C*******************************************************************************
C  PRE.CONSTFLUX.F77 -- A PROGRAM TO SUM CONSTANT FLUXES FOR INPUT TO
C  THE MODULAR GROUND-WATER MODEL
C               BY   WES DANSKIN
C                    LAST REVISION 2/28/89
C
C  PROGRAM READS IN CONSTANT FLUXES FOR CONSTANT WELL PUMPAGE, STREAM RECHARGE
C  UNGAGED RECHARGE, AND BOUNDARY FLUXES.  VALUES ARE SUMMED
C  FOR EACH NODE.  ALL VALUES (EXCEPT BOUNDARY FLUX) ARE READ IN
C  POSITIVE AND CONVERTED SO THAT RECHARGE IS POSITIVE AND
C  PUMPAGE NEGATIVE. STREAM AND UNGAGED RECHARGE ARE PUT IN LAYER 1; WELL PUMPAGE
C  IS PUT IN WHICHEVER LAYER READ IN.
C  NUMBERING IS (ROW,COLUMN,LAYER) LAYER 1 IS TOP
C  IBOUND ARRAYS ARE USED TO VERIFY THAT ALL NODES ARE ACTIVE
C*******************************************************************************
C  FILES
C     5  PRE.CONSTFLUX.IN -- INPUT PARAMETERS AND DATA
C     6  PRE.CONSTFLUX.CHECK -- VERIFY INPUT DATA
C    32  MODEL.WELL -- OUTPUT FOR MODULAR MODEL WELL PACKAGE
C    94  PRE.CONSTFLUX.TOTALS -- TOTALS FOR EACH TYPE OF FLUX
C    95  PRE.ERRORS -- ERRORS
C*******************************************************************************
      DIMENSION FLUX(180,40,2),FLUXIN(180,40),IBOUND(180,40,2),
     - TOTPUM(2)
      CHARACTER*10 IWELL
      CHARACTER*80 BLANK,HEADNG
      COMMON /BIG1/FLUX,FLUXIN,IBOUND
C  DEFINE CONSTANTS AND SIZE OF GRID LOOPS
C      NROW=180
C      NCOL=40
C      NLAY=2
      IONE=1
      ITWO=2
C  READ CONTROL PARAMETERS
      IOUT=6
      READ(30,902)HEADNG
C      WRITE(IOUT,902)HEADNG
      READ(30,902)HEADNG
C      WRITE(IOUT,902)HEADNG
      READ(30,903)NLAY,NROW,NCOL,NYEARS
C      WRITE(IOUT,903)NLAY,NROW,NCOL,NYEARS
      READ(5,900)MAXWEL
C      WRITE(IOUT,900)MAXWEL
C  ZERO VARIABLES AND MATRIXES
      DO 10 K=1,NLAY
      DO 10 I=1,NROW
      DO 10 J=1,NCOL
      IBOUND(I,J,K)=0
   10 CONTINUE
      CALL ZERO2D(FLUXIN,NROW,NCOL)
      CALL ZERO3D(FLUX,NROW,NCOL,NLAY)
C  READ IN IBOUND ARRAY FOR EACH LAYER
      DO 50 I=1,NROW
       READ(51,981)(IBOUND(I,J,1),J=1,NCOL)
       READ(52,981)(IBOUND(I,J,2),J=1,NCOL)
   50 CONTINUE
C  DO-LOOP FOR YEARS OF SIMULATION
      DO 800 KYEAR=1,NYEARS
      ITEST=1962+KYEAR
      WRITE(94,915)ITEST
C  RE-ZERO ARRAYS
      CALL ZERO2D(FLUXIN,NROW,NCOL)
      CALL ZERO3D(FLUX,NROW,NCOL,NLAY)
C
C  WELL PUMPAGES
C
C  READ IN PUMPAGE DATA FOR A SINGLE WATER YEAR
C  READ IN PUMPAGE DATA FOR LAYER 1
      IN=71
      IOUT=6
      SCALE=-1.0
      READ(IN,900)IYEAR
C      WRITE(IOUT,923)IYEAR
C  CHECK THAT DATASET FOR CORRECT YEAR IS READ
      ITEST=1962+KYEAR
      IF(IYEAR.NE.ITEST) WRITE(95,913)IYEAR,KYEAR
      CALL READ2D(FLUXIN,NROW,NCOL,IN,SCALE)
C      CALL WRIT2D(FLUXIN,NROW,NCOL,IOUT)
C  CALCULATE SUMS AND ADD TO TOTAL ARRAY
      TOTPUM(1)=0.
      DO 200 I=1,NROW
      DO 200 J=1,NCOL
C  CHECK TO ASSURE NODE IS ACTIVE
      IF(IBOUND(I,J,1).NE.0) GOTO 205
      IF(FLUXIN(I,J).NE.0.) WRITE(95,914)I,J,IONE
  205 TOTPUM(1)=TOTPUM(1)+FLUXIN(I,J)
      FLUX(I,J,1)=FLUX(I,J,1)+FLUXIN(I,J)
  200 CONTINUE
C  READ IN PUMPAGE DATA FOR LAYER 2
      IN=72
      IOUT=6
      SCALE=-1.0
      READ(IN,900)IYEAR
C      WRITE(IOUT,923)IYEAR
C  CHECK THAT DATASET FOR CORRECT YEAR IS READ
      ITEST=1962+KYEAR
      IF(IYEAR.NE.ITEST) WRITE(95,913)IYEAR,KYEAR
      CALL READ2D(FLUXIN,NROW,NCOL,IN,SCALE)
C      CALL WRIT2D(FLUXIN,NROW,NCOL,IOUT)
C  CALCULATE SUMS AND ADD TO TOTAL ARRAY
      TOTPUM(2)=0.
      DO 210 I=1,NROW
      DO 210 J=1,NCOL
C  CHECK TO ASSURE NODE IS ACTIVE
      IF(IBOUND(I,J,2).NE.0) GOTO 215
      IF(FLUXIN(I,J).NE.0.) WRITE(95,914)I,J,ITWO
  215 TOTPUM(2)=TOTPUM(2)+FLUXIN(I,J)
      FLUX(I,J,2)=FLUX(I,J,2)+FLUXIN(I,J)
  210 CONTINUE
C  WRITE OUT PUMPAGE TOTALS
      IOUT=94
      TPUMP=TOTPUM(1)+TOTPUM(2)
      WRITE(IOUT,911)TOTPUM(1),TOTPUM(2),TPUMP
C
C  GAGED STREAM RECHARGES
C
C  READ IN DATA FOR A SINGLE WATER YEAR
C  ASSIGN ALL STREAM RECHARGE TO LAYER 1
      IN=73
      IOUT=6
      SCALE=1.0
      READ(IN,900)IYEAR
C      WRITE(IOUT,923)IYEAR
C  CHECK THAT DATASET FOR CORRECT YEAR IS READ
      ITEST=1962+KYEAR
      IF(IYEAR.NE.ITEST) WRITE(95,913)IYEAR,KYEAR
      CALL READ2D(FLUXIN,NROW,NCOL,IN,SCALE)
C      CALL WRIT2D(FLUXIN,NROW,NCOL,IOUT)
C  CALCULATE SUMS AND ADD TO TOTAL ARRAY
      TOTSTR=0.
      DO 300 I=1,NROW
      DO 300 J=1,NCOL
C  CHECK TO ASSURE NODE IS ACTIVE
      IF(IBOUND(I,J,1).NE.0) GOTO 305
      IF(FLUXIN(I,J).NE.0.) WRITE(95,914)I,J,IONE
  305 TOTSTR=TOTSTR+FLUXIN(I,J)
      FLUX(I,J,1)=FLUX(I,J,1)+FLUXIN(I,J)
  300 CONTINUE
C  WRITE OUT STREAM RECHARGE TOTALS
      IOUT=94
      WRITE(IOUT,924)TOTSTR
C
C  UNGAGED RECHARGES
C
C  READ IN DATA FOR A SINGLE WATER YEAR
C  ASSIGN ALL UNGAGED RECHARGE TO LAYER 1
      IN=74
      IOUT=6
      SCALE=1.0
      READ(IN,900)IYEAR
C      WRITE(IOUT,923)IYEAR
C  CHECK THAT DATASET FOR CORRECT YEAR IS READ
      ITEST=1962+KYEAR
      IF(IYEAR.NE.ITEST) WRITE(95,913)IYEAR,KYEAR
      CALL READ2D(FLUXIN,NROW,NCOL,IN,SCALE)
C      CALL WRIT2D(FLUXIN,NROW,NCOL,IOUT)
C  CALCULATE SUMS AND ADD TO TOTAL ARRAY
      TOTUNG=0.
      DO 350 I=1,NROW
      DO 350 J=1,NCOL
C  CHECK TO ASSURE NODE IS ACTIVE
      IF(IBOUND(I,J,1).NE.0) GOTO 355
      IF(FLUXIN(I,J).NE.0.) WRITE(95,914)I,J,IONE
  355 TOTUNG=TOTUNG+FLUXIN(I,J)
      FLUX(I,J,1)=FLUX(I,J,1)+FLUXIN(I,J)
  350 CONTINUE
C  WRITE OUT UNGAGED RECHARGE TOTALS
      IOUT=94
      WRITE(IOUT,926)TOTUNG
C
C  CANAL RECHARGES -- CANALS AND DITCHES
C
C  READ IN DATA FOR A SINGLE WATER YEAR
C  ASSIGN ALL CANAL RECHARGE TO LAYER 1
      IN=75
      IOUT=6
      SCALE=1.0
      READ(IN,900)IYEAR
C      WRITE(IOUT,923)IYEAR
C  CHECK THAT DATASET FOR CORRECT YEAR IS READ
      ITEST=1962+KYEAR
      IF(IYEAR.NE.ITEST) WRITE(95,913)IYEAR,KYEAR
      CALL READ2D(FLUXIN,NROW,NCOL,IN,SCALE)
C      CALL WRIT2D(FLUXIN,NROW,NCOL,IOUT)
C  CALCULATE SUMS AND ADD TO TOTAL ARRAY
      TOTCAN=0.
      DO 360 I=1,NROW
      DO 360 J=1,NCOL
C  CHECK TO ASSURE NODE IS ACTIVE
      IF(IBOUND(I,J,1).NE.0) GOTO 365
      IF(FLUXIN(I,J).NE.0.) WRITE(95,914)I,J,IONE
  365 TOTCAN=TOTCAN+FLUXIN(I,J)
      FLUX(I,J,1)=FLUX(I,J,1)+FLUXIN(I,J)
  360 CONTINUE
C  WRITE OUT CANAL RECHARGE TOTALS
      IOUT=94
      WRITE(IOUT,927)TOTCAN
C
C  GROUND-WATER RECHARGE -- THAT IS SPECIFIED AS GW RECHARGE, NOT
C                           AS CANALS, OR PONDS OR ANYTHING ELSE.
C
C  READ IN DATA FOR A SINGLE WATER YEAR
C  ASSIGN ALL CANAL RECHARGE TO LAYER 1
      IN=76
      IOUT=6
      SCALE=1.0
      READ(IN,900)IYEAR
C      WRITE(IOUT,923)IYEAR
C  CHECK THAT DATASET FOR CORRECT YEAR IS READ
      ITEST=1962+KYEAR
      IF(IYEAR.NE.ITEST) WRITE(95,913)IYEAR,KYEAR
      CALL READ2D(FLUXIN,NROW,NCOL,IN,SCALE)
C      CALL WRIT2D(FLUXIN,NROW,NCOL,IOUT)
C  CALCULATE SUMS AND ADD TO TOTAL ARRAY
      TOTGW=0.
      DO 370 I=1,NROW
      DO 370 J=1,NCOL
C  CHECK TO ASSURE NODE IS ACTIVE
      IF(IBOUND(I,J,1).NE.0) GOTO 375
      IF(FLUXIN(I,J).NE.0.) WRITE(95,914)I,J,IONE
  375 TOTGW=TOTGW+FLUXIN(I,J)
      FLUX(I,J,1)=FLUX(I,J,1)+FLUXIN(I,J)
  370 CONTINUE
C  WRITE OUT GROUND-WATER RECHARGE TOTALS
      IOUT=94
      WRITE(IOUT,928)TOTGW
C
C  AGRICULTURAL RECHARGES -- FROM IRRIGATION AND STOCK WATERING,
C                            NOT FROM MAJOR CANALS OR DITCHES
C
C  READ IN DATA FOR A SINGLE WATER YEAR
C  ASSIGN ALL AGRICULTURAL RECHARGE TO LAYER 1
      IN=77
      IOUT=6
      SCALE=1.0
      READ(IN,900)IYEAR
C      WRITE(IOUT,923)IYEAR
C  CHECK THAT DATASET FOR CORRECT YEAR IS READ
      ITEST=1962+KYEAR
      IF(IYEAR.NE.ITEST) WRITE(95,913)IYEAR,KYEAR
      CALL READ2D(FLUXIN,NROW,NCOL,IN,SCALE)
C      CALL WRIT2D(FLUXIN,NROW,NCOL,IOUT)
C  CALCULATE SUMS AND ADD TO TOTAL ARRAY
      TOTAG=0.
      DO 380 I=1,NROW
      DO 380 J=1,NCOL
C  CHECK TO ASSURE NODE IS ACTIVE
      IF(IBOUND(I,J,1).NE.0) GOTO 385
      IF(FLUXIN(I,J).NE.0.) WRITE(95,914)I,J,IONE
  385 TOTAG=TOTAG+FLUXIN(I,J)
      FLUX(I,J,1)=FLUX(I,J,1)+FLUXIN(I,J)
  380 CONTINUE
C  WRITE OUT AGRICULTURAL RECHARGE TOTALS
      IOUT=94
      WRITE(IOUT,929)TOTAG
C
C  CONSTANT FLUX BOUNDARY CONDITIONS
C
C  NOTE THESE VALUES MUST BE READ IN + FOR RECHARGE, - DISCHARGE
C  READ IN ONE SET OF DATA AND REUSE FOR ALL YEARS
      IN=80
      IOUT=6
      SCALE=1.0
      REWIND(IN)
      READ(IN,901) NBN,IYEAR
C      WRITE(IOUT,901) NBN,IYEAR
        IF(NBN.EQ.0) GOTO 400
C  CALCULATE SUMS AND ADD TO TOTAL ARRAY
      TOTBND=0.
      DO 400 I=1,NBN
        READ(IN,930) IL,IR,IC,BCFS
C        WRITE(IOUT,930) IL,IR,IC,BCFS
        BCFS=BCFS*SCALE
        TOTBND=TOTBND+BCFS
        FLUX(IR,IC,IL)=FLUX(IR,IC,IL)+BCFS
  400 CONTINUE
C  WRITE OUT BOUNDARY FLOW TOTALS
      IOUT=94
      WRITE(IOUT,925)TOTBND
C
C CALCULATE NUMBER OF NON-ZERO PUMPAGES
C
      NN=0
      TOTFLX=0.
      DO 500 K=1,NLAY
      DO 500 I=1,NROW
      DO 500 J=1,NCOL
        IF(FLUX(I,J,K).EQ.0.) GOTO 500
        TOTFLX=TOTFLX+FLUX(I,J,K)
        NN=NN+1
  500 CONTINUE
C
C  WRITE NUMBER OF WELLS AND FILE HEADER FOR STEADY.WELL PACKAGE
C
      IOUT=6
C  IF MAXIMUM NUMBER OF WELLS IS TOO SMALL, WRITE ERROR MESSAGE
      IF(NN.GT.MAXWEL)WRITE(95,982)NN
      IUNIT=63
C      WRITE(IOUT,950)NN,TOTFLX
      WRITE(94,950)NN,TOTFLX
      IF(KYEAR.EQ.1)WRITE(32,901)MAXWEL,IUNIT
      IF(KYEAR.EQ.1)WRITE(IOUT,901)MAXWEL,IUNIT
      WRITE(32,900)NN
C      WRITE(IOUT,900)NN
C  WRITE NON-ZERO PUMPAGES TO A FILE
      DO 600 K=1,NLAY
      DO 600 I=1,NROW
      DO 600 J=1,NCOL
        IF(FLUX(I,J,K).EQ.0.) GOTO 600
      WRITE(32,990) K,I,J,FLUX(I,J,K)
C      WRITE(IOUT,990) K,I,J,FLUX(I,J,K)
      IF(IBOUND(I,J,K).NE.0)GOTO 600
C  WRITE ERROR MESSAGE THAT NODE IS NOT ACTIVE
      WRITE(95,980)I,J,K
  600 CONTINUE
C  END OF MAJOR DO-LOOP FOR YEARS OF SIMULATION
  800 CONTINUE
C  FORMAT STATEMENTS
  900 FORMAT(I10)
  901 FORMAT(2I10)
  902 FORMAT(A80)
  903 FORMAT(4I10)
  911 FORMAT('TOTAL WELL PUMPAGE (CFS) -- LAYER 1 = ',F10.3,/,
     -       '                   (CFS) -- LAYER 2 = ',F10.3,/,
     -       '                   (CFS) -- BOTH    = ',F10.3)
  913 FORMAT('ERROR --INCORRECT YEAR IS READ IN ',2I10)
  914 FORMAT('ERROR -- NODE IS NOT ACTIVE, I,J,K = ',3I5)
  915 FORMAT('********* WATER YEAR = ',I5)
  923 FORMAT(I10,' = WATER YEAR')
  924 FORMAT('TOTAL STREAM RECHARGE (CFS) -- LAYER 1 = ',F10.3)
  925 FORMAT('TOTAL BOUNDARY FLOW CFS (+ IN - OUT) = ',F10.3)
  926 FORMAT('TOTAL UNGAGED RECHARGE (CFS) -- LAYER 1 = ',F10.3)
  927 FORMAT('TOTAL CANAL RECHARGE (CFS) -- LAYER 1 = ',F10.3)
  928 FORMAT('TOTAL GW RECHARGE (CFS) -- LAYER 1 = ',F10.3)
  929 FORMAT('TOTAL AG RECHARGE (CFS) -- LAYER 1 = ',F10.3)
  930 FORMAT(3I10,10X,F10.3)
  950 FORMAT('NUMBER OF CONSTANT FLUX NODES = ',I6,2X,/,
     -       'TOTAL CONSTANT FLUX (CFS)  = ',F10.3)
  980 FORMAT('ERROR -- NODE IS NOT ACTIVE',3I5)
  981 FORMAT(40I3)
  982 FORMAT('MAXIMUM NUMBER OF WELLS TOO LOW. NEED MORE THAN=',I5)
  990 FORMAT(3I10,F10.3)
  991 FORMAT(1X,'TOTAL NUMBER OF FLUX NODES =  ',I4)
C  END OF MAIN PROGRAM
      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
