SUBROUTINE U155(KFILDI,KFILDO,ICALL,CCALL,ELEV,IWBAN,WDIR,WSPD, 1 STALAT,STALON,XPL,YPL,XP,YP,XYP,XPE,YPE, 2 ISDATA,SDATA,TOSS,QUEST,LTAG,NAME,IQUAL,LNDSEA, 3 NOPAR,LOCPAR,QUALST,XLAPSE,VRAD,ELEVHI,ELEVLO,ND1, 4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD8,FD9, 5 ND2,ND3,ND2X3, 6 ID,IDPARS,THRESH,JD,JP, 7 ANLTAB,INLTAB,KFILAN,ANLNAM, 8 ISCALD,IWRITS,IWRITA,SMULT,SADD,ORIGIN,CINT,UNITS, 9 PLAIN,IPLAIN,PLAINT,IPLANT,L3264B,L3264W,ND4, A IALOC,ADIST,AELEV,ND13, B IPACK,DATA,IWORK,ICALLD,CCALLD,ND5, C TELEV,SEALND,CPNDFD,ND12, E KFILIN,NAMIN,JFOPEN,MODNUM,LDATB,LDATE, E LKHERE,MSDATE,INDEXC,ND6, F IS0,IS1,IS2,IS4,ND7, G IDATE,NWORK,ND8, H LSTORE,MSTORE,INDEX,ND9, I CORE,ND10,NBLOCK, J DIR,NGRIDC,ND11) C C JUNE 2004 GLAHN TDL MOS-2000 C MODIFIED FROM U150 C AUGUST 2004 GLAHN ADDED IQUAL(ND1,2) TO DIMENSION C AND TO CALL AND TO CALL TO INT155 C SEPTEMBER 2004 GLAHN ADDED IWRITS TO CALL QUAL TO U405A C SEPTEMBER 2004 GLAHN ADDED IQUAL( , ) TO CALL TO U505A C OCTOBER 2004 GLAHN ADDED NELEV( ) TO CALL TO U405A C OCTOBER 2004 GLAHN ADDED NCYCLE TO CALL TO RDSTR1 AND 7 C OCTOBER 2004 GLAHN ADDED XPE( ), YPE( ) TO CALL AND C TO CALL TO U405A; CHANGED NELEV( ) C TO ELEV( ) NOW TREATED AS METERS C OCTOBER 2004 GLAHN MODIFIED FOR LAT/LON VICE POLE C OCTOBER 2004 GLAHN ADDED LNDSEA( ); SEALND( ) AND ND12 C OCTOBER 2004 GLAHN INSERTED LAMBERT AND MERCATOR C CAPABILITY C NOVEMBER 2004 GLAHN ELIMINATED MESHL IN CALLS TO GTHRES C NOVEMBER 2004 GLAHN ADDED KFILVO TO CALL TO U405A C DECEMBER 2004 GLAHN ADDED IDST( , , , ), IDPARST( , , , ), C TRSTL( , , ), TRSTU( , , ), XLAPSE( ), C AA( , , , ), IDIMTB ( , ) ND13, ND14, C ND15 C DECEMBER 2004 GLAHN ADDED IBASE( ) C DECEMBER 2004 GLAHN ADDED MESHL TO CALL TO GTHRES C DECEMBER 2004 GLAHN ADDED CHECK FOR ELEVATION = 9999. C AT 153 C DECEMBER 2004 GLAHN REMOVED ITIME IN CALL TO RDSTR1 C DECEMBER 2004 GLAHN REMOVED CHECK FOR ELEVATION = 9999 C DECEMBER 2004 GLAHN REMOVED WRITING A TRIALER RECORD TO C KFILIO AND KFIOOG; COMMENTS; MODIFIED C TO CALL XYCOM1 VICE XYCOMP C JANUARY 2005 GLAHN ELIMINATED REFERENCE TO IP(14) C JANUARY 2005 GLAHN ELIMINATED REFERENCE TO IP(8) C MAY 2005 GLAHN ELIMINATED STRATIFICATION FEATURE; C ADDED LAPSE CALCULATION ON THE FLY; C KFILLP ADDED TO CALL TO INT155 C MAY 2005 GLAHN CHANGED NOALOC( ) TO NOPAR( ), C KEY( ) TO LOCPAR( ); ADDED LOCSTA( ) C MAY 2005 GLAHN ADDED NAME( ) TO CALL TO U405A C MAY 2005 GLAHN REMOVED LOCSTA( ) C MAY 2005 GLAHN ADDED IP(14) FOR COMPUTED LAPSE RATES C AUGUST 2005 GLAHN INCREASED SIZE OF ANLTAB TO 14 C SEPTEMBER 2005 GLAHN ADDED INLTAB( ) TO CALL AND TO CALL TO C INT155 C OCTOBER 2005 GLAHN ADDED ISTA AND ISMPL; SAMPLING OF C FIRST GUESS FOR ANALYSIS POINTS C JANUARY 2006 GLAHN INSERTED CLFILM FOR KFILRA(J) AT 315 C JANUARY 2006 GLAHN ADDED IP24 FOR WRITING FIT TO STATIONS C OVER WHOLE AREA VICE IP14 C MARCH 2006 GLAHN REMOVED CALL TO SKIPWR, ADDED OUTVEC C AND OUTQCV TO CALL TO U405A C MARCH 2006 GLAHN INCREASED ISTOP(3) TO ISTOP(5) C MARCH 2006 GLAHN ADDED KFILSL TO CALLS TO INT155, U405A C APRIL 2006 GLAHN INCREASED XDATA(ND1) TO XDATA(ND1,6) C APRIL 2006 GLAHN INCREASED ANLTAB CHARACTER*14 TO *17 C MAY 2006 GLAHN REMOVED DUPLICATE COMMENTS; REINSERTED C WRITING HEADERS AND ADDED WRITING C TRAILERS TO KFILOV AND KFILQC; CHANGED C SUBROUTINE SKIPWR TO SKPWR1 C JUNE 2006 GLAHN ADDED CPNDFD( ) TO CALL AND READING C OF THE GRID; ADDED NCLIP C MAY 2007 GLAHN INCREASED IQUAL( ,2) TO IQUAL( ,5) C JUNE 2007 GLAHN REMOVED XDATA( , ) C JULY 2007 GLAHN ADDED NPRED TO CALL TO U405A C AUGUST 2007 GLAHN ADDED VRAD(ND1,6) C SEPTEMBER 2007 GLAHN REPLACED NEWXY WITH NEWXY1 C OCTOBER 2007 GLAHN ADDED ELEVHI( ), ELEVLO( ) C DECEMBER 2007 GLAHN ADDED IP(25) AND ISTOP(6) CAPABILITY C DECEMBER 2007 GLAHN ADDED READING OF KFILNI, ETC. C FEBRUARY 2008 GLAHN MODIFIED DO 200 LOOP IN SKIPPING U450A C FEBRUARY 2008 GLAHN REMOVED KFILSL FROM CALL TO INT155 C AND TO U405A C FEBRUARY 2008 GLAHN ADDED NAREA TO INT155 AND A405A C FEBRUARY 2008 GLAHN CHANGED USE OF KFILVO; ADDED IWRITA C MARCH 2008 RLC ADDED COMMAS TO FORMAT 380 FOR IBM C COMPILE C MRCH 2008 GLAHN ADDED KFILCP FROM INT155 AND TO U405A C APRIL 2008 GLAHN ADDED ICOMPT( ) C MAY 2008 GLAHN MODIFIED CALL TO INT155 C JUNE 2008 GLAHN PUT IN DIAGNOSTIC CHECK AT 102 C JUNE 2008 GLAHN ADDED NCEPNO TO CALL TO RDSTR1, RDSTR7 C SEPTEMBER 2008 GLAHN ADDED ID(3,N).EQ.ID(3,N-1) CHECK IN C DO 200 LOOP BEFORE CALL TO U405A C FEBRUARY 2009 WAGNER PASSED MODNUM AND ND6 TO U405A C JUNE 2009 GLAHN ADDED PLAINT,IPLANT TO CALL TO U405A C AUGUST 2009 GLAHN CHANGED ISTOP=ISTOP+1 TO C ISTOP(1)=ISTOP(1)+1 IN 3 PLACES C SEPTEMBER 2009 GAW MODIFIED DEVELOPMENTAL VERSION OF C U155. ADDED NCEP-LIKE DOC BLOCK. C PUT W3 TAGS AT BEGINNING AND AFTER C EVERY STOP. ADDED INLTAB TO CALL TO C U405A. C MARCH 2010 GLAHN ADDED XYP( , ) C APRIL 2010 GLAHN ADDED SKIPPING OF VARIABLES IN A C SEQUENCE TO MATCH U405A C JUNE 2010 GLAHN ADDED READING DISTANCE TO LAND GRID C AND STORING IN INTERNAL STORAGE, C ADDED LDDST( ) C JULY 2010 GLAHN ADDED NCEPNO TO CALL TO U405A C JULY 2010 GLAHN ADDED TEST FOR SEQUENCE OF DISCRETE C CATEGORIES FOR DETERMINING LEVELS C AND MODIFIED CODE C APRIL 2011 GLAHN 'ENCOUNTERED' INSERTED IN FORMATS C 3254 AND 3255 C JUNE 2011 GLAHN ADDED IWRITF( ) C AUGUST 2011 GLAHN DIMENSIONED NOTOSS( ) C JUNE 2013 IM CHANGED MINPK FROM 47 TO 21 TO BE C CONSISTENT WITH GMOS SETUP C SEPTEMBER 2013 GLAHN COMMENT ABOUT IP(18) C MAY 2014 GLAHN ADDED MTAGPT( ) AND IN CALL TO U405A C MAY 2014 GLAHN DIMENSIONED NCEPNO(3) C JUNE 2014 GLAHN INSERTED CALL TO W3TAGE BEFORE STOPS; C DEFINED JMERTL AND OUTPUT AT END C AUGUST 2014 GHIRARDELLI MADE COSMETIC MODIFICATIONS TO C LOOK MORE LIKE CURRENT OPERATIONAL C VERSION C AUGUST 2014 GLAHN ADDED ITYPE( ) TO CALL AND TO INT155 C AND TO U405A C APRIL 2014 GLAHN ADDED W3TAGE BEFORE STOPS TO THIS MELD C VERSION; DEFINED JMERTL AND OUTPUT AT C END C APRIL 2015 GLAHN MODIFIED CALL TO U405A TO ADD VOTNAM C AND OTHER MISC COSMETIC CHANGES C MAY 2015 GLAHN CHANGED DIMENSION OF ITYPE( ) FROM C ND4 TO ND1 C MAY 2015 GLAHN AUGMENTED PRINT AT 3259 C OCTOBER 2016 GLAHN ADDED IP8 AND ICALL TO CALL TO U405A C APRIL 2019 GLAHN PUT IN PATCH TO CORRECT SEALND( ) C NOT MATCHING TELEV( ). REMOVE WHEN C CORRECTED. LIMITED TO ALASKA AREA. C OCTOBER 2020 GHIRARDELLI INITIALIED THE TOSS, ISDATA, C SDATA, AND QUEST ARRAYS TO 9999 C C PURPOSE C PROGRAM U155 IS USED TO ANALYZE VARIOUS WEATHER VARIABLES. C THE DATA TO BE ANALYZED WILL BE VECTOR, BUT THE FIRST C GUESS, IF NOT GENERATED INTERNALLY, WILL BE GRIDPOINT. C INPUT CAN BE FROM A SEQUENTIAL FILE, AS IT WOULD BE C FOR MAKING ANALYSES FOR MULTIPLE DATE/TIMES. OR, INPUT C CAN BE FROM A RANDOM ACCESS FILE, AS IT MIGHT BE C FOR A SINGLE DATE/TIME, SUCH AS IN OPERATIONS. C OUTPUT WILL CONSIST OF A GRIDPOINT FIELD AND/OR THE C ANALYZED FIELD CONVERTED TO A "VECTOR" RECORD. THIS C CAN BE TO A SEQUENTIAL FILE OR A RANDOM ACCESS FILE. C FOR MULTIPLE DATE/TIMES, A SEQUENTIAL FILE WILL NEDED TO BE C WRITTEN; FOR A SINGLE DATE/TIME, THE GRIDPOINT ANALYSIS C CAN BE OUTPUT AS A RANDOM FILE IN "VECTOR" FORMAT. C THERE CAN ALSO BE VECTOR OUTPUT CONSISTING OF QUALITY C CONTROLLED OBSERVATIONS. IN ADDITION, THERE ARE C DIAGNOSTIC VECTOR AND/OR GRIDPOINT DATA WRITTEN. C ALL SUCH OUTPUT IS WRITTEN IN TDLPACK. C THIS PROGRAM SHOULD RUN ON EITHER THE HP UNIX PLATFORM C WHICH USES 32-BIT INTEGERS OR THE CRAY UNIX PLATFORM C WHICH USES 64-BIT INTEGERS. THE ONLY DIFFERENCE IS C THAT THE DRIVER IS COMPILED WITH THE PARAMETER STATEMENT: C PARAMETER (L3264B=32) FOR THE 32-BIT MACHINE AND C PARAMETER (L3264B=64) FOR THE 64-BIT MACHINE. C FOR CHECKOUT AND TESTING, IT WOULD BE MORE INFORMATIVE C TO STOP ON A FATAL ERROR THAN TO PROCEED, BUT FOR C OPERATIONS HAVING MULTIPLE STOPS REQUIRES MORE CHANGES. C C THERE ARE CERTAIN FATAL ERRORS WITH STOPS IN INT155, BUT C GENERALLY IT WILL RUN TO COMPLETION EVEN WITH ERRORS. C C DATA SET USE C KFILDI - UNIT NUMBER OF INPUT FILE 'U155.CN'. (INPUT) C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFILIN(J) - UNIT NUMBERS FOR INPUT DATA, ALL IN TDLPACK C FORMAT (J=1,NUMIN). INPUT CAN INCLUDE C GRIDPOINT DATA, VECTOR (OBSERVATIONS) DATA, C VARIOUS CONSTANTS, OR MOS FORECASTS. (INPUT) C KFILRA(J) - HOLDS THE UNIT NUMBERS FOR ACCESSING THE C MOS-2000 EXTERNAL RANDOM ACCESS FILES (J=1,6). C (INPUT) C KFILAN - UNIT NUMBER FOR READING THE INDIVIDUAL .CN C FILES. (INPUT) C KFILLP - UNIT NUMBER FOR READING STATION PAIRS. (INPUT) C KFILNI - UNIT NUMBER FOR READING NEIGHBORS LIST. (INPUT) C KFILCP - UNIT NUMBER FOR VARIABLE CONSTANT FILE. (INPUT) C C OUTPUT FILES: C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,25). C (SEE IP( ) UNDER "VARIABLES" BELOW.) (OUTPUT) C KFIL10 - UNIT NUMBER FOR INTERMEDIATE PREDICTOR STORAGE C IN INTERNAL MOS-2000 RANDOM ACCESS SYSTEM. C (INTERNAL) C KFILIO - UNIT NUMBER OF PRIMARY OUTPUT TDLPACK GRIDPOINT C FILE. (OUTPUT) C KFILVO - UNIT NUMBER OF VECTOR OUTPUT ASCII FILE. C ZERO MEANS OUTPUT WILL NOT BE WRITTEN. C (OUTPUT) C KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (OUTPUT) C KFILOV - UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C TOSSED OR QUESTIONABLE 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 KFILRA(J) - HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). (INPUT) C KFILAN - UNIT NUMBER FOR READING THE INDIVIDUAL .CN FILES. C (INPUT) C KFILLP - UNIT NUMBER FOR READING STATION PAIRS. (INPUT) C KFILNI - UNIT NUMBER FOR READING NEIGHBORS LIST. (INPUT) C KFILCP - UNIT NUMBER FOR VARIABLE CONSTANT FILE. C (INPUT) C C VARIABLES C KFILDI = UNIT NUMBER TO READ INPUT FILE 'U155.CN'. C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. INITIALLY, C THIS IS SET BY DATA STATEMENT. LATER, IN C IPOPEN, IF IP(1) NE 0, KFILDO IS SET = IP(1). C THIS ALLOWS CHANGING THE "DEFAULT" PRINT FILE ON C THE FLY. OTHERWISE, ON SOME SYSTEMS, THE OUTPUT C FILE MIGHT HAVE THE SAME NAME AND BE OVERWRITTEN. C WHEN THE OUTPUT FILE IS NOT THE ORIGINAL DEFAULT, C THE NAME IS GENERATED AND CAN BE DIFFERENT FOR C EACH RUN. C ICALL(L,K,J) = 8 STATION CALL LETTERS AS CHARACTERS IN AN C INTEGER VARIABLE (L=1,L3264W) (K=1,NSTA) C (J=1,6). NOTE THAT THIS REQUIRES TWO 32-BIT C WORDS TO HOLD THE DESCRIPTION BUT ONLY ONE C 64-BIT WORD. EQUIVALENCED TO CCALL( , ). C CCALL(K,J) = 8-CHARACTER STATION CALL LETTERS (OR GRIDPOINT C LOCATIONS FOR GRID DEVELOPMENT) TO PROVIDE C OUTPUT FOR (J=1) AND 5 POSSIBLE OTHER STATION C CALL LETTERS (J=2,6) THAT CAN BE USED INSTEAD C IF THE PRIMARY (J=1) STATION CANNOT BE FOUND C IN AN INPUT DIRECTORY (K=1,NSTA). ALL STATION C DATA ARE KEYED TO THIS LIST, EXCEPT POSSIBLY C CCALLD( ). EQUIVALENCED TO ICALL( , , ). C ELEV(K) = ELEVATIONS OF STATIONS IN METERS (K=1,NSTA). C THESE ARE READ FROM THE STATION DICTIONARY C BY RDSTQN OR RDSTQA IN FT, BUT ARE CONVERTED C TO METERS BY THOSE READERS. (OUTPUT) C IWBAN(K) = WBAN NUMBERS OF STATIONS (K=1,NSTA). IT IS C EQUIVALENCED IN DRU155 TO SDATA( ). C WDIR(K) = WIND DIRECTION (K=1,NSTA). C WSPD(K) = WIND SPEED IN KTS (K=1,NSTA). C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). C XP(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE ANALYSIS GRID AT THE CURRENT GRID MESH C LENGTH XMESH. C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE ANALYSIS GRID AT THE CURRENT GRID MESH C LENGTH XMESH. C XYP(K,J) = XYP(1,1) EQUIVALENCED TO XP( ) IN DRIVER. C XYP(1,2) EQUIVALENCED TO YP( ) IN DRIVER. C XPL(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE ANALYSIS GRID AT THE MESH LENGTH MESHB. C YPL(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE ANALYSIS GRID AT THE MESH LENGTH MESHB. C XPE(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE ELEVATION GRID AT THE GRID MESH LENGTH C MESHE. C YPE(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE ELEVATION GRID AT THE GRID MESH LENGTH C MESHE. C ITYPE(K) = TYPE OF STATION (K=1,ND1). C NXL = THE SIZE OF THE ANALYSIS GRID FOR THIS RUN C IN THE X DIRECTION IN MESHB UNITS. C NYL = THE SIZE OF THE ANALYSIS GRID FOR THIS RUN C IN THE Y DIRECTION IN MESHB UNITS. C MESHB = THE NOMINAL MESH LENGTH OF THE ANALYSIS GRID C SPECIFIED BY NXL, NYL AT LATITUDE XLAT. C FOR INSTANCE, NOMINAL 80 CORRESPONDS C TO 95.25 KM FOR POLAR STEREOGRAPHIC. FOR C ALL ROUTINES TO WORK, THIS VALUE MUST BE C 1, 3, 5, 10, 20, 40, 80, 160, OR 320. C THE LOWER NUMBERS ARE INTEGERS APPROXIMATING C EVEN FRACTIONS OF BEDIENTS. C BMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHB. C MESHL = NOMINAL MESH LENGTH OF QUALITY CONTROL C (SUBSETTED) GRID FOR CONTINUOUS VARIABLES. C XMESHL = ACTUAL MESH LENGTH CORRESPONDING TO MESHL. C MESHD = NOMINAL MESH LENGTH OF QUALITY CONTROL C (SUBSETTED) GRID FOR DISCONTINUOUS VARIABLES. C DMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHD. C TELEV(J) = THE TERRAIN ELEVATION FROM THE MOS-2000 EXTERNAL C RANDOM ACCESS FILE (J=1,NXE*NYE). C NXE = X-EXTENT OF TELEV( ),SEALND( ), AND CPNDFD( ) C AT MESH LENGTH MESHE. (INPUT) C NYE = Y-EXTENT OF TELEV( ),SEALND( ), AND CPNDFD( ) C AT MESH LENGTH MESHE. (INPUT) C SEALND(J) = THE LAND/SEA MASK (J=1,NXE*NYE) AT NOMINAL C MESHLENGTH MESHE. C 0 = OCEAN WATER GRIDPOINTS; C 3 = INLAND WATER GRIDPOINTS. C 9 = LAND GRIDPOINTS. C CPNDFD(J) = THE NDGD MASK FROM THE MOS-2000 EXTERNAL C RANDOM ACCESS FILE (J=1,NXE*NYE) AT NOMINAL C MESHLENGTH MESHE. C ND12 = MAXIMUM SIZE OF TELEV( ), SEALND( ), AND C CPNDFD( ). 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. C EMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHE. 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. 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. C ISDATA(K) = USED IN RDSTAD TO KEEP TRACK OF THE STATIONS C FOUND IN THE DIRECTORY (K=1,NSTA). C SDATA(K) = ARRAY USED FOR VECTOR VALUES (K=1,NSTA). C EQUIVALENCED TO IWBAN( ) IN DRU155. C TOSS(K) = WORK ARRAY (K=1,NSTA). C QUEST(K) = WORK ARRAY (K=1,NSTA). C LTAG(K) = DENOTES USE OF DATA IN DATA(K) FOR STATION K C (K=1,NSTA). C 0 = USE DATA. C 1 = STATION OUTSIDE RADIUS OF INFLUENCE FOR C AREA BEING ANALYZED OR MISSING DATUM. C 2 = STATION LOCATION UNKNOWN. C NAME(K) = NAMES OF STATIONS (K=1,NSTA) (CHARACTER*20) C IQUAL(K,I) = THE QUALITY VALUES FROM THE STATION DICTIONARY C FOR FIVE POSSIBLE DATA TYPES (K=1,ND1) (I=1,5). 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 NOPAR(K) = NUMBER OF PAIRS FOR STATION K (K=1,MSTA). C LOCPAR(K) = WHERE IN IALOC( ), ADIST( ), AND AELEV( ) THE C DATA FOR STATION CCALL(K) STARTS (K=1,LSTA). C QUALST(K) = THE QUALITY WEIGHTS TO APPLY FOR THIS VARIABLE C (K=1,KSTA). C XLAPSE(K) = CALCULATED LAPSE RATE IN UNITS OF THE VARIABLE C BEING ANALYZED PER M. (K=1,KSTA). 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 TOTAL RUN. C ELEVLO(K) = THE LOW ELEVATION ASSOCIATED WITH STATION C CCALL(K) (K=1,NSTA). C ELEVHI(K) = THE HIGH ELEVATION ASSOCIATED WITH STATION C CCALL(K) (K=1,NSTA). C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT C WITH. NOTE THAT THIS IS NOT NECESSARILY C THE NUMBER OF STATIONS IN A VECTOR DIRECTORY C UNLESS, OF COURSE, THE STATION DIRECTORY C IS TO BE USED AS THE STATION LIST. C SET BY PARAMETER IN DRU155. C FD1(J), FD2(J), ETC = WORK ARRAYS (J=1,ND2X3). THESE CAN BE USED IN C ROUTINES AS 2-DIMENSIONAL ARRAYS, THE ONLY SIZE C RESTRICTION BEING THE TOTAL, NOT THE INDIVIDUAL C GRID DIMENSIONS. THE DIMENSION IS THE PRODUCT C OF PARAMETERS ND2 AND ND3 JUST TO ALLOW THE USER C TO APPRECIATE THE SIZE OF THE GRIDS THAT CAN BE C ACCOMMODATED. THESE ARRAYS ARE USUALLY USED FOR C GRIDS, BUT NEED NOT BE. C ND2 = ND2*ND3 IS THE MAXIMUM SIZE OF THE GRID THAT CAN C BE DEALT WITH. ND2 AND ND3 ARE SET SEPARATELY C TO HIGHLIGHT THE POSSIBLE DIMENSIONS OF THE C GRID. HOWEVER, IN THE CALLED ROUTINES, THE SIZE C IS ONLY LIMITED BY THE PRODUCT, NOT EACH C DIMENSION INDIVIDUALLY. NOT ACTUALLY USED C EXCEPT IN DRU155. SET BY PARAMETER IN DRU155. C (NOT ACTUALLY USED.) C ND3 = ND2*ND3 IS THE MAXIMUM SIZE OF THE GRID THAT CAN C BE DEALT WITH. SEE ND2. SET BY PARAMETER IN C DRU155. (NOT ACTUALLY USED.) C ND2X3 = THE DIMENSION OF SEVERAL ARRAYS. SET BY C PARAMETER. C ID(J,N) = THE INTEGER PREDICTOR ID'S (J=1,4) (N=1,ND4). C IDPARS(J,N) = 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 THRESH(N) = THE BINARY THRESHOLD ASSOCIATED WITH C IDPARS( ,N), N=1,ND4). C JD(J,N) = THE BASIC INTEGER PREDICTOR ID'S (J=1,4) C (N=1,ND4). C THIS IS THE SAME AS ID(J,N), EXCEPT THAT THE C PORTIONS PERTAINING TO PROCESSING ARE OMITTED: C B = IDPARS(3, ), C T = IDPARS(8,), C I = IDPARS(13, ), C S = IDPARS(14, ), C G = IDPARS(15, ), AND C THRESH( ). C JD( , ) IS USED TO IDENTIFY THE BASIC MODEL C FIELDS AS READ FROM THE ARCHIVE. 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. C ANLTAB(N) = THE CONTROL FILE NAME FOR THE VARIABLE (N=1,NPRED). C (CHARACTER*17) C INLTAB(N) = UNIT NUMBER FOR CONTROL FILE ANLTAB( ) REQUIRED C BY THE IBM. C ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING C THE DATA (N=1,ND4). C IWRITS(N) = 1 WHEN ANALYSIS FOR VARIABLE N IS TO BE WRITTEN C TO INTERNAL STORAGE BEFORE POSTPROCESSING; C 0 OTHERWISE (N=1,ND4). (OUTPUT) C IWRITA(N) = 1 WHEN ASCII DATA FOR VARIABLE N IS TO BE WRITTEN C TO FILE UNIT NUMBER KFIOVO; 0 OTHERWISE (N=1,ND4). C ICOMPT(N) = SIGNALS WHETHER THE VARIABLE IS TO BE ANALYZED C OR COMPUTED (N=1,ND4). C 0 WHEN THE VARIABLE IS TO BE ANALYZED; THE USUAL C CASE. C 1 WHEN THE VARIABLE IS NOT TO BE ANALYZED BUT TO C BE COMPUTED FROM OTHER ALREADY ANALYZED C VARIABLES. C IWRITF(N) = 1 WHEN FINAL POSTPROCESSED ANALYSIS FOR VARIABLE N C IS TO BE WRITTEN TO INTERNAL STORAGE; 0 OTHERWISE C (N=1,ND4). THE POSTPROCESSED VARIABLE IS C DISTINGUISHED FROM THE NON-POSTPROCESSED C INTERNALLY WITH A "1" IN THE "G" LOCATION OF THE ID. C SMULT(N) = THE ADDITIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). C THIS PERTAINS TO THE FINAL OUTPUT AND MAY C NOT BE THE SAME AS FOR INDIVIDUAL PASSES C IN ANALYSES. (NOTE THAT SMULT( ), SADD( ), C ORIGIN( ), CINT( ), UNITS( ) ARE NOT PASSED C INTO U405A. RATHER, THOSE PARAMETERS ARE C GOTTEN FROM THE U405A.CN FILE.) C SADD(N) = THE ADDITIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). C THIS PERTAINS TO THE FINAL OUTPUT AND MAY C NOT BE THE SAME AS FOR INDIVIDUAL PASSES C IN ANALYSES. C ORIGIN(N) = THE CONTOUR ORIGIN, APPLIES TO THE UNITS IN C UNITS(N) (N=1,ND4). C THIS PERTAINS TO THE FINAL OUTPUT AND MAY C NOT BE THE SAME AS FOR INDIVIDUAL PASSES C IN ANALYSES. C CINT(N) = THE CONTOUR INTERVAL, APPLIES TO THE UNITS IN C UNITS(N) (N=1,ND4). C THIS PERTAINS TO THE FINAL OUTPUT AND MAY C NOT BE THE SAME AS FOR INDIVIDUAL PASSES C IN ANALYSES. C UNITS(N) = THE UNITS OF THE DATA THAT APPLY AFTER C MULTIPLYING BY SMULT(N) AND ADDING SADD(N) C (N=1,ND4). (CHARACTER*12) C ND4 = THE MAXIMUM NUMBER OF PREDICTORS FOR WHICH C INTERPOLATED VALUES CAN BE PROVIDED. SET BY C PARAMETER. C PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES C IN ID( ,N) (N=1,ND4). EQUIVALENCED TO C IPLAIN( , ,N) IN DRU155. (CHARACTER*32) C IPLAIN(L,J,N) = 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN C LANGUAGE DESCRIPTION OF VARIABLES (N=1,ND4). 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 DRU155. C PLAINT = THE PLAIN LANGUAGE DESCRIPTION TO FURNISH TO C GTHRES. THIS IS FOR TERRAIN OR SEA/LAND MASK. 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 L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). SET BY PARAMETER. C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C CALCULATED BY PARAMETER, BASED ON L3464B. C IALOC(J) = LOCATIONS IN CCALL( , ) OF THE PAIRED STATIONS C (J=1,ND13), NOPAR(K) VALUES FOR EACH STATION K C (K=1,LSTA). C ADIST(J) = DISTANCES OF BASE STATION OF THE PAIRED STATIONS C (J=1,ND13), NOPAR(K) VALUES FOR EACH STATION K. C AELEV(J) = ELEVATION DIFFERENCES OF BASE STATION OF THE C PAIRED STATIONS (J=1,ND13), NOPAR(K) VALUES C FOR EACH STATION K. C ND13 = MAXIMUM TOTAL PAIRS OF STATIONS. DIMENSION OF C IALOC( ), ADIST( ), AND AELEV( ). C IPACK(J) = WORK ARRAY (J=1,ND5). C DATA(J) = WORK ARRAY (J=1,ND5). C IWORK(J) = WORK ARRAY (J=1,ND5). C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN C INTEGER VARIABLE (L=1,L3264W) (K=1,NSTA). THIS C LIST IS USED IN RDSTAD AND RDSTAL. C EQUIVALENCED TO CCALLD( ) IN DRU155. C CCALLD(K) = 8 STATION CALL LETTERS (K=1,NSTA). THIS LIST IS C USED IN RDSTAD TO RETAIN THE ORIGINAL LIST IN C CCALL( ). EQUIVALENCED TO ICALLD( , ) IN DRU155. C (CHARACTER*8) C ND5 = DIMENSION OF IPACK( ), IWORK( ), DATA( ) AND C CCALLD( ); SECOND DIMENSION OF ICALLD( , ). C THESE ARE GENERAL PURPOSE ARRAYS, SOMETIMES USED C FOR GRIDS. TWO SIZES OF ARRAYS (ND5 AND ND2X3) C ARE USED IN CASE AN ARRAY NEEDS TO BE LARGER C THAN ND2X3. ND5 CAN BE INCREASED WITHOUT C INCREASING THE SIZE OF ALL ARRAYS. SHOULD BE GE C ND2X3. SET BY PARAMETER IN DRU155. C KFILIN(J) = UNIT NUMBERS FOR INPUT DATA, ALL IN TDLPACK C FORMAT. INPUT CAN INCLUDE GRIDPOINT (FILES) C DATA, VECTOR (OBSERVATIONS) DATA, VARIOUS C CONSTANTS, OR MOS FORECASTS. (J=1,NUMIN). C NAMIN(J) = HOLDS DATA SET NAMES FOR THE UNIT NUMBERS IN C KFILIN(J) (J=1,NUMIN). (CHARACTER*60) C JFOPEN(J) = FOR EACH FILE IN KFILIN(J), JFOPEN(J) IS 1 WHEN C THE FILE IS OPEN, IS 0 WHEN IT HAS ALREADY BEEN C USED AND IS 2 WHEN THE FILE HAS NOT BEEN OPENED C (J=1,NUMIN). C MODNUM(J) = THE "MODEL" NUMBER CORRESPONDING TO KFILIN(J), C AND NAMIN(J) (J=1,NUMIN). THIS MAY NOT HAVE C MEANING FOR SOME INPUTS, BUT IS NEEDED FOR THE C MODEL DATA. C LDATB(J) = BEGINNING DATE NEEDED FOR THE MODEL C CORRESPONDING TO NAMIN(J), ETC. (J=1,NUMIN). C THIS IS NOT OVERALL, BUT IS VALID AT PARTICULAR C TIMES IN THE PROGRAM. C LDATE(J) = ENDING DATE NEEDED FOR THE MODEL CORRESPONDING C TO NAMIN(J), ETC. (J=1,NUMIN). THIS IS NOT C OVERALL, BUT IS VALID AT PARTICULAR TIMES IN THE C PROGRAM. LDATB( ) AND LDATE( ) ARE INITIALIZED C TO PLUS AND MINUS VALUES OUTSIDE THE RANGE OF C REASONABLE DATES. C LKHERE(J) = KEEPS TRACK OF WHICH FILES AN EOF HAS BEEN C REACHED (J=1,NUMIN). INITIALLY SET TO 1; SET C TO ZERO WHEN AN EOF HAS BEEN REACHED. C MSDATE(J) = KEEPS TRACK OF WHETHER ANY DATA ARE AVAILABLE C FOR A PARTICULAR DATE ON AN INPUT FILE C (J=1,NUMIN). USED FOR DIAGNOSTIC PRINT. C INDEXC(K,J) = LOCATIONS OF THE STATIONS CORRESPONDING TO C CCALL(K, ) (K=1,NSTA) FOR EACH MODEL J C (J=1,NUMIN). FOR GRIDPOINT DATA, INDEXC( , ) C WILL BE EMPTY FOR THAT MODEL J. IF A STATION C CANNOT BE FOUND IN THE DIRECTORY, INDEXC( , ) C IS SET TO 99999999. (OUTPUT) C ND6 = MAXIMUM NUMBER OF INPUT FILES THAT CAN C BE DEALT WITH IN ONE RUN. DIMENSION OF C KFILIN( ) AND NAMIN( ). SET BY PARAMETER C IN DRU155. C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C NOT ALL LOCATIONS ARE USED. MAXIMUM SIZE IS FOR C IS1( ) = 22 PLUS 32 CHARACTERS (ONE CHARACTER C PER WORD) OF PLAIN TEXT = 54. SET BY PARAMETER. C IDATE(J) = INITIAL DATE LIST (J=1,NDATES) WHICH MAY CONTAIN C NEGATIVE VALUES INDICATING A DATE SPAN. C THIS IS MODIFIED IN DATPRO TO CONTAIN THE C COMPLETE DATE LIST WITH THE DATES IN THE SPANS C FILLED IN (J=1,NDATES), WHERE NDATES HAS BEEN C INCREASED IF NECESSARY. DATES ARE INPUT AS C YYMMDDHH AND MODIFIED TO YYYYMMDDHH. ZEROS IN C THE INPUT ARE ELIMINATED. TERMINATOR IS C 99999999. MAXIMUM NUMBER OF DATES IS ND8. C NWORK(J) = A WORK ARRAY (J=1,ND8). C ND8 = DIMENSION OF IDATE( ) AND NWORK( ). SET BY C PARAMETER IN DRU155. C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). C L=1,4--THE 4 ID'S FOR THE DATA. C L=5 --LOCATION OF STORED DATA. WHEN IN CORE, C THIS IS THE LOCATION IN CORE( ) WHERE C THE DATA START. WHEN ON DISK, C THIS IS MINUS THE RECORD NUMBER WHERE C THE DATA START. C L=6 --THE NUMBER OF 4-BYTE WORDS STORED. C L=7 --2 FOR DATA PACKED IN TDLPACK, 1 FOR NOT. C L=8 --THE DATE/TIME OF THE DATA IN FORMAT C YYYYMMDDHH. C L=9 --NUMBER OF TIMES DATA HAVE BEEN RETRIEVED. C L=10 --FOR INCOMING GRIDS, THE NUMBER OF THE C SLAB IN DIR( , ,L) AND IN NGRIDC( ,L) C DEFINING THE CHARACTERISTICS OF THIS GRID. C FOR GRIDS STORED FOR ARCHIVAL, NSLAB IS C SET TO MESHB. FOR VECTOR DATA, NSLAB = 0. C L=11 --THE NUMBER OF THE FIRST PREDICTOR IN THE C SORTED LIST IN ID( ,N) (N=1,NPRED) FOR C WHICH THIS VARIABLE IS NEEDED, WHEN IT C DOES NOT NEED TO BE STORED AFTER DAY 1. C WHEN THE VARIABLE MUST BE STORED (TO BE C ACCESSED THROUGH OPTION) FOR ALL DAYS, C ID(11,N) IS 7777 + THE NUMBER OF THE C FIRST PREDICTOR IN THE SORTED LIST C FOR WHICH THIS VARIABLE IS NEEDED. C L=12 --USED INITIALLY IN ESTABLISHING C MSTORE( , ). LATER USED AS A WAY OF C DETERMINING WHETHER TO KEEP THIS C VARIABLE. C MSTORE(L,J) = THE ARRAY HOLDING THE VARIABLES NEEDED AS C INPUT, AFTER DAY 1, AND ASSOCIATED INFORMATION C (L=1,7) (J=1,MITEMS). C J=1,4 --THE 4 ID'S OF THE DATA. C J=5 --THE VALUE TAKEN FROM LSTORE(11, ) WHICH C INDICATES WHETHER OR NOT TO STORE THE C VARIABLE AND THE FIRST PREDICTOR TO USE C IT FOR. C J=6 --THE CYCLE TIME FOR WHICH THIS VARIABLE C IS NEEDED FOR THE DATE BEING PROCESSED. C A VARIABLE NEEDED FOR MORE THAN ONE C CYCLE TIME WILL HAVE ONE (AND ONLY ONE) C ENTRY FOR EACH CYCLE. C J=7 --THE MAXIMUM TIME OFFSET RR (SEE C IDPARS(9, ) CORRESPONDING TO MSTORE(6, ) C INDEX(J) = RDSTR1 KEEPS TRACK OF THE ELEMENTS IN MSTORE( , ) C FOUND ON THE INPUT(S). IF A VARIABLE IS FOUND C MORE THAN ONCE, A DIAGNOSTIC IS FURNISHED. C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ) C AND MSTORE( , ). SECOND DIMENSION OF C LSTORE( , ) AND MSTORE( , ). C CORE(J) = SPACE ALLOCATED FOR SAVING PACKED GRIDPOINT C FIELDS (J=1,ND10). WHEN THIS SPACE IS C EXHAUSTED, SCRATCH DISK WILL BE USED. THIS IS C THE SPACE USED FOR THE MOS-2000 INTERNAL RANDOM C ACCESS SYSTEM. C ND10 = THE MEMORY IN WORDS ALLOCATED TO THE SAVING OF C DATA CORE( ). WHEN THIS SPACE IS EXHAUSTED, C SCRATCH DISK WILL BE USED. C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK C STORAGE. SINCE MUCH, IF NOT ALL, INTERNAL C STORAGE WILL BE OF PACKED DATA, THE NUMBER OF C BYTES WILL BE THE SAME FOR EITHER A 32- OR C 64-BIT MACHINE. THEREFORE, THE BLOCK SIZE IS C SET BY PARAMETER TO VARY WITH L3264B. IN THE C PARAMETER STATEMENT, THE 6400 IS ARBITRARY, C AND CAN BE CHANGED. PERFORMANCE SHOULD NOT BE C HIGHLY DEPENDENT ON THIS. HOWEVER, IF TOO C LARGE, SPACE WILL BE WASTED, AND IF TOO SMALL C MANY RECORDS WILL BE NECESSARY TO HOLD EACH C RECORD. THE 6400 ACCOMMODATES 800 BYTES ON C EITHER A 32- OR 64-BIT MACHINE. SET BY C PARAMETER IN DRU155. C DIR(K,J,M) = THE IX (J=1) AND JY (J=2) POSITIONS ON THE GRID C FOR THE COMBINATION OF GRID CHARACTERISTICS M C (M=1,NGRID) AND STATION K (K=1,NSTA) IN C NGRIDC( M). ALL VECTOR DATA READ ARE KEYED C TO THE STATION LIST; DIR( , , ) IS USED ONLY C FOR GRIDDED DATA. INDEXC( , , ) IS NEEDED C ONLY IN RDSTR1 AND RDSTR7. C NGRIDC(L,M) = HOLDS THE GRID CHARACTERISTICS (L=1,6) FOR EACH C GRID COMBINATION (M=1,NGRID). C L=1--MAP PROJECTION NUMBER (3=LAMBERT, 5=POLAR C STEREOGRAPHIC). C L=2--GRID LENGTH IN METERS, C L=3--LATITUDE AT WHICH GRID LENGTH IS C CORRECT *1000, C L=4--GRID ORIENTATION IN DEGREES *1000, C L=5--LATITUDE OF LL CORNER IN DEGREES *1000, AND C L=6--LONGITUDE OF LL CORNER IN DEGREES *1000. C ND11 = MAXIMUM NUMBER OF GRID COMBINATIONS THAT CAN BE C DEALT WITH ON THIS RUN. LAST DIMENSION OF C NGRIDC( , ) AND DIR( , , ). C C INTERNAL VARIABLES C 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 NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT C WITH. C NPRED = THE NUMBER OF ENTRIES IN ID( ,J), ETC. C LITEMS = THE NUMBER OF ITEMS IN LSTORE( , ). C MITEMS = THE NUMBER OF ITEMS IN MSTORE( , ). C IP(J) = EACH VALUE (J=1,25) INDICATES WHETHER (>1) C OR NOT (=0) CERTAIN INFORMATION WILL BE WRITTEN. C WHEN IP( ) > 0, THE VALUE INDICATES THE UNIT C NUMBER FOR OUTPUT. THESE VALUES SHOULD NOT BE C THE SAME AS ANY KFILX VALUES EXCEPT POSSIBLY C KFILDO, WHICH IS THE DEFAULT OUTPUT FILE. THIS C IS ASCII OUTPUT, GENERALLY FOR DIAGNOSTIC C PURPOSES. THE FILE NAMES WILL BE 4 CHARACTERS C 'U155', THEN 4 CHARACTERS FROM IPINIT, THEN C 2 CHARACTERS FROM IP(J) (E.G., 'U155HRG130'). C THE ARRAY IS INITIALIZED TO ZERO IN CASE LESS C THAN THE EXPECTED NUMBER OF VALUES ARE READ IN. C EACH OUTPUT ASCII FILE WILL BE TIME STAMPED. C NOTE THAT THE TIME ON EACH FILE SHOULD BE VERY C NEARLY THE SAME, BUT COULD VARY BY A FRACTION C OF A SECOND. IT IS INTENDED THAT ALL ERRORS C BE INDICATED ON THE DEFAULT, SOMETIMES IN C ADDITION TO BEING INDICATED ON A FILE WITH A C SPECIFIC IP( ) NUMBER, SO THAT THE USER WILL C NOT MISS AN ERROR. NOTE THAT IN SUBROUTINE C INT155, SUBROUTINE IPRINT SETS IP(J) = 0 C WHEN IUSE(J) = 0. IF IP(J) WAS READ AS NON C ZERO, A FILE WITH UNIT NUMBER IP(J) WILL HAVE C BEEN OPENED, BUT WILL NOT BE TIME STAMPED. C (1) = ALL ERRORS AND OTHER INFORMATION NOT C SPECIFICALLY IDENTIFIED WITH OTHER IP( ) C NUMBERS. WHEN IP(1) IS READ AS NONZERO, C KFILDO, THE DEFAULT OUTPUT FILE UNIT NUMBER, C WILL BE SET TO IP(1). WHEN IP(1) IS READ C AS ZERO, KFILDO WILL BE USED UNCHANGED. C (2) = THE INPUT DATES IN IDATE( ). WHEN THERE C ARE ERRORS, PRINT WILL BE TO UNIT KFILDO AS C WELL AS TO UNIT IP(2). C (3) = THE OUTPUT DATES IN IDATE( ). WHEN THERE C ARE ERRORS, OUTPUT WILL BE TO UNIT KFILDO AS C WELL AS TO UNIT IP(3). C (4) = THE INPUT STATION LIST (CALL LETTERS C ONLY) WHEN THE STATION LIST IS NOT FROM C THE DIRECTORY (I.E., KFILD(1) NE KFILD(2) C IN INT155). HOWEVER, IF THERE ARE INPUT C ERRORS, THE STATION LIST WILL ALWAYS BE C WRITTEN TO THE DEFAULT OUTPUT FILE UNIT C KFILDO AS WELL AS TO UNIT IP(4). C (5) = THE STATIONS AND STATION DIRECTORY C INFORMATION IN THE ORDER TO BE DEALT WITH C IN U155. THE STATIONS WILL BE IN C ALPHABETICAL ORDER PROVIDED THE DIRECTORY IS. C IF THERE ARE INPUT ERRORS, THE STATION LIST C WILL BE WRITTEN TO THE DEFAULT OUTPUT FILE C UNIT KFILDO AS WELL AS TO UNIT IP(5). THIS C LISTING IS FROM RDSTAL OR RDSTAD. C (6) = THE VARIABLES AS THEY ARE BEING READ IN. C THIS IS GOOD FOR CHECKOUT; FOR ROUTINE C OPERATION, IP(7), AND/OR IP(9), C MAY BE BETTER. C (7) = THE VARIABLE LIST IN SUMMARY FORM. C IF THERE ARE ERRORS, THE VARIABLE LIST WILL C BE WRITTEN TO THE DEFAULT OUTPUT FILE C UNIT KFILDO AS WELL AS TO UNIT IP(7). C THIS LIST INCLUDES THE PARSED ID'S IN C IDPARS( , ). C (8) = INDICATES WHETHER (>1) OR NOT (=0) THE C STATIONS AND THEIR PAIRS AS READ ARE C WRITTEN TO IP8. C (9) = THE VARIABLE LIST IN SUMMARY FORM . THIS C DIFFERS FROM (8) IN THAT (9) DOES NOT C INCLUDE THE PARSED ID'S IN IDPARS( , ), C BUT RATHER INCLUDES THE INFORMATION TAKEN C FROM THE PREDICTOR CONSTANT FILE ON UNIT C KFILCP IN INT155. C (10) = INDICATES WHETHER (>1) OR NOT (=0) THE C LIST OF FIELDS READ FOR DAY 1 WILL BE C PRINTED TO THE FILE WHOSE UNIT NUMBER IS C IP(10). ALSO PROVIDES THE LIST OF DATES C NEEDED PER FILE FOR DAY 1 AND A FEW DAYS C AFTER THAT. C (11) = INDICATES WHETHER (>0) OR NOT (=0) C THE VARIABLE ID'S OF THE ARCHIVED FIELDS C ACTUALLY NEEDED, WILL BE PRINTED. THIS C IS THE CONTENTS OF MSTORE( , ). THIS C FILLING OF MSTORE( , ) AND PRINT DOES NOT C OCCUR IF THERE IS ONLY ONE DATE. C (12) = INDICATES WHETHER (>1) OR NOT (=0) THE C LIST OF STATIONS ON THE INPUT FILES WILL BE C PRINTED TO THE FILE WHOSE UNIT NUMBER IS C IP(12). SINCE HOURLY DATA WILL PROBABLY C BE READ AND THE STATION LIST CHANGES C HOURLY, THIS CAN BE VOLUMINOUS OUTPUT. C THE PRINT OCCURS IN SUBROUTINE FINDST. C FINDST ALSO PRINTS A LIST OF STATIONS C NOT FOUND ON THE INPUT FILE (EACH HOUR C READ) UNLESS COMPILED WITH /D OPTION. C (13) = INDICATES WHETHER (>0) OR NOT (=0) C THE CONTENTS OF LSTORE( , ) WILL BE C WRITTEN TO UNIT IP(13) AFTER COMPRESSION C AFTER EACH DAY NUMBER (CYCLE) LE LSTPRT, C WHICH IS SET IN DATA STATEMENT. C (14) = INDICATES WHETHER (>0) OR NOT (=0) C THE COMPUTED LAPSE RATES WILL BE PROVIDED C ON IP(14). C (15) = INDICATES WHETHER (>0) OR NOT (=0) A C LIST OF THE X AND Y POSITIONS OF THE STATIONS C FOR THE BASIC GRID WILL BE PROVIDED ON C IP(15). THIS IS PRINTED ONLY ONCE IN XYCOM1 C CALLED FROM U155. C (16) = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP(16) C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWOTG. C (17) = INDICATES WHETHER (>0) OR NOT (=0) A C LISTING OF STATIONS, THEIR X/Y POSITIONS, C THEIR DATA VALUES, AND LTAGS WILL BE WRITTEN C AT THE END OF SUBROUTINE ESP TO IP(17). C THIS PRODUCES A LISTING FOR EACH PASS C FOR EACH ANALYSIS BEING DONE (E.G., U405A, C U405B, ETC.). ONLY THE STATIONS WITH C NON MISSING DATA ARE LISTED. C (18) = INDICATES WHETHER (>0) OR NOT (=0) A C LISTING OF STATIONS, THEIR X/Y POSITIONS, C DATA VALUES, LTAGS, ANALYSIS (INTERPOLATED) C VALUES, AND DIFFERENCES BETWEEN THE DATA C AND THE ANALYSIS VALUES WILL BE WRITTEN C IN SUBROUTINE ESP TO IP(18). C THIS PRODUCES A LISTING FOR EACH PASS C FOR EACH ANALYSIS BEING DONE (E.G., U405A, C U405B, ETC.). ONLY THE STATIONS WITH C NON MISSING DATA ARE LISTED. C ALSO, WHEN NE 0, CAUSES LSTORE TO PRINT C TO KFILDO. C (19) = SAME AS (18) EXCEPT IT APPLIES TO THE C SMOOTHED ANALYSIS. IF THE ANALYSIS IS NOT C SMOOTHED, IP19 IS NOT WRITTEN TO. C THIS PRODUCES A LISTING FOR EACH PASS C FOR EACH ANALYSIS BEING DONE (E.G., U405A, C U405B, ETC.). ONLY THE STATIONS WITH C NON MISSING DATA ARE LISTED. C (20) = INDICATES WHETHER (>0) OR NOT (=0) A C LISTING OF STATIONS, THEIR X/Y POSITIONS, C DATA VALUES, LTAGS, ANALYSIS (INTERPOLATED) C VALUES, AND DIFFERENCES BETWEEN THE DATA C AND THE ANALYSIS VALUES WILL BE WRITTEN C IN SUBROUTINE BCD TO IP(20) FOR ONLY THE C SUBSETTED AREA FOR GRIDPRINTING. IF IOPT( ) C IS NOT USED, IP(20) IS NOT ACTIVATED. C THIS PRODUCES A LISTING FOR EACH PASS C FOR EACH ANALYSIS BEING DONE (E.G., U405A, C U405B, ETC.). ONLY THE STATIONS WITH C NON MISSING DATA ARE LISTED. C (21) = INDICATES WHETHER (>0) OR NOT (=0) THE C AVERAGE DEGREE OF FIT BETWEEN THE DATA AND C THE ANALYSIS WILL BE WRITTEN TO UNIT IP(21) C FOR THE UNSMOOTHED AND, IF SMOOTHED, THE C SMOOTHED ANALYSIS. THIS PRODUCES ONLY C ONE LINE PER PASS FOR EACH ANALYSIS BEING C DONE (E.G., U405A, U405B, ETC.) C (22) = UNIT NUMBER OF GRIDPRINTED MAPS, IF C OTHER THAN KFILDO. OPTIONAL PRINTING C IS INDICATED IN ROUTINES. C (23) = INDICATES WHETHER (>0) OR NOT (=0) C STATEMENTS ABOUT EOF AND FILE OPENINGS C AND CLOSINGS WILL BE OUTPUT FOR PRINTING C ON UNIT IP(23). C (24) = UNIT NUMBER FOR WRITING FIT TO WITHHELD C STATIONS, IF ANY, AND NON-WITHHELD STATIONS OVER C WHOLE ANALYSIS AREA WHEN NWITH NE 0. LIST OF C WITHHELD STATIONS IS ALSO PROVIDED. C (25) = UNIT NUMBER FOR WRITING PROBLEMS WITH C BOGUS STATIONS. C IPINIT = 4 CHARACTERS, USUALLY A USER'S INITIALS PLUS C A RUN NUMBER, TO APPEND TO 'U155' TO IDENTIFY C A PARTICULAR SEGMENT OF OUTPUT INDICATED BY A C SUFFIX IP(J). THE RUN NUMBER ALLOWS MULTIPLE C RUNS OF U155 AND WRITING OF UNIQUELY NAMED C FILES, PROVIDED THE USER USES A DIFFERENT RUN C NUMBER FOR EACH RUN. (CHARACTER*4) C KFIL10 = UNIT NUMBER FOR INTERMEDIATE PREDICTOR STORAGE C IN THE MOS-2000 RANDOM ACCESS SYSTEM. C KFILIO = UNIT NUMBER OF PRIMARY OUTPUT TDLPACK FILE. C ZERO MEANS OUTPUT WILL NOT BE WRITTEN. C KFILVO = UNIT NUMBER OF VECTOR OUTPUT ASCII FILE. C ZERO MEANS OUTPUT WILL NOT BE WRITTEN. C KSKIP = WHEN NONZERO, INDICATES THAT THE OUTPUT C GRIDPOINT ON UNIT NO. KFILIO AND QUALITY C CONTROLLED OBS VECTOR FILES ON UNIT NO. KFILQC C ARE TO BE MOVED FORWARD UNTIL ALL DATA FOR C DATE KSKIP HAVE BEEN SKIPPED. KSKIP IS INPUT C AS YYMMDDHH OR YYYYMMDDHH AND THEN USED AS C YYYYMMDDHH. C KFILAN = UNIT NUMBER FOR READING THE INDIVIDUAL C .CN FILES. C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. THIS IS FOR DIFFERENT PASSES OF THE C ANALYSES AND THEIR SMOOTHINGS. C KFILOV = UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C TOSSED OR QUESTIONABLE OBS AS MISSING. C KFILQC = UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C QUALITY CONTROLLED OBS AFTER THE FINAL ANALYSIS C PASS. C KFILCP = UNIT NUMBER FOR VARIABLE CONSTANT FILE. THIS C CONTAINS DEFAULT VALUES FOR CERTAIN CONSTANTS C FOR BASIC NMC VARIABLES AND OTHER VARIABLES C SANS THRESHOLDS, ETC. THESE INCLUDE PACKING C CONSTANTS, GRIDPOINT CONSTANTS, AND NAMES. C KFILLP = UNIT NUMBER FOR READING STATION PAIRS. C WHEN = 0, THERE IS NO PAIRS LIST. C KFILNI = UNIT NUMBER FOR READING STATION NEIGHBORS. C WHEN = 0, THERE IS NO NEIGHBORS LIST. C KWRITE = 0 IF CALL LETTERS RECORD IS NOT TO BE WRITTEN. C NE 0 OTHERWISE. THIS HAS NO EFFECT UNLESS KSKIP C NE 0. IF DATA ARE SKIPPED, THE EXISTING C CALL LETTERS RECORD IS CHECKED WITH THE ONE C AVAILABLE FOR WRITING. IF THEY MATCH C THE NEW ONE IS NOT WRITTEN; HOWEVER, IF THEY C DON'T MATCH, THE NEW ONE IS WRITTEN WHEN C KWRITE = 1, BUT THE PROGRAM HALTS WITH A C DIAGNOSTIC WHEN KWRITE = 0. C NSKIP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON C DAY 1 WITHOUT THE PROGRAM HALTING. IF THIS C NUMBER IS EXCEEDED, STOP WILL BE AFTER DAY 3. C JSTOP = THE NUMBER OF ERRORS THAT WILL BE TOLERATED ON C THE TOTAL RUN BEFORE PROGRAM STOPS. C INCCYL = INCREMENT IN HOURS BETWEEN DATE/TIMES THAT C ARE PUT INTO IDATE( ) BY SUBROUTINE DATPRO. C NEW = 1 WHEN NEW 8-LETTER CALL LETTERS ARE TO BE USED; C 0 WHEN OLD 3-LETTER CALL LETTERS ARE TO BE USED. C NALPH = 1 WHEN THE CALL LETTERS USED ARE TO BE C ALPHABETIZED (MORE EXACTLY, PUT IN THE ORDER C THEY EXIST IN THE STATION DIRECTORY. C 0 WHEN THE ORDER READ IN IS TO BE PRESERVED. C NTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILIO (THE OUTPUT GRIDPOINT FILE). C IT IS INITIALIZED IN SKIPR AND IS UPDATED WHEN C THE DATA IN IPACK( ) ARE WRITTEN. THIS DOES NOT C INCLUDE THE 8 BYTES PER RECORD FORTRAN USES. C NTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE WITH UNIT C NUMBER KFILIO. IT IS INITIALIZED IN SKIPR AND C IS UPDATED AS NEEDED IN WRITEP. C JTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOG. C JTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOG. C MTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOV. C MTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOV. 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 NDATES = NUMBER OF VALUES IN IDATE( ). MODIFIED AS C NECESSARY IN DATPRO. C GOTNAM = NAME OF DATA SET FOR OUTPUT GRIDS. C (CHARACTER*60) C OUTDIS = NAME OF DATA SET FOR DISPOSABLE GRIDS IN TDLPACK C FORMAT. THIS IS FOR INTERMEDIATE RESULTS, SUCH C AS THE RESULTS OF THE DIFFERENT PASSES OF C ANALYSES. (CHARACTER*60) C OUTVEC = NAME OF DATA SET FOR VECTOR DATA IN TDLPACK C FORMAT. (CHARACTER*60) C OUTQCV = NAME OF DATA SET FOR QUALITY CONTROLLED DATA C IN TDLPACK FORMAT. (CHARACTER*60) (OUTPUT) C ANLNAM = NAME OF DATA SET FOR READING THE INDIVIDUAL C ANALYSIS .CN FILES. NEEDED FOR IBM. C (CHARACTER*60) C VOTNAM = NAME OF DATA SET FOR OUTPUT ASCII DATA IN FORMAT C CORRESPONDING TO UNIT NO. KFILVO. C (CHARACTER*60) (OUTPUT) C NGRID = THE NUMBER OF GRID COMBINATIONS IN NGRIDC( , ), C MAXIMUM OF ND11. C IER = STATUS RETURN. C 0 = GOOD RETURN. SEE CALLED ROUTINES FOR OTHER C VALUES. C OTHER VALUES RETURNED FROM SUBROUTINES. C NUMIN = THE NUMBER OF VALUES IN KFILIN( ), NAMES IN C NAMIN( ), ETC. MAXIMUM OF ND6. THIS IS C REDUCED IF THERE IS NO VARIABLE WITH A C PARTICULAR MODEL NUMBER. C BLANK = 8 BLANKS. (CHARACTER*8) (INTERNAL) C LASTL = THE LAST LOCATION IN CORE( ) USED FOR MOS-2000 C INTERNAL STORAGE. INITIALIZED TO 0 ON FIRST C ENTRY TO GSTORE. ALSO INITIALIZED IN U155 IN C CASE GSTORE IS NOT ENTERED. C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK FOR C MOS-2000 INTERNAL STORAGE. C NSTORE = THE NUMBER OF TIMES GSTORE HAS BEEN ENTERED. C GSTORE KEEPS TRACK OF THIS AND RETURNS THE C VALUE. C NFETCH = THE NUMBER OF TIMES GFETCH AND GFETCH3 HAVE C BEEN ENTERED. GFETCH AND GFETCH3 KEEP TRACK C OF THIS AND RETURNS THE VALUE. C MINPK = MINIMUM GROUP SIZE WHEN PACKING THE INTERPOLATED C VALUES. SET IN DATA STATEMENT. C PXMISS = THE VALUE OF A SECONDARY MISSING VALUE TO INSERT C WHEN THE SECONDARY MISSING VALUE IS 9997. C THIS ALLOWS MAINTAINING A 9997, TREATING IT AS C ZERO, AS 9999, OR AS SOME OTHER VALUE. (INPUT) C MISTOT = TOTAL NUMBER OF TIMES A MISSING INDICATOR C HAS BEEN ENCOUNTERED IN UNPACKING GRIDS WHEN C COMPUTING VARIABLES. 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 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. THE COUNT IS MADE C EVERY TIME THIS OCCURS, SO ONE STATION C WILL LIKELY BE COUNTED MULTIPLE TIMES. C ISTOP(6)--IS INCREMENTED WHEN THERE IS A PROBLEM C WITH MAKING BOGUS STATIONS. C NAREA = THE AREA OVER WHICH THE ANALYSIS IS MADE: C 1 = CONUS, C 2 = ALASKA, C 3 = HAWAII, C NPROJ = MAP PROJECTION. C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED. C IOPTB(J) = SUBSETTING VALUES USED IN GRIDPRINTING (J=1,8) C IN RELATION TO MESHB. C DEFAULT VALUES OF 0 SET IN DATA STATEMENT MAY C BE OVERWRITTEN IN INT155. IN U155, THESE VALUES C ARE IN RELATION TO MESHB; IN U405A AND U405B, C THE VALUES ARE MADE RELEVANT TO MESHL AND ARE C NAMED IOPT( ); IN U405D, THE VALUES ARE MADE C RELEVANT TO MESHD AND ARE NAMED IOPT( ). C XMISSP = THE PRIMARY MISSING DATUM INDICATOR. THESE C GRIDS MAY HAVE MISSING VALUES (E.G., C DISCONTINUOUS VARIABLES). XMISSP IS SET IN C DATA STATEMENT TO 0 FOR SAFETY, BUT IS C CHANGED LATER. C XMISSS = THE SECONDARY MISSING DATUM INDICATOR. SOME C GRIDS MAY HAVE A SECONDARY MISSING VALUE C (E.G., 8888 FOR HGT AND AMT OF CLOUD ABOVE C THE LOWEST LAYER). XMISSS IS SET IN DATA C STATEMENT TO 0 FOR SAFETY, BUT IS CHANGED C LATER. C MISSP = INTEGER REPRESENTATION OF XMISSP. C MISSS = INTEGER REPRESENTATION OF XMISSS. C LSTPRT = INDICATES HOW MANY DAYS (CYCLES) OF THE CONTENTS C OF LSTORE( , ) TO PRINT AFTER COMPRESSION C WHEN IP(13) NE 0. CURRENTLY SET IN DATA C STATEMENT TO 3. 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 NCEPNO(J) = ORIGINALLY DESIGNED A SINGLE NCEP MODEL NUMBER C FOR THE RUN WHEN ONLY ONE GRIDDED DD WAS C EXPECTED. TO PROVIDE FOR UP TO 3 GRIDS THAT C MIGHT BE NEEDED IN MERGING LAMP AND HRRR OR RAP, C IT HAS BEEN DIMENSIONED NCEPNO(J) (J=1,3). C ONE VALUE IS READ IN, AND PARSED INTO THREE C VARIABLES IN INT155. VARIABLE READ AS XXYYZZ C AND PARSED INTO NCEPNO(1)=XX, NCEPNO(2)=YY, C AND NCEPNO(3)=ZZ. (OUTPUT) C MODNO = DD FOR WRITING GRIDS. IT IS ALSO THE EXPECTED C DD OF THE DATA TO ANALYZE (00 FOR OBS, 08 C OR ANOTHER NCEP MODEL FOR MOS FORECASTS, C 05 FOR LAMP FORECASTS). C MINVEC = THE MINIMUM NUMBER OF HOURS OF DATA TO SAVE C FOR VECTOR DATA. C MINMOD = THE MINIMUM NUMBER OF HOURS OF DATA TO SAVE C FOR GRIDPOINT DATA. C IPRTEL = 1 TO GRIDPRINT OR WRITE TO FILE NO. KFILOG C THE TERRAIN FILED, LAND/SEA MASK, AND THE C NDGD CLIP MASK. C 0 OTHERWISE. C ISTA = 1 TO READ STATION DIRECTORY. 0 OTHERWISE. C THE POINTS TO ANALYZE CAN COME FROM THE C DIRECTORY (ISTA=1), FROM RANDOMLY SAMPLED C POINTS (ISTA=0), OR BOTH (ISTA=1). C ISMPL = MAXIMUM NUMBER OF POINTS TO SAMPLE FROM THE C FIRST GUESS FIELD. 0 OTHERWISE. THE POINTS C TO ANALYZE CAN COME FROM THE DIRECTORY ONLY C (ISMPL=0), FROM SAMPLED POINTS (ISMPL GT 0), C OR BOTH (ISMPL GT 0). NSTA FROM THE DIRECTORY C + ISMPL MUST NOT EXCEED ND1 FOR ALL POINTS C TO BE USED. THE RANDOM POINTS ARE DETERMINED C IN U155 BY CALLING POINTS, BUT THE SAMPLING C IS DONE IN U405A. C LD(J) = THE 4-WORD FOR THE TERRAIN HEIGHT, WHERE C THE CCCFFF IN IS 409XY0, WHERE C X = REPRESENTS THE MAP PROJECTION C 3 = LAMBERT C 5 = POLAR STEREOGRAPHIC C 7 = MERCATOR C Y = REPRESENTS THE MESH LENGTH IN BEDIENTS C 0 = 1/4 BEDIENT (NOMINAL 80) C 1 = 1/8 " (NOMINAL 40) C 2 = 1/16 " (NOMINAL 20) C 3 = 1/32 " (NOMINAL 10) C 4 = 1/64 " (NOMINAL 5) C 5 = 1/128 " (NOMINAL 3) (2.5) C 6 = 1/256 " (NOMINAL 1) (1.25) C ITABLE(J,L) = CORRESPONDENCE BETWEEN NOMINAL MESH LENGTH C (L=1) AND VALUE FOR X IN 409CX0000 (L=2), C (J=1,7). C LDELE(4) = THE 4 IDS FOR ELEVATION. SET BY DATA STATEMENT. C LDLAT(4) = THE 4 IDS FOR LATITUDE. SET BY DATA STATEMENT. C LDLON(4) = THE 4 IDS FOR LONGITUDE. SET BY DATA STATEMENT. C NRRDAT = THE LAST DATE NEEDED TO STORE WITH CONSTANT C DATA. SET BY DATA STATEMENT. C LSDATE = THE DATE TO STORE WITH CONSTANT DATA. SET BY C DATA STATEMENT. C NOTOSS(J) = RUNNING OF COUNT OF TOTAL STATIONS TOSSED ON C LAST PASS (J=1) AND OF BASE STATIONS (J=2). C INITIALIZED BY DATA STATEMENT. C NTOTGR = THE TOTAL NUMBER OF EXTERNAL RANDOM ACCESS C RECORDS WRITTEN TO KFILRA = 42. SET BY DATA C STATEMENT. C NTOTVO = THE TOTAL NUMBER OF ASCII RECORDS FOR GIS C WRITTEN TO FILE KFILVO. SET BY DATA STATEMENT. C NCLIPY = 1 WHEN THE NDGD MASK GRID IS AVAILABLE AND C IN CPNDFD( ). C 0 OTHERWISE. C LSTA = NUMBER OF STATIONS FOR WHICH NEIGHBORS ARE C FURNISHED ON FILE UNIT NUMBER KFILNI. C MAXSTA = MAXIMUM NUMBER OF NEIGHBORS THAT WILL BE C FURNISHED PER STATION ON FILE UNIT NUMBER C KFILNI. C MTAGPT(K) = NEEDED TO TRANSMIT INFORMATION FROM LAMP WIND C SPEED ANALYSIS TO TOTAL WIND. A SAVE STATEMENT C CANNOT BE USED, BUT BECAUSE A U155 RUN NEVER C LEAVES U155, THE CONTENTS WILL BE SAVED. C (INTERNAL) (AUTOMATIC) C JMERTL = THE TOTAL OF THE VALUES RETURNED FROM U405A. C THIS IS THE TOTAL OF MAJOR AN MINOR ERRORS. C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C INT155, U405A, RDSTR1, RDSTR7, C LMSTR5, LMSTR2, SKIPR, GCPAC, TRAIL, UPDAT, C ACTUAL, XYCOM1, DATPRS, GFETCH, GSTORE, C WRITEP, TIMPR, SKPWR1, NEWXY1, W3TAGE C UNIQUE: - INT155, U405A C LIBRARY: C MOSLIB - RDSTR1, RDSTR7, LMSTR5, LMSTR2, SKIPR, C SKPWR1, GCPAC, TRAIL, UPDAT, ACTUAL, XYCOM1, DATPRS, C GFETCH, GSTORE, WRITEP, TIMPR C W3LIB - W3TAGB, W3TAGE C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C 140 - ERROR IN ROUTINE SKIPR C 143 - ERROR IN ROUTINE SKIPWR C 145 - ERROR IN ROUTINE SKIPWR C 152 - ERROR IN SUBROUTINE XYCOM1 C 160 - FATAL ERROR IN RDSTR1 C 170 - FATAL ERROR IN RDSTR7 C 238 - NUMBER OF ERRORS EXCEEDS JSTOP C 299 - NUMBER OF ERRORS EXCEEDS NSKIP C C REMARKS: NONE C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 (xlf90 compiler) C MACHINE: IBM SP C C$$$ C CHARACTER*8 CCALL(ND1,6),BLANK CHARACTER*8 CCALLD(ND5) CHARACTER*17 ANLTAB(ND4) CHARACTER*12 UNITS(ND4) CHARACTER*20 NAME(ND1) CHARACTER*32 PLAIN(ND4),PLAINT CHARACTER*60 ANLNAM(ND4) CHARACTER*60 NAMIN(ND6),RACESS(6),OUTDIS,OUTVEC,OUTQCV,GOTNAM, 1 VOTNAM C DIMENSION ICALL(L3264W,ND1,6),XYP(ND1,2), 1 ELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1), 2 XP(ND1),YP(ND1),XPL(ND1),YPL(ND1),XPE(ND1),YPE(ND1), 3 ISDATA(ND1),SDATA(ND1),LTAG(ND1), 4 WDIR(ND1),WSPD(ND1), 5 TOSS(ND1),QUEST(ND1), 6 IQUAL(ND1,5),LNDSEA(ND1), 7 NOPAR(ND1),LOCPAR(ND1),QUALST(ND1),XLAPSE(ND1), 8 VRAD(ND1,6), 9 ELEVHI(ND1),ELEVLO(ND1) DIMENSION MTAGPT(ND1),ITYPE(ND1) C MTAGPT( ) AND ITYPE( ) ARE AUTOMATIC VARIABLES SO THAT C DRU155 WOULDN'T HAVE TO BE CHANGED. DIMENSION FD1(ND2X3),FD2(ND2X3),FD3(ND2X3),FD4(ND2X3), 1 FD5(ND2X3),FD6(ND2X3),FD7(ND2X3),FD8(ND2X3), 2 FD9(ND2X3) DIMENSION ID(4,ND4),IDPARS(15,ND4),THRESH(ND4),JD(4,ND4), 1 JP(3,ND4),ISCALD(ND4),IWRITS(ND4),IWRITA(ND4), 2 IWRITF(ND4),INLTAB(ND4),KFILAN(ND4), 3 SMULT(ND4),SADD(ND4),ORIGIN(ND4),CINT(ND4) DIMENSION ICOMPT(ND4) C ICOMPT( ) IS AN AUTOMATIC VARIABLE SO THAT DRU155 WOULDN'T C HAVE TO BE CHANGED. DIMENSION IPLAIN(L3264W,4,ND4),IPLANT(L3264W,4) DIMENSION IPACK(ND5),DATA(ND5),IWORK(ND5),ICALLD(L3264W,ND5) DIMENSION KFILIN(ND6),MODNUM(ND6),LDATB(ND6),LDATE(ND6), 1 JFOPEN(ND6),LKHERE(ND6),MSDATE(ND6) DIMENSION INDEXC(ND1,ND6) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION IDATE(ND8),NWORK(ND8) DIMENSION LSTORE(12,ND9),MSTORE(7,ND9),INDEX(ND9) DIMENSION CORE(ND10) DIMENSION DIR(ND1,2,ND11),NGRIDC(6,ND11) DIMENSION TELEV(ND12),SEALND(ND12),CPNDFD(ND12) DIMENSION IALOC(ND13),ADIST(ND13),AELEV(ND13) DIMENSION KFILRA(6),IP(25),IOPTB(8),JDATE(4),ISTOP(6),LD(4), 1 ITABLE(7,2),LDELV(4),LDLAT(4),LDLON(4),LDDST(4), 2 NOTOSS(2),NCEPNO(3) DIMENSION LOCNEI(:,:),DSTNEI(:,:) C ALLOCATABLE LOCNEI,DSTNEI C SAVE LOCNEI,DSTNEI C THIS SAVE STATEMENT SHOULD NOT BE NECESSARY. C DATA KFIL10/99/ DATA ISTOP/6*0/ DATA MINPK/21/ CCC DATA MINPK/14/ C FOR 2.5 KM OVER CONUS, 14 GETS BUMPED UP WITH 45000 SETTING. DATA NGRID/0/ DATA BLANK/' '/ DATA LASTL/0/, 1 LASTD/0/ DATA IP/25*0/ DATA KSKIP,NSKIP,JSTOP,INCCYL/4*0/ DATA NSTORE/0/, 1 NFETCH/0/ DATA NTOTBY/0/, 1 NTOTRC/0/ DATA JTOTBY/0/, 1 JTOTRC/0/ DATA MTOTBY/0/, 1 MTOTRC/0/ DATA ITOTBY/0/, 1 ITOTRC/0/ DATA MISTOT/0/ DATA IOPTB/8*0/ DATA XMISSP/0./, 1 XMISSS/0./ DATA LSTPRT/3/ DATA MITEMS/0/ DATA LD/4*0/ DATA ITABLE/80, 40, 20, 10, 5, 3, 1, 1 0, 1, 2, 3, 4, 5, 6/ DATA LDELV/400005000,0,0,0/, 1 LDLAT/400006000,0,0,0/, 2 LDLON/400007000,0,0,0/, 3 LDDST/400000000,0,0,0/ DATA NRRDAT/2100010100/, 1 LSDATE/0/ DATA NOTOSS/0,0/ DATA NTOTGR/0/ DATA NTOTVO/0/ C DO 101 K=1,ND1 TOSS(K)=9999. ISDATA(K)=9999. SDATA(K)=9999. QUEST(K)=9999. 101 CONTINUE D CALL TIMPR(KFILDO,KFILDO,'STARTING U155 ') JMERTL=0 C CALL INT155(KFILDI,KFILDO,KFILIO,KFILVO,KFILOG,KFILCP, 1 KFILOV,KFILQC,KFILAN,KFIL10,KFILLP,KFILNI,IP, 2 CCALL,ELEV,IWBAN,STALAT,STALON,ISDATA,IPACK, 3 NAME,IQUAL,LNDSEA,ITYPE,NSTA,ND1, 4 CCALLD,ND5,NAREA, 5 ID,IDPARS,THRESH,JD,JP,NCEPNO,MODNO,NPRED, 6 ISCALD,IWRITS,IWRITA,ICOMPT,IWRITF,SMULT,SADD, 7 ORIGIN,CINT,ANLTAB,INLTAB,PLAIN,UNITS,ND4, 8 L3264B,KFILIN,MODNUM,NAMIN,JFOPEN,NUMIN,ND6, 9 KFILRA,RACESS,NUMRA,GOTNAM,OUTDIS, A OUTVEC,OUTQCV,ANLNAM,VOTNAM, B IDATE,NDATES,NWORK,ND8,INCCYL, C KSKIP,NSKIP,JSTOP,PXMISS,NPROJ,ORIENT,XLAT, D ALATL,ALONL,NXL,NYL, E MESHB,BMESH,MESHL,XMESHL,MESHD,DMESH, F MESHE,EMESH,IPRTEL,IOPTB,MINVEC,MINMOD, G ISTA,ISMPL,ISTOP,IER) IF(IER.EQ.777)GO TO 500 C IER = 777 IS FATAL ERROR. C C CHECK WHETHER ARRAYS ARE LARGE ENOUGH FOR THE DESIRED C GRID. C IF(ND2X3.LT.NXL*NYL)THEN WRITE(KFILDO,102)ND2X3,NXL*NYL 102 FORMAT(/,' ****ND2*ND3 =',I8, 1 ' TOO SMALL TO HOLD GRID NXL*NYL =',I8, 2 '. FATAL ERROR.') GO TO 500 ENDIF C C SET VALUES OF IPXX AND NDATE SO THAT VARIABLES IN CALL C AND SUBROUTINES ARE THE SAME. D CALL TIMPR(KFILDO,KFILDO,'OUT OF INT155 ') C IP8=IP(8) IP10=IP(10) IP11=IP(11) IP12=IP(12) IP13=IP(13) IP14=IP(14) IP16=IP(16) IP17=IP(17) IP18=IP(18) IP19=IP(19) IP20=IP(20) IP21=IP(21) IP22=IP(22) IP23=IP(23) IP24=IP(24) IP25=IP(25) NDATE=IDATE(1) C C CLOSE KFILDI, IT IS USED BY OTHER ROUTINES. C CLOSE(UNIT=KFILDI) C CALL RDPRS(KFILDO,KFILLP,IP8,ICALL,CCALL,NAME,NSTA, 1 NOPAR,LOCPAR,ND1, 2 IALOC,ADIST,AELEV,ND13,ICALLD,CCALLD,ND5,L3264W, 3 ISTOP,IER) C WHEN KFILLP = 0, RDPRS IS A DO NOTHING ROUTINE. C IF(IER.EQ.777)GO TO 500 C IER = 777 IS A FATAL ERROR IN RDPRS. C C READ THE NUMBER OF STATIONS FOR WHICH NEIGHBORS C WILL BE PROVIDED. IT IS DONE HERE SO THAT THE ARRAYS C CAN BE ALLOCATED TO THE EXACT SIZE NEEDED. D CALL TIMPR(KFILDO,KFILDO,'OUT OF RDPRS ') C IF(KFILNI.NE.0)THEN C********************************************* C IT APPEARS THIS ROUTINE AND FILE ARE NO LONGER NEEDED, C BUT ITS INTENDED FUNCTION IS TAKEN OVER IN U405A WITH C SUBROUTINE AUGMT1. THE SLOT IN THE U155.CN FILE IS STILL C THERE. C********************************************* C READ(KFILNI,IOSTAT=IOS,ERR=105,END=105)LSTA,MAXSTA C 105 IF(IOS.NE.0)THEN WRITE(KFILDO,106) 106 FORMAT(/,' ****PROBLEM READING NEIGHBORS LIST IN U155', 1 ' ON UNIT NO.',I5,'. FATAL ERROR.') GO TO 500 ENDIF C WRITE(KFILDO,108)LSTA,KFILNI 108 FORMAT(/,' ',I6,' STATIONS FOR WHICH NEIGHBORS ARE ON INPUT', 1 ' FILE UNIT NUMBER',I4) C C ALLOCATE THE LOCNEI( , ) AND DSTNEI( , ) ARRAYS. C ALLOCATE(LOCNEI(ND1,MAXSTA),DSTNEI(ND1,MAXSTA),STAT=IOS) C IF(IOS.NE.0)THEN IER=IOS WRITE(KFILDO,380)MAXSTA,IOS 380 FORMAT(/' ****UNABLE TO ALLOCATE LOCNEI( , ) AND', 1 ' DSTNEI( , ) IN RDNEI FOR MAXSTA =',I4, 2 ' STATIONS, IOS=',I4,'. FATAL ERROR.') GO TO 500 ENDIF C C READ THE NEIGHBORS OF STATIONS FOR USE IN COMPUTING C BOGUS VALUES FOR ANALYSIS. NORMALLY THIS IS FOR FILLING C IN TEMPERATURE, FOR INSTANCE, FOR THE LOCATIONS THAT C HAVE MAX/MIN TEMPERATURES SO THAT THE ANALYSES CAN BE C MORE CONSISTENT. C REWIND KFILNI C RDNEI REREADS THE FIRST RECORD. C CALL RDNEI(KFILDO,KFILNI,IP8,ICALL,CCALL,NAME,NSTA, 1 LOCNEI,DSTNEI,ND1,MAXSTA, 2 ICALLD,CCALLD,ND5,L3264W, 3 ISTOP,IER) C IF(IER.EQ.777)GO TO 500 C IER = 777 IS A FATAL ERROR IN RDPRS. ENDIF C C SKIP RECORDS ON THE GRIDPOINT OUTPUT FILE WHEN KSKIP NE 0. C WHEN KFILIO = 0, SKIPR DOES NOTHING. C CALL SKIPR(KFILDO,KFILIO,KSKIP,NTOTBY,NTOTRC,L3264B,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,140) 140 FORMAT(/' ****PROGRAM STOP AT 140 BECAUSE OF ERROR IN', 1 ' ROUTINE SKIPR. OTHERWISE, GOOD GRIDPOINT DATA', 2 ' MIGHT BE OVERWRITTEN.') CALL W3TAGE('U155') STOP 140 ENDIF C C STOP THE PROGRAM FOR SAFETY. OTHERWISE, GOOD GRIDPOINT C DATA MIGHT BE OVERWRITTEN. C C USE SKPWR1 TO SKIP RECORDS ON DISPOSABLE FILES WHEN KSKIP C NE 0. THE ONLY PURPOSE IS TO SKIP WHEN DESIRED, AND THIS C PROBABLY WOULD BE RARE. CALL LETTERS RECORDS, DATA, AND C TRAILERS ARE WRITTEN IN U405A C IF(KSKIP.NE.0)THEN KCHECK=0 KWRITE=1 C IF(KFILOV.NE.0)THEN WRITE(KFILDO,1425)OUTVEC 1425 FORMAT(/' INITIALIZE FILE ',A60) CALL SKPWR1(KFILDO,KFILOV,KSKIP,KWRITE,KCHECK, 1 CCALL,ND1,NSTA, 2 CCALLD,ND5,IPACK,ND5, 3 MTOTBY,MTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)THEN C WRITE(KFILDO,143)KFILOV 143 FORMAT(/' ****PROGRAM STOP AT 143 BECAUSE OF ERROR IN', 1 ' ROUTINE SKPWR1 ON UNIT NO.',I4,'.') CALL W3TAGE('U155') STOP 143 C STOP THE PROGRAM FOR SAFETY. ENDIF C ENDIF C KCHECK=0 KWRITE=1 C IF(KFILQC.NE.0)THEN WRITE(KFILDO,1445)OUTQCV 1445 FORMAT(/' INITIALIZE FILE ',A60) CALL SKPWR1(KFILDO,KFILQC,KSKIP,KWRITE,KCHECK, 1 CCALL,ND1,NSTA, 2 CCALLD,ND5,IPACK,ND5, 3 ITOTBY,ITOTRC,L3264B,L3264W,IER) IF(IER.NE.0)THEN C WRITE(KFILDO,145)KFILQC 145 FORMAT(/' ****PROGRAM STOP AT 145 BECAUSE OF ERROR IN', 1 ' ROUTINE SKPWR1 ON UNIT NO.',I4, 2 '. OTHERWISE, GOOD QUALITY', 3 ' CONTROLLED OBS DATA MIGHT BE OVERWRITTEN.') CALL W3TAGE('U155') STOP 145 C STOP THE PROGRAM FOR SAFETY. OTHERWISE, GOOD DATA C MIGHT BE OVERWRITTEN. ENDIF C ENDIF C ENDIF C D CALL TIMPR(KFILDO,KFILDO,'READY TO READ TERRAIN') C C DETERMINE THE POSITION J IN ITABLE( , ) FOR THE GRIDLENGTH C BEING USED. C DO 147 J=1,7 C IF(MESHE.EQ.ITABLE(J,1))THEN GO TO 1483 ENDIF C 147 CONTINUE C C FALL THROUGH HERE MEANS THE NOMINAL GRID LENGTH MESHE C IS NOT ONE OF THE VALUES HANDLED IN ITABLE( , ). C WRITE(KFILDO,148) 148 FORMAT(/' ****MESH LENGTH FOR CONSTANT GRID FROM GTHRES IS NOT', 1 ' HANDLED IN ITABLE( , ) AT 148. FATAL ERROR.') GO TO 500 C C READ THE GRID CONTAINING, OVER WATER, THE DISTANCES TO C THE CLOSEST LAND. IT IS STORED IN INTERNAL STORAGE. C TELEV( ) IS OF THE RIGHT SIZE AND IS USED TEMPORARILY. C 1483 LD(1)=409003000+NPROJ*100000+ITABLE(J,2)*10000 C NPROJ IS THE MAP PROJECTION C ITABLE(J,2) IS THE NOMINAL RESOLUTION LDDST(1)=LD(1) C ID(1) SAVED IN LDDST(1) FOR WRITING. LD(2)=0 LD(3)=0 LD(4)=0 C 32 CHARACTERS OF PLAIN LANGUAGE FOR PACKING. PLAINT='DISTANCE TO LAND FROM WATER PT. ' C CALL GTHRES(KFILDO,KFILOG,KFILRA,RACESS,NUMRA,IPRTEL,LD, 1 IP16,IP22, 2 FD1,ND2X3,IPACK,DATA,IWORK,ND5, 3 MODNO,NDATE, 4 ALATL,ALONL,NPROJ,ORIENT,XLAT, 5 NXL,NYL,MESHB,BMESH,IOPTB, 6 NXE,NYE,MESHE,EMESH,MESHL, 7 IS0,IS1,IS2,IS4,ND7, 8 JTOTBY,JTOTRC,PLAINT,IPLANT, 9 L3264B,L3264W,MINPK,ISTOP,IER) IERFD1=IER C FD1( , ) CANNOT BE STORED UNTIL AFTER RDSTR1. SAVE C IER FOR USE BEFORE ATTEMPTING TO STORE. IFD1SZ=IS2(3)*IS2(4) C SAVE SIZE OF FD1( ). C IF(IER.NE.0)THEN WRITE(KFILDO,1485) 1485 FORMAT(' THE DISTANCE TO LAND GRID WAS NOT FOUND.', 1 ' IT IS PROBABLY NOT NEEDED. PROCEEDING.') ISTOP(1)=ISTOP(1)+1 ENDIF C C READ THE TERRAIN ELEVATION GRID FROM RANDOM ACCESS FILE C ON UNIT NO. 43 OR 44. GTHRES EXCLUDES READING FROM UNIT C NO. 42, AS THAT IS USED FOR WRITING WHEN DESIRED. C ITABLE( ,1) IS USED TO MATCH THE AVAILABLE/DESIRED MESH C LENGTH TO CONSTRUCT THE ID IN LD( ). C LD(1)=409000000+NPROJ*100000+ITABLE(J,2)*10000 LD(2)=0 LD(3)=0 LD(4)=0 C 32 CHARACTERS OF PLAIN LANGUAGE FOR PACKING. PLAINT='UNSMOOTHED TERRAIN HEIGHT ' C 149 CALL GTHRES(KFILDO,KFILOG,KFILRA,RACESS,NUMRA,IPRTEL,LD, 1 IP16,IP22, 2 TELEV,ND12,IPACK,DATA,IWORK,ND5, 3 MODNO,NDATE, 4 ALATL,ALONL,NPROJ,ORIENT,XLAT, 5 NXL,NYL,MESHB,BMESH,IOPTB, 6 NXE,NYE,MESHE,EMESH,MESHL, 7 IS0,IS1,IS2,IS4,ND7, 8 JTOTBY,JTOTRC,PLAINT,IPLANT, 9 L3264B,L3264W,MINPK,ISTOP,IER) C IF(IER.EQ.777)THEN C IER = 777 IS FATAL ERROR. WRITE(KFILDO,150) 150 FORMAT(' FATAL ERROR IN GTHRES FROM U155.') GO TO 500 ENDIF C C READ THE SEA/LAND MASK GRID FROM RANDOM ACCESS FILE C ON UNIT NO. 43 OR 44. GTHRES EXCLUDES READING FROM UNIT C NO. 42, AS THAT IS USED FOR WRITING WHEN DESIRED. C ITABLE( ,1) IS USED TO MATCH THE AVAILABLE/DESIRED MESH C LENGTH TO CONSTRUCT THE ID IN LD( ). C LD(1)=400000000+NPROJ*100000+ITABLE(J,2)*10000 LD(2)=0 LD(3)=0 LD(4)=0 C 32 CHARACTERS OF PLAIN LANGUAGE FOR PACKING. PLAINT='LAND/SEA MASK ' C CALL GTHRES(KFILDO,KFILOG,KFILRA,RACESS,NUMRA,IPRTEL,LD, 1 IP16,IP22, 2 SEALND,ND12,IPACK,DATA,IWORK,ND5, 3 MODNO,NDATE, 4 ALATL,ALONL,NPROJ,ORIENT,XLAT, 5 NXL,NYL,MESHB,BMESH,IOPTB, 6 NXE,NYE,MESHE,EMESH,MESHL, 7 IS0,IS1,IS2,IS4,ND7, 8 JTOTBY,JTOTRC,PLAINT,IPLANT, 9 L3264B,L3264W,MINPK,ISTOP,IER) C IF(IER.EQ.777)THEN C IER = 777 IS FATAL ERROR. WRITE(KFILDO,150) GO TO 500 ENDIF C C*****************************************PATCH C TEST AND REPLACE WHEN SEALND( ) IS CORRECTED. C IF(NAREA.EQ.2)THEN C DO 1505 IXY=1,NXE*NYE C IF(TELEV(IXY).GT.0.)THEN !!REMOVE WHEN SEALND( ) REPACKED SEALND(IXY)=9. !!THIS CORRECTED PADU PROBLEM ENDIF C 1505 CONTINUE c ENDIF C C*****************************************PATCH C READ THE NDGD MASK GRID FROM RANDOM ACCESS FILE C ON UNIT NO. 43 OR 44. GTHRES EXCLUDES READING FROM UNIT C NO. 42, AS THAT IS USED FOR WRITING WHEN DESIRED. C ITABLE( ,1) IS USED TO MATCH THE AVAILABLE/DESIRED MESH C LENGTH TO CONSTRUCT THE ID IN LD( ). C LD(1)=400009000+NPROJ*100000+ITABLE(J,2)*10000 C NPROJ IS THE MAP PROJECTION C ITABLE(J,2) IS THE NOMINAL RESOLUTION C I DON'T KNOW WHAT THE 9 REPRESENTS. LD(2)=0 LD(3)=0 LD(4)=0 C 32 CHARACTERS OF PLAIN LANGUAGE FOR PACKING. PLAINT='NDGD MASK ' C CALL GTHRES(KFILDO,KFILOG,KFILRA,RACESS,NUMRA,IPRTEL,LD, 1 IP16,IP22, 2 CPNDFD,ND12,IPACK,DATA,IWORK,ND5, 3 MODNO,NDATE, 4 ALATL,ALONL,NPROJ,ORIENT,XLAT, 5 NXL,NYL,MESHB,BMESH,IOPTB, 6 NXE,NYE,MESHE,EMESH,MESHL, 7 IS0,IS1,IS2,IS4,ND7, 8 JTOTBY,JTOTRC,PLAINT,IPLANT, 9 L3264B,L3264W,MINPK,ISTOP,IER) C IF(IER.EQ.777)THEN C IER = 777 IS NOT FATAL. AN NDGD MASK MIGHT NOT BE C PROVIDED. WRITE(KFILDO,151) 151 FORMAT(/' ****THE NDGD MASK WAS NOT FOUND. THE FIRST GUESS', 1 ' CANNOT BE CUT. NOT FATAL, BUT COUNTED AS AN ERROR.', 2 ' PROCEEDING.') NCLIPY=0 C NCLIPY=0 MEANS THE NCLIP GRID CPNDFD WAS NOT FOUND. ISTOP(1)=ISTOP(1)+1 IER=0 ELSE NCLIPY=1 C NCLIPY=1 MEANS THE NCLIP GRID CPNDFD WAS FOUND. ENDIF C C DETERMINE THE POINTS TO SAMPLE FROM THE FIRST GUESS WHEN ISMPL C GT 0. NSTA HAS BEEN ALTERED TO NSTA + ISMPL, LIMITED BY ND1. C D CALL TIMPR(KFILDO,KFILDO,'GTHRES READING DONE ') IF(ISMPL.GT.0)THEN CALL POINTS(KFILDO,CCALL,NAME,ELEV,IWBAN,STALAT,STALON, 1 LNDSEA,IQUAL,NOPAR,ND1,NSTA,ISMPL, 2 TELEV,SEALND,NXE,NYE,BMESH,EMESH,NXL,NYL, 3 NPROJ,ORIENT,XLAT,ALATL,ALONL, 4 ISTOP,IER) IF(IER.NE.0)THEN WRITE(KFILDO,1515) 1515 FORMAT(' STOP IN U155 AT 1515') CALL W3TAGE('U155') STOP 151 ENDIF C ENDIF C CCCD WRITE(KFILDO,1512)(K,CCALL(K,1),NAME(K),ELEV(K), CCCD 1 STALAT(K),STALON(K),LNDSEA(K), CCCD 2 (IQUAL(K,J),J=1,5),K=1,NSTA) CCCD1512 FORMAT(' AT 1512 IN U155--(K,CCALL(K,1),NAME(K),ELEV(K),', CCCD 1 'STALAT(K),STALON(K),LNDSEA(K),(IQUAL(K,J),J=1,5),', CCCD 2 'K=1,NSTA)',/, CCCD 2 I6,2X,A8,2X,A20,3F10.2,6I4) C C COMPUTE XPL( ) AND YPL( ) POSITIONS OF THE NSTA STATIONS C WHOSE LATITUDES AND LONGITUDES ARE IN STALAT( ) C AND STALON( ). THIS IS IN RELATION TO THE C GRIDLENGTH BMESH AND LL CORNER ALATL AND ALONL. C THESE ARE PERMANENT, AND THE POSITIONS OF THE STATIONS C IN RELATION TO OTHER GRID LENGTHS ARE CALCULATED C LINEARLY AND CARRIED IN XP( ) AND YP( ). C CALL XYCOM1(KFILDO,IP(15),CCALL,NAME, 1 NPROJ,BMESH,XLAT,ORIENT,ALATL,ALONL, 2 STALAT,STALON,XPL,YPL,NSTA,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,152) 152 FORMAT(' STOP IN U155 AT 152') CALL W3TAGE('U155') STOP 152 ENDIF C C COMPUTE THE STATION POSITIONS WITH RESPECT TO THE C TERRAIN ELEVATION GRID. THE TWO GRIDS COVER THE SAME C AREA, SO THE (1,1) POINTS ARE THE SAME; ADJUST FOR DIFFERENCE C IN MESH LENGTHS. C CALL NEWXY1(KFILDO,MESHB,XPL,YPL,MESHE,XPE,YPE,NPROJ,NSTA) C C PROCESS ALL NDATES CYCLES. NOTE THAT, WHILE CYCLES OF A C MODEL ARE USUALLY DEALT WITH SEPARATELY, THE DATES C CONTAIN THE CYCLE (RUN) TIME, AND NDATES REFERS TO THE TOTAL C NUMBER OF CYCLES, NOT JUST DAYS. C DO 400 ND=1,NDATES NDATE=IDATE(ND) C C PARSE THE DATE INTO ITS FOUR COMPONENTS AND PRINT IT. C CALL DATPRS(KFILDO,NDATE,JDATE) WRITE(KFILDO,154)(JDATE(J),J=1,4) 154 FORMAT(/' STARTING DATE',I6,3I3.2,' #####################', 1 '###############################################') D CALL TIMPR(KFILDO,KFILDO,'READY FOR RDSTR1 ') IF(ND.EQ.1)THEN C C READ AND STORE ALL DATA FROM ALL MODELS THAT MAY BE NEEDED C FOR DAY 1. SINCE IT IS NOT KNOWN AT THIS POINT WHICH DATA C ARE NEEDED, ALL GRIDS ARE SAVED WITH THE IDENTIFYING C INFORMATION IN PACKED FORMAT, AND ALL VECTOR DATA ARE C UNPACKED, ASSOCIATED WITH THE STATION LIST, AND STORED C UNPACKED. ALSO, THE GRID LOCATIONS OF THE STATIONS ARE C COMPUTED IN DIR(K,J,M) (K=1,NSTA) (J=1,2) (M=1,NGRID) C FOR ALL COMBINATIONS OF GRIDS ENCOUNTERED. C CALL RDSTR1(KFILDO,KFIL10,KFILIN,MODNUM,NAMIN,JFOPEN, 1 LDATB,LDATE,LKHERE,ND6,NUMIN,IDATE(1), 2 ID,IDPARS,NPRED,ND4,NCEPNO, 3 IPACK,IWORK,DATA,CCALLD,ND5, 4 IS0,IS1,IS2,IS4,ND7, 5 LSTORE,LITEMS,ND9,NBLOCK,CORE,ND10, 6 LASTL,LASTD,NSTORE,NGRIDC,ND11,NGRID,IP10, 7 CCALL,NAME,STALAT,STALON,SDATA,DIR, 8 INDEXC,ND1,NSTA,MINVEC,MINMOD, 9 PXMISS,IP12,IP23,L3264B,L3264W,ISTOP(1),IER) C C IER = 56--MEANS THAT NO FIELDS WERE FOUND FOR DAY 1. C WHILE UNLIKELY, IT IS POSSIBLE THIS RUN DOES C NOT REQUIRE MODEL DATA, SO LET IT CONTINUE. C IT COULD REQUIRE ONLY RANDOM ACCESS DATA. C = 55--NO MODEL NUMBER EQUALS A DATASET MODEL C NUMBER. THIS IS NOT NECESSARILY FATAL. C IF(IER.EQ.51.OR.IER.EQ.60.OR.IER.EQ.50.OR.IER.EQ.38)THEN C IER = 50--NO SPACE IN LSTORE( , )--FROM GFETCH C = 51--ND11 ABOUT TO BE EXCEEDED--FROM GRCOMB C = 60--MAP PROJECTION NOT EXPECTED--FROM DIRCMP C = 38--ND5 NOT LARGE ENOUGH TO HOLD DATA--FROM UNPACK WRITE(KFILDO,160)IER 160 FORMAT(' ****FATAL ERROR =',I5,', STOP IN U155 AT 160') CALL W3TAGE('U155') STOP 160 ENDIF C IF(IERFD1.NE.777)THEN C C STORE GRID OF DISTANCES TO SHORE IN INTERNAL STORAGE. C NOTE THAT THIS HAS TO COME AFTER RDSTR1 BECAUSE OF C INITIALIZATION IN RDSTR1. C CALL GSTORE(KFILDO,KFIL10,LDDST,0,LSTORE,ND9,LITEMS, 1 FD1,IFD1SZ,1,NRRDAT,LSDATE, 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C IF(IER.NE.0)THEN C IER NE 0 IS TREATED AS A AN ERROR, BUT NOT FATAL. C A DIAGNOSTIC WILL HAVE BEEN WRITTEN IN GSTORE. ISTOP(1)=ISTOP(1)+1 ENDIF C ENDIF C C STORE STATION ELEVATIONS IN INTERNAL STORAGE. NOTE THAT C THIS HAS TO COME AFTER RDSTR1 BECAUSE OF INITIALIZATION C IN RDSTR1. C CALL GSTORE(KFILDO,KFIL10,LDELV,0,LSTORE,ND9,LITEMS, 1 ELEV,NSTA,1,NRRDAT,LSDATE, 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C IF(IER.NE.0)THEN C IER NE 0 IS TREATED AS A FATAL ERROR. A DIAGNOSTIC WILL C HAVE BEEN WRITTEN IN GSTORE. ISTOP(1)=ISTOP(1)+1 GO TO 500 ENDIF C C STORE STATION LATITUDES IN INTERNAL STORAGE. C CALL GSTORE(KFILDO,KFIL10,LDLAT,0,LSTORE,ND9,LITEMS, 1 STALAT,NSTA,1,NRRDAT,LSDATE, 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C IF(IER.NE.0)THEN C IER NE 0 IS TREATED AS A FATAL ERROR. A DIAGNOSTIC WILL C HAVE BEEN WRITTEN IN GSTORE. ISTOP(1)=ISTOP(1)+1 GO TO 500 ENDIF C C STORE STATION LONGITUDES IN INTERNAL STORAGE. C CALL GSTORE(KFILDO,KFIL10,LDLON,0,LSTORE,ND9,LITEMS, 1 STALON,NSTA,1,NRRDAT,LSDATE, 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C IF(IER.NE.0)THEN C IER NE 0 IS TREATED AS A FATAL ERROR. A DIAGNOSTIC WILL C HAVE BEEN WRITTEN IN GSTORE. ISTOP(1)=ISTOP(1)+1 GO TO 500 ENDIF C ELSE CALL RDSTR7(KFILDO,KFIL10,KFILIN,MODNUM,NAMIN,JFOPEN, 1 LDATB,LDATE,LKHERE,MSDATE,ND6,NUMIN,NDATE, 2 ID,IDPARS,NPRED,ND4,NCEPNO, 3 IPACK,IWORK,DATA,CCALLD,ND5, 4 IS0,IS1,IS2,IS4,ND7, 5 LSTORE,LITEMS,MSTORE,MITEMS,INDEX,ND9,CORE,ND10, 6 NBLOCK,LASTL,LASTD,NSTORE,NGRIDC,ND11,NGRID, 7 CCALL,NAME,STALAT,STALON,SDATA,DIR, 8 INDEXC,ND1,NSTA,MINVEC,MINMOD, 9 PXMISS,IP10,IP12,IP23,L3264B,L3264W,ISTOP,IER) C IF(IER.EQ.51.OR.IER.EQ.60.OR.IER.EQ.50.OR.IER.EQ.38)THEN C IER = 50--NO SPACE IN LSTORE( , )--FROM GFETCH C = 51--ND11 ABOUT TO BE EXCEEDED--FROM GRCOMB C = 60--MAP PROJECTION NOT EXPECTED--FROM DIRCMP C = 38--ND5 NOT LARGE ENOUGH TO HOLD DATA--FROM UNPACK WRITE(KFILDO,170)IER 170 FORMAT(' ****FATAL ERROR =',I5,', STOP IN U155 AT 170') CALL W3TAGE('U155') STOP 170 ENDIF C ENDIF c D CALL TIMPR(KFILDO,KFILDO,'OUT OF RDSTR7 ') C DO 200 N=1,NPRED C C DETERMINE WHETHER THIS IS A SEQUENCE ALREADY DEALT WITH C IN U405A. NOTE THAT N CANNOT BE CHANGED, SO SOME VARIABLES C MAY NEED TO BE SKIPPED. THE DEFINITIONS OF A SEQUENCE MUST C BE THE SAME HERE AS IN U405A. C IF(N.GT.1)THEN C WILL ALWAYS ENTER U405A FOR THE FIRST VARIABLE. C IF(ID(1,N).EQ.ID(1,N-1).AND.ID(3,N).EQ.ID(3,N-1))THEN C THE CCCFFFBDD AND TAU MUST MATCH FOR THIS TO BE A C SEQUENCE. C IF(IDPARS(6,N ).GT.0..AND.IDPARS(6,N ).LT.100..AND. 1 IDPARS(6,N-1).GT.0..AND.IDPARS(6,N-1).LT.100.)THEN C U405 HAS NOT REQUIRED THE PROBABILITIES TO BE C INCREASING OR DECREASING. THIS TEST IS FOR C LEVELS OF PROBABILITY OF A VARIABLE IN EKDMOS. GO TO 200 C THE LLLL OF BOTH VARIABLES ARE IN THE RANGE 0 TO 100, C SO THIS IS A SEQUENCE. ELSEIF((IDPARS(3,N).EQ.1.OR. 1 IDPARS(3,N).EQ.2.OR. 2 IDPARS(3,N).EQ.3).AND. 3 (THRESH(N).NE.THRESH(N-1)))THEN C C THE ABOVE INDICATES THIS IS A CUMULATIVE C PROBABILITY, EITHER FROM ABOVE OR FROM BELOW OR C A SERIES OF DISCRETE LEVELS. THIS TEST IS FOR C PROBABILITIES OF CATEGORIES AS IN LAMP CUMULATIVE C CEILING HEIGHT OR VISIBILITY, OR DISCRETE SKY AMOUNT. C NOTE THAT NO ORDER OF THRESHOLDS IS NECESSARY. GO TO 200 ENDIF C ENDIF C ENDIF C D CALL TIMPR(KFILDO,KFILDO,'CALLING U405A ') D WRITE(KFILDO,180)N,NPRED,(ID(J,N),J=1,4),(IDPARS(J,N),J=1,15) D180 FORMAT(/,' AT 180 IN U155--', D 1 'N,NPRED,ID(J,N),J=1,4)(IDPARS(J,N),J=1,15)',/,2I4,4I10,15I5) C IF(ANLTAB(N)(1:5).EQ.'U405A')THEN C C THIS VARIABLE IS TO BE ANALYZED WITH U405A. C CALL U405A(KFILDI,KFILDO,KFIL10,KFILOG,KFILOV,KFILQC,KFILIO, 1 KFILVO,KFILLP,KFILCP,KFILRA,RACESS,NUMRA,NCEPNO, 2 IP8,IP12,IP14,IP16,IP17,IP18,IP19,IP20,IP21,IP22, 3 IP24,IP25,OUTVEC,OUTQCV,VOTNAM, 4 IALOC,ADIST,AELEV,ND13,ELEVLO,ELEVHI, 5 ICALL,CCALL,NAME,XP,YP,XYP,XPL,YPL, 6 TOSS,QUEST,ISDATA,SDATA,MTAGPT, 7 WDIR,WSPD,LTAG,IQUAL,LNDSEA,ELEV,STALAT,STALON, 8 NOPAR,LOCPAR,QUALST,XLAPSE,VRAD,NSTA,ND1, 9 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD8,FD9,ND2X3, A ID,IDPARS,JD,JP,ICOMPT,ISCALD, B THRESH,ANLTAB,INLTAB,IWRITS,IWRITA,IWRITF,DIR, C NGRIDC,ND11,IPLAIN,PLAIN,ND4,PLAINT,IPLANT,NPRED, D N,ICALLD,CCALLD,IPACK,DATA,IWORK,ND5, E MODNO,NDATE,MODNUM,ND6, F NAREA,ALATL,ALONL,NPROJ,ORIENT,XLAT, G NXL,NYL,MESHB,BMESH,MESHL,IOPTB,NCLIPY, H TELEV,SEALND,CPNDFD,NXE,NYE,XPE,YPE,MESHE,EMESH, I IS0,IS1,IS2,IS4,ND7, J LSTORE,LITEMS,ND9, K CORE,ND10,NBLOCK,NSTORE,NFETCH, L JTOTBY,JTOTRC,MTOTBY,MTOTRC,ITOTBY,ITOTRC, M NTOTBY,NTOTRC,NOTOSS,NTOTGR,NTOTVO, N L3264B,L3264W,MISTOT,MINPK, O ISTA,ISMPL,ISTOP,IER) ENDIF C JMERTL=JMERTL+IER C AN ERROR IN U405 FOR AN ELEMENT WILL NOT STOP U155. THE C IER IS THE TOTAL OF MAJOR AND MINOR ERRORS IN U405A. C CCCC WRITE(KFILDO,199)IER,JMERTL CCCC 199 FORMAT(/' AT 199 IN U155--IER,JMERTL',2I4) C 200 CONTINUE C IF(IP13.NE.0)THEN WRITE(IP13,2001)NDATE,((LSTORE(L,M),L=1,12),M=1,LITEMS) 2001 FORMAT(/' LSTORE IN U155 AT 2001 AFTER U405 FOR DATE',I12/ 1 (' ',3I10,I11,2I8,I3,I12,2I3,I5,I12)) ENDIF C IF(ND.EQ.NDATES)GO TO 304 IF(ND.GT.1)GO TO 230 C C ELIMINATE THE ENTRIES IN LSTORE( , ) NOT NEEDED AND C INITIALIZES MSTORE( , ). DON'T NEED TO DO FOR LAST DATE. C CALL LMSTR4(KFILDO,NDATE,LSTORE,LITEMS, 1 MSTORE,MITEMS,ND9,INCCYL,NCEPNO,MINVEC,MINMOD, 2 IDATE,NDATES,ISTOP,IER) C CALL GCPAC(KFILDO,KFIL10,LSTORE,ND9,LITEMS,CORE,ND10, 1 LASTL,LASTD,IWORK,ND5,NBLOCK,IER) IF(IER.NE.0)ISTOP(1)=ISTOP(1)+1 C IF(IP18.NE.0)THEN C INTERESTING. PRINT TO KFILDO DEPENDS ON IP18! C IF(LITEMS.NE.0)THEN WRITE(KFILDO,2095)ND,((LSTORE(L,M),L=1,12),M=1,LITEMS) 2095 FORMAT(/' SAVED VARIABLES IN LSTORE AFTER DAY ',I3,// 1 (' ',3I10,I11,2I8,I3,I12,2I3,I5,I12)) ELSE WRITE(KFILDO,2096)ND 2096 FORMAT(/' NO VARIABLES SAVED IN LSTORE AFTER DAY ',I3) ENDIF C ENDIF C IF(MITEMS.EQ.0)THEN WRITE(KFILDO,2097) 2097 FORMAT(/' NO VARIABLES SAVED IN MSTORE. MUST BE AN ERROR.', 1 ' STOP IN U155 AT 2097.') C ELSEIF(IP(11).NE.0)THEN WRITE(IP(11),210)((MSTORE(L,K),L=1,7),K=1,MITEMS) 210 FORMAT(/' MSTORE( , ) AFTER DAY 1, VARIABLES NEEDED', 1 ' FROM INPUT',/ 2 45X,'USE/STORE CYCLE HRS TO KEEP',/ 3 (' ',3I10,I11,I10,I8,I10)) ENDIF C IF(ISTOP(1).NE.0)THEN WRITE(KFILDO,216)ISTOP(1) 216 FORMAT(/' AT LEAST ISTOP(1) =',I6,' ERRORS OCCURRED ON DAY 1.') ENDIF C IF(ISTOP(2).NE.0.AND.ISTOP(1).EQ.0)THEN WRITE(KFILDO,222)ISTOP(2) 222 FORMAT(/' AT LEAST ISTOP(2) =',I6,' ANALYSES HAD FEW DATA', 1 ' FOR DAY 1.') C ELSEIF(ISTOP(2).NE.0)THEN WRITE(KFILDO,223)ISTOP(2) 223 FORMAT(' AT LEAST ISTOP(2) =',I6,' ANALYSES HAD FEW DATA', 1 ' FOR DAY 1.') ENDIF C IF(ISTOP(3).NE.0.AND.(ISTOP(1).EQ.0.OR.ISTOP(2).EQ.0))THEN WRITE(KFILDO,224)ISTOP(3) 224 FORMAT(/' AT LEAST ISTOP(3) =',I6, 1 ' VARIABLES MISSING ON DAY 1.') C ELSEIF(ISTOP(3).NE.0)THEN WRITE(KFILDO,225)ISTOP(3) 225 FORMAT(' AT LEAST ISTOP(3) =',I6, 1 ' VARIABLES MISSING ON DAY 1.') ENDIF C IF(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0)WRITE(KFILDO,226) 226 FORMAT(/' NO ERRORS OCCURRED AND ALL NEEDED DATA WERE FOUND', 1 ' FOR DAY 1.') C WRITE(KFILDO,227)NSTORE 227 FORMAT(/' AT THE END OF DAY 1, THE MOS-2000 INTERNAL FILE', 1 ' HAS BEEN ACCESSED BY GSTORE',I11,' TIMES.') C WRITE(KFILDO,228)NFETCH 228 FORMAT(' AT THE END OF DAY 1, THE MOS-2000 INTERNAL FILE', 1 ' HAS BEEN ACCESSED BY GFETCH',I11,' TIMES.') C IF(ND.EQ.1)LSTOP=ISTOP(1) C THE NUMBER OF ERRORS, ISTOP(1), ON DAY 1 IS SAVED IN LSTOP. C AFTER DAY THREE, IF LSTOP IS GT NSKIP, U155 HALTS. GO TO 400 C C ELIMINATE THE ENTRIES IN LSTORE( , ) NOT NEEDED. C 230 CALL LMSTR2(KFILDO,IDATE(ND+1),LSTORE,LITEMS,ND9) CALL GCPAC(KFILDO,KFIL10,LSTORE,ND9,LITEMS,CORE,ND10, 1 LASTL,LASTD,IWORK,ND5,NBLOCK,IER) C IF(IER.EQ.0)GO TO 237 ISTOP(1)=ISTOP(1)+1 C AN ERROR IN GCPAC IS FATAL. WRITE(KFILDO,236)IDATE(ND) 236 FORMAT(/' ****FATAL ERROR IN GCPAC PROCESSING DATE',I11) GO TO 304 C 237 IF(ND.LE.6.AND.ND.LT.NDATES)THEN C IF(IP18.NE.0)THEN C INTERESTING. PRINT TO KFILDO DEPENDS ON IP18! C IF(LITEMS.NE.0)THEN WRITE(KFILDO,2095)ND,((LSTORE(L,M),L=1,12),M=1,LITEMS) ELSE WRITE(KFILDO,2096)ND ENDIF C ENDIF C ENDIF C IF(ND.LT.3.OR.ISTOP(1).LE.JSTOP)GO TO 240 C C TOTAL ERRORS ALLOWED HAVE BEEN EXCEEDED. PRINT AND STOP. C WRITE(KFILDO,238)ISTOP(1),IDATE(ND) 238 FORMAT(/' NUMBER OF ERRORS =',I6,' AFTER DATE',I11, 1 ' EXCEEDS JSTOP. STOP IN U155 AT 238.') WRITE(KFILDO,306)NSTORE WRITE(KFILDO,307)NFETCH CALL W3TAGE('U155') STOP 238 C 240 IF(ND.NE.3.OR.LSTOP.LE.NSKIP)GO TO 400 C WRITE(KFILDO,299)LSTOP,ISTOP(1) 299 FORMAT(/' NUMBER OF ERRORS ON DAY 1 =',I3,' EXCEEDS NSKIP.', 1 ' STOP AT END OF DAY 3, ISTOP(1) TOTAL ERRORS =',I3, 2 '. STOP IN U155 AT 299.') WRITE(KFILDO,306)NSTORE WRITE(KFILDO,307)NFETCH CALL W3TAGE('U155') STOP 299 C C WRITE EOF TO THIS VECTOR FILE UNLESS KFILOV = 0. C THE CALL TO TRAIL IS IN U405A. THIS MAY NOT REALLY C BE NECESSARY. C 304 IF(KFILOV.NE.0)THEN ENDFILE KFILOV ENDIF C C WRITE EOF TO THIS VECTOR FILE UNLESS KFILQC = 0. C THE CALL TO TRAIL IS IN U405A. THIS MAY NOT REALLY C BE NECESSARY. C IF(KFILQC.NE.0)THEN ENDFILE KFILQC ENDIF C WRITE(KFILDO,306)NSTORE 306 FORMAT(/' THE MOS-2000 INTERNAL FILE HAS BEEN ACCESSED BY', 1 ' GSTORE',I11,' TIMES.') WRITE(KFILDO,307)NFETCH 307 FORMAT(' THE MOS-2000 INTERNAL FILE HAS BEEN ACCESSED BY', 1 ' GFETCH',I11,' TIMES.') IF(MISTOT.NE.0)WRITE(KFILDO,308)MISTOT 308 FORMAT(/' A PRIMARY MISSING INDICATOR HAS BEEN FOUND',I7, 1 ' TIMES WHEN UNPACKING GRIDS.') C ICOUNT=0 C C THIS PRINT IF FOR THE ARCHIVE SEQUENTIAL ARCHIVE GRIDS. C IF(KFILIO.NE.0)THEN IF(ICOUNT.EQ.0)WRITE(KFILDO,309) 309 FORMAT(' ') ICOUNT=1 WRITE(KFILDO,310)NTOTBY,NTOTRC,GOTNAM 310 FORMAT(' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C C THIS PRINT IF FOR THE DISPOSABLE OUTPUT GRIDS. C IF(KFILOG.NE.0)THEN IF(ICOUNT.EQ.0)WRITE(KFILDO,309) ICOUNT=1 WRITE(KFILDO,311)JTOTBY,JTOTRC,OUTDIS 311 FORMAT(' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C C THIS PRINT IF FOR THE OUTPUT VECTOR DATA. C IF(KFILOV.NE.0)THEN IF(ICOUNT.EQ.0)WRITE(KFILDO,309) ICOUNT=1 WRITE(KFILDO,312)MTOTBY,MTOTRC,OUTVEC 312 FORMAT(' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C C THIS PRINT IS FOR THE OUTPUT QC'ED VECTOR DATA. C IF(KFILQC.NE.0)THEN IF(ICOUNT.EQ.0)WRITE(KFILDO,309) ICOUNT=1 WRITE(KFILDO,313)ITOTBY,ITOTRC,OUTQCV 313 FORMAT(' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C C THIS PRINT IS FOR THE ASCII OUTPUT FOR GIS. C IF(NTOTVO.NE.0)THEN IF(ICOUNT.EQ.0)WRITE(KFILDO,309) ICOUNT=1 WRITE(KFILDO,314)NTOTVO,VOTNAM 314 FORMAT(' A TOTAL OF ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C C THIS PRINT IS FOR THE EXTERNAL RA ARCHIVE GRIDS. C DO 316 J=1,6 C IF(KFILRA(J).EQ.42)THEN IF(ICOUNT.EQ.0)WRITE(KFILDO,309) ICOUNT=1 WRITE(KFILDO,315)NTOTGR,RACESS(J) 315 FORMAT(' A TOTAL OF ',I7,' RECORDS', 1 ' WRITTEN ON FILE ',A60) CALL CLFILM(KFILDO,KFILRA(J),IER) C THE FILE HAS LIKELY BEEN CLOSED IN U405A, BUT IF NOT C WILL BE CLOSED HERE. GO TO 320 ENDIF C 316 CONTINUE C 320 IF(ISTOP(1).NE.0)THEN WRITE(KFILDO,321)ISTOP(1) 321 FORMAT(/' AT LEAST ISTOP(1) =',I6, 1 ' ERRORS OCCURRED ON THIS RUN.') ENDIF C IF(ISTOP(2).NE.0.AND.ISTOP(1).EQ.0)THEN WRITE(KFILDO,322)ISTOP(2) 322 FORMAT(/' AT LEAST ISTOP(2) =',I6,' ANALYSES HAD FEW DATA', 1 ' ON THIS RUN.') C ELSEIF(ISTOP(2).NE.0)THEN WRITE(KFILDO,323)ISTOP(2) 323 FORMAT(' AT LEAST ISTOP(2) =',I6,' ANALYSES HAD FEW DATA', 1 ' ON THIS RUN.') ENDIF C IF(ISTOP(3).NE.0.AND.(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0))THEN WRITE(KFILDO,324)ISTOP(3) 324 FORMAT(/,' AT LEAST ISTOP(3) =',I6, 1 ' VARIABLES MISSING ON THIS RUN.') C ELSEIF(ISTOP(3).NE.0)THEN WRITE(KFILDO,325)ISTOP(3) 325 FORMAT(' AT LEAST ISTOP(3) =',I6, 1 ' VARIABLES MISSING ON THIS RUN.') ENDIF C IF(ISTOP(4).NE.0.AND.(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0. 1 AND.ISTOP(3).EQ.0))THEN WRITE(KFILDO,3252)ISTOP(4) 3252 FORMAT(/,' AT LEAST ISTOP(4) =',I6, 1 ' PROBLEMS WITH LAPSE RATES ON THIS RUN.') C ELSEIF(ISTOP(4).NE.0)THEN WRITE(KFILDO,3253)ISTOP(4) 3253 FORMAT(' AT LEAST ISTOP(4) =',I6, 1 ' PROBLEMS WITH LAPSE RATES ON THIS RUN.') ENDIF C IF(ISTOP(5).NE.0.AND.(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0. 1 AND.ISTOP(3).EQ.0.AND.ISTOP(4).EQ.0))THEN WRITE(KFILDO,3254)ISTOP(5) 3254 FORMAT(/,' AT LEAST ISTOP(5) =',I6, 1 ' DATA POINTS ENCOUNTERED WITH NO SURROUNDING GRID', 2 ' POINT OF THE SAME TYPE ON THIS RUN.') C ELSEIF(ISTOP(5).NE.0)THEN WRITE(KFILDO,3255)ISTOP(5) 3255 FORMAT(' AT LEAST ISTOP(5) =',I6, 1 ' DATA POINTS ENCOUNTERED WITH NO SURROUNDING GRID', 2 ' POINT OF THE SAME TYPE ON THIS RUN.') ENDIF C IF(ISTOP(6).NE.0.AND.(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0. 1 AND.ISTOP(3).EQ.0.AND.ISTOP(4).EQ.0. 2 AND.ISTOP(5).EQ.0))THEN WRITE(KFILDO,3256)ISTOP(6) 3256 FORMAT(/,' AT LEAST ISTOP(6) =',I6, 1 ' PROBLEMS WITH BOGUS POINTS ON THIS RUN.') C ELSEIF(ISTOP(6).NE.0)THEN WRITE(KFILDO,3257)ISTOP(6) 3257 FORMAT(' AT LEAST ISTOP(6) =',I6, 1 ' PROBLEMS WITH BOGUS POINTS ON THIS RUN.') ENDIF C IF(NOTOSS(1).EQ.0)THEN WRITE(KFILDO,3258) 3258 FORMAT(/,' NO DATA WERE TOSSED ON THE LAST PASS ON THIS RUN.') ELSE WRITE(KFILDO,3259)NOTOSS(1),NOTOSS(2) 3259 FORMAT(/,' DATA VALUES TOSSED ON THE LAST PASS ON THIS RUN,', 1 ' TOTAL =',I5,', BASE =',I5, 2 ' (BASE STATIONS ARE THOSE NOT BOGUS OR AUGMENTED.)') ENDIF C IF(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0)WRITE(KFILDO,326) 326 FORMAT(/' NO FATAL ERRORS OCCURRED AND ALL NEEDED DATA WERE', 1 ' FOUND ON THIS RUN.') C 400 CONTINUE C IF(JMERTL.EQ.0)THEN WRITE(KFILDO,401) 401 FORMAT(/' NO MAJOR OR MINOR ERRORS OCCURRED IN U405A', 1 ' ON THIS RUN.'/) ELSE WRITE(KFILDO,402)JMERTL 402 FORMAT(/' A TOTAL OF',I6,' MAJOR AND MINOR ERRORS OCCURRED', 1 ' IN U405A ON THIS RUN.'/) ENDIF C 500 RETURN END