13 & year, mon, day, hour, min, sec, &
14 & zone, zone_hour, zone_min, caltype, caltype_str, day_seconds, &
15 & sclyear, sclmon, sclday, sclsec, err)
60 use dc_message,
only: messagenotify
61 use dc_trace,
only: beginsub, endsub
62 use dc_present,
only: present_select
63 use dc_string,
only: lchar, cprintf
66 &
operator(==),
operator(>),
operator(<),
operator(>=),
operator(<=), &
67 &
operator(+),
operator(-),
operator(*),
operator(/),
mod,
modulo, &
72 integer,
intent(in),
optional:: year
73 integer,
intent(in),
optional:: mon
74 integer,
intent(in),
optional:: day
75 integer,
intent(in),
optional:: hour
76 integer,
intent(in),
optional:: min
77 real(DP),
intent(in),
optional:: sec
78 character(*),
intent(in),
optional :: zone
79 integer,
intent(in),
optional :: zone_hour
80 integer,
intent(in),
optional :: zone_min
81 integer,
intent(in),
optional:: caltype
82 character(*),
intent(in),
optional:: caltype_str
83 real(DP),
intent(in),
optional:: day_seconds
88 logical,
intent(out),
optional:: err
91 integer :: gcday, gcmon, gcyear
92 real(DP):: essec, esds
96 integer,
parameter:: year_default = 0, mon_default = 1
97 integer,
parameter:: day_default = 1
98 integer,
parameter:: sec_default = 0
99 logical :: current_time_used
101 character(TOKEN):: zone_str
102 integer :: stat, cause_i
103 character(STRING) :: cause_c
104 character(*),
parameter :: subname =
'DCDateTimeCreate1'
106 current_time_used = .not.
present(year) &
107 & .and. .not.
present(mon) &
108 & .and. .not.
present(day) &
109 & .and. .not.
present(hour) &
110 & .and. .not.
present(
min) &
111 & .and. .not.
present(sec) &
112 & .and. .not.
present(sclyear) &
113 & .and. .not.
present(sclmon) &
114 & .and. .not.
present(sclday) &
115 & .and. .not.
present(sclsec)
116 call beginsub(subname,
'current_time_used=<%y>', l=(/current_time_used/))
121 if (
present(day_seconds) )
then
122 time % day_seconds = day_seconds
134 if (.not. current_time_used)
then
135 if (
present(zone_hour) .or.
present(zone_min) )
then
137 & hour = zone_hour,
min = zone_min )
138 zone_str =
tochar(zonediff)
139 if ( zone_str(1:1) ==
'-' )
then
144 izone(2:6) = zone_str(13:17)
146 if (
present(zone))
then
152 if (
present(err))
then
153 call messagenotify(
'W', subname, &
154 &
'zone=<%c> is invalid.', &
161 if (
present(sclsec) )
then
163 elseif(
present(sec) )
then
168 if (
present(
min))
then
171 if (
present(hour))
then
175 if (
present(sclday) )
then
177 elseif(
present(day) )
then
183 if (
present(sclday) )
then
185 elseif(
present(day) )
then
190 iday = iday +
floor(isec / time % day_seconds)
192 if (
present(sclmon) )
then
194 elseif(
present(mon) )
then
200 if (
present(sclyear) )
then
202 elseif(
present(year) )
then
210 time % sec =
modulo(isec, time % day_seconds)
211 time % caltype = caltype_default
212 if (
present(caltype_str))
then
213 select case( lchar(trim(caltype_str)) )
227 call messagenotify(
'W', subname, &
228 &
'caltype=<%c> is invalid calender type.', &
229 & c1 = trim(caltype_str) )
230 if ( .not.
present(err) )
then
236 if (
present(caltype))
then
238 time % caltype = caltype
242 if (
present(err))
then
243 call messagenotify(
'W', subname, &
244 &
'caltype=<%d> is invalid calender type.', &
257 iday = iday +
int( (month * 306 - 914) / 10 )
259 time % day = iday + iyear * 365 + 90
262 if (time % caltype ==
cal_julian .or. iday < 640116)
then
263 time % day = iday + 91
265 century = (iyear -
modulo(iyear, 100)) / 100 + 1
266 time % day = iday -
int( (century * 3 -
modulo(century * 3, 4)) / 4 ) + 93
272 call storeerror(stat, subname, err, cause_c, cause_i)
273 esday = time % day ; essec = time % sec ; esds = time % day_seconds
274 call endsub(subname,
'time (caltype=%d, day=%d, sec=%f, zone=%c, day_seconds=%f)', &
275 & i=(/time % caltype, esday/), d=(/essec, esds/), &
276 & c1=trim(time % zone))
285 use dc_string,
only: stod
287 integer,
intent(out) :: jyear, jmon, jday
288 real(DP),
intent(out) :: jsec
289 character(*),
intent(out) :: jzone
291 integer :: date_time_values(1:8)
292 character(5) :: zone_raw
295 call date_and_time(zone=zone_raw, values=date_time_values)
297 jzone = zone_raw(1:3) //
":" // zone_raw(4:5)
299 jyear = date_time_values(1)
300 jmon = date_time_values(2)
301 jday = date_time_values(3)
304 & + real(date_time_values(7), dp)
312 & year, mon, day, hour, min, sec, day_seconds, nondim, &
313 & sclyear, sclmon, sclday, sclsec )
328 use dc_message,
only: messagenotify
329 use dc_trace,
only: beginsub, endsub, debug
330 use dc_present,
only: present_select
333 &
operator(==),
operator(>),
operator(<),
operator(>=),
operator(<=), &
334 &
operator(+),
operator(-),
operator(*),
operator(/),
mod,
modulo, &
336 use dc_string,
only: cprintf
340 integer,
intent(in),
optional:: year
341 integer,
intent(in),
optional:: mon
342 integer,
intent(in),
optional:: day
343 integer,
intent(in),
optional:: hour
344 integer,
intent(in),
optional:: min
345 real(DP),
intent(in),
optional:: sec
346 real(DP),
intent(in),
optional:: day_seconds
347 real(DP),
intent(in),
optional:: nondim
354 integer,
parameter:: year_default = 0, mon_default = 0
355 integer,
parameter:: day_default = 0, hour_default = 0, min_default = 0
356 integer,
parameter:: sec_default = 0
357 real(DP):: essec, esds
358 integer :: esmon, esday
359 character(STRING):: endsub_msb
361 character(*),
parameter :: subname =
'DCDiffTimeCreate1'
363 call beginsub(subname)
365 if (
present(nondim) )
then
366 diff % nondim_flag = .true.
372 diff % nondim_flag = .false.
375 if (
present(sclyear) )
then
377 elseif(
present(year) )
then
383 if (
present(sclmon) )
then
385 elseif(
present(mon) )
then
391 if (
present(sclday) )
then
393 elseif(
present(day) )
then
399 ihour = present_select(.false., hour_default, hour)
400 imin = present_select(.false., min_default,
min)
402 if (
present(sclsec) )
then
404 elseif(
present(sec) )
then
416 if(
present(day_seconds) )
then
417 diff % day_seconds = day_seconds
419 diff % day_seconds = day_seconds_default
422 call dcdate_normalize(diff % day, diff % sec, diff % day_seconds, diff % nondim_flag)
425 call debug( dbg_mode )
427 esmon = diff % mon ; esday = diff % day
428 essec = diff % sec ; esds = diff % day_seconds
430 & cprintf(
'mon=%d, day=%d, sec=%f, day_seconds=%f, nondim_flag=%b', &
431 & i = (/ esmon, esday /), d = (/ essec, esds /), &
432 & l = (/ diff % nondim_flag /) )
436 call endsub(subname,
'diff (%c)', c1 = trim(endsub_msb) )
475 use dc_trace,
only: beginsub, endsub
477 use dc_string,
only: strieq
486 &
operator(==),
operator(>),
operator(<),
operator(>=),
operator(<=), &
487 &
operator(+),
operator(-),
operator(*),
operator(/),
mod,
modulo, &
491 real(DP),
intent(in) :: value
492 character(*),
intent(in) :: unit
493 integer,
intent(in),
optional :: unit_symbol
494 logical,
intent(out),
optional :: err
497 integer :: esmon, esday
498 integer :: stat, val_int
500 character(STRING) :: cause_c
503 character(*),
parameter :: subname =
'DCDiffTimeCreate2'
505 call beginsub(subname,
'value=%f', d=(/
value/))
509 if (
present(unit_symbol) )
then
525 val_dec =
value -
int(
value)
546 esmon = diff % mon ; esday = diff % day ; essec = diff % sec
547 call endsub(subname,
'diff (mon=%d, day=%d, sec=%f)', &
548 & i=(/esmon, esday/), d=(/essec/))
557 real,
intent(in) :: value
558 character(*),
intent(in) :: unit
559 integer,
intent(in),
optional :: unit_symbol
560 logical,
intent(out),
optional :: err
571 integer,
intent(in) :: value
572 character(*),
intent(in) :: unit
573 integer,
intent(in),
optional :: unit_symbol
574 logical,
intent(out),
optional :: err
591 integer,
intent(in):: sec
608 real,
intent(in):: sec
620 real(DP),
intent(in):: sec
637 integer,
intent(in):: sec
654 real,
intent(in):: sec
666 real(DP),
intent(in):: sec
676 & year, mon, day, hour, min, sec, &
677 & zone, caltype, day_seconds, err)
682 integer,
intent(in),
optional:: year, mon, day, hour, min
683 real(DP),
intent(in),
optional:: sec, day_seconds
684 character(*),
intent(in),
optional :: zone
685 integer,
intent(in),
optional:: caltype
686 logical,
intent(out),
optional:: err
689 & year, mon, day, hour,
min, sec, &
690 & zone, caltype, day_seconds = day_seconds, err = err )
694 & year, mon, day, hour, min, sec, day_seconds)
699 integer,
intent(in),
optional:: year, mon, day, hour, min
700 real(DP),
intent(in),
optional:: sec, day_seconds
703 & year, mon, day, hour,
min, sec, day_seconds )
711 real(DP),
intent(in) :: value
712 character(*),
intent(in) :: unit
713 logical,
intent(out),
optional :: err
subroutine dcdatetimecreater(time, sec)
subroutine dcdatetimecreate1_bc(time, year, mon, day, hour, min, sec, zone, caltype, day_seconds, err)
subroutine dcdifftimecreated(diff, sec)
subroutine dcdifftimecreate2r(diff, value, unit, unit_symbol, err)
subroutine dcdifftimecreatei(diff, sec)
subroutine dcdifftimecreate2d(diff, value, unit, unit_symbol, err)
subroutine dcdifftimecreater(diff, sec)
subroutine dcdifftimecreate1_bc(diff, year, mon, day, hour, min, sec, day_seconds)
subroutine dcdatetimecreatei(time, sec)
subroutine dcdatetimecreate1(time, year, mon, day, hour, min, sec, zone, zone_hour, zone_min, caltype, caltype_str, day_seconds, sclyear, sclmon, sclday, sclsec, err)
subroutine dcdatetimecreated(time, sec)
subroutine dcdifftimecreate2i(diff, value, unit, unit_symbol, err)
subroutine dcdifftimecreate2_bc(diff, value, unit, err)
subroutine get_current_time(jyear, jmon, jday, jsec, jzone)
subroutine dcdifftimecreate1(diff, year, mon, day, hour, min, sec, day_seconds, nondim, sclyear, sclmon, sclday, sclsec)
subroutine, public dcdate_set_day_seconds_scl
subroutine, public dcdate_normalize(day, sec, day_seconds, nondim_flag)
integer, parameter, public unit_symbol_err
integer, parameter, public unit_symbol_hour
integer, parameter, public unit_symbol_min
integer, parameter, public cal_noleap
real(dp), parameter, public cyclic_mdays
integer, parameter, public hour_seconds
integer, parameter, public unit_symbol_month
integer, parameter, public four_years
integer, parameter, public cal_cyclic
real(dp), save, public day_seconds
integer, save, public caltype
integer, parameter, public unit_symbol_sec
integer, parameter, public unit_symbol_nondim
type(dc_scaled_sec), save, public day_seconds_scl
logical, save, public flag_set_day_seconds_scl
integer, parameter, public year_months
integer, parameter, public cal_gregorian
integer, parameter, public min_seconds
integer, parameter, public unit_symbol_day
integer, parameter, public unit_symbol_year
integer, parameter, public cal_julian
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_ebadunit
integer, parameter, public dc_noerr
integer, parameter, public dc_ebadcaltype
integer, parameter, public dc_ebadtimezone
subroutine, public dcscaledsecputline(sclsec, unit, indent)
Provides kind type parameter values.
integer, parameter, public token
Character length for word, token
integer, parameter, public string
Character length for string
integer, parameter, public dp
Double Precision Real number