53 use dc_message,
only: messagenotify
54 use dc_string,
only: lchar
55 use dc_trace,
only: beginsub, endsub
59 integer,
intent(in):: year
60 integer,
intent(in):: month
61 integer,
intent(in):: day
62 integer,
intent(in):: hour
63 integer,
intent(in):: min
64 real(DP),
intent(in):: sec
65 type(
dc_cal_date),
intent(out),
optional,
target:: date
74 character(*),
intent(in),
optional:: zone
76 logical,
intent(out),
optional:: err
96 integer:: start, length
98 character(STRING):: cause_c
99 character(*),
parameter:: version = &
101 &
'$Id: dccaldatecreate.f90,v 1.3 2010-09-24 07:07:31 morikawa Exp $'
102 character(*),
parameter:: subname =
'DCCalDateCreate1'
104 call beginsub( subname, version )
111 if (
present( date ) )
then
136 if ( month < 1 )
then
138 call messagenotify(
'W', subname,
'month=<%d> must be natural number', &
145 call messagenotify(
'W', subname,
'day=<%d> must be natural number', &
152 call messagenotify(
'W', subname,
'hour=<%d> must not be negative', &
159 call messagenotify(
'W', subname,
'min=<%d> must not be negative', &
164 if ( sec < 0.0_dp )
then
166 call messagenotify(
'W', subname,
'sec=<%f> must not be negative', &
171 call match(
'^[#+-]#d+:#d+$', zone, &
173 if ( length > 0 )
then
183 datep % month = month
192 datep % initialized = .true.
195 call storeerror( stat, subname, err, cause_c )
196 call endsub( subname )
248 use dc_message,
only: messagenotify
250 use dc_trace,
only: beginsub, endsub
254 character(*),
intent(in):: date_str
262 type(
dc_cal_date),
intent(out),
optional,
target:: date
271 logical,
intent(out),
optional:: err
297 character(TOKEN):: zone
300 character(STRING):: cause_c
301 character(*),
parameter:: version = &
303 &
'$Id: dccaldatecreate.f90,v 1.3 2010-09-24 07:07:31 morikawa Exp $'
304 character(*),
parameter:: subname =
'DCCalDateCreate2'
306 call beginsub( subname, version )
313 if (
present( date ) )
then
332 & year, month, day, hour, min, sec, zone, &
334 if (
present(err) )
then
345 & year, month, day, hour, min, sec, &
346 & datep, zone, err = err )
347 if (
present(err) )
then
359 call storeerror( stat, subname, err, cause_c )
360 call endsub( subname )
subroutine dccaldatecreate2(date_str, date, err)
subroutine dccaldatecreate1(year, month, day, hour, min, sec, date, zone, err)
type(dc_cal_date), target, save, public default_date
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_ealreadyinit
integer, parameter, public dc_noerr
integer, parameter, public dc_ebaddate
Provide simple regular expression subroutine: 'match' .
subroutine, public match(pattern, text, start, length)
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