SUBROUTINE RDSTR17(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 JULY 2017 GLAHN REVISED FROM RDSTR1; DIMENSIONED
C NCEPNO(6)
C JULY 2017 GLAHN INCREASED +-6H TO +-8H
C NOVEMBER 2017 GLAHN COMMENTS REGARDING NCEPNO( )
C OCTOBER 2020 GHIRARDELLI SET MAXMVS 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 8 HOURS ON EITHER
C SIDE OF THE ANALYSES BEING RUN WERE SUFFICIENT.
C MODIFIED FOR U755.
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 MODIFIED FROM RDSTR1 IN U155LIBTO ACCOMMODATE NCEPNO(6)
C VICE 3 FOR U755.
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 6 GRIDS THAT
C MIGHT BE NEEDED IN MERGING LAMP AND HRRR OR RAP,
C IT HAS BEEN DIMENSIONED NCEPNO(J) (J=1,6).
C (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 RDSTR17 AND RDSTR77.
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 = INITIAL 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(6)
C
DATA LSTOP/500/,
1 LSTOPC/0/
DATA IFIRST/1/
C
CALL TIMPR(KFILDO,KFILDO,'START RDSTR17 ')
IER=0
LITEMS=0
ICOUNT=0
NUMINX=NUMIN
MAXMVT=MAX(MINVEC,MINMOD)
C MAXMVT IS THE MAXIMUM OF BACKUP HOURS TO SAVE.
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(1).OR.
1 MODNUM(IN).EQ.NCEPNO(2).OR.
2 MODNUM(IN).EQ.NCEPNO(3).OR.
3 MODNUM(IN).EQ.NCEPNO(4).OR.
4 MODNUM(IN).EQ.NCEPNO(5).OR.
5 MODNUM(IN).EQ.NCEPNO(6))THEN
INCDTL=MIN(INCDTL,-IDPARS(9,N),-MINMOD)
INCDTH=MAX(INCDTH,-IDPARS(9,N),-MINMOD)
ENDIF
C
CCCC WRITE(KFILDO,150)IN,NUMIN,LKHERE(IN),(NCEPNO(J),J=1,6),
CCCC 1 INCDTL,INCDTH,MINMOD,MINVEC
CCCC 150 FORMAT(' IN RDSTR17--IN,NUMIN,LKHERE(IN),(NCEPNO(J),J=1,6),',
CCCC 1 'INCDTL,INCDTH,MINMOD,MINVEC',/,20I6)
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 RDSTR17 FOR U755 MAY NOT NEED THE LOOP AS VECTOR
C DATA WILL PROBABLY NOT BE NEEDED.
C
IF(MODNUM(IN).EQ.0)THEN
INCDTL=MIN(INCDTL,-MINVEC)
INCDTH=MAX(INCDTH,-MINVEC)
ELSE
CCCC WRITE(KFILDO,159)MODNUM(IN),KFILIN(IN)
CCCC 159 FORMAT(/' ****MODNUM(IN) = ',I4,' ON KFILIN(IN) =',I4,
CCCC 1 ' DOES NOT = 0 FOR KFININ(IN)',
CCCC 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 RDSTR17.')
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 STORING 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 RDSTR17 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 RDSTR17--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 RDSTR17--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 RDSTR17 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 RDSTR17 AT 203.')
IER=138
LSTOPC=0
C THIS ALLOWS ROUTINE TO PROCEED. FALLS THROUGH TO
C SWITCH 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)IN,MINTAU,MAXTAU,ITAU
CCCC 2055 FORMAT(' AT 2055 IN RDSTR17--IN,MINTAU,MAXTAU,ITAU',4I10)
C
DO 2057 M=0,MAXMVT,12
CCCC DO 2057 M=0,MAXMVT,6
CALL UPDAT(NDATE,-M,JDATE)
C
C CHECK SETTING OF MAXMVS - JUDY GHIRARDELLI
MAXMVS=0
IF(JDATE.LE.IDATE)THEN
MAXSAV=MAXTAU+MAXMVS+M+12
CCCCC MAXSAV=MAXTAU+MAXMVS+M+6
C THE 6 IS ARBITRARY AND CAN BE INCREASED.
MINSAV=MIN(MINTAU+12-M,-12)
CCCCC MINSAV=MIN(MINTAU+12-M,-6)
C THIS SHOULD SAVE DATA WITH TAUS 12 HOURS AROUND
C ANY PROJECTION BEING ANALYZED.
C
CCCC WRITE(KFILDO,2056)NDATE,JDATE,IDATE,M,MINSAV,MAXSAV
CCCC 2056 FORMAT(/' AT 2056 IN RDSTR17--',
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 RDSTR17. ',
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 RDSTR17 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 RDSTR17 IN CASE THE DIRECTORY CHANGES.
C
CCC WRITE(KFILDO,2155)IS1(9)
CCC 2155 FORMAT(/,' AT 2155 IN RDSTR17--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 RDSTR17--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 RDSTR17. 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 RDSTR17
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 RDSTR17--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 RDSTR17 ')
250 RETURN
C
900 WRITE(KFILDO,901)IER
901 FORMAT(/' ****ERROR IN UNPKBG IN RDSTR17. IER =',I4)
RETURN
END