From a093d8aa3732bf50b2d4c0c9ee21d641b2eb6759 Mon Sep 17 00:00:00 2001 From: Frederick Stein Date: Sun, 11 Dec 2022 13:36:21 +0100 Subject: [PATCH] Refactor comparison operators for mp_comm_type --- src/cp_subsys_methods.F | 2 +- src/fm/cp_cfm_basic_linalg.F | 4 ++-- src/fm/cp_fm_basic_linalg.F | 2 +- src/fm/cp_fm_struct.F | 2 +- src/mpiwrap/message_passing.F | 14 ++++++++++++++ src/pw/fft_tools.F | 10 +++++----- src/pw/pw_methods.F | 2 +- src/replica_methods.F | 2 +- 8 files changed, 26 insertions(+), 12 deletions(-) diff --git a/src/cp_subsys_methods.F b/src/cp_subsys_methods.F index 304a28a343..9d7d9c8f50 100644 --- a/src/cp_subsys_methods.F +++ b/src/cp_subsys_methods.F @@ -293,7 +293,7 @@ CONTAINS CPASSERT(.NOT. ASSOCIATED(small_subsys)) CPASSERT(ASSOCIATED(big_subsys)) - IF (big_subsys%para_env%group%get_handle() /= small_para_env%group%get_handle()) & + IF (big_subsys%para_env%group /= small_para_env%group) & CPABORT("big_subsys%para_env%group==small_para_env%group") !----------------------------------------------------------------------------- diff --git a/src/fm/cp_cfm_basic_linalg.F b/src/fm/cp_cfm_basic_linalg.F index 7ccd07eafc..c7896125e4 100644 --- a/src/fm/cp_cfm_basic_linalg.F +++ b/src/fm/cp_cfm_basic_linalg.F @@ -195,7 +195,7 @@ CONTAINS ELSE CPASSERT(PRESENT(matrix_b)) - IF (matrix_a%matrix_struct%context%group%get_handle() /= matrix_b%matrix_struct%context%group%get_handle()) & + IF (matrix_a%matrix_struct%context%group /= matrix_b%matrix_struct%context%group) & CPABORT("matrixes must be in the same blacs context") IF (cp_fm_struct_equivalent(matrix_a%matrix_struct, & @@ -302,7 +302,7 @@ CONTAINS END IF ELSE - IF (matrix_a%matrix_struct%context%group%get_handle() /= matrix_b%matrix_struct%context%group%get_handle()) & + IF (matrix_a%matrix_struct%context%group /= matrix_b%matrix_struct%context%group) & CPABORT("matrices must be in the same blacs context") IF (cp_fm_struct_equivalent(matrix_a%matrix_struct, & diff --git a/src/fm/cp_fm_basic_linalg.F b/src/fm/cp_fm_basic_linalg.F index 86b32a7971..0bb3b576db 100644 --- a/src/fm/cp_fm_basic_linalg.F +++ b/src/fm/cp_fm_basic_linalg.F @@ -137,7 +137,7 @@ CONTAINS END IF END IF IF (my_beta .NE. 0.0_dp) THEN - IF (matrix_a%matrix_struct%context%group%get_handle() /= matrix_b%matrix_struct%context%group%get_handle()) & + IF (matrix_a%matrix_struct%context%group /= matrix_b%matrix_struct%context%group) & CPABORT("matrixes must be in the same blacs context") IF (cp_fm_struct_equivalent(matrix_a%matrix_struct, & diff --git a/src/fm/cp_fm_struct.F b/src/fm/cp_fm_struct.F index db30354969..d6f79e2dd0 100644 --- a/src/fm/cp_fm_struct.F +++ b/src/fm/cp_fm_struct.F @@ -370,7 +370,7 @@ CONTAINS IF (ASSOCIATED(fmstruct1, fmstruct2)) THEN res = .TRUE. ELSE - res = (fmstruct1%context%group%get_handle() == fmstruct2%context%group%get_handle()) .AND. & + res = (fmstruct1%context%group == fmstruct2%context%group) .AND. & (fmstruct1%nrow_global == fmstruct2%nrow_global) .AND. & (fmstruct1%ncol_global == fmstruct2%ncol_global) .AND. & (fmstruct1%local_leading_dimension == & diff --git a/src/mpiwrap/message_passing.F b/src/mpiwrap/message_passing.F index 367395d712..f5749e0b81 100644 --- a/src/mpiwrap/message_passing.F +++ b/src/mpiwrap/message_passing.F @@ -130,6 +130,10 @@ MODULE message_passing CONTAINS PROCEDURE :: set_handle => mp_comm_type_set_handle PROCEDURE :: get_handle => mp_comm_type_get_handle +PROCEDURE, PRIVATE :: mp_comm_op_eq +PROCEDURE, PRIVATE :: mp_comm_op_neq +GENERIC, PUBLIC :: operator(.EQ.) => mp_comm_op_eq +GENERIC, PUBLIC :: operator(.NE.) => mp_comm_op_neq END TYPE ! The actual constants @@ -720,6 +724,16 @@ MODULE message_passing CONTAINS + ELEMENTAL LOGICAL FUNCTION mp_comm_op_eq(comm1, comm2) + CLASS(mp_comm_type), INTENT(IN) :: comm1, comm2 + mp_comm_op_eq = (comm1%handle .EQ. comm2%handle) + END FUNCTION mp_comm_op_eq + + ELEMENTAL LOGICAL FUNCTION mp_comm_op_neq(comm1, comm2) + CLASS(mp_comm_type), INTENT(IN) :: comm1, comm2 + mp_comm_op_neq = (comm1%handle .NE. comm2%handle) + END FUNCTION mp_comm_op_neq + ELEMENTAL SUBROUTINE mp_comm_type_set_handle(this, handle) CLASS(mp_comm_type), INTENT(INOUT) :: this INTEGER, INTENT(IN) :: handle diff --git a/src/pw/fft_tools.F b/src/pw/fft_tools.F index 7d27eb1bb9..458a0158c2 100644 --- a/src/pw/fft_tools.F +++ b/src/pw/fft_tools.F @@ -2753,10 +2753,10 @@ CONTAINS DEALLOCATE (fft_scratch%rbuf6) END IF - IF (fft_scratch%cart_sub_comm(1)%get_handle() .NE. mp_comm_null%get_handle()) THEN + IF (fft_scratch%cart_sub_comm(1) /= mp_comm_null) THEN CALL mp_comm_free(fft_scratch%cart_sub_comm(1)) END IF - IF (fft_scratch%cart_sub_comm(2)%get_handle() .NE. mp_comm_null%get_handle()) THEN + IF (fft_scratch%cart_sub_comm(2) /= mp_comm_null) THEN CALL mp_comm_free(fft_scratch%cart_sub_comm(2)) END IF fft_scratch%cart_sub_comm = mp_comm_null @@ -2921,7 +2921,7 @@ CONTAINS CYCLE END IF IF (PRESENT(fft_sizes)) THEN - IF (fft_sizes%gs_group%get_handle() /= fft_scratch_current%fft_scratch%group%get_handle()) THEN + IF (fft_sizes%gs_group /= fft_scratch_current%fft_scratch%group) THEN fft_scratch_last => fft_scratch_current fft_scratch_current => fft_scratch_current%fft_scratch_next CYCLE @@ -3410,8 +3410,8 @@ CONTAINS equal = equal .AND. fft_size_1%nmray == fft_size_2%nmray equal = equal .AND. fft_size_1%nyzray == fft_size_2%nyzray - equal = equal .AND. fft_size_1%gs_group%get_handle() == fft_size_2%gs_group%get_handle() - equal = equal .AND. fft_size_1%rs_group%get_handle() == fft_size_2%rs_group%get_handle() + equal = equal .AND. fft_size_1%gs_group == fft_size_2%gs_group + equal = equal .AND. fft_size_1%rs_group == fft_size_2%rs_group equal = equal .AND. ALL(fft_size_1%g_pos == fft_size_2%g_pos) equal = equal .AND. ALL(fft_size_1%r_pos == fft_size_2%r_pos) diff --git a/src/pw/pw_methods.F b/src/pw/pw_methods.F index 204949b648..bdabb7e763 100644 --- a/src/pw/pw_methods.F +++ b/src/pw/pw_methods.F @@ -1694,7 +1694,7 @@ CONTAINS IF (pw1%pw_grid%dvol /= pw2%pw_grid%dvol) THEN CPABORT("PW grids not compatible") END IF - IF (pw1%pw_grid%para%group%get_handle() /= pw2%pw_grid%para%group%get_handle()) THEN + IF (pw1%pw_grid%para%group /= pw2%pw_grid%para%group) THEN CPABORT("PW grids have not compatible MPI groups") END IF END IF diff --git a/src/replica_methods.F b/src/replica_methods.F index 53f8519e80..869d856ecc 100644 --- a/src/replica_methods.F +++ b/src/replica_methods.F @@ -133,7 +133,7 @@ CONTAINS WRITE (unit_nr, FMT="(T2,A,I0,A)") "REPLICA| ", para_env%num_pe - dims(1)*dims(2), " MPI process(es) will be idle" END IF CALL mp_cart_create(comm_old=para_env%group, ndims=2, dims=dims, pos=pos, comm_cart=comm_cart) - IF (comm_cart%get_handle() /= mp_comm_null%get_handle()) THEN + IF (comm_cart /= mp_comm_null) THEN CALL cp_cart_create(cart, comm_cart, ndims=2, owns_group=.TRUE.) NULLIFY (para_env_full) CALL cp_para_env_create(para_env_full, comm_cart, owns_group=.FALSE.)