1 2 SUBROUTINE OURANK 3 !*********************************************************************** 4 ! OURANK Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: To Process RANKFILE Output Selections 7 ! 8 ! PROGRAMMER: Roger Brode 9 ! 10 ! DATE: November 29, 1993 11 ! 12 ! INPUTS: Input Runstream Parameters 13 ! 14 ! OUTPUTS: Output Option Switches 15 ! 16 ! CALLED FROM: OUCARD 17 !*********************************************************************** 18 19 ! Variable Declarations 20 USE MAIN1 21 IMPLICIT NONE 22 CHARACTER MODNAM*12 23 24 SAVE 25 INTEGER :: I , J , K , IPRDT 26 LOGICAL FOUND 27 28 ! Variable Initializations 29 MODNAM = 'OURANK' ! 0 30 31 ! Check If Enough Fields 32 IF ( IFC.EQ.2 ) THEN 33 ! Error Message: No Fields 34 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 35 GOTO 999 36 ELSEIF ( IFC.LT.5 ) THEN 37 ! Error Message: Not Enough Fields 38 CALL ERRHDL(PATH,MODNAM,'E','201',KEYWRD) ! 0 39 GOTO 999 40 ELSEIF ( IFC.GT.6 ) THEN 41 ! Error Message: Too Many Fields 42 CALL ERRHDL(PATH,MODNAM,'E','202',KEYWRD) ! 0 43 GOTO 999 44 ENDIF 45 46 ! Retrieve Averaging Period 47 IF ( FIELD(3).EQ.'MONTH' .AND. MONTH ) THEN ! 0 48 ! Set Value of IPRDT = 720 for MONTHly Averages 49 IPRDT = 720 ! 0 50 ELSE 51 CALL STONUM(FIELD(3),ILEN_FLD,FNUM,IMIT) ! 0 52 IF ( IMIT.NE.1 ) THEN 53 ! Write Error Message:Invalid Numerical Field 54 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 55 GOTO 999 56 ENDIF 57 IPRDT = INT(FNUM) ! 0 58 ENDIF 59 60 ! Check Averaging Period Against KAVE Array 61 FOUND = .FALSE. ! 0 62 J = 1 63 DO WHILE ( .NOT.FOUND .AND. J.LE.NUMAVE ) 64 IF ( IPRDT.EQ.KAVE(J) ) THEN ! 0 65 FOUND = .TRUE. ! 0 66 INDAVE = J 67 ENDIF 68 J = J + 1 ! 0 69 ENDDO 70 IF ( .NOT.FOUND ) THEN ! 0 71 ! Error Message:E203 AVEPER Not Match With Pre-Defined One 72 CALL ERRHDL(PATH,MODNAM,'E','203','AVEPER') ! 0 73 GOTO 999 74 ENDIF 75 76 ! Check for MAXTABLE Option for this INDAVE; Then Set Switch and 77 ! Check for Previous RANKFILE Card for This Averaging Period 78 IF ( MAXAVE(INDAVE).EQ.1 ) THEN ! 0 79 IRNKFL(INDAVE) = IRNKFL(INDAVE) + 1 ! 0 80 ELSE 81 ! Error Message:E203 AVEPER Not Match With MAXTABLE Options 82 CALL ERRHDL(PATH,MODNAM,'E','203','AVEPER') ! 0 83 GOTO 999 84 ENDIF 85 IF ( IRNKFL(INDAVE).GT.1 ) THEN ! 0 86 ! WRITE Error Message 87 CALL ERRHDL(PATH,MODNAM,'E','211',KEYWRD) ! 0 88 GOTO 999 89 ENDIF 90 91 ! Retrieve Rank Number (number of values to output) 92 CALL STONUM(FIELD(4),ILEN_FLD,FNUM,IMIT) ! 0 93 ! Check for Valid Threshold Value 94 IF ( IMIT.NE.1 ) THEN 95 ! Write Error Message:Invalid Numerical Field 96 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 97 GOTO 999 98 ENDIF 99 INUM = INT(FNUM) ! 0 100 IF ( INUM.GT.NMAX ) THEN 101 ! WRITE Error Message: Maximum Value Selected Exceeds NMAX 102 WRITE (DUMMY,'(I8)') NMAX ! 0 103 CALL ERRHDL(PATH,MODNAM,'E','280',DUMMY) 104 GOTO 999 105 ELSEIF ( INUM.GT.IMXVAL(INDAVE) ) THEN 106 ! WRITE Error Message: Maximum Value Selected Exceeds IMXVAL 107 CALL ERRHDL(PATH,MODNAM,'E','203','RANKVALU') ! 0 108 GOTO 999 109 ELSE 110 IRKVAL(INDAVE) = INUM ! 0 111 ENDIF 112 113 IF ( (LOCE(5)-LOCB(5)).LE.39 ) THEN ! 0 114 ! Retrieve Filename as Character Substring to Maintain Original Case 115 ! Also Check for Filename Larger Than 40 Characters 116 RNKFIL(INDAVE) = RUNST1(LOCB(5):LOCE(5)) ! 0 117 ELSE 118 ! WRITE Error Message: RNKFIL Field is Too Long 119 CALL ERRHDL(PATH,MODNAM,'E','203',' FILNAM ') ! 0 120 ENDIF 121 122 ! Retrieve File Unit If Input, or Assign File Unit and OPEN File 123 IF ( IFC.EQ.6 ) THEN ! 0 124 CALL STONUM(FIELD(6),ILEN_FLD,FNUM,IMIT) ! 0 125 ! Check for Valid Threshold Value 126 IF ( IMIT.NE.1 ) THEN 127 ! Write Error Message:Invalid Numerical Field 128 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 129 GOTO 999 130 ENDIF 131 ! Check for Conflict With System Files 132 IF ( FNUM.LE.25. ) THEN ! 0 133 ! WRITE Error Message: Invalid File Unit Specified 134 CALL ERRHDL(PATH,MODNAM,'E','560',KEYWRD) ! 0 135 GOTO 999 136 ELSEIF ( FNUM.GT.100 ) THEN 137 ! WRITE Warning Message: Suspect File Unit Specified 138 ! Unit May Conflict With Dynamically Allocated File Units 139 CALL ERRHDL(PATH,MODNAM,'W','565',KEYWRD) ! 0 140 IRKUNT(INDAVE) = INT(FNUM) 141 ELSE 142 IRKUNT(INDAVE) = INT(FNUM) ! 0 143 ENDIF 144 ELSE 145 ! Dynamically Allocate File Unit (100's) 146 IRKUNT(INDAVE) = 100 + INDAVE ! 0 147 ENDIF 148 149 ! Check for Earlier Use of This Filename and File Unit 150 FOUND = .FALSE. ! 0 151 DO I = 1 , NUMAVE 152 IF ( I.NE.INDAVE ) THEN ! 0 153 IF ( RNKFIL(INDAVE).EQ.RNKFIL(I) .AND. IRKUNT(INDAVE) & 154 & .EQ.IRKUNT(I) ) THEN 155 FOUND = .TRUE. ! 0 156 ELSEIF ( RNKFIL(INDAVE).EQ.RNKFIL(I) .AND. IRKUNT(INDAVE) & 157 & .NE.IRKUNT(I) ) THEN 158 ! Write Error Message: Conflicting Inputs 159 CALL ERRHDL(PATH,MODNAM,'E','550',KEYWRD) ! 0 160 GOTO 999 161 ELSEIF ( RNKFIL(INDAVE).NE.RNKFIL(I) .AND. IRKUNT(INDAVE) & 162 & .EQ.IRKUNT(I) ) THEN 163 ! Write Error Message: Conflicting Inputs 164 CALL ERRHDL(PATH,MODNAM,'E','550',KEYWRD) ! 0 165 GOTO 999 166 ENDIF 167 ENDIF 168 ENDDO 169 170 ! First Time File is Identified - OPEN File 171 IF ( .NOT.FOUND ) OPEN (IRKUNT(INDAVE),ERR=99,FILE=RNKFIL(INDAVE),& 172 & FORM='FORMATTED',IOSTAT=IOERRN, & 173 & STATUS='UNKNOWN') 174 175 GOTO 999 ! 0 176 177 ! WRITE Error Message for Error Opening File 178 99 WRITE (DUMMY,'("RNKFL",I3.3)') IRKUNT(INDAVE) ! 0 179 CALL ERRHDL(PATH,MODNAM,'E','500',DUMMY) 180 181 ! Set Logical Switch Indicating That Ranked Value File(s) Are Generated 182 999 RKFILE = .TRUE. ! 0 183 184 CONTINUE 185 END
HyperKWIC - Version 1.00DD executed at 20:00 on 1 Mar 2018 | Personal or Academic or Evaluation User | Free for Non-Commercial, Non-Government Use