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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
! This program provides an elementary check of some of the parts of the
! Fortran 90 interface to netCDF 3.5. It is a Fortran 90 implementation
! of the nctst.cpp program provided with the C++ interface to netcdf
! (in the src/cxx directory of the netcdf distribution).
!
program netcdfTest
use typeSizes
use netcdf
implicit none
! netcdf related variables
integer :: ncFileID, &
latDimID, lonDimID, frTimeDimID, timeDimID, mxStrDimID, &
pressVarID, latVarID, lonVarID, frTimeVarID, refTimeVarID, &
scalarVarID, scalarStrVarID
! Local variables
integer, parameter :: numLats = 4, numLons = 3, &
numFrTimes = 2, timeStringLen = 20, mxStrLen=80
character (len = *), parameter :: fileName = "tst_f90.nc"
integer :: counter, i
real, dimension(numLons, numLats, numFrTimes) :: pressure
integer (kind = FourByteInt), dimension(numFrTimes) :: frTimeVals
real (kind = FourByteReal) fillVal;
real (kind = FourByteReal), dimension(2) :: validRange;
character (len = 20) frTimeUnits
character(len=mxStrLen) :: scalarString, scalarStrRead
print *, ''
print *,'*** Testing netCDF-3 Fortran 90 API.'
! --------------------
! Code begins
! --------------------
if(.not. byteSizesOK()) then
print *, "Compiler does not appear to support required kinds of variables."
stop
end if
! Create the file
call check(nf90_create(path = trim(fileName), cmode = nf90_clobber, ncid = ncFileID))
! Define the dimensions
call check(nf90_def_dim(ncid = ncFileID, name = "lat", len = numLats, dimid = latDimID))
call check(nf90_def_dim(ncid = ncFileID, name = "lon", len = numLons, dimid = lonDimID))
call check(nf90_def_dim(ncid = ncFileID, name = "frtime", len = nf90_unlimited, dimid = frTimeDimID))
call check(nf90_def_dim(ncid = ncFileID, name = "timelen", len = timeStringLen, dimid = timeDimID))
call check(nf90_def_dim(ncid = ncFileID, name = "mxstrlen",len = mxStrLen, dimid = mxStrDimID))
! Create variables and attributes
call check(nf90_def_var(ncid = ncFileID, name = "P", xtype = nf90_float, &
dimids = (/ lonDimID, latDimID, frTimeDimID /), varID = pressVarID) )
call check(nf90_put_att(ncFileID, pressVarID, "long_name", "pressure at maximum wind"))
call check(nf90_put_att(ncFileID, pressVarID, "units", "hectopascals") )
! Use 4-byte reals explicitly, to match 4-byte attribute type in test file
validRange(1) = 0.
validRange(2) = 1500
call check(nf90_put_att(ncFileID, pressVarID, "valid_range", validRange))
! Use a 4-byte float constant, to match variable type
fillVal = -9999.0
call check(nf90_put_att(ncFileID, pressVarID, "_FillValue", fillVal ) )
call check(nf90_def_var(ncFileID, "lat", nf90_float, dimids = latDimID, varID = latVarID) )
call check(nf90_put_att(ncFileID, latVarID, "long_name", "latitude"))
call check(nf90_put_att(ncFileID, latVarID, "units", "degrees_north"))
call check(nf90_def_var(ncFileID, "lon", nf90_float, lonDimID, lonVarID) )
call check(nf90_put_att(ncFileID, lonVarID, "long_name", "longitude"))
call check(nf90_put_att(ncFileID, lonVarID, "units", "degrees_east"))
call check(nf90_def_var(ncFileID, "frtime", nf90_int, frTimeDimID, frTimeVarID) )
call check(nf90_put_att(ncFileID, frTimeVarID, "long_name", "forecast time"))
call check(nf90_put_att(ncFileID, frTimeVarID, "units", "hours"))
call check(nf90_def_var(ncFileID, "reftime", nf90_char, timeDimID, refTimeVarID) )
call check(nf90_put_att(ncFileID, refTimeVarID, "long_name", "reference time"))
call check(nf90_put_att(ncFileID, refTimeVarID, "units", "text_time"))
! In the C++ interface the define a scalar variable - do we know how to do this?
call check(nf90_def_var(ncFileID, "ScalarVariable", nf90_real, scalarVarID))
! Define a scalar string -- in a netCDF file it's a 1-D character array
call check(nf90_def_var(ncFileID, "ScalarString", nf90_char, (/mxStrDimID/), scalarStrVarID))
! Global attributes
call check(nf90_put_att(ncFileID, nf90_global, "history", &
"created by Unidata LDM from NPS broadcast"))
call check(nf90_put_att(ncFileID, nf90_global, "title", &
"NMC Global Product Set: Pressure at Maximum Wind"))
! Leave define mode
call check(nf90_enddef(ncfileID))
! Write the dimension variables
call check(nf90_put_var(ncFileID, latVarId, (/ -90., -87.5, -85., -82.5 /)) )
call check(nf90_put_var(ncFileID, lonVarId, (/ -180, -175, -170 /) ) )
! Don't use anonymous array here, in case platform has 8-byte integers
frTimeVals(1) = 12
frTimeVals(2) = 18
call check(nf90_put_var(ncFileID, frTimeVarId, frTimeVals ) )
call check(nf90_put_var(ncFileID, reftimeVarID, "1992-3-21 12:00" ) )
! Write the pressure variable. Write a slab at a time to check incrementing.
pressure = 949. + real(reshape( (/ (counter, counter = 1, numLats * numLons * numFrTimes) /), &
(/ numLons, numLats, numFrTimes /) ) )
call check(nf90_put_var(ncFileID, pressVarID, pressure(:, :, 1:1)) )
call check(nf90_put_var(ncFileID, pressVarID, pressure(:, :, 2:2), start = (/ 1, 1, 2 /)) )
call check(nf90_put_var(ncFileID, scalarVarID, 10))
! Write a scalar string -- note that Fortran assignement adds blank fill
scalarString = 'this is a blank padded string'
call check(nf90_put_var(ncFileID, scalarStrVarID, scalarString))
call check(nf90_close(ncFileID))
! Now open the file to read and check a few values
call check(nf90_open(trim(fileName), NF90_NOWRITE, ncFileID))
call check(nf90_inq_varid(ncFileID,"frtime",frTimeVarID))
call check(nf90_get_att(ncFileID,frTimeVarID,"units",frTimeUnits))
if(frTimeUnits .ne. "hours") then
print *, 'Attribute value not what was written:', frTimeUnits
stop 2
endif
call check(nf90_get_var(ncFileID, scalarStrVarID, scalarStrRead))
if(scalarStrRead .ne. scalarString) then
do i = 1, len(scalarString)
if (scalarStrRead(i:i) .ne. scalarString(i:i)) exit
end do
print *, 'String written to file does not match string read from file.'
print *, 'Position of first difference:', i, ' character written:', '"'//scalarString(i:i)//'"', &
' character read:', '"'//scalarStrRead(i:i)//'"'
stop 2
endif
call check(nf90_close(ncFileID))
print *,'*** SUCCESS!'
contains
! Internal subroutine - checks error status after each netcdf, prints out text message each time
! an error code is returned.
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 netcdfTest
|
