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