C*******************************************************************************
C  MAKE.PRECIP.F77 -- A PROGRAM TO MAKE A PRECIPITATION FILE USING LAND
C  SURFACE DATUM AND A REGRESSION EQUATION PLUS ANNUAL VALUES OF PRECIPITATION.
C
C               BY   WES DANSKIN
C                    LAST REVISION 1/20/89
C
C*******************************************************************************
      DIMENSION XLSD(180,40),IBOUND(180,40),PRECIP(180,40),AMULT(30),
     - SUM(30)
      CHARACTER*80 HEADNG
C DEFINE SIZE OF GRID LOOPS
C      NROW=180
C      NCOL=40
C      NLAY=2
C      NYEARS=26
C  READ CONTROL PARAMETERS
      READ(29,902)HEADNG
      WRITE(6,902)HEADNG
      READ(29,902)HEADNG
      WRITE(6,902)HEADNG
      READ(29,906)NLAY,NROW,NCOL,NYEARS
      WRITE(6,906)NLAY,NROW,NCOL,NYEARS
C  ZERO ARRAYS
      DO 10 I=1,NROW
      DO 10 J=1,NCOL
      IBOUND(I,J)=0
   10 CONTINUE
      CALL ZERO2D(XLSD,NROW,NCOL)
      CALL ZERO2D(PRECIP,NROW,NCOL)
      DO 12 I=1,NYEARS
      AMULT(I)=0.
      SUM(I)=0.
   12 CONTINUE
C  DEFINE CONSTANTS
      CINCFS=1./12.*2000.*2000./365./86400.
C  READ IBOUND FOR LAYER 1
      DO 100 I=1,NROW
      READ(51,900) (IBOUND(I,J),J=1,NCOL)
      WRITE(6,900) (IBOUND(I,J),J=1,NCOL)
  100 CONTINUE
C  READ LAND SURFACE DATUM
      IN=60
      IOUT=6
      SCALE=1.0
      CALL READ2D(XLSD,NROW,NCOL,IN,SCALE)
      CALL WRIT2D(XLSD,NROW,NCOL,IOUT)
C  READ ANNUAL MULTIPLIERS
      DO 250 I=1,NYEARS
      READ(40,903) AMULT(I)
      WRITE(6,903) AMULT(I)
  250 CONTINUE
      SUMLT=0.
      DO 300 I=1,NROW
      DO 300 J=1,NCOL
      IF(IBOUND(I,J).EQ.0) GOTO 290
C  REGRESSION EQUATION FOR ALL STATIONS FOR 1963-1984 WY
      PRECIP(I,J)=XLSD(I,J)*0.00245-3.205
C  NORMALIZE TO LONG-TERM INDEPENDENCE VALUE
C    1963-1984 AVERAGE = 5.98 IN/YR
C    99 YEAR AVERAGE = 5.10 IN/YR
      XINDEP=5.10/5.98
      PRECIP(I,J)=PRECIP(I,J)*XINDEP
      SUMLT=SUMLT+PRECIP(I,J)*CINCFS
      IF(IBOUND(I,J).EQ.0) WRITE(95,913)I,J
  290 CONTINUE
  300 CONTINUE
C WRITE OUT LONGTERM AVERAGE PRECIP ARRAY
      IYEAR=9999
      IOUT=7
      WRITE(7,904)IYEAR,SUMLT
      WRITE(90,904)IYEAR,SUMLT
      CALL WRIT2D(PRECIP,NROW,NCOL,IOUT)
C  CREATE PRECIP ARRAYS FOR SPECIFIC YEARS
      DO 600 K=1,NYEARS
C  RE-ZERO ARRAYS
      CALL ZERO2D(PRECIP,NROW,NCOL)
      SUM(K)=0.
      DO 500 I=1,NROW
      DO 500 J=1,NCOL
      IF(IBOUND(I,J).EQ.0) GOTO 450
C  REGRESSION EQUATION FOR ALL STATIONS FOR 1963-1984 WY
      PRECIP(I,J)=XLSD(I,J)*0.00245-3.205
C  NORMALIZE TO LONG-TERM INDEPENDENCE VALUE
C    1963-1984 AVERAGE = 5.98 IN/YR
C    99 YEAR AVERAGE = 5.10
      XINDEP=5.10/5.98
      XINDEP=XINDEP*AMULT(K)/5.10
      PRECIP(I,J)=PRECIP(I,J)*XINDEP
      SUM(K)=SUM(K)+PRECIP(I,J)*CINCFS
      IF(IBOUND(I,J).EQ.0) WRITE(95,913)I,J
  450 CONTINUE
  500 CONTINUE
C  WRITE OUT HEADER INFORMATION
      IYEAR=1962+K
      IOUT=30
      WRITE(IOUT,904)IYEAR,SUM(K)
      WRITE(90,904)IYEAR,SUM(K)
      IF(K.EQ.1) WRITE(31,904)IYEAR,SUM(K)
      IF(K.EQ.22) WRITE(32,904)IYEAR,SUM(K)
C  WRITE OUT ARRAYS
      IOUT=30
      CALL WRIT2D(PRECIP,NROW,NCOL,IOUT)
      IOUT=31
      IF(K.EQ.1) CALL WRIT2D(PRECIP,NROW,NCOL,IOUT)
      IOUT=32
      IF(K.EQ.22) CALL WRIT2D(PRECIP,NROW,NCOL,IOUT)
  600 CONTINUE
C  FORMAT STATEMENTS
  900 FORMAT(40I3)
  901 FORMAT(8F10.0)
  902 FORMAT(A80)
  903 FORMAT(F10.2)
  904 FORMAT(I10,'WY  ***  TOTAL PRECIPITATION IN CFS = ',F10.2)
  905 FORMAT(8F10.3)
  906 FORMAT(4I10)
  913 FORMAT('ERROR -- NODE ',2I5,' IS NOT ACTIVE')
      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 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