1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2020 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief methods related to the blacs parallel environment 8!> \par History 9!> 08.2002 created [fawzi] 10!> 02.2004 modified to associate a blacs_env with a given para_env 11!> \author Fawzi Mohamed 12! ************************************************************************************************** 13MODULE cp_blacs_env 14 USE cp_array_utils, ONLY: cp_2d_i_write 15 USE cp_blacs_calls, ONLY: cp_blacs_gridexit,& 16 cp_blacs_gridinfo,& 17 cp_blacs_gridinit,& 18 cp_blacs_set 19 USE cp_para_env, ONLY: cp_para_env_release,& 20 cp_para_env_retain 21 USE cp_para_types, ONLY: cp_para_env_type 22 USE kinds, ONLY: dp 23 USE machine, ONLY: m_flush 24 USE mathlib, ONLY: gcd 25 USE message_passing, ONLY: mp_sum 26#include "../base/base_uses.f90" 27 28 IMPLICIT NONE 29 PRIVATE 30 31 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE. 32 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_blacs_env' 33 34 ! Blacs type of distribution 35 INTEGER, PARAMETER, PUBLIC :: BLACS_GRID_SQUARE = 1, & 36 BLACS_GRID_ROW = 2, & 37 BLACS_GRID_COL = 3 38 39 PUBLIC :: cp_blacs_env_type ! make it accessible only through cp_para_types? 40 PUBLIC :: cp_blacs_env_create, cp_blacs_env_retain, cp_blacs_env_release 41 PUBLIC :: cp_blacs_env_write, get_blacs_info 42 43! ************************************************************************************************** 44!> \brief represent a blacs multidimensional parallel environment 45!> (for the mpi corrispective see cp_paratypes/cp_para_cart_type) 46!> \param mepos the position of the actual processor (2D) 47!> \param group id of the actual group (context, communicator) 48!> \param num_pe number of processors in the group in each dimension 49!> \param ref_count the reference count, when it is zero this object gets 50!> deallocated 51!> \param my_pid process id of the actual processor 52!> \param n_pid number of process ids 53!> \param the para_env associated (and compatible) with this blacs_env 54!> \param blacs2mpi: maps mepos(1)-mepos(2) of blacs to its mpi rank 55!> \param mpi2blacs(i,rank): maps the mpi rank to the mepos(i) 56!> \par History 57!> 08.2002 created [fawzi] 58!> \author Fawzi Mohamed 59! ************************************************************************************************** 60 TYPE cp_blacs_env_type 61 INTEGER, DIMENSION(2) :: mepos, num_pe 62 INTEGER :: group, my_pid, n_pid, ref_count 63 TYPE(cp_para_env_type), POINTER :: para_env 64 INTEGER, DIMENSION(:, :), POINTER :: blacs2mpi 65 INTEGER, DIMENSION(:, :), POINTER :: mpi2blacs 66 LOGICAL :: repeatable 67 END TYPE cp_blacs_env_type 68 69!*** 70CONTAINS 71 72! ************************************************************************************************** 73!> \brief Return informations about the specified BLACS context. 74!> \param blacs_env ... 75!> \param my_process_row ... 76!> \param my_process_column ... 77!> \param my_process_number ... 78!> \param number_of_process_rows ... 79!> \param number_of_process_columns ... 80!> \param number_of_processes ... 81!> \param para_env ... 82!> \param blacs2mpi ... 83!> \param mpi2blacs ... 84!> \date 19.06.2001 85!> \par History 86!> MM.YYYY moved here from qs_blacs (Joost VandeVondele) 87!> \author Matthias Krack 88!> \version 1.0 89! ************************************************************************************************** 90 SUBROUTINE get_blacs_info(blacs_env, my_process_row, my_process_column, & 91 my_process_number, number_of_process_rows, & 92 number_of_process_columns, number_of_processes, & 93 para_env, blacs2mpi, mpi2blacs) 94 TYPE(cp_blacs_env_type), POINTER :: blacs_env 95 INTEGER, INTENT(OUT), OPTIONAL :: my_process_row, my_process_column, my_process_number, & 96 number_of_process_rows, number_of_process_columns, number_of_processes 97 TYPE(cp_para_env_type), OPTIONAL, POINTER :: para_env 98 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: blacs2mpi, mpi2blacs 99 100 CHARACTER(len=*), PARAMETER :: routineN = 'get_blacs_info', routineP = moduleN//':'//routineN 101 102 IF (.NOT. ASSOCIATED(blacs_env)) THEN 103 CPABORT("No BLACS environment") 104 END IF 105 106 IF (PRESENT(my_process_row)) my_process_row = blacs_env%mepos(1) 107 IF (PRESENT(my_process_column)) my_process_column = blacs_env%mepos(2) 108 IF (PRESENT(my_process_number)) my_process_number = blacs_env%my_pid 109 IF (PRESENT(number_of_process_rows)) number_of_process_rows = blacs_env%num_pe(1) 110 IF (PRESENT(number_of_process_columns)) number_of_process_columns = blacs_env%num_pe(2) 111 IF (PRESENT(number_of_processes)) number_of_processes = blacs_env%n_pid 112 IF (PRESENT(para_env)) para_env => blacs_env%para_env 113 IF (PRESENT(blacs2mpi)) blacs2mpi => blacs_env%blacs2mpi 114 IF (PRESENT(mpi2blacs)) mpi2blacs => blacs_env%mpi2blacs 115 116 END SUBROUTINE get_blacs_info 117 118! ************************************************************************************************** 119!> \brief allocates and initializes a type that represent a blacs context 120!> \param blacs_env the type to initialize 121!> \param para_env the para_env for which a blacs env should be created 122!> \param blacs_grid_layout ... 123!> \param blacs_repeatable ... 124!> \param row_major ... 125!> \param grid_2d ... 126!> \par History 127!> 08.2002 created [fawzi] 128!> \author Fawzi Mohamed 129! ************************************************************************************************** 130 SUBROUTINE cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d) 131 TYPE(cp_blacs_env_type), POINTER :: blacs_env 132 TYPE(cp_para_env_type), POINTER :: para_env 133 INTEGER, INTENT(IN), OPTIONAL :: blacs_grid_layout 134 LOGICAL, INTENT(IN), OPTIONAL :: blacs_repeatable, row_major 135 INTEGER, DIMENSION(:), INTENT(IN), & 136 OPTIONAL :: grid_2d 137 138 CHARACTER(len=*), PARAMETER :: routineN = 'cp_blacs_env_create', & 139 routineP = moduleN//':'//routineN 140 141 INTEGER :: ipcol, iprow, stat 142#if defined(__parallel) 143 INTEGER :: gcd_max, ipe, jpe, & 144 my_blacs_grid_layout, & 145 npcol, npe, nprow 146 LOGICAL :: my_blacs_repeatable, & 147 my_row_major 148#endif 149 150#ifdef __parallel 151#ifndef __SCALAPACK 152 CALL cp_abort(__LOCATION__, & 153 "to USE the blacs environment "// & 154 "you need the blacs/scalapack library : recompile with -D__SCALAPACK (and link scalapack and blacs) ") 155#endif 156#endif 157 158 CPASSERT(.NOT. ASSOCIATED(blacs_env)) 159 160 ALLOCATE (blacs_env) 161 blacs_env%group = 0 162 blacs_env%ref_count = 1 163 blacs_env%mepos(:) = 0 164 blacs_env%num_pe(:) = 1 165 blacs_env%my_pid = 0 166 blacs_env%n_pid = 1 167 CALL cp_para_env_retain(para_env) 168 blacs_env%para_env => para_env 169 170#ifdef __SCALAPACK 171 ! get the number of cpus for this blacs grid 172 blacs_env%my_pid = para_env%mepos 173 blacs_env%n_pid = para_env%num_pe 174 nprow = 1 175 npcol = 1 176 npe = blacs_env%n_pid 177 ! get the layout of this grid 178 179 IF (PRESENT(grid_2d)) THEN 180 nprow = grid_2d(1) 181 npcol = grid_2d(2) 182 ENDIF 183 184 IF (nprow*npcol .NE. npe) THEN 185 ! hard code for the time being the grid layout 186 my_blacs_grid_layout = BLACS_GRID_SQUARE 187 IF (PRESENT(blacs_grid_layout)) my_blacs_grid_layout = blacs_grid_layout 188 ! XXXXXX 189 SELECT CASE (my_blacs_grid_layout) 190 CASE (BLACS_GRID_SQUARE) 191 ! make the grid as 'square' as possible, where square is defined as nprow and npcol 192 ! having the largest possible gcd 193 gcd_max = -1 194 DO ipe = 1, CEILING(SQRT(REAL(npe, dp))) 195 jpe = npe/ipe 196 IF (ipe*jpe .NE. npe) CYCLE 197 IF (gcd(ipe, jpe) >= gcd_max) THEN 198 nprow = ipe 199 npcol = jpe 200 gcd_max = gcd(ipe, jpe) 201 ENDIF 202 ENDDO 203 CASE (BLACS_GRID_ROW) 204 nprow = 1 205 npcol = npe 206 CASE (BLACS_GRID_COL) 207 nprow = npe 208 npcol = 1 209 END SELECT 210 ENDIF 211 212 ! blacs_env%group will be set to the blacs context for this blacs env, this is not the same as the MPI context 213 blacs_env%group = para_env%group 214 my_row_major = .TRUE. 215 IF (PRESENT(row_major)) my_row_major = row_major 216 IF (my_row_major) THEN 217 CALL cp_blacs_gridinit(blacs_env%group, "Row-major", nprow, npcol) 218 ELSE 219 CALL cp_blacs_gridinit(blacs_env%group, "Col-major", nprow, npcol) 220 ENDIF 221 222 my_blacs_repeatable = .FALSE. 223 IF (PRESENT(blacs_repeatable)) my_blacs_repeatable = blacs_repeatable 224 blacs_env%repeatable = my_blacs_repeatable 225 IF (blacs_env%repeatable) CALL cp_blacs_set(blacs_env%group, 15, 1) 226 227 ! fill in the info one needs 228 CALL cp_blacs_gridinfo(blacs_env%group, blacs_env%num_pe(1), & 229 blacs_env%num_pe(2), blacs_env%mepos(1), blacs_env%mepos(2)) 230 231#else 232 MARK_USED(blacs_grid_layout) 233 MARK_USED(blacs_repeatable) 234 MARK_USED(grid_2d) 235 MARK_USED(row_major) 236#endif 237 238 ! generate the mappings blacs2mpi and mpi2blacs 239 ALLOCATE (blacs_env%blacs2mpi(0:blacs_env%num_pe(1) - 1, 0:blacs_env%num_pe(2) - 1), & 240 stat=stat) 241 CPASSERT(stat == 0) 242 blacs_env%blacs2mpi = 0 243 blacs_env%blacs2mpi(blacs_env%mepos(1), blacs_env%mepos(2)) = para_env%mepos 244 CALL mp_sum(blacs_env%blacs2mpi, para_env%group) 245 ALLOCATE (blacs_env%mpi2blacs(2, 0:para_env%num_pe - 1)) 246 blacs_env%mpi2blacs = -1 247 DO ipcol = 0, blacs_env%num_pe(2) - 1 248 DO iprow = 0, blacs_env%num_pe(1) - 1 249 blacs_env%mpi2blacs(1, blacs_env%blacs2mpi(iprow, ipcol)) = iprow 250 blacs_env%mpi2blacs(2, blacs_env%blacs2mpi(iprow, ipcol)) = ipcol 251 END DO 252 END DO 253 END SUBROUTINE cp_blacs_env_create 254 255! ************************************************************************************************** 256!> \brief retains the given blacs env 257!> \param blacs_env the blacs env to retain 258!> \par History 259!> 08.2002 created [fawzi] 260!> \author Fawzi Mohamed 261! ************************************************************************************************** 262 SUBROUTINE cp_blacs_env_retain(blacs_env) 263 TYPE(cp_blacs_env_type), POINTER :: blacs_env 264 265 CHARACTER(len=*), PARAMETER :: routineN = 'cp_blacs_env_retain', & 266 routineP = moduleN//':'//routineN 267 268 CPASSERT(ASSOCIATED(blacs_env)) 269 CPASSERT(blacs_env%ref_count > 0) 270 blacs_env%ref_count = blacs_env%ref_count + 1 271 END SUBROUTINE cp_blacs_env_retain 272 273! ************************************************************************************************** 274!> \brief releases the given blacs_env 275!> \param blacs_env the blacs env to release 276!> \par History 277!> 08.2002 created [fawzi] 278!> \author Fawzi Mohamed 279! ************************************************************************************************** 280 SUBROUTINE cp_blacs_env_release(blacs_env) 281 TYPE(cp_blacs_env_type), POINTER :: blacs_env 282 283 CHARACTER(len=*), PARAMETER :: routineN = 'cp_blacs_env_release', & 284 routineP = moduleN//':'//routineN 285 286 IF (ASSOCIATED(blacs_env)) THEN 287 CPASSERT(blacs_env%ref_count > 0) 288 blacs_env%ref_count = blacs_env%ref_count - 1 289 IF (blacs_env%ref_count < 1) THEN 290 CALL cp_blacs_gridexit(blacs_env%group) 291 CALL cp_para_env_release(blacs_env%para_env) 292 DEALLOCATE (blacs_env%mpi2blacs) 293 DEALLOCATE (blacs_env%blacs2mpi) 294 DEALLOCATE (blacs_env) 295 END IF 296 END IF 297 NULLIFY (blacs_env) 298 END SUBROUTINE cp_blacs_env_release 299 300! ************************************************************************************************** 301!> \brief writes the description of the given blacs env 302!> \param blacs_env the blacs environment to write 303!> \param unit_nr the unit number where to write the description of the 304!> blacs environment 305!> \par History 306!> 08.2002 created [fawzi] 307!> \author Fawzi Mohamed 308! ************************************************************************************************** 309 SUBROUTINE cp_blacs_env_write(blacs_env, unit_nr) 310 TYPE(cp_blacs_env_type), POINTER :: blacs_env 311 INTEGER, INTENT(in) :: unit_nr 312 313 CHARACTER(len=*), PARAMETER :: routineN = 'cp_blacs_env_write', & 314 routineP = moduleN//':'//routineN 315 316 INTEGER :: iostat 317 318 IF (ASSOCIATED(blacs_env)) THEN 319 WRITE (unit=unit_nr, fmt="(' group=',i10,', ref_count=',i10,',')", & 320 iostat=iostat) blacs_env%group, blacs_env%ref_count 321 CPASSERT(iostat == 0) 322 WRITE (unit=unit_nr, fmt="(' mepos=(',i8,',',i8,'),')", & 323 iostat=iostat) blacs_env%mepos(1), blacs_env%mepos(2) 324 CPASSERT(iostat == 0) 325 WRITE (unit=unit_nr, fmt="(' num_pe=(',i8,',',i8,'),')", & 326 iostat=iostat) blacs_env%num_pe(1), blacs_env%num_pe(2) 327 CPASSERT(iostat == 0) 328 IF (ASSOCIATED(blacs_env%blacs2mpi)) THEN 329 WRITE (unit=unit_nr, fmt="(' blacs2mpi=')", advance="no", iostat=iostat) 330 CPASSERT(iostat == 0) 331 CALL cp_2d_i_write(blacs_env%blacs2mpi, unit_nr=unit_nr) 332 ELSE 333 WRITE (unit=unit_nr, fmt="(' blacs2mpi=*null*')", iostat=iostat) 334 CPASSERT(iostat == 0) 335 END IF 336 IF (ASSOCIATED(blacs_env%para_env)) THEN 337 WRITE (unit=unit_nr, fmt="(' para_env=<cp_para_env id=',i6,'>,')") & 338 blacs_env%para_env%group 339 ELSE 340 WRITE (unit=unit_nr, fmt="(' para_env=*null*')") 341 END IF 342 WRITE (unit=unit_nr, fmt="(' my_pid=',i10,', n_pid=',i10,' }')", & 343 iostat=iostat) blacs_env%my_pid, blacs_env%n_pid 344 CPASSERT(iostat == 0) 345 ELSE 346 WRITE (unit=unit_nr, & 347 fmt="(a)", iostat=iostat) ' <cp_blacs_env>:*null* ' 348 CPASSERT(iostat == 0) 349 END IF 350 CALL m_flush(unit_nr) 351 END SUBROUTINE cp_blacs_env_write 352 353END MODULE cp_blacs_env 354