1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
C This is part of the netCDF package. Copyright 2006-2019 University
C Corporation for Atmospheric Research/Unidata. See COPYRIGHT file
C for conditions of use.
C This program tests netCDF-4 group functions in the F77 API.
C Ed Hartnett, 2009
program ftst_groups
implicit none
include 'netcdf.inc'
C This is the name of the data file we will create.
character*(*) file_name
parameter (file_name='ftst_groups.nc')
C Info about the groups we'll create.
character*(*) group_name, sub_group_name
parameter (group_name = 'grp', sub_group_name = 'sub')
character*80 name_in, name_in2
integer ngroups_in
integer full_name_len
C Dimensions and variables.
character*(*) dim1_name, dim2_name
parameter (dim1_name = 'd1', dim2_name = 'd2')
character*(*) var1_name, var2_name
parameter (var1_name = 'v1', var2_name = 'v2')
integer nvars, ndims
C NetCDF IDs.
integer ncid, grpid, sub_grpid, subgrp_in
integer grpids(1), grpid_in, dimids(2), varids(2)
integer varids_in(2), dimids_in(2)
C Error handling.
integer retval
print *, ''
print *,'*** Testing netCDF-4 groups from F77.'
C Create the netCDF file.
retval = nf_create(file_name, NF_NETCDF4, ncid)
if (retval .ne. nf_noerr) stop 1
C Create a group and a subgroup.
retval = nf_def_grp(ncid, group_name, grpid)
if (retval .ne. nf_noerr) stop 1
retval = nf_def_grp(grpid, sub_group_name, sub_grpid)
if (retval .ne. nf_noerr) stop 1
C Create a two dims and two vars.
retval = nf_def_dim(sub_grpid, dim1_name, 0, dimids(1))
if (retval .ne. nf_noerr) stop 1
retval = nf_def_dim(sub_grpid, dim2_name, 0, dimids(2))
if (retval .ne. nf_noerr) stop 1
retval = nf_def_var(sub_grpid, var1_name, NF_UINT64, 2, dimids,
& varids(1))
if (retval .ne. nf_noerr) stop 1
retval = nf_def_var(sub_grpid, var2_name, NF_UINT64, 2, dimids,
& varids(2))
if (retval .ne. nf_noerr) stop 1
C Close the file.
retval = nf_close(ncid)
if (retval .ne. nf_noerr) stop 1
C Reopen the file.
retval = nf_open(file_name, NF_NOWRITE, ncid)
if (retval .ne. nf_noerr) stop 1
C Check the name of the root group.
retval = nf_inq_grpname(ncid, name_in)
if (retval .ne. nf_noerr) stop 1
if (name_in(1:1) .ne. '/') stop 2
C Check the full name of the root group (also "/").
retval = nf_inq_grpname_full(ncid, full_name_len, name_in)
if (retval .ne. nf_noerr) stop 1
if (full_name_len .ne. 1 .or. name_in(1:1) .ne. '/') stop 2
C What groups are there from the root group?
retval = nf_inq_grps(ncid, ngroups_in, grpids)
if (retval .ne. nf_noerr) stop 1
if (ngroups_in .ne. 1) stop 2
C Check the name of this group.
retval = nf_inq_grpname(grpids(1), name_in)
if (retval .ne. nf_noerr) stop 1
if (name_in(1:len(group_name)) .ne. group_name) stop 2
C Check the length of the full name.
retval = nf_inq_grpname_len(grpids(1), full_name_len)
if (retval .ne. nf_noerr) stop 1
if (full_name_len .ne. len(group_name) + 1) stop 2
C Check the full name.
retval = nf_inq_grpname_full(grpids(1), full_name_len, name_in2)
if (retval .ne. nf_noerr) stop 1
if (name_in2(1:1) .ne. '/' .or.
& name_in2(2:len(group_name)+1) .ne. group_name .or.
& full_name_len .ne. len(group_name) + 1) stop 2
C Check getting the grpid by full name
retval = nf_inq_grp_full_ncid(ncid, name_in, grpid_in)
if (retval .ne. nf_noerr) stop 1
if (grpid_in .ne. grpids(1)) stop 2
C Check the parent ncid.
retval = nf_inq_grp_parent(grpids(1), grpid_in)
if (retval .ne. nf_noerr) stop 1
if (grpid_in .ne. ncid) stop 2
C Check getting the group by name
retval = nf_inq_ncid(ncid, group_name, grpid_in)
if (retval .ne. nf_noerr) stop 1
if (grpid_in .ne. grpids(1)) stop 2
C Check getting the group by name
retval = nf_inq_ncid(ncid, group_name, grpid_in)
if (retval .ne. nf_noerr) stop 1
if (grpid_in .ne. grpids(1)) stop 2
C Get the sub group id, using its name.
retval = nf_inq_ncid(grpid_in, sub_group_name, subgrp_in)
if (retval .ne. nf_noerr) stop 1
C Check varids in subgroup.
retval = nf_inq_varids(subgrp_in, nvars, varids_in)
if (retval .ne. nf_noerr) stop 1
if (nvars .ne. 2 .or. varids_in(1) .ne. varids(1) .or.
& varids_in(2) .ne. varids(2)) stop 2
C Check dimids in subgroup.
retval = nf_inq_dimids(subgrp_in, ndims, dimids_in, 0)
if (retval .ne. nf_noerr) stop 1
if (ndims .ne. 2 .or. dimids_in(1) .ne. dimids(1) .or.
& dimids_in(2) .ne. dimids(2)) stop 2
C Check dimids including parents (will get same answers, since there
C are no dims in parent group.
retval = nf_inq_dimids(subgrp_in, ndims, dimids_in, 1)
if (retval .ne. nf_noerr) stop 1
if (ndims .ne. 2 .or. dimids_in(1) .ne. dimids(1) .or.
& dimids_in(2) .ne. dimids(2)) stop 2
C Close the file.
retval = nf_close(ncid)
if (retval .ne. nf_noerr) stop 1
print *,'*** SUCCESS!'
end
|
