15 & year, month, day, hour, min, sec, elapse_sec, cal, date, err )
53 use dc_message,
only: messagenotify
54 use dc_trace,
only: beginsub, endsub
60 integer,
intent(in):: year
61 integer,
intent(in):: month
62 integer,
intent(in):: day
63 integer,
intent(in):: hour
64 integer,
intent(in):: min
65 real(DP),
intent(in):: sec
66 real(DP),
intent(in):: elapse_sec
69 type(
dc_cal),
intent(in),
optional,
target:: cal
74 type(
dc_cal_date),
intent(out),
optional,
target:: date
79 logical,
intent(out),
optional:: err
97 integer:: wyear, wmonth, wday, whour, wmin
100 type(
dc_cal),
pointer:: calp =>null()
101 character(STRING):: e_date_str, e_cal_str
103 character(STRING):: cause_c
104 character(*),
parameter:: subname =
'DCCalDateEvalYMDHMS1'
106 call beginsub( subname )
113 if (
present( date ) )
then
119 if (
present( cal ) )
then
135 if ( .not. calp % initialized )
then
160 wsec = wsec + elapse_sec
169 e_date_str =
dccaldatetochar( wyear, wmonth, wday, whour, wmin, wsec, zone =
"" )
170 call messagenotify(
'W', subname,
'cal=<%c> and date=<%c> are inconsistency', &
171 & c1 = trim(e_cal_str), c2 = trim(e_date_str) )
179 & wyear, wmonth, wday, whour, wmin, wsec, &
180 & datep, zone =
"", err = err )
181 if (
present(err) )
then
192 nullify( calp, datep )
193 call storeerror( stat, subname, err, cause_c )
194 call endsub( subname )
200 & year, month, day, hour, min, sec, elapse_time, units, cal, date, err )
239 use dc_message,
only: messagenotify
240 use dc_trace,
only: beginsub, endsub
247 integer,
intent(in):: year
248 integer,
intent(in):: month
249 integer,
intent(in):: day
250 integer,
intent(in):: hour
251 integer,
intent(in):: min
252 real(DP),
intent(in):: sec
253 real(DP),
intent(in):: elapse_time
259 character(*),
intent(in):: units
263 type(
dc_cal),
intent(in),
optional,
target:: cal
268 type(
dc_cal_date),
intent(out),
optional,
target:: date
273 logical,
intent(out),
optional:: err
291 integer:: wyear, wmonth, wday, whour, wmin
294 type(
dc_cal),
pointer:: calp =>null()
295 character(STRING):: e_date_str, e_cal_str
298 character(STRING):: cause_c
299 character(*),
parameter:: subname =
'DCCalDateEvalYMDHMS2'
301 call beginsub( subname )
308 if (
present( date ) )
then
314 if (
present( cal ) )
then
330 if ( .not. calp % initialized )
then
358 wsec = wsec + elapse_time * calp % hour_in_day &
359 & * calp % min_in_hour &
360 & * calp % sec_in_min
362 wsec = wsec + elapse_time * calp % min_in_hour &
363 & * calp % sec_in_min
365 wsec = wsec + elapse_time * calp % sec_in_min
367 wsec = wsec + elapse_time
370 call messagenotify(
'W', subname,
'units=<%c> is invalid. (ONLY day,hrs,min,sec are valid)', &
383 e_date_str =
dccaldatetochar( wyear, wmonth, wday, whour, wmin, wsec, zone =
"" )
384 call messagenotify(
'W', subname,
'cal=<%c> and date=<%c> are inconsistency', &
385 & c1 = trim(e_cal_str), c2 = trim(e_date_str) )
393 & wyear, wmonth, wday, whour, wmin, wsec, &
394 & datep, zone =
"", err = err )
395 if (
present(err) )
then
406 nullify( calp, datep )
407 call storeerror( stat, subname, err, cause_c )
408 call endsub( subname )
451 use dc_message,
only: messagenotify
452 use dc_trace,
only: beginsub, endsub
463 real(DP),
intent(in):: elapse_sec
466 type(
dc_cal),
intent(in),
optional,
target:: cal
471 type(
dc_cal_date),
intent(out),
optional,
target:: date
476 logical,
intent(out),
optional:: err
494 integer:: wyear, wmonth, wday, whour, wmin
496 character(TOKEN):: wzone
498 type(
dc_cal),
pointer:: calp =>null()
499 character(STRING):: e_date_str, e_cal_str
501 character(STRING):: cause_c
502 character(*),
parameter:: subname =
'DCCalDateEvalID1'
504 call beginsub( subname )
511 if (
present( date ) )
then
517 if (
present( cal ) )
then
533 if ( .not. calp % initialized )
then
542 wyear = init_date % year
543 wmonth = init_date % month
544 wday = init_date % day
545 whour = init_date % hour
546 wmin = init_date % min
547 wsec = init_date % sec
548 wzone = init_date % zone
559 wsec = wsec + elapse_sec
568 e_date_str =
dccaldatetochar( wyear, wmonth, wday, whour, wmin, wsec, zone =
"" )
569 call messagenotify(
'W', subname,
'cal=<%c> and date=<%c> are inconsistency', &
570 & c1 = trim(e_cal_str), c2 = trim(e_date_str) )
578 & wyear, wmonth, wday, whour, wmin, wsec, &
579 & datep, zone = wzone, err = err )
580 if (
present(err) )
then
591 nullify( calp, datep )
592 call storeerror( stat, subname, err, cause_c )
593 call endsub( subname )
636 use dc_message,
only: messagenotify
637 use dc_trace,
only: beginsub, endsub
649 real(DP),
intent(in):: elapse_time
655 character(*),
intent(in):: units
659 type(
dc_cal),
intent(in),
optional,
target:: cal
664 type(
dc_cal_date),
intent(out),
optional,
target:: date
669 logical,
intent(out),
optional:: err
687 integer:: wyear, wmonth, wday, whour, wmin
689 character(TOKEN):: wzone
691 type(
dc_cal),
pointer:: calp =>null()
692 character(STRING):: e_date_str, e_cal_str
695 character(STRING):: cause_c
696 character(*),
parameter:: subname =
'DCCalDateEvalID2'
698 call beginsub( subname )
705 if (
present( date ) )
then
711 if (
present( cal ) )
then
727 if ( .not. calp % initialized )
then
736 wyear = init_date % year
737 wmonth = init_date % month
738 wday = init_date % day
739 whour = init_date % hour
740 wmin = init_date % min
741 wsec = init_date % sec
742 wzone = init_date % zone
756 wsec = wsec + elapse_time * calp % hour_in_day &
757 & * calp % min_in_hour &
758 & * calp % sec_in_min
760 wsec = wsec + elapse_time * calp % min_in_hour &
761 & * calp % sec_in_min
763 wsec = wsec + elapse_time * calp % sec_in_min
765 wsec = wsec + elapse_time
768 call messagenotify(
'W', subname,
'units=<%c> is invalid. (ONLY day,hrs,min,sec are valid)', &
781 e_date_str =
dccaldatetochar( wyear, wmonth, wday, whour, wmin, wsec, zone =
"" )
782 call messagenotify(
'W', subname,
'cal=<%c> and date=<%c> are inconsistency', &
783 & c1 = trim(e_cal_str), c2 = trim(e_date_str) )
791 & wyear, wmonth, wday, whour, wmin, wsec, &
792 & datep, zone = wzone, err = err )
793 if (
present(err) )
then
804 nullify( calp, datep )
805 call storeerror( stat, subname, err, cause_c )
806 call endsub( subname )
812 & year1, month1, day1, hour1, min1, sec1, &
814 & year2, month2, day2, hour2, min2, sec2, &
835 use dc_message,
only: messagenotify
836 use dc_trace,
only: beginsub, endsub
842 integer,
intent(in):: year1
843 integer,
intent(in):: month1
844 integer,
intent(in):: day1
845 integer,
intent(in):: hour1
846 integer,
intent(in):: min1
847 real(DP),
intent(in):: sec1
848 real(DP),
intent(in):: elapse_sec
851 integer,
intent(out):: year2
852 integer,
intent(out):: month2
853 integer,
intent(out):: day2
854 integer,
intent(out):: hour2
855 integer,
intent(out):: min2
856 real(DP),
intent(out):: sec2
857 type(
dc_cal),
intent(in),
optional,
target:: cal
862 logical,
intent(out),
optional:: err
880 type(
dc_cal),
pointer:: calp =>null()
881 character(STRING):: e_date_str, e_cal_str
883 character(STRING):: cause_c
884 character(*),
parameter:: subname =
'DCCalDateEvalYM2YM1'
886 call beginsub( subname )
893 if (
present( cal ) )
then
909 if ( .not. calp % initialized )
then
934 sec2 = sec2 + elapse_sec
943 e_date_str =
dccaldatetochar( year2, month2, day2, hour2, min2, sec2, zone =
"" )
944 call messagenotify(
'W', subname,
'cal=<%c> and date=<%c> are inconsistency', &
945 & c1 = trim(e_cal_str), c2 = trim(e_date_str) )
954 call storeerror( stat, subname, err, cause_c )
955 call endsub( subname )
961 & year1, month1, day1, hour1, min1, sec1, &
962 & elapse_time, units, &
963 & year2, month2, day2, hour2, min2, sec2, &
985 use dc_message,
only: messagenotify
986 use dc_trace,
only: beginsub, endsub
994 integer,
intent(in):: year1
995 integer,
intent(in):: month1
996 integer,
intent(in):: day1
997 integer,
intent(in):: hour1
998 integer,
intent(in):: min1
999 real(DP),
intent(in):: sec1
1000 real(DP),
intent(in):: elapse_time
1006 character(*),
intent(in):: units
1010 integer,
intent(out):: year2
1011 integer,
intent(out):: month2
1012 integer,
intent(out):: day2
1013 integer,
intent(out):: hour2
1014 integer,
intent(out):: min2
1015 real(DP),
intent(out):: sec2
1016 type(
dc_cal),
intent(in),
optional,
target:: cal
1021 logical,
intent(out),
optional:: err
1039 type(
dc_cal),
pointer:: calp =>null()
1040 character(STRING):: e_date_str, e_cal_str
1043 character(STRING):: cause_c
1044 character(*),
parameter:: subname =
'DCCalDateEvalYM2YM1'
1046 call beginsub( subname )
1053 if (
present( cal ) )
then
1069 if ( .not. calp % initialized )
then
1097 sec2 = sec2 + elapse_time * calp % hour_in_day &
1098 & * calp % min_in_hour &
1099 & * calp % sec_in_min
1101 sec2 = sec2 + elapse_time * calp % min_in_hour &
1102 & * calp % sec_in_min
1104 sec2 = sec2 + elapse_time * calp % sec_in_min
1106 sec2 = sec2 + elapse_time
1109 call messagenotify(
'W', subname,
'units=<%c> is invalid. (ONLY day,hour,min,sec are valid)', &
1110 & c1 = trim(units) )
1122 e_date_str =
dccaldatetochar( year2, month2, day2, hour2, min2, sec2, zone =
"" )
1123 call messagenotify(
'W', subname,
'cal=<%c> and date=<%c> are inconsistency', &
1124 & c1 = trim(e_cal_str), c2 = trim(e_date_str) )
1133 call storeerror( stat, subname, err, cause_c )
1134 call endsub( subname )
1171 real(
dp),
intent(in):: elapse_sec
1174 type(
dc_cal_date),
intent(in),
optional,
target:: date
1179 type(
dc_cal),
intent(in),
optional,
target:: cal
1191 real(
dp):: day_of_year
1194 type(
dc_cal),
pointer:: calp =>null()
1195 integer:: year, month, day, hour, min
1202 if (
present( date ) )
then
1208 if (
present( cal ) )
then
1219 if ( .not. datep % initialized )
return
1220 if ( .not. calp % initialized )
return
1226 & elapse_sec = elapse_sec, date = date , cal = calp )
1237 result = ( day_of_year - 1 ) * calp % hour_in_day &
1238 & * calp % min_in_hour &
1239 & * calp % sec_in_min &
1240 & + hour * calp % min_in_hour &
1241 & * calp % sec_in_min &
1242 & + min * calp % sec_in_min &
1281 real(
dp),
intent(in):: elapse_sec
1284 type(
dc_cal_date),
intent(in),
optional,
target:: date
1289 type(
dc_cal),
intent(in),
optional,
target:: cal
1301 integer:: year, month, day, hour, min
1305 type(
dc_cal),
pointer:: calp =>null()
1312 if (
present( date ) )
then
1318 if (
present( cal ) )
then
1329 if ( .not. datep % initialized )
return
1330 if ( .not. calp % initialized )
return
1336 & elapse_sec = elapse_sec, date = date , cal = calp )
1380 real(
dp),
intent(in):: elapse_sec
1383 type(
dc_cal_date),
intent(in),
optional,
target:: date
1388 type(
dc_cal),
intent(in),
optional,
target:: cal
1402 type(
dc_cal),
pointer:: calp =>null()
1403 integer:: year, month, day, hour, min
1410 if (
present( date ) )
then
1416 if (
present( cal ) )
then
1427 if ( .not. datep % initialized )
return
1428 if ( .not. calp % initialized )
return
1434 & elapse_sec = elapse_sec, date = date , cal = calp )
1440 & hour * calp % min_in_hour &
1441 & * calp % sec_in_min &
1442 & + min * calp % sec_in_min &
subroutine dccaldateevalymdhms2(year, month, day, hour, min, sec, elapse_time, units, cal, date, err)
real(dp) function dccaldateevaldayofyear1(elapse_sec, date, cal)
subroutine dccaldateevalid2(init_date, elapse_time, units, cal, date, err)
real(dp) function dccaldateevalsecofyear1(elapse_sec, date, cal)
subroutine dccaldateevalymdhms1(year, month, day, hour, min, sec, elapse_sec, cal, date, err)
subroutine dccaldateevalym2ym1(year1, month1, day1, hour1, min1, sec1, elapse_sec, year2, month2, day2, hour2, min2, sec2, cal, err)
subroutine dccaldateevalym2ym2(year1, month1, day1, hour1, min1, sec1, elapse_time, units, year2, month2, day2, hour2, min2, sec2, cal, err)
subroutine dccaldateevalid1(init_date, elapse_sec, cal, date, err)
real(dp) function dccaldateevalsecofday1(elapse_sec, date, cal)
type(dc_cal), target, save, public default_cal
type(dc_cal_date), target, save, public default_date
integer function, public dccaldate_normalize(year, month, day, hour, min, sec, cal)
integer function, public dccaldate_ym2d(year, month, day, cal, day_of_year)
subroutine, public default_cal_set
integer function, public dccaldate_str2usym(str)
integer, parameter, public unit_symbol_sec
integer, parameter, public unit_symbol_hour
integer, parameter, public unit_symbol_day
integer, parameter, public unit_symbol_min
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_ebadunit
integer, parameter, public dc_enotinit
integer, parameter, public dc_ealreadyinit
integer, parameter, public dc_noerr
integer, parameter, public dc_enegative
integer, parameter, public dc_ebaddate
integer, parameter, public dc_einconsistcaldate
Provides kind type parameter values.
integer, parameter, public token
Character length for word, token
integer, parameter, public dp
Double Precision Real number
integer, parameter, public string
Character length for string