SUBROUTINE COMPID(KFILDO,ID,IDPARS,NDATE,KD,LD,MDOY,R,IER) C C NOVEMBER 1996 GLAHN TDL MOS-2000 C AUGUST 1998 GLAHN COMMENTS UPDATED; LOOP FROM C J=1,14 CHANGED TO J=2,14 AT DO 150 C SEPTEMBER 1998 DALLAVALLE ADDED NO MONTHLY INTERPOLATION C SEPTEMBER 1998 GLAHN ADDED CCCFFF = 40XXXX CAPABILITY C OCTOBER 1998 GLAHN ADDED R=0 AT START C MARCH 2000 DALLAVALLE MODIFIED FORMAT STATEMENTS TO C CONFORM TO FORTRAN 90 STANDARDS C ON IBM SP C MAY 2000 GLAHN ADDED COMMENT FOR R SET = 0 C MARCH 2004 GLAHN/CHARBA MODIFIED FOR 2ND ID FORMAT C BELOW STATEMENT 200 C MARCH 2004 GLAHN/CHARBA MODIFIED CHECK BELOW 200 C MARCH 2008 CHARBA ADDED EXCEPTIONS FOR THE HRMOS QPF C CONSTANTS: C 443999 (REGIONAL WEIGHTS) C 443118 (MAX PROB GE 2") C 443119 (UPPER BOUND GE 2") C 443128 (MAX PROB GE 3") C 443129 (UPPER BOUND GE 3") C WHICH PREVENT DROPPING THE BINARY C INDICATER AND THE MODEL NUMBER. C MAY 2008 CHARBA ADDED ADDITIONAL EXCEPTIONS FOR THE C HRMOS QPF CONSTANTS 443118 AND 443128 C TO INSERT THE MODEL CYCLE IN KD(2) AND C RETAIN THE PROJECTION IN KD(3). C MARCH 2010 CHARBA ADDED AN EXCEPTION FOR THE HRMOS QPF C CONSTANTS: C 443118 (MAX PROB GE 2") C 443119 (UPPER BOUND GE 2") C 443128 (MAX PROB GE 3") C 443129 (UPPER BOUND GE 3") C SUCH THAT THE DATE FOR THE MODEL CYCLE C IS USED TO FORMULATE THE DATE-ID( ) C COMBINATION RATHER THAN THE PROJECTED C DATE. C JANUARY 2011 CHARBA ADDED AN EXCEPTION FOR THE LAMP CON- C VECTION REGIONAL WEIGHTS (ID1=441999) C WHICH PREVENTS DROPPING THE MODEL C NUMBER IN KD(1) AND REMOVES SEASONAL C DEPENDENCE IN KD(2). C JUNE 2011 CHARBA CHANGED TO THE FINAL ID FOR THE CON- C VECTION WEIGHTS (CHANGED FROM 441999 C TO 447999). C MARCH 2018 SAMPLATSKY AS WAS NECESSARY FOR PREVIOUS C REGIONAL WEIGHTS, ADDED AN EXCEPTION C FOR LAMP PQPF REGIONAL WEIGHTS (442 C 999) WHICH PREVENTS DROPPING THE C MODEL NUMBER IN KD(1) AND REMOVES C SEASONAL DEPENDENCE IN KD(2). C C PURPOSE C TO PROVIDE THE IDS FOR EXTRACTING CONSTANT DATA FROM C MOS-2000 EXTERNAL FILES. TWO SETS OF IDS ARE RETURNED, C THE 2ND SET BEING NECESSARY ONLY WHEN INTERPOLATION IS C TO BE DONE. IN ADDITION, THE DOY IS RETURNED AS WELL AS C AN "INTERPOLATION FACTOR," THE LATTER BEING THE FRACTION C OF THE WAY THE DOY IS FROM THE 1ST OF THE TWO VALUES C BEING USED IN INTERPOLATION. C C TWO ID FORMATS ARE ACCOMMODATED, THE SECOND ONE DEFINED C IN MARCH 2004 (SEE MDL ON 00-1, CHAPTER 14) C C THE FOLLOWING CONSTANT IDS ARE ACCOMMODATED IN COMPID: C 40XXXX = TRULY CONSTANT VALUES; DO NOT DEPEND ON TIME C 41XXXX = DAILY VALUES C 422XXX = 5-DAY VALUES (JAN 5, JAN 10, ... C DEC 31 = 365TH DAY) C 43XXXX = MONTHLY VALUES; INTERPOLATION ASSUMED C 44XXXX = 6-MONTH SEASONS (APRIL-SEPTEMBER, ETC); C NO INTERPOLATION PROVIDED FOR C 45XXXX = 3-MONTH SEASONS (MARCH-MAY, JUNE-AUGUST, ETC.); C NO INTERPOLATION PROVIDED FOR C 46XXXX = YEARLY VALUES C 47XXXX = MONTHLY VALUES; NO INTERPOLAATION C C DATA SET USE C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (OUTPUT) C C VARIABLES C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (INPUT) C ID(J) = THE PREDICTOR ID (J=1,4). (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE PREDICTOR C ID CORRESPONDING TO ID( ) (J=1,15). (INPUT) C J=1--CCC (CLASS OF VARIABLE), C J=2--FFF (SUBCLASS OF VARIABLE), C J=3--B (BINARY INDICATOR), C J=4--DD (DATA SOURCE, MODEL NUMBER), C J=5--V (VERTICAL APPLICATION), C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK IN TIME), C J=10--OT (TIME APPLICATION), C J=11--OH (TIME PERIOD IN HOURS), C J=12--TAU (PROJECTION IN HOURS), C J=13--I (INTERPOLATION TYPE), C J=14--S (SMOOTHING INDICATOR), AND C J=15--G (GRID INDICATOR). C IEND = VALID HOUR OF THE CONSTANT FOR THE NEW ID SCHEME C NDATE = THE DATE/TIME FOR WHICH THE CONSTANT IS NEEDED. C (INPUT) C KD(J) = IDS FOR THE CONSTANTS (J=1,4). (OUTPUT) C LD(J) = 2ND SET OF IDS FOR THE CONSTANTS WHEN A SECOND C SET IS NECESSARY. THIS IS WHEN INTERPOLATION C WILL BE NEEDED (E.G., DAILY VALUES FROM 5-DAY C VALUES). (OUTPUT) C MDOY = DAY OF YEAR. (OUTPUT) C R = INTERPOLATION FACTOR, THE FRACTION OF THE WAY C MDOY IS FROM THE FIRST OF THE TWO VALUES TO BE C USED IN INTERPOLATION. IF INTERPOLATION C IS NOT NEEDED, R IS SET TO 0. (OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 161 = COULD NOT IDENTIFY A CCCFFF FOR WHICH TO C COMPUTE KD(2). C 162 = IMPOSSIBLE ERROR DEALING WITH INTERPOLATION C FOR MONTHLY VALUES. C (OUTPUT) C CJ(J) = THE MIDPOINT IN DAYS OF MONTHS (J=1,14). USED C TO COMPUTE R FOR MONTHLY FREQUENCIES. C C NONSYSTEM SUBROUINES USED C DOY C DIMENSION ID(4),IDPARS(15),KD(4),LD(4) DIMENSION CJ(14) DATA CJ/-15.5, 15.5, 45.0, 74.5, 105.0, 135.5, 166.0, 1 196.5, 227.5, 258.0, 288.5, 319.0, 349.5, 380.5/ C IER=0 R=0. C C COMPUTE THE DAY OF THE YEAR. BASE IT ON C NDATE AND TAU. NORMALLY, CONSTANTS WOULD HAVE C A TAU = 0. HOWEVER, FOR FORECASTS OF, SAY, C 5 DAYS, A TAU COULD BE PROVIDED. FOR INTERACTIVE C PREDICTORS INVOLVING A CONSTANT AND A MODEL FIELD, C IT IS ASSUMED THE SAME TAU COULD APPLY TO BOTH. C CALL UPDAT(NDATE,IDPARS(12),NDATEU) C C INSERTED AN EXCEPTION FOR THE HRMOS QPF VARIABLES OF 2" MAX C PROB (443118), 2" UPPER BOUND (443119), 3" MAX PROB (443128), C AND 3" UPPER BOUND (443129) SUCH THAT JYR, JMO, JDA, JHR, AND C MDOY IS BASED ON MODEL CYCLE DATE (NDATE; THE FIRST BRANCH OF C "IF THEN" STATEMENT) RATHER THAN THE PROJECTED DATE (NDATEU; C THE "ELSE" BRANCH)...CHARBA MARCH 2010. C IF (((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.118)).OR. 1 ((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.119)).OR. 2 ((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.128)).OR. 3 ((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.129))) THEN CALL DOY(NDATE,JYR,JMO,JDA,JHR,MDOY) ELSE CALL DOY(NDATEU,JYR,JMO,JDA,JHR,MDOY) ENDIF C C FORM THE ID'S IN KD( ) FOR THE CONSTANTS. KD(2) C DEPENDS ON WHETHER THE VALUES ARE AVAILABLE DAILY, C MONTHLY, SEASONLLY, OR YEARLY. TEMPERATURE AND C DEW POINT, WHEN AVAILABLE EVERY 5 DAYS, BUT C ARE TO BE INTERPOLATED TO DAILY VALUES, REQUIRE C TWO SETS OF IDS; IN THIS CASE THE SECOND SET IS C PROVIDED IN LD( ). ACTUALLY, A SECOND SET IS C ALWAYS PROVIDED IN LD( ) FOR SAFETY. C C THE FIRST BRANCH OF THE "IF THEN" IMMEDIATELY BELOW RETAINS THE C BINARY INDICATER ("B") AND THE MODEL NUMBER ("DD") IN ID(1) FOR C THE HRMOS QPF VARIABLES 443999 (REGIONAL WTS FOR HRMOS QPF), C 443118 (2" MAX PROB), 443119 (2" UPPER BOUND), 443128 (3" MAX C PROB), AND 443129 (3" UPPER BOUND). THE "ELSE" BRANCH DROPS C BOTH PARAMETERS, WHICH APPLIES TO ALL OTHER MOS VARIABLES. C (CHARBA MARCH 2008) C THE LAMP CONVECTION REGIONAL WEIGHTS VARIABLE (447999) ALSO RE- C QUIRE THIS EXCEPTION (CHARBA JANUARY 2011). C THE LAMP PQPF REGIONAL WEIGHTS VARIABLE (442999) ALSO REQUIRE C THIS EXCEPTION (SAMPLATSKY MARCH 2018). C IF (((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.999)).OR. 1 ((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.118)).OR. 2 ((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.119)).OR. 3 ((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.128)).OR. 4 ((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.129)).OR. 4 ((IDPARS(1).EQ.442).AND.(IDPARS(2).EQ.999)).OR. 5 ((IDPARS(1).EQ.447).AND.(IDPARS(2).EQ.999))) THEN KD(1)=ID(1) ELSE KD(1)=IDPARS(1)*1000000+IDPARS(2)*1000 END IF C C THE "IF THEN" IMMEDIATELY BELOW RETAINS THE PROJECTION IN C ID(3) FOR THE VARIABLE 443118 AND 443119 (QPF 2" MAX PROB C AND 2" UB). THE "ELSE" DROPS IT, WHICH IS THE NORMAL PATH. C (EXCEPTION IS NEEDED FOR HRMOS QPF, CHARBA MAY 2008 / C MARCH 2010). C C INSERTED AN EXCEPTION FOR THE HRMOS QPF CONSTANT VARIABLES OF C 2" MAX PROB (443118), 2" UPPER BOUND (443119), 3" MAX PROB C (443128), AND 3" UPPER BOUND (443129) SUCH THAT THE PROJECTION C IN ID(3) IS RETAINED IN KD(3) (THE FIRST BRANCH OF THE "IF C THEN" STATEMENT). THE "ELSE" BRANCH DROPS THE PROJECTION, C WHICH APPLIES TO ALL OTHER MOS CONSTANT VARIABLES. C CHARBA MARCH 2010. C IF((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.118).OR. 1 (IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.119).OR. 2 (IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.128).OR. 3 (IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.129)) THEN KD(3)=ID(3) ELSE KD(3)=0 ENDIF KD(4)=ID(4) C LD(1)=KD(1) LD(3)=KD(3) LD(4)=KD(4) C C THIS SECTION FOR CONSTANTS THAT DO NOT DEPEND ON TIME. C IF(IDPARS(1)/10.EQ.40)THEN KD(2)=0 LD(2)=0 C C THIS SECTION FOR DAILY VALUES. C ELSEIF(IDPARS(1)/10.EQ.41)THEN KD(2)=MDOY*10000 LD(2)=KD(2) C C THIS SECTION FOR MONTHLY VALUES. ASSUMES C INTERPOLATION IS TO BE DONE IN DEFINING C THE 2ND ID. C ELSEIF(IDPARS(1)/10.EQ.43)THEN DDOY=MDOY C DO 150 J=2,14 IF(DDOY.LE.CJ(J))GO TO 155 150 CONTINUE C C DROP THROUGH LOOP SHOULD NOT HAPPEN. WRITE(KFILDO,151)IDPARS(1),IDPARS(2) 151 FORMAT(/,' ****IMPOSSIBLE ERROR IN COMPID,', 1 ' IDENTIFIERS IN COMPID FOR CCCFFF = ', 2 2I3.3) IER=162 GO TO 250 C 155 R=(DDOY-CJ(J-1))/(CJ(J)-CJ(J-1)) M=J-2 IF(M.EQ.0)M=12 C IF DDOY IS IN THE FIRST HALF OF JANUARY, THE FIRST C SET OF FREQUENCIES MUST BE FROM DECEMBER. KD(2)=(1000+M)*10000 C N=J-1 IF(N.EQ.13)N=1 C IF DDOY IS IN THE LAST HALF OF DECEMBER, THE SECOND C SET OF FREQUENCIES MUST BE FROM JANUARY. LD(2)=(1000+N)*10000 C C THIS SECTION FOR 3-MONTH SEASONS (MAR-MAY, ETC). C ELSEIF(IDPARS(1)/10.EQ.45)THEN IF(JMO.GE.3.AND.JMO.LE.5)THEN KD(2)=10130000 ELSEIF(JMO.GE.6.AND.JMO.LE.8)THEN KD(2)=10140000 ELSEIF(JMO.GE.9.AND.JMO.LE.11)THEN KD(2)=10150000 ELSE KD(2)=10160000 ENDIF C LD(2)=KD(2) C C THIS SECTION FOR 6-MONTH SEASONS (APR-SEPT, ETC). C ELSEIF(IDPARS(1)/10.EQ.44)THEN IF(JMO.GE.4.AND.JMO.LE.9)THEN KD(2)=10170000 ELSE KD(2)=10180000 ENDIF C C FOR THE HRMOS QPF CONSTANTS 443118 (2" MAX PROB) AND C 443128 (3" MAX PROB) REPLACE "10" IN KD(2) WITH THE MODEL C CYCLE...CHARBA MAY 2008. C IF((IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.118).OR. 1 (IDPARS(1).EQ.443).AND.(IDPARS(2).EQ.128)) THEN ICYC=MOD(NDATE,100) KD(2)=ICYC*1000000+MOD(KD(2),1000000) ENDIF C C FOR CONVEC REGIONAL WEIGHTS (447999), SET KD(2)=0 SINCE C THERE IS NO SEASONAL DEPENDENCE (CHARBA JAN 2011). C FOR LAMP PQPF REGIONAL WEIGHTS (442999), SET KD(2)=0 SINCE C THERE IS NO SEASONAL DEPENDENCE (SAMPLATSKY MAR 2018). C IF((IDPARS(1).EQ.447.AND.IDPARS(2).EQ.999).OR. 1 (IDPARS(1).EQ.442.AND.IDPARS(2).EQ.999)) THEN KD(2)=0 ENDIF C LD(2)=KD(2) C C THIS SECTION FOR YEARLY VALUES. C ELSEIF(IDPARS(1)/10.EQ.46)THEN KD(2)=10190000 LD(2)=KD(2) C C THIS SECTION FOR MONTHLY RELATIVE FREQUENCIES C FOR WHICH INTERPOLATION TO THE DAY OF THE MONTH C IS NOT DESIRED. C ELSEIF(IDPARS(1)/10.EQ.47)THEN KD(1)=(IDPARS(1)-40)*1000000+IDPARS(2)*1000 KD(2)=(1000+JMO)*10000 LD(1)=KD(1) LD(2)=KD(2) C C THIS SECTION FOR 2 SETS OF IDS, BASED ON C 5-DAY VALUES BEING AVAILABLE. ASSUMES C THE FIRST VALUE IS FOR JAN. 5 AND KD(2) RELATES C TO THAT. LD(2) = KD(2) + 5 DAYS. C ELSEIF(IDPARS(1).EQ.422)THEN LDOY=(MDOY/5)*5 R=(MDOY-LDOY)/5. KD(2)=LDOY*10000 LD(2)=KD(2)+50000 IF(KD(2).EQ.0)KD(2)=3650000 IF(LD(2).GT.3650000)LD(2)=50000 C ELSE IER=161 WRITE(KFILDO,200)IDPARS(1),IDPARS(2) 200 FORMAT(/,' ****COULD NOT COMPUTE CONSTANT', 1 ' IDENTIFIERS IN COMPID FOR CCCFFF = ', 2 2I3.3) ENDIF C C NOW MODIFY AS NECESSARY FOR THE 2ND OPTION FOR ID C STRUCTURE. THIS OPTION IS SIGNALED WHEN THE 2ND DIGIT C IN ID WORD 2 IS EITHER 2 (FOR DAILY VALUES) OR 3 (FOR C NON DAILY VALUES). C IF(IDPARS(1)/10.NE.40.OR. 1 IDPARS(1).NE.412.OR. 2 IDPARS(1).NE.422)THEN C IF(IDPARS(6)/1000.EQ.2.OR.IDPARS(6)/1000.EQ.3)THEN IEND=MOD(MOD(NDATE,100)+IDPARS(12),24) KD(2)=KD(2)+20000000 KD(3)=IDPARS(8) *100000000+ 1 IDPARS(9) *1000000+ 2 IDPARS(10)*100000+ 3 IEND *1000 LD(1)=KD(1) LD(2)=LD(2)+20000000 LD(3)=KD(3) ENDIF C ENDIF C C WRITE(KFILDO,249)ID,NDATE,KD,LD,MDOY,R C249 FORMAT(/,' IN COMPID--ID,NDATE,KD,LD,MDOY,R',/, C 1 4I11,I15,/,4I11,5X,4I11,I10,F6.2) 250 RETURN END