Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |