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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
C This is part of the netCDF package.
C Copyright 2008 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 testing enum and opaque types.
C Ed Hartnett, 2009
program ftst_vars3
implicit none
include 'netcdf.inc'
C This is the name of the data file we will create.
character*(*) FILE_NAME
parameter (FILE_NAME='ftst_vars3.nc')
C We are writing an attribute, of length 3.
integer NDIMS
parameter (NDIMS = 1)
integer NX
parameter (NX = 3)
C NetCDF IDs.
integer ncid, varid, dimids(1)
integer enum_typeid, opaque_typeid
C This is the data array we will write as an enum attribute, and a
C place to store it when we read it back in. Z is the fastest
C varying dimension.
integer data_out(NX), data_in(NX)
integer max_types
parameter (max_types = 2)
C Need these to read type information.
integer num_types, typeids(max_types)
integer base_type, base_size, num_members, member_value
character*80 type_name, member_name
integer type_size, nfields, class
C Information for the enum type we will define.
character*(*) enum_type_name, one_name, zero_name
parameter (enum_type_name = 'enum_type')
parameter (zero_name = 'zero', one_name = 'one')
integer one, zero
C Information for the opaque type we will define.
character*(*) opaque_type_name
parameter (opaque_type_name = 'opaque_type')
integer opaque_size
parameter (opaque_size = 16)
character*(opaque_size) opaque_data, opaque_data_in
parameter (opaque_data = '0123456789012345')
C Loop indexes, and error handling.
integer x, retval, index(1)
C Create some pretend data.
do x = 1, NX
data_out(x) = 0
end do
data_out(1) = 1
print *, ''
print *,'*** Testing enum and opaque types.'
C Create the netCDF file.
retval = nf_create(FILE_NAME, NF_NETCDF4, ncid)
if (retval .ne. nf_noerr) stop 1
C Create the enum type.
retval = nf_def_enum(ncid, NF_INT, enum_type_name, enum_typeid)
if (retval .ne. nf_noerr) stop 1
one = 1
zero = 0
retval = nf_insert_enum(ncid, enum_typeid, zero_name, zero)
if (retval .ne. nf_noerr) stop 1
retval = nf_insert_enum(ncid, enum_typeid, one_name, one)
if (retval .ne. nf_noerr) stop 1
C Create the opaque type.
retval = nf_def_opaque(ncid, opaque_size, opaque_type_name,
& opaque_typeid)
if (retval .ne. nf_noerr) stop 1
C Create a dimension.
retval = nf_def_dim(ncid, 'dim', 1, dimids(1))
if (retval .ne. nf_noerr) stop 1
C Create an opaque variable.
retval = nf_def_var(ncid, 'var', opaque_typeid, 1, dimids, varid)
if (retval .ne. nf_noerr) stop 1
C Write the opaque scalar var. (Could also use nf_put_var).
index(1) = 1
retval = nf_put_var1(ncid, varid, index, opaque_data)
if (retval .ne. nf_noerr) stop 1
C Attach an enum attribute to the variable.
retval = nf_put_att(ncid, varid, 'att', enum_typeid, NX,
& data_out)
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 Get the typeids of all user defined types.
retval = nf_inq_typeids(ncid, num_types, typeids)
if (retval .ne. nf_noerr) stop 1
if (num_types .ne. max_types) stop 2
C Use nf_inq_user_type to confirm this is an enum type.
retval = nf_inq_user_type(ncid, typeids(1), type_name, type_size,
& base_type, nfields, class)
if (retval .ne. nf_noerr) stop 1
if (type_name(1:len(enum_type_name)) .ne. enum_type_name .or.
& type_size .ne. 4 .or. base_type .ne. NF_INT .or.
& nfields .ne. 2 .or. class .ne. nf_enum) stop 2
C Use nf_inq_enum and make sure we get the same answers as we did
C with nf_inq_user_type.
retval = nf_inq_enum(ncid, typeids(1), type_name, base_type,
& base_size, num_members)
if (retval .ne. nf_noerr) stop 1
if (type_name(1:len(enum_type_name)) .ne. enum_type_name .or.
& base_type .ne. NF_INT .or. num_members .ne. 2) stop 2
C Check the members of the enum type.
retval = nf_inq_enum_member(ncid, typeids(1), 1, member_name,
& member_value)
if (retval .ne. nf_noerr) stop 1
if (member_name(1:len(zero_name)) .ne. zero_name .or.
& member_value .ne. 0) stop 2
retval = nf_inq_enum_member(ncid, typeids(1), 2, member_name,
& member_value)
if (retval .ne. nf_noerr) stop 1
if (member_name(1:len(one_name)) .ne. one_name .or.
& member_value .ne. 1) stop 2
retval = nf_inq_enum_ident(ncid, typeids(1), 0, member_name)
if (retval .ne. nf_noerr) stop 1
if (member_name(1:len(zero_name)) .ne. zero_name) stop 2
retval = nf_inq_enum_ident(ncid, typeids(1), 1, member_name)
if (retval .ne. nf_noerr) stop 1
if (member_name(1:len(one_name)) .ne. one_name) stop 2
C Use nf_inq_user_type to confirm that the second typeid is an
C opaque type.
retval = nf_inq_user_type(ncid, typeids(2), type_name, type_size,
& base_type, nfields, class)
if (retval .ne. nf_noerr) stop 1
if (type_name(1:len(opaque_type_name)) .ne. opaque_type_name .or.
& type_size .ne. opaque_size .or. base_type .ne. 0 .or.
& nfields .ne. 0 .or. class .ne. nf_opaque) stop 2
C Use nf_inq_opaque and make sure we get the same answers as we did
C with nf_inq_user_type.
retval = nf_inq_opaque(ncid, typeids(2), type_name, base_size)
if (retval .ne. nf_noerr) stop 1
if (base_size .ne. opaque_size .or.
& type_name(1:len(opaque_type_name)) .ne. opaque_type_name)
& stop 2
C Read the variable.
index(1) = 1
retval = nf_get_var1(ncid, varid, index, opaque_data_in)
if (retval .ne. nf_noerr) stop 1
if (opaque_data_in .ne. opaque_data) stop 2
C Read the attribute.
retval = nf_get_att(ncid, varid, 'att', data_in)
if (retval .ne. nf_noerr) stop 1
C Check the values.
do x = 1, NX
if (data_in(x) .ne. data_out(x)) stop 2
end do
C Close the file.
retval = nf_close(ncid)
if (retval .ne. nf_noerr) stop 1
print *,'*** SUCCESS!'
end
|
