dccalconvertbyunit.f90

Go to the documentation of this file.

! -*- mode: f90; coding: utf-8 -*-
!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
 
function dccalconvertbyunit1( in_time, in_unit, out_unit, cal ) result( out_time )
 
  use dc_calendar_internal, only: default_cal, default_cal_set, &
    & dccaldate_str2usym
  use dc_calendar_types, only: dc_cal
  use dc_calendar_generic, only: dccalconvertbyunit
  use dc_message, only: messagenotify
  use dc_types, only: dp
  implicit none
  real(dp):: out_time
  real(dp), intent(in):: in_time
  character(*), intent(in):: in_unit
  character(*), intent(in):: out_unit
  type(dc_cal), intent(in), optional, target:: cal
 
  ! 作業変数
  ! Work variables
  !
  type(dc_cal), pointer:: calp =>null()
  integer:: in_unit_sym, out_unit_sym
  character(*), parameter:: subname = 'DCCalConvertByUnit1'
continue
 
  out_time = -1.0
 
  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( cal ) ) then
    calp => cal
  else
    calp => default_cal
    if ( .not. calp % initialized ) call default_cal_set
  end if
 
  ! 初期設定のチェック
  ! Check initialization
  !
  if ( .not. calp % initialized ) then
    call messagenotify('W', subname, '"cal" is not initialized. <-1> is returned.' )
    goto 999
  end if
 
  ! 単位の解釈
  ! Parse units
  !
  in_unit_sym  = dccaldate_str2usym( in_unit )
  out_unit_sym = dccaldate_str2usym( out_unit )
 
  ! 数値の変換
  ! Convert a value
  !
  out_time = dccalconvertbyunit( in_time, in_unit_sym, out_unit_sym, cal )
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
999 continue
  nullify( calp )
end function dccalconvertbyunit1
 
!---------------------------------------------------------------------
 
function dccalconvertbyunit2( in_time, in_unit, out_unit, cal ) result( out_time )
 
  use dc_calendar_internal, only: default_cal, default_cal_set
  use dc_calendar_types, only: dc_cal, &
    & unit_symbol_day, unit_symbol_hour, unit_symbol_min, unit_symbol_sec
  use dc_message, only: messagenotify
  use dc_types, only: dp
  implicit none
  real(dp):: out_time
  real(dp), intent(in):: in_time
  integer, intent(in):: in_unit
  integer, intent(in):: out_unit
  type(dc_cal), intent(in), optional, target:: cal
 
  ! 作業変数
  ! Work variables
  !
  type(dc_cal), pointer:: calp =>null()
  real(dp):: in_timew
  character(*), parameter:: subname = 'DCCalConvertByUnit2'
continue
 
  out_time = -1.0
 
  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( cal ) ) then
    calp => cal
  else
    calp => default_cal
    if ( .not. calp % initialized ) call default_cal_set
  end if
 
  ! 初期設定のチェック
  ! Check initialization
  !
  if ( .not. calp % initialized ) then
    call messagenotify('W', subname, '"cal" is not initialized. <-1> is returned.' )
    goto 999
  end if
 
  ! 数値の変換
  ! Convert a value
  !
  select case(in_unit)
  case(unit_symbol_day)
    in_timew = in_time * calp % hour_in_day &
      &                * calp % min_in_hour &
      &                * calp % sec_in_min
  case(unit_symbol_hour)
    in_timew = in_time * calp % min_in_hour &
      &                * calp % sec_in_min
  case(unit_symbol_min)
    in_timew = in_time * calp % sec_in_min
  case(unit_symbol_sec)
    in_timew = in_time
  case default
    call messagenotify('W', subname, 'in_unit=<%d> is invalid. (ONLY day,hour,min,sec are valid).'  // &
      & ' <-1> is returned.', &
      & i = (/ in_unit /) )
    goto 999
  end select
 
  select case(out_unit)
  case(unit_symbol_day)
    out_time = in_timew / calp % hour_in_day &
      &                 / calp % min_in_hour &
      &                 / calp % sec_in_min
  case(unit_symbol_hour)
    out_time = in_timew / calp % min_in_hour &
      &                 / calp % sec_in_min
  case(unit_symbol_min)
    out_time = in_timew / calp % sec_in_min
  case(unit_symbol_sec)
    out_time = in_timew
  case default
    call messagenotify('W', subname, 'out_unit=<%d> is invalid. (ONLY day,hour,min,sec are valid).'  // &
      & ' <-1> is returned.', &
      & i = (/ out_unit /) )
    goto 999
  end select
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
999 continue
  nullify( calp )
end function dccalconvertbyunit2