dccaldatecurrent.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	dccaldatecurrent1 (date, err)

Function/Subroutine Documentation

dccaldatecurrent1()

subroutine dccaldatecurrent1	(	type(dc_cal_date), intent(out)	date,
		logical, intent(out), optional	err
	)

Definition at line 2 of file dccaldatecurrent.f90.

References dc_error::dc_ealreadyinit, dc_error::dc_ebaddate, dc_error::dc_noerr, dc_calendar_internal::default_date, dc_types::dp, dc_error::storeerror(), dc_types::string, and dc_types::token.

  !
  ! 実時間を dc_calendar_types#DC_CAL_DATE 型の
  ! date に返します. 
  ! 実時間は Fortran 90 以降の組み込みサブルーチンである 
  ! date_and_time から得られます. 
  !
  ! Return actual time +date+ (type "dc_calendar_types#DC_CAL_DATE"). 
  ! The actual time is acquired by "date_and_time" that is 
  ! a built-in subroutine of Fortran 90 or more. 
  !
  use dc_calendar_generic, only: dccaldateparsestr, dccaldatecreate
  use dc_calendar_types, only: dc_cal_date
  use dc_calendar_internal, only: default_date
  use dc_message, only: messagenotify
  use dc_types, only: dp, token
  use dc_trace, only: beginsub, endsub
  use dc_error, only: storeerror, dc_noerr, dc_ealreadyinit, dc_ebaddate
  use dc_types, only: string
  implicit none
  type(dc_cal_date), intent(out):: date
                              ! 実時間の日時情報を収めたオブジェクト. 
                              ! 
                              ! An object that stores information of 
                              ! date and time of actual time. 
  logical, intent(out), optional:: err
                              ! 例外処理用フラグ. 
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します. 
                              ! 引数 *err* が与えられる場合, 
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます. 
                              !
                              ! Exception handling flag. 
                              ! By default, when error occur in 
                              ! this procedure, the program aborts. 
                              ! If this *err* argument is given, 
                              ! .true. is substituted to *err* and 
                              ! the program does not abort. 


  ! 作業変数
  ! Work variables
  !
  integer :: date_time_values(1:8)
  character(5)  :: zone_raw

  integer:: year  ! 年. Year.
  integer:: month ! 月. Month.
  integer:: day   ! 日. Day.
  integer:: hour  ! 時. Hour.
  integer:: min   ! 分. Minute.
  real(DP):: sec  ! 秒. Second.
  character(TOKEN):: zone
                  ! UTC からの時差. Time-zone.
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: subname = 'DCCalDateCurrent1'
continue
  call beginsub( subname )
  stat = dc_noerr
  cause_c = ''

!!$  ! 初期設定のチェック
!!$  ! Check initialization
!!$  !
!!$  if ( datep % initialized ) then
!!$    stat = DC_EALREADYINIT
!!$    cause_c = 'DC_CAL_DATE'
!!$    goto 999
!!$  end if


  ! date_and_time 組み込みサブルーチンを用いて, 現在
  ! 時刻と UTC からの時差を取得. 
  !
  call date_and_time(zone=zone_raw, values=date_time_values)
  zone = zone_raw(1:3) // ":" // zone_raw(4:5)


  ! オブジェクトの作成
  ! Create an object
  !
  call dccaldatecreate( &
    & date_time_values(1), date_time_values(2), date_time_values(3), & ! (in)
    & date_time_values(5), date_time_values(6), &                      ! (in)
    & real( date_time_values(7), DP ), & ! (in)
    & date, zone, err = err )            ! (out) optional
  if ( present(err) ) then
    if ( err ) then
      stat = dc_ebaddate
      goto 999
    end if
  end if

  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
999 continue
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )

Here is the call graph for this function: