SUBROUTINE MRMSQC(KFILDO,KFIL10,IP12,ID,IDPARS,JD,NDATE, 1 CCALL,ICALLD,CCALLD,ISDATA,SDATA,DIR,ND1,NSTA, 2 IPACK,IWORK,DATA,ND5,KFILRA,RACESS, 3 FD1,ND2X3,NGRIDC,NGRID,ND11, 4 NSLAB,LSTORE,ND9,LITEMS,CORE,ND10, 5 NBLOCK,NFETCH,LASTL,LASTD,NSTORE, 6 IS0,IS1,IS2,IS4,ND7, 7 ISTAV,L3264B,L3264W,IER) C C OCTOBER 2016 SAMPLATSKY MDL MOS-2000 C OCTOBER 2016 SAMPLATSKY SET UP THIS OPER VERSION OF THE C CODE, WHICH COMBINES 2 DEV CODES C INTO A SINGLE U202/GRIDPOST C SUBROUTINE. ALSO RESTRUCTURED C SOME LOGIC TO REMOVE GOTO C STATEMENTS. JUST ERROR RETURN C GOTO STATEMENTS REMAIN. C MARCH 2017 SAMPLATSKY FIXED BUGS PERTAINING TO FETCHING C GFS AND HRRR GRIDS C APRIL 2017 SAMPLATSKY IMPROVED DOCUMENTATION C OCTOBER 2017 SAMPLATSKY HAD TO MODIFY AN IF STATEMENT IN C THE SPIKE ECHO CHECK SECTION TO C NOT USE A VARIABLE THAT WAS NEVER C INITIALIZED. ALSO MODIFIED LOGIC C NEAR THE END OF THE CODE WHERE C THE RESULTS OF THE QC ARE PRINTED C TO PREVENT A SEG FAULT. SEE IN- C LINE COMMENT. ALSO MODIFIED LOGIC C IN THE FINAL QC APPLICATION DUE C TO AN OVERSIGHT WITH ADDITIONAL C UNDEFINED VARIABLES. AS A RESULT, C ADDED DEFINITIONS FOR RMIN AND C RMAX VARIABLES, AND REPLACED ALL C INSTANCES OF NUMGRD WITH NUMRL. C OCTOBER 2017 SAMPLATSKY ADDED DOCUMENTATION OF ALL ARRAY C AND PARAMETER VARIABLES. C SEPTEMBER 2018 SAMPLATSKY ADDED PROCESSING FOR MRMS 1H C PRECIP AC AND NN GRIDS. C MARCH 2019 SAMPLATSKY MODIFIED ERROR PRINT STATEMENT C REGARDING FETCHING 1H PRECIP. C APRIL 2019 SAMPLATSKY MODIFIED HANDLING OF FETCHING C HRRR DATA. A SPECIAL MESSAGE C WILL BE PRINTED IF THE HRRR IS C MISSING, AND PROCESSING WILL C CONTINUE TO LEAD TO "CLEANER" C FAILURE IN DOWNSTREAM JOBS. C SEPTEMBER 2020 SAMPLATSKY REMOVED A CALL TO PRSID1 PRIOR C TO CONSTG, WHICH TURNED OUT TO C NOT EVEN BE NEEDED. THE LDPARS C ARRAY IN THE CALL WAS NEVER C DIMENSIONED, WHICH WAS LEADING C TO RANDOM RUNTIME ERRORS. C C PURPOSE C PERFORM QC CHECKS ON ALL MRMS VARIABLES IN DATARL( , , ) AND C RETURN QC VARIABLES IN DATAO( , , ). PROCEED BY PERFORM- C ING A SINGLE PASS THROUGH GRID AND EXECUTING OPERATIONS IN C THE ORDER: C - SET 9998.1 VALUES IN VIL AND STMTP TO RMIN( ) C (LOWER TRUNCATION BOUND) FOR BOTH RAW AND C QC'D GRIDS C - CHECK CREF FOR CONSISTENCY WITH BOTH LTG C OCCURRENCE AND VIL, STMTP, AND PCRT THRESHOLDS C - WHERE A CHECK INDICATES A FALSE ECHO SET ALL C QC'D VARIABLES TO 9999. C - APPLY LOWER AND UPPER TRUNCATION BOUNDS ON C EACH (NON-MISSING) OUTPUT VARIABLE C C VARIABLES C NX,NY = DIMENSIONS OF GRID. (INTERNAL) C NUMREG = NUMBER OF GEOGRAPHICAL REGIONS. (INTERNAL) C NUMCONS = NUMBER OF CONSTANT RECORDS THAT WILL BE READ C IN AND USED. (INTERNAL) C NUMRL = NUMBER OF MRMS AND LIGHTNING RECORDS THAT WILL C BE READ IN. (INTERNAL) C NUMMODEL = NUMBER OF HRRR AND GFS MODEL RECORDS THAT WILL C BE READ IN. (INTERNAL) C NUM_MRMSCAT = NUMBER OF MRMS CREF "BINS" WHICH WILL BE USED C FOR QC DECISIONS. (INTERNAL) C IRAD_HRRRCREF = THE RADIUS, IN TERMS OF GRID COORDINATES, OF C A CIRCLE TO BE USED FOR LOCAL CHECKING BETWEEN C MRMS AND HRRR CREF. (INTERNAL) C IRAD_GFSPWBLI = THE RADIUS, IN TERMS OF GRID COORDINATES, OF C A CIRCLE TO BE USED FOR LOCAL CHECKING WHICH C INVOLVES THE GFS PW AND BLI. (INTERNAL) C TH_VIL = CREF THRESHOLD TO BE USED IN CROSS-VALIDATING C MRMS CREF AND VIL VALUES. (INTERNAL) C TH_STP = CREF THRESHOLD TO BE USED IN CROSS-VALIDATING C MRMS CREF AND STP30 VALUES. (INTERNAL) C TMP_STPVIL = CODED VALUE TO RECOGNIZE "INDETERMINITE" VIL C AND STP30 VALUES. (INTERNAL) C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C NDATE = MRMS YYYYMMDDHH BEING QC'D. (INPUT) C SPIKE_TH = CREF THRESHOLD USED IN PERFORMING A SPIKE C ECHO CHECK. (INTERNAL) C PW_TROPTH = GFS PW THRESHOLD VALUE FOR DETERMINING A C TROPICAL ENVIRONMENT. (INTERNAL) C BLI_TROPTH = GFS BLI THRESHOLD VALUE FOR DETERMINING A C TROPICAL ENVIRONMENT. (INTERNAL) C NUM_PWBLITH = THE NUMBER OF PW/BLI VALUES NEEDED TO DEFINE C A TROPICAL ENVIRONMENT. (INTERNAL) C NUMHRRR_CREFTH = THE NUMBER OF HRRR CREF ECHOES ABOVE THRESHOLD C TO DEEM THE MRMS AND HRRR CONSISTENT. C (INTERNAL) C DATARL(I,J,K) = RAW INGEST MRMS GRIDS, AND LIGHTNING GRID. C (I=1,NX),(J=1,NY),(K=1,NUMRL). (INTERNAL) C DATAC(I,J,L) = INGEST CONSTANT DATA GRIDS. (I=1,NX),(J=1,NY), C (L=1,NUMCONS) (INTERNAL) C DATAM(I,J,M) = INGEST MODEL DATA GRIDS. (I=1,NX),J=1,NY), C (M=1,NUMMODEL) (INTERNAL) C IRJCD_XTRP(I,J) = FLAG ARRAY HOLDING RESULTS OF QC BASED ON C CONUS NON-TROPICAL CONSISTENCY CHECKS. C (I=1,NX),(J=1,NY) (INTERNAL) C IRJCD_TRP(I,J) = FLAG ARRAY HOLDING RESULTS OF QC BASED ON C CONUS TROPICAL CONSISTENCY CHECKS. (I=1,NX), C (J=1,NY) (INTERNAL) C IRJCD_CA(I,J) = FLAG ARRAY HOLDING RESULTS OF QC BASED ON C CANADA CONSISTENCY CHECKS. (I=1,NY),(J=1,NY) C (INTERNAL) C IRJCD_HRRR(I,J) = FLAG ARRAY HOLDING RESULTS OF QC BASED ON C HRRR CONSISTENCY CHECKS. (I=1,NY),(J=1,NY) C (INTERNAL) C IQCCD(I,J) = ARRAY WHICH HOLDS A "CODE" THAT GETS USED FOR C PRINTING THE RESULTS OF THE QC. (I=1,NX), C (J=1,NY) (INTERNAL) C MRMS_CREF_HRRR_WS(K) C MRMS_CREF_HRRR_CS(K) C MRMS_CREF_HRRR(K) = ARRAYS HOLDING WARM AND COOL SEASON MRMS CREF C THRESHOLDS FOR PERFORMING THE HRRR CONSISTENCY C CHECKS. (K=1,NUMREG) (INTERNAL) C HRRR_CREFTH_WS(K) C HRRR_CREFTH_CS(K) C HRRR_CREFTH(K) = ARRAYS HOLDING WARM AND COOL SEASON HRRR CREF C THRESHOLDS TO BE USED IN PERFORMING THE HRRR C CONSISTENCY CHECKS. (K=1,NUMREG) (INTERNAL) C VILTHS_WS(K,L) C VILTHS_CS(K,L) C VILTHS(K,L) = ARRAYS HOLDING WARM AND COOL SEASON MRMS VIL C THRESHOLDS USED IN THE MRMS INTER-ELEMENT C CONSISTENCY CHECKING. (K=1,NUMREG), C (L=1,NUM_MRMSCAT) (INTERNAL) C STPTHS_WS(K,L) C STPTHS_CS(K,L) C STPTHS(K,L) = ARRAYS HOLDING WARM AND COOL SEASON MRMS STP30 C THRESHOLDS USED IN THE MRMS INTER-ELEMENT C CONSISTENCY CHECKING. (K=1,NUMREG), C (L=1,NUM_MRMSCAT) (INTERNAL) C CREFBP(K) = ARRAY HOLDING MRMS CREF "BREAKPOINT" VALUES C USED IN THE VARIOUS QC CHECKS. C (K=1,NUM_MRMSCAT+1) (INTERNAL) C NUMREJ(K,L) = ARRAY HOLDING THE NUMBER OF QC REJECTS FOR C GEOGRAPHIC REGION, AND EACH CREF BIN. C (K=1,NUMREG+1),(L=1,NUM_MRMSCAT) (INTERNAL) C NUMECHO(K,L) = TOTAL NUMBER OF MRMS CREF ECHOS IN EACH BIN C AND GEOGRAPHIC REGION. (K=1,NUMREG+1), C (L=1,NUM_MRMSCAT) (INTERNAL) C NUMECHO_CIR(K) = ARRAY HOLDING NUMBER OF ECHOES WITHIN CIRCLE C FOR CONSISTENCY CHECKING. (K=1,NUM_MRMSCAT) C (INTERNAL) C NUMREJ_CIR(K,L) = ARRAY HOLDING NUMBER OF ECHOES WITHIN CIRCLE C FOR CONSISTENCY CHECKING WHICH AID IN REJECT C DECISION. (K=1,2),(L=1,NUM_MRMSCAT) C (INTERNAL) C ID_GRDCON(K,L) = IDS OF CONSTANT DATA TO FETCH. (K=1,4), C (L=1,NUMCONS) (INTNERAL) C ID_MODEL(K,L) = IDS OF MODEL DATA TO FETCH. (K=1,4), C (L=1,NUMMODEL) (INTERNAL) C ID_RL(K,L) = IDS OF MRMS AND LIGHTNING DATA TO FETCH. C (K=1,4),(L=1,NUMRL) (INTERNAL) C RMIN(N) = LOWER BOUND FOR MRMS VARIABLES, WHICH IS C APPLIED FOLLOWING QC (EXCEPT REPLACES 9998.1 C VALUES IN ETP/STP AND VIL PRIOR TO QC) C (N=1,NUMRL-1). (INTERNAL) C RMAX(N) = UPPER BOUND FOR MRMS VARIABLES, WHICH IS C APPLIED FOLLOWING QC (N=1,NUMRL-1). C (INTERNAL) C C IXOFF_HRRRCREF(K) C JYOFF_HRRRCREF(K) = ALLOCATED ARRAYS STORING THE I- AND J-OFFSETS C OF A CIRCLE TO USE FOR HRRR CONSISTENCY C CHECKING. (K=1,(IRAD_HRRRCREF**2)*4) C (INTERNAL) C IXOFF_GFSPWBLI(K) C JYOFF_GFSPWBLI(K) = ALLOCATED ARRAYS STORING THE I- AND J-OFFSETS C OF A CIRCLE TO USE FOR DETERMINING TROPICAL C ENVIRONMENT FROM GFS PW AND BLI. C (K=1,(IRAD_GFSPWBLI**2)*4) (INTERNAL) C DATAO(I,J,K) = ALLOCATED ARRAY STORING THE FINAL QC MRMS C DATA, TO BE PASSED TO OUTPUT. (I=1,NX) C (J=1,NY),(K=1,NUMRL) (INTERNAL) C C PARAMETER (NX=1201,NY=897) ! GRID DIMENSIONS PARAMETER (NUMREG=3) ! # REGIONS PARAMETER (NUMCONS=4) ! # CONSTANT DATA RECORDS PARAMETER (NUMRL=6) ! # RADAR/LTG RECORDS PARAMETER (NUMMODEL=3) ! # HRRR/GFS RECORDS PARAMETER (NUM_MRMSCAT=5) ! # MRMS CREF INTERVALS PARAMETER (IRAD_HRRRCREF=40) ! HRRR CREF CIRCLE RADIUS PARAMETER (IRAD_GFSPWBLI=60) ! GFS PW/BLI CIRCLE RADIUS C PARAMETER (TH_VIL=5.0,TH_STP=30.0,TMP_STPVIL=-9998.1) C PARAMETER (SPIKE_TH=45.0) ! CREF THRESHOLD FOR SPIKE CHECK PARAMETER (PW_TROPTH=45.0) ! PW THRESH FOR TROP ENV CHECK PARAMETER (BLI_TROPTH=0.0) ! BLI THRESH FOR TROP ENV CHECK PARAMETER (NUM_PWBLITH=1) ! # PW/BLI COMBO FOR TROP ENV PARAMETER (NUMHRRR_CREFTH=8) ! # HRRR CREF AT/ABOVE THRESHOLD C DIMENSION DATARL(NX,NY,NUMRL) DIMENSION DATAC(NX,NY,NUMCONS),DATAM(NX,NY,NUMMODEL) DIMENSION IRJCD_XTRP(NX,NY),IRJCD_TRP(NX,NY),IRJCD_CA(NX,NY) DIMENSION IRJCD_HRRR(NX,NY) DIMENSION IQCCD(NX,NY),DATA(ND2X3),FD1(ND2X3),WORK(NX,NY) C DIMENSION MRMS_CREF_HRRR(NUMREG),HRRR_CREFTH(NUMREG) DIMENSION HRRR_CREFTH_WS(NUMREG),HRRR_CREFTH_CS(NUMREG) DIMENSION MRMS_CREF_HRRR_WS(NUMREG),MRMS_CREF_HRRR_CS(NUMREG) C DIMENSION VILTHS(NUMREG,NUM_MRMSCAT),STPTHS(NUMREG,NUM_MRMSCAT) DIMENSION VILTHS_CS(NUMREG,NUM_MRMSCAT) DIMENSION STPTHS_CS(NUMREG,NUM_MRMSCAT) DIMENSION VILTHS_WS(NUMREG,NUM_MRMSCAT) DIMENSION STPTHS_WS(NUMREG,NUM_MRMSCAT) DIMENSION CREFBP(NUM_MRMSCAT+1),NUMREJ(NUMREG+1,NUM_MRMSCAT) DIMENSION NUMECHO_CIR(NUM_MRMSCAT),NUMECHO(NUMREG+1,NUM_MRMSCAT) DIMENSION NUMREJ_CIR(2,NUM_MRMSCAT),ID_GRDCON(4,NUMCONS) DIMENSION ID_MODEL(4,NUMMODEL),ID_RL(4,NUMRL) DIMENSION RMIN(NUMRL-3),RMAX(NUMRL-3) C INTEGER ICALLD(L3264W,ND5),ISDATA(ND1),ICALL(L3264W,ND1,6), 1 KDPARS(15),IDPARS(15),ID(4),JD(4),KD(4),LD(4), 2 NGRIDC(6,ND11),LSTORE(12,ND9),IS0(ND7),IS1(ND7),IS2(ND7), 3 IS4(ND7),IPACK(ND5),IWORK(ND5) INTEGER, ALLOCATABLE, DIMENSION(:) :: IXOFF_HRRRCREF INTEGER, ALLOCATABLE, DIMENSION(:) :: JYOFF_HRRRCREF INTEGER, ALLOCATABLE, DIMENSION(:) :: IXOFF_GFSPWBLI INTEGER, ALLOCATABLE, DIMENSION(:) :: JYOFF_GFSPWBLI C REAL, ALLOCATABLE, DIMENSION(:,:,:) :: DATAO C DATA IFIRST/0/,NCIRC_HRRRCREF/0/,NCIRC_GFSPWBLI/0/,IREJ/1/ DATA CREFBP/35.0,43.0,50.0,55.0,60.0,999.0/ C DATA MRMS_CREF_HRRR_WS/37.0,37.0,34.0/ DATA MRMS_CREF_HRRR_CS/35.0,35.0,34.0/ C DATA HRRR_CREFTH_WS/29.0,29.0,37.0/ DATA HRRR_CREFTH_CS/28.0,28.0,35.0/ C DATA RMIN/0.0,0.0,0.0/ DATA RMAX/75.0,19.0,90.0/ C DATA STPTHS_CS/ 0.680,0.530, 0.780, 1 1.500,1.000, 2.400, 2 2.400,2.000, 3.600, 3 3.900,2.850, 5.500, 4 9.200,3.750,10.500/ C DATA VILTHS_CS/ 0.63, 0.53, 0.73, 1 1.70, 1.10, 3.00, 2 3.60, 3.00, 4.80, 3 6.50, 4.00, 9.00, 4 15.00,10.00,18.00/ C DATA STPTHS_WS/ 0.680,0.530, 0.900, 1 1.550,1.000, 3.800, 2 3.350,2.250, 5.900, 3 5.150,3.100, 8.200, 4 10.500,3.750,12.500/ C DATA VILTHS_WS/ 0.63, 0.53, 0.85, 1 1.75, 1.20, 4.40, 2 4.75, 3.40, 7.90, 3 8.30, 4.90,12.00, 4 18.50,10.00,21.00/ C DATA ID_GRDCON/400006000,0,0,0, ! LAT 1 400007000,0,0,0, ! LON 2 447531000,3,0,0, ! REGION CODE (1-3) 3 447531000,4,0,0/ ! STATIC MASK C DATA ID_RL/707800004,0,0,0, ! MRMS CREF 1 707820004,0,0,0, ! MRMS STP30 2 707810004,0,0,0, ! MRMS VIL 3 707560004,0,0,0, ! TL FLASHES 4 703200004,0,0,0, ! 1H PCP NN 5 703203004,0,0,0/ ! 1H PCP AC C DATA ID_MODEL/007800003,0,1,0, ! HRRR CREF 1 003350008,0,0,0, ! GFS PW 2 007010008,0,0,0/ ! GFS LI C SAVE IFIRST, 1 IXOFF_HRRRCREF,JYOFF_HRRRCREF,NCIRC_HRRRCREF, 2 IXOFF_GFSPWBLI,JYOFF_GFSPWBLI,NCIRC_GFSPWBLI, 3 DATAO C C CHECK IF ID IS ACCOMMODATED. C IF (ID(1)/1000.EQ.707801) THEN NVAR=1 ELSE IF (ID(1)/1000.EQ.707811) THEN NVAR=3 ELSE IF (ID(1)/1000.EQ.707821) THEN NVAR=2 ELSE IF (ID(1)/1000.EQ.703201) THEN NVAR=5 ELSE IF (ID(1)/1000.EQ.703204) THEN NVAR=6 ELSE WRITE(KFILDO,10) ID 10 FORMAT(/,' **** ID ',4I11.9' NOT ACCOMODATED IN MRMSQC. ', 1 ' RETURN MISSING VALUES.') GOTO 950 ! ERROR RETURN END IF C C BASED ON NDATE, DETERMINE WHICH SEASON THE DATE BEING C PROCESSED FALLS IN, AND SELECT THE APPROPRIATE THRESHOLDS. C MMDD=MOD((NDATE/100),10000) IF ((MMDD.GE.0401).AND.(MMDD.LE.0930)) THEN DO K=1,NUMREG MRMS_CREF_HRRR(K)=MRMS_CREF_HRRR_WS(K) HRRR_CREFTH(K)=HRRR_CREFTH_WS(K) DO N=1,NUM_MRMSCAT STPTHS(K,N)=STPTHS_WS(K,N) VILTHS(K,N)=VILTHS_WS(K,N) END DO END DO ELSE DO K=1,NUMREG MRMS_CREF_HRRR(K)=MRMS_CREF_HRRR_CS(K) HRRR_CREFTH(K)=HRRR_CREFTH_CS(K) DO N=1,NUM_MRMSCAT STPTHS(K,N)=STPTHS_CS(K,N) VILTHS(K,N)=VILTHS_CS(K,N) END DO END DO END IF C C INITIALIZE ARRAYS AND OTHER VARIABLES C DO K=1,NUMREG+1 DO N=1,NUM_MRMSCAT NUMREJ(K,N)=0 ! REJECTS BY REGION AND INTERVAL NUMECHO(K,N)=0 ! TOTAL CREF VALUES BY INTERVAL END DO END DO C DO J=1,NY DO I=1,NX IRJCD_XTRP(I,J)=0 ! QC RESULT FOR NON-TROPICAL THRESHOLDS IRJCD_TRP(I,J)=0 ! QC RESULT FOR TROPICAL THRESHOLDS IRJCD_CA(I,J)=0 ! QC RESULT FOR CANADA THRESHOLDS IRJCD_HRRR(I,J)=0 ! QC RESULT FROM HRRR CHECK IQCCD(I,J)=0 ! QC RESULT PRINT CODE END DO END DO C NCREF_NONMIS=0 ! # NON-MISSING CREF OVER WHOLE GRID NCREF_GT0=0 ! # CREF > 0 OVER WHOLE GRID NCREF_SPIKE=0 ! # CREF > 45 DBZ NLTG=0 ! # LTG > 0 OVER WHOLE GRID C IF (IFIRST.EQ.0) THEN C C ALLOCATE DATAO( , , ) ARRAY, WHICH WILL STORE DATA OUTPUT. C ALL VARIABLES WILL BE PROCESSED ON FIRST ENTRY. A SUBSEQUENT C ENTRY FOR VIL WILL JUST GRAB DATA FROM THE DATAO( , , ) ARRAY. C ALLOCATE(DATAO(NX,NY,NUMRL),STAT=IOS) C C DEFINE A CIRCLE BASED ON IRAD_HRRRCREF ABOVE. THIS COMPUTATION C IS DONE ONLY UPON THE FIRST ENTRY INTO THIS SUBROUTINE. C ALLOCATE(IXOFF_HRRRCREF((IRAD_HRRRCREF**2)*4),STAT=IOS) ALLOCATE(JYOFF_HRRRCREF((IRAD_HRRRCREF**2)*4),STAT=IOS) KK=0 DO JPT=-IRAD_HRRRCREF,IRAD_HRRRCREF DO IPT=-IRAD_HRRRCREF,IRAD_HRRRCREF XOFF=IPT YOFF=JPT RDIST=SQRT(XOFF**2+YOFF**2) IF (RDIST.LE.IRAD_HRRRCREF) THEN KK=KK+1 IXOFF_HRRRCREF(KK)=IPT JYOFF_HRRRCREF(KK)=JPT END IF END DO END DO NCIRC_HRRRCREF=KK C C DEFINE A CIRCLE BASED ON IRAD_GFSPWBLI ABOVE. THIS COMPUTATION C IS DONE ONLY UPON THE FIRST ENTRY INTO THIS SUBROUTINE. C ALLOCATE(IXOFF_GFSPWBLI((IRAD_GFSPWBLI**2)*4),STAT=IOS) ALLOCATE(JYOFF_GFSPWBLI((IRAD_GFSPWBLI**2)*4),STAT=IOS) KK=0 DO JPT=-IRAD_GFSPWBLI,IRAD_GFSPWBLI DO IPT=-IRAD_GFSPWBLI,IRAD_GFSPWBLI XOFF=IPT YOFF=JPT RDIST=SQRT(XOFF**2+YOFF**2) IF (RDIST.LE.IRAD_GFSPWBLI) THEN KK=KK+1 IXOFF_GFSPWBLI(KK)=IPT JYOFF_GFSPWBLI(KK)=JPT END IF END DO END DO NCIRC_GFSPWBLI=KK C C FETCH CONSTANT DATA FIRST. CONSTG IS CALLED HERE. C DO K=1,NUMCONS DO L=1,4 LD(L)=ID_GRDCON(L,K) END DO C C BASED ON SEASON, FETCH APPROPRIATE STATIC MASK. THIS C IS DONE BY SETTING THE 2ND WORD OF THE ID. C IF (K.EQ.4) THEN IF (MMDD.GE.0401.AND.MMDD.LE.0930) THEN LD(2)=LD(2)+010170000 ELSE LD(2)=LD(2)+010180000 END IF END IF C CALL CONSTG(KFILDO,KFILRA,RACESS,LD, 1 IPACK,IWORK,FD1,ND5, 2 IS0,IS1,IS2,IS4,ND7, 3 ISTAV,L3264B,IER) IF (IER.NE.0) THEN WRITE(KFILDO,110) LD,IER 110 FORMAT(/,' **** IN MRMSQC, UNABLE TO FETCH CONSTANT', 1 ' DATA ',4I11.9,' ... IER=',I4,' SET DATA TO', 2 ' MISSING AND RETURN.') GOTO 950 ! ERROR RETURN END IF C NN=1 DO J=1,NY DO I=1,NX DATAC(I,J,K)=FD1(NN) NN=NN+1 END DO END DO C END DO C C FETCH RADAR AND LIGHTNING DATA NEXT. GFETCH IS CALLED HERE. C FOR LIGHTNING, THE DATE ON THE DATA IS FOR THE BEGINNING OF C THE VALID PERIOD, INSTEAD OF THE END. ADJUST LDATE AND LD(2) C ACCORDINGLY. C DO K=1,NUMRL LD(1)=ID_RL(1,K) C IF (K.EQ.4) THEN LD(2)=ID(2)-9 ELSE IF (K.GE.5) THEN LD(2)=0 ELSE LD(2)=ID(2) END IF C LD(3)=ID_RL(3,K) LD(4)=ID_RL(4,K) LDATE=NDATE CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD1,ND2X3, 2 NWORDS,NPACK,LDATE,NTIMES,CORE,ND10,NBLOCK, 3 NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) IF (IER.NE.0) THEN IF (K.LE.4) THEN WRITE(KFILDO,120) LD 120 FORMAT(/,' **** IN MRMSQC, UNABLE TO FETCH RADAR OR LTG', 1 ' DATA ',4I11.9,' ... SET DATA TO MISSING AND', 2 ' RETURN.') GOTO 950 ! ERROR RETURN ELSE WRITE(KFILDO,121) LD 121 FORMAT(/,' **** IN MRMSQC, UNABLE TO FETCH 1H PRECIP', 1 ' DATA ',4I11.9,' ... SET DATA TO MISSING, BUT', 2 ' CONTINUE PROCESSING.', 3 /,' THIS IS ONLY AN ERROR IF PROCESSING', 4 ' HH:14 DATA') DO NN=1,NX*NY FD1(NN)=9999.0 END DO END IF END IF C C TRANSFER DATA INTO DATARL ARRAY FOR LATER USE. C NN=1 DO J=1,NY DO I=1,NX DATARL(I,J,K)=FD1(NN) NN=NN+1 END DO END DO C END DO C C FETCH HRRR AND GFS DATA LAST. GFETCH IS CALLED HERE. FOR C THE HRRR, LDATE NEEDS TO BE ADJUSTED SINCE THE DATE ON THE C FILES IS BASED ON THE MODEL CYCLE AND PROJECTION. C DO K=1,NUMMODEL LD(1)=ID_MODEL(1,K) LD(2)=ID(2) LD(3)=ID_MODEL(3,K) LD(4)=ID_MODEL(4,K) C IF (K.EQ.1) THEN CALL UPDAT(NDATE,-1,LDATE) ELSE LDATE=NDATE END IF C CALL GFETCH(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,FD1,ND2X3, 2 NWORDS,NPACK,LDATE,NTIMES,CORE,ND10,NBLOCK, 3 NFETCH,NSLAB,MISSP,MISSS,L3264B,1,IER) IF (IER.NE.0) THEN C C IN THE CASE OF THE HRRR, PRINT A SPECIAL MESSAGE AND C ALLOW PROCESSING TO CONTINUE, BUT WITH MISSING HRRR C DATA. THIS ALLOWS FOR MORE PROPER FAILURE IN LATER C PROCESSING. C IF (K.EQ.1) THEN WRITE(KFILDO,130) LD 130 FORMAT(/,' **** ERROR IN MRMSQC FETCHING HRRR DATA', 1 4I11.9, 2 /,' **** RETURN MISSING DATA. DOWNSTREAM JOBS', 3 ' ARE LIKELY TO FAIL AS WELL.') DO J=1,NY DO I=1,NX DATAM(I,J,K)=9999.0 END DO END DO IER=0 C ELSE WRITE(KFILDO,131) LD 131 FORMAT(/,' **** IN MRMSQC, UNABLE TO FETCH MODEL', 1 ' DATA ',4I11.9,' ... SET DATA TO MISSING AND', 2 ' RETURN.') GOTO 950 ! ERROR RETURN END IF END IF C NN=1 DO J=1,NY DO I=1,NX DATAM(I,J,K)=FD1(NN) NN=NN+1 END DO END DO C END DO C C PERFORM DATA CONSISTENCY CHECKING ACROSS MRMS ELEMENTS. WHEN C SOMETHING IS NOT CONSISTENT, SET DATA VALUE TO INDETERMINITE C VALUE, AS DEFINED IN PARAMETERS. C DO J=1,NY DO I=1,NX CREF=DATARL(I,J,1) STP=DATARL(I,J,2) VIL=DATARL(I,J,3) C IF (CREF.GE.9998.5) CYCLE C IF ((CREF.LT.TH_STP).AND.(STP.GT.9998.5)) THEN DATARL(I,J,2)=TMP_STPVIL END IF C IF ((CREF.LT.TH_VIL).AND.(VIL.GT.9998.5)) THEN DATARL(I,J,3)=TMP_STPVIL END IF C END DO END DO C C CALL LTGSUM TO COMPUTE 3X3 LTG SUM. THE SUMMED VALUES C WILL THEN GET PLACED BACK INTO DATARL( , ,4). THE C WORK( , ) ARRAY IS JUST TEMPORARY STORAGE OF THE SUMMED C LTG FLASHES. C CALL LTGSUM(KFILDO,DATARL(1,1,4),WORK,NX,NY) C DO J=1,NY DO I=1,NX DATARL(I,J,4)=WORK(I,J) END DO END DO C C ALL DATA NEEDED TO PERFORM MRMS QC HAS BEEN FOUND. THE C QC HAS 2 COMPONENTS, FIRST DO THE DYNAMIC QC. C C FIRST LOOP OVER ENTIRE GRID. C - SET COUNTER FOR CREFS IN ALL INTERVALS C - PERFORM SPIKE ECHO CHECK C - PERFORM STP/VIL CHECKS (REGIONALLY) C - PERFORM HRRR CREF CHECK OVER ENTIRE GRID C DO J=1,NY DO I=1,NX C C SET THE BEGINNING AND ENDING INDEX OF SURROUNDING C GRIDPOINTS, USED FOR SPIKE ECHO CHECK. ALSO SET C SOME OTHER VARIABLES TO BE USED WITHIN THE MAIN QC C PROCESS, MAINLY FOR IMPROVED READABILITY. C IBX=MAX(1,I-1) IBY=MAX(1,J-1) IEX=MIN(NX,I+1) IEY=MIN(NY,J+1) C CREF=DATARL(I,J,1) STP=DATARL(I,J,2) VIL=DATARL(I,J,3) RLTG=DATARL(I,J,4) RLON=DATAC(I,J,2) IREG=DATAC(I,J,3) C C SET DATA0=DATA C DO NN=1,NUMRL DATAO(I,J,NN)=DATARL(I,J,NN) END DO C C IF CREF IS MISSING, CYCLE LOOP. WHEN NON-MISSING, C INCREMENT COUNTERS FOR NON-MISSING CREF, AND CREF > 0. C IF (CREF.GT.9998.5) CYCLE C NCREF_NONMIS=NCREF_NONMIS+1 IF (CREF.GT.0.0) NCREF_GT0=NCREF_GT0+1 C C INCREMENT COUNTERS FOR CREF ECHOES WITHIN EACH INTERVAL C AS DEFINED IN CREFBP( ) ARRAY. THIS COUNT IS ALSO C SEPARATED BY REGION. C DO N=1,NUM_MRMSCAT IF ((CREF.GE.CREFBP(N)).AND.(CREF.LT.CREFBP(N+1))) THEN NUMECHO(IREG,N)=NUMECHO(IREG,N)+1 NUMECHO(NUMREG+1,N)=NUMECHO(NUMREG+1,N)+1 END IF END DO C C INCREMENT COUNTER OF CREF ECHOES GE SPIKE_TH (SET IN C PARAMETERS). C IF (CREF.GE.SPIKE_TH) NCREF_SPIKE=NCREF_SPIKE+1 C C IF THERE IS LIGHTNING AT THE CURRENT GRIDPOINT, INCREMENT C A COUNTER, AND CYCLE LOOP AS NO QC IS DONE WHEN LIGHTNING C IS PRESENT. C IF (RLTG.GT.0.0) THEN NLTG=NLTG+1 CYCLE END IF C C FIRST, PERFORM SPIKE ECHO CHECK. THIS IS DONE WHEN CREF C IS GE SPIKE_TH. THIS CHECK SEARCHES FOR ISOLATED HIGH C CREF ECHOES (USUALLY A SIGNLE OR 2 ADJACENT GRIDPOINTS) C ARE SIGNIFICANTLY HIGHER THAN IMMEDIATELY SURROUNDING C ECHOES. C IF(CREF.GE.SPIKE_TH) THEN C ICNT=0 ILTTH=0 CREFN=CREF*0.30 C DO JJ=IBY,IEY DO II=IBX,IEX IF((JJ.EQ.J.AND.II.EQ.I).OR. 1 (DATARL(II,JJ,1).GT.9998.5)) CYCLE ICNT=ICNT+1 IF(DATARL(II,JJ,1).LT.CREFN) ILTTH=ILTTH+1 END DO END DO C C IF ONE OR MORE NEAREST 8 GRIDBOXES HAVE NON-MISSING C CREF, PERFORM THE SPIKE CHECK. C IF(ICNT.GT.0) THEN C ILTTHREQ=NINT(ICNT*0.85) C C CREF IN 85% OF 8 NEAREST GRIDBOXES LT CREFBP AND NO C LTG, SO SPIKE ECHO INDICATED. SET IRJCD FLAG ARRAYS C TO -1, WHICH WILL PREVENT ANY FURTHER CHECKING LATER. C IF(ILTTH.GE.ILTTHREQ.AND.DATARL(I,J,4).EQ.0.0) THEN NSPIKE=NSPIKE+1 IQCCD(I,J)=1 C IRJCD_XTRP(I,J)=-1 IRJCD_TRP(I,J)=-1 IRJCD_HRRR(I,J)=1 CYCLE C END IF END IF C END IF ! TERMINATOR FOR SPIKE CHECK C C PERFORM AND SAVE RESULTS OF STP/VIL CHECKS. C - REGION 1 RESULTS ARE NEEDED OVER REGIONS 1 AND 2 C - REGION 2 AND 3 RESULTS ARE ONLY NEEDED WITHIN THE C RESPECTIVE REGIONS. C C ONLY PERFORM THIS CHECK IF THE CREF IS GE THE LOWEST C INTERVAL. C IF (CREF.GE.CREFBP(1)) THEN C DO N=1,NUM_MRMSCAT IF ((CREF.GE.CREFBP(N)).AND.(CREF.LT.CREFBP(N+1))) THEN C C PERFORM CHECKS AGAINST NON-TROPICAL THRESHOLDS FOR C REGIONS 1 AND 2 (CONUS REGIONS) C IF ((IREG.EQ.1).OR.(IREG.EQ.2)) THEN IF ((STP.LT.STPTHS(1,N)).AND.(VIL.LT.VILTHS(1,N))) 1 IRJCD_XTRP(I,J)=N END IF C C PERFORM CHECKS AGAINST TROPICAL THRESHOLDS FOR C REGION 2 (EAST CONUS) C IF (IREG.EQ.2) THEN IF ((STP.LT.STPTHS(2,N)).AND.(VIL.LT.VILTHS(2,N))) 1 IRJCD_TRP(I,J)=N END IF C C PERFORM CHECKS AGAINST CANADA THRESHOLDS FOR C REGION 3 (CANADA) C IF (IREG.EQ.3) THEN IF ((STP.LT.STPTHS(3,N)).AND.(VIL.LT.VILTHS(3,N))) 1 IRJCD_CA(I,J)=N END IF C END IF END DO C END IF C C LASTLY, PERFORM HRRR MODEL CREF CONSISTENTY CHECK, AND C SAVE RESULTS FOR THE ENTIRE GRID. THIS CHECK IS ONLY C DONE WHEN CREF IS ABOVE MRMS_CREF_HRRR THRESHOLD, SET C IN DATA STATEMENT. C IF (CREF.LT.MRMS_CREF_HRRR(IREG)) CYCLE C C CHECK HRRR CREF IN CIRCLE. KEEP COUNT OF HOW MANY C GRIDPOINTS IN CIRCLE ARE NON-MISSING, ALONG WITH HOW C MANY HRRR ECHOES IN CIRCLE ARE ABOVE HRRR_CREFTH, AS C DEFINED IN DATA STATEMENT. C C NOTE IF THE HRRR CREF IS MISSING, AN ALTERNATE CHECK C IS DONE AGAINST THE GFS PW AND LI. THIS ALTERNATE C CHECK IS SIMPLY STRATIFIED BY LONGITUDE, AND A SEASONAL C PW AND LI THRESHOLD. C NUMHRRR_CREF=0 NUMHRRR_NOMIS=0 IF (DATAM(I,J,1).GT.9998.5) THEN C C HRRR CREF IS MISSING, DO THE GFS CHECK INSTEAD. C IF ((MMDD.GE.0401).AND.(MMDD.LE.0930)) THEN C C WARM SEASON GFS CHECK C IF (RLON.GE.103.0) THEN IF ((DATAM(I,J,2).LT.18.0).AND. 1 (DATAM(I,J,3).GT.-2.0)) THEN IRJCD_HRRR(I,J)=1 END IF END IF C IF (RLON.LT.103.0) THEN IF ((DATAM(I,J,2).LT.25.0).AND. 1 (DATAM(I,J,3).GT.2.0)) THEN IRJCD_HRRR(I,J)=1 END IF END IF C ELSE C C COOL SEASON GFS CHECK C IF (RLON.GE.103.0) THEN IF ((DATAM(I,J,2).LT.12.0).AND. 1 (DATAM(I,J,3).GT.1.0)) THEN IRJCD_HRRR(I,J)=1 END IF END IF C IF (RLON.LT.103.0) THEN IF ((DATAM(I,J,2).LT.14.0).AND. 1 (DATAM(I,J,3).GT.6.0)) THEN IRJCD_HRRR(I,J)=1 END IF END IF C END IF C ELSE C C STANDARD HRRR CHECK, AS HRRR CREF IS AVAILABLE. C DO N=1,NCIRC_HRRRCREF IPT=I-IXOFF_HRRRCREF(N) JPT=J-JYOFF_HRRRCREF(N) C IF (((IPT.LT.1).OR.(IPT.GT.NX)).OR. 1 ((JPT.LT.1).OR.(JPT.GT.NY))) CYCLE C HRRR_CREF=DATAM(IPT,JPT,1) C IF (HRRR_CREF.GE.9998.5) CYCLE C NUMHRRR_NOMIS=NUMHRRR_NOMIS+1 C IF (HRRR_CREF.GE.HRRR_CREFTH(IREG)) THEN NUMHRRR_CREF=NUMHRRR_CREF+1 END IF END DO C C CHECK THAT ENOUGH OF THE HRRR CIRCLE IS NON-MISSING. C CYCLE LOOP IF NOT. C HRRR_PCT=FLOAT(NUMHRRR_NOMIS)/FLOAT(NCIRC_HRRRCREF) IF (HRRR_PCT.LT.0.33) CYCLE C C SCALE NUMHRRR_CREFTH ACCORDINGLY BASED ON PERCENTAGE OF C CIRCLE THAT IS NON-MISSING C NUMHRRR_TH=(IFIX(HRRR_PCT*NUMHRRR_CREFTH))+1 IF (NUMHRRR_TH.GT.NUMHRRR_CREFTH) 1 NUMHRRR_TH=NUMHRRR_CREFTH C C SAVE A REJECT IF NUMHRRR_CREF IS BELOW THE COMPUTED C THRESHOLD. C IF (NUMHRRR_CREF.LT.NUMHRRR_TH) THEN IRJCD_HRRR(I,J)=1 CYCLE END IF C C PERFORM AN ALTERNATE HRRR CHECK BASED ON HIGHER CREF C VALUES. THE THRESHOLD VARIES SLIGHTLY BY SEASON. C IF ((MMDD.GE.0401).AND.(MMDD.LE.0930)) THEN CREFTH_HI=60.0 HRRRTH_HI=39.0 ELSE CREFTH_HI=55.0 HRRRTH_HI=38.0 END IF c IF (CREF.GE.CREFTH_HI) THEN NUMHRRR_CREF=0 DO N=1,NCIRC_HRRRCREF IPT=I-IXOFF_HRRRCREF(N) JPT=J-JYOFF_HRRRCREF(N) C IF (((IPT.LT.1).OR.(IPT.GT.NX)).OR. 1 ((JPT.LT.1).OR.(JPT.GT.NY))) CYCLE C HRRR_CREF=DATAM(IPT,JPT,1) C IF (HRRR_CREF.GE.9998.5) CYCLE C IF (HRRR_CREF.GE.HRRRTH_HI) THEN NUMHRRR_CREF=NUMHRRR_CREF+1 END IF END DO HRRR_PCT=FLOAT(NUMHRRR_NOMIS)/FLOAT(NCIRC_HRRRCREF) IF (HRRR_PCT.LT.0.33) CYCLE C C SCALE NUMHRRR_CREFTH ACCORDINGLY BASED ON PERCENTAGE OF C CIRCLE THAT IS NON-MISSING C NUMHRRR_TH=(IFIX(HRRR_PCT*NUMHRRR_CREFTH))+1 IF (NUMHRRR_TH.GT.NUMHRRR_CREFTH) 1 NUMHRRR_TH=NUMHRRR_CREFTH C C SAVE A REJECT IF NUMHRRR_CREF IS BELOW THE COMPUTED C THRESHOLD. C IF (NUMHRRR_CREF.LT.NUMHRRR_TH) THEN IRJCD_HRRR(I,J)=1 CYCLE END IF END IF C END IF C END DO ! termination of first grid loop pass END DO ! termination of first grid loop pass C C SECOND LOOP OVER ENTIRE GRID. C - DECISION TREE (WHERE NEEDED) FOR REJECTS IN TROPICAL DOMAIN C - APPLICATION OF QC RESULT C DO J=1,NY DO I=1,NX C IREG=DATAC(I,J,3) C C IF THERE ARE NO REJECTS BASED ON ANY DEFINITIONS, CYCLE C THE LOOP. C IF ((IRJCD_XTRP(I,J).LE.0).AND.(IRJCD_TRP(I,J).LE.0).AND. 1 (IRJCD_CA(I,J).LE.0).AND.(IRJCD_HRRR(I,J).LE.0)) CYCLE C C IF THE DATA IS BETWEEN 05/15 AND 11/30, GO THROUGH C TROPICAL DECISION PROCESS FOR REGION 2 (EAST CONUS). C IF ((IREG.EQ.2).AND.(MMDD.GE.0515).AND.(MMDD.LE.1130)) THEN C IRJCD_XT=IRJCD_XTRP(I,J) IRJCD_TP=IRJCD_TRP(I,J) C C IF GRIDPOINT IS REJECTED BY BOTH TROPICAL AND C NON-TROPICAL THRESHOLDS, THIS IS AN AUTOMATIC REJECT. C IF (IRJCD_XT.EQ.IRJCD_TP) THEN IQCCD(I,J)=2 ELSE C C AT THIS POINT, THERE IS A REJECT FROM NON-TROPICAL C THRESHOLDS, BUT NOT FOR TROPICAL THRESHOLDS. C BEGIN TROPICAL CHECKING BY EXAMINING GFS MODEL C PW AND BLI OVER A CIRCLE IN AN ATTEMPT TO DETERMINE C WHETHER THE ENVIRONMENT IS TROPICAL OR NON-TROPICAL. C NUM_PWBLI=0 DO N=1,NCIRC_GFSPWBLI IPT=I-IXOFF_GFSPWBLI(N) JPT=J-JYOFF_GFSPWBLI(N) C IF (((IPT.LT.1).OR.(IPT.GT.NX)).OR. 1 ((JPT.LT.1).OR.(JPT.GT.NY))) CYCLE C CIR_PW=DATAM(IPT,JPT,2) CIR_BLI=DATAM(IPT,JPT,3) C IF ((CIR_PW.GE.PW_TROPTH).AND. 1 (CIR_BLI.GE.BLI_TROPTH)) THEN NUM_PWBLI=NUM_PWBLI+1 END IF C END DO C C IF NUM_PWBLI IS ABOVE THRESHOLD, THE ENVIRONMENT IS C DEEMED TROPICAL, WITH NO REJECT. OTHERWISE, RETAIN C THE NON-TROPICAL REJECT, BUT PROCEED TO ANOTHER C CHECK BASED ON THE HRRR CREF. C IF (NUM_PWBLI.GE.NUM_PWBLITH) THEN IQCCD(I,J)=3 IRJCD_XTRP(I,J)=0 ELSE C C FINALLY, IF THE ABOVE LOGIC DEEMS THE ENVIRONMENT C NON-TROPICAL, CHECK AGAINST THE HRRR. IF THE HRRR C DOES NOT HAVE A REJECT, OVERRIDE THE ORIGINAL NON- C TROPICAL THRESHOLDS REJECT. C IF ((IRJCD_HRRR(I,J).EQ.0).AND.(MMDD.GT.0930)) THEN IRJCD_XTRP(I,J)=0 IQCCD(I,J)=4 END IF END IF C END IF END IF ! END OF ALL REGION CHECKS C C APPLY REJECTS C C PATCH 10/11/17 C C THE DO NN LOOP BELOW WAS BEING EXECUTED ON AN UNDEFINED C VARIABLE! HOW DID THIS EVER WORK? THE CORRECTION IS C TO LOOP BASED ON NUMRL, WHICH IS NOW STATED BELOW. THIS C IS MAJOR, BECAUSE THIS IS THE ACTUAL APPLICATION OF QC C REJECTS TO THE OUTPUT DATA. C IF ((IRJCD_XTRP(I,J).GT.0).OR.(IRJCD_CA(I,J).GT.0).OR. 1 (IRJCD_HRRR(I,J).GT.0)) THEN DO NN=1,NUMRL IF (NN.EQ.4) CYCLE ! NN=4 IS LTG, DO NOT ALTER DATAO(I,J,NN)=9999.0 END DO END IF C END DO ! END OF LOOP OVER ALL POINTS END DO ! END OF LOOP OVER ALL POINTS C C DYNAMIC QC COMPLETED FOR ALL MRMS VARIABLES OVER FULL GRID C FOR NDATE. C C TRUNCATE VARIABLES TO BE IN BOUNDS OF RMIN - RMAX. THIS C LOOP IS SEPARATE FROM ABOVE TO GUARANTEE EVERY GRID POINT C IS CHECKED FOR BEING IN THE BOUNDS OF RMIN-RMAX. C C 12/2014 UPDATE: TO RETAIN INDETERMINITE VALUES OF -9998.1 C DO NOT CHECK AGAINST RMIN. C C PATCH 10/11/17 C C THE DO N LOOP BELOW WAS BEING EXECUTED ON AN UNDEFINED C VARIABLE! IN ADDITION, THE RMIN AND RMAX ARRAYS BELOW C WERE NEVER EVEN DECLARED. RMIN AND RMAX ARE NOW C INITIALIZED AND DEFINED AT THE START OF THE ROUTINE. C THESE VALUES WERE TAKEN FROM OUR ORIGINAL DRIVER ROUTINE C FOR THE QC (PRIOR TO MAKING THIS A U202 SUBROUTINE). THIS C IS MAJOR BECAUSE GARBAGE RMAX VALUES COULD RUIN THE OUTPUT C DATA. C C ULTIMATE DECISION: SINCE RALTGRD DOES FURTHER TRUNCATION C ON THE CREF AND VIL, DO NOT DO THE TRUNCATION HERE AT ALL. C C DO J=1,NY C DO I=1,NX C DO N=1,NUMRL-1 C C IF (DATAO(I,J,N).GT.9998.5) CYCLE C C IF (DATAO(I,J,N).LT.RMIN(N)) THEN C DATAO(I,J,N)=RMIN(N) C IQCCD(I,J)=5 C ELSE IF(DATAO(I,J,N).GT.RMAX(N)) THEN C DATAO(I,J,N)=RMAX(N) C IQCCD(I,J)=6 C END IF C END DO C C END DO C END DO C C RESULT PRINTOUT SECTION C C PRINT "CODED" RESULTS FIRST, BASED ON THE IQCCD ARRAY. C N_HSAV=0 WRITE(KFILDO,700) 700 FORMAT(/,' THE FOLLOWING LOCATIONS HAD A REJECT OVERRIDDEN', 1 ' BY THE HRRR CHECK. I,J,REG,LAT,LON,CREF,STP,VIL') DO J=1,NY DO I=1,NX IF (IQCCD(I,J).NE.4) CYCLE C N_HSAV=N_HSAV+1 WRITE(KFILDO,701) I,J,NINT(DATAC(I,J,3)),DATAC(I,J,1), 1 DATAC(I,J,2),DATARL(I,J,1),DATARL(I,J,2), 2 DATARL(I,J,3),N_HSAV 701 FORMAT(4X,2I4.4,I3,2F9.2,F9.1,F9.3,F9.2,I7) END DO END DO C N_TROP=0 WRITE(KFILDO,710) 710 FORMAT(/,' THE FOLLOWING LOCATIONS WERE DETERMINED TO HAVE A', 1 ' TROPICAL ENVIRONMENT. I,J,REG,LAT,LON,CREF,STP,VIL') DO J=1,NY DO I=1,NX IF (IQCCD(I,J).NE.3) CYCLE C N_TROP=N_TROP+1 WRITE(KFILDO,711) I,J,NINT(DATAC(I,J,3)),DATAC(I,J,1), 1 DATAC(I,J,2),DATARL(I,J,1),DATARL(I,J,2), 2 DATARL(I,J,3),N_TROP 711 FORMAT(4X,2I4.4,I3,2F9.2,F9.1,F9.3,F9.2,I7) END DO END DO C IF ((MMDD.GE.0515).AND.(MMDD.LE.1130)) THEN N_BOTH=0 WRITE(KFILDO,720) 720 FORMAT(/,' THE FOLLOWING LOCATIONS WERE REJECTED BY TROPICAL', 1 ' AND NON-TROPICAL THRESHOLDS. I,J,REG,LAT,LON,CREF', 2 ',STP,VIL') DO J=1,NY DO I=1,NX IF (IQCCD(I,J).NE.2) CYCLE C IREG=DATAC(I,J,3) CREF=DATARL(I,J,1) DO N=1,NUM_MRMSCAT IF (CREF.GE.CREFBP(N).AND.(CREF.LT.CREFBP(N+1))) IREJ=N END DO NUMREJ(IREG,IREJ)=NUMREJ(IREG,IREJ)+1 NUMREJ(NUMREG+1,IREJ)=NUMREJ(NUMREG+1,IREJ)+1 C N_BOTH=N_BOTH+1 WRITE(KFILDO,721) I,J,NINT(DATAC(I,J,3)),DATAC(I,J,1), 1 DATAC(I,J,2),DATARL(I,J,1), 2 DATARL(I,J,2),DATARL(I,J,3),N_BOTH 721 FORMAT(4X,2I4.4,I3,2F9.2,F9.1,F9.3,F9.2,I7) END DO END DO END IF C NSPIKE=0 WRITE(KFILDO,730) 730 FORMAT(/,' THE FOLLOWING LOCATIONS WERE DETERMINED TO HAVE A', 1 ' FALSE SPIKE ECHO. I,J,REG,LAT,LON,CREF,STP,VIL') DO J=1,NY DO I=1,NX IF (IQCCD(I,J).NE.1) CYCLE C IREG=DATAC(I,J,3) CREF=DATARL(I,J,1) DO N=1,NUM_MRMSCAT IF (CREF.GE.CREFBP(N).AND.(CREF.LT.CREFBP(N+1))) IREJ=N END DO NUMREJ(IREG,IREJ)=NUMREJ(IREG,IREJ)+1 NUMREJ(NUMREG+1,IREJ)=NUMREJ(NUMREG+1,IREJ)+1 C NSPIKE=NSPIKE+1 WRITE(KFILDO,731) I,J,NINT(DATAC(I,J,3)),DATAC(I,J,1), 1 DATAC(I,J,2),DATARL(I,J,1),DATARL(I,J,2), 2 DATARL(I,J,3),NSPIKE 731 FORMAT(4X,2I4.4,I3,2F9.2,F9.1,F9.3,F9.2,I7) END DO END DO C C PRINT STP/VIL REJECTS C DO N=1,NUM_MRMSCAT WRITE(KFILDO,740) CREFBP(N),CREFBP(N+1) 740 FORMAT(/,' FOR CREF INTERVAL ',F6.1,' - ',F6.1,' THE STP/VIL', 1 ' CHECKS REJECTED THE FOLLOWING POINTS. I,J,REG,LAT', 2 ',LON,CREF,STP,VIL') DO J=1,NY DO I=1,NX IF ((IRJCD_XTRP(I,J).NE.N).AND.(IRJCD_CA(I,J).NE.N)) CYCLE C IREG=DATAC(I,J,3) IF (IREG.LT.3) IREJ=IRJCD_XTRP(I,J) IF (IREG.EQ.3) IREJ=IRJCD_CA(I,J) C NUMREJ(IREG,IREJ)=NUMREJ(IREG,IREJ)+1 NUMREJ(NUMREG+1,IREJ)=NUMREJ(NUMREG+1,IREJ)+1 WRITE(KFILDO,741) I,J,IREG,DATAC(I,J,1),DATAC(I,J,2), 1 DATARL(I,J,1),DATARL(I,J,2),DATARL(I,J,3), 2 NUMREJ(NUMREG+1,IREJ) 741 FORMAT(4X,2I4.4,I3,2F9.2,F9.1,F9.3,F9.2,I7) END DO END DO END DO C C PRINT HRRR REJECTS C N_HRRR=0 WRITE(KFILDO,750) 750 FORMAT(/,' THE FOLLOWING LOCATIONS WERE REJECTED BY THE HRRR', 1 ' CHECK. I,J,REG,LAT,LON,CREF,STP,VIL') DO J=1,NY DO I=1,NX IF (IRJCD_HRRR(I,J).LE.0) CYCLE C IREG=DATAC(I,J,3) IF ((IREG.LT.3).AND.(IRJCD_XTRP(I,J).NE.0)) CYCLE IF ((IREG.EQ.3).AND.(IRJCD_CA(I,J).NE.0)) CYCLE C CREF=DATARL(I,J,1) C C PATCH 10/10/17 C C THE HRRR CHECK STARTS AT A SLIGHTLY LOWER CREF VALUE C THAN DEFINED IN THE CREFBP( ) ARRAY AT THE CURRENT C TIME. AS A RESULT, IT WAS POSSIBLE THAT IREJ WAS NEVER C INITIALIZED. TO CIRCUMVENT THIS SCENARIO, THE STATMENT C BELOW WAS MODIFIED TO INITIALIZE IREJ TO 1 IF THE CREF C VALUE IS BELOW CREFBP(1), WHICH PREVENTS A SEG FAULT C FROM OCCURING. C DO N=1,NUM_MRMSCAT IF ((N.EQ.1).AND.(CREF.LT.CREFBP(N))) THEN IREJ=1 ELSE IF (CREF.GE.CREFBP(N).AND.(CREF.LT.CREFBP(N+1))) THEN IREJ=N END IF END DO C NUMREJ(IREG,IREJ)=NUMREJ(IREG,IREJ)+1 NUMREJ(NUMREG+1,IREJ)=NUMREJ(NUMREG+1,IREJ)+1 C N_HRRR=N_HRRR+1 WRITE(KFILDO,751) I,J,NINT(DATAC(I,J,3)),DATAC(I,J,1), 1 DATAC(I,J,2),DATARL(I,J,1),DATARL(I,J,2), 2 DATARL(I,J,3),N_HRRR 751 FORMAT(4X,2I4.4,I3,2F9.2,F9.1,F9.3,F9.2,I7) END DO END DO C C PRINT OUT SUMMARY STATISTICS. C DO N=1,NUM_MRMSCAT NREJ=NREJ+NUMREJ(NUMREG+1,N) END DO C WRITE(KFILDO,800) NDATE,NX*NY,NCREF_NONMIS,NCREF_GT0,NLTG,NREJ, 1 (NUMECHO(1,K),K=1,NUM_MRMSCAT), 2 (NUMECHO(2,K),K=1,NUM_MRMSCAT), 3 (NUMECHO(3,K),K=1,NUM_MRMSCAT), 4 (NUMREJ(1,K),K=1,NUM_MRMSCAT), 5 (NUMREJ(2,K),K=1,NUM_MRMSCAT), 6 (NUMREJ(3,K),K=1,NUM_MRMSCAT) 800 FORMAT(/,' SUMMARY FOR DATE ',I10, 1 /,' # TOTAL BOXES: ',I7, 2 /,' # CREF NON-MISSING: ',I7, 3 /,' # CREF > 0: ',I7, 4 /,' # BOXES WITH LTG: ',I7, 5 /,' # TOTAL REJECTS: ',I7, 5 //,' NUMBER OF ECHOES IN REGION 1 FOR EACH INTERVAL ', 6 ' (LOW-HI): ',5I6, 7 /,' NUMBER OF ECHOES IN REGION 2 FOR EACH INTERVAL ', 8 ' (LOW-HI): ',5I6, 9 /,' NUMBER OF ECHOES IN REGION 3 FOR EACH INTERVAL ', 1 ' (LOW-HI): ',5I6, 2 //,' NUMBER OF REJECTS IN REGION 1 FOR EACH INTERVAL ', 3 ' (LOW-HI): ',5I6, 4 /,' NUMBER OF REJECTS IN REGION 2 FOR EACH INTERVAL ', 5 ' (LOW-HI): ',5I6, 6 /,' NUMBER OF REJECTS IN REGION 3 FOR EACH INTERVAL ', 7 ' (LOW-HI): ',5I6) C C FINALLY PERFORM PART 2 OF THE QC, APPLICATION OF THE STATIC C MASK. DATAC( , ,4) CONTAINS THE MASK. C DO J=1,NY DO I=1,NX IF (NINT(DATAC(I,J,4)).EQ.1) THEN DO N=1,NUMRL DATAO(I,J,N)=9999.0 END DO END IF END DO END DO C IFIRST=1 END IF ! IF IFIRST=0 C C RETURN DATA BASED ON NVAR C NN=1 DO J=1,NY DO I=1,NX DATA(NN)=DATAO(I,J,NVAR) NN=NN+1 END DO END DO C RETURN ! CLEAN RETURN, BYPASSES ERROR HANDLING C C ERROR HANDLING C 950 DO NN=1,ND5 DATA(NN)=9999.0 END DO C 999 RETURN END