gtool_history_internal::copy_attrs Interface Reference

Public Member Functions
subroutine	copy_attrs (from, to, err)

Detailed Description

Definition at line 75 of file gtool_history_internal.f90.

Constructor & Destructor Documentation

copy_attrs()

subroutine gtool_history_internal::copy_attrs::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 171 of file gtool_history_internal.f90.

    !
    ! 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
    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)

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(), and dc_types::string.

Here is the call graph for this function:

---

The documentation for this interface was generated from the following file:

• /build/gtool5-1.0.0~rc5/debian/build-serial/src/gtool/gtool_history/gtool_history_internal.f90