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.
C Copyright 2006 University Corporation for Atmospheric Research/Unidata.
C See COPYRIGHT file for conditions of use.
C This program tests netCDF-4 variable functions from fortran.
C $Id: ftst_groups.F,v 1.5 2009/01/25 14:33:44 ed Exp $
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) call handle_err(retval)
C Create a group and a subgroup.
retval = nf_def_grp(ncid, group_name, grpid)
if (retval .ne. nf_noerr) call handle_err(retval)
retval = nf_def_grp(grpid, sub_group_name, sub_grpid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Create a two dims and two vars.
retval = nf_def_dim(sub_grpid, dim1_name, 0, dimids(1))
if (retval .ne. nf_noerr) call handle_err(retval)
retval = nf_def_dim(sub_grpid, dim2_name, 0, dimids(2))
if (retval .ne. nf_noerr) call handle_err(retval)
retval = nf_def_var(sub_grpid, var1_name, NF_UINT64, 2, dimids,
& varids(1))
if (retval .ne. nf_noerr) call handle_err(retval)
retval = nf_def_var(sub_grpid, var2_name, NF_UINT64, 2, dimids,
& varids(2))
if (retval .ne. nf_noerr) call handle_err(retval)
C Close the file.
retval = nf_close(ncid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Reopen the file.
retval = nf_open(file_name, NF_NOWRITE, ncid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Check the name of the root group.
retval = nf_inq_grpname(ncid, name_in)
if (retval .ne. nf_noerr) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
C Check varids in subgroup.
retval = nf_inq_varids(subgrp_in, nvars, varids_in)
if (retval .ne. nf_noerr) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
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) call handle_err(retval)
print *,'*** SUCCESS!'
end
|
