Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |