!IPK LAST UPDATE OCT 23 2015 ADD DECODAT OPTION FOR INPUT !IPK LAST UPDATE nov 20 2014 IMPLEMENT BINARY FILE SAVE FOR ELEMENT INFLOW DATA !IPK LAST UPDATE nov 17 2014 initialise TPRVH FOR ALL TYPES !IPK last update oct 22 2012 initialize TPRVH !IPK LAST UPDATE MAY 04 2011 FIX BUG CAUSED WHEN SPANNING MULTIPLE FILES !IPK LAST UPDATE SEPT 3 2007 ADD FULL DATE TO INPUT !IPK last update sept 01 2007 permit comma delimited entry of data !IPK LAST UPDATE SEP 06 2004 ADD ERROR FILE ! Last change: IPK 19 Sep 2000 11:44 am !IPK LAST UPDATE APR 16 1997 !IPK last update Jan 23 1996 !IPK last update jan 9 1996 SUBROUTINE GETEQ !IPK APR97 SAVE use winteracter USE BLKELTLD include 'D.inc' ! ! Declare window-type and message variables ! TYPE(WIN_STYLE) :: WINDOW TYPE(WIN_MESSAGE) :: MESSAGE !IPK AUG05 SAVE INTEGER JCNV(12) CHARACTER*32 FNAM CHARACTER*8 ID CHARACTER*80 QHTITLE,DLIN CHARACTER*10 DATE character*255 fnamein,filter !IPK oct 12 add initial value data tprvh/0./,ITIME/0/ DATA JCNV/0,31,59,90,120,151,181,212,243,273,304,334/ LOGICAL OPENED IF(ITIME .EQ. 0) THEN DAYOFY=-9999 ITIME=1 IQEUNIT=0 IBINEL=0 IRMATYP=10 NQHYD=0 NQP=0 ENDIF call wdialogload(IDD_CHOOSEMODEL) ierr=infoerror(1) CALL WDialogSelect(IDD_CHOOSEMODEL) ierr=infoerror(1) call wdialogputRadioButton(idf_radio1) CALL WDialogShow(-1,-1,0,Modal) ierr=infoerror(1) do ! IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN call wdialoggetradiobutton(idf_radio1,ntyp) GO TO 50 ENDIF enddo 50 CONTINUE IF(NTYP .EQ. 1) IRMATYP=2 IF(NTYP .EQ. 2) IRMATYP=10 IF(NTYP .EQ. 3) THEN IRMATYP=11 NQP=1 call wdialogload(IDD_GETINT) ierr=infoerror(1) CALL WDialogSelect(IDD_GETINT) ierr=infoerror(1) CALL WDialogPutString(IDF_STRING1,'NUMBER OF WQ GRAPH ENTRIES') CALL WDialogPutInteger(IDF_INTEGER1,NQP) CALL WDialogShow(-1,-1,0,Modal) ierr=infoerror(1) ! Branch depending on type of message. ! DO IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN CALL WDialogGetInteger(IDF_INTEGER1,NQP) ! TEMPORARY LIMIT IF(NQP .GT. 3) NQP=3 GO TO 70 ELSE RETURN ENDIF ENDDO ENDIF !IPK NOV14 ADD IBINEL TO TEST 70 CONTINUE IF(IQEUNIT .EQ. 0 .and. ibinel .eq. 0) THEN INQUIRE(201,opened= OPENED) filter='Element Input files|*.elt;*.elf;*.dat;*.txt;*.grh|All files --|*.*|' IF( .NOT. OPENED) THEN CALL WSelectFile(filter,PromptOn+DirChange,FNAMEIN,'Element Load File Name') IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN OPEN(201,FILE=FNAMEIN,STATUS='OLD') ELSE RETURN ENDIF ENDIF IQEUNIT=201 ENDIF IF(NQHYD .EQ. 0) THEN !IPK NOV14 READ AND ALLOCATE DATA FROM BINARY FILE IF(IBINEL .GT. 0) THEN TSTARTS=(DAYOFY-1)*24.+TIME-TETH READ(IBINEL)NEDPTS,NQHYD,TSTARTKP,IYRKP YEARC=0. IF(IYRR .NE. IYRKP) THEN IF(IYRR .GT. IYRKP) THEN 80 CALL HRYRT(IYRKP,HRYR) YEARC=YEARC+HRYR IYRKP=IYRKP+1 IF(IYRR .GT. IYRKP) GO TO 80 ELSE 90 CALL HRYRT(IYRKP,HRYR) YEARC=YEARC-HRYR IYRKP=IYRKP-1 IF(IYRR .LT. IYRKP) GO TO 90 ENDIF ENDIF ALLOCATE(DYE(NEDPTS,NQHYD),TAE(NEDPTS,NQHYD),HAE(NEDPTS,NQHYD),HDE(NEDPTS,NQHYD,3),ILAYRE(NEDPTS,NQHYD)) do j=1,NQHYD READ(IBINEL) NCLINE(j),NEST(j),IYDATE(j),NHYE(J) READ(IBINEL) (DYE(I,j),TAE(I,j),HAE(I,j),I=1,nedpts) DO I=1,NEDPTS TAE(I,J)=TAE(I,J)+TSTARTKP-TSTARTS-YEARC ENDDO enddo GO TO 199 ENDIF !IPK NOV14 END UPDATE NEDPTS=0 CALL ALLOCFL(NEDPTS,NELDS,IQEUNIT,3) ! ! set starting time in hours of the year ! teth contains the first time step 95 READ(IQEUNIT,'(A8,A72)') ID,QHTITLE !IPK sep07 CHECK FOR COMMA'S 98 IFREE=0 DO K=1,8 IF(ID(K:K) .NE. ',') THEN IFREE=0 ELSE KFIRST=K+1 IFREE=1 GO TO 99 ENDIF ENDDO 99 IF(IFREE .EQ. 1) THEN QHTITLE=ID(KFIRST:8)//QHTITLE(1:71+KFIRST) ENDIF READ(IQEUNIT,'(A8,A72)') ID,DLIN IF(ID(1:3) .EQ. 'QEI' .OR. ID(1:3) .EQ. 'QT ') THEN 101 NQHYD=NQHYD+1 !IPK sep07 CHECK FOR COMMA'S !IPK nov14 initialise TPRVH tprvh=0 IFREE=0 DO K=1,8 IF(ID(K:K) .NE. ',') THEN IFREE=0 ELSE KFIRST=K+1 IFREE=1 GO TO 102 ENDIF ENDDO 102 IF(IFREE .EQ. 1) THEN DLIN=ID(KFIRST:8)//DLIN(1:71+KFIRST) ENDIF !IPK APR97 TEST FOR LIMIT IF(NQHYD .GT. NELDS) THEN !IPK SEP04 CLOSE(75) OPEN(75,file='ERROR.OUT') WRITE(75,*) 'ERROR STOP TOO MANY ELEMENT INFLOWS' WRITE(*,*) 'ERROR STOP TOO MANY ELEMENT INFLOWS' STOP 'ERROR STOP TOO MANY ELEMENT INFLOWS' ENDIF NHYE(NQHYD)=0 !IPK sep07 if(ifree .eq. 0) then READ(DLIN,'(3I8,2F16.2)',ERR=801) NCLINE(NQHYD),NEST(NQHYD),IYDATE(NQHYD),XYCEL(NQHYD,1),XYCEL(NQHYD,2) GO TO 811 801 READ(DLIN,'(3I8)') NCLINE(NQHYD),NEST(NQHYD),IYDATE(NQHYD) 811 CONTINUE else READ(DLIN,*) NCLINE(NQHYD),NEST(NQHYD),IYDATE(NQHYD) endif IF(NCLINE(NQHYD) .EQ. 0) NCLINE(NQHYD)=-9999 ! IYD=IYDATE(NQHYD) !IPK may11 set IYDOLD IYDOLD=IYD DO 120 I=1,NEDPTS+1 READ(IQEUNIT,'(A8,A72)') ID,DLIN !IPK sep07 ADD QN IF(ID(1:3) .EQ. 'TI ') GO TO 98 IF(ID(1:3) .EQ. 'QEI' .OR. ID(1:3) .EQ. 'QT ') THEN ! NHYE(NQHYD)=NHYE(NQHYD)+1 !IPK jan96 add day of year to logic ! DYE(NHYE(NQHYD),NQHYD)=1.E+6 ! TAE(NHYE(NQHYD),NQHYD)=1.E+8 ! HAE(NHYE(NQHYD),NQHYD)=HAE(NHYE(NQHYD)-1,NQHYD) GO TO 101 ELSEIF(ID(1:2) .EQ. 'QE' .OR. ID(1:2) .EQ. 'QN' .OR. ID(1:2) .EQ. 'QD' .or. ID(1:2) .EQ. 'QM') THEN !IPK jan96 add day of year to logic !IPK sep07 CHECK FOR COMMA'S IFREE=0 DO K=1,8 IF(ID(K:K) .NE. ',') THEN IFREE=0 ELSE KFIRST=K+1 IFREE=1 GO TO 105 ENDIF ENDDO 105 IF(IFREE .EQ. 1) THEN DLIN=ID(KFIRST:8)//DLIN(1:71+KFIRST) ENDIF !IPK sep07 ALLOW FOR QN IF(ID(1:2) .EQ. 'QE' .OR. ID(1:2) .EQ. 'QD') THEN IF(IFREE .EQ. 0) THEN READ(ID(5:8),'(F4.0)') DYE(I,NQHYD) IF(IRMATYP .EQ. 2) READ(DLIN,'(2F8.0)') TAE(I,NQHYD),HAE(I,NQHYD) IF(IRMATYP .EQ. 10) READ(DLIN,'(F8.0,I8,4F8.0)') TAE(I,NQHYD),ILAYRE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,3) IF(IRMATYP .EQ. 11) READ(DLIN,'(F8.0,4F8.0)') TAE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,NQP) else IF(IRMATYP .EQ. 2) READ(DLIN,*) TAE(I,NQHYD),HAE(I,NQHYD) IF(IRMATYP .EQ. 10) READ(DLIN,*) DYE(I,NQHYD),TAE(I,NQHYD),ILAYRE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,3) IF(IRMATYP .EQ. 11) READ(DLIN,*) TAE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,NQP) endif !IPK SEP07 ADD DATE INPUT ELSE !IPK oct15 add decodat option IF(IFREE .EQ. 1) THEN READ(DLIN,'(A10)') DATE READ(DLIN(12:80),*) TAE(I,NQHYD),HAE(I,NQHYD) READ(DATE,'(I2,1X,I2,1X,I4)') IDAYY,IMTHH,IYYR DYE(I,NQHYD)=IDAYY+JCNV(IMTHH) IF(MOD(IYYR,4) .EQ. 0 .AND. IYYR .NE. 2000) THEN IF(IMTHH .GT. 2) DYE(I,NQHYD)=DYE(I,NQHYD)+1 ENDIF ELSE CALL DECODDAT(DLIN,DYE(I,NQHYD),TAE(I,NQHYD)) IF(IRMATYP .EQ. 2) READ(DLIN(17:24),'(F8.0)') HAE(I,NQHYD) IF(IRMATYP .EQ. 10) READ(DLIN(17:64),'(I8,4F8.0)') ILAYRE(I,NQHYD),HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,3) IF(IRMATYP .EQ. 11) READ(DLIN(17:64),'(4F8.0)') HAE(I,NQHYD),(HDE(I,NQHYD,K),K=1,NQP) ENDIF !IPK oct15 end decodat update ENDIF IF(DAYOFY .LT. 0) THEN DAYOFY=DYE(I,NQHYD) TSTARTS=(DAYOFY-1)*24. IYRR=IYD ENDIF NHYE(NQHYD)=NHYE(NQHYD)+1 ! IF(I .EQ. 1) THEN ! ! reduce input time to time since that set to start simulation ! 110 CONTINUE ! IF(MOD(IYD,4) .EQ. 0) THEN ! ILP=1 ! ELSE ! ILP=0 ! ENDIF ! IF(IYD .EQ. IYRR) THEN ! ! If now for for the same year ! TCUR1=(DYE(I,NQHYD)-1.)*24.+TAE(I,NQHYD) ! ! set time as the difference ! TAE(I,NQHYD)=TCUR1 ! WRITE(75,*) I,TAE(I,NQHYD),HAE(I,NQHYD) ! ELSEIF(IYD .LT. IYRR) THEN ! IF(MOD(IYD,4) .EQ. 0) THEN ! TPRVH=TPRVH+366.*24. ! ELSE ! TPRVH=TPRVH+365.*24. ! ENDIF ! IYD=IYD+1 ! GO TO 110 ! ELSE !IPK SEP04 ! CLOSE(75) ! OPEN(75,file='ERROR.OUT') !IPK SEP00 ! WRITE(*,*) ' Element inflows for wrong year' ! WRITE(*,*) ' Execution stopped' ! WRITE(75,*) ' Element inflows for wrong year' ! WRITE(75,*) ' Excution stopped' ! STOP ! ENDIF ! ELSE !IPK may11 reset IYD ! IYD=IYDOLD ! IF(DYE(I,NQHYD) .LT. DYE(I-1,NQHYD)) THEN ! TCUR1=TCUR1-365.*24. !IPK MAY11 IF(ILP .EQ. 1) TCUR1=TCUR1-24. !IPK MAY11 IYD=IYD+1 ! IF(MOD(IYD,4) .EQ. 0) THEN ! ILP=1 ! ELSE ! ILP=0 ! ENDIF !IPK may11 ! IYDOLD=IYDOLD+1 ! IF(ILP .EQ. 1) TCUR1=TCUR1-24. ! ENDIF ! TCUR=(DYE(I,NQHYD)-1.)*24.+TAE(I,NQHYD) ! TAE(I,NQHYD)=TAE(I-1,NQHYD)+TCUR-TCUR1 ! TCUR1=TCUR ! WRITE(75,*) I,TAE(I,NQHYD),HAE(I,NQHYD) ! ENDIF ELSE ! NHYE(NQHYD)=NHYE(NQHYD)+1 !IPK jan96 add day of year to logic ! DYE(NHYE(NQHYD),NQHYD)=1.E+6 ! TAE(NHYE(NQHYD),NQHYD)=1.E+8 ! HAE(NHYE(NQHYD),NQHYD)=HAE(NHYE(NQHYD)-1,NQHYD) ! IF(IRMATYP .EQ. 10) THEN ! DO K=1,3 ! HDE(NHYE(NQHYD),NQHYD,K)=HDE(NHYE(NQHYD)-1,NQHYD,K) ! ENDDO ! ENDIF GO TO 199 ENDIF 120 CONTINUE !IPK SEP04 CLOSE(75) OPEN(75,file='ERROR.OUT') !IPK SEP00 WRITE(*,*) 'Execution terminated more lines than allowed in element graph' WRITE(75,*)'Execution terminated more lines than allowed in element graph' stop ENDIF 199 continue ENDIF 200 CONTINUE CLOSE(IQEUNIT) IQEUNIT=0 DO I=1,NQHYD IF(XYCEL(I,1) .EQ. 0. .AND. XYCEL(I,2) .EQ. 0) THEN JJ=NCLINE(I) CALL GETXCL(JJ,XYCEL(I,1),XYCEL(I,2)) ENDIF ENDDO RETURN END !IPK NOV14 ADD LEAP YEAR ROUTINE SUBROUTINE HRYRT(IYRKP,HRYR) IF(MOD(IYRKP,4) .EQ. 0) THEN ILP=1 HRYR=366.*24. ELSE ILP=0 HRYR=365.*24. ENDIF RETURN END !IPK NEW WITH VERSION 9.0H OCT 25 2015 ! DECODE JULIAN DAY FROM DAY/MONTH/YEAR DATA SUBROUTINE DECODDAT(DATAIN,DAYJUL,TIME) CHARACTER*72 DATAIN REAL DAYJUL,TIME INTEGER IMTS(12,2),IDAY,IMO,IYR,HR,MIN DATA IMTS/0,31,59,90,120,151,181,212,243,273,304,334,0,31,60,91,121,152,182,213,244,274,305,335/ ! ! LOOP THROUGH COLUMNS ADDING A COMMA IDBLNK=0 DO I=1,16 IF(DATAIN(I:I) .EQ. ':') THEN IHSW=0 DATAIN(I:I)=',' ELSEIF(DATAIN(I:I) .EQ. '.') THEN IHSW=1 ENDIF IF(DATAIN(I:I) .EQ. '/') DATAIN(I:I)=',' IF(I .GT. 8 .AND. DATAIN(I:I) .EQ. ' ') THEN IF(IDBLNK .EQ. 0) THEN DATAIN(I:I)=',' IDBLNK=1 IHSW=1 ELSE DATAIN(I:I)='0' ENDIF ENDIF ENDDO ! write(155,*) ihsw,datain(1:16) IF(IHSW .EQ. 0) THEN READ(DATAIN(1:16),*) IDAY,IMO,IYR,HR,MIN TIME=HR+MIN/60. ELSE READ(DATAIN(1:16),*) IDAY,IMO,IYR,TIME ! write(155,*) IDAY,IMO,IYR,TIME ENDIF IF(MOD(IYR,4) .EQ. 0) THEN DAYJUL=IMTS(IMO,2)+IDAY ELSE DAYJUL=IMTS(IMO,1)+IDAY ENDIF RETURN END SUBROUTINE ALLOCFL(MAXPT,MAXTYP,IUNIT,ITYP) USE BLKELTLD CHARACTER*8 ID NELDS=200 MAXPT=0 !IPK JUN09 RESTORE MAXTYP1 MAXTYP1=0 NQLM=0 200 CONTINUE READ(IUNIT,'(A8)', END=500) ID !IPK JUN09 ADD TO IF OPTIONS IF(ID(1:2) .EQ. 'TT' .OR. ID(1:2) .EQ. 'TH' .OR. ID(1:2) .EQ. 'TE' .OR. ID(1:2) .EQ. 'TI' & & .OR. ID(1:3) .eq. 'CLQ' .OR. ID(1:3) .eq. 'CLH' & & .OR. ID(1:3) .eq. 'QEI' .OR. ID(1:3) .eq. 'QT ' & & .OR. ID(1:3) .EQ. 'TIT' .OR. ID(1:3) .EQ. 'CTL') THEN !IPK SEP14 ADD TYPE 4 (STAGE FLOW) OPTION !IPK JUN09 RESTORE MAXTYP1 MAXTYP1=MAXTYP1+1 ! MAXTYP1=MAXTYP1+1 !IPK JUN09 IF(NQLM .GT. MAXQPT) MAXPT=NQLM IF(NQLM .GE. MAXPT) MAXPT=NQLM+1 NQLM=0 GO TO 200 ELSEIF(ID(1:6) .EQ. 'ENDDAT') THEN !IPK JUN09 ADD TO NQLM IF(NQLM .GT. MAXPT) MAXPT=NQLM+1 GO TO 500 ELSE NQLM=NQLM+1 GO TO 200 ENDIF 500 CONTINUE !IPK JUN09 write(90,*) maxtyp,maxtyp1,maxpt,nelds IF(MAXTYP1 .GT. MAXTYP) MAXTYP=MAXTYP1 ALLOCATE (TAE(MAXPT,MAXTYP),HAE(MAXPT,MAXTYP),DYE(MAXPT,MAXTYP),HDE(MAXPT,MAXTYP,3),ILAYRE(MAXPT,MAXTYP)) ALLOCATE (NCLINE(NELDS),NHYE(NELDS),IYDATE(NELDS),NEST(NELDS),XYCEL(NELDS,2)) TAE=0. HAE=0. HDE=0. DYE=0. XYCEL=0. ILAYRE=0 REWIND IUNIT RETURN END