SUBROUTINE PRED24(KFILDO,KFIL10,KFILIO,KFILGO,KFILIN,NAMIN, 1 JFOPEN,NFIRST,ID,IDPARS,THRESH,JD,INDEX,JP, 2 IFIND,ISTAV,ITIME,ISCALD, 3 SMULT,SADD,ORIGIN,CINT,IPLAIN,PLAIN,UNITS, 4 NPRED,MODNUM,ND6,NUMIN,LDATB,LDATE, 5 LKHERE,MSDATE,NDATE,KFILRA,RACESS,NUMRA, 6 ICALL,CCALL,ICALLD,CCALLD,NAME,NSTA,NGRID,DIR, 7 NGRIDC,ISDATA,SDATA,SDATA1,L1DATA, 8 NELEV,STALAT,STALON,ITIMEZ,INDEXC,ND1,ND11, 9 IPACK,IWORK,DATA,ND5,MINPK, A LSTORE,MSTORE,ND9,LITEMS,MITEMS,CORE,ND10,LASTL, B NBLOCK,LASTD,NSTORE,NFETCH, C IS0,IS1,IS2,IS4,ND7, D FD1,FD2,FD3,FD4,FD5,FD6,FD7, E FDA,FDVERT,FDTIME,FDSINS,FDMS,ND2X3, F IP12,IP13,IP14,IP15,IP16,IP23, G NTOTBY,NTOTRC,NTOTBG,NTOTRG, H PXMISS,L3264B,L3264W,MISTOT,ISTOP,IER) C C DECEMBER 2000 GLAHN MOS/LAMP-2000 C FEBRUARY 2001 GLAHN MODIFIED TO NOT DO GRIDPOINT C CALCULATIONS WHEN FULL ID IS FOUND; C ADDED IFDATE( ); SUBSTITUTED TEST ON C IFDATE(N) FOR TEST ON INDEX(N) IN C DO 116 LOOP; CHANGED LT TO LE IN C LOOP DO 1015 AND EXECUTED LOOP C ONLY WHEN NODATA LT 3 C NOVEMBER 2002 GLAHN CHANGED ISDATA( ) TO FD1( ) AND ND1 C TO ND2X3 IN CALL TO PACKG C DECEMBER 2002 COSGROVE MODIFIED FORMAT STATEMENTS TO COMPILE C ON THE IBM C FEBRUARY 2003 GLAHN ADDED NAME AND NGRID TO CALL TO OPTION C SEPTEMBER 2003 GLAHN REPLACED KSTART=KEND+1 WITH C KSTART=MAX(KSTART+1,MITEMS) BELOW C 116 AND 1165; CHANGED HOW NSIZE C IS DEFINED OUT OF OPTION; COMMENTS; C OMITTED TEST ON IFIND( ) AT BEGINNING C OF DO 700 LOOP C OCTOBER 2012 ENGLE MODIFIED CALLS TO PACKG TO INCLUDE C PLAIN. C SEPTEMBER 2015 CHARBA INSERTED GRID BINARY AND SMOOTHING C EXCEPTIONS FOR RCM-BASED, CG-LTG- C BASED, MRMS-BASED, AND TL-BASED LAMP C CONVEC AND LTG PROB PREDICTORS, WHERE- C BY THESE POST-PROCESSING OPERATIONS C ACOMMODATE MISSING VALUES IN THE ASSO- C CIATED GRIDS. THE SAME EXCEPTIONS C APPEAR IN U201/PRED22. C C PURPOSE C TO OBTAIN FOR U202 ALL VARIABLES IDENTIFIED IN ID( , ), C IDPARS( , ), AND THRESH( ). "BASIC" VARIABLES (THE C VARIABLES SANS "PROCESSING" INFORMATION) ARE IN JD( , ), C RESPECTIVELY. A RECORD IS READ AND PROCESSED INTO C VARIABLES IF POSSIBLE. ALSO, IF IT WILL BE NEEDED C LATER (THROUGH OPTION), IT IS STORED WITH ITS KEYS C IN LSTORE( , ). THE PROCESSED VARIABLES ARE C WRITTEN TO THE OUTPUT FILE. PRED24 IS ENTERED ONCE FOR C EACH DATE/TIME AFTER THE FIRST. GRIDPOINT C AND VECTOR DATA MUST BE HANDLED SOMEWHAT DIFFERENTLY. C FOR GRIDPOINT DATA, THE BASIC ID IN JD( ) IS USED C AND ALL PROCESSING OPERATORS (B, T, I, S) APPLY. C FOR VECTOR DATA, IT IS EXPECTED THAT THE PROCESSING C WILL BE DONE IN OPTION. C C PRED24 FOR U202 WAS ADAPTED FROM PRED22 FOR U201. IT'S C PRIMARY PURPOSE IS TO COPY SELECTED GRIDPOINT DATA FROM A C TDLPACK FILE TO ANOTHER, BUT WILL ALSO COPY VECTOR DATA FROM C A VECTOR FILE TO ANOTHER. THE COMPUTATIONAL ASPECTS OF U201 C ARE RETAINED, EXCEPT INTERPOLATION INTO THE GRIDPOINT DATA C IS NOT DONE; RATHER THE GRIDPOINT DATA ARE PACKED AND C WRITTEN AS GRIDPOINT DATA. THEREFORE, TWO OUTPUT FILES C ARE USED, ONE FOR VECTOR DATA, KFILIO AS IN U201, AND C ONE FOR GRIDPOINT DATA, KFILGO. C C BECAUSE THE COMPUTATIONAL CAPABILITIES ON GRIDS ARE C RETAINED, THE GRIDPOINT DATA ARE UNPACKED AS READ, AND C THEREFORE HAVE TO BE REPACKED, EVEN IF UNMODIFIED. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 - UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS. C (INPUT-OUTPUT) C KFILIO - UNIT NUMBER OF INTERPOLATED OUTPUT FILE. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFIL10 = UNIT NUMBER OF TDL MOS-2000 FILE SYSTEM ACCESS. C (INPUT) C KFILIO = UNIT NUMBER OF INTERPOLATED OUTPUT FILE. (INPUT) C KFILIN(J) = UNIT NUMBERS FOR INPUT DATA, ALL IN TDLPACK FORMAT. C INPUT CAN INCLUDE GRIDPOINT (FILES) DATA, PREDICTAND C (OBSERVATIONS) DATA, VARIOUS CONSTANTS, OR MOS FORECASTS C (FOR 2ND GENERATION MOS, POSSIBLY FOR LOCAL IMPLEMENTATION C (J=1,NUMIN). (INPUT) C NAMIN(J) = NAME OF THE INPUT FILES BEING PROCESSED (J=1,NUMIN). C (CHARACTER*60) (INPUT) 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). (INPUT/OUTPUT) C NFIRST = 1 FOR FIRST DAY, 2 FOR SECOND, 3 OTHERWISE. C FOR PRED24, NFIRST WILL NEVER BE 1. (INPUT) C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NPRED). C (INPUT) C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE C ID CORRESPONDING TO ID( ) (J=1,15) (N=1,NPRED). C (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 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK 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 IDPARS( ,N) C (N=1,NPRED). (INPUT) C JD(J,N) = THE BASIC INTEGER VARIABLE ID (J=1,4) (N=1,NPRED). C THIS IS THE SAME AS ID(J,N), EXCEPT THAT THE PORTIONS C 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 FIELDS C AS READ FROM THE ARCHIVE. (INPUT) C INDEX(N) = USED TO KEEP TRACK OF WHICH VARIABLES HAVE C BEEN DEALT WITH FOR A PARTICULAR DATE. THIS ALLOWS C A DIAGNOSTIC IF A BASIC VARIABLE IS DEALT WITH MORE C THAN ONCE. (INTERNAL-OUTPUT) C JP(J,N) = JP( ,N) INDICATES WHETHER (>0) OR NOT (=0) VARIABLE N C WILL BE OUTPUT FOR VIEWING (N=1,NPRED). C J=1--GRIDPOINT VALUES, C J=2--GRIDPRINT WITH CONTOURS, AND C J=3--INTERPOLATED VALUES. C THIS ALLOWS INDIVIDUAL VARIABLE CONTROL ON THE PRINT C PARAMETERS IP12, IP13, IP14, AND IP15. (INPUT) C IFIND(N) = 1 = WHEN THE VARIABLE MAY BE FOUND DIRECTLY C FROM GFETCH. THIS INCLUDES CASE WHEN IT HAS C NOT BEEN FOUND, BUT IS NOT IDENTIFIED IN OPTION. C 0 = THE VARIABLE CAN AND MUST BE COMPUTED THRU C OPTION. C (INPUT) C ISTAV(N) = INDICATES FOR EACH VARIABLE (N=1,NPRED) WHETHER C DATA ARE CURRENTLY VECTOR (=1), GRIDPOINT (=0), C OR UNKNOWN (=2). (INPUT) C ITIME(N) = FOR EACH VARIABLE (N=1,NPRED) INDICATES WHETHER (=1) C OR NOT (=0) THE RR IS TO BE USED BY GFETCH WHEN C FETCHING DATA. (INPUT) C ISCALD(N) = THE DECIMAL SCALING CONSTANT TO USE WHEN PACKING THE C INTERPOLATED DATA (N=1,ND4). THE BINARY SCALING C CONSTANT IS USED AS ZERO. (INPUT) C SMULT(N) = THE MULTIPLICATIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). (INPUT) C SADD(N) = THE ADDITIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). (INPUT) C ORIGIN(N) = THE CONTOUR ORIGIN, APPLIES TO THE UNITS IN IUNITS( ,J) C (N=1,ND4). (INPUT) C CINT(N) = THE CONTOUR INTERVAL, APPLIES TO THE UNITS IN C IUNITS( ,J) (N=1,ND4). (INPUT) C IPLAIN(L,J,N) = 32 CHARACTERS (L=1,L3264W) (J=1,4) OF PLAIN LANGUAGE C 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( ). (INPUT) C PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES C (N=1,ND4). EQUIVALENCED TO IPLAIN( , ). C (CHARACTER*32) (INPUT) C UNITS(N) = THE UNITS OF THE DATA THAT APPLY AFTER MULTIPLYING C BY SMULT(N) AND ADDING SADD(N) (N=1,ND4). C (CHARACTER*12) (INPUT) C NPRED = THE NUMBER OF VARIABLES NEEDED AND IDENTIFIED IN C ID( , ), ETC. ALSO TREATED AS THE DIMENSION OF THE C VARIABLES ID( , ), ETC. THIS NAME IS A HOLDOVER, C AS IS THE NAME OF THE ROUTINE ITSELF, TO WHEN C U202 WAS WRITTEN ONLY FOR PREDICTORS. (INPUT) C MODNUM(J) = THE "MODEL" NUMBER CORRESPONDING TO KFILIN(J) C (J=1,NUMIN). THIS MAY NOT HAVE MEANING FOR C SOME INPUTS, BUT IS NEEDED FOR THE MODEL DATA. C (INPUT) C ND6 = THE MAXIMUM OF NUMIN. DIMENSION OF KFILIN( ), C NAMIN( ), JFOPEN( ), MODNUM( ), LKHERE( ), C LDATB( ), AND LDATE( ) AND THE SECOND DIMENSION C OF INDEXC( , ). (INPUT) C NUMIN = THE NUMBER OF VALUES IN KFILIN( ), C NAMIN( ), JFOPEN( ),MODNUM( ), LKHERE( ), C LDATB( ), AND LDATE( ). (INPUT) C LDATB(J) = BEGINNING DATE NEEDED FOR THE MODEL CORRESPONDING C TO NAMIN(J), ETC. (J=1,NUMIN). THIS IS NOT OVERALL, C BUT IS VALID FOR THE DAY BEING PROCESSED. C (INTERNAL-OUTPUT) C LDATE(J) = ENDING DATE NEEDED FOR THE MODEL CORRESPONDING C TO NAMIN(J), ETC. (J=1,NUMIN). THIS IS NOT OVERALL, C BUT IS VALID FOR THE DAY BEING PROCESSED. C (INTERNAL-OUTPUT) 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. (INTERNAL) C NDATE = THE DATE/TIME FOR WHICH VARIABLES ARE TO BE C FURNISHED ON THIS CALL TO PRED24. (INPUT) C KFILRA(J) = HOLDS THE UNIT NUMBERS FOR ACCESSING THE MOS-2000 C EXTERNAL RANDOM ACCESS FILES (J=1,ND12). (INPUT) C RACESS(J) = THE FILE NAMES CORRESPONDING TO KFILRA(J) (J=1,NUMRA). C (CHARACTER*60) (INPUT) C NUMRA = THE NUMBER OF UNIT NUMBERS AND NAMES IN KFILRA( ) C AND RACESS( ). (INPUT) C ICALL(L,K,J) = 8 STATION CALL LETTERS AS CHARACTERS IN AN INTEGER C VARIABLE (L=1,L3264W) (K=1,NSTA) (J=1,6). C EQUIVALENCED TO CCALL( , ) (INPUT/OUTPUT) 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 (CHARACTER*8) (INPUT/OUTPUT) C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN INTEGER C VARIABLE (L=1,L3264W) (K=1,ND5). C EQUIVALENCED TO CCALLD( ). (INTERNAL) C CCALLD(K) = 8 STATION CALL LETTERS (K=1,ND5). THIS LIST IS USED C IN L1D1 TO READ THE REGION LISTS. EQUIVALENCED C TO ICALLD( , ). (CHARACTER*8) (INTERNAL) C NAME(K) = NAMES OF STATIONS (K=1,NSTA). USED FOR PRINTOUT C ONLY. (CHARACTER*20) (INPUT) C NSTA = THE NUMBER OF STATIONS IN ICALL( , , ) AND CCALL( , ). C (INPUT) C NGRID = THE NUMBER OF GRID COMBINATIONS IN DIR( , , ), C MAXIMUM OF ND11. (INPUT) 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 NGRIDC( ,M). C (INPUT) C NGRIDC(L,M) = HOLDS THE GRID CHARACTERISTICS (L=1,6) FOR EACH GRID C COMBINATION (M=1,NGRID). THIS CAN BE UPDATED IF A C NEW GRID IS ENCOUNTERED. (INPUT-OUTPUT) C L=1--MAP PROJECTION NUMBER (3=LAMBERT, 5=POLAR C STEREOGRAPHIC). C L=2--GRID LENGTH IN MILLIMETERS, C L=3--LATITUDE AT WHICH GRID LENGTH IS CORRECT *10000, C L=4--GRID ORIENTATION IN DEGREES *10000, C L=5--LATITUDE OF LL CORNER IN DEGREES *10000, C L=6--LONGITUDE OF LL CORNER IN DEGREES *10000. C ISDATA(K) = USED IN PACK1D VIA PACKV (K=1,NSTA). (INTERNAL) C SDATA(K) = INTERPOLATED DATA FOR WRITING (K=1,NSTA). C (INTERNAL) C SDATA1(K) = WORK ARRAY RESERVED FOR USE IN L2D2 (K=1,NSTA). C (INTERNAL) C L1DATA(K) = THE ARRAY RESERVED FOR USE BY LINEARIZATION C ROUTINES (K=1,NSTA). (INTERNAL) C NELEV(K) = ELEVATION OF STATIONS (K=1,NSTA). (INPUT) C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). (INPUT) C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). (INPUT) C ITIMEZ(K) = TIME ZONE INDICATOR. THE NUMBER OF HOURS C THE STATION IS DIFFERENT FROM UTC (K=1,NSTA). C (INPUT) C INDEXC(K,J) = LOCATIONS OF THE STATIONS CORRESPONDING TO C CCALL(K, ) (K=1,NSTA) FOR EACH MODEL J (J=1,NUMIN). C FOR GRIDPOINT DATA, INDEXC( , ) WILL BE EMPTY C FOR THAT MODEL J. IF A STATION'S LOCATION IS C UNKNOWN, INDEXC( , ) = 99999999. (OUTPUT) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT WITH. C (INPUT) C ND11 = MAXIMUM NUMBER OF GRID COMBINATIONS THAT CAN BE C DEALT WITH ON THIS RUN. LAST DIMENSION OF C NGRIDC( , ) AND DIR( , , ). (INPUT) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C DATA(J) = PRIMARY ARRAY FOR HOLDING GRIDPOINT DATA FOR C PROCESSING (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ). C SHOULD BE GE ND2X3 IN CALLING PROGRAM. (INPUT) C MINPK = MINIMUM GROUP SIZE WHEN PACKING THE INTERPOLATED C VALUES. (INPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,11) (J=1,LITEMS). (INPUT-OUTPUT) 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 CHARACTERISTICS C OF THIS GRID. C L=11 --THE NUMBER OF THE FIRST VARIABLE IN THE SORTED C LIST IN ID( ,N) (N=1,NPRED) FOR WHICH THIS C VARIABLE IS NEEDED, WHEN IT DOES NOT NEED C TO BE STORED AFTER DAY 1. WHEN THE VARIABLE C MUST BE STORED (TO BE ACCESSED THROUGH OPTION) C FOR ALL DAYS, ID(11,N) IS 7777 + THE NUMBER C OF THE FIRST VARIABLE IN THE SORTED LIST C FOR WHICH THIS VARIABLE IS NEEDED. C L=12 --USED INITIALLY IN ESTABLISHING MSTORE( , ). C LATER USED AS A WAY OF DETERMINING WHETHER C TO KEEP THIS VARIABLE. C MSTORE(L,J) = THE ARRAY HOLDING THE VARIABLES NEEDED AS INPUT, AFTER C DAY 1, AND ASSOCIATED INFORMATION (L=1,7) (J=1,MITEMS). C (INPUT) C L=1,4--THE 4 ID'S FOR THE DATA. C L=5 --INDICATES WHETHER OR NOT TO STORE THE C VARIABLE AND THE FIRST VARIABLE TO USE IT FOR. C L=6 --THE CYCLE TIME FOR WHICH THIS VARIABLE C IS NEEDED FOR THE DATE BEING PROCESSED. A C VARIABLE NEEDED FOR MORE THAN ONE CYCLE TIME C WILL HAVE AN ENTRY FOR EACH CYCLE TIME NEEDED. C L=7 --THE MAXIMUM TIME OFFSET RR (SEE IDPARS(9, ) C CORRESPONDING TO MSTORE(6, ) C NOTE THAT MSTORE IN U202 AND PRED24 IS NOT EXACTLY C THAT IN U600 AND RDVECT. U202 DOES NOT USE RDVECT. C ND9 = THE SECOND DIMENSION OF LSTORE( , ) AND MSTORE( , ). C (INPUT) C LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , ) THAT C HAVE BEEN USED IN THIS RUN. C MITEMS = THE NUMBER OF ITEMS (COLUMNS) IN MSTORE( , ). C CORE(J) = THE ARRAY TO STORE OR RETRIEVE THE DATA IDENTIFIED IN C LSTORE( , ) (J=1,ND10). WHEN CORE( ) IS FULL C DATA ARE STORED ON DISK. (INPUT-OUTPUT) C ND10 = DIMENSION OF CORE( ). (INPUT) C LASTL = THE LAST LOCATION IN CORE( ) USED. THIS IS THE C MAXIMUM VALUE THAT HAS BEEN USED, EVEN THOUGH C THE SLOT(S) AT THE END HAVE BEEN RELEASED. THIS C IS MODIFIED, ALONG WITH LITEMS, IF COMPACTION IS C DONE OR IF THE ITEM RELEASED IS THE LAST ITEM C IN THE LIST. INITIALIZED TO 0 ON FIRST ENTRY TO C GSTORE. THE USER NEED NOT WORRY ABOUT THIS. (INTERNAL) C NBLOCK = THE BLOCK SIZE IN WORDS OF THE MOS-2000 RANDOM C DISK FILE. (INPUT) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK FOR MOS-2000 C INTERNAL STORAGE. C NSTORE = THE NUMBER OF TIMES GSTORE HAS BEEN ENTERED. GSTORE C KEEPS TRACK OF THIS AND RETURNS THE VALUE. (OUTPUT) C NFETCH = THE NUMBER OF TIMES GFETCH HAS BEEN ENTERED. GFETCH C KEEPS TRACK OF THIS AND RETURNS THE VALUE. (OUTPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,3). (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,22+). (INTERNAL) C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). (INTERNAL) C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). (INTERNAL) C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C NOT ALL LOCATIONS ARE USED. (INPUT) C FD1(J),FD2(J), ETC = WORK ARRAYS (J=1,ND2X3). THESE MAY BE USED IN C ROUTINES AS 2-DIMENSIONAL ARRAYS, WHERE THE C TOTAL ARRAY SIZE IS ND2*ND3=ND2X3 AS DECLARED IN C THE CALLING PROGRAM. (INTERNAL) C FDA(J) = USED TO RETAIN A VARIABLE WITHIN PRED24 SO THAT IT C WON'T HAVE TO BE ACCESSED AGAIN WITH GFETCH. THIS C IS MAINLY SO THAT THE NUMBER OF GRIDS STORED WILL C FIT WITHIN CORE. IT ALSO ELIMINATES MULTIPLE C UNPACKING OF THE DATA. (INTERNAL) C FDVERT(J) = TEMPORARY STORAGE RESERVED FOR SUBROUTINE VERTP C (J=1,ND2X3). C FDTIME(J) = TEMPORARY STORAGE RESERVED FOR SUBROUTINE TEMEP C (J=1,ND2X3). C FDSINS(IX,JY) = USED TO SAVE THE SIN OF THE LATITUDE IN SUBROUTINE C PSMAPF (IX=1,NX) (JY=1,NY). THE USER MUST NOT C USE THIS ARRAY EXCEPT IN CALLING PSMAPF. C (INPUT/OUTPUT) C FDMS(IX,JY) = USED TO SAVE THE MAP FACTOR IN SUBROUTINE C PSMAPF (IX=1,NX) (JY=1,NY). THE USER MUST NOT C USE THIS ARRAY EXCEPT IN CALLING PSMAPF. C (INPUT/OUTPUT) C ND2X3 = DIMENSION OF FD1( ), FD2( ), ETC. MUST BE C AT LEAST AS LARGE AS THE LARGEST GRID AND AS C LARGE AS NSTA. (INPUT) C IP12 = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF C STATIONS AND THEIR I,J POSITIONS ON THE C GRID WILL BE PRINTED TO THE TO THE FILE WHOSE UNIT C NUMBER IS IP12. ALSO USED IN THE SAME MANNER C TO PRINT STATIONS IN THE DIRECTORY RECORD C OF VECTOR INPUT FILES. (INPUT) C IP13 = INDICATES WHETHER (>1) OR NOT (=0) GRIDPOINT FIELDS C WILL BE WRITTEN TO UNIT IP13 FOR VIEWING. (INPUT) C IP14 = INDICATES WHETHER (>1) OR NOT (=0) GRIDPOINT FIELDS C WILL BE CONTOURED AND WRITTEN TO UNIT IP14 FOR C VIEWING. (INPUT) C IP15 = INDICATES WHETHER (>1) OR NOT (=0) INTERPOLATED C VALUES WILL BE WRITTEN TO UNIT IP15 FOR VIEWING. C (INPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) DIAGNOSTICS C WILL BE WRITTEN TO UNIT IP16 FOR LINEARIZATION C AND CONSTANT ROUTINES (E.G., STATIONS IN C THRESHOLD LISTS THAT ARE NOT BEING DEALT WITH C IN THIS RUN). (INPUT) C IP23 = INDICATES WHETHER (>0) OR NOT (=0) STATEMENTS C ABOUT EOF AND FILE OPENINGS AND CLOSINGS, C AND NO DATA ON A PARTICULAR FILE WILL C BE OUTPUT FOR PRINTING ON UNIT IP23. (INPUT) C NTOTBY = THE TOTAL NUMBER OF WORDS IN THE OUTPUT FILE. C IT IS UPDATED WHEN THE DATA IN IPACK( ) ARE WRITTEN. C (INPUT-OUTPUT) C NTOTRC = THE TOTAL NUMBER OF RECORDS IN THE OUTPUT FILE. C IT IS UPDATED AS NEEDED IN WRITEP. (INPUT-OUTPUT) 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 OR TREATING IT AS C ZERO, OR EVEN SOME OTHER VALUE SUCH AS 9999. C (INPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING USED C (EITHER 32 OR 64). (INPUT) C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). (INPUT) C MISTOT = TOTAL NUMBER OF TIMES A PRIMARY MISSING INDICATOR C HAS BEEN ENCOUNTERED IN UNPACKING GRIDS. NOTE C THAT THIS IS LIMITED TO GRIDS AND DOES NOT C INCLUDE VECTORS. (INPUT-OUTPUT) C ISTOP(J) = FOR J=1, ISTOP( ) IS INCREMENTED BY 1 EACH TIME C AN ERROR OCCURS THAT MAY BE FATAL. C FOR J=2, ISTOP( ) IS INCREMENTED BY 1 WHENEVER AN C INPUT DATA RECORD IS NOT FOUND. (INPUT-OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 31 = TROUBLE OPENING OR SWITCHING FILE. C 38 = ND5 TO SMALL. C 127 = NO MORE DATA AVAILABLE. C 138 = 500 ERRORS HAVE OCCURRED. C SEE ROUTINE GSTORE, GFETCH, AND GRCOMB FOR FOR C OTHER VALUES. (INTERNAL-OUTPUT) C LSIZE = NUMBER OF WORDS IN IPACK( ). THIS IS THE SIZE OF C THE PACKED RECORD READ. (INTERNAL) C NSIZE = THE NUMBER OF WORDS RETURNED FROM GFETCH. THIS C IS THE GRID SIZE FOR GRIDDED DATA OR THE NUMBER C OF STATIONS FOR VECTOR DATA. (INTERNAL) C NSTORE = RUNNING COUNT OF NUMBER OF TIMES DATA ARE STORED BY C GSTORE. INITIALIZED TO ZERO THE FIRST TIME GSTORE C IS CALLED. THE USER NEED NOT WORRY ABOUT THIS; THE C COUNT IS KEPT WITHIN GSTORE. (INTERNAL) C NSLAB = THE NUMBER OF THE SLAB IN DIR( , , ) AND C IN NGRIDC( , ) DEFINING THE CHARACTERISTICS C OF THIS GRID. SEE LSTORE(10, ). (INTERNAL) C NYR = YEAR, 4 DIGITS. (INTERNAL) C NMO = MONTH. (INTERNAL) C NDA = DAY OF MONTH. (INTERNAL) C NHR = HOUR, 2 DIGITS. (INTERNAL) C LD(K) = HOLDS THE 3 ID WORDS OF THE DATA IN FDA( ). C (INTERNAL) C LPARS = HOLDS THE VALUE OF IDPARS(15, ) OF THE DATA IN FDA( ). C INITIALIZED TO 9999 FOR SAFETY. (INTERNAL) C MISSP = PRIMARY MISSING VALUE INDICATOR. RETURNED AS ZERO C FROM GFETCH WHEN DATA ARE NOT PACKED. (INTERNAL) C MISSS = SECONDARY MISSING VALUE INDICATOR. RETURNED AS ZERO C FROM GFETCH WHEN DATA ARE NOT PACKED. (INTERNAL) C XMISSP = PRIMARY MISSING VALUE PROVIDED TO PACKV. C (INTERNAL) C XMISSS = SECONDARY MISSING VALUE PROVIDED TO PACKV. C (INTERNAL) C NBYTES(J) = ARRAY USED TO DEAL WITH DIFFERENT WORD LENGTHS C OF HP AND CRAY WHEN READING DATA (J=1,2). C LSTOPC = AN INTERNAL COUNTER TO KEEP AN INFINITE READING C LOOP FROM OCCURRING. (INTERNAL) C LSTOP = THE VALUE TO COMPARE LSTOPC WITH TO STOP THE C READING. CURRENTLY SET AT 500; THIS ASSUMES C 500 READING ERRORS SHOULD NOT OCCUR IN A SINGLE C RUN. NOTE THAT THIS COUNT IS SEPARATE FROM C ISTOP(1) IN CASE ISTOP(1) HAS TO BE LARGE WHEN C DEALING WITH HOURLY DATA AND MISSING STATIONS. C NGOMIS = SWITCH TO KEEP FROM PROCESSING A MISSING GRID. C 1 = MISSING GRIDPOINT DATA, C 0 = GOOD GRID DATA. C (INTERNAL) C NWORDS = NUMBER OF WORDS IN IPACK( ) RETURNED FROM PACKV. C (INTERNAL) C NODATA = COUNTS THE NUMBER OF TIMES THERE HAS BEEN NO C DATA ON A FILE. A DIAGNOSTIC ON KFILDO IS C PRINTED ONLY WHEN NODATA LE.3. (INTERNAL) C IFDATE(N) = HOLDS THE DATE/TIME OF THE VARIABLE FOUND, C CORRESPONDING TO INDEX(N). IFDATE( ) AND C INDEX( ) TOGETHER ALLOW A MISSING DAY (SUCH C THAT A VARIABLE FOR TWO (OR MORE) DATES HAVE C TO BE SAVED WHILE READING THE DATA) CAN BE C HANDLED CORRECTLY. (AUTOMATIC) (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C GFETCH, OPTION, GRIDB, GRIDBM, SMTH5, SMTH9, SMTH25, C SMT25M, SMTH2X, SMT2XM, SMTH3X, PREDX1, PACKV, UNPACK, C UNPKBG, UPDAT, GRCOMB, GSTORE, TIMPR C CHARACTER*8 CCALL(ND1,6), 1 CCALLD(ND5) CHARACTER*12 UNITS(ND1) CHARACTER*20 NAME(ND1) CHARACTER*32 PLAIN(NPRED) CHARACTER*60 RACESS(NUMRA),NAMIN(ND6) C DIMENSION ICALL(L3264W,ND1,6), 1 NELEV(ND1),STALAT(ND1),STALON(ND1),ITIMEZ(ND1), 2 ISDATA(ND1),SDATA(ND1),SDATA1(ND1),L1DATA(ND1) DIMENSION DIR(ND1,2,ND11),NGRIDC(6,ND11) DIMENSION ID(4,NPRED),IDPARS(15,NPRED),THRESH(NPRED), 1 JD(4,NPRED),INDEX(NPRED),JP(3,NPRED),IFIND(NPRED), 2 ISTAV(NPRED),ITIME(NPRED),ISCALD(NPRED), 3 SMULT(NPRED),SADD(NPRED),ORIGIN(NPRED),CINT(NPRED) DIMENSION IFDATE(NPRED) C IFDATE( ) IS AN AUTOMATIC VARIABLE. DIMENSION IPLAIN(L3264W,4,NPRED) DIMENSION FD1(ND2X3),FD2(ND2X3),FD3(ND2X3),FD4(ND2X3), 1 FD5(ND2X3),FD6(ND2X3),FD7(ND2X3),FDA(ND2X3), 2 FDVERT(ND2X3),FDTIME(ND2X3),FDSINS(ND2X3),FDMS(ND2X3) DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5),ICALLD(L3264W,ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9),MSTORE(7,ND9) DIMENSION CORE(ND10) DIMENSION KFILIN(ND6),MODNUM(ND6),LDATB(ND6),LDATE(ND6), 1 LKHERE(ND6),MSDATE(ND6),JFOPEN(ND6) DIMENSION INDEXC(ND1,ND6) DIMENSION KFILRA(NUMRA) DIMENSION LD(3),NBYTES(2),ISTOP(2) C DATA LPARS/9999/ DATA LSTOP/500/, 1 LSTOPC/0/, 2 NGOMIS/0/ DATA NODATA/0/ C IER=0 LD(1)=0 C ABOVE STATEMENT NECESSARY BECAUSE A FIELD COULD HAVE BEEN C LEFT OVER FROM A PREVIOUS DATE. C C SET UP SOME VALUES FOR LOADING IS1( ). C NYR=NDATE/1000000 NMO=NDATE/10000-NYR*100 NDA=NDATE/100-NYR*10000-NMO*100 NHR=NDATE-NYR*1000000-NMO*10000-NDA*100 C C ZERO THE ARRAY THAT INDICATES VARIABLES HAVE BEEN DEALT WITH. C DO 101 N=1,NPRED INDEX(N)=0 IFDATE(N)=0 101 CONTINUE C C SET UP INITIAL SEARCH LIMITS FOR MSTORE( , ). THE ENTRIES C IN MSTORE( , ) WILL BE IN THE SAME ORDER AS THE DATA ARE C ENCOUNTERED IN THE INPUT FOR DAY 1. THEREFORE, IF THE ORDER C OF THE DATA ON THE INPUT FILES IS CONSTANT, THE NEXT RECORD C TO BE FOUND SHOULD BE THE NEXT ITEM IN MSTORE( , ), SO THE C SEARCH STARTS WITH THE LAST ITEM FOUND. THE WHOLE MSTORE( , ) C HAS TO BE SEARCHED IF THE RECORD READ IS NOT WANTED. C KSTART=1 KEND=MITEMS C IF(NUMIN.EQ.0)GO TO 405 C WHEN THE ABOVE TEST IS MET, INPUT FILES ARE NOT NEEDED. C C DETERMINE DATE RANGE OF DATA FOR EACH MODEL FOR THE DATE IN NDATE. C THIS IS DONE EVEN FOR FILES NOT OPEN IN CASE ONE OR MORE HAS C TO BE OPENED DURING PROCESSING OF DAY 1; FILES ALREADY CLOSED C ARE NOT CONSIDERED. C DO 105 IN=1,NUMIN MSDATE(IN)=0 IF(JFOPEN(IN).EQ.0)GO TO 105 MODELX=MODNUM(IN) INCDTL=9999 INCDTH=0 C INCDTH INITIALIZED TO ZERO SO THAT HIGH END DATE WILL NOT BE C LESS THAN THE CURRENT DATE C DO 103 N=1,NPRED C C TAKE CARE OF GRIDPOINT DATA. THE RR IN THE ID IS OPERATIVE. C IF(MODELX.GT.0)THEN IF(MODELX.EQ.IDPARS(4,N))THEN INCDTL=MIN(INCDTL,-IDPARS(9,N)) INCDTH=MAX(INCDTH,-IDPARS(9,N)) ENDIF C C NOW TAKE CARE OF VECTOR DATA THAT DID NOT ORIGINATE IN C U202 AND WILL NOT HAVE A MODEL NUMBER (E.G. HOURLY DATA). C THE RR IN THE ID IS OPERATIVE. C ELSEIF(IDPARS(4,N).EQ.0)THEN INCDTL=MIN(INCDTL,-IDPARS(9,N)) INCDTH=MAX(INCDTH,-IDPARS(9,N)) C C FINALLY, TAKE CARE OF VECTOR DATA THAT MIGHT HAVE COME C FROM A PREVIOUS RUN OF U202 AND HAVE A MODEL NUMBER C THAT WILL NOT MATCH MODELX. THE RR IN THE ID IS NOT C OPERATIVE. C ELSE INCDTL=MIN(INCDTL,0) INCDTH=MAX(INCDTH,0) ENDIF C 103 CONTINUE C IF(INCDTL.EQ.9999)INCDTL=0 C WHEN NO VARIABLE MODEL NUMBER MATCHES MODEL INPUT, IT WILL C HAVE BEEN NOTED IN RDSTR2 AND A DIAGNOSTIC PRINTED. IT IS C NOT REPEATED HERE. CALL UPDAT(NDATE,INCDTL,LDATB(IN)) CALL UPDAT(NDATE,INCDTH,LDATE(IN)) C ACTUAL DATES ARE NOW IN LDATB(IN) AND LDATE(IN). THESE ARE C THE FIRST AND LAST DATE/TIMES, RESPECTIVELY, NEEDED FOR DAY 1. 105 CONTINUE C D ICOUNT=0 C D DO 108 IN=1,NUMIN D IF(JFOPEN(IN).EQ.0)GO TO 108 C D IF(ICOUNT.EQ.0)THEN D WRITE(KFILDO,106)NDATE D106 FORMAT(/' BEGINNING AND ENDING DATES FOR EACH MODEL FOR DATE', D 1 I11) D ICOUNT=ICOUNT+1 D ENDIF C D WRITE(KFILDO,107)MODNUM(IN),KFILIN(IN),LDATB(IN),LDATE(IN) D107 FORMAT(' MODEL NO.'I3,' ON UNIT NO.'I3,2I12) D108 CONTINUE C D WRITE(KFILDO,109) D109 FORMAT(' ') C C FIND/COMPUTE ALL VARIABLES FOR THE DATE IN NDATE. THIS C IS DONE FILE BY FILE, STORING WHAT IS NECESSARY FOR C FUTURE COMPUTATIONS. C DO 400 IN=1,NUMIN IER=0 IF(LKHERE(IN).EQ.0)GO TO 400 C WHEN LKHERE(IN) = 0, AN END OF FILE HAS BEEN REACHED. IF(JFOPEN(IN).NE.1)GO TO 400 C JFOPEN(IN) MUST BE 1 FOR THE FILE TO BE OPEN. 110 READ(KFILIN(IN),IOSTAT=IOS,ERR=1101,END=1106) 1 (NBYTES(J),J=1,L3264W), 2 (IPACK(J),J=1,MIN(ND5,NBYTES(L3264W)*8/L3264B)) C IPACK( ) CONTAINS THE PACKED RECORD. C THE RECORD CONSISTS OF AN INITIAL 64 BITS CONTAINING THE NUMBER C OF BYTES FOLLOWING. FOR A 32-BIT MACHINE, THIS IS TWO WORDS. C FOR A 32-BIT MACHINE, IPACK(5) HOLDS THE DATE/TIME OF THE RECORD. C AN EOF MAY BE REACHED HERE FOR GRIDPOINT DATA. FOR VECTOR C DATA, NORMALLY THERE WOULD BE A TRAILER BEFORE THE EOF. C GO TO 1104 1101 WRITE(KFILDO,1102)KFILIN(IN),NDATE,IOS,NAMIN(IN) IF(IP23.NE.0.AND.IP23.NE.KFILDO)WRITE(IP23,1102)KFILIN(IN), 1 NDATE,IOS,NAMIN(IN) 1102 FORMAT(/' ****ERROR READING PACKED RECORD ON UNIT NO.',I3, 1 ' PROCESSING DATE',I11,' IN PRED24 AT 1102, IOSTAT =',I5/ 2 ' FILE = ',A60) ISTOP(1)=ISTOP(1)+1 LSTOPC=LSTOPC+1 IF(LSTOPC.LT.LSTOP)GO TO 110 C THIS CHECK IS TO STOP AN INFINITE LOOP THAT MIGHT OCCUR. WRITE(KFILDO,1103)LSTOP IF(IP23.NE.0.AND.IP23.NE.KFILDO)WRITE(IP23,1103)LSTOP 1103 FORMAT(' A TOTAL OF',I6,' READING ERRORS HAVE OCCURRED.', 1 ' RETURN FROM PRED24 AT 1103.') IER=138 GO TO 800 C 1104 IF(L3264B.EQ.32)THEN C FOR A 32-BIT MACHINE, IPACK(5) HOLDS THE DATE/TIME OF THE C RECORD. IDATE=IPACK(5) C ELSE C FOR A 64-BIT MACHINE, THE LEFT HALF OF IPACK(3) HOLDS C THE DATE/TIME OF THE RECORD. LOC=3 IPOS=1 CALL UNPKBG(KFILDO,IPACK,ND5,LOC,IPOS,IDATE,32,L3264B,IER,*396) ENDIF C LSIZE=NBYTES(L3264W)*8/L3264B C IF(LSIZE.GT.ND5)THEN WRITE(KFILDO,1105)ND5,LSIZE,KFILIN(IN),NDATE,NAMIN(IN) 1105 FORMAT(/' ****ERROR IN PRED24 AT 1105.', 1 ' ND5 MUST BE INCREASED FROM',I8,' TO GE',I8/ 2 ' READING ON UNIT NO.',I3,' PROCESSING DATE',I11, 3 ' FILE = ',A60) ISTOP(1)=ISTOP(1)+1 IER=38 GO TO 800 C ENDIF C GO TO 115 C 1106 IF(IP23.NE.0)WRITE(IP23,1107)KFILIN(IN),NDATE,NAMIN(IN) 1107 FORMAT(/' END OF FILE ON UNIT NO.',I3, 1 ' PROCESSING DATE',I11, 2 ' FILE = ',A60) 1108 CALL SWITCH(KFILDO,IN,KFILIN,NAMIN,JFOPEN,LKHERE,MSDATE, 1 NUMIN,ND6,NDATE,IRD,IP23,ISTOP(1),IER) IF(IER.NE.0)GO TO 400 C ISTOP(1) INCREMENTED IN SWITCH ON ERROR. IF(IRD.EQ.0)GO TO 400 C IRD NE 0 FROM SWITCH WHEN KFILIN( ) GE 80. PRESUMABLY, C THIS WILL NOT HAPPEN, BUT TAKES CARE OF THE POSSIBILITY C THAT A TRAILER DOES NOT FOLLOW THE LAST DATA BEFORE C AN EOF. JFOPEN( ) AND LKHERE( ) ARE TAKEN CARE OF IN C SWITCH. C C FALL THROUGH HERE MEANS THE DATA ARE VECTOR, ANOTHER C FILE EXISTS WITH THE SAME UNIT NUMBER, AND THE OPEN C WAS MADE OK. DIRECTORY HAS TO BE READ, ETC. C CALL RDDIR(KFILDO,KFILIN(IN+1),IP12,NAMIN(IN+1),NDATE, 1 CCALL,INDEXC(1,IN+1),ND1,NSTA,CCALLD,ND5,MSTA, 2 L3264B,L3264W,IER) C IF(IER.EQ.0)GO TO 400 IF(IER.NE.146)ISTOP(1)=ISTOP(1)+1 C EVEN IER = 120 FOR ONE OR MORE STATIONS MISSING WILL C BE COUNTED AS AN ERROR. HOWEVER, IER = 146 SIGNIFYING C AN EOF IS NOT UNEXPECTED AND IS NOT COUNTED AS AN ERROR. IF(IER.EQ.140.OR. 1 IER.EQ.145.OR. 2 IER.EQ.146)THEN CLOSE(UNIT=KFILIN(IN+1),IOSTAT=IOS,ERR=1110) C CERTAIN ERRORS ARE TREATED AS IF AN END OF FILE C HAS BEEN REACHED. IF(IP23.NE.0)WRITE(IP23,1109)KFILIN(IN+1), 1 NDATE,NAMIN(IN+1) 1109 FORMAT(' CLOSING FILE ON UNIT NO.',I3, 1 ' PROCESSING DATE',I11,' FILE = ',A60) GO TO 1114 C 1110 WRITE(KFILDO,1111)KFILIN(IN+1),NDATE,IOS,NAMIN(IN+1) IF(IP23.NE.0.AND.IP23.NE.KFILDO) 1 WRITE(IP23,1111)KFILIN(IN+1),NDATE,IOS,NAMIN(IN+1) 1111 FORMAT(/' ****ERROR CLOSING FILE ON UNIT NO.',I3, 1 ' PROCESSING DATE',I11,' IN PRED24 AT 1111,', 2 ' IOSTAT =',I5/ 3 ' FILE = ',A60) ISTOP(1)=ISTOP(1)+1 1114 LKHERE(IN+1)=0 JFOPEN(IN+1)=0 ENDIF C C DROP THROUGH HERE WHEN IER = 0 OR 120. GO TO 400 C 115 IF(IDATE.NE.9999)GO TO 1155 C THE ABOVE TEST IS FOR A TRAILER RECORD ON VECTOR DATA. C IF FOUND, AN ATTEMPT IS MADE TO READ A DIRECTORY RECORD C ON THE SAME FILE. C CALL RDDIR(KFILDO,KFILIN(IN),IP12,NAMIN(IN),NDATE, 1 CCALL,INDEXC(1,IN),ND1,NSTA,CCALLD,ND5,MSTA, 2 L3264B,L3264W,IER) C IF(IER.EQ.0)GO TO 110 C THE ABOVE WOULD OCCUR WHEN A DIRECTORY RECORD FOLLOWS C A TRAILER ON THE SAME FILE. C IF(IER.EQ.146)GO TO 1106 C IER = 146 HERE MEANS AN END OF FILE WAS FOUND AFTER C A TRAILER. THIS IS EXPECTED AND IS NOT COUNTED C AS AN ERROR. SWITCH FILES. C ISTOP(1)=ISTOP(1)+1 C EVEN IER = 120 FOR ONE OR MORE STATIONS MISSING WILL C BE COUNTED AS AN ERROR. IF(IER.EQ.120)GO TO 110 C OTHER VALUES OF IER ARE LIKELY UNRECOVERABLE ERRORS; C SWITCH FILES ANYWAY, BUT DO NOT PRINT AN EOF MESSAGE. GO TO 1108 C 1155 IF(IDATE.LT.LDATB(IN))THEN GO TO 110 C THE ABOVE SPACES UP TO THE DAY WANTED. ELSE IF(IDATE.GT.LDATE(IN))THEN BACKSPACE KFILIN(IN) C THE READ ABOVE HAS GONE BEYOND THE DATE WANTED BY 1 RECORD; C THEREFORE, THE BACKSPACE. (NOTE: TO ELIMINATE BACKSPACE, C THE NUMBER OF VARIABLES NEEDED FROM EACH MODEL WOULD BE C NEEDED. THIS COULD BE GOTTEN FROM THE DAY ONE PROCESSING. C BUT WITH DISK, RATHER THAN TAPE, READING AND MODERN C BUFFERING, IS NOT WORTH THE EFFORT.) D WRITE(KFILDO,1156)KFILIN(IN),NDATE D1156 FORMAT(' BACKSPACING INPUT FILE ON UNIT NO.'I3, D 1 ' PROCESSING DATE'I11,' IN PRED24 AT 1156') GO TO 400 ENDIF C C THIS IS A DATE TO USE FOR THIS MODEL FOR THIS DAY. C DOES IT HAVE THE NEEDED ID'S? NOTE THAT IS1(9-11) = C IPACK(6-8) ON A 32-BIT MACHINE. ON A 64-BIT MACHINE, C THE 3 ID'S HAVE TO BE UNPACKED. STILL HAVE TO CHECK C THE TIME (CYCLE) OR ALL INTERMEDIATE CYCLES ON THE C INPUT WILL BE SAVED WHEN NOT NEEDED. C MSDATE(IN)=1 C MSDATE(IN) = 1 INDICATES SOME DATA WERE AVAILABLE ON THIS FILE C FOR THIS DATE. JCYL=MOD(IDATE,100) IF(L3264B.EQ.32)THEN C 1157 DO 116 M=KSTART,KEND C THE INDEX IN THIS LOOP IS M. LATER, N REFERS TO A PARTICULAR C VARIABLE. C***D WRITE(KFILDO,1158)IDATE,JCYL,MSTORE(6,M), C***D 1 (IPACK(L),L=6,9),(MSTORE(L,M),L=1,4) C***D1158 FORMAT(/' IDATE,JCYL,MSTORE(6,M),IPACK,MSTORE'I12,2I4,4I12/ C***D 1 (' ', C***D 2 4I12)) C IF(IPACK(6).EQ.MSTORE(1,M).AND. 1 IPACK(7).EQ.MSTORE(2,M).AND. 2 IPACK(8).EQ.MSTORE(3,M).AND. 3 IPACK(9).EQ.MSTORE(4,M).AND. 4 JCYL.EQ.MSTORE(6,M))THEN C NOTE THAT THE CYCLE IS CHECKED. C N=MOD(MSTORE(5,M),7777) IF(IFDATE(N).EQ.IDATE)GO TO 116 C WHEN THE ABOVE TEST IS MET, THE VARIABLE HAS ALREADY C BEEN FOUND FOR THE SAME DATE. THIS CAN HAPPEN WHEN C A PREVIOUS RUN OF U202 IS INPUT, AS WELL AS THE C INPUT TO THE PREVIOUS U202 RUN. CALL UPDAT(IDATE,MSTORE(7,M),NEWDAT) C USUALLY THE LOOKBACK FEATURE WON'T BE OPERATIVE C AND MSTORE(7,M) WILL BE ZERO, IN WHICH CASE C UPDAT IS NOT EXPENSIVE. NEWDAT IS USED LATER. C C MSTORE( , ) CAN HOLD THE ID( ) OR JD( ), DEPENDING ON WHICH C ONE WAS FOUND IN PRED25. IF THE VARIABLE READ IS THE C SAME AS ID( ), THEN NO PROCESSING SHOULD BE DONE. IN THAT C CASE, SET IDYES = 1. C IF(IPACK(6).EQ.ID(1,N).AND. 1 IPACK(7).EQ.ID(2,N).AND. 2 IPACK(8).EQ.ID(3,N).AND. 3 IPACK(9).EQ.ID(4,N))THEN IDYES=1 ELSE IDYES=0 ENDIF C IF(IDATE.EQ.NDATE)THEN GO TO 117 ELSE IF(NEWDAT.GE.NDATE)GO TO 117 ENDIF C ENDIF C 116 CONTINUE C IF(KSTART.EQ.1)THEN KSTART=MAX(KEND+1,MITEMS) KEND=MITEMS GO TO 110 C SEARCH DONE. START THE NEXT SEARCH WHERE THE C LAST SUCCESSFUL ONE LEFT OFF. ELSE KEND=KSTART-1 KSTART=1 GO TO 1157 C COMPLETE SEARCH. ENDIF C ELSE LOC=3 IPOS=33 CALL UNPKBG(KFILDO,IPACK,ND5,LOC,IPOS,IPA6,32,L3264B,IER,*396) CALL UNPKBG(KFILDO,IPACK,ND5,LOC,IPOS,IPA7,32,L3264B,IER,*396) CALL UNPKBG(KFILDO,IPACK,ND5,LOC,IPOS,IPA8,32,L3264B,IER,*396) CALL UNPKBG(KFILDO,IPACK,ND5,LOC,IPOS,IPA9,32,L3264B,IER,*396) C 1160 DO 1165 M=KSTART,KEND C THE INDEX IN THIS LOOP IS M. LATER, N REFERS TO A PARTICULAR C VARIABLE. C IF(IPA6.EQ.MSTORE(1,M).AND. 1 IPA7.EQ.MSTORE(2,M).AND. 2 IPA8.EQ.MSTORE(3,M).AND. 3 IPA9.EQ.MSTORE(4,M).AND. 4 JCYL.EQ.MSTORE(6,M))THEN C NOTE THAT THE CYCLE IS CHECKED. C N=MOD(MSTORE(5,M),7777) IF(INDEX(N).EQ.1.AND.MSTORE(7,M).EQ.0)GO TO 1165 C WHEN THE ABOVE TEST IS MET, THE VARIABLE HAS ALREADY C BEEN FOUND FOR THE SAME DATE. THIS CAN HAPPEN WHEN C A PREVIOUS RUN OF U201 IS INPUT, AS WELL AS THE C INPUT TO THE PREVIOUS U202 RUN. C TEST ON MSTORE(7,M) ADDED 9/7/03, NECESSARY TO SAVE C PAST DATA IN SOME CIRCUMSTANCES; THIS MIGHT CAUSE C DUPLICATE PROCESSING IF DUPLICATES WERE INPUT. CALL UPDAT(IDATE,MSTORE(7,M),NEWDAT) C USUALLY THE LOOKBACK FEATURE WON'T BE OPERATIVE C AND MSTORE(7,M) WILL BE ZERO, IN WHICH CASE C UPDAT IS NOT EXPENSIVE. NEWDAT IS USED LATER. C C MSTORE( , ) CAN HOLD THE ID( ) OR JD( ), DEPENDING ON WHICH C ONE WAS FOUND IN PRED25. IF THE VARIABLE READ IS THE C SAME AS ID( ), THEN NO PROCESSING SHOULD BE DONE. IN THAT C CASE, SET IDYES = 1. C IF(IPA6.EQ.ID(1,N).AND. 1 IPA7.EQ.ID(2,N).AND. 2 IPA8.EQ.ID(3,N).AND. 3 IPA9.EQ.ID(4,N))THEN IDYES=1 ELSE IDYES=0 ENDIF C IF(IDATE.EQ.NDATE)THEN GO TO 117 ELSE IF(NEWDAT.GE.NDATE)GO TO 117 ENDIF C ENDIF C 1165 CONTINUE C IF(KSTART.EQ.1)THEN KSTART=MAX(KEND+1,MITEMS) KEND=MITEMS GO TO 110 C SEARCH DONE. START THE NEXT SEARCH WHERE THE C LAST SUCCESSFUL ONE LEFT OFF. ELSE KEND=KSTART-1 KSTART=1 GO TO 1160 C COMPLETE SEARCH. ENDIF C ENDIF C C THE DATA ARE NEEDED. UNPACK THE ID'S, WHICH ARE NEEDED C FOR STORING THE DATA. C 117 KSTART=M C SAVE M FOR START OF NEXT SEARCH. STARTING AT M RATHER C THAN M+1 DOESN'T REQUIRE M+1.GT.MITEMS CHECK. KEND=MITEMS C KEND IS THE END OF THE NEXT (PARTIAL) SEARCH. CALL UNPACK(KFILDO,IPACK,IWORK,DATA,ND5, 1 IS0,IS1,IS2,IS4,ND7,MISSP,MISSS,1,L3264B,IER) LD(1)=0 C ABOVE IS A SAFETY, BECAUSE CHARACTERISTICS OF ANY GRID IN C FDA( ) WILL BE WIPED OUT BY FILLING IS2( ) ETC. IN UNPACK. IVECT=1 IF(BTEST(IS1(2),0))IVECT=0 C IVECT = 1 FOR VECTOR DATA, 0 FOR GRIDPOINT DATA. C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 C DATA ARE NOT SAVED OR USED. ANY ERROR IN UNPACK WILL C HAVE CREATED A DIAGNOSTIC. GO TO 110 ENDIF C IF(IVECT.EQ.1)GO TO 118 C C********************************************************** C C THIS SECTION IS FOR GRIDPOINT DATA ONLY. THE ONLY C WAY OUT OF HERE IS TO STATEMENT NOS. 110, 134, OR 800. C C********************************************************** CALL GRCOMB(KFILDO,IP12,IS2,ND7,NGRIDC,ND11,NGRID,NSLAB, 1 CCALL,NAME,STALAT,STALON,DIR,ND1,NSTA,IER) C UPON RETURN FROM GRCOMB, NSLAB IS THE NUMBER OF THE GRID C COMBINATION IN NGRIDC OF THE GRID TO STORE. C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 C AN ERROR IN GRCOMB WILL HAVE CREATED A DIAGNOSTIC. GO TO 800 C IER NE 0 IS TREATED AS FATAL IN PRED24 WITH RETURN TO CALLING C PROGRAM. THAT IS, WHEN THE VARIABLE IS NEEDED, A GRID C COMBINATION MUST BE ABLE TO BE DETERMINED FOR GRIDPOINT DATA. ENDIF C IF(NEWDAT.LT.NDATE)GO TO 110 C THE ABOVE IS A SAFETY. SHOULD NEVER GET HERE WHEN C NEWDAT LT NDATE. C IF(MSTORE(5,M).LT.7777)GO TO 1176 C MSTORE(5, ) LT 7777 INDICATES IT DOESN'T NEED TO BE STORED. C NRRDAT=IS1(8) IF(MSTORE(7,M).NE.0)CALL UPDAT(IS1(8),MSTORE(7,M),NRRDAT) C NRRDAT IS THE LATEST DATE/TIME THIS VARIABLE MAY BE NEEDED. CALL GSTORE(KFILDO,KFIL10,IS1(9),NSLAB,LSTORE,ND9,LITEMS, 1 IPACK,LSIZE,2,NRRDAT,IS1(8), 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C THIS VARIABLE IS STORED PACKED AND WILL BE USED LATER. C LSIZE IS THE SIZE OF THE PACKED RECORD. C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 C AN ERROR IN GSTORE WILL HAVE CREATED A DIAGNOSTIC. THIS C SHOULD NOT HAPPEN; IT IT DOES, THE DATA WILL NOT BE C AVAILABLE LATER, SO DON'T USE IT NOW. GO TO 110 ENDIF C C THIS VARIABLE HAS BEEN STORED. IF(MSTORE(5,M).EQ.7777)GO TO 110 C WHEN MSTORE(5,M) = 7777, IT IS ONLY STORED. C 1176 IF(IDATE.NE.NDATE)GO TO 110 C ONLY ON TIME DATA CAN BE USED DIRECTLY. C C CONTROL NEVER GOES BEYOND THIS POINT IN THE INITAL LOOP TO C STATEMENT 400 UNLESS THE DATE IS CURRENT. C THIS ARRANGEMENT ASSURES THAT THE DATA NEEDED ARE STORED C FOR LATER RECOVERY, BUT DOES NOT GUARANTEE THAT THE DATA C ARE USED WHEN ENCOUNTERED. C C DETERMINE WHETHER DATA READ MATCHES THE TYPE EXPECTED, C VECTOR OR GRIDPOINT. C IF(ISTAV(N).EQ.2)THEN C ISTAV( ) WAS UNDETERMINED UNTIL NOW. ISTAV(N)=IVECT ELSEIF(IVECT.NE.ISTAV(N))THEN WRITE(KFILDO,1189)MODNUM(IN),KFILIN(IN),NDATE,NAMIN(IN) ISTOP(1)=ISTOP(1)+1 GO TO 110 C ENDIF C CALL UNPACK(KFILDO,IPACK,IWORK,DATA,ND5, 1 IS0,IS1,IS2,IS4,ND7,MISSP,MISSS,2,L3264B,IER) LD(1)=0 C ABOVE IS A SAFETY, BECAUSE CHARACTERISTICS OF ANY GRID IN C FDA( ) WILL BE WIPED OUT BY FILLING IS2( ) ETC. IN UNPACK. C THE UNPACKED DATA NOW RESIDE IN DATA( ), UNLESS IER NE 0. C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 C AN ERROR IN UNPACK WILL HAVE CREATED A DIAGNOSTIC. GO TO 110 ENDIF C IF(MISSP.NE.0)MISTOT=MISTOT+1 C MISTOT IS INCREMENTED IF GRIDPOINT DATA HAVE MISSING DATA. C NSIZE=IS2(3)*IS2(4) C NSIZE IS THE SIZE OF THE GRID. C C CHECK SIZE OF GRID. NOTE THAT AN EARLIER CHECK WAS C ON LSIZE, THE SIZE OF THE RECORD READ. C IF(NSIZE.GT.ND5)THEN WRITE(KFILDO,1178)ND5,NSIZE,KFILIN(IN),NDATE,NAMIN(IN) 1178 FORMAT(/' ****ERROR IN PRED24 AT 1178.', 1 ' ND5 MUST BE INCREASED FROM',I8,' TO GE',I8/ 2 ' READING ON UNIT NO.',I3,' PROCESSING DATE',I11, 3 ' FILE = ',A60) ISTOP(1)=ISTOP(1)+1 IER=38 GO TO 110 ENDIF C GO TO 134 C C********************************************************** C C THIS SECTION FOR VECTOR DATA ONLY. ASSOCIATE DATA C WITH STATION LOCATIONS. THE ONLY WAY OUT OF HERE IS C TO STATEMENT NOS. 110 OR 350. C C********************************************************** C 118 ISTA=IS4(3) IF(ISTA.GT.ND5)THEN WRITE(KFILDO,1182)ND5,ISTA,KFILIN(IN),NDATE,NAMIN(IN) 1182 FORMAT(/' ****ND5 =',I6,' TOO SMALL FOR DATA ARRAY', 1 ' IN PRED24 AT 1182. INCREASE TO GE',I6/ 2 ' READING ON UNIT NO.',I3, 3 ' PROCESSING DATE',I11,' FILE = ',A60) IER=38 C SET SDATA( ) TO MISSING. DATA( ) WILL NOT HAVE C BEEN OVERFLOWED, BUT WILL CONTAIN THE MISSING C INDICATOR. C ISTOP(1)=ISTOP(1)+1 C DATA ARE NOT USED OR STORED. GO TO 110 C ELSE C C PUT DATA INTO SDATA( ). NOTE THAT EXCEPT FOR THE C INITIAL RETRIEVAL INTO DATA( ), ONLY THE NSTA WORDS C OF DATA ARE DEALT WITH. C CALL UNPACK(KFILDO,IPACK,IWORK,DATA,ND5, 1 IS0,IS1,IS2,IS4,ND7,MISSP,MISSS,2,L3264B,IER) C THE UNPACKED DATA NOW RESIDE IN DATA( ), UNLESS IER NE 0. LD(1)=0 C ABOVE IS A SAFETY, BECAUSE CHARACTERISTICS OF ANY GRID IN C FDA( ) WILL BE WIPED OUT BY FILLING IS2( ) ETC. IN UNPACK. C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 C AN ERROR IN UNPACK WILL HAVE CREATED A DIAGNOSTIC. GO TO 110 ENDIF C DO 1184 K=1,NSTA C IF(INDEXC(K,IN).EQ.99999999)THEN SDATA(K)=9999. ELSE SDATA(K)=DATA(INDEXC(K,IN)) IF(SDATA(K).EQ.9997.)SDATA(K)=PXMISS C THE ABOVE STATEMENT ALLOWS THE MISSING VALUE C 9997 TO BE TREATED AS SOME OTHER VALUE. THIS C WOULD USUALLY BE 0, BUT COULD BE, SAY, 9999. ENDIF C 1184 CONTINUE C NSLAB=0 C NSLAB IS SET TO 0 FOR VECTOR DATA FOR POSSIBLE C STORAGE BY GRCOMB. ENDIF C IF(NEWDAT.LT.NDATE)GO TO 110 C THE ABOVE IS A SAFETY. SHOULD NEVER GET HERE WHEN C NEWDAT LT NDATE. C IF(MSTORE(5,M).LT.7777)GO TO 1186 C MSTORE(5, ) LT 7777 INDICATES IT DOESN'T NEED TO BE STORED. C NRRDAT=IS1(8) IF(MSTORE(7,M).NE.0)CALL UPDAT(IS1(8),MSTORE(7,M),NRRDAT) C NRRDAT IS THE LATEST DATE/TIME THIS VARIABLE MAY BE NEEDED. CALL GSTORE(KFILDO,KFIL10,IS1(9),0,LSTORE,ND9,LITEMS, 1 SDATA,NSTA,1,NRRDAT,IS1(8), 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C THIS VARIABLE IS STORED UNPACKED AND WILL BE USED LATER. C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 C AN ERROR IN GSTORE WILLL HAVE CREATED A DIAGNOSTIC. GO TO 110 ENDIF C C THIS VARIABLE HAS BEEN STORED. 1186 IF(MSTORE(5,M).EQ.7777)GO TO 110 C WHEN MSTORE(5,M) = 7777, IT IS ONLY STORED. C IF(IDATE.NE.NDATE)GO TO 110 C ONLY ON TIME DATA CAN BE USED DIRECTLY. C C CONTROL NEVER GOES BEYOND THIS POINT IN THE INITAL LOOP TO C STATEMENT 400 UNLESS THE DATE IS CURRENT. C THIS ARRANGEMENT ASSURES THAT THE DATA NEEDED ARE STORED C FOR LATER RECOVERY, BUT DOES NOT GUARANTEE THAT THE DATA C ARE USED WHEN ENCOUNTERED. C C DETERMINE WHETHER DATA READ MATCHES THE TYPE EXPECTED, C VECTOR OR GRIDPOINT. C IF(ISTAV(N).EQ.2)THEN C ISTAV( ) WAS UNDETERMINED UNTIL NOW. ISTAV(N)=IVECT ELSEIF(IVECT.NE.ISTAV(N))THEN WRITE(KFILDO,1189)MODNUM(IN),KFILIN(IN),NDATE,NAMIN(IN) 1189 FORMAT(/' ****MODEL NO.',I3,' ON UNIT NO.',I3, 1 ' IMPLYING GRIDPOINT OR VECTOR DATA DOES NOT AGREE'/ 2 ' WITH TYPE OF DATA READ IN PRED24. ', 3 ' MODEL NUMBERS OF 80 AND ABOVE ARE RESERVED', 4 ' FOR VECTOR DATA.'/ 5 ' PROCESSING DATE',I11,' FILE = ',A60) ISTOP(1)=ISTOP(1)+1 GO TO 110 C ENDIF C GO TO 350 C NOTE THAT VECTOR DATA FROM THE INPUT HAS NO COMPUTATIONS C DONE. C C*********************************************************** C C END OF VECTOR SECTION ONLY. C C*********************************************************** C C ARE THESE DATA REUSABLE AND STORED IN FDA( )? NOTE THAT C THESE DATA ARE USED FOR MAKING A GRID BINARY AND/OR C SMOOTHING. C 119 IF(JD(1,N).NE.LD(1).OR. 1 JD(2,N).NE.LD(2).OR. 2 JD(3,N).NE.LD(3).OR. 3 LPARS.NE.IDPARS(15,N))GO TO 110 C C TAKE DATA FROM FDA( ). C D WRITE(KFILDO,1190)(JD(K,N),K=1,4) D1190 FORMAT( ' RESTORING GRID AT 1190 IN PRED24',I11.9,3I11) C DO 120 K=1,NSIZE DATA(K)=FDA(K) 120 CONTINUE C IDYES=LDYES C PRESERVE IDYES CORRESPONDING TO DATA. GO TO 205 C 134 IF(N.EQ.NPRED)GO TO 205 C C SAVE GRID FOR POSSIBLE REUSE. IT IS POSSIBLE IT WON'T BE C NEEDED FOR THE NEXT VARIABLE BUT C WILL BE NEEDED FOR THE NEXT (E.G., GRID BINARY). OR IT C MAY NOT BE NEEDED AT ALL, BUT THIS CONTINGENCY KEEPS C GRIDS FROM BEING STORED BY GSTORE UNNECESSARILY. C IF(JD(1,N).NE.JD(1,N+1).OR. 1 JD(2,N).NE.JD(2,N+1).OR. 2 JD(3,N).NE.JD(3,N+1).OR. 3 IDPARS(15,N).NE.IDPARS(15,N+1))GO TO 205 C THE IDPARS(15, ) CHECK IS A SAFETY. AT PRESENT, IDPARS(15, ) C IS NOT USED. C LD(1)=JD(1,N) LD(2)=JD(2,N) LD(3)=JD(3,N) LPARS=IDPARS(15,N) LDYES=IDYES C PRESERVE IDYES FOR LATER USE. C D WRITE(KFILDO,139)(JD(K,N),K=1,4) D139 FORMAT(/' SAVING GRID AT 139 IN PRED24 ',I11.9,3I11) C DO 140 K=1,NSIZE FDA(K)=DATA(K) 140 CONTINUE C C AT THIS POINT, THE VARIABLE EXISTS IN DATA( ). C THE FULL IDENTIFICATION IS IN IS1( ), IS2( ), C AND IS4( ). IF IT MAY BE NEEDED FOR THE C NEXT VARIABLE AND IS A GRID, THE DATA ARE ALSO IN FDA( ). C C MAKE GRID BINARY IF DESIRED. C 205 IF(IDYES.EQ.1)GO TO 206 C IF(IDPARS(3,N).EQ.5) THEN C C THE FOLLOWING IDS PERTAIN TO LAMP RCM, MRMS, AND TL C PREDICTORS, WHICH CAN CONTAIN MISSING (9999) VALUES. C GRIDB CANNOT ACCOMMODATE MISSING VALUES, SO CALL GRIDBM C INSTEAD. C IF(ID(1,N)/1000.NE.007581.AND.ID(1,N)/1000.NE.007582.AND. 1 ID(1,N)/1000.NE.007647.AND.ID(1,N)/1000.NE.007648.AND. 2 ID(1,N)/1000.NE.007801.AND.ID(1,N)/1000.NE.007807.AND. 3 ID(1,N)/1000.NE.007545.AND.ID(1,N)/1000.NE.007550) THEN CALL GRIDB(KFILDO,ID(1,N),IDPARS(3,N),THRESH(N), 1 DATA,FD1,IS2(3),IS2(4),IER) ELSE C FOR LAMP TSTM RADAR AND LIGHTNING PREDICTORS USE GRIDBM, C WHICH CHECKS FOR MISSING (9999) GRIDPOINT VALUES. THIS C THIS ALSO APPLIES TO (MORE RECENT) MRMS AND TL PDRS. CALL GRIDBM(KFILDO,ID(1,N),IDPARS(3,N),THRESH(N), 1 DATA,FD1,IS2(3),IS2(4),IER) ENDIF C IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 ISTOP(2)=ISTOP(2)+1 C AN ERROR IN GRIDB WILL HAVE CREATED A DIAGNOSTIC AND DATA C ARE RETURNED AS MISSING. LET IT PROCEED. ISTOP(2) IS C INCREMENTED HERE BECAUSE IT PROBABLY WON'T BE LATER. ENDIF C ENDIF C C SMOOTH FIELD IF DESIRED. C IF(IDPARS(14,N).EQ.0)GO TO 206 C IF(IDPARS(14,N).EQ.1)THEN CALL SMTH5 (KFILDO,DATA,FD1,IS2(3),IS2(4)) ELSEIF(IDPARS(14,N).EQ.2)THEN CALL SMTH9 (KFILDO,DATA,FD1,IS2(3),IS2(4)) C ELSEIF(IDPARS(14,N).EQ.3)THEN C C FOR LAMP MRMS/TL PREDICTORS USE SMT25M, WHICH CHECKS C FOR MISSING (9999) GRIDPOINT VALUES. OTHERWISE, USE C SMTH25. C IF(ID(1,N)/1000.NE.007801.AND.ID(1,N)/1000.NE.007807.AND. 1 ID(1,N)/1000.NE.007545.AND.ID(1,N)/1000.NE.007550) THEN C CALL SMTH25(KFILDO,DATA,FD1,IS2(3),IS2(4)) ELSE CALL SMT25M(KFILDO,DATA,FD1,IS2(3),IS2(4)) ENDIF C ELSEIF(IDPARS(14,N).EQ.4)THEN IF(ID(1,N)/1000.NE.007581.AND.ID(1,N)/1000.NE.007582.AND. 1 ID(1,N)/1000.NE.007647.AND.ID(1,N)/1000.NE.007648) THEN CALL SMTH2X(KFILDO,DATA,FD1,IS2(3),IS2(4)) ELSE C FOR LAMP TSTM RADAR PREDICTORS USE SMT2XM, WHICH C CHECKS FOR MISSING (9999) GRIDPOINT VALUES. CALL SMT2XM(KFILDO,DATA,FD1,IS2(3),IS2(4)) ENDIF C ELSEIF(IDPARS(14,N).EQ.5)THEN CALL SMTH3X(KFILDO,DATA,FD1,IS2(3),IS2(4)) ENDIF C C PRINT GRIDPOINT VALUES IF DESIRED. TRY TO MATCH PRECISION C OF PRINTING TO SIZE OF VALUES THROUGH ISCALD( ). WHILE C THE LOOP IS INEFFICIENT, IT WILL BE EXECUTED VERY RARELY. C 206 IF(IP13.EQ.0)GO TO 210 IF(JP(1,N).EQ.0)GO TO 210 C WRITE(IP13,207)(ID(J,N),J=1,4),NDATE 207 FORMAT(/' GRIDPOINT VALUES FOR VARIABLE',I11.9,3I11, 1 ' FOR DATE',I12/) C DO 209 JY=1,IS2(4) C IF(ISCALD(N).LE.-1)THEN WRITE(IP13,208)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) 208 FORMAT(' ',10F10.1/(' ',10F10.1)) ELSEIF(ISCALD(N).EQ.0)THEN WRITE(IP13,2080)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) 2080 FORMAT(' ',10F10.2/(' ',10F10.2)) ELSEIF(ISCALD(N).EQ.1)THEN WRITE(IP13,2081)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) 2081 FORMAT(' ',10F10.3/(' ',10F10.3)) ELSEIF(ISCALD(N).EQ.2)THEN WRITE(IP13,2082)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) 2082 FORMAT(' ',10F10.4/(' ',10F10.4)) ELSE WRITE(IP13,2083)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) 2083 FORMAT(' ',10F10.5/(' ',10F10.5)) ENDIF C 209 CONTINUE C C GRIDPRINT FIELD IF DESIRED. C 210 IF(IP14.EQ.0)GO TO 220 IF(JP(2,N).EQ.0)GO TO 220 C C GRIDPRINT WHEN DESIRED. C CALL PREDX1(KFILDO,IDPARS(1,N),THRESH(N), 1 SMULT(N),SADD(N),ORIGIN(N),CINT(N), 2 PLAIN(N),UNITS(N),NDATE,-IDPARS(9,N),DATA,ND5, 3 IS2,ND7,IP14,ISTOP(1),IER) C AN ERROR IN GRIDPRINTING IS TREATED AS AN ISTOP(1) ERROR. C NORMALLY, GRIDPRINTING WOULD BE DONE ONLY IN CHECKOUT. C IER NE 0 IN PREDX1 DOES NOT CAUSE MISSING DATA. C C PACK AND WRITE THE GRIDPOINT FIELD. IT IS POSSIBLE SOME C GRIDS WILL HAVE PRIMARY MISSINT VALUES (E.G., CEILING C HEIGHT FOR LAMP). C 220 XMISSP=9999. XMISSS=0. CALL PACKG(KFILDO,KFILGO,ID(1,N),IDPARS(1,N), 1 ISCALD(N),0,NGRIDC(1,NSLAB), 2 IPLAIN(1,1,N),PLAIN(N),NDATE,NYR,NMO,NDA,NHR, 3 FD1,DATA,ND2X3,IS2(3),IS2(4),IPACK,IWORK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS, 5 NWORDS,NTOTBG,NTOTRG, 6 L3264B,L3264W,ISTOP(1),IER) C NOTE THAT GRIDPOINT DATA TO PACK ARE IN DATA( ). GO TO 389 C C THIS SECTION FOR VECTOR DATA. C C SET XMISSP AND XMISSS. NOTE THAT ANY VALUES OF 9997 C IN VECTOR DATA HAVE BEEN SET TO PXMISS. C 9997 IS NOT EXPECTED OR DEALT WITH IN GRIDPOINT DATA. C OPTION SHOULD NOT RETURN 9997 UNLESS IT IS DESIRED C TO LEAVE THOSE VALUES IN THE OUTPUT. C 350 CALL SETMIS(KFILDO,SDATA,NSTA,XMISSP,XMISSS) C C PACK AND WRITE THE DATA. C 360 CALL PACKV(KFILDO,KFILIO,ID(1,N),IDPARS(1,N),JP(1,N),ISCALD(N),0, 1 IPLAIN(1,1,N),PLAIN(N),NDATE,NYR,NMO,NDA,NHR,CCALL, 2 ISDATA,SDATA,ND1,NSTA,IPACK,ND5,MINPK, 3 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS, 4 IP15,NWORDS,NTOTBY,NTOTRC, 5 L3264B,L3264W,ISTOP(1),IER) 389 IF(INDEX(N).NE.1)GO TO 395 C IF(KFILIO.EQ.0)THEN WRITE(KFILDO,390)(ID(I,N),I=1,4),NDATE 390 FORMAT(/' ****VARIABLE ',I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 1 ' COMPUTED MORE THAN ONCE FOR DATE',I11) ELSE WRITE(KFILDO,391)(ID(I,N),I=1,4),NDATE 391 FORMAT(/' ****VARIABLE ',I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 1 ' COMPUTED AND WRITTEN MORE THAN ONCE PROCESSING DATE', 2 I11) ENDIF C ISTOP(1)=ISTOP(1)+1 395 INDEX(N)=1 IFDATE(N)=IDATE N=N+1 IF(N.GT.NPRED)GO TO 110 IF(ISTAV(N).EQ.1)GO TO 110 IF(INDEX(N).EQ.1)GO TO 110 GO TO 119 C 396 WRITE(KFILDO,397)IER,NDATE 397 FORMAT(/' ****ERROR IN UNPKBG IN PRED24. IER =',I4, 1 ', PROCESSING DATE',I11) ISTOP(1)=ISTOP(1)+1 C UNPKBG DOES NOT CREATE A DIAGNOSTIC. GO TO 110 C 400 CONTINUE C C VARIABLES HAVE BEEN USED FOR CURRENT DATE THAT DO NOT C REQUIRE BEING STORED WITH KEYS IN LSTORE( , ). C OUTPUT UP TO 3 DIAGNOSTICS IF NO DATA AVAILABLE ON A C PARTICULAR INPUT FILE FOR UP TO 3 DIAGNOSTICS. C IF(NODATA.GE.3)GO TO 4016 C DO 4015 J=1,NUMIN C IF(JFOPEN(J).NE.1)GO TO 4015 C IF(LKHERE(J).NE.0.AND. 1 MSDATE(J).EQ.0)THEN C IF(IP23.NE.0.AND.IP23.NE.KFILDO)THEN WRITE(IP23,401)KFILIN(J),NDATE,NAMIN(J) 401 FORMAT(/' ****NO DATA AVAILABLE FOR FILE ON UNIT NO.',I4, 1 ' PROCESSING DATE',I11/ 2 ' FILE = ',A60) C NOTE THAT THIS OUTPUT IS PROVIDED ONLY WHEN AN END OF C FILE HAS NOT BEEN REACHED. NODATA=NODATA+1 ENDIF C IF(NODATA.LE.2)THEN WRITE(KFILDO,401)KFILIN(J),NDATE,NAMIN(J) ELSEIF(NODATA.EQ.3)THEN WRITE(KFILDO,401)KFILIN(J),NDATE,NAMIN(J) WRITE(KFILDO,4010) 4010 FORMAT(' THIS DIAGNOSTIC WILL NOT BE WRITTEN AGAIN.') ENDIF C ENDIF C 4015 CONTINUE C C OUTPUT DIAGNOSTIC IF ALL DATA HAVE BEEN EXHAUSTED. C 4016 DO 402 J=1,NUMIN IF(LITEMS.NE.0.OR. 1 MSDATE(J).NE.0.OR. 2 LKHERE(J).NE.0)GO TO 405 402 CONTINUE C WRITE(KFILDO,403)NDATE 403 FORMAT(/' ****ALL INPUT DATA EXHAUSTED LOOKING FOR DATE',I11,'.') IER=127 ISTOP(1)=ISTOP(1)+1 GO TO 800 C C NOW COMPUTE THE VARIABLES THROUGH THE OPTION SUBROUTINE. C 405 LD(1)=0 C ABOVE STATEMENT NECESSARY BECAUSE A FIELD COULD HAVE BEEN C LEFT OVER FROM A PREVIOUS DATE. C DO 700 N=1,NPRED IF(INDEX(N).EQ.1)GO TO 700 C WHEN INDEX( ) = 1, THIS VARIABLE HAS ALREADY BEEN SECURED. IF(IDPARS(1,N).EQ.799)GO TO 700 C CCC = 799 IS A DUMMY THAT HAS NO PURPOSE IN PRED24 EXCEPT C IN DETERMINING LDATB( ) AND LDATE( ). C IF(ISTAV(N).EQ.1.AND.ITIME(N).EQ.1)GO TO 427 C VECTOR DATA FOR THE CURRENT DATE HAVE BEEN ACCESSED. C THE TRANSFER TO 427 WILL TAKE CARE OF POSSIBLE PAST C CASES. OTHERWISE, THIS VECTOR MUST COME FROM OPTION. C IF(ISTAV(N).NE.0)THEN C THIS VARIABLE MAY BE A VECTOR; IT IS NEVER SAVED. C NOTE THAT ISTAV( ) MAY BE 2 AFTER DAY 1, AND LATER C BE CHANGED. GO TO 425 ENDIF C C A DROP THROUGH HERE WHEN IT IS EXPECTED THE VARIABLE C IS GRIDPOINT AND MAY BE AVAILABLE DIRECTLY FROM INPUT. C A VECTOR IS NOT SAVED IN FDA( ). C IF(N.EQ.1)GO TO 425 C C THIS VARIABLE CAN BE REUSED FROM THE PREVIOUS ONE ONLY IF: C (1) IT IS A GRID AND ONLY THE POINT COMPUTATIONS C ARE NECESSARY (E.G., INTERPOLATION). C IF GRID PROCESSING (E.G., SMOOTHING) IS NEEDED ON A C BASIC GRID, IT MAY BE SAVED IN FDA( ). C C***D WRITE(KFILDO,410)N,JD(1,N-1),JD(2,N-1),JD(3,N-1), C***D 1 IDPARS(13,N-1),IDPARS(14,N-1),IDPARS(15,N-1), C***D 2 JD(1,N),JD(2,N),JD(3,N), C***D 3 IDPARS(3,N), C***D 4 IDPARS(13,N),IDPARS(14,N),IDPARS(15,N) C***D410 FORMAT(' PRED24 AT 410'I4,3I10,6X3I6/ C***D 1 ' '4X,3I10, 4I6) IF(JD(1,N).EQ.JD(1,N-1).AND. 1 JD(2,N).EQ.JD(2,N-1).AND. 2 JD(3,N).EQ.JD(3,N-1).AND. 3 IDPARS(3,N).NE.5.AND. 4 IDPARS(3,N-1).NE.5.AND. 5 IDPARS(13,N).EQ.IDPARS(13,N-1).AND. 6 IDPARS(14,N).EQ.IDPARS(14,N-1).AND. 7 IDPARS(15,N).EQ.IDPARS(15,N-1).AND. 8 NGOMIS.EQ.0)GO TO 510 C THE CHECK ON IDPARS(3,N-1) IS NOT NECESSARY WHEN C THE VARIABLES ARE ORDERED, AS THEY SHOULD BE C UNLESS SORTEM IS TAKEN OUT OF RDPRED. NGOMIS C IS 1 WHEN THE PREVIOUS VARIABLE WAS MISSING. C THE CHECK ABOVE WAS FOR U201 AND WILL PROBABLY NEVER C BE MET IN U202. IDYES IS PRESERVED. C TRANSFER TO 510 RATHER THAN 520 ALLOWS GRIDPRINTING. C IDYES IS PRESERVED. C C IS THIS GRID REUSABLE AND STORED IN FDA( )? NOTE THAT C THESE DATA ARE USED FOR MAKING A GRID BINARY AND/OR C SMOOTHING. C IF(JD(1,N).NE.LD(1).OR. 1 JD(2,N).NE.LD(2).OR. 2 JD(3,N).NE.LD(3).OR. 3 LPARS.NE.IDPARS(15,N))GO TO 425 C C TAKE DATA FROM FDA( ). C D WRITE(KFILDO,419)(JD(K,N),K=1,4) D419 FORMAT( ' RESTORING GRID AT 419 IN PRED24',I11.9,3I11) C DO 420 K=1,NSIZE DATA(K)=FDA(K) 420 CONTINUE C IDYES=LDYES C PRESERVE IDYES CORRESPONDING TO DATA. GO TO 505 C C MUST EITHER FIND A VARIABLE IN LSTORE( , ) OR COMPUTE IT IN C OPTION. ALL VARIABLES NOT TO BE COMPUTED IN OPTION OF THE C CURRENT DATE/TIME HAVE BEEN DEALT WITH. BASIC LAGGED C VARIABLES CAN BE GOTTEN DIRECTLY BY GFETCH. C 425 IF(IFIND(N).EQ.0)GO TO 432 C WHEN IFIND(N) EQ.0, THIS VARIABLE MUST BE COMPUTED IN OPTION, C IFIND( ) BEING SET IN PRED21. THIS IS DONE FOR EFFICIENCY ONLY. C IF(IDPARS(9,N).EQ.0)THEN C LAG OF 0 HAS BEEN DEALT WITH ABOVE, UNLESS IT IS COMPUTED IN C OPTION. THIS KEEPS CONTROL OUT OF GFETCH. WRITE(KFILDO,426)(ID(K,N),K=1,4),NDATE 426 FORMAT(/' ****VARIABLE ',I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 1 ' NOT FOUND ON INPUT FILE(S) FOR DATE',I11/ 2 ' VARIABLE WILL NOT BE WRITTEN.') ISTOP(1)=ISTOP(1)+1 ISTOP(2)=ISTOP(2)+1 GO TO 695 ENDIF C 427 IF(IFIND(N).EQ.0)GO TO 432 C IF IFIND( ) = 0, THE VARIABLE IS KNOWN TO COME FROM OPTION. C IF(ISTAV(N).NE.1)THEN C IF ISTAV( ) = 0, THE VARIABLE IS VECTOR. C IF ISTAV( ) = 2, THE TYPE IS UNKNOWN AT THIS TIME. C C THIS IS FOR GRIDPOINT DATA. C CALL GFETCH(KFILDO,KFIL10,JD(1,N),N,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,DATA,ND5,NSIZE, 2 NPACK,NDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,ITIME(N), 4 IER) C DATA ARE RETURNED IN DATA(ND5), NSIZE VALUES. HOWEVER, C IF IER NE 0, NSIZE MAY BE ZERO. LD(1)=0 C ABOVE IS A SAFETY, BECAUSE CHARACTERISTICS OF ANY GRID IN C FDA( ) WILL BE WIPED OUT BY FILLING IS2( ) ETC. IN GFETCH. IF(MISSP.NE.0)MISTOT=MISTOT+1 C IF(IER.EQ.0)THEN IDYES=0 C IDYES = 0 INDICATES FULL ID WAS NOT FOUND. C IF(NSLAB.EQ.0)THEN C DATA ARE VECTOR. THIS IS ALREADY KNOWN UNLESS C DATA WERE MISSING UP TO THIS POINT. NORMALLY, C THIS ENTRY TO GFETCH WOULD NOT OCCUR, BECAUSE C ISTAV(N) WOULD BE 0 AND THE DATA WOULD BE GRIDPOINT. ISTAV(N)=1 C DO 4285 K=1,NSTA SDATA(K)=DATA(K) 4285 CONTINUE C GO TO 650 ELSE C DATA ARE NOT VECTOR. THIS IS ALREADY KNOWN UNLESS C DATA WERE MISSING UP TO THIS POINT. ISTAV(N)=0 GO TO 435 ENDIF C ELSEIF(IER.EQ.47)THEN C IF(IFIND(N).EQ.2)THEN GO TO 4287 ELSE WRITE(KFILDO,426)(JD(K,N),K=1,4),NDATE ISTOP(2)=ISTOP(2)+1 GO TO 695 ENDIF C ELSE ISTOP(1)=ISTOP(1)+1 C AN ERROR IN GFETCH WILL HAVE CREATED A DIAGNOSTIC EXCEPT, C POSSIBLY, FOR IER = 47. IER = 47 MEANS THE DATA C COULDN'T BE FOUND. OTHER RETURNS ARE PROBABLY FATAL. C NOTE THAT CONTROL IS NOT HERE IF IT IS EXPECTED THAT C OPTION IS NEEDED. WRITE(KFILDO,426)(JD(K,N),K=1,4),NDATE ISTOP(2)=ISTOP(2)+1 GO TO 695 ENDIF C ENDIF C 4287 IF(ISTAV(N).NE.0)THEN C IF ISTAV( ) = 1, THE VARIABLE IS VECTOR. C IF ISTAV( ) = 2, THE TYPE IS UNKNOWN AT THIS TIME. C C THIS IS FOR VECTOR DATA. C CALL GFETCH(KFILDO,KFIL10,ID(1,N),N,LSTORE,ND9,LITEMS, 1 IS0,IS1,IS2,IS4,ND7,IPACK,IWORK,SDATA,ND1,NSIZE, 2 NPACK,NDATE,NTIMES,CORE,ND10, 3 NBLOCK,NFETCH,NSLAB,MISSP,MISSS,L3264B,ITIME(N), 4 IER) LD(1)=0 C ABOVE IS A SAFETY, BECAUSE CHARACTERISTICS OF ANY GRID IN C FDA( ) WILL BE WIPED OUT BY FILLING IS2( ) ETC. IN GFETCH. C DATA ARE RETURNED IN SDATA(ND1), NSTA VALUES. C IF(IER.EQ.0)THEN IDYES=1 C IDYES = 1 INDICATES FULL ID WAS FOUND. C IF(NSLAB.EQ.0)THEN C DATA ARE VECTOR. THIS IS ALREADY KNOWN UNLESS C DATA WERE MISSING UP TO THIS POINT. ISTAV(N)=1 GO TO 650 ELSE C DATA ARE NOT VECTOR. THIS IS ALREADY KNOWN UNLESS C DATA WERE MISSING UP TO THIS POINT. NORMALLY, C THIS ENTRY TO GFETCH WOULD NOT OCCUR, BECAUSE C ISTAV(N) WOULD BE 1 AND THE DATA WOULD BE VECTOR. ISTAV(N)=0 C DO 4295 K=1,ND5 DATA(K)=SDATA(K) 4295 CONTINUE C GO TO 435 ENDIF C ELSEIF(IER.EQ.47)THEN C IF(IFIND(N).EQ.2)THEN GO TO 432 ELSE WRITE(KFILDO,426)(JD(K,N),K=1,4),NDATE ISTOP(2)=ISTOP(2)+1 GO TO 600 ENDIF C ELSE ISTOP(1)=ISTOP(1)+1 C AN ERROR IN GFETCH WILL HAVE CREATED A DIAGNOSTIC EXCEPT, C POSSIBLY, FOR IER = 47. IER = 47 MEANS THE DATA C COULDN'T BE FOUND. OTHER RETURNS ARE PROBABLY FATAL. C NOTE THAT CONTROL IS NOT HERE IF IT IS EXPECTED THAT C OPTION IS NEEDED. GO TO 600 ENDIF C ENDIF C IF(IFIND(N).EQ.1)GO TO 600 C C MUST COMPUTE THIS VARIABLE. C 432 CALL OPTION(KFILDO,KFIL10,NFIRST, 1 ID(1,N),IDPARS(1,N),THRESH(N),JD(1,N),NDATE, 2 KFILRA,RACESS,NUMRA, 3 ICALL,CCALL,ICALLD,CCALLD,NAME, 4 NELEV,STALAT,STALON, 5 ITIMEZ,ISDATA,SDATA,SDATA1,L1DATA,DIR,ND1,NSTA, 6 NGRIDC,NGRID,ND11,NSLAB,IPACK,IWORK,DATA,ND5, 7 LSTORE,ND9,LITEMS,CORE,ND10,LASTL, 8 NBLOCK,LASTD,NSTORE,NFETCH, 9 IS0,IS1,IS2,IS4,ND7, A FD1,FD2,FD3,FD4,FD5,FD6,FD7, B FDVERT,FDTIME,FDSINS,FDMS,ND2X3,IP12,IP16, C ISTAVX,L3264B,L3264W,MISTOT,IER) LD(1)=0 C ABOVE IS A SAFETY, BECAUSE CHARACTERISTICS OF ANY GRID IN C FDA( ) WILL BE WIPED OUT BY FILLING IS2( ) ETC. IN OPTION. C C DEFINE NSIZE. IF THE DATA ARE GRIDPOINT AND IER NE 0, C IS2( ) IS NOT DEFINED, SO MAKE NSIZE = ND2X3 IN CASE C ND2X3 IS USED (E.G., FOR SAVING A GRID). C IF(ISTAV(N).EQ.1)THEN C DATA ARE VECTOR. NSIZE=NSTA ELSE C DATA ARE GRIDPOINT. C IF(IER.EQ.0)THEN NSIZE=IS2(3)*IS2(4) ELSE NSIZE=ND2X3 ENDIF C ENDIF C C AS A SPECIAL FEATURE, IER = -1 FROM A SUBROUTINE CALLED C BY OPTION MEANS THAT THE DATA ARE NOT TO BE WRITTEN. C THIS CAN BE USED WHEN NOT ALL HOURS BEING PROCESSED C HAVE DATA FOR THAT HOUR (E.G., MAX/MIN TEMPERATURE). C ALSO, WHEN THE VARIABLE ID CANNOT BE LOCATED IN OPTION, C IER IS RETURNED AS -2. THIS FACILITATES THE USE OF THE C LOOKBACK FEATURE IN PRED21 WHEN NOT ALL DATA ARE AVAILABLE C FOR DAY 1. C IF(IER.EQ.0)THEN IFIND(N)=0 IDYES=1 C IDYES = 1 ALLOWS GRIDPOINT PROCESSING FROM OPTION. GO TO 4325 C ELSEIF(IER.EQ.47)THEN C MISSING DATA IS NOT COUNTED AS AN ERROR, BUT IS C COUNTED LATER AS MISSING DATA. IFIND( ) IS NOT C CHANGED. IT MAY STILL NOT BE KNOWN WHERE THE C VARIABLE IS TO COME FROM. WRITE(KFILDO,4321)(ID(J,N),J=1,4) 4321 FORMAT(' VARIABLE ', 1 I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 2 ' WILL NOT BE WRITTEN.') ISTOP(2)=ISTOP(2)+1 GO TO 695 C ELSEIF(IER.EQ.-1)THEN C DON'T WRITE THIS VARIABLE. TREAT IER = 0 ONWARD. IFIND(N)=0 IER=0 WRITE(KFILDO,4321)(ID(J,N),J=1,4) GO TO 695 C ELSEIF(IER.EQ.120)THEN C IER = 120 IS FROM FINDST IN CONST AND MEANS ONE C OR MORE STATIONS COULD NOT BE FOUND. THIS IS C NOT FATAL, BUT IS TREATED AS AN ERROR. IFIND(N)=0 ISTOP(1)=ISTOP(1)+1 GO TO 4325 C ELSEIF(IER.EQ.-2)THEN C THIS SHOULD NOT HAPPEN. IFIND(N)=1 ISTOP(1)=ISTOP(1)+1 WRITE(KFILDO,4321)(ID(J,N),J=1,4) GO TO 695 ENDIF C 4325 IF(ISTAVX.NE.ISTAV(N))THEN ISTOP(1)=ISTOP(1)+1 WRITE(KFILDO,433)(ID(J,N),J=1,4),NDATE 433 FORMAT(/' ****ISTAV RETURNED FROM OPTION IN PRED24 DOES', 1 ' NOT AGREE WITH WHAT WAS EXPECTED FOR VARIABLE',/ 2 ' ',I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 3 ' PROCESSING DATE',I11/ 3 ' VARIABLE WILL NOT BE WRITTEN.') ISTOP(2)=ISTOP(2)+1 GO TO 695 ENDIF C IF(ISTAV(N).EQ.1)GO TO 650 C VECTOR DATA ARE NOT SAVED IN FDA( ). TRANSFORMATION C AND BINARY OPERATORS ARE USED FOR VECTOR DATA FROM C OPTION (BUT NOT FOR VECTOR DATA NOT FROM OPTION). C C SAVE GRID FOR POSSIBLE REUSE. IT IS POSSIBLE IT WON'T BE C NEEDED FOR THE NEXT VARIABLE (E.G., POINT BINARY) BUT C WILL BE NEEDED FOR THE NEXT (E.G., GRID BINARY). OR IT C MAY NOT BE NEEDED AT ALL, BUT THIS CONTINGENCY KEEPS C GRIDS FROM BEING STORED BY GSTORE UNNECESSARILY. C 435 IF(N.EQ.NPRED)GO TO 504 C THE LAST VARIABLE IN THE LIST NEED NOT BE SAVED. C IF(JD(1,N).NE.JD(1,N+1).OR. 1 JD(2,N).NE.JD(2,N+1).OR. 2 JD(3,N).NE.JD(3,N+1).OR. 3 IDPARS(15,N).NE.IDPARS(15,N+1))GO TO 504 C THE IDPARS(15, ) CHECK IS A SAFETY. AT PRESENT, IDPARS(15, ) C IS NOT USED. C LD(1)=JD(1,N) LD(2)=JD(2,N) LD(3)=JD(3,N) LPARS=IDPARS(15,N) LDYES=IDYES C KEEP IDYES WITH THE DATA. C D WRITE(KFILDO,439)(JD(K,N),K=1,4) D439 FORMAT(/' SAVING GRID AT 439 IN PRED24 ',I11.9,3I11) C DO 440 K=1,NSIZE FDA(K)=DATA(K) 440 CONTINUE C MISDAT=0 C C AT THIS POINT, THE VARIABLE HAS BEEN FOUND OR COMPUTED AND C EXISTS IN DATA( ). THE FULL IDENTIFICATION IS IN IS1( ), C IS2( ), AND IS4( ). IF IT MAY BE NEEDED FOR THE NEXT C VARIABLE AND IS A GRID, THE DATA ARE ALSO IN FDA( ). C IF IER NE 0, THE DATA MAY BE MISSING OR INCORRECT, BUT C THIS MAY SAVE ANOTHER TRIP TO OPTION. NOTE THE CHECK C OR IER BELOW. C 504 IF(IER.NE.0)GO TO 600 C IT IS POSSIBLE THIS POINT COULD BE REACHED WITH MISSING C GRIDPOINT VALUES; HENCE, THE CHECK FOR IER = 0 FOR SAFETY. C C MAKE GRID BINARY IF DESIRED. C 505 IF(IDYES.EQ.1)GO TO 506 C IF(IDPARS(3,N).EQ.5) THEN IF(ID(1,N)/1000.NE.007581.AND.ID(1,N)/1000.NE.007582.AND. 1 ID(1,N)/1000.NE.007647.AND.ID(1,N)/1000.NE.007648.AND. 2 ID(1,N)/1000.NE.007801.AND.ID(1,N)/1000.NE.007807.AND. 3 ID(1,N)/1000.NE.007545.AND.ID(1,N)/1000.NE.007550) THEN CALL GRIDB(KFILDO,ID(1,N),IDPARS(3,N),THRESH(N), 1 DATA,FD1,IS2(3),IS2(4),IER) ELSE CALL GRIDBM(KFILDO,ID(1,N),IDPARS(3,N),THRESH(N), 1 DATA,FD1,IS2(3),IS2(4),IER) ENDIF IF(IER.NE.0)THEN ISTOP(1)=ISTOP(1)+1 ISTOP(2)=ISTOP(2)+1 C AN ERROR IN GRIDB WILL HAVE CREATED A DIAGNOSTIC AND DATA C ARE RETURNED AS MISSING. LET IT PROCEED. ISTOP(2) IS C INCREMENTED HERE BECAUSE IT PROBABLY WON'T BE LATER. ENDIF C ENDIF C C SMOOTH FIELD IF DESIRED. C IF(IDPARS(14,N).EQ.0)GO TO 506 C IF(IDPARS(14,N).EQ.1)THEN CALL SMTH5 (KFILDO,DATA,FD1,IS2(3),IS2(4)) ELSEIF(IDPARS(14,N).EQ.2)THEN CALL SMTH9 (KFILDO,DATA,FD1,IS2(3),IS2(4)) C ELSEIF(IDPARS(14,N).EQ.3)THEN C C FOR LAMP MRMS/TL PREDICTORS USE SMT25M, WHICH CHECKS C FOR MISSING (9999) GRIDPOINT VALUES. OTHERWISE, USE C SMTH25. C IF(ID(1,N)/1000.NE.007801.AND.ID(1,N)/1000.NE.007807.AND. 1 ID(1,N)/1000.NE.007545.AND.ID(1,N)/1000.NE.007550) THEN C CALL SMTH25(KFILDO,DATA,FD1,IS2(3),IS2(4)) ELSE CALL SMT25M(KFILDO,DATA,FD1,IS2(3),IS2(4)) ENDIF C ELSEIF(IDPARS(14,N).EQ.4)THEN IF(ID(1,N)/1000.NE.007581.AND.ID(1,N)/1000.NE.007582.AND. 1 ID(1,N)/1000.NE.007647.AND.ID(1,N)/1000.NE.007648) THEN CALL SMTH2X(KFILDO,DATA,FD1,IS2(3),IS2(4)) ELSE C FOR LAMP TSTM RADAR AND LIGHTNING PREDICTORS USE C SMT2XM, WHICH CHECKS FOR MISSING (9999) GRIDPOINT C VALUES. CALL SMT2XM(KFILDO,DATA,IWORK,IS2(3),IS2(4)) ENDIF C ELSEIF(IDPARS(14,N).EQ.5)THEN CALL SMTH3X(KFILDO,DATA,FD1,IS2(3),IS2(4)) ENDIF C C PRINT GRIDPOINT VALUES IF DESIRED. TRY TO MATCH PRECISION C OF PRINTING TO SIZE OF VALUES THROUGH ISCALD( ). WHILE C THE LOOP IS INEFFICIENT, IT WILL BE EXECUTED VERY RARELY. C 506 IF(IP13.EQ.0)GO TO 510 IF(JP(1,N).EQ.0)GO TO 510 WRITE(IP13,207)(ID(J,N),J=1,4),NDATE C DO 509 JY=1,IS2(4) C IF(ISCALD(N).LE.-1)THEN WRITE(IP13,208)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) ELSEIF(ISCALD(N).EQ.0)THEN WRITE(IP13,2080)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) ELSEIF(ISCALD(N).EQ.1)THEN WRITE(IP13,2081)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) ELSEIF(ISCALD(N).EQ.2)THEN WRITE(IP13,2082)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) ELSE WRITE(IP13,2083)(DATA(K),K=(IS2(4)-JY)*IS2(3)+1, 1 (IS2(4)-JY)*IS2(3)+IS2(3)) ENDIF C 509 CONTINUE C C GRIDPRINT FIELD IF DESIRED. C 510 IF(IP14.EQ.0)GO TO 520 IF(JP(2,N).EQ.0)GO TO 520 C C GRIDPRINT WHEN DESIRED. C CALL PREDX1(KFILDO,IDPARS(1,N),THRESH(N), 1 SMULT(N),SADD(N),ORIGIN(N),CINT(N), 2 PLAIN(N),UNITS(N),NDATE,-IDPARS(9,N),DATA,ND5, 3 IS2,ND7,IP14,ISTOP(1),IER) C AN ERROR IN GRIDPRINTING IS TREATED AS AN ISTOP(1) ERROR. C NORMALLY, GRIDPRINTING WOULD BE DONE ONLY IN CHECKOUT. C IER NE 0 IN PREDX1 DOES NOT CAUSE MISSING DATA. C 520 XMISSP=9999. XMISSS=0. CALL PACKG(KFILDO,KFILGO,ID(1,N),IDPARS(1,N), 1 ISCALD(N),0,NGRIDC(1,NSLAB), 2 IPLAIN(1,1,N),PLAIN(N),NDATE,NYR,NMO,NDA,NHR, 3 FD1,DATA,ND2X3,IS2(3),IS2(4),IPACK,IWORK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS, 5 NWORDS,NTOTBG,NTOTRG, 6 L3264B,L3264W,ISTOP(1),IER) C NOTE THAT GRIDPOINT DATA TO PACK ARE IN DATA( ). GO TO 670 C C THE DATA ARE MISSING. SET ALL VALUES TO 9999. C 600 DO 610 K=1,NSTA SDATA(K)=9999. 610 CONTINUE C 612 ISTOP(2)=ISTOP(2)+1 C AN ATTEMPT IS MADE TO COUNT ALL MISSING FIELDS IN ISTOP(2), C EVEN IF AN ERROR HAS BEEN COUNTED IN ISTOP(1). NGOMIS=1 C SET NGOMIS = 1 TO KEEP FROM REUSING A GRID WITH C MISSING VALUES. XMISSP=9999. XMISSS=0. GO TO 660 C C SET XMISSP AND XMISSS. NOTE THAT ANY VALUES OF 9997 C IN VECTOR DATA HAVE BEEN SET TO PXMISS. C 9997 IS NOT EXPECTED OR DEALT WITH IN GRIDPOINT DATA. C OPTION SHOULD NOT RETURN 9997 UNLESS IT IS DESIRED C TO LEAVE THOSE VALUES IN THE OUTPUT. C 650 CALL SETMIS(KFILDO,SDATA,NSTA,XMISSP,XMISSS) C C PACK AND WRITE THE DATA. C 660 CALL PACKV(KFILDO,KFILIO,ID(1,N),IDPARS(1,N),JP(1,N),ISCALD(N),0, 1 IPLAIN(1,1,N),PLAIN(N),NDATE,NYR,NMO,NDA,NHR,CCALL, 2 ISDATA,SDATA,ND1,NSTA,IPACK,ND5,MINPK, 3 IS0,IS1,IS2,IS4,ND7,XMISSP,XMISSS, 4 IP15,NWORDS,NTOTBY,NTOTRC, 5 L3264B,L3264W,ISTOP(1),IER) 670 IF(INDEX(N).NE.1)GO TO 695 C IF(KFILIO.EQ.0)THEN WRITE(KFILDO,690)(ID(I,N),I=1,4),NDATE 690 FORMAT(/' ****VARIABLE ',I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 1 ' COMPUTED MORE THAN ONCE PROCESSING DATE',I11) ELSE WRITE(KFILDO,691)(ID(I,N),I=1,4),NDATE 691 FORMAT(/' ****VARIABLE ',I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 1 ' COMPUTED AND WRITTEN MORE THAN ONCE PROCESSING DATE', 2 I11) ENDIF C ISTOP(1)=ISTOP(1)+1 695 INDEX(N)=1 C 700 CONTINUE C 800 RETURN END