SUBROUTINE SETPNT(KFILDO,CCALL,NAME,DATA,LTAG,LTAGPT,LNDSEA, 1 XP,YP,NSTA, 2 P,DIST,NX,NY,MESH,SEALND,NXE,NYE,MESHE, 3 ISETP,IER) C C OCTOBER 2004 GLAHN MDL MOS-2000 C FEBRUARY 2005 GLAHN MODIFIED TO MAKE PARTIAL CORRECTION; C ADDED ISETP TO CALL C JUNE 2005 GLAHN REMOVED CHECK OF LTAG = -3; COMMENTS; C CHECKED FOR GRIDPOINT = 9999. C SEPTEMBER 2005 GLAHN INCLUDED INITIAL TEST FOR ISETP = 0 C NOVEMBER 2005 DALLAVALLE MODIFIED FORMAT STATEMENTS TO C CONFORM TO FORTRAN 90 STANDARDS C ON THE IBM SP; CHANGED IF C TESTS FOR EQUALITY OF REAL C VALUES C FEBRUARY 2006 GLAHN ADDED PARAGRAPH IN PURPOSE C JUNE 2010 GLAHN COMMENTS C JULY 2010 GLAHN COMMAS FOR /D COMPILER OPTION C AUGUST 2011 GLAHN ADDED LTAGPT( ) C FEBRUARY 2012 GLAHN INSERTED TEST TO ACCOMMODATE C LTAG( ) = 4 C FEBRUARY 2012 GLAHN REMOVED LTAG( ) = 4 TEST C AUGUST 2015 GLAHN ADDED DIAGNOSTIC WHEN CLOSEST C GRIDPOINT VALUE IS REPLACED; C REPLACED IF(P(I,J).NE.9999.)THEN C WITH IF(P(I,J).LT.9998.5)THEN C AUGUST 2015 GLAHN PUT CALL( ) AND NAME( ) IN CALL; C ADDED DIAGNOSTICS WITH /D C OCTOBER 2015 GLAHN CHANGED SETPNT TO INTRPL IN COMMENT; C REVISED FOR ISETP = 3; ADDED KOUNT( ) C NOVEMBER 2015 GLAHN TWO MODS TO SEPARATE ISETP 3 FROM 2 C NOVEMBER 2015 GLAHN REMOVED CODE DEALING WITH ISETP = 1 C NOVEMBER 2015 GLAHN ADDED METAR( ); CHANGED METHOD OF C CHECKING ON METAR STATION; ADDED C ISETP = 4 C NOVEMBER 2015 GLAHN INCORPORATED LNDSEA( ) & SEALND( , ); C ADDED NXE, NYE, MESH, MESHE TO CALL C DECEMBER 2015 GLAHN CHANGED METAR( ) DEFINITION TO C REQUIRE A BLANK IN THE 5TH VICE C 6TH POSITION IN CCALL( ) C MARCH 2016 GHIRARDELLI COMMENTED OUT WRITE 119 TO C REDUCE VOLUMINOUS OUTPUT C DECEMBER 2016 SCHNAPP WRITE STATEMENT NEAR 111 NO LONGER C GOES OUT OF BOUNDS C APRIL 2017 GLAHN MODIFIED FORMAT 111 C APRIL 2017 GLAHN CORRECTED SPELLING OF GRIDPOINT C FEBRIARY 2019 GLAHN MODIFIED TO NOT PRINT DIAGNOSTIC C WHEN DATA POINT OUTSIDE GRID C APRIL 2019 GLAHN ADDED ISETP = 5 CAPABILITY; ADDED C "P" FOR ALASKA METAR DEFINITION C MAY 2019 GLAHN FOR ISETP = 5, REMOVED RESTRICTION C THAT THE STATION TYPE MATCH THE GRID C C PURPOSE C FOR EVERY USABLE DATA POINT IN DATA( ), WHOSE POSITION ON C A GRID P( , ) IS REPRESENTED BY XP( ) AND YP( ), MODIFY C THE VALUE OF THE GRIDPOINT AT THE CLOSEST GRIDPOINT, C PROVIDED: C (1) THE DATA POINT IS WITHIN THE GRID OR WITHIN C 1/2 GRIDLENGTH OF THE GRID. C (2) A CLOSER DATA POINT HAS NOT ALREADY MODIFIED THE C GRIDPOINT (EXCEPT FOR METAR, SEE ISETP = 3 BELOW). C (3) THE DATA POINT IS NOT AN AUGMENTED OR BOGUS VALUE. C (4) THE DATA POINT WAS NOT TOSSED ON THE LAST ANALYSIS C PASS. C (5) THE DATA TYPES FOR STATIONS AND GRIDPOINTS MATCH C (OCEAN WITH OCEAN, LAKE WITH LAKE, LAND WITH LAND; C C C THIS PLACEMENT IS COMPATIBLE WITH THE GRIDPOINT VALUE C RETURNED BY INTRPL. A PLACEMENT IS MADE IF THE STATION C IS OUTSIDE THE GRID BUT WITHIN 1/2 (SOMETIMES .707) C GRIDLENGTHS OF THE NEAREST GRIDPOINT. C C WHEN ISETP = 0: C NO REPLACEMENT IS DONE. C C WHEN ISETP = 1: C THE GRIDPOINT CORRECTION IS IN THE DIRECTION OF THE DATA C POINT, BUT DOES NOT TRAVERSE AN INTEGER VALUE. C EXAMPLES: C DATA POINT = 45.4; GRIDPOINT = 48.5; NEW VALUE = 48.05 C 45.4 44.4 44.95 C THIS ALWAYS MAKES LESS THAN 1 UNIT CORRECTION, AND C KEEPS BULLSEYES DOWN WHEN CONTOURING AT INTEGER VALUES. C EVEN THOUGH A CORRECTION MAY BE MADE TO A CORRECTED C GRIDPOINT, THAT IS OK. C C NOTE FOR PROBABILITIES IN THE 0 TO 1 RANGE, .05 IS LARGE. C THIS COULD BE CHANGED TO A DIFFERENCE OF .01 RATHER THAN C .05, BUT IT IS LIKELY SETPNT WON'T BE USED FOR C PROBABILITIES. C C WHEN ISETP = 2: C THE GRIDPOINT IS SET TO THE STATION VALUE. C C CAUTION: THIS COULD MAKE A LARGE CORRECTION; HOWEVER, C STATIONS TOSSED IN THE LAST PASS ARE NOT C USED. C C WHEN ISETP = 3: C THE GRIDPOINT IS SET TO THE STATION VALUE. THIS IS THE C SAME AS ISETP = 2 EXCEPT THAT PREFERENCE IS GIVEN TO C STATIONS WITH IDENTIFIERS THAT START WITH "K" AND HAVE C A BLANK IN THE 5TH CHARACTER POSITION, PRESUMABLY C METAR STATIONS. C C CAUTION: THIS COULD MAKE A LARGE CORRECTION; HOWEVER, C STATIONS TOSSED IN THE LAST PASS ARE NOT C USED. C C WHEN ISETP = 4: C THE GRIDPOINT IS SET TO THE STATION VALUE, BUT ONLY WHEN C THE STATION IS "METAR" (STATIONS WITH IDENTIFIERS THAT C START WITH "K" AND HAVE A BLANK IN THE 5TH CHARACTER C POSITION). C C WHEN ISETP = 5: C ALL 4 GRIDPOINTS SURROUNDING THE STATION WILL BE SET C TO THE STATION VALUE. IN CASE OF CONFLICTS, PREFERENCE C IS GIVEN TO "K" AND "P" CALL LETTERS (CONUS AND ALASKA). C C WHEN MORE THAN ONE CYCLE IS MERGED, DATA( ) CAN HOLD C EITHER THE DATA BEING ANALYZED OR THE ON-CYCLE DATA. C C MESHE MUST EQUAL MESH. C C FATAL ERRORS, IER: C NONE. 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 CCALL(K) = STATION CALL LETTERS (K=1,NSTA) (INPUT) C NAME(K) = STATION NAMES (K=1,NSTA) (INPUT) C DATA(K) = DATA POINTS (K=1,NSTA). (INPUT) C LTAG(K) = DENOTES USE OF DATA CORRESPONDING TO CCALL(K). C +4 = TOSSED IN A PREVIOUS OBS RUN AND C MAINTAINED DOWNSTREAM. C +3 = TOSSED IN A PREVIOUS LAMP RUN, AND C MAINTAINED DOWNSTREAM. C +2 = NOT USED FOR ANY PURPOSE. C +1 = PERMANENTLY DISCARDED FOR THE VARIABLE C BEING ANALYZED. INCLUDES DATA FAR C OUTSIDE THE GRID, AS DEFINED BY RMAX C 0 = GOOD DATA, USE IT. C -1 = DO NOT USE ON THIS PASS. C -3 = ACCEPT THIS STATION ON EVERY PASS. THIS C FEATURE MAY OR MAY NOT BE IMPLEMENTED IN C THE CALLING PROGRAM. C (INPUT) C LTAGPT(K) = FOR STATION K (K=1NSTA), C 1 = AUGMENTED DATA (FIRST PASS) C 2 = AUGMENTED DATA (2ND PASS) C 3 = BOGUS DATA C 0 = EVERYTHING ELSE C (INPUT) C LNDSEA(K) = LAND/SEA INFLUENCE FLAG FOR EACH STATION C (K=1,ND1). C 0 = WILL BE USED FOR ONLY OCEAN WATER (=0) C GRIDPOINTS. C 3 = WILL BE USED FOR ONLY INLAND WATER (=3) C GRIDPOINTS. C 6 = WILL BE USED FOR BOTH INLAND WATER (=3) C AND LAND (=9) GRIDPOINTS. C 9 = WILL BE USED FOR ONLY LAND (=9) GRIDPOINTS. C (INPUT) C XP(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE GRID P( , ). (INPUT) C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE GRID P( , ). (INPUT) C NSTA = THE NUMBER OF DATA VALUES IN DATA( ), LTAG( ), C XP( ), AND YP( ). (INPUT) C P(IX,JY) = GRID (IX=1,NX) (JY=1,NY). (INPUT/OUTPUT) C DIST(IX,JY) = WORK ARRAY (IX=1,NX) (JY=1,NY). (INTERNAL) C NX = NUMBER OF GRIDPOINTS IN THE XI (LEFT TO RIGHT) C DIRECTION IN P( , ). (INPUT) C NY = NUMBER OF GRIDPOINTS IN THE JY (BOTTOM TO TOP) C DIRECTION IN P( , ). (INPUT) C MESH = THE NOMINAL MESH LENGTH OF THE CURRENT GRID. C (INPUT) C SEALND(IX,JY) = THE LAND/SEA MASK (IX=1,NX) (JY=1,NY). C 0 = OCEAN WATER GRIDPOINTS; C 3 = INLAND WATER GRIDPOINTS. C 9 = LAND GRIDPOINTS. C (INPUT) C NXE = X-EXTENT OF SEALND( , ), AT MESH LENGTH C MESHE. (INPUT) C NYE = Y-EXTENT OF SEALND( , ), AT MESH LENGTH C MESHE. (INPUT) C MESHE = THE NOMINAL MESH LENGTH OF SEALND( , ) GRID. C (INPUT) C ISETP = FLAG TO INDICATE WHETHER AFTER THE LASS PASS C A GRIDPOINT WILL BE MODIFIED BY A STATION C VALUE: C 0 = NOT MODIFIED, C 1 = NUDGED IN THE DIRECTION OF THE STATION, C BUT NOT TO CROSS AN INTEGER BOUNDARY, C 2 = SET TO THE CLOSEST STATION, C 3 = SAME AS 2 EXCEPT WHEN TWO OR MORE STATIONS C REPRESENT THE SAME GRIDPOINT, PREFERENCE C IS GIVEN TO "K" AND "P" STATIONS (STATIONS C WHOSE CALL LETTERS START WITH K (CONUS) OR C P (AKASJA) AND HAVE A BLANK IN THE 5TH C POSITION--PRESUMABLY METAR STATIONS). C 4 = THE SAME AS 3 EXCEPT ONLY METAR STATIONS C ARE PLACED. C 5 = ALL 4 GRIDPOINTS SURROUNDING THE STATION C ARE SET TO THE STATION VALUE. PREFERENCE C IS GIVEN TO "K" (CONUS) AND "P" (ALASKA) C CALL LETTERS WHEN THERE IS A CONFLICT. C (INPUT) C IER = ERROR RETURN. C 0 = GOOD RETURN. C 777 = WHEN ISETP NE 0, 1, 2, 3, 4, OR 5. C (OUTPUT) C ICLXY(IX,JY) = THE STATION NUMBER FOR EACH GRIDPOINT WHEN C REPLACED (IX=1,NX) (JY=1,NY). (AUTOMATIC) C (INTERNAL) C METAR(K) = WHEN = 1, THE STATION IS DEEMED A METAR C STATION; = 0 OTHERWISE. THE STATION IS JUDGED C METAR WHEN THE LEADING CHARACTER IS "K" OR "P" C AND THE 5TH CHARACTER IS BLANK. (AUTOMATIC) C (INTERNAL) C KOUNT(J) = COUNTS OF REPLACEMENTS (J=1,9). FOR SHORTHAND, C "K" HERE REFERS TO AN ATTEMPT TO IDENTIFY C METAR STATIONS. VALUES OF J ARE: C ISETP = 2,3 C 1--FIRST PLACEMENT C 2--CONFLICT, NOT K WITH NOT K C 3--REPLACE NOT K WITH K C 4--REPLACE K WITH K C 5--CONFLICT, K WITH K C 6--REPLACE K WITH NOT K C 7-- C ISETP = 0,1 C 8--REPLACE C 9--CONFLICT, NOT REPLACE C (INTERNAL) C 1 2 3 4 5 6 7 X C CHARACTER*8 CCALL(NSTA) CHARACTER*20 NAME(NSTA) C DIMENSION DATA(NSTA),XP(NSTA),YP(NSTA),LTAG(NSTA),LTAGPT(NSTA), 1 LNDSEA(NSTA) DIMENSION METAR(NSTA) C METAR( ) IS AN AUTOMATIC ARRAY. DIMENSION P(NX,NY),DIST(NX,NY) DIMENSION ICLXY(NX,NY) C ICLXY( , ) IS AN AUTOMATIC ARRAY. DIMENSION SEALND(NXE,NYE) DIMENSION KOUNT(9) C CALL TIMPR(KFILDO,KFILDO,'START SETPNT ') IER=0 C IF(ISETP.EQ.0)GO TO 200 C NORMALLY, SETPNT WILL NOT BE ENTERED WHEN ISETP = 0. THIS C IS A SAFETY CHECK. C IF(ISETP.EQ.1)THEN WRITE(KFILDO,101) 101 FORMAT(/' CLOSEST GRIDPOINT TO STATION NUDGED TOWARD STATION', 1 ' VALUE WHEN STATION IS NOT BOGUS OR AUGMENTED.') ELSEIF(ISETP.EQ.2)THEN WRITE(KFILDO,102) 102 FORMAT(/' CLOSEST GRIDPOINT TO STATION SET TO STATION VALUE', 1 ' WHEN STATION IS NOT BOGUS OR AUGMENTED.') ELSEIF(ISETP.EQ.3)THEN WRITE(KFILDO,1025) 1025 FORMAT(/' CLOSEST GRIDPOINT TO STATION SET TO STATION VALUE', 1 ' WHEN STATION IS NOT BOGUS OR AUGMENTED, WITH', 2 ' PREFERENCE TO METAR STATIONS.') ELSEIF(ISETP.EQ.4)THEN WRITE(KFILDO,1026) 1026 FORMAT(/' CLOSEST GRIDPOINT TO STATION SET TO STATION VALUE,', 1 ' BUT ONLY FOR METAR STATIONS.') ELSEIF(ISETP.EQ.5)THEN WRITE(KFILDO,1027) 1027 FORMAT(/' ALL 4 GRIDPOINTS SURROUNDING THE STATION ARE SET', 1 ' TO THE STATION VALUE. PREFERENCE IS GIVEN TO', 2 ' METAR STATIONS.') ELSE WRITE(KFILDO,103) 103 FORMAT(/' ISETP NOT 0, 1, 2, 3, 4, OR 5 IN SETPNT.', 1 ' ABORTED SETPNT.') IER=777 GO TO 200 ENDIF C C ASSURE MESH = MESHE. C IF(MESH.NE.MESHE)THEN WRITE(KFILDO,1035)MESHE,MESH 1035 FORMAT(/' ****MESHE IS NOT EQUAL TO MESH IN SETPNT.', 1 ' ABORTED SETPNT.') IER=777 GO TO 200 ENDIF C C INITIALIZE DIST( , ) WHICH IS A RECORD KEPT OF THE GRIDPOINTS C THAT HAVE BEEN MODIFIED AND THE DISTANCE FROM THE STATION C DONATING THE VALUE. ALSO, ICLXY( , ) KEEPS THE NUMBER OF C THE STATION. C DO 105 JY=1,NY DO 104 IX=1,NX DIST(IX,JY)=9999. ICLXY(IX,JY)=0 104 CONTINUE 105 CONTINUE C DO 106 J=1,9 KOUNT(J)=0 106 CONTINUE C C FILL METAR( ) TO INDICATE METAR STATIONS. C DO 107 K=1,NSTA IF((CCALL(K)(5:5).EQ.' ').AND. 1 (CCALL(K)(1:1).EQ.'K'.OR.CCALL(K)(1:1).EQ.'P'))THEN METAR(K)=1 ELSE METAR(K)=0 ENDIF C 107 CONTINUE C DO 120 K=1,NSTA C CCCC IF(CCALL(K).EQ.'KFHR ')THEN CCCC WRITE(KFILDO,108)CCALL(K),NAME(K),LTAG(K),LTAGPT(K),DATA(K) CCCC 108 FORMAT(/' STATION ',A8,2X,A20, CCCC 1 ' LTAG( ),LTAGPT( ),DATA( ) =',2I4,F10.3) CCCC ENDIF C C ************************************************* C C THIS BRANCH FOR ISETP = 5. C C ************************************************** C IF(ISETP.EQ.5)THEN IF((LTAG(K).EQ.0.AND.LTAGPT(K).EQ.0))THEN C PLACE ONLY IF THE STATION WAS NOT TOSSED AND IS NOT C BOGUS OR AUGMENTED. C DO 1085 IXX=0,1 DO 1084 JYY=0,1 IX=XP(K)+IXX JY=YP(K)+JYY C IF(IX.GE.1.AND.IX.LE.NX.AND.JY.GE.1.AND.JY.LE.NY)THEN C THE POINT IS WITHIN THE GRID. C C IT IS NOT REQUIRED THAT THE STATION TYPE (OCEAN C OR LAND) MATCH THE GRIDPONT TYPE. USERS WILL C NOT MAKE THAT DISTINCTION. C IF(METAR(K).EQ.1)THEN P(IX,JY)=DATA(K) C PREFERENCE IS GIVEN TO METAR STATION. IF C CONFLICT OCCURS, THE LAST IS USED. ICLXY(IX,JY)=K ELSEIF(ICLXY(IX,JY).EQ.0)THEN C NO CONFLICT, SO INSERT. P(IX,JY)=DATA(K) ICLXY(IX,JY)=K ENDIF C ENDIF C 1084 CONTINUE 1085 CONTINUE C ENDIF C GO TO 120 C DONE WITH THIS STATION. C ENDIF C IF(ISETP.EQ.4.AND.METAR(K).EQ.0)GO TO 120 C WHEN ISETP = 4, ONLY METER STATIONS ARE SET INTO GRID. C IF((LTAG(K).EQ.0.AND.LTAGPT(K).EQ.0))THEN C THIS IS A DATA POINT TO USE. IT WASN'T TOSSED AND IT C IS NOT AUGMENTED OR BOGUS. NOTE THAT LTAGPT( ) IS REALLY C MTAGPT( ) AND CORRECTLY DISTINGUISHES AUGMENTED FROM C NON-AUGMENTED. C C FIND THE CLOSEST STATION. C DX=999999. IX=XP(K) JY=YP(K) C IX,JY IS THE LL CORNER OF THE BOX BOUNDING DATA( ). C LOOK AT ALL FOUR CORNERS AROUND DATA( ). C DO 110 I=IX,IX+1 IF(I.LT.1.OR.I.GT.NX)GO TO 110 C THE DATA POINT IS NOT WITHIN THE GRID. C DO 109 J=JY,JY+1 IF(J.LT.1.OR.J.GT.NY)GO TO 109 C THE DATA POINT IS NOT WITHIN THE GRID. C IF(P(I,J).LT.9998.5)THEN CCCC IF((LNDSEA(K).EQ.NINT(SEALND(I,J)).OR. CCCC 1 (LNDSEA(K).EQ.6.AND.(NINT(SEALND(I,J)).EQ.3).OR. CCCC 2 (NINT(SEALND(I,J)).EQ.9)))THEN C IF((LNDSEA(K).EQ.9.AND.NINT(SEALND(I,J)).EQ.9).OR. 1 (LNDSEA(K).EQ.0.AND.NINT(SEALND(I,J)).EQ.0).OR. 2 (LNDSEA(K).EQ.3.AND.NINT(SEALND(I,J)).EQ.3).OR. 3 (LNDSEA(K).EQ.6.AND.NINT(SEALND(I,J)).EQ.3).OR. 4 (LNDSEA(K).EQ.6.AND.NINT(SEALND(I,J)).EQ.9))THEN C THE TYPE OF STATION AND GRIDPOINT ARE THE SAME. D=(XP(K)-I)**2+(YP(K)-J)**2 C IF(D.LT.DX)THEN DX=D IXX=I JYY=J ENDIF C ENDIF C ENDIF C 109 CONTINUE C 110 CONTINUE C IF(DX.EQ.999999.)THEN WRITE(KFILDO,111)CCALL(K),LNDSEA(K),XP(K),YP(K) 111 FORMAT(' STATION ',2X,A8,' OF TYPE',I4, 1 ' HAS NO CLOSE GRIDPOINT OF CORRECT TYPE.', 2 ' XP(K) AND YP(K) ARE:',2F8.2) GO TO 120 ENDIF C IF(ISETP.EQ.3)THEN C C ************************************************* C C THIS BRANCH FOR ISETP = 3. C C ************************************************** C IF(METAR(K).EQ.1)THEN C THIS IS A METAR STATION. C IF(ICLXY(IXX,JYY).EQ.0)THEN C THERE IS NO PREVIOUS STATION. REPLACE C DIST(IXX,JYY)=DX ICLXY(IXX,JYY)=K KOUNT(1)=KOUNT(1)+1 P(IXX,JYY)=DATA(K) C ELSEIF(METAR(ICLXY(IXX,JYY)).EQ.1)THEN C IF(DX.LT.DIST(IXX,JYY))THEN WRITE(KFILDO,112)CCALL(K),CCALL(ICLXY(IXX,JYY)), 1 IXX,JYY 112 FORMAT(' STATION ',A8,' REPLACING STATION ',A8, 1 ' AT GRIDPOINT',2I6) C DIST(IXX,JYY)=DX ICLXY(IXX,JYY)=K KOUNT(4)=KOUNT(4)+1 P(IXX,JYY)=DATA(K) ELSE WRITE(KFILDO,1120)CCALL(K),CCALL(ICLXY(IXX,JYY)), 1 IXX,JYY 1120 FORMAT(' STATION ',A8,' NOT REPLACING STATION ',A8, 1 ' AT GRIDPOINT',2I6) KOUNT(5)=KOUNT(5)+1 ENDIF C ELSE DIST(IXX,JYY)=DX ICLXY(IXX,JYY)=K KOUNT(6)=KOUNT(6)+1 P(IXX,JYY)=DATA(K) ENDIF C ELSEIF(ICLXY(IXX,JYY).EQ.0)THEN DIST(IXX,JYY)=DX ICLXY(IXX,JYY)=K KOUNT(1)=KOUNT(1)+1 P(IXX,JYY)=DATA(K) C ELSEIF(METAR(ICLXY(IXX,JYY)).EQ.0)THEN C THIS IS NOT A METAR STATION. C IF(DX.LT.DIST(IXX,JYY))THEN DIST(IXX,JYY)=DX ICLXY(IXX,JYY)=K KOUNT(3)=KOUNT(3)+1 P(IXX,JYY)=DATA(K) ELSE KOUNT(2)=KOUNT(2)+1 ENDIF C ELSE KOUNT(7)=KOUNT(7)+1 ENDIF C ELSEIF(ICLXY(IXX,JYY).EQ.0)THEN C THIS IS THE FIRST PLACEMENT. DIST(IXX,JYY)=DX ICLXY(IXX,JYY)=K KOUNT(1)=KOUNT(1)+1 P(IXX,JYY)=DATA(K) C ELSE C C ************************************************* C C BRANCHES BELOW FOR ISETP = 1, 2 OR 4. C C ************************************************** C IF(DX.LT.DIST(IXX,JYY))THEN C REPLACE WHEN DISTANCE TO THIS STATION LESS C THAN PREVIOUS. WRITE(KFILDO,113)CCALL(K),CCALL(ICLXY(IXX,JYY)), 1 IXX,JYY 113 FORMAT(' STATION ',A8,' REPLACING STATION ',A8, 1 ' AT GRIDPOINT',2I6) DIST(IXX,JYY)=DX ICLXY(IXX,JYY)=K KOUNT(8)=KOUNT(8)+1 C IF(ISETP.EQ.1)THEN C IF(P(IXX,JYY).LT.DATA(K))THEN P(IXX,JYY)=MIN(INT(P(IXX,JYY)+.999)-.05,DATA(K)) C THIS IS FOR WHEN GRIDPOINT LT DATA POINT ELSE P(IXX,JYY)=MAX(INT(P(IXX,JYY))+.05,DATA(K)) C THIS IS FOR WHEN GRIDPOINT GE DATA POINT ENDIF C ELSE P(IXX,JYY)=DATA(K) C THIS IS FOR ISETP = 2. ENDIF C ELSE C DISTANCE TO THIS STATION FARTHER THAN PREVIOUS, C SO DO NOT REPLACE. WRITE(KFILDO,1130)CCALL(K),CCALL(ICLXY(IXX,JYY)), 1 IXX,JYY 1130 FORMAT(' STATION ',A8,' NOT REPLACING STATION ',A8, 1 ' AT GRIDPOINT',2I6) KOUNT(9)=KOUNT(9)+1 ENDIF C ENDIF C ELSE C IF(LTAG(K).EQ.-1)THEN C C THIS STATION WAS TOSSED ON THE LAST PASS. WRITE(KFILDO,118)CCALL(K),NAME(K) 118 FORMAT(' STATION ',A8,2X,A20,' TOSSED ON LAST', 1 ' PASS AND NOT SET INTO GRID.') C ELSEIF(LTAGPT(K).GT.0)THEN C THIS IS AN AUGMENTED STATION. D WRITE(KFILDO,119)CCALL(K),NAME(K),LTAGPT(K) 119 FORMAT(' STATION ',A8,2X,A20,' IS EITHER BOGUS', 1 ' OR AUGMENTED AND NOT SET INTO GRID.', 2 ' LTAGPT(K) =',I3) ENDIF C ENDIF C 120 CONTINUE C IF(ISETP.EQ.3)THEN WRITE(KFILDO,130)KOUNT(1),KOUNT(4),KOUNT(6),KOUNT(5), 1 KOUNT(3),KOUNT(7),KOUNT(2) 130 FORMAT(/' FIRST TIME PLACES = ',I7/ ! 1 1 ' METAR REPLACED METAR = ',I7/ ! 4 2 ' METAR REPLACED NOT METAR = ',I7/ ! 6 3 ' METAR DID NOT REPLACE METAR = ',I7/ ! 5 4 ' NOT METAR REPLACED NOT METAR = ',I7/ ! 3 5 ' NOT METAR DID NOT REPLACE METAR = ',I7/ ! 7 6 ' NOT METER DID NOT REPLACE NOT METAR =',I7) ! 2 ELSEIF(ISETP.NE.5)THEN WRITE(KFILDO,131)KOUNT(1),KOUNT(8),KOUNT(9) 131 FORMAT(/' FIRST TIME PLACES = ',I7/ 1 ' REPLACES = ',I7/ 2 ' CONFLICTS, NOT REPLACED = ',I7) ENDIF C C***************************************************************** CCCC DO 399 K=1,NSTA C CCCC IF(CCALL(K).EQ.'LOPW1 ')THEN CCCC WRITE(KFILDO,398)K,CCALL(K),DATA(K),P(1612,183),P(1612,184), CCCC 1 P(1613,183),P(1613,184), CCCC 2 ICLXY(1612,183),ICLXY(1612,184), CCCC 3 ICLXY(1613,183),ICLXY(1613,184) CCCC 398 FORMAT(/' AT 398 IN SETPNT--K,CCALL(K,1),DATA(K),P(1612,183),', CCCC 1 'P(1612,184),P(1613,183),P(1613,184)', CCCC 2 'ICLXY(1612,183),ICLXY(1612,184),', CCCC 3 'ICLXY(1613,183),ICLXY(1613,184)',/, CCCC 4 I8,2X,A8,5F10.3,4I6) CCCC ENDIF C CCCC 399 CONTINUE C***************************************************************** C 200 CONTINUE C CALL TIMPR(KFILDO,KFILDO,'END SETPNT ') RETURN END