Home

Context Navigation

source: palm/trunk/SOURCE/data_output_netcdf4_serial_module.f90 @ 4096

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |