anvarputattrchar.f90

Path: anvarputattrchar.f90
Last Update: Sat Dec 22 19:57:18 JST 2007

属性の付加

Authors:Eizi TOYODA, Yasuhiro MORIKAWA
Version:$Id: anvarputattrchar.f90,v 1.3 2007/12/22 10:57:18 morikawa Exp $
Tag Name:$Name: gt4f90io-20080217 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2007. All rights reserved.
License:See COPYRIGHT

以下のサブルーチン、関数は an_generic から an_generic#Put_Attr として提供されます。

Methods

ANVarPutAttrChar  

Included Modules

an_types an_vartable an_file netcdf_f77 dc_url dc_error dc_string an_generic

Public Instance methods

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

[Source]

subroutine ANVarPutAttrChar(var, name, value, xtype, err)
  use an_types, only: AN_VARIABLE, AN_VARIABLE_ENTRY
  use an_vartable, only: vtable_lookup
  use an_file, only: ANFileDefineMode
  use netcdf_f77, only: NF_PUT_ATT_TEXT, NF_NOERR, NF_DEL_ATT, NF_ENOTINDEFINE, NF_GLOBAL
  use dc_url, only: GT_PLUS
  use dc_error
  use dc_string, only: get_array
  use an_generic, only: put_attr
  implicit none
  type(AN_VARIABLE), intent(in):: var
  character(len = *), intent(in):: name
  character(len = *), intent(in):: value
  character(len = *), intent(in), optional:: xtype
  logical, intent(out), optional:: err
  integer, pointer:: ip(:)
  real, pointer:: rp(:)
  double precision, pointer:: dp(:)
  integer:: stat
  type(an_variable_entry):: ent
continue
  stat = vtable_lookup(var, ent)
  if (stat /= NF_NOERR) goto 999
  if (len(value) == 0) then
    if (name(1:1) == GT_PLUS) then
      stat = nf_del_att(ent % fileid, NF_GLOBAL, name = name(2:))
    else
      stat = nf_del_att(ent % fileid, ent % varid, name = name)
    endif
    goto 999
  endif
  if ( present(xtype) ) then
    select case(xtype)
    case("INTEGER", "integer", "int")
      goto 200
    case("REAL", "real", "float")
      goto 300
    case("DOUBLEPRECISION", "DOUBLE", "double")
      goto 400
    end select
  end if

  stat = ANFileDefineMode( ent % fileid )
  if (stat /= NF_NOERR) goto 999
  if (name(1:1) == GT_PLUS) then
    stat = nf_put_att_text(ent % fileid, NF_GLOBAL, name = name(2:), len = len_trim(value), text = trim(value) )
  else
    stat = nf_put_att_text(ent % fileid, ent % varid, name = name, len = len_trim(value), text = trim(value) )
  endif

999 continue
  call StoreError(stat, 'ANVarPutAttrChar', err, cause_c=name)
  return

200 continue
  call get_array(ip, value)
  if (associated(ip)) then
    call put_attr(var, name, ip, err)
    deallocate(ip)
  endif
  return

300 continue
  call get_array(rp, value)
  if (associated(rp)) then
    call put_attr(var, name, rp, err)
    deallocate(rp)
  endif
  return

400 continue
  call get_array(dp, value)
  if (associated(dp)) then
    call put_attr(var, name, dp, err)
    deallocate(dp)
  endif
  return
end subroutine ANVarPutAttrChar

[Validate]