Home

Context Navigation

data_output_module.f90 @ 4629

Last change on this file since 4629 was 4597, checked in by gronemeier, 5 years ago

Summary:

bugfix: - write unlimited dimension in netcdf4-parallel mode

prevent unused-variable warning if preprocessor directives are not given

new : - added optional argument to dom_def_dim to allow that dimension variables can be written

by every PE

change: - set parallel access mode to independent per default (netCDF4 output files)

Details:

data_output_module.f90:

bugfix: - write unlimited dimension in netcdf4-parallel mode
new : - added optional argument to dom_def_dim to allow that dimension variables can be written

by every PE

data_output_netcdf4_module.f90:

bugfix: - allow writing of unlimited dimensions in parallel mode

prevent unused-variable warning if preprocessor directives are not given

change: - set parallel access mode to independent per default
new : - dimension variables can be written by every PE

data_output_binary_module.f90:

change: update argument list of routine binary_init_dimension due to changes in interface

Property svn:keywords set to Id

File size: 216.6 KB

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

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

Context Navigation

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

Download in other formats: