dccaldatecurrent.f90

Go to the documentation of this file.

! -*- mode: f90; coding: utf-8 -*-
!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
!>
!> @author    Yasuhiro MORIKAWA
!> @copyright Copyright (C) GFD Dennou Club, 2009-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. see [COPYRIGHT](@ref COPYRIGHT) in detail
!> @en
!> @brief Get current date and time
!> @details
!> Procedures described in this file are provided from "dc_calendar" module.
!> @enden
!>
!> @ja
!> @brief 現在日時の取得
!> @details
!> このファイルに記載される手続き群は dc_calendar モジュールから提供されます.
!> @endja
!>
 
!> @en
!> @brief Get current actual time
!> @details
!> 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.
!>
!> @param[out] date An object that stores information of date and time of actual time.
!> @param[out] err 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.
!> @enden
!>
!> @ja
!> @brief 実時間の現在日時を取得
!> @details
!> 実時間を dc_calendar_types#DC_CAL_DATE 型の
!> date に返します.
!> 実時間は Fortran 90 以降の組み込みサブルーチンである
!> date_and_time から得られます.
!>
!> @param[out] date 実時間の日時情報を収めたオブジェクト.
!> @param[out] err 例外処理用フラグ.
!>                 デフォルトでは, この手続き内でエラーが生じた場合,
!>                 プログラムは強制終了します.
!>                 引数 `err` が与えられる場合, プログラムは強制終了せず,
!>                 代わりに `err` に .true. が代入されます.
!> @endja
subroutine dccaldatecurrent1( date, err )
  use dc_calendar_generic, only: dccaldatecreate
  use dc_calendar_types, only: dc_cal_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_ebaddate
  use dc_types, only: string
  implicit none
  type(dc_cal_date), intent(out):: date
  logical, intent(out), optional:: err
 
  ! 作業変数
  ! Work variables
  !
  integer :: date_time_values(1:8)
  character(5)  :: zone_raw
 
  character(TOKEN):: 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 )
end subroutine dccaldatecurrent1