Home

Context Navigation

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

Last change on this file since 4495 was 4481, checked in by maronga, 5 years ago
Bugfix for copyright updates in document_changes; copyright update applied to all files
Property svn:keywords set to `Id`
File size: 198.1 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |