"Fossies" - the Fresh Open Source Software Archive

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