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
|
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 $Id: ftst_types2.F,v 1.5 2009/09/25 19:23:37 ed Exp $
program ftst_types2
implicit none
include 'netcdf.inc'
C This is the name of the data file we will create.
character*(*) FILE_NAME
parameter (FILE_NAME='ftst_types2.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
integer x_dimid, y_dimid
integer typeids(1)
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, ary_name
parameter (type_name = 'cmp_w_ary', ary_name = 'A')
integer ntypes
integer cmp_size
parameter (cmp_size = 24)
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 compound types from F77 some more.'
C Create the netCDF file.
retval = nf_create(FILE_NAME, NF_NETCDF4, ncid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Define a compound type.
retval = nf_def_compound(ncid, cmp_size, type_name,
& cmp_typeid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Include an array.
dim_sizes(1) = NX
dim_sizes(2) = NY
retval = nf_insert_array_compound(ncid, cmp_typeid, ary_name, 0,
& NF_INT, NDIMS, dim_sizes)
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 and check again.
retval = nf_open(FILE_NAME, NF_NOWRITE, ncid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Find the type.
retval = nf_inq_typeids(ncid, ntypes, typeids)
if (retval .ne. nf_noerr) call handle_err(retval)
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) call handle_err(retval)
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 2
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) call handle_err(retval)
if (name_in(1:len(ary_name)) .ne. ary_name .or.
& offset_in .ne. 0 .or. field_typeid_in .ne. NF_INT .or.
& ndims_in .ne. NDIMS .or.
& dim_sizes_in(1) .ne. dim_sizes(1) .or.
& dim_sizes_in(2) .ne. dim_sizes(2)) stop 2
C Close the file.
retval = nf_close(ncid)
if (retval .ne. nf_noerr) call handle_err(retval)
print *,'*** SUCCESS!'
end
|
