C**********************************************************************
C**********************************************************************
C
      SUBROUTINE ADUMP
     I   ( Q,   NAME,
     D     NXB, NZB, NROT,
     I     IR , IFDUMP , TIME )
C
C**********************************************************************
      IMPLICIT REAL*8 ( A-H, O-Z )
C**********************************************************************
C
      CHARACTER*(*) NAME
      DIMENSION Q( -2:NXB, -2:NZB, NROT )
C
C======================================================================
C
      IP0 = 0
C
      IF ( IFDUMP .NE. 1 ) RETURN
C
      WRITE(6,600)
  600 FORMAT ( 1H1 )
C
      NX = NXB-2
      NZ = NZB-2
C
      EPS = 1.0D-17
      QMAX = EPS
C
      DO 10 IZ = -2, NZB
      DO 10 IX = 1, NX
         QABS = ABS( Q(IX,IZ,IR) )
         QMAX = MAX ( QMAX, QABS )
   10 CONTINUE
C
      SCALE = 10.0D0**INT( LOG10( QMAX ) -2 )
C
      WRITE(6,*)'====================================================='
      WRITE(6,*)'ARRAY:  ',NAME,'(',IR,') SCALE =',SCALE,' TIME=',TIME
      WRITE(6,*)'-----------------------------------------------------'
C
      WRITE(6,601)(J,(INT(Q(I+IP0,J,IR)/SCALE),I=-2,18),J=NZ+2,-2,-1)
  601 FORMAT (22I3)
C
      WRITE(6,*)'====================================================='
C
C     WRITE(41) NAME
C     WRITE(41) TIME, IR, Q
C
C====================================================================
C
      RETURN
      E N D
