From e55a1565e8a0e2b190c124252e6f9c8a4e2df934 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 23 Nov 2017 10:35:13 +0100 Subject: [PATCH] MPI test is OK --- config/gfortran_mpi.cfg | 2 +- plugins/CAS_SD_ZMQ/selection.irp.f | 2 +- plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES | 2 +- plugins/Full_CI_ZMQ/fci_zmq.irp.f | 71 ++++++++++--------- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 4 +- plugins/Full_CI_ZMQ/run_selection_slave.irp.f | 4 +- plugins/Full_CI_ZMQ/selection.irp.f | 29 ++++---- plugins/Full_CI_ZMQ/selection_buffer.irp.f | 4 +- .../selection_davidson_slave.irp.f | 16 ++++- plugins/Full_CI_ZMQ/zmq_selection.irp.f | 6 +- plugins/MPI/NEEDED_CHILDREN_MODULES | 2 +- plugins/MPI/mpi_test.irp.f | 12 ---- src/Bitmask/bitmasks_module.f90 | 3 +- src/Davidson/u0Hu0.irp.f | 4 ++ 14 files changed, 81 insertions(+), 80 deletions(-) delete mode 100644 plugins/MPI/mpi_test.irp.f diff --git a/config/gfortran_mpi.cfg b/config/gfortran_mpi.cfg index f40123b1..6358d745 100644 --- a/config/gfortran_mpi.cfg +++ b/config/gfortran_mpi.cfg @@ -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 diff --git a/plugins/CAS_SD_ZMQ/selection.irp.f b/plugins/CAS_SD_ZMQ/selection.irp.f index b42116bd..6b010950 100644 --- a/plugins/CAS_SD_ZMQ/selection.irp.f +++ b/plugins/CAS_SD_ZMQ/selection.irp.f @@ -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 diff --git a/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES b/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES index d9a3a160..6736cc4e 100644 --- a/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES +++ b/plugins/Full_CI_ZMQ/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Perturbation Selectors_full Generators_full ZMQ FourIdx +Perturbation Selectors_full Generators_full ZMQ FourIdx MPI diff --git a/plugins/Full_CI_ZMQ/fci_zmq.irp.f b/plugins/Full_CI_ZMQ/fci_zmq.irp.f index 7f9c17c6..06946f21 100644 --- a/plugins/Full_CI_ZMQ/fci_zmq.irp.f +++ b/plugins/Full_CI_ZMQ/fci_zmq.irp.f @@ -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)), & diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index c641c50d..1f24da38 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -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 diff --git a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f index 930eec2c..d6f5739f 100644 --- a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f +++ b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f @@ -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 diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 3e58224a..af898941 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -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 diff --git a/plugins/Full_CI_ZMQ/selection_buffer.irp.f b/plugins/Full_CI_ZMQ/selection_buffer.irp.f index 3deccb12..f3759781 100644 --- a/plugins/Full_CI_ZMQ/selection_buffer.irp.f +++ b/plugins/Full_CI_ZMQ/selection_buffer.irp.f @@ -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 diff --git a/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f b/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f index f86a7fcd..50d8bbcc 100644 --- a/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f +++ b/plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f @@ -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. diff --git a/plugins/Full_CI_ZMQ/zmq_selection.irp.f b/plugins/Full_CI_ZMQ/zmq_selection.irp.f index 700ee0e7..29ccd214 100644 --- a/plugins/Full_CI_ZMQ/zmq_selection.irp.f +++ b/plugins/Full_CI_ZMQ/zmq_selection.irp.f @@ -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 diff --git a/plugins/MPI/NEEDED_CHILDREN_MODULES b/plugins/MPI/NEEDED_CHILDREN_MODULES index 19028952..495f2ad0 100644 --- a/plugins/MPI/NEEDED_CHILDREN_MODULES +++ b/plugins/MPI/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Utils +Determinants Utils diff --git a/plugins/MPI/mpi_test.irp.f b/plugins/MPI/mpi_test.irp.f deleted file mode 100644 index 3fcb355a..00000000 --- a/plugins/MPI/mpi_test.irp.f +++ /dev/null @@ -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 diff --git a/src/Bitmask/bitmasks_module.f90 b/src/Bitmask/bitmasks_module.f90 index c5a9093f..52c917f8 100644 --- a/src/Bitmask/bitmasks_module.f90 +++ b/src/Bitmask/bitmasks_module.f90 @@ -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 diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index c67b1440..e4b1de50 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -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