SUBROUTINE CONEKD(KFILDO,KFIL10,ID,IDPARS, 1 P,NX,NY, 2 LSTORE,ND9,LITEMS,NDATE, 3 IS0,IS1,IS2,IS4,ND7, 4 IPACK,IWORK,DATA,ND5, 5 CORE,ND10,NBLOCK,NFETCH,NSLAB, 6 L3264B,ISTOP,IER) C C AUGUST 2008 GLAHN TDL MOS-2000 C JANUARY 2009 GLAHN CCCFFF = 222000 ADDED FOR CHECKING C JANUARY 2009 GLAHN CCCFFF'S ADDED FOR DEWPOINT C JANUARY 2009 GLAHN TREATING NON-CONSISTENCY LEVEL C TO LEVEL AS AN ERROR C MARCH 2012 GLAHN ADDED READING MODIFIED TEMP GRID C WITH ID(4)+1; IER SET = 0 ON RETURN; C STARTED WITH JOHN WAGNER VERSION; C SPELL CHECK C APRIL 2012 WAGNER ADDED AN IF STATEMENT AROUND WRITE C STATEMENT 130 C JUNE 2014 GLAHN RETURNED IER=666 IF GRID NOT CHECKED C MARCH 2018 GLAHN TOOK THE OPS VERSION; IT HAD ONE MORE C ID CHECK C C PURPOSE C TO MAKE SURE THE VARIABLE AT A PARTICULAR PROBABILITY C LEVEL IS AT LEAST AS HIGH AS THE VARIABLE VALUE AT A C LOWER PROBABILITY LEVEL ON A CDF. THIS IS C SPECIFICALLY FOR EKDMOS TEMP, DP, MAX, AND MIN. THESE C VARIABLES DO NOT HAVE THRESHOLD VALUES, BUT THE C PROBABILITY LEVELS ARE INDICATED IN THE 2ND WORD, AS C XXXPPXXXX. THE ROUTINE IS ENTERED WITH A PROBABILITY C LEVEL GRID IN P. INTERNAL STORAGE IS SEARCHED FOR UP C TO THREE LOWER PROBABILITY LEVELS AT 5 PERCENT INCREMENTS. C THIS ALLOWS CHANGING THE LEVELS AT WHICH THE ANALYSES ARE C MADE WITHOUT CHANGING ALL .CN FILES. IT IS UNLIKELY C THE PROBABILITY LEVELS WILL BE MORE THAN 15 PERCENT APART, C AND IF THEY ARE, CONSISTENCY WOULD NOT BE AS MUCH OF C A CONCERN AS IF THEY WERE, SAY, 5 PERCENT APART. C ONLY LEVELS AT 5 PERCENT INCREMENTS ARE DEALT WITH. C IF A 1 PERCENT LEVEL WERE ADDED, IT WOULD NOT BE CHECKED C WITH ANYTHING WITHOUT MODIFICATION OF THIS ROUTINE. C IF THE LEVELS ANALYZED ARE AT INCREMENTS > 15%, THEN C THE LIMIT OF LOOP DO 150 CAN BE INCREASED FROM L=1,3 TO C L=1,X TO MAKE SURE TO GET A PREVIOUS GRID. C C WITH THE MARCH 2012 MOD, THE LOWER LEVEL GRIDS CHECKED C ARE THE ONES PREVIOUSLY CHECKED. THESE SHOULD HAVE C BEEN WRITTEN WITH IWRITF( ) SET = 1. 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 C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (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(IXY) = GRID OF VARIABLE AT A PARTICULAR PROBABILITY C LEVEL (IXY=1,NX*NY) TREATED AS A C SINGLE DIMENSIONED VARIABLE. (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(IXY) = WORK ARRAY (IXY) TREATED AS A SINGLE C DIMENSIONED VARIABLE. ND5 IN CALLING PROGRAM. C (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 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 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C NONE C DIMENSION ID(4),IDPARS(15),LD(4) DIMENSION P(NX*NY) 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(5) C CD CALL TIMPR(KFILDO,KFILDO,'START CONEKD ') IER=0 D ICOUNT=0 C CCCD WRITE(KFILDO,110)ID CCCD110 FORMAT(/,' AT 110 IN CONEKD--ID',4I12) C C FIND WHETHER THE VARIABLE IS DEALT WITH. SO FAR, C THIS IS ONLY TEMPERATURE AND DEW POINT. THE OTHER C VARIABLES, LIKE QPF, WILL LIKELY HAVE THRESHOLDS C AND BE PROBABILITY LEVELS AT SPECIFIC VALUES C OF THE VARIABLE RATHER THAN BEING SPECIFIC VALUES C AT A PROBABILITY LEVEL. C IF(ID(1)/1000.EQ.222020.OR. 1 ID(1)/1000.EQ.222000.OR. 2 ID(1)/1000.EQ.222120.OR. 3 ID(1)/1000.EQ.222120.OR. 4 ID(1)/1000.EQ.222220.OR. 5 ID(1)/1000.EQ.222060.OR. C 6 ID(1)/1000.EQ.223020.OR. 7 ID(1)/1000.EQ.223000.OR. 8 ID(1)/1000.EQ.223120.OR. 9 ID(1)/1000.EQ.223120.OR. A ID(1)/1000.EQ.223220.OR. B ID(1)/1000.EQ.224360)THEN GO TO 120 ELSE C C DROP THROUGH HERE MEANS THE CCCFFF WAS NOT FOUND. C WRITE(KFILDO,115)(ID(L),L=1,4) 115 FORMAT(/,' ****CCCFFF NOT HANDLED IN CONEKD', 2 ' GRID NOT CHECKED FOR CONSISTENCY WITH', 2 ' LOWER PROBABILITY LEVEL.') ISTOP(1)=ISTOP(1)+1 C NOT COUNTED AS FATAL. GO TO 210 ENDIF C 120 IF(ID(2)/10000.EQ.5)GO TO 210 C IT IS ASSUMED THE LOWEST LEVEL IS 5 PERCENT, SO C A 5 PERCENT LEVEL DOES NOT HAVE A LOWER LEVEL. C DO 150 L=1,3 C IF THE LEVELS ANALYZED ARE AT INCREMENTS > 15%, THEN C THE LIMIT OF LOOP DO 150 CAN BE INCREASED FROM L=1,3 TO C L=1,X TO MAKE SURE TO GET A PREVIOUS GRID. LD(1)=ID(1) LD(2)=ID(2)-10000*L*5 LD(3)=ID(3) IP=1 110 LD(4)=ID(4)+IP C THE +1 IS FOR THE POSTPROCESSED GRID. IF(ID(2)/10000.LE.0)GO TO 210 C THE LOWEST LEVEL TO LOOK FOR IS 5. SEARCH WILL BE C AT 5 PERCENT INTERVALS. C 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) C IF(IER.EQ.0)THEN GO TO 160 ELSE C IF(IP.EQ.0)THEN C IF(L.EQ.3)THEN WRITE(KFILDO,130)(LD(J),J=1,4),(ID(J),J=1,4) 130 FORMAT(/,' **** GRID',4I10,' NOT FETCHED', 1 ' FROM INTERNAL STORAGE IN CONEKD.',/, 2 ' GRID',4I10,' NOT CHECKED FOR', 3 ' CONSISTENCY WITH LOWER PROBABILITY LEVEL.') ISTOP(1)=ISTOP(1)+1 ISTOP(3)=ISTOP(3)+1 C NOT COUNTED AS FATAL. IER=666 GO TO 210 ELSE GO TO 150 ENDIF C ELSE IP=0 C IF THE POSTPROCESSED GRID IS NOT AVAILABLE, TRY THE C ONE NOT POSTPROCESSED. IF(L.EQ.3)THEN WRITE(KFILDO,1300)(LD(J),J=1,4) 1300 FORMAT(/,' ****POSTPROCESSED GRID NOT AVAILABLE IN', 1 ' CONEKD',2X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3,/ 2 ' TRY TO RETRIEVE UNPOSTPROCESSED GRID.', 3 ' THIS WILL HAVE INTERNAL SMOOTHING APPLIED.') ENDIF C DON'T COUNT THIS AS A MISSING GRID BECAUSE CHECKING C AT 5% INCREMENTS IT IS EXPECTED NOT ALL WILL BE FOUND. GO TO 110 C ENDIF C ENDIF C 150 CONTINUE C C DROP THROUGH MEANS A NEXT LOWER LEVEL WAS FOUND. C 160 DO 170 IXY=1,NX*NY C IF(DATA(IXY).LE.9998.9)THEN C DATA( ) INTERNAL STORAGE HAS NOT BEEN CLIPPED, C BUT P( ) HAS. C IF(DATA(IXY).GT.P(IXY))THEN P(IXY)=DATA(IXY) CD ICOUNT=ICOUNT+1 ENDIF C ENDIF C 170 CONTINUE C D IF(ICOUNT.GT.0)THEN D WRITE(KFILDO,205)ICOUNT D 205 FORMAT(/,'****NUMBER OF VALUES IN THE PROBABILITY GRID', D 1 ' MODIFIED BY THE VALUES IN THE NEXT LOWER', D 2 ' CATEGORY = ',I12) C IT IS EXPECTED THE INPUT VECTOR DATA WILL BE CONSISTENT C FROM LEVEL TO LEVEL, AND THEREFORE THE ANALYSIS SHOULD C BE ALSO. SO TREAT NON-CONSISTENCY AS AN ERROR. ISTOP(1)=ISTOP(1)+1 CD ELSE CD WRITE(KFILDO,206) CD206 FORMAT(/' GRID CONSISTENT WITH NEXT LOWER CATEGORY.') D ENDIF C 210 IF(IER.NE.666)IER=0 RETURN END