SUBROUTINE WELLFORC(NIBEG,NIEND,IBEG,IEND,IEND9,NICNT,ICNT,ICNT9,
     +                    LOSS,IHIST)
C
C Subroutine is called from PREMAIN.FOR and uses Maddock's 27 stress period 
C file (TRWELLS.DAT) to forecast a new, 2 (user-specified) stress periods 
C per year file (TWELLS.DAT).  Season lengths are specified in PREMAIN.FOR.
C Maddock's entire file is read, leaving the 27th stress period data (1990) 
C in memory for use as a template in creating the new file.  Municipal and 
C industrial (M&I) and mountain front recharge (MFR) wells are assumed to be 
C independent of river flow.  User-defined stress periods for the non-irrigation 
C (NI) and irrigation (I) seasons are used with a monthly M&I demand 
C distribution to convert Maddock's M&I values into one for each season.  MFR 
C pumping is constant throughout the year and Maddock's values are used 
C directly.  Maddock used Net Irrigation with respect to the irrigation wells 
C (IW) whereas Boyle will use flow that is dependent on the supply from three 
C diverting canals (Leasburg, Eastside, and Westside from the BESTSM output 
C file BESTINT.DAT), demand (CROPDEM.DAT), well capacities (WELLCAP.DAT), and 
C the distribution of irrigation (IRRDIST.DAT).  A monthly ET demand distribution 
C from Maddock's report, page 2-8, is used to adjust the IW pumping demand 
C based on the user specified stress period length.
C
      INTEGER  NIBEG,NIEND,IBEG,IEND,IEND9,APPRATE,LOSS
      INTEGER  NICNT,ICNT,ICNT9,ICNTS,I,J,K,L,M
      INTEGER  WELLCOUNT,ICOUNT,ISPCNT,IYRCNT
      REAL  NIMIDEM,IMIDEM,IMIDEM9,NIETDEM,IETDEM,IETDEM9,
      REAL  NIPCPTN,IPCPTN,IPCPTN9,NIPUMP,IPUMP
      REAL  R(800),C(800),WT(800),MIFLOW(800)
      REAL  LYR(800),ROW(800),COL(800),FLOW(800),NIFLOW(800),IFLOW(800)
C
      OPEN(1,"TRWELLS.DAT",STATUS="OLD")
      OPEN(2,"BESTINT.DAT",STATUS="OLD")      
      OPEN(3,"CROPDEM.DAT",STATUS="OLD")
      OPEN(4,"WELLCAP.DAT",STATUS="OLD")
      OPEN(6,"TWELLS.DAT",STATUS="UNKNOWN")
      OPEN(7,"PUMPING.DAT",STATUS="UNKNOWN")
C
C  OPEN DELPER.DAT TO USE FOR HISTORIC RUN ONLY
C
      IF(IHIST .EQ. 1) THEN
         OPEN(8,"DELPER.DAT",STATUS="UNKNOWN")
      ENDIF
C
C Set the number of stress periods contained in the initial file and number    
C of years to be forecasted.
C     
      ISPCNT=27
      IYRCNT=81
C
C Call sub to read the monthly MI and ET demand functions and add up the total 
C non-irrigation and irrigation seasons.
C
      CALL DEMANDS(NIBEG,NIEND,IBEG,IEND,IEND9,NIMIDEM,IMIDEM,
     +           IMIDEM9,NIETDEM,IETDEM,IETDEM9,NIPCPTN,IPCPTN,IPCPTN9)
C
C Read header from Maddock's file (max # wells = 795 and IDUM flag = 0). 
C
      READ(1,96) IMAX, IDUM
      WRITE(6,96) IMAX, IDUM
C        
C Read Maddock's 27 stress periods and assign wells to M&I, MFR, and IW.  M&I 
C wells come first, followed by MFR wells beginning on LYR 1, ROW 1, COL 30, 
C and then Maddock's NIF wells beginning on LYR 1, ROW 16, COL 9.  M&I flow 
C values are read and converted to two season flows, based on the user-specified 
C season lengths -- (DO THIS LATER IN THE YEAR LOOP).  MFR flows are read and
C used as they are in Maddock's file.  The first NIF well is used as a flag to
C exit the read loop and call the PUMPING subroutine.  Flows are in CFS.
C     
      DO 60 I=1,ISPCNT
        READ(1,96) WELLCOUNT
        DO 10 K=1,WELLCOUNT
          READ(1,96,END=98) LYR(K),ROW(K),COL(K),FLOW(K)
   10   CONTINUE
C
C Initialize records to M&I (first M&I record is not always LYR1, ROW 28, COL 46 so cannot use IF(ROW(K).EQ.28.AND.COL(K).EQ.46) THEN ...
C
        DO 20 K=1,WELLCOUNT    
          IF(ROW(K).EQ.1.AND.COL(K).EQ.30) GOTO 30  
          MIFLOW(K)=FLOW(K)
          NIFLOW(K)=FLOW(K)
          IFLOW(K)=FLOW(K)
   20   CONTINUE
   30   MFRSTART=K
        DO 40 J=K,WELLCOUNT    
          IF(ROW(J).EQ.16.AND.COL(J).EQ.9) GOTO 50              
          NIFLOW(J)=FLOW(J)
          IFLOW(J)=FLOW(J)
   40   CONTINUE
   50   IWSTART=J    
   60 CONTINUE
C
C Calculate number of Boyle wells = 423 irrigation wells + J-1 M&I/MFR wells.
C
      ICOUNT = 423 + IWSTART - 1
C
C Write output using the 27th stress period as a template for well locations.  
C Write M&I and MFR for NI stress period while reading IRRDIST.DAT and 
C calculating puming for both NI and I periods.  Calculate IW flows for both 
C periods and write it for the NI period.  Then, write M&I, MFR, and IW for 
C I stress period.  This sequence is followed so that IRRDIST.DAT is read only 
C once per year and used to calculate both NI and I pumping rates for IW's.
C All pumping values are in CFS.
C
      DO 95 M=1,IYRCNT
        IF (M.EQ.IYRCNT) THEN
          ICNT = ICNT9
          IETDEM = IETDEM9
          IMIDEM = IMIDEM9
          IPCPTN = IPCPTN9
        ENDIF
C
C READ PERCENT HEADGATE DIVERSION LOST IN CANALS FOR HISTORIC RUN,
C       (DELPER.DAT) LOSS CHANGES EACH YEAR
C
        IF(IHIST .EQ. 1) THEN
          READ(8,'(I10,F10.0)') IDELYR, LOSS
        ENDIF
C
C
        CALL PUMPING(NIBEG,NICNT,ICNT,NIETDEM,IETDEM,NIPCPTN,
     +     IPCPTN,NIPUMP,IPUMP,LOSS)

        WRITE(7,*) M,NIPUMP,IPUMP
        OPEN(5,"IRRDIST.DAT",STATUS="OLD")
        WRITE(6,96) ICOUNT
        DO 70 J=1,WELLCOUNT
          IF(J.LT.IWSTART) THEN
C
C  Convert all M&I well flows from one annual to two seasonal flows.
C
            IF(J.LT.MFRSTART) THEN
              NIFLOW(J)=MIFLOW(J)*NIMIDEM*12/NICNT
              IFLOW(J)=MIFLOW(J)*IMIDEM*12/ICNT
            ENDIF
C
C  Write M&I and MFR well data.
C
            WRITE(6,96) LYR(J),ROW(J),COL(J),NIFLOW(J)
          ELSE
            READ(5,97,END=80) R(J),C(J),WT(J)
            NIFLOW(J) = -1 * NIPUMP * WT(J) 
            IFLOW(J) = -1 * IPUMP * WT(J) 
            WRITE(6,96) LYR(J),R(J),C(J),NIFLOW(J)
          ENDIF
   70   CONTINUE
   80   CLOSE(5)
        WRITE(6,96) ICOUNT
        DO 90 L=1,WELLCOUNT
          IF(L.LT.IWSTART) THEN
            WRITE(6,96) LYR(L),ROW(L),COL(L),IFLOW(L)
          ELSE
            WRITE(6,96) LYR(L),R(L),C(L),IFLOW(L)
          ENDIF
   90   CONTINUE
   95 CONTINUE
C        
   96 FORMAT(3I10,F10.4)
   97 FORMAT(2I8,F8.6)
   98 CLOSE(1)     
      CLOSE(2)
      CLOSE(3)
      CLOSE(4)
      CLOSE(6)
      CLOSE(7)
C
C CLOSE DELPER.DAT (8) FOR THE HISTORIC RUN ONLY
C
      IF(IHIST .EQ. 1) THEN
        CLOSE(8)
      ENDIF

      END
C
C
**********************************************************************************************
      SUBROUTINE SKIPP(NFR,FRW,NSKIP)
C
C Read over NSKIP lines in file NFR.
C
      CHARACTER REC*250
C
      DO 200 I=1,NSKIP
        READ(NFR,210,END=220) REC
        IF(NFW.NE.0) WRITE(NFW,210) REC
  200 CONTINUE
C
  210 FORMAT(A)
C
  220 RETURN
      END
C
C
************************************************************************************************
      SUBROUTINE PUMPING(NIBEG,NICNT,ICNT,NIETDEM,IETDEM,
     +        NIPCPTN,IPCPTN,NIPUMP,IPUMP,LOSS)
C
C Compare supply and demand for each season to well capacity to determine pumping demand.
C
      INTEGER  NIBEG,NICNT,ICNT,LOSS,MO2,YR3,YR2,YR4
      REAL  NIETDEM,IETDEM,NIPCPTN,IPCPTN,NIPUMP,IPUMP,PRECIP
      REAL  Q1,Q2AG,Q3AG,Q4AG,ET,AC,CAP,NISUP,ISUP,NIDEM,IDEM
      REAL  Q2MI,NICAP,ICAP,APPRATE
C
C Calculate total seasonal supply in AF for each season.  Supply that makes it 
C to the farm = diversion from canals - export to Las Cruces (CRUEXP already
C in CFS) * (100% - % of canal losses - % canal returns).  Delivery percent according to
C Hamilton & Maddock, averaged 47%, page 4-38 for 1930-1990.
C Preprocessor uses average 27% for canal RETURNS (one component of losses).
c User specifies percent canal LOSS (other component of losses, typically 26%).
c Therefore, losses total 53% (27% + 26%), and delivery = 47%.
C Add in precipitation based on the seasonal
C distribution in subroutine DEMANDS with units = AF/season.
C
      NISUP=0.
      ISUP=0.
C
C     CONVERT M&I SUPPLY TO ACRE-FT/MONTH
C
      READ(3,340,END=300) YR3,ET,AC,PRECIP,APPRATE
  300 READ(2,330,END=325) YR2,MO2,Q1,Q2AG,Q2MI,Q3AG,Q4AG
      NISUP = (Q2AG + Q3AG + Q4AG)*((100.
     !         -LOSS-27.)/100.)
      IF(MO2.EQ.NIBEG) THEN
        DO 310 I=1,NICNT-1
          READ(2,330,END=325) YR2,MO2,Q1,Q2AG,Q2MI,Q3AG,Q4AG
          NISUP = NISUP + (Q2AG + Q3AG + Q4AG)*((100.-LOSS-27.)
     !            /100.)
310   CONTINUE
        DO 320 J=1,ICNT
          READ(2,330,END=325) YR2,MO2,Q1,Q2AG,Q2MI,Q3AG,Q4AG
          ISUP = ISUP + (Q2AG + Q3AG + Q4AG)*((100.-LOSS-27.)/100.)
  320   CONTINUE
      ELSE
        GOTO 300
      ENDIF

  325 NISUP = NISUP + 0.78*PRECIP*NIPCPTN*AC
      ISUP  = ISUP  + 0.78*PRECIP*IPCPTN*AC

c Supply above consists of surface water supply plus effective rain.
c Value of .98 yields good agreement with pumping estimates by Lang
c and Maddock. Hamilton and Maddock used .9 of growing season rain
c over irrig land and .2 of annual rain over non-irrig land. 
C Calculate total seasonal demand in AF for each seasons.  Rather than basing
C demand on ET, allow user to vary the application rate.  Probably near 5 ft/year 
C from Lang * Maddock, Table 5-1, page 5-17.
C


      NIDEM = APPRATE * AC * NIETDEM
      IDEM = APPRATE * AC * IETDEM
C
C Read total yearly well capacity in AF per year.  Assuming historical data
C was based on an 8 month irrigation season only.  Normalize capacity to 8
C months.
C
      READ(4,350,END=327) YR4,CAP
  327 NICAP = CAP * NICNT / 8
      ICAP = CAP * ICNT / 8
C
C Calculate NI season pumping rate in AF per season.
C
      IF(NISUP.GE.NIDEM) THEN
        NIPUMP = 0.
      ELSE
        NIPUMP = (NIDEM - NISUP)
      ENDIF
      IF(NIPUMP.GE.NICAP) NIPUMP=NICAP
C
C Calculate I season pumping rate in AF per season.
C
      IF(ISUP.GE.IDEM) THEN
        IPUMP = 0.
      ELSE 
        IPUMP = (IDEM - ISUP)
      ENDIF
      IF(IPUMP.GE.ICAP) IPUMP=ICAP
C
C Convert NI and I season pumping rates into CFS.
C
      NIPUMP = NIPUMP * 43560 / NICNT / 30.4 / 86400 
      IPUMP = IPUMP * 43560 / ICNT / 30.4 / 86400       
C
  330 FORMAT(I7,I3,5F12.0)
  340 FORMAT(6X,I4,F10.1,I10,F10.3,F10.2)  
  350 FORMAT(6X,I4,F10.0)
      RETURN
      END