1 2 SUBROUTINE SET_METDATA 3 !*********************************************************************** 4 ! SET_METDATA Module of ISC3 Short Term Model 5 ! 6 ! PURPOSE: Sets the meteorological data variables for current hour 7 ! 8 ! PROGRAMMER: ROGER BRODE 9 ! 10 ! DATE: May 12, 1999 11 ! 12 ! MODIFIED: To include call to GRDEPS, for calculation of 13 ! gridded turbulence dissipation rate for use in the 14 ! PVMRM algorithm. 15 ! R. W. Brode, MACTEC (f/k/a PES), Inc., 07/27/04 16 ! 17 ! To include determination of the day-of-week index 18 ! (1 for Weekday [M-F], 2 for Saturday, 3 for Sunday) 19 ! for use in the option to vary emissions by season, 20 ! hour-of-day, and day-of-week (SHRDOW). 21 ! R.W. Brode, PES, Inc., 4/10/2000 22 ! 23 ! INPUTS: Meteorological Variables for One Hour 24 ! 25 ! OUTPUTS: Meteorological Data Error and Status Switches 26 ! 27 ! CALLED FROM: METEXT 28 !*********************************************************************** 29 30 ! Variable Declarations 31 USE MAIN1 32 IMPLICIT NONE 33 CHARACTER MODNAM*12 34 35 SAVE 36 ! Declare Arrays for Use With Day/Date Calcs 37 INTEGER :: NDAY(12) , IDYMAX(12) 38 INTEGER :: I , IA , IY , IM , ID , NL , GINDEX , NUMSW 39 REAL :: SUMSW 40 41 ! Variable Initializations 42 MODNAM = 'SET_METDATA' ! 4320 43 DATA NDAY/31 , 59 , 90 , 120 , 151 , 181 , 212 , 243 , 273 , 304 ,& 44 & 334 , 365/ 45 DATA IDYMAX/31 , 29 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 ,& 46 & 31/ 47 48 !---- Assign the mixing height/boundary layer height to another variable 49 ! so it can be manipulated and massaged as required. 50 51 IF ( ZICONV.GE.0.0 .AND. ZICONV.LT.1.0 ) ZICONV = 1.0 52 IF ( ZIMECH.GE.0.0 .AND. ZIMECH.LT.1.0 ) ZIMECH = 1.0 53 54 ! Set the date variables for this hour 55 CALL SET_DATES 56 57 ! Determine SEASON 58 IF ( IMONTH.LE.2 .OR. IMONTH.EQ.12 ) THEN 59 ISEAS = 1 ! 2832 60 ELSEIF ( IMONTH.GE.3 .AND. IMONTH.LE.5 ) THEN 61 ISEAS = 2 ! 1488 62 ELSEIF ( IMONTH.GE.6 .AND. IMONTH.LE.8 ) THEN 63 ISEAS = 3 ! 0 64 ELSEIF ( IMONTH.GE.9 .AND. IMONTH.LE.11 ) THEN 65 ISEAS = 4 ! 0 66 ENDIF 67 68 ! Determine Day of Week (1 = Weekday [M-F], 2 = Saturday, 3 = Sunday). 69 ! Based on "Frequently Asked Questions about Calendars," Version 2.2, 70 ! by Claus Tondering, April 9, 2000, available on the web at URL 71 ! http://www.tondering.dk/claus/calendar/html 72 IA = (14-IMONTH)/12 ! 4320 73 IY = IYR - IA 74 IM = IMONTH + 12*IA - 2 75 ID = MOD((IDAY+IY+IY/4-IY/100+IY/400+(31*IM)/12),7) 76 IF ( ID.GE.1 .AND. ID.LE.5 ) THEN 77 ! This is a weekday 78 IDAY_OF_WEEK = 1 ! 3072 79 ELSEIF ( ID.EQ.6 ) THEN 80 ! This is a Saturday 81 IDAY_OF_WEEK = 2 ! 624 82 ELSEIF ( ID.EQ.0 ) THEN 83 ! This is a Sunday 84 IDAY_OF_WEEK = 3 ! 624 85 ENDIF 86 IF ( ID.EQ.0 ) THEN ! 4320 87 ! This is a Sunday 88 IDAY_OF_WEEK7 = 7 ! 624 89 ELSE 90 ! This is weekday or Saturday 91 IDAY_OF_WEEK7 = ID ! 3696 92 ENDIF 93 94 IF ( MONTH .AND. IHOUR.EQ.24 ) THEN ! 4320 95 ! Check for the End of the Month 96 IF ( IMONTH.EQ.1 .OR. (MOD(IYR,4).NE.0) .OR. & 97 & (MOD(IYR,100).EQ.0 .AND. MOD(IYR,400).NE.0) ) THEN 98 ! Not a Leap Year OR Month = January 99 IF ( JDAY.EQ.NDAY(IMONTH) ) ENDMON = .TRUE. ! 0 100 ELSE 101 ! Leap Year AND Month > January 102 IF ( JDAY.EQ.NDAY(IMONTH)+1 ) ENDMON = .TRUE. ! 0 103 ENDIF 104 ENDIF 105 106 ! Check Data for Calms, Missing, Out-of-Range Values --- CALL METCHK 107 CALL METCHK ! 4320 108 109 ! Limit ZI to 4000 meters. 110 IF ( ZICONV.GT.4000. ) ZICONV = 4000. 111 IF ( ZIMECH.GT.4000. ) ZIMECH = 4000. 112 ! Select appropriate mixing height from convective and mechanical values 113 IF ( .NOT.MSGHR .AND. OBULEN.LT.0.0 ) THEN 114 ZI = AMAX1(ZICONV,ZIMECH) ! 1566 115 ELSEIF ( .NOT.MSGHR ) THEN 116 ZI = ZIMECH ! 2546 117 ELSE 118 ZI = -999.0 ! 208 119 ENDIF 120 !RWB Avoid ZI = 0.0. 121 IF ( ZI.GE.0.0 .AND. ZI.LT.1.0 ) ZI = 1.0 ! 4320 122 123 ! Apply ROTANG Adjustment to Wind Direction 124 IF ( ROTANG.NE.0.0 ) THEN 125 WDREF = WDREF - ROTANG ! 0 126 IF ( WDREF.LE.0.0 ) WDREF = WDREF + 360. 127 ENDIF 128 129 !---- Make correction to the profile wind direction(s) 130 ! (default, ROTANG = 0.0) 131 132 IF ( ROTANG.NE.0.0 ) THEN ! 4320 133 DO NL = 1 , NPLVLS ! 0 134 IF ( PFLWD(NL).GT.0.0 ) THEN ! 0 135 PFLWD(NL) = PFLWD(NL) - ROTANG ! 0 136 137 IF ( PFLWD(NL).LE.0.0 ) PFLWD(NL) = PFLWD(NL) + 360.0 138 139 ENDIF 140 ENDDO 141 ENDIF 142 143 ! 144 !---- Check the RUNERR flag - if it is FALSE, then there is sufficient 145 ! data to continue processing the data 146 URBSTAB = .FALSE. ! 4320 147 148 IF ( .NOT.RUNERR ) THEN 149 ! 150 IF ( .NOT.CLMHR .AND. .NOT.MSGHR ) THEN ! 4320 151 ! Set the stability logical variables 152 IF ( OBULEN.GT.0.0 ) THEN ! 3044 153 UNSTAB = .FALSE. ! 2546 154 STABLE = .TRUE. 155 ELSE 156 UNSTAB = .TRUE. ! 498 157 STABLE = .FALSE. 158 ENDIF 159 160 IF ( FULLDATE.GT.ISDATE .AND. IPROC(JDAY).EQ.1 ) THEN ! 3044 161 ! 162 ! Initialize the gridded profile arrays 163 DO GINDEX = 1 , MXGLVL ! 3044 164 GRIDSV(GINDEX) = -99.0 ! 264828 165 GRIDSW(GINDEX) = -99.0 166 GRIDWS(GINDEX) = -99.0 167 GRIDWD(GINDEX) = -99.0 168 GRIDTG(GINDEX) = -99.0 169 GRIDPT(GINDEX) = -99.0 170 IF ( URBAN ) THEN 171 GRDSVR(GINDEX) = -99.0 ! 0 172 GRDSVU(GINDEX) = -99.0 173 GRDSWR(GINDEX) = -99.0 174 GRDSWU(GINDEX) = -99.0 175 GRDTGR(GINDEX) = -99.0 176 GRDTGU(GINDEX) = -99.0 177 GRDPTR(GINDEX) = -99.0 178 GRDPTU(GINDEX) = -99.0 179 ENDIF 180 ENDDO 181 182 ! Get the index from the array of gridded heights that 183 ! corresponds to the height immediately below ZI 184 185 CALL LOCATE(GRIDHT,1,MXGLVL,ZI,NDX4ZI) ! 3044 186 187 ! Compute THETA_STAR and DTHDZ for the gridded 188 ! potential temperature gradient 189 190 CALL TGINIT() 191 ! 192 ! Profile all variables here except sv and sw; defer sv 193 ! and sw until u at zi is known. 194 ! 195 CALL GRDWS() 196 CALL GRDWD() 197 CALL GRDPTG() 198 CALL GRDPT() 199 200 !---------- Compute density profile for PRIME 201 CALL GRDDEN 202 203 !---------- Compute the parameter values at ZI; if ZI is above the 204 ! highest gridded profile level, use the value at the high- 205 ! est level 206 IF ( NDX4ZI.LT.MXGLVL ) THEN 207 CALL GINTRP(GRIDHT(NDX4ZI),GRIDWS(NDX4ZI), & 208 & GRIDHT(NDX4ZI+1),GRIDWS(NDX4ZI+1),ZI, & 209 & UATZI) 210 CALL GINTRP(GRIDHT(NDX4ZI),GRIDPT(NDX4ZI), & 211 & GRIDHT(NDX4ZI+1),GRIDPT(NDX4ZI+1),ZI, & 212 & PTATZI) 213 214 ELSE 215 UATZI = GRIDWS(MXGLVL) ! 0 216 PTATZI = GRIDPT(MXGLVL) 217 218 ENDIF 219 ! 220 ! Add turbulence variables here 221 ! 222 CALL GRDSV() ! 3044 223 224 ! Obtain residual turbulence value before calling GRDSW 225 NUMSW = 0 226 SUMSW = 0.0 227 228 DO I = 1 , NPLVLS 229 IF ( PFLHT(I).GE.ZI .AND. PFLSW(I).GE.0.0 ) THEN ! 3044 230 NUMSW = NUMSW + 1 ! 0 231 SUMSW = SUMSW + PFLSW(I) 232 ENDIF 233 ENDDO 234 235 IF ( NUMSW.GT.0 ) THEN ! 3044 236 SWRMAX = SUMSW/NUMSW ! 0 237 ELSE 238 SWRMAX = 0.02*UATZI ! 3044 239 ENDIF 240 241 CALL GRDSW() ! 3044 242 243 IF ( NDX4ZI.LT.MXGLVL ) THEN 244 CALL GINTRP(GRIDHT(NDX4ZI),GRIDSV(NDX4ZI), & 245 & GRIDHT(NDX4ZI+1),GRIDSV(NDX4ZI+1),ZI, & 246 & SVATZI) 247 CALL GINTRP(GRIDHT(NDX4ZI),GRIDSW(NDX4ZI), & 248 & GRIDHT(NDX4ZI+1),GRIDSW(NDX4ZI+1),ZI, & 249 & SWATZI) 250 ELSE 251 SVATZI = GRIDSV(MXGLVL) ! 0 252 SWATZI = GRIDSW(MXGLVL) 253 ENDIF 254 255 ! Compute gridded profile of epsilon for PVMRM option 256 IF ( PVMRM ) CALL GRDEPS ! 3044 257 ! 258 ! Compute Urban Profiles if Needed 259 IF ( URBAN .AND. STABLE ) THEN 260 ZIRUR = ZI ! 0 261 CALL URBCALC 262 CALL GRDURBAN 263 ENDIF 264 265 ENDIF 266 267 ELSE 268 ! To correctly compute the smoothed PBL heights, the previous 269 ! hour's smoothed height must be reset to missing, otherwise 270 ! the last nonmissing value is used in the computation. 271 272 HNPREV = -999.0 ! 1276 273 274 ENDIF 275 276 ! Write every other level of gridded profile data to a file 277 ! up to a height of 1000 m; 278 279 ENDIF 280 281 ! Set Appropriate Wind Speed Category Index 282 IF ( UREF.LE.UCAT(1) ) THEN ! 4320 283 IUCAT = 1 ! 1580 284 ELSEIF ( UREF.LE.UCAT(2) ) THEN 285 IUCAT = 2 ! 812 286 ELSEIF ( UREF.LE.UCAT(3) ) THEN 287 IUCAT = 3 ! 1068 288 ELSEIF ( UREF.LE.UCAT(4) ) THEN 289 IUCAT = 4 ! 538 290 ELSEIF ( UREF.LE.UCAT(5) ) THEN 291 IUCAT = 5 ! 104 292 ELSE 293 IUCAT = 6 ! 218 294 ENDIF 295 296 ! Set Stability Category based on Golder (1972) for use with 297 ! TOXICS Area Source Optimizations 298 CALL LTOPG(KST) ! 4320 299 300 IF ( MSGHR ) THEN 301 IF ( .NOT.MSGPRO ) THEN ! 208 302 ! Set Flag for Runtime Met. Error to Prevent Further Calculations 303 RUNERR = .TRUE. ! 0 304 ! WRITE Error Message: Missing Meteorological Data 305 WRITE (DUMMY,'(I8.8)') KURDAT 306 CALL ERRHDL(PATH,MODNAM,'E','460',DUMMY) 307 ELSE 308 ! WRITE Informational Message: Missing Meteorological Data 309 WRITE (DUMMY,'(I8.8)') KURDAT ! 208 310 CALL ERRHDL(PATH,MODNAM,'I','460',DUMMY) 311 ENDIF 312 ENDIF 313 314 CONTINUE ! 4320 315 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