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