SUBROUTINE RDV155(KFILDO,IP6,IP7,IP9,KFILP,KFILCP,ID,IDPARS, 1 THRESH,JD,JP,ANLTAB,INLTAB,ISCALD, 2 IWRITS,IWRITA,ICOMPT,IWRITF, 3 SMULT,SADD,ORIGIN,CINT,PLAIN,UNITS,ND4, 4 NPRED,ISTOP,IER) C C MAY 2004 GLAHN TDL MOS-2000 C ADAPTED FROM RDLVRB C JANUARY 2005 GLAHN MODIFIED COMMENT ABOUT JP C JULY 2005 GLAHN ELIMINTATED CHECKING FOR DUPLICATES C AUGUST 2005 GLAHN INCREASED SIZE OF ANLTAB TO 14 C SEPTEMBER 2005 GLAHN PUT COMMAS IN SOME FORMATS; READ IN C UNIT NUMBER WITH FILE NAME FOR IBM; C ADDED INLTAB( ) TO CALL PER TRIMARCO C APRIL 2006 GLAHN INCREASED ANLTAB AND ATEMP FROM C CHARACTER*14 TO *17 C NOVEMBER 2006 GLAHN CORRECTED PRINT TO IP6 C FEBRUARY 2008 GLAHN ADDED IWRITA( ) C APRIL 2008 GLAHN ADDED ICOMPT( ) C JUNE 2011 GLAHN ADDED IWRITF( ) C OCTOBER 2012 ENGLE MODIFIED FORMAT STATEMENT C 182 FOR INTEL COMPILER C APRIL 2015 GLAHN MODIFIED IWRITA DIAGNOSTIC IN C FORMAT STATEMENT 230 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. PLAIN C LANGUAGE IS READ, MATCHED WITH THE VARIABLES, AND C SOME INSERTIONS MADE FOR COMPUTED PREDICTORS BY ROUTINE C SETPLN. ALL GRID BINARIES ARE GIVEN THE ISCALD( ) C VALUE = 2, AND ALL POINT BINARIES ARE GIVEN THE ISCALD( ) C VALUE = 0 BY SETPLN, EXCEPT CCC=2XX, 8XX, AND 4XX ARE GIVEN C THE VALUE 3. HOWEVER, THIS CAN BE CHANGED FOR C SPECIFIC VARIABLES BY INSERTING AN EXACT CCCFFFB MATCH C 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 IP9 - UNIT NUMBER FOR OUTPUT (PRINT) FILE FOR VARIABLE C LIST INCLUDING INFORMATION FROM THE VARIABLE C CONSTANT FILE. (OUTPUT) 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, 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 IP9 = INDICATES WHETHER (>0) OR NOT (=0) THE VARIABLE C LIST WILL BE WRITTEN TO UNIT IP9. THE DIFFERENCE C BETWEEN IP7 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 PRINT CONTROL. C (OUTPUT) C ANLTAB(N) = THE CONTROL FILE NAME FOR THE VARIABLE (N=1,NPRED). C (CHARACTER*17) (OUTPUT) C INLTAB(N) = THE UNIT NUMBER FOR ANLTAB(N) NEEDED FOR IBM C (N=1,NPRED). (OUTPUT) C ISCALD(N) = THE SCALING CONSTANT TO USE WHEN PACKING THE C INTERPOLATED DATA (N=1,ND4). (OUTPUT) C USED TEMPORARILY IN XCHANG. (INTERNAL) C IWRITS(N) = 1 WHEN ANALYSIS FOR VARIABLE N IS TO BE WRITTEN C TO INTERNAL STORAGE BEFORE POSTPROCESSING; C 0 OTHERWISE (N=1,ND4). (OUTPUT) C IWRITA(N) = 1 WHEN ASCII DATA FOR VARIABLE N IS TO BE WRITTEN C TO FILE UNIT NUMBER KFIOVO; 0 OTHERWISE (N=1,ND4). C (OUTPUT) C ICOMPT(N) = SIGNALS WHETHER THE VARIABLE IS TO BE ANALYZED C OR COMPUTED (N=1,ND4). C 0 WHEN THE VARIABLE IS TO BE ANALYZED; THE USUAL C CASE. C 1 WHEN THE VARIABLE IS NOT TO BE ANALYZED BUT TO C BE COMPUTED FROM OTHER ALRADY ANALYZED C VARIABLES. C (OUTPUT) C IWRITF(N) = 1 WHEN FINAL POSTPROCESSED ANALYSIS FOR VARIABLE N C IS TO BE WRITTEN TO INTERNAL STORAGE; 0 OTHERWISE C (N=1,ND4). THE POSTPROCESSED VARIABLE IS C DISTINGUISHED FROM THE NON-POSTPROCESSED C INTERNALLY WITH A "1" IN THE "G" LOCATON OF THE ID. C (OUTPUT) C SMULT(N) = THE MULTIPLICATIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). (OUTPUT) C USED TEMPORARILY 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 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES CALLED C PRSID, BASICP, SORTEM, XCHANG, CKIDS C CHARACTER*1 TEMP CHARACTER*17 ATEMP,ANLTAB(ND4) 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),IWRITS(ND4),IWRITA(ND4), 2 ICOMPT(ND4),IWRITF(ND4),INLTAB(ND4), 3 SMULT(ND4),SADD(ND4),ORIGIN(ND4),CINT(ND4) DIMENSION ITEMP(6),JTEMP(3) C IER=0 NERR=0 N=1 C C READ PREDICTOR 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), 2 ATEMP,MTEMP,IW,IA,IC,IFF 103 FORMAT(I9,1X,I9,1X,I9,1X,I3,1X,A1,1X,I4,1X,I3,4X,3I2,1X,A17, 1 I4,4I2) IF(IP6.NE.0.AND.N.EQ.1)WRITE(IP6,1030) 1030 FORMAT(/' VARIABLES AS READ BY RDV155') IF(IP6.NE.0)WRITE(IP6,1031)(ITEMP(J),J=1,4), 1 TEMP,ITEMP(5),ITEMP(6),(JTEMP(J),J=1,3), 2 ATEMP,MTEMP,IW,IA,IC,IFF 1031 FORMAT(' ',I9.9,1X,I9.9,1X,I9.9,1X,I3.3,1X,A1,1X,I4,1X,I3,4X,4I2, 1 1X,A17,I4,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.AND.IP6.NE.0)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 RDV155.') GO TO 180 C C PARSE ID'S INTO 15 COMPONENT PARTS ID(J, ) (J=1,15) AND C 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 AND THE DESIGNATOR FOR WRITING C TO INTERNAL STORAGE. C JP(1,N)=JTEMP(1) JP(2,N)=JTEMP(2) JP(3,N)=JTEMP(3) IWRITS(N)=IW IWRITA(N)=IA ICOMPT(N)=IC IWRITF(N)=IFF C C STORE THE CONTROL FILE NAME AND UNIT NUMBER. C ANLTAB(N)(1:17)=ATEMP(1:17) INLTAB(N)=MTEMP 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) 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', 1 ' CONSTANT FILE: IWRITS, IWRITF: 1=INTERNAL RA;', 3 ' IWRITA: >0=ASCII KFILVO;', 3 ' CMP: 1=COMPUTE ONLY') IF(IP9.NE.0)WRITE(IP9,235)(N,(ID(J,N),J=1,4), 1 PLAIN(N),ISCALD(N), 2 (JP(J,N),J=1,3),IWRITS(N),IWRITA(N),ICOMPT(N), 3 IWRITF(N),ANLTAB(N),INLTAB(N),N=1,NPRED) 235 FORMAT(/' NO. ID(1) ID(2) ID(3) ID(4)', 1 ' PLAIN LANGUAGE ID ISCALD', 2 ' JP IWRS IWRA CMP IWRF CONTROL FILE UNIT NO.'/ 3 (' ',I4,1X,I9.9,1X,I9.9,1X,I9.9,1X,I10.3,2X, 4 A32,I3,2X,3I2,I3,I5,I4,I5,2X,A17,I4)) RETURN END