C*******************************************************************************
C  POST.BUDGET.F77 -- A PROGRAM TO PROCESS OUTPUT FROM THE MODULAR GROUND
C  WATER MODEL BY MCDONALD AND HARBAUGH (1984).
C               BY   WES DANSKIN
C                    LAST REVISION 11/20/89
C
C  THE MODULAR MODEL WRITES AN UNFORMATTED FILE CONSISTING OF A HEADER RECORD
C  AND THEN CELL-BY-CELL VALUES FROM THE SOLUTION OUTPUT.  IN THE CASE OF HEADS
C  AND DRAWDOWNS THE OUTPUT IS A HEADER FOR EACH LAYER OF BUF(NCOL,NROW).  IN
C  THE CASE OF FLUXES A HEADER IS FOLLOWED BY BUFF(NCOL,NROW,NLAY).
C
C  VALUES IN THE UNFORMATTED RECORD BUFF(I,J,K) ARE INCREMENTED I,J,K.
C  VALUES OF FLUXES ARE SUMMED FOR SPECIFIC AREAS OF INTEREST
C
C  SET IFLAG=0 TO SKIP A BUDGET LOOP
C  SOME LOOPS ARE COMMENTED OUT IF NOT USED BY THE MODEL
C*****************************************************************************
C  MAIN PROGRAM
C*****************************************************************************
      DIMENSION BUFF(40,180,2,26),XTIME(26),SUMIN(26),SUMOUT(26),
     - SUMTOT(26)
      CHARACTER*16 TEXT,TEXTID
      CHARACTER*80 NAME,HEADNG
      COMMON /BIGX/ BUFF,XTIME,SUMIN,SUMOUT,SUMTOT
      COMMON /BIGI/ NCOL,NROW,NLAY,NYEARS
      COMMON /BIGC/ TEXT,TEXTID
C  DEFINE DIMENSIONS
C     NCOL = NUMBER OF COLUMNS = 40
C     NROW = NUMBER OF ROWS = 180
C     NLAY = NUMBER OF LAYERS = 2
C     NYEARS = NUMBER OF TIMESTEPS (YEARS) = 26
C  READ CONTROL PARAMETERS
      IOUT=6
      IREAD=30
      READ(IREAD,902)HEADNG
      WRITE(IOUT,902)HEADNG
      READ(IREAD,902)HEADNG
      WRITE(IOUT,902)HEADNG
      READ(IREAD,903)NLAY,NROW,NCOL,NYEARS
      WRITE(IOUT,903)NLAY,NROW,NCOL,NYEARS
C  ZERO MATRICES AND VARIABLES
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZERO4D
      DO 10 K=1,NYEARS
      XTIME(K)=0.
   10 CONTINUE
      KSTP=0
      KPER=0
      TEXT='                '
      TEXTID='                '
      PERTIM=0.
      TOTIM=0.
      IREAD1=0
      IREAD2=0
      IOUT=0
C  DEFINE ARRAY OF X VALUES, AT AVERAGE OF TIME PERIOD
      BEGTIM=1962.25
      DO 50 I=1,NYEARS
      XTIME(I)=BEGTIM+I
   50 CONTINUE
C--STORAGE
      IREAD1=55
      IREAD2=70
      IOUT=80
      IFLAG=1
      TEXTID='         STORAGE'
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 100 I=1,29999
      IF(IFLAG.EQ.0) GOTO 101
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  100 CONTINUE
  101 CONTINUE
C--CONSTANT HEAD FLUX
      IREAD1=55
      IREAD2=71
      IOUT=81
      IFLAG=1
      TEXTID='   CONSTANT HEAD'
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 110 I=1,29999
      IF(IFLAG.EQ.0) GOTO 111
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  110 CONTINUE
  111 CONTINUE
C--CELL FLOW THROUGH RIGHT FACE
      IREAD1=55
      IREAD2=72
      IOUT=82
      IFLAG=1
      TEXTID='FLOW RIGHT FACE '
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 120 I=1,29999
      IF(IFLAG.EQ.0) GOTO 121
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  120 CONTINUE
  121 CONTINUE
C--CELL FLOW THROUGH FRONT FACE
      IREAD1=55
      IREAD2=73
      IOUT=83
      IFLAG=1
      TEXTID='FLOW FRONT FACE '
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 130 I=1,29999
      IF(IFLAG.EQ.0) GOTO 131
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  130 CONTINUE
  131 CONTINUE
C--CELL FLOW THROUGH BOTTOM FACE
      IREAD1=55
      IREAD2=74
      IOUT=84
      IFLAG=1
      TEXTID='FLOW LOWER FACE '
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 140 I=1,29999
      IF(IFLAG.EQ.0) GOTO 141
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  140 CONTINUE
  141 CONTINUE
C--WELLS AND STREAM RECHARGE
      IREAD1=65
      IREAD2=75
      IOUT=85
      IFLAG=1
      TEXTID='           WELLS'
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 150 I=1,29999
      IF(IFLAG.EQ.0) GOTO 151
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  150 CONTINUE
  151 CONTINUE
C--DRAINS
      IREAD1=66
      IREAD2=76
      IOUT=86
      IFLAG=1
      TEXTID='          DRAINS'
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 160 I=1,29999
      IF(IFLAG.EQ.0) GOTO 161
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  160 CONTINUE
  161 CONTINUE
C--PRECIP AND ET RECHARGE (NET)
      IREAD1=67
      IREAD2=77
      IOUT=87
      IFLAG=1
      TEXTID='        RECHARGE'
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 170 I=1,29999
      IF(IFLAG.EQ.0) GOTO 171
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  170 CONTINUE
  171 CONTINUE
C--EVAPOTRANSPIRATION
      IREAD1=68
      IREAD2=78
      IOUT=88
      IFLAG=1
      TEXTID='              ET'
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 180 I=1,29999
      IF(IFLAG.EQ.0) GOTO 181
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  180 CONTINUE
  181 CONTINUE
C--RIVER
      IREAD1=69
      IREAD2=79
      IOUT=89
      IFLAG=1
      TEXTID='   RIVER LEAKAGE'
      REWIND(IREAD1)
      CALL ZERO4D
      CALL BUFFRD (IREAD1)
      DO 190 I=1,29999
      IF(IFLAG.EQ.0) GOTO 191
      CALL ZERO1D (SUMIN)
      CALL ZERO1D (SUMOUT)
      CALL ZERO1D (SUMTOT)
      CALL ZONEBD (IREAD2,IOUT,IFLAG)
  190 CONTINUE
  191 CONTINUE
C--GENERAL HEAD BOUNDARY
      CONTINUE
C  FORMAT STATEMENTS
  901 FORMAT(2I10)
  902 FORMAT(A80)
  903 FORMAT(4I10)
C  END OF MAIN PROGRAM
      STOP
      END
C*****************************************************************************
      SUBROUTINE ZERO1D (SUM)
C*****************************************************************************
      DIMENSION BUFF(40,180,2,26),XTIME(26),SUMIN(26),SUMOUT(26),
     -  SUMTOT(26),SUM(26)
      CHARACTER*16 TEXT,TEXTID
      COMMON /BIGX/ BUFF,XTIME,SUMIN,SUMOUT,SUMTOT
      COMMON /BIGI/ NCOL,NROW,NLAY,NYEARS
      COMMON /BIGC/ TEXT,TEXTID
C--ZERO 1-DIMENSIONAL BUFFER
      DO 100 I=1,NYEARS
        SUM(I)=0.
  100 CONTINUE
      RETURN
      END
C*****************************************************************************
      SUBROUTINE ZERO4D
C*****************************************************************************
      DIMENSION BUFF(40,180,2,26),XTIME(26),SUMIN(26),SUMOUT(26),
     -  SUMTOT(26)
      CHARACTER*16 TEXT,TEXTID
      COMMON /BIGX/ BUFF,XTIME,SUMIN,SUMOUT,SUMTOT
      COMMON /BIGI/ NCOL,NROW,NLAY,NYEARS
      COMMON /BIGC/ TEXT,TEXTID
C--ZERO 4-DIMENISONAL BUFFER
      DO 100 L=1,NYEARS
      DO 100 K=1,NLAY
      DO 100 J=1,NROW
      DO 100 I=1,NCOL
        BUFF(I,J,K,L)=0.
  100 CONTINUE
      RETURN
      END
********************************************************************************
      SUBROUTINE BUFFRD (IREAD)
********************************************************************************
      DIMENSION BUFF(40,180,2,26),XTIME(26),SUMIN(26),SUMOUT(26),
     -  SUMTOT(26),JUNK(40,180,2)
      CHARACTER*16 TEXT,TEXTID
      COMMON /BIGX/ BUFF,XTIME,SUMIN,SUMOUT,SUMTOT
      COMMON /BIGI/ NCOL,NROW,NLAY,NYEARS
      COMMON /BIGC/ TEXT,TEXTID
C--READ BUFFER OF CELL-BY-CELL FLUXES
      DO 100 N=1,9999
      READ(IREAD,END=101)KSTP,KPER,TEXT,NCOL,NROW,NLAY
      WRITE(6,901)KSTP,KPER,TEXT,NCOL,NROW,NLAY
  901 FORMAT(2I10,5X,A16,3I10)
      IF(TEXT.EQ.TEXTID)THEN
          READ(IREAD,END=101)(((BUFF(I,J,K,KPER),I=1,NCOL)
     - ,J=1,NROW),K=1,NLAY)
          WRITE(6,900)TEXT,TEXTID
        ELSE
          READ(IREAD,END=101)(((JUNK(I,J,K),I=1,NCOL)
     - ,J=1,NROW),K=1,NLAY)
      ENDIF
  100 CONTINUE
  101 CONTINUE
  900 FORMAT(A16,5X,A16)
      RETURN
      END
********************************************************************************
      SUBROUTINE ZONEBD (IREAD,IOUT,IFLAG)
********************************************************************************
      DIMENSION BUFF(40,180,2,26),XTIME(26),SUMIN(26),SUMOUT(26),
     -  SUMTOT(26),SUMACF(26)
      CHARACTER*16 TEXT,TEXTID
      CHARACTER*80 NAME
      COMMON /BIGX/ BUFF,XTIME,SUMIN,SUMOUT,SUMTOT
      COMMON /BIGI/ NCOL,NROW,NLAY,NYEARS
      COMMON /BIGC/ TEXT,TEXTID
C--SUM CELL-BY-CELL FLUXES FOR DEFINED AREAS AND TOPICS
      READ(IREAD,900,END=700)NAME
      READ(IREAD,901,END=700)NCELLS
      IF(NCELLS.EQ.0) GOTO 800
      DO 200 N=1,NCELLS
      READ(IREAD,901)ILAY,IROW,ICOL
      DO 100 L=1,NYEARS
      B=BUFF(ICOL,IROW,ILAY,L)
      IF(B.GT.0.)SUMIN(L)=SUMIN(L)+B
      IF(B.LT.0.)SUMOUT(L)=SUMOUT(L)+B
      SUMTOT(L)=SUMTOT(L)+B
  100 CONTINUE
  200 CONTINUE
      DO 300 L=1,NYEARS
      SUMACF(L)=SUMTOT(L)*365.*86400./43560.
  300 CONTINUE
C  WRITE OUT ZONE BUDGET TO A SEPARATE FILE
      WRITE(IOUT,900)NAME
      WRITE(IOUT,903)TEXTID
      WRITE(IOUT,902)(XTIME(L),SUMIN(L),SUMOUT(L),SUMTOT(L),
     -  SUMACF(L),L=1,NYEARS)
      GOTO 800
  700 IFLAG=0
  800 CONTINUE
C  FORMAT STATEMENTS
  900 FORMAT(A80)
  901 FORMAT(8I10)
  902 FORMAT(4F10.2,F10.0)
  903 FORMAT('WATER YEAR   SUM IN   SUM OUT  SUM TOTAL  SUM ACFT',
     - '  -- FOR ',A16)
      RETURN
      END
