Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Nov 1, 2017 1:18:45 PM (6 years ago)
Author:
hellstea
Message:

i/o grouping update for nested runs

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_parent_mod.f90

    r2101 r2599  
    2626! -----------------
    2727! $Id$
     28! Some cleanup and commenting improvements only.
     29!
     30! 2101 2017-01-05 16:42:31Z suehring
    2831!
    2932! 2000 2016-08-20 18:09:15Z knoop
    … …  
    192195
    193196!
    194 !--    Intra communicater is used for MPI_GET
     197!--    Intra communicator is used for MPI_GET
    195198       CALL MPI_INTERCOMM_MERGE( children(childid)%inter_comm, .FALSE.,         &
    196199                                 children(childid)%intra_comm, istat )
    … …  
    232235
    233236     IF ( m_model_rank == 0 )  THEN
    234 
    235 !
    236 !--     Sort to ascending parent PE order
     237!
     238!--     Sort to ascending parent process order
    237239        CALL pmc_sort( index_list, 6 )
    238 
    239240        is = 1
    240241        DO  ip = 0, m_model_npes-1
    241 
    242 !
    243 !--        Split into parent PEs
     242!
     243!--        Split into parent processes
    244244           ie = is - 1
    245 
    246 !
    247 !--        There may be no entry for this PE
     245!
     246!--        There may be no entry for this process
    248247           IF ( is <= SIZE( index_list,2 )  .AND.  ie >= 0 )  THEN
    249 
    250248              DO WHILE ( index_list(6,ie+1 ) == ip )
    251249                 ie = ie + 1
    252250                 IF ( ie == SIZE( index_list,2 ) )  EXIT
    253251              ENDDO
    254 
    255252              ian = ie - is + 1
    256 
    257253           ELSE
    258254              is  = -1
    … …  
    260256              ian =  0
    261257           ENDIF
    262 
    263 !
    264 !--        Send data to other parent PEs
     258!
     259!--        Send data to other parent processes
    265260           IF ( ip == 0 )  THEN
    266261              indchildren(childid)%nrpoints = ian
    … …  
    279274           ENDIF
    280275           is = ie + 1
    281 
    282276        ENDDO
    283 
    284277     ELSE
    285 
    286278        CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000,  &
    287279                       m_model_comm, MPI_STATUS_IGNORE, istat )
    288280        ian = indchildren(childid)%nrpoints
    289 
    290281        IF ( ian > 0 )  THEN
    291282           ALLOCATE( indchildren(childid)%index_list_2d(6,ian) )
    … …  
    294285                          MPI_STATUS_IGNORE, istat)
    295286        ENDIF
    296 
    297287     ENDIF
    298 
    299288     CALL set_pe_index_list( childid, children(childid),                        &
    300289                             indchildren(childid)%index_list_2d,                &
    … …  
    328317
    329318    next_array_in_list = next_array_in_list + 1
    330 
    331 !
    332 !-- Array names are the same on all children PEs, so take first PE to get the name
     319!
     320!-- Array names are the same on all children processes, so take first
     321!-- process to get the name
    333322    ape => children(childid)%pes(1)
    334323
    335324    IF ( next_array_in_list > ape%nr_arrays )  THEN
    336 
    337325!
    338326!--    All arrays are done
    … …  
    343331    ar => ape%array_list(next_array_in_list)
    344332    myname = ar%name
    345 
    346333!
    347334!-- Return true if legal array
    … …  
    413400
    414401    array_adr = C_LOC(array)
    415 
    416402!
    417403!-- In PALM's pointer version, two indices have to be stored internally.
    … …  
    469455    rcount  = 0
    470456    bufsize = 8
    471 
    472457!
    473458!-- First stride: compute size and set index
    … …  
    493478          CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag,                    &
    494479                          children(childid)%inter_comm, req(rcount), ierr )
    495 
    496480!
    497481!--       Maximum of 1024 outstanding requests
    498 !--       TODO: what does this limit mean?
     482!--       TODO: what does this limit mean? Does outstanding mean pending?
    499483          IF ( rcount == 1024 )  THEN
    500484             CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
    … …  
    505489          bufsize = bufsize + arlen
    506490          ar%sendsize = arlen
    507 
    508491       ENDDO
    509492
    … …  
    513496
    514497    ENDDO
    515 
    516498!
    517499!-- Create RMA (One Sided Communication) window for data buffer parent to
    … …  
    530512                         children(childid)%intra_comm,                          &
    531513                         children(childid)%win_parent_child, ierr )
    532 
    533514!
    534515!-- Open window to set data
    535516    CALL MPI_WIN_FENCE( 0, children(childid)%win_parent_child, ierr )
    536 
    537517!
    538518!-- Second stride: set buffer pointer
    … …  
    555535       ENDDO
    556536    ENDDO
    557 
    558537!
    559538!-- Child to parent direction
    560539    bufsize = 8
    561 
    562540!
    563541!-- First stride: compute size and set index
    564542    DO  i = 1, children(childid)%inter_npes
    565 
    566543       ape => children(childid)%pes(i)
    567544       tag = 300
    568 
    569545       DO  j = 1, ape%nr_arrays
    570 
    571546          ar => ape%array_list(j)
    572 
    573547!
    574548!--       Receive index from child
    … …  
    576550          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag,                     &
    577551                         children(childid)%inter_comm, MPI_STATUS_IGNORE, ierr )
    578 
    579552          IF ( ar%nrdims == 3 )  THEN
    580553             bufsize = MAX( bufsize, ape%nrele * ar%a_dim(4) )
    … …  
    583556          ENDIF
    584557          ar%recvindex = myindex
    585 
    586558        ENDDO
    587 
    588     ENDDO
    589 
     559    ENDDO
    590560!
    591561!-- Create RMA (one sided communication) data buffer.
    … …  
    596566
    597567    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
    598 
    599568!
    600569!-- Second stride: set buffer pointer
    601570    DO  i = 1, children(childid)%inter_npes
    602 
    603571       ape => children(childid)%pes(i)
    604 
    605572       DO  j = 1, ape%nr_arrays
    606573          ar => ape%array_list(j)
    607574          ar%recvbuf = base_ptr
    608575       ENDDO
    609 
    610576    ENDDO
    611577
    … …  
    654620
    655621    DO  ip = 1, children(childid)%inter_npes
    656 
    657622       ape => children(childid)%pes(ip)
    658 
    659623       DO  j = 1, ape%nr_arrays
    660 
    661624          ar => ape%array_list(j)
    662625          myindex = 1
    663 
    664626          IF ( ar%nrdims == 2 )  THEN
    665 
    666627             buf_shape(1) = ape%nrele
    667628             CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
    … …  
    671632                myindex = myindex + 1
    672633             ENDDO
    673 
    674634          ELSEIF ( ar%nrdims == 3 )  THEN
    675 
    676635             buf_shape(1) = ape%nrele*ar%a_dim(4)
    677636             CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
    … …  
    682641                myindex = myindex + ar%a_dim(4)
    683642             ENDDO
    684 
    685643          ENDIF
    686 
    687644        ENDDO
    688 
    689     ENDDO
    690 
     645    ENDDO
    691646!
    692647!-- Buffer is filled
    … …  
    727682
    728683    t1 = pmc_time()
    729 
    730684!
    731685!-- Wait for child to fill buffer
    … …  
    733687    t2 = pmc_time() - t1
    734688    IF ( PRESENT( waittime ) )  waittime = t2
    735 
    736689!
    737690!-- TODO: check next statement
    … …  
    741694
    742695    DO  ip = 1, children(childid)%inter_npes
    743 
    744696       ape => children(childid)%pes(ip)
    745 
    746697       DO  j = 1, ape%nr_arrays
    747 
    748698          ar => ape%array_list(j)
    749 
     699         
    750700          IF ( ar%recvindex < 0 )  CYCLE
    751701
    … …  
    755705             nr = ape%nrele * ar%a_dim(4)
    756706          ENDIF
    757 
    758707          buf_shape(1) = nr
    759708          CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
    760 
    761709!
    762710!--       MPI passive target RMA
    763711          IF ( nr > 0 )  THEN
    764712             target_disp = ar%recvindex - 1
    765 
    766 !
    767 !--          Child PEs are located behind parent PEs
     713!
     714!--          Child processes are located behind parent process
    768715             target_pe = ip - 1 + m_model_npes
    769716             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED, target_pe, 0,                  &
    … …  
    774721                                  children(childid)%win_parent_child, ierr )
    775722          ENDIF
    776 
    777723          myindex = 1
    778724          IF ( ar%nrdims == 2 )  THEN
    779 
    780725             CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
    781726             DO  ij = 1, ape%nrele
    … …  
    783728                myindex = myindex + 1
    784729             ENDDO
    785 
    786730          ELSEIF ( ar%nrdims == 3 )  THEN
    787 
    788731             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3))
    789732             DO  ij = 1, ape%nrele
    … …  
    792735                myindex = myindex + ar%a_dim(4)
    793736             ENDDO
    794 
    795737          ENDIF
    796 
    797738       ENDDO
    798 
    799739    ENDDO
    800740
    … …  
    832772
    833773!
    834 !-- Set array for child inter PE 0
     774!-- Set array for child inter process 0
    835775    IMPLICIT NONE
    836776
    … …  
    849789
    850790    DO  i = 1, children(childid)%inter_npes
    851 
    852791       ape => children(childid)%pes(i)
    853792       ar  => ape%array_list(next_array_in_list)
    … …  
    855794       ar%a_dim  = dims
    856795       ar%data   = array_adr
    857 
    858796       IF ( PRESENT( second_adr ) )  THEN
    859797          ar%po_data(1) = array_adr
    … …  
    863801          ar%po_data(2) = C_NULL_PTR
    864802       ENDIF
    865 
    866803    ENDDO
    867804
    … …  
    885822
    886823    DO  ip = 1, children(childid)%inter_npes
    887 
    888824       ape => children(childid)%pes(ip)
    889 
    890825       DO  j = 1, ape%nr_arrays
    891 
    892826          ar => ape%array_list(j)
    893827          IF ( iactive == 1  .OR.  iactive == 2 )  THEN
    894828             ar%data = ar%po_data(iactive)
    895829          ENDIF
    896 
    897830       ENDDO
    898 
    899831    ENDDO
    900832
    … …  
    931863
    932864!
    933 !-- First, count entries for every remote child PE
     865!-- First, count entries for every remote child process
    934866    DO  i = 1, mychild%inter_npes
    935867       ape => mychild%pes(i)
    936868       ape%nrele = 0
    937869    ENDDO
    938 
    939870!
    940871!-- Loop over number of coarse grid cells
    941872    DO  j = 1, nrp
    942        rempe = index_list(5,j) + 1   ! PE number on remote PE
     873       rempe = index_list(5,j) + 1   ! process number on remote process
    943874       ape => mychild%pes(rempe)
    944        ape%nrele = ape%nrele + 1     ! Increment number of elements for this child PE
     875       ape%nrele = ape%nrele + 1     ! Increment number of elements for this child process
    945876    ENDDO
    946877
    … …  
    951882
    952883    remind = 0
    953 
    954884!
    955885!-- Second, create lists
    … …  
    963893       ape%locind(ind)%j = index_list(2,j)
    964894    ENDDO
    965 
    966 !
    967 !-- Prepare number of elements for children PEs
     895!
     896!-- Prepare number of elements for children processes
    968897    CALL pmc_alloc_mem( rldef, mychild%inter_npes*2 )
    969 
    970 !
    971 !-- Number of child PEs * size of INTEGER (i just arbitrary INTEGER)
     898!
     899!-- Number of child processes * size of INTEGER (i just arbitrary INTEGER)
    972900    winsize = mychild%inter_npes*c_sizeof(i)*2
    973901
    974902    CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL,                    &
    975903                         mychild%intra_comm, indwin, ierr )
    976 
    977904!
    978905!-- Open window to set data
    979906    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    980907
    981     rldef(1) = 0            ! index on remote PE 0
    982     rldef(2) = remind(1)    ! number of elements on remote PE 0
    983 
     908    rldef(1) = 0            ! index on remote process 0
     909    rldef(2) = remind(1)    ! number of elements on remote process 0
    984910!
    985911!-- Reserve buffer for index array
    986912    DO  i = 2, mychild%inter_npes
    987913       i2          = (i-1) * 2 + 1
    988        rldef(i2)   = rldef(i2-2) + rldef(i2-1) * 2  ! index on remote PE
    989        rldef(i2+1) = remind(i)                      ! number of elements on remote PE
    990     ENDDO
    991 
     914       rldef(i2)   = rldef(i2-2) + rldef(i2-1) * 2  ! index on remote process
     915       rldef(i2+1) = remind(i)                      ! number of elements on remote process
     916    ENDDO
    992917!
    993918!-- Close window to allow child to access data
    994919    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    995 
    996920!
    997921!-- Child has retrieved data
    … …  
    1000924    i2 = 2 * mychild%inter_npes - 1
    1001925    winsize = ( rldef(i2) + rldef(i2+1) ) * 2
    1002 
    1003926!
    1004927!-- Make sure, MPI_ALLOC_MEM works
    … …  
    1013936!-- Open window to set data
    1014937    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
    1015 
    1016938!
    1017939!-- Create the 2D index list
    1018940    DO  j = 1, nrp
    1019        rempe = index_list(5,j) + 1    ! PE number on remote PE
     941       rempe = index_list(5,j) + 1    ! process number on remote process
    1020942       ape => mychild%pes(rempe)
    1021943       i2    = rempe * 2 - 1
    … …  
    1025947       rldef(i2)      = rldef(i2)+2
    1026948    ENDDO
    1027 
    1028949!
    1029950!-- All data are set
    1030951    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
    1031 
    1032952!
    1033953!-- Don't know why, but this barrier is necessary before windows can be freed
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |