SUBROUTINE RDSTR7(KFILDO,KFIL10,KFILIN,MODNUM,NAMIN,JFOPEN, 1 LDATB,LDATE,LKHERE,MSDATE,ND6,NUMIN,NDATE, 2 ID,IDPARS,NPRED,ND4,NCEPNO, 3 IPACK,IWORK,DATA,CCALLD,ND5, 4 IS0,IS1,IS2,IS4,ND7, 5 LSTORE,LITEMS,MSTORE,MITEMS,INDEX,ND9,CORE,ND10, 6 NBLOCK,LASTL,LASTD,NSTORE,NGRIDC,ND11,NGRID, 7 CCALL,NAME,STALAT,STALON,SDATA,DIR, 8 INDEXC,ND1,NSTA,MINVEC,MINMOD, 9 PXMISS,IP10,IP12,IP23,L3264B,L3264W,ISTOP,IER) C C JULY 2004 GLAHN TDL MOS-2000 C ADAPTED FROM RDSTR6 FOR U155 C JULY 2004 GLAHN CHANGED LE TO GE ABOVE 1085 C JULY 2004 GLAHN ADDED 2 TO MINMOD HOURS TO SAVE C OCTOBER 2004 GLAHN ADDED PRINT OF LSTORE AT 4018 C OCTOBER 2004 GLAHN MODIFIED FOR DATES TO SAVE; ELIMINATED C MODELX C FEBRUARY 2007 GLAHN SWITCHED FILES WHEN TOO MANY READING C ERRORS AT 1103 C JUNE 2008 GLAHN ADDED NCEPNO TO CALL AND IN NCEPNO C VICE IDPARS(4,N) IN TEST C AUGUST 2008 GLAHN COMMENTS C MAY 2014 GLAHN DIMENSIONED NCEPNO(3) C C PURPOSE C TO OBTAIN FROM GRIDPOINT OR VECTOR TDLPACK SEQUENTIAL FILES C THE VARIABLES IN MSTORE( , ) AND TO WRITE THEM TO THE C MOS-2000 INTERNAL FILE SYSTEM WITH THEIR KEYS IN C LSTORE( , ). RDSTR7 PERFORMS ABOUT THE SAME PURPOSE FOR C ALL DAYS AFTER DAY 1 THAT RDSTR1 PERFORMS FOR DAY 1. C VECTOR DATA ARE UNPACKED AND ORDERED BY STATION; C GRIDPOINT DATA ARE STORED PACKED 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 KFILIN(J) - UNIT NUMBERS OF TDLPACK INPUT FILES. (INPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFIL10 = UNIT NUMBER OF TDL MOS-2000 INTERNAL RANDOM C ACCESS FILE SYSTEM. (INPUT) C KFILIN(J) = UNIT NUMBERS FOR INPUT DATA, ALL IN TDLPACK C FORMAT. INPUT CAN INCLUDE GRIDPOINT DATA, C PREDICTAND (OBSERVATIONS) DATA, VARIOUS C CONSTANTS, OR MOS FORECASTS (FOR 2ND GENERATION C MOS, POSSIBLY FOR LOCAL IMPLEMENTATION C (J=1,NUMIN). NUMBERS GE 80 ARE RESERVED FOR, C AND ARE TO BE USED FOR, VECTOR DATA. C (INPUT/OUTPUT) C MODNUM(J) = THE "MODEL" NUMBER CORRESPONDING TO KFILIN(J) C (J=1,NUMIN). THIS IS NEEDED TO MATCH WITH DD IN C THE VARIABLE ID'S FOR THE LOOKBACK FEATURE. C HOWEVER, FOR INPUT DATA THAT COULD HAVE COME C FROM A PREVIOUS RUN OF U201, THE VECTOR DATA C HAVE A MIXTURE OF DD'S, AND THE MODEL NUMBER C FOR ALL VECTOR DATA MUST BE ZERO. C (INPUT/OUTPUT) C NAMIN(J) = NAME OF THE INPUT FILES BEING PROCESSED C (J=1,NUMIN). (CHARACTER*60) (INPUT/OUTPUT) 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 LDATB(J) = BEGINNING DATE NEEDED FOR THE MODEL C CORRESPONDING TO NAMIN(J), ETC. (J=1,NUMIN). C THIS IS NOT OVERALL, BUT IS VALID FOR THIS DATE. C (INTERNAL-OUTPUT) C LDATE(J) = ENDING DATE NEEDED FOR THE MODEL CORRESPONDING C TO NAMIN(J), ETC. (J=1,NUMIN). THIS IS NOT C OVERALL, BUT IS VALID FOR THIS DATE. 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. (INTERNAL) C MSDATE(J) = KEEPS TRACK OF WHETHER ANY DATA ARE AVAILABLE C FOR A PARTICULAR DATE ON AN INPUT FILE C (J=1,NUMIN). THIS IS USED IN SWITCH. C (INTERNAL) C ND6 = THE MAXIMUM OF NUMIN. DIMENSION OF KFILIN( ), C MODNUM( ), JFOPEN( ), LDATB( ), LDATE( ), C LKHERE( ), AND MSDATE( ). ALSO SECOND DIMENSION C OF INDEXC( , ). (INPUT) C NUMIN = THE NUMBER OF VALUES IN KFILIN( ), MODNUM( ), C NAMIN( ), JFOPEN( ), LDATB( ), AND LDATE( ). C IN CASE THERE IS NO DD MATCHING A MODEL NUMBER IN C MODNUM( ), THE FILE IS ELIMINATED FROM THE LIST C IN KFILIN( ), MODNUM( ), NAMIN( ), AND JFOPEN( ) C AND NUMIN ADJUSTED DOWNWARD ACCORDINGLY. C (INPUT/OUTPUT) C NDATE = DATE IN FORM YYYYMMDDHH. (INPUT) C ID(J,N) = THE PREDICTOR ID'S (J=1,4) (N=1,NPRED). (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,NPRED). 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 NPRED = NUMBER OF ID'S IN ID( , ) AND IDPARS( , ). C (INPUT) C ND4 = THE MAXIMUM NUMBER OF VARIABLES IN ID( , ). 2ND C DIMENSION OF ID( , ) AND IDPARS( , ). (INPUT) C NCEPNO(J) = ORIGINALLY DESIGNED A SINGLE NCEP MODEL NUMBER C FOR THE RUN WHEN ONLY ONE GRIDDED DD WAS C EXPECTED. TO PROVIDE FOR UP TO 3 GRIDS THAT C MIGHT BE NEEDED IN MERGING LAMP AND HRRR OR RAP, C IT HAS BEEN DIMENSIONED NCEPNO(J) (J=1,3). C ONE VALUE IS READ IN, AND PARSED INTO THREE C VARIABLES IN INT155. VARIABLE READ AS XXYYZZ C AND PARSED INTO NCEPNO(1)=XX, NCEPNO(2)=YY, C AND NCEPNO(3)=ZZ. (JNPUT) C IPACK(J) = HOLDS THE TDLPACK RECORD (J=1,NWORDS). NWORDS C IS CALCULATED NWORDS=NBYTES*8/L3264B, WHERE C NBYTES IS THE LENGTH IN BYTES READ FROM THE C RECORD ITSELF. (INTERNAL) C IWORK(J) = ARRAY TO FURNISH TO SUBROUTINE UNPACK C (J=1,ND5). (INTERNAL) C DATA(J) = ARRAY TO FURNISH TO SUBROUTINE GSTORE AND UNPACK C (J=1,ND5). DATA( ) HOLDS UNPACKED VECTOR DATA. C (INTERNAL) C CCALLD(J) = CALL LETTERS AS READ FROM INPUT FILES (K=1,ND5) C (INTERNAL) C ND5 = DIMENSION OF IPACK( ), IWORK( ), DATA( ) AND. C CCALLD( ). (INPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,3). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,22+). 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 IS4( ). C NOT ALL LOCATIONS ARE USED. (INPUT) C LSTORE(L,J) = THE ARRAY TO HOLD 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. NOTE THAT WHEN A FIELD C CANNOT BE STORED IN CORE( ), IT IS PUT C ON DISK. IT MAY BE THAT A LATER FIELD C WILL FIT, AND IT IS PUT IN CORE( ). 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 --NSLAB, THE NUMBER OF THE SLAB IN C DIR( , ,L) AND IN NGRIDC( ,L) DEFINING C THE CHARACTERISTICS OF THIS GRID. C L=11 --THE NUMBER OF THE PREDICTOR IN THE SORTED C LIST IN ID( ,N) (N=1,NPRED) FOR WHICH C THIS VARIABLE IS NEEDED, WHEN IT IS C NEEDED ONLY ONCE FROM LSTORE( , ). WHEN C IT IS NEEDED MORE THAN ONCE, THE VALUE IS C SET = 7777. C L=12 --USED INITIALLY IN ESTABLISHING C MSTORE( , ). LATER USED AS A WAY OF C DETERMINING WHETHER TO KEEP THIS C VARIABLE. C (INPUT-OUTPUT) C LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , ) C THAT ARE CURRENTLY BEING USED. C MSTORE(L,J) = THE ARRAY HOLDING THE VARIABLES NEEDED AS INPUT, C AFTER DAY 1, AND ASSOCIATED INFORMATION (L=1,7) C (J=1,MITEMS). 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 C IT FOR. C L=6 --THE CYCLE TIME FOR WHICH THIS VARIABLE C IS NEEDED FOR THE DATE BEING PROCESSED. C A VARIABLE NEEDED FOR MORE THAN ONE C CYCLE TIME WILL HAVE AN ENTRY FOR EACH C CYCLE TIME NEEDED. C L=7 --THE MAXIMUM TIME OFFSET RR (SEE C IDPARS(9, ) CORRESPONDING TO MSTORE(6, ) C NOTE THAT MSTORE IN U201, PRED22, U150, AND C RDSTR7 IS NOT EXACTLY LIKE THAT IN U600 AND C RDVECT. U201 DOES NOT USE RDVECT. C (INPUT) C MITEMS = THE NUMBER OF ITEMS (COLUMNS) IN MSTORE( , ). C (INPUT) C INDEX(N) = USED TO KEEP TRACK OF WHICH VARIABLES HAVE C BEEN DEALT WITH FOR A PARTICULAR DATE. THIS C ALLOWS A DIAGNOSTIC IF A VARIABLE IN MSTORE( , ) C IS FOUND MORE THAN ONCE. (INTERNAL) C ND9 = THE SECOND DIMENSION OF LSTORE( , ) AND C MSTORE( , ). (INPUT) C CORE(J) = THE ARRAY TO STORE 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 NBLOCK = THE RECORD SIZE FOR THE FILE TO WRITE THE DATA C WHEN CORE( ) IS FULL. (INPUT) C LASTL = THE LAST LOCATION IN CORE( ) USED. C INITIALIZED TO 0 ON FIRST ENTRY TO GSTORE. C (INPUT/OUTPUT) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK. C (INPUT/OUTPUT) C NSTORE = RUNNING COUNT OF NUMBER OF TIMES DATA ARE C STORED BY GSTORE. INITIALIZED TO ZERO THE C FIRST TIME GSTORE IS CALLED. THE USER NEED C NOT WORRY ABOUT THIS. IT CAN BE USED FOR C DIAGNOSTICS IF NEEDED. (OUTPUT) C NGRIDC(L,M) = HOLDS THE GRID CHARACTERISTICS (L=1,6) FOR EACH C GRID COMBINATION (M=1,NGRID). C L=1--MAP PROJECTION NUMBER (3=LAMBERT, 5=POLAR C STEREOGRAPHIC). C L=2--GRID LENGTH IN METERS, C L=3--LATITUDE AT WHICH GRID LENGTH IS 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 ND11 = MAXIMUM NUMBER OF GRID COMBINATIONS THAT CAN BE C DEALT WITH ON THIS RUN. LAST DIMENSION OF C NGRIDC( , ). (INPUT) C NGRID = THE NUMBER OF GRID COMBINATIONS IN NGRIDC( , ), C MAXIMUM OF ND11. (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( ). (CHARACTER*8) C (OUTPUT) C NAME(K) = NAMES OF STATIONS (K=1,NSTA). USED FOR PRINTOUT C ONLY. (CHARACTER*20) (INPUT) C STALAT(K) = LATITUDE OF STATIONS (K=1,NSTA). (INPUT) C STALON(K) = LONGITUDE OF STATIONS (K=1,NSTA). (INPUT) C SDATA(J) = WORK ARRAY (J=1,NSTA). (INTERNAL) 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). (OUTPUT) 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. ALL VECTOR C DATA READ ARE KEYED TO THE STATION LIST; C DIR( , , ) IS USED ONLY FOR GRIDDED DATA. C INDEXC( , , ) IS NEEDED ONLY IN RDSTR1 AND RDSTR7. C (INTERNAL) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT C WITH. (INPUT) C NSTA = THE NUMBER OF STATIONS IN CCALL( , ). (INPUT) C MINVEC = THE MINIMUM NUMBER OF HOURS OF VECTOR DATA TO SAVE. C (INPUT) C MINMOD = THE MINIMUM NUMBER OF HOURS OF GRIDPOINT DATA C TO SAVE. (INPUT) 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. (INPUT) C IP10 = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF C FIELDS READ FOR THIS DAY WILL BE PRINTED TO UNIT C IP10 ALONG WITH THE FIRST AND LAST DATE/TIME C NEEDED FOR EACH FILE FOR DAY 1. (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 WRITTEN TO THE FILE WHOSE UNIT C NUMBER IS IP12. ALSO, WHETHER POSITIONS IN C RECORD(S) OF VECTOR DATA SOURCES OF THE STATIONS C WILL BE WRITTEN TO UNIT IP12. NOTE THAT BOTH C OF THESE PERTAIN ONLY TO THE DATA BEING SAVED C ACCORDING TO THE LOOKBACK FACILITY. IF THERE C IS A DIRECTORY RECORD IMMEDIATELY FOLLOWING THE C DATA FOR THE LAST DATE NEEDED, IT WILL HAVE BEEN C READ, AND THE POSITIONS PRINTED WILL REFER TO C THIS NEW DIRECTORY. (INPUT) C IP23 = INDICATES WHETHER (>0) OR NOT (=0) STATEMENTS C ABOUT EOF AND FILE OPENINGS AND CLOSINGS WILL C BE OUTPUT FOR PRINTING ON UNIT IP23. (INPUT) C L3264B = INTEGER WORD LENGTH OF MACHINE BEING USED. C (INPUT) C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2), C BASED ON L3464B. (INPUT) C ISTOP = INCREMENTED BY ONE EACH TIME AN ERROR IS C ENCOUNTERED. (INPUT-OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 38 = ND5 IS NOT LARGE ENOUGH TO HOLD DATA FROM C UNPACK. C 51 = ND11 IS ABOUT TO BE EXCEEDED (FROM GRCOMB). C 60 = MAP PROJECTION NUMBER NOT EXPECTED (FROM C DIRCMP VIA GRCOMB). C 127 = ALL INPUT DATA EXHAUSTED. C 138 = TOO MANY READING ERRORS. C SEE ROUTINE GSTORE FOR OTHER VALUES. C (INTERNAL-OUTPUT) C NBYTES = NUMBER OF BYTES IN RECORD, FOLLOWING THE INITIAL C 64 BITS CONTAINING NBYTES ITSELF. (INTERNAL) C NWORDS = NUMBER OF WORDS IN IPACK( ). NWORDS IS C CALCULATED NWORDS=NBYTES*8/L3264B, WHERE NBYTES C IS THE LENGTH IN BYTES READ FROM THE RECORD C ITSELF. (INTERNAL) C INCDTL = THE INCREMENT IN HOURS OF THE FIRST DATE TO USE C WITH REFERENCE TO THE CYCLE DATE/TIME IN NDATE. C USED TO COMPUTE LDATB( ). (INTERNAL) C INCDTH = THE INCREMENT IN HOURS OF THE LAST DATE TO USE C WITH REFERENCE TO THE CYCLE DATE/TIME IN NDATE. C USED TO COMPUTE LDATE( ). (INTERNAL) C ICOUNT = COUNT OF FILES NOT NEEDED AND CLOSED. C (INTERNAL) C MSTA = THE NUMBER OF STATIONS READ FROM A VECTOR FILE. 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 IN CASE ISTOP HAS TO BE LARGE WHEN DEALING C WITH HOURLY DATA AND MISSING STATIONS. C IFIRST = COUNTS TIMES WRITING OF DATES NEEDED. C (INTERNAL) C IFRTOT = TOTAL TIMES WRITING OF DATES NEEDED WILL BE C DONE. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C UNPACK, GSTORE, UPDAT, GRCOMB C CHARACTER*8 CCALL(ND1,6), 1 CCALLD(ND5) CHARACTER*20 NAME(ND1) CHARACTER*60 NAMIN(ND6) C DIMENSION SDATA(ND1),STALAT(ND1),STALON(ND1) DIMENSION DIR(ND1,2,ND11) DIMENSION ID(4,ND4),IDPARS(15,ND4) DIMENSION IPACK(ND5),IWORK(ND5),DATA(ND5) DIMENSION KFILIN(ND6),MODNUM(ND6),JFOPEN(ND6), 1 LDATB(ND6),LDATE(ND6),LKHERE(ND6),MSDATE(ND6) DIMENSION INDEXC(ND1,ND6) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9),MSTORE(7,ND9),INDEX(ND9) DIMENSION CORE(ND10) DIMENSION NGRIDC(6,ND11) DIMENSION NBYTES(2),NCEPNO(3) C DATA LSTOP/500/, 1 LSTOPC/0/ DATA IFIRST/0/, 1 IFRTOT/2/ C IER=0 D WRITE(KFILDO,100)NDATE,NUMIN,(JFOPEN(IN),IN=1,NUMIN) D100 FORMAT(/' IN RDSTR7 AT 100--NDATE,NUMIN,(JFOPEN(IN),IN=1,NUMIN)', D 1 I12,(50I2)) C C ZERO THE ARRAY THAT INDICATES VARIABLES HAVE BEEN DEALT WITH. C DO 101 N=1,MITEMS INDEX(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 800 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 C NDATE. THIS IS DONE EVEN FOR FILES NOT OPEN IN CASE ONE OR C MORE HAS TO BE OPENED DURING PROCESSING; FILES ALREADY CLOSED C ARE NOT CONSIDERED. C DO 105 IN=1,NUMIN MSDATE(IN)=0 IF(JFOPEN(IN).EQ.0)GO TO 105 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 IF(MODNUM(IN).GT.0)THEN C C THIS SAVES A MINIMUM OF (A) MINMOD OR (B) RR HOURS OF C GRIDPOINT DATA. C IF(MODNUM(IN).EQ.NCEPNO(1).OR. 1 MODNUM(IN).EQ.NCEPNO(2))THEN INCDTL=MIN(INCDTL,-IDPARS(9,N),-MINMOD) INCDTH=MAX(INCDTH,-IDPARS(9,N),-MINMOD) C***4/28/15 NOT SURE WHY THIS DOES NOT INCLUDE NCEPNO(3). ENDIF C C THIS SAVES A MINIMUM OF MINVEC HOURS OF VECTOR DATA C FROM ANY SOURCE. A ZERO DD WILL BE PRESENT IN ID(1, ) C FOR OBS. PRESUMABLY, RR WILL NOT PLAY A ROLE HERE, C ALTHOUGH THE ID COULD CONTAIN A NON-ZERO VALUE. C ELSE INCDTL=MIN(INCDTL,-MINVEC) INCDTH=MAX(INCDTH,-MINVEC) C ENDIF 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 THIS C DATE/TIME. 105 CONTINUE C C THE BEGINNING AND ENDING DATES NEEDED FOR EACH MODEL WILL C BE PRINTED A MAXIMUM OF IFRTOT TIMES. C ICOUNT=0 C DO 108 IN=1,NUMIN C IF(IFIRST.LT.IFRTOT*NUMIN)THEN C IF(JFOPEN(IN).EQ.0)GO TO 108 C IF(ICOUNT.EQ.0)THEN C IF(IP10.NE.0)THEN WRITE(IP10,106)NDATE 106 FORMAT(/' BEGINNING AND ENDING DATES FOR EACH MODEL', 1 ' FOR DATE',I11) ENDIF C ICOUNT=ICOUNT+1 C ENDIF C IF(IP10.NE.0)THEN WRITE(IP10,107)MODNUM(IN),KFILIN(IN),LDATB(IN), 1 LDATE(IN) 107 FORMAT(' MODEL NO.',I3,' ON UNIT NO.',I3,2I12) IFIRST=IFIRST+1 ENDIF C ENDIF C 108 CONTINUE C IF(IFIRST.EQ.IFRTOT*NUMIN.AND.IP10.NE.0)THEN WRITE(IP10,1085) 1085 FORMAT(' THIS DIAGNOSTIC WILL NOT PRINT AGAIN.') IFIRST=IFIRST+100 C IFIRST INCREASED MORE THAN 1 TO KEEP FROM PRINTING AGAIN. ENDIF 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 C RECORD. AN EOF MAY BE REACHED HERE FOR GRIDPOINT DATA. FOR C VECTOR 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 RDSTR7 AT 1102, IOSTAT =',I5/ 2 ' FILE = ',A60) ISTOP=ISTOP+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 ' SWITCHING FILES IN RDSTR7 AT 1103.') IER=138 LSTOPC=0 C THIS ALLOWS ROUTINE TO PROCEED AND SWITCH RECORDS. GO TO 1108 C C AT THIS POINT THERE HAS BEEN A GOOD READ, AND DATA ARE IN C IPACK( ). 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 RDSTR7 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=ISTOP+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) C C THIS SECTION SWITCHES FILES. FOR GRIDPOINT DATA, JUST C GO TO 400 FOR THE NEXT FILE READING. FOR VECTOR DATA, C HAVE TO READ THE DIRECTORY, ETC. C 1108 CALL SWITCH(KFILDO,IN,KFILIN,NAMIN,JFOPEN,LKHERE,MSDATE, 1 NUMIN,ND6,NDATE,IRD,IP23,ISTOP,IER) IF(IER.NE.0)GO TO 800 C CHANGE MADE HERE 8/19/01 FROM GO TO 400 TO GO TO 800 C ISTOP INCREMENTED IN SWITCH ON ERROR. IF(IRD.EQ.0)GO TO 400 C IRD = 1 WHEN DIRECTORY RECORD MUST BE READ. 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=ISTOP+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 RDSTR7 AT 1111,', 2 ' IOSTAT =',I5/ 3 ' FILE = ',A60) ISTOP=ISTOP+1 1114 LKHERE(IN+1)=0 JFOPEN(IN+1)=0 ENDIF C GO TO 400 C C GOOD READ OF DATA, AND IDATE HOLDS DATE OF DATA, OR C 9999 FOR A TRAILER RECORD. 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=ISTOP+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 C GOOD READ OF DATA, AND IDATE HOLDS DATE OF DATA. 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. D WRITE(KFILDO,1156)KFILIN(IN),NDATE D1156 FORMAT(' BACKSPACING INPUT FILE ON UNIT NO.',I3, D 1 ' PROCESSING DATE',I11,' IN RDSTR7 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 C********************************************************** C C THIS SECTION FOR A 32-BIT MACHINE. C C********************************************************** C 1157 DO 116 M=KSTART,KEND 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*** WRITE(KFILDO,1158)(IPACK(JJJ),JJJ=6,9),JCYL C*** 1158 FORMAT(' AT 1158 IN RDSTR7--(IPACK(JJJ),JJJ=6,9),JCYL', C*** 1 4I10,I16) 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 N=M C IF(INDEX(N).EQ.IDATE)THEN WRITE(KFILDO,1159)(MSTORE(J,M),J=1,4),NDATE 1159 FORMAT(/' ****VARIABLE ',I9.9,1X,I9.9,1X,I9.9,1X, 1 I10.3,' ENCOUNTERED ON INPUT MORE THAN ONCE', 2 ' FOR DATE',I11) GO TO 116 ENDIF C C WHEN THE ABOVE TEST IS MET, THE VARIABLE HAS ALREADY C BEEN FOUND. THIS CAN HAPPEN WHEN A PREVIOUS RUN OF U201 C IS INPUT, AS WELL AS THE INPUT TO THE PREVIOUS U201 RUN. 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=KEND+1 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 C********************************************************** C C THIS SECTION FOR A 64-BIT MACHINE. C C********************************************************** 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. 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=M C IF(INDEX(N).EQ.IDATE)THEN WRITE(KFILDO,1159)(MSTORE(J,M),J=1,4),NDATE GO TO 1165 ENDIF C C WHEN THE ABOVE TEST IS MET, THE VARIABLE HAS ALREADY C BEEN FOUND. THIS CAN HAPPEN WHEN A PREVIOUS RUN OF U201 C IS INPUT, AS WELL AS THE INPUT TO THE PREVIOUS U201 RUN. C IF(IDATE.EQ.NDATE)THEN GO TO 117 ELSE CALL UPDAT(IDATE,MSTORE(7,M),NEWDAT) IF(NEWDAT.GE.NDATE)GO TO 117 ENDIF C ENDIF C 1165 CONTINUE C IF(KSTART.EQ.1)THEN KSTART=KEND+1 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********************************************************** C C THE DATA ARE NEEDED. UNPACK THE ID'S, WHICH ARE NEEDED C FOR STORING THE DATA. C C********************************************************** 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. C C UNPACK ID'S ONLY. C CALL UNPACK(KFILDO,IPACK,IWORK,DATA,ND5, 1 IS0,IS1,IS2,IS4,ND7,MISSP,MISSS,1,L3264B,IER) 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=ISTOP+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, 395, OR 800. C 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=ISTOP+1 C AN ERROR IN GRCOMB WILL HAVE CREATED A DIAGNOSTIC. GO TO 800 C IER NE 0 IS TREATED AS FATAL IN RDSTR7 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 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. LSIZE IS THE SIZE OF C THE PACKED RECORD IN WORDS. C IF(IER.NE.0)THEN ISTOP=ISTOP+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. C GO TO 395 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 395. 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 RDSTR7 AT 1182. INCREASE TO GE',I6/ 2 ' READING ON UNIT NO.',I3, 3 ' PROCESSING DATE',I11,' FILE = ',A60) IER=38 C DATA( ) IS NOT LARGE ENOUGH. IT WILL NOT HAVE C BEEN OVERFLOWED, BUT WILL CONTAIN THE MISSING C INDICATOR. C ISTOP=ISTOP+1 C DATA ARE NOT 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. C IF(IER.NE.0)THEN ISTOP=ISTOP+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 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, NSTA WORDS FROM SDATA( ). C IF(IER.NE.0)THEN ISTOP=ISTOP+1 C AN ERROR IN GSTORE WILL HAVE CREATED A DIAGNOSTIC. GO TO 110 ENDIF C C THIS VARIABLE HAS BEEN STORED. C C*********************************************************** C C END OF VECTOR SECTION ONLY. C C*********************************************************** C 395 INDEX(N)=IS1(8) N=N+1 GO TO 110 C 396 WRITE(KFILDO,397)IER,NDATE 397 FORMAT(/' ****ERROR IN UNPKBG IN RDSTR7. IER =',I4, 1 ', PROCESSING DATE',I11) ISTOP=ISTOP+1 C UNPKBG DOES NOT CREATE A DIAGNOSTIC. GO TO 110 C 400 CONTINUE C C VARIABLES HAVE BEEN STORED WITH KEYS IN LSTORE( , ). C OUTPUT DIAGNOSTIC IF NO DATA AVAILABLE ON A PARTICULAR C INPUT FILE. 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 WRITE(KFILDO,401)KFILIN(J),NDATE,NAMIN(J) 401 FORMAT(/' NO DATA AVAILABLE FOR READING FOR FILE ON', 1 ' UNIT NO.',I4,' PROCESSING DATE',I11, 2 '. PROBABLY THE DATA WERE PREVIOUSLY READ.'/ 2 ' FILE = ',A60) C NOTE THAT THIS OUTPUT IS PROVIDED ONLY WHEN AN END OF C FILE HAS NOT BEEN REACHED. ENDIF C 4015 CONTINUE C IF(IP10.NE.0)THEN WRITE(IP10,4018)LITEMS,NDATE,((LSTORE(J,K),J=1,12),K=1,LITEMS) 4018 FORMAT(/' ',I4,' FIELDS IN LSTORE FOR NDATE ',I10,/, 1 (' ',3I10.9,I11.3,2I8,I3,I12,2I3,I5,I12)) ENDIF C C C OUTPUT DIAGNOSTIC IF ALL DATA HAVE BEEN EXHAUSTED. C DO 402 J=1,NUMIN IF(LITEMS.NE.0.OR. 1 MSDATE(J).NE.0.OR. 2 LKHERE(J).NE.0)GO TO 800 402 CONTINUE C WRITE(KFILDO,403)NDATE 403 FORMAT(/' ****ALL INPUT DATA EXHAUSTED LOOKING FOR DATE',I11,'.') IER=127 ISTOP=ISTOP+1 C 800 RETURN END