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
|
C This is part of the netCDF package.
C Copyright 2007 University Corporation for Atmospheric Research/Unidata.
C See COPYRIGHT file for conditions of use.
C This program tests netCDF-4 user defined types from fortran.
C Ed Hartnett, 2009
program ftst_types3
implicit none
include 'netcdf.inc'
C This is the name of the data file we will create.
character*(*) FILE_NAME
parameter (FILE_NAME='ftst_types3.nc')
C We are writing 2D data, a 3 x 2 grid.
integer NDIMS
parameter (NDIMS = 2)
integer dim_sizes(NDIMS)
integer NX, NY
parameter (NX = 3, NY = 2)
C NetCDF IDs.
integer ncid, varid, dimids(NDIMS)
integer cmp_typeid, typeid_in
integer x_dimid, y_dimid
integer typeids(1)
integer grpid, sub_grpid
C Info about the groups we'll create.
character*(*) group_name, sub_group_name
parameter (group_name = 'you_drive_me_crazy')
parameter (sub_group_name = 'baby_Im_so_into_you')
C Info about the type we'll create.
integer size_in, base_type_in, nfields_in, class_in
character*80 name_in
character*(*) type_name, field_name
parameter (type_name = 'I_just_want_to_have_some_fun')
parameter (field_name = 'Ill_tell_it_to_the_world')
integer ntypes
integer cmp_size
parameter (cmp_size = 4)
integer offset_in, field_typeid_in, ndims_in, dim_sizes_in(NDIMS)
C Loop indexes, and error handling.
integer x, y, retval
print *, ''
print *,'*** Testing netCDF-4 user-defined types and groups.'
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 Define a compound type in the root group.
retval = nf_def_compound(ncid, cmp_size, type_name,
& cmp_typeid)
if (retval .ne. nf_noerr) stop 1
C Include a float.
retval = nf_insert_compound(ncid, cmp_typeid, field_name, 0,
& NF_FLOAT)
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 and check again.
retval = nf_open(FILE_NAME, NF_NOWRITE, ncid)
if (retval .ne. nf_noerr) stop 1
C Find the type.
retval = nf_inq_typeids(ncid, ntypes, typeids)
if (retval .ne. nf_noerr) stop 1
if (ntypes .ne. 1 .or. typeids(1) .ne. cmp_typeid) stop 2
C Check the type.
retval = nf_inq_user_type(ncid, typeids(1), name_in, size_in,
& base_type_in, nfields_in, class_in)
if (retval .ne. nf_noerr) stop 1
if (name_in(1:len(type_name)) .ne. type_name .or.
& size_in .ne. cmp_size .or. nfields_in .ne. 1 .or.
& class_in .ne. NF_COMPOUND) stop 31
C Check the first field of the compound type.
retval = nf_inq_compound_field(ncid, typeids(1), 1, name_in,
& offset_in, field_typeid_in, ndims_in, dim_sizes_in)
if (retval .ne. nf_noerr) stop 1
if (name_in(1:len(field_name)) .ne. field_name .or.
& offset_in .ne. 0 .or. field_typeid_in .ne. NF_FLOAT .or.
& ndims_in .ne. 0) stop 19
C Go to a child group and find the id of our type.
retval = nf_inq_grp_ncid(ncid, group_name, sub_grpid)
if (retval .ne. nf_noerr) stop 1
retval = nf_inq_typeid(sub_grpid, type_name, typeid_in)
if (retval .ne. nf_noerr) stop 1
retval = nf_inq_user_type(sub_grpid, typeid_in, name_in, size_in,
& base_type_in, nfields_in, class_in)
if (retval .ne. nf_noerr) stop 1
if (name_in(1:len(type_name)) .ne. type_name .or.
& size_in .ne. cmp_size .or. nfields_in .ne. 1 .or.
& class_in .ne. NF_COMPOUND) stop 22
C Close the file.
retval = nf_close(ncid)
if (retval .ne. nf_noerr) stop 1
print *,'*** SUCCESS!'
end
|
