dccaldatecreate.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	dccaldatecreate1 (year, month, day, hour, min, sec, date, zone, err)
subroutine	dccaldatecreate2 (date_str, date, err)

Function/Subroutine Documentation

dccaldatecreate1()

subroutine dccaldatecreate1	(	integer, intent(in)	year,
		integer, intent(in)	month,
		integer, intent(in)	day,
		integer, intent(in)	hour,
		integer, intent(in)	min,
		real(dp), intent(in)	sec,
		type(dc_cal_date), intent(out), optional, target	date,
		character(*), intent(in), optional	zone,
		logical, intent(out), optional	err
	)

Definition at line 15 of file dccaldatecreate.f90.

  !
  ! 日時の設定を行います. 
  ! 
  ! YYYY-MM-DDThh:mm:ss.sTZD のような文字列 
  ! (YYYY は年, MM は月, DD は日, hh は時, mm は分, ss.s は秒,
  ! TZD はタイムゾーン) で指定する場合には
  ! 下記の同名のサブルーチンを使用して下さい. 
  !
  ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
  ! 保持される "dc_calendar_types#DC_CAL_DATE" 型の変数に日時が
  ! 設定されます. その後の手続きで *date* を省略した場合には
  ! この日時が使用されます. 
  ! *date* が省略されない場合にはその変数に日時が設定されます. 
  ! その日時を使用する場合, 手続きにその "dc_calendar_types#DC_CAL_DATE" 型の変数
  ! を与えてください. 
  !
  ! Set date. 
  !
  ! If a string like as "YYYY-MM-DDThh:mm:ss.sTZD"
  ! (YYYY is year, MM is month, DD is day, hh is hour, mm is minute, 
  ! ss.s is second, TZD is time zone) is used, 
  ! use a following homonymous subroutine. 
  !
  ! If an optional argument *date* is omitted, 
  ! the date setting is stored to a "dc_calendar_types#DC_CAL_DATE" 
  ! variable that is saved in the "dc_calendar". 
  ! When *date* is omitted in subsequent procedures, the internal date
  ! is used. 
  ! If *date* is not omitted, the settings is stored to the *date*. 
  ! In order to use the date setting, use the "dc_calendar_types#DC_CAL_DATE" 
  ! varieble to subsequent procedures. 
  !
 
 
  use dc_calendar_types, only: dc_cal_date
  use dc_calendar_internal, only: default_date
  use dc_regex, only: match
  use dc_message, only: messagenotify
  use dc_string, only: lchar
  use dc_trace, only: beginsub, endsub
  use dc_error, only: storeerror, dc_noerr, dc_ealreadyinit, dc_ebaddate
  use dc_types, only: string, dp
  implicit none
  integer, intent(in):: year  ! 年. Year.
  integer, intent(in):: month ! 月. Month.
  integer, intent(in):: day   ! 日. Day.
  integer, intent(in):: hour  ! 時. Hour.
  integer, intent(in):: min   ! 分. Minute.
  real(DP), intent(in):: sec  ! 秒. Second.
  type(DC_CAL_DATE), intent(out), optional, target:: date
                              ! 日時情報を収めたオブジェクト. 
                              ! 省略した場合には, デフォルトの日時として
                              ! 指定される. 
                              ! 
                              ! An object that stores information of 
                              ! date and time. 
                              ! If this is omitted, these information is 
                              ! set as default date and time. 
  character(*), intent(in), optional:: zone
                              ! UTC からの時差. Time-zone. 
  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
  !
  type(DC_CAL_DATE), pointer:: datep =>null()
  integer:: start, length
  integer:: stat
  character(STRING):: cause_c
  character(*), parameter:: version = &
    & '$Name:  $' // &
    & '$Id: dccaldatecreate.f90,v 1.3 2010-09-24 07:07:31 morikawa Exp $'
  character(*), parameter:: subname = 'DCCalDateCreate1'
continue
  call beginsub( subname, version )
  stat = dc_noerr
  cause_c = ''
 
  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( date ) ) then
    datep => date
  else
    datep => default_date
  end if
 
!!$  ! 初期設定のチェック
!!$  ! Check initialization
!!$  !
!!$  if ( datep % initialized ) then
!!$    stat = DC_EALREADYINIT
!!$    cause_c = 'DC_CAL_DATE'
!!$    goto 999
!!$  end if
 
  ! 日時の正当性のチェック
  ! Validate date and time
  !
!!$  if ( year < 1 ) then
!!$    stat = DC_EBADDATE
!!$    call MessageNotify('W', subname, 'year=<%d> must be natural number', &
!!$      & i = (/ year /) )
!!$    goto 999
!!$  end if
 
  if ( month < 1 ) then
    stat = dc_ebaddate
    call messagenotify('W', subname, 'month=<%d> must be natural number', &
      & i = (/ month /) )
    goto 999
  end if
 
  if ( day < 1 ) then
    stat = dc_ebaddate
    call messagenotify('W', subname, 'day=<%d> must be natural number', &
      & i = (/ day /) )
    goto 999
  end if
 
  if ( hour < 0 ) then
    stat = dc_ebaddate
    call messagenotify('W', subname, 'hour=<%d> must not be negative', &
      & i = (/ hour /) )
    goto 999
  end if
 
  if ( min < 0 ) then
    stat = dc_ebaddate
    call messagenotify('W', subname, 'min=<%d> must not be negative', &
      & i = (/ min /) )
    goto 999
  end if
 
  if ( sec < 0.0_dp ) then
    stat = dc_ebaddate
    call messagenotify('W', subname, 'sec=<%f> must not be negative', &
      & d = (/ sec /) )
    goto 999
  end if
 
  call match( '^[#+-]#d+:#d+$', zone, & ! (in)
    &         start, length )           ! (out)
  if ( length > 0 ) then
    datep % zone = zone
  else
    datep % zone = ''
  end if
 
  ! 各要素への値の設定
  ! Configure elements
  !
  datep % year  = year
  datep % month = month
  datep % day   = day
  datep % hour  = hour
  datep % min   = min
  datep % sec   = sec
 
  ! 終了処理, 例外処理
  ! Termination and Exception handling
  !
  datep % initialized = .true.
999 continue
  nullify( datep )
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )

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

Here is the call graph for this function:

dccaldatecreate2()

subroutine dccaldatecreate2	(	character(*), intent(in)	date_str,
		type(dc_cal_date), intent(out), optional, target	date,
		logical, intent(out), optional	err
	)

Definition at line 199 of file dccaldatecreate.f90.

  !
  ! 日時の設定を行います. 
  ! 
  ! *date_str* に YYYY-MM-DDThh:mm:ss.sTZD の形式の文字列 
  ! (YYYY は年, MM は月, DD は日, hh は時, mm は分, ss.s は秒,
  ! TZD はタイムゾーン) を指定してください. 
  ! 年月日時分秒を各個変数で指定する場合には
  ! 上記の同名のサブルーチンを使用して下さい. 
  ! 日時の文字列形式は 
  ! gtool4 netCDF 規約「5.5 日時形式」に準拠しています. 
  ! 
  ! "s since 2009-06-17T11:23:45+09:00" のような文字列を与えた場合には, 
  ! "s since " の部分をサブルーチン内で自動的に切り取って, 
  ! "2009-06-17T11:23:45+09:00" の部分を設定します. 
  !
  ! 省略可能引数 *date* が省略された場合には, dc_calendar 内部で
  ! 保持される "dc_calendar_types#DC_CAL_DATE" 型の変数に日時が
  ! 設定されます. その後の手続きで *date* を省略した場合には
  ! この日時が使用されます. 
  ! *date* が省略されない場合にはその変数に日時が設定されます. 
  ! その日時を使用する場合, 手続きにその "dc_calendar_types#DC_CAL_DATE" 型の変数
  ! を与えてください. 
  !
  ! Set date. 
  !
  ! Specify a string like as "YYYY-MM-DDThh:mm:ss.sTZD"
  ! (YYYY is year, MM is month, DD is day, hh is hour, mm is minute, 
  ! ss.s is second, TZD is time zone). 
  ! If individual variables (year, month, day, hour, minute, second, zone) 
  ! are used, use a foregoing homonymous subroutine. 
  ! Format of date is conformed to gtool4 netCDF Convention "5.5 Expression of date and time" 
  !
  ! If a string like as "s since 2009-06-17T11:23:45+09:00" is specified, 
  ! A part "s since " is truncated automatically, and 
  ! a part "2009-06-17T11:23:45+09:00" is set. 
  !
  ! If an optional argument *date* is omitted, 
  ! the date setting is stored to a "dc_calendar_types#DC_CAL_DATE" 
  ! variable that is saved in the "dc_calendar". 
  ! When *date* is omitted in subsequent procedures, the internal date
  ! is used. 
  ! If *date* is not omitted, the settings is stored to the *date*. 
  ! In order to use the date setting, use the "dc_calendar_types#DC_CAL_DATE" 
  ! varieble to subsequent procedures. 
  !
  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
  character(*), intent(in):: date_str
                              ! 日時情報を表す文字列. 
                              ! 表示形式については gtool4 netCDF 規約
                              ! 5.5 日時形式を参照のこと. 
                              ! 
                              ! Strings that express date and time. 
                              ! See gtool4 netCDF Convention 
                              ! 5.5 Expression of date and time for details. 
  type(DC_CAL_DATE), intent(out), optional, target:: date
                              ! 日時情報を収めたオブジェクト. 
                              ! 省略した場合には, デフォルトの日時として
                              ! 指定される. 
                              ! 
                              ! An object that stores information of 
                              ! date and time. 
                              ! If this is omitted, these information is 
                              ! set as default date and 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
  !
  type(DC_CAL_DATE), pointer:: datep =>null()
  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:: version = &
    & '$Name:  $' // &
    & '$Id: dccaldatecreate.f90,v 1.3 2010-09-24 07:07:31 morikawa Exp $'
  character(*), parameter:: subname = 'DCCalDateCreate2'
continue
  call beginsub( subname, version )
  stat = dc_noerr
  cause_c = ''
 
  ! オブジェクトのポインタ割付
  ! Associate pointer of an object
  !
  if ( present( date ) ) then
    datep => date
  else
    datep => default_date
  end if
 
!!$  ! 初期設定のチェック
!!$  ! Check initialization
!!$  !
!!$  if ( datep % initialized ) then
!!$    stat = DC_EALREADYINIT
!!$    cause_c = 'DC_CAL_DATE'
!!$    goto 999
!!$  end if
 
  ! 日時を表現した文字列の解釈
  ! Parse strings that express date and time
  !
  call dccaldateparsestr( date_str, &           ! (in)
    & year, month, day, hour, min, sec, zone, & ! (out)
    & err = err )                               ! (out) optional
  if ( present(err) ) then
    if ( err ) then
      stat = dc_ebaddate
      goto 999
    end if
  end if
 
  ! オブジェクトの作成
  ! Create an object
  !
  call dccaldatecreate( &
    & year, month, day, hour, min, sec, & ! (in)
    & datep, 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
  nullify( datep )
  call storeerror( stat, subname, err, cause_c )
  call endsub( subname )

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.

Here is the call graph for this function: