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 wrappers for the actual blacs calls.
      10             : !>      all functionality needed in the code should actually be provide by cp_blacs_env
      11             : !>      these functions should be private members of that module
      12             : !> \note
      13             : !>      http://www.netlib.org/blacs/BLACS/QRef.html
      14             : !> \par History
      15             : !>      12.2003 created [Joost]
      16             : !> \author Joost VandeVondele
      17             : ! **************************************************************************************************
      18             : MODULE cp_blacs_types
      19             : 
      20             : #if defined(__DLAF)
      21             :    USE cp_dlaf_utils_api, ONLY: cp_dlaf_create_grid, &
      22             :                                 cp_dlaf_free_grid
      23             : #endif
      24             :    USE kinds, ONLY: dp
      25             :    USE message_passing, ONLY: mp_comm_type
      26             : #include "../base/base_uses.f90"
      27             : 
      28             :    IMPLICIT NONE
      29             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_blacs_types'
      30             :    PRIVATE
      31             : 
      32             :    PUBLIC :: cp_blacs_type
      33             : 
      34             :    TYPE cp_blacs_type
      35             :       PRIVATE
      36             : #if defined(__parallel)
      37             :       INTEGER :: context_handle = -1
      38             : #endif
      39             :       INTEGER, DIMENSION(2), PUBLIC :: mepos = -1, num_pe = -1
      40             :    CONTAINS
      41             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: gridinit => cp_blacs_gridinit
      42             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: gridexit => cp_blacs_gridexit
      43             :       PROCEDURE, PRIVATE, PASS(this), NON_OVERRIDABLE :: gridinfo => cp_blacs_gridinfo
      44             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: set => cp_blacs_set
      45             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: zgebs2d => cp_blacs_zgebs2d
      46             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: dgebs2d => cp_blacs_dgebs2d
      47             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: zgebr2d => cp_blacs_zgebr2d
      48             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: dgebr2d => cp_blacs_dgebr2d
      49             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: get_handle => cp_blacs_get_handle
      50             : 
      51             :       PROCEDURE, PRIVATE, PASS(this), NON_OVERRIDABLE :: cp_context_is_equal
      52             :       GENERIC, PUBLIC :: OPERATOR(==) => cp_context_is_equal
      53             : 
      54             :       PROCEDURE, PRIVATE, PASS(this), NON_OVERRIDABLE :: cp_context_is_not_equal
      55             :       GENERIC, PUBLIC :: OPERATOR(/=) => cp_context_is_not_equal
      56             : 
      57             :       PROCEDURE, PUBLIC, PASS(this), NON_OVERRIDABLE :: interconnect => cp_blacs_interconnect
      58             :    END TYPE
      59             : 
      60             : !***
      61             : CONTAINS
      62             : 
      63             : ! **************************************************************************************************
      64             : !> \brief ...
      65             : !> \param this ...
      66             : !> \param comm ...
      67             : !> \param order ...
      68             : !> \param nprow ...
      69             : !> \param npcol ...
      70             : ! **************************************************************************************************
      71      175435 :    SUBROUTINE cp_blacs_gridinit(this, comm, order, nprow, npcol)
      72             :       CLASS(cp_blacs_type), INTENT(OUT) :: this
      73             :       CLASS(mp_comm_type), INTENT(IN) :: comm
      74             :       CHARACTER(len=1), INTENT(IN):: order
      75             :       INTEGER, INTENT(IN)    :: nprow, npcol
      76             : #if defined(__parallel)
      77             :       INTEGER :: context_handle
      78      175435 :       context_handle = comm%get_handle()
      79      175435 :       CALL blacs_gridinit(context_handle, order, nprow, npcol)
      80      175435 :       this%context_handle = context_handle
      81             : #if defined(__DLAF)
      82             :       CALL cp_dlaf_create_grid(context_handle)
      83             : #endif
      84             : #else
      85             :       MARK_USED(this)
      86             :       MARK_USED(comm)
      87             :       MARK_USED(order)
      88             :       MARK_USED(nprow)
      89             :       MARK_USED(npcol)
      90             : #endif
      91      175435 :       CALL this%gridinfo()
      92      175435 :    END SUBROUTINE cp_blacs_gridinit
      93             : 
      94             : ! **************************************************************************************************
      95             : !> \brief ...
      96             : !> \param this ...
      97             : ! **************************************************************************************************
      98      175435 :    SUBROUTINE cp_blacs_gridexit(this)
      99             :       CLASS(cp_blacs_type), INTENT(IN) :: this
     100             : #if defined(__parallel)
     101      175435 :       CALL blacs_gridexit(this%context_handle)
     102             : #if defined(__DLAF)
     103             :       CALL cp_dlaf_free_grid(this%context_handle)
     104             : #endif
     105             : #else
     106             :       MARK_USED(this)
     107             : #endif
     108      175435 :    END SUBROUTINE cp_blacs_gridexit
     109             : 
     110             : ! **************************************************************************************************
     111             : !> \brief ...
     112             : !> \param this ...
     113             : ! **************************************************************************************************
     114      175435 :    SUBROUTINE cp_blacs_gridinfo(this)
     115             :       CLASS(cp_blacs_type), INTENT(INOUT)  :: this
     116             : #if defined(__parallel)
     117      175435 :       CALL blacs_gridinfo(this%context_handle, this%num_pe(1), this%num_pe(2), this%mepos(1), this%mepos(2))
     118             : #else
     119             :       MARK_USED(this)
     120             :       this%num_pe = 1
     121             :       this%mepos = 0
     122             : #endif
     123      175435 :    END SUBROUTINE cp_blacs_gridinfo
     124             : 
     125             : ! **************************************************************************************************
     126             : !> \brief ...
     127             : !> \param this ...
     128             : !> \param what :
     129             : !>     WHAT = 0 : Handle indicating default system context;  ! DO NOT USE (i.e. use para_env)
     130             : !>     WHAT = 1 : The BLACS message ID range;
     131             : !>     WHAT = 2 : The BLACS debug level the library was compiled with;
     132             : !>     WHAT = 10: Handle indicating the system context used to define the BLACS context whose handle is ICONTXT;
     133             : !>     WHAT = 11: Number of rings multiring topology is presently using;
     134             : !>     WHAT = 12: Number of branches general tree topology is presently using.
     135             : !>     WHAT = 15: If non-zero, makes topology choice for repeatable collectives
     136             : !> \param val ...
     137             : ! **************************************************************************************************
     138         794 :    SUBROUTINE cp_blacs_set(this, what, val)
     139             :       CLASS(cp_blacs_type), INTENT(IN) :: this
     140             :       INTEGER, INTENT(IN)  :: what, val
     141             : #if defined(__parallel)
     142         794 :       CALL blacs_set(this%context_handle, what, val)
     143             : #else
     144             :       MARK_USED(this)
     145             :       MARK_USED(what)
     146             :       MARK_USED(val)
     147             : #endif
     148         794 :    END SUBROUTINE cp_blacs_set
     149             : 
     150             : ! **************************************************************************************************
     151             : !> \brief ...
     152             : !> \param this ...
     153             : !> \param SCOPE ...
     154             : !> \param TOP ...
     155             : !> \param M ...
     156             : !> \param N ...
     157             : !> \param A ...
     158             : !> \param LDA ...
     159             : ! **************************************************************************************************
     160        4689 :    SUBROUTINE cp_blacs_zgebs2d(this, SCOPE, TOP, M, N, A, LDA)
     161             :       CLASS(cp_blacs_type), INTENT(IN)     :: this
     162             :       CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
     163             :       INTEGER, INTENT(IN)     :: M, N, LDA
     164             :       COMPLEX(KIND=dp)            :: A
     165             : #if defined(__parallel)
     166        4689 :       CALL zgebs2d(this%context_handle, SCOPE, TOP, M, N, A, LDA)
     167             : #else
     168             :       MARK_USED(this)
     169             :       MARK_USED(SCOPE)
     170             :       MARK_USED(TOP)
     171             :       MARK_USED(M)
     172             :       MARK_USED(N)
     173             :       MARK_USED(A)
     174             :       MARK_USED(LDA)
     175             : #endif
     176        4689 :    END SUBROUTINE
     177             : ! **************************************************************************************************
     178             : !> \brief ...
     179             : !> \param this ...
     180             : !> \param SCOPE ...
     181             : !> \param TOP ...
     182             : !> \param M ...
     183             : !> \param N ...
     184             : !> \param A ...
     185             : !> \param LDA ...
     186             : !> \param RSRC ...
     187             : !> \param CSRC ...
     188             : ! **************************************************************************************************
     189        4689 :    SUBROUTINE cp_blacs_zgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
     190             :       CLASS(cp_blacs_type), INTENT(IN)     :: this
     191             :       CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
     192             :       INTEGER, INTENT(IN)     :: M, N, LDA
     193             :       INTEGER, INTENT(IN)     :: RSRC, CSRC
     194             :       COMPLEX(KIND=dp)            :: A
     195             : #if defined(__parallel)
     196        4689 :       CALL zgebr2d(this%context_handle, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
     197             : #else
     198             :       MARK_USED(this)
     199             :       MARK_USED(SCOPE)
     200             :       MARK_USED(TOP)
     201             :       MARK_USED(M)
     202             :       MARK_USED(N)
     203             :       MARK_USED(A)
     204             :       MARK_USED(LDA)
     205             :       MARK_USED(RSRC)
     206             :       MARK_USED(CSRC)
     207             : #endif
     208        4689 :    END SUBROUTINE
     209             : 
     210             : ! **************************************************************************************************
     211             : !> \brief ...
     212             : !> \param this ...
     213             : !> \param SCOPE ...
     214             : !> \param TOP ...
     215             : !> \param M ...
     216             : !> \param N ...
     217             : !> \param A ...
     218             : !> \param LDA ...
     219             : ! **************************************************************************************************
     220     1237318 :    SUBROUTINE cp_blacs_dgebs2d(this, SCOPE, TOP, M, N, A, LDA)
     221             :       CLASS(cp_blacs_type), INTENT(IN)     :: this
     222             :       CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
     223             :       INTEGER, INTENT(IN)     :: M, N, LDA
     224             :       REAL(KIND=dp)               :: A
     225             : #if defined(__parallel)
     226     1237318 :       CALL dgebs2d(this%context_handle, SCOPE, TOP, M, N, A, LDA)
     227             : #else
     228             :       MARK_USED(this)
     229             :       MARK_USED(SCOPE)
     230             :       MARK_USED(TOP)
     231             :       MARK_USED(M)
     232             :       MARK_USED(N)
     233             :       MARK_USED(A)
     234             :       MARK_USED(LDA)
     235             : #endif
     236     1237318 :    END SUBROUTINE
     237             : ! **************************************************************************************************
     238             : !> \brief ...
     239             : !> \param this ...
     240             : !> \param SCOPE ...
     241             : !> \param TOP ...
     242             : !> \param M ...
     243             : !> \param N ...
     244             : !> \param A ...
     245             : !> \param LDA ...
     246             : !> \param RSRC ...
     247             : !> \param CSRC ...
     248             : ! **************************************************************************************************
     249     1237318 :    SUBROUTINE cp_blacs_dgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
     250             :       CLASS(cp_blacs_type), INTENT(IN)     :: this
     251             :       CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
     252             :       INTEGER, INTENT(IN)     :: M, N, LDA
     253             :       INTEGER, INTENT(IN)     :: RSRC, CSRC
     254             :       REAL(KIND=dp)               :: A
     255             : #if defined(__parallel)
     256     1237318 :       CALL dgebr2d(this%context_handle, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
     257             : #else
     258             :       MARK_USED(this)
     259             :       MARK_USED(SCOPE)
     260             :       MARK_USED(TOP)
     261             :       MARK_USED(M)
     262             :       MARK_USED(N)
     263             :       MARK_USED(A)
     264             :       MARK_USED(LDA)
     265             :       MARK_USED(RSRC)
     266             :       MARK_USED(CSRC)
     267             : #endif
     268     1237318 :    END SUBROUTINE
     269             : 
     270             : ! **************************************************************************************************
     271             : !> \brief ...
     272             : !> \param this ...
     273             : !> \return ...
     274             : ! **************************************************************************************************
     275      169706 :    ELEMENTAL INTEGER FUNCTION cp_blacs_get_handle(this)
     276             :       CLASS(cp_blacs_type), INTENT(IN) :: this
     277             : #if defined(__parallel)
     278      169706 :       cp_blacs_get_handle = this%context_handle
     279             : #else
     280             :       MARK_USED(this)
     281             :       cp_blacs_get_handle = -1
     282             : #endif
     283      169706 :    END FUNCTION
     284             : 
     285             : ! **************************************************************************************************
     286             : !> \brief ...
     287             : !> \param this ...
     288             : !> \param other ...
     289             : !> \return ...
     290             : ! **************************************************************************************************
     291      460431 :    ELEMENTAL LOGICAL FUNCTION cp_context_is_equal(this, other)
     292             :       CLASS(cp_blacs_type), INTENT(IN) :: this, other
     293             : #if defined(__parallel)
     294      460431 :       cp_context_is_equal = (this%context_handle == other%context_handle)
     295             : #else
     296             :       MARK_USED(this)
     297             :       MARK_USED(other)
     298             :       cp_context_is_equal = .TRUE.
     299             : #endif
     300      460431 :    END FUNCTION cp_context_is_equal
     301             : 
     302             : ! **************************************************************************************************
     303             : !> \brief ...
     304             : !> \param this ...
     305             : !> \param other ...
     306             : !> \return ...
     307             : ! **************************************************************************************************
     308     1410838 :    ELEMENTAL LOGICAL FUNCTION cp_context_is_not_equal(this, other)
     309             :       CLASS(cp_blacs_type), INTENT(IN) :: this, other
     310             : #if defined(__parallel)
     311     1410838 :       cp_context_is_not_equal = (this%context_handle /= other%context_handle)
     312             : #else
     313             :       MARK_USED(this)
     314             :       MARK_USED(other)
     315             :       cp_context_is_not_equal = .FALSE.
     316             : #endif
     317     1410838 :    END FUNCTION cp_context_is_not_equal
     318             : 
     319             : ! **************************************************************************************************
     320             : !> \brief ...
     321             : !> \param this ...
     322             : !> \param comm_super ...
     323             : !> \return ...
     324             : ! **************************************************************************************************
     325         934 :    TYPE(mp_comm_type) FUNCTION cp_blacs_interconnect(this, comm_super)
     326             :       CLASS(cp_blacs_type), INTENT(IN) :: this
     327             :       CLASS(mp_comm_type), INTENT(IN) :: comm_super
     328             : 
     329             :       INTEGER :: blacs_coord
     330             : 
     331             : ! We enumerate the processes within the process grid in a linear fashion
     332         934 :       blacs_coord = this%mepos(1)*this%num_pe(2) + this%mepos(2)
     333             : 
     334         934 :       CALL cp_blacs_interconnect%from_split(comm_super, blacs_coord)
     335             : 
     336         934 :    END FUNCTION cp_blacs_interconnect
     337             : 
     338           0 : END MODULE cp_blacs_types