SUBROUTINE RDSTR1(KFILDO,KFIL10,KFILIN,MODNUM,NAMIN,JFOPEN, 1 LDATB,LDATE,LKHERE,ND6,NUMIN,NDATE, 2 ID,IDPARS,NPRED,ND4,NCEPNO, 3 IPACK,IWORK,DATA,CCALLD,ND5, 4 IS0,IS1,IS2,IS4,ND7, 5 LSTORE,LITEMS,ND9,NBLOCK,CORE,ND10, 6 LASTL,LASTD,NSTORE,NGRIDC,ND11,NGRID,IP10, 7 CCALL,NAME,STALAT,STALON,SDATA,DIR, 8 INDEXC,ND1,NSTA,MINVEC,MINMOD, 9 PXMISS,IP12,IP23,L3264B,L3264W,ISTOP,IER) C C JUNE 2004 GLAHN TDL MOS-2000 C MODIFIED FOR U155 FROM RDSTR2 C JULY 2004 GLAHN ADDED 2 TO MINMOD HOURS TO SAVE C SEPTEMBER 2004 GLAHN MODIFIED FOR DATES TO SAVE C OCTOBER 2004 GLAHN MODIFIED FOR DATES TO SAVE C DECEMBER 2004 GLAHN REMOVED ITIME C AUGUST 2005 GLAHN A FEW CHANGES TO GET A MORE C UNDERSTANDABLE PATTERN OF FILE USE C JULY 2006 GLAHN MODIFIED FORMAT 159 C SEPTEMBER 2006 GLAHN CHANGED MINMOD TO MINVEC IN PURPOSE C MARCH 2007 GLAHN SWITCHED FILES WHEN TOO MANY READING C ERRORS AT 203 C APRIL 2007 SMB ADDED COMMA TO FORMAT 159 FOR IBM C COMPILE C MAY 2008 GLAHN MODIFIED FORMAT 233 C JUNE 2008 GLAHN ADDED NCEPNO TO CALL AND IN NCEPNO C VICE IDPARS(4,N) IN TEST AND 162 C JUNE 2008 GLAHN REMOVED BELOW 240 C "IF(JFOPEN(IN).EQ.0)GO TO 245" C AUGUST 2008 GLAHN COMMENTS C MAY 2009 GLAHN COMMENTS C SEPTEMBER 2013 GLAHN CHANGED I4 TO I6 IN STATEMENT 229; C LIMITED STORING BY TAU C MAY 2014 GLAHN ADDED DIAGNOSTIC 1954 C MAY 2014 GLAHN DIMENSIONED NCEPNO(3) C JUNE 2019 GLAHN/SCALLION MAXMVS WAS NEVER INITIALIZED, C SET IT TO 0. C C PURPOSE C TO READ PACKED DATA FROM ALL GRIDPOINT AND VECTOR SOURCES C NEEDED FOR THE FIRST DAY, EXCEPT CONSTANT DATA, C AND TO STORE ALL FIELDS. GRIDPOINT AND VECTOR DATA C MUST BE TREATED SOMEWHAT DIFFERENTLY. MODIFIED TO C RESTRICT PROJECTIONS OF FIELDS STORED TO THOSE C NEEDED; IT WAS ASSUMED PROJECTIONS 6 HOURS ON EITHER C SIDE OF THE ANALYSES BEING RUN WERE SUFFICIENT. C C FOR GRIDPOINT DATA: C EACH DATA SOURCE MUST BE READ WITH A UNIT NUMBER LT 80. C THE DATA ARE STORED AS READ, INCLUDING THE TDLPACK C SECTIONS. ALSO, THE GRID LOCATIONS OF THE STATIONS C ARE COMPUTED FOR ALL GRIDS ENCOUNTERED. THE FIRST C DATE/TIME SAVED FOR A PARTICULAR MODEL IS CALCULATED C BASED ON DAY 1 NDATE MINUS EITHER (A) THE MAXIMUM RUN TIME C OFFSET RR FOR THAT PARTICULAR MODEL OF ANY VARIABLE C INDICATING THAT MODEL, AND (B) MINMOD, WHICHEVER IS EARLIER. C ALL ID'S NEED A MODEL NUMBER DD TO ASSOCIATE WITH THE C MODEL NUMBER IN MODNUM( ) FOR THE LOOKBACK FEATURE. C THIS KEEPS DATA FROM ALL MODELS, IN CASE MODELS ARE C MIXED, FROM BEING SAVED IN CASE RR IS DIFFERENT FOR C THE DIFFERENT MODELS. IF IT IS DISCOVERED THAT, C WHEN KFILIN( ) NE 0, NO VARIABLE DD MATCHES THE MODEL C NUMBER MODNUM( ), THAT UNIT IS CLOSED. C C FOR VECTOR DATA: C EACH DATA SOURCE MUST BE READ WITH A UNIT NUMBER GE 80. C THERE IS USUALLY NO MODEL NUMBER ASSOCIATED WITH AN C INPUT SOURCE, BUT CCC = 2XX (MOS FORECASTS) HAS DD NE 0. C A DIRECTORY RECORD IS READ INITIALLY AND AFTER ANY C ENCOUNTER OF A TRAILER RECORD. THE DATA MUST BE C UNPACKED AND ASSOCIATED WITH THE CURRENTLY RESIDENT C DIRECTORY FOR THAT DATA SOURCE. THE DATA ARE THEN C STORED UNPACKED FOR THOSE LOCATIONS (STATIONS) C IN CCALL( , ). THE LOOKBACK FEATURE APPLIES TO ALL C VECTOR SOURCES EQUALLY, IN DISTINCTION TO GRIDPOINT C SOURCES FOR WHICH LOOKBACK APPLIES TO EACH SOURCE C (MODEL) SEPARATELY. FOR THE LOOKBACK FEATURE, WHEN C THE DD IN ID( ) IS = 0, AND THE UNIT NUMBER IS GE 80, C RR IS APPLIED TO ALL SUCH INPUTS TOGETHER. THIS MEANS C THAT SPECIFIC MODELS CAN BE DEALT WITH INDEPENDENTLY, C BUT VECTOR DATA ARE GROUPED TOGETHER. A MINIMUM OF C MINVEC HOURS OF DATA ARE SAVED FOR POSSIBLE BACKUP. C THIS PROVIDES MINVEC HOURS OF DATA FOR BACKUP IN CASE C THE ANALYSIS PROGRAM NEEDS THEM. 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 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 KFILIN(J) = UNIT NUMBERS FOR INPUT DATA, ALL IN TDLPACK C FORMAT. INPUT CAN INCLUDE GRIDPOINT (TAPES) C DATA, 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. (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 ND6 = THE MAXIMUM OF NUMIN. DIMENSION OF KFILIN( ), C MODNUM( ), 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 C OVERALL, BUT IS VALID FOR DAY 1. 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 DAY 1. 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 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 = DAY 1 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 PREDICTOR C ID'S CORRESPONDING TO ID( ,N) (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 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 NPRED = NUMBER OF ID'S IN ID( , ) AND IDPARS( , ). (INPUT) C ND4 = THE MAXIMUM NUMBER OF PREDICTORS FOR WHICH C INTERPOLATED VALUES CAN BE PROVIDED. 2ND DIMENSION C 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. (INPUT) C IPACK(J) = HOLDS THE TDLPACK RECORD (J=1,NWORDS). NWORDS C IS CALCULATED NWORDS=NBYTES*8/L3264B, WHERE NBYTES C IS THE LENGTH IN BYTES READ FROM THE RECORD ITSELF. C (INTERNAL) C IWORK(J) = ARRAY TO FURNISH TO SUBROUTINE UNPACK C (J=1,ND5). HOWEVER, IT SHOULD NOT ACTUALLY BE C USED BECAUSE ONLY THE ID'S ARE UNPACKED INTO C IS0( ), IS1( ), IS2( ), AND IS4( ). (INTERNAL) C DATA(J) = ARRAY TO FURNISH TO SUBROUTINE GSTORE AND UNPACK C (J=1,ND5). HOWEVER, IT SHOULD NOT ACTUALLY BE C USED BECAUSE ONLY THE ID'S ARE UNPACKED INTO C IS0( ), IS1( ), IS2( ), AND IS4( ). (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). (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 LSTORE(L,J) = THE ARRAY TO HOLD INFORMATION ABOUT THE DATA C STORED (L=1,12) (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. 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 DIR( , ,L) C AND IN NGRIDC( ,L) DEFINING THE CHARACTERISTICS C OF THIS GRID. C L=11 --THE NUMBER OF THE PREDICTOR IN THE SORTED C LIST IN ID( ,N) (N=1,NPRED) FOR WHICH THIS C VARIABLE IS NEEDED, WHEN IT IS NEEDED ONLY C ONCE FROM LSTORE( , ). WHEN IT IS NEEDED C MORE THAN ONCE, THE VALUE IS SET = 7777. C L=12 --USED INITIALLY IN ESTABLISHING MSTORE( , ). C LATER USED AS A WAY OF DETERMINING WHETHER C TO KEEP THIS VARIABLE. C LITEMS = THE NUMBER OF ITEMS (COLUMNS) IN LSTORE( , ) THAT C HAVE BEEN USED IN THIS RUN. INITIALIZED TO ZERO C AT BEGINNING. C ND9 = 2ND DIMENSION OF LSTORE( , ). (INPUT) C NBLOCK = THE RECORD SIZE FOR THE FILE TO WRITE THE DATA C WHEN CORE( ) IS FULL. (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. (OUTPUT) C ND10 = DIMENSION OF CORE( ). (INPUT) C LASTL = THE LAST LOCATION IN CORE( ) USED. INITIALIZED TO 0 C ON FIRST ENTRY TO GSTORE. (INPUT/OUTPUT) C LASTD = TOTAL NUMBER OF PHYSICAL RECORDS ON DISK. C (INPUT/OUTPUT) 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. C IT CAN BE USED FOR DIAGNOSTICS IF NEEDED. C (OUTPUT) C NGRIDC(L,M) = HOLDS THE GRID CHARACTERISTICS (L=1,6) FOR EACH GRID C COMBINATION (M=1,NGRID). C L=1--MAP PROJECTION NUMBER (3=LAMBERT, 5=POLAR C ND11 = MAXIMUM NUMBER OF GRID COMBINATIONS THAT CAN BE C STEREOGRAPHIC, 7=MERCATOR). 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, AND C L=6--LONGITUDE OF LL CORNER IN DEGREES *10000. 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 IP10 = INDICATES WHETHER (>1) OR NOT (=0) THE LIST OF C FIELDS READ FOR DAY 1 WILL BE PRINTED TO UNIT IP10 C ALONG WITH THE FIRST AND LAST DATE/TIME C NEEDED FOR EACH FILE FOR DAY 1. (INPUT) 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( ) AND CCALLP( ). (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 NGRIDC( ,M). C (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 WITH. C (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 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. (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 ENCOUNTERED. C (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 = RETURN FROM GRCOMB WHEN ND11 IS ABOUT TO BE C EXCEEDED. C 55 = NO PREDICTOR MODEL NUMBER NCEPNO EQUALS C A DATASET MODEL NUMBER INPUT. C 56 = NO FIELDS FOUND FOR DAY 1. C 60 = MAP PROJECTION NUMBER NOT EXPECTED (FROM DIRCMP). C SEE ROUTINE GSTORE FOR OTHER VALUES. (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 CALCULATED C NWORDS=NBYTES*8/L3264B, WHERE NBYTES IS THE LENGTH C IN BYTES READ FROM THE RECORD 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. (INTERNAL) C MSTA = THE NUMBER OF STATIONS READ FROM A VECTOR FILE. C (INTERNAL) C ISTAV = INDICATES WHETHER (=1) OF NOT (=0) THE VARIABLE C IS A VECTOR. ISTAV IS ASSOCIATED WITH NSLAB C STORED BY GSTORE AND RETRIEVED BY GFETCH. C WHEN NSLAB NE 0, IT IS A SLAB NUMBER FOR A GRID. C WHEN IT IS 0, IT IS NOT A GRID. (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 NUMINX = INITAL VALUE OF NUMIN. USED TO CONTROL PRINT. 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 (AUTOMATIC) (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) C MSDATE( ) IS AN AUTOMATIC VARIABLE. DIMENSION INDEXC(ND1,ND6) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION NGRIDC(6,ND11) DIMENSION NBYTES(2),NCEPNO(3) C DATA LSTOP/500/, 1 LSTOPC/0/ DATA IFIRST/1/ C CALL TIMPR(KFILDO,KFILDO,'START RDSTR1 ') IER=0 LITEMS=0 ICOUNT=0 NUMINX=NUMIN MAXMVT=MAX(MINVEC,MINMOD) C MAXMVT IS THE MAXIMUM OF BACKUP HOURS TO SAVE. MAXMVS=0 C C INITIALIZE LKHERE( ). C DO 120 IN=1,NUMIN LKHERE(IN)=1 120 CONTINUE C C DETERMINE DATE RANGE OF DATA FOR EACH MODEL FOR THE FIRST DATE. C THIS IS DONE EVEN FOR FILES NOT OPEN IN CASE ONE OR MORE HAS C TO BE OPENED DURING PROCESSING OF DAY 1. C DO 170 IN=1,NUMIN 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 160 N=1,NPRED C C TAKE CARE OF DATA WITH SPECIFIC MODEL NUMBERS C THAT MATCH MODNUM(IN). C IF(KFILIN(IN).LT.80)THEN C C THIS SAVES A MINIMUM OF (A) MINMOD OR (B) RR HOURS OF C GRIDPOINT DATA. C IF(MODNUM(IN).EQ.NCEPNO(3))THEN INCDTL=MIN(INCDTL,-IDPARS(9,N),-MINMOD) INCDTH=MAX(INCDTH,-IDPARS(9,N),-MINMOD) ELSEIF(MODNUM(IN).EQ.NCEPNO(1).OR. 1 MODNUM(IN).EQ.NCEPNO(2))THEN INCDTL=MIN(INCDTL,-IDPARS(9,N),-MINVEC) INCDTH=MAX(INCDTH,-IDPARS(9,N),-MINVEC) C***4/28/15 THE ABOVE SHOULD BE UA DATA, SO IT SEEMS MINVEC SHOULD BE C*** MINMOD. ENDIF ELSE C C THIS SAVES A MINIMUM OF MINVEC HOURS OF C VECTOR DATA FROM ANY SOURCE. A ZERO DD WILL BE C PRESENT IN ID(1, ) FOR OBS. PRESUMABLY, RR WILL C NOT PLAY A ROLE HERE, ALTHOUGH THE ID COULD C CONTAIN A NON-ZERO VALUE. WHEN KFILIN( ) GE 80, C MODNUM( ) SHOULD = 0. C IF(MODNUM(IN).EQ.0)THEN INCDTL=MIN(INCDTL,-MINVEC) INCDTH=MAX(INCDTH,-MINVEC) ELSE WRITE(KFILDO,159)MODNUM(IN),KFILIN(IN) 159 FORMAT(/' ****MODNUM(IN) = ',I4,' ON KFILIN(IN) =',I4, 1 ' DOES NOT = 0 FOR KFININ(IN)', 2 ' GE 80. PROCEEDING.') ISTOP=ISTOP+1 ENDIF C ENDIF C 160 CONTINUE C IF(INCDTL.EQ.9999)THEN WRITE(KFILDO,162)IN,MODNUM(IN) 162 FORMAT(/' ****NO PREDICTOR MODEL NUMBER NCEPNO', 1 ' MATCHES MODEL INPUT NUMBER MODNUM(',I2,') = ',I2,'.') IER=55 ISTOP=ISTOP+1 C SINCE THIS FILE IS NOT NEEDED, IT IS CLOSED AND REFERENCE C TO IT IS ELIMINATED BELOW. FILES WITH MODEL DATA C (DD NE 0) MAY BE CLOSED. SELDOM IF EVER WILL A FILE C HOLDING OBSERVATIONAL DATA BE CLOSED. CLOSE(KFILIN(IN)) IF(IP23.NE.0)WRITE(IP23,163)KFILIN(IN) 163 FORMAT(' UNIT NO.',I3,' BEING CLOSED IN RDSTR1.') KFILIN(IN)=0 ICOUNT=ICOUNT+1 INCDTL=0 ENDIF C 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 THE C FIRST AND LAST DATE/TIMES, RESPECTIVELY, NEEDED FOR DAY 1. 170 CONTINUE C IF(ICOUNT.EQ.0)GO TO 190 C C ELIMINATE THE FILES NOT NEEDED. C 172 DO 180 IN=1,NUMIN IF(KFILIN(IN).GT.0)GO TO 180 IF(IN.EQ.NUMIN)GO TO 176 C DO 175 J=IN+1,NUMIN KFILIN(J-1)=KFILIN(J) MODNUM(J-1)=MODNUM(J) JFOPEN(J-1)=JFOPEN(J) NAMIN(J-1)=NAMIN(J) LDATB(J-1)=LDATB(J) LDATE(J-1)=LDATE(J) 175 CONTINUE C 176 NUMIN=NUMIN-1 IF(NUMIN.GT.0)GO TO 172 GO TO 250 180 CONTINUE C 190 CONTINUE C IF(NUMIN.EQ.0)GO TO 194 C C LIMIT STOTING DATA TO A MINIMUM AND MAXIMUM PROJECTION TAU. C MAXTAU=0 MINTAU=0 C DO 1905 N=1,NPRED MAXTAU=MAX(MAXTAU,IDPARS(12,N)) MINTAU=MIN(MINTAU,IDPARS(12,N)) 1905 CONTINUE IF(IP10.EQ.0)GO TO 194 WRITE(IP10,191)MINTAU,MAXTAU 191 FORMAT(/' BEGINNING AND ENDING DATES FOR EACH MODEL FOR DAY 1', 1 ', MINIMUM AND MAXIMUM PROJECTIONS OF ANALYSES =',2I4) C DO 193 IN=1,NUMIN IF(JFOPEN(IN).EQ.0)GO TO 193 WRITE(IP10,192)MODNUM(IN),KFILIN(IN),LDATB(IN),LDATE(IN) 192 FORMAT(' MODEL NO.',I3,' ON UNIT NO.',I3,2I12) 193 CONTINUE C C START PROCESSING DAY 1 DATA C 194 DO 220 IN=1,NUMIN C IF(IN.EQ.1)THEN WRITE(KFILDO,1940) 1940 FORMAT(' ') ENDIF C IF(JFOPEN(IN).NE.1)GO TO 220 C READ ONLY OPEN FILES. C C CHECK CONSISTENCY OF MODEL NUMBER MODNUM(IN) AND C FILE UNIT NUMBER KFILIN(IN), AND FURNISH DIAGNOSTIC C CONCERNING PROCESSING. C IF(KFILIN(IN).LT.80)THEN C C THIS IMPLIES GRIDPOINT DATA. C IF(MODNUM(IN).EQ.0)THEN WRITE(KFILDO,1941)MODNUM(IN),KFILIN(IN) 1941 FORMAT(/' ****MODEL NUMBER =',I3,' IMPLIES VECTOR DATA', 1 ' BUT UNIT NUMBER =',I3,' IMPLIES GRIDPOINT DATA.', 2 ' PROCEEDING, BUT AN ERROR IS LIKELY.') ISTOP=ISTOP+1 GO TO 1947 ELSE C IF(IFIRST.NE.1)THEN WRITE(KFILDO,1942) 1942 FORMAT(' ') ENDIF C WRITE(KFILDO,1943)KFILIN(IN) 1943 FORMAT(' PROCESSING GRIDPOINT DATA ON UNIT NUMBER =',I3) IFIRST=0 ENDIF C ELSE C C THIS IMPLIES VECTOR DATA. C IF(MODNUM(IN).NE.0)THEN WRITE(KFILDO,1945)MODNUM(IN),KFILIN(IN) 1945 FORMAT(/' ****MODEL NUMBER =',I3,' IMPLIES GRIDPOINT DATA', 1 ' BUT UNIT NUMBER =',I3,' IMPLIES VECTOR DATA.', 2 ' PROCEEDING, BUT AN ERROR IS LIKELY.') ISTOP=ISTOP+1 GO TO 1947 ELSE C IF(IFIRST.NE.1)THEN WRITE(KFILDO,1942) ENDIF C WRITE(KFILDO,1946)KFILIN(IN) 1946 FORMAT(' PROCESSING VECTOR DATA ON UNIT NUMBER =',I3) IFIRST=0 ENDIF C ENDIF C 1947 ISTAV=0 C ASSUME INITIALLY THAT DATA ARE GRIDPOINT. IF(KFILIN(IN).LT.80)GO TO 200 C C FALL THROUGH HERE MEANS THE DATA ARE VECTOR. DIRECTORY C HAS TO BE READ, ETC. C IF(NSTA.EQ.0)THEN C HAVING NO STATION LIST AND PROCESSING VECTOR DATA ARE C INCOMPATIBLE. CLOSE THIS FILE. JFOPEN(IN)=0 WRITE(KFILDO,1948)KFILIN(IN) 1948 FORMAT(/' ****TRYING TO PROCESS VECTOR DATA WITH NO', 1 ' STATION LIST IN RDSTR1 AT 1948. FILE UNIT NO.', 2 I3,' IS CLOSED.') ISTOP=ISTOP+1 GO TO 220 ENDIF C 195 CALL RDDIR(KFILDO,KFILIN(IN),IP12,NAMIN(IN),NDATE, 1 CCALL,INDEXC(1,IN),ND1,NSTA,CCALLD,ND5,MSTA, 2 L3264B,L3264W,IER) C ON THE LAST READ OF A FILE, THE DIRECTORY RECORD CAN'T C BE READ, SO THE INDEXC( ,IN) IS RETURNED AS 99999999. C ANY SUBSEQUENT DATA READ FROM THIS FILE IS NOT INDEXED. C THIS SHOULD NOT OCCUR ANYWAY. C IF(MSTA.EQ.3.AND.IER.NE.146)THEN C IER = 146 IS AN END OF FILE AND NOT UNEXPECTED. WRITE(KFILDO,1954) 1954 FORMAT(/' ****ONLY 3 SATIONS READ. LIKELY A TRAILER', 1 ' RECORD WAS READ INSTEAD OF A DIRECTORY', 2 ' RECORD.'/' THIS IS CAUSED BY', 3 ' TWO TRAILER RECORDS IN SUCCESSION WITHOUT', 4 ' AN INTERVENING DIRECTORY RECORD. CONTINUING.') ISTOP=ISTOP+1 ENDIF C D WRITE(KFILDO,1955)IER,(INDEXC(K,IN),K=1,20) D1955 FORMAT(/' AT 1955 IN RDSTR1--IER,', D 1 '(INDEXC(K,IN),K=1,MIN(20,NSTA))',I5/,(10I10)) C IS1( ) IS NOT AVAILABLE YET FOR THIS RECORD. C IF(IER.EQ.0)THEN GO TO 199 C ELSEIF(IER.EQ.120)THEN ISTOP=ISTOP+1 GO TO 199 C C FOR ONE OF THE ERRORS BELOW, THE FILE IS SWITCHED C BUT THE DIRECTORY NOT READ. THIS PUTS THE NEW C FILE IN THE SAME STATE (OPENED BUT NOT READ) AS C AN ORIGINAL FILE WOULD BE UPON ENTRY. C ELSEIF(IER.EQ.146)THEN C IER = 146 (END OF FILE) IS NOT UNEXPECTED AND IS C NOT COUNTED AS AN ERROR. IF(IP23.NE.0)WRITE(IP23,196)KFILIN(IN),NDATE,NAMIN(IN) 196 FORMAT(' END OF FILE ON UNIT NO.',I3, 1 ' PROCESSING DATE',I11,' FILE = ',A60) CALL SWITCH(KFILDO,IN,KFILIN,NAMIN,JFOPEN,LKHERE,MSDATE, 1 NUMIN,ND6,NDATE,IRD,IP23,ISTOP,IER) GO TO 220 C ELSE C THIS TAKES CARE OF IER = 140 AND 145. ISTOP=ISTOP+1 CALL SWITCH(KFILDO,IN,KFILIN,NAMIN,JFOPEN,LKHERE,MSDATE, 1 NUMIN,ND6,NDATE,IRD,IP23,ISTOP,IER) GO TO 220 ENDIF C 199 ISTAV=1 C 200 READ(KFILIN(IN),IOSTAT=IOS,ERR=201,END=204) 1 (NBYTES(J),J=1,L3264W), 2 (IPACK(J),J=1,MIN(ND5,NBYTES(L3264W)*8/L3264B)) C******** C**** TO CHECK MESSAGE, DECLARE IBYTE(2000) LOGICAL*1, AND REPLACE C**** ABOVE READ WITH THE FOLLOWING READ AND WRITE.INCLUDE. C**** READ(KFILIN(IN),IOSTAT=IOS,ERR=201,END=220)NTRASH,NBYTES, C**** 1 (IBYTE(J),J=1,NBYTES) C****D WRITE(KFILDO,210)(IBYTE(J),J=1,NBYTES) C****D210 FORMAT(/' PACKED MESSAGE'/ C****D 1 (16(1X,O3.3))) C**** STOP 5555 C******** C IPACK( ) CONTAINS THE PACKED RECORD. C THE RECORD CONSISTS OF AN INITIAL 64 BYTES 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 IF(L3264B.EQ.32)THEN IDATE=IPACK(5) D WRITE(KFILDO,2005)IN,LDATB(IN),LDATE(IN),IDATE D2005 FORMAT(/' AT 2005 IN RDSTR1--IN,LDATB(IN),LDATE(IN),IDATE', D 1 4I12) ELSE C THE LEFT HALF OF IPACK(3) HOLDS THE DATE/TIME OF THE RECORD C FOR A 64-BIT MACHINE. LOC=3 IPOS=1 CALL UNPKBG(KFILDO,IPACK,ND5,LOC,IPOS,IDATE,32,L3264B,IER,*900) ENDIF C NWORDS=NBYTES(L3264W)*8/L3264B GO TO 205 C 201 WRITE(KFILDO,202)KFILIN(IN),NDATE,IOS,NAMIN(IN) 202 FORMAT(/' ****ERROR READING PACKED RECORDS ON UNIT NO.',I3, 1 ' PROCESSING DATE',I11,' IN RDSTR1 AT 202, IOSTAT =',I5/ 2 ' FILE = ',A60) ISTOP=ISTOP+1 LSTOPC=LSTOPC+1 IF(LSTOPC.LT.LSTOP)GO TO 200 C THIS CHECK IS TO STOP AN INFINITE LOOP THAT MIGHT OCCUR. WRITE(KFILDO,203)LSTOPC 203 FORMAT(' A TOTAL OF',I6,' READING ERRORS HAVE OCCURRED.', 1 ' SWITCHING FILES IN RDSTR1 AT 203.') IER=138 LSTOPC=0 C THIS ALLOWS ROUTINE TO PROCEED. FALLS THROUGH TO C SWITHCH RECORDS. C 204 CALL SWITCH(KFILDO,IN,KFILIN,NAMIN,JFOPEN,LKHERE,MSDATE, 1 NUMIN,ND6,NDATE,IRD,IP23,ISTOP,IER) 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. GO TO 220 C 205 IF(IDATE.EQ.9999)GO TO 195 C THE ABOVE TEST IS FOR A TRAILER RECORD ON VECTOR DATA. C IF FOUND, A NEW DIRECTORY RECORD IS READ. C IF(IDATE.LT.LDATB(IN))THEN GO TO 200 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. FOR VECTOR DATA, THE POINTER C MAY BE DIRECTLY AFTER A NEW DIRECTORY RECORD. GO TO 220 ENDIF C C CHECK FOR NEEDED TAU. C IF(L3264B.EQ.32)THEN LOC=10 IPOS=1 NBIT=16 CALL UNPKBG(KFILDO,IPACK,ND5,LOC,IPOS,ITAU,NBIT,L3264B, 1 IER,*900) ELSE LOC=5 IPOS=33 NBIT=16 CALL UNPKBG(KFILDO,IPACK,ND5,LOC,IPOS,ITAU,NBIT,L3264B, 1 IER,*900) ENDIF C CCCC WRITE(KFILDO,2055)MINTAU,MAXTAU,ITAU CCCC 2055 FORMAT(' AT 2055 IN RDSTR1--MINTAU,MAXTAU,ITAU',3I10) C DO 2057 M=0,MAXMVT,6 CALL UPDAT(NDATE,-M,JDATE) C IF(JDATE.LE.IDATE)THEN MAXSAV=MAXTAU+MAXMVS+M+6 C THE 6 IS ARBITRARY AND CAN BE INCREASED. MINSAV=MIN(MINTAU+12-M,-6) C THIS SHOULD SAVE DATA WITH TAUS 6 HOURS AROUND C ANY PROJECTION BEING ANALYZED. C CCCC WRITE(KFILDO,2056)NDATE,JDATE,IDATE,M,MINSAV,MAXSAV CCCC 2056 FORMAT(/' AT 2056 IN RDSTR1--', CCCC 1 'NDATE,JDATE,IDATE,M,MINSAV,MAXSAV',3I12,3I6) C IF(ITAU.GT.MAXSAV.OR.ITAU.LT.MINSAV)THEN GO TO 200 ENDIF C ENDIF C 2057 CONTINUE C C THIS IS A DATE/TIME TO SAVE FOR THIS MODEL FOR DAY 1. C THIS IS A RECORD FROM MODEL NAMIN(IN) THAT MUST BE SAVED SO C THAT IT CAN BE RETAINED IN A RANDOM ACCESS MANNER. THE TDL C MOS-2000 STORAGE SYSTEM IS USED FOR THIS PURPOSE. MODEL C DATA ARE STORED PACKED, BUT VECTOR DATA HAVE TO BE UNPACKED C AND ASSOCIATED WITH THE CURRENT DIRECTORY FOR THAT SOURCE C AND ARE THEN STORED UNPACKED FOR THE NSTA STATIONS. C CALL UNPACK(KFILDO,IPACK,IWORK,DATA,ND5,IS0,IS1,IS2,IS4,ND7, 1 MISSP,MISSS,ISTAV+1,L3264B,IER) C ONLY ID'S ARE UNPACKED FOR GRIDPOINT DATA; DATA ARE ALSO C UNPACKED FOR VECTOR DATA. ISTAV+1 DOES THAT. C***D WRITE(KFILDO,206)(IS0(K),K=1,3) C***D206 FORMAT(/' IS0',1X,A4,2I10) C***D WRITE(KFILDO,207)(IS1(K),K=1,22+IS1(22)) C***D207 FORMAT(/' IS1',10I11/' '10I11/' '2I11,4X,32R1) C***D WRITE(KFILDO,208)(IS2(K),K=1,12) C***D208 FORMAT(/' IS2',10I11/(' '10I11)) C***D WRITE(KFILDO,209)(IS4(K),K=1,4) C***D209 FORMAT(/' IS4',10I11/(' '10I11)) C IF(IER.NE.0)THEN ISTOP=ISTOP+1 GO TO 200 ENDIF C IER NE 0 INDICATES PROBLEM WITH UNPACKING RECORD. IT IS NOT C TREATED AS FATAL, BUT THIS RECORD IS SKIPPED. A DIAGNOSTIC C WILL HAVE BEEN PRINTED IN UNPACK. C C DETERMINE WHETHER DATA READ MATCHES THE TYPE EXPECTED, C VECTOR OR GRIDPOINT. C IVECT=1 IF(BTEST(IS1(2),0))IVECT=0 C IVECT = 1 FOR VECTOR DATA, 0 FOR GRIDPOINT DATA. IF(IVECT.NE.ISTAV)THEN WRITE(KFILDO,211)MODNUM(IN),KFILIN(IN) 211 FORMAT(/' ****MODEL NO.',I3,' ON UNIT NO.',I3, 1 ' IMPLYING GRIDPOINT OR VECTOR DATA DOES NOT AGREE'/ 2 ' WITH TYPE OF DATA READ IN RDSTR1. ', 3 ' MODEL NUMBERS OF 80 AND ABOVE ARE RESERVED', 4 ' FOR VECTOR DATA.') ISTOP=ISTOP+1 C DATA ARE NOT STORED. GO TO 200 ENDIF C IF(ISTAV.EQ.1)THEN C C THIS SECTION IS FOR VECTOR DATA. C DATA ARE STORED, UNPACKED, FOR STATIONS NEEDED. C 9997 IS SET TO PXMISS. C ISTA=IS4(3) IF(ISTA.GT.ND5)THEN WRITE(KFILDO,215)ND5,ISTA,KFILIN(IN),NAMIN(IN) 215 FORMAT(/' ****ND5 =',I6,' TOO SMALL FOR DATA ARRAY', 1 ' IN RDSTR1 AT 215. INCREASE TO GE',I6/ 2 ' READING ON UNIT NO.',I3,' 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=ISTOP+1 C DATA ARE NOT STORED. GO TO 200 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. THIS HAS TO BE DONE IN C RDSTR1 IN CASE THE DIRECTORY CHANGES. C CCC WRITE(KFILDO,2155)IS1(9) CCC 2155 FORMAT(/,' AT 2155 IN RDESTR1--IS1(9)',I14) C DO 217 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 CCCC IF(K.LE.20)THEN CCCC WRITE(KFILDO,216)IS1(9),IS1(10),IS1(11),IS1(12), CCCC 1 K,IN,CCALL(K,1),INDEXC(K,IN),SDATA(K) CCCC 216 FORMAT(/,' AT 216 IN RDSTR1--IS1( ),', CCCC 1 'K,IN,CCALL(K,1),INDEXC(K,IN),SDATA(K)', CCCC 2 I11,2I7,I10,I6,I2,1X,A6,I9,F7.1) CCCC ENDIF C 217 CONTINUE C CALL GSTORE(KFILDO,KFIL10,IS1(9),0,LSTORE,ND9,LITEMS, 1 SDATA,NSTA,1,0,IS1(8), 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C IS1(9) IS THE FIRST OF 4 ID WORDS. C "NSLAB" IS STORED AS ZERO SIGNIFYING VECTOR DATA. C IF(IER.NE.0)THEN ISTOP=ISTOP+1 C IER NE 0 IS TREATED AS FATAL WITH RETURN TO CALLING C PROGRAM. GO TO 250 C ENDIF C ENDIF C ELSE C C THIS SECTION IS FOR GRIDPOINT DATA. C DATA ARE STORED PACKED. C GRCOMB IS NOT ENTERED FOR VECTOR DATA. C CALL GRCOMB(KFILDO,0,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. NOTE THAT "IP12" C IS USED AS ZERO HERE AND THAT THE PRINT OF ALL X,Y POSITIONS C IS AT THE END OF RDSTR1. ON SUBSEQUENT ENTRIES TO GRCOMB IN C PRED2, CHARACTERISTICS OF A NEW GRID WILL BE PRINTED. C CCALL IN GRCOMB IS SINGLE DIMENSIONED; THIS IS OK. C IF(IER.NE.0)THEN ISTOP=ISTOP+1 C IER NE 0 IS TREATED AS FATAL WITH RETURN TO CALLING C PROGRAM. GO TO 250 C ENDIF C CALL GSTORE(KFILDO,KFIL10,IS1(9),NSLAB,LSTORE,ND9,LITEMS, 1 IPACK,NWORDS,2,0,IS1(8), 2 CORE,ND10,LASTL,NBLOCK,LASTD,NSTORE,L3264B,IER) C IS1(9) IS THE FIRST OF 4 ID WORDS. C "NSLAB" IS STORED AS NON-ZERO SIGNIFYING GRID DATA. ENDIF C IF(IER.NE.0)THEN ISTOP=ISTOP+1 C IER NE FROM GSTORE 0 IS TREATED AS FATAL IN RDSTR1 C WITH RETURN TO CALLING PROGRAM. GO TO 250 ENDIF C GO TO 200 C 220 CONTINUE C IF(LITEMS.EQ.0)THEN C IF(NUMINX.NE.0)THEN C IF(IP10.NE.0)THEN WRITE(IP10,228) 228 FORMAT(/' ****NO FIELDS FOUND FOR DAY 1') ENDIF C IF(IP10.NE.KFILDO)THEN WRITE(KFILDO,228) ENDIF C ISTOP=ISTOP+1 IER=56 GO TO 250 C ENDIF C ELSE C IF(IP10.NE.0)THEN WRITE(IP10,229)LITEMS,((LSTORE(J,K),J=1,12),K=1,LITEMS) 229 FORMAT(/' ',I6,' FIELDS READ AND STORED FOR DAY 1',/, 1 (' ',3I10.9,I11.3,2I8,I3,I12,2I3,I5,I12)) ENDIF C ENDIF C C WRITE GRID LOCATIONS OF STATIONS, IF DESIRED. C IF(IP12.EQ.0)GO TO 250 IF(NGRID.EQ.0)GO TO 240 WRITE(IP12,232) 232 FORMAT(/' IX, JY GRID LOCATIONS FOR EACH STATION FOR EACH GRID') C DO 234 K=1,NSTA WRITE(IP12,233)CCALL(K,1),NAME(K),(DIR(K,1,M),DIR(K,2,M), 1 M=1,NGRID) 233 FORMAT(' ',A8,1X,A20,6(3X,2F8.2)/ 1 (' ',29X,6(3X,2F8.2))) 234 CONTINUE C C WRITE LOCATIONS IN VECTOR RECORDS OF THE STATIONS C FOR EACH VECTOR INPUT, IF DESIRED. C 240 DO 245 IN=1,NUMIN C D WRITE(IP12,241)IN,KFILIN(IN),JFOPEN(IN) D241 FORMAT(/,' AT 214 IN RDSTR1--IN,KFILIN(IN),JFOPEN(IN)',3I6) C IF(KFILIN(IN).LT.80)GO TO 245 CCC IF(JFOPEN(IN).EQ.0)GO TO 245 C THE ABOVE STATEMENT REMOVED BECAUSE THE UNIT WILL C USUALLY HAVE BEEN CLOSED. IP12 IS NOT USUALLY USED. WRITE(IP12,242)IN,KFILIN(IN),(K,CCALL(K,1),NAME(K),INDEXC(K,IN), 1 K=1,NSTA) 242 FORMAT(/' LOCATIONS IN RECORD FOR EACH STATION FOR INPUT FILE', 1 ' NO.',I4,' UNIT NO.',I4// 1 (' ',I8,2X,A8,1X,A20,I10)) C NOTE THAT ONLY THE LAST FILE IN A SEQUENCE WILL HAVE C INDEXC( , ) NON-MISSING. 245 CONTINUE C CALL TIMPR(KFILDO,KFILDO,'END RDSTR1 ') 250 RETURN C 900 WRITE(KFILDO,901)IER 901 FORMAT(/' ****ERROR IN UNPKBG IN RDSTR1. IER =',I4) RETURN END