Line data    Source code

       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Exercises point-to-point MPI wrappers concurrently from multiple OpenMP threads.
      10              : ! **************************************************************************************************
      11            2 : PROGRAM message_passing_thread_unittest
      12              :    USE OMP_LIB,                         ONLY: omp_get_num_threads,&
      13              :                                               omp_get_thread_num,&
      14            2 :                                               omp_set_dynamic,&
      15              :                                               omp_set_num_threads
      16              :    USE message_passing,                 ONLY: mp_collect_timings,&
      17              :                                               mp_comm_type,&
      18              :                                               mp_world_finalize,&
      19              :                                               mp_world_init
      20              :    USE timings,                         ONLY: add_timer_env,&
      21              :                                               rm_timer_env,&
      22              :                                               timings_register_hooks
      23              : #include "../base/base_uses.f90"
      24              : 
      25              :    IMPLICIT NONE
      26              : 
      27              :    TYPE(mp_comm_type)                                  :: world
      28              : 
      29            2 :    CALL mp_world_init(world)
      30              : 
      31            2 :    CALL timings_register_hooks()
      32            2 :    CALL add_timer_env()
      33            2 :    mp_collect_timings = .TRUE.
      34              : 
      35            2 :    CALL omp_set_dynamic(.FALSE.)
      36            2 :    CALL omp_set_num_threads(2)
      37              : !$OMP PARALLEL DEFAULT(NONE) SHARED(world)
      38              :    CALL exercise_concurrent_point_to_point(world)
      39              : !$OMP END PARALLEL
      40              : 
      41            2 :    mp_collect_timings = .FALSE.
      42            2 :    CALL rm_timer_env()
      43            2 :    CALL mp_world_finalize()
      44              : 
      45              : CONTAINS
      46              : 
      47              : ! **************************************************************************************************
      48              : !> \brief Exercise concurrent point-to-point communication on a shared communicator.
      49              : !> \param comm communicator shared by all OpenMP threads
      50              : ! **************************************************************************************************
      51            4 :    SUBROUTINE exercise_concurrent_point_to_point(comm)
      52              :       TYPE(mp_comm_type), INTENT(IN)                     :: comm
      53              : 
      54              :       INTEGER, PARAMETER                                 :: num_iterations = 128
      55              : 
      56              :       INTEGER                                            :: dest, expected, iter, nthreads, &
      57              :                                                             recv_value, send_value, source, tag, &
      58              :                                                             thread_id
      59              : 
      60            4 :       thread_id = omp_get_thread_num()
      61            4 :       nthreads = omp_get_num_threads()
      62            4 :       CPASSERT(nthreads == 2)
      63            4 :       CPASSERT(thread_id >= 0 .AND. thread_id < nthreads)
      64              : 
      65            4 :       dest = MODULO(comm%mepos + 1, comm%num_pe)
      66            4 :       source = MODULO(comm%mepos - 1, comm%num_pe)
      67              : 
      68          516 :       DO iter = 1, num_iterations
      69          512 :          tag = (iter - 1)*nthreads + thread_id
      70          512 :          send_value = (comm%num_pe*(iter - 1) + comm%mepos)*nthreads + thread_id
      71          512 :          CALL comm%sendrecv(send_value, dest, recv_value, source, tag=tag)
      72          512 :          expected = (comm%num_pe*(iter - 1) + source)*nthreads + thread_id
      73          516 :          CPASSERT(recv_value == expected)
      74              :       END DO
      75            4 :    END SUBROUTINE exercise_concurrent_point_to_point
      76              : 
      77              : END PROGRAM message_passing_thread_unittest