Home

Context Navigation

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

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