SUBROUTINE BCD5(KFILDO,KFILOG,KFILRA,RACESS,NUMRA,KFILOV,KFILQC,
1 IP14,IP16,IP17,IP18,IP19,IP20,IP21,IP22,I405ADG,
2 ID,IDPARS,JP,IVRBL,MODNO,
3 ISCALD,JFIRST,
4 NDATE,JDATE,XDATA,CCALL,NAME,XP,YP,XYP,
5 STALAT,STALON,XPL,YPL,XPE,YPE,SDATA,
6 TOSS,QUEST,LTAG,LNDSEA,ELEV,QUALST,
7 LAPFG,XLAPSE,ULAPSE,LAPUDB,TELL,TELH,ATEL,BTEL,
8 VRAD,NSTA,NBASTA,ND1,ISETP,LTAGPT,MTAGPT,ILS,
9 WTWTL,WTLTW,HGTTHA,HGTTHB,
A P,FD2,CORR,COUNT,NCOUNT,FD6,ND2X3,NX,NY,
B IPACK,DATA,IWORK,ND5,MINPK,
C TELEV,SEALND,CPNDFD,NXE,NYE,MESHE,EMESH,
D IS0,IS1,IS2,IS4,ND7,
E MD,IPLAIN,PLAIN,PLAINT,IPLANT,
F NAREA,ALATL,ALONL,NPROJ,ORIENT,
G MESH,MESHB,MESHL,XLAT,
H MSHPAS,ER1,
I NTYPE,B,CSTSM,R,
J RSTAR,LNDWAT,ITRPLQ,
K IALGOR,ELCORR,IBKPN,BK,
L ELCORU,IFCOR,RWATO,RWATI,IVRAD,
M TLOD,SETLOD,THID,SETHID,CONSTD,NSCALD,EX1D,EX2D,
N IALOC,ADIST,AELEV,ND13,N4P,NSHLN,ICUB,
O NSMTYP,U,V,WNDWT,WNDGRD,WNDTHR,WNDTRN,
P NPRT,JPRT,NTDL,JTDL,NPASS,NREP,NREPNO,MGUESS,
Q ERRADJ,NPASSP,NPASSF,NSMN,NPASRR,NPASSR,IORST,
R NCLIP,PREPRO,NOPRE,
S NOPTN,DIFFA,NOCEAN,LAKE,DISTX,DPOWER,WTAUG,RAY,LH,
T CINT,ORIGIN,SMULT,SADD,TITLE,IOPT,POSTDS,NOPROD,
U JTOTBY,JTOTRC,MTOTBY,MTOTRC,ITOTBY,ITOTRC,NOTOSS,
V L3264B,L3264W,ISTOP,IER)
C
C JUNE 1993 GLAHN, CHAMBERS TDL HP9000
C AUGUST 2000 GLAHN MODIFIED FOR LAMP-2000
C JUNE 2004 GLAHN MODIFIED SLIGHTLY FOR MOS-2000
C SEPTEMBER 2004 GLAHN MODIFIED LD( ) AND ITAUH FOR WRITING
C SEPTEMBER 2004 GLAHN ADDED IQUAL( ) TO CALL, ETC.
C OCTOBER 2004 GLAHN SHORTENED LINE TO 72 CHARACTERS
C WRITING FORMAT 2787 TO KFILDO;
C ADDED QUALWT( ) TO CALL; EXTRA PRINT
C TO IP18 WHEN PACKED DATA ARE LISTED
C OCTOBER 2004 GLAHN ADDED NELEV( ) TO CALL AND TO CORBC5
C OCTOBER 2004 GLAHN CHANGED NELEV( ) TO ELEV( ); REMOVED
C EMESH IN CALL TO CORBC5
C OCTOBER 2004 GLAHN MODIFIED FOR LAT/LON VICE POLE
C OCTOBER 2004 GLAHN ADDED LNDSEA( ), LNDWAT( , ), ISETP,
C ILS, CALL TO SETPNT
C OCTOBER 2004 GLAHN CHANGED CALL TO PAWOTG TO PAWGTS
C OCTOBER 2004 GLAHN INSERTED LAMBERT AND MERCATOR
C CAPABILITY
C NOVEMBER 2004 GLAHN EXCHANGED ACTUAL FOR MSHXMS; SOME
C STATEMENT NUMBERS CHANGED
C NOVEMBER 2004 GLAHN EXCHANGED 2 ARGUMENTS IN CALL TO
C ACTUAL
C DECEMBER 2004 GLAHN ADDED ELCORR( ), XLAPSE( , , ),
C AA( , , , ), IBASE, IDIMTB, IDIM,
C IBASE( ), ND1, ND13, ND14, ND15 TO
C CALL; REMOVED IDIM
C DECEMBER 2004 GLAHN DIMENSIONED ELCORR( )
C DECEMBER 2004 GLAHN ELIMINATED CALL TO CUTIT IN TWO PLACES
C IF INPUT AND OUTPUT GRIDS ARE THE SAME
C DECEMBER 2004 GLAHN POSITION TO CALL SETPNT CHANGED AND
C 280 CHANGED TO 2799 IN SEVERAL PLACES
C DECEMBER 2004 GLAHN CHANGED QUALWT(3) TO QUALWT(4)
C JANUARY 2005 GLAHN CHANGED KM TO M IN CALLS TO PSIJLL,
C LMIJLL, AND MCIJLL
C JANUARY 2005 GLAHN SUBSTITUTED ITRPSL FOR ITRP TO GET
C ANALYSIS VALUE; ADDED LNDSEA,
C SEALND( ), NXE, NYE, MESHE TO CALL
C TO ESP5
C JANUARY 2005 GLAHN ADDED COMMENT AFTER CALL TO ITRPSL
C FEBRUARY 2005 GLAHN ADDED ISETP TO CALL TO SETPNT
C FEBRUARY 2005 GLAHN ADDED JFIRST TO CALL AND TO CALL TO
C ESP5; CHANGED SOME VALUES OF
C FRACT( ) FROM .51 TO .6
C FEBRUARY 2005 GLAHN UPDATED IVRBL RELATED COMMENTS
C MARCH 2005 GLAHN CHANGED LOCATION OF STATEMENT 400
C MARCH 2005 GLAHN ADDED NOSTM, TRSTL( ), TRSTU( ),
C IDST( ), IDPARS( ) TO CALL
C MAY 2005 GLAHN ELIMINATED STRATIFICATION FEATURE;
C ADDED LAPSE CALCULATION ON THE FLY
C JULY 2005 GLAHN ADDED XLAPSE AND ELEV TO CALL TO ESP5
C JULY 2005 GLAHN ADDED NAME( ) TO CALL; ADDED IP21,
C NAME( ), AND NPASS TO CALL TO ESP5
C JULY 2005 GLAHN ADDED NOTOSS TO CALL AND CALL TO ESP5
C JULY 2005 GLAHN ADDED CALLS TO SMOTHG
C AUGUST 2005 GLAHN ADDED IF TESTS TO DEAL WITH IOPT(1)=0;
C ADDED COMMENTS ABOUT SUBSET AREA
C AUGUST 2005 GLAHN CHANGED FORMATS 260 AND 262 TO FX.3
C AUGUST 2005 GLAHN CHANGED ARGUMENT MD TO MD(4)
C AUGUST 2005 GLAHN MODIFIED USE OF LNDSEA( )
C SEPTEMBER 2005 GLAHN ADDED POSTPROCESSING; POSTDS TO CALL
C SEPTEMBER 2005 GLAHN CHANGED NSCALE FOR DISSNO FROM 0 TO 1
C AND TRUNC FROM 0 TO .1
C SEPTEMBER 2005 GLAHN ADDED TRUNC TO CALL
C SEPTEMBER 2005 GLAHN CORRECTED ERROR IN DISPOSABLE OUTPUT
C WHEN MESH AND GRID SIZE NE BASE VALUE
C SEPTEMBER 2005 GLAHN ADDED NSMTYP = 7 CAPABILITY; ADDED
C NSMTYP TO CALL TO SMOTHG
C SEPTEMBER 2005 GLAHN ADDED IUSEIW (NOT IMPLEMENTED)
C OCTOBER 2005 GLAHN ADDED IBKPN AND BK( )
C NOVEMBER 2005 GLAHN MOVED SOME STATEMENTS 3 SPACES LEFT
C NOVEMBER 2005 GLAHN ADDED LIMITX
C JANUARY 2006 GLAHN REMOVED LIMITX
C JANUARY 2006 GLAHN ADDED ELCORU( , )
C JANUARY 2006 GLAHN ADDED IALGOR( , )
C MARCH 2006 GLAHN ADJUSTED CALL FORMAT; CORRECTED FORMAT
C 1865 FROM KFILOV TO KFILQC
C MARCH 2006 GLAHN ADDED IP14 TO CALL AND IP14 AND
C ISTOP( ) TO CALL TO ITRPSL; ADDED
C CSTSM, N4P
C APRIL 2006 GLAHN CHANGED FORMAT 186
C APRIL 2006 GLAHN REVISED COMPUTATIONAL LOOPS INVOLVING
C IP19, 1P20, IP21, IOPT(1)
C MAY 2006 GLAHN CHANGED 218461 TO 208462--VECTOR QC
C CHANGED 218461 TO 228462--GRIDDED FG
C CHANGED 208461 TO 208462--VECTOR TOSS
C JUNE 2006 GLAHN ADDED IBKPN = 99 CAPABILITY
C JUNE 2006 GLAHN CHANGED CALLS TO SZGRID TO SZGRDM
C JULY 2006 GLAHN ADDED DISPOP; COMMENTS
C DECEMBER 2006 GLAHN ADDED MGUESS TO CALL & CALL TO CORBC5
C JANUARY 2007 GLAHN ADDED NSHLN( ).
C JANUARY 2007 GLAHN ADDED POSTPROCESSING VOR WIND SP
C FEBRUARY 2007 GLAHN CHANGED COMMENT TO QUALWT( )
C FEBRUARY 2007 GLAHN ADDED IBKPN TO CALL TO ESP5
C MARCH 2007 GLAHN ADDED COUNT( , ) TO CALL TO SMOTHG
C MARCH 2007 GLAHN PULLED THE DO 105 LOOP INTO U405
C MARCH 2007 GLAHN REMOVED IQUAL( ) AND QUALWT( )
C MARCH 2007 GLAHN CORRECTED CALL TO SMTH9
C JUNE 2007 GLAHN ADDED RWATO( ) AND RWATI( )
C JUNE 2007 GLAHN REARRANGED CALL TO CORBC5
C JUNE 2007 GLAHN ELIMINATED TRUNC( ); ADDED
C TLOD,SETLOD,THID,SETHID,EX1D,EX2D;
C CALL TO POST
C AUGUST 2007 GLAHN ADDED VRAD(ND1), IVRAD
C SEPTEMBER 2007 GLAHN REPLACED NEWXY WITH NEWXY1
C OCTOBER 2007 GLAHN INCREASED DIMENSION VRAD(ND1,6)
C OCTOBER 2007 GLAHN ADDED ND1 TO CALL
C NOVEMBER 2007 GLAHN INCREASED POSTDS FROM 1 TO POSTDS(3)
C ALONG WITH POSTPROCESSING PARAMETERS
C NOVEMBER 2007 GLAHN ADDED ORIENT TO CALL TO CORBC5
C DECEMBER 2007 GLAHN ADDED IP(25) AND ISTOP(6) CAPABILITY
C FEBRUARY 2007 GLAHN ADDED NAREA
C MARCH 2008 GLAHN SUBSTITUTED ITRPSX FOR ITRPSL
C MARCH 2008 GLAHN ADDED DISCIG; CHANGED NVAL TO
C NXD*NYD IN CALL TO POST
C MARCH 2008 GLAHN ADDED IBKPN, ELCORR(LP), ELCORU(LP)
C TO CALL TO ITRPSX
C MAY 2008 GLAHN ADDED LNDWAT = 2,3 CAPABILITY;
C ELIMINATED IUSEIW
C OCTOBER 2008 GLAHN ADDED WTWTL, WTLTW
C NOVEMBER 2008 GLAHN CHANGED CORR( ) TO NCOUNT( ) IN
C 3 CALLS TO PAWGTS; COMMENTS; SPELLING
C JANUARY 2009 GLAHN ADDED CALL TO VISMI
C DECEMBER 2009 GLAHN ADDED LTAGPT( ) AND IAUG TO CALL
C JANUARY 2010 GLAHN ADDED PREX4 TO CALL AND PREX4 AND
C LTAGPT( ) TO CALL TO CORBC5
C JANUARY 2010 GLAHN ADDED KFILRA( ), RACESS( ), NUMRA,
C PLAINT, PLAIN TO CALL; ADDED CALL
C TO LRSMTH
C MARCH 2010 GLAHN ADDED IAUG TO CALL TO LRSMTH; MODIFIED
C TO NOT USE AUGMENTATION STATIONS IN
C VERIFICATION; CHANGED CALL TO LRSMTH
C TO LCSMTH; ADDED IOPT( ) TO LCSMTH
C MARCH 2010 GLAHN ADDED NPASSF TO CALL
C MARCH 2010 GLAHN ADDED XYP( , 2) AND SDATA( ); CALL TO
C INTRPB, ETC.; ADDED IAUGSM
C MARCH 2010 GLAHN ADDED NSMNUM, NOCEAN, SQUEZE, WTAUG,
C RAY DIFFA TO CALL AND THEIR USE; ADDED
C DIFFA, NOCEAN, SQUEZE, RAY TO CALL TO
C SPOTRM
C MARCH 2010 GLAHN ADDED CPNDFD TO CALL, CALL TO SPOTRM
C MARCH 2010 GLAHN ADDED NOPTN TO CALL; ADDED NOPTN AND
C ID TO CALL TO SPOTRM
C APRIL 2010 GLAHN REMOVED IAUGSM
C APRIL 2010 GLAHN ADDED 2ND SPOTRM ON LAST PASS
C APRIL 2010 GLAHN ADDED LTAGPT TO CALL TO SPOTRM
C APRIL 2010 GLAHN REMOVED 2ND PASS 6 SPOTRM
C APRIL 2010 GLAHN ADDED NPASSP; ADDED DIFMAX
C APRIL 2010 GLAHN ADDED DIFMAX(3), STAMAX(3)
C APRIL 2010 GLAHN ADDED NAMMAX(3)
C MAY 2010 GLAHN SET IER=0 AFTER ITRPSX
C JUNE 2010 GLAHN ADDED IVRADS
C JULY 2010 GLAHN ADDED ERROR CHECK AFTER CORBC5
C JULY 2010 GLAHN INSERTED DIAGNOSTIC 165
C SEPTEMBER 2010 GLAHN INSERTED IF(NAPSSR.EQ.LP) BEFORE 165;
C COMMENT DEFINITION OF SQUEZE
C OCTOBER 2010 GLAHN ADDED CALL TO SPOTRM WITH LTAG( )
C OCTOBER 2010 GLAHN ADDED SAFETY CHECK 272 ON NSMTYP AND
C NOPTN
C NOVEMBER 2010 GLAHN MODIFIED DIAGNOSTIC 274
C FEBRUARY 2011 GLAHN CORRECTED NAPSSP TO NPASSP BELOW 155
C MARCH 2011 GLAHN CORRECTED FORMAT 274
C MARCH 2011 GLAHN ADDED SMOTHG SPECIAL CIRCUMSTANCE
C BELOW 271--LATER DEACTIVATED
C MARCH 2011 GLAHN CHANGED DEFINITION OF SQUEZE TO SQUARE
C MARCH 2011 GLAHN ADDED LAKE
C JUNE 2011 GLAHN BYPASS SMOOTHING WHEN SPOTRM FAILED
C ON IER = 777
C JUNE 2011 GLAHN CHANGED SQUARE IN SPOTRM TO DISTX
C JULY 2011 GLAHN ADDED 'SRM' TO TITLE OF DISTANCE GRID
C AUGUST 2011 GLAHN DIMENSIONED NOTOSS( )
C AUGUST 2011 GLAHN CHANGED DEFINITION OF LTAGPT( );
C ELIMINATED IAUG; ADDED LTAGPT( ) TO
C CALL TO ESP5
C SEPTEMBER 2011 GLAHN REVISED CHECK ON NSMTYP AT 274
C OCTOBER 2011 GLAHN FORMAT 2754 REVISED, NSMTYP COMMENT
C DECEMBER 2011 GLAHN ADDED ERRADJ IN CALL AND CALL TO ESP5
C MARCH 2012 GLAHN MODIFIED FORMATS 2753, 2754
C SEPTEMBER 2013 GLAHN CHANGED KFILDO TO IP14 AT 131
C OCTOBER 2013 GLAHN INSERTED CALL TO SMOTHG WHEN
C LP < NPASS AND B(LP) = 99
C NOVEMBER 2013 GLAHN ADDED WRITING TOSS( ) ON LAST PASS
C WITH ID(2) = 940000 TO FILE KFILOV
C NOVEMBER 2013 GLAHN ADDED PRINTING NUMBER OF VALUES TOSSED
C JANUARY 2014 GLAHN ADDED NPASS TO CALL TO CORBC5
C JANUARY 2014 GLAHN ADDED LAPUDB TO CALL AND TO CALL TO
C CORBC5
C JANUARY 2014 GLAHN MODIFIED TO ACCOMMODATE NOPTN AS
C ONLY 2 DIGITS
C JANUARY 2014 GLAHN ADDED STALAT( ) AND STALON( ) TO CALL
C AND TO CALL TO TO SPOTRM; NAREA ADDED
C TO CALL TO SPOTRM
C FEBRUARY 2014 GLAHN ADDED NOPROD TO CALL
C FEBRUARY 2014 GLAHN MODIFIED LTAG( ) WRITING TO KFILOV
C AT DO 1753
C MARCH 2014 GLAHN ADDED TELEV TO CALL TO ESP5
C APRIL 2014 GLAHN ADDED GF
C MAY 2014 GLAHN ADDED DIAGNOSTIC TO KFILDO AT 1756
C MAY 2014 GLAHN ADDED MTAGPT( )
C JUNE 2014 GLAHN INSERTED CALL TO W3TAGE BEFORE STOPS
C JUNE 2014 GLAHN DEFINED KER TO CARRY ERROR CODE BACK
C TO U405A
C JUNE 2014 GLAHN INSERTED CALL TO SPOTRM WHEN TOTAL
C WIND IS BEING ANALYZED
C JULY 2014 GLAHN ADDED KFILRA( ) TO DIMENSIONS
C AUGUST 2014 GLAHN MODIFIED GF FOR MAX OF 1.5 VICE 2.0
C DECEMBER 2014 GLAHN REVISED W3TAG PER JUDY IN ONE PLACE
C DECEMBER 2014 GHIRARDELLI/GLAHN CHANGED WRITE(IP18,1755)LP
C TO WRITE(IP18,177)LP AT 177
C FEBRUARY 2014 GLAHN ADDED / IN DIAGNOSTICS 2645 AND 2787
C MAY 2015 GLAHN QUALST( ) ADDED TO CALL TO ESP5;
C ADDED QUALST( ) TO IP19 PRINT;
C AUGMENTED PRINT AT 435
C JUNE 2015 GLAHN ADDED FSTGS, ULAPSE( ), TELL, TELH,
C ATEL, BTEL
C JULY 2015 GLAHN CHANGED TO I6 VICE I5 IN 2785, 2787
C JULY 2015 GLAHN ADDED IZCHK AND CALLS TO ESP5
C JULY 2015 GLAHN ADDED ICUB TO CALL AND CALL TO CORBC5
C JULY 2015 GLAHN ADDED NREP AND NREPNO TO CALL, AND
C IMPLEMENTED THEM; PUT ISETP LOGIC
C OUTSIDE LOOP; CHANGED GO TO 2799 TO
C GO TO 290
C AUGUST 2015 GLAHN ADDED CCALL( ) AND NAME( ) TO CALL
C TO SETPNT
C SEPTEMBER 2015 GLAHN CORRECTED NOTOSS( )
C NOVEMBER 2015 GLAHN ALLOWED FOR ERROR RETURN FROM SETPNT
C NOVEMBER 2015 GLAHN ADDED LNDSEA( ), SEALND( , ), MESH,
C MESHE, NXE, NYE TO CALLS TO SETPNT
C DECEMBER 2015 GLAHN CHANGED SLIGHTLY DEFINITION OF IZCHK
C DECEMBER 2015 GLAHN ADDED WFACT AND CALL TO ESP5
C JANUARY 2016 GLAHN ADDED QUALST( ) > .99 TO COMPUTE
C ERROR STATISTICS
C JANUARY 2016 GLAHN ADDED GF = 2 FOR MOS GUST
C JANUARY 2016 GHIRARDELLI/GLAHN CORRECTED ORDER OF
C "NREP,NREPNO" IN CALL SEQUENCE;
C JANUARY 2016 GLAHN MOVED "ISCALD,JFIRST" DOWN ONE LINE
C TO MATCH CALL
C SEPTEMBER 2016 GLAHN CHANGED ND5 TO ND2X3 IN THREE CALLS
C TO PAWGTS
C OCTOBER 2016 GLAHN ADDED NCLIP TO CALL AND TO CALL TO
C SPOTRM
C MARCH 2018 GLAHN COMMENTED OUT WRITE 152 AND
C ASSOCIATED DO LOOP 154 PER LAMP OPS
C APRIL 2018 GLAHN MADE RACESS(6) CHARACTER*60 VICE *6
C JULY 2018 GLAHN ACCEPTED TRI-ROLE FOR NSMN FORMERLY
C NSMNUM
C FEBRUARY 2019 GLAHN ADDED NBASTA TO CALL, USED TO PRINT
C ONLY NON-BOBUSG STATIONS
C FEBRUARY 2019 GLAHN ADDED NEAR( , )TO CALL TO SETPT;
C NOPTN NOW HAS DUAL PURPOSE; ADDED
C NEAR( ,) AND IG TO CALL TO SMOTHG
C FEBRUARY 2018 GLAHN DEFINED NSTASV AND RESET NSTA
C APRIL 2019 GLAHN ADDED LNDSEA( ) TO IP18 PRINT AT
C 258, 259, 261
C APRIL 2019 GLAHN MOD TO LIMIT SETGPT AND SMOTHG
C FOLLOWING SPOTRM TO THE LAST PASS
C APRIL 2019 GLAHN CHANGED TO VERIFY ONLY LAND
C STATIONS WHEN ILS NE 0
C APRIL 2019 GLAHN CORRECTED COMMENT ABOUT N4P
C APRIL 2019 GLAHN ADDED ISQ, XDATSV( ); ANALYZED
C SQRT OF CEILING
C APRIL 2019 GLAHN ADDED NPASRR TO CALL; ADDED CAPABILITY
C TO SWITCH BACK TO VARIABLE RADII AFTER
C SWITCHING TO FIXED RADII
C APRIL 2019 GLAHN ADDED PREPRO,NOPRE TO CALL
C MAY 2019 GLAHN ADDED NBASTA TO CALL TO CORBC5
C PURPOSE
C TO DO A BERGTHORSSEN-CRESSMAN-DOOS SUCCESSIVE
C APPROXIMATION ANALYSIS ON A SCALAR FIELD. ADAPTED FROM
C IBM 360/195 M400. THE VARIABLES HANDLED ARE SPECIFIED
C IN A TABLE IN THE CALLING PROGRAM, U405A. SURFACE WINDS
C CAN BE USED IN SEA LEVEL PRESSURE ANALYSIS (NOT YET
C IMPLEMENTED). OUTPUT IS IN MB FOR PRESSURE AND DEG
C FAHRENHEIT FOR TEMPERATURE. THE NX BY NY ANALYSIS IS
C RETURNED IN P( ).
C
C "DISPOSABLE" OR "SUBSETTED" GRIDS, DIMENSIONS IN IOPT( ),
C CAN BE CREATED FOR (1) GRIDPRINTING AND WRITING TO UNIT
C NO. IP22 AND/OR (2) TDLPACKING AND WRITING TO UNIT
C NO. KFILOG. THESE GRIDS CAN BE USED FOR CHECKOUT AND
C QUALITY CONTROL. THE CAPABILITY PERTAINS TO EACH PASS
C AND TO BOTH UNSMOOTHED AND SMOOTHED GRIDS. WHEN
C IOPT(1) = 0, THERE IS NO SUBSET AREA AND SOME COMPUTATIONS
C ARE BYPASSED.
C
C BCD5 AND THE CALLED ESP5 DEPEND ON IVRBL BEING 1 FOR
C SEA LEVEL PRESSURE AND 4 FOR SATURATION DEFICIT. OTHER
C NUMBERS ARE FLEXIBLY USED.
C
C THE OUTPUT GRIDS FROM BCD5 ARE AT THE CURRENT MESH LENGTH
C MESH. WHEN A GRID HAS BEEN CLIPPED TO A LARGER MESH
C LENGTH IN FSTGS5 THAN MESH, THE AREA COVERED WITH
C NON-MISSING DATA MAY BE SLIGHTLY GRATER THAN THE DESIRED
C AREA AT MESH LENGTH MESH.
C
C ORIGINALLY, THE SMOOTHING OF LAND WAS LINKED WITH
C WATER. IN JULY 2018, IT WAS DESIRED TO SMOOTH LAND BUT
C NOT WATER, SO THE SPOTRM PARAMETER NSMNUM WAS GIVEN
C TRIPLE DUTY SO THAT OCEAN AND LAKE (SEPARATELY) COULD BE
C NOT SMOOTHED WHEN LAND WAS. NOTE THAT THIS ASSUMES
C SPOTRM IS BEING CALLED.
C
C FATAL ERRORS, IER:
C AT 173.
C
C DATA SET USE
C KFILDO - UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT)
C KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT
C OUTPUT. (OUTPUT)
C KFILRA(J)- HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000
C EXTERNAL RANDOM ACCESS FILES (J=1,6). (INPUT)
C KFILOV - UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING
C ALL OBS EXCEPT THOSE TOSSED OR QUESTIONABLE
C OBS AS MISSING. (OUTPUT)
C KFILQC - UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING
C QUALITY CONTROLLED OBS AFTER THE FINAL ANALYSIS
C PASS. (OUTPUT)
C IP14 - UNIT NUMBER FOR LISTING COMPUTED LAPSE
C RATES AND PROBLEMS WITH LAPSE RATES. (OUTPUT)
C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS
C WRITTEN TO THE SEQUENTIAL FILE. (OUTPUT)
C IP17 - UNIT NUMBER FOR LISTING OF STATIONS, THEIR
C X/Y POSITIONS, THEIR DATA VALUES, AND LTAGS.
C (OUTPUT)
C IP18 - UNIT NUMBER FOR LISTING OF STATIONS,
C THEIR X/Y POSITIONS, DATA VALUES, LTAGS,
C UNSMOOTHED ANALYSIS (INTERPOLATED) VALUES, AND
C DIFFERENCES BETWEEN THE DATA AND THE UNSMOOTHED
C ANALYSIS VALUES FOR THE WHOLE ANALYSIS AREA. ALSO
C USED IN PACKV FOR LISTING OF DATA WRITTEN.
C (OUTPUT)
C IP19 - UNIT NUMBER FOR LISTING OF STATIONS, THEIR
C X/Y POSITIONS, DATA VALUES, LTAGS,
C SMOOTHED ANALYSIS (INTERPOLATED) VALUES, AND
C DIFFERENCES BETWEEN THE DATA AND THE ANALYSIS
C VALUES FOR THE WHOLE ANALYSIS AREA FOR EACH
C PASS ON WHICH SMOOTHING IS DONE. (OUTPUT)
C IP20 - UNIT NUMBER FOR LISTING OF STATIONS, THEIR
C X/Y POSITIONS, DATA VALUES, LTAGS, UNSMOOTHED
C ANALYSIS (INTERPOLATED) VALUES, AND DIFFERENCES
C BETWEEN THE DATA AND THE UNSMOOTHED ANALYSIS
C VALUES FOR THE ANALYSIS AREA. ALSO, WHEN
C THERE IS A SUBSETTED AREA, THE MEAN ABSOLUTE
C DIFFERENCE BETWEEN THE UNSMOOTHED ANALYSIS
C AND THE DATA. (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 OVER THE
C WHOLE AREA. ALSO USED IN ESP5 TO LIST
C STATIONS TOSSED ON THE LAST PASS. (OUTPUT)
C IP22 - UNIT NUMBER FOR GRIDPRINTING. (OUTPUT)
C
C VARIABLES
C KFILDO = UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT)
C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT
C OUTPUT. THIS IS FOR DIFFERENT PASSES OF THE
C ANALYSES AND THEIR SMOOTHINGS. (INPUT)
C KFILRA(J) = HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000
C EXTERNAL RANDOM ACCESS FILES (J=1,6).
C THE ACCESS ROUTINES ALLOW 6 RANDOM ACCESS
C FILES. HOWEVER, IT UNLIKELY U155 WILL NEED
C MORE THAN 1 OR 2.
C RACESS(J) = THE FILE NAMES CORRESPONDING TO KFILRA(J)
C (J=1,6). (CHARACTER*60)
C NUMRA = THE NUMBER OF UNIT NUMBERS IN KFILRA( ) AND
C NAMES IN RACESS( ).
C KFILOV = UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING
C ALL OBS EXCEPT THOSE TOSSED OR QUESTIONABLE
C OBS AS MISSING. (INPUT)
C KFILQC = UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING
C QUALITY CONTROLLED OBS AFTER THE FINAL ANALYSIS
C PASS. (OUTPUT)
C IP14 = UNIT NUMBER FOR LISTING COMPUTED LAPSE
C RATES AND PROBLEMS WITH LAPSE RATES. (INPUT)
C IP16 = INDICATES WHETHER (>0) OR NOT (=0)
C A STATEMENT WILL BE OUTPUT TO IP(16)
C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH
C PAWGTS. (INPUT))
C IP17 = UNIT NUMBER FOR LISTING OF STATIONS, THEIR
C X/Y POSITIONS, THEIR DATA VALUES, AND LTAGS.
C (INPUT)
C IP18 = UNIT NUMBER FOR LISTING OF STATIONS, THEIR
C X/Y POSITIONS, DATA VALUES, LTAGS,
C UNSMOOTHED ANALYSIS (INTERPOLATED) VALUES, AND
C DIFFERENCES BETWEEN THE DATA AND THE ANALYSIS
C VALUES FOR THE WHOLE ANALYSIS AREA. ALSO USED
C IN PACKV FOR LISTING OF DATA WRITTEN TO THE
C RESOLUTION PACKED. ALSO, SEE IP20. (INPUT)
C IP19 = UNIT NUMBER FOR LISTING OF STATIONS, THEIR
C X/Y POSITIONS, DATA VALUES, LTAGS,
C SMOOTHED ANALYSIS (INTERPOLATED) VALUES, AND
C DIFFERENCES BETWEEN THE DATA AND THE ANALYSIS
C VALUES FOR THE WHOLE ANALYSIS AREA FOR EACH
C PASS ON WHICH SMOOTHING IS DONE. (INPUT)
C IP20 = UNIT NUMBER FOR LISTING OF STATIONS, THEIR
C X/Y POSITIONS, DATA VALUES, LTAGS, UNSMOOTHED
C ANALYSIS (INTERPOLATED) VALUES, AND DIFFERENCES
C BETWEEN THE DATA AND THE UNSMOOTHED ANALYSIS
C VALUES FOR THE ANALYSIS AREA. ALSO, WHEN
C THERE IS A SUBSETTED AREA, THE MEAN ABSOLUTE
C DIFFERENCE BETWEEN THE UNSMOOTHED ANALYSIS
C AND THE DATA.
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 FOR THE
C WHOLE ANALYSIS AREA. ALSO USED IN ESP5 TO
C LIST STATIONS TOSSED ON THE LAST PASS.
C (INPUT)
C IP22 = UNIT NUMBER FOR WRITING GRIDPRINTED UNSMOOTHED
C AND SMOOTHED ANALYSES OVER SUBSETTED AREA.
C (INPUT)
C I405ADG = 1 = DIAGNOSTIC PRINT TO KFILDO;
C 0 OTHERWISE. (INTERNAL)
C ID(J) = 4 WORD ID OF VARIABLE BEING ANALYZED.
C COMES FROM ITABLE( ,2, ) IN U405A. (INPUT)
C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE
C PREDICTOR ID'S CORRESPONDING TO ID( ,N)
C (J=1,15), (N=1,ND4).
C J=1--CCC (CLASS OF VARIABLE),
C J=2--FFF (SUBCLASS OF VARIABLE),
C J=3--B (BINARY INDICATOR),
C J=4--DD (DATA SOURCE, MODEL NUMBER),
C J=5--V (VERTICAL APPLICATION),
C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY
C 1 LAYER),
C J=7--LTLTLTLT (TOP OF LAYER),
C J=8--T (TRANSFORMATION),
C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK
C IN TIME),
C J=10--OT (TIME APPLICATION),
C J=11--OH (TIME PERIOD IN HOURS),
C J=12--TAU (PROJECTION IN HOURS),
C J=13--I (INTERPOLATION TYPE),
C J=14--S (SMOOTHING INDICATOR), AND
C J=15--G (GRID INDICATOR).
C (INPUT)
C JP(J,N) = INDICATES WHETHER A PARTICULAR VARIABLE N MAY
C HAVE GRIDPRINTS (J=1), INTERMEDIATE TDLPACK
C OUTPUT (J=2), OR PRINT OF VECTOR RECORDS IN
C PACKV (J=3) (N=1,ND4). PACKV IS FOR THE
C DATA SHOWING T0SSED DATA AS MISSING AND
C QUESTIONABLE DATA AS MISSING. THIS IS
C AN OVERRIDE FEATURE FOR THE PARAMETERS FOR
C GRIDPRINTING AND TDLPACKING IN EACH VARIABLE'S
C CONTROL FILE. (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 MODNO = OUTPUT MODEL NUMBER. (INPUT)
C ISCALD = DECIMAL SCALING FOR TDLPACKING. (INPUT)
C JFIRST = USED IN ESP5 VIA BCD5 TO CONTROL PRINTING.
C THIS IS SPECIFIC TO THE VARIABLE BEING
C ANALYZED. (INPUT/OUTPUT)
C NDATE = DATE/TIME, YYYYMMDDHH. THIS IS THE ANALYSIS
C RUN TIME, INCLUDING HH. (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 XDATA(K) = DATA TO ANALYZE (K=1,NSTA). (INPUT)
C CCALL(K) = STATION CALL LETTERS (K=1,NSTA). (CHARACTER*8)
C (INPUT)
C NAME(K) = NAMES OF STATIONS (K=1,NSTA). (CHARACTER*20)
C (INPUT)
C XP(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON
C THE ANALYSIS GRID AREA AT THE CURRENT GRID MESH
C LENGTH MESH. (INPUT)
C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON
C THE ANALYSIS GRID AREA AT THE CURRENT GRID MESH
C LENGTH MESH. (INPUT)
C XYP(K,J) = XYP(1,1) EQUIVALENCED TO XP( ) IN DRIVER.
C XYP(1,2) EQUIVALENCED TO YP( ) IN DRIVER.
C (INPUT)
C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). (INPUT)
C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). (INPUT)
C XPL(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON
C THE ANALYSIS GRID AT THE MESH LENGTH MESHB.
C (INPUT)
C YPL(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON
C THE ANALYSIS GRID AT THE MESH LENGTH MESHB.
C (INPUT)
C XPE(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON
C THE ELEVATION GRID AT THE GRID MESH LENGTH
C MESHE. (INPUT)
C YPE(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON
C THE ELEVATION GRID AT THE GRID MESH LENGTH
C MESHE. (INPUT)
C SDATA(K) = WORK ARRAY (K=1,NSTA). (INTERNAL)
C TOSS(K) = CONTAINS TOSSED OBS (K=1,NSTA). ALL OTHER
C VALUES ARE 9999. (INTERNAL)
C QUEST(K) = CONTAINS QUESTIONABLE OBS (K=1,NSTA). ALL
C OTHER VALUES ARE 9999. QUESTIONABLE IS DEFINED
C AS NOT MEETING X PERCENT OF THE ERROR THRESHOLD,
C WHERE X IS HARDWIRED BY PASS. (INTERNAL)
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 = 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. (INPUT/OUTPUT)
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 ELEV(K) = ELEVATION OF STATIONS IN METERS (K=1,NSTA).
C (INPUT)
C QUALST(K) = THE QUALITY WEIGHTS TO APPLY FOR THIS VARIABLE
C (K=1,KSTA). (INTERNAL)
C LAPFG = 0 COMPUTE LAPSE FROM DATA
C 1 COMPUTE LAPSE FROM FIRST GUESS.
C 2 COMPUTE LAPSE FROM UPPER AIR DATA.
C 3 COMPUTE LAPSE FROM SURFACE AND UPPER AIR DATA.
C 4 USE LAPSE FROM PREVIOUS VARIABLE (E.G., TOTAL
C WIND FROM WIND SPEED)
C 5 A COMBINATION OF 0 AND 3 ABOVE.
C NOTE IT IS COMBINED WITH LAPUDB IN READING.
C (INPUT)
C XLAPSE(K) = CALCULATED LAPSE RATE IN UNITS OF THE VARIABLE
C BEING ANALYZED PER M (K=1,KSTA). THIS IS THE
C LAPSE TO USE, UNLESS LAPFG = 5, IN WHICH CASE
C THIS IS COMPUTED FROM SURFACE DATA AND ULAPSE( )
C IS CALCULATED FROM SURFACE AND UA DATA, AND
C THEY ARE TO BE COMBINED DEPENDING ON DISTANCE
C IN ELEVATION BETWEEN THE STATION AND THE
C GRIDPOINT BEING CORRECTED. (K=1,KSTA).
C ULAPSE(K) = LAPSE CALCULATED FROM SFC AND UA DATA (K=1,NSTA).
C LAPUDB = 0 ANY LAPSE WILL BE USED BOTH UP AND DOWN
C 1 LAPSE WILL BE USED ONLY IN AN UPWARD MANNER
C 2 LAPSE WILL BE USED ONLY IN A DOWNWARD MANNER
C THIS WAS ADDED TO KEEP WIND SPEED FROM BEING
C VERY LOW IN VALLEYS. (INPUT)
C TELL = LOWER THRESHOLD FOR WT TO BE USED WITH XLAPSE
C IN CORBC5. THE WEIGHT FOR ULAPSE IS 1-TELL.
C CALCULATED IN CLAPSE. (INTERNAL)
C TELH = HIGHER THRESHOLD FOR WT. (SEE TELL ABOVE)
C (INTERNAL)
C ATEL = CONSTANT FOR THE LINE. (SEE TELL ABOVE)
C (INTERNAL)
C BTEL = COEFFICIENT FOR THE LINE. (SEE TELL ABOVE)
C (INTERNAL)
C VRAD(K,L) = RADII OF INFLUENCE USED AS OVERRIDE TO U405.CN
C CONTROL FILE (K=1,NSTA) (L=1,6). NOTE THAT
C THIS APPLIES TO THE TOTAL RUN; ITS USE IS
C CONTROLLED BY IVRAD BY ELEMENT. (INPUT)
C NSTA = NUMBER OF POINTS FOR WHICH DATA ARE AVAILABLE.
C THIS CAN BE BOTH FROM STATION DATA AND FROM
C SAMPLING THE FIRST GUESS. (INPUT)
C NBASTA = THE NUMBER OF STATIONS BEFORE BOGUSG STATIONS
C ARE ADDED. (INPUT)
C ISETP = FLAG TO INDICATE WHETHER AFTER THE LAST PASS
C A GRIDPOINT WILL BE SET TO THE CLOSEST
C STATION (=2), TO A VALUE IN THE DIRECTION
C OF THE STATION VALUE BUT NOT CROSS AN INTEGER
C BOUNDARY (=1), OR NOT (=0). (THIS COULD BE
C PARTICULARIZED TO QUALITY OF DATA.) (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 4 = BOGUS DATA FROM BOGUSG
C 0 = EVERYTHING ELSE
C (INPUT)
C MTAGPT(K) = WHEN SPEED ANALYZED, LTAGPT( ) IS SAVED IN
C MTAGPT( ) (DONE IN AUGMT2) FOR USE IN TOTAL
C WIND (K=1NSTA). (INPUT)
C ILS = FLAG FOR HOW THE SEA/LAND CORRECTIONS ARE
C GOING TO BE MADE:
C 1 = LAND/WATER TREATED SEPARATELY;
C 0 = OTHERWISE. THIS OPERATES IN TANDOM WITH
C LNDWAT( , ), BUT ILS CAN OVERRIDE FOR EASY CHANGE.
C (INPUT)
C WTWTL = WEIGHTING FACTOR TO USE FOR OCEAN OR INLAND WATER
C POINTS OVER LAND WHEN ILS = 1. OCEAN POINTS
C NEVER AFFECT INLAND WATER. (INPUT)
C WTLTW = WEIGHTING FACTOR TO USE FOR LAND POINTS OVER
C OCEAN AND INLAND WATER WHEN ILS = 1. (INPUT)
C HGTTHA = ELEVATION DIFFERENCE IN M BETWEEN A STATION
C AND A GRIDPOINT WHICH MUST NOT BE EXCEEDED
C FOR THE STATION TO INFLUENCE THE GRIDPOINT.
C (INPUT)
C HGTTHB = ELEVATION DIFFERENCE IN M BETWEEN A STATION
C AND ANY (INTERPOLATED) POINT ON THE ELEVATION
C GRID BETWEEN THE STATION AND THE GRIDPOINT
C WHICH MUST NOT BE EXCEEDED FOR THE STATION
C TO INFLUENCE THE GRIDPOINT. (INPUT)
C P(J) = FIELD HOLDING FIRST GUESS AND ANALYSIS
C (J=1,NX*NY). (INPUT/OUTPUT)
C FD2(J) = WORK ARRAY FOR GRIDPRINTING (J=1,ND2X3).
C (INTERNAL)
C CORR(J) = CORRECTION FOR GRIDPOINT IX,JY (J=1,NX*NY).
C (INTERNAL)
C COUNT(J) = SUM OF WEIGHTS FOR GRIDPOINT IX,JY WHEN TYPE 3
C CORRECTION BEING MADE (J=1,NX*NY).
C (INTERNAL)
C NCOUNT(J) = COUNT OF STATIONS CORRECTING GRIDPOINT IX,JY
C (J=1,NX*NY) IN CORBC5. ALSO USED AS SCRATCH
C IN PACKV, SMOTHN, SOMTHC, AND PAWGTS.
C (INTERNAL)
C FD6(J) = WORK ARRAY (J=1,NX*NY). (INTERNAL)
C ND2X3 = SIZE OF FD2( ), P( ), CORR( ), COUNT( ), AND
C NCOUNT( ). (INPUT)
C NX = NUMBER OF GRIDPOINTS IN THE XI (LEFT TO RIGHT)
C DIRECTION AT CURRENT MESH LENGTH MESH.
C (INPUT/OUTPUT)
C NY = NUMBER OF GRIDPOINTS IN THE YJ (BOTTOM TO TOP)
C DIRECTION AT CURRENT MESH LENGTH MESH.
C (INPUT/OUTPUT)
C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C DATA(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL)
C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ).
C (INPUT)
C MINPK = MINIMUM GROUP SIZE WHEN PACKING THE DATA.
C (INPUT)
C TELEV(J) = THE TERRAIN ELEVATION FROM THE MOS-2000 EXTERNAL
C RANDOM ACCESS FILE (J=1,NXE*NYE). (INPUT)
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 CPNDFD(J) = THE NDFD MASK FROM THE MOS-2000 EXTERNAL
C RANDOM ACCESS FILE (J=1,NXE*NYE) AT NOMINAL
C MESHLENGTH MESHE. (INPUT)
C NXE = X-EXTENT OF TELEV( , ), SEALND( , ),
C SEALND( , ), AND CPNDFD( , ) AT MESH LENGTH
C MESHE. (INPUT)
C NYE = Y-EXTENT OF TELEV( , ), SEALND( , ),
C SEALND( , ), AND CPNDFD( , ) AT MESH LENGTH
C MESHE. (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 EMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHE.
C (INPUT)
C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4).
C (INTERNAL)
C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+).
C (INTERNAL)
C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12).
C (INTERNAL)
C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4).
C (INTERNAL)
C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND
C IS4( ). (INPUT)
C MD(J) = THE 4-WORD ID OF THE VECTOR DATA BEING
C ANALYZED (ITABLE(1,2,IVRBL) IN CALLING
C PROGRAM). (INPUT)
C IPLAIN(L,J) = 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN
C LANGUAGE DESCRIPTION OF THE VARIABLE.
C NOTE THAT THIS REQUIRES TWO 32-BIT WORDS TO HOLD
C THE DESCRIPTION BUT ONLY ONE 64-BIT WORD.
C EQUIVALENCED TO PLAIN( ) IN DRU150.
C PLAIN = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLE
C IN ID( ). EQUIVALENCED TO IPLAIN( , ) IN
C DRU150. (CHARACTER*32)
C PLAINT = THE PLAIN LANGUAGE DESCRIPTION TO FURNISH TO
C GTHRES. THIS IS FOR DISTANCE GRID IN SPOTRM.
C EQUIVALENCED TO IPLANT.
C PLANT(L,J) = 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN
C LANGUAGE DESCRIPTION OF VARIABLES TO FURNISH TO
C GTHRES. THIS IS FOR TERRAIN OR SEA/LAND MASK.
C EQUIVALENCED TO PLAINT.
C NAREA = THE AREA OVER WHICH THE ANALYSIS IS MADE:
C 1 = CONUS,
C 2 = ALASKA,
C 3 = HAWAII,
C 4 = PUERTO.
C ALATL = NORTH LATITUDE OF LOWER LEFT CORNER POINT
C OF A GRID OF THE SIZE NXL, NYL. TRUNCATED
C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE
C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF
C DEGREES. (INPUT)
C ALONL = WEST LONGITUDE OF LOWER LEFT CORNER POINT
C OF A GRID OF THE SIZE NXL, NYL. TRUNCATED
C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE
C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF
C DEGREES. (INPUT)
C NPROJ = NUMBER OF MAP PROJECTION TO WHICH THIS GRID
C APPLIES.
C 3 = LAMBERT.
C 5 = POLAR STEREOGRAPHIC.
C 7 = MERCATOR.
C (INPUT)
C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. (INPUT)
C MESH = THE NOMINAL MESH LENGTH OF THE CURRENT GRID.
C INITIALLY SET IN FSTGS5 FROM U405A.CN FILE
C MSHPAS( , ). (INPUT/OUTPUT)
C MESHB = THE NOMINAL MESH LENGTH OF THE ANALYSIS GRID.
C 1/4 BEDIENT AT 60 N IS 95.25 KM WHICH IS ABOUT
C 80 KM OVER THE U.S. MESH = 80 CORRESPONDS TO
C 95.25 STORED WITH THE GRIDS. NXL, NYL, ETC.
C ARE IN RELATION TO THIS.
C MESHL = NOMINAL MESH LENGTH OF QUALITY CONTROL
C (SUBSETTED) GRID FOR CONTINUOUS VARIABLES.
C (INPUT)
C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED
C IN DEGREES. (INPUT)
C MSHPAS(J) = THE NOMINAL MESH LENGTH FOR EACH PASS
C (J=1,NPASS) FOR THE GUESS OPTION BEING USED.
C (INPUT)
C ER1(J) = ERROR CRITERIA FOR PASS (J=1,NPASS).
C IF OBSERVATION IS DIFFERENT FROM CURRENT
C ANALYSIS BY MORE THAN ER1( ), IT IS
C PROBABLY NOT USED ON THIS PASS. HOWEVER,
C BEFORE A DATUM IS DISCARDED, A BUDDY CHECK
C IS MADE. ALSO IF ER1(J) = 0, IT MEANS CHECK
C IS NOT PERFORMED ON THIS PASS. (INPUT)
C NTYPE(J) = TYPE OF CORRECTION FOR PASS J (J=1,NPASS).
C 0 MEANS SKIP THIS PASS
C 1 MEANS W = 1
C 2 MEANS W = (R**2 - D**2)/(R**2 + D**2)
C 3 MEANS SAME AS 2 EXCEPT SUM OF WEIGHTS IN
C DENOMINATOR. (INPUT)
C B(J) = SMOOTHING PARAMETER FOR PASS J (J=1,NPASS).
C B( ) = 0 MEANS NO SMOOTHING. (INPUT)
C CSTSM = THE SMOOTHING PARAMETER IF ANY POINT HAS WATER
C BUT NOT ALL ARE WATER. USE INSTEAD OF BQ.
C (INPUT)
C R(J) = RADIUS OF INFLUENCE FOR PASS J IN GRID UNITS
C (J=1,NPASS). NOTE THAT THE ACTUAL DISTANCE
C DEPENDS ON MESH. (INPUT)
C RSTAR(J) = MULTIPLICATIVE FACTOR TO USE WITH R(J) IN
C DETERMINING HOW FAR OUTSIDE GRID TO USE DATA.
C FOR PASS J, PROGRAM WILL USE DATA R(J)*RSTAR(J)
C GRID UNITS OUTSIDE GRID. (INPUT)
C LNDWAT(J) = FLAG FOR EACH PASS (J=1,NPASS) TO DETERMINE
C HOW THE SEA/LAND CORRECTIONS WILL BE MADE.
C 0 = DON'T USE THE DIFFERENCES FEATURE; ALL DATA
C WILL BE USED FOR ALL POINTS.
C 1 = USE THE DIFFERENCE FEATURE. SEE LNDSEA( ).
C 2 = OCEAN POINTS WILL NOT BE CHANGED.
C 3 = NEITHER OCEAN NOR INLAND WATER POINTS WILL
C BE CHANGED.
C (INPUT)
C ITRPLQ(J) = TYPE OF INTERPOLATION TO GO FROM ONE MESH
C LENGTH TO ONE OF HALF THAT FOR EACH PASS J
C (J=1,NPASS).
C 1 = BILINEAR
C 2 = BIQUADRATIC
C (INPUT)
C IALGOR(J) = TYPE OF CORRECTION ALGORITHM TO APPLY FOR EACH
C PASS (J=1,NPASS).
C 1 = NORMAL TERRAIN
C 2 = DISTANCE WEIGHTED TERRAIN
C (INPUT)
C ELCORR(J) = FRACTION OF THE ELEVATION CORRECTION TO
C APPLY FOR EACH PASS (J=1,NPASS). (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),
C +2 = SAME AS 1, BUT DON'T APPLY DOWNWARD,
C -1 = APPLY TO NEGATIVE LAPSES (NEGATIVE IS ODD
C FOR SNOW),
C -2 = SAME AS -1, BUT DON'T APPLY DOWNWARD, AND
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. KFILLP IS THE FILE FOR READING
C PAIRS TO COMPUTE LAPSE.)
C (INPUT)
C BK(J) = THE MAXIMUM RADII IN GRIDPOINTS FOR WHICH
C THE LAPSE RATES INDICATED BY IBKPN ARE USED
C FOR EACH PASS J (J=1,NPASS). (INTERNAL)
C ELCORU(J) = FRACTION OF THE ELEVATION CORRECTION TO
C APPLY FOR EACH PASS (J=1,NPASS) FOR THE
C "UNUSUAL" LAPSE RATE (THE ONE WITH THE SIGN
C SPECIFIED IN IBKPN. (INPUT)
C IFCOR(J) = CORRECTION FLAG FOR EACH PASS J (J=1,NPASS)).
C 0 = IFULL( , ) IS NOT USED IN CORRECTIONS,
C 1 = IFULL( , ) USED FOR + OR - CORRECTIONS,
C 2 = IFULL( , ) USED TO EMPHASIZE HIGH WINDS.
C THIS IS FOR WHEN MESONET OR OTHER DATA WITH
C LESS RELIABILITY THAN METAR ARE TO NOT CARRY
C AS MUCH WEIGHT. READ AS PART OF NTYPE( , )
C (INPUT)
C RWATO(J) = FACTOR BY WHICH TO INCREASE THE RADIUS FOR
C OCEAN WATER POINTS (J=1,NPASS). (INPUT)
C RWATI(J) = FACTOR BY WHICH TO INCREASE THE RADIUS FOR
C INLAND WATER POINTS (J=1,NPASS). (INPUT)
C IVRAD = CONTROLS HOW VRAD( ) AND THE RADII R( , )
C ARE USED.
C 0 = USE R( , ) NORMALLY.
C 1 = USE VRAD( , ) OVERRIDE.
C THIS IS READ IN U405A .CN FILE, BUT CAN BE
C MODIFIED IN BCD5 WHEN NPASSF IS IN THE RANGE
C 1 THROUGH NPASS. (INPUT/OUTPUT)
C TLOD(J) = LOW THRESHOLD FOR DISPOSABLE GRIDS (J=1,3).
C WHEN A LAST PASS GRIDPOINT IS
C LT TLOD, IT IS SET TO SETLOD. (INPUT)
C SETLOD(J) = SEE TLOD (J=1,3). (INPUT)
C THID(J) = HIGH THRESHOLD FOR DISPOSABLE GRIDS (J=1,3).
C WHEN A LAST PASS GRIDPOINT IS
C GT THID, IT IS SET TO SETHID. (INPUT)
C SETHID(J) = SEE THID (J=1,3). (INPUT)
C CONSTD(J) = ADDITIVE CONSTANT TO FURNISH TO THRESHOLDING
C AND SCALING SUBROUTINE FOR DISPOSABLE GRIDS
C (J=1,3). (INPUT)
C NSCALD(J) = SCALING CONSTANT TO FURNISH TO THRESHOLDING
C AND SCALING SUBROUTINE FOR DISPOSABLE GRIDS
C (J=1,3). (INPUT)
C EX1D(J) = EXTRA PARAMETER FOR DISPOSABLE GRIDS NOT YET
C USED FOR THRESHOLDING (J=1,3). (INPUT)
C EX2D(J) = EXTRA PARAMETER FOR DISPOSABLE GRIDS NOT YET
C USED FOR THRESHOLDING (J=1,3). (INPUT)
C IALOC(J) = LOCATIONS IN CCALL( , ) OF THE PAIRED STATIONS
C (J=1,ND13), NOALOC(K) VALUES FOR EACH STATION K
C (K=1,LSTA). (INPUT)
C ADIST(J) = DISTANCES OF BASE STATION OF THE PAIRED STATIONS
C (J=1,ND13), NOALOC(K) VALUES FOR EACH STATION K.
C (INPUT)
C AELEV(J) = ELEVATION DIFFERENCES OF BASE STATION OF THE
C PAIRED STATIONS (J=1,ND13), NOALOC(K) VALUES
C FOR EACH STATION K. (INPUT)
C ND13 = MAXIMUM TOTAL PAIRS OF STATIONS. DIMENSION OF
C IALOC( ), ADIST( ), AND AELEV( ). (INPUT)
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 NSHLN(J) = DETERMINES SMOOTHING AT HIGH AND LOW ELEVATIONS.
C A 1 INDICATES:
C J=1--HIGH ELEVATION, HIGH VALUE SMOOTHED.
C J=2--HIGH ELEVATION, LOW VALUE SMOOTHED.
C J=3--HIGH ELEVATION, NOT HIGH OR LOW VALUE
C SMOOTHED.
C J=4--LOW ELEVATION, HIGH VALUE SMOOTHED.
C J=5--LOW ELEVATION, LOW VALUE SMOOTHED.
C J=6--LOW ELEVATION, NOT HIGH OR LOW VALUE
C SMOOTHED.
C A 0 INDICATES NO SMOOTHING FOR THE VALUES OF J.
C (INPUT)
C ICUB = = 0, USE WT=(R**2-DIST**2)/(R**2+DIST**2)
C = 1, USE WT=[(R**3-DIST**3)/(R**3-DIST**3)]**2
C (INTERNAL)
C NSMTYP = TYPE OF SMOOTHING:
C 0 = NONE
C 1 = NORMAL, 5-PT
C 2 = SAME EXCEPT NO CHANGE IS MADE UNLESS ONE
C OF THE POINTS TO CONTRIBUTE TO THE NEW
C VALUE HAS BEEN CHANGED.
C 3 = 9-POINT SMOOTHING USED ON LAST PASS ONLY,
C ANY OTHER PASS DEFAULTS TO NSMTYP = 2.
C 4 = USES SUBROUTINE SMOTHC FOR PASSES GE 4
C FOR SLP ONLY. FOR PASSES LT 4 OR NOT SLP,
C DEFAULTS TO NSMTYP = 2.
C 5 = SPECIAL TERRAIN-FOLLOWING SMOOTHING.
C 6 = TWO PASSES OF 5 ABOVE.
C 7 = THREE PASSES OF 5 ABOVE.
C 8 = HOLE FILLER RAY WITH SPOTRM
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 U405B AS
C WELL AS WIND SPEEDS LT WNDTHR. U( ) IS
C DIMENSIONED ND2X3 IN THE DRIVER DRU155, AND
C ND2X3 IS GUARANTEED TO BE GE ND1. (INPUT)
C V(K) = SAME AS U(K) EXCEPT FOR V-WINDS. (INPUT)
C WNDWT(J) = WEIGHT TO APPLY TO WIND OBS CORRECTIONS
C RELATIVE TO PRESSURE CORRECTIONS (J=1,6).
C THIS WILL BE ZERO FOR ALL EXCEPT PRESSURE
C ANALYSIS. (INPUT)
C WNDGRD = PARAMETER FOR CONVERTING WIND SPEED TO SLP
C GRADIENTS. (INPUT)
C WNDTHR = THRESHOLD TO USE FOR WIND SPEED FOR WIND TO BE
C USED IN ANALYSIS. FOR PRINTING ONLY. (INPUT)
C WNDTRN = DEGREES TO TURN SURFACE WIND BEFORE APPLYING
C GEOSTROPHIC CORRECTION. FOR PRINTING ONLY.
C (INPUT)
C NPRT(J) = 1 FOR PRINTING OF ANALYSIS AFTER PASS J
C (J=1,6).
C 0 FOR NO PRINTING. (INPUT)
C JPRT(J) = SAME AS NPRT(J) EXCEPT FOR SMOOTHED ANALYSIS.
C (INPUT)
C NTDL(J) = 1 FOR TDLPACKING AND WRITING SUBSETTED
C UNSMOOTHED ANALYSIS AFTER PASS J (J=1,NPASS).
C ZERO FOR NO WRITING. (INPUT)
C JTDL(J) = SAME AS ABOVE EXCEPT FOR SMOOTHED ANALYSIS.
C (INPUT)
C NPASS = NUMBER OF PASSES TO PERFORM FOR VARIABLE.
C (INPUT)
C NREPNO = NUMBER OF TIMES TO REPEAT ANALYSIS WHEN SOME
C DATA HAVE BEEN TOSSED ON THE LAST PASS.
C (INPUT)
C NREP = PASS NUMBER TO START REPEAT (SEE NPRENO
C ABOVE). (INPUT)
C MGUESS = THE TYPE OF FIRST GUESS ACTUALLY USED.
C 1 = CONSTANT.
C 2 = PRIMARY GRID (E.G., A MOS FORECAST).
C 3 = ALTERNATE GRID.
C 4 = AVERAGE OF OBSERVATIONS.
C (INPUT)
C ERRADJ = THROWOUT ADJUSTMENT. NORMALLY = 1. FOR AUGMTX,
C CAN BE USED TO ADJUST THROWOUT BASED ON TYPE OF
C DATA (OCEAN, LAKE, LAKE/LAND, OR LAND). IN ESP5.
C HAS BEEN IMPLEMENTED FOR AUGMT2. (INPUT)
C NPASSP = THE NUMBER OF THE PASS TO START SPOTRM. (INPUT)
C NPASSF = THE NUMBER OF THE PASS TO TAKE
C A SPECIFIC ACTION, LIKE INTERPOLATING INTO
C THE CURRENT ANALYSIS TO GET STABLIZING
C VALUES FOR THE SUBSEQUENT PASSES. A VALUE OF
C ZERO WILL BE TREATED AS A NOP. (INPUT)
C NSMN = SERVES TRIPLE PURPOSE. CONSIDER IT COMPOSED OF
C XYZZ, WHERE:
C X = 1 IF THE OCEAN PONTS ARE NOT TO BE SMOOTHED,
C Y = 1 IF THE LAKE POINTS ARE NOT TO BE SMOOTHED,
C ZZ =THE NUMBER OF CALLS TO SMOTHG AFTER SPOTRM.
C TAKEN FROM SPOTRM CONTROL PARAMETERS. THIS WAS
C THE ORIGINAL PURPOSE OF NSMNUM. (INPUT)
C NPASRR = THE NUMBER OF THE PASS TO USE THE INTERNALLY
C COMPUTED RADII BASED ON THE CLOSEST STATION.
C (INPUT)
C NPASSR = THE NUMBER OF THE PASS TO SWITCH FROM VARIABLE
C RADII TO CONSTANT RADII, UNLESS NPASSR EQ 0.
C (INPUT)
C IORST = 1 WHEN ORSMTW IS TO BE CALLED, AND SMOTHG IS
C TO BE CALLED BEFORE THE CORRECTIONS ON THE LAST
C PASS. 0 OTHERWISE. THE PURPOSE IS TO SMOOTH
C THE OCEAN WITH A 9-POINT SMOOTHER IN ORDER TO
C FORCE A CORRECTION AT AND AROUND A MAX OR MIN
C DATUM VALUE. (INPUT)
C NCLIP = 1 TO CLIP OUTPUT TO NDFD MASK; =0 OTHERWISE.
C (INPUT)
C PREPRO(J) = NAME OF PREPROCESSING ROUTINES (J=1,NPRE).
C (CHARACTER*6) (INTERNAL)
C NOPRE = NUMBER OF ENTRIES IN PREPRO( ) AND ASSOCIATED
C VARIABLES. (INTERNAL)
C NOPTN = INDICATES OPTION FOR WHICH DATA TO SMOOTH OUT
C IN SPOTRM. COMES FROM U405A.CN IN CALL TO
C SPOTRM CONST( ).
C 1 = SMOOTH OUT BOGUS ONLY
C 2 = SMOOTH OUT BOGUS AND 2ND LEVE AUGMENTATION.
C 3 = SMOOTH OUT BOGUS AND ALL AUGMENTATION
C 4 = KEEP ALL.
C INCOMING IS RIGHTMOST 2 DIGITS. ISETG*100 IS
C ALSO PART OF INCOMING, AND IS SEPARATED OUT.
C (INPUT)
C DIFFA = THE MAXIMUM DIFFERENCE IN ELEVATION IN METERS
C BETWEEN THE GRIDPOINT BEING SMOOTHED AND THE
C GRIDPOINT USED IN SMOOTHING. USED IN SPOTRM.
C NOCEAN = TAKES ONE OF 4 VALUES DEPENDING ON HOW THE
C OCEAN TYPE OF STATION AFFECTS THE TYPE OF
C GRIDPOINT. (INPUT)
C LAKE = TAKES ONE OF 4 VALUES DEPENDING ON HOW THE
C LAKE TYPE OF STATION AFFECTS THE TYPE OF
C GRIDPOINT. (INPUT)
C DISTX = VALUE TO MULTIPLY BY RMAX IN SPOTRM = R(1)
C IN U405A.CN TO SEARCH FOR CLOSEST STATION
C (INPUT)
C DPOWER = THE POWER OF THE DISTANCE TO USE IN WEIGHTING.
C (INPUT)
C WTAUG = THE WEIGHT OF THE AUGMENTING DATA. THIS WAS
C SET UP TO USE WITH AUGMT3, BUT COULD BE USED
C WITH OTHER AUGMENTING ROUTINES. INITIALIZED
C TO 1. SO UNLESS SET OTHERWISE, AUGMENTING
C AND BOGUS DATA WILL BE USED FULL FORCE.
C (INPUT)
C RAY = THE MULTIPLIER OF THE DISTANCE TO THE CLOSEST
C STATION TO USE AS THE RADIUS OF THE SMOOTHING
C CIRCLE (OR MAJOR AXIS OF ELIPSE). (INPUT)
C LH = SWITCH (=1) TO INDICATE TO SPORTM TO ASSURE
C LOW VALUES ARE IN VALLEYS AND HIGH VALUES ARE
C IN HIGH ELEVATIONS. (INPUT)
C CINT(J) = THE CONTOUR INTERVAL WHEN GRIDPRINTING, APPLIES
C TO THE UNITS IN UNITS(N) (J=1,NPASS).
C (INTERNAL)
C ORIGIN(J) = THE CONTOUR ORIGIN WHEN GRIDPRINTING, APPLIES
C TO THE UNITS IN UNITS(N) (J=1,NPASS).
C (INTERNAL)
C SMULT(J) = THE MULTIPLICATIVE FACTOR WHEN CONTOURING OR
C GRIDPRINTING THE DATA (J=1,NPASS).
C NOTE SMULT( ), SADD( ), ORIGIN( ), CINT( ),
C AND UNITS( ), ALTHOUGH NAMED THE SAME AND
C PLAYING THE SAME ROLE IN GRIDPRINTING, ARE
C NOT THE SAME VARIABLES AS IN THE CALLING
C PROGRAM; THEY ARE FILLED HERE AND PERTAIN
C TO EACH PASS. (INTERNAL)
C SADD(J) = THE ADDITIVE FACTOR WHEN CONTOURING OR
C GRIDPRINTING THE DATA (J=1,NPASS). (INTERNAL)
C TITLE = 40-CHARACTER TITLE FOR VARIABLE. (CHARACTER*40)
C (INPUT)
C IOPT(J) = SUBSETTING VALUES USED IN GRIDPRINTING (J=1,8).
C WHEN IOPT(1) = 0, SUBSETTING IS NOT DONE,
C STATISTICS ARE NOT CALCULATED, AND IP20 IS NOT
C USED. IOPT( ) IS IN RELATION TO THE SUBSETTED
C AREA MESH LENGTH MESHL.
C 1 - 0 OPTION TABLE NOT USED/1 USED.
C 2 - SUB ARRAY MIN IX VALUE.
C 3 - SUB ARRAY MAX IX VALUE.
C 4 - SUB ARRAY MIN JY VALUE.
C 5 - SUB ARRAY MAX JY VALUE.
C 6 - 1 IF ALL INTERPOLATION IS TO BE BILINEAR.
C OTHERWISE, INTERPOLATION IS TO BE
C BIQUADRATIC WHERE POSSIBLE.
C 7 - NOT USED.
C 8 - PAGE WIDTH IN GRID POINTS.
C (INPUT)
C POSTDS(J) = HOLDS NAME OF DISPOSABLE POSTPROCESSING ROUTINE
C (J=1,NOPROD). (CHARACTER*6) (INPUT)
C NOPROD = THE NUMBER OF ENTRIES IN POSTDS( ). (INPUT)
C JTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED
C WITH UNIT NO. KFILOG. (INPUT/OUTPUT)
C JTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT
C NUMBER KFILOG. (INPUT/OUTPUT)
C MTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED
C WITH UNIT NO. KFILOV. (INPUT/OUTPUT)
C MTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT
C NUMBER KFILOV. (INPUT/OUTPUT)
C ITOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED
C WITH UNIT NO. KFILQC.
C ITOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT
C NUMBER KFILQC.
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 L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING
C USED (EITHER 32 OR 64). (INPUT).
C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2).
C (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 IER = ERROR RETURN.
C 0 = GOOD RETURN.
C 777 = FATAL ERROR.
C (OUTPUT)
C LP = PASS NUMBER. (INTERNAL)
C BB = INTERPOLATED VALUE FROM SUBROUTINE INTR.
C (INTERNAL)
C ITAUH = PROJECTION OF FIELD IN HOURS. (INTERNAL)
C ITAUM = PROJECTION OF FIELD IN MINUTES. (INTERNAL)
C IOPTGR(J) = SUBSETTING VALUES USED IN DETERMINING WHETHER
C A POINT SHOULD BE INCLUDED IN SUMMING THE
C DIFFERENCES FOR THE SUBSETTED AREA (J=1,8).
C THESE ARE CALCULATED IN REFERENCE TO THE
C CURRENT GRID MESH BEING USED. (INTERNAL)
C NXD = THE X EXTENT OF THE DISPOSABLE GRID. (INTERNAL)
C NYD = THE Y EXTENT OF THE DISPOSABLE GRID. (INTERNAL)
C ALATD = LL LATITUDE OF THE DISPOSABLE GRID. TRUNCATED
C TO THOUSANDS TO AGREE WITH ARCHIVE WHEN THE
C GRIDS ARE THE SAME. THIS IS NECESSARY FOR
C U203 FOR GEMPAK. (INTERNAL)
C ALOND = LL LONGITUDE OF THE DISPOSABLE GRID. SEE ALATD.
C (INTERNAL)
C FRACT(J) = FRACTION QUEST( ) CRITERIA ARE OF ER1(J) (J=1,6).
C J = PASS. (INTERNAL)
C ER1Q = ERROR CRITERIA FOR THE CURRENT PASS FOR QUEST( ).
C ER1Q(LP)=ER1(LP)*FRACT(LP), WHERE LP IS THE
C PASS NUMBER. (INTERNAL)
C ISCALE = BINARY SCALING FACTOR, SET TO ZERO. (INTERNAL)
C XMISSP = PRIMARY MISSING VALUE FOR PACKING, SET = 9999.
C OR 0 DEPENDING ON USE. (INTERNAL)
C XMISSS = SECONDARY MISSING VALUE FOR PACKING, SET = 0.
C (INTERNAL)
C DIFMAX(M) = RANKED LARGEST ABSOLUTE DIFFERENCES BETWEEN AN
C ANALYSIS POINT AND THE INTERPOLATED VALUE OVER
C THE SUBSET AREA (M=1,3). (INTERNAL)
C STAMAX(M) = CALL LETTERS OF THE STATION ASSOCIATED WITH
C DIFMAX(M) (M=1,3). INTERNAL)
C NAMMAX(M) = NAME OF THE STATION ASSOCIATED WITH
C DIFMAX(M) (M=1,3). INTERNAL)
C IVRADS = HOLDS INCOMING IVRAD SO THAT IT CAN BE RESTORED
C UPON EXIT.
C NOPTNT = TEMPORARY VALUE OF NOPTN. (INTERNAL)
C GF = MULTIPLICATIVE FACTOR TO INCREASE ER1( ) WHEN
C THE ERROR IS POISITVE. ADDED FOR GUSTS SO
C THAT GUSTS CAN BE KEPT WITHOUT KEEPING ALL
C VERY SMALL VALUES. (INPUT)
C LAMPNO = 20 WHEN THIS IS LAMP TOTAL WIND (GUST) ANALYSIS;
C 0 OTHERWISE. THIS IS BASED ON A SPECIFIC
C ID = 224390005. (INTERNAL)
C KER = COUNTS ERRORS FOR RETURNING TO U405A.
C (INTERNAL)
C IZCHK = NORMALLY ZERO. SET TO 1 FOR OBS WIND SPEED AND
C OBS TOTAL WIND, AND FURNISHED TO ESP5.
C (INTERNAL)
C NOTSAV(J) = SAVES NOTOSS(J) UPON ENTRY FOR PRINT (J=1,2).
C (INTERNAL)
C LTOSS(J) = SAME AS NOTOSS(J) FOR THIS ELEMENT (J=1,2).
C ADDED TO IMPLEMENT THE REPEAT OPTION NREPNO.
C (INTERNAL)
C WFACT = THE FRACTION OF THE TOSS THRESHOLD TO USE FOR
C TOSSING DATA THAT ARE LOWER THAN THE CURRENT
C ANALYSIS; USED IN ESP5, FOR MOS WIND SPEED.
C (INTERNAL)
C JOCEAN = JOCEAN AND JLAKE PARSED FROM NSMN.
C 1 WHEN OCEAN IS NOT SMOOTHED;
C 0 OTHERWISE (DEFAULT)
C (INPUT)
C JLAKE = JOCEAN AND JLAKE PARSED FROM NSMN.
C 1 WHEN LAKES ARE NOT SMOOTHED;
C 0 OTHERWISE (DEFAULT)
C (INPUT)
C ISETG = INDICATES TO SETGPT HOW TO PREPARE GRID
C NEAR( , ) TO KEEP SMOTHG FROM SMOOTHING
C NEAR THE DATA POINTS. COMES IN AS PART OF
C NOPTN. (INTERNAL)
C NEAR(IX,JY) = EACH GRIDPOINT = 0 EXCEPT THE ONES TO NOT BE
C SMOOTHED (IX=1,NX) (JY=1,NY). SET IN SETGPT
C AND USED IN SMOTHG, FOLLOWING SPOTRM.
C (INTERNAL) (AUTOMATIC)
C NSTASV = NUMBER OF STATIONS SANS THE BOGUS VALUES
C PLACED AT GRIDPOINTS. (INTERNAL)
C ISQ = SWITCH TO INDICATE ANALYZING SQUARE ROOT OF
C ELEMENT (=1), ZERO OTHERWISE.
C XDATSV(K) = SAVES XDATA FOR RETURN (K=1,NSTA).
C 1 2 3 4 5 6 7 X
C
C NONSYSTEM SUBROUTINES CALLED
C TIMPR, ESP5, ITRP, PRTGR, SMOTH, SMOTHN, SMOTHC, SMTH9,
C SZGRDM, NEWXY1, CORBC5, TRNSFR, CUTIT, ACTUAL, ITRPSX,
C PSIJLL, LMIJLL, MCIJLL, PAWGTS, PRSID1, PACKV, SETPNT,
C POST
C
CHARACTER*6 POSTDS(NOPROD),PREPRO(NOPRE)
CHARACTER*8 CCALL(NSTA),STAMAX(3)
CHARACTER*8 SMTH/'SMOOTHD '/
CHARACTER*8 BLANK/' '/
CHARACTER*20 NAME(NSTA),NAMMAX(3)
CHARACTER*32 PLAIN,PLAINT
CHARACTER*40 TITLE
CHARACTER*60 RACESS(6)
C
DIMENSION XDATA(NSTA),XP(NSTA),YP(NSTA),XPL(NSTA),YPL(NSTA),
1 XPE(NSTA),YPE(NSTA),LTAG(NSTA),TOSS(NSTA),QUEST(NSTA),
2 U(NSTA),V(NSTA),LNDSEA(NSTA),ELEV(NSTA),
3 QUALST(NSTA),XLAPSE(NSTA),LTAGPT(NSTA),MTAGPT(NSTA),
4 ULAPSE(NSTA)
DIMENSION XDATSV(NSTA)
C XDATSV() ) IS AN AUTOMATIC ARRAY.
DIMENSION VRAD(ND1,6),XYP(ND1,2),SDATA(ND1),
1 STALAT(ND1),STALON(ND1)
DIMENSION P(ND2X3),CORR(ND2X3),COUNT(ND2X3),NCOUNT(ND2X3),
1 FD2(ND2X3),FD6(ND2X3)
DIMENSION NEAR(ND2X3)
C NEAR IS AN AUTOMATIC ARRAY.
DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5)
DIMENSION IPLAIN(L3264W,4),IPLANT(L3264W,4)
DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7)
DIMENSION IALOC(ND13),ADIST(ND13),AELEV(ND13)
DIMENSION TELEV(NXE*NYE),SEALND(NXE*NYE),CPNDFD(NXE*NYE)
DIMENSION SMULT(6),SADD(6),ORIGIN(6),CINT(6),
1 ER1(6),R(6),B(6),NTYPE(6),RSTAR(6),LNDWAT(6),
2 NPRT(6),JPRT(6),NTDL(6),JTDL(6),WNDWT(6),
3 MSHPAS(6),ITRPLQ(6),FRACT(6),IALGOR(6),ELCORR(6),
4 BK(6),ELCORU(6),RWATO(6),RWATI(6),IFCOR(6)
DIMENSION ID(4),IDPARS(15),LD(4),LDPARS(15),MD(4),NSHLN(6),
1 IOPT(8),IOPTGR(8),JDATE(4),JP(3),ISTOP(6),DIFMAX(3),
2 KFILRA(6)
DIMENSION TLOD(3),SETLOD(3),THID(3),SETHID(3),CONSTD(3),NSCALD(3),
1 EX1D(3),EX2D(3)
DIMENSION NOTOSS(2),NOTSAV(2),LTOSS(2)
C
DATA FRACT/.6, .6, .6, .6, .6, .6/
DATA ISCALE/0/
C
IER=0
KER=0
CALL TIMPR(KFILDO,KFILDO,'START BCD5 ')
C
C SEPARATE INCOMING NOPTN INTO NOPTNT AND ISETG.
C
ISETG=NOPTN/100
C ISETG IS USED IN SETGPT
NOPTNT=NOPTN-ISETG*100
C NOPTNT IS WHAT NOPNT WAS ORIBINALLY AND IS USED IN SPOTRM.
C
C PARSE NSMN INTO ITS THREE PARTS.
C
JOCEAN=NSMN/1000
JLAKE=NSMN/100-JOCEAN*10
NSMNUM=NSMN-JOCEAN*1000-JLAKE*100
C NSMNUM NOW HAS ITS ORIGINAL MEANING BEFORE VALUE IN CALL
C REPLACED NSMNUM BY NSMN.
C
CCCC WRITE(KFILDO,130)NPASS,NREP,NREPNO
CCCC 130 FORMAT(/' AT 130 IN BCD5--NPASS,NREP,NREPNO',3I6)
C
D WRITE(IP14,131)(K,CCALL(K),XDATA(K),LTAG(K),LTAGPT(K),QUALST(K),
D 1 VRAD(K,1),VRAD(K,6),K=1,NBASTA)
D131 FORMAT(' IN BCD5 AT 131--(K,CCALL(K),XDATA(K),LTAG(K),LTAGPT(K),',
D 1 'QUALST(K),VRAD(K,1),VRAD(K,6),K=1,NBASTA)',
D 2 I6,1X,A8,F8.2,2I6,3F12.3)
C ONLY THE BASE STATIONS, NBASTA, ARE WRITTEN.
C
C SAVE IVRAD SO THAT IT CAN BE RESTORED UPON EXIT. OTHERWISE,
C IF IVRAD IS CHANGED TO INDICATE A SWITCH FROM VARIABLE RADII
C TO CONSTANT RADII AND PROBABILITY LEVELS ARE BEING ANALYZED,
C ALL LEVELS AFTER THE FIRST WILL USE CONSTANT RADII FOR ALL
C PASSES.
IVRADS=IVRAD
C
C SAVE THE RUNNING NUMBERS OF TOSSED VALUES, SO THAT THE
C NUMBER TOSSED FOR THIS VARIABLE CAN BE PRINTED AT THE
C END.
C
NOTSAV(1)=NOTOSS(1)
NOTSAV(2)=NOTOSS(2)
C
C INITIALIZE THE PORTION OF IOPTGR( ) THAT DOES NOT CHANGE.
C WHEN THERE IS NO SUBSET AREA, IOPT(1) = IOPTGR(1) = 0.
C
IOPTGR(1)=IOPT(1)
IOPTGR(6)=IOPT(6)
IOPTGR(7)=IOPT(7)
IOPTGR(8)=IOPT(8)
C
C SET LAMPNO = 20 FOR LAMP TOTAL WIND (GUST) ANALYSIS;
C 0 OTHERWISE.
C
IF(ID(1).EQ.224390005)THEN
LAMPNO=20
ELSE
LAMPNO=0
ENDIF
C
LREPNO=0
C LREPNO IS THE NUMBER OF REPEATS DONE.
NSTASV=NSTA
C NSTASV SAVES NSTA IN CASE IT IS INCREASED IN THE LOOP.
C NSTA IS RESET AT THE END OF THE DO 300 LOOP.
C
C WHEN SQUARE FOOT OF ELEMENT IS BEING ANALYZED, COMPUTE
C SQUARE ROOT OF DATA IN XDATA( ), BUT SAVE XDATA( ) IN
C XDATSV( ) FOR RETURN. CONVERT FIRST GUESS IN P( ) TO
C SQUARE ROOT. THIS IS TRIGGERED BY A PREPROCESSING
C ROUTINE ELESQR.
C
ISQ=0
DO 140 NN=1,NOPRE
C
IF(PREPRO(NN).EQ.'ELESQR')THEN
ISQ=1
C ISQ SIGNALS SQUARE ROOT OR NOT.
WRITE(KFILDO,133)
133 FORMAT(/' ANALYSIS IS SQUARE ROOT OF VARIABLE.'/)
C
CALL TRNSFR(XDATA,XDATSV,NSTA)
C
DO 136 K=1,NSTA
C
IF(XDATA(K).LT.9998.5)THEN
XDATA(K)=SQRT(ABS(XDATA(K)))
C XDATA( ) SHOULD BE POSITIVE. THIS IS A SAFETY.
ENDIF
C
136 CONTINUE
C
DO 138 IXY=1,ND2X3
C
IF(P(IXY).LT.9998.5)THEN
P(IXY)=SQRT(ABS(P(IXY)))
C P( ) SHOULD BE POSITIVE. THIS IS A SAFETY.
ENDIF
C
138 CONTINUE
C
ENDIF
C
140 CONTINUE
C
C THIS IS THE LOOP FOR REPEATS. WHEN NREPNO = 0, LOOP
C IS EXECUTED ONLY ONCE.
C
DO 300 LPP=1,MAX(1,NREPNO)
C ALWAYS MAKE THE TRIP ONCE.
C
IF(LPP.EQ.1)THEN
ISTART=1
ELSE
ISTART=NREP
ENDIF
C
C DO NPASS PASSES FOR THE ANALYSIS. IF THIS IS A REPEAT,
C ISTART IS THE PASS TO START THE REPEAT.
C
DO 290 LP=ISTART,NPASS
C ALWAYS MAKE THE FULL TRIP ONCE, PARTIAL TRIP THEREAFTER.
C
D WRITE(KFILDO,1400)LP,ALATL,ALONL,MESHL,MESH,NX,NY,NSTA
D1400 FORMAT(/' AT 1400 IN BCD5--LP,ALATL,ALONL,MESHL,',
D 1 'MESH,NX,NY,NSTA',I4,2F10.5,4I6,I10)
C
WRITE(KFILDO,150)LP,TITLE,ER1(LP)
150 FORMAT(/' STARTING PASS',I3,' FOR ',A16,
1 ' ERROR CRITERION =',F8.2,15X,
2 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&')
C
CCCCD DO 154 K=1,NBASTA
CCCCC
CCCCD IF(LTAG(K).NE.0.AND.XDATA(K).LT.9998.)THEN
CCCCD WRITE(KFILDO,152)CCALL(K),XP(K),YP(K),XDATA(K),LTAG(K)
CCCCD152 FORMAT(' AT 152 IN BCD5--CCALL(K),XP(K),YP(K),XDATA(K),',
CCCCD 1 'LTAG(K) ',A8,2F8.2,F8.1,I6)
CCCCD ENDIF
CCCCC
CCCCD154 CONTINUE
C
LTOSS(1)=0
LTOSS(2)=0
C
IF(NREPNO.GT.0.AND.LREPNO.LT.NREPNO.AND.LP.EQ.NREP)THEN
C THIS SAVES THE CURRENT ANALYSIS IN P( ) WHEN IT MAY
C BE NEEDED TO START THE REPEAT ANALYSIS.
C
WRITE(KFILDO,155)
155 FORMAT(/' SAVING P( , ) IN FD6( , ).')
C
DO 156 J=1,NX*NY
FD6(J)=P(J)
156 CONTINUE
C
ENDIF
C
IF(NPASSR.NE.0.AND.LP.GE.NPASSR)THEN
C WHENEVER NPASSR GE LP, THE CONSTANT RADII ARE USED.
C IVRAD MAY ALREADY BE 0, BUT THAT IS OK. IT MAY BE
C THAT NPASSR HAS NOT BEEN SET IN U405A, SO IS THEN
C INOPERATIVE.
IVRAD=0
IF(NPASSR.EQ.LP)WRITE(KFILDO,165)NPASSR
165 FORMAT(/' SWITCHING TO CONSTANT RADII AT PASS NO.',I3,/)
C
IF(NPASRR.EQ.LP)THEN
IVRAD=1
WRITE(KFILDO,166)NPASRR
166 FORMAT(/' SWITCHING BACK TO VARIABLE RADII AT PASS NO.',I3/)
ENDIF
C
ENDIF
C**********************************TEMPORARY TO RESTART VARIABLE RADII
CCCCC IF(LP.EQ.NPASS.AND.LP.GE.NPASSR.AND.NPASSR.NE.0)THEN
CCCCC IVRAD=1
CCCCCC THIS SWITCHES BACK TO VARIABLE RADII ON THE LAST PASS.
CCCCC WRITE(KFILDO,165)NPASS
CCCCC 166 FORMAT(/' SWITCHING TO VARIABLE RADII AT PASS NO.',I3)
CCCCC ENDIF
C**************************** ******TEMPORARY
C
IF(NTYPE(LP).EQ.0)THEN
C EVEN THOUGH NPASS CAN BE AS HIGH AS 6, A PARTICULAR
C PASS IS SKIPPED IF NTYPE(LP) = 0.
WRITE(KFILDO,170)LP
170 FORMAT(/' ****THIS PASS =',I3,' BEING SKIPPED BECAUSE',
1 ' NTYPE(LP) = 0. MAY BE AN ERROR.')
ISTOP(1)=ISTOP(1)+1
GO TO 290
C
ELSEIF(MSHPAS(LP).EQ.0)THEN
C A MESH LENGTH OF 0 CANNOT BE ACCOMMODATED, SO SKIP
C THIS PASS.
WRITE(KFILDO,172)LP
172 FORMAT(/' ****THIS PASS =',I3,' BEING SKIPPED BECAUSE',
1 ' MSHPAS(LP) = 0. PROBABLY AN ERROR.')
ISTOP(1)=ISTOP(1)+1
GO TO 290
ENDIF
C
C AT THE BEGINNING OF EACH PASS, THERE IS A GRID IN P( )
C WITH DIMENSIONS NX, NY AND AT A MESH LENGTH OF MESH.
C MSHPAS(LP) CONTAINS THE MESH LENGTH TO USE FOR PASS LP.
C IF MESH NE MSHPAS(LP), THE GRID MUST BE "RESIZED" AND THE
C X AND Y POSITIONS OF THE STATIONS IN RELATION TO IT MUST BE
C CHANGED. NOTE, AGAIN, THAT NX, NY, MESH,
C XP( ) AND YP( ) FOLLOW THE GRID. THAT IS, WHATEVER
C IS IN P( ) WILL HAVE THOSE CHARACTERISTICS. ON PASS 1
C THE GRID SHOULD BE OF THE CORRECT SIZE.
C
IF(MESH.NE.MSHPAS(LP))THEN
C XP( ) AND YP( ) ARE IN RELATION TO MESH; MODIFY
C THEM IF MESH IS TO CHANGE.
C
C MSHPAS( ) IS READ FROM THE .CN CONTROL FILE. VERIFY
C MSHPAS( ) IS A LEGITIMATE VALUE IN RANGE 1 TO 320.
C
IF(MESH.GT.320.OR.MESH.LT.1)THEN
WRITE(KFILDO,173)MSHPAS(LP)
173 FORMAT(/' ****MSHPAS(L) =',I6,' NOT IN RANGE 1 TO 320.',
1 ' STOP IN BCD5 AT 173.')
CALL W3TAGE('BCD5')
STOP 173
ENDIF
C
CALL NEWXY1(KFILDO,MESH,XP,YP,MSHPAS(LP),XP,YP,NPROJ,NSTA)
RATIO=FLOAT(MESH)/MSHPAS(LP)
C
D WRITE(KFILDO,1735)NX,NY
D1735 FORMAT(/' CALLING SZGRDM AT 1735--NX,NY',2I6)
C
CALL SZGRDM(KFILDO,P,NX,NY,
1 MESH,MSHPAS(LP),ITRPLQ(LP),ND2X3)
C NOTE THAT SZGRDM SETS MESH TO EQUAL MSHPAS(LP) AND
C MODIFIES NX AND NY ACCORDINGLY.
C
C ADJUST U( ) AND V( ) FOR CURRENT MESH WHEN SLP
C BEING ANALYZED (IVRBL = 1).
C
IF(IVRBL.EQ.1)THEN
FAC=1./RATIO
C
DO 174 K=1,NSTA
C
IF(U(K).NE.9999.)THEN
U(K)=U(K)*FAC
V(K)=V(K)*FAC
ENDIF
C
174 CONTINUE
C
ENDIF
C
ENDIF
C
C MESH HAS BEEN SET FOR THIS PASS AND WILL REMAIN CONSTANT.
C LIKEWISE, IOPTGR( ) CAN BE CALCULATED AND WILL REMAIN
C UNCHANGED FOR THIS PASS. SOME ELEMENTS IF IOPTGR( )
C HAVE BEEN SET ABOVE WHICH DO NOT CHANGE AT ALL.
C WHEN IOPT(1) = 0, THERE IS NO SUBSET AREA.
C
IF(IOPT(1).NE.0)THEN
RATIO=FLOAT(MESHL)/MESH
IOPTGR(2)=NINT((IOPT(2)-1)*RATIO)+1
IOPTGR(3)=NINT((IOPT(3)-1)*RATIO)+1
IOPTGR(4)=NINT((IOPT(4)-1)*RATIO)+1
IOPTGR(5)=NINT((IOPT(5)-1)*RATIO)+1
ENDIF
C
IF(ER1(LP).EQ.0)GO TO 190
ER1Q=ER1(LP)*FRACT(LP)
C
CCCC WRITE(KFILDO,1742)LP,IVRBL,ER1(LP),ER1Q
CCCC 1742 FORMAT(/' IN BCD5 AT 1742--LP,IVRBL,ER1(LP),ER1Q',2I4,2F8.3)
C
IF(LP.NE.NPASS.AND.B(LP).GT.98.)THEN
C THIS IS HEAVY SMOOTHING BEFORE ERROR CHECKING TO TRY
C TO TOSS BAD DATA. NOTE B(LP) = 99.
RMESH=FLOAT(MESH)/FLOAT(MESHE)
C RMESH IS THE RATIO OF THE MESH LENGTH OF THE ANALYSIS GRID
C TO THE TERRAIN GRID.
NSM5=JOCEAN*1000+JLAKE*100+7
C SMOTHG HAS TO HAVE NSMTYP = 5-7. GIVE IT THREE SMOOTHINGS.
C JOCEAN AND JLAKE ALLOWS FOR NO SMOOTHING OVER WATER.
CSTSM5=0.
C DON'T BOTHER SMOOTHING ALONG COASTS.
IG=0
C DON'T USE NEAR( , ). iT HASN'T BEEN INITIALIZED YET.
CALL SMOTHG(KFILDO,P,CORR,COUNT,IG,NEAR,NX,NY,B(LP),CSTSM5,
1 TELEV,SEALND,NXE,NYE,
2 RMESH,NSM5,NSHLN,IER)
IF(IER.EQ.666)KER=KER+1
ENDIF
C
CCCC WRITE(KFILDO,1743)(K,CCALL(K),XDATA(K),LTAG(K),K=1,NBASTA)
CCCC 1743 FORMAT(' AT 1743 IN BCD5--K,CCALL(K),XDATA(K),LTAG(K)',
CCCC 1 I6,2X,A8,F8.1,I4)
CCC ONLY STATIONS ARE WRITTEN NOT THOSE BY BOGUSG
C
C SET GF FOR OBS AND LAMP, WIND SPEED AND TOTAL WIND. THIS
C INCREASES THE THROWOUT CRITERIA FOR POSITIVE DIFFERENCES.
C INCLUDED WIND SPEED 11/18/15. IMPLEMENTS GF = 2 FOR
C MOS GUST.
C
IF(ID(1).EQ.224335005.OR.
1 ID(1).EQ.724330085.OR.
2 ID(1).EQ.224390005.OR.
3 ID(1).EQ.724390085)THEN
GF=MAX(1.5-MAX(IDPARS(12)-1,0)/24.,1.)
C MODIFIED 8/14/14
C MAX IS 1.5, FADES TO 1.0 AT 13 HOURS.
CCCCCC GF=2.-MAX(IDPARS(12)-1,0)/24.
CCCCC THIS GIVES GF = 2 AT PROJECTIONS O AND 1 AND 1 AT
CCCCC PROJECTION 25. WILL BEGIN TO CUT OUT THE LARGER
CCCCC GUSTS WITH PROJECTION.
ELSEIF(ID(1).EQ.224385008)THEN
GF=2.
ELSE
GF=1.
ENDIF
C
C SET IZCHK FOR OBS WIND SPEED OR OBS TOTAL WIND. THIS
C TOSSES VALUES OF ZERO WHEN ER1 IS NOT MET (DOES NOT USE
C NEIGHBORS).
C
IF(ID(1).EQ.724330085.OR.ID(1).EQ.724390085)THEN
IZCHK=1
ELSE
IZCHK=0
ENDIF
C
C SET WFACT FOR MOS WIND SPEED. MIGHT BE APPROPRIATE FOR
C EKDMOS WIND SPEED. THE FACTOR .4 IS ARBITRARY. SET IT
C HIGHER TO TOSS LESS, LOWER TO TOSS MORE. NOTE THIS IS
C SPECIFIC TO MOS, NOT LAMP OR EKDMOS.
C
IF(ID(1).EQ.224360008)THEN
WFACT=.4
ELSE
WFACT=1.
ENDIF
C
C CALL ESP5 IF ERROR CHECKING IS DESIRED. LTAG( ) IS SET.
C INITIALIZE ER1Q, DEPENDING ON PASS. THIS IS HARDWIRED
C FOR NOW.
C
C LTAGPT( ) IS NORMALLY FURNISHED TO ESP, BUT FOR LAMP TOTAL
C WIND, LTAGPT( ) DOES NOT DIFFERENTIATE BETWEEN LAMP AND
C OTHER STATIONS, SO MTAGPT( ), WHICH WAS SAVED FROM WIND
C SPEED, IS FURNISHED.
C
IF(LAMPNO.EQ.20)THEN
CALL ESP5(KFILDO,IP14,IP17,IP21,JDATE,IVRBL,CCALL,NAME,XDATA,
1 XP,YP,TOSS,QUEST,LTAG,QUALST,MTAGPT,U,V,
2 LNDSEA,XLAPSE,ELEV,NBASTA,
3 P,NX,NY,LP,NPASS,ER1(LP),ER1Q,ERRADJ,GF,MESH,MESHB,
4 TITLE,JFIRST,SEALND,TELEV,NXE,NYE,MESHE,
5 R(LP)*RSTAR(LP),LTOSS,N4P,IBKPN,IZCHK,WFACT,
6 ISTOP,I405ADG)
C ONLY BASE STATIONS ARE CHECKED, NOT THOSE ADDED BY BOGUSG.
ELSE
CALL ESP5(KFILDO,IP14,IP17,IP21,JDATE,IVRBL,CCALL,NAME,XDATA,
1 XP,YP,TOSS,QUEST,LTAG,QUALST,LTAGPT,U,V,
2 LNDSEA,XLAPSE,ELEV,NBASTA,
3 P,NX,NY,LP,NPASS,ER1(LP),ER1Q,ERRADJ,GF,MESH,MESHB,
4 TITLE,JFIRST,SEALND,TELEV,NXE,NYE,MESHE,
5 R(LP)*RSTAR(LP),LTOSS,N4P,IBKPN,IZCHK,WFACT,
6 ISTOP,I405ADG)
C ONLY BASE STATIONS ARE CHECKED, NOT THOSE ADDED BY BOGUSG.
ENDIF
C
C PACK AND WRITE THE VECTOR DATA IN TOSS( ) CONTAINING THE
C OBSERVATIONS WITH ALL THOSE EXCEPT TOSSED AS 9999.
C THE ID'S WRITTEN ARE THE SAME AS THE DATA BEING ANALYZED
C EXCEPT THE 3RD WORD HAS THE PASS NUMBER.
C
CCCCC WRITE(KFILDO,1744)(K,CCALL(K),XDATA(K),LTAG(K),TOSS(K),
CCCCC 1 K=1,NBASTA)
CCCCC 1744 FORMAT(' AT 1744 IN BCD5--K,CCALL(K),XDATA(K),LTAG(K),TOSS(K)',
CCCCC 1 I6,2X,A8,F8.1,I4,F8.1)
C STATIONS WRITTEN ARE SANS BOGUSG STATIONS.
C
XMISSP=9999.0
XMISSS=0.
C
IF(KFILOV.EQ.0)GO TO 180
C DON'T WRITE WHEN KFILOV = 0
LD(1)=(MD(1)/1000000)*1000000+IDPARS(2)*1000+IDPARS(3)*100
1 +IDPARS(4)
C MD(1) IS FROM ITABLE( ,2, ) AND REPRESENTS THE VARIABLE
C BEING ANALYZED. HOWEVER, THE UNITS MAY HAVE CHANGED
C (E.G., SNOWFALL), SO RETAIN THE CCC, BUT USE FFFBDD FROM
C IDPARS( ) REPRESENTING THE OUTPUT VARIABLE.
LD(2)=LP*10000
C LD(2) HOLDS THE PASS NUMBER.
LD(3)=MD(3)+IDPARS(12)
LD(4)=MD(4)
CALL PRSID1(KFILDO,LD,LDPARS)
C PRSID1 FILLS LDPARS( ) ACCORDING TO LD( ).
C
IF(IP18.NE.0.AND.JP(3).NE.0)THEN
WRITE(IP18,1745)LP
1745 FORMAT(/' TOSSED OBSERVATIONS WRITTEN TO FILE KFILOV',
1 ' FOR PASS NO.',I3,
2 '. ALL OTHERS ARE WRITTEN AS MISSING.')
ENDIF
C
CALL PACKV(KFILDO,KFILOV,LD,LDPARS,
1 JP,ISCALD,ISCALE,
2 IPLAIN,PLAIN,NDATE,JDATE(1),JDATE(2),JDATE(3),JDATE(4),
3 CCALL,NCOUNT,TOSS,NSTA,NSTA,IPACK,ND5,MINPK,
4 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS,
5 IP18,NWORDS,MTOTBY,MTOTRC,
6 L3264B,L3264W,ISTOP,IER)
C NCOUNT( ) IS WORK ARRAY FOR PACKV. IP18 IS USED TO LIST VALUES.
C ISCALD IS USED FOR GRIDPOINT DATA; IT IS ASSUMED IT IS OK
C FOR THE VECTOR DATA. THE SPECIFIC IDENTIFYING WORD IS IN
C ID(2) OF THE FORM X0000, WHERE X IS THE PASS NUMBER.
C IF THERE WAS AN ERROR, IT IS COUNTED BY ISTOP, BUT IS NOT
C CONSIDERED FATAL. THESE RECORDS ARE FOR CHECKOUT.
C
IF(IER.NE.0)THEN
KER=KER+1
ELSE
IF(IP16.NE.0)THEN
WRITE(IP16,175)(LD(J),J=1,4),
1 ((IPLAIN(I,J),I=1,L3264W),J=1,4),NDATE
175 FORMAT(/' WRITING DATA TO UNIT KFILOV',3I10.9,I10.3,3X,8A4,
1 ' FOR DATE',I12)
ENDIF
C
ENDIF
C
IF(LP.NE.NPASS)GO TO 176
C
C PACK AND WRITE VALUES OF LTAG( ) TO KFILOV WITH
C 2ND WORD ID(2) = 940000 FOR THE LAST PASS. THIS IS FOR
C READING IN A SUBSEQUENT RUN OF U155/U405. THIS IS WRITTEN
C FOR EACH ELEMENT; THE RECORD READ IS INDICATED IN AUGMT2
C WORD 5 IN THE TABLE.
C
DO 1753 K=1,NSTA
SDATA(K)=LTAG(K)
C FOR PACKING, VALUES MUST BE FLOATING POINT.
1753 CONTINUE
C
C************************************************************
C BELOW FOR DIAGNOSTICS ONLY.
C
D ICOUNT=0
C
D DO 914 K=1,NBASTA
C
D IF(NINT(SDATA(K)).EQ.-1)THEN
D ICOUNT=ICOUNT+1
D WRITE(KFILDO,913)CCALL(K),XDATA(K),ICOUNT
D913 FORMAT(' AT 913 IN BCD5, STATION WITH LTAG( ) = -1 ',
D 1 'XDATA(K),ICOUNT-- ',A8,F8.1,I7)
D ENDIF
C
D914 CONTINUE
C
D DO 916 K=1,NBASTA
C
D IF(CCALL(K).EQ.'XXXXX ')THEN
D WRITE(KFILDO,915)CCALL(K),XDATA(K),LTAG(K)
D915 FORMAT(/' AT 915 IN BCD5, ',
D 1 'XDATA(K),LTAG(K)-- ',A8,F8.1,I4/)
D ENDIF
C
D916 CONTINUE
C
D ICOUNT=0
C
D DO 918 K=1,NBASTA
C
D IF(NINT(SDATA(K)).EQ.4)THEN
D ICOUNT=ICOUNT+1
D WRITE(KFILDO,917)CCALL(K),XDATA(K),ICOUNT
D917 FORMAT(' AT 917 IN BCD5, STATION WITH LTAG( ) = +4 ',
D 1 'XDATA(K),ICOUNT-- ',A8,F8.1,I7)
D ENDIF
C
D918 CONTINUE
C************************************************************
C
LD(2)=940000
CALL PRSID1(KFILDO,LD,LDPARS)
C PRSID1 FILLS LDPARS( ) ACCORDING TO LD( ).
C
IF(IP18.NE.0.AND.JP(3).NE.0)THEN
WRITE(IP18,1755)LP
1755 FORMAT(/' LTAG( ) VALUES WRITTEN TO FILE KFILOV',
1 ' FOR FINAL PASS NO.',I3)
ENDIF
C********************
ISCL=0
C SDATA( ) HERE ARE WHOLE NUMBERS.
C
CCCC WRITE(KFILDO,9755)ISCL,(K,CCALL(K),SDATA(K),K=1,NBASTA)
CCCC 9755 FORMAT(' AT 9755 IN BCD5--ISCALD,(K,CCALL(K),SDATA(K),K=1,NSTA)',
CCCC 1 I4,/,(I8,2X,A8,F8.1))
C ONLY NON-BOGUSG STATIONS ARE WRITTEN.
C
CALL PACKV(KFILDO,KFILOV,LD,LDPARS,
1 JP,ISCL,ISCALE,
2 IPLAIN,PLAIN,NDATE,JDATE(1),JDATE(2),JDATE(3),JDATE(4),
3 CCALL,NCOUNT,SDATA,NSTA,NSTA,IPACK,ND5,MINPK,
4 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS,
5 IP18,NWORDS,MTOTBY,MTOTRC,
6 L3264B,L3264W,ISTOP,IER)
C NCOUNT( ) IS WORK ARRAY FOR PACKV. IP18 IS USED TO LIST VALUES.
C SCALING = ISCL = 0 BECAUSE VALUES ARE WHOLE NUMBERS. THE
C SPECIFIC IDENTIFYING WORD IS IN ID(2) OF THE FORM 940000.
C IF THERE WAS AN ERROR, IT IS COUNTED BY ISTOP, BUT IS NOT
C CONSIDERED FATAL.
C
IF(IER.NE.0)THEN
KER=KER+1
ELSE
IF(IP16.NE.0)THEN
WRITE(IP16,1756)(LD(J),J=1,4),
1 ((IPLAIN(I,J),I=1,L3264W),J=1,4),NDATE
1756 FORMAT(/' WRITING DATA TO UNIT KFILOV',3I10.9,I10.3,3X,8A4,
1 ' FOR DATE',I12)
ENDIF
C
ENDIF
C
WRITE(KFILDO,1756)(LD(J),J=1,4),
1 ((IPLAIN(I,J),I=1,L3264W),J=1,4),NDATE
C
IF(IP18.NE.0.AND.JP(3).NE.0)THEN
WRITE(IP18,1757)LP
1757 FORMAT(/' LTAG( ) VALUES TO FILE KFILOV',
1 ' FOR PASS NO.',I3)
ENDIF
C
CCCC WRITE(KFILDO,1758)(CCALL(K),TOSS(K),SDATA(K),XDATA(K),LTAG(K),
CCCC 1 K=1,NBASTA)
CCCC 1758 FORMAT(/' AT 1758 IN BCD5--',
CCCC 1 'CCALL(K),TOSS(K),SDATA(K),XDATA(K),LTAG(K)--',/
CCCC 2 (' ',A8,3F8.1,I4))
C
C PACK AND WRITE THE VECTOR DATA IN QUEST( ) CONTAINING THE
C OBSERVATIONS WITH ALL THOSE EXCEPT QUESTIONABLE AS 9999.
C THE ID'S WRITTEN ARE THE SAME AS THE DATA BEING ANALYZED
C EXCEPT THE 3RD WORD HAS THE PASS NUMBER PRECEDED BY "1".
C
176 LD(1)=(MD(1)/1000000)*1000000+IDPARS(2)*1000+IDPARS(3)*100
1 +IDPARS(4)
C MD(1) IS FROM ITABLE( ,2, ) AND REPRESENTS THE VARIABLE
C BEING ANALYZED. HOWEVER, THE UNITS MAY HAVE CHANGED
C (E.G., SNOWFALL), SO RETAIN THE CCC, BUT USE FFFBDD FROM
C IDPARS( ) REPRESENTING THE OUTPUT VARIABLE.
LD(2)=LP*10000+100000
C LD(2) HOLDS THE PASS NUMBER, PRECEDED BY A ONE.
LD(3)=MD(3)+IDPARS(12)
LD(4)=MD(4)
CALL PRSID1(KFILDO,LD,LDPARS)
C PRSID1 FILLS LDPARS( ) ACCORDING TO LD( ).
C
IF(IP18.NE.0.AND.JP(3).NE.0)THEN
WRITE(IP18,177)LP
177 FORMAT(/' QUESTIONABLE OBSERVATIONS WRITTEN TO FILE KFILOV',
1 ' FOR PASS NO.',I3,
2 '. ALL OTHERS ARE WRITTEN AS MISSING.')
ENDIF
C
CALL PACKV(KFILDO,KFILOV,LD,LDPARS,
1 JP,ISCALD,ISCALE,
2 IPLAIN,PLAIN,NDATE,JDATE(1),JDATE(2),JDATE(3),JDATE(4),
3 CCALL,NCOUNT,QUEST,NSTA,NSTA,IPACK,ND5,MINPK,
4 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS,
5 IP18,NWORDS,MTOTBY,MTOTRC,
6 L3264B,L3264W,ISTOP,IER)
C NCOUNT( ) IS WORK ARRAY FOR PACKV. IP18 IS USED TO LIST VALUES.
C ISCALD IS USED FOR GRIDPOINT DATA; IT IS ASSUMED IT IS OK
C FOR THE VECTOR DATA. THE SPECIFIC IDENTIFYING WORD IS IN
C ID(2) OF THE FORM 1X0000, WHERE X IS THE PASS NUMBER.
C IF THERE WAS AN ERROR, IT IS COUNTED BY ISTOP(1), BUT IS NOT
C CONSIDERED FATAL.
C
IF(IER.NE.0)THEN
KER=KER+1
ELSE
C
IF(IP16.NE.0)THEN
WRITE(IP16,175)(LD(J),J=1,4),
1 ((IPLAIN(I,J),I=1,L3264W),J=1,4),NDATE
ENDIF
C
ENDIF
C
180 IF(LP.LT.NPASS)GO TO 190
C WRITE ONLY ON THE LAST PASS.
IF(KFILQC.EQ.0)GO TO 190
C DON'T WRITE WHEN KFILQC = 0
C
C IF ERROR CHECKING WAS DONE, COMBINE XDATA( ) AND TOSS( ) TO
C PRODUCE A QUALITY CONTROLLED ARRAY IN TOSS. THIS ARRAY
C WILL BE THE SAME AS XDATA( ) EXCEPT THE TOSSED OBS IN
C TOSS( ) WILL BE SET TO MISSING. THIS ARRAY IS THEN WRITTEN
C TO THE QC FILE. IF ERROR CHECKING IS NOT DONE, WHICH WOULD
C BE VERY UNUSUAL IN U405A, DATA ARE NOT WRITTEN, BECAUSE
C THEY WOULD NOT BE QUALITY CONTROLLED SO THAT THE ID WOULD
C APPLY. NOTE THAT THE QC DATA WILL BE WRITTEN ONLY WHEN
C ERROR CHECKING WAS DONE ON THE LAST PASS.
C
DO 185 K=1,NSTA
C
IF(XDATA(K).NE.9999.)THEN
C
IF(TOSS(K).EQ.9999.)THEN
TOSS(K)=XDATA(K)
ELSE
TOSS(K)=9999.
ENDIF
C
ENDIF
C
185 CONTINUE
C
LD(1)=(MD(1)/1000000)*1000000+IDPARS(2)*1000+IDPARS(3)*100
1 +IDPARS(4)
C MD(1) IS FROM ITABLE( ,2, ) AND REPRESENTS THE VARIABLE
C BEING ANALYZED. HOWEVER, THE UNITS MAY HAVE CHANGED
C (E.G., SNOWFALL), SO RETAIN THE CCC, BUT USE FFFBDD FROM
C IDPARS( ) REPRESENTING THE OUTPUT VARIABLE.
C NOTE THAT FOR THE MERGED LAMP/MOS OBS WITH CCCFFF = 202900,
C THE QC DATA WILL BE WRITTEN CCCFFF = 202020 BECAUSE 020 IS
C THE FFF OF THE VARIABLE BEING ANALYZED. THAT MAKES THE
C ID THE SAME AS THE MOS DATA. BUT THE DD WILL REPRESENT
C LAMP.
LD(2)=MD(2)
LD(3)=MD(3)+IDPARS(12)
LD(4)=MD(4)
CALL PRSID1(KFILDO,LD,LDPARS)
C PRSID1 FILLS LDPARS( ) ACCORDING TO LD( ).
C
IF(I405ADG.NE.0)THEN
WRITE(KFILDO,186)(LD(J),J=1,4),PLAIN,NDATE
186 FORMAT(/' WRITING QC DATA RECORD FOR ',3(1X,I9.9),
1 1X,I10.3,' ',A32,' FOR DATE',I12)
ENDIF
C
IF(IP18.NE.0.AND.JP(3).NE.0)THEN
WRITE(IP18,1865)LP
1865 FORMAT(/' QUALITY CONTROLLED OBSERVATIONS WRITTEN TO FILE',
1 ' KFILQC FOR FINAL PASS NO.',I3,
2 '. TOSSED VALUES ARE WRITTEN AS MISSING.')
ENDIF
C
CALL PACKV(KFILDO,KFILQC,LD,LDPARS,
1 JP,ISCALD,ISCALE,
2 IPLAIN,PLAIN,NDATE,JDATE(1),JDATE(2),JDATE(3),JDATE(4),
3 CCALL,NCOUNT,TOSS,NSTA,NSTA,IPACK,ND5,MINPK,
4 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS,
5 IP18,NWORDS,ITOTBY,ITOTRC,
6 L3264B,L3264W,ISTOP,IER)
C NCOUNT( ) IS WORK ARRAY FOR PACKV. IP18 IS USED TO LIST
C VALUES. ISCALD IS USED FOR GRIDPOINT DATA; IT IS ASSUMED IT IS
C OK FOR THE VECTOR DATA. IF THERE IS AN ERROR, IT IS COUNTED
C BY ISTOP(1), BUT IS NOT CONSIDERED FATAL.
C
IF(IER.NE.0)THEN
KER=KER+1
ELSE
C
IF(IP16.NE.0)THEN
WRITE(IP16,188)(LD(J),J=1,4),
1 ((IPLAIN(I,J),I=1,L3264W),J=1,4),NDATE
188 FORMAT(/' WRITING DATA TO UNIT KFILQC',3I10.9,I10.3,3X,8A4,
2 ' FOR DATE',I12)
ENDIF
C
ENDIF
C
C SPECIAL CIRCUMSTANCE ADDED 7/19/11. THIS IS PRIMARILY
C TO SMOOTH THE OCEAN TO SMOOTH OUT THE MAXIMUM ASSOCIATED
C WITH A DATUM. WHEN NOT SMOOTHED, THE DATUM HAS ALREADY
C BEEN FIT AND THERE IS NO EFFORT TO BRING SURROUNDING POINTS
C UP TO BETTER REFLECT A MAXIMUM AROUND A BUOY. THE
C SMOOTHING OF A MAX WILL LET THE DATUM MAKE A POSITIVE CHANGE
C TO SURROUNDING GRIDPOINTS AND THE GRIDPOINT CLOSEST TO THE
C DATUM WILL BE BROUGHT BACK UP TO ITS APPROPRIATE VALUE.
C THE QUESTION IS WHEN TO INVOKE THIS SMOOTHING. IT IS
C ASSUMED IT WILL BE USED ON THE LAST PASS, AND THAT SOME
C TYPE OF SMOOTHING WILL BE DONE ON THE OCEAN.
C
CCCC WRITE(KFILDO,1883)ID,IORST,LP,B(LP)
CCCC 1883 FORMAT(/' AT 1883--ID,IORST,LP,B(LP)',4I12,2I4,F6.0)
C
IF(IORST.EQ.1.AND.LP.EQ.NPASS.AND.B(LP).NE.0)THEN
C THIS IS TRIGGERED WHEN ORSMTW IS USED ON THE LAST PASS.
C
CCCC WRITE(KFILDO,1885)LP,B(LP),NSMTYP
CCCC 1885 FORMAT(//////' AT 1885 IN BCD5--LP,B(LP),NSMTYP',I4,F6.2,2I4)
C
RMESH=FLOAT(MESH)/FLOAT(MESHE)
C RMESH IS THE RATIO OF THE MESH LENGTH OF THE ANALYSIS GRID
C TO THE TERRAIN GRID.
NSM5=JOCEAN*1000+JLAKE*100+7
C SMOTHG HAS TO HAVE NSMTYP = 5-7. GIVE IT THREE SMOOTHINGS.
C JOCEAN AND JLAKE ALLOWS FOR NO SMOOTHING OVER WATER.
CSTSM5=0.
C DON'T BOTHER SMOOTHING ALONG COASTS.
IG=0
C DON'T USE NEAR( , ). iT HASN'T BEEN INITIALIZED YET.
CALL SMOTHG(KFILDO,P,CORR,COUNT,IG,NEAR,NX,NY,B(LP),CSTSM5,
1 TELEV,SEALND,NXE,NYE,
2 RMESH,NSM5,NSHLN,IER)
IF(IER.EQ.666)KER=KER+1
ENDIF
STOP 22222
C
C MAKE THE CORRECTIONS IN A SUBROUTINE SO THAT DOUBLY
C DIMENSIONED VARIABLES CAN BE USED. NX AND NY ARE
C CHANGED IN BCD5, AND ARE FURNISHED TO CORBC5.
C
D CALL TIMPR(KFILDO,KFILDO,'START CORBC5 ')
190 CALL CORBC5(KFILDO,IP14,IP20,CCALL,XDATA,XP,YP,XPL,YPL,LTAG,
1 QUALST,VRAD(1,LP),LNDSEA,ELEV,LAPFG,
2 XLAPSE,ULAPSE,NSTA,NBASTA,LAPUDB,
3 TELL,TELH,ATEL,BTEL,
4 ILS,LNDWAT(LP),WTWTL,WTLTW,WTAUG,LTAGPT,IALGOR(LP),
5 ELCORR(LP),IBKPN,BK(LP),ELCORU(LP),IFCOR(LP),ICUB,
6 RWATO(LP),RWATI(LP),IVRAD,IALOC,ADIST,AELEV,ND13,
7 P,CORR,COUNT,NCOUNT,FD2,NX,NY,MESH,MESHL,
8 U,V,WNDWT(LP),WNDGRD,
9 TELEV,SEALND,NXE,NYE,XPE,YPE,MESHE,ORIENT,
A HGTTHA,HGTTHB,NAREA,
B LP,NPASS,NTYPE(LP),R(LP),IOPT,JDATE,TITLE,N4P,MGUESS,
C ISTOP,IER)
D CALL TIMPR(KFILDO,KFILDO,'END CORBC5 ')
C
IF(IER.NE.0)THEN
WRITE(KFILDO,200)IER
200 FORMAT(/' MAJOR ERROR IN BCD5 FROM CORBC5,',
1 ' IER =',I4)
C THIS DIAGNOSTIC WILL FOLLOW ONE IN CORBC5. ISTOP( )
C HAS BEEN INCREMENTED.
KER=KER+1
ENDIF
C THE FOLLOWING DIAGNOSTIC PRINT PRODUCED ON IP18 INDICATES
C FOR EACH DATUM THE DEGREE OF FIT OF THE UNSMOOTHED ANALYSIS
C TO THE DATA OF THE PASS LP FOR THE WHOLE ANALYSIS AREA.
C DIFFERENCES BETWEEN DATA VALUES AND INTERPOLATED VALUES
C ARE NOT USED FOR THIS PURPOSE FOR POINTS OUTSIDE THE
C NX BY NY GRID. AUGMENTED DATA, IF ANY, ARE NOT USED IN
C THE COMPUTATIONS.
C
IF(IP18.NE.0.OR.IP21.NE.0.OR.IOPT(1).NE.0)THEN
C ANY TIME THERE IS A SUBSET AREA, THE DEGREE OF FIT IS
C COMPUTED.
C
IF(IP18.NE.0)THEN
WRITE(IP18,258)(JDATE(J),J=1,4),LP,TITLE(1:16),MESH
258 FORMAT(/' FOR DATE',I6,3I3.2,' VALUES AT END OF BCD5 PASS',
1 ' NO.',I3,' (UNSMOOTHED) FOR ',A16,
2 ' FOR MESH LENGTH =',I4/
3 ' ONLY BASE STATIONS WITH LTAG = 0 OR -1 ARE PRINTED;',
4 ' THOSE PERMANENTLY DISCARDED ARE NOT PRINTED.',
5 ' BB IS THE ANALYSIS VALUE.'/
6 ' STATIONS WITH NO DIFFERENCES ARE OUTSIDE THE GRID'/
7 ' NO. STATION XPOS YPOS DATA',
8 ' BB DIF LTAG QUALST LNDSEA')
ENDIF
C
SUM=0.
NSUM=0
C SUM AND NSUM ARE FOR SUMMING THE DIFFERENCES BETWEEN THE
C INTERPOLATED VALUES AND THE OBSERVATIONS FOR ALL
C OBSERVATIONS WITHIN THE GRID.
SUMGR=0.
NSUMGR=0
C SUMGR AND NSUMGR ARE FOR SUMMING THE DIFFERENCES
C BETWEEN THE INTERPOLATED VALUES AND THE OBSERVATIONS
C FOR ALL OBSERVATIONS WITHIN THE SUBSETTED AREA ONLY.
C
DO 2582 M=1,3
DIFMAX(M)=0.
STAMAX(M)=' '
NAMMAX(M)=' '
C DIFMAX( ) IS FOR COLLECTING THE THREE LARGEST
C DIFFERENCES; STAMAX( ) AND NAMMAX ARE FOR THE ASSOCIATED
C STATIONS CALL LETTERS AND NAMES, RESPECTIVELY.
2582 CONTINUE
C
XNX=NX
YNY=NY
C
DO 263 K=1,NSTA
C
CCCC WRITE(KFILDO,2583)K,CCALL(K),LTAG(K),LTAGPT(K)
CCCC 2583 FORMAT(' AT 2583--K,CCALL(K),LTAG(K),LTAGPT(K)',I4,2X,A8,2I6)
C
IF(LTAG(K).GE.1)GO TO 263
C ONLY STATIONS NOT TOSSED ON THE LAST PASS ARE USED.
C
IF(ILS.NE.0.AND.LNDSEA(K).LE.3)GO TO 263
C THIS TEST PUT IN TO VERIFY ONLY LAND STATIONS WHEN THE
C LAND AND WATER ARE SEPARATED IN THE ANALYSIS.
C
C THE BELOW TEST PUT IN TO VERIFY ONLY BASE STATIONS, NOT
C ANY BOGUS OR AUGMENTED ONES. NORMALLY, BASE STATIONS ARE
C INDICATED BY 0 IN LTAGPT( ), BUT THIS IS NOT THE CASE
C FOR TOTAL WIND, SO MTAGPT( ) FROM WIND SPEED IS USED.
C
IF(LAMPNO.EQ.20)THEN
IF(MTAGPT(K).GT.0)GO TO 263
ELSE
IF(LTAGPT(K).GT.0)GO TO 263
ENDIF
C
IF(QUALST(K).LE..99)GO TO 263
C ABOVE ADDED 1/4/16. OMITS MESONET STATIONS WHEN USED
C WITH REDUCED WEIGHT.
C
C FIND INTERPOLATED VALUE OR NEAREST NEIGHBOR VALUE IN
C ITRPSX ACCORDING TO THE LAND/WATER TYPE LNDSEA(K).
C
CALL ITRPSX(KFILDO,IP14,P,NX,NY,
1 CCALL(K),XDATA(K),XLAPSE(K),ELEV(K),XP(K),YP(K),
2 LNDSEA(K),SEALND,TELEV,NXE,NYE,
3 IBKPN,ELCORR(LP),ELCORU(LP),
4 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 EXISTS. ALSO, THE FIRST GUESS ANALYSIS AREA
C MAY NOT FILL GRID. IN THIS CASE, IER NE 0.
C
IF(IER.NE.0)THEN
IER=0
C IER NE 0 IS NOT COUNTED AS AN ERROR HERE. RESET OR IT
C MAY TRIP AN ERROR COUNT LATER.
GO TO 261
ENDIF
C
IF(XP(K).LT.1..OR.XP(K).GT.XNX)GO TO 261
IF(YP(K).LT.1..OR.YP(K).GT.YNY)GO TO 261
DIF=BB-XDATA(K)
ADIF=ABS(DIF)
IF(LTAG(K).EQ.-1)GO TO 259
SUM=SUM+ADIF
NSUM=NSUM+1
C
C*************************************************
CCC IF(LP.EQ.NPASS)THEN
CCC WRITE(KFILDO,2585)CCALL(K),BB,XDATA(K),DIF,NSUM,SUM
CCC 2585 FORMAT(' AT 2585--CCALL(K),BB,XDATA(K),DIF,NSUM,SUM ',
CCC 1 A8,3F8.2,I6,F8.2)
CCC ENDIF
C*************************************************
C
C WHEN IOPT(1) = 0, THERE IS NO SUBSET AREA, SO DO NO
C CALCULATIONS FOR IT.
C
IF(IOPT(1).NE.0)THEN
C
IF(XP(K).LE.IOPTGR(3).AND.
1 XP(K).GE.IOPTGR(2).AND.
2 YP(K).LE.IOPTGR(5).AND.
3 YP(K).GE.IOPTGR(4))THEN
NSUMGR=NSUMGR+1
SUMGR=SUMGR+ADIF
C
IF(ADIF.GT.DIFMAX(1))THEN
DIFMAX(3)=DIFMAX(2)
STAMAX(3)=STAMAX(2)
NAMMAX(3)=NAMMAX(2)
DIFMAX(2)=DIFMAX(1)
STAMAX(2)=STAMAX(1)
NAMMAX(2)=NAMMAX(1)
DIFMAX(1)=ADIF
STAMAX(1)=CCALL(K)
NAMMAX(1)=NAME(K)
ELSEIF(ADIF.GT.DIFMAX(2))THEN
DIFMAX(3)=DIFMAX(2)
STAMAX(3)=STAMAX(2)
NAMMAX(3)=NAMMAX(2)
DIFMAX(2)=ADIF
STAMAX(2)=CCALL(K)
NAMMAX(2)=NAME(K)
ELSEIF(ADIF.GT.DIFMAX(3))THEN
DIFMAX(3)=ADIF
STAMAX(3)=CCALL(K)
NAMMAX(3)=NAME(K)
ENDIF
C
ENDIF
C
ENDIF
C
C*** IF(IP20.NE.0.AND.IOPT(1).NE.0)THEN
C***D WRITE(KFILDO,2588)K,CCALL(K),XP(K),YP(K),
C***D 1 IOPTGR(3),IOPTGR(2),
C***D 2 IOPTGR(5),IOPTGR(4),NSUMGR,SUMGR
C***D2588 FORMAT(' IN BCD5 AT 2588--K,CCALL(K),XP(K),YP(K),',
C***D 1 'IOPTGR(3,2,5,4),',
C***D 2 'NSUMGR,SUMGR',I5,1X,A6,2F7.2,4F6.0,I5,F8.2)
C
C*** ENDIF
C
259 IF(IP18.NE.0)THEN
WRITE(IP18,260)K,CCALL(K),XP(K),YP(K),XDATA(K),BB,DIF,
1 LTAG(K),QUALST(K),LNDSEA(K)
260 FORMAT(' ',I5,3X,A8,F8.2,F8.2,F10.3,F10.3,F8.3,I6,F8.3,I6)
GO TO 263
ENDIF
C
261 IF(IP18.NE.0)THEN
WRITE(IP18,262)K,CCALL(K),XP(K),YP(K),XDATA(K),BB,LTAG(K),
1 QUALST(K),LNDSEA(K)
262 FORMAT(' ',I5,3X,A8,F8.2,F8.2,F10.3,F10.3,8X,I6,F8.3,I6)
ENDIF
C
263 CONTINUE
C
AVG=9999.
IF(NSUM.NE.0)AVG=SUM/NSUM
C
IF(IP21.NE.0)THEN
WRITE(IP21,264)(JDATE(J),J=1,4),NSUM,LP,TITLE(1:16),AVG
264 FORMAT(' FOR DATE',I6,3I3.2,' MEAN ABS DIFF OF',I6,
1 ' VALUES USED WITHIN THE GRID',
2 ' ON PASS NO.',I2,' FOR ',A16,' =',F7.3,
3 ' (UNSMOOTHED)')
ENDIF
C
C COMPUTE AND PRINT THE AVERAGE DIFFERENCE BETWEEN THE DATA
C AND THE CURRENT ANALYSIS OVER THE SUBSETTED AREA.
C
IF(IOPT(1).NE.0)THEN
C THERE IS A SUBSET AREA.
C
IF(NSUMGR.EQ.0)THEN
AVGGR=9999.
ELSE
AVGGR=SUMGR/NSUMGR
ENDIF
C
IF(I405ADG.NE.0)THEN
WRITE(KFILDO,2644)
ENDIF
C
IF(IP20.NE.KFILDO.AND.IP20.NE.0)THEN
WRITE(IP20,2644)
2644 FORMAT(' ')
ENDIF
C
IF(IP20.NE.0)THEN
WRITE(IP20,2645)
1 (JDATE(J),J=1,4),NSUMGR,LP,TITLE(1:16),AVGGR,
2 (STAMAX(M),NAMMAX(M),DIFMAX(M),M=3,1,-1)
2645 FORMAT(/' FOR DATE',I6,3I3.2,' MEAN ABS DIFF OF',I6,
1 ' VALUES USED IN SUBSET AREA ',
2 ' ON PASS NO.',I2,' FOR ',A16,' =',F7.3,
3 ' (UNSMOOTHED)',/,
4 4X,'BIG DIFFERENCES = ',A8,A20,F7.3,', ',
5 A8,A20,F7.3,', ',
6 A8,A20,F7.3)
ENDIF
C
IF(I405ADG.NE.0)THEN
C
IF(IP20.NE.KFILDO)THEN
WRITE(KFILDO,2645)
1 (JDATE(J),J=1,4),NSUMGR,LP,TITLE(1:16),AVGGR,
2 (STAMAX(M),NAMMAX(M),DIFMAX(M),M=3,1,-1)
ENDIF
C
ENDIF
C
ELSE
C THERE IS NOT A SUBSET AREA.
AVGGR=AVG
NSUMGR=NSUM
C AVGGR AND NSUMGR ARE PRINTED AT THE BOTTOM OF THE
C GRIDPRINTED MAP. IF THERE IS NO SUBSETTED AREA, THE
C WHOLE AREA MAY BE PRINTED. THEREFORE, SET AVGGR TO
C AVG AND NSUMGR TO NSUM.
ENDIF
C
ENDIF
C
C PREPARE UNSMOOTHED MAPS FOR GRIDPRINTING AND OR
C WRITING IN TDLPACK, IF DESIRED.
C
IF(NPRT(LP).NE.0.AND.IP22.NE.0.AND.JP(1).NE.0)GO TO 2646
IF(NTDL(LP).NE.0.AND.KFILOG.NE.0.AND.JP(2).NE.0)GO TO 2646
GO TO 271
C TO PROCEED BELOW, EITHER NPRT(LP) AND JP(1)
C INDICATE GRIDPRINTING OR NTDL(LP) AND JP(2) INDICATE
C PACKING AND THERE IS A NONZERO UNIT NUMBER TO WRITE TO.
C
2646 NXG=NX
NYG=NY
MESHG=MESH
C NXG, ETC. ARE NECESSARY BECAUSE SZGRDM CHANGE THEM, AND
C NX, ETC. MUST BE RETAINED.
CALL TRNSFR(P,FD2,NX*NY)
D WRITE(KFILDO,2647)NX,NY
D2647 FORMAT(/' CALLING SZGRDM AT 2647--NX,NY',2I6)
CALL SZGRDM(KFILDO,FD2,NXG,NYG,
1 MESHG,MESHL,ITRPLQ(LP),ND2X3)
C SZGIRD PUTS THE GRID IN FD2( ) AT SUBSET MESH LENGTH MESHL.
C IOPT( ) IS IN RELATION TO THAT MESH LENGTH.
C
C GRIDPRINT UNSMOOTHED FIELD IF DESIRED.
C
IF(NPRT(LP).EQ.0.OR.IP22.EQ.0.OR.JP(1).EQ.0)GO TO 2654
TITLE(17:24)=BLANK(1:8)
CALL PRTGR(IP22,FD2,NXG,NYG,
1 CINT(LP),ORIGIN(LP),SMULT(LP),SADD(LP),IOPT,TITLE,IER)
IF(IER.NE.0)ISTOP(1)=ISTOP(1)+1
C AN ERROR IS COUNTED BY ISTOP(1), BUT IS NOT FATAL.
C
C AT THE BOTTOM OF THE MAP, BELOW THE TITLE, PRINT
C THE PASS NUMBER LP, NTYPE( ), R( ), B( ), AND ER1( ).
C IT IS EXPECTED THAT 4 PASSES WILL USUALLY BE USED
C AND ALL THOSE VALUES ARE PRINTED. HOWEVER, IF NPASS
C IS GT 4, IT IS ACCOMMODATED. THE NUMBER OF VALUES WITHIN
C THE GRIDPRINTED AREA AND THE AVERAGE ABSOLUTE DIFFERENCE
C ARE ALSO PRINTED.
C
IF(NPASS.LE.4)THEN
WRITE(IP22,2648)LP,(NTYPE(J),J=1,4),(R(J),J=1,4),
1 (MSHPAS(J),J=1,4),NSMTYP,(B(J),J=1,4),
2 (ER1(J),J=1,4),
3 (ITRPLQ(J),J=1,4),NSUMGR,AVGGR
2648 FORMAT(' PASS NO.',I2,' NTYPE',4I4,
1 ' R',F7.1,3F5.1,
2 ' MSHPAS',4I5,5X,'NSMTYP',I5/
3 19X,' B',F8.1,3F4.1,' ER1',4F5.1,
4 ' ITRPLQ',4I5,
5 ' VALUES',I5,' FIT',F6.2)
C REMOVED THE "CTRL-L" AND "/" IN THE FORMAT 2648.
C
IF(IVRBL.EQ.1)THEN
WRITE(IP22,2649)(WNDWT(J),J=1,4),WNDTHR,WNDTRN,WNDGRD
2649 FORMAT(21X,'WNDWT',4F4.1,' WNDTHR',F8.1,
1 14X,'WNDTRN',F8.2,17X,'WNDGRD',F6.2)
ENDIF
C
ELSEIF(NPASS.EQ.5)THEN
WRITE(IP22,265)LP,(NTYPE(J),J=1,5),(R(J),J=1,5),
1 (MSHPAS(J),J=1,5),NSMTYP,(B(J),J=1,5),
2 (ER1(J),J=1,5),
3 (ITRPLQ(J),J=1,5),NSUMGR
265 FORMAT(' PASS NO.',I2,' NTYPE',5I4,
1 ' R ',5F5.1,
2 ' MSHPAS',5I5,' NSMTYP',I5/
3 19X,' B ',5F4.1,' ER1',5F5.1,
4 ' ITRPLQ',5I5,' VALUES',I5)
C
IF(IVRBL.EQ.1)THEN
WRITE(IP22,2650)(WNDWT(J),J=1,5),WNDTHR,WNDTRN,WNDGRD,AVGGR
2650 FORMAT(21X,'WNDWT',5F4.1,' WNDTHR',F8.1,
1 19X,'WNDTRN',F8.2,' WNDGRD',F6.2,' FIT',F8.2)
ENDIF
C
WRITE(IP22,2651)CINT(LP),ORIGIN(LP),SMULT(LP),SADD(LP)
2651 FORMAT(21X,'CINT',F8.2,16X,' ORIGIN',F8.2,
1 19X,'SMULT ',F8.2,17X,' SADD',F7.2)
ELSE
C
WRITE(IP22,2652)LP,(NTYPE(J),J=1,6),(R(J),J=1,6),
1 (MSHPAS(J),J=1,6),(B(J),J=1,6),(ER1(J),J=1,6),
2 (ITRPLQ(J),J=1,6),NSUMGR,AVGGR
2652 FORMAT(' PASS NO.',I2,' NTYPE',6I4,' R',6F5.1,
1 ' MSHPAS',6I5/
2 10X,' B',6F4.1,' ER1',6F5.1,' ITRPLQ',I5,5I2,
3 ' VALUES',I5,' FIT',F6.2)
ENDIF
C
IF(NPASS.NE.5)THEN
WRITE(IP22,2653)CINT(LP),ORIGIN(LP),SMULT(LP),SADD(LP)
ENDIF
C
2653 FORMAT(21X,'CINT',F8.2,16X,'ORIGIN',F8.2,
1 14X,'SMULT ',F8.2,17X,'SADD',F8.2)
C
C TDLPACK AND WRITE UNSMOOTHED FIELD IF DESIRED FOR THE
C SUBSET AREA. WHEN IOPT(1) = 0, THERE IS NO SUBSET AREA.
2654 IF(NTDL(LP).EQ.0.OR.KFILOG.EQ.0.OR.JP(2).EQ.0.
1 OR.IOPT(1).EQ.0)GO TO 271
LD(1)=ID(1)
LD(2)=LP*10000+IDPARS(7)
C THE LLLL IN ID(2) IS USED FOR THE PASS NUMBER.
C IDPARS(7) MAINTAINS THE LEVEL.
LD(3)=ID(3)
LD(4)=(ID(4)/1000)*1000
C THIS IS THE UNSMOOTHED ANALYSIS; S IN ID(4) = 0.
ITAUH=IDPARS(12)
ITAUM=0
NSEQ=0
NCHAR=32
C 32 CHARACTERS OF PLAIN LANGUAGE ARE PACKED.
XMISSP=0.
XMISSS=0.
C THESE ARE ANALYSES AND NO MISSING VALUES ARE PROVIDED FOR.
C IF THERE EVER ARE, JUST SET XMISSP=9999., OR WHATEVER THE
C MISSING VALUE IS.
C
C THE GRID IN FD2( ) IS ALWAYS AT MESH LENGTH MESHL AS A
C RESULT OF SZGRDM, WHICH IS WHAT IS WANTED FOR THE
C DISPOSABLE GRID. NOW CUT THE GRID TO THE DISPOSABLE
C AREA. IOPT( ) IS IN RELATION TO MESHL, WHICH IS THE
C MESH LENGTH OF FD2( ).
C
NXD=IOPT(3)-IOPT(2)+1
NYD=IOPT(5)-IOPT(4)+1
NXOFF=IOPT(2)-1
NYOFF=IOPT(4)-1
C NXOFF AND NYOFF ARE THE DIFFERENCES IN THE (1,1) POINT
C OF THE ANALYSIS AND SUBSETTED GRIDS AT THE CURRENT MESH
C LENGTH MESH. THERE IS NO NEED TO CALL CUTIT IF THE INPUT
C AND OUTPUT GRIDS ARE THE SAME. NXG AND NYG ARE THE
C DIMENSIONS OF THE GRID IN FD2( ) AT MESH LENGTH MESHL.
C
IF(NXOFF.NE.0.OR.NYOFF.NE.0.OR.NXG.NE.NXD.OR.NYG.NE.NYD)THEN
CALL CUTIT(KFILDO,FD2,NXG,NYG,NXOFF,NYOFF,
1 FD2,NXD,NYD,IER)
ENDIF
C
IF(IER.NE.0)THEN
ISTOP(1)=ISTOP(1)+1
KER=KER+1
WRITE(KFILDO,2655)(LD(J),J=1,4),PLAIN,NDATE
2655 FORMAT(' NOT WRITING UNSMOOTHED ANALYSIS ',3(1X,I9.9),
1 1X,I10.3,' ',A32,' FOR DATE',I12,/,
2 ' TO UNIT NO. KFILOG.')
GO TO 271
ENDIF
C
C FIND THE ACTUAL MESH LENGTH XMESHL FROM THE NOMINAL
C MESH LENGTH MESHL.
C
CALL ACTUAL(KFILDO,MESHL,XMESHL,TRASH,NPROJ,IER)
C XMESHL IS THE ACTUAL MESH LENGTH IN KM.
C
IF(IER.NE.0)THEN
WRITE(KFILDO,2656)IER
2656 FORMAT(/' FATAL ERROR IN ACTUAL FROM BCD5,',
1 ' IER =',I4)
ISTOP(1)=ISTOP(1)+1
KER=KER+1
GO TO 400
ENDIF
C
C FIND THE LAT/LONG ALATD/ALOND OF THE LOWER LEFT CORNER
C OF THE DISPOSABLE GRID. THIS IS GRIDPOINT IOPT(2), IOPT(4)
C ON THE FD2 GRID AT MESH LENGTH MESHL. THE MESH LENGTH MUST
C BE IN METERS FOR THE CALLED ROUTINES.
C
IF(NPROJ.EQ.3)THEN
CALL LMIJLL(KFILDO,FLOAT(IOPT(2)),FLOAT(IOPT(4)),
1 XMESHL*1000.,ORIENT,XLAT,
2 ALATL,ALONL,ALATD,ALOND,IER)
C
IF(IER.NE.0)THEN
WRITE(KFILDO,2657)IER
2657 FORMAT(/' FATAL ERROR IN LMIJLL FROM BCD5 AT 2657,',
1 ' IER =',I4)
ISTOP(1)=ISTOP(1)+1
KER=KER+1
GO TO 400
ENDIF
C
ELSEIF(NPROJ.EQ.5)THEN
CALL PSIJLL(KFILDO,FLOAT(IOPT(2)),FLOAT(IOPT(4)),
1 XMESHL*1000.,ORIENT,XLAT,
2 ALATL,ALONL,ALATD,ALOND)
ELSEIF(NPROJ.EQ.7)THEN
CALL MCIJLL(KFILDO,FLOAT(IOPT(2)),FLOAT(IOPT(4)),
1 XMESHL*1000.,XLAT,
2 ALATL,ALONL,ALATD,ALOND)
ELSE
WRITE(KFILDO,2658)NPROJ
2658 FORMAT(/' ****MAP PROJECTION NUMBER NPROJ =',I3,
1 ' NOT 3, 5, OR 7. FATAL ERROR IN BCD5 AT 2658.')
ISTOP(1)=ISTOP(1)+1
KER=KER+1
GO TO 400
ENDIF
C
CCC WRITE(KFILDO,2659)IOPT(2),IOPT(3),IOPT(4),IOPT(5),NXOFF,NYOFF,
CCC 1 NXG,NYG,NXD,NYD,MESH,MESHL,
CCC 2 ALATL,ALONL,ALATD,ALOND
CCC 2659 FORMAT(/,' AT 2659--IOPT(2),IOPT(3),IOPT(4),IOPT(5),NXOFF,NYOFF,',
CCC 1 'NXG,NYG,NXD,NYD,MESH,MESHL,',
CCC 2 'ALATL,ALONL,ALATD,ALOND',/,12I7,4F9.4)
C
C ALATD AND ALOND ARE THE LL LAT/LON GRID POSITION.
C TRUNCATE TO THREE DECIMAL PLACES TO ASSURE
C COMPATIBILITY WITH AVN ARCHIVE AND OTHER PROGRAMS.
C
ALATD=NINT(ALATD*1000)/1000.
ALOND=NINT(ALOND*1000)/1000.
C
C PAWGTS PACKS AND WRITES THE UNSMOOTHED DATA TO A
C GRIDPOINT FILE. BUT FIRST POSTPROCESS IF DESIRED.
C THE OUTPUT GRIDS FROM BCD5 ARE AT THE CURRENT MESH LENGTH
C MESH. WHEN A GRID HAS BEEN CLIPPED TO A LARGER MESH
C LENGTH IN FSTGS5 THAN MESH, THE AREA COVERED WITH
C NON-MISSING DATA MAY BE SLIGHTLY GRATER THAN THE DESIRED
C AREA AT MESH LENGTH MESH.
C
CALL TRNSFR(FD2,COUNT,NXD*NYD)
C DATA IN FD2( ) ARE TRANSFERRED TO COUNT( ) SO THIS
C DISPOSABLE OUTPUT POSTPROCESSING DOES NOT MODIFY THE
C DATA.
C
C POSTPROCESS IF NEEDED. THREE ROUTINES ARE AVAILABLE.
C
DO 2705 NN=1,NOPROD
C
IF(POSTDS(NN).NE.' ')THEN
C
IF(POSTDS(NN).EQ.'POST ')THEN
CALL POST(KFILDO,COUNT,NXD*NYD,
1 TLOD(NN),SETLOD(NN),THID(NN),SETHID(NN),
2 CONSTD(NN),NSCALD(NN),EX1D(NN),EX2D(NN),IER)
C IF A POSTPROCESSING ROUTINE OTHER THAN POST IS
C NEEDED, PUT CHECK AND CALL HERE.
C
ELSEIF(POSTDS(NN).EQ.'CIGFT ')THEN
CALL CIGFT(KFILDO,COUNT,NXD*NYD,
1 TLOD(NN),SETLOD(NN),THID(NN),SETHID(NN),
2 CONSTD(NN),NSCALD(NN),EX1D(NN),EX2D(NN),IER)
C THIS IS TO CHANGE LAMP CEILING HEIGHT IN CATEGORIES
C TO HUNDREDS OF FT.
C
CCCC ELSEIF(POSTDS(NN).EQ.'VISMI ')THEN
CCCC CALL VISMI(KFILDO,COUNT,NXD*NYD,
CCCC 1 TLOD(NN),SETLOD(NN),THID(NN),SETHID(NN),
CCCC 2 CONSTD(NN),NSCALD(NN),EX1D(NN),EX2D(NN),IER)
CCCCC THIS IS TO CHANGE LAMP VISIBILITY IN CATEGORIES
CCCCC TO MILES.
CCCC NOTE VIS WAS PREVIOUSLY ANALYZED IN CATEGORIES, NOW IN
C MI, SO VISMI NOT NEEDED.
ELSE
WRITE(KFILDO,270)POSTDS(NN)
270 FORMAT(/' ****POSTPROCESSING ROUTINE SPECIFIED',
1 ' IN U405A.CN FILE = ',A6,' FOR DISPOSABLE',
2 ' GRIDS NOT AVAILABLE IN BCD5. PROCEEDING.')
ISTOP(1)=ISTOP(1)+1
ENDIF
C
ENDIF
C
2705 CONTINUE
C
IF(ISQ.EQ.1)THEN
C
DO 2706 IXY=1,ND2X3
C
IF(COUNT(IXY).LT.9998.5)THEN
COUNT(IXY)=COUNT(IXY)*COUNT(IXY)
ENDIF
C
2706 CONTINUE
C
ENDIF
C
CALL PAWGTS(KFILDO,KFILOG,'KFILOG',IP16,NDATE,
1 LD,ITAUH,ITAUM,MODNO,NSEQ,ISCALD,
2 NPROJ,ALATD,ALOND,ORIENT,MESHL,XLAT,NXD,NYD,
3 COUNT,NCOUNT,IWORK,IPACK,ND2X3,MINPK,
4 IS0,IS1,IS2,IS4,ND7,
5 IPLAIN,PLAIN,NCHAR,
6 XMISSP,XMISSS,LX,IOCTET,
7 JTOTBY,JTOTRC,L3264B,L3264W,IER)
C
IF(IER.NE.0)THEN
ISTOP(1)=ISTOP(1)+1
KER=KER+1
C AN ERROR IN PAWGTS IS NOT CONSIDERED FATAL.
ENDIF
C
C THIS IS THE END OF THE DISPOSABLE AND GRIDPRINT OUTPUT
C FOR UNSMOOTHED GRIDS.
C
C SMOOTH FIELD IF DESIRED.
C
271 CONTINUE
IF(B(LP).EQ.0.)GO TO 290
C
C SAFETY CHECK. IF NOPTNT NE 0, THEN NSMTYP SHOULD EQUAL
C 8 TO INDICATE SPOTRM.
C
IF(NOPTNT.NE.0.AND.NSMTYP.NE.8)THEN
WRITE(KFILDO,272)NSMTYP
272 FORMAT(/' ****PROBABLE ERROR. NSMTYP =',I3,' WHEN SPOTRM',
1 ' IS INDICATED IN U405A.CN FILE. NSMTYP USED',
2 ' RATHER THAN SPOTRM.'/)
ISTOP(1)=ISTOP(1)+1
ENDIF
C
CCCC WRITE(KFILDO,2720)RAY,NPASSP,NOPTNT,LAMPNO,NSMTYP
CCCC 2720 FORMAT(/' AT 2720 IN BCD5--RAY,NPASSP,NOPTNT,LAMPNO,NSMTYP',
CCCC 1 F10.2,4I10)
C
IF(NSMTYP.EQ.1)THEN
CALL SMOTH(P,CORR,NX,NY,B(LP))
C
ELSEIF(NSMTYP.EQ.2)THEN
CALL SMOTHN(P,CORR,NX,NY,B(LP),NCOUNT)
C
ELSEIF(NSMTYP.EQ.3)THEN
C
IF(LP.EQ.NPASS)THEN
CALL SMTH9(KFILDO,P,CORR,NX,NY)
ELSE
CALL SMOTHN(P,CORR,NX,NY,B(LP),NCOUNT)
ENDIF
C
ELSEIF(NSMTYP.EQ.4)THEN
C
IF(LP.GE.4.AND.IVRBL.EQ.1)THEN
CALL SMOTHC(KFILDO,P,CORR,FD2,NX,NY,B(LP),NCOUNT,MESH)
C
C PAWGTS PACKS AND WRITES THE SMOOTHING ARRAY FD2
C TO A GRIDPOINT FILE.
C
D IF(KFILOG.NE.0.AND.NTDL(LP).NE.0.AND.JP(2).NE.0)THEN
C NXD ETC. HAVE TO BE COMPUTED ABOVE FOR THIS TO WORK.
D LD(1)=099000005
D LD(2)=LP*10000
C THE LLLL IN ID(2) IS USED FOR THE PASS NUMBER.
D LD(3)=0
D LD(4)=0
D ITAUH=0
D ITAUM=0
D NSEQ=0
D NCHAR=32
C 32 CHARACTERS OF PLAIN LANGUAGE ARE PACKED.
D XMISSP=9999.
D XMISSS=0.
D IZERO=0
C
C ASSUME FOR THIS TESTING THAT THE LOOP ABOVE TO SET
C ALATD, ETC. HAS BEEN EXECUTED. THIS GRID IS NOT
C CUT AND SHOULD BE USED WHEN THE DISPOSABLE GRID IS
C OF THE FULL SIZE.
C
D CALL PAWGTS(KFILDO,KFILOG,'KFILOG',IP16,NDATE,
D 1 LD,ITAUH,ITAUM,MODNO,NSEQ,IZERO,
D 2 NPROJ,ALATD,ALOND,ORIENT,MESHL,XLAT,NXD,NYD,
D 3 FD2,NCOUNT,IWORK,IPACK,ND2X3,MINPK,
D 4 IS0,IS1,IS2,IS4,ND7,
D 5 IPLAIN,PLAIN,NCHAR,
D 6 XMISSP,XMISSS,LX,IOCTET,
D 7 JTOTBY,JTOTRC,L3264B,L3264W,IER)
C
D IF(IER.NE.0)THEN
D ISTOP(1)=ISTOP(1)+1
D KER=KER+1
C AN ERROR IN PAWGTS IS NOT CONSIDERED FATAL.
D ENDIF
C
D ENDIF
C
ELSE
CALL SMOTHN(P,CORR,NX,NY,B(LP),NCOUNT)
ENDIF
C
ELSEIF(NSMTYP.GE.5.AND.NSMTYP.LE.7)THEN
RMESH=FLOAT(MESH)/FLOAT(MESHE)
C RMESH IS THE RATIO OF THE MESH LENGTH OF THE ANALYSIS GRID
C TO THE TERRAIN GRID.
C
C*************************************************
CCCC IND=509*NX+77
CCCC WRITE(KFILDO,273)P(IND),NX,NY,B(LP),SEALND(IND),
CCCC 1 NXE,NYE,RMESH,NSMTYP,NSHLN
CCCC 273 FORMAT(/'IN BCD5 AT 273--P(509*NX+77),NX,NY,B(LP),',
CCCC 1 'SEALND(509*NX+77),NXE,NYE,RMESH,NSMTYP,NSHLN( )',/,
CCCC 2 F8.3,2I5,2F8.3,2I6,F8.2,7I6)
C*************************************************
C
NSM5=JOCEAN*1000+JLAKE*100+NSMTYP
C SMOTHG HAS TO HAVE NSMTYP = 5-7. GIVE IT THREE SMOOTHINGS.
C JOCEAN AND JLAKE ALLOWS FOR NO SMOOTHING OVER WATER.
IG=0
C DON'T USE NEAR( , ). iT HASN'T BEEN INITIALIZED YET.
CALL SMOTHG(KFILDO,P,CORR,COUNT,IG,NEAR,NX,NY,B(LP),CSTSM,
1 TELEV,SEALND,NXE,NYE,
2 RMESH,NSM5,NSHLN,IER)
C THIS IS A SPECIALIZED SMOOTHER FOR GRIDDED MOS.
IF(IER.EQ.666)KER=KER+1
C
ELSEIF(NSMTYP.EQ.8)THEN
C
IF(RAY.GT.0..AND.LP.GE.NPASSP)THEN
WRITE(KFILDO,274)R(1),NPASSP,NSMN,NOPTNT,DIFFA,NOCEAN,
1 LAKE,DISTX,DPOWER,RAY
274 FORMAT(/' SPOT SMOOTHED POSSIBLY FOLLOWED BY TERRAIN',
1 ' FOLLOWING SMOOTHER INDICATED BY NSMNUM, RMAX =',
2 F5.1/
3 ' NPASSP =',I2,' NSMN =',I4,
4 ' NOPTN =',I2,' DIFFA =',F5.0,' NOCEAN =',I2,
5 ' LAKE =',I2,
6 ' DISTX =',F5.2,' DPOWER =',F5.2,
7 ' RAY =',F5.2/)
C
PLAINT='NEAREST DISTANCE TO STATION-SRM '
C
IF(NOPTNT.NE.0)THEN
C NOPTNT IS USED WITH LTAGPT( ) TO SELECTIVELY SMOOTH
C OUT BOGUS AND 1ST AND 2ND TIER AUGMENTATION.
C FOR LAMP TOTAL WIND, MTAGPT( ) IS USED VICE LTAGPT( ).
C
IF(LAMPNO.EQ.20)THEN
CALL SPOTRM(KFILDO,KFILOG,IP16,NAREA,
1 CCALL,XP,YP,LNDSEA,NOPTNT,LTAG,MTAGPT,
2 STALAT,STALON,NSTA,
3 ID,IDPARS,P,COUNT,MESH,NX,NY,
4 TELEV,SEALND,CPNDFD,NXE,NYE,MESHE,
5 IPACK,DATA,IWORK,ND5,
6 MODNO,NDATE,NCLIP,
7 ALATL,ALONL,NPROJ,ORIENT,XLAT,ISCALD,
8 DIFFA,NOCEAN,LAKE,DISTX,DPOWER,RAY,R(1),
9 LH,
A IS0,IS1,IS2,IS4,ND7,
B JTOTBY,JTOTRC,PLAINT,IPLANT,
C L3264B,L3264W,MINPK,ISTOP(1),IER)
ELSE
CALL SPOTRM(KFILDO,KFILOG,IP16,NAREA,
1 CCALL,XP,YP,LNDSEA,NOPTNT,LTAG,LTAGPT,
2 STALAT,STALON,NSTA,
3 ID,IDPARS,P,COUNT,MESH,NX,NY,
4 TELEV,SEALND,CPNDFD,NXE,NYE,MESHE,
5 IPACK,DATA,IWORK,ND5,
6 MODNO,NDATE,NCLIP,
7 ALATL,ALONL,NPROJ,ORIENT,XLAT,ISCALD,
8 DIFFA,NOCEAN,LAKE,DISTX,DPOWER,RAY,R(1),
9 LH,
A IS0,IS1,IS2,IS4,ND7,
B JTOTBY,JTOTRC,PLAINT,IPLANT,
C L3264B,L3264W,MINPK,ISTOP(1),IER)
ENDIF
C IF IER NE 0, A DIAGNOSTIC IS PRODUCED IN SPOTRM WITH
C ISTOP(1) INCREMENTED.
C
IF(IER.EQ.777)THEN
JER=JER+1
GO TO 290
C IER = 777 IS FATAL IN SPOTRM, SO SKIP CALCULATIONS
ENDIF
C DEPENDING ON GOOD RESULTS.
ENDIF
C
C FOLLOW THE SPOTRM SMOOTHER WITH TWO TERRAIN FOLLOWING
C PASSES TO SMOOTH OUT NOISE. NEITHER SPOTRM OR SMOTHG
C WILL SMOOTH THE 4 GRIDPOINTS AROUND A STATION.
C
IF(LP.EQ.NPASS)THEN
C SMOTHG SMOOTHING AND SETTING THE 4 GRIDPOINTS TO THE
C STATION VALUE BY SETGPT IS DONE ONLY ON THE LAST
C PASS; SPOTRM MAY BE USED ON EARLIER PASSES.
C
IF(NSMNUM.NE.0)THEN
C NSMNUM MAY BE ZERO HERE INDICATING NO SMOOTHING.
C SMOTHG IF ENTERED WITH NSMNUM = 0 WILL GIVE AN
C UNWANTED DIAGNOSTIC.
C
C CALL SETGPT TO SET THE GRIDPOINTS TO NOT SMOOTH.
C THIS IS DONE EACH GRID BECAUSE TOSSED DATA OR
C BOGUS MAY BE DIFFERENT.
C
CALL SETGPT(KFILDO,CCALL,NAME,LTAG,LTAGPT,LNDSEA,
1 XP,YP,NSTA,
2 NAREA,NEAR,NX,NY,MESH,SEALND,NXE,NYE,
3 MESHE,ISETG,IER)
RMESH=FLOAT(MESH)/FLOAT(MESHE)
C RMESH IS THE RATIO OF THE MESH LENGTH OF THE
C ANALYSIS GRID TO THE TERRAIN GRID.
IG=1
C USE NEAR( , ).
C
CALL SMOTHG(KFILDO,P,CORR,COUNT,IG,NEAR,NX,NY,B(LP),
1 CSTSM,TELEV,SEALND,NXE,NYE,
2 RMESH,NSMN,NSHLN,IER)
C NSMN HAS ITS ORIGINAL INCOMING TRIPLE VALUE.
C THIS IS A SPECIALIZED SMOOTHER FOR GRIDDED MOS.
IF(IER.EQ.666)KER=KER+1
C
ELSE
WRITE(KFILDO,275)
275 FORMAT(/' NO SMOTHG SMOOTHING BEING DONE.')
ENDIF
C
ENDIF
C
ELSEIF(B(LP).GT.98.)THEN
C THIS IS A NOOP. IT ALLOWS B(LP)=99 FOR SMOOTHING ABOVE
C CALL TO ESP.
C
ELSE
WRITE(KFILDO,2753)NSMTYP,RAY,LP,NPASSP,B(LP)
2753 FORMAT(/' ****NSMTYP =',I3,' RAY =',F6.3,' LP =',I3,
1 ' NPASSP =',I3,' FOR B(LP) =',F6.3,
2 ' IS ILLEGAL COMBINATION.',/,
3 ' SMOOTHING NOT DONE FOR THIS VARIABLE,',
4 ' FOR THIS PASS.')
ISTOP(1)=ISTOP(1)+1
GO TO 290
ENDIF
C
ELSE
C
WRITE(KFILDO,2754)NSMTYP
2754 FORMAT(/' ****NSMTYP =',I4,' NOT A CORRECT VALUE OF',
1 ' 1, 2, 3, ,4, 5, 6, 7 OR 8.',
2 ' SMOOTHING NOT DONE FOR THIS VARIABLE.')
ISTOP(1)=ISTOP(1)+1
GO TO 290
ENDIF
C
C THE FOLLOWING DIAGNOSTIC PRINT PRODUCED ON IP19 INDICATES
C FOR EACH DATUM THE DEGREE OF FIT OF THE SMOOTHED ANALYSIS
C TO THE DATA OF THE PASS LP. DIFFERENCES BETWEEN DATA VALUES
C AND INTERPOLATED VALUES ARE NOT USED FOR THIS PURPOSE FOR
C POINTS OUTSIDE THE NX BY NY GRID. AUGMENTED DATA, IF ANY,
C ARE NOT USED.
C
IF(IP19.NE.0.OR.IP21.NE.0.OR.IOPT(1).NE.0)THEN
C ANY TIME THERE IS A SUBSET AREA, THE DEGREE OF FIT IS
C COMPUTED.
C
IF(IP19.NE.0)THEN
WRITE(IP19,2755)(JDATE(J),J=1,4),LP,TITLE(1:16),MESH
2755 FORMAT(/' FOR DATE',I6,3I3.2,' VALUES AT END OF BCD5 PASS',
1 ' NO.',I3,' (SMOOTHED) FOR ',A16,
2 ' FOR MESH LENGTH =',I4/
3 ' ONLY BASE STATIONS WITH LTAG = 0 OR -1 ARE PRINTED;',
4 ' THOSE PERMANENTLY DISCARDED ARE NOT PRINTED.',
5 ' BB IS THE ANALYSIS VALUE.'/
6 ' STATIONS WITH NO DIFFERENCES ARE OUTSIDE THE GRID'/
7 ' NO. STATION XPOS YPOS DATA',
8 ' BB DIF LTAG QUALST')
ENDIF
C
SUM=0.
NSUM=0
C SUM AND NSUM ARE FOR SUMMING THE DIFFERENCES BETWEEN THE
C INTERPOLATED VALUES AND THE OBSERVATIONS FOR ALL
C OBSERVATIONS WITHIN THE GRID.
SUMGR=0.
NSUMGR=0
C SUMGR AND NSUMGR ARE FOR SUMMING THE DIFFERENCES
C BETWEEN THE INTERPOLATED VALUES AND THE OBSERVATIONS
C FOR ALL OBSERVATIONS WITHIN THE SUBSETTED AREA ONLY.
C
DO 2757 M=1,3
DIFMAX(M)=0.
STAMAX(M)=' '
NAMMAX(M)=' '
C DIFMAX( ) IS FOR COLLECTING THE THREE LARGEST
C DIFFERENCES; STAMAX( ) AND NAMMAX ARE FOR THE ASSOCIATED
C STATIONS CALL LETTERS AND NAMES, RESPECTIVELY.
2757 CONTINUE
C
XNX=NX
YNY=NY
C
DO 278 K=1,NSTA
C
IF(LTAG(K).GE.1)GO TO 278
C ONLY STATIONS NOT TOSSED ON THE LAST PASS ARE USED.
C
IF(ILS.NE.0.AND.LNDSEA(K).LE.3)GO TO 278
C THIS TEST PUT IN TO VERIFY ONLY LAND STATIONS WHEN THE
C LAND AND WATER ARE SEPARATED IN THE ANALYSIS.
C
C THE BELOW TEST PUT IN TO VERIFY ONLY BASE STATIONS, NOT
C ANY BOGUS OR AUGMENTED ONES. NORMALLY, BASE STATIONS ARE
C INDICATED BY 0 IN LTAGPT( ), BUT THIS IS NOT THE CASE
C FOR TOTAL WIND, SO MTAGPT( ) FROM WIND SPEED IS USED.
IF(LAMPNO.EQ.20)THEN
IF(MTAGPT(K).GT.0)GO TO 278
ELSE
IF(LTAGPT(K).GT.0)GO TO 278
ENDIF
C
IF(QUALST(K).LE..99)GO TO 278
C ABOVE ADDED 1/4/16. OMITS MESONET STATIONS WHEN USED
C WITH REDUCED WEIGHT.
C
C FIND INTERPOLATED VALUE OR NEAREST NEIGHBOR VALUE IN
C ITRPSL ACCORDING TO THE LAND/WATER TYPE LNDSEA(K).
C
CALL ITRPSX(KFILDO,IP14,P,NX,NY,
1 CCALL(K),XDATA(K),XLAPSE(K),ELEV(K),XP(K),YP(K),
2 LNDSEA(K),SEALND,TELEV,NXE,NYE,
3 IBKPN,ELCORR(LP),ELCORU(LP),
4 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 EXISTS. ALSO, THE FIRST GUESS ANALYSIS AREA
C MAY NOT FILL GRID. IN THIS CASE, IER NE 0.
C
IF(IER.NE.0)THEN
IF(IER.EQ.195)ISTOP(1)=ISTOP(1)+1
C A **** IER = 195 ERROR IN ITRPSL MEANS AN ERROR IN THE
C STATION TABLE CONCERNING LAND/WATER POINT DESIGNATIONS.
C A #### IER = 196 ERROR MEANS GRID POINTS OF NECESSARY
C TYPE ARE NOT AVAILABLE, AND IS NOT COUNTED AS AN ERROR.
IER=0
GO TO 277
ENDIF
C
IF(XP(K).LT.1..OR.XP(K).GT.XNX)GO TO 277
IF(YP(K).LT.1..OR.YP(K).GT.YNY)GO TO 277
DIF=BB-XDATA(K)
ADIF=ABS(DIF)
IF(LTAG(K).EQ.-1)GO TO 276
C
CCCC IF(CCALL(K).EQ.'PAGM ')THEN
CCCC WRITE(KFILDO,1234)CCALL(K),XDATA(K),BB,ADIF
CCCC 1234 FORMAT(/' AT 1234 IN BCD5--CCALL(K),XDATA(K),BB,ADIF ',
CCCC 1 A8,3F10.3)
CCCC ENDIF
C
SUM=SUM+ADIF
NSUM=NSUM+1
C
C WHEN IOPT(1) = 0, THERE IS NO SUBSET AREA, SO DO NO
C CALCULATIONS FOR IT.
C
IF(IOPT(1).NE.0)THEN
C
IF(XP(K).LE.IOPTGR(3).AND.
1 XP(K).GE.IOPTGR(2).AND.
2 YP(K).LE.IOPTGR(5).AND.
3 YP(K).GE.IOPTGR(4))THEN
NSUMGR=NSUMGR+1
SUMGR=SUMGR+ADIF
C
IF(ADIF.GT.DIFMAX(1))THEN
DIFMAX(3)=DIFMAX(2)
STAMAX(3)=STAMAX(2)
NAMMAX(3)=NAMMAX(2)
DIFMAX(2)=DIFMAX(1)
STAMAX(2)=STAMAX(1)
NAMMAX(2)=NAMMAX(1)
DIFMAX(1)=ADIF
STAMAX(1)=CCALL(K)
NAMMAX(1)=NAME(K)
ELSEIF(ADIF.GT.DIFMAX(2))THEN
DIFMAX(3)=DIFMAX(2)
STAMAX(3)=STAMAX(2)
NAMMAX(3)=NAMMAX(2)
DIFMAX(2)=ADIF
STAMAX(2)=CCALL(K)
NAMMAX(2)=NAME(K)
ELSEIF(ADIF.GT.DIFMAX(3))THEN
DIFMAX(3)=ADIF
STAMAX(3)=CCALL(K)
NAMMAX(3)=NAME(K)
ENDIF
C
ENDIF
C
ENDIF
C
C***D WRITE(KFILDO,2758)K,CCALL(K),XP(K),YP(K),
C***D 1 IOPTGR(3),IOPTGR(2),
C***D 2 IOPTGR(5),IOPTGR(4),NSUMGR,SUMGR
C***D2758 FORMAT(' IN BCD5 AT 2758--K,CCALL(K),XP(K),YP(K),',
C***D 1 'IOPTGR(3,2,5,4),',
C***D 2 'NSUMGR,SUMGR',I5,1X,A6,2F7.2,4F6.0,I5,F8.2)
C
276 IF(IP19.NE.0)THEN
WRITE(IP19,260)K,CCALL(K),XP(K),YP(K),XDATA(K),BB,DIF,
1 LTAG(K),QUALST(K)
GO TO 278
ENDIF
C
277 IF(IP19.NE.0)THEN
WRITE(IP19,262)K,CCALL(K),XP(K),YP(K),XDATA(K),BB,LTAG(K),
1 QUALST(K)
ENDIF
C
278 CONTINUE
C
AVG=9999.
IF(NSUM.NE.0)AVG=SUM/NSUM
C
IF(IP21.NE.0)THEN
WRITE(IP21,2785)(JDATE(J),J=1,4),NSUM,LP,TITLE(1:16),AVG
2785 FORMAT(' FOR DATE',I6,3I3.2,' MEAN ABS DIFF OF',I6,
1 ' VALUES USED WITHIN THE GRID',
2 ' ON PASS NO.',I2,' FOR ',A16,' =',F7.3,
3 ' (SMOOTHED)')
ENDIF
C
C COMPUTE AND PRINT THE AVERAGE DIFFERENCE BETWEEN THE DATA
C AND THE CURRENT SMOOTHED ANALYSIS OVER THE SUBSETTED AREA.
C
IF(IOPT(1).NE.0)THEN
C
IF(NSUMGR.EQ.0)THEN
AVGGR=9999.
ELSE
AVGGR=SUMGR/NSUMGR
ENDIF
C
IF(IP20.NE.0)THEN
WRITE(IP20,2787)
1 (JDATE(J),J=1,4),NSUMGR,LP,TITLE(1:16),AVGGR,
2 (STAMAX(M),NAMMAX(M),DIFMAX(M),M=3,1,-1)
2787 FORMAT(/' FOR DATE',I6,3I3.2,' MEAN ABS DIFF OF',I6,
1 ' VALUES USED IN SUBSET AREA ',
2 ' ON PASS NO.',I2,' FOR ',A16,' =',F7.3,
3 ' (SMOOTHED)',/,
4 4X,'BIG DIFFERENCES = ',A8,A20,F7.3,', ',
5 A8,A20,F7.3,', ',
6 A8,A20,F7.3)
ENDIF
C
IF(I405ADG.NE.0)THEN
C
IF(IP20.NE.KFILDO)THEN
WRITE(KFILDO,2787)
1 (JDATE(J),J=1,4),NSUMGR,LP,TITLE(1:16),AVGGR,
2 (STAMAX(M),NAMMAX(M),DIFMAX(M),M=3,1,-1)
ENDIF
C
ENDIF
C
ELSE
C THERE IS NOT A SUBSET AREA.
AVGGR=AVG
NSUMGR=NSUM
C AVGGR AND NSUMGR ARE PRINTED AT THE BOTTOM OF THE
C GRIDPRINTED MAP. IF THERE IS NO SUBSETTED AREA, THE
C WHOLE AREA MAY BE PRINTED. THEREFORE, SET AVGGR TO
C AVG AND NSUMGR TO NSUM.
ENDIF
C
ENDIF
C
C PREPARE SMOOTHED MAPS FOR GRIDPRINTING AND OR
C WRITING IN TDLPACK, IF DESIRED.
C
IF(JPRT(LP).NE.0.AND.IP22.NE.0.AND.JP(1).NE.0)GO TO 2790
IF(JTDL(LP).NE.0.AND.KFILOG.NE.0.AND.JP(2).NE.0)GO TO 2790
GO TO 290
C
C TO PROCEED BELOW, EITHER JPRT(LP) AND JP(1)
C INDICATE GRIDPRINTING OR JTDL(LP) AND JP(2) INDICATE
C PACKING AND THERE IS A NONZERO UNIT NUMBER TO WRITE TO.
C
2790 NXG=NX
NYG=NY
MESHG=MESH
C NXG, ETC. ARE NECESSARY BECAUSE SZGRDM CHANGE THEM, AND
C NX, ETC. MUST BE RETAINED.
CALL TRNSFR(P,FD2,NX*NY)
C
D WRITE(KFILDO,2791)NX,NY
D2791 FORMAT(/' CALLING SZGRDM AT 2791--NX,NY',2I6)
C
CALL SZGRDM(KFILDO,FD2,NXG,NYG,
1 MESHG,MESHL,ITRPLQ(LP),ND2X3)
C SZGIRD PUTS THE GRID IN FD2( ) AT SUBSET MESH LENGTH MESHL.
C IOPT( ) IS IN RELATION TO THAT MESH LENGTH.
C
C GRIDPRINT SMOOTHED FIELD IF DESIRED.
C
IF(JPRT(LP).EQ.0.OR.IP22.EQ.0.OR.JP(1).EQ.0)GO TO 2793
TITLE(17:24)=SMTH(1:8)
CALL PRTGR(IP22,FD2,NXG,NYG,
1 CINT(LP),ORIGIN(LP),SMULT(LP),SADD(LP),IOPT,TITLE,IER)
IF(IER.NE.0)ISTOP(1)=ISTOP(1)+1
C A NON-ZERO IER IS NOT CONSIDERED FATAL.
C
C AT THE BOTTOM OF THE MAP, BELOW THE TITLE, PRINT
C THE PASS NUMBER LP, NTYPE( ), R( ), B( ), AND ER1( ).
C IT IS EXPECTED THAT 4 PASSES WILL USUALLY BE USED
C AND ALL THOSE VALUES ARE PRINTED. HOWEVER, IF NPASS
C IS GT 4, IT IS ACCOMMODATED. THE NUMBER OF VALUES WITHIN
C THE GRIDPRINTED AREA AND THE AVERAGE ABSOLUTE DIFFERENCE
C ARE ALSO PRINTED.
C
IF(NPASS.LE.4)THEN
WRITE(IP22,2648)LP,(NTYPE(J),J=1,4),(R(J),J=1,4),
1 (MSHPAS(J),J=1,4),NSMTYP,(B(J),J=1,4),
2 (ER1(J),J=1,4),
3 (ITRPLQ(J),J=1,4),NSUMGR,AVGGR
C
IF(IVRBL.EQ.1)THEN
WRITE(IP22,2649)(WNDWT(J),J=1,4),WNDTHR,WNDTRN,WNDGRD
ENDIF
C
ELSEIF(NPASS.EQ.5)THEN
WRITE(IP22,265)LP,(NTYPE(J),J=1,5),(R(J),J=1,5),
1 (MSHPAS(J),J=1,5),NSMTYP,(B(J),J=1,5),
2 (ER1(J),J=1,5),
3 (ITRPLQ(J),J=1,5),NSUMGR
C
IF(IVRBL.EQ.1)THEN
WRITE(IP22,2650)(WNDWT(J),J=1,5),WNDTHR,WNDTRN,WNDGRD,AVGGR
ENDIF
C
WRITE(IP22,2651)CINT(LP),ORIGIN(LP),SMULT(LP),SADD(LP)
ELSE
WRITE(IP22,2652)LP,(NTYPE(J),J=1,6),(R(J),J=1,6),
1 (MSHPAS(J),J=1,6),(B(J),J=1,6),(ER1(J),J=1,6),
2 (ITRPLQ(J),J=1,6),NSUMGR,AVGGR
ENDIF
C
IF(NPASS.NE.5)THEN
WRITE(IP22,2653)CINT(LP),ORIGIN(LP),SMULT(LP),SADD(LP)
ENDIF
C
C TDLPACK AND WRITE SMOOTHED FIELD IF DESIRED FOR THE
C SUBSET AREA. WHEN IOPT(1) = 0, THERE IS NO SUBSET AREA.
C
2793 IF(JTDL(LP).EQ.0.OR.KFILOG.EQ.0.OR.JP(2).EQ.0.
1 OR.IOPT(1).EQ.0)GO TO 290
LD(1)=ID(1)
LD(2)=LP*10000+IDPARS(7)
C THE LLLL IN ID(2) IS USED FOR THE PASS NUMBER.
C IDPARS(7) MAINTAINS THE LEVEL.
LD(3)=ID(3)
LD(4)=(ID(4)/1000)*1000+010
C THIS IS THE SMOOTHED ANALYSIS; S IN ID(4) = 010.
ITAUH=IDPARS(12)
ITAUM=0
NSEQ=0
NCHAR=32
C 32 CHARACTERS OF PLAIN LANGUAGE ARE PACKED.
XMISSP=0
XMISSS=0
C THESE ARE ANALYSES AND NO MISSING VALUES ARE PROVIDED FOR.
C IF THERE EVER ARE, JUST SET XMISSP=9999, OR WHATEVER THE
C MISSING VALUE IS.
C
C THE GRID IN FD2( ) IS ALWAYS AT MESH LENGTH MESHL AS A
C RESULT OF SZGRDM, WHICH IS WHAT IS WANTED FOR THE
C DISPOSABLE GRID. NOW CUT THE GRID TO THE DISPOSABLE
C AREA. IOPT( ) IS IN RELATION TO MESHL, WHICH IS THE
C MESH LENGTH OF FD2( ).
C
NXD=IOPT(3)-IOPT(2)+1
NYD=IOPT(5)-IOPT(4)+1
NXOFF=IOPTGR(2)-1
NYOFF=IOPTGR(4)-1
C NXOFF AND NYOFF ARE THE DIFFERENCES IN THE (1,1) POINT
C OF THE ANALYSIS AND SUBSETTED GRIDS AT THE CURRENT MESH
C LENGTH MESH. THERE IS NO NEED TO CALL CUTIT IF THE INPUT
C AND OUTPUT GRIDS ARE THE SAME. NXG AND NYG ARE THE
C DIMENSIONS OF THE GRID IN FD2( ) AT MESH LENGTH MESHL.
C
IF(NXOFF.NE.0.OR.NYOFF.NE.0.OR.NXG.NE.NXD.OR.NYG.NE.NYD)THEN
CALL CUTIT(KFILDO,FD2,NXG,NYG,NXOFF,NYOFF,
1 FD2,NXD,NYD,IER)
ENDIF
C
IF(IER.NE.0)THEN
ISTOP(1)=ISTOP(1)+1
JER=JER+1
WRITE(KFILDO,2795)(LD(J),J=1,4),PLAIN,NDATE
2795 FORMAT(' NOT WRITING SMOOTHED ANALYSIS ',3(1X,I9.9),
1 1X,I10.3,' ',A32,' FOR DATE',I12,/,
2 ' TO UNIT NO. KFILOG.')
GO TO 290
ENDIF
C
CALL ACTUAL(KFILDO,MESHL,XMESHL,TRASH,NPROJ,IER)
C XMESHL IS THE ACTUAL MESH LENGTH IN KM.
C
IF(IER.NE.0)THEN
WRITE(KFILDO,2656)IER
ISTOP(1)=ISTOP(1)+1
KER=KER+1
GO TO 400
ENDIF
C
IF(NPROJ.EQ.3)THEN
CALL LMIJLL(KFILDO,FLOAT(IOPT(2)),FLOAT(IOPT(4)),
1 XMESHL*1000.,ORIENT,XLAT,
2 ALATL,ALONL,ALATD,ALOND,IER)
C
IF(IER.NE.0)THEN
WRITE(KFILDO,2796)IER
2796 FORMAT(/' FATAL ERROR IN LMIJLL FROM BCD5 AT 2796,',
1 ' IER =',I4)
ISTOP(1)=ISTOP(1)+1
KER=KER+1
GO TO 400
ENDIF
C
ELSEIF(NPROJ.EQ.5)THEN
CALL PSIJLL(KFILDO,FLOAT(IOPT(2)),FLOAT(IOPT(4)),
1 XMESHL*1000.,ORIENT,XLAT,
2 ALATL,ALONL,ALATD,ALOND)
ELSEIF(NPROJ.EQ.7)THEN
CALL MCIJLL(KFILDO,FLOAT(IOPT(2)),FLOAT(IOPT(4)),
1 XMESHL*1000.,XLAT,
2 ALATL,ALONL,ALATD,ALOND)
ELSE
WRITE(KFILDO,2797)NPROJ
2797 FORMAT(/' ****MAP PROJECTION NUMBER NPROJ =',I3,
1 ' NOT 3, 5, OR 7. FATAL ERROR IN BCD5 AT 2797.')
ISTOP(1)=ISTOP(1)+1
KER=KER+1
GO TO 400
ENDIF
C
C ALATD AND ALOND ARE THE LL LAT/LON GRID POSITION.
C TRUNCATE TO THREE DECIMAL PLACES TO ASSURE
C COMPATIBILITY WITH AVN ARCHIVE AND OTHER PROGRAMS.
ALATD=NINT(ALATD*1000)/1000.
ALOND=NINT(ALOND*1000)/1000.
C
C PAWGTS PACKS AND WRITES THE SMOOTHED DATA TO A
C GRIDPOINT FILE. BUT FIRST POSTPROCESS IF DESIRED.
C THE OUTPUT GRIDS FROM BCD5 ARE AT THE CURRENT MESH LENGTH
C MESH. WHEN A GRID HAS BEEN CLIPPED TO A LARGER MESH
C LENGTH IN FSTGS5 THAN MESH, THE AREA COVERED WITH
C NON-MISSING DATA MAY BE SLIGHTLY GRATER THAN THE DESIRED
C AREA AT MESH LENGTH MESH.
C
CALL TRNSFR(FD2,COUNT,NXD*NYD)
C DATA IN FD2( ) ARE TRANSFERRED TO COUNT( ) SO THIS
C ARCHIVE OUTPUT POSTPROCESSING DOES NOT MODIFY THE
C DATA.
C
C POSTPROCESS IF NEEDED. THREE ROUTINES ARE AVAILABLE.
C
DO 2798 NN=1,NOPROD
C
IF(POSTDS(NN).NE.' ')THEN
C
IF(POSTDS(NN).EQ.'POST ')THEN
CALL POST(KFILDO,COUNT,NXD*NYD,
1 TLOD(NN),SETLOD(NN),THID(NN),SETHID(NN),
2 CONSTD(NN),NSCALD(NN),EX1D(NN),EX2D(NN),IER)
C THERE IS NO NONZERO IER RETURN.
C IF A POSTPROCESSING ROUTINE OTHER THAN POST IS
C NEEDED, PUT CHECK AND CALL HERE.
C
ELSEIF(POSTDS(NN).EQ.'CIGFT ')THEN
CALL CIGFT(KFILDO,COUNT,NXD*NYD,
1 TLOD(NN),SETLOD(NN),THID(NN),SETHID(NN),
2 CONSTD(NN),NSCALD(NN),EX1D(NN),EX2D(NN),IER)
C THERE IS NO NONZERO IER RETURN.
C THIS IS TO CHANGE LAMP CEILING HEIGHT IN CATEGORIES
C TO HUNDREDS OF FT.
ELSE
WRITE(KFILDO,270)POSTDS(NN)
ISTOP(1)=ISTOP(1)+1
ENDIF
C
ENDIF
C
2798 CONTINUE
C
IF(ISQ.EQ.1)THEN
C
DO 2799 IXY=1,ND2X3
C
IF(COUNT(IXY).LT.9998.5)THEN
COUNT(IXY)=COUNT(IXY)*COUNT(IXY)
ENDIF
C
2799 CONTINUE
C
ENDIF
C
CALL PAWGTS(KFILDO,KFILOG,'KFILOG',IP16,NDATE,
1 LD,ITAUH,ITAUM,MODNO,NSEQ,ISCALD,
2 NPROJ,ALATD,ALOND,ORIENT,MESHL,XLAT,NXD,NYD,
3 COUNT,NCOUNT,IWORK,IPACK,ND2X3,MINPK,
4 IS0,IS1,IS2,IS4,ND7,
5 IPLAIN,PLAIN,NCHAR,
6 XMISSP,XMISSS,LX,IOCTET,
7 JTOTBY,JTOTRC,L3264B,L3264W,IER)
C
IF(IER.NE.0)THEN
ISTOP(1)=ISTOP(1)+1
KER=KER+1
ENDIF
C
C THIS IS THE END OF THE DISPOSABLE AND GRIDPRINT OUTPUT
C FOR SMOOTHED GRIDS.
C
290 CONTINUE
C
IF(NREPNO.GT.0)THEN
C A REPEAT MAY BE NECESSARY.
C
IF(LTOSS(1).GT.0.OR.LTOSS(2).GT.0)THEN
C ONE OR MORE STATIONS HAVE BEEN TOSSED ON THIS PASS.
NOTOSS(1)=NOTOSS(1)+LTOSS(1)
NOTOSS(2)=NOTOSS(2)+LTOSS(2)
LTOSS(1)=0
LTOSS(2)=0
C
IF(LPP.LT.NREPNO)THEN
C IF ANOTHER PASS IS DONE, START WITH THE ANALYSIS
C PREVIOUS TO THE REPEAT PASS. SET LTAG( ) FOR
C THE TOSSED STATIONS TO +4 SO THEY WON'T BE USED.
C IF THIS IS THE LAST REPEAT PASS, THE LTAG( )
C VALUES CAN BE LEFT -1 AS THEY WILL BE TAKEN
C CARE OF LATER, JUST AS THEY WERE BEFORE THE
C REPEAT OPTION WAS ADDED.
C
WRITE(KFILDO,294)
294 FORMAT(/' RESTORING P( , ) FROM FD6( , ).')
C
DO 295 J=1,NX*NY
P(J)=FD6(J)
295 CONTINUE
C
DO 296 K=1,NSTA
C
IF(LTAG(K).EQ.-1)THEN
C A STATION DISCARDED ON THIS PASS WILL NOT BE
C USED ON THE NEXT PASS, NOR ON ANY DOWNSTREAM
C ANALYSIS. THE VALUE 4 IS DEALT WITH IN
C AUGMT2.
LTAG(K)=4
XDATA(K)=9999.
ENDIF
C
296 CONTINUE
C
ENDIF
C
ELSE
GO TO 350
ENDIF
C
ELSE
NOTOSS(1)=NOTOSS(1)+LTOSS(1)
NOTOSS(2)=NOTOSS(2)+LTOSS(2)
ENDIF
C
LREPNO=LREPNO+1
NSTA=NSTASV
C BOGUSG, IF CALLED, INCREASES NSTA; IT MUST BE RESET.
C
300 CONTINUE
C
C WHEN ANALYZING THE SQUARE ROOT OF AN ELEMENT, BEFORE RETURN,
C TRANXFER DATA BACK INTO XDTA( ) AND SQUARE THE ANALLYSIS.
C
IF(ISQ.EQ.1)THEN
CALL TRNSFR(XDATSV,XDATA,NSTA)
C
DO 305 IXY=1,ND2X3
C
IF(P(IXY).LT.9998.5)THEN
P(IXY)=P(IXY)*P(IXY)
ENDIF
C
305 CONTINUE
C
ENDIF
C
C WHEN DESIRED, PUT EACH STATION VALUE AT THE NEAREST GRIDPOINT,
C PROVIDED A CLOSER STATION TO THE GRIDPOINT DOES NOT EXIST.
C THIS IS DONE HERE IF IT IS (1) THE LAST PASS, (2) SMOOTHING
C IS DONE, AND (3) ISETP NE 0. ONLY THE ORIGINAL
C (BASE) STATIONS ARE USED IN SETTING GRIDPOINT VALUES
C IN SETPNT. NOTE THAT IF SCALING ON THE ORIGINAL VALUES
C HAS BEEN DONE, THEN IT IS THESE SCALED VALUES THAT ARE
C USED. THE SCALED VALUE WILL, WHEN TRUNCATED TO AN INTEGER,
C HAVE THE ORIGINAL INTEGER VALUE.
C
C THE 4 POINTS AROUND A STATION MAY HAVE BEEN SET TO THE
C STATION VALUE BY SETGPT, BUT SETPNT IS LEFT HERE FOR SAFETY.
C IS VERY FAST AND ASSURES THE CLOSEST GRIDPOINT HAS THE
C STATION VALUE.
C
350 IF(ISETP.NE.0)THEN
C
C**************************************************************
CCCC WRITE(KFILDO,351)LP,B(LP),ISETP,
CCCC 1 (KKK,CCALL(KKK),LTAG(KKK),LTAGPT(KKK),KKK=1,NBASTA)
CCCC 351 FORMAT(/' AT 9876--LP,B(LP),ISETP,',
CCCC 1 '(KKK,CCALL(KKK),LTAG(KKK),LTAGPT(KKK),KKK=1,NBASTA)',
CCCC 2 /,I6,F6.1,I6,/,(I6,2X,A8,2I4))
C**************************************************************
C
IF(LAMPNO.EQ.20)THEN
C NORMALLY LTAGPT IS FURNISHED TO ONLY SET POINTS
C FOR BASE STATIONS, BUT FOR LAMP TW THIS INCLUDES ALL
C SPEED AUGMENTED STATIONS, SO MTAGPT IS FURNISHED
C WHICH WAS SAVED FROM SPEED.
CALL SETPNT(KFILDO,CCALL,NAME,XDATA,LTAG,MTAGPT,LNDSEA,
1 XP,YP,NBASTA,
2 P,FD2,NX,NY,MESH,SEALND,NXE,NYE,MESHE,
3 ISETP,IER)
C ONLY NON-BOGUSG POINTS ARE CONSIDERED IN SETPNT.
C IER NE 0 WHEN ISETP NOT IN CORRECT RANGE. THIS IS A
C NON-FATAL ERROR.
C
IF(IER.NE.0)THEN
ISTOP(1)=ISTOP(1)+1
KER=KER+1
IER=0
ENDIF
ELSE
CALL SETPNT(KFILDO,CCALL,NAME,XDATA,LTAG,LTAGPT,LNDSEA,
1 XP,YP,NBASTA,
2 P,FD2,NX,NY,MESH,SEALND,NXE,NYE,MESHE,
3 ISETP,IER)
C ONLY NON-BOGUSG POINTS ARE CONSIDERED IN SETPNT.
C IER NE 0 WHEN ISETP NOT IN CORRECT RANGE. THIS IS A
C NON-FATAL ERROR.
C
IF(IER.NE.0)THEN
ISTOP(1)=ISTOP(1)+1
KER=KER+1
IER=0
ENDIF
C
ENDIF
C
ENDIF
C
400 IER=KER
C IER RETURNS THE NUMBER OF ERRORS IN BCD5.
IVRAD=IVRADS
C
C ANALYSIS DONE AND PRINTED.
C BCD5 DOES NOT RETURN A NON-ZERO ERROR.
C
CCCC WRITE(IP14,431)(K,CCALL(K),XDATA(K),LTAG(K),LTAGPT(K),MTAGPT(K),
CCCC 1 XLAPSE(K),QUALST(K),K=1,NBASTA)
CCCC 431 FORMAT(' AT 431(K,CCALL(K),XDATA(K),LTAG(K),LTAGPT(K),MTAGPT(K),',
CCCC 1 'XLAPSE(K),QUALST(K),K=1,NBASTA)',
CCCC 2 I6,1X,A8,F8.2,3I5,F8.4,F7.1)
C ONLY NON-BOGUSG STATIONS ARE PRINTED.
WRITE(KFILDO,435)(ID(J),J=1,4),PLAIN,
1 NOTOSS(1)-NOTSAV(1),NOTOSS(2)-NOTSAV(2),
2 NOTOSS(1),NOTOSS(2)
435 FORMAT(/,' DATA VALUES TOSSED ON THE LAST PASS ON THIS ANALYSIS',
1 ' OF ',3I10.9,I10.3,3X,A32/
2 ' THIS ANALYSIS TOTAL =',I5,' BASE =',I5,
3 ' (BASE STATIONS ARE THOSE NOT BOGUS OR AUGMENTED.)'/
4 ' RUNNING TOTAL =',I5,' BASE =',I5/)
C
CCCC CALL PRNTXX(KFILDO,CCALL,XDATA,ELEV,NSTA,P,TELEV,NX,NY)
C
CALL TIMPR(KFILDO,KFILDO,'END BCD5 ')
RETURN
END