You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

485 lines
14 KiB
Fortran

!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