SUBROUTINE U755(KFILDI,KFILDO,ICALL,CCALL,ELEV,IWBAN, 1 STALAT,STALON,XP,YP,XYP, 2 ISDATA,SDATA,NAME,IQUAL,LNDSEA,ITYPE, 3 ND1,ND13,ND14,ND15, 4 FD1,FD2,FD3,FD4,FD5,FD6,FD7,FD8,FD9, 5 ND2,ND3,ND2X3, 6 ID,IDPARS,THRESH,JD,JP, 7 ANLTAB,INLTAB, 8 ISCALD,IWRITS,IWRITA,IWRITF, 9 PLAIN,IPLAIN,PLAINT,IPLANT,L3264B,L3264W,ND4, 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 MTABLE,MPLAIN,ND16, I LSTORE,MSTORE,INDEX,ND9, J CORE,ND10,NBLOCK, K DIR,NGRIDC,ND11) C C MARCH 2017 GLAHN TDL MOS-2000 C MODIFIED FROM U155 C APRIL 2017 GLAHN INCREASED NCEPNO(3) TO NCEPNO(6) C APRIL 2017 GLAHN ADDED DIAGNOSTIC 156 C APRIL 2017 GLAHN ISTA REMOVED; IREG ADDED C JULY 2017 GLAHN REMOVED IREG C JULY 2017 GLAHN MODIFIED TO USE FULL NCEPNO(6); C USED RDSTR17 VICE RDSTR1 C JULY 2017 GLAHN ADDED MTABLE ,MPLAIN, IDCNT, ND16 C TO CALL TO INT755 AND CN733 C NOVEMBER 2017 GLAHN COMMENTS CONCERNING RDSTR17 C NOVEMBER 2017 GLAHN DELETED KFILAN, ANLNAM C DECEMBER 2017 GLAHN CHANGED COMMENT FOR KFILOV C MAY 2018 GLAHN ADDED COMMENT ABOUT INTRPOLATION C OUTPUT C JULY 2018 GLAHN DIMENSIONED KFILEQ( ), EQNNAM( ) C AND PUT IN CALL TO CN755; CLOSED C AFTER EACH NDATE C JULY 2018 GLAHN ADDED WRITING CALL LETTERS TO KFILOV; C ADDED WRITING TRAILER TO KFILOV C REARRANGED READING OR NOT THE CONSTANT C FILES TELEV( , ), SEALND( , ), C CPNDFD( , ) C AUGUST 2018 GLAHN ADDED IP12 TO CALL TO CN755 C JULY 2019 GLAHN ADDED VOTNAM TO CALL TO CN755 C NOVEMBER 2019 GLAHN ADDED NGRID TO CALL TO CN755 C C PURPOSE C PROGRAM U755 IS USED TO MAKE FORECASTS FROM EQUATIONS C ON A GRID (SIMILAR TO U700/U900 FOR STATIONS AND AS C AN ALTERNATIVE TO USING LAT/LON IDS FOR POINTS). C THE INFRASTRUCTURE IS MUCH LIKE THAT OF OF U155. C C INITIALLY, A GENERALIZED OPERATOR MELD-TYPE SET OF C EQUATIONS WILL BE USED, BUT REGIONS DEFINED BY A GRID C OR GRIDS WILL BE ACCOMMODATED. C C THERE IS AN OPTION TO INTERPOLATE TO STATIONS FROM C THE GRIDDED FORECAST. C C THE L3264B PARAMETER IS RETAINED AS IT EXISTS IN OTHER C MOS-300 PROGRAMS, ALTHOUGH I BELIEVE IT HAS NO UTILITY C BEYOND THE CRAY IN USE IN THE LATE 1990'S WHEN MOS-2000 C WAS UNDER DEVELOPMENT. C C THERE ARE CERTAIN FATAL ERRORS WITH STOPS IN INT755, BUT C GENERALLY IT WILL RUN TO COMPLETION EVEN WITH ERRORS. C C DATA SET USE C KFILDI - UNIT NUMBER OF INPUT FILE 'U755.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 IP(J) - UNIT NUMBERS FOR OPTIONAL OUTPUT (J=1,25). C (SEE IP( ) UNDER "VARIABLES" BELOW.) (OUTPUT) C KFIL10 - UNIT NUMBER FOR INTERMEDIATE VARIABLE 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 OUTPUT ASCII FILE WITH C LATITUDES, LONGITUDES, AND DATA FOR GMOS_PLOT. C ZERO MEANS OUTPUT WILL NOT BE WRITTEN. C (NOT CURRENTLY USED. COULD INTERPOLATE TO C STATIONS AND OUTPUT.) C (OUTPUT) C KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (OUTPUT) ****MAY NOT BE NEEDED**** C KFILRA(J) - HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). (INPUT) C KFILCP - UNIT NUMBER FOR VARIABLE CONSTANT FILE (SCALING, C PLAIN LANGUAGE, ETC.). (INPUT) C C VARIABLES C KFILDI = UNIT NUMBER TO READ INPUT FILE 'U755.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 DRU755 TO SDATA( ). 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 FORECAST GRID AT THE CURRENT GRID MESH C LENGTH BMESH. C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE FORECAST GRID AT THE CURRENT GRID MESH C LENGTH BMESH. C XYP(K,J) = XYP(1,1) EQUIVALENCED TO XP( ) IN DRIVER. C XYP(1,2) EQUIVALENCED TO YP( ) IN DRIVER. C ITYPE(K) = TYPE OF STATION (K=1,ND1). C MESH = THE NOMINAL MESH LENGTH OF THE FORECAST GRID C SPECIFIED BY NX, NY 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 MESH. C TELEV(J) = THE TERRAIN ELEVATION FROM THE MOS-2000 EXTERNAL C RANDOM ACCESS FILE (J=1,NX*NY). C SEALND(J) = THE LAND/SEA MASK (J=1,NX*NY) AT NOMINAL C MESHLENGTH MESH. 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,NX*NY) AT NOMINAL C MESHLENGTH MESH. C ND12 = MAXIMUM SIZE OF TELEV( ), SEALND( ), AND C CPNDFD( ). C ALATL = NORTH LATITUDE OF LOWER LEFT CORNER POINT C OF A GRID OF THE SIZE NX, NY. 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 NX, NY. 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 RDSTQS 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 DRU755. 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 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 DRU755. C ND13 = MAXIMUM NUMBER OF REGIONS IN EQUATIONS. C ND14 = MAXIMUM NUMBER OF TERMS IN AN EQUATION. C ND15 = MAXIMUM NUMBER OF CATEGORIES IN PROBABILITY C EQUATIONS. 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 DRU755. SET BY PARAMETER IN DRU755. 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 DRU755. (NOT ACTUALLY USED.) C ND2X3 = THE DIMENSION OF SEVERAL ARRAYS. SET BY C PARAMETER. C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,ND4). C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C VARIABLE 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 VARIABLE 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) = FOR EACH VARIABLE (N=1,NPRED), C JP(1,N) = 1 INDICATES THE GRIDS WILL BE CLIPPED C ACCORDING TO THE MASK IN CPNDFD( , ). ZERO C OTHERWISE. C JP(2,N) = 1 (NAREA = 2) INDICATES CATEGORICAL C FORECASTS WILL BE REPLACED WITH FIRST GUESS OVER C WATER, SIBERIA, AND POSTIONS OF CANADA. ZERO C OTHERWISE. C JP(3,N) = STATION VALUES WILL BE INTERPOLATED C FROM THE CATEGORICAL GRIDS AND WRITTEN TO C KFILOV WHEN KIFLOV NE 0. ZERO OTHERWISE. C ANLTAB(N) = THE CONTROL FILE NAME FOR THE VARIABLE C (N=1,NPRED). (CHARACTER*17) C INLTAB(N) = UNIT NUMBER FOR CONTROL FILE ANLTAB( ) C (N=1,NPRED). C ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING C THE DATA (N=1,ND4). C IWRITS(N) = 1 WHEN FORECAST 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 C WRITTEN TO FILE UNIT NUMBER KFIOVO; 0 OTHERWISE C (N=1,ND4). THESE ARE INTERPOLATED FROM THE GRID. C IWRITF(N) = 1 WHEN FINAL POSTPROCESSED FORECASTS 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 ND4 = THE MAXIMUM NUMBER OF VARIABLES FOR WHICH C FORECASTS CAN BE MADE. SET BY PARAMETER IN C DRU755. C PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES C IN ID( ,N) (N=1,ND4). EQUIVALENCED TO C IPLAIN( , ,N) IN DRU755. (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 DRU755. C PLAINT = THE PLAIN LANGUAGE DESCRIPTION TO FURNISH TO C GET755. 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 GET755. 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 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 RDSTQS AND RDSTAT. C EQUIVALENCED TO CCALLD( ) IN DRU755. C CCALLD(K) = 8 STATION CALL LETTERS (K=1,NSTA). THIS LIST IS C USED IN RDSTQS TO RETAIN THE ORIGINAL LIST IN C CCALL( ). EQUIVALENCED TO ICALLD( , ) IN DRU755. 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 DRU755. 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 LAMP OR MOS FORECASTS. C (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 DRU755. 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 DRU755. C MTABLE(I,J) = CORRESPONDENCE TABLE BETWEEN VECTOR PREDICTAND C ID (J=1) AND GRIDDED ID TO READ TO EVALUATE C (J=2), I=1,ND16). MTABLE(I,3) IS CALCULATED TO C INDICATE WHETHER OR NOT A BINARY MUST BE MADE. C MPLAIN(I) = DEFINITION OF THE VARIABLES IN MTABLE(I,J), C (I=1,ND16). (CHARACTER*32) C ND16 = MAXIMUM OF IDCNT. DIMENSION OF MPLAIN AND C FIRST DIMENSION OF MTABLE( , ). 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 MESH. FOR VECTOR DATA, NSLAB = 0. C L=11 --THE NUMBER OF THE FIRST VARIABLE 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 VARIABLE 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 VARIABLE 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) = RDSTR17 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 DRU755. 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 RDSTR17 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 U755 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 'U755', THEN 4 CHARACTERS FROM IPINIT, THEN C 2 CHARACTERS FROM IP(J) (E.G., 'U755HRG130'). 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 INT755, 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 INT755). 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 U755. 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 RDSTQS OR RDSTQT. 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 (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 VARIABLE CONSTANT FILE ON UNIT C KFILCP IN INT755. 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). THIS PERTAINS ONLY TO INPUT C VECTOR FILES. C (13) = INDICATES WHETHER (>0) OR NOT (=0) C THE CONTENTS OF LSTORE( , ) WILL BE C WRITTEN TO UNIT IP(13) AFTER CP755 C FOR EACH DAY NUMBER (CYCLE) LE LSTPRT, C WHICH IS SET IN DATA STATEMENT. 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 U755. 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) C DATA WILL BE WRITTEN TO IP(17) TO UNITS C PACKED IN PACKV FOR THE VARIABLE N WHEN C WHEN JP(3,N) NE 0. C (18) = INDICATES WHETHER (>0) OR NOT (=0) C EQUATIONS READ WILL BE WRITTEN TO IP(18). C (19) = INDICATES WHETHER (>0) OR NOT (=0) C STATIONS READ FROM CONSTANT FILE WILL C BE PRINTED TO IP(19). C (23) = INDICATES WHETHER (>0) OR NOT (=0) C STATEMENTS ABOUT EOF AND FILE OPENINGS C AND CLOSINGS WILL BE OUTPUT FOR PRINTING C IPINIT = 4 CHARACTERS, USUALLY A USER'S INITIALS PLUS C A RUN NUMBER, TO APPEND TO 'U755' TO IDENTIFY C A PARTICULAR SEGMENT OF OUTPUT INDICATED BY A C SUFFIX IP(J). THE RUN NUMBER ALLOWS MULTIPLE C RUNS OF U755 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 VARIABLE 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 OUTPUT ASCII FILE WITH C LATITUDES, LONGITUDES, AND DATA FOR GMOS_PLOT. C ZERO MEANS OUTPUT WILL NOT BE WRITTEN. C (NOT CURRENTLY USED. COULD INTERPOLATE TO C STATIONS AND OUTPUT.) C KFILOV = UNIT NUMBER OF OUTPUT VECTOR FILE. C INTERPLATION TO STATIONS CAN BE DONE AND C THE OUTPUT PACKED AND WRITTEN. (OUTPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (NOT CURRENTLY USED) 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 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 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. C (CHARACTER*60) C OUTVEC = NAME OF DATA SET FOR VECTOR DATA IN TDLPACK C FORMAT. (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 U755 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 A DATA RECORD C COULD NOT BE FOUND. C NAREA = THE AREA OVER WHICH THE FORECAST IS MADE: C 1 = CONUS, C 2 = ALASKA, C 3 = HAWAII, C 4 = PUERTO RICO. C NPROJ = MAP PROJECTION. C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED. 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 6 GRIDS THAT C MIGHT BE NEEDED IN MERGING LAMP AND HRRR OR RAP, C IT HAS BEEN DIMENSIONED NCEPNO(J) (J=1,6). C RDSTR17 IS USED TO ACCOMMODATE. RDSTR7 MAY NOT C WORK IF MORE THAN 3 ARE USED. 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 = NOT USED. 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 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 NSEALND = 1 IF THE SEA/LAND MASK IS TO BE READ; C 0 OTHERWISE. C NTELEV = 1 IF THE TERRAIN MAP IS TO BE READ. AFTER AN C ATTEMPTED READING, IF IT CANNOT BE READ, IT C IS SET TO ZERO AND INDICATES WHETHER OR NOT C THE TERRAIN GRID IS IN TELEV( ). C 0 OTHERWISE. C IF C JMERTL = THE TOTAL OF THE ERROR VALUES RETURNED FROM C CN755. THIS IS THE TOTAL OF MAJOR AN MINOR C ERRORS. C IDCNT = NUMBER OF ENTRIES IN MTABLE( , ) AND MPLAIN( ). C IOPER = 1 FOR OPERATIONS; 0 FOR DEVELOPMENT. CONTROLS C HOW EQUATIONS HEADER IS READ AND USED. (INPUT) C KFILEQ(J) = UNIT NUMBER OF FILE HOLDING EQUATIONS (J=1,ND4). C (INPUT FROM CN755) C EQNNAM(J) = FILE NAME HOLDING EQUATIONS, INCLUDING THE C PATH (J=1,ND4). (CHARACTER*60) (INPUT FROM C CN755) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C INT755, CN755, RDSTR17, RDSTR7, C LMSTR5, LMSTR2, SKIPR, GCPAC, TRAIL, UPDAT, C ACTUAL, XYCOM1, DATPRS, GFETCH, GSTORE, C WRITEP, TIMPR, SKPWR1, NEWXY1 C CHARACTER*8 CCALL(ND1,6),BLANK CHARACTER*8 CCALLD(ND5) CHARACTER*10 CFIOP CHARACTER*17 ANLTAB(ND4) CHARACTER*20 NAME(ND1) CHARACTER*32 PLAIN(ND4),PLAINT CHARACTER*32 MPLAIN(ND16+1) CHARACTER*60 NAMIN(ND6),RACESS(6),OUTDIS,OUTVEC,GOTNAM, 1 VOTNAM,EQNNAM(ND4) C EQNNAM( ) IS AN AUTOMATIC ARRAY. C DIMENSION ICALL(L3264W,ND1,6),XYP(ND1,2), 1 ELEV(ND1),IWBAN(ND1),STALAT(ND1),STALON(ND1), 2 XP(ND1),YP(ND1), 3 ISDATA(ND1),SDATA(ND1), 6 IQUAL(ND1,5),LNDSEA(ND1),ITYPE(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),IWRITS(ND4),IWRITA(ND4), 2 IWRITF(ND4),INLTAB(ND4) DIMENSION KFILEQ(ND4) C KFILEQ( ) IS AN AUTOMATIC ARRAY. 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 MTABLE(ND16+1,3) DIMENSION KFILRA(6),IP(25),JDATE(4),ISTOP(2),LD(4), 1 ITABLE(7,2),LDELV(4),LDLAT(4),LDLON(4),NCEPNO(6) C DATA KFIL10/99/ DATA ISTOP/2*0/ DATA MINPK/47/ 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 NSKIP,JSTOP,INCCYL/3*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 MISTOT/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/ DATA NRRDAT/2100010100/, 1 LSDATE/0/ DATA NTOTGR/0/ DATA NTOTVO/0/ C D CALL TIMPR(KFILDO,KFILDO,'STARTING U755 ') JMERTL=0 C CCCCD WRITE(KFILDO,101)ND1,ND2,ND3,ND2X3,ND4,ND5,ND6,ND7,ND8, CCCCD 1 ND9,ND10,ND11,ND12 CCCCD101 FORMAT(' IN U755--ND1,ND2,ND3,ND2X3,ND4,ND5,ND6,ND7,ND8,', CCCCD 1 'ND9,ND10,ND11,ND12'/20I8) C CALL INT755(KFILDI,KFILDO,KFILIO,KFILVO,KFILOG,KFILCP, 1 KFILOV,KFIL10,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,IWRITF, 7 ANLTAB,INLTAB,PLAIN,ND4, 8 L3264B,KFILIN,MODNUM,NAMIN,JFOPEN,NUMIN,ND6, 9 KFILRA,RACESS,NUMRA,GOTNAM,OUTDIS, A OUTVEC,VOTNAM, B IDATE,NDATES,NWORK,ND8,INCCYL, C MTABLE,MPLAIN,IDCNT,ND16, D NSKIP,JSTOP,PXMISS,NPROJ,ORIENT,XLAT, E ALATL,ALONL,NX,NY, F MESH,BMESH, G IOPER,IPRTEL,MINVEC,MINMOD, H ISTOP,IER) IF(IER.NE.0)THEN CALL W3TAGE('U755') STOP 888 ENDIF C DO 1015 J=1,ND4 EQNNAM(J)=' ' 1015 CONTINUE C C CHECK WHETHER ARRAYS ARE LARGE ENOUGH FOR THE DESIRED C GRID. C IF(ND2X3.LT.NX*NY)THEN WRITE(KFILDO,102)ND2X3,NX*NY 102 FORMAT(/,' ****ND2*ND3 =',I8, 1 ' TOO SMALL TO HOLD GRID NX*NY =',I8, 2 '. FATAL ERROR.') CALL W3TAGE('U755') STOP 102 ENDIF C C SET VALUES OF IPXX AND NDATE SO THAT VARIABLES IN CALL C AND SUBROUTINES ARE THE SAME. 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 C DETERMINE THE POSITION J IN ITABLE( , ) FOR THE GRIDLENGTH C BEING USED. C DO_130: DO 130 J=1,7 C IF(MESH.EQ.ITABLE(J,1))THEN C J IS THE ENTRY IN THE TABLE. EXIT DO_130 ELSE IF(J.EQ.7)THEN WRITE(KFILDO,125) 125 FORMAT(/' ****MESH LENGTH FOR CONSTANT GRID IS NOT', 1 ' HANDLED IN ITABLE( , ) AT 125 IN U755.', 2 ' FATAL ERROR.') GO TO 500 ENDIF C ENDIF C C FALL THROUGH HERE MEANS THE NOMINAL GRID LENGTH MESH C IS NOT ONE OF THE VALUES HANDLED IN ITABLE( , ). C 130 END DO DO_130 C C DETERMINE WHETHER THE CLIPPING MASK IS NEEDED. C NCPNDFD=0 C DO_131: DO 131 N=1,NPRED C IF(JP(1,N).NE.0)THEN NCPNDFD=1 C THE CLIPPING MASK IS NEEDED. EXIT DO_131 ENDIF C 131 END DO DO_131 C NTELEV=1 C HARD CODED TO READ THE TERRAIN GRID FROM THE RA CONSTANT C FILE. NSEALND=1 C HARD CODED TO READ AND USE THE SEA/LND GRID FROM THE RA C CONSTANT FILE. C C IT IS NOT KNOWN WHICH RA FILES CONTAIN THE GRIDS. C NO. 43 AND 44 ARE TRIED. THE GRIDS CAN BE ON DIFFERENT C FILES. C DO_150: DO 150 L=1,NUMRA C IF(KFILRA(L).EQ.43.OR.KFILRA(L).EQ.44)THEN C IF(NTELEV.EQ.1)THEN C READ THE TERRAIN ELEVATION GRID FROM RANDOM ACCESS FILE C ON UNIT NO. 43 OR 44. EXCLUDE 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 CALL CONSTG(KFILDO,KFILRA(L),RACESS(L),LD, 1 IPACK,IWORK,TELEV,ND12, 2 IS0,IS1,IS2,IS4,ND7, 3 ISTAV,L3264B,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,135)IER 135 FORMAT(' ERROR IN CONSTG FROM U755 AT 135. IER =', 1 I4,'. IT MAY JUST INCORRECT UNIT NUMBER.', 2 ' NOS. 43 AND 44 ARE TRIED.') ISTOP(2)=ISTOP(2)+1 NTELEV=0 ELSE NTELEV=1 WRITE(KFILDO,136) 136 FORMAT(/' TELEV GRID READ.') ENDIF ENDIF C IF(NSEALND.EQ.1)THEN C READ THE SEA/LAND MASK GRID FROM RANDOM ACCESS FILE C ON UNIT NO. 43 OR 44. GET755 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 CONSTG(KFILDO,KFILRA(L),RACESS(L),LD, 1 IPACK,IWORK,SEALND,ND12, 2 IS0,IS1,IS2,IS4,ND7, 3 ISTAV,L3264B,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,140)IER 140 FORMAT(' ERROR IN CONSTG FROM U755 AT 140. IER =', 1 I4,'. IT MAY JUST INCORRECT UNIT NUMBER.', 2 ' NOS. 43 AND 44 ARE TRIED.') ISTOP(2)=ISTOP(2)+1 NSEALND=0 ELSE NSEALND=1 WRITE(KFILDO,141) 141 FORMAT(/' SEALND GRID READ.') ENDIF C ENDIF C IF(NCPNDFD.EQ.1)THEN C READ THE NDGD MASK GRID FROM RANDOM ACCESS FILE C ON UNIT NO. 43 OR 44. GET755 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 CONSTG(KFILDO,KFILRA(L),RACESS(L),LD, 1 IPACK,IWORK,CPNDFD,ND12, 2 IS0,IS1,IS2,IS4,ND7, 3 ISTAV,L3264B,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,145)IER 145 FORMAT(' ERROR IN CONSTG FROM U755 AT 145. IER =', 1 I4,'. IT MAY JUST INCORRECT UNIT NUMBER.', 2 ' NOS. 43 AND 44 ARE TRIED.') ISTOP(2)=ISTOP(2)+1 NCLIPY=0 ELSE NCLIPY=1 WRITE(KFILDO,146) 146 FORMAT(/' CPNDFD GRID READ.') ENDIF C ENDIF C ENDIF C 150 END DO DO_150 C C COMPUTE XP( ) AND YP( ) 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,XP,YP,NSTA,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,151) 151 FORMAT(' STOP IN U755 AT 151') CALL W3TAGE('U755') STOP 151 ENDIF C C USE SKPRW2 TO WRITE THE CALL LETTERS RECORD ON VECTOR FILE C KFILOV. RECORDS ARE NOT SKIPPED. THE FILE WILL CONTAIN C ONE HEADER (CALL LETERS) AND ONE TRAILER AT COMPLETION C OF U755. C IF(KFILOV.NE.0)THEN KCHECK=1 KWRITE=1 C SINCE RECORDS ARE NOT TO BE SKIPPED, KCHECK AND KWRITE C DON'T MATTER. MSKIP=0 WRITE(KFILDO,152)OUTVEC 152 FORMAT(/' INITIALIZE FILE KFILOV ',A60) CALL SKPWR2(KFILDO,KFILOV,MSKIP,KWRITE,KCHECK, 1 CCALL,ND1,NSTA, 2 CCALLD,ND5,IPACK,ND5, 3 MTOTBY,MTOTRC,L3264B,L3264W,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,153)IER 153 FORMAT(/,' ****FILE KFILOV COULD NOT BE INITIALIZED', 1 ' WITH CALL LETTERS. WRITING TO KFILOV', 2 ' WILL NOT BE DONE. IER =',I4, 3 '. PROCEEDING.') ISTOP(1)=ISTOP(1)+1 KFILOV=0 JMERTL=JMERTL+1 ENDIF C ENDIF 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 '###############################################') C 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 RDSTR17(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 U755 AT 160') CALL W3TAGE('U755') STOP 160 ENDIF C C STORE STATION ELEVATIONS IN INTERNAL STORAGE. NOTE THAT C THIS HAS TO COME AFTER RDSTR17 BECAUSE OF INITIALIZATION C IN RDSTR17. 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 CALL W3TAGE('U755') STOP 886 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 CALL W3TAGE('U755') STOP 885 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 CALL W3TAGE('U755') STOP 884 ENDIF C ELSE CALL TIMPR(KFILDO,KFILDO,'BEFORE RDSTR7 ') C C RDSTR7 WORKS FOR NCEPNO( ) WHEN ONLY THE FIRST 3 VALUES C ARE NON-ZERO. IF 4 OR MORE MODELS ARE EVER USED, RDSTR7 C WILL HAVE TO BE REVISED. C 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 U755 AT 170') CALL W3TAGE('U755') STOP 170 ENDIF C ENDIF C DO 200 N=1,NPRED C WRITE(KFILDO,175)(ID(J,N),J=1,4) 175 FORMAT(/' ***************************************************'//, 1 ' STARTING VARIABLE ',3I10.9,I10.3,//) C CCCC WRITE(KFILDO,180)N,NPRED,(ID(J,N),J=1,4),(IDPARS(J,N),J=1,15) CCCC 180 FORMAT(/,' AT 180 IN U755--', CCCC 1 'N,NPRED,ID(J,N),J=1,4)(IDPARS(J,N),J=1,15)',/,2I4,4I10,15I5) C C IF(ANLTAB(N)(1:3).EQ.'CN7')THEN C C THIS VARIABLE IS TO HAVE FORECASTS MADE WITH CN755. C CALL CN755(KFILDI,KFILDO,KFIL10,KFILOG,KFILOV,KFILIO, 1 KFILVO,KFILRA,RACESS,NUMRA,KFILEQ,EQNNAM,VOTNAM, 2 IP12,IP16,IP17,IP18,IP19,ND13,ND14,ND15, 3 ICALL,CCALL,NAME,XP,YP,XYP,ISDATA,SDATA, 4 IQUAL,LNDSEA,ELEV,STALAT,STALON,NSTA,ND1, 5 FD1,FD2,FD3,FD4,FD5,FD6,ND2X3, 6 ID,IDPARS,JD,JP,ISCALD,THRESH, 7 ANLTAB,INLTAB,IWRITS,IWRITA,IWRITF, 8 DIR,NGRIDC,NGRID,ND11, 9 IPLAIN,PLAIN,ND4,PLAINT,IPLANT,NPRED,N, A ICALLD,CCALLD,IPACK,DATA,IWORK,ND5, B ND,MODNO,IOPER,NDATE,JDATE,MODNUM,ND6, C NAREA,ALATL,ALONL,NPROJ,ORIENT,XLAT, D NX,NY,MESH,BMESH, E NTELEV,TELEV,SEALND,NCLIPY,CPNDFD, F IS0,IS1,IS2,IS4,ND7, G MTABLE,MPLAIN,IDCNT,ND16, H LSTORE,LITEMS,ND9, I CORE,ND10,NBLOCK,NSTORE,NFETCH, J JTOTBY,JTOTRC,MTOTBY,MTOTRC, K NTOTBY,NTOTRC,NTOTGR,NTOTVO, L L3264B,L3264W,MISTOT,MINPK, M ISTOP,IER) ENDIF C JMERTL=JMERTL+IER C AN ERROR IN CN755 FOR AN ELEMENT WILL NOT STOP U755. THE C IER IS THE TOTAL OF MAJOR AND MINOR ERRORS IN CN755. C D WRITE(KFILDO,195)IER,JMERTL D195 FORMAT(/' AT 195 IN U755--IER,JMERTL',2I4) C C REWIND THE EQUATION FILES. THE MAXIMUM NUMBER OPEN IS C NPRED, BUT WILL USUALLLY BE FAR LESS. THE EQUATION C FILES ARE REREAD FOR EACH NDATE. C 200 CONTINUE C C ALL THE VARIABLES HAVE BEEN DEALT WITH AND FORECASTS C MADE OR ABORTED. C IF(IP13.NE.0)THEN WRITE(IP13,2001)NDATE,((LSTORE(L,M),L=1,12),M=1,LITEMS) 2001 FORMAT(/' LSTORE IN U755 AT 2001 AFTER CN755 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 C**************************************************************** CCCC CALL LMSTR4(KFILDO,NDATE,LSTORE,LITEMS, CCCC 1 MSTORE,MITEMS,ND9,INCCYL,NCEPNO,MINVEC,MINMOD, CCCC 2 IDATE,NDATES,ISTOP,IER) C**************************************************************** C CALL UPDAT(NDATE,INCCYL,NRRDAT) CALL LMSTR8(KFILDO,NDATE,NRRDAT,LSTORE,LITEMS, 1 MSTORE,MITEMS,ND9,INCCYL,IER) C**************************************************************** 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 IF(LITEMS.NE.0)THEN WRITE(IP18,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(IP18,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 U755 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)THEN WRITE(KFILDO,225)ISTOP(2) 225 FORMAT(' AT LEAST ISTOP(2) =',I6, 1 ' VARIABLES MISSING ON DAY 1.') ENDIF C IF(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0)THEN WRITE(KFILDO,226) 226 FORMAT(/' NO ERRORS OCCURRED AND ALL NEEDED DATA WERE FOUND', 1 ' FOR DAY 1.') ENDIF 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, U755 HALTS. C C CLOSE EQUATION FILES. MAXIMUM NUMBER = NPRED, BUT C WILL USUALLY BE MUCH FEWER. C DO 229 J=1,NPRED INQUIRE(UNIT=KFILEQ(J),ACCESS=CFIOP) WRITE(KFILDO,231)J,KFILEQ(J),EQNNAM(J),CFIOP C IF(CFIOP.EQ.'SEQUENTIAL')THEN CLOSE(UNIT=KFILEQ(J)) ENDIF C 229 CONTINUE 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 C CLOSEEQUATION FILES. MAXIMUM NUMBER = NPRED, BUT C WILL USUALLY BE MUCH FEWER. C DO 232 J=1,NPRED INQUIRE(UNIT=KFILEQ(J),ACCESS=CFIOP) WRITE(KFILDO,231)J,KFILEQ(J),EQNNAM(J),CFIOP 231 FORMAT(/'J,KFILEQ(J),EQNNAM(J),CFIOP',2I4,2X,A60,A10) C IF(CFIOP.EQ.'SEQUENTIAL')THEN CLOSE(UNIT=KFILEQ(J)) ENDIF C 232 CONTINUE 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(IP18,2095)ND,((LSTORE(L,M),L=1,12),M=1,LITEMS) ELSE WRITE(IP18,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 U755 AT 238.') WRITE(KFILDO,306)NSTORE WRITE(KFILDO,307)NFETCH CALL W3TAGE('U755') 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 U755 AT 299.') WRITE(KFILDO,306)NSTORE WRITE(KFILDO,307)NFETCH CALL W3TAGE('U755') STOP 299 C C WRITE TRAILER RECORD AND EOF TO VECTOR FILE KFILOV UNLESS C KFILOV = 0. IF THERE IS AN ERROR, TRAIL WILL PRODUCE C A DIAGNOSTIC. C 304 IF(KFILOV.NE.0)THEN CALL TRAIL(KFILDO,KFILOV,L3264B,L3264W,MTOTBY,MTOTRC,IER) C IER WILL OVERWRITE ANY PREVIOUS IER. ENDFILE KFILOV 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 IS 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 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 CN755, 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)THEN WRITE(KFILDO,325)ISTOP(2) 325 FORMAT(' AT LEAST ISTOP(2) =',I6, 1 ' VARIABLES MISSING ON THIS RUN.') ENDIF C IF(ISTOP(1).EQ.0.AND.ISTOP(2).EQ.0)THEN WRITE(KFILDO,326) 326 FORMAT(/' NO FATAL ERRORS OCCURRED AND ALL NEEDED DATA', 1 ' WERE FOUND ON THIS RUN.') ENDIF C 400 CONTINUE C IF(JMERTL.EQ.0)THEN WRITE(KFILDO,401) 401 FORMAT(/' NO MAJOR OR MINOR ERRORS OCCURRED IN CN755', 1 ' ON THIS RUN.'/) ELSE WRITE(KFILDO,402)JMERTL 402 FORMAT(/' A TOTAL OF',I6,' MAJOR AND MINOR ERRORS OCCURRED', 1 ' IN CN755 ON THIS RUN.'/) ENDIF C 500 RETURN END