SUBROUTINE CATEQ(KFILDO,P,DSAV,PSAV,NX,NY, 1 CCALL,NAME,XP,YP,XDATA,LTAGPT,NSTA,IER) C C DECEMBER 2009 GLAHN TDL MOS-2000 C ADAPTED FROM SETCFT C MARCH 2010 GLAHN ADDED 220 DIAGNOSTIC C MAY 2010 GLAHN ASSURED GRIDPOINT IX,JY WITHIN GRID; C ASSURED GRID VALUE IS NOT MISSING C MAY 2010 GLAHN ELIMINATED "CEILING HEIGHT' IN C DIAGNOSTICS; COMMENTS; SPELL CHECK C JULY 2010 GLAHN ADDED COMMENTS; REMOVED "D" ON C DIAGNOSTICS AT 121 AND 1215 C C PURPOSE C TO MAKE SURE THE CLOSEST GRIDPOINT IN P( , ) TO A C STATION HAS A VALUE WITHIN THE RANGE OF THE CATEGORY C IN XDATA( ). BOTH P( , ) AND XDATA( ) ARE IN C CATEGORIES. THESE CAN BE CEILING HEIGHT OR VISIBILITY, C FORECASTS OR OBSERVATIONS. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C P(IX,JY) = ANALYSIS GRID (IX=1,NX) (JY=1,NY). C (INPUT/OUTPUT) C DSAV(IX,JY) = WORK ARRAY (IX=1,NX) (JY=1,NY). HOLDS C DISTANCES TO CONTROLLING STATION. (INTERNAL) C DSAV(IX,JY) = WORK ARRAY (IX=1,NX) (JY=1,NY). HOLDS C INCOMING P( , ) UNTIL OUTPUT. (INTERNAL) C NX = X EXTENT OF GRID IN P( , ). (INPUT) C NY = Y EXTENT OF GRID IN P( , ). (INPUT) C CCALL(K) = CALL LETTERS OF STATION K (K=1,NSTA). C (CHARACTER*8) (INPUT) C NAME(K) = NAME OF STATION K (K=1,NSTA). C (CHARACTER*8) (INPUT) C XP(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE GRID IN P( , ). (INPUT) C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE GRID IN P( , ). (INPUT) C XDATA(K) = CATEGORICAL VALUES (K=1,NVAL). C (INPUT) C LTAGPT(K) = HOLDS THE LTAG VALUES TO BE USED BY SUBROUTINE C CATEQ. THE USABLE ORIGINAL DATA VALUES HAVE C A ZERO IN LTAGPT( ) AND THE AUGMENTED ONES HAVE C A 1. (INTERNAL) (AUTOMATIC) C NSTA = THE NUMBER OF VALUES IN XDATA( ) BEING DEALT C WITH. (INPUT) C IER = ERROR RETURN. C 0 = GOOD RETURN. C (OUTPUT) C NCOUNT = COUNT OF COMPARISONS. (INTERNAL) C ICOUNT = COUNT OF CHANGES. (INTERNAL) C NOINC = COUNT OF INCREASES. (INTERNAL) C NODEC = COUNT OF DECREASES. (INTERNAL) C AVGCHG = ACCUMULATION AND THEN AVERAGE OF CHANGES. C (INTERNAL) C AVGABS = ACCUMULATION AND THEN AVERAGE OF ABSOLUTE C CHANGES. (INTERNAL) C F = FRACTION OF CHANGES OF TOTAL (IN PERCENT). C (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C NONE C CHARACTER*8 CCALL(NSTA) CHARACTER*20 NAME(NSTA) C DIMENSION XDATA(NSTA),XP(NSTA),YP(NSTA),LTAGPT(NSTA) DIMENSION P(NX,NY),DSAV(NX,NY),PSAV(NX,NY) C D CALL TIMPR(KFILDO,KFILDO,'START CATEQ ') C IER=0 NCOUNT=0 ICOUNT=0 NOINC=0 NODEC=0 AVGCHG=0. AVGABS=0. C C INITIALIZE DSAV( , ). C DO 110 JY=1,NY DO 109 IX=1,NX DSAV(IX,JY)=9999. PSAV(IX,JY)=P(IX,JY) 109 CONTINUE 110 CONTINUE C DO 200 K=1,NSTA C CCC WRITE(KFILDO,112)K,CCALL(K),NAME(K),LTAGPT(K) CCC 112 FORMAT(/' AT 112 IN CATEQ--K,CCALL(K),NAME(K),LTAGPT(K)', CCC 1 I7,1X,A6,1X,A20,I6) C IF(XDATA(K).GT.9998.9)GO TO 200 IF(LTAGPT(K).NE.0)GO TO 200 C ON TRANSFER, THIS IS AN AUGMENTED STATION AND NOT TO BE C DEALT WITH HERE. NCOUNT=NCOUNT+1 DMIN=9999. IX=XP(K) JY=YP(K) C DO 120 M=0,1 DO 119 N=0,1 D=(XP(K)-(IX+N))**2+(YP(K)-(JY+M))**2 C IF(D.LT.DMIN)THEN DMIN=D NSAV=N MSAV=M ENDIF C 119 CONTINUE 120 CONTINUE C IX=IX+NSAV JY=JY+MSAV C C ASSURE LOCATION IS WITHIN THE GRID. THE IX, JY ARE THE C X AND Y COORDINATES OF THE GRIDPOINT CLOSEST TO THE STATION. C IF(IX.LT.1.OR.IX.GT.NX.OR. 1 JY.LT.1.OR.JY.GT.NY)THEN C D WRITE(KFILDO,121)CCALL(K),NAME(K) D121 FORMAT(/' STATION ',A8,A20,' IS OUTSIDE GRID. IN CATEQ.') C GO TO 200 ENDIF C D=(XP(K)-(IX))**2+(YP(K)-(JY))**2 C IF(D.LT.DSAV(IX,JY))THEN NSCAT=MAX(1.,XDATA(K)) NGCAT=MAX(1.,P(IX,JY)) C C THE GRID HAS BEEN CLIPPED. MAKE SURE THE VALUE C IN P(IX,JY) IS NOT MISSING. C IF(NGCAT.GE.9998)THEN C D WRITE(KFILDO,1215)CCALL(K),NAME(K) D1215 FORMAT(/' STATION ',A8,A20,' IS OUTSIDE CLIPPED GRID.', D 1 ' IN CATEQ.') C GO TO 200 ENDIF C C THE VALUES IN XDATA( ) AND P(IX,JY) ARE CATEGORY VALUES C SCALED WITHIN CATEGORIES. THE MAX FUNCTION GUARDS C AGAINST NEGATIVE VALUES. C D WRITE(KFILDO,122)XDATA(K),NSCAT,P(IX,JY),NGCAT D122 FORMAT(' AT 122 IN CATEQ--XDATA(K),NSCAT,P(IX,JY),NGCAT', D 1 F12.5,I4,F12.5,I4) C IF(NGCAT.LT.NSCAT)THEN PSAV(IX,JY)=NSCAT+.02 C THE GRIDPOINT IS BELOW THE STATION CATEGORY, C SO SET IT TO THE LOW END OF THE SCALED STATION C CATEGORY PLUS AN INCREMENT TO CIRCUMVENT C POSSIBLE PRECISION PROBLEMS. ICOUNT=ICOUNT+1 NOINC=NOINC+1 AVGCHG=AVGCHG+ PSAV(IX,JY)-NGCAT AVGABS=AVGABS+ABS(PSAV(IX,JY)-NGCAT) C D IF(DSAV(IX,JY).GT.9998.)THEN C D WRITE(KFILDO,125)CCALL(K),NAME(K),XDATA(K),NSCAT, D 1 P(IX,JY),NGCAT,PSAV(IX,JY) D125 FORMAT(' STATION ',A8,1X,A20,' OF',F9.5,I3, ' ADJUSTED', D 1 ' CLOSEST GRIDPOINT VALUE OF ',F9.5,I3, D 2 ' UP TO ',F9.5) D ELSE D WRITE(KFILDO,126)CCALL(K),NAME(K),XDATA(K),NSCAT, D 1 P(IX,JY),NGCAT,PSAV(IX,JY) D126 FORMAT(' STATION ',A8,1X,A20,' OF',F9.5,I3, ' ADJUSTED', D 1 ' CLOSEST GRIDPOINT VALUE OF ',F9.5,I3, D 2 ' UP TO ',F9.5,' SECOND ADJUSTMENT.') D ENDIF C ELSEIF(NGCAT.GT.NSCAT)THEN PSAV(IX,JY)=NSCAT+.98 C THE GRIDPOINT IS ABOVE THE STATION CATEGORY, C SO SET IT TO THE HIGH END OF THE SCALED STATION C CATEGORY MINUS AN INCREMENT TO CIRCUMVENT C POSSIBLE PRECISION PROBLEMS. ICOUNT=ICOUNT+1 NODEC=NODEC+1 AVGCHG=AVGCHG+ PSAV(IX,JY)-NGCAT AVGABS=AVGABS+ABS(PSAV(IX,JY)-NGCAT) C D IF(DSAV(IX,JY).GT.9998.)THEN C D WRITE(KFILDO,135)CCALL(K),NAME(K),XDATA(K),NSCAT, D 1 P(IX,JY),NGCAT,PSAV(IX,JY) D135 FORMAT(' STATION ',A8,1X,A20,' OF',F9.5,I3, ' ADJUSTED', D 1 ' CLOSEST GRIDPOINT VALUE OF ',F9.5,I3, D 2 ' DOWN TO ',F9.5) D ELSE D WRITE(KFILDO,136)CCALL(K),NAME(K),XDATA(K),NSCAT, D 1 P(IX,JY),NGCAT,PSAV(IX,JY) D136 FORMAT(' STATION ',A8,1X,A20,' OF',F9.5,I3, ' ADJUSTED', D 1 ' CLOSEST GRIDPOINT VALUE OF ',F9.5,I3, D 2 ' DOWN TO ',F9.5,' SECOND ADJUSTMENT.') D ENDIF C ENDIF C C THE STATION AND THE GRIDPOINT ARE OF THE SAME CATEGORY. C SAVE IT IN DSAT( , ). C DSAV(IX,JY)=D ENDIF C C WHEN DSAV( , ) IS LE D, IT IS NOT MODIFIED. C 200 CONTINUE C AVGCHG=AVGCHG/ICOUNT AVGABS=AVGABS/ICOUNT NF=NINT((REAL(ICOUNT)/REAL(NCOUNT))*100.) C IF(ICOUNT.GT.0)THEN WRITE(KFILDO,205)ICOUNT,NF,NOINC,NODEC,AVGCHG,AVGABS 205 FORMAT(/,I6,' VALUES IN THE ANALYSIS GRID MODIFIED', 1 ' BY THE STATION VALUE AFTER THE ANALYSIS', 2 ' (',I2,' PERCENT OF STATIONS).'/ 3 ' NO. INCREASES =',I5, 4 ', NO. DECREASES =',I5, 5 ', AVG CHANGE =', F5.2,' CATEGORIES', 6 ', AVG ABS CHANGE =',F5.2,' CATEGORIES.') C DO 210 JY=1,NY DO 209 IX=1,NX P(IX,JY)=PSAV(IX,JY) 209 CONTINUE 210 CONTINUE C ELSE WRITE(KFILDO,220) 220 FORMAT(/' NO VALUES IN THE ANALYSIS GRID WERE MODIFIED', 1 ' BY THE STATION VALUE AFTER THE ANALYSIS.', 2 ' WAHOO!') ENDIF C RETURN END