Homec4science
Diffusion FENNECS: Finite Element Non-Neutral Electron Cloud Simulator (geom_testpardiso) Browse

fennecs/src/mpihelper_mod.f90
bde8e520bdf2geom_testpardiso

Last Change
Raw File

mpihelper_mod.f90
View Options

MODULE mpihelper
USE constants
USE mpi
IMPLICIT NONE
TYPE BASICDATA
LOGICAL :: nlres, nlsave, newres, nlxg, nlppform, nlPhis, nlclassical
INTEGER :: nplasma, nz, it0d, it2d, itparts, &
& itgraph, distribtype, nblock, nrun
DOUBLE PRECISION :: job_time, extra_time, tmax, dt, &
& potinn, potout, B0, n0, temp, &
& Rcurv, width, H0, P0
INTEGER, DIMENSION(2) :: femorder, ngauss
INTEGER, DIMENSION(3) :: nnr
DOUBLE PRECISION, DIMENSION(2):: lz
DOUBLE PRECISION, DIMENSION(4):: radii, plasmadim
CHARACTER(len=64) :: resfile= "results.h5"
END TYPE BASICDATA
TYPE particle
INTEGER :: Rindex, Zindex
DOUBLE PRECISION :: R, Z, &
& UZ, UR, UTHET, &
& Gamma
END TYPE particle
INTEGER, SAVE :: basicdata_type
INTEGER, SAVE :: particle_type
INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: rhscol_type
INTEGER, SAVE:: rhsoverlap_type
INTEGER, DIMENSION(:), ALLOCATABLE, SAVE:: rhsrequests, rhsoverlaprequests
INTEGER:: rhscommtag=10, rhsoverlapcommtag = 15
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, SAVE:: rhsoverlap
CONTAINS
!=========================================================================
SUBROUTINE init_mpitypes
CALL init_particlempi
CALL init_basicdatampi
END SUBROUTINE init_mpitypes
!=========================================================================
SUBROUTINE init_rhsvectormpi(Zbounds, nz, nrankz, nrankr, rhs)
INTEGER, INTENT(in):: nrankr, nrankz, nz
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE, INTENT(in):: rhs
INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(in):: Zbounds
INTEGER:: i, dz, mpisize, process, zoverlap, mpirank, ierr
CALL MPI_Comm_size(MPI_COMM_WORLD, mpisize, ierr)
CALL MPI_Comm_rank(MPI_COMM_WORLD, mpirank, ierr)
ALLOCATE(rhscol_type(0:mpisize-1), rhsrequests(mpisize-1), rhsoverlaprequests(2))
rhsrequests=MPI_REQUEST_NULL
rhsoverlaprequests=MPI_REQUEST_NULL
DO i=0,mpisize-1
dz=Zbounds(i+1)-Zbounds(i)
CALL MPI_Type_vector(nrankr, dz, nrankz, MPI_DOUBLE_PRECISION, rhscol_type(i), ierr)
CALL MPI_Type_commit(rhscol_type(i), ierr)
END DO
zoverlap=nrankz-nz
CALL MPI_Type_vector(nrankr, zoverlap, nrankz, MPI_DOUBLE_PRECISION, rhsoverlap_type, ierr)
CALL MPI_Type_commit(rhsoverlap_type, ierr)
! initialize persistent communication for rhs
IF (mpirank .eq. 0) THEN
DO process=1, mpisize-1
CALL MPI_Recv_init(rhs(Zbounds(process)+1+zoverlap), 1, rhscol_type(process), &
& process, rhscommtag, MPI_COMM_WORLD, rhsrequests(process), ierr )
END DO
ELSE
CALL MPI_Send_init(rhs(Zbounds(mpirank)+1+zoverlap), 1, rhscol_type(mpirank), &
& 0, rhscommtag, MPI_COMM_WORLD, rhsrequests(mpirank), ierr )
END IF
! initialize persistent communication for overlap region in rhs
ALLOCATE(rhsoverlap(zoverlap*nrankr))
DO process=1, mpisize-1
IF(mpirank .eq. process) CALL MPI_Send_init(rhs(Zbounds(process)+1), 1, rhsoverlap_type, process-1, rhsoverlapcommtag, MPI_COMM_WORLD, rhsoverlaprequests(1), ierr)
IF(mpirank .eq. process-1) CALL MPI_Recv_init(rhsoverlap, nrankr*zoverlap, MPI_DOUBLE_PRECISION, process, rhsoverlapcommtag, MPI_COMM_WORLD, rhsoverlaprequests(2), ierr)
END DO
END SUBROUTINE
!=========================================================================
SUBROUTINE init_particlempi()
INTEGER :: nblock = 8
INTEGER:: blocklength(8)
INTEGER(kind=MPI_ADDRESS_KIND):: displs(8), displ0
INTEGER, DIMENSION(8) :: types
TYPE(particle) :: part
INTEGER:: ierr
CALL mpi_get_address(part%Rindex, displs(1), ierr)
CALL mpi_get_address(part%Zindex, displs(2), ierr)
types(1:2)=MPI_INTEGER
CALL mpi_get_address(part%R, displs(3), ierr)
CALL mpi_get_address(part%Z, displs(4), ierr)
CALL mpi_get_address(part%UZ, displs(5), ierr)
CALL mpi_get_address(part%UR, displs(6), ierr)
CALL mpi_get_address(part%UTHET, displs(7), ierr)
CALL mpi_get_address(part%GAMMA, displs(8), ierr)
types(3:8)=MPI_DOUBLE_PRECISION
blocklength(1:8) = 1
CALL mpi_get_address(part, displ0, ierr)
displs=displs-displ0
CALL MPI_Type_create_struct(nblock, blocklength, displs, types, particle_type, ierr)
CALL MPI_Type_commit(particle_type,ierr)
END SUBROUTINE init_particlempi
!=========================================================================
SUBROUTINE init_basicdatampi()
INTEGER :: nblock = 36
INTEGER:: blocklength(36)
INTEGER(kind=MPI_ADDRESS_KIND):: displs(36), displ0
INTEGER, DIMENSION(36) :: types
TYPE(BASICDATA) :: bdata
INTEGER:: ierr
CALL mpi_get_address(bdata%nlres, displs(1), ierr)
CALL mpi_get_address(bdata%nlsave, displs(2), ierr)
CALL mpi_get_address(bdata%newres, displs(3), ierr)
CALL mpi_get_address(bdata%nlxg, displs(4), ierr)
CALL mpi_get_address(bdata%nlppform, displs(5), ierr)
CALL mpi_get_address(bdata%nlPhis, displs(6), ierr)
CALL mpi_get_address(bdata%nlclassical, displs(7), ierr)
types(1:7)=MPI_LOGICAL
CALL mpi_get_address(bdata%nplasma, displs(8), ierr)
CALL mpi_get_address(bdata%nz, displs(9), ierr)
CALL mpi_get_address(bdata%it0d, displs(10), ierr)
CALL mpi_get_address(bdata%it2d, displs(11), ierr)
CALL mpi_get_address(bdata%itparts, displs(12), ierr)
CALL mpi_get_address(bdata%itgraph, displs(13), ierr)
CALL mpi_get_address(bdata%distribtype, displs(14), ierr)
CALL mpi_get_address(bdata%nblock, displs(15), ierr)
CALL mpi_get_address(bdata%nrun, displs(16), ierr)
types(8:16)=MPI_INTEGER
CALL mpi_get_address(bdata%job_time, displs(17), ierr)
CALL mpi_get_address(bdata%extra_time, displs(18), ierr)
CALL mpi_get_address(bdata%tmax, displs(19), ierr)
CALL mpi_get_address(bdata%dt, displs(20), ierr)
CALL mpi_get_address(bdata%potinn, displs(21), ierr)
CALL mpi_get_address(bdata%potout, displs(22), ierr)
CALL mpi_get_address(bdata%B0, displs(23), ierr)
CALL mpi_get_address(bdata%n0, displs(24), ierr)
CALL mpi_get_address(bdata%temp, displs(25), ierr)
CALL mpi_get_address(bdata%Rcurv, displs(26), ierr)
CALL mpi_get_address(bdata%width, displs(27), ierr)
CALL mpi_get_address(bdata%H0, displs(28), ierr)
CALL mpi_get_address(bdata%P0, displs(29), ierr)
types(17:29)=MPI_DOUBLE_PRECISION
blocklength(1:29) = 1
CALL mpi_get_address(bdata%femorder, displs(30), ierr)
CALL mpi_get_address(bdata%ngauss, displs(31), ierr)
CALL mpi_get_address(bdata%nnr, displs(32), ierr)
types(30:32)=MPI_INTEGER
blocklength(30:31) = 2
blocklength(32) = 3
CALL mpi_get_address(bdata%lz, displs(33), ierr)
blocklength(33) = 2
CALL mpi_get_address(bdata%radii, displs(34), ierr)
CALL mpi_get_address(bdata%plasmadim, displs(35), ierr)
types(33:35)=MPI_DOUBLE_PRECISION
blocklength(34:35) = 4
CALL mpi_get_address(bdata%resfile, displs(36), ierr)
types(36)=MPI_CHARACTER
blocklength(36) = 64
CALL mpi_get_address(bdata, displ0, ierr)
displs=displs-displ0
CALL MPI_Type_create_struct(nblock, blocklength, displs, types, basicdata_type, ierr)
CALL MPI_Type_commit(basicdata_type,ierr)
END SUBROUTINE init_basicdatampi
!=========================================================================
END MODULE mpihelper
c4science · Help