dccalcreate.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	dccalcreate1 (cal_type, cal, err)
	Calendar creation procedures.
subroutine	dccalcreate2 (month_in_year, day_in_month, hour_in_day, min_in_hour, sec_in_min, cal, err)

Function/Subroutine Documentation

dccalcreate1()

subroutine dccalcreate1	(	character(*), intent(in)	cal_type,
		type(dc_cal), intent(out), optional, target	cal,
		logical, intent(out), optional	err
	)

Calendar creation procedures.

Author

Youhei SASAKI, Yasuhiro MORIKAWA

Copyright

Copyright (C) GFD Dennou Club, 2009-2026. All rights reserved.
License is BSD-2-Clause. see COPYRIGHT in detail

Definition at line 93 of file dccalcreate.f90.

 
  use dc_calendar_types, only: dc_cal, &
    & cal_cyclic, cal_noleap, cal_julian, cal_gregorian, cal_360day
  use dc_calendar_internal, only: default_cal
  use dc_message, only: messagenotify
  use dc_string, only: lchar
  use dc_trace, only: beginsub, endsub
  use dc_error, only: storeerror, dc_noerr, dc_ebadcaltype
  use dc_types, only: string, dp
  implicit none
  character(*), intent(in):: cal_type
  type(DC_CAL), intent(out), optional, target:: cal
  logical, intent(out), optional:: err
 
  ! 作業変数
  ! Work variables
  !
  type(DC_CAL), pointer:: calp =>null()
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: version = &
    & '$Name:  $' // &
    & '$Id: dccalcreate.f90,v 1.4 2009-10-18 12:02:32 morikawa Exp $'
  character(*), parameter:: subname = 'DCCalCreate1'
continue
  call beginsub( subname, version )
  stat = dc_noerr
  cause_c = ''
 
  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( cal ) ) then
    calp => cal
  else
    calp => default_cal
  end if
 
  ! 暦の種別の正当性のチェック
  ! Validate a kind of calendar
  !
  select case( lchar(trim(cal_type)) )
  case('cyclic')
    calp % cal_type = cal_cyclic
  case('noleap')
    calp % cal_type = cal_noleap
  case('julian')
    calp % cal_type = cal_julian
  case('gregorian')
    calp % cal_type = cal_gregorian
  case('360day')
    calp % cal_type = cal_360day
  case default
    stat = dc_ebadcaltype
    call messagenotify('W', subname, &
      & 'cal_type=<%c> is invalid calender type.', &
      & c1 = trim(cal_type) )
    goto 999
  end select
 
  ! 各要素への値の設定
  ! Configure elements
  !
  allocate( calp % day_in_month(1:12) )
  calp % month_in_year = 12
  calp % hour_in_day   = 24
  calp % min_in_hour   = 60
  calp % sec_in_min    = 60.0_dp
 
  select case( calp % cal_type )
  case(cal_cyclic)
    calp % day_in_month(1:12) = &
      & (/ 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31, 30 /)
  case(cal_noleap)
    calp % day_in_month(1:12) = &
      & (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
  case(cal_julian)
    calp % day_in_month(1:12) = &
      & (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
  case(cal_gregorian)
    calp % day_in_month(1:12) = &
      & (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
  case(cal_360day)
    calp % day_in_month(1:12) = &
      & (/ 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30 /)
  case default
  end select
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
  calp % initialized = .true.
999 continue
  nullify( calp )
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )

References dc_trace::beginsub(), dc_calendar_types::cal_360day, dc_calendar_types::cal_cyclic, dc_calendar_types::cal_gregorian, dc_calendar_types::cal_julian, dc_calendar_types::cal_noleap, dc_error::dc_ebadcaltype, dc_error::dc_noerr, dc_calendar_internal::default_cal, dc_types::dp, dc_trace::endsub(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

dccalcreate2()

subroutine dccalcreate2	(	integer, intent(in)	month_in_year,
		integer, dimension(:), intent(in)	day_in_month,
		integer, intent(in)	hour_in_day,
		integer, intent(in)	min_in_hour,
		real(dp), intent(in)	sec_in_min,
		type(dc_cal), intent(out), optional, target	cal,
		logical, intent(out), optional	err
	)

Create calendar with custom settings

Set calendar.

Specify number of days of a month, number of seconds of a day, etc. to arguments. If Gregorian calendar, Julian calendar are needed, see a foregoing homonymous subroutine.

If an optional argument cal is omitted. The calendar setting is stored to a "dc_calendar_types#DC_CAL" variable that is saved in the "dc_calendar". When cal is omitted in subsequent procedures, the internal calendar is used. If cal is not omitted, the settings is stored to the cal. In order to use the calendar setting, use the "dc_calendar_types#DC_CAL" variable to subsequent procedures.

Parameters

[in]	month_in_year	Months in a year
[in]	day_in_month	Days in months (array)
[in]	hour_in_day	Hours in a day
[in]	min_in_hour	Minutes in an hour
[in]	sec_in_min	Seconds in a minute
[out]	cal	An object that stores information of calendar
[out]	err	Exception handling flag

Definition at line 248 of file dccalcreate.f90.

 
  use dc_calendar_types, only: dc_cal, cal_user_defined
  use dc_calendar_internal, only: default_cal
  use dc_message, only: messagenotify
  use dc_types, only: dp
  use dc_trace, only: beginsub, endsub
  use dc_error, only: storeerror, dc_noerr, dc_ebadcaltype
  use dc_types, only: string
  implicit none
  integer, intent(in):: month_in_year
  integer, intent(in):: day_in_month(:)
  integer, intent(in):: hour_in_day
  integer, intent(in):: min_in_hour
  real(DP), intent(in):: sec_in_min
  type(DC_CAL), intent(out), optional, target:: cal
  logical, intent(out), optional:: err
 
  ! 作業変数
  ! Work variables
  !
  type(DC_CAL), pointer:: calp =>null()
  integer:: size_day_in_month
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: version = &
    & '$Name:  $' // &
    & '$Id: dccalcreate.f90,v 1.4 2009-10-18 12:02:32 morikawa Exp $'
  character(*), parameter:: subname = 'DCCalCreate2'
continue
  call beginsub( subname, version )
  stat = dc_noerr
  cause_c = ''
 
  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( cal ) ) then
    calp => cal
  else
    calp => default_cal
  end if
 
  ! 月数の算出
  ! Evaluate number of months
  !
  size_day_in_month = size ( day_in_month )
 
  ! 引数の正当性のチェック
  ! Validate arguments
  !
  if ( .not. month_in_year == size_day_in_month ) then
    stat = dc_ebadcaltype
    call messagenotify('W', subname, &
      & 'month_in_year=<%d> is not equal to size of day_in_month=<%d>', &
      & i = (/ month_in_year, size_day_in_month /) )
    goto 999
  end if
 
  if ( month_in_year < 1 ) then
    stat = dc_ebadcaltype
    call messagenotify('W', subname, 'month_in_year=<%d> must be positive', &
      & i = (/ month_in_year /) )
    goto 999
  end if
 
  if ( hour_in_day < 1 ) then
    stat = dc_ebadcaltype
    call messagenotify('W', subname, 'hour_in_day=<%d> must be positive', &
      & i = (/ hour_in_day /) )
    goto 999
  end if
 
  if ( min_in_hour < 1 ) then
    stat = dc_ebadcaltype
    call messagenotify('W', subname, 'min_in_hour=<%d> must be positive', &
      & i = (/ min_in_hour /) )
    goto 999
  end if
 
  if ( .not. sec_in_min > 0.0_dp ) then
    stat = dc_ebadcaltype
    call messagenotify('W', subname, 'sec_in_min=<%f> must be positive', &
      & d = (/ sec_in_min /) )
    goto 999
  end if
 
  ! 各要素への値の設定
  ! Configure elements
  !
  calp % cal_type      = cal_user_defined
  calp % month_in_year = month_in_year
  allocate( calp % day_in_month(1:size_day_in_month) )
  calp % day_in_month  = day_in_month
  calp % hour_in_day   = hour_in_day
  calp % min_in_hour   = min_in_hour
  calp % sec_in_min    = sec_in_min
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
  calp % initialized = .true.
999 continue
  nullify( calp )
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )

References dc_trace::beginsub(), dc_calendar_types::cal_user_defined, dc_error::dc_ebadcaltype, dc_error::dc_noerr, dc_calendar_internal::default_cal, dc_types::dp, dc_trace::endsub(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function: