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
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
D WRITE(KFILDO,205)
D205 FORMAT(/' END OF CVLMPR')
C
900 RETURN
END