Homec4science
Diffusion COSOlver (master) Browse

cosolver/src/ppsetup.f90
5b66a09e0f20master

Last Change
Raw File

ppsetup.f90
View Options

SUBROUTINE PPSETUP
!
! sets up the MPI topology and distribute the work betwen the nprocs
!
use prec_const
use basic
USE basic_mpi
use grid
use model
!
IMPLICIT NONE
!
INTEGER :: iproc =0
!
! loc. vars.
INTEGER :: ii, nloc
INTEGER :: dims(2)
LOGICAL :: is_periodic(2)
LOGICAL :: reorder
INTEGER :: Ngroups
!
IF(nprocs > 1 ) THEN
!
! Generate an 1D topology: the collisional rows are shared with procesors
!
lbaremax = numbe(Pmaxe,Jmaxe)
lbarimax = numbi(Pmaxi,Jmaxi)
!
IF(IFGKCoulomb) THEN
IF( .not. GKC_USE_OPT) THEN
lbarimax = numbi(Pmaxi,Jmaxi)*(npiFLR+1)*(niFLR - niFLRs+1)*(JEmaxx+1)
lbaremax = numbe(Pmaxe,Jmaxe)*(npeFLR+1)*(neFLR - neFLRs+1)*(JEmaxx+1)
ELSE
lbarimax = numbi(Pmaxi,Jmaxi)*(npiFLR+1)*(JEmaxx+1)
lbaremax = numbe(Pmaxe,Jmaxe)*(npeFLR+1)*(JEmaxx+1)
ENDIF
ENDIF
!
! Create MPI group E/I/SELF
Ngroups = 0
IF(eicolls) Ngroups = Ngroups +1
IF(iecolls) Ngroups = Ngroups +1
IF(eecolls .or. iicolls) Ngroups = Ngroups +1
!
! Assign group ranks
!
iproc = 0
IF(eicolls) THEN
ALLOCATE(ranks_e(1:nprocs_ei))
DO ii=1, nprocs_ei
ranks_e(ii) = ii-1
ENDDO
iproc = nprocs_ei
ENDIF
!
IF(iecolls) THEN
ALLOCATE(ranks_i(1:nprocs_ie))
DO ii=1, nprocs_ie
ranks_i(ii) = iproc + ii -1
ENDDO
iproc = iproc + nprocs_ie
ENDIF
!
IF(eecolls .or. iicolls) THEN
ALLOCATE(ranks_self(1:nprocs_self))
DO ii=1,nprocs_self
ranks_self(ii) = iproc + ii -1
ENDDO
ENDIF
!
! CREATE Groups
CALL MPI_COMM_GROUP(MPI_COMM_WORLD,grp_world,ierr)
!
IF(eicolls) THEN
CALL MPI_GROUP_INCL(grp_world, nprocs_ei , ranks_e,grp_e,ierr)
CALL MPI_GROUP_RANK(grp_e,me_e,ierr)
CALL MPI_COMM_CREATE_GROUP(MPI_COMM_WORLD,grp_e,0,comm_e,ierr)
IF(me_e .ne. MPI_UNDEFINED ) is_e = .true.
ENDIF
!
IF(iecolls) THEN
CALL MPI_GROUP_INCL(grp_world, nprocs_ie ,ranks_i,grp_i,ierr)
CALL MPI_GROUP_RANK(grp_i,me_i,ierr)
CALL MPI_COMM_CREATE_GROUP(MPI_COMM_WORLD,grp_i,0,comm_i,ierr)
IF(me_i.ne. MPI_UNDEFINED) is_i = .true.
ENDIF
!
IF(eecolls .or. iicolls) THEN
CALL MPI_GROUP_INCL(grp_world, nprocs_self, ranks_self, grp_self, ierr)
CALL MPI_GROUP_RANK(grp_self,me_self,ierr)
CALL MPI_COMM_CREATE_GROUP(MPI_COMM_WORLD, grp_self, 0, comm_self,ierr)
IF(me_self .ne. MPI_UNDEFINED) is_self = .true.
!
ENDIF
!
IF( me .eq. 0) print*, 'Set MPI parrallel environnement ...'
IF(eicolls .and. is_e ) THEN
call dist1d(comm_e, 1, lbaremax, lbare_s_l, nloc)
lbare_e_l = lbare_s_l + nloc -1
print*, 'local e indices (me/start/end): ', lbare_s_l, lbare_e_l, nloc
ENDIF
IF(iecolls .and. is_i ) THEN
call dist1d(comm_i, 1, lbarimax, lbari_s_l, nloc)
lbari_e_l = lbari_s_l + nloc -1
print*, 'local i indices (me/start/end): ',lbari_s_l, lbari_e_l, nloc
ENDIF
IF( eecolls .and. is_self ) THEN
call dist1d(comm_self, 1, lbaremax, lbaree_s_l, nloc)
lbaree_e_l = lbaree_s_l + nloc -1
print*,'local ee indices (me/start/end): ', lbaree_s_l, lbaree_e_l, nloc
ENDIF
IF( iicolls .and. is_self ) THEN
call dist1d(comm_self, 1, lbarimax, lbarii_s_l, nloc)
lbarii_e_l = lbarii_s_l + nloc -1
print*, 'local ii indices: ',lbarii_s_l, lbarii_e_l, nloc
ENDIF
!
ELSE
lbare_e_l = numbe(Pmaxe,Jmaxe)
lbare_s_l = 1
lbari_e_l = numbi(Pmaxi,Jmaxi)
lbari_s_l = 1
lbaree_s_l = 1
lbaree_e_l = numbe(Pmaxe,Jmaxe)
lbarii_s_l = 1
lbarii_e_l = numbi(Pmaxi,Jmaxi)
IF( .not. GKC_USE_OPT) THEN
IF( iicolls .and. IFGKCOULOMB) lbarii_e_l = numbi(Pmaxi,Jmaxi)*(npiFLR+1)*(niFLR - niFLRs+1)*(JEmaxx+1)
IF( eecolls .and. IFGKCOULOMB) lbaree_e_l = numbe(Pmaxe,Jmaxe)*(npeFLR+1)*(neFLR - neFLRs+1)*(JEmaxx+1)
IF( eicolls .and. IFGKCOULOMB) lbare_e_l = numbe(Pmaxe,Jmaxe)*(npeFLR+1)*(neFLR - neFLRs+1)*(JEmaxx+1)
IF( iecolls .and. IFGKCOULOMB) lbari_e_l = numbi(Pmaxi,Jmaxi)*(npiFLR+1)*(niFLR - niFLRs+1)*(JEmaxx+1)
lbarimax = lbarii_e_l
lbaremax = lbaree_e_l
ELSE
IF( iicolls .and. IFGKCOULOMB) lbarii_e_l = numbi(Pmaxi,Jmaxi)*(npiFLR+1)*(JEmaxx+1)
IF( eecolls .and. IFGKCOULOMB) lbaree_e_l = numbe(Pmaxe,Jmaxe)*(npeFLR+1)*(JEmaxx+1)
IF( eicolls .and. IFGKCOULOMB) lbare_e_l = numbe(Pmaxe,Jmaxe)*(npeFLR+1)*(JEmaxx+1)
IF( iecolls .and. IFGKCOULOMB) lbari_e_l = numbi(Pmaxi,Jmaxi)*(npiFLR+1)*(JEmaxx+1)
lbarimax = lbarii_e_l
lbaremax = lbaree_e_l
ENDIF
comm_e = MPI_COMM_WORLD
comm_i = MPI_COMM_WORLD
comm_self = MPI_COMM_WORLD
comm_cart_self = MPI_COMM_WORLD
me_e = 0
me_i= 0
me_self =0
!
is_e = .true.
is_i = .true.
is_self = .true.
!
ENDIF
!
CALL mpi_barrier(MPI_COMM_WORLD,ierr)
!
END SUBROUTINE PPSETUP
!
SUBROUTINE dist1d(comm, s0, ntot, s, nloc)
!
! 1d distribute ntot elements, returns offset s and local number of
! elements nloc.
!
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: comm, me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(comm, npes, ierr)
CALL MPI_COMM_RANK(comm, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
c4science · Help