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