Back to OASIS3-MCT home

In oasis3-mct/lib/psmile/src :

mod_oasis_part.F90 :

No use anymore of gatherall to avoid memory problems : each proc send its data to the master proc

CONTAINS
SUBROUTINE oasis_def_partition (id_part, kparal, kinfo, ig_size, name)
=> oasis_debug_enter(subname)
if (.not. oasis_coupled) then
     call oasis_debug_exit(subname)
     return
endif
=> oasis_timer_start('part_definition')
=> oasis_part_zero(prism_part(prism_npart))
=> oasis_timer_stop('part_definition')
=> oasis_debug_exit(subname)

SUBROUTINE
oasis_part_setup() (see arborescence of the Psmile)
=> oasis_debug_enter(subname)
=> oasis_timer_start('part_setup')
allocate(pnum(mpi_size_local))
=> MPI_GATHER(prism_npart, 1, MPI_INTEGER, pnum, 1, MPI_INTEGER, 0, mpi_comm_local, ierr)   ! prism_npart = number of partitions (grids) defined o each proc
do n = 1,prism_npart
      loc_pname(n) = prism_part(n)%partname
enddo
do m = 1,mpi_size_local
     taskid = m - 1
=>
MPI_SEND(loc_pname, prism_npart*ic_lvar2, MPI_CHARACTER, 0, 900+m, mpi_comm_local, ierr)   ! each proc sends its data
=>
oasis_mpi_chkerr(ierr,subname//':send')
=>
MPI_RECV(loc_pname0, pnum(m)*ic_lvar2, MPI_CHARACTER, taskid, 900+m, mpi_comm_local, status, ierr)   ! the master receives the data of each proc
=>
oasis_mpi_chkerr(ierr,subname//':recv')
pcnt=pcnt+1
pname0(pcnt) = loc_pname0(n)
enddo  ! mpi_size_local
=>
oasis_mpi_bcast(pcnt,mpi_comm_local,subname//' pcnt')
if (mpi_rank_local == 0) then
      pname(1:pcnt) = pname0(1:pcnt)
endif
=
> oasis_mpi_bcast(pname,mpi_comm_local,subname//' pname')
To construct the gsmap (ie. the decomposition) it is necessary to define all partitions (grids) on all tasks and say that some have no data :
it means that we define prism_part(prism_npart) for all tasks with prism_part(prism_npart)%kpara(1:3)=0
Convert kparal information to data for the gsmap (ex: apple partition)
elseif (kparal(CLIM_Strategy) == CLIM_Apple) then
     nsegs = 1
     allocate(start(nsegs),length(nsegs))
     start (1) = kparal(CLIM_Offset) + 1
     length(1) = kparal(CLIM_Length)
     numel = nsegs
     if (length(1) == 0) numel = 0
endif
if (mpi_comm_local /= MPI_COMM_NULL) then
if (ig_size > 0) then
=>
mct_gsmap_init(prism_part(m)%gsmap,start,length,mpi_root_local, mpi_comm_local,compid,numel=numel,gsize=ig_size)
else
=> mct_gsmap_init(prism_part(m)%gsmap,start,length,mpi_root_local, mpi_comm_local,compid,numel=numel)
endif
=>
prism_part(m)%gsize = mct_gsmap_gsize(prism_part(m)%gsmap)
Creation of a communication with only the procs that have grids defined on them
icpl = MPI_UNDEFINED
if (numel > 0) icpl = 1
=> MPI_COMM_Split(mpi_comm_local,icpl,1,prism_part(m)%mpicom,ierr)
if (numel > 0) then
=> CALL MPI_Comm_Size ( prism_part(m)%mpicom, prism_part(m)%npes, ierr )
=> CALL MPI_Comm_Rank ( prism_part(m)%mpicom, prism_part(m)%rank, ierr )

if (ig_size > 0) then
=>
mct_gsmap_init(prism_part(m)%pgsmap,start,length,0, prism_part(m)%mpicom,compid,numel=numel,gsize=ig_size)
else
=>
mct_gsmap_init(prism_part(m)%pgsmap,start,length,0, prism_part(m)%mpicom,compid,numel=numel)
endif
prism_part(m)%mpicom = MPI_COMM_NULL
=>
oasis_timer_stop('part_setup')
=>
oasis_debug_exit(subname)