Loading...
Searching...
No Matches
dccaldateeval.f90
Go to the documentation of this file.
1!= 日時の算出
2!= Evaluate date
3!
4! Authors:: Yasuhiro MORIKAWA
5! Version:: $Id: dccaldateeval.f90,v 1.6 2010-09-24 00:28:18 morikawa Exp $
6! Tag Name:: $Name: $
7! Copyright:: Copyright (C) GFD Dennou Club, 2009-. All rights reserved.
8! License:: See COPYRIGHT[link:../../COPYRIGHT]
9!
10! このファイルに記載される手続き群は dc_calendar モジュールから提供されます.
11!
12! Procedures described in this file are provided from "dc_calendar" module.
13!
15 & year, month, day, hour, min, sec, elapse_sec, cal, date, err )
16 !
17 ! 日時の算出と設定を行います.
18 !
19 ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
20 ! 保持される "dc_calendar_types#DC_CAL_DATE" 型の変数に日時が
21 ! 設定されます. その後の手続きで *date* を省略した場合には
22 ! この日時が使用されます.
23 ! *date* が省略されない場合にはその変数に日時が設定されます.
24 ! その日時を使用する場合, 手続きにその "dc_calendar_types#DC_CAL_DATE" 型の変数
25 ! を与えてください.
26 !
27 ! 省略可能引数 *cal* が省略された場合には, 経過秒数 *elapse_sec*
28 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
29 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
30 !
31 ! Evaluate and set date.
32 !
33 ! If an optional argument *date* is omitted,
34 ! the date setting is stored to a "dc_calendar_types#DC_CAL_DATE"
35 ! variable that is saved in the "dc_calendar".
36 ! When *date* is omitted in subsequent procedures, the internal date
37 ! is used.
38 ! If *date* is not omitted, the settings is stored to the *date*.
39 ! In order to use the date setting, use the "dc_calendar_types#DC_CAL_DATE"
40 ! varieble to subsequent procedures.
41 !
42 ! If an optional argument *cal* is omitted,
43 ! information of calendar that is stored in the "dc_calendar"
44 ! is used for conversion of elapsed seconds *elapse_sec* into
45 ! year-month-day etc.
46 ! If *cal* is not omitted, information of the variable is used.
47 !
48
53 use dc_message, only: messagenotify
54 use dc_trace, only: beginsub, endsub
57 use dc_types, only: string, dp, token
58 use dc_types, only: dp
59 implicit none
60 integer, intent(in):: year ! 起点の年. Year of origin.
61 integer, intent(in):: month ! 起点の月. Month of origin.
62 integer, intent(in):: day ! 起点の日. Day of origin.
63 integer, intent(in):: hour ! 起点の時. Hour of origin.
64 integer, intent(in):: min ! 起点の分. Minute of origin.
65 real(DP), intent(in):: sec ! 起点の秒. Second of origin.
66 real(DP), intent(in):: elapse_sec
67 ! *year* 〜 *sec* からの経過秒数.
68 ! Elapsed seconds from *year* -- *sec*
69 type(dc_cal), intent(in), optional, target:: cal
70 ! 暦情報を収めたオブジェクト.
71 !
72 ! An object that stores information of
73 ! calendar.
74 type(dc_cal_date), intent(out), optional, target:: date
75 ! 経過時間後の日時情報を収めたオブジェクト.
76 !
77 ! An object that stores information of
78 ! date and time after elapsed time.
79 logical, intent(out), optional:: err
80 ! 例外処理用フラグ.
81 ! デフォルトでは, この手続き内でエラーが
82 ! 生じた場合, プログラムは強制終了します.
83 ! 引数 *err* が与えられる場合,
84 ! プログラムは強制終了せず, 代わりに
85 ! *err* に .true. が代入されます.
86 !
87 ! Exception handling flag.
88 ! By default, when error occur in
89 ! this procedure, the program aborts.
90 ! If this *err* argument is given,
91 ! .true. is substituted to *err* and
92 ! the program does not abort.
93
94 ! 作業変数
95 ! Work variables
96 !
97 integer:: wyear, wmonth, wday, whour, wmin
98 real(DP):: wsec
99 type(dc_cal_date), pointer:: datep =>null()
100 type(dc_cal), pointer:: calp =>null()
101 character(STRING):: e_date_str, e_cal_str
102 integer:: stat
103 character(STRING):: cause_c
104 character(*), parameter:: subname = 'DCCalDateEvalYMDHMS1'
105continue
106 call beginsub( subname )
107 stat = dc_noerr
108 cause_c = ''
109
110 ! オブジェクトのポインタ割付
111 ! Associate pointer of an object
112 !
113 if ( present( date ) ) then
114 datep => date
115 else
116 datep => default_date
117 end if
118
119 if ( present( cal ) ) then
120 calp => cal
121 else
122 calp => default_cal
123 if ( .not. calp % initialized ) call default_cal_set
124 end if
125
126 ! 初期設定のチェック
127 ! Check initialization
128 !
129!!$ if ( .not. datep % initialized ) then
130!!$ stat = DC_ENOTINIT
131!!$ cause_c = 'DC_CAL_DATE'
132!!$ goto 999
133!!$ end if
134
135 if ( .not. calp % initialized ) then
136 stat = dc_enotinit
137 cause_c = 'DC_CAL'
138 goto 999
139 end if
140
141 ! 各要素への値の参照
142 ! Refer elements
143 !
144 wyear = year
145 wmonth = month
146 wday = day
147 whour = hour
148 wmin = min
149 wsec = sec
150
151 ! 経過時間(秒)の追加
152 ! Add elapsed time (seconds)
153 !
154!!$ if ( elapse_sec < 0.0_DP ) then
155!!$ stat = DC_ENEGATIVE
156!!$ cause_c = 'elapse_sec'
157!!$ goto 999
158!!$ end if
159
160 wsec = wsec + elapse_sec
161
162 ! 日時の正規化
163 ! Normalize date and time
164 !
165 stat = dccaldate_normalize( wyear, wmonth, wday, whour, wmin, wsec, & ! (inout)
166 & calp ) ! (in)
167 if ( stat == dc_einconsistcaldate ) then
168 e_cal_str = dccaltochar( calp )
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) )
172 goto 999
173 end if
174
175 ! オブジェクトの作成
176 ! Create an object
177 !
178 call dccaldatecreate( &
179 & wyear, wmonth, wday, whour, wmin, wsec, & ! (in)
180 & datep, zone = "", err = err ) ! (out) optional
181 if ( present(err) ) then
182 if ( err ) then
183 stat = dc_ebaddate
184 goto 999
185 end if
186 end if
187
188 ! 終了処理, 例外処理
189 ! Termination and Exception handling
190 !
191999 continue
192 nullify( calp, datep )
193 call storeerror( stat, subname, err, cause_c )
194 call endsub( subname )
195end subroutine dccaldateevalymdhms1
196
197!-----------------------------------------------------------
198
200 & year, month, day, hour, min, sec, elapse_time, units, cal, date, err )
201 !
202 ! 日時の算出と設定を行います.
203 !
204 ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
205 ! 保持される "dc_calendar_types#DC_CAL_DATE" 型の変数に日時が
206 ! 設定されます. その後の手続きで *date* を省略した場合には
207 ! この日時が使用されます.
208 ! *date* が省略されない場合にはその変数に日時が設定されます.
209 ! その日時を使用する場合, 手続きにその "dc_calendar_types#DC_CAL_DATE" 型の変数
210 ! を与えてください.
211 !
212 ! 省略可能引数 *cal* が省略された場合には, 経過時間 *elapse_time*
213 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
214 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
215 !
216 ! Evaluate and set date.
217 !
218 ! If an optional argument *date* is omitted,
219 ! the date setting is stored to a "dc_calendar_types#DC_CAL_DATE"
220 ! variable that is saved in the "dc_calendar".
221 ! When *date* is omitted in subsequent procedures, the internal date
222 ! is used.
223 ! If *date* is not omitted, the settings is stored to the *date*.
224 ! In order to use the date setting, use the "dc_calendar_types#DC_CAL_DATE"
225 ! varieble to subsequent procedures.
226 !
227 ! If an optional argument *cal* is omitted,
228 ! information of calendar that is stored in the "dc_calendar"
229 ! is used for conversion of elapsed time *elapse_time* into
230 ! year-month-day etc.
231 ! If *cal* is not omitted, information of the variable is used.
232 !
233
239 use dc_message, only: messagenotify
240 use dc_trace, only: beginsub, endsub
244 use dc_types, only: string, dp, token
245 use dc_types, only: dp
246 implicit none
247 integer, intent(in):: year ! 起点の年. Year of origin.
248 integer, intent(in):: month ! 起点の月. Month of origin.
249 integer, intent(in):: day ! 起点の日. Day of origin.
250 integer, intent(in):: hour ! 起点の時. Hour of origin.
251 integer, intent(in):: min ! 起点の分. Minute of origin.
252 real(DP), intent(in):: sec ! 起点の秒. Second of origin.
253 real(DP), intent(in):: elapse_time
254 ! *year* 〜 *sec* からの経過時間.
255 ! 単位は *unit* で指定する.
256 !
257 ! Elapsed time from *year* -- *sec*
258 ! Unit is specified as *unit*.
259 character(*), intent(in):: units
260 ! *elapse_time* の単位.
261 !
262 ! Unit of *elapse_time*.
263 type(dc_cal), intent(in), optional, target:: cal
264 ! 暦情報を収めたオブジェクト.
265 !
266 ! An object that stores information of
267 ! calendar.
268 type(dc_cal_date), intent(out), optional, target:: date
269 ! 経過時間後の日時情報を収めたオブジェクト.
270 !
271 ! An object that stores information of
272 ! date and time after elapsed time.
273 logical, intent(out), optional:: err
274 ! 例外処理用フラグ.
275 ! デフォルトでは, この手続き内でエラーが
276 ! 生じた場合, プログラムは強制終了します.
277 ! 引数 *err* が与えられる場合,
278 ! プログラムは強制終了せず, 代わりに
279 ! *err* に .true. が代入されます.
280 !
281 ! Exception handling flag.
282 ! By default, when error occur in
283 ! this procedure, the program aborts.
284 ! If this *err* argument is given,
285 ! .true. is substituted to *err* and
286 ! the program does not abort.
287
288 ! 作業変数
289 ! Work variables
290 !
291 integer:: wyear, wmonth, wday, whour, wmin
292 real(DP):: wsec
293 type(dc_cal_date), pointer:: datep =>null()
294 type(dc_cal), pointer:: calp =>null()
295 character(STRING):: e_date_str, e_cal_str
296 integer:: tusym
297 integer:: stat
298 character(STRING):: cause_c
299 character(*), parameter:: subname = 'DCCalDateEvalYMDHMS2'
300continue
301 call beginsub( subname )
302 stat = dc_noerr
303 cause_c = ''
304
305 ! オブジェクトのポインタ割付
306 ! Associate pointer of an object
307 !
308 if ( present( date ) ) then
309 datep => date
310 else
311 datep => default_date
312 end if
313
314 if ( present( cal ) ) then
315 calp => cal
316 else
317 calp => default_cal
318 if ( .not. calp % initialized ) call default_cal_set
319 end if
320
321 ! 初期設定のチェック
322 ! Check initialization
323 !
324!!$ if ( .not. datep % initialized ) then
325!!$ stat = DC_ENOTINIT
326!!$ cause_c = 'DC_CAL_DATE'
327!!$ goto 999
328!!$ end if
329
330 if ( .not. calp % initialized ) then
331 stat = dc_enotinit
332 cause_c = 'DC_CAL'
333 goto 999
334 end if
335
336 ! 各要素への値の参照
337 ! Refer elements
338 !
339 wyear = year
340 wmonth = month
341 wday = day
342 whour = hour
343 wmin = min
344 wsec = sec
345
346 ! 経過時間(秒)の追加
347 ! Add elapsed time (seconds)
348 !
349!!$ if ( elapse_time < 0.0_DP ) then
350!!$ stat = DC_ENEGATIVE
351!!$ cause_c = 'elapse_time'
352!!$ goto 999
353!!$ end if
354
355 tusym = dccaldate_str2usym(units)
356 select case(tusym)
357 case(unit_symbol_day)
358 wsec = wsec + elapse_time * calp % hour_in_day &
359 & * calp % min_in_hour &
360 & * calp % sec_in_min
361 case(unit_symbol_hour)
362 wsec = wsec + elapse_time * calp % min_in_hour &
363 & * calp % sec_in_min
364 case(unit_symbol_min)
365 wsec = wsec + elapse_time * calp % sec_in_min
366 case(unit_symbol_sec)
367 wsec = wsec + elapse_time
368 case default
369 cause_c = units
370 call messagenotify('W', subname, 'units=<%c> is invalid. (ONLY day,hrs,min,sec are valid)', &
371 & c1 = trim(units) )
372 stat = dc_ebadunit
373 goto 999
374 end select
375
376 ! 日時の正規化
377 ! Normalize date and time
378 !
379 stat = dccaldate_normalize( wyear, wmonth, wday, whour, wmin, wsec, & ! (inout)
380 & calp ) ! (in)
381 if ( stat == dc_einconsistcaldate ) then
382 e_cal_str = dccaltochar( calp )
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) )
386 goto 999
387 end if
388
389 ! オブジェクトの作成
390 ! Create an object
391 !
392 call dccaldatecreate( &
393 & wyear, wmonth, wday, whour, wmin, wsec, & ! (in)
394 & datep, zone = "", err = err ) ! (out) optional
395 if ( present(err) ) then
396 if ( err ) then
397 stat = dc_ebaddate
398 goto 999
399 end if
400 end if
401
402 ! 終了処理, 例外処理
403 ! Termination and Exception handling
404 !
405999 continue
406 nullify( calp, datep )
407 call storeerror( stat, subname, err, cause_c )
408 call endsub( subname )
409end subroutine dccaldateevalymdhms2
410
411!-----------------------------------------------------------
412
413subroutine dccaldateevalid1( init_date, elapse_sec, cal, date, err )
414 !
415 ! 日時の算出と設定を行います.
416 !
417 ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
418 ! 保持される "dc_calendar_types#DC_CAL_DATE" 型の変数に日時が
419 ! 設定されます. その後の手続きで *date* を省略した場合には
420 ! この日時が使用されます.
421 ! *date* が省略されない場合にはその変数に日時が設定されます.
422 ! その日時を使用する場合, 手続きにその "dc_calendar_types#DC_CAL_DATE" 型の変数
423 ! を与えてください.
424 !
425 ! 省略可能引数 *cal* が省略された場合には, 経過秒数 *elapse_sec*
426 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
427 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
428 !
429 ! Evaluate and set date.
430 !
431 ! If an optional argument *date* is omitted,
432 ! the date setting is stored to a "dc_calendar_types#DC_CAL_DATE"
433 ! variable that is saved in the "dc_calendar".
434 ! When *date* is omitted in subsequent procedures, the internal date
435 ! is used.
436 ! If *date* is not omitted, the settings is stored to the *date*.
437 ! In order to use the date setting, use the "dc_calendar_types#DC_CAL_DATE"
438 ! varieble to subsequent procedures.
439 !
440 ! If an optional argument *cal* is omitted,
441 ! information of calendar that is stored in the "dc_calendar"
442 ! is used for conversion of elapsed seconds *elapse_sec* into
443 ! year-month-day etc.
444 ! If *cal* is not omitted, information of the variable is used.
445 !
446
451 use dc_message, only: messagenotify
452 use dc_trace, only: beginsub, endsub
455 use dc_types, only: string, dp, token
456 use dc_types, only: dp
457 implicit none
458 type(dc_cal_date), intent(in):: init_date
459 ! 起点となる日時情報を収めたオブジェクト.
460 !
461 ! An object that stores information of
462 ! date of origin.
463 real(DP), intent(in):: elapse_sec
464 ! *init_date* からの経過秒数.
465 ! Elapsed seconds from *init_date*.
466 type(dc_cal), intent(in), optional, target:: cal
467 ! 暦情報を収めたオブジェクト.
468 !
469 ! An object that stores information of
470 ! calendar.
471 type(dc_cal_date), intent(out), optional, target:: date
472 ! 経過時間後の日時情報を収めたオブジェクト.
473 !
474 ! An object that stores information of
475 ! date and time after elapsed time.
476 logical, intent(out), optional:: err
477 ! 例外処理用フラグ.
478 ! デフォルトでは, この手続き内でエラーが
479 ! 生じた場合, プログラムは強制終了します.
480 ! 引数 *err* が与えられる場合,
481 ! プログラムは強制終了せず, 代わりに
482 ! *err* に .true. が代入されます.
483 !
484 ! Exception handling flag.
485 ! By default, when error occur in
486 ! this procedure, the program aborts.
487 ! If this *err* argument is given,
488 ! .true. is substituted to *err* and
489 ! the program does not abort.
490
491 ! 作業変数
492 ! Work variables
493 !
494 integer:: wyear, wmonth, wday, whour, wmin
495 real(DP):: wsec
496 character(TOKEN):: wzone
497 type(dc_cal_date), pointer:: datep =>null()
498 type(dc_cal), pointer:: calp =>null()
499 character(STRING):: e_date_str, e_cal_str
500 integer:: stat
501 character(STRING):: cause_c
502 character(*), parameter:: subname = 'DCCalDateEvalID1'
503continue
504 call beginsub( subname )
505 stat = dc_noerr
506 cause_c = ''
507
508 ! オブジェクトのポインタ割付
509 ! Associate pointer of an object
510 !
511 if ( present( date ) ) then
512 datep => date
513 else
514 datep => default_date
515 end if
516
517 if ( present( cal ) ) then
518 calp => cal
519 else
520 calp => default_cal
521 if ( .not. calp % initialized ) call default_cal_set
522 end if
523
524 ! 初期設定のチェック
525 ! Check initialization
526 !
527!!$ if ( .not. datep % initialized ) then
528!!$ stat = DC_ENOTINIT
529!!$ cause_c = 'DC_CAL_DATE'
530!!$ goto 999
531!!$ end if
532
533 if ( .not. calp % initialized ) then
534 stat = dc_enotinit
535 cause_c = 'DC_CAL'
536 goto 999
537 end if
538
539 ! 各要素への値の参照
540 ! Refer elements
541 !
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
549
550 ! 経過時間(秒)の追加
551 ! Add elapsed time (seconds)
552 !
553!!$ if ( elapse_sec < 0.0_DP ) then
554!!$ stat = DC_ENEGATIVE
555!!$ cause_c = 'elapse_sec'
556!!$ goto 999
557!!$ end if
558
559 wsec = wsec + elapse_sec
560
561 ! 日時の正規化
562 ! Normalize date and time
563 !
564 stat = dccaldate_normalize( wyear, wmonth, wday, whour, wmin, wsec, & ! (inout)
565 & calp ) ! (in)
566 if ( stat == dc_einconsistcaldate ) then
567 e_cal_str = dccaltochar( calp )
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) )
571 goto 999
572 end if
573
574 ! オブジェクトの作成
575 ! Create an object
576 !
577 call dccaldatecreate( &
578 & wyear, wmonth, wday, whour, wmin, wsec, & ! (in)
579 & datep, zone = wzone, err = err ) ! (out) optional
580 if ( present(err) ) then
581 if ( err ) then
582 stat = dc_ebaddate
583 goto 999
584 end if
585 end if
586
587 ! 終了処理, 例外処理
588 ! Termination and Exception handling
589 !
590999 continue
591 nullify( calp, datep )
592 call storeerror( stat, subname, err, cause_c )
593 call endsub( subname )
594end subroutine dccaldateevalid1
595
596!-----------------------------------------------------------
597
598subroutine dccaldateevalid2( init_date, elapse_time, units, cal, date, err )
599 !
600 ! 日時の算出と設定を行います.
601 !
602 ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
603 ! 保持される "dc_calendar_types#DC_CAL_DATE" 型の変数に日時が
604 ! 設定されます. その後の手続きで *date* を省略した場合には
605 ! この日時が使用されます.
606 ! *date* が省略されない場合にはその変数に日時が設定されます.
607 ! その日時を使用する場合, 手続きにその "dc_calendar_types#DC_CAL_DATE" 型の変数
608 ! を与えてください.
609 !
610 ! 省略可能引数 *cal* が省略された場合には, 経過時間 *elapse_time*
611 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
612 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
613 !
614 ! Evaluate and set date.
615 !
616 ! If an optional argument *date* is omitted,
617 ! the date setting is stored to a "dc_calendar_types#DC_CAL_DATE"
618 ! variable that is saved in the "dc_calendar".
619 ! When *date* is omitted in subsequent procedures, the internal date
620 ! is used.
621 ! If *date* is not omitted, the settings is stored to the *date*.
622 ! In order to use the date setting, use the "dc_calendar_types#DC_CAL_DATE"
623 ! varieble to subsequent procedures.
624 !
625 ! If an optional argument *cal* is omitted,
626 ! information of calendar that is stored in the "dc_calendar"
627 ! is used for conversion of elapsed time *elapse_time* into
628 ! year-month-day etc.
629 ! If *cal* is not omitted, information of the variable is used.
630 !
636 use dc_message, only: messagenotify
637 use dc_trace, only: beginsub, endsub
641 use dc_types, only: string, dp, token
642 use dc_types, only: dp
643 implicit none
644 type(dc_cal_date), intent(in):: init_date
645 ! 起点となる日時情報を収めたオブジェクト.
646 !
647 ! An object that stores information of
648 ! date of origin.
649 real(DP), intent(in):: elapse_time
650 ! *init_date* からの経過時間.
651 ! 単位は *unit* で指定する.
652 !
653 ! Elapsed time from *init_date*.
654 ! Unit is specified as *unit*.
655 character(*), intent(in):: units
656 ! *elapse_time* の単位.
657 !
658 ! Unit of *elapse_time*.
659 type(dc_cal), intent(in), optional, target:: cal
660 ! 暦情報を収めたオブジェクト.
661 !
662 ! An object that stores information of
663 ! calendar.
664 type(dc_cal_date), intent(out), optional, target:: date
665 ! 経過時間後の日時情報を収めたオブジェクト.
666 !
667 ! An object that stores information of
668 ! date and time after elapsed time.
669 logical, intent(out), optional:: err
670 ! 例外処理用フラグ.
671 ! デフォルトでは, この手続き内でエラーが
672 ! 生じた場合, プログラムは強制終了します.
673 ! 引数 *err* が与えられる場合,
674 ! プログラムは強制終了せず, 代わりに
675 ! *err* に .true. が代入されます.
676 !
677 ! Exception handling flag.
678 ! By default, when error occur in
679 ! this procedure, the program aborts.
680 ! If this *err* argument is given,
681 ! .true. is substituted to *err* and
682 ! the program does not abort.
683
684 ! 作業変数
685 ! Work variables
686 !
687 integer:: wyear, wmonth, wday, whour, wmin
688 real(DP):: wsec
689 character(TOKEN):: wzone
690 type(dc_cal_date), pointer:: datep =>null()
691 type(dc_cal), pointer:: calp =>null()
692 character(STRING):: e_date_str, e_cal_str
693 integer:: tusym
694 integer:: stat
695 character(STRING):: cause_c
696 character(*), parameter:: subname = 'DCCalDateEvalID2'
697continue
698 call beginsub( subname )
699 stat = dc_noerr
700 cause_c = ''
701
702 ! オブジェクトのポインタ割付
703 ! Associate pointer of an object
704 !
705 if ( present( date ) ) then
706 datep => date
707 else
708 datep => default_date
709 end if
710
711 if ( present( cal ) ) then
712 calp => cal
713 else
714 calp => default_cal
715 if ( .not. calp % initialized ) call default_cal_set
716 end if
717
718 ! 初期設定のチェック
719 ! Check initialization
720 !
721!!$ if ( .not. datep % initialized ) then
722!!$ stat = DC_ENOTINIT
723!!$ cause_c = 'DC_CAL_DATE'
724!!$ goto 999
725!!$ end if
726
727 if ( .not. calp % initialized ) then
728 stat = dc_enotinit
729 cause_c = 'DC_CAL'
730 goto 999
731 end if
732
733 ! 各要素への値の参照
734 ! Refer elements
735 !
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
743
744 ! 経過時間(秒)の追加
745 ! Add elapsed time (seconds)
746 !
747!!$ if ( elapse_time < 0.0_DP ) then
748!!$ stat = DC_ENEGATIVE
749!!$ cause_c = 'elapse_time'
750!!$ goto 999
751!!$ end if
752
753 tusym = dccaldate_str2usym(units)
754 select case(tusym)
755 case(unit_symbol_day)
756 wsec = wsec + elapse_time * calp % hour_in_day &
757 & * calp % min_in_hour &
758 & * calp % sec_in_min
759 case(unit_symbol_hour)
760 wsec = wsec + elapse_time * calp % min_in_hour &
761 & * calp % sec_in_min
762 case(unit_symbol_min)
763 wsec = wsec + elapse_time * calp % sec_in_min
764 case(unit_symbol_sec)
765 wsec = wsec + elapse_time
766 case default
767 cause_c = units
768 call messagenotify('W', subname, 'units=<%c> is invalid. (ONLY day,hrs,min,sec are valid)', &
769 & c1 = trim(units) )
770 stat = dc_ebadunit
771 goto 999
772 end select
773
774 ! 日時の正規化
775 ! Normalize date and time
776 !
777 stat = dccaldate_normalize( wyear, wmonth, wday, whour, wmin, wsec, & ! (inout)
778 & calp ) ! (in)
779 if ( stat == dc_einconsistcaldate ) then
780 e_cal_str = dccaltochar( calp )
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) )
784 goto 999
785 end if
786
787 ! オブジェクトの作成
788 ! Create an object
789 !
790 call dccaldatecreate( &
791 & wyear, wmonth, wday, whour, wmin, wsec, & ! (in)
792 & datep, zone = wzone, err = err ) ! (out) optional
793 if ( present(err) ) then
794 if ( err ) then
795 stat = dc_ebaddate
796 goto 999
797 end if
798 end if
799
800 ! 終了処理, 例外処理
801 ! Termination and Exception handling
802 !
803999 continue
804 nullify( calp, datep )
805 call storeerror( stat, subname, err, cause_c )
806 call endsub( subname )
807end subroutine dccaldateevalid2
808
809!-----------------------------------------------------------
810
812 & year1, month1, day1, hour1, min1, sec1, &
813 & elapse_sec, &
814 & year2, month2, day2, hour2, min2, sec2, &
815 & cal, err )
816 !
817 ! 日時の算出と設定を行います.
818 !
819 ! 省略可能引数 *cal* が省略された場合には, 経過秒数 *elapse_sec*
820 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
821 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
822 !
823 ! Evaluate and set date.
824 !
825 ! If an optional argument *cal* is omitted,
826 ! information of calendar that is stored in the "dc_calendar"
827 ! is used for conversion of elapsed seconds *elapse_sec* into
828 ! year-month-day etc.
829 ! If *cal* is not omitted, information of the variable is used.
830 !
835 use dc_message, only: messagenotify
836 use dc_trace, only: beginsub, endsub
839 use dc_types, only: string, dp, token
840 use dc_types, only: dp
841 implicit none
842 integer, intent(in):: year1 ! 起点の年. Year of origin.
843 integer, intent(in):: month1 ! 起点の月. Month of origin.
844 integer, intent(in):: day1 ! 起点の日. Day of origin.
845 integer, intent(in):: hour1 ! 起点の時. Hour of origin.
846 integer, intent(in):: min1 ! 起点の分. Minute of origin.
847 real(DP), intent(in):: sec1 ! 起点の秒. Second of origin.
848 real(DP), intent(in):: elapse_sec
849 ! *year1* 〜 *sec1* からの経過秒数.
850 ! Elapsed seconds from *year1* -- *sec1*
851 integer, intent(out):: year2 ! 経過時間後の年. Year after elapsed time.
852 integer, intent(out):: month2 ! 経過時間後の月. Month after elapsed time.
853 integer, intent(out):: day2 ! 経過時間後の日. Day after elapsed time.
854 integer, intent(out):: hour2 ! 経過時間後の時. Hour after elapsed time.
855 integer, intent(out):: min2 ! 経過時間後の分. Minute after elapsed time.
856 real(DP), intent(out):: sec2 ! 経過時間後の秒. Second after elapsed time.
857 type(dc_cal), intent(in), optional, target:: cal
858 ! 暦情報を収めたオブジェクト.
859 !
860 ! An object that stores information of
861 ! calendar.
862 logical, intent(out), optional:: err
863 ! 例外処理用フラグ.
864 ! デフォルトでは, この手続き内でエラーが
865 ! 生じた場合, プログラムは強制終了します.
866 ! 引数 *err* が与えられる場合,
867 ! プログラムは強制終了せず, 代わりに
868 ! *err* に .true. が代入されます.
869 !
870 ! Exception handling flag.
871 ! By default, when error occur in
872 ! this procedure, the program aborts.
873 ! If this *err* argument is given,
874 ! .true. is substituted to *err* and
875 ! the program does not abort.
876
877 ! 作業変数
878 ! Work variables
879 !
880 type(dc_cal), pointer:: calp =>null()
881 character(STRING):: e_date_str, e_cal_str
882 integer:: stat
883 character(STRING):: cause_c
884 character(*), parameter:: subname = 'DCCalDateEvalYM2YM1'
885continue
886 call beginsub( subname )
887 stat = dc_noerr
888 cause_c = ''
889
890 ! オブジェクトのポインタ割付
891 ! Associate pointer of an object
892 !
893 if ( present( cal ) ) then
894 calp => cal
895 else
896 calp => default_cal
897 if ( .not. calp % initialized ) call default_cal_set
898 end if
899
900 ! 初期設定のチェック
901 ! Check initialization
902 !
903!!$ if ( .not. datep % initialized ) then
904!!$ stat = DC_ENOTINIT
905!!$ cause_c = 'DC_CAL_DATE'
906!!$ goto 999
907!!$ end if
908
909 if ( .not. calp % initialized ) then
910 stat = dc_enotinit
911 cause_c = 'DC_CAL'
912 goto 999
913 end if
914
915 ! 各要素への値の参照
916 ! Refer elements
917 !
918 year2 = year1
919 month2 = month1
920 day2 = day1
921 hour2 = hour1
922 min2 = min1
923 sec2 = sec1
924
925 ! 経過時間(秒)の追加
926 ! Add elapsed time (seconds)
927 !
928!!$ if ( elapse_sec < 0.0_DP ) then
929!!$ stat = DC_ENEGATIVE
930!!$ cause_c = 'elapse_sec'
931!!$ goto 999
932!!$ end if
933
934 sec2 = sec2 + elapse_sec
935
936 ! 日時の正規化
937 ! Normalize date and time
938 !
939 stat = dccaldate_normalize( year2, month2, day2, hour2, min2, sec2, & ! (inout)
940 & calp ) ! (in)
941 if ( stat == dc_einconsistcaldate ) then
942 e_cal_str = dccaltochar( calp )
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) )
946 goto 999
947 end if
948
949 ! 終了処理, 例外処理
950 ! Termination and Exception handling
951 !
952999 continue
953 nullify( calp )
954 call storeerror( stat, subname, err, cause_c )
955 call endsub( subname )
956end subroutine dccaldateevalym2ym1
957
958!-----------------------------------------------------------
959
961 & year1, month1, day1, hour1, min1, sec1, &
962 & elapse_time, units, &
963 & year2, month2, day2, hour2, min2, sec2, &
964 & cal, err )
965 !
966 ! 日時の算出と設定を行います.
967 !
968 ! 省略可能引数 *cal* が省略された場合には, 経過時間 *elapse_time*
969 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
970 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
971 !
972 ! Evaluate and set date.
973 !
974 ! If an optional argument *cal* is omitted,
975 ! information of calendar that is stored in the "dc_calendar"
976 ! is used for conversion of elapsed time *elapse_time* into
977 ! year-month-day etc.
978 ! If *cal* is not omitted, information of the variable is used.
979 !
985 use dc_message, only: messagenotify
986 use dc_trace, only: beginsub, endsub
990 use dc_types, only: string, dp, token
991 use dc_types, only: dp
992 implicit none
993
994 integer, intent(in):: year1 ! 起点の年. Year of origin.
995 integer, intent(in):: month1 ! 起点の月. Month of origin.
996 integer, intent(in):: day1 ! 起点の日. Day of origin.
997 integer, intent(in):: hour1 ! 起点の時. Hour of origin.
998 integer, intent(in):: min1 ! 起点の分. Minute of origin.
999 real(DP), intent(in):: sec1 ! 起点の秒. Second of origin.
1000 real(DP), intent(in):: elapse_time
1001 ! *year1* 〜 *sec1* からの経過時間.
1002 ! 単位は *unit* で指定する.
1003 !
1004 ! Elapsed time from *year1* -- *sec1*
1005 ! Unit is specified as *unit*.
1006 character(*), intent(in):: units
1007 ! *elapse_time* の単位.
1008 !
1009 ! Unit of *elapse_time*.
1010 integer, intent(out):: year2 ! 経過時間後の年. Year after elapsed time.
1011 integer, intent(out):: month2 ! 経過時間後の月. Month after elapsed time.
1012 integer, intent(out):: day2 ! 経過時間後の日. Day after elapsed time.
1013 integer, intent(out):: hour2 ! 経過時間後の時. Hour after elapsed time.
1014 integer, intent(out):: min2 ! 経過時間後の分. Minute after elapsed time.
1015 real(DP), intent(out):: sec2 ! 経過時間後の秒. Second after elapsed time.
1016 type(dc_cal), intent(in), optional, target:: cal
1017 ! 暦情報を収めたオブジェクト.
1018 !
1019 ! An object that stores information of
1020 ! calendar.
1021 logical, intent(out), optional:: err
1022 ! 例外処理用フラグ.
1023 ! デフォルトでは, この手続き内でエラーが
1024 ! 生じた場合, プログラムは強制終了します.
1025 ! 引数 *err* が与えられる場合,
1026 ! プログラムは強制終了せず, 代わりに
1027 ! *err* に .true. が代入されます.
1028 !
1029 ! Exception handling flag.
1030 ! By default, when error occur in
1031 ! this procedure, the program aborts.
1032 ! If this *err* argument is given,
1033 ! .true. is substituted to *err* and
1034 ! the program does not abort.
1035
1036 ! 作業変数
1037 ! Work variables
1038 !
1039 type(dc_cal), pointer:: calp =>null()
1040 character(STRING):: e_date_str, e_cal_str
1041 integer:: tusym
1042 integer:: stat
1043 character(STRING):: cause_c
1044 character(*), parameter:: subname = 'DCCalDateEvalYM2YM1'
1045continue
1046 call beginsub( subname )
1047 stat = dc_noerr
1048 cause_c = ''
1049
1050 ! オブジェクトのポインタ割付
1051 ! Associate pointer of an object
1052 !
1053 if ( present( cal ) ) then
1054 calp => cal
1055 else
1056 calp => default_cal
1057 if ( .not. calp % initialized ) call default_cal_set
1058 end if
1059
1060 ! 初期設定のチェック
1061 ! Check initialization
1062 !
1063!!$ if ( .not. datep % initialized ) then
1064!!$ stat = DC_ENOTINIT
1065!!$ cause_c = 'DC_CAL_DATE'
1066!!$ goto 999
1067!!$ end if
1068
1069 if ( .not. calp % initialized ) then
1070 stat = dc_enotinit
1071 cause_c = 'DC_CAL'
1072 goto 999
1073 end if
1074
1075 ! 各要素への値の参照
1076 ! Refer elements
1077 !
1078 year2 = year1
1079 month2 = month1
1080 day2 = day1
1081 hour2 = hour1
1082 min2 = min1
1083 sec2 = sec1
1084
1085 ! 経過時間(秒)の追加
1086 ! Add elapsed time (seconds)
1087 !
1088!!$ if ( elapse_time < 0.0_DP ) then
1089!!$ stat = DC_ENEGATIVE
1090!!$ cause_c = 'elapse_time'
1091!!$ goto 999
1092!!$ end if
1093
1094 tusym = dccaldate_str2usym(units)
1095 select case(tusym)
1096 case(unit_symbol_day)
1097 sec2 = sec2 + elapse_time * calp % hour_in_day &
1098 & * calp % min_in_hour &
1099 & * calp % sec_in_min
1100 case(unit_symbol_hour)
1101 sec2 = sec2 + elapse_time * calp % min_in_hour &
1102 & * calp % sec_in_min
1103 case(unit_symbol_min)
1104 sec2 = sec2 + elapse_time * calp % sec_in_min
1105 case(unit_symbol_sec)
1106 sec2 = sec2 + elapse_time
1107 case default
1108 cause_c = units
1109 call messagenotify('W', subname, 'units=<%c> is invalid. (ONLY day,hour,min,sec are valid)', &
1110 & c1 = trim(units) )
1111 stat = dc_ebadunit
1112 goto 999
1113 end select
1114
1115 ! 日時の正規化
1116 ! Normalize date and time
1117 !
1118 stat = dccaldate_normalize( year2, month2, day2, hour2, min2, sec2, & ! (inout)
1119 & calp ) ! (in)
1120 if ( stat == dc_einconsistcaldate ) then
1121 e_cal_str = dccaltochar( calp )
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) )
1125 goto 999
1126 end if
1127
1128 ! 終了処理, 例外処理
1129 ! Termination and Exception handling
1130 !
1131999 continue
1132 nullify( calp )
1133 call storeerror( stat, subname, err, cause_c )
1134 call endsub( subname )
1135end subroutine dccaldateevalym2ym2
1136
1137!-----------------------------------------------------------
1138
1139function dccaldateevalsecofyear1( elapse_sec, date, cal ) result(result)
1140 ! 年始めからの通秒を算出します.
1141 !
1142 ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
1143 ! 保持される日時が起点の日時として用いられます.
1144 ! *date* が省略されない場合にはその変数に設定された日時が
1145 ! 起点の日時として用いられます.
1146 !
1147 ! 省略可能引数 *cal* が省略された場合には, 経過秒数 *elapse_sec*
1148 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
1149 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
1150 !
1151 ! Evaluate second of year.
1152 !
1153 ! If an optional argument *date* is omitted,
1154 ! information of date that is stored in the "dc_calendar"
1155 ! is used as date of origin,
1156 ! If *date* is not omitted, information of the variable is used as
1157 ! date of origin.
1158 !
1159 ! If an optional argument *cal* is omitted,
1160 ! information of calendar that is stored in the "dc_calendar"
1161 ! is used for conversion of elapsed seconds *elapse_sec* into
1162 ! year-month-day etc.
1163 ! If *cal* is not omitted, information of the variable is used.
1164 !
1169 use dc_types, only: dp
1170 implicit none
1171 real(dp), intent(in):: elapse_sec
1172 ! *date* からの経過秒数.
1173 ! Elapsed seconds from *date*.
1174 type(dc_cal_date), intent(in), optional, target:: date
1175 ! 起点となる日時情報を収めたオブジェクト.
1176 !
1177 ! An object that stores information of
1178 ! date of origin.
1179 type(dc_cal), intent(in), optional, target:: cal
1180 ! 暦情報を収めたオブジェクト.
1181 !
1182 ! An object that stores information of
1183 ! calendar.
1184 real(dp):: result
1185 ! 年始めからの通秒.
1186 ! Second of year.
1187
1188 ! 作業変数
1189 ! Work variables
1190 !
1191 real(dp):: day_of_year
1192 integer:: stat
1193 type(dc_cal_date), pointer:: datep =>null()
1194 type(dc_cal), pointer:: calp =>null()
1195 integer:: year, month, day, hour, min
1196 real(dp):: sec
1197continue
1198
1199 ! オブジェクトのポインタ割付
1200 ! Associate pointer of an object
1201 !
1202 if ( present( date ) ) then
1203 datep => date
1204 else
1205 datep => default_date
1206 end if
1207
1208 if ( present( cal ) ) then
1209 calp => cal
1210 else
1211 calp => default_cal
1212 if ( .not. calp % initialized ) call default_cal_set
1213 end if
1214
1215 ! 初期設定のチェック
1216 ! Check initialization
1217 !
1218 result = 0.0
1219 if ( .not. datep % initialized ) return
1220 if ( .not. calp % initialized ) return
1221
1222 ! 経過時間を与えた場合の日時を取得
1223 ! Inquire date and time when elapse time is given
1224 !
1225 call dccaldateinquire( year, month, day, hour, min, sec, & ! (out)
1226 & elapse_sec = elapse_sec, date = date , cal = calp ) ! (in)
1227
1228 ! 年初めからの通日を取得
1229 ! Day of year is inquire
1230 !
1231 stat = dccaldate_ym2d( year, month, day, calp, & ! (in)
1232 & day_of_year ) ! (out)
1233
1234 ! 通秒へ変換
1235 ! Convert into sec of year
1236 !
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 &
1243 & + sec
1244
1245end function dccaldateevalsecofyear1
1246
1247!-----------------------------------------------------------
1248
1249function dccaldateevaldayofyear1( elapse_sec, date, cal ) result(result)
1250 ! 年始めからの通日を算出します.
1251 !
1252 ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
1253 ! 保持される日時が起点の日時として用いられます.
1254 ! *date* が省略されない場合にはその変数に設定された日時が
1255 ! 起点の日時として用いられます.
1256 !
1257 ! 省略可能引数 *cal* が省略された場合には, 経過秒数 *elapse_sec*
1258 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
1259 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
1260 !
1261 ! Evaluate day of year.
1262 !
1263 ! If an optional argument *date* is omitted,
1264 ! information of date that is stored in the "dc_calendar"
1265 ! is used as date of origin,
1266 ! If *date* is not omitted, information of the variable is used as
1267 ! date of origin.
1268 !
1269 ! If an optional argument *cal* is omitted,
1270 ! information of calendar that is stored in the "dc_calendar"
1271 ! is used for conversion of elapsed seconds *elapse_sec* into
1272 ! year-month-day etc.
1273 ! If *cal* is not omitted, information of the variable is used.
1274 !
1279 use dc_types, only: dp
1280 implicit none
1281 real(dp), intent(in):: elapse_sec
1282 ! *date* からの経過秒数.
1283 ! Elapsed seconds from *date*.
1284 type(dc_cal_date), intent(in), optional, target:: date
1285 ! 起点となる日時情報を収めたオブジェクト.
1286 !
1287 ! An object that stores information of
1288 ! date of origin.
1289 type(dc_cal), intent(in), optional, target:: cal
1290 ! 暦情報を収めたオブジェクト.
1291 !
1292 ! An object that stores information of
1293 ! calendar.
1294 real(dp):: result
1295 ! 年始めからの通日.
1296 ! Day of year.
1297
1298 ! 作業変数
1299 ! Work variables
1300 !
1301 integer:: year, month, day, hour, min
1302 real(dp):: sec
1303 integer:: stat
1304 type(dc_cal_date), pointer:: datep =>null()
1305 type(dc_cal), pointer:: calp =>null()
1306
1307continue
1308
1309 ! オブジェクトのポインタ割付
1310 ! Associate pointer of an object
1311 !
1312 if ( present( date ) ) then
1313 datep => date
1314 else
1315 datep => default_date
1316 end if
1317
1318 if ( present( cal ) ) then
1319 calp => cal
1320 else
1321 calp => default_cal
1322 if ( .not. calp % initialized ) call default_cal_set
1323 end if
1324
1325 ! 初期設定のチェック
1326 ! Check initialization
1327 !
1328 result = 0.0
1329 if ( .not. datep % initialized ) return
1330 if ( .not. calp % initialized ) return
1331
1332 ! 経過時間を与えた場合の日時を取得
1333 ! Inquire date and time when elapse time is given
1334 !
1335 call dccaldateinquire( year, month, day, hour, min, sec, & ! (out)
1336 & elapse_sec = elapse_sec, date = date , cal = calp ) ! (in)
1337
1338 ! 年初めからの通日を取得
1339 ! Day of year is inquire
1340 !
1341 stat = dccaldate_ym2d( year, month, day, calp, & ! (in)
1342 & result ) ! (out)
1343
1344end function dccaldateevaldayofyear1
1345
1346!-----------------------------------------------------------
1347
1348function dccaldateevalsecofday1( elapse_sec, date, cal ) result(result)
1349 ! 日始めからの通秒を算出します.
1350 !
1351 ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
1352 ! 保持される日時が起点の日時として用いられます.
1353 ! *date* が省略されない場合にはその変数に設定された日時が
1354 ! 起点の日時として用いられます.
1355 !
1356 ! 省略可能引数 *cal* が省略された場合には, 経過秒数 *elapse_sec*
1357 ! の年月日時分への変換に dc_calendar 内部で保持される暦が用いられます.
1358 ! *cal* が省略されない場合にはその変数に設定された暦が用いられます.
1359 !
1360 ! Evaluate second of day.
1361 !
1362 ! If an optional argument *date* is omitted,
1363 ! information of date that is stored in the "dc_calendar"
1364 ! is used as date of origin,
1365 ! If *date* is not omitted, information of the variable is used as
1366 ! date of origin.
1367 !
1368 ! If an optional argument *cal* is omitted,
1369 ! information of calendar that is stored in the "dc_calendar"
1370 ! is used for conversion of elapsed seconds *elapse_sec* into
1371 ! year-month-day etc.
1372 ! If *cal* is not omitted, information of the variable is used.
1373 !
1378 use dc_types, only: dp
1379 implicit none
1380 real(dp), intent(in):: elapse_sec
1381 ! *date* からの経過秒数.
1382 ! Elapsed seconds from *date*.
1383 type(dc_cal_date), intent(in), optional, target:: date
1384 ! 起点となる日時情報を収めたオブジェクト.
1385 !
1386 ! An object that stores information of
1387 ! date of origin.
1388 type(dc_cal), intent(in), optional, target:: cal
1389 ! 暦情報を収めたオブジェクト.
1390 !
1391 ! An object that stores information of
1392 ! calendar.
1393 real(dp):: result
1394 ! 日始めからの通秒.
1395 ! Second of day.
1396
1397 ! 作業変数
1398 ! Work variables
1399 !
1400 integer:: stat
1401 type(dc_cal_date), pointer:: datep =>null()
1402 type(dc_cal), pointer:: calp =>null()
1403 integer:: year, month, day, hour, min
1404 real(dp):: sec
1405continue
1406
1407 ! オブジェクトのポインタ割付
1408 ! Associate pointer of an object
1409 !
1410 if ( present( date ) ) then
1411 datep => date
1412 else
1413 datep => default_date
1414 end if
1415
1416 if ( present( cal ) ) then
1417 calp => cal
1418 else
1419 calp => default_cal
1420 if ( .not. calp % initialized ) call default_cal_set
1421 end if
1422
1423 ! 初期設定のチェック
1424 ! Check initialization
1425 !
1426 result = 0.0
1427 if ( .not. datep % initialized ) return
1428 if ( .not. calp % initialized ) return
1429
1430 ! 経過時間を与えた場合の日時を取得
1431 ! Inquire date and time when elapse time is given
1432 !
1433 call dccaldateinquire( year, month, day, hour, min, sec, & ! (out)
1434 & elapse_sec = elapse_sec, date = date , cal = calp ) ! (in)
1435
1436 ! 通秒へ変換
1437 ! Convert into sec of year
1438 !
1439 result = &
1440 & hour * calp % min_in_hour &
1441 & * calp % sec_in_min &
1442 & + min * calp % sec_in_min &
1443 & + sec
1444
1445end function dccaldateevalsecofday1
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)
Definition dc_error.f90:830
integer, parameter, public dc_ebadunit
Definition dc_error.f90:559
integer, parameter, public dc_enotinit
Definition dc_error.f90:557
integer, parameter, public dc_ealreadyinit
Definition dc_error.f90:558
integer, parameter, public dc_noerr
Definition dc_error.f90:509
integer, parameter, public dc_enegative
Definition dc_error.f90:568
integer, parameter, public dc_ebaddate
Definition dc_error.f90:575
integer, parameter, public dc_einconsistcaldate
Definition dc_error.f90:576
Provides kind type parameter values.
Definition dc_types.f90:49
integer, parameter, public token
Character length for word, token
Definition dc_types.f90:109
integer, parameter, public dp
Double Precision Real number
Definition dc_types.f90:83
integer, parameter, public string
Character length for string
Definition dc_types.f90:118