Context Navigation

fp2nc4io_mod.F90 @ 87d9684

FPv9.3.1FPv9.3.1b_testingFPv9.3.2fp9.3.1-20161214-nc4grib2nc4_repair

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

Minor changes in grib2nc4 for FPv9.3.1.

See Ticket #150

Property mode set to 100644

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

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

Download in other formats:

Original Format