Home

Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

data_output_netcdf4_parallel_module.f90 @ 4087

Last change on this file since 4087 was 4070, checked in by gronemeier, 5 years ago
Add new data output modules
Property svn:keywords set to `Id`
File size: 33.7 KB

Rev	Line
[4070]	1	!> @file data_output_netcdf4_parallel_module.f90
	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	! ------------------
	22	!
	23	!
	24	! Former revisions:
	25	! -----------------
	26	! $Id: data_output_netcdf4_parallel_module.f90 4070 2019-07-03 13:51:40Z gronemeier $
	27	! Initial revision
	28	!
	29	!
	30	! Authors:
	31	! --------
	32	!> @author: Tobias Gronemeier
	33	!
	34	! Description:
	35	! ------------
	36	!> NetCDF output module to write data to NetCDF files using parallel NetCDF.
	37	!>
	38	!> @todo Think of removing 'is_init' as its value can be derived from the return
	39	!> value of 'return_value'.
	40	!--------------------------------------------------------------------------------------------------!
	41	MODULE data_output_netcdf4_parallel_module
	42
	43	USE kinds
	44
	45	#if defined( __parallel )
	46	#if defined( __mpifh )
	47	INCLUDE "mpif.h"
	48	#else
	49	USE MPI
	50	#endif
	51	#endif
	52
	53	#if defined( __netcdf4_parallel )
	54	USE NETCDF
	55	#endif
	56
	57	IMPLICIT NONE
	58
	59	CHARACTER(LEN=800) :: internal_error_message = '' !< string containing the last error message
	60	CHARACTER(LEN=800) :: temp_string !< dummy string
	61
	62	INTEGER(iwp) :: debug_output_unit !< Fortran Unit Number of the debug-output file
	63	INTEGER(iwp) :: global_id_in_file = -1 !< value of global ID within a file
	64
	65	LOGICAL :: print_debug_output = .FALSE. !< if true, debug output is printed
	66
	67	SAVE
	68
	69	PRIVATE
	70
	71	INTERFACE netcdf4_parallel_init_module
	72	MODULE PROCEDURE netcdf4_parallel_init_module
	73	END INTERFACE netcdf4_parallel_init_module
	74
	75	INTERFACE netcdf4_parallel_open_file
	76	MODULE PROCEDURE netcdf4_parallel_open_file
	77	END INTERFACE netcdf4_parallel_open_file
	78
	79	INTERFACE netcdf4_parallel_init_dimension
	80	MODULE PROCEDURE netcdf4_parallel_init_dimension
	81	END INTERFACE netcdf4_parallel_init_dimension
	82
	83	INTERFACE netcdf4_parallel_init_variable
	84	MODULE PROCEDURE netcdf4_parallel_init_variable
	85	END INTERFACE netcdf4_parallel_init_variable
	86
	87	INTERFACE netcdf4_parallel_write_attribute
	88	MODULE PROCEDURE netcdf4_parallel_write_attribute
	89	END INTERFACE netcdf4_parallel_write_attribute
	90
	91	INTERFACE netcdf4_parallel_init_end
	92	MODULE PROCEDURE netcdf4_parallel_init_end
	93	END INTERFACE netcdf4_parallel_init_end
	94
	95	INTERFACE netcdf4_parallel_write_variable
	96	MODULE PROCEDURE netcdf4_parallel_write_variable
	97	END INTERFACE netcdf4_parallel_write_variable
	98
	99	INTERFACE netcdf4_parallel_finalize
	100	MODULE PROCEDURE netcdf4_parallel_finalize
	101	END INTERFACE netcdf4_parallel_finalize
	102
	103	INTERFACE netcdf4_parallel_get_error_message
	104	MODULE PROCEDURE netcdf4_parallel_get_error_message
	105	END INTERFACE netcdf4_parallel_get_error_message
	106
	107	PUBLIC &
	108	netcdf4_parallel_finalize, &
	109	netcdf4_parallel_get_error_message, &
	110	netcdf4_parallel_init_dimension, &
	111	netcdf4_parallel_init_end, &
	112	netcdf4_parallel_init_module, &
	113	netcdf4_parallel_init_variable, &
	114	netcdf4_parallel_open_file, &
	115	netcdf4_parallel_write_attribute, &
	116	netcdf4_parallel_write_variable
	117
	118
	119	CONTAINS
	120
	121
	122	!--------------------------------------------------------------------------------------------------!
	123	! Description:
	124	! ------------
	125	!> Initialize data-output module.
	126	!--------------------------------------------------------------------------------------------------!
	127	SUBROUTINE netcdf4_parallel_init_module( program_debug_output_unit, debug_output, dom_global_id )
	128
	129	INTEGER(iwp), INTENT(IN) :: dom_global_id !< global id within a file defined by DOM
	130	INTEGER(iwp), INTENT(IN) :: program_debug_output_unit !< file unit number for debug output
	131
	132	LOGICAL, INTENT(IN) :: debug_output !< if true, debug output is printed
	133
	134
	135	debug_output_unit = program_debug_output_unit
	136
	137	print_debug_output = debug_output
	138
	139	global_id_in_file = dom_global_id
	140
	141
	142	END SUBROUTINE netcdf4_parallel_init_module
	143
	144	!--------------------------------------------------------------------------------------------------!
	145	! Description:
	146	! ------------
	147	!> Open netcdf file.
	148	!--------------------------------------------------------------------------------------------------!
	149	SUBROUTINE netcdf4_parallel_open_file( filename, file_id, return_value )
	150
	151	CHARACTER(LEN=*), INTENT(IN) :: filename !< name of file
	152
	153	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_open_file' !< name of this routine
	154
	155	INTEGER(iwp), INTENT(OUT) :: file_id !< file ID
	156	INTEGER(iwp) :: nc_stat !< netcdf return value
	157	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
	158
	159
	160	#if defined( __parallel ) && defined( __netcdf4_parallel )
	161	return_value = 0
	162
	163	!-- Open new file
	164	CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( filename ) // '"' )
	165
	166	nc_stat = NF90_CREATE( TRIM( filename ), &
	167	IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &
	168	file_id, COMM = MPI_COMM_WORLD, INFO = MPI_INFO_NULL )
	169
	170	IF ( nc_stat /= NF90_NOERR ) THEN
	171	return_value = 1
	172	CALL internal_message( 'error', routine_name // ': NetCDF error while opening file "' // &
	173	TRIM( filename ) // '": ' // NF90_STRERROR( nc_stat ) )
	174	ENDIF
	175	#else
	176	file_id = -1
	177	nc_stat = 0
	178	return_value = 1
	179	CALL internal_message( 'error', routine_name // &
	180	': pre-processor directives "__parallel" ' // &
	181	'and/or "__netcdf4_parallel" not given. ' // &
	182	'Using parallel NetCDF4 output not possible' )
	183	#endif
	184
	185	END SUBROUTINE netcdf4_parallel_open_file
	186
	187	!--------------------------------------------------------------------------------------------------!
	188	! Description:
	189	! ------------
	190	!> Write attribute to netcdf file.
	191	!--------------------------------------------------------------------------------------------------!
	192	SUBROUTINE netcdf4_parallel_write_attribute( file_id, var_id, att_name, att_value_char, &
	193	att_value_int8, att_value_int16, att_value_int32, &
	194	att_value_real32, att_value_real64, return_value )
	195
	196	CHARACTER(LEN=*), INTENT(IN) :: att_name !< name of attribute
	197	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: att_value_char !< value of attribute
	198
	199	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_write_attribute' !< name of this routine
	200
	201	INTEGER(iwp) :: nc_stat !< netcdf return value
	202	INTEGER(iwp) :: target_id !< ID of target which gets attribute (either global or var_id)
	203
	204	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
	205	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
	206	INTEGER(iwp), INTENT(IN) :: var_id !< variable ID
	207
	208	INTEGER(KIND=1), INTENT(IN), OPTIONAL :: att_value_int8 !< value of attribute
	209	INTEGER(KIND=2), INTENT(IN), OPTIONAL :: att_value_int16 !< value of attribute
	210	INTEGER(KIND=4), INTENT(IN), OPTIONAL :: att_value_int32 !< value of attribute
	211
	212	REAL(KIND=4), INTENT(IN), OPTIONAL :: att_value_real32 !< value of attribute
	213	REAL(KIND=8), INTENT(IN), OPTIONAL :: att_value_real64 !< value of attribute
	214
	215
	216	#if defined( __netcdf4_parallel )
	217	return_value = 0
	218
	219	IF ( var_id == global_id_in_file ) THEN
	220	target_id = NF90_GLOBAL
	221	ELSE
	222	target_id = var_id
	223	ENDIF
	224
	225	CALL internal_message( 'debug', &
	226	routine_name // ': write attribute "' // TRIM( att_name ) // '"' )
	227
	228	IF ( PRESENT( att_value_char ) ) THEN
	229	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), TRIM( att_value_char ) )
	230	ELSEIF ( PRESENT( att_value_int8 ) ) THEN
	231	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int8 )
	232	ELSEIF ( PRESENT( att_value_int16 ) ) THEN
	233	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int16 )
	234	ELSEIF ( PRESENT( att_value_int32 ) ) THEN
	235	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int32 )
	236	ELSEIF ( PRESENT( att_value_real32 ) ) THEN
	237	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_real32 )
	238	ELSEIF ( PRESENT( att_value_real64 ) ) THEN
	239	nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_real64 )
	240	ELSE
	241	return_value = 1
	242	CALL internal_message( 'error', TRIM( routine_name ) // &
	243	': attribute "' // TRIM( att_name ) // '": no value given' )
	244	ENDIF
	245
	246	IF ( return_value == 0 ) THEN
	247	IF ( nc_stat /= NF90_NOERR ) THEN
	248	return_value = 1
	249	CALL internal_message( 'error', &
	250	routine_name // ': NetCDF error while writing attribute "' // &
	251	TRIM( att_name ) // '": ' // NF90_STRERROR( nc_stat ) )
	252	ENDIF
	253	ENDIF
	254	#else
	255	return_value = 1
	256	#endif
	257
	258	END SUBROUTINE netcdf4_parallel_write_attribute
	259
	260	!--------------------------------------------------------------------------------------------------!
	261	! Description:
	262	! ------------
	263	!> Initialize dimension.
	264	!--------------------------------------------------------------------------------------------------!
	265	SUBROUTINE netcdf4_parallel_init_dimension( file_id, dim_id, var_id, &
	266	dim_name, dim_type, dim_length, is_init, return_value )
	267
	268	CHARACTER(LEN=*), INTENT(IN) :: dim_name !< name of dimension
	269	CHARACTER(LEN=*), INTENT(IN) :: dim_type !< data type of dimension
	270
	271	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_init_dimension' !< name of this routine
	272
	273	INTEGER(iwp), INTENT(OUT) :: dim_id !< dimension ID
	274	INTEGER(iwp), INTENT(IN) :: dim_length !< length of dimension
	275	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
	276	INTEGER(iwp) :: nc_dim_length !< length of dimension
	277	INTEGER(iwp) :: nc_stat !< netcdf return value
	278	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
	279	INTEGER(iwp), INTENT(OUT) :: var_id !< variable ID
	280
	281	LOGICAL, INTENT(OUT) :: is_init !< true if dimension is initialized
	282
	283
	284	#if defined( __netcdf4_parallel )
	285	return_value = 0
	286	var_id = -1
	287
	288	CALL internal_message( 'debug', routine_name // ': init dimension "' // TRIM( dim_name ) // '"' )
	289
	290	!-- Check if dimension is unlimited
	291	IF ( dim_length < 0 ) THEN
	292	nc_dim_length = NF90_UNLIMITED
	293	ELSE
	294	nc_dim_length = dim_length
	295	ENDIF
	296
	297	!-- Define dimension in file
	298	nc_stat = NF90_DEF_DIM( file_id, dim_name, nc_dim_length, dim_id )
	299
	300	IF ( nc_stat == NF90_NOERR ) THEN
	301
	302	!-- Define variable holding dimension values in file
	303	CALL netcdf4_parallel_init_variable( file_id, var_id, dim_name, dim_type, (/dim_id/), &
	304	is_init, is_global=.TRUE., return_value=return_value )
	305
	306	ELSE
	307	return_value = 1
	308	is_init = .FALSE.
	309	CALL internal_message( 'error', routine_name // &
	310	': NetCDF error while initializing dimension "' // &
	311	TRIM( dim_name ) // '": ' // NF90_STRERROR( nc_stat ) )
	312	ENDIF
	313	#else
	314	return_value = 1
	315	var_id = -1
	316	dim_id = -1
	317	is_init = .FALSE.
	318	#endif
	319
	320	END SUBROUTINE netcdf4_parallel_init_dimension
	321
	322	!--------------------------------------------------------------------------------------------------!
	323	! Description:
	324	! ------------
	325	!> Initialize variable.
	326	!--------------------------------------------------------------------------------------------------!
	327	SUBROUTINE netcdf4_parallel_init_variable( file_id, var_id, var_name, var_type, var_dim_ids, &
	328	is_init, is_global, return_value )
	329
	330	CHARACTER(LEN=*), INTENT(IN) :: var_name !< name of variable
	331	CHARACTER(LEN=*), INTENT(IN) :: var_type !< data type of variable
	332
	333	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_init_variable' !< name of this routine
	334
	335	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
	336	INTEGER(iwp) :: nc_stat !< netcdf return value
	337	INTEGER(iwp) :: nc_var_type !< netcdf data type
	338	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
	339	INTEGER(iwp), INTENT(OUT) :: var_id !< variable ID
	340
	341	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: var_dim_ids !< list of dimension IDs used by variable
	342
	343	LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)
	344	LOGICAL, INTENT(OUT) :: is_init !< true if variable is initialized
	345
	346
	347	#if defined( __netcdf4_parallel )
	348	return_value = 0
	349
	350	WRITE( temp_string, * ) is_global
	351	CALL internal_message( 'debug', routine_name // ': init variable "' // TRIM( var_name ) // &
	352	'" ( is_global = ' // TRIM( temp_string ) // ')' )
	353
	354	nc_var_type = get_netcdf_data_type( var_type )
	355
	356	IF ( nc_var_type /= -1_iwp ) THEN
	357
	358	!-- Define variable in file
	359	nc_stat = NF90_DEF_VAR( file_id, var_name, nc_var_type, var_dim_ids, var_id )
	360
	361	IF ( nc_stat == NF90_NOERR ) THEN
	362	IF ( is_global ) THEN
	363	nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_INDEPENDENT )
	364	ELSE
	365	nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_COLLECTIVE )
	366	ENDIF
	367	ENDIF
	368
	369	IF ( nc_stat /= NF90_NOERR) THEN
	370	return_value = 1
	371	CALL internal_message( 'error', routine_name // &
	372	': NetCDF error while initializing variable "' // &
	373	TRIM( var_name ) // '": ' // NF90_STRERROR( nc_stat ) )
	374	ENDIF
	375
	376	ELSE
	377	return_value = 1
	378	ENDIF
	379
	380	is_init = return_value == 0
	381	#else
	382	return_value = 1
	383	var_id = -1
	384	is_init = .FALSE.
	385	#endif
	386
	387	END SUBROUTINE netcdf4_parallel_init_variable
	388
	389	!--------------------------------------------------------------------------------------------------!
	390	! Description:
	391	! ------------
	392	!> Leave file definition state.
	393	!--------------------------------------------------------------------------------------------------!
	394	SUBROUTINE netcdf4_parallel_init_end( file_id, return_value )
	395
	396	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_init_end' !< name of this routine
	397
	398	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
	399	INTEGER(iwp) :: nc_stat !< netcdf return value
	400	INTEGER(iwp) :: old_mode !< previous netcdf fill mode
	401	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
	402
	403
	404	#if defined( __netcdf4_parallel )
	405	return_value = 0
	406
	407	WRITE( temp_string, * ) file_id
	408	CALL internal_message( 'debug', &
	409	routine_name // &
	410	': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
	411
	412	!-- Set general no fill, otherwise the performance drops significantly
	413	nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_mode )
	414
	415	IF ( nc_stat == NF90_NOERR ) THEN
	416	nc_stat = NF90_ENDDEF( file_id )
	417	ENDIF
	418
	419	IF ( nc_stat /= NF90_NOERR ) THEN
	420	return_value = 1
	421	CALL internal_message( 'error', routine_name // ': NetCDF error: ' // &
	422	NF90_STRERROR( nc_stat ) )
	423	ENDIF
	424	#else
	425	return_value = 1
	426	#endif
	427
	428	END SUBROUTINE netcdf4_parallel_init_end
	429
	430	!--------------------------------------------------------------------------------------------------!
	431	! Description:
	432	! ------------
	433	!> Write variable of different kind into netcdf file.
	434	!--------------------------------------------------------------------------------------------------!
	435	SUBROUTINE netcdf4_parallel_write_variable( &
	436	file_id, var_id, bounds_start, bounds_end, bounds_origin, &
	437	do_output, is_global, &
	438	var_int8_0d, var_int8_1d, var_int8_2d, var_int8_3d, &
	439	var_int16_0d, var_int16_1d, var_int16_2d, var_int16_3d, &
	440	var_int32_0d, var_int32_1d, var_int32_2d, var_int32_3d, &
	441	var_intwp_0d, var_intwp_1d, var_intwp_2d, var_intwp_3d, &
	442	var_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &
	443	var_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &
	444	var_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d, &
	445	return_value )
	446
	447	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_write_variable' !< name of this routine
	448
	449	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
	450	INTEGER(iwp) :: myid = 0 !< id number of processor element
	451	INTEGER(iwp) :: nc_stat !< netcdf return value
	452	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
	453	INTEGER(iwp), INTENT(IN) :: var_id !< variable ID
	454
	455	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension
	456	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_end !< ending index of variable
	457	INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_start !< starting index of variable
	458	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: value_count !< count of values along each dimension to be written
	459
	460	INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: var_int8_0d !< output variable
	461	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int8_1d !< output variable
	462	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int8_2d !< output variable
	463	INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int8_3d !< output variable
	464
	465	INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL :: var_int16_0d !< output variable
	466	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int16_1d !< output variable
	467	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int16_2d !< output variable
	468	INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int16_3d !< output variable
	469
	470	INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL :: var_int32_0d !< output variable
	471	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int32_1d !< output variable
	472	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int32_2d !< output variable
	473	INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int32_3d !< output variable
	474
	475	INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL :: var_intwp_0d !< output variable
	476	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_intwp_1d !< output variable
	477	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_intwp_2d !< output variable
	478	INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_intwp_3d !< output variable
	479
	480	LOGICAL, INTENT(IN) :: do_output !< if false, set count to 0 and do no output
	481	LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)
	482
	483	REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: var_real32_0d !< output variable
	484	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_real32_1d !< output variable
	485	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_real32_2d !< output variable
	486	REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_real32_3d !< output variable
	487
	488	REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL :: var_real64_0d !< output variable
	489	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_real64_1d !< output variable
	490	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_real64_2d !< output variable
	491	REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_real64_3d !< output variable
	492
	493	REAL(wp), POINTER, INTENT(IN), OPTIONAL :: var_realwp_0d !< output variable
	494	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_realwp_1d !< output variable
	495	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_realwp_2d !< output variable
	496	REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_realwp_3d !< output variable
	497
	498
	499	#if defined( __netcdf4_parallel )
	500	return_value = 0
	501
	502	#if defined( __parallel )
	503	CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, return_value )
	504	IF ( return_value /= 0 ) THEN
	505	CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
	506	ENDIF
	507	#endif
	508
	509	IF ( return_value == 0 .AND. ( .NOT. is_global .OR. myid == 0 ) ) THEN
	510
	511	WRITE( temp_string, * ) var_id
	512	CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
	513
	514	ALLOCATE( value_count(SIZE( bounds_start )) )
	515
	516	IF ( do_output ) THEN
	517	value_count = bounds_end - bounds_start + 1
	518	ELSE
	519	value_count = 0
	520	END IF
	521
	522	!-- 8bit integer output
	523	IF ( PRESENT( var_int8_0d ) ) THEN
	524	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int8_0d /), &
	525	start = bounds_start - bounds_origin + 1, &
	526	count = value_count )
	527	ELSEIF ( PRESENT( var_int8_1d ) ) THEN
	528	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_1d, &
	529	start = bounds_start - bounds_origin + 1, &
	530	count = value_count )
	531	ELSEIF ( PRESENT( var_int8_2d ) ) THEN
	532	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_2d, &
	533	start = bounds_start - bounds_origin + 1, &
	534	count = value_count )
	535	ELSEIF ( PRESENT( var_int8_3d ) ) THEN
	536	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_3d, &
	537	start = bounds_start - bounds_origin + 1, &
	538	count = value_count )
	539	!-- 16bit integer output
	540	ELSEIF ( PRESENT( var_int16_0d ) ) THEN
	541	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int16_0d /), &
	542	start = bounds_start - bounds_origin + 1, &
	543	count = value_count )
	544	ELSEIF ( PRESENT( var_int16_1d ) ) THEN
	545	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_1d, &
	546	start = bounds_start - bounds_origin + 1, &
	547	count = value_count )
	548	ELSEIF ( PRESENT( var_int16_2d ) ) THEN
	549	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_2d, &
	550	start = bounds_start - bounds_origin + 1, &
	551	count = value_count )
	552	ELSEIF ( PRESENT( var_int16_3d ) ) THEN
	553	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_3d, &
	554	start = bounds_start - bounds_origin + 1, &
	555	count = value_count )
	556	!-- 32bit integer output
	557	ELSEIF ( PRESENT( var_int32_0d ) ) THEN
	558	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int32_0d /), &
	559	start = bounds_start - bounds_origin + 1, &
	560	count = value_count )
	561	ELSEIF ( PRESENT( var_int32_1d ) ) THEN
	562	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_1d, &
	563	start = bounds_start - bounds_origin + 1, &
	564	count = value_count )
	565	ELSEIF ( PRESENT( var_int32_2d ) ) THEN
	566	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_2d, &
	567	start = bounds_start - bounds_origin + 1, &
	568	count = value_count )
	569	ELSEIF ( PRESENT( var_int32_3d ) ) THEN
	570	nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_3d, &
	571	start = bounds_start - bounds_origin + 1, &
	572	count = value_count )
	573	!-- working-precision integer output
	574	ELSEIF ( PRESENT( var_intwp_0d ) ) THEN
	575	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_intwp_0d /), &
	576	start = bounds_start - bounds_origin + 1, &
	577	count = value_count )
	578	ELSEIF ( PRESENT( var_intwp_1d ) ) THEN
	579	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_1d, &
	580	start = bounds_start - bounds_origin + 1, &
	581	count = value_count )
	582	ELSEIF ( PRESENT( var_intwp_2d ) ) THEN
	583	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_2d, &
	584	start = bounds_start - bounds_origin + 1, &
	585	count = value_count )
	586	ELSEIF ( PRESENT( var_intwp_3d ) ) THEN
	587	nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_3d, &
	588	start = bounds_start - bounds_origin + 1, &
	589	count = value_count )
	590	!-- 32bit real output
	591	ELSEIF ( PRESENT( var_real32_0d ) ) THEN
	592	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_real32_0d /), &
	593	start = bounds_start - bounds_origin + 1, &
	594	count = value_count )
	595	ELSEIF ( PRESENT( var_real32_1d ) ) THEN
	596	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_1d, &
	597	start = bounds_start - bounds_origin + 1, &
	598	count = value_count )
	599	ELSEIF ( PRESENT( var_real32_2d ) ) THEN
	600	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_2d, &
	601	start = bounds_start - bounds_origin + 1, &
	602	count = value_count )
	603	ELSEIF ( PRESENT( var_real32_3d ) ) THEN
	604	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_3d, &
	605	start = bounds_start - bounds_origin + 1, &
	606	count = value_count )
	607	!-- 64bit real output
	608	ELSEIF ( PRESENT( var_real64_0d ) ) THEN
	609	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_real64_0d /), &
	610	start = bounds_start - bounds_origin + 1, &
	611	count = value_count )
	612	ELSEIF ( PRESENT( var_real64_1d ) ) THEN
	613	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_1d, &
	614	start = bounds_start - bounds_origin + 1, &
	615	count = value_count )
	616	ELSEIF ( PRESENT( var_real64_2d ) ) THEN
	617	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_2d, &
	618	start = bounds_start - bounds_origin + 1, &
	619	count = value_count )
	620	ELSEIF ( PRESENT( var_real64_3d ) ) THEN
	621	nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_3d, &
	622	start = bounds_start - bounds_origin + 1, &
	623	count = value_count )
	624	!-- working-precision real output
	625	ELSEIF ( PRESENT( var_realwp_0d ) ) THEN
	626	nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_realwp_0d /), &
	627	start = bounds_start - bounds_origin + 1, &
	628	count = value_count )
	629	ELSEIF ( PRESENT( var_realwp_1d ) ) THEN
	630	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_1d, &
	631	start = bounds_start - bounds_origin + 1, &
	632	count = value_count )
	633	ELSEIF ( PRESENT( var_realwp_2d ) ) THEN
	634	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_2d, &
	635	start = bounds_start - bounds_origin + 1, &
	636	count = value_count )
	637	ELSEIF ( PRESENT( var_realwp_3d ) ) THEN
	638	nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_3d, &
	639	start = bounds_start - bounds_origin + 1, &
	640	count = value_count )
	641	ELSE
	642	return_value = 1
	643	nc_stat = NF90_NOERR
	644	WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) var_id, file_id
	645	CALL internal_message( 'error', routine_name // &
	646	TRIM( temp_string ) // &
	647	': no output values given' )
	648	ENDIF
	649
	650	!-- Check for errors
	651	IF ( nc_stat /= NF90_NOERR ) THEN
	652	return_value = 1
	653	WRITE( temp_string, * ) 'variable_id=', var_id, '; file_id=', file_id, &
	654	', bounds_start=', bounds_start, &
	655	', bounds_end=', bounds_end, &
	656	', count=', value_count
	657	CALL internal_message( 'error', routine_name // &
	658	': error while writing ' // TRIM( temp_string ) // &
	659	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
	660	ENDIF
	661
	662	ENDIF
	663	#else
	664	return_value = 1
	665	#endif
	666
	667	END SUBROUTINE netcdf4_parallel_write_variable
	668
	669	!--------------------------------------------------------------------------------------------------!
	670	! Description:
	671	! ------------
	672	!> Close netcdf file.
	673	!--------------------------------------------------------------------------------------------------!
	674	SUBROUTINE netcdf4_parallel_finalize( file_id, return_value )
	675
	676	CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_parallel_finalize' !< name of routine
	677
	678	INTEGER(iwp), INTENT(IN) :: file_id !< file ID
	679	INTEGER(iwp) :: nc_stat !< netcdf return value
	680	INTEGER(iwp), INTENT(OUT) :: return_value !< return value
	681
	682
	683	#if defined( __netcdf4_parallel )
	684	WRITE( temp_string, * ) file_id
	685	CALL internal_message( 'debug', routine_name // &
	686	': close file (file_id=' // TRIM( temp_string ) // ')' )
	687
	688	nc_stat = NF90_CLOSE( file_id )
	689	IF ( nc_stat == NF90_NOERR ) THEN
	690	return_value = 0
	691	ELSE
	692	return_value = 1
	693	CALL internal_message( 'error', routine_name // &
	694	': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
	695	ENDIF
	696	#else
	697	return_value = 1
	698	#endif
	699
	700	END SUBROUTINE netcdf4_parallel_finalize
	701
	702	!--------------------------------------------------------------------------------------------------!
	703	! Description:
	704	! ------------
	705	!> Convert data_type string into netcdf data type value.
	706	!--------------------------------------------------------------------------------------------------!
	707	FUNCTION get_netcdf_data_type( data_type ) RESULT( return_value )
	708
	709	CHARACTER(LEN=*), INTENT(IN) :: data_type !< requested data type
	710
	711	CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_netcdf_data_type' !< name of this routine
	712
	713	INTEGER(iwp) :: return_value !< netcdf data type
	714
	715
	716	SELECT CASE ( TRIM( data_type ) )
	717
	718	#if defined( __netcdf4_parallel )
	719	CASE ( 'char' )
	720	return_value = NF90_CHAR
	721
	722	CASE ( 'int8' )
	723	return_value = NF90_BYTE
	724
	725	CASE ( 'int16' )
	726	return_value = NF90_SHORT
	727
	728	CASE ( 'int32' )
	729	return_value = NF90_INT
	730
	731	CASE ( 'real32' )
	732	return_value = NF90_FLOAT
	733
	734	CASE ( 'real64' )
	735	return_value = NF90_DOUBLE
	736	#endif
	737
	738	CASE DEFAULT
	739	CALL internal_message( 'error', routine_name // &
	740	': data type unknown (' // TRIM( data_type ) // ')' )
	741	return_value = -1_iwp
	742
	743	END SELECT
	744
	745	END FUNCTION get_netcdf_data_type
	746
	747	!--------------------------------------------------------------------------------------------------!
	748	! Description:
	749	! ------------
	750	!> Message routine writing debug information into the debug file
	751	!> or creating the error message string.
	752	!--------------------------------------------------------------------------------------------------!
	753	SUBROUTINE internal_message( level, string )
	754
	755	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
	756	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
	757
	758
	759	IF ( TRIM( level ) == 'error' ) THEN
	760
	761	WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
	762
	763	ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN
	764
	765	WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
	766	FLUSH( debug_output_unit )
	767
	768	ENDIF
	769
	770	END SUBROUTINE internal_message
	771
	772	!--------------------------------------------------------------------------------------------------!
	773	! Description:
	774	! ------------
	775	!> Return the last created error message.
	776	!--------------------------------------------------------------------------------------------------!
	777	SUBROUTINE netcdf4_parallel_get_error_message( error_message )
	778
	779	CHARACTER(LEN=800), INTENT(OUT) :: error_message !< return error message to main program
	780
	781
	782	error_message = internal_error_message
	783
	784	END SUBROUTINE netcdf4_parallel_get_error_message
	785
	786
	787	END MODULE data_output_netcdf4_parallel_module

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

Context Navigation

source: palm/trunk/SOURCE/data_output_netcdf4_parallel_module.f90 @ 4087

Download in other formats: