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
10program 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
79contains
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
93end program f90tst_path
94