SUBROUTINE RDEQHR(KFILDO,KFILEQ,IP18,EQNNAM,IOPER,NDATE,
1 MTANDS,IDTAND,ND15,IER)
C
C JUNE 2018 GLAHN MDL MOS-2000
C PULLED FROM RDEQNM
C
C PURPOSE
C TO READ THE 3-RECORD HEADER OF EQUATIONS, INCLUDING THE
C NUMBER OF PREDICTANDS. EACH PROJECTION WILL BE ON A
C SEPARATE FILE WITH HEADERS, BUT PROBABILITY EQUATIONS
C FOR ONE PREDICTAND WILL BE ON ONE FILE AS WELL AS
C REGIONAL EQUATIONS, IF MORE THAN ONE REGION.
C
C DATA SET USE
C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT)
C KFILEQ - UNIT NUMBER FOR READING EQUATION FILE.
C (INPUT)
C IP18 - INDICATES WHETHER (>0) OR NOT (=0)
C ELEMENTS OF THE EQUATIONS WILL BE WRITTEN
C ON UNIT IP18. (INPUT)
C
C VARIABLES
C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT)
C KFILEQ = UNIT NUMBER FOR READING EQUATION FILE. (INPUT)
C IP18 = INDICATES WHETHER (>0) OR NOT (=0)
C EQUATIONS READ IN RDEQNM WILL BE WRITTEN
C TO IP18 IN RDEQNM. (INPUT)
C EQNNAM = NAME OF FILE CORRESPONDING TO KFILEQ. (INPUT)
C IOPER = 1 FOR OPERATIONS; 0 FOR DEVELOPMENT. CONTROLS
C HOW HEADER IS READ AND USED.
C NDATE = FOR OPERATIONS, MUST FALL WITHIN DATES
C SPECIFIED FOR THE EQUAITONS. FOR DEVELOPMENT,
C HR MUST AGREE WITH CYCLE FOR THE EQUATIONS.
C (INPUT)
C MTANDS = THE NUMBER OF PREDICTANDS FOR THIS SET OF
C EQUATIONS. (OUTPUT)
C IDTAND(J,NN) = THE PREDICTAND ID'S (J=1,4) AND PREDICTAND NN
C (NN=1,MTANDS) FOR THIS EQUATION SET. (OUTPUT)
C ND15 = MAXIMUM NUMBER OF PREDICTANDS IN ANY EQUATION.
C USED AS DIMENSION OF IDTAND( , ). (INPUT)
C IER = STATUS RETURN.
C 0 = GOOD RETURN.
C 165 = EXTERNAL AND INTERNAL FILE NAMES DON'T
C MATCH IN OPTION 1 HEADER.
C 166 = NDATE DOES NOT FIT WITHIN STARTING AND
C ENDING DATES OF EQUATIONS FOR OPERATIONS
C OR MATCH THE RUN HOUR OF THE RUN DATE
C FOR DEVELOPMENT.
C 168 = SYSTEM ERROR READING OR END OF FILE.
C 195 = NUMBER OF PREDICTANDS = ZERO OR GT ND15.
C 1 2 3 4 5 6 7 X
C
C NONSYSTEM SUBROUTINES USED
C IERX
C
CHARACTER*4 STATE,UTC
CHARACTER*9 CYCLE
CHARACTER*60 EQNNAM,EQNCHK
C
DIMENSION IDTAND(4,ND15+1)
C
CALL TIMPR(KFILDO,KFILDO,'START RDEQHR ')
IER=0
C READ AND WRITE THE FILE NAME.
C
IF(IOPER.EQ.0)THEN
C
C READ AND CHECK THE FILE NAME. THIS IS FOR
C DEVELOPMENT AND OPTION 1 EQUATION HEADER.
C
STATE=' 110'
READ(KFILEQ,110,IOSTAT=IOS,ERR=900,END=900)EQNCHK,
1 CYCLE,NCYCLE
110 FORMAT(' ',A60,A9,I2)
C
CCCC WRITE(KFILDO,1105)CYCLE,NCYCLE
CCCC 1105 FORMAT(/' AT 1105 IN RDEQHR--CYCLE,NCYCLE ',A9,I4)
C
IF(EQNCHK.NE.EQNNAM)THEN
WRITE(KFILDO,111)EQNNAM,EQNCHK
111 FORMAT(/,' ****INPUT EQUATION FILE NAME ',A60,/,
1 ' DOES NOT MATCH INTERNAL NAME ',A60,
2 ' AT 111 IN RDEQHR.',/,
2 ' READING OF EQUATIONS ABORTED.')
IER=165
GO TO 950
ELSE
IHR=MOD(NDATE,100)
C
IF(NCYCLE.NE.IHR)THEN
WRITE(KFILDO,1112)NCHCLE,IHR
1112 FORMAT(/' ****INPUT CYCLE =',I4,
1 ' NOT EQUAL TO HOUR IN INPUT DATE =',I4,
2 ' AT 1112 IN RDEQHR.'/
3 ' READING OF EQUATIONS ABORTED.')
IER=166
GO TO 950
ENDIF
C
ENDIF
C
ELSE
C
C READ AND CHECK THE DATE. THIS IS FOR OPERATIONS
C AND OPTION 2 EQUATION HEADER. FOR MULTIPLE
C PROJECTIONS FOR OPERATIONS, THE NEXT RECORD
C MAY BE A TERMINATOR ENDING THE LAST SET OF EQUATIONS.
C
STATE=' 111'
write(KFILDO,*)'adam, check the header date'
READ(KFILEQ,1115,IOSTAT=IOS,ERR=900,END=900)
1 IHOUR,UTC,MONDAS,MONDAE
1115 FORMAT(I5,A4,2I5)
C
CALL DOY(NDATE,JY,JM,JD,JH,MDAY)
C
IF(IHOUR.EQ.JH*100)THEN
C
IF(MONDAS.LE.MONDAE)THEN
IF(JM*100+JD.GE.MONDAS.AND.
1 JM*100+JD.LE.MONDAE)GO TO 1119
ELSE
IF(JM*100+JD.LE.MONDAE.OR.
1 JM*100+JD.GE.MONDAS)GO TO 1119
ENDIF
C
ENDIF
C
WRITE(KFILDO,1117)IHOUR,MONDAS,MONDAE,JY,JM,JD,JH,EQNNAM
1117 FORMAT(/,' ****EQUATION SET FOR HOUR',I4.2,
1 ' STARTING AND ENDING DATES',2I6.4,
2 ' DOES NOT MATCH NDATE',I6,I3.2,I2.2,I3.2,/,
3 ' ON OPERATIONAL FILE ',A60)
IER=166
GO TO 950
ENDIF
C
C READ NUMBER OF PREDICTANDS.
C
1119 STATE=' 112'
READ(KFILEQ,112,IOSTAT=IOS,ERR=900,END=900)MTANDS
112 FORMAT(1X,I4)
C
IF(MTANDS.EQ.0)THEN
WRITE(KFILDO,113)EQNNAM
113 FORMAT(/,' ****NUMBER OF PREDICTANDS EQUALS ZERO AT 113',
1 ' IN RDEQHR FOR FILE ',A60,/,
2 ' READING OF EQUATIONS ABORTED.')
IER=195
GO TO 950
C
ELSEIF(MTANDS.GT.ND15)THEN
WRITE(KFILDO,1130)MTANDS,ND15,EQNNAM
1130 FORMAT(/,' ****NUMBER OF PREDICTANDS =',I4,' GT ND15 =',I4,
1 ' AT 1130 IN RDEQHR FOR FILE ',A60,/,
2 ' READING OF EQUATIONS ABORTED.')
IER=195
GO TO 950
C
ELSE
WRITE(KFILDO,1132)MTANDS
1132 FORMAT(/' NUMBER OF EQUATIONS, MTANDS =',I4)
ENDIF
C
C READ PREDICTAND DEFINITIONS.
C
WRITE(KFILDO,1135)EQNNAM
1135 FORMAT(/,' PREDICTANDS FOR EQUATION SET ON FILE ',A60)
IF(IP18.NE.0.AND.IP18.NE.KFILDO)WRITE(IP18,1135)EQNNAM
C
STATE=' 114'
C
DO 115 N=1,MTANDS
READ(KFILEQ,114,IOSTAT=IOS,ERR=900,END=900)
1 (IDTAND(J,N),J=1,4)
114 FORMAT(1X,I9,2I10,I11)
115 CONTINUE
C
IDTAND(1,MTANDS+1)=0
C THIS IS TO FACILITATE TESTING IN CALLING ROUTINE.
C ARRAY IS ND15+1, SO THERE IS ALWAYS ROOM.
C
DO 120 N=1,MTANDS
WRITE(KFILDO,117)(IDTAND(J,N),J=1,4)
117 FORMAT(3(1X,I9.9),1X,I10.3)
IF(IP18.NE.0.AND.IP18.NE.KFILDO)
1 WRITE(IP18,117)(IDTAND(J,N),J=1,4)
C
120 CONTINUE
GO TO 950
C
900 CALL IERX(KFILDO,KFILDO,IOS,'RDEQHR',STATE)
IER=168
C
950 CONTINUE
C
CALL TIMPR(KFILDO,KFILDO,'END RDEQHR ')
C
RETURN
END