SUBROUTINE ESP5(KFILDO,IP14,IP17,IP21,JDATE,IVRBL,CCALL,NAME,DATA, 1 XP,YP,TOSS,QUEST,LTAG,QUALST,LTAGPT,U,V, 2 LNDSEA,XLAPSE,ELEV,NSTA, 3 P,NX,NY,LP,NPASS,ER1T,ER1QT,ERRADJ,GF,MESH,MESHB, 4 TITLE,JFIRST,SEALND,TELEV,NXE,NYE,MESHE, 5 RMAX,NOTOSS,N4P,IBKPN,IZCHK,WFACT, 6 ISTOP,I405ADG) C C JUNE 1993 CHAMBERS, GLAHN TDL HP9000 C JULY 2000 GLAHN MODIFIED FOR LAMP-2000 C JUNE 2004 GLAHN MODIFIED FOR MOS-2000 C SAME AS ESP EXCEPT FOR NAME C OCTOBER 2004 GLAHN PUT SPACE IN FORMAT 1835 C JANUARY 2005 GLAHN SUBSTITUTED ITRPSL FOR ITRP; ADDED C LNDSEA, SEALND( ), NXE, NYE, MESHE C TO CALL C FEBRUARY 2005 GLAHN UPDATED IVRBL RELATED COMMENTS C FEBRUARY 2005 GLAHN MADE WRITE OF F OPTIONAL AT 100 C MARCH 2005 GLAHN CHANGED RAD FROM 3 TO 5 GRID UNITS C JULY 2005 GLAHN ADDED ITRP BEFORE TOSSING DATA C JULY 2005 GLAHN ADDED XLAPSE( ) AND ELEV( ) FOR C ANOTHER BUDDY CHECK C JULY 2005 GLAHN ADDED IP17, NAME( ), AND NPASS TO CALL C JULY 2005 GLAHN ADDED NOTOSS TO CALL C AUGUST 2005 GLAHN CORRECTED COUNT OF NOTOSS C AUGUST 2005 GLAHN CHANGED ER1 TO FER1 IN BUDDY LAPSE C RATE CHECK C AUGUST 2005 GLAHN TOOK ISKIP OUT OF DATA STATEMENT; C INSERTED BLANK PRINTS C AUGUST 2005 GLAHN MODIFIED USE OF LNDSEA( ) C SEPTEMBER 2005 GLAHN CHANGED I400ADG TO I405ADG C MARCH 2006 GLAHN SET LTAG( ) = 1 WHEN ITRPSL GIVES C IER NE 0 AT 150 C MARCH 2006 GLAHN ADDED IP14 AND ISTOP( ) TO CALL AND C TO CALLS TO ITRPSL; ADDED N4P C JANUARY 2007 GLAHN ADDED WRITING NAME FOR TOSSED STATION C FEBRUARY 2007 GLAHN ADDED IBKPN TO CALL; MODIFICATION TO C NOT USE XLAPSE( ) WHEN IBKPN = 99; C ADDED DBBSAV C MARCH 2007 GLAHN CHANGED RAD FROM 5* TO 15.*MESHB/MESH C MARCH 2007 GLAHN DIAGNOSTIC INSERTED FOR 2ND STATION C MAY 2007 GLAHN ADDED MORE DIAGNOSTICS UNDER CONTROL C OF I405ADG C DECEMBER 2007 GLAHN ADDED ISTOP(6) CAPABILITY C JULY 2008 GLAHN CHANGED -1 TO + 1 AT 149 C MARCH 2009 GLAHN MODIFIED TO KEEP 2ND NEIGHBOR'S C ERROR TO LE 1.5*ERI TO USE IT C MAY 2009 GLAHN REMOVED CHECK ON I405ADG FOR PRINTING C "NOT ACCEPTED" C MAY 2009 GLAHN CHANGED I5 TO F7.0 IN FORMAT 200 C JUNE 2009 GLAHN ADDED OLITOS( ) CAPABILITY C SEPTEMBER 2009 GLAHN ADDED LNDSEA( ) TO IP17 PRINT C JUNE 2010 GLAHN ADJUSTED RES TO ACCOUNT FOR MESH; C SPELLING C JUNE 2010 GLAHN THE ADJUSTMENT WAS TO RAD, NOT RES C AUGUST 2011 GLAHN DIMENSIONED NOTOSS( ) AND COUNTED C NOTOSS(2); ADDED LTAGPT( ) C OCTOBER 2011 GLAHN SLIGHT CHANGE TO 1ST BUDDY CHECK C NEAR 163; NUMBERED STATEMENT 1629 C DECEMBER 2011 GLAHN CHANGE TO PRINT TO 1520 IN 2 PLACES; C CHANGED I4 TO I5 FOR K IN 210 C DECEMBER 2011 GLAHN ADDED ERRADJ IN CALL AND IMPLEMENTED C SEPTEMBER 2013 GLAHN MADE FORMAT 151 /D FOR "QUESTIONABLE" C OCTOBER 2013 GLAHN MODIFIED TO CALL CLOSLW VICE CLOS AND C LISTLW VICE LIST C MARCH 2014 GLAHN ADDED TELEV( , ) TO CALL AND ADDED C TEST WITH XLAPSE C APRIL 2014 GLAHN ADDED GF C MAY 2015 GLAHN ADDED QUALST( ) C DECEMBER 2015 GLAHN ADDED WFACT C JANUARY 2015 GLAHN CHANGED WHERE ER1XX AND FER1X DEFINED; C CHANGED ER1X TO ER1XX AS NEEDED C APRIL 2019 GLAHN CORRECTED COMMENT ABOUT N4P C C PURPOSE C TO CHECK FOR ERRORS IN DATA FOR BCD ANALYSIS. A CHECK C IS MADE AGAINST THE CURRENT ANALYSIS ACCORDING TO ERROR C CRITERION IN ER1, WHICH PERTAINS TO THIS PASS. WHENEVER C A STATION DOES NOT MEET THE ERROR CRITERION BUT DOES MEET C 1.5 TIMES THE ERROR CRITERION, A CHECK IS MADE C OF ITS TWO CLOSEST NEIGHBORS. IF EITHER OF ITS TWO C NEIGHBORS ALSO DISAGREES WITH THE ANALYSIS BY GREATER THAN C THE ERROR CRITERION * F (FER1) IN THE SAME DIRECTION, THE C STATION IS KEPT. ALSO, THE NEIGHBOR IS KEPT IF IT MEETS C 1.5 TIMES THE ERROR CRITERION. F IS A FACTOR SET BY DATA C STATEMENT IN U405A, CURRENTLY 0.6. IF THE INITIAL C INTERPOLATION ITRPSL DOES NOT GET A VALUE THAT C SUBSTANTIATES THE STATION, ITRP IS TRIED. THIS IS C NECESSARY FOR COASTAL STATIONS WHERE ITRPSL MAY RETURN C A VALUE FROM THE NEAREST GRIDPOINT WHICH MAY MATCH C THE ANALYSIS WELL INLAND, BUT NOT BE REPRESENTATIVE C OF THE FIT AT THE COASTAL STATION. FINALLY, IF THIS C DOES NOT SUBSTANTIATE THE STATION, EACH OF THE TWO C NEIGHBOR'S VALUES ARE RUN UP OR DOWN TO THE STATION C BEING CHECKED WITH THEIR AVERAGE LAPSE RATES, AND C IF THE AGREEMENT OF THAT CALCULATION WITH THE STATION C BEING CHECKED IS WITHIN FER1, THEN THE STATION IS KEPT. C C LTAG( ) IS SET = +1 WHEN STATION IS OUTSIDE C GRID AREA BY AS MUCH OR MORE THAN RMAX FOR THAT PASS. C THIS WAS CHANGED FROM -1 ON 7/24/08 TO DISTINGUISH IT C FROM TOSSED DATA. THERE IS NO PROBLEM AS LONG AS C THE RADII DO NOT INCREASE BY PASS. IN ANY CASE, THIS C ONLY AFFECTS DATA FAR OUTSIDE THE GRID. C C FOR SEA LEVEL PRESSURE, AS AN ADDED CHECK, BEFORE A C STATION IS TOSSED, AN ESTIMATE OF ITS PRESSURE IS MADE C FROM ITS TWO CLOSEST NEIGHBORS BY USING THE NEIGHBOR'S C PRESSURE AND WIND. IF THE ESTIMATE IS WITHIN ER1, THE C STATION IS KEPT. THIS DOES NOT AFFECT THE KEEPING OF C A NEIGHBOR. ESP5 DEPENDS ON IVRBL BEING 1 FOR SEA LEVEL C PRESSURE AND 4 FOR SATURATION. OTHER NUMBERS ARE C FLEXIBLY USED. C C THE ERROR CHECKING CRITERION READ FROM THE U405A.CN C FILE PASSED TO ESP5 IS MODIFIED BY THE TYPE OF STATION C BEING DEALT WITH IN THE DO 190 LOOP. THIS WAS ADDED C BECAUSE OF THE VARIABILITY OF OBSERVATIONS OVER THE GREAT C LAKES AND BUOYS NOT BEING THERE IN WINTER. SEE OLITOS( ) C DEFINITION. THE ER1 VALUE IS LEFT INTACT AND USED FOR C SEA LEVEL PRESSURE. OTHERWISE, ER1X, AS MODIFIED C FROM ER1 AND OLITOS(LNDSEA(K)+1) IS USED. THE VALUE C ERQ1 FOR "QUESTIONABLE" IS LEFT UNMODIFIED. C C THE OCTOBER 2013 MOD USES LNDSEA IN CLOSLW AND LISTLW C TO TREAT SAME DATA TYPES TOGETHER. TYPES 0, 3, AND 9 C ARE PAIRED WITH 0, 3, AND 9, RESPECTIVELY. TYPE 6 IS C CONSIDERED WITH EITHER 3 OR 6. TYPE 6 IS USUALLY MORE C LIKE LAND THAN WATER, BUT IT CAN DO MORE DAMAGE TO C LAKE THAN LAND. C C THE MAY 19,2015 MOD INCLUDES A MOD TO CLOSLW THAT C RETURNS A NEIGHBOR OF A STATION WITH FULL WEIGHT ONLY C IF IT ALSO HAS FULL WEIGHT. THIS WAY, A METAR WIND C STATION IS ONLY CHECKED WITH A METAR STATION, BUT A C MESONET STATION IS CHECKED AGAINST EITHER ANOTHER C MESONET OR A METAR. C C THIS SERIES OF PROGRAMS, INCLUDING ESP5, HAS NOT BEEN C CHECKED OUT FOR SLP. C C DATA SET USE C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C IP14 - UNIT NUMBER FOR LISTING COMPUTED LAPSE C RATES AND PROBLEMS WITH LAPSE RATES. (OUTPUT) C IP17 - UNIT NUMBER FOR LISTING OF STATIONS, THEIR C X/Y POSITIONS, THEIR DATA VALUES, AND LTAGS. C (OUTPUT) C IP21 - UNIT NUMBER FOR LISTING THE AVERAGE DEGREE C OF FIT BETWEEN THE UNSMOOTHED AND SMOOTHED, C IF SMOOTHED, ANALYSIS AND THE DATA. C ALSO USED IN ESP5 TO LIST STATIONS TOSSED ON C LAST PASS. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. C DIAGNOSTICS. (INPUT) C IP14 = UNIT NUMBER FOR LISTING COMPUTED LAPSE C RATES AND PROBLEMS WITH LAPSE RATES. (INPUT) C IP17 = UNIT NUMBER FOR LISTING OF STATIONS, THEIR C X/Y POSITIONS,THEIR DATA VALUES, AND LTAGS. C (INPUT) C IP21 = UNIT NUMBER FOR LISTING THE AVERAGE DEGREE C OF FIT BETWEEN THE UNSMOOTHED AND SMOOTHED, C IF SMOOTHED, ANALYSIS AND THE DATA. C ALSO USED IN ESP5 TO LIST STATIONS TOSSED ON C LAST PASS. (INPUT) C JDATE(J) = NDATE PARSED INTO ITS 4 COMPONENTS: C J=1 IS YYYY C J=2 IS MM C J=3 IS DD C J=4 IS HH C (INPUT) C IVRBL = 1 = VARIABLE IS SLP. C 2 = FLEXIBLE. C 3 = FLEXIBLE. C 4 = SATURATION DEFICIT. C OTHERS - FLEXIBLE. C SEE ITABLE( , , ) IN U405A FOR OTHER VALUES. C NOTE: BCD5 AND CALLED ESP5 DEPEND ON IVRBL C BEING 1 AND 4 FOR SEA LEVEL PRESSURE AND C SATURATION DEFICIT, RESPECTIVELY. (INPUT) C CCALL(J) = STATION CALL LETTERS (J=1,NSTA). (CHARACTER*8) C (INPUT) C NAME(K) = NAMES OF STATIONS (K=1,NSTA). (CHARACTER*20) C (INPUT) C DATA(J) = DATA BEING ANALYZED (J=1,NSTA). (INPUT) C XP(J) = HORIZONTAL GRID POSITION OF STATION J C (J=1,NSTA). (INPUT) C YP(J) = VERTICAL GRID POSITION OF STATION J C (J=1,NSTA). (INPUT) C TOSS(K) = CONTAINS TOSSED OBS (K=1,NSTA). ALL OTHER C VALUES = 9999. THIS IS BASED ON ER1 TOGETHER C WITH THE BUDDY CHECK. (OUTPUT) C QUEST(K) = CONTAINS QUESTIONABLE OBS (K=1,NSTA). ALL C OTHER VALUES = 9999. QUESTIONABLE IS DEFINED C AS MEETING THE ERROR CRITERION, BUT NOT C MEETING ER1Q. (OUTPUT) 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. FLTAG SETS C A VALUE +2 WHEN THE STATION LOCATION C IS MISSING. C +1 = PERMANENTLY DISCARDED FOR THE VARIABLE C BEING ANALYZED. INCLUDES DATA FAR C OUTSIDE THE GRID, AS DEFINED BY RMAX C 0 = USE ON CURRENT PASS THROUGH DATA. 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/OUTPUT) C QUALST(K) = THE QUALITY WEIGHTS TO APPLY FOR THIS VARIABLE C (K=1,KSTA). (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 NOTE THAT FOR TOTAL WIND, LTAGPT( ) IS REALLY C MTAGPT( ) INCOMING IN ORDER TO IDENTIFY BASE C STATIONS. C FOR TOTAL WIND, THIS IS ACTUALLY MTAGPT( ) C IN THE CALLING PROGRAM AND PERTAINS TO C WIND SPEED. C (INPUT) C U(K) = THE FACTOR TO USE IN CONVERTING U-WINDS C TO CHANGE IN MB PER MESH LENGTH (K=1,NSTA) C BUT ONLY WHEN ANALYZING SLP. U(K) HAS C BEEN SET TO 9999 FOR OBS TOSSED BY U400B AS C WELL AS WIND SPEEDS LT WNDTHR. (INPUT) C V(K) = SAME AS U(K) EXCEPT FOR V-WINDS. (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 XLAPSE(K) = CALCULATED LAPSE RATE IN UNITS OF THE VARIABLE C BEING ANALYZED PER M. (K=1,KSTA). (INPUT) C ELEV(K) = ELEVATION OF STATIONS IN METERS (K=1,NSTA). C (INPUT) C NSTA = NUMBER OF STATIONS FOR WHICH DATA ARE AVAILABLE. C (INPUT) C P(IX,JY) = FIELD HOLDING FIRST GUESS AND ANALYSIS C (IX=1,NY) (JY=1,NY). (INPUT) C NX,NY = FIRST AND SECOND DIMENSIONS, RESPECTIVELY, C OF P( , ). (INPUT) C LP = PASS NUMBER. (INPUT) C NPASS = TOTAL NUMBER OF PASSES TO BE MADE. (INPUT) C ER1T = TEMPORARY ERROR CRITERIA FOR THIS PASS. C IF OBSERVATION IS DIFFERENT FROM CURRENT C ANALYSIS BY MORE THAN ER1T, IT IS NOT C USED ON THIS PASS UNLESS THE BUDDY CHECK C INDICATES TO KEEP IT. IF ER1T = 0, THIS ROUTINE C IS NOT CALLED ON THIS PASS. (SEE TOSS( )). C IS ADJUSTED WITH ERRADJ. (INPUT) C ER1QT = TEMPORARY ERROR CRITERIA FOR DEDUCING A C QUESTIONABLE OB. (SEE QUEST( )). IS C ADJUSTED WITH ERRADJ. (INPUT) C ERRADJ = THROWOUT ADJUSTMENT. NORMALLY = 1. FOR AUGMTX, C CAN BE USED TO ADJUST TRHOWOUT BASED ON TYPE OF C DATA (OCEAN, LAKE, LAKE/LAND, OR LAND). HAS C BEEN IMPLEMENTED FOR AUGMT2 = PREX4( ). (INPUT) C GF = MULTIPLICATIVE FACTOR TO INCREASE IR1X WHEN C THE ERROR IS POSITIVE. ADDED FOR GUSTS SO C THAT GUSTS CAN BE KEPT WITHOUT KEEPING ALL C VERY SMALL VALUES. WAS EXTENDED TO APPLY ALSO C TO WIND SPEED. GF IS SET IN BCD5; IT IS C SET = 1 WHEN WIND IS NOT INVOLVED. (INPUT) C MESH = THE NOMINAL MESH LENGTH OF THE CURRENT GRID. C (INPUT) C MESHB = THE NOMINAL MESH LENGTH OF THE ANALYSIS GRID. C NXL, NYL, ETC. ARE IN RELATION TO THIS. (INPUT) C TITLE = 40-CHARACTER TITLE FOR VARIABLE. (CHARACTER*40) C (INPUT) C JFIRST = USED TO CONTROL PRINTING. THIS IS SPECIFIC TO C THE VARIABLE BEING ANALYZED. (INPUT/OUTPUT) C SEALND(J) = THE LAND/SEA MASK (J=1,NXE*NYE). C 0 = OCEAN WATER GRIDPOINTS; C 3 = INLAND WATER GRIDPOINTS. C 9 = LAND GRIDPOINTS. C (INPUT) C TELEV(J) = THE TERRAIN ELEVATION FROM THE MOS-2000 EXTERNAL C RANDOM ACCESS FILE (J=1,NXE*NYE). (INPUT) C NXE = X-EXTENT OF AND SEALND( ) AT MESH LENGTH MESHE. C (INPUT) C NYE = Y-EXTENT OF AND SEALND( ) AT MESH LENGTH MESHE. C (INPUT) C MESHE = THE NOMINAL MESH LENGTH OF THE TERRAIN GRID. C IT IS MANDATORY THE GRID AVAILABLE IS OF THIS C MESH SIZE AND COVER THE SAME AREA SPECIFIED C BY NXL BY NYL, EVEN IF MESHE IS NOT EQUAL C TO MESHB. (INPUT) C RMAX = R*RSTAR FOR THIS PASS. THIS DETERMINES C HOW FAR OUTSIDE GRID TO USE DATA FOR THIS C PASS. NOTE THAT THIS IS IN TERMS OF C THE CONSTANT GRIDLENGTH FOR THIS PASS IN THE C .CN FILE. MORE STATIONS CAN GET TOSSED AS C THE PASSES PROCEED. (INPUT) C NOTOSS(J) = RUNNING COUNT OF TOTAL STATIONS TOSSED ON C LAST PASS (J=1) AND OF BASE STATIONS (J=2). C (INPUT/OUTPUT) C N4P = 4 INDICATES THE SURROUNDING 4 POINTS WILL BE C CHECKED WHEN TRYING TO FIND A GRIDPOINT OF C THE SAME TYPE AS THE DATUM AND INTERPOLATION C CAN'T BE DONE. CURRENTLY, THIS IS ALWAYS C DONE (DOES NOT REQUIRE N4P=4). C 12 SAME AS ABOVE, EXCEPT 12 ADDITIONAL POINTS C WILL BE CHECKED WHEN NONE OF THE 4 POINTS C ARE OF THE CORRECT TYPE. C N4P IS OPERATIVE ONLY WHEN THE SURROUNDING C 4 POINTS ARE OF MIXED TYPE. (INPUT) C IBKPN = FLAG TO INDICATE WHETHER TO APPLY BK( , ) TO C POSITIVE OR NEGATIVE LAPSE RATES: C 0 = DON'T OPERATE BK( , ) (ALL LAPSES USED), C +1 = APPLY TO POSITIVE LAPSES (POSITIVE IS ODD C FOR TEMPERATURE), AND C -1 = APPLY TO NEGATIVE LAPSES (NEGATIVE IS ODD C FOR SNOW). C 99 = DON'T COMPUTE OR USE LAPSE RATES. C (LAPSE RATES WILL ALSO NOT BE USED WHEN KFILLP C IS NOT PROVIDED AND WHEN ELCORR( ) FOR ALL C PASSES = 0.) C (INPUT) C IZCHK = ZERO EXCEPT EQ 1 FOR WIND SPEED AND TOTAL WIND. C WHEN ER1 IS NOT MET, IZCHK = 1, AND THE DATA C VALUE = 0, IT IS TOSSED (NEIGHBORS ARE NOT C CHECKED). (INPUT) C WFACT = FACTOR TO REDUCE THE THRESHOLD FOR VALUES C BELOW THE CURRENT ANALYSIS FOR MESONET SITES. C PUT IN FOR MOS WIND SPEED THAT IS C CHARACTERISTICALLY LOW. THE MESONET SITES C MUST BE DISTINGUISHED BY QUALST(K) LT 1. WHEN C QUALST( ) = 1 OR WFACT = 1, THIS FEATURE IS C NOT OPERATIVE. (INPUT) C ISTOP(J) = ISTOP(1)--IS INCREMENTED BY 1 EACH TIME AN ERROR C OCCURS. C ISTOP(2)--IS INCREMENTED WHEN THERE ARE C FEW DATA (200) FOR AN ANALYSIS. C ISTOP(3)--IS INCREMENTED WHEN A DATA RECORD C COULD NOT BE FOUND. C ISTOP(4)--IS INCREMENTED WHEN A LAPSE RATE COULD C NOT BE COMPUTED OR HAS TOO FEW CASES C TO BE USED. C ISTOP(5)--IS INCREMENTED WHEN NO NON-MISSING C GRIDPOINT AROUND THE DATA POINT IS C OF THE SAME TYPE. C ISTOP(6)--IS INCREMENTED WHEN THERE IS A PROBLEM C WITH MAKING BOGUS STATIONS. C (INPUT/OUTPUT) C I405ADG = 1 = DIAGNOSTIC PRINT TO KFILDO; C 0 OTHERWISE. (INPUT) C ONEMR = 1. - RMAX. (INTERNAL) C RPNX = RMAX + NX. (INTERNAL) C RPNY = RMAX + NY. (INTERNAL) C LS1, LS2 = INDEX IN DATA( ) OF NEAREST AND NEXT NEAREST C NEIGHBOR, RESPECTIVELY. NEIGHBORING STATIONS C CAN BE THOSE WITH LTAG( ) LE 0 ONLY. (INTERNAL) C BB = INTERPOLATED VALUE FOR STATION K. (INTERNAL) C BB1 = INTERPOLATED VALUE FOR STATION LS1. (INTERNAL) C BB2 = INTERPOLATED VALUE FOR STATION LS2. (INTERNAL) C F = FACTOR TO MULTIPLY ER1 BY BEFORE CHECKING NEAREST C NEIGHBOR ACCORDING TO IVRBL. SET TO .6 IN C DATA STATEMENT. (INTERNAL) C FER1 = THE THRESHOLD DIFFERENCE BETWEEN THE ANALYSIS C AND THE OBSERVATION TO USE WHEN CHECKING THE C NEIGHBORING STATION. FER1 = F*ER1X. ER1 IS C ALSO USED IN THE LAPSE RATE CHECK WITH C NEIGHBORING STATIONS. (INTERNAL) C FER1X = FER1 POSSIBLY ADJUSTED BY WFACT. WFACT IS C EITHER 1. OR POSSIBLY < 1. FOR WIND SPEED. C (INTERNAL) C ER1X = ER1T ADJUSTED BY TYPE OF STATION IN OLITOS( ). C 1.0 FOR OCEAN AND LAND, C 1.5 FOR LAKE AND MIX LAKE/LAND. C OR, IT IS ADJUSTED BY ERRADJ, NOT BOTH. C (INTERNAL) C ER1XX = ER1X POSSIBLY ADJUSTED BY WFACT. (INTERNAL) C IFIRST = CONTROLS PRINT SPACING. (INTERNAL) C RAD = THE PLUS AND MINUS GRID UNITS FOR LISTING C STATIONS IN SUBROUTINE LIST. IT DEPENDS C ON THE MESH LENGTH MESH. (INTERNAL) C ISKIP = CONTROLS BLANK LINE BEFORE "QUESTIONABLE" OB C DIAGNOSTIC. (INTERNAL) C OLITOS(J) = THE FACTORS BY WHICH THE ER1 ERROR CRITERION C IS MODIFIED BY TYPE OF DATUM (J=1,10). C THE 10 VALUES IN OLITOS( ) CORRESPOND TO VALUES C IN LNDSEA( ) THUSLY: C OLITOS( ) 1 2 3 4 5 6 7 8 9 10 C LNDSEA( ) 0 3 6 9 C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES CALLED C ITRPSL, ITRP, CLOS, TIMPR, ESLP5 C CHARACTER*8 CCALL(NSTA) CHARACTER*20 NAME(NSTA) CHARACTER*40 TITLE C DIMENSION DATA(NSTA),XP(NSTA),YP(NSTA),LTAG(NSTA),LTAGPT(NSTA), 1 TOSS(NSTA),QUEST(NSTA),U(NSTA),V(NSTA),LNDSEA(NSTA), 2 XLAPSE(NSTA),ELEV(NSTA),QUALST(NSTA) DIMENSION TELEV(NXE*NYE),SEALND(NXE*NYE) DIMENSION P(NX,NY) DIMENSION JDATE(4),ISTOP(6),NOTOSS(2) DIMENSION OLITOS(10) C DATA F/.6/ DATA OLITOS/1.,0.,0.,1.5,0.,0.,1.5,0.,0.,1./ C THE VALUES IN OLITOS CAN BE ADJUSTED AS NEEDED. THE LAST C VALUE PERTAINING TO LAND SHOULD BE LEFT INTACT AS 1.0. C CALL TIMPR(KFILDO,KFILDO,'START ESP5 ') JFIRST=JFIRST+1 C C**************************************************** CCCC DO 9999 K=1,NSTA CCCC IF(CCALL(K).EQ.'AP899 ')THEN CCCC DATA(K)=9999. CCCC ENDIF CCCC 9999 CONTINUE C**************************************************** ISKIP=1 C IF(JFIRST.NE.1)THEN JFIRST=2 ENDIF C RAD=15.*(MESHB/MESH) IF(MESH.EQ.3)RAD=RAD*2. C THIS GIVES A RADIUS OF 15 FOR 5 KM AND A RADIUS OF 30 C FOR 2.5 KM. THIS WAS SET FOR 15 WHEN 5 KM WAS BEING USED. C AS OF 11/1/13, LISTLW INCREASES THIS FOR WATER. C D IF(JFIRST.EQ.1)THEN D WRITE(KFILDO,100)F D100 FORMAT(/' USING F =',F4.2,' FOR NEIGHBOR THRESHOLD IN', D 1 ' THROWOUT ASSIST.') D ENDIF C IFIRST=0 ONEMR=1.-RMAX RPNX=RMAX+NX RPNY=RMAX+NY ICOUNT=0 C C ERROR CHECK EACH DATUM. THE RANDOM SAMPLE POINTS ARE C CHECKED MAINLY TO GET THE ENTRIES IN TOSS( ) AND QUEST( ). C DO 190 K=1,NSTA C IF(LTAG(K).GT.0)THEN C DATUM WITH LTAG( ) GT 0 IS NEVER USED. TOSS(K)=9999. QUEST(K)=9999. GO TO 190 ENDIF C IF(LTAG(K).EQ.-3.AND.IVRBL.NE.4)THEN C DATUM WITH LTAG( ) = -3 IS ALWAYS HONORED WHEN ANALYZING C ANYTHING BUT SATURATION DEFICIT; NO CHECKING IS DONE. TOSS(K)=9999. QUEST(K)=9999. GO TO 190 ENDIF C IF(LTAG(K).EQ.-2)THEN C THIS STATION WILL NOT BE DISCARDED IF LTAG( ) WAS SET TO -2 C ON THIS PASS INDICATING IT WAS A CLOSEST NEIGHBOR MEETING 1.5 C TIMES THE ER1 CRITERION. NOTE THAT LTAG( ) WILL NOT BE C LEFT AT -2 AT THE END OF A PASS. ALSO, LTAG( ) = -1 FROM A C PREVIOUS PASS IS TREATED THE SAME AS LTAG( ) = 0. TOSS(K)=9999. QUEST(K)=9999. LTAG(K)=0 GO TO 190 ENDIF C C DROP THROUGH TO HERE FOR LTAG( ) = 0 AND -1. C IF(XP(K).LT.ONEMR)GO TO 149 IF(XP(K).GT.RPNX)GO TO 149 IF(YP(K).LT.ONEMR)GO TO 149 IF(YP(K).GT.RPNY)GO TO 149 GO TO 150 C 149 IF(LTAG(K).NE.-3)LTAG(K)=+1 C STATION IS OUTSIDE THE GRID AREA BY AS MUCH OR MORE THAN THE C RADIUS OF INFLUENCE TIMES RSTAR. C IF(CCALL(K).EQ.'CWKG ')THEN WRITE(IP14,9998)CCALL(K),DATA(K),LTAG(K) 9998 FORMAT(/' IN ESP5 AT 9998--CCALL(K),DATA(K),LTAG(K) ', 1 A8,F10.2,I4) ENDIF TOSS(K)=9999. QUEST(K)=9999. GO TO 190 C C MODIFY THE ERROR CRITERION ER1 ACCORDING TO THE TYPE C OF STATION--OCEAN, INLAND WATER, LAND. C 150 ER1X=ER1T*OLITOS(LNDSEA(K)+1) ER1Q=ER1QT C IF(ERRADJ.NE.0..AND.LP.GT.1)THEN C ERRADJ = 0 IS DEFAULT FOR PREVIOUS IMPLEMENTATIONS. C THE 1ST PASS IS NOT ADJUSTED. C THE OLD LAMP TEMP ANALYSIS HAD THROWOUT 60, 42.0, 24.0, 18. C WITH ADJUST = 1.8, THE VALUES WILL BE 60, 25.2, 19.6, 18 C WHEN THE .CN FILE HAS 60, 14.0, 12.0, 10. C CCC WRITE(KFILDO,1501)K,CCALL(K),NAME(K),OLITOS(LNDSEA(K)+1), CCC 1 LTAGPT(K) CCC 1501 FORMAT(/ ' K,CCALL(K),NAME(K),OLITOS(LNDSEA(K)+1),LTAGPT(K)', CCC 1 I6,2X,A8,2X,A20,F6.2,I4) C IF(OLITOS(LNDSEA(K)+1).EQ.1.)THEN C IF AN INCREASE HAS ALREADY BEEN MADE VIA OLITOS, C THEN LEAVE IT ALONE. THIS CURRENTLY APPLIES TO ONLY C LAKE AND LAKE/LAND. C IF(LTAGPT(K).EQ.0)THEN C ADJUST THROWOUT CRITERIA FOR BASE STATIONS. C IT IS EXPECTED THAT ADJUST IS > 1. ER1X=ER1T*ERRADJ ER1Q=ER1QT*ERRADJ C ER1Q HAD NOT BEEN, AND IS NOT, RELATED TO OLITOS( ). C (MAYBE IT WILL NEED TO BE.) ENDIF C CCCC IF(CCALL(K).EQ.'PASI '.AND.LP.EQ.NPASS)THEN CCCC WRITE(KFILDO,1502)K,CCALL(K),NAME(K),ER1T,ER1QT,ERRADJ, CCCC 1 LTAGPT(K),ER1X,ER1Q,LNDSEA(K) CCCC 1502 FORMAT(' AT 1502--K,CCALL(K),NAME(K),ER1T,ER1QT,ERRADJ,', CCCC 1 'LTAGPT(K),ER1X,ER1Q,LNDSEA(K)', CCCC 2 I6,2X,A8,2X,A20,3F6.2,I4,2F6.2,I4) CCCC ENDIF C ENDIF C ENDIF C FER1=F*ER1X C C FIND INTERPOLATED VALUE OR NEAREST NEIGHBOR VALUE IN C ITRPSL ACCORDING TO THE LAND/WATER TYPE LNDSEA(K). C CALL ITRPSL(KFILDO,IP14,P,NX,NY,CCALL(K),XP(K),YP(K), 1 LNDSEA(K),SEALND,NXE,NYE, 2 MESH,MESHE,N4P,BB,ISTOP,IER) C VALUE INTERPOLATED FROM CURRENT ANALYSIS OR FIRST C GUESS TO LOCATION OF STATION IS NOW IN BB. THIS CAN BE C MISSING BECAUSE AN INTERPOLATED VALUE FOR A LAND (WATER) C STATION IS ONLY TAKEN FROM LAND (WATER) STATIONS, AND IT IS C POSSIBLE NONE EXIST. ALSO, THE FIRST GUESS ANALYSIS AREA C MAY NOT FILL GRID. IN THIS CASE, IER NE 0. THE STATION C IS NOT TOSSED, BUT PROBABLY CAN'T BE USED IN THE ANALYSIS. C IF(IER.NE.0)THEN C THIS RETURN IS MAINLY WHEN THE 6X6 STENCIL DIDN'T C FIND A SUITABLE GRIDPONT, SO THESE ARE CAUGHT ON THE C FIRST PASS AND DISCARDED, AND SHOULD NOT OCCUR ON C FOLLOWING PASSES. C CCCC WRITE(KFILDO,9999)LP,CCALL(K),DATA(K),LTAG(K),IER CCCC 9999 FORMAT(/' AT 9999 IN ESP5--LP,CCALL(K),DATA(K),LTAG(K),', CCCC 1 'IER ',I4,2X,A8,F10.2,2I4) C LTAG(K)=1 C IF INTERPOLATION COULDN'T BE DONE IN THIS FIRST C PASS CALL TO ESP5, THE STATION IS UNUSABLE FOR THIS C ANALYSIS, SO SET LTAG( ) = 1. GO TO 190 ENDIF C DBB=DATA(K)-BB C C THE ABOVE INTERPOLATION DOES NOT CONSIDER THE XLAPSE( ). C CALL ITRPSL TO GET THE INTERPOLATED ELEVATION, RUN C BB UP OR DOWN TO THE GRID AND SEE IF IT MATCHES DATA( ) C CLOSER THAN WITHOUT XLAPSE( ). C DBBSAV=DBB BBSAV=BB CALL ITRPSL(KFILDO,IP14,TELEV,NXE,NYE,CCALL(K),XP(K),YP(K), 1 LNDSEA(K),SEALND,NXE,NYE, 2 MESH,MESHE,N4P,TBB,ISTOP,IER) IF(IER.NE.0)THEN WRITE(KFILDO,1503) 1503 FORMAT(' ****ERROR IN ITRPSL IN ESP5 INTERPOLATING', 1 ' INTO TELEV( , ). BYPASS THIS.') BB=BBSAV DBB=DBBSAV ELSE DBB=DATA(K)-(BBSAV+XLAPSE(K)*(ELEV(K)-TBB)) C THE LAST TERM CORRECTS THE VALUE LINEARLY C INTERPOLATED TO THE GRID WITH THE LAPSE TO GET C A BETTER ESTIMATE AT THE STATION. THIS AGREES C WITH THE WAY THE CORRECTION IS APPLIED. C C USE BELOW TO CHECK ON A SPECIFIC STATION. C***************************************************** IF(CCALL(K).EQ.'PASI ')THEN WRITE(KFILDO,1504)K,CCALL(K),BBSAV,DBBSAV,TBB,DBB, 1 DATA(K),XLAPSE(K),WFACT,ER1X, 2 ELEV(K),TBB 1504 FORMAT(/' AT 1504 IN ESP5--K,CCALL(K),BBSAV,DBBSAV,', 1 'TBB,DBB,DATA(K),XLAPSE(K),WFACT,ER1X,', 2 ' ELEV(K),TBB',I6,2X,A8,5F8.1,F8.5,4F8.2) ENDIF C***************************************************** C IF(ABS(DBBSAV).LT.ABS(DBB))THEN C IF USE OF XLAPSE( ) PRODUCES A CLOSER FIT, USE IT. C OTHERWISE, RESET BB AND DBB TO THEIR ORIGINAL C VALUES. BB=BBSAV DBB=DBBSAV ICOUNT=ICOUNT+1 CCCC IF(ICOUNT.LT.500)WRITE(KFILDO,1505)CCALL(K),ICOUNT CCCC 1505 FORMAT(' RESTORING ORIGINAL VALUE IN ESP5 ',A6,I5) ENDIF C ENDIF C C CHECK FOR LARGE DISCREPANCY WITH SATURATION DEFICIT AND C LTAG(K) = -3. THIS IS TO KEEP OUT A LIKELY ERRONEOUS C PRECIP OB WHICH WOULD MAKE A BULLSEYE. C IF(IVRBL.EQ.4.AND.LTAG(K).EQ.-3)THEN C IF(BB.LT.38.)THEN C THIS BB VALUE (CURRENT ANALYSIS) OF 38 IS SCALED. C THE CORRESPONDING UNSCALED VALUE IS (38-5)*6=198. C THIS TEST HONORS THE -3 AND ACCEPTS THE OB AT THIS C POINT WHEN THE DIFFERENCE IS LT 38-(-15)=53. C OTHERWISE WITH A DIFFERENCE GE 53, IT WILL GO THROUGH C THE USUAL CHECK AND MAY OR MAY NOT BE THROWN OUT. TOSS(K)=9999. QUEST(K)=9999. GO TO 190 ENDIF C ENDIF C C***************ADDED 12/23/15 FOR MOS WIND SPEED. NOT CHECKED FOR LAMP. IF(QUALST(K).LT.1..AND.DBB.LT.0.)THEN ER1XX=ER1X*WFACT FER1X=FER1*WFACT ELSE ER1XX=ER1X FER1X=FER1 ENDIF C C THIS IS THE LAST USE OF ER1X. C THIS IS THE LAST USE OF FER1. C C ER1XX IS ER1T ADJUSTED FOR WFACT WHEN THE ERROR IS NEGATIVE, C AND ND BY EITHER OLITOS( ) OR BY ERRADJ FOR BASE STATIONS. C THIS IS THE THRESHOLD TO CHECK AGAINST C FER1X IS THE SAME AS ER1XX EXCEPT * F = .6. THIS IS THE C THRESHOLD TO CHECK THE NEIGHBOR STATIONS AGAINST. C ER1Q IS THE THRESHOLD FOR "QUESTIONABLE" STATIONS AND IS NOT C DIRECTLY INVOLVED IN TOSSING STATIONS. C IF(CCALL(K).EQ.'PASI ')THEN WRITE(KFILDO,1512)CCALL(K),QUALST(K),WFACT,DBB,ER1XX,FER1X,ER1Q 1512 FORMAT(' IN ESP5 AT 1512--CCALL(K),QUALST(K),WFACT,DBB,', 1 'ER1XX,FER1X,EQIQ '/,A8,6F10.4) ENDIF C***************ADDED 12/23/15 FOR MOS WIND SPEED. NOT CHECKED FOR LAMP. C IF(ABS(DBB).LE.ER1Q)THEN QUEST(K)=9999. ELSE QUEST(K)=DATA(K) C IF(ABS(DBB).LT.ER1XX.AND.I405ADG.NE.0)THEN C IF(ISKIP.NE.0)WRITE(KFILDO,1508) 1508 FORMAT(' ') D WRITE(KFILDO,151)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB,ER1Q D151 FORMAT(' ',A8,' QUESTIONABLE PASS',I3,' ANALYSIS IS',F8.1, D 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1,' DIFFERENCE', D 2 ' IS',F7.1,' THRESHOLD IS',F6.1) ISKIP=0 IFIRST=0 ENDIF C ENDIF C IF(ABS(DBB).LE.ER1XX)THEN C THIS STATION IS ACCEPTABLE. LTAG(K)=0 TOSS(K)=9999. GO TO 190 ENDIF C C STATION K MAY BE IN ERROR. IF IT MEETS 1.5 TIMES THE ERROR C CRITERION, FIND TWO NEAREST STATIONS. IF ONE (OR BOTH) DOES C NOT MEET THE ERROR CRITERION AND IS INCORRECT IN THE SAME C DIRECTION, THEN STATION K IS ACCEPTED. (ALSO, THE STATION C THAT HELPED STATION K TO BE ACCEPTED IS ACCEPTED IF IT MEETS C 1.5 TIMES THE ERROR CRITERION.) C IF(I405ADG.NE.0)THEN IF(ISKIP.NE.0)WRITE(KFILDO,1508) WRITE(KFILDO,1515)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB,ER1XX 1515 FORMAT(' ',A8,' IN QUESTION PASS',I3,' ANALYSIS IS',F8.1, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1,' DIFFERENCE', 2 ' IS',F7.1,' THRESHOLD IS',F6.1) ISKIP=0 IFIRST=0 ENDIF C C BEFORE TOSSING, USE ITRP. ITRPSL MAY RETURN THE CLOSEST C GRIDPOINT WHICH MAY NOT BE A GOOD REPRESENTATION AT A C WATER/LAND BOUNDARY. C CALL ITRP(P,NX,NY,XP(K),YP(K),BB) DBBSAV=DBB DBB=DATA(K)-BB C IF(ISKIP.NE.0.AND.I405ADG.NE.0)WRITE(KFILDO,1508) ISKIP=0 IFIRST=1 C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1516)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB,ER1XX 1516 FORMAT(' ',A8,' TRYING ITRP PASS',I3,' ANALYSIS IS',F8.1, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1,' DIFFERENCE', 2 ' IS',F7.1,' THRESHOLD IS',F6.1) ENDIF C IF(ABS(DBB).LE.ER1XX)THEN C THIS STATION IS ACCEPTABLE. C IF(I405ADG.NE.0)THEN IF(ISKIP.NE.0)WRITE(KFILDO,1508) ISKIP=0 WRITE(KFILDO,1517)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB, 1 ER1XX 1517 FORMAT(' ',A8,' ITRP ACCEPTS PASS',I3,' ANALYSIS IS',F8.1, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1,' DIFFERENCE', 2 ' IS',F7.1,' THRESHOLD IS',F6.1) ENDIF C LTAG(K)=0 TOSS(K)=9999. GO TO 190 ENDIF C C FOR WIND SPEED AND TOTAL WIND, USE IZCHK. C IF(IZCHK.EQ.1.AND.DATA(K).LT..1)THEN IF(IFIRST.EQ.0)WRITE(KFILDO,1524) WRITE(KFILDO,1518)CCALL(K),LP,BB,XP(K),YP(K),DATA(K) 1518 FORMAT(' ',A8,' NOT ACCEPTED PASS',I3,' ANALYSIS IS',F8.1, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1,' WIND SPEED IS', 2 ' ZERO') C IF(NAME(K).NE.' ')THEN C MANY NAMES ARE BLANK. WRITE(KFILDO,1526)NAME(K) ENDIF C LTAG(K)=-1 TOSS(K)=DATA(K) QUEST(K)=9999. GO TO 190 ENDIF C C CHECK WITH GUST FACTOR. C IF(DBB.GT.0..AND.(DBB.LE.ER1XX*GF.OR.DBBSAV.LE.ER1XX*GF))THEN C THIS IS A POSITIVE ERROR AND IF GT > 1, AS IT WOULD C BE FOR TOTAL WIND, THEN POSITIVE VALUES CAN BE KEPT C WITHOUT ACCEPTING VERY SMALL VALUES. C IF(I405ADG.NE.0)THEN IF(ISKIP.NE.0)WRITE(KFILDO,1508) ISKIP=0 WRITE(KFILDO,1519)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB, 1 ER1XX*GF 1519 FORMAT(' ',A8,' ITRP ACCEPTS PASS',I3,' ANALYSIS IS',F8.1, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1,' DIFFERENCE', 2 ' IS',F7.1,' THRESHOLD IS',F6.1) ENDIF C LTAG(K)=0 TOSS(K)=9999. GO TO 190 ENDIF C IF(ABS(DBB).LE.1.5*ER1XX.OR.ABS(DBBSAV).LE.1.5*ER1XX)THEN C MEETS 1.5*ER1XX FROM EITHER ITRPSL OR ITRP, SO TRY C NEIGHBORS FOR SUPPORT. GO TO 160 ENDIF C C DOES NOT MEET 1.5*ER1XX, SO TOSS THE DATUM. C IF(LP.EQ.NPASS)THEN NOTOSS(1)=NOTOSS(1)+1 IF(LTAGPT(K).EQ.0)NOTOSS(2)=NOTOSS(2)+1 C NOTOSS(2) COUNTS THE BASE STATIONS TOSSED. ENDIF C LTAG(K)=-1 TOSS(K)=DATA(K) QUEST(K)=9999. C C PRINT TO IP21 ON LAST PASS. C IF(IP21.NE.0.AND.LP.EQ.NPASS)THEN WRITE(IP21,1520)CCALL(K),NAME(K),LP,DATA(K),DBB,NOTOSS(1), 1 NOTOSS(2) 1520 FORMAT(/' ',A8,2X,A20,' TOSSED ON LAST PASS NO.',I2, 1 ', DATA =',F6.1,', DIFF =',F7.2, 2 ', NO. TOSSED THIS RUN =',I4,', BASE STA. =',I4) ENDIF C CCC IF(I405ADG.NE.0)THEN CCC REMOVED ABOVE 5/23/07 IF(IFIRST.EQ.0)WRITE(KFILDO,1524) 1524 FORMAT(' ') WRITE(KFILDO,1525)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB 1525 FORMAT(' ',A8,' NOT ACCEPTED PASS',I3,' ANALYSIS IS',F8.1, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1,' DIFFERENCE IS', 2 F7.1) C IF(NAME(K).NE.' ')THEN C MANY NAMES ARE BLANK. WRITE(KFILDO,1526)NAME(K) 1526 FORMAT(' ',A20) ENDIF C IFIRST=1 C ABOVE IFIRST=1 ADDED 5/23/07 TO ACCOMMODATE I405ADG = 0. ISKIP=1 C C*************************SEA LEVEL PRESSURE ONLY BELOW************* C C FOR SEA LEVEL PRESSURE ONLY (IVRBL = 1), EXTREME PRESSURE C IS CHECKED FOR POSSIBLE 100 MB ERROR (E.G., REPORTED C 940 INSTEAD OF 1040). C IF(IVRBL.EQ.1.AND.(DATA(K).LT.970..OR.DATA(K).GT.1040.))THEN CALL ESLP5(KFILDO,DATA(K),DBB,BB,ER1,IFLAG) C RETURN OF IFLAG NE 0 MEANS THE SWITCH WAS MADE (DATA( ) C VALUE CHANGED BY 100 AND DBB MODIFIED ACCORDINGLY). C IF(IFLAG.NE.0)THEN C THIS STATION IS ACCEPTED AFTER ESLP5. BECAUSE C OF CHANGE OF DATA(K), HAVE TO CHECK ER1Q. LTAG(K)=0 TOSS(K)=9999. C IF(ABS(DBB).LE.ER1Q)THEN QUEST(K)=9999. ELSE QUEST(K)=DATA(K) ENDIF C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1527)CCALL(K),DATA(K) 1527 FORMAT(' ',A8,30X,'IS NOW ACCEPTED AS',F8.1) ISKIP=1 ENDIF C GO TO 190 C STATION HAS BEEN ACCEPTED. ENDIF C ENDIF C C FOR SEA LEVEL PRESSURE AND FOR PRESSURES LT 1013 MB, C ESTIMATE THE PRESSURE FROM ONE OR BOTH OF ITS C CLOSEST NEIGHBORS. IF THIS ESTIMATE AGREES WITHIN ER1 C WITH THE PRESSURE, ACCEPT IT. C IF(IVRBL.EQ.1.AND.DATA(K).LT.1013.)THEN CALL CLOSLW(XP,YP,LTAG,QUALST,LNDSEA,NSTA,K,LS1,LS2) C IF(I405ADG.NE.0)THEN CALL LISTLW(KFILDO,CCALL,DATA,XP,YP,LNDSEA,K,NSTA, 1 P,NX,NY,RAD,MESH) C LS1 AND LS2 CONTAIN POSITIONS IN STATION LIST OF NEAREST C AND NEXT NEAREST STATION RESPECTIVELY. C NOTE THAT LIST USES ITRP, NOT ITRPSL. THE LISTING VALUES C MAY NOT AGREE WELL WITH THE VALUES FROM ITRPSL. ENDIF C CALL GRADCK(KFILDO,P,NX,NY,DATA,XP,YP,U,V,K,LS1,LS2, 1 NSTA,ER1,ESTP,IACCPT) IF(IACCPT.EQ.0)GO TO 190 C STATION HAS NOW BEEN ACCEPTED. LTAG(K)=0 TOSS(K)=9999. QUEST(K)=DATA(K) C A STATION ACCEPTED BY THIS PROCEDURE IS ALWAYS COUNTED C AS QUESTIONABLE. DIQ=DATA(K)-ESTP C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1815)CCALL(K),CCALL(IACCPT),ESTP,DIQ,ER1 ISKIP=1 ENDIF C ENDIF C C*************************SEA LEVEL PRESSURE ONLY ABOVE************* C GO TO 190 C C THIS SECTION FOR BUDDY CHECK BEFORE A STATION IS DISCARDED C FOR OTHER THAN SEA LEVEL PRESSURE. C 160 CALL CLOSLW(XP,YP,LTAG,QUALST,LNDSEA,NSTA,K,LS1,LS2) C LS1 AND LS2 CONTAIN POSITIONS IN STATION LIST OF NEAREST C AND NEXT NEAREST STATION RESPECTIVELY. C C CHECK NEAREST NEIGHBOR FOR AGREEMENT WITH ANALYSIS. C FIND INTERPOLATED VALUE OR NEAREST NEIGHBOR VALUE IN C ITRPSL ACCORDING TO THE LAND/WATER TYPE LNDSEA(K). C CALL ITRPSL(KFILDO,IP14,P,NX,NY,CCALL(LS1),XP(LS1),YP(LS1), 1 LNDSEA(LS1),SEALND,NXE,NYE, 2 MESH,MESHE,N4P,BB1,ISTOP,IER) C VALUE INTERPOLATED FROM CURRENT ANALYSIS OR FIRST C GUESS TO LOCATION OF STATION IS NOW IN BB1. THIS CAN BE C MISSING BECAUSE AN INTERPOLATED VALUE FOR A LAND (WATER) C STATION IS ONLY TAKEN FROM LAND (WATER) STATIONS, AND IT IS C POSSIBLE NONE EXIST. ALSO, THE FIRST GUESS ANALYSIS AREA C MAY NOT FILL GRID. IN THIS CASE, IER NE 0. C IF(IER.NE.0)THEN C THIS INTERPOLATION CAN'T BE USED, SO GO TO ITRP. C THE 1615 IF STATEMENT WILL PASS IT TO ITRP. DS1BB1=0. GO TO 1615 ELSE DS1BB1=DATA(LS1)-BB1 ENDIF C IF(I405ADG.NE.0)THEN CALL LISTLW(KFILDO,CCALL,DATA,XP,YP,LNDSEA,K,NSTA, 1 P,NX,NY,RAD,MESH) WRITE(KFILDO,161)CCALL(K),CCALL(LS1),XP(LS1),YP(LS1),DATA(LS1), 1 DS1BB1,FER1X 161 FORMAT(/' ',A8,' IN QUESTION, NEAREST NEIGHBOR IS ',A8, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1, 2 ' DIFFERENCE IS',F7.1,' THRESHOLD IS',F6.1) C NOTE THAT LIST USES ITRP, NOT ITRPSL. THE LISTING VALUES C MAY NOT AGREE WELL WITH THE VALUES FROM ITRPSL. IFIRST=1 ISKIP=1 ENDIF C 1615 IF(ABS(DS1BB1).LE.FER1X)THEN C NEIGHBOR FITS THE ANALYSIS, SO DOES NOT SUPPORT STATION. C BEFORE DECIDING, USE ITRP. ITRPSL MAY RETURN THE CLOSEST C GRIDPOINT WHICH MAY NOT BE A GOOD REPRESENTATION AT A C WATER/LAND BOUNDARY. C CALL ITRP(P,NX,NY,XP(LS1),YP(LS1),BB1) DS1BB1=DATA(LS1)-BB1 C IF(I405ADG.NE.0)THEN WRITE(KFILDO,162)DS1BB1 162 FORMAT(90X,'DIFFERENCE IS',F7.1,' AFTER ITRP') ENDIF C IF(ABS(DS1BB1).LE.FER1X)THEN C CLOSEST NEIGHBOR AGREES WITH ANALYSIS TO CRITERION ER1X*F, C WITH BOTH ITRPSL OR ITRP INTERPOLATION, SO DOES NOT C SUPPORT KEEPING STATION BEING CHECKED. BEFORE C DECIDING IT DOESN'T AGREE, TRY RUNNING THE NEIGHBOR UP C (OR DOWN) TO THE STATION'S ELEVATION, AND SEEING IF THEY C MATCH, PROVIDED XLAPSE( ) IS USED. AVERAGE OF THEIR C LAPSE RATES IS USED. C IF(IBKPN.NE.99)THEN C IBKPN = 99 SIGNALS XLAPSE( ) IS NOT USED. TEST=DATA(LS1)+ 1 ((XLAPSE(K)+XLAPSE(LS1))/2.)*(ELEV(K)-ELEV(LS1)) DIFF=DATA(K)-TEST C C USE BELOW TO CHECK ON A SPECIFIC STATION. C********************************************************* CCCC IF(CCALL(K).EQ.'CWKG ')THEN CCCC WRITE(KFILDO,1624)CCALL(K),DATA(K),DATA(LS1), CCCC 1 XLAPSE(K),XLAPSE(LS1), CCCC 2 ELEV(K),ELEV(LS1),TEST,DIFF CCCC 1624 FORMAT(/' AT 1624--CCALL(K),DATA(K),DATA(LS1),', CCCC 1 'XLAPSE(K),XLAPSE(LS1),', CCCC 2 'ELEV(K),ELEV(LS1),TEST,DIFF',A8,8F9.4) CCCC ENDIF C********************************************************* C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1625)DIFF 1625 FORMAT(82X,'STATION DIFFERENCE IS',F7.1, 1 ' AFTER XLAPSE') ENDIF C IF(ABS(DIFF).LE.FER1X)THEN GO TO 163 C THE NEIGHBOR ADJUSTED FOR TERRAIN AGREES TO WITHIN C FER1X, SO ACCEPT. IF THE STATION IS REALLY BAD, ITS C LAPSE RATE WILL REFLECT THAT, AND THE USE OF THIS C LAPSE RATE MIGHT ALWAYS ACCEPT THE STATION. THE C USE OF THE AVERAGE OUGHT TO HELP THAT. THAT IS, WE C DON'T KNOW THE TRUE LAPSE RATE, BUT ONLY WHAT THE C DATA TELL US. HOWEVER, A SINGLE STATION ON THE C OLYMPIC MOUNTAINS HAS NEIGHBORS THAT LIE BETWEEN C THE COAST AND THE MOUNTAINS, AND UNDOUBTEDLY HAVE C A CONFUSED COMPUTED LAPSE RATE. (ER1 WAS USED C INSTEAD OF FER1X TO ACCEPT A MAX TEMPERATURE THAT C WAS PROBABLY CORRECT. HOWEVER, THIS ALLOWED C ACCEPTANCE OF A BAD DEW POINT, SO ER1 WAS CHANGED C TO FER1 8/3/05) ENDIF C GO TO 180 C ENDIF C C NEITHER ITRPSL NOR ITRP FOR THIS NEIGHBOR SUBSTANTIATE C THE STATION, NOR DID THE LAPSE CALCULATION, SO TRY THE C SECOND NEIGHBOR. GO TO 180 C ENDIF C C 1ST NEIGHBOR MAGNITUDE SUBSTANTIATES STATION K ERROR. NOW C CHECK SIGN. GO TO 1629 C ENDIF C C A FALL THROUGH HERE MEANS THE NEIGHBOR MAGNITUDE AGREED. NOW C NOW TEST FOR SIGN. C 1629 IF(DBB*DS1BB1.LT.0.)GO TO 180 C ERRORS ARE OF THE SAME SIGN. ACCEPT STATION K. 163 LTAG(K)=0 TOSS(K)=9999. C IF(I405ADG.NE.0)THEN IF(IFIRST.EQ.0)WRITE(KFILDO,1524) WRITE(KFILDO,1635)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB 1635 FORMAT(' ',A8,' ACCEPTED PASS',I3,' ANALYSIS IS',F8.1, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1,' DIFFERENCE IS', 2 F7.1) IFIRST=1 ISKIP=1 ENDIF C C THIS ARANGES TO ACCEPT THE NEIGHBOR IF IT CORROBORATES C STATION K. C IF(ABS(DS1BB1).GT.1.5*ER1XX)GO TO 190 C NEAREST NEIGHBOR MEETS 1.5 TIMES THE ERROR CRITERION. C IF IT IS ABOVE STATION K IN THE LIST AND LTAG(LS1) EQ -1, C SET LTAG(LS1) = 0. OTHERWISE, SET LTAG(LS1) = -2. C IF(LS1.GT.K)GO TO 165 C IF(LTAG(LS1).NE.-1)GO TO 190 C LTAG(LS1)=0 TOSS(LS1)=9999. C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1645)CCALL(LS1) 1645 FORMAT(' ',A8,30X,'IS NOW ACCEPTED') ISKIP=1 ENDIF C GO TO 190 C 165 IF(LTAG(LS1).NE.-3)LTAG(LS1)=-2 TOSS(LS1)=9999. GO TO 190 C C CLOSEST NEIGHBOR DID NOT ALLOW STATION TO BE ACCEPTED. C NOW CHECK SECOND NEAREST NEIGHBOR. C FIND INTERPOLATED VALUE OR NEAREST NEIGHBOR VALUE IN C ITRPSL ACCORDING TO THE LAND/WATER TYPE LNDSEA(K). C 180 CALL ITRPSL(KFILDO,IP14,P,NX,NY,CCALL(LS2),XP(LS2),YP(LS2), 1 LNDSEA(LS2),SEALND,NXE,NYE, 2 MESH,MESHE,N4P,BB2,ISTOP,IER) C VALUE INTERPOLATED FROM CURRENT ANALYSIS OR FIRST C GUESS TO LOCATION OF STATION IS NOW IN BB2. THIS CAN BE C MISSING BECAUSE AN INTERPOLATED VALUE FOR A LAND (WATER) C STATION IS ONLY TAKEN FROM LAND (WATER) STATIONS, AND IT IS C POSSIBLE NONE EXIST. ALSO, THE FIRST GUESS ANALYSIS AREA C MAY NOT FILL GRID. IN THIS CASE, IER NE 0. C IF(IER.NE.0)THEN C THIS INTERPOLATION CAN'T BE USED, SO GO TO ITRP. C THE 1807 IF STATEMENT WILL PASS IT TO ITRP. DS2BB2=0. GO TO 1807 ELSE DS2BB2=DATA(LS2)-BB2 ENDIF C IF(I405ADG.NE.0)THEN IF(IFIRST.EQ.0)WRITE(KFILDO,1524) WRITE(KFILDO,1803)CCALL(K),XP(K),YP(K),DATA(K),BB,DBB, 1 CCALL(LS2),XP(LS2),YP(LS2),DATA(LS2),BB2,DS2BB2 1803 FORMAT(' ',A8,' XPOS',F7.1,' YPOS',F7.1,F6.1,' NOT ', 1 'YET ACCEPTED ANALYSIS IS',F9.1,' DIFFERENCE IS', 2 F7.1,/,' ',A8,' XPOS',F7.1,' YPOS',F7.1,F6.1,6X, 3 'SECOND NEIGHBOR ANALYSIS IS',F9.1,' DIFFERENCE IS', 4 F7.1) ENDIF C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1805)CCALL(LS2),XP(LS2),YP(LS2),DATA(LS2), 1 DS2BB2,FER1X 1805 FORMAT(24X,' NEXT NEAREST NEIGHBOR IS ',A8, 1 ' XPOS',F6.1,' YPOS',F6.1,F7.1, 2 ' DIFFERENCE IS',F7.1,' THRESHOLD IS',F6.1) ISKIP=1 ENDIF C 1807 IF(ABS(DS2BB2).LE.FER1X)THEN C C BEFORE DECIDING, USE ITRP. ITRPSL MAY RETURN THE CLOSEST C GRIDPOINT WHICH MAY NOT BE A GOOD REPRESENTATION AT A C WATER/LAND BOUNDARY. C CALL ITRP(P,NX,NY,XP(LS2),YP(LS2),BB2) DS2BB2=DATA(LS2)-BB2 C IF(I405ADG.NE.0)THEN WRITE(KFILDO,162)DS2BB2 ENDIF C IF(ABS(DS2BB2).GT.FER1X.AND.ABS(DS2BB2).LT.1.5*ER1XX)GO TO 182 C NEXT CLOSEST NEIGHBOR DOES NOT AGREE WITH ANALYSIS WITHIN C CRITERION ER1*F AND ER1XX*1.5 WITH ITRPSL OR ITRP INTERPOLATION C AND THEREFORE SUPPORTS STATION. GO TO 182 TO CHECK SIGN. C C NEXT CLOSEST NEIGHBOR AGREES WITH ANALYSIS TO CRITERION C ER1X*F, WITH BOTH ITRPSL OR ITRP INTERPOLATION, SO DOES C NOT SUPPORT KEEPING STATION BEING CHECKED. BEFORE C DECIDING IT DOESN'T AGREE, TRY RUNNING THE NEIGHBOR UP C (OR DOWN) TO THE STATION'S ELEVATION, AND SEEING IF THEY C MATCH, PROVIDED XLAPSE( ) IS USED. AVERAGE OF THEIR C LAPSE RATES IS USED. C IF(IBKPN.NE.99)THEN C IBKPN = 99 SIGNALS XLAPSE( ) IS NOT USED. TEST=DATA(LS2)+ 1 ((XLAPSE(K)+XLAPSE(LS2))/2.)*(ELEV(K)-ELEV(LS2)) DIFF=DATA(K)-TEST C CCC WRITE(KFILDO,1808)CCALL(K),DATA(K),DATA(LS2),XLAPSE(K), CCC 1 XLAPSE(LS2), CCC 2 ELEV(K),ELEV(LS2),TEST,DIFF CCC 1808 FORMAT(/' AT 1808--CCALL(K),DATA(K),DATA(LS2),XLAPSE(K),', CCC 1 'XLAPSE(LS2),', CCC 2 'ELEV(K),ELEV(LS2),TEST,DIFF',A8,8F9.4) C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1625)DIFF ENDIF C IF(ABS(DIFF).LE.FER1X)THEN GO TO 183 C THE NEIGHBOR ADJUSTED FOR TERRAIN AGREES TO WITHIN C FER1X, SO ACCEPT. IF THE STATION IS REALLY BAD, ITS C LAPSE RATE WILL REFLECT THAT, AND THE USE OF THIS C LAPSE RATE MIGHT ALWAYS ACCEPT THE STATION. THE USE C OF THE AVERAGE OUGHT TO HELP THAT. THAT IS, WE DON'T C KNOW THE TRUE LAPSE RATE, BUT ONLY WHAT THE DATA C TELL US. HOWEVER, A SINGLE STATION ON THE OLYMPIC C MOUNTAINS HAS NEIGHBORS THAT LIE BETWEEN THE COAST C AND THE MOUNTAINS, AND UNDOUBTEDLY HAVE A CONFUSED C COMPUTED LAPSE RATE. (ER1X WAS USED INSTEAD OF FER1 C TO ACCEPT A MAX TEMPERATURE THAT WAS PROBABLY C CORRECT. HOWEVER, THIS ALLOWED ACCEPTANCE OF A C BAD DEW POINT, SO ER1X WAS CHANGED TO FER1 8/3/05) ENDIF C ENDIF C GO TO 181 C THE LAPSE RATE CALCULATION DOES NOT SUBSTANTIATE C THE STATION, SO TOSS IT. ELSEIF(ABS(DS2BB2).LE.1.5*ER1XX)THEN GO TO 182 C THE MAGNITUDE OF THE 2ND NEIGHBOR ERROR DID NOT FALL C BETWEEN FER1X AND 1.5*ER1XX, SO CHECK THE SIGN. NOTE THAT C AN ERROR OF 1.5*ER1XX IS NOT CONSIDERED ACCEPTABLE FOR C THE NEIGHBOR. ENDIF C C DROPS THROUGH HERE WHEN THE 2ND NEIGHBOR DOES NOT SUBSTANTIATE C THE STATION. C CCC 181 IF(I405ADG.NE.0)THEN CCC REMOVED ABOVE 5/10/09 181 IF(IFIRST.EQ.0)WRITE(KFILDO,1524) WRITE(KFILDO,1525)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB WRITE(KFILDO,1526)NAME(K) IFIRST=1 ISKIP=1 C DOES NOT MEET 1.5*ER1X, SO TOSS THE DATUM. C IF(LP.EQ.NPASS)THEN NOTOSS(1)=NOTOSS(1)+1 IF(LTAGPT(K).EQ.0)NOTOSS(2)=NOTOSS(2)+1 C NOTOSS(2) COUNTS THE BASE STATIONS TOSSED. ENDIF C LTAG(K)=-1 TOSS(K)=DATA(K) QUEST(K)=9999. C C PRINT TO IP21 ON LAST PASS. C IF(IP21.NE.0.AND.LP.EQ.NPASS)THEN WRITE(IP21,1520)CCALL(K),NAME(K),LP,DATA(K),DBB,NOTOSS(1), 1 NOTOSS(2) ENDIF C C*************************SEA LEVEL PRESSURE ONLY BELOW************* C C FOR SEA LEVEL PRESSURE ONLY (IVRBL = 1), EXTREME PRESSURE C IS CHECKED FOR POSSIBLE 100 MB ERROR (E.G., REPORTED C 940 INSTEAD OF 1040). C IF(IVRBL.EQ.1.AND.(DATA(K).LT.970..OR.DATA(K).GT.1040.))THEN CALL ESLP5(KFILDO,DATA(K),DBB,BB,ER1,IFLAG) C RETURN OF IFLAG NE 0 MEANS THE SWITCH WAS MADE (DATA( ) C VALUE CHANGED BY 100 AND DBB MODIFIED ACCORDINGLY). C IF(IFLAG.NE.0)THEN LTAG(K)=0 TOSS(K)=9999. C IF(ABS(DBB).LE.ER1Q)THEN QUEST(K)=9999. ELSE QUEST(K)=DATA(K) ENDIF C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1527)CCALL(K),DATA(K) ISKIP=1 ENDIF C GO TO 190 C STATION HAS BEEN ACCEPTED. ENDIF C ENDIF C C FOR SEA LEVEL PRESSURE AND FOR PRESSURES LT 1013 MB, C ESTIMATE THE PRESSURE FROM ONE OR BOTH OF ITS C CLOSEST NEIGHBORS. IF THIS ESTIMATE AGREES WITHIN ER1 C WITH THE PRESSURE, ACCEPT IT. C IF(IVRBL.EQ.1.AND.DATA(K).LT.1013.)THEN CALL GRADCK(KFILDO,P,NX,NY,DATA,XP,YP,U,V,K,LS1,LS2, 1 NSTA,ER1,ESTP,IACCPT) IF(IACCPT.EQ.0)GO TO 190 C STATION HAS NOW BEEN ACCEPTED. LTAG(K)=0 TOSS(K)=9999. QUEST(K)=DATA(K) C A STATION ACCEPTED BY THIS PROCEDURE IS ALWAYS COUNTED C AS QUESTIONABLE. DIQ=DATA(K)-ESTP C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1815)CCALL(K),CCALL(IACCPT),ESTP,DIQ,ER1 1815 FORMAT(' ',A8,' ACCEPTED BECAUSE OF ESTIMATE FROM', 1 ' STATION ',A8,' OF ',F7.1,' DIFFERENCE IS',F7.1, 2 ' THRESHOLD IS',F6.1) ISKIP=1 ENDIF C ENDIF C C*************************SEA LEVEL PRESSURE ONLY ABOVE************* C GO TO 190 C C NEXT CLOSEST NEIGHBOR DOES NOT MEET CRITERION EITHER. IF C ERRORS ARE OF THE SAME SIGN, ACCEPT STATION K. C 182 IF(DBB*DS2BB2.LT.0.)GO TO 181 C ERRORS ARE OF SAME SIGN. ACCEPT STATION K. 183 LTAG(K)=0 TOSS(K)=9999. C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1635)CCALL(K),LP,BB,XP(K),YP(K),DATA(K),DBB ENDIF C IF(ABS(DS2BB2).GT.1.5*ER1XX)GO TO 190 C NEXT NEAREST NEIGHBOR MEETS 1.5 TIMES THE ERROR CRITERION. C IF IT IS ABOVE STATION K IN LIST AND LTAG(LS2) EQ -1, C SET LTAG(LS2) = 0. OTHERWISE, SET LTAG(LS2) = -2. C IF(LS2.GT.K)GO TO 185 C IF(LTAG(LS2).NE.-1)GO TO 190 C LTAG(LS2)=0 TOSS(LS2)=9999. C IF(I405ADG.NE.0)THEN WRITE(KFILDO,1645)CCALL(LS2) ISKIP=1 ENDIF C GO TO 190 C 185 IF(LTAG(LS2).NE.-3)LTAG(LS2)=-2 TOSS(LS2)=9999. 190 CONTINUE C C ON CONTROL OF IP17, PRINT THE RESULTS OF ERROR CHECKING C IN LTAG( ). C IF(IP17.NE.0)THEN WRITE(IP17,200)(JDATE(J),J=1,4),MESH,TITLE(1:16), 1 LP,ONEMR,RPNX,ONEMR,RPNY 200 FORMAT(/' FOR DATE',I6,3I3.2,' AT THE END OF ESP5, VALUES FOR', 1 ' MESH LENGTH =',I5,' FOR ',A16,' PASS =',I3,' ARE:'/ 2 ' STATIONS WITH MISSING DATA ARE NOT LISTED. ', 3 ' RANGE OF IX CHECKED =',F7.0,' TO',F7.0,'; ', 4 ' RANGE OF JY CHECKED =',F7.0,' TO',F7.0/ 5 ' NO. STATION XPOS YPOS DATA ', 6 ' LTAG LNDSEA') C DO 220 K=1,NSTA C IF(DATA(K).NE.9999.)THEN WRITE(IP17,210)K,CCALL(K),XP(K),YP(K),DATA(K),LTAG(K), 1 LNDSEA(K) 210 FORMAT(' ',I5,2X,A8,F8.2,F8.2,F10.2,I6,I7) ENDIF C 220 CONTINUE C ENDIF C CALL TIMPR(KFILDO,KFILDO,'END ESP5 ') RETURN END