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(value), text=value)
else
stat = nf_put_att_text(ent%fileid, ent%varid, name=name, len=len(value), text=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