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