"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.5.2/nf03_test4/f90tst_rengrps.f90" (18 Sep 2019, 4362 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 90 source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 !     This is part of the netCDF package. Copyright 2006-2019
    2 !     University Corporation for Atmospheric Research/Unidata. See
    3 !     COPYRIGHT file for conditions of use.
    4 
    5 !     Modified version of f90tst_grps to add test for rename_grps.
    6 
    7 !     Russ Rew, 2014
    8 
    9 program f90tst_rengrps
   10   use typeSizes
   11   use netcdf
   12   implicit none
   13 
   14   ! This is the name of the data file we will create.
   15   character (len = *), parameter :: FILE_NAME = "f90tst_rengrps.nc"
   16 
   17   ! We are writing 2D data, a 6 x 12 grid. 
   18   integer, parameter :: MAX_DIMS = 2
   19   integer, parameter :: NX = 6, NY = 12
   20   integer :: chunksizes(MAX_DIMS)
   21   integer, parameter :: CACHE_NELEMS = 10000, CACHE_SIZE = 1000000
   22   integer, parameter :: DEFLATE_LEVEL = 4
   23   ! We need these ids and other gunk for netcdf.
   24   integer :: ncid, varid1, varid2, dimids(MAX_DIMS)
   25   integer :: x_dimid, y_dimid
   26   character (len = *), parameter :: VAR1_NAME = "VarName1"
   27   character (len = *), parameter :: VAR2_NAME = "VarName2"
   28   character (len = *), parameter :: GRP1_NAME = "Old_Grp1_name"
   29   character (len = *), parameter :: GRP2_NAME = "Old_Grp2_name"
   30   character (len = *), parameter :: NEW_GRP1_NAME = "new_Grp1_name"
   31   character (len = *), parameter :: NEW_GRP2_NAME = "new_Grp2_name"
   32 
   33   character (len = NF90_MAX_NAME) :: grp1_full_name
   34   integer :: ilen
   35 
   36   ! Information read back from the file to check correctness.
   37   integer :: grpid1, grpid2
   38   integer :: deflate_level_in, endianness_in
   39   logical :: shuffle_in, fletcher32_in
   40   integer :: xtype_in, ndims_in, natts_in, dimids_in(MAX_DIMS)
   41   character (len = nf90_max_name) :: name_in
   42   integer :: chunksizes_in(MAX_DIMS)
   43 
   44   print *, ''
   45   print *,'*** Testing netCDF-4 rename groups from Fortran 90.'
   46 
   47   ! Create the netCDF file. 
   48   call check(nf90_create(FILE_NAME, nf90_netcdf4, ncid))
   49 
   50   ! Define the dimensions.
   51   call check(nf90_def_dim(ncid, "x", NX, x_dimid))
   52   call check(nf90_def_dim(ncid, "y", NY, y_dimid))
   53   dimids =  (/ y_dimid, x_dimid /)
   54 
   55   ! Define some nested groups.
   56   call check(nf90_def_grp(ncid, GRP1_NAME, grpid1))
   57   call check(nf90_def_grp(grpid1, GRP2_NAME, grpid2))
   58 
   59   ! Define some variables. 
   60   chunksizes = (/ NY, NX /)
   61   call check(nf90_def_var(ncid, VAR1_NAME, NF90_INT, dimids, varid1, chunksizes = chunksizes, &
   62        shuffle = .TRUE., fletcher32 = .TRUE., endianness = nf90_endian_big, deflate_level = DEFLATE_LEVEL))
   63   call check(nf90_def_var(grpid1, VAR2_NAME, NF90_INT, dimids, varid2, contiguous = .TRUE.))
   64 
   65   ! Close the file. 
   66   call check(nf90_close(ncid))
   67 
   68   ! Reopen the file.
   69   call check(nf90_open(FILE_NAME, nf90_write, ncid))
   70   
   71   ! Get the group ids for the newly reopened file.
   72   call check(nf90_inq_grp_ncid(ncid, GRP1_NAME, grpid1))
   73   call check(nf90_inq_grp_ncid(grpid1, GRP2_NAME, grpid2))
   74 
   75   ! Check for the groups with full group names. 
   76   write(grp1_full_name, '(A,A)') '/', GRP1_NAME
   77   call check(nf90_inq_grp_full_ncid(ncid, grp1_full_name, grpid1))
   78   call check(nf90_inq_grpname(grpid1, name_in))
   79   if (name_in .ne. GRP1_NAME) stop 61
   80   call check(nf90_inq_grpname_full(grpid1, ilen, name_in))
   81   if (name_in .ne. grp1_full_name) stop 62
   82 
   83   Call check(nf90_rename_grp(grpid1, NEW_GRP1_NAME))
   84   name_in=REPEAT(" ", LEN(name_in))
   85   Call check(nf90_inq_grpname(grpid1, name_in))
   86   If (name_in /= NEW_GRP1_NAME) Call check(-1)
   87 
   88   ! Check variable 1.
   89   call check(nf90_inquire_variable(ncid, varid1, name_in, xtype_in, ndims_in, dimids_in, &
   90        natts_in, chunksizes = chunksizes_in, endianness = endianness_in, fletcher32 = fletcher32_in, &
   91        deflate_level = deflate_level_in, shuffle = shuffle_in))
   92   if (name_in .ne. VAR1_NAME .or. xtype_in .ne. NF90_INT .or. ndims_in .ne. MAX_DIMS .or. &
   93        natts_in .ne. 0 .or. dimids_in(1) .ne. dimids(1) .or. dimids_in(2) .ne. dimids(2)) stop 3
   94   if (chunksizes_in(1) /= chunksizes(1) .or. chunksizes_in(2) /= chunksizes(2)) &
   95        stop 4
   96   if (endianness_in .ne. nf90_endian_big) stop 5
   97 
   98   ! Close the file. 
   99   call check(nf90_close(ncid))
  100 
  101   print *,'*** SUCCESS!'
  102 
  103 contains
  104 !     This subroutine handles errors by printing an error message and
  105 !     exiting with a non-zero status.
  106   subroutine check(errcode)
  107     use netcdf
  108     implicit none
  109     integer, intent(in) :: errcode
  110     
  111     if(errcode /= nf90_noerr) then
  112        print *, 'Error: ', trim(nf90_strerror(errcode))
  113        stop 2
  114     endif
  115   end subroutine check
  116 end program f90tst_rengrps
  117