Home

Context Navigation

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

Last change on this file since 4142 was 4141, checked in by gronemeier, 5 years ago

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

renaming of variables
changes to formatting and layout
update routine descriptions

Property svn:keywords set to Id

File size: 38.1 KB

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