1 2 SUBROUTINE DAYRNG 3 !*********************************************************************** 4 ! DAYRNG Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Process the Selection of Days and Ranges of Days 7 ! for Processing from the Meteorology File 8 ! 9 ! PROGRAMMER: Roger Brode, Jeff Wang 10 ! 11 ! DATE: March 2, 1992 12 ! 13 ! INPUTS: Input Runstream Image Parameters 14 ! 15 ! OUTPUTS: Array of Dates to Process from Meteorological File 16 ! 17 ! ERROR HANDLING: Checks for Too Few Parameters; 18 ! Checks for Invalid Numeric Fields; 19 ! Checks for Improper Combinations of Fields; 20 ! Checks for Dates Out of Range 21 ! 22 ! CALLED FROM: MECARD 23 !*********************************************************************** 24 25 ! Variable Declarations 26 USE MAIN1 27 IMPLICIT NONE 28 CHARACTER MODNAM*12 29 30 SAVE 31 INTEGER :: I , K , IMN , IDY , IMN1 , IDY1 , IMN2 , IDY2 , JDAYB ,& 32 & JDAYE 33 CHARACTER BEGRNG*8 , ENDRNG*8 , CMN1*8 , CDY1*8 , CMN2*8 , CDY2*8 34 CHARACTER BLNK08*8 35 LOGICAL RMARK , GMARK 36 37 ! Variable Initializations 38 MODNAM = 'DAYRNG' ! 0 39 DATA BLNK08/' '/ 40 41 IF ( IFC.LT.3 ) THEN 42 ! WRITE Error Message ! No Parameters 43 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 44 ELSE 45 DO I = 3 , IFC ! 0 46 ! First Check For Range Marker (-) And Gregorian Day Marker (/) 47 ! Initialize Character Fields 48 BEGRNG = BLNK08 ! 0 49 ENDRNG = BLNK08 50 CMN1 = BLNK08 51 CDY1 = BLNK08 52 CMN2 = BLNK08 53 CDY2 = BLNK08 54 CALL FSPLIT(PATH,KEYWRD,FIELD(I),ILEN_FLD,'-',RMARK,BEGRNG, & 55 & ENDRNG) 56 CALL FSPLIT(PATH,KEYWRD,BEGRNG,8,'/',GMARK,CMN1,CDY1) 57 IF ( RMARK .AND. GMARK ) & 58 & CALL FSPLIT(PATH,KEYWRD,ENDRNG,8,'/',GMARK,CMN2,CDY2) 59 60 IF ( .NOT.RMARK .AND. .NOT.GMARK ) THEN 61 ! Field Must Be a Single Julian Day 62 CALL STONUM(BEGRNG,8,FNUM,IMIT) ! 0 63 ! Check The Numerical Field 64 IF ( IMIT.EQ.-1 ) THEN 65 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 66 GOTO 40 67 ELSE 68 JDAY = NINT(FNUM) ! 0 69 ENDIF 70 IF ( JDAY.GE.1 .AND. JDAY.LE.366 .AND. IMIT.EQ.1 ) THEN ! 0 71 IPROC(JDAY) = 1 ! 0 72 ELSE 73 ! WRITE Error Message ! Invalid Julian Day 74 CALL ERRHDL(PATH,MODNAM,'E','203','Juli Day') ! 0 75 ENDIF 76 IF ( JDAY.LT.ISJDAY .OR. JDAY.GT.IEJDAY ) THEN ! 0 77 ! WRITE Warning Message ! Julian Day Out-of-Range 78 WRITE (DUMMY,'(I8)') JDAY ! 0 79 CALL ERRHDL(PATH,MODNAM,'W','350',DUMMY) 80 ENDIF 81 82 ELSEIF ( RMARK .AND. .NOT.GMARK ) THEN 83 ! Field Must Be a Julian Day Range - Extract Beg & End 84 CALL STONUM(BEGRNG,8,FNUM,IMIT) ! 0 85 ! Check The Numerical Field 86 IF ( IMIT.EQ.-1 ) THEN 87 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 88 GOTO 40 89 ELSE 90 JDAYB = NINT(FNUM) ! 0 91 ENDIF 92 CALL STONUM(ENDRNG,8,FNUM,IMIT) ! 0 93 ! Check The Numerical Field 94 IF ( IMIT.EQ.-1 ) THEN 95 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 96 GOTO 40 97 ELSE 98 JDAYE = NINT(FNUM) ! 0 99 ENDIF 100 IF ( (JDAYB.LE.JDAYE) .AND. (JDAYB.GE.1) .AND. & 101 & (JDAYE.LE.366) ) THEN 102 DO K = JDAYB , JDAYE ! 0 103 IPROC(K) = 1 ! 0 104 ENDDO 105 ELSE 106 ! WRITE Error Message ! Invalid Julian Day Range 107 CALL ERRHDL(PATH,MODNAM,'E','203','Juli Day') ! 0 108 ENDIF 109 IF ( JDAYB.LT.ISJDAY .OR. JDAYE.GT.IEJDAY ) THEN ! 0 110 ! WRITE Warning Message ! Julian Day Out-of-Range 111 WRITE (DUMMY,'(I3,"-",I3)') JDAYB , JDAYE ! 0 112 CALL ERRHDL(PATH,MODNAM,'W','350',DUMMY) 113 ENDIF 114 115 ELSEIF ( .NOT.RMARK .AND. GMARK ) THEN 116 ! Field Must Be a Single Month/Day 117 CALL STONUM(CMN1,8,FNUM,IMIT) ! 0 118 ! Check The Numerical Field 119 IF ( IMIT.EQ.-1 ) THEN 120 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 121 GOTO 40 122 ELSE 123 IMN = NINT(FNUM) ! 0 124 ENDIF 125 CALL STONUM(CDY1,8,FNUM,IMIT) ! 0 126 ! Check The Numerical Field 127 IF ( IMIT.EQ.-1 ) THEN 128 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 129 GOTO 40 130 ELSE 131 IDY = NINT(FNUM) ! 0 132 ENDIF 133 CALL JULIAN(ISYEAR,IMN,IDY,JDAY) ! 0 134 IF ( JDAY.GE.1 .AND. JDAY.LE.366 ) THEN 135 IPROC(JDAY) = 1 ! 0 136 ELSE 137 ! WRITE Error Message ! Invalid Julian Day 138 CALL ERRHDL(PATH,MODNAM,'E','203','Juli Day') ! 0 139 ENDIF 140 IF ( JDAY.LT.ISJDAY .OR. JDAY.GT.IEJDAY ) THEN ! 0 141 ! WRITE Warning Message ! Julian Day Out-of-Range 142 WRITE (DUMMY,'(I8)') JDAY ! 0 143 CALL ERRHDL(PATH,MODNAM,'W','350',DUMMY) 144 ENDIF 145 146 ELSEIF ( RMARK .AND. GMARK ) THEN 147 ! Field Must Be a Greg. Date Range (MN/DY-MN/DY) 148 CALL STONUM(CMN1,8,FNUM,IMIT) ! 0 149 ! Check The Numerical Field 150 IF ( IMIT.EQ.-1 ) THEN 151 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 152 GOTO 41 153 ELSE 154 IMN1 = NINT(FNUM) ! 0 155 ENDIF 156 CALL STONUM(CDY1,8,FNUM,IMIT) ! 0 157 ! Check The Numerical Field 158 IF ( IMIT.EQ.-1 ) THEN 159 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 160 GOTO 41 161 ELSE 162 IDY1 = NINT(FNUM) ! 0 163 ENDIF 164 41 CALL STONUM(CMN2,8,FNUM,IMIT) ! 0 165 ! Check The Numerical Field 166 IF ( IMIT.EQ.-1 ) THEN 167 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 168 GOTO 40 169 ELSE 170 IMN2 = NINT(FNUM) ! 0 171 ENDIF 172 CALL STONUM(CDY2,8,FNUM,IMIT) ! 0 173 ! Check The Numerical Field 174 IF ( IMIT.EQ.-1 ) THEN 175 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 176 GOTO 40 177 ELSE 178 IDY2 = NINT(FNUM) ! 0 179 ENDIF 180 CALL JULIAN(ISYEAR,IMN1,IDY1,JDAYB) ! 0 181 CALL JULIAN(ISYEAR,IMN2,IDY2,JDAYE) 182 IF ( (JDAYB.LE.JDAYE) .AND. (JDAYB.GE.1) .AND. & 183 & (JDAYE.LE.366) ) THEN 184 DO K = JDAYB , JDAYE ! 0 185 IPROC(K) = 1 ! 0 186 ENDDO 187 ELSE 188 ! WRITE Error Message ! Invalid Julian Day 189 CALL ERRHDL(PATH,MODNAM,'E','203','Juli Day') ! 0 190 ENDIF 191 IF ( JDAYB.LT.ISJDAY .OR. JDAYE.GT.IEJDAY ) THEN ! 0 192 ! WRITE Warning Message ! Julian Day Out-of-Range 193 WRITE (DUMMY,'(I3,"-",I3)') JDAYB , JDAYE ! 0 194 CALL ERRHDL(PATH,MODNAM,'W','350',DUMMY) 195 ENDIF 196 197 ELSE 198 ! WRITE Error Message ! Invalid Field 199 CALL ERRHDL(PATH,MODNAM,'E','203','DAYRANGE') ! 0 200 ENDIF 201 202 40 ENDDO 203 ENDIF 204 205 CONTINUE ! 0 206 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