"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.5.2/nf03_test4/f90tst_path.f90" (18 Sep 2019, 2366 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 !     Tests new nf90_inq_path function
    6 !     Mimics tests in C tst_files5.c code
    7 
    8 !      Russ Rew
    9 
   10 program f90tst_path
   11   use typeSizes
   12   use netcdf
   13 
   14   implicit NONE
   15 
   16   character(len=*), parameter :: FILE_NAME="f90tst_path.nc"
   17 
   18   integer                        :: path_len, ncid
   19   character(LEN=NF90_MAX_NAME+1) :: path_in
   20 
   21   path_in   = REPEAT(" ", LEN(path_in))
   22   path_len  = 0
   23 
   24   print *,''
   25   print *,'*** Testing netcdf file functions.'
   26   print *,'*** Checking the new inq_path function'
   27 
   28 ! Test with classic mode nf90_create
   29 
   30   call check(nf90_create(FILE_NAME, nf90_classic_model, ncid))
   31   call check(nf90_inq_path(ncid, path_len, path_in))
   32 
   33   if ((path_len /= LEN(FILE_NAME)) .OR. (FILE_NAME /= TRIM(path_in)))  &
   34     call check(-1)
   35   call check(nf90_close(ncid))
   36 
   37   path_in=REPEAT(" ", LEN(path_in))
   38   path_len=0
   39 
   40 ! Test with classic mode nf90_open
   41 
   42   call check(nf90_open(FILE_NAME, nf90_classic_model, ncid))
   43   call check(nf90_inq_path(ncid, path_len, path_in))
   44 
   45   if ((path_len /= LEN(FILE_NAME)) .OR. (FILE_NAME /= TRIM(path_in)))  &
   46     call check(-1)
   47   call check(nf90_close(ncid))
   48 
   49   path_in=REPEAT(" ", LEN(path_in))
   50   path_len=0
   51 
   52 
   53 ! Test with netcdf4 mode nf90_create
   54 
   55   call check(nf90_create(FILE_NAME, nf90_netcdf4, ncid))
   56   call check(nf90_inq_path(ncid, path_len, path_in))
   57 
   58   if ((path_len /= LEN(FILE_NAME)) .OR. (FILE_NAME /= TRIM(path_in)))  &
   59     call check(-1)
   60   call check(nf90_close(ncid))
   61 
   62   path_in=REPEAT(" ", LEN(path_in))
   63   path_len=0
   64 
   65 ! Test with netcdf4 mode nf90_open
   66 
   67   call check(nf90_open(FILE_NAME, nf90_netcdf4, ncid))
   68   call check(nf90_inq_path(ncid, path_len, path_in))
   69 
   70   if ((path_len /= LEN(FILE_NAME)) .OR. (FILE_NAME /= TRIM(path_in)))  &
   71     call check(-1)
   72   call check(nf90_close(ncid))
   73 
   74   path_in=REPEAT(" ", LEN(path_in))
   75   path_len=0
   76 
   77   Print *,'*** SUCCESS!'
   78 
   79 contains
   80 !     This subroutine handles errors by printing an error message and
   81 !     exiting with a non-zero status.
   82   subroutine check(errcode)
   83     use netcdf
   84     implicit none
   85     integer, intent(in) :: errcode
   86 
   87     if(errcode /= nf90_noerr) then
   88        print *, 'Error: ', trim(nf90_strerror(errcode))
   89        stop 2
   90     endif
   91   end subroutine check
   92 
   93 end program f90tst_path