gdmemvarattrget.f90

Path: gtdata/gtdata_memory/gdmemvarattrget.f90
Last Update: Mon May 25 18:47:27 +0900 2009

Methods

GDMemVarAttrGet  

Included Modules

gtdata_memory_types gtdata_memory_internal dc_error netcdf_f77

Public Instance methods

GDMemVarAttrGet( var, name, value, [err] )
Subroutine :
var :type(GD_MEM_VARIABLE), intent(in)
name :character(len = *), intent(in)
value :character(len = *), intent(out)
err :logical, intent(out), optional

[Source]

subroutine GDMemVarAttrGet(var, name, value, err)
  use gtdata_memory_types, only: GD_MEM_VARIABLE, GD_MEM_VARIABLE_ENTRY, GD_MEM_ATTR_CHAIN
  use gtdata_memory_internal, only: memtab_lookup
  use dc_error, only: StoreError
  use netcdf_f77, only: nf_enotatt, nf_noerr
  type(GD_MEM_VARIABLE), intent(in):: var
  character(len = *), intent(in):: name
  character(len = *), intent(out):: value
  logical, intent(out), optional:: err
  type(GD_MEM_VARIABLE_ENTRY), pointer:: ent
  type(GD_MEM_ATTR_CHAIN), pointer:: p
  integer:: i, stat
  stat = memtab_lookup(var, ent)
  if (stat == nf_noerr) then
    if (associated(ent%current)) then
      p => ent%current
      if (p%name == name) goto 100
    endif
    p => ent%attr
    do
      if (.not. associated(p)) exit
      if (p%name == name) goto 100
      p => p%next
    enddo
    stat = nf_enotatt
  endif
  call StoreError(stat, "GDMemVarAttrGet", err, cause_c=name)
  return
  
100 continue
  if (associated(p%cbuf)) then
    do, i = 1, len(value)
      value(i:i) = p%cbuf(i)
    enddo
  else
    value = ""
  endif
  
end subroutine GDMemVarAttrGet

[Validate]