SUBROUTINE RDEQNM(KFILDO,KFILEQ,EQNNAM, 1 IP18, 2 CCALLD,NSTA1, 3 KGP, 4 MTRMS,MTANDS, 5 IDEQN, 6 CONST, 7 AVG,CORR, 8 COEF, 9 ND14,ND15,ND5,ND13,IER) C C APRIL 2017 GLAHN MDL MOS-2000 C REVISED FROM RDEQNG USED IN U405A C APRIL 2017 GLAHN ADDED NSTA1 TO CALL C JULY 2017 GLAHN CHANGING ND2 TO ND14 AND ND3 TO ND15 C SEPTEMBER 2017 GLAHN ADDED 'IDTAND(1,NTAND+1)=0' AFTER 115 C JUNE 2018 GLAHN REVISED TO NOT READ THE FIRST 3 C HEADER RECORDS; REMOVED IDTAND( , ) C JUNE 2018 GLAHN REVISED FOR NO STATIONS I LIST C JUNE 2018 GLAHN REVISED FOR KGP OUTPUT VICE INPUT 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 FOR ALL REGIONS (CURRENTLY ONLY ONE). C C THE THREE HEADER RECORDS ARE READ IN RDEQHR. 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 = NAME OF FILE CORRESPONDING TO KFILEQ. (INPUT) C IP18 = INDICATES WHETHER (>0) OR NOT (=0) DIAGNOSTIC C INFO WILL BE WRITTEN TO UNIT IP18. (INPUT) C CCALLD(K) = STATIONS FOR THIS EQUATION SET (K=1,ND5) C (CHARACTER*8) (OUTPUT) C NSTA1 = NUMBER OF STATIONS READ INTO CCALLD( ). MUST C BE LE ND5. (OUTPUT) C KGP = THE NUMBER OF REGIONAL EQUATIONS. MUST BE C LE ND13. (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 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. (OUTPUT) 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 ND14 = MAXIMUM NUMBER OF TERMS IN ANY EQUATION. C USED AS DIMENSION OF SEVERAL VARIABLES. (INPUT) C ND15 = 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. DIMENSION OF CCALLD( ). (INPUT) C ND13 = MAXIMUM NUMBER OF DIFFERENT EQUATIONS PER SET. C IER = STATUS RETURN. C 0 = GOOD RETURN. C 167 = NUMBER OF TERMS IN EQUATION = 0 OR GT ND14. C 168 = SYSTEM ERROR READING. C 169 = NUMBER OF EQUATIONS GT ND13. C 20 = ERROR OR END OF FILE ON UNIT KFILEQ OR C DATES ON EQUATION FILE DO NOT MATCH NDATE C (FROM RDC OR RDEQNM). C 21 = LIST TOO LONG FOR DIMENSION ND ON UNIT C KFIL (FROM RDC). C 196 = NUMBER OF GROUP KGP GT ND13. C MTANDS = 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,ND14) DIMENSION CONST(ND13,ND15), 1 AVG(ND13,ND15), 2 CORR(ND13,ND15) DIMENSION COEF(ND13,ND14,ND15) C CALL TIMPR(KFILDO,KFILDO,'START RDEQNM ') IER=0 KGP=0 C C READ THE STATION CALL LETTERS INTO CCALLD( ). C 120 STATE='130 ' CALL RDC(KFILDO,KFILDO,KFILEQ,CCALLD,ND5,CTEMP,14, 1 '(14(1X,A8))',NSTA1,'99999999',IER1) C D WRITE(KFILDO,129)IER1,NSTA1,(CCALLD(J),J=1,NSTA1) D129 FORMAT(/' AT 129 IN RDEQNM--IER1,NSTA1',2I8/ D 1 (14(1X,A8))) C C FOR MELD OPERATIONS, THE STATION LIST MAY HAVE ONLY C ONE TOKEN STATION WITH THE 99999999 TERMINATOR. THAT C IS OK, THE STATION LIST IS NOT USED. AN EMPTY LIST C WILL HALT READING. NOTE CCALLD( ) IS NOT DIMENSIONED C FOR MULTIPLE REGIONS. C IF(IER1.NE.0)THEN WRITE(KFILDO,130)EQNNAM,IER1 130 FORMAT(/,' ****ERROR READING EQUATIONS. ABORTED AT 130', 1 ' IN RDEQNM ON FILE ',A60/ 2 ' IER =',I4,' FROM RDC.') GO TO 800 ELSEIF(NSTA1.EQ.0)THEN C AN EMPTY SET OF STATIONS SIGNALS THE END OF ALL C REGIONAL EQUATIONS. LEAVE THE FILE IN THIS POSITION C BECAUSE IN OPERATIONS ANOTHER PROJECTION MAY C FOLLOW. THIS IS A GOOD RETURN. FILE POSITION IS C READY FOR ANOTHER PROJECTION. GO TO 950 ENDIF C C FALL THROUGH MEANS STATION CALL LETTERS HAVE BEEN READ, C SO REGIONAL EQUATIONS FOLLOW. UPDATE KGP. C KGP=KGP+1 C IF(KGP.GT.ND13)THEN WRITE(KFILDO,132)KGP,ND13 132 FORMAT(/' ****NUMBER OF REGIONAL EQUATIONS KGP =',I4, 1 ' GT ND13 =',I4,' READING OF EQUATIONS ABORTED IN', 2 ' RDEQNM AT 132.') KGP=KGP-1 C KGP REDUCED TO NOT CAUSE POSSIBLE TROUBLE IN CALLING C ROUTINE. IER=169 GO TO 950 ENDIF C C READ THE NUMBER OF TERMS IN THE EQUATIONS. C 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 RDEQNM ON FILE ',A60,/, 2 ' READING OF EQUATIONS ABORTED.') IER=167 GO TO 950 ENDIF C IF(NTRMS.GT.ND14)THEN WRITE(KFILDO,1350)NTRMS,ND14,EQNNAM 1350 FORMAT(/,' ****NUMBER OF TERMS INDICATED FOR NEXT', 1 ' EQUATION =',I4,' IS GT ND14 =',I4,/, 2 ' AT 1350 IN RDEQNM 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,MTANDS) STATE=' 138' READ(KFILEQ,138,IOSTAT=IOS,ERR=900,END=900) 1 (CORR(KGP,N),N=1,MTANDS) STATE=' 139' READ(KFILEQ,138,IOSTAT=IOS,ERR=900,END=900) 1 (CONST(KGP,N),N=1,MTANDS) 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,MTANDS) 140 CONTINUE C CCCCC READ THE TERMINATOR. NECESSARY FOR OPERATIONS CCCCC WHEN PROJECTIONS ARE ON THE SAME FILE. C CCCC READ(KFILEQ,141)ITERM CCCC 141 FORMAT(I9) C CCCC IF(IERM.NE.99999999)THEN CCCC WRITE(KFILDO,142) CCCC 142 FORMAT(/' ****TERMINTOR NOT FOUND AFTER READING', CCCC 1 ' EQUATIONS. STOP IN RDEQNM AT 142.') CCCC STOP 142 CCCC ENDIF C MTRMS(KGP)=NTRMS C C WRITE PREDICTAND MEANS IF DESIRED. C IF(IP18.NE.0)THEN WRITE(IP18,145)(AVG(KGP,N),N=1,MIN(6,MTANDS)) 145 FORMAT(/' AVERAGES FOR PREDICTANDS',26X,6F12.5) IF(MTANDS.GT.6)WRITE(IP18,146)(AVG(KGP,N),N=7,MTANDS) 146 FORMAT(51X,6F12.5) ENDIF C C WRITE MULTIPLE CORRELATIONS IF DESIRED. C IF(IP18.NE.0)THEN WRITE(IP18,150)(CORR(KGP,N),N=1,MIN(6,MTANDS)) 150 FORMAT(/' CORRELATION COEFFICIENTS',26X,6F12.5) IF(MTANDS.GT.6)WRITE(IP18,151)(CORR(KGP,N),N=7,MTANDS) 151 FORMAT(51X,6F12.5) ENDIF C C WRITE EQUATIONS IF DESIRED. C IF(IP18.NE.0)THEN WRITE(IP18,160)(CONST(KGP,N),N=1,MIN(6,MTANDS)) 160 FORMAT(' REGRESSION EQUATION(S)',/,' CONSTANT',39X,6E12.5) IF(MTANDS.GT.6)WRITE(IP18,161)(CONST(KGP,N),N=7,MTANDS) 161 FORMAT(51X,6E12.5) C DO 180 M=1,NTRMS WRITE(IP18,170) 1 (IDEQN(J,KGP,M),J=1,4), 2 (COEF(KGP,M,N),N=1,MIN(6,MTANDS)) 170 FORMAT(3X,3(1X,I9.9),1X,I10.3,7X,6E12.5) IF(MTANDS.GT.6)WRITE(IP18,171)(COEF(KGP,M,N),N=7,MTANDS) 171 FORMAT(51X,6E12.5) C 180 CONTINUE C C WRITE CALL LETTERS FOR THIS SET. ENDIF C 190 IF(IP18.NE.0)WRITE(IP18,191) 191 FORMAT(/,' ****************************************') C WRITE(KFILDO,218)KGP 218 FORMAT(/' KGP'/(' ',I4)) WRITE(KFILDO,219)MTANDS 219 FORMAT(/' MTANDS'/(' ',I4)) WRITE(KFILDO,222)(MTRMS(M),M=1,KGP) 222 FORMAT(/' MTRMS'/(' ',30I4)) C GO TO 120 C ANOTHER SET OF REGIONAL EQUATIONS MAY EXIST. NO WAY C TO TELL EXCEPT TO READ STATION LIST. C 800 IF(IER.EQ.0)IER=IER1 C IER1 COMES FROM RDC. GO TO 950 C 900 CALL IERX(KFILDO,KFILDO,IOS,'RDEQNM',STATE) IER=168 C 950 CONTINUE C D CALL TIMPR(KFILDO,KFILDO,'END RDEQNM ') RETURN END