SUBROUTINE RDVRHL(KFILDO,KFILSL,FILESL,IP14, 1 CCALL,NAME,VRAD,ELEVLO,ELEVHI,R, 2 NPROJ,ORIENT,BMESH,XLAT,ALATL,ALONL, 3 ND1,NSTA,NBASTA,PREC3,ISTOP,IER) C C OCTOBER 2007 GLAHN MDL MOS-2000 C FEBRUARY 2008 GLAHN ADDED GO TO 119 BELOW 137 C MARCH 2008 COSGROVE ADDED COMMAS TO FORMATS 132,137, C AND 145 FOR IBM COMPILE C MAY 2008 GLAHN MODIFIED TO BE CALLED FROM U405A C TO BE SPECIFIC TO ELEMENT C MAY 2008 GLAHN MODIFIED DIAGNOSTIC WRITING; ADDED C IWRIT1 AND IWRIT2 C JUNE 2008 GLAHN ADDED READING AND PRINTING OF FILE C NAME ON UNIT KFILSL C OCTOBER 2008 COSGROVE ADDED COMMAS TO FORMATS FOR IBM C COMPILE C MARCH 2009 GLAHN ADDED TO DIAGNOSTIC 145 C MAY 2009 GLAHN UPDATED FOR EXPANDED U178 FILE ID C MAY 2009 GLAHN ADDED NPROJ,ORIENT,BMESH,XLAT,ALATL, C AND ALONL TO CALL, MODIFIED INFO C READ FROM RADII FILE, AND DID SOME C CHECKING OF CONSISTENCY OF INPUTS. C JULY 2009 GLAHN MODIFIED TO TRANSFORM 5 KM RADII C TO 3 KM BASED ON BMESH AND BMESHI C SEPTEMBER 2009 GAW MODIFIED OPEN STATEMENT FOR OPERATIONS C JULY 2010 GLAHN MODIFIED DIAGNOSTIC 1090 C JULY 2010 GLAHN CORRECTED TO NOT SAVE SAVFL WHEN C FILE NOT READ C OCTOBER 2013 GLAHN MODIFIED TO SAVE VRAD( , ) TO C VRADSV( , ) WHEN FILE IS READ TO C USE ON A DUPLICATE ENTRY; ADDED C VRADSV( , ) C NOVEMBER 2018 GLAHN ADDED NBASTA AND PREC3 TO CALL C AND USED THEM C APRIL 2018 GLAHN ADJUSTMENT OF CODE IN DO 150 LOOP; C DIAGNOSTICS C MAY 2019 GLAHN IMPROVED DIAGNOSTIC 151 C C PURPOSE C READS A FILE CONTAINING CALL LETTERS, SIX RADII OF C INFLUENCE FOR U155, AND THE HIGHEST AND LOWEST TERRAIN C ELEVATIONS WITHIN THE LARGEST R FOR EACH STATION. THE C ELEVATIONS ARE USED IN DETERMINING THE LAPSE RATE FROM C UPPER AIR DATA IN U405 AS NEEDED. THE DATA READ ARE ASCII C SO THAT EDITING CAN BE DONE AS NEEDED. C (REPLACES RDVRAD) C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C IP14 - UNIT NUMBER FOR WRITING LIST OF STATIONS AND C ASSOCIATED RADII AND ELEVATIONS. (OUTPUT) C KFILSL - UNIT NUMBER FOR READING THE STATIONS AND C ASSOCIATED RADII AND ELEVATIONS. (INPUT) C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILSL = UNIT NUMBER FOR READING THE STATIONS AND C ASSOCIATED RADII AND ELEVATIONS. (INPUT) C FILESL = NAME OF DATA SET FOR READING THE VARIABLE C RADII AND HI AND LO ELEVATIONS. C (CHARACTER*60) (INPUT) C IP14 = UNIT NUMBER FOR WRITING LIST OF STATIONS AND C ASSOCIATED RADII AND ELEVATIONS. (INPUT) C CCALL(K) = IDENTIFIERS OF STATIONS BEING USED (K=1,NSTA). C (CHARACTER*8) (INPUT) C NAME(K) = NAMES OF STATIONS BEING USED (K=1,NSTA). USED C FOR PRINTING ONLY. (CHARACTER*20) (INPUT) C VRAD(K,L) = RADII READ FROM UNIT NO. KFILSL C (K=1,NSTA) (L=1,6). (OUTPUT) C ELEVLO(K) = THE LOW ELEVATION ASSOCIATED WITH STATION C CCALL(K) READ FROM UNIT NO. KFILSL C (K=1,NSTA). (OUTPUT) C ELEVHI(K) = THE HIGH ELEVATION ASSOCIATED WITH STATION C CCALL(K) READ FROM UNIT NO. KFILSL C (K=1,NSTA). (OUTPUT) C R(J) = RADIUS OF INFLUENCE FOR EACH PASS J (J=1,NPASS) C FOR THE FIRST GUESS OPTION BEING USED IN TERMS C OF MESH GRID UNITS BEING USED ON THAT PASS. C THIS IS USED IN CASE THERE IS A STATION WITH C NO VARIABLE LIST IN VRAD( , ). (INPUT) C NPROJ = NUMBER OF MAP PROJECTION TO WHICH THIS GRID C APPLIES. C 3 = LAMBERT. C 5 = POLAR STEREOGRAPHIC. C 7 = MERCATOR. C (INPUT) C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. (INPUT) C BMESH = ACTUAL MESH LENGTH CORRESPONDING TO MESHB. C (INPUT) C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED C IN DEGREES. (INPUT) C ALATL = NORTH LATITUDE OF LOWER LEFT CORNER POINT C OF A GRID OF THE SIZE NXL, NYL. TRUNCATED C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF C DEGREES. (INPUT) C ALONL = WEST LONGITUDE OF LOWER LEFT CORNER POINT C OF A GRID OF THE SIZE NXL, NYL. TRUNCATED C TO TEN THOUSANDTHS OF DEGREES. NOTE THAT THE C MOS-2000 ARCHIVE IS ONLY TO THOUSANDTHS OF C DEGREES. (INPUT) C ND1 = DIMENSION OF CCALL( ), NAME( ), VRAD( ), C ELEVLO( ), AND ELEVHI( ). (INPUT) C NSTA = NUMBER OF VALUES IN CCALL( ) AND NAME( ). C (INPUT) C NBASTA = NUMBER OF STATIONS (NSTA) BEFORE THE ONES C AT GRIDPOINTS WERE ADDED BY BOGUSG. (INPUT) C PREC3 = THE RADIUS TO USE AT THE BOGUSG POINTS. C (INPUT) C ISTOP = INCREMENTED BY ONE WHEN AN ERROR OCCURS. C (INPUT/OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 777 = ERROR. C (OUTPUT) C STATE = VARIABLE SET TO STATEMENT NUMBER TO INDICATE C WHERE AN ERROR OCCURRED. (CHARACTER*4) C (INTERNAL) C MAXSTA = THE MAXIMUM NUMBER OF STATIONS DEFINED IN C U178 TO AFFECT A SPECIFIC GRIDPOINT NO MORE C THAN XDIST GRID LENGTHS AWAY. READ FROM C UNIT NO. KFILSL. (INTERNAL) C XDIST = SEE MAXSTA. (INTERNAL) C IFIRST = CONTROLS PRINTING AND SPACING OF DIAGNOSTICS. C (INTERNAL) C IWRIT1 = CONTROLS WRITING OF DIAGNOSTIC AT 137. C A STATION LIST MAY BE USED (ESPECIALLY WHEN C MULTIPLE ELEMENTS ARE ANALYZED IN ONE RUN) C THAT IS LARGER THAN THE LIST USED TO CREATE C THE RADII LIST. THIS COULD CREATE MANY WRITES. C ONLY ONE INSTANCE IS WRITTEN PER ENTRY WITH C A ****, AND IS NOT COUNTED AS AN ERROR. C ASCIFM = NAME OF STATION LIST FILE FROM WHICH THE C U178 RUN WAS MADE. READ FROM UNIT NO KFILSL. C (INTERNAL) C IWRIT2 = CONTROLS WRITING OF DIAGNOSTIC(K=1,NSTA) (L=1,6). C VRADSV(K,L) = SAVED FROM VRAD(K,L) WHEN READ. USED TO RESTORE C VRAD(K,L) ON A FOLLUP ENTRY WHEN THE SAME FILE C IS FURNISHED AND NOT ACTUALLY READ C (K=1,NSTA) (L=1,6). (INTERNAL) (ALLOCATABLE) C (SAVE) C MFIRST = 0 ON ENTRY BY DATA STATEMENT. BECOMES 1 WHEN C VRADSV( , ) IS ALLOCATED. (INTERNAL) (SAVE) C 1 2 3 4 5 6 7 X C CHARACTER*4 STATE CHARACTER*8 CCALL(NSTA),CCALLD CHARACTER*20 NAME(NSTA) CHARACTER*60 FILESL,SAVFL,ASCIFM,TOSS C DIMENSION VRAD(ND1,6),ELEVHI(ND1),ELEVLO(ND1) DIMENSION TRASH(6),R(6) C ALLOCATABLE VRADSV(:,:) C DATA SAVFL/' '/ DATA MFIRST/0/ C SAVE SAVFL,VRADSV,MFIRST C CALL TIMPR(KFILDO,KFILDO,'START RDVRHL ') C IER=0 IFIRST=0 IWRIT1=0 IWRIT2=0 C D WRITE(KFILDO,100)ND1,NSTA,KFILSL,IP14,FILESL,SAVFL D100 FORMAT(/' AT 100 IN RDVRHL--ND1,NSTA,KFILSL,IP14',4I6/ D 1 5X,A60/ D 2 5X,A60) C C OPEN FILE IF NECESSARY. C COPS NOTE THAT THIS CHECK CAUSES A PROBLEM IN OPERATIONS IF YOU DO COPS OUR STANDARD PROCEDURE OF JUST HAVING A UNIT NUMBER WITH NO FILENAME. COPS IT WILL NEVER OPEN ANY RADII FILE. SO PUT SOME DUMMY STRING IN FOR THE COPS FILENAME SO THAT IT DOESN'T MATCH SAVFL WHICH IS SET TO BLANK C IF(FILESL.EQ.SAVFL)THEN WRITE(KFILDO,101)FILESL 101 FORMAT(/' SAME RADII FILE USED AS PREVIOUS = ',A60) C C RESTORE VRAD( , ) FROM VRADSV( , ). C DO 1015 L=1,6 DO 1014 K=1,NSTA VRAD(K,L)=VRADSV(K,L) 1014 CONTINUE 1015 CONTINUE C GO TO 160 ENDIF C STATE='102 ' COPS OPEN(UNIT=KFILSL,FILE=FILESL,STATUS='OLD', OPEN(UNIT=KFILSL,STATUS='OLD', 1 IOSTAT=IOS,ERR=900) SAVFL(1:60)=FILESL(1:60) C FILE NAME IS SAVED SO THAT RDVRHL WON'T HAVE TO BE EXECUTED C AGAIN UNLESS A DIFFERENT RADII FILE IS USED AS FOR THE C PREVIOUS ENTRY. WRITE(KFILDO,102)KFILSL,FILESL 102 FORMAT(/,' OPENING OLD FILE ON UNIT NO.',I3,' FILE = ',A60) C C INITIALIZE VRAD( , ), ELEVHI( ), AND ELEVLO( ). C DO 105 K=1,NBASTA C DO 104 L=1,6 VRAD(K,L)=0. 104 CONTINUE C ELEVHI(K)=999999. ELEVLO(K)=999999. 105 CONTINUE C C SKIP FILE IDENTIFICATION. C STATE=' 109' READ(KFILSL,109,IOSTAT=IOS,ERR=900,END=1200)TOSS 109 FORMAT(A60) D WRITE(KFILDO,1090)TOSS D1090 FORMAT(' FILE PREPARATION = ',A60) C THE ABOVE SKIPS THE DATE TIME STAMP. C STATE=' 110' READ(KFILSL,110,IOSTAT=IOS,ERR=900,END=1200)NPROJI,ORIENTI, 1 BMESHI,XLATI,ALATLI,ALONLI,NXI,NYI,MAXSTA,XDIST,ASCIFM 110 FORMAT(20X,I8/ 1 20X,F8.0/ 2 20X,F8.0/ 3 20X,F8.0/ 4 20X,F8.0/ 5 20X,F8.0/ 5 20X,I8/ 6 20X,I8/ 7 20X,I8/ 8 20X,F8.0/ 9 12X,A60) C WRITE(KFILDO,112)MAXSTA,XDIST,BMESHI,ASCIFM 112 FORMAT(/,' VARIABLE RADIUS LIST READ FOR MAXSTA =',I6, 1 ' AND MAXIMUM DISTANCE =',F10.1, 2 ' AT ACTUAL GRID LENGTH =',F9.4,/, 3 ' PREPARED BY U178 FROM STATION LIST FILE NAME ',A60) C C CHECK INPUTS WITH WHAT IS EXPECTED. C IF(NPROJ.NE.NPROJI.OR. 1 ORIENT.NE.ORIENTI.OR. 2 XLAT.NE.XLATI.OR. 3 ABS(ALATL-ALATLI).GT..001.OR. 4 ABS(ALONL-ALONLI).GT..001)THEN WRITE(KFILDO,1125)NPROJ,NPROJI,ORIENT,ORIENTI,BMESH,BMESHI, 1 XLAT,XLATI,ALATL,ALATLI,ALONL,ALONLI 1125 FORMAT(/' ****VALUES READ FROM RADII FILE IN RDVRHL ARE NOT', 1 ' WHAT ARE EXPECTED.'/ 2 ' NPROJ =',I10, ' NPROJI FROM FILE =',I10/ 3 ' ORIENT =',F10.4,' ORIENTI FROM FILE =',F10.4/ 4 ' BMESH =',F10.4,' BMESHI FROM FILE =',F10.4/ 5 ' XLAT =',F10.4,' XLATI FROM FILE =',F10.4/ 6 ' ALATL =',F10.4,' ALATLI FROM FILE =',F10.4/ 7 ' ALONL =',F10.4,' ALONLI FROM FILE =',F10.4) ISTOP=ISTOP+1 SAVFL(1:5)='ERROR' C MAKE SURE THE NEXT ENTRY DOESN'T THINK FILE HAS BEEN READ. IER=777 C THIS IS CONSIDERED A FATAL ERROR. GO TO 160 ELSEIF(ABS(BMESH-BMESHI).GT..001)THEN WRITE(KFILDO,1127)BMESH 1127 FORMAT(' VARIABLE RADII BEING INCREASED. RADII COMPUTED', 1 ' ON BASIS OF NOMINAL 5 KM ACCEPTED FOR',F8.4,' KM.') ENDIF C IF(IP14.NE.0)THEN WRITE(IP14,113) 113 FORMAT(' ') WRITE(IP14,114)MAXSTA,XDIST 114 FORMAT(' RADII AND MAXIMUM AND MINIMUM ELEVATIONS', 1 ' FOR STATIONS FOR EACH GRIDPOINT TO BE AFFECTED BY', 2 ' UP TO',I5,' STATIONS',/, 3 ' WITHIN A RADIUS OF',F7.0,' GRIDLENGTHS.',/) WRITE(IP14,115) 115 FORMAT(' STATION',51X, 1 'RADII',25X,'MAX ELEVATION MIN ELEVATION') ENDIF C ISTART=1 IEND=NBASTA C ISTART AND IEND ARE FOR SEARCHING IN LOOP BELOW. C STATE=' 119' 119 READ(KFILSL,120,IOSTAT=IOS,ERR=900,END=1200)CCALLD, 1 (TRASH(J),J=1,6),TRLO,TRHI 120 FORMAT(' ',A8,2X,6F12.2,2F8.0) GO TO 122 C 1200 WRITE(KFILDO,1201)KFILSL 1201 FORMAT(/,' ****PREMATURE END OF VARIABLE RADIUS AND', 1 ' ELEVATION LIST. NO TERMINATOR FOUND ON', 2 ' FILE KFILSL =',I4) ISTOP=ISTOP+1 SAVFL(1:5)='ERROR' C MAKE SURE THE NEXT ENTRY DOESN'T THINK FILE HAS BEEN READ. IER=777 C THIS IS CONSIDERED A FATAL ERROR. GO TO 160 C C FIND STATION IN LIST. C 122 IF(CCALLD.EQ.'99999999')GO TO 140 C THIS IS THE TERMINATOR. C 130 DO 135 K=ISTART,IEND C CCC WRITE(KFILDO,1300)ISTART,IEND,K,CCALLD,CCALL(K) CCC 1300 FORMAT(' AT 1300 IN RDVRHL--ISTART,IEND,K,CCALLD,CCALL(K)', CCC 1 3I6,2X,A8,2X,A8) C IF(CCALLD.EQ.CCALL(K))THEN C DO 131 L=1,6 VRAD(K,L)=TRASH(L) 131 CONTINUE C ELEVLO(K)=TRLO ELEVHI(K)=TRHI ISTART=K C SET TO K NOT K+1, TO AVOID DIFFICULTY AT END OF LIST. C IF(IP14.NE.0)THEN WRITE(IP14,132)CCALL(K),NAME(K),(VRAD(K,L),L=1,6), 1 ELEVHI(K),ELEVLO(K) 132 FORMAT(' ',A8,2X,A20,2X,6F12.2,2F8.0) ENDIF C GO TO 119 ENDIF C 135 CONTINUE C IF(ISTART.NE.1)THEN ISTART=1 GO TO 130 ELSE IF(IWRIT1.EQ.0)THEN IWRIT1=IWRIT1+1 WRITE(KFILDO,137)CCALLD 137 FORMAT(/' ****IDENTIFIER ',A8,'IN RADII FILE NOT FOUND IN', 1 ' STATION LIST.', 2 ' MAY NOT BE AN ERROR AND IS NOT COUNTED AS AN', 3 ' ISTOP ERROR.',/,' THIS DIAGNOSTIC WILL NOT', 4 ' PRINT AGAIN.') ELSE IWRIT1=IWRIT1+1 ENDIF C GO TO 119 ENDIF C 140 IF(IWRIT1.GT.0)THEN WRITE(KFILDO,141)IWRIT1 141 FORMAT(' THERE WERE ',I7,' SUCH IDENTIFIERS NOT FOUND.') ENDIF C D DO 143 K=1,NBASTA D WRITE(KFILDO,142)K,CCALL(K),(VRAD(K,J),J=1,6),ELEVLO(K),ELEVHI(K) D142 FORMAT(' RDVRHL-K,CCALL(K),(VRAD(K,J),J=1,6),ELEVLO(K),ELEVHI(K)', D 1 I6,2X,A8,F5.1,5F7.1,2F8.0) D143 CONTINUE C C CHECK TO SEE WHETHER ALL STATIONS HAVE DATA READ IN. C DO 150 K=1,NBASTA C IF(VRAD(K,1).EQ.0..OR.ELEVLO(K).GT.888887.)THEN C INCOMING ELEVLO( ) CAN BE 888888 IN SOME VARIATIONS C OF U179; 999999 IS MORE LIKELY. C IF(VRAD(K,1).EQ.0.)THEN C THIS STATION NOT FOUND ON FILE WITH A LEGITIMATE RADIUS. WRITE(KFILDO,1433)CCALL(K),NAME(K) 1433 FORMAT(' ****STATION ',A8,2X,A20,' MISSING OR HAS ZERO', 1 ' RADIUS. USE DEFAULT IN R( ).', 2 ' COUNTED AS AN ISTOP ERROR.') ISTOP=ISTOP+1 NADJ=0 C ADJUSTMENT OR RADIUS FOR GRIDLENGTH IS NOT NEEDED. C DO 1435 L=1,6 VRAD(K,L)=R(L) 1435 CONTINUE C ELSEIF(ELEVLO(K).GT.888887.)THEN C INCOMING ELEVLO( ) CAN BE 888888 IN SME VARIATIONS C OF U179; 999999 IS MORE LIKELY. IWRIT2=IWRIT2+1 NADJ=1 C ADJUSTMENT OR RADIUS FOR GRIDLENGTH MAY BE NEEDED. C IF(IWRIT2.LE.2)THEN IF(IFIRST.EQ.0)THEN WRITE(KFILDO,144)CCALL(K),NAME(K) 144 FORMAT(/' ****STATION ',A8,2X,A20,' HAS MISSING', 1 ' HI AND LO ELEVATIONS ON FILE.', 2 ' NOT COUNTED AS AN ISTOP ERROR.') IFIRST=IFIRST+1 ELSE WRITE(KFILDO,145)CCALL(K),NAME(K) 145 FORMAT(' ****STATION ',A8,2X,A20,' HAS MISSING', 1 ' HI AND LO ELEVATIONS ON FILE.', 4 ' NOT COUNTED AS AN ISTOP ERROR.',/, 3 ' THIS DIAGNOSTIC WILL NOT PRINT AGAIN.') ENDIF C ENDIF C IF(IP14.NE.0.AND.IP14.NE.KFILDO)THEN C IF(IFIRST.LE.1)THEN WRITE(IP14,144)CCALL(K),NAME(K) IFIRST=IFIRST+1 ELSE WRITE(IP14,144)CCALL(K),NAME(K) ENDIF C ENDIF C ENDIF C ELSE NADJ=1 C ADJUSTMENT OR RADIUS FOR GRIDLENGTH MAY BE NEEDED. ENDIF C C IT IS ASSUMED FOR THE CONUS AREA (NPROJ = 3 FOR LAMBERT), C THE RADII ARE CALCULATED BY U178 AT NOMINAL 5 KM, AND IF C THIS RUN IS FOR 3 OR 1.5 KM, THE RADII ARE MULTIPLIED C 2 OR 4, RESPECTIVELY. THIS KEEPS RUNNING OF U178 SIMPLER. C NOTE THAT THE DEFAULT RADII FROM U405A.CN ARE NOT MODIFIED. C C THIS IS A HOLDOVER AND PROBABLY NOT NEEDED. IT IS LEFT C IN FOR SAFETY. C IF(NADJ.EQ.1)THEN C IF(NPROJ.EQ.3.AND.(BMESHI.GT.4.AND.BMESHI.LT.6))THEN C THIS IS CONUS LAMBERT AND THE U178 INPUT IS 5 KM. C THE U178 INPUT COULD BE AT 3 OR 1.5 KM, AND THEN THE C RADII WOULD NOT BE MODIFIED. C IF(BMESH.GT.2.AND.BMESH.LT.3)THEN C DO 149 L=1,6 VRAD(K,L)=VRAD(K,L)*2. 149 CONTINUE C ELSEIF(BMESH.GT.1.AND.BMESH.LT.2)THEN C DO 1490 L=1,6 VRAD(K,L)=VRAD(K,L)*4. 1490 CONTINUE C ENDIF C ENDIF C ENDIF C 150 CONTINUE C IF(IWRIT2.GT.0)THEN WRITE(KFILDO,151)IWRIT2 151 FORMAT(' THERE WERE ',I7,' SUCH STATION IDENTIFIERS', 1 ' FOUND WITH MISSING MAX AND MIN ELEVATIONS.', 2 ' SEE IP14 FOR A MORE FULL EXPLANATION.'/ 3 ' THESE ARE PROBABLY STATIONS OUTSIDE THE GRID.') ENDIF C C IF BOGUS STATIONS AT GRIDPOINTS HAVE BEEN ADDED BY BOGUSG, C INSERT RADII FOR THEM FROM PREC3. C IF(NSTA.GT.NBASTA)THEN C DO 1516 L=1,6 DO 1515 K=NBASTA+1,NSTA VRAD(K,L)=PREC3 1515 CONTINUE 1516 CONTINUE C ELSEIF(NBASTA.GT.NSTA)THEN WRITE(KFILDO,1517) 1517 FORMAT(/' ****NBASTA =',I10,' GT NSTA =',I10, 1 ' IN RDVRHL. STOP AT 1517.') STOP 1517 ELSE WRITE(KFILDO,1518)NSTA 1518 FORMAT(/' NO STATIONS WERE ADDED BY BOGUSG.', 1 ' NUMBER OF STATIONS =',I8) ENDIF C IF(MFIRST.EQ.0)THEN C ALLOCATE VRADSV( , ). ALLOCATE (VRADSV(NSTA,6),STAT=IOS) MFIRST=1 C SETTING MFIRST = 1 KEEPS ALLOCATION FROM BEING DONE C AGAIN. THE ARRAY IS NOT DEALLOCATED; THERE IS NO C REASON TO. C IF(IOS.EQ.1)THEN WRITE(KFILDO,152) 152 FORMAT(/' ****ALLOCATION OF VRADSV( , )', 1 ' FAILED IN RDVRHL AT 152.', 2 ' ARRAYS ALREADY ALLOCATED.') SAVFL=' ' C BECAUSE VRADSV( , ) COULDN'T BE ALLOCATED, VRAD( , ) C COULDN'T BE SAVED, AND THE FILE MUST BE READ AGAIN. C OBLITERATING THE FILE NAME WILL MAKE THAT HAPPEN. GO TO 160 C ELSEIF(IOS.EQ.2)THEN WRITE(KFILDO,153) 153 FORMAT(/' ****ALLOCATION OF VRADSV( , )', 1 ' FAILED IN RDVRHL AT 153.', 2 ' ARRAYS NOT ALLOCATED.') SAVFL=' ' C BECAUSE VRADSV( , ) COULDN'T BE ALLOCATED, VRAD( , ) C COULDN'T BE SAVED, AND THE FILE MUST BE READ AGAIN. C OBLITERATING THE FILE NAME WILL MAKE THAT HAPPEN. GO TO 160 C ENDIF C ENDIF C C ALLOCATION WAS SUCCESSFUL. C SAVE VRAD( , ) INTO VRADSV( , ). THIS KEEPS THE READING C AND SEARCHING FROM BEING DONE DUPLICATE TIMES. C DO 155 L=1,6 DO 154 K=1,NSTA VRADSV(K,L)=VRAD(K,L) 154 CONTINUE 155 CONTINUE C 160 CLOSE(UNIT=KFILSL) C FILE IS CLOSED BECAUSE ROUTINE MAY BE ENTERED AGAIN TO C USE THE SAME UNIT NUMBER. C CALL TIMPR(KFILDO,KFILDO,'END RDVRHL ') C RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. C 900 CALL IERX(KFILDO,KFILDO,IOS,'RDVRHL',STATE) WRITE(KFILDO,901) 901 FORMAT(' FATAL SYSTEM ROUTINE ERROR IN RDVRHL.') ISTOP=ISTOP+1 SAVFL(1:5)='ERROR' C MAKE SURE THE NEXT ENTRY DOESN'T THINK FILE HAS BEEN READ. IER=777 GO TO 160 END