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
485 lines
14 KiB
Fortran
5 years ago
|
!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
|
||
|
|
|