Parse strings of date.
69
76 implicit none
77 character(*), intent(in):: date_str
78 integer, intent(out):: year
79 integer, intent(out):: month
80 integer, intent(out):: day
81 integer, intent(out):: hour
82 integer, intent(out):: min
83 real(DP), intent(out):: sec
84 character(*), intent(out):: zone
85 logical, intent(out), optional:: err
86
87
88
89
90 integer:: start, length
91 character(STRING):: str1, str2
92 character(TOKEN):: zone_pm, zone_hrs, zone_min
93 integer:: stat
94 character(STRING):: cause_c
95 character(*), parameter:: subname = 'DCCalDateParseStr1'
96continue
99 cause_c = ''
100
101
102
103
104 call match(
'[-]*#d+-#d+-#d+[#w#s]+#d+:#d+:#d+', date_str, &
105 & start, length )
106
107 if ( length > 0 ) then
108 str1 = date_str(start:)
109 else
112 & 'date_str=<%c> is invalid expression as date.', &
113 & c1 = trim(date_str) )
114 goto 999
115 end if
116
117
118
119
120 call match(
'^[-]*#d+-', str1, &
121 & start, length )
122 str2 = str1(start:start+length-2)
123 str1 = str1(start+length:)
125
126
127
128
129 call match(
'^#d+-', str1, &
130 & start, length )
131 str2 = str1(start:start+length-2)
132 str1 = str1(start+length:)
134
135
136
137
138 call match(
'^#d+[#w#s]', str1, &
139 & start, length )
140 str2 = str1(start:start+length-2)
141 str1 = str1(start+length:)
143
144
145
146
147 call match(
'#d+:', str1, &
148 & start, length )
149 str2 = str1(start:start+length-2)
150 str1 = str1(start+length:)
152
153
154
155
156 call match(
'#d+:', str1, &
157 & start, length )
158 str2 = str1(start:start+length-2)
159 str1 = str1(start+length:)
161
162
163
164
165 call match(
'#d+', str1, &
166 & start, length )
167 str2 = str1(start:start+length-1)
168 str1 = str1(start+length:)
169
170 call match(
'^#.#d+', str1, &
171 & start, length )
172
173 if ( length > 0 ) then
174 str2 = trim(str2) // str1(start:start+length-1)
175 str1 = str1(start+length:)
176 end if
178
179
180
181
182 call match(
'[#+-]#d+:#d+', str1, &
183 & start, length )
184 if ( length > 0 ) then
185 zone_pm = str1(start:start)
186 str1 = str1(start+1:start+length-1)
187
188 call match(
'^#d+:', str1, &
189 & start, length )
190 zone_hrs = str1(start:start+length-2)
191 zone_min = str1(start+length:)
192 zone = trim(zone_pm) // trim(zone_hrs) // ':' // trim(zone_min)
193 else
194 zone = ''
195 end if
196
197 call dbgmessage(
'year=<%d> month=<%d> day=<%d> hour=<%d> min=<%d> sec=<%f>' // &
198 & ' zone=<%c>', &
199 & i = (/year, month, day, hour, min/), d = (/sec/), &
200 & c1 = trim(zone) )
201
202
203
204
205999 continue
206 call storeerror( stat, subname, err, cause_c )
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_noerr
Error storage variables
integer, parameter, public dc_ebaddate
Provides simple regular expression subroutine: 'match'.
subroutine, public match(pattern, text, start, length)
Handling character types.
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
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