Home

Context Navigation

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

Last change on this file since 4108 was 4107, checked in by gronemeier, 5 years ago

changes in data-output module (data_output_module.f90, data_output_binary_module.f90, data_output_netcdf4_module.f90, binary_to_netcdf.f90):

add support for different output groups of MPI ranks (required for, e.g., nesting runs)
revise output messages

Property svn:keywords set to Id

File size: 158.6 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |