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