変数に文字属性を設定します。xtype が指定された場合、 値はその数値型に変換されてから格納されます。 name が '+' で始まる場合、グローバル属性として扱われます。 空の value は属性を削除します。
52 use netcdf, only: &
53 & nf90_global, &
54 & nf90_noerr, &
55 & nf90_put_att, &
56 & nf90_del_att
61 implicit none
62 type(GD_NC_VARIABLE), intent(in):: var
63 character(len = *), intent(in):: name
64 character(len = *), intent(in):: val
65 character(len = *), intent(in), optional:: xtype
66 logical, intent(out), optional:: err
67 integer, pointer:: ip(:)
68 real, pointer:: rp(:)
69 double precision, pointer:: dp(:)
70 integer:: stat
71 type(GD_NC_VARIABLE_ENTRY):: ent
72continue
74 if (stat /= nf90_noerr) goto 999
75 if (len(val) == 0) then
77 stat = nf90_del_att(ent%fileid, nf90_global, name = name(2:))
78 else
79 stat = nf90_del_att(ent%fileid, ent%varid, name = name)
80 endif
81 goto 999
82 endif
83 if ( present(xtype) ) then
84 select case(xtype)
85 case("INTEGER", "integer", "int")
86 goto 200
87 case("REAL", "real", "float")
88 goto 300
89 case("DOUBLEPRECISION", "DOUBLE", "double")
90 goto 400
91 end select
92 end if
93
95 if (stat /= nf90_noerr) goto 999
97 stat = nf90_put_att(ent%fileid, nf90_global, name(2:), trim(val) )
98 else
99 stat = nf90_put_att(ent%fileid, ent%varid, name, trim(val) )
100 endif
101
102999 continue
103 call storeerror(stat,
'GDNcVarPutAttrChar', err, cause_c=name)
104 return
105
106200 continue
108 if (associated(ip)) then
110 deallocate(ip)
111 endif
112 return
113
114300 continue
116 if (associated(rp)) then
118 deallocate(rp)
119 endif
120 return
121
122400 continue
124 if (associated(dp)) then
126 deallocate(dp)
127 endif
128 return
subroutine, public storeerror(number, where, err, cause_c, cause_i)
character, parameter, public gt_plus
integer function, public vtable_lookup(var, entry)