@@ -42,7 +42,7 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
42
42
real (4 ), dimension (:,:,:), allocatable :: arrayr4 _3d,arrayr4 _3d_save
43
43
real (8 ), dimension (:,:,:), allocatable :: arrayr8 _3d
44
44
45
- real (8 ) rad2dg, x(im),y(jm)
45
+ real (8 ) x(im),y(jm)
46
46
integer :: fieldCount, fieldDimCount, gridDimCount
47
47
integer , dimension (:), allocatable :: ungriddedLBound, ungriddedUBound
48
48
@@ -56,7 +56,8 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
56
56
character (len= ESMF_MAXSTR) :: attName, fldName
57
57
58
58
integer :: varival
59
- real (4 ) :: varr4 val, scale_fact, compress_err, offset, dataMin, dataMax
59
+ real (4 ) :: varr4 val, scale_fact, offset, dataMin, dataMax
60
+ real (4 ), allocatable , dimension (:) :: compress_err
60
61
real (8 ) :: varr8 val
61
62
character (len= ESMF_MAXSTR) :: varcval
62
63
@@ -71,10 +72,10 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
71
72
!
72
73
! !
73
74
!
74
- rad2dg = 45 ./ atan (1.0 )
75
75
76
76
call ESMF_FieldBundleGet(fieldbundle, fieldCount= fieldCount, rc= rc); ESMF_ERR_RETURN(rc)
77
77
78
+ allocate (compress_err(fieldCount)); compress_err=- 999 .
78
79
allocate (fldlev(fieldCount)) ; fldlev = 0
79
80
allocate (fcstField(fieldCount))
80
81
allocate (varids(fieldCount))
@@ -117,13 +118,13 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
117
118
if (mype== 0 ) then
118
119
119
120
if (ideflate == 0 ) then
120
- ncerr = nf90_create(trim (filename), cmode= IOR (NF90_CLOBBER,NF90_64BIT_OFFSET), &
121
+ ncerr = nf90_create(trim (filename), cmode= IOR (IOR ( NF90_CLOBBER,NF90_64BIT_OFFSET),NF90_SHARE ), &
121
122
ncid= ncid); NC_ERR_STOP(ncerr)
122
123
ncerr = nf90_set_fill(ncid, NF90_NOFILL, oldMode); NC_ERR_STOP(ncerr)
123
124
else
124
125
ncerr = nf90_create(trim (filename), cmode= IOR (IOR (NF90_CLOBBER,NF90_NETCDF4),NF90_CLASSIC_MODEL), &
125
126
ncid= ncid); NC_ERR_STOP(ncerr)
126
- ! if compression on use HDF5 format with default _FillValue
127
+ ncerr = nf90_set_fill(ncid, NF90_NOFILL, oldMode); NC_ERR_STOP(ncerr)
127
128
endif
128
129
129
130
! define dimensions
@@ -156,28 +157,32 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
156
157
! define variables
157
158
if (fldlev(i) == 1 ) then
158
159
if (typekind == ESMF_TYPEKIND_R4 ) then
159
- ncerr = nf90_def_var(ncid, trim (fldName), NF90_FLOAT, &
160
- (/ im_dimid,jm_dimid,time_dimid/ ), varids(i)); NC_ERR_STOP(ncerr)
161
160
if (ideflate > 0 ) then
162
- ! shuffle filter on for lossless compression
163
- ncerr = nf90_def_var_deflate(ncid, varids(i), 1 , 1 , ideflate)
164
- NC_ERR_STOP(ncerr)
161
+ ncerr = nf90_def_var(ncid, trim (fldName), NF90_FLOAT, &
162
+ (/ im_dimid,jm_dimid,time_dimid/ ), varids(i), &
163
+ shuffle= .true. ,deflate_level= ideflate, &
164
+ chunksizes= (/ im,jm,1 / )); NC_ERR_STOP(ncerr)
165
+ else
166
+ ncerr = nf90_def_var(ncid, trim (fldName), NF90_FLOAT, &
167
+ (/ im_dimid,jm_dimid,time_dimid/ ), varids(i)); NC_ERR_STOP(ncerr)
165
168
endif
166
169
else if (typekind == ESMF_TYPEKIND_R8 ) then
167
170
ncerr = nf90_def_var(ncid, trim (fldName), NF90_DOUBLE, &
168
- (/ im_dimid,jm_dimid,time_dimid/ ), varids(i)); NC_ERR_STOP(ncerr)
171
+ (/ im_dimid,jm_dimid,time_dimid/ ), varids(i)); NC_ERR_STOP(ncerr)
169
172
else
170
173
write (0 ,* )' Unsupported typekind ' , typekind
171
174
stop
172
175
end if
173
176
else if (fldlev(i) > 1 ) then
174
177
if (typekind == ESMF_TYPEKIND_R4 ) then
175
- ncerr = nf90_def_var(ncid, trim (fldName), NF90_FLOAT, &
176
- (/ im_dimid,jm_dimid,pfull_dimid,time_dimid/ ), varids(i)); NC_ERR_STOP(ncerr)
177
178
if (ideflate > 0 ) then
178
- ! shuffle filter off since lossy compression used
179
- ncerr = nf90_def_var_deflate(ncid, varids(i), 0 , 1 , ideflate)
180
- NC_ERR_STOP(ncerr)
179
+ ncerr = nf90_def_var(ncid, trim (fldName), NF90_FLOAT, &
180
+ (/ im_dimid,jm_dimid,pfull_dimid,time_dimid/ ), varids(i), &
181
+ shuffle= .false. ,deflate_level= ideflate, &
182
+ chunksizes= (/ im,jm,1 ,1 / )); NC_ERR_STOP(ncerr)
183
+ else
184
+ ncerr = nf90_def_var(ncid, trim (fldName), NF90_FLOAT, &
185
+ (/ im_dimid,jm_dimid,pfull_dimid,time_dimid/ ), varids(i)); NC_ERR_STOP(ncerr)
181
186
endif
182
187
else if (typekind == ESMF_TYPEKIND_R8 ) then
183
188
ncerr = nf90_def_var(ncid, trim (fldName), NF90_DOUBLE, &
@@ -219,8 +224,8 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
219
224
call ESMF_AttributeGet(fcstField(i), convention= " NetCDF" , purpose= " FV3" , &
220
225
name= trim (attName), value= varr8 val, &
221
226
rc= rc); ESMF_ERR_RETURN(rc)
222
- if (trim (attName) /= ' _FillValue' .or. ideflate == 0 ) then
223
- ! FIXME: _FillValue must be cast to var type when using NF90_NETCDF4
227
+ if (trim (attName) /= ' _FillValue' ) then
228
+ ! FIXME: _FillValue must be cast to var type for recent versions of netcdf
224
229
ncerr = nf90_put_att(ncid, varids(i), trim (attName), varr8 val); NC_ERR_STOP(ncerr)
225
230
endif
226
231
@@ -236,6 +241,25 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
236
241
237
242
end do ! i=1,fieldCount
238
243
244
+ ! write grid_xt, grid_yt attributes
245
+ if (trim (output_grid) == ' gaussian_grid' .or. &
246
+ trim (output_grid) == ' regional_latlon' ) then
247
+ ncerr = nf90_put_att(ncid, im_varid, " long_name" , " T-cell longitude" ); NC_ERR_STOP(ncerr)
248
+ ncerr = nf90_put_att(ncid, im_varid, " units" , " degrees_E" ); NC_ERR_STOP(ncerr)
249
+ ncerr = nf90_put_att(ncid, jm_varid, " long_name" , " T-cell latiitude" ); NC_ERR_STOP(ncerr)
250
+ ncerr = nf90_put_att(ncid, jm_varid, " units" , " degrees_N" ); NC_ERR_STOP(ncerr)
251
+ else if (trim (output_grid) == ' rotated_latlon' ) then
252
+ ncerr = nf90_put_att(ncid, im_varid, " long_name" , " rotated T-cell longiitude" ); NC_ERR_STOP(ncerr)
253
+ ncerr = nf90_put_att(ncid, im_varid, " units" , " degrees" ); NC_ERR_STOP(ncerr)
254
+ ncerr = nf90_put_att(ncid, jm_varid, " long_name" , " rotated T-cell latiitude" ); NC_ERR_STOP(ncerr)
255
+ ncerr = nf90_put_att(ncid, jm_varid, " units" , " degrees" ); NC_ERR_STOP(ncerr)
256
+ else if (trim (output_grid) == ' lambert_conformal' ) then
257
+ ncerr = nf90_put_att(ncid, im_varid, " long_name" , " x-coordinate of projection" ); NC_ERR_STOP(ncerr)
258
+ ncerr = nf90_put_att(ncid, im_varid, " units" , " meters" ); NC_ERR_STOP(ncerr)
259
+ ncerr = nf90_put_att(ncid, jm_varid, " long_name" , " y-coordinate of projection" ); NC_ERR_STOP(ncerr)
260
+ ncerr = nf90_put_att(ncid, jm_varid, " units" , " meters" ); NC_ERR_STOP(ncerr)
261
+ endif
262
+
239
263
ncerr = nf90_enddef(ncid); NC_ERR_STOP(ncerr)
240
264
end if
241
265
@@ -247,63 +271,39 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
247
271
if (mype== 0 ) then
248
272
if (trim (output_grid) == ' gaussian_grid' .or. &
249
273
trim (output_grid) == ' regional_latlon' ) then
250
- ncerr = nf90_put_var(ncid, im_varid, values= rad2dg* arrayr8 (:,1 ) ); NC_ERR_STOP(ncerr)
251
- ncerr = nf90_redef(ncid= ncid); NC_ERR_STOP(ncerr)
252
- ncerr = nf90_put_att(ncid, im_varid, " long_name" , " T-cell longitude" ); NC_ERR_STOP(ncerr)
253
- ncerr = nf90_put_att(ncid, im_varid, " units" , " degrees_E" ); NC_ERR_STOP(ncerr)
254
- ncerr = nf90_enddef(ncid= ncid); NC_ERR_STOP(ncerr)
274
+ ncerr = nf90_put_var(ncid, im_varid, values= arrayr8 (:,1 ) ); NC_ERR_STOP(ncerr)
255
275
else if (trim (output_grid) == ' rotated_latlon' ) then
256
276
do i= 1 ,im
257
277
x(i) = lon1 + (lon2- lon1)/ (im-1 ) * (i-1 )
258
278
enddo
259
279
ncerr = nf90_put_var(ncid, im_varid, values= x ); NC_ERR_STOP(ncerr)
260
- ncerr = nf90_redef(ncid= ncid); NC_ERR_STOP(ncerr)
261
- ncerr = nf90_put_att(ncid, im_varid, " long_name" , " rotated T-cell longiitude" ); NC_ERR_STOP(ncerr)
262
- ncerr = nf90_put_att(ncid, im_varid, " units" , " degrees" ); NC_ERR_STOP(ncerr)
263
- ncerr = nf90_enddef(ncid= ncid); NC_ERR_STOP(ncerr)
264
280
else if (trim (output_grid) == ' lambert_conformal' ) then
265
281
do i= 1 ,im
266
282
x(i) = dx * (i-1 )
267
283
enddo
268
284
ncerr = nf90_put_var(ncid, im_varid, values= x ); NC_ERR_STOP(ncerr)
269
- ncerr = nf90_redef(ncid= ncid); NC_ERR_STOP(ncerr)
270
- ncerr = nf90_put_att(ncid, im_varid, " long_name" , " x-coordinate of projection" ); NC_ERR_STOP(ncerr)
271
- ncerr = nf90_put_att(ncid, im_varid, " units" , " meters" ); NC_ERR_STOP(ncerr)
272
- ncerr = nf90_enddef(ncid= ncid); NC_ERR_STOP(ncerr)
273
285
endif
274
- ncerr = nf90_put_var(ncid, lon_varid, values= rad2dg * arrayr8 ); NC_ERR_STOP(ncerr)
286
+ ncerr = nf90_put_var(ncid, lon_varid, values= arrayr8 ); NC_ERR_STOP(ncerr)
275
287
endif
276
288
277
289
call ESMF_GridGetCoord(wrtGrid, coordDim= 2 , array= array, rc= rc); ESMF_ERR_RETURN(rc)
278
290
call ESMF_ArrayGather(array, arrayr8 , rootPet= 0 , rc= rc); ESMF_ERR_RETURN(rc)
279
291
if (mype== 0 ) then
280
292
if (trim (output_grid) == ' gaussian_grid' .or. &
281
293
trim (output_grid) == ' regional_latlon' ) then
282
- ncerr = nf90_put_var(ncid, jm_varid, values= rad2dg* arrayr8 (1 ,:) ); NC_ERR_STOP(ncerr)
283
- ncerr = nf90_redef(ncid= ncid); NC_ERR_STOP(ncerr)
284
- ncerr = nf90_put_att(ncid, jm_varid, " long_name" , " T-cell latiitude" ); NC_ERR_STOP(ncerr)
285
- ncerr = nf90_put_att(ncid, jm_varid, " units" , " degrees_N" ); NC_ERR_STOP(ncerr)
286
- ncerr = nf90_enddef(ncid= ncid); NC_ERR_STOP(ncerr)
294
+ ncerr = nf90_put_var(ncid, jm_varid, values= arrayr8 (1 ,:) ); NC_ERR_STOP(ncerr)
287
295
else if (trim (output_grid) == ' rotated_latlon' ) then
288
296
do j= 1 ,jm
289
297
y(j) = lat1 + (lat2- lat1)/ (jm-1 ) * (j-1 )
290
298
enddo
291
299
ncerr = nf90_put_var(ncid, jm_varid, values= y ); NC_ERR_STOP(ncerr)
292
- ncerr = nf90_redef(ncid= ncid); NC_ERR_STOP(ncerr)
293
- ncerr = nf90_put_att(ncid, jm_varid, " long_name" , " rotated T-cell latiitude" ); NC_ERR_STOP(ncerr)
294
- ncerr = nf90_put_att(ncid, jm_varid, " units" , " degrees" ); NC_ERR_STOP(ncerr)
295
- ncerr = nf90_enddef(ncid= ncid); NC_ERR_STOP(ncerr)
296
300
else if (trim (output_grid) == ' lambert_conformal' ) then
297
301
do j= 1 ,jm
298
302
y(j) = dy * (j-1 )
299
303
enddo
300
304
ncerr = nf90_put_var(ncid, jm_varid, values= y ); NC_ERR_STOP(ncerr)
301
- ncerr = nf90_redef(ncid= ncid); NC_ERR_STOP(ncerr)
302
- ncerr = nf90_put_att(ncid, jm_varid, " long_name" , " y-coordinate of projection" ); NC_ERR_STOP(ncerr)
303
- ncerr = nf90_put_att(ncid, jm_varid, " units" , " meters" ); NC_ERR_STOP(ncerr)
304
- ncerr = nf90_enddef(ncid= ncid); NC_ERR_STOP(ncerr)
305
305
endif
306
- ncerr = nf90_put_var(ncid, lat_varid, values= rad2dg * arrayr8 ); NC_ERR_STOP(ncerr)
306
+ ncerr = nf90_put_var(ncid, lat_varid, values= arrayr8 ); NC_ERR_STOP(ncerr)
307
307
endif
308
308
309
309
do i= 1 , fieldCount
@@ -344,11 +344,7 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
344
344
arrayr4 _3d = quantized(arrayr4 _3d_save, nbits, dataMin, dataMax)
345
345
! compute max abs compression error, save as a variable
346
346
! attribute.
347
- compress_err = maxval (abs (arrayr4 _3d_save- arrayr4 _3d))
348
- ncerr = nf90_redef(ncid= ncid); NC_ERR_STOP(ncerr)
349
- ncerr = nf90_put_att(ncid, varids(i), ' max_abs_compression_error' , compress_err); NC_ERR_STOP(ncerr)
350
- ncerr = nf90_put_att(ncid, varids(i), ' nbits' , nbits); NC_ERR_STOP(ncerr)
351
- ncerr = nf90_enddef(ncid= ncid); NC_ERR_STOP(ncerr)
347
+ compress_err(i) = maxval (abs (arrayr4 _3d_save- arrayr4 _3d))
352
348
endif
353
349
ncerr = nf90_put_var(ncid, varids(i), values= arrayr4 _3d, start= (/ 1 ,1 ,1 / ),count= (/ im,jm,lm,1 / ) ); NC_ERR_STOP(ncerr)
354
350
end if
@@ -363,6 +359,17 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, rc
363
359
364
360
end do
365
361
362
+ if (ideflate > 0 .and. nbits > 0 .and. mype == 0 ) then
363
+ ncerr = nf90_redef(ncid= ncid); NC_ERR_STOP(ncerr)
364
+ do i= 1 , fieldCount
365
+ if (compress_err(i) > 0 ) then
366
+ ncerr = nf90_put_att(ncid, varids(i), ' max_abs_compression_error' , compress_err(i)); NC_ERR_STOP(ncerr)
367
+ ncerr = nf90_put_att(ncid, varids(i), ' nbits' , nbits); NC_ERR_STOP(ncerr)
368
+ endif
369
+ enddo
370
+ ncerr = nf90_enddef(ncid= ncid); NC_ERR_STOP(ncerr)
371
+ endif
372
+
366
373
deallocate (arrayr4 )
367
374
deallocate (arrayr8 )
368
375
deallocate (arrayr4 _3d,arrayr4 _3d_save)
@@ -484,9 +491,9 @@ subroutine get_grid_attr(grid, prefix, ncid, varid, rc)
484
491
else if (typekind== ESMF_TYPEKIND_R8 ) then
485
492
call ESMF_AttributeGet(grid, convention= " NetCDF" , purpose= " FV3" , &
486
493
name= trim (attName), value= varr8 val, rc= rc); ESMF_ERR_RETURN(rc)
487
- if (trim (attName) /= ' _FillValue' .or. ideflate == 0 ) then
488
- ! FIXME: _FillValue must be cast to var type when using
489
- ! NF90_NETCDF4. Until this is fixed, using netCDF default _FillValue.
494
+ if (trim (attName) /= ' _FillValue' ) then
495
+ ! FIXME: _FillValue must be cast to var type for recent versions
496
+ ! of netcdf
490
497
ncerr = nf90_put_att(ncid, varid, trim (attName(ind+1 :len (attName))), varr8 val); NC_ERR_STOP(ncerr)
491
498
endif
492
499
0 commit comments