SUBROUTINE U15015M(KFILDI,KFILDO,ICALL,CCALL,NELEV,IWBAN,WDIR, 1 WSPD,STALAT,STALON,XPL,YPL,XP,YP,ISDATA,SDATA, 2 DP,WX,PW,EL,THICK,LTAG,NAME,ND1, 3 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD8,FD9, 4 ND2,ND3,ND2X3, 5 ID,IDPARS,THRESH,JD,JP, 6 ISCALD,SMULT,SADD,ORIGIN,CINT,UNITS,ND4, 7 PLAIN,IPLAIN,L3264B,L3264W, 8 IPACK,DATA,IWORK,ICALLD,CCALLD,ND5, 9 KFILIN,NAMIN,JFOPEN,MODNUM,LDATB,LDATE, A LKHERE,MSDATE,INDEXC,ND6, B IS0,IS1,IS2,IS4,ND7, C IDATE,NWORK,ND8, D LSTORE,MSTORE,INDEX,ND9, E CORE,ND10,NBLOCK, F DIR,NGRIDC,ND11) C C$$$ MAIN PROGRAM DOCUMENTATION BLOCK *** C C SUBPROGRAM: U150 C PRGMMR: WIEDENFELD ORG: OST21 DATE: 2005-08-09 C C ABSTRACT: PROGRAM U150 IS USED TO RUN THE ANALYSIS AND MODEL C COMPONENTS OF LAMP. BOTH SEQUENTIAL TDLPACK GRIDPOINT C AND VECTOR DATA ARE ACCOMMODATED. THE PRIMARY OUTPUT C IS GRIDPOINT AND IS WRITTEN ON A SEQUENTIAL FILE. 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 C THERE ARE CERTAIN FATAL ERRORS WITH STOPS IN INT150, BUT C GENERALLY IT WILL RUN TO COMPLETION EVEN WITH ERRORS. C C FOR THIS DEVELOPMENTAL VERSION, U150 DOES NOT COMPLETE FOR C A DATE/TIME IF A CRITICAL COMPONENT CANNOT BE COMPLETED. C IN THAT CASE, THERE WILL BE NO GRIDPOINT OUTPUT ON UNIT C KFILIO, UNLESS THE ERROR OCCURRED WHEN UNPACKING, PACKING, C AND WRITING THE DATA AT THE VERY END OF THE CYCLE. C C PROGRAM HISTORY LOG: C C JULY 2000 GLAHN TDL LAMP C DECEMBER 2000 TLAHN CHANGED OPT( ) TO OPTB( ) C DECEMBER 2000 GLAHN REMOVED WRITING TRAILER TO KFILOG C AND KFILIO C JANUARY 2001 GLAHN REMOVED STOP 99999 BEFORE STATEMENT C 200; ADDED IER TO PRINT AT 155; C REMOVED TEST ON IER = 56 AT 155. C FEBRUARY 2001 GLAHN MODIFIED TO SET LITEMS = 0 WHEN C NDATES = 1 BELOW 200 C FEBRUARY 2001 GLAHN MODIFIED TO WRITE VECTOR RECORD WITH C TOSSED OBS AS MISSING; ADDED KFILOV; C USED NELEV( ),ISDATA( ), AND PLAIN( ) C IN U400A AND U400B C FEBRUARY 2001 GLAHN ADDED KFILQC; REMOVED STATEMENT C NO. 168 C FEBRUARY 2001 GLAHN ADDED EXPLANATION ON VECTOR FILE(S) C INITIALIZATION C FEBRUARY 2001 GLAHN INSERTED ADDITIONAL PRINT C FEBRUARY 2001 GLAHN ADDED KFILID, AUGLST, AND IP(8) C MARCH 2001 GLAHN ADDED IU( ) C MARCH 2001 GLAHN INTERCHANGED CALLS TO U400A AND B; C MODIFIED CALL TO U400A C MARCH 2001 GLAHN REMOVED WRITING OF WIND DIRECTION GRID C APRIL 2001 GLAHN ADDED PLAIN TO CALL TO U400D C APRIL 2001 GLAHN CHANGED LOCATION OF STATEMENT NO. 165; C SET WDIR( ) AND WSPD( ) TO MISSING. C JUNE 2001 GLAHN MODIFIED TEXT WHEN WRITING TO IP(16) C JULY 2001 GLAHN CHANGED COMMENTS IN PURPOSE C JULY 2001 GLAHN ADDED MITEMS TO MSTORE( , ) PRINT C AUGUST 2001 GLAHN ADDED IER NE 0 TEST FOR PRINT 2010 C AUGUST 2001 GLAHN ADDED IER = 31 TEST AT 156 C AUGUST 2001 GLAHN ELIMINATED IU( ); SET MAXIBO; C ELIMINATED AUGLST C SEPTEMBER 2001 GLAHN INSERTED CALL TO U454 C SEPTEMBER 2001 GLAHN INSERTED BLANK LINE FORMAT 1884 C SEPTEMBER 2001 GLAHN INSERTED IER=0 AFTER STATEMENT 202 C OCTOBER 2001 GLAHN ADDED WRITING RADAR DATA WITH LAMPNO C OCTOBER 2001 GLAHN ADDED U452; RESTRUCTURED TO IF/THEN C OCTOBER 2001 GLAHN ELIMINATED ND IN CALL TO U400D C NOVEMBER 2001 GLAHN ADDED IP(10) TO CALL TO RDSTR6 C JANUARY 2002 GLAHN ADDED U453 AS OPTION TO U452 C MAY 2002 GLAHN REARRANGED DIAGNOSTICS FROM ROUTINES C MAY 2002 GLAHN CHANGED WRITING ID(1) IN 1885 AND 1895 C MAY 2002 GLAHN CHANGED WHERE DD=LAMPNO INSERTED IN ID C JUNE 2002 GLAHN ADDED INCDD C JULY 2002 GHIRARDELLI REMOVED FD4 FROM CALL TO U454 C AUGUST 2002 GLAHN ADDED IU454=2 CAPABILITY C SEPTEMBER 2002 GLAHN ADDED IU454=3 CAPABILITY C NOVEMBER 2002 GHIRARDELLI COMMENTED OUT IU454=2 OR 3 C CAPABILITY C DECEMBER 2002 RUDACK MODIFIED FORMAT STATEMENTS TO ADHERE C TO THE F90 COMPILER STANDARDS FOUND ON C THE IBM SYSTEM C DECEMBER 2002 GLAHN REVISED CALL TO U454 C DECEMBER 2002 GLAHN REVISED FORMAT 307; ADDED ISTOP(2); C INSERTED DUMMY CALL TO GSTORE BELOW C 2010 TO GET NSTORE FOR PRINTING C JANUARY 2003 GHIRARDELLI FIXED STATEMENT 170 AND 172 C FOR ISTOP DIMENSIONS AND FORMATS C MARCH 2003 GLAHN REMOVED TWO CALLS TO TIMPR AT 190 C APRIL 2003 GLAHN ADDED CALL TO UNPACK AT 1893 C APRIL 2003 GLAHN REMOVED DUMMY CALL TO GFETCH C MAY 2003 GLAHN CHANGED IPACK TO DATA IN CALL C TO UNPACK ABOVE 1893 C MAY 2003 GLAHN MODIFIED TO USE GFETCH3, NOT GFETCH2 C AUGUST 2005 WIEDENFLED MODIFIED FOR NCEP OPERATIONS. C OCTOBER 2015 SAMPLATSKY ADDED CONDITION WITHIN DO 190 C LOOP TO NOT WRITE OUTPUT WHEN THE C PROJECTION IS 0. THIS WAS DONE FOR C MRMS/TL BECAUSE U202 ALREADY CREATES C GRIDS WHEN THE PROJECTION IS 0, AND C U201 LATER INGESTS BOTH U150 AND U202 C OUTPUT. WE WANTED TO GUARANTEE U202 C OUTPUT BEING USED. C APRIL 2017 SAMPLATSKY MODIFIED ID EXCEPTION TO FINAL C APPROVED MRMS/TL IDS. C SEPTEMBER 2018 SAMPLATSKY MODIFIED ID EXCEPTION WITHIN C DO 190 LOOP TO INCLUDE 1H PRECIP. C MARCH 2024 SAMPLATSKY THIS VERSION IS FOR 15 MIN TIME C STEPS. CHANGED NAME TO U15015M, AND C CALL TO U45415M INSTEAD OF U454. C C DATA SET USE C INPUT FILES: C FORT.KFILDI - UNIT NUMBER OF INPUT FILE. (INPUT) C FORT.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 (INPUT) C FORT.KFILID - UNIT NUMBER FOR READING THE INDIVIDUAL .CN FILES C IN AUGIDS TO AUGMENT THE ID LIST IN ID( , ). C (INPUT) C FORT.KFILRA(J) - HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). C C OUTPUT FILES: C FORT.KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C FORT.IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (SEE IP( ) C UNDER "VARIABLES" BELOW.) (J=1,25) (OUTPUT) C FORT.KFIL10 - UNIT NUMBER FOR INTERMEDIATE PREDICTOR STORAGE. C (OUTPUT) C FORT.KFILIO - UNIT NUMBER OF OUTPUT TDLPACK FILE. (OUTPUT) C FORT.KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (OUTPUT) C FORT.KFILOV - UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C TOSSED OR QUESTIONABLE OBS AS MISSING. (OUTPUT) C FORT.KFILQC - UNIT NUMBER OF OUTPUT VECTOR FILE CONTAINING C QUALITY CONTROLLED OBS AFTER THE FINAL ANALYSIS C PASS. (OUTPUT) C C VARIABLES C KFILDI = UNIT NUMBER TO READ INPUT FILE 'lmp_grdmodl.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 NELEV(K) = ELEVATION OF STATIONS (K=1,NSTA). C IWBAN(K) = WBAN NUMBERS OF STATIONS (K=1,NSTA). THIS IS C RETURNED FROM RDSTAD, BUT IS NOT NEEDED. IT IS C EQUIVALENCED IN DRU150 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 LAMP GRID AREA AT THE CURRENT GRID MESH C LENGTH XMESH. C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE LAMP GRID AREA AT THE CURRENT GRID MESH C LENGTH XMESH. C XPL(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE LAMP GRID AREA AT THE QUARTER BEDIENT C MESH LENGTH MESHB. C YPL(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE LAMP GRID AREA AT THE QUARTER BEDIENT C MESH LENGTH MESHB. C NXL = THE SIZE OF THE PRIMARY GRID FOR THIS RUN C IN THE X DIRECTION IN 1/B BEDIENT UNITS. C NYL = THE SIZE OF THE PRIMARY GRID FOR THIS RUN C IN THE Y DIRECTION IN 1/B BEDIENT UNITS. C NXPL = POLE POSITION OF THE PRIMARY GRID FOR THIS RUN C IN RELATION TO LOWER LEFT CORNER OF GRID AT C (1,1) IN THE X DIRECTION IN 1/B BEDIENT UNITS. C NYPL = POLE POSITION OF THE PRIMARY GRID FOR THIS RUN C IN RELATION TO LOWER LEFT CORNER OF GRID AT C (1,1) IN THE Y DIRECTION IN 1/B BEDIENT UNITS. C MESHB = THE NOMINAL MESH LENGTH OF 1/4 BEDIENT 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 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 ALATL = NORTH LATITUDE OF LOWER LEFT CORNER POINT C OF A 1/4 B GRID OF THE SIZE ETC. SPECIFIED C BY NXL, NYL, NXPL, AND NYPL. CALCULATED WITH C IJLLPS IN INT150. C ALONL = WEST LONGITUDE OF LOWER LEFT CORNER POINT C OF A 1/4 B GRID OF THE SIZE ETC. SPECIFIED C BY NXL, NYL, NXPL, AND NYPL. CALCULATED WITH C IJLLPS IN INT150. 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 IN DRU150 TO IWBAN( ). C PW(K) = PRECIPITABLE WATER AT THE NEEDED PROJECTION C INTERPOLATED TO STATIONS FROM NCEP GRID C (J=1,NSTA). (USED ONLY IN U400A) C EL(K) = STATION ELEVATION INTERPOLATED TO STATIONS C (J=1,NSTA). (USED ONLY IN U400A) C THICK(K) = 1000-500 MB THICKNESS AT THE NEEDED PROJECTION C CALCULATED AND INTERPOLATED TO STATIONS FROM C NCEP GRIDS (J=1,NSTA). (USED ONLY IN U400A) C DP(K) = DEW POINT OBSERVATION (K=1,NSTA). (USED C ONLY IN U400A) C WX(K) = WEATHER OBSERVATION (K=1,NSTA). (USED C ONLY IN U400A) 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 (INTERNAL) C NAME(K) = NAMES OF STATIONS (K=1,NSTA) (CHARACTER*20) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT C WITH. NOTE THAT THIS DOES 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 DRU150. 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 DRU150. SET BY PARAMETER IN DRU150. 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 DRU150. (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 ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING C THE DATA (N=1,ND4). 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. 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 DRU150. (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 DRU150. C JTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOG. THESE ARE THE INTERMEDIATE C RESULTS, LIKELY ONLY TEMPORARY. C JTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOG. THESE ARE THE INTERMEDIATE C RESULTS, LIKELY ONLY TEMPORARY. C MTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOV. THESE ARE THE INTERMEDIATE C RESULTS, LIKELY ONLY TEMPORARY. C MTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOV. THESE ARE THE INTERMEDIATE C RESULTS, LIKELY ONLY TEMPORARY. 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 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 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 DRU150. 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 DRU150. 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 DRU150. 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 DRU150. 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 DRU150. 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, THE NOMINAL 1/4 BEDIENT C MESH LENGTH. 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) = RDSTR5 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 DRU150. 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). NGRIDC(L,M) = HOLDS THE GRID C CHARACTERISTICS (L=1,6) FOR EACH GRID C 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 U150 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 'U150', THEN 4 CHARACTERS FROM IPINIT, THEN C 2 CHARACTERS FROM IP(J) (E.G., 'U150HRG130'). 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 INT150, 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 INT150). 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 U150. 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) = THE INPUT CONTROL FILE NAMES AND C THE AUGMENTATION ID LIST. 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 INT150. 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) A C DIAGNOSTIC WILL BE PROVIDED ON UNIT IP(14) C WHEN THERE ARE NO DATA FOR A DESIRED C DATE/TIME ON A PARTICULAR INPUT FILE. C THIS MIGHT HAPPEN FOR EACH DATE/TIME AND C A LOT OF OUTPUT BE CREATED. C (15) = INDICATES WHETHER (>0) OR NOT (=0) A C LIST OF THE X AND Y POSITIONS OF THE STATIONS C FOR THE BASIC LAMP GRID WILL BE PROVIDED ON C IP(15). THIS IS PRINTED ONLY ONCE IN XYCOMP C CALLED FROM U150. 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., U400A, C U400B, 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., U400A, C U400B, ETC.). ONLY THE STATIONS WITH C NON MISSING DATA ARE LISTED. 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., U400A, C U400B, 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., U400A, C U400B, 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., U400A, U400B, 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 IPINIT = 4 CHARACTERS, USUALLY A USER'S INITIALS PLUS C A RUN NUMBER, TO APPEND TO 'U150' TO IDENTIFY C A PARTICULAR SEGMENT OF OUTPUT INDICATED BY A C SUFFIX IP(J). THE RUN NUMBER ALLOWS MULTIPLE C RUNS OF U150 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 KFILIO = UNIT NUMBER OF OUTPUT TDLPACK FILE. ZERO C MEANS OUTPUT WILL NOT BE WRITTEN. C KSKIP = WHEN NONZERO, INDICATES THAT THE OUTPUT C GRIDPOINT AND QUALITY CONTROLLED OBS VECTOR C FILES 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 KFILID = UNIT NUMBER FOR READING THE INDIVIDUAL .CN FILES C IN AUGIDS TO AUGMENT THE ID LIST IN ID( , ). 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. (OUTPUT) 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 NDATES = NUMBER OF VALUES IN IDATE( ). MODIFIED AS C NECESSARY IN DATPRO. C OUTNAM = 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) (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 U150 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. ISTOP(2) IS INCREMENTED WHEN THERE ARE C FEW DATA FOR AN ANALYSIS. C NPROJ = MAP PROJECTION. SET IN DATA STATEMENT TO 5 FOR C POLAR STEREOGRAPHIC. C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. SET IN C DATA STATEMENT TO 150. C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED. C SET IN DATA STATEMENT TO 60. C IOPTB(J) = SUBSETTING VALUES USED IN GRIDPRINTING (J=1,8) C IN RELATION TO THE QUARTER BEDIENT MESHB. C DEFAULT VALUES OF 0 SET IN DATA STATEMENT MAY C BE OVERWRITTEN IN INT150. IN U150, THESE VALUES C ARE IN RELATION TO MESHB; IN U400A AND U400B, C THE VALUES ARE MADE RELEVANT TO MESHL; IN U400D, C THE VALUES ARE MADE RELEVANT TO MESHD. C IU400A = 1 INDICATES TO RUN U400A. C IU400B = 1 INDICATES TO RUN U400B. C IU400D = 1 INDICATES TO RUN U400D. C IU450 = 1 INDICATES TO RUN U450. C IU451 = 1 INDICATES TO RUN U451. (NOT USED) C IU452 = 1 INDICATES TO RUN U452. C IU453 = 1 INDICATES TO RUN U453. C IU454 = 1 INDICATES TO RUN U454; C 2 INDICATES TO RUN U455, (NOT USED) C 3 INDICATES TO RUN U456. (NOT USED) C ITRASH = PASSED TO RDSTR5, AND DIMENSIONED IN RDSTR5, C BUT NOT ACTUALLY USED. C LAMPNO = LAMP MODEL NUMBER. SET IN DATA STATEMENT TO 5. C NCEPNO = NCEP MODEL NUMBER. SET IN DATA STATEMENT TO 8 C TO INDICATE THE AVN MODEL. C NRADNO = RADAR MODEL NUMBER. SET IN DATA STATEMENT TO 4. 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 10. 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 INCDD = INCREMENT TO ADD TO LAMPNO FOR WRITING FORECASTS C TO ARCHIVE OR DISPOSABLE FILES. ONLY THE C FORECASTS ARE AFFECTED. C C SUBPROGRAMS CALLED: C INT150, U400A, U400B, U400D, RDSTR5, RDSTR6, C LMSTR5, LMSTR2, SKIPR, SKIPWR, GCPAC, TRAIL, UPDAT, C XMSMSH, XYCOMP, DATPRS, AUGIDS, GFETCH3, PACK2D, C WRITEP, TIMPR C UNIQUE - INT150, U400A, U400B, U400D C MOSLIB - SKIPR, SKIPWR, GCPAC, TRAIL, UPDAT, DATPRS C PACK2D, WRITEP, TIMPR C LMPLIB - RDSTR5, RDSTR6, LMSTR5, LMSTR2, XMSMSH, XYCOMP, C AUGIDS, GFETCH3 C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C 140 - ERROR IN SKIPR C 143 - ERROR IN SKIPRW FORECASTS/ANALYSES C 145 - ERROR IN SKIPRW QC'ED OBS C 155 - FATAL ERROR IN RDSTR5 C 156 - FATAL ERROR IN RDSTR6 C 183 - ERROR IN GFETCH3 C 189 - ERROR IN WRITEP C 206 - NO VARIABLES IN MSTORE (MASS STORAGE) AFTER DAY 1. C (PROBLEM WITH INPUT) C 238 - NUMBER OF ERRORS EXCEEDS JSTOP C 299 - NUMBER OF ERRORS EXCEEDS NSKIP C 9999 - FATAL ERROR IN READING A CONTROL FILE IN C U400A, U400B, U400D, U450, U453, OR U454 C 1 2 3 4 5 6 7 X C CHARACTER*8 CCALL(ND1,6),BLANK CHARACTER*8 CCALLD(ND5) CHARACTER*12 UNITS(ND4) CHARACTER*20 NAME(ND1) CHARACTER*32 PLAIN(ND4) CHARACTER*60 NAMIN(ND6),RACESS(6),OUTNAM,OUTDIS,OUTVEC,OUTQCV C DIMENSION ICALL(L3264W,ND1,6), 1 NELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1), 2 XP(ND1),YP(ND1),XPL(ND1),YPL(ND1), 3 ISDATA(ND1),SDATA(ND1),LTAG(ND1), 4 WDIR(ND1),WSPD(ND1),PW(ND1),THICK(ND1),EL(ND1), 5 DP(ND1),WX(ND1) 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), 2 SMULT(ND4),SADD(ND4),ORIGIN(ND4),CINT(ND4) DIMENSION IPLAIN(L3264W,4,ND4) 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 KFILRA(6),IP(25),IOPTB(8),JDATE(4),LD(4),ISTOP(2) C DATA KFIL10/99/ DATA ISTOP/2*0/ DATA MINPK/14/ 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 NPROJ/5/, 1 ORIENT/105./ 2 XLAT/60./ DATA MESHB/80/ DATA LAMPNO/5/, 1 NCEPNO/3/ ! 3 FOR RAP, 8 FOR GFS DATA IOPTB/8*0/ DATA XMISSP/0./, 1 XMISSS/0./ DATA LSTPRT/3/ DATA NRADNO/4/ C CALL INT150(KFILDI,KFILDO,KFILIO,KFILOG,KFILOV,KFILQC,IP, 1 KFILID, 2 CCALL,NELEV,IWBAN,STALAT,STALON, 3 ISDATA,IPACK,NAME,NSTA,ND1,CCALLD,ND5, 4 ID,IDPARS,THRESH,JD,INCDD,JP,NPRED, 5 ISCALD,SMULT,SADD,ORIGIN,CINT,PLAIN,UNITS, 6 L3264B,ND4, 7 KFILIN,MODNUM,NAMIN,JFOPEN,NUMIN,ND6, 8 KFILRA,RACESS,NUMRA,OUTNAM,OUTDIS,OUTVEC,OUTQCV, 9 IDATE,NDATES,NWORK,ND8,INCCYL, A KSKIP,NSKIP,JSTOP,PXMISS,ORIENT,XLAT, B ALATL,ALONL,NXL,NYL,NXPL,NYPL, C MESHB,BMESH,MESHL,XMESHL,MESHD,DMESH,IOPTB, D IU400A,IU400B,IU400D, E IU450,IU451,IU452,IU453,IU454, F ISTOP,IER) C FATAL ERRORS ARE STOPS IN INT150. OTHERWISE, IER = 0. C C CLOSE KFILDI, IT IS USED BY OTHER ROUTINES. C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER INT150 ') CLOSE(UNIT=KFILDI) 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 QUARTER BEDIENT 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 XYCOMP(KFILDO,IP(15),CCALL,NAME, 1 BMESH,XLAT,ORIENT,ALATL,ALONL, 2 STALAT,STALON,XPL,YPL,NSTA) C C SKIP RECORDS ON THE GRIDPOINT OUTPUT FILE WHEN KSKIP NE 0. C WHEN KFILIO = 0, SKIPWR DOES NOTHING. C CALL SKIPR(KFILDO,KFILIO,KSKIP,NTOTBY,NTOTRC,L3264B,IER) C IF(IER.EQ.0)GO TO 142 WRITE(KFILDO,140) 140 FORMAT(/' ****PROGRAM STOP AT 140 BECAUSE OF ERROR IN', 1 ' ROUTINE SKIPWR. OTHERWISE, GOOD GRIDPOINT DATA', 2 ' MIGHT BE OVERWRITTEN.') CALL W3TAGE('U15015M') STOP 140 C STOP THE PROGRAM FOR SAFETY. OTHERWISE, GOOD GRIDPOINT C DATA MIGHT BE OVERWRITTEN. C C USE SKIPWR TO WRITE THE CALL LETTERS RECORD ON DISPOSABLE C FILES. RECORDS ARE NOT SKIPPED ON THESE DISPOSABLE FILES. C 142 KCHECK=1 KWRITE=1 C SINCE RECORDS ARE NOT TO BE SKIPPED, KCHECK AND KWRITE C DON'T MATTER. MSKIP=0 C IF(KFILOV.NE.0)THEN WRITE(KFILDO,1425)OUTVEC 1425 FORMAT(/' INITIALIZE FILE ',A60) CALL SKIPWR(KFILDO,KFILOV,MSKIP,KWRITE,KCHECK, 1 CCALL,ND1,NSTA, 2 CCALLD,ND5,IPACK,ND5, 3 MTOTBY,MTOTRC,L3264B,L3264W,IER) IF(IER.EQ.0)GO TO 144 C WRITE(KFILDO,143) 143 FORMAT(/' ****PROGRAM STOP AT 143 BECAUSE OF ERROR IN', 1 ' ROUTINE SKIPWR.') CALL W3TAGE('U15015M') STOP 143 C STOP THE PROGRAM FOR SAFETY. ENDIF C C SKIP RECORDS ON THE QUALITY CONTROLLED OBS VECTOR C OUTPUT FILE WHEN KSKIP NE 0. THE STATION LIST IN C ICALL( ) IS CHECKED WITH THE STATION LIST AS THE FIRST C RECORD IN THE FILE. IF THEY DO NOT MATCH, THE PROGRAM C RESPONDS TO KWRITE. WHEN RECORDS ARE NOT SKIPPED, C THE CALL LETTERS RECORD IS WRITTEN. WHEN KFILOV = 0, C SKIPWR DOES NOTHING. C 144 KCHECK=1 KWRITE=1 C KCHECK ARE SET TO CHECK THE CALL LETTERS RECORD AND C WRITE A NEW ONE IF THEY DON'T MATCH. C IF(KFILQC.NE.0)THEN WRITE(KFILDO,1445)OUTQCV 1445 FORMAT(/' INITIALIZE FILE ',A60) CALL SKIPWR(KFILDO,KFILQC,KSKIP,KWRITE,KCHECK, 1 CCALL,ND1,NSTA, 2 CCALLD,ND5,IPACK,ND5, 3 ITOTBY,ITOTRC,L3264B,L3264W,IER) IF(IER.EQ.0)GO TO 150 C WRITE(KFILDO,145) 145 FORMAT(/' ****PROGRAM STOP AT 145 BECAUSE OF ERROR IN', 1 ' ROUTINE SKIPWR. OTHERWISE, GOOD QUALITY', 2 ' CONTROLLED OBS DATA MIGHT BE OVERWRITTEN.') CALL W3TAGE('U15015M') STOP 145 C STOP THE PROGRAM FOR SAFETY. OTHERWISE, GOOD DATA MIGHT C BE OVERWRITTEN. ENDIF C C SET VALUES OF IPXX AND NDATE SO THAT VARIABLES IN CALL C AND SUBROUTINES ARE THE SAME. C 150 IP8=IP(8) IP10=IP(10) IP12=IP(12) IP16=IP(16) IP17=IP(17) IP18=IP(18) IP19=IP(19) IP20=IP(20) IP21=IP(21) IP22=IP(22) IP23=IP(23) 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 300 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,152)(JDATE(J),J=1,4) 152 FORMAT(/' STARTING DATE',I6,3I3.2,' #####################', 1 '###############################################') IF(ND.EQ.1)THEN C C AUGMENT THE ID SET IN ID( , ) TO CONTAIN ALL VARIABLES C THAT MAY BE NEEDED IN THE RUN. IN THE IDS, RR IS SET C SO THAT THE NECESSARY HOURS OF DATA ARE SAVED. IN C DOING SO, THE INDIVIDUAL CONTROL FILES ARE READ TO C GET IBACKL AND IBACKN. SET IBACKO HERE BASED ON C WHAT ANALYSES ARE TO BE RUN, AS DETERMINED BY IU400A, C IU400B, AND IU400D. C MAXIBO=0 IF(IU400D.GT.0.OR.IU400A.GT.0)MAXIBO=1 C THE ASSUMPTION IS MADE THAT THE CONTINUOUS VARIABLES C USED IN U400A OR U400B NEED ONLY THE CURRENT HOUR OF DATA, C BUT THE DISCONTINUOUS VARIABLES PROCESSED BY U400D C NEED 2 HOURS OF DATA. HOWEVER, SD IN U400A NEEDS C RADAR. C CALL AUGIDS(KFILDO,KFILID,IP8,ID,IDPARS,NPRED, 1 NPREDX,ND4,NCEPNO,LAMPNO, 2 MAXIBN,MAXIBL,MAXIBO,ISTOP,IER) C IER IS ALWAYS ZERO FROM AUGIDS. THE TOTAL ENTRIES IN C ID( , ) IS NOW NPREDX. IF KFILID = 0, AUGIDS C ACCOMMODATES AND RETURNS NPREDX = NPRED, MAXIBN = 0, C AND MAXIBL = 0. 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 RDSTR5(KFILDO,KFIL10,KFILIN,MODNUM,NAMIN,JFOPEN, 1 LDATB,LDATE,LKHERE,ND6,NUMIN,NDATE, 2 ID,IDPARS,ITRASH,NPREDX,ND4, 3 NCEPNO,LAMPNO, 4 IPACK,IWORK,DATA,CCALLD,ND5, 5 IS0,IS1,IS2,IS4,ND7, 6 LSTORE,LITEMS,ND9,NBLOCK,CORE,ND10, 7 LASTL,LASTD,NSTORE,NGRIDC,ND11,NGRID,IP(10), 8 CCALL,NAME,STALAT,STALON,SDATA,DIR, 9 INDEXC,ND1,NSTA, A PXMISS,IP12,IP23,L3264B,L3264W,ISTOP,IER) C C IER = 56 MEANS THAT NO FIELDS WERE FOUND FOR DAY 1. WHILE C UNLIKELY, IT IS POSSIBLE THIS RUN DOES NOT REQUIRE MODEL C DATA, SO LET IT CONTINUE. IT COULD REQUIRE ONLY RANDOM C ACCESS DATA. C D IF(IP(13).NE.0)THEN D WRITE(IP(13),1544)NDATE,((LSTORE(L,M),L=1,12),M=1,LITEMS) D1544 FORMAT(/' LSTORE IN U150 AT 1554 AFTER RDSTR5 FOR DATE',I12/ D 1 (' ',3I10,I11,2I8,I3,I12,2I3,I5,I12)) D ENDIF C IF(IER.EQ.38.OR.IER.EQ.50.OR.IER.EQ.53.OR.IER.EQ.60)THEN WRITE(KFILDO,155)IER 155 FORMAT(' ****FATAL ERROR, IER =',I5,' FROM RDSTR5.', 1 ' STOP IN U15015M AT 155.') CALL W3TAGE('U15015M') STOP 155 ENDIF C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER RDSTR5 ') ELSE CALL RDSTR6(KFILDO,KFIL10,KFILIN,MODNUM,NAMIN,JFOPEN, 1 LDATB,LDATE,LKHERE,MSDATE,ND6,NUMIN,NDATE, 2 ID,IDPARS,NPREDX,ND4, 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, 9 PXMISS,IP10,IP12,IP23,L3264B,L3264W,ISTOP,IER) C D IF(IP(13).NE.0)THEN D WRITE(IP(13),1555)NDATE,((LSTORE(L,M),L=1,12),M=1,LITEMS) D1555 FORMAT(/' LSTORE IN U150 AT 1555 AFTER RDSTR6 FOR DATE',I12/ D 1 (' ',3I10,I11,2I8,I3,I12,2I3,I5,I12)) D ENDIF C IF(IER.EQ.38.OR.IER.EQ.50.OR.IER.EQ.53.OR.IER.EQ.56.OR. 1 IER.EQ.60.OR.IER.EQ.127.OR.IER.EQ.138.OR.IER.EQ.31)THEN WRITE(KFILDO,156) 156 FORMAT(' ****FATAL ERROR, STOP IN U15015M AT 156') CALL W3TAGE('U15015M') STOP 156 ENDIF C C***D CALL TIMPR(KFILDO,KFILDO,'U150 AFTER RDSTR6 ') ENDIF C C SET WDIR( ) AND WSPD( ) TO MISSING IN CASE U400B DOES NOT RUN. C WDIR( ) AND WSPD( ) ARE USED IN U400A. C DO 158 K=1,ND1 WDIR(K)=9999. WSPD(K)=9999. 158 CONTINUE C IF(IU400B.NE.0)THEN C C DO ANALYSES IN U400B. C CALL U400B(KFILDI,KFILDO,KFIL10,KFILOG,KFILOV,KFILQC, 1 IP16,IP17,IP18,IP19,IP20,IP21,IP22, 2 CCALL,STALAT,STALON,XP,YP,XPL,YPL,NELEV,ISDATA, 3 LTAG,WDIR,WSPD,NSTA,ND1, 4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD8,FD9,ND2X3, 5 ID,IDPARS,JD,JP,ISCALD, 6 IPLAIN,PLAIN,NPRED,ND4, 7 IPACK,DATA,SDATA,IWORK,ND5, 8 NCEPNO,LAMPNO,NDATE, 9 ALATL,ALONL,NPROJ,ORIENT,XLAT, A NXL,NYL,NXPL,NYPL,MESHB,MESHL,IOPTB, B IS0,IS1,IS2,IS4,ND7, C LSTORE,LITEMS,ND9, D CORE,ND10,NBLOCK, E JTOTBY,JTOTRC,MTOTBY,MTOTRC,ITOTBY,ITOTRC, F L3264B,L3264W,MISTOT,MINPK,ISTOP,IER) C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER U400B ') C IF(IER.NE.0.AND.IER.NE.9999)THEN WRITE(KFILDO,159)IER,ISTOP(1) 159 FORMAT(' IER =',I4,' ISTOP(1) =',I3,' FROM U400B.') WRITE(KFILDO,201)OUTNAM GO TO 200 C THIS WILL CLOSE OUT THIS DATE/TIME. ELSEIF(IER.EQ.9999)THEN CALL W3TAGE('U15015M') STOP 9999 ENDIF C ENDIF C IF(IU400A.NE.0)THEN C C DO ANALYSES IN U400A. C CALL U400A(KFILDI,KFILDO,KFIL10,KFILOG,KFILOV,KFILQC,KFILRA, 1 RACESS,NUMRA,IP16,IP17,IP18,IP19,IP20,IP21,IP22, 2 CCALL,XP,YP,XPL,YPL,DP,WX,PW,EL,THICK,NELEV,ISDATA, 3 WDIR,WSPD,LTAG,NSTA,ND1, 4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD8,FD9,ND2X3, 5 ID,IDPARS,JD,JP,NGRIDC,ND11,ISCALD, 6 IPLAIN,PLAIN,NPRED,ND4, 7 IPACK,DATA,IWORK,ND5, 8 NCEPNO,LAMPNO,NDATE, 9 ALATL,ALONL,NPROJ,ORIENT,XLAT, A NXL,NYL,NXPL,NYPL,MESHB,BMESH,MESHL,IOPTB, B IS0,IS1,IS2,IS4,ND7, C LSTORE,LITEMS,MSTORE,MITEMS,ND9, D CORE,ND10,NBLOCK, E JTOTBY,JTOTRC,MTOTBY,MTOTRC,ITOTBY,ITOTRC, F L3264B,L3264W,MISTOT,MINPK,ISTOP,IER) C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER U400A ') C IF(IER.NE.0.AND.IER.NE.9999)THEN WRITE(KFILDO,160)IER,ISTOP(1) 160 FORMAT(' IER =',I4,' ISTOP(1) =',I3,' FROM U400A.') WRITE(KFILDO,201)OUTNAM GO TO 200 C THIS WILL CLOSE OUT THIS DATE/TIME. ELSEIF(IER.EQ.9999)THEN CALL W3TAGE('U15015M') STOP 9999 ENDIF C ENDIF C IF(IU400D.NE.0)THEN C CALL U400D(KFILDI,KFILDO,KFIL10,KFILOG, 1 IP16,IP17,IP22, 2 CCALL,XP,YP,XPL,YPL, 3 LTAG,NSTA,ND1, 4 FD1,FD2,FD3,FD4,ND2X3, 5 ID,IDPARS,JD,JP,ISCALD, 6 IPLAIN,PLAIN,NPRED,ND4, 7 IPACK,DATA,IWORK,ND5, 8 LAMPNO,NDATE, 9 ALATL,ALONL,NPROJ,ORIENT,XLAT, A NXL,NYL,NXPL,NYPL,MESHB,MESHD,IOPTB, B IS0,IS1,IS2,IS4,ND7, C LSTORE,LITEMS,ND9, D CORE,ND10,NBLOCK, E JTOTBY,JTOTRC,L3264B,L3264W,MISTOT, F MINPK,ISTOP,IER) C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER U400D ') C IF(IER.NE.0.AND.IER.NE.9999)THEN WRITE(KFILDO,161)IER,ISTOP(1) 161 FORMAT(' IER =',I4,' ISTOP(1) =',I3,' FROM U400D.') WRITE(KFILDO,201)OUTNAM GO TO 200 C THIS WILL CLOSE OUT THIS DATE/TIME. ELSEIF(IER.EQ.9999)THEN CALL W3TAGE('U15015M') STOP 9999 ENDIF C ENDIF C IF(IU450.NE.0)THEN C CALL U450(KFILDI,KFILDO,KFIL10,KFILOG,KFILRA,RACESS,NUMRA, 1 IP16,IP22, 2 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD8,FD9,ND2X3, 3 ID,IDPARS,JD,INCDD,JP,ISCALD, 4 IPLAIN,PLAIN,NPRED,ND4, 5 IPACK,DATA,IWORK,ND5, 6 NCEPNO,LAMPNO,NDATE, 7 ALATL,ALONL,NPROJ,ORIENT,XLAT, 8 NXL,NYL,NXPL,NYPL,MESHB,MESHL,IOPTB, 9 IS0,IS1,IS2,IS4,ND7, A LSTORE,LITEMS,ND9, B CORE,ND10,NBLOCK, C JTOTBY,JTOTRC, D L3264B,L3264W,MISTOT,MINPK,ISTOP,IER) C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER U450 ') C IF(IER.NE.0.AND.IER.NE.9999)THEN WRITE(KFILDO,162)IER,ISTOP(1) 162 FORMAT(' IER =',I4,' ISTOP(1) =',I3,' FROM U450.') WRITE(KFILDO,201)OUTNAM GO TO 200 C THIS WILL CLOSE OUT THIS DATE/TIME. ELSEIF(IER.EQ.9999)THEN CALL W3TAGE('U15015M') STOP 9999 ENDIF C ENDIF C IF(IU453.NE.0)THEN C CALL U453(KFILDI,KFILDO,KFIL10,KFILOG,KFILRA,RACESS,NUMRA, 1 IP16,IP22, 2 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD9,ND2X3, 3 ID,IDPARS,JD,INCDD,JP,ISCALD, 4 IPLAIN,PLAIN,NPRED,ND4, 5 IPACK,DATA,IWORK,ND5, 6 NCEPNO,LAMPNO,NDATE, 7 ALATL,ALONL,NPROJ,ORIENT,XLAT, 8 NXL,NYL,NXPL,NYPL,MESHB,MESHL,IOPTB, 9 IS0,IS1,IS2,IS4,ND7, A LSTORE,LITEMS,ND9, B CORE,ND10,NBLOCK, C JTOTBY,JTOTRC, D L3264B,L3264W,MISTOT,MINPK,ISTOP,IER) C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER U453 ') C IF(IER.NE.0.AND.IER.NE.9999)THEN WRITE(KFILDO,163)IER,ISTOP(1) 163 FORMAT(' IER =',I4,' ISTOP(1) =',I3,' FROM U453.') WRITE(KFILDO,201)OUTNAM GO TO 200 C THIS WILL CLOSE OUT THIS DATE/TIME. ELSEIF(IER.EQ.9999)THEN CALL W3TAGE('U15015M') STOP 9999 ENDIF C ELSEIF(IU452.NE.0)THEN C BOTH U453 AND U452 WILL NOT EXECUTE, ONLY ONE AT MOST. C SINCE IT IS EXPECTED U453 WILL BE USED, IT IS CALLED FIRST C IN CASE BOTH IU452 AND IU453 ARE 1. C CALL U452(KFILDI,KFILDO,KFIL10,KFILOG,KFILRA,RACESS,NUMRA, 1 IP16,IP22, 2 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD9,ND2X3, 3 ID,IDPARS,JD,INCDD,JP,ISCALD, 4 IPLAIN,PLAIN,NPRED,ND4, 5 IPACK,DATA,IWORK,ND5, 6 NCEPNO,LAMPNO,NDATE, 7 ALATL,ALONL,NPROJ,ORIENT,XLAT, 8 NXL,NYL,NXPL,NYPL,MESHB,MESHL,IOPTB, 9 IS0,IS1,IS2,IS4,ND7, A LSTORE,LITEMS,ND9, B CORE,ND10,NBLOCK, C JTOTBY,JTOTRC, D L3264B,L3264W,MISTOT,MINPK,ISTOP,IER) C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER U452 ') C IF(IER.NE.0.AND.IER.NE.9999)THEN WRITE(KFILDO,164)IER,ISTOP(1) 164 FORMAT(' IER =',I4,' ISTOP(1) =',I3,' FROM U452.') WRITE(KFILDO,201)OUTNAM GO TO 200 C THIS WILL CLOSE OUT THIS DATE/TIME. ELSEIF(IER.EQ.9999)THEN CALL W3TAGE('U15015M') STOP 9999 ENDIF C ENDIF C IF(IU454.EQ.1)THEN C CALL U45415M(KFILDI,KFILDO,KFIL10,KFILOG,KFILRA,RACESS,NUMRA, 1 IP16,IP22, 2 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD8,FD9,ND2X3, 3 ID,IDPARS,JD,INCDD,JP,ISCALD, 4 IPLAIN,PLAIN,NPRED,ND4, 5 IPACK,DATA,IWORK,ND5, 6 NCEPNO,LAMPNO,NDATE, 7 ALATL,ALONL,NPROJ,ORIENT,XLAT, 8 NXL,NYL,NXPL,NYPL,MESHB,MESHD,IOPTB, 9 IS0,IS1,IS2,IS4,ND7, A LSTORE,LITEMS,ND9, B CORE,ND10,NBLOCK, C JTOTBY,JTOTRC, D L3264B,L3264W,MISTOT,MINPK,ISTOP,IER) C D CALL TIMPR(KFILDO,KFILDO,'U15015M AFTER U45415M') C IF(IER.NE.0.AND.IER.NE.9999)THEN WRITE(KFILDO,165)IER,ISTOP(1) 165 FORMAT(' IER =',I4,' ISTOP(1) =',I3,' FROM U454.') WRITE(KFILDO,201)OUTNAM GO TO 200 C THIS WILL CLOSE OUT THIS DATE/TIME. ELSEIF(IER.EQ.9999)THEN CALL W3TAGE('U15015M') STOP 9999 ENDIF C ENDIF C C READ THE ANALYSES AND/FORECASTS FROM THE INTERNAL C RANDOM ACCESS FILE AND WRITE THEM TO THE SEQUENTIAL C OUTPUT FILE. FOR FORECASTS, THERE SHOULD BE AN C ENTRY IN ID( , ) FOR EACH PROJECTION. NOTE THAT THEY C ARE NOT UNPACKED AND REPACKED; GFETCH3 FETCHES THE C TOTAL DATA RECORD, WHICH CAN BE WRITTEN. ALL OF THE C FINAL WRITING IS DONE HERE RATHER THAN IN INDIVIDUAL C MODULES SO THAT IF THERE IS AN ABORT FOR A PARTICULAR C DATE, NO DATA WILL BE WRITTEN. C ICOUNT=0 C DO 190 N=1,NPRED IF(IDPARS(4,N).NE.LAMPNO.AND. 1 IDPARS(4,N).NE.NCEPNO.AND. 2 IDPARS(4,N).NE.NRADNO)GO TO 190 C THERE MAY BE VARIABLES IN THE LIST THAT ARE NOT C TO BE WRITTEN. WRITE ONLY THOSE WITH DD = 4, 5, OR 8. C 4, 5, AND 8 ARE NRADNO, LAMPNO, AND NCEPNO, RESPECTIVELY. C NOTE THAT ALL THREE WIND VARIABLES SHOULD BE IN C THE LIST (U, V, AND SPEED) FOR THEM TO BE WRITTEN. C WIND DIRECTION WILL NOT BE WRITTEN, AND IF A WIND C ANALYSIS WERE TO BE DONE FOR PURPOSES OF ASSISTING C IN THE SLP ANALYSIS AND WRITING IS NOT DESIRED, THEN C PUT ONLY THE WIND DIRECTION IN THE .CN LIST. U400B C WILL ANALYZE ALL THREE AT THE SAME TIME EVEN IF C ONLY ONE IS THERE. C IF(ID(1,N).EQ.004201005)GO TO 190 C WIND DIRECTION IS NOT WRITTEN AS A GRID EVEN C THOUGH IT IS IN THE .CN INPUT LIST. IT IS IN THE LIST C FOR PURPOSES OF WRITING A QUALITY CONTROLLED C OBSERVATIONAL RECORD OR FOR DOING A WIND ANALYSIS WITH C NO WIND OUTPUT. C C INPUT RADAR DATA HAVE DD = 4. RADAR DATA ON LAMP GRID C WILL HAVE A DD = LAMPNO. BELOW ASSURES THIS. C C C ONLY WRITE OUT OUTPUT OF 0H PROJ FOR NON-MRMS AND LTG VARS. C **** FOR 15 MIN ADV, DO OUTPUT THE 0HR GRID, THAT PART IS C COMMENTED OUT. C C IF ((ID(3,N).NE.0).OR. C 1 ((ID(1,N)/1000.NE.007545).AND. ! 60M TL C 2 (ID(1,N)/1000.NE.007550).AND. ! 30M TL C 3 (ID(1,N)/1000.NE.007551).AND. ! 30M IC C 4 (ID(1,N)/1000.NE.007552).AND. ! 30M CG C 5 (ID(1,N)/1000.NE.007553).AND. ! 30M TL TIME CHANGE C 6 (ID(1,N)/1000.NE.007801).AND. ! MRMS CREF C 7 (ID(1,N)/1000.NE.007805).AND. ! MRMS CREF TIME CHANGE C 8 (ID(1,N)/1000.NE.007811).AND. ! MRMS MX VIL C 9 (ID(1,N)/1000.NE.003200).AND. ! 1H PCP NN C X (ID(1,N)/1000.NE.003203))) THEN ! IH PCP AC LD(1)=(ID(1,N)/100)*100+LAMPNO LD(2)=ID(2,N) LD(3)=ID(3,N) LD(4)=ID(4,N) ITIME=0 C ITIME=0 MEANS NO TIME ADJUSTMENT FOR THIS FETCH. C GFETCH3 RETURNS THE FULL RECORD, STILL PACKED, C IN DATA(J) J=1,NWORDS AND THE METADATA IN THE ISX( ) C ARRAYS. CALL GFETCH3(KFILDO,KFIL10,LD,7777,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA,ND5, 2 NWORDS,NPACK,NDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B, 4 ITIME,IER) C IF(IER.EQ.47)THEN IER=0 WRITE(KFILDO,182)(LD(J),J=1,4),OUTNAM 182 FORMAT(/' ****VARIABLE ',3(1X,I9.9),1X,I10.3,' NOT FOUND', 1 ' BY GFETCH3.'/ 2 ' DATA CANNOT BE WRITTEN TO OUTPUT FILE ',A60) ISTOP(1)=ISTOP(1)+1 C THIS IS COUNTED AS AN ISTOP(1) ERROR. GO TO 190 ENDIF C IF(IER.NE.0)THEN WRITE(KFILDO,183)IER 183 FORMAT(/' ****FATAL ERROR IN GFETCH3, IER =',I5, 1 '. STOP IN U15015M AT 183.') CALL W3TAGE('U15015M') STOP 183 ENDIF C C WRITE THE DATA FROM DATA( ), RETURNED BY GFETCH3, C UNLESS KFILIO = 0. NOTE THAT UNPACKING AND REPACKING C IS NOT DONE. C IF(KFILIO.NE.0)THEN C IF(ICOUNT.EQ.0)THEN C PUT A SPACE BEFORE THE FIRST ONE. WRITE(KFILDO,1884) 1884 FORMAT(' ') ICOUNT=1 ENDIF C WRITE(KFILDO,1885)(LD(J),J=1,4),NDATE,PLAIN(N) 1885 FORMAT(' WRITING GRIDPOINT RECORD FOR ',3(1X,I9.9),1X,I10.3, 1 ' FOR DATE',I12,2X,A32) CALL WRITEP(KFILDO,KFILIO,DATA,NWORDS, 1 NTOTBY,NTOTRC,L3264B,IER) D WRITE(KFILDO,1887)NFETCH,NWORDS,NTOTBY,NTOTRC D1887 FORMAT(' NFETCH,NWORDS,NTOTBY,NTOTRC=',4I10) C IF(IER.NE.0)THEN WRITE(KFILDO,189) 189 FORMAT(/' ****FATAL ERROR IN WRITEP. STOP U15015M AT 189.') CALL W3TAGE('U15015M') STOP 189 ENDIF C IF(IP(16).NE.0)THEN CALL XMSMSH(KFILDO,IS2(8)/1000000.,MESH,TRASH) C XMSMSH GETS THE NOMINAL MESH LENGTH MESH OF THE CURRENT C GRID. WRITE(IP(16),1895)(LD(J),J=1,4), 1 ((IPLAIN(I,J,N),I=1,L3264W),J=1,4),NDATE, 2 IS2(3),IS2(4),MESH,ALATL,ALONL 1895 FORMAT(/' WRITING DATA TO UNIT KFILIO',3I10.9,I10.3,3X,8A4, 1 ' FOR DATE',I12/ 2 77X,'NX,NY,MESH,ALAT,ALON =',3I5,2F9.4) ENDIF C ENDIF C C END OUTPUTTING OF EVERYTHING OTHER THAN THE 0 PROJECTION OF C MRMS OR LTG DATA C ENDIF 190 CONTINUE C 200 CONTINUE 201 FORMAT(' THIS DATE/TIME WILL NOT COMPLETE AND DATA WILL', 1 ' NOT BE WRITTEN'/ 2 ' TO THE OUTPUT FILE ',A60) C CONTROL COMES TO 200 WHENEVER PROGRAM CANNOT C COMPLETE THIS DATE NT. C IF(IER.NE.0)THEN C IF(IP(13).NE.0)THEN WRITE(IP(13),2010)NDATE,((LSTORE(L,M),L=1,12),M=1,LITEMS) 2010 FORMAT(/' LSTORE IN U150 AT 2010 BEFORE LMSTR5 FOR DATE', 1 I12/ 2 (' ',3I10,I11,2I8,I3,I12,2I3,I5,I12)) ENDIF C ENDIF C C DO A DUMMY STORE TO GET THE NSTORE COUNT WHEN THIS IS THE C LAST DATE. C IF(ND.EQ.NDATES)THEN LD(1)=0 LD(2)=0 LD(3)=0 LD(4)=0 NDUM=10 CALL GSTORE(KFILDO,KFIL10,LD,MESHB,LSTORE,ND9,LITEMS, 1 IPACK,NDUM,2,0,IS1(8), 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C NOT CHECKING IER. ENDIF C IF(ND.EQ.1)THEN D WRITE(KFILDO,202)NDATE,((LSTORE(L,M),L=1,12),M=1,LITEMS) D202 FORMAT(/' LSTORE IN U150 AT 202 BEFORE LMSTR5 FOR DATE',I12/ D 1 (' ',3I10,I11,2I8,I3,I12,2I3,I5,I12)) C C ELIMINATE THE ENTRIES IN LSTORE( , ) NOT NEEDED AND C INITIALIZE MSTORE( , ) IN LMSTR5. LET IT PROCEED C EVEN IF THERE IS ONLY ONE DATE FOR FOLLOWING PRINT. C IER=0 IF(NDATES.GT.1)THEN C IF(ND.LT.NDATES)THEN CALL LMSTR5(KFILDO,IP(11),ID,IDPARS,NPRED,NPREDX, 1 NDATE,IDATE(ND+1),INCCYL, 2 LSTORE,LITEMS,MSTORE,MITEMS,ND9, 3 NCEPNO,LAMPNO,MAXIBN,MAXIBL,MAXIBO,ISTOP,IER) ELSE CALL UPDAT(IDATE(ND),INCCYL,KDATE) C IDATE(ND+1) IS UNDEFINED WHEN ND = NDATES. CALL LMSTR5(KFILDO,IP(11),ID,IDPARS,NPRED,NPREDX, 1 NDATE,KDATE,INCCYL, 2 LSTORE,LITEMS,MSTORE,MITEMS,ND9, 3 NCEPNO,LAMPNO,MAXIBN,MAXIBL,MAXIBO,ISTOP,IER) ENDIF C ELSE LITEMS=0 ENDIF C IF(IER.NE.0)ISTOP(1)=ISTOP(1)+1 C IF(LITEMS.GT.0)THEN C COMPRESSION AND PRINT IS NOT DONE WHEN LITEMS = 0, C WHICH WOULD GENERALLY OCCUR WHEN NDATES = 1. CALL GCPAC(KFILDO,KFIL10,LSTORE,ND9,LITEMS,CORE,ND10, 1 LASTL,LASTD,IWORK,ND5,NBLOCK,IER) C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 C AN ERROR IN GCPAC IS FATAL. WRITE(KFILDO,236)IDATE(ND) C A **** DIAGNOSTIC WILL HAVE BEEN PRINTED BY GCPAC OR C ITS SUBROUTINES. GO TO 304 ENDIF C IF(IP(13).NE.0)THEN C IF(LITEMS.EQ.0)THEN WRITE(IP(13),204)ND,NDATE 204 FORMAT(/' NO VARIABLES IN LSTORE AFTER DAY',I4, 1 ', DATE',I12) ELSE WRITE(IP(13),205)ND,NDATE, 1 ((LSTORE(L,M),L=1,12),M=1,LITEMS) 205 FORMAT(/' SAVED VARIABLES IN LSTORE AFTER DAY ',I4, 1 ', DATE',I12// 2 (' ',3I10,I11,2I8,I3,I12,2I3,I5,I12)) ENDIF C ENDIF C ENDIF C IF(IP(11).NE.0.AND.NDATES.GT.1)THEN C IF(MITEMS.EQ.0)THEN WRITE(IP(11),206) IF(IP(11).NE.KFILDO)WRITE(KFILDO,206) 206 FORMAT(/' NO VARIABLES IN MSTORE AFTER DAY 1.', 1 ' THIS IS A FATAL ERROR. STOP IN 150 AT 206.') CALL W3TAGE('U15015M') STOP 206 C ELSE WRITE(IP(11),210)MITEMS,((MSTORE(L,K),L=1,7),K=1,MITEMS) 210 FORMAT(/' MSTORE( , ) AFTER DAY 1,',I5,' VARIABLES', 1 ' POSSIBLY NEEDED FROM INPUT'/ 2 45X,'USE/STORE CYCLE HRS TO KEEP'/ 3 (' ',3I10,I11,I10,I8,I10)) ENDIF C ENDIF C IF(ISTOP(1).NE.0)THEN WRITE(KFILDO,216)ISTOP(1) 216 FORMAT(/' AT LEAST ISTOP(1) =',I6, 1 ' ERRORS OCCURRED ON DAY 1.') ELSE WRITE(KFILDO,217) 217 FORMAT(/' NO ERRORS OCCURRED AND ALL NEEDED DATA WERE', 1 ' FOUND FOR DAY 1.') ENDIF C NSTORE AND NFETCH WILL LIKELY NOT BE CORRECT C BECAUSE THEY HAVE NOT BEEN IN THE CALL TO ROUTINES. C IF(IER.EQ.53.OR.IER.EQ.60.OR.IER.EQ.127)GO TO 304 C IER EQ 53 OR 60 IS FATAL ERROR IN GRCOMB. C IER EQ 127 MEANS ALL DATA AVAILABLE HAVE BEEN USED. C IER EQ 31, 38, OR 138 WILL BE TOLERATED FOR NOW; C ISTOP(1) WILL HALT PROGRAM EVENTUALLY. 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, U15015M HALTS. C ELSE C C ELIMINATE THE ENTRIES IN LSTORE( , ) NOT NEEDED AFTER C ALL DAYS EXCEPT DAY 1 AND THE LAST DAY. NOTE THAT C IDATE(ND+1) IS FURNISHED TO LMSTR2, AND THAT IS NOT C LEGITIMATE FOR THE LAST DATE. C IF(ND.LT.NDATES)THEN 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.NE.0)THEN 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) C A **** DIAGNOSTIC WILL HAVE BEEN PRINTED BY GCPAC OR C ITS SUBROUTINES. GO TO 304 ENDIF C C PRINT LSTORE( , ) AFTER COMPRESSION WHEN IP(13) NE 0, C WHEN ND LE LSTPRT AND WHEN THIS IS NOT THE LAST DATE. C IF(IP(13).NE.0.AND.ND.LE.LSTPRT.AND.ND.LT.NDATES)THEN C IF(LITEMS.EQ.0)THEN WRITE(IP(13),204)ND,NDATE ELSE WRITE(IP(13),205)ND,NDATE, 1 ((LSTORE(L,M),L=1,12),M=1,LITEMS) ENDIF C 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 THIS CAN HAPPEN ONLY ON DAYS 3 AND ABOVE WHEN ISTOP(1) GT JSTOP. C WRITE(KFILDO,238)ISTOP(1),IDATE(ND) 238 FORMAT(/' NUMBER OF ERRORS =',I6,' AFTER DATE',I11, 1 ' EXCEEDS JSTOP. STOP IN U15015M AT 238.') CALL W3TAGE('U15015M') STOP 238 C 240 IF(ND.NE.3.OR.LSTOP.LE.NSKIP)GO TO 300 C C DAY 1 ERRORS ALLOWED HAVE BEEN EXCEEDED. PRINT AND STOP. C THIS CAN HAPPEN ONLY ON DAY 3 AND WHEN LSTOP GE NSKIP. 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 U15015M AT 299.') CALL W3TAGE('U15015M') STOP 299 C 300 CONTINUE C C WRITE AN EOF ON KFILIO AND KFILOG UNLESS THE UNIT C NUMBER = 0. C 304 IF(KFILIO.NE.0)THEN ENDFILE KFILIO ENDIF C IF(KFILOG.NE.0)THEN ENDFILE KFILOG ENDIF C C WRITE TRAILER RECORD AND EOF TO KFILOV UNLESS KFILOV = 0. C IF THERE IS AN ERROR, TRAIL WILL PRODUCE A DIAGNOSTIC. C IF(KFILOV.NE.0)THEN CALL TRAIL(KFILDO,KFILOV,L3264B,L3264W,MTOTBY,MTOTRC,IER) ENDFILE KFILOV ENDIF C C WRITE TRAILER RECORD AND EOF TO KFILQC UNLESS KFILQC = 0. C IF THERE IS AN ERROR, TRAIL WILL PRODUCE A DIAGNOSTIC. C IF(KFILQC.NE.0)THEN CALL TRAIL(KFILDO,KFILQC,L3264B,L3264W,ITOTBY,ITOTRC,IER) 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 C NFETCH WILL BE CORRECT PROVIDED DATA ARE WRITTEN TO C THE ARCHIVE FILE (KFILIO IS NOT ZERO). 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.'/ 2 ' NO ALLOWANCE FOR MISSING VALUES HAS BEEN MADE', 3 ' WHEN MAKING CALCULATIONS.') C IF(KFILIO.NE.0)THEN WRITE(KFILDO,309)NTOTBY,NTOTRC,OUTNAM 309 FORMAT(/' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C IF(KFILQC.NE.0)THEN WRITE(KFILDO,3092)ITOTBY,ITOTRC,OUTQCV 3092 FORMAT(/' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C IF(KFILOG.NE.0)THEN WRITE(KFILDO,3095)JTOTBY,JTOTRC,OUTDIS 3095 FORMAT(/' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C IF(KFILOV.NE.0)THEN WRITE(KFILDO,3096)MTOTBY,MTOTRC,OUTVEC 3096 FORMAT(/' A TOTAL OF ',I11,' BYTES IN ',I7,' RECORDS NOW', 1 ' EXIST ON FILE ',A60) ENDIF C IF(ISTOP(1).NE.0)THEN WRITE(KFILDO,311)ISTOP(1) 311 FORMAT(/' AT LEAST ISTOP(1) =',I6, 1 ' ERRORS HAVE OCCURRED ON THIS RUN.') ELSE WRITE(KFILDO,312) 312 FORMAT(/' NO ERRORS HAVE OCCURRED ON THIS RUN.') ENDIF C IF(ISTOP(2).NE.0)THEN WRITE(KFILDO,313)ISTOP(2) 313 FORMAT(/' AT LEAST ISTOP(2) =',I6, 1 ' HOURS HAVE LESS THAN 200 STATIONS FOR ANALYSIS', 2 ' OF A VARIABLE ON THIS RUN.') ENDIF C WRITE(KFILDO,315) 315 FORMAT(' ') RETURN END