diff --git a/src/input/cp_output_handling.F b/src/input/cp_output_handling.F index 6e6ffb275e..3fe9c3274c 100644 --- a/src/input/cp_output_handling.F +++ b/src/input/cp_output_handling.F @@ -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 diff --git a/src/mpiwrap/message_passing.F b/src/mpiwrap/message_passing.F index 9302c592bb..b66dbfd7c5 100644 --- a/src/mpiwrap/message_passing.F +++ b/src/mpiwrap/message_passing.F @@ -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 diff --git a/src/mpiwrap/message_passing.fypp b/src/mpiwrap/message_passing.fypp index 340d677bae..6e51044c04 100644 --- a/src/mpiwrap/message_passing.fypp +++ b/src/mpiwrap/message_passing.fypp @@ -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}$ diff --git a/src/pw/realspace_grid_cube.F b/src/pw/realspace_grid_cube.F index 38ae7f4282..6c26275370 100644 --- a/src/pw/realspace_grid_cube.F +++ b/src/pw/realspace_grid_cube.F @@ -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