SUBROUTINE RD45CN(KFILDO,KFILAN, 1 ID,IDPARS,JD, 2 ELCORR,ANLTAB,NPASS,IER) C C C APRIL 2019 GLAHN MDL MOS-2000 C APRIL 2020 HUANG MDL MODIFIED OPEN STATEMENT C FOR OPERATIONAL PURPOSE. C C PURPOSE C READS A U405A .CN FILE, SKIPPING ALL DATA DOWN TO THE C FRACTION OF THE LAPSE TO APPLY, ELCORR( , ). C C WHEN ANALYZING A SERIES OF "LEVELS" OF PROBABILITY, C THE U405A.CN FILE IS READ IN U405A FOR ONLY THE FIRST C (LOWEST) LEVEL. ALL PARAMETERS IN THE .CN WERE C ASSUMED TO BE THE SAME FOR ALL LEVELS. IT WAS FOUND C THAT THE SAME LAPSE CANNOT BE APPLIED TO ALL LEVELS; C A LAPSE APPROPRIATE FOR HIGHER LEVESL WILL LIKELY C OVERDO THE LOWEST LEVLES WHERE THE DATA VALUES MAY C BE ZERO. SO THIS ROUTINE WAS WRITTEN TO READ C ELCORR( , ) FOR EACH LEVEL. IF IT IS FOUND DIFFERENT C VALUES ARE NEEDED FOR OTHER VARIABLES, THEY CAN BE C INSERTED. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFILAN - UNIT NUMBER FOR READING INDIVIDUAL ANALYSIS C CONTROL FILES. SET TO KFILIN. (INPUT) C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILAN = UNIT NUMBER FOR READING INDIVIDUAL ANALYSIS C CONTROL FILES. (INPUT) C ID(J) = THE INTEGER PREDICTOR ID'S (J=1,4). C (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C PREDICTOR ID'S CORRESPONDING TO ID( ) C (J=1,15). (INPUT) 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 JD(J) = THE BASIC INTEGER PREDICTOR ID'S (J=1,4). C (INPUT) C THIS IS THE SAME AS ID(J,N), EXCEPT THAT THE C PORTIONS 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 C (INPUT) C FIELDS AS READ FROM THE ARCHIVE. (INPUT) C ELCORR(J,L) = FRACTION OF THE ELEVATION CORRECTION TO C APPLY FOR EACH PASS (J=1,NPASS) AND FIRST C GUESS OPTION (L=1,4) FOR THE "USUAL" LAPSE C RATE SIGN. (OUTPUT) C ANLTAB = THE CONTROL FILE NAME FOR THE VARIABLE C DEFINED IN ID( ). (CHARACTER*17) (INPUT) C NPASS = THE NUMBER OF PASSES FOR THIS ANALYSIS. C UP TO 6 ARE ACCOMMODATED. ALSO CONTAINS C NREP AND NREPNO WHEN READ. (INPUT) C IER = ERROR RETURN. (OUTPUT) C ITABLE(I,L) = 4-WORD ID OF THE VARIABLES THAT ARE C ACCOMMODATED BY U405A (I=1,4) (L=1,JVAL). C (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C NONE C PARAMETER (JVAL=7) C JVAL MUST AGREE WITH THE VALUE IN U405A. C CHARACTER*4 STATE CHARACTER*17 ANLTAB C DIMENSION ID(4),IDPARS(15),JD(4) C DIMENSION ITABLE(4,JVAL) DIMENSION ELCORR(6,4) DIMENSION DUMMY(5) C IER=0 D WRITE(KFILDO,100) 100 FORMAT(' ') CALL TIMPR(KFILDO,KFILDO,'START RD45CN ') C C READ CONTROL INFORMATION ACCORDING TO THE VARIABLE TO BE C ANALYZED. C STATE='120 ' COPS OPEN(UNIT=KFILAN,FILE=ANLTAB,STATUS='OLD', OPEN(UNIT=KFILAN,STATUS='OLD', 1 IOSTAT=IOS,ERR=900) C C READ AND WRITE ANALYSIS SPECIFIC CONTROL PARAMETERS. THE C CONTENT OF THE FIRST RECORD IS DIFFERENT FOR SLP C THAN FOR OTHER VARIABLES. C STATE='1245' C READ(KFILAN,1245,IOSTAT=IOS,ERR=900) 1245 FORMAT(8I4,F8.0,1X,A16,5I4) C READ(KFILAN,126) 126 FORMAT(I4,4F6.2,4I3,2F6.0,I4,2I2,I4,F4.0,2I4,2X,6I1,2F4.0) C C READ THE RUN TIMES AND WEIGHTS FOR THEM. C STATE='128 ' READ(KFILAN,128,IOSTAT=IOS,ERR=900)NORUNS, 1 (DUMMY(J),J=1,5),(DUMMY(J),J=1,5),(DUMMY(J),J=1,5) 128 FORMAT(I4,5I6,/,(4X,5F6.0)) C DO 130 L=1,JVAL READ(KFILAN,1294,IOSTAT=IOS,ERR=900)(ITABLE(J,L),J=1,4) 1294 FORMAT(4I10) 130 CONTINUE C c CHECK CCCFFFB OF 1ST ID WORD AND THE 4TH ID WORD (THRESHOLD) C OF "ANALYSIS VARIABLE" READ WITH INCOMING ID( ). NOTE THAT C THIS DOES NOT CHECK THE 2ND WORD, SO THE PROBABILITY LEVEL, C MEAN, AND STANDARD DEVIATION OF ENSEMBLES CAN USE THE SAME C U405 CONTROL FILE. C IF(ID(1)/100.NE.ITABLE(1,1)/100.OR. 1 ID(4).NE.ITABLE(4,1))THEN WRITE(KFILDO,1300)ITABLE(1,1)/100,ITABLE(4,1), 1 ID(1)/100,ID(4) 1300 FORMAT(/,' ****IDS OF ANALYSIS VARIABLE READ IN U405A.CN', 1 ' DO NOT MATCH ANALYSIS DESIRED FROM U155.CN',/, 2 ' CCCFFFB AND 4TH ID READ HERE ARE ',I8,I11,/, 3 ' CCCFFFB AND 4TH ID FROM U155.CN ARE ',I8,I11,/, 4 ' U405 DID NOT COMPLETE.') STOP 1300 ENDIF C C READ NOMINAL MESH LENGTH TO USE FOR EACH PASS FOR EACH C POSSIBILITY OF FIRST GUESS. C 1306 STATE='1308' C DO 135 L=1,4 READ(KFILAN,1308,IOSTAT=IOS,ERR=900) 1308 FORMAT(6I8) 135 CONTINUE C C READ ERROR CRITERIA TO USE FOR EACH PASS FOR EACH POSSIBILITY C OF FIRST GUESS. C STATE='140 ' C DO 146 M=1,12 DO 145 L=1,4 READ(KFILAN,140,IOSTAT=IOS,ERR=900) 140 FORMAT(6F8.0) 145 CONTINUE 146 CONTINUE C C READ TYPE OF CORRECTION TO USE FOR EACH PASS FOR EACH C POSSIBILITY OF FIRST GUESS. C STATE='150 ' C DO 155 L=1,4 READ(KFILAN,1308,IOSTAT=IOS,ERR=900) 155 CONTINUE C C READ SMOOTHING PARAMETER TO USE FOR EACH PASS FOR EACH C POSSIBILITY OF FIRST GUESS. C STATE='160 ' C DO 165 L=1,4 READ(KFILAN,140,IOSTAT=IOS,ERR=900) 165 CONTINUE C C READ RADIUS OF INFLUENCE TO USE FOR EACH PASS FOR EACH C POSSIBILITY OF FIRST GUESS. C STATE='170 ' C DO 175 L=1,4 READ(KFILAN,140,IOSTAT=IOS,ERR=900) 175 CONTINUE C C READ TYPE OF INTERPOLATION TO USE IN COMPUTING C THE NEXT GRID FOR EACH PASS FOR EACH POSSIBILITY C OF FIRST GUESS. C STATE='180 ' C DO 185 L=1,4 READ(KFILAN,1308,IOSTAT=IOS,ERR=900) 185 CONTINUE C C READ RSTAR, THE FRACTION OF THE RADIUS OF INFLUENCE C TO USE DATA OUTSIDE THE ANALYSIS AREA FOR EACH PASS C FOR EACH POSSIBILITY OF FIRST GUESS. C STATE='190 ' C DO 193 L=1,4 READ(KFILAN,140,IOSTAT=IOS,ERR=900) 193 CONTINUE C C READ FLAGS TO DETERMINE HOW THE LAND/SEA CORRECTIONS C WILL BE MADE. C STATE='197 ' C DO 199 L=1,4 READ(KFILAN,1308,IOSTAT=IOS,ERR=900) 199 CONTINUE C C READ TYPE OF CORRECTION ALGORITHM TO APPLY. C STATE='1991' C DO 1993 L=1,4 READ(KFILAN,1308,IOSTAT=IOS,ERR=900) 1993 CONTINUE C C READ FRACTION OF ELEVATION CORRECTION TO APPLY TO C USUAL, OR EXPECTED, LAPSE RATES. C STATE='1995' C DO 200 L=1,4 READ(KFILAN,140,IOSTAT=IOS,ERR=900)(ELCORR(J,L),J=1,NPASS) C IF(L.EQ.1)THEN WRITE(KFILDO,1995)NPASS 1995 FORMAT(' ELCORR FOR ',I3,' PASSES') ENDIF C WRITE(KFILDO,1996)L,(ELCORR(J,L),J=1,NPASS) 1996 FORMAT(' FOR FIRST GUESS OPTION',I2,4X,6F8.2) C 200 CONTINUE CALL TIMPR(KFILDO,KFILDO,'END RD45CN ') RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 900 CALL IERX(KFILDO,KFILDO,IOS,'RD45CN',STATE) CALL W3TAGE('RD45CN') STOP 900 END