Homec4science
Diffusion COSOlver (master) Browse

cosolver/src/ppsync_self.f90
05a553ae087cmaster

Last Change
Raw File

ppsync_self.f90
View Options

SUBROUTINE ppsync_self
!
! MPI sync self collisional matrices between processors
!
USE basic
USE model
USE array
!
IMPLICIT NONE
!
! local vars.
! MPI COMM.
! INTEGER :: SUBTYPE_II,SUBTYPE_EE
! INTEGER :: to,from,tag,iproc
! INTEGER :: STATUS(MPI_STATUS_SIZE)
! INTEGER, DIMENSION(:), allocatable :: buff_
! !
! to = 0
! !
! IF(caanproc > 1) THEN
! !
! ! 1.1 MPI SYNC SELF-ELECTONS
! !___________________________________________________________________
! IF(eecolls) THEN
! !
! IF( me_self .eq. 0 ) THEN
! IF(ALLOCATED(buff_)) DEALLOCATE(buff_)
! CALL ALLOCATE_ARRAY(buff_,1,2*Caanproc)
! ENDIF
! !
! ! MPI COMM Test matrices
! !
! CALL MPI_GATHER(sizes_ee(me_self,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_self,ierr)
! !
! IF(me_self .eq. 0) THEN
! DO iproc = 0,Caanproc-1
! sizes_ee(iproc,1) = buff_(2*iproc +1)
! sizes_ee(iproc,2) = buff_(2*iproc +2)
! ENDDO
! ENDIF
! !
! CALL MPI_GATHER(subsizes_ee(me_self,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_self,ierr)
! !
! IF(me_self .eq. 0) THEN
! DO iproc = 0,Caanproc-1
! subsizes_ee(iproc,1) = buff_(2*iproc +1)
! subsizes_ee(iproc,2) = buff_(2*iproc +2)
! ENDDO
! ENDIF
! !
! CALL MPI_GATHER(starts_ee(me_self,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_self,ierr)
! !
! IF(me_self .eq. 0) THEN
! DO iproc = 0,Caanproc-1
! starts_ee(iproc,1) = buff_(2*iproc +1)
! starts_ee(iproc,2) = buff_(2*iproc +2)
! ENDDO
! ENDIF
! !
! DO iproc =0,Caanproc-1
! IF(ESELF .ne. 0) THEN
! tag = 2*iproc + 2
! IF( me_self .eq. 0 .and. iproc .ge. 1 ) THEN
! CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_ee(iproc,:),subsizes_ee(iproc,:),starts_ee(iproc,:), &
! MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
! SUBTYPE_EE,ierr)
! CALL MPI_TYPE_COMMIT(SUBTYPE_EE,ierr)
! ENDIF
! IF( me_self .eq. iproc .and. me_self .ne. 0) THEN
! !
! CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_ee(me_self,:),subsizes_ee(me_self,:),starts_ee(me_self,:), &
! MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
! SUBTYPE_EE,ierr)
! CALL MPI_TYPE_COMMIT(SUBTYPE_EE,ierr)
! !
! ENDIF
! !
! !
! ! send Ceedp to root = o proc
! IF( me_self .eq. 0 .and. iproc .ne. 0 ) THEN ! ... send to the root proc.
! CALL MPI_RECV(Ceedp,1,SUBTYPE_EE,iproc,tag,comm_self,status,ierr)
! ELSEIF( me_self .eq. iproc .and. me_self .ne. 0 ) THEN
! CALL MPI_SEND(Ceedp,1,SUBTYPE_EE,to,tag,comm_self,ierr)
! ENDIF
! !
! ENDIF
! ENDDO
! ENDIF
! !
! ! 1.2 MPI SYNC SELF-IONS
! !___________________________________________________________________
! IF(iicolls) THEN
! !
! IF( me_self .eq. 0 ) THEN
! IF(ALLOCATED(buff_)) DEALLOCATE(buff_)
! CALL ALLOCATE_ARRAY(buff_,1,2*Caanproc)
! ENDIF
! !
! ! MPI COMM Test matrices
! !
! CALL MPI_GATHER(sizes_ii(me_self,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_self,ierr)
! !
! IF(me_self .eq. 0) THEN
! DO iproc = 0,Caanproc-1
! sizes_ii(iproc,1) = buff_(2*iproc +1)
! sizes_ii(iproc,2) = buff_(2*iproc +2)
! ENDDO
! ENDIF
! !
! CALL MPI_GATHER(subsizes_ii(me_self,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_self,ierr)
! !
! IF(me_self .eq. 0) THEN
! DO iproc = 0,Caanproc-1
! subsizes_ii(iproc,1) = buff_(2*iproc +1)
! subsizes_ii(iproc,2) = buff_(2*iproc +2)
! ENDDO
! ENDIF
! !
! CALL MPI_GATHER(starts_ii(me_self,:),2,MPI_INTEGER,buff_,2,MPI_INTEGER,0,comm_self,ierr)
! !
! IF(me_self .eq. 0) THEN
! DO iproc = 0,Caanproc-1
! starts_ii(iproc,1) = buff_(2*iproc +1)
! starts_ii(iproc,2) = buff_(2*iproc +2)
! ENDDO
! ENDIF
! !
! !
! DO iproc =0,Caanproc-1
! IF(ISELF .ne. 0) THEN
! tag = 2*iproc + 2
! IF( me_self .eq. 0 .and. iproc .ge. 1 ) THEN
! CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_ii(iproc,:),subsizes_ii(iproc,:),starts_ii(iproc,:), &
! MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
! SUBTYPE_II,ierr)
! CALL MPI_TYPE_COMMIT(SUBTYPE_II,ierr)
! ENDIF
! IF( me_self .eq. iproc .and. me_self .ne. 0) THEN
! !
! CALL MPI_TYPE_CREATE_SUBARRAY(2,sizes_ii(me_self,:),subsizes_ii(me_self,:),starts_ii(me_self,:), &
! MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, &
! SUBTYPE_II,ierr)
! CALL MPI_TYPE_COMMIT(SUBTYPE_II,ierr)
! !
! ENDIF
! !
! !
! ! send CeiTdp to root = o proc
! IF( me_self .eq. 0 .and. iproc .ne. 0 ) THEN ! ... send to the root proc.
! CALL MPI_RECV(Ciidp,1,SUBTYPE_II,iproc,tag,comm_self,status,ierr)
! ELSEIF( me_self .eq. iproc .and. me_self .ne. 0 ) THEN
! CALL MPI_SEND(Ciidp,1,SUBTYPE_II,to,tag,comm_self,ierr)
! ENDIF
! !
! ENDIF
! ENDDO
! ENDIF
! !
! ENDIF
!
END SUBROUTINE ppsync_self
c4science · Help