Home

Context Navigation

source: palm/trunk/SOURCE/data_output_module.f90 @ 4577

Last change on this file since 4577 was 4577, checked in by raasch, 4 years ago
further re-formatting to follow the PALM coding standard
Property svn:keywords set to `Id`
File size: 209.6 KB

Rev	Line
[4070]	1	!> @file data_output_module.f90
	2	!--------------------------------------------------------------------------------------------------!
	3	! This file is part of the PALM model system.
	4	!
[4577]	5	! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
	6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
	7	! (at your option) any later version.
[4070]	8	!
[4577]	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
	10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
	11	! Public License for more details.
[4070]	12	!
[4577]	13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
	14	! <http://www.gnu.org/licenses/>.
[4070]	15	!
[4481]	16	! Copyright 2019-2020 Leibniz Universitaet Hannover
[4070]	17	!--------------------------------------------------------------------------------------------------!
	18	!
	19	! Current revisions:
	20	! ------------------
[4408]	21	!
	22	!
[4070]	23	! Former revisions:
	24	! -----------------
	25	! $Id: data_output_module.f90 4577 2020-06-25 09:53:58Z raasch $
[4577]	26	! file re-formatted to follow the PALM coding standard
	27	!
	28	! 4500 2020-04-17 10:12:45Z suehring
[4500]	29	! Avoid uninitialized variables
[4577]	30	!
[4500]	31	! 4481 2020-03-31 18:55:54Z maronga
[4408]	32	! Enable character-array output
	33	!
	34	! 4147 2019-08-07 09:42:31Z gronemeier
[4147]	35	! corrected indentation according to coding standard
	36	!
	37	! 4141 2019-08-05 12:24:51Z gronemeier
[4070]	38	! Initial revision
	39	!
	40	!
	41	! Authors:
	42	! --------
	43	!> @author Tobias Gronemeier
	44	!> @author Helge Knoop
	45	!
	46	!--------------------------------------------------------------------------------------------------!
	47	! Description:
	48	! ------------
	49	!> Data-output module to handle output of variables into output files.
	50	!>
[4141]	51	!> The module first creates an interal database containing all meta data of all output quantities.
	52	!> After defining all meta data, the output files are initialized and prepared for writing. When
	53	!> writing is finished, files can be finalized and closed.
	54	!> The order of calls are as follows:
	55	!> 1. Initialize the module via
	56	!> 'dom_init'
	57	!> 2. Define output files via (multiple calls of)
	58	!> 'dom_def_file', 'dom_def_att', 'dom_def_dim', 'dom_def_var'
	59	!> 3. Leave definition stage via
	60	!> 'dom_def_end'
	61	!> 4. Write output data into file via
	62	!> 'dom_write_var'
	63	!> 5. Finalize the output via
	64	!> 'dom_finalize_output'
	65	!> If any routine exits with a non-zero return value, the error message of the last encountered
	66	!> error can be fetched via 'dom_get_error_message'.
	67	!> For debugging purposes, the content of the database can be written to the debug output via
	68	!> 'dom_database_debug_output'.
[4070]	69	!>
	70	!> @todo Convert variable if type of given values do not fit specified type.
	71	!--------------------------------------------------------------------------------------------------!
[4147]	72	MODULE data_output_module
[4070]	73
[4147]	74	USE kinds
[4070]	75
[4577]	76	USE data_output_netcdf4_module, &
	77	ONLY: netcdf4_finalize, &
	78	netcdf4_get_error_message, &
	79	netcdf4_init_dimension, &
	80	netcdf4_init_module, &
	81	netcdf4_init_variable, &
	82	netcdf4_open_file, &
	83	netcdf4_stop_file_header_definition, &
	84	netcdf4_write_attribute, &
[4147]	85	netcdf4_write_variable
[4070]	86
[4577]	87	USE data_output_binary_module, &
	88	ONLY: binary_finalize, &
	89	binary_get_error_message, &
	90	binary_init_dimension, &
	91	binary_init_module, &
	92	binary_init_variable, &
	93	binary_open_file, &
	94	binary_stop_file_header_definition, &
	95	binary_write_attribute, &
[4147]	96	binary_write_variable
[4070]	97
[4147]	98	IMPLICIT NONE
[4070]	99
[4147]	100	INTEGER, PARAMETER :: charlen = 100 !< maximum length of character variables
	101	INTEGER, PARAMETER :: no_id = -1 !< default ID if no ID was assigned
[4070]	102
[4147]	103	TYPE attribute_type
	104	CHARACTER(LEN=charlen) :: data_type = '' !< data type
	105	CHARACTER(LEN=charlen) :: name !< attribute name
	106	CHARACTER(LEN=charlen) :: value_char !< attribute value if character
	107	INTEGER(KIND=1) :: value_int8 !< attribute value if 8bit integer
	108	INTEGER(KIND=2) :: value_int16 !< attribute value if 16bit integer
	109	INTEGER(KIND=4) :: value_int32 !< attribute value if 32bit integer
	110	REAL(KIND=4) :: value_real32 !< attribute value if 32bit real
	111	REAL(KIND=8) :: value_real64 !< attribute value if 64bit real
	112	END TYPE attribute_type
[4070]	113
[4147]	114	TYPE variable_type
	115	CHARACTER(LEN=charlen) :: data_type = '' !< data type
	116	CHARACTER(LEN=charlen) :: name !< variable name
[4577]	117	CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE :: dimension_names !< list of
	118	!< dimension names used by variable
[4147]	119	INTEGER :: id = no_id !< id within file
[4577]	120	LOGICAL :: is_global = .FALSE. !< true if global
	121	!< variable
	122	INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of
	123	!< dimension ids used by variable
	124	TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes !< list of
	125	!< attributes
[4147]	126	END TYPE variable_type
[4070]	127
[4147]	128	TYPE dimension_type
	129	CHARACTER(LEN=charlen) :: data_type = '' !< data type
	130	CHARACTER(LEN=charlen) :: name !< dimension name
[4577]	131	INTEGER :: id = no_id !< dimension id within
	132	!< file
[4147]	133	INTEGER :: length !< length of dimension
[4577]	134	INTEGER :: length_mask !< length of masked
	135	!< dimension
	136	INTEGER :: variable_id = no_id !< associated variable
	137	!< id within file
[4147]	138	LOGICAL :: is_masked = .FALSE. !< true if masked
[4577]	139	INTEGER, DIMENSION(2) :: bounds !< lower and upper bound
	140	!< of dimension
	141	INTEGER, DIMENSION(:), ALLOCATABLE :: masked_indices !< list of masked
	142	!< indices of dimension
	143	INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: masked_values_int8 !< masked dimension
	144	!< values if 16bit integer
	145	INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: masked_values_int16 !< masked dimension
	146	!< values if 16bit integer
	147	INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: masked_values_int32 !< masked dimension
	148	!< values if 32bit integer
	149	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: masked_values_intwp !< masked dimension
	150	!< values if working-precision int
	151	INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: values_int8 !< dimension values if
	152	!< 16bit integer
	153	INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: values_int16 !< dimension values if
	154	!< 16bit integer
	155	INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: values_int32 !< dimension values if
	156	!< 32bit integer
	157	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: values_intwp !< dimension values if
	158	!< working-precision integer
[4147]	159	LOGICAL, DIMENSION(:), ALLOCATABLE :: mask !< mask
[4577]	160	REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: masked_values_real32 !< masked dimension
	161	!< values if 32bit real
	162	REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: masked_values_real64 !< masked dimension
	163	!< values if 64bit real
	164	REAL(wp), DIMENSION(:), ALLOCATABLE :: masked_values_realwp !< masked dimension
	165	!< values if working-precision real
	166	REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: values_real32 !< dimension values if
	167	!< 32bit real
	168	REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: values_real64 !< dimension values if
	169	!< 64bit real
	170	REAL(wp), DIMENSION(:), ALLOCATABLE :: values_realwp !< dimension values if
	171	!< working-precision real
[4147]	172	TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes !< list of attributes
	173	END TYPE dimension_type
[4070]	174
[4147]	175	TYPE file_type
	176	CHARACTER(LEN=charlen) :: format = '' !< file format
	177	CHARACTER(LEN=charlen) :: name = '' !< file name
	178	INTEGER :: id = no_id !< id of file
	179	LOGICAL :: is_init = .FALSE. !< true if initialized
	180	TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes !< list of attributes
	181	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimensions !< list of dimensions
	182	TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variables !< list of variables
	183	END TYPE file_type
[4070]	184
	185
[4577]	186	CHARACTER(LEN=800) :: internal_error_message = '' !< string containing the last error message
[4147]	187	CHARACTER(LEN=charlen) :: output_file_suffix = '' !< file suffix added to each file name
	188	CHARACTER(LEN=800) :: temp_string !< dummy string
[4070]	189
[4147]	190	INTEGER :: debug_output_unit !< Fortran Unit Number of the debug-output file
	191	INTEGER :: nfiles = 0 !< number of files
	192	INTEGER :: master_rank = 0 !< master rank for tasks to be executed by single PE only
	193	INTEGER :: output_group_comm !< MPI communicator addressing all MPI ranks which participate in output
[4070]	194
[4147]	195	LOGICAL :: print_debug_output = .FALSE. !< if true, debug output is printed
[4070]	196
[4147]	197	TYPE(file_type), DIMENSION(:), ALLOCATABLE :: files !< file list
[4070]	198
[4147]	199	SAVE
[4070]	200
[4147]	201	PRIVATE
[4070]	202
[4147]	203	!> Initialize the data-output module
	204	INTERFACE dom_init
	205	MODULE PROCEDURE dom_init
	206	END INTERFACE dom_init
[4070]	207
[4147]	208	!> Add files to database
	209	INTERFACE dom_def_file
	210	MODULE PROCEDURE dom_def_file
	211	END INTERFACE dom_def_file
[4070]	212
[4147]	213	!> Add dimensions to database
	214	INTERFACE dom_def_dim
	215	MODULE PROCEDURE dom_def_dim
	216	END INTERFACE dom_def_dim
[4070]	217
[4147]	218	!> Add variables to database
	219	INTERFACE dom_def_var
	220	MODULE PROCEDURE dom_def_var
	221	END INTERFACE dom_def_var
[4070]	222
[4147]	223	!> Add attributes to database
	224	INTERFACE dom_def_att
	225	MODULE PROCEDURE dom_def_att_char
	226	MODULE PROCEDURE dom_def_att_int8
	227	MODULE PROCEDURE dom_def_att_int16
	228	MODULE PROCEDURE dom_def_att_int32
	229	MODULE PROCEDURE dom_def_att_real32
	230	MODULE PROCEDURE dom_def_att_real64
	231	END INTERFACE dom_def_att
[4070]	232
[4147]	233	!> Prepare for output: evaluate database and create files
	234	INTERFACE dom_def_end
	235	MODULE PROCEDURE dom_def_end
	236	END INTERFACE dom_def_end
[4070]	237
[4147]	238	!> Write variables to file
	239	INTERFACE dom_write_var
	240	MODULE PROCEDURE dom_write_var
	241	END INTERFACE dom_write_var
[4070]	242
[4147]	243	!> Last actions required for output befor termination
	244	INTERFACE dom_finalize_output
	245	MODULE PROCEDURE dom_finalize_output
	246	END INTERFACE dom_finalize_output
[4070]	247
[4147]	248	!> Return error message
	249	INTERFACE dom_get_error_message
	250	MODULE PROCEDURE dom_get_error_message
	251	END INTERFACE dom_get_error_message
[4070]	252
[4147]	253	!> Write database to debug output
	254	INTERFACE dom_database_debug_output
	255	MODULE PROCEDURE dom_database_debug_output
	256	END INTERFACE dom_database_debug_output
[4141]	257
[4147]	258	PUBLIC &
	259	dom_init, &
	260	dom_def_file, &
	261	dom_def_dim, &
	262	dom_def_var, &
	263	dom_def_att, &
	264	dom_def_end, &
	265	dom_write_var, &
	266	dom_finalize_output, &
	267	dom_get_error_message, &
	268	dom_database_debug_output
[4070]	269
[4147]	270	CONTAINS
[4070]	271
	272
	273	!--------------------------------------------------------------------------------------------------!
	274	! Description:
	275	! ------------
[4141]	276	!> Initialize data-output module.
	277	!> Provide some general information of the main program.
	278	!> The optional argument 'file_suffix_of_output_group' defines a file suffix which is added to all
	279	!> output files. If multiple output groups (groups of MPI ranks, defined by
	280	!> 'mpi_comm_of_output_group') exist, a unique file suffix must be given for each group. This
	281	!> prevents that multiple groups try to open and write to the same output file.
[4070]	282	!--------------------------------------------------------------------------------------------------!
[4147]	283	SUBROUTINE dom_init( file_suffix_of_output_group, mpi_comm_of_output_group, master_output_rank, &
	284	program_debug_output_unit, debug_output )
[4070]	285
[4147]	286	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: file_suffix_of_output_group !< file-name suffix added to each file;
	287	!> must be unique for each output group
[4070]	288
[4147]	289	INTEGER, INTENT(IN), OPTIONAL :: master_output_rank !< MPI rank executing tasks which must
	290	!> be executed by a single PE only
	291	INTEGER, INTENT(IN) :: mpi_comm_of_output_group !< MPI communicator specifying the MPI group
	292	!> which participate in the output
	293	INTEGER, INTENT(IN) :: program_debug_output_unit !< file unit number for debug output
[4107]	294
[4147]	295	LOGICAL, INTENT(IN) :: debug_output !< if true, debug output is printed
[4070]	296
	297
[4147]	298	IF ( PRESENT( file_suffix_of_output_group ) ) output_file_suffix = file_suffix_of_output_group
	299	IF ( PRESENT( master_output_rank ) ) master_rank = master_output_rank
[4107]	300
[4147]	301	output_group_comm = mpi_comm_of_output_group
[4107]	302
[4147]	303	debug_output_unit = program_debug_output_unit
	304	print_debug_output = debug_output
[4070]	305
[4147]	306	CALL binary_init_module( output_file_suffix, output_group_comm, master_rank, &
	307	debug_output_unit, debug_output, no_id )
[4070]	308
[4147]	309	CALL netcdf4_init_module( output_file_suffix, output_group_comm, master_rank, &
	310	debug_output_unit, debug_output, no_id )
[4070]	311
[4147]	312	END SUBROUTINE dom_init
[4070]	313
	314	!--------------------------------------------------------------------------------------------------!
	315	! Description:
	316	! ------------
	317	!> Define output file.
[4141]	318	!> Example call:
	319	!> status = dom_def_file( 'my_output_file_name', 'binary' )
[4070]	320	!--------------------------------------------------------------------------------------------------!
[4147]	321	FUNCTION dom_def_file( file_name, file_format ) RESULT( return_value )
[4070]	322
[4577]	323	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_file' !< name of this routine
	324
[4147]	325	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file to be created
	326	CHARACTER(LEN=*), INTENT(IN) :: file_format !< format of file to be created
[4070]	327
[4147]	328	INTEGER :: f !< loop index
	329	INTEGER :: return_value !< return value
[4070]	330
[4147]	331	TYPE(file_type), DIMENSION(:), ALLOCATABLE :: files_tmp !< temporary file list
[4070]	332
	333
[4147]	334	return_value = 0
[4070]	335
[4147]	336	CALL internal_message( 'debug', routine_name // ': define file "' // TRIM( file_name ) // '"' )
	337	!
	338	!-- Allocate file list or extend it by 1
	339	IF ( .NOT. ALLOCATED( files ) ) THEN
[4116]	340
[4147]	341	nfiles = 1
	342	ALLOCATE( files(nfiles) )
[4070]	343
[4147]	344	ELSE
[4070]	345
[4147]	346	nfiles = SIZE( files )
	347	!
	348	!-- Check if file already exists
	349	DO f = 1, nfiles
	350	IF ( files(f)%name == TRIM( file_name ) ) THEN
	351	return_value = 1
	352	CALL internal_message( 'error', routine_name // &
	353	': file "' // TRIM( file_name ) // '" already exists' )
	354	EXIT
	355	ENDIF
	356	ENDDO
	357	!
	358	!-- Extend file list
	359	IF ( return_value == 0 ) THEN
	360	ALLOCATE( files_tmp(nfiles) )
	361	files_tmp = files
	362	DEALLOCATE( files )
	363	nfiles = nfiles + 1
	364	ALLOCATE( files(nfiles) )
	365	files(:nfiles-1) = files_tmp
	366	DEALLOCATE( files_tmp )
	367	ENDIF
[4070]	368
[4147]	369	ENDIF
	370	!
	371	!-- Add new file to database
	372	IF ( return_value == 0 ) THEN
	373	files(nfiles)%name = TRIM( file_name )
	374	files(nfiles)%format = TRIM( file_format )
	375	ENDIF
[4070]	376
[4147]	377	END FUNCTION dom_def_file
[4070]	378
	379	!--------------------------------------------------------------------------------------------------!
	380	! Description:
	381	! ------------
[4141]	382	!> Define dimension.
	383	!> Dimensions can either be limited (a lower and upper bound is given) or unlimited (only a lower
	384	!> bound is given). Also, instead of providing all values of the dimension, a single value can be
	385	!> given which is then used to fill the entire dimension.
	386	!> An optional mask can be given to mask limited dimensions.
	387	!> Example call:
	388	!> - fixed dimension with 100 entries (values known):
	389	!> status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
	390	!> output_type='real32', bounds=(/1,100/), &
	391	!> values_real32=my_dim(1:100), mask=my_dim_mask(1:100) )
	392	!> - fixed dimension with 50 entries (values not yet known):
	393	!> status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
	394	!> output_type='int32', bounds=(/0,49/), &
	395	!> values_int32=(/fill_value/) )
	396	!> - masked dimension with 75 entries:
	397	!> status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
	398	!> output_type='real64', bounds=(/101,175/), &
	399	!> values_real64=my_dim(1:75), mask=my_dim_mask(1:75) )
	400	!> - unlimited dimension:
	401	!> status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
	402	!> output_type='real32', bounds=(/1/), &
	403	!> values_real32=(/fill_value/) )
[4070]	404	!>
	405	!> @todo Convert given values into selected output_type.
	406	!--------------------------------------------------------------------------------------------------!
[4147]	407	FUNCTION dom_def_dim( file_name, dimension_name, output_type, bounds, &
	408	values_int8, values_int16, values_int32, values_intwp, &
	409	values_real32, values_real64, values_realwp, &
	410	mask ) RESULT( return_value )
[4070]	411
[4577]	412	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_dim' !< name of this routine
	413
[4147]	414	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	415	CHARACTER(LEN=*), INTENT(IN) :: dimension_name !< name of dimension
	416	CHARACTER(LEN=*), INTENT(IN) :: output_type !< data type of dimension variable in output file
[4070]	417
[4147]	418	INTEGER :: d !< loop index
	419	INTEGER :: f !< loop index
	420	INTEGER :: i !< loop index
	421	INTEGER :: j !< loop index
[4500]	422	INTEGER :: ndims = 0 !< number of dimensions in file
[4147]	423	INTEGER :: return_value !< return value
[4070]	424
[4147]	425	INTEGER, DIMENSION(:), INTENT(IN) :: bounds !< lower and upper bound of dimension variable
	426	INTEGER(KIND=1), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int8 !< values of dimension
	427	INTEGER(KIND=2), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int16 !< values of dimension
	428	INTEGER(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int32 !< values of dimension
	429	INTEGER(iwp), DIMENSION(:), INTENT(IN), OPTIONAL :: values_intwp !< values of dimension
[4070]	430
[4147]	431	LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: mask !< mask of dimesion
[4070]	432
[4147]	433	REAL(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL :: values_real32 !< values of dimension
	434	REAL(KIND=8), DIMENSION(:), INTENT(IN), OPTIONAL :: values_real64 !< values of dimension
	435	REAL(wp), DIMENSION(:), INTENT(IN), OPTIONAL :: values_realwp !< values of dimension
[4070]	436
[4147]	437	TYPE(dimension_type) :: dimension !< new dimension
	438	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimensions_tmp !< temporary dimension list
[4070]	439
	440
[4147]	441	return_value = 0
[4070]	442
[4577]	443	CALL internal_message( 'debug', routine_name // &
	444	': define dimension ' // &
	445	'(dimension "' // TRIM( dimension_name ) // &
[4147]	446	'", file "' // TRIM( file_name ) // '")' )
[4116]	447
[4147]	448	dimension%name = TRIM( dimension_name )
	449	dimension%data_type = TRIM( output_type )
	450	!
	451	!-- Check dimension bounds and allocate dimension according to bounds
	452	IF ( SIZE( bounds ) == 1 ) THEN
	453	!
[4577]	454	!-- Dimension has only lower bound, which means it changes its size during simulation.
[4147]	455	!-- Set length to -1 as indicator.
	456	dimension%bounds(:) = bounds(1)
	457	dimension%length = -1
[4070]	458
[4147]	459	IF ( PRESENT( mask ) ) THEN
	460	return_value = 1
[4577]	461	CALL internal_message( 'error', routine_name // &
	462	': unlimited dimensions cannot be masked ' // &
	463	'(dimension "' // TRIM( dimension_name ) // &
[4147]	464	'", file "' // TRIM( file_name ) // '")!' )
	465	ENDIF
[4070]	466
[4147]	467	ELSEIF ( SIZE( bounds ) == 2 ) THEN
[4070]	468
[4147]	469	dimension%bounds = bounds
	470	dimension%length = bounds(2) - bounds(1) + 1
	471	!
	472	!-- Save dimension values
	473	IF ( PRESENT( values_int8 ) ) THEN
	474	ALLOCATE( dimension%values_int8(dimension%bounds(1):dimension%bounds(2)) )
	475	IF ( SIZE( values_int8 ) == dimension%length ) THEN
	476	dimension%values_int8 = values_int8
	477	ELSEIF ( SIZE( values_int8 ) == 1 ) THEN
	478	dimension%values_int8(:) = values_int8(1)
	479	ELSE
	480	return_value = 2
	481	ENDIF
	482	ELSEIF( PRESENT( values_int16 ) ) THEN
	483	ALLOCATE( dimension%values_int16(dimension%bounds(1):dimension%bounds(2)) )
	484	IF ( SIZE( values_int16 ) == dimension%length ) THEN
	485	dimension%values_int16 = values_int16
	486	ELSEIF ( SIZE( values_int16 ) == 1 ) THEN
	487	dimension%values_int16(:) = values_int16(1)
	488	ELSE
	489	return_value = 2
	490	ENDIF
	491	ELSEIF( PRESENT( values_int32 ) ) THEN
	492	ALLOCATE( dimension%values_int32(dimension%bounds(1):dimension%bounds(2)) )
	493	IF ( SIZE( values_int32 ) == dimension%length ) THEN
	494	dimension%values_int32 = values_int32
	495	ELSEIF ( SIZE( values_int32 ) == 1 ) THEN
	496	dimension%values_int32(:) = values_int32(1)
	497	ELSE
	498	return_value = 2
	499	ENDIF
	500	ELSEIF( PRESENT( values_intwp ) ) THEN
	501	ALLOCATE( dimension%values_intwp(dimension%bounds(1):dimension%bounds(2)) )
	502	IF ( SIZE( values_intwp ) == dimension%length ) THEN
	503	dimension%values_intwp = values_intwp
	504	ELSEIF ( SIZE( values_intwp ) == 1 ) THEN
	505	dimension%values_intwp(:) = values_intwp(1)
	506	ELSE
	507	return_value = 2
	508	ENDIF
	509	ELSEIF( PRESENT( values_real32 ) ) THEN
	510	ALLOCATE( dimension%values_real32(dimension%bounds(1):dimension%bounds(2)) )
	511	IF ( SIZE( values_real32 ) == dimension%length ) THEN
	512	dimension%values_real32 = values_real32
	513	ELSEIF ( SIZE( values_real32 ) == 1 ) THEN
	514	dimension%values_real32(:) = values_real32(1)
	515	ELSE
	516	return_value = 2
	517	ENDIF
	518	ELSEIF( PRESENT( values_real64 ) ) THEN
	519	ALLOCATE( dimension%values_real64(dimension%bounds(1):dimension%bounds(2)) )
	520	IF ( SIZE( values_real64 ) == dimension%length ) THEN
	521	dimension%values_real64 = values_real64
	522	ELSEIF ( SIZE( values_real64 ) == 1 ) THEN
	523	dimension%values_real64(:) = values_real64(1)
	524	ELSE
	525	return_value = 2
	526	ENDIF
	527	ELSEIF( PRESENT( values_realwp ) ) THEN
	528	ALLOCATE( dimension%values_realwp(dimension%bounds(1):dimension%bounds(2)) )
	529	IF ( SIZE( values_realwp ) == dimension%length ) THEN
	530	dimension%values_realwp = values_realwp
	531	ELSEIF ( SIZE( values_realwp ) == 1 ) THEN
	532	dimension%values_realwp(:) = values_realwp(1)
	533	ELSE
	534	return_value = 2
	535	ENDIF
	536	ELSE
	537	return_value = 1
[4577]	538	CALL internal_message( 'error', routine_name // &
	539	': no values given ' // &
	540	'(dimension "' // TRIM( dimension_name ) // &
[4147]	541	'", file "' // TRIM( file_name ) // '")!' )
	542	ENDIF
[4070]	543
[4147]	544	IF ( return_value == 2 ) THEN
	545	return_value = 1
[4577]	546	CALL internal_message( 'error', routine_name // &
	547	': number of values and given bounds do not match ' // &
	548	'(dimension "' // TRIM( dimension_name ) // &
[4147]	549	'", file "' // TRIM( file_name ) // '")!' )
	550	ENDIF
	551	!
	552	!-- Initialize mask
	553	IF ( PRESENT( mask ) .AND. return_value == 0 ) THEN
[4070]	554
[4147]	555	IF ( dimension%length == SIZE( mask ) ) THEN
[4070]	556
[4147]	557	IF ( ALL( mask ) ) THEN
[4070]	558
[4577]	559	CALL internal_message( 'debug', routine_name // &
	560	': mask contains only TRUE values. Ignoring mask ' // &
	561	'(dimension "' // TRIM( dimension_name ) // &
[4147]	562	'", file "' // TRIM( file_name ) // '")!' )
[4070]	563
[4147]	564	ELSE
[4070]	565
[4147]	566	dimension%is_masked = .TRUE.
	567	dimension%length_mask = COUNT( mask )
[4070]	568
[4147]	569	ALLOCATE( dimension%mask(dimension%bounds(1):dimension%bounds(2)) )
	570	ALLOCATE( dimension%masked_indices(0:dimension%length_mask-1) )
[4070]	571
[4147]	572	dimension%mask = mask
	573	!
	574	!-- Save masked positions and masked values
	575	IF ( ALLOCATED( dimension%values_int8 ) ) THEN
[4070]	576
[4147]	577	ALLOCATE( dimension%masked_values_int8(0:dimension%length_mask-1) )
	578	j = 0
	579	DO i = dimension%bounds(1), dimension%bounds(2)
	580	IF ( dimension%mask(i) ) THEN
	581	dimension%masked_values_int8(j) = dimension%values_int8(i)
	582	dimension%masked_indices(j) = i
	583	j = j + 1
	584	ENDIF
	585	ENDDO
[4070]	586
[4147]	587	ELSEIF ( ALLOCATED( dimension%values_int16 ) ) THEN
[4070]	588
[4147]	589	ALLOCATE( dimension%masked_values_int16(0:dimension%length_mask-1) )
	590	j = 0
	591	DO i = dimension%bounds(1), dimension%bounds(2)
	592	IF ( dimension%mask(i) ) THEN
	593	dimension%masked_values_int16(j) = dimension%values_int16(i)
	594	dimension%masked_indices(j) = i
	595	j = j + 1
	596	ENDIF
	597	ENDDO
[4070]	598
[4147]	599	ELSEIF ( ALLOCATED( dimension%values_int32 ) ) THEN
[4070]	600
[4147]	601	ALLOCATE( dimension%masked_values_int32(0:dimension%length_mask-1) )
	602	j = 0
[4577]	603	DO i = dimension%bounds(1), dimension%bounds(2)
[4147]	604	IF ( dimension%mask(i) ) THEN
	605	dimension%masked_values_int32(j) = dimension%values_int32(i)
	606	dimension%masked_indices(j) = i
	607	j = j + 1
	608	ENDIF
	609	ENDDO
[4070]	610
[4147]	611	ELSEIF ( ALLOCATED( dimension%values_intwp ) ) THEN
[4070]	612
[4147]	613	ALLOCATE( dimension%masked_values_intwp(0:dimension%length_mask-1) )
	614	j = 0
	615	DO i = dimension%bounds(1), dimension%bounds(2)
	616	IF ( dimension%mask(i) ) THEN
	617	dimension%masked_values_intwp(j) = dimension%values_intwp(i)
	618	dimension%masked_indices(j) = i
	619	j = j + 1
	620	ENDIF
	621	ENDDO
[4070]	622
[4147]	623	ELSEIF ( ALLOCATED( dimension%values_real32 ) ) THEN
[4070]	624
[4147]	625	ALLOCATE( dimension%masked_values_real32(0:dimension%length_mask-1) )
	626	j = 0
	627	DO i = dimension%bounds(1), dimension%bounds(2)
	628	IF ( dimension%mask(i) ) THEN
	629	dimension%masked_values_real32(j) = dimension%values_real32(i)
	630	dimension%masked_indices(j) = i
	631	j = j + 1
	632	ENDIF
	633	ENDDO
[4070]	634
[4147]	635	ELSEIF ( ALLOCATED(dimension%values_real64) ) THEN
[4070]	636
[4147]	637	ALLOCATE( dimension%masked_values_real64(0:dimension%length_mask-1) )
	638	j = 0
	639	DO i = dimension%bounds(1), dimension%bounds(2)
	640	IF ( dimension%mask(i) ) THEN
	641	dimension%masked_values_real64(j) = dimension%values_real64(i)
	642	dimension%masked_indices(j) = i
	643	j = j + 1
	644	ENDIF
	645	ENDDO
[4070]	646
[4147]	647	ELSEIF ( ALLOCATED(dimension%values_realwp) ) THEN
[4070]	648
[4147]	649	ALLOCATE( dimension%masked_values_realwp(0:dimension%length_mask-1) )
	650	j = 0
	651	DO i = dimension%bounds(1), dimension%bounds(2)
	652	IF ( dimension%mask(i) ) THEN
	653	dimension%masked_values_realwp(j) = dimension%values_realwp(i)
	654	dimension%masked_indices(j) = i
	655	j = j + 1
	656	ENDIF
	657	ENDDO
[4070]	658
[4147]	659	ENDIF
[4070]	660
[4147]	661	ENDIF ! if not all mask = true
[4070]	662
[4147]	663	ELSE
	664	return_value = 1
[4577]	665	CALL internal_message( 'error', routine_name // &
	666	': size of mask and given bounds do not match ' // &
	667	'(dimension "' // TRIM( dimension_name ) // &
[4147]	668	'", file "' // TRIM( file_name ) // '")!' )
	669	ENDIF
[4070]	670
[4147]	671	ENDIF
[4141]	672
[4147]	673	ELSE
[4141]	674
[4147]	675	return_value = 1
[4577]	676	CALL internal_message( 'error', routine_name // &
	677	': at least one but no more than two bounds must be given ' // &
	678	'(dimension "' // TRIM( dimension_name ) // &
[4147]	679	'", file "' // TRIM( file_name ) // '")!' )
[4141]	680
[4147]	681	ENDIF
	682	!
	683	!-- Add dimension to database
	684	IF ( return_value == 0 ) THEN
[4141]	685
[4147]	686	DO f = 1, nfiles
[4070]	687
[4147]	688	IF ( TRIM( file_name ) == files(f)%name ) THEN
[4070]	689
[4147]	690	IF ( files(f)%is_init ) THEN
[4070]	691
[4147]	692	return_value = 1
[4577]	693	CALL internal_message( 'error', routine_name // &
	694	': file already initialized. ' // &
	695	'No further dimension definition allowed ' // &
	696	'(dimension "' // TRIM( dimension_name ) // &
[4147]	697	'", file "' // TRIM( file_name ) // '")!' )
	698	EXIT
[4070]	699
[4147]	700	ELSEIF ( .NOT. ALLOCATED( files(f)%dimensions ) ) THEN
[4070]	701
[4147]	702	ndims = 1
	703	ALLOCATE( files(f)%dimensions(ndims) )
[4070]	704
[4147]	705	ELSE
	706	!
	707	!-- Check if any variable of the same name as the new dimension is already defined
	708	IF ( ALLOCATED( files(f)%variables ) ) THEN
	709	DO i = 1, SIZE( files(f)%variables )
	710	IF ( files(f)%variables(i)%name == dimension%name ) THEN
	711	return_value = 1
[4577]	712	CALL internal_message( 'error', routine_name // &
	713	': file already has a variable of this name defined. ' // &
	714	'Defining a dimension of the same name is not allowed ' // &
	715	'(dimension "' // TRIM( dimension_name ) // &
	716	'", file "' // TRIM( file_name ) // '")!' )
[4147]	717	EXIT
	718	ENDIF
	719	ENDDO
	720	ENDIF
[4070]	721
[4147]	722	IF ( return_value == 0 ) THEN
	723	!
	724	!-- Check if dimension already exists in file
	725	ndims = SIZE( files(f)%dimensions )
[4070]	726
[4147]	727	DO d = 1, ndims
	728	IF ( files(f)%dimensions(d)%name == dimension%name ) THEN
	729	return_value = 1
[4577]	730	CALL internal_message( 'error', routine_name // &
	731	': dimension already exists in file ' // &
	732	'(dimension "' // TRIM( dimension_name ) // &
	733	'", file "' // TRIM( file_name ) // '")!' )
[4147]	734	EXIT
	735	ENDIF
	736	ENDDO
	737	!
	738	!-- Extend dimension list
	739	IF ( return_value == 0 ) THEN
	740	ALLOCATE( dimensions_tmp(ndims) )
	741	dimensions_tmp = files(f)%dimensions
	742	DEALLOCATE( files(f)%dimensions )
	743	ndims = ndims + 1
	744	ALLOCATE( files(f)%dimensions(ndims) )
	745	files(f)%dimensions(:ndims-1) = dimensions_tmp
	746	DEALLOCATE( dimensions_tmp )
	747	ENDIF
	748	ENDIF
[4070]	749
[4147]	750	ENDIF
	751	!
	752	!-- Add new dimension to database
	753	IF ( return_value == 0 ) files(f)%dimensions(ndims) = dimension
[4106]	754
[4147]	755	EXIT
[4106]	756
[4147]	757	ENDIF
	758	ENDDO
[4070]	759
[4147]	760	IF ( f > nfiles ) THEN
	761	return_value = 1
[4577]	762	CALL internal_message( 'error', routine_name // &
	763	': file not found (dimension "' // TRIM( dimension_name ) // &
[4147]	764	'", file "' // TRIM( file_name ) // '")!' )
	765	ENDIF
[4070]	766
[4147]	767	ENDIF
[4070]	768
[4147]	769	END FUNCTION dom_def_dim
[4106]	770
[4070]	771	!--------------------------------------------------------------------------------------------------!
	772	! Description:
	773	! ------------
	774	!> Add variable to database.
[4141]	775	!> If a variable is identical for each MPI rank, the optional argument 'is_global' should be set to
[4577]	776	!> .TRUE. This flags the variable to be a global variable and is later only written once by the
[4141]	777	!> master output rank.
[4123]	778	!> Example call:
[4141]	779	!> dom_def_var( file_name = 'my_output_file_name', &
	780	!> variable_name = 'u', &
[4123]	781	!> dimension_names = (/'x ', 'y ', 'z ', 'time'/), &
	782	!> output_type = 'real32' )
	783	!> @note The order of dimensions must match in reversed order to the dimensions of the
	784	!> corresponding variable array. The last given dimension can also be non-existent within the
	785	!> variable array if at any given call of 'dom_write_var' for this variable, the last
	786	!> dimension has only a single index.
	787	!> Hence, the array 'u' must be allocated with dimension 'x' as its last dimension, preceded
	788	!> by 'y', then 'z', and 'time' being the first dimension. If at any given write statement,
	789	!> only a single index of dimension 'time' is to be written, the dimension can be non-present
	790	!> in the variable array leaving dimension 'z' as the first dimension.
	791	!> So, the variable array needs to be allocated like either:
	792	!> ALLOCATE( u(<time>,<z>,<y>,<x>) )
	793	!> or
	794	!> ALLOCATE( u(<z>,<y>,<x>) )
[4070]	795	!--------------------------------------------------------------------------------------------------!
[4577]	796	FUNCTION dom_def_var( file_name, variable_name, dimension_names, output_type, is_global ) &
[4147]	797	RESULT( return_value )
[4070]	798
[4577]	799	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_var' !< name of this routine
	800
[4147]	801	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
[4577]	802	CHARACTER(LEN=*), INTENT(IN) :: output_type !< data type of variable
[4147]	803	CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable
[4070]	804
[4147]	805	CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: dimension_names !< list of dimension names
[4070]	806
[4147]	807	INTEGER :: d !< loop index
	808	INTEGER :: f !< loop index
	809	INTEGER :: i !< loop index
	810	INTEGER :: nvars !< number of variables in file
	811	INTEGER :: return_value !< return value
[4070]	812
[4147]	813	LOGICAL :: found !< true if requested dimension is defined in file
	814	LOGICAL, INTENT(IN), OPTIONAL :: is_global !< true if variable is global (same on all PE)
[4070]	815
[4147]	816	TYPE(variable_type) :: variable !< new variable
	817	TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variables_tmp !< temporary variable list
[4070]	818
	819
[4147]	820	return_value = 0
	821	found = .FALSE.
[4070]	822
[4577]	823	CALL internal_message( 'debug', routine_name // &
	824	': define variable (variable "' // TRIM( variable_name ) // &
[4147]	825	'", file "' // TRIM( file_name ) // '")' )
[4116]	826
[4147]	827	variable%name = TRIM( variable_name )
[4070]	828
[4147]	829	ALLOCATE( variable%dimension_names(SIZE( dimension_names )) )
	830	ALLOCATE( variable%dimension_ids(SIZE( dimension_names )) )
[4070]	831
[4147]	832	variable%dimension_names = dimension_names
	833	variable%dimension_ids = -1
	834	variable%data_type = TRIM( output_type )
[4070]	835
[4147]	836	IF ( PRESENT( is_global ) ) THEN
	837	variable%is_global = is_global
	838	ELSE
	839	variable%is_global = .FALSE.
	840	ENDIF
	841	!
	842	!-- Add variable to database
	843	DO f = 1, nfiles
[4070]	844
[4147]	845	IF ( TRIM( file_name ) == files(f)%name ) THEN
[4070]	846
[4147]	847	IF ( files(f)%is_init ) THEN
[4070]	848
[4147]	849	return_value = 1
[4577]	850	CALL internal_message( 'error', routine_name // &
	851	': file already initialized. No further variable definition allowed ' // &
	852	'(variable "' // TRIM( variable_name ) // &
	853	'", file "' // TRIM( file_name ) // '")!' )
[4147]	854	EXIT
[4070]	855
[4147]	856	ELSEIF ( ALLOCATED( files(f)%dimensions ) ) THEN
	857	!
	858	!-- Check if any dimension of the same name as the new variable is already defined
	859	DO d = 1, SIZE( files(f)%dimensions )
	860	IF ( files(f)%dimensions(d)%name == variable%name ) THEN
	861	return_value = 1
[4577]	862	CALL internal_message( 'error', routine_name // &
	863	': file already has a dimension of this name defined. ' // &
	864	'Defining a variable of the same name is not allowed ' // &
	865	'(variable "' // TRIM( variable_name ) // &
	866	'", file "' // TRIM( file_name ) // '")!' )
[4147]	867	EXIT
	868	ENDIF
	869	ENDDO
	870	!
	871	!-- Check if dimensions assigned to variable are defined within file
	872	IF ( return_value == 0 ) THEN
	873	DO i = 1, SIZE( variable%dimension_names )
	874	found = .FALSE.
	875	DO d = 1, SIZE( files(f)%dimensions )
	876	IF ( files(f)%dimensions(d)%name == variable%dimension_names(i) ) THEN
	877	found = .TRUE.
	878	EXIT
	879	ENDIF
	880	ENDDO
	881	IF ( .NOT. found ) THEN
	882	return_value = 1
[4577]	883	CALL internal_message( 'error', routine_name // &
	884	': required dimension "'// TRIM( variable%dimension_names(i) ) // &
	885	'" for variable is not defined ' // &
	886	'(variable "' // TRIM( variable_name ) // &
	887	'", file "' // TRIM( file_name ) // '")!' )
[4147]	888	EXIT
	889	ENDIF
	890	ENDDO
	891	ENDIF
[4106]	892
[4147]	893	ELSE
[4106]	894
[4147]	895	return_value = 1
[4577]	896	CALL internal_message( 'error', routine_name // &
	897	': no dimensions defined in file. Cannot define variable '// &
	898	'(variable "' // TRIM( variable_name ) // &
	899	'", file "' // TRIM( file_name ) // '")!' )
[4070]	900
[4147]	901	ENDIF
[4106]	902
[4147]	903	IF ( return_value == 0 ) THEN
	904	!
	905	!-- Check if variable already exists
	906	IF ( .NOT. ALLOCATED( files(f)%variables ) ) THEN
[4070]	907
[4147]	908	nvars = 1
	909	ALLOCATE( files(f)%variables(nvars) )
[4070]	910
[4147]	911	ELSE
[4070]	912
[4147]	913	nvars = SIZE( files(f)%variables )
	914	DO i = 1, nvars
	915	IF ( files(f)%variables(i)%name == variable%name ) THEN
	916	return_value = 1
[4577]	917	CALL internal_message( 'error', routine_name // &
	918	': variable already exists '// &
	919	'(variable "' // TRIM( variable_name ) // &
	920	'", file "' // TRIM( file_name ) // '")!' )
[4147]	921	EXIT
	922	ENDIF
	923	ENDDO
[4070]	924
[4147]	925	IF ( return_value == 0 ) THEN
	926	!
	927	!-- Extend variable list
	928	ALLOCATE( variables_tmp(nvars) )
	929	variables_tmp = files(f)%variables
	930	DEALLOCATE( files(f)%variables )
	931	nvars = nvars + 1
	932	ALLOCATE( files(f)%variables(nvars) )
	933	files(f)%variables(:nvars-1) = variables_tmp
	934	DEALLOCATE( variables_tmp )
	935	ENDIF
[4070]	936
[4147]	937	ENDIF
	938	!
	939	!-- Add new variable to database
	940	IF ( return_value == 0 ) files(f)%variables(nvars) = variable
[4070]	941
[4147]	942	ENDIF
[4070]	943
[4147]	944	EXIT
[4070]	945
[4147]	946	ENDIF
[4070]	947
[4147]	948	ENDDO
[4070]	949
[4147]	950	IF ( f > nfiles ) THEN
	951	return_value = 1
[4577]	952	CALL internal_message( 'error', routine_name // &
	953	': file not found (variable "' // TRIM( variable_name ) // &
[4147]	954	'", file "' // TRIM( file_name ) // '")!' )
	955	ENDIF
[4070]	956
[4147]	957	END FUNCTION dom_def_var
[4070]	958
	959	!--------------------------------------------------------------------------------------------------!
	960	! Description:
	961	! ------------
	962	!> Create attribute with value of type character.
[4141]	963	!> If the optional argument 'variable_name' is given, the attribute is added to the respective
	964	!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
	965	!> the file itself.
	966	!> If an attribute of similar name already exists, it is updated (overwritten) with the new value.
	967	!> If the optional argument 'append' is set TRUE, the value of an already existing attribute of
	968	!> similar name is appended by the new value instead of overwritten.
	969	!> Example call:
	970	!> - define a global file attribute:
	971	!> dom_def_att( file_name='my_output_file_name', &
	972	!> attribute_name='my_attribute', &
	973	!> value='This is the attribute value' )
	974	!> - define a variable attribute:
	975	!> dom_def_att( file_name='my_output_file_name', &
	976	!> variable_name='my_variable', &
	977	!> attribute_name='my_attribute', &
	978	!> value='This is the attribute value' )
	979	!> - append an attribute:
	980	!> dom_def_att( file_name='my_output_file_name', &
	981	!> attribute_name='my_attribute', &
	982	!> value=' and this part was appended', append=.TRUE. )
[4070]	983	!--------------------------------------------------------------------------------------------------!
[4147]	984	FUNCTION dom_def_att_char( file_name, variable_name, attribute_name, value, append ) &
	985	RESULT( return_value )
[4070]	986
[4577]	987	CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute
[4147]	988	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	989	CHARACTER(LEN=*), INTENT(IN) :: value !< attribute value
	990	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: variable_name !< name of variable
	991	CHARACTER(LEN=charlen) :: variable_name_internal !< internal copy of variable_name
[4070]	992
[4147]	993	! CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_char' !< name of routine
[4070]	994
[4147]	995	INTEGER :: return_value !< return value
[4070]	996
[4147]	997	LOGICAL :: append_internal !< same as 'append'
	998	LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value
[4070]	999
[4147]	1000	TYPE(attribute_type) :: attribute !< new attribute
[4070]	1001
	1002
[4147]	1003	return_value = 0
[4070]	1004
[4147]	1005	IF ( PRESENT( append ) ) THEN
	1006	append_internal = append
	1007	ELSE
	1008	append_internal = .FALSE.
	1009	ENDIF
[4070]	1010
[4147]	1011	attribute%name = TRIM( attribute_name )
	1012	attribute%data_type = 'char'
	1013	attribute%value_char = TRIM( value )
[4070]	1014
[4147]	1015	IF ( PRESENT( variable_name ) ) THEN
	1016	variable_name_internal = TRIM( variable_name )
	1017	ELSE
	1018	variable_name_internal = ''
	1019	ENDIF
[4070]	1020
[4577]	1021	return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
	1022	variable_name=TRIM( variable_name_internal ), &
	1023	attribute=attribute, append=append_internal )
[4141]	1024
[4147]	1025	END FUNCTION dom_def_att_char
[4070]	1026
	1027	!--------------------------------------------------------------------------------------------------!
	1028	! Description:
	1029	! ------------
	1030	!> Create attribute with value of type int8.
[4141]	1031	!> If the optional argument 'variable_name' is given, the attribute is added to the respective
	1032	!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
	1033	!> the file itself.
	1034	!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
	1035	!> Example call:
	1036	!> - define a global file attribute:
	1037	!> dom_def_att( file_name='my_output_file_name', &
	1038	!> attribute_name='my_attribute', &
	1039	!> value=0_1 )
	1040	!> - define a variable attribute:
	1041	!> dom_def_att( file_name='my_output_file_name', &
	1042	!> variable_name='my_variable', &
	1043	!> attribute_name='my_attribute', &
	1044	!> value=1_1 )
[4070]	1045	!--------------------------------------------------------------------------------------------------!
[4577]	1046	FUNCTION dom_def_att_int8( file_name, variable_name, attribute_name, value, append ) &
[4147]	1047	RESULT( return_value )
[4070]	1048
[4577]	1049	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_int8' !< name of routine
	1050
	1051	CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute
[4147]	1052	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	1053	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: variable_name !< name of variable
	1054	CHARACTER(LEN=charlen) :: variable_name_internal !< internal copy of variable_name
[4070]	1055
[4147]	1056	INTEGER(KIND=1), INTENT(IN) :: value !< attribute value
[4070]	1057
[4147]	1058	INTEGER :: return_value !< return value
[4070]	1059
[4147]	1060	LOGICAL :: append_internal !< same as 'append'
	1061	LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value
[4070]	1062
[4147]	1063	TYPE(attribute_type) :: attribute !< new attribute
[4070]	1064
	1065
[4147]	1066	return_value = 0
[4070]	1067
[4147]	1068	IF ( PRESENT( variable_name ) ) THEN
	1069	variable_name_internal = TRIM( variable_name )
	1070	ELSE
	1071	variable_name_internal = ''
	1072	ENDIF
[4141]	1073
[4147]	1074	IF ( PRESENT( append ) ) THEN
	1075	IF ( append ) THEN
	1076	return_value = 1
[4577]	1077	CALL internal_message( 'error', routine_name // &
	1078	': numeric attribute cannot be appended ' // &
	1079	'(attribute "' // TRIM( attribute_name ) // &
	1080	'", variable "' // TRIM( variable_name_internal ) // &
[4147]	1081	'", file "' // TRIM( file_name ) // '")!' )
	1082	ENDIF
	1083	ENDIF
[4070]	1084
[4147]	1085	IF ( return_value == 0 ) THEN
	1086	append_internal = .FALSE.
[4070]	1087
[4147]	1088	attribute%name = TRIM( attribute_name )
	1089	attribute%data_type = 'int8'
	1090	attribute%value_int8 = value
[4070]	1091
[4577]	1092	return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
	1093	variable_name=TRIM( variable_name_internal ), &
	1094	attribute=attribute, append=append_internal )
[4147]	1095	ENDIF
[4070]	1096
[4147]	1097	END FUNCTION dom_def_att_int8
[4070]	1098
	1099	!--------------------------------------------------------------------------------------------------!
	1100	! Description:
	1101	! ------------
	1102	!> Create attribute with value of type int16.
[4141]	1103	!> If the optional argument 'variable_name' is given, the attribute is added to the respective
	1104	!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
	1105	!> the file itself.
	1106	!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
	1107	!> Example call:
	1108	!> - define a global file attribute:
	1109	!> dom_def_att( file_name='my_output_file_name', &
	1110	!> attribute_name='my_attribute', &
	1111	!> value=0_2 )
	1112	!> - define a variable attribute:
	1113	!> dom_def_att( file_name='my_output_file_name', &
	1114	!> variable_name='my_variable', &
	1115	!> attribute_name='my_attribute', &
	1116	!> value=1_2 )
[4070]	1117	!--------------------------------------------------------------------------------------------------!
[4577]	1118	FUNCTION dom_def_att_int16( file_name, variable_name, attribute_name, value, append ) &
[4147]	1119	RESULT( return_value )
[4070]	1120
[4577]	1121	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_int16' !< name of routine
	1122
	1123	CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute
[4147]	1124	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	1125	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: variable_name !< name of variable
	1126	CHARACTER(LEN=charlen) :: variable_name_internal !< internal copy of variable_name
[4070]	1127
[4147]	1128	INTEGER(KIND=2), INTENT(IN) :: value !< attribute value
[4070]	1129
[4147]	1130	INTEGER :: return_value !< return value
[4070]	1131
[4147]	1132	LOGICAL :: append_internal !< same as 'append'
	1133	LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value
[4070]	1134
[4147]	1135	TYPE(attribute_type) :: attribute !< new attribute
[4070]	1136
	1137
[4147]	1138	return_value = 0
[4070]	1139
[4147]	1140	IF ( PRESENT( variable_name ) ) THEN
	1141	variable_name_internal = TRIM( variable_name )
	1142	ELSE
	1143	variable_name_internal = ''
	1144	ENDIF
[4141]	1145
[4147]	1146	IF ( PRESENT( append ) ) THEN
	1147	IF ( append ) THEN
	1148	return_value = 1
[4577]	1149	CALL internal_message( 'error', routine_name // &
	1150	': numeric attribute cannot be appended ' // &
	1151	'(attribute "' // TRIM( attribute_name ) // &
	1152	'", variable "' // TRIM( variable_name_internal ) // &
[4147]	1153	'", file "' // TRIM( file_name ) // '")!' )
	1154	ENDIF
	1155	ENDIF
[4070]	1156
[4147]	1157	IF ( return_value == 0 ) THEN
	1158	append_internal = .FALSE.
[4070]	1159
[4147]	1160	attribute%name = TRIM( attribute_name )
	1161	attribute%data_type = 'int16'
	1162	attribute%value_int16 = value
[4070]	1163
[4577]	1164	return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
	1165	variable_name=TRIM( variable_name_internal ), &
	1166	attribute=attribute, append=append_internal )
[4147]	1167	ENDIF
[4070]	1168
[4147]	1169	END FUNCTION dom_def_att_int16
[4070]	1170
	1171	!--------------------------------------------------------------------------------------------------!
	1172	! Description:
	1173	! ------------
	1174	!> Create attribute with value of type int32.
[4141]	1175	!> If the optional argument 'variable_name' is given, the attribute is added to the respective
	1176	!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
	1177	!> the file itself.
	1178	!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
	1179	!> Example call:
	1180	!> - define a global file attribute:
	1181	!> dom_def_att( file_name='my_output_file_name', &
	1182	!> attribute_name='my_attribute', &
	1183	!> value=0_4 )
	1184	!> - define a variable attribute:
	1185	!> dom_def_att( file_name='my_output_file_name', &
	1186	!> variable_name='my_variable', &
	1187	!> attribute_name='my_attribute', &
	1188	!> value=1_4 )
[4070]	1189	!--------------------------------------------------------------------------------------------------!
[4577]	1190	FUNCTION dom_def_att_int32( file_name, variable_name, attribute_name, value, append ) &
[4147]	1191	RESULT( return_value )
[4070]	1192
[4577]	1193	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_int32' !< name of routine
	1194
	1195
	1196	CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute
[4147]	1197	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	1198	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: variable_name !< name of variable
	1199	CHARACTER(LEN=charlen) :: variable_name_internal !< internal copy of variable_name
[4070]	1200
[4147]	1201	INTEGER(KIND=4), INTENT(IN) :: value !< attribute value
[4070]	1202
[4147]	1203	INTEGER :: return_value !< return value
[4070]	1204
[4147]	1205	LOGICAL :: append_internal !< same as 'append'
	1206	LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value
[4070]	1207
[4147]	1208	TYPE(attribute_type) :: attribute !< new attribute
[4070]	1209
	1210
[4147]	1211	return_value = 0
[4070]	1212
[4147]	1213	IF ( PRESENT( variable_name ) ) THEN
	1214	variable_name_internal = TRIM( variable_name )
	1215	ELSE
	1216	variable_name_internal = ''
	1217	ENDIF
[4141]	1218
[4147]	1219	IF ( PRESENT( append ) ) THEN
	1220	IF ( append ) THEN
	1221	return_value = 1
[4577]	1222	CALL internal_message( 'error', routine_name // &
	1223	': numeric attribute cannot be appended ' // &
	1224	'(attribute "' // TRIM( attribute_name ) // &
	1225	'", variable "' // TRIM( variable_name_internal ) // &
[4147]	1226	'", file "' // TRIM( file_name ) // '")!' )
	1227	ENDIF
	1228	ENDIF
[4070]	1229
[4147]	1230	IF ( return_value == 0 ) THEN
	1231	append_internal = .FALSE.
[4070]	1232
[4147]	1233	attribute%name = TRIM( attribute_name )
	1234	attribute%data_type = 'int32'
	1235	attribute%value_int32 = value
[4070]	1236
[4577]	1237	return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
	1238	variable_name=TRIM( variable_name_internal ), &
	1239	attribute=attribute, append=append_internal )
[4147]	1240	ENDIF
[4070]	1241
[4147]	1242	END FUNCTION dom_def_att_int32
[4070]	1243
	1244	!--------------------------------------------------------------------------------------------------!
	1245	! Description:
	1246	! ------------
	1247	!> Create attribute with value of type real32.
[4141]	1248	!> If the optional argument 'variable_name' is given, the attribute is added to the respective
	1249	!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
	1250	!> the file itself.
	1251	!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
	1252	!> Example call:
	1253	!> - define a global file attribute:
	1254	!> dom_def_att( file_name='my_output_file_name', &
	1255	!> attribute_name='my_attribute', &
	1256	!> value=1.0_4 )
	1257	!> - define a variable attribute:
	1258	!> dom_def_att( file_name='my_output_file_name', &
	1259	!> variable_name='my_variable', &
	1260	!> attribute_name='my_attribute', &
	1261	!> value=1.0_4 )
[4070]	1262	!--------------------------------------------------------------------------------------------------!
[4577]	1263	FUNCTION dom_def_att_real32( file_name, variable_name, attribute_name, value, append ) &
[4147]	1264	RESULT( return_value )
[4070]	1265
[4577]	1266	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_real32' !< name of routine
	1267
	1268	CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute
[4147]	1269	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	1270	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: variable_name !< name of variable
	1271	CHARACTER(LEN=charlen) :: variable_name_internal !< internal copy of variable_name
[4070]	1272
[4147]	1273	INTEGER :: return_value !< return value
[4070]	1274
[4147]	1275	LOGICAL :: append_internal !< same as 'append'
	1276	LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value
[4070]	1277
[4147]	1278	REAL(KIND=4), INTENT(IN) :: value !< attribute value
[4070]	1279
[4147]	1280	TYPE(attribute_type) :: attribute !< new attribute
[4070]	1281
	1282
[4147]	1283	return_value = 0
[4070]	1284
[4147]	1285	IF ( PRESENT( variable_name ) ) THEN
	1286	variable_name_internal = TRIM( variable_name )
	1287	ELSE
	1288	variable_name_internal = ''
	1289	ENDIF
[4141]	1290
[4147]	1291	IF ( PRESENT( append ) ) THEN
	1292	IF ( append ) THEN
	1293	return_value = 1
[4577]	1294	CALL internal_message( 'error', routine_name // &
	1295	': numeric attribute cannot be appended ' // &
	1296	'(attribute "' // TRIM( attribute_name ) // &
	1297	'", variable "' // TRIM( variable_name_internal ) // &
[4147]	1298	'", file "' // TRIM( file_name ) // '")!' )
	1299	ENDIF
	1300	ENDIF
[4070]	1301
[4147]	1302	IF ( return_value == 0 ) THEN
	1303	append_internal = .FALSE.
[4070]	1304
[4147]	1305	attribute%name = TRIM( attribute_name )
	1306	attribute%data_type = 'real32'
	1307	attribute%value_real32 = value
[4070]	1308
[4577]	1309	return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
	1310	variable_name=TRIM( variable_name_internal ), &
	1311	attribute=attribute, append=append_internal )
[4147]	1312	ENDIF
[4070]	1313
[4147]	1314	END FUNCTION dom_def_att_real32
[4070]	1315
	1316	!--------------------------------------------------------------------------------------------------!
	1317	! Description:
	1318	! ------------
	1319	!> Create attribute with value of type real64.
[4141]	1320	!> If the optional argument 'variable_name' is given, the attribute is added to the respective
	1321	!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
	1322	!> the file itself.
	1323	!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
	1324	!> Example call:
	1325	!> - define a global file attribute:
	1326	!> dom_def_att( file_name='my_output_file_name', &
	1327	!> attribute_name='my_attribute', &
	1328	!> value=0.0_8 )
	1329	!> - define a variable attribute:
	1330	!> dom_def_att( file_name='my_output_file_name', &
	1331	!> variable_name='my_variable', &
	1332	!> attribute_name='my_attribute', &
	1333	!> value=1.0_8 )
[4070]	1334	!--------------------------------------------------------------------------------------------------!
[4577]	1335	FUNCTION dom_def_att_real64( file_name, variable_name, attribute_name, value, append ) &
[4147]	1336	RESULT( return_value )
[4070]	1337
[4577]	1338	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_real64' !< name of routine
	1339
	1340	CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute
[4147]	1341	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	1342	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: variable_name !< name of variable
	1343	CHARACTER(LEN=charlen) :: variable_name_internal !< internal copy of variable_name
[4070]	1344
[4147]	1345	INTEGER :: return_value !< return value
[4070]	1346
[4147]	1347	LOGICAL :: append_internal !< same as 'append'
	1348	LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value
[4070]	1349
[4147]	1350	REAL(KIND=8), INTENT(IN) :: value !< attribute value
[4070]	1351
[4147]	1352	TYPE(attribute_type) :: attribute !< new attribute
[4070]	1353
	1354
[4147]	1355	return_value = 0
[4070]	1356
[4147]	1357	IF ( PRESENT( variable_name ) ) THEN
	1358	variable_name_internal = TRIM( variable_name )
	1359	ELSE
	1360	variable_name_internal = ''
	1361	ENDIF
[4141]	1362
[4147]	1363	IF ( PRESENT( append ) ) THEN
	1364	IF ( append ) THEN
	1365	return_value = 1
[4577]	1366	CALL internal_message( 'error', routine_name // &
	1367	': numeric attribute cannot be appended ' // &
	1368	'(attribute "' // TRIM( attribute_name ) // &
	1369	'", variable "' // TRIM( variable_name_internal ) // &
[4147]	1370	'", file "' // TRIM( file_name ) // '")!' )
	1371	ENDIF
	1372	ENDIF
[4070]	1373
[4147]	1374	IF ( return_value == 0 ) THEN
	1375	append_internal = .FALSE.
[4070]	1376
[4147]	1377	attribute%name = TRIM( attribute_name )
	1378	attribute%data_type = 'real64'
	1379	attribute%value_real64 = value
[4070]	1380
[4577]	1381	return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
	1382	variable_name=TRIM( variable_name_internal ), &
	1383	attribute=attribute, append=append_internal )
[4147]	1384	ENDIF
[4141]	1385
[4147]	1386	END FUNCTION dom_def_att_real64
[4141]	1387
	1388	!--------------------------------------------------------------------------------------------------!
	1389	! Description:
	1390	! ------------
	1391	!> End output definition.
	1392	!> The database is cleared from unused files and dimensions. Then, the output files are initialized
	1393	!> and prepared for writing output values to them. The saved values of the dimensions are written
	1394	!> to the files.
	1395	!--------------------------------------------------------------------------------------------------!
[4147]	1396	FUNCTION dom_def_end() RESULT( return_value )
[4141]	1397
[4147]	1398	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_end' !< name of routine
[4141]	1399
[4147]	1400	INTEGER :: d !< loop index
	1401	INTEGER :: f !< loop index
	1402	INTEGER :: return_value !< return value
[4141]	1403
[4147]	1404	INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE, TARGET :: values_int8 !< target array for dimension values
	1405	INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE, TARGET :: values_int16 !< target array for dimension values
	1406	INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET :: values_int32 !< target array for dimension values
	1407	INTEGER(iwp), DIMENSION(:), ALLOCATABLE, TARGET :: values_intwp !< target array for dimension values
[4141]	1408
[4147]	1409	INTEGER(KIND=1), DIMENSION(:), POINTER, CONTIGUOUS :: values_int8_pointer !< pointer to target array
	1410	INTEGER(KIND=2), DIMENSION(:), POINTER, CONTIGUOUS :: values_int16_pointer !< pointer to target array
	1411	INTEGER(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS :: values_int32_pointer !< pointer to target array
	1412	INTEGER(iwp), DIMENSION(:), POINTER, CONTIGUOUS :: values_intwp_pointer !< pointer to target array
[4141]	1413
[4147]	1414	REAL(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET :: values_real32 !< target array for dimension values
	1415	REAL(KIND=8), DIMENSION(:), ALLOCATABLE, TARGET :: values_real64 !< target array for dimension values
	1416	REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET :: values_realwp !< target array for dimension values
[4141]	1417
[4147]	1418	REAL(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS :: values_real32_pointer !< pointer to target array
	1419	REAL(KIND=8), DIMENSION(:), POINTER, CONTIGUOUS :: values_real64_pointer !< pointer to target array
	1420	REAL(wp), DIMENSION(:), POINTER, CONTIGUOUS :: values_realwp_pointer !< pointer to target array
[4141]	1421
	1422
[4147]	1423	return_value = 0
	1424	CALL internal_message( 'debug', routine_name // ': start' )
	1425	!
	1426	!-- Clear database from empty files and unused dimensions
	1427	IF ( nfiles > 0 ) return_value = cleanup_database()
[4141]	1428
[4147]	1429	IF ( return_value == 0 ) THEN
	1430	DO f = 1, nfiles
	1431	!
	1432	!-- Skip initialization if file is already initialized
	1433	IF ( files(f)%is_init ) CYCLE
[4141]	1434
[4577]	1435	CALL internal_message( 'debug', routine_name // ': initialize file "' // &
[4147]	1436	TRIM( files(f)%name ) // '"' )
	1437	!
	1438	!-- Open file
[4577]	1439	CALL open_output_file( files(f)%format, files(f)%name, files(f)%id, &
[4147]	1440	return_value=return_value )
	1441	!
	1442	!-- Initialize file header:
	1443	!-- define dimensions and variables and write attributes
[4577]	1444	IF ( return_value == 0 ) CALL init_file_header( files(f), return_value=return_value )
[4147]	1445	!
	1446	!-- End file definition
[4577]	1447	IF ( return_value == 0 ) &
	1448	CALL stop_file_header_definition( files(f)%format, files(f)%id, files(f)%name, &
	1449	return_value )
[4141]	1450
[4147]	1451	IF ( return_value == 0 ) THEN
	1452	!
	1453	!-- Flag file as initialized
	1454	files(f)%is_init = .TRUE.
	1455	!
	1456	!-- Write dimension values into file
	1457	DO d = 1, SIZE( files(f)%dimensions )
	1458	IF ( ALLOCATED( files(f)%dimensions(d)%values_int8 ) ) THEN
[4577]	1459	ALLOCATE( values_int8(files(f)%dimensions(d)%bounds(1): &
[4141]	1460	files(f)%dimensions(d)%bounds(2)) )
[4147]	1461	values_int8 = files(f)%dimensions(d)%values_int8
	1462	values_int8_pointer => values_int8
[4577]	1463	return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
	1464	bounds_start=(/ files(f)%dimensions(d)%bounds(1) /), &
	1465	bounds_end =(/ files(f)%dimensions(d)%bounds(2) /), &
[4147]	1466	values_int8_1d=values_int8_pointer )
	1467	DEALLOCATE( values_int8 )
	1468	ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int16 ) ) THEN
[4577]	1469	ALLOCATE( values_int16(files(f)%dimensions(d)%bounds(1): &
[4141]	1470	files(f)%dimensions(d)%bounds(2)) )
[4147]	1471	values_int16 = files(f)%dimensions(d)%values_int16
	1472	values_int16_pointer => values_int16
[4577]	1473	return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
	1474	bounds_start=(/ files(f)%dimensions(d)%bounds(1) /), &
	1475	bounds_end =(/ files(f)%dimensions(d)%bounds(2) /), &
[4147]	1476	values_int16_1d=values_int16_pointer )
	1477	DEALLOCATE( values_int16 )
	1478	ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int32 ) ) THEN
[4577]	1479	ALLOCATE( values_int32(files(f)%dimensions(d)%bounds(1): &
[4141]	1480	files(f)%dimensions(d)%bounds(2)) )
[4147]	1481	values_int32 = files(f)%dimensions(d)%values_int32
	1482	values_int32_pointer => values_int32
[4577]	1483	return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
	1484	bounds_start=(/ files(f)%dimensions(d)%bounds(1) /), &
	1485	bounds_end =(/ files(f)%dimensions(d)%bounds(2) /), &
[4147]	1486	values_int32_1d=values_int32_pointer )
	1487	DEALLOCATE( values_int32 )
	1488	ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_intwp ) ) THEN
[4577]	1489	ALLOCATE( values_intwp(files(f)%dimensions(d)%bounds(1): &
[4141]	1490	files(f)%dimensions(d)%bounds(2)) )
[4147]	1491	values_intwp = files(f)%dimensions(d)%values_intwp
	1492	values_intwp_pointer => values_intwp
[4577]	1493	return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
	1494	bounds_start=(/ files(f)%dimensions(d)%bounds(1) /), &
	1495	bounds_end =(/ files(f)%dimensions(d)%bounds(2) /), &
[4147]	1496	values_intwp_1d=values_intwp_pointer )
	1497	DEALLOCATE( values_intwp )
	1498	ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real32 ) ) THEN
[4577]	1499	ALLOCATE( values_real32(files(f)%dimensions(d)%bounds(1): &
[4147]	1500	files(f)%dimensions(d)%bounds(2)) )
	1501	values_real32 = files(f)%dimensions(d)%values_real32
	1502	values_real32_pointer => values_real32
[4577]	1503	return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
	1504	bounds_start=(/ files(f)%dimensions(d)%bounds(1) /), &
	1505	bounds_end =(/ files(f)%dimensions(d)%bounds(2) /), &
[4147]	1506	values_real32_1d=values_real32_pointer )
	1507	DEALLOCATE( values_real32 )
	1508	ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real64 ) ) THEN
[4577]	1509	ALLOCATE( values_real64(files(f)%dimensions(d)%bounds(1): &
[4147]	1510	files(f)%dimensions(d)%bounds(2)) )
	1511	values_real64 = files(f)%dimensions(d)%values_real64
	1512	values_real64_pointer => values_real64
[4577]	1513	return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
	1514	bounds_start=(/ files(f)%dimensions(d)%bounds(1) /), &
	1515	bounds_end =(/ files(f)%dimensions(d)%bounds(2) /), &
[4147]	1516	values_real64_1d=values_real64_pointer )
	1517	DEALLOCATE( values_real64 )
	1518	ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_realwp ) ) THEN
[4577]	1519	ALLOCATE( values_realwp(files(f)%dimensions(d)%bounds(1): &
[4147]	1520	files(f)%dimensions(d)%bounds(2)) )
	1521	values_realwp = files(f)%dimensions(d)%values_realwp
	1522	values_realwp_pointer => values_realwp
[4577]	1523	return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
	1524	bounds_start=(/ files(f)%dimensions(d)%bounds(1) /), &
	1525	bounds_end =(/ files(f)%dimensions(d)%bounds(2) /), &
[4147]	1526	values_realwp_1d=values_realwp_pointer )
	1527	DEALLOCATE( values_realwp )
	1528	ENDIF
	1529	IF ( return_value /= 0 ) EXIT
	1530	ENDDO
[4141]	1531
[4147]	1532	ENDIF
[4141]	1533
[4147]	1534	IF ( return_value /= 0 ) EXIT
[4141]	1535
[4147]	1536	ENDDO
	1537	ENDIF
[4141]	1538
[4147]	1539	CALL internal_message( 'debug', routine_name // ': finished' )
[4141]	1540
[4147]	1541	END FUNCTION dom_def_end
[4141]	1542
	1543	!--------------------------------------------------------------------------------------------------!
	1544	! Description:
	1545	! ------------
	1546	!> Write variable to file.
	1547	!> Example call:
	1548	!> dom_write_var( file_name = 'my_output_file_name', &
	1549	!> name = 'u', &
	1550	!> bounds_start = (/nxl, nys, nzb, time_step/), &
	1551	!> bounds_end = (/nxr, nyn, nzt, time_step/), &
	1552	!> values_real64_3d = u )
	1553	!> @note The order of dimension bounds must match to the order of dimensions given in call
	1554	!> 'dom_def_var'. I.e., the corresponding variable definition should be like:
	1555	!> dom_def_var( file_name = 'my_output_file_name', &
	1556	!> name = 'u', &
	1557	!> dimension_names = (/'x ', 'y ', 'z ', 'time'/), &
	1558	!> output_type = <desired-output-type> )
	1559	!> @note The values given do not need to be of the same data type as was defined in the
	1560	!> corresponding 'dom_def_var' call. If the output format 'netcdf' was chosen, the values are
	1561	!> automatically converted to the data type given during the definition. If 'binary' was
	1562	!> chosen, the values are written to file as given in the 'dom_write_var' call.
	1563	!--------------------------------------------------------------------------------------------------!
[4577]	1564	FUNCTION dom_write_var( file_name, variable_name, bounds_start, bounds_end, &
	1565	values_char_0d, values_char_1d, values_char_2d, values_char_3d, &
	1566	values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, &
	1567	values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, &
	1568	values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, &
	1569	values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, &
	1570	values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &
	1571	values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &
	1572	values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d &
[4147]	1573	) RESULT( return_value )
[4141]	1574
[4577]	1575	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_write_var' !< name of routine
	1576
[4147]	1577	CHARACTER(LEN=charlen) :: file_format !< file format chosen for file
	1578	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	1579	CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable
[4141]	1580
[4408]	1581	CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL :: values_char_0d !< output variable
	1582	CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_char_1d !< output variable
	1583	CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_char_2d !< output variable
	1584	CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_char_3d !< output variable
	1585
	1586	CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:) :: values_char_1d_resorted !< resorted output variable
	1587	CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_char_2d_resorted !< resorted output variable
	1588	CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_char_3d_resorted !< resorted output variable
	1589
	1590	CHARACTER(LEN=1), POINTER :: values_char_0d_pointer !< pointer to resortet array
	1591	CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:) :: values_char_1d_pointer !< pointer to resortet array
	1592	CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_char_2d_pointer !< pointer to resortet array
	1593	CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_char_3d_pointer !< pointer to resortet array
	1594
[4147]	1595	INTEGER :: file_id !< file ID
	1596	INTEGER :: i !< loop index
	1597	INTEGER :: j !< loop index
	1598	INTEGER :: k !< loop index
	1599	INTEGER :: output_return_value !< return value of a called output routine
	1600	INTEGER :: return_value !< return value
	1601	INTEGER :: variable_id !< variable ID
[4141]	1602
[4147]	1603	INTEGER, DIMENSION(:), INTENT(IN) :: bounds_end !< end index per dimension of variable
	1604	INTEGER, DIMENSION(:), INTENT(IN) :: bounds_start !< start index per dimension of variable
[4577]	1605
[4147]	1606	INTEGER, DIMENSION(:), ALLOCATABLE :: bounds_origin !< first index of each dimension
	1607	INTEGER, DIMENSION(:), ALLOCATABLE :: bounds_start_internal !< start index per dim. for output after masking
	1608	INTEGER, DIMENSION(:), ALLOCATABLE :: value_counts !< count of indices to be written per dimension
	1609	INTEGER, DIMENSION(:,:), ALLOCATABLE :: masked_indices !< list containing all output indices along a dimension
[4141]	1610
[4147]	1611	LOGICAL :: do_output !< true if any data lies within given range of masked dimension
	1612	LOGICAL :: is_global !< true if variable is global
[4141]	1613
[4147]	1614	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: values_int8_0d !< output variable
	1615	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL :: values_int16_0d !< output variable
	1616	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_int32_0d !< output variable
	1617	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL :: values_intwp_0d !< output variable
	1618	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int8_1d !< output variable
	1619	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int16_1d !< output variable
	1620	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int32_1d !< output variable
	1621	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_intwp_1d !< output variable
	1622	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int8_2d !< output variable
	1623	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int16_2d !< output variable
	1624	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int32_2d !< output variable
	1625	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_intwp_2d !< output variable
	1626	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int8_3d !< output variable
	1627	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int16_3d !< output variable
	1628	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int32_3d !< output variable
	1629	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_intwp_3d !< output variable
[4141]	1630
[4147]	1631	INTEGER(KIND=1), POINTER :: values_int8_0d_pointer !< pointer to resortet array
	1632	INTEGER(KIND=2), POINTER :: values_int16_0d_pointer !< pointer to resortet array
	1633	INTEGER(KIND=4), POINTER :: values_int32_0d_pointer !< pointer to resortet array
	1634	INTEGER(iwp), POINTER :: values_intwp_0d_pointer !< pointer to resortet array
	1635	INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:) :: values_int8_1d_pointer !< pointer to resortet array
	1636	INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:) :: values_int16_1d_pointer !< pointer to resortet array
	1637	INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:) :: values_int32_1d_pointer !< pointer to resortet array
	1638	INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:) :: values_intwp_1d_pointer !< pointer to resortet array
	1639	INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_int8_2d_pointer !< pointer to resortet array
	1640	INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_int16_2d_pointer !< pointer to resortet array
	1641	INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_int32_2d_pointer !< pointer to resortet array
	1642	INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_intwp_2d_pointer !< pointer to resortet array
	1643	INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_int8_3d_pointer !< pointer to resortet array
	1644	INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_int16_3d_pointer !< pointer to resortet array
	1645	INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_int32_3d_pointer !< pointer to resortet array
	1646	INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_intwp_3d_pointer !< pointer to resortet array
[4141]	1647
[4577]	1648	INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:) :: values_int8_1d_resorted !< resorted output variable
	1649	INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:) :: values_int16_1d_resorted !< resorted output variable
	1650	INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:) :: values_int32_1d_resorted !< resorted output variable
	1651	INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:) :: values_intwp_1d_resorted !< resorted output variable
	1652	INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_int8_2d_resorted !< resorted output variable
	1653	INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_int16_2d_resorted !< resorted output variable
	1654	INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_int32_2d_resorted !< resorted output variable
	1655	INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_intwp_2d_resorted !< resorted output variable
	1656	INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_int8_3d_resorted !< resorted output variable
	1657	INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_int16_3d_resorted !< resorted output variable
	1658	INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_int32_3d_resorted !< resorted output variable
	1659	INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_intwp_3d_resorted !< resorted output variable
	1660
[4147]	1661	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_real32_0d !< output variable
	1662	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL :: values_real64_0d !< output variable
	1663	REAL(wp), POINTER, INTENT(IN), OPTIONAL :: values_realwp_0d !< output variable
	1664	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_real32_1d !< output variable
	1665	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_real64_1d !< output variable
	1666	REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_realwp_1d !< output variable
	1667	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_real32_2d !< output variable
	1668	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_real64_2d !< output variable
	1669	REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_realwp_2d !< output variable
	1670	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_real32_3d !< output variable
	1671	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_real64_3d !< output variable
	1672	REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_realwp_3d !< output variable
[4141]	1673
[4147]	1674	REAL(KIND=4), POINTER :: values_real32_0d_pointer !< pointer to resortet array
	1675	REAL(KIND=8), POINTER :: values_real64_0d_pointer !< pointer to resortet array
	1676	REAL(wp), POINTER :: values_realwp_0d_pointer !< pointer to resortet array
	1677	REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:) :: values_real32_1d_pointer !< pointer to resortet array
	1678	REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:) :: values_real64_1d_pointer !< pointer to resortet array
	1679	REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:) :: values_realwp_1d_pointer !< pointer to resortet array
	1680	REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_real32_2d_pointer !< pointer to resortet array
	1681	REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_real64_2d_pointer !< pointer to resortet array
	1682	REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_realwp_2d_pointer !< pointer to resortet array
	1683	REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_real32_3d_pointer !< pointer to resortet array
	1684	REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_real64_3d_pointer !< pointer to resortet array
	1685	REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_realwp_3d_pointer !< pointer to resortet array
[4141]	1686
[4577]	1687	REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:) :: values_real32_1d_resorted !< resorted output variable
	1688	REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:) :: values_real64_1d_resorted !< resorted output variable
	1689	REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:) :: values_realwp_1d_resorted !< resorted output variable
	1690	REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_real32_2d_resorted !< resorted output variable
	1691	REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_real64_2d_resorted !< resorted output variable
	1692	REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_realwp_2d_resorted !< resorted output variable
	1693	REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_real32_3d_resorted !< resorted output variable
	1694	REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_real64_3d_resorted !< resorted output variable
	1695	REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_realwp_3d_resorted !< resorted output variable
	1696
[4147]	1697	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimension_list !< list of used dimensions of variable
[4141]	1698
	1699
[4147]	1700	return_value = 0
	1701	output_return_value = 0
[4141]	1702
[4577]	1703	CALL internal_message( 'debug', routine_name // ': write ' // TRIM( variable_name ) // &
[4147]	1704	' into file ' // TRIM( file_name ) )
	1705	!
	1706	!-- Search for variable within file
[4577]	1707	CALL find_var_in_file( file_name, variable_name, file_format, file_id, variable_id, &
[4147]	1708	is_global, dimension_list, return_value=return_value )
[4141]	1709
[4147]	1710	IF ( return_value == 0 ) THEN
	1711	!
	1712	!-- Check if the correct amount of variable bounds were given
[4577]	1713	IF ( SIZE( bounds_start ) /= SIZE( dimension_list ) .OR. &
	1714	SIZE( bounds_end ) /= SIZE( dimension_list ) ) THEN
[4147]	1715	return_value = 1
[4577]	1716	CALL internal_message( 'error', routine_name // &
	1717	': number bounds do not match with ' // &
	1718	'number of dimensions of variable ' // &
	1719	'(variable "' // TRIM( variable_name ) // &
[4147]	1720	'", file "' // TRIM( file_name ) // '")!' )
	1721	ENDIF
[4141]	1722
[4147]	1723	ENDIF
[4141]	1724
[4147]	1725	IF ( return_value == 0 ) THEN
	1726	!
	1727	!-- Save starting index (lower bounds) of each dimension
	1728	ALLOCATE( bounds_origin(SIZE( dimension_list )) )
	1729	ALLOCATE( bounds_start_internal(SIZE( dimension_list )) )
	1730	ALLOCATE( value_counts(SIZE( dimension_list )) )
[4141]	1731
[4147]	1732	WRITE( temp_string, * ) bounds_start
[4577]	1733	CALL internal_message( 'debug', routine_name // &
	1734	': file "' // TRIM( file_name ) // &
	1735	'", variable "' // TRIM( variable_name ) // &
[4147]	1736	'", bounds_start =' // TRIM( temp_string ) )
	1737	WRITE( temp_string, * ) bounds_end
[4577]	1738	CALL internal_message( 'debug', routine_name // &
	1739	': file "' // TRIM( file_name ) // &
	1740	'", variable "' // TRIM( variable_name ) // &
[4147]	1741	'", bounds_end =' // TRIM( temp_string ) )
	1742	!
	1743	!-- Get bounds for masking
[4577]	1744	CALL get_masked_indices_and_masked_dimension_bounds( dimension_list, bounds_start, &
	1745	bounds_end, bounds_start_internal, value_counts, bounds_origin, masked_indices )
[4141]	1746
[4147]	1747	do_output = .NOT. ANY( value_counts == 0 )
[4141]	1748
[4147]	1749	WRITE( temp_string, * ) bounds_start_internal
[4577]	1750	CALL internal_message( 'debug', routine_name // &
	1751	': file "' // TRIM( file_name ) // &
	1752	'", variable "' // TRIM( variable_name ) // &
[4147]	1753	'", bounds_start_internal =' // TRIM( temp_string ) )
	1754	WRITE( temp_string, * ) value_counts
[4577]	1755	CALL internal_message( 'debug', routine_name // &
	1756	': file "' // TRIM( file_name ) // &
	1757	'", variable "' // TRIM( variable_name ) // &
[4147]	1758	'", value_counts =' // TRIM( temp_string ) )
	1759	!
	1760	!-- Mask and resort variable
[4408]	1761	!-- character output
	1762	IF ( PRESENT( values_char_0d ) ) THEN
	1763	values_char_0d_pointer => values_char_0d
	1764	ELSEIF ( PRESENT( values_char_1d ) ) THEN
	1765	IF ( do_output ) THEN
	1766	ALLOCATE( values_char_1d_resorted(0:value_counts(1)-1) )
	1767	!$OMP PARALLEL PRIVATE (i)
	1768	!$OMP DO
	1769	DO i = 0, value_counts(1) - 1
	1770	values_char_1d_resorted(i) = values_char_1d(masked_indices(1,i))
	1771	ENDDO
	1772	!$OMP END PARALLEL
	1773	ELSE
	1774	ALLOCATE( values_char_1d_resorted(1) )
	1775	values_char_1d_resorted = ' '
	1776	ENDIF
	1777	values_char_1d_pointer => values_char_1d_resorted
	1778	ELSEIF ( PRESENT( values_char_2d ) ) THEN
	1779	IF ( do_output ) THEN
[4577]	1780	ALLOCATE( values_char_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) )
[4408]	1781	!$OMP PARALLEL PRIVATE (i,j)
	1782	!$OMP DO
	1783	DO i = 0, value_counts(1) - 1
	1784	DO j = 0, value_counts(2) - 1
[4577]	1785	values_char_2d_resorted(i,j) = values_char_2d(masked_indices(2,j), &
	1786	masked_indices(1,i))
[4408]	1787	ENDDO
	1788	ENDDO
	1789	!$OMP END PARALLEL
	1790	ELSE
	1791	ALLOCATE( values_char_2d_resorted(1,1) )
	1792	values_char_2d_resorted = ' '
	1793	ENDIF
	1794	values_char_2d_pointer => values_char_2d_resorted
	1795	ELSEIF ( PRESENT( values_char_3d ) ) THEN
	1796	IF ( do_output ) THEN
[4577]	1797	ALLOCATE( values_char_3d_resorted(0:value_counts(1)-1, &
	1798	0:value_counts(2)-1, &
[4408]	1799	0:value_counts(3)-1) )
	1800	!$OMP PARALLEL PRIVATE (i,j,k)
	1801	!$OMP DO
	1802	DO i = 0, value_counts(1) - 1
	1803	DO j = 0, value_counts(2) - 1
	1804	DO k = 0, value_counts(3) - 1
[4577]	1805	values_char_3d_resorted(i,j,k) = values_char_3d(masked_indices(3,k), &
	1806	masked_indices(2,j), &
	1807	masked_indices(1,i))
[4408]	1808	ENDDO
	1809	ENDDO
	1810	ENDDO
	1811	!$OMP END PARALLEL
	1812	ELSE
	1813	ALLOCATE( values_char_3d_resorted(1,1,1) )
	1814	values_char_3d_resorted = ' '
	1815	ENDIF
	1816	values_char_3d_pointer => values_char_3d_resorted
	1817	!
[4147]	1818	!-- 8bit integer output
[4408]	1819	ELSEIF ( PRESENT( values_int8_0d ) ) THEN
[4147]	1820	values_int8_0d_pointer => values_int8_0d
	1821	ELSEIF ( PRESENT( values_int8_1d ) ) THEN
	1822	IF ( do_output ) THEN
	1823	ALLOCATE( values_int8_1d_resorted(0:value_counts(1)-1) )
	1824	!$OMP PARALLEL PRIVATE (i)
	1825	!$OMP DO
	1826	DO i = 0, value_counts(1) - 1
	1827	values_int8_1d_resorted(i) = values_int8_1d(masked_indices(1,i))
	1828	ENDDO
	1829	!$OMP END PARALLEL
	1830	ELSE
	1831	ALLOCATE( values_int8_1d_resorted(1) )
	1832	values_int8_1d_resorted = 0_1
	1833	ENDIF
	1834	values_int8_1d_pointer => values_int8_1d_resorted
	1835	ELSEIF ( PRESENT( values_int8_2d ) ) THEN
	1836	IF ( do_output ) THEN
[4577]	1837	ALLOCATE( values_int8_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) )
[4147]	1838	!$OMP PARALLEL PRIVATE (i,j)
	1839	!$OMP DO
	1840	DO i = 0, value_counts(1) - 1
	1841	DO j = 0, value_counts(2) - 1
[4577]	1842	values_int8_2d_resorted(i,j) = values_int8_2d(masked_indices(2,j), &
	1843	masked_indices(1,i))
[4147]	1844	ENDDO
	1845	ENDDO
	1846	!$OMP END PARALLEL
	1847	ELSE
	1848	ALLOCATE( values_int8_2d_resorted(1,1) )
	1849	values_int8_2d_resorted = 0_1
	1850	ENDIF
	1851	values_int8_2d_pointer => values_int8_2d_resorted
	1852	ELSEIF ( PRESENT( values_int8_3d ) ) THEN
	1853	IF ( do_output ) THEN
[4577]	1854	ALLOCATE( values_int8_3d_resorted(0:value_counts(1)-1, &
	1855	0:value_counts(2)-1, &
[4141]	1856	0:value_counts(3)-1) )
[4147]	1857	!$OMP PARALLEL PRIVATE (i,j,k)
	1858	!$OMP DO
	1859	DO i = 0, value_counts(1) - 1
	1860	DO j = 0, value_counts(2) - 1
	1861	DO k = 0, value_counts(3) - 1
[4577]	1862	values_int8_3d_resorted(i,j,k) = values_int8_3d(masked_indices(3,k), &
	1863	masked_indices(2,j), &
[4147]	1864	masked_indices(1,i) )
	1865	ENDDO
	1866	ENDDO
	1867	ENDDO
	1868	!$OMP END PARALLEL
	1869	ELSE
	1870	ALLOCATE( values_int8_3d_resorted(1,1,1) )
	1871	values_int8_3d_resorted = 0_1
	1872	ENDIF
	1873	values_int8_3d_pointer => values_int8_3d_resorted
	1874	!
	1875	!-- 16bit integer output
	1876	ELSEIF ( PRESENT( values_int16_0d ) ) THEN
	1877	values_int16_0d_pointer => values_int16_0d
	1878	ELSEIF ( PRESENT( values_int16_1d ) ) THEN
	1879	IF ( do_output ) THEN
	1880	ALLOCATE( values_int16_1d_resorted(0:value_counts(1)-1) )
	1881	!$OMP PARALLEL PRIVATE (i)
	1882	!$OMP DO
	1883	DO i = 0, value_counts(1) - 1
	1884	values_int16_1d_resorted(i) = values_int16_1d(masked_indices(1,i))
	1885	ENDDO
	1886	!$OMP END PARALLEL
	1887	ELSE
	1888	ALLOCATE( values_int16_1d_resorted(1) )
	1889	values_int16_1d_resorted = 0_1
	1890	ENDIF
	1891	values_int16_1d_pointer => values_int16_1d_resorted
	1892	ELSEIF ( PRESENT( values_int16_2d ) ) THEN
	1893	IF ( do_output ) THEN
[4577]	1894	ALLOCATE( values_int16_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) )
[4147]	1895	!$OMP PARALLEL PRIVATE (i,j)
	1896	!$OMP DO
	1897	DO i = 0, value_counts(1) - 1
	1898	DO j = 0, value_counts(2) - 1
[4577]	1899	values_int16_2d_resorted(i,j) = values_int16_2d(masked_indices(2,j), &
[4147]	1900	masked_indices(1,i))
	1901	ENDDO
	1902	ENDDO
	1903	!$OMP END PARALLEL
	1904	ELSE
	1905	ALLOCATE( values_int16_2d_resorted(1,1) )
	1906	values_int16_2d_resorted = 0_1
	1907	ENDIF
	1908	values_int16_2d_pointer => values_int16_2d_resorted
	1909	ELSEIF ( PRESENT( values_int16_3d ) ) THEN
	1910	IF ( do_output ) THEN
[4577]	1911	ALLOCATE( values_int16_3d_resorted(0:value_counts(1)-1, &
	1912	0:value_counts(2)-1, &
[4141]	1913	0:value_counts(3)-1) )
[4147]	1914	!$OMP PARALLEL PRIVATE (i,j,k)
	1915	!$OMP DO
	1916	DO i = 0, value_counts(1) - 1
	1917	DO j = 0, value_counts(2) - 1
	1918	DO k = 0, value_counts(3) - 1
[4577]	1919	values_int16_3d_resorted(i,j,k) = values_int16_3d(masked_indices(3,k), &
	1920	masked_indices(2,j), &
	1921	masked_indices(1,i))
[4147]	1922	ENDDO
	1923	ENDDO
	1924	ENDDO
	1925	!$OMP END PARALLEL
	1926	ELSE
	1927	ALLOCATE( values_int16_3d_resorted(1,1,1) )
	1928	values_int16_3d_resorted = 0_1
	1929	ENDIF
	1930	values_int16_3d_pointer => values_int16_3d_resorted
	1931	!
	1932	!-- 32bit integer output
	1933	ELSEIF ( PRESENT( values_int32_0d ) ) THEN
	1934	values_int32_0d_pointer => values_int32_0d
	1935	ELSEIF ( PRESENT( values_int32_1d ) ) THEN
	1936	IF ( do_output ) THEN
	1937	ALLOCATE( values_int32_1d_resorted(0:value_counts(1)-1) )
	1938	!$OMP PARALLEL PRIVATE (i)
	1939	!$OMP DO
	1940	DO i = 0, value_counts(1) - 1
	1941	values_int32_1d_resorted(i) = values_int32_1d(masked_indices(1,i))
	1942	ENDDO
	1943	!$OMP END PARALLEL
	1944	ELSE
	1945	ALLOCATE( values_int32_1d_resorted(1) )
	1946	values_int32_1d_resorted = 0_1
	1947	ENDIF
	1948	values_int32_1d_pointer => values_int32_1d_resorted
	1949	ELSEIF ( PRESENT( values_int32_2d ) ) THEN
	1950	IF ( do_output ) THEN
[4577]	1951	ALLOCATE( values_int32_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) )
[4147]	1952	!$OMP PARALLEL PRIVATE (i,j)
	1953	!$OMP DO
	1954	DO i = 0, value_counts(1) - 1
	1955	DO j = 0, value_counts(2) - 1
[4577]	1956	values_int32_2d_resorted(i,j) = values_int32_2d(masked_indices(2,j), &
	1957	masked_indices(1,i))
[4147]	1958	ENDDO
	1959	ENDDO
	1960	!$OMP END PARALLEL
	1961	ELSE
	1962	ALLOCATE( values_int32_2d_resorted(1,1) )
	1963	values_int32_2d_resorted = 0_1
	1964	ENDIF
	1965	values_int32_2d_pointer => values_int32_2d_resorted
	1966	ELSEIF ( PRESENT( values_int32_3d ) ) THEN
	1967	IF ( do_output ) THEN
[4577]	1968	ALLOCATE( values_int32_3d_resorted(0:value_counts(1)-1, &
	1969	0:value_counts(2)-1, &
[4141]	1970	0:value_counts(3)-1) )
[4147]	1971	!$OMP PARALLEL PRIVATE (i,j,k)
	1972	!$OMP DO
	1973	DO i = 0, value_counts(1) - 1
	1974	DO j = 0, value_counts(2) - 1
	1975	DO k = 0, value_counts(3) - 1
[4577]	1976	values_int32_3d_resorted(i,j,k) = values_int32_3d(masked_indices(3,k), &
	1977	masked_indices(2,j), &
	1978	masked_indices(1,i))
[4147]	1979	ENDDO
	1980	ENDDO
	1981	ENDDO
	1982	!$OMP END PARALLEL
	1983	ELSE
	1984	ALLOCATE( values_int32_3d_resorted(1,1,1) )
	1985	values_int32_3d_resorted = 0_1
	1986	ENDIF
	1987	values_int32_3d_pointer => values_int32_3d_resorted
	1988	!
[4577]	1989	!-- Working-precision integer output
[4147]	1990	ELSEIF ( PRESENT( values_intwp_0d ) ) THEN
	1991	values_intwp_0d_pointer => values_intwp_0d
	1992	ELSEIF ( PRESENT( values_intwp_1d ) ) THEN
	1993	IF ( do_output ) THEN
	1994	ALLOCATE( values_intwp_1d_resorted(0:value_counts(1)-1) )
	1995	!$OMP PARALLEL PRIVATE (i)
	1996	!$OMP DO
	1997	DO i = 0, value_counts(1) - 1
	1998	values_intwp_1d_resorted(i) = values_intwp_1d(masked_indices(1,i))
	1999	ENDDO
	2000	!$OMP END PARALLEL
	2001	ELSE
	2002	ALLOCATE( values_intwp_1d_resorted(1) )
	2003	values_intwp_1d_resorted = 0_1
	2004	ENDIF
	2005	values_intwp_1d_pointer => values_intwp_1d_resorted
	2006	ELSEIF ( PRESENT( values_intwp_2d ) ) THEN
	2007	IF ( do_output ) THEN
[4577]	2008	ALLOCATE( values_intwp_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) )
[4147]	2009	!$OMP PARALLEL PRIVATE (i,j)
	2010	!$OMP DO
	2011	DO i = 0, value_counts(1) - 1
	2012	DO j = 0, value_counts(2) - 1
[4577]	2013	values_intwp_2d_resorted(i,j) = values_intwp_2d(masked_indices(2,j), &
	2014	masked_indices(1,i))
[4147]	2015	ENDDO
	2016	ENDDO
	2017	!$OMP END PARALLEL
	2018	ELSE
	2019	ALLOCATE( values_intwp_2d_resorted(1,1) )
	2020	values_intwp_2d_resorted = 0_1
	2021	ENDIF
	2022	values_intwp_2d_pointer => values_intwp_2d_resorted
	2023	ELSEIF ( PRESENT( values_intwp_3d ) ) THEN
	2024	IF ( do_output ) THEN
[4577]	2025	ALLOCATE( values_intwp_3d_resorted(0:value_counts(1)-1, &
	2026	0:value_counts(2)-1, &
[4141]	2027	0:value_counts(3)-1) )
[4147]	2028	!$OMP PARALLEL PRIVATE (i,j,k)
	2029	!$OMP DO
	2030	DO i = 0, value_counts(1) - 1
	2031	DO j = 0, value_counts(2) - 1
	2032	DO k = 0, value_counts(3) - 1
[4577]	2033	values_intwp_3d_resorted(i,j,k) = values_intwp_3d(masked_indices(3,k), &
	2034	masked_indices(2,j), &
	2035	masked_indices(1,i))
[4147]	2036	ENDDO
	2037	ENDDO
	2038	ENDDO
	2039	!$OMP END PARALLEL
	2040	ELSE
	2041	ALLOCATE( values_intwp_3d_resorted(1,1,1) )
	2042	values_intwp_3d_resorted = 0_1
	2043	ENDIF
	2044	values_intwp_3d_pointer => values_intwp_3d_resorted
	2045	!
	2046	!-- 32bit real output
	2047	ELSEIF ( PRESENT( values_real32_0d ) ) THEN
	2048	values_real32_0d_pointer => values_real32_0d
	2049	ELSEIF ( PRESENT( values_real32_1d ) ) THEN
	2050	IF ( do_output ) THEN
	2051	ALLOCATE( values_real32_1d_resorted(0:value_counts(1)-1) )
	2052	!$OMP PARALLEL PRIVATE (i)
	2053	!$OMP DO
	2054	DO i = 0, value_counts(1) - 1
	2055	values_real32_1d_resorted(i) = values_real32_1d(masked_indices(1,i))
	2056	ENDDO
	2057	!$OMP END PARALLEL
	2058	ELSE
	2059	ALLOCATE( values_real32_1d_resorted(1) )
	2060	values_real32_1d_resorted = 0_1
	2061	ENDIF
	2062	values_real32_1d_pointer => values_real32_1d_resorted
	2063	ELSEIF ( PRESENT( values_real32_2d ) ) THEN
	2064	IF ( do_output ) THEN
[4577]	2065	ALLOCATE( values_real32_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) )
[4147]	2066	!$OMP PARALLEL PRIVATE (i,j)
	2067	!$OMP DO
	2068	DO i = 0, value_counts(1) - 1
	2069	DO j = 0, value_counts(2) - 1
[4577]	2070	values_real32_2d_resorted(i,j) = values_real32_2d(masked_indices(2,j), &
	2071	masked_indices(1,i))
[4147]	2072	ENDDO
	2073	ENDDO
	2074	!$OMP END PARALLEL
	2075	ELSE
	2076	ALLOCATE( values_real32_2d_resorted(1,1) )
	2077	values_real32_2d_resorted = 0_1
	2078	ENDIF
	2079	values_real32_2d_pointer => values_real32_2d_resorted
	2080	ELSEIF ( PRESENT( values_real32_3d ) ) THEN
	2081	IF ( do_output ) THEN
[4577]	2082	ALLOCATE( values_real32_3d_resorted(0:value_counts(1)-1, &
	2083	0:value_counts(2)-1, &
[4147]	2084	0:value_counts(3)-1) )
	2085	!$OMP PARALLEL PRIVATE (i,j,k)
	2086	!$OMP DO
	2087	DO i = 0, value_counts(1) - 1
	2088	DO j = 0, value_counts(2) - 1
	2089	DO k = 0, value_counts(3) - 1
[4577]	2090	values_real32_3d_resorted(i,j,k) = values_real32_3d(masked_indices(3,k), &
	2091	masked_indices(2,j), &
	2092	masked_indices(1,i))
[4147]	2093	ENDDO
	2094	ENDDO
	2095	ENDDO
	2096	!$OMP END PARALLEL
	2097	ELSE
	2098	ALLOCATE( values_real32_3d_resorted(1,1,1) )
	2099	values_real32_3d_resorted = 0_1
	2100	ENDIF
	2101	values_real32_3d_pointer => values_real32_3d_resorted
	2102	!
	2103	!-- 64bit real output
	2104	ELSEIF ( PRESENT( values_real64_0d ) ) THEN
	2105	values_real64_0d_pointer => values_real64_0d
	2106	ELSEIF ( PRESENT( values_real64_1d ) ) THEN
	2107	IF ( do_output ) THEN
	2108	ALLOCATE( values_real64_1d_resorted(0:value_counts(1)-1) )
	2109	!$OMP PARALLEL PRIVATE (i)
	2110	!$OMP DO
	2111	DO i = 0, value_counts(1) - 1
	2112	values_real64_1d_resorted(i) = values_real64_1d(masked_indices(1,i))
	2113	ENDDO
	2114	!$OMP END PARALLEL
	2115	ELSE
	2116	ALLOCATE( values_real64_1d_resorted(1) )
	2117	values_real64_1d_resorted = 0_1
	2118	ENDIF
	2119	values_real64_1d_pointer => values_real64_1d_resorted
	2120	ELSEIF ( PRESENT( values_real64_2d ) ) THEN
	2121	IF ( do_output ) THEN
[4577]	2122	ALLOCATE( values_real64_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) )
[4147]	2123	!$OMP PARALLEL PRIVATE (i,j)
	2124	!$OMP DO
	2125	DO i = 0, value_counts(1) - 1
	2126	DO j = 0, value_counts(2) - 1
[4577]	2127	values_real64_2d_resorted(i,j) = values_real64_2d(masked_indices(2,j), &
	2128	masked_indices(1,i))
[4147]	2129	ENDDO
	2130	ENDDO
	2131	!$OMP END PARALLEL
	2132	ELSE
	2133	ALLOCATE( values_real64_2d_resorted(1,1) )
	2134	values_real64_2d_resorted = 0_1
	2135	ENDIF
	2136	values_real64_2d_pointer => values_real64_2d_resorted
	2137	ELSEIF ( PRESENT( values_real64_3d ) ) THEN
	2138	IF ( do_output ) THEN
[4577]	2139	ALLOCATE( values_real64_3d_resorted(0:value_counts(1)-1, &
	2140	0:value_counts(2)-1, &
[4147]	2141	0:value_counts(3)-1) )
	2142	!$OMP PARALLEL PRIVATE (i,j,k)
	2143	!$OMP DO
	2144	DO i = 0, value_counts(1) - 1
	2145	DO j = 0, value_counts(2) - 1
	2146	DO k = 0, value_counts(3) - 1
[4577]	2147	values_real64_3d_resorted(i,j,k) = values_real64_3d(masked_indices(3,k), &
	2148	masked_indices(2,j), &
	2149	masked_indices(1,i))
[4147]	2150	ENDDO
	2151	ENDDO
	2152	ENDDO
	2153	!$OMP END PARALLEL
	2154	ELSE
	2155	ALLOCATE( values_real64_3d_resorted(1,1,1) )
	2156	values_real64_3d_resorted = 0_1
	2157	ENDIF
	2158	values_real64_3d_pointer => values_real64_3d_resorted
	2159	!
[4577]	2160	!-- Working-precision real output
[4147]	2161	ELSEIF ( PRESENT( values_realwp_0d ) ) THEN
	2162	values_realwp_0d_pointer => values_realwp_0d
	2163	ELSEIF ( PRESENT( values_realwp_1d ) ) THEN
	2164	IF ( do_output ) THEN
	2165	ALLOCATE( values_realwp_1d_resorted(0:value_counts(1)-1) )
	2166	!$OMP PARALLEL PRIVATE (i)
	2167	!$OMP DO
	2168	DO i = 0, value_counts(1) - 1
	2169	values_realwp_1d_resorted(i) = values_realwp_1d(masked_indices(1,i))
	2170	ENDDO
	2171	!$OMP END PARALLEL
	2172	ELSE
	2173	ALLOCATE( values_realwp_1d_resorted(1) )
	2174	values_realwp_1d_resorted = 0_1
	2175	ENDIF
	2176	values_realwp_1d_pointer => values_realwp_1d_resorted
	2177	ELSEIF ( PRESENT( values_realwp_2d ) ) THEN
	2178	IF ( do_output ) THEN
[4577]	2179	ALLOCATE( values_realwp_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) )
[4147]	2180	!$OMP PARALLEL PRIVATE (i,j)
	2181	!$OMP DO
	2182	DO i = 0, value_counts(1) - 1
	2183	DO j = 0, value_counts(2) - 1
[4577]	2184	values_realwp_2d_resorted(i,j) = values_realwp_2d(masked_indices(2,j), &
	2185	masked_indices(1,i))
[4147]	2186	ENDDO
	2187	ENDDO
	2188	!$OMP END PARALLEL
	2189	ELSE
	2190	ALLOCATE( values_realwp_2d_resorted(1,1) )
	2191	values_realwp_2d_resorted = 0_1
	2192	ENDIF
	2193	values_realwp_2d_pointer => values_realwp_2d_resorted
	2194	ELSEIF ( PRESENT( values_realwp_3d ) ) THEN
	2195	IF ( do_output ) THEN
[4577]	2196	ALLOCATE( values_realwp_3d_resorted(0:value_counts(1)-1, &
	2197	0:value_counts(2)-1, &
[4147]	2198	0:value_counts(3)-1) )
	2199	!$OMP PARALLEL PRIVATE (i,j,k)
	2200	!$OMP DO
	2201	DO i = 0, value_counts(1) - 1
	2202	DO j = 0, value_counts(2) - 1
	2203	DO k = 0, value_counts(3) - 1
[4577]	2204	values_realwp_3d_resorted(i,j,k) = values_realwp_3d(masked_indices(3,k), &
	2205	masked_indices(2,j), &
	2206	masked_indices(1,i))
[4147]	2207	ENDDO
	2208	ENDDO
	2209	ENDDO
	2210	!$OMP END PARALLEL
	2211	ELSE
	2212	ALLOCATE( values_realwp_3d_resorted(1,1,1) )
	2213	values_realwp_3d_resorted = 0_1
	2214	ENDIF
	2215	values_realwp_3d_pointer => values_realwp_3d_resorted
[4141]	2216
[4147]	2217	ELSE
	2218	return_value = 1
[4577]	2219	CALL internal_message( 'error', routine_name // &
	2220	': no output values given ' // &
	2221	'(variable "' // TRIM( variable_name ) // &
[4147]	2222	'", file "' // TRIM( file_name ) // '")!' )
	2223	ENDIF
[4141]	2224
[4147]	2225	DEALLOCATE( masked_indices )
[4141]	2226
[4147]	2227	ENDIF ! Check for error
[4141]	2228
[4147]	2229	IF ( return_value == 0 ) THEN
	2230	!
	2231	!-- Write variable into file
	2232	SELECT CASE ( TRIM( file_format ) )
[4141]	2233
[4147]	2234	CASE ( 'binary' )
	2235	!
[4577]	2236	!-- Character output
[4408]	2237	IF ( PRESENT( values_char_0d ) ) THEN
[4577]	2238	CALL binary_write_variable( file_id, variable_id, &
	2239	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4408]	2240	values_char_0d=values_char_0d_pointer, return_value=output_return_value )
	2241	ELSEIF ( PRESENT( values_char_1d ) ) THEN
[4577]	2242	CALL binary_write_variable( file_id, variable_id, &
	2243	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4408]	2244	values_char_1d=values_char_1d_pointer, return_value=output_return_value )
	2245	ELSEIF ( PRESENT( values_char_2d ) ) THEN
[4577]	2246	CALL binary_write_variable( file_id, variable_id, &
	2247	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4408]	2248	values_char_2d=values_char_2d_pointer, return_value=output_return_value )
	2249	ELSEIF ( PRESENT( values_char_3d ) ) THEN
[4577]	2250	CALL binary_write_variable( file_id, variable_id, &
	2251	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4408]	2252	values_char_3d=values_char_3d_pointer, return_value=output_return_value )
	2253	!
[4147]	2254	!-- 8bit integer output
[4408]	2255	ELSEIF ( PRESENT( values_int8_0d ) ) THEN
[4577]	2256	CALL binary_write_variable( file_id, variable_id, &
	2257	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2258	values_int8_0d=values_int8_0d_pointer, return_value=output_return_value )
	2259	ELSEIF ( PRESENT( values_int8_1d ) ) THEN
[4577]	2260	CALL binary_write_variable( file_id, variable_id, &
	2261	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2262	values_int8_1d=values_int8_1d_pointer, return_value=output_return_value )
	2263	ELSEIF ( PRESENT( values_int8_2d ) ) THEN
[4577]	2264	CALL binary_write_variable( file_id, variable_id, &
	2265	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2266	values_int8_2d=values_int8_2d_pointer, return_value=output_return_value )
	2267	ELSEIF ( PRESENT( values_int8_3d ) ) THEN
[4577]	2268	CALL binary_write_variable( file_id, variable_id, &
	2269	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2270	values_int8_3d=values_int8_3d_pointer, return_value=output_return_value )
	2271	!
	2272	!-- 16bit integer output
	2273	ELSEIF ( PRESENT( values_int16_0d ) ) THEN
[4577]	2274	CALL binary_write_variable( file_id, variable_id, &
	2275	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2276	values_int16_0d=values_int16_0d_pointer, return_value=output_return_value )
	2277	ELSEIF ( PRESENT( values_int16_1d ) ) THEN
[4577]	2278	CALL binary_write_variable( file_id, variable_id, &
	2279	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2280	values_int16_1d=values_int16_1d_pointer, return_value=output_return_value )
	2281	ELSEIF ( PRESENT( values_int16_2d ) ) THEN
[4577]	2282	CALL binary_write_variable( file_id, variable_id, &
	2283	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2284	values_int16_2d=values_int16_2d_pointer, return_value=output_return_value )
	2285	ELSEIF ( PRESENT( values_int16_3d ) ) THEN
[4577]	2286	CALL binary_write_variable( file_id, variable_id, &
	2287	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2288	values_int16_3d=values_int16_3d_pointer, return_value=output_return_value )
	2289	!
	2290	!-- 32bit integer output
	2291	ELSEIF ( PRESENT( values_int32_0d ) ) THEN
[4577]	2292	CALL binary_write_variable( file_id, variable_id, &
	2293	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2294	values_int32_0d=values_int32_0d_pointer, return_value=output_return_value )
	2295	ELSEIF ( PRESENT( values_int32_1d ) ) THEN
[4577]	2296	CALL binary_write_variable( file_id, variable_id, &
	2297	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2298	values_int32_1d=values_int32_1d_pointer, return_value=output_return_value )
	2299	ELSEIF ( PRESENT( values_int32_2d ) ) THEN
[4577]	2300	CALL binary_write_variable( file_id, variable_id, &
	2301	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2302	values_int32_2d=values_int32_2d_pointer, return_value=output_return_value )
	2303	ELSEIF ( PRESENT( values_int32_3d ) ) THEN
[4577]	2304	CALL binary_write_variable( file_id, variable_id, &
	2305	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2306	values_int32_3d=values_int32_3d_pointer, return_value=output_return_value )
	2307	!
[4577]	2308	!-- Working-precision integer output
[4147]	2309	ELSEIF ( PRESENT( values_intwp_0d ) ) THEN
[4577]	2310	CALL binary_write_variable( file_id, variable_id, &
	2311	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2312	values_intwp_0d=values_intwp_0d_pointer, return_value=output_return_value )
	2313	ELSEIF ( PRESENT( values_intwp_1d ) ) THEN
[4577]	2314	CALL binary_write_variable( file_id, variable_id, &
	2315	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2316	values_intwp_1d=values_intwp_1d_pointer, return_value=output_return_value )
	2317	ELSEIF ( PRESENT( values_intwp_2d ) ) THEN
[4577]	2318	CALL binary_write_variable( file_id, variable_id, &
	2319	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2320	values_intwp_2d=values_intwp_2d_pointer, return_value=output_return_value )
	2321	ELSEIF ( PRESENT( values_intwp_3d ) ) THEN
[4577]	2322	CALL binary_write_variable( file_id, variable_id, &
	2323	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2324	values_intwp_3d=values_intwp_3d_pointer, return_value=output_return_value )
	2325	!
	2326	!-- 32bit real output
	2327	ELSEIF ( PRESENT( values_real32_0d ) ) THEN
[4577]	2328	CALL binary_write_variable( file_id, variable_id, &
	2329	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2330	values_real32_0d=values_real32_0d_pointer, return_value=output_return_value )
	2331	ELSEIF ( PRESENT( values_real32_1d ) ) THEN
[4577]	2332	CALL binary_write_variable( file_id, variable_id, &
	2333	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2334	values_real32_1d=values_real32_1d_pointer, return_value=output_return_value )
	2335	ELSEIF ( PRESENT( values_real32_2d ) ) THEN
[4577]	2336	CALL binary_write_variable( file_id, variable_id, &
	2337	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2338	values_real32_2d=values_real32_2d_pointer, return_value=output_return_value )
	2339	ELSEIF ( PRESENT( values_real32_3d ) ) THEN
[4577]	2340	CALL binary_write_variable( file_id, variable_id, &
	2341	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2342	values_real32_3d=values_real32_3d_pointer, return_value=output_return_value )
	2343	!
	2344	!-- 64bit real output
	2345	ELSEIF ( PRESENT( values_real64_0d ) ) THEN
[4577]	2346	CALL binary_write_variable( file_id, variable_id, &
	2347	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2348	values_real64_0d=values_real64_0d_pointer, return_value=output_return_value )
	2349	ELSEIF ( PRESENT( values_real64_1d ) ) THEN
[4577]	2350	CALL binary_write_variable( file_id, variable_id, &
	2351	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2352	values_real64_1d=values_real64_1d_pointer, return_value=output_return_value )
	2353	ELSEIF ( PRESENT( values_real64_2d ) ) THEN
[4577]	2354	CALL binary_write_variable( file_id, variable_id, &
	2355	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2356	values_real64_2d=values_real64_2d_pointer, return_value=output_return_value )
	2357	ELSEIF ( PRESENT( values_real64_3d ) ) THEN
[4577]	2358	CALL binary_write_variable( file_id, variable_id, &
	2359	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2360	values_real64_3d=values_real64_3d_pointer, return_value=output_return_value )
	2361	!
	2362	!-- working-precision real output
	2363	ELSEIF ( PRESENT( values_realwp_0d ) ) THEN
[4577]	2364	CALL binary_write_variable( file_id, variable_id, &
	2365	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2366	values_realwp_0d=values_realwp_0d_pointer, return_value=output_return_value )
	2367	ELSEIF ( PRESENT( values_realwp_1d ) ) THEN
[4577]	2368	CALL binary_write_variable( file_id, variable_id, &
	2369	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2370	values_realwp_1d=values_realwp_1d_pointer, return_value=output_return_value )
	2371	ELSEIF ( PRESENT( values_realwp_2d ) ) THEN
[4577]	2372	CALL binary_write_variable( file_id, variable_id, &
	2373	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2374	values_realwp_2d=values_realwp_2d_pointer, return_value=output_return_value )
	2375	ELSEIF ( PRESENT( values_realwp_3d ) ) THEN
[4577]	2376	CALL binary_write_variable( file_id, variable_id, &
	2377	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2378	values_realwp_3d=values_realwp_3d_pointer, return_value=output_return_value )
	2379	ELSE
	2380	return_value = 1
[4577]	2381	CALL internal_message( 'error', routine_name // &
	2382	': output_type not supported by file format "' // &
	2383	TRIM( file_format ) // '" ' // &
	2384	'(variable "' // TRIM( variable_name ) // &
[4147]	2385	'", file "' // TRIM( file_name ) // '")!' )
	2386	ENDIF
[4141]	2387
[4147]	2388	CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
	2389	!
[4577]	2390	!-- Character output
[4408]	2391	IF ( PRESENT( values_char_0d ) ) THEN
[4577]	2392	CALL netcdf4_write_variable( file_id, variable_id, &
	2393	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4408]	2394	values_char_0d=values_char_0d_pointer, return_value=output_return_value )
	2395	ELSEIF ( PRESENT( values_char_1d ) ) THEN
[4577]	2396	CALL netcdf4_write_variable( file_id, variable_id, &
	2397	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4408]	2398	values_char_1d=values_char_1d_pointer, return_value=output_return_value )
	2399	ELSEIF ( PRESENT( values_char_2d ) ) THEN
[4577]	2400	CALL netcdf4_write_variable( file_id, variable_id, &
	2401	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4408]	2402	values_char_2d=values_char_2d_pointer, return_value=output_return_value )
	2403	ELSEIF ( PRESENT( values_char_3d ) ) THEN
[4577]	2404	CALL netcdf4_write_variable( file_id, variable_id, &
	2405	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4408]	2406	values_char_3d=values_char_3d_pointer, return_value=output_return_value )
	2407	!
[4147]	2408	!-- 8bit integer output
[4408]	2409	ELSEIF ( PRESENT( values_int8_0d ) ) THEN
[4577]	2410	CALL netcdf4_write_variable( file_id, variable_id, &
	2411	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2412	values_int8_0d=values_int8_0d_pointer, return_value=output_return_value )
	2413	ELSEIF ( PRESENT( values_int8_1d ) ) THEN
[4577]	2414	CALL netcdf4_write_variable( file_id, variable_id, &
	2415	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2416	values_int8_1d=values_int8_1d_pointer, return_value=output_return_value )
	2417	ELSEIF ( PRESENT( values_int8_2d ) ) THEN
[4577]	2418	CALL netcdf4_write_variable( file_id, variable_id, &
	2419	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2420	values_int8_2d=values_int8_2d_pointer, return_value=output_return_value )
	2421	ELSEIF ( PRESENT( values_int8_3d ) ) THEN
[4577]	2422	CALL netcdf4_write_variable( file_id, variable_id, &
	2423	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2424	values_int8_3d=values_int8_3d_pointer, return_value=output_return_value )
	2425	!
	2426	!-- 16bit integer output
	2427	ELSEIF ( PRESENT( values_int16_0d ) ) THEN
[4577]	2428	CALL netcdf4_write_variable( file_id, variable_id, &
	2429	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2430	values_int16_0d=values_int16_0d_pointer, return_value=output_return_value )
	2431	ELSEIF ( PRESENT( values_int16_1d ) ) THEN
[4577]	2432	CALL netcdf4_write_variable( file_id, variable_id, &
	2433	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2434	values_int16_1d=values_int16_1d_pointer, return_value=output_return_value )
	2435	ELSEIF ( PRESENT( values_int16_2d ) ) THEN
[4577]	2436	CALL netcdf4_write_variable( file_id, variable_id, &
	2437	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2438	values_int16_2d=values_int16_2d_pointer, return_value=output_return_value )
	2439	ELSEIF ( PRESENT( values_int16_3d ) ) THEN
[4577]	2440	CALL netcdf4_write_variable( file_id, variable_id, &
	2441	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2442	values_int16_3d=values_int16_3d_pointer, return_value=output_return_value )
	2443	!
	2444	!-- 32bit integer output
	2445	ELSEIF ( PRESENT( values_int32_0d ) ) THEN
[4577]	2446	CALL netcdf4_write_variable( file_id, variable_id, &
	2447	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2448	values_int32_0d=values_int32_0d_pointer, return_value=output_return_value )
	2449	ELSEIF ( PRESENT( values_int32_1d ) ) THEN
[4577]	2450	CALL netcdf4_write_variable( file_id, variable_id, &
	2451	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2452	values_int32_1d=values_int32_1d_pointer, return_value=output_return_value )
	2453	ELSEIF ( PRESENT( values_int32_2d ) ) THEN
[4577]	2454	CALL netcdf4_write_variable( file_id, variable_id, &
	2455	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2456	values_int32_2d=values_int32_2d_pointer, return_value=output_return_value )
	2457	ELSEIF ( PRESENT( values_int32_3d ) ) THEN
[4577]	2458	CALL netcdf4_write_variable( file_id, variable_id, &
	2459	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2460	values_int32_3d=values_int32_3d_pointer, return_value=output_return_value )
	2461	!
[4577]	2462	!-- Working-precision integer output
[4147]	2463	ELSEIF ( PRESENT( values_intwp_0d ) ) THEN
[4577]	2464	CALL netcdf4_write_variable( file_id, variable_id, &
	2465	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2466	values_intwp_0d=values_intwp_0d_pointer, return_value=output_return_value )
	2467	ELSEIF ( PRESENT( values_intwp_1d ) ) THEN
[4577]	2468	CALL netcdf4_write_variable( file_id, variable_id, &
	2469	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2470	values_intwp_1d=values_intwp_1d_pointer, return_value=output_return_value )
	2471	ELSEIF ( PRESENT( values_intwp_2d ) ) THEN
[4577]	2472	CALL netcdf4_write_variable( file_id, variable_id, &
	2473	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2474	values_intwp_2d=values_intwp_2d_pointer, return_value=output_return_value )
	2475	ELSEIF ( PRESENT( values_intwp_3d ) ) THEN
[4577]	2476	CALL netcdf4_write_variable( file_id, variable_id, &
	2477	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2478	values_intwp_3d=values_intwp_3d_pointer, return_value=output_return_value )
	2479	!
	2480	!-- 32bit real output
	2481	ELSEIF ( PRESENT( values_real32_0d ) ) THEN
[4577]	2482	CALL netcdf4_write_variable( file_id, variable_id, &
	2483	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2484	values_real32_0d=values_real32_0d_pointer, return_value=output_return_value )
	2485	ELSEIF ( PRESENT( values_real32_1d ) ) THEN
[4577]	2486	CALL netcdf4_write_variable( file_id, variable_id, &
	2487	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2488	values_real32_1d=values_real32_1d_pointer, return_value=output_return_value )
	2489	ELSEIF ( PRESENT( values_real32_2d ) ) THEN
[4577]	2490	CALL netcdf4_write_variable( file_id, variable_id, &
	2491	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2492	values_real32_2d=values_real32_2d_pointer, return_value=output_return_value )
	2493	ELSEIF ( PRESENT( values_real32_3d ) ) THEN
[4577]	2494	CALL netcdf4_write_variable( file_id, variable_id, &
	2495	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2496	values_real32_3d=values_real32_3d_pointer, return_value=output_return_value )
	2497	!
	2498	!-- 64bit real output
	2499	ELSEIF ( PRESENT( values_real64_0d ) ) THEN
[4577]	2500	CALL netcdf4_write_variable( file_id, variable_id, &
	2501	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2502	values_real64_0d=values_real64_0d_pointer, return_value=output_return_value )
	2503	ELSEIF ( PRESENT( values_real64_1d ) ) THEN
[4577]	2504	CALL netcdf4_write_variable( file_id, variable_id, &
	2505	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2506	values_real64_1d=values_real64_1d_pointer, return_value=output_return_value )
	2507	ELSEIF ( PRESENT( values_real64_2d ) ) THEN
[4577]	2508	CALL netcdf4_write_variable( file_id, variable_id, &
	2509	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2510	values_real64_2d=values_real64_2d_pointer, return_value=output_return_value )
	2511	ELSEIF ( PRESENT( values_real64_3d ) ) THEN
[4577]	2512	CALL netcdf4_write_variable( file_id, variable_id, &
	2513	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2514	values_real64_3d=values_real64_3d_pointer, return_value=output_return_value )
	2515	!
	2516	!-- working-precision real output
	2517	ELSEIF ( PRESENT( values_realwp_0d ) ) THEN
[4577]	2518	CALL netcdf4_write_variable( file_id, variable_id, &
	2519	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2520	values_realwp_0d=values_realwp_0d_pointer, return_value=output_return_value )
	2521	ELSEIF ( PRESENT( values_realwp_1d ) ) THEN
[4577]	2522	CALL netcdf4_write_variable( file_id, variable_id, &
	2523	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2524	values_realwp_1d=values_realwp_1d_pointer, return_value=output_return_value )
	2525	ELSEIF ( PRESENT( values_realwp_2d ) ) THEN
[4577]	2526	CALL netcdf4_write_variable( file_id, variable_id, &
	2527	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2528	values_realwp_2d=values_realwp_2d_pointer, return_value=output_return_value )
	2529	ELSEIF ( PRESENT( values_realwp_3d ) ) THEN
[4577]	2530	CALL netcdf4_write_variable( file_id, variable_id, &
	2531	bounds_start_internal, value_counts, bounds_origin, is_global, &
[4147]	2532	values_realwp_3d=values_realwp_3d_pointer, return_value=output_return_value )
	2533	ELSE
	2534	return_value = 1
[4577]	2535	CALL internal_message( 'error', routine_name // &
	2536	': output_type not supported by file format "' // &
	2537	TRIM( file_format ) // '" ' // &
	2538	'(variable "' // TRIM( variable_name ) // &
[4147]	2539	'", file "' // TRIM( file_name ) // '")!' )
	2540	ENDIF
[4141]	2541
[4147]	2542	CASE DEFAULT
	2543	return_value = 1
[4577]	2544	CALL internal_message( 'error', routine_name // &
	2545	': file format "' // TRIM( file_format ) // &
	2546	'" not supported ' // &
	2547	'(variable "' // TRIM( variable_name ) // &
[4147]	2548	'", file "' // TRIM( file_name ) // '")!' )
[4141]	2549
[4147]	2550	END SELECT
[4141]	2551
[4147]	2552	IF ( return_value == 0 .AND. output_return_value /= 0 ) THEN
	2553	return_value = 1
[4577]	2554	CALL internal_message( 'error', routine_name // &
	2555	': error while writing variable ' // &
	2556	'(variable "' // TRIM( variable_name ) // &
[4147]	2557	'", file "' // TRIM( file_name ) // '")!' )
	2558	ENDIF
[4141]	2559
[4147]	2560	ENDIF
[4141]	2561
[4147]	2562	END FUNCTION dom_write_var
[4070]	2563
	2564	!--------------------------------------------------------------------------------------------------!
	2565	! Description:
	2566	! ------------
[4141]	2567	!> Finalize output.
	2568	!> All necessary steps are carried out to close all output files. If a file could not be closed,
	2569	!> this is noted in the error message.
	2570	!>
	2571	!> @bug if multiple files failed to be closed, only the last failure is given in the error message.
	2572	!--------------------------------------------------------------------------------------------------!
[4147]	2573	FUNCTION dom_finalize_output() RESULT( return_value )
[4141]	2574
[4147]	2575	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_finalize_output' !< name of routine
[4141]	2576
[4147]	2577	INTEGER :: f !< loop index
	2578	INTEGER :: output_return_value !< return value from called routines
	2579	INTEGER :: return_value !< return value
	2580	INTEGER :: return_value_internal !< error code after closing a single file
[4141]	2581
	2582
[4147]	2583	return_value = 0
[4141]	2584
[4147]	2585	DO f = 1, nfiles
[4141]	2586
[4147]	2587	IF ( files(f)%is_init ) THEN
[4141]	2588
[4147]	2589	output_return_value = 0
	2590	return_value_internal = 0
[4141]	2591
[4147]	2592	SELECT CASE ( TRIM( files(f)%format ) )
[4141]	2593
[4147]	2594	CASE ( 'binary' )
	2595	CALL binary_finalize( files(f)%id, output_return_value )
[4141]	2596
[4147]	2597	CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
	2598	CALL netcdf4_finalize( files(f)%id, output_return_value )
[4141]	2599
[4147]	2600	CASE DEFAULT
	2601	return_value_internal = 1
[4141]	2602
[4147]	2603	END SELECT
[4141]	2604
[4147]	2605	IF ( output_return_value /= 0 ) THEN
	2606	return_value = output_return_value
[4577]	2607	CALL internal_message( 'error', routine_name // &
	2608	': error while finalizing file "' // &
[4147]	2609	TRIM( files(f)%name ) // '"' )
	2610	ELSEIF ( return_value_internal /= 0 ) THEN
	2611	return_value = return_value_internal
[4577]	2612	CALL internal_message( 'error', routine_name // &
	2613	': unsupported file format "' // &
	2614	TRIM( files(f)%format ) // '" for file "' // &
[4147]	2615	TRIM( files(f)%name ) // '"' )
	2616	ENDIF
[4141]	2617
[4147]	2618	ENDIF
[4141]	2619
[4147]	2620	ENDDO
[4141]	2621
[4147]	2622	END FUNCTION dom_finalize_output
[4141]	2623
	2624	!--------------------------------------------------------------------------------------------------!
	2625	! Description:
	2626	! ------------
	2627	!> Return the last created error message.
	2628	!--------------------------------------------------------------------------------------------------!
[4147]	2629	FUNCTION dom_get_error_message() RESULT( error_message )
[4141]	2630
[4147]	2631	CHARACTER(LEN=800) :: error_message !< return error message to main program
[4141]	2632
	2633
[4147]	2634	error_message = TRIM( internal_error_message )
[4141]	2635
[4147]	2636	error_message = TRIM( error_message ) // TRIM( binary_get_error_message() )
[4141]	2637
[4147]	2638	error_message = TRIM( error_message ) // TRIM( netcdf4_get_error_message() )
[4141]	2639
[4147]	2640	internal_error_message = ''
	2641
	2642	END FUNCTION dom_get_error_message
	2643
[4141]	2644	!--------------------------------------------------------------------------------------------------!
	2645	! Description:
	2646	! ------------
[4070]	2647	!> Add attribute to database.
	2648	!>
	2649	!> @todo Try to combine similar code parts and shorten routine.
	2650	!--------------------------------------------------------------------------------------------------!
[4147]	2651	FUNCTION save_attribute_in_database( file_name, variable_name, attribute, append ) &
	2652	RESULT( return_value )
[4070]	2653
[4577]	2654	CHARACTER(LEN=*), PARAMETER :: routine_name = 'save_attribute_in_database' !< name of routine
	2655
[4147]	2656	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	2657	CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable
[4070]	2658
[4147]	2659	INTEGER :: a !< loop index
	2660	INTEGER :: d !< loop index
	2661	INTEGER :: f !< loop index
	2662	INTEGER :: natts !< number of attributes
	2663	INTEGER :: return_value !< return value
[4070]	2664
[4147]	2665	LOGICAL :: found !< true if variable or dimension of name 'variable_name' found
	2666	LOGICAL, INTENT(IN) :: append !< if true, append value to existing value
[4070]	2667
[4147]	2668	TYPE(attribute_type), INTENT(IN) :: attribute !< new attribute
[4070]	2669
[4147]	2670	TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: atts_tmp !< temporary attribute list
[4070]	2671
	2672
[4147]	2673	return_value = 0
	2674	found = .FALSE.
[4070]	2675
[4577]	2676	CALL internal_message( 'debug', routine_name // &
	2677	': define attribute "' // TRIM( attribute%name ) // &
	2678	'" of variable "' // TRIM( variable_name ) // &
[4147]	2679	'" in file "' // TRIM( file_name ) // '"' )
[4116]	2680
[4147]	2681	DO f = 1, nfiles
[4070]	2682
[4147]	2683	IF ( TRIM( file_name ) == files(f)%name ) THEN
[4070]	2684
[4147]	2685	IF ( files(f)%is_init ) THEN
	2686	return_value = 1
[4577]	2687	CALL internal_message( 'error', routine_name // ': file "' // TRIM( file_name ) // &
[4147]	2688	'" is already initialized. No further attribute definition allowed!' )
	2689	EXIT
	2690	ENDIF
	2691	!
	2692	!-- Add attribute to file
	2693	IF ( TRIM( variable_name ) == '' ) THEN
	2694	!
	2695	!-- Initialize first file attribute
	2696	IF ( .NOT. ALLOCATED( files(f)%attributes ) ) THEN
	2697	natts = 1
	2698	ALLOCATE( files(f)%attributes(natts) )
	2699	ELSE
	2700	natts = SIZE( files(f)%attributes )
	2701	!
	2702	!-- Check if attribute already exists
	2703	DO a = 1, natts
	2704	IF ( files(f)%attributes(a)%name == attribute%name ) THEN
	2705	IF ( append ) THEN
	2706	!
	2707	!-- Append existing string attribute
[4577]	2708	files(f)%attributes(a)%value_char = &
	2709	TRIM( files(f)%attributes(a)%value_char ) // &
	2710	TRIM( attribute%value_char )
[4147]	2711	ELSE
	2712	files(f)%attributes(a) = attribute
	2713	ENDIF
	2714	found = .TRUE.
	2715	EXIT
	2716	ENDIF
	2717	ENDDO
	2718	!
	2719	!-- Extend attribute list by 1
	2720	IF ( .NOT. found ) THEN
	2721	ALLOCATE( atts_tmp(natts) )
	2722	atts_tmp = files(f)%attributes
	2723	DEALLOCATE( files(f)%attributes )
	2724	natts = natts + 1
	2725	ALLOCATE( files(f)%attributes(natts) )
	2726	files(f)%attributes(:natts-1) = atts_tmp
	2727	DEALLOCATE( atts_tmp )
	2728	ENDIF
	2729	ENDIF
	2730	!
	2731	!-- Save new attribute to the end of the attribute list
	2732	IF ( .NOT. found ) THEN
	2733	files(f)%attributes(natts) = attribute
	2734	found = .TRUE.
	2735	ENDIF
[4106]	2736
[4147]	2737	EXIT
[4070]	2738
[4147]	2739	ELSE
	2740	!
	2741	!-- Add attribute to dimension
	2742	IF ( ALLOCATED( files(f)%dimensions ) ) THEN
[4070]	2743
[4147]	2744	DO d = 1, SIZE( files(f)%dimensions )
[4070]	2745
[4147]	2746	IF ( files(f)%dimensions(d)%name == TRIM( variable_name ) ) THEN
[4070]	2747
[4147]	2748	IF ( .NOT. ALLOCATED( files(f)%dimensions(d)%attributes ) ) THEN
	2749	!
	2750	!-- Initialize first attribute
	2751	natts = 1
	2752	ALLOCATE( files(f)%dimensions(d)%attributes(natts) )
	2753	ELSE
	2754	natts = SIZE( files(f)%dimensions(d)%attributes )
	2755	!
	2756	!-- Check if attribute already exists
	2757	DO a = 1, natts
	2758	IF ( files(f)%dimensions(d)%attributes(a)%name == attribute%name ) &
	2759	THEN
	2760	IF ( append ) THEN
	2761	!
	2762	!-- Append existing character attribute
[4577]	2763	files(f)%dimensions(d)%attributes(a)%value_char = &
	2764	TRIM( files(f)%dimensions(d)%attributes(a)%value_char ) // &
[4147]	2765	TRIM( attribute%value_char )
	2766	ELSE
	2767	!
	2768	!-- Update existing attribute
	2769	files(f)%dimensions(d)%attributes(a) = attribute
	2770	ENDIF
	2771	found = .TRUE.
	2772	EXIT
	2773	ENDIF
	2774	ENDDO
	2775	!
	2776	!-- Extend attribute list
	2777	IF ( .NOT. found ) THEN
	2778	ALLOCATE( atts_tmp(natts) )
	2779	atts_tmp = files(f)%dimensions(d)%attributes
	2780	DEALLOCATE( files(f)%dimensions(d)%attributes )
	2781	natts = natts + 1
	2782	ALLOCATE( files(f)%dimensions(d)%attributes(natts) )
	2783	files(f)%dimensions(d)%attributes(:natts-1) = atts_tmp
	2784	DEALLOCATE( atts_tmp )
	2785	ENDIF
	2786	ENDIF
	2787	!
	2788	!-- Add new attribute to database
	2789	IF ( .NOT. found ) THEN
	2790	files(f)%dimensions(d)%attributes(natts) = attribute
	2791	found = .TRUE.
	2792	ENDIF
[4070]	2793
[4147]	2794	EXIT
[4070]	2795
[4147]	2796	ENDIF ! dimension found
[4070]	2797
[4147]	2798	ENDDO ! loop over dimensions
[4070]	2799
[4147]	2800	ENDIF ! dimensions exist in file
	2801	!
	2802	!-- Add attribute to variable
	2803	IF ( .NOT. found .AND. ALLOCATED( files(f)%variables) ) THEN
[4070]	2804
[4147]	2805	DO d = 1, SIZE( files(f)%variables )
[4070]	2806
[4147]	2807	IF ( files(f)%variables(d)%name == TRIM( variable_name ) ) THEN
[4070]	2808
[4147]	2809	IF ( .NOT. ALLOCATED( files(f)%variables(d)%attributes ) ) THEN
	2810	!
	2811	!-- Initialize first attribute
	2812	natts = 1
	2813	ALLOCATE( files(f)%variables(d)%attributes(natts) )
	2814	ELSE
	2815	natts = SIZE( files(f)%variables(d)%attributes )
	2816	!
	2817	!-- Check if attribute already exists
	2818	DO a = 1, natts
[4577]	2819	IF ( files(f)%variables(d)%attributes(a)%name == attribute%name ) THEN
[4147]	2820	IF ( append ) THEN
	2821	!
	2822	!-- Append existing character attribute
[4577]	2823	files(f)%variables(d)%attributes(a)%value_char = &
	2824	TRIM( files(f)%variables(d)%attributes(a)%value_char ) // &
[4147]	2825	TRIM( attribute%value_char )
	2826	ELSE
	2827	!
	2828	!-- Update existing attribute
	2829	files(f)%variables(d)%attributes(a) = attribute
	2830	ENDIF
	2831	found = .TRUE.
	2832	EXIT
	2833	ENDIF
	2834	ENDDO
	2835	!
	2836	!-- Extend attribute list
	2837	IF ( .NOT. found ) THEN
	2838	ALLOCATE( atts_tmp(natts) )
	2839	atts_tmp = files(f)%variables(d)%attributes
	2840	DEALLOCATE( files(f)%variables(d)%attributes )
	2841	natts = natts + 1
	2842	ALLOCATE( files(f)%variables(d)%attributes(natts) )
	2843	files(f)%variables(d)%attributes(:natts-1) = atts_tmp
	2844	DEALLOCATE( atts_tmp )
	2845	ENDIF
[4070]	2846
[4147]	2847	ENDIF
	2848	!
	2849	!-- Add new attribute to database
	2850	IF ( .NOT. found ) THEN
	2851	files(f)%variables(d)%attributes(natts) = attribute
	2852	found = .TRUE.
	2853	ENDIF
[4070]	2854
[4147]	2855	EXIT
[4070]	2856
[4147]	2857	ENDIF ! variable found
[4070]	2858
[4147]	2859	ENDDO ! loop over variables
[4070]	2860
[4147]	2861	ENDIF ! variables exist in file
[4070]	2862
[4147]	2863	IF ( .NOT. found ) THEN
	2864	return_value = 1
[4577]	2865	CALL internal_message( 'error', &
	2866	routine_name // &
	2867	': requested dimension/variable "' // TRIM( variable_name ) // &
	2868	'" for attribute "' // TRIM( attribute%name ) // &
	2869	'" does not exist in file "' // TRIM( file_name ) // '"' )
[4147]	2870	ENDIF
[4070]	2871
[4147]	2872	EXIT
[4070]	2873
[4147]	2874	ENDIF ! variable_name not empty
[4070]	2875
[4147]	2876	ENDIF ! check file_name
[4070]	2877
[4147]	2878	ENDDO ! loop over files
[4070]	2879
[4147]	2880	IF ( .NOT. found .AND. return_value == 0 ) THEN
	2881	return_value = 1
[4577]	2882	CALL internal_message( 'error', &
	2883	routine_name // &
	2884	': requested file "' // TRIM( file_name ) // &
	2885	'" for attribute "' // TRIM( attribute%name ) // &
[4147]	2886	'" does not exist' )
	2887	ENDIF
[4070]	2888
[4147]	2889	END FUNCTION save_attribute_in_database
[4070]	2890
	2891	!--------------------------------------------------------------------------------------------------!
	2892	! Description:
	2893	! ------------
	2894	!> Check database and delete any unused dimensions and empty files (i.e. files
	2895	!> without variables).
	2896	!--------------------------------------------------------------------------------------------------!
[4147]	2897	FUNCTION cleanup_database() RESULT( return_value )
[4070]	2898
[4147]	2899	! CHARACTER(LEN=*), PARAMETER :: routine_name = 'cleanup_database' !< name of routine
[4070]	2900
[4147]	2901	INTEGER :: d !< loop index
	2902	INTEGER :: f !< loop index
	2903	INTEGER :: i !< loop index
	2904	INTEGER :: ndims !< number of dimensions in a file
	2905	INTEGER :: ndims_used !< number of used dimensions in a file
	2906	INTEGER :: nfiles_used !< number of used files
	2907	INTEGER :: nvars !< number of variables in a file
	2908	INTEGER :: return_value !< return value
[4070]	2909
[4147]	2910	LOGICAL, DIMENSION(1:nfiles) :: file_is_used !< true if file contains variables
	2911	LOGICAL, DIMENSION(:), ALLOCATABLE :: dimension_is_used !< true if dimension is used by any variable
[4070]	2912
[4147]	2913	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: used_dimensions !< list of used dimensions
[4070]	2914
[4147]	2915	TYPE(file_type), DIMENSION(:), ALLOCATABLE :: used_files !< list of used files
[4070]	2916
	2917
[4147]	2918	return_value = 0
	2919	!
	2920	!-- Flag files which contain output variables as used
	2921	file_is_used(:) = .FALSE.
	2922	DO f = 1, nfiles
	2923	IF ( ALLOCATED( files(f)%variables ) ) THEN
	2924	file_is_used(f) = .TRUE.
	2925	ENDIF
	2926	ENDDO
	2927	!
	2928	!-- Copy flagged files into temporary list
	2929	nfiles_used = COUNT( file_is_used )
	2930	ALLOCATE( used_files(nfiles_used) )
	2931	i = 0
	2932	DO f = 1, nfiles
	2933	IF ( file_is_used(f) ) THEN
	2934	i = i + 1
	2935	used_files(i) = files(f)
	2936	ENDIF
	2937	ENDDO
	2938	!
	2939	!-- Replace file list with list of used files
	2940	DEALLOCATE( files )
	2941	nfiles = nfiles_used
	2942	ALLOCATE( files(nfiles) )
	2943	files = used_files
	2944	DEALLOCATE( used_files )
	2945	!
	2946	!-- Check every file for unused dimensions
	2947	DO f = 1, nfiles
	2948	!
	2949	!-- If a file is already initialized, it was already checked previously
	2950	IF ( files(f)%is_init ) CYCLE
	2951	!
	2952	!-- Get number of defined dimensions
	2953	ndims = SIZE( files(f)%dimensions )
	2954	ALLOCATE( dimension_is_used(ndims) )
	2955	!
	2956	!-- Go through all variables and flag all used dimensions
	2957	nvars = SIZE( files(f)%variables )
	2958	DO d = 1, ndims
	2959	DO i = 1, nvars
[4577]	2960	dimension_is_used(d) = &
	2961	ANY( files(f)%dimensions(d)%name == files(f)%variables(i)%dimension_names )
[4147]	2962	IF ( dimension_is_used(d) ) EXIT
	2963	ENDDO
	2964	ENDDO
	2965	!
	2966	!-- Copy used dimensions to temporary list
	2967	ndims_used = COUNT( dimension_is_used )
	2968	ALLOCATE( used_dimensions(ndims_used) )
	2969	i = 0
	2970	DO d = 1, ndims
	2971	IF ( dimension_is_used(d) ) THEN
	2972	i = i + 1
	2973	used_dimensions(i) = files(f)%dimensions(d)
	2974	ENDIF
	2975	ENDDO
	2976	!
	2977	!-- Replace dimension list with list of used dimensions
	2978	DEALLOCATE( files(f)%dimensions )
	2979	ndims = ndims_used
	2980	ALLOCATE( files(f)%dimensions(ndims) )
	2981	files(f)%dimensions = used_dimensions
	2982	DEALLOCATE( used_dimensions )
	2983	DEALLOCATE( dimension_is_used )
[4070]	2984
[4147]	2985	ENDDO
[4070]	2986
[4147]	2987	END FUNCTION cleanup_database
[4070]	2988
	2989	!--------------------------------------------------------------------------------------------------!
	2990	! Description:
	2991	! ------------
	2992	!> Open requested output file.
	2993	!--------------------------------------------------------------------------------------------------!
[4147]	2994	SUBROUTINE open_output_file( file_format, file_name, file_id, return_value )
[4070]	2995
[4577]	2996	CHARACTER(LEN=*), PARAMETER :: routine_name = 'open_output_file' !< name of routine
	2997
[4147]	2998	CHARACTER(LEN=*), INTENT(IN) :: file_format !< file format chosen for file
	2999	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file to be checked
[4070]	3000
[4147]	3001	INTEGER, INTENT(OUT) :: file_id !< file ID
	3002	INTEGER :: output_return_value !< return value of a called output routine
	3003	INTEGER, INTENT(OUT) :: return_value !< return value
[4070]	3004
	3005
[4147]	3006	return_value = 0
	3007	output_return_value = 0
[4070]	3008
[4147]	3009	SELECT CASE ( TRIM( file_format ) )
[4070]	3010
[4147]	3011	CASE ( 'binary' )
	3012	CALL binary_open_file( 'binary', file_name, file_id, output_return_value )
[4070]	3013
[4147]	3014	CASE ( 'netcdf4-serial' )
	3015	CALL netcdf4_open_file( 'serial', file_name, file_id, output_return_value )
[4070]	3016
[4147]	3017	CASE ( 'netcdf4-parallel' )
	3018	CALL netcdf4_open_file( 'parallel', file_name, file_id, output_return_value )
[4070]	3019
[4147]	3020	CASE DEFAULT
	3021	return_value = 1
[4070]	3022
[4147]	3023	END SELECT
[4070]	3024
[4147]	3025	IF ( output_return_value /= 0 ) THEN
	3026	return_value = output_return_value
[4577]	3027	CALL internal_message( 'error', routine_name // &
[4147]	3028	': error while opening file "' // TRIM( file_name ) // '"' )
	3029	ELSEIF ( return_value /= 0 ) THEN
[4577]	3030	CALL internal_message( 'error', routine_name // &
	3031	': file "' // TRIM( file_name ) // &
	3032	'": file format "' // TRIM( file_format ) // &
[4147]	3033	'" not supported' )
	3034	ENDIF
[4070]	3035
[4147]	3036	END SUBROUTINE open_output_file
[4070]	3037
	3038	!--------------------------------------------------------------------------------------------------!
	3039	! Description:
	3040	! ------------
[4141]	3041	!> Initialize attributes, dimensions and variables in a file.
[4070]	3042	!--------------------------------------------------------------------------------------------------!
[4147]	3043	SUBROUTINE init_file_header( file, return_value )
[4070]	3044
[4147]	3045	! CHARACTER(LEN=*), PARAMETER :: routine_name = 'init_file_header' !< name of routine
[4070]	3046
[4147]	3047	INTEGER :: a !< loop index
	3048	INTEGER :: d !< loop index
	3049	INTEGER, INTENT(OUT) :: return_value !< return value
[4070]	3050
[4147]	3051	TYPE(file_type), INTENT(INOUT) :: file !< initialize header of this file
[4070]	3052
	3053
[4147]	3054	return_value = 0
	3055	!
	3056	!-- Write file attributes
	3057	IF ( ALLOCATED( file%attributes ) ) THEN
	3058	DO a = 1, SIZE( file%attributes )
[4577]	3059	return_value = write_attribute( file%format, file%id, file%name, &
	3060	variable_id=no_id, variable_name='', &
[4147]	3061	attribute=file%attributes(a) )
	3062	IF ( return_value /= 0 ) EXIT
	3063	ENDDO
	3064	ENDIF
[4070]	3065
[4147]	3066	IF ( return_value == 0 ) THEN
	3067	!
	3068	!-- Initialize file dimensions
	3069	DO d = 1, SIZE( file%dimensions )
[4070]	3070
[4147]	3071	IF ( .NOT. file%dimensions(d)%is_masked ) THEN
	3072	!
	3073	!-- Initialize non-masked dimension
[4577]	3074	CALL init_file_dimension( file%format, file%id, file%name, &
	3075	file%dimensions(d)%id, file%dimensions(d)%name, &
	3076	file%dimensions(d)%data_type, file%dimensions(d)%length, &
	3077	file%dimensions(d)%variable_id, return_value )
[4070]	3078
[4147]	3079	ELSE
	3080	!
	3081	!-- Initialize masked dimension
[4577]	3082	CALL init_file_dimension( file%format, file%id, file%name, &
	3083	file%dimensions(d)%id, file%dimensions(d)%name, &
	3084	file%dimensions(d)%data_type, file%dimensions(d)%length_mask,&
	3085	file%dimensions(d)%variable_id, return_value )
[4070]	3086
[4147]	3087	ENDIF
[4070]	3088
[4147]	3089	IF ( return_value == 0 .AND. ALLOCATED( file%dimensions(d)%attributes ) ) THEN
	3090	!
	3091	!-- Write dimension attributes
	3092	DO a = 1, SIZE( file%dimensions(d)%attributes )
[4577]	3093	return_value = write_attribute( file%format, file%id, file%name, &
	3094	variable_id=file%dimensions(d)%variable_id, &
	3095	variable_name=file%dimensions(d)%name, &
	3096	attribute=file%dimensions(d)%attributes(a) )
[4147]	3097	IF ( return_value /= 0 ) EXIT
	3098	ENDDO
	3099	ENDIF
[4070]	3100
[4147]	3101	IF ( return_value /= 0 ) EXIT
[4070]	3102
[4147]	3103	ENDDO
	3104	!
	3105	!-- Save dimension IDs for variables wihtin database
[4577]	3106	IF ( return_value == 0 ) &
[4147]	3107	CALL collect_dimesion_ids_for_variables( file%name, file%variables, file%dimensions, &
	3108	return_value )
	3109	!
	3110	!-- Initialize file variables
	3111	IF ( return_value == 0 ) THEN
	3112	DO d = 1, SIZE( file%variables )
[4070]	3113
[4577]	3114	CALL init_file_variable( file%format, file%id, file%name, &
	3115	file%variables(d)%id, file%variables(d)%name, file%variables(d)%data_type, &
	3116	file%variables(d)%dimension_ids, &
[4147]	3117	file%variables(d)%is_global, return_value )
[4070]	3118
[4147]	3119	IF ( return_value == 0 .AND. ALLOCATED( file%variables(d)%attributes ) ) THEN
	3120	!
	3121	!-- Write variable attributes
	3122	DO a = 1, SIZE( file%variables(d)%attributes )
[4577]	3123	return_value = write_attribute( file%format, file%id, file%name, &
	3124	variable_id=file%variables(d)%id, &
	3125	variable_name=file%variables(d)%name, &
	3126	attribute=file%variables(d)%attributes(a) )
[4147]	3127	IF ( return_value /= 0 ) EXIT
	3128	ENDDO
	3129	ENDIF
[4070]	3130
[4147]	3131	IF ( return_value /= 0 ) EXIT
[4070]	3132
[4147]	3133	ENDDO
	3134	ENDIF
[4070]	3135
[4147]	3136	ENDIF
[4070]	3137
[4147]	3138	END SUBROUTINE init_file_header
[4070]	3139
	3140	!--------------------------------------------------------------------------------------------------!
	3141	! Description:
	3142	! ------------
[4141]	3143	!> Initialize dimension in file.
	3144	!--------------------------------------------------------------------------------------------------!
[4577]	3145	SUBROUTINE init_file_dimension( file_format, file_id, file_name, &
	3146	dimension_id, dimension_name, dimension_type, dimension_length, &
	3147	variable_id, return_value )
[4141]	3148
[4577]	3149	CHARACTER(LEN=*), PARAMETER :: routine_name = 'init_file_dimension' !< file format chosen for file
	3150
[4147]	3151	CHARACTER(LEN=*), INTENT(IN) :: dimension_name !< name of dimension
	3152	CHARACTER(LEN=*), INTENT(IN) :: dimension_type !< data type of dimension
	3153	CHARACTER(LEN=*), INTENT(IN) :: file_format !< file format chosen for file
	3154	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
[4141]	3155
[4147]	3156	INTEGER, INTENT(OUT) :: dimension_id !< dimension ID
	3157	INTEGER, INTENT(IN) :: dimension_length !< length of dimension
	3158	INTEGER, INTENT(IN) :: file_id !< file ID
	3159	INTEGER :: output_return_value !< return value of a called output routine
	3160	INTEGER, INTENT(OUT) :: return_value !< return value
	3161	INTEGER, INTENT(OUT) :: variable_id !< associated variable ID
[4141]	3162
	3163
[4147]	3164	return_value = 0
	3165	output_return_value = 0
[4141]	3166
[4577]	3167	temp_string = '(file "' // TRIM( file_name ) // &
[4147]	3168	'", dimension "' // TRIM( dimension_name ) // '")'
[4141]	3169
[4147]	3170	SELECT CASE ( TRIM( file_format ) )
[4141]	3171
[4147]	3172	CASE ( 'binary' )
[4577]	3173	CALL binary_init_dimension( 'binary', file_id, dimension_id, variable_id, &
	3174	dimension_name, dimension_type, dimension_length, &
	3175	return_value=output_return_value )
[4141]	3176
[4147]	3177	CASE ( 'netcdf4-serial' )
[4577]	3178	CALL netcdf4_init_dimension( 'serial', file_id, dimension_id, variable_id, &
	3179	dimension_name, dimension_type, dimension_length, &
	3180	return_value=output_return_value )
[4141]	3181
[4147]	3182	CASE ( 'netcdf4-parallel' )
[4577]	3183	CALL netcdf4_init_dimension( 'parallel', file_id, dimension_id, variable_id, &
	3184	dimension_name, dimension_type, dimension_length, &
	3185	return_value=output_return_value )
[4141]	3186
[4147]	3187	CASE DEFAULT
	3188	return_value = 1
[4577]	3189	CALL internal_message( 'error', routine_name // &
	3190	': file format "' // TRIM( file_format ) // &
[4147]	3191	'" not supported ' // TRIM( temp_string ) )
[4141]	3192
[4147]	3193	END SELECT
[4141]	3194
[4147]	3195	IF ( output_return_value /= 0 ) THEN
	3196	return_value = output_return_value
[4577]	3197	CALL internal_message( 'error', routine_name // &
[4147]	3198	': error while defining dimension ' // TRIM( temp_string ) )
	3199	ENDIF
[4141]	3200
[4147]	3201	END SUBROUTINE init_file_dimension
[4141]	3202
	3203	!--------------------------------------------------------------------------------------------------!
	3204	! Description:
	3205	! ------------
	3206	!> Initialize variable.
	3207	!--------------------------------------------------------------------------------------------------!
[4577]	3208	SUBROUTINE init_file_variable( file_format, file_id, file_name, &
	3209	variable_id, variable_name, variable_type, dimension_ids, &
[4147]	3210	is_global, return_value )
[4141]	3211
[4577]	3212	CHARACTER(LEN=*), PARAMETER :: routine_name = 'init_file_variable' !< file format chosen for file
	3213
[4147]	3214	CHARACTER(LEN=*), INTENT(IN) :: file_format !< file format chosen for file
	3215	CHARACTER(LEN=*), INTENT(IN) :: file_name !< file name
	3216	CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable
	3217	CHARACTER(LEN=*), INTENT(IN) :: variable_type !< data type of variable
[4141]	3218
[4147]	3219	INTEGER, INTENT(IN) :: file_id !< file ID
	3220	INTEGER :: output_return_value !< return value of a called output routine
	3221	INTEGER, INTENT(OUT) :: return_value !< return value
	3222	INTEGER, INTENT(OUT) :: variable_id !< variable ID
[4141]	3223
[4147]	3224	INTEGER, DIMENSION(:), INTENT(IN) :: dimension_ids !< list of dimension IDs used by variable
[4141]	3225
[4147]	3226	LOGICAL, INTENT(IN) :: is_global !< true if variable is global
[4141]	3227
	3228
[4147]	3229	return_value = 0
	3230	output_return_value = 0
[4141]	3231
[4147]	3232	temp_string = '(file "' // TRIM( file_name ) // &
	3233	'", variable "' // TRIM( variable_name ) // '")'
[4141]	3234
[4147]	3235	SELECT CASE ( TRIM( file_format ) )
[4141]	3236
[4147]	3237	CASE ( 'binary' )
[4577]	3238	CALL binary_init_variable( 'binary', file_id, variable_id, variable_name, &
[4147]	3239	variable_type, dimension_ids, is_global, return_value=output_return_value )
[4141]	3240
[4147]	3241	CASE ( 'netcdf4-serial' )
[4577]	3242	CALL netcdf4_init_variable( 'serial', file_id, variable_id, variable_name, &
[4147]	3243	variable_type, dimension_ids, is_global, return_value=output_return_value )
[4141]	3244
[4147]	3245	CASE ( 'netcdf4-parallel' )
[4577]	3246	CALL netcdf4_init_variable( 'parallel', file_id, variable_id, variable_name, &
[4147]	3247	variable_type, dimension_ids, is_global, return_value=output_return_value )
[4141]	3248
[4147]	3249	CASE DEFAULT
	3250	return_value = 1
[4577]	3251	CALL internal_message( 'error', routine_name // &
	3252	': file format "' // TRIM( file_format ) // &
[4147]	3253	'" not supported ' // TRIM( temp_string ) )
[4141]	3254
[4147]	3255	END SELECT
[4141]	3256
[4147]	3257	IF ( output_return_value /= 0 ) THEN
	3258	return_value = output_return_value
	3259	CALL internal_message( 'error', routine_name // &
	3260	': error while defining variable ' // TRIM( temp_string ) )
	3261	ENDIF
[4141]	3262
[4147]	3263	END SUBROUTINE init_file_variable
[4141]	3264
	3265	!--------------------------------------------------------------------------------------------------!
	3266	! Description:
	3267	! ------------
[4070]	3268	!> Write attribute to file.
	3269	!--------------------------------------------------------------------------------------------------!
[4577]	3270	FUNCTION write_attribute( file_format, file_id, file_name, variable_id, variable_name, attribute )&
	3271	RESULT( return_value )
[4070]	3272
[4577]	3273	CHARACTER(LEN=*), PARAMETER :: routine_name = 'write_attribute' !< file format chosen for file
	3274
[4147]	3275	CHARACTER(LEN=*), INTENT(IN) :: file_format !< file format chosen for file
	3276	CHARACTER(LEN=*), INTENT(IN) :: file_name !< file name
	3277	CHARACTER(LEN=*), INTENT(IN) :: variable_name !< variable name
[4070]	3278
[4147]	3279	INTEGER, INTENT(IN) :: file_id !< file ID
[4577]	3280	INTEGER :: output_return_value !< return value of a called output routine
[4147]	3281	INTEGER :: return_value !< return value
	3282	INTEGER, INTENT(IN) :: variable_id !< variable ID
[4070]	3283
[4147]	3284	TYPE(attribute_type), INTENT(IN) :: attribute !< attribute to be written
[4070]	3285
	3286
[4147]	3287	return_value = 0
	3288	output_return_value = 0
	3289	!
	3290	!-- Prepare for possible error message
[4577]	3291	temp_string = '(file "' // TRIM( file_name ) // &
	3292	'", variable "' // TRIM( variable_name ) // &
[4147]	3293	'", attribute "' // TRIM( attribute%name ) // '")'
	3294	!
	3295	!-- Write attribute to file
	3296	SELECT CASE ( TRIM( file_format ) )
[4106]	3297
[4147]	3298	CASE ( 'binary' )
[4106]	3299
[4147]	3300	SELECT CASE ( TRIM( attribute%data_type ) )
[4070]	3301
[4147]	3302	CASE( 'char' )
[4577]	3303	CALL binary_write_attribute( file_id=file_id, variable_id=variable_id, &
	3304	attribute_name=attribute%name, value_char=attribute%value_char, &
[4147]	3305	return_value=output_return_value )
[4070]	3306
[4147]	3307	CASE( 'int8' )
[4577]	3308	CALL binary_write_attribute( file_id=file_id, variable_id=variable_id, &
	3309	attribute_name=attribute%name, value_int8=attribute%value_int8, &
[4147]	3310	return_value=output_return_value )
[4070]	3311
[4147]	3312	CASE( 'int16' )
[4577]	3313	CALL binary_write_attribute( file_id=file_id, variable_id=variable_id, &
	3314	attribute_name=attribute%name, value_int16=attribute%value_int16, &
[4147]	3315	return_value=output_return_value )
[4070]	3316
[4147]	3317	CASE( 'int32' )
[4577]	3318	CALL binary_write_attribute( file_id=file_id, variable_id=variable_id, &
	3319	attribute_name=attribute%name, value_int32=attribute%value_int32, &
[4147]	3320	return_value=output_return_value )
[4070]	3321
[4147]	3322	CASE( 'real32' )
[4577]	3323	CALL binary_write_attribute( file_id=file_id, variable_id=variable_id, &
	3324	attribute_name=attribute%name, value_real32=attribute%value_real32, &
[4147]	3325	return_value=output_return_value )
[4070]	3326
[4147]	3327	CASE( 'real64' )
[4577]	3328	CALL binary_write_attribute( file_id=file_id, variable_id=variable_id, &
	3329	attribute_name=attribute%name, value_real64=attribute%value_real64, &
[4147]	3330	return_value=output_return_value )
[4070]	3331
[4147]	3332	CASE DEFAULT
	3333	return_value = 1
[4577]	3334	CALL internal_message( 'error', routine_name // &
	3335	': file format "' // TRIM( file_format ) // &
	3336	'" does not support attribute data type "'// &
	3337	TRIM( attribute%data_type ) // &
[4147]	3338	'" ' // TRIM( temp_string ) )
[4070]	3339
[4147]	3340	END SELECT
[4070]	3341
[4147]	3342	CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
[4070]	3343
[4147]	3344	SELECT CASE ( TRIM( attribute%data_type ) )
[4070]	3345
[4147]	3346	CASE( 'char' )
[4577]	3347	CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
	3348	attribute_name=attribute%name, value_char=attribute%value_char, &
[4147]	3349	return_value=output_return_value )
[4070]	3350
[4147]	3351	CASE( 'int8' )
[4577]	3352	CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
	3353	attribute_name=attribute%name, value_int8=attribute%value_int8, &
[4147]	3354	return_value=output_return_value )
[4070]	3355
[4147]	3356	CASE( 'int16' )
[4577]	3357	CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
	3358	attribute_name=attribute%name, value_int16=attribute%value_int16, &
[4147]	3359	return_value=output_return_value )
[4070]	3360
[4147]	3361	CASE( 'int32' )
[4577]	3362	CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
	3363	attribute_name=attribute%name, value_int32=attribute%value_int32, &
[4147]	3364	return_value=output_return_value )
[4070]	3365
[4147]	3366	CASE( 'real32' )
[4577]	3367	CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
	3368	attribute_name=attribute%name, value_real32=attribute%value_real32, &
[4147]	3369	return_value=output_return_value )
[4070]	3370
[4147]	3371	CASE( 'real64' )
[4577]	3372	CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
	3373	attribute_name=attribute%name, value_real64=attribute%value_real64, &
[4147]	3374	return_value=output_return_value )
[4070]	3375
[4147]	3376	CASE DEFAULT
	3377	return_value = 1
[4577]	3378	CALL internal_message( 'error', routine_name // &
	3379	': file format "' // TRIM( file_format ) // &
	3380	'" does not support attribute data type "'// &
	3381	TRIM( attribute%data_type ) // &
[4147]	3382	'" ' // TRIM( temp_string ) )
[4070]	3383
[4147]	3384	END SELECT
[4070]	3385
[4147]	3386	CASE DEFAULT
	3387	return_value = 1
[4577]	3388	CALL internal_message( 'error', routine_name // &
	3389	': unsupported file format "' // TRIM( file_format ) // &
[4147]	3390	'" ' // TRIM( temp_string ) )
[4070]	3391
[4147]	3392	END SELECT
[4070]	3393
[4147]	3394	IF ( output_return_value /= 0 ) THEN
	3395	return_value = output_return_value
[4577]	3396	CALL internal_message( 'error', routine_name // &
[4147]	3397	': error while writing attribute ' // TRIM( temp_string ) )
	3398	ENDIF
[4070]	3399
[4147]	3400	END FUNCTION write_attribute
[4113]	3401
[4070]	3402	!--------------------------------------------------------------------------------------------------!
	3403	! Description:
	3404	! ------------
[4141]	3405	!> Get dimension IDs and save them to variables.
[4070]	3406	!--------------------------------------------------------------------------------------------------!
[4147]	3407	SUBROUTINE collect_dimesion_ids_for_variables( file_name, variables, dimensions, return_value )
[4070]	3408
[4577]	3409	CHARACTER(LEN=*), PARAMETER :: routine_name = 'collect_dimesion_ids_for_variables' !< file format chosen for file
	3410
[4147]	3411	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
[4070]	3412
[4147]	3413	INTEGER :: d !< loop index
	3414	INTEGER :: i !< loop index
	3415	INTEGER :: j !< loop index
	3416	INTEGER :: ndims !< number of dimensions
	3417	INTEGER :: nvars !< number of variables
	3418	INTEGER, INTENT(OUT) :: return_value !< return value
[4070]	3419
[4577]	3420	LOGICAL :: found = .FALSE. !< true if dimension required by variable was found in dimension list
[4070]	3421
[4147]	3422	TYPE(dimension_type), DIMENSION(:), INTENT(IN) :: dimensions !< list of dimensions in file
[4070]	3423
[4147]	3424	TYPE(variable_type), DIMENSION(:), INTENT(INOUT) :: variables !< list of variables in file
[4070]	3425
	3426
[4147]	3427	return_value = 0
	3428	ndims = SIZE( dimensions )
	3429	nvars = SIZE( variables )
[4070]	3430
[4147]	3431	DO i = 1, nvars
	3432	DO j = 1, SIZE( variables(i)%dimension_names )
	3433	found = .FALSE.
	3434	DO d = 1, ndims
	3435	IF ( variables(i)%dimension_names(j) == dimensions(d)%name ) THEN
	3436	variables(i)%dimension_ids(j) = dimensions(d)%id
	3437	found = .TRUE.
	3438	EXIT
	3439	ENDIF
	3440	ENDDO
	3441	IF ( .NOT. found ) THEN
	3442	return_value = 1
[4577]	3443	CALL internal_message( 'error', routine_name // &
	3444	': required dimension "' // TRIM( variables(i)%dimension_names(j) ) // &
	3445	'" is undefined (variable "' // TRIM( variables(i)%name ) // &
[4147]	3446	'", file "' // TRIM( file_name ) // '")!' )
	3447	EXIT
	3448	ENDIF
	3449	ENDDO
	3450	IF ( .NOT. found ) EXIT
	3451	ENDDO
[4070]	3452
[4147]	3453	END SUBROUTINE collect_dimesion_ids_for_variables
[4070]	3454
	3455	!--------------------------------------------------------------------------------------------------!
	3456	! Description:
	3457	! ------------
[4141]	3458	!> Leave file definition/initialization.
[4070]	3459	!>
	3460	!> @todo Do we need an MPI barrier at the end?
	3461	!--------------------------------------------------------------------------------------------------!
[4147]	3462	SUBROUTINE stop_file_header_definition( file_format, file_id, file_name, return_value )
[4070]	3463
[4577]	3464	CHARACTER(LEN=*), PARAMETER :: routine_name = 'stop_file_header_definition' !< name of routine
	3465
[4147]	3466	CHARACTER(LEN=*), INTENT(IN) :: file_format !< file format
	3467	CHARACTER(LEN=*), INTENT(IN) :: file_name !< file name
[4070]	3468
[4147]	3469	INTEGER, INTENT(IN) :: file_id !< file id
	3470	INTEGER :: output_return_value !< return value of a called output routine
	3471	INTEGER, INTENT(OUT) :: return_value !< return value
[4070]	3472
	3473
[4147]	3474	return_value = 0
	3475	output_return_value = 0
[4106]	3476
[4147]	3477	temp_string = '(file "' // TRIM( file_name ) // '")'
[4106]	3478
[4147]	3479	SELECT CASE ( TRIM( file_format ) )
[4070]	3480
[4147]	3481	CASE ( 'binary' )
	3482	CALL binary_stop_file_header_definition( file_id, output_return_value )
[4070]	3483
[4147]	3484	CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
	3485	CALL netcdf4_stop_file_header_definition( file_id, output_return_value )
[4070]	3486
[4147]	3487	CASE DEFAULT
	3488	return_value = 1
[4577]	3489	CALL internal_message( 'error', routine_name // &
	3490	': file format "' // TRIM( file_format ) // &
[4147]	3491	'" not supported ' // TRIM( temp_string ) )
[4070]	3492
[4147]	3493	END SELECT
[4070]	3494
[4147]	3495	IF ( output_return_value /= 0 ) THEN
	3496	return_value = output_return_value
[4577]	3497	CALL internal_message( 'error', routine_name // &
	3498	': error while leaving file-definition state ' // &
[4147]	3499	TRIM( temp_string ) )
	3500	ENDIF
[4106]	3501
[4147]	3502	! CALL MPI_Barrier( MPI_COMM_WORLD, return_value )
[4070]	3503
[4147]	3504	END SUBROUTINE stop_file_header_definition
[4070]	3505
	3506	!--------------------------------------------------------------------------------------------------!
	3507	! Description:
	3508	! ------------
[4141]	3509	!> Find a requested variable 'variable_name' and its used dimensions in requested file 'file_name'.
[4070]	3510	!--------------------------------------------------------------------------------------------------!
[4577]	3511	SUBROUTINE find_var_in_file( file_name, variable_name, file_format, file_id, variable_id, &
[4147]	3512	is_global, dimensions, return_value )
[4070]	3513
[4577]	3514	CHARACTER(LEN=*), PARAMETER :: routine_name = 'find_var_in_file' !< name of routine
	3515
[4147]	3516	CHARACTER(LEN=charlen), INTENT(OUT) :: file_format !< file format chosen for file
	3517	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	3518	CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable
[4070]	3519
[4147]	3520	INTEGER :: d !< loop index
	3521	INTEGER :: dd !< loop index
	3522	INTEGER :: f !< loop index
	3523	INTEGER, INTENT(OUT) :: file_id !< file ID
	3524	INTEGER, INTENT(OUT) :: return_value !< return value
	3525	INTEGER, INTENT(OUT) :: variable_id !< variable ID
[4070]	3526
[4147]	3527	INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of dimension IDs used by variable
[4070]	3528
[4147]	3529	LOGICAL :: found !< true if requested variable found in requested file
	3530	LOGICAL, INTENT(OUT) :: is_global !< true if variable is global
[4070]	3531
[4147]	3532	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: dimensions !< list of dimensions used by variable
[4070]	3533
	3534
[4147]	3535	return_value = 0
	3536	found = .FALSE.
[4070]	3537
[4147]	3538	DO f = 1, nfiles
	3539	IF ( TRIM( file_name ) == TRIM( files(f)%name ) ) THEN
[4113]	3540
[4147]	3541	IF ( .NOT. files(f)%is_init ) THEN
	3542	return_value = 1
[4577]	3543	CALL internal_message( 'error', routine_name // &
	3544	': file not initialized. ' // &
	3545	'Writing variable to file is impossible ' // &
	3546	'(variable "' // TRIM( variable_name ) // &
[4147]	3547	'", file "' // TRIM( file_name ) // '")!' )
	3548	EXIT
	3549	ENDIF
[4113]	3550
[4147]	3551	file_id = files(f)%id
	3552	file_format = files(f)%format
	3553	!
	3554	!-- Search for variable in file
	3555	DO d = 1, SIZE( files(f)%variables )
	3556	IF ( TRIM( variable_name ) == TRIM( files(f)%variables(d)%name ) ) THEN
[4070]	3557
[4147]	3558	variable_id = files(f)%variables(d)%id
	3559	is_global = files(f)%variables(d)%is_global
[4070]	3560
[4147]	3561	ALLOCATE( dimension_ids(SIZE( files(f)%variables(d)%dimension_ids )) )
	3562	ALLOCATE( dimensions(SIZE( files(f)%variables(d)%dimension_ids )) )
[4070]	3563
[4147]	3564	dimension_ids = files(f)%variables(d)%dimension_ids
[4070]	3565
[4147]	3566	found = .TRUE.
	3567	EXIT
[4070]	3568
[4147]	3569	ENDIF
	3570	ENDDO
[4070]	3571
[4147]	3572	IF ( found ) THEN
	3573	!
	3574	!-- Get list of dimensions used by variable
	3575	DO d = 1, SIZE( files(f)%dimensions )
	3576	DO dd = 1, SIZE( dimension_ids )
	3577	IF ( dimension_ids(dd) == files(f)%dimensions(d)%id ) THEN
	3578	dimensions(dd) = files(f)%dimensions(d)
	3579	EXIT
	3580	ENDIF
	3581	ENDDO
	3582	ENDDO
[4070]	3583
[4147]	3584	ELSE
	3585	!
	3586	!-- If variable was not found, search for a dimension instead
	3587	DO d = 1, SIZE( files(f)%dimensions )
	3588	IF ( TRIM( variable_name ) == TRIM( files(f)%dimensions(d)%name ) ) THEN
[4070]	3589
[4147]	3590	variable_id = files(f)%dimensions(d)%variable_id
	3591	is_global = .TRUE.
[4070]	3592
[4147]	3593	ALLOCATE( dimensions(1) )
[4070]	3594
[4147]	3595	dimensions(1) = files(f)%dimensions(d)
[4070]	3596
[4147]	3597	found = .TRUE.
	3598	EXIT
[4070]	3599
[4147]	3600	ENDIF
	3601	ENDDO
[4070]	3602
[4147]	3603	ENDIF
	3604	!
	3605	!-- If variable was not found in requested file, return an error
	3606	IF ( .NOT. found ) THEN
	3607	return_value = 1
[4577]	3608	CALL internal_message( 'error', routine_name // &
	3609	': variable not found in file ' // &
	3610	'(variable "' // TRIM( variable_name ) // &
[4147]	3611	'", file "' // TRIM( file_name ) // '")!' )
	3612	ENDIF
[4070]	3613
[4147]	3614	EXIT
[4070]	3615
[4147]	3616	ENDIF ! file found
	3617	ENDDO ! loop over files
[4070]	3618
[4147]	3619	IF ( .NOT. found .AND. return_value == 0 ) THEN
	3620	return_value = 1
[4577]	3621	CALL internal_message( 'error', routine_name // &
	3622	': file not found ' // &
	3623	'(variable "' // TRIM( variable_name ) // &
[4147]	3624	'", file "' // TRIM( file_name ) // '")!' )
	3625	ENDIF
[4070]	3626
[4147]	3627	END SUBROUTINE find_var_in_file
[4070]	3628
	3629	!--------------------------------------------------------------------------------------------------!
	3630	! Description:
	3631	! ------------
	3632	!> Search for masked indices of dimensions within the given bounds ('bounds_start' and
[4123]	3633	!> 'bounds_end'). Return the masked indices ('masked_indices') of the dimensions, the first index
	3634	!> of the masked dimensions containing these indices ('bounds_masked_start'), the count of masked
	3635	!> indices within given bounds ('value_counts') and the origin index of each dimension
	3636	!> ('bounds_origin'). If, for any dimension, no masked index lies within the given bounds, counts,
	3637	!> starts and origins are set to zero for all dimensions.
[4070]	3638	!--------------------------------------------------------------------------------------------------!
[4577]	3639	SUBROUTINE get_masked_indices_and_masked_dimension_bounds( &
	3640	dimensions, bounds_start, bounds_end, bounds_masked_start, value_counts, &
[4147]	3641	bounds_origin, masked_indices )
[4070]	3642
[4147]	3643	! CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_masked_indices_and_masked_dimension_bounds' !< name of routine
[4070]	3644
[4147]	3645	INTEGER :: d !< loop index
	3646	INTEGER :: i !< loop index
[4070]	3647
[4147]	3648	INTEGER, DIMENSION(:), INTENT(IN) :: bounds_end !< upper bonuds to be searched in
	3649	INTEGER, DIMENSION(:), INTENT(OUT) :: bounds_masked_start !< lower bounds of masked dimensions within given bounds
	3650	INTEGER, DIMENSION(:), INTENT(OUT) :: bounds_origin !< first index of each dimension, 0 if dimension is masked
	3651	INTEGER, DIMENSION(:), INTENT(IN) :: bounds_start !< lower bounds to be searched in
	3652	INTEGER, DIMENSION(:), INTENT(OUT) :: value_counts !< count of indices per dimension to be output
[4070]	3653
[4147]	3654	INTEGER, DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) :: masked_indices !< masked indices within given bounds
[4070]	3655
[4147]	3656	TYPE(dimension_type), DIMENSION(:), INTENT(IN) :: dimensions !< dimensions to be searched for masked indices
[4070]	3657
	3658
[4147]	3659	ALLOCATE( masked_indices(SIZE( dimensions ),0:MAXVAL( bounds_end - bounds_start + 1 )) )
	3660	masked_indices = -HUGE( 0 )
	3661	!
	3662	!-- Check for masking and update lower and upper bounds if masked
	3663	DO d = 1, SIZE( dimensions )
[4070]	3664
[4147]	3665	IF ( dimensions(d)%is_masked ) THEN
[4070]	3666
[4147]	3667	bounds_origin(d) = 0
[4070]	3668
[4147]	3669	bounds_masked_start(d) = -HUGE( 0 )
	3670	!
	3671	!-- Find number of masked values within given variable bounds
	3672	value_counts(d) = 0
[4577]	3673	DO i = LBOUND( dimensions(d)%masked_indices, DIM=1 ), &
[4147]	3674	UBOUND( dimensions(d)%masked_indices, DIM=1 )
	3675	!
	3676	!-- Is masked index within given bounds?
[4577]	3677	IF ( dimensions(d)%masked_indices(i) >= bounds_start(d) .AND. &
[4147]	3678	dimensions(d)%masked_indices(i) <= bounds_end(d) ) THEN
	3679	!
	3680	!-- Save masked index
	3681	masked_indices(d,value_counts(d)) = dimensions(d)%masked_indices(i)
	3682	value_counts(d) = value_counts(d) + 1
	3683	!
	3684	!-- Save bounds of mask within given bounds
	3685	IF ( bounds_masked_start(d) == -HUGE( 0 ) ) bounds_masked_start(d) = i
[4123]	3686
[4147]	3687	ENDIF
[4070]	3688
[4147]	3689	ENDDO
	3690	!
	3691	!-- Set masked bounds to zero if no masked index lies within bounds
	3692	IF ( value_counts(d) == 0 ) THEN
	3693	bounds_origin(:) = 0
	3694	bounds_masked_start(:) = 0
	3695	value_counts(:) = 0
	3696	EXIT
	3697	ENDIF
[4070]	3698
[4147]	3699	ELSE
	3700	!
	3701	!-- If dimension is not masked, save all indices within bounds for output
	3702	bounds_origin(d) = dimensions(d)%bounds(1)
	3703	bounds_masked_start(d) = bounds_start(d)
	3704	value_counts(d) = bounds_end(d) - bounds_start(d) + 1
[4070]	3705
[4147]	3706	DO i = 0, value_counts(d) - 1
	3707	masked_indices(d,i) = bounds_start(d) + i
	3708	ENDDO
[4070]	3709
[4147]	3710	ENDIF
[4070]	3711
[4147]	3712	ENDDO
[4070]	3713
[4147]	3714	END SUBROUTINE get_masked_indices_and_masked_dimension_bounds
[4070]	3715
	3716	!--------------------------------------------------------------------------------------------------!
	3717	! Description:
	3718	! ------------
[4577]	3719	!> Message routine writing debug information into the debug file or creating the error message
	3720	!> string.
[4070]	3721	!--------------------------------------------------------------------------------------------------!
[4147]	3722	SUBROUTINE internal_message( level, string )
[4070]	3723
[4147]	3724	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
	3725	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
[4070]	3726
	3727
[4147]	3728	IF ( TRIM( level ) == 'error' ) THEN
[4070]	3729
[4147]	3730	WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
[4070]	3731
[4147]	3732	ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN
[4070]	3733
[4147]	3734	WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
	3735	FLUSH( debug_output_unit )
[4070]	3736
[4147]	3737	ENDIF
[4070]	3738
[4147]	3739	END SUBROUTINE internal_message
[4070]	3740
[4141]	3741	!--------------------------------------------------------------------------------------------------!
	3742	! Description:
	3743	! ------------
	3744	!> Print contents of the created database to debug_output_unit. This routine can be called at any
	3745	!> stage after the call to 'dom_init'. Multiple calls are possible.
	3746	!--------------------------------------------------------------------------------------------------!
[4147]	3747	SUBROUTINE dom_database_debug_output
[4070]	3748
[4147]	3749	CHARACTER(LEN=*), PARAMETER :: separation_string = '---' !< string separating blocks in output
	3750	CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_database_debug_output' !< name of this routine
[4070]	3751
[4577]	3752	INTEGER, PARAMETER :: indent_depth = 3 !< space per indentation
	3753	INTEGER, PARAMETER :: max_keyname_length = 6 !< length of longest key name
	3754
	3755	CHARACTER(LEN=50) :: write_format1 !< format for write statements
	3756
[4147]	3757	INTEGER :: f !< loop index
	3758	INTEGER :: indent_level !< indentation level
	3759	INTEGER :: natts !< number of attributes
	3760	INTEGER :: ndims !< number of dimensions
	3761	INTEGER :: nvars !< number of variables
[4070]	3762
	3763
[4147]	3764	CALL internal_message( 'debug', routine_name // ': write database to debug output' )
[4070]	3765
[4147]	3766	WRITE( debug_output_unit, '(A)' ) 'DOM database:'
	3767	WRITE( debug_output_unit, '(A)' ) REPEAT( separation_string // ' ', 4 )
[4106]	3768
[4577]	3769	IF ( .NOT. ALLOCATED( files ) .OR. nfiles == 0 ) THEN
[4070]	3770
[4147]	3771	WRITE( debug_output_unit, '(A)' ) 'database is empty'
[4070]	3772
[4147]	3773	ELSE
[4070]	3774
[4147]	3775	indent_level = 1
[4577]	3776	WRITE( write_format1, '(A,I3,A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A,T', &
	3777	indent_level * indent_depth + 1 + max_keyname_length, &
	3778	',(": ")'
[4070]	3779
[4147]	3780	DO f = 1, nfiles
[4070]	3781
[4147]	3782	natts = 0
	3783	ndims = 0
	3784	nvars = 0
	3785	IF ( ALLOCATED( files(f)%attributes ) ) natts = SIZE( files(f)%attributes )
	3786	IF ( ALLOCATED( files(f)%dimensions ) ) ndims = SIZE( files(f)%dimensions )
	3787	IF ( ALLOCATED( files(f)%variables ) ) nvars = SIZE( files(f)%variables )
[4070]	3788
[4147]	3789	WRITE( debug_output_unit, '(A)' ) 'file:'
	3790	WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) 'name', TRIM( files(f)%name )
	3791	WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) 'format', TRIM(files(f)%format)
	3792	WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) 'id', files(f)%id
	3793	WRITE( debug_output_unit, TRIM( write_format1 ) // ',L1)' ) 'is init', files(f)%is_init
	3794	WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#atts', natts
	3795	WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#dims', ndims
	3796	WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#vars', nvars
[4070]	3797
[4147]	3798	IF ( natts /= 0 ) CALL print_attributes( indent_level, files(f)%attributes )
	3799	IF ( ndims /= 0 ) CALL print_dimensions( indent_level, files(f)%dimensions )
	3800	IF ( nvars /= 0 ) CALL print_variables( indent_level, files(f)%variables )
[4070]	3801
[4147]	3802	WRITE( debug_output_unit, '(/A/)' ) REPEAT( separation_string // ' ', 4 )
[4070]	3803
[4147]	3804	ENDDO
[4141]	3805
[4147]	3806	ENDIF
[4070]	3807
[4147]	3808	CONTAINS
[4070]	3809
[4577]	3810	!--------------------------------------------------------------------------------------------------!
	3811	! Description:
	3812	! ------------
	3813	!> Print list of attributes.
	3814	!--------------------------------------------------------------------------------------------------!
[4147]	3815	SUBROUTINE print_attributes( indent_level, attributes )
[4070]	3816
[4577]	3817	INTEGER, PARAMETER :: max_keyname_length = 6 !< length of longest key name
	3818
[4147]	3819	CHARACTER(LEN=50) :: write_format1 !< format for write statements
	3820	CHARACTER(LEN=50) :: write_format2 !< format for write statements
[4070]	3821
[4147]	3822	INTEGER :: i !< loop index
	3823	INTEGER, INTENT(IN) :: indent_level !< indentation level
	3824	INTEGER :: nelement !< number of elements to print
[4070]	3825
[4147]	3826	TYPE(attribute_type), DIMENSION(:), INTENT(IN) :: attributes !< list of attributes
[4070]	3827
	3828
[4147]	3829	WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
[4577]	3830	WRITE( write_format2, '(A,I3,A,I3,A)' ) &
	3831	'(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
[4147]	3832	( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
[4070]	3833
[4577]	3834	WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) &
[4147]	3835	REPEAT( separation_string // ' ', 4 )
	3836	WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'attributes:'
[4070]	3837
[4147]	3838	nelement = SIZE( attributes )
	3839	DO i = 1, nelement
[4577]	3840	WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
[4147]	3841	'name', TRIM( attributes(i)%name )
[4577]	3842	WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
[4147]	3843	'type', TRIM( attributes(i)%data_type )
[4141]	3844
[4147]	3845	IF ( TRIM( attributes(i)%data_type ) == 'char' ) THEN
[4577]	3846	WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
[4147]	3847	'value', TRIM( attributes(i)%value_char )
	3848	ELSEIF ( TRIM( attributes(i)%data_type ) == 'int8' ) THEN
[4577]	3849	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)' ) &
[4147]	3850	'value', attributes(i)%value_int8
	3851	ELSEIF ( TRIM( attributes(i)%data_type ) == 'int16' ) THEN
[4577]	3852	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)' ) &
[4147]	3853	'value', attributes(i)%value_int16
	3854	ELSEIF ( TRIM( attributes(i)%data_type ) == 'int32' ) THEN
[4577]	3855	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)' ) &
[4147]	3856	'value', attributes(i)%value_int32
	3857	ELSEIF ( TRIM( attributes(i)%data_type ) == 'real32' ) THEN
[4577]	3858	WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)' ) &
[4147]	3859	'value', attributes(i)%value_real32
	3860	ELSEIF ( TRIM(attributes(i)%data_type) == 'real64' ) THEN
[4577]	3861	WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)' ) &
[4147]	3862	'value', attributes(i)%value_real64
	3863	ENDIF
[4577]	3864	IF ( i < nelement ) &
[4147]	3865	WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
	3866	ENDDO
[4141]	3867
[4147]	3868	END SUBROUTINE print_attributes
[4141]	3869
[4577]	3870	!--------------------------------------------------------------------------------------------------!
	3871	! Description:
	3872	! ------------
	3873	!> Print list of dimensions.
	3874	!--------------------------------------------------------------------------------------------------!
[4147]	3875	SUBROUTINE print_dimensions( indent_level, dimensions )
[4141]	3876
[4577]	3877	INTEGER, PARAMETER :: max_keyname_length = 15 !< length of longest key name
	3878
[4147]	3879	CHARACTER(LEN=50) :: write_format1 !< format for write statements
	3880	CHARACTER(LEN=50) :: write_format2 !< format for write statements
[4141]	3881
[4147]	3882	INTEGER :: i !< loop index
	3883	INTEGER, INTENT(IN) :: indent_level !< indentation level
	3884	INTEGER :: j !< loop index
	3885	INTEGER :: nelement !< number of elements to print
[4141]	3886
[4147]	3887	LOGICAL :: is_masked !< true if dimension is masked
[4141]	3888
[4147]	3889	TYPE(dimension_type), DIMENSION(:), INTENT(IN) :: dimensions !< list of dimensions
[4141]	3890
	3891
[4147]	3892	WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
[4577]	3893	WRITE( write_format2, '(A,I3,A,I3,A)' ) &
	3894	'(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
[4147]	3895	( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
[4141]	3896
[4577]	3897	WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) &
[4147]	3898	REPEAT( separation_string // ' ', 4 )
	3899	WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'dimensions:'
[4141]	3900
[4147]	3901	nelement = SIZE( dimensions )
	3902	DO i = 1, nelement
	3903	is_masked = dimensions(i)%is_masked
	3904	!
	3905	!-- Print general information
[4577]	3906	WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
[4147]	3907	'name', TRIM( dimensions(i)%name )
[4577]	3908	WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
[4147]	3909	'type', TRIM( dimensions(i)%data_type )
[4577]	3910	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) &
[4147]	3911	'id', dimensions(i)%id
[4577]	3912	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) &
[4147]	3913	'length', dimensions(i)%length
[4577]	3914	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7,A,I7)' ) &
[4147]	3915	'bounds', dimensions(i)%bounds(1), ',', dimensions(i)%bounds(2)
[4577]	3916	WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' ) &
[4147]	3917	'is masked', dimensions(i)%is_masked
	3918	!
	3919	!-- Print information about mask
	3920	IF ( is_masked ) THEN
[4577]	3921	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) &
[4147]	3922	'masked length', dimensions(i)%length_mask
[4141]	3923
[4577]	3924	WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)', ADVANCE='no' ) &
[4147]	3925	'mask', dimensions(i)%mask(dimensions(i)%bounds(1))
	3926	DO j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
	3927	WRITE( debug_output_unit, '(A,L1)', ADVANCE='no' ) ',', dimensions(i)%mask(j)
	3928	ENDDO
	3929	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
[4141]	3930
[4577]	3931	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' ) &
[4147]	3932	'masked indices', dimensions(i)%masked_indices(0)
	3933	DO j = 1, dimensions(i)%length_mask-1
[4577]	3934	WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
[4147]	3935	',', dimensions(i)%masked_indices(j)
	3936	ENDDO
	3937	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	3938	ENDIF
	3939	!
	3940	!-- Print saved values
	3941	IF ( ALLOCATED( dimensions(i)%values_int8 ) ) THEN
[4141]	3942
[4577]	3943	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)', ADVANCE='no' ) &
[4147]	3944	'values', dimensions(i)%values_int8(dimensions(i)%bounds(1))
	3945	DO j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
[4577]	3946	WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' ) &
[4147]	3947	',', dimensions(i)%values_int8(j)
	3948	ENDDO
	3949	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	3950	IF ( is_masked ) THEN
[4577]	3951	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)', ADVANCE='no' ) &
[4147]	3952	'masked values', dimensions(i)%masked_values_int8(0)
	3953	DO j = 1, dimensions(i)%length_mask-1
[4577]	3954	WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' ) &
[4147]	3955	',', dimensions(i)%masked_values_int8(j)
	3956	ENDDO
	3957	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	3958	ENDIF
[4141]	3959
[4147]	3960	ELSEIF ( ALLOCATED( dimensions(i)%values_int16 ) ) THEN
[4141]	3961
[4577]	3962	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' ) &
[4147]	3963	'values', dimensions(i)%values_int16(dimensions(i)%bounds(1))
	3964	DO j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
[4577]	3965	WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
[4147]	3966	',', dimensions(i)%values_int16(j)
	3967	ENDDO
	3968	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	3969	IF ( is_masked ) THEN
[4577]	3970	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' ) &
[4147]	3971	'masked values', dimensions(i)%masked_values_int16(0)
	3972	DO j = 1, dimensions(i)%length_mask-1
[4577]	3973	WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
[4147]	3974	',', dimensions(i)%masked_values_int16(j)
	3975	ENDDO
	3976	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	3977	ENDIF
[4141]	3978
[4147]	3979	ELSEIF ( ALLOCATED( dimensions(i)%values_int32 ) ) THEN
[4141]	3980
[4577]	3981	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' ) &
[4147]	3982	'values', dimensions(i)%values_int32(dimensions(i)%bounds(1))
	3983	DO j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
[4577]	3984	WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
[4147]	3985	',', dimensions(i)%values_int32(j)
	3986	ENDDO
	3987	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	3988	IF ( is_masked ) THEN
[4577]	3989	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' ) &
[4147]	3990	'masked values', dimensions(i)%masked_values_int32(0)
	3991	DO j = 1, dimensions(i)%length_mask-1
[4577]	3992	WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
[4147]	3993	',', dimensions(i)%masked_values_int32(j)
	3994	ENDDO
	3995	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	3996	ENDIF
[4141]	3997
[4147]	3998	ELSEIF ( ALLOCATED( dimensions(i)%values_intwp ) ) THEN
[4141]	3999
[4577]	4000	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' ) &
[4147]	4001	'values', dimensions(i)%values_intwp(dimensions(i)%bounds(1))
	4002	DO j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
[4577]	4003	WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
[4147]	4004	',', dimensions(i)%values_intwp(j)
	4005	ENDDO
	4006	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	4007	IF ( is_masked ) THEN
[4577]	4008	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' ) &
[4147]	4009	'masked values', dimensions(i)%masked_values_intwp(0)
	4010	DO j = 1, dimensions(i)%length_mask-1
[4577]	4011	WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
[4147]	4012	',', dimensions(i)%masked_values_intwp(j)
	4013	ENDDO
	4014	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	4015	ENDIF
[4141]	4016
[4147]	4017	ELSEIF ( ALLOCATED( dimensions(i)%values_real32 ) ) THEN
[4141]	4018
[4577]	4019	WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)', ADVANCE='no' ) &
[4147]	4020	'values', dimensions(i)%values_real32(dimensions(i)%bounds(1))
	4021	DO j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
[4577]	4022	WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' ) &
[4147]	4023	',', dimensions(i)%values_real32(j)
	4024	ENDDO
	4025	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	4026	IF ( is_masked ) THEN
[4577]	4027	WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)', ADVANCE='no' ) &
[4147]	4028	'masked values', dimensions(i)%masked_values_real32(0)
	4029	DO j = 1, dimensions(i)%length_mask-1
[4577]	4030	WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' ) &
[4147]	4031	',', dimensions(i)%masked_values_real32(j)
	4032	ENDDO
	4033	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	4034	ENDIF
[4141]	4035
[4147]	4036	ELSEIF ( ALLOCATED( dimensions(i)%values_real64 ) ) THEN
[4141]	4037
[4577]	4038	WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' ) &
[4147]	4039	'values', dimensions(i)%values_real64(dimensions(i)%bounds(1))
	4040	DO j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
[4577]	4041	WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
[4147]	4042	',', dimensions(i)%values_real64(j)
	4043	ENDDO
	4044	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	4045	IF ( is_masked ) THEN
[4577]	4046	WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' ) &
[4147]	4047	'masked values', dimensions(i)%masked_values_real64(0)
	4048	DO j = 1, dimensions(i)%length_mask-1
[4577]	4049	WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
[4147]	4050	',', dimensions(i)%masked_values_real64(j)
	4051	ENDDO
	4052	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	4053	ENDIF
[4141]	4054
[4147]	4055	ELSEIF ( ALLOCATED( dimensions(i)%values_realwp ) ) THEN
[4141]	4056
[4577]	4057	WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' ) &
[4147]	4058	'values', dimensions(i)%values_realwp(dimensions(i)%bounds(1))
	4059	DO j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
[4577]	4060	WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
[4147]	4061	',', dimensions(i)%values_realwp(j)
	4062	ENDDO
	4063	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	4064	IF ( is_masked ) THEN
[4577]	4065	WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' ) &
[4147]	4066	'masked values', dimensions(i)%masked_values_realwp(0)
	4067	DO j = 1, dimensions(i)%length_mask-1
[4577]	4068	WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
[4147]	4069	',', dimensions(i)%masked_values_realwp(j)
	4070	ENDDO
	4071	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
	4072	ENDIF
[4141]	4073
[4147]	4074	ENDIF
[4141]	4075
[4577]	4076	IF ( ALLOCATED( dimensions(i)%attributes ) ) &
[4147]	4077	CALL print_attributes( indent_level+1, dimensions(i)%attributes )
[4141]	4078
[4577]	4079	IF ( i < nelement ) &
[4147]	4080	WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
	4081	ENDDO
[4141]	4082
[4147]	4083	END SUBROUTINE print_dimensions
[4141]	4084
[4577]	4085	!--------------------------------------------------------------------------------------------------!
	4086	! Description:
	4087	! ------------
	4088	!> Print list of variables.
	4089	!--------------------------------------------------------------------------------------------------!
[4147]	4090	SUBROUTINE print_variables( indent_level, variables )
[4141]	4091
[4577]	4092	INTEGER, PARAMETER :: max_keyname_length = 16 !< length of longest key name
	4093
[4147]	4094	CHARACTER(LEN=50) :: write_format1 !< format for write statements
	4095	CHARACTER(LEN=50) :: write_format2 !< format for write statements
[4141]	4096
[4147]	4097	INTEGER :: i !< loop index
	4098	INTEGER, INTENT(IN) :: indent_level !< indentation level
	4099	INTEGER :: j !< loop index
	4100	INTEGER :: nelement !< number of elements to print
[4141]	4101
[4147]	4102	TYPE(variable_type), DIMENSION(:), INTENT(IN) :: variables !< list of variables
[4141]	4103
	4104
[4147]	4105	WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
[4577]	4106	WRITE( write_format2, '(A,I3,A,I3,A)' ) &
	4107	'(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
[4147]	4108	( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
[4141]	4109
[4577]	4110	WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) &
[4147]	4111	REPEAT( separation_string // ' ', 4 )
	4112	WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'variables:'
[4141]	4113
[4147]	4114	nelement = SIZE( variables )
	4115	DO i = 1, nelement
[4577]	4116	WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
[4147]	4117	'name', TRIM( variables(i)%name )
[4577]	4118	WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
[4147]	4119	'type', TRIM( variables(i)%data_type )
[4577]	4120	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) &
[4147]	4121	'id', variables(i)%id
[4577]	4122	WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' ) &
[4147]	4123	'is global', variables(i)%is_global
[4141]	4124
[4577]	4125	WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)', ADVANCE='no' ) &
[4147]	4126	'dimension names', TRIM( variables(i)%dimension_names(1) )
	4127	DO j = 2, SIZE( variables(i)%dimension_names )
[4577]	4128	WRITE( debug_output_unit, '(A,A)', ADVANCE='no' ) &
[4147]	4129	',', TRIM( variables(i)%dimension_names(j) )
	4130	ENDDO
	4131	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
[4141]	4132
[4577]	4133	WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)', ADVANCE='no' ) &
[4147]	4134	'dimension ids', variables(i)%dimension_ids(1)
	4135	DO j = 2, SIZE( variables(i)%dimension_names )
[4577]	4136	WRITE( debug_output_unit, '(A,I7)', ADVANCE='no' ) &
[4147]	4137	',', variables(i)%dimension_ids(j)
	4138	ENDDO
	4139	WRITE( debug_output_unit, '(A)' ) '' ! write line-end
[4141]	4140
[4577]	4141	IF ( ALLOCATED( variables(i)%attributes ) ) &
[4147]	4142	CALL print_attributes( indent_level+1, variables(i)%attributes )
[4577]	4143	IF ( i < nelement ) &
[4147]	4144	WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
	4145	ENDDO
[4141]	4146
[4147]	4147	END SUBROUTINE print_variables
[4141]	4148
[4147]	4149	END SUBROUTINE dom_database_debug_output
[4141]	4150
[4577]	4151	END MODULE data_output_module

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |