1      SUBROUTINE DRN5AL(ISUM,LENX,LCDRAI,NDRAIN,MXDRN,IN,IOUT,IDRNCB,
2     1        NDRNVL,IDRNAL,IFREFM)
3C
4C-----VERSION 0841 21FEB1996 DRN5AL
5C     ******************************************************************
6C     ALLOCATE ARRAY STORAGE FOR DRAIN PACKAGE
7C     ******************************************************************
8C
9C        SPECIFICATIONS:
10C     ------------------------------------------------------------------
11      COMMON /DRNCOM/DRNAUX(5)
12      CHARACTER*16 DRNAUX
13      CHARACTER*80 LINE
14C     ------------------------------------------------------------------
15C
16C1------IDENTIFY PACKAGE AND INITIALIZE NDRAIN.
17      WRITE(IOUT,1)IN
18    1 FORMAT(1X,/1X,'DRN5 -- DRAIN PACKAGE, VERSION 5, 9/1/93',
19     1' INPUT READ FROM UNIT',I3)
20      NDRAIN=0
21C
22C2------READ MAXIMUM NUMBER OF DRAINS AND UNIT OR FLAG FOR
23C2------CELL-BY-CELL FLOW TERMS.
24      READ(IN,'(A)') LINE
25      IF(IFREFM.EQ.0) THEN
26         READ(LINE,'(2I10)') MXDRN,IDRNCB
27         LLOC=21
28      ELSE
29         LLOC=1
30         CALL URWORD(LINE,LLOC,ISTART,ISTOP,2,MXDRN,R,IOUT,IN)
31         CALL URWORD(LINE,LLOC,ISTART,ISTOP,2,IDRNCB,R,IOUT,IN)
32      END IF
33      WRITE(IOUT,3) MXDRN
34    3 FORMAT(1X,'MAXIMUM OF',I5,' DRAINS')
35      IF(IDRNCB.LT.0) WRITE(IOUT,7)
36    7 FORMAT(1X,'CELL-BY-CELL FLOWS WILL BE PRINTED WHEN ICBCFL NOT 0')
37      IF(IDRNCB.GT.0) WRITE(IOUT,8) IDRNCB
38    8 FORMAT(1X,'CELL-BY-CELL FLOWS WILL BE SAVED ON UNIT',I3)
39C
40C3------READ AUXILIARY PARAMETERS AND CBC ALLOCATION OPTION.
41      IDRNAL=0
42      NAUX=0
43   10 CALL URWORD(LINE,LLOC,ISTART,ISTOP,1,N,R,IOUT,IN)
44      IF(LINE(ISTART:ISTOP).EQ.'CBCALLOCATE' .OR.
45     1   LINE(ISTART:ISTOP).EQ.'CBC') THEN
46         IDRNAL=1
47         WRITE(IOUT,11)
48   11    FORMAT(1X,'MEMORY IS ALLOCATED FOR CELL-BY-CELL BUDGET TERMS')
49         GO TO 10
50      ELSE IF(LINE(ISTART:ISTOP).EQ.'AUXILIARY' .OR.
51     1        LINE(ISTART:ISTOP).EQ.'AUX') THEN
52         CALL URWORD(LINE,LLOC,ISTART,ISTOP,1,N,R,IOUT,IN)
53         IF(NAUX.LT.5) THEN
54            NAUX=NAUX+1
55            DRNAUX(NAUX)=LINE(ISTART:ISTOP)
56            WRITE(IOUT,12) DRNAUX(NAUX)
57   12       FORMAT(1X,'AUXILIARY DRAIN PARAMETER: ',A)
58         END IF
59         GO TO 10
60      END IF
61      NDRNVL=5+NAUX+IDRNAL
62C
63C4------ALLOCATE SPACE IN THE X ARRAY FOR THE DRAI ARRAY.
64      LCDRAI=ISUM
65      ISP=NDRNVL*MXDRN
66      ISUM=ISUM+ISP
67C
68C5------PRINT AMOUNT OF SPACE USED BY DRAIN PACKAGE.
69      WRITE(IOUT,14) ISP
70   14 FORMAT(1X,I10,' ELEMENTS IN X ARRAY ARE USED BY DRN')
71      ISUM1=ISUM-1
72      WRITE(IOUT,15) ISUM1,LENX
73   15 FORMAT(1X,I10,' ELEMENTS OF X ARRAY USED OUT OF ',I10)
74      IF(ISUM1.GT.LENX) WRITE(IOUT,16)
75   16 FORMAT(1X,'   ***X ARRAY MUST BE DIMENSIONED LARGER***')
76C
77C6------RETURN.
78      RETURN
79      END
80      SUBROUTINE DRN5RP(DRAI,NDRAIN,MXDRN,IN,IOUT,NDRNVL,IDRNAL,IFREFM)
81C
82C-----VERSION 0845 21FEB1996 DRN5RP
83C     ******************************************************************
84C     READ DRAIN LOCATIONS, ELEVATIONS, AND CONDUCTANCES
85C     ******************************************************************
86C
87C        SPECIFICATIONS:
88C     ------------------------------------------------------------------
89      DIMENSION DRAI(NDRNVL,MXDRN)
90      COMMON /DRNCOM/DRNAUX(5)
91      CHARACTER*16 DRNAUX
92      CHARACTER*151 LINE
93C     ------------------------------------------------------------------
94C
95C1------READ ITMP (NUMBER OF DRAIN CELLS OR FLAG TO REUSE DATA).
96      IF(IFREFM.EQ.0) THEN
97         READ(IN,'(I10)') ITMP
98      ELSE
99         READ(IN,*) ITMP
100      END IF
101C
102C2------TEST ITMP.
103      IF(ITMP.GE.0) GO TO 50
104C
105C2A-----IF ITMP<0 THEN REUSE DATA FROM LAST STRESS PERIOD.
106      WRITE(IOUT,7)
107    7 FORMAT(1X,/1X,'REUSING DRAINS FROM LAST STRESS PERIOD')
108      RETURN
109C
110C3------IF ITMP=>0 THEN IT IS THE NUMBER OF DRAINS.
111   50 NDRAIN=ITMP
112      IF(NDRAIN.LE.MXDRN) GO TO 100
113C
114C4------IF NDRAIN>MXDRN THEN STOP.
115      WRITE(IOUT,99) NDRAIN,MXDRN
116   99 FORMAT(1X,/1X,'NDRAIN(',I4,') IS GREATER THAN MXDRN(',I4,')')
117      STOP
118C
119C5------PRINT NUMBER OF DRAINS IN THIS STRESS PERIOD.
120  100 WRITE(IOUT,101) NDRAIN
121  101 FORMAT(1X,//1X,I5,' DRAINS')
122C
123C6------IF THERE ARE NO DRAINS THEN RETURN.
124      IF(NDRAIN.EQ.0) GO TO 260
125C
126C7------READ AND PRINT DATA FOR EACH DRAIN.
127      NAUX=NDRNVL-5-IDRNAL
128      MAXAUX=NDRNVL-IDRNAL
129      IF(NAUX.GT.0) THEN
130         WRITE(IOUT,103) (DRNAUX(JJ),JJ=1,NAUX)
131         WRITE(IOUT,104) ('------------------',JJ=1,NAUX)
132      ELSE
133         WRITE(IOUT,103)
134         WRITE(IOUT,104)
135      END IF
136  103 FORMAT(1X,/1X,'LAYER   ROW   COL   ELEVATION   CONDUCTANCE   ',
137     1           'DRAIN NO.',:5(2X,A))
138  104 FORMAT(1X,55('-'),5A)
139      DO 250 II=1,NDRAIN
140C7A-----READ THE REQUIRED DATA WITH FIXED OR FREE FORMAT.
141      READ(IN,'(A)') LINE
142      IF(IFREFM.EQ.0) THEN
143         READ(LINE,'(3I10,2F10.0)') K,I,J,(DRAI(JJ,II),JJ=4,5)
144         LLOC=51
145      ELSE
146         LLOC=1
147         CALL URWORD(LINE,LLOC,ISTART,ISTOP,2,K,R,IOUT,IN)
148         CALL URWORD(LINE,LLOC,ISTART,ISTOP,2,I,R,IOUT,IN)
149         CALL URWORD(LINE,LLOC,ISTART,ISTOP,2,J,R,IOUT,IN)
150         CALL URWORD(LINE,LLOC,ISTART,ISTOP,3,N,DRAI(4,II),IOUT,IN)
151         CALL URWORD(LINE,LLOC,ISTART,ISTOP,3,N,DRAI(5,II),IOUT,IN)
152      END IF
153C7B-----READ ANY AUXILIARY DATA WITH FREE FORMAT, AND PRINT ALL VALUES.
154      IF(NAUX.GT.0) THEN
155         DO 110 JJ=1,NAUX
156         CALL URWORD(LINE,LLOC,ISTART,ISTOP,3,N,DRAI(JJ+5,II),IOUT,IN)
157  110    CONTINUE
158         WRITE (IOUT,115) K,I,J,DRAI(4,II),DRAI(5,II),II,
159     1         (DRAI(JJ,II),JJ=6,MAXAUX)
160      ELSE
161         WRITE (IOUT,115) K,I,J,DRAI(4,II),DRAI(5,II),II
162      END IF
163  115 FORMAT(1X,I4,I7,I6,G13.4,G14.4,I8,:5(2X,G16.5))
164      DRAI(1,II)=K
165      DRAI(2,II)=I
166      DRAI(3,II)=J
167  250 CONTINUE
168C
169C8------RETURN.
170  260 RETURN
171C
172      END
173      SUBROUTINE DRN5FM(NDRAIN,MXDRN,DRAI,HNEW,HCOF,RHS,IBOUND,
174     1              NCOL,NROW,NLAY,NDRNVL)
175C
176C-----VERSION 1050 16JULY1992 DRN5FM
177C     ******************************************************************
178C     ADD DRAIN FLOW TO SOURCE TERM
179C     ******************************************************************
180C
181C        SPECIFICATIONS:
182C     ------------------------------------------------------------------
183      DOUBLE PRECISION HNEW,EEL
184C
185      DIMENSION DRAI(NDRNVL,MXDRN),HNEW(NCOL,NROW,NLAY),
186     1         RHS(NCOL,NROW,NLAY),IBOUND(NCOL,NROW,NLAY),
187     1         HCOF(NCOL,NROW,NLAY)
188C     ------------------------------------------------------------------
189C
190C1------IF NDRAIN<=0 THERE ARE NO DRAINS. RETURN.
191      IF(NDRAIN.LE.0) RETURN
192C
193C2------PROCESS EACH CELL IN THE DRAIN LIST.
194      DO 100 L=1,NDRAIN
195C
196C3------GET COLUMN, ROW AND LAYER OF CELL CONTAINING DRAIN.
197      IL=DRAI(1,L)
198      IR=DRAI(2,L)
199      IC=DRAI(3,L)
200C
201C4-------IF THE CELL IS EXTERNAL SKIP IT.
202      IF(IBOUND(IC,IR,IL).LE.0) GO TO 100
203C
204C5-------IF THE CELL IS INTERNAL GET THE DRAIN DATA.
205      EL=DRAI(4,L)
206      EEL=EL
207C
208C6------IF HEAD IS LOWER THAN DRAIN THEN SKIP THIS CELL.
209      IF(HNEW(IC,IR,IL).LE.EEL) GO TO 100
210C
211C7------HEAD IS HIGHER THAN DRAIN. ADD TERMS TO RHS AND HCOF.
212      C=DRAI(5,L)
213      HCOF(IC,IR,IL)=HCOF(IC,IR,IL)-C
214      RHS(IC,IR,IL)=RHS(IC,IR,IL)-C*EL
215  100 CONTINUE
216C
217C8------RETURN.
218      RETURN
219      END
220      SUBROUTINE DRN5BD(NDRAIN,MXDRN,VBNM,VBVL,MSUM,DRAI,DELT,HNEW,
221     1        NCOL,NROW,NLAY,IBOUND,KSTP,KPER,IDRNCB,ICBCFL,BUFF,IOUT,
222     2        PERTIM,TOTIM,NDRNVL,IDRNAL)
223C-----VERSION 1052 06APRIL1993 DRN5BD
224C     ******************************************************************
225C     CALCULATE VOLUMETRIC BUDGET FOR DRAINS
226C     ******************************************************************
227C
228C        SPECIFICATIONS:
229C     ------------------------------------------------------------------
230      CHARACTER*16 VBNM(MSUM),TEXT
231      DOUBLE PRECISION HNEW,HHNEW,EEL,CC,CEL,RATOUT,QQ
232C
233      DIMENSION VBVL(4,MSUM),DRAI(NDRNVL,MXDRN),HNEW(NCOL,NROW,NLAY),
234     1          IBOUND(NCOL,NROW,NLAY),BUFF(NCOL,NROW,NLAY)
235C
236      DATA TEXT /'          DRAINS'/
237C     ------------------------------------------------------------------
238C
239C1------INITIALIZE CELL-BY-CELL FLOW TERM FLAG (IBD) AND
240C1------ACCUMULATOR (RATOUT).
241      ZERO=0.
242      RATOUT=ZERO
243      IBD=0
244      IF(IDRNCB.LT.0 .AND. ICBCFL.NE.0) IBD=-1
245      IF(IDRNCB.GT.0) IBD=ICBCFL
246      IBDLBL=0
247C
248C2------IF CELL-BY-CELL FLOWS WILL BE SAVED AS A LIST, WRITE HEADER.
249      IF(IBD.EQ.2) CALL UBDSV2(KSTP,KPER,TEXT,IDRNCB,NCOL,NROW,NLAY,
250     1          NDRAIN,IOUT,DELT,PERTIM,TOTIM,IBOUND)
251C
252C3------CLEAR THE BUFFER.
253      DO 50 IL=1,NLAY
254      DO 50 IR=1,NROW
255      DO 50 IC=1,NCOL
256      BUFF(IC,IR,IL)=ZERO
25750    CONTINUE
258C
259C4------IF THERE ARE NO DRAINS THEN DO NOT ACCUMULATE DRAIN FLOW.
260      IF(NDRAIN.LE.0) GO TO 200
261C
262C5------LOOP THROUGH EACH DRAIN CALCULATING FLOW.
263      DO 100 L=1,NDRAIN
264C
265C5A-----GET LAYER, ROW & COLUMN OF CELL CONTAINING REACH.
266      IL=DRAI(1,L)
267      IR=DRAI(2,L)
268      IC=DRAI(3,L)
269      Q=ZERO
270C
271C5B-----IF CELL IS NO-FLOW OR CONSTANT-HEAD, IGNORE IT.
272      IF(IBOUND(IC,IR,IL).LE.0) GO TO 99
273C
274C5C-----GET DRAIN PARAMETERS FROM DRAIN LIST.
275      EL=DRAI(4,L)
276      EEL=EL
277      C=DRAI(5,L)
278      HHNEW=HNEW(IC,IR,IL)
279C
280C5D-----IF HEAD HIGHER THAN DRAIN, CALCULATE Q=C*(EL-HHNEW).
281C5D-----SUBTRACT Q FROM RATOUT.
282      IF(HHNEW.GT.EEL) THEN
283         CC=C
284         CEL=C*EL
285         QQ=CEL - CC*HHNEW
286         Q=QQ
287         RATOUT=RATOUT-QQ
288      END IF
289C
290C5E-----PRINT THE INDIVIDUAL RATES IF REQUESTED(IDRNCB<0).
291      IF(IBD.LT.0) THEN
292         IF(IBDLBL.EQ.0) WRITE(IOUT,61) TEXT,KPER,KSTP
293   61    FORMAT(1X,/1X,A,'   PERIOD',I3,'   STEP',I3)
294         WRITE(IOUT,62) L,IL,IR,IC,Q
295   62    FORMAT(1X,'DRAIN',I4,'   LAYER',I3,'   ROW',I4,'   COL',I4,
296     1       '   RATE',1PG15.6)
297         IBDLBL=1
298      END IF
299C
300C5F-----ADD Q TO BUFFER.
301      BUFF(IC,IR,IL)=BUFF(IC,IR,IL)+Q
302C
303C5G-----IF SAVING CELL-BY-CELL FLOWS IN A LIST, WRITE FLOW.  OR IF
304C5G-----RETURNING THE FLOW IN THE DRAI ARRAY, COPY FLOW TO DRAI.
305   99 IF(IBD.EQ.2) CALL UBDSVA(IDRNCB,NCOL,NROW,IC,IR,IL,Q,IBOUND,NLAY)
306      IF(IDRNAL.NE.0) DRAI(NDRNVL,L)=Q
307  100 CONTINUE
308C
309C6------IF CELL-BY-CELL FLOW WILL BE SAVED AS A 3-D ARRAY,
310C6------CALL UBUDSV TO SAVE THEM.
311      IF(IBD.EQ.1) CALL UBUDSV(KSTP,KPER,TEXT,IDRNCB,BUFF,NCOL,NROW,
312     1                          NLAY,IOUT)
313C
314C7------MOVE RATES,VOLUMES & LABELS INTO ARRAYS FOR PRINTING.
315  200 ROUT=RATOUT
316      VBVL(3,MSUM)=ZERO
317      VBVL(4,MSUM)=ROUT
318      VBVL(2,MSUM)=VBVL(2,MSUM)+ROUT*DELT
319      VBNM(MSUM)=TEXT
320C
321C8------INCREMENT BUDGET TERM COUNTER.
322      MSUM=MSUM+1
323C
324C9------RETURN.
325      RETURN
326      END
327