SUBROUTINE 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 C APRIL 2011 GLAHN MDL MOS-2000 C MAY 2012 GLAHN ADDED ICYCLE; IDPARS(12) C CHNAGED TO IDPARS(12)+ICYCLE C BELOW 120 C MAY 2012 GLAHN CORRECTED DEFINITION OF F C MAY 2012 IM ADDED IADD3 AND LD(3)+3 C C PURPOSE C CVLMPR READS MOS PROBABILITIES, AND PREPARES C A PROBABILITY FOR THE PROJECTION BEING ADDRESSED. C IF NECESSARY, 2 MOS PROBABILITIES ARE READ AND C INTERPOLATED. THE MOS PROBABILITIES ARE WRITTEN C IDENTIFIED AS LAMP SO THAT THE REST OF U155 CAN C OPERATE AS IF ALL WERE LAMP. C C CVLMPR IS CALLED FROM CVLMPR. 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 GSTORE. (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 GSTORE. (INPUT) C MDATE = DATE/TIME, YYYYMMDDHH, OF TIME OF ANALYSIS. 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 FD2(K) = WORK ARRAY (K=1,NSTA). (INTERNAL) C FD3(K) = WORK ARRAY (K=1,NSTA). (INTERNAL) C ND1 = DIMENSION OF FD2( ) AND FD3( ). (INPUT) C NSTA = NUMBER OF STATIONS BEING USED; THE NUMBER C OF VALUES IN XDATA( ). (INPUT) C MDATE = DATE/TIME, YYYYMMDDHH, OF THE MOS CYCLE BEING C USED. (INPUT) C IDIF6 = PASSED IN FROM CVLMPM. (INPUT) C IDIF3 = PASSED IN FROM CVLMPM. (INPUT) 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 BE AND IS CRITICAL. C WHEN AN ERROR OCCURS AND IER IS RETURNED NE 0, C THE INCREMENTING OF ISTOP(1)IS DONE IN THE C CALLING PROGRAM (U405A). (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 JTABLE(I,J,L,M) = HOLDS THE 4-WORD IDS OF THE PROBABILITIES C (I=1,4) (J=1,IDCV(1)) OF CEILING (M=1) FOR LAMP C (L=1) AND OF MOS (J=1,IDCV(2)) (L=2). LAMP C AND MOS PROBABILITIES ARE INITIALLY CUMULATIVE, C BUT MOS HAS BEEN POSTPROCESS TO DISCRETE. C FOR THIS REASON, LAMP AND MOS ARE NOT MERGED, C BUT RATHER MOS IS USED. THE "B" IS 2 FOR C DISCRETE IN JTABLE( , , , ) FOR BOTH LAMP AND C MOS, BECAUSE THE LAMP ID IS FOR WRITING, AND C IS NOW DISCRETE, COMING FROM MOS. (INTERNAL) C L = 1 FOR CEILING HEIGHT; = 2 FOR VISIBILITY. C (INPUT) C IDCAT = 2ND DIMENSION OF JTABLE( , , , ). (INTERNAL) C (SET BY PARAMETER) C IDCV(J) = THE NUMBER OF MOS PROBABILITY CATEGORIES TO USE C FOR CEILING (J=1) AND VISIBILITY (J=2). C (INTERNAL) C RACK(J) = PLAIN LANGUAGE WRITE TO IP16 FOR CEILING (J=1) C AND VISIBILITY (J=2) (CHARACTER*32) (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C GFETCH, UPDAT C PARAMETER (IDCAT=8) C CHARACTER*32 RACK(2) DIMENSION ID(4),IDPARS(15),JD(4),IDMOS(4),LD(4),IDCV(2) DIMENSION 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),JTABLE(4,IDCAT,2,2) C DATA ITABLE/208071000, 1 208131000/ DATA IDCV/7,6/ DATA RACK/' MOS CEILING PROBABILITY OF CATS', 1 ' MOS VISBY PROBABILITY OF CATS '/ C C THESE VALUES ARE ID(1) OF LAMP CEILING OR VISIBILITY. C DATA JTABLE/208070305,0,0,150001000, 2 208070305,0,0,450001000, 3 208070305,0,0,950001000, 4 208070305,0,0,195002000, 5 208070305,0,0,305002000, 6 208070305,0,0,655002000, 7 208070305,0,0,120503000, 8 208070305,0,0,999994000, C ABOVE ARE LAMP CEILING PROBABILITIES. NOTE THE C B = 3 FOR DISCRETE, BECAUSE MOS IS DISCRETE. C A 208050308,0,0,150001000, B 208050308,0,0,450001000, C 208050308,0,0,950001000, D 208050308,0,0,195002000, E 208050308,0,0,305002000, F 208050308,0,0,655002000, G 208050308,0,0,120503000, H 208050308,0,0,999994000, C ABOVE ARE MOS CEILING PROBABILITIES. C 1 208130205,0,0,495000000, 2 208130205,0,0,950000000, 3 208130205,0,0,195001000, 4 208130205,0,0,295001000, 5 208130205,0,0,505001000, 6 208130205,0,0,605001000, 7 208130205,0,0,999994000, 9 000000000,0,0,000000000, C ABOVE ARE LAMP VISIBILITY PROBABILITIES. NOTE THE C B = 2 FOR CUMULATIVE BECAUSE MOS IS CUMULATIVE. C LAST VALUE IS A DUMMY. C A 208130208,0,0,495000000, B 208130208,0,0,950000000, C 208130208,0,0,195001000, D 208130208,0,0,295001000, E 208130208,0,0,505001000, F 208130208,0,0,605001000, G 208130208,0,0,999994000, I 000000000,0,0,000000000/ C ABOVE ARE MOS VISIBILITY PROBABILITIES. LAST VALUE C IS DUMMY. C CALL TIMPR(KFILDO,KFILDO,'START CVLMPR ') IER=0 C D WRITE(KFILDO,101)(ITABLE(J),J=1,2) D101 FORMAT(/' AT 101 IN CVLMPR--', D 1 '(ITABLE(J),J=1,2)',/,(2I11)) C C DETERMINE WHETHER VARIABLE IS IN THE ITABLE( ). C DO 103 L=1,2 C IF(ID(1).EQ.ITABLE(L)+IDPARS(4))THEN GO TO 105 C L IS DEFINED AT THIS POINT, 1 FOR CEILING AND C 2 FOR VISIBILITY. ENDIF C 103 CONTINUE C DROP THROUGH HERE MEANS THE ID WAS NOT FOUND. C IER=103 WRITE(KFILDO,104)(ID(J),J=1,4),IER 104 FORMAT(/' ****VARIABLE ',I9.9,I10.9,I10.9,I4.3,' NOT', 1 ' ACCOMMODATED IN SUBROUTINE CVLMPR. IER =',I3) GO TO 900 C C PROCESS ALL PROBABILITY LEVELS. C 105 DO 200 IC=1,IDCV(L) C C GET THE MOS PROBABILITY FORECAST. C LD(1)=JTABLE(1,IC,2,L) LD(2)=0 LD(3)=IDPARS(12)-MOD(IDPARS(12),3)+IDIF6-IDIF3 IF(IADD3.GT.0) LD(3)=LD(3)+3 LD(4)=JTABLE(4,IC,2,L) 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 D WRITE(KFILDO,112)(K,FD3(K),K=1,100) D112 FORMAT(/,' FD3( ) IN CVLMPR AT 112',/,(8(I7,F8.3))) 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 MOS PROBABILITY', 1 3I10.9,I10) C ENDIF 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,FD2,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,FD2(K),K=1,100) D1376 FORMAT(/,' FD2( ) IN CVLMPR AT 1376',/,(8(I7,F8.3))) C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 ISTOP(3)=ISTOP(3)+1 WRITE(KFILDO,138)(ID(M1),M1=1,4),MDATE 138 FORMAT(/' ****COULD NOT FIND MOS FORECAST', 1 3I10.9,I10,' FOR DATE',I12) GO TO 900 C ELSE C C TWO PROJECTIONS OF MOS AVAILABLE. INTERPOLATE TO THE C LAMP PROJECTION. C F=MOD(IDPARS(12)+ICYCLE,3)/3. C DO 140 K=1,NSTA C IF(FD3(K).GT.9998.5.OR.FD2(K).GT.9998.5)THEN FD3(K)=MIN(FD2(K),FD3(K)) C THIS RETAINS THE PROBABILITY IF ONLY ONE IS C PRESENT. ELSE FD3(K)=(FD2(K)-FD3(K))*F+FD3(K) ENDIF C 140 CONTINUE C D WRITE(KFILDO,141)F,(K,FD3(K),K=1,100) D141 FORMAT(/,' FD3( ) IN CVLMPR AT 141',F10.2,/,(8(I7,F8.3))) C ENDIF C ENDIF C C WRITE THE PROBABILITY FIELD TO INTERNAL STORAGE. C LD(1)=JTABLE(1,IC,1,L) LD(2)=1 C LD(2) IS SET TO 1 TO DISTINGUISH THIS MERGED PROBABILITY C FROM THE ORIGINAL ONE. LD(3)=IDPARS(12) LD(4)=JTABLE(4,IC,1,L) CALL GSTORE(KFILDO,KFIL10,LD,0,LSTORE,ND9,LITEMS, 1 FD3,NSTA,1,0,NDATE, 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C "NSLAB" IS STORED AS ZERO SIGNIFYING VECTOR DATA. C THE RECORD WRITTEN WILL HAVE THE SAME ID AS THE C GRID EXCEPT THE 2ND WORD = 970000. C IF(IER.EQ.0)THEN C IF(IP16.NE.0)THEN WRITE(IP16,155)(LD(JJ),JJ=1,4), 1 RACK(L),NDATE 155 FORMAT(/' WRITING DATA TO UNIT KFIL10',3I10.9,I10.3,3X, 1 A32,' FOR DATE',I12) ENDIF C ELSE C A DIAGNOSTIC WILL HAVE OCCURRED IN GSTORE. ISTOP(1)=ISTOP(1)+1 JER=1 WRITE(KFILDO,160)(LD(JJ),JJ=1,4) 160 FORMAT(' ERROR WRITING VARIABLE',3(1X,I9.9),1X,I10.3, 1 ' TO INTERNAL STORAGE.',/, 2 ' SOME COMPUTATIONS (PRE- OR POST-PROCESSING)', 3 ' MAY NOT BE ABLE TO BE MADE. PROCEEDING.') ENDIF C 200 CONTINUE C CALL TIMPR(KFILDO,KFILDO,'END CVLMPR ') 900 RETURN END