SUBROUTINE RDEQNG(KFILDO,KFILEQ,EQNNAM, 1 IP25, 2 CCALLD, 3 KGP, 4 MTRMS,MTANDS, 5 IDEQN,IDTAND, 6 CONST, 7 AVG,CORR, 8 COEF, 9 ND1,ND2,ND3,ND5,ND13,IER) C C JANUARY 2015 GLAHN MDL MOS-2000 C REVISED FROM U700'S RDEQN FOR U155 C JUNE 2015 GLAHN CHANGED ORDER OF PRINTING AT 111 C AUGUST 2015 IM/GLAHN CHANGED 138 FORMAT(' ',10(E13.7)) C TO 138 FORMAT(' ',10(E13.6)) C C PURPOSE C TO READ ONE SET OF EQUATIONS FROM A FILE FOR U155. C A SET IS DEFINED AS A GROUP OF EQUATIONS ALL C HAVING THE SAME PREDICTORS. THIS IS FOR THE LAMP/HRRR C MELD, AND ONE SET IS COMPOSED OF THE PROBABILITY C EQUATIONS FOR ALL PREDICTAND CATEGORIES READ FROM C U602 OUTPUT. ALSO, TO READ THE THRESHOLDS FOR EACH C EQUAION FOR MAKING CATEGORICAL FORECASTS FROM THE C OUTPUT OF U830. 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 C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILEQ = UNIT NUMBER FOR READING EQUATION FILE. (INPUT) C EQNNAM = FOR U700, NAME OF FILE CORRESPONDING TO KFILEQ. C FOR U900, THIS IS NOT USED (NDATE = 9999). C (CHARACTER*60) (OUTPUT) C NDATE = FOR U900, NDATE IS THE DATE/TIME BEING PROCESSED. C THIS MUST BE WITHIN THE BEGINNING AND ENDING C DATES (MONTH/DAY) AND FOR THE HOUR (CYCLE) C SPECIFIED IN THE EQUATION FILE. C FOR U700, THIS MUST BE 9999. C IP25 = INDICATES WHETHER (>0) OR NOT (=0) THE C PREDICTAND MEANS WILL BE WRITTEN TO UNIT IP25 C FOR VIEWING. (INPUT) C CCALLD(K) = SCRATCH ARRAY (K=1,ND1) (CHARACTER*8) C (INTERNAL) C KGP = THE NUMBER OF EQUATIONS FOR THIS SET. (OUTPUT) C MTRMS(L) = THE NUMBER OF TERMS IN EACH EQUATION C (L=1,KGP) FOR THIS SET. (OUTPUT) C MTANDS = THE NUMBER OF PREDICTANDS FOR EACH EQUATION. C (OUTPUT) C IDEQN(J,L,M) = THE 4-WORD ID (J=1,4) FOR EACH PREDICTOR C (M=1,NTRMS) IN EACH EQUATION (L=1,KGP), C FOR THIS EQUATION SET. (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 CONST(L,NN) = THE EQUATION CONSTANTS FOR GROUP L (L=1,KGP) C AND PREDICTAND NN (NN=1,MTANDS) FOR THIS C EQUATION SET. (OUTPUT) C AVG(L,NN) = THE PREDICTAND MEANS FOR GROUP L (L=1,KGP) AND C PREDICTAND NN (NN=1,MTANDS) FOR THIS EQUATION C SET. (OUPTUT) C CORR(L,NN) = THE MULTIPLE CORRELATIONS FOR GROUP L C (L=1,KGP) AND PREDICTAND NN (NN=1,MTANDS) FOR C THIS EQUATION SET. (OUTPUT) C COEF(L,M,NN) = THE COEFFICIENTS FOR GROUP L (L=1,KGP), C TERM M (M=1,MTRMS), AND PREDICTAND NN C (NN=1,MTANDS) FOR THIS EQUATION SET. (OUTPUT) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT C WITH. USED AS DIMENSION OF SEVERAL VARIABLES. C (INPUT) C ND2 = MAXIMUM NUMBER OF TERMS IN ANY EQUATION. C USED AS DIMENSION OF SEVERAL VARIABLES. (INPUT) C ND3 = MAXIMUM NUMBER OF PREDICTANDS IN ANY EQUATION. C USED AS DIMENSION OF SEVERAL VARIABLES. (INPUT) C ND5 = THE MAXIMUM NUMBER OF CALL LETTERS FOR A SET C OF EQUATIONS. THIS COULD BE GT ND1. DIMENSION C CCALLD( ). C ND13 = MAXIMUM NUMBER OF DIFFERENT EQUATIONS PER SET. C IER = STATUS RETURN. C 0 = GOOD RETURN. C 165 = EXTERNAL AND INTERNAL FILE NAMES DON'T C MATCH WHEN NDATE = 9999. C 166 = NUMBER OF PREDICTANDS = ZERO OR GT ND3. C 167 = NUMBER OF TERMS IN EQUATION = 0 OR GT ND2. C 168 = SYSTEM ERROR READING. C 169 = NUMBER OF EQUATIONS GT ND1 OR GT ND13. C 171 = NO EQUATION FOR ONE OR MORE STATIONS C IN THE STATION LIST. C 20 = ERROR OR END OF FILE ON UNIT KFILEQ OR C DATES ON EQUATION FILE DO NOT MATCH NDATE C (FROM RDC OR RDEQNG). C 21 = LIST TOO LONG FOR DIMENSION ND ON UNIT C KFIL (FROM RDC). C NTAND = THE NUMBER OF PREDICTANDS FOR THIS PARTICULAR C SET OF EQUATIONS. (INTERNAL) C NCOUNT = COUNTS TOTAL NUMBER OF STATIONS TO MAKE C FORECASTS FOR IN ALL SETS. (INTERNAL) C JCOUNT = COUNTS NUMBER OF STATIONS TO MAKE FORECASTS FOR C FOR EACH SET. (INTERNAL) C KEEP = KEEPS TRACK OF WHETHER A STATION IS IN THE C INPUT LIST MORE THAN ONCE, WHICH WILL CAUSE A C DIAGNOSTIC. (INTERNAL) C ICOUNT = REGULATES PRINT SPACING IN DO 195 LOOP. C (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C IERX, RDC C CHARACTER*4 STATE CHARACTER*8 CTEMP(14) CHARACTER*8 CCALLD(ND5) CHARACTER*60 EQNNAM,EQNCHK C DIMENSION MTRMS(ND13) DIMENSION IDEQN(4,ND13,ND2) DIMENSION CONST(ND13,ND3), 1 AVG(ND13,ND3), 2 CORR(ND13,ND3) DIMENSION COEF(ND13,ND2,ND3) DIMENSION IDTAND(4,ND3) C CALL TIMPR(KFILDO,KFILDO,'START RDEQNG ') IER=0 KGP=1 D WRITE(KFILDO,104)KFILEQ,EQNNAM D104 FORMAT(/' IN RDEQNG--KFILEQ,EQNNAM',I4,2X,A60) C C OPEN THE EQUATION FILE. C STATE='105 ' OPEN(UNIT=KFILEQ,FILE=EQNNAM,STATUS='OLD',IOSTAT=IOS,ERR=900) C READ AND WRITE THE FILE NAME. C STATE=' 110' READ(KFILEQ,110,IOSTAT=IOS,ERR=900,END=900)EQNCHK 110 FORMAT(' ',A60) C IF(EQNNAM.NE.EQNCHK)THEN WRITE(KFILDO,111)EQNCHK,EQNNAM 111 FORMAT(/' ****FILE NAME READ = ',A60/ 1 ' EXPECTED ',A60) GO TO 950 ELSE WRITE(KFILDO,1110)EQNCHK 1110 FORMAT(/,' EQUATION FILE NAME READ ',A60) ENDIF C C READ NUMBER OF PREDICTANDS. C STATE=' 112' READ(KFILEQ,112,IOSTAT=IOS,ERR=900,END=900)NTAND 112 FORMAT(1X,I4) C IF(NTAND.EQ.0)THEN WRITE(KFILDO,113)EQNNAM 113 FORMAT(/,' ****NUMBER OF PREDICTANDS EQUALS ZERO AT 113', 1 ' IN RDEQNG FOR FILE ',A60,/, 2 ' READING OF EQUATIONS ABORTED.') IER=166 GO TO 950 C ELSEIF(NTAND.GT.ND3)THEN WRITE(KFILDO,1130)NTAND,ND3,EQNNAM 1130 FORMAT(/,' ****NUMBER OF PREDICTANDS =',I4,' GT ND3 =',I4, 1 ' AT 1130 IN RDEQNG FOR FILE ',A60,/, 2 ' READING OF EQUATIONS ABORTED.') IER=166 GO TO 950 C ELSE WRITE(KFILDO,1132)NTAND 1132 FORMAT(/' NUMBER OF EQUATIONS, NTAND =',I4) ENDIF C C READ PREDICTAND DEFINITIONS. C WRITE(KFILDO,1135)EQNNAM 1135 FORMAT(/,' PREDICTANDS FOR EQUATION SET ON FILE ',A60) IF(IP25.NE.0.AND.IP25.NE.KFILDO)WRITE(IP25,1135)EQNNAM C STATE=' 114' C DO 115 N=1,NTAND 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 DO 120 N=1,NTAND WRITE(KFILDO,117)(IDTAND(J,N),J=1,4) 117 FORMAT(3(1X,I9.9),1X,I10.3) IF(IP25.NE.0.AND.IP25.NE.KFILDO) 1 WRITE(IP25,117)(IDTAND(J,N),J=1,4) C 120 CONTINUE C C READ CALL LETTERS FOR THE EQUATIONS TO FOLLOW. C THESE ARE NOT ACTUALLY USED. C CALL RDC(KFILDO,KFILDO,KFILEQ,CCALLD,ND5,CTEMP,14, 1 '(14(1X,A8))',NSTA1,'99999999',IER1) IF(IER1.NE.0)THEN WRITE(KFILDO,122)EQNNAM 122 FORMAT(/,' ****READING OF EQUATIONS ABORTED AT 122', 1 ' IN RDEQNG ON FILE ',A60) GO TO 800 ENDIF C C READ THE NUMBER OF TERMS IN THE EQUATIONS. C 1335 STATE=' 134' READ(KFILEQ,134,IOSTAT=IOS,ERR=900,END=900)NTRMS 134 FORMAT(' ',I4) C IF(NTRMS.EQ.0)THEN WRITE(KFILDO,135)EQNNAM 135 FORMAT(/,' ****ZERO TERMS INDICATED FOR NEXT EQUATION', 1 ' AT 135 IN RDEQNG ON FILE ',A60,/, 2 ' READING OF EQUATIONS ABORTED.') IER=167 GO TO 950 ENDIF C IF(NTRMS.GT.ND2)THEN WRITE(KFILDO,1350)NTRMS,ND2,EQNNAM 1350 FORMAT(/,' ****NUMBER OF TERMS INDICATED FOR NEXT', 1 ' EQUATION =',I4,' IS GT ND2 =',I4,/, 2 ' AT 1350 IN RDEQNG ON FILE ',A60,/, 3 ' READING OF EQUATIONS ABORTED.') IER=167 GO TO 950 ENDIF C WRITE(KFILDO,1355)NTRMS 1355 FORMAT(/' NUMBER OF TERMS IN EQUATIONS, NTRMS =',I4) C C READ THE PREDICTOR ID'S. C STATE=' 136' READ(KFILEQ,136,IOSTAT=IOS,ERR=900,END=900) 1 ((IDEQN(J,KGP,M),J=1,4),M=1,NTRMS) 136 FORMAT(' ',I9.9,2I10,I11) C WRITE(KFILDO,137)((IDEQN(J,KGP,M),J=1,4),M=1,NTRMS) 137 FORMAT(/' ((IDEQN(J,KGP,M),J=1,4),M=1,NTRMS)',/(4I11)) C C READ THE PREDICTAND AVERAGES, CORRELATIONS, AND CONSTANTS. C SINCE THE DECIMAL POINT IS WITH THE EQUATIONS, IT DOESN'T C MATTER WHETHER E12.5, E12.7, OR EVEN E12.0 IS USED FOR C READING. C STATE=' 137' READ(KFILEQ,138,IOSTAT=IOS,ERR=900,END=900) 1 (AVG(KGP,N),N=1,NTAND) STATE=' 138' READ(KFILEQ,138,IOSTAT=IOS,ERR=900,END=900) 1 (CORR(KGP,N),N=1,NTAND) STATE=' 139' READ(KFILEQ,138,IOSTAT=IOS,ERR=900,END=900) 1 (CONST(KGP,N),N=1,NTAND) 138 FORMAT(' ',10(E13.6)) C THIS WAS CHANGED FROM 13.7 TO 13.6 TO KEEP WCOSS C WARNING ERROR FROM HAPPENING. THE INPUT SHOULD C HAVE A DECIMAL POINT, SO IT SHOULD WORK. C C READ THE COEFFICIENTS. C STATE=' 140' C DO 140 M=1,NTRMS READ(KFILEQ,138,IOSTAT=IOS,ERR=900,END=900) 1 (COEF(KGP,M,N),N=1,NTAND) 140 CONTINUE C MTRMS(KGP)=NTRMS IF(MTRMS(KGP).EQ.0)KGP=KGP-1 C THE ABOVE STATEMENT CAUSES THE PREVIOUSLY READ C EQUATION TO NOT BE KEPT BECAUSE THERE ARE NO C STATIONS WITH IT FOR WHICH FORECASTS ARE TO BE MADE. MTANDS=NTAND C C WRITE PREDICTAND MEANS IF DESIRED. C IF(IP25.NE.0)THEN WRITE(IP25,145)(AVG(KGP,N),N=1,MIN(6,NTAND)) 145 FORMAT(/' AVERAGES FOR PREDICTANDS',26X,6F12.5) IF(NTAND.GT.6)WRITE(IP25,146)(AVG(KGP,N),N=7,NTAND) 146 FORMAT(51X,6F12.5) ENDIF C C WRITE MULTIPLE CORRELATIONS IF DESIRED. C IF(IP25.NE.0)THEN WRITE(IP25,150)(CORR(KGP,N),N=1,MIN(6,NTAND)) 150 FORMAT(/' CORRELATION COEFFICIENTS',26X,6F12.5) IF(NTAND.GT.6)WRITE(IP25,151)(CORR(KGP,N),N=7,NTAND) 151 FORMAT(51X,6F12.5) ENDIF C C WRITE EQUATIONS IF DESIRED. C IF(IP25.NE.0)THEN WRITE(IP25,160)(CONST(KGP,N),N=1,MIN(6,NTAND)) 160 FORMAT(' REGRESSION EQUATION(S)',/,' CONSTANT',39X,6E12.5) IF(NTAND.GT.6)WRITE(IP25,161)(CONST(KGP,N),N=7,NTAND) 161 FORMAT(51X,6E12.5) C DO 180 M=1,NTRMS WRITE(IP25,170) 1 (IDEQN(J,KGP,M),J=1,4), 2 (COEF(KGP,M,N),N=1,MIN(6,NTAND)) 170 FORMAT(3X,3(1X,I9.9),1X,I10.3,7X,6E12.5) IF(NTAND.GT.6)WRITE(IP25,171)(COEF(KGP,M,N),N=7,NTAND) 171 FORMAT(51X,6E12.5) C 180 CONTINUE C C WRITE CALL LETTERS FOR THIS SET. ENDIF C 190 IF(IP25.NE.0)WRITE(IP25,191) 191 FORMAT(/,' ****************************************') C D WRITE(KFILDO,218)KGP D218 FORMAT(/' KGP'/(' ',I4)) D WRITE(KFILDO,219)MTANDS D219 FORMAT(/' MTANDS'/(' ',I4)) D WRITE(KFILDO,222)(MTRMS(M),M=1,KGP) D222 FORMAT(/' MTRMS'/(' ',30I4)) C 800 IF(IER.EQ.0)IER=IER1 C IER1 COMES FROM RDC. GO TO 950 C 900 CALL IERX(KFILDO,KFILDO,IOS,'RDEQNG',STATE) IER=168 C 950 CONTINUE C CALL TIMPR(KFILDO,KFILDO,'END RDEQNG ') RETURN END