Homec4science
Diffusion COSOlver (new_coulomb) Browse

cosolver/src/ppsync_i.f90
83b8f38f6c51new_coulomb

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