Homec4science
Diffusion COSOlver (improved_sugama) Browse

cosolver/src/ppsync_e.f90
cd1286e2d410improved_sugama

Last Change
Raw File

ppsync_e.f90
View Options

SUBROUTINE ppsync_e
!
! MPI sync electrion collisional matrices between processors
!
USE basic_mpi
USE basic
USE model
USE array
!
IMPLICIT NONE
!
! local vars.
! MPI COMM.
INTEGER :: SUBTYPE_T,SUBTYPE_F
INTEGER :: to,from,tag,iproc
INTEGER :: STATUS(MPI_STATUS_SIZE)
INTEGER, DIMENSION(:), allocatable :: buff_
!
to = 0
!
IF(Cenproc > 1 ) THEN
!
IF( me_e .eq. 0 ) THEN
IF(ALLOCATED(buff_)) DEALLOCATE(buff_)
CALL ALLOCATE_ARRAY(buff_,1,2*Cenproc)
ENDIF
!
! MPI COMM Test matrices
!
CALL MPI_GATHER(sizes_e_T(me_e,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_e,ierr)
!
IF(me_e .eq. 0) THEN
DO iproc = 0,Cenproc-1
sizes_e_T(iproc,1) = buff_(2*iproc +1)
sizes_e_T(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
CALL MPI_GATHER(subsizes_e_T(me_e,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_e,ierr)
!
IF(me_e .eq. 0) THEN
DO iproc = 0,Cenproc-1
subsizes_e_T(iproc,1) = buff_(2*iproc +1)
subsizes_e_T(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
CALL MPI_GATHER(starts_e_T(me_e,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_e,ierr)
!
IF(me_e .eq. 0) THEN
DO iproc = 0,Cenproc-1
starts_e_T(iproc,1) = buff_(2*iproc +1)
starts_e_T(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
!
! MPI COMM Field matrices
!
CALL MPI_GATHER(sizes_e_F(me_e,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_e,ierr)
!
IF(me_e .eq. 0) THEN
DO iproc = 0,Cenproc-1
sizes_e_F(iproc,1) = buff_(2*iproc +1)
sizes_e_F(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
! !
CALL MPI_GATHER(subsizes_e_F(me_e,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_e,ierr)
!
IF(me_e .eq. 0) THEN
DO iproc = 0,Cenproc-1
subsizes_e_F(iproc,1) = buff_(2*iproc +1)
subsizes_e_F(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
CALL MPI_GATHER(starts_e_F(me_e,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_e,ierr)
!
IF(me_e .eq. 0) THEN
DO iproc = 0,Cenproc-1
starts_e_F(iproc,1) = buff_(2*iproc +1)
starts_e_F(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
!
DO iproc =0,Cenproc-1
!
! 1.1 MPI SYNC TEST electrons
!___________________________________________________________________
IF(ETEST .ne. 0) THEN
tag = 2*iproc + 2
IF( me .eq. 0 .and. iproc .ge. 1 ) THEN
CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_e_T(iproc,:),subsizes_e_T(iproc,:),starts_e_T(iproc,:), &
MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
SUBTYPE_T,ierr)
CALL MPI_TYPE_COMMIT(SUBTYPE_T,ierr)
ENDIF
IF( me .eq. iproc .and. me .ne. 0) THEN
!
CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_e_T(me,:),subsizes_e_T(me,:),starts_e_T(me,:), &
MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
SUBTYPE_T,ierr)
CALL MPI_TYPE_COMMIT(SUBTYPE_T,ierr)
!
ENDIF
!
!
! send CeiTdp to root = o proc
IF(me .eq. 0 .and. iproc .ne. 0 ) THEN ! ... send to the root proc.
CALL MPI_RECV(CeiTdp,1,SUBTYPE_T,iproc,tag,comm_e,status,ierr)
ELSEIF( me .eq. iproc .and. me .ne. 0 ) THEN
CALL MPI_SEND(CeiTdp,1,SUBTYPE_T,to,tag,comm_e,ierr)
ENDIF
!
ENDIF
!
!
! 1.2 MPI SYNC Field electrons
!___________________________________________________________________
IF(EBACK .ne. 0) THEN
tag = 2*iproc + 1
IF( me .eq. 0 .and. iproc .ge. 1 ) THEN
CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_e_F(iproc,:),subsizes_e_F(iproc,:),starts_e_F(iproc,:), &
MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
SUBTYPE_F,ierr)
CALL MPI_TYPE_COMMIT(SUBTYPE_F,ierr)
ENDIF
IF( me .eq. iproc .and. me .ne. 0) THEN
!
CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_e_F(me,:),subsizes_e_F(me,:),starts_e_F(me,:), &
MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
SUBTYPE_F,ierr)
CALL MPI_TYPE_COMMIT(SUBTYPE_F,ierr)
!
ENDIF
!
!
! send CeiFdp to root = o proc
IF(me .eq. 0 .and. iproc .ne. 0 ) THEN ! ... send to the root proc.
CALL MPI_RECV(CeiFdp,1,SUBTYPE_F,iproc,tag,comm_e,status,ierr)
ELSEIF( me .eq. iproc .and. me .ne. 0 ) THEN
CALL MPI_SEND(CeiFdp,1,SUBTYPE_F,to,tag,comm_e,ierr)
ENDIF
!
ENDIF
!
ENDDO
!
! clear MPI user-defined datatype
IF( ETEST .ne. 0) CALL MPI_TYPE_FREE(SUBTYPE_T,ierr)
IF( EBACK .ne. 0) CALL MPI_TYPE_FREE(SUBTYPE_F,ierr)
!
ENDIF
!
END SUBROUTINE ppsync_e
c4science · Help