Home

Context Navigation

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

Last change on this file since 4867 was 4857, checked in by raasch, 4 years ago
bugfix: allocation of 3d-int4 array moved from particle output to standard output
Property svn:keywords set to `Id`
File size: 152.2 KB

Rev	Line
[4495]	1	!> @file restart_data_mpi_io_mod.f90
[4591]	2	!--------------------------------------------------------------------------------------------------!
[4495]	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	!
[4828]	16	! Copyright 1997-2021 Leibniz Universitaet Hannover
[4591]	17	!--------------------------------------------------------------------------------------------------!
[4495]	18	!
[4591]	19	!
[4495]	20	! Current revisions:
	21	! -----------------
[4591]	22	!
	23	!
[4495]	24	! Former revisions:
	25	! -----------------
	26	! $Id: restart_data_mpi_io_mod.f90 4857 2021-01-26 07:24:41Z moh.hefny $
[4857]	27	! bugfix: allocation of 3d-int4 array moved from particle output to standard output
	28	!
	29	! 4832 2021-01-07 07:15:12Z raasch
[4832]	30	! some debug output flushed
	31	!
	32	! 4828 2021-01-05 11:21:41Z Giersch
[4735]	33	! interface for 3d logical arrays added
	34	!
	35	! 4694 2020-09-23 15:09:19Z pavelkrc
[4694]	36	! Fix name of subroutine in message
	37	!
	38	! 4629 2020-07-29 09:37:56Z raasch
[4629]	39	! support for MPI Fortran77 interface (mpif.h) removed
	40	!
	41	! 4628 2020-07-29 07:23:03Z raasch
[4628]	42	! extensions required for MPI-I/O of particle data to restart files
	43	!
	44	! 4622 2020-07-23 09:02:23Z raasch
[4622]	45	! unused variables removed
	46	!
	47	! 4621 2020-07-23 08:15:59Z raasch
[4621]	48	! bugfixes for serial (non-parallel) mode
	49	!
	50	! 4619 2020-07-22 13:21:28Z raasch
[4619]	51	! unused variable removed
	52	!
	53	! 4617 2020-07-22 09:48:50Z raasch
[4617]	54	! Cyclic fill mode implemented
	55	!
	56	! 4598 2020-07-10 10:13:23Z suehring
[4598]	57	! Bugfix in treatment of 3D soil arrays
	58	!
	59	! 4591 2020-07-06 15:56:08Z raasch
[4591]	60	! File re-formatted to follow the PALM coding standard
	61	!
	62	! 4539 2020-05-18 14:05:17Z raasch
	63	! Checks added, if index limits in header are exceeded
	64	! Bugfix in rrd_mpi_io_int_2d
	65	!
[4539]	66	! 4536 2020-05-17 17:24:13Z raasch
[4591]	67	! Messages and debug output converted to PALM routines
	68	!
[4536]	69	! 4534 2020-05-14 18:35:22Z raasch
[4534]	70	! I/O on reduced number of cores added (using shared memory MPI)
[4591]	71	!
[4534]	72	! 4500 2020-04-17 10:12:45Z suehring
[4500]	73	! Fix too long lines
[4591]	74	!
[4500]	75	! 4498 2020-04-15 14:26:31Z raasch
[4591]	76	! Bugfix for creation of filetypes, argument removed from rd_mpi_io_open
	77	!
[4498]	78	! 4497 2020-04-15 10:20:51Z raasch
[4591]	79	! Last bugfix deactivated because of compile problems
	80	!
[4497]	81	! 4496 2020-04-15 08:37:26Z raasch
[4591]	82	! Problem with posix read arguments for surface data fixed
	83	!
[4496]	84	! 4495 2020-04-13 20:11:20Z raasch
[4628]	85	! Initial version (K. Ketelsen), adjusted to PALM formatting standards (S. Raasch)
[4495]	86	!
	87	!
	88	! Description:
	89	! ------------
	90	!> Routines for restart data handling using MPI-IO.
	91	!--------------------------------------------------------------------------------------------------!
	92	MODULE restart_data_mpi_io_mod
	93
	94	#if defined( __parallel )
	95	USE MPI
	96	#else
	97	USE posix_interface, &
[4591]	98	ONLY: posix_close, &
	99	posix_lseek, &
	100	posix_open, &
	101	posix_read, &
	102	posix_write
[4495]	103	#endif
	104
	105	USE, INTRINSIC :: ISO_C_BINDING
	106
	107	USE control_parameters, &
[4591]	108	ONLY: debug_output, &
	109	debug_string, &
	110	include_total_domain_boundaries, &
	111	message_string, &
	112	restart_data_format_input, &
	113	restart_data_format_output, &
	114	restart_file_size
[4495]	115
	116	USE exchange_horiz_mod, &
[4591]	117	ONLY: exchange_horiz, &
	118	exchange_horiz_2d
[4495]	119
	120	USE indices, &
[4591]	121	ONLY: nbgp, &
	122	nnx, &
	123	nny, &
	124	nx, &
	125	nxl, &
	126	nxlg, &
[4617]	127	nx_on_file, &
[4591]	128	nxr, &
	129	nxrg, &
	130	ny, &
	131	nyn, &
	132	nyng, &
[4617]	133	ny_on_file, &
[4591]	134	nys, &
	135	nysg, &
	136	nz, &
	137	nzb, &
	138	nzt
[4495]	139
	140	USE kinds
	141
[4628]	142	USE particle_attributes, &
	143	ONLY: grid_particles, &
	144	particles, &
	145	particle_type, &
	146	prt_count, &
	147	zero_particle
	148
[4495]	149	USE pegrid, &
[4591]	150	ONLY: comm1dx, &
	151	comm1dy, &
	152	comm2d, &
[4617]	153	communicator_configurations, &
[4591]	154	myid, &
	155	myidx, &
	156	myidy, &
	157	npex, &
	158	npey, &
	159	numprocs, &
	160	pdims
[4495]	161
[4534]	162	USE shared_memory_io_mod, &
[4617]	163	ONLY: domain_decomposition_grid_features, &
[4591]	164	sm_class
[4495]	165
[4534]	166
[4495]	167	IMPLICIT NONE
	168
[4591]	169	CHARACTER(LEN=128) :: io_file_name !> internal variable to communicate filename between different subroutines
[4495]	170
	171	#if defined( __parallel )
[4534]	172	INTEGER(iwp) :: ierr !< error status of MPI-calls
	173	INTEGER(iwp), PARAMETER :: rd_offset_kind = MPI_OFFSET_KIND !< Adress or Offset kind
	174	INTEGER(iwp), PARAMETER :: rd_status_size = MPI_STATUS_SIZE !<
[4495]	175	#else
[4534]	176	INTEGER(iwp), PARAMETER :: rd_offset_kind = C_SIZE_T !<
[4591]	177	INTEGER(iwp), PARAMETER :: rd_status_size = 1 !< Not required in sequential mode
[4495]	178	#endif
	179
[4591]	180	INTEGER(iwp) :: debug_level = 1 !< TODO: replace with standard debug output steering
[4495]	181
[4591]	182	INTEGER(iwp) :: comm_io !< Communicator for MPI-IO
[4628]	183	INTEGER(iwp) :: fh = -1 !< MPI-IO file handle
[4495]	184	#if defined( __parallel )
[4591]	185	INTEGER(iwp) :: fhs = -1 !< MPI-IO file handle to open file with comm2d always
[4495]	186	#endif
[4591]	187	INTEGER(iwp) :: ft_surf = -1 !< MPI filetype surface data
[4534]	188	#if defined( __parallel )
[4591]	189	INTEGER(iwp) :: ft_2di_nb !< MPI filetype 2D array INTEGER no outer boundary
	190	INTEGER(iwp) :: ft_2d !< MPI filetype 2D array REAL with outer boundaries
	191	INTEGER(iwp) :: ft_3d !< MPI filetype 3D array REAL with outer boundaries
[4628]	192	INTEGER(iwp) :: ft_3di4 = -1 !< MPI filetype 3D array INTEGER*4
	193	INTEGER(iwp) :: ft_3di8 = -1 !< MPI filetype 3D array INTEGER*8
[4591]	194	INTEGER(iwp) :: ft_3dsoil !< MPI filetype for 3d-soil array
[4534]	195	#endif
[4591]	196	INTEGER(iwp) :: glo_start !< global start index on this PE
[4534]	197	#if defined( __parallel )
[4591]	198	INTEGER(iwp) :: local_start !<
[4534]	199	#endif
[4591]	200	INTEGER(iwp) :: nr_iope !<
	201	INTEGER(iwp) :: nr_val !< local number of values in x and y direction
[4534]	202	#if defined( __parallel )
[4591]	203	INTEGER(iwp) :: win_2di !<
	204	INTEGER(iwp) :: win_2dr !<
[4628]	205	INTEGER(iwp) :: win_3di4 = -1 !<
	206	INTEGER(iwp) :: win_3di8 = -1 !<
[4591]	207	INTEGER(iwp) :: win_3dr !<
	208	INTEGER(iwp) :: win_3ds !<
	209	INTEGER(iwp) :: win_surf = -1 !<
[4534]	210	#endif
[4591]	211	INTEGER(iwp) :: total_number_of_surface_values !< total number of values for one variable
[4495]	212
	213	INTEGER(KIND=rd_offset_kind) :: array_position !<
	214	INTEGER(KIND=rd_offset_kind) :: header_position !<
	215
[4628]	216	INTEGER(iwp), DIMENSION(:,:), POINTER, CONTIGUOUS :: array_2di !<
[4534]	217
[4495]	218	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: m_end_index !<
[4591]	219	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: m_global_start !<
[4495]	220	INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: m_start_index !<
	221
[4628]	222	INTEGER(isp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: array_3di4 !<
	223	INTEGER(idp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: array_3di8 !<
[4534]	224
[4591]	225	LOGICAL :: all_pes_write !< all PEs have data to write
	226	LOGICAL :: filetypes_created !<
	227	LOGICAL :: io_on_limited_cores_per_node !< switch to shared memory MPI-IO
	228	LOGICAL :: rd_flag !< file is opened for read
	229	LOGICAL :: wr_flag !< file is opened for write
	230
[4534]	231	#if defined( __parallel )
	232	REAL(wp), DIMENSION(:), POINTER, CONTIGUOUS :: array_1d !<
	233	#endif
	234	REAL(wp), DIMENSION(:,:), POINTER, CONTIGUOUS :: array_2d !<
	235	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: array_3d !<
	236	REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: array_3d_soil !<
	237
[4495]	238	!
[4617]	239	!-- Variable to store the grid features (index bounds) of the temporary arrays that are used
	240	!-- to read and write the restart data. They differ depending on if the outer boundary of the
	241	!-- total domain is contained in the restart data or not. iog stands for IO-grid.
	242	TYPE(domain_decomposition_grid_features) :: iog !<
[4495]	243
	244	!
	245	!-- General Header (first 32 byte in restart file)
	246	TYPE general_header
[4591]	247	INTEGER(iwp) :: endian !< little endian (1) or big endian (2) internal format
	248	INTEGER(iwp) :: i_outer_bound !< if 1, outer boundaries are stored in restart file
	249	INTEGER(iwp) :: nr_arrays !< number of arrays in restart files
	250	INTEGER(iwp) :: nr_char !< number of Text strings entries in header
[4495]	251	INTEGER(iwp) :: nr_int !< number of INTEGER entries in header
	252	INTEGER(iwp) :: nr_real !< number of REAL entries in header
	253	INTEGER(iwp) :: total_nx !< total number of points in x-direction
	254	INTEGER(iwp) :: total_ny !< total number of points in y-direction
	255	END TYPE general_header
	256
[4591]	257	TYPE(general_header), TARGET :: tgh !<
[4495]	258
[4591]	259	TYPE(sm_class) :: sm_io !<
[4534]	260
[4495]	261	!
	262	!-- Declaration of varibales for file header section
	263	INTEGER(KIND=rd_offset_kind) :: header_int_index
	264	INTEGER, PARAMETER :: max_nr_int=256
	265	CHARACTER(LEN=32), DIMENSION(max_nr_int) :: int_names
	266	INTEGER(KIND=iwp), DIMENSION(max_nr_int) :: int_values
	267
	268	INTEGER(KIND=rd_offset_kind) :: header_char_index
[4539]	269	INTEGER, PARAMETER :: max_nr_char=128
	270	CHARACTER(LEN=128), DIMENSION(max_nr_char) :: text_lines
[4495]	271
	272	INTEGER(KIND=rd_offset_kind) :: header_real_index
	273	INTEGER, PARAMETER :: max_nr_real=256
	274	CHARACTER(LEN=32), DIMENSION(max_nr_real) :: real_names
	275	REAL(KIND=wp), DIMENSION(max_nr_real) :: real_values
	276
[4539]	277	INTEGER(KIND=rd_offset_kind) :: header_array_index
[4495]	278	INTEGER, PARAMETER :: max_nr_arrays=600
	279	CHARACTER(LEN=32), DIMENSION(max_nr_arrays) :: array_names
	280	INTEGER(KIND=rd_offset_kind), DIMENSION(max_nr_arrays) :: array_offset
[4617]	281
	282	!
	283	!-- Variables to handle the cyclic fill initialization mode
	284	INTEGER :: comm_cyclic_fill !< communicator for cyclic fill PEs
[4622]	285	#if defined( __parallel )
[4617]	286	INTEGER :: rmawin_2di !< RMA window 2d INTEGER
	287	INTEGER :: rmawin_2d !< RMA window 2d REAL
	288	INTEGER :: rmawin_3d !< RMA window 3d
[4622]	289	#endif
[4617]	290
	291	INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: remote_pe
	292	INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: remote_pe_s
	293	INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: rma_offset
	294	INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: rma_offset_s
	295	INTEGER(iwp), ALLOCATABLE, DIMENSION(:,:) :: rmabuf_2di
	296
	297	LOGICAL :: cyclic_fill_mode !< arrays are filled cyclically with data from prerun
	298	LOGICAL :: pe_active_for_read = .TRUE. !< this PE is active for reading data from prerun or
	299	!< restart run. For restarts all PEs are active.
	300
	301	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: rmabuf_2d
	302	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: rmabuf_3d
	303
	304	TYPE(domain_decomposition_grid_features) :: mainrun_grid !< grid variables for the main run
	305	TYPE(domain_decomposition_grid_features) :: prerun_grid !< grid variables for the prerun
	306
[4628]	307	!
	308	!-- MPI_INTEGER8 is not standard MPI, but is supported on most MPI distibutions
	309	!-- If not suppported, a workaround could be enabled with the following preprocessor directive
	310	!#if defined( __NO_INTEGER8)
	311	! INTEGER :: MPI_INTEGER8 !< MPI data type INTEGER8
	312	!#endif
[4617]	313
[4495]	314	SAVE
	315
	316	PRIVATE
	317
[4536]	318	PUBLIC restart_file_size, total_number_of_surface_values
[4495]	319
	320	!
	321	!-- PALM interfaces
	322	INTERFACE rd_mpi_io_check_array
	323	MODULE PROCEDURE rd_mpi_io_check_array
	324	END INTERFACE rd_mpi_io_check_array
	325
	326	INTERFACE rd_mpi_io_close
	327	MODULE PROCEDURE rd_mpi_io_close
	328	END INTERFACE rd_mpi_io_close
	329
[4628]	330	INTERFACE rd_mpi_io_check_open
	331	MODULE PROCEDURE rd_mpi_io_check_open
	332	END INTERFACE rd_mpi_io_check_open
	333
[4495]	334	INTERFACE rd_mpi_io_open
	335	MODULE PROCEDURE rd_mpi_io_open
	336	END INTERFACE rd_mpi_io_open
	337
	338	INTERFACE rrd_mpi_io
	339	MODULE PROCEDURE rrd_mpi_io_char
	340	MODULE PROCEDURE rrd_mpi_io_int
	341	MODULE PROCEDURE rrd_mpi_io_int_2d
[4628]	342	MODULE PROCEDURE rrd_mpi_io_int4_3d
	343	MODULE PROCEDURE rrd_mpi_io_int8_3d
[4495]	344	MODULE PROCEDURE rrd_mpi_io_logical
[4735]	345	MODULE PROCEDURE rrd_mpi_io_logical_3d
[4495]	346	MODULE PROCEDURE rrd_mpi_io_real
	347	MODULE PROCEDURE rrd_mpi_io_real_2d
	348	MODULE PROCEDURE rrd_mpi_io_real_3d
	349	MODULE PROCEDURE rrd_mpi_io_real_3d_soil
	350	END INTERFACE rrd_mpi_io
	351
	352	INTERFACE rrd_mpi_io_global_array
	353	MODULE PROCEDURE rrd_mpi_io_global_array_int_1d
	354	MODULE PROCEDURE rrd_mpi_io_global_array_real_1d
	355	MODULE PROCEDURE rrd_mpi_io_global_array_real_2d
	356	MODULE PROCEDURE rrd_mpi_io_global_array_real_3d
	357	MODULE PROCEDURE rrd_mpi_io_global_array_real_4d
	358	END INTERFACE rrd_mpi_io_global_array
	359
	360	INTERFACE rrd_mpi_io_surface
	361	MODULE PROCEDURE rrd_mpi_io_surface
	362	MODULE PROCEDURE rrd_mpi_io_surface_2d
	363	END INTERFACE rrd_mpi_io_surface
	364
[4628]	365	INTERFACE rrd_mpi_io_particles
	366	MODULE PROCEDURE rrd_mpi_io_particles
	367	END INTERFACE rrd_mpi_io_particles
	368
	369	INTERFACE rd_mpi_io_particle_filetypes
	370	MODULE PROCEDURE rd_mpi_io_particle_filetypes
	371	END INTERFACE rd_mpi_io_particle_filetypes
	372
[4495]	373	INTERFACE rd_mpi_io_surface_filetypes
	374	MODULE PROCEDURE rd_mpi_io_surface_filetypes
	375	END INTERFACE rd_mpi_io_surface_filetypes
	376
	377	INTERFACE wrd_mpi_io
	378	MODULE PROCEDURE wrd_mpi_io_char
	379	MODULE PROCEDURE wrd_mpi_io_int
	380	MODULE PROCEDURE wrd_mpi_io_int_2d
[4628]	381	MODULE PROCEDURE wrd_mpi_io_int4_3d
	382	MODULE PROCEDURE wrd_mpi_io_int8_3d
[4495]	383	MODULE PROCEDURE wrd_mpi_io_logical
[4735]	384	MODULE PROCEDURE wrd_mpi_io_logical_3d
[4495]	385	MODULE PROCEDURE wrd_mpi_io_real
	386	MODULE PROCEDURE wrd_mpi_io_real_2d
	387	MODULE PROCEDURE wrd_mpi_io_real_3d
	388	MODULE PROCEDURE wrd_mpi_io_real_3d_soil
	389	END INTERFACE wrd_mpi_io
	390
	391	INTERFACE wrd_mpi_io_global_array
	392	MODULE PROCEDURE wrd_mpi_io_global_array_int_1d
	393	MODULE PROCEDURE wrd_mpi_io_global_array_real_1d
	394	MODULE PROCEDURE wrd_mpi_io_global_array_real_2d
	395	MODULE PROCEDURE wrd_mpi_io_global_array_real_3d
	396	MODULE PROCEDURE wrd_mpi_io_global_array_real_4d
	397	END INTERFACE wrd_mpi_io_global_array
	398
[4628]	399	INTERFACE wrd_mpi_io_particles
	400	MODULE PROCEDURE wrd_mpi_io_particles
	401	END INTERFACE wrd_mpi_io_particles
	402
[4495]	403	INTERFACE wrd_mpi_io_surface
	404	MODULE PROCEDURE wrd_mpi_io_surface
	405	MODULE PROCEDURE wrd_mpi_io_surface_2d
	406	END INTERFACE wrd_mpi_io_surface
	407
[4591]	408	PUBLIC rd_mpi_io_check_array, &
[4628]	409	rd_mpi_io_check_open, &
[4591]	410	rd_mpi_io_close, &
	411	rd_mpi_io_open, &
[4628]	412	rd_mpi_io_particle_filetypes, &
	413	rd_mpi_io_surface_filetypes, &
[4591]	414	rrd_mpi_io, &
	415	rrd_mpi_io_global_array, &
[4628]	416	rrd_mpi_io_particles, &
[4591]	417	rrd_mpi_io_surface, &
	418	wrd_mpi_io, &
	419	wrd_mpi_io_global_array, &
[4628]	420	wrd_mpi_io_particles, &
[4591]	421	wrd_mpi_io_surface
[4495]	422
	423
	424	CONTAINS
	425
	426
	427	!--------------------------------------------------------------------------------------------------!
	428	! Description:
	429	! ------------
	430	!> Open restart file for read or write with MPI-IO
	431	!--------------------------------------------------------------------------------------------------!
[4534]	432	SUBROUTINE rd_mpi_io_open( action, file_name, open_for_global_io_only )
[4495]	433
	434	IMPLICIT NONE
	435
[4591]	436	CHARACTER(LEN=*), INTENT(IN) :: action !<
	437	CHARACTER(LEN=*), INTENT(IN) :: file_name !<
[4495]	438
[4591]	439	INTEGER(iwp) :: i !<
	440	INTEGER(iwp) :: gh_size !<
[4495]	441
[4591]	442	INTEGER(KIND=rd_offset_kind) :: offset !<
[4495]	443
	444	#if defined( __parallel )
[4591]	445	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	446	#endif
	447
[4591]	448	LOGICAL, INTENT(IN), OPTIONAL :: open_for_global_io_only !<
	449	LOGICAL :: set_filetype !<
[4534]	450
[4495]	451	#if ! defined( __parallel )
[4591]	452	TYPE(C_PTR) :: buf_ptr !<
[4495]	453	#endif
	454
	455	offset = 0
[4536]	456	io_on_limited_cores_per_node = .FALSE.
[4495]	457
	458	rd_flag = ( TRIM( action ) == 'READ' .OR. TRIM( action ) == 'read' )
	459	wr_flag = ( TRIM( action ) == 'WRITE' .OR. TRIM( action ) == 'write' )
	460
[4536]	461	IF ( .NOT. ( rd_flag .OR. wr_flag ) ) THEN
	462	message_string = 'illegal action "' // TRIM( action ) // '" for opening restart files'
	463	CALL message( 'restart_data_mpi_io_mod', 'PA0720', 1, 2, 0, 6, 0 )
	464	ENDIF
[4495]	465	!
[4534]	466	!-- Store name of I/O file to communicate it internally within this module.
	467	io_file_name = file_name
	468	!
	469	!-- Setup for IO on a limited number of threads per node (using shared memory MPI)
[4536]	470	IF ( rd_flag ) THEN
	471	set_filetype = .TRUE.
	472	IF ( TRIM( restart_data_format_input ) == 'mpi_shared_memory' ) THEN
	473	io_on_limited_cores_per_node = .TRUE.
	474	ENDIF
	475	ENDIF
	476
	477	IF ( TRIM( restart_data_format_output ) == 'mpi_shared_memory' .AND. wr_flag ) THEN
[4534]	478	io_on_limited_cores_per_node = .TRUE.
	479	ENDIF
	480	!
	481	!-- Shared memory MPI is not used for reading of global data
	482	IF ( PRESENT( open_for_global_io_only ) .AND. rd_flag ) THEN
	483	IF ( open_for_global_io_only ) THEN
	484	io_on_limited_cores_per_node = .FALSE.
	485	set_filetype = .FALSE.
	486	ENDIF
	487	ENDIF
	488
[4617]	489	!
	490	!-- Determine, if prerun data shall be read and mapped cyclically to the mainrun arrays.
	491	!-- In cyclic fill mode only a subset of the PEs will read.
	492	cyclic_fill_mode = .FALSE.
	493	pe_active_for_read = .TRUE.
[4534]	494
[4617]	495	IF ( rd_flag .AND. .NOT. PRESENT( open_for_global_io_only ) .AND. &
	496	nx_on_file < nx .AND. ny_on_file < ny ) THEN
	497	cyclic_fill_mode = .TRUE.
	498	CALL setup_cyclic_fill
[4534]	499	!
[4617]	500	!-- Shared memory IO on limited cores is not allowed for cyclic fill mode
	501	CALL sm_io%sm_init_comm( .FALSE. ) !
	502	ELSE
	503	CALL sm_io%sm_init_comm( io_on_limited_cores_per_node )
	504	ENDIF
	505
	506	!
	507	!-- TODO: add a more detailed meaningful comment about what is happening here
	508	!-- activate model grid
	509	IF( cyclic_fill_mode .AND. .NOT. pe_active_for_read ) THEN
	510	CALL mainrun_grid%activate_grid_from_this_class()
	511	RETURN
	512	ENDIF
	513
	514
	515	!
[4534]	516	!-- Set communicator to be used. If all cores are doing I/O, comm2d is used as usual.
	517	IF( sm_io%is_sm_active() ) THEN
	518	comm_io = sm_io%comm_io
[4617]	519	ELSEIF ( cyclic_fill_mode ) THEN
	520	comm_io = comm_cyclic_fill
[4534]	521	ELSE
	522	comm_io = comm2d
	523	ENDIF
	524
	525	!
[4495]	526	!-- Create subarrays and file types
	527	filetypes_created = .FALSE.
	528
	529	!
	530	!-- In case of read it is not known yet if data include total domain. Filetypes will be created
	531	!-- further below.
[4536]	532	IF ( wr_flag ) THEN
[4534]	533	CALL rd_mpi_io_create_filetypes
[4495]	534	filetypes_created = .TRUE.
	535	ENDIF
	536
	537	!
	538	!-- Open file for MPI-IO
	539	#if defined( __parallel )
[4534]	540	IF ( sm_io%iam_io_pe ) THEN
[4536]	541
[4534]	542	IF ( rd_flag ) THEN
[4536]	543
	544	IF ( debug_output ) THEN
	545	WRITE( debug_string, * ) 'open joint restart file "' // TRIM( io_file_name ) // &
	546	'" for read with MPI-IO'
	547	CALL debug_message( debug_string, 'start' )
	548	ENDIF
	549
[4534]	550	CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fh, &
	551	ierr )
[4536]	552
	553	IF ( ierr /= 0 ) THEN
[4591]	554	message_string = 'error opening restart file "' // TRIM( io_file_name ) // &
[4536]	555	'" for reading with MPI-IO'
	556	CALL message( 'rrd_mpi_io_open', 'PA0727', 3, 2, 0, 6, 0 )
	557	ENDIF
	558
	559	IF ( debug_output ) THEN
	560	WRITE( debug_string, * ) 'open joint restart file "' // TRIM( io_file_name ) // &
	561	'" for read with MPI-IO'
	562	CALL debug_message( debug_string, 'end' )
	563	ENDIF
	564
[4534]	565	ELSEIF ( wr_flag ) THEN
[4536]	566
	567	IF ( debug_output ) THEN
	568	WRITE( debug_string, * ) 'open joint restart file "' // TRIM( io_file_name ) // &
	569	'" for write with MPI-IO'
	570	CALL debug_message( debug_string, 'start' )
	571	ENDIF
	572
[4534]	573	CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_CREATE+MPI_MODE_WRONLY, &
	574	MPI_INFO_NULL, fh, ierr )
[4536]	575
	576	IF ( ierr /= 0 ) THEN
[4591]	577	message_string = 'error opening restart file "' // TRIM( io_file_name ) // &
[4536]	578	'" for writing with MPI-IO'
	579	CALL message( 'rrd_mpi_io_open', 'PA0728', 3, 2, 0, 6, 0 )
	580	ENDIF
	581
	582	IF ( debug_output ) THEN
	583	WRITE( debug_string, * ) 'open joint restart file "' // TRIM( io_file_name ) // &
	584	'" for write with MPI-IO'
	585	CALL debug_message( debug_string, 'end' )
	586	ENDIF
	587
[4534]	588	ENDIF
[4536]	589
[4495]	590	ENDIF
	591	#else
	592	IF ( rd_flag ) THEN
[4536]	593
	594	IF ( debug_output ) THEN
[4591]	595	WRITE( debug_string, * ) 'open restart file "' // TRIM( io_file_name ) // &
[4536]	596	'" for read in serial mode (posix)'
	597	CALL debug_message( debug_string, 'start' )
	598	ENDIF
	599
[4534]	600	fh = posix_open( TRIM( io_file_name ), .TRUE. )
[4536]	601
	602	IF ( debug_output ) THEN
[4591]	603	WRITE( debug_string, * ) 'open restart file "' // TRIM( io_file_name ) // &
[4536]	604	'" for read in serial mode (posix)'
	605	CALL debug_message( debug_string, 'end' )
	606	ENDIF
	607
[4495]	608	ELSEIF ( wr_flag ) THEN
[4536]	609
	610	IF ( debug_output ) THEN
[4591]	611	WRITE( debug_string, * ) 'open restart file "' // TRIM( io_file_name ) // &
[4536]	612	'" for write in serial mode (posix)'
	613	CALL debug_message( debug_string, 'start' )
	614	ENDIF
	615
[4534]	616	fh = posix_open( TRIM( io_file_name ), .FALSE. )
[4536]	617
	618	IF ( debug_output ) THEN
[4591]	619	WRITE( debug_string, * ) 'open restart file "' // TRIM( io_file_name ) // &
[4536]	620	'" for write in serial mode (posix)'
	621	CALL debug_message( debug_string, 'end' )
	622	ENDIF
	623
[4495]	624	ENDIF
	625
[4536]	626	IF ( fh < 0 ) THEN
	627	message_string = 'error opening restart file for posix I/O'
	628	CALL message( 'restart_data_mpi_io_mod', 'PA0721', 1, 2, 0, 6, 0 )
	629	ENDIF
[4495]	630	#endif
	631
	632	array_position = 65536 !> Start offset for writing 2-D and 3.D arrays at 64 k
	633	header_position = 0
	634
	635	header_int_index = 1
	636	header_char_index = 1
[4539]	637	header_real_index = 1
	638	header_array_index = 1
[4495]	639
	640	int_names = ' '
	641	int_values = 0
	642	text_lines = ' '
	643	real_names = ' '
	644	real_values = 0.0
	645	array_names = ' '
	646	array_offset = 0
	647
	648	int_names(1) = 'nx'
	649	int_values(1) = nx
	650	int_names(2) = 'ny'
	651	int_values(2) = ny
	652	int_names(3) = 'nz'
	653	int_values(3) = nz
	654	header_int_index = header_int_index+3
	655
[4591]	656	DO i = 1, max_nr_arrays
[4495]	657	array_offset(i) = 0
	658	array_names(i) = ' '
	659	ENDDO
	660
	661	gh_size = STORAGE_SIZE( tgh ) / 8
	662
	663	IF ( rd_flag ) THEN
[4534]	664	IF ( sm_io%iam_io_pe ) THEN
[4495]	665	!
[4591]	666	!-- File is open for reading
[4495]	667	#if defined( __parallel )
[4534]	668	!-- Set the default view
	669	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
[4495]	670	!
[4534]	671	!-- Read the file header size
	672	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	673	CALL MPI_FILE_READ( fh, tgh, gh_size, MPI_BYTE, status, ierr )
[4495]	674	#else
[4534]	675	CALL posix_lseek( fh, header_position )
	676	buf_ptr = C_LOC( tgh )
	677	CALL posix_read( fh, buf_ptr, gh_size )
[4495]	678	#endif
[4534]	679	ENDIF
	680	#if defined( __parallel )
	681	IF ( sm_io%is_sm_active() ) THEN
	682	CALL MPI_BCAST( tgh, gh_size, MPI_BYTE, 0, sm_io%comm_shared, ierr )
	683	ENDIF
	684	#endif
[4495]	685	header_position = header_position + gh_size
	686
	687	include_total_domain_boundaries = ( tgh%i_outer_bound == 1 )
	688
	689	!
[4591]	690	!-- File types depend on boundaries of the total domain being included in data. This has been
[4498]	691	!-- checked with the previous statement.
[4534]	692	IF ( set_filetype ) THEN
	693	CALL rd_mpi_io_create_filetypes
	694	filetypes_created = .TRUE.
	695	ENDIF
[4495]	696
[4534]	697	IF ( sm_io%iam_io_pe ) THEN
[4495]	698	#if defined( __parallel )
	699	!
[4534]	700	!-- Read INTEGER values
	701	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	702	CALL MPI_FILE_READ( fh, int_names, SIZE( int_names ) * 32, MPI_CHAR, status, ierr )
	703	header_position = header_position + SIZE( int_names ) * 32
[4495]	704
[4534]	705	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	706	CALL MPI_FILE_READ (fh, int_values, SIZE( int_values ), MPI_INT, status, ierr )
	707	header_position = header_position + SIZE( int_values ) * iwp
[4495]	708	!
[4534]	709	!-- Character entries
	710	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	711	CALL MPI_FILE_READ( fh, text_lines, SIZE( text_lines ) * 128, MPI_CHAR, status, ierr )
[4591]	712	header_position = header_position + SIZE ( text_lines ) * 128
[4495]	713	!
[4534]	714	!-- REAL values
	715	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	716	CALL MPI_FILE_READ( fh, real_names, SIZE( real_names ) * 32, MPI_CHAR, status, ierr )
	717	header_position = header_position + SIZE( real_names ) * 32
[4495]	718
[4534]	719	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	720	CALL MPI_FILE_READ( fh, real_values, SIZE( real_values ), MPI_REAL, status, ierr )
	721	header_position = header_position + SIZE( real_values ) * wp
[4495]	722	!
[4534]	723	!-- 2d- and 3d-array headers
	724	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	725	CALL MPI_FILE_READ( fh, array_names, SIZE( array_names ) * 32, MPI_CHAR, status, ierr )
	726	header_position = header_position + SIZE( array_names ) * 32
[4495]	727
[4534]	728	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	729	CALL MPI_FILE_READ( fh, array_offset, SIZE( array_offset ) * MPI_OFFSET_KIND, MPI_BYTE, &
	730	status,ierr ) ! there is no I*8 datatype in Fortran
	731	header_position = header_position + SIZE( array_offset ) * rd_offset_kind
[4495]	732	#else
[4534]	733	CALL posix_lseek( fh, header_position )
	734	CALL posix_read( fh, int_names )
	735	header_position = header_position + SIZE( int_names ) * 32
[4495]	736
[4534]	737	CALL posix_lseek( fh, header_position )
	738	CALL posix_read( fh, int_values, SIZE( int_values ) )
	739	header_position = header_position + SIZE( int_values ) * iwp
[4495]	740	!
[4534]	741	!-- Character entries
	742	CALL posix_lseek( fh, header_position )
	743	CALL posix_read( fh, text_lines )
	744	header_position = header_position + SIZE( text_lines ) * 128
[4495]	745	!
[4534]	746	!-- REAL values
	747	CALL posix_lseek( fh, header_position )
	748	CALL posix_read( fh, real_names )
	749	header_position = header_position + SIZE( real_names ) * 32
[4495]	750
[4534]	751	CALL posix_lseek( fh, header_position )
	752	CALL posix_read( fh, real_values, SIZE( real_values ) )
	753	header_position = header_position + SIZE( real_values ) * wp
[4495]	754	!
[4534]	755	!-- 2d- and 3d-array headers
	756	CALL posix_lseek( fh, header_position )
	757	CALL posix_read( fh, array_names )
	758	header_position = header_position + SIZE( array_names ) * 32
[4495]	759
[4534]	760	CALL posix_lseek( fh, header_position )
	761	CALL posix_read( fh, array_offset, SIZE( array_offset ) ) ! there is no I*8 datatype in Fortran
	762	header_position = header_position + SIZE( array_offset ) * rd_offset_kind
[4495]	763	#endif
[4536]	764	IF ( debug_output ) CALL rd_mpi_io_print_header
[4534]	765
[4495]	766	ENDIF
	767
[4534]	768	#if defined( __parallel )
	769	!
	770	!-- Broadcast header to all remaining cores that are not involved in I/O
	771	IF ( sm_io%is_sm_active() ) THEN
	772	!
	773	!-- Not sure, that it is possible to broadcast CHARACTER array in one MPI_Bcast call
	774	DO i = 1, SIZE( int_names )
	775	CALL MPI_BCAST( int_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
	776	ENDDO
	777	CALL MPI_BCAST( int_values, SIZE( int_values ), MPI_INTEGER, 0, sm_io%comm_shared, ierr )
[4495]	778
[4534]	779	DO i = 1, SIZE( text_lines )
	780	CALL MPI_BCAST( text_lines(i), 128, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
	781	ENDDO
	782
	783	DO i = 1, SIZE( real_names )
	784	CALL MPI_BCAST( real_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
	785	ENDDO
	786	CALL MPI_BCAST( real_values, SIZE( real_values ), MPI_REAL, 0, sm_io%comm_shared, ierr )
	787
	788	DO i = 1, SIZE( array_names )
	789	CALL MPI_BCAST( array_names(i), 32, MPI_CHARACTER, 0, sm_io%comm_shared, ierr )
	790	ENDDO
	791	CALL MPI_BCAST( array_offset, SIZE( array_offset )*8, MPI_BYTE, 0, sm_io%comm_shared, &
	792	ierr ) ! there is no I8 datatype in Fortran (array_offset is I8!)
	793
	794	CALL MPI_BCAST( header_position, rd_offset_kind, MPI_BYTE, 0, sm_io%comm_shared, ierr )
	795
	796	ENDIF
	797	#endif
	798
[4617]	799
[4495]	800	ENDIF
	801
[4617]	802	!
	803	!-- TODO: describe in more detail what is happening here
	804	!-- activate model grid
	805	IF ( cyclic_fill_mode ) CALL mainrun_grid%activate_grid_from_this_class()
	806
	807	CONTAINS
	808
	809	SUBROUTINE setup_cyclic_fill
	810
	811	IMPLICIT NONE
	812
	813	INTEGER :: color !< used to set the IO PEs for MPI_COMM_SPLIT
	814	INTEGER(iwp) :: i !<
	815	INTEGER(iwp) :: j !<
[4621]	816	#if defined( __parallel )
[4622]	817	INTEGER :: ierr !<
[4617]	818	INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !< size of RMA window
[4621]	819	#else
	820	INTEGER(idp) :: winsize
	821	#endif
[4617]	822
	823	!
	824	!-- TODO: describe in more detail what is done here and why it is done
	825	!-- save grid of main run
	826	CALL mainrun_grid%save_grid_into_this_class()
	827
	828	ALLOCATE( remote_pe(0:nx_on_file,0:ny_on_file) )
	829	ALLOCATE( remote_pe_s(0:nx_on_file,0:ny_on_file) )
	830	ALLOCATE( rma_offset(0:nx_on_file,0:ny_on_file) )
	831	ALLOCATE( rma_offset_s(0:nx_on_file,0:ny_on_file) )
	832
	833	remote_pe_s = 0
	834	rma_offset_s = 0
	835	!
	836	!-- Determine, if gridpoints of the prerun are located on this thread.
	837	!-- Set the (cyclic) prerun grid.
	838	nxr = MIN( nxr, nx_on_file )
	839	IF ( nxl > nx_on_file ) THEN
	840	nxl = -99
	841	nxr = -99
	842	nnx = 0
	843	ELSE
	844	nnx =nxr-nxl+1
	845	ENDIF
	846
	847	nyn = MIN( nyn, ny_on_file )
	848	IF ( nys > ny_on_file ) THEN
	849	nys = -99
	850	nyn = -99
	851	nny = 0
	852	ELSE
	853	nny = nyn-nys+1
	854	ENDIF
	855
	856	nx = nx_on_file
	857	ny = ny_on_file
	858	!
	859	!-- Determine, if this thread is doing IO
	860	IF ( nnx > 0 .AND. nny > 0 ) THEN
	861	color = 1
	862	pe_active_for_read = .TRUE.
	863	remote_pe_s(nxl:nxr,nys:nyn) = myid ! myid from comm2d
	864	DO j = nys, nyn
	865	DO i = nxl, nxr
	866	rma_offset_s(i,j) = ( j-nys ) + ( i-nxl ) * nny
	867	ENDDO
	868	ENDDO
	869	ELSE
[4621]	870	#if defined( __parallel )
[4617]	871	color = MPI_UNDEFINED
[4621]	872	#endif
[4617]	873	pe_active_for_read = .FALSE.
	874	ENDIF
	875
	876	#if defined( __parallel )
	877	CALL MPI_ALLREDUCE( remote_pe_s, remote_pe, SIZE(remote_pe_s), MPI_INTEGER, MPI_SUM, &
	878	comm2d, ierr )
	879	CALL MPI_ALLREDUCE( rma_offset_s, rma_offset, SIZE(rma_offset_s), MPI_INTEGER, MPI_SUM, &
	880	comm2d, ierr )
	881	CALL MPI_COMM_SPLIT( comm2d, color, 0, comm_cyclic_fill, ierr )
	882
	883	IF ( pe_active_for_read ) THEN
	884	CALL MPI_COMM_SIZE( comm_cyclic_fill, numprocs, ierr )
	885	CALL MPI_COMM_RANK( comm_cyclic_fill, myid, ierr )
	886	ENDIF
	887	#else
	888	remote_pe = remote_pe_s
	889	rma_offset = rma_offset_s
	890	myid = 0
	891	numprocs = 1
	892	#endif
	893	!
	894	!-- Allocate 2d buffers as RMA window, accessible on all threads
	895	IF ( pe_active_for_read ) THEN
	896	ALLOCATE( rmabuf_2di(nys:nyn,nxl:nxr) )
	897	ELSE
	898	ALLOCATE( rmabuf_2di(1,1) )
	899	ENDIF
	900	winsize = SIZE( rmabuf_2di ) * iwp
	901
	902	#if defined( __parallel )
	903	CALL MPI_WIN_CREATE( rmabuf_2di, winsize, iwp, MPI_INFO_NULL, comm2d, rmawin_2di, ierr )
	904	CALL MPI_WIN_FENCE( 0, rmawin_2di, ierr )
	905	#endif
	906
	907	IF ( pe_active_for_read ) THEN
	908	ALLOCATE( rmabuf_2d(nys:nyn,nxl:nxr) )
	909	ELSE
	910	ALLOCATE( rmabuf_2d(1,1) )
	911	ENDIF
	912	winsize = SIZE( rmabuf_2d ) * wp
	913
	914	#if defined( __parallel )
	915	CALL MPI_WIN_CREATE( rmabuf_2d, winsize, wp, MPI_INFO_NULL, comm2d, rmawin_2d, ierr )
	916	CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
	917	#endif
	918
	919	!
	920	!-- Allocate 3d buffer as RMA window, accessable on all threads
	921	IF ( pe_active_for_read ) THEN
	922	ALLOCATE( rmabuf_3d(nzb:nzt+1,nys:nyn,nxl:nxr) )
	923	ELSE
	924	ALLOCATE( rmabuf_3d(1,1,1) )
	925	ENDIF
	926	winsize = SIZE( rmabuf_3d ) * wp
	927
	928	#if defined( __parallel )
	929	CALL MPI_WIN_CREATE( rmabuf_3d, winsize, wp, MPI_INFO_NULL, comm2d, rmawin_3d, ierr )
	930	CALL MPI_WIN_FENCE( 0, rmawin_3d, ierr )
	931	#endif
	932
	933	!
	934	!-- TODO: comment in more detail, what is done here, and why
	935	!-- save small grid
	936	CALL prerun_grid%save_grid_into_this_class()
	937	prerun_grid%comm2d = comm_cyclic_fill
	938
	939	DEALLOCATE( remote_pe_s, rma_offset_s )
	940
	941	END SUBROUTINE setup_cyclic_fill
	942
[4495]	943	END SUBROUTINE rd_mpi_io_open
	944
	945
	946	!--------------------------------------------------------------------------------------------------!
	947	! Description:
	948	! ------------
	949	!> Check, if array exists in restart file
	950	!--------------------------------------------------------------------------------------------------!
	951	SUBROUTINE rd_mpi_io_check_array( name, found )
	952
	953	IMPLICIT NONE
	954
	955	CHARACTER(LEN=*), INTENT(IN) :: name !<
	956
	957	INTEGER(iwp) :: i !<
	958
[4591]	959	LOGICAl :: found !<
[4495]	960
	961
	962	DO i = 1, tgh%nr_arrays
	963	IF ( TRIM( array_names(i) ) == TRIM( name ) ) THEN
	964	array_position = array_offset(i)
	965	found = .TRUE.
	966	RETURN
	967	ENDIF
	968	ENDDO
	969
	970	found = .FALSE.
	971
	972	END SUBROUTINE rd_mpi_io_check_array
	973
	974
	975
	976	!--------------------------------------------------------------------------------------------------!
	977	! Description:
	978	! ------------
	979	!> Read INTEGER with MPI-IO
	980	!--------------------------------------------------------------------------------------------------!
[4536]	981	SUBROUTINE rrd_mpi_io_int( name, value )
[4495]	982
	983	IMPLICIT NONE
	984
[4591]	985	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	986
[4591]	987	INTEGER(iwp) :: i !<
	988	INTEGER(KIND=iwp), INTENT(OUT) :: value !<
[4495]	989
[4591]	990	LOGICAL :: found !<
[4495]	991
	992
[4536]	993	found = .FALSE.
[4495]	994	value = 0
	995
	996	DO i = 1, tgh%nr_int
	997	IF ( TRIM(int_names(i)) == TRIM( name ) ) THEN
	998	value = int_values(i)
[4536]	999	found = .TRUE.
[4495]	1000	EXIT
	1001	ENDIF
	1002	ENDDO
	1003
[4536]	1004	IF ( .NOT. found ) THEN
	1005	message_string = 'INTEGER variable "' // TRIM( name ) // '" not found in restart file'
	1006	CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
[4495]	1007	ENDIF
	1008
	1009	END SUBROUTINE rrd_mpi_io_int
	1010
	1011
	1012
	1013	!--------------------------------------------------------------------------------------------------!
	1014	! Description:
	1015	! ------------
	1016	!> Read REAL with MPI-IO
	1017	!--------------------------------------------------------------------------------------------------!
[4536]	1018	SUBROUTINE rrd_mpi_io_real( name, value )
[4495]	1019
	1020	IMPLICIT NONE
	1021
[4591]	1022	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	1023
[4591]	1024	INTEGER(iwp) :: i !<
[4495]	1025
[4591]	1026	LOGICAL :: found !<
[4495]	1027
[4591]	1028	REAL(KIND=wp), INTENT(OUT) :: value !<
[4495]	1029
	1030
[4536]	1031	found = .FALSE.
[4495]	1032	value = 0.0
	1033
	1034	DO i = 1, tgh%nr_real
	1035	IF ( TRIM(real_names(i)) == TRIM( name ) ) THEN
	1036	value = real_values(i)
[4536]	1037	found = .TRUE.
[4495]	1038	EXIT
	1039	ENDIF
	1040	ENDDO
	1041
[4536]	1042	IF ( .NOT. found ) THEN
	1043	message_string = 'REAL variable "' // TRIM( name ) // '" not found in restart file'
	1044	CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
[4495]	1045	ENDIF
	1046
	1047	END SUBROUTINE rrd_mpi_io_real
	1048
	1049
	1050
	1051	!--------------------------------------------------------------------------------------------------!
	1052	! Description:
	1053	! ------------
	1054	!> Read 2d-real array with MPI-IO
	1055	!--------------------------------------------------------------------------------------------------!
	1056	SUBROUTINE rrd_mpi_io_real_2d( name, data )
	1057
	1058	IMPLICIT NONE
	1059
[4591]	1060	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	1061
	1062	#if defined( __parallel )
[4591]	1063	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	1064	#endif
[4591]	1065	INTEGER(iwp) :: i !<
[4495]	1066
[4591]	1067	LOGICAL :: found !<
[4495]	1068
[4591]	1069	REAL(wp), INTENT(INOUT), DIMENSION(nysg:nyng,nxlg:nxrg) :: data !<
[4495]	1070
	1071
	1072	found = .FALSE.
	1073
	1074	DO i = 1, tgh%nr_arrays
	1075	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	1076	array_position = array_offset(i)
	1077	found = .TRUE.
	1078	EXIT
	1079	ENDIF
	1080	ENDDO
	1081
[4534]	1082	IF ( found ) THEN
[4617]	1083
	1084	IF ( cyclic_fill_mode ) THEN
	1085
	1086	CALL rrd_mpi_io_real_2d_cyclic_fill
	1087
	1088	ELSE
	1089
[4495]	1090	#if defined( __parallel )
[4617]	1091	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited # of cores is inactive
	1092	IF ( sm_io%iam_io_pe ) THEN
	1093	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, &
	1094	ierr )
	1095	CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d ), MPI_REAL, status, ierr )
	1096	ENDIF
	1097	CALL sm_io%sm_node_barrier()
[4495]	1098	#else
[4617]	1099	CALL posix_lseek( fh, array_position )
	1100	CALL posix_read( fh, array_2d, SIZE( array_2d ) )
[4495]	1101	#endif
	1102
[4617]	1103	IF ( include_total_domain_boundaries ) THEN
	1104	DO i = iog%nxl, iog%nxr
	1105	data(iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_2d(i,iog%nys:iog%nyn)
	1106	ENDDO
	1107	IF ( debug_level >= 2) THEN
	1108	WRITE(9,*) 'r2f_ob ', TRIM(name),' ', SUM( data(nys:nyn,nxl:nxr) )
	1109	ENDIF
	1110	ELSE
	1111	DO i = nxl, nxr
	1112	data(nys:nyn,i) = array_2d(i,nys:nyn)
	1113	ENDDO
	1114	IF ( debug_level >= 2) THEN
	1115	WRITE(9,*) 'r2f ', TRIM( name ),' ', SUM( data(nys:nyn,nxl:nxr) )
	1116	ENDIF
	1117	ENDIF
	1118
[4534]	1119	ENDIF
[4495]	1120
[4534]	1121	CALL exchange_horiz_2d( data )
[4495]	1122
[4534]	1123	ELSE
[4536]	1124	message_string = '2d-REAL array "' // TRIM( name ) // '" not found in restart file'
	1125	CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
[4534]	1126	ENDIF
[4495]	1127
[4617]	1128
	1129	CONTAINS
	1130
	1131	SUBROUTINE rrd_mpi_io_real_2d_cyclic_fill
	1132
	1133	IMPLICIT NONE
	1134
	1135	INTEGER(iwp) :: i !<
	1136	INTEGER(iwp) :: ie !<
	1137	INTEGER(iwp) :: is !<
	1138	INTEGER(iwp) :: i_remote !<
	1139	INTEGER(iwp) :: j !<
	1140	INTEGER(iwp) :: je !<
	1141	INTEGER(iwp) :: js !<
	1142	INTEGER(iwp) :: j_remote !<
	1143	INTEGER(iwp) :: nval !<
	1144	INTEGER(iwp) :: rem_pe !<
	1145
[4621]	1146	#if defined( __parallel )
[4622]	1147	INTEGER(iwp) :: ierr !<
[4617]	1148	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_offs !<
[4621]	1149	#else
	1150	INTEGER(idp) :: rem_offs
	1151	#endif
[4617]	1152
	1153
	1154	!kk write(9,*) 'Here is rma_cylic_fill_real_2d ',nxl,nxr,nys,nyn; FLUSH(9)
	1155
	1156	!
	1157	!-- Reading 2d real array on prerun grid
	1158	CALL prerun_grid%activate_grid_from_this_class()
	1159
	1160	IF ( pe_active_for_read ) THEN
[4621]	1161	#if defined( __parallel )
[4617]	1162	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, &
	1163	ierr )
	1164	CALL MPI_FILE_READ_ALL( fh, array_2d, SIZE( array_2d ), MPI_REAL, status, ierr )
[4621]	1165	#endif
[4617]	1166	DO i = nxl, nxr
	1167	rmabuf_2d(nys:nyn,i) = array_2d(i,nys:nyn)
	1168	ENDDO
	1169	data(nys:nyn,nxl:nxr) = rmabuf_2d ! copy prerund data directly into output array data
	1170	ENDIF
	1171
	1172	CALL mainrun_grid%activate_grid_from_this_class()
	1173
	1174	#if defined( __parallel )
	1175	!
	1176	!-- Close RMA window to allow remote access
	1177	CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
	1178	#endif
	1179
	1180	!
	1181	!-- TODO: describe in more detail what is happening in this IF/ELSE clause
	1182	IF ( .NOT. pe_active_for_read ) THEN
	1183
	1184	is = nxl
	1185	ie = nxr
	1186	js = nys
	1187	je = nyn
	1188
	1189	ELSE
	1190	!
	1191	!-- Extra get for cyclic data north of prerun data
	1192	is = nxl
	1193	ie = nxr
	1194	js = prerun_grid%nys+1
	1195	je = nyn
	1196	DO i = is, ie
	1197	DO j = js, je
	1198	i_remote = MOD(i,nx_on_file+1)
	1199	j_remote = MOD(j,ny_on_file+1)
	1200	rem_pe = remote_pe(i_remote,j_remote)
	1201	rem_offs = rma_offset(i_remote,j_remote)
	1202	nval = 1
	1203
	1204	#if defined( __parallel )
	1205	IF ( rem_pe /= myid ) THEN
	1206	CALL MPI_GET( data(j,i), nval, MPI_REAL, rem_pe, rem_offs, nval, MPI_REAL, &
	1207	rmawin_2d, ierr )
	1208	ELSE
	1209	data(j,i) = rmabuf_2d(j_remote,i_remote)
	1210	ENDIF
	1211	#else
	1212	data(j,i) = array_2d(i_remote,j_remote)
	1213	#endif
	1214	ENDDO
	1215	ENDDO
	1216	!
	1217	!-- Prepare setup for stripe right of prerun data
	1218	is = prerun_grid%nxr+1
	1219	ie = nxr
	1220	js = nys
	1221	je = nyn
	1222
	1223	ENDIF
	1224
	1225	DO i = is, ie
	1226	DO j = js, je
	1227	i_remote = MOD(i,nx_on_file+1)
	1228	j_remote = MOD(j,ny_on_file+1)
	1229	rem_pe = remote_pe(i_remote,j_remote)
	1230	rem_offs = rma_offset(i_remote,j_remote)
	1231	nval = 1
	1232
	1233	#if defined( __parallel )
	1234	IF ( rem_pe /= myid ) THEN
	1235	CALL MPI_GET( data(j,i), nval, MPI_REAL, rem_pe, rem_offs, nval, MPI_REAL, &
	1236	rmawin_2d, ierr )
	1237	ELSE
	1238	data(j,i) = rmabuf_2d(j_remote,i_remote)
	1239	ENDIF
	1240	#else
	1241	data(j,i) = array_2d(i_remote,j_remote)
	1242	#endif
	1243	ENDDO
	1244	ENDDO
	1245
	1246	#if defined( __parallel )
	1247	!
	1248	!-- Reopen RMA window to allow filling
	1249	CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
	1250	#endif
	1251
	1252	END SUBROUTINE rrd_mpi_io_real_2d_cyclic_fill
	1253
[4495]	1254	END SUBROUTINE rrd_mpi_io_real_2d
	1255
	1256
	1257
	1258	!--------------------------------------------------------------------------------------------------!
	1259	! Description:
	1260	! ------------
	1261	!> Read 2d-INTEGER array with MPI-IO
	1262	!--------------------------------------------------------------------------------------------------!
	1263	SUBROUTINE rrd_mpi_io_int_2d( name, data )
	1264
	1265	IMPLICIT NONE
	1266
[4591]	1267	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	1268
[4591]	1269	INTEGER(iwp) :: i !<
	1270	INTEGER(iwp) :: j !<
[4495]	1271
	1272	#if defined( __parallel )
[4591]	1273	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	1274	#endif
	1275
[4591]	1276	INTEGER(KIND=iwp), INTENT(INOUT), DIMENSION(:,:) :: data !<
[4495]	1277
[4591]	1278	LOGICAL :: found !<
[4495]	1279
	1280
	1281	found = .FALSE.
	1282
	1283	DO i = 1, tgh%nr_arrays
	1284	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	1285	array_position = array_offset(i)
	1286	found = .TRUE.
	1287	EXIT
	1288	ENDIF
	1289	ENDDO
	1290
	1291	IF ( found ) THEN
	1292
[4591]	1293	IF ( ( nxr - nxl + 1 + 2 * nbgp ) == SIZE( data, 2 ) ) THEN
[4495]	1294	!
	1295	!-- Output array with Halos.
[4591]	1296	!-- ATTENTION: INTEGER arrays with ghost boundaries are not implemented yet. This kind of
	1297	!-- array would be dimensioned in the caller subroutine like this:
[4495]	1298	!-- INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg):: data
[4536]	1299	message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be read from restart ' // &
	1300	'file is defined with illegal dimensions in the PALM code'
	1301	CALL message( 'rrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
[4495]	1302
[4591]	1303	ELSEIF ( (nxr - nxl + 1) == SIZE( data, 2 ) ) THEN
[4495]	1304	!
	1305	!-- INTEGER input array without Halos.
	1306	!-- This kind of array is dimensioned in the caller subroutine
	1307	!-- INTEGER, DIMENSION(nys:nyn,nxl:nxr) :: data
[4617]	1308	IF ( cyclic_fill_mode ) THEN
[4495]	1309
[4617]	1310	CALL rrd_mpi_io_int_2d_cyclic_fill
	1311
	1312	ELSE
	1313
[4495]	1314	#if defined( __parallel )
[4617]	1315	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited # of cores is inactive
	1316	IF ( sm_io%iam_io_pe ) THEN
	1317	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native', &
	1318	MPI_INFO_NULL, ierr )
	1319	CALL MPI_FILE_READ_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status, &
	1320	ierr )
	1321	ENDIF
	1322	CALL sm_io%sm_node_barrier()
[4495]	1323	#else
[4617]	1324	CALL posix_lseek( fh, array_position )
	1325	CALL posix_read( fh, array_2di, SIZE( array_2di ) )
[4495]	1326	#endif
[4617]	1327	DO j = nys, nyn
	1328	DO i = nxl, nxr
	1329	data(j-nys+1,i-nxl+1) = array_2di(i,j)
	1330	ENDDO
[4495]	1331	ENDDO
	1332
[4617]	1333	ENDIF
	1334
[4536]	1335	ELSE
[4495]	1336
[4536]	1337	message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be read from restart ' // &
	1338	'file is defined with illegal dimensions in the PALM code'
	1339	CALL message( 'rrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
	1340
[4495]	1341	ENDIF
	1342
	1343	ELSE
	1344
[4536]	1345	message_string = '2d-INTEGER array "' // TRIM( name ) // '" not found in restart file'
	1346	CALL message( 'rrd_mpi_io_int_2d', 'PA0722', 3, 2, 0, 6, 0 )
[4495]	1347
	1348	ENDIF
	1349
[4617]	1350
	1351	CONTAINS
	1352
	1353	SUBROUTINE rrd_mpi_io_int_2d_cyclic_fill
	1354
	1355	IMPLICIT NONE
	1356
	1357	INTEGER(iwp) :: i !<
	1358	INTEGER(iwp) :: ie !<
	1359	INTEGER(iwp) :: is !<
	1360	INTEGER(iwp) :: i_remote !<
	1361	INTEGER(iwp) :: j !<
	1362	INTEGER(iwp) :: je !<
	1363	INTEGER(iwp) :: js !<
	1364	INTEGER(iwp) :: j_remote !<
	1365	INTEGER(iwp) :: nval !<
	1366	INTEGER(iwp) :: rem_pe !<
	1367
[4621]	1368	#if defined( __parallel )
[4622]	1369	INTEGER(iwp) :: ierr !<
[4617]	1370	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_offs !<
[4621]	1371	#else
	1372	INTEGER(idp) :: rem_offs
	1373	#endif
[4617]	1374
	1375
	1376	CALL prerun_grid%activate_grid_from_this_class()
	1377
	1378	IF ( pe_active_for_read ) THEN
[4621]	1379	#if defined( __parallel )
[4617]	1380	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native', &
	1381	MPI_INFO_NULL, ierr )
	1382	CALL MPI_FILE_READ_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status, ierr )
[4621]	1383	#endif
[4617]	1384	DO i = nxl, nxr
	1385	rmabuf_2di(nys:nyn,i) = array_2di(i,nys:nyn)
	1386	ENDDO
	1387	data(1:nny,1:nnx) = rmabuf_2di
	1388	ENDIF
	1389
	1390	CALL mainrun_grid%activate_grid_from_this_class()
	1391
	1392	#if defined( __parallel )
	1393	!
	1394	!-- Close RMA window to allow remote access
	1395	CALL MPI_WIN_FENCE( 0, rmawin_2di, ierr )
	1396	#endif
	1397
	1398	IF ( .NOT. pe_active_for_read ) THEN
	1399
	1400	is = nxl
	1401	ie = nxr
	1402	js = nys
	1403	je = nyn
	1404
	1405	ELSE
	1406
	1407	is = nxl
	1408	ie = nxr
	1409	js = prerun_grid%nys+1
	1410	je = nyn
	1411	DO i = is, ie
	1412	DO j = js, je
	1413	i_remote = MOD(i,nx_on_file+1)
	1414	j_remote = MOD(j,ny_on_file+1)
	1415	rem_pe = remote_pe(i_remote,j_remote)
	1416	rem_offs = rma_offset(i_remote,j_remote)
	1417	nval = 1
	1418
	1419	#if defined( __parallel )
	1420	IF ( rem_pe /= myid ) THEN
	1421	CALL MPI_GET( data(j-nys+1,i-nxl+1), nval, MPI_INTEGER, rem_pe, rem_offs, nval, &
	1422	MPI_INTEGER, rmawin_2di, ierr )
	1423	ELSE
	1424	data(j-nys+1,i-nxl+1) = rmabuf_2di(j_remote,i_remote)
	1425	ENDIF
	1426	#else
	1427	data(j-nys+1,i-nxl+1) = array_2di(i_remote,j_remote)
	1428	#endif
	1429	ENDDO
	1430	ENDDO
	1431	is = prerun_grid%nxr+1
	1432	ie = nxr
	1433	js = nys
	1434	je = nyn
	1435
	1436	ENDIF
	1437
	1438	DO i = is, ie
	1439	DO j = js, je
	1440	i_remote = MOD(i,nx_on_file+1)
	1441	j_remote = MOD(j,ny_on_file+1)
	1442	rem_pe = remote_pe(i_remote,j_remote)
	1443	rem_offs = rma_offset(i_remote,j_remote)
	1444	nval = 1
	1445	#if defined( __parallel )
	1446	IF ( rem_pe /= myid ) THEN
	1447	CALL MPI_GET( data(j-nys+1,i-nxl+1), nval, MPI_INTEGER, rem_pe, rem_offs, nval, &
	1448	MPI_INTEGER, rmawin_2di, ierr)
	1449	ELSE
	1450	data(j-nys+1,i-nxl+1) = rmabuf_2di(j_remote,i_remote)
	1451	ENDIF
	1452	#else
	1453	data(j-nys+1,i-nxl+1) = array_2di(i_remote,j_remote)
	1454	#endif
	1455	ENDDO
	1456	ENDDO
	1457
	1458	#if defined( __parallel )
	1459	!
	1460	!-- Reopen RMA window to allow filling
	1461	CALL MPI_WIN_FENCE( 0, rmawin_2di, ierr )
	1462	#endif
	1463
	1464	END SUBROUTINE rrd_mpi_io_int_2d_cyclic_fill
	1465
[4495]	1466	END SUBROUTINE rrd_mpi_io_int_2d
	1467
	1468
	1469
	1470	!--------------------------------------------------------------------------------------------------!
	1471	! Description:
	1472	! ------------
[4628]	1473	!> Read 3d-INTEGER*4 array with MPI-IO
	1474	!--------------------------------------------------------------------------------------------------!
	1475	SUBROUTINE rrd_mpi_io_int4_3d( name, data )
	1476
	1477	IMPLICIT NONE
	1478
	1479	CHARACTER(LEN=*), INTENT(IN) :: name !<
	1480
	1481	INTEGER(iwp) :: i !<
	1482
	1483	#if defined( __parallel )
	1484	INTEGER, DIMENSION(rd_status_size) :: status !<
	1485	#endif
	1486
	1487	LOGICAL :: found !<
	1488
	1489	INTEGER(isp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data !<
	1490
	1491
	1492	found = .FALSE.
	1493	data = -1.0
	1494
	1495	DO i = 1, tgh%nr_arrays
	1496	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	1497	array_position = array_offset(i)
	1498	found = .TRUE.
	1499	EXIT
	1500	ENDIF
	1501	ENDDO
	1502
	1503	IF ( found ) THEN
	1504
	1505	#if defined( __parallel )
	1506	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited # of cores is inactive
	1507	IF( sm_io%iam_io_pe ) THEN
	1508	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_3di4, 'native', &
	1509	MPI_INFO_NULL, ierr )
	1510	CALL MPI_FILE_READ_ALL( fh, array_3di4, SIZE( array_3di4 ), MPI_INTEGER, status, ierr )
	1511	ENDIF
	1512	CALL sm_io%sm_node_barrier()
	1513	#else
	1514	CALL posix_lseek( fh, array_position )
	1515	CALL posix_read(fh, array_3di4, SIZE( array_3di4 ) )
	1516	#endif
	1517	IF ( include_total_domain_boundaries ) THEN
	1518	DO i = iog%nxl, iog%nxr
	1519	data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_3di4(:,i,iog%nys:iog%nyn)
	1520	ENDDO
	1521	ELSE
	1522	DO i = nxl, nxr
	1523	data(:,nys:nyn,i) = array_3di4(:,i,nys:nyn)
	1524	ENDDO
	1525	ENDIF
	1526
	1527	ELSE
	1528
	1529	message_string = '3d-INTEGER*4 array "' // TRIM( name ) // '" not found in restart file'
	1530	CALL message( 'rrd_mpi_io_int4_3d', 'PA0722', 3, 2, 0, 6, 0 )
	1531
	1532	ENDIF
	1533
	1534
	1535	END SUBROUTINE rrd_mpi_io_int4_3d
	1536
	1537
	1538
	1539	!--------------------------------------------------------------------------------------------------!
	1540	! Description:
	1541	! ------------
	1542	!> Read 3d-INTEGER*8 array with MPI-IO
	1543	!--------------------------------------------------------------------------------------------------!
	1544	SUBROUTINE rrd_mpi_io_int8_3d( name, data )
	1545
	1546	IMPLICIT NONE
	1547
	1548	CHARACTER(LEN=*), INTENT(IN) :: name !<
	1549
	1550	INTEGER(iwp) :: i !<
	1551
	1552	#if defined( __parallel )
	1553	INTEGER, DIMENSION(rd_status_size) :: status !<
	1554	#endif
	1555
	1556	LOGICAL :: found !<
	1557
	1558	INTEGER(idp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data !<
	1559
	1560
	1561	found = .FALSE.
	1562	data = -1.0
	1563
	1564	DO i = 1, tgh%nr_arrays
	1565	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	1566	array_position = array_offset(i)
	1567	found = .TRUE.
	1568	EXIT
	1569	ENDIF
	1570	ENDDO
	1571
	1572	IF ( found ) THEN
	1573
	1574	#if defined( __parallel )
	1575	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited # of cores is inactive
	1576	IF( sm_io%iam_io_pe ) THEN
	1577	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER8, ft_3di8, 'native', MPI_INFO_NULL, &
	1578	ierr )
	1579	CALL MPI_FILE_READ_ALL( fh, array_3di8, SIZE( array_3di8 ), MPI_INTEGER8, status, ierr )
	1580	ENDIF
	1581	CALL sm_io%sm_node_barrier()
	1582	#else
	1583	CALL posix_lseek( fh, array_position )
	1584	CALL posix_read(fh, array_3di8, SIZE( array_3di8 ) )
	1585	#endif
	1586	IF ( include_total_domain_boundaries ) THEN
	1587	DO i = iog%nxl, iog%nxr
	1588	data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_3di8(:,i,iog%nys:iog%nyn)
	1589	ENDDO
	1590	ELSE
	1591	DO i = nxl, nxr
	1592	data(:,nys:nyn,i) = array_3di8(:,i,nys:nyn)
	1593	ENDDO
	1594	ENDIF
	1595
	1596	ELSE
	1597
	1598	message_string = '3d-INTEGER*8 array "' // TRIM( name ) // '" not found in restart file'
	1599	CALL message( 'rrd_mpi_io_int8_3d', 'PA0722', 3, 2, 0, 6, 0 )
	1600
	1601	ENDIF
	1602
	1603
	1604	END SUBROUTINE rrd_mpi_io_int8_3d
	1605
	1606
	1607
	1608	!--------------------------------------------------------------------------------------------------!
	1609	! Description:
	1610	! ------------
[4495]	1611	!> Read 2d-REAL array with MPI-IO
	1612	!--------------------------------------------------------------------------------------------------!
	1613	SUBROUTINE rrd_mpi_io_real_3d( name, data )
	1614
	1615	IMPLICIT NONE
	1616
[4591]	1617	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	1618
[4591]	1619	INTEGER(iwp) :: i !<
[4495]	1620
	1621	#if defined( __parallel )
[4591]	1622	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	1623	#endif
	1624
[4591]	1625	LOGICAL :: found !<
[4495]	1626
[4591]	1627	REAL(wp), INTENT(INOUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data !<
[4495]	1628
	1629
	1630	found = .FALSE.
[4617]	1631	data = -1.0
[4495]	1632
	1633	DO i = 1, tgh%nr_arrays
	1634	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	1635	array_position = array_offset(i)
	1636	found = .TRUE.
	1637	EXIT
	1638	ENDIF
	1639	ENDDO
	1640
	1641	IF ( found ) THEN
[4617]	1642
	1643	IF ( cyclic_fill_mode ) THEN
	1644
	1645	CALL rrd_mpi_io_real_3d_cyclic_fill
	1646	!
	1647	!-- Cyclic fill mode requires to use the "cyclic" communicator, in order to initialize
	1648	!-- grid points at the outer boundaries (ghost layers) of the total domain. These points
	1649	!-- are not contained in the prerun data, because the prerun used cyclic boundary conditions.
	1650	CALL exchange_horiz( data, nbgp, alternative_communicator = 1 )
	1651
	1652	ELSE
[4495]	1653	#if defined( __parallel )
[4617]	1654	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited # of cores is inactive
	1655	IF( sm_io%iam_io_pe ) THEN
	1656	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, &
	1657	ierr )
	1658	CALL MPI_FILE_READ_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
	1659	ENDIF
	1660	CALL sm_io%sm_node_barrier()
	1661	#else
	1662	CALL posix_lseek( fh, array_position )
	1663	CALL posix_read(fh, array_3d, SIZE( array_3d ) )
	1664	#endif
	1665	IF ( include_total_domain_boundaries ) THEN
	1666	DO i = iog%nxl, iog%nxr
	1667	data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_3d(:,i,iog%nys:iog%nyn)
	1668	ENDDO
	1669	ELSE
	1670	DO i = nxl, nxr
	1671	data(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
	1672	ENDDO
	1673	ENDIF
	1674
	1675	CALL exchange_horiz( data, nbgp )
	1676
	1677	ENDIF
	1678
	1679	ELSE
	1680
	1681	message_string = '3d-REAL array "' // TRIM( name ) // '" not found in restart file'
	1682	CALL message( 'rrd_mpi_io_real_3d', 'PA0722', 3, 2, 0, 6, 0 )
	1683
	1684	ENDIF
	1685
	1686
	1687	CONTAINS
	1688
	1689	SUBROUTINE rrd_mpi_io_real_3d_cyclic_fill
	1690
	1691	IMPLICIT NONE
	1692
	1693	INTEGER(iwp) :: i !<
	1694	INTEGER(iwp) :: ie !<
	1695	INTEGER(iwp) :: is !<
	1696	INTEGER(iwp) :: i_remote !<
	1697	INTEGER(iwp) :: j !<
	1698	INTEGER(iwp) :: je !<
	1699	INTEGER(iwp) :: js !<
	1700	INTEGER(iwp) :: j_remote !<
	1701	INTEGER(iwp) :: nval !<
	1702	INTEGER(iwp) :: rem_pe !<
	1703
[4621]	1704	#if defined( __parallel )
[4622]	1705	INTEGER(iwp) :: ierr !<
[4617]	1706	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_offs !<
[4621]	1707	#else
	1708	INTEGER(idp) :: rem_offs
	1709	#endif
[4617]	1710
	1711
	1712	CALL prerun_grid%activate_grid_from_this_class()
	1713
	1714	IF ( pe_active_for_read ) THEN
[4621]	1715	#if defined( __parallel )
[4534]	1716	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, &
	1717	ierr )
	1718	CALL MPI_FILE_READ_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
[4621]	1719	#endif
[4617]	1720	DO i = nxl, nxr
	1721	rmabuf_3d(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
	1722	ENDDO
	1723	data(:,nys:nyn,nxl:nxr) = rmabuf_3d
[4534]	1724	ENDIF
[4617]	1725	CALL mainrun_grid%activate_grid_from_this_class ()
	1726
	1727	#if defined( __parallel )
	1728	!
	1729	!-- Close RMA window to allow remote access
	1730	CALL MPI_WIN_FENCE( 0, rmawin_3d, ierr )
	1731	#endif
	1732
	1733	IF ( .NOT. pe_active_for_read ) THEN
	1734
	1735	is = nxl
	1736	ie = nxr
	1737	js = nys
	1738	je = nyn
	1739
	1740	ELSE
	1741
	1742	is = nxl
	1743	ie = nxr
	1744	js = prerun_grid%nys+1
	1745	je = nyn
	1746
	1747	DO i = is, ie
	1748	DO j = js, je
	1749	i_remote = MOD(i,nx_on_file+1)
	1750	j_remote = MOD(j,ny_on_file+1)
	1751	rem_pe = remote_pe(i_remote,j_remote)
	1752	rem_offs = rma_offset(i_remote,j_remote)*(nzt-nzb+2)
	1753	nval = nzt-nzb+2
	1754
	1755	#if defined( __parallel )
	1756	IF(rem_pe /= myid) THEN
	1757	CALL MPI_GET( data(nzb,j,i), nval, MPI_REAL, rem_pe, rem_offs, nval, MPI_REAL, &
	1758	rmawin_3d, ierr)
	1759	ELSE
	1760	data(:,j,i) = rmabuf_3d(:,j_remote,i_remote)
	1761	ENDIF
[4495]	1762	#else
[4617]	1763	data(:,j,i) = array_3d(:,i_remote,j_remote)
[4495]	1764	#endif
[4617]	1765	ENDDO
[4495]	1766	ENDDO
[4617]	1767	is = prerun_grid%nxr+1
	1768	ie = nxr
	1769	js = nys
	1770	je = nyn
	1771
[4495]	1772	ENDIF
	1773
[4617]	1774	DO i = is, ie
	1775	DO j = js, je
	1776	i_remote = MOD(i,nx_on_file+1)
	1777	j_remote = MOD(j,ny_on_file+1)
	1778	rem_pe = remote_pe(i_remote,j_remote)
	1779	rem_offs = rma_offset(i_remote,j_remote) * ( nzt-nzb+2 )
	1780	nval = nzt-nzb+2
[4495]	1781
[4617]	1782	#if defined( __parallel )
	1783	IF ( rem_pe /= myid ) THEN
	1784	CALL MPI_GET( data(nzb,j,i), nval, MPI_REAL, rem_pe, rem_offs, nval, MPI_REAL, &
	1785	rmawin_3d, ierr)
	1786	ELSE
	1787	data(:,j,i) = rmabuf_3d(:,j_remote,i_remote)
	1788	ENDIF
	1789	#else
	1790	data(:,j,i) = array_3d(:,i_remote,j_remote)
	1791	#endif
	1792	ENDDO
	1793	ENDDO
[4536]	1794
[4617]	1795	#if defined( __parallel )
	1796	!
	1797	!-- Reopen RMA window to allow filling
	1798	CALL MPI_WIN_FENCE( 0, rmawin_3d, ierr )
	1799	#endif
[4536]	1800
[4617]	1801	END SUBROUTINE rrd_mpi_io_real_3d_cyclic_fill
[4495]	1802
	1803	END SUBROUTINE rrd_mpi_io_real_3d
	1804
	1805
	1806
	1807	!--------------------------------------------------------------------------------------------------!
	1808	! Description:
	1809	! ------------
	1810	!> Read 3d-REAL soil array with MPI-IO
	1811	!> nzb_soil, nzt_soil are located in the module land_surface_model_mod. Since Fortran does not allow
	1812	!> cross referencing of module variables, it is required to pass these variables as arguments.
	1813	!--------------------------------------------------------------------------------------------------!
	1814	SUBROUTINE rrd_mpi_io_real_3d_soil( name, data, nzb_soil, nzt_soil )
	1815
	1816	IMPLICIT NONE
	1817
[4591]	1818	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	1819
[4591]	1820	INTEGER(iwp) :: i !<
	1821	INTEGER, INTENT(IN) :: nzb_soil !<
	1822	INTEGER, INTENT(IN) :: nzt_soil !<
[4495]	1823
	1824	#if defined( __parallel )
[4591]	1825	INTEGER, DIMENSION(rd_status_size) :: status !<
[4622]	1826	INTEGER(iwp) :: ierr !<
[4495]	1827	#endif
	1828
[4591]	1829	LOGICAL :: found !<
[4495]	1830
[4591]	1831	REAL(wp), INTENT(INOUT), DIMENSION(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) :: data !<
[4495]	1832
	1833
[4617]	1834	!
	1835	!-- Prerun data is not allowed to contain soil information so far
	1836	IF ( cyclic_fill_mode ) THEN
	1837	message_string = 'prerun data is not allowed to contain soil information'
	1838	CALL message( 'rrd_mpi_io_real_3d_soil', 'PA0729', 3, 2, -1, 6, 0 )
	1839	ENDIF
	1840
[4495]	1841	found = .FALSE.
	1842
	1843	DO i = 1, tgh%nr_arrays
	1844	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	1845	array_position = array_offset(i)
	1846	found = .TRUE.
	1847	EXIT
	1848	ENDIF
	1849	ENDDO
	1850
	1851	IF ( found ) THEN
	1852	#if defined( __parallel )
	1853	CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
[4591]	1854	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
[4534]	1855	IF ( sm_io%iam_io_pe ) THEN
[4591]	1856	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', &
	1857	MPI_INFO_NULL, ierr )
[4534]	1858	CALL MPI_FILE_READ_ALL( fh, array_3d_soil, SIZE( array_3d_soil ), MPI_REAL, status, ierr )
	1859	CALL MPI_TYPE_FREE( ft_3dsoil, ierr )
	1860	ENDIF
	1861	CALL sm_io%sm_node_barrier()
[4495]	1862	#else
	1863	CALL posix_lseek( fh, array_position )
[4534]	1864	CALL posix_read( fh, array_3d_soil, SIZE( array_3d_soil ) )
[4495]	1865	#endif
	1866	IF ( include_total_domain_boundaries ) THEN
[4617]	1867	DO i = iog%nxl, iog%nxr
	1868	data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp) = array_3d_soil(:,i,iog%nys:iog%nyn)
[4495]	1869	ENDDO
	1870	ELSE
	1871	DO i = nxl, nxr
[4598]	1872	data(:,nys:nyn,i) = array_3d_soil(:,i,nys:nyn)
[4495]	1873	ENDDO
	1874	ENDIF
	1875
	1876	ELSE
[4536]	1877
	1878	message_string = '3d-REAL soil array "' // TRIM( name ) // '" not found in restart file'
	1879	CALL message( 'rrd_mpi_io_real_3d_soil', 'PA0722', 3, 2, 0, 6, 0 )
	1880
[4495]	1881	ENDIF
	1882
	1883	END SUBROUTINE rrd_mpi_io_real_3d_soil
	1884
	1885
	1886
	1887	!--------------------------------------------------------------------------------------------------!
	1888	! Description:
	1889	! ------------
	1890	!> Read CHARACTER with MPI-IO
	1891	!--------------------------------------------------------------------------------------------------!
[4536]	1892	SUBROUTINE rrd_mpi_io_char( name, text )
[4495]	1893
	1894	IMPLICIT NONE
	1895
[4591]	1896	CHARACTER(LEN=*), INTENT(IN) :: name !<
	1897	CHARACTER(LEN=*), INTENT(OUT) :: text !<
	1898	CHARACTER(LEN=128) :: line !<
[4495]	1899
[4591]	1900	INTEGER(iwp) :: i !<
[4495]	1901
[4591]	1902	LOGICAL :: found !<
[4495]	1903
	1904
[4536]	1905	found = .FALSE.
[4495]	1906	text = ' '
	1907
	1908	DO i = 1, tgh%nr_char
[4536]	1909	line = text_lines(i)
	1910	IF ( TRIM( line(1:32) ) == TRIM( name ) ) THEN
	1911	text = line(33:)
	1912	found = .TRUE.
[4495]	1913	EXIT
	1914	ENDIF
	1915	ENDDO
	1916
[4536]	1917	IF ( .NOT. found ) THEN
	1918	message_string = 'CHARACTER variable "' // TRIM( name ) // '" not found in restart file'
	1919	CALL message( 'rrd_mpi_io_char', 'PA0722', 3, 2, 0, 6, 0 )
[4495]	1920	ENDIF
	1921
	1922	END SUBROUTINE rrd_mpi_io_char
	1923
	1924
	1925
	1926	!--------------------------------------------------------------------------------------------------!
	1927	! Description:
	1928	! ------------
	1929	!> Read LOGICAL with MPI-IO
	1930	!--------------------------------------------------------------------------------------------------!
	1931	SUBROUTINE rrd_mpi_io_logical( name, value )
	1932
	1933	IMPLICIT NONE
	1934
[4591]	1935	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	1936
[4591]	1937	INTEGER(iwp) :: logical_as_integer !<
[4495]	1938
[4591]	1939	LOGICAL, INTENT(OUT) :: value !<
[4495]	1940
	1941
	1942	CALL rrd_mpi_io_int( name, logical_as_integer )
	1943	value = ( logical_as_integer == 1 )
	1944
	1945	END SUBROUTINE rrd_mpi_io_logical
	1946
	1947
	1948
	1949	!--------------------------------------------------------------------------------------------------!
	1950	! Description:
	1951	! ------------
[4735]	1952	!> Read 3D-LOGICAL with MPI-IO
	1953	!--------------------------------------------------------------------------------------------------!
	1954	SUBROUTINE rrd_mpi_io_logical_3d( name, data )
	1955
	1956	IMPLICIT NONE
	1957
	1958	CHARACTER(LEN=*), INTENT(IN) :: name !<
	1959
	1960	INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: logical_as_integer !<
	1961
	1962	LOGICAL, INTENT(OUT), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data !<
	1963
	1964
	1965	CALL rrd_mpi_io_int4_3d( name, logical_as_integer )
	1966	data(:,:,:) = ( logical_as_integer(:,:,:) == 1 )
	1967
	1968	END SUBROUTINE rrd_mpi_io_logical_3d
	1969
	1970
	1971
	1972	!--------------------------------------------------------------------------------------------------!
	1973	! Description:
	1974	! ------------
[4495]	1975	!> Write INTEGER with MPI-IO
	1976	!--------------------------------------------------------------------------------------------------!
	1977	SUBROUTINE wrd_mpi_io_int( name, value )
	1978
	1979	IMPLICIT NONE
	1980
[4591]	1981	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	1982
[4591]	1983	INTEGER(KIND=iwp), INTENT(IN) :: value !<
[4495]	1984
	1985
[4539]	1986	IF ( header_int_index == max_nr_int ) THEN
	1987	STOP '+++ maximum number of INTEGER entries in restart file header exceeded'
	1988	ENDIF
	1989
[4495]	1990	int_names(header_int_index) = name
	1991	int_values(header_int_index) = value
	1992	header_int_index = header_int_index + 1
	1993
	1994	END SUBROUTINE wrd_mpi_io_int
	1995
	1996
[4591]	1997	!--------------------------------------------------------------------------------------------------!
	1998	! Description:
	1999	! ------------
	2000	!> To do: Description missing!
	2001	!--------------------------------------------------------------------------------------------------!
[4495]	2002	SUBROUTINE wrd_mpi_io_real( name, value )
	2003
	2004	IMPLICIT NONE
	2005
[4591]	2006	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2007
[4591]	2008	REAL(wp), INTENT(IN) :: value !<
[4495]	2009
	2010
[4539]	2011	IF ( header_real_index == max_nr_real ) THEN
	2012	STOP '+++ maximum number of REAL entries in restart file header exceeded'
	2013	ENDIF
	2014
[4495]	2015	real_names(header_real_index) = name
	2016	real_values(header_real_index) = value
	2017	header_real_index = header_real_index + 1
	2018
	2019	END SUBROUTINE wrd_mpi_io_real
	2020
	2021
	2022
	2023	!--------------------------------------------------------------------------------------------------!
	2024	! Description:
	2025	! ------------
	2026	!> Write 2d-REAL array with MPI-IO
	2027	!--------------------------------------------------------------------------------------------------!
	2028	SUBROUTINE wrd_mpi_io_real_2d( name, data )
	2029
	2030	IMPLICIT NONE
	2031
[4591]	2032	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2033
[4591]	2034	INTEGER(iwp) :: i !<
[4495]	2035
	2036	#if defined( __parallel )
[4591]	2037	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	2038	#endif
	2039
[4591]	2040	REAL(wp), INTENT(IN), DIMENSION(nysg:nyng,nxlg:nxrg) :: data !<
[4495]	2041
	2042
[4539]	2043	IF ( header_array_index == max_nr_arrays ) THEN
	2044	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2045	ENDIF
[4495]	2046
[4539]	2047	array_names(header_array_index) = name
	2048	array_offset(header_array_index) = array_position
	2049	header_array_index = header_array_index + 1
	2050
[4495]	2051	IF ( include_total_domain_boundaries ) THEN
	2052	!
[4591]	2053	!-- Prepare output with outer boundaries
[4617]	2054	DO i = iog%nxl, iog%nxr
	2055	array_2d(i,iog%nys:iog%nyn) = data(iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
[4495]	2056	ENDDO
[4536]	2057
[4495]	2058	ELSE
	2059	!
[4591]	2060	!-- Prepare output without outer boundaries
[4495]	2061	DO i = nxl,nxr
[4617]	2062	array_2d(i,iog%nys:iog%nyn) = data(nys:nyn,i)
[4495]	2063	ENDDO
[4536]	2064
[4495]	2065	ENDIF
	2066
	2067	#if defined( __parallel )
[4591]	2068	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
[4534]	2069	IF ( sm_io%iam_io_pe ) THEN
	2070	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_2d, 'native', MPI_INFO_NULL, ierr )
	2071	CALL MPI_FILE_WRITE_ALL( fh, array_2d, SIZE( array_2d), MPI_REAL, status, ierr )
	2072	ENDIF
	2073	CALL sm_io%sm_node_barrier()
[4495]	2074	#else
	2075	CALL posix_lseek( fh, array_position )
	2076	CALL posix_write( fh, array_2d, SIZE( array_2d ) )
	2077	#endif
	2078	!
[4591]	2079	!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
[4495]	2080	!-- Maybe a compiler problem.
[4617]	2081	array_position = array_position + ( INT( iog%ny, KIND=rd_offset_kind ) + 1 ) * &
	2082	( INT( iog%nx, KIND=rd_offset_kind ) + 1 ) * wp
[4495]	2083
	2084	END SUBROUTINE wrd_mpi_io_real_2d
	2085
	2086
	2087
	2088	!--------------------------------------------------------------------------------------------------!
	2089	! Description:
	2090	! ------------
	2091	!> Write 2d-INTEGER array with MPI-IO
	2092	!--------------------------------------------------------------------------------------------------!
[4536]	2093	SUBROUTINE wrd_mpi_io_int_2d( name, data )
[4495]	2094
	2095	IMPLICIT NONE
	2096
[4591]	2097	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2098
[4591]	2099	INTEGER(iwp) :: i !<
	2100	INTEGER(iwp) :: j !<
[4495]	2101
	2102	#if defined( __parallel )
[4591]	2103	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	2104	#endif
[4591]	2105	INTEGER(KIND=iwp), INTENT(IN), DIMENSION(:,:) :: data !<
[4495]	2106
	2107
[4539]	2108	IF ( header_array_index == max_nr_arrays ) THEN
	2109	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2110	ENDIF
[4495]	2111
[4539]	2112	array_names(header_array_index) = name
	2113	array_offset(header_array_index) = array_position
	2114	header_array_index = header_array_index + 1
	2115
[4591]	2116	IF ( ( nxr - nxl + 1 + 2 * nbgp ) == SIZE( data, 2 ) ) THEN
[4495]	2117	!
	2118	!-- Integer arrays with ghost layers are not implemented yet. These kind of arrays would be
	2119	!-- dimensioned in the caller subroutine as
	2120	!-- INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg) :: data
[4536]	2121	message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be written to restart ' // &
	2122	'file is defined with illegal dimensions in the PALM code'
	2123	CALL message( 'wrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
[4495]	2124
	2125	ELSEIF ( ( nxr-nxl+1 ) == SIZE( data, 2 ) ) THEN
	2126	!
	2127	!-- INTEGER input array without ghost layers.
	2128	!-- This kind of array is dimensioned in the caller subroutine as
	2129	!-- INTEGER, DIMENSION(nys:nyn,nxl:nxr) :: data
	2130	DO j = nys, nyn
	2131	DO i = nxl, nxr
[4534]	2132	array_2di(i,j) = data(j-nys+1,i-nxl+1)
[4495]	2133	ENDDO
	2134	ENDDO
	2135	#if defined( __parallel )
[4591]	2136	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
[4534]	2137	IF ( sm_io%iam_io_pe ) THEN
	2138	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_2di_nb, 'native', &
	2139	MPI_INFO_NULL, ierr )
	2140	CALL MPI_FILE_WRITE_ALL( fh, array_2di, SIZE( array_2di ), MPI_INTEGER, status, ierr )
	2141	ENDIF
	2142	CALL sm_io%sm_node_barrier()
[4495]	2143	#else
	2144	CALL posix_lseek( fh, array_position )
[4534]	2145	CALL posix_write( fh, array_2di, SIZE( array_2di ) )
[4495]	2146	#endif
	2147	!
	2148	!-- Type conversion required, otherwise rigth hand side brackets are calculated assuming 4 byte
	2149	!-- INT. Maybe a compiler problem.
	2150	array_position = array_position + INT( (ny+1), KIND=rd_offset_kind ) * &
	2151	INT( (nx+1), KIND=rd_offset_kind ) * 4
	2152
	2153	ELSE
[4536]	2154
	2155	message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be written to restart ' // &
	2156	'file is defined with illegal dimensions in the PALM code'
	2157	CALL message( 'wrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
	2158
[4495]	2159	ENDIF
	2160
	2161	END SUBROUTINE wrd_mpi_io_int_2d
	2162
	2163
	2164
	2165	!--------------------------------------------------------------------------------------------------!
	2166	! Description:
	2167	! ------------
[4628]	2168	!> Write 3d-INTEGER*4 array with MPI-IO
	2169	!--------------------------------------------------------------------------------------------------!
	2170	SUBROUTINE wrd_mpi_io_int4_3d( name, data )
	2171
	2172	IMPLICIT NONE
	2173
	2174	CHARACTER(LEN=*), INTENT(IN) :: name !<
	2175
	2176	INTEGER(iwp) :: i !<
	2177	#if defined( __parallel )
	2178	INTEGER, DIMENSION(rd_status_size) :: status !<
	2179	#endif
	2180	INTEGER(isp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data !<
	2181
	2182
	2183	IF ( header_array_index == max_nr_arrays ) THEN
	2184	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2185	ENDIF
	2186
	2187	array_names(header_array_index) = name
	2188	array_offset(header_array_index) = array_position
	2189	header_array_index = header_array_index + 1
	2190
	2191	IF ( include_total_domain_boundaries ) THEN
	2192	!
	2193	!-- Prepare output of 3d-REAL-array with ghost layers. In the virtual PE grid, the first
	2194	!-- dimension is PEs along x, and the second along y. For MPI-IO it is recommended to have the
	2195	!-- index order of the array in the same way, i.e. the first dimension should be along x and the
	2196	!-- second along y. For this reason, the original PALM data need to be swaped.
	2197	DO i = iog%nxl, iog%nxr
	2198	array_3di4(:,i,iog%nys:iog%nyn) = data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
	2199	ENDDO
	2200
	2201	ELSE
	2202	!
	2203	!-- Prepare output of 3d-REAL-array without ghost layers
	2204	DO i = nxl, nxr
	2205	array_3di4(:,i,iog%nys:iog%nyn) = data(:,nys:nyn,i)
	2206	ENDDO
	2207
	2208	ENDIF
	2209	#if defined( __parallel )
	2210	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
	2211	IF ( sm_io%iam_io_pe ) THEN
	2212	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER, ft_3di4, 'native', MPI_INFO_NULL, ierr )
	2213	CALL MPI_FILE_WRITE_ALL( fh, array_3di4, SIZE( array_3di4 ), MPI_INTEGER, status, ierr )
	2214	ENDIF
	2215	CALL sm_io%sm_node_barrier()
	2216	#else
	2217	CALL posix_lseek( fh, array_position )
	2218	CALL posix_write( fh, array_3di4, SIZE( array_3di4 ) )
	2219	#endif
	2220	!
	2221	!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
	2222	!-- Maybe a compiler problem.
	2223	array_position = array_position + INT( (nz+2), KIND = rd_offset_kind ) * &
	2224	INT( (iog%ny+1), KIND = rd_offset_kind ) * &
	2225	INT( (iog%nx+1), KIND = rd_offset_kind ) * isp
	2226
	2227	write(9,*) 'array_position int4_3d ',trim(name),' ',array_position
	2228
	2229	END SUBROUTINE wrd_mpi_io_int4_3d
	2230
	2231
	2232
	2233	!--------------------------------------------------------------------------------------------------!
	2234	! Description:
	2235	! ------------
	2236	!> Write 3d-INTEGER*8 array with MPI-IO
	2237	!--------------------------------------------------------------------------------------------------!
	2238	SUBROUTINE wrd_mpi_io_int8_3d( name, data )
	2239
	2240	IMPLICIT NONE
	2241
	2242	CHARACTER(LEN=*), INTENT(IN) :: name !<
	2243
	2244	INTEGER(iwp) :: i !<
	2245	#if defined( __parallel )
	2246	INTEGER, DIMENSION(rd_status_size) :: status !<
	2247	#endif
	2248	INTEGER(idp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data !<
	2249
	2250
	2251	IF ( header_array_index == max_nr_arrays ) THEN
	2252	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2253	ENDIF
	2254
	2255	array_names(header_array_index) = name
	2256	array_offset(header_array_index) = array_position
	2257	header_array_index = header_array_index + 1
	2258
	2259	IF ( include_total_domain_boundaries ) THEN
	2260	!
	2261	!-- Prepare output of 3d-REAL-array with ghost layers. In the virtual PE grid, the first
	2262	!-- dimension is PEs along x, and the second along y. For MPI-IO it is recommended to have the
	2263	!-- index order of the array in the same way, i.e. the first dimension should be along x and the
	2264	!-- second along y. For this reason, the original PALM data need to be swaped.
	2265	DO i = iog%nxl, iog%nxr
	2266	array_3di8(:,i,iog%nys:iog%nyn) = data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
	2267	ENDDO
	2268
	2269	ELSE
	2270	!
	2271	!-- Prepare output of 3d-REAL-array without ghost layers
	2272	DO i = nxl, nxr
	2273	array_3di8(:,i,iog%nys:iog%nyn) = data(:,nys:nyn,i)
	2274	ENDDO
	2275
	2276	ENDIF
	2277	#if defined( __parallel )
	2278	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
	2279	IF ( sm_io%iam_io_pe ) THEN
	2280	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_INTEGER8, ft_3di8, 'native', MPI_INFO_NULL, ierr )
	2281	CALL MPI_FILE_WRITE_ALL( fh, array_3di8, SIZE( array_3di8 ), MPI_INTEGER8, status, ierr )
	2282	ENDIF
	2283	CALL sm_io%sm_node_barrier()
	2284	#else
	2285	CALL posix_lseek( fh, array_position )
	2286	CALL posix_write( fh, array_3di8, SIZE( array_3di8 ) )
	2287	#endif
	2288	!
	2289	!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
	2290	!-- Maybe a compiler problem.
	2291	array_position = array_position + INT( (nz+2), KIND = rd_offset_kind ) * &
	2292	INT( (iog%ny+1), KIND = rd_offset_kind ) * &
	2293	INT( (iog%nx+1), KIND = rd_offset_kind ) * dp
	2294
	2295	write(9,*) 'array_position int8_3d ',trim(name),' ',array_position
	2296
	2297	END SUBROUTINE wrd_mpi_io_int8_3d
	2298
	2299
	2300
	2301	!--------------------------------------------------------------------------------------------------!
	2302	! Description:
	2303	! ------------
[4495]	2304	!> Write 3d-REAL array with MPI-IO
	2305	!--------------------------------------------------------------------------------------------------!
	2306	SUBROUTINE wrd_mpi_io_real_3d( name, data )
	2307
	2308	IMPLICIT NONE
	2309
[4591]	2310	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2311
[4591]	2312	INTEGER(iwp) :: i !<
[4495]	2313	#if defined( __parallel )
[4591]	2314	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	2315	#endif
[4591]	2316	REAL(wp), INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data !<
[4495]	2317
	2318
[4539]	2319	IF ( header_array_index == max_nr_arrays ) THEN
	2320	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2321	ENDIF
[4495]	2322
[4539]	2323	array_names(header_array_index) = name
	2324	array_offset(header_array_index) = array_position
	2325	header_array_index = header_array_index + 1
	2326
[4495]	2327	IF ( include_total_domain_boundaries ) THEN
	2328	!
[4591]	2329	!-- Prepare output of 3d-REAL-array with ghost layers. In the virtual PE grid, the first
	2330	!-- dimension is PEs along x, and the second along y. For MPI-IO it is recommended to have the
	2331	!-- index order of the array in the same way, i.e. the first dimension should be along x and the
	2332	!-- second along y. For this reason, the original PALM data need to be swaped.
[4617]	2333	DO i = iog%nxl, iog%nxr
	2334	array_3d(:,i,iog%nys:iog%nyn) = data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
[4495]	2335	ENDDO
[4536]	2336
[4495]	2337	ELSE
	2338	!
	2339	!-- Prepare output of 3d-REAL-array without ghost layers
	2340	DO i = nxl, nxr
[4617]	2341	array_3d(:,i,iog%nys:iog%nyn) = data(:,nys:nyn,i)
[4495]	2342	ENDDO
[4536]	2343
[4495]	2344	ENDIF
	2345	#if defined( __parallel )
[4591]	2346	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
[4534]	2347	IF ( sm_io%iam_io_pe ) THEN
	2348	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3d, 'native', MPI_INFO_NULL, ierr )
	2349	CALL MPI_FILE_WRITE_ALL( fh, array_3d, SIZE( array_3d ), MPI_REAL, status, ierr )
	2350	ENDIF
	2351	CALL sm_io%sm_node_barrier()
[4495]	2352	#else
	2353	CALL posix_lseek( fh, array_position )
	2354	CALL posix_write( fh, array_3d, SIZE( array_3d ) )
	2355	#endif
	2356	!
[4591]	2357	!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
[4495]	2358	!-- Maybe a compiler problem.
[4617]	2359	array_position = array_position + INT( (nz+2), KIND = rd_offset_kind ) * &
	2360	INT( (iog%ny+1), KIND = rd_offset_kind ) * &
	2361	INT( (iog%nx+1), KIND = rd_offset_kind ) * wp
[4495]	2362
[4832]	2363	IF ( debug_output ) THEN
	2364	WRITE (9,*) 'array_position real3d ', TRIM( name ), ' ', array_position
	2365	FLUSH( 9 )
	2366	ENDIF
[4628]	2367
[4495]	2368	END SUBROUTINE wrd_mpi_io_real_3d
	2369
	2370
	2371
	2372	!--------------------------------------------------------------------------------------------------!
	2373	! Description:
	2374	! ------------
	2375	!> Write 3d-REAL soil array with MPI-IO.
	2376	!> nzb_soil, nzt_soil are located in the module land_surface_model_mod. Since Fortran does not allow
	2377	!> cross referencing of module variables, it is required to pass these variables as arguments.
	2378	!--------------------------------------------------------------------------------------------------!
	2379	SUBROUTINE wrd_mpi_io_real_3d_soil( name, data, nzb_soil, nzt_soil )
	2380
	2381	IMPLICIT NONE
	2382
[4591]	2383	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2384
[4591]	2385	INTEGER(iwp) :: i !<
	2386	INTEGER, INTENT(IN) :: nzb_soil !<
	2387	INTEGER, INTENT(IN) :: nzt_soil !<
[4495]	2388
	2389	#if defined( __parallel )
[4591]	2390	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	2391	#endif
	2392
[4591]	2393	REAL(wp), INTENT(IN), DIMENSION(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) :: data !<
[4495]	2394
	2395
[4539]	2396	IF ( header_array_index == max_nr_arrays ) THEN
	2397	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2398	ENDIF
[4495]	2399
[4539]	2400	array_names(header_array_index) = name
	2401	array_offset(header_array_index) = array_position
	2402	header_array_index = header_array_index + 1
	2403
[4534]	2404	#if defined( __parallel )
	2405	CALL rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
	2406	#endif
	2407
[4617]	2408	IF ( include_total_domain_boundaries) THEN
[4495]	2409	!
[4591]	2410	!-- Prepare output of 3d-REAL-array with ghost layers. In the virtual PE grid, the first
	2411	!-- dimension is PEs along x, and the second along y. For MPI-IO it is recommended to have the
	2412	!-- index order of the array in the same way, i.e. the first dimension should be along x and the
	2413	!-- second along y. For this reason, the original PALM data need to be swaped.
[4617]	2414	DO i = iog%nxl, iog%nxr
	2415	array_3d_soil(:,i,iog%nys:iog%nyn) = data(:,iog%nys-nbgp:iog%nyn-nbgp,i-nbgp)
[4495]	2416	ENDDO
[4536]	2417
[4495]	2418	ELSE
	2419	!
	2420	!-- Prepare output of 3d-REAL-array without ghost layers
	2421	DO i = nxl, nxr
[4617]	2422	array_3d_soil(:,i,iog%nys:iog%nyn) = data(:,nys:nyn,i)
[4495]	2423	ENDDO
[4536]	2424
[4495]	2425	ENDIF
	2426	#if defined( __parallel )
[4591]	2427	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
[4534]	2428	IF ( sm_io%iam_io_pe ) THEN
	2429	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_3dsoil, 'native', MPI_INFO_NULL, &
	2430	ierr )
	2431	CALL MPI_FILE_WRITE_ALL( fh, array_3d_soil, SIZE( array_3d_soil ), MPI_REAL, status, ierr )
	2432	ENDIF
	2433	CALL sm_io%sm_node_barrier()
[4495]	2434	#else
	2435	CALL posix_lseek( fh, array_position )
[4534]	2436	CALL posix_write( fh, array_3d_soil, SIZE( array_3d_soil ) )
[4495]	2437	#endif
	2438	!
[4591]	2439	!-- Type conversion required, otherwise right hand side brackets are calculated assuming 4 byte INT.
[4495]	2440	!-- Maybe a compiler problem.
[4591]	2441	array_position = array_position + INT( (nzt_soil-nzb_soil+1), KIND = rd_offset_kind ) * &
[4617]	2442	INT( (iog%ny+1), KIND = rd_offset_kind ) * &
	2443	INT( (iog%nx+1), KIND = rd_offset_kind ) * wp
[4495]	2444
	2445	END SUBROUTINE wrd_mpi_io_real_3d_soil
	2446
	2447
	2448
	2449	!--------------------------------------------------------------------------------------------------!
	2450	! Description:
	2451	! ------------
	2452	!> Write CHARATCTER with MPI-IO
	2453	!--------------------------------------------------------------------------------------------------!
	2454	SUBROUTINE wrd_mpi_io_char( name, text )
	2455
	2456	IMPLICIT NONE
	2457
[4591]	2458	CHARACTER(LEN=128) :: lo_line !<
	2459	CHARACTER(LEN=*), INTENT(IN) :: name !<
	2460	CHARACTER(LEN=*), INTENT(IN) :: text !<
[4495]	2461
	2462
[4539]	2463	IF ( header_char_index == max_nr_char ) THEN
	2464	STOP '+++ maximum number of CHARACTER entries in restart file header exceeded'
	2465	ENDIF
	2466
[4495]	2467	lo_line = name
	2468	lo_line(33:) = text
	2469	text_lines(header_char_index) = lo_line
	2470	header_char_index = header_char_index + 1
	2471
	2472	END SUBROUTINE wrd_mpi_io_char
	2473
	2474
	2475
	2476	!--------------------------------------------------------------------------------------------------!
	2477	! Description:
	2478	! ------------
	2479	!> Write LOGICAL with MPI-IO
	2480	!--------------------------------------------------------------------------------------------------!
	2481	SUBROUTINE wrd_mpi_io_logical( name, value )
	2482
	2483	IMPLICIT NONE
	2484
[4591]	2485	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2486
[4591]	2487	INTEGER(iwp) :: logical_as_integer !<
[4495]	2488
[4591]	2489	LOGICAL, INTENT(IN) :: value !<
[4495]	2490
	2491
	2492	IF ( value ) THEN
	2493	logical_as_integer = 1
	2494	ELSE
	2495	logical_as_integer = 0
	2496	ENDIF
	2497
	2498	CALL wrd_mpi_io_int( name, logical_as_integer )
	2499
	2500	END SUBROUTINE wrd_mpi_io_logical
	2501
	2502
	2503
	2504	!--------------------------------------------------------------------------------------------------!
	2505	! Description:
	2506	! ------------
[4735]	2507	!> Write 3D-LOGICAL with MPI-IO
	2508	!--------------------------------------------------------------------------------------------------!
	2509	SUBROUTINE wrd_mpi_io_logical_3d( name, data )
	2510
	2511	IMPLICIT NONE
	2512
	2513	CHARACTER(LEN=*), INTENT(IN) :: name !<
	2514
	2515	INTEGER(iwp) :: i !< loop index
	2516	INTEGER(iwp) :: j !< loop index
	2517	INTEGER(iwp) :: k !< loop index
	2518
	2519	INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: logical_as_integer !<
	2520
	2521	LOGICAL, INTENT(IN), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: data !<
	2522
	2523
	2524	DO i = nxlg, nxrg
	2525	DO j = nysg, nyng
	2526	DO k = nzb, nzt+1
	2527	IF ( data(k,j,i) ) THEN
	2528	logical_as_integer(k,j,i) = 1
	2529	ELSE
	2530	logical_as_integer(k,j,i) = 0
	2531	ENDIF
	2532	ENDDO
	2533	ENDDO
	2534	ENDDO
	2535
	2536	CALL wrd_mpi_io_int4_3d( name, logical_as_integer )
	2537
	2538	END SUBROUTINE wrd_mpi_io_logical_3d
	2539
	2540
	2541
	2542	!--------------------------------------------------------------------------------------------------!
	2543	! Description:
	2544	! ------------
[4495]	2545	!> Read 1d-REAL global array with MPI-IO.
	2546	!> Array contains identical data on all PEs.
	2547	!--------------------------------------------------------------------------------------------------!
	2548	SUBROUTINE rrd_mpi_io_global_array_real_1d( name, data )
	2549
	2550	IMPLICIT NONE
	2551
[4591]	2552	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2553
[4591]	2554	INTEGER(iwp) :: i !<
	2555	INTEGER(KIND=rd_offset_kind) :: offset !<
[4495]	2556
	2557	#if defined( __parallel )
[4591]	2558	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	2559	#endif
	2560
[4591]	2561	LOGICAL :: found !<
[4495]	2562
[4591]	2563	REAL(KIND=wp), INTENT(INOUT), DIMENSION(:) :: data !<
[4495]	2564
	2565
	2566	offset = 0
	2567	found = .FALSE.
	2568
	2569	DO i = 1, tgh%nr_arrays
	2570	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	2571	array_position = array_offset(i)
	2572	found = .TRUE.
	2573	EXIT
	2574	ENDIF
	2575	ENDDO
	2576
[4617]	2577
[4495]	2578	IF ( found ) THEN
[4617]	2579
[4495]	2580	!
	2581	!-- Set default view
	2582	#if defined( __parallel )
[4617]	2583	IF ( cyclic_fill_mode ) THEN !kk This may be the general solution for all cases
	2584	IF ( pe_active_for_read ) THEN
	2585	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	2586	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	2587	CALL MPI_FILE_READ_ALL( fh, data, SIZE( data ), MPI_REAL, status, ierr )
	2588	ENDIF
	2589	CALL MPI_BCAST( data, SIZE( data ), MPI_REAL, 0, comm2d, ierr )
	2590	ELSE
	2591	IF ( sm_io%iam_io_pe ) THEN
	2592	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	2593	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	2594	CALL MPI_FILE_READ_ALL( fh, data, SIZE( data ), MPI_REAL, status, ierr )
	2595	ENDIF
	2596	IF ( sm_io%is_sm_active() ) THEN
	2597	CALL MPI_BCAST( data, SIZE( data ), MPI_REAL, 0, sm_io%comm_shared, ierr )
	2598	ENDIF
[4534]	2599	ENDIF
[4495]	2600	#else
	2601	CALL posix_lseek( fh, array_position )
	2602	CALL posix_read( fh, data, SIZE( data ) )
	2603	#endif
[4536]	2604
[4495]	2605	ELSE
[4536]	2606
	2607	message_string = '1d/2d/3d/4d-REAL global array "' // TRIM( name ) // '" not found in ' // &
	2608	'restart file'
	2609	CALL message( 'rrd_mpi_io_global_array_real_1d', 'PA0722', 3, 2, 0, 6, 0 )
	2610
[4495]	2611	ENDIF
	2612
	2613	END SUBROUTINE rrd_mpi_io_global_array_real_1d
	2614
	2615
	2616
	2617	!--------------------------------------------------------------------------------------------------!
	2618	! Description:
	2619	! ------------
	2620	!> Read 2d-REAL global array with MPI-IO.
	2621	!> Array contains identical data on all PEs.
	2622	!--------------------------------------------------------------------------------------------------!
	2623	SUBROUTINE rrd_mpi_io_global_array_real_2d( name, data )
	2624
	2625	IMPLICIT NONE
	2626
[4591]	2627	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2628
[4591]	2629	INTEGER, DIMENSION(1) :: bufshape !<
[4495]	2630
[4591]	2631	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:), TARGET :: data !<
	2632	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf !<
[4495]	2633
[4591]	2634	TYPE(C_PTR) :: c_data !<
[4495]	2635
	2636
	2637	c_data = C_LOC( data )
	2638	bufshape(1) = SIZE( data )
	2639	CALL C_F_POINTER( c_data, buf, bufshape )
	2640
	2641	CALL rrd_mpi_io_global_array_real_1d( name, buf )
	2642
	2643	END SUBROUTINE rrd_mpi_io_global_array_real_2d
	2644
	2645
	2646
	2647	!--------------------------------------------------------------------------------------------------!
	2648	! Description:
	2649	! ------------
	2650	!> Read 3d-REAL global array with MPI-IO.
	2651	!> Array contains identical data on all PEs.
	2652	!--------------------------------------------------------------------------------------------------!
	2653	SUBROUTINE rrd_mpi_io_global_array_real_3d( name, data )
	2654
	2655	IMPLICIT NONE
	2656
[4591]	2657	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2658
[4591]	2659	INTEGER, DIMENSION(1) :: bufshape !<
[4495]	2660
[4591]	2661	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:), TARGET :: data !<
	2662	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf !<
[4495]	2663
[4591]	2664	TYPE(C_PTR) :: c_data !<
[4495]	2665
	2666
	2667	c_data = C_LOC( data )
	2668	bufshape(1) = SIZE( data )
	2669	CALL C_F_POINTER( c_data, buf, bufshape )
	2670
	2671	CALL rrd_mpi_io_global_array_real_1d( name, buf )
	2672
	2673	END SUBROUTINE rrd_mpi_io_global_array_real_3d
	2674
	2675
	2676
	2677	!--------------------------------------------------------------------------------------------------!
	2678	! Description:
	2679	! ------------
	2680	!> Read 4d-REAL global array with MPI-IO.
	2681	!> Array contains identical data on all PEs.
	2682	!--------------------------------------------------------------------------------------------------!
	2683	SUBROUTINE rrd_mpi_io_global_array_real_4d( name, data )
	2684
	2685	IMPLICIT NONE
	2686
[4591]	2687	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2688
[4591]	2689	INTEGER, DIMENSION(1) :: bufshape !<
[4495]	2690
[4591]	2691	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:,:), TARGET :: data !<
	2692	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf !<
[4495]	2693
[4591]	2694	TYPE(C_PTR) :: c_data !<
[4495]	2695
	2696
	2697	c_data = C_LOC( data )
	2698	bufshape(1) = SIZE( data)
	2699	CALL C_F_POINTER( c_data, buf, bufshape )
	2700
	2701	CALL rrd_mpi_io_global_array_real_1d( name, buf )
	2702
	2703	END SUBROUTINE rrd_mpi_io_global_array_real_4d
	2704
	2705
	2706
	2707	!--------------------------------------------------------------------------------------------------!
	2708	! Description:
	2709	! ------------
	2710	!> Read 1d-INTEGER global array with MPI-IO.
	2711	!> Array contains identical data on all PEs.
	2712	!--------------------------------------------------------------------------------------------------!
[4536]	2713	SUBROUTINE rrd_mpi_io_global_array_int_1d( name, data )
[4495]	2714
	2715	IMPLICIT NONE
	2716
[4591]	2717	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2718
[4591]	2719	INTEGER(iwp) :: i !<
	2720	INTEGER(KIND=rd_offset_kind) :: offset !<
[4495]	2721
	2722	#if defined( __parallel )
[4591]	2723	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	2724	#endif
[4591]	2725	INTEGER(KIND=iwp), INTENT(INOUT), DIMENSION(:) :: data !<
[4495]	2726
[4591]	2727	LOGICAL :: found !<
[4495]	2728
	2729
	2730	offset = 0
	2731	found = .FALSE.
	2732
	2733	DO i = 1, tgh%nr_arrays
[4591]	2734	IF ( TRIM( array_names(i) ) == TRIM( name ) ) THEN
[4495]	2735	array_position = array_offset(i)
	2736	found = .TRUE.
	2737	EXIT
	2738	ENDIF
	2739	ENDDO
	2740
	2741	IF ( found ) THEN
	2742	!
	2743	!-- Set default view
	2744	#if defined( __parallel )
[4617]	2745	IF ( cyclic_fill_mode ) THEN !kk This may be the general solution for all cases
	2746	IF ( pe_active_for_read ) THEN
	2747	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	2748	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	2749	CALL MPI_FILE_READ_ALL( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
	2750	ENDIF
	2751	CALL MPI_BCAST( data, SIZE( data ), MPI_REAL, 0, comm2d, ierr )
	2752	ELSE
	2753	IF ( sm_io%iam_io_pe ) THEN
	2754	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	2755	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	2756	CALL MPI_FILE_READ_ALL( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
	2757	ENDIF
	2758	IF ( sm_io%is_sm_active() ) THEN
	2759	CALL MPI_BCAST( data, SIZE( data ), MPI_INTEGER, 0, sm_io%comm_shared, ierr )
	2760	ENDIF
[4534]	2761	ENDIF
[4495]	2762	#else
	2763	CALL posix_lseek( fh, array_position )
	2764	CALL posix_read( fh, data, SIZE( data ) )
	2765	#endif
	2766	ELSE
[4536]	2767
	2768	message_string = '1d-INTEGER global array "' // TRIM( name ) // '" not found in ' // &
	2769	'restart file'
	2770	CALL message( 'rrd_mpi_io_global_array_int_1d', 'PA0722', 3, 2, 0, 6, 0 )
	2771
[4495]	2772	ENDIF
	2773
	2774	END SUBROUTINE rrd_mpi_io_global_array_int_1d
	2775
	2776
	2777
	2778	!--------------------------------------------------------------------------------------------------!
	2779	! Description:
	2780	! ------------
	2781	!> Write 1d-REAL global array with MPI-IO.
	2782	!> Array contains identical data on all PEs.
	2783	!--------------------------------------------------------------------------------------------------!
	2784	SUBROUTINE wrd_mpi_io_global_array_real_1d( name, data )
	2785
	2786	IMPLICIT NONE
	2787
[4591]	2788	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2789
[4591]	2790	INTEGER(KIND=rd_offset_kind) :: offset !<
[4495]	2791
	2792	#if defined( __parallel )
[4591]	2793	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	2794	#endif
	2795
[4591]	2796	REAL(KIND=wp), INTENT(IN), DIMENSION(:) :: data !<
[4495]	2797
	2798
	2799	offset = 0
	2800
[4539]	2801	IF ( header_array_index == max_nr_arrays ) THEN
	2802	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2803	ENDIF
[4495]	2804
[4539]	2805	array_names(header_array_index) = name
	2806	array_offset(header_array_index) = array_position
	2807	header_array_index = header_array_index + 1
	2808
[4495]	2809	!
[4536]	2810	!-- Set default view
[4495]	2811	#if defined( __parallel )
[4536]	2812	IF ( sm_io%iam_io_pe ) THEN
	2813	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	2814	ENDIF
[4495]	2815	!
[4536]	2816	!-- Only PE 0 writes replicated data
	2817	IF ( myid == 0 ) THEN
	2818	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
[4591]	2819	CALL MPI_FILE_WRITE( fh, data, SIZE( data ), MPI_REAL, status, ierr )
[4536]	2820	ENDIF
[4495]	2821	#else
[4536]	2822	CALL posix_lseek( fh, array_position )
	2823	CALL posix_write( fh, data, SIZE( data ) )
[4495]	2824	#endif
[4536]	2825	array_position = array_position + SIZE( data ) * wp
[4495]	2826
	2827	END SUBROUTINE wrd_mpi_io_global_array_real_1d
	2828
	2829
	2830
	2831	!--------------------------------------------------------------------------------------------------!
	2832	! Description:
	2833	! ------------
	2834	!> Write 2d-REAL global array with MPI-IO.
	2835	!> Array contains identical data on all PEs.
	2836	!--------------------------------------------------------------------------------------------------!
	2837	SUBROUTINE wrd_mpi_io_global_array_real_2d( name, data )
	2838
	2839	IMPLICIT NONE
	2840
[4591]	2841	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2842
[4591]	2843	INTEGER, DIMENSION(1) :: bufshape !<
[4495]	2844
[4591]	2845	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf !<
	2846	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:), TARGET :: data !<
[4495]	2847
[4591]	2848	TYPE(C_PTR) :: c_data !<
[4495]	2849
	2850
	2851	c_data = C_LOC( data )
	2852	bufshape(1) = SIZE( data)
	2853	CALL C_F_POINTER( c_data, buf, bufshape )
	2854
	2855	CALL wrd_mpi_io_global_array_real_1d( name, buf )
	2856
	2857	END SUBROUTINE wrd_mpi_io_global_array_real_2d
	2858
	2859
	2860
	2861	!--------------------------------------------------------------------------------------------------!
	2862	! Description:
	2863	! ------------
	2864	!> Write 3d-REAL global array with MPI-IO.
	2865	!> Array contains identical data on all PEs.
	2866	!--------------------------------------------------------------------------------------------------!
	2867	SUBROUTINE wrd_mpi_io_global_array_real_3d( name, data )
	2868
	2869	IMPLICIT NONE
	2870
[4591]	2871	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2872
[4591]	2873	INTEGER, DIMENSION(1) :: bufshape !<
[4495]	2874
[4591]	2875	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf !<
	2876	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:), TARGET :: data !<
[4495]	2877
[4591]	2878	TYPE(C_PTR) :: c_data !<
[4495]	2879
	2880
	2881	c_data = C_LOC( data )
	2882	bufshape(1) = SIZE( data )
	2883	CALL C_F_POINTER( c_data, buf, bufshape )
	2884
	2885	CALL wrd_mpi_io_global_array_real_1d( name, buf )
	2886
	2887	END SUBROUTINE wrd_mpi_io_global_array_real_3d
	2888
	2889
	2890
	2891	!--------------------------------------------------------------------------------------------------!
	2892	! Description:
	2893	! ------------
	2894	!> Write 4d-REAL global array with MPI-IO.
	2895	!> Array contains identical data on all PEs.
	2896	!--------------------------------------------------------------------------------------------------!
	2897	SUBROUTINE wrd_mpi_io_global_array_real_4d( name, data )
	2898
	2899	IMPLICIT NONE
	2900
[4591]	2901	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2902
[4591]	2903	INTEGER, DIMENSION(1) :: bufshape !<
[4495]	2904
[4591]	2905	REAL(KIND=wp), POINTER, DIMENSION(:) :: buf !<
	2906	REAL(KIND=wp), INTENT(IN), DIMENSION(:,:,:,:), TARGET :: data !<
[4495]	2907
[4591]	2908	TYPE(C_PTR) :: c_data !<
[4495]	2909
	2910
	2911	c_data = C_LOC( data )
	2912	bufshape(1) = SIZE( data)
	2913	CALL C_F_POINTER( c_data, buf, bufshape )
	2914
	2915	CALL wrd_mpi_io_global_array_real_1d( name, buf )
	2916
	2917	END SUBROUTINE wrd_mpi_io_global_array_real_4d
	2918
	2919
	2920
	2921	!--------------------------------------------------------------------------------------------------!
	2922	! Description:
	2923	! ------------
	2924	!> Write 1d-INTEGER global array with MPI-IO.
	2925	!> Array contains identical data on all PEs.
	2926	!--------------------------------------------------------------------------------------------------!
	2927	SUBROUTINE wrd_mpi_io_global_array_int_1d( name, data )
	2928
	2929	IMPLICIT NONE
	2930
[4591]	2931	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	2932
[4591]	2933	INTEGER(KIND=rd_offset_kind) :: offset !<
[4495]	2934
[4591]	2935	INTEGER(KIND=iwp), INTENT(IN), DIMENSION(:) :: data !<
[4495]	2936	#if defined( __parallel )
[4591]	2937	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	2938	#endif
	2939
[4539]	2940	IF ( header_array_index == max_nr_arrays ) THEN
	2941	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	2942	ENDIF
	2943
[4495]	2944	offset = 0
[4539]	2945	array_names(header_array_index) = name
	2946	array_offset(header_array_index) = array_position
	2947	header_array_index = header_array_index + 1
[4495]	2948
	2949	!
	2950	!-- Set default view
	2951	#if defined( __parallel )
[4534]	2952	IF ( sm_io%iam_io_pe ) THEN
	2953	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	2954	ENDIF
[4495]	2955	!
	2956	!-- Only PE 0 writes replicated data
[4591]	2957	IF ( myid == 0 ) THEN
[4495]	2958	CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
	2959	CALL MPI_FILE_WRITE( fh, data, SIZE( data), MPI_INTEGER, status, ierr )
	2960	ENDIF
	2961	#else
	2962	CALL posix_lseek( fh, array_position )
	2963	CALL posix_write( fh, data, SIZE( data ) )
	2964	#endif
	2965	array_position = array_position + SIZE( data ) * 4
	2966
	2967	END SUBROUTINE wrd_mpi_io_global_array_int_1d
	2968
	2969
	2970
	2971	!--------------------------------------------------------------------------------------------------!
	2972	! Description:
	2973	! ------------
[4628]	2974	!> Read particle data array with MPI-IO.
	2975	!--------------------------------------------------------------------------------------------------!
	2976	SUBROUTINE rrd_mpi_io_particles( name, prt_global_index )
	2977
	2978	IMPLICIT NONE
	2979
	2980	CHARACTER(LEN=*), INTENT(IN) :: name !<
	2981	INTEGER(idp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: prt_global_index !<
	2982
	2983	INTEGER(iwp) :: array_size !<
	2984	INTEGER(iwp) :: byte_column !<
	2985	INTEGER(iwp) :: i !<
	2986	INTEGER(iwp) :: ind !<
	2987	INTEGER(iwp) :: j !<
	2988	INTEGER(iwp) :: k !<
	2989	INTEGER(iwp) :: n !<
	2990	INTEGER(iwp) :: particle_size !<
	2991
	2992	INTEGER(KIND=rd_offset_kind) :: disp !<
	2993	INTEGER(KIND=rd_offset_kind) :: offset !<
	2994	INTEGER(KIND=rd_offset_kind) :: prt_nr_bytes !<
	2995
	2996	LOGICAL :: found !<
	2997
	2998	REAL(dp) :: rr !< there is no data type INTEGER*8 in MPI
	2999	REAL(dp) :: rs !< use REAL*8 to compute max offset
	3000
	3001	TYPE(particle_type), DIMENSION(:), ALLOCATABLE, TARGET :: prt_data !<
	3002
	3003	#if defined( __parallel )
	3004	INTEGER, DIMENSION(rd_status_size) :: status !<
	3005	#else
	3006	TYPE(C_PTR) :: buf
	3007	#endif
	3008
	3009	found = .FALSE.
	3010
	3011	DO i = 1, tgh%nr_arrays
	3012	IF ( TRIM(array_names(i)) == TRIM( name ) ) THEN
	3013	array_position = array_offset(i)
	3014	found = .TRUE.
	3015	EXIT
	3016	ENDIF
	3017	ENDDO
	3018
	3019	IF ( found ) THEN
	3020
	3021	offset = 0
	3022
	3023	particle_size = STORAGE_SIZE(zero_particle) / 8 ! 8 here means number of bits/byte, NOT wp
	3024
	3025	array_size = 0
	3026	DO i = nxl, nxr
	3027	DO j = nys, nyn
	3028	array_size = MAX( array_size, SUM(prt_count(:,j,i)) )
	3029	ENDDO
	3030	ENDDO
	3031
	3032	write(9,*) 'particle_size_read ',particle_size,array_size,array_position,sum(prt_global_index)
	3033
	3034	ALLOCATE( prt_data(MAX(array_size,1)) )
	3035
	3036	!
	3037	!-- Write columns of particle
	3038	#if defined( __parallel )
	3039	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	3040	#endif
	3041	prt_nr_bytes = 0
	3042	DO i = nxl, nxr
	3043	DO j = nys, nyn
	3044	disp = array_position + prt_global_index(nzb,j,i) * particle_size
	3045	byte_column = SUM( prt_count(:,j,i) ) * particle_size
	3046	prt_nr_bytes = MAX( disp+byte_column, prt_nr_bytes )
	3047
	3048	#if defined( __parallel )
	3049	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
	3050	IF ( byte_column > 0 ) THEN
	3051	CALL MPI_FILE_SEEK( fh, disp, MPI_SEEK_SET, ierr )
	3052	CALL MPI_FILE_READ( fh, prt_data, byte_column, MPI_BYTE, status, ierr )
	3053	ENDIF
	3054	CALL sm_io%sm_node_barrier()
	3055	#else
	3056	buf = C_LOC(prt_data) ! use C_PTR to avaid another overlay in posix interface
	3057	CALL posix_lseek( fh, disp )
	3058	CALL posix_read( fh, buf, byte_column )
	3059	#endif
	3060	ind = 1
	3061	DO k = nzb, nzt+1
	3062	DO n = 1, prt_count(k,j,i)
	3063	grid_particles(k,j,i)%particles(n) = prt_data(ind)
	3064	ind = ind+1
	3065	ENDDO
	3066	ENDDO
	3067
	3068	ENDDO
	3069	ENDDO
	3070
	3071	#if defined( __parallel )
	3072	rs = prt_nr_bytes
	3073	CALL MPI_ALLREDUCE( rs, rr, 1, MPI_DOUBLE_PRECISION, MPI_MAX, comm2d, ierr )
	3074	prt_nr_bytes = rr
	3075	#else
	3076	rr = rs
	3077	#endif
	3078	array_position = prt_nr_bytes
	3079
	3080	write(9,*) 'array_position after particle read ',array_position,prt_nr_bytes,rs
	3081
	3082	DEALLOCATE( prt_data )
	3083
	3084	ENDIF
	3085
	3086	END SUBROUTINE rrd_mpi_io_particles
	3087
	3088
	3089
	3090	!--------------------------------------------------------------------------------------------------!
	3091	! Description:
	3092	! ------------
[4495]	3093	!> Read 1d-REAL surface data array with MPI-IO.
	3094	!--------------------------------------------------------------------------------------------------!
	3095	SUBROUTINE rrd_mpi_io_surface( name, data, first_index )
	3096
	3097	IMPLICIT NONE
	3098
[4591]	3099	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	3100
[4591]	3101	INTEGER(KIND=rd_offset_kind) :: disp !< displacement of actual indices
	3102	INTEGER(KIND=rd_offset_kind) :: disp_f !< displacement in file
	3103	INTEGER(KIND=rd_offset_kind) :: disp_n !< displacement of next column
	3104	INTEGER(iwp), OPTIONAL :: first_index !<
[4495]	3105
[4591]	3106	INTEGER(iwp) :: i !<
	3107	INTEGER(iwp) :: i_f !<
	3108	INTEGER(iwp) :: j !<
	3109	INTEGER(iwp) :: j_f !<
	3110	INTEGER(iwp) :: lo_first_index !<
	3111	INTEGER(iwp) :: nr_bytes !<
	3112	INTEGER(iwp) :: nr_bytes_f !<
	3113	INTEGER(iwp) :: nr_words !<
[4495]	3114	#if defined( __parallel )
[4591]	3115	INTEGER, DIMENSION(rd_status_size) :: status !<
[4628]	3116	#else
	3117	TYPE(C_PTR) :: buf !<
[4495]	3118	#endif
	3119
[4591]	3120	LOGICAL :: found !<
[4495]	3121
[4628]	3122	REAL(wp), INTENT(OUT), DIMENSION(:), TARGET :: data !<
[4495]	3123
	3124
	3125	found = .FALSE.
	3126	lo_first_index = 1
	3127
	3128	IF ( PRESENT( first_index ) ) THEN
	3129	lo_first_index = first_index
	3130	ENDIF
	3131
	3132	DO i = 1, tgh%nr_arrays
	3133	IF ( TRIM( array_names(i) ) == TRIM( name ) ) THEN
	3134	array_position = array_offset(i) + ( lo_first_index - 1 ) * &
[4591]	3135	total_number_of_surface_values * wp
[4495]	3136	found = .TRUE.
	3137	EXIT
	3138	ENDIF
	3139	ENDDO
	3140
	3141	disp = -1
	3142	disp_f = -1
	3143	disp_n = -1
	3144	IF ( found ) THEN
	3145
[4617]	3146	IF ( cyclic_fill_mode ) THEN
[4495]	3147
[4617]	3148	CALL rrd_mpi_io_surface_cyclic_fill
	3149
	3150	ELSE
	3151
	3152	IF ( MAXVAL( m_global_start ) == -1 ) RETURN ! Nothing to do on this PE
	3153	DO i = nxl, nxr
	3154	DO j = nys, nyn
	3155
	3156	IF ( m_global_start(j,i) > 0 ) THEN
	3157	disp = array_position+(m_global_start(j,i)-1) * wp
	3158	nr_words = m_end_index(j,i)-m_start_index(j,i)+1
	3159	nr_bytes = nr_words * wp
[4495]	3160	ENDIF
[4617]	3161	IF ( disp >= 0 .AND. disp_f == -1 ) THEN ! First entry
	3162	disp_f = disp
	3163	nr_bytes_f = 0
	3164	i_f = i
	3165	j_f = j
[4495]	3166	ENDIF
[4617]	3167	IF ( j == nyn .AND. i == nxr ) THEN ! Last entry
	3168	disp_n = -1
	3169	IF ( nr_bytes > 0 ) THEN
	3170	nr_bytes_f = nr_bytes_f+nr_bytes
	3171	ENDIF
	3172	ELSEIF ( j == nyn ) THEN ! Next x
	3173	IF ( m_global_start(nys,i+1) > 0 .AND. disp > 0 ) THEN
	3174	disp_n = array_position + ( m_global_start(nys,i+1) - 1 ) * wp
	3175	ELSE
	3176	CYCLE
	3177	ENDIF
[4495]	3178	ELSE
[4617]	3179	IF ( m_global_start(j+1,i) > 0 .AND. disp > 0 ) THEN
	3180	disp_n = array_position + ( m_global_start(j+1,i) - 1 ) * wp
	3181	ELSE
	3182	CYCLE
	3183	ENDIF
[4495]	3184	ENDIF
	3185
	3186
[4617]	3187	IF ( disp + nr_bytes == disp_n ) THEN ! Contiguous block
	3188	nr_bytes_f = nr_bytes_f + nr_bytes
	3189	ELSE ! Read
[4495]	3190	#if defined( __parallel )
[4617]	3191	CALL MPI_FILE_SEEK( fhs, disp_f, MPI_SEEK_SET, ierr )
	3192	nr_words = nr_bytes_f / wp
	3193	CALL MPI_FILE_READ( fhs, data(m_start_index(j_f,i_f)), nr_words, MPI_REAL, status, &
	3194	ierr )
[4495]	3195	#else
[4628]	3196	!
	3197	!-- Use C_PTR here, because posix read does not work with indexed array
	3198	buf = C_LOC( data(m_start_index(j_f,i_f)) )
[4617]	3199	CALL posix_lseek( fh, disp_f )
[4628]	3200	CALL posix_read( fh, buf, nr_bytes_f )
[4495]	3201	#endif
[4617]	3202	disp_f = disp
	3203	nr_bytes_f = nr_bytes
	3204	i_f = i
	3205	j_f = j
	3206	ENDIF
[4495]	3207
[4617]	3208	ENDDO
[4495]	3209	ENDDO
[4617]	3210	ENDIF
[4495]	3211
[4617]	3212
[4495]	3213	ELSE
[4536]	3214
	3215	message_string = 'surface array "' // TRIM( name ) // '" not found in restart file'
[4694]	3216	CALL message( 'rrd_mpi_io_surface', 'PA0722', 3, 2, 0, 6, 0 )
[4536]	3217
[4495]	3218	ENDIF
	3219
[4617]	3220	CONTAINS
	3221
	3222	SUBROUTINE rrd_mpi_io_surface_cyclic_fill
	3223
	3224	IMPLICIT NONE
	3225
	3226	INTEGER(iwp) :: i !<
	3227	INTEGER(iwp) :: ie !<
[4622]	3228	#if defined( __parallel )
[4617]	3229	INTEGER(iwp) :: ierr !<
[4622]	3230	#endif
[4617]	3231	INTEGER(iwp) :: is !<
	3232	INTEGER(iwp) :: i_remote !<
	3233	INTEGER(iwp) :: j !<
	3234	INTEGER(iwp) :: je !<
	3235	INTEGER(iwp) :: js !<
	3236	INTEGER(iwp) :: j_remote !<
	3237	INTEGER(iwp) :: nval !<
	3238	INTEGER(iwp) :: rem_pe !<
	3239
[4621]	3240	#if defined( __parallel )
[4617]	3241	INTEGER(KIND=MPI_ADDRESS_KIND) :: rem_offs !<
[4621]	3242	#else
	3243	INTEGER(idp) :: rem_offs
	3244	#endif
[4617]	3245
	3246	LOGICAL :: write_done !<
	3247
	3248
	3249	!
	3250	!-- In the current version, there is only 1 value per grid cell allowed.
	3251	!-- In this special case, the cyclical repetition can be done with the same method as for 2d-real
	3252	!-- array.
	3253	CALL prerun_grid%activate_grid_from_this_class()
	3254
	3255	IF ( pe_active_for_read ) THEN
	3256	rmabuf_2d = -1.0
	3257	DO i = nxl, nxr
	3258	DO j = nys, nyn
	3259
	3260	IF ( m_global_start(j,i) > 0 ) THEN
	3261	disp = array_position+(m_global_start(j,i)-1) * wp
	3262	nr_words = m_end_index(j,i)-m_start_index(j,i)+1
	3263	nr_bytes = nr_words * wp
	3264	ENDIF
	3265	IF ( disp >= 0 .AND. disp_f == -1 ) THEN ! First entry
	3266	disp_f = disp
	3267	nr_bytes_f = 0
	3268	write_done = .TRUE.
	3269	ENDIF
	3270	IF( write_done ) THEN
	3271	i_f = i
	3272	j_f = j
	3273	write_done = .FALSE.
	3274	ENDIF
	3275
	3276	IF ( j == nyn .AND. i == nxr ) THEN ! Last entry
	3277	disp_n = -1
	3278	IF ( nr_bytes > 0 ) THEN
	3279	nr_bytes_f = nr_bytes_f+nr_bytes
	3280	ENDIF
	3281	ELSEIF ( j == nyn ) THEN ! Next x
	3282	IF ( m_global_start(nys,i+1) > 0 .AND. disp > 0 ) THEN
	3283	disp_n = array_position + ( m_global_start(nys,i+1) - 1 ) * wp
	3284	ELSE
	3285	CYCLE
	3286	ENDIF
	3287	ELSE
	3288	IF ( m_global_start(j+1,i) > 0 .AND. disp > 0 ) THEN
	3289	disp_n = array_position + ( m_global_start(j+1,i) - 1 ) * wp
	3290	ELSE
	3291	CYCLE
	3292	ENDIF
	3293	ENDIF
	3294
	3295
	3296	IF ( disp + nr_bytes == disp_n ) THEN ! Contiguous block
	3297	nr_bytes_f = nr_bytes_f + nr_bytes
	3298	ELSE ! Read
	3299	#if defined( __parallel )
	3300	CALL MPI_FILE_SEEK( fhs, disp_f, MPI_SEEK_SET, ierr )
	3301	nr_words = nr_bytes_f / wp
	3302	CALL MPI_FILE_READ( fhs, rmabuf_2d(j_f,i_f), nr_words, MPI_REAL, status, ierr )
	3303	#else
	3304	CALL posix_lseek( fh, disp_f )
[4621]	3305	CALL posix_read( fh, rmabuf_2d(j_f:,i_f:), nr_bytes_f )
[4617]	3306	#endif
	3307
	3308	disp_f = disp
	3309	nr_bytes_f = nr_bytes
	3310	write_done = .TRUE.
	3311	ENDIF
	3312
	3313	ENDDO
	3314	ENDDO
	3315
	3316	ENDIF
	3317
	3318	CALL mainrun_grid%activate_grid_from_this_class()
	3319
	3320	#if defined( __parallel )
	3321	!
	3322	!-- Close RMA window to allow remote access
	3323	CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
	3324	#endif
	3325
	3326	IF ( .NOT. pe_active_for_read ) THEN
	3327
	3328	is = nxl
	3329	ie = nxr
	3330	js = nys
	3331	je = nyn
	3332
	3333	ELSE
	3334
	3335	is = nxl
	3336	ie = nxr
	3337	js = prerun_grid%nys+1
	3338	je = nyn
	3339
	3340	DO i = is, ie
	3341	DO j = js, je
	3342	i_remote = MOD(i,nx_on_file+1)
	3343	j_remote = MOD(j,ny_on_file+1)
	3344	rem_pe = remote_pe(i_remote,j_remote)
	3345	rem_offs = rma_offset(i_remote,j_remote)
	3346	nval = 1
	3347
	3348	#if defined( __parallel )
	3349	IF ( rem_pe /= myid ) THEN
	3350	CALL MPI_GET( data(m_start_index(j,i)), nval, MPI_REAL, rem_pe, rem_offs, nval, &
	3351	MPI_REAL, rmawin_2d, ierr)
	3352	ELSE
	3353	data(m_start_index(j,i)) = rmabuf_2d(j_remote,i_remote)
	3354	ENDIF
	3355	#else
	3356	data(m_start_index(j,i)) = array_2d(i_remote,j_remote)
	3357	#endif
	3358	ENDDO
	3359	ENDDO
	3360	is = prerun_grid%nxr+1
	3361	ie = nxr
	3362	js = nys
	3363	je = nyn
	3364
	3365	ENDIF
	3366
	3367	DO i = is, ie
	3368	DO j = js, je
	3369	i_remote = MOD(i,nx_on_file+1)
	3370	j_remote = MOD(j,ny_on_file+1)
	3371	rem_pe = remote_pe(i_remote,j_remote)
	3372	rem_offs = rma_offset(i_remote,j_remote)
	3373	nval = 1
	3374
	3375	#if defined( __parallel )
	3376	IF ( rem_pe /= myid ) THEN
	3377	CALL MPI_GET( data(m_start_index(j,i)), nval, MPI_REAL, rem_pe, rem_offs, nval, &
	3378	MPI_REAL, rmawin_2d, ierr)
	3379	ELSE
	3380	data(m_start_index(j,i)) = rmabuf_2d(j_remote,i_remote)
	3381	ENDIF
	3382	#else
[4621]	3383	data(m_start_index(j,i)) = array_2d(i_remote,j_remote)
[4617]	3384	#endif
	3385	ENDDO
	3386	ENDDO
	3387
	3388	#if defined( __parallel )
	3389	!
	3390	!-- Reopen RMA window to allow filling
	3391	CALL MPI_WIN_FENCE( 0, rmawin_2d, ierr )
	3392	#endif
	3393
	3394	END SUBROUTINE rrd_mpi_io_surface_cyclic_fill
	3395
[4495]	3396	END SUBROUTINE rrd_mpi_io_surface
	3397
	3398
	3399
	3400	!--------------------------------------------------------------------------------------------------!
	3401	! Description:
	3402	! ------------
	3403	!> Read 2d-REAL surface data array with MPI-IO.
	3404	!> These consist of multiple 1d-REAL surface data arrays.
	3405	!--------------------------------------------------------------------------------------------------!
	3406	SUBROUTINE rrd_mpi_io_surface_2d( name, data )
	3407
	3408	IMPLICIT NONE
	3409
[4591]	3410	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	3411
[4591]	3412	INTEGER(iwp) :: i !<
[4495]	3413
[4591]	3414	REAL(wp), INTENT(OUT), DIMENSION(:,:) :: data !<
	3415	REAL(wp), DIMENSION(SIZE( data,2)) :: tmp !<
[4495]	3416
	3417
[4591]	3418	DO i = 1, SIZE( data, 1 )
[4495]	3419	CALL rrd_mpi_io_surface( name, tmp, first_index = i )
	3420	data(i,:) = tmp
	3421	ENDDO
	3422
	3423	!
	3424	!-- Comment from Klaus Ketelsen (September 2018)
[4591]	3425	!-- The intention of the following loop was to let the compiler do the copying on return.
	3426	!-- In my understanding it is standard conform to pass the second dimension to a 1d-array inside a
	3427	!-- subroutine and the compiler is responsible to generate code for copying. Acually this works fine
	3428	!-- for INTENT(IN) variables (wrd_mpi_io_surface_2d). For INTENT(OUT) like in this case the code
	3429	!-- works on pgi compiler. But both, the Intel 16 and the Cray compiler show wrong answers using
	3430	!-- this loop. That is the reason why the above auxiliary array tmp was introduced.
[4495]	3431	! DO i = 1, SIZE( data,1)
	3432	! CALL rrd_mpi_io_surface( name, data(i,:), first_index = i )
	3433	! ENDDO
	3434
	3435	END SUBROUTINE rrd_mpi_io_surface_2d
	3436
	3437
	3438
	3439	!--------------------------------------------------------------------------------------------------!
	3440	! Description:
	3441	! ------------
[4628]	3442	!> Write particle data with MPI-IO.
	3443	!--------------------------------------------------------------------------------------------------!
	3444	SUBROUTINE wrd_mpi_io_particles( name, prt_global_index )
	3445
	3446	IMPLICIT NONE
	3447
	3448	CHARACTER(LEN=*), INTENT(IN) :: name !<
	3449	INTEGER(idp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: prt_global_index !<
	3450
	3451	INTEGER(iwp) :: array_size !<
	3452	INTEGER(iwp) :: byte_column !<
	3453	INTEGER(iwp) :: i !<
	3454	INTEGER(iwp) :: ind !<
	3455	INTEGER(iwp) :: j !<
	3456	INTEGER(iwp) :: k !<
	3457	INTEGER(iwp) :: n !<
	3458	INTEGER(iwp) :: particle_size !<
	3459
	3460	INTEGER(KIND=rd_offset_kind) :: disp !<
	3461	INTEGER(KIND=rd_offset_kind) :: offset !<
	3462	INTEGER(KIND=rd_offset_kind) :: prt_nr_bytes !<
	3463
	3464	REAL(dp) :: rs !< use REAL*8 to compute max offset
	3465	REAL(dp) :: rr !< there is no data type INTEGER*8 in MPI
	3466
	3467
	3468	TYPE(particle_type), DIMENSION(:), ALLOCATABLE, TARGET :: prt_data !<
	3469
	3470	#if defined( __parallel )
	3471	INTEGER, DIMENSION(rd_status_size) :: status !<
	3472	#else
	3473	TYPE(C_PTR) :: buf
	3474	#endif
	3475
	3476
	3477	offset = 0
	3478
	3479	array_names(header_array_index) = TRIM(name)
	3480	array_offset(header_array_index) = array_position
	3481	header_array_index = header_array_index + 1
	3482
	3483	particle_size = STORAGE_SIZE( zero_particle ) / 8
	3484
	3485	array_size = 0
	3486	DO i = nxl, nxr
	3487	DO j = nys, nyn
	3488	array_size = MAX( array_size, SUM(prt_count(:,j,i)) )
	3489	ENDDO
	3490	ENDDO
	3491
	3492	ALLOCATE( prt_data(MAX(array_size,1)) )
	3493
	3494	!
	3495	!-- Write columns of particles.
	3496	!-- The particles of a column are stored sequentially in the first dimension of the particles array.
	3497	!-- Store only the particles of one cell would be possible with this setup, but the I/O portions
	3498	!-- for a maximum of 100 particles are not big enough.
	3499	#if defined( __parallel )
	3500	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	3501	#endif
	3502	prt_nr_bytes = 0
	3503	DO i = nxl, nxr
	3504	DO j = nys, nyn
	3505	disp = array_position + prt_global_index(nzb,j,i) * particle_size
	3506	byte_column = SUM( prt_count(:,j,i) ) * particle_size
	3507	prt_nr_bytes = MAX( disp+byte_column, prt_nr_bytes )
	3508
	3509	ind = 1
	3510	DO k = nzb, nzt+1
	3511	DO n = 1, prt_count(k,j,i)
	3512	prt_data(ind) = grid_particles(k,j,i)%particles(n)
	3513	ind = ind+1
	3514	ENDDO
	3515	ENDDO
	3516
	3517	#if defined( __parallel )
	3518	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
	3519	IF ( byte_column > 0 ) THEN
	3520	CALL MPI_FILE_SEEK( fh, disp, MPI_SEEK_SET, ierr )
	3521	CALL MPI_FILE_WRITE( fh, prt_data, byte_column, MPI_BYTE, status, ierr )
	3522	ENDIF
	3523	CALL sm_io%sm_node_barrier()
	3524	#else
	3525	buf = C_LOC(prt_data) ! use C_PTR to avoid another overlay in posix interface
	3526	CALL posix_lseek( fh, disp )
	3527	CALL posix_write( fh, buf, byte_column )
	3528	#endif
	3529	ENDDO
	3530	ENDDO
	3531
	3532	#if defined( __parallel )
	3533	rs = prt_nr_bytes
	3534	CALL MPI_ALLREDUCE( rs, rr, 1, MPI_DOUBLE_PRECISION, MPI_MAX, comm2d, ierr )
	3535	prt_nr_bytes = rr
	3536	#else
	3537	rr = rs
	3538	#endif
	3539	array_position = prt_nr_bytes
	3540
	3541	write(9,*) 'array_position after particle ',array_position,prt_nr_bytes,rs
	3542
	3543	DEALLOCATE( prt_data )
	3544
	3545	END SUBROUTINE wrd_mpi_io_particles
	3546
	3547
	3548
	3549	!--------------------------------------------------------------------------------------------------!
	3550	! Description:
	3551	! ------------
[4495]	3552	!> Write 1d-REAL surface data array with MPI-IO.
	3553	!--------------------------------------------------------------------------------------------------!
	3554	SUBROUTINE wrd_mpi_io_surface( name, data, first_index )
	3555
	3556	IMPLICIT NONE
	3557
[4591]	3558	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	3559
	3560	#if defined( __parallel )
[4591]	3561	INTEGER(KIND=rd_offset_kind) :: disp !<
[4495]	3562	#endif
[4591]	3563	INTEGER(iwp), OPTIONAL :: first_index !<
[4534]	3564	#if defined( __parallel )
[4591]	3565	INTEGER(iwp) :: i !<
[4534]	3566	#endif
[4591]	3567	INTEGER(iwp) :: lo_first_index !<
	3568	INTEGER(KIND=rd_offset_kind) :: offset !<
[4495]	3569
	3570	#if defined( __parallel )
[4591]	3571	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	3572	#endif
	3573
[4591]	3574	REAL(wp), INTENT(IN), DIMENSION(:), TARGET :: data !<
[4495]	3575
	3576
	3577	offset = 0
	3578	lo_first_index = 1
	3579
[4591]	3580	IF ( PRESENT( first_index ) ) THEN
[4495]	3581	lo_first_index = first_index
	3582	ENDIF
	3583	!
[4539]	3584	!-- In case of 2d-data, name is written only once
[4495]	3585	IF ( lo_first_index == 1 ) THEN
[4539]	3586
	3587	IF ( header_array_index == max_nr_arrays ) THEN
	3588	STOP '+++ maximum number of 2d/3d-array entries in restart file header exceeded'
	3589	ENDIF
	3590
	3591	array_names(header_array_index) = name
	3592	array_offset(header_array_index) = array_position
	3593	header_array_index = header_array_index + 1
	3594
[4495]	3595	ENDIF
[4539]	3596
[4495]	3597	#if defined( __parallel )
[4534]	3598	IF ( sm_io%is_sm_active() ) THEN
	3599	DO i = 1, nr_val
	3600	array_1d(i+local_start) = data(i)
	3601	ENDDO
[4495]	3602	ELSE
[4534]	3603	! array_1d => data !kk Did not work in all cases why???
	3604	ALLOCATE( array_1d( SIZE( data ) ) )
	3605	array_1d = data
	3606	ENDIF
	3607
[4591]	3608	CALL sm_io%sm_node_barrier() ! Has no effect if I/O on limited number of cores is inactive
[4534]	3609	IF ( sm_io%iam_io_pe ) THEN
	3610	IF ( all_pes_write ) THEN
	3611	CALL MPI_FILE_SET_VIEW( fh, array_position, MPI_REAL, ft_surf, 'native', MPI_INFO_NULL, &
	3612	ierr )
	3613	CALL MPI_FILE_WRITE_ALL( fh, array_1d, nr_iope, MPI_REAL, status, ierr )
	3614	ELSE
	3615	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	3616	IF ( nr_val > 0 ) THEN
	3617	disp = array_position + 8 * ( glo_start - 1 )
	3618	CALL MPI_FILE_SEEK( fh, disp, MPI_SEEK_SET, ierr )
	3619	CALL MPI_FILE_WRITE( fh, array_1d, nr_iope, MPI_REAL, status, ierr )
	3620	ENDIF
[4495]	3621	ENDIF
	3622	ENDIF
[4534]	3623	CALL sm_io%sm_node_barrier()
	3624	IF( .NOT. sm_io%is_sm_active() ) DEALLOCATE( array_1d )
[4495]	3625	#else
	3626	CALL posix_lseek( fh, array_position )
	3627	CALL posix_write( fh, data, nr_val )
	3628	#endif
	3629	array_position = array_position + total_number_of_surface_values * wp
	3630
[4536]	3631	! IF ( lo_first_index == 1 ) THEN
	3632	! IF ( debug_level >= 2 .AND. nr_val > 0 ) WRITE(9,*) 'w_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
	3633	! ELSE
	3634	! IF ( debug_level >= 2 .AND. nr_val > 0 ) WRITE(9,*) 'w_surf_n ', TRIM( name ), ' ', &
	3635	! lo_first_index, nr_val, SUM( data(1:nr_val) )
	3636	! ENDIF
[4495]	3637
	3638	END SUBROUTINE wrd_mpi_io_surface
	3639
	3640
	3641
	3642	!--------------------------------------------------------------------------------------------------!
	3643	! Description:
	3644	! ------------
	3645	!> Read 2d-REAL surface data array with MPI-IO.
[4591]	3646	!> This consist of multiple 1d-REAL surface data arrays.
[4495]	3647	!--------------------------------------------------------------------------------------------------!
	3648	SUBROUTINE wrd_mpi_io_surface_2d( name, data )
	3649
	3650	IMPLICIT NONE
	3651
[4591]	3652	CHARACTER(LEN=*), INTENT(IN) :: name !<
[4495]	3653
[4591]	3654	INTEGER(iwp) :: i !<
[4495]	3655
[4591]	3656	REAL(wp), INTENT(IN), DIMENSION(:,:) :: data !<
[4495]	3657
	3658
[4591]	3659	DO i = 1, SIZE( data, 1 )
[4495]	3660	CALL wrd_mpi_io_surface( name, data(i,:), first_index = i )
	3661	ENDDO
	3662
	3663	END SUBROUTINE wrd_mpi_io_surface_2d
	3664
	3665
	3666
[4628]	3667
[4495]	3668	!--------------------------------------------------------------------------------------------------!
	3669	! Description:
	3670	! ------------
	3671	!> Close restart file for MPI-IO
	3672	!--------------------------------------------------------------------------------------------------!
	3673	SUBROUTINE rd_mpi_io_close
	3674
	3675	IMPLICIT NONE
	3676
[4591]	3677	INTEGER(iwp) :: gh_size !<
	3678	INTEGER(KIND=rd_offset_kind) :: offset !<
[4495]	3679	#if defined( __parallel )
[4591]	3680	INTEGER, DIMENSION(rd_status_size) :: status !<
[4495]	3681	#endif
	3682
	3683	#if ! defined( __parallel )
[4591]	3684	TYPE(C_PTR) :: buf_ptr !<
[4495]	3685	#endif
	3686
	3687
	3688	offset = 0
	3689
[4534]	3690	IF ( wr_flag .AND. sm_io%iam_io_pe ) THEN
[4495]	3691
	3692	tgh%nr_int = header_int_index - 1
	3693	tgh%nr_char = header_char_index - 1
	3694	tgh%nr_real = header_real_index - 1
[4539]	3695	tgh%nr_arrays = header_array_index - 1
[4617]	3696	tgh%total_nx = iog%nx + 1
	3697	tgh%total_ny = iog%ny + 1
[4591]	3698	IF ( include_total_domain_boundaries ) THEN ! Not sure, if LOGICAL interpretation is the same for all compilers,
	3699	tgh%i_outer_bound = 1 ! therefore store as INTEGER in general header
[4495]	3700	ELSE
	3701	tgh%i_outer_bound = 0
	3702	ENDIF
	3703	!
	3704	!-- Check for big/little endian format. This check is currently not used, and could be removed
	3705	!-- if we can assume little endian as the default on all machines.
[4534]	3706	CALL rd_mpi_io_check_endian( tgh%endian )
[4495]	3707
	3708	!
	3709	!-- Set default view
	3710	#if defined( __parallel )
	3711	CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
	3712	#endif
	3713	!
	3714	!-- Write header file
	3715	gh_size = storage_size(tgh) / 8
[4534]	3716	IF ( myid == 0 ) THEN ! myid = 0 always performs I/O, even if I/O is limited to some cores
[4495]	3717	#if defined( __parallel )
	3718	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	3719	CALL MPI_FILE_WRITE( fh, tgh, gh_size, MPI_INT, status, ierr )
	3720	header_position = header_position + gh_size
	3721	!
	3722	!-- INTEGER values
	3723	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
[4591]	3724	CALL MPI_FILE_WRITE( fh, int_names, SIZE( int_names ) * 32, MPI_CHAR, status, ierr )
[4495]	3725	header_position = header_position + SIZE( int_names ) * 32
	3726
	3727	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	3728	CALL MPI_FILE_WRITE( fh, int_values, SIZE( int_values ), MPI_INT, status, ierr )
	3729	header_position = header_position + SIZE( int_values ) * iwp
	3730	!
	3731	!-- Character entries
	3732	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
[4591]	3733	CALL MPI_FILE_WRITE( fh, text_lines, SIZE( text_lines ) * 128, MPI_CHAR, status, ierr )
[4495]	3734	header_position = header_position + SIZE( text_lines ) * 128
	3735	!
	3736	!--- REAL values
	3737	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
[4591]	3738	CALL MPI_FILE_WRITE( fh, real_names, SIZE( real_names ) * 32, MPI_CHAR, status, ierr )
[4495]	3739	header_position = header_position + SIZE( real_names ) * 32
	3740
	3741	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
	3742	CALL MPI_FILE_WRITE( fh, real_values, SIZE( real_values ), MPI_REAL, status, ierr )
	3743	header_position = header_position + SIZE( real_values ) * wp
	3744	!
	3745	!-- 2d- and 3d- distributed array headers, all replicated array headers
	3746	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
[4591]	3747	CALL MPI_FILE_WRITE( fh, array_names, SIZE( array_names ) * 32, MPI_CHAR, status, ierr )
[4495]	3748	header_position = header_position + SIZE( array_names ) * 32
	3749
	3750	CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
[4591]	3751	CALL MPI_FILE_WRITE( fh, array_offset, SIZE( array_offset ) * MPI_OFFSET_KIND, MPI_BYTE, &
[4536]	3752	status, ierr ) ! There is no I*8 datatype in Fortran
[4495]	3753	header_position = header_position + SIZE( array_offset ) * rd_offset_kind
	3754	#else
	3755	CALL posix_lseek( fh, header_position )
	3756	buf_ptr = C_LOC( tgh )
	3757	CALL posix_write( fh, buf_ptr, gh_size )
	3758	header_position = header_position + gh_size
	3759	!
	3760	!-- INTEGER values
	3761	CALL posix_lseek( fh, header_position )
	3762	CALL posix_write( fh, int_names )
	3763	header_position = header_position + SIZE( int_names ) * 32
	3764
	3765	CALL posix_lseek( fh, header_position )
	3766	CALL posix_write( fh, int_values, SIZE( int_values ) )
	3767	header_position = header_position + SIZE( int_values ) * iwp
	3768	!
	3769	!-- Character entries
	3770	CALL posix_lseek( fh, header_position )
	3771	CALL posix_write( fh, text_lines )
	3772	header_position = header_position + SIZE( text_lines ) * 128
	3773	!
	3774	!-- REAL values
	3775	CALL posix_lseek( fh, header_position )
	3776	CALL posix_write( fh, real_names )
	3777	header_position = header_position + SIZE( real_names ) * 32
	3778
	3779	CALL posix_lseek( fh, header_position )
	3780	CALL posix_write( fh, real_values, SIZE( real_values ) )
	3781	header_position = header_position + SIZE( real_values ) * wp
	3782	!
	3783	!-- 2d- and 3d-distributed array headers, all replicated array headers
	3784	CALL posix_lseek( fh, header_position )
	3785	CALL posix_write( fh, array_names )
	3786	header_position = header_position + SIZE( array_names ) * 32
	3787
	3788	CALL posix_lseek( fh, header_position )
	3789	CALL posix_write( fh, array_offset, SIZE( array_offset ) )
	3790	header_position = header_position + SIZE( array_offset ) * rd_offset_kind
	3791	#endif
[4536]	3792	IF ( debug_output ) CALL rd_mpi_io_print_header
[4495]	3793	ENDIF
	3794
	3795	ENDIF
	3796
	3797	!
	3798	!-- Free file types
[4534]	3799	CALL rd_mpi_io_free_filetypes
[4495]	3800
	3801	!
[4534]	3802	!-- Close MPI-IO files
[4495]	3803	#if defined( __parallel )
[4534]	3804	!
	3805	!-- Restart file has been opened with comm2d
	3806	IF ( fhs /= -1 ) THEN
	3807	CALL MPI_FILE_CLOSE( fhs, ierr )
	3808	ENDIF
[4617]	3809	!
	3810	!-- Free RMA windows
	3811	IF ( cyclic_fill_mode ) THEN
	3812	CALL MPI_WIN_FREE( rmawin_2di, ierr )
	3813	CALL MPI_WIN_FREE( rmawin_2d, ierr )
	3814	CALL MPI_WIN_FREE( rmawin_3d, ierr )
	3815	ENDIF
[4621]	3816	#endif
[4534]	3817
[4617]	3818	IF (.NOT. pe_active_for_read ) RETURN
	3819	!
	3820	!-- TODO: better explain the following message
	3821	!-- In case on non cyclic read, pe_active_for_read is set .TRUE.
[4534]	3822	IF ( sm_io%iam_io_pe ) THEN
	3823
	3824	#if defined( __parallel )
	3825	CALL MPI_FILE_CLOSE( fh, ierr )
[4495]	3826	#else
[4534]	3827	CALL posix_close( fh )
[4495]	3828	#endif
	3829
[4534]	3830	ENDIF
	3831
[4628]	3832	fh = -1
	3833
[4536]	3834	restart_file_size = array_position / ( 1024.0_dp * 1024.0_dp )
[4495]	3835
	3836	END SUBROUTINE rd_mpi_io_close
	3837
	3838
	3839
[4628]	3840	FUNCTION rd_mpi_io_check_open() RESULT ( isopen )
	3841
	3842	LOGICAL :: isopen
	3843
	3844	isopen = ( fh /= -1 )
	3845
	3846	END FUNCTION rd_mpi_io_check_open
	3847
	3848
	3849
[4495]	3850	!--------------------------------------------------------------------------------------------------!
	3851	! Description:
	3852	! ------------
	3853	!> This subroutine prepares a filetype and some variables for the I/O of surface data.
	3854	!> Whenever a new set of start_index and end_index is used, rd_mpi_io_surface_filetypes has to be
	3855	!> called. A main feature of this subroutine is computing the global start indices of the 1d- and
	3856	!> 2d- surface arrays.
[4534]	3857	!> Even if I/O is done by a limited number of cores only, the surface data are read by ALL cores!
	3858	!> Reading them by some cores and then distributing the data would result in complicated code
	3859	!> which is suspectable for errors and overloads the reading subroutine. Since reading of surface
	3860	!> data is not time critical (data size is comparably small), it will be read by all cores.
[4495]	3861	!--------------------------------------------------------------------------------------------------!
	3862	SUBROUTINE rd_mpi_io_surface_filetypes( start_index, end_index, data_to_write, global_start )
	3863
	3864	IMPLICIT NONE
	3865
[4591]	3866	INTEGER(iwp) :: i !< loop index
[4617]	3867	INTEGER(iwp) :: j !< loop index
[4591]	3868	INTEGER(KIND=rd_offset_kind) :: offset !<
[4495]	3869
[4591]	3870	INTEGER(iwp), DIMENSION(1) :: dims1 !<
	3871	INTEGER(iwp), DIMENSION(1) :: lize1 !<
	3872	INTEGER(iwp), DIMENSION(1) :: start1 !<
[4495]	3873
[4591]	3874	INTEGER(iwp), DIMENSION(0:numprocs-1) :: all_nr_val !< number of values for all PEs
	3875	INTEGER(iwp), DIMENSION(0:numprocs-1) :: lo_nr_val !< local number of values in x and y direction
[4495]	3876
	3877
[4617]	3878	INTEGER, INTENT(INOUT), DIMENSION(nys:nyn,nxl:nxr) :: end_index !<
	3879	INTEGER, INTENT(OUT), DIMENSION(nys:nyn,nxl:nxr) :: global_start !<
	3880	INTEGER, INTENT(INOUT), DIMENSION(nys:nyn,nxl:nxr) :: start_index !<
[4495]	3881
[4591]	3882	LOGICAL, INTENT(OUT) :: data_to_write !< returns, if surface data have to be written
	3883
[4617]	3884	!
	3885	!-- Actions during reading
	3886	IF ( rd_flag ) THEN
	3887	!
	3888	!-- Set start index and end index for the mainrun grid.
	3889	!-- ATTENTION: This works only for horizontal surfaces with one vale per grid cell!!!
	3890	IF ( cyclic_fill_mode ) THEN
	3891	DO i = nxl, nxr
	3892	DO j = nys, nyn
	3893	start_index (j,i) = (i-nxl) * nny + j - nys + 1
	3894	end_index (j,i) = start_index(j,i)
	3895	ENDDO
	3896	ENDDO
	3897	ENDIF
[4591]	3898
[4617]	3899	IF ( .NOT. ALLOCATED( m_start_index ) ) ALLOCATE( m_start_index(nys:nyn,nxl:nxr) )
	3900	IF ( .NOT. ALLOCATED( m_end_index ) ) ALLOCATE( m_end_index(nys:nyn,nxl:nxr) )
	3901	IF ( .NOT. ALLOCATED( m_global_start ) ) ALLOCATE( m_global_start(nys:nyn,nxl:nxr) )
	3902	!
	3903	!-- Save arrays for later reading
	3904	m_start_index = start_index
	3905	m_end_index = end_index
	3906	m_global_start = global_start
	3907	nr_val = MAXVAL( end_index )
	3908
	3909	ENDIF
	3910
	3911	IF ( .NOT. pe_active_for_read ) RETURN
	3912
	3913	IF ( cyclic_fill_mode ) CALL prerun_grid%activate_grid_from_this_class()
	3914
[4495]	3915	offset = 0
	3916	lo_nr_val= 0
	3917	lo_nr_val(myid) = MAXVAL( end_index )
	3918	#if defined( __parallel )
	3919	CALL MPI_ALLREDUCE( lo_nr_val, all_nr_val, numprocs, MPI_INTEGER, MPI_SUM, comm2d, ierr )
[4534]	3920	IF ( ft_surf /= -1 .AND. sm_io%iam_io_pe ) THEN
[4591]	3921	CALL MPI_TYPE_FREE( ft_surf, ierr ) ! If set, free last surface filetype
[4495]	3922	ENDIF
[4534]	3923
	3924	IF ( win_surf /= -1 ) THEN
	3925	IF ( sm_io%is_sm_active() ) THEN
	3926	CALL MPI_WIN_FREE( win_surf, ierr )
	3927	ENDIF
	3928	win_surf = -1
	3929	ENDIF
	3930
	3931	IF ( sm_io%is_sm_active() .AND. rd_flag ) THEN
	3932	IF ( fhs == -1 ) THEN
	3933	CALL MPI_FILE_OPEN( comm2d, TRIM( io_file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fhs, &
	3934	ierr )
	3935	ENDIF
	3936	ELSE
	3937	fhs = fh
	3938	ENDIF
[4495]	3939	#else
	3940	all_nr_val(myid) = lo_nr_val(myid)
	3941	#endif
	3942	nr_val = lo_nr_val(myid)
	3943
	3944	total_number_of_surface_values = 0
	3945	DO i = 0, numprocs-1
	3946	IF ( i == myid ) THEN
	3947	glo_start = total_number_of_surface_values + 1
	3948	ENDIF
	3949	total_number_of_surface_values = total_number_of_surface_values + all_nr_val(i)
	3950	ENDDO
	3951
	3952	!
[4591]	3953	!-- Actions during reading
[4495]	3954	IF ( rd_flag ) THEN
	3955
	3956	#if defined( __parallel )
[4534]	3957	CALL MPI_FILE_SET_VIEW( fhs, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
[4495]	3958	#endif
	3959	ENDIF
	3960
[4617]	3961	IF ( cyclic_fill_mode ) CALL mainrun_grid%activate_grid_from_this_class()
	3962
[4495]	3963	!
[4591]	3964	!-- Actions during writing
[4495]	3965	IF ( wr_flag ) THEN
	3966	!
	3967	!-- Create surface filetype
	3968	ft_surf = -1
	3969	global_start = start_index + glo_start - 1
	3970
	3971	WHERE ( end_index < start_index )
	3972	global_start = -1
	3973	ENDWHERE
	3974
[4534]	3975	#if defined( __parallel )
	3976	IF ( sm_io%is_sm_active() ) THEN
	3977	IF ( sm_io%iam_io_pe ) THEN
[4495]	3978	!
[4534]	3979	!-- Calculate number of values of all PEs of an I/O group
	3980	nr_iope = 0
	3981	DO i = myid, myid+sm_io%sh_npes-1
	3982	nr_iope = nr_iope + all_nr_val(i)
	3983	ENDDO
	3984	ELSE
	3985	local_start = 0
	3986	DO i = myid-sm_io%sh_rank, myid-1
	3987	local_start = local_start + all_nr_val(i)
	3988	ENDDO
	3989	ENDIF
	3990	!
	3991	!-- Get the size of shared memory window on all PEs
	3992	CALL MPI_BCAST( nr_iope, 1, MPI_INTEGER, 0, sm_io%comm_shared, ierr )
	3993	CALL sm_io%sm_allocate_shared( array_1d, 1, MAX( 1, nr_iope ), win_surf )
	3994	ELSE
	3995	nr_iope = nr_val
	3996	ENDIF
	3997	#else
	3998	nr_iope = nr_val
	3999	#endif
	4000
	4001	!
[4495]	4002	!-- Check, if surface data exist on this PE
	4003	data_to_write = .TRUE.
	4004	IF ( total_number_of_surface_values == 0 ) THEN
	4005	data_to_write = .FALSE.
	4006	RETURN
	4007	ENDIF
	4008
[4534]	4009	IF ( sm_io%iam_io_pe ) THEN
[4495]	4010
[4534]	4011	all_pes_write = ( MINVAL( all_nr_val ) > 0 )
[4495]	4012
[4534]	4013	IF ( all_pes_write ) THEN
	4014	dims1(1) = total_number_of_surface_values
	4015	lize1(1) = nr_iope
	4016	start1(1) = glo_start-1
	4017
[4495]	4018	#if defined( __parallel )
[4534]	4019	IF ( total_number_of_surface_values > 0 ) THEN
	4020	CALL MPI_TYPE_CREATE_SUBARRAY( 1, dims1, lize1, start1, MPI_ORDER_FORTRAN, &
	4021	MPI_REAL, ft_surf, ierr )
	4022	CALL MPI_TYPE_COMMIT( ft_surf, ierr )
	4023	ENDIF
	4024	#endif
[4495]	4025	ENDIF
	4026	ENDIF
[4534]	4027
[4495]	4028	ENDIF
	4029
	4030	END SUBROUTINE rd_mpi_io_surface_filetypes
	4031
	4032
	4033
	4034	!--------------------------------------------------------------------------------------------------!
	4035	! Description:
	4036	! ------------
	4037	!> This subroutine creates file types to access 2d-/3d-REAL arrays and 2d-INTEGER arrays
	4038	!> distributed in blocks among processes to a single file that contains the global arrays.
	4039	!--------------------------------------------------------------------------------------------------!
[4534]	4040	SUBROUTINE rd_mpi_io_create_filetypes
[4495]	4041
	4042	IMPLICIT NONE
	4043
[4591]	4044	INTEGER, DIMENSION(2) :: dims2 !<
	4045	INTEGER, DIMENSION(2) :: lize2 !<
	4046	INTEGER, DIMENSION(2) :: start2 !<
[4495]	4047
[4591]	4048	INTEGER, DIMENSION(3) :: dims3 !<
	4049	INTEGER, DIMENSION(3) :: lize3 !<
	4050	INTEGER, DIMENSION(3) :: start3 !<
[4495]	4051
[4617]	4052	TYPE(domain_decomposition_grid_features) :: save_io_grid !< temporary variable to store grid settings
[4495]	4053
[4534]	4054
	4055	IF ( sm_io%is_sm_active() ) THEN
	4056	save_io_grid = sm_io%io_grid
	4057	ENDIF
	4058
[4617]	4059	IF( .NOT. pe_active_for_read ) RETURN
	4060
	4061	IF ( cyclic_fill_mode ) CALL prerun_grid%activate_grid_from_this_class()
	4062
[4495]	4063	!
	4064	!-- Decision, if storage with or without ghost layers.
	4065	!-- Please note that the indexing of the global array always starts at 0, even in Fortran.
	4066	!-- Therefore the PE local indices have to be shifted by nbgp in the case with ghost layers.
	4067	IF ( include_total_domain_boundaries ) THEN
	4068
[4617]	4069	iog%nxl = nxl + nbgp
	4070	iog%nxr = nxr + nbgp
	4071	iog%nys = nys + nbgp
	4072	iog%nyn = nyn + nbgp
	4073	iog%nnx = nnx
	4074	iog%nny = nny
	4075	iog%nx = nx + 2 * nbgp
	4076	iog%ny = ny + 2 * nbgp
[4495]	4077	IF ( myidx == 0 ) THEN
[4617]	4078	iog%nxl = iog%nxl - nbgp
	4079	iog%nnx = iog%nnx + nbgp
[4495]	4080	ENDIF
	4081	IF ( myidx == npex-1 .OR. npex == -1 ) THEN ! npex == 1 if -D__parallel not set
[4617]	4082	iog%nxr = iog%nxr + nbgp
	4083	iog%nnx = iog%nnx + nbgp
[4495]	4084	ENDIF
	4085	IF ( myidy == 0 ) THEN
[4617]	4086	iog%nys = iog%nys - nbgp
	4087	iog%nny = iog%nny + nbgp
[4495]	4088	ENDIF
	4089	IF ( myidy == npey-1 .OR. npey == -1 ) THEN ! npey == 1 if -D__parallel not set
[4617]	4090	iog%nyn = iog%nyn + nbgp
	4091	iog%nny = iog%nny + nbgp
[4495]	4092	ENDIF
	4093
[4534]	4094	CALL sm_io%sm_adjust_outer_boundary()
	4095
[4495]	4096	ELSE
	4097
[4617]	4098	iog%nxl = nxl
	4099	iog%nxr = nxr
	4100	iog%nys = nys
	4101	iog%nyn = nyn
	4102	iog%nnx = nnx
	4103	iog%nny = nny
	4104	iog%nx = nx
	4105	iog%ny = ny
[4495]	4106
	4107	ENDIF
	4108
[4534]	4109	IF ( sm_io%is_sm_active() ) THEN
	4110	#if defined( __parallel )
	4111	CALL sm_io%sm_allocate_shared( array_2d, sm_io%io_grid%nxl, sm_io%io_grid%nxr, &
	4112	sm_io%io_grid%nys, sm_io%io_grid%nyn, win_2dr )
	4113	CALL sm_io%sm_allocate_shared( array_2di, save_io_grid%nxl, save_io_grid%nxr, &
	4114	save_io_grid%nys, save_io_grid%nyn, win_2di )
	4115	CALL sm_io%sm_allocate_shared( array_3d, nzb, nzt+1, sm_io%io_grid%nxl, sm_io%io_grid%nxr, &
	4116	sm_io%io_grid%nys, sm_io%io_grid%nyn, win_3dr )
[4857]	4117	CALL sm_io%sm_allocate_shared( array_3di4, nzb, nzt+1, sm_io%io_grid%nxl, sm_io%io_grid%nxr,&
	4118	sm_io%io_grid%nys, sm_io%io_grid%nyn, win_3di4 )
[4534]	4119	#endif
	4120	ELSE
[4617]	4121	ALLOCATE( array_2d(iog%nxl:iog%nxr,iog%nys:iog%nyn) )
[4534]	4122	ALLOCATE( array_2di(nxl:nxr,nys:nyn) )
[4617]	4123	ALLOCATE( array_3d(nzb:nzt+1,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
[4857]	4124	ALLOCATE( array_3di4(nzb:nzt+1,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
[4617]	4125	sm_io%io_grid = iog
[4534]	4126	ENDIF
	4127
[4495]	4128	!
	4129	!-- Create filetype for 2d-REAL array with ghost layers around the total domain
[4617]	4130	dims2(1) = iog%nx + 1
	4131	dims2(2) = iog%ny + 1
[4495]	4132
[4534]	4133	lize2(1) = sm_io%io_grid%nnx
	4134	lize2(2) = sm_io%io_grid%nny
[4495]	4135
[4534]	4136	start2(1) = sm_io%io_grid%nxl
	4137	start2(2) = sm_io%io_grid%nys
[4495]	4138
	4139	#if defined( __parallel )
[4534]	4140	IF ( sm_io%iam_io_pe ) THEN
	4141	CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_REAL, &
	4142	ft_2d, ierr )
	4143	CALL MPI_TYPE_COMMIT( ft_2d, ierr )
	4144	ENDIF
[4495]	4145	#endif
	4146	!
	4147	!-- Create filetype for 2d-INTEGER array without ghost layers around the total domain
	4148	dims2(1) = nx + 1
	4149	dims2(2) = ny + 1
	4150
[4534]	4151	IF ( sm_io%is_sm_active() ) THEN
[4495]	4152
[4534]	4153	lize2(1) = save_io_grid%nnx
	4154	lize2(2) = save_io_grid%nny
[4495]	4155
[4534]	4156	start2(1) = save_io_grid%nxl
	4157	start2(2) = save_io_grid%nys
	4158
	4159	ELSE
	4160
	4161	lize2(1) = nnx
	4162	lize2(2) = nny
	4163
	4164	start2(1) = nxl
	4165	start2(2) = nys
	4166
	4167	ENDIF
	4168
[4495]	4169	#if defined( __parallel )
[4534]	4170	IF ( sm_io%iam_io_pe ) THEN
	4171	CALL MPI_TYPE_CREATE_SUBARRAY( 2, dims2, lize2, start2, MPI_ORDER_FORTRAN, MPI_INTEGER, &
	4172	ft_2di_nb, ierr )
	4173	CALL MPI_TYPE_COMMIT( ft_2di_nb, ierr )
	4174	ENDIF
[4495]	4175	#endif
	4176	!
	4177	!-- Create filetype for 3d-REAL array
	4178	dims3(1) = nz + 2
[4617]	4179	dims3(2) = iog%nx + 1
	4180	dims3(3) = iog%ny + 1
[4495]	4181
	4182	lize3(1) = dims3(1)
[4534]	4183	lize3(2) = sm_io%io_grid%nnx
	4184	lize3(3) = sm_io%io_grid%nny
[4495]	4185
	4186	start3(1) = nzb
[4534]	4187	start3(2) = sm_io%io_grid%nxl
	4188	start3(3) = sm_io%io_grid%nys
[4495]	4189
	4190	#if defined( __parallel )
[4534]	4191	IF ( sm_io%iam_io_pe ) THEN
	4192	CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL, ft_3d, &
	4193	ierr )
	4194	CALL MPI_TYPE_COMMIT( ft_3d, ierr )
	4195	ENDIF
[4495]	4196	#endif
	4197
[4617]	4198	IF ( cyclic_fill_mode ) CALL mainrun_grid%activate_grid_from_this_class()
	4199
[4534]	4200	END SUBROUTINE rd_mpi_io_create_filetypes
[4495]	4201
	4202
	4203
	4204	!--------------------------------------------------------------------------------------------------!
	4205	! Description:
	4206	! ------------
[4628]	4207	!> This subroutine creates file types to access 3d-INTEGER4 arrays and 3d-INTEGER8 arrays
	4208	!> distributed in blocks among processes to a single file that contains the global arrays.
	4209	!> These types are only used for particle data.
	4210	!--------------------------------------------------------------------------------------------------!
	4211	SUBROUTINE rd_mpi_io_particle_filetypes
	4212
	4213	IMPLICIT NONE
	4214
	4215	INTEGER, DIMENSION(3) :: dims3 !<
	4216	INTEGER, DIMENSION(3) :: lize3 !<
	4217	INTEGER, DIMENSION(3) :: start3 !<
	4218
	4219	TYPE(domain_decomposition_grid_features) :: save_io_grid !< temporary variable to store grid settings
	4220
	4221	!
	4222	!-- MPI_INTEGER8 is not standard MPI, but is supported on most MPI distibutions
	4223	!-- If not suppported, a workaround could be enabled with the following preprocessor directive
	4224	!#if defined( __NO_INTEGER8)
	4225	! CALL MPI_TYPE_CONTIGUOUS( 2, MPI_INTEGER, MPI_INTEGER8, ierr )
	4226	! CALL MPI_TYPE_COMMIT( MPI_INTEGER8, ierr )
	4227	!#endif
	4228
	4229	IF ( sm_io%is_sm_active() ) THEN
	4230	save_io_grid = sm_io%io_grid
	4231	ENDIF
	4232
	4233	IF( .NOT. pe_active_for_read ) RETURN
	4234
	4235	!
	4236	!-- Decision, if storage with or without ghost layers.
	4237	!-- Please note that the indexing of the global array always starts at 0, even in Fortran.
	4238	!-- Therefore the PE local indices have to be shifted by nbgp in the case with ghost layers.
	4239	IF ( include_total_domain_boundaries ) THEN
	4240
	4241	iog%nxl = nxl + nbgp
	4242	iog%nxr = nxr + nbgp
	4243	iog%nys = nys + nbgp
	4244	iog%nyn = nyn + nbgp
	4245	iog%nnx = nnx
	4246	iog%nny = nny
	4247	iog%nx = nx + 2 * nbgp
	4248	iog%ny = ny + 2 * nbgp
	4249	IF ( myidx == 0 ) THEN
	4250	iog%nxl = iog%nxl - nbgp
	4251	iog%nnx = iog%nnx + nbgp
	4252	ENDIF
	4253	IF ( myidx == npex-1 .OR. npex == -1 ) THEN ! npex == 1 if -D__parallel not set
	4254	iog%nxr = iog%nxr + nbgp
	4255	iog%nnx = iog%nnx + nbgp
	4256	ENDIF
	4257	IF ( myidy == 0 ) THEN
	4258	iog%nys = iog%nys - nbgp
	4259	iog%nny = iog%nny + nbgp
	4260	ENDIF
	4261	IF ( myidy == npey-1 .OR. npey == -1 ) THEN ! npey == 1 if -D__parallel not set
	4262	iog%nyn = iog%nyn + nbgp
	4263	iog%nny = iog%nny + nbgp
	4264	ENDIF
	4265
	4266	CALL sm_io%sm_adjust_outer_boundary()
	4267
	4268	ELSE
	4269
	4270	iog%nxl = nxl
	4271	iog%nxr = nxr
	4272	iog%nys = nys
	4273	iog%nyn = nyn
	4274	iog%nnx = nnx
	4275	iog%nny = nny
	4276	iog%nx = nx
	4277	iog%ny = ny
	4278
	4279	ENDIF
	4280
	4281	IF ( sm_io%is_sm_active() ) THEN
	4282	#if defined( __parallel )
	4283	CALL sm_io%sm_allocate_shared( array_3di8, nzb, nzt+1, sm_io%io_grid%nxl, sm_io%io_grid%nxr,&
	4284	sm_io%io_grid%nys, sm_io%io_grid%nyn, win_3di8 )
	4285	#endif
	4286	ELSE
	4287	ALLOCATE( array_3di8(nzb:nzt+1,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
	4288
	4289	sm_io%io_grid = iog
	4290	ENDIF
	4291
	4292	!
	4293	!-- Create filetype for 3d INTEGER array
	4294	dims3(1) = nz + 2
	4295	dims3(2) = iog%nx + 1
	4296	dims3(3) = iog%ny + 1
	4297
	4298	lize3(1) = dims3(1)
	4299	lize3(2) = sm_io%io_grid%nnx
	4300	lize3(3) = sm_io%io_grid%nny
	4301
	4302	start3(1) = nzb
	4303	start3(2) = sm_io%io_grid%nxl
	4304	start3(3) = sm_io%io_grid%nys
	4305
	4306	#if defined( __parallel )
	4307	IF ( sm_io%iam_io_pe ) THEN
	4308	CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_INTEGER, &
	4309	ft_3di4, ierr )
	4310	CALL MPI_TYPE_COMMIT( ft_3di4, ierr )
	4311
	4312	CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_INTEGER8, &
	4313	ft_3di8, ierr )
	4314	CALL MPI_TYPE_COMMIT( ft_3di8, ierr )
	4315	ENDIF
	4316	#endif
	4317
	4318	END SUBROUTINE rd_mpi_io_particle_filetypes
	4319
	4320
	4321
	4322	!--------------------------------------------------------------------------------------------------!
	4323	! Description:
	4324	! ------------
[4591]	4325	!> This subroutine creates file types to access 3d-soil arrays distributed in blocks among processes
	4326	!> to a single file that contains the global arrays. It is not required for the serial mode.
[4495]	4327	!--------------------------------------------------------------------------------------------------!
	4328	#if defined( __parallel )
	4329	SUBROUTINE rd_mpi_io_create_filetypes_3dsoil( nzb_soil, nzt_soil )
	4330
	4331	IMPLICIT NONE
	4332
[4591]	4333	INTEGER, INTENT(IN) :: nzb_soil !<
	4334	INTEGER, INTENT(IN) :: nzt_soil !<
[4495]	4335
[4591]	4336	INTEGER, DIMENSION(3) :: dims3 !<
	4337	INTEGER, DIMENSION(3) :: lize3 !<
	4338	INTEGER, DIMENSION(3) :: start3 !<
[4495]	4339
	4340
[4534]	4341	IF ( sm_io%is_sm_active() ) THEN
	4342	CALL sm_io%sm_allocate_shared( array_3d_soil, nzb_soil, nzt_soil, sm_io%io_grid%nxl, &
	4343	sm_io%io_grid%nxr, sm_io%io_grid%nys, sm_io%io_grid%nyn, &
	4344	win_3ds )
	4345	ELSE
[4617]	4346	ALLOCATE( array_3d_soil(nzb_soil:nzt_soil,iog%nxl:iog%nxr,iog%nys:iog%nyn) )
	4347	sm_io%io_grid = iog
[4534]	4348	ENDIF
	4349
[4495]	4350	!
	4351	!-- Create filetype for 3d-soil array
	4352	dims3(1) = nzt_soil - nzb_soil + 1
[4617]	4353	dims3(2) = iog%nx + 1
	4354	dims3(3) = iog%ny + 1
[4495]	4355
	4356	lize3(1) = dims3(1)
[4534]	4357	lize3(2) = sm_io%io_grid%nnx
	4358	lize3(3) = sm_io%io_grid%nny
[4495]	4359
	4360	start3(1) = nzb_soil
[4534]	4361	start3(2) = sm_io%io_grid%nxl
	4362	start3(3) = sm_io%io_grid%nys
[4495]	4363
[4534]	4364	IF ( sm_io%iam_io_pe ) THEN
	4365	CALL MPI_TYPE_CREATE_SUBARRAY( 3, dims3, lize3, start3, MPI_ORDER_FORTRAN, MPI_REAL, &
	4366	ft_3dsoil, ierr )
	4367	CALL MPI_TYPE_COMMIT( ft_3dsoil, ierr )
	4368	ENDIF
[4495]	4369
	4370	END SUBROUTINE rd_mpi_io_create_filetypes_3dsoil
	4371	#endif
	4372
	4373
	4374
	4375	!--------------------------------------------------------------------------------------------------!
	4376	! Description:
	4377	! ------------
	4378	!> Free all file types that have been created for MPI-IO.
	4379	!--------------------------------------------------------------------------------------------------!
[4534]	4380	SUBROUTINE rd_mpi_io_free_filetypes
[4495]	4381
	4382	IMPLICIT NONE
	4383
	4384
	4385	#if defined( __parallel )
	4386	IF ( filetypes_created ) THEN
[4534]	4387
	4388	IF ( sm_io%iam_io_pe ) THEN
	4389	CALL MPI_TYPE_FREE( ft_2d, ierr )
	4390	CALL MPI_TYPE_FREE( ft_2di_nb, ierr )
	4391	CALL MPI_TYPE_FREE( ft_3d, ierr )
	4392	ENDIF
	4393
	4394	IF ( sm_io%is_sm_active() ) THEN
	4395	CALL sm_io%sm_free_shared( win_2dr )
	4396	CALL sm_io%sm_free_shared( win_2di )
	4397	CALL sm_io%sm_free_shared( win_3dr )
	4398	ELSE
	4399	DEALLOCATE( array_2d, array_2di, array_3d )
	4400	ENDIF
	4401
[4495]	4402	ENDIF
	4403	!
	4404	!-- Free last surface filetype
[4534]	4405	IF ( sm_io%iam_io_pe .AND. ft_surf /= -1 ) THEN
[4495]	4406	CALL MPI_TYPE_FREE( ft_surf, ierr )
	4407	ENDIF
[4534]	4408
	4409	IF ( sm_io%is_sm_active() .AND. win_surf /= -1 ) THEN
	4410	CALL sm_io%sm_free_shared( win_surf )
	4411	ENDIF
	4412
[4628]	4413	!
	4414	!-- Free last particle filetypes
	4415	IF ( sm_io%iam_io_pe .AND. ft_3di4 /= -1 ) THEN
	4416	CALL MPI_TYPE_FREE( ft_3di4, ierr )
	4417	CALL MPI_TYPE_FREE( ft_3di8, ierr )
	4418	ENDIF
	4419
	4420	IF ( sm_io%is_sm_active() .AND. win_3di4 /= -1 ) THEN
	4421	CALL sm_io%sm_free_shared( win_3di4 )
	4422	CALL sm_io%sm_free_shared( win_3di8 )
	4423	ENDIF
	4424
[4534]	4425	ft_surf = -1
	4426	win_surf = -1
	4427	#else
[4628]	4428	IF ( ASSOCIATED(array_2d) ) DEALLOCATE( array_2d )
	4429	IF ( ASSOCIATED(array_2di) ) DEALLOCATE( array_2di )
	4430	IF ( ASSOCIATED(array_3d) ) DEALLOCATE( array_3d )
	4431	IF ( ASSOCIATED(array_3di4) ) DEALLOCATE( array_3di4 )
	4432	IF ( ASSOCIATED(array_3di8) ) DEALLOCATE( array_3di8 )
[4495]	4433	#endif
	4434
[4534]	4435	END SUBROUTINE rd_mpi_io_free_filetypes
[4495]	4436
	4437
	4438
	4439	!--------------------------------------------------------------------------------------------------!
	4440	! Description:
	4441	! ------------
	4442	!> Print the restart data file header (MPI-IO format) for debugging.
	4443	!--------------------------------------------------------------------------------------------------!
[4534]	4444	SUBROUTINE rd_mpi_io_print_header
[4495]	4445
	4446	IMPLICIT NONE
	4447
[4591]	4448	INTEGER(iwp) :: i !<
[4495]	4449
	4450
[4536]	4451	WRITE (9,*) 'header position after reading the restart file header: ', header_position
	4452	WRITE (9,*) ' '
	4453	WRITE (9,*) 'restart file header content:'
	4454	WRITE (9,*) '----------------------------'
	4455	WRITE (9,*) ' '
[4495]	4456
[4536]	4457	WRITE (9,*) ' CHARACTER header values Total number: ', tgh%nr_char
	4458	WRITE (9,*) ' '
	4459	DO i = 1, tgh%nr_char
	4460	WRITE( 9, '(I3,A,1X,A)' ) i, ': ', text_lines(i)(1:80)
	4461	ENDDO
	4462	WRITE (9,*) ' '
[4495]	4463
[4536]	4464	WRITE (9,*) ' INTEGER header variables and values Total number: ', tgh%nr_int
	4465	WRITE (9,*) ' '
	4466	DO i = 1, tgh%nr_int
	4467	WRITE(9,*) ' variable: ', int_names(i), ' value: ', int_values(i)
	4468	ENDDO
	4469	WRITE (9,*) ' '
[4495]	4470
[4536]	4471	WRITE (9,*) ' REAL header variables and values Total number: ', tgh%nr_real
	4472	WRITE (9,*) ' '
	4473	DO i = 1, tgh%nr_real
	4474	WRITE(9,*) ' variable: ', real_names(i), ' value: ', real_values(i)
	4475	ENDDO
	4476	WRITE (9,*) ' '
[4495]	4477
[4536]	4478	WRITE (9,*) ' Header entries with offset (2d/3d arrays) Total number: ', tgh%nr_arrays
	4479	WRITE (9,*) ' '
	4480	DO i = 1, tgh%nr_arrays
	4481	WRITE(9,*) ' variable: ', array_names(i), ' offset: ', array_offset(i)
	4482	ENDDO
	4483	WRITE (9,*) ' '
[4495]	4484
[4534]	4485	END SUBROUTINE rd_mpi_io_print_header
[4495]	4486
	4487
	4488
	4489	!--------------------------------------------------------------------------------------------------!
	4490	! Description:
	4491	! ------------
	4492	!> Check if big/little endian data format is used.
	4493	!> An int4 pointer is set to a int8 variable, the int*8 is set to 1, and then it is checked, if
	4494	!> the first 4 bytes of the pointer are equal 1 (little endian) or not.
	4495	!--------------------------------------------------------------------------------------------------!
[4534]	4496	SUBROUTINE rd_mpi_io_check_endian( i_endian )
[4495]	4497
	4498	IMPLICIT NONE
	4499
[4591]	4500	INTEGER, INTENT(out) :: i_endian !<
	4501	INTEGER(KIND=8), TARGET :: int8 !<
[4495]	4502
[4591]	4503	INTEGER, DIMENSION(1) :: bufshape !<
	4504	INTEGER(KIND=4), POINTER, DIMENSION(:) :: int4 !<
[4495]	4505
[4591]	4506	TYPE(C_PTR) :: ptr !<
[4495]	4507
	4508
	4509	ptr = C_LOC( int8 )
	4510	bufshape(1) = 2
	4511	CALL C_F_POINTER( ptr, int4, bufshape )
	4512
	4513	int8 = 1
	4514
	4515	IF ( int4(1) == 1 ) THEN
[4591]	4516	i_endian = 1 ! Little endian
[4495]	4517	ELSE
[4591]	4518	i_endian = 2 ! Big endian
[4495]	4519	ENDIF
	4520
[4534]	4521	END SUBROUTINE rd_mpi_io_check_endian
[4495]	4522
	4523	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 |