historyvarinfocopy.f90

Go to the documentation of this file.

 
 
  subroutine historyvarinfocopy1(varinfo_dest, varinfo_src, err, &
    & name, dims, longname, units, xtype )
    use gtool_history_types, only: gt_history_varinfo
    use gtool_history_internal, only: copy_attrs
    use dc_trace, only: beginsub, endsub, dbgmessage
    use dc_present,only: present_select
    use dc_string, only: joinchar
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, dc_ealreadyinit
    use dc_types, only: string, token
    implicit none
    type(gt_history_varinfo),intent(out):: varinfo_dest
    type(gt_history_varinfo),intent(in):: varinfo_src
    logical, intent(out), optional:: err
    character(*) , intent(in), optional:: name     ! 次元変数名
    character(*) , intent(in), optional, target:: dims(:)  ! 依存する次元
    character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
    character(*) , intent(in), optional:: units    ! 次元変数の単位
    character(*) , intent(in), optional:: xtype    ! 次元変数の型
 
    integer:: i, stat
    character(STRING):: cause_c
    character(TOKEN), pointer :: srcdims(:) =>null() ! 依存する次元
    character(STRING) :: name_tmp, xtype_tmp
    character(*), parameter:: subname = "HistoryVarinfoCopy1"
  continue
    call beginsub(subname)
    stat = dc_noerr
    cause_c = ''
 
    if ( .not. varinfo_src % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY_VARINFO'
      goto 999
    end if
 
    if ( varinfo_dest % initialized ) then
      stat = dc_ealreadyinit
      cause_c = 'GT_HISTORY_VARINFO'
      goto 999
    end if
 
    name_tmp = present_select('', varinfo_src % name, name)
    varinfo_dest % name     = name_tmp(:len(varinfo_dest % name))
    varinfo_dest % longname = present_select('', varinfo_src % longname, longname)
    varinfo_dest % units    = present_select('', varinfo_src % units, units)
    xtype_tmp = present_select('', varinfo_src % xtype, xtype)
    varinfo_dest % xtype    = xtype_tmp(:len(varinfo_dest % xtype))
 
    if (present(dims)) then
      srcdims => dims
    else
      srcdims => varinfo_src % dims
    endif
 
    call dbgmessage('srcdims=<%c>', &
      & c1=trim(joinchar(srcdims)))
 
    allocate(  varinfo_dest % dims( size( srcdims ) )  )
    do i = 1, size(srcdims)
      varinfo_dest % dims(i) = srcdims(i)
    end do
 
    call dbgmessage('varinfo_dest %% dims=<%c>', &
      & c1=trim(joinchar(varinfo_dest % dims)))
 
    if (associated( varinfo_src % attrs ) ) then
      allocate(  varinfo_dest % attrs( size( varinfo_src % attrs) )  )
      call copy_attrs( from = varinfo_src % attrs, &
        &                to = varinfo_dest % attrs, err = err)
    end if
 
    varinfo_dest % initialized = .true.
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)
  end subroutine historyvarinfocopy1
 
  subroutine historyvarinfocopy2(varinfo_dest, varinfo_src, err, &
    & name, dims, longname, units, xtype )
    !
    ! 使用方法は HistoryVarinfoCopy と同様です. 
    !
    ! Usage is same as "HistoryVarinfoCopy".
    !
    !--
    ! 総称名 Copy として提供するための関数です. 
    ! 機能は HistoryVarinfoCopy1 と同じです. 
    !++
    use gtool_history_types, only: gt_history_varinfo
    use gtool_history_generic, only: historyvarinfocopy
    use dc_trace, only: beginsub, endsub
    implicit none
    type(gt_history_varinfo),intent(out):: varinfo_dest
    type(gt_history_varinfo),intent(in):: varinfo_src
    logical, intent(out), optional:: err
    character(*) , intent(in), optional:: name     ! 次元変数名
    character(*) , intent(in), optional, target:: dims(:)  ! 依存する次元
    character(*) , intent(in), optional:: longname ! 次元変数の記述的名称
    character(*) , intent(in), optional:: units    ! 次元変数の単位
    character(*) , intent(in), optional:: xtype    ! 次元変数の型
 
    character(*), parameter:: subname = "HistoryVarinfoCopy2"
  continue
    call beginsub(subname)
    call historyvarinfocopy(varinfo_dest, varinfo_src, err, &
      & name, dims, longname, units, xtype )
    call endsub(subname)
  end subroutine historyvarinfocopy2