C*******************************************************************************
C  PRE.TKS.F77 -- A PROGRAM TO CREATE TRANSMISSIVITY, VCONT, AND STORAGE FILES
C  FOR A TWO-LAYER SYSTEM
C               BY   WES DANSKIN
C                    LAST REVISION 1/17/89
C
C  PROGRAM USES HYDROGEOLOGIC AREAS TO DETERMINE THE HYDRAULIC PARAMETERS.
C*******************************************************************************
C  FILES
C     5  INPUT VALUES
C     6  PRE.TK.CHECK
C    51  IBOUND, LAYER 1
C    52  IBOUND, LAYER 2
C    56  TRANSMISSIVITY, LAYER 1
C    57  VCONT, LAYER 1-2
C    58  TRANSMISSIVITY, LAYER 2
C    59  STORAGE, LAYER 1
C    60  STORAGE, LAYER 2
C    95  ERRORS
C*******************************************************************************
      DIMENSION IBOUND(180,40,2),TRANS(180,40,2),VCONT(180,40,2),
     - STORE(180,40,2),TNEW(60,2),VCONTN(60,2),SNEW(60,2)
      CHARACTER*80 BLANK,HEADNG
      CHARACTER*30 ANAME(60)
      COMMON /DATATK/ IBOUND,TRANS,VCONT,STORE,TNEW,VCONTN,SNEW
C  INITILIZE VARIABLES
C      NROW=180
C      NCOL=40
C      NLAY=2
      NAREAS=60
C  READ CONTROL PARAMETERS
      READ(30,902)HEADNG
      WRITE(6,902)HEADNG
      READ(30,902)HEADNG
      WRITE(6,902)HEADNG
      READ(30,903)NLAY,NROW,NCOL,NYEARS
      WRITE(6,903)NLAY,NROW,NCOL,NYEARS
C  ZERO ARRAYS
      DO 20, K=1,NLAY
      DO 20, I=1,NROW
      DO 20, J=1,NCOL
      IBOUND(I,J,K)=0
      TRANS(I,J,K)=0.
      VCONT(I,J,K)=0.
      STORE(I,J,K)=0.
   20 CONTINUE
      DO 22 K=1,NAREAS
      DO 22 I=1,NLAY
      TNEW(K,I)=0.
      VCONTN(K,I)=0.
      SNEW(K,I)=0.
   22 CONTINUE
C  READ IN DIMENSIONS OF MODELC  READ IBOUND VALUES FOR EACH LAYER
C  READ IBOUND VALUES FOR EACH LAYER
      DO 50 I=1,NROW
      READ(51,911) (IBOUND(I,J,1),J=1,NCOL)
      READ(52,911) (IBOUND(I,J,2),J=1,NCOL)
   50 CONTINUE
C  READ NEW T, VCONT, STORAGE VALUES TO APPLY TO EACH AREA
      READ(5,912)BLANK
      WRITE(6,912)BLANK
      DO 70 I=1,NAREAS
      READ(5,909) ANAME(I),TNEW(I,1),TNEW(I,2),VCONTN(I,1),SNEW(I,1),
     - SNEW(I,2)
      WRITE(6,909) ANAME(I),TNEW(I,1),TNEW(I,2),VCONTN(I,1),SNEW(I,1),
     - SNEW(I,2)
   70 CONTINUE
C
C  ASSIGN NEW VALUES
      DO 200 K=1,NLAY
      DO 200 I=1,NROW
      DO 200 J=1,NCOL
      M=IABS(IBOUND(I,J,K))
C  WRITE ERROR IF M IS NOT DEFINED
      IF(M.GT.NAREAS) WRITE(95,915)M,I,J
C  NODE IS OUTSIDE MODEL AREA
      IF(M.EQ.0) GOTO 190
C  ASSIGN VALUES FOR 2 LAYERS
C  ASSUME VCONT 1 IS BETWEEN LAYERS 1 AND 2
C  ASSUME VCONT 1 IS DETERMINED BY LAYER 2 MATERIALS
  110 IF(K.EQ.1)TRANS(I,J,1)=TNEW(M,1)
      IF(K.EQ.2)TRANS(I,J,2)=TNEW(M,2)
C      IF(K.EQ.1)VCONT(I,J,1)=VCONTN(M,1)
      IF(K.EQ.2)VCONT(I,J,1)=VCONTN(M,1)
      IF(K.EQ.1)STORE(I,J,1)=SNEW(M,1)
      IF(K.EQ.2)STORE(I,J,2)=SNEW(M,2)
      GOTO 200
C  NODE IS INACTIVE
  190 TRANS(I,J,1)=0.
      TRANS(I,J,2)=0.
      VCONT(I,J,1)=0.
      STORE(I,J,1)=0.
      STORE(I,J,2)=0.
      GOTO 200
  200 CONTINUE
C  WRITE TRANSMISSIVITY (G/D/FT)
      DO 300 I=1,NROW
      WRITE(56,920)(TRANS(I,J,1), J=1,NCOL)
      WRITE(58,920)(TRANS(I,J,2), J=1,NCOL)
  300 CONTINUE
C  WRITE VERTICAL CONDUCTANCE BETWEEN LAYER 1 AND 2 (10E-4 G/D/FT3)
      DO 310 I=1,NROW
      WRITE(57,922)(VCONT(I,J,1), J=1,NCOL)
  310 CONTINUE
C  WRITE STORAGE COEFFICIENTS (NOTE FORMAT)
      DO 340 I=1,NROW
      WRITE(59,926)(STORE(I,J,1), J=1,NCOL)
      WRITE(60,926)(STORE(I,J,2), J=1,NCOL)
  340 CONTINUE
C  FORMAT STATEMENTS
  902 FORMAT(A80)
  903 FORMAT(4I10)
  909 FORMAT(A30,5F10.0)
  911 FORMAT(40I3)
  912 FORMAT(A80)
  915 FORMAT('ERROR -- HYDROGEOLOGIC AREA IS NOT DEFINED, M = ',I5,
     -' ROW = ',I5,'COLUMN= ',I5)
  920 FORMAT(8F10.0)
  921 FORMAT(8F10.1)
  922 FORMAT(8F10.2)
  923 FORMAT(8F10.3)
  924 FORMAT(8F10.4)
  925 FORMAT(8F10.5)
  926 FORMAT(8F10.6)
  927 FORMAT(8F10.7)
      STOP
      END
C*****************************************************************************
      SUBROUTINE ZERO2D(BUF,NROW,NCOL)
C*****************************************************************************
      DIMENSION BUF(180,40)
C      COMMON /ZERO2/ BUF
C--ZERO 2-DIMENSIONAL BUFFER
      DO 100 I=1,NROW
      DO 100 J=1,NCOL
        BUF(I,J)=0.
  100 CONTINUE
      RETURN
      END
C*****************************************************************************
      SUBROUTINE ZERO3D(BUFF,NROW,NCOL,NLAY)
C*****************************************************************************
      DIMENSION BUFF(180,40,2)
C      COMMON /ZERO3/ BUFF
C--ZERO 3-DIMENISONAL BUFFER
      DO 100 K=1,NLAY
      DO 100 I=1,NROW
      DO 100 J=1,NCOL
        BUFF(I,J,K)=0.
  100 CONTINUE
      RETURN
      END
C*****************************************************************************
      SUBROUTINE READ2D(BUF,NROW,NCOL,IN,SCALE)
C*****************************************************************************
      DIMENSION BUF(180,40)
C      COMMON /READ2/ BUF
C--READ 2-DIMENISONAL ARRAY
      DO 100 I=1,NROW
      READ(IN,900) (BUF(I,J),J=1,NCOL)
  100 CONTINUE
      DO 200 I=1,NROW
      DO 200 J=1,NCOL
      BUF(I,J)=BUF(I,J)*SCALE
  200 CONTINUE
  900 FORMAT(8F10.0)
      RETURN
      END
C*****************************************************************************
      SUBROUTINE WRIT2D(BUF,NROW,NCOL,IOUT)
C*****************************************************************************
      DIMENSION BUF(180,40)
C      COMMON /WRIT2/ BUF
C--WRITE 2-DIMENISONAL ARRAY
      DO 100 I=1,NROW
      WRITE(IOUT,900) (BUF(I,J),J=1,NCOL)
  100 CONTINUE
  900 FORMAT(8F10.3)
      RETURN
      END
