Home

Context Navigation

source: palm/trunk/SOURCE/restart_data_mpi_io_mod.f90 @ 4558

Last change on this file since 4558 was 4539, checked in by raasch, 5 years ago
checks added, if index limits in header are exceeded (restart_data_mpi_io_mod), bugfix in rrd_mpi_io_int_2d, location and log_point names added/modified, cpu time per grid point and timestep does not included initialization and spinup any more (cpulog_mod)
Property svn:keywords set to `Id`
File size: 94.3 KB

Rev	Line
[4495]	1	!> @file restart_data_mpi_io_mod.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 terms of the GNU General
	6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
	7	! (at your option) any later version.
	8	!
	9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
	10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
	11	! Public License for more details.
	12	!
	13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
	14	! <http://www.gnu.org/licenses/>.
	15	!
	16	! Copyright 1997-2020 Leibniz Universitaet Hannover
	17	! -------------------------------------------------------------------------------------------------!
	18	!
	19	! Current revisions:
	20	! -----------------
	21	!
	22	!
	23	! Former revisions:
	24	! -----------------
	25	! $Id: restart_data_mpi_io_mod.f90 4539 2020-05-18 14:05:17Z moh.hefny $
[4539]	26	! checks added, if index limits in header are exceeded
	27	! bugfix in rrd_mpi_io_int_2d
	28	!
	29	! 4536 2020-05-17 17:24:13Z raasch
[4536]	30	! messages and debug output converted to PALM routines
	31	!
	32	! 4534 2020-05-14 18:35:22Z raasch
[4534]	33	! I/O on reduced number of cores added (using shared memory MPI)
	34	!
	35	! 4500 2020-04-17 10:12:45Z suehring
[4500]	36	! Fix too long lines
	37	!
	38	! 4498 2020-04-15 14:26:31Z raasch
[4498]	39	! bugfix for creation of filetypes, argument removed from rd_mpi_io_open
	40	!
	41	! 4497 2020-04-15 10:20:51Z raasch
[4497]	42	! last bugfix deactivated because of compile problems
	43	!
	44	! 4496 2020-04-15 08:37:26Z raasch
[4496]	45	! problem with posix read arguments for surface data fixed
	46	!
	47	! 4495 2020-04-13 20:11:20Z raasch
	48	! Initial version (K. Ketelsen), adjusted to PALM formatting standards (s. Raasch)
[4495]	49	!
	50	!
	51	!
	52	! Description:
	53	! ------------
	54	!> Routines for restart data handling using MPI-IO.
	55	!--------------------------------------------------------------------------------------------------!
	56	MODULE restart_data_mpi_io_mod
	57
	58	#if defined( __parallel )
	59	#if defined( __mpifh )
	60	INCLUDE "mpif.h"
	61	#else
	62	USE MPI
	63	#endif
	64	#else
	65	USE posix_interface, &
	66	ONLY: posix_close, posix_lseek, posix_open, posix_read, posix_write
	67	#endif
	68
	69	USE, INTRINSIC :: ISO_C_BINDING
	70
	71	USE control_parameters, &
[4536]	72	ONLY: debug_output, debug_string, include_total_domain_boundaries, message_string, &
	73	restart_data_format_input, restart_data_format_output, restart_file_size
[4495]	74
	75	USE exchange_horiz_mod, &
	76	ONLY: exchange_horiz, exchange_horiz_2d
	77
	78	USE indices, &
	79	ONLY: nbgp, nnx, nny, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt
	80
	81	USE kinds
	82
	83	USE pegrid, &
	84	ONLY: comm1dx, comm1dy, comm2d, myid, myidx, myidy, npex, npey, numprocs, pdims
	85
[4534]	86	USE shared_memory_io_mod, &
	87	ONLY: local_boundaries, sm_class
[4495]	88
[4534]	89
[4495]	90	IMPLICIT NONE
	91
[4534]	92	CHARACTER(LEN=128) :: io_file_name !> internal variable to communicate filename between
	93	!> different subroutines
[4495]	94
	95	#if defined( __parallel )
[4534]	96	INTEGER(iwp) :: ierr !< error status of MPI-calls
	97	INTEGER(iwp), PARAMETER :: rd_offset_kind = MPI_OFFSET_KIND !< Adress or Offset kind
	98	INTEGER(iwp), PARAMETER :: rd_status_size = MPI_STATUS_SIZE !<
[4495]	99	#else
[4534]	100	INTEGER(iwp), PARAMETER :: rd_offset_kind = C_SIZE_T !<
	101	INTEGER(iwp), PARAMETER :: rd_status_size = 1 !< Not required in sequential mode
[4495]	102	#endif
	103
[4534]	104	INTEGER(iwp) :: debug_level = 1 !< TODO: replace with standard debug output steering
[4495]	105
[4534]	106	INTEGER(iwp) :: comm_io !< Communicator for MPI-IO
	107	INTEGER(iwp) :: fh !< MPI-IO file handle
[4495]	108	#if defined( __parallel )
[4534]	109	INTEGER(iwp) :: fhs = -1 !< MPI-IO file handle to open file with comm2d always
[4495]	110	#endif
[4534]	111	INTEGER(iwp) :: ft_surf = -1 !< MPI filetype surface data
	112	#if defined( __parallel )
	113	INTEGER(iwp) :: ft_2di_nb !< MPI filetype 2D array INTEGER no outer boundary
	114	INTEGER(iwp) :: ft_2d !< MPI filetype 2D array REAL with outer boundaries
	115	INTEGER(iwp) :: ft_3d !< MPI filetype 3D array REAL with outer boundaries
	116	INTEGER(iwp) :: ft_3dsoil !< MPI filetype for 3d-soil array
	117	#endif
	118	INTEGER(iwp) :: glo_start !< global start index on this PE
	119	#if defined( __parallel )
	120	INTEGER(iwp) :: local_start !<
	121	#endif
	122	INTEGER(iwp) :: nr_iope !<
	123	INTEGER(iwp) :: nr_val !< local number of values in x and y direction
	124	#if defined( __parallel )
	125	INTEGER(iwp) :: win_2di
	126	INTEGER(iwp) :: win_2dr
	127	INTEGER(iwp) :: win_3dr
	128	INTEGER(iwp) :: win_3ds
	129	INTEGER(iwp) :: win_surf = -1
	130	#endif
	131	INTEGER(iwp) :: total_number_of_surface_values !< total number of values for one variable
[4495]	132
	133	INTEGER(KIND=rd_offset_kind) :: array_position !<
	134	INTEGER(KIND=rd_offset_kind) :: header_position !<
	135
[4534]	136	INTEGER(iwp), DIMENSION(:,:), POINTER, CONTIGUOUS :: array_2di !<
	137
[4495]	138	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: m_end_index !<
	139	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: m_start_index !<
	140	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: m_global_start !<
	141
[4534]	142	LOGICAL :: all_pes_write !< all PEs have data to write
	143	LOGICAL :: filetypes_created !<
	144	LOGICAL :: io_on_limited_cores_per_node !< switch to shared memory MPI-IO
	145	LOGICAL :: rd_flag !< file is opened for read
	146	LOGICAL :: wr_flag !< file is opened for write
	147
	148	#if defined( __parallel )
	149	REAL(wp), DIMENSION(:), POINTER, CONTIGUOUS :: array_1d !<
	150	#endif
	151	REAL(wp), DIMENSION(:,:), POINTER, CONTIGUOUS :: array_2d !<
	152	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: array_3d !<
	153	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: array_3d_soil !<
	154
[4495]	155	!
	156	!-- Handling of outer boundaries
	157	TYPE(local_boundaries) :: lb !<
	158
	159	!
	160	!-- General Header (first 32 byte in restart file)
	161	TYPE general_header
	162	INTEGER(iwp) :: nr_int !< number of INTEGER entries in header
	163	INTEGER(iwp) :: nr_char !< number of Text strings entries in header
	164	INTEGER(iwp) :: nr_real !< number of REAL entries in header
	165	INTEGER(iwp) :: nr_arrays !< number of arrays in restart files
	166	INTEGER(iwp) :: total_nx !< total number of points in x-direction
	167	INTEGER(iwp) :: total_ny !< total number of points in y-direction
	168	INTEGER(iwp) :: i_outer_bound !< if 1, outer boundaries are stored in restart file
	169	INTEGER(iwp) :: endian !< little endian (1) or big endian (2) internal format
	170	END TYPE general_header
	171
	172	TYPE(general_header), TARGET :: tgh
	173
[4534]	174	TYPE(sm_class) :: sm_io
	175
[4495]	176	!
	177	!-- Declaration of varibales for file header section
	178	INTEGER(KIND=rd_offset_kind) :: header_int_index
	179	INTEGER, PARAMETER :: max_nr_int=256
	180	CHARACTER(LEN=32), DIMENSION(max_nr_int) :: int_names
	181	INTEGER(KIND=iwp), DIMENSION(max_nr_int) :: int_values
	182
	183	INTEGER(KIND=rd_offset_kind) :: header_char_index
[4539]	184	INTEGER, PARAMETER :: max_nr_char=128
	185	CHARACTER(LEN=128), DIMENSION(max_nr_char) :: text_lines
[4495]	186
	187	INTEGER(KIND=rd_offset_kind) :: header_real_index
	188	INTEGER, PARAMETER :: max_nr_real=256
	189	CHARACTER(LEN=32), DIMENSION(max_nr_real) :: real_names
	190	REAL(KIND=wp), DIMENSION(max_nr_real) :: real_values
	191
[4539]	192	INTEGER(KIND=rd_offset_kind) :: header_array_index
[4495]	193	INTEGER, PARAMETER :: max_nr_arrays=600
	194	CHARACTER(LEN=32), DIMENSION(max_nr_arrays) :: array_names
	195	INTEGER(KIND=rd_offset_kind), DIMENSION(max_nr_arrays) :: array_offset
	196
	197	SAVE
	198
	199	PRIVATE
	200
[4536]	201	PUBLIC restart_file_size, total_number_of_surface_values
[4495]	202
	203	!
	204	!-- PALM interfaces
	205	INTERFACE rd_mpi_io_check_array
	206	MODULE PROCEDURE rd_mpi_io_check_array
	207	END INTERFACE rd_mpi_io_check_array
	208
	209	INTERFACE rd_mpi_io_close
	210	MODULE PROCEDURE rd_mpi_io_close
	211	END INTERFACE rd_mpi_io_close
	212
	213	INTERFACE rd_mpi_io_open
	214	MODULE PROCEDURE rd_mpi_io_open
	215	END INTERFACE rd_mpi_io_open
	216
	217	INTERFACE rrd_mpi_io
	218	MODULE PROCEDURE rrd_mpi_io_char
	219	MODULE PROCEDURE rrd_mpi_io_int
	220	MODULE PROCEDURE rrd_mpi_io_int_2d
	221	MODULE PROCEDURE rrd_mpi_io_logical
	222	MODULE PROCEDURE rrd_mpi_io_real
	223	MODULE PROCEDURE rrd_mpi_io_real_2d
	224	MODULE PROCEDURE rrd_mpi_io_real_3d
	225	MODULE PROCEDURE rrd_mpi_io_real_3d_soil
	226	END INTERFACE rrd_mpi_io
	227
	228	INTERFACE rrd_mpi_io_global_array
	229	MODULE PROCEDURE rrd_mpi_io_global_array_int_1d
	230	MODULE PROCEDURE rrd_mpi_io_global_array_real_1d
	231	MODULE PROCEDURE rrd_mpi_io_global_array_real_2d
	232	MODULE PROCEDURE rrd_mpi_io_global_array_real_3d
	233	MODULE PROCEDURE rrd_mpi_io_global_array_real_4d
	234	END INTERFACE rrd_mpi_io_global_array
	235
	236	INTERFACE rrd_mpi_io_surface
	237	MODULE PROCEDURE rrd_mpi_io_surface
	238	MODULE PROCEDURE rrd_mpi_io_surface_2d
	239	END INTERFACE rrd_mpi_io_surface
	240
	241	INTERFACE rd_mpi_io_surface_filetypes
	242	MODULE PROCEDURE rd_mpi_io_surface_filetypes
	243	END INTERFACE rd_mpi_io_surface_filetypes
	244
	245	INTERFACE wrd_mpi_io
	246	MODULE PROCEDURE wrd_mpi_io_char
	247	MODULE PROCEDURE wrd_mpi_io_int
	248	MODULE PROCEDURE wrd_mpi_io_int_2d
	249	MODULE PROCEDURE wrd_mpi_io_logical
	250	MODULE PROCEDURE wrd_mpi_io_real
	251	MODULE PROCEDURE wrd_mpi_io_real_2d
	252	MODULE PROCEDURE wrd_mpi_io_real_3d
	253	MODULE PROCEDURE wrd_mpi_io_real_3d_soil
	254	END INTERFACE wrd_mpi_io
	255
	256	INTERFACE wrd_mpi_io_global_array
	257	MODULE PROCEDURE wrd_mpi_io_global_array_int_1d
	258	MODULE PROCEDURE wrd_mpi_io_global_array_real_1d
	259	MODULE PROCEDURE wrd_mpi_io_global_array_real_2d
	260	MODULE PROCEDURE wrd_mpi_io_global_array_real_3d
	261	MODULE PROCEDURE wrd_mpi_io_global_array_real_4d
	262	END INTERFACE wrd_mpi_io_global_array
	263
	264	INTERFACE wrd_mpi_io_surface
	265	MODULE PROCEDURE wrd_mpi_io_surface
	266	MODULE PROCEDURE wrd_mpi_io_surface_2d
	267	END INTERFACE wrd_mpi_io_surface
	268
	269	PUBLIC rd_mpi_io_check_array, rd_mpi_io_close, rd_mpi_io_open, rrd_mpi_io, &
	270	rrd_mpi_io_global_array, rrd_mpi_io_surface, rd_mpi_io_surface_filetypes, wrd_mpi_io, &
	271	wrd_mpi_io_global_array, wrd_mpi_io_surface
	272
	273
	274	CONTAINS
	275
	276
	277	!--------------------------------------------------------------------------------------------------!
	278	! Description:
	279	! ------------
	280	!> Open restart file for read or write with MPI-IO
	281	!--------------------------------------------------------------------------------------------------!
[4534]	282	SUBROUTINE rd_mpi_io_open( action, file_name, open_for_global_io_only )
[4495]	283
	284	IMPLICIT NONE
	285
	286	CHARACTER(LEN=*), INTENT(IN) :: action !<
	287	CHARACTER(LEN=*), INTENT(IN) :: file_name !<
	288
	289	INTEGER(iwp) :: i !<
	290	INTEGER(iwp) :: gh_size !<
	291
	292	INTEGER(KIND=rd_offset_kind) :: offset !<
	293
	294	#if defined( __parallel )
	295	INTEGER, DIMENSION(rd_status_size) :: status !<
	296	#endif
	297
[4534]	298	LOGICAL, INTENT(IN), OPTIONAL :: open_for_global_io_only !<
	299	LOGICAL :: set_filetype !<
	300
[4495]	301	#if ! defined( __parallel )
	302	TYPE(C_PTR) :: buf_ptr !<
	303	#endif
	304
	305
	306	offset = 0
[4536]	307	io_on_limited_cores_per_node = .FALSE.
[4495]	308
	309	rd_flag = ( TRIM( action ) == 'READ' .OR. TRIM( action ) == 'read' )
	310	wr_flag = ( TRIM( action ) == 'WRITE' .OR. TRIM( action ) == 'write' )
	311
[4536]	312	IF ( .NOT. ( rd_flag .OR. wr_flag ) ) THEN
	313	message_string = 'illegal action "' // TRIM( action ) // '" for opening restart files'
	314	CALL message( 'restart_data_mpi_io_mod', 'PA0720', 1, 2, 0, 6, 0 )
	315	ENDIF
[4495]	316	!
[4534]	317	!-- Store name of I/O file to communicate it internally within this module.
	318	io_file_name = file_name
	319	!
	320	!-- Setup for IO on a limited number of threads per node (using shared memory MPI)
[4536]	321	IF ( rd_flag ) THEN
	322	set_filetype = .TRUE.
	323	IF ( TRIM( restart_data_format_input ) == 'mpi_shared_memory' ) THEN
	324	io_on_limited_cores_per_node = .TRUE.
	325	ENDIF
	326	ENDIF
	327
	328	IF ( TRIM( restart_data_format_output ) == 'mpi_shared_memory' .AND. wr_flag ) THEN
[4534]	329	io_on_limited_cores_per_node = .TRUE.
	330	ENDIF
	331	!
	332	!-- Shared memory MPI is not used for reading of global data
	333	IF ( PRESENT( open_for_global_io_only ) .AND. rd_flag ) THEN
	334	IF ( open_for_global_io_only ) THEN
	335	io_on_limited_cores_per_node = .FALSE.
	336	set_filetype = .FALSE.
	337	ENDIF
	338	ENDIF
	339
	340	CALL sm_io%sm_init_comm( io_on_limited_cores_per_node )
	341
	342	!
	343	!-- Set communicator to be used. If all cores are doing I/O, comm2d is used as usual.
	344	IF( sm_io%is_sm_active() ) THEN
	345	comm_io = sm_io%comm_io
	346	ELSE
	347	comm_io = comm2d
	348	ENDIF
	349
	350	!
[4495]	351	!-- Create subarrays and file types
	352	filetypes_created = .FALSE.
	353
	354	!
	355	!-- In case of read it is not known yet if data include total domain. Filetypes will be created
	356	!-- further below.
[4536]	357	IF ( wr_flag ) THEN
[4534]	358	CALL rd_mpi_io_create_filetypes
[4495]	359	filetypes_created = .TRUE.
	360	ENDIF
	361
	362	!
	363	!-- Open file for MPI-IO
	364	#if defined( __parallel )
[4534]	365	IF ( sm_io%iam_io_pe ) THEN
[4536]	366
[4534]	367	IF ( rd_flag ) THEN
[4536]	368
	369	IF ( debug_output ) THEN
	370	WRITE( debug_string, * ) 'open joint restart file "' // TRIM( io_file_name ) // &
	371	'" for read with MPI-IO'
	372	CALL debug_message( debug_string, 'start' )
	373	ENDIF
	374
[4534]	375	CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fh, &
	376	ierr )
[4536]	377
	378	IF ( ierr /= 0 ) THEN
	379	message_string = 'error opening restart file "' // TRIM( io_file_name ) // &
	380	'" for reading with MPI-IO'
	381	CALL message( 'rrd_mpi_io_open', 'PA0727', 3, 2, 0, 6, 0 )
	382	ENDIF
	383
	384	IF ( debug_output ) THEN
	385	WRITE( debug_string, * ) 'open joint restart file "' // TRIM( io_file_name ) // &
	386	'" for read with MPI-IO'
	387	CALL debug_message( debug_string, 'end' )
	388	ENDIF
	389
[4534]	390	ELSEIF ( wr_flag ) THEN
[4536]	391
	392	IF ( debug_output ) THEN
	393	WRITE( debug_string, * ) 'open joint restart file "' // TRIM( io_file_name ) // &
	394	'" for write with MPI-IO'
	395	CALL debug_message( debug_string, 'start' )
	396	ENDIF
	397
[4534]	398	CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_CREATE+MPI_MODE_WRONLY, &
	399	MPI_INFO_NULL, fh, ierr )
[4536]	400
	401	IF ( ierr /= 0 ) THEN
	402	message_string = 'error opening restart file "' // TRIM( io_file_name ) // &
	403	'" for writing with MPI-IO'
	404	CALL message( 'rrd_mpi_io_open', 'PA0728', 3, 2, 0, 6, 0 )
	405	ENDIF
	406
	407	IF ( debug_output ) THEN
	408	WRITE( debug_string, * ) 'open joint restart file "' // TRIM( io_file_name ) // &
	409	'" for write with MPI-IO'
	410	CALL debug_message( debug_string, 'end' )
	411	ENDIF
	412
[4534]	413	ENDIF
[4536]	414
[4495]	415	ENDIF
	416	#else
	417	IF ( rd_flag ) THEN
[4536]	418
	419	IF ( debug_output ) THEN
	420	WRITE( debug_string, * ) 'open restart file "' // TRIM( io_file_name ) // &
	421	'" for read in serial mode (posix)'
	422	CALL debug_message( debug_string, 'start' )
	423	ENDIF
	424
[4534]	425	fh = posix_open( TRIM( io_file_name ), .TRUE. )
[4536]	426
	427	IF ( debug_output ) THEN
	428	WRITE( debug_string, * ) 'open restart file "' // TRIM( io_file_name ) // &
	429	'" for read in serial mode (posix)'
	430	CALL debug_message( debug_string, 'end' )
	431	ENDIF
	432
[4495]	433	ELSEIF ( wr_flag ) THEN
[4536]	434
	435	IF ( debug_output ) THEN
	436	WRITE( debug_string, * ) 'open restart file "' // TRIM( io_file_name ) // &
	437	'" for write in serial mode (posix)'
	438	CALL debug_message( debug_string, 'start' )
	439	ENDIF
	440
[4534]	441	fh = posix_open( TRIM( io_file_name ), .FALSE. )
[4536]	442
	443	IF ( debug_output ) THEN
	444	WRITE( debug_string, * ) 'open restart file "' // TRIM( io_file_name ) // &
	445	'" for write in serial mode (posix)'
	446	CALL debug_message( debug_string, 'end' )
	447	ENDIF
	448
[4495]	449	ENDIF
	450
[4536]	451	IF ( fh < 0 ) THEN
	452	message_string = 'error opening restart file for posix I/O'
	453	CALL message( 'restart_data_mpi_io_mod', 'PA0721', 1, 2, 0, 6, 0 )
	454	ENDIF
[4495]	455	#endif
	456
	457	array_position = 65536 !> Start offset for writing 2-D and 3.D arrays at 64 k
	458	header_position = 0
	459
	460	header_int_index = 1
	461	header_char_index = 1
[4539]	462	header_real_index = 1
	463	header_array_index = 1
[4495]	464
	465	int_names = ' '
	466	int_values = 0
	467	text_lines = ' '
	468	real_names = ' '
	469	real_values = 0.0
	470	array_names = ' '
	471	array_offset = 0
	472
	473	int_names(1) = 'nx'
	474	int_values(1) = nx
	475	int_names(2) = 'ny'
	476	int_values(2) = ny
	477	int_names(3) = 'nz'
	478	int_values(3) = nz
	479	header_int_index = header_int_index+3
	480
	481	DO i = 1, max_nr_arrays
	482	array_offset(i) = 0
	483	array_names(i) = ' '
	484	ENDDO
	485
	486	gh_size = STORAGE_SIZE( tgh ) / 8
	487
	488	IF ( rd_flag ) THEN
[4534]	489	IF ( sm_io%iam_io_pe ) THEN
[4495]	490	!
[4534]	491	!-- File is open for read.
[4495]	492	#if defined( __parallel )
[4534]	493	!-- Set the default view
	494	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
[4495]	495	!
[4534]	496	!-- Read the file header size
	497	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	498	CALL MPI_FILE_READ( fh, tgh, gh_size, MPI_BYTE, status, ierr )
[4495]	499	#else
[4534]	500	CALL posix_lseek( fh, header_position )
	501	buf_ptr = C_LOC( tgh )
	502	CALL posix_read( fh, buf_ptr, gh_size )
[4495]	503	#endif
[4534]	504	ENDIF
	505	#if defined( __parallel )
	506	IF ( sm_io%is_sm_active() ) THEN
	507	CALL MPI_BCAST( tgh, gh_size, MPI_BYTE, 0, sm_io%comm_shared, ierr )
	508	ENDIF
	509	#endif
[4495]	510	header_position = header_position + gh_size
	511
	512	include_total_domain_boundaries = ( tgh%i_outer_bound == 1 )
	513
	514	!
[4498]	515	!-- File types depend on if boundaries of the total domain is included in data. This has been
	516	!-- checked with the previous statement.
[4534]	517	IF ( set_filetype ) THEN
	518	CALL rd_mpi_io_create_filetypes
	519	filetypes_created = .TRUE.
	520	ENDIF
[4495]	521
[4534]	522	IF ( sm_io%iam_io_pe ) THEN
[4495]	523	#if defined( __parallel )
	524	!
[4534]	525	!-- Read INTEGER values
	526	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	527	CALL MPI_FILE_READ( fh, int_names, SIZE( int_names ) * 32, MPI_CHAR, status, ierr )
	528	header_position = header_position + SIZE( int_names ) * 32
[4495]	529
[4534]	530	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	531	CALL MPI_FILE_READ (fh, int_values, SIZE( int_values ), MPI_INT, status, ierr )
	532	header_position = header_position + SIZE( int_values ) * iwp
[4495]	533	!
[4534]	534	!-- Character entries
	535	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	536	CALL MPI_FILE_READ( fh, text_lines, SIZE( text_lines ) * 128, MPI_CHAR, status, ierr )
	537	header_position = header_position+size(text_lines) * 128
[4495]	538	!
[4534]	539	!-- REAL values
	540	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	541	CALL MPI_FILE_READ( fh, real_names, SIZE( real_names ) * 32, MPI_CHAR, status, ierr )
	542	header_position = header_position + SIZE( real_names ) * 32
[4495]	543
[4534]	544	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	545	CALL MPI_FILE_READ( fh, real_values, SIZE( real_values ), MPI_REAL, status, ierr )
	546	header_position = header_position + SIZE( real_values ) * wp
[4495]	547	!
[4534]	548	!-- 2d- and 3d-array headers
	549	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	550	CALL MPI_FILE_READ( fh, array_names, SIZE( array_names ) * 32, MPI_CHAR, status, ierr )
	551	header_position = header_position + SIZE( array_names ) * 32
[4495]	552
[4534]	553	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	554	CALL MPI_FILE_READ( fh, array_offset, SIZE( array_offset ) * MPI_OFFSET_KIND, MPI_BYTE, &
	555	status,ierr ) ! there is no I*8 datatype in Fortran
	556	header_position = header_position + SIZE( array_offset ) * rd_offset_kind
[4495]	557	#else
[4534]	558	CALL posix_lseek( fh, header_position )
	559	CALL posix_read( fh, int_names )
	560	header_position = header_position + SIZE( int_names ) * 32
[4495]	561
[4534]	562	CALL posix_lseek( fh, header_position )
	563	CALL posix_read( fh, int_values, SIZE( int_values ) )
	564	header_position = header_position + SIZE( int_values ) * iwp
[4495]	565	!
[4534]	566	!-- Character entries
	567	CALL posix_lseek( fh, header_position )
	568	CALL posix_read( fh, text_lines )
	569	header_position = header_position + SIZE( text_lines ) * 128
[4495]	570	!
[4534]	571	!-- REAL values
	572	CALL posix_lseek( fh, header_position )
	573	CALL posix_read( fh, real_names )
	574	header_position = header_position + SIZE( real_names ) * 32
[4495]	575
[4534]	576	CALL posix_lseek( fh, header_position )
	577	CALL posix_read( fh, real_values, SIZE( real_values ) )
	578	header_position = header_position + SIZE( real_values ) * wp
[4495]	579	!
[4534]	580	!-- 2d- and 3d-array headers
	581	CALL posix_lseek( fh, header_position )
	582	CALL posix_read( fh, array_names )
	583	header_position = header_position + SIZE( array_names ) * 32
[4495]	584
[4534]	585	CALL posix_lseek( fh, header_position )
	586	CALL posix_read( fh, array_offset, SIZE( array_offset ) ) ! there is no I*8 datatype in Fortran
	587	header_position = header_position + SIZE( array_offset ) * rd_offset_kind
[4495]	588	#endif
[4536]	589	IF ( debug_output ) CALL rd_mpi_io_print_header
[4534]	590
[4495]	591	ENDIF
	592
[4534]	593	#if defined( __parallel )
	594	!
	595	!-- Broadcast header to all remaining cores that are not involved in I/O
	596	IF ( sm_io%is_sm_active() ) THEN
	597	!
	598	!-- Not sure, that it is possible to broadcast CHARACTER array in one MPI_Bcast call
	599	DO i = 1, SIZE( int_names )
	600	CALL MPI_BCAST( int_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
	601	ENDDO
	602	CALL MPI_BCAST( int_values, SIZE( int_values ), MPI_INTEGER, 0, sm_io%comm_shared, ierr )
[4495]	603
[4534]	604	DO i = 1, SIZE( text_lines )
	605	CALL MPI_BCAST( text_lines(i), 128, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
	606	ENDDO
	607
	608	DO i = 1, SIZE( real_names )
	609	CALL MPI_BCAST( real_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
	610	ENDDO
	611	CALL MPI_BCAST( real_values, SIZE( real_values ), MPI_REAL, 0, sm_io%comm_shared, ierr )
	612
	613	DO i = 1, SIZE( array_names )
	614	CALL MPI_BCAST( array_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
	615	ENDDO
	616	CALL MPI_BCAST( array_offset, SIZE( array_offset )*8, MPI_BYTE, 0, sm_io%comm_shared, &
	617	ierr ) ! there is no I8 datatype in Fortran (array_offset is I8!)
	618
	619	CALL MPI_BCAST( header_position, rd_offset_kind, MPI_BYTE, 0, sm_io%comm_shared, ierr )
	620
	621	ENDIF
	622	#endif
	623
[4495]	624	ENDIF
	625
	626	END SUBROUTINE rd_mpi_io_open
	627
	628
	629	!--------------------------------------------------------------------------------------------------!
	630	! Description:
	631	! ------------
	632	!> Check, if array exists in restart file
	633	!--------------------------------------------------------------------------------------------------!
	634	SUBROUTINE rd_mpi_io_check_array( name, found )
	635
	636	IMPLICIT NONE
	637
	638	CHARACTER(LEN=*), INTENT(IN) :: name !<
	639
	640	INTEGER(iwp) :: i !<
	641
	642	LOGICAl :: found !<
	643
	644
	645	DO i = 1, tgh%nr_arrays
	646	IF ( TRIM( array_names(i) ) == TRIM( name ) ) THEN
	647	array_position = array_offset(i)
	648	found = .TRUE.
	649	RETURN
	650	ENDIF
	651	ENDDO
	652
	653	found = .FALSE.
	654
	655	END SUBROUTINE rd_mpi_io_check_array
	656
	657
	658
	659	!--------------------------------------------------------------------------------------------------!
	660	! Description:
	661	! ------------
	662	!> Read INTEGER with MPI-IO
	663	!--------------------------------------------------------------------------------------------------!
[4536]	664	SUBROUTINE rrd_mpi_io_int( name, value )
[4495]	665
	666	IMPLICIT NONE
	667
	668	CHARACTER(LEN=*), INTENT(IN) :: name
	669
	670	INTEGER(iwp) :: i
	671	INTEGER(KIND=iwp), INTENT(OUT) :: value
	672
[4536]	673	LOGICAL :: found
[4495]	674
	675
[4536]	676	found = .FALSE.
[4495]	677	value = 0
	678
	679	DO i = 1, tgh%nr_int
	680	IF ( TRIM(int_names(i)) == TRIM( name ) ) THEN
	681	value = int_values(i)
[4536]	682	found = .TRUE.
[4495]	683	EXIT
	684	ENDIF
	685	ENDDO
	686
[4536]	687	IF ( .NOT. found ) THEN
	688	message_string = 'INTEGER variable "' // TRIM( name ) // '" not found in restart file'
	689	CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
[4495]	690	ENDIF
	691
	692	END SUBROUTINE rrd_mpi_io_int
	693
	694
	695
	696	!--------------------------------------------------------------------------------------------------!
	697	! Description:
	698	! ------------
	699	!> Read REAL with MPI-IO
	700	!--------------------------------------------------------------------------------------------------!
[4536]	701	SUBROUTINE rrd_mpi_io_real( name, value )
[4495]	702
	703	IMPLICIT NONE
	704
	705	CHARACTER(LEN=*), INTENT(IN) :: name
	706
	707	INTEGER(iwp) :: i
	708
[4536]	709	LOGICAL :: found
[4495]	710
	711	REAL(KIND=wp), INTENT(OUT) :: value
	712
	713
[4536]	714	found = .FALSE.
[4495]	715	value = 0.0
	716
	717	DO i = 1, tgh%nr_real
	718	IF ( TRIM(real_names(i)) == TRIM( name ) ) THEN
	719	value = real_values(i)
[4536]	720	found = .TRUE.
[4495]	721	EXIT
	722	ENDIF
	723	ENDDO
	724
[4536]	725	IF ( .NOT. found ) THEN
	726	message_string = 'REAL variable "' // TRIM( name ) // '" not found in restart file'
	727	CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
[4495]	728	ENDIF
	729
	730	END SUBROUTINE rrd_mpi_io_real
	731
	732
	733
	734	!--------------------------------------------------------------------------------------------------!
	735	! Description:
	736	! ------------
	737	!> Read 2d-real array with MPI-IO
	738	!--------------------------------------------------------------------------------------------------!
	739	SUBROUTINE rrd_mpi_io_real_2d( name, data )
	740
	741	IMPLICIT NONE
	742
	743	CHARACTER(LEN=*), INTENT(IN) :: name
	744
	745	#if defined( __parallel )
	746	INTEGER, DIMENSION(rd_status_size) :: status
	747	#endif
	748	INTEGER(iwp) :: i
	749
	750	LOGICAL :: found
	751
	752	REAL(wp), INTENT(INOUT), DIMENSION(nysg:nyng,nxlg:nxrg) :: data
	753
	754
	755	found = .FALSE.
	756
	757	DO i = 1, tgh%nr_arrays
	758	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	759	array_position = array_offset(i)
	760	found = .TRUE.
	761	EXIT
	762	ENDIF
	763	ENDDO
	764
[4534]	765	IF ( found ) THEN
[4495]	766	#if defined( __parallel )
[4534]	767	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	768	IF ( sm_io%iam_io_pe ) THEN
	769	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, &
	770	ierr )
	771	CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d ), MPI_REAL, status, ierr )
	772	ENDIF
	773	CALL sm_io%sm_node_barrier()
[4495]	774	#else
[4534]	775	CALL posix_lseek( fh, array_position )
	776	CALL posix_read( fh, array_2d, SIZE( array_2d ) )
[4495]	777	#endif
	778
[4534]	779	IF ( include_total_domain_boundaries) THEN
	780	DO i = lb%nxl, lb%nxr
	781	data(lb%nys-nbgp:lb%nyn-nbgp,i-nbgp) = array_2d(i,lb%nys:lb%nyn)
	782	ENDDO
	783	IF ( debug_level >= 2) WRITE(9,*) 'r2f_ob ', TRIM(name),' ', SUM( data(nys:nyn,nxl:nxr) )
	784	ELSE
	785	DO i = nxl, nxr
	786	data(nys:nyn,i) = array_2d(i,nys:nyn)
	787	ENDDO
	788	IF ( debug_level >= 2) WRITE(9,*) 'r2f ', TRIM( name ),' ', SUM( data(nys:nyn,nxl:nxr) )
	789	ENDIF
[4495]	790
[4534]	791	CALL exchange_horiz_2d( data )
[4495]	792
[4534]	793	ELSE
[4536]	794	message_string = '2d-REAL array "' // TRIM( name ) // '" not found in restart file'
	795	CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
[4534]	796	ENDIF
[4495]	797
	798	END SUBROUTINE rrd_mpi_io_real_2d
	799
	800
	801
	802	!--------------------------------------------------------------------------------------------------!
	803	! Description:
	804	! ------------
	805	!> Read 2d-INTEGER array with MPI-IO
	806	!--------------------------------------------------------------------------------------------------!
	807	SUBROUTINE rrd_mpi_io_int_2d( name, data )
	808
	809	IMPLICIT NONE
	810
	811	CHARACTER(LEN=*), INTENT(IN) :: name
	812
	813	INTEGER(iwp) :: i
	814	INTEGER(iwp) :: j
	815
	816	#if defined( __parallel )
	817	INTEGER, DIMENSION(rd_status_size) :: status
	818	#endif
	819
	820	INTEGER(KIND=iwp), INTENT(INOUT), DIMENSION(:,:) :: data
	821
	822	LOGICAL :: found
	823
	824
	825	found = .FALSE.
	826
	827	DO i = 1, tgh%nr_arrays
	828	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	829	array_position = array_offset(i)
	830	found = .TRUE.
	831	EXIT
	832	ENDIF
	833	ENDDO
	834
	835	IF ( found ) THEN
	836
	837	IF ( ( nxr - nxl + 1 + 2*nbgp ) == SIZE( data, 2 ) ) THEN
	838	!
	839	!-- Output array with Halos.
	840	!-- ATTENTION: INTEGER array with ghost boundaries are not implemented yet. This kind of array
	841	!-- would be dimensioned in the caller subroutine like this:
	842	!-- INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg):: data
[4536]	843	message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be read from restart ' // &
	844	'file is defined with illegal dimensions in the PALM code'
	845	CALL message( 'rrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
[4495]	846
	847	ELSEIF ( (nxr-nxl+1) == SIZE( data, 2 ) ) THEN
	848	!
	849	!-- INTEGER input array without Halos.
	850	!-- This kind of array is dimensioned in the caller subroutine
	851	!-- INTEGER, DIMENSION(nys:nyn,nxl:nxr) :: data
	852
	853	#if defined( __parallel )
[4534]	854	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	855	IF ( sm_io%iam_io_pe ) THEN
	856	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native', &
	857	MPI_INFO_NULL, ierr )
[4539]	858	CALL MPI_FILE_READ_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status, ierr )
[4534]	859	ENDIF
	860	CALL sm_io%sm_node_barrier()
[4495]	861	#else
	862	CALL posix_lseek( fh, array_position )
[4534]	863	CALL posix_read( fh, array_2di, SIZE( array_2di ) )
[4495]	864	#endif
	865
	866	DO j = nys, nyn
	867	DO i = nxl, nxr
[4534]	868	data(j-nys+1,i-nxl+1) = array_2di(i,j)
[4495]	869	ENDDO
	870	ENDDO
	871
[4536]	872	ELSE
[4495]	873
[4536]	874	message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be read from restart ' // &
	875	'file is defined with illegal dimensions in the PALM code'
	876	CALL message( 'rrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
	877
[4495]	878	ENDIF
	879
	880	ELSE
	881
[4536]	882	message_string = '2d-INTEGER array "' // TRIM( name ) // '" not found in restart file'
	883	CALL message( 'rrd_mpi_io_int_2d', 'PA0722', 3, 2, 0, 6, 0 )
[4495]	884
	885	ENDIF
	886
	887	END SUBROUTINE rrd_mpi_io_int_2d
	888
	889
	890
	891	!--------------------------------------------------------------------------------------------------!
	892	! Description:
	893	! ------------
	894	!> Read 2d-REAL array with MPI-IO
	895	!--------------------------------------------------------------------------------------------------!
	896	SUBROUTINE rrd_mpi_io_real_3d( name, data )
	897
	898	IMPLICIT NONE
	899
	900	CHARACTER(LEN=*), INTENT(IN) :: name
	901
	902	INTEGER(iwp) :: i
	903
	904	#if defined( __parallel )
	905	INTEGER, DIMENSION(rd_status_size) :: status
	906	#endif
	907
	908	LOGICAL :: found
	909
	910	REAL(wp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data
	911
	912
	913	found = .FALSE.
	914
	915	DO i = 1, tgh%nr_arrays
	916	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	917	array_position = array_offset(i)
	918	found = .TRUE.
	919	EXIT
	920	ENDIF
	921	ENDDO
	922
	923	IF ( found ) THEN
	924	#if defined( __parallel )
[4534]	925	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	926	IF( sm_io%iam_io_pe ) THEN
	927	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, &
	928	ierr )
	929	CALL MPI_FILE_READ_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
	930	ENDIF
	931	CALL sm_io%sm_node_barrier()
[4495]	932	#else
	933	CALL posix_lseek( fh, array_position )
	934	CALL posix_read(fh, array_3d, SIZE( array_3d ) )
	935	#endif
	936	IF ( include_total_domain_boundaries) THEN
	937	DO i = lb%nxl, lb%nxr
	938	data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp) = array_3d(:,i,lb%nys:lb%nyn)
	939	ENDDO
	940	ELSE
	941	DO i = nxl, nxr
	942	data(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
	943	ENDDO
	944	ENDIF
	945
	946	CALL exchange_horiz( data, nbgp )
	947
	948	ELSE
[4536]	949
	950	message_string = '3d-REAL array "' // TRIM( name ) // '" not found in restart file'
	951	CALL message( 'rrd_mpi_io_real_3d', 'PA0722', 3, 2, 0, 6, 0 )
	952
[4495]	953	ENDIF
	954
	955	END SUBROUTINE rrd_mpi_io_real_3d
	956
	957
	958
	959	!--------------------------------------------------------------------------------------------------!
	960	! Description:
	961	! ------------
	962	!> Read 3d-REAL soil array with MPI-IO
	963	!> nzb_soil, nzt_soil are located in the module land_surface_model_mod. Since Fortran does not allow
	964	!> cross referencing of module variables, it is required to pass these variables as arguments.
	965	!--------------------------------------------------------------------------------------------------!
	966	SUBROUTINE rrd_mpi_io_real_3d_soil( name, data, nzb_soil, nzt_soil )
	967
	968	IMPLICIT NONE
	969
	970	CHARACTER(LEN=*), INTENT(IN) :: name
	971
	972	INTEGER(iwp) :: i
	973	INTEGER, INTENT(IN) :: nzb_soil
	974	INTEGER, INTENT(IN) :: nzt_soil
	975
	976	#if defined( __parallel )
	977	INTEGER, DIMENSION(rd_status_size) :: status
	978	#endif
	979
	980	LOGICAL :: found
	981
	982	REAL(wp), INTENT(INOUT), DIMENSION(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) :: data
	983
	984
	985	found = .FALSE.
	986
	987	DO i = 1, tgh%nr_arrays
	988	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	989	array_position = array_offset(i)
	990	found = .TRUE.
	991	EXIT
	992	ENDIF
	993	ENDDO
	994
	995	IF ( found ) THEN
	996	#if defined( __parallel )
	997	CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
[4534]	998	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	999	IF ( sm_io%iam_io_pe ) THEN
	1000	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', MPI_INFO_NULL,&
	1001	ierr )
	1002	CALL MPI_FILE_READ_ALL( fh, array_3d_soil, SIZE( array_3d_soil ), MPI_REAL, status, ierr )
	1003	CALL MPI_TYPE_FREE( ft_3dsoil, ierr )
	1004	ENDIF
	1005	CALL sm_io%sm_node_barrier()
[4495]	1006	#else
	1007	CALL posix_lseek( fh, array_position )
[4534]	1008	CALL posix_read( fh, array_3d_soil, SIZE( array_3d_soil ) )
[4495]	1009	#endif
	1010	IF ( include_total_domain_boundaries ) THEN
	1011	DO i = lb%nxl, lb%nxr
	1012	data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp) = array_3d(:,i,lb%nys:lb%nyn)
	1013	ENDDO
	1014	ELSE
	1015	DO i = nxl, nxr
	1016	data(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
	1017	ENDDO
	1018	ENDIF
	1019
	1020	ELSE
[4536]	1021
	1022	message_string = '3d-REAL soil array "' // TRIM( name ) // '" not found in restart file'
	1023	CALL message( 'rrd_mpi_io_real_3d_soil', 'PA0722', 3, 2, 0, 6, 0 )
	1024
[4495]	1025	ENDIF
	1026
	1027	END SUBROUTINE rrd_mpi_io_real_3d_soil
	1028
	1029
	1030
	1031	!--------------------------------------------------------------------------------------------------!
	1032	! Description:
	1033	! ------------
	1034	!> Read CHARACTER with MPI-IO
	1035	!--------------------------------------------------------------------------------------------------!
[4536]	1036	SUBROUTINE rrd_mpi_io_char( name, text )
[4495]	1037
	1038	IMPLICIT NONE
	1039
	1040	CHARACTER(LEN=*), INTENT(IN) :: name
	1041	CHARACTER(LEN=*), INTENT(OUT) :: text
[4536]	1042	CHARACTER(LEN=128) :: line
[4495]	1043
	1044	INTEGER(iwp) :: i
	1045
[4536]	1046	LOGICAL :: found
[4495]	1047
	1048
[4536]	1049	found = .FALSE.
[4495]	1050	text = ' '
	1051
	1052	DO i = 1, tgh%nr_char
[4536]	1053	line = text_lines(i)
	1054	IF ( TRIM( line(1:32) ) == TRIM( name ) ) THEN
	1055	text = line(33:)
	1056	found = .TRUE.
[4495]	1057	EXIT
	1058	ENDIF
	1059	ENDDO
	1060
[4536]	1061	IF ( .NOT. found ) THEN
	1062	message_string = 'CHARACTER variable "' // TRIM( name ) // '" not found in restart file'
	1063	CALL message( 'rrd_mpi_io_char', 'PA0722', 3, 2, 0, 6, 0 )
[4495]	1064	ENDIF
	1065
	1066	END SUBROUTINE rrd_mpi_io_char
	1067
	1068
	1069
	1070	!--------------------------------------------------------------------------------------------------!
	1071	! Description:
	1072	! ------------
	1073	!> Read LOGICAL with MPI-IO
	1074	!--------------------------------------------------------------------------------------------------!
	1075	SUBROUTINE rrd_mpi_io_logical( name, value )
	1076
	1077	IMPLICIT NONE
	1078
	1079	CHARACTER(LEN=*), INTENT(IN) :: name
	1080
	1081	INTEGER(iwp) :: logical_as_integer
	1082
	1083	LOGICAL, INTENT(OUT) :: value
	1084
	1085
	1086	CALL rrd_mpi_io_int( name, logical_as_integer )
	1087	value = ( logical_as_integer == 1 )
	1088
	1089	END SUBROUTINE rrd_mpi_io_logical
	1090
	1091
	1092
	1093	!--------------------------------------------------------------------------------------------------!
	1094	! Description:
	1095	! ------------
	1096	!> Write INTEGER with MPI-IO
	1097	!--------------------------------------------------------------------------------------------------!
	1098	SUBROUTINE wrd_mpi_io_int( name, value )
	1099
	1100	IMPLICIT NONE
	1101
	1102	CHARACTER(LEN=*), INTENT(IN) :: name
	1103
	1104	INTEGER(KIND=iwp), INTENT(IN) :: value
	1105
	1106
[4539]	1107	IF ( header_int_index == max_nr_int ) THEN
	1108	STOP '+++ maximum number of INTEGER entries in restart file header exceeded'
	1109	ENDIF
	1110
[4495]	1111	int_names(header_int_index) = name
	1112	int_values(header_int_index) = value
	1113	header_int_index = header_int_index + 1
	1114
	1115	END SUBROUTINE wrd_mpi_io_int
	1116
	1117
	1118
	1119	SUBROUTINE wrd_mpi_io_real( name, value )
	1120
	1121	IMPLICIT NONE
	1122
	1123	CHARACTER(LEN=*), INTENT(IN) :: name
	1124
	1125	REAL(wp), INTENT(IN) :: value
	1126
	1127
[4539]	1128	IF ( header_real_index == max_nr_real ) THEN
	1129	STOP '+++ maximum number of REAL entries in restart file header exceeded'
	1130	ENDIF
	1131
[4495]	1132	real_names(header_real_index) = name
	1133	real_values(header_real_index) = value
	1134	header_real_index = header_real_index + 1
	1135
	1136	END SUBROUTINE wrd_mpi_io_real
	1137
	1138
	1139
	1140	!--------------------------------------------------------------------------------------------------!
	1141	! Description:
	1142	! ------------
	1143	!> Write 2d-REAL array with MPI-IO
	1144	!--------------------------------------------------------------------------------------------------!
	1145	SUBROUTINE wrd_mpi_io_real_2d( name, data )
	1146
	1147	IMPLICIT NONE
	1148
	1149	CHARACTER(LEN=*), INTENT(IN) :: name
	1150
	1151	INTEGER(iwp) :: i
	1152
	1153	#if defined( __parallel )
	1154	INTEGER, DIMENSION(rd_status_size) :: status
	1155	#endif
	1156
	1157	REAL(wp), INTENT(IN), DIMENSION(nysg:nyng,nxlg:nxrg) :: data
	1158
	1159
[4539]	1160	IF ( header_array_index == max_nr_arrays ) THEN
	1161	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	1162	ENDIF
[4495]	1163
[4539]	1164	array_names(header_array_index) = name
	1165	array_offset(header_array_index) = array_position
	1166	header_array_index = header_array_index + 1
	1167
[4495]	1168	IF ( include_total_domain_boundaries ) THEN
	1169	!
	1170	!-- Prepare Output with outer boundaries
	1171	DO i = lb%nxl, lb%nxr
	1172	array_2d(i,lb%nys:lb%nyn) = data(lb%nys-nbgp:lb%nyn-nbgp,i-nbgp)
	1173	ENDDO
[4536]	1174
[4495]	1175	ELSE
	1176	!
	1177	!-- Prepare Output without outer boundaries
	1178	DO i = nxl,nxr
	1179	array_2d(i,lb%nys:lb%nyn) = data(nys:nyn,i)
	1180	ENDDO
[4536]	1181
[4495]	1182	ENDIF
	1183
	1184	#if defined( __parallel )
[4534]	1185	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	1186	IF ( sm_io%iam_io_pe ) THEN
	1187	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, ierr )
	1188	CALL MPI_FILE_WRITE_ALL( fh, array_2d, SIZE( array_2d), MPI_REAL, status, ierr )
	1189	ENDIF
	1190	CALL sm_io%sm_node_barrier()
[4495]	1191	#else
	1192	CALL posix_lseek( fh, array_position )
	1193	CALL posix_write( fh, array_2d, SIZE( array_2d ) )
	1194	#endif
	1195	!
	1196	!-- Type conversion required, otherwise rigth hand side brackets are calculated assuming 4 byte INT.
	1197	!-- Maybe a compiler problem.
	1198	array_position = array_position + ( INT( lb%ny, KIND=rd_offset_kind ) + 1 ) * &
	1199	( INT( lb%nx, KIND=rd_offset_kind ) + 1 ) * wp
	1200
	1201	END SUBROUTINE wrd_mpi_io_real_2d
	1202
	1203
	1204
	1205	!--------------------------------------------------------------------------------------------------!
	1206	! Description:
	1207	! ------------
	1208	!> Write 2d-INTEGER array with MPI-IO
	1209	!--------------------------------------------------------------------------------------------------!
[4536]	1210	SUBROUTINE wrd_mpi_io_int_2d( name, data )
[4495]	1211
	1212	IMPLICIT NONE
	1213
	1214	CHARACTER(LEN=*), INTENT(IN) :: name
	1215
	1216	INTEGER(iwp) :: i
	1217	INTEGER(iwp) :: j
	1218
	1219	#if defined( __parallel )
	1220	INTEGER, DIMENSION(rd_status_size) :: status
	1221	#endif
	1222	INTEGER(KIND=iwp), INTENT(IN), DIMENSION(:,:) :: data
	1223
	1224
[4539]	1225	IF ( header_array_index == max_nr_arrays ) THEN
	1226	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	1227	ENDIF
[4495]	1228
[4539]	1229	array_names(header_array_index) = name
	1230	array_offset(header_array_index) = array_position
	1231	header_array_index = header_array_index + 1
	1232
[4495]	1233	IF ( ( nxr-nxl + 1 + 2 * nbgp ) == SIZE( data, 2 ) ) THEN
	1234	!
	1235	!-- Integer arrays with ghost layers are not implemented yet. These kind of arrays would be
	1236	!-- dimensioned in the caller subroutine as
	1237	!-- INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg) :: data
[4536]	1238	message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be written to restart ' // &
	1239	'file is defined with illegal dimensions in the PALM code'
	1240	CALL message( 'wrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
[4495]	1241
	1242	ELSEIF ( ( nxr-nxl+1 ) == SIZE( data, 2 ) ) THEN
	1243	!
	1244	!-- INTEGER input array without ghost layers.
	1245	!-- This kind of array is dimensioned in the caller subroutine as
	1246	!-- INTEGER, DIMENSION(nys:nyn,nxl:nxr) :: data
	1247	DO j = nys, nyn
	1248	DO i = nxl, nxr
[4534]	1249	array_2di(i,j) = data(j-nys+1,i-nxl+1)
[4495]	1250	ENDDO
	1251	ENDDO
	1252	#if defined( __parallel )
[4534]	1253	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	1254	IF ( sm_io%iam_io_pe ) THEN
	1255	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native', &
	1256	MPI_INFO_NULL, ierr )
	1257	CALL MPI_FILE_WRITE_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status, ierr )
	1258	ENDIF
	1259	CALL sm_io%sm_node_barrier()
[4495]	1260	#else
	1261	CALL posix_lseek( fh, array_position )
[4534]	1262	CALL posix_write( fh, array_2di, SIZE( array_2di ) )
[4495]	1263	#endif
	1264	!
	1265	!-- Type conversion required, otherwise rigth hand side brackets are calculated assuming 4 byte
	1266	!-- INT. Maybe a compiler problem.
	1267	array_position = array_position + INT( (ny+1), KIND=rd_offset_kind ) * &
	1268	INT( (nx+1), KIND=rd_offset_kind ) * 4
	1269
	1270	ELSE
[4536]	1271
	1272	message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be written to restart ' // &
	1273	'file is defined with illegal dimensions in the PALM code'
	1274	CALL message( 'wrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
	1275
[4495]	1276	ENDIF
	1277
	1278	END SUBROUTINE wrd_mpi_io_int_2d
	1279
	1280
	1281
	1282	!--------------------------------------------------------------------------------------------------!
	1283	! Description:
	1284	! ------------
	1285	!> Write 3d-REAL array with MPI-IO
	1286	!--------------------------------------------------------------------------------------------------!
	1287	SUBROUTINE wrd_mpi_io_real_3d( name, data )
	1288
	1289	IMPLICIT NONE
	1290
	1291	CHARACTER(LEN=*), INTENT(IN) :: name
	1292
	1293	INTEGER(iwp) :: i
	1294	#if defined( __parallel )
	1295	INTEGER, DIMENSION(rd_status_size) :: status
	1296	#endif
	1297	REAL(wp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data
	1298
	1299
[4539]	1300	IF ( header_array_index == max_nr_arrays ) THEN
	1301	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	1302	ENDIF
[4495]	1303
[4539]	1304	array_names(header_array_index) = name
	1305	array_offset(header_array_index) = array_position
	1306	header_array_index = header_array_index + 1
	1307
[4495]	1308	IF ( include_total_domain_boundaries ) THEN
	1309	!
	1310	!-- Prepare output of 3d-REAL-array with ghost layers.
	1311	!-- In the virtual PE grid, the first dimension is PEs along x, and the second along y.
	1312	!-- For MPI-IO it is recommended to have the index order of the array in the same way, i.e.
	1313	!-- the first dimension should be along x and the second along y.
	1314	!-- For this reason, the original PALM data need to be swaped.
	1315	DO i = lb%nxl, lb%nxr
	1316	array_3d(:,i,lb%nys:lb%nyn) = data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp)
	1317	ENDDO
[4536]	1318
[4495]	1319	ELSE
	1320	!
	1321	!-- Prepare output of 3d-REAL-array without ghost layers
	1322	DO i = nxl, nxr
	1323	array_3d(:,i,lb%nys:lb%nyn) = data(:,nys:nyn,i)
	1324	ENDDO
[4536]	1325
[4495]	1326	ENDIF
	1327	#if defined( __parallel )
[4534]	1328	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	1329	IF ( sm_io%iam_io_pe ) THEN
	1330	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, ierr )
	1331	CALL MPI_FILE_WRITE_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
	1332	ENDIF
	1333	CALL sm_io%sm_node_barrier()
[4495]	1334	#else
	1335	CALL posix_lseek( fh, array_position )
	1336	CALL posix_write( fh, array_3d, SIZE( array_3d ) )
	1337	#endif
	1338	!
	1339	!-- Type conversion required, otherwise rigth hand side brackets are calculated assuming 4 byte INT.
	1340	!-- Maybe a compiler problem.
	1341	array_position = array_position + INT( (nz+2), KIND=rd_offset_kind ) * &
	1342	INT( (lb%ny+1), KIND=rd_offset_kind ) * &
	1343	INT( (lb%nx+1), KIND=rd_offset_kind ) * wp
	1344
	1345	END SUBROUTINE wrd_mpi_io_real_3d
	1346
	1347
	1348
	1349	!--------------------------------------------------------------------------------------------------!
	1350	! Description:
	1351	! ------------
	1352	!> Write 3d-REAL soil array with MPI-IO.
	1353	!> nzb_soil, nzt_soil are located in the module land_surface_model_mod. Since Fortran does not allow
	1354	!> cross referencing of module variables, it is required to pass these variables as arguments.
	1355	!--------------------------------------------------------------------------------------------------!
	1356	SUBROUTINE wrd_mpi_io_real_3d_soil( name, data, nzb_soil, nzt_soil )
	1357
	1358	IMPLICIT NONE
	1359
	1360	CHARACTER(LEN=*), INTENT(IN) :: name
	1361
	1362	INTEGER(iwp) :: i
	1363	INTEGER, INTENT(IN) :: nzb_soil
	1364	INTEGER, INTENT(IN) :: nzt_soil
	1365
	1366	#if defined( __parallel )
	1367	INTEGER, DIMENSION(rd_status_size) :: status
	1368	#endif
	1369
	1370	REAL(wp), INTENT(IN), DIMENSION(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) :: data
	1371
	1372
[4539]	1373	IF ( header_array_index == max_nr_arrays ) THEN
	1374	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	1375	ENDIF
[4495]	1376
[4539]	1377	array_names(header_array_index) = name
	1378	array_offset(header_array_index) = array_position
	1379	header_array_index = header_array_index + 1
	1380
[4534]	1381	#if defined( __parallel )
	1382	CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
	1383	#endif
	1384
[4495]	1385	IF ( include_total_domain_boundaries) THEN
	1386	!
	1387	!-- Prepare output of 3d-REAL-array with ghost layers.
	1388	!-- In the virtual PE grid, the first dimension is PEs along x, and the second along y.
	1389	!-- For MPI-IO it is recommended to have the index order of the array in the same way, i.e.
	1390	!-- the first dimension should be along x and the second along y.
	1391	!-- For this reason, the original PALM data need to be swaped.
	1392	DO i = lb%nxl, lb%nxr
[4534]	1393	array_3d_soil(:,i,lb%nys:lb%nyn) = data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp)
[4495]	1394	ENDDO
[4536]	1395
[4495]	1396	ELSE
	1397	!
	1398	!-- Prepare output of 3d-REAL-array without ghost layers
	1399	DO i = nxl, nxr
[4534]	1400	array_3d_soil(:,i,lb%nys:lb%nyn) = data(:,nys:nyn,i)
[4495]	1401	ENDDO
[4536]	1402
[4495]	1403	ENDIF
	1404	#if defined( __parallel )
[4534]	1405	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	1406	IF ( sm_io%iam_io_pe ) THEN
	1407	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', MPI_INFO_NULL, &
	1408	ierr )
	1409	CALL MPI_FILE_WRITE_ALL( fh, array_3d_soil, SIZE( array_3d_soil ), MPI_REAL, status, ierr )
	1410	ENDIF
	1411	CALL sm_io%sm_node_barrier()
[4495]	1412	#else
	1413	CALL posix_lseek( fh, array_position )
[4534]	1414	CALL posix_write( fh, array_3d_soil, SIZE( array_3d_soil ) )
[4495]	1415	#endif
	1416	!
	1417	!-- Type conversion required, otherwise rigth hand side brackets are calculated assuming 4 byte INT.
	1418	!-- Maybe a compiler problem.
	1419	array_position = array_position + INT( (nzt_soil-nzb_soil+1), KIND=rd_offset_kind ) * &
	1420	INT( (lb%ny+1), KIND=rd_offset_kind ) * &
	1421	INT( (lb%nx+1), KIND=rd_offset_kind ) * wp
	1422
	1423	END SUBROUTINE wrd_mpi_io_real_3d_soil
	1424
	1425
	1426
	1427	!--------------------------------------------------------------------------------------------------!
	1428	! Description:
	1429	! ------------
	1430	!> Write CHARATCTER with MPI-IO
	1431	!--------------------------------------------------------------------------------------------------!
	1432	SUBROUTINE wrd_mpi_io_char( name, text )
	1433
	1434	IMPLICIT NONE
	1435
	1436	CHARACTER(LEN=128) :: lo_line
	1437	CHARACTER(LEN=*), INTENT(IN) :: name
	1438	CHARACTER(LEN=*), INTENT(IN) :: text
	1439
	1440
[4539]	1441	IF ( header_char_index == max_nr_char ) THEN
	1442	STOP '+++ maximum number of CHARACTER entries in restart file header exceeded'
	1443	ENDIF
	1444
[4495]	1445	lo_line = name
	1446	lo_line(33:) = text
	1447	text_lines(header_char_index) = lo_line
	1448	header_char_index = header_char_index + 1
	1449
	1450	END SUBROUTINE wrd_mpi_io_char
	1451
	1452
	1453
	1454	!--------------------------------------------------------------------------------------------------!
	1455	! Description:
	1456	! ------------
	1457	!> Write LOGICAL with MPI-IO
	1458	!--------------------------------------------------------------------------------------------------!
	1459	SUBROUTINE wrd_mpi_io_logical( name, value )
	1460
	1461	IMPLICIT NONE
	1462
	1463	CHARACTER(LEN=*), INTENT(IN) :: name
	1464
	1465	INTEGER(iwp) :: logical_as_integer
	1466
	1467	LOGICAL, INTENT(IN) :: value
	1468
	1469
	1470	IF ( value ) THEN
	1471	logical_as_integer = 1
	1472	ELSE
	1473	logical_as_integer = 0
	1474	ENDIF
	1475
	1476	CALL wrd_mpi_io_int( name, logical_as_integer )
	1477
	1478	END SUBROUTINE wrd_mpi_io_logical
	1479
	1480
	1481
	1482	!--------------------------------------------------------------------------------------------------!
	1483	! Description:
	1484	! ------------
	1485	!> Read 1d-REAL global array with MPI-IO.
	1486	!> Array contains identical data on all PEs.
	1487	!--------------------------------------------------------------------------------------------------!
	1488	SUBROUTINE rrd_mpi_io_global_array_real_1d( name, data )
	1489
	1490	IMPLICIT NONE
	1491
	1492	CHARACTER(LEN=*), INTENT(IN) :: name
	1493
	1494	INTEGER(iwp) :: i
	1495	INTEGER(KIND=rd_offset_kind) :: offset
	1496
	1497	#if defined( __parallel )
	1498	INTEGER, DIMENSION(rd_status_size) :: status
	1499	#endif
	1500
	1501	LOGICAL :: found
	1502
	1503	REAL(KIND=wp), INTENT(INOUT), DIMENSION(:) :: data
	1504
	1505
	1506	offset = 0
	1507	found = .FALSE.
	1508
	1509	DO i = 1, tgh%nr_arrays
	1510	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	1511	array_position = array_offset(i)
	1512	found = .TRUE.
	1513	EXIT
	1514	ENDIF
	1515	ENDDO
	1516
	1517	IF ( found ) THEN
	1518	!
	1519	!-- Set default view
	1520	#if defined( __parallel )
[4534]	1521	IF ( sm_io%iam_io_pe ) THEN
	1522	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	1523	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	1524	CALL MPI_FILE_READ_ALL( fh, data, SIZE( data ), MPI_REAL, status, ierr )
	1525	ENDIF
	1526	IF ( sm_io%is_sm_active() ) THEN
	1527	CALL MPI_BCAST( data, SIZE(data), MPI_REAL, 0, sm_io%comm_shared, ierr )
	1528	ENDIF
[4495]	1529	#else
	1530	CALL posix_lseek( fh, array_position )
	1531	CALL posix_read( fh, data, SIZE( data ) )
	1532	#endif
[4536]	1533
[4495]	1534	ELSE
[4536]	1535
	1536	message_string = '1d/2d/3d/4d-REAL global array "' // TRIM( name ) // '" not found in ' // &
	1537	'restart file'
	1538	CALL message( 'rrd_mpi_io_global_array_real_1d', 'PA0722', 3, 2, 0, 6, 0 )
	1539
[4495]	1540	ENDIF
	1541
	1542	END SUBROUTINE rrd_mpi_io_global_array_real_1d
	1543
	1544
	1545
	1546	!--------------------------------------------------------------------------------------------------!
	1547	! Description:
	1548	! ------------
	1549	!> Read 2d-REAL global array with MPI-IO.
	1550	!> Array contains identical data on all PEs.
	1551	!--------------------------------------------------------------------------------------------------!
	1552	SUBROUTINE rrd_mpi_io_global_array_real_2d( name, data )
	1553
	1554	IMPLICIT NONE
	1555
	1556	CHARACTER(LEN=*), INTENT(IN) :: name
	1557
	1558	INTEGER, DIMENSION(1) :: bufshape
	1559
	1560	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:), TARGET :: data
	1561	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf
	1562
	1563	TYPE(C_PTR) :: c_data
	1564
	1565
	1566	c_data = C_LOC( data )
	1567	bufshape(1) = SIZE( data )
	1568	CALL C_F_POINTER( c_data, buf, bufshape )
	1569
	1570	CALL rrd_mpi_io_global_array_real_1d( name, buf )
	1571
	1572	END SUBROUTINE rrd_mpi_io_global_array_real_2d
	1573
	1574
	1575
	1576	!--------------------------------------------------------------------------------------------------!
	1577	! Description:
	1578	! ------------
	1579	!> Read 3d-REAL global array with MPI-IO.
	1580	!> Array contains identical data on all PEs.
	1581	!--------------------------------------------------------------------------------------------------!
	1582	SUBROUTINE rrd_mpi_io_global_array_real_3d( name, data )
	1583
	1584	IMPLICIT NONE
	1585
	1586	CHARACTER(LEN=*), INTENT(IN) :: name
	1587
	1588	INTEGER, DIMENSION(1) :: bufshape
	1589
	1590	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:), TARGET :: data
	1591	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf
	1592
	1593	TYPE(C_PTR) :: c_data
	1594
	1595
	1596	c_data = C_LOC( data )
	1597	bufshape(1) = SIZE( data )
	1598	CALL C_F_POINTER( c_data, buf, bufshape )
	1599
	1600	CALL rrd_mpi_io_global_array_real_1d( name, buf )
	1601
	1602	END SUBROUTINE rrd_mpi_io_global_array_real_3d
	1603
	1604
	1605
	1606	!--------------------------------------------------------------------------------------------------!
	1607	! Description:
	1608	! ------------
	1609	!> Read 4d-REAL global array with MPI-IO.
	1610	!> Array contains identical data on all PEs.
	1611	!--------------------------------------------------------------------------------------------------!
	1612	SUBROUTINE rrd_mpi_io_global_array_real_4d( name, data )
	1613
	1614	IMPLICIT NONE
	1615
	1616	CHARACTER(LEN=*), INTENT(IN) :: name
	1617
	1618	INTEGER, DIMENSION(1) :: bufshape
	1619
	1620	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:,:), TARGET :: data
	1621	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf
	1622
	1623	TYPE(C_PTR) :: c_data
	1624
	1625
	1626	c_data = C_LOC( data )
	1627	bufshape(1) = SIZE( data)
	1628	CALL C_F_POINTER( c_data, buf, bufshape )
	1629
	1630	CALL rrd_mpi_io_global_array_real_1d( name, buf )
	1631
	1632	END SUBROUTINE rrd_mpi_io_global_array_real_4d
	1633
	1634
	1635
	1636	!--------------------------------------------------------------------------------------------------!
	1637	! Description:
	1638	! ------------
	1639	!> Read 1d-INTEGER global array with MPI-IO.
	1640	!> Array contains identical data on all PEs.
	1641	!--------------------------------------------------------------------------------------------------!
[4536]	1642	SUBROUTINE rrd_mpi_io_global_array_int_1d( name, data )
[4495]	1643
	1644	IMPLICIT NONE
	1645
	1646	CHARACTER(LEN=*), INTENT(IN) :: name
	1647
	1648	INTEGER(iwp) :: i
	1649	INTEGER(KIND=rd_offset_kind) :: offset
	1650
	1651	#if defined( __parallel )
	1652	INTEGER, DIMENSION(rd_status_size) :: status
	1653	#endif
	1654	INTEGER(KIND=iwp), INTENT(INOUT), DIMENSION(:) :: data
	1655
	1656	LOGICAL :: found
	1657
	1658
	1659	offset = 0
	1660	found = .FALSE.
	1661
	1662	DO i = 1, tgh%nr_arrays
	1663	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	1664	array_position = array_offset(i)
	1665	found = .TRUE.
	1666	EXIT
	1667	ENDIF
	1668	ENDDO
	1669
	1670	IF ( found ) THEN
	1671	!
	1672	!-- Set default view
	1673	#if defined( __parallel )
[4534]	1674	IF ( sm_io%iam_io_pe ) THEN
	1675	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	1676	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	1677	CALL MPI_FILE_READ_ALL( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
	1678	ENDIF
	1679	IF ( sm_io%is_sm_active() ) THEN
	1680	CALL MPI_BCAST( data, SIZE(data), MPI_INTEGER, 0, sm_io%comm_shared, ierr )
	1681	ENDIF
[4495]	1682	#else
	1683	CALL posix_lseek( fh, array_position )
	1684	CALL posix_read( fh, data, SIZE( data ) )
	1685	#endif
	1686	ELSE
[4536]	1687
	1688	message_string = '1d-INTEGER global array "' // TRIM( name ) // '" not found in ' // &
	1689	'restart file'
	1690	CALL message( 'rrd_mpi_io_global_array_int_1d', 'PA0722', 3, 2, 0, 6, 0 )
	1691
[4495]	1692	ENDIF
	1693
	1694	END SUBROUTINE rrd_mpi_io_global_array_int_1d
	1695
	1696
	1697
	1698	!--------------------------------------------------------------------------------------------------!
	1699	! Description:
	1700	! ------------
	1701	!> Write 1d-REAL global array with MPI-IO.
	1702	!> Array contains identical data on all PEs.
	1703	!--------------------------------------------------------------------------------------------------!
	1704	SUBROUTINE wrd_mpi_io_global_array_real_1d( name, data )
	1705
	1706	IMPLICIT NONE
	1707
	1708	CHARACTER(LEN=*), INTENT(IN) :: name
	1709
	1710	INTEGER(KIND=rd_offset_kind) :: offset
	1711
	1712	#if defined( __parallel )
	1713	INTEGER, DIMENSION(rd_status_size) :: status
	1714	#endif
	1715
	1716	REAL(KIND=wp), INTENT(IN), DIMENSION(:) :: data
	1717
	1718
	1719	offset = 0
	1720
[4539]	1721	IF ( header_array_index == max_nr_arrays ) THEN
	1722	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	1723	ENDIF
[4495]	1724
[4539]	1725	array_names(header_array_index) = name
	1726	array_offset(header_array_index) = array_position
	1727	header_array_index = header_array_index + 1
	1728
[4495]	1729	!
[4536]	1730	!-- Set default view
[4495]	1731	#if defined( __parallel )
[4536]	1732	IF ( sm_io%iam_io_pe ) THEN
	1733	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	1734	ENDIF
[4495]	1735	!
[4536]	1736	!-- Only PE 0 writes replicated data
	1737	IF ( myid == 0 ) THEN
	1738	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	1739	CALL MPI_FILE_WRITE( fh, data, SIZE( data), MPI_REAL, status, ierr )
	1740	ENDIF
[4495]	1741	#else
[4536]	1742	CALL posix_lseek( fh, array_position )
	1743	CALL posix_write( fh, data, SIZE( data ) )
[4495]	1744	#endif
[4536]	1745	array_position = array_position + SIZE( data ) * wp
[4495]	1746
	1747	END SUBROUTINE wrd_mpi_io_global_array_real_1d
	1748
	1749
	1750
	1751	!--------------------------------------------------------------------------------------------------!
	1752	! Description:
	1753	! ------------
	1754	!> Write 2d-REAL global array with MPI-IO.
	1755	!> Array contains identical data on all PEs.
	1756	!--------------------------------------------------------------------------------------------------!
	1757	SUBROUTINE wrd_mpi_io_global_array_real_2d( name, data )
	1758
	1759	IMPLICIT NONE
	1760
	1761	CHARACTER(LEN=*), INTENT(IN) :: name
	1762
	1763	INTEGER, DIMENSION(1) :: bufshape
	1764
	1765	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf
	1766	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:), TARGET :: data
	1767
	1768	TYPE(C_PTR) :: c_data
	1769
	1770
	1771	c_data = C_LOC( data )
	1772	bufshape(1) = SIZE( data)
	1773	CALL C_F_POINTER( c_data, buf, bufshape )
	1774
	1775	CALL wrd_mpi_io_global_array_real_1d( name, buf )
	1776
	1777	END SUBROUTINE wrd_mpi_io_global_array_real_2d
	1778
	1779
	1780
	1781	!--------------------------------------------------------------------------------------------------!
	1782	! Description:
	1783	! ------------
	1784	!> Write 3d-REAL global array with MPI-IO.
	1785	!> Array contains identical data on all PEs.
	1786	!--------------------------------------------------------------------------------------------------!
	1787	SUBROUTINE wrd_mpi_io_global_array_real_3d( name, data )
	1788
	1789	IMPLICIT NONE
	1790
	1791	CHARACTER(LEN=*), INTENT(IN) :: name
	1792
	1793	INTEGER, DIMENSION(1) :: bufshape
	1794
	1795	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf
	1796	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:), TARGET :: data
	1797
	1798	TYPE(C_PTR) :: c_data
	1799
	1800
	1801	c_data = C_LOC( data )
	1802	bufshape(1) = SIZE( data )
	1803	CALL C_F_POINTER( c_data, buf, bufshape )
	1804
	1805	CALL wrd_mpi_io_global_array_real_1d( name, buf )
	1806
	1807	END SUBROUTINE wrd_mpi_io_global_array_real_3d
	1808
	1809
	1810
	1811	!--------------------------------------------------------------------------------------------------!
	1812	! Description:
	1813	! ------------
	1814	!> Write 4d-REAL global array with MPI-IO.
	1815	!> Array contains identical data on all PEs.
	1816	!--------------------------------------------------------------------------------------------------!
	1817	SUBROUTINE wrd_mpi_io_global_array_real_4d( name, data )
	1818
	1819	IMPLICIT NONE
	1820
	1821	CHARACTER(LEN=*), INTENT(IN) :: name
	1822
	1823	INTEGER, DIMENSION(1) :: bufshape
	1824
	1825	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf
	1826	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:,:), TARGET :: data
	1827
	1828	TYPE(C_PTR) :: c_data
	1829
	1830
	1831	c_data = C_LOC( data )
	1832	bufshape(1) = SIZE( data)
	1833	CALL C_F_POINTER( c_data, buf, bufshape )
	1834
	1835	CALL wrd_mpi_io_global_array_real_1d( name, buf )
	1836
	1837	END SUBROUTINE wrd_mpi_io_global_array_real_4d
	1838
	1839
	1840
	1841	!--------------------------------------------------------------------------------------------------!
	1842	! Description:
	1843	! ------------
	1844	!> Write 1d-INTEGER global array with MPI-IO.
	1845	!> Array contains identical data on all PEs.
	1846	!--------------------------------------------------------------------------------------------------!
	1847	SUBROUTINE wrd_mpi_io_global_array_int_1d( name, data )
	1848
	1849	IMPLICIT NONE
	1850
	1851	CHARACTER(LEN=*), INTENT(IN) :: name
	1852
	1853	INTEGER(KIND=rd_offset_kind) :: offset
	1854
	1855	INTEGER(KIND=iwp), INTENT(IN), DIMENSION(:) :: data
	1856	#if defined( __parallel )
	1857	INTEGER, DIMENSION(rd_status_size) :: status
	1858	#endif
	1859
[4539]	1860	IF ( header_array_index == max_nr_arrays ) THEN
	1861	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	1862	ENDIF
	1863
[4495]	1864	offset = 0
[4539]	1865	array_names(header_array_index) = name
	1866	array_offset(header_array_index) = array_position
	1867	header_array_index = header_array_index + 1
[4495]	1868
	1869	!
	1870	!-- Set default view
	1871	#if defined( __parallel )
[4534]	1872	IF ( sm_io%iam_io_pe ) THEN
	1873	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	1874	ENDIF
[4495]	1875	!
	1876	!-- Only PE 0 writes replicated data
	1877	IF ( myid == 0 ) THEN !
	1878	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	1879	CALL MPI_FILE_WRITE( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
	1880	ENDIF
	1881	#else
	1882	CALL posix_lseek( fh, array_position )
	1883	CALL posix_write( fh, data, SIZE( data ) )
	1884	#endif
	1885	array_position = array_position + SIZE( data ) * 4
	1886
	1887	END SUBROUTINE wrd_mpi_io_global_array_int_1d
	1888
	1889
	1890
	1891	!--------------------------------------------------------------------------------------------------!
	1892	! Description:
	1893	! ------------
	1894	!> Read 1d-REAL surface data array with MPI-IO.
	1895	!--------------------------------------------------------------------------------------------------!
	1896	SUBROUTINE rrd_mpi_io_surface( name, data, first_index )
	1897
	1898	IMPLICIT NONE
	1899
	1900	CHARACTER(LEN=*), INTENT(IN) :: name
	1901
	1902	INTEGER(KIND=rd_offset_kind) :: disp !< displacement of actual indices
	1903	INTEGER(KIND=rd_offset_kind) :: disp_f !< displacement in file
	1904	INTEGER(KIND=rd_offset_kind) :: disp_n !< displacement of next column
	1905	INTEGER(iwp), OPTIONAL :: first_index
	1906
	1907	INTEGER(iwp) :: i
	1908	INTEGER(iwp) :: i_f
	1909	INTEGER(iwp) :: j
	1910	INTEGER(iwp) :: j_f
	1911	INTEGER(iwp) :: lo_first_index
	1912	INTEGER(iwp) :: nr_bytes
	1913	INTEGER(iwp) :: nr_bytes_f
	1914	INTEGER(iwp) :: nr_words
	1915	#if defined( __parallel )
	1916	INTEGER, DIMENSION(rd_status_size) :: status
	1917	#endif
	1918
	1919	LOGICAL :: found
	1920
	1921	REAL(wp), INTENT(OUT), DIMENSION(:) :: data
	1922
	1923
	1924	found = .FALSE.
	1925	lo_first_index = 1
	1926
	1927	IF ( MAXVAL( m_global_start ) == -1 ) RETURN ! nothing to do on this PE
	1928
	1929	IF ( PRESENT( first_index ) ) THEN
	1930	lo_first_index = first_index
	1931	ENDIF
	1932
	1933	DO i = 1, tgh%nr_arrays
	1934	IF ( TRIM( array_names(i) ) == TRIM( name ) ) THEN
	1935	array_position = array_offset(i) + ( lo_first_index - 1 ) * &
	1936	total_number_of_surface_values * wp
	1937	found = .TRUE.
	1938	EXIT
	1939	ENDIF
	1940	ENDDO
	1941
	1942	disp = -1
	1943	disp_f = -1
	1944	disp_n = -1
	1945	IF ( found ) THEN
	1946
	1947	DO i = nxl, nxr
	1948	DO j = nys, nyn
	1949
	1950	IF ( m_global_start(j,i) > 0 ) THEN
	1951	disp = array_position+(m_global_start(j,i)-1) * wp
	1952	nr_words = m_end_index(j,i)-m_start_index(j,i)+1
	1953	nr_bytes = nr_words * wp
	1954	ENDIF
	1955	IF ( disp >= 0 .AND. disp_f == -1 ) THEN ! first Entry
	1956	disp_f = disp
	1957	nr_bytes_f = 0
	1958	i_f = i
	1959	j_f = j
	1960	ENDIF
	1961	IF ( j == nyn .AND. i == nxr ) THEN ! last Entry
	1962	disp_n = -1
	1963	IF ( nr_bytes > 0 ) THEN
	1964	nr_bytes_f = nr_bytes_f+nr_bytes
	1965	ENDIF
	1966	ELSEIF ( j == nyn ) THEN ! next x
	1967	IF ( m_global_start(nys,i+1) > 0 .AND. disp > 0 ) THEN
	1968	disp_n = array_position + ( m_global_start(nys,i+1) - 1 ) * wp
	1969	ELSE
	1970	CYCLE
	1971	ENDIF
	1972	ELSE
	1973	IF ( m_global_start(j+1,i) > 0 .AND. disp > 0 ) THEN
	1974	disp_n = array_position + ( m_global_start(j+1,i) - 1 ) * wp
	1975	ELSE
	1976	CYCLE
	1977	ENDIF
	1978	ENDIF
	1979
	1980
	1981	IF ( disp + nr_bytes == disp_n ) THEN ! contiguous block
	1982	nr_bytes_f = nr_bytes_f + nr_bytes
	1983	ELSE ! read
	1984	#if defined( __parallel )
[4534]	1985	CALL MPI_FILE_SEEK( fhs, disp_f, MPI_SEEK_SET, ierr )
[4495]	1986	nr_words = nr_bytes_f / wp
[4534]	1987	CALL MPI_FILE_READ( fhs, data(m_start_index(j_f,i_f)), nr_words, MPI_REAL, status, ierr )
[4495]	1988	#else
	1989	CALL posix_lseek( fh, disp_f )
[4534]	1990	CALL posix_read( fh, data(m_start_index(j_f,i_f):), nr_bytes_f )
[4495]	1991	#endif
	1992	disp_f = disp
	1993	nr_bytes_f = nr_bytes
	1994	i_f = i
	1995	j_f = j
	1996	ENDIF
	1997
	1998	ENDDO
	1999	ENDDO
	2000
	2001	ELSE
[4536]	2002
	2003	message_string = 'surface array "' // TRIM( name ) // '" not found in restart file'
	2004	CALL message( 'rrd_mpi_io_global_array_int_1d', 'PA0722', 3, 2, 0, 6, 0 )
	2005
[4495]	2006	ENDIF
	2007
[4536]	2008	! IF ( lo_first_index == 1 ) THEN
	2009	! IF ( debug_level >= 2 .AND. nr_val > 0 ) WRITE(9,*) 'r_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
	2010	! ELSE
	2011	! IF ( debug_level >= 2 .AND. nr_val > 0 ) WRITE(9,*) 'r_surf_next ', TRIM( name ), ' ', &
	2012	! lo_first_index,nr_val, SUM( data(1:nr_val) )
	2013	! ENDIF
[4495]	2014
	2015	END SUBROUTINE rrd_mpi_io_surface
	2016
	2017
	2018
	2019	!--------------------------------------------------------------------------------------------------!
	2020	! Description:
	2021	! ------------
	2022	!> Read 2d-REAL surface data array with MPI-IO.
	2023	!> These consist of multiple 1d-REAL surface data arrays.
	2024	!--------------------------------------------------------------------------------------------------!
	2025	SUBROUTINE rrd_mpi_io_surface_2d( name, data )
	2026
	2027	IMPLICIT NONE
	2028
	2029	CHARACTER(LEN=*), INTENT(IN) :: name
	2030
	2031	INTEGER(iwp) :: i
	2032
	2033	REAL(wp), INTENT(OUT), DIMENSION(:,:) :: data
	2034	REAL(wp), DIMENSION(SIZE( data,2)) :: tmp
	2035
	2036
	2037	DO i = 1, SIZE( data,1)
	2038	CALL rrd_mpi_io_surface( name, tmp, first_index = i )
	2039	data(i,:) = tmp
	2040	ENDDO
	2041
	2042	!
	2043	!-- Comment from Klaus Ketelsen (September 2018)
	2044	!-- The intention of the following loop was let the compiler do the copying on return.
	2045	!-- In my understanding is it standard conform to pass the second dimension to a 1d-
	2046	!-- array inside a subroutine and the compiler is responsible to generate code for
	2047	!-- copying. Acually this works fine for INTENT(IN) variables (wrd_mpi_io_surface_2d).
	2048	!-- For INTENT(OUT) like in this case the code works on pgi compiler. But both, the Intel 16
	2049	!-- and the Cray compiler show wrong answers using this loop.
	2050	!-- That is the reason why the above auxiliary array tmp was introduced.
	2051	! DO i = 1, SIZE( data,1)
	2052	! CALL rrd_mpi_io_surface( name, data(i,:), first_index = i )
	2053	! ENDDO
	2054
	2055	END SUBROUTINE rrd_mpi_io_surface_2d
	2056
	2057
	2058
	2059	!--------------------------------------------------------------------------------------------------!
	2060	! Description:
	2061	! ------------
	2062	!> Write 1d-REAL surface data array with MPI-IO.
	2063	!--------------------------------------------------------------------------------------------------!
	2064	SUBROUTINE wrd_mpi_io_surface( name, data, first_index )
	2065
	2066	IMPLICIT NONE
	2067
	2068	CHARACTER(LEN=*), INTENT(IN) :: name
	2069
	2070	#if defined( __parallel )
	2071	INTEGER(KIND=rd_offset_kind) :: disp
	2072	#endif
	2073	INTEGER(iwp), OPTIONAL :: first_index
[4534]	2074	#if defined( __parallel )
	2075	INTEGER(iwp) :: i
	2076	#endif
[4495]	2077	INTEGER(iwp) :: lo_first_index
	2078	INTEGER(KIND=rd_offset_kind) :: offset
	2079
	2080	#if defined( __parallel )
	2081	INTEGER, DIMENSION(rd_status_size) :: status
	2082	#endif
	2083
[4534]	2084	REAL(wp), INTENT(IN), DIMENSION(:), TARGET :: data
[4495]	2085
	2086
	2087	offset = 0
	2088	lo_first_index = 1
	2089
	2090	IF ( PRESENT(first_index) ) THEN
	2091	lo_first_index = first_index
	2092	ENDIF
	2093	!
[4539]	2094	!-- In case of 2d-data, name is written only once
[4495]	2095	IF ( lo_first_index == 1 ) THEN
[4539]	2096
	2097	IF ( header_array_index == max_nr_arrays ) THEN
	2098	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2099	ENDIF
	2100
	2101	array_names(header_array_index) = name
	2102	array_offset(header_array_index) = array_position
	2103	header_array_index = header_array_index + 1
	2104
[4495]	2105	ENDIF
[4539]	2106
[4495]	2107	#if defined( __parallel )
[4534]	2108	IF ( sm_io%is_sm_active() ) THEN
	2109	DO i = 1, nr_val
	2110	array_1d(i+local_start) = data(i)
	2111	ENDDO
[4495]	2112	ELSE
[4534]	2113	! array_1d => data !kk Did not work in all cases why???
	2114	ALLOCATE( array_1d( SIZE( data ) ) )
	2115	array_1d = data
	2116	ENDIF
	2117
	2118	CALL sm_io%sm_node_barrier() ! has no effect if I/O on limited number of cores is inactive
	2119	IF ( sm_io%iam_io_pe ) THEN
	2120	IF ( all_pes_write ) THEN
	2121	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_surf, 'native', MPI_INFO_NULL, &
	2122	ierr )
	2123	CALL MPI_FILE_WRITE_ALL( fh, array_1d, nr_iope, MPI_REAL, status, ierr )
	2124	ELSE
	2125	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	2126	IF ( nr_val > 0 ) THEN
	2127	disp = array_position + 8 * ( glo_start - 1 )
	2128	CALL MPI_FILE_SEEK( fh, disp, MPI_SEEK_SET, ierr )
	2129	CALL MPI_FILE_WRITE( fh, array_1d, nr_iope, MPI_REAL, status, ierr )
	2130	ENDIF
[4495]	2131	ENDIF
	2132	ENDIF
[4534]	2133	CALL sm_io%sm_node_barrier()
	2134	IF( .NOT. sm_io%is_sm_active() ) DEALLOCATE( array_1d )
[4495]	2135	#else
	2136	CALL posix_lseek( fh, array_position )
	2137	CALL posix_write( fh, data, nr_val )
	2138	#endif
	2139	array_position = array_position + total_number_of_surface_values * wp
	2140
[4536]	2141	! IF ( lo_first_index == 1 ) THEN
	2142	! IF ( debug_level >= 2 .AND. nr_val > 0 ) WRITE(9,*) 'w_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
	2143	! ELSE
	2144	! IF ( debug_level >= 2 .AND. nr_val > 0 ) WRITE(9,*) 'w_surf_n ', TRIM( name ), ' ', &
	2145	! lo_first_index, nr_val, SUM( data(1:nr_val) )
	2146	! ENDIF
[4495]	2147
	2148	END SUBROUTINE wrd_mpi_io_surface
	2149
	2150
	2151
	2152	!--------------------------------------------------------------------------------------------------!
	2153	! Description:
	2154	! ------------
	2155	!> Read 2d-REAL surface data array with MPI-IO.
	2156	!> These consist of multiple 1d-REAL surface data arrays.
	2157	!--------------------------------------------------------------------------------------------------!
	2158	SUBROUTINE wrd_mpi_io_surface_2d( name, data )
	2159
	2160	IMPLICIT NONE
	2161
	2162	CHARACTER(LEN=*), INTENT(IN) :: name
	2163
	2164	INTEGER(iwp) :: i
	2165
	2166	REAL(wp), INTENT(IN), DIMENSION(:,:) :: data
	2167
	2168
	2169	DO i = 1, SIZE( data,1)
	2170	CALL wrd_mpi_io_surface( name, data(i,:), first_index = i )
	2171	ENDDO
	2172
	2173	END SUBROUTINE wrd_mpi_io_surface_2d
	2174
	2175
	2176
	2177	!--------------------------------------------------------------------------------------------------!
	2178	! Description:
	2179	! ------------
	2180	!> Close restart file for MPI-IO
	2181	!--------------------------------------------------------------------------------------------------!
	2182	SUBROUTINE rd_mpi_io_close
	2183
	2184	IMPLICIT NONE
	2185
	2186	INTEGER(iwp) :: gh_size
	2187	INTEGER(KIND=rd_offset_kind) :: offset
	2188	#if defined( __parallel )
	2189	INTEGER, DIMENSION(rd_status_size) :: status
	2190	#endif
	2191
	2192	#if ! defined( __parallel )
	2193	TYPE(C_PTR) :: buf_ptr
	2194	#endif
	2195
	2196
	2197	offset = 0
	2198
[4534]	2199	IF ( wr_flag .AND. sm_io%iam_io_pe ) THEN
[4495]	2200
	2201	tgh%nr_int = header_int_index - 1
	2202	tgh%nr_char = header_char_index - 1
	2203	tgh%nr_real = header_real_index - 1
[4539]	2204	tgh%nr_arrays = header_array_index - 1
[4495]	2205	tgh%total_nx = lb%nx + 1
	2206	tgh%total_ny = lb%ny + 1
[4536]	2207	IF ( include_total_domain_boundaries ) THEN ! not sure, if LOGICAL interpretation is the same for all compilers,
[4495]	2208	tgh%i_outer_bound = 1 ! therefore store as INTEGER in general header
	2209	ELSE
	2210	tgh%i_outer_bound = 0
	2211	ENDIF
	2212	!
	2213	!-- Check for big/little endian format. This check is currently not used, and could be removed
	2214	!-- if we can assume little endian as the default on all machines.
[4534]	2215	CALL rd_mpi_io_check_endian( tgh%endian )
[4495]	2216
	2217	!
	2218	!-- Set default view
	2219	#if defined( __parallel )
	2220	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	2221	#endif
	2222	!
	2223	!-- Write header file
	2224	gh_size = storage_size(tgh) / 8
[4534]	2225	IF ( myid == 0 ) THEN ! myid = 0 always performs I/O, even if I/O is limited to some cores
[4495]	2226	#if defined( __parallel )
	2227	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	2228	CALL MPI_FILE_WRITE( fh, tgh, gh_size, MPI_INT, status, ierr )
	2229	header_position = header_position + gh_size
	2230	!
	2231	!-- INTEGER values
	2232	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	2233	CALL MPI_FILE_WRITE( fh, int_names, SIZE( int_names )*32, MPI_CHAR, status, ierr )
	2234	header_position = header_position + SIZE( int_names ) * 32
	2235
	2236	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	2237	CALL MPI_FILE_WRITE( fh, int_values, SIZE( int_values ), MPI_INT, status, ierr )
	2238	header_position = header_position + SIZE( int_values ) * iwp
	2239	!
	2240	!-- Character entries
	2241	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	2242	CALL MPI_FILE_WRITE( fh, text_lines, SIZE( text_lines )*128, MPI_CHAR, status, ierr )
	2243	header_position = header_position + SIZE( text_lines ) * 128
	2244	!
	2245	!--- REAL values
	2246	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	2247	CALL MPI_FILE_WRITE( fh, real_names, SIZE( real_names )*32, MPI_CHAR, status, ierr )
	2248	header_position = header_position + SIZE( real_names ) * 32
	2249
	2250	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	2251	CALL MPI_FILE_WRITE( fh, real_values, SIZE( real_values ), MPI_REAL, status, ierr )
	2252	header_position = header_position + SIZE( real_values ) * wp
	2253	!
	2254	!-- 2d- and 3d- distributed array headers, all replicated array headers
	2255	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	2256	CALL MPI_FILE_WRITE( fh, array_names, SIZE( array_names )*32, MPI_CHAR, status, ierr )
	2257	header_position = header_position + SIZE( array_names ) * 32
	2258
	2259	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
[4536]	2260	CALL MPI_FILE_WRITE( fh, array_offset, SIZE( array_offset )*MPI_OFFSET_KIND, MPI_BYTE, &
	2261	status, ierr ) ! There is no I*8 datatype in Fortran
[4495]	2262	header_position = header_position + SIZE( array_offset ) * rd_offset_kind
	2263	#else
	2264	CALL posix_lseek( fh, header_position )
	2265	buf_ptr = C_LOC( tgh )
	2266	CALL posix_write( fh, buf_ptr, gh_size )
	2267	header_position = header_position + gh_size
	2268	!
	2269	!-- INTEGER values
	2270	CALL posix_lseek( fh, header_position )
	2271	CALL posix_write( fh, int_names )
	2272	header_position = header_position + SIZE( int_names ) * 32
	2273
	2274	CALL posix_lseek( fh, header_position )
	2275	CALL posix_write( fh, int_values, SIZE( int_values ) )
	2276	header_position = header_position + SIZE( int_values ) * iwp
	2277	!
	2278	!-- Character entries
	2279	CALL posix_lseek( fh, header_position )
	2280	CALL posix_write( fh, text_lines )
	2281	header_position = header_position + SIZE( text_lines ) * 128
	2282	!
	2283	!-- REAL values
	2284	CALL posix_lseek( fh, header_position )
	2285	CALL posix_write( fh, real_names )
	2286	header_position = header_position + SIZE( real_names ) * 32
	2287
	2288	CALL posix_lseek( fh, header_position )
	2289	CALL posix_write( fh, real_values, SIZE( real_values ) )
	2290	header_position = header_position + SIZE( real_values ) * wp
	2291	!
	2292	!-- 2d- and 3d-distributed array headers, all replicated array headers
	2293	CALL posix_lseek( fh, header_position )
	2294	CALL posix_write( fh, array_names )
	2295	header_position = header_position + SIZE( array_names ) * 32
	2296
	2297	CALL posix_lseek( fh, header_position )
	2298	CALL posix_write( fh, array_offset, SIZE( array_offset ) )
	2299	header_position = header_position + SIZE( array_offset ) * rd_offset_kind
	2300	#endif
[4536]	2301	IF ( debug_output ) CALL rd_mpi_io_print_header
[4495]	2302	ENDIF
	2303
	2304	ENDIF
	2305
	2306	!
	2307	!-- Free file types
[4534]	2308	CALL rd_mpi_io_free_filetypes
[4495]	2309
	2310	!
[4534]	2311	!-- Close MPI-IO files
[4495]	2312	#if defined( __parallel )
[4534]	2313	!
	2314	!-- Restart file has been opened with comm2d
	2315	IF ( fhs /= -1 ) THEN
	2316	CALL MPI_FILE_CLOSE( fhs, ierr )
	2317	ENDIF
	2318	#endif
	2319
	2320	IF ( sm_io%iam_io_pe ) THEN
	2321
	2322	#if defined( __parallel )
	2323	CALL MPI_FILE_CLOSE( fh, ierr )
[4495]	2324	#else
[4534]	2325	CALL posix_close( fh )
[4495]	2326	#endif
	2327
[4534]	2328	ENDIF
	2329
[4536]	2330	restart_file_size = array_position / ( 1024.0_dp * 1024.0_dp )
[4495]	2331
	2332	END SUBROUTINE rd_mpi_io_close
	2333
	2334
	2335
	2336	!--------------------------------------------------------------------------------------------------!
	2337	! Description:
	2338	! ------------
	2339	!> This subroutine prepares a filetype and some variables for the I/O of surface data.
	2340	!> Whenever a new set of start_index and end_index is used, rd_mpi_io_surface_filetypes has to be
	2341	!> called. A main feature of this subroutine is computing the global start indices of the 1d- and
	2342	!> 2d- surface arrays.
[4534]	2343	!> Even if I/O is done by a limited number of cores only, the surface data are read by ALL cores!
	2344	!> Reading them by some cores and then distributing the data would result in complicated code
	2345	!> which is suspectable for errors and overloads the reading subroutine. Since reading of surface
	2346	!> data is not time critical (data size is comparably small), it will be read by all cores.
[4495]	2347	!--------------------------------------------------------------------------------------------------!
	2348	SUBROUTINE rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start )
	2349
	2350	IMPLICIT NONE
	2351
	2352	INTEGER(iwp) :: i !< loop index
	2353	INTEGER(KIND=rd_offset_kind) :: offset
	2354
	2355	INTEGER(iwp), DIMENSION(1) :: dims1
	2356	INTEGER(iwp), DIMENSION(1) :: lize1
	2357	INTEGER(iwp), DIMENSION(1) :: start1
	2358	INTEGER(iwp), DIMENSION(0:numprocs-1) :: lo_nr_val !< local number of values in x and y direction
	2359	INTEGER(iwp), DIMENSION(0:numprocs-1) :: all_nr_val !< number of values for all PEs
	2360
	2361	INTEGER, INTENT(IN), DIMENSION(nys:nyn,nxl:nxr) :: end_index
	2362	INTEGER, INTENT(OUT), DIMENSION(nys:nyn,nxl:nxr) :: global_start
	2363	INTEGER, INTENT(IN), DIMENSION(nys:nyn,nxl:nxr) :: start_index
	2364
	2365	LOGICAL, INTENT(OUT) :: data_to_write !< returns, if surface data have to be written
	2366
	2367
	2368	offset = 0
	2369	lo_nr_val= 0
	2370	lo_nr_val(myid) = MAXVAL( end_index )
	2371	#if defined( __parallel )
	2372	CALL MPI_ALLREDUCE( lo_nr_val, all_nr_val, numprocs, MPI_INTEGER, MPI_SUM, comm2d, ierr )
[4534]	2373	IF ( ft_surf /= -1 .AND. sm_io%iam_io_pe ) THEN
[4495]	2374	CALL MPI_TYPE_FREE( ft_surf, ierr ) ! if set, free last surface filetype
	2375	ENDIF
[4534]	2376
	2377	IF ( win_surf /= -1 ) THEN
	2378	IF ( sm_io%is_sm_active() ) THEN
	2379	CALL MPI_WIN_FREE( win_surf, ierr )
	2380	ENDIF
	2381	win_surf = -1
	2382	ENDIF
	2383
	2384	IF ( sm_io%is_sm_active() .AND. rd_flag ) THEN
	2385	IF ( fhs == -1 ) THEN
	2386	CALL MPI_FILE_OPEN( comm2d, TRIM( io_file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fhs, &
	2387	ierr )
	2388	ENDIF
	2389	ELSE
	2390	fhs = fh
	2391	ENDIF
[4495]	2392	#else
	2393	all_nr_val(myid) = lo_nr_val(myid)
	2394	#endif
	2395	nr_val = lo_nr_val(myid)
	2396
	2397	total_number_of_surface_values = 0
	2398	DO i = 0, numprocs-1
	2399	IF ( i == myid ) THEN
	2400	glo_start = total_number_of_surface_values + 1
	2401	ENDIF
	2402	total_number_of_surface_values = total_number_of_surface_values + all_nr_val(i)
	2403	ENDDO
	2404
	2405	!
	2406	!-- Actions during read
	2407	IF ( rd_flag ) THEN
	2408	IF ( .NOT. ALLOCATED( m_start_index ) ) ALLOCATE( m_start_index(nys:nyn,nxl:nxr) )
	2409	IF ( .NOT. ALLOCATED( m_end_index ) ) ALLOCATE( m_end_index(nys:nyn,nxl:nxr) )
	2410	IF ( .NOT. ALLOCATED( m_global_start ) ) ALLOCATE( m_global_start(nys:nyn,nxl:nxr) )
	2411	!
	2412	!-- Save arrays for later reading
	2413	m_start_index = start_index
	2414	m_end_index = end_index
	2415	m_global_start = global_start
	2416	nr_val = MAXVAL( end_index )
	2417
	2418	#if defined( __parallel )
[4534]	2419	CALL MPI_FILE_SET_VIEW( fhs, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
[4495]	2420	#endif
	2421	ENDIF
	2422
	2423	!
	2424	!-- Actions during write
	2425	IF ( wr_flag ) THEN
	2426	!
	2427	!-- Create surface filetype
	2428	ft_surf = -1
	2429	global_start = start_index + glo_start - 1
	2430
	2431	WHERE ( end_index < start_index )
	2432	global_start = -1
	2433	ENDWHERE
	2434
[4534]	2435	#if defined( __parallel )
	2436	IF ( sm_io%is_sm_active() ) THEN
	2437	IF ( sm_io%iam_io_pe ) THEN
[4495]	2438	!
[4534]	2439	!-- Calculate number of values of all PEs of an I/O group
	2440	nr_iope = 0
	2441	DO i = myid, myid+sm_io%sh_npes-1
	2442	nr_iope = nr_iope + all_nr_val(i)
	2443	ENDDO
	2444	ELSE
	2445	local_start = 0
	2446	DO i = myid-sm_io%sh_rank, myid-1
	2447	local_start = local_start + all_nr_val(i)
	2448	ENDDO
	2449	ENDIF
	2450	!
	2451	!-- Get the size of shared memory window on all PEs
	2452	CALL MPI_BCAST( nr_iope, 1, MPI_INTEGER, 0, sm_io%comm_shared, ierr )
	2453	CALL sm_io%sm_allocate_shared( array_1d, 1, MAX( 1, nr_iope ), win_surf )
	2454	ELSE
	2455	nr_iope = nr_val
	2456	ENDIF
	2457	#else
	2458	nr_iope = nr_val
	2459	#endif
	2460
	2461	!
[4495]	2462	!-- Check, if surface data exist on this PE
	2463	data_to_write = .TRUE.
	2464	IF ( total_number_of_surface_values == 0 ) THEN
	2465	data_to_write = .FALSE.
	2466	RETURN
	2467	ENDIF
	2468
[4534]	2469	IF ( sm_io%iam_io_pe ) THEN
[4495]	2470
[4534]	2471	all_pes_write = ( MINVAL( all_nr_val ) > 0 )
[4495]	2472
[4534]	2473	IF ( all_pes_write ) THEN
	2474	dims1(1) = total_number_of_surface_values
	2475	lize1(1) = nr_iope
	2476	start1(1) = glo_start-1
	2477
[4495]	2478	#if defined( __parallel )
[4534]	2479	IF ( total_number_of_surface_values > 0 ) THEN
	2480	CALL MPI_TYPE_CREATE_SUBARRAY( 1, dims1, lize1, start1, MPI_ORDER_FORTRAN, &
	2481	MPI_REAL, ft_surf, ierr )
	2482	CALL MPI_TYPE_COMMIT( ft_surf, ierr )
	2483	ENDIF
	2484	#endif
[4495]	2485	ENDIF
	2486	ENDIF
[4534]	2487
[4495]	2488	ENDIF
	2489
	2490	END SUBROUTINE rd_mpi_io_surface_filetypes
	2491
	2492
	2493
	2494	!--------------------------------------------------------------------------------------------------!
	2495	! Description:
	2496	! ------------
	2497	!> This subroutine creates file types to access 2d-/3d-REAL arrays and 2d-INTEGER arrays
	2498	!> distributed in blocks among processes to a single file that contains the global arrays.
	2499	!--------------------------------------------------------------------------------------------------!
[4534]	2500	SUBROUTINE rd_mpi_io_create_filetypes
[4495]	2501
	2502	IMPLICIT NONE
	2503
	2504	INTEGER, DIMENSION(2) :: dims2
	2505	INTEGER, DIMENSION(2) :: lize2
	2506	INTEGER, DIMENSION(2) :: start2
	2507
	2508	INTEGER, DIMENSION(3) :: dims3
	2509	INTEGER, DIMENSION(3) :: lize3
	2510	INTEGER, DIMENSION(3) :: start3
	2511
[4534]	2512	TYPE(local_boundaries) :: save_io_grid !< temporary variable to store grid settings
[4495]	2513
[4534]	2514
	2515	IF ( sm_io%is_sm_active() ) THEN
	2516	save_io_grid = sm_io%io_grid
	2517	ENDIF
	2518
[4495]	2519	!
	2520	!-- Decision, if storage with or without ghost layers.
	2521	!-- Please note that the indexing of the global array always starts at 0, even in Fortran.
	2522	!-- Therefore the PE local indices have to be shifted by nbgp in the case with ghost layers.
	2523	IF ( include_total_domain_boundaries ) THEN
	2524
	2525	lb%nxl = nxl + nbgp
	2526	lb%nxr = nxr + nbgp
	2527	lb%nys = nys + nbgp
	2528	lb%nyn = nyn + nbgp
	2529	lb%nnx = nnx
	2530	lb%nny = nny
	2531	lb%nx = nx + 2 * nbgp
	2532	lb%ny = ny + 2 * nbgp
	2533	IF ( myidx == 0 ) THEN
	2534	lb%nxl = lb%nxl - nbgp
	2535	lb%nnx = lb%nnx + nbgp
	2536	ENDIF
	2537	IF ( myidx == npex-1 .OR. npex == -1 ) THEN ! npex == 1 if -D__parallel not set
	2538	lb%nxr = lb%nxr + nbgp
	2539	lb%nnx = lb%nnx + nbgp
	2540	ENDIF
	2541	IF ( myidy == 0 ) THEN
	2542	lb%nys = lb%nys - nbgp
	2543	lb%nny = lb%nny + nbgp
	2544	ENDIF
	2545	IF ( myidy == npey-1 .OR. npey == -1 ) THEN ! npey == 1 if -D__parallel not set
	2546	lb%nyn = lb%nyn + nbgp
	2547	lb%nny = lb%nny + nbgp
	2548	ENDIF
	2549
[4534]	2550	CALL sm_io%sm_adjust_outer_boundary()
	2551
[4495]	2552	ELSE
	2553
	2554	lb%nxl = nxl
	2555	lb%nxr = nxr
	2556	lb%nys = nys
	2557	lb%nyn = nyn
	2558	lb%nnx = nnx
	2559	lb%nny = nny
	2560	lb%nx = nx
	2561	lb%ny = ny
	2562
	2563	ENDIF
	2564
[4534]	2565	IF ( sm_io%is_sm_active() ) THEN
	2566	#if defined( __parallel )
	2567	CALL sm_io%sm_allocate_shared( array_2d, sm_io%io_grid%nxl, sm_io%io_grid%nxr, &
	2568	sm_io%io_grid%nys, sm_io%io_grid%nyn, win_2dr )
	2569	CALL sm_io%sm_allocate_shared( array_2di, save_io_grid%nxl, save_io_grid%nxr, &
	2570	save_io_grid%nys, save_io_grid%nyn, win_2di )
	2571	CALL sm_io%sm_allocate_shared( array_3d, nzb, nzt+1, sm_io%io_grid%nxl, sm_io%io_grid%nxr, &
	2572	sm_io%io_grid%nys, sm_io%io_grid%nyn, win_3dr )
	2573	#endif
	2574	ELSE
	2575	ALLOCATE( array_2d(lb%nxl:lb%nxr,lb%nys:lb%nyn) )
	2576	ALLOCATE( array_2di(nxl:nxr,nys:nyn) )
	2577	ALLOCATE( array_3d(nzb:nzt+1,lb%nxl:lb%nxr,lb%nys:lb%nyn) )
	2578	sm_io%io_grid = lb
	2579	ENDIF
	2580
[4495]	2581	!
	2582	!-- Create filetype for 2d-REAL array with ghost layers around the total domain
	2583	dims2(1) = lb%nx + 1
	2584	dims2(2) = lb%ny + 1
	2585
[4534]	2586	lize2(1) = sm_io%io_grid%nnx
	2587	lize2(2) = sm_io%io_grid%nny
[4495]	2588
[4534]	2589	start2(1) = sm_io%io_grid%nxl
	2590	start2(2) = sm_io%io_grid%nys
[4495]	2591
	2592	#if defined( __parallel )
[4534]	2593	IF ( sm_io%iam_io_pe ) THEN
	2594	CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_REAL, &
	2595	ft_2d, ierr )
	2596	CALL MPI_TYPE_COMMIT( ft_2d, ierr )
	2597	ENDIF
[4495]	2598	#endif
	2599	!
	2600	!-- Create filetype for 2d-INTEGER array without ghost layers around the total domain
	2601	dims2(1) = nx + 1
	2602	dims2(2) = ny + 1
	2603
[4534]	2604	IF ( sm_io%is_sm_active() ) THEN
[4495]	2605
[4534]	2606	lize2(1) = save_io_grid%nnx
	2607	lize2(2) = save_io_grid%nny
[4495]	2608
[4534]	2609	start2(1) = save_io_grid%nxl
	2610	start2(2) = save_io_grid%nys
	2611
	2612	ELSE
	2613
	2614	lize2(1) = nnx
	2615	lize2(2) = nny
	2616
	2617	start2(1) = nxl
	2618	start2(2) = nys
	2619
	2620	ENDIF
	2621
[4495]	2622	#if defined( __parallel )
[4534]	2623	IF ( sm_io%iam_io_pe ) THEN
	2624	CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_INTEGER, &
	2625	ft_2di_nb, ierr )
	2626	CALL MPI_TYPE_COMMIT( ft_2di_nb, ierr )
	2627	ENDIF
[4495]	2628	#endif
	2629	!
	2630	!-- Create filetype for 3d-REAL array
	2631	dims3(1) = nz + 2
	2632	dims3(2) = lb%nx + 1
	2633	dims3(3) = lb%ny + 1
	2634
	2635	lize3(1) = dims3(1)
[4534]	2636	lize3(2) = sm_io%io_grid%nnx
	2637	lize3(3) = sm_io%io_grid%nny
[4495]	2638
	2639	start3(1) = nzb
[4534]	2640	start3(2) = sm_io%io_grid%nxl
	2641	start3(3) = sm_io%io_grid%nys
[4495]	2642
	2643	#if defined( __parallel )
[4534]	2644	IF ( sm_io%iam_io_pe ) THEN
	2645	CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL, ft_3d, &
	2646	ierr )
	2647	CALL MPI_TYPE_COMMIT( ft_3d, ierr )
	2648	ENDIF
[4495]	2649	#endif
	2650
[4534]	2651	END SUBROUTINE rd_mpi_io_create_filetypes
[4495]	2652
	2653
	2654
	2655	!--------------------------------------------------------------------------------------------------!
	2656	! Description:
	2657	! ------------
	2658	!> This subroutine creates file types to access 3d-soil arrays
	2659	!> distributed in blocks among processes to a single file that contains the global arrays.
[4496]	2660	!> It is not required for the serial mode.
[4495]	2661	!--------------------------------------------------------------------------------------------------!
	2662	#if defined( __parallel )
	2663	SUBROUTINE rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
	2664
	2665	IMPLICIT NONE
	2666
	2667	INTEGER, INTENT(IN) :: nzb_soil
	2668	INTEGER, INTENT(IN) :: nzt_soil
	2669
	2670	INTEGER, DIMENSION(3) :: dims3
	2671	INTEGER, DIMENSION(3) :: lize3
	2672	INTEGER, DIMENSION(3) :: start3
	2673
	2674
[4534]	2675	IF ( sm_io%is_sm_active() ) THEN
	2676	CALL sm_io%sm_allocate_shared( array_3d_soil, nzb_soil, nzt_soil, sm_io%io_grid%nxl, &
	2677	sm_io%io_grid%nxr, sm_io%io_grid%nys, sm_io%io_grid%nyn, &
	2678	win_3ds )
	2679	ELSE
	2680	ALLOCATE( array_3d_soil(nzb_soil:nzt_soil,lb%nxl:lb%nxr,lb%nys:lb%nyn) )
	2681	sm_io%io_grid = lb
	2682	ENDIF
	2683
[4495]	2684	!
	2685	!-- Create filetype for 3d-soil array
	2686	dims3(1) = nzt_soil - nzb_soil + 1
	2687	dims3(2) = lb%nx + 1
	2688	dims3(3) = lb%ny + 1
	2689
	2690	lize3(1) = dims3(1)
[4534]	2691	lize3(2) = sm_io%io_grid%nnx
	2692	lize3(3) = sm_io%io_grid%nny
[4495]	2693
	2694	start3(1) = nzb_soil
[4534]	2695	start3(2) = sm_io%io_grid%nxl
	2696	start3(3) = sm_io%io_grid%nys
[4495]	2697
[4534]	2698	IF ( sm_io%iam_io_pe ) THEN
	2699	CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL, &
	2700	ft_3dsoil, ierr )
	2701	CALL MPI_TYPE_COMMIT( ft_3dsoil, ierr )
	2702	ENDIF
[4495]	2703
	2704	END SUBROUTINE rd_mpi_io_create_filetypes_3dsoil
	2705	#endif
	2706
	2707
	2708
	2709	!--------------------------------------------------------------------------------------------------!
	2710	! Description:
	2711	! ------------
	2712	!> Free all file types that have been created for MPI-IO.
	2713	!--------------------------------------------------------------------------------------------------!
[4534]	2714	SUBROUTINE rd_mpi_io_free_filetypes
[4495]	2715
	2716	IMPLICIT NONE
	2717
	2718
	2719	#if defined( __parallel )
	2720	IF ( filetypes_created ) THEN
[4534]	2721
	2722	IF ( sm_io%iam_io_pe ) THEN
	2723	CALL MPI_TYPE_FREE( ft_2d, ierr )
	2724	CALL MPI_TYPE_FREE( ft_2di_nb, ierr )
	2725	CALL MPI_TYPE_FREE( ft_3d, ierr )
	2726	ENDIF
	2727
	2728	IF ( sm_io%is_sm_active() ) THEN
	2729	CALL sm_io%sm_free_shared( win_2dr )
	2730	CALL sm_io%sm_free_shared( win_2di )
	2731	CALL sm_io%sm_free_shared( win_3dr )
	2732	ELSE
	2733	DEALLOCATE( array_2d, array_2di, array_3d )
	2734	ENDIF
	2735
[4495]	2736	ENDIF
	2737	!
	2738	!-- Free last surface filetype
[4534]	2739	IF ( sm_io%iam_io_pe .AND. ft_surf /= -1 ) THEN
[4495]	2740	CALL MPI_TYPE_FREE( ft_surf, ierr )
	2741	ENDIF
[4534]	2742
	2743	IF ( sm_io%is_sm_active() .AND. win_surf /= -1 ) THEN
	2744	CALL sm_io%sm_free_shared( win_surf )
	2745	ENDIF
	2746
	2747	ft_surf = -1
	2748	win_surf = -1
	2749	#else
	2750	DEALLOCATE( array_2d, array_2di, array_3d )
[4495]	2751	#endif
	2752
[4534]	2753	END SUBROUTINE rd_mpi_io_free_filetypes
[4495]	2754
	2755
	2756
	2757	!--------------------------------------------------------------------------------------------------!
	2758	! Description:
	2759	! ------------
	2760	!> Print the restart data file header (MPI-IO format) for debugging.
	2761	!--------------------------------------------------------------------------------------------------!
[4534]	2762	SUBROUTINE rd_mpi_io_print_header
[4495]	2763
	2764	IMPLICIT NONE
	2765
	2766	INTEGER(iwp) :: i
	2767
	2768
[4536]	2769	WRITE (9,*) 'header position after reading the restart file header: ', header_position
	2770	WRITE (9,*) ' '
	2771	WRITE (9,*) 'restart file header content:'
	2772	WRITE (9,*) '----------------------------'
	2773	WRITE (9,*) ' '
[4495]	2774
[4536]	2775	WRITE (9,*) ' CHARACTER header values Total number: ', tgh%nr_char
	2776	WRITE (9,*) ' '
	2777	DO i = 1, tgh%nr_char
	2778	WRITE( 9, '(I3,A,1X,A)' ) i, ': ', text_lines(i)(1:80)
	2779	ENDDO
	2780	WRITE (9,*) ' '
[4495]	2781
[4536]	2782	WRITE (9,*) ' INTEGER header variables and values Total number: ', tgh%nr_int
	2783	WRITE (9,*) ' '
	2784	DO i = 1, tgh%nr_int
	2785	WRITE(9,*) ' variable: ', int_names(i), ' value: ', int_values(i)
	2786	ENDDO
	2787	WRITE (9,*) ' '
[4495]	2788
[4536]	2789	WRITE (9,*) ' REAL header variables and values Total number: ', tgh%nr_real
	2790	WRITE (9,*) ' '
	2791	DO i = 1, tgh%nr_real
	2792	WRITE(9,*) ' variable: ', real_names(i), ' value: ', real_values(i)
	2793	ENDDO
	2794	WRITE (9,*) ' '
[4495]	2795
[4536]	2796	WRITE (9,*) ' Header entries with offset (2d/3d arrays) Total number: ', tgh%nr_arrays
	2797	WRITE (9,*) ' '
	2798	DO i = 1, tgh%nr_arrays
	2799	WRITE(9,*) ' variable: ', array_names(i), ' offset: ', array_offset(i)
	2800	ENDDO
	2801	WRITE (9,*) ' '
[4495]	2802
[4534]	2803	END SUBROUTINE rd_mpi_io_print_header
[4495]	2804
	2805
	2806
	2807	!--------------------------------------------------------------------------------------------------!
	2808	! Description:
	2809	! ------------
	2810	!> Check if big/little endian data format is used.
	2811	!> An int4 pointer is set to a int8 variable, the int*8 is set to 1, and then it is checked, if
	2812	!> the first 4 bytes of the pointer are equal 1 (little endian) or not.
	2813	!--------------------------------------------------------------------------------------------------!
[4534]	2814	SUBROUTINE rd_mpi_io_check_endian( i_endian )
[4495]	2815
	2816	IMPLICIT NONE
	2817
	2818	INTEGER, INTENT(out) :: i_endian
	2819	INTEGER(KIND=8), TARGET :: int8
	2820
	2821	INTEGER, DIMENSION(1) :: bufshape
	2822	INTEGER(KIND=4), POINTER, DIMENSION(:) :: int4
	2823
	2824	TYPE(C_PTR) :: ptr
	2825
	2826
	2827	ptr = C_LOC( int8 )
	2828	bufshape(1) = 2
	2829	CALL C_F_POINTER( ptr, int4, bufshape )
	2830
	2831	int8 = 1
	2832
	2833	IF ( int4(1) == 1 ) THEN
	2834	i_endian = 1 ! little endian
	2835	ELSE
	2836	i_endian = 2 ! big endian
	2837	ENDIF
	2838
[4534]	2839	END SUBROUTINE rd_mpi_io_check_endian
[4495]	2840
	2841	END MODULE restart_data_mpi_io_mod

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |