1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2020 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief stores a mapping of 2D info (e.g. matrix) on a 8!> 2D processor distribution (i.e. blacs grid) 9!> where cpus in the same blacs row own the same rows of the 2D info 10!> (and similar for the cols) 11!> \author Joost VandeVondele (2003-08) 12! ************************************************************************************************** 13MODULE distribution_2d_types 14 15 USE cp_array_utils, ONLY: cp_1d_i_p_type,& 16 cp_1d_i_write 17 USE cp_blacs_env, ONLY: cp_blacs_env_release,& 18 cp_blacs_env_retain,& 19 cp_blacs_env_type,& 20 cp_blacs_env_write 21 USE cp_log_handling, ONLY: cp_get_default_logger,& 22 cp_logger_type 23 USE machine, ONLY: m_flush 24#include "base/base_uses.f90" 25 26 IMPLICIT NONE 27 PRIVATE 28 29 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'distribution_2d_types' 30 INTEGER, SAVE, PRIVATE :: last_distribution_2d_id = 0 31 32 PUBLIC :: distribution_2d_type 33 34 PUBLIC :: distribution_2d_create, & 35 distribution_2d_release, & 36 distribution_2d_retain, & 37 distribution_2d_write, & 38 distribution_2d_get 39 40! ************************************************************************************************** 41!> \brief distributes pairs on a 2d grid of processors 42!> \param row_distribution (i): processor row that owns the row i 43!> \param col_distribution (i): processor col that owns the col i 44!> \param n_row_distribution nuber of global rows 45!> \param n_col_distribution number of global cols 46!> \param n_local_rows (ikind): number of local rows of kind ikind 47!> \param n_local_cols (ikind): number of local cols of kind ikind 48!> \param local_cols (ikind)%array: ordered global indexes of the local cols 49!> of kind ikind (might be oversized) 50!> \param local_rows (ikind)%array: ordered global indexes of the local 51!> rows of kind ikind (might be oversized) 52!> \param flat_local_rows ordered global indexes of the local rows 53!> (allocated on request, might be oversized) 54!> \param flat_local_cols ordered global indexes of the local cols 55!> (allocated on request, might be oversized) 56!> \param blacs_env parallel environment in which the pairs are distributed 57!> \param ref_count reference count (see doc/ReferenceCounting.html) 58!> \param id_nr identification number (unique) 59!> \par History 60!> 08.2003 created [joost] 61!> 09.2003 kind separation, minor cleanup [fawzi] 62!> \author Joost & Fawzi 63! ************************************************************************************************** 64 TYPE distribution_2d_type 65 INTEGER, DIMENSION(:, :), POINTER :: row_distribution 66 INTEGER, DIMENSION(:, :), POINTER :: col_distribution 67 INTEGER :: n_row_distribution 68 INTEGER :: n_col_distribution 69 INTEGER, DIMENSION(:), POINTER :: n_local_rows 70 INTEGER, DIMENSION(:), POINTER :: n_local_cols 71 TYPE(cp_1d_i_p_type), DIMENSION(:), POINTER :: local_rows 72 TYPE(cp_1d_i_p_type), DIMENSION(:), POINTER :: local_cols 73 INTEGER, DIMENSION(:), POINTER :: flat_local_rows 74 INTEGER, DIMENSION(:), POINTER :: flat_local_cols 75 TYPE(cp_blacs_env_type), POINTER :: blacs_env 76 INTEGER :: ref_count 77 INTEGER :: id_nr 78 END TYPE distribution_2d_type 79 80CONTAINS 81 82! ************************************************************************************************** 83!> \brief initializes the distribution_2d 84!> \param distribution_2d ... 85!> \param blacs_env ... 86!> \param local_rows_ptr ... 87!> \param n_local_rows ... 88!> \param local_cols_ptr ... 89!> \param row_distribution_ptr 2D array, first is atom to processor 2nd is 90!> atom to cluster 91!> \param col_distribution_ptr ... 92!> \param n_local_cols ... 93!> \param n_row_distribution ... 94!> \param n_col_distribution ... 95!> \par History 96!> 09.2003 rewamped [fawzi] 97!> \author Joost VandeVondele 98!> \note 99!> the row and col_distribution are not allocated if not given 100! ************************************************************************************************** 101 SUBROUTINE distribution_2d_create(distribution_2d, blacs_env, & 102 local_rows_ptr, n_local_rows, & 103 local_cols_ptr, row_distribution_ptr, col_distribution_ptr, & 104 n_local_cols, n_row_distribution, n_col_distribution) 105 TYPE(distribution_2d_type), POINTER :: distribution_2d 106 TYPE(cp_blacs_env_type), POINTER :: blacs_env 107 TYPE(cp_1d_i_p_type), DIMENSION(:), OPTIONAL, & 108 POINTER :: local_rows_ptr 109 INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: n_local_rows 110 TYPE(cp_1d_i_p_type), DIMENSION(:), OPTIONAL, & 111 POINTER :: local_cols_ptr 112 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: row_distribution_ptr, & 113 col_distribution_ptr 114 INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: n_local_cols 115 INTEGER, INTENT(in), OPTIONAL :: n_row_distribution, n_col_distribution 116 117 CHARACTER(len=*), PARAMETER :: routineN = 'distribution_2d_create', & 118 routineP = moduleN//':'//routineN 119 120 INTEGER :: i 121 122 CPASSERT(ASSOCIATED(blacs_env)) 123 CPASSERT(.NOT. ASSOCIATED(distribution_2d)) 124 125 ALLOCATE (distribution_2d) 126 distribution_2d%ref_count = 1 127 last_distribution_2d_id = last_distribution_2d_id + 1 128 distribution_2d%id_nr = last_distribution_2d_id 129 130 NULLIFY (distribution_2d%col_distribution, distribution_2d%row_distribution, & 131 distribution_2d%local_rows, distribution_2d%local_cols, & 132 distribution_2d%blacs_env, distribution_2d%n_local_cols, & 133 distribution_2d%n_local_rows, distribution_2d%flat_local_rows, & 134 distribution_2d%flat_local_cols) 135 136 distribution_2d%n_col_distribution = -HUGE(0) 137 IF (PRESENT(col_distribution_ptr)) THEN 138 distribution_2d%col_distribution => col_distribution_ptr 139 distribution_2d%n_col_distribution = SIZE(distribution_2d%col_distribution, 1) 140 END IF 141 IF (PRESENT(n_col_distribution)) THEN 142 IF (ASSOCIATED(distribution_2d%col_distribution)) THEN 143 IF (n_col_distribution > distribution_2d%n_col_distribution) & 144 CPABORT("n_col_distribution<=distribution_2d%n_col_distribution") 145 ! else alloc col_distribution? 146 END IF 147 distribution_2d%n_col_distribution = n_col_distribution 148 END IF 149 distribution_2d%n_row_distribution = -HUGE(0) 150 IF (PRESENT(row_distribution_ptr)) THEN 151 distribution_2d%row_distribution => row_distribution_ptr 152 distribution_2d%n_row_distribution = SIZE(distribution_2d%row_distribution, 1) 153 END IF 154 IF (PRESENT(n_row_distribution)) THEN 155 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN 156 IF (n_row_distribution > distribution_2d%n_row_distribution) & 157 CPABORT("n_row_distribution<=distribution_2d%n_row_distribution") 158 ! else alloc row_distribution? 159 END IF 160 distribution_2d%n_row_distribution = n_row_distribution 161 END IF 162 163 IF (PRESENT(local_rows_ptr)) & 164 distribution_2d%local_rows => local_rows_ptr 165 IF (.NOT. ASSOCIATED(distribution_2d%local_rows)) THEN 166 CPASSERT(PRESENT(n_local_rows)) 167 ALLOCATE (distribution_2d%local_rows(SIZE(n_local_rows))) 168 DO i = 1, SIZE(distribution_2d%local_rows) 169 ALLOCATE (distribution_2d%local_rows(i)%array(n_local_rows(i))) 170 distribution_2d%local_rows(i)%array = -HUGE(0) 171 END DO 172 END IF 173 ALLOCATE (distribution_2d%n_local_rows(SIZE(distribution_2d%local_rows))) 174 IF (PRESENT(n_local_rows)) THEN 175 IF (SIZE(distribution_2d%n_local_rows) /= SIZE(n_local_rows)) & 176 CPABORT("SIZE(distribution_2d%n_local_rows)==SIZE(n_local_rows)") 177 DO i = 1, SIZE(distribution_2d%n_local_rows) 178 IF (SIZE(distribution_2d%local_rows(i)%array) < n_local_rows(i)) & 179 CPABORT("SIZE(distribution_2d%local_rows(i)%array)>=n_local_rows(i)") 180 distribution_2d%n_local_rows(i) = n_local_rows(i) 181 END DO 182 ELSE 183 DO i = 1, SIZE(distribution_2d%n_local_rows) 184 distribution_2d%n_local_rows(i) = & 185 SIZE(distribution_2d%local_rows(i)%array) 186 END DO 187 END IF 188 189 IF (PRESENT(local_cols_ptr)) & 190 distribution_2d%local_cols => local_cols_ptr 191 IF (.NOT. ASSOCIATED(distribution_2d%local_cols)) THEN 192 CPASSERT(PRESENT(n_local_cols)) 193 ALLOCATE (distribution_2d%local_cols(SIZE(n_local_cols))) 194 DO i = 1, SIZE(distribution_2d%local_cols) 195 ALLOCATE (distribution_2d%local_cols(i)%array(n_local_cols(i))) 196 distribution_2d%local_cols(i)%array = -HUGE(0) 197 END DO 198 END IF 199 ALLOCATE (distribution_2d%n_local_cols(SIZE(distribution_2d%local_cols))) 200 IF (PRESENT(n_local_cols)) THEN 201 IF (SIZE(distribution_2d%n_local_cols) /= SIZE(n_local_cols)) & 202 CPABORT("SIZE(distribution_2d%n_local_cols)==SIZE(n_local_cols)") 203 DO i = 1, SIZE(distribution_2d%n_local_cols) 204 IF (SIZE(distribution_2d%local_cols(i)%array) < n_local_cols(i)) & 205 CPABORT("SIZE(distribution_2d%local_cols(i)%array)>=n_local_cols(i)") 206 distribution_2d%n_local_cols(i) = n_local_cols(i) 207 END DO 208 ELSE 209 DO i = 1, SIZE(distribution_2d%n_local_cols) 210 distribution_2d%n_local_cols(i) = & 211 SIZE(distribution_2d%local_cols(i)%array) 212 END DO 213 END IF 214 215 distribution_2d%blacs_env => blacs_env 216 CALL cp_blacs_env_retain(distribution_2d%blacs_env) 217 218 END SUBROUTINE distribution_2d_create 219 220! ************************************************************************************************** 221!> \brief ... 222!> \param distribution_2d ... 223!> \author Joost VandeVondele 224! ************************************************************************************************** 225 SUBROUTINE distribution_2d_retain(distribution_2d) 226 TYPE(distribution_2d_type), POINTER :: distribution_2d 227 228 CHARACTER(len=*), PARAMETER :: routineN = 'distribution_2d_retain', & 229 routineP = moduleN//':'//routineN 230 231 CPASSERT(ASSOCIATED(distribution_2d)) 232 CPASSERT(distribution_2d%ref_count > 0) 233 distribution_2d%ref_count = distribution_2d%ref_count + 1 234 END SUBROUTINE distribution_2d_retain 235 236! ************************************************************************************************** 237!> \brief ... 238!> \param distribution_2d ... 239! ************************************************************************************************** 240 SUBROUTINE distribution_2d_release(distribution_2d) 241 TYPE(distribution_2d_type), POINTER :: distribution_2d 242 243 CHARACTER(len=*), PARAMETER :: routineN = 'distribution_2d_release', & 244 routineP = moduleN//':'//routineN 245 246 INTEGER :: i 247 248 IF (ASSOCIATED(distribution_2d)) THEN 249 CPASSERT(distribution_2d%ref_count > 0) 250 distribution_2d%ref_count = distribution_2d%ref_count - 1 251 IF (distribution_2d%ref_count == 0) THEN 252 CALL cp_blacs_env_release(distribution_2d%blacs_env) 253 IF (ASSOCIATED(distribution_2d%col_distribution)) THEN 254 DEALLOCATE (distribution_2d%col_distribution) 255 END IF 256 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN 257 DEALLOCATE (distribution_2d%row_distribution) 258 END IF 259 DO i = 1, SIZE(distribution_2d%local_rows) 260 DEALLOCATE (distribution_2d%local_rows(i)%array) 261 END DO 262 DEALLOCATE (distribution_2d%local_rows) 263 DO i = 1, SIZE(distribution_2d%local_cols) 264 DEALLOCATE (distribution_2d%local_cols(i)%array) 265 END DO 266 DEALLOCATE (distribution_2d%local_cols) 267 IF (ASSOCIATED(distribution_2d%flat_local_rows)) THEN 268 DEALLOCATE (distribution_2d%flat_local_rows) 269 END IF 270 IF (ASSOCIATED(distribution_2d%flat_local_cols)) THEN 271 DEALLOCATE (distribution_2d%flat_local_cols) 272 END IF 273 IF (ASSOCIATED(distribution_2d%n_local_rows)) THEN 274 DEALLOCATE (distribution_2d%n_local_rows) 275 END IF 276 IF (ASSOCIATED(distribution_2d%n_local_cols)) THEN 277 DEALLOCATE (distribution_2d%n_local_cols) 278 END IF 279 DEALLOCATE (distribution_2d) 280 ENDIF 281 ENDIF 282 NULLIFY (distribution_2d) 283 END SUBROUTINE distribution_2d_release 284 285! ************************************************************************************************** 286!> \brief writes out the given distribution 287!> \param distribution_2d the distribution to write out 288!> \param unit_nr the unit to write to 289!> \param local if the unit is local to to each processor (otherwise 290!> only the processor with logger%para_env%source== 291!> logger%para_env%mepos writes), defaults to false. 292!> \param long_description if a long description should be given, 293!> defaults to false 294!> \par History 295!> 08.2003 adapted qs_distribution_2d_create write done by Matthias[fawzi] 296!> \author Fawzi Mohamed 297!> \note 298!> to clean up, make safer wrt. grabage in distribution_2d%n_* 299! ************************************************************************************************** 300 SUBROUTINE distribution_2d_write(distribution_2d, unit_nr, local, & 301 long_description) 302 TYPE(distribution_2d_type), POINTER :: distribution_2d 303 INTEGER, INTENT(in) :: unit_nr 304 LOGICAL, INTENT(in), OPTIONAL :: local, long_description 305 306 CHARACTER(len=*), PARAMETER :: routineN = 'distribution_2d_write', & 307 routineP = moduleN//':'//routineN 308 309 INTEGER :: i 310 LOGICAL :: my_local, my_long_description 311 TYPE(cp_logger_type), POINTER :: logger 312 313 logger => cp_get_default_logger() 314 315 my_long_description = .FALSE. 316 IF (PRESENT(long_description)) my_long_description = long_description 317 my_local = .FALSE. 318 IF (PRESENT(local)) my_local = local 319 IF (.NOT. my_local) my_local = logger%para_env%ionode 320 321 IF (ASSOCIATED(distribution_2d)) THEN 322 IF (my_local) THEN 323 WRITE (unit=unit_nr, & 324 fmt="(/,' <distribution_2d> { id_nr=',i10,' ref_count=',i10,',')") & 325 distribution_2d%id_nr, distribution_2d%ref_count 326 327 WRITE (unit=unit_nr, fmt="(' n_row_distribution=',i15,',')") & 328 distribution_2d%n_row_distribution 329 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN 330 IF (my_long_description) THEN 331 WRITE (unit=unit_nr, fmt="(' row_distribution= (')", advance="no") 332 DO i = 1, SIZE(distribution_2d%row_distribution, 1) 333 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%row_distribution(i, 1) 334 ! keep lines finite, so that we can open outputs in vi 335 IF (MODULO(i, 8) == 0 .AND. i .NE. SIZE(distribution_2d%row_distribution, 1)) & 336 WRITE (unit=unit_nr, fmt='()') 337 END DO 338 WRITE (unit=unit_nr, fmt="('),')") 339 ELSE 340 WRITE (unit=unit_nr, fmt="(' row_distribution= array(',i6,':',i6,'),')") & 341 LBOUND(distribution_2d%row_distribution(:, 1)), & 342 UBOUND(distribution_2d%row_distribution(:, 1)) 343 END IF 344 ELSE 345 WRITE (unit=unit_nr, fmt="(' row_distribution=*null*,')") 346 END IF 347 348 WRITE (unit=unit_nr, fmt="(' n_col_distribution=',i15,',')") & 349 distribution_2d%n_col_distribution 350 IF (ASSOCIATED(distribution_2d%col_distribution)) THEN 351 IF (my_long_description) THEN 352 WRITE (unit=unit_nr, fmt="(' col_distribution= (')", advance="no") 353 DO i = 1, SIZE(distribution_2d%col_distribution, 1) 354 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%col_distribution(i, 1) 355 ! keep lines finite, so that we can open outputs in vi 356 IF (MODULO(i, 8) == 0 .AND. i .NE. SIZE(distribution_2d%col_distribution, 1)) & 357 WRITE (unit=unit_nr, fmt='()') 358 END DO 359 WRITE (unit=unit_nr, fmt="('),')") 360 ELSE 361 WRITE (unit=unit_nr, fmt="(' col_distribution= array(',i6,':',i6,'),')") & 362 LBOUND(distribution_2d%col_distribution(:, 1)), & 363 UBOUND(distribution_2d%col_distribution(:, 1)) 364 END IF 365 ELSE 366 WRITE (unit=unit_nr, fmt="(' col_distribution=*null*,')") 367 END IF 368 369 IF (ASSOCIATED(distribution_2d%n_local_rows)) THEN 370 IF (my_long_description) THEN 371 WRITE (unit=unit_nr, fmt="(' n_local_rows= (')", advance="no") 372 DO i = 1, SIZE(distribution_2d%n_local_rows) 373 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%n_local_rows(i) 374 ! keep lines finite, so that we can open outputs in vi 375 IF (MODULO(i, 10) == 0 .AND. i .NE. SIZE(distribution_2d%n_local_rows)) & 376 WRITE (unit=unit_nr, fmt='()') 377 END DO 378 WRITE (unit=unit_nr, fmt="('),')") 379 ELSE 380 WRITE (unit=unit_nr, fmt="(' n_local_rows= array(',i6,':',i6,'),')") & 381 LBOUND(distribution_2d%n_local_rows), & 382 UBOUND(distribution_2d%n_local_rows) 383 END IF 384 ELSE 385 WRITE (unit=unit_nr, fmt="(' n_local_rows=*null*,')") 386 END IF 387 388 IF (ASSOCIATED(distribution_2d%local_rows)) THEN 389 WRITE (unit=unit_nr, fmt="(' local_rows=(')") 390 DO i = 1, SIZE(distribution_2d%local_rows) 391 IF (ASSOCIATED(distribution_2d%local_rows(i)%array)) THEN 392 IF (my_long_description) THEN 393 CALL cp_1d_i_write(array=distribution_2d%local_rows(i)%array, & 394 unit_nr=unit_nr) 395 ELSE 396 WRITE (unit=unit_nr, fmt="(' array(',i6,':',i6,'),')") & 397 LBOUND(distribution_2d%local_rows(i)%array), & 398 UBOUND(distribution_2d%local_rows(i)%array) 399 END IF 400 ELSE 401 WRITE (unit=unit_nr, fmt="('*null*')") 402 END IF 403 END DO 404 WRITE (unit=unit_nr, fmt="(' ),')") 405 ELSE 406 WRITE (unit=unit_nr, fmt="(' local_rows=*null*,')") 407 END IF 408 409 IF (ASSOCIATED(distribution_2d%n_local_cols)) THEN 410 IF (my_long_description) THEN 411 WRITE (unit=unit_nr, fmt="(' n_local_cols= (')", advance="no") 412 DO i = 1, SIZE(distribution_2d%n_local_cols) 413 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%n_local_cols(i) 414 ! keep lines finite, so that we can open outputs in vi 415 IF (MODULO(i, 10) == 0 .AND. i .NE. SIZE(distribution_2d%n_local_cols)) & 416 WRITE (unit=unit_nr, fmt='()') 417 END DO 418 WRITE (unit=unit_nr, fmt="('),')") 419 ELSE 420 WRITE (unit=unit_nr, fmt="(' n_local_cols= array(',i6,':',i6,'),')") & 421 LBOUND(distribution_2d%n_local_cols), & 422 UBOUND(distribution_2d%n_local_cols) 423 END IF 424 ELSE 425 WRITE (unit=unit_nr, fmt="(' n_local_cols=*null*,')") 426 END IF 427 428 IF (ASSOCIATED(distribution_2d%local_cols)) THEN 429 WRITE (unit=unit_nr, fmt="(' local_cols=(')") 430 DO i = 1, SIZE(distribution_2d%local_cols) 431 IF (ASSOCIATED(distribution_2d%local_cols(i)%array)) THEN 432 IF (my_long_description) THEN 433 CALL cp_1d_i_write(array=distribution_2d%local_cols(i)%array, & 434 unit_nr=unit_nr) 435 ELSE 436 WRITE (unit=unit_nr, fmt="(' array(',i6,':',i6,'),')") & 437 LBOUND(distribution_2d%local_cols(i)%array), & 438 UBOUND(distribution_2d%local_cols(i)%array) 439 END IF 440 ELSE 441 WRITE (unit=unit_nr, fmt="('*null*')") 442 END IF 443 END DO 444 WRITE (unit=unit_nr, fmt="(' ),')") 445 ELSE 446 WRITE (unit=unit_nr, fmt="(' local_cols=*null*,')") 447 END IF 448 449 IF (ASSOCIATED(distribution_2d%blacs_env)) THEN 450 IF (my_long_description) THEN 451 WRITE (unit=unit_nr, fmt="(' blacs_env=')", advance="no") 452 CALL cp_blacs_env_write(distribution_2d%blacs_env, unit_nr=unit_nr) 453 ELSE 454 WRITE (unit=unit_nr, fmt="(' blacs_env=<blacs_env id=',i6,'>')") & 455 distribution_2d%blacs_env%group 456 END IF 457 ELSE 458 WRITE (unit=unit_nr, fmt="(' blacs_env=*null*')") 459 END IF 460 461 WRITE (unit=unit_nr, fmt="(' }')") 462 END IF 463 464 ELSE IF (my_local) THEN 465 WRITE (unit=unit_nr, & 466 fmt="(' <distribution_2d *null*>')") 467 END IF 468 469 CALL m_flush(unit_nr) 470 471 END SUBROUTINE distribution_2d_write 472 473! ************************************************************************************************** 474!> \brief returns various attributes about the distribution_2d 475!> \param distribution_2d the object you want info about 476!> \param row_distribution ... 477!> \param col_distribution ... 478!> \param n_row_distribution ... 479!> \param n_col_distribution ... 480!> \param n_local_rows ... 481!> \param n_local_cols ... 482!> \param local_rows ... 483!> \param local_cols ... 484!> \param flat_local_rows ... 485!> \param flat_local_cols ... 486!> \param n_flat_local_rows ... 487!> \param n_flat_local_cols ... 488!> \param blacs_env ... 489!> \param id_nr ... 490!> \par History 491!> 09.2003 created [fawzi] 492!> \author Fawzi Mohamed 493! ************************************************************************************************** 494 SUBROUTINE distribution_2d_get(distribution_2d, row_distribution, & 495 col_distribution, n_row_distribution, n_col_distribution, & 496 n_local_rows, n_local_cols, local_rows, local_cols, & 497 flat_local_rows, flat_local_cols, n_flat_local_rows, n_flat_local_cols, & 498 blacs_env, id_nr) 499 TYPE(distribution_2d_type), POINTER :: distribution_2d 500 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: row_distribution, col_distribution 501 INTEGER, INTENT(out), OPTIONAL :: n_row_distribution, n_col_distribution 502 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: n_local_rows, n_local_cols 503 TYPE(cp_1d_i_p_type), DIMENSION(:), OPTIONAL, & 504 POINTER :: local_rows, local_cols 505 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: flat_local_rows, flat_local_cols 506 INTEGER, INTENT(out), OPTIONAL :: n_flat_local_rows, n_flat_local_cols 507 TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env 508 INTEGER, INTENT(out), OPTIONAL :: id_nr 509 510 CHARACTER(len=*), PARAMETER :: routineN = 'distribution_2d_get', & 511 routineP = moduleN//':'//routineN 512 513 INTEGER :: iblock_atomic, iblock_min, ikind, & 514 ikind_min 515 INTEGER, ALLOCATABLE, DIMENSION(:) :: multiindex 516 517 CPASSERT(ASSOCIATED(distribution_2d)) 518 CPASSERT(distribution_2d%ref_count > 0) 519 IF (PRESENT(row_distribution)) row_distribution => distribution_2d%row_distribution 520 IF (PRESENT(col_distribution)) col_distribution => distribution_2d%col_distribution 521 IF (PRESENT(n_row_distribution)) n_row_distribution = distribution_2d%n_row_distribution 522 IF (PRESENT(n_col_distribution)) n_col_distribution = distribution_2d%n_col_distribution 523 IF (PRESENT(n_local_rows)) n_local_rows => distribution_2d%n_local_rows 524 IF (PRESENT(n_local_cols)) n_local_cols => distribution_2d%n_local_cols 525 IF (PRESENT(local_rows)) local_rows => distribution_2d%local_rows 526 IF (PRESENT(local_cols)) local_cols => distribution_2d%local_cols 527 IF (PRESENT(flat_local_rows)) THEN 528 IF (.NOT. ASSOCIATED(distribution_2d%flat_local_rows)) THEN 529 ALLOCATE (multiindex(SIZE(distribution_2d%local_rows)), & 530 distribution_2d%flat_local_rows(SUM(distribution_2d%n_local_rows))) 531 multiindex = 1 532 DO iblock_atomic = 1, SIZE(distribution_2d%flat_local_rows) 533 iblock_min = HUGE(0) 534 ikind_min = -HUGE(0) 535 DO ikind = 1, SIZE(distribution_2d%local_rows) 536 IF (multiindex(ikind) <= distribution_2d%n_local_rows(ikind)) THEN 537 IF (distribution_2d%local_rows(ikind)%array(multiindex(ikind)) < & 538 iblock_min) THEN 539 iblock_min = distribution_2d%local_rows(ikind)%array(multiindex(ikind)) 540 ikind_min = ikind 541 END IF 542 END IF 543 END DO 544 CPASSERT(ikind_min > 0) 545 distribution_2d%flat_local_rows(iblock_atomic) = & 546 distribution_2d%local_rows(ikind_min)%array(multiindex(ikind_min)) 547 multiindex(ikind_min) = multiindex(ikind_min) + 1 548 END DO 549 DEALLOCATE (multiindex) 550 END IF 551 flat_local_rows => distribution_2d%flat_local_rows 552 END IF 553 IF (PRESENT(flat_local_cols)) THEN 554 IF (.NOT. ASSOCIATED(distribution_2d%flat_local_cols)) THEN 555 ALLOCATE (multiindex(SIZE(distribution_2d%local_cols)), & 556 distribution_2d%flat_local_cols(SUM(distribution_2d%n_local_cols))) 557 multiindex = 1 558 DO iblock_atomic = 1, SIZE(distribution_2d%flat_local_cols) 559 iblock_min = HUGE(0) 560 ikind_min = -HUGE(0) 561 DO ikind = 1, SIZE(distribution_2d%local_cols) 562 IF (multiindex(ikind) <= distribution_2d%n_local_cols(ikind)) THEN 563 IF (distribution_2d%local_cols(ikind)%array(multiindex(ikind)) < & 564 iblock_min) THEN 565 iblock_min = distribution_2d%local_cols(ikind)%array(multiindex(ikind)) 566 ikind_min = ikind 567 END IF 568 END IF 569 END DO 570 CPASSERT(ikind_min > 0) 571 distribution_2d%flat_local_cols(iblock_atomic) = & 572 distribution_2d%local_cols(ikind_min)%array(multiindex(ikind_min)) 573 multiindex(ikind_min) = multiindex(ikind_min) + 1 574 END DO 575 DEALLOCATE (multiindex) 576 END IF 577 flat_local_cols => distribution_2d%flat_local_cols 578 END IF 579 IF (PRESENT(n_flat_local_rows)) n_flat_local_rows = SUM(distribution_2d%n_local_rows) 580 IF (PRESENT(n_flat_local_cols)) n_flat_local_cols = SUM(distribution_2d%n_local_cols) 581 IF (PRESENT(blacs_env)) blacs_env => distribution_2d%blacs_env 582 IF (PRESENT(id_nr)) id_nr = distribution_2d%id_nr 583 END SUBROUTINE distribution_2d_get 584 585END MODULE distribution_2d_types 586