SUBROUTINE RQCRCM(KFILDO,NDATE,RAD,FLT,WRK,FLT33,FLTPT33, 1 IP20,IP21,NX,NY,GLAT,GLON,GCHECK,GNOCH) C C MAY 2005 CHARBA MDL MOS2000 C AUGUST 2005 CHARBA ADDED IP20 AND IP21 TO THE ARGUMENT C LIST TO USE FOR OUTPUTTING PRINT FILES. C OCTOBER 2012 CHARBA CHANGED F4.2 FORMAT TO F5.2 TO AVOID C INTEL COMPILER ERROR MSGS. C C PURPOSE C PERFORM A SUITE OF ERROR CHECKS ON THE RCM RADAR REFLECTIV- C ITIES AND MAKE APPROPRIATE QC ADJUSTMENTS WHERE ERRORS ARE C INDICATED. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C NX = MAX GRID POINTS IN X DIRECTION. (INPUT) C NY = MAX GRID POINTS IN Y DIRECTION. (INPUT) C NDATE = DATE BEING PROCESSED. (INPUT) C RAD(I,J) = CONTAINS RADAR REFLECTIVITY DATA C (I=1,NX,J=1,NY). (INPUT) C FLT(I,J) = LIGHTNING FLASH COUNT DATA (I=1,NX,J=1,NY). C (INPUT) C WRK(I,J) = CONTAINS QC'D RADAR REFLECTIVITY DATA C (I=1,NX,J=1,NY). (OUTPUT) C FLT33(I,J) = CONTAINS 3X3 SUMMED LIGHTNING FLASH COUNT AT C CURRENT TIME (I=1,NX,J=1,NY). (INTERNAL) C FLTPT33(I,J) = CONTAINS 3X3 SUMMED LIGHTNING FLASH COUNT AT C PREVIOUS TIME (I=1,NX,J=1,NY). (INTERNAL) C STALAT(I,J) = CONTAINS THE LATITUDE OF THE LL CORNER OF THE C 10-KM RADAR AND LIGHTNING GRIDBOXES C (I=1,NX,J=1,NY). (INPUT) C STALON(I,J) = CONTAINS THE LONGITUDE OF THE LL CORNER OF THE C 10-KM RADAR AND LIGHTNING GRIDBOXES C (I=1,NX,J=1,NY). (INPUT) C NUMRL = NUMBER OF RADAR LEVELS TO CHECK. (INTERNAL) C RADLVL(K) = RADAR LEVELS TO CHECK (K=1,NUMRL). (INTERNAL) C RMIN = MIN RADAR VALUE AMONG NEAREST 8 GRIDBOXES TO THE C CENTRAL GRIDBOX. (INTERNAL) C RMIN = MAX RADAR VALUE AMONG NEAREST 8 GRIDBOXES TO THE C CENTRAL GRIDBOX. (INTERNAL) C THAVGA(M,N) = THRESHOLD RADAR VALUES APPLIED TO MEAN OVER C 8 GRIDBOXES SURROUNDING THE CENTER BOX. C (M=1,NUMRL;N=1,2) C RADPRT = RADAR REFLECTIVITY THRESHOLD FOR WHICH DIAGNOS- C TIC MESSAGES ARE PRINTED OUT. (INTERNAL) C IP20 = UNIT NUMBER FOR WRITING A PRINT OUTPUT FILE C CONTAINING A LISTING OF RCM GRIDBOXES WITH C CATEGORY 5 AND 6 VALUES AND THE CORRESPOND- C ING LIGHTNING VALUES. (INPUT) C IP21 = UNIT NUMBER FOR WRITING A PRINT OUTPUT FILE C CONTAINING DIAGNOSTIC INFORMATION FOR GRID C BOXES IN WHICH THE RCM VALUES ARE CHECKED C AND POSSIBLY CORRECTED. (INPUT) C C NON-SYSTEM ROUTINES CALLED C NONE. C DIMENSION RAD(NX,NY),FLT(NX,NY),GLAT(NX,NY),GLON(NX,NY), 1 WRK(NX,NY),FLT33(NX,NY),FLTPT33(NX,NY) C REAL RADLVL(2)/6.0,5.0/ REAL THAVGA(2,2)/ 1.8, 1.3, 1 1.8, 1.3/ C 1 2.7, 2.0/ C 1 3.1, 2.5/ REAL RADPRT /5.0/ C INTEGER NUMRL/2/ C SAVE C C BEGIN BY SETTING OUTPUT RADAR ARRAY TO THE INPUT (RAW) RADAR C ARRAY. C DO 10 J=1,NY DO 10 I=1,NX WRK(I,J)=RAD(I,J) 10 CONTINUE C C GCHECK IS A COUNTER FOR THE NUMBER OF GRIDPOINTS CHECKED FOR C THE CURRENT DATE. C GNOCH IS A COUNTER FOR THE NUMBER OF GRIDPOINTS WHICH WERE C CHECKED BUT NOT CHANGED FOR THE CURRENT DATE. C GCHECK=0.0 GNOCH=0.0 C C PERFORM CHECK FOR EACH GRIDPOINT...IGNORE GRID BORDERS C SINCE RADAR DATA ARE MISSING THERE. C DO 200 J=2,NY-1 DO 200 I=2,NX-1 C C PASS OVER GRIDPOINTS WITH MISSING RADAR VALUES. C IF(WRK(I,J).EQ.9999.) GO TO 200 C C LOOP OVER NUMBER OF RADAR LEVELS TO CHECK. NOTE: ONCE A GRID- C POINT (FOR A RADAR LEVEL) IS CORRECTED, NO ADDITIONAL CHECKS/- C CORRECTIONS ARE MADE (EXIT 100 LOOP BELOW). C DO 100 NRL=1,NUMRL C C PERFORM CHECK FOR GRIDPOINT ONLY IF WRK( , )=RADLVL(NRL) C IF(WRK(I,J).NE.RADLVL(NRL)) GO TO 100 C GCHECK=GCHECK+1. TEMP=WRK(I,J) C C IF(FLT(I,J).GE.1.0) THEN IF(FLT33(I,J).GE.1.0.OR.FLTPT33(I,J).GE.1.0) THEN GNOCH=GNOCH+1. C C RADAR LEVELS 5 AND 6 ARE NOT CHANGED WHEN LIGHTNING OCCURS C IN 3X3 GRIDBOX AT CURRENT OR PREVIOUS TIME. C C BRANCH 1.00 OCCURRED IN 77.28%/63.41% OF THE WS/CS (5-6) C CASES. C BRANCH=1.00 GO TO 40 ENDIF C C CHECK RADAR VALUE IN NEAREST 8 GRIDBOXES AND SET FLAG WHEN THE C VALUES ARE NOT USEABLE (WHEN THEY TAKE ON VALUES OF ONLY C 9999., 0., AND 6.). ALSO COMPUTE AVG AND AVGA FROM THEM. C LCNT=0 SUMA=0.0 ICNT=0 ICNT6=0 SUM=0.0 RMIN=6. RMAX=0. C C IUSE WILL RETAIN THE VALUE OF 0 WHEN SURROUNDING 8 GRIDPOINTS C CONTAIN ANY COMBINATION OF ONLY 9999., 6.0, OR, 0.0 VALUES. C IUSE=0 DO 15 JJ=J-1,J+1 DO 15 II=I-1,I+1 IF(RAD(II,JJ).EQ.9999..OR.(JJ.EQ.J.AND.II.EQ.I)) GO TO 15 IF(RAD(II,JJ).EQ.RADLVL(1)) GO TO 12 LCNT=LCNT+1 SUMA=SUMA+RAD(II,JJ) IF(RAD(II,JJ).NE.0.) IUSE=1 12 ICNT=ICNT+1 IF(RAD(II,JJ).EQ.RADLVL(1)) ICNT6=ICNT6+1 SUM=SUM+RAD(II,JJ) IF(RAD(II,JJ).LT.RMIN) RMIN=RAD(II,JJ) IF(RAD(II,JJ).GT.RMAX) RMAX=RAD(II,JJ) 15 CONTINUE IF(LCNT.EQ.0) THEN AVGA=9999. ELSE AVGA=SUMA/LCNT ENDIF IF(ICNT.EQ.0) THEN AVG=9999. ELSE AVG=SUM/ICNT ENDIF C C BEGIN CHECKING IN ERNEST. C IF(IUSE.EQ.0) THEN C C ARBITRARILY CHANGE (5 OR 6) RCM VALUES TO 3. C C BRANCH 1.01 HAD ONLY .07%/.04% OF THE WS/CS CASES. C BRANCH=1.01 C WRK(I,J)=9999. WRK(I,J)=3. GO TO 30 ENDIF IF(ICNT6.GE.3) THEN C C ARBITRARILY CHANGE (5 OR 6) RCM VALUES TO 3. C C BRANCH 1.07 HAD 1.03%/1.17% OF WS/CS CASES. C BRANCH=1.07 C WRK(I,J)=9999. WRK(I,J)=3. GO TO 30 ENDIF IF(FLT33(I,J).GE.1.AND.IUSE.EQ.1) THEN C C BRANCH 1.02 HAD NO CASES DURING WS AND CS. C BRANCH=1.02 GNOCH=GNOCH+1. GO TO 40 ENDIF IF(IUSE.EQ.1.AND.FLT33(I,J).EQ.0..AND.AVGA.GE.THAVGA(NRL,1)) THEN C C BRANCH 1.03 HAD 18.85%/32.92% OF THE WS/CS CASES. C BRANCH=1.03 GNOCH=GNOCH+1. GO TO 40 ENDIF IF(FLTPT33(I,J).GE.1.) THEN C C BRANCH 1.04 HAD NO CASES DURING WS AND CS. C BRANCH=1.04 GNOCH=GNOCH+1 GO TO 40 ENDIF IF(IUSE.EQ.1.AND.FLT33(I,J).EQ.0..AND.FLTPT33(I,J).EQ.0..AND. 1 AVGA.LT.THAVGA(NRL,2)) THEN C C BRANCH 1.05 HAD 2.77%/2.46% OF THE WS/CS CASES. C BRANCH=1.05 C WRK(I,J)=9999. WRK(I,J)=NINT(AVGA) GO TO 30 ENDIF C C BRANCH 1.06 HAD NO CASES DURING THE WS AND CS. C BRANCH=1.06 GNOCH=GNOCH+1 GO TO 40 C 30 WRITE(IP21,35) I,J,GLAT(I,J),GLON(I,J),TEMP,WRK(I,J),FLT(I,J), 1 FLT33(I,J),FLTPT33(I,J),IUSE,RMIN,RMAX,AVG,AVGA, 2 ICNT,ICNT6,LCNT,THAVGA(NRL,1),BRANCH,NDATE 35 FORMAT(' FOR I, J = ',2I5,' LAT, LONG = ',2F7.2,' RADAR VALUE', 1 ' OF ',F3.0,' WAS CHANGED TO ',F6.0,' FLT, FLT33, FLTPT33' 2 ,' = ',3F4.0,' IUSE, RMIN, RMAX, AVG, AVGA, ICNT, ICNT6, ' 3 ,'LCNT = ',I1,1X,2F3.0,2F7.1,3I2,' TH = ',F4.1, Cintl4 ' ****BRANCH = ',F4.2,' NDATE = ',I10) 4 ' ****BRANCH = ',F5.2,' NDATE = ',I10) C WRITE(IP20,36) NDATE,I,J,TEMP,WRK(I,J),FLT(I,J),BRANCH 36 FORMAT(I10,2I5,2X,F8.0,5X,F8.0,5X,F9.0,8X,F5.2,/) GO TO 200 C 40 IF(WRK(I,J).GE.RADPRT) THEN IF(BRANCH.EQ.1.00.OR.BRANCH.EQ.1.02) GO TO 50 WRITE(IP21,45) I,J,GLAT(I,J),GLON(I,J),WRK(I,J),FLT(I,J), 1 FLT33(I,J),FLTPT33(I,J),IUSE,RMIN,RMAX,AVG,AVGA, 2 ICNT,ICNT6,LCNT,THAVGA(NRL,1),BRANCH,NDATE 45 FORMAT(' FOR I, J = ',2I5,' LAT, LONG = ',2F7.2,' RADAR VALUE', 1 ' OF ',F3.0,' WAS NOT CHANGED FLT, FLT33, FLTPT33 = ', 2 3F4.0,' IUSE, RMIN, RMAX, AVG, AVGA, ICNT, ICNT6, ', 3 'LCNT = ',I1,1X,2F3.0,2F7.1,3I2,' TH = ',F4.1, Cintl4 ' ****BRANCH = ',F4.2,' NDATE = ',I10) 4 ' ****BRANCH = ',F5.2,' NDATE = ',I10) C 50 WRITE(IP20,36) NDATE,I,J,TEMP,WRK(I,J),FLT(I,J),BRANCH GO TO 200 ENDIF C 100 CONTINUE C 200 CONTINUE C RETURN END