"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.4.5/nf_test/ftst_rengrps.F" (31 Jan 2019, 3941 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. See also the latest Fossies "Diffs" side-by-side code changes report for "ftst_rengrps.F": 4.4.4_vs_4.4.5.

    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_rengrps.F,v 1.3 2010/02/03 14:35:21 ed Exp $
    8 
    9       program ftst_rengrps
   10 C      use typeSizes
   11 C      use netcdf
   12 C      use netcdf4_f03
   13       implicit none
   14      include "netcdf.inc"
   15       
   16 C This is the name of the data file we will create.
   17       character (len = *), parameter :: FILE_NAME = "ftst_rengrps.nc"
   18 
   19 C We are writing 2D data, a 6 x 12 grid. 
   20       integer, parameter :: MAX_DIMS = 2
   21       integer, parameter :: NX = 6, NY = 12
   22       integer :: chunksizes(MAX_DIMS), chunksizes_in(MAX_DIMS)
   23       integer, parameter :: CACHE_NELEMS = 10000, CACHE_SIZE = 1000000
   24       integer, parameter :: DEFLATE_LEVEL = 4
   25 C We need these ids and other gunk for netcdf.
   26       integer :: ncid, varid1, varid2, dimids(MAX_DIMS)
   27       integer :: x_dimid, y_dimid
   28       integer :: nvars, ngatts, ndims, unlimdimid, file_format
   29       character (len = *), parameter :: VAR1_NAME = "VarName1"
   30       character (len = *), parameter :: VAR2_NAME = "VarName2"
   31       character (len = *), parameter :: GRP1_NAME = "Old_Grp1_name"
   32       character (len = *), parameter :: GRP2_NAME = "Old_Grp2_name"
   33       character (len = *), parameter :: NEW_GRP1_NAME = "new_Grp1_name"
   34       character (len = *), parameter :: NEW_GRP2_NAME = "new_Grp2_name"
   35 
   36       character (len = NF_MAX_NAME) :: grp1_full_name
   37       integer :: ilen
   38 
   39 C Information read back from the file to check correctness.
   40       integer :: varid1_in, varid2_in
   41       integer :: grpid1, grpid2
   42       integer :: xtype_in, ndims_in, natts_in, dimids_in(MAX_DIMS)
   43       character (len = nf_max_name) :: name_in
   44 
   45       print *, ''
   46       print *,'*** Testing netCDF-4 rename groups from Fortran 90.'
   47 
   48 C Create the netCDF file. 
   49       call check(nf_create(FILE_NAME, NF_NETCDF4, ncid))
   50 
   51 C Define the dimensions.
   52       call check(nf_def_dim(ncid, "x", NX, x_dimid))
   53       call check(nf_def_dim(ncid, "y", NY, y_dimid))
   54       dimids =  (/ y_dimid, x_dimid /)
   55 
   56 C Define some nested groups.
   57       call check(nf_def_grp(ncid, GRP1_NAME, grpid1))
   58       call check(nf_def_grp(grpid1, GRP2_NAME, grpid2))
   59 
   60 C Define some variables. 
   61       chunksizes = (/ NY, NX /)
   62       call check(nf_def_var(ncid, VAR1_NAME, NF_INT, MAX_DIMS, dimids,  &
   63      &  varid1))
   64       call check(nf_def_var(grpid1, VAR2_NAME, NF_INT, MAX_DIMS, dimids,&
   65      & varid2))
   66 
   67 C Close the file. 
   68       call check(nf_close(ncid))
   69 
   70 C Reopen the file.
   71       call check(nf_open(FILE_NAME, NF_WRITE, ncid))
   72       
   73 C Get the group ids for the newly reopened file.
   74       call check(nf_inq_grp_ncid(ncid, GRP1_NAME, grpid1))
   75       call check(nf_inq_grp_ncid(grpid1, GRP2_NAME, grpid2))
   76 
   77 C Check for the groups with full group names. 
   78       write(grp1_full_name, '(A,A)') '/', GRP1_NAME
   79       call check(nf_inq_grp_full_ncid(ncid, grp1_full_name, grpid1))
   80       call check(nf_inq_grpname(grpid1, name_in))
   81       if (name_in .ne. GRP1_NAME) stop 61
   82       call check(nf_inq_grpname_full(grpid1, ilen, name_in))
   83       if (name_in .ne. grp1_full_name) stop 62
   84 
   85       Call check(nf_rename_grp(grpid1, NEW_GRP1_NAME))
   86       name_in=REPEAT(" ",LEN(name_in))
   87       Call check(nf_inq_grpname(grpid1, name_in))
   88       If (name_in /= NEW_GRP1_NAME) Call check(-1)
   89 
   90 C Close the file. 
   91       call check(nf_close(ncid))
   92 
   93       print *,'*** SUCCESS!'
   94 
   95       contains
   96 C         This subroutine handles errors by printing an error message and
   97 C         exiting with a non-zero status.
   98       subroutine check(errcode)
   99 C        use netcdf
  100         implicit none
  101         include "netcdf.inc"
  102         integer, intent(in) :: errcode
  103         
  104         if(errcode /= NF_NOERR) then
  105            print *, 'Error: ', trim(nf_strerror(errcode))
  106            stop 2
  107         endif
  108       end subroutine check
  109 
  110       end program ftst_rengrps