Refactor comparison operators for mp_comm_type

This commit is contained in:
Frederick Stein 2022-12-11 13:36:21 +01:00 committed by Frederick Stein
parent e9b55358bc
commit a093d8aa37
8 changed files with 26 additions and 12 deletions

View file

@ -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")
!-----------------------------------------------------------------------------

View file

@ -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, &

View file

@ -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, &

View file

@ -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 == &

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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.)