Home

Context Navigation

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

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