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
|
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 some compound type behavior.
C Ed Hartnett, 2009
program ftst_vars5
implicit none
include 'netcdf.inc'
C This is the name of the data file we will create.
character*(*) FILE_NAME
parameter (FILE_NAME='ftst_vars5.nc')
C NetCDF IDs.
integer ncid, cmp_typeid
integer max_types
parameter (max_types = 1)
C Need these to read type information.
integer num_types, typeids(max_types)
integer base_type, type_size, num_members, member_value
character*80 type_name, member_name
integer nfields, class
C Information for the compound type we will define.
character*(*) cmp_type_name, int1_name, int2_name
parameter (cmp_type_name = 'compound_type')
parameter (int1_name = 'int1', int2_name = 'int2')
integer compound_len, compound_len_in
parameter (compound_len = 2)
integer data1(compound_len), data1_in(compound_len)
character*(4) att_name
parameter (att_name = 'att1')
C Loop indexes, and error handling.
integer x, retval, index(1)
print *, ''
print *,'*** Testing compound types.'
C Prepare some data to write.
do x = 1, compound_len
data1(x) = x
end do
C Create the netCDF file.
retval = nf_create(FILE_NAME, NF_NETCDF4, ncid)
if (retval .ne. nf_noerr) stop 1
C Create the compound type.
retval = nf_def_compound(ncid, 8, cmp_type_name,
& cmp_typeid)
if (retval .ne. nf_noerr) stop 1
C Insert two integers.
retval = nf_insert_compound(ncid, cmp_typeid, int1_name,
& 0, NF_INT)
if (retval .ne. nf_noerr) stop 1
retval = nf_insert_compound(ncid, cmp_typeid, int2_name,
& 4, NF_INT)
if (retval .ne. nf_noerr) stop 1
C Write the compound attribute.
retval = nf_put_att(ncid, NF_GLOBAL, att_name, cmp_typeid,
& 1, data1)
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 compound 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(cmp_type_name)) .ne. cmp_type_name .or.
& type_size .ne. 8 .or. base_type .ne. 0 .or.
& nfields .ne. 2 .or. class .ne. nf_compound) stop 2
C Use nf_inq_compound and make sure we get the same answers as we did
C with nf_inq_user_type.
retval = nf_inq_compound(ncid, typeids(1), type_name, type_size,
& nfields)
if (retval .ne. nf_noerr) stop 1
if (type_name(1:len(cmp_type_name)) .ne. cmp_type_name .or.
& base_type .ne. 0 .or. type_size .ne. 8 .or.
& nfields .ne. 2) stop 2
C Read the compound attribute.
retval = nf_get_att(ncid, NF_GLOBAL, att_name, data1_in)
if (retval .ne. nf_noerr) stop 1
C Check the data
do x = 1, compound_len
if (data1(x) .ne. data1_in(x)) stop 2
end do
C Close the file.
retval = nf_close(ncid)
if (retval .ne. nf_noerr) stop 1
print *,'*** SUCCESS!'
end
|
