C     This is part of the netCDF package.
C     Copyright 2008 University Corporation for Atmospheric Research/Unidata.
C     See COPYRIGHT file for conditions of use.

C     This program tests prototype nf_open_mem and procedure for
C     creating an in memory netcdf file from an existing netcdf
C     file on a hard drive. The program will first use the logic
C     from f03tst_vars6.F to create a small netcdf file on
C     the hard drive. This file is then opened as a Fortran
C     unformatted, stream file and read into an allocatable
C     array of C_CHAR type. 

      program ftst_open_mem
      use netcdf4_f03
      use iso_c_binding, ONLY : C_CHAR

      implicit none

C     This is the name of the data file we will create.
      character*(*) FILE_NAME
      parameter (FILE_NAME='f03tst_open_mem.nc')
      integer NDIMS
      parameter (NDIMS = 1)
      integer DIM_LEN
      parameter (DIM_LEN = 22)
      integer NVARS
      parameter (NVARS = 3)
      integer DATA_LEN
      parameter (DATA_LEN = 2)
      integer check_file
C
C  *** Specify an allocatable array of KIND=C_CHAR with TARGET
C      attribute to hold in-memory NC file. This is the closest
C      we can get to in Fortran >= 2003 to an array of bytes
C      that C will understand

      Character(KIND=C_CHAR), ALLOCATABLE, TARGET :: memfile(:)

      integer ncid, varid(NVARS), dimids(NDIMS)
      integer data_len_in, offset, ncsize, iostat, mode
      parameter (offset = 20)
      integer data1(data_len), data1_in(data_len)
      character*(4) var_name(NVARS)
      character*(4) dim_name
      parameter (dim_name = 'dim1')
      integer NO_FILL, MY_FILL_VALUE
      parameter (NO_FILL = 1)
      parameter (MY_FILL_VALUE = 42)

C     Loop index and error handling.
      integer x, retval

      print *, ''
      print *,'*** Testing fill values.'

C     Prepare some data to write.
      do x = 1, data_len
         data1(x) = x
      end do

C     Set up var names.
      var_name(1) = 'var1'
      var_name(2) = 'var2'
      var_name(3) = 'var3'

C     Create the netCDF file.
      retval = nf_create(FILE_NAME, NF_NETCDF4, ncid)
      if (retval .ne. nf_noerr) call handle_err(retval)

C     Create a dimension.
      retval = nf_def_dim(ncid, dim_name, DIM_LEN, dimids(1))
      if (retval .ne. nf_noerr) call handle_err(retval)

C     Create a few integer variables.
      do x = 1, NVARS      
         retval = nf_def_var(ncid, var_name(x), NF_INT, NDIMS, dimids,
     $        varid(x))
         if (retval .ne. nf_noerr) call handle_err(retval)
      end do

C     Set no fill mode for the second variable.
      retval = nf_def_var_fill(ncid, varid(2), NO_FILL, 88)
      if (retval .ne. 0) stop 2

C     Set an alternative fill value for the third variable.
      retval = nf_def_var_fill(ncid, varid(3), 0, MY_FILL_VALUE)
      if (retval .ne. 0) stop 3

C     Check it out. 
c      retval = check_file(ncid, var_name, dim_name)
c      if (retval .ne. 0) stop 2

C     Close the file. 
      retval = nf_close(ncid)
      if (retval .ne. nf_noerr) call handle_err(retval)
C
C *****   TESTING OF nf_open_mem ******
C

      Print *,''
      Print *,' testing nf_open_mem'
      Print *,''
C
C     First open external netcdf file with unformatted stream access
C     and get file size (hopefully in bytes) using INQUIRE intrinsic
C

      Open(7, FILE=FILE_NAME, STATUS="UNKNOWN", ACCESS="STREAM",         &
     & FORM="UNFORMATTED")
      INQUIRE(FILE=FILE_NAME,  SIZE=ncsize)

      Print *,''
      Print *,' FILE = ', TRIM(FILE_NAME), ' is ', ncsize, ' bytes'
      Print *,''

C For non-zero length files ALLOCATED memfile to size returned by INQUIRE
C Then do an unformatted read on file. If no read errors (iostat==0)
C then call nf_open_mem in NF_DISKLESS mode

      If (ncsize > 0) Then
        ALLOCATE(memfile(ncsize))
        Read(7, iostat=iostat) memfile(1:ncsize)
        If (iostat == 0) then
           Close(7)
           mode = IOR(NF_DISKLESS, NF_INMEMORY)
           retval = nf_open_mem(FILE_NAME, mode, ncsize, memfile, ncid)
        Else
           retval = iostat
        EndIf
        if (retval .ne. 0) stop 41
      Else
        stop 42
      EndIf 
      retval = check_file(ncid, var_name, dim_name)
      if (retval .ne. 0) stop 4

C     Close the file. 
      retval = nf_close(ncid)
      if (retval .ne. nf_noerr) call handle_err(retval)

      If (ALLOCATED(memfile)) DEALLOCATE(memfile)
      print *,'*** SUCCESS!'
      end

C     This function check the file to make sure everything is OK.
      integer function check_file(ncid, var_name, dim_name)
      use netcdf4_f03
      implicit none

C     I need these in both here and the main program.
      integer NDIMS
      parameter (NDIMS = 1)
      integer DIM_LEN
      parameter (DIM_LEN = 22)
      integer NVARS
      parameter (NVARS = 3)
      integer DATA_LEN
      parameter (DATA_LEN = 2)
      integer MY_FILL_VALUE
      parameter (MY_FILL_VALUE = 42)

C     Parameters
      integer ncid
      character*(4) var_name(NVARS)
      character*(4) dim_name

C     Values that are read in, to check the file.
      integer ndims_in, nvars_in, ngatts_in, unlimdimid_in
      integer xtype_in, dimids_in(NDIMS), natts_in
      integer varid_in(NVARS), dimid_in, no_fill_in, fill_value_in
      character*(4) var_name_in
      integer int_data_in(DIM_LEN)

      integer x, retval

C     Check it out.
      retval = nf_inq(ncid, ndims_in, nvars_in, ngatts_in,
     $     unlimdimid_in)
      if (retval .ne. nf_noerr) call handle_err(retval)
      if (ndims_in .ne. 1 .or. nvars_in .ne. NVARS .or. ngatts_in .ne. 0
     $     .or. unlimdimid_in .ne. -1) stop 5

C     Get the varids and the dimid.
      do x = 1, NVARS      
         retval = nf_inq_varid(ncid, var_name(x), varid_in(x))
         if (retval .ne. nf_noerr) call handle_err(retval)
         if (varid_in(x) .ne. x) stop 6
      end do
      retval = nf_inq_dimid(ncid, dim_name, dimid_in)
      if (retval .ne. nf_noerr) call handle_err(retval)
      if (dimid_in .ne. 1) stop 7

C     These things are the same for all three variables, except
C     natts_in..
      do x = 1, NVARS      
         retval = nf_inq_var(ncid, varid_in(x), var_name_in, xtype_in,
     $        ndims_in, dimids_in, natts_in)
         if (retval .ne. nf_noerr) call handle_err(retval)
         if (ndims_in .ne. 1 .or. xtype_in .ne. NF_INT .or. dimids_in(1)
     $        .ne. dimid_in) stop 8
         if (x .eq. 3 .and. natts_in .ne. 1) stop 9
         if (x .lt. 3 .and. natts_in .ne. 0) stop 10
      end do

C     Check the fill value for the first var. Nothing was set, so
C     no_fill should be off, and fill_value should be the default fill
C     value for this type.
      retval = nf_inq_var_fill(ncid, varid_in(1), no_fill_in,
     $     fill_value_in)
      if (retval .ne. nf_noerr) call handle_err(retval)
      if (no_fill_in .ne. 0 .or. fill_value_in .ne. nf_fill_int) stop 11

C     Check that no_fill mode is on for the second variable.
      retval = nf_inq_var_fill(ncid, varid_in(2), no_fill_in,
     $     fill_value_in)
      if (retval .ne. nf_noerr) call handle_err(retval)
      if (no_fill_in .ne. 1 .or. fill_value_in .ne. nf_fill_int) stop 12

C     Check that a non-default fill value is in use for the third variable.
      retval = nf_inq_var_fill(ncid, varid_in(3), no_fill_in,
     $     fill_value_in)
      if (retval .ne. nf_noerr) call handle_err(retval)
      if (no_fill_in .ne. 0 .or. fill_value_in .ne. MY_FILL_VALUE) stop
     $     2

C     Get the data in var1. It will be all the default fill value.
      retval = nf_get_var_int(ncid, varid_in(1), int_data_in)
      if (retval .ne. nf_noerr) call handle_err(retval)
      do x = 1, DIM_LEN
         if (int_data_in(x) .ne. nf_fill_int) stop 13
      end do

C     Get the data in var2. What will it be?
      retval = nf_get_var_int(ncid, varid_in(2), int_data_in)
      if (retval .ne. nf_noerr) call handle_err(retval)
C$$$      do x = 1, DIM_LEN
C$$$         print *, int_data_in(x)
C$$$      end do

C     Get the data in var3. It will be all the default fill value.
      retval = nf_get_var_int(ncid, varid_in(3), int_data_in)
      if (retval .ne. nf_noerr) call handle_err(retval)
      do x = 1, DIM_LEN
C         print *, int_data_in(x)
         if (int_data_in(x) .ne. MY_FILL_VALUE) stop 14
      end do

      check_file = 0
      end