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 2007 University Corporation for Atmospheric Research/Unidata.
! See COPYRIGHT file for conditions of use.
! This program tests netCDF-4 new types from fortran 90.
! $Id: tst_types.f90,v 1.7 2009/01/25 14:33:44 ed Exp $
program tst_types
use typeSizes
use netcdf
implicit none
! This is the name of the data file we will create.
character (len = *), parameter :: FILE_NAME = "tst_types.nc"
! Information for the types we create.
character (len = *), parameter :: OPAQUE_TYPE_NAME = "Odessyus"
character (len = *), parameter :: var_name = "Polyphemus"
character (len = 80) :: name_in
character (len = 10), parameter :: opaque_data = "0123456789"
character (len = *), parameter :: att_name = "att1"
integer, parameter :: OPAQUE_SIZE = 10
integer (kind = EightByteInt) BIG_NUMBER, num_in
parameter (BIG_NUMBER = 4294967295_EightByteInt)
integer :: ncid, opaque_typeid, varid
integer :: size_in, base_typeid_in, nfields_in, class_in
print *, ''
print *,'*** Testing new netCDF-4 types from Fortran 90.'
! Create the netCDF file.
call check(nf90_create(FILE_NAME, nf90_netcdf4, ncid))
! Create an opaque type.
call check(nf90_def_opaque(ncid, OPAQUE_SIZE, OPAQUE_TYPE_NAME, opaque_typeid))
! Write an (global) opaque attribute.
call check(nf90_put_att_any(ncid, NF90_GLOBAL, att_name, opaque_typeid, 1, opaque_data))
! Create an int64 scalar variable.
call check(nf90_def_var(ncid, var_name, nf90_int64, varid))
! Write a large integer (too large to fit in 32-bit ints).
call check(nf90_put_var(ncid, varid, BIG_NUMBER))
! Close the file.
call check(nf90_close(ncid))
! Reopen the netCDF file.
call check(nf90_open(FILE_NAME, 0, ncid))
! Check the opaque type.
call check(nf90_inq_user_type(ncid, opaque_typeid, name_in, size_in, &
base_typeid_in, nfields_in, class_in))
if (name_in(1:len(OPAQUE_TYPE_NAME)) .ne. OPAQUE_TYPE_NAME .or. &
size_in .ne. OPAQUE_SIZE .or. base_typeid_in .ne. 0 .or. &
nfields_in .ne. 0 .or. class_in .ne. NF90_OPAQUE) stop 2
! Check it again with the inq_opaque call.
call check(nf90_inq_opaque(ncid, opaque_typeid, name_in, size_in))
if (name_in(1:len(OPAQUE_TYPE_NAME)) .ne. OPAQUE_TYPE_NAME .or. &
size_in .ne. OPAQUE_SIZE) stop 2
! Check it again with the inq_type call
!! call check(nf90_inq_type(ncid, opaque_typeid, name_in, size_in))
if (name_in(1:len(OPAQUE_TYPE_NAME)) .ne. OPAQUE_TYPE_NAME .or. &
size_in .ne. OPAQUE_SIZE) stop 2
! Read in the large number.
call check(nf90_get_var(ncid, varid, num_in))
if (num_in .ne. BIG_NUMBER) stop 2
! Close the file.
call check(nf90_close(ncid))
print *,'*** SUCCESS!'
! This subroutine handles errors by printing an error message and
! exiting with a non-zero status.
contains
subroutine check(status)
integer, intent ( in) :: status
if(status /= nf90_noerr) then
print *, trim(nf90_strerror(status))
stop 2
end if
end subroutine check
end program tst_types
|
