SUBROUTINE PLASTV1(KFILDO,CCALL,NAME,FD4,DIR,ND1,NSTA, 1 DATA,NX,NY,IER) C C JUNE 2019 GLAHN MDL MOS-2000 C REVISED FROM 2016 PLASTC C OCTOBER 2019 GLAHN USED END DO TO ELIMINATE GO TO; C SKIPPED STATION OFF THE GRID C OCTOBER 2019 GLAHN CHANGED VALUES IN TABLE1( ) C NOVEMBER 2019 GLAHN COUNTED MATCHES C C C PURPOSE C C TO PLACE THE 4 GRIDPOINTS AROUND A STATION WITH A C VALUE CONSISTENT WITH THE VECTOR STATION FORECAST C CATEGORY READ IN THE CALLING ROUTINE AND PROVIDED C IN FD4( ). C C THIS ROUTINE IS FOR VISIBILITY. IT IS CALLED FROM SETVTG. C THE LAMP CATEGORIES ARE: C CAATEGORY LIMITS (MI) C 1 = 0 AND < 1/2 C 2 = 1/2 AND < 1 C 3 = 1 AND < 2 C 4 = 2 AND < 3 C 5 =3 AND <= 5 C 6 > 5 AND <= 6 C 7 > 6 C C DATA SET USE C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (OUTPUT) C C VARIABLES C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (INPUT) C CCALL(K) = 8-CHARACTER STATION CALL LETTERS TO PROVIDE C OUTPUT FOR (K=1,NSTA). (CHARACTER*8) (INPUT) C NAME(K) = NAMES OF STATIONS (K=1,NSTA). USED FOR PRINTOUT C ONLY. (CHARACTER*20) (INPUT) C FD4(K) = VECTOR FORECASTS (K=1,ND1). (INPUT) C DIR(K,J) = THE IX (J=1) AND JY (J=2) POSITIONS ON THE GRID C FOR FOR EACH STATION K (K=1,NSTA) FOR THE C CORRECT GRID. (INPUT) C ND1 = THE FIRST DIMENSION OF DIR( , ). (INPUT) C NSTA = THE NUMBER OF STATIONS DEALT WITH. (INPUT) C DATA(IX,JY) = ARRAY TO OPERATE ON AND RETURN (IX=1,NX) C (JY=1,NY). (INPUT/OUTPUT) C NX,NY = DIMENSIONS IN X AND Y DIRECTIONS OF DATA( , ). C (INPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C (OUTPUT) C TABLE1(I) = CORRESPONDENCE TABLE THE BETWEEN CATEGORIES I C (I=2,8) FOR VISIBILITY. TABLE(I+1) IS THE C INCLUSIVE LOWER BOUND FOR CATEGORY I. C TABLE1(L+2) IS THE EXCLUSIVE UPPER BOUND FOR C CATEGORY I. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C NONE C CHARACTER*8 CCALL(ND1) CHARACTER*20 NAME(ND1) C DIMENSION DATA(NX,NY) DIMENSION DIR(ND1,2),FD4(ND1) DIMENSION TABLE1(9) C DATA TABLE1/.0, .000, .50, 1.00, 2.0, 3.0, 5., 6., 10.01/ C CATEGORY NO. 1 2 3 4 5 6 7 C IER=0 CALL TIMPR(KFILDO,KFILDO,'START PLASTV1 ') KOUNT1=0 KOUNT2=0 KOUNT3=0 C DO_130: DO 130 K=1,NSTA C IF(FD4(K).LT.9998.5)THEN IX=NINT(DIR(K,1)) JY=NINT(DIR(K,2)) L=NINT(FD4(K)) C L IS THE LAMP CATEGORY NUMBER OF THE MELD FORECASTS. C C GUARD AGAINST VALUE OF L OUT OF RANGE OF TABLE1( ). C IF(L.LT.1.OR.L.GT.7)THEN WRITE(KFILDO,114)L 114 FORMAT(/'****LAMP CATEGORY =',I7,' ON VECTOR FILE OUT OF', 1 ' PERMISSIBLE RANGE 1 TO 7. VALUE SKIPPED.', 2 ' GRID NOT MODIFIED.') CYCLE DO_130 ENDIF C IF(IX.LT.1.OR.IX.GT.NX-1.OR. 1 JY.LT.1.OR.JY.GT.NY-1)THEN C WRITE(KFILDO,113)CCALL(K),IX,JY 113 FORMAT(' THIS STATION ',A8,' AT IX,JY =',2I6, 1 ' IS OFF THE GRID.') C THIS STATION IS OFF THE GRID. CYCLE DO_130 ENDIF WRITE(KFILDO,115)L,DATA(IX,JY),TABLE1(L+2),TABLE1(L+1) 115 FORMAT(/' AT 115--L,DATA(IX,JY),TABLE1(L+2),TABLE1(L+1)', 1 I3,3F10.4) C IF(L.LT.5.AND.(DATA(IX,JY).GE.TABLE1(L+2)).OR. 1 L.GE.5.AND.(DATA(IX,JY).GT.TABLE1(L+2)))THEN C DATA( , ) HAS NOT BEEN PACKED UP TO THIS POINT C SO NO PRECISION HAS BEEN LOST. DATA(IX,JY) IS THE C VALUE IN THE GRID CLOSEST TO THE STATION. KOUNT1=KOUNT1+1 WRITE(KFILDO,120)CCALL(K),NAME(K),L,DATA(IX,JY), 1 TABLE1(L+2)-.01,KOUNT1 120 FORMAT(' STATION ',A8,1X,A20,' LAMP CATEGORY =',I4, 1 ' REPLACING GRID VALUE =',F8.4,' WITH',F8.4, 2 ' DOWN REPLACEMENTS ',I8) IX=DIR(K,1) JY=DIR(K,2) C THIS IS THE LOWER LEFT CORNER OF THE BOX AROUND THE C STATION. DATA(IX,JY)=TABLE1(L+2)-.01 DATA(IX+1,JY)=TABLE1(L+2)-.01 DATA(IX,JY+1)=TABLE1(L+2)-.01 DATA(IX+1,JY+1)=TABLE1(L+2)-.01 C THE -.01 SETS THE VALUE FAR ENOUGH INSIDE THE UPPER C BOUND OF THE CATEGORY THAT PACKING WON'T PUT IT INTO C THE NEXT CATEGORY. ELSEIF(L.LT.6.AND.(DATA(IX,JY).LT.TABLE1(L+1)).OR. 1 L.GE.6.AND.(DATA(IX,JY).LE.TABLE1(L+1)))THEN KOUNT2=KOUNT2+1 WRITE(KFILDO,121)CCALL(K),NAME(K),L,DATA(IX,JY), 1 TABLE1(L+1)+.01,KOUNT2 121 FORMAT(' STATION ',A8,1X,A20,' LAMP CATEGORY =',I4, 1 ' REPLACING GRID VALUE =',F8.4,' WITH',F8.4, 2 ' UP REPLACEMENTS ',I8) IX=DIR(K,1) JY=DIR(K,2) DATA(IX,JY)=TABLE1(L+1)+.01 DATA(IX+1,JY)=TABLE1(L+1)+.01 DATA(IX,JY+1)=TABLE1(L+1)+.01 DATA(IX+1,JY+1)=TABLE1(L+1)+.01 C THE +.01 SETS THE VALUE FAR ENOUGH INSIDE THE LOwER C BOUND OF THE DATEGORY THAT PACKING WON'T PUT IT INTO C THE NEXT CATEGORY. ELSE KOUNT3=KOUNT3+1 WRITE(KFILDO,122)CCALL(K),NAME(K),L,DATA(IX,JY),KOUNT3 122 FORMAT(' STATION ',A8,1X,A20,' LAMP CATEGORY =',I4, 1 ' GRID VALUE =',F8.4,' MATCH, TOTAL =',I4) ENDIF C ENDIF C 130 END DO DO_130 C RETURN END