19 use dc_trace, only: beginsub, endsub
20 use netcdf, only: nf90_noerr, nf90_max_name, nf90_enotvar, nf90_ebaddim, &
21 & nf90_inq_varid, nf90_inq_dimid, nf90_inquire_variable, nf90_inquire
22 implicit none
23 type(GD_NC_VARIABLE), intent(out):: var
24 character(len = *), intent(in):: url
25 logical, intent(in), optional:: writable
26 logical, intent(out), optional:: err
27 character(len = STRING):: filename, varname
28 character(len = NF90_MAX_NAME):: dimname
29 integer:: stat, nvars, i
30 type(GD_NC_VARIABLE_SEARCH):: e
31 character(len = *), parameter:: subname = 'GDNcVarOpen'
32continue
33 call beginsub(subname)
34 call urlsplit(url, file=filename, var=varname)
35 if (filename == "") filename = "gtool.nc"
36 call gdncfileopen(e%fileid, trim(filename), stat=stat, writable=writable, err=err )
37 if (stat /= 0) goto 999
38
39
40
41 if (varname /= '') then
42 e%varid = 0
43 stat = nf90_inq_varid(e%fileid, trim(varname), e%varid)
44 if (stat == nf90_enotvar) then
45 e%varid = 0
46 stat = nf90_noerr
47 endif
48 else
49
50 stat = nf90_inquire(e%fileid, nvariables = nvars)
51 if (stat /= 0) goto 999
52 e%varid = 1
53 do, i = 1, nvars
54 stat = nf90_inquire_variable(e%fileid, i, name = dimname)
55 if (stat /= nf90_noerr) goto 999
56 stat = nf90_inq_dimid(e%fileid, dimname, e%dimid)
57 if (stat == nf90_noerr) cycle
58 if (stat /= nf90_ebaddim) goto 999
59 e%varid = i
60 stat = nf90_noerr
61 exit
62 enddo
63 endif
64 if (stat /= nf90_noerr) goto 999
65
66
67
68 stat = nf90_inq_dimid(e%fileid, trim(varname), e%dimid)
69 if (stat /= nf90_noerr) then
70 if (e%varid <= 0) goto 999
71 e%dimid = 0
72 endif
73
75 if (stat /= nf90_noerr) goto 999
76 call endsub(subname, 'an=%d file=%d var=%d', i=(/var%id, e%fileid, e%varid/))
78 return
79
80
81
82999 continue
84 call endsub(subname, 'an=%d err', i=(/var%id/))
85 call storeerror(stat, subname, err, cause_c=url)
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Provides kind type parameter values.
integer, parameter, public string
Character length for string
integer function, public vtable_add(var, entry)