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(__SCALAPACK)
      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      173834 :    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(__SCALAPACK)
      77             :       INTEGER :: context_handle
      78      173834 :       context_handle = comm%get_handle()
      79      173834 :       CALL blacs_gridinit(context_handle, order, nprow, npcol)
      80      173834 :       this%context_handle = context_handle
      81             : 
      82             : #if defined(__DLAF)
      83             :       CALL cp_dlaf_create_grid(context_handle)
      84             : #endif
      85             : #else
      86             :       MARK_USED(this)
      87             :       MARK_USED(comm)
      88             :       MARK_USED(order)
      89             :       MARK_USED(nprow)
      90             :       MARK_USED(npcol)
      91             : #endif
      92      173834 :       CALL this%gridinfo()
      93      173834 :    END SUBROUTINE cp_blacs_gridinit
      94             : 
      95             : ! **************************************************************************************************
      96             : !> \brief ...
      97             : !> \param this ...
      98             : ! **************************************************************************************************
      99      173834 :    SUBROUTINE cp_blacs_gridexit(this)
     100             :       CLASS(cp_blacs_type), INTENT(IN) :: this
     101             : #if defined(__SCALAPACK)
     102      173834 :       CALL blacs_gridexit(this%context_handle)
     103             : 
     104             : #if defined(__DLAF)
     105             :       CALL cp_dlaf_free_grid(this%context_handle)
     106             : #endif
     107             : #else
     108             :       MARK_USED(this)
     109             : #endif
     110      173834 :    END SUBROUTINE cp_blacs_gridexit
     111             : 
     112             : ! **************************************************************************************************
     113             : !> \brief ...
     114             : !> \param this ...
     115             : ! **************************************************************************************************
     116      173834 :    SUBROUTINE cp_blacs_gridinfo(this)
     117             :       CLASS(cp_blacs_type), INTENT(INOUT)  :: this
     118             : #if defined(__SCALAPACK)
     119      173834 :       CALL blacs_gridinfo(this%context_handle, this%num_pe(1), this%num_pe(2), this%mepos(1), this%mepos(2))
     120             : #else
     121             :       MARK_USED(this)
     122             :       this%num_pe = 1
     123             :       this%mepos = 0
     124             : #endif
     125      173834 :    END SUBROUTINE cp_blacs_gridinfo
     126             : 
     127             : ! **************************************************************************************************
     128             : !> \brief ...
     129             : !> \param this ...
     130             : !> \param what :
     131             : !>     WHAT = 0 : Handle indicating default system context;  ! DO NOT USE (i.e. use para_env)
     132             : !>     WHAT = 1 : The BLACS message ID range;
     133             : !>     WHAT = 2 : The BLACS debug level the library was compiled with;
     134             : !>     WHAT = 10: Handle indicating the system context used to define the BLACS context whose handle is ICONTXT;
     135             : !>     WHAT = 11: Number of rings multiring topology is presently using;
     136             : !>     WHAT = 12: Number of branches general tree topology is presently using.
     137             : !>     WHAT = 15: If non-zero, makes topology choice for repeatable collectives
     138             : !> \param val ...
     139             : ! **************************************************************************************************
     140         740 :    SUBROUTINE cp_blacs_set(this, what, val)
     141             :       CLASS(cp_blacs_type), INTENT(IN) :: this
     142             :       INTEGER, INTENT(IN)  :: what, val
     143             : #if defined(__SCALAPACK)
     144         740 :       CALL blacs_set(this%context_handle, what, val)
     145             : #else
     146             :       MARK_USED(this)
     147             :       MARK_USED(what)
     148             :       MARK_USED(val)
     149             : #endif
     150         740 :    END SUBROUTINE cp_blacs_set
     151             : 
     152             : ! **************************************************************************************************
     153             : !> \brief ...
     154             : !> \param this ...
     155             : !> \param SCOPE ...
     156             : !> \param TOP ...
     157             : !> \param M ...
     158             : !> \param N ...
     159             : !> \param A ...
     160             : !> \param LDA ...
     161             : ! **************************************************************************************************
     162        4689 :    SUBROUTINE cp_blacs_zgebs2d(this, SCOPE, TOP, M, N, A, LDA)
     163             :       CLASS(cp_blacs_type), INTENT(IN)     :: this
     164             :       CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
     165             :       INTEGER, INTENT(IN)     :: M, N, LDA
     166             :       COMPLEX(KIND=dp)            :: A
     167             : #if defined(__SCALAPACK)
     168        4689 :       CALL zgebs2d(this%context_handle, SCOPE, TOP, M, N, A, LDA)
     169             : #else
     170             :       MARK_USED(this)
     171             :       MARK_USED(SCOPE)
     172             :       MARK_USED(TOP)
     173             :       MARK_USED(M)
     174             :       MARK_USED(N)
     175             :       MARK_USED(A)
     176             :       MARK_USED(LDA)
     177             : #endif
     178        4689 :    END SUBROUTINE
     179             : ! **************************************************************************************************
     180             : !> \brief ...
     181             : !> \param this ...
     182             : !> \param SCOPE ...
     183             : !> \param TOP ...
     184             : !> \param M ...
     185             : !> \param N ...
     186             : !> \param A ...
     187             : !> \param LDA ...
     188             : !> \param RSRC ...
     189             : !> \param CSRC ...
     190             : ! **************************************************************************************************
     191        4689 :    SUBROUTINE cp_blacs_zgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
     192             :       CLASS(cp_blacs_type), INTENT(IN)     :: this
     193             :       CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
     194             :       INTEGER, INTENT(IN)     :: M, N, LDA
     195             :       INTEGER, INTENT(IN)     :: RSRC, CSRC
     196             :       COMPLEX(KIND=dp)            :: A
     197             : #if defined(__SCALAPACK)
     198        4689 :       CALL zgebr2d(this%context_handle, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
     199             : #else
     200             :       MARK_USED(this)
     201             :       MARK_USED(SCOPE)
     202             :       MARK_USED(TOP)
     203             :       MARK_USED(M)
     204             :       MARK_USED(N)
     205             :       MARK_USED(A)
     206             :       MARK_USED(LDA)
     207             :       MARK_USED(RSRC)
     208             :       MARK_USED(CSRC)
     209             : #endif
     210        4689 :    END SUBROUTINE
     211             : 
     212             : ! **************************************************************************************************
     213             : !> \brief ...
     214             : !> \param this ...
     215             : !> \param SCOPE ...
     216             : !> \param TOP ...
     217             : !> \param M ...
     218             : !> \param N ...
     219             : !> \param A ...
     220             : !> \param LDA ...
     221             : ! **************************************************************************************************
     222     1275878 :    SUBROUTINE cp_blacs_dgebs2d(this, SCOPE, TOP, M, N, A, LDA)
     223             :       CLASS(cp_blacs_type), INTENT(IN)     :: this
     224             :       CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
     225             :       INTEGER, INTENT(IN)     :: M, N, LDA
     226             :       REAL(KIND=dp)               :: A
     227             : #if defined(__SCALAPACK)
     228     1275878 :       CALL dgebs2d(this%context_handle, SCOPE, TOP, M, N, A, LDA)
     229             : #else
     230             :       MARK_USED(this)
     231             :       MARK_USED(SCOPE)
     232             :       MARK_USED(TOP)
     233             :       MARK_USED(M)
     234             :       MARK_USED(N)
     235             :       MARK_USED(A)
     236             :       MARK_USED(LDA)
     237             : #endif
     238     1275878 :    END SUBROUTINE
     239             : ! **************************************************************************************************
     240             : !> \brief ...
     241             : !> \param this ...
     242             : !> \param SCOPE ...
     243             : !> \param TOP ...
     244             : !> \param M ...
     245             : !> \param N ...
     246             : !> \param A ...
     247             : !> \param LDA ...
     248             : !> \param RSRC ...
     249             : !> \param CSRC ...
     250             : ! **************************************************************************************************
     251     1275878 :    SUBROUTINE cp_blacs_dgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
     252             :       CLASS(cp_blacs_type), INTENT(IN)     :: this
     253             :       CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
     254             :       INTEGER, INTENT(IN)     :: M, N, LDA
     255             :       INTEGER, INTENT(IN)     :: RSRC, CSRC
     256             :       REAL(KIND=dp)               :: A
     257             : #if defined(__SCALAPACK)
     258     1275878 :       CALL dgebr2d(this%context_handle, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
     259             : #else
     260             :       MARK_USED(this)
     261             :       MARK_USED(SCOPE)
     262             :       MARK_USED(TOP)
     263             :       MARK_USED(M)
     264             :       MARK_USED(N)
     265             :       MARK_USED(A)
     266             :       MARK_USED(LDA)
     267             :       MARK_USED(RSRC)
     268             :       MARK_USED(CSRC)
     269             : #endif
     270     1275878 :    END SUBROUTINE
     271             : 
     272             : ! **************************************************************************************************
     273             : !> \brief ...
     274             : !> \param this ...
     275             : !> \return ...
     276             : ! **************************************************************************************************
     277      159042 :    ELEMENTAL INTEGER FUNCTION cp_blacs_get_handle(this)
     278             :       CLASS(cp_blacs_type), INTENT(IN) :: this
     279             : #if defined(__SCALAPACK)
     280      159042 :       cp_blacs_get_handle = this%context_handle
     281             : #else
     282             :       MARK_USED(this)
     283             :       cp_blacs_get_handle = -1
     284             : #endif
     285      159042 :    END FUNCTION
     286             : 
     287             : ! **************************************************************************************************
     288             : !> \brief ...
     289             : !> \param this ...
     290             : !> \param other ...
     291             : !> \return ...
     292             : ! **************************************************************************************************
     293      463631 :    ELEMENTAL LOGICAL FUNCTION cp_context_is_equal(this, other)
     294             :       CLASS(cp_blacs_type), INTENT(IN) :: this, other
     295             : #if defined(__SCALAPACK)
     296      463631 :       cp_context_is_equal = (this%context_handle == other%context_handle)
     297             : #else
     298             :       MARK_USED(this)
     299             :       MARK_USED(other)
     300             :       cp_context_is_equal = .TRUE.
     301             : #endif
     302      463631 :    END FUNCTION cp_context_is_equal
     303             : 
     304             : ! **************************************************************************************************
     305             : !> \brief ...
     306             : !> \param this ...
     307             : !> \param other ...
     308             : !> \return ...
     309             : ! **************************************************************************************************
     310     1368820 :    ELEMENTAL LOGICAL FUNCTION cp_context_is_not_equal(this, other)
     311             :       CLASS(cp_blacs_type), INTENT(IN) :: this, other
     312             : #if defined(__SCALAPACK)
     313     1368820 :       cp_context_is_not_equal = (this%context_handle /= other%context_handle)
     314             : #else
     315             :       MARK_USED(this)
     316             :       MARK_USED(other)
     317             :       cp_context_is_not_equal = .FALSE.
     318             : #endif
     319     1368820 :    END FUNCTION cp_context_is_not_equal
     320             : 
     321             : ! **************************************************************************************************
     322             : !> \brief ...
     323             : !> \param this ...
     324             : !> \param comm_super ...
     325             : !> \return ...
     326             : ! **************************************************************************************************
     327         854 :    TYPE(mp_comm_type) FUNCTION cp_blacs_interconnect(this, comm_super)
     328             :       CLASS(cp_blacs_type), INTENT(IN) :: this
     329             :       CLASS(mp_comm_type), INTENT(IN) :: comm_super
     330             : 
     331             :       INTEGER :: blacs_coord
     332             : 
     333             : ! We enumerate the processes within the process grid in a linear fashion
     334         854 :       blacs_coord = this%mepos(1)*this%num_pe(2) + this%mepos(2)
     335             : 
     336         854 :       CALL cp_blacs_interconnect%from_split(comm_super, blacs_coord)
     337             : 
     338         854 :    END FUNCTION cp_blacs_interconnect
     339             : 
     340           0 : END MODULE cp_blacs_types