1C********************************************************************
2C   Copyright 1993, UCAR/Unidata
3C   See netcdf/COPYRIGHT file for copying and redistribution conditions.
4C   $Id: ftest.F,v 1.11 2009/01/25 14:33:45 ed Exp $
5C********************************************************************
6
7C     This is part of the netCDF package.
8C     Copyright 2006 University Corporation for Atmospheric Research/Unidata.
9C     See COPYRIGHT file for conditions of use.
10
11C     This program tests netCDF-4 variable Filter support from fortran.
12
13      program ftst_filter
14      implicit none
15      include 'netcdf.inc'
16
17C     This is the name of the data file we will create.
18      character*(*) FILE_NAME
19      parameter (FILE_NAME='ftst_filter.nc')
20
21C     We are writing 2D data, a 6 x 12 grid.
22      integer NDIMS
23      parameter (NDIMS=2)
24      integer NX, NY
25      parameter (NX = 6, NY = 12)
26      integer DATAOFFSET
27C      parameter (DATAOFFSET = 2147483646)
28      parameter (DATAOFFSET = 0)
29
30C     NetCDF IDs.
31      integer ncid, varid, dimids(NDIMS)
32      integer x_dimid, y_dimid
33
34C     This is the data array we will write, and a place to store it when
35C     we read it back in.
36      integer data_out(NY, NX), data_in(NY, NX)
37
38C     For checking our data file to make sure it's correct.
39      integer chunks(NDIMS), chunks_in(NDIMS)
40      integer filterid, nparams, params(1)
41
42C     Loop indexes, and error handling.
43      integer x, y, retval
44
45C     Create some pretend data.
46      do x = 1, NX
47         do y = 1, NY
48            data_out(y, x) = DATAOFFSET + x * y
49         end do
50      end do
51
52      print *, ''
53      print *,'*** Testing definition netCDF-4 Filters'
54
55C     Create the netCDF file.
56      retval = nf_create(FILE_NAME, NF_CLOBBER+NF_NETCDF4, ncid)
57      if (retval .ne. nf_noerr) stop 1
58
59C     Define the dimensions.
60      retval = nf_def_dim(ncid, "x", NX, x_dimid)
61      if (retval .ne. nf_noerr) stop 1
62      retval = nf_def_dim(ncid, "y", NY, y_dimid)
63      if (retval .ne. nf_noerr) stop 1
64
65C     Define the variable.
66      dimids(1) = y_dimid
67      dimids(2) = x_dimid
68      retval = nf_def_var(ncid, "data", NF_INT64, NDIMS, dimids, varid)
69      if (retval .ne. nf_noerr) stop 1
70
71C     Turn on chunking.
72      chunks(1) = NY
73      chunks(2) = NX
74      retval = nf_def_var_chunking(ncid, varid, 0, chunks)
75      if (retval .ne. nf_noerr) stop 1
76
77C     Set bzip filter on variable
78      params(1) = 9
79      retval = nf_def_var_filter(ncid, varid, 307, 1, params)
80      if (retval .ne. nf_noerr) stop 1
81
82      retval = nf_enddef(ncid)
83      if (retval .ne. nf_noerr) stop 1
84
85C     Write the pretend data to the file.
86      retval = nf_put_var_int(ncid, varid, data_out)
87      if (retval .ne. nf_noerr) stop 1
88
89C     Close the file.
90      retval = nf_close(ncid)
91      if (retval .ne. nf_noerr) stop 1
92
93C     Reopen the file and check again.
94      retval = nf_open(FILE_NAME, NF_NOWRITE, ncid)
95      if (retval .ne. nf_noerr) stop 1
96
97C     Find our variable.
98      retval = nf_inq_varid(ncid, "data", varid)
99      if (retval .ne. nf_noerr) stop 1
100      if (varid .ne. 1) stop 2
101
102C     Check the filter
103      params(1) = -1
104      retval = nf_inq_var_filter(ncid, varid, filterid, nparams, params)
105      if (retval .ne. nf_noerr) stop 1
106      if (filterid .ne. 307) stop 2
107      if (nparams .ne. 1) stop 2
108      if (params(1) .ne. 9) stop 2
109
110C     Read the data and check it.
111      retval = nf_get_var_int(ncid, varid, data_in)
112      if (retval .ne. nf_noerr) stop 1
113      do x = 1, NX
114         do y = 1, NY
115            if (data_in(y, x) .ne. data_out(y, x)) stop 2
116         end do
117      end do
118
119C     Close the file.
120      retval = nf_close(ncid)
121      if (retval .ne. nf_noerr) stop 1
122
123      print *,'*** SUCCESS!'
124      end
125