source: palm/trunk/SOURCE/date_and_time_mod.f90 @ 3637

Last change on this file since 3637 was 3614, checked in by raasch, 5 years ago

unused variables removed, abort renamed inifor_abort to avoid intrinsic problem in Fortran

  • Property svn:keywords set to Id
File size: 20.8 KB
Line 
1!> @file date_and_time_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2018 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: date_and_time_mod.f90 3614 2018-12-10 07:05:46Z knoop $
27! further tabs removed
28!
29! 3467 2018-10-30 19:05:21Z suehring
30! Tabs removed
31!
32! 3458 2018-10-30 14:51:23Z kanani
33! from chemistry branch r3443, banzhafs:
34! Added initial hour_of_day, hour_of_year, day_of_year and month_of_year to
35! init_date_and_time
36!
37! 3298 2018-10-02 12:21:11Z kanani
38! - Minor formatting (kanani)
39! - Added Routines for DEFAULT mode of chemistry emissions (Russo)
40! - Added routine for reading-in real dates: format has to be in DDMMYYYY and
41!   passed in the namelist parameter date_init (Russo)
42! - Added calculation of several time indices useful in several routines
43!   of the model (Russo)
44!
45! 2718 2018-01-02 08:49:38Z maronga
46! Corrected "Former revisions" section
47!
48! 2701 2017-12-15 15:40:50Z suehring
49! Changes from last commit documented
50!
51! 2698 2017-12-14 18:46:24Z suehring
52! Bugfix in definition of d_seconds_year.
53!
54! 2696 2017-12-14 17:12:51Z kanani
55! Change in file header (GPL part)
56!
57! 2544 2017-10-13 18:09:32Z maronga
58! Initial revision
59!
60!
61
62!
63! Description:
64! ------------
65!> This routine calculates all needed information on date and time used by
66!> other modules
67!> @todo Further testing and revision of routines for updating indices of
68!>       emissions in the default mode
69!> @todo Add routine for recognizing leap years
70!> @todo Add recognition of exact days of week (Monday, Tuesday, etc.)
71!> @todo Reconsider whether to remove day_of_year_init from the namelist: we
72!>       already implemented changes for calculating it from date_init in
73!>       calc_date_and_time
74!> @todo time_utc during spin-up 
75!------------------------------------------------------------------------------!
76 MODULE date_and_time_mod
77
78    USE control_parameters,                                                   &
79        ONLY:  coupling_start_time, days_since_reference_point,               &
80               message_string, simulated_time, time_since_reference_point
81
82    USE kinds
83
84
85    IMPLICIT NONE
86
87    PRIVATE
88
89!-- Variables Declaration
90
91    INTEGER(iwp)        ::  day_of_year      = 0   !< day of the year (DOY)
92    INTEGER(iwp)        ::  day_of_year_init = 0   !< DOY at model start (default: 0)
93
94    ! --- Most of these indices are updated by the routine calc_date_and_time according to the current date and time of the simulation
95    INTEGER(iwp)        ::  hour_of_year = 1                        !< hour of the current year (1:8760(8784))
96    INTEGER(iwp)        ::  hour_of_day=1                           !< hour of the current day (1:24)
97    INTEGER(iwp)        ::  day_of_month=0                          !< day of the current month (1:31)
98    INTEGER(iwp)        ::  month_of_year=0                         !< month of the current year (1:12)
99    INTEGER(iwp)        ::  current_year=0                          !< current year
100    INTEGER(iwp)        ::  hour_call_emis=0                        !< index used to call the emissions just once every hour
101
102    INTEGER(iwp)        ::  ihour           
103    INTEGER(iwp)        ::  index_mm                                !< index months of the default emission mode
104    INTEGER(iwp)        ::  index_dd                                !< index days of the default emission mode
105    INTEGER(iwp)        ::  index_hh                                !< index hours of the emission mode
106    INTEGER(iwp)        ::  hours_since_reference_point             !< hours of current simulation
107
108    REAL(wp)            ::  time_utc                     !< current model time in UTC
109    REAL(wp)            ::  time_utc_emis                !< current emission module time in UTC
110    REAL(wp)            ::  time_utc_init = 43200.0_wp   !< UTC time at model start
111    REAL(wp)            ::  time_update                  !< used to calculate actual second of the simulation
112 
113    REAL(wp), PARAMETER ::  d_hours_day    = 1.0_wp / 24.0_wp       !< inverse of hours per day (1/24)
114    REAL(wp), PARAMETER ::  d_seconds_hour = 1.0_wp / 3600.0_wp     !< inverse of seconds per hour (1/3600)
115    REAL(wp), PARAMETER ::  d_seconds_year = 1.0_wp / 31536000.0_wp !< inverse of the seconds per year (1/(365*86400))
116   
117    CHARACTER(len=8)    ::  date_init = "21062017"                  !< Starting date of simulation: We selected this because it was a monday
118 
119    !> --- Parameters
120    INTEGER, PARAMETER, DIMENSION(12) :: days = (/31,28,31,30,31,30,31,31,30,31,30,31/) ! total number of days for each month (no leap year)
121
122    SAVE
123
124!-- INTERFACES PART
125    !-- Read initial day and time of simulation
126    INTERFACE init_date_and_time
127       MODULE PROCEDURE init_date_and_time
128    END INTERFACE init_date_and_time
129
130    !-- Get hour index in the DEAFULT case of chemistry emissions :
131    INTERFACE time_default_indices
132       MODULE PROCEDURE time_mdh_indices
133       MODULE PROCEDURE time_hour_indices
134    END INTERFACE time_default_indices
135
136    !-- Get hour index in the PRE-PROCESSED case of chemistry emissions :
137    INTERFACE time_preprocessed_indices
138       MODULE PROCEDURE time_preprocessed_indices
139    END INTERFACE time_preprocessed_indices
140
141
142    !-- Calculate current date and time
143    INTERFACE calc_date_and_time
144       MODULE PROCEDURE calc_date_and_time
145    END INTERFACE
146
147
148    !-- Public Interfaces
149    PUBLIC calc_date_and_time, time_default_indices, init_date_and_time, time_preprocessed_indices
150
151    !-- Public Variables
152    PUBLIC date_init, d_hours_day, d_seconds_hour, d_seconds_year,               &
153           day_of_year, day_of_year_init, time_utc, time_utc_init, day_of_month, &
154           month_of_year, index_mm, index_dd, index_hh, hour_of_day, hour_of_year, &
155           hour_call_emis
156
157 CONTAINS
158
159
160 !------------------------------------------------------------------------------!
161 !> Reads starting date from namelist
162 !------------------------------------------------------------------------------!
163 
164    SUBROUTINE init_date_and_time
165
166       IMPLICIT NONE
167
168       !--    Variables Definition
169       INTEGER ::  i_mon       !< Index for going through the different months
170
171       IF  (day_of_year_init == 0) THEN
172          ! Day of the month at starting time
173          READ(UNIT=date_init(1:2),fmt=*)day_of_month
174
175          ! Month of the year at starting time
176          READ(UNIT=date_init(3:4),fmt=*)month_of_year
177
178          ! Year at starting time
179          READ(UNIT=date_init(5:8),fmt=*)current_year
180       
181       ENDIF
182
183
184       !-- Calculate initial hour of the day: the first hour of the day is from 00:00:00 to 00:59:59.
185
186       hour_of_day = INT( FLOOR( time_utc_init/3600.0_wp ) ) + 1
187
188       !-- Calculate initial day day_of_year_init in case date_init is given or day_of_year_init is given
189       IF ( day_of_year_init == 0 ) THEN
190
191          !> Condition for printing an error when date_init is not provided when day_of_year_init is not given in the namelist or when the format of the date is not the one required by PALM.
192          IF ( day_of_month .GT. 0 .AND. day_of_month .LE. 31 .AND. month_of_year .GT. 0 .AND. month_of_year .LE. 12) THEN
193       
194             IF ( month_of_year == 1 ) THEN  !!month of year is read in input
195
196                day_of_year_init = day_of_month
197
198             ELSE
199
200                day_of_year_init= SUM(days( 1:(month_of_year-1) )) + day_of_month  !day_of_month is read in input in this case
201
202             ENDIF
203!kanani: Revise, we cannot force users to provide date_init, maybe set a default value?
204!           ELSE
205!
206!              message_string = 'date_init not provided in the namelist or'             //          &
207!                               ' given in the wrong format: MUST BE DDMMYYYY'                       
208!              CALL message( 'calc_date_and_time', 'DT0100', 2, 2, 0, 6, 0 )
209     
210          ENDIF
211
212       ENDIF
213
214       
215       !-- Initial day of the year
216       day_of_year = day_of_year_init
217
218       !-- Initial hour of the year
219       hour_of_year = ( (day_of_year-1) * 24 ) + hour_of_day
220
221       !--Initial day of the month and month of the year
222       !> --------------------------------------------------------------------------------
223       !> The first case is when date_init is not provided: we only know day_of_year_init     
224       IF ( month_of_year == 0 .AND. day_of_month == 0) THEN
225
226         
227          IF ( day_of_year .LE. 31 ) THEN
228
229             month_of_year=1
230             day_of_month=day_of_year
231
232          ELSE
233
234             DO i_mon=2,12   !january is considered in the first case
235                IF ( day_of_year .LE. SUM(days(1:i_mon)) .AND. day_of_year .GT. SUM(days(1:(i_mon-1))) ) THEN
236           
237                   month_of_year=i_mon
238
239                   day_of_month=INT(MOD(day_of_year, SUM(days(1:(i_mon-1))))) 
240
241                   GOTO 38
242
243                ENDIF
244
245             38 ENDDO
246          ENDIF
247       !> --------------------------------------------------------------------------------
248       !> in the second condition both day of month and month_of_year are either given in input (passed to date_init) or we are in some day successive to the initial one, so that day_of_month has already be computed in previous step
249       !>TBD: something to calculate the current year is missing
250       ELSEIF ( day_of_month .GT. 0 .AND. day_of_month .LE. 31 .AND. month_of_year .GT. 0 .AND. month_of_year .LE. 12) THEN
251 
252          !> calculate month_of_year. TBD: test the condition when day_of_year==31
253 
254          IF (day_of_year==1) THEN  !> this allows to turn from december to January when passing from a year to another
255 
256             month_of_year = 1
257       
258          ELSE IF (day_of_year .GT. 1 .AND. day_of_year .GT. SUM(days(1:month_of_year))) THEN
259
260             month_of_year = month_of_year + 1
261
262          ENDIF
263
264          !> calculate day_of_month
265          IF ( month_of_year == 1 ) THEN
266           
267            day_of_month=day_of_year
268
269          ELSE
270
271            day_of_month=INT(MOD(day_of_year, SUM(days(1:(month_of_year-1)))))
272
273          ENDIF
274
275
276       ELSE
277
278          !> Condition when date_init is provided but it is given in the wrong format
279          message_string = 'date_init not provided in the namelist or'            //          &
280                              ' given in the wrong format: MUST BE DDMMYYYY'                 
281          CALL message( 'init_date_and_time', 'DT0102', 2, 2, 0, 6, 0 ) 
282
283       ENDIF
284
285
286    END SUBROUTINE init_date_and_time
287
288!------------------------------------------------------------------------------!
289! Description:
290! ------------
291!> Calculate current date and time of the simulation
292!------------------------------------------------------------------------------!
293 
294    SUBROUTINE calc_date_and_time
295
296       IMPLICIT NONE
297
298!--    Variables Definition
299       INTEGER                          :: i_mon       !< Index for going through the different months
300
301       !> Update simulation time in seconds
302       time_update = simulated_time-coupling_start_time
303
304!--    Calculate current day of the simulated time
305       days_since_reference_point=INT(FLOOR( (time_utc_init + time_update) &
306                               / 86400.0_wp ) )
307
308!--    Calculate actual UTC time                       
309       time_utc = MOD((time_utc_init + time_since_reference_point), 86400.0_wp)
310       
311!sB    PRILIMINARY workaround for time_utc changes due to changes in time_since_reference_point in
312!sB    radiation_model_mod during runtime:
313       time_utc_emis = MOD((time_utc_init + time_update), 86400.0_wp)     
314
315!--    Calculate initial day of the year: it is calculated only once. In fact, day_of_year_init is initialized to 0 and then a positive value is passed. This condition is also called only when day_of_year_init is not given in the namelist.
316
317       IF ( day_of_year_init == 0 ) THEN
318
319          !> Condition for printing an error when date_init is not provided when day_of_year_init is not given in the namelist or when the format of the date is not the one required by PALM.
320          IF ( day_of_month .GT. 0 .AND. day_of_month .LE. 31 .AND. month_of_year .GT. 0 .AND. month_of_year .LE. 12) THEN
321       
322             IF ( month_of_year == 1 ) THEN  !!month of year is read in input
323
324                day_of_year_init = day_of_month
325
326             ELSE
327
328                day_of_year_init= SUM(days( 1:(month_of_year-1) )) + day_of_month  !day_of_month is read in input in this case
329
330             ENDIF
331!kanani: Revise, we cannot force users to provide date_init, maybe set a default value?
332!           ELSE
333!
334!              message_string = 'date_init not provided in the namelist or'             //          &
335!                               ' given in the wrong format: MUST BE DDMMYYYY'                       
336!              CALL message( 'calc_date_and_time', 'DT0100', 2, 2, 0, 6, 0 )
337     
338          ENDIF
339
340       ENDIF
341
342      !-- Calculate actual hour of the day: the first hour of the day is from 00:00:00 to 00:59:59.
343
344      hour_of_day = INT( FLOOR( time_utc_emis/3600.0_wp ) ) + 1
345
346!--    Calculate current day of the year !TBD: considetr leap years
347       IF ( (day_of_year_init + days_since_reference_point)  .GT. 365 ) THEN
348
349          day_of_year=INT(MOD((day_of_year_init + days_since_reference_point), 365.0_wp))
350
351       ELSE
352         
353          day_of_year = day_of_year_init + days_since_reference_point
354
355       ENDIF
356
357!
358!--    Calculate current hour of the year
359       hour_of_year = ( (day_of_year-1) * 24 ) + hour_of_day  !> actual hour of the year
360       
361
362!
363!--    UPDATE actual day of the month and month of the year
364       !> --------------------------------------------------------------------------------
365       !> The first case is when date_init is not provided: we only know day_of_year_init     
366       IF ( month_of_year == 0 .AND. day_of_month == 0) THEN
367
368          !> The first case is when date_init is not provided: we only know day_of_year_init
369          !DO i_mon=1,12
370             !IF (day_of_year .LE. SUM(days(1:i_mon))) THEN
371          IF ( day_of_year .LE. 31 ) THEN
372
373             month_of_year=1
374             day_of_month=day_of_year
375
376          ELSE
377
378             DO i_mon=2,12   !january is considered in the first case
379                IF ( day_of_year .LE. SUM(days(1:i_mon)) .AND. day_of_year .GT. SUM(days(1:(i_mon-1))) ) THEN
380           
381                   month_of_year=i_mon
382
383                   day_of_month=INT(MOD(day_of_year, SUM(days(1:(i_mon-1))))) 
384
385                   GOTO 38
386
387                ENDIF
388
389             38 ENDDO
390          ENDIF
391       !> --------------------------------------------------------------------------------
392       !> in the second condition both day of month and month_of_year are either given in input (passed to date_init) or we are in some day successive to the initial one, so that day_of_month has already be computed in previous step
393       !>TBD: something to calculate the current year is missing
394       ELSEIF ( day_of_month .GT. 0 .AND. day_of_month .LE. 31 .AND. month_of_year .GT. 0 .AND. month_of_year .LE. 12) THEN
395 
396          !> calculate month_of_year. TBD: test the condition when day_of_year==31
397 
398          IF (day_of_year==1) THEN  !> this allows to turn from december to January when passing from a year to another
399 
400             month_of_year = 1
401       
402          ELSE IF (day_of_year .GT. 1 .AND. day_of_year .GT. SUM(days(1:month_of_year))) THEN
403
404             month_of_year = month_of_year + 1
405
406          ENDIF
407
408          !> calculate day_of_month
409          IF ( month_of_year == 1 ) THEN
410           
411            day_of_month=day_of_year
412
413          ELSE
414
415            day_of_month=INT(MOD(day_of_year, SUM(days(1:(month_of_year-1)))))
416
417          ENDIF
418
419
420
421
422      ELSE
423
424          !> Condition when date_init is provided but it is given in the wrong format
425          message_string = 'date_init not provided in the namelist or'            //          &
426                              ' given in the wrong format: MUST BE DDMMYYYY'                 
427          CALL message( 'calc_date_and_time', 'DT0101', 2, 2, 0, 6, 0 ) 
428
429      ENDIF       
430
431    END SUBROUTINE calc_date_and_time
432
433
434!------------------------------------------------------------------------------!
435! Description:
436! ------------
437!> This routine determines the time factor index in the PRE-PROCESSED emissions mode.
438!------------------------------------------------------------------------------!
439
440 SUBROUTINE time_preprocessed_indices(index_hh)
441
442    USE indices
443
444    IMPLICIT NONE
445
446!
447!-- In/output
448    INTEGER, INTENT(INOUT) ::  index_hh    !> Index Hour
449!
450!-- Additional Variables for calculateing indices
451!-- Constants
452    INTEGER, PARAMETER ::  nhour = 24
453
454    IF (days_since_reference_point == 0) THEN
455
456       index_hh=hour_of_day
457
458    ELSE
459
460       index_hh=(days_since_reference_point*nhour)+(hour_of_day)
461
462    ENDIF
463
464
465 END SUBROUTINE time_preprocessed_indices
466
467
468!------------------------------------------------------------------------------!
469! Description:
470! ------------
471!> This routine determines the time factor index in the mdh case of the DEFAULT chemistry emissions mode.
472!------------------------------------------------------------------------------!
473
474 SUBROUTINE time_mdh_indices(daytype_mdh,mo, dd, hh, index_mm, index_dd, index_hh)
475
476    USE indices
477
478    IMPLICIT NONE
479
480    !> IN/OUTPUT
481    INTEGER, INTENT(INOUT) :: mo          !> Month of year
482    INTEGER, INTENT(INOUT) :: dd          !> Day of month
483    INTEGER, INTENT(INOUT) :: hh          !> Hour of day
484    INTEGER, INTENT(INOUT) :: index_mm    !> Index Month
485    INTEGER, INTENT(INOUT) :: index_dd    !> Index Day
486    INTEGER, INTENT(INOUT) :: index_hh    !> Index Hour
487
488    CHARACTER(len=80), INTENT(INOUT) :: daytype_mdh !> type of the day in mdh mode: one of 1-WORKDAY
489                                                    !                                      2-WEEKEND
490                                                    !                                      3-HOLIDAY
491
492    REAL(wp)                         :: frac_day=0 
493
494    !> ------------------------------------------------------------------------
495
496    INTEGER                          :: weekday
497
498    !> CONSTANTS
499    INTEGER, PARAMETER               :: nmonth = 12
500    INTEGER, PARAMETER               :: nday = 7
501    INTEGER, PARAMETER               :: nhour = 24
502
503    frac_day= (dd-1)/nday    !> indicates the week of the month, supposing the month starts on monday
504
505   ! 1:7      1:31  7                   (0:30)/7
506    weekday = dd-( nday * (INT( CEILING( frac_day ) ) ) ) ! for now we let the year start on Monday.
507
508    !TBD: set weekday correct based on date
509    index_mm = mo
510    index_dd = nmonth + weekday  !> Index of the days in the mdh mode (13:20)
511
512    SELECT CASE(TRIM(daytype_mdh))
513
514       CASE ("workday")
515       
516          index_hh = nmonth+ nday + hh 
517
518       CASE ("weekend")
519       
520          index_hh = nmonth+ nday + nhour + hh 
521
522       CASE ("holiday")
523       
524          index_hh = nmonth+ nday + 2*nhour + hh 
525
526    END SELECT
527
528
529 END SUBROUTINE time_mdh_indices
530
531!------------------------------------------------------------------------------!
532! Description:
533! ------------
534!> This routine determines the time factor index in the HOURLY case of the DEFAULT emissions mode.
535!------------------------------------------------------------------------------!
536
537 SUBROUTINE time_hour_indices(mo,dd,hh,index_hh)
538
539    USE indices
540
541    IMPLICIT NONE
542
543    !> IN/OUTPUT
544    INTEGER, INTENT(INOUT)              :: mo          !> Month
545    INTEGER, INTENT(INOUT)              :: hh          !> Hour
546    INTEGER, INTENT(INOUT)              :: dd          !> Day
547    INTEGER, INTENT(INOUT)              :: index_hh    !> Index Hour
548 
549    !> Additional Variables for calculateing indices
550    INTEGER                             :: index_mm    !> Index Month
551    INTEGER                             :: index_dd    !> Index Day
552    INTEGER                             :: i_mon       !> Index for going through the different months
553    INTEGER                             :: sum_dd      !> Sum days
554
555    !> CONSTANTS
556    INTEGER, PARAMETER                  :: nmonth=12
557    INTEGER, PARAMETER                  :: nday = 7
558    INTEGER, PARAMETER                  :: nhour = 24
559    INTEGER, PARAMETER, DIMENSION(12)   :: days = (/31,28,31,30,31,30,31,31,30,31,30,31/) ! no leap year
560   
561
562    index_mm = mo-1
563    index_dd = dd-1
564    sum_dd=0
565
566    IF (mo == 1) THEN
567
568       index_hh=(index_dd*nhour)+hh
569
570    ELSE
571
572       DO i_mon=1,index_mm
573
574         sum_dd=sum_dd+days(i_mon)
575
576       ENDDO
577     
578       index_hh=(sum_dd*nhour)+(index_dd*nhour)+(hh)
579
580    ENDIF
581 
582
583 END SUBROUTINE time_hour_indices
584
585
586END MODULE date_and_time_mod
Note: See TracBrowser for help on using the repository browser.