Home

Context Navigation

data_output_netcdf4_module.f90 @ 4598

Last change on this file since 4598 was 4597, checked in by gronemeier, 4 years ago

Summary:

bugfix: - write unlimited dimension in netcdf4-parallel mode

prevent unused-variable warning if preprocessor directives are not given

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

by every PE

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

Details:

data_output_module.f90:

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

by every PE

data_output_netcdf4_module.f90:

bugfix: - allow writing of unlimited dimensions in parallel mode

prevent unused-variable warning if preprocessor directives are not given

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

data_output_binary_module.f90:

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

Property svn:keywords set to Id

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

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

Context Navigation

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

Download in other formats: