LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01:00
Code Issues Releases Wiki Activity

Fixed MPI

Browse Source
This commit is contained in:
Anthony Scemama 2017-11-23 19:24:42 +01:00
parent ae1cb2dfd5
commit 077e140a9d
1 changed files with 10 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
plugins/MPI/broadcast.irp.f
View File

@ -12,6 +12,7 @@ subroutine broadcast_chunks_$double(A, LDA)
integer :: i, sze, ierr integer :: i, sze, ierr
do i=1,LDA,2000000000/$8 do i=1,LDA,2000000000/$8
sze = min(LDA-i+1, 2000000000/$8) sze = min(LDA-i+1, 2000000000/$8)
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (A(i), sze, MPI_$DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (A(i), sze, MPI_$DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, 'Unable to broadcast chuks $double ', i print *, 'Unable to broadcast chuks $double ', i
@ -43,18 +44,21 @@ subroutine mpi_bcast_psi(energy, size_energy)
include 'mpif.h' include 'mpif.h'
integer :: ierr integer :: ierr
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (N_states, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (N_states, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, 'Unable to broadcast N_states' print *, 'Unable to broadcast N_states'
stop -1 stop -1
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (N_det, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (N_det, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, 'Unable to broadcast N_det' print *, 'Unable to broadcast N_det'
stop -1 stop -1
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, 'Unable to broadcast psi_det_size' print *, 'Unable to broadcast psi_det_size'
@ -66,33 +70,15 @@ subroutine mpi_bcast_psi(energy, size_energy)
endif endif
call broadcast_chunks_bit_kind(psi_det,size(psi_det)) call broadcast_chunks_bit_kind(psi_det,N_det*N_int*2)
! integer :: i, k, sze
! do i=1,psi_det_size,1000000000/(N_int*bit_kind_size)
! sze = min(psi_det_size-i+1, 1000000000/(N_int*bit_kind_size))
! call MPI_BCAST (psi_det(1,1,i), sze*N_int*2, MPI_BIT_KIND, 0, MPI_COMM_WORLD, ierr)
! if (ierr /= MPI_SUCCESS) then
! print *, 'Unable to broadcast psi_det ', i
! stop -1
! endif
! enddo
call broadcast_chunks_double(psi_coef,size(psi_coef)) call broadcast_chunks_double(psi_coef,N_states*N_det)
! do k=1,N_states
! do i=1,psi_det_size,2000000000/8
! sze = min(psi_det_size-i+1, 2000000000/8)
! call MPI_BCAST (psi_coef(i,k), sze, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
! if (ierr /= MPI_SUCCESS) then
! print *, 'Unable to broadcast psi_coef ', i, k
! stop -1
! endif
! enddo
! enddo
if (.not.mpi_master) then if (.not.mpi_master) then
TOUCH psi_det psi_coef TOUCH psi_det psi_coef
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (N_det_generators, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (N_det_generators, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, 'Unable to broadcast N_det_generators' print *, 'Unable to broadcast N_det_generators'
@ -103,6 +89,7 @@ subroutine mpi_bcast_psi(energy, size_energy)
TOUCH N_det_generators TOUCH N_det_generators
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (N_det_selectors, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (N_det_selectors, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, 'Unable to broadcast N_det_selectors' print *, 'Unable to broadcast N_det_selectors'
@ -113,11 +100,13 @@ subroutine mpi_bcast_psi(energy, size_energy)
TOUCH N_det_selectors TOUCH N_det_selectors
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
call MPI_BCAST (energy, size(energy), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST (energy, size(energy), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then if (ierr /= MPI_SUCCESS) then
print *, 'Unable to broadcast energy' print *, 'Unable to broadcast energy'
stop -1 stop -1
endif endif
! call MPI_BARRIER(MPI_COMM_WORLD)
IRP_ENDIF IRP_ENDIF
end end