Homec4science
Diffusion COSOlver (improved_sugama) Browse

cosolver/src/ppsync_i.f90
cd1286e2d410improved_sugama

Last Change
Raw File

ppsync_i.f90
View Options

SUBROUTINE ppsync_i
!
! MPI sync ion collisional matrices between processors
!
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(Cinproc > 1) THEN
!
IF( me_i .eq. 0 ) THEN
IF(ALLOCATED(buff_)) DEALLOCATE(buff_)
CALL ALLOCATE_ARRAY(buff_,1,2*Cinproc)
ENDIF
!
! MPI COMM Test matrices
!
CALL MPI_GATHER(sizes_i_T(me_i,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_i,ierr)
!
IF(me_i .eq. 0) THEN
DO iproc = 0,Cinproc-1
sizes_i_T(iproc,1) = buff_(2*iproc +1)
sizes_i_T(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
CALL MPI_GATHER(subsizes_i_T(me_i,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_i,ierr)
!
IF(me_i .eq. 0) THEN
DO iproc = 0,Cinproc-1
subsizes_i_T(iproc,1) = buff_(2*iproc +1)
subsizes_i_T(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
CALL MPI_GATHER(starts_i_T(me_i,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_i,ierr)
!
IF(me_i .eq. 0) THEN
DO iproc = 0,Cinproc-1
starts_i_T(iproc,1) = buff_(2*iproc +1)
starts_i_T(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
!
! MPI COMM Field matrices
!
CALL MPI_GATHER(sizes_i_F(me_i,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_i,ierr)
!
IF(me_i .eq. 0) THEN
DO iproc = 0,Cinproc-1
sizes_i_F(iproc,1) = buff_(2*iproc +1)
sizes_i_F(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
! !
CALL MPI_GATHER(subsizes_i_F(me_i,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_i,ierr)
!
IF(me_i .eq. 0) THEN
DO iproc = 0,Cinproc-1
subsizes_i_F(iproc,1) = buff_(2*iproc +1)
subsizes_i_F(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
CALL MPI_GATHER(starts_i_F(me_i,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_i,ierr)
!
IF(me_i .eq. 0) THEN
DO iproc = 0,Cinproc-1
starts_i_F(iproc,1) = buff_(2*iproc +1)
starts_i_F(iproc,2) = buff_(2*iproc +2)
ENDDO
ENDIF
!
!
DO iproc =0,Cinproc-1
!
! 1.1 MPI SYNC TEST ions
!___________________________________________________________________
IF(ITEST .ne. 0) THEN
tag = 2*iproc + 2
IF( me_i .eq. 0 .and. iproc .ge. 1 ) THEN
CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_i_T(iproc,:),subsizes_i_T(iproc,:),starts_i_T(iproc,:), &
MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
SUBTYPE_T,ierr)
CALL MPI_TYPE_COMMIT(SUBTYPE_T,ierr)
ENDIF
IF( me_i .eq. iproc .and. me_i .ne. 0) THEN
!
CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_i_T(me_i,:),subsizes_i_T(me_i,:),starts_i_T(me_i,:), &
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_i .eq. 0 .and. iproc .ne. 0 ) THEN ! ... send to the root proc.
CALL MPI_RECV(CieTdp,1,SUBTYPE_T,iproc,tag,comm_i,status,ierr)
ELSEIF( me_i .eq. iproc .and. me_i .ne. 0 ) THEN
CALL MPI_SEND(CieTdp,1,SUBTYPE_T,to,tag,comm_i,ierr)
ENDIF
ENDIF
!
!
! 2.2 MPI SYNC Field IONS
!___________________________________________________________________
IF(IBACK .ne. 0) THEN
tag = 2*iproc + 1
IF( me_i .eq. 0 .and. iproc .ge. 1 ) THEN
CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_i_F(iproc,:),subsizes_i_F(iproc,:),starts_i_F(iproc,:), &
MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
SUBTYPE_F,ierr)
CALL MPI_TYPE_COMMIT(SUBTYPE_F,ierr)
ENDIF
IF( me_i .eq. iproc .and. me_i .ne. 0) THEN
!
CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_i_F(me_i,:),subsizes_i_F(me_i,:),starts_i_F(me_i,:), &
MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
SUBTYPE_F,ierr)
CALL MPI_TYPE_COMMIT(SUBTYPE_F,ierr)
!
ENDIF
!
!
! send CieFdp to root = o proc
IF(me_i .eq. 0 .and. iproc .ne. 0 ) THEN ! ... send to the root proc.
CALL MPI_RECV(CieFdp,1,SUBTYPE_F,iproc,tag,comm_i,status,ierr)
ELSEIF( me_i .eq. iproc .and. me_i .ne. 0 ) THEN
CALL MPI_SEND(CieFdp,1,SUBTYPE_F,to,tag,comm_i,ierr)
ENDIF
!
ENDIF
!
ENDDO
! clear MPI user-defined datatype
IF( ITEST .ne. 0) CALL MPI_TYPE_FREE(SUBTYPE_T,ierr)
IF( IBACK .ne. 0) CALL MPI_TYPE_FREE(SUBTYPE_F,ierr)
!
ENDIF
!
END SUBROUTINE ppsync_i
c4science · Help