1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
C This is part of the netCDF package. Copyright 2006-2019 University
C Corporation for Atmospheric Research/Unidata. See COPYRIGHT file
C for conditions of use.
C Tests new nf_inq_path function
C Mimics tests in C tst_files5.c code
C Russ Rew, 2014
program ftst_path
implicit NONE
include "netcdf.inc"
character(len=*), parameter :: FILE_NAME="ftst_path.nc"
integer :: path_len, ncid
character(LEN=NF_MAX_NAME+1) :: path_in
path_in = REPEAT(" ", LEN(path_in))
path_len = 0
print *,''
print *,'*** Testing netcdf file functions.'
print *,'*** Checking the new inq_path function'
C Test with classic mode nf_create
call check(nf_create(FILE_NAME, nf_classic_model, ncid))
call check(nf_inq_path(ncid, path_len, path_in))
if ((path_len /= LEN(FILE_NAME)) .OR. &
& (FILE_NAME /= TRIM(path_in))) &
& call check(-1)
call check(nf_close(ncid))
path_in=REPEAT(" ", LEN(path_in))
path_len=0
C Test with classic mode nf_open
call check(nf_open(FILE_NAME, nf_classic_model, ncid))
call check(nf_inq_path(ncid, path_len, path_in))
if ((path_len /= LEN(FILE_NAME)) .OR. &
& (FILE_NAME /= TRIM(path_in))) &
& call check(-1)
call check(nf_close(ncid))
path_in=REPEAT(" ", LEN(path_in))
path_len=0
C Test with netcdf4 mode nf_create
call check(nf_create(FILE_NAME, nf_netcdf4, ncid))
call check(nf_inq_path(ncid, path_len, path_in))
if ((path_len /= LEN(FILE_NAME)) .OR. &
& (FILE_NAME /= TRIM(path_in))) &
& call check(-1)
call check(nf_close(ncid))
path_in=REPEAT(" ", LEN(path_in))
path_len=0
C Test with netcdf4 mode nf_open
call check(nf_open(FILE_NAME, nf_netcdf4, ncid))
call check(nf_inq_path(ncid, path_len, path_in))
if ((path_len /= LEN(FILE_NAME)) .OR. &
& (FILE_NAME /= TRIM(path_in))) &
& call check(-1)
call check(nf_close(ncid))
path_in=REPEAT(" ", LEN(path_in))
path_len=0
print *,'*** SUCCESS! '
contains
C This subroutine handles errors by printing an error message and
C exiting with a non-zero status.
subroutine check(errcode)
use netcdf
implicit none
integer, intent(in) :: errcode
if(errcode /= nf_noerr) then
print *, 'Error: ', trim(nf_strerror(errcode))
stop 2
endif
end subroutine check
end program ftst_path
|
