SUBROUTINE 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 P,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) C C MARCH 2017 GLAHN TDL MOS-2000 C ADAPTED FROM U405A C APRIL 2017 GLAHN ADDED DIR( , , ) AND ND111 TO CALL C TO MELD71 C JULY 2017 GLAHN ADDED IREG AS INPUT C JULY 2017 GLAHN ADDED ISCALD( ) TO CALL TO MELD70 C JULY 2017 GLAHN ADDED KFILOG TO CALL TO MELD70 C JULY 2017 GLAHN ADDED JTOTBY, JTOTRC TO CALL TO MELD70 C JULY 2017 GLAHN ADDED MTABLE, MPLAIN, IDCNT, ND16 TO C CALL AND TO CALL TO MELD70 C JULY 2017 GLAHN REMOVED ISPOT, MTIMES, DIFFV, DIFFA C AUGUST 2017 GLAHN REMOVED BA, IREG, AND WRITEP C SEPTEMBER 2017 GLAHN REMOVED TMPEQN C NOVEMBER 2017 GLAHN ADDED KFILOV, DIR, JP TO CALL TO C MELD70 C DECEMBER 2017 GLAHN CHANGED TO MATCH FULL 1ST WORD VICE C CCCFFFB AT 132 C DECEMBER 2017 GLAHN CHANGED COMMENT FOR KFILOV C JUNE 2018 GLAHN ADDED IREG INPUT AND CALL TO MELD71 C JUNE 2018 GLAHN READ KFILEQ FROM INPUT FILE C JULY 2018 GLAHN ADDED MTOTBY AND MTOTRC TO CALL TO C MELD70 C JULY 2018 GLAHN ADDED KFILEQ( ), EQNNAM( ) TO CALL C JULY 2018 GLAHN REMOVED WRITING TRAILER TO KFILOV C AUGUST 2018 GLAHN ADDED IP12 TO CALL AND CALL TO MELD70 C JULY 2019 GLAHN ADDED NTOTVO, NAME( ), IWRITA( ), C KFILVO, STALAT( ), AND STALON( ), AND C VOTNAM TO CALL TO MELD70; ADDED C VOTNAM TO CALL C NOVEMBER 2019 GLAHN ADDED NGRIDC( , , ) AND ND11 TO CALL C TO MELD70 C NOVEMBER 2019 GLAHN ADDED NGRID TO CALL AND TO CALL C TO MELD70 C C PURPOSE C PROGRAM CN755 READS THE SPECIFIC VARIABLE .CN FILES C AND CALLS MELD70 OR MELD71 TO MAKE THE FORECASTS. MELD70 C IS FOR GENERALIZED OPERATOR EQUATIONS AND MELD 71 IS FOR C REGIONALIZED EQUATIONS. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT/OUTPUT) C KFILIO - UNIT NUMBER FOR WRITING FINAL GRIDPOINT C FORECASTS. (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 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 KFILRA(J)- HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). (INPUT) C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL OR RANDOM ACCESS C FILE. (OUTPUT) C VARIABLES C KFILDI = UNIT NUMBER TO READ INPUT FILE 'U450A.CN'. C IT IS CLOSED IN U755. (INPUT) C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (INPUT) C KFILOV = UNIT NUMBER OF OUTPUT VECTOR FILE. C INTERPLATION TO STATIONS CAN BE DONE AND THE C OUTPUT PACKED AND WRITTEN. (INPUT) C KFILIO = UNIT NUMBER FOR WRITING FINAL GRIDPOINT C FORECASTS. (INPUT) C KFILVO = UNIT NUMBER OF OUTPUT ASCII FILE WITH C LATITUDES, LONGITUDES, AND DATA AT STATIONS C INTERPOLATED FROM THE GRID FOR GMOS_PLOT. C ZERO MEANS OUTPUT WILL NOT BE WRITTEN. C (INPUT) C KFILRA(J) = HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,6). C THE ACCESS ROUTINES ALLOW 6 RANDOM ACCESS C FILES. HOWEVER, IT UNLIKELY U755 WILL NEED C MORE THAN 1 OR 2. (INPUT) C RACESS(J) = THE FILE NAMES CORRESPONDING TO KFILRA(J) C (J=1,6). (CHARACTER*60) (INPUT) C NUMRA = THE NUMBER OF UNIT NUMBERS IN KFILRA( ) AND C NAMES IN RACESS( ). (INPUT) C KFILEQ(J) = UNIT NUMBER OF FILE HOLDING EQUATIONS (J=1,ND4). C (OUTPUT) C EQNNAM(J) = FILE NAME HOLDING EQUATIONS, INCLUDING THE C PATH (J=1,ND4). (CHARACTER*60) (OUTPUT) C VOTNAM = NAME OF DATA SET FOR OUTPUT ASCII DATA IN FORMAT C CORRESPONDING TO UNIT NO. KFILVO. C (CHARACTER*60) (OUTPUT) C IP12 = PROVIDED TO SUBROUTINE MELD70 FOR PASSING TO C CONST FOR POSSIBLE PRINTING OF STATION C IDENTIFIERS. (INPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP16 C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWGTS,A RANDOM ACCESS FILE IS WRITTEN C THROUGH PAWRAC, OR A FILE IS WRITTEN TO C INTERNAL STORAGE BY GSSTORE. (INPUT) C IP18 = INDICATES WHETHER (>0) OR NOT (=0) C ELEMENTS OF THE EQUATIONS WILL BE WRITTEN C ON UNIT IP218 (INPUT) 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 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 (J=1) AND C 5 POSSIBLE OTHER STATION CALL LETTERS (J=2,6) C THAT CAN BE USED INSTEAD IF THE PRIMARY (J=1) C STATION CANNOT BE FOUND IN AN INPUT DIRECTORY C (K=1,NSTA). ALL STATION DATA ARE KEYED TO C THIS LIST. CONTAINS GRIDPOINT IDS WHEN C "DATA" TO ANALYZE ARE AT GRIDPOINTS. (INPUT) C NAME(K) = NAMES OF STATIONS (K=1,NSTA). (CHARACTER*20) C (INPUT) C XP(K) = THE X POSITION FOR STATION K (K=1,NSTA) ON C THE FORECAST GRID AREA AT THE CURRENT GRID MESH C LENGTH XMESH. (INTERNAL) C YP(K) = THE Y POSITION FOR STATION K (K=1,NSTA) ON C THE FORECAST GRID AREA AT THE CURRENT GRID MESH C LENGTH XMESH. (INTERNAL) C XYP(K,J) = XYP(1,1) EQUIVALENCED TO XP( ) IN DRIVER. C XYP(1,2) EQUIVALENCED TO YP( ) IN DRIVER. C (INPUT) C ISDATA(K) = WORK ARRAY (K=1,ND1). (INTERNAL) C SDATA(K) = WORK ARRAY (K=1,NSTA). (INTERNAL) C LNDSEA(K) = LAND/SEA INFLUENCE FLAG FOR EACH STATION C (K=1,ND1). C 0 = WILL BE USED FOR ONLY OCEAN WATER (=0) C GRIDPOINTS. C 3 = WILL BE USED FOR ONLY INLAND WATER (=3) C GRIDPOINTS. C 6 = WILL BE USED FOR BOTH INLAND WATER (=3) C AND LAND (=9) GRIDPOINTS. C 9 = WILL BE USED FOR ONLY LAND (=9) GRIDPOINTS. C (INPUT) C ELEV(K) = ELEVATION OF STATIONS IN METERS (K=1,NSTA). C (INPUT) C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). (INPUT) C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). (INPUT) C NSTA = NUMBER OF STATIONS OR LOCATIONS BEING DEALT WITH. C THIS MAY INCLUDED RANDOMLY SAMPLED POINTS FROM C THE FIRST GUESS. (INPUT) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT C WITH. NOTE THAT THIS DOES NOT NECESSARILY C INCLUDE THE NUMBER OF STATIONS IN A C DIRECTORY. (INPUT) C P(I,J) = THE COMPUTED FORECASTS. (I=1,NX) (J=1,NY). C (INTERNAL) C FD2(J), FD3(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. (INTERNAL) C ND2X3 = THE DIMENSION OF SEVERAL ARRAYS = C MAX(ND1,ND2*ND3) IN DRIVER. (INPUT) C ID(J,N) = THE INTEGER PREDICTOR ID'S (J=1,4) (N=1,ND4). C (INPUT) 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). (INPUT) 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). (INPUT) C JD(J,N) = THE BASIC INTEGER PREDICTOR ID'S (J=1,4) C (N=1,ND4). (INPUT) 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. (INPUT) 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 ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING C THE DATA (N=1,ND4). (INPUT) C THRESH(N) = THE BINARY THRESHOLD ASSOCIATED WITH C IDPARS( ,N), N=1,ND4). (INPUT) C ANLTAB(N) = THE CONTROL FILE NAME FOR THE VARIABLE DEFINED IN C ID( ), N=1,ND4). (CHARACTER*17) (INPUT) C INLTAB(N) = UNIT NUMBER FOR CONTROL FILE ANLTAB( ). C IWRITS(N) = CONTROLS WRITING TO INTERNAL STORAGE (N=1,ND4). C 1 = WRITE GRID (FORECAST), C 0 = OTHERWISE. (INPUT) C IWRITA(N) = INDICATES WHETHER OR NOT ASCII DATA ARE TO BE C WRITTEN TO FILE VOTNAM ON UNIT NO. KFILVO C (N=1,ND4). C 0 = DO NOT WRITE; C 1 = WRITE. C (INPUT) C IWRITF(N) = 1 WHEN FINAL POSTPROCESSED ANALYSIS FOR VARIABLE N C IS TO BE WRITTEN TO INTERNAL STORAGE; 0 OTHERWISE C (N=1,ND4). THE POSTPROCESSED VARIABLE IS C DISTINGUISHED FROM THE NON-POSTPROCESSED C INTERNALLY WITH A "1" IN THE "G" LOCATION OF THE ID. C 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). (INPUT) C NGRIDC(L,M) = HOLDS THE GRID 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 CORRECT, C L=4--GRID ORIENTATION IN DEGREES, AND C L=5--LATITUDE OF LL CORNER IN DEGREES, C L=6--LONGITUDE OF LL CORNER IN DEGREES C (INPUT) C ND11 = MAXIMUM NUMBER OF GRID COMBINATIONS THAT CAN BE C DEALT WITH ON THIS RUN. LAST DIMENSION OF C NGRIDC( , ). (INPUT) 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. (INPUT) 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) (INPUT) C ND4 = DIMENSION OF SEVERAL VARIABLES. (INPUT) C PLAINT = ARRAY FOR THE PLAIN LANGUAGE DESCRIPTION TO C FURNISH TO CAKSNO AND CCONSN. EQUIVALENCED C TO IPLANT. (INTERNAL) C PLANT(L,J) = 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN C LANGUAGE DESCRIPTION USED IN CAKSNO CCONSN. C EQUIVALENCED TO PLAINT. (INTERNAL) C NPRED = THE NUMBER OF VARIABLES IN ID( , ), ETC. (INPUT) C N = INDEX INTO ID( , ) AND OTHER VARIABLES C INDICATING THE VARIABLE BEING DEALT WITH. C (INPUT) C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN C INTEGER VARIABLE (L=1,L3264W) (K=1,NSTA). C EQUIVALENCED TO CCALLD( ) IN DRU755. (INTERNAL) C CCALLD(K) = 8 STATION CALL LETTERS (K=1,NSTA). EQUIVALENCED C TO ICALLD( , ) IN DRU755. (CHARACTER*8) C (INTERNAL) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C DATA(J) = WORK ARRAY FOR OBSERVED DATA (J=1,ND5). C (INTERNAL) C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ). C (INPUT) C MODNO = DD FOR WRITING GRIDS. (INPUT) C IOPER = 1 FOR OPERATIONS; 0 FOR DEVELOPMENT. CONTROLS C HOW EQUATIONS HEADER IS READ AND USED. (INPUT) C NDATE = THE DATE/TIME OF THE RUN. (INPUT) C ND = THE NUMBER OF THE DATE BEING PROCESSED. C (INPUT) C JDATE(J) = NDATE PARSED INTO ITS 4 COMPONENTS: C J=1 IS YYYY C J=2 IS MM C J=3 IS DD C J=4 IS HH C (INPUT) C MODNUM(J) = THE "MODEL" NUMBER CORRESPONDING TO KFILIN(J), C AND NAMIN(J) (J=1,ND6). (INPUT) C ND6 = MAXIMUM NUMBER OF INPUT FILES THAT CAN C BE DEALT WITH IN ONE RUN. DIMENSION OF C MODNUM( ). (INPUT) C NAREA = THE AREA OVER WHICH THE FORECAST IS MADE: C 1 = CONUS, C 2 = ALASKA, C 3 = HAWAII, C 4 = PUERTO. C ALATL = NORTH LATITUDE OF LOWER LEFT CORNER POINT C OF A GRID OF THE SIZE NX, NY. TRUNCATED C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF C DEGREES. (INPUT) C ALONL = WEST LONGITUDE OF LOWER LEFT CORNER POINT C OF A GRID OF THE SIZE NX, NY. TRUNCATED C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF C DEGREES. (INPUT) C NPROJ = NUMBER OF MAP PROJECTION TO WHICH THIS GRID C APPLIES. C 3 = LAMBERT. C 5 = POLAR STEREOGRAPHIC. C 7 = MERCATOR. C (INPUT) C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. (INPUT) C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED C IN DEGREES. (INPUT) C NX = THE SIZE OF THE PRIMARY GRID FOR THIS RUN C IN THE X DIRECTION IN MESH UNITS. (INPUT) C NY = THE SIZE OF THE PRIMARY GRID FOR THIS RUN C IN THE Y DIRECTION IN MESH UNITS. (INPUT) 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. (INPUT) C BMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESH. C (INPUT) C NTELEV = 1 WHEN THE TERRAIN IS IN TELEV( ); C 0 OTHERWISE. C (INPUT) C TELEV(J) = THE TERRAIN ELEVATION FROM THE MOS-2000 EXTERNAL C RANDOM ACCESS FILE (J=1,NX*NY). PRESENT C ONLY WHEN NTELEV = 1. (INPUT) C SEALND(J) = THE LAND/SEA MASK (J=1,NX*NY). C 0 = OCEAN WATER GRIDPOINTS; C 3 = INLAND WATER GRIDPOINTS. C 9 = LAND GRIDPOINTS. C (INPUT) C NCLIPY = 1 WHEN THE NDGD MASK GRID IS AVAILABLE AND C IN CPNDFD( ). C 0 OTHERWISE. C (INPUT) C CPNDFD(J) = THE NDFD MASK FROM THE MOS-2000 EXTERNAL C RANDOM ACCESS FILE (J=1,NX*NY) AT NOMINAL C MESHLENGTH MESHE. A "1" MEANS WITHIN THE AREA; C A "0" MEANS CLIP IT OUT. THE GRID IS PRESENT C ONLY WHEN NCLIPY = 1. (INPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). C (INTERNAL) C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C (INTERNAL) C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C (INTERNAL) C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND C IS4( ). (INPUT) C 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 C INDICATES WHETHER OR NOT A BINARY MUST BE MADE. C (INPUT) C MPLAIN(I) = DEFINITION OF THE VARIABLES IN MTABLE(I,J), C (I=1,ND16). (CHARACTER*32) (INPUT) C IDCNT = NUMBER OF ENTRIES IN MTABLE( , ) AND MPLAIN( ). C (INPUT) C ND16 = MAXIMUM OF IDCNT. DIMENSION OF MPLAIN( ) AND C FIRST DIMENSION OF MTABLE( , ). (INPUT) 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 --NUMBER OF THE SLAB IN DIR( , ,L) AND C IN NGRIDC( ,L) DEFINING THE C CHARACTERISTICS OF THIS GRID. C L=11 --THE NUMBER OF THE FIRST VARIABLE IN THE C 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 LIST FOR WHICH C 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 VARIABLE. C (INPUT) C LITEMS = THE NUMBER OF ITEMS IN LSTORE( , ). (INPUT) C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ). C SECOND DIMENSION OF LSTORE( , ). (INPUT) 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 C IS THE SPACE USED FOR THE MOS-2000 INTERNAL C RANDOM ACCESS SYSTEM. (INPUT) 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. (INPUT) C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK C STORAGE. (INPUT) C NSTORE = NUMBER OF TIMES A RECORD HAS BEEN STORED TO C INTERNAL STORAGE. (INPUT/OUTPUT) C NFETCH = NUMBER OF TIMES A RECORD HAS BEEN FETCHED FROM C INTERNAL STORAGE. (INPUT/OUTPUT) C JTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOG. (INPUT/OUTPUT) C JTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOG. (INPUT/OUTPUT) C MTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOV. (INPUT/OUTPUT) C MTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOV. (INPUT/OUTPUT) C NTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILIO (THE OUTPUT GRIDPOINT FILE). C (INPUT/OUTPUT) C NTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE WITH UNIT C NUMBER KFILIO. (INPUT/OUTPUT) C NTOTGR = THE TOTAL NUMBER OF EXTERNAL RANDOM ACCESS C RECORDS WRITTEN TO KFILRA = 42. (INPUT/OUTPUT) C NTOTVO = THE TOTAL NUMBER OF ASCII RECORDS FOR SCRIPT C 'plot.sh' WRITTEN TO FILE KFILVO. (INPUT/OUTPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT). C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C (INPUT) C MISTOT = TOTAL NUMBER OF TIMES A MISSING INDICATOR C HAS BEEN ENCOUNTERED IN UNPACKING GRIDS WHEN C COMPUTING VARIABLES. (INPUT/OUTPUT) C MINPK = MINIMUM GROUP SIZE WHEN PACKING THE DATA. C (INPUT) C ISTOP(J) = (J=1,2): C 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 (INPUT/OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 777 = FATAL ERROR C SEE CALLED ROUTINES FOR OTHER VALUES. C ANY NON ZERO VALUE WILL CLOSE OUT THIS C DATE/TIME IN U755. (OUTPUT) C STATE = VARIABLE SET TO STATEMENT NUMBER TO INDICATE C WHERE AN ERROR OCCURRED. (CHARACTER*4) C (INTERNAL) C ITABLE(J) = 4-WORD ID OF THE VARIABLE THAT IS BEING C DEALT WITH IN CN755 (J=1,4). (INTERNAL) C IBACKN = NUMBER OF 6-H CYCLES TO LOOK BACK FOR FIRST C GUESS WHEN IGUESS = 2. IBACKN = 1 MEANS C CURRENT (MOST RECENT) CYCLE PLUS THE ONE C 6 HOURS BEFORE). NORMALLY, THIS IS 0 FOR C DEVELOPMENT; MAY BE OTHERWISE FOR OPERATIONS. C IN A SIMILAR MANNER, IBACKN IS USED IN LAPSUA C TO GET FIELDS FOR CALCULATION OF LAPSE RATE. C IBACKN IS ALSO USED TO INDICATE IN AUGMT1 HOW C MANY CYCLES TO GO BACK TO FIND AUGMENTATION C DATA. IT IS POSSIBLE THERE COULD BE A CONFLICT C IN THESE USES, BUT NOT LIKELY. (INTERNAL) C IBACKL = NUMBER OF 6-H CYCLES TO LOOK BACK FOR FIRST C GUESS WHEN IGUESS = 3. IBACKL = 1 MEANS C CURRENT (MOST RECENT) CYCLE PLUS THE ONE C 6 HOURS BEFORE). NORMALLY, THIS IS 0 FOR C DEVELOPMENT; MAY BE OTHERWISE FOR OPERATIONS. C (NOTE THAT THIS DOES NOT PROVIDE FOR A BACKUP C FIRST GUESS FROM LAMP AT 1-H INTERVALS. A FIRST C GUESS (LAMP/MOS FORECASTS AT THE HOUR EXPECTED) C CAN BE USED, BUT JUST NOT A BACKUP.) C IN A SIMILAR MANNER, IBACKL IS USED IN LAPSUA C TO GET FIELDS FOR CALCULATION OF LAPSE RATE. C (INTERNAL) C IQUALC = THE COLUMN IN IQUAL(K, ) WHERE THE C DATA QUALITY FOR THAT STATION K RESIDES. C (INTERNAL) C ISETP = FLAG TO INDICATE WHETHER AFTER THE LAST PASS C A GRIDPOINT WILL BE SET TO THE CLOSEST C STATION (=2), TO A VALUE IN THE DIRECTION C OF THE STATION VALUE BUT NOT CROSS AN INTEGER C BOUNDARY (=1), OR NOT (=0). (THIS COULD BE C PARTICULARIZED TO QUALITY OF DATA.) (INPUT) C MESH = THE NOMINAL MESH LENGTH OF THE GRID BEING DEALT C WITH WHOSE DIMENSIONS ARE NX AND NY, AND C THE STATION LOCATIONS IN XP( ) AND YP( ) ARE C IN REFERENCE TO. (INTERNAL) C JER = 0 UNTIL A MAJOR ERROR OCCURS, THEN IT IS C INCREMENTED BY 1. IT COUNTS THE MAJOR ERRORS C THAT WILL CAUSE EITHER NO GRID, A COMPROMISED C GRID, OR A 9999 (MISSING) GRID TO BE OUTPUT. C THIS INCLLUDES A GRID THAT COJLD NOT BE C CHECKED WITH STATION FORECASTS. C (INTERNAL) C NX = THE X-EXTENT OF THE CURRENT GRID. DEFINED IN C FSTGS5. (INTERNAL) C NY = THE Y-EXTENT OF THE CURRENT GRID. DEFINED IN C FSTGS5. (INTERNAL) C LX = THE NUMBER OF GROUPS WHEN PACKING IN PAWGTS. C (INTERNAL) C IOCTET = THE NUMBER OF OCTETS OR BYTES IN THE PACKED C ARRAY IN PAWGTS. (INTERNAL) C LASTL = THE LAST LOCATION IN CORE( ) USED. RETURNED C FROM GSTORE. (INTERNAL) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK C IN INTERNAL RANDOM ACCESS STORAGE. RETURNED C FROM GSTORE. (INTERNAL) C NTOTGB = TOTAL BYTES WRITTEN TO RANDOM ACCESS FILE. C NTOTGR IS THE NUMBER OF RECORDS AND IS C INITIALIZED AND CARRIED BACK TO U755. NTOTGB C IS NOT WRITTEN IN U755. (INTERNAL) C CPRJ = WILL HOLD ASCII VERSION OF PROJECTION, 3 DITITS. C (CHARACTER*3) C EQNNAM = FILE NAME FOR EQUATIONS IN MELD. (CHARACTER*60) C (INTERNAL) C EQNTYP = TYPE OF EQUATION, 'PROB' OR 'CONT'. C (CHARACTER*4) (INTERNAL) C IREG = NUMBER OF REGIONS FOR REGIONAL EQUATIONS. C 1 = GENERALIZED OPERATOR. (OUTPUT) C C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C IERX, NEWXY1, SIZEGR,TRAIL,MELD7 C CHARACTER*3 CPRJ CHARACTER*4 STATE,EQNTYP CHARACTER*6 PROCES CHARACTER*7 DUMMY CHARACTER*8 CCALL(ND1,6) CHARACTER*8 CCALLD(ND5) CHARACTER*8 DUMCAL(ND1) C DUMCAL( ) IS AN AUTOMATIC ARRAY. CHARACTER*17 ANLTAB(ND4) CHARACTER*20 NAME(ND1) CHARACTER*32 PLAIN(ND4),PLAINT CHARACTER*32 MPLAIN(ND16+1) CHARACTER*40 TITLE/' '/ CHARACTER*60 RACESS(6),EQNNAM(ND4),VOTNAM C DIMENSION XP(ND1),YP(ND1), 1 STALAT(ND1),STALON(ND1), 2 ISDATA(ND1),XYP(ND1,2),SDATA(ND1), 3 IQUAL(ND1,5),LNDSEA(ND1),ELEV(ND1), 5 ICALL(L3264W,ND1,6) DIMENSION P(ND2X3) DIMENSION FD2(ND2X3),FD3(ND2X3),FD4(ND2X3),FD5(ND2X3),FD6(ND2X3) DIMENSION ID(4,ND4),IDPARS(15,ND4),THRESH(ND4),JD(4,ND4), 1 JP(3,ND4),ISCALD(ND4),IWRITS(ND4),IWRITA(ND4), 2 KFILEQ(ND4) DIMENSION IWRITF(ND4),INLTAB(ND4) DIMENSION IPLAIN(L3264W,4,ND4),IPLANT(L3264W,4) DIMENSION IPACK(ND5),DATA(ND5),IWORK(ND5),ICALLD(L3264W,ND5) DIMENSION MODNUM(ND6) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION DIR(ND1,2,ND11),NGRIDC(6,ND11) DIMENSION TELEV(NX*NY),SEALND(NX*NY),CPNDFD(NX*NY) DIMENSION MTABLE(ND16+1,3) DIMENSION LD(4),LDPARS(15),KFILRA(6),ISTOP(2),JDATE(4) DIMENSION ITABLE(4) C DATA IFIRST/0/ DATA ISAVDT/99999999/ DATA NTOTGB/0/ C CALL TIMPR(KFILDO,KFILDO,'START CN755 ') c CCCC WRITE(KFILDO,101)ND1,ND2X3,ND4,ND5,ND6,ND7, CCCC 1 ND9,ND10,ND11, CCCC 101 FORMAT(' IN CN755-ND1,ND2X3,ND4,ND5,ND6,ND7,', CCCC 1 'ND9,ND10,ND11'/20I8) C IER=0 JER=0 C JER IS SET = 1 WHEN A MAJOR ERROR OCCURS BUT THERE IS NOT C A HARD STOP. NSTSAV=NSTA C NSTA MAY BE ALTERED IN CN755, AND IS RESET ON EXIT. NSTSAV C IS NOT CURRENTLY USED. C C UPDATE ISAVDT WHEN THERE IS A NEW NDATE. PURPOSE IS C TO INCREMENT IFIRST ONLY FOR A NEW DATE. C IF(NDATE.NE.ISAVDT)THEN ISAVDT=NDATE IFIRST=IFIRST+1 ENDIF C C READ CONTROL INFORMATION FOR THE VARIABLE TO BE FORECAST. C STATE='120 ' COPS OPEN(UNIT=INLTAB(N),FILE=ANLTAB(N),STATUS='OLD', COPS 1 IOSTAT=IOS,ERR=900) WRITE(KFILDO,110)ANLTAB(N),INLTAB(N) 110 FORMAT(/' OPENING FILE ',A60,' ON UNIT NO.',I4) C C READ THE IDS OF THE ELEMENT TO FORECAST, AND OTHER IDS. C 121 STATE='122 ' C READ(INLTAB(N),122,IOSTAT=IOS,ERR=900)(ITABLE(J),J=1,4), 1 KFILEQ(N),EQNNAM(N) C EQNNAM IS WHERE EQUATION FILE IS TO BE FOUND. 122 FORMAT(4I10/,I4,2X,A60) C c CHECK CCCFFFB OF 1ST ID WORD THE FORECAST VARIABLE READ C WITH INCOMING ID( ). C IF(ID(1,N).NE.ITABLE(1))THEN WRITE(KFILDO,132)(ITABLE(J),J=1,4), 1 (ID(J,N),J=1,4),ANLTAB(N) 132 FORMAT(/,' ****IDS OF FORECAST VARIABLE READ IN CN755.CN', 1 ' DO NOT MATCH FORECAST DESIRED FROM U755.CN',/, 2 ' IDS READ HERE ARE ',I10.9,3I11,/, 3 ' IDS FROM U755.CN ARE ',I10.9,3I11,/, 4 ' CHECK U755.CN WITH ANLTAB = ',A17, 5 ' FATAL ERROR AT 132.') CALL W3TAGE('CN755') STOP 132 ENDIF C STATE='134 ' C READ(INLTAB(N),135,IOSTAT=IOS,ERR=900)DUMMY,PROCES,IREG 135 FORMAT(A7,2X,A6,I4) WRITE(KFILDO,136)DUMMY,PROCES,IREG 136 FORMAT(1X,A7,2X,A6,I4) C WRITE(KFILDO,290)IWRITA(N),KFILVO 290 FORMAT(/' IN CN755--IWRITA(N),KFILVO',3I6) C IF(PROCES.EQ.'MELD70')THEN CALL MELD70(KFILDO,KFILIO,KFILRA,RACESS,NUMRA,KFIL10, 1 KFILOG,KFILOV,INLTAB(N),KFILEQ(N),EQNNAM(N), 2 KFILVO,VOTNAM,IP12,IP16,IP17,IP18,IP19, 3 ID(1,N),IDPARS(1,N),JD(1,N),JP(1,N),ISCALD(N), 4 IWRITA(N),MODNO,IOPER,IREG, 5 NDATE,JDATE,CCALL,ICALLD,CCALLD,NAME,XP,YP, 6 STALAT,STALON,ISDATA,SDATA,NSTA,ND1, 7 DIR,NGRIDC,NGRID,ND11,ND13,ND14,ND15, 8 P,FD2,FD3,FD4,FD5,ND2X3,NX,NY, 9 IPACK,DATA,IWORK,ND5,MINPK, D NTELEV,TELEV,SEALND,NCLIPY,CPNDFD, B MTABLE,MPLAIN,IDCNT,ND16, C LSTORE,ND9,LITEMS,CORE,ND10,LASTL, D NBLOCK,LASTD,NSTORE,NFETCH, E IS0,IS1,IS2,IS4,ND7, F IPLAIN(1,1,N),PLAIN(N), G NAREA,ALATL,ALONL,NPROJ,ORIENT, K MESH,BMESH,XLAT, I NTOTBY,NTOTRC,NTOTGB,NTOTGR,JTOTBY,JTOTRC, J MTOTBY,MTOTRC,NTOTVO, K L3264B,L3264W,MISTOT,ISTOP,JER,IER) C ELSE WRITE(KFILDO,139)PROCES 139 FORMAT(/' ****PROCES = ',A6,' NOT A PROCESS TO EXECUTE ', 1 'IN CN755. FATAL ERROR.') CALL W3TAGE('CN755') STOP 139 ENDIF C C PUT OTHER POSTPROCESSORS HERE. 500 IF(JER.EQ.0)THEN WRITE(KFILDO,502)(JDATE(JJ),JJ=1,4),PLAIN(N) 502 FORMAT(/' CN755 HAS SUCCESSFULLY COMPLETED FOR DATE/TIME ', 1 I5,3I3.2,'00, VARIABLE ',A32, 2 ' OUTPUT SHOULD BE CORRECT.') ELSE WRITE(KFILDO,503)JER,(JDATE(JJ),JJ=1,4),PLAIN(N) 503 FORMAT(/' CN755 HAS COMPLETED WITH',I3,' MAJOR ERRORS FOR', 1 ' DATE/TIME ',I5,3I3.2,'00, VARIABLE ',A32,/, 2 74X,'EITHER NO GRID, A 9999 GRID, OR A COMPROMISED', 3 ' GRID WAS WRITTEN.') ENDIF C C CLOSE RANDOM ACCESS FILE NO. 42. EVEN THOUGH C A CLOSE IS ALSO IN U755, IT IS DONE HERE SO THAT ANY C RECORDS WRITTEN IN CN755 FOR ONE VARIABLE WILL BE C AVAILABLE EVEN IF U755 DID NOT COMPLETE. C***********THIS SHOULD HAVE OPENED IF NEEDED AGAIN, BUT C***********BUT EVIDENTLY DIDN'T. C DO 710 J=1,6 IF(KFILRA(J).EQ.42)THEN CALL CLFILM(KFILDO,KFILRA(J),IER) ENDIF 710 CONTINUE C CALL TIMPR(KFILDO,KFILDO,'END CN755 ') C IER UPON RETURN DOES NOT AFFECT CALLING U755. U755 C WILL PROCEED. IER=JER C THE TOTAL OF MAJOR AND MINOR ERRORS ARE RETURNED FOR C SUMMATION AND PRINTING IN U755. CLOSE(UNIT=INLTAB(N)) C RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 900 CALL IERX(KFILDO,KFILDO,IOS,'CN755 ',STATE) CALL W3TAGE('CN755') STOP 900 END