C     Copyright 1996-2019, UCAR/Unidata
C     See netcdf/COPYRIGHT file for copying and redistribution conditions.

C     Steve Emmerson, Ed Hartnett

C     Test nf_create
C     For mode in NF_NOCLOBBER, NF_CLOBBER do:
C     create netcdf file 'scratch.nc' with no data, close it
C     test that it can be opened, do nf_inq to check nvars = 0, etc.
C     Try again in NF_NOCLOBBER mode, check error return
C     On exit, delete this file
      subroutine test_nf_create()
      implicit none
#include "tests.inc"

      integer clobber           !/* 0 for NF_NOCLOBBER, 1 for NF_CLOBBER */
      integer err
      integer ncid
      integer ndims1             !/* number of dimensions */
      integer nvars1             !/* number of variables */
      integer ngatts1            !/* number of global attributes */
      integer recdim1            !/* id of unlimited dimension */
      integer flags

      flags = NF_NOCLOBBER
      do 1, clobber = 0, 1
         err = nf_create(scratch, flags, ncid)
         if (err .ne. 0) then
            call errore('nf_create: ', err)
         end if
         err = nf_close(ncid)
         if (err .ne. 0) then
            call errore('nf_close: ', err)
         end if
         err = nf_open(scratch, NF_NOWRITE, ncid)
         if (err .ne. 0) then
            call errore('nf_open: ', err)
         end if
         err = nf_inq(ncid, ndims1, nvars1, ngatts1, recdim1)
         if (err .ne. 0) then
            call errore('nf_inq: ', err)
         else if (ndims1 .ne. 0) then
            call errori(
     +           'nf_inq: wrong number of dimensions returned, ',
     +           ndims1)
         else if (nvars1 .ne. 0) then
            call errori(
     +           'nf_inq: wrong number of variables returned, ',
     +           nvars1)
         else if (ngatts1 .ne. 0) then
            call errori(
     +           'nf_inq: wrong number of global atts returned, ',
     +           ngatts1)
         else if (recdim1 .ge. 1) then
            call errori(
     +           'nf_inq: wrong record dimension ID returned, ',
     +           recdim1)
         end if
         err = nf_close(ncid)
         if (err .ne. 0) then
            call errore('nf_close: ', err)
         end if

         flags = NF_CLOBBER
 1    continue

      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. NF_EEXIST) then
         call errore('attempt to overwrite file: ', err)
      end if
      err = nf_delete(scratch)
      if (err .ne. 0) then
         call errori('delete of scratch file failed: ', err)
      end if
      end


C     Test nf_redef
C     (In fact also tests nf_enddef - called from test_nf_enddef)
C     BAD_ID
C     attempt redef (error) & enddef on read-only file
C     create file, define dims & vars.
C     attempt put var (error)
C     attempt redef (error) & enddef.
C     put vars
C     attempt def new dims (error)
C     redef
C     def new dims, vars.
C     put atts
C     enddef
C     put vars
C     close
C     check file: vars & atts
      subroutine test_nf_redef()
      implicit none
#include "tests.inc"
      integer         title_len
      parameter       (title_len = 9)

      integer                 ncid !/* netcdf id */
      integer                 dimid !/* dimension id */
      integer                 vid !/* variable id */
      integer                 err
      character*(title_len)   title
      doubleprecision         var
      character*(NF_MAX_NAME) name
      integer                 length

      title = 'Not funny'

C     /* BAD_ID tests */
      err = nf_redef(BAD_ID)
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)
      err = nf_enddef(BAD_ID)
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)

C     /* read-only tests */
      err = nf_open(testfile, NF_NOWRITE, ncid)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      err = nf_redef(ncid)
      if (err .ne. NF_EPERM)
     +     call errore('nf_redef in NF_NOWRITE mode: ', err)
      err = nf_enddef(ncid)
      if (err .ne. NF_ENOTINDEFINE)
     +     call errore('nf_redef in NF_NOWRITE mode: ', err)
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

C     /* tests using scratch file */
      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      call def_dims(ncid)
      call def_vars(ncid)
      call put_atts(ncid)
      err = nf_inq_varid(ncid, 'd', vid)
      if (err .ne. 0)
     +     call errore('nf_inq_varid: ', err)
      var = 1.0
      err = nf_put_var1_double(ncid, vid, (/0/), var)
      if (err .ne. NF_EINDEFINE)
     +     call errore('nf_put_var... in define mode: ', err)
      err = nf_redef(ncid)
      if (err .ne. NF_EINDEFINE)
     +     call errore('nf_redef in define mode: ', err)
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      call put_vars(ncid)
      err = nf_def_dim(ncid, 'abc', 8, dimid)
      if (err .ne. NF_ENOTINDEFINE)
     +     call errore('nf_def_dim in define mode: ', err)
      err = nf_redef(ncid)
      if (err .ne. 0)
     +     call errore('nf_redef: ', err)
      err = nf_def_dim(ncid, 'abc', 8, dimid)
      if (err .ne. 0)
     +     call errore('nf_def_dim: ', err)
      err = nf_def_var(ncid, 'abc', NF_INT, 0, (/0/), vid)
      if (err .ne. 0)
     +     call errore('nf_def_var: ', err)
      err = nf_put_att_text(ncid, NF_GLOBAL, 'title', len(title),
     +     title)
      if (err .ne .0)
     +     call errore('nf_put_att_text: ', err)
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      var = 1.0
      err = nf_put_var1_double(ncid, vid, (/0/), var)
      if (err .ne. 0)
     +     call errore('nf_put_var1_double: ', err)
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

C     /* check scratch file written as expected */
      call check_file(scratch)
      err = nf_open(scratch, NF_NOWRITE, ncid)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      err = nf_inq_dim(ncid, dimid, name, length)
      if (err .ne. 0)
     +     call errore('nf_inq_dim: ', err)
      if (name .ne. "abc")
     +     call errori('Unexpected dim name in netCDF ', ncid)
      if (length .ne. 8)
     +     call errori('Unexpected dim length: ', length)
      err = nf_get_var1_double(ncid, vid, (/0/), var)
      if (err .ne. 0)
     +     call errore('nf_get_var1_double: ', err)
      if (var .ne. 1.0)
     +     call errori(
     +     'nf_get_var1_double: unexpected value in netCDF ', ncid)
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errori('delete failed for netCDF: ', err)
      end

C     Test nf_enddef
C     Simply calls test_nf_redef which tests both nf_redef & nf_enddef

      subroutine test_nf_enddef()
      implicit none
#include "tests.inc"

      call test_nf_redef
      end


C     Test nf_sync
C     try with bad handle, check error
C     try in define mode, check error
C     try writing with one handle, reading with another on same netCDF
      subroutine test_nf_sync()
      implicit none
#include "tests.inc"

      integer ncidw             !/* netcdf id for writing */
      integer ncidr             !/* netcdf id for reading */
      integer err

C     /* BAD_ID test */
      err = nf_sync(BAD_ID)
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)

C     /* create scratch file & try nf_sync in define mode */
      err = nf_create(scratch, NF_NOCLOBBER, ncidw)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      err = nf_sync(ncidw)
      if (err .ne. NF_EINDEFINE)
     +     call errore('nf_sync called in define mode: ', err)

C     /* write using same handle */
      call def_dims(ncidw)
      call def_vars(ncidw)
      call put_atts(ncidw)
      err = nf_enddef(ncidw)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      call put_vars(ncidw)
      err = nf_sync(ncidw)
      if (err .ne. 0)
     +     call errore('nf_sync of ncidw failed: ', err)

C     /* open another handle, nf_sync, read (check) */
      err = nf_open(scratch, NF_NOWRITE, ncidr)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      err = nf_sync(ncidr)
      if (err .ne. 0)
     +     call errore('nf_sync of ncidr failed: ', err)
      call check_dims(ncidr)
      call check_atts(ncidr)
      call check_vars(ncidr)

C     /* close both handles */
      err = nf_close(ncidr)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_close(ncidw)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errori('delete of scratch file failed: ', err)
      end


C     Test nf_abort
C     try with bad handle, check error
C     try in define mode before anything written, check that file was deleted
C     try after nf_enddef, nf_redef, define new dims, vars, atts
C     try after writing variable
      subroutine test_nf_abort()
      implicit none
#include "tests.inc"

      integer ncid              !/* netcdf id */
      integer err
      integer ndims1
      integer nvars1
      integer ngatts1
      integer recdim1

C     /* BAD_ID test */
      err = nf_abort(BAD_ID)
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: status = ', err)

C     /* create scratch file & try nf_abort in define mode */
      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      call def_dims(ncid)
      call def_vars(ncid)
      call put_atts(ncid)
      err = nf_abort(ncid)
      if (err .ne. 0)
     +     call errore('nf_abort of ncid failed: ', err)
      err = nf_close(ncid)      !/* should already be closed */
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)
      err = nf_delete(scratch)  !/* should already be deleted */
      if (err .eq. 0)
     +     call errori('scratch file should not exist: ', err)

C     create scratch file
C     do nf_enddef & nf_redef
C     define new dims, vars, atts
C     try nf_abort: should restore previous state (no dims, vars, atts)
      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      err = nf_redef(ncid)
      if (err .ne. 0)
     +     call errore('nf_redef: ', err)
      call def_dims(ncid)
      call def_vars(ncid)
      call put_atts(ncid)
      err = nf_abort(ncid)
      if (err .ne. 0)
     +     call errore('nf_abort of ncid failed: ', err)
      err = nf_close(ncid)      !/* should already be closed */
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)
      err = nf_open(scratch, NF_NOWRITE, ncid)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      err = nf_inq (ncid, ndims1, nvars1, ngatts1, recdim1)
      if (err .ne. 0)
     +     call errore('nf_inq: ', err)
      if (ndims1 .ne. 0)
     +     call errori('ndims1 should be ', 0)
      if (nvars1 .ne. 0)
     +     call errori('nvars1 should be ', 0)
      if (ngatts1 .ne. 0)
     +     call errori('ngatts1 should be ', 0)
      err = nf_close (ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

C     /* try nf_abort in data mode - should just close */
      err = nf_create(scratch, NF_CLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      call def_dims(ncid)
      call def_vars(ncid)
      call put_atts(ncid)
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      call put_vars(ncid)
      err = nf_abort(ncid)
      if (err .ne. 0)
     +     call errore('nf_abort of ncid failed: ', err)
      err = nf_close(ncid)      !/* should already be closed */
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)
      call check_file(scratch)
      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errori('delete of scratch file failed: ', err)
      end


C     Test nf_def_dim
C     try with bad netCDF handle, check error
C     try in data mode, check error
C     check that returned id is one more than previous id
C     try adding same dimension twice, check error
C     try with illegal sizes, check error
C     make sure unlimited size works, shows up in nf_inq_unlimdim
C     try to define a second unlimited dimension, check error
      subroutine test_nf_def_dim()
      implicit none
#include "tests.inc"

      integer ncid
      integer err               !/* status */
      integer i
      integer dimid             !/* dimension id */
      integer length

C     /* BAD_ID test */
      err = nf_def_dim(BAD_ID, 'abc', 8, dimid)
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)

C     /* data mode test */
      err = nf_create(scratch, NF_CLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      err = nf_def_dim(ncid, 'abc', 8, dimid)
      if (err .ne. NF_ENOTINDEFINE)
     +     call errore('bad ncid: ', err)

C     /* define-mode tests: unlimited dim */
      err = nf_redef(ncid)
      if (err .ne. 0)
     +     call errore('nf_redef: ', err)
      err = nf_def_dim(ncid, dim_name(1), NF_UNLIMITED, dimid)
      if (err .ne. 0)
     +     call errore('nf_def_dim: ', err)
      if (dimid .ne. 1)
     +     call errori('Unexpected dimid: ', dimid)
      err = nf_inq_unlimdim(ncid, dimid)
      if (err .ne. 0)
     +     call errore('nf_inq_unlimdim: ', err)
      if (dimid .ne. RECDIM)
     +     call error('Unexpected recdim1: ')
      err = nf_inq_dimlen(ncid, dimid, length)
      if (length .ne. 0)
     +     call errori('Unexpected length: ', 0)
      err = nf_def_dim(ncid, 'abc', NF_UNLIMITED, dimid)
      if (err .ne. NF_EUNLIMIT)
     +     call errore('2nd unlimited dimension: ', err)

C     /* define-mode tests: remaining dims */
      do 1, i = 2, NDIMS
         err = nf_def_dim(ncid, dim_name(i-1), dim_len(i),
     +        dimid)
         if (err .ne. NF_ENAMEINUSE)
     +        call errore('duplicate name: ', err)
         err = nf_def_dim(ncid, BAD_NAME, dim_len(i), dimid)
         if (err .ne. NF_EBADNAME)
     +        call errore('bad name: ', err)
         err = nf_def_dim(ncid, dim_name(i), NF_UNLIMITED-1,
     +        dimid)
         if (err .ne. NF_EDIMSIZE)
     +        call errore('bad size: ', err)
         err = nf_def_dim(ncid, dim_name(i), dim_len(i), dimid)
         if (err .ne. 0)
     +        call errore('nf_def_dim: ', err)
         if (dimid .ne. i)
     +        call errori('Unexpected dimid: ', 0)
 1    continue

C     /* Following just to expand unlimited dim */
      call def_vars(ncid)
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      call put_vars(ncid)

C     /* Check all dims */
      call check_dims(ncid)

      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errori('delete of scratch file failed: ', err)
      end


C     Test nf_rename_dim
C     try with bad netCDF handle, check error
C     check that proper rename worked with nf_inq_dim
C     try renaming to existing dimension name, check error
C     try with bad dimension handle, check error
      subroutine test_nf_rename_dim()
      implicit none
#include "tests.inc"

      integer ncid
      integer err               !/* status */
      character*(NF_MAX_NAME) name

C     /* BAD_ID test */
      err = nf_rename_dim(BAD_ID, 1, 'abc')
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)

C     /* main tests */
      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      call def_dims(ncid)
      err = nf_rename_dim(ncid, BAD_DIMID, 'abc')
      if (err .ne. NF_EBADDIM)
     +     call errore('bad dimid: ', err)
      err = nf_rename_dim(ncid, 3, 'abc')
      if (err .ne. 0)
     +     call errore('nf_rename_dim: ', err)
      err = nf_inq_dimname(ncid, 3, name)
      if (name .ne. 'abc')
     +     call errorc('Unexpected name: ', name)
      err = nf_rename_dim(ncid, 1, 'abc')
      if (err .ne. NF_ENAMEINUSE)
     +     call errore('duplicate name: ', err)

      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errori('delete of scratch file failed: ', err)
      end


C     Test nf_def_var
C     try with bad netCDF handle, check error
C     try with bad name, check error
C     scalar tests:
C     check that proper define worked with nf_inq_var
C     try redefining an existing variable, check error
C     try with bad datatype, check error
C     try with bad number of dimensions, check error
C     try in data mode, check error
C     check that returned id is one more than previous id
C     try with bad dimension ids, check error
      subroutine test_nf_def_var()
      implicit none
#include "tests.inc"

      integer ncid
      integer vid
      integer err               !/* status */
      integer i
      integer ndims1
      integer na
      character*(NF_MAX_NAME) name
      integer dimids(MAX_RANK)
      integer datatype

C     /* BAD_ID test */
      err = nf_def_var(BAD_ID, 'abc', NF_SHORT, 0, dimids, vid)
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: status = ', err)

C     /* scalar tests */
      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      err = nf_def_var(ncid, 'abc', NF_SHORT, 0, dimids, vid)
      if (err .ne. 0)
     +     call errore('nf_def_var: ', err)
      err = nf_inq_var(ncid, vid, name, datatype, ndims1, dimids,
     +     na)
      if (err .ne. 0)
     +     call errore('nf_inq_var: ', err)
      if (name .ne. 'abc')
     +     call errorc('Unexpected name: ', name)
      if (datatype .ne. NF_SHORT)
     +     call error('Unexpected datatype')
      if (ndims1 .ne. 0)
     +     call error('Unexpected rank')
      err = nf_def_var(ncid, BAD_NAME, NF_SHORT, 0, dimids, vid)
      if (err .ne. NF_EBADNAME)
     +     call errore('bad name: ', err)
      err = nf_def_var(ncid, 'abc', NF_SHORT, 0, dimids, vid)
      if (err .ne. NF_ENAMEINUSE)
     +     call errore('duplicate name: ', err)
      err = nf_def_var(ncid, 'ABC', BAD_TYPE, -1, dimids, vid)
      if (err .ne. NF_EBADTYPE)
     +     call errore('bad type: ', err)
      err = nf_def_var(ncid, 'ABC', NF_SHORT, -1, dimids, vid)
      if (err .ne. NF_EINVAL)
     +     call errore('bad rank: ', err)
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      err = nf_def_var(ncid, 'ABC', NF_SHORT, 0, dimids, vid)
      if (err .ne. NF_ENOTINDEFINE)
     +     call errore('nf_def_var called in data mode: ', err)
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errorc('delete of scratch file failed: ', scratch)

C     /* general tests using global vars */
      err = nf_create(scratch, NF_CLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      call def_dims(ncid)
      do 1, i = 1, NVARS
         err = nf_def_var(ncid, var_name(i), var_type(i),
     +        var_rank(i), var_dimid(1,i), vid)
         if (err .ne. 0)
     +        call errore('nf_def_var: ', err)
         if (vid .ne. i)
     +        call error('Unexpected varid')
 1    continue

C     /* try bad dim ids */
      dimids(1) = BAD_DIMID
      err = nf_def_var(ncid, 'abc', NF_SHORT, 1, dimids, vid)
      if (err .ne. NF_EBADDIM)
     +     call errore('bad dim ids: ', err)
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errorc('delete of scratch file failed: ', scratch)
      end


C     Test nf_rename_var
C     try with bad netCDF handle, check error
C     try with bad variable handle, check error
C     try renaming to existing variable name, check error
C     check that proper rename worked with nf_inq_varid
C     try in data mode, check error
      subroutine test_nf_rename_var()
      implicit none
#include "tests.inc"

      integer ncid
      integer vid
      integer err
      integer i
      character*(NF_MAX_NAME) name

      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      err = nf_rename_var(ncid, BAD_VARID, 'newName')
      if (err .ne. NF_ENOTVAR)
     +     call errore('bad var id: ', err)
      call def_dims(ncid)
      call def_vars(ncid)

C     /* Prefix "new_" to each name */
      do 1, i = 1, NVARS
         err = nf_rename_var(BAD_ID, i, 'newName')
         if (err .ne. NF_EBADID)
     +        call errore('bad ncid: ', err)
         err = nf_rename_var(ncid, i, var_name(NVARS))
         if (err .ne. NF_ENAMEINUSE)
     +        call errore('duplicate name: ', err)
         name = 'new_' // var_name(i)
         err = nf_rename_var(ncid, i, name)
         if (err .ne. 0)
     +        call errore('nf_rename_var: ', err)
         err = nf_inq_varid(ncid, name, vid)
         if (err .ne. 0)
     +        call errore('nf_inq_varid: ', err)
         if (vid .ne. i)
     +        call error('Unexpected varid')
 1    continue

C     /* Change to data mode */
C     /* Try making names even longer. Then restore original names */
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      do 2, i = 1, NVARS
         name = 'even_longer_' // var_name(i)
         err = nf_rename_var(ncid, i, name)
         if (err .ne. NF_ENOTINDEFINE)
     +        call errore('longer name in data mode: ', err)
         err = nf_rename_var(ncid, i, var_name(i))
         if (err .ne. 0)
     +        call errore('nf_rename_var: ', err)
         err = nf_inq_varid(ncid, var_name(i), vid)
         if (err .ne. 0)
     +        call errore('nf_inq_varid: ', err)
         if (vid .ne. i)
     +        call error('Unexpected varid')
 2    continue

      call put_vars(ncid)
      call check_vars(ncid)

      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errorc('delete of scratch file failed: ', scratch)
      end


C     Test nf_copy_att
C     try with bad source or target netCDF handles, check error
C     try with bad source or target variable handle, check error
C     try with nonexisting attribute, check error
C     check that NF_GLOBAL variable for source or target works
C     check that new attribute put works with target in define mode
C     check that old attribute put works with target in data mode
C     check that changing type and length of an attribute work OK
C     try with same ncid for source and target, different variables
C     try with same ncid for source and target, same variable
      subroutine test_nf_copy_att()
      implicit none
#include "tests.inc"

      integer ncid_in
      integer ncid_out
      integer vid
      integer err
      integer i
      integer j
      character*(NF_MAX_NAME) name !/* of att */
      integer datatype          !/* of att */
      integer length            !/* of att */
      character*1     value

      err = nf_open(testfile, NF_NOWRITE, ncid_in)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      err = nf_create(scratch, NF_NOCLOBBER, ncid_out)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      call def_dims(ncid_out)
      call def_vars(ncid_out)

      do 1, i = 0, NVARS
         vid = VARID(i)
         do 2, j = 1, NATTS(i)
            name = ATT_NAME(j,i)
            err = nf_copy_att(ncid_in, BAD_VARID, name, ncid_out,
     +           vid)
            if (err .ne. NF_ENOTVAR)
     +           call errore('bad var id: ', err)
            err = nf_copy_att(ncid_in, vid, name, ncid_out,
     +           BAD_VARID)
            if (err .ne. NF_ENOTVAR)
     +           call errore('bad var id: ', err)
            err = nf_copy_att(BAD_ID, vid, name, ncid_out, vid)
            if (err .ne. NF_EBADID)
     +           call errore('bad ncid: ', err)
            err = nf_copy_att(ncid_in, vid, name, BAD_ID, vid)
            if (err .ne. NF_EBADID)
     +           call errore('bad ncid: ', err)
            err = nf_copy_att(ncid_in, vid, 'noSuch', ncid_out, vid)
            if (err .ne. NF_ENOTATT)
     +           call errore('bad attname: ', err)
            err = nf_copy_att(ncid_in, vid, name, ncid_out, vid)
            if (err .ne. 0)
     +           call errore('nf_copy_att: ', err)
            err = nf_copy_att(ncid_out, vid, name, ncid_out, vid)
            if (err .ne. 0)
     +           call errore('source = target: ', err)
 2       continue
 1    continue

      err = nf_close(ncid_in)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

C     /* Close scratch. Reopen & check attributes */
      err = nf_close(ncid_out)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_open(scratch, NF_WRITE, ncid_out)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      call check_atts(ncid_out)

C     change to define mode
C     define single char. global att. ':a' with value 'A'
C     This will be used as source for following copies
      err = nf_redef(ncid_out)
      if (err .ne. 0)
     +     call errore('nf_redef: ', err)
      err = nf_put_att_text(ncid_out, NF_GLOBAL, 'a', 1, 'A')
      if (err .ne. 0)
     +     call errore('nf_put_att_text: ', err)

C     change to data mode
C     Use scratch as both source & dest.
C     try copy to existing att. change type & decrease length
C     rename 1st existing att of each var (if any) 'a'
C     if this att. exists them copy ':a' to it
      err = nf_enddef(ncid_out)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      do 3, i = 1, NVARS
         if (NATTS(i) .gt. 0 .and. ATT_LEN(1,i) .gt. 0) then
            err = nf_rename_att(ncid_out, i, att_name(1,i), 'a')
            if (err .ne. 0)
     +           call errore('nf_rename_att: ', err)
            err = nf_copy_att(ncid_out, NF_GLOBAL, 'a', ncid_out,
     +           i)
            if (err .ne. 0)
     +           call errore('nf_copy_att: ', err)
         end if
 3    continue
      err = nf_close(ncid_out)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

C     /* Reopen & check */
      err = nf_open(scratch, NF_WRITE, ncid_out)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      do 4, i = 1, NVARS
         if (NATTS(i) .gt. 0 .and. ATT_LEN(1,i) .gt. 0) then
            err = nf_inq_att(ncid_out, i, 'a', datatype, length)
            if (err .ne. 0)
     +           call errore('nf_inq_att: ', err)
            if (datatype .ne. NF_CHAR)
     +           call error('Unexpected type')
            if (length .ne. 1)
     +           call error('Unexpected length')
            err = nf_get_att_text(ncid_out, i, 'a', value)
            if (err .ne. 0)
     +           call errore('nf_get_att_text: ', err)
            if (value .ne. 'A')
     +           call error('Unexpected value')
         end if
 4    continue

      err = nf_close(ncid_out)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errorc('delete of scratch file failed', scratch)
      end


C     Test nf_rename_att
C     try with bad netCDF handle, check error
C     try with bad variable handle, check error
C     try with nonexisting att name, check error
C     try renaming to existing att name, check error
C     check that proper rename worked with nf_inq_attid
C     try in data mode, check error
      subroutine test_nf_rename_att()
      implicit none
#include "tests.inc"

      integer ncid
      integer vid
      integer err
      integer i
      integer j
      integer  k
      integer attnum
      character*(NF_MAX_NAME) atnam
      character*(NF_MAX_NAME) name
      character*(NF_MAX_NAME) oldname
      character*(NF_MAX_NAME) newname
      integer nok               !/* count of valid comparisons */
      integer datatype
      integer attyp
      integer length
      integer attlength
      integer ndx(1)
      character*(MAX_NELS)    text
      doubleprecision value(MAX_NELS)
      doubleprecision expect

      nok = 0

      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      err = nf_rename_att(ncid, BAD_VARID, 'abc', 'newName')
      if (err .ne. NF_ENOTVAR)
     +     call errore('bad var id: ', err)
      call def_dims(ncid)
      call def_vars(ncid)
      call put_atts(ncid)

      do 1, i = 0, NVARS
         vid = VARID(i)
         do 2, j = 1, NATTS(i)
            atnam = ATT_NAME(j,i)
            err = nf_rename_att(BAD_ID, vid, atnam, 'newName')
            if (err .ne. NF_EBADID)
     +           call errore('bad ncid: ', err)
            err = nf_rename_att(ncid, vid, 'noSuch', 'newName')
            if (err .ne. NF_ENOTATT)
     +           call errore('bad attname: ', err)
            newname = 'new_' // atnam
            err = nf_rename_att(ncid, vid, atnam, newname)
            if (err .ne. 0)
     +           call errore('nf_rename_att: ', err)
            err = nf_inq_attid(ncid, vid, newname, attnum)
            if (err .ne. 0)
     +           call errore('nf_inq_attid: ', err)
            if (attnum .ne. j)
     +           call error('Unexpected attnum')
 2       continue
 1    continue

C     /* Close. Reopen & check */
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_open(scratch, NF_WRITE, ncid)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)

      do 3, i = 0, NVARS
         vid = VARID(i)
         do 4, j = 1, NATTS(i)
            atnam = ATT_NAME(j,i)
            attyp = ATT_TYPE(j,i)
            attlength = ATT_LEN(j,i)
            newname = 'new_' // atnam
            err = nf_inq_attname(ncid, vid, j, name)
            if (err .ne. 0)
     +           call errore('nf_inq_attname: ', err)
            if (name .ne. newname)
     +           call error('nf_inq_attname: unexpected name')
            err = nf_inq_att(ncid, vid, name, datatype, length)
            if (err .ne. 0)
     +           call errore('nf_inq_att: ', err)
            if (datatype .ne. attyp)
     +           call error('nf_inq_att: unexpected type')
            if (length .ne. attlength)
     +           call error('nf_inq_att: unexpected length')
            if (datatype .eq. NF_CHAR) then
               err = nf_get_att_text(ncid, vid, name, text)
               if (err .ne. 0)
     +              call errore('nf_get_att_text: ', err)
               do 5, k = 1, attlength
                  ndx(1) = k
                  expect = hash(datatype, -1, ndx)
                  if (ichar(text(k:k)) .ne. expect) then
                     call error(
     +                    'nf_get_att_text: unexpected value')
                  else
                     nok = nok + 1
                  end if
 5             continue
            else
               err = nf_get_att_double(ncid, vid, name, value)
               if (err .ne. 0)
     +              call errore('nf_get_att_double: ', err)
               do 6, k = 1, attlength
                  ndx(1) = k
                  expect = hash(datatype, -1, ndx)
                  if (inRange(expect, datatype)) then
                     if (.not. equal(value(k),expect,datatype,
     +                    NF_DOUBLE)) then
                        call error(
     +                       'nf_get_att_double: unexpected value')
                     else
                        nok = nok + 1
                     end if
                  end if
 6             continue
            end if
 4       continue
 3    continue
      call print_nok(nok)

C     /* Now in data mode */
C     /* Try making names even longer. Then restore original names */

      do 7, i = 0, NVARS
         vid = VARID(i)
         do 8, j = 1, NATTS(i)
            atnam = ATT_NAME(j,i)
            oldname = 'new_' // atnam
            newname = 'even_longer_' // atnam
            err = nf_rename_att(ncid, vid, oldname, newname)
            if (err .ne. NF_ENOTINDEFINE)
     +           call errore('longer name in data mode: ', err)
            err = nf_rename_att(ncid, vid, oldname, atnam)
            if (err .ne. 0)
     +           call errore('nf_rename_att: ', err)
            err = nf_inq_attid(ncid, vid, atnam, attnum)
            if (err .ne. 0)
     +           call errore('nf_inq_attid: ', err)
            if (attnum .ne. j)
     +           call error('Unexpected attnum')
 8       continue
 7    continue

      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errori('delete of scratch file failed: ', err)
      end


C     Test nf_del_att
C     try with bad netCDF handle, check error
C     try with bad variable handle, check error
C     try with nonexisting att name, check error
C     check that proper delete worked using:
C     nf_inq_attid, nf_inq_natts, nf_inq_varnatts
      subroutine test_nf_del_att()
      implicit none
#include "tests.inc"

      integer ncid
      integer err
      integer i
      integer j
      integer attnum
      integer na
      integer numatts
      integer vid
      character*(NF_MAX_NAME)  name !/* of att */

      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      err = nf_del_att(ncid, BAD_VARID, 'abc')
      if (err .ne. NF_ENOTVAR)
     +     call errore('bad var id: ', err)
      call def_dims(ncid)
      call def_vars(ncid)
      call put_atts(ncid)

      do 1, i = 0, NVARS
         vid = VARID(i)
         numatts = NATTS(i)
         do 2, j = 1, numatts
            name = ATT_NAME(j,i)
            err = nf_del_att(BAD_ID, vid, name)
            if (err .ne. NF_EBADID)
     +           call errore('bad ncid: ', err)
            err = nf_del_att(ncid, vid, 'noSuch')
            if (err .ne. NF_ENOTATT)
     +           call errore('bad attname: ', err)
            err = nf_del_att(ncid, vid, name)
            if (err .ne. 0)
     +           call errore('nf_del_att: ', err)
            err = nf_inq_attid(ncid, vid, name, attnum)
            if (err .ne. NF_ENOTATT)
     +           call errore('bad attname: ', err)
            if (i .lt. 1) then
               err = nf_inq_natts(ncid, na)
               if (err .ne. 0)
     +              call errore('nf_inq_natts: ', err)
               if (na .ne. numatts-j) then
                  call errori('natts: expected: ', numatts-j)
                  call errori('natts: got:      ', na)
               end if
            end if
            err = nf_inq_varnatts(ncid, vid, na)
            if (err .ne. 0)
     +           call errore('nf_inq_natts: ', err)
            if (na .ne. numatts-j) then
               call errori('natts: expected: ', numatts-j)
               call errori('natts: got:      ', na)
            end if
 2       continue
 1    continue

C     /* Close. Reopen & check no attributes left */
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_open(scratch, NF_WRITE, ncid)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      err = nf_inq_natts(ncid, na)
      if (err .ne. 0)
     +     call errore('nf_inq_natts: ', err)
      if (na .ne. 0)
     +     call errori('natts: expected 0, got ', na)
      do 3, i = 0, NVARS
         vid = VARID(i)
         err = nf_inq_varnatts(ncid, vid, na)
         if (err .ne. 0)
     +        call errore('nf_inq_natts: ', err)
         if (na .ne. 0)
     +        call errori('natts: expected 0, got ', na)
 3    continue

C     /* restore attributes. change to data mode. try to delete */
      err = nf_redef(ncid)
      if (err .ne. 0)
     +     call errore('nf_redef: ', err)
      call put_atts(ncid)
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)

      do 4, i = 0, NVARS
         vid = VARID(i)
         numatts = NATTS(i)
         do 5, j = 1, numatts
            name = ATT_NAME(j,i)
            err = nf_del_att(ncid, vid, name)
            if (err .ne. NF_ENOTINDEFINE)
     +           call errore('in data mode: ', err)
 5       continue
 4    continue

      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errori('delete of scratch file failed: ', err)
      end


C     Test nf_set_fill
C     try with bad netCDF handle, check error
C     try in read-only mode, check error
C     try with bad new_fillmode, check error
C     try in data mode, check error
C     check that proper set to NF_FILL works for record & non-record variables
C     (note that it is not possible to test NF_NOFILL mode!)
C     close file & create again for test using attribute _FillValue
      subroutine test_nf_set_fill()
      implicit none
#include "tests.inc"

      integer ncid
      integer vid
      integer err
      integer i
      integer j
      integer old_fillmode
      integer nok               !/* count of valid comparisons */
      character*1 text
      doubleprecision value
      doubleprecision fill
      doubleprecision fill_array(1)
      integer index(MAX_RANK)

      nok = 0
      value = 0

C     /* bad ncid */
      err = nf_set_fill(BAD_ID, NF_NOFILL, old_fillmode)
      if (err .ne. NF_EBADID)
     +     call errore('bad ncid: ', err)

C     /* try in read-only mode */
      err = nf_open(testfile, NF_NOWRITE, ncid)
      if (err .ne. 0)
     +     call errore('nf_open: ', err)
      err = nf_set_fill(ncid, NF_NOFILL, old_fillmode)
      if (err .ne. NF_EPERM)
     +     call errore('read-only: ', err)
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)

C     /* create scratch */
      err = nf_create(scratch, NF_NOCLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if

C     /* BAD_FILLMODE */
      err = nf_set_fill(ncid, BAD_FILLMODE, old_fillmode)
      if (err .ne. NF_EINVAL)
     +     call errore('bad fillmode: ', err)

C     /* proper calls */
      err = nf_set_fill(ncid, NF_NOFILL, old_fillmode)
      if (err .ne. 0)
     +     call errore('nf_set_fill: ', err)
      if (old_fillmode .ne. NF_FILL)
     +     call errori('Unexpected old fill mode: ', old_fillmode)
      err = nf_set_fill(ncid, NF_FILL, old_fillmode)
      if (err .ne. 0)
     +     call errore('nf_set_fill: ', err)
      if (old_fillmode .ne. NF_NOFILL)
     +     call errori('Unexpected old fill mode: ', old_fillmode)

C     /* define dims & vars */
      call def_dims(ncid)
      call def_vars(ncid)

C     /* Change to data mode. Set fillmode again */
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      err = nf_set_fill(ncid, NF_FILL, old_fillmode)
      if (err .ne. 0)
     +     call errore('nf_set_fill: ', err)
      if (old_fillmode .ne. NF_FILL)
     +     call errori('Unexpected old fill mode: ', old_fillmode)

C     /* Write record number NRECS to force writing of preceding records */
C     /* Assumes variable cr is char vector with UNLIMITED dimension */
      err = nf_inq_varid(ncid, 'cr', vid)
      if (err .ne. 0)
     +     call errore('nf_inq_varid: ', err)
      index(1) = NRECS
      text = char(NF_FILL_CHAR)
      err = nf_put_var1_text(ncid, vid, index, text)
      if (err .ne. 0)
     +     call errore('nf_put_var1_text: ', err)

C     /* get all variables & check all values equal default fill */
      do 1, i = 1, NVARS
         if (var_type(i) .eq. NF_CHAR) then
            fill = NF_FILL_CHAR
         else if (var_type(i) .eq. NF_BYTE) then
            fill = NF_FILL_BYTE
         else if (var_type(i) .eq. NF_SHORT) then
            fill = NF_FILL_SHORT
         else if (var_type(i) .eq. NF_INT) then
            fill = NF_FILL_INT
         else if (var_type(i) .eq. NF_FLOAT) then
            fill = NF_FILL_FLOAT
         else if (var_type(i) .eq. NF_DOUBLE) then
            fill = NF_FILL_DOUBLE
         else
            stop 2
         end if

         do 2, j = 1, var_nels(i)
            err = index2indexes(j, var_rank(i), var_shape(1,i),
     +           index)
            if (err .ne. 0)
     +           call error('error in index2indexes()')
            if (var_type(i) .eq. NF_CHAR) then
               err = nf_get_var1_text(ncid, i, index, text)
               if (err .ne. 0)
     +              call errore('nf_get_var1_text failed: ',err)
               value = ichar(text)
            else
               err = nf_get_var1_double(ncid, i, index, value)
               if (err .ne. 0)
     +              call errore('nf_get_var1_double failed: ',err)
            end if
            if (value .ne. fill .and.
     +           abs((fill - value)/fill) .gt. 1.0e-9) then
               call errord('Unexpected fill value: ', value)
            else
               nok = nok + 1
            end if
 2       continue
 1    continue

C     /* close scratch & create again for test using attribute _FillValue */
      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_create(scratch, NF_CLOBBER, ncid)
      if (err .ne. 0) then
         call errore('nf_create: ', err)
         return
      end if
      call def_dims(ncid)
      call def_vars(ncid)

C     /* set _FillValue = 42 for all vars */
      fill = 42
      fill_array(1) = fill
      text = char(int(fill))
      do 3, i = 1, NVARS
         if (var_type(i) .eq. NF_CHAR) then
            err = nf_put_att_text(ncid, i, '_FillValue', 1, text)
            if (err .ne. 0)
     +           call errore('nf_put_att_text: ', err)
         else
            err = nf_put_att_double(ncid, i, '_FillValue',
     +           var_type(i),1,fill_array)
            if (err .ne. 0)
     +           call errore('nf_put_att_double: ', err)
         end if
 3    continue

C     /* data mode. write records */
      err = nf_enddef(ncid)
      if (err .ne. 0)
     +     call errore('nf_enddef: ', err)
      index(1) = NRECS
      err = nf_put_var1_text(ncid, vid, index, text)
      if (err .ne. 0)
     +     call errore('nf_put_var1_text: ', err)

C     /* get all variables & check all values equal 42 */
      do 4, i = 1, NVARS
         do 5, j = 1, var_nels(i)
            err = index2indexes(j, var_rank(i), var_shape(1,i),
     +           index)
            if (err .ne. 0)
     +           call error('error in index2indexes')
            if (var_type(i) .eq. NF_CHAR) then
               err = nf_get_var1_text(ncid, i, index, text)
               if (err .ne. 0)
     +              call errore('nf_get_var1_text failed: ',err)
               value = ichar(text)
            else
               err = nf_get_var1_double(ncid, i, index, value)
               if (err .ne. 0)
     +              call errore('nf_get_var1_double failed: ', err)
            end if
            if (value .ne. fill) then
               call errord(' Value expected: ', fill)
               call errord(' Value read:     ', value)
            else
               nok = nok + 1
            end if
 5       continue
 4    continue
      call print_nok(nok)

      err = nf_close(ncid)
      if (err .ne. 0)
     +     call errore('nf_close: ', err)
      err = nf_delete(scratch)
      if (err .ne. 0)
     +     call errori('delete of scratch file failed: ', err)
      end

C     * Test nc_set_default_format
C     *    try with bad default format
C     *    try with NULL old_formatp
C     *    try in data mode, check error
C     *    check that proper set to NC_FILL works for record & non-record variables
C     *    (note that it is not possible to test NC_NOFILL mode!)
C     *    close file & create again for test using attribute _FillValue
      subroutine test_nf_set_default_format()
      implicit none
#include "tests.inc"

      integer ncid
      integer err
      integer i
      integer version
      integer old_format
      integer nf_get_file_version

C     /* bad format */
      err = nf_set_default_format(99, old_format)
      IF (err .ne. NF_EINVAL)
     +     call errore("bad default format: status = %d", err)

C     /* Cycle through available formats. (actually netcdf-4 formats are
C     ignored for the moment - ed 5/15/5) */
      do 1 i=1, 2
         err = nf_set_default_format(i, old_format)
         if (err .ne. 0)
     +        call errore("setting classic format: status = %d", err)
         err = nf_create(scratch, NF_CLOBBER, ncid)
         if (err .ne. 0) call errore("bad nf_create: status = %d", err)
         err = nf_put_att_text(ncid, NF_GLOBAL, "testatt",
     +        4, "blah")
         if (err .ne. 0) call errore("bad put_att: status = %d", err)
         err = nf_close(ncid)
         if (err .ne. 0) call errore("bad close: status = %d", err)
         err = nf_get_file_version(scratch, version)
         if (err .ne. 0) call errore("bad file version = %d", err)
         if (version .ne. i)
     +        call errore("bad file version = %d", err)
 1    continue

C     /* Remove the left-over file. */
C     err = nf_delete(scratch)
      if (err .ne. 0) call errore("remove failed", err)
      end

C     This function looks in a file for the netCDF magic number.
      integer function nf_get_file_version(path, version)
      implicit none
#include "tests.inc"

      character*(*) path
      integer version, iosnum
      character magic*4
      integer ver
      integer f
      parameter (f = 10)

      open(f, file=path, status='OLD', form='UNFORMATTED',
     +     access='DIRECT', recl=4)

C     Assume this is not a netcdf file.
      nf_get_file_version = NF_ENOTNC
      version = 0

C     Read the magic number, the first 4 bytes of the file.
      read(f, rec=1, err = 1) magic

C     If the first three characters are not "CDF" we're done.
      if (index(magic, 'CDF') .eq. 1) then
         ver = ichar(magic(4:4))
         if (ver .eq. 1) then
            version = 1
            nf_get_file_version = NF_NOERR
         elseif (ver .eq. 2) then
            version = 2
            nf_get_file_version = NF_NOERR
         endif
      endif

 1    close(f)
      return
      end
