gtool_history_internal Module Reference

Data Types
interface	append_attrs
interface	copy_attrs
interface	lookup_dimension
interface	lookup_var_or_dim
interface	lookup_variable
interface	lookup_variable_ord
interface	set_fake_dim_value

Functions/Subroutines
subroutine, public	append_attrs (varname, attrs, history)
subroutine, public	copy_attrs (from, to, err)
subroutine, public	set_fake_dim_value (history, dimord)
integer function, public	lookup_variable_ord (history, varname)
type(gt_variable) function, public	lookup_variable (history, varname, ord)
type(gt_variable) function, public	lookup_dimension (history, dimname, ord)
subroutine, public	lookup_var_or_dim (history, name, var, err)

Variables
type(gt_history), target, save, public	default
character(string), parameter, public	gtool4_netcdf_conventions = "http://www.gfd-dennou.org/library/gtool4/conventions/"
character(string), parameter, public	gtool4_netcdf_version = "4.3"

Function/Subroutine Documentation

append_attrs()

subroutine, public gtool_history_internal::append_attrs	(	character(*), intent(in)	varname,
		type(gt_history_attr), dimension(:), intent(in)	attrs,
		type(gt_history), intent(inout), optional, target	history
	)

Definition at line 91 of file gtool_history_internal.f90.

References dc_trace::beginsub(), dc_trace::dbgmessage(), default, and dc_trace::endsub().

    !
    ! GT_HISTORY_ATTR 変数を history の varname 変数に
    ! 付加するためのサブルーチン. 公開用ではなく,
    ! HistoryCreate や HistoryAddVariable に GT_HISTORY_AXIS
    ! や GT_HISTORY_VARINFO が与えられた時に内部的に利用される.
    !
    use gtool_history_generic, only: historyaddattr
    use gtdata_generic, only: put_attr
    use dc_trace, only: beginsub, endsub, dbgmessage
    use dc_string     , only: strhead, lchar, tochar
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr
    implicit none
    character(*),     intent(in):: varname
    type(gt_history_attr),  intent(in):: attrs(:)
    type(gt_history), intent(inout), target, optional:: history
    type(gt_history), pointer:: hst =>null()
    integer                      :: i
    character(*), parameter:: subname = "append_attrs"
  continue
    call beginsub(subname, 'varname=<%c>, size(attrs(:))=<%d>', &
      &        c1=trim(varname), i=(/size(attrs(:))/))
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    ! attrs(:) のサイズ分だけループ
    do i = 1, size( attrs(:) )
      ! attrs(i)%attrtype の種別で与える変数を変える
      if ( strhead( 'char', trim(lchar(attrs(i)%attrtype))) ) then
        call historyaddattr( &
          & varname, attrs(i)%attrname, &
          & trim(attrs(i)%Charvalue), hst )
      elseif ( strhead( 'int', trim(lchar(attrs(i)%attrtype))) ) then
        if ( attrs(i)%array ) then
          call dbgmessage('Intarray(:) is selected.')
          call historyaddattr( &
            & varname, attrs(i)%attrname , &
            & attrs(i)%Intarray, hst       )
        else
          call dbgmessage('Intvalue is selected')
          call historyaddattr( &
            & varname, attrs(i)%attrname , &
            & attrs(i)%Intvalue, hst      )
        endif
      elseif ( strhead( 'real', trim(lchar(attrs(i)%attrtype))) ) then
        if ( attrs(i)%array ) then
          call dbgmessage('Realarray(:) is selected.')
          call historyaddattr( &
            & varname, attrs(i)%attrname, attrs(i)%Realarray, hst)
        else
          call dbgmessage('Realvalue is selected')
          call historyaddattr( &
            & varname, attrs(i)%attrname, attrs(i)%Realvalue, hst)
        endif
      elseif ( strhead( 'double', trim(lchar(attrs(i)%attrtype))) ) then
        if ( attrs(i)%array ) then
          call dbgmessage('Doublearray(:) is selected.')
          call historyaddattr( &
            & varname, attrs(i)%attrname, attrs(i)%Doublearray, hst)
        else
          call dbgmessage('Doublevalue is selected')
          call historyaddattr( &
            & varname, attrs(i)%attrname, attrs(i)%Doublevalue, hst)
        endif
      elseif ( strhead( 'logical', trim(lchar(attrs(i)%attrtype))) ) then
        call historyaddattr( &
          & varname, attrs(i)%attrname, attrs(i)%Logicalvalue, hst)
      else
        call dbgmessage('attrtype=<%c>=<%c>is Invalid.'   , &
          &      c1=trim(attrs(i)%attrtype)         , &
          &      c2=trim(lchar(attrs(i)%attrtype))      )
      endif
    enddo
    call endsub(subname)

Here is the call graph for this function:

copy_attrs()

subroutine, public gtool_history_internal::copy_attrs	(	type(gt_history_attr), dimension(:), intent(in)	from,
		type(gt_history_attr), dimension(:), intent(out)	to,
		logical, intent(out), optional	err
	)

Definition at line 168 of file gtool_history_internal.f90.

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_noerr, dc_trace::endsub(), dc_error::gt_eargsizemismatch, dc_error::gt_ebadattrname, dc_error::storeerror(), dc_types::string, and dc_types::token.

    !
    ! GT_HISTORY_ATTR 変数をコピーするためのサブルーチン
    ! このモジュール内部で利用されることを想定している.
    ! from と to の配列サイズは同じであることが想定されている.
    ! err を与えると, コピーの際何らかの不具合が生じると
    ! 終了せずに err が真になって返る.
    !
    use dc_string,only: lchar, strhead
    use dc_trace, only: beginsub, endsub, dbgmessage
    use dc_error, only: storeerror, &
      &  gt_eargsizemismatch, gt_ebadattrname, dc_noerr
    use dc_types, only: string, token
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr
    implicit none
    type(gt_history_attr), intent(in)  :: from(:)
    type(gt_history_attr), intent(out) :: to(:)
    logical,               intent(out), optional :: err
    integer     :: i, stat
    character(STRING) :: cause_c
    character(STRING), parameter:: subname = "copy_attrs"
  continue
    call beginsub(subname)
    stat = dc_noerr
    cause_c = ''
    call dbgmessage('size(from)=<%d>, size(to)=<%d>, So copy <%d> times.', &
      &       i=(/ size(from), size(to), min(size(from),size(to)) /) )
    if ( size(to) < size(from) ) then
      stat = gt_eargsizemismatch
      cause_c = 'from is larger than to'
      goto 999
    end if
    ! from と to の小さい方に合わせてループ
    do i = 1, min( size(from), size(to) )
      ! attrname と attrtype と array はまずコピー
      to(i)%attrname       = from(i)%attrname
      to(i)%attrtype       = from(i)%attrtype
      to(i)%array          = from(i)%array
      ! from(i)%attrtype の種別でコピーする変数を変える.
      if ( strhead( 'char', trim(lchar(from(i)%attrtype))) ) then
        to(i)%Charvalue      = from(i)%Charvalue
                          elseif ( strhead( &
        &   lchar('Int'), trim(lchar(from(i)%attrtype)))) then
        if ( from(i)%array ) then
          allocate(  to(i)%Intarray( size(from(i)%Intarray) )  )
          to(i)%Intarray = from(i)%Intarray
        else
          to(i)%Intvalue = from(i)%Intvalue
        endif
      elseif ( strhead( &
        &   lchar('Real'), trim(lchar(from(i)%attrtype)))) then
        if ( from(i)%array ) then
          allocate(  to(i)%Realarray( size(from(i)%Realarray) )  )
          to(i)%Realarray = from(i)%Realarray
        else
          to(i)%Realvalue = from(i)%Realvalue
        endif
      elseif ( strhead( &
        &   lchar('Double'), trim(lchar(from(i)%attrtype)))) then
        if ( from(i)%array ) then
          allocate(  to(i)%Doublearray( size(from(i)%Doublearray) )  )
          to(i)%Doublearray = from(i)%Doublearray
        else
          to(i)%Doublevalue = from(i)%Doublevalue
        endif
      elseif ( strhead( 'logical', trim(lchar(from(i)%attrtype))) ) then
        to(i)%Logicalvalue = from(i)%Logicalvalue
      else
        stat = gt_ebadattrname
        cause_c = from(i)%attrtype
        goto 999
      endif
    enddo
999 continue
    call storeerror(stat, subname, err, cause_c=cause_c)
    call endsub(subname)

Here is the call graph for this function:

lookup_dimension()

type(gt_variable) function, public gtool_history_internal::lookup_dimension	(	type(gt_history), intent(in)	history,
		character(len = *), intent(in)	dimname,
		integer, intent(out), optional	ord
	)

Definition at line 357 of file gtool_history_internal.f90.

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_noerr, dc_trace::endsub(), dc_error::gt_ebaddimname, dc_error::storeerror(), and dc_types::string.

    !
    ! history 内の dimname という変数名を持つ次元の GT_VARIABLE
    ! 変数を返す. dimname 末尾の空白は無視される.
    !
    use gtdata_generic, only: inquire
    use dc_types, only: string
    use dc_error, only: storeerror, gt_ebaddimname, dc_noerr
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    type(gt_history), intent(in):: history
    character(len = *), intent(in):: dimname
    integer, intent(out), optional:: ord
    integer:: ordwork
    character(len = STRING):: name, cause_c
    integer:: i, stat
    character(len = *), parameter:: subname = 'lookup_dimension'
  continue
    call beginsub(subname, 'dimname=%c', c1=trim(dimname))
    stat = dc_noerr
    if (present(ord)) ord = 0
    ordwork = 0
    if (associated(history % dimvars)) then
      do, i = 1, size(history % dimvars)
        call inquire(history % dimvars(i), name=name)
        if (name == trim(dimname)) then
          result = history % dimvars(i)
          if (present(ord)) ord = i
          stat = dc_noerr
          cause_c = ""
          goto 999
        endif
      enddo
    endif
    if (present(ord)) then
      ord = 0
    else
      stat = gt_ebaddimname
      cause_c = dimname
    endif
999 continue
    call storeerror(stat, subname, cause_c=cause_c)
    if (present(ord)) ordwork = ord
    call endsub(subname, 'ord=%d (0:not found)', i=(/ordwork/))

Here is the call graph for this function:

lookup_var_or_dim()

subroutine, public gtool_history_internal::lookup_var_or_dim	(	type(gt_history), intent(in)	history,
		character(len = *), intent(in)	name,
		type(gt_variable), intent(out)	var,
		logical, intent(out)	err
	)

Definition at line 402 of file gtool_history_internal.f90.

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_noerr, dc_trace::endsub(), dc_error::storeerror(), and dc_types::string.

    !
    ! history 内から, name という名前の次元または変数を探査し,
    ! var に GT_VARIABLE 変数を返す. 見つかって正常に
    ! var が返る場合は stat には DC_NOERR が返り,
    ! history 内から name が発見されない場合には, stat に
    ! NF90_ENOTVAR が返る.
    !
    use dc_error, only: storeerror, dc_noerr, nf90_enotvar
    use dc_types, only: string
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    type(gt_history), intent(in):: history
    character(len = *), intent(in):: name
    type(gt_variable), intent(out):: var
    logical, intent(out):: err
    integer:: stat, ord
    character(STRING) :: cause_c
    character(len = *), parameter:: subname = 'lookup_var_or_dim'
  continue
    call beginsub(subname, 'name=<%c>', c1=trim(name))
    cause_c = ""
    stat = dc_noerr
    var = lookup_variable(history, name, ord)
    if (ord /= 0) then
      stat = dc_noerr
      goto 999
    endif
    var = lookup_dimension(history, name, ord)
    if (ord /= 0) then
      stat = dc_noerr
      goto 999
    endif
    stat = nf90_enotvar
    cause_c = "Any vars and dims are not found"
999 continue
    call storeerror(stat, subname, err, cause_c)
    call endsub(subname, 'ord=%d (0:not found)', i=(/ord/))

Here is the call graph for this function:

lookup_variable()

type(gt_variable) function, public gtool_history_internal::lookup_variable	(	type(gt_history), intent(in)	history,
		character(len = *), intent(in)	varname,
		integer, intent(out), optional	ord
	)

Definition at line 314 of file gtool_history_internal.f90.

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_noerr, dc_trace::endsub(), dc_error::storeerror(), and dc_types::string.

    !
    !  history 内での変数 varname の ID を取得
    !    ID を取得できた場合, 返り値 result と ord にそれぞれ
    !    その ID が返される。
    !    ID を取得できない場合、ord が渡されていなければその場で終了
    !    ord が渡されている場合は ord に 0 が返される。
    !
    use dc_types, only: string
    use dc_error, only: storeerror, nf90_enotvar, dc_noerr
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    type(gt_history), intent(in):: history
    character(len = *), intent(in):: varname
    character(len = STRING) :: cause_c
    integer, intent(out), optional:: ord
    integer:: ordwork
    integer:: i, stat
    character(len = *), parameter:: subname = 'lookup_variable'
  continue
    call beginsub(subname, '%c', c1=trim(varname))
    stat = dc_noerr
    cause_c = ''
    if (present(ord)) ord = 0
    ordwork = 0
    i = lookup_variable_ord(history, varname)
    if (i > 0) then
      result = history % vars(i)
      if (present(ord)) ord = i
      goto 999
    endif
    if (present(ord)) then
      ord = 0
    else
      stat = nf90_enotvar
      cause_c = varname
      i = 0
    endif
999 continue
    call storeerror(stat, subname, cause_c=cause_c)
    if (present(ord)) ordwork = ord
    call endsub(subname, "ord=%d (0: not found)", i=(/ordwork/))

Here is the call graph for this function:

lookup_variable_ord()

integer function, public gtool_history_internal::lookup_variable_ord	(	type(gt_history), intent(in)	history,
		character(len = *), intent(in)	varname
	)

Definition at line 287 of file gtool_history_internal.f90.

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_trace::endsub(), and dc_types::string.

    !
    ! history 内の varname 変数の変数番号を返す.
    ! 現在, 明示的に history 変数を与えない場合の変数番号の
    ! 検索は出来ない.
    !
    use dc_types, only: string
    use gtdata_generic, only: inquire
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    type(gt_history), intent(in):: history
    character(len = *), intent(in):: varname
    character(len = string):: name
    character(len = *), parameter:: subname = 'lookup_variable_ord'
  continue
    call beginsub(subname, 'var=%c', c1 = trim(varname))
    if (associated(history % vars)) then
      do, result = 1, size(history % vars)
        call inquire(history % vars(result), name=name)
        if (name == varname) goto 999
        call dbgmessage('no match <%c> <%c>', c1=trim(name), c2=trim(varname))
      enddo
    endif
    result = 0
999 continue
    call endsub(subname, "result=%d", i=(/result/))

Here is the call graph for this function:

set_fake_dim_value()

subroutine, public gtool_history_internal::set_fake_dim_value	(	type(gt_history), intent(inout)	history,
		integer, intent(in)	dimord
	)

Definition at line 245 of file gtool_history_internal.f90.

References dumperror().

    !
    ! 次元 history % dimvars(dimord) に値が設定されていない場合、
    ! 「とりあえず」値を設定する。ただし、無制限次元 (時間次元)
    ! に関しては history % origin, history % interval, history % count
    ! から「まっとうな」値が設定される。
    !
    use gtdata_generic, only: inquire, slice, put
    use dc_error, only: dumperror
!    use dc_calendar, only: DCCalConvertByUnit
!    use dc_date, only: EvalByUnit
    type(gt_history), intent(inout):: history
    integer, intent(in):: dimord
    integer:: length, i
    real, allocatable:: value(:)
    logical:: err
  continue
    if (dimord == history % unlimited_index) then
      if (.not. associated(history % count)) return
      length = maxval(history % count(:))
    else
      call inquire(history % dimvars(dimord), size=length)
    endif
    if (length == 0) return
    allocate(value(length))
    if (dimord == history % unlimited_index) then
      value(:) = (/(real(i), i = 1, length)/)
      value(:) =   &
        &   history % origin &
        & + (value(:) - 1.0) * history % interval
!!$      value(:) =   &
!!$        &   EvalByUnit( history % origin, '', history % unlimited_units_symbol ) &
!!$        & + (value(:) - 1.0) &
!!$        &   * EvalByUnit( history % interval, '', history % unlimited_units_symbol )
      call slice(history % dimvars(dimord), 1, start=1, count=length)
    else
      value(:) = (/(real(i), i = 1, length)/)
    endif
    call put(history % dimvars(dimord), value, size(value), err)
    if (err) call dumperror
    deallocate(value)

Here is the call graph for this function:

Variable Documentation

default

type(gt_history), target, save, public gtool_history_internal::default

Definition at line 49 of file gtool_history_internal.f90.

Referenced by append_attrs(), historyaddattrchar0(), historyaddattrdouble0(), historyaddattrdouble1(), historyaddattrint0(), historyaddattrint1(), historyaddattrlogical0(), historyaddattrreal0(), historyaddattrreal1(), historyaddvariable1(), historyaddvariable2(), historyaxisaddattrchar0(), historyaxisaddattrdouble0(), historyaxisaddattrdouble1(), historyaxisaddattrint0(), historyaxisaddattrint1(), historyaxisaddattrlogical0(), historyaxisaddattrreal0(), historyaxisaddattrreal1(), historyaxisclear(), historyaxiscopy1(), historyaxiscreate1(), historyaxiscreate2(), historyaxisinquire1(), historyclose(), historycopy1(), historycopyvariable1(), historycreate1(), historycreate2(), historycreate3(), historyinquire1(), historyinquire2(), historyputaxismpidouble(), historyputaxismpiint(), historyputaxismpireal(), historyputcharex(), historyputdoubleex(), historyputintex(), historyputline(), historyputrealex(), historysettime(), historyvarinfoaddattrchar0(), historyvarinfoaddattrdouble0(), historyvarinfoaddattrdouble1(), historyvarinfoaddattrint0(), historyvarinfoaddattrint1(), historyvarinfoaddattrlogical0(), historyvarinfoaddattrreal0(), historyvarinfoaddattrreal1(), historyvarinfoclear0(), historyvarinfocopy1(), historyvarinfoinquire1(), and timegoahead().

  type(gt_history), save, target, public:: default

gtool4_netcdf_conventions

character(string), parameter, public gtool_history_internal::gtool4_netcdf_conventions = "http://www.gfd-dennou.org/library/gtool4/conventions/"

Definition at line 57 of file gtool_history_internal.f90.

Referenced by historycreate1().

  character(STRING), parameter, public:: &
    & gtool4_netCDF_Conventions = &
    &     "http://www.gfd-dennou.org/library/gtool4/conventions/"

gtool4_netcdf_version

character(string), parameter, public gtool_history_internal::gtool4_netcdf_version = "4.3"

Definition at line 61 of file gtool_history_internal.f90.

Referenced by historycreate1().

  character(STRING), parameter, public:: &
    & gtool4_netCDF_version = "4.3"