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

Rev	Line
[3447]	1	!> @file src/inifor_io.f90
[2696]	2	!------------------------------------------------------------------------------!
[2718]	3	! This file is part of the PALM model system.
[2696]	4	!
[2718]	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
[2696]	8	! version.
	9	!
[2718]	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.
[2696]	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	!
[2718]	17	! Copyright 2017-2018 Leibniz Universitaet Hannover
	18	! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
[2696]	19	!------------------------------------------------------------------------------!
	20	!
	21	! Current revisions:
	22	! -----------------
[3183]	23	!
	24	!
	25	! Former revisions:
	26	! -----------------
	27	! $Id: inifor_io.f90 3615 2018-12-10 07:21:03Z raasch $
[3615]	28	! bugfix: abort replaced by inifor_abort
	29	!
	30	! 3557 2018-11-22 16:01:22Z eckhard
[3557]	31	! Updated documentation, removed unused subroutine write_netcdf_variable_2d()
	32	!
	33	!
	34	! 3537 2018-11-20 10:53:14Z eckhard
[3537]	35	! New routine get_netcdf_dim_vector()
	36	!
	37	!
	38	! 3534 2018-11-19 15:35:16Z raasch
[3534]	39	! bugfix: INTENT attribute changed
	40	!
	41	! 3456 2018-10-30 14:29:54Z eckhard
[3456]	42	! NetCDf output of internal arrays only with --debug option
	43	!
	44	!
	45	! 3447 2018-10-29 15:52:54Z eckhard
[3447]	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
[3395]	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
[3262]	60	!
	61	! 3183 2018-07-27 14:25:55Z suehring
[3182]	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
[2696]	73	!
[3182]	74	!
[3183]	75	! 3182 2018-07-27 13:36:03Z suehring
[2696]	76	! Initial revision
	77	!
	78	!
	79	!
	80	! Authors:
	81	! --------
[3557]	82	!> @author Eckhard Kadasch (Deutscher Wetterdienst, Offenbach)
[2696]	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, &
[3182]	93	ONLY: DATE, SNAME, PATH, PI, dp, hp, TO_RADIANS, TO_DEGREES, VERSION
[2696]	94	USE netcdf
	95	USE types
	96	USE util, &
[3182]	97	ONLY: reverse, str, real_to_str
[2696]	98
	99	IMPLICIT NONE
	100
[3557]	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	!------------------------------------------------------------------------------!
[3182]	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
[2696]	116	CONTAINS
	117
[3557]	118	!------------------------------------------------------------------------------!
	119	! Description:
	120	! ------------
	121	!> get_netcdf_variable_int() implements the integer variant for the
	122	!> get_netcdf_variable interface.
	123	!------------------------------------------------------------------------------!
[3182]	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
[3447]	130	INTEGER :: ncid
	131	INTEGER, DIMENSION(3) :: start, count
[3182]	132
[3447]	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) // "'."
[3615]	152	CALL inifor_abort('get_netcdf_variable', message)
[3447]	153
	154	END IF
	155
	156	CALL check(nf90_close(ncid))
	157	CALL run_control('time', 'read')
	158
[3182]	159	END SUBROUTINE get_netcdf_variable_int
	160
	161
[3557]	162	!------------------------------------------------------------------------------!
	163	! Description:
	164	! ------------
	165	!> get_netcdf_variable_real() implements the real variant for the
	166	!> get_netcdf_variable interface.
	167	!------------------------------------------------------------------------------!
[3182]	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
[3447]	174	INTEGER :: ncid
	175	INTEGER, DIMENSION(3) :: start, count
[3182]	176
[3447]	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) // "'."
[3615]	196	CALL inifor_abort('get_netcdf_variable', message)
[3447]	197
	198	END IF
	199
	200	CALL check(nf90_close(ncid))
	201	CALL run_control('time', 'read')
	202
[3182]	203	END SUBROUTINE get_netcdf_variable_real
	204
	205
[3557]	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)
[3537]	213
	214	CHARACTER(LEN=*), INTENT(IN) :: filename
[3557]	215	CHARACTER(LEN=*), INTENT(IN) :: coordname
	216	REAL(dp), ALLOCATABLE, INTENT(INOUT) :: coords(:)
[3537]	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. &
[3557]	222	nf90_inq_varid( ncid, coordname, varid ) .EQ. NF90_NOERR ) THEN
[3537]	223
	224	CALL check(nf90_inquire_variable( ncid, varid, dimids = dimids ))
	225	CALL check(nf90_inquire_dimension( ncid, dimids(1), len = dimlen ))
	226
[3557]	227	ALLOCATE(coords(dimlen))
	228	CALL check(nf90_get_var( ncid, varid, coords))
[3537]	229
	230	ELSE
	231
[3557]	232	message = "Failed to read '" // TRIM(coordname) // &
[3537]	233	"' from file '" // TRIM(filename) // "'."
[3615]	234	CALL inifor_abort('get_netcdf_dim_vector', message)
[3537]	235
	236	END IF
	237
	238	END SUBROUTINE get_netcdf_dim_vector
	239
	240
[3557]	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	!------------------------------------------------------------------------------!
[3447]	247	SUBROUTINE get_input_dimensions(in_var, ncid)
	248
[3534]	249	TYPE(nc_var), INTENT(INOUT) :: in_var
	250	INTEGER, INTENT(IN) :: ncid
[3447]	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
[3557]	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	!------------------------------------------------------------------------------!
[3447]	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 " // &
[3537]	290	TRIM(in_var % name) // " with " // TRIM(str(in_var % ndim)) // &
[3447]	291	" dimensions because only two- and and three-dimensional" // &
	292	" variables are supported."
[3615]	293	CALL inifor_abort('get_netcdf_start_and_count', message)
[3447]	294
	295	END IF
	296
	297	start = (/ 1, 1, 1 /)
	298	IF ( TRIM(in_var % name) .EQ. 'T_SO' ) THEN
[3557]	299	!
	300	!-- Skip depth = 0.0 for T_SO and reduce number of depths from 9 to 8
[3447]	301	in_var % dimlen(3) = in_var % dimlen(3) - 1
	302
[3557]	303	!
	304	!-- Start reading from second level, e.g. depth = 0.005 instead of 0.0
[3447]	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
[3557]	319	!------------------------------------------------------------------------------!
	320	! Description:
	321	! ------------
	322	!> Routine for defining netCDF variables in the dynamic driver, INIFOR's netCDF
	323	!> output.
	324	!------------------------------------------------------------------------------!
[2696]	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))
[3182]	333	IF ( var % lod .GE. 0 ) THEN
	334	CALL check(nf90_put_att(ncid, var % varid, "lod", var % lod))
	335	END IF
[2696]	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
[3557]	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	!------------------------------------------------------------------------------!
[2696]	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	! ------------
[3557]	368	!> This routine parses and interpretes the command-line options and stores the
	369	!> resulting settings in the 'cfg' data structure.
[2696]	370	!------------------------------------------------------------------------------!
[3182]	371	SUBROUTINE parse_command_line_arguments( cfg )
[2696]	372
[3182]	373	TYPE(inifor_config), INTENT(INOUT) :: cfg
[2696]	374
[3182]	375	CHARACTER(LEN=PATH) :: option, arg
	376	INTEGER :: arg_count, i
[2696]	377
[3395]	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
[2696]	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(' ') // &
[3182]	393	" - by setting the namelist parameters 'longitude' and 'latitude', or" // NEW_LINE(' ') // &
[2696]	394	" - by providing a static driver netCDF file via the -static command-line option."
	395
[3182]	396	i = 1
	397	DO WHILE (i .LE. arg_count)
[2696]	398
	399	CALL GET_COMMAND_ARGUMENT( i, option )
	400
	401	SELECT CASE( TRIM(option) )
	402
[3395]	403	CASE( '--averaging-mode' )
	404	CALL get_option_argument( i, arg )
	405	cfg % averaging_mode = TRIM(arg)
	406
[3182]	407	CASE( '-date', '-d', '--date' )
	408	CALL get_option_argument( i, arg )
	409	cfg % start_date = TRIM(arg)
[2696]	410
[3395]	411	CASE( '--debug' )
	412	cfg % debug = .TRUE.
	413
[3182]	414	CASE( '-z0', '-z', '--elevation' )
	415	CALL get_option_argument( i, arg )
	416	READ(arg, *) cfg % z0
[2696]	417
[3182]	418	CASE( '-p0', '-r', '--surface-pressure' )
[3395]	419	cfg % p0_is_set = .TRUE.
[3182]	420	CALL get_option_argument( i, arg )
	421	READ(arg, *) cfg % p0
[2696]	422
[3182]	423	CASE( '-ug', '-u', '--geostrophic-u' )
[3395]	424	cfg % ug_is_set = .TRUE.
[3182]	425	CALL get_option_argument( i, arg )
	426	READ(arg, *) cfg % ug
[2696]	427
[3182]	428	CASE( '-vg', '-v', '--geostrophic-v' )
[3395]	429	cfg % vg_is_set = .TRUE.
[3182]	430	CALL get_option_argument( i, arg )
	431	READ(arg, *) cfg % vg
[2696]	432
[3182]	433	CASE( '-clon', '-clat' )
[3615]	434	CALL inifor_abort('parse_command_line_arguments', message)
[2696]	435
[3182]	436	CASE( '-path', '-p', '--path' )
	437	CALL get_option_argument( i, arg )
	438	cfg % input_path = TRIM(arg)
[2696]	439
[3182]	440	CASE( '-hhl', '-l', '--hhl-file' )
	441	CALL get_option_argument( i, arg )
[3395]	442	cfg % hhl_file = TRIM(arg)
[2696]	443
[3395]	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
[3182]	453	CASE( '-static', '-t', '--static-driver' )
	454	CALL get_option_argument( i, arg )
[3395]	455	cfg % static_driver_file = TRIM(arg)
[2696]	456
[3182]	457	CASE( '-soil', '-s', '--soil-file')
	458	CALL get_option_argument( i, arg )
[3395]	459	cfg % soiltyp_file = TRIM(arg)
[2696]	460
[3182]	461	CASE( '--flow-prefix')
	462	CALL get_option_argument( i, arg )
[3395]	463	cfg % flow_prefix = TRIM(arg)
	464	cfg % flow_prefix_is_set = .TRUE.
	465
[3182]	466	CASE( '--radiation-prefix')
	467	CALL get_option_argument( i, arg )
[3395]	468	cfg % radiation_prefix = TRIM(arg)
	469	cfg % radiation_prefix_is_set = .TRUE.
	470
[3182]	471	CASE( '--soil-prefix')
	472	CALL get_option_argument( i, arg )
[3395]	473	cfg % soil_prefix = TRIM(arg)
	474	cfg % soil_prefix_is_set = .TRUE.
	475
[3182]	476	CASE( '--soilmoisture-prefix')
	477	CALL get_option_argument( i, arg )
[3395]	478	cfg % soilmoisture_prefix = TRIM(arg)
	479	cfg % soilmoisture_prefix_is_set = .TRUE.
[2696]	480
[3182]	481	CASE( '-o', '--output' )
	482	CALL get_option_argument( i, arg )
	483	cfg % output_file = TRIM(arg)
[2696]	484
[3182]	485	CASE( '-n', '--namelist' )
	486	CALL get_option_argument( i, arg )
	487	cfg % namelist_file = TRIM(arg)
[2696]	488
[3182]	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
[2696]	507	CASE DEFAULT
[3182]	508	message = "unknown option '" // TRIM(option) // "'."
[3615]	509	CALL inifor_abort('parse_command_line_arguments', message)
[2696]	510
	511	END SELECT
	512
[3182]	513	i = i + 1
	514
[2696]	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
[3182]	526
[3557]	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	!------------------------------------------------------------------------------!
[3182]	533	SUBROUTINE get_option_argument(i, arg)
	534	CHARACTER(LEN=PATH), INTENT(INOUT) :: arg
	535	INTEGER, INTENT(INOUT) :: i
[2696]	536
[3182]	537	i = i + 1
	538	CALL GET_COMMAND_ARGUMENT(i, arg)
	539
	540	END SUBROUTINE
	541
	542
[3557]	543	!------------------------------------------------------------------------------!
	544	! Description:
	545	! ------------
	546	!> Checks the INIFOR configuration 'cfg' for plausibility.
	547	!------------------------------------------------------------------------------!
[3182]	548	SUBROUTINE validate_config(cfg)
	549	TYPE(inifor_config), INTENT(IN) :: cfg
	550	LOGICAL :: all_files_present
	551
	552	all_files_present = .TRUE.
[3395]	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')
[3182]	556
[3557]	557	!
	558	!-- Only check optional static driver file name, if it has been given.
[3182]	559	IF (TRIM(cfg % static_driver_file) .NE. '') THEN
[3395]	560	all_files_present = all_files_present .AND. file_present(cfg % static_driver_file, 'static driver')
[3182]	561	END IF
	562
	563	IF (.NOT. all_files_present) THEN
	564	message = "INIFOR configuration invalid; some input files are missing."
[3615]	565	CALL inifor_abort( 'validate_config', message )
[3182]	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."
[3615]	577	CALL inifor_abort( 'validate_config', message )
[3182]	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."
[3615]	589	CALL inifor_abort( 'validate_config', message )
[3182]	590	END SELECT
	591
[3395]	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."
[3615]	600	CALL inifor_abort( 'validate_config', message )
[3395]	601	END SELECT
[3182]	602
[3395]	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."
[3615]	606	CALL inifor_abort( 'validate_config', message )
[3395]	607	END IF
	608
[3182]	609	END SUBROUTINE validate_config
	610
	611
[3557]	612	!------------------------------------------------------------------------------!
	613	! Description:
	614	! ------------
	615	!> Check whether the given file is present on the filesystem.
	616	!------------------------------------------------------------------------------!
[3395]	617	LOGICAL FUNCTION file_present(filename, kind)
[3182]	618	CHARACTER(LEN=PATH), INTENT(IN) :: filename
[3395]	619	CHARACTER(LEN=*), INTENT(IN) :: kind
[3182]	620
[3395]	621	IF (LEN(TRIM(filename))==0) THEN
[3182]	622
[3395]	623	file_present = .FALSE.
	624	message = "No name was given for the " // TRIM(kind) // " file."
[3182]	625	CALL report('file_present', message)
[3395]	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
[3182]	637	END IF
	638
	639	END FUNCTION file_present
	640
	641
[2696]	642	!------------------------------------------------------------------------------!
	643	! Description:
	644	! ------------
[3557]	645	!> This routine initializes the dynamic driver file, i.e. INIFOR's netCDF output
	646	!> file.
[2696]	647	!>
	648	!> Besides writing metadata, such as global attributes, coordinates, variables,
[3557]	649	!> in the netCDF file, various netCDF IDs are saved for later, when INIFOR
[2696]	650	!> writes the actual data.
	651	!------------------------------------------------------------------------------!
[3182]	652	SUBROUTINE setup_netcdf_dimensions(output_file, palm_grid, &
	653	start_date_string, origin_lon, origin_lat)
[2696]	654
	655	TYPE(nc_file), INTENT(INOUT) :: output_file
	656	TYPE(grid_definition), INTENT(IN) :: palm_grid
[3182]	657	CHARACTER (LEN=DATE), INTENT(IN) :: start_date_string
	658	REAL(dp), INTENT(IN) :: origin_lon, origin_lat
[2696]	659
[3182]	660	CHARACTER (LEN=8) :: date_string
	661	CHARACTER (LEN=10) :: time_string
	662	CHARACTER (LEN=5) :: zone_string
	663	CHARACTER (LEN=SNAME) :: history_string
[2696]	664	INTEGER :: ncid, nx, ny, nz, nt, dimids(3), dimvarids(3)
	665	REAL(dp) :: z0
	666
[3182]	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
[3557]	671	!
	672	!-- Create the netCDF file as in netCDF-4/HDF5 format if __netcdf4 preprocessor flag is given
[3182]	673	#if defined( __netcdf4 )
[2696]	674	CALL check(nf90_create(TRIM(output_file % name), OR(NF90_CLOBBER, NF90_HDF5), ncid))
[3182]	675	#else
	676	CALL check(nf90_create(TRIM(output_file % name), NF90_CLOBBER, ncid))
	677	#endif
[2696]	678
[3395]	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
[2696]	689	!
	690	!------------------------------------------------------------------------------
[3395]	691	!- Section 2: Write global NetCDF attributes
[2696]	692	!------------------------------------------------------------------------------
[3182]	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
[2696]	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'))
[3182]	702	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'history', TRIM(history_string)))
[2696]	703	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'references', '--'))
	704	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'comment', '--'))
[3182]	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)'))))
[3557]	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)
[3395]	711	CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_z', TRIM(real_to_str(z0, '(F18.13)'))))
[2696]	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	!------------------------------------------------------------------------------
[3557]	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
[2696]	729
[3557]	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"))
[2696]	736
[3557]	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"))
[2696]	740
[3557]	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
[2696]	747
[3557]	748	!
	749	!-- overwrite third dimid with the one of depth
[3182]	750	CALL check(nf90_def_dim(ncid, "zsoil", SIZE(palm_grid % depths), dimids(3)) )
[3557]	751	!
	752	!-- save dimids for later
	753	output_file % dimids_soil = dimids
[2696]	754
[3557]	755	!
	756	!-- overwrite third dimvarid with the one of depth
[3182]	757	CALL check(nf90_def_var(ncid, "zsoil", NF90_FLOAT, output_file % dimids_soil(3), dimvarids(3)))
[2696]	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	!
[3557]	762	!-- save dimvarids for later
	763	output_file % dimvarids_soil = dimvarids
	764	!
[2696]	765	!------------------------------------------------------------------------------
	766	!- Section 2b: Define dimensions for cell faces/velocities
	767	!------------------------------------------------------------------------------
[3557]	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
[2696]	777
[3557]	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"))
[2696]	784
[3557]	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"))
[2696]	788
[3557]	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
[2696]	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"))
[3182]	806	CALL check(nf90_put_att(ncid, output_file % dimvarid_time, "units", &
	807	"seconds since " // start_date_string // " UTC"))
[2696]	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
[3557]	823	!
	824	!-- TODO Read in soil depths from input file before this.
[2696]	825	CALL check(nf90_put_var(ncid, output_file % dimvarids_soil(3), palm_grid%depths))
	826
[3557]	827	!
	828	!-- Write time vector
[2696]	829	CALL check(nf90_put_var(ncid, output_file % dimvarid_time, output_file % time))
	830
[3557]	831	!
	832	!-- Close the file
[2696]	833	CALL check(nf90_close(ncid))
	834
	835	END SUBROUTINE setup_netcdf_dimensions
	836
	837
[3557]	838	!------------------------------------------------------------------------------!
	839	! Description:
	840	! ------------
	841	!> Defines the netCDF variables to be written to the dynamic driver file
	842	!------------------------------------------------------------------------------!
[3456]	843	SUBROUTINE setup_netcdf_variables(filename, output_variable_table, debug)
[2696]	844
	845	CHARACTER (LEN=*), INTENT(IN) :: filename
	846	TYPE(nc_var), INTENT(INOUT), TARGET :: output_variable_table(:)
[3456]	847	LOGICAL, INTENT(IN) :: debug
	848
[2696]	849	TYPE(nc_var), POINTER :: var
	850	INTEGER :: i, ncid
[3456]	851	LOGICAL :: to_be_written
[2696]	852
[3182]	853	message = "Defining variables in dynamic driver '" // TRIM(filename) // "'."
[2696]	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
[3456]	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
[3182]	867	message = " variable #" // TRIM(str(i)) // " '" // TRIM(var%name) // "'."
[2696]	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
[3182]	879	message = "Dynamic driver '" // TRIM(filename) // "' initialized successfully."
[2696]	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	!------------------------------------------------------------------------------
[3557]	916	!
	917	!-- radiation budgets, precipitation
[2696]	918	IF (group % kind == 'running average' .OR. &
[3557]	919	group % kind == 'accumulated') THEN
[2696]	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)) ) // "."
[3615]	926	CALL inifor_abort('read_input_variables \| accumulation', message)
[2696]	927	END IF
	928
[3557]	929	!
	930	!-- use two buffer arrays
[2696]	931	nbuffers = 2
	932	IF ( .NOT. ALLOCATED( buffer ) ) ALLOCATE( buffer(nbuffers) )
	933
[3557]	934	!
	935	!-- hour of the day
	936	hour = iter - 1
	937	!
	938	!-- chose correct buffer array
[2696]	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)
[3182]	946	CALL get_netcdf_variable(input_file, input_var, buffer(buf_id) % array)
[2696]	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
[3557]	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)
[3395]	964	nbuffers = MAX( group % n_inputs, group % n_output_quantities )
[2696]	965	ALLOCATE( buffer(nbuffers) )
	966	CALL run_control('time', 'alloc')
	967
[3557]	968	!
	969	!-- Read in all input variables, leave extra buffers-if any-untouched.
[3395]	970	DO ivar = 1, group % n_inputs
[2696]	971
	972	input_var => group % in_var_list(ivar)
	973
[3557]	974	!
	975	! Check wheather P or PP is present in input file
[2696]	976	IF (input_var % name == 'P') THEN
[3395]	977	input_var % name = TRIM( get_pressure_varname(input_file) )
[2696]	978	CALL run_control('time', 'read')
	979	END IF
	980
[3182]	981	CALL get_netcdf_variable(input_file, input_var, buffer(ivar) % array)
[2696]	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
[3557]	992	!------------------------------------------------------------------------------!
	993	! Description:
	994	! ------------
	995	!> Select the appropriate buffer ID for accumulated COSMO input variables
	996	!> depending on the current hour.
	997	!------------------------------------------------------------------------------!
[2696]	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))
[3615]	1012	CALL inifor_abort('select_buffer', message)
[2696]	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	!------------------------------------------------------------------------------!
[3395]	1023	CHARACTER(LEN=2) FUNCTION get_pressure_varname(input_file) RESULT(var)
[2696]	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) // "'."
[3615]	1041	CALL inifor_abort('get_pressure_var', message)
[2696]	1042
	1043	END IF
	1044
	1045	CALL check(nf90_close(ncid))
	1046
[3395]	1047	END FUNCTION get_pressure_varname
[2696]	1048
	1049
[3557]	1050	!------------------------------------------------------------------------------!
	1051	! Description:
	1052	! ------------
	1053	!> Read the given global attribute form the given netCDF file.
	1054	!------------------------------------------------------------------------------!
[2696]	1055	FUNCTION get_netcdf_attribute(filename, attribute) RESULT(attribute_value)
	1056
	1057	CHARACTER(LEN=*), INTENT(IN) :: filename, attribute
	1058	REAL(dp) :: attribute_value
	1059
[3557]	1060	INTEGER :: ncid
[2696]	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))
[3182]	1065	CALL check(nf90_close(ncid))
[2696]	1066
	1067	ELSE
	1068
	1069	message = "Failed to read '" // TRIM(attribute) // &
	1070	"' from file '" // TRIM(filename) // "'."
[3615]	1071	CALL inifor_abort('get_netcdf_attribute', message)
[2696]	1072
	1073	END IF
	1074
	1075	END FUNCTION get_netcdf_attribute
	1076
	1077
[3557]	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	!------------------------------------------------------------------------------!
[3456]	1085	SUBROUTINE update_output(var, array, iter, output_file, cfg)
[2696]	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
[3456]	1090	TYPE(inifor_config) :: cfg
[2696]	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
[3557]	1099	!
	1100	!-- Skip time dimension for output
[3182]	1101	ndim = var % ndim
	1102	IF ( var_is_time_dependent ) ndim = var % ndim - 1
[2696]	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
[3557]	1110	!
	1111	!-- Reduce dimension of output array according to variable kind
[2696]	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
[3456]	1175	CASE ( 'constant scalar profile', 'geostrophic' )
[2696]	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
[3456]	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
[3182]	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
[2696]	1194	CASE DEFAULT
	1195
	1196	message = "Variable kind '" // TRIM(var % kind) // &
	1197	"' not recognized."
[3615]	1198	CALL inifor_abort('update_output', message)
[2696]	1199
	1200	END SELECT
	1201
	1202	CALL check(nf90_close(ncid))
	1203
	1204	END SUBROUTINE update_output
	1205
	1206
[3557]	1207	!------------------------------------------------------------------------------!
	1208	! Description:
	1209	! ------------
	1210	!> Checks the status of a netCDF API call and aborts if an error occured
	1211	!------------------------------------------------------------------------------!
[2696]	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) )
[3615]	1219	CALL inifor_abort('io.check', message)
[2696]	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 |