SUBROUTINE CVLMPM(KFILDO,KFIL10,IP16,NDATE,ID,IDPARS,JD,ICYCLE, 1 IDMOS,XDATA,FD2,FD3,ND1,NSTA, 2 IBSTRT,IBEND,MOSFUL, 3 LSTORE,ND9,LITEMS, 4 IS0,IS1,IS2,IS4,ND7, 5 IPACK,IWORK,DATA,ND5, 6 CORE,ND10,NBLOCK,NSTORE,NFETCH, 7 L3264B,ISTOP,IER) C C APRIL 2011 GLAHN MDL MOS-2000 C APRIL 2011 GLAHN ADDED CALL TO CVLMPR C MAY 2011 GLAHN ADDED NINT IN DO 155 LOOP C MAY 2012 GLAHN ADDED ICYCLE, CHANGED DEFINITION C OF MDATE C MAY 2012 GLAHN IDPARS(12) CHNAGED TO C IDPARS(12)+ICYCLE BELOW 1375; C ICYCLE PUT INTO CALL CVLMPR C MAY 2012 GLAHN CORRECTED DEFINITION OF F C MAY 2012 IM ADDED IADD3 AND LD(3)+3; C IADD3 PUT INTO CALL CVLMPR C FEBRUARY 2015 GLAHN CORRECTED WRITING TO FORMATS 135, 138; C DEFINED LD3SAV; DEFINED MOSFUL AND C PUT INTO CALL C C PURPOSE C TO MERGE LAMP AND MOS CATEGORICAL FORECASTS OF EITHER C CEILING HEIGHT OR VISIBILITY FOR ANALYSIS. THE BEGINNING C OF THE MERGE IS AT IBSTRT, AND THE FULL MOS IS AT IBEND. C WHEN IBEND < 26, LAMP WILL FADE OUT BEFORE LAMP C PROJECTION 25. WHEN MOS PROJECTIONS DON'T MATCH THE C LAMP PROJECTIONS, LINEAR INTERPOLATION IN TIME BETWEEN C TWO 3-H MOS PROJECTIONS IS DONE. UPON RETURN, XDATA( ) C WILL CONTAIN WHOLE CATEGORIES AS NEEDED BY SCLCIG OR C SCLVIS. EVEN THOUGH THE NUMBER OF CATEGORIES FOR C CEILING HEIGHT AND VISIBILITY ARE DIFFERENT, THE C CALCULATIONS HERE DO NOT DEPEND ON THAT. THREE C 6-HOURLY CYCLES OF MOS FORECASTS ARE SEARCHED UNTIL C ONE IS FOUND STARTING WITH THE MOST RECENT CYCLE C LE THE LAMP CYCLE. CVLMPM IS ENTERED FROM U405A ONLY C WHEN IDPARS(12) GE IBSTRT. C C WHEN MOS IS TO BE USED, THE PROBABILITIES ARE READ IN C CVLMPR, INTERPOLATED TO THE NEEDED PROJECTION, AND C WRITTEN TO INTERNAL STORAGE. THESE HAVE THE SAME IDS C AS LAMP PROBABILITIES (IF THEY EXIST), EXCEPT THE MOS C ARE WRITTEN WITH A 1 IN ID(2) TO DISTINGUISH THEM. C ALSO, MOSFUL IS SET = 1 WHEN MOS IS USED EXCLUSIVELY C SO THAT THE CORRECT PROBABILITIES WILL BE USED. THE C CHANGEOVER FROM LAMP TO MOS SHOULD OCCUR AT PROJECTION C 26, SO THAT MOSFUL WOULD NOT BE NEEDED. HOWEVER, THE C SWITCH TO MOS COULD BE MADE EARLIER, OR THIS SAME C SETUP COULD BE USED TO ANALYZE MOS FOR ALL PROJECTIONS, C EVEN THOUGH LAMP WERE AVAILABLE. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C IP16 - INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP16 C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWGTS,A RANDOM ACCESS FILE IS WRITTEN C THROUGH PAWRAC, OR A FILE IS WRITTEN TO C INTERNAL STORAGE BY GSSTORE. (INPUT) C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT/OUTPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP16 C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWGTS,A RANDOM ACCESS FILE IS WRITTEN C THROUGH PAWRAC, OR A FILE IS WRITTEN TO C INTERNAL STORAGE BY GSSTORE. (INPUT) C NDATE = DATE/TIME, YYYYMMDDHH, OF ANALYSIS RUN. C (INPUT) C ID(J) = ID OF VARIABLE TO PROVIDE DATA FOR ANALYSIS C (J=1,4). (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C VARIABLE ID'S CORRESPONDING TO ID( ,N) C (J=1,15), (N=1,ND4). 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 C 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK C 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 (INPUT) C JD(J) = THE BASIC INTEGER VARIABLE ID'S (J=1,4) C (N=1,ND4). C THIS IS THE SAME AS ID(J,N), EXCEPT THAT THE C PORTIONS PERTAINING TO PROCESSING ARE OMITTED: C B = IDPARS(3, ), C T = IDPARS(8,), C I = IDPARS(13, ), C S = IDPARS(14, ), C G = IDPARS(15, ), AND C THRESH( ). C NOT ACTUALLY USED. (INPUT) C ICYCLE = CYCLE OF RUN = JDATE(4) IN CALLING PROGRAM. C (INPUT) C IDMOS(J) = 4-WORD ID OF MOS CEILING HEIGHT (OR VISIBILITY) C THAT MATCHES THE LAMP CEILING (OR VISIBILITY) C (J=1,4). (INPUT) C XDATA(K) = MERGED LAMP AND MOS (INTERPOLATED IN TIME IF C NECESSARY) CATEGORICAL VALUES (WHOLE NUMBERS) C ON OUTPUT (K=1,NSTA). (INPUT/OUTPUT) C FD2(K) = WORK ARRAY (K=1,NSTA). (INTERNAL) C FD3(K) = WORK ARRAY (K=1,NSTA). (INTERNAL) C ND1 = DIMENSION OF XDATA( ), FD2( ), AND FD3( ). C (INPUT) C NSTA = NUMBER OF STATIONS BEING USED; THE NUMBER C OF VALUES IN XDATA( ). (INPUT) C IBSTRT = THE PROJECTION BELOW WHICH A FORECAST C IS COMPLETELY LAMP. (INPUT) C IBEND = THE PROJECTION AT AND ABOVE WHICH A FORECAST C IS COMPLETELY MOS. (INPUT) C MOSFUL = 1 WHEN MOS IS USED WITHOUT LAMP. THIS HAPPENS C WHEN IDPARS(12) GE IBEND. (OUTPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). (INPUT/OUTPUT) C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ). C SECOND DIMENSION OF LSTORE( , ). (INPUT) C LITEMS = THE NUMBER OF ITEMS J IN LSTORE( ,L). C (INPUT/OUTPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C (INPUT) C IPACK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C DATA(J) = WORK ARRAY FOR GFETCH (J=1,ND5). (INTERNAL) C (NOT ACTUALLY USED.) C ND5 = DIMENSION OF IPACK( ), WORK( ), AND DATA( ). C (INPUT) C CORE(J) = SPACE ALLOCATED FOR SAVING PACKED GRIDPOINT C FIELDS (J=1,ND10). WHEN THIS SPACE IS C EXHAUSTED, SCRATCH DISK WILL BE USED. THIS IS C THE SPACE USED FOR THE MOS-2000 INTERNAL RANDOM C ACCESS SYSTEM. (INPUT) C ND10 = THE MEMORY IN WORDS ALLOCATED TO THE SAVING OF C DATA CORE( ). WHEN THIS SPACE IS EXHAUSTED, C SCRATCH DISK WILL BE USED. (INPUT) C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK C STORAGE. (INPUT) C NSTORE = NUMBER OF TIMES A RECORD HAS BEEN STORED TO C INTERNAL STORAGE. (INPUT/OUTPUT) C NFETCH = NUMBER OF TIMES A RECORD HAS BEEN FETCHED FROM C INTERNAL STORAGE. (INPUT/OUTPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C ISTOP(J) = ISTOP(1) IS INCREMENTED BY 1 WHENEVER AN ERROR C OCCURS AND THE PROGRAM PROCEEDS. ISTOP(3) IS C INCREMENTED BY 1 WHEN A DATA RECORD COULD C NOT BE FOUND THAT SHOULD HAVE BEEN AND IS C CRITICAL. WHEN AN ERROR OCCURS AND IER IS C RETURNED NE 0, THE INCREMENTING OF ISTOP(1) C IS DONE IN THE CALLING PROGRAM (U405A). C (INPUT/OUTPUT) C IER = ERROR CODE. C 0 = GOOD RETURN. C 103 = COULD NOT IDENTIFY ID IN INTERNAL TABLE. C OTHER VALUES FROM CALLED ROUTNES. EVERY C ERROR IS FATAL FOR THIS ELEMENT. C (OUTPUT) C NSLAB = SLAB OF THE GRID CHARACTERISTICS. RETURNED C BY GFETCH. (INTERNAL) C NTIMES = THE NUMBER OF TIMES GFETCH HAS BEEN ACCESSED. C (INTERNAL) C LASTL = THE LAST LOCATION IN CORE( ) USED. RETURNED C FROM GSTORE. (INTERNAL) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK C IN INTERNAL RANDOM ACCESS STORAGE. RETURNED C FROM GSTORE. (INTERNAL) C ITABLE(J) = THE VALUES ARE ID(1) OF THE FORECASTS OF LAMP C CEILING AND MOS CEILING (J=1), AND OF LAMP C VISIBILITY AND MOS VISIBILITY (J=2). (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C GFETCH, UPDAT, CVLMPR C DIMENSION ID(4),IDPARS(15),JD(4),IDMOS(4),LD(4) DIMENSION XDATA(ND1),FD2(ND1),FD3(ND1) DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION ISTOP(3),ITABLE(2) C DATA ITABLE/208071000, 1 208131000/ C THESE VALUES ARE ID(1) OF LAMP CEILING OR VISIBILITY. C CALL TIMPR(KFILDO,KFILDO,'START CVLMPM ') IER=0 MOSFUL=0 C MOSFUL SET AS A SAFETY. C D WRITE(KFILDO,101)(ITABLE(J),J=1,2) D101 FORMAT(/' AT 101 IN CVLMPM--', D 1 '(ITABLE(J),J=1,2)',/,(2I11)) C C DETERMINE WHETHER VARIABLE IS IN THE ITABLE( ). C DO 105 L=1,2 C IF(ID(1).EQ.ITABLE(l)+IDPARS(4))THEN GO TO 111 ENDIF C 105 CONTINUE C C DROP THROUGH HERE MEANS THE ID WAS NOT FOUND. C IER=103 WRITE(KFILDO,110)(ID(J),J=1,4),IER 110 FORMAT(/' ****VARIABLE ',I9.9,I10.9,I10.9,I4.3,' NOT', 1 ' ACCOMMODATED IN SUBROUTINE CVLMPM. IER =',I3) GO TO 900 C C GET THE LAMP CATEGORICAL CEILING OR VISIBILITY FORECAST C WHEN THE PROJECTION IS LT IBEND. C 111 IF(IDPARS(12).LT.IBEND)THEN CALL GFETCH(KFILDO,KFIL10,ID,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,XDATA,ND1, 2 NWORDS,NPACK,NDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) C D WRITE(KFILDO,112)(K,XDATA(K),K=1,100) D112 FORMAT(/,' IN CVLMPM AT 112',/,(8(I7,F8.2))) C JER=0 C IF(IER.NE.0)THEN JER=1 ISTOP(1)=ISTOP(1)+1 ISTOP(3)=ISTOP(3)+1 WRITE(KFILDO,120)(ID(M1),M1=1,4) 120 FORMAT(/' ****COULD NOT FIND LAMP FORECAST', 1 3I10.9,I10,'. ATTEMPT TO USE MOS FORECAST.') C DO 125 K=1,NSTA XDATA(K)=9999. 125 CONTINUE C ENDIF C ELSE C DO 127 K=1,NSTA XDATA(K)=9999. 127 CONTINUE C JER=1 ENDIF C C RETRIEVE 1 OR 2 PROJECTIONS OF MOS FORECASTS, AS C NEEDED. THIS ROUTINE IS ENTERED ONLY WHEN IDPARS(12) GE C IBSTRT. C C GET MOS DATA. HAVE TO COMPUTE CYCLE AND TAU. C MDATE=MOD(ICYCLE,6) CALL UPDAT(NDATE,-MDATE,MDATE) C THIS WILL NOT GO BACK INTO THE PREVIOUS DAY. MDATE C IS THE DATE/TIME FOR MOS. IDIF6=NDATE-MDATE C IDIF6 WILL BE 0 THROUGH 5. IDIF3=MOD(IDIF6,3) LD(1)=IDMOS(1) LD(2)=0 LD(3)=IDPARS(12)-MOD(IDPARS(12),3)+IDIF6-IDIF3 IADD3=0 LD3SAV=LD(3) C IF((NDATE+IDPARS(12)-MDATE-LD(3)).GE.3)THEN LD(3)=LD(3)+3 IADD3=1 LD3SAV=LD(3) ENDIF C LD(4)=0 C DO 130 M=1,3 CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD2,ND1, 2 NWORDS,NPACK,MDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) C IF(IER.NE.0)THEN CALL UPDAT(MDATE,-6,MDATE) LD(3)=LD(3)+6 IDIF6=IDIF6+6 C IDIF6 IS UPDATED BECAUSE IT IS PASSED TO CVLMPR. ELSE GO TO 131 ENDIF C 130 CONTINUE C 131 IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 ISTOP(3)=ISTOP(3)+1 LD(3)=LD3SAV WRITE(KFILDO,135)(LD(M1),M1=1,4),NDATE 135 FORMAT(/' ****COULD NOT FIND MOS FORECAST', 1 3I10.9,I10,' FOR LAMP DATE/TIME',I12) C IF(JER.EQ.0)THEN IER=0 WRITE(KFILDO,136) 136 FORMAT(' LAMP FORECASTS WILL BE USED WHEN', 1 ' AVAILABLE.') GO TO 900 ELSE WRITE(KFILDO,137) 137 FORMAT(' FATAL ERROR IN CVLMPM AT 137') GO TO 900 ENDIF C ENDIF C CCCC WRITE(KFILDO,1370)FD2(256),FD2(176),FD2(318) CCCC 1370 FORMAT(/' AT 1370 IN CVLMPM--FD2(256),FD2(176),', CCCC 1 'FD2(318)',F8.2) C D WRITE(KFILDO,1375)(K,FD2(K),K=1,100) D1375 FORMAT(/,' IN CVLMPM AT 1375',/,(8(I7,F8.2))) C C DETERMINE WHETHER ANOTHER MOS PROJECTION AND INTERPOLATION C IS NEEDED. C IF(MOD(IDPARS(12)+ICYCLE,3).NE.0)THEN C GET 2ND PROJECTION OF MOS DATA. HAVE TO COMPUTE TAU. LD(3)=LD(3)+3 CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD3,ND1, 2 NWORDS,NPACK,MDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) C NOTE THIS IS MDATE FOR MOS. C D WRITE(KFILDO,1376)(K,FD3(K),K=1,100) D1376 FORMAT(/,' IN CVLMPM AT 1376',/,(8(I7,F8.2))) C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 ISTOP(3)=ISTOP(3)+1 WRITE(KFILDO,138)(LD(M1),M1=1,4),NDATE 138 FORMAT(/' ****COULD NOT FIND MOS FORECAST', 1 3I10.9,I10,' FOR DATE',I12) C C IF(JER.EQ.0)THEN C JER = 1 WHEN LAMP IS NOT AVAILABLE. IER=0 WRITE(KFILDO,136) GO TO 900 ELSE WRITE(KFILDO,137) GO TO 900 ENDIF C ELSE C C TWO PROJECTIONS OF MOS AVAILABLE. INTERPOLATE TO THE C LAMP PROJECTION. LEAVE FRACTIONAL VALUES AT THIS POINT C AND ROUNDED LATER. C F=MOD(IDPARS(12)+ICYCLE,3)/3. C DO 140 K=1,NSTA C IF(FD2(K).GT.9998.5.OR.FD3(K).GT.9998.5)THEN FD2(K)=9999. ELSE FD2(K)=(FD3(K)-FD2(K))*F+FD2(K) ENDIF C 140 CONTINUE C D WRITE(KFILDO,141)F,(K,FD2(K),K=1,100) D141 FORMAT(/,' IN CVLMPM AT 141',F10.2,/,(8(I7,F8.2))) C ENDIF C ENDIF C C MERGE LAMP AND (INTERPOLATED) MOS TOGETHER AND PUT C VALUES INTO EVEN CATEGORIES FOR SCLCIG OR SCLVIS. C IF IBEND = IBSTRT, THERE IS NO "MERGE PERIOD." RATHER C THERE IS FULL MOS AT IBEND, AND FULL LAMP AT LT ISTRT. NOTE C THAT CVLMPM IS ENTERED ONLY WHEN IDPARS(12) GE IBSTRT. C IF(IDPARS(12).LT.IBEND)THEN C WHEN IDPARS(12) GE IBEND, NO MERGE IS DONE. MOS IS C USED IN FULL. MOSFUL=0 IF(IBEND.NE.IBSTRT)THEN F2=REAL((IDPARS(12)-IBSTRT))/REAL((IBEND-IBSTRT)) C F2 IS THE FRACTION OF MOS. F1=1.-F2 C F1 IS THE FRACTION OF LAMP. ELSE F1=0. F2=1. ENDIF C D WRITE(KFILDO,145)IDPARS(12),IBSTRT,IBEND,F1,F2 D145 FORMAT(/' AT 145--IDPARS(12),IBSTRT,IBEND,F1,F2',3I4,2F6.2) C DO 150 K=1,NSTA C IF(XDATA(K).GT.9998.5)THEN XDATA(K)=FD2(K) C IF FD2( ) = 9999, THAT IS OK. NO VALUE AVAILABLE. ELSE XDATA(K)=NINT(XDATA(K)*F1+FD2(K)*F2) C NOTE THAT THIS IS ROUNDED TO THE NEAREST CATEGORY. ENDIF C 150 CONTINUE C ELSE C C NO MERGE; USE MOS. C MOSFUL=1 C DO 155 K=1,NSTA XDATA(K)=NINT(FD2(K)) C NOTE THAT THIS IS ROUNDED TO THE NEAREST CATEGORY. C WORKS FOR MISSINGS ALSO. 155 CONTINUE C ENDIF C D WRITE(KFILDO,225)(K,XDATA(K),K=1,100) D225 FORMAT(/,' IN CVLMPM AT 225',/,(8(I7,F8.2))) C C CVLMPM IS NOT CALLED UNLESS IT AND CVLMPR ARE NEEDED. C CVLMPR NOT USED IF LAMP NOT AVAILABLE OR NOT USED C (PROJECTION GE IBEND). C CALL CVLMPR(KFILDO,KFIL10,IP16,NDATE,ID,IDPARS,JD,ICYCLE, 1 FD2,FD3,ND1,NSTA, 2 MDATE,IDIF6,IDIF3,IADD3, 3 LSTORE,ND9,LITEMS, 4 IS0,IS1,IS2,IS4,ND7, 5 IPACK,IWORK,DATA,ND5, 6 CORE,ND10,NBLOCK,NSTORE,NFETCH, 7 L3264B,ISTOP,IER) C CALL TIMPR(KFILDO,KFILDO,'END CVLMPM ') 900 RETURN END