Home

Context Navigation

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

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