17
18
19
20
21
22
23
24
25
27 use dc_message, only: messagenotify
28 use dc_string, only: lchar, stoi, stod
29 use dc_trace, only: beginsub, endsub, dbgmessage
32 implicit none
33 character(*), intent(in):: date_str
34
35
36
37
38
39
40
41 integer, intent(out):: year
42 integer, intent(out):: month
43 integer, intent(out):: day
44 integer, intent(out):: hour
45 integer, intent(out):: min
46 real(DP), intent(out):: sec
47 character(*), intent(out):: zone
48
49 logical, intent(out), optional:: err
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68 integer:: start, length
69 character(STRING):: str1, str2
70 character(TOKEN):: zone_pm, zone_hrs, zone_min
71 integer:: stat
72 character(STRING):: cause_c
73 character(*), parameter:: subname = 'DCCalDateParseStr1'
74continue
75 call beginsub( subname )
77 cause_c = ''
78
79
80
81
82 call match(
'[-]*#d+-#d+-#d+[#w#s]+#d+:#d+:#d+', date_str, &
83 & start, length )
84
85 if ( length > 0 ) then
86 str1 = date_str(start:)
87 else
89 call messagenotify('W', subname, &
90 & 'date_str=<%c> is invalid expression as date.', &
91 & c1 = trim(date_str) )
92 goto 999
93 end if
94
95
96
97
98 call match(
'^[-]*#d+-', str1, &
99 & start, length )
100 str2 = str1(start:start+length-2)
101 str1 = str1(start+length:)
102 year = stoi(str2)
103
104
105
106
107 call match(
'^#d+-', str1, &
108 & start, length )
109 str2 = str1(start:start+length-2)
110 str1 = str1(start+length:)
111 month = stoi(str2)
112
113
114
115
116 call match(
'^#d+[#w#s]', str1, &
117 & start, length )
118 str2 = str1(start:start+length-2)
119 str1 = str1(start+length:)
120 day = stoi(str2)
121
122
123
124
125 call match(
'#d+:', str1, &
126 & start, length )
127 str2 = str1(start:start+length-2)
128 str1 = str1(start+length:)
129 hour = stoi(str2)
130
131
132
133
134 call match(
'#d+:', str1, &
135 & start, length )
136 str2 = str1(start:start+length-2)
137 str1 = str1(start+length:)
138 min = stoi(str2)
139
140
141
142
143 call match(
'#d+', str1, &
144 & start, length )
145 str2 = str1(start:start+length-1)
146 str1 = str1(start+length:)
147
148 call match(
'^#.#d+', str1, &
149 & start, length )
150
151 if ( length > 0 ) then
152 str2 = trim(str2) // str1(start:start+length-1)
153 str1 = str1(start+length:)
154 end if
155 sec = stod(str2)
156
157
158
159
160 call match(
'[#+-]#d+:#d+', str1, &
161 & start, length )
162 if ( length > 0 ) then
163 zone_pm = str1(start:start)
164 str1 = str1(start+1:start+length-1)
165
166 call match(
'^#d+:', str1, &
167 & start, length )
168 zone_hrs = str1(start:start+length-2)
169 zone_min = str1(start+length:)
170 zone = trim(zone_pm) // trim(zone_hrs) // ':' // trim(zone_min)
171 else
172 zone = ''
173 end if
174
175 call dbgmessage('year=<%d> month=<%d> day=<%d> hour=<%d> min=<%d> sec=<%f>' // &
176 & ' zone=<%c>', &
177 & i = (/year, month, day, hour, min/), d = (/sec/), &
178 & c1 = trim(zone) )
179
180
181
182
183999 continue
184 call storeerror( stat, subname, err, cause_c )
185 call endsub( subname )
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 dp
Double Precision Real number
integer, parameter, public string
Character length for string