Home

Context Navigation

source: palm/trunk/UTIL/inifor/src/inifor_io.f90 @ 3615

Last change on this file since 3615 was 3615, checked in by raasch, 5 years ago
bugfix for last commit: abort replaced by inifor_abort
Property svn:keywords set to `Id`
File size: 46.6 KB

Line
1	!> @file src/inifor_io.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 2017-2018 Leibniz Universitaet Hannover
18	! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
19	!------------------------------------------------------------------------------!
20	!
21	! Current revisions:
22	! -----------------
23	!
24	!
25	! Former revisions:
26	! -----------------
27	! $Id: inifor_io.f90 3615 2018-12-10 07:21:03Z raasch $
28	! bugfix: abort replaced by inifor_abort
29	!
30	! 3557 2018-11-22 16:01:22Z eckhard
31	! Updated documentation, removed unused subroutine write_netcdf_variable_2d()
32	!
33	!
34	! 3537 2018-11-20 10:53:14Z eckhard
35	! New routine get_netcdf_dim_vector()
36	!
37	!
38	! 3534 2018-11-19 15:35:16Z raasch
39	! bugfix: INTENT attribute changed
40	!
41	! 3456 2018-10-30 14:29:54Z eckhard
42	! NetCDf output of internal arrays only with --debug option
43	!
44	!
45	! 3447 2018-10-29 15:52:54Z eckhard
46	! Removed INCLUDE statement for get_netcdf_variable()
47	! Renamed source files for compatibilty with PALM build system
48	!
49	!
50	! 3395 2018-10-22 17:32:49Z eckhard
51	! Added command-line options for configuring the computation of geostrophic
52	! winds (--averagin-mode, --averaging-angle)
53	! Added command-line option --input-prefix for setting input file prefixes all
54	! at once
55	! Added --debug option for more verbose terminal output
56	! Added option-specific *_is_set LOGICALs to indicate invocation from the
57	! command-line
58	! Improved error messages in case of empty file-name strings
59	! Improved routine naming
60	!
61	! 3183 2018-07-27 14:25:55Z suehring
62	! Introduced new PALM grid stretching
63	! Updated variable names and metadata for PIDS v1.9 compatibility
64	! Improved handling of the start date string
65	! Better compatibility with older Intel compilers:
66	! - avoiding implicit array allocation with new get_netcdf_variable()
67	! subroutine instead of function
68	! Improved command line interface:
69	! - Added configuration validation
70	! - New options to configure input file prefixes
71	! - GNU-style short and long option names
72	! - Added version and copyright output
73	!
74	!
75	! 3182 2018-07-27 13:36:03Z suehring
76	! Initial revision
77	!
78	!
79	!
80	! Authors:
81	! --------
82	!> @author Eckhard Kadasch (Deutscher Wetterdienst, Offenbach)
83	!
84	! Description:
85	! ------------
86	!> The io module contains the functions needed to read and write netCDF data in
87	!> INIFOR.
88	!------------------------------------------------------------------------------!
89	MODULE io
90
91	USE control
92	USE defs, &
93	ONLY: DATE, SNAME, PATH, PI, dp, hp, TO_RADIANS, TO_DEGREES, VERSION
94	USE netcdf
95	USE types
96	USE util, &
97	ONLY: reverse, str, real_to_str
98
99	IMPLICIT NONE
100
101	!------------------------------------------------------------------------------!
102	! Description:
103	! ------------
104	!> get_netcdf_variable() reads the netCDF data and metadate for the netCDF
105	!> variable 'in_var % name' from the file 'in_file'. The netCDF data array is
106	!> stored in the 'buffer' array and metadata added to the respective members of
107	!> the given 'in_var'.
108	!------------------------------------------------------------------------------!
109	INTERFACE get_netcdf_variable
110	MODULE PROCEDURE get_netcdf_variable_int
111	MODULE PROCEDURE get_netcdf_variable_real
112	END INTERFACE get_netcdf_variable
113
114	PRIVATE :: get_netcdf_variable_int, get_netcdf_variable_real
115
116	CONTAINS
117
118	!------------------------------------------------------------------------------!
119	! Description:
120	! ------------
121	!> get_netcdf_variable_int() implements the integer variant for the
122	!> get_netcdf_variable interface.
123	!------------------------------------------------------------------------------!
124	SUBROUTINE get_netcdf_variable_int(in_file, in_var, buffer)
125
126	CHARACTER(LEN=PATH), INTENT(IN) :: in_file
127	TYPE(nc_var), INTENT(INOUT) :: in_var
128	INTEGER(hp), ALLOCATABLE, INTENT(INOUT) :: buffer(:,:,:)
129
130	INTEGER :: ncid
131	INTEGER, DIMENSION(3) :: start, count
132
133	IF ( nf90_open( TRIM(in_file), NF90_NOWRITE, ncid ) .EQ. NF90_NOERR .AND. &
134	nf90_inq_varid( ncid, in_var % name, in_var % varid ) .EQ. NF90_NOERR ) THEN
135
136	CALL get_input_dimensions(in_var, ncid)
137
138	CALL get_netcdf_start_and_count(in_var, start, count)
139	CALL run_control('time', 'read')
140
141	ALLOCATE( buffer( count(1), count(2), count(3) ) )
142	CALL run_control('time', 'alloc')
143
144	CALL check(nf90_get_var( ncid, in_var % varid, buffer, &
145	start = start, &
146	count = count ))
147
148	ELSE
149
150	message = "Failed to read '" // TRIM(in_var % name) // &
151	"' from file '" // TRIM(in_file) // "'."
152	CALL inifor_abort('get_netcdf_variable', message)
153
154	END IF
155
156	CALL check(nf90_close(ncid))
157	CALL run_control('time', 'read')
158
159	END SUBROUTINE get_netcdf_variable_int
160
161
162	!------------------------------------------------------------------------------!
163	! Description:
164	! ------------
165	!> get_netcdf_variable_real() implements the real variant for the
166	!> get_netcdf_variable interface.
167	!------------------------------------------------------------------------------!
168	SUBROUTINE get_netcdf_variable_real(in_file, in_var, buffer)
169
170	CHARACTER(LEN=PATH), INTENT(IN) :: in_file
171	TYPE(nc_var), INTENT(INOUT) :: in_var
172	REAL(dp), ALLOCATABLE, INTENT(INOUT) :: buffer(:,:,:)
173
174	INTEGER :: ncid
175	INTEGER, DIMENSION(3) :: start, count
176
177	IF ( nf90_open( TRIM(in_file), NF90_NOWRITE, ncid ) .EQ. NF90_NOERR .AND. &
178	nf90_inq_varid( ncid, in_var % name, in_var % varid ) .EQ. NF90_NOERR ) THEN
179
180	CALL get_input_dimensions(in_var, ncid)
181
182	CALL get_netcdf_start_and_count(in_var, start, count)
183	CALL run_control('time', 'read')
184
185	ALLOCATE( buffer( count(1), count(2), count(3) ) )
186	CALL run_control('time', 'alloc')
187
188	CALL check(nf90_get_var( ncid, in_var % varid, buffer, &
189	start = start, &
190	count = count ))
191
192	ELSE
193
194	message = "Failed to read '" // TRIM(in_var % name) // &
195	"' from file '" // TRIM(in_file) // "'."
196	CALL inifor_abort('get_netcdf_variable', message)
197
198	END IF
199
200	CALL check(nf90_close(ncid))
201	CALL run_control('time', 'read')
202
203	END SUBROUTINE get_netcdf_variable_real
204
205
206	!------------------------------------------------------------------------------!
207	! Description:
208	! ------------
209	!> get_netcdf_dim_vector() reads the coordinate array 'coordname' from the
210	!> netCDF file 'filename'.
211	!------------------------------------------------------------------------------!
212	SUBROUTINE get_netcdf_dim_vector(filename, coordname, coords)
213
214	CHARACTER(LEN=*), INTENT(IN) :: filename
215	CHARACTER(LEN=*), INTENT(IN) :: coordname
216	REAL(dp), ALLOCATABLE, INTENT(INOUT) :: coords(:)
217
218	INTEGER :: ncid, varid, dimlen
219	INTEGER :: dimids(NF90_MAX_VAR_DIMS)
220
221	IF ( nf90_open( TRIM(filename), NF90_NOWRITE, ncid ) .EQ. NF90_NOERR .AND. &
222	nf90_inq_varid( ncid, coordname, varid ) .EQ. NF90_NOERR ) THEN
223
224	CALL check(nf90_inquire_variable( ncid, varid, dimids = dimids ))
225	CALL check(nf90_inquire_dimension( ncid, dimids(1), len = dimlen ))
226
227	ALLOCATE(coords(dimlen))
228	CALL check(nf90_get_var( ncid, varid, coords))
229
230	ELSE
231
232	message = "Failed to read '" // TRIM(coordname) // &
233	"' from file '" // TRIM(filename) // "'."
234	CALL inifor_abort('get_netcdf_dim_vector', message)
235
236	END IF
237
238	END SUBROUTINE get_netcdf_dim_vector
239
240
241	!------------------------------------------------------------------------------!
242	! Description:
243	! ------------
244	!> get_input_dimensions() reads dimensions metadata of the netCDF variable given
245	!> by 'in_var % name' into 'in_var' data structure.
246	!------------------------------------------------------------------------------!
247	SUBROUTINE get_input_dimensions(in_var, ncid)
248
249	TYPE(nc_var), INTENT(INOUT) :: in_var
250	INTEGER, INTENT(IN) :: ncid
251
252	INTEGER :: i
253
254	CALL check(nf90_get_att( ncid, in_var % varid, "long_name", &
255	in_var % long_name))
256
257	CALL check(nf90_get_att( ncid, in_var % varid, "units", &
258	in_var % units ))
259
260	CALL check(nf90_inquire_variable( ncid, in_var % varid, &
261	ndims = in_var % ndim, &
262	dimids = in_var % dimids ))
263
264	DO i = 1, in_var % ndim
265	CALL check(nf90_inquire_dimension( ncid, in_var % dimids(i), &
266	name = in_var % dimname(i), &
267	len = in_var % dimlen(i) ))
268	END DO
269
270	END SUBROUTINE get_input_dimensions
271
272
273	!------------------------------------------------------------------------------!
274	! Description:
275	! ------------
276	!> get_netcdf_start_and_count() gets the start position and element counts for
277	!> the given netCDF file. This information is used in get_netcdf_variable_int()
278	!> and _real() for reading input variables..
279	!------------------------------------------------------------------------------!
280	SUBROUTINE get_netcdf_start_and_count(in_var, start, count)
281
282	TYPE(nc_var), INTENT(INOUT) :: in_var
283	INTEGER, DIMENSION(3), INTENT(OUT) :: start, count
284
285	INTEGER :: ndim
286
287	IF ( in_var % ndim .LT. 2 .OR. in_var % ndim .GT. 4 ) THEN
288
289	message = "Failed reading NetCDF variable " // &
290	TRIM(in_var % name) // " with " // TRIM(str(in_var % ndim)) // &
291	" dimensions because only two- and and three-dimensional" // &
292	" variables are supported."
293	CALL inifor_abort('get_netcdf_start_and_count', message)
294
295	END IF
296
297	start = (/ 1, 1, 1 /)
298	IF ( TRIM(in_var % name) .EQ. 'T_SO' ) THEN
299	!
300	!-- Skip depth = 0.0 for T_SO and reduce number of depths from 9 to 8
301	in_var % dimlen(3) = in_var % dimlen(3) - 1
302
303	!
304	!-- Start reading from second level, e.g. depth = 0.005 instead of 0.0
305	start(3) = 2
306	END IF
307
308	IF (in_var % ndim .EQ. 2) THEN
309	in_var % dimlen(3) = 1
310	ENDIF
311
312	ndim = MIN(in_var % ndim, 3)
313	count = (/ 1, 1, 1 /)
314	count(1:ndim) = in_var % dimlen(1:ndim)
315
316	END SUBROUTINE get_netcdf_start_and_count
317
318
319	!------------------------------------------------------------------------------!
320	! Description:
321	! ------------
322	!> Routine for defining netCDF variables in the dynamic driver, INIFOR's netCDF
323	!> output.
324	!------------------------------------------------------------------------------!
325	SUBROUTINE netcdf_define_variable(var, ncid)
326
327	TYPE(nc_var), INTENT(INOUT) :: var
328	INTEGER, INTENT(IN) :: ncid
329
330	CALL check(nf90_def_var(ncid, var % name, NF90_FLOAT, var % dimids(1:var % ndim), var % varid))
331	CALL check(nf90_put_att(ncid, var % varid, "long_name", var % long_name))
332	CALL check(nf90_put_att(ncid, var % varid, "units", var % units))
333	IF ( var % lod .GE. 0 ) THEN
334	CALL check(nf90_put_att(ncid, var % varid, "lod", var % lod))
335	END IF
336	CALL check(nf90_put_att(ncid, var % varid, "source", var % source))
337	CALL check(nf90_put_att(ncid, var % varid, "_FillValue", NF90_FILL_REAL))
338
339	END SUBROUTINE netcdf_define_variable
340
341
342	!------------------------------------------------------------------------------!
343	! Description:
344	! ------------
345	!> netcdf_get_dimensions() reads in all dimensions and their lengths and stores
346	!> them in the given the 'var' data structure. This information is used later
347	!> for writing output variables in update_output().
348	!------------------------------------------------------------------------------!
349	SUBROUTINE netcdf_get_dimensions(var, ncid)
350
351	TYPE(nc_var), INTENT(INOUT) :: var
352	INTEGER, INTENT(IN) :: ncid
353	INTEGER :: i
354	CHARACTER(SNAME) :: null
355
356	DO i = 1, var % ndim
357	CALL check(nf90_inquire_dimension(ncid, var % dimids(i), &
358	name = null, &
359	len = var % dimlen(i) ) )
360	END DO
361
362	END SUBROUTINE netcdf_get_dimensions
363
364
365	!------------------------------------------------------------------------------!
366	! Description:
367	! ------------
368	!> This routine parses and interpretes the command-line options and stores the
369	!> resulting settings in the 'cfg' data structure.
370	!------------------------------------------------------------------------------!
371	SUBROUTINE parse_command_line_arguments( cfg )
372
373	TYPE(inifor_config), INTENT(INOUT) :: cfg
374
375	CHARACTER(LEN=PATH) :: option, arg
376	INTEGER :: arg_count, i
377
378	cfg % p0_is_set = .FALSE.
379	cfg % ug_is_set = .FALSE.
380	cfg % vg_is_set = .FALSE.
381	cfg % flow_prefix_is_set = .FALSE.
382	cfg % input_prefix_is_set = .FALSE.
383	cfg % radiation_prefix_is_set = .FALSE.
384	cfg % soil_prefix_is_set = .FALSE.
385	cfg % soilmoisture_prefix_is_set = .FALSE.
386
387	arg_count = COMMAND_ARGUMENT_COUNT()
388	IF (arg_count .GT. 0) THEN
389
390	message = "The -clon and -clat command line options are depricated. " // &
391	"Please remove them form your inifor command and specify the " // &
392	"location of the PALM-4U origin either" // NEW_LINE(' ') // &
393	" - by setting the namelist parameters 'longitude' and 'latitude', or" // NEW_LINE(' ') // &
394	" - by providing a static driver netCDF file via the -static command-line option."
395
396	i = 1
397	DO WHILE (i .LE. arg_count)
398
399	CALL GET_COMMAND_ARGUMENT( i, option )
400
401	SELECT CASE( TRIM(option) )
402
403	CASE( '--averaging-mode' )
404	CALL get_option_argument( i, arg )
405	cfg % averaging_mode = TRIM(arg)
406
407	CASE( '-date', '-d', '--date' )
408	CALL get_option_argument( i, arg )
409	cfg % start_date = TRIM(arg)
410
411	CASE( '--debug' )
412	cfg % debug = .TRUE.
413
414	CASE( '-z0', '-z', '--elevation' )
415	CALL get_option_argument( i, arg )
416	READ(arg, *) cfg % z0
417
418	CASE( '-p0', '-r', '--surface-pressure' )
419	cfg % p0_is_set = .TRUE.
420	CALL get_option_argument( i, arg )
421	READ(arg, *) cfg % p0
422
423	CASE( '-ug', '-u', '--geostrophic-u' )
424	cfg % ug_is_set = .TRUE.
425	CALL get_option_argument( i, arg )
426	READ(arg, *) cfg % ug
427
428	CASE( '-vg', '-v', '--geostrophic-v' )
429	cfg % vg_is_set = .TRUE.
430	CALL get_option_argument( i, arg )
431	READ(arg, *) cfg % vg
432
433	CASE( '-clon', '-clat' )
434	CALL inifor_abort('parse_command_line_arguments', message)
435
436	CASE( '-path', '-p', '--path' )
437	CALL get_option_argument( i, arg )
438	cfg % input_path = TRIM(arg)
439
440	CASE( '-hhl', '-l', '--hhl-file' )
441	CALL get_option_argument( i, arg )
442	cfg % hhl_file = TRIM(arg)
443
444	CASE( '--input-prefix')
445	CALL get_option_argument( i, arg )
446	cfg % input_prefix = TRIM(arg)
447	cfg % input_prefix_is_set = .TRUE.
448
449	CASE( '-a', '--averaging-angle' )
450	CALL get_option_argument( i, arg )
451	READ(arg, *) cfg % averaging_angle
452
453	CASE( '-static', '-t', '--static-driver' )
454	CALL get_option_argument( i, arg )
455	cfg % static_driver_file = TRIM(arg)
456
457	CASE( '-soil', '-s', '--soil-file')
458	CALL get_option_argument( i, arg )
459	cfg % soiltyp_file = TRIM(arg)
460
461	CASE( '--flow-prefix')
462	CALL get_option_argument( i, arg )
463	cfg % flow_prefix = TRIM(arg)
464	cfg % flow_prefix_is_set = .TRUE.
465
466	CASE( '--radiation-prefix')
467	CALL get_option_argument( i, arg )
468	cfg % radiation_prefix = TRIM(arg)
469	cfg % radiation_prefix_is_set = .TRUE.
470
471	CASE( '--soil-prefix')
472	CALL get_option_argument( i, arg )
473	cfg % soil_prefix = TRIM(arg)
474	cfg % soil_prefix_is_set = .TRUE.
475
476	CASE( '--soilmoisture-prefix')
477	CALL get_option_argument( i, arg )
478	cfg % soilmoisture_prefix = TRIM(arg)
479	cfg % soilmoisture_prefix_is_set = .TRUE.
480
481	CASE( '-o', '--output' )
482	CALL get_option_argument( i, arg )
483	cfg % output_file = TRIM(arg)
484
485	CASE( '-n', '--namelist' )
486	CALL get_option_argument( i, arg )
487	cfg % namelist_file = TRIM(arg)
488
489	CASE( '-mode', '-i', '--init-mode' )
490	CALL get_option_argument( i, arg )
491	cfg % ic_mode = TRIM(arg)
492
493	CASE( '-f', '--forcing-mode' )
494	CALL get_option_argument( i, arg )
495	cfg % bc_mode = TRIM(arg)
496
497	CASE( '--version' )
498	CALL print_version()
499	STOP
500
501	CASE( '--help' )
502	CALL print_version()
503	PRINT *, ""
504	PRINT *, "For a list of command-line options have a look at the README file."
505	STOP
506
507	CASE DEFAULT
508	message = "unknown option '" // TRIM(option) // "'."
509	CALL inifor_abort('parse_command_line_arguments', message)
510
511	END SELECT
512
513	i = i + 1
514
515	END DO
516
517	ELSE
518
519	message = "No arguments present, using default input and output files"
520	CALL report('parse_command_line_arguments', message)
521
522	END IF
523
524	END SUBROUTINE parse_command_line_arguments
525
526
527	!------------------------------------------------------------------------------!
528	! Description:
529	! ------------
530	!> Get the argument of the i'th command line option, which is at the location
531	!> i+1 of the argument list.
532	!------------------------------------------------------------------------------!
533	SUBROUTINE get_option_argument(i, arg)
534	CHARACTER(LEN=PATH), INTENT(INOUT) :: arg
535	INTEGER, INTENT(INOUT) :: i
536
537	i = i + 1
538	CALL GET_COMMAND_ARGUMENT(i, arg)
539
540	END SUBROUTINE
541
542
543	!------------------------------------------------------------------------------!
544	! Description:
545	! ------------
546	!> Checks the INIFOR configuration 'cfg' for plausibility.
547	!------------------------------------------------------------------------------!
548	SUBROUTINE validate_config(cfg)
549	TYPE(inifor_config), INTENT(IN) :: cfg
550	LOGICAL :: all_files_present
551
552	all_files_present = .TRUE.
553	all_files_present = all_files_present .AND. file_present(cfg % hhl_file, 'HHL')
554	all_files_present = all_files_present .AND. file_present(cfg % namelist_file, 'NAMELIST')
555	all_files_present = all_files_present .AND. file_present(cfg % soiltyp_file, 'SOILTYP')
556
557	!
558	!-- Only check optional static driver file name, if it has been given.
559	IF (TRIM(cfg % static_driver_file) .NE. '') THEN
560	all_files_present = all_files_present .AND. file_present(cfg % static_driver_file, 'static driver')
561	END IF
562
563	IF (.NOT. all_files_present) THEN
564	message = "INIFOR configuration invalid; some input files are missing."
565	CALL inifor_abort( 'validate_config', message )
566	END IF
567
568
569	SELECT CASE( TRIM(cfg % ic_mode) )
570	CASE( 'profile', 'volume')
571	CASE DEFAULT
572	message = "Initialization mode '" // TRIM(cfg % ic_mode) //&
573	"' is not supported. " //&
574	"Please select either 'profile' or 'volume', " //&
575	"or omit the -i/--init-mode/-mode option entirely, which corresponds "//&
576	"to the latter."
577	CALL inifor_abort( 'validate_config', message )
578	END SELECT
579
580
581	SELECT CASE( TRIM(cfg % bc_mode) )
582	CASE( 'real', 'ideal')
583	CASE DEFAULT
584	message = "Forcing mode '" // TRIM(cfg % bc_mode) //&
585	"' is not supported. " //&
586	"Please select either 'real' or 'ideal', " //&
587	"or omit the -f/--forcing-mode option entirely, which corresponds "//&
588	"to the latter."
589	CALL inifor_abort( 'validate_config', message )
590	END SELECT
591
592	SELECT CASE( TRIM(cfg % averaging_mode) )
593	CASE( 'level', 'height')
594	CASE DEFAULT
595	message = "Averaging mode '" // TRIM(cfg % averaging_mode) //&
596	"' is not supported. " //&
597	"Please select either 'height' or 'level', " //&
598	"or omit the --averaging-mode option entirely, which corresponds "//&
599	"to the latter."
600	CALL inifor_abort( 'validate_config', message )
601	END SELECT
602
603	IF ( cfg % ug_is_set .NEQV. cfg % vg_is_set ) THEN
604	message = "You specified only one component of the geostrophic " // &
605	"wind. Please specify either both or none."
606	CALL inifor_abort( 'validate_config', message )
607	END IF
608
609	END SUBROUTINE validate_config
610
611
612	!------------------------------------------------------------------------------!
613	! Description:
614	! ------------
615	!> Check whether the given file is present on the filesystem.
616	!------------------------------------------------------------------------------!
617	LOGICAL FUNCTION file_present(filename, kind)
618	CHARACTER(LEN=PATH), INTENT(IN) :: filename
619	CHARACTER(LEN=*), INTENT(IN) :: kind
620
621	IF (LEN(TRIM(filename))==0) THEN
622
623	file_present = .FALSE.
624	message = "No name was given for the " // TRIM(kind) // " file."
625	CALL report('file_present', message)
626
627	ELSE
628
629	INQUIRE(FILE=filename, EXIST=file_present)
630
631	IF (.NOT. file_present) THEN
632	message = "The given " // TRIM(kind) // " file '" // &
633	TRIM(filename) // "' does not exist."
634	CALL report('file_present', message)
635	END IF
636
637	END IF
638
639	END FUNCTION file_present
640
641
642	!------------------------------------------------------------------------------!
643	! Description:
644	! ------------
645	!> This routine initializes the dynamic driver file, i.e. INIFOR's netCDF output
646	!> file.
647	!>
648	!> Besides writing metadata, such as global attributes, coordinates, variables,
649	!> in the netCDF file, various netCDF IDs are saved for later, when INIFOR
650	!> writes the actual data.
651	!------------------------------------------------------------------------------!
652	SUBROUTINE setup_netcdf_dimensions(output_file, palm_grid, &
653	start_date_string, origin_lon, origin_lat)
654
655	TYPE(nc_file), INTENT(INOUT) :: output_file
656	TYPE(grid_definition), INTENT(IN) :: palm_grid
657	CHARACTER (LEN=DATE), INTENT(IN) :: start_date_string
658	REAL(dp), INTENT(IN) :: origin_lon, origin_lat
659
660	CHARACTER (LEN=8) :: date_string
661	CHARACTER (LEN=10) :: time_string
662	CHARACTER (LEN=5) :: zone_string
663	CHARACTER (LEN=SNAME) :: history_string
664	INTEGER :: ncid, nx, ny, nz, nt, dimids(3), dimvarids(3)
665	REAL(dp) :: z0
666
667	message = "Initializing PALM-4U dynamic driver file '" // &
668	TRIM(output_file % name) // "' and setting up dimensions."
669	CALL report('setup_netcdf_dimensions', message)
670
671	!
672	!-- Create the netCDF file as in netCDF-4/HDF5 format if __netcdf4 preprocessor flag is given
673	#if defined( __netcdf4 )
674	CALL check(nf90_create(TRIM(output_file % name), OR(NF90_CLOBBER, NF90_HDF5), ncid))
675	#else
676	CALL check(nf90_create(TRIM(output_file % name), NF90_CLOBBER, ncid))
677	#endif
678
679	!------------------------------------------------------------------------------
680	!- Section 1: Define NetCDF dimensions and coordinates
681	!------------------------------------------------------------------------------
682	nt = SIZE(output_file % time)
683	nx = palm_grid % nx
684	ny = palm_grid % ny
685	nz = palm_grid % nz
686	z0 = palm_grid % z0
687
688
689	!
690	!------------------------------------------------------------------------------
691	!- Section 2: Write global NetCDF attributes
692	!------------------------------------------------------------------------------
693	CALL date_and_time(DATE=date_string, TIME=time_string, ZONE=zone_string)
694	history_string = &
695	'Created on '// date_string // &
696	' at ' // time_string(1:2) // ':' // time_string(3:4) // &
697	' (UTC' // zone_string // ')'
698
699	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'title', 'PALM input file for scenario ...'))
700	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'institution', 'Deutscher Wetterdienst, Offenbach'))
701	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'author', 'Eckhard Kadasch, eckhard.kadasch@dwd.de'))
702	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'history', TRIM(history_string)))
703	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'references', '--'))
704	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'comment', '--'))
705	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_lat', TRIM(real_to_str(origin_lat*TO_DEGREES, '(F18.13)'))))
706	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_lon', TRIM(real_to_str(origin_lon*TO_DEGREES, '(F18.13)'))))
707	!
708	!-- FIXME: This is the elevation relative to COSMO-DE/D2 sea level and does
709	!-- FIXME: not necessarily comply with DHHN2016 (c.f. PALM Input Data
710	!-- FIXME: Standard v1.9., origin_z)
711	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_z', TRIM(real_to_str(z0, '(F18.13)'))))
712	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'inifor_version', TRIM(VERSION)))
713	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'palm_version', '--'))
714
715	!
716	!
717	!------------------------------------------------------------------------------
718	!- Section 2a: Define dimensions for cell centers (scalars in soil and atmosph.)
719	!------------------------------------------------------------------------------
720	!
721	!-- reset dimids first
722	dimids = (/0, 0, 0/)
723	CALL check( nf90_def_dim(ncid, "x", nx+1, dimids(1)) )
724	CALL check( nf90_def_dim(ncid, "y", ny+1, dimids(2)) )
725	CALL check( nf90_def_dim(ncid, "z", nz, dimids(3)) )
726	!
727	!-- save dimids for later
728	output_file % dimids_scl = dimids
729
730	!
731	!-- reset dimvarids first
732	dimvarids = (/0, 0, 0/)
733	CALL check(nf90_def_var(ncid, "x", NF90_FLOAT, dimids(1), dimvarids(1)))
734	CALL check(nf90_put_att(ncid, dimvarids(1), "standard_name", "x coordinate of cell centers"))
735	CALL check(nf90_put_att(ncid, dimvarids(1), "units", "m"))
736
737	CALL check(nf90_def_var(ncid, "y", NF90_FLOAT, dimids(2), dimvarids(2)))
738	CALL check(nf90_put_att(ncid, dimvarids(2), "standard_name", "y coordinate of cell centers"))
739	CALL check(nf90_put_att(ncid, dimvarids(2), "units", "m"))
740
741	CALL check(nf90_def_var(ncid, "z", NF90_FLOAT, dimids(3), dimvarids(3)))
742	CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "z coordinate of cell centers"))
743	CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
744	!
745	!-- save dimvarids for later
746	output_file % dimvarids_scl = dimvarids
747
748	!
749	!-- overwrite third dimid with the one of depth
750	CALL check(nf90_def_dim(ncid, "zsoil", SIZE(palm_grid % depths), dimids(3)) )
751	!
752	!-- save dimids for later
753	output_file % dimids_soil = dimids
754
755	!
756	!-- overwrite third dimvarid with the one of depth
757	CALL check(nf90_def_var(ncid, "zsoil", NF90_FLOAT, output_file % dimids_soil(3), dimvarids(3)))
758	CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "depth_below_land"))
759	CALL check(nf90_put_att(ncid, dimvarids(3), "positive", "down"))
760	CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
761	!
762	!-- save dimvarids for later
763	output_file % dimvarids_soil = dimvarids
764	!
765	!------------------------------------------------------------------------------
766	!- Section 2b: Define dimensions for cell faces/velocities
767	!------------------------------------------------------------------------------
768	!
769	!-- reset dimids first
770	dimids = (/0, 0, 0/)
771	CALL check(nf90_def_dim(ncid, "xu", nx, dimids(1)) )
772	CALL check(nf90_def_dim(ncid, "yv", ny, dimids(2)) )
773	CALL check(nf90_def_dim(ncid, "zw", nz-1, dimids(3)) )
774	!
775	!-- save dimids for later
776	output_file % dimids_vel = dimids
777
778	!
779	!-- reset dimvarids first
780	dimvarids = (/0, 0, 0/)
781	CALL check(nf90_def_var(ncid, "xu", NF90_FLOAT, dimids(1), dimvarids(1)))
782	CALL check(nf90_put_att(ncid, dimvarids(1), "standard_name", "x coordinate of cell faces"))
783	CALL check(nf90_put_att(ncid, dimvarids(1), "units", "m"))
784
785	CALL check(nf90_def_var(ncid, "yv", NF90_FLOAT, dimids(2), dimvarids(2)))
786	CALL check(nf90_put_att(ncid, dimvarids(2), "standard_name", "y coordinate of cell faces"))
787	CALL check(nf90_put_att(ncid, dimvarids(2), "units", "m"))
788
789	CALL check(nf90_def_var(ncid, "zw", NF90_FLOAT, dimids(3), dimvarids(3)))
790	CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "z coordinate of cell faces"))
791	CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
792	!
793	!-- save dimvarids for later
794	output_file % dimvarids_vel = dimvarids
795
796	!
797	!------------------------------------------------------------------------------
798	!- Section 2c: Define time dimension
799	!------------------------------------------------------------------------------
800	CALL check(nf90_def_dim(ncid, "time", nt, output_file % dimid_time) )
801	CALL check(nf90_def_var(ncid, "time", NF90_FLOAT, &
802	output_file % dimid_time, &
803	output_file % dimvarid_time))
804	CALL check(nf90_put_att(ncid, output_file % dimvarid_time, "standard_name", "time"))
805	CALL check(nf90_put_att(ncid, output_file % dimvarid_time, "long_name", "time"))
806	CALL check(nf90_put_att(ncid, output_file % dimvarid_time, "units", &
807	"seconds since " // start_date_string // " UTC"))
808
809	CALL check(nf90_enddef(ncid))
810
811	!
812	!------------------------------------------------------------------------------
813	!- Section 3: Write grid coordinates
814	!------------------------------------------------------------------------------
815	CALL check(nf90_put_var(ncid, output_file % dimvarids_scl(1), palm_grid%x))
816	CALL check(nf90_put_var(ncid, output_file % dimvarids_scl(2), palm_grid%y))
817	CALL check(nf90_put_var(ncid, output_file % dimvarids_scl(3), palm_grid%z))
818
819	CALL check(nf90_put_var(ncid, output_file % dimvarids_vel(1), palm_grid%xu))
820	CALL check(nf90_put_var(ncid, output_file % dimvarids_vel(2), palm_grid%yv))
821	CALL check(nf90_put_var(ncid, output_file % dimvarids_vel(3), palm_grid%zw))
822
823	!
824	!-- TODO Read in soil depths from input file before this.
825	CALL check(nf90_put_var(ncid, output_file % dimvarids_soil(3), palm_grid%depths))
826
827	!
828	!-- Write time vector
829	CALL check(nf90_put_var(ncid, output_file % dimvarid_time, output_file % time))
830
831	!
832	!-- Close the file
833	CALL check(nf90_close(ncid))
834
835	END SUBROUTINE setup_netcdf_dimensions
836
837
838	!------------------------------------------------------------------------------!
839	! Description:
840	! ------------
841	!> Defines the netCDF variables to be written to the dynamic driver file
842	!------------------------------------------------------------------------------!
843	SUBROUTINE setup_netcdf_variables(filename, output_variable_table, debug)
844
845	CHARACTER (LEN=*), INTENT(IN) :: filename
846	TYPE(nc_var), INTENT(INOUT), TARGET :: output_variable_table(:)
847	LOGICAL, INTENT(IN) :: debug
848
849	TYPE(nc_var), POINTER :: var
850	INTEGER :: i, ncid
851	LOGICAL :: to_be_written
852
853	message = "Defining variables in dynamic driver '" // TRIM(filename) // "'."
854	CALL report('setup_netcdf_variables', message)
855
856	CALL check(nf90_open(TRIM(filename), NF90_WRITE, ncid))
857	CALL check(nf90_redef(ncid))
858
859	DO i = 1, SIZE(output_variable_table)
860
861	var => output_variable_table(i)
862
863	to_be_written = ( var % to_be_processed .AND. .NOT. var % is_internal) .OR. &
864	( var % is_internal .AND. debug )
865
866	IF ( to_be_written ) THEN
867	message = " variable #" // TRIM(str(i)) // " '" // TRIM(var%name) // "'."
868	CALL report('setup_netcdf_variables', message)
869
870	CALL netcdf_define_variable(var, ncid)
871	CALL netcdf_get_dimensions(var, ncid)
872	END IF
873
874	END DO
875
876	CALL check(nf90_enddef(ncid))
877	CALL check(nf90_close(ncid))
878
879	message = "Dynamic driver '" // TRIM(filename) // "' initialized successfully."
880	CALL report('setup_netcdf_variables', message)
881
882	END SUBROUTINE setup_netcdf_variables
883
884
885	!------------------------------------------------------------------------------!
886	! Description:
887	! ------------
888	!> This routine reads and returns all input variables of the given IO group
889	!> It accomodates the data by allocating a container variable that represents a
890	!> list of arrays of the same length as the groups variable list. (This list
891	!> will typically contain one or two items.) After the container, its members
892	!> are allocated one by one with the appropriate, possibly different,
893	!> dimensions.
894	!>
895	!> The 'group' is an INTENT(INOUT) variable so that 'get_netcdf_variable()' can
896	!> record netCDF IDs in the 'in_var_list()' member variable.
897	!------------------------------------------------------------------------------!
898	SUBROUTINE read_input_variables(group, iter, buffer)
899	TYPE(io_group), INTENT(INOUT), TARGET :: group
900	INTEGER, INTENT(IN) :: iter
901	TYPE(container), ALLOCATABLE, INTENT(INOUT) :: buffer(:)
902	INTEGER :: hour, buf_id
903	TYPE(nc_var), POINTER :: input_var
904	CHARACTER(LEN=PATH), POINTER :: input_file
905	INTEGER :: ivar, nbuffers
906
907	message = "Reading data for I/O group '" // TRIM(group % in_var_list(1) % name) // "'."
908	CALL report('read_input_variables', message)
909
910	input_file => group % in_files(iter)
911
912	!
913	!------------------------------------------------------------------------------
914	!- Section 1: Load input buffers for accumulated variables
915	!------------------------------------------------------------------------------
916	!
917	!-- radiation budgets, precipitation
918	IF (group % kind == 'running average' .OR. &
919	group % kind == 'accumulated') THEN
920
921	IF (SIZE(group % in_var_list) .GT. 1 ) THEN
922	message = "I/O groups may not contain more than one " // &
923	"accumulated variable. Group '" // TRIM(group % kind) //&
924	"' contains " // &
925	TRIM( str(SIZE(group % in_var_list)) ) // "."
926	CALL inifor_abort('read_input_variables \| accumulation', message)
927	END IF
928
929	!
930	!-- use two buffer arrays
931	nbuffers = 2
932	IF ( .NOT. ALLOCATED( buffer ) ) ALLOCATE( buffer(nbuffers) )
933
934	!
935	!-- hour of the day
936	hour = iter - 1
937	!
938	!-- chose correct buffer array
939	buf_id = select_buffer(hour)
940
941	CALL run_control('time', 'read')
942	IF ( ALLOCATED(buffer(buf_id) % array) ) DEALLOCATE(buffer(buf_id) % array)
943	CALL run_control('time', 'alloc')
944
945	input_var => group % in_var_list(1)
946	CALL get_netcdf_variable(input_file, input_var, buffer(buf_id) % array)
947	CALL report('read_input_variables', "Read accumulated " // TRIM(group % in_var_list(1) % name))
948
949	IF ( input_var % is_upside_down ) CALL reverse(buffer(buf_id) % array)
950	CALL run_control('time', 'comp')
951
952	!------------------------------------------------------------------------------
953	!- Section 2: Load input buffers for normal I/O groups
954	!------------------------------------------------------------------------------
955	ELSE
956
957	!
958	!-- Allocate one input buffer per input_variable. If more quantities
959	!-- have to be computed than input variables exist in this group,
960	!-- allocate more buffers. For instance, in the thermodynamics group,
961	!-- there are three input variabels (PP, T, Qv) and four quantities
962	!-- necessart (P, Theta, Rho, qv) for the corresponding output fields
963	!-- (p0, Theta, qv, ug, and vg)
964	nbuffers = MAX( group % n_inputs, group % n_output_quantities )
965	ALLOCATE( buffer(nbuffers) )
966	CALL run_control('time', 'alloc')
967
968	!
969	!-- Read in all input variables, leave extra buffers-if any-untouched.
970	DO ivar = 1, group % n_inputs
971
972	input_var => group % in_var_list(ivar)
973
974	!
975	! Check wheather P or PP is present in input file
976	IF (input_var % name == 'P') THEN
977	input_var % name = TRIM( get_pressure_varname(input_file) )
978	CALL run_control('time', 'read')
979	END IF
980
981	CALL get_netcdf_variable(input_file, input_var, buffer(ivar) % array)
982
983	IF ( input_var % is_upside_down ) CALL reverse(buffer(ivar) % array)
984	CALL run_control('time', 'comp')
985
986	END DO
987	END IF
988
989	END SUBROUTINE read_input_variables
990
991
992	!------------------------------------------------------------------------------!
993	! Description:
994	! ------------
995	!> Select the appropriate buffer ID for accumulated COSMO input variables
996	!> depending on the current hour.
997	!------------------------------------------------------------------------------!
998	INTEGER FUNCTION select_buffer(hour)
999	INTEGER, INTENT(IN) :: hour
1000	INTEGER :: step
1001
1002	select_buffer = 0
1003	step = MODULO(hour, 3) + 1
1004
1005	SELECT CASE(step)
1006	CASE(1, 3)
1007	select_buffer = 1
1008	CASE(2)
1009	select_buffer = 2
1010	CASE DEFAULT
1011	message = "Invalid step '" // TRIM(str(step))
1012	CALL inifor_abort('select_buffer', message)
1013	END SELECT
1014	END FUNCTION select_buffer
1015
1016
1017	!------------------------------------------------------------------------------!
1018	! Description:
1019	! ------------
1020	!> Checks if the input_file contains the absolute pressure, 'P', or the pressure
1021	!> perturbation, 'PP', and returns the appropriate string.
1022	!------------------------------------------------------------------------------!
1023	CHARACTER(LEN=2) FUNCTION get_pressure_varname(input_file) RESULT(var)
1024	CHARACTER(LEN=*) :: input_file
1025	INTEGER :: ncid, varid
1026
1027	CALL check(nf90_open( TRIM(input_file), NF90_NOWRITE, ncid ))
1028	IF ( nf90_inq_varid( ncid, 'P', varid ) .EQ. NF90_NOERR ) THEN
1029
1030	var = 'P'
1031
1032	ELSE IF ( nf90_inq_varid( ncid, 'PP', varid ) .EQ. NF90_NOERR ) THEN
1033
1034	var = 'PP'
1035	CALL report('get_pressure_var', 'Using PP instead of P')
1036
1037	ELSE
1038
1039	message = "Failed to read '" // TRIM(var) // &
1040	"' from file '" // TRIM(input_file) // "'."
1041	CALL inifor_abort('get_pressure_var', message)
1042
1043	END IF
1044
1045	CALL check(nf90_close(ncid))
1046
1047	END FUNCTION get_pressure_varname
1048
1049
1050	!------------------------------------------------------------------------------!
1051	! Description:
1052	! ------------
1053	!> Read the given global attribute form the given netCDF file.
1054	!------------------------------------------------------------------------------!
1055	FUNCTION get_netcdf_attribute(filename, attribute) RESULT(attribute_value)
1056
1057	CHARACTER(LEN=*), INTENT(IN) :: filename, attribute
1058	REAL(dp) :: attribute_value
1059
1060	INTEGER :: ncid
1061
1062	IF ( nf90_open( TRIM(filename), NF90_NOWRITE, ncid ) == NF90_NOERR ) THEN
1063
1064	CALL check(nf90_get_att(ncid, NF90_GLOBAL, TRIM(attribute), attribute_value))
1065	CALL check(nf90_close(ncid))
1066
1067	ELSE
1068
1069	message = "Failed to read '" // TRIM(attribute) // &
1070	"' from file '" // TRIM(filename) // "'."
1071	CALL inifor_abort('get_netcdf_attribute', message)
1072
1073	END IF
1074
1075	END FUNCTION get_netcdf_attribute
1076
1077
1078
1079	!------------------------------------------------------------------------------!
1080	! Description:
1081	! ------------
1082	!> Updates the dynamic driver with the interpolated field of the current
1083	!> variable at the current time step.
1084	!------------------------------------------------------------------------------!
1085	SUBROUTINE update_output(var, array, iter, output_file, cfg)
1086	TYPE(nc_var), INTENT(IN) :: var
1087	REAL(dp), INTENT(IN) :: array(:,:,:)
1088	INTEGER, INTENT(IN) :: iter
1089	TYPE(nc_file), INTENT(IN) :: output_file
1090	TYPE(inifor_config) :: cfg
1091
1092	INTEGER :: ncid, ndim, start(4), count(4)
1093	LOGICAL :: var_is_time_dependent
1094
1095	var_is_time_dependent = ( &
1096	var % dimids( var % ndim ) == output_file % dimid_time &
1097	)
1098
1099	!
1100	!-- Skip time dimension for output
1101	ndim = var % ndim
1102	IF ( var_is_time_dependent ) ndim = var % ndim - 1
1103
1104	start(:) = (/1,1,1,1/)
1105	start(ndim+1) = iter
1106	count(1:ndim) = var%dimlen(1:ndim)
1107
1108	CALL check(nf90_open(output_file % name, NF90_WRITE, ncid))
1109
1110	!
1111	!-- Reduce dimension of output array according to variable kind
1112	SELECT CASE (TRIM(var % kind))
1113
1114	CASE ( 'init scalar profile', 'init u profile', 'init v profile', &
1115	'init w profile' )
1116
1117	CALL check(nf90_put_var( ncid, var%varid, array(1,1,:) ) )
1118
1119	CASE ( 'init soil', 'init scalar', 'init u', 'init v', 'init w' )
1120
1121	CALL check(nf90_put_var( ncid, var%varid, array(:,:,:) ) )
1122
1123	CASE( 'left scalar', 'right scalar', 'left w', 'right w' )
1124
1125	CALL check(nf90_put_var( ncid, var%varid, array(1,:,:), &
1126	start=start(1:ndim+1), &
1127	count=count(1:ndim) ) )
1128
1129
1130	IF (.NOT. SIZE(array, 2) .EQ. var % dimlen(1)) THEN
1131	PRINT *, "inifor: update_output: Dimension ", 1, " of variable ", &
1132	TRIM(var % name), " (", var % dimlen(1), &
1133	") does not match the dimension of the output array (", &
1134	SIZE(array, 2), ")."
1135	STOP
1136	END IF
1137
1138
1139	CASE( 'north scalar', 'south scalar', 'north w', 'south w' )
1140
1141	CALL check(nf90_put_var( ncid, var%varid, array(:,1,:), &
1142	start=start(1:ndim+1), &
1143	count=count(1:ndim) ) )
1144
1145
1146	CASE( 'surface forcing', 'top scalar', 'top w' )
1147
1148	CALL check(nf90_put_var( ncid, var%varid, array(:,:,1), &
1149	start=start(1:ndim+1), &
1150	count=count(1:ndim) ) )
1151
1152	CASE ( 'left u', 'right u', 'left v', 'right v' )
1153
1154	CALL check(nf90_put_var( ncid, var%varid, array(1,:,:), &
1155	start=start(1:ndim+1), &
1156	count=count(1:ndim) ) )
1157
1158	CASE ( 'north u', 'south u', 'north v', 'south v' )
1159
1160	CALL check(nf90_put_var( ncid, var%varid, array(:,1,:), &
1161	start=start(1:ndim+1), &
1162	count=count(1:ndim) ) )
1163
1164	CASE ( 'top u', 'top v' )
1165
1166	CALL check(nf90_put_var( ncid, var%varid, array(:,:,1), &
1167	start=start(1:ndim+1), &
1168	count=count(1:ndim) ) )
1169
1170	CASE ( 'time series' )
1171
1172	CALL check(nf90_put_var( ncid, var%varid, array(1,1,1), &
1173	start=start(1:ndim+1) ) )
1174
1175	CASE ( 'constant scalar profile', 'geostrophic' )
1176
1177	CALL check(nf90_put_var( ncid, var%varid, array(1,1,:), &
1178	start=start(1:ndim+1), &
1179	count=count(1:ndim) ) )
1180
1181	CASE ( 'internal profile' )
1182
1183	IF ( cfg % debug ) THEN
1184	CALL check(nf90_put_var( ncid, var%varid, array(1,1,:), &
1185	start=start(1:ndim+1), &
1186	count=count(1:ndim) ) )
1187	END IF
1188
1189	CASE ( 'large-scale scalar forcing', 'large-scale w forcing' )
1190
1191	message = "Doing nothing in terms of writing large-scale forings."
1192	CALL report('update_output', message)
1193
1194	CASE DEFAULT
1195
1196	message = "Variable kind '" // TRIM(var % kind) // &
1197	"' not recognized."
1198	CALL inifor_abort('update_output', message)
1199
1200	END SELECT
1201
1202	CALL check(nf90_close(ncid))
1203
1204	END SUBROUTINE update_output
1205
1206
1207	!------------------------------------------------------------------------------!
1208	! Description:
1209	! ------------
1210	!> Checks the status of a netCDF API call and aborts if an error occured
1211	!------------------------------------------------------------------------------!
1212	SUBROUTINE check(status)
1213
1214	INTEGER, INTENT(IN) :: status
1215
1216	IF (status /= nf90_noerr) THEN
1217	message = "NetCDF API call failed with error: " // &
1218	TRIM( nf90_strerror(status) )
1219	CALL inifor_abort('io.check', message)
1220	END IF
1221
1222	END SUBROUTINE check
1223
1224	END MODULE io

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |