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,NUMRA,
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 SEPTEMBER 2020 GHIRARDELLI INITIALIED NREJ TO 0 TO PASS
C check all TEST
C OCTOBER 2020 GHIRARDELLI INITIALIED NSPIKE TO 0 TO PASS
C check all TEST
C DECEMBER 2022 SAMPLATSKY MINOR EDITS TO PROPERLY FETCH
C INPUT DATA TO PERFORM QC AT HH:00
C AND HH:30 TIMES.
C JULY 2024 SAMPLATSKY SOMEHOW RACESS WAS NEVER DECLARED
C AND NEW COMPILERS FLAGGED THIS.
C ADDED NUMRA TO THE ARGUMENT LIST
C AND DECLARE RACESS(NUMRA) SO IT
C MATCHES OPTION.
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
CHARACTER*60 RACESS(NUMRA)
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
NSPIKE=0
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
NSPIKE=0
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
IF (ID(2).EQ.30) LD(2)=20
IF (ID(2).EQ.44) LD(2)=35
IF (ID(2).EQ.00) LD(2)=50
IF (ID(2).EQ.14) LD(2)=05
c 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)
IF ((K.EQ.4).AND.(LD(2).EQ.50)) THEN
CALL UPDAT(NDATE,-1,LDATE)
ELSE
LDATE=NDATE
END IF
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
NREJ=0
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