Home

Context Navigation

source: palm/trunk/SOURCE/data_output_netcdf4_module.f90 @ 4588

Last change on this file since 4588 was 4579, checked in by gronemeier, 4 years ago
corrected formatting to follow PALM coding standard (data_output_module, data_output_binary_module, data_output_netcdf4_module)
Property svn:keywords set to `Id`
File size: 44.1 KB

Rev	Line
[4106]	1	!> @file data_output_netcdf4_module.f90
[4070]	2	!--------------------------------------------------------------------------------------------------!
	3	! This file is part of the PALM model system.
	4	!
[4577]	5	! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
	6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
	7	! (at your option) any later version.
[4070]	8	!
[4577]	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
	10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
	11	! Public License for more details.
[4070]	12	!
[4577]	13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
	14	! <http://www.gnu.org/licenses/>.
[4070]	15	!
[4481]	16	! Copyright 2019-2020 Leibniz Universitaet Hannover
[4070]	17	!--------------------------------------------------------------------------------------------------!
	18	!
	19	! Current revisions:
	20	! ------------------
[4579]	21	!
	22	!
[4070]	23	! Former revisions:
	24	! -----------------
	25	! $Id: data_output_netcdf4_module.f90 4579 2020-06-25 20:05:07Z suehring $
[4579]	26	! corrected formatting to follow PALM coding standard
	27	!
	28	! 4577 2020-06-25 09:53:58Z raasch
[4577]	29	! file re-formatted to follow the PALM coding standard
	30	!
	31	! 4481 2020-03-31 18:55:54Z maronga
[4429]	32	! bugfix: cpp-directive moved to avoid compile error due to unused dummy argument
[4577]	33	!
[4429]	34	! 4408 2020-02-14 10:04:39Z gronemeier
[4408]	35	! Enable character-array output
	36	!
	37	! 4232 2019-09-20 09:34:22Z knoop
[4232]	38	! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement
	39	!
	40	! 4147 2019-08-07 09:42:31Z gronemeier
[4147]	41	! corrected indentation according to coding standard
	42	!
	43	! 4141 2019-08-05 12:24:51Z gronemeier
[4070]	44	! Initial revision
	45	!
	46	!
	47	! Authors:
	48	! --------
	49	!> @author: Tobias Gronemeier
	50	!
	51	! Description:
	52	! ------------
[4106]	53	!> NetCDF output module to write data to NetCDF files.
	54	!> This is either done in parallel mode via parallel NetCDF4 I/O or in serial mode only by PE0.
[4070]	55	!--------------------------------------------------------------------------------------------------!
[4147]	56	MODULE data_output_netcdf4_module
[4070]	57
[4147]	58	USE kinds
[4070]	59
[4232]	60	#if defined( __parallel ) && !defined( __mpifh )
[4147]	61	USE MPI
[4070]	62	#endif
	63
[4106]	64	#if defined( __netcdf4 )
[4147]	65	USE NETCDF
[4070]	66	#endif
	67
[4147]	68	IMPLICIT NONE
[4070]	69
[4232]	70	#if defined( __parallel ) && defined( __mpifh )
	71	INCLUDE "mpif.h"
	72	#endif
	73
[4577]	74	CHARACTER(LEN=*), PARAMETER :: mode_parallel = 'parallel' !< string selecting netcdf4 parallel mode
	75	CHARACTER(LEN=*), PARAMETER :: mode_serial = 'serial' !< string selecting netcdf4 serial mode
	76
	77	CHARACTER(LEN=100) :: file_suffix = '' !< file suffix added to each file name
[4147]	78	CHARACTER(LEN=800) :: internal_error_message = '' !< string containing the last error message
	79	CHARACTER(LEN=800) :: temp_string !< dummy string
[4070]	80
[4147]	81	INTEGER :: debug_output_unit !< Fortran Unit Number of the debug-output file
	82	INTEGER :: global_id_in_file = -1 !< value of global ID within a file
	83	INTEGER :: master_rank !< master rank for tasks to be executed by single PE only
	84	INTEGER :: output_group_comm !< MPI communicator addressing all MPI ranks which participate in output
[4070]	85
[4147]	86	LOGICAL :: print_debug_output = .FALSE. !< if true, debug output is printed
[4070]	87
[4147]	88	SAVE
[4070]	89
[4147]	90	PRIVATE
[4070]	91
[4147]	92	INTERFACE netcdf4_init_module
	93	MODULE PROCEDURE netcdf4_init_module
	94	END INTERFACE netcdf4_init_module
[4070]	95
[4147]	96	INTERFACE netcdf4_open_file
	97	MODULE PROCEDURE netcdf4_open_file
	98	END INTERFACE netcdf4_open_file
[4070]	99
[4147]	100	INTERFACE netcdf4_init_dimension
	101	MODULE PROCEDURE netcdf4_init_dimension
	102	END INTERFACE netcdf4_init_dimension
[4070]	103
[4147]	104	INTERFACE netcdf4_init_variable
	105	MODULE PROCEDURE netcdf4_init_variable
	106	END INTERFACE netcdf4_init_variable
[4070]	107
[4147]	108	INTERFACE netcdf4_write_attribute
	109	MODULE PROCEDURE netcdf4_write_attribute
	110	END INTERFACE netcdf4_write_attribute
[4070]	111
[4147]	112	INTERFACE netcdf4_stop_file_header_definition
	113	MODULE PROCEDURE netcdf4_stop_file_header_definition
	114	END INTERFACE netcdf4_stop_file_header_definition
[4070]	115
[4147]	116	INTERFACE netcdf4_write_variable
	117	MODULE PROCEDURE netcdf4_write_variable
	118	END INTERFACE netcdf4_write_variable
[4070]	119
[4147]	120	INTERFACE netcdf4_finalize
	121	MODULE PROCEDURE netcdf4_finalize
	122	END INTERFACE netcdf4_finalize
[4070]	123
[4147]	124	INTERFACE netcdf4_get_error_message
	125	MODULE PROCEDURE netcdf4_get_error_message
	126	END INTERFACE netcdf4_get_error_message
[4070]	127
[4577]	128	PUBLIC &
	129	netcdf4_finalize, &
	130	netcdf4_get_error_message, &
	131	netcdf4_init_dimension, &
	132	netcdf4_init_module, &
	133	netcdf4_init_variable, &
	134	netcdf4_open_file, &
	135	netcdf4_stop_file_header_definition, &
	136	netcdf4_write_attribute, &
[4147]	137	netcdf4_write_variable
[4070]	138
	139
[4147]	140	CONTAINS
[4070]	141
	142
	143	!--------------------------------------------------------------------------------------------------!
	144	! Description:
	145	! ------------
	146	!> Initialize data-output module.
	147	!--------------------------------------------------------------------------------------------------!
[4577]	148	SUBROUTINE netcdf4_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, &
	149	master_output_rank, &
[4147]	150	program_debug_output_unit, debug_output, dom_global_id )
[4070]	151
[4147]	152	CHARACTER(LEN=*), INTENT(IN) :: file_suffix_of_output_group !> file-name suffix added to each file;
	153	!> must be unique for each output group
[4107]	154
[4147]	155	INTEGER, INTENT(IN) :: dom_global_id !< global id within a file defined by DOM
	156	INTEGER, INTENT(IN) :: master_output_rank !< MPI rank executing tasks which must be executed by a single PE
	157	INTEGER, INTENT(IN) :: mpi_comm_of_output_group !< MPI communicator specifying the rank group participating in output
	158	INTEGER, INTENT(IN) :: program_debug_output_unit !< file unit number for debug output
[4070]	159
[4147]	160	LOGICAL, INTENT(IN) :: debug_output !< if true, debug output is printed
[4070]	161
	162
[4147]	163	file_suffix = file_suffix_of_output_group
	164	output_group_comm = mpi_comm_of_output_group
	165	master_rank = master_output_rank
[4107]	166
[4147]	167	debug_output_unit = program_debug_output_unit
	168	print_debug_output = debug_output
[4070]	169
[4147]	170	global_id_in_file = dom_global_id
[4070]	171
[4147]	172	END SUBROUTINE netcdf4_init_module
[4070]	173
	174	!--------------------------------------------------------------------------------------------------!
	175	! Description:
	176	! ------------
	177	!> Open netcdf file.
	178	!--------------------------------------------------------------------------------------------------!
[4147]	179	SUBROUTINE netcdf4_open_file( mode, file_name, file_id, return_value )
[4070]	180
[4577]	181	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_open_file' !< name of this routine
	182
[4147]	183	CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file
	184	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
[4070]	185
[4147]	186	INTEGER, INTENT(OUT) :: file_id !< file ID
	187	INTEGER :: my_rank !< MPI rank of processor
	188	INTEGER :: nc_stat !< netcdf return value
	189	INTEGER, INTENT(OUT) :: return_value !< return value
[4070]	190
	191
[4147]	192	return_value = 0
	193	file_id = -1
	194	!
	195	!-- Open new file
	196	CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( file_name ) // '"' )
[4070]	197
[4147]	198	IF ( TRIM( mode ) == mode_serial ) THEN
[4070]	199
[4106]	200	#if defined( __netcdf4 )
[4107]	201	#if defined( __parallel )
[4147]	202	CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
	203	IF ( return_value /= 0 ) THEN
	204	CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
	205	ENDIF
	206	IF ( my_rank /= master_rank ) THEN
	207	return_value = 1
[4577]	208	CALL internal_message( 'error', routine_name // &
	209	': trying to define a NetCDF file in serial mode by an MPI ' // &
	210	'rank other than the master output rank. Serial NetCDF ' // &
[4147]	211	'files can only be defined by the master output rank!' )
	212	ENDIF
[4106]	213	#else
[4147]	214	my_rank = master_rank
	215	return_value = 0
[4107]	216	#endif
	217
[4579]	218	IF ( return_value == 0 ) &
[4577]	219	nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), &
	220	IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), file_id )
[4107]	221	#else
[4147]	222	nc_stat = 0
	223	return_value = 1
[4577]	224	CALL internal_message( 'error', routine_name // &
	225	': pre-processor directive "__netcdf4" not given. ' // &
[4147]	226	'Using NetCDF4 output not possible' )
[4106]	227	#endif
	228
[4147]	229	ELSEIF ( TRIM( mode ) == mode_parallel ) THEN
[4106]	230
	231	#if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel )
[4577]	232	nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), &
	233	IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &
[4147]	234	file_id, COMM = output_group_comm, INFO = MPI_INFO_NULL )
[4106]	235	#else
[4147]	236	nc_stat = 0
	237	return_value = 1
[4577]	238	CALL internal_message( 'error', routine_name // &
	239	': pre-processor directives "__parallel" and/or ' // &
	240	'"__netcdf4" and/or "__netcdf4_parallel" not given. ' // &
[4147]	241	'Using parallel NetCDF4 output not possible' )
[4106]	242	#endif
	243
[4147]	244	ELSE
	245	nc_stat = 0
	246	return_value = 1
[4577]	247	CALL internal_message( 'error', routine_name // ': selected mode "' // &
	248	TRIM( mode ) // '" must be either "' // &
[4147]	249	mode_serial // '" or "' // mode_parallel // '"' )
	250	ENDIF
[4106]	251
	252	#if defined( __netcdf4 )
[4147]	253	IF ( nc_stat /= NF90_NOERR .AND. return_value == 0 ) THEN
	254	return_value = 1
[4577]	255	CALL internal_message( 'error', routine_name // &
	256	': NetCDF error while opening file "' // &
[4147]	257	TRIM( file_name ) // '": ' // NF90_STRERROR( nc_stat ) )
	258	ENDIF
[4070]	259	#endif
	260
[4147]	261	END SUBROUTINE netcdf4_open_file
[4070]	262
	263	!--------------------------------------------------------------------------------------------------!
	264	! Description:
	265	! ------------
	266	!> Write attribute to netcdf file.
	267	!--------------------------------------------------------------------------------------------------!
[4577]	268	SUBROUTINE netcdf4_write_attribute( file_id, variable_id, attribute_name, &
	269	value_char, value_int8, value_int16, value_int32, &
	270	value_real32, value_real64, return_value )
[4070]	271
[4577]	272	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_attribute' !< name of this routine
	273
[4147]	274	CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute
	275	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: value_char !< value of attribute
[4070]	276
[4147]	277	INTEGER, INTENT(IN) :: file_id !< file ID
[4579]	278	INTEGER :: nc_stat !< netcdf return value
[4147]	279	INTEGER, INTENT(OUT) :: return_value !< return value
[4579]	280	INTEGER :: target_id !< ID of target which gets attribute (either global or variable_id)
[4147]	281	INTEGER, INTENT(IN) :: variable_id !< variable ID
[4070]	282
[4147]	283	INTEGER(KIND=1), INTENT(IN), OPTIONAL :: value_int8 !< value of attribute
	284	INTEGER(KIND=2), INTENT(IN), OPTIONAL :: value_int16 !< value of attribute
	285	INTEGER(KIND=4), INTENT(IN), OPTIONAL :: value_int32 !< value of attribute
[4070]	286
[4147]	287	REAL(KIND=4), INTENT(IN), OPTIONAL :: value_real32 !< value of attribute
	288	REAL(KIND=8), INTENT(IN), OPTIONAL :: value_real64 !< value of attribute
[4070]	289
	290
[4106]	291	#if defined( __netcdf4 )
[4147]	292	return_value = 0
[4070]	293
[4147]	294	IF ( variable_id == global_id_in_file ) THEN
	295	target_id = NF90_GLOBAL
	296	ELSE
	297	target_id = variable_id
	298	ENDIF
[4070]	299
[4577]	300	CALL internal_message( 'debug', routine_name // &
[4147]	301	': write attribute "' // TRIM( attribute_name ) // '"' )
[4070]	302
[4147]	303	IF ( PRESENT( value_char ) ) THEN
	304	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) )
	305	ELSEIF ( PRESENT( value_int8 ) ) THEN
	306	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 )
	307	ELSEIF ( PRESENT( value_int16 ) ) THEN
	308	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 )
	309	ELSEIF ( PRESENT( value_int32 ) ) THEN
	310	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 )
	311	ELSEIF ( PRESENT( value_real32 ) ) THEN
	312	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 )
	313	ELSEIF ( PRESENT( value_real64 ) ) THEN
	314	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 )
	315	ELSE
	316	return_value = 1
[4577]	317	CALL internal_message( 'error', routine_name // &
[4147]	318	': no value given for attribute "' // TRIM( attribute_name ) // '"' )
	319	ENDIF
[4070]	320
[4147]	321	IF ( return_value == 0 ) THEN
	322	IF ( nc_stat /= NF90_NOERR ) THEN
	323	return_value = 1
[4577]	324	CALL internal_message( 'error', routine_name // &
	325	': NetCDF error while writing attribute "' // &
[4147]	326	TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) )
	327	ENDIF
	328	ENDIF
[4070]	329	#else
[4147]	330	return_value = 1
[4070]	331	#endif
	332
[4147]	333	END SUBROUTINE netcdf4_write_attribute
[4070]	334
	335	!--------------------------------------------------------------------------------------------------!
	336	! Description:
	337	! ------------
	338	!> Initialize dimension.
	339	!--------------------------------------------------------------------------------------------------!
[4579]	340	SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id, &
	341	dimension_name, dimension_type, dimension_length, return_value )
[4070]	342
[4577]	343	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_dimension' !< name of this routine
	344
[4147]	345	CHARACTER(LEN=*), INTENT(IN) :: dimension_name !< name of dimension
	346	CHARACTER(LEN=*), INTENT(IN) :: dimension_type !< data type of dimension
	347	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
[4070]	348
[4147]	349	INTEGER, INTENT(OUT) :: dimension_id !< dimension ID
	350	INTEGER, INTENT(IN) :: dimension_length !< length of dimension
	351	INTEGER, INTENT(IN) :: file_id !< file ID
	352	INTEGER :: nc_dimension_length !< length of dimension
	353	INTEGER :: nc_stat !< netcdf return value
	354	INTEGER, INTENT(OUT) :: return_value !< return value
	355	INTEGER, INTENT(OUT) :: variable_id !< variable ID
[4070]	356
	357
[4106]	358	#if defined( __netcdf4 )
[4147]	359	return_value = 0
	360	variable_id = -1
[4070]	361
[4577]	362	CALL internal_message( 'debug', routine_name // &
[4147]	363	': init dimension "' // TRIM( dimension_name ) // '"' )
	364	!
	365	!-- Check if dimension is unlimited
	366	IF ( dimension_length < 0 ) THEN
	367	nc_dimension_length = NF90_UNLIMITED
	368	ELSE
	369	nc_dimension_length = dimension_length
	370	ENDIF
	371	!
	372	!-- Define dimension in file
	373	nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id )
[4070]	374
[4147]	375	IF ( nc_stat == NF90_NOERR ) THEN
	376	!
	377	!-- Define variable holding dimension values in file
[4579]	378	CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, &
[4147]	379	(/ dimension_id /), is_global=.TRUE., return_value=return_value )
[4070]	380
[4147]	381	ELSE
	382	return_value = 1
[4577]	383	CALL internal_message( 'error', routine_name // &
	384	': NetCDF error while initializing dimension "' // &
[4147]	385	TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) )
	386	ENDIF
[4070]	387	#else
[4147]	388	return_value = 1
	389	variable_id = -1
	390	dimension_id = -1
[4070]	391	#endif
	392
[4147]	393	END SUBROUTINE netcdf4_init_dimension
[4070]	394
	395	!--------------------------------------------------------------------------------------------------!
	396	! Description:
	397	! ------------
	398	!> Initialize variable.
	399	!--------------------------------------------------------------------------------------------------!
[4577]	400	SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type, &
[4147]	401	dimension_ids, is_global, return_value )
[4070]	402
[4577]	403	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_variable' !< name of this routine
	404
[4147]	405	CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)
	406	CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable
	407	CHARACTER(LEN=*), INTENT(IN) :: variable_type !< data type of variable
[4070]	408
[4147]	409	INTEGER, INTENT(IN) :: file_id !< file ID
	410	INTEGER :: nc_stat !< netcdf return value
	411	INTEGER :: nc_variable_type !< netcdf data type
	412	INTEGER, INTENT(OUT) :: return_value !< return value
	413	INTEGER, INTENT(OUT) :: variable_id !< variable ID
[4070]	414
[4147]	415	INTEGER, DIMENSION(:), INTENT(IN) :: dimension_ids !< list of dimension IDs used by variable
[4070]	416
[4147]	417	LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)
[4070]	418
	419
[4106]	420	#if defined( __netcdf4 )
[4147]	421	return_value = 0
[4070]	422
[4147]	423	WRITE( temp_string, * ) is_global
[4577]	424	CALL internal_message( 'debug', routine_name // &
	425	': init variable "' // TRIM( variable_name ) // &
[4147]	426	'" ( is_global = ' // TRIM( temp_string ) // ')' )
[4070]	427
[4147]	428	nc_variable_type = get_netcdf_data_type( variable_type )
[4070]	429
[4147]	430	IF ( nc_variable_type /= -1 ) THEN
	431	!
	432	!-- Define variable in file
	433	nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type, dimension_ids, variable_id )
[4070]	434
[4147]	435	!
	436	!-- Define how variable can be accessed by PEs in parallel netcdf file
	437	IF ( nc_stat == NF90_NOERR .AND. TRIM( mode ) == mode_parallel ) THEN
[4429]	438	#if defined( __netcdf4_parallel )
[4147]	439	IF ( is_global ) THEN
	440	nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_INDEPENDENT )
	441	ELSE
	442	nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_COLLECTIVE )
	443	ENDIF
[4429]	444	#else
	445	CONTINUE
	446	#endif
[4147]	447	ENDIF
[4070]	448
[4147]	449	IF ( nc_stat /= NF90_NOERR ) THEN
	450	return_value = 1
[4577]	451	CALL internal_message( 'error', routine_name // &
	452	': NetCDF error while initializing variable "' // &
[4147]	453	TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) )
	454	ENDIF
[4070]	455
[4147]	456	ELSE
	457	return_value = 1
	458	ENDIF
[4070]	459
	460	#else
[4147]	461	return_value = 1
	462	variable_id = -1
[4070]	463	#endif
	464
[4147]	465	END SUBROUTINE netcdf4_init_variable
[4070]	466
	467	!--------------------------------------------------------------------------------------------------!
	468	! Description:
	469	! ------------
	470	!> Leave file definition state.
	471	!--------------------------------------------------------------------------------------------------!
[4147]	472	SUBROUTINE netcdf4_stop_file_header_definition( file_id, return_value )
[4070]	473
[4147]	474	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_stop_file_header_definition' !< name of this routine
[4070]	475
[4147]	476	INTEGER, INTENT(IN) :: file_id !< file ID
	477	INTEGER :: nc_stat !< netcdf return value
	478	INTEGER :: old_fill_mode !< previous netcdf fill mode
	479	INTEGER, INTENT(OUT) :: return_value !< return value
[4070]	480
	481
[4106]	482	#if defined( __netcdf4 )
[4147]	483	return_value = 0
[4070]	484
[4147]	485	WRITE( temp_string, * ) file_id
[4579]	486	CALL internal_message( 'debug', routine_name // &
[4147]	487	': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
	488	!
	489	!-- Set general no fill, otherwise the performance drops significantly
	490	nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode )
[4070]	491
[4147]	492	IF ( nc_stat == NF90_NOERR ) THEN
	493	nc_stat = NF90_ENDDEF( file_id )
	494	ENDIF
[4070]	495
[4147]	496	IF ( nc_stat /= NF90_NOERR ) THEN
	497	return_value = 1
[4579]	498	CALL internal_message( 'error', routine_name // &
[4147]	499	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
	500	ENDIF
[4070]	501	#else
[4147]	502	return_value = 1
[4070]	503	#endif
	504
[4147]	505	END SUBROUTINE netcdf4_stop_file_header_definition
[4070]	506
	507	!--------------------------------------------------------------------------------------------------!
	508	! Description:
	509	! ------------
	510	!> Write variable of different kind into netcdf file.
	511	!--------------------------------------------------------------------------------------------------!
[4577]	512	SUBROUTINE netcdf4_write_variable( &
	513	file_id, variable_id, bounds_start, value_counts, bounds_origin, &
	514	is_global, &
	515	values_char_0d, values_char_1d, values_char_2d, values_char_3d, &
	516	values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, &
	517	values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, &
	518	values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, &
	519	values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, &
	520	values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &
	521	values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &
	522	values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, &
[4147]	523	return_value )
[4070]	524
[4147]	525	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_variable' !< name of this routine
[4070]	526
[4408]	527	CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL :: values_char_0d !< output variable
	528	CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_char_1d !< output variable
	529	CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_char_2d !< output variable
	530	CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_char_3d !< output variable
	531
[4147]	532	INTEGER :: d !< loop index
	533	INTEGER, INTENT(IN) :: file_id !< file ID
	534	INTEGER :: my_rank !< MPI rank of processor
	535	INTEGER :: nc_stat !< netcdf return value
	536	INTEGER :: ndims !< number of dimensions of variable in file
	537	INTEGER, INTENT(OUT) :: return_value !< return value
	538	INTEGER, INTENT(IN) :: variable_id !< variable ID
[4070]	539
[4147]	540	INTEGER, DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension
	541	INTEGER, DIMENSION(:), INTENT(IN) :: bounds_start !< starting index of variable
	542	INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< IDs of dimensions of variable in file
	543	INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_lengths !< length of dimensions of variable in file
	544	INTEGER, DIMENSION(:), INTENT(IN) :: value_counts !< count of values along each dimension to be written
[4070]	545
[4147]	546	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: values_int8_0d !< output variable
	547	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL :: values_int16_0d !< output variable
	548	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_int32_0d !< output variable
	549	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL :: values_intwp_0d !< output variable
	550	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int8_1d !< output variable
	551	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int16_1d !< output variable
	552	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int32_1d !< output variable
	553	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_intwp_1d !< output variable
	554	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int8_2d !< output variable
	555	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int16_2d !< output variable
	556	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int32_2d !< output variable
	557	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_intwp_2d !< output variable
	558	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int8_3d !< output variable
	559	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int16_3d !< output variable
	560	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int32_3d !< output variable
	561	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_intwp_3d !< output variable
[4070]	562
[4147]	563	LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)
[4070]	564
[4147]	565	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_real32_0d !< output variable
	566	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL :: values_real64_0d !< output variable
	567	REAL(wp), POINTER, INTENT(IN), OPTIONAL :: values_realwp_0d !< output variable
	568	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_real32_1d !< output variable
	569	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_real64_1d !< output variable
	570	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_realwp_1d !< output variable
	571	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_real32_2d !< output variable
	572	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_real64_2d !< output variable
	573	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_realwp_2d !< output variable
	574	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_real32_3d !< output variable
	575	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_real64_3d !< output variable
	576	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_realwp_3d !< output variable
[4070]	577
	578
[4106]	579	#if defined( __netcdf4 )
[4070]	580
	581	#if defined( __parallel )
[4147]	582	CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
	583	IF ( return_value /= 0 ) THEN
	584	CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
	585	ENDIF
[4106]	586	#else
[4147]	587	my_rank = master_rank
	588	return_value = 0
[4070]	589	#endif
	590
[4577]	591	IF ( return_value == 0 .AND. ( .NOT. is_global .OR. my_rank == master_rank ) ) THEN
[4070]	592
[4147]	593	WRITE( temp_string, * ) variable_id
	594	CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
[4070]	595
[4147]	596	ndims = SIZE( bounds_start )
[4408]	597
[4147]	598	!
[4408]	599	!-- character output
	600	IF ( PRESENT( values_char_0d ) ) THEN
[4577]	601	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /), &
	602	start = bounds_start - bounds_origin + 1, &
[4408]	603	count = value_counts )
	604	ELSEIF ( PRESENT( values_char_1d ) ) THEN
[4577]	605	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_1d, &
	606	start = bounds_start - bounds_origin + 1, &
[4408]	607	count = value_counts )
	608	ELSEIF ( PRESENT( values_char_2d ) ) THEN
[4577]	609	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_2d, &
	610	start = bounds_start - bounds_origin + 1, &
[4408]	611	count = value_counts )
	612	ELSEIF ( PRESENT( values_char_3d ) ) THEN
[4577]	613	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_3d, &
	614	start = bounds_start - bounds_origin + 1, &
[4408]	615	count = value_counts )
	616	!
[4147]	617	!-- 8bit integer output
[4408]	618	ELSEIF ( PRESENT( values_int8_0d ) ) THEN
[4577]	619	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /), &
	620	start = bounds_start - bounds_origin + 1, &
[4147]	621	count = value_counts )
	622	ELSEIF ( PRESENT( values_int8_1d ) ) THEN
[4577]	623	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_1d, &
	624	start = bounds_start - bounds_origin + 1, &
[4147]	625	count = value_counts )
	626	ELSEIF ( PRESENT( values_int8_2d ) ) THEN
[4577]	627	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_2d, &
	628	start = bounds_start - bounds_origin + 1, &
[4147]	629	count = value_counts )
	630	ELSEIF ( PRESENT( values_int8_3d ) ) THEN
[4577]	631	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_3d, &
	632	start = bounds_start - bounds_origin + 1, &
[4147]	633	count = value_counts )
	634	!
	635	!-- 16bit integer output
	636	ELSEIF ( PRESENT( values_int16_0d ) ) THEN
[4577]	637	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int16_0d /), &
	638	start = bounds_start - bounds_origin + 1, &
[4147]	639	count = value_counts )
	640	ELSEIF ( PRESENT( values_int16_1d ) ) THEN
[4577]	641	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_1d, &
	642	start = bounds_start - bounds_origin + 1, &
[4147]	643	count = value_counts )
	644	ELSEIF ( PRESENT( values_int16_2d ) ) THEN
[4577]	645	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_2d, &
	646	start = bounds_start - bounds_origin + 1, &
[4147]	647	count = value_counts )
	648	ELSEIF ( PRESENT( values_int16_3d ) ) THEN
[4577]	649	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_3d, &
	650	start = bounds_start - bounds_origin + 1, &
[4147]	651	count = value_counts )
	652	!
	653	!-- 32bit integer output
	654	ELSEIF ( PRESENT( values_int32_0d ) ) THEN
[4577]	655	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int32_0d /), &
	656	start = bounds_start - bounds_origin + 1, &
[4147]	657	count = value_counts )
	658	ELSEIF ( PRESENT( values_int32_1d ) ) THEN
[4577]	659	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_1d, &
	660	start = bounds_start - bounds_origin + 1, &
[4147]	661	count = value_counts )
	662	ELSEIF ( PRESENT( values_int32_2d ) ) THEN
[4577]	663	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_2d, &
	664	start = bounds_start - bounds_origin + 1, &
[4147]	665	count = value_counts )
	666	ELSEIF ( PRESENT( values_int32_3d ) ) THEN
[4577]	667	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_3d, &
	668	start = bounds_start - bounds_origin + 1, &
[4147]	669	count = value_counts )
	670	!
[4577]	671	!-- Working-precision integer output
[4147]	672	ELSEIF ( PRESENT( values_intwp_0d ) ) THEN
[4577]	673	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_intwp_0d /), &
	674	start = bounds_start - bounds_origin + 1, &
[4147]	675	count = value_counts )
	676	ELSEIF ( PRESENT( values_intwp_1d ) ) THEN
[4577]	677	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_1d, &
	678	start = bounds_start - bounds_origin + 1, &
[4147]	679	count = value_counts )
	680	ELSEIF ( PRESENT( values_intwp_2d ) ) THEN
[4577]	681	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_2d, &
	682	start = bounds_start - bounds_origin + 1, &
[4147]	683	count = value_counts )
	684	ELSEIF ( PRESENT( values_intwp_3d ) ) THEN
[4577]	685	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_3d, &
	686	start = bounds_start - bounds_origin + 1, &
[4147]	687	count = value_counts )
	688	!
	689	!-- 32bit real output
	690	ELSEIF ( PRESENT( values_real32_0d ) ) THEN
[4577]	691	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real32_0d /), &
	692	start = bounds_start - bounds_origin + 1, &
[4147]	693	count = value_counts )
	694	ELSEIF ( PRESENT( values_real32_1d ) ) THEN
[4577]	695	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_1d, &
	696	start = bounds_start - bounds_origin + 1, &
[4147]	697	count = value_counts )
	698	ELSEIF ( PRESENT( values_real32_2d ) ) THEN
[4577]	699	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_2d, &
	700	start = bounds_start - bounds_origin + 1, &
[4147]	701	count = value_counts )
	702	ELSEIF ( PRESENT( values_real32_3d ) ) THEN
[4577]	703	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_3d, &
	704	start = bounds_start - bounds_origin + 1, &
[4147]	705	count = value_counts )
	706	!
	707	!-- 64bit real output
	708	ELSEIF ( PRESENT( values_real64_0d ) ) THEN
[4577]	709	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real64_0d /), &
	710	start = bounds_start - bounds_origin + 1, &
[4147]	711	count = value_counts )
	712	ELSEIF ( PRESENT( values_real64_1d ) ) THEN
[4577]	713	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_1d, &
	714	start = bounds_start - bounds_origin + 1, &
[4147]	715	count = value_counts )
	716	ELSEIF ( PRESENT( values_real64_2d ) ) THEN
[4577]	717	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_2d, &
	718	start = bounds_start - bounds_origin + 1, &
[4147]	719	count = value_counts )
	720	ELSEIF ( PRESENT( values_real64_3d ) ) THEN
[4577]	721	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_3d, &
	722	start = bounds_start - bounds_origin + 1, &
[4147]	723	count = value_counts )
	724	!
	725	!-- working-precision real output
	726	ELSEIF ( PRESENT( values_realwp_0d ) ) THEN
[4577]	727	nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /), &
	728	start = bounds_start - bounds_origin + 1, &
[4147]	729	count = value_counts )
	730	ELSEIF ( PRESENT( values_realwp_1d ) ) THEN
[4577]	731	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_1d, &
	732	start = bounds_start - bounds_origin + 1, &
[4147]	733	count = value_counts )
	734	ELSEIF ( PRESENT( values_realwp_2d ) ) THEN
[4577]	735	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_2d, &
	736	start = bounds_start - bounds_origin + 1, &
[4147]	737	count = value_counts )
	738	ELSEIF ( PRESENT( values_realwp_3d ) ) THEN
[4577]	739	nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_3d, &
	740	start = bounds_start - bounds_origin + 1, &
[4147]	741	count = value_counts )
	742	ELSE
	743	return_value = 1
	744	nc_stat = NF90_NOERR
	745	WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) variable_id, file_id
[4577]	746	CALL internal_message( 'error', routine_name // &
[4147]	747	': no output values given ' // TRIM( temp_string ) )
	748	ENDIF
	749	!
	750	!-- Check for errors
	751	IF ( nc_stat /= NF90_NOERR ) THEN
	752	return_value = 1
[4070]	753
[4147]	754	IF ( nc_stat == NF90_EEDGE .OR. nc_stat == NF90_EINVALCOORDS ) THEN
	755	!
	756	!-- If given bounds exceed dimension bounds, get information of bounds in file
	757	WRITE( temp_string, * ) NF90_STRERROR( nc_stat )
[4070]	758
[4147]	759	ALLOCATE( dimension_ids(ndims) )
	760	ALLOCATE( dimension_lengths(ndims) )
[4106]	761
[4147]	762	nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, dimids=dimension_ids )
[4106]	763
[4147]	764	d = 1
	765	DO WHILE ( d <= ndims .AND. nc_stat == NF90_NOERR )
[4577]	766	nc_stat = NF90_INQUIRE_DIMENSION( file_id, dimension_ids(d), &
[4147]	767	LEN=dimension_lengths(d) )
	768	d = d + 1
	769	ENDDO
[4106]	770
[4147]	771	IF ( nc_stat == NF90_NOERR ) THEN
[4577]	772	WRITE( temp_string, * ) TRIM( temp_string ) // '; given variable bounds: ' // &
[4147]	773	'start=', bounds_start, ', count=', value_counts, ', origin=', bounds_origin
[4577]	774	CALL internal_message( 'error', routine_name // &
[4147]	775	': error while writing: ' // TRIM( temp_string ) )
	776	ELSE
	777	!
	778	!-- Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION
[4577]	779	CALL internal_message( 'error', routine_name // &
	780	': error while accessing file: ' // &
[4147]	781	NF90_STRERROR( nc_stat ) )
	782	ENDIF
[4106]	783
[4147]	784	ELSE
	785	!
	786	!-- Other NetCDF error
[4577]	787	CALL internal_message( 'error', routine_name // &
[4147]	788	': error while writing: ' // NF90_STRERROR( nc_stat ) )
	789	ENDIF
	790	ENDIF
[4106]	791
[4147]	792	ENDIF
[4070]	793	#else
[4147]	794	return_value = 1
[4070]	795	#endif
	796
[4147]	797	END SUBROUTINE netcdf4_write_variable
[4070]	798
	799	!--------------------------------------------------------------------------------------------------!
	800	! Description:
	801	! ------------
	802	!> Close netcdf file.
	803	!--------------------------------------------------------------------------------------------------!
[4147]	804	SUBROUTINE netcdf4_finalize( file_id, return_value )
[4070]	805
[4147]	806	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_finalize' !< name of routine
[4070]	807
[4147]	808	INTEGER, INTENT(IN) :: file_id !< file ID
	809	INTEGER :: nc_stat !< netcdf return value
	810	INTEGER, INTENT(OUT) :: return_value !< return value
[4070]	811
	812
[4106]	813	#if defined( __netcdf4 )
[4147]	814	WRITE( temp_string, * ) file_id
[4577]	815	CALL internal_message( 'debug', routine_name // &
[4147]	816	': close file (file_id=' // TRIM( temp_string ) // ')' )
[4070]	817
[4147]	818	nc_stat = NF90_CLOSE( file_id )
	819	IF ( nc_stat == NF90_NOERR ) THEN
	820	return_value = 0
	821	ELSE
	822	return_value = 1
[4577]	823	CALL internal_message( 'error', routine_name // &
[4147]	824	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
	825	ENDIF
[4070]	826	#else
[4147]	827	return_value = 1
[4070]	828	#endif
	829
[4147]	830	END SUBROUTINE netcdf4_finalize
[4070]	831
	832	!--------------------------------------------------------------------------------------------------!
	833	! Description:
	834	! ------------
	835	!> Convert data_type string into netcdf data type value.
	836	!--------------------------------------------------------------------------------------------------!
[4147]	837	FUNCTION get_netcdf_data_type( data_type ) RESULT( return_value )
[4070]	838
[4577]	839	CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_netcdf_data_type' !< name of this routine
	840
[4147]	841	CHARACTER(LEN=*), INTENT(IN) :: data_type !< requested data type
[4070]	842
[4147]	843	INTEGER :: return_value !< netcdf data type
[4070]	844
	845
[4147]	846	SELECT CASE ( TRIM( data_type ) )
[4070]	847
[4106]	848	#if defined( __netcdf4 )
[4147]	849	CASE ( 'char' )
	850	return_value = NF90_CHAR
[4070]	851
[4147]	852	CASE ( 'int8' )
	853	return_value = NF90_BYTE
[4070]	854
[4147]	855	CASE ( 'int16' )
	856	return_value = NF90_SHORT
[4070]	857
[4147]	858	CASE ( 'int32' )
	859	return_value = NF90_INT
[4070]	860
[4147]	861	CASE ( 'real32' )
	862	return_value = NF90_FLOAT
[4070]	863
[4147]	864	CASE ( 'real64' )
	865	return_value = NF90_DOUBLE
[4070]	866	#endif
	867
[4147]	868	CASE DEFAULT
[4577]	869	CALL internal_message( 'error', routine_name // &
[4147]	870	': data type unknown (' // TRIM( data_type ) // ')' )
	871	return_value = -1
[4070]	872
[4147]	873	END SELECT
[4070]	874
[4147]	875	END FUNCTION get_netcdf_data_type
[4070]	876
	877	!--------------------------------------------------------------------------------------------------!
	878	! Description:
	879	! ------------
[4577]	880	!> Message routine writing debug information into the debug file or creating the error message
	881	!> string.
[4070]	882	!--------------------------------------------------------------------------------------------------!
[4147]	883	SUBROUTINE internal_message( level, string )
[4070]	884
[4147]	885	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
	886	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
[4070]	887
	888
[4147]	889	IF ( TRIM( level ) == 'error' ) THEN
[4070]	890
[4147]	891	WRITE( internal_error_message, '(A,A)' ) ': ', string
[4070]	892
[4147]	893	ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN
[4070]	894
[4147]	895	WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
	896	FLUSH( debug_output_unit )
[4070]	897
[4147]	898	ENDIF
[4070]	899
[4147]	900	END SUBROUTINE internal_message
[4070]	901
	902	!--------------------------------------------------------------------------------------------------!
	903	! Description:
	904	! ------------
	905	!> Return the last created error message.
	906	!--------------------------------------------------------------------------------------------------!
[4147]	907	FUNCTION netcdf4_get_error_message() RESULT( error_message )
[4070]	908
[4147]	909	CHARACTER(LEN=800) :: error_message !< return error message to main program
[4070]	910
	911
[4147]	912	error_message = TRIM( internal_error_message )
[4070]	913
[4147]	914	internal_error_message = ''
[4070]	915
[4147]	916	END FUNCTION netcdf4_get_error_message
[4070]	917
[4141]	918
[4147]	919	END MODULE data_output_netcdf4_module

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |