comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-27 21:55:16 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Refactor MPI file handle

Browse source
This commit is contained in:
Frederick Stein 2022-12-12 17:14:39 +01:00 • committed by Frederick Stein
parent eb42053dfb
commit 09b7866876
4 changed files with 138 additions and 116 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/input/cp_output_handling.F
View file

@ -53,7 +53,8 @@ MODULE cp_output_handling
USE message_passing, ONLY: mp_file_close,&
mp_file_delete,&
mp_file_get_amode,&
mp_file_open
mp_file_open,&
mp_file_type
USE string_utilities, ONLY: compress,&
s2a
#include "../base/base_uses.f90"
@ -821,13 +822,14 @@ CONTAINS
CHARACTER(len=default_string_length) :: my_file_action, my_file_form, &
my_file_position, my_file_status, &
outPath
INTEGER :: c_i_level, f_backup_level, i, iounit, &
mpi_amode, my_backup_level, my_nbak, &
nbak, s_backup_level, unit_nr
INTEGER :: c_i_level, f_backup_level, i, mpi_amode, &
my_backup_level, my_nbak, nbak, &
s_backup_level, unit_nr
LOGICAL :: do_log, found, my_do_backup, my_local, &
my_mpi_io, my_on_file, &
my_should_output, replace
TYPE(cp_iteration_info_type), POINTER :: iteration_info
TYPE(mp_file_type) :: mp_unit
TYPE(section_vals_type), POINTER :: print_key
my_local = .FALSE.
@ -968,9 +970,9 @@ CONTAINS
ELSE
IF (replace) CALL mp_file_delete(filename)
CALL mp_file_open(groupid=logger%para_env%group, &
fh=iounit, filepath=filename, amode_status=mpi_amode)
fh=mp_unit, filepath=filename, amode_status=mpi_amode)
IF (PRESENT(fout)) fout = filename
res = iounit
res = mp_unit%get_handle()
END IF
IF (do_log) THEN
unit_nr = cp_logger_get_unit_nr(logger, local=my_local)
@ -1020,6 +1022,7 @@ CONTAINS
CHARACTER(len=default_string_length) :: outPath
LOGICAL :: my_local, my_mpi_io, my_on_file, &
my_should_output
TYPE(mp_file_type) :: mp_unit
TYPE(section_vals_type), POINTER :: print_key
my_local = .FALSE.
@ -1044,7 +1047,8 @@ CONTAINS
IF (.NOT. my_mpi_io) THEN
CALL close_file(unit_nr, "KEEP")
ELSE
CALL mp_file_close(unit_nr)
CALL mp_unit%set_handle(unit_nr)
CALL mp_file_close(mp_unit)
END IF
unit_nr = -1
ELSE

129
src/mpiwrap/message_passing.F
View file

@ -72,6 +72,7 @@ MODULE message_passing
INTEGER, PARAMETER :: mp_comm_world_handle = MPI_COMM_WORLD
INTEGER, PARAMETER :: mp_request_null_handle = MPI_REQUEST_NULL
INTEGER, PARAMETER :: mp_win_null_handle = MPI_WIN_NULL
INTEGER, PARAMETER :: mp_file_null_handle = MPI_FILE_NULL
INTEGER, PARAMETER, PUBLIC :: mp_status_size = MPI_STATUS_SIZE
INTEGER, PARAMETER, PUBLIC :: mp_proc_null = MPI_PROC_NULL
! Set max allocatable memory by MPI to 2 GiByte
@ -96,8 +97,9 @@ MODULE message_passing
INTEGER, PARAMETER :: mp_comm_world_handle = -12
INTEGER, PARAMETER :: mp_request_null_handle = -4
INTEGER, PARAMETER :: mp_win_null_handle = -5
INTEGER, PARAMETER, PUBLIC :: mp_status_size = -6
INTEGER, PARAMETER, PUBLIC :: mp_proc_null = -7
INTEGER, PARAMETER :: mp_file_null_handle = -6
INTEGER, PARAMETER, PUBLIC :: mp_status_size = -7
INTEGER, PARAMETER, PUBLIC :: mp_proc_null = -8
INTEGER, PARAMETER, PUBLIC :: mp_max_library_version_string = 1
INTEGER, PARAMETER, PUBLIC :: file_offset = int_8
@ -125,6 +127,7 @@ MODULE message_passing
PUBLIC :: mp_comm_type
PUBLIC :: mp_request_type
PUBLIC :: mp_win_type
PUBLIC :: mp_file_type
TYPE mp_comm_type
PRIVATE
@ -162,12 +165,25 @@ MODULE message_passing
GENERIC, PUBLIC :: OPERATOR(.NE.) => mp_win_op_neq
END TYPE
TYPE mp_file_type
PRIVATE
INTEGER :: handle = mp_file_null_handle
CONTAINS
PROCEDURE :: set_handle => mp_file_type_set_handle
PROCEDURE :: get_handle => mp_file_type_get_handle
PROCEDURE, PRIVATE :: mp_file_op_eq
PROCEDURE, PRIVATE :: mp_file_op_neq
GENERIC, PUBLIC :: OPERATOR(.EQ.) => mp_file_op_eq
GENERIC, PUBLIC :: OPERATOR(.NE.) => mp_file_op_neq
END TYPE
! Create the constants from the corresponding handles
TYPE(mp_comm_type), PARAMETER, PUBLIC :: mp_comm_null = mp_comm_type(mp_comm_null_handle)
TYPE(mp_comm_type), PARAMETER, PUBLIC :: mp_comm_self = mp_comm_type(mp_comm_self_handle)
TYPE(mp_comm_type), PARAMETER, PUBLIC :: mp_comm_world = mp_comm_type(mp_comm_world_handle)
TYPE(mp_request_type), PARAMETER, PUBLIC :: mp_request_null = mp_request_type(mp_request_null_handle)
TYPE(mp_win_type), PARAMETER, PUBLIC :: mp_win_null = mp_win_type(mp_win_null_handle)
TYPE(mp_file_type), PARAMETER, PUBLIC :: mp_file_null = mp_file_type(mp_file_null_handle)
! init and error
PUBLIC :: mp_world_init, mp_world_finalize
@ -753,7 +769,7 @@ MODULE message_passing
CONTAINS
#:mute
#:set types = ["comm", "request", "win"]
#:set types = ["comm", "request", "win", "file"]
#:endmute
#:for type in types
ELEMENTAL LOGICAL FUNCTION mp_${type}$_op_eq(${type}$1, ${type}$2)
@ -3195,7 +3211,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_open(groupid, fh, filepath, amode_status, info)
TYPE(mp_comm_type), INTENT(IN) :: groupid
INTEGER, INTENT(OUT) :: fh
TYPE(mp_file_type), INTENT(OUT) :: fh
CHARACTER(len=*), INTENT(IN) :: filepath
INTEGER, INTENT(IN) :: amode_status
INTEGER, INTENT(IN), OPTIONAL :: info
@ -3205,7 +3221,7 @@ CONTAINS
INTEGER :: my_info
#else
CHARACTER(LEN=10) :: fstatus, fposition
INTEGER :: amode
INTEGER :: amode, handle
LOGICAL :: exists, is_open
#endif
@ -3214,8 +3230,8 @@ CONTAINS
#if defined(__parallel)
my_info = mpi_info_null
IF (PRESENT(info)) my_info = info
CALL mpi_file_open(groupid%handle, filepath, amode_status, my_info, fh, ierr)
CALL mpi_file_set_errhandler(fh, MPI_ERRORS_RETURN, ierr)
CALL mpi_file_open(groupid%handle, filepath, amode_status, my_info, fh%handle, ierr)
CALL mpi_file_set_errhandler(fh%handle, MPI_ERRORS_RETURN, ierr)
IF (ierr .NE. 0) CALL mp_stop(ierr, "mpi_file_set_errhandler @ mp_file_open")
#else
MARK_USED(groupid)
@ -3235,11 +3251,12 @@ CONTAINS
fstatus = "OLD"
END IF
! Get a new unit number
DO fh = 1, 999
INQUIRE (UNIT=fh, EXIST=exists, OPENED=is_open, IOSTAT=istat)
DO handle = 1, 999
INQUIRE (UNIT=handle, EXIST=exists, OPENED=is_open, IOSTAT=istat)
IF (exists .AND. (.NOT. is_open) .AND. (istat == 0)) EXIT
END DO
OPEN (UNIT=fh, FILE=filepath, STATUS=fstatus, ACCESS="STREAM", POSITION=fposition)
OPEN (UNIT=handle, FILE=filepath, STATUS=fstatus, ACCESS="STREAM", POSITION=fposition)
fh%handle = handle
#endif
END SUBROUTINE mp_file_open
@ -3286,17 +3303,17 @@ CONTAINS
!> 11.2012 created [Hossein Bani-Hashemian]
! **************************************************************************************************
SUBROUTINE mp_file_close(fh)
INTEGER, INTENT(INOUT) :: fh
TYPE(mp_file_type), INTENT(INOUT) :: fh
INTEGER :: ierr
ierr = 0
#if defined(__parallel)
CALL mpi_file_set_errhandler(fh, MPI_ERRORS_RETURN, ierr)
CALL mpi_file_close(fh, ierr)
CALL mpi_file_set_errhandler(fh%handle, MPI_ERRORS_RETURN, ierr)
CALL mpi_file_close(fh%handle, ierr)
IF (ierr .NE. 0) CALL mp_stop(ierr, "mpi_file_set_errhandler @ mp_file_close")
#else
CLOSE (fh)
CLOSE (fh%handle)
#endif
END SUBROUTINE mp_file_close
@ -3311,18 +3328,18 @@ CONTAINS
!> 12.2012 created [Hossein Bani-Hashemian]
! **************************************************************************************************
SUBROUTINE mp_file_get_size(fh, file_size)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(OUT) :: file_size
INTEGER :: ierr
ierr = 0
#if defined(__parallel)
CALL mpi_file_set_errhandler(fh, MPI_ERRORS_RETURN, ierr)
CALL mpi_file_get_size(fh, file_size, ierr)
CALL mpi_file_set_errhandler(fh%handle, MPI_ERRORS_RETURN, ierr)
CALL mpi_file_get_size(fh%handle, file_size, ierr)
IF (ierr .NE. 0) CALL mp_stop(ierr, "mpi_file_set_errhandler @ mp_file_get_size")
#else
INQUIRE (UNIT=fh, SIZE=file_size)
INQUIRE (UNIT=fh%handle, SIZE=file_size)
#endif
END SUBROUTINE mp_file_get_size
@ -3337,18 +3354,18 @@ CONTAINS
!> 11.2017 created [Nico Holmberg]
! **************************************************************************************************
SUBROUTINE mp_file_get_position(fh, pos)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(OUT) :: pos
INTEGER :: ierr
ierr = 0
#if defined(__parallel)
CALL mpi_file_set_errhandler(fh, MPI_ERRORS_RETURN, ierr)
CALL mpi_file_get_position(fh, pos, ierr)
CALL mpi_file_set_errhandler(fh%handle, MPI_ERRORS_RETURN, ierr)
CALL mpi_file_get_position(fh%handle, pos, ierr)
IF (ierr .NE. 0) CALL mp_stop(ierr, "mpi_file_set_errhandler @ mp_file_get_position")
#else
INQUIRE (UNIT=fh, POS=pos)
INQUIRE (UNIT=fh%handle, POS=pos)
#endif
END SUBROUTINE mp_file_get_position
@ -3365,7 +3382,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_write_at_chv(fh, offset, msg, msglen)
CHARACTER, INTENT(IN) :: msg(:)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN), OPTIONAL :: msglen
INTEGER(kind=file_offset), INTENT(IN) :: offset
@ -3376,12 +3393,12 @@ CONTAINS
msg_len = SIZE(msg)
IF (PRESENT(msglen)) msg_len = msglen
CALL MPI_FILE_WRITE_AT(fh, offset, msg, msg_len, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_WRITE_AT(fh%handle, offset, msg, msg_len, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_write_at_chv @ "//routineN)
#else
MARK_USED(msglen)
WRITE (UNIT=fh, POS=offset + 1) msg
WRITE (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_write_at_chv
@ -3393,7 +3410,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_write_at_ch(fh, offset, msg)
CHARACTER(LEN=*), INTENT(IN) :: msg
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_ch'
@ -3401,11 +3418,11 @@ CONTAINS
#if defined(__parallel)
INTEGER :: ierr
CALL MPI_FILE_WRITE_AT(fh, offset, msg, LEN(msg), MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_WRITE_AT(fh%handle, offset, msg, LEN(msg), MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_write_at_ch @ "//routineN)
#else
WRITE (UNIT=fh, POS=offset + 1) msg
WRITE (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_write_at_ch
@ -3421,7 +3438,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_write_at_all_chv(fh, offset, msg, msglen)
CHARACTER, INTENT(IN) :: msg(:)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN), OPTIONAL :: msglen
INTEGER(kind=file_offset), INTENT(IN) :: offset
@ -3432,12 +3449,12 @@ CONTAINS
msg_len = SIZE(msg)
IF (PRESENT(msglen)) msg_len = msglen
CALL MPI_FILE_WRITE_AT_ALL(fh, offset, msg, msg_len, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_WRITE_AT_ALL(fh%handle, offset, msg, msg_len, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_write_at_all_chv @ "//routineN)
#else
MARK_USED(msglen)
WRITE (UNIT=fh, POS=offset + 1) msg
WRITE (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_write_at_all_chv
@ -3449,7 +3466,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_write_at_all_ch(fh, offset, msg)
CHARACTER(LEN=*), INTENT(IN) :: msg
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_all_ch'
@ -3457,11 +3474,11 @@ CONTAINS
#if defined(__parallel)
INTEGER :: ierr
CALL MPI_FILE_WRITE_AT_ALL(fh, offset, msg, LEN(msg), MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_WRITE_AT_ALL(fh%handle, offset, msg, LEN(msg), MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_write_at_all_ch @ "//routineN)
#else
WRITE (UNIT=fh, POS=offset + 1) msg
WRITE (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_write_at_all_ch
@ -3478,7 +3495,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_read_at_chv(fh, offset, msg, msglen)
CHARACTER, INTENT(OUT) :: msg(:)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN), OPTIONAL :: msglen
INTEGER(kind=file_offset), INTENT(IN) :: offset
@ -3489,12 +3506,12 @@ CONTAINS
msg_len = SIZE(msg)
IF (PRESENT(msglen)) msg_len = msglen
CALL MPI_FILE_READ_AT(fh, offset, msg, msg_len, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_READ_AT(fh%handle, offset, msg, msg_len, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_read_at_chv @ "//routineN)
#else
MARK_USED(msglen)
READ (UNIT=fh, POS=offset + 1) msg
READ (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_read_at_chv
@ -3506,7 +3523,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_read_at_ch(fh, offset, msg)
CHARACTER(LEN=*), INTENT(OUT) :: msg
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_ch'
@ -3514,11 +3531,11 @@ CONTAINS
#if defined(__parallel)
INTEGER :: ierr
CALL MPI_FILE_READ_AT(fh, offset, msg, LEN(msg), MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_READ_AT(fh%handle, offset, msg, LEN(msg), MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_read_at_ch @ "//routineN)
#else
READ (UNIT=fh, POS=offset + 1) msg
READ (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_read_at_ch
@ -3534,7 +3551,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_read_at_all_chv(fh, offset, msg, msglen)
CHARACTER, INTENT(OUT) :: msg(:)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN), OPTIONAL :: msglen
INTEGER(kind=file_offset), INTENT(IN) :: offset
@ -3545,12 +3562,12 @@ CONTAINS
msg_len = SIZE(msg)
IF (PRESENT(msglen)) msg_len = msglen
CALL MPI_FILE_READ_AT_ALL(fh, offset, msg, msg_len, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_READ_AT_ALL(fh%handle, offset, msg, msg_len, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_read_at_all_chv @ "//routineN)
#else
MARK_USED(msglen)
READ (UNIT=fh, POS=offset + 1) msg
READ (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_read_at_all_chv
@ -3562,7 +3579,7 @@ CONTAINS
! **************************************************************************************************
SUBROUTINE mp_file_read_at_all_ch(fh, offset, msg)
CHARACTER(LEN=*), INTENT(OUT) :: msg
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_all_ch'
@ -3570,11 +3587,11 @@ CONTAINS
#if defined(__parallel)
INTEGER :: ierr
CALL MPI_FILE_READ_AT_ALL(fh, offset, msg, LEN(msg), MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_READ_AT_ALL(fh%handle, offset, msg, LEN(msg), MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_read_at_all_ch @ "//routineN)
#else
READ (UNIT=fh, POS=offset + 1) msg
READ (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_read_at_all_ch
@ -3779,7 +3796,7 @@ CONTAINS
!> \author Nico Holmberg [05.2017]
! **************************************************************************************************
SUBROUTINE mp_file_type_set_view_chv(fh, offset, type_descriptor)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
TYPE(mp_file_descriptor_type) :: type_descriptor
@ -3791,8 +3808,8 @@ CONTAINS
CALL mp_timeset(routineN, handle)
#if defined(__parallel)
CALL mpi_file_set_errhandler(fh, MPI_ERRORS_RETURN, ierr)
CALL MPI_File_set_view(fh, offset, MPI_CHARACTER, &
CALL mpi_file_set_errhandler(fh%handle, MPI_ERRORS_RETURN, ierr)
CALL MPI_File_set_view(fh%handle, offset, MPI_CHARACTER, &
type_descriptor%type_handle, "native", MPI_INFO_NULL, ierr)
IF (ierr .NE. 0) CALL mp_stop(ierr, "mpi_file_set_errhandler @ MPI_File_set_view")
#else
@ -3818,7 +3835,7 @@ CONTAINS
!> \author Nico Holmberg [05.2017]
! **************************************************************************************************
SUBROUTINE mp_file_read_all_chv(fh, msglen, ndims, buffer, type_descriptor)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN) :: msglen
INTEGER, INTENT(IN) :: ndims
CHARACTER(LEN=msglen), DIMENSION(ndims) :: buffer
@ -3835,7 +3852,7 @@ CONTAINS
#if defined(__parallel)
MARK_USED(type_descriptor)
CALL MPI_File_read_all(fh, buffer, ndims*msglen, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL MPI_File_read_all(fh%handle, buffer, ndims*msglen, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) CALL mp_stop(ierr, "mpi_file_set_errhandler @ MPI_File_read_all")
CALL add_perf(perf_id=28, count=1, msg_size=ndims*msglen)
#else
@ -3849,7 +3866,7 @@ CONTAINS
"File view has not been set in mp_file_descriptor_type.")
! Use explicit offsets
DO i = 1, ndims
READ (fh, POS=type_descriptor%index_descriptor%chunks(i)) buffer(i)
READ (fh%handle, POS=type_descriptor%index_descriptor%chunks(i)) buffer(i)
END DO
#endif
@ -3869,7 +3886,7 @@ CONTAINS
!> \author Nico Holmberg [05.2017]
! **************************************************************************************************
SUBROUTINE mp_file_write_all_chv(fh, msglen, ndims, buffer, type_descriptor)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN) :: msglen
INTEGER, INTENT(IN) :: ndims
CHARACTER(LEN=msglen), DIMENSION(ndims) :: buffer
@ -3886,8 +3903,8 @@ CONTAINS
#if defined(__parallel)
MARK_USED(type_descriptor)
CALL mpi_file_set_errhandler(fh, MPI_ERRORS_RETURN, ierr)
CALL MPI_File_write_all(fh, buffer, ndims*msglen, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
CALL mpi_file_set_errhandler(fh%handle, MPI_ERRORS_RETURN, ierr)
CALL MPI_File_write_all(fh%handle, buffer, ndims*msglen, MPI_CHARACTER, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) CALL mp_stop(ierr, "mpi_file_set_errhandler @ MPI_File_write_all")
CALL add_perf(perf_id=28, count=1, msg_size=ndims*msglen)
#else
@ -3901,7 +3918,7 @@ CONTAINS
"File view has not been set in mp_file_descriptor_type.")
! Use explicit offsets
DO i = 1, ndims
WRITE (fh, POS=type_descriptor%index_descriptor%chunks(i)) buffer(i)
WRITE (fh%handle, POS=type_descriptor%index_descriptor%chunks(i)) buffer(i)
END DO
#endif

54
src/mpiwrap/message_passing.fypp
View file

@ -3730,7 +3730,7 @@
! **************************************************************************************************
SUBROUTINE mp_file_write_at_${nametype1}$v(fh, offset, msg, msglen)
${type1}$, INTENT(IN) :: msg(:)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN), OPTIONAL :: msglen
INTEGER(kind=file_offset), INTENT(IN) :: offset
@ -3742,11 +3742,11 @@
msg_len = SIZE(msg)
IF (PRESENT(msglen)) msg_len = msglen
#if defined(__parallel)
CALL MPI_FILE_WRITE_AT(fh, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_WRITE_AT(fh%handle, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_write_at_${nametype1}$v @ "//routineN)
#else
WRITE (UNIT=fh, POS=offset + 1) msg(1:msg_len)
WRITE (UNIT=fh%handle, POS=offset + 1) msg(1:msg_len)
#endif
END SUBROUTINE mp_file_write_at_${nametype1}$v
@ -3758,7 +3758,7 @@
! **************************************************************************************************
SUBROUTINE mp_file_write_at_${nametype1}$ (fh, offset, msg)
${type1}$, INTENT(IN) :: msg
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_${nametype1}$'
@ -3767,11 +3767,11 @@
ierr = 0
#if defined(__parallel)
CALL MPI_FILE_WRITE_AT(fh, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_WRITE_AT(fh%handle, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_write_at_${nametype1}$ @ "//routineN)
#else
WRITE (UNIT=fh, POS=offset + 1) msg
WRITE (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_write_at_${nametype1}$
@ -3787,24 +3787,23 @@
! **************************************************************************************************
SUBROUTINE mp_file_write_at_all_${nametype1}$v(fh, offset, msg, msglen)
${type1}$, INTENT(IN) :: msg(:)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN), OPTIONAL :: msglen
INTEGER :: msg_len
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_all_${nametype1}$v'
INTEGER :: ierr
INTEGER :: ierr, msg_len
ierr = 0
msg_len = SIZE(msg)
IF (PRESENT(msglen)) msg_len = msglen
#if defined(__parallel)
CALL MPI_FILE_WRITE_AT_ALL(fh, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_WRITE_AT_ALL(fh%handle, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_write_at_all_${nametype1}$v @ "//routineN)
#else
WRITE (UNIT=fh, POS=offset + 1) msg(1:msg_len)
WRITE (UNIT=fh%handle, POS=offset + 1) msg(1:msg_len)
#endif
END SUBROUTINE mp_file_write_at_all_${nametype1}$v
@ -3816,7 +3815,7 @@
! **************************************************************************************************
SUBROUTINE mp_file_write_at_all_${nametype1}$ (fh, offset, msg)
${type1}$, INTENT(IN) :: msg
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_write_at_all_${nametype1}$'
@ -3825,11 +3824,11 @@
ierr = 0
#if defined(__parallel)
CALL MPI_FILE_WRITE_AT_ALL(fh, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_WRITE_AT_ALL(fh%handle, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_write_at_all_${nametype1}$ @ "//routineN)
#else
WRITE (UNIT=fh, POS=offset + 1) msg
WRITE (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_write_at_all_${nametype1}$
@ -3846,24 +3845,23 @@
! **************************************************************************************************
SUBROUTINE mp_file_read_at_${nametype1}$v(fh, offset, msg, msglen)
${type1}$, INTENT(OUT) :: msg(:)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN), OPTIONAL :: msglen
INTEGER :: msg_len
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_${nametype1}$v'
INTEGER :: ierr
INTEGER :: ierr, msg_len
ierr = 0
msg_len = SIZE(msg)
IF (PRESENT(msglen)) msg_len = msglen
#if defined(__parallel)
CALL MPI_FILE_READ_AT(fh, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_READ_AT(fh%handle, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_read_at_${nametype1}$v @ "//routineN)
#else
READ (UNIT=fh, POS=offset + 1) msg(1:msg_len)
READ (UNIT=fh%handle, POS=offset + 1) msg(1:msg_len)
#endif
END SUBROUTINE mp_file_read_at_${nametype1}$v
@ -3875,7 +3873,7 @@
! **************************************************************************************************
SUBROUTINE mp_file_read_at_${nametype1}$ (fh, offset, msg)
${type1}$, INTENT(OUT) :: msg
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_${nametype1}$'
@ -3884,11 +3882,11 @@
ierr = 0
#if defined(__parallel)
CALL MPI_FILE_READ_AT(fh, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_READ_AT(fh%handle, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_read_at_${nametype1}$ @ "//routineN)
#else
READ (UNIT=fh, POS=offset + 1) msg
READ (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_read_at_${nametype1}$
@ -3904,7 +3902,7 @@
! **************************************************************************************************
SUBROUTINE mp_file_read_at_all_${nametype1}$v(fh, offset, msg, msglen)
${type1}$, INTENT(OUT) :: msg(:)
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER, INTENT(IN), OPTIONAL :: msglen
INTEGER(kind=file_offset), INTENT(IN) :: offset
@ -3916,11 +3914,11 @@
msg_len = SIZE(msg)
IF (PRESENT(msglen)) msg_len = msglen
#if defined(__parallel)
CALL MPI_FILE_READ_AT_ALL(fh, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_READ_AT_ALL(fh%handle, offset, msg, msg_len, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_read_at_all_${nametype1}$v @ "//routineN)
#else
READ (UNIT=fh, POS=offset + 1) msg(1:msg_len)
READ (UNIT=fh%handle, POS=offset + 1) msg(1:msg_len)
#endif
END SUBROUTINE mp_file_read_at_all_${nametype1}$v
@ -3932,7 +3930,7 @@
! **************************************************************************************************
SUBROUTINE mp_file_read_at_all_${nametype1}$ (fh, offset, msg)
${type1}$, INTENT(OUT) :: msg
INTEGER, INTENT(IN) :: fh
TYPE(mp_file_type), INTENT(IN) :: fh
INTEGER(kind=file_offset), INTENT(IN) :: offset
CHARACTER(len=*), PARAMETER :: routineN = 'mp_file_read_at_all_${nametype1}$'
@ -3941,11 +3939,11 @@
ierr = 0
#if defined(__parallel)
CALL MPI_FILE_READ_AT_ALL(fh, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
CALL MPI_FILE_READ_AT_ALL(fh%handle, offset, msg, 1, ${mpi_type1}$, MPI_STATUS_IGNORE, ierr)
IF (ierr .NE. 0) &
CPABORT("mpi_file_read_at_all_${nametype1}$ @ "//routineN)
#else
READ (UNIT=fh, POS=offset + 1) msg
READ (UNIT=fh%handle, POS=offset + 1) msg
#endif
END SUBROUTINE mp_file_read_at_all_${nametype1}$

53
src/pw/realspace_grid_cube.F
View file

@ -16,9 +16,9 @@ MODULE realspace_grid_cube
USE message_passing, ONLY: &
file_amode_rdonly, file_offset, mp_bcast, mp_comm_type, mp_file_close, &
mp_file_descriptor_type, mp_file_get_position, mp_file_open, mp_file_read_all_chv, &
mp_file_type_free, mp_file_type_hindexed_make_chv, mp_file_type_set_view_chv, &
mp_file_write_all_chv, mp_file_write_at, mp_maxloc, mp_recv, mp_send, mp_sum, mp_sync, &
mpi_character_size
mp_file_type, mp_file_type_free, mp_file_type_hindexed_make_chv, &
mp_file_type_set_view_chv, mp_file_write_all_chv, mp_file_write_at, mp_maxloc, mp_recv, &
mp_send, mp_sum, mp_sync, mpi_character_size
USE pw_grid_types, ONLY: PW_MODE_LOCAL
USE pw_types, ONLY: pw_type
#include "../base/base_uses.f90"
@ -67,6 +67,7 @@ CONTAINS
LOGICAL :: be_silent, my_zero_tails, parallel_write
REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: buf
TYPE(mp_comm_type) :: gid
TYPE(mp_file_type) :: mp_unit
CALL timeset(routineN, handle)
@ -215,7 +216,8 @@ CONTAINS
IF (MODULO(size_of_z, num_entries_line) /= 0) &
num_linebreak = num_linebreak + 1
msglen = (size_of_z*entry_len + num_linebreak)*mpi_character_size
CALL pw_to_cube_parallel(pw, unit_nr, title, particles_r, particles_z, my_stride, my_zero_tails, msglen)
CALL mp_unit%set_handle(unit_nr)
CALL pw_to_cube_parallel(pw, mp_unit, title, particles_r, particles_z, my_stride, my_zero_tails, msglen)
END IF
CALL timestop(handle)
@ -391,7 +393,7 @@ CONTAINS
INTEGER(kind=file_offset), ALLOCATABLE, &
DIMENSION(:), TARGET :: displacements
INTEGER(kind=file_offset) :: BOF
INTEGER :: extunit, i, ientry, ip, islice, j, k, master, my_rank, nat, ndum, nslices, &
INTEGER :: extunit_handle, i, ientry, ip, islice, j, k, master, my_rank, nat, ndum, nslices, &
num_pe, offset_global, output_unit, pos, readstat, size_of_z, tag
CHARACTER(LEN=msglen), ALLOCATABLE, DIMENSION(:) :: readbuffer
CHARACTER(LEN=msglen) :: tmp
@ -399,7 +401,8 @@ CONTAINS
REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: buffer
REAL(kind=dp), DIMENSION(3) :: dr, rdum
TYPE(mp_comm_type) :: gid
TYPE(mp_file_descriptor_type) :: mp_file_type
TYPE(mp_file_descriptor_type) :: mp_file_desc
TYPE(mp_file_type) :: extunit
output_unit = cp_logger_get_default_io_unit()
@ -440,15 +443,15 @@ CONTAINS
file_form="FORMATTED", &
file_action="READ", &
file_access="STREAM", &
unit_number=extunit)
unit_number=extunit_handle)
!skip header comments
DO i = 1, 2
READ (extunit, *)
READ (extunit_handle, *)
END DO
READ (extunit, *) nat, rdum
READ (extunit_handle, *) nat, rdum
DO i = 1, 3
READ (extunit, *) ndum, rdum
READ (extunit_handle, *) ndum, rdum
IF ((ndum /= npoints(i) .OR. (ABS(rdum(i) - dr(i)) > 1e-4)) .AND. &
output_unit > 0) THEN
WRITE (output_unit, *) "Restart from density | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i
@ -458,11 +461,11 @@ CONTAINS
END DO
!ignore atomic position data - read from coord or topology instead
DO i = 1, nat
READ (extunit, *)
READ (extunit_handle, *)
END DO
! Get byte offset
INQUIRE (extunit, POS=offset_global)
CALL close_file(unit_number=extunit)
INQUIRE (extunit_handle, POS=offset_global)
CALL close_file(unit_number=extunit_handle)
END IF
! Sync offset and start parallel read
CALL mp_bcast(offset_global, grid%pw_grid%para%group_head_id, gid)
@ -496,14 +499,14 @@ CONTAINS
ALLOCATE (blocklengths(nslices))
blocklengths(:) = msglen
! Create indexed MPI type using calculated byte offsets as displacements and use it as a file view
mp_file_type = mp_file_type_hindexed_make_chv(nslices, blocklengths, displacements)
mp_file_desc = mp_file_type_hindexed_make_chv(nslices, blocklengths, displacements)
BOF = 0
CALL mp_file_type_set_view_chv(extunit, BOF, mp_file_type)
CALL mp_file_type_set_view_chv(extunit, BOF, mp_file_desc)
! Collective read of cube
ALLOCATE (readbuffer(nslices))
readbuffer(:) = ''
CALL mp_file_read_all_chv(extunit, msglen, nslices, readbuffer, mp_file_type)
CALL mp_file_type_free(mp_file_type)
CALL mp_file_read_all_chv(extunit, msglen, nslices, readbuffer, mp_file_desc)
CALL mp_file_type_free(mp_file_desc)
CALL mp_file_close(extunit)
! Convert cube values string -> real
i = lbounds_local(1)
@ -565,15 +568,15 @@ CONTAINS
file_status="OLD", &
file_form="FORMATTED", &
file_action="READ", &
unit_number=extunit)
unit_number=extunit_handle)
!skip header comments
DO i = 1, 2
READ (extunit, *)
READ (extunit_handle, *)
END DO
READ (extunit, *) nat, rdum
READ (extunit_handle, *) nat, rdum
DO i = 1, 3
READ (extunit, *) ndum, rdum
READ (extunit_handle, *) ndum, rdum
IF ((ndum /= npoints(i) .OR. (ABS(rdum(i) - dr(i)) > 1e-4)) .AND. &
output_unit > 0) THEN
WRITE (output_unit, *) "Restart from density | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i
@ -583,7 +586,7 @@ CONTAINS
END DO
!ignore atomic position data - read from coord or topology instead
DO i = 1, nat
READ (extunit, *)
READ (extunit_handle, *)
END DO
END IF
@ -591,7 +594,7 @@ CONTAINS
DO i = lbounds(1), ubounds(1)
DO j = lbounds(2), ubounds(2)
IF (my_rank .EQ. 0) THEN
READ (extunit, *) (buffer(k), k=lbounds(3), ubounds(3))
READ (extunit_handle, *) (buffer(k), k=lbounds(3), ubounds(3))
IF (num_pe .GT. 1) THEN
DO ip = 1, num_pe - 1
CALL mp_send(buffer(lbounds(3):ubounds(3)), ip, tag, gid)
@ -615,7 +618,7 @@ CONTAINS
END DO
END DO
IF (my_rank == 0) CALL close_file(unit_number=extunit)
IF (my_rank == 0) CALL close_file(unit_number=extunit_handle)
CALL mp_sync(gid)
END IF
@ -640,7 +643,7 @@ CONTAINS
msglen)
TYPE(pw_type), INTENT(IN) :: grid
INTEGER, INTENT(IN) :: unit_nr
TYPE(mp_file_type), INTENT(IN) :: unit_nr
CHARACTER(*), INTENT(IN), OPTIONAL :: title
REAL(KIND=dp), DIMENSION(:, :), INTENT(IN), &
OPTIONAL :: particles_r