LCPQ
/
quantum_package
mirror of https://github.com/LCPQ/quantum_package
10
0
Fork 0
Code Issues Releases Wiki Activity

MPI test is OK

This commit is contained in:
Anthony Scemama 2017-11-23 10:35:13 +01:00
parent 334f165ff1
commit e55a1565e8
14 changed files with 81 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
config/gfortran_mpi.cfg
View File

@ -10,7 +10,7 @@
#
#
[COMMON]
FC : mpif90 -ffree-line-length-none -I .
FC : mpif90 -ffree-line-length-none -I . -g
LAPACK_LIB : -lblas -llapack
IRPF90 : irpf90
IRPF90_FLAGS : --ninja --align=32 -DMPI

2
plugins/CAS_SD_ZMQ/selection.irp.f
View File

@ -646,7 +646,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
do p2=ib,mo_tot_num
if(bannedOrb(p2, s2)) cycle
if(banned(p1,p2)) cycle
if(mat(1, p1, p2) == 0d0) cycle
if(sum(dabs(mat(:, p1, p2))) == 0d0) cycle
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
logical, external :: is_in_wavefunction

2
plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES
View File

@ -1 +1 @@
Perturbation Selectors_full Generators_full ZMQ FourIdx
Perturbation Selectors_full Generators_full ZMQ FourIdx MPI

71
plugins/Full_CI_ZMQ/fci_zmq.irp.f
View File

@ -81,40 +81,41 @@ program fci_zmq
(CI_energy(1) + pt2(1) - hf_energy_ref)
correlation_energy_ratio = min(1.d0,correlation_energy_ratio)
! print *, ''
! print '(A,I12)', 'Summary at N_det = ', N_det
! print '(A)', '-----------------------------------'
! print *, ''
! call write_double(6,correlation_energy_ratio, 'Correlation ratio')
! print *, ''
!
! N_states_p = min(N_det,N_states)
! print *, ''
! write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=========================''))'
! write(*,fmt)
! write(fmt,*) '(12X,', N_states_p, '(6X,A5,1X,I6,8X))'
! write(*,fmt) ('State',k, k=1,N_states_p)
! write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=========================''))'
! write(*,fmt)
! write(fmt,*) '(A12,', N_states_p, '(1X,F12.8,13X))'
! write(*,fmt) '# E ', CI_energy(1:N_states_p)
! if (N_states_p > 1) then
! write(*,fmt) '# Excit. (au)', CI_energy(1:N_states_p)-CI_energy(1)
! write(*,fmt) '# Excit. (eV)', (CI_energy(1:N_states_p)-CI_energy(1))*27.211396641308d0
! endif
! write(fmt,*) '(A12,', 2*N_states_p, '(1X,F12.8))'
! write(*,fmt) '# PT2'//pt2_string, (pt2(k), error(k), k=1,N_states_p)
! write(*,*) '#'
! write(*,fmt) '# E+PT2 ', (CI_energy(k)+pt2(k),error(k), k=1,N_states_p)
! if (N_states_p > 1) then
! write(*,fmt) '# Excit. (au)', ( (CI_energy(k)+pt2(k)-CI_energy(1)-pt2(1)), &
! dsqrt(error(k)*error(k)+error(1)*error(1)), k=1,N_states_p)
! write(*,fmt) '# Excit. (eV)', ( (CI_energy(k)+pt2(k)-CI_energy(1)-pt2(1))*27.211396641308d0, &
! dsqrt(error(k)*error(k)+error(1)*error(1))*27.211396641308d0, k=1,N_states_p)
! endif
! write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=========================''))'
! write(*,fmt)
! print *, ''
N_states_p = min(N_det,N_states)
print *, ''
print '(A,I12)', 'Summary at N_det = ', N_det
print '(A)', '-----------------------------------'
print *, ''
call write_double(6,correlation_energy_ratio, 'Correlation ratio')
print *, ''
print *, ''
write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=========================''))'
write(*,fmt)
write(fmt,*) '(12X,', N_states_p, '(6X,A5,1X,I6,8X))'
write(*,fmt) ('State',k, k=1,N_states_p)
write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=========================''))'
write(*,fmt)
write(fmt,*) '(A12,', N_states_p, '(1X,F12.8,13X))'
write(*,fmt) '# E ', CI_energy(1:N_states_p)
if (N_states_p > 1) then
write(*,fmt) '# Excit. (au)', CI_energy(1:N_states_p)-CI_energy(1)
write(*,fmt) '# Excit. (eV)', (CI_energy(1:N_states_p)-CI_energy(1))*27.211396641308d0
endif
write(fmt,*) '(A12,', 2*N_states_p, '(1X,F12.8))'
write(*,fmt) '# PT2'//pt2_string, (pt2(k), error(k), k=1,N_states_p)
write(*,'(A)') '#'
write(*,fmt) '# E+PT2 ', (CI_energy(k)+pt2(k),error(k), k=1,N_states_p)
if (N_states_p > 1) then
write(*,fmt) '# Excit. (au)', ( (CI_energy(k)+pt2(k)-CI_energy(1)-pt2(1)), &
dsqrt(error(k)*error(k)+error(1)*error(1)), k=1,N_states_p)
write(*,fmt) '# Excit. (eV)', ( (CI_energy(k)+pt2(k)-CI_energy(1)-pt2(1))*27.211396641308d0, &
dsqrt(error(k)*error(k)+error(1)*error(1))*27.211396641308d0, k=1,N_states_p)
endif
write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=========================''))'
write(*,fmt)
print *, ''
print *, 'N_det = ', N_det
print *, 'N_states = ', N_states
@ -220,7 +221,7 @@ program fci_zmq
endif
write(fmt,*) '(A12,', 2*N_states_p, '(1X,F12.8))'
write(*,fmt) '# PT2'//pt2_string, (pt2(k), error(k), k=1,N_states_p)
write(*,*) '#'
write(*,'(A)') '#'
write(*,fmt) '# E+PT2 ', (CI_energy(k)+pt2(k),error(k), k=1,N_states_p)
if (N_states_p > 1) then
write(*,fmt) '# Excit. (au)', ( (CI_energy(k)+pt2(k)-CI_energy(1)-pt2(1)), &

4
plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f
View File

@ -119,8 +119,8 @@ subroutine ZMQ_pt2(E, pt2,relative_error, absolute_error, error)
call update_psi_average_norm_contrib(w)
SOFT_TOUCH psi_average_norm_contrib
endif
do i=N_det+1,N_states
pt2(i) = 0.d0
do k=N_det+1,N_states
pt2(k) = 0.d0
enddo
end subroutine

4
plugins/Full_CI_ZMQ/run_selection_slave.irp.f
View File

@ -36,7 +36,7 @@ subroutine run_selection_slave(thread,iproc,energy)
end if
buf%N = 0
ctask = 1
pt2 = 0d0
pt2(:) = 0d0
do
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id(ctask), task)
@ -65,7 +65,7 @@ subroutine run_selection_slave(thread,iproc,energy)
call merge_selection_buffers(buf,buf2)
call push_selection_results(zmq_socket_push, pt2, buf, task_id(1), ctask)
buf%mini = buf2%mini
pt2 = 0d0
pt2(:) = 0d0
buf%cur = 0
end if
ctask = 0

29
plugins/Full_CI_ZMQ/selection.irp.f
View File

@ -563,7 +563,6 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
call spot_isinwf(mask, fullminilist, i_generator, fullinteresting(0), banned, fullMatch, fullinteresting)
if(fullMatch) cycle
mat = 0d0
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting)
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf)
@ -617,7 +616,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
do p2=ib,mo_tot_num
if(bannedOrb(p2, s2)) cycle
if(banned(p1,p2)) cycle
if(mat(1, p1, p2) == 0d0) cycle
if( sum(abs(mat(1:N_states, p1, p2))) == 0d0) cycle
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
@ -783,9 +782,9 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2)
if(ma == 1) then
mat(:, putj, puti) += coefs * hij
mat(:, putj, puti) += coefs(:) * hij
else
mat(:, puti, putj) += coefs * hij
mat(:, puti, putj) += coefs(:) * hij
end if
end do
else
@ -801,7 +800,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
p1 = p(turn2(i), 1)
hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2)
mat(:, puti, putj) += coefs * hij
mat(:, puti, putj) += coefs(:) * hij
end do
end do
end if
@ -821,7 +820,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
p1 = p(i1, ma)
p2 = p(i2, ma)
hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2)
mat(:, puti, putj) += coefs * hij
mat(:, puti, putj) += coefs(:) * hij
end do
end do
else if(tip == 3) then
@ -835,7 +834,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
p2 = p(i, ma)
hij = mo_bielec_integral(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2)
mat(:, min(puti, putj), max(puti, putj)) += coefs * hij
mat(:, min(puti, putj), max(puti, putj)) += coefs(:) * hij
end do
else ! tip == 4
puti = p(1, sp)
@ -846,7 +845,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
h1 = h(1, mi)
h2 = h(2, mi)
hij = (mo_bielec_integral(p1, p2, h1, h2) - mo_bielec_integral(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2)
mat(:, puti, putj) += coefs * hij
mat(:, puti, putj) += coefs(:) * hij
end if
end if
end if
@ -931,13 +930,13 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
putj = p1
if(.not. banned(putj,puti,bant)) then
hij = mo_bielec_integral(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix)
tmp_row(:,puti) += hij * coefs
tmp_row(:,puti) += hij * coefs(:)
end if
putj = p2
if(.not. banned(putj,puti,bant)) then
hij = mo_bielec_integral(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix)
tmp_row2(:,puti) += hij * coefs
tmp_row2(:,puti) += hij * coefs(:)
end if
end do
@ -959,12 +958,12 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
do putj=1,hfix-1
if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle
hij = (mo_bielec_integral(p1, p2, putj, hfix)-mo_bielec_integral(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2)
tmp_row(:,putj) += hij * coefs
tmp_row(:,putj) += hij * coefs(:)
end do
do putj=hfix+1,mo_tot_num
if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle
hij = (mo_bielec_integral(p1, p2, hfix, putj)-mo_bielec_integral(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2)
tmp_row(:,putj) += hij * coefs
tmp_row(:,putj) += hij * coefs(:)
end do
mat(:, :puti-1, puti) += tmp_row(:,:puti-1)
@ -982,13 +981,13 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
putj = p2
if(.not. banned(puti,putj,1)) then
hij = mo_bielec_integral(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1)
tmp_row(:,puti) += hij * coefs
tmp_row(:,puti) += hij * coefs(:)
end if
putj = p1
if(.not. banned(puti,putj,1)) then
hij = mo_bielec_integral(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2)
tmp_row2(:,puti) += hij * coefs
tmp_row2(:,puti) += hij * coefs(:)
end if
end do
mat(:,:p2-1,p2) += tmp_row(:,:p2-1)
@ -1017,7 +1016,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
call i_h_j(gen, det, N_int, hij)
mat(:, p1, p2) += coefs * hij
mat(:, p1, p2) += coefs(:) * hij
end do
end do
end

4
plugins/Full_CI_ZMQ/selection_buffer.irp.f
View File

@ -8,8 +8,8 @@ subroutine create_selection_buffer(N, siz, res)
allocate(res%det(N_int, 2, siz), res%val(siz))
res%val = 0d0
res%det = 0_8
res%val(:) = 0d0
res%det(:,:,:) = 0_8
res%N = N
res%mini = 0d0
res%cur = 0

16
plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f
View File

@ -51,7 +51,10 @@ subroutine run_wf
! ---------
print *, 'Selection'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
if (mpi_master) then
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
endif
call mpi_bcast_psi(energy,N_states)
!$OMP PARALLEL PRIVATE(i)
i = omp_get_thread_num()
@ -65,7 +68,11 @@ subroutine run_wf
! --------
print *, 'Davidson'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
print *, 'PT2'
if (mpi_master) then
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
endif
call mpi_bcast_psi(energy,N_states)
call omp_set_nested(.True.)
call davidson_slave_tcp(0)
call omp_set_nested(.False.)
@ -77,7 +84,10 @@ subroutine run_wf
! ---
print *, 'PT2'
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
if (mpi_master) then
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
endif
call mpi_bcast_psi(energy,N_states)
logical :: lstop
lstop = .False.

6
plugins/Full_CI_ZMQ/zmq_selection.irp.f
View File

@ -100,7 +100,6 @@ subroutine selection_collector(b, N, pt2)
double precision, pointer :: val(:)
integer(bit_kind), pointer :: det(:,:,:)
integer, allocatable :: task_id(:)
real :: time, time0
type(selection_buffer) :: b2
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
@ -109,11 +108,11 @@ subroutine selection_collector(b, N, pt2)
allocate(task_id(N_det_generators))
more = 1
pt2(:) = 0d0
call CPU_TIME(time0)
pt2_mwen(:) = 0.d0
do while (more == 1)
call pull_selection_results(zmq_socket_pull, pt2_mwen, b2%val(1), b2%det(1,1,1), b2%cur, task_id, ntask)
pt2 += pt2_mwen
pt2(:) += pt2_mwen(:)
do i=1, b2%cur
call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i))
if (b2%val(i) > b%mini) exit
@ -125,7 +124,6 @@ subroutine selection_collector(b, N, pt2)
endif
call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more)
end do
call CPU_TIME(time)
end do

2
plugins/MPI/NEEDED_CHILDREN_MODULES
View File

@ -1 +1 @@
Utils
Determinants Utils

12
plugins/MPI/mpi_test.irp.f
View File

@ -1,12 +0,0 @@
program MPI
implicit none
BEGIN_DOC
! MPI test program
END_DOC
print *, 'hello world'
print *, 'rank, size, master = ', mpi_rank, mpi_size, mpi_master
integer :: ierr
call MPI_FINALIZE(ierr)
print *, ierr
end

3
src/Bitmask/bitmasks_module.f90
View File

@ -1,7 +1,8 @@
module bitmasks
integer, parameter :: bit_kind_shift = 6 ! 5: 32 bits, 6: 64 bits
integer, parameter :: bit_kind_size = 64
integer, parameter :: bit_kind = 64/8
integer, parameter :: bit_kind = 8
integer, parameter :: mpi_bit_kind = 8
integer, parameter :: d_hole1 = 1
integer, parameter :: d_part1 = 2
integer, parameter :: d_hole2 = 3

4
src/Davidson/u0Hu0.irp.f
View File

@ -4,6 +4,10 @@ BEGIN_PROVIDER [ double precision, psi_energy, (N_states) ]
! Energy of the current wave function
END_DOC
call u_0_H_u_0(psi_energy,psi_coef,N_det,psi_det,N_int,N_states,psi_det_size)
integer :: i
do i=N_det+1,N_states
psi_energy(i) = 0.d0
enddo
END_PROVIDER