SUBROUTINE CONVPR(KFILDO,KFIL10,IP16,ID,IDPARS, 2 P,NX,NY, 3 LSTORE,ND9,LITEMS,NDATE, 4 IS0,IS1,IS2,IS4,ND7, 5 IPACK,IWORK,DATA,ND5, 6 CORE,ND10,NBLOCK,NFETCH,NSLAB, 6 IPLAIN,L3264W,L3264B,ISTOP,JER,IER) C C MARCH 2008 GLAHN TDL MOS-2000 C JUNE 2008 GLAHN IMPROVED DIAGNOSTICS AT 115, 130 C OCTOBER 2008 COSGROVE ADDED COMMAS TO FORMAT 130 FOR IBM C APRIL 2010 GLAHN ADDED AVERAGE AND MAX CHANGE C APRIL 2010 GLAHN MODIFIED PRINT FOR LOWEST LEVEL C JUNE 2010 GLAHN INSERTED WRITING TO INTERNAL STORAGE; C ADDED IP16, PLAIN, L3264W, JER TO CALL C JUNE 2010 GLAHN OMITTED WRITING WHEN THRESHOLD NOT C FOUND; MODIFIED COUNT TO > 0.1% C APRIL 2013 IM MOS/LAMP TEAM LEADERS MADE A DECISION C TO MAKE FINAL OUTPUT UNIT=DECIMAL C (INSTEAD OF PERCENT), SO MODIFIED COUNT C > 0.1% TO COUNT > 0.001 ACCORDINGLY. C JUNE 2014 GLAHN IER SET = 666 ON GSTORE ERROR C JANUARY 2015 GLAHN CHANGED G=1 TO G=2 WHEN WRITING AND C READING THE CONSISTENT GRID C MARCH 2018 GLAHN MODIFIED 205 TO CONFORM TO LAMP OPS C C PURPOSE C TO MAKE SURE THE PROBABILITY OF A CUMULATIVE VISIBILITY C CATEGORY IS AT LEAST AS HIGH AS THE NEXT LOWER CATEGORY. C ITABLE IS FOR VISIBILITY. THE CONSISTENT GRID IS C WRITTEN TO INTERNAL STORAGE WITH G=2 VICE G=1 BECAUSE C G=1 IS USED IN U405A FOR ALL POSTPROCESSED GRIDS. C C NOTE THAT IF SETPNT IS USED WITH PROBABILITIES (IN THE C RANGE 0 TO 1), THE MAX CHANGE MAY USUALLY BE .05. C ALTHOUGH IT MAY NOT HAPPEN OFTEN, THAT ALSO AFFECTS THE C AVERAGE CHANGE. USUALLY SETPNT WON'T BE USED WITH C PROBABILITIES. SETPNT COULD BE CHANGED TO GIVE C AN OFFSET OF 001, SAY, VICE .05. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO INTERNAL STORAGE. (OUTPUT)C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) 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 ID(J) = ID OF VARIABLE BEING ANALYZED (J=1,4). C (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C ID'S CORRESPONDING TO ID( ) C (J=1,15). (INPUT) C P(IX,JY) = GRID OF VISIBILITY PROBABILITIES C (IX=1,NX) (JY=1,NY). (INPUT/OUTPUT) C NX = X EXTENT OF GRID IN P( , ). (INPUT) C NY = Y EXTENT OF GRID IN P( , ). (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 NDATE = THE DATE/TIME OF THE RUN. (INPUT) 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(IX,JY) = WORK ARRAY (IX=1,NX) (JY=1,NY). DIMENSIONED C ND5 IN CALLING PROGRAM. (INTERNAL) C ND5 = DIMENSION OF IPACK( ), AND IWORK( ). 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 NFETCH = INCREMENTED EACH TIME DATA ARE FETCHED BY C GFETCH. IT IS A RUNNING COUNT FROM THE C BEGINNING OF THE PROGRAM. THIS COUNT C IS MAINTAINED IN CASE THE USER NEEDS IT C (DIAGNOSTICS, ETC.). (OUTPUT) C NSLAB = SLAB OF THE GRID CHARACTERISTICS. RETURNED C BY GFETCH. USED FOR CHECKING FOR EQUAL C CHARACTERISTICS OF GRIDS READ. (OUTPUT) C IPLAIN(L,J) = 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN C LANGUAGE DESCRIPTION OF VARIABLE TO BE WRITTEN. C NOTE THAT THIS REQUIRES TWO 32-BIT WORDS TO HOLD C THE DESCRIPTION BUT ONLY ONE 64-BIT WORD. C EQUIVALENCED TO PLAIN( ) IN DRU155. (INPUT) C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C (INPUT) 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 EACH TIME AN ERROR C OCCURS. C ISTOP(3)--IS INCREMENTED WHEN A DATA RECORD C COULD NOT BE FOUND. C (INPUT/OUTPUT) C IER = ERROR RETURN. C 0 = GOOD RETURN. C (OUTPUT) C TABLE(M) = HOLDS THE 4TH WORD ID FOR THE NOCAT CATEGORIES C OF VISIBILITY (M=1,NOCAT). (INTERNAL) C NOCAT = THE NUMBER OF VISIBILITY CATEGORIES FORECAST C BY LAMP MINUS 1. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C NONE C PARAMETER(NOCAT=6) C DIMENSION ID(4),IDPARS(15),LD(4) DIMENSION IPLAIN(L3264W,4) DIMENSION P(NX,NY),DATA(NX,NY) DIMENSION IPACK(ND5),IWORK(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION ITABLE(NOCAT) DIMENSION ISTOP(5) C DATA ITABLE/ 495000000, 1 950000000, 2 195001000, 3 295001000, 4 505001000, 5 605001000/ C CALL TIMPR(KFILDO,KFILDO,'START CONVPR ') IER=0 C C FIND THE CATEGORY. C DO 110 J=1,NOCAT C IF(ID(4).EQ.ITABLE(J))THEN C IF(J.EQ.1)THEN C THIS IS THE LOWEST CATEGORY. CAN'T CHECK A LOWER ONE. C BECAUSE ALL LEVELS ARE USED TO COMPUTE THE LAPSE, THE C U405A.CN IS USED FOR ALL PROBABILITY LEVELS. C THEREFORE, CONVPR OR CONCPR (OR EQUIVALENT) HAS TO C BE IN THE u405A.CN FOR THE LOWEST LEVEL OR NO LEVELS C WILL BE CHECKED. WRITE(KFILDO,105) 105 FORMAT(/' PROBABILITY OF < 0.5 MI CANNOT CHECKED FOR', 1 ' CONSISTENCY WITH NEXT LOWER LEVEL.') GO TO 210 ELSE GO TO 120 C J HAS BEEN DEFINED. ENDIF C ENDIF C 110 CONTINUE C C DROP THROUGH HERE MEANS THE CATEGORY WAS NOT FOUND. C WRITE(KFILDO,115)(ID(L),L=1,4) 115 FORMAT(/,' ****COULDN''T FIND THRESHOLD FOR ID ',4I10, 1 ' IN TABLE IN CONVPR.',/, 2 ' GRID NOT CHECKED', 3 ' FOR CONSISTENCY WITH LOWER CATEGORY.') ISTOP(1)=ISTOP(1)+1 C NOT COUNTED AS FATAL. GO TO 350 C THIS CATEGORY IS UNKNOWN TO CONVPR, SO IT DOES NOT C NEED TO BE WRITTEN. C 120 LD(1)=ID(1) LD(2)=ID(2) LD(3)=ID(3) LD(4)=ITABLE(J-1)+2 C THE G=2 IS TO GET THE "CONSISTENT" GRID. A GRID IS C WRITTEN IN U405A BEFORE CHECKING IS DONE (WITH G=0) C AND ALSO AFTER ALL POSTPROCESSING WITH G=1. CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA,ND5, 2 NWORDS,NPACK,NDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) IF(IER.NE.0)THEN WRITE(KFILDO,130)(LD(L),L=1,4),(ID(L),L=1,4) 130 FORMAT(/,' ****COULDN''T FETCH GRID ',4I10, 1 ' FROM INTERNAL STORAGE IN CONVPR.',/, 2 ' GRID ',4I10,' NOT CHECKED', 3 ' FOR CONSISTENCY WITH LOWER CATEGORY.') ISTOP(1)=ISTOP(1)+1 ISTOP(3)=ISTOP(3)+1 IER=0 C NOT COUNTED AS FATAL. GO TO 210 C THIS CATEGORY IS WRITTEN SO THAT IT WILL BE C AVAILABLE FOR THE NEXT HIGHER LEVEL, EVEN IF IT COULD C NOT BE CHECKED. THIS MIGHT HAPPEN IF ONE LEVEL WERE C OMITTED. ENDIF C ICOUNT=0 CHG=0. CHGMAX=0. C DO 140 JY=1,NY DO 139 IX=1,NX C THE GRIDS HAVE LIKELY BEEN CLIPPED AND CONTAIN 9999'S C IN THE BORDERS. ALL CHANGES WILL BE POSITIVE. C IF(DATA(IX,JY).LT.9998..AND.P(IX,JY).LT.9998.)THEN DIFF=DATA(IX,JY)-P(IX,JY) C IF(DIFF.GT.0.)THEN D WRITE(KFILDO,138)IX,JY,ICOUNT,DATA(IX,JY),P(IX,JY),DIFF D138 FORMAT(' IN CONVPR--IX,JY,ICOUNT,DATA(IX,JY),P(IX,JY),DIFF', D 1 3I7,3F10.4) C P(IX,JY)=DATA(IX,JY) C IF(DIFF.GT.0.001)THEN ICOUNT=ICOUNT+1 CHG=CHG+DIFF CHGMAX=MAX(CHGMAX,DIFF) ENDIF C ENDIF C ENDIF C 139 CONTINUE 140 CONTINUE C IF(ICOUNT.GT.0)THEN CHG=CHG/ICOUNT WRITE(KFILDO,205)ICOUNT,CHG,CHGMAX 205 FORMAT(/,I6,' VALUES IN THE VISIBILITY PROBABILITY GRID', 1 ' MODIFIED BY THE NEXT LOWER CATEGORY BY > 0.001.', 2 ' AVG CHG =',F6.3,' MAX CHG =',F7.3) ELSE WRITE(KFILDO,206) 206 FORMAT(/' VISIBILITY PROBABILITY GRID CONSISTENT WITH NEXT', 1 ' LOWER ONE.') ENDIF C C GSTORE WRITES THE "CONSISTENT" GRID TO INTERNAL STORAGE C ON FILE KFIL10. TO DISTINGUISH IT FROM THE ONE WRITTEN C IN U405A, IDPARS(15) IS SET TO 1. THIS GRID IS ALWAYS C WRITTEN, ANTICIPATING A CHECK WITH THE ONE ABOVE. C NOTE THAT THIS IS NOT CLIPPED AS IT MAY BE FOR OUTPUT C TO OTHER MEDIA. C 210 LD(1)=ID(1) LD(2)=ID(2) LD(3)=ID(3) LD(4)=ID(4)+2 NSLAB=0 C THE G=2 IS TO DISTINGUISH THE GRID FROM THE ONE WRITTEN C IN U405A WITH G=0 AND ALSO WITH G=1. THIS ONE IS THE C ONE "CONSISTENT" WITH THE LOWER LEVELS. CALL GSTORE(KFILDO,KFIL10,LD,NSLAB,LSTORE,ND9,LITEMS, 1 P,NX*NY,1,0,NDATE, 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C "NSLAB" IS STORED AS ZERO SIGNIFYING THE DATA ARE NOT C PACKED AND CAN BE TREATED AS VECTOR DATA. C IF(IER.EQ.0)THEN C IF(IP16.NE.0)THEN WRITE(IP16,3475)(LD(JJ),JJ=1,4), 1 ((IPLAIN(I,JJ),I=1,L3264W),JJ=1,4),NDATE 3475 FORMAT(/' WRITING DATA TO UNIT KFIL10',3I10.9,I10.3,3X, 1 8A4,' FOR DATE',I12) ENDIF C ELSE C A DIAGNOSTIC WILL HAVE OCCURRED IN GSTORE. ISTOP(1)=ISTOP(1)+1 JER=1 WRITE(KFILDO,348)(LD(JJ),JJ=1,4) 348 FORMAT(' ERROR WRITING VARIABLE',3(1X,I9.9),1X,I10.3, 1 ' TO INTERNAL STORAGE.',/, 2 ' CHECKING OF PROBABILITY GRIDS FOR CONSISTENCY', 3 ' MAY NOT BE ABLE TO BE MADE.') IER=666 ENDIF C CALL TIMPR(KFILDO,KFILDO,'END CONVPR ') 350 RETURN END