dccaldatecurrent.f90

subroutine DCCalDateCurrent1( date, err )
  !
  ! 実時間を 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), date_time_values(5), date_time_values(6), real( date_time_values(7), DP ), 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 )
end subroutine DCCalDateCurrent1