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
|
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 testing chunking and deflate settings.
C Ed Hartnett
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 DEFAULT_CACHE_SIZE, DEFAULT_CACHE_NELEMS
integer DEFAULT_CACHE_PREEMPTION
parameter (DEFAULT_CACHE_SIZE = 16777216)
parameter (DEFAULT_CACHE_NELEMS = 4133)
parameter (DEFAULT_CACHE_PREEMPTION = 75)
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 Check default chunk cache sizes.
retval = nf_get_chunk_cache(cache_size_in, cache_nelems_in,
& cache_preemption_in)
if (retval .ne. nf_noerr) stop 1
if (cache_size_in .ne. DEFAULT_CACHE_SIZE .or.
& cache_nelems_in .ne. DEFAULT_CACHE_NELEMS .or.
& cache_preemption_in .ne. DEFAULT_CACHE_PREEMPTION) stop 4
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) stop 1
C Check chunk cache sizes.
retval = nf_get_chunk_cache(cache_size_in, cache_nelems_in,
& cache_preemption_in)
if (retval .ne. nf_noerr) stop 1
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) stop 1
C Define the dimensions.
retval = nf_def_dim(ncid, "x", NX, x_dimid)
if (retval .ne. nf_noerr) stop 1
retval = nf_def_dim(ncid, "y", NY, y_dimid)
if (retval .ne. nf_noerr) stop 1
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) stop 1
C Turn on chunking.
chunks(1) = NY
chunks(2) = NX
retval = nf_def_var_chunking(ncid, varid, 0, chunks)
if (retval .ne. nf_noerr) stop 1
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) stop 1
C Turn on deflate, fletcher32.
retval = nf_def_var_deflate(ncid, varid, 0, 1, 4)
if (retval .ne. nf_noerr) stop 1
retval = nf_def_var_fletcher32(ncid, varid, NF_FLETCHER32)
if (retval .ne. nf_noerr) stop 1
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) stop 1
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) stop 1
if (checksum .ne. NF_FLETCHER32) stop 2
retval = nf_inq_var_chunking(ncid, varid, contiguous, chunks_in)
if (retval .ne. nf_noerr) stop 1
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) stop 1
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) stop 1
C Write the pretend data to the file.
retval = nf_put_var_int(ncid, varid, 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 and check again.
retval = nf_open(FILE_NAME, NF_NOWRITE, ncid)
if (retval .ne. nf_noerr) stop 1
C Find our variable.
retval = nf_inq_varid(ncid, "data", varid)
if (retval .ne. nf_noerr) stop 1
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) stop 1
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) stop 1
if (checksum .ne. NF_FLETCHER32) stop 2
retval = nf_inq_var_chunking(ncid, varid, contiguous, chunks_in)
if (retval .ne. nf_noerr) stop 1
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) stop 1
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) stop 1
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) stop 1
print *,'*** SUCCESS!'
end
|