Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief Defines all routines to deal with the performance of MPI routines
      10             : ! **************************************************************************************************
      11             : MODULE mp_perf_env
      12             :    ! performance gathering
      13             :    USE kinds,                           ONLY: dp
      14             : #include "../base/base_uses.f90"
      15             : 
      16             :    PRIVATE
      17             : 
      18             :    PUBLIC :: mp_perf_env_type
      19             :    PUBLIC :: mp_perf_env_retain, mp_perf_env_release
      20             :    PUBLIC :: add_mp_perf_env, rm_mp_perf_env, get_mp_perf_env, describe_mp_perf_env
      21             :    PUBLIC :: add_perf
      22             : 
      23             :    TYPE mp_perf_type
      24             :       CHARACTER(LEN=20) :: name = ""
      25             :       INTEGER :: count = 0
      26             :       REAL(KIND=dp) :: msg_size = 0.0_dp
      27             :    END TYPE mp_perf_type
      28             : 
      29             :    INTEGER, PARAMETER :: MAX_PERF = 28
      30             : 
      31             : ! **************************************************************************************************
      32             :    TYPE mp_perf_env_type
      33             :       PRIVATE
      34             :       INTEGER :: ref_count = -1
      35             :       TYPE(mp_perf_type), DIMENSION(MAX_PERF) :: mp_perfs = mp_perf_type()
      36             :    CONTAINS
      37             :       PROCEDURE, PUBLIC, PASS(perf_env), NON_OVERRIDABLE :: retain => mp_perf_env_retain
      38             :    END TYPE mp_perf_env_type
      39             : 
      40             : ! **************************************************************************************************
      41             :    TYPE mp_perf_env_p_type
      42             :       TYPE(mp_perf_env_type), POINTER         :: mp_perf_env => Null()
      43             :    END TYPE mp_perf_env_p_type
      44             : 
      45             :    ! introduce a stack of mp_perfs, first index is the stack pointer, for convenience is replacing
      46             :    INTEGER, PARAMETER :: max_stack_size = 10
      47             :    INTEGER            :: stack_pointer = 0
      48             :    TYPE(mp_perf_env_p_type), DIMENSION(max_stack_size), SAVE :: mp_perf_stack
      49             : 
      50             :    CHARACTER(LEN=20), PARAMETER :: sname(MAX_PERF) = &
      51             :                                    (/"MP_Group            ", "MP_Bcast            ", "MP_Allreduce        ", &
      52             :                                      "MP_Gather           ", "MP_Sync             ", "MP_Alltoall         ", &
      53             :                                      "MP_SendRecv         ", "MP_ISendRecv        ", "MP_Wait             ", &
      54             :                                      "MP_comm_split       ", "MP_ISend            ", "MP_IRecv            ", &
      55             :                                      "MP_Send             ", "MP_Recv             ", "MP_Memory           ", &
      56             :                                      "MP_Put              ", "MP_Get              ", "MP_Fence            ", &
      57             :                                      "MP_Win_Lock         ", "MP_Win_Create       ", "MP_Win_Free         ", &
      58             :                                      "MP_IBcast           ", "MP_IAllreduce       ", "MP_IScatter         ", &
      59             :                                      "MP_RGet             ", "MP_Isync            ", "MP_Read_All         ", &
      60             :                                      "MP_Write_All        "/)
      61             : 
      62             : CONTAINS
      63             : 
      64             : ! **************************************************************************************************
      65             : !> \brief start and stop the performance indicators
      66             : !>      for every call to start there has to be (exactly) one call to stop
      67             : !> \param perf_env ...
      68             : !> \par History
      69             : !>      2.2004 created [Joost VandeVondele]
      70             : !> \note
      71             : !>      can be used to measure performance of a sub-part of a program.
      72             : !>      timings measured here will not show up in the outer start/stops
      73             : !>      Doesn't need a fresh communicator
      74             : ! **************************************************************************************************
      75      115957 :    SUBROUTINE add_mp_perf_env(perf_env)
      76             :       TYPE(mp_perf_env_type), OPTIONAL, POINTER          :: perf_env
      77             : 
      78      115957 :       stack_pointer = stack_pointer + 1
      79      115957 :       IF (stack_pointer > max_stack_size) THEN
      80           0 :          CPABORT("stack_pointer too large : message_passing @ add_mp_perf_env")
      81             :       END IF
      82      115957 :       NULLIFY (mp_perf_stack(stack_pointer)%mp_perf_env)
      83      115957 :       IF (PRESENT(perf_env)) THEN
      84       89764 :          mp_perf_stack(stack_pointer)%mp_perf_env => perf_env
      85       89764 :          IF (ASSOCIATED(perf_env)) CALL mp_perf_env_retain(perf_env)
      86             :       END IF
      87      115957 :       IF (.NOT. ASSOCIATED(mp_perf_stack(stack_pointer)%mp_perf_env)) THEN
      88       26193 :          CALL mp_perf_env_create(mp_perf_stack(stack_pointer)%mp_perf_env)
      89             :       END IF
      90      115957 :    END SUBROUTINE add_mp_perf_env
      91             : 
      92             : ! **************************************************************************************************
      93             : !> \brief ...
      94             : !> \param perf_env ...
      95             : ! **************************************************************************************************
      96       26193 :    SUBROUTINE mp_perf_env_create(perf_env)
      97             :       TYPE(mp_perf_env_type), OPTIONAL, POINTER          :: perf_env
      98             : 
      99             :       INTEGER                                            :: i
     100             : 
     101             :       NULLIFY (perf_env)
     102      759597 :       ALLOCATE (perf_env)
     103       26193 :       perf_env%ref_count = 1
     104      759597 :       DO i = 1, MAX_PERF
     105      759597 :          perf_env%mp_perfs(i)%name = sname(i)
     106             :       END DO
     107             : 
     108       26193 :    END SUBROUTINE mp_perf_env_create
     109             : 
     110             : ! **************************************************************************************************
     111             : !> \brief ...
     112             : !> \param perf_env ...
     113             : ! **************************************************************************************************
     114      124564 :    SUBROUTINE mp_perf_env_release(perf_env)
     115             :       TYPE(mp_perf_env_type), POINTER                    :: perf_env
     116             : 
     117      124564 :       IF (ASSOCIATED(perf_env)) THEN
     118      124564 :          IF (perf_env%ref_count < 1) THEN
     119           0 :             CPABORT("invalid ref_count: message_passing @ mp_perf_env_release")
     120             :          END IF
     121      124564 :          perf_env%ref_count = perf_env%ref_count - 1
     122      124564 :          IF (perf_env%ref_count == 0) THEN
     123       26193 :             DEALLOCATE (perf_env)
     124             :          END IF
     125             :       END IF
     126      124564 :       NULLIFY (perf_env)
     127      124564 :    END SUBROUTINE mp_perf_env_release
     128             : 
     129             : ! **************************************************************************************************
     130             : !> \brief ...
     131             : !> \param perf_env ...
     132             : ! **************************************************************************************************
     133       98371 :    ELEMENTAL SUBROUTINE mp_perf_env_retain(perf_env)
     134             :       CLASS(mp_perf_env_type), INTENT(INOUT)                    :: perf_env
     135             : 
     136       98371 :       perf_env%ref_count = perf_env%ref_count + 1
     137       98371 :    END SUBROUTINE mp_perf_env_retain
     138             : 
     139             : !.. reports the performance counters for the MPI run
     140             : ! **************************************************************************************************
     141             : !> \brief ...
     142             : !> \param perf_env ...
     143             : !> \param iw ...
     144             : ! **************************************************************************************************
     145        9127 :    SUBROUTINE mp_perf_env_describe(perf_env, iw)
     146             :       TYPE(mp_perf_env_type), INTENT(IN)       :: perf_env
     147             :       INTEGER, INTENT(IN)                      :: iw
     148             : 
     149             : #if defined(__parallel)
     150             :       INTEGER                                  :: i
     151             :       REAL(KIND=dp)                            :: vol
     152             : #endif
     153             : 
     154        9127 :       IF (perf_env%ref_count < 1) THEN
     155           0 :          CPABORT("invalid perf_env%ref_count : message_passing @ mp_perf_env_describe")
     156             :       END IF
     157             : #if defined(__parallel)
     158        9127 :       IF (iw > 0) THEN
     159        4667 :          WRITE (iw, '( /, 1X, 79("-") )')
     160        4667 :          WRITE (iw, '( " -", 77X, "-" )')
     161        4667 :          WRITE (iw, '( " -", 24X, A, 24X, "-" )') ' MESSAGE PASSING PERFORMANCE '
     162        4667 :          WRITE (iw, '( " -", 77X, "-" )')
     163        4667 :          WRITE (iw, '( 1X, 79("-"), / )')
     164        4667 :          WRITE (iw, '( A, A, A )') ' ROUTINE', '             CALLS ', &
     165        9334 :             '     AVE VOLUME [Bytes]'
     166      135343 :          DO i = 1, MAX_PERF
     167             : 
     168      135343 :             IF (perf_env%mp_perfs(i)%count > 0) THEN
     169       32709 :                vol = perf_env%mp_perfs(i)%msg_size/REAL(perf_env%mp_perfs(i)%count, KIND=dp)
     170       32709 :                IF (vol < 1.0_dp) THEN
     171             :                   WRITE (iw, '(1X,A15,T17,I10)') &
     172       13807 :                      ADJUSTL(perf_env%mp_perfs(i)%name), perf_env%mp_perfs(i)%count
     173             :                ELSE
     174             :                   WRITE (iw, '(1X,A15,T17,I10,T40,F11.0)') &
     175       18902 :                      ADJUSTL(perf_env%mp_perfs(i)%name), perf_env%mp_perfs(i)%count, &
     176       37804 :                      vol
     177             :                END IF
     178             :             END IF
     179             : 
     180             :          END DO
     181        4667 :          WRITE (iw, '( 1X, 79("-"), / )')
     182             :       END IF
     183             : #else
     184             :       MARK_USED(iw)
     185             : #endif
     186        9127 :    END SUBROUTINE mp_perf_env_describe
     187             : 
     188             : ! **************************************************************************************************
     189             : !> \brief ...
     190             : ! **************************************************************************************************
     191      115957 :    SUBROUTINE rm_mp_perf_env()
     192      115957 :       IF (stack_pointer < 1) THEN
     193           0 :          CPABORT("no perf_env in the stack : message_passing @ rm_mp_perf_env")
     194             :       END IF
     195      115957 :       CALL mp_perf_env_release(mp_perf_stack(stack_pointer)%mp_perf_env)
     196      115957 :       stack_pointer = stack_pointer - 1
     197      115957 :    END SUBROUTINE rm_mp_perf_env
     198             : 
     199             : ! **************************************************************************************************
     200             : !> \brief ...
     201             : !> \return ...
     202             : ! **************************************************************************************************
     203      107498 :    FUNCTION get_mp_perf_env() RESULT(res)
     204             :       TYPE(mp_perf_env_type), POINTER                    :: res
     205             : 
     206      107498 :       IF (stack_pointer < 1) THEN
     207           0 :          CPABORT("no perf_env in the stack : message_passing @ get_mp_perf_env")
     208             :       END IF
     209      107498 :       res => mp_perf_stack(stack_pointer)%mp_perf_env
     210      107498 :    END FUNCTION get_mp_perf_env
     211             : 
     212             : ! **************************************************************************************************
     213             : !> \brief ...
     214             : !> \param scr ...
     215             : ! **************************************************************************************************
     216        9127 :    SUBROUTINE describe_mp_perf_env(scr)
     217             :       INTEGER, INTENT(in)                                :: scr
     218             : 
     219             :       TYPE(mp_perf_env_type), POINTER                    :: perf_env
     220             : 
     221        9127 :       perf_env => get_mp_perf_env()
     222        9127 :       CALL mp_perf_env_describe(perf_env, scr)
     223        9127 :    END SUBROUTINE describe_mp_perf_env
     224             : 
     225             : ! **************************************************************************************************
     226             : !> \brief adds the performance informations of one call
     227             : !> \param perf_id ...
     228             : !> \param count ...
     229             : !> \param msg_size ...
     230             : !> \author fawzi
     231             : ! **************************************************************************************************
     232    80951504 :    SUBROUTINE add_perf(perf_id, count, msg_size)
     233             :       INTEGER, INTENT(in)                      :: perf_id
     234             :       INTEGER, INTENT(in), OPTIONAL            :: count
     235             :       INTEGER, INTENT(in), OPTIONAL            :: msg_size
     236             : 
     237             : #if defined(__parallel)
     238             :       TYPE(mp_perf_type), POINTER              :: mp_perf
     239             : 
     240    80951504 :       IF (.NOT. ASSOCIATED(mp_perf_stack(stack_pointer)%mp_perf_env)) RETURN
     241             : 
     242    80951504 :       mp_perf => mp_perf_stack(stack_pointer)%mp_perf_env%mp_perfs(perf_id)
     243    80951504 :       IF (PRESENT(count)) THEN
     244    80951504 :          mp_perf%count = mp_perf%count + count
     245             :       END IF
     246    80951504 :       IF (PRESENT(msg_size)) THEN
     247    73119152 :          mp_perf%msg_size = mp_perf%msg_size + REAL(msg_size, dp)
     248             :       END IF
     249             : #else
     250             :       MARK_USED(perf_id)
     251             :       MARK_USED(count)
     252             :       MARK_USED(msg_size)
     253             : #endif
     254             : 
     255             :    END SUBROUTINE add_perf
     256             : 
     257           0 : END MODULE mp_perf_env