c----------------------------------------------------------------------
c     Author:       Matthew W. Choptuik
c     Institution:  The University of Texas at Austin
c     Date:         June 1994
c----------------------------------------------------------------------
c-----------------------------------------------------------------------
c
c     Some utility routines for use with test readers/writers ...
c
c-----------------------------------------------------------------------

C-----------------------------------------------------------------------
C
C     Define 3--array "ramp" function ...
C
C-----------------------------------------------------------------------

      SUBROUTINE D3RAMP(A,D1,D2,D3,X10,DX1,X20,DX2,X30,DX3)

         IMPLICIT       NONE

         INTEGER        D1,         D2,         D3
         REAL*8         A(D1,D2,D3)

         REAL*8         X10,        DX1,        X20,        DX2,
     *                  X30,        DX3

         REAL*8         BASE3,      BASE2,      BASE1
         INTEGER        I,          J,          K

         BASE3 = X10 + X20 + X30
         DO 30 K = 1 , D3
            BASE2 = BASE3
            DO 20 J = 1 , D2
               BASE1 = BASE2
               DO 10 I = 1 , D1
                  A(I,J,K) = BASE1
                  BASE1 = BASE1 + DX1
 10            CONTINUE
               BASE2 = BASE2 + DX2
 20         CONTINUE
            BASE3 = BASE3 + DX3
 30      CONTINUE

         RETURN

      END
C
C-----------------------------------------------------------------------
C
C     Dumps 3--array labelled with LABEL on UNIT.
C
C-----------------------------------------------------------------------
C
      SUBROUTINE D3DUMP(A,D1,D2,D3,LABEL,UNIT)
C
         IMPLICIT       NONE
C
         INTEGER        D1,       D2,       D3,
     *                  UNIT
         REAL*8         A(D1,D2,D3)
         CHARACTER*(*)  LABEL
         INTEGER        I,        J,        K,
     *                  ST
C
         IF( D1 .GT. 0  .AND.  D2 .GT. 0  .AND.  D3 .GT. 0 ) THEN
            WRITE(UNIT,100) LABEL
 100        FORMAT(/' <<< ',A,' >>>')
            DO 300 K = 1 , D3
               WRITE(UNIT,105) K
 105           FORMAT(' <<< Plane: ',I4,'. >>>')
               DO 200 J = 1 , D2
                  ST = 1
 110              CONTINUE
                     WRITE(UNIT,120) ( A(I,J,K) , I = ST , MIN(ST+3,D1))
 120                 FORMAT(' ',4(1PE19.10))
                  ST = ST + 4
                  IF( ST .LE. D1 ) GO TO 110
                  WRITE(UNIT,140)
 140              FORMAT(' ')
 200           CONTINUE
 300        CONTINUE
         END IF
C
         RETURN
C
      END
 
C-----------------------------------------------------------------------
C
C     Dumps vector labelled with LABEL on UNIT.
C
C-----------------------------------------------------------------------
C
      SUBROUTINE DVDUMP(V,N,LABEL,UNIT)
C
         REAL*8         V(1)
         CHARACTER*(*)  LABEL
         INTEGER        I, N, ST, UNIT
C
         IF( N .LT. 1 ) GO TO 130
            WRITE(UNIT,100) LABEL
 100        FORMAT(/' <<< ',A,' >>>'/)
            ST = 1
 110        CONTINUE
               WRITE(UNIT,120) ( V(I) , I = ST , MIN(ST+3,N))
 120           FORMAT(' ',4(1PE19.10))
               ST = ST + 4
            IF( ST .LE. N ) GO TO 110
C
 130     CONTINUE
C
         RETURN
C
      END
C
C---------------------------------------------------------------------
C
C     Initializes V to ramp function - origin V0, increment VINC.
C
C---------------------------------------------------------------------
C
      SUBROUTINE DVRAMP(V,V0,VINC,N)
C
         REAL*8      V(1)
         REAL*8      V0, VINC
         INTEGER     I, N
C
         V(1) = V0
         DO 10 I = 2 , N
            V(I) = V(I-1) + VINC
 10      CONTINUE
C
         RETURN
C
      END

C-----------------------------------------------------------------------
C
C     Dumps V on UNIT.
C
C-----------------------------------------------------------------------
C
      SUBROUTINE IVDUMP(V,N,LABEL,UNIT)
C
         IMPLICIT       LOGICAL*1 (A-Z)
C
         INTEGER        N,   UNIT
C
         INTEGER        V(1)
C
         CHARACTER*(*)  LABEL
C
         INTEGER        I,   ST
C
         IF( N .GE. 1 ) THEN
            WRITE(UNIT,100) LABEL
 100        FORMAT(/' <<< ',A,' >>>'/)
            ST = 1
 110        CONTINUE
               WRITE(UNIT,120) ( V(I) , I = ST , MIN(ST+5,N))
 120           FORMAT(' ',6I12)
               ST = ST + 6
            IF( ST .LE. N ) GO TO 110
         END IF
C
         RETURN
C
      END