"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.5.2/nf_test4/ftst_vars.F" (18 Sep 2019, 5966 Bytes) of package /linux/misc/netcdf-fortran-4.5.2.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Fortran 77 source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 C     This is part of the netCDF package.
    2 C     Copyright 2006 University Corporation for Atmospheric Research/Unidata.
    3 C     See COPYRIGHT file for conditions of use.
    4 
    5 C     This program tests netCDF-4 variable functions from fortran,
    6 C     testing chunking and deflate settings.
    7 
    8 C     $Id: ftst_vars.F,v 1.19 2009/09/27 21:25:23 ed Exp $
    9 
   10       program ftst_vars
   11       implicit none
   12       include 'netcdf.inc'
   13 
   14 C     This is the name of the data file we will create.
   15       character*(*) FILE_NAME
   16       parameter (FILE_NAME='ftst_vars.nc')
   17 
   18 C     We are writing 2D data, a 6 x 12 grid. 
   19       integer NDIMS
   20       parameter (NDIMS=2)
   21       integer NX, NY
   22       parameter (NX = 6, NY = 12)
   23 
   24 C     NetCDF IDs.
   25       integer ncid, varid, dimids(NDIMS)
   26       integer x_dimid, y_dimid
   27 
   28 C     This is the data array we will write, and a place to store it when
   29 C     we read it back in.
   30       integer data_out(NY, NX), data_in(NY, NX)
   31 
   32 C     For checking our data file to make sure it's correct.
   33       integer chunks(NDIMS), chunks_in(NDIMS)
   34       integer shuffle, deflate, deflate_level, checksum, contiguous
   35       integer endianness
   36 
   37 C     Cache size stuff.
   38       integer CACHE_SIZE, CACHE_NELEMS, CACHE_PREEMPTION
   39       parameter (CACHE_SIZE = 8000, CACHE_NELEMS = 500)
   40       parameter (CACHE_PREEMPTION = 50)
   41       integer cache_size_in, cache_nelems_in, cache_preemption_in
   42 
   43 C     Loop indexes, and error handling.
   44       integer x, y, retval
   45 
   46 C     Create some pretend data.
   47       do x = 1, NX
   48          do y = 1, NY
   49             data_out(y, x) = 2147483646 + x * y
   50          end do
   51       end do
   52 
   53       print *, ''
   54       print *,'*** Testing definition of netCDF-4 vars from Fortran 77.'
   55 
   56 C     Change the cache size for the files created/opened in this program.
   57       retval = nf_set_chunk_cache(CACHE_SIZE, CACHE_NELEMS, 
   58      &     CACHE_PREEMPTION)
   59       if (retval .ne. nf_noerr) stop 1
   60 
   61 C     Check chunk cache sizes.
   62       retval = nf_get_chunk_cache(cache_size_in, cache_nelems_in, 
   63      &     cache_preemption_in)
   64       if (retval .ne. nf_noerr) stop 1
   65       if (cache_size_in .ne. CACHE_SIZE .or. 
   66      &     cache_nelems_in .ne. CACHE_NELEMS .or. 
   67      &     cache_preemption_in .ne. CACHE_PREEMPTION) stop 4
   68 
   69 C     Create the netCDF file.
   70       retval = nf_create(FILE_NAME, NF_NETCDF4, ncid)
   71       if (retval .ne. nf_noerr) stop 1
   72 
   73 C     Define the dimensions.
   74       retval = nf_def_dim(ncid, "x", NX, x_dimid)
   75       if (retval .ne. nf_noerr) stop 1
   76       retval = nf_def_dim(ncid, "y", NY, y_dimid)
   77       if (retval .ne. nf_noerr) stop 1
   78 
   79 C     Define the variable. 
   80       dimids(1) = y_dimid
   81       dimids(2) = x_dimid
   82       retval = nf_def_var(ncid, "data", NF_INT64, NDIMS, dimids, varid)
   83       if (retval .ne. nf_noerr) stop 1
   84 
   85 C     Turn on chunking.
   86       chunks(1) = NY
   87       chunks(2) = NX
   88       retval = nf_def_var_chunking(ncid, varid, 0, chunks)
   89       if (retval .ne. nf_noerr) stop 1
   90 
   91 C     Set variable to big-endian (default is whatever is native to
   92 C     writing machine).
   93       retval = nf_def_var_endian(ncid, varid, NF_ENDIAN_BIG)
   94       if (retval .ne. nf_noerr) stop 1
   95 
   96 C     Turn on deflate, fletcher32.
   97       retval = nf_def_var_deflate(ncid, varid, 0, 1, 4)
   98       if (retval .ne. nf_noerr) stop 1
   99       retval = nf_def_var_fletcher32(ncid, varid, NF_FLETCHER32)
  100       if (retval .ne. nf_noerr) stop 1
  101 
  102 C     Is everything set that is supposed to be?
  103       retval = nf_inq_var_deflate(ncid, varid, shuffle, deflate, 
  104      +     deflate_level)
  105       if (retval .ne. nf_noerr) stop 1
  106       if (shuffle .ne. 0 .or. deflate .ne. 1 .or. 
  107      +     deflate_level .ne. 4) stop 2
  108       retval = nf_inq_var_fletcher32(ncid, varid, checksum)
  109       if (retval .ne. nf_noerr) stop 1
  110       if (checksum .ne. NF_FLETCHER32) stop 2
  111       retval = nf_inq_var_chunking(ncid, varid, contiguous, chunks_in)
  112       if (retval .ne. nf_noerr) stop 1
  113       if (contiguous .ne. 0) stop 2
  114       if (chunks(1) .ne. chunks_in(1) .or.
  115      +     chunks(2) .ne. chunks_in(2)) stop 2
  116       retval = nf_inq_var_endian(ncid, varid, endianness)
  117       if (retval .ne. nf_noerr) stop 1
  118       if (endianness .ne. NF_ENDIAN_BIG) stop 2
  119 
  120 C     Since this is a classic model file, we must call enddef
  121       retval = nf_enddef(ncid)
  122       if (retval .ne. nf_noerr) stop 1
  123 
  124 C     Write the pretend data to the file.
  125       retval = nf_put_var_int(ncid, varid, data_out)
  126       if (retval .ne. nf_noerr) stop 1
  127 
  128 C     Close the file. 
  129       retval = nf_close(ncid)
  130       if (retval .ne. nf_noerr) stop 1
  131 
  132 C     Reopen the file and check again.
  133       retval = nf_open(FILE_NAME, NF_NOWRITE, ncid)
  134       if (retval .ne. nf_noerr) stop 1
  135 
  136 C     Find our variable.
  137       retval = nf_inq_varid(ncid, "data", varid)
  138       if (retval .ne. nf_noerr) stop 1
  139       if (varid .ne. 1) stop 2
  140 
  141 C     Check the deflate, fletcher32, chunking, and endianness.
  142       retval = nf_inq_var_deflate(ncid, varid, shuffle, deflate, 
  143      +     deflate_level)
  144       if (retval .ne. nf_noerr) stop 1
  145       if (shuffle .ne. 0 .or. deflate .ne. 1 .or. 
  146      +     deflate_level .ne. 4) stop 2
  147       retval = nf_inq_var_fletcher32(ncid, varid, checksum)
  148       if (retval .ne. nf_noerr) stop 1
  149       if (checksum .ne. NF_FLETCHER32) stop 2
  150       retval = nf_inq_var_chunking(ncid, varid, contiguous, chunks_in)
  151       if (retval .ne. nf_noerr) stop 1
  152       if (contiguous .ne. 0) stop 2
  153       if (chunks(1) .ne. chunks_in(1) .or.
  154      +     chunks(2) .ne. chunks_in(2)) stop 2
  155       retval = nf_inq_var_endian(ncid, varid, endianness)
  156       if (retval .ne. nf_noerr) stop 1
  157       if (endianness .ne. NF_ENDIAN_BIG) stop 2
  158 
  159 C     Read the data and check it.
  160       retval = nf_get_var_int(ncid, varid, data_in)
  161       if (retval .ne. nf_noerr) stop 1
  162       do x = 1, NX
  163          do y = 1, NY
  164             if (data_in(y, x) .ne. data_out(y, x)) stop 2
  165          end do
  166       end do
  167 
  168 C     Close the file. 
  169       retval = nf_close(ncid)
  170       if (retval .ne. nf_noerr) stop 1
  171 
  172       print *,'*** SUCCESS!'
  173       end