Line data    Source code

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