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
|
! This is part of the netCDF package. Copyright 2006-2019
! University Corporation for Atmospheric Research/Unidata. See
! COPYRIGHT file for conditions of use.
! Tests new nf90_inq_path function
! Mimics tests in C tst_files5.c code
! Russ Rew
program f90tst_path
use typeSizes
use netcdf
implicit NONE
character(len=*), parameter :: FILE_NAME="f90tst_path.nc"
integer :: path_len, ncid
character(LEN=NF90_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'
! Test with classic mode nf90_create
call check(nf90_create(FILE_NAME, nf90_classic_model, ncid))
call check(nf90_inq_path(ncid, path_len, path_in))
if ((path_len /= LEN(FILE_NAME)) .OR. (FILE_NAME /= TRIM(path_in))) &
call check(-1)
call check(nf90_close(ncid))
path_in=REPEAT(" ", LEN(path_in))
path_len=0
! Test with classic mode nf90_open
call check(nf90_open(FILE_NAME, nf90_classic_model, ncid))
call check(nf90_inq_path(ncid, path_len, path_in))
if ((path_len /= LEN(FILE_NAME)) .OR. (FILE_NAME /= TRIM(path_in))) &
call check(-1)
call check(nf90_close(ncid))
path_in=REPEAT(" ", LEN(path_in))
path_len=0
! Test with netcdf4 mode nf90_create
call check(nf90_create(FILE_NAME, nf90_netcdf4, ncid))
call check(nf90_inq_path(ncid, path_len, path_in))
if ((path_len /= LEN(FILE_NAME)) .OR. (FILE_NAME /= TRIM(path_in))) &
call check(-1)
call check(nf90_close(ncid))
path_in=REPEAT(" ", LEN(path_in))
path_len=0
! Test with netcdf4 mode nf90_open
call check(nf90_open(FILE_NAME, nf90_netcdf4, ncid))
call check(nf90_inq_path(ncid, path_len, path_in))
if ((path_len /= LEN(FILE_NAME)) .OR. (FILE_NAME /= TRIM(path_in))) &
call check(-1)
call check(nf90_close(ncid))
path_in=REPEAT(" ", LEN(path_in))
path_len=0
Print *,'*** SUCCESS!'
contains
! This subroutine handles errors by printing an error message and
! exiting with a non-zero status.
subroutine check(errcode)
use netcdf
implicit none
integer, intent(in) :: errcode
if(errcode /= nf90_noerr) then
print *, 'Error: ', trim(nf90_strerror(errcode))
stop 2
endif
end subroutine check
end program f90tst_path
|
