Home

Context Navigation

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

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