Context Navigation

fp2nc4io_mod.F90 @ efd26ca

FPv9.3.2grib2nc4_repair

Last change on this file since efd26ca was efd26ca, checked in by Don Morton <Don.Morton@…>, 6 years ago

Changed double precision NC write to single precision.

Ticket #384 comment:17

Property mode set to 100644

File size: 16.4 KB

Line
1	MODULE fp2nc4io_mod
2
3	!****************************************************************
4	! *
5	! Contains data and routines for dumping selected FLEXPART *
6	! array variables to a NetCDF4 file. *
7	! *
8	! Don Morton (Boreal Scientific Computing LLC) *
9	! *
10	! May 2016 *
11	! *
12	! 2017-12-03 DJM - *
13	! *
14	! - Changed NF90_DOUBLE to NF90 FLOAT (6 places) *
15	! - Cleaned up long lines from addition of NC descriptions *
16	! *
17	! *
18	! *
19	!****************************************************************
20
21	USE par_mod
22	USE com_mod
23
24	USE netcdf
25
26	IMPLICIT NONE
27
28	! This variable should be in the range [1,9]. It has been suggested
29	! that 2 offers reasonable compression in a reasonable time.
30	! Higher values will offer more compression, but will take more time
31	INTEGER, PARAMETER :: DEFAULT_DEFLATE_LEVEL = 2
32	PRIVATE DEFAULT_DEFLATE_LEVEL
33
34	! These are valid variable names for the user of this module to reference
35	!!! DJM - 2016-06-13 -- added specific value in DIMENSION statement.
36	!!! can't be "*" in some Fortran versions
37	CHARACTER, DIMENSION(10), PARAMETER :: VALID_VARS = &
38	& (/ 't', 'u', 'v', 'w', 'q', &
39	& 'T', 'U', 'V', 'W', 'Q' /)
40	PRIVATE VALID_VARS
41
42	! Private routines in this module
43	PRIVATE private_dump_3dfield
44	PRIVATE private_read_3dfield
45	PRIVATE to_upper
46
47
48	CONTAINS
49
50	SUBROUTINE fp2nc4io_print_valid_vars
51
52	! Prints the list of met variables that are considered valid in this
53	! module
54
55	IMPLICIT NONE
56	INTEGER :: i
57
58	DO i=1,SIZE(VALID_VARS)
59	PRINT *, VALID_VARS(i)
60	ENDDO
61
62	END SUBROUTINE fp2nc4io_print_valid_vars
63
64
65
66	LOGICAL FUNCTION fp2nc4io_vars_are_valid(num_vars, dump_vars)
67
68	! Returns True or False depending on whether all of the variables
69	! in dump_vars are valid names (according to VALID_VARS)
70
71	IMPLICIT NONE
72
73	INTEGER, INTENT(IN) :: num_vars
74	CHARACTER, DIMENSION(num_vars), INTENT(IN) :: dump_vars ! var list
75
76	LOGICAL :: all_good = .TRUE.
77	INTEGER :: i
78
79	DO i=1,num_vars
80	IF( .NOT. ANY(VALID_VARS == dump_vars(i)) ) THEN
81	all_good = .FALSE.
82	ENDIF
83	ENDDO
84
85	fp2nc4io_vars_are_valid = all_good
86
87	END FUNCTION fp2nc4io_vars_are_valid
88
89
90
91	SUBROUTINE fp2nc4io_dump(nc4_filepath, num_vars, dump_vars, deflate_level)
92
93	! Writes metadata plus variables in dump_vars to NetCDF4 file
94	! All of the dumped variables come from FLEXPART modules
95	! par_mod and com_mod
96
97	IMPLICIT NONE
98
99	CHARACTER(LEN=*), INTENT(IN) :: nc4_filepath ! Full path to dump file
100	INTEGER, INTENT(IN) :: num_vars ! Num variables in dump_vars
101	CHARACTER, DIMENSION(num_vars), INTENT(IN) :: dump_vars ! var list
102	INTEGER, OPTIONAL, INTENT(IN) :: deflate_level ! (should be 0-9)
103
104
105	INTEGER :: i, j, k
106	INTEGER :: ncfunc_retval ! NetCDF function call return values
107	INTEGER :: ncid ! NetCDF file id
108
109
110	! Variables used by NetCDF routines
111	INTEGER :: x_dimid, y_dimid, z_dimid, dimids(3)
112	INTEGER :: varid
113	INTEGER :: deflevel ! Deflate level
114
115	#ifdef TESTING
116	INTEGER :: nx_test, ny_test, nz_test
117	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: testvar_array
118	CHARACTER(LEN=NF90_MAX_NAME) :: x_dimname, y_dimname, z_dimname
119	REAL :: orig_array_sum, test_array_sum
120	#endif
121
122	#ifdef TESTING
123	PRINT *,
124	PRINT , ' Running in testing mode *'
125	PRINT *,
126	#endif
127
128	! Use default deflate level if it wasn't passed in, or if a bad
129	! value was passed in.
130	IF (PRESENT(deflate_level)) THEN
131	IF (deflate_level < 0 .OR. deflate_level > 9) THEN
132	deflevel = DEFAULT_DEFLATE_LEVEL
133	ELSE
134	deflevel = deflate_level
135	ENDIF
136	ELSE
137	deflevel = DEFAULT_DEFLATE_LEVEL
138	ENDIF
139
140	PRINT *, 'Using deflate level: ', deflevel
141
142	!!!!!!---------------------------------------------------
143	!!!!!! Now we are ready to dump to NetCDF4 file
144	!!!!!!---------------------------------------------------
145
146	ncfunc_retval = nf90_create(nc4_filepath, &
147	& OR(NF90_CLOBBER, NF90_HDF5), ncid)
148	PRINT *, 'Created file: ', TRIM(nc4_filepath)
149
150	! Define the dimensions, and get dimension ids passed back
151	! The values nx, ny and nz come from FP par_mod
152	ncfunc_retval = nf90_def_dim(ncid, 'x', nx, x_dimid)
153	ncfunc_retval = nf90_def_dim(ncid, 'y', ny, y_dimid)
154	ncfunc_retval = nf90_def_dim(ncid, 'z', nz, z_dimid)
155	dimids = (/ x_dimid, y_dimid, z_dimid /)
156
157	! Write each of the 3d variables to the NetCDF file
158	DO i=1,num_vars
159	CALL private_dump_3dfield(ncid, dump_vars(i), dimids, deflevel)
160	PRINT *, 'Dumped 3d field: ', dump_vars(i)
161	ENDDO
162
163	! Write the height field - variable 'height' is defined in com_mod
164	ncfunc_retval = nf90_def_var(ncid, 'height', NF90_FLOAT, &
165	& z_dimid, varid)
166	! attributes
167	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
168	& "height of the FLEXPART model levels")
169	ncfunc_retval = nf90_put_att(ncid, varid, "units","m a.g.l")
170
171	ncfunc_retval = nf90_def_var_deflate(ncid, varid, &
172	& shuffle=0, &
173	& deflate=1, &
174	& deflate_level=deflevel)
175
176	ncfunc_retval = nf90_put_var(ncid, varid, height(1:nz))
177
178	! Write some of the scalar metadata variables
179	! dx, dy, xlon0, xlat0 are all defined in com_mod
180	ncfunc_retval = nf90_def_var(ncid, 'dx', NF90_FLOAT, varid)
181	ncfunc_retval = nf90_put_var(ncid, varid, dx)
182	! attributes
183	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
184	& "grid distance in x direction")
185	ncfunc_retval = nf90_put_att(ncid, varid, "units","degrees")
186
187
188	ncfunc_retval = nf90_def_var(ncid, 'dy', NF90_FLOAT, varid)
189	ncfunc_retval = nf90_put_var(ncid, varid, dy)
190	! attributes
191	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
192	& "grid distance in y direction")
193	ncfunc_retval = nf90_put_att(ncid, varid, "units","degrees")
194
195
196	ncfunc_retval = nf90_def_var(ncid, 'xlon0', NF90_FLOAT, varid)
197	ncfunc_retval = nf90_put_var(ncid, varid, xlon0)
198	! attributes
199	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
200	& "longitude of the lowest left corner")
201	ncfunc_retval = nf90_put_att(ncid, varid, "units","degrees")
202
203
204	ncfunc_retval = nf90_def_var(ncid, 'ylat0', NF90_FLOAT, varid)
205	ncfunc_retval = nf90_put_var(ncid, varid, ylat0)
206	! attributes
207	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
208	& "latitude of the lowest left corner")
209	ncfunc_retval = nf90_put_att(ncid, varid, "units","degrees")
210
211
212	! All done, close the NetCDF file
213	ncfunc_retval = nf90_close(ncid)
214
215	#ifdef TESTING
216	!!!!!!!!!!!!!! Reading !!!!!!!!!!!!!!!!!!!!
217	print *, "Opening nc file for reading"
218	ncfunc_retval = nf90_open(nc4_filepath, NF90_NOWRITE, ncid)
219
220	! Get dimensions
221	ncfunc_retval = nf90_inq_dimid(ncid, 'x', x_dimid)
222	ncfunc_retval = nf90_inquire_dimension(ncid, x_dimid, x_dimname, &
223	& nx_test)
224	PRINT *, 'nx_test: ', nx_test
225
226	ncfunc_retval = nf90_inq_dimid(ncid, 'y', y_dimid)
227	ncfunc_retval = nf90_inquire_dimension(ncid, y_dimid, y_dimname, &
228	& ny_test)
229	PRINT *, 'ny_test: ', ny_test
230
231	ncfunc_retval = nf90_inq_dimid(ncid, 'z', z_dimid)
232	ncfunc_retval = nf90_inquire_dimension(ncid, z_dimid, z_dimname, &
233	& nz_test)
234	PRINT *, 'nz_test: ', nz_test
235
236	ALLOCATE( testvar_array(0:nx_test-1, 0:ny_test-1, nz_test) )
237
238	! Read each variable and compare with original data
239	DO i=1,num_vars
240	CALL private_read_3dfield(ncid, dump_vars(i), &
241	& nx_test, ny_test, nz_test, &
242	& testvar_array)
243
244
245	IF (to_upper(dump_vars(i)) == 'U') THEN
246	orig_array_sum = SUM( uu(0:nx_test-1, 0:ny_test-1, &
247	& 1:nz_test, 1) )
248	ELSEIF (to_upper(dump_vars(i)) == 'V') THEN
249	orig_array_sum = SUM( vv(0:nx_test-1, 0:ny_test-1, &
250	& 1:nz_test, 1) )
251	ELSEIF (to_upper(dump_vars(i)) == 'T') THEN
252	orig_array_sum = SUM( tt(0:nx_test-1, 0:ny_test-1, &
253	& 1:nz_test, 1) )
254	ELSEIF (to_upper(dump_vars(i)) == 'W') THEN
255	orig_array_sum = SUM( ww(0:nx_test-1, 0:ny_test-1, &
256	& 1:nz_test, 1) )
257	ELSEIF (to_upper(dump_vars(i)) == 'Q') THEN
258	orig_array_sum = SUM( qv(0:nx_test-1, 0:ny_test-1, &
259	& 1:nz_test, 1) )
260	ENDIF
261
262	test_array_sum = SUM( testvar_array(0:nx_test-1, 0:ny_test-1, &
263	& 1:nz_test) )
264
265	PRINT *, dump_vars(i), ': ', 'SUM of differences = ', &
266	& test_array_sum - orig_array_sum
267	IF ( ABS(test_array_sum - orig_array_sum) .GT. 1.0E-3 ) THEN
268	PRINT *, &
269	& 'WARNING WILL ROBINSON!: Sum of differences exceeds 1.0E-3'
270	ENDIF
271	ENDDO
272
273	ncfunc_retval = nf90_close(ncid)
274	PRINT *, 'Closed file: ', ncfunc_retval
275
276	#endif
277
278	END SUBROUTINE fp2nc4io_dump
279
280
281	SUBROUTINE private_dump_3dfield(ncid, varname, dimids, deflevel)
282
283	! Private routine meant to provide low level access for writing
284	! specified varname to NetCDF4 file. It is assumed that the
285	! NC4 file has already been opened, and that dimension id's have
286	! already been obtained
287
288	IMPLICIT NONE
289
290	INTEGER, INTENT(IN) :: ncid ! NC4 file id
291	CHARACTER, INTENT(IN) :: varname
292	INTEGER, INTENT(IN) :: dimids(3) ! NC4 dimension ids
293	INTEGER, INTENT(IN) :: deflevel ! compression level
294
295	! NetCDF4 variables
296	CHARACTER :: nc_varname
297	INTEGER :: ncfunc_retval, varid
298
299	! Check that we have a valid varname. If not, buh-bye
300	IF( .NOT. ANY(VALID_VARS == varname) ) THEN
301	PRINT *,
302	PRINT *, 'fp2nc4io:private_dump_3d_field() bad var: ', varname
303	PRINT *, ' ABORTING...'
304	PRINT *,
305	STOP
306	ENDIF
307
308	! Convert varname to upper case for use in NetCDF file
309	nc_varname = to_upper(varname)
310
311	! Create the variable in the NetCDF file
312	ncfunc_retval = nf90_def_var(ncid, nc_varname, NF90_FLOAT, &
313	& dimids, varid)
314
315	ncfunc_retval = nf90_def_var_deflate(ncid, varid, &
316	& shuffle=0, &
317	& deflate=1, &
318	& deflate_level=deflevel)
319
320	! Write the data arrays
321	! The values nx, ny and nz come from module com_mod
322	! Likewise, the arrays uu, vv, tt, ww, qv are also from the
323	! same module, and we assume they all have the same dimensions
324	! (currently they do)
325	PRINT *, 'Writing: ', nc_varname
326	IF (nc_varname == 'U') THEN
327	ncfunc_retval = nf90_put_var(ncid, varid, &
328	& uu(0:nx-1, 0:ny-1, 1:nz, 1))
329	! attributes
330	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
331	& "U component of wind in the X[horizontal] direction")
332	ncfunc_retval = nf90_put_att(ncid, varid, "units","m s**-1")
333
334
335	ELSEIF (nc_varname == 'V') THEN
336	ncfunc_retval = nf90_put_var(ncid, varid, &
337	& vv(0:nx-1, 0:ny-1, 1:nz, 1))
338	! attributes
339	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
340	& "V component of wind in the Y[horizontal] direction")
341	ncfunc_retval = nf90_put_att(ncid, varid, "units","m s**-1")
342
343
344	ELSEIF (nc_varname == 'T') THEN
345	ncfunc_retval = nf90_put_var(ncid, varid, &
346	& tt(0:nx-1, 0:ny-1, 1:nz, 1))
347	! attributes
348	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
349	& "temperature")
350	ncfunc_retval = nf90_put_att(ncid, varid, "units","k")
351
352	ELSEIF (nc_varname == 'W') THEN
353	ncfunc_retval = nf90_put_var(ncid, varid, &
354	& ww(0:nx-1, 0:ny-1, 1:nz, 1))
355	! attributes
356	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
357	& "wind component in the Z[vertical] direction")
358	ncfunc_retval = nf90_put_att(ncid, varid, "units","m s**-1")
359
360
361	ELSEIF (nc_varname == 'Q') THEN
362	ncfunc_retval = nf90_put_var(ncid, varid, &
363	& qv(0:nx-1, 0:ny-1, 1:nz, 1))
364	! attributes
365	ncfunc_retval = nf90_put_att(ncid, varid, "description",&
366	& "specific humidity")
367	ncfunc_retval = nf90_put_att(ncid, varid, "units"," ")
368
369
370	ELSE
371	PRINT *,
372	PRINT *, 'fp2nc4io:private_dump_3d_field() bad var: ', nc_varname
373	PRINT *, ' ABORTING...'
374	PRINT *,
375	ENDIF
376
377	IF (ncfunc_retval /= 0) THEN
378	PRINT *,
379	PRINT , ' WARNING *'
380	PRINT *, ' fp2nc4io:private_dump_3d_field()'
381	PRINT *, ' nf90_put_var returned error for var: ', nc_varname
382	PRINT *,
383
384	ENDIF
385
386
387	END SUBROUTINE private_dump_3dfield
388
389
390
391	SUBROUTINE private_read_3dfield(ncid, varname, xdim, ydim, zdim, var_array)
392
393	! Private routine for reading full 3D array, specified by varname,
394	! from NC4 file. Reads into preallocated array of size
395	! xdim x ydim x zdim
396	IMPLICIT NONE
397
398	INTEGER, INTENT(IN) :: ncid ! NC4 file id
399	CHARACTER, INTENT(IN) :: varname
400	INTEGER, INTENT(IN) :: xdim, ydim, zdim ! NC4 dimension ids
401	REAL, DIMENSION(xdim, ydim, zdim) :: var_array
402
403	CHARACTER :: nc_varname
404	INTEGER :: ncfunc_retval, varid
405
406	! Check that we have a valid varname. If not, buh-bye
407	IF( .NOT. ANY(VALID_VARS == varname) ) THEN
408	PRINT *,
409	PRINT *, 'fp2nc4io:private_dump_3d_field() bad var: ', varname
410	PRINT *, ' ABORTING...'
411	PRINT *,
412	STOP
413	ENDIF
414
415	! Convert varname to upper case for use in NetCDF file
416	nc_varname = to_upper(varname)
417
418	! Get the varid
419	ncfunc_retval = nf90_inq_varid(ncid, nc_varname, varid)
420
421	! Read the variable into var_array
422	ncfunc_retval = nf90_get_var(ncid, varid, var_array)
423
424	END SUBROUTINE private_read_3dfield
425
426
427	CHARACTER FUNCTION to_upper(c)
428
429	! Utility function to convert lower case char to upper case
430
431	IMPLICIT NONE
432
433	CHARACTER, INTENT(IN) :: c
434
435	INTEGER :: c_ascii_code
436
437	c_ascii_code = IACHAR(c)
438	IF (c_ascii_code >= IACHAR("a") .AND. c_ascii_code <= IACHAR("z")) THEN
439	to_upper = ACHAR(c_ascii_code - 32)
440	ELSE
441	to_upper = c
442	ENDIF
443
444	END FUNCTION to_upper
445
446
447
448	END MODULE fp2nc4io_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format