Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |