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_child_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
    … …  
    171174     CALL MPI_COMM_SIZE( me%model_comm, me%model_npes, istat )
    172175     CALL MPI_COMM_REMOTE_SIZE( me%inter_comm, me%inter_npes, istat )
    173 
    174 !
    175 !--  Intra-communicater is used for MPI_GET
     176!
     177!--  Intra-communicator is used for MPI_GET
    176178     CALL MPI_INTERCOMM_MERGE( me%inter_comm, .TRUE., me%intra_comm, istat )
    177179     CALL MPI_COMM_RANK( me%intra_comm, me%intra_rank, istat )
    178180
    179181     ALLOCATE( me%pes(me%inter_npes) )
    180 
    181 !
    182 !--  Allocate an array of type arraydef for all parent PEs to store information
    183 !--  of then transfer array
     182!
     183!--  Allocate an array of type arraydef for all parent processes to store
     184!--  information of then transfer array
    184185     DO  i = 1, me%inter_npes
    185186        ALLOCATE( me%pes(i)%array_list(pmc_max_array) )
    … …  
    201202
    202203    INTEGER, INTENT(OUT) ::  istat  !<
    203 
    204204!
    205205!-- Local variables
    … …  
    211211
    212212    istat = pmc_status_ok
    213 
    214213!
    215214!-- Check length of array names
    … …  
    229228
    230229!
    231 !-- Broadcat to all child PEs
     230!-- Broadcast to all child processes
    232231!-- TODO: describe what is broadcast here and why it is done
    233232    CALL pmc_bcast( myname%couple_index, 0, comm=m_model_comm )
    … …  
    236235    CALL pmc_bcast( myname%childdesc,    0, comm=m_model_comm )
    237236    CALL pmc_bcast( myname%nameonchild,  0, comm=m_model_comm )
    238 
    239 !
    240 !-- Broadcat to all parent PEs
     237!
     238!-- Broadcast to all parent processes
    241239!-- TODO: describe what is broadcast here and why it is done
    242240    IF ( m_model_rank == 0 )  THEN
    … …  
    263261
    264262    LOGICAL, INTENT(IN), OPTIONAL ::  lastentry  !<
    265 
    266263!
    267264!-- Local variables
    … …  
    290287    INTEGER :: i, ierr, i2, j, nr  !<
    291288    INTEGER :: indwin              !< MPI window object
    292     INTEGER :: indwin2  !          < MPI window object
     289    INTEGER :: indwin2             !< MPI window object
    293290
    294291    INTEGER(KIND=MPI_ADDRESS_KIND) :: win_size !< Size of MPI window 1 (in bytes)
    … …  
    306303    CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,    &
    307304                         indwin, ierr )
    308 
    309305!
    310306!-- Open window on parent side
    311307!-- TODO: why is the next MPI routine called twice??
    312308    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    313 
    314309!
    315310!-- Close window on parent side and open on child side
    … …  
    321316                     MPI_INTEGER, indwin, ierr )
    322317    ENDDO
    323 
    324318!
    325319!-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is
    326320!-- called
    327321    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    328 
    329322!
    330323!-- Allocate memory for index array
    … …  
    344337    ALLOCATE( myind(2*winsize) )
    345338    winsize = 1
    346 
    347339!
    348340!-- Local buffer used in MPI_GET can but must not be inside the MPI Window.
    349 !-- Here, we use a dummy for the MPI window because the parent PEs do not access
    350 !-- the RMA window via MPI_GET or MPI_PUT
     341!-- Here, we use a dummy for the MPI window because the parent processes do
     342!-- not access the RMA window via MPI_GET or MPI_PUT
    351343    CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm,     &
    352344                         indwin2, ierr )
    353 
    354345!
    355346!-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is
    … …  
    377368       ENDIF
    378369    ENDDO
    379 
    380370!
    381371!-- Don't know why, but this barrier is necessary before we can free the windows
    … …  
    406396!--  pmc_interface
    407397     CHARACTER(LEN=*), INTENT(OUT) ::  myname  !<
    408 
    409398!
    410399!-- Local variables
    … …  
    414403
    415404    next_array_in_list = next_array_in_list + 1
    416 
    417 !
    418 !-- Array names are the same on all child PEs, so take first PE to get the name
     405!
     406!-- Array names are the same on all child PEs, so take first process to
     407!-- get the name   
    419408    ape => me%pes(1)
    420 
    421409!
    422410!-- Check if all arrays have been processed
    … …  
    429417
    430418    myname = ar%name
    431 
    432419!
    433420!-- Return true if legal array
    … …  
    545532    myindex = 0
    546533    bufsize = 8
    547 
    548534!
    549535!-- Parent to child direction.
    550536!-- First stride: compute size and set index
    551537    DO  i = 1, me%inter_npes
    552 
    553538       ape => me%pes(i)
    554539       tag = 200
    555 
    556540       DO  j = 1, ape%nr_arrays
    557 
    558541          ar => ape%array_list(j)
    559 
    560542!
    561543!--       Receive index from child
    … …  
    564546                         MPI_STATUS_IGNORE, ierr )
    565547          ar%recvindex = myindex
    566 
    567548!
    568549!--       Determine max, because child buffer is allocated only once
    … …  
    573554             bufsize = MAX( bufsize, ar%a_dim(1)*ar%a_dim(2) )
    574555          ENDIF
    575 
    576556       ENDDO
    577 
    578     ENDDO
    579 
     557    ENDDO
    580558!
    581559!-- Create RMA (one sided communication) data buffer.
    … …  
    584562    CALL pmc_alloc_mem( base_array_pc, bufsize, base_ptr )
    585563    me%totalbuffersize = bufsize*wp  ! total buffer size in byte
    586 
    587564!
    588565!-- Second stride: set buffer pointer
    589566    DO  i = 1, me%inter_npes
    590 
    591567       ape => me%pes(i)
    592 
    593568       DO  j = 1, ape%nr_arrays
    594569          ar => ape%array_list(j)
    595570          ar%recvbuf = base_ptr
    596571       ENDDO
    597 
    598     ENDDO
    599 
     572    ENDDO
    600573!
    601574!-- Child to parent direction
    … …  
    605578
    606579    DO  i = 1, me%inter_npes
    607 
    608580       ape => me%pes(i)
    609581       tag = 300
    610 
    611582       DO  j = 1, ape%nr_arrays
    612 
    613583          ar => ape%array_list(j)
    614584          IF( ar%nrdims == 2 )  THEN
    … …  
    617587             arlen = ape%nrele*ar%a_dim(1)
    618588          ENDIF
    619 
    620589          tag    = tag + 1
    621590          rcount = rcount + 1
    … …  
    629598             ar%sendindex = noindex
    630599          ENDIF
    631 
    632600!
    633601!--       Maximum of 1024 outstanding requests
    634 !--       TODO: explain where this maximum comes from (arbitrary?)
     602!--       TODO: explain where this maximum comes from (arbitrary?).
     603!--       Outstanding = pending?
    635604          IF ( rcount == 1024 )  THEN
    636605             CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
    … …  
    651620
    652621    ENDDO
    653 
    654622!
    655623!-- Create RMA (one sided communication) window for data buffer child to parent
    … …  
    670638    CALL MPI_WIN_FENCE( 0, me%win_parent_child, ierr )
    671639    CALL MPI_BARRIER( me%intra_comm, ierr )
    672 
    673640!
    674641!-- Second stride: set buffer pointer
    675642    DO  i = 1, me%inter_npes
    676 
    677643       ape => me%pes(i)
    678 
    679644       DO  j = 1, ape%nr_arrays
    680 
    681           ar => ape%array_list(j)
    682 
     645          ar => ape%array_list(j)         
    683646          IF ( ape%nrele > 0 )  THEN
    684647             ar%sendbuf = C_LOC( base_array_cp(ar%sendindex) )
    685 
    686648!
    687649!--          TODO: if this is an error to be really expected, replace the
    … …  
    695657             ENDIF
    696658          ENDIF
    697 
    698659       ENDDO
    699 
    700660    ENDDO
    701661
    … …  
    743703       waittime = t2 - t1
    744704    ENDIF
    745 
    746705!
    747706!-- Wait for buffer is filled.
    … …  
    753712
    754713    DO  ip = 1, me%inter_npes
    755 
    756714       ape => me%pes(ip)
    757 
    758715       DO  j = 1, ape%nr_arrays
    759 
    760716          ar => ape%array_list(j)
    761 
    762717          IF ( ar%nrdims == 2 )  THEN
    763718             nr = ape%nrele
    … …  
    765720             nr = ape%nrele * ar%a_dim(1)
    766721          ENDIF
    767 
    768722          buf_shape(1) = nr
    769723          CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
    770 
    771724!
    772725!--       MPI passive target RMA
    … …  
    780733             CALL MPI_WIN_UNLOCK( ip-1, me%win_parent_child, ierr )
    781734          ENDIF
    782 
    783735          myindex = 1
    784736          IF ( ar%nrdims == 2 )  THEN
    785 
    786737             CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
    787 
    788738             DO  ij = 1, ape%nrele
    789739                data_2d(ape%locind(ij)%j,ape%locind(ij)%i) = buf(myindex)
    790740                myindex = myindex + 1
    791741             ENDDO
    792 
    793742          ELSEIF ( ar%nrdims == 3 )  THEN
    794 
    795743             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
    796 
    797744             DO  ij = 1, ape%nrele
    798745                data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) =                  &
    … …  
    800747                myindex = myindex+ar%a_dim(1)
    801748             ENDDO
    802 
    803           ENDIF
    804 
     749          ENDIF
    805750       ENDDO
    806 
    807751    ENDDO
    808752
    … …  
    849793
    850794    DO  ip = 1, me%inter_npes
    851 
    852795       ape => me%pes(ip)
    853 
    854796       DO  j = 1, ape%nr_arrays
    855 
    856797          ar => aPE%array_list(j)
    857798          myindex = 1
    858 
    859799          IF ( ar%nrdims == 2 )  THEN
    860 
    861800             buf_shape(1) = ape%nrele
    862801             CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
    863802             CALL C_F_POINTER( ar%data,    data_2d, ar%a_dim(1:2) )
    864 
    865803             DO  ij = 1, ape%nrele
    866804                buf(myindex) = data_2d(ape%locind(ij)%j,ape%locind(ij)%i)
    867805                myindex = myindex + 1
    868806             ENDDO
    869 
    870807          ELSEIF ( ar%nrdims == 3 )  THEN
    871 
    872808             buf_shape(1) = ape%nrele*ar%a_dim(1)
    873809             CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
    874810             CALL C_F_POINTER( ar%data,    data_3d, ar%a_dim(1:3) )
    875 
    876811             DO  ij = 1, ape%nrele
    877812                buf(myindex:myindex+ar%a_dim(1)-1) =                            &
    … …  
    879814                myindex = myindex + ar%a_dim(1)
    880815             ENDDO
    881 
    882           ENDIF
    883 
     816          ENDIF
    884817       ENDDO
    885 
    886     ENDDO
    887 
     818    ENDDO
    888819!
    889820!-- TODO: Fence might do it, test later
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |