Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_clock_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_Clock\_Mod contains routines and variables
9 : ! to handle the HEMCO time and calendar settings through the HEMCO clock
10 : ! object. The HEMCO clock carries information of the current UTC/local
11 : ! time as well as the UTC times from the previous time step. These
12 : ! values should be updated on every time step (--> HcoClock\_Set). It
13 : ! also contains separate variables for the current and previous emission
14 : ! datetime (year, month, day, hour, min, sec). This allows us to keep
15 : ! track of emission time steps even if the emission time steps are less
16 : ! frequent than the regular time step.
17 : !\\
18 : !\\
19 : ! Subroutine HcoClock\_EmissionsDone indicates that emisisons have been
20 : ! completely calculated for the current time step. Any calls to
21 : ! HcoClock\_Get will return IsEmisTime FALSE until the clock has been
22 : ! advanced to the next emission time step (via HcoClock\_Set).
23 : !\\
24 : !\\
25 : ! The HEMCO clock object HcoClock is a private object and cannot be
26 : ! accessed directly from outside of this module. The HcoClock\_Get
27 : ! routine should be used instead. There are also some wrapper routines
28 : ! for frequently used checks, i.e. if this is a new year, month, etc.
29 : !\\
30 : !\\
31 : ! Local times are calculated for 26 time zones, ranging from UTC-12 hours
32 : ! to UTC+13 hours. The time zone to be used at a given grid point is
33 : ! based on its geographical position. By default, the time zone is picked
34 : ! according to the longitude, with each time zone spanning 15 degrees.
35 : ! More detailed time zones can be provided through an external input file,
36 : ! specified in the HEMCO configuration file. The field name must be
37 : ! `TIMEZONES`, and the file must contain UTC offsets in hours. If such a
38 : ! file is provided, the time zones are determined based on these values.
39 : ! Minute offsets are ignored, e.g. UTC+9hr30min is treated as UTC+9hr. If
40 : ! the input field contains any invalid values (e.g. outside the range of
41 : ! UTC-12 - UTC+13 hours), the default algorithm is applied.
42 : !\\
43 : !\\
44 : ! The HEMCO clock object also controls cases where the emission dates shall
45 : ! be held constant, e.g. for simulations where emission year 2000 shall be
46 : ! used irrespective of the simulation date. Fixed simulation dates can be
47 : ! set in the settings section of the HEMCO configuration file via settings
48 : ! `Emission year`, `Emission month`, `Emission day`, and `Emission hour`.
49 : ! Only a subset of those settings can be provided, in which case all other
50 : ! time attributes will be taken from the simulation datetime.
51 : !\\
52 : !\\
53 : ! !INTERFACE:
54 : !
55 : MODULE HCO_CLOCK_MOD
56 : !
57 : ! !USES:
58 : !
59 : USE HCO_Error_Mod
60 : USE HCO_Julday_Mod
61 : USE HCO_TYPES_MOD, ONLY : HcoClock
62 :
63 : IMPLICIT NONE
64 : PRIVATE
65 : !
66 : ! !PUBLIC MEMBER FUNCTIONS:
67 : !
68 : ! HEMCO Clock object:
69 : PUBLIC :: HcoClock_Init
70 : PUBLIC :: HcoClock_InitTzPtr
71 : PUBLIC :: HcoClock_Set
72 : PUBLIC :: HcoClock_Get
73 : PUBLIC :: HcoClock_GetLocal
74 : PUBLIC :: HcoClock_Cleanup
75 : PUBLIC :: HcoClock_NewYear
76 : PUBLIC :: HcoClock_NewMonth
77 : PUBLIC :: HcoClock_NewDay
78 : PUBLIC :: HcoClock_NewHour
79 : PUBLIC :: HcoClock_New3Hour
80 : PUBLIC :: HcoClock_First
81 : PUBLIC :: HcoClock_Rewind
82 : PUBLIC :: HcoClock_CalcDOY
83 : PUBLIC :: HcoClock_Increase
84 : PUBLIC :: HcoClock_EmissionsDone
85 : PUBLIC :: HcoClock_SetLast
86 : PUBLIC :: Get_LastDayOfMonth
87 : !
88 : ! !REMARKS:
89 : ! The current local time implementation assumes a regular grid,
90 : ! i.e. local time does not change with latitude
91 : !
92 : ! !REVISION HISTORY:
93 : ! 29 Dec 2012 - C. Keller - Initialization
94 : ! See https://github.com/geoschem/hemco for complete history
95 : !EOP
96 : !------------------------------------------------------------------------------
97 : !BOC
98 : !
99 : ! !DEFINED PARAMETERS:
100 : !
101 : !
102 : ! !PRIVATE TYPES:
103 : !
104 : !
105 : ! !LOCAL VARIABLES:
106 : !
107 : ! HcoClock is the variable for the HEMCO clock object
108 : ! TYPE(HcoClock), POINTER :: HcoClock => NULL()
109 :
110 : ! Midmonth days for a regular year.
111 : ! These can be used to obtain the mid-month day of the current month.
112 : INTEGER, PARAMETER :: MidMon(13) = (/ 15, 45, 74, 105, &
113 : 135, 166, 196, 227, &
114 : 258, 288, 319, 349, 380/)
115 :
116 : ! Number of time zones. Time zone index 1 is UTC-12. Time zone index
117 : ! 25 is UTC+12. Add one more to account for UTC+13.
118 : INTEGER, PARAMETER :: nTimeZones = 26
119 :
120 : CONTAINS
121 : !EOC
122 : !------------------------------------------------------------------------------
123 : ! Harmonized Emissions Component (HEMCO) !
124 : !------------------------------------------------------------------------------
125 : !BOP
126 : !
127 : ! !IROUTINE: HcoClock_Init
128 : !
129 : ! !DESCRIPTION: Subroutine HcoClock\_Init initializes the HEMCO clock.
130 : !\\
131 : !\\
132 : ! !INTERFACE:
133 : !
134 0 : SUBROUTINE HcoClock_Init ( HcoState, RC )
135 : !
136 : ! !USES:
137 : !
138 : USE HCO_ARR_MOD, ONLY : HCO_ArrInit
139 : USE HCO_STATE_MOD, ONLY : HCO_State
140 : !
141 : ! !INPUT/OUTPUT PARAMETERS:
142 : !
143 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
144 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
145 : !
146 : ! !REVISION HISTORY:
147 : ! 10 Sep 2013 - C. Keller - Initialization
148 : ! See https://github.com/geoschem/hemco for complete history
149 : !EOP
150 : !------------------------------------------------------------------------------
151 : !BOC
152 : !
153 : ! !LOCAL VARIABLES:
154 : !
155 : INTEGER :: AS
156 : CHARACTER(LEN=255) :: LOC
157 :
158 : !======================================================================
159 : ! HcoClock_Init begins here!
160 : !======================================================================
161 0 : LOC = 'HcoClock_Init (HCO_CLOCK_MOD.F90)'
162 :
163 : ! Enter
164 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
165 0 : IF ( RC /= HCO_SUCCESS ) THEN
166 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
167 0 : RETURN
168 : ENDIF
169 :
170 : ! Eventually allocate clock object and set all values to -1
171 0 : IF ( .NOT. ASSOCIATED ( HcoState%Clock ) ) THEN
172 0 : ALLOCATE ( HcoState%Clock )
173 0 : HcoState%Clock%PrevYear = -1
174 0 : HcoState%Clock%PrevMonth = -1
175 0 : HcoState%Clock%PrevDay = -1
176 0 : HcoState%Clock%PrevHour = -1
177 0 : HcoState%Clock%PrevMin = -1
178 0 : HcoState%Clock%PrevSec = -1
179 0 : HcoState%Clock%PrevDOY = -1
180 0 : HcoState%Clock%PrevWD = -1
181 :
182 0 : HcoState%Clock%ThisYear = -1
183 0 : HcoState%Clock%ThisMonth = -1
184 0 : HcoState%Clock%ThisDay = -1
185 0 : HcoState%Clock%ThisHour = -1
186 0 : HcoState%Clock%ThisMin = -1
187 0 : HcoState%Clock%ThisSec = -1
188 0 : HcoState%Clock%ThisDOY = -1
189 0 : HcoState%Clock%ThisWD = -1
190 0 : HcoState%Clock%MonthLastDay = -1
191 :
192 0 : HcoState%Clock%ThisEYear = -1
193 0 : HcoState%Clock%ThisEMonth = -1
194 0 : HcoState%Clock%ThisEDay = -1
195 0 : HcoState%Clock%ThisEHour = -1
196 0 : HcoState%Clock%ThisEMin = -1
197 0 : HcoState%Clock%ThisESec = -1
198 :
199 0 : HcoState%Clock%PrevEYear = -1
200 0 : HcoState%Clock%PrevEMonth = -1
201 0 : HcoState%Clock%PrevEDay = -1
202 0 : HcoState%Clock%PrevEHour = -1
203 0 : HcoState%Clock%PrevEMin = -1
204 0 : HcoState%Clock%PrevESec = -1
205 :
206 0 : HcoState%Clock%SimYear = -1
207 0 : HcoState%Clock%SimMonth = -1
208 0 : HcoState%Clock%SimDay = -1
209 0 : HcoState%Clock%SimHour = -1
210 0 : HcoState%Clock%SimMin = -1
211 0 : HcoState%Clock%SimSec = -1
212 :
213 0 : HcoState%Clock%isLast = .FALSE.
214 :
215 : ! local time vectors
216 0 : HcoState%Clock%ntz = nTimeZones
217 :
218 0 : ALLOCATE ( HcoState%Clock%ThisLocYear(HcoState%Clock%ntz), STAT=AS )
219 0 : IF ( AS /= 0 ) THEN
220 0 : CALL HCO_ERROR ( 'ThisLocYear', RC )
221 0 : RETURN
222 : ENDIF
223 0 : HcoState%Clock%ThisLocYear(:) = -1
224 :
225 0 : ALLOCATE ( HcoState%Clock%ThisLocMonth(HcoState%Clock%ntz), STAT=AS )
226 : IF ( AS /= 0 ) THEN
227 0 : CALL HCO_ERROR( 'ThisLocMonth', RC )
228 0 : RETURN
229 : ENDIF
230 0 : HcoState%Clock%ThisLocMonth(:) = -1
231 :
232 0 : ALLOCATE ( HcoState%Clock%ThisLocDay(HcoState%Clock%ntz), STAT=AS )
233 : IF ( AS /= 0 ) THEN
234 0 : CALL HCO_ERROR( 'ThisLocDay', RC )
235 0 : RETURN
236 : ENDIF
237 0 : HcoState%Clock%ThisLocDay(:) = -1
238 :
239 0 : ALLOCATE ( HcoState%Clock%ThisLocWD(HcoState%Clock%ntz), STAT=AS )
240 : IF ( AS /= 0 ) THEN
241 0 : CALL HCO_ERROR( 'ThisLocWD', RC )
242 0 : RETURN
243 : ENDIF
244 0 : HcoState%Clock%ThisLocWD(:) = -1
245 :
246 0 : ALLOCATE ( HcoState%Clock%ThisLocHour(HcoState%Clock%ntz), STAT=AS )
247 : IF ( AS /= 0 ) THEN
248 0 : CALL HCO_ERROR( 'ThisLocHour', RC )
249 0 : RETURN
250 : ENDIF
251 0 : HcoState%Clock%ThisLocHour(:) = -1.0_sp
252 :
253 0 : HcoState%Clock%nSteps = 0
254 0 : HcoState%Clock%nEmisSteps = 0
255 0 : HcoState%Clock%LastEStep = 0
256 :
257 : ! Initialize TIMEZONES array. Initialize as pointer (dims=0)
258 0 : CALL HCO_ArrInit( HcoState%Clock%TIMEZONES, 0, 0, RC )
259 0 : IF ( RC /= HCO_SUCCESS ) THEN
260 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
261 0 : RETURN
262 : ENDIF
263 :
264 : ENDIF
265 :
266 : ! Return w/ success
267 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
268 :
269 : END SUBROUTINE HcoClock_Init
270 : !EOC
271 : !------------------------------------------------------------------------------
272 : ! Harmonized Emissions Component (HEMCO) !
273 : !------------------------------------------------------------------------------
274 : !BOP
275 : !
276 : ! !IROUTINE: HcoClock_InitTzPtr
277 : !
278 : ! !DESCRIPTION: Subroutine HcoClock\_InitTzPtr initializes the TIMEZONES
279 : ! module variable. TIMEZONES points to the timezones data (i.e. offsets
280 : ! from UTC in hours) as read from disk. If the timezones data file is not
281 : ! being used, then the TIMEZONES pointer will be left unassociated.
282 : !\\
283 : !\\
284 : ! !INTERFACE:
285 : !
286 0 : SUBROUTINE HcoClock_InitTzPtr( HcoState, RC )
287 : !
288 : ! !USES:
289 : !
290 : USE HCO_STATE_MOD, ONLY : HCO_State
291 : USE HCO_EMISLIST_MOD, ONLY : HCO_GetPtr
292 : !
293 : ! !INPUT PARAMETERS:
294 : !
295 : TYPE(HCO_State), POINTER :: HcoState ! HcoState object
296 : !
297 : ! !INPUT/OUTPUT PARAMETERS:
298 : !
299 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
300 : !
301 : ! !REMARKS:
302 : ! This routine has to be called in the HCO_Run routine, immediately after
303 : ! the call to ReadList_Read. The HEMCO configuration file has to be read
304 : ! first in order to determine if we are getting our timezone information from
305 : ! a file, or if we are computing it just based on longitude in the default
306 : ! manner.
307 : !
308 : ! !REVISION HISTORY:
309 : ! 23 Feb 2015 - R. Yantosca - Initial version
310 : ! See https://github.com/geoschem/hemco for complete history
311 : !EOP
312 : !------------------------------------------------------------------------------
313 : !BOC
314 : !
315 : ! !LOCAL VARIABLES:
316 : !
317 : LOGICAL :: FOUND
318 :
319 : ! Make sure HcoClock obj. is associated
320 0 : IF ( .NOT. ASSOCIATED(HcoState%Clock) ) THEN
321 : CALL HCO_WARNING( HcoState%Config%Err, &
322 : 'CANNOT SET TIMEZONES - HEMCO CLOCK IS NOT DEFINED', &
323 0 : RC, WARNLEV=1, THISLOC='HcoClock_InitTzPtr (hco_clock_mod.F90)' )
324 0 : RETURN
325 : ENDIF
326 :
327 : ! Look for the time zone pointer
328 : CALL HCO_GetPtr ( HcoState, 'TIMEZONES', &
329 0 : HcoState%Clock%TIMEZONES%Val, RC, FOUND=FOUND )
330 :
331 : ! Print a message
332 0 : IF ( HcoState%amIRoot ) THEN
333 0 : IF ( FOUND ) THEN
334 : CALL HCO_MSG( HcoState%Config%Err, &
335 0 : 'TIMEZONES (i.e. OFFSETS FROM UTC) WERE READ FROM A FILE' )
336 : ELSE
337 : CALL HCO_MSG( HcoState%Config%Err, &
338 0 : 'TIMEZONES (i.e. OFFSETS FROM UTC) WERE COMPUTED FROM LONGITUDE' )
339 : ENDIF
340 : ENDIF
341 :
342 : END SUBROUTINE HcoClock_InitTzPtr
343 : !EOC
344 : !------------------------------------------------------------------------------
345 : ! Harmonized Emissions Component (HEMCO) !
346 : !------------------------------------------------------------------------------
347 : !BOP
348 : !
349 : ! !IROUTINE: HcoClock_Set
350 : !
351 : ! !DESCRIPTION: Subroutine HcoClock\_Set updates the HEMCO clock. These
352 : ! routine should be called at the beginning of every emission time step!
353 : ! If the current day of year (cDoy) is not provided, it is automatically
354 : ! calculated from the current date.
355 : !\\
356 : !\\
357 : ! !INTERFACE:
358 : !
359 0 : SUBROUTINE HcoClock_Set ( HcoState, cYr, cMt, cDy, cHr, &
360 : cMin, cSec, cDOY, IsEmisTime, RC )
361 : !
362 : ! !USES:
363 : !
364 : USE HCO_TYPES_MOD, ONLY : ConfigObj, Ext
365 : USE HCO_STATE_MOD, ONLY : HCO_State
366 : USE HCO_EXTLIST_MOD, ONLY : GetExtOpt, CoreNr
367 : !
368 : ! !INPUT PARAMETERS:
369 : !
370 : INTEGER, INTENT(IN ) :: cYr ! Current year
371 : INTEGER, INTENT(IN ) :: cMt ! Current month
372 : INTEGER, INTENT(IN ) :: cDy ! Current day
373 : INTEGER, INTENT(IN ) :: cHr ! Current hour
374 : INTEGER, INTENT(IN ) :: cMin ! Current minute
375 : INTEGER, INTENT(IN ) :: cSec ! Current second
376 : INTEGER, INTENT(IN ), OPTIONAL :: cDoy ! Current day of year
377 : LOGICAL, INTENT(IN ), OPTIONAL :: IsEmisTime! Is it time for emissions?
378 : !
379 : ! !INPUT/OUTPUT PARAMETERS:
380 : !
381 : TYPE(HCO_State), POINTER :: HcoState ! HcoState object
382 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
383 : !
384 : ! !REVISION HISTORY:
385 : ! 29 Dec 2012 - C. Keller - Initialization
386 : ! See https://github.com/geoschem/hemco for complete history
387 : !EOP
388 : !------------------------------------------------------------------------------
389 : !BOC
390 : !
391 : ! !LOCAL ARGUMENTS:
392 : !
393 : TYPE(HcoClock), POINTER :: Clock
394 : TYPE(ConfigObj),POINTER :: CF
395 : REAL(sp) :: UTC
396 : INTEGER :: DUM, DOY
397 : INTEGER :: UseYr, UseMt, UseDy, UseHr
398 : CHARACTER(LEN=255) :: MSG, ErrMsg
399 : LOGICAL :: FND, NewStep, EmisTime, WasEmisTime
400 :
401 : !======================================================================
402 : ! Clock_Set begins here!
403 : !======================================================================
404 :
405 : ! Assume success until otherwise
406 0 : RC = HCO_SUCCESS
407 :
408 : ! Get HEMCO clock object
409 0 : Clock => HcoState%Clock
410 0 : CF => HcoState%Config
411 :
412 : ! ----------------------------------------------------------------
413 : ! On first call, check if fixed emission dates are to be used.
414 : ! Those can be set in the HEMCO configuration file.
415 : ! ----------------------------------------------------------------
416 0 : IF ( Clock%nSteps == 0 ) THEN
417 : CALL GetExtOpt( CF, CoreNr, 'Emission year', OptValInt=DUM, &
418 0 : FOUND=FND, RC=RC )
419 0 : IF ( RC /= HCO_SUCCESS ) THEN
420 0 : ErrMsg = 'Error getting emission year'
421 0 : CALL HCO_Error( ErrMsg, RC )
422 0 : RETURN
423 : ENDIF
424 0 : IF ( FND ) THEN
425 0 : Clock%FixYY = DUM
426 0 : WRITE(MSG,*) 'Emission year will be fixed to day ', Clock%FixYY
427 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
428 : ENDIF
429 :
430 : CALL GetExtOpt( CF, CoreNr, 'Emission month', OptValInt=DUM, &
431 0 : FOUND=FND, RC=RC )
432 0 : IF ( RC /= HCO_SUCCESS ) THEN
433 0 : ErrMsg = 'Error getting emission month'
434 0 : CALL HCO_Error( ErrMsg, RC )
435 0 : RETURN
436 : ENDIF
437 :
438 0 : IF ( FND ) THEN
439 0 : Clock%FixMM = DUM
440 0 : WRITE(MSG,*) 'Emission month will be fixed to day ', Clock%FixMM
441 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
442 : ENDIF
443 :
444 : CALL GetExtOpt( CF, CoreNr, 'Emission day', OptValInt=DUM, &
445 0 : FOUND=FND, RC=RC )
446 0 : IF ( RC /= HCO_SUCCESS ) THEN
447 0 : ErrMsg = 'Error getting emission day'
448 0 : CALL HCO_Error( ErrMsg, RC )
449 0 : RETURN
450 : ENDIF
451 :
452 0 : IF ( FND ) THEN
453 0 : Clock%Fixdd = DUM
454 0 : WRITE(MSG,*) 'Emission day will be fixed to day ', Clock%Fixdd
455 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
456 : ENDIF
457 :
458 : CALL GetExtOpt( CF, CoreNr, 'Emission hour', OptValInt=DUM, &
459 0 : FOUND=FND, RC=RC )
460 0 : IF ( RC /= HCO_SUCCESS ) THEN
461 0 : ErrMsg = 'Error getting emission hour'
462 0 : CALL HCO_Error( ErrMsg, RC )
463 0 : RETURN
464 : ENDIF
465 :
466 0 : IF ( FND ) THEN
467 0 : Clock%Fixhh = DUM
468 0 : WRITE(MSG,*) 'Emission hour will be fixed to day ', Clock%Fixhh
469 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
470 : ENDIF
471 : ENDIF
472 :
473 : ! ----------------------------------------------------------------
474 : ! Is this a new time step comparted to the most current one in
475 : ! memory?
476 : ! ----------------------------------------------------------------
477 0 : NewStep = .TRUE.
478 : IF ( Clock%SimYear==cYr .AND. Clock%SimMonth==cMt .AND. &
479 : Clock%SimDay ==cDy .AND. Clock%SimHour ==cHr .AND. &
480 0 : Clock%SimMin ==cMin .AND. Clock%SimSec ==cSec ) THEN
481 : NewStep = .FALSE.
482 : ENDIF
483 :
484 : ! ----------------------------------------------------------------
485 : ! Update current and previous time stamps
486 : ! ----------------------------------------------------------------
487 : IF ( NewStep ) THEN
488 0 : Clock%PrevYear = Clock%ThisYear
489 0 : Clock%PrevMonth = Clock%ThisMonth
490 0 : Clock%PrevDay = Clock%ThisDay
491 0 : Clock%PrevHour = Clock%ThisHour
492 0 : Clock%PrevMin = Clock%ThisMin
493 0 : Clock%PrevSec = Clock%ThisSec
494 0 : Clock%PrevDOY = Clock%ThisDOY
495 0 : Clock%PrevWD = Clock%ThisWD
496 :
497 : ! Set simulation date
498 0 : Clock%SimYear = cYr
499 0 : Clock%SimMonth = cMt
500 0 : Clock%SimDay = cDy
501 0 : Clock%SimHour = cHr
502 0 : Clock%SimMin = cMin
503 0 : Clock%SimSec = cSec
504 :
505 : ! Check for fixed dates
506 0 : UseYr = cYr
507 0 : UseMt = cMt
508 0 : UseDy = cDy
509 0 : UseHr = cHr
510 0 : IF ( Clock%FixYY > 0 ) UseYr = Clock%FixYY
511 0 : IF ( Clock%FixMM > 0 ) UseMt = Clock%FixMM
512 0 : IF ( Clock%Fixdd > 0 ) UseDy = Clock%Fixdd
513 0 : IF ( Clock%Fixhh > 0 ) UseHr = Clock%Fixhh
514 :
515 : ! Set day of year: calculate if not specified
516 : IF ( PRESENT(cDOY) .AND. Clock%FixYY<0 .AND. &
517 0 : Clock%FixMM<0 .AND. Clock%Fixdd<0 ) THEN
518 0 : DOY = cDOY
519 : ELSE
520 0 : DOY = HcoClock_CalcDOY( UseYr, UseMt, UseDy )
521 : ENDIF
522 :
523 0 : Clock%ThisYear = UseYr
524 0 : Clock%ThisMonth = UseMt
525 0 : Clock%ThisDay = UseDy
526 0 : Clock%ThisHour = UseHr
527 0 : Clock%ThisMin = cMin
528 0 : Clock%ThisSec = cSec
529 0 : Clock%ThisDOY = DOY
530 :
531 : ! UTC decimal time
532 : UTC = ( REAL( Clock%ThisHour, sp ) ) + &
533 : ( REAL( Clock%ThisMin , sp ) / 60.0_sp ) + &
534 0 : ( REAL( Clock%ThisSec , sp ) / 3600.0_sp )
535 0 : Clock%ThisWD = HCO_GetWeekday ( UseYr, UseMt, UseDy, UTC )
536 :
537 : ! ----------------------------------------------------------------
538 : ! Get last day of this month (only if month has changed)
539 : ! ----------------------------------------------------------------
540 0 : IF ( Clock%ThisMonth /= Clock%PrevMonth ) THEN
541 : Clock%MonthLastDay = &
542 0 : Get_LastDayOfMonth( Clock%ThisMonth, Clock%ThisYear )
543 : ENDIF
544 :
545 : ! ----------------------------------------------------------------
546 : ! Set local times
547 : ! ----------------------------------------------------------------
548 0 : CALL Set_LocalTime ( HcoState, Clock, UTC, RC )
549 0 : IF ( RC /= HCO_SUCCESS ) THEN
550 0 : ErrMsg = 'Error setting local time'
551 0 : CALL HCO_Error( ErrMsg, RC )
552 0 : RETURN
553 : ENDIF
554 :
555 :
556 : ! ----------------------------------------------------------------
557 : ! Update counter
558 : ! ----------------------------------------------------------------
559 0 : Clock%nSteps = Clock%nSteps + 1
560 :
561 : ENDIF !New time step
562 :
563 : ! ----------------------------------------------------------------
564 : ! Emission time steps
565 : ! ----------------------------------------------------------------
566 0 : EmisTime = .FALSE.
567 0 : IF ( PRESENT(IsEmisTime) ) EmisTime = IsEmisTime
568 :
569 : ! If this is an emission time step, force current values to be in
570 : ! sync with the other values.
571 0 : IF ( EmisTime ) THEN
572 :
573 : ! Check if previous emission time step is different
574 : IF ( ( Clock%ThisEYear /= Clock%ThisYear ) .OR. &
575 : ( Clock%ThisEMonth /= Clock%ThisMonth ) .OR. &
576 : ( Clock%ThisEDay /= Clock%ThisDay ) .OR. &
577 : ( Clock%ThisEHour /= Clock%ThisHour ) .OR. &
578 0 : ( Clock%ThisEMin /= Clock%ThisMin ) .OR. &
579 : ( Clock%ThisESec /= Clock%ThisSec ) ) THEN
580 :
581 : ! Set previous values
582 0 : Clock%PrevEYear = Clock%ThisEYear
583 0 : Clock%PrevEMonth = Clock%ThisEMonth
584 0 : Clock%PrevEDay = Clock%ThisEDay
585 0 : Clock%PrevEHour = Clock%ThisEHour
586 0 : Clock%PrevEMin = Clock%ThisEMin
587 0 : Clock%PrevESec = Clock%ThisESec
588 :
589 : ! Update current values
590 0 : Clock%ThisEYear = Clock%ThisYear
591 0 : Clock%ThisEMonth = Clock%ThisMonth
592 0 : Clock%ThisEDay = Clock%ThisDay
593 0 : Clock%ThisEHour = Clock%ThisHour
594 0 : Clock%ThisEMin = Clock%ThisMin
595 0 : Clock%ThisESec = Clock%ThisSec
596 :
597 : ! Increase counter
598 0 : Clock%nEmisSteps = Clock%nEmisSteps + 1
599 :
600 : ! Set EmisTime to false to make sure that the verbose message
601 : ! below won't be printed.
602 : ELSE
603 0 : EmisTime = .FALSE.
604 : ENDIF
605 : ENDIF
606 :
607 : ! ----------------------------------------------------------------
608 : ! Verbose mode
609 : ! ----------------------------------------------------------------
610 0 : IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN
611 0 : IF ( NewStep ) THEN
612 0 : WRITE(MSG,110) Clock%ThisYear, Clock%ThisMonth, &
613 0 : Clock%ThisDay, Clock%ThisHour, &
614 0 : Clock%ThisMin, Clock%ThisSec
615 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=')
616 0 : WRITE(MSG,120) Clock%ThisWD
617 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
618 0 : WRITE(MSG,130) EmisTime
619 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP2=' ')
620 0 : ELSEIF ( EmisTime ) THEN
621 0 : WRITE(MSG,140) Clock%ThisYear, Clock%ThisMonth, &
622 0 : Clock%ThisDay, Clock%ThisHour, &
623 0 : Clock%ThisMin, Clock%ThisSec
624 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1=' ', SEP2=' ')
625 : ENDIF
626 : ENDIF
627 :
628 : ! Cleanup
629 0 : Clock => NULL()
630 0 : CF => NULL()
631 :
632 : 110 FORMAT( 'Set HEMCO clock to ', i4,'-',i2.2,'-',i2.2,' ', &
633 : i2.2,':',i2.2,':',i2.2 )
634 : 120 FORMAT( 'The weekday is (0=Sun,...,6=Sat): ', i1.1 )
635 : 130 FORMAT( 'Is this an emission time step : ', L1 )
636 : 140 FORMAT( 'Declared emission time: ', i4,'-',i2.2,'-',i2.2,' ', &
637 : i2.2,':',i2.2,':',i2.2 )
638 :
639 : END SUBROUTINE HcoClock_Set
640 : !EOC
641 : !------------------------------------------------------------------------------
642 : ! Harmonized Emissions Component (HEMCO) !
643 : !------------------------------------------------------------------------------
644 : !BOP
645 : !
646 : ! !IROUTINE: HcoClock_Get
647 : !
648 : ! !DESCRIPTION: Subroutine HcoClock\_Get returns the selected UTC variables
649 : ! from the HEMCO clock object.
650 : !\\
651 : !\\
652 : ! !INTERFACE:
653 : !
654 0 : SUBROUTINE HcoClock_Get ( Clock, &
655 : cYYYY, cMM, cDD, cH, &
656 : cM, cS, cDOY, cWEEKDAY, &
657 : pYYYY, pMM, pDD, pH, &
658 : pM, pS, pDOY, pWEEKDAY, &
659 : sYYYY, sMM, sDD, sH, &
660 : sM, sS, &
661 : LMD, nSteps, cMidMon, &
662 : dslmm, dbtwmm, IsEmisTime, &
663 : IsLast, RC )
664 : !
665 : ! !INPUT PARAMETERS:
666 : !
667 : TYPE(HcoClock), POINTER :: Clock ! HEMCO clock obj
668 : !
669 : ! !OUTPUT PARAMETERS:
670 : !
671 : INTEGER, INTENT( OUT), OPTIONAL :: cYYYY ! Current year
672 : INTEGER, INTENT( OUT), OPTIONAL :: cMM ! Current month
673 : INTEGER, INTENT( OUT), OPTIONAL :: cDD ! Current day
674 : INTEGER, INTENT( OUT), OPTIONAL :: cH ! Current hour
675 : INTEGER, INTENT( OUT), OPTIONAL :: cM ! Current minute
676 : INTEGER, INTENT( OUT), OPTIONAL :: cS ! Current second
677 : INTEGER, INTENT( OUT), OPTIONAL :: cDOY ! Current day of year
678 : INTEGER, INTENT( OUT), OPTIONAL :: cWEEKDAY ! Current weekday
679 : INTEGER, INTENT( OUT), OPTIONAL :: pYYYY ! Previous year
680 : INTEGER, INTENT( OUT), OPTIONAL :: pMM ! Previous month
681 : INTEGER, INTENT( OUT), OPTIONAL :: pDD ! Previous day
682 : INTEGER, INTENT( OUT), OPTIONAL :: pH ! Previous hour
683 : INTEGER, INTENT( OUT), OPTIONAL :: pM ! Previous minute
684 : INTEGER, INTENT( OUT), OPTIONAL :: pS ! Previous second
685 : INTEGER, INTENT( OUT), OPTIONAL :: sYYYY ! Simulation year
686 : INTEGER, INTENT( OUT), OPTIONAL :: sMM ! Simulation month
687 : INTEGER, INTENT( OUT), OPTIONAL :: sDD ! Simulation day
688 : INTEGER, INTENT( OUT), OPTIONAL :: sH ! Simulation hour
689 : INTEGER, INTENT( OUT), OPTIONAL :: sM ! Simulation minute
690 : INTEGER, INTENT( OUT), OPTIONAL :: sS ! Simulation second
691 : INTEGER, INTENT( OUT), OPTIONAL :: pDOY ! Previous day of year
692 : INTEGER, INTENT( OUT), OPTIONAL :: pWEEKDAY ! Previous weekday
693 : INTEGER, INTENT( OUT), OPTIONAL :: LMD ! Last day of month
694 : INTEGER, INTENT( OUT), OPTIONAL :: nSteps ! # of passed steps
695 : INTEGER, INTENT( OUT), OPTIONAL :: cMidMon ! Mid-month day of curr. month
696 : INTEGER, INTENT( OUT), OPTIONAL :: dslmm ! days since last mid-month
697 : INTEGER, INTENT( OUT), OPTIONAL :: dbtwmm ! days between mid-month
698 : LOGICAL, INTENT( OUT), OPTIONAL :: IsEmisTime ! days between mid-month
699 : LOGICAL, INTENT( OUT), OPTIONAL :: IsLast ! last time step?
700 : !
701 : ! !INPUT/OUTPUT PARAMETERS:
702 : !
703 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
704 : !
705 : ! !REVISION HISTORY:
706 : ! 29 Dec 2012 - C. Keller - Initialization
707 : ! See https://github.com/geoschem/hemco for complete history
708 : !EOP
709 : !------------------------------------------------------------------------------
710 : !BOC
711 : !
712 : ! !LOCAL VARIABLES:
713 : !
714 :
715 : !======================================================================
716 : ! HcoClock_Get begins here!
717 : !======================================================================
718 :
719 : ! Set selected datetime variables
720 0 : IF ( PRESENT(cYYYY ) ) cYYYY = Clock%ThisYear
721 0 : IF ( PRESENT(cMM ) ) cMM = Clock%ThisMonth
722 0 : IF ( PRESENT(cDD ) ) cDD = Clock%ThisDay
723 0 : IF ( PRESENT(cH ) ) cH = Clock%ThisHour
724 0 : IF ( PRESENT(cM ) ) cM = Clock%ThisMin
725 0 : IF ( PRESENT(cS ) ) cS = Clock%ThisSec
726 0 : IF ( PRESENT(cDOY ) ) cDOY = Clock%ThisDOY
727 0 : IF ( PRESENT(cWEEKDAY ) ) cWEEKDAY = Clock%ThisWD
728 :
729 0 : IF ( PRESENT(pYYYY ) ) pYYYY = Clock%PrevYear
730 0 : IF ( PRESENT(pMM ) ) pMM = Clock%PrevMonth
731 0 : IF ( PRESENT(pDD ) ) pDD = Clock%PrevDay
732 0 : IF ( PRESENT(pH ) ) pH = Clock%PrevHour
733 0 : IF ( PRESENT(pM ) ) pM = Clock%PrevMin
734 0 : IF ( PRESENT(pS ) ) pS = Clock%PrevSec
735 0 : IF ( PRESENT(pDOY ) ) pDOY = Clock%PrevDOY
736 0 : IF ( PRESENT(pWEEKDAY ) ) pWEEKDAY = Clock%PrevWD
737 :
738 0 : IF ( PRESENT(sYYYY ) ) sYYYY = Clock%SimYear
739 0 : IF ( PRESENT(sMM ) ) sMM = Clock%SimMonth
740 0 : IF ( PRESENT(sDD ) ) sDD = Clock%SimDay
741 0 : IF ( PRESENT(sH ) ) sH = Clock%SimHour
742 0 : IF ( PRESENT(sM ) ) sM = Clock%SimMin
743 0 : IF ( PRESENT(sS ) ) sS = Clock%SimSec
744 :
745 0 : IF ( PRESENT(LMD ) ) LMD = Clock%MonthLastDay
746 :
747 0 : IF ( PRESENT(nSteps ) ) nSteps = Clock%nSteps
748 :
749 : ! Mid-month day related variables
750 0 : IF ( PRESENT(cMidMon ) ) cMidMon = MidMon(Clock%ThisMonth)
751 :
752 : ! Days since passing the most recent mid-month day. From modis_lai_mod.F90
753 0 : IF ( PRESENT(dslmm ) ) THEN
754 0 : IF ( Clock%ThisDOY < MidMon(1) ) THEN
755 0 : dslmm = 365 + Clock%ThisDoy - MidMon(12)
756 : ELSE
757 0 : dslmm = MidMon(Clock%ThisMonth+1) - MidMon(Clock%ThisMonth)
758 : ENDIF
759 : ENDIF
760 :
761 : ! Days between most recently passed mid-month day and next one.
762 0 : IF ( PRESENT(dbtwmm ) ) THEN
763 :
764 : ! If day of year is earlier than first mid-month day, we are between
765 : ! December and January.
766 0 : IF ( Clock%ThisDOY < MidMon(1) ) THEN
767 0 : dbtwmm = MidMon(13) - MidMon(12)
768 :
769 : ! If day of year is earlier than mid-month day of current month, the
770 : ! day difference has to be taken relative to previous month' mid-day
771 0 : ELSEIF ( Clock%ThisDOY < MidMon(Clock%ThisMonth) ) THEN
772 0 : dbtwmm = MidMon(Clock%ThisMonth) - MidMon(Clock%ThisMonth-1)
773 :
774 : ! If day of year is after than mid-month day of current month, the
775 : ! day difference has to be taken relative to current month' mid-day
776 : ELSE
777 0 : dbtwmm = MidMon(Clock%ThisMonth+1) - MidMon(Clock%ThisMonth)
778 : ENDIF
779 : ENDIF
780 :
781 : ! Is it time for emissions?
782 0 : IF ( PRESENT(IsEmisTime) ) THEN
783 0 : IsEmisTime = .FALSE.
784 : IF ( ( Clock%ThisEYear == Clock%ThisYear ) .AND. &
785 : ( Clock%ThisEMonth == Clock%ThisMonth ) .AND. &
786 : ( Clock%ThisEDay == Clock%ThisDay ) .AND. &
787 : ( Clock%ThisEHour == Clock%ThisHour ) .AND. &
788 : ( Clock%ThisEMin == Clock%ThisMin ) .AND. &
789 0 : ( Clock%ThisESec == Clock%ThisSec ) .AND. &
790 : ( Clock%LastEStep /= Clock%nEmisSteps ) ) THEN
791 0 : IsEmisTime = .TRUE.
792 : ENDIF
793 : ENDIF
794 :
795 : ! Last step
796 0 : IF ( PRESENT(IsLast) ) IsLast = Clock%isLast
797 :
798 : ! Return w/ success
799 0 : RC = HCO_SUCCESS
800 :
801 0 : END SUBROUTINE HcoClock_Get
802 : !EOC
803 : !------------------------------------------------------------------------------
804 : ! Harmonized Emissions Component (HEMCO) !
805 : !------------------------------------------------------------------------------
806 : !BOP
807 : !
808 : ! !IROUTINE: HcoClock_GetLocal
809 : !
810 : ! !DESCRIPTION: Subroutine HcoClock\_GetLocal returns the selected local
811 : ! time variables from the HEMCO clock object for the given longitude and
812 : ! latitude. At the moment, the time zone is selected purely on the given
813 : ! longitude and the passed latitude is not evaluated.
814 : !\\
815 : !\\
816 : ! !INTERFACE:
817 : !
818 0 : SUBROUTINE HcoClock_GetLocal ( HcoState, I, J, cYYYY, cMM, &
819 : cDD, cH, CWEEKDAY, RC, verb )
820 : !
821 : ! !USES:
822 : !
823 : USE HCO_STATE_MOD, ONLY : HCO_State
824 : !
825 : ! !INPUT PARAMETERS:
826 : !
827 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
828 : INTEGER, INTENT(IN ) :: I ! Longitude index
829 : INTEGER, INTENT(IN ) :: J ! Latitude index
830 : !
831 : ! !OUTPUT PARAMETERS:
832 : !
833 : INTEGER, INTENT( OUT), OPTIONAL :: cYYYY ! Current year
834 : INTEGER, INTENT( OUT), OPTIONAL :: cMM ! Current month
835 : INTEGER, INTENT( OUT), OPTIONAL :: cDD ! Current day
836 : REAL(hp), INTENT( OUT), OPTIONAL :: cH ! Current hour
837 : INTEGER, INTENT( OUT), OPTIONAL :: cWEEKDAY ! Current weekday
838 : INTEGER, INTENT(IN ), OPTIONAL :: verb ! verbose
839 : !
840 : ! !INPUT/OUTPUT PARAMETERS:
841 : !
842 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
843 : !
844 : ! !REMARKS:
845 : ! Module variable TIMEZONES points to the timezone data (i.e. offsets in
846 : ! hours from UTC) as read from disk. The data file containing UTC offsets
847 : ! is specified in the "NON-EMISSIONS DATA" section of the HEMCO configuraiton
848 : ! file, under the container name "TIMEZONES".
849 : !
850 : ! The TIMEZONES module variable is initialized by calling HcoClock_InitTzPtr.
851 : ! in the HEMCO run method HCO_Run (in module hco_driver_mod.F90). The call
852 : ! to HcoClock_InitTzPtr immediately follows the call to ReadList_Read, and
853 : ! is only done on the very first emissions timestep. The reason we have to
854 : ! initialize the TIMEZONES module variable in the run method (instead of in
855 : ! the init method) is because the HEMCO configuration file has to be read
856 : ! before the timezones data can be loaded into a HEMCO data container.
857 : !
858 : ! If we are not reading timezone data from a file, then the TIMEZONES
859 : ! module variable will remain unassociated.
860 : !
861 : ! This fix was necessary in order to avoid segmentation faults when running
862 : ! with OpenMP parallelization turned on.
863 : !
864 : ! -- Bob Yantosca (23 Feb 2015)
865 : !
866 : ! !REVISION HISTORY:
867 : ! 29 Dec 2012 - C. Keller - Initialization
868 : ! See https://github.com/geoschem/hemco for complete history
869 : !EOP
870 : !------------------------------------------------------------------------------
871 : !BOC
872 : ! Local variables
873 : REAL(hp) :: LON
874 : INTEGER :: IX, OFFSET
875 : LOGICAL :: FOUND
876 :
877 : !======================================================================
878 : ! HcoClock_GetLocal begins here!
879 : !======================================================================
880 :
881 : ! Get longitude (degrees east)
882 0 : LON = HcoState%Grid%XMID%Val(I,J)
883 :
884 : ! Longitude must be between -180 and +180
885 0 : IF ( LON < -180_hp ) THEN
886 0 : DO WHILE ( LON < 180_hp )
887 0 : LON = LON + 360_hp
888 : ENDDO
889 : ENDIF
890 0 : IF ( LON > 180_hp ) THEN
891 0 : DO WHILE ( LON > 180_hp )
892 0 : LON = LON - 360_hp
893 : ENDDO
894 : ENDIF
895 :
896 : ! Get time zone index for the given position (longitude and latitude).
897 : ! Use gridded time zones if available, and default 15 degrees time zone
898 : ! bins otherwise.
899 :
900 : ! Init
901 0 : IX = -1
902 :
903 : ! First try to get time zone index from gridded data
904 0 : IF ( ASSOCIATED(HcoState%Clock%TIMEZONES) ) THEN
905 0 : IF ( ASSOCIATED(HcoState%Clock%TIMEZONES%Val) ) THEN
906 :
907 : ! Offset from UTC in hours
908 0 : OFFSET = FLOOR(HcoState%Clock%TIMEZONES%Val(I,J))
909 :
910 : ! Extract time zone index from offset. Index 13 is UTC=0.
911 : ! Valid offset is between -12 and +13
912 0 : IF ( OFFSET >= -12 .AND. OFFSET <= 13 ) THEN
913 0 : IX = 13 + OFFSET
914 : ENDIF
915 :
916 : ENDIF
917 : ENDIF
918 :
919 : ! Use default approach if (a) time zone file is not provided; (b) no valid
920 : ! time zone was found for this grid box.
921 0 : IF ( IX < 0 ) THEN
922 : ! Get time zone index for the given longitude, i.e. see into which time
923 : ! zone the given longitude falls.
924 0 : LON = ( LON + 180_hp ) / 15_hp
925 0 : IX = FLOOR(LON) + 1
926 :
927 : ! Avoid ix=25 if longitude is exactly 180
928 0 : IF ( IX==25 ) IX = 1
929 : ENDIF
930 :
931 : ! Check time zone index
932 0 : IF ( IX > HcoState%Clock%ntz ) THEN
933 0 : CALL HCO_ERROR ( 'time zone index too large!', RC )
934 0 : RETURN
935 : ENDIF
936 :
937 : ! Set defined variables
938 0 : IF ( PRESENT(cYYYY ) ) cYYYY = HcoState%Clock%ThisLocYear(IX)
939 0 : IF ( PRESENT(cMM ) ) cMM = HcoState%Clock%ThisLocMonth(IX)
940 0 : IF ( PRESENT(cDD ) ) cDD = HcoState%Clock%ThisLocDay(IX)
941 0 : IF ( PRESENT(cH ) ) cH = HcoState%Clock%ThisLocHour(IX)
942 0 : IF ( PRESENT(cWEEKDAY) ) cWEEKDAY = HcoState%Clock%ThisLocWD(IX)
943 :
944 : ! Return w/ success
945 0 : RC = HCO_SUCCESS
946 :
947 : END SUBROUTINE HcoClock_GetLocal
948 : !EOC
949 : !------------------------------------------------------------------------------
950 : ! Harmonized Emissions Component (HEMCO) !
951 : !------------------------------------------------------------------------------
952 : !BOP
953 : !
954 : ! !IROUTINE: HcoClock_First
955 : !
956 : ! !DESCRIPTION: Function HcoClock\_First returns TRUE on the first HEMCO
957 : ! time step, FALSE otherwise.
958 : !\\
959 : !\\
960 : ! !INTERFACE:
961 : !
962 0 : FUNCTION HcoClock_First( Clock, EmisTime ) RESULT ( First )
963 : !
964 : ! !INPUT ARGUMENTS:
965 : !
966 : TYPE(HcoClock), POINTER :: Clock
967 : LOGICAL, INTENT(IN) :: EmisTime
968 : !
969 : ! !RETURN VALUE:
970 : !
971 : LOGICAL :: First
972 : !
973 : ! !REVISION HISTORY:
974 : ! 29 Dec 2012 - C. Keller - Initialization
975 : ! See https://github.com/geoschem/hemco for complete history
976 : !EOP
977 : !------------------------------------------------------------------------------
978 : !BOC
979 0 : IF ( EmisTime ) THEN
980 : !First = ( Clock%nEmisSteps == 1 )
981 0 : First = ( Clock%nEmisSteps <= 1 )
982 : ELSE
983 : !First = ( Clock%nSteps == 1 )
984 0 : First = ( Clock%nSteps <= 1 )
985 : ENDIF
986 :
987 0 : END FUNCTION HcoClock_First
988 : !EOC
989 : !------------------------------------------------------------------------------
990 : ! Harmonized Emissions Component (HEMCO) !
991 : !------------------------------------------------------------------------------
992 : !BOP
993 : !
994 : ! !IROUTINE: HcoClock_Rewind
995 : !
996 : ! !DESCRIPTION: Function HcoClock\_Rewind returns TRUE if the last archived
997 : ! HEMCO time step is not in the past.
998 : !\\
999 : !\\
1000 : ! !INTERFACE:
1001 : !
1002 0 : FUNCTION HcoClock_Rewind( Clock, EmisTime ) RESULT ( Rwnd )
1003 : !
1004 : ! !INPUT ARGUMENTS:
1005 : !
1006 : TYPE(HcoClock), POINTER :: Clock
1007 : LOGICAL, INTENT(IN) :: EmisTime
1008 : !
1009 : ! !RETURN VALUE:
1010 : !
1011 : LOGICAL :: Rwnd
1012 : !
1013 : ! !REVISION HISTORY:
1014 : ! 08 May 2015 - C. Keller - Initial version
1015 : ! See https://github.com/geoschem/hemco for complete history
1016 : !EOP
1017 : !------------------------------------------------------------------------------
1018 : !BOC
1019 :
1020 : INTEGER :: YYYYMMDD, HHMMSS
1021 : INTEGER :: pYYYYMMDD, pHHMMSS
1022 :
1023 : ! Init
1024 0 : Rwnd = .FALSE.
1025 :
1026 : ! Get current and previous date & time
1027 0 : IF ( EmisTime ) THEN
1028 : YYYYMMDD = Clock%ThisEYear * 10000 + &
1029 : Clock%ThisEMonth * 100 + &
1030 0 : Clock%ThisEDay
1031 : HHMMSS = Clock%ThisEHour * 10000 + &
1032 : Clock%ThisEMin * 100 + &
1033 0 : Clock%ThisESec
1034 :
1035 : pYYYYMMDD = Clock%PrevEYear * 10000 + &
1036 : Clock%PrevEMonth * 100 + &
1037 0 : Clock%PrevEDay
1038 : pHHMMSS = Clock%PrevEHour * 10000 + &
1039 : Clock%PrevEMin * 100 + &
1040 0 : Clock%PrevESec
1041 :
1042 : ELSE
1043 : YYYYMMDD = Clock%ThisYear * 10000 + &
1044 : Clock%ThisMonth * 100 + &
1045 0 : Clock%ThisDay
1046 : HHMMSS = Clock%ThisHour * 10000 + &
1047 : Clock%ThisMin * 100 + &
1048 0 : Clock%ThisSec
1049 :
1050 : pYYYYMMDD = Clock%PrevYear * 10000 + &
1051 : Clock%PrevMonth * 100 + &
1052 0 : Clock%PrevDay
1053 : pHHMMSS = Clock%PrevHour * 10000 + &
1054 : Clock%PrevMin * 100 + &
1055 0 : Clock%PrevSec
1056 : ENDIF
1057 :
1058 : ! Check if current date & time is in future
1059 0 : IF ( ( pHHMMSS > HHMMSS ) .AND. &
1060 : ( pYYYYMMDD >= YYYYMMDD ) ) THEN
1061 : Rwnd = .TRUE.
1062 0 : ELSEIF ( pYYYYMMDD > YYYYMMDD ) THEN
1063 0 : Rwnd = .TRUE.
1064 : ENDIF
1065 :
1066 0 : END FUNCTION HcoClock_Rewind
1067 : !EOC
1068 : !------------------------------------------------------------------------------
1069 : ! Harmonized Emissions Component (HEMCO) !
1070 : !------------------------------------------------------------------------------
1071 : !BOP
1072 : !
1073 : ! !IROUTINE: HcoClock_NewYear
1074 : !
1075 : ! !DESCRIPTION: Function HcoClock\_NewYear returns TRUE if this is a new
1076 : ! year (compared to the previous emission time step), FALSE otherwise.
1077 : !\\
1078 : !\\
1079 : ! !INTERFACE:
1080 : !
1081 0 : FUNCTION HcoClock_NewYear( Clock, EmisTime ) RESULT ( NewYear )
1082 : !
1083 : ! !INPUT ARGUMENTS:
1084 : !
1085 : TYPE(HcoClock), POINTER :: Clock
1086 : LOGICAL, INTENT(IN) :: EmisTime
1087 : !
1088 : ! !RETURN VALUE:
1089 : !
1090 : LOGICAL :: NewYear
1091 : !
1092 : ! !REVISION HISTORY:
1093 : ! 29 Dec 2012 - C. Keller - Initialization
1094 : ! See https://github.com/geoschem/hemco for complete history
1095 : !EOP
1096 : !------------------------------------------------------------------------------
1097 : !BOC
1098 :
1099 0 : IF ( EmisTime ) THEN
1100 0 : NewYear = ( Clock%ThisEYear /= Clock%PrevEYear )
1101 : ELSE
1102 0 : NewYear = ( Clock%ThisYear /= Clock%PrevYear )
1103 : ENDIF
1104 :
1105 0 : END FUNCTION HcoClock_NewYear
1106 : !EOC
1107 : !------------------------------------------------------------------------------
1108 : ! Harmonized Emissions Component (HEMCO) !
1109 : !------------------------------------------------------------------------------
1110 : !BOP
1111 : !
1112 : ! !IROUTINE: HcoClock_NewMonth
1113 : !
1114 : ! !DESCRIPTION: Function HcoClock\_NewMonth returns TRUE if this is a new
1115 : ! month (compared to the previous emission time step), FALSE otherwise.
1116 : !\\
1117 : !\\
1118 : ! !INTERFACE:
1119 : !
1120 0 : FUNCTION HcoClock_NewMonth( Clock, EmisTime ) RESULT ( NewMonth )
1121 : !
1122 : ! !INPUT ARGUMENTS:
1123 : !
1124 : TYPE(HcoClock), POINTER :: Clock
1125 : LOGICAL, INTENT(IN) :: EmisTime
1126 : !
1127 : ! !RETURN VALUE:
1128 : !
1129 : LOGICAL :: NewMonth
1130 : !
1131 : ! !REVISION HISTORY:
1132 : ! 29 Dec 2012 - C. Keller - Initialization
1133 : ! See https://github.com/geoschem/hemco for complete history
1134 : !EOP
1135 : !------------------------------------------------------------------------------
1136 : !BOC
1137 :
1138 0 : IF ( EmisTime ) THEN
1139 0 : NewMonth = ( Clock%ThisEMonth /= Clock%PrevEMonth )
1140 : ELSE
1141 0 : NewMonth = ( Clock%ThisMonth /= Clock%PrevMonth )
1142 : ENDIF
1143 :
1144 0 : END FUNCTION HcoClock_NewMonth
1145 : !EOC
1146 : !------------------------------------------------------------------------------
1147 : ! Harmonized Emissions Component (HEMCO) !
1148 : !------------------------------------------------------------------------------
1149 : !BOP
1150 : !
1151 : ! !IROUTINE: HcoClock_NewDay
1152 : !
1153 : ! !DESCRIPTION: Function HcoClock\_NewDay returns TRUE if this is a new
1154 : ! day (compared to the previous emission time step), FALSE otherwise.
1155 : !\\
1156 : !\\
1157 : ! !INTERFACE:
1158 : !
1159 0 : FUNCTION HcoClock_NewDay( Clock, EmisTime ) RESULT ( NewDay )
1160 : !
1161 : ! !INPUT ARGUMENTS:
1162 : !
1163 : TYPE(HcoClock), POINTER :: Clock
1164 : LOGICAL, INTENT(IN) :: EmisTime
1165 : !
1166 : ! !RETURN VALUE:
1167 : !
1168 : LOGICAL :: NewDay
1169 : !
1170 : ! !REVISION HISTORY:
1171 : ! 29 Dec 2012 - C. Keller - Initialization
1172 : ! See https://github.com/geoschem/hemco for complete history
1173 : !EOP
1174 : !------------------------------------------------------------------------------
1175 : !BOC
1176 :
1177 0 : IF ( EmisTime ) THEN
1178 0 : NewDay = ( Clock%ThisEDay /= Clock%PrevEDay )
1179 : ELSE
1180 0 : NewDay = ( Clock%ThisDay /= Clock%PrevDay )
1181 : ENDIF
1182 :
1183 0 : END FUNCTION HcoClock_NewDay
1184 : !EOC
1185 : !------------------------------------------------------------------------------
1186 : ! Harmonized Emissions Component (HEMCO) !
1187 : !------------------------------------------------------------------------------
1188 : !BOP
1189 : !
1190 : ! !IROUTINE: HcoClock_NewHour
1191 : !
1192 : ! !DESCRIPTION: Function HcoClock\_NewHour returns TRUE if this is a new
1193 : ! hour (compared to the previous emission time step), FALSE otherwise.
1194 : !\\
1195 : !\\
1196 : ! !INTERFACE:
1197 : !
1198 0 : FUNCTION HcoClock_NewHour( Clock, EmisTime ) RESULT ( NewHour )
1199 : !
1200 : ! !INPUT ARGUMENTS:
1201 : !
1202 : TYPE(HcoClock), POINTER :: Clock
1203 : LOGICAL, INTENT(IN) :: EmisTime
1204 : !
1205 : ! !RETURN VALUE:
1206 : !
1207 : LOGICAL :: NewHour
1208 : !
1209 : ! !REVISION HISTORY:
1210 : ! 29 Dec 2012 - C. Keller - Initialization
1211 : ! See https://github.com/geoschem/hemco for complete history
1212 : !EOP
1213 : !------------------------------------------------------------------------------
1214 : !BOC
1215 :
1216 0 : IF ( EmisTime ) THEN
1217 0 : NewHour = ( Clock%ThisEHour /= Clock%PrevEHour )
1218 : ELSE
1219 0 : NewHour = ( Clock%ThisHour /= Clock%PrevHour )
1220 : ENDIF
1221 :
1222 0 : END FUNCTION HcoClock_NewHour
1223 : !EOC
1224 : !------------------------------------------------------------------------------
1225 : ! Harmonized Emissions Component (HEMCO) !
1226 : !------------------------------------------------------------------------------
1227 : !BOP
1228 : !
1229 : ! !IROUTINE: HcoClock_New3Hour
1230 : !
1231 : ! !DESCRIPTION: Function HcoClock\_New3Hour returns TRUE if this is a new
1232 : ! 3-hour timestep, FALSE otherwise.
1233 : !\\
1234 : !\\
1235 : ! !INTERFACE:
1236 : !
1237 0 : FUNCTION HcoClock_New3Hour( Clock, EmisTime ) RESULT ( New3Hour )
1238 : !
1239 : ! !INPUT ARGUMENTS:
1240 : !
1241 : TYPE(HcoClock), POINTER :: Clock
1242 : LOGICAL, INTENT(IN) :: EmisTime
1243 : !
1244 : ! !RETURN VALUE:
1245 : !
1246 : LOGICAL :: New3Hour
1247 : !
1248 : ! !REVISION HISTORY:
1249 : ! 08 Dec 2019 - M. Sulprizio- Initial version
1250 : ! See https://github.com/geoschem/hemco for complete history
1251 : !EOP
1252 : !------------------------------------------------------------------------------
1253 : !BOC
1254 : !
1255 : ! !LOCAL VARIABLES:
1256 : !
1257 : INTEGER :: HHMMSS
1258 :
1259 : ! Compute hour-minute-second variable
1260 0 : HHMMSS = Clock%ThisHour * 10000 + Clock%ThisMin * 100 + Clock%ThisSec
1261 :
1262 : ! Read 3-hourly fields as hour 0, 3, 6, 9, 12, 15, 18 UTC
1263 0 : New3Hour = ( MOD( HHMMSS, 030000 ) == 0 )
1264 :
1265 0 : END FUNCTION HcoClock_New3Hour
1266 : !EOC
1267 : !------------------------------------------------------------------------------
1268 : ! Harmonized Emissions Component (HEMCO) !
1269 : !------------------------------------------------------------------------------
1270 : !BOP
1271 : !
1272 : ! !IROUTINE: HcoClock_Cleanup
1273 : !
1274 : ! !DESCRIPTION: Subroutine HcoClock\_Cleanup removes the given HcoHcoClock
1275 : ! type.
1276 : !\\
1277 : !\\
1278 : ! !INTERFACE:
1279 : !
1280 0 : SUBROUTINE HcoClock_Cleanup ( Clock )
1281 : !
1282 : ! !USES:
1283 : !
1284 : USE HCO_ARR_MOD, ONLY : HCO_ArrCleanup
1285 : !
1286 : ! !INPUT ARGUMENTS:
1287 : !
1288 : TYPE(HcoClock), POINTER :: Clock
1289 : !
1290 : ! !REVISION HISTORY:
1291 : ! 29 Dec 2012 - C. Keller - Initialization
1292 : ! See https://github.com/geoschem/hemco for complete history
1293 : !EOP
1294 : !------------------------------------------------------------------------------
1295 : !BOC
1296 :
1297 : !======================================================================
1298 : ! HcoClock_Cleanup begins here!
1299 : !======================================================================
1300 0 : IF ( ASSOCIATED( Clock ) ) THEN
1301 :
1302 : ! Make sure TimeZones does not point to any content any more.
1303 0 : CALL HCO_ArrCleanup( Clock%TimeZones, DeepClean=.FALSE. )
1304 :
1305 : ! We also need to free the pointer fields in the Clock object
1306 0 : IF ( ASSOCIATED( Clock%ThisLocYear ) ) THEN
1307 0 : DEALLOCATE( Clock%ThisLocYear )
1308 : ENDIF
1309 0 : Clock%ThisLocYear => NULL()
1310 :
1311 0 : IF ( ASSOCIATED( Clock%ThisLocMonth ) ) THEN
1312 0 : DEALLOCATE( Clock%ThisLocMonth )
1313 : ENDIF
1314 0 : Clock%ThisLocMonth => NULL()
1315 :
1316 0 : IF ( ASSOCIATED( Clock%ThisLocDay ) ) THEN
1317 0 : DEALLOCATE( Clock%ThisLocDay )
1318 : ENDIF
1319 0 : Clock%ThisLocDay => NULL()
1320 :
1321 0 : IF ( ASSOCIATED( Clock%ThisLocWD ) ) THEN
1322 0 : DEALLOCATE( Clock%ThisLocWD )
1323 : ENDIF
1324 0 : Clock%ThisLocWD => NULL()
1325 :
1326 0 : IF ( ASSOCIATED( Clock%ThisLocHour ) ) THEN
1327 0 : DEALLOCATE( Clock%ThisLocHour )
1328 : ENDIF
1329 0 : Clock%ThisLocHour => NULL()
1330 :
1331 0 : DEALLOCATE ( Clock )
1332 : ENDIF
1333 0 : Clock => NULL()
1334 :
1335 0 : END SUBROUTINE HcoClock_Cleanup
1336 : !EOC
1337 : !------------------------------------------------------------------------------
1338 : ! Harmonized Emissions Component (HEMCO) !
1339 : !------------------------------------------------------------------------------
1340 : !BOP
1341 : !
1342 : ! !FUNCTION: HCO_GetWeekday
1343 : !
1344 : ! !DESCRIPTION: Function HCO\_GetWeekday returns the weekday for the
1345 : ! given date (year, month, day).
1346 : ! 0 = Sunday, 1 = Monday, ..., 6 = Saturday.
1347 : !\\
1348 : !\\
1349 : ! !INTERFACE:
1350 : !
1351 0 : FUNCTION HCO_GetWeekday( year, month, day, gmt ) RESULT ( weekday )
1352 : !
1353 : ! !INPUT PARAMETERS:
1354 : !
1355 : INTEGER, INTENT(IN) :: year
1356 : INTEGER, INTENT(IN) :: month
1357 : INTEGER, INTENT(IN) :: day
1358 : REAL(sp), INTENT(IN) :: gmt
1359 : !
1360 : ! !RETURN VALUE:
1361 : !
1362 : INTEGER :: weekday
1363 : !
1364 : ! ! NOTES: This function is largely based on the GEOS-Chem functions
1365 : ! in time_mod.F.
1366 : !
1367 : ! !REVISION HISTORY:
1368 : ! 18 Dec 2013 - C. Keller - Initialization
1369 : ! See https://github.com/geoschem/hemco for complete history
1370 : !EOP
1371 : !------------------------------------------------------------------------------
1372 : !BOC
1373 : !
1374 : ! !LOCAL VARIABLES:
1375 : !
1376 : REAL(dp) :: A, B, JD, THISDAY, TMP
1377 :
1378 : !--------------------------
1379 : ! HCO_GetWeekday begins here
1380 : !--------------------------
1381 :
1382 : ! Day of week w/r/t the GMT date
1383 : ! Use same algorithm as in routine SET_CURRENT_TIME
1384 0 : THISDAY = DAY + ( GMT / 24.0_dp )
1385 0 : JD = JULDAY( YEAR, MONTH, THISDAY )
1386 0 : A = ( JD + 1.5_dp ) / 7_dp
1387 0 : B = ( A - INT( A ) ) * 7_dp
1388 0 : B = INT( NINT( B* 1e5_dp + SIGN(5.0_dp,B) ) / 10_dp ) / 1e4_dp
1389 0 : weekday = INT( B )
1390 :
1391 0 : END FUNCTION HCO_GetWeekday
1392 : !EOC
1393 : !------------------------------------------------------------------------------
1394 : ! Harmonized Emissions Component (HEMCO) !
1395 : !------------------------------------------------------------------------------
1396 : !BOP
1397 : !
1398 : ! !IROUTINE: get_lastdayofmonth
1399 : !
1400 : ! !DESCRIPTION: Function GET\_LASTDAYOFMONTH returns the last day of MONTH.
1401 : !\\
1402 : !\\
1403 : ! !INTERFACE:
1404 : !
1405 0 : FUNCTION Get_LastDayOfMonth( Month, Year ) RESULT ( LastDay )
1406 : !
1407 : ! !INPUT PARAMETERS:
1408 : !
1409 : INTEGER, INTENT(IN) :: Month
1410 : INTEGER, INTENT(IN) :: Year
1411 : !
1412 : ! !RETURN VALUE:
1413 : !
1414 : INTEGER :: LastDay
1415 : !
1416 : ! !REVISION HISTORY:
1417 : ! 13 Jan 2014 - C. Keller - Initial version
1418 : ! See https://github.com/geoschem/hemco for complete history
1419 : !EOP
1420 : !------------------------------------------------------------------------------
1421 : !BOC
1422 :
1423 : !-----------------------------------
1424 : ! GET_LASTDAYOFMONTH begins here!
1425 : !-----------------------------------
1426 :
1427 : ! Set default value (MSL: 11/20/14)
1428 0 : LastDay = 31
1429 :
1430 : ! Select month
1431 0 : SELECT CASE ( Month )
1432 :
1433 : ! Months with 31 days
1434 : CASE (1,3,5,7,8,10,12)
1435 0 : LastDay = 31
1436 :
1437 : ! Months with 30 days
1438 : CASE (4,6,9,11)
1439 0 : LastDay = 30
1440 :
1441 : ! February
1442 : CASE (2)
1443 0 : LastDay = 28
1444 :
1445 : ! Check for leap years:
1446 0 : IF ( (MOD(Year,4 ) == 0) .AND. &
1447 0 : (MOD(Year,400) /= 0) ) THEN
1448 0 : LastDay = 29
1449 : ENDIF
1450 :
1451 : END SELECT
1452 :
1453 0 : END FUNCTION Get_LastDayOfMonth
1454 : !EOC
1455 : !------------------------------------------------------------------------------
1456 : ! Harmonized Emissions Component (HEMCO) !
1457 : !------------------------------------------------------------------------------
1458 : !BOP
1459 : !
1460 : ! !IROUTINE: Set_LocalTime
1461 : !
1462 : ! !DESCRIPTION: Subroutine Set\_LocalTime sets the local time vectors in
1463 : ! the HEMCO clock object. Local time is calculated for each of the 24
1464 : ! defined time zones.
1465 : !\\
1466 : !\\
1467 : ! !INTERFACE:
1468 : !
1469 0 : SUBROUTINE Set_LocalTime ( HcoState, Clock, UTC, RC )
1470 : !
1471 : ! !USES:
1472 : !
1473 : USE HCO_STATE_MOD, ONLY : HCO_State
1474 : !
1475 : ! !INPUT PARAMETERS:
1476 : !
1477 : TYPE(HCO_STATE), POINTER :: HcoState
1478 : TYPE(HcoClock), POINTER :: Clock ! Clock object
1479 : REAL(sp), INTENT(IN ) :: UTC ! UTC time
1480 : !
1481 : ! !INPUT/OUTPUT PARAMETERS:
1482 : !
1483 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
1484 : !
1485 : ! !REVISION HISTORY:
1486 : ! 13 Jan 2014 - C. Keller - Initial version
1487 : ! See https://github.com/geoschem/hemco for complete history
1488 : !EOP
1489 : !------------------------------------------------------------------------------
1490 : !BOC
1491 : !
1492 : ! !LOCAL VARIABLES:
1493 : !
1494 : INTEGER :: I, MtLastDay
1495 : REAL(sp) :: LocDt, DECloc
1496 : REAL(sp) :: ThisLocHour
1497 : INTEGER :: ThisLocYear, ThisLocMonth
1498 : INTEGER :: ThisLocDay, ThisLocWD
1499 : CHARACTER(LEN=255) :: LOC
1500 :
1501 : !-----------------------------------
1502 : ! SET_LOCALTIME begins here!
1503 : !-----------------------------------
1504 0 : LOC = 'SET_LOCALTIME (HCO_CLOCK_MOD.F90)'
1505 :
1506 : ! Enter
1507 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
1508 0 : IF ( RC /= HCO_SUCCESS ) THEN
1509 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
1510 0 : RETURN
1511 : ENDIF
1512 :
1513 : ! Loop over all time zones to account for different local times.
1514 0 : DO I = 1, Clock%ntz
1515 :
1516 : ! local time shift relative to UTC
1517 0 : LocDt = -12_sp + real(I-1,sp)
1518 :
1519 : ! local decimal time
1520 0 : DECloc = UTC + LocDt
1521 :
1522 : ! Extract local dates
1523 :
1524 : ! defaults
1525 0 : ThisLocYear = Clock%ThisYear
1526 0 : ThisLocMonth = Clock%ThisMonth
1527 :
1528 : ! Case 1: Local time is one day behind UTC.
1529 0 : IF ( DECloc < 0.0_sp ) THEN
1530 0 : ThisLocHour = DECloc + 24_sp
1531 :
1532 : ! Adjust local weekday
1533 0 : ThisLocWD = Clock%ThisWD - 1
1534 0 : IF ( ThisLocWD < 0 ) ThisLocWD = 6
1535 :
1536 : ! Adjust local day. Also correct local
1537 : ! month/year if needed!
1538 0 : ThisLocDay = Clock%ThisDay - 1
1539 0 : IF ( ThisLocDay == 0 ) THEN
1540 0 : ThisLocMonth = ThisLocMonth - 1
1541 0 : IF ( ThisLocMonth == 0 ) THEN
1542 0 : ThisLocMonth = 12
1543 0 : ThisLocYear = Clock%ThisYear - 1
1544 : ENDIF
1545 : ThisLocDay = Get_LastDayOfMonth( ThisLocMonth, &
1546 0 : ThisLocYear )
1547 : ENDIF
1548 :
1549 : ! Case 2: Local time is one day ahead UTC.
1550 0 : ELSE IF ( DECloc >= 24.0_sp ) THEN
1551 0 : ThisLocHour = DECloc - 24_sp
1552 :
1553 : ! Adjust local weekday
1554 0 : ThisLocWD = Clock%ThisWD + 1
1555 0 : IF ( ThisLocWD > 6 ) ThisLocWD = 0
1556 :
1557 : ! Adjust local day. Also correct local
1558 : ! month/year if needed!
1559 0 : ThisLocDay = Clock%ThisDay + 1
1560 0 : IF ( ThisLocDay > Clock%MonthLastDay ) THEN
1561 0 : ThisLocMonth = ThisLocMonth + 1
1562 0 : IF ( ThisLocMonth == 13 ) THEN
1563 0 : ThisLocMonth = 1
1564 0 : ThisLocYear = Clock%ThisYear + 1
1565 : ENDIF
1566 : ThisLocDay = Get_LastDayOfMonth( ThisLocMonth, &
1567 0 : ThisLocYear )
1568 : ENDIF
1569 :
1570 : ! Case 3: Local time is same day as UTC.
1571 : ELSE
1572 0 : ThisLocHour = DECloc
1573 :
1574 : ! local day same as utc day
1575 0 : ThisLocWD = Clock%ThisWD
1576 0 : ThisLocDay = Clock%ThisDay
1577 : ENDIF
1578 :
1579 : ! Error trap: prevent local time from being 24
1580 : ! (can occur due to rounding errors)
1581 0 : IF ( ThisLocHour == 24.0_sp ) THEN
1582 0 : ThisLocHour = 0.0_sp
1583 : ENDIF
1584 :
1585 : ! Pass to Clock
1586 0 : Clock%ThisLocYear(I) = ThisLocYear
1587 0 : Clock%ThisLocMonth(I) = ThisLocMonth
1588 0 : Clock%ThisLocDay(I) = ThisLocDay
1589 0 : Clock%ThisLocWD(I) = ThisLocWD
1590 0 : Clock%ThisLocHour(I) = ThisLocHour
1591 : ENDDO !I
1592 :
1593 : ! Leave w/ success
1594 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
1595 :
1596 : END SUBROUTINE Set_LocalTime
1597 : !EOC
1598 : !------------------------------------------------------------------------------
1599 : ! Harmonized Emissions Component (HEMCO) !
1600 : !------------------------------------------------------------------------------
1601 : !BOP
1602 : !
1603 : ! !IROUTINE: HcoClock_CalcDOY
1604 : !
1605 : ! !DESCRIPTION: FUNCTION HcoClock\_CalcDOY calculates the day of year
1606 : ! for the given year, month, and day.
1607 : !\\
1608 : !\\
1609 : ! !INTERFACE:
1610 : !
1611 0 : FUNCTION HcoClock_CalcDOY( YYYY, MM, DD ) RESULT ( DOY )
1612 : !
1613 : ! !INPUT ARGUMENTS:
1614 : !
1615 : INTEGER, INTENT(IN) :: YYYY ! Year
1616 : INTEGER, INTENT(IN) :: MM ! Month
1617 : INTEGER, INTENT(IN) :: DD ! Day
1618 : !
1619 : ! !RETURN VALUE:
1620 : !
1621 : INTEGER :: DOY ! Day of year
1622 : !
1623 : ! !REVISION HISTORY:
1624 : ! 08 Jul 2014 - C. Keller - Initial version
1625 : ! See https://github.com/geoschem/hemco for complete history
1626 : !EOP
1627 : !------------------------------------------------------------------------------
1628 : !BOC
1629 : !
1630 : ! LOCAL VARIABLES:
1631 : !
1632 : INTEGER :: TMP, N
1633 :
1634 : !-----------------------------------
1635 : ! HcoClock_CalcDOY begins here
1636 : !-----------------------------------
1637 :
1638 : ! Init
1639 0 : DOY = 0
1640 :
1641 : ! Add total days of all month up to current month MM
1642 0 : DO N = 1, MM-1
1643 0 : TMP = Get_LastDayOfMonth( N, YYYY )
1644 0 : DOY = DOY + TMP
1645 : ENDDO
1646 :
1647 : ! Add all days of current month
1648 0 : DOY = DOY + DD
1649 :
1650 0 : END FUNCTION HcoClock_CalcDOY
1651 : !EOC
1652 : !------------------------------------------------------------------------------
1653 : ! Harmonized Emissions Component (HEMCO) !
1654 : !------------------------------------------------------------------------------
1655 : !BOP
1656 : !
1657 : ! !IROUTINE: HcoClock_Increase
1658 : !
1659 : ! !DESCRIPTION: Subroutine HcoClock\_Increase increases the HEMCO clock by the
1660 : ! specified time.
1661 : !\\
1662 : !\\
1663 : ! !INTERFACE:
1664 : !
1665 0 : SUBROUTINE HcoClock_Increase ( HcoState, TimeStep, EmisTime, RC )
1666 : !
1667 : ! !USES:
1668 : !
1669 : USE HCO_STATE_MOD, ONLY : HCO_State
1670 : !
1671 : ! !INPUT PARAMETERS:
1672 : !
1673 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
1674 : REAL(sp), INTENT(IN ) :: TimeStep ! Time step increase [s]
1675 : LOGICAL, INTENT(IN ) :: EmisTime ! Is new time step emission time?
1676 : !
1677 : ! !INPUT/OUTPUT PARAMETERS:
1678 : !
1679 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
1680 : !
1681 : ! !REVISION HISTORY:
1682 : ! 29 Jul 2014 - C. Keller - Initial version
1683 : ! See https://github.com/geoschem/hemco for complete history
1684 : !EOP
1685 : !------------------------------------------------------------------------------
1686 : !BOC
1687 : !
1688 : ! !LOCAL VARIABLES:
1689 : !
1690 : TYPE(HcoClock), POINTER :: Clock
1691 : INTEGER :: YYYYMMDD, HHMMSS
1692 : INTEGER :: Yr, Mt, Dy, Hr, Mn, Sc
1693 : REAL(dp) :: DAY, UTC, JD
1694 : CHARACTER(LEN=255) :: LOC
1695 :
1696 : !-----------------------------------
1697 : ! HcoClock_Increase begins here!
1698 : !-----------------------------------
1699 0 : LOC = 'HcoClock_Increase (HCO_CLOCK_MOD.F90)'
1700 :
1701 : ! Get pointer to HEMCO clock
1702 0 : Clock => HcoState%Clock
1703 :
1704 : ! Get current date as Julian day.
1705 : UTC = ( REAL(Clock%ThisHour,dp) / 24.0_dp ) + &
1706 : ( REAL(Clock%ThisMin ,dp) / 1440.0_dp ) + &
1707 0 : ( REAL(Clock%ThisSec ,dp) / 86400.0_dp )
1708 0 : DAY = REAL(Clock%ThisDay,dp) + UTC
1709 0 : JD = JULDAY( Clock%ThisYear, Clock%ThisMonth, DAY )
1710 :
1711 : ! Add time step
1712 0 : JD = JD + ( REAL(TimeStep,dp) / 86400.0_dp )
1713 :
1714 : ! Translate back into dates.
1715 0 : CALL CALDATE( JD, YYYYMMDD, HHMMSS )
1716 0 : Yr = FLOOR ( MOD( YYYYMMDD, 100000000) / 1.0e4_dp )
1717 0 : Mt = FLOOR ( MOD( YYYYMMDD, 10000 ) / 1.0e2_dp )
1718 0 : Dy = FLOOR ( MOD( YYYYMMDD, 100 ) / 1.0e0_dp )
1719 :
1720 0 : Hr = FLOOR ( MOD( HHMMSS, 1000000 ) / 1.0e4_dp )
1721 0 : Mn = FLOOR ( MOD( HHMMSS, 10000 ) / 1.0e2_dp )
1722 0 : Sc = FLOOR ( MOD( HHMMSS, 100 ) / 1.0e0_dp )
1723 :
1724 : ! Update HEMCO clock to new values
1725 : CALL HcoClock_Set ( HcoState, Yr, Mt, Dy, Hr, Mn, Sc, &
1726 0 : IsEmisTime=EmisTime, RC=RC )
1727 0 : IF ( RC /= HCO_SUCCESS ) THEN
1728 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
1729 0 : RETURN
1730 : ENDIF
1731 :
1732 : ! Cleanup
1733 0 : Clock => NULL()
1734 :
1735 : ! Return w/ success
1736 0 : RC = HCO_SUCCESS
1737 :
1738 : END SUBROUTINE HcoClock_Increase
1739 : !EOC
1740 : !------------------------------------------------------------------------------
1741 : ! Harmonized Emissions Component (HEMCO) !
1742 : !------------------------------------------------------------------------------
1743 : !BOP
1744 : !
1745 : ! !IROUTINE: HcoClock_EmissionsDone
1746 : !
1747 : ! !DESCRIPTION: Subroutine HcoClock\_EmissionsDone marks the current (emission)
1748 : ! time step as having emissions completed. This is useful if the HEMCO core
1749 : ! routines are called multiple times on the same time step, e.g. if there are
1750 : ! two run phases.
1751 : !\\
1752 : !\\
1753 : ! !INTERFACE:
1754 : !
1755 0 : SUBROUTINE HcoClock_EmissionsDone( Clock, RC )
1756 : !
1757 : ! !INPUT PARAMETERS:
1758 : !
1759 : TYPE(HcoClock), POINTER :: Clock ! HEMCO clock obj
1760 : !
1761 : ! !INPUT/OUTPUT PARAMETERS:
1762 : !
1763 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
1764 : !
1765 : ! !REVISION HISTORY:
1766 : ! 13 Jan 2015 - C. Keller - Initial version
1767 : ! See https://github.com/geoschem/hemco for complete history
1768 : !EOP
1769 : !------------------------------------------------------------------------------
1770 : !BOC
1771 :
1772 : ! Update flag
1773 0 : Clock%LastEStep = Clock%nEmisSteps
1774 :
1775 : ! Return w/ success
1776 0 : RC = HCO_SUCCESS
1777 :
1778 0 : END SUBROUTINE HcoClock_EmissionsDone
1779 : !EOC
1780 : !------------------------------------------------------------------------------
1781 : ! Harmonized Emissions Component (HEMCO) !
1782 : !------------------------------------------------------------------------------
1783 : !BOP
1784 : !
1785 : ! !IROUTINE: HcoClock_SetLast
1786 : !
1787 : ! !DESCRIPTION: Subroutine HcoClock\_SetLast sets the IsLast flag.
1788 : !\\
1789 : !\\
1790 : ! !INTERFACE:
1791 : !
1792 0 : SUBROUTINE HcoClock_SetLast( Clock, IsLast, RC )
1793 : !
1794 : ! !INPUT PARAMETERS:
1795 : !
1796 : TYPE(HcoClock), POINTER :: Clock ! HEMCO clock obj
1797 : LOGICAL, INTENT(IN ) :: IsLast ! Is last time step?
1798 : !
1799 : ! !INPUT/OUTPUT PARAMETERS:
1800 : !
1801 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
1802 : !
1803 : ! !REVISION HISTORY:
1804 : ! 01 Nov 2016 - C. Keller - Initial version
1805 : ! See https://github.com/geoschem/hemco for complete history
1806 : !EOP
1807 : !------------------------------------------------------------------------------
1808 : !BOC
1809 :
1810 : ! Update flag
1811 0 : Clock%IsLast = IsLast
1812 :
1813 : ! Return w/ success
1814 0 : RC = HCO_SUCCESS
1815 :
1816 0 : END SUBROUTINE HcoClock_SetLast
1817 : !EOC
1818 : END MODULE HCO_CLOCK_MOD
1819 : !EOM
|