Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |