SUBROUTINE RDPRED(KFILDO,IP6,IP7,IP8,IP9,KFILP,KFILCP, 1 ID,IDPARS,THRESH,JD,JP,ISCALD,SMULT,SADD, 2 ORIGIN,CINT,PLAIN,UNITS,ND4,NPRED,ISTOP,IER) C C SEPTEMBER 1995 GLAHN TDL MOS-2000 C DECEMBER 1996 GLAHN ALTERED SEARCH TO ACCOMMODATE CCC = 3XX. C JANUARY 1996 GLAHN ADDED "C" FOR CONSTANT DATA CCC = 4XX. C SEPTEMBER 1997 GLAHN ADDED B AND GB ISCALD( ) DEFAULTS C SEPTEMBER 1997 GLAHN ADDED SPECIFIC MODEL CHECK C NOVEMBER 1997 GLAHN CHANGED ISCALE( ) TO ISCALD( ) C DECEMBER 1997 GLAHN INSERTED UNITS, ETC. FOR POINT BINARIES C APRIL 1998 GLAHN SETPLN CALLED FOR PLAIN LANGUAGE, ETC. C "PREDICTOR" CHANGED TO "VARIABLE" C DECEMBER 1998 GLAHN REPLACED SORT16 AND FSORT WITH SORTEM C JULY 2005 RLC DISABLED SORTING OF VARIABLE LIST C FOR OPERATIONAL VERSION WE'RE USING C AS A GRIDDED POST-PROCESSOR. C OCTOBER 2012 ENGLE MODIFIED FORMAT STATEMENT C 182 FOR INTEL COMPILER C C PURPOSE C TO READ A VARIABLE LIST AND ASSOCIATED INFORMATION FROM C A FILE ON UNIT KFILP. KFILP CAN BE THE DEFAULT INPUT FILE, C OR CAN BE A SEPARATE FILE. ALSO, VARIABLE NAMES AND OTHER C INFORMATION FROM THE VARIABLE CONSTANT FILE CAN BE C RETRIEVED FROM THE FILE READ ON UNIT KFILCP AND MATCHED C WITH THE VARIABLES. EACH VARIABLE ID IN ID( , ) IS C DUPLICATED IN JD( , ) BUT WITH THE PROCESSING PORTIONS C OMITTED; THE RESULT IS CALLED THE "BASIC" ID. THE VARIABLE C LIST IS THEN REORDERED WITH THE FOURTH WORD OF THE ID C (I.E. JD(4, )), WHICH WAS ZERO, REPLACED WITH PROCESSING C INFORMATION. THIS REPLACEMENT IS ONLY FOR ORDERING, AND C THE ZERO IS THEN RESTORED TO JD(4, ). THE RESULT IS THE C VARIABLE LIST BEING IN AN ORDER FOR OPTIMUM USE OF C THE GRID FIELDS. PLAIN LANGUAGE IS READ, MATCHED C WITH THE VARIABLES, AND SOME INSERTIONS MADE FOR COMPUTED C PREDITORS BY ROUTINE SETPLN. RDPRED IS FOR U201; A C SIMILIAR ROUTINE RDVRBL IS USED FOR PROGRAMS SUCH AS U600. C ALL GRID BINARIES ARE GIVEN THE ISCALD( ) VALUE = 2, C AND ALL POINT BINARIES ARE GIVEN THE ISCALD( ) VALUE = 0. C THIS CAN BE CHANGED FOR SPECIFIC VARIABLES BY INSERTING C AN EXACT CCCFFFB MATCH IN THE PLAIN LANGUAGE FILE. C C DATA SET USE C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. (OUTPUT) C IP6 - UNIT NUMBER FOR OUTPUT (PRINT) FILE FOR VARIABLE C LIST AS READ IN. (OUTPUT) C IP7 - UNIT NUMBER FOR OUTPUT (PRINT) FILE FOR VARIABLE C LIST PARSED INTO ITS 15 COMPONENTS. (OUTPUT) C IP8 - UNIT NUMBER FOR OUTPUT (PRINT) FILE FOR VARIABLE C LIST PARSED INTO ITS 15 INTEGER AND 1 REAL COMPONENT. C (OUPUT) C IP9 - UNIT NUMBER FOR OUTPUT (PRINT) FILE FOR VARIABLE C LIST INCLUDING INFORMATION FROM THE VARIABLE C CONSTANT FILE. (OUPUT) C KFILP - UNIT NUMBER FROM WHICH TO READ VARIABLE LIST. C IT IS ASSUMED FILE HAS BEEN OPENED. (INPUT) C KFILCP - UNIT NUMBER FROM WHICH TO READ VARIABLE NAMES AND C OTHER ASSOCIATED INFORMATION. IT IS ASSUMED FILE C HAS BEEN OPENED. (INPUT) C C VARIABLES C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. (INPUT) C IP6 = INDICATES WHETHER (>0) OR NOT (=0) THE VARIABLE C ID WILL BE WRITTEN TO UNIT IP6 AS THE VARIABLES C ARE READ IN. THIS SHOULD BE USEFUL FOR CHECKOUT C OTHERWISE, IP7, IP8, AND/OR IP9 MAY BE PREFERRED. C (INPUT) C IP7 = INDICATES WHETHER (>0) OR NOT (=0) THE VARIABLE C LIST WILL BE WRITTEN TO UNIT IP7. IF THERE ARE C INPUT ERRORS, THE VARIABLE LIST WILL BE WRITTEN C TO THE DEFAULT OUTPUT FILE UNIT KFILDO AS WELL AS C TO UNIT IP7 IF THEY ARE DIFFERENT. (INPUT) C IP8 = INDICATES WHETHER (>0) OR NOT (=0) THE VARIABLE C LIST WILL BE WRITTEN TO UNIT IP8 PARSED INTO ITS C 15 INTEGER AND ONE REAL*4 COMPONENT. (INPUT) C IP9 = INDICATES WHETHER (>0) OR NOT (=0) THE VARIABLE C LIST WILL BE WRITTEN TO UNIT IP9. THE DIFFERENCE C BETWEEN IP8 AND IP9 IS THAT IP9 DOES NOT INCLUDE C THE PARSED ID'S IN IDPARS( , ), BUT RATHER DOES C INCLUDE INFORMATION TAKEN FROM THE VARIABLE C CONSTANT FILE READ ON UNIT KFILCP. (INPUT) C KFILP = UNIT NUMBER FROM WHICH TO READ VARIABLE LIST. C IT IS ASSUMED FILE HAS BEEN OPENED. (INPUT) C KFILCP = UNIT NUMBER FROM WHICH TO READ VARIOUS VARIABLE C CONSTANTS AND NAMES. IT IS ASSUMED FILE HAS BEEN C OPENED. (INPUT) C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NPRED). C (OUTPUT) C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE VARIABLE C ID'S CORRESPONDING TO ID( ,N) (J=1,15), (N=1,NPRED). C (OUTPUT) C J=1--CCC (CLASS OF VARIABLE), C J=2--FFF (SUBCLASS OF VARIABLE), C J=3--B (BINARY INDICATOR), C J=4--DD (DATA SOURCE, MODEL NUMBER), C J=5--V (VERTICAL APPLICATION), C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK IN TIME), C J=10--OT (TIME APPLICATION), C J=11--OH (TIME PERIOD IN HOURS), C J=12--TAU (PROJECTION IN HOURS), C J=13--I (INTERPOLATION TYPE), C J=14--S (SMOOTHING INDICATOR), AND C J=15--G (GRID INDICATOR). C THRESH(N) = THE BINARY THRESHOLD CORRESPONDING TO IDPARS( ,N) C (N=1,ND4). (OUTPUT) C JD(J,N) = THE BASIC INTEGER VARIABLE ID'S (J=1,4) (N=1,ND4). C THIS IS THE SAME AS ID(J,N), EXCEPT THAT THE PORTIONS C PERTAINING TO PROCESSING ARE OMITTED: C B = IDPARS(3, ), C T = IDPARS(8,), C I = IDPARS(13, ), C S = IDPARS(14, ), C G = IDPARS(15, ), AND C THRESH( ). C JD( , ) IS USED TO IDENTIFY THE BASIC MODEL FIELDS C AS READ FROM THE ARCHIVE. (OUTPUT) C JD(4, ) IS USED TEMPORARILY IN THE SORTING C PROCESS AND IN KEEPING TRACK OF WHICH VARIABLES C HAVE BEEN FOUND AND PROCESSED; THE ARRAY = 0 ON C RETURN. C JP(J,N) = JP( ,N) INDICATES WHETHER (>0) OR NOT (=0) VARIABLE N C WILL BE OUTPUT FOR VIEWING (N=1,NPRED). C J=1--GRIDPOINT VALUES, C J=2--GRIDPRINT WITH CONTOURS, AND C J=3--INTERPOLATED VALUES. C THIS ALLOWS INDIVIDUAL VARIABLE CONTROL ON THE PRINT C PARAMETERS IP(12), IP(13), AND IP(14). (OUTPUT) C ISCALD(N) = THE SCALING CONSTANT TO USE WHEN PACKING THE C INTERPOLATED DATA (N=1,ND4). (OUTPUT) C USED TEMPORARIALLY IN XCHANG. (INTERNAL) C SMULT(N) = THE MULTIPLICATIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). (OUTPUT) C USED TEMPORARIALLY IN XCHANG AS AN INTEGER ARRAY. C (INTERNAL) C SADD(N) = THE ADDITIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). (OUTPUT) C PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES C (N=1,ND4). (CHARACTER*32) (OUTPUT) C UNITS(J) = THE UNITS OF THE DATA THAT APPLY AFTER MULTIPLYING C BY SMULT(N) AND ADDING SADD(N) (N=1,ND4). C (CHARACTER*12) (OUTPUT) C ORIGIN(N) = THE CONTOUR ORIGIN, APPLIES TO THE UNITS IN UNITS(N) C (N=1,ND4). (OUTPUT) C CINT(N) = THE CONTOUR INTERVAL, APPLIES TO THE UNITS IN C UNITS(N) (N=1,ND4). (OUTPUT) C ND4 = MAXIMUM NUMBER OF VARIABLES THAT CAN BE DEALT WITH C IN ONE RUN. SECOND DIMENSION OF ID( , ) AND C IDPARS( , ) AND DIMENSION OF THRESH( ). (INPUT) C NPRED = THE NUMBER OF VARIABLES. (OUTPUT) C ISTOP = INCREASED BY 1 WHENEVER AN ERROR IS ENCOUNTERED. C (INPUT-OUTPUT) C IER = STATUS RETURN. (OUTPUT) C 0 = GOOD RETURN. C 40 = ERROR READING VARIABLE LIST. C 41 = DIMENSION ND4 ABOUT TO BE EXCEEDED. C ITEMP(J) = WORK ARRAY (J=1,6). (INTERNAL) C J=1--FIRST ID = ID(1, ), C J=2--SECOND ID = ID(2, ), C J=3--THIRD ID = ID(3, ), C J=4--LAST PORTION OF ID = ID(4, ), C J=5--FRACTIONAL PART OF THRESH, AND C J=6--TEN'S EXPONENT OF ITEMP(5). C TEMP = SIGN OF THRESHOLD. (CHARACTER*1) (INTERNAL) C NERR = COUNTS ERRORS FOR PURPOSES OF KNOWING WHEN TO C PRINT DIAGNOSTICS. (INTERNAL) C C NONSYSTEM SUBROUTINES CALLED C PRSID, BASICP, SORTEM, XCHANG, CKIDS C CHARACTER*1 TEMP CHARACTER*12 UNITS(ND4) CHARACTER*32 PLAIN(ND4) C DIMENSION ID(4,ND4),IDPARS(15,ND4),THRESH(ND4),JD(4,ND4), 1 JP(3,ND4),ISCALD(ND4),SMULT(ND4),SADD(ND4), 2 ORIGIN(ND4),CINT(ND4) DIMENSION ITEMP(6),JTEMP(3) C IER=0 NERR=0 N=1 C C READ PRDICTOR ID. C 102 READ(KFILP,103,IOSTAT=IOS,ERR=104,END=150)(ITEMP(J),J=1,4), 1 TEMP,ITEMP(5),ITEMP(6),(JTEMP(J),J=1,3) 103 FORMAT(I9,1X,I9,1X,I9,1X,I3,1X,A1,1X,I4,1X,I3,4X,3I2) IF(IP6.NE.0.AND.N.EQ.1)WRITE(IP6,1030) 1030 FORMAT(/' VARIABLES AS READ BY RDPRED') IF(IP6.NE.0)WRITE(IP6,1031)(ITEMP(J),J=1,4), 1 TEMP,ITEMP(5),ITEMP(6),(JTEMP(J),J=1,3) 1031 FORMAT(' ',I9.9,1X,I9.9,1X,I9.9,1X,I3.3,1X,A1,1X,I4,1X,I3,4X,3I2) GO TO 120 C 104 NERR=NERR+1 ISTOP=ISTOP+1 IER=40 WRITE(KFILDO,107)N,IOS 107 FORMAT(/' ****ERROR READING VARIABLE ID NO.',I4, 1 '. IOSTAT =',I5,'. VARIABLE SKIPPED.') IF(IP6.NE.KFILDO)WRITE(IP6,107)N,IOS GO TO 102 C 120 IF(ITEMP(1).EQ.999999)GO TO 150 C C STORE THIS VARIABLE ID, UNLESS ND4 WILL BE EXCEEDED. C IF(N.LE.ND4)GO TO 125 IER=41 NERR=NERR+1 ISTOP=ISTOP+1 WRITE(KFILDO,122)ND4 122 FORMAT(/' ****ND4 = ',I4,' TOO SMALL IN RDPRED.') GO TO 180 C C PARSE ID'S INTO 15 COMPONENT PARTS ID(J, ) (J=1,15) AND THRESH( ). C 125 CALL PRSID(KFILDO,ITEMP,TEMP,ID(1,N),IDPARS(1,N),THRESH(N),ISTOP) C C PREPARE "BASIC" VARIABLE ID'S, THE VARIABLE ID'S WITHOUT C THE "PROCESSING" INFORMATION. C CALL BASICP(KFILDO,IDPARS(1,N),JD(1,N)) C C STORE PRINT PARAMETERS. C JP(1,N)=JTEMP(1) JP(2,N)=JTEMP(2) JP(3,N)=JTEMP(3) C C CHECK CONSISTENCY OF INFORMATION READ. C CALL CKIDS(KFILDO,N,ID(1,N),IDPARS(1,N),1,IER) C THE "1" IN THE ABOVE CALL ALLOWS IDPARS(3) TO C TAKE ONLY A VALUE OF 0, 1, OR 5 WITHOUT AN C ERROR BEING INDICATED. IF(IER.NE.0)ISTOP=ISTOP+1 C C OMIT VARIABLE IF IT IS A DUPLICATE. C IF(N.EQ.1)GO TO 130 C DO 129 J=1,N-1 IF(ID(1,J).NE.ID(1,N).OR. 1 ID(2,J).NE.ID(2,N).OR. 2 ID(3,J).NE.ID(3,N).OR. 3 ID(4,J).NE.ID(4,N))GO TO 129 WRITE(KFILDO,128)(ID(L,N),L=1,4) 128 FORMAT(/' ****DUPLICATE VARIABLE DELETED',4I11) ISTOP=ISTOP+1 GO TO 102 C 129 CONTINUE C 130 N=N+1 GO TO 102 C 150 NPRED=N-1 C C WRITE VARIABLE LIST WHEN REQUIRED. LIST IS ALWAYS WRITTEN C TO DEFAULT OUTPUT WHEN THERE HAS BEEN AN ERROR. C 180 IF(NERR.NE.0)WRITE(KFILDO,181)NPRED 181 FORMAT(/' ',I4,' VARIABLES AND PARSED IDS IN ORDER READ IN') IF(NERR.NE.0)WRITE(KFILDO,182)(N,(ID(J,N),J=1,4), 1 (IDPARS(J,N),J=1,15), 2 THRESH(N),THRESH(N), 3 (JP(J,N),J=1,3),N=1,NPRED) 182 FORMAT(' NO. ID(1) ID(2) ID(3) ID(4)', 2 ' CCC FFF B DD V LLLL UUUU T RR O HH', 3 ' TAU I S G THRESHOLD PRINT'/ 4 (' ',I4,1X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3, 5 2X,I4.3,I4.3,I2,I3,3X,I2,I5,I5,3X, 6 I2,I3,I3,I3,I4,3X,I2,I2,I2,F13.6,E11.4,3I2)) IF(NERR.NE.0.AND.KFILDO.NE.IP7.OR.NERR.EQ.0.AND.IP7.NE.0) 1 WRITE(IP7,181)NPRED IF(NERR.NE.0.AND.KFILDO.NE.IP7.OR.NERR.EQ.0.AND.IP7.NE.0) 1 WRITE(IP7,182)(N,(ID(J,N),J=1,4), 2 (IDPARS(J,N),J=1,15), 3 THRESH(N),THRESH(N), 4 (JP(J,N),J=1,3),N=1,NPRED) CC*************************************************************** CC JULY 2005 - THE FOLLOWING SECTION HAS BEEN COMMENTED OUT FOR CC THE OPERATIONAL VERSION OF U202 - MDL_GRIDPOST. THIS IS CC BECAUSE WE DON'T WANT IT REORDERING THE VARIABLE LIST, WE CC WANT IT TO PROCESS THE VARIABLES AS LISTED. C C ORDER THE VARIABLES, LOW TO HIGH. MUST ALSO ARRANGE C THE PARSED ID'S. THE BASIC VARIABLES IN JD( , ) ARE C ORDERED, NOT THE FULL ID'S. HOWEVER, THE 4TH WORD C OF EACH BASIC VARIABLE IS REPLACED WITH PROCESSING C INFORMATION SO THAT THE SORT IS (1) BY BASIC VARIABLE, C (2) BY SMOOTHING, (3) BY BINARY INDICATOR, AND C (4) BY TRANSFORM. C C DO 185 N=1,NPRED C JD(4,N)=IDPARS(14,N)*100+ C 1 IDPARS(3,N)*10+ C 2 IDPARS(8,N) C185 CONTINUE C C CALL SORTEM(KFILDO,JD,ISCALD,THRESH,NPRED) C C THE VARIABLES ARE IN ORDER LOW TO HIGH, INCLUDING THE C THRESHOLDS. NOTE THAT ISCALD( ) IS USED TEMPORARILY FOR C SORTING--THE NAME IN OTHER ROUTINES MAY BE INDEX( ). C NOW REORDER OTHER VARIABLES TO MATCH. C SMULT( ) IS USED AS A WORK ARRAY IN XCHANG. C C CALL XCHANG(ID, 4,ISCALD,SMULT,NPRED) C CALL XCHANG(IDPARS,15,ISCALD,SMULT,NPRED) C CALL XCHANG(JP, 3,ISCALD,SMULT,NPRED) C C RESTORE THE 4TH WORD IN JD( ) TO ZERO. C C DO 187 N=1,NPRED C JD(4,N)=0 C187 CONTINUE C C IF(IP8.NE.0)WRITE(IP8,191)NPRED C191 FORMAT(/' ',I4,' VARIABLES AND PARSED IDS', C 1 ' (ORDERED BY BASIC VARIABLE', C 2 '--SANS PROCESSING PARAMETERS)') C IF(IP8.NE.0)WRITE(IP8,182)(N,(ID(J,N),J=1,4), C 1 (IDPARS(J,N),J=1,15), C 2 THRESH(N),THRESH(N), C 3 (JP(J,N),J=1,3),N=1,NPRED) C CC END OF SECTION COMMENTED OUT FOR OPERATIONS CC*************************************************************** C C READ THE PLAIN LANGUAGE AND OTHER INFORMATION C FROM THE VARIABLE CONSTANT FILE ON UNIT KFILCP C AND INITIALIZE PLAIN( ) AND OTHER VARIABLES. C THEN CLOSE UNIT KFILCP. C CALL SETPLN(KFILDO,KFILCP, 1 ID,IDPARS,JD,ISCALD,SMULT,SADD, 2 ORIGIN,CINT,PLAIN,UNITS,ND4,NPRED,ISTOP,IER) C C CLOSE(KFILCP) C IF(IP9.NE.0)WRITE(IP9,230)NPRED 230 FORMAT(/' ',I4,' VARIABLES AND INFORMATION FROM VARIABLE', 1 ' CONSTANT FILE', 2 ' (ORDERED BY BASIC VARIABLE', 3 '--SANS PROCESSING PARAMETERS)') IF(IP9.NE.0)WRITE(IP9,235)(N,(ID(J,N),J=1,4), 1 PLAIN(N),ISCALD(N),SMULT(N),SADD(N), 2 ORIGIN(N),CINT(N),UNITS(N), 3 (JP(J,N),J=1,3),N=1,NPRED) 235 FORMAT(' NO. ID(1) ID(2) ID(3) ID(4)', 1 ' PLAIN LANGUAGE ID ISCALD SMULT SADD', 2 ' ORIGIN CINT UNITS PRINT'/ 3 (' ',I4,1X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3,2X, 4 A32,I3,F7.2,F7.2,F8.2,F8.2,1X,A12,3I2)) RETURN END