SCALE-RM
scale_calendar.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
14 !-------------------------------------------------------------------------------
16  !-----------------------------------------------------------------------------
17  !
18  !++ used modules
19  !
20  use scale_precision
21  use scale_stdio
22  !-----------------------------------------------------------------------------
23  implicit none
24  private
25  !-----------------------------------------------------------------------------
26  !
27  !++ Public procedure
28  !
29  public :: calendar_setup
30  public :: calendar_getdayofyear
31  public :: calendar_date2daysec
32  public :: calendar_daysec2date
33  public :: calendar_ymd2absday
34  public :: calendar_hms2abssec
35  public :: calendar_adjust_daysec
36  public :: calendar_combine_daysec
37  public :: calendar_unit2sec
38  public :: calendar_cfunits2sec
39  public :: calendar_date2char
40 
41  !-----------------------------------------------------------------------------
42  !
43  !++ Public parameters & variables
44  !
45  integer, public, parameter :: i_year = 1
46  integer, public, parameter :: i_month = 2
47  integer, public, parameter :: i_day = 3
48  integer, public, parameter :: i_hour = 4
49  integer, public, parameter :: i_min = 5
50  integer, public, parameter :: i_sec = 6
51 
52  !-----------------------------------------------------------------------------
53  !
54  !++ Private procedure
55  !
56  private :: calendar_absday2ymd
57  private :: calendar_abssec2hms
58  private :: calendar_ymdhms2nd
59  private :: calendar_ymdhms2mjd
60  private :: checkleap
61 
62  !-----------------------------------------------------------------------------
63  !
64  !++ Private parameters & variables
65  !
66  real(DP), private :: calendar_doi = 365.0_dp
67  real(DP), private :: calendar_hour = 24.0_dp
68  real(DP), private :: calendar_min = 60.0_dp
69  real(DP), private :: calendar_sec = 60.0_dp
70 
71  integer, private, parameter :: i_nonleapyear = 1
72  integer, private, parameter :: i_leapyear = 2
73  integer, private :: dayofmonth(12,2)
74  data dayofmonth / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, & ! non-leap year
75  31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 / ! leap year
76 
77  !-----------------------------------------------------------------------------
78 contains
79  !-----------------------------------------------------------------------------
81  subroutine calendar_setup
82  implicit none
83  !---------------------------------------------------------------------------
84 
85  if( io_l ) write(io_fid_log,*)
86  if( io_l ) write(io_fid_log,*) '++++++ Module[CALENDAR] / Categ[COMMON] / Origin[SCALElib]'
87  if( io_l ) write(io_fid_log,*) '*** No namelists.'
88 
89  return
90  end subroutine calendar_setup
91 
92  !-----------------------------------------------------------------------------
94  subroutine calendar_getdayofyear( &
95  DayOfYear, &
96  iyear )
97  implicit none
98 
99  real(DP), intent(out) :: dayofyear ! # of day of year
100  integer, intent(in) :: iyear ! current year
101  !---------------------------------------------------------------------------
102 
103  dayofyear = calendar_doi
104  if( checkleap(iyear) ) dayofyear = calendar_doi + 1.0_dp
105 
106  return
107  end subroutine calendar_getdayofyear
108 
109  !-----------------------------------------------------------------------------
111  subroutine calendar_date2daysec( &
112  absday, &
113  abssec, &
114  ymdhms, &
115  subsec, &
116  offset_year )
117  implicit none
118 
119  integer, intent(out) :: absday
120  real(DP), intent(out) :: abssec
121  integer, intent(in) :: ymdhms(6)
122  real(DP), intent(in) :: subsec
123  integer, intent(in) :: offset_year
124  !---------------------------------------------------------------------------
125 
126  call calendar_ymd2absday( absday, & ! [OUT]
127  ymdhms(i_year), & ! [IN]
128  ymdhms(i_month), & ! [IN]
129  ymdhms(i_day), & ! [IN]
130  offset_year ) ! [IN]
131 
132  call calendar_hms2abssec( abssec, & ! [OUT]
133  ymdhms(i_hour), & ! [IN]
134  ymdhms(i_min), & ! [IN]
135  ymdhms(i_sec), & ! [IN]
136  subsec ) ! [IN]
137 
138  return
139  end subroutine calendar_date2daysec
140 
141  !-----------------------------------------------------------------------------
143  subroutine calendar_daysec2date( &
144  ymdhms, &
145  subsec, &
146  absday, &
147  abssec, &
148  offset_year )
149  implicit none
150 
151  integer, intent(out) :: ymdhms(6)
152  real(DP), intent(out) :: subsec
153  integer, intent(in) :: absday
154  real(DP), intent(in) :: abssec
155  integer, intent(in) :: offset_year
156  !---------------------------------------------------------------------------
157 
158  call calendar_absday2ymd( ymdhms(i_year), & ! [OUT]
159  ymdhms(i_month), & ! [OUT]
160  ymdhms(i_day), & ! [OUT]
161  absday, & ! [IN]
162  offset_year ) ! [IN]
163 
164  call calendar_abssec2hms( ymdhms(i_hour), & ! [OUT]
165  ymdhms(i_min), & ! [OUT]
166  ymdhms(i_sec), & ! [OUT]
167  subsec, & ! [OUT]
168  abssec ) ! [IN]
169 
170  return
171  end subroutine calendar_daysec2date
172 
173  !-----------------------------------------------------------------------------
175  subroutine calendar_ymd2absday( &
176  absday, &
177  gyear, &
178  gmonth, &
179  gday, &
180  oyear )
181  implicit none
182 
183  integer, intent(out) :: absday
184  integer, intent(in) :: gyear
185  integer, intent(in) :: gmonth
186  integer, intent(in) :: gday
187  integer, intent(in) :: oyear
188 
189  integer :: gyear_mod, gmonth_mod
190  integer :: yearday, monthday
191  integer :: m, ileap
192  !---------------------------------------------------------------------------
193 
194  gmonth_mod = mod( gmonth-1, 12 ) + 1
195  gyear_mod = gyear + ( gmonth-gmonth_mod ) / 12
196 
197  yearday = int( calendar_doi * ( gyear_mod - oyear ) ) &
198  + int( real(gyear_mod-1,kind=DP) / 4.0_dp ) &
199  - int( real(gyear_mod-1,kind=DP) / 100.0_dp ) &
200  + int( real(gyear_mod-1,kind=DP) / 400.0_dp ) &
201  - int( real(oyear -1,kind=DP) / 4.0_dp ) &
202  + int( real(oyear -1,kind=DP) / 100.0_dp ) &
203  - int( real(oyear -1,kind=DP) / 400.0_dp )
204 
205  ileap = i_nonleapyear
206  if( checkleap(gyear_mod) ) ileap = i_leapyear
207 
208  monthday = 0
209  do m = 1, gmonth_mod-1
210  monthday = monthday + dayofmonth(m,ileap)
211  enddo
212 
213  absday = yearday + monthday + gday - 1
214 
215  return
216  end subroutine calendar_ymd2absday
217 
218  !-----------------------------------------------------------------------------
220  subroutine calendar_absday2ymd( &
221  gyear, &
222  gmonth, &
223  gday, &
224  absday, &
225  oyear )
226  implicit none
227 
228  integer, intent(out) :: gyear
229  integer, intent(out) :: gmonth
230  integer, intent(out) :: gday
231  integer, intent(in) :: absday
232  integer, intent(in) :: oyear
233 
234  integer :: checkday
235  integer :: i, ileap
236  !---------------------------------------------------------------------------
237 
238  gyear = int( real(absday,kind=DP) / 366.0_dp ) + oyear ! first guess
239  do i = 1, 1000
240  call calendar_ymd2absday( checkday, gyear+1, 1, 1, oyear )
241  if( absday < checkday ) exit
242  gyear = gyear + 1
243  enddo
244 
245  ileap = i_nonleapyear
246  if( checkleap(gyear) ) ileap = i_leapyear
247 
248  gmonth = 1
249  do i = 1, 1000
250  call calendar_ymd2absday( checkday, gyear, gmonth, dayofmonth(gmonth,ileap), oyear )
251  if( absday <= checkday ) exit
252  gmonth = gmonth + 1
253  enddo
254 
255  call calendar_ymd2absday( checkday, gyear, gmonth, 1, oyear )
256  gday = absday - checkday + 1
257 
258  return
259  end subroutine calendar_absday2ymd
260 
261  !-----------------------------------------------------------------------------
263  subroutine calendar_hms2abssec( &
264  abssec, &
265  hour, &
266  minute, &
267  second, &
268  subsec )
269  implicit none
270 
271  real(DP), intent(out) :: abssec
272  integer, intent(in) :: hour
273  integer, intent(in) :: minute
274  integer, intent(in) :: second
275  real(DP), intent(in) :: subsec
276  !---------------------------------------------------------------------------
277 
278  abssec = real(hour, kind=DP) * calendar_min * calendar_sec &
279  + real(minute,kind=DP) * calendar_sec &
280  + real(second,kind=DP) &
281  + subsec
282 
283  return
284  end subroutine calendar_hms2abssec
285 
286  !-----------------------------------------------------------------------------
288  subroutine calendar_abssec2hms( &
289  hour, &
290  minute, &
291  second, &
292  subsec, &
293  abssec )
294  implicit none
295 
296  integer, intent(out) :: hour
297  integer, intent(out) :: minute
298  integer, intent(out) :: second
299  real(DP), intent(out) :: subsec
300  real(DP), intent(in) :: abssec
301 
302  real(DP) :: nsec, nmin, nhour, temp
303  !---------------------------------------------------------------------------
304 
305  nsec = real(int(abssec),kind=dp)
306  subsec = abssec - nsec
307 
308  temp = mod( nsec, calendar_sec )
309  second = int( temp )
310  nmin = ( nsec-temp ) / calendar_sec
311 
312  temp = mod( nmin, calendar_min )
313  minute = int( temp )
314  nhour = ( nmin-temp ) / calendar_min
315 
316  temp = mod( nhour, calendar_hour )
317  hour = int( temp )
318 
319  return
320  end subroutine calendar_abssec2hms
321 
322  !-----------------------------------------------------------------------------
324  subroutine calendar_adjust_daysec( &
325  absday, &
326  abssec )
327  implicit none
328 
329  integer, intent(inout) :: absday
330  real(DP), intent(inout) :: abssec
331 
332  integer :: addday
333  !---------------------------------------------------------------------------
334 
335  addday = int( abssec / ( calendar_hour * calendar_min * calendar_sec ) )
336 
337  absday = absday + addday
338 
339  abssec = abssec - real(addday,kind=DP) * calendar_hour * calendar_min * calendar_sec
340 
341  return
342  end subroutine calendar_adjust_daysec
343 
344  !-----------------------------------------------------------------------------
346  function calendar_combine_daysec( absday, abssec ) result(daysec)
347  implicit none
348 
349  integer, intent(in) :: absday
350  real(DP), intent(in) :: abssec
351  real(DP) :: daysec
352  !---------------------------------------------------------------------------
353 
354  daysec = real(absday,kind=DP) * calendar_sec * calendar_min * calendar_hour &
355  + abssec
356 
357  return
358  end function calendar_combine_daysec
359 
360  !-----------------------------------------------------------------------------
362  subroutine calendar_unit2sec( &
363  second, &
364  value, &
365  unit )
366  use scale_process, only: &
368  implicit none
369 
370  real(DP), intent(out) :: second
371  real(DP), intent(in) :: value
372  character(len=*), intent(in) :: unit
373  !---------------------------------------------------------------------------
374 
375  select case(unit)
376  case('MSEC')
377  second = value * 1.e-3_dp
378  case('SEC', 'seconds')
379  second = value
380  case('MIN')
381  second = value * calendar_sec
382  case('HOUR')
383  second = value * calendar_sec * calendar_min
384  case('DAY')
385  second = value * calendar_sec * calendar_min * calendar_hour
386  case default
387  write(*,*) 'xxx Unsupported UNIT: ', trim(unit), ', ', value
388  call prc_mpistop
389  endselect
390 
391  return
392  end subroutine calendar_unit2sec
393 
394  !-----------------------------------------------------------------------------
396  function calendar_cfunits2sec( cftime, cfunits, offset_year, startdaysec ) result( sec )
397  use scale_process, only: &
399  implicit none
400 
401  real(DP), intent(in) :: cftime
402  character(len=*), intent(in) :: cfunits
403  integer, intent(in) :: offset_year
404  real(DP), intent(in), optional :: startdaysec
405  real(DP) :: sec
406 
407  character(len=H_MID) :: tunit
408  character(len=H_MID) :: buf
409 
410  integer :: date(6)
411  integer :: day
412  real(DP) :: sec0
413 
414  integer :: l
415 
416  intrinsic index
417  !---------------------------------------------------------------------------
418 
419  l = index( cfunits, " since " )
420  if ( l > 1 ) then ! untis is under the CF convension
421  tunit = cfunits(1:l-1)
422  buf = cfunits(l+7:)
423 
424  l = index(buf,"-")
425  if ( l /= 5 ) then
426  write(*,*) 'xxx units for time is invalid (year)'
427  write(*,*) 'xxx ', trim(cfunits)
428  write(*,*) 'xxx ', trim(buf)
429  call prc_mpistop
430  end if
431  read(buf(1:4),*) date(1) ! year
432  buf = buf(6:)
433 
434  l = index(buf,"-")
435  if ( l /= 3 ) then
436  write(*,*) 'xxx units for time is invalid (month)'
437  write(*,*) 'xxx ', trim(cfunits)
438  write(*,*) 'xxx ', trim(buf)
439  call prc_mpistop
440  end if
441  read(buf(1:2),*) date(2) ! month
442  buf = buf(4:)
443 
444  l = index(buf," ")
445  if ( l /= 3 ) then
446  write(*,*) 'xxx units for time is invalid (day)'
447  write(*,*) 'xxx ', trim(cfunits)
448  write(*,*) 'xxx ', trim(buf)
449  call prc_mpistop
450  end if
451  read(buf(1:2),*) date(3) ! day
452  buf = buf(4:)
453 
454  l = index(buf,":")
455  if ( l /= 3 ) then
456  write(*,*) 'xxx units for time is invalid (hour)'
457  write(*,*) 'xxx ', trim(cfunits)
458  write(*,*) 'xxx ', trim(buf)
459  call prc_mpistop
460  end if
461  read(buf(1:2),*) date(4) ! hour
462  buf = buf(4:)
463 
464  l = index(buf,":")
465  if ( l /= 3 ) then
466  write(*,*) 'xxx units for time is invalid (min)'
467  write(*,*) 'xxx ', trim(cfunits)
468  write(*,*) 'xxx ', trim(buf)
469  call prc_mpistop
470  end if
471  read(buf(1:2),*) date(5) ! min
472  buf = buf(4:)
473 
474  if ( len_trim(buf) /= 2 ) then
475  write(*,*) 'xxx units for time is invalid (sec)'
476  write(*,*) 'xxx ', trim(cfunits)
477  write(*,*) 'xxx ', trim(buf)
478  write(*,*) 'xxx ', len_trim(buf)
479  call prc_mpistop
480  end if
481  read(buf(1:2),*) date(6) ! sec
482 
483  call calendar_date2daysec( day, & ! (out)
484  sec0, & ! (out)
485  date(:), & ! (in)
486  0.0_dp, & ! (in)
487  offset_year ) ! (in)
488 
489  sec0 = calendar_combine_daysec( day, sec0 )
490  else
491  tunit = cfunits
492  if ( present(startdaysec) ) then
493  sec0 = startdaysec
494  else
495  sec0 = 0.0_dp
496  end if
497  end if
498 
499  call calendar_unit2sec( sec, cftime, tunit )
500 
501  sec = sec0 + sec
502 
503  return
504  end function calendar_cfunits2sec
505 
506  !-----------------------------------------------------------------------------
508  subroutine calendar_date2char( &
509  chardate, &
510  ymdhms, &
511  subsec )
512  implicit none
513 
514  character(len=27), intent(out) :: chardate
515  integer, intent(in) :: ymdhms(6)
516  real(DP), intent(in) :: subsec
517  !---------------------------------------------------------------------------
518 
519  write(chardate,'(I4.4,A1,I2.2,A1,I2.2,A1,I2.2,A1,I2.2,A1,I2.2,A2,F6.3)') &
520  ymdhms(1),'/',ymdhms(2),'/',ymdhms(3),' ', &
521  ymdhms(4),':',ymdhms(5),':',ymdhms(6),' +', &
522  subsec
523 
524  return
525  end subroutine calendar_date2char
526 
527  !-----------------------------------------------------------------------------
530  function checkleap( iyear )
531  implicit none
532 
533  integer, intent(in) :: iyear
534  logical :: checkleap
535 
536  integer :: check4, check100, check400
537  !---------------------------------------------------------------------------
538 
539  check4 = mod(iyear,4 )
540  check100 = mod(iyear,100)
541  check400 = mod(iyear,400)
542 
543  checkleap = .false.
544  if( check4 == 0 ) checkleap = .true.
545  if( check100 == 0 ) checkleap = .false.
546  if( check400 == 0 ) checkleap = .true.
547 
548  end function checkleap
549 
550  !-----------------------------------------------------------------------------
552  subroutine calendar_ymdhms2nd( &
553  nd, &
554  ymdhms, &
555  oyear )
556  implicit none
557 
558  real(DP), intent(out) :: nd
559  integer, intent(in) :: ymdhms(6)
560  integer, intent(in) :: oyear
561 
562  integer :: absday, absday_jan1
563  !---------------------------------------------------------------------------
564 
565  call calendar_ymd2absday( absday, & ! [OUT]
566  ymdhms(i_year), & ! [IN]
567  ymdhms(i_month), & ! [IN]
568  ymdhms(i_day), & ! [IN]
569  oyear ) ! [IN]
570 
571  call calendar_ymd2absday( absday_jan1, & ! [OUT]
572  ymdhms(i_year), & ! [IN]
573  1, & ! [IN]
574  1, & ! [IN]
575  oyear ) ! [IN]
576 
577  nd = absday - absday_jan1 + 1.0_dp
578 
579  return
580  end subroutine calendar_ymdhms2nd
581 
582  !-----------------------------------------------------------------------------
584  subroutine calendar_ymdhms2mjd( &
585  mjd, &
586  ymdhms, &
587  oyear )
588  implicit none
589 
590  real(DP), intent(out) :: mjd
591  integer, intent(in) :: ymdhms(6)
592  integer, intent(in) :: oyear
593 
594  integer :: y, m, mjd_day
595  !---------------------------------------------------------------------------
596 
597  if ( ymdhms(i_month) == 1 &
598  .OR. ymdhms(i_month) == 2 ) then
599  y = ymdhms(i_year) - 1
600  m = ymdhms(i_month) + 2
601  else
602  y = ymdhms(i_year)
603  m = ymdhms(i_month)
604  endif
605 
606  mjd_day = int( 365.25_dp * y ) & ! year
607  + int( y/400.0_dp ) - int( y/100.0_dp ) & ! leap year
608  + int( 30.59_dp * m-2 ) & ! month
609  + ymdhms(i_day) & ! day
610  + 678912 ! constant
611 
612  mjd = real(mjd_day,kind=DP) & ! day
613  + ymdhms(i_hour) / 24.0_dp & ! hour
614  + ymdhms(i_min) / 1440.0_dp & ! min
615  + ymdhms(i_sec) / 86400.0_dp ! sec
616 
617  return
618  end subroutine calendar_ymdhms2mjd
619 
620 end module scale_calendar
integer, parameter, public i_month
[index] month
subroutine, public calendar_unit2sec(second, value, unit)
Convert several units to second.
integer, parameter, public i_year
[index] year
subroutine, public prc_mpistop
Abort MPI.
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
subroutine, public calendar_ymd2absday(absday, gyear, gmonth, gday, oyear)
Convert from gregorian date to absolute day, DAY 0 is AD1/1/1.
subroutine, public calendar_date2char(chardate, ymdhms, subsec)
Convert from gregorian date to absolute day/second.
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:61
module STDIO
Definition: scale_stdio.F90:12
subroutine, public calendar_adjust_daysec(absday, abssec)
Adjust day and second.
subroutine, public calendar_setup
Setup.
real(dp) function, public calendar_cfunits2sec(cftime, cfunits, offset_year, startdaysec)
Convert time in units of the CF convention to second.
integer, parameter, public i_min
[index] minute
module PROCESS
integer, parameter, public i_sec
[index] second
integer, parameter, public i_hour
[index] hour
integer, parameter, public i_day
[index] day
subroutine, public calendar_daysec2date(ymdhms, subsec, absday, abssec, offset_year)
Convert from gregorian date to absolute day/second.
module PRECISION
module CALENDAR
subroutine, public calendar_getdayofyear(DayOfYear, iyear)
Get day of year.
subroutine, public calendar_hms2abssec(abssec, hour, minute, second, subsec)
Hour, minute, second, subsecond -> absolute second.
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
integer, parameter, public dp
subroutine, public calendar_date2daysec(absday, abssec, ymdhms, subsec, offset_year)
Convert from gregorian date to absolute day/second.