Creates a variable at the specified URL. The dimensions the variable depends on are given in dims. The returned var contains the variable ID and other information.
Setting overwrite to .true. enables overwrite mode (default: no overwrite). If err is provided, errors return .false. instead of terminating.
63 use netcdf, only: &
64 & nf90_noerr, nf90_float, nf90_double, nf90_int, nf90_char, nf90_ebaddim, nf90_def_var
67 implicit none
68 type(GD_NC_VARIABLE), intent(out):: var
69 character(len = *), intent(in):: url
70 character(len = *), intent(in):: xtype
71 type(GD_NC_VARIABLE), intent(in):: dims(:)
72 logical, intent(in), optional:: overwrite
73 logical, intent(out), optional:: err
74 type(GD_NC_VARIABLE_SEARCH):: ent
75 type(GD_NC_VARIABLE_ENTRY):: ent_dim
76 character(len = string):: filename, varname
77 integer, allocatable:: dimids(:)
78 integer:: stat, nvdims, i
79 integer:: nc_xtype
80 logical:: clobber
81 intrinsic trim
82 character(len = *), parameter:: subnam = "GDNcVarCreate"
83continue
84 clobber = .false.
85 if (present(overwrite)) clobber = overwrite
89 call dbgmessage(
'dims=(/%*d/)', i=(/dims(:)%id/), n=(/
size(dims)/))
91
92
93 call urlsplit(url, filename, varname)
94 call gdncfileopen(ent%fileid, filename, stat=stat, writable=.true., &
95 & overwrite=clobber)
96 if (stat /= nf90_noerr) goto 999
97
98
99 nvdims = size(dims)
100 allocate(dimids(max(1, nvdims)), stat=stat)
101 if (stat /= 0) then
103 goto 999
104 end if
105 do, i = 1, nvdims
107 if (stat /= nf90_noerr) then
108 stat = nf90_ebaddim
109 goto 999
110 endif
111 if (ent%fileid /= ent_dim%fileid) then
113 goto 999
114 endif
115 if (ent_dim%dimid <= 0) then
117 goto 999
118 endif
119 dimids(i) = ent_dim%dimid
120 enddo
121 ent%dimid = 0
122
123
124 nc_xtype = nf90_float
125 if (
strieq(xtype,
"double"))
then
126 nc_xtype = nf90_double
127 else if (
strieq(xtype,
"DOUBLEPRECISION"))
then
128 nc_xtype = nf90_double
129 end if
130 if (
strieq(xtype,
"int"))
then
131 nc_xtype = nf90_int
132 else if (
strieq(xtype,
"INTEGER"))
then
133 nc_xtype = nf90_int
134 end if
135 if (
strieq(xtype,
"char"))
then
136 nc_xtype = nf90_char
137 else if (
strieq(xtype,
"CHARACTER"))
then
138 nc_xtype = nf90_char
139 end if
140
141
143 if (stat /= nf90_noerr) goto 999
144 if ( nvdims == 0 ) then
145 stat = nf90_def_var(ent%fileid, name = trim(varname), &
146 & xtype = nc_xtype, varid=ent%varid)
147 else
148 stat = nf90_def_var(ent%fileid, name = trim(varname), &
149 & xtype = nc_xtype, dimids = dimids, varid=ent%varid)
150 end if
151 if (stat /= nf90_noerr) goto 999
152
153
155
156999 continue
157 if (allocated(dimids)) deallocate(dimids)
158 if (stat /= nf90_noerr) var % id = -1
159 call storeerror(stat, subnam, err, cause_c=url)
160 call endsub(subnam,
'stat=%d, var.id=%d', i=(/stat, var % id/))
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public gt_eotherfile
integer, parameter, public gt_enomem
integer, parameter, public gt_edimmultidim
Handling character types.
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Provides kind type parameter values.
integer, parameter, public string
Character length for string
Variable URL string parser.
integer function, public vtable_add(var, entry)
integer function, public vtable_lookup(var, entry)