Changeset 3962 for palm/trunk/SOURCE/pmc_parent_mod.f90
- Timestamp:
- May 8, 2019 7:40:33 PM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_parent_mod.f90
r3655 r3962 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Bugfixes in initial settings of child and parent communication patterns. 29 ! 30 ! 3655 2019-01-07 16:51:22Z knoop 28 31 ! explicit kind settings 29 32 ! … … 473 476 INTEGER(iwp), INTENT(IN) :: childid !< 474 477 475 INTEGER(iwp) :: arlen !<476 INTEGER(iwp) :: i !<477 INTEGER(iwp) :: ierr !<478 INTEGER(iwp) :: j !<479 INTEGER(iwp) :: myindex !<480 INTEGER(iwp) :: rcount !< count MPI requests481 INTEGER(iwp) :: t ag !<478 INTEGER(iwp) :: arlen !< 479 INTEGER(iwp) :: i !< 480 INTEGER(iwp) :: ierr !< 481 INTEGER(iwp) :: j !< 482 INTEGER(iwp) :: lo_nr_arrays !< store number of arrays in local variiab le 483 INTEGER(iwp) :: myindex !< 484 INTEGER(iwp) :: total_npes !< Total Number of PEs Parent and Child 482 485 483 486 INTEGER(idp) :: bufsize !< size of MPI data window 484 487 INTEGER(KIND=MPI_ADDRESS_KIND) :: winsize !< 485 486 INTEGER(iwp), DIMENSION(1024) :: req !< 488 489 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: myindex_s 490 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: myindex_r 487 491 488 492 TYPE(C_PTR) :: base_ptr !< … … 493 497 REAL(wp),DIMENSION(:), POINTER, SAVE :: base_array_cp !< base array for child to parent transfer 494 498 499 call MPI_COMM_SIZE (children(childid)%intra_comm, total_npes, ierr) 495 500 ! 496 501 !-- Parent to child direction 497 502 myindex = 1 498 rcount = 0499 503 bufsize = 8 504 ! 505 !-- All Child processes get the same number of arrays 506 !-- Therfore the number of arrays form the first Child process can be used for Dimension. 507 lo_nr_arrays = children(childid)%pes(1)%nr_arrays 508 509 ALLOCATE( myindex_s(lo_nr_arrays,0:total_npes-1) ) 510 ALLOCATE( myindex_r(lo_nr_arrays,0:total_npes-1) ) 511 512 myindex_s = 0 513 500 514 ! 501 515 !-- First stride: compute size and set index … … 503 517 504 518 ape => children(childid)%pes(i) 505 tag = 200506 519 507 520 DO j = 1, ape%nr_arrays … … 516 529 ENDIF 517 530 ar%sendindex = myindex 518 519 tag = tag + 1 520 rcount = rcount + 1 521 CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag, & 522 children(childid)%inter_comm, req(rcount), ierr ) 523 ! 524 !-- Maximum of 1024 pending requests 525 526 IF ( rcount == 1024 ) THEN 527 CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr ) 528 rcount = 0 529 ENDIF 531 ! 532 ! Using intra communicator for MPU_Alltoall, the numbers of the child processes are after the paremt ones 533 534 myindex_s(j,i-1+children(childid)%model_npes) = myindex 530 535 531 536 myindex = myindex + arlen … … 534 539 ENDDO 535 540 536 IF ( rcount > 0 ) THEN 537 CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr ) 538 ENDIF 539 540 ENDDO 541 ENDDO 542 ! 543 !-- Using MPI_Alltoall to send indices from Parent to Child 544 !-- The data comming back from the child processes are ignored. 545 546 CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER, & 547 myindex_r, lo_nr_arrays, MPI_INTEGER, & 548 children(childid)%intra_comm, ierr ) 549 550 ! 551 !-- Using MPI_Alltoall to receive indices from Child 552 myindex_s = 0 553 myindex_r = 0 554 555 CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER, & 556 myindex_r, lo_nr_arrays, MPI_INTEGER, & 557 children(childid)%intra_comm, ierr ) 541 558 ! 542 559 !-- Create RMA (One Sided Communication) window for data buffer parent to … … 585 602 DO i = 1, children(childid)%inter_npes 586 603 ape => children(childid)%pes(i) 587 tag = 300588 604 DO j = 1, ape%nr_arrays 589 605 ar => ape%array_list(j) 590 606 ! 591 607 !-- Receive index from child 592 tag = tag + 1593 CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, &594 children(childid)%inter_comm, MPI_STATUS_IGNORE, ierr )595 608 IF ( ar%nrdims == 3 ) THEN 596 609 bufsize = MAX( bufsize, & … … 599 612 bufsize = MAX( bufsize, INT( ape%nrele, MPI_ADDRESS_KIND ) ) 600 613 ENDIF 601 ar%recvindex = myindex 614 ar%recvindex = myindex_r(j,i-1+children(childid)%model_npes) 602 615 ENDDO 603 616 ENDDO 617 618 DEALLOCATE( myindex_s ) 619 DEALLOCATE( myindex_r ) 620 604 621 ! 605 622 !-- Create RMA (one sided communication, RMA = Remote Memory Access) data buffer.
Note: See TracChangeset
for help on using the changeset viewer.