Setup_date_string.F
References to this file elsewhere.
1 SUBROUTINE Setup_date_string ( grid, date_string, adantn )
2 USE module_domain
3 USE module_configure
4 USE esmf_mod
5 IMPLICIT NONE
6 TYPE(domain), POINTER :: grid
7 character(len=19), dimension(1000), intent(out) :: date_string
8 character(len=2), intent(in ) :: adantn
9
10 character(len=19) :: tmp_string, begin_date_string, end_date_string
11
12 ! Local
13 INTEGER :: start_year,start_month,start_day,start_hour,start_minute,start_second
14 INTEGER :: end_year,end_month,end_day,end_hour,end_minute,end_second
15
16 INTEGER :: local_interval , &
17 local_interval_mo, &
18 local_interval_d, &
19 local_interval_h, &
20 local_interval_m, &
21 local_interval_s
22
23 INTEGER :: local_begin , &
24 local_begin_y, &
25 local_begin_mo, &
26 local_begin_d, &
27 local_begin_h, &
28 local_begin_m, &
29 local_begin_s
30
31 INTEGER :: local_end , &
32 local_end_y, &
33 local_end_mo,&
34 local_end_d, &
35 local_end_h, &
36 local_end_m, &
37 local_end_s
38
39 INTEGER :: current_y, &
40 current_mo,&
41 current_d, &
42 current_h, &
43 current_m, &
44 current_s
45
46 INTEGER :: index, i, n
47
48 logical, external :: string_a_less_than_b
49
50 CALL nl_get_start_year(1,start_year)
51 CALL nl_get_start_month(1,start_month)
52 CALL nl_get_start_day(1,start_day)
53 CALL nl_get_start_hour(1,start_hour)
54 CALL nl_get_start_minute(1,start_minute)
55 CALL nl_get_start_second(1,start_second)
56
57 CALL nl_get_end_year(1,end_year)
58 CALL nl_get_end_month(1,end_month)
59 CALL nl_get_end_day(1,end_day)
60 CALL nl_get_end_hour(1,end_hour)
61 CALL nl_get_end_minute(1,end_minute)
62 CALL nl_get_end_second(1,end_second)
63
64 print *, 'start_year,start_month,start_day,start_hour,start_minute,start_second=', &
65 start_year,start_month,start_day,start_hour,start_minute,start_second
66
67 print *, 'end_year,end_month,end_day,end_hour,end_minute,end_second=', &
68 end_year,end_month,end_day,end_hour,end_minute,end_second
69
70 ! AUXINPUT3_ INTERVAL
71 ! auxinput3_interval is left there (and means minutes) for consistency, but
72 ! auxinput3_interval_m will take precedence if specified
73
74 if( adantn == 'ad') then
75
76 CALL nl_get_auxinput3_begin_y( 1, local_begin_y )
77 CALL nl_get_auxinput3_begin_mo( 1, local_begin_mo )
78 CALL nl_get_auxinput3_begin_d( 1, local_begin_d )
79 CALL nl_get_auxinput3_begin_h( 1, local_begin_h )
80 CALL nl_get_auxinput3_begin_m( 1, local_begin_m )
81 CALL nl_get_auxinput3_begin_s( 1, local_begin_s )
82
83 CALL nl_get_auxinput3_end_y( 1, local_end_y )
84 CALL nl_get_auxinput3_end_mo( 1, local_end_mo )
85 CALL nl_get_auxinput3_end_d( 1, local_end_d )
86 CALL nl_get_auxinput3_end_h( 1, local_end_h )
87 CALL nl_get_auxinput3_end_m( 1, local_end_m )
88 CALL nl_get_auxinput3_end_s( 1, local_end_s )
89
90 CALL nl_get_auxinput3_interval( 1, local_interval ) ! same as minutes
91
92 CALL nl_get_auxinput3_interval_mo( 1, local_interval_mo )
93 CALL nl_get_auxinput3_interval_d( 1, local_interval_d )
94 CALL nl_get_auxinput3_interval_h( 1, local_interval_h )
95 CALL nl_get_auxinput3_interval_m( 1, local_interval_m )
96 CALL nl_get_auxinput3_interval_s( 1, local_interval_s )
97
98 else
99
100 CALL nl_get_auxinput2_begin_y( 1, local_begin_y )
101 CALL nl_get_auxinput2_begin_mo( 1, local_begin_mo )
102 CALL nl_get_auxinput2_begin_d( 1, local_begin_d )
103 CALL nl_get_auxinput2_begin_h( 1, local_begin_h )
104 CALL nl_get_auxinput2_begin_m( 1, local_begin_m )
105 CALL nl_get_auxinput2_begin_s( 1, local_begin_s )
106
107 CALL nl_get_auxinput2_end_y( 1, local_end_y )
108 CALL nl_get_auxinput2_end_mo( 1, local_end_mo )
109 CALL nl_get_auxinput2_end_d( 1, local_end_d )
110 CALL nl_get_auxinput2_end_h( 1, local_end_h )
111 CALL nl_get_auxinput2_end_m( 1, local_end_m )
112 CALL nl_get_auxinput2_end_s( 1, local_end_s )
113
114 CALL nl_get_auxinput2_interval( 1, local_interval ) ! same as minutes
115
116 CALL nl_get_auxinput2_interval_mo( 1, local_interval_mo )
117 CALL nl_get_auxinput2_interval_d( 1, local_interval_d )
118 CALL nl_get_auxinput2_interval_h( 1, local_interval_h )
119 CALL nl_get_auxinput2_interval_m( 1, local_interval_m )
120 CALL nl_get_auxinput2_interval_s( 1, local_interval_s )
121
122 endif
123
124 if(local_interval_mo < 1 .and. &
125 local_interval_d < 1 .and. &
126 local_interval_h < 1 .and. &
127 local_interval_m < 1 .and. &
128 local_interval_s < 1) then
129 if(local_interval < 1) then
130 index = 1
131 date_string(index)(1:19) = '9999-01-01_00:00:00'
132 write(unit=*, fmt='(a)') 'No need to set date_string.'
133 return
134 else
135 local_interval_m = local_interval
136 endif
137 endif
138
139 !--date_string(0) = 2000-01-24_12:00:00
140
141 write(end_date_string(1:19), fmt='(i4.4,5(a1,i2.2))') &
142 end_year, &
143 '-', end_month, &
144 '-', end_day, &
145 '_', end_hour, &
146 ':', end_minute, &
147 ':', end_second
148
149 write(begin_date_string(1:19), fmt='(i4.4,5(a1,i2.2))') &
150 start_year, &
151 '-', start_month, &
152 '-', start_day, &
153 '_', start_hour, &
154 ':', start_minute, &
155 ':', start_second
156
157 current_y = start_year
158 current_mo = start_month
159 current_d = start_day
160 current_h = start_hour
161 current_m = start_minute
162 current_s = start_second
163
164 index = 0
165
166 write(unit=*, fmt='(2(2x, 2a))') &
167 'begin_date_string =', begin_date_string, 'end_date_string =', end_date_string
168
169 do while(string_a_less_than_b(begin_date_string, end_date_string))
170 write(unit=*, fmt='(2(2x, 2a))') &
171 'begin_date_string =', begin_date_string, 'end_date_string =', end_date_string
172
173 index = index + 1
174
175 write(date_string(index)(1:19), fmt='(i4.4,5(a1,i2.2))') &
176 current_y, &
177 '-', current_mo, &
178 '-', current_d, &
179 '_', current_h, &
180 ':', current_m, &
181 ':', current_s
182
183 write(unit=*, fmt='(a,i4,2a)') &
184 'date_string(', index, ')=', date_string(index)
185
186 call advance_ccyymmddhhmmss(current_y, current_mo, current_d, current_h, current_m, current_s, &
187 0, local_interval_mo, local_interval_d, local_interval_h, local_interval_m, local_interval_s )
188
189 write(begin_date_string(1:19), fmt='(i4.4,5(a1,i2.2))') &
190 current_y, &
191 '-', current_mo, &
192 '-', current_d, &
193 '_', current_h, &
194 ':', current_m, &
195 ':', current_s
196
197 if(index > 999) exit
198 end do
199
200 if( adantn /= 'tn' ) then ! reverse order
201
202 n = index
203 do i=1, index/2
204 tmp_string = date_string(i)
205 date_string(i) = date_string(n)
206 date_string(n) = tmp_string
207 n = n - 1
208 enddo
209
210 endif
211
212 do i=1,index
213 write(6,*)'check date_string:',adantn,i,date_string(i)
214 enddo
215
216 CALL wrf_debug ( 100 , 'Setup_date_string: returning...' )
217
218 END SUBROUTINE Setup_date_string
219
220 subroutine advance_ccyymmddhhmmss(current_y, current_mo, current_d, current_h, current_m, current_s, &
221 interval_y, interval_mo, interval_d, interval_h, interval_m, interval_s )
222
223 implicit none
224
225 integer, intent(inout) :: current_y, current_mo, current_d, current_h, current_m, current_s
226 integer, intent(in) :: interval_y, interval_mo, interval_d, interval_h, interval_m, interval_s
227
228 if(interval_y /= 0 .or. interval_mo /= 0 .or. interval_d /= 0) then
229 print *, 'interval_y = ', interval_y
230 print *, 'interval_mo= ', interval_mo
231 print *, 'interval_d = ', interval_d
232 print *, 'Can not handle this yet.'
233 stop
234 endif
235
236 current_y = current_y + interval_y
237 current_mo = current_mo + interval_mo
238 current_d = current_d + interval_d
239 current_h = current_h + interval_h
240 current_m = current_m + interval_m
241 current_s = current_s + interval_s
242
243 do while (current_s < 0)
244 current_s = current_s + 60
245 current_m = current_m - 1
246 end do
247
248 do while (current_s >= 60)
249 current_s = current_s - 60
250 current_m = current_m + 1
251 end do
252
253 do while (current_m < 0)
254 current_m = current_m + 60
255 current_h = current_h - 1
256 end do
257
258 do while (current_m >= 60)
259 current_m = current_m - 60
260 current_h = current_h + 1
261 end do
262
263 do while (current_h < 0)
264 current_h = current_h + 24
265 call change_date ( current_y, current_mo, current_d, -1 )
266 end do
267
268 do while (current_h > 23)
269 current_h = current_h - 24
270 call change_date ( current_y, current_mo, current_d, 1 )
271 end do
272
273 end subroutine advance_ccyymmddhhmmss
274
275 subroutine change_date( ccyy, mm, dd, delta )
276
277 implicit none
278
279 integer, intent(inout) :: ccyy, mm, dd
280 integer, intent(in) :: delta
281
282 integer, dimension(12) :: mmday
283
284 mmday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
285
286 mmday(2) = 28
287
288 if (mod(ccyy,4) == 0) then
289 mmday(2) = 29
290
291 if ( mod(ccyy,100) == 0) then
292 mmday(2) = 28
293 endif
294
295 if(mod(ccyy,400) == 0) then
296 mmday(2) = 29
297 end if
298 endif
299
300 dd = dd + delta
301
302 if(dd == 0) then
303 mm = mm - 1
304
305 if(mm == 0) then
306 mm = 12
307 ccyy = ccyy - 1
308 endif
309
310 dd = mmday(mm)
311 elseif ( dd .gt. mmday(mm) ) then
312 dd = 1
313 mm = mm + 1
314 if(mm > 12 ) then
315 mm = 1
316 ccyy = ccyy + 1
317 end if
318 end if
319 end subroutine change_date
320
321 function string_a_less_than_b(begin_date_string, end_date_string)
322 IMPLICIT NONE
323 character(len=19), intent(in) :: begin_date_string, end_date_string
324
325 character(len=1) :: char
326
327 ! Local
328 INTEGER :: begin_year,begin_month,begin_day,begin_hour,begin_minute,begin_second
329 INTEGER :: end_year,end_month,end_day,end_hour,end_minute,end_second
330
331 integer(kind=8) :: begin_date, end_date
332
333 logical :: string_a_less_than_b
334
335 read(begin_date_string(1:19), fmt='(i4.4,5(a1,i2.2))') &
336 begin_year, &
337 char, begin_month, &
338 char, begin_day, &
339 char, begin_hour, &
340 char, begin_minute, &
341 char, begin_second
342
343 read(end_date_string(1:19), fmt='(i4.4,5(a1,i2.2))') &
344 end_year, &
345 char, end_month, &
346 char, end_day, &
347 char, end_hour, &
348 char, end_minute, &
349 char, end_second
350
351 begin_date = begin_second + 100*(begin_minute + 100*(begin_hour &
352 + 100*(begin_day + 100*(begin_month + 100*begin_year))))
353 end_date = end_second + 100*(end_minute + 100*(end_hour &
354 + 100*(end_day + 100*(end_month + 100*end_year))))
355
356 if(end_date < begin_date ) then
357 string_a_less_than_b = .false.
358 else
359 string_a_less_than_b = .true.
360 endif
361
362 end function string_a_less_than_b
363