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
|
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_vars.F,v 1.19 2009/09/27 21:25:23 ed Exp $
program ftst_vars
implicit none
include 'netcdf.inc'
C This is the name of the data file we will create.
character*(*) FILE_NAME
parameter (FILE_NAME='ftst_vars.nc')
C We are writing 2D data, a 6 x 12 grid.
integer NDIMS
parameter (NDIMS=2)
integer NX, NY
parameter (NX = 6, NY = 12)
C NetCDF IDs.
integer ncid, varid, dimids(NDIMS)
integer x_dimid, y_dimid
C This is the data array we will write, and a place to store it when
C we read it back in.
integer data_out(NY, NX), data_in(NY, NX)
C For checking our data file to make sure it's correct.
integer chunks(NDIMS), chunks_in(NDIMS)
integer shuffle, deflate, deflate_level, checksum, contiguous
integer endianness
C Cache size stuff.
integer CACHE_SIZE, CACHE_NELEMS, CACHE_PREEMPTION
parameter (CACHE_SIZE = 8000, CACHE_NELEMS = 500)
parameter (CACHE_PREEMPTION = 50)
integer cache_size_in, cache_nelems_in, cache_preemption_in
C Loop indexes, and error handling.
integer x, y, retval
C Create some pretend data.
do x = 1, NX
do y = 1, NY
data_out(y, x) = 2147483646 + x * y
end do
end do
print *, ''
print *,'*** Testing definition of netCDF-4 vars from Fortran 77.'
C Change the cache size for the files created/opened in this program.
retval = nf_set_chunk_cache(CACHE_SIZE, CACHE_NELEMS,
& CACHE_PREEMPTION)
if (retval .ne. nf_noerr) call handle_err(retval)
C Check chunk cache sizes.
retval = nf_get_chunk_cache(cache_size_in, cache_nelems_in,
& cache_preemption_in)
if (retval .ne. nf_noerr) call handle_err(retval)
if (cache_size_in .ne. CACHE_SIZE .or.
& cache_nelems_in .ne. CACHE_NELEMS .or.
& cache_preemption_in .ne. CACHE_PREEMPTION) stop 4
C Create the netCDF file.
retval = nf_create(FILE_NAME, NF_NETCDF4, ncid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Define the dimensions.
retval = nf_def_dim(ncid, "x", NX, x_dimid)
if (retval .ne. nf_noerr) call handle_err(retval)
retval = nf_def_dim(ncid, "y", NY, y_dimid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Define the variable.
dimids(1) = y_dimid
dimids(2) = x_dimid
retval = nf_def_var(ncid, "data", NF_INT64, NDIMS, dimids, varid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Turn on chunking.
chunks(1) = NY
chunks(2) = NX
retval = nf_def_var_chunking(ncid, varid, 0, chunks)
if (retval .ne. nf_noerr) call handle_err(retval)
C Set variable to big-endian (default is whatever is native to
C writing machine).
retval = nf_def_var_endian(ncid, varid, NF_ENDIAN_BIG)
if (retval .ne. nf_noerr) call handle_err(retval)
C Turn on deflate, fletcher32.
retval = nf_def_var_deflate(ncid, varid, 0, 1, 4)
if (retval .ne. nf_noerr) call handle_err(retval)
retval = nf_def_var_fletcher32(ncid, varid, NF_FLETCHER32)
if (retval .ne. nf_noerr) call handle_err(retval)
C Is everything set that is supposed to be?
retval = nf_inq_var_deflate(ncid, varid, shuffle, deflate,
+ deflate_level)
if (retval .ne. nf_noerr) call handle_err(retval)
if (shuffle .ne. 0 .or. deflate .ne. 1 .or.
+ deflate_level .ne. 4) stop 2
retval = nf_inq_var_fletcher32(ncid, varid, checksum)
if (retval .ne. nf_noerr) call handle_err(retval)
if (checksum .ne. NF_FLETCHER32) stop 2
retval = nf_inq_var_chunking(ncid, varid, contiguous, chunks_in)
if (retval .ne. nf_noerr) call handle_err(retval)
if (contiguous .ne. 0) stop 2
if (chunks(1) .ne. chunks_in(1) .or.
+ chunks(2) .ne. chunks_in(2)) stop 2
retval = nf_inq_var_endian(ncid, varid, endianness)
if (retval .ne. nf_noerr) call handle_err(retval)
if (endianness .ne. NF_ENDIAN_BIG) stop 2
C Since this is a classic model file, we must call enddef
retval = nf_enddef(ncid)
if (retval .ne. nf_noerr) call handle_err(retval)
C Write the pretend data to the file.
retval = nf_put_var_int(ncid, varid, data_out)
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 our variable.
retval = nf_inq_varid(ncid, "data", varid)
if (retval .ne. nf_noerr) call handle_err(retval)
if (varid .ne. 1) stop 2
C Check the deflate, fletcher32, chunking, and endianness.
retval = nf_inq_var_deflate(ncid, varid, shuffle, deflate,
+ deflate_level)
if (retval .ne. nf_noerr) call handle_err(retval)
if (shuffle .ne. 0 .or. deflate .ne. 1 .or.
+ deflate_level .ne. 4) stop 2
retval = nf_inq_var_fletcher32(ncid, varid, checksum)
if (retval .ne. nf_noerr) call handle_err(retval)
if (checksum .ne. NF_FLETCHER32) stop 2
retval = nf_inq_var_chunking(ncid, varid, contiguous, chunks_in)
if (retval .ne. nf_noerr) call handle_err(retval)
if (contiguous .ne. 0) stop 2
if (chunks(1) .ne. chunks_in(1) .or.
+ chunks(2) .ne. chunks_in(2)) stop 2
retval = nf_inq_var_endian(ncid, varid, endianness)
if (retval .ne. nf_noerr) call handle_err(retval)
if (endianness .ne. NF_ENDIAN_BIG) stop 2
C Read the data and check it.
retval = nf_get_var_int(ncid, varid, data_in)
if (retval .ne. nf_noerr) call handle_err(retval)
do x = 1, NX
do y = 1, NY
if (data_in(y, x) .ne. data_out(y, x)) stop 2
end do
end do
C Close the file.
retval = nf_close(ncid)
if (retval .ne. nf_noerr) call handle_err(retval)
print *,'*** SUCCESS!'
end
|
