From 9fd26ca1c8a6b88a33847673952d26f6cb3b68c3 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Tue, 28 Sep 2021 00:30:10 +0200 Subject: [PATCH 01/86] added dav_dressed_ext_rout.irp.f --- INSTALL.rst | 2 +- src/ao_basis/aos_in_r.irp.f | 26 +- .../dav_dressed_ext_rout.irp.f | 485 ++++++++++++++++++ src/dav_general_mat/dav_ext_rout.irp.f | 24 +- src/dav_general_mat/test_dav.irp.f | 39 +- src/mo_basis/mos_in_r.irp.f | 3 + 6 files changed, 543 insertions(+), 36 deletions(-) create mode 100644 src/dav_general_mat/dav_dressed_ext_rout.irp.f diff --git a/INSTALL.rst b/INSTALL.rst index 229bf40a..336d350c 100644 --- a/INSTALL.rst +++ b/INSTALL.rst @@ -209,7 +209,7 @@ ZeroMQ and its Fortran binding .. code:: bash - cp f77_zmq_free.h ${QP_ROOT}/src/ZMQ/f77_zmq.h + cp f77_zmq_free.h ${QP_ROOT}/src/zmq/f77_zmq.h Zlib diff --git a/src/ao_basis/aos_in_r.irp.f b/src/ao_basis/aos_in_r.irp.f index 7fcb980a..902827eb 100644 --- a/src/ao_basis/aos_in_r.irp.f +++ b/src/ao_basis/aos_in_r.irp.f @@ -12,21 +12,21 @@ double precision function ao_value(i,r) integer :: power_ao(3) double precision :: accu,dx,dy,dz,r2 num_ao = ao_nucl(i) - power_ao(1:3)= ao_power(i,1:3) - center_ao(1:3) = nucl_coord(num_ao,1:3) - dx = (r(1) - center_ao(1)) - dy = (r(2) - center_ao(2)) - dz = (r(3) - center_ao(3)) - r2 = dx*dx + dy*dy + dz*dz - dx = dx**power_ao(1) - dy = dy**power_ao(2) - dz = dz**power_ao(3) +! power_ao(1:3)= ao_power(i,1:3) +! center_ao(1:3) = nucl_coord(num_ao,1:3) +! dx = (r(1) - center_ao(1)) +! dy = (r(2) - center_ao(2)) +! dz = (r(3) - center_ao(3)) +! r2 = dx*dx + dy*dy + dz*dz +! dx = dx**power_ao(1) +! dy = dy**power_ao(2) +! dz = dz**power_ao(3) accu = 0.d0 - do m=1,ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2) - enddo +! do m=1,ao_prim_num(i) +! beta = ao_expo_ordered_transp(m,i) +! accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2) +! enddo ao_value = accu * dx * dy * dz end diff --git a/src/dav_general_mat/dav_dressed_ext_rout.irp.f b/src/dav_general_mat/dav_dressed_ext_rout.irp.f new file mode 100644 index 00000000..27873bfc --- /dev/null +++ b/src/dav_general_mat/dav_dressed_ext_rout.irp.f @@ -0,0 +1,485 @@ +subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_diag,dressing_state,dressing_vec,idress,converged,hcalc) + use mmap_module + implicit none + BEGIN_DOC + ! Davidson diagonalization. + ! + ! u_in : guess coefficients on the various states. Overwritten + ! on exit + ! + ! sze : leftmost dimension of u_in + ! + ! sze : Number of determinants + ! + ! N_st : Number of eigenstates + ! + ! Initial guess vectors are not necessarily orthonormal + END_DOC + integer, intent(in) :: sze, N_st, N_st_diag,idress + double precision, intent(inout) :: u_in(sze,N_st_diag) + double precision, intent(inout) :: H_jj(sze) + double precision, intent(out) :: energies(N_st_diag) + double precision, intent(in) :: dressing_vec(sze,N_st) + integer, intent(in) :: dressing_state + logical, intent(out) :: converged + external hcalc + + double precision :: f + + integer :: iter + integer :: i,j,k,l,m + + double precision, external :: u_dot_v, u_dot_u + + integer :: k_pairs, kl + + integer :: iter2, itertot + double precision, allocatable :: y(:,:), h(:,:), lambda(:) + double precision, allocatable :: s_tmp(:,:) + double precision :: diag_h_mat_elem + double precision, allocatable :: residual_norm(:) + character*(16384) :: write_buffer + double precision :: to_print(2,N_st) + double precision :: cpu, wall + integer :: shift, shift2, itermax, istate + double precision :: r1, r2, alpha + logical :: state_ok(N_st_diag*davidson_sze_max) + integer :: nproc_target + integer :: order(N_st_diag) + double precision :: cmax + double precision, allocatable :: U(:,:), overlap(:,:) + double precision, pointer :: W(:,:) + logical :: disk_based + double precision :: energy_shift(N_st_diag*davidson_sze_max) + !!!! TO CHANGE !!!! + integer :: idx_dress(1) + idx_dress = idress + + + if (dressing_state > 0) then + do k=1,N_st + do i=1,sze + H_jj(i) += u_in(i,k) * dressing_vec(i,k) + enddo + enddo + endif + + l = idx_dress(1) + f = 1.0d0/u_in(l,1) + + include 'constants.include.F' + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, y, h, lambda + if (N_st_diag*3 > sze) then + print *, 'error in Davidson :' + print *, 'Increase n_det_max_full to ', N_st_diag*3 + stop -1 + endif + + itermax = max(2,min(davidson_sze_max, sze/N_st_diag))+1 + itertot = 0 + + if (state_following) then + allocate(overlap(N_st_diag*itermax, N_st_diag*itermax)) + else + allocate(overlap(1,1)) ! avoid 'if' for deallocate + endif + overlap = 0.d0 + + + provide threshold_davidson !nthreads_davidson + call write_time(6) + write(6,'(A)') '' + write(6,'(A)') 'Davidson Diagonalization' + write(6,'(A)') '------------------------' + write(6,'(A)') '' + + ! Find max number of cores to fit in memory + ! ----------------------------------------- + + nproc_target = nproc + double precision :: rss + integer :: maxab +! maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 + maxab = sze + + m=1 + disk_based = .False. + call resident_memory(rss) + do + r1 = 8.d0 * &! bytes + ( dble(sze)*(N_st_diag*itermax) &! U + + 1.0d0*dble(sze*m)*(N_st_diag*itermax) &! W + + 3.0d0*(N_st_diag*itermax)**2 &! h,y,s_tmp + + 1.d0*(N_st_diag*itermax) &! lambda + + 1.d0*(N_st_diag) &! residual_norm + ! In H_u_0_nstates_zmq + + 2.d0*(N_st_diag*N_det) &! u_t, v_t, on collector + + 2.d0*(N_st_diag*N_det) &! u_t, v_t, on slave + + 0.5d0*maxab &! idx0 in H_u_0_nstates_openmp_work_* + + nproc_target * &! In OMP section + ( 1.d0*(N_int*maxab) &! buffer + + 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx + ) / 1024.d0**3 + + if (nproc_target == 0) then + call check_mem(r1,irp_here) + nproc_target = 1 + exit + endif + + if (r1+rss < qp_max_mem) then + exit + endif + + if (itermax > 4) then + itermax = itermax - 1 + else if (m==1.and.disk_based_davidson) then + m=0 + disk_based = .True. + itermax = 6 + else + nproc_target = nproc_target - 1 + endif + + enddo + nthreads_davidson = nproc_target + TOUCH nthreads_davidson + call write_int(6,N_st,'Number of states') + call write_int(6,N_st_diag,'Number of states in diagonalization') + call write_int(6,sze,'Number of determinants') + call write_int(6,nproc_target,'Number of threads for diagonalization') + call write_double(6, r1, 'Memory(Gb)') + if (disk_based) then + print *, 'Using swap space to reduce RAM' + endif + + !--------------- + + write(6,'(A)') '' + write_buffer = '=====' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ ===========' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + write_buffer = 'Iter' + do i=1,N_st + write_buffer = trim(write_buffer)//' Energy Residual ' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + write_buffer = '=====' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ ===========' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + + + allocate(W(sze,N_st_diag*itermax)) + + allocate( & + ! Large + U(sze,N_st_diag*itermax), & + + ! Small + h(N_st_diag*itermax,N_st_diag*itermax), & + y(N_st_diag*itermax,N_st_diag*itermax), & + s_tmp(N_st_diag*itermax,N_st_diag*itermax), & + residual_norm(N_st_diag), & + lambda(N_st_diag*itermax)) + + h = 0.d0 + U = 0.d0 + y = 0.d0 + s_tmp = 0.d0 + + + ASSERT (N_st > 0) + ASSERT (N_st_diag >= N_st) + ASSERT (sze > 0) + + ! Davidson iterations + ! =================== + + converged = .False. + + do k=N_st+1,N_st_diag + do i=1,sze + call random_number(r1) + call random_number(r2) + r1 = dsqrt(-2.d0*dlog(r1)) + r2 = dtwo_pi*r2 + u_in(i,k) = r1*dcos(r2) * u_in(i,k-N_st) + enddo + u_in(k,k) = u_in(k,k) + 10.d0 + enddo + ! Normalize all states + do k=1,N_st_diag + call normalize(u_in(1,k),sze) + enddo + ! Copy from the guess input "u_in" to the working vectors "U" + + do k=1,N_st_diag + do i=1,sze + U(i,k) = u_in(i,k) + enddo + enddo + + + do while (.not.converged) + itertot = itertot+1 + if (itertot == 8) then + exit + endif + + do iter=1,itermax-1 + + shift = N_st_diag*(iter-1) + shift2 = N_st_diag*iter + + if ((iter > 1).or.(itertot == 1)) then + ! Compute |W_k> = \sum_i |i> + ! ----------------------------------- + ! Gram-Schmidt to orthogonalize all new guess with the previous vectors + call ortho_qr(U,size(U,1),sze,shift2) + call ortho_qr(U,size(U,1),sze,shift2) + ! it does W = H U with W(sze,N_st_diag),U(sze,N_st_diag) + ! where sze is the size of the vector, N_st_diag is the number of states + call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag,sze) + else + ! Already computed in update below + continue + endif + + if (dressing_state > 0) then + + if (N_st == 1) then + + + do istate=1,N_st_diag + do i=1,sze + W(i,shift+istate) += dressing_vec(i,1) *f * U(l,shift+istate) + W(l,shift+istate) += dressing_vec(i,1) *f * U(i,shift+istate) + enddo + + enddo + + else + print*,'Not implemented yet for multi state ...' + stop +! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & +! psi_coef, size(psi_coef,1), & +! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +! dressing_vec, size(dressing_vec,1), s_tmp, size(s_tmp,1), & +! 1.d0, W(1,shift+1), size(W,1)) +! +! +! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, & +! dressing_vec, size(dressing_vec,1), & +! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, & +! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & +! 1.d0, W(1,shift+1), size(W,1)) + + endif + endif + + ! Compute h_kl = = + ! ------------------------------------------- + + call dgemm('T','N', shift2, shift2, sze, & + 1.d0, U, size(U,1), W, size(W,1), & + 0.d0, h, size(h,1)) + call dgemm('T','N', shift2, shift2, sze, & + 1.d0, U, size(U,1), U, size(U,1), & + 0.d0, s_tmp, size(s_tmp,1)) + + ! Diagonalize h + ! --------------- + + integer :: lwork, info + double precision, allocatable :: work(:) + + y = h + lwork = -1 + allocate(work(1)) + call dsygv(1,'V','U',shift2,y,size(y,1), & + s_tmp,size(s_tmp,1), lambda, work,lwork,info) + lwork = int(work(1)) + deallocate(work) + allocate(work(lwork)) + call dsygv(1,'V','U',shift2,y,size(y,1), & + s_tmp,size(s_tmp,1), lambda, work,lwork,info) + deallocate(work) + if (info /= 0) then + stop 'DSYGV Diagonalization failed' + endif + + ! Compute Energy for each eigenvector + ! ----------------------------------- + + call dgemm('N','N',shift2,shift2,shift2, & + 1.d0, h, size(h,1), y, size(y,1), & + 0.d0, s_tmp, size(s_tmp,1)) + + call dgemm('T','N',shift2,shift2,shift2, & + 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & + 0.d0, h, size(h,1)) + + do k=1,shift2 + lambda(k) = h(k,k) + enddo + + if (state_following) then + + overlap = -1.d0 + do k=1,shift2 + do i=1,shift2 + overlap(k,i) = dabs(y(k,i)) + enddo + enddo + do k=1,N_st + cmax = -1.d0 + do i=1,N_st + if (overlap(i,k) > cmax) then + cmax = overlap(i,k) + order(k) = i + endif + enddo + do i=1,N_st_diag + overlap(order(k),i) = -1.d0 + enddo + enddo + overlap = y + do k=1,N_st + l = order(k) + if (k /= l) then + y(1:shift2,k) = overlap(1:shift2,l) + endif + enddo + do k=1,N_st + overlap(k,1) = lambda(k) + enddo + + endif + + + ! Express eigenvectors of h in the determinant basis + ! -------------------------------------------------- + + call dgemm('N','N', sze, N_st_diag, shift2, & + 1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1)) + call dgemm('N','N', sze, N_st_diag, shift2, & + 1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1)) + + ! Compute residual vector and davidson step + ! ----------------------------------------- + + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k) + do k=1,N_st_diag + do i=1,sze + U(i,shift2+k) = & + (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & + /max(H_jj(i) - lambda (k),1.d-2) + enddo + + if (k <= N_st) then + residual_norm(k) = u_dot_u(U(1,shift2+k),sze) + to_print(1,k) = lambda(k) + nuclear_repulsion + to_print(2,k) = residual_norm(k) + endif + enddo + !$OMP END PARALLEL DO + + + if ((itertot>1).and.(iter == 1)) then + !don't print + continue + else + write(*,'(1X,I3,1X,100(1X,F16.10,1X,E11.3))') iter-1, to_print(1:2,1:N_st) + endif + + ! Check convergence + if (iter > 1) then + converged = dabs(maxval(residual_norm(1:N_st))) < threshold_davidson + endif + + do k=1,N_st + if (residual_norm(k) > 1.d8) then + print *, 'Davidson failed' + stop -1 + endif + enddo + if (converged) then + exit + endif + + logical, external :: qp_stop + if (qp_stop()) then + converged = .True. + exit + endif + + + enddo + + ! Re-contract U and update W + ! -------------------------------- + + call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & + W, size(W,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) + do k=1,N_st_diag + do i=1,sze + W(i,k) = u_in(i,k) + enddo + enddo + + call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & + U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) + + do k=1,N_st_diag + do i=1,sze + U(i,k) = u_in(i,k) + enddo + enddo + + enddo + + + call nullify_small_elements(sze,N_st_diag,U,size(U,1),threshold_davidson_pt2) + do k=1,N_st_diag + do i=1,sze + u_in(i,k) = U(i,k) + enddo + enddo + + do k=1,N_st_diag + energies(k) = lambda(k) + enddo + write_buffer = '======' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ ===========' + enddo + write(6,'(A)') trim(write_buffer) + write(6,'(A)') '' + call write_time(6) + + deallocate(W) + + deallocate ( & + residual_norm, & + U, overlap, & + h, y, s_tmp, & + lambda & + ) + FREE nthreads_davidson +end + + + + + + + diff --git a/src/dav_general_mat/dav_ext_rout.irp.f b/src/dav_general_mat/dav_ext_rout.irp.f index a2aad413..ff2167e4 100644 --- a/src/dav_general_mat/dav_ext_rout.irp.f +++ b/src/dav_general_mat/dav_ext_rout.irp.f @@ -1,5 +1,5 @@ -subroutine davidson_general_ext_rout(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,converged,hcalc) +subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc) use mmap_module implicit none BEGIN_DOC @@ -9,7 +9,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia ! ! u_in : guess coefficients on the various states. Overwritten on exit ! - ! dim_in : leftmost dimension of u_in + ! sze : leftmost dimension of u_in ! ! sze : Number of determinants ! @@ -21,9 +21,9 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia ! ! hcalc subroutine to compute W = H U (see routine hcalc_template for template of input/output) END_DOC - integer, intent(in) :: dim_in, sze, N_st, N_st_diag_in + integer, intent(in) :: sze, N_st, N_st_diag_in double precision, intent(in) :: H_jj(sze) - double precision, intent(inout) :: u_in(dim_in,N_st_diag_in) + double precision, intent(inout) :: u_in(sze,N_st_diag_in) double precision, intent(out) :: energies(N_st) external hcalc @@ -157,19 +157,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia write(6,'(A)') write_buffer(1:6+41*N_st) -! if (disk_based) then -! ! Create memory-mapped files for W and S -! type(c_ptr) :: ptr_w, ptr_s -! integer :: fd_s, fd_w -! call mmap(trim(ezfio_work_dir)//'davidson_w', (/int(sze,8),int(N_st_diag*itermax,8)/),& -! 8, fd_w, .False., ptr_w) -! call mmap(trim(ezfio_work_dir)//'davidson_s', (/int(sze,8),int(N_st_diag*itermax,8)/),& -! 4, fd_s, .False., ptr_s) -! call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/)) -! call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/)) -! else - allocate(W(sze,N_st_diag*itermax)) -! endif + allocate(W(sze,N_st_diag*itermax)) allocate( & ! Large @@ -398,7 +386,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia write(6,'(A)') '' call write_time(6) - deallocate(W) + deallocate(W) deallocate ( & residual_norm, & diff --git a/src/dav_general_mat/test_dav.irp.f b/src/dav_general_mat/test_dav.irp.f index 0a7faaf0..4a65ba7c 100644 --- a/src/dav_general_mat/test_dav.irp.f +++ b/src/dav_general_mat/test_dav.irp.f @@ -8,12 +8,13 @@ program test_dav touch read_wf PROVIDE threshold_davidson nthreads_davidson call routine + call test_dav_dress end subroutine routine implicit none double precision, allocatable :: u_in(:,:), H_jj(:), energies(:),h_mat(:,:) - integer :: dim_in,sze,N_st,N_st_diag_in,dressing_state + integer :: dim_in,sze,N_st,N_st_diag_in logical :: converged integer :: i,j external hcalc_template @@ -21,9 +22,8 @@ subroutine routine N_st_diag_in = N_states_diag sze = N_det dim_in = sze - dressing_state = 0 !!!! MARK THAT u_in mut dimensioned with "N_st_diag_in" as a second dimension - allocate(u_in(dim_in,N_st_diag_in),H_jj(sze),h_mat(sze,sze),energies(N_st)) + allocate(u_in(dim_in,N_st_diag_in),H_jj(sze),h_mat(sze,sze),energies(N_st_diag_in)) u_in = 0.d0 do i = 1, N_st u_in(1,i) = 1.d0 @@ -42,7 +42,38 @@ subroutine routine print*,'energies = ',energies !!! hcalc_template is the routine that computes v = H u !!! and you can use the routine "davidson_general_ext_rout" - call davidson_general_ext_rout(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,converged,hcalc_template) + call davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc_template) print*,'energies = ',energies end + +subroutine test_dav_dress + implicit none + double precision, allocatable :: u_in(:,:), H_jj(:), energies(:) + integer :: sze,N_st,N_st_diag_in,dressing_state + logical :: converged + integer :: i,j + external hcalc_template + double precision, allocatable :: dressing_vec(:) + integer :: idress + N_st = N_states + N_st_diag_in = N_states_diag + sze = N_det + dressing_state = 0 + idress = 1 + !!!! MARK THAT u_in mut dimensioned with "N_st_diag_in" as a second dimension + allocate(u_in(sze,N_st_diag_in),H_jj(sze),energies(N_st_diag_in)) + allocate(dressing_vec(sze)) + dressing_vec = 0.d0 + u_in = 0.d0 + do i = 1, N_st + u_in(1,i) = 1.d0 + enddo + do i = 1, sze + H_jj(i) = H_matrix_all_dets(i,i) + nuclear_repulsion + enddo + print*,'dressing davidson ' + call davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_diag_in,dressing_state,dressing_vec,idress,converged,hcalc_template) + print*,'energies(1) = ',energies(1) + +end diff --git a/src/mo_basis/mos_in_r.irp.f b/src/mo_basis/mos_in_r.irp.f index ee2795d0..e5d3b243 100644 --- a/src/mo_basis/mos_in_r.irp.f +++ b/src/mo_basis/mos_in_r.irp.f @@ -1,6 +1,9 @@ subroutine give_all_mos_at_r(r,mos_array) implicit none + BEGIN_DOC +! mos_array(i) = ith MO function evaluated at "r" + END_DOC double precision, intent(in) :: r(3) double precision, intent(out) :: mos_array(mo_num) double precision :: aos_array(ao_num) From 1d53e6fda2f7667ec83219df5febb6b5249f96ae Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Tue, 28 Sep 2021 11:53:34 +0200 Subject: [PATCH 02/86] added the possibility to introduce a threshold for saving the wave function in cis.irp.f --- src/cis/cis.irp.f | 2 +- src/determinants/EZFIO.cfg | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/cis/cis.irp.f b/src/cis/cis.irp.f index acec29c2..c4100105 100644 --- a/src/cis/cis.irp.f +++ b/src/cis/cis.irp.f @@ -79,6 +79,6 @@ subroutine run call ezfio_set_cis_energy(CI_energy) psi_coef = ci_eigenvectors SOFT_TOUCH psi_coef - call save_wavefunction_truncated(1.d-12) + call save_wavefunction_truncated(threshold_save_wf) end diff --git a/src/determinants/EZFIO.cfg b/src/determinants/EZFIO.cfg index 662c6fbb..1e85693b 100644 --- a/src/determinants/EZFIO.cfg +++ b/src/determinants/EZFIO.cfg @@ -136,3 +136,9 @@ doc: If |true|, discard any Slater determinants with an interaction smaller than interface: ezfio,provider,ocaml default: False + +[threshold_save_wf] +type: Threshold +doc: Threshold on the coefficients of the wave function when saving it into the ezfio +interface: ezfio,provider,ocaml +default: 1.e-14 From 0c7c8513b1c5ccb1a6bba46dcc75a5b4c6b59580 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Thu, 7 Oct 2021 17:37:24 +0200 Subject: [PATCH 03/86] added the possibility to have a mu(r) in the functionals --- src/dft_keywords/EZFIO.cfg | 5 +++++ src/dft_one_e/NEED | 1 + src/dft_one_e/mu_erf_dft.irp.f | 12 ++++++++++++ src/functionals/sr_lda.irp.f | 18 ++++++++++++------ src/functionals/sr_pbe.irp.f | 14 ++++++++++---- 5 files changed, 40 insertions(+), 10 deletions(-) diff --git a/src/dft_keywords/EZFIO.cfg b/src/dft_keywords/EZFIO.cfg index b452c863..a13cbac9 100644 --- a/src/dft_keywords/EZFIO.cfg +++ b/src/dft_keywords/EZFIO.cfg @@ -16,3 +16,8 @@ doc: Percentage of HF exchange in the DFT model interface: ezfio,provider,ocaml default: 0. +[mu_dft_type] +type: character*(32) +doc: type of mu(r) for rsdft [ cst ] +interface: ezfio, provider, ocaml +default: cst diff --git a/src/dft_one_e/NEED b/src/dft_one_e/NEED index 3a942f28..615ee97e 100644 --- a/src/dft_one_e/NEED +++ b/src/dft_one_e/NEED @@ -6,3 +6,4 @@ ao_one_e_ints ao_two_e_ints mo_two_e_erf_ints ao_two_e_erf_ints +mu_of_r diff --git a/src/dft_one_e/mu_erf_dft.irp.f b/src/dft_one_e/mu_erf_dft.irp.f index 53effcb6..8161324b 100644 --- a/src/dft_one_e/mu_erf_dft.irp.f +++ b/src/dft_one_e/mu_erf_dft.irp.f @@ -8,3 +8,15 @@ BEGIN_PROVIDER [double precision, mu_erf_dft] mu_erf_dft = mu_erf END_PROVIDER + +BEGIN_PROVIDER [double precision, mu_of_r_dft, (n_points_final_grid)] + implicit none + integer :: i + do i = 1, n_points_final_grid + if(mu_dft_type == "cst")then + mu_of_r_dft(i) = mu_erf_dft + else + mu_of_r_dft(i) = mu_of_r_hf(i) + endif + enddo +END_PROVIDER diff --git a/src/functionals/sr_lda.irp.f b/src/functionals/sr_lda.irp.f index 965a744c..bd062a02 100644 --- a/src/functionals/sr_lda.irp.f +++ b/src/functionals/sr_lda.irp.f @@ -21,7 +21,9 @@ weight = final_weight_at_r_vector(i) rhoa(istate) = one_e_dm_and_grad_alpha_in_r(4,i,istate) rhob(istate) = one_e_dm_and_grad_beta_in_r(4,i,istate) - call ex_lda_sr(mu_erf_dft,rhoa(istate),rhob(istate),e_x,vx_a,vx_b) + double precision :: mu_local + mu_local = mu_of_r_dft(i) + call ex_lda_sr(mu_local,rhoa(istate),rhob(istate),e_x,vx_a,vx_b) energy_x_sr_lda(istate) += weight * e_x enddo enddo @@ -48,7 +50,9 @@ weight = final_weight_at_r_vector(i) rhoa(istate) = one_e_dm_and_grad_alpha_in_r(4,i,istate) rhob(istate) = one_e_dm_and_grad_beta_in_r(4,i,istate) - call ec_lda_sr(mu_erf_dft,rhoa(istate),rhob(istate),e_c,vc_a,vc_b) + double precision :: mu_local + mu_local = mu_of_r_dft(i) + call ec_lda_sr(mu_local,rhoa(istate),rhob(istate),e_c,vc_a,vc_b) energy_c_sr_lda(istate) += weight * e_c enddo enddo @@ -122,8 +126,10 @@ END_PROVIDER weight = final_weight_at_r_vector(i) rhoa(istate) = one_e_dm_and_grad_alpha_in_r(4,i,istate) rhob(istate) = one_e_dm_and_grad_beta_in_r(4,i,istate) - call ec_lda_sr(mu_erf_dft,rhoa(istate),rhob(istate),e_c,sr_vc_a,sr_vc_b) - call ex_lda_sr(mu_erf_dft,rhoa(istate),rhob(istate),e_x,sr_vx_a,sr_vx_b) + double precision :: mu_local + mu_local = mu_of_r_dft(i) + call ec_lda_sr(mu_local,rhoa(istate),rhob(istate),e_c,sr_vc_a,sr_vc_b) + call ex_lda_sr(mu_local,rhoa(istate),rhob(istate),e_x,sr_vx_a,sr_vx_b) do j =1, ao_num aos_sr_vc_alpha_lda_w(j,i,istate) = sr_vc_a * aos_in_r_array(j,i)*weight aos_sr_vc_beta_lda_w(j,i,istate) = sr_vc_b * aos_in_r_array(j,i)*weight @@ -147,8 +153,6 @@ END_PROVIDER double precision :: mu,weight double precision :: e_c,sr_vc_a,sr_vc_b,e_x,sr_vx_a,sr_vx_b double precision, allocatable :: rhoa(:),rhob(:) - double precision :: mu_local - mu_local = mu_erf_dft allocate(rhoa(N_states), rhob(N_states)) do istate = 1, N_states do i = 1, n_points_final_grid @@ -158,6 +162,8 @@ END_PROVIDER weight = final_weight_at_r_vector(i) rhoa(istate) = one_e_dm_and_grad_alpha_in_r(4,i,istate) rhob(istate) = one_e_dm_and_grad_beta_in_r(4,i,istate) + double precision :: mu_local + mu_local = mu_of_r_dft(i) call ec_lda_sr(mu_local,rhoa(istate),rhob(istate),e_c,sr_vc_a,sr_vc_b) call ex_lda_sr(mu_local,rhoa(istate),rhob(istate),e_x,sr_vx_a,sr_vx_b) do j =1, ao_num diff --git a/src/functionals/sr_pbe.irp.f b/src/functionals/sr_pbe.irp.f index 93c51067..7053cfb6 100644 --- a/src/functionals/sr_pbe.irp.f +++ b/src/functionals/sr_pbe.irp.f @@ -35,9 +35,11 @@ grad_rho_b_2 += grad_rho_b(m) * grad_rho_b(m) grad_rho_a_b += grad_rho_a(m) * grad_rho_b(m) enddo - + + double precision :: mu_local + mu_local = mu_of_r_dft(i) ! inputs - call GGA_sr_type_functionals(mu_erf_dft,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b, & ! outputs exchange + call GGA_sr_type_functionals(mu_local,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b, & ! outputs exchange ex,vx_rho_a,vx_rho_b,vx_grad_rho_a_2,vx_grad_rho_b_2,vx_grad_rho_a_b, & ! outputs correlation ec,vc_rho_a,vc_rho_b,vc_grad_rho_a_2,vc_grad_rho_b_2,vc_grad_rho_a_b ) energy_x_sr_pbe(istate) += ex * weight @@ -135,8 +137,10 @@ END_PROVIDER grad_rho_a_b += grad_rho_a(m) * grad_rho_b(m) enddo + double precision :: mu_local + mu_local = mu_of_r_dft(i) ! inputs - call GGA_sr_type_functionals(mu_erf_dft,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b, & ! outputs exchange + call GGA_sr_type_functionals(mu_local,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b, & ! outputs exchange ex,vx_rho_a,vx_rho_b,vx_grad_rho_a_2,vx_grad_rho_b_2,vx_grad_rho_a_b, & ! outputs correlation ec,vc_rho_a,vc_rho_b,vc_grad_rho_a_2,vc_grad_rho_b_2,vc_grad_rho_a_b ) vx_rho_a *= weight @@ -292,8 +296,10 @@ END_PROVIDER grad_rho_a_b += grad_rho_a(m) * grad_rho_b(m) enddo + double precision :: mu_local + mu_local = mu_of_r_dft(i) ! inputs - call GGA_sr_type_functionals(mu_erf_dft,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b, & ! outputs exchange + call GGA_sr_type_functionals(mu_local,rho_a,rho_b,grad_rho_a_2,grad_rho_b_2,grad_rho_a_b, & ! outputs exchange ex,vx_rho_a,vx_rho_b,vx_grad_rho_a_2,vx_grad_rho_b_2,vx_grad_rho_a_b, & ! outputs correlation ec,vc_rho_a,vc_rho_b,vc_grad_rho_a_2,vc_grad_rho_b_2,vc_grad_rho_a_b ) vx_rho_a *= weight From 2125cd69aba5f560cdc4e697cc2b871f8f7fe0ad Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Thu, 7 Oct 2021 23:05:43 +0200 Subject: [PATCH 04/86] added mu(rsc) --- src/dft_one_e/mu_erf_dft.irp.f | 57 +++++++++++++++++++++++++++++---- src/dft_utils_func/mu_rsc.irp.f | 13 ++++++++ 2 files changed, 63 insertions(+), 7 deletions(-) create mode 100644 src/dft_utils_func/mu_rsc.irp.f diff --git a/src/dft_one_e/mu_erf_dft.irp.f b/src/dft_one_e/mu_erf_dft.irp.f index 8161324b..a1d7a5c1 100644 --- a/src/dft_one_e/mu_erf_dft.irp.f +++ b/src/dft_one_e/mu_erf_dft.irp.f @@ -12,11 +12,54 @@ END_PROVIDER BEGIN_PROVIDER [double precision, mu_of_r_dft, (n_points_final_grid)] implicit none integer :: i - do i = 1, n_points_final_grid - if(mu_dft_type == "cst")then - mu_of_r_dft(i) = mu_erf_dft - else - mu_of_r_dft(i) = mu_of_r_hf(i) - endif - enddo + if(mu_dft_type == "Read")then + call ezfio_get_mu_of_r_mu_of_r_disk(mu_of_r_dft) + else + do i = 1, n_points_final_grid + if(mu_dft_type == "cst")then + mu_of_r_dft(i) = mu_erf_dft + else if(mu_dft_type == "hf")then + mu_of_r_dft(i) = mu_of_r_hf(i) + else if(mu_dft_type == "rsc")then + mu_of_r_dft(i) = mu_rsc_of_r(i) + else + print*,'mu_dft_type is not of good type = ',mu_dft_type + print*,'it must be of type Read, cst, hf, rsc' + print*,'Stopping ...' + stop + endif + enddo + endif +END_PROVIDER + +BEGIN_PROVIDER [double precision, mu_rsc_of_r, (n_points_final_grid)] + implicit none + integer :: i + double precision :: mu_rs_c,rho,r(3), dm_a, dm_b + do i = 1, n_points_final_grid + r(1) = final_grid_points(1,i) + r(2) = final_grid_points(2,i) + r(3) = final_grid_points(3,i) + call dm_dft_alpha_beta_at_r(r,dm_a,dm_b) + rho = dm_a + dm_b + mu_rsc_of_r(i) = mu_rs_c(rho) + enddo + +END_PROVIDER + +BEGIN_PROVIDER [double precision, mu_of_r_dft_average] + implicit none + integer :: i + double precision :: mu_rs_c,rho,r(3), dm_a, dm_b + mu_of_r_dft_average = 0.d0 + do i = 1, n_points_final_grid + r(1) = final_grid_points(1,i) + r(2) = final_grid_points(2,i) + r(3) = final_grid_points(3,i) + call dm_dft_alpha_beta_at_r(r,dm_a,dm_b) + rho = dm_a + dm_b + mu_of_r_dft_average += rho * mu_of_r_dft(i) * final_weight_at_r_vector(i) + enddo + mu_of_r_dft_average = mu_of_r_dft_average / dble(elec_alpha_num + elec_beta_num) + print*,'mu_of_r_dft_average = ',mu_of_r_dft_average END_PROVIDER diff --git a/src/dft_utils_func/mu_rsc.irp.f b/src/dft_utils_func/mu_rsc.irp.f new file mode 100644 index 00000000..386a1c2d --- /dev/null +++ b/src/dft_utils_func/mu_rsc.irp.f @@ -0,0 +1,13 @@ +double precision function mu_rs_c(rho) + implicit none + double precision, intent(in) :: rho + include 'constants.include.F' + double precision :: cst_rs,alpha_rs,rs + cst_rs = (4.d0 * dacos(-1.d0)/3.d0)**(-1.d0/3.d0) + alpha_rs = 2.d0 * dsqrt((9.d0 * dacos(-1.d0)/4.d0)**(-1.d0/3.d0)) / sqpi + + rs = cst_rs * rho**(-1.d0/3.d0) + mu_rs_c = alpha_rs/dsqrt(rs) + +end + From 8a7d6444abe7d837b33863f0e59ce85b6a95e23b Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Mon, 18 Oct 2021 08:56:25 +0200 Subject: [PATCH 05/86] removed some stuffs to clean the CIPSI module --- src/cipsi/EZFIO.cfg | 6 - src/cipsi/NEED | 1 - src/cipsi/pert_rdm_providers.irp.f | 183 -------------- src/cipsi/pt2_stoch_routines.irp.f | 2 +- src/cipsi/selection.irp.f | 30 +-- src/cipsi/update_2rdm.irp.f | 223 ------------------ src/cipsi/zmq_selection.irp.f | 2 +- src/davidson_dressed/diagonalize_ci.irp.f | 2 +- src/dft_one_e/mu_erf_dft.irp.f | 1 + src/iterations/print_summary.irp.f | 2 +- src/tools/NEED | 1 + .../print_e_components.irp.f | 0 12 files changed, 21 insertions(+), 432 deletions(-) delete mode 100644 src/cipsi/pert_rdm_providers.irp.f delete mode 100644 src/cipsi/update_2rdm.irp.f rename src/{davidson => two_body_rdm}/print_e_components.irp.f (100%) diff --git a/src/cipsi/EZFIO.cfg b/src/cipsi/EZFIO.cfg index 19b45ac1..7fcf19eb 100644 --- a/src/cipsi/EZFIO.cfg +++ b/src/cipsi/EZFIO.cfg @@ -1,9 +1,3 @@ -[pert_2rdm] -type: logical -doc: If true, computes the one- and two-body rdms with perturbation theory -interface: ezfio,provider,ocaml -default: False - [save_wf_after_selection] type: logical doc: If true, saves the wave function after the selection, before the diagonalization diff --git a/src/cipsi/NEED b/src/cipsi/NEED index bfbc559a..85d01f79 100644 --- a/src/cipsi/NEED +++ b/src/cipsi/NEED @@ -2,5 +2,4 @@ perturbation zmq mpi iterations -two_body_rdm csf diff --git a/src/cipsi/pert_rdm_providers.irp.f b/src/cipsi/pert_rdm_providers.irp.f deleted file mode 100644 index eca8decc..00000000 --- a/src/cipsi/pert_rdm_providers.irp.f +++ /dev/null @@ -1,183 +0,0 @@ - -use bitmasks -use omp_lib - -BEGIN_PROVIDER [ integer(omp_lock_kind), pert_2rdm_lock] - use f77_zmq - implicit none - call omp_init_lock(pert_2rdm_lock) -END_PROVIDER - -BEGIN_PROVIDER [integer, n_orb_pert_rdm] - implicit none - n_orb_pert_rdm = n_act_orb -END_PROVIDER - -BEGIN_PROVIDER [integer, list_orb_reverse_pert_rdm, (mo_num)] - implicit none - list_orb_reverse_pert_rdm = list_act_reverse - -END_PROVIDER - -BEGIN_PROVIDER [integer, list_orb_pert_rdm, (n_orb_pert_rdm)] - implicit none - list_orb_pert_rdm = list_act - -END_PROVIDER - -BEGIN_PROVIDER [double precision, pert_2rdm_provider, (n_orb_pert_rdm,n_orb_pert_rdm,n_orb_pert_rdm,n_orb_pert_rdm)] - implicit none - pert_2rdm_provider = 0.d0 - -END_PROVIDER - -subroutine fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf, psi_det_connection, psi_coef_connection_reverse, n_det_connection) - use bitmasks - use selection_types - implicit none - - integer, intent(in) :: n_det_connection - double precision, intent(in) :: psi_coef_connection_reverse(N_states,n_det_connection) - integer(bit_kind), intent(in) :: psi_det_connection(N_int,2,n_det_connection) - integer, intent(in) :: i_generator, sp, h1, h2 - double precision, intent(in) :: mat(N_states, mo_num, mo_num) - logical, intent(in) :: bannedOrb(mo_num, 2), banned(mo_num, mo_num) - double precision, intent(in) :: fock_diag_tmp(mo_num) - double precision, intent(in) :: E0(N_states) - type(pt2_type), intent(inout) :: pt2_data - type(selection_buffer), intent(inout) :: buf - logical :: ok - integer :: s1, s2, p1, p2, ib, j, istate, jstate - integer(bit_kind) :: mask(N_int, 2), det(N_int, 2) - double precision :: e_pert, delta_E, val, Hii, sum_e_pert, tmp, alpha_h_psi, coef(N_states) - double precision, external :: diag_H_mat_elem_fock - double precision :: E_shift - - logical, external :: detEq - double precision, allocatable :: values(:) - integer, allocatable :: keys(:,:) - integer :: nkeys - integer :: sze_buff - sze_buff = 5 * mo_num ** 2 - allocate(keys(4,sze_buff),values(sze_buff)) - nkeys = 0 - if(sp == 3) then - s1 = 1 - s2 = 2 - else - s1 = sp - s2 = sp - end if - call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int) - E_shift = 0.d0 - - if (h0_type == 'CFG') then - j = det_to_configuration(i_generator) - E_shift = psi_det_Hii(i_generator) - psi_configuration_Hii(j) - endif - - do p1=1,mo_num - if(bannedOrb(p1, s1)) cycle - ib = 1 - if(sp /= 3) ib = p1+1 - - do p2=ib,mo_num - -! ----- -! /!\ Generating only single excited determinants doesn't work because a -! determinant generated by a single excitation may be doubly excited wrt -! to a determinant of the future. In that case, the determinant will be -! detected as already generated when generating in the future with a -! double excitation. -! -! if (.not.do_singles) then -! if ((h1 == p1) .or. (h2 == p2)) then -! cycle -! endif -! endif -! -! if (.not.do_doubles) then -! if ((h1 /= p1).and.(h2 /= p2)) then -! cycle -! endif -! endif -! ----- - - if(bannedOrb(p2, s2)) cycle - if(banned(p1,p2)) cycle - - - if( sum(abs(mat(1:N_states, p1, p2))) == 0d0) cycle - call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) - - if (do_only_cas) then - integer, external :: number_of_holes, number_of_particles - if (number_of_particles(det)>0) then - cycle - endif - if (number_of_holes(det)>0) then - cycle - endif - endif - - if (do_ddci) then - logical, external :: is_a_two_holes_two_particles - if (is_a_two_holes_two_particles(det)) then - cycle - endif - endif - - if (do_only_1h1p) then - logical, external :: is_a_1h1p - if (.not.is_a_1h1p(det)) cycle - endif - - - Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) - - sum_e_pert = 0d0 - integer :: degree - call get_excitation_degree(det,HF_bitmask,degree,N_int) - if(degree == 2)cycle - do istate=1,N_states - delta_E = E0(istate) - Hii + E_shift - alpha_h_psi = mat(istate, p1, p2) - val = alpha_h_psi + alpha_h_psi - tmp = dsqrt(delta_E * delta_E + val * val) - if (delta_E < 0.d0) then - tmp = -tmp - endif - e_pert = 0.5d0 * (tmp - delta_E) - coef(istate) = e_pert / alpha_h_psi - print*,e_pert,coef,alpha_h_psi - pt2_data % pt2(istate) += e_pert - pt2_data % variance(istate) += alpha_h_psi * alpha_h_psi - enddo - - do istate=1,N_states - alpha_h_psi = mat(istate, p1, p2) - e_pert = coef(istate) * alpha_h_psi - do jstate=1,N_states - pt2_data % overlap(jstate,jstate) = coef(istate) * coef(jstate) - enddo - - if (weight_selection /= 5) then - ! Energy selection - sum_e_pert = sum_e_pert + e_pert * selection_weight(istate) - - else - ! Variance selection - sum_e_pert = sum_e_pert - alpha_h_psi * alpha_h_psi * selection_weight(istate) - endif - end do - call give_2rdm_pert_contrib(det,coef,psi_det_connection,psi_coef_connection_reverse,n_det_connection,nkeys,keys,values,sze_buff) - - if(sum_e_pert <= buf%mini) then - call add_to_selection_buffer(buf, det, sum_e_pert) - end if - end do - end do - call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock) -end - - diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index b366a268..3594aaf2 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -133,7 +133,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted PROVIDE psi_det_hii selection_weight pseudo_sym PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max - PROVIDE pert_2rdm excitation_beta_max excitation_alpha_max excitation_max + PROVIDE excitation_beta_max excitation_alpha_max excitation_max if (h0_type == 'CFG') then PROVIDE psi_configuration_hii det_to_configuration diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index eda9642c..f1ec6ff6 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -464,14 +464,14 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d allocate (fullminilist (N_int, 2, fullinteresting(0)), & minilist (N_int, 2, interesting(0)) ) - if(pert_2rdm)then - allocate(coef_fullminilist_rev(N_states,fullinteresting(0))) - do i=1,fullinteresting(0) - do j = 1, N_states - coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j) - enddo - enddo - endif +! if(pert_2rdm)then +! allocate(coef_fullminilist_rev(N_states,fullinteresting(0))) +! do i=1,fullinteresting(0) +! do j = 1, N_states +! coef_fullminilist_rev(j,i) = psi_coef_sorted(fullinteresting(i),j) +! enddo +! enddo +! endif do i=1,fullinteresting(0) do k=1,N_int @@ -531,19 +531,19 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting) - if(.not.pert_2rdm)then +! if(.not.pert_2rdm)then call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf) - else - call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0)) - endif +! else +! call fill_buffer_double_rdm(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf,fullminilist, coef_fullminilist_rev, fullinteresting(0)) +! endif end if enddo if(s1 /= s2) monoBdo = .false. enddo deallocate(fullminilist,minilist) - if(pert_2rdm)then - deallocate(coef_fullminilist_rev) - endif +! if(pert_2rdm)then +! deallocate(coef_fullminilist_rev) +! endif enddo enddo deallocate(preinteresting, prefullinteresting, interesting, fullinteresting) diff --git a/src/cipsi/update_2rdm.irp.f b/src/cipsi/update_2rdm.irp.f deleted file mode 100644 index 260c48fd..00000000 --- a/src/cipsi/update_2rdm.irp.f +++ /dev/null @@ -1,223 +0,0 @@ -use bitmasks - -subroutine give_2rdm_pert_contrib(det,coef,psi_det_connection,psi_coef_connection_reverse,n_det_connection,nkeys,keys,values,sze_buff) - implicit none - integer, intent(in) :: n_det_connection,sze_buff - double precision, intent(in) :: coef(N_states) - integer(bit_kind), intent(in) :: det(N_int,2) - integer(bit_kind), intent(in) :: psi_det_connection(N_int,2,n_det_connection) - double precision, intent(in) :: psi_coef_connection_reverse(N_states,n_det_connection) - integer, intent(inout) :: keys(4,sze_buff),nkeys - double precision, intent(inout) :: values(sze_buff) - integer :: i,j - integer :: exc(0:2,2,2) - integer :: degree - double precision :: phase, contrib - do i = 1, n_det_connection - call get_excitation(det,psi_det_connection(1,1,i),exc,degree,phase,N_int) - if(degree.gt.2)cycle - contrib = 0.d0 - do j = 1, N_states - contrib += state_average_weight(j) * psi_coef_connection_reverse(j,i) * phase * coef(j) - enddo - ! case of single excitations - if(degree == 1)then - if (nkeys + 6 * elec_alpha_num .ge. sze_buff)then - call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock) - nkeys = 0 - endif - call update_buffer_single_exc_rdm(det,psi_det_connection(1,1,i),exc,phase,contrib,nkeys,keys,values,sze_buff) - else - !! case of double excitations - ! if (nkeys + 4 .ge. sze_buff)then - ! call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock) - ! nkeys = 0 - ! endif - ! call update_buffer_double_exc_rdm(exc,phase,contrib,nkeys,keys,values,sze_buff) - endif - enddo -!call update_keys_values(keys,values,nkeys,n_orb_pert_rdm,pert_2rdm_provider,pert_2rdm_lock) -!nkeys = 0 - -end - -subroutine update_buffer_single_exc_rdm(det1,det2,exc,phase,contrib,nkeys,keys,values,sze_buff) - implicit none - integer, intent(in) :: sze_buff - integer(bit_kind), intent(in) :: det1(N_int,2) - integer(bit_kind), intent(in) :: det2(N_int,2) - integer,intent(in) :: exc(0:2,2,2) - double precision,intent(in) :: phase, contrib - integer, intent(inout) :: nkeys, keys(4,sze_buff) - double precision, intent(inout):: values(sze_buff) - - integer :: occ(N_int*bit_kind_size,2) - integer :: n_occ_ab(2),ispin,other_spin - integer :: h1,h2,p1,p2,i - call bitstring_to_list_ab(det1, occ, n_occ_ab, N_int) - - if (exc(0,1,1) == 1) then - ! Mono alpha - h1 = exc(1,1,1) - p1 = exc(1,2,1) - ispin = 1 - other_spin = 2 - else - ! Mono beta - h1 = exc(1,1,2) - p1 = exc(1,2,2) - ispin = 2 - other_spin = 1 - endif - if(list_orb_reverse_pert_rdm(h1).lt.0)return - h1 = list_orb_reverse_pert_rdm(h1) - if(list_orb_reverse_pert_rdm(p1).lt.0)return - p1 = list_orb_reverse_pert_rdm(p1) - !update the alpha/beta part - do i = 1, n_occ_ab(other_spin) - h2 = occ(i,other_spin) - if(list_orb_reverse_pert_rdm(h2).lt.0)return - h2 = list_orb_reverse_pert_rdm(h2) - - nkeys += 1 - values(nkeys) = 0.5d0 * contrib * phase - keys(1,nkeys) = h1 - keys(2,nkeys) = h2 - keys(3,nkeys) = p1 - keys(4,nkeys) = h2 - nkeys += 1 - values(nkeys) = 0.5d0 * contrib * phase - keys(1,nkeys) = h2 - keys(2,nkeys) = h1 - keys(3,nkeys) = h2 - keys(4,nkeys) = p1 - enddo - !update the same spin part -!do i = 1, n_occ_ab(ispin) -! h2 = occ(i,ispin) -! if(list_orb_reverse_pert_rdm(h2).lt.0)return -! h2 = list_orb_reverse_pert_rdm(h2) - -! nkeys += 1 -! values(nkeys) = 0.5d0 * contrib * phase -! keys(1,nkeys) = h1 -! keys(2,nkeys) = h2 -! keys(3,nkeys) = p1 -! keys(4,nkeys) = h2 - -! nkeys += 1 -! values(nkeys) = - 0.5d0 * contrib * phase -! keys(1,nkeys) = h1 -! keys(2,nkeys) = h2 -! keys(3,nkeys) = h2 -! keys(4,nkeys) = p1 -! -! nkeys += 1 -! values(nkeys) = 0.5d0 * contrib * phase -! keys(1,nkeys) = h2 -! keys(2,nkeys) = h1 -! keys(3,nkeys) = h2 -! keys(4,nkeys) = p1 - -! nkeys += 1 -! values(nkeys) = - 0.5d0 * contrib * phase -! keys(1,nkeys) = h2 -! keys(2,nkeys) = h1 -! keys(3,nkeys) = p1 -! keys(4,nkeys) = h2 -!enddo - -end - -subroutine update_buffer_double_exc_rdm(exc,phase,contrib,nkeys,keys,values,sze_buff) - implicit none - integer, intent(in) :: sze_buff - integer,intent(in) :: exc(0:2,2,2) - double precision,intent(in) :: phase, contrib - integer, intent(inout) :: nkeys, keys(4,sze_buff) - double precision, intent(inout):: values(sze_buff) - integer :: h1,h2,p1,p2 - - if (exc(0,1,1) == 1) then - ! Double alpha/beta - h1 = exc(1,1,1) - h2 = exc(1,1,2) - p1 = exc(1,2,1) - p2 = exc(1,2,2) - ! check if the orbitals involved are within the orbital range - if(list_orb_reverse_pert_rdm(h1).lt.0)return - h1 = list_orb_reverse_pert_rdm(h1) - if(list_orb_reverse_pert_rdm(h2).lt.0)return - h2 = list_orb_reverse_pert_rdm(h2) - if(list_orb_reverse_pert_rdm(p1).lt.0)return - p1 = list_orb_reverse_pert_rdm(p1) - if(list_orb_reverse_pert_rdm(p2).lt.0)return - p2 = list_orb_reverse_pert_rdm(p2) - nkeys += 1 - values(nkeys) = 0.5d0 * contrib * phase - keys(1,nkeys) = h1 - keys(2,nkeys) = h2 - keys(3,nkeys) = p1 - keys(4,nkeys) = p2 - nkeys += 1 - values(nkeys) = 0.5d0 * contrib * phase - keys(1,nkeys) = p1 - keys(2,nkeys) = p2 - keys(3,nkeys) = h1 - keys(4,nkeys) = h2 - - else - if (exc(0,1,1) == 2) then - ! Double alpha/alpha - h1 = exc(1,1,1) - h2 = exc(2,1,1) - p1 = exc(1,2,1) - p2 = exc(2,2,1) - else if (exc(0,1,2) == 2) then - ! Double beta - h1 = exc(1,1,2) - h2 = exc(2,1,2) - p1 = exc(1,2,2) - p2 = exc(2,2,2) - endif - ! check if the orbitals involved are within the orbital range - if(list_orb_reverse_pert_rdm(h1).lt.0)return - h1 = list_orb_reverse_pert_rdm(h1) - if(list_orb_reverse_pert_rdm(h2).lt.0)return - h2 = list_orb_reverse_pert_rdm(h2) - if(list_orb_reverse_pert_rdm(p1).lt.0)return - p1 = list_orb_reverse_pert_rdm(p1) - if(list_orb_reverse_pert_rdm(p2).lt.0)return - p2 = list_orb_reverse_pert_rdm(p2) - nkeys += 1 - values(nkeys) = 0.5d0 * contrib * phase - keys(1,nkeys) = h1 - keys(2,nkeys) = h2 - keys(3,nkeys) = p1 - keys(4,nkeys) = p2 - - nkeys += 1 - values(nkeys) = - 0.5d0 * contrib * phase - keys(1,nkeys) = h1 - keys(2,nkeys) = h2 - keys(3,nkeys) = p2 - keys(4,nkeys) = p1 - - nkeys += 1 - values(nkeys) = 0.5d0 * contrib * phase - keys(1,nkeys) = h2 - keys(2,nkeys) = h1 - keys(3,nkeys) = p2 - keys(4,nkeys) = p1 - - nkeys += 1 - values(nkeys) = - 0.5d0 * contrib * phase - keys(1,nkeys) = h2 - keys(2,nkeys) = h1 - keys(3,nkeys) = p1 - keys(4,nkeys) = p2 - endif - -end - - diff --git a/src/cipsi/zmq_selection.irp.f b/src/cipsi/zmq_selection.irp.f index 58630709..1bfe87c0 100644 --- a/src/cipsi/zmq_selection.irp.f +++ b/src/cipsi/zmq_selection.irp.f @@ -22,7 +22,7 @@ subroutine ZMQ_selection(N_in, pt2_data) PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max - PROVIDE pert_2rdm excitation_beta_max excitation_alpha_max excitation_max + PROVIDE excitation_beta_max excitation_alpha_max excitation_max call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection') diff --git a/src/davidson_dressed/diagonalize_ci.irp.f b/src/davidson_dressed/diagonalize_ci.irp.f index 7619532a..709ee0e6 100644 --- a/src/davidson_dressed/diagonalize_ci.irp.f +++ b/src/davidson_dressed/diagonalize_ci.irp.f @@ -12,7 +12,7 @@ BEGIN_PROVIDER [ double precision, CI_energy_dressed, (N_states_diag) ] enddo do j=1,min(N_det,N_states) write(st,'(I4)') j - call write_double(6,CI_energy_dressed(j),'Energy of state '//trim(st)) + call write_double(6,CI_energy_dressed(j),'Energy dressed of state '//trim(st)) call write_double(6,CI_eigenvectors_s2_dressed(j),'S^2 of state '//trim(st)) enddo diff --git a/src/dft_one_e/mu_erf_dft.irp.f b/src/dft_one_e/mu_erf_dft.irp.f index a1d7a5c1..21f6dc21 100644 --- a/src/dft_one_e/mu_erf_dft.irp.f +++ b/src/dft_one_e/mu_erf_dft.irp.f @@ -58,6 +58,7 @@ BEGIN_PROVIDER [double precision, mu_of_r_dft_average] r(3) = final_grid_points(3,i) call dm_dft_alpha_beta_at_r(r,dm_a,dm_b) rho = dm_a + dm_b + if(mu_of_r_dft(i).gt.1.d+3)cycle mu_of_r_dft_average += rho * mu_of_r_dft(i) * final_weight_at_r_vector(i) enddo mu_of_r_dft_average = mu_of_r_dft_average / dble(elec_alpha_num + elec_beta_num) diff --git a/src/iterations/print_summary.irp.f b/src/iterations/print_summary.irp.f index 641ee209..8e6285e2 100644 --- a/src/iterations/print_summary.irp.f +++ b/src/iterations/print_summary.irp.f @@ -98,7 +98,7 @@ subroutine print_summary(e_,pt2_data,pt2_data_err,n_det_,n_configuration_,n_st,s enddo endif - call print_energy_components() +! call print_energy_components() end subroutine diff --git a/src/tools/NEED b/src/tools/NEED index c07c9109..0f4e17b0 100644 --- a/src/tools/NEED +++ b/src/tools/NEED @@ -2,3 +2,4 @@ fci mo_two_e_erf_ints aux_quantities hartree_fock +two_body_rdm diff --git a/src/davidson/print_e_components.irp.f b/src/two_body_rdm/print_e_components.irp.f similarity index 100% rename from src/davidson/print_e_components.irp.f rename to src/two_body_rdm/print_e_components.irp.f From 416cd45d7a469961db5ff03a8d27639fec1f1a20 Mon Sep 17 00:00:00 2001 From: Fileto Rodriguez Date: Fri, 22 Oct 2021 12:18:01 +0200 Subject: [PATCH 06/86] added mu of r grad_rho --- src/dft_one_e/mu_erf_dft.irp.f | 12 +++++++++ src/dft_utils_func/mu_of_r_dft.irp.f | 37 ++++++++++++++++++++++++++++ src/dft_utils_func/mu_rsc.irp.f | 13 ---------- 3 files changed, 49 insertions(+), 13 deletions(-) create mode 100644 src/dft_utils_func/mu_of_r_dft.irp.f delete mode 100644 src/dft_utils_func/mu_rsc.irp.f diff --git a/src/dft_one_e/mu_erf_dft.irp.f b/src/dft_one_e/mu_erf_dft.irp.f index a1d7a5c1..f9bff24d 100644 --- a/src/dft_one_e/mu_erf_dft.irp.f +++ b/src/dft_one_e/mu_erf_dft.irp.f @@ -44,9 +44,21 @@ BEGIN_PROVIDER [double precision, mu_rsc_of_r, (n_points_final_grid)] rho = dm_a + dm_b mu_rsc_of_r(i) = mu_rs_c(rho) enddo +END_PROVIDER +BEGIN_PROVIDER [double precision, mu_grad_rho, (n_points_final_grid)] + implicit none + integer :: i + double precision :: mu_grad_rho_func, r(3) + do i = 1, n_points_final_grid + r(1) = final_grid_points(1,i) + r(2) = final_grid_points(2,i) + r(3) = final_grid_points(3,i) + mu_grad_rho(i) = mu_grad_rho_func(r) + enddo END_PROVIDER + BEGIN_PROVIDER [double precision, mu_of_r_dft_average] implicit none integer :: i diff --git a/src/dft_utils_func/mu_of_r_dft.irp.f b/src/dft_utils_func/mu_of_r_dft.irp.f new file mode 100644 index 00000000..7cba0a60 --- /dev/null +++ b/src/dft_utils_func/mu_of_r_dft.irp.f @@ -0,0 +1,37 @@ +double precision function mu_rs_c(rho) + implicit none + double precision, intent(in) :: rho + include 'constants.include.F' + double precision :: cst_rs,alpha_rs,rs + cst_rs = (4.d0 * dacos(-1.d0)/3.d0)**(-1.d0/3.d0) + alpha_rs = 2.d0 * dsqrt((9.d0 * dacos(-1.d0)/4.d0)**(-1.d0/3.d0)) / sqpi + + rs = cst_rs * rho**(-1.d0/3.d0) + mu_rs_c = alpha_rs/dsqrt(rs) + +end + +double precision function mu_grad_rho_func(r) + implicit none + double precision , intent(in) :: r(3) + integer :: m + double precision :: rho, dm_a, dm_b, grad_dm_a(3), grad_dm_b(3) + double precision :: eta, grad_rho(3), grad_sqr + eta = 0.135d0 + call density_and_grad_alpha_beta(r,dm_a,dm_b, grad_dm_a, grad_dm_b) + rho = dm_a + dm_b + do m = 1,3 + grad_rho(m) = grad_dm_a(m) + grad_dm_b(m) + enddo + grad_sqr=0.d0 + do m = 1,3 + grad_sqr=grad_sqr+grad_rho(m)*grad_rho(m) + enddo + grad_sqr = dsqrt(grad_sqr) + if (rho<1.d-12) then + mu_grad_rho_func = 1.d-10 + else + mu_grad_rho_func = eta * grad_sqr / rho + endif + +end diff --git a/src/dft_utils_func/mu_rsc.irp.f b/src/dft_utils_func/mu_rsc.irp.f deleted file mode 100644 index 386a1c2d..00000000 --- a/src/dft_utils_func/mu_rsc.irp.f +++ /dev/null @@ -1,13 +0,0 @@ -double precision function mu_rs_c(rho) - implicit none - double precision, intent(in) :: rho - include 'constants.include.F' - double precision :: cst_rs,alpha_rs,rs - cst_rs = (4.d0 * dacos(-1.d0)/3.d0)**(-1.d0/3.d0) - alpha_rs = 2.d0 * dsqrt((9.d0 * dacos(-1.d0)/4.d0)**(-1.d0/3.d0)) / sqpi - - rs = cst_rs * rho**(-1.d0/3.d0) - mu_rs_c = alpha_rs/dsqrt(rs) - -end - From 699f655b8943b5aa7486be845294d8dec8d86305 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Mon, 25 Oct 2021 10:35:22 +0200 Subject: [PATCH 07/86] added int grad --- src/dft_utils_in_r/ints_grad.irp.f | 39 ++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 src/dft_utils_in_r/ints_grad.irp.f diff --git a/src/dft_utils_in_r/ints_grad.irp.f b/src/dft_utils_in_r/ints_grad.irp.f new file mode 100644 index 00000000..239fe554 --- /dev/null +++ b/src/dft_utils_in_r/ints_grad.irp.f @@ -0,0 +1,39 @@ + BEGIN_PROVIDER [ double precision, mo_grad_ints, (mo_num, mo_num,3)] + implicit none + BEGIN_DOC +! mo_grad_ints(i,j,m) = + END_DOC + integer :: i,j,ipoint,m + double precision :: weight + mo_grad_ints = 0.d0 + do m = 1, 3 + do ipoint = 1, n_points_final_grid + weight = final_weight_at_r_vector(ipoint) + do j = 1, mo_num + do i = 1, mo_num + mo_grad_ints(i,j,m) += mos_grad_in_r_array(j,ipoint,m) * mos_in_r_array(i,ipoint) * weight + enddo + enddo + enddo + enddo + + +END_PROVIDER + + BEGIN_PROVIDER [ double precision, mo_grad_ints_transp, (3,mo_num, mo_num)] + implicit none + BEGIN_DOC +! mo_grad_ints(i,j,m) = + END_DOC + integer :: i,j,ipoint,m + double precision :: weight + do m = 1, 3 + do j = 1, mo_num + do i = 1, mo_num + mo_grad_ints_transp(m,i,j) = mo_grad_ints(i,j,m) + enddo + enddo + enddo + + +END_PROVIDER From 1f0c48023d20540a3101f5c46b9317479a980eb6 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Tue, 26 Oct 2021 19:11:04 +0200 Subject: [PATCH 08/86] dav_double_dress_ext_rout.irp.f --- .../dav_double_dress_ext_rout.irp.f | 520 ++++++++++++++++++ src/dav_general_mat/dav_ext_rout.irp.f | 2 +- src/utils/sort.irp.f | 209 ++----- 3 files changed, 557 insertions(+), 174 deletions(-) create mode 100644 src/dav_general_mat/dav_double_dress_ext_rout.irp.f diff --git a/src/dav_general_mat/dav_double_dress_ext_rout.irp.f b/src/dav_general_mat/dav_double_dress_ext_rout.irp.f new file mode 100644 index 00000000..9bcfc5ab --- /dev/null +++ b/src/dav_general_mat/dav_double_dress_ext_rout.irp.f @@ -0,0 +1,520 @@ +subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies,sze,N_st,N_st_diag,converged,hcalc) + use mmap_module + BEGIN_DOC + ! Generic Davidson diagonalization with TWO DRESSING VECTORS + ! + ! Dress_jj : DIAGONAL DRESSING of the Hamiltonian + ! + ! Dressing_vec : COLUMN / LINE DRESSING VECTOR + ! + ! idx_dress : position of the basis function used to use the Dressing_vec (usually the largest coeff) + ! + ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson + ! + ! u_in : guess coefficients on the various states. Overwritten on exit + ! + ! sze : leftmost dimension of u_in + ! + ! sze : Number of determinants + ! + ! N_st : Number of eigenstates + ! + ! N_st_diag : Number of states in which H is diagonalized. Assumed > sze + ! + ! Initial guess vectors are not necessarily orthonormal + ! + ! hcalc subroutine to compute W = H U (see routine hcalc_template for template of input/output) + END_DOC + implicit none + integer, intent(in) :: sze, N_st, N_st_diag, idx_dress + double precision, intent(in) :: H_jj(sze),Dress_jj(sze),Dressing_vec(sze,N_st) + double precision, intent(inout) :: u_in(sze,N_st_diag) + double precision, intent(out) :: energies(N_st_diag) + logical, intent(out) :: converged + external hcalc + + double precision, allocatable :: H_jj_tmp(:) + ASSERT (N_st > 0) + ASSERT (sze > 0) + allocate(H_jj_tmp(sze)) + + do i=1,sze + H_jj_tmp(i) = H_jj(i) + Dress_jj(i) + enddo + do k=1,N_st + do i=1,sze + H_jj_tmp(i) += u_in(i,k) * Dressing_vec(i,k) + enddo + enddo + + integer :: iter + integer :: i,j,k,l,m + + double precision, external :: u_dot_v, u_dot_u + + integer :: k_pairs, kl + + integer :: iter2, itertot + double precision, allocatable :: y(:,:), h(:,:), lambda(:) + double precision, allocatable :: s_tmp(:,:) + double precision, allocatable :: residual_norm(:),inv_c_idx_dress_vec(:) + character*(16384) :: write_buffer + double precision :: to_print(2,N_st),inv_c_idx_dress + double precision :: cpu, wall + integer :: shift, shift2, itermax, istate + double precision :: r1, r2, alpha + logical :: state_ok(N_st_diag*davidson_sze_max) + integer :: nproc_target + integer :: order(N_st_diag) + double precision :: cmax + double precision, allocatable :: U(:,:), overlap(:,:) + double precision, pointer :: W(:,:) + logical :: disk_based + double precision :: energy_shift(N_st_diag*davidson_sze_max) + + + allocate(inv_c_idx_dress_vec(N_st)) + inv_c_idx_dress = 1.d0/u_in(idx_dress,1) + do i = 1, N_st + inv_c_idx_dress_vec(i) = 1.d0/u_in(idx_dress,i) + enddo + include 'constants.include.F' + + integer :: N_st_diag_in + N_st_diag_in = N_st_diag + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, y, h, lambda + if (N_st_diag_in*3 > sze) then + print *, 'error in Davidson :' + print *, 'Increase n_det_max_full to ', N_st_diag_in*3 + stop -1 + endif + + itermax = max(2,min(davidson_sze_max, sze/N_st_diag_in))+1 + itertot = 0 + + if (state_following) then + allocate(overlap(N_st_diag_in*itermax, N_st_diag_in*itermax)) + else + allocate(overlap(1,1)) ! avoid 'if' for deallocate + endif + overlap = 0.d0 + + call write_time(6) + write(6,'(A)') '' + write(6,'(A)') 'Davidson Diagonalization' + write(6,'(A)') '------------------------' + write(6,'(A)') '' + + ! Find max number of cores to fit in memory + ! ----------------------------------------- + + nproc_target = nproc + double precision :: rss + integer :: maxab + maxab = max(N_det_alpha_unique, N_det_beta_unique)+1 + + m=1 + disk_based = .False. + call resident_memory(rss) + do + r1 = 8.d0 * &! bytes + ( dble(sze)*(N_st_diag_in*itermax) &! U + + 1.0d0*dble(sze*m)*(N_st_diag_in*itermax) &! W + + 3.0d0*(N_st_diag_in*itermax)**2 &! h,y,s_tmp + + 1.d0*(N_st_diag_in*itermax) &! lambda + + 1.d0*(N_st_diag_in) &! residual_norm + ! In H_u_0_nstates_zmq + + 2.d0*(N_st_diag_in*N_det) &! u_t, v_t, on collector + + 2.d0*(N_st_diag_in*N_det) &! u_t, v_t, on slave + + 0.5d0*maxab &! idx0 in H_u_0_nstates_openmp_work_* + + nproc_target * &! In OMP section + ( 1.d0*(N_int*maxab) &! buffer + + 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx + ) / 1024.d0**3 + + if (nproc_target == 0) then + call check_mem(r1,irp_here) + nproc_target = 1 + exit + endif + + if (r1+rss < qp_max_mem) then + exit + endif + + if (itermax > 4) then + itermax = itermax - 1 + else if (m==1.and.disk_based_davidson) then + m=0 + disk_based = .True. + itermax = 6 + else + nproc_target = nproc_target - 1 + endif + + enddo + nthreads_davidson = nproc_target + TOUCH nthreads_davidson + call write_int(6,N_st,'Number of states') + call write_int(6,N_st_diag_in,'Number of states in diagonalization') + call write_int(6,sze,'Number of basis functions ') + call write_int(6,nproc_target,'Number of threads for diagonalization') + call write_double(6, r1, 'Memory(Gb)') + if (disk_based) then + print *, 'Using swap space to reduce RAM' + endif + + !--------------- + + write(6,'(A)') '' + write_buffer = '=====' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ ===========' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + write_buffer = 'Iter' + do i=1,N_st + write_buffer = trim(write_buffer)//' Energy Residual ' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + write_buffer = '=====' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ ===========' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + + + allocate(W(sze,N_st_diag_in*itermax)) + + allocate( & + ! Large + U(sze,N_st_diag_in*itermax), & + + ! Small + h(N_st_diag_in*itermax,N_st_diag_in*itermax), & + y(N_st_diag_in*itermax,N_st_diag_in*itermax), & + s_tmp(N_st_diag_in*itermax,N_st_diag_in*itermax), & + residual_norm(N_st_diag_in), & + lambda(N_st_diag_in*itermax)) + + h = 0.d0 + U = 0.d0 + y = 0.d0 + s_tmp = 0.d0 + + + ASSERT (N_st > 0) + ASSERT (N_st_diag_in >= N_st) + ASSERT (sze > 0) + ASSERT (Nint > 0) + ASSERT (Nint == N_int) + + ! Davidson iterations + ! =================== + + converged = .False. + + do k=N_st+1,N_st_diag_in + do i=1,sze + call random_number(r1) + call random_number(r2) + r1 = dsqrt(-2.d0*dlog(r1)) + r2 = dtwo_pi*r2 + u_in(i,k) = r1*dcos(r2) * u_in(i,k-N_st) + enddo + u_in(k,k) = u_in(k,k) + 10.d0 + enddo + do k=1,N_st_diag_in + call normalize(u_in(1,k),sze) + enddo + + do k=1,N_st_diag_in + do i=1,sze + U(i,k) = u_in(i,k) + enddo + enddo + + + do while (.not.converged) + itertot = itertot+1 + if (itertot == 8) then + exit + endif + + do iter=1,itermax-1 + + shift = N_st_diag_in*(iter-1) + shift2 = N_st_diag_in*iter + + if ((iter > 1).or.(itertot == 1)) then + ! Compute |W_k> = \sum_i |i> + ! ----------------------------------- + call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag_in,sze) + ! Compute then the DIAGONAL PART OF THE DRESSING + ! += Dress_jj(i) * + call dressing_diag_uv(W(1,shift+1),U(1,shift+1),Dress_jj,N_st_diag_in,sze) + else + ! Already computed in update below + continue + endif + + + if (N_st == 1) then + + l = idx_dress + double precision :: f + f = inv_c_idx_dress + do istate=1,N_st_diag_in + do i=1,sze + W(i,shift+istate) += Dressing_vec(i,1) *f * U(l,shift+istate) + W(l,shift+istate) += Dressing_vec(i,1) *f * U(i,shift+istate) + enddo + enddo + + else + print*,'dav_double_dressed routine not yet implemented for N_st > 1' +! +! call dgemm('T','N', N_st, N_st_diag_in, sze, 1.d0, & +! psi_coef, size(psi_coef,1), & +! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('N','N', sze, N_st_diag_in, N_st, 1.0d0, & +! Dressing_vec, size(Dressing_vec,1), s_tmp, size(s_tmp,1), & +! 1.d0, W(1,shift+1), size(W,1)) +! +! +! call dgemm('T','N', N_st, N_st_diag_in, sze, 1.d0, & +! Dressing_vec, size(Dressing_vec,1), & +! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1)) +! +! call dgemm('N','N', sze, N_st_diag_in, N_st, 1.0d0, & +! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), & +! 1.d0, W(1,shift+1), size(W,1)) +! + endif + + ! Compute h_kl = = + ! ------------------------------------------- + + call dgemm('T','N', shift2, shift2, sze, & + 1.d0, U, size(U,1), W, size(W,1), & + 0.d0, h, size(h,1)) + call dgemm('T','N', shift2, shift2, sze, & + 1.d0, U, size(U,1), U, size(U,1), & + 0.d0, s_tmp, size(s_tmp,1)) + + ! Diagonalize h + ! --------------- + + integer :: lwork, info + double precision, allocatable :: work(:) + + y = h + lwork = -1 + allocate(work(1)) + call dsygv(1,'V','U',shift2,y,size(y,1), & + s_tmp,size(s_tmp,1), lambda, work,lwork,info) + lwork = int(work(1)) + deallocate(work) + allocate(work(lwork)) + call dsygv(1,'V','U',shift2,y,size(y,1), & + s_tmp,size(s_tmp,1), lambda, work,lwork,info) + deallocate(work) + if (info /= 0) then + stop 'DSYGV Diagonalization failed' + endif + + ! Compute Energy for each eigenvector + ! ----------------------------------- + + call dgemm('N','N',shift2,shift2,shift2, & + 1.d0, h, size(h,1), y, size(y,1), & + 0.d0, s_tmp, size(s_tmp,1)) + + call dgemm('T','N',shift2,shift2,shift2, & + 1.d0, y, size(y,1), s_tmp, size(s_tmp,1), & + 0.d0, h, size(h,1)) + + do k=1,shift2 + lambda(k) = h(k,k) + enddo + + if (state_following) then + + overlap = -1.d0 + do k=1,shift2 + do i=1,shift2 + overlap(k,i) = dabs(y(k,i)) + enddo + enddo + do k=1,N_st + cmax = -1.d0 + do i=1,N_st + if (overlap(i,k) > cmax) then + cmax = overlap(i,k) + order(k) = i + endif + enddo + do i=1,N_st_diag_in + overlap(order(k),i) = -1.d0 + enddo + enddo + overlap = y + do k=1,N_st + l = order(k) + if (k /= l) then + y(1:shift2,k) = overlap(1:shift2,l) + endif + enddo + do k=1,N_st + overlap(k,1) = lambda(k) + enddo + + endif + + + ! Express eigenvectors of h in the determinant basis + ! -------------------------------------------------- + + call dgemm('N','N', sze, N_st_diag_in, shift2, & + 1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1)) + call dgemm('N','N', sze, N_st_diag_in, shift2, & + 1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1)) + + ! Compute residual vector and davidson step + ! ----------------------------------------- + + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k) + do k=1,N_st_diag_in + do i=1,sze + U(i,shift2+k) = & + (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & + /max(H_jj_tmp(i) - lambda (k),1.d-2) + enddo + + if (k <= N_st) then + residual_norm(k) = u_dot_u(U(1,shift2+k),sze) + to_print(1,k) = lambda(k) + to_print(2,k) = residual_norm(k) + endif + enddo + !$OMP END PARALLEL DO + + + if ((itertot>1).and.(iter == 1)) then + !don't print + continue + else + write(*,'(1X,I3,1X,100(1X,F16.10,1X,E11.3))') iter-1, to_print(1:2,1:N_st) + endif + + ! Check convergence + if (iter > 1) then + converged = dabs(maxval(residual_norm(1:N_st))) < threshold_davidson + endif + + do k=1,N_st + if (residual_norm(k) > 1.d8) then + print *, 'Davidson failed' + stop -1 + endif + enddo + if (converged) then + exit + endif + + logical, external :: qp_stop + if (qp_stop()) then + converged = .True. + exit + endif + + + enddo + + ! Re-contract U and update W + ! -------------------------------- + + call dgemm('N','N', sze, N_st_diag_in, shift2, 1.d0, & + W, size(W,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) + do k=1,N_st_diag_in + do i=1,sze + W(i,k) = u_in(i,k) + enddo + enddo + + call dgemm('N','N', sze, N_st_diag_in, shift2, 1.d0, & + U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) + + do k=1,N_st_diag_in + do i=1,sze + U(i,k) = u_in(i,k) + enddo + enddo + + enddo + + + call nullify_small_elements(sze,N_st_diag_in,U,size(U,1),threshold_davidson_pt2) + do k=1,N_st_diag_in + do i=1,sze + u_in(i,k) = U(i,k) + enddo + enddo + + do k=1,N_st_diag_in + energies(k) = lambda(k) + enddo + write_buffer = '======' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ ===========' + enddo + write(6,'(A)') trim(write_buffer) + write(6,'(A)') '' + call write_time(6) + + deallocate(W) + + deallocate ( & + residual_norm, & + U, overlap, & + h, y, s_tmp, & + lambda & + ) + FREE nthreads_davidson +end + + +subroutine dressing_diag_uv(v,u,dress_diag,N_st,sze) + implicit none + BEGIN_DOC + ! Routine that computes the diagonal part of the dressing + ! + ! v(i) += u(i) * dress_diag(i) + ! + ! !!!!!!!! WARNING !!!!!!!! the vector v is not initialized + ! + ! !!!!!!!! SO MAKE SURE THERE ARE SOME MEANINGFUL VALUES IN THERE + END_DOC + integer, intent(in) :: N_st,sze + double precision, intent(in) :: u(sze,N_st),dress_diag(sze) + double precision, intent(inout) :: v(sze,N_st) + integer :: i,istate + do istate = 1, N_st + do i = 1, sze + v(i,istate) += dress_diag(i) * u(i,istate) + enddo + enddo +end + + + + + + + + + + + diff --git a/src/dav_general_mat/dav_ext_rout.irp.f b/src/dav_general_mat/dav_ext_rout.irp.f index ff2167e4..0f2d7680 100644 --- a/src/dav_general_mat/dav_ext_rout.irp.f +++ b/src/dav_general_mat/dav_ext_rout.irp.f @@ -3,7 +3,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co use mmap_module implicit none BEGIN_DOC - ! Davidson diagonalization with specific diagonal elements of the H matrix + ! Generic Davidson diagonalization ! ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson ! diff --git a/src/utils/sort.irp.f b/src/utils/sort.irp.f index a63eb4a3..2a655eed 100644 --- a/src/utils/sort.irp.f +++ b/src/utils/sort.irp.f @@ -38,7 +38,15 @@ BEGIN_TEMPLATE $type,intent(inout) :: x(isize) integer,intent(inout) :: iorder(isize) integer, external :: omp_get_num_threads - call rec_$X_quicksort(x,iorder,isize,1,isize,nproc) + if (omp_get_num_threads() == 1) then + !$OMP PARALLEL DEFAULT(SHARED) + !$OMP SINGLE + call rec_$X_quicksort(x,iorder,isize,1,isize,nproc) + !$OMP END SINGLE + !$OMP END PARALLEL + else + call rec_$X_quicksort(x,iorder,isize,1,isize,nproc) + endif end recursive subroutine rec_$X_quicksort(x, iorder, isize, first, last, level) @@ -49,7 +57,7 @@ BEGIN_TEMPLATE $type :: c, tmp integer :: itmp integer :: i, j - + if(isize<2)return c = x( shiftr(first+last,1) ) @@ -81,11 +89,16 @@ BEGIN_TEMPLATE endif else if (first < i-1) then + !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,first,i,level) call rec_$X_quicksort(x, iorder, isize, first, i-1,level/2) + !$OMP END TASK endif if (j+1 < last) then + !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,last,j,level) call rec_$X_quicksort(x, iorder, isize, j+1, last,level/2) + !$OMP END TASK endif + !$OMP TASKWAIT endif end @@ -249,60 +262,7 @@ SUBST [ X, type ] i2 ; integer*2 ;; END_TEMPLATE - -!---------------------- INTEL -IRP_IF INTEL - BEGIN_TEMPLATE - subroutine $Xsort(x,iorder,isize) - use intel - implicit none - BEGIN_DOC - ! Sort array x(isize). - ! iorder in input should be (1,2,3,...,isize), and in output - ! contains the new order of the elements. - END_DOC - integer,intent(in) :: isize - $type,intent(inout) :: x(isize) - integer,intent(inout) :: iorder(isize) - integer :: n - character, allocatable :: tmp(:) - if (isize < 2) return - call ippsSortRadixIndexGetBufferSize(isize, $ippsz, n) - allocate(tmp(n)) - call ippsSortRadixIndexAscend_$ityp(x, $n, iorder, isize, tmp) - deallocate(tmp) - iorder(1:isize) = iorder(1:isize)+1 - call $Xset_order(x,iorder,isize) - end - - subroutine $Xsort_noidx(x,isize) - use intel - implicit none - BEGIN_DOC - ! Sort array x(isize). - ! iorder in input should be (1,2,3,...,isize), and in output - ! contains the new order of the elements. - END_DOC - integer,intent(in) :: isize - $type,intent(inout) :: x(isize) - integer :: n - character, allocatable :: tmp(:) - if (isize < 2) return - call ippsSortRadixIndexGetBufferSize(isize, $ippsz, n) - allocate(tmp(n)) - call ippsSortRadixAscend_$ityp_I(x, isize, tmp) - deallocate(tmp) - end - -SUBST [ X, type, ityp, n, ippsz ] - ; real ; 32f ; 4 ; 13 ;; - i ; integer ; 32s ; 4 ; 11 ;; - i2 ; integer*2 ; 16s ; 2 ; 7 ;; -END_TEMPLATE - -BEGIN_TEMPLATE - subroutine $Xsort(x,iorder,isize) implicit none BEGIN_DOC @@ -329,12 +289,12 @@ BEGIN_TEMPLATE endif end subroutine $Xsort -SUBST [ X, type ] - d ; double precision ;; +SUBST [ X, type, Y ] + ; real ; i ;; + d ; double precision ; i8 ;; END_TEMPLATE BEGIN_TEMPLATE - subroutine $Xsort(x,iorder,isize) implicit none BEGIN_DOC @@ -346,112 +306,8 @@ BEGIN_TEMPLATE $type,intent(inout) :: x(isize) integer,intent(inout) :: iorder(isize) integer :: n - if (isize < 2) then - return - endif - call sorted_$Xnumber(x,isize,n) - if (isize == n) then - return - endif - if ( isize < 32) then - call insertion_$Xsort(x,iorder,isize) - else - call $Xradix_sort(x,iorder,isize,-1) - endif - end subroutine $Xsort - -SUBST [ X, type ] - i8 ; integer*8 ;; -END_TEMPLATE - -!---------------------- END INTEL -IRP_ELSE -!---------------------- NON-INTEL -BEGIN_TEMPLATE - - subroutine $Xsort_noidx(x,isize) - implicit none - BEGIN_DOC - ! Sort array x(isize). - END_DOC - integer,intent(in) :: isize - $type,intent(inout) :: x(isize) - integer, allocatable :: iorder(:) - integer :: i - allocate(iorder(isize)) - do i=1,isize - iorder(i)=i - enddo - call $Xsort(x,iorder,isize) - deallocate(iorder) - end subroutine $Xsort_noidx - -SUBST [ X, type ] - ; real ;; - d ; double precision ;; - i ; integer ;; - i8 ; integer*8 ;; - i2 ; integer*2 ;; -END_TEMPLATE - -BEGIN_TEMPLATE - - subroutine $Xsort(x,iorder,isize) - implicit none - BEGIN_DOC - ! Sort array x(isize). - ! iorder in input should be (1,2,3,...,isize), and in output - ! contains the new order of the elements. - END_DOC - integer,intent(in) :: isize - $type,intent(inout) :: x(isize) - integer,intent(inout) :: iorder(isize) - integer :: n - if (isize < 2) then - return - endif -! call sorted_$Xnumber(x,isize,n) -! if (isize == n) then -! return -! endif - if ( isize < 32) then - call insertion_$Xsort(x,iorder,isize) - else -! call heap_$Xsort(x,iorder,isize) - call quick_$Xsort(x,iorder,isize) - endif - end subroutine $Xsort - -SUBST [ X, type ] - ; real ;; - d ; double precision ;; -END_TEMPLATE - -BEGIN_TEMPLATE - - subroutine $Xsort(x,iorder,isize) - implicit none - BEGIN_DOC - ! Sort array x(isize). - ! iorder in input should be (1,2,3,...,isize), and in output - ! contains the new order of the elements. - END_DOC - integer,intent(in) :: isize - $type,intent(inout) :: x(isize) - integer,intent(inout) :: iorder(isize) - integer :: n - if (isize < 2) then - return - endif - call sorted_$Xnumber(x,isize,n) - if (isize == n) then - return - endif - if ( isize < 32) then - call insertion_$Xsort(x,iorder,isize) - else - call $Xradix_sort(x,iorder,isize,-1) - endif +! call $Xradix_sort(x,iorder,isize,-1) + call quick_$Xsort(x,iorder,isize) end subroutine $Xsort SUBST [ X, type ] @@ -460,11 +316,6 @@ SUBST [ X, type ] i2 ; integer*2 ;; END_TEMPLATE -IRP_ENDIF -!---------------------- END NON-INTEL - - - BEGIN_TEMPLATE subroutine $Xset_order(x,iorder,isize) implicit none @@ -562,12 +413,10 @@ SUBST [ X, type ] i2; integer*2 ;; END_TEMPLATE - BEGIN_TEMPLATE -recursive subroutine $Xradix_sort$big(x,iorder,isize,iradix) + recursive subroutine $Xradix_sort$big(x,iorder,isize,iradix) implicit none - BEGIN_DOC ! Sort integer array x(isize) using the radix sort algorithm. ! iorder in input should be (1,2,3,...,isize), and in output @@ -703,14 +552,24 @@ recursive subroutine $Xradix_sort$big(x,iorder,isize,iradix) endif +! !$OMP PARALLEL DEFAULT(SHARED) if (isize > 1000000) +! !$OMP SINGLE if (i3>1_$int_type) then +! !$OMP TASK FIRSTPRIVATE(iradix_new,i3) SHARED(x,iorder) if(i3 > 1000000) call $Xradix_sort$big(x,iorder,i3,iradix_new-1) +! !$OMP END TASK endif if (isize-i3>1_$int_type) then +! !$OMP TASK FIRSTPRIVATE(iradix_new,i3) SHARED(x,iorder) if(isize-i3 > 1000000) call $Xradix_sort$big(x(i3+1_$int_type),iorder(i3+1_$int_type),isize-i3,iradix_new-1) +! !$OMP END TASK endif +! !$OMP TASKWAIT +! !$OMP END SINGLE +! !$OMP END PARALLEL + return endif @@ -765,11 +624,16 @@ recursive subroutine $Xradix_sort$big(x,iorder,isize,iradix) if (i1>1_$int_type) then + !$OMP TASK FIRSTPRIVATE(i0,iradix,i1) SHARED(x,iorder) if(i1 >1000000) call $Xradix_sort$big(x(i0+1_$int_type),iorder(i0+1_$int_type),i1,iradix-1) + !$OMP END TASK endif if (i0>1) then + !$OMP TASK FIRSTPRIVATE(i0,iradix) SHARED(x,iorder) if(i0 >1000000) call $Xradix_sort$big(x,iorder,i0,iradix-1) + !$OMP END TASK endif + !$OMP TASKWAIT end @@ -782,4 +646,3 @@ SUBST [ X, type, integer_size, is_big, big, int_type ] END_TEMPLATE - From fccd7e2d1a22c3e1599311cd431bed602314cc71 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Tue, 26 Oct 2021 20:49:48 +0200 Subject: [PATCH 09/86] reput the sort.irp.f --- src/utils/sort.irp.f | 209 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 173 insertions(+), 36 deletions(-) diff --git a/src/utils/sort.irp.f b/src/utils/sort.irp.f index 2a655eed..a63eb4a3 100644 --- a/src/utils/sort.irp.f +++ b/src/utils/sort.irp.f @@ -38,15 +38,7 @@ BEGIN_TEMPLATE $type,intent(inout) :: x(isize) integer,intent(inout) :: iorder(isize) integer, external :: omp_get_num_threads - if (omp_get_num_threads() == 1) then - !$OMP PARALLEL DEFAULT(SHARED) - !$OMP SINGLE - call rec_$X_quicksort(x,iorder,isize,1,isize,nproc) - !$OMP END SINGLE - !$OMP END PARALLEL - else - call rec_$X_quicksort(x,iorder,isize,1,isize,nproc) - endif + call rec_$X_quicksort(x,iorder,isize,1,isize,nproc) end recursive subroutine rec_$X_quicksort(x, iorder, isize, first, last, level) @@ -57,7 +49,7 @@ BEGIN_TEMPLATE $type :: c, tmp integer :: itmp integer :: i, j - + if(isize<2)return c = x( shiftr(first+last,1) ) @@ -89,16 +81,11 @@ BEGIN_TEMPLATE endif else if (first < i-1) then - !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,first,i,level) call rec_$X_quicksort(x, iorder, isize, first, i-1,level/2) - !$OMP END TASK endif if (j+1 < last) then - !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,last,j,level) call rec_$X_quicksort(x, iorder, isize, j+1, last,level/2) - !$OMP END TASK endif - !$OMP TASKWAIT endif end @@ -262,7 +249,60 @@ SUBST [ X, type ] i2 ; integer*2 ;; END_TEMPLATE + +!---------------------- INTEL +IRP_IF INTEL + BEGIN_TEMPLATE + subroutine $Xsort(x,iorder,isize) + use intel + implicit none + BEGIN_DOC + ! Sort array x(isize). + ! iorder in input should be (1,2,3,...,isize), and in output + ! contains the new order of the elements. + END_DOC + integer,intent(in) :: isize + $type,intent(inout) :: x(isize) + integer,intent(inout) :: iorder(isize) + integer :: n + character, allocatable :: tmp(:) + if (isize < 2) return + call ippsSortRadixIndexGetBufferSize(isize, $ippsz, n) + allocate(tmp(n)) + call ippsSortRadixIndexAscend_$ityp(x, $n, iorder, isize, tmp) + deallocate(tmp) + iorder(1:isize) = iorder(1:isize)+1 + call $Xset_order(x,iorder,isize) + end + + subroutine $Xsort_noidx(x,isize) + use intel + implicit none + BEGIN_DOC + ! Sort array x(isize). + ! iorder in input should be (1,2,3,...,isize), and in output + ! contains the new order of the elements. + END_DOC + integer,intent(in) :: isize + $type,intent(inout) :: x(isize) + integer :: n + character, allocatable :: tmp(:) + if (isize < 2) return + call ippsSortRadixIndexGetBufferSize(isize, $ippsz, n) + allocate(tmp(n)) + call ippsSortRadixAscend_$ityp_I(x, isize, tmp) + deallocate(tmp) + end + +SUBST [ X, type, ityp, n, ippsz ] + ; real ; 32f ; 4 ; 13 ;; + i ; integer ; 32s ; 4 ; 11 ;; + i2 ; integer*2 ; 16s ; 2 ; 7 ;; +END_TEMPLATE + +BEGIN_TEMPLATE + subroutine $Xsort(x,iorder,isize) implicit none BEGIN_DOC @@ -289,12 +329,12 @@ BEGIN_TEMPLATE endif end subroutine $Xsort -SUBST [ X, type, Y ] - ; real ; i ;; - d ; double precision ; i8 ;; +SUBST [ X, type ] + d ; double precision ;; END_TEMPLATE BEGIN_TEMPLATE + subroutine $Xsort(x,iorder,isize) implicit none BEGIN_DOC @@ -306,8 +346,112 @@ BEGIN_TEMPLATE $type,intent(inout) :: x(isize) integer,intent(inout) :: iorder(isize) integer :: n -! call $Xradix_sort(x,iorder,isize,-1) - call quick_$Xsort(x,iorder,isize) + if (isize < 2) then + return + endif + call sorted_$Xnumber(x,isize,n) + if (isize == n) then + return + endif + if ( isize < 32) then + call insertion_$Xsort(x,iorder,isize) + else + call $Xradix_sort(x,iorder,isize,-1) + endif + end subroutine $Xsort + +SUBST [ X, type ] + i8 ; integer*8 ;; +END_TEMPLATE + +!---------------------- END INTEL +IRP_ELSE +!---------------------- NON-INTEL +BEGIN_TEMPLATE + + subroutine $Xsort_noidx(x,isize) + implicit none + BEGIN_DOC + ! Sort array x(isize). + END_DOC + integer,intent(in) :: isize + $type,intent(inout) :: x(isize) + integer, allocatable :: iorder(:) + integer :: i + allocate(iorder(isize)) + do i=1,isize + iorder(i)=i + enddo + call $Xsort(x,iorder,isize) + deallocate(iorder) + end subroutine $Xsort_noidx + +SUBST [ X, type ] + ; real ;; + d ; double precision ;; + i ; integer ;; + i8 ; integer*8 ;; + i2 ; integer*2 ;; +END_TEMPLATE + +BEGIN_TEMPLATE + + subroutine $Xsort(x,iorder,isize) + implicit none + BEGIN_DOC + ! Sort array x(isize). + ! iorder in input should be (1,2,3,...,isize), and in output + ! contains the new order of the elements. + END_DOC + integer,intent(in) :: isize + $type,intent(inout) :: x(isize) + integer,intent(inout) :: iorder(isize) + integer :: n + if (isize < 2) then + return + endif +! call sorted_$Xnumber(x,isize,n) +! if (isize == n) then +! return +! endif + if ( isize < 32) then + call insertion_$Xsort(x,iorder,isize) + else +! call heap_$Xsort(x,iorder,isize) + call quick_$Xsort(x,iorder,isize) + endif + end subroutine $Xsort + +SUBST [ X, type ] + ; real ;; + d ; double precision ;; +END_TEMPLATE + +BEGIN_TEMPLATE + + subroutine $Xsort(x,iorder,isize) + implicit none + BEGIN_DOC + ! Sort array x(isize). + ! iorder in input should be (1,2,3,...,isize), and in output + ! contains the new order of the elements. + END_DOC + integer,intent(in) :: isize + $type,intent(inout) :: x(isize) + integer,intent(inout) :: iorder(isize) + integer :: n + if (isize < 2) then + return + endif + call sorted_$Xnumber(x,isize,n) + if (isize == n) then + return + endif + if ( isize < 32) then + call insertion_$Xsort(x,iorder,isize) + else + call $Xradix_sort(x,iorder,isize,-1) + endif end subroutine $Xsort SUBST [ X, type ] @@ -316,6 +460,11 @@ SUBST [ X, type ] i2 ; integer*2 ;; END_TEMPLATE +IRP_ENDIF +!---------------------- END NON-INTEL + + + BEGIN_TEMPLATE subroutine $Xset_order(x,iorder,isize) implicit none @@ -413,10 +562,12 @@ SUBST [ X, type ] i2; integer*2 ;; END_TEMPLATE + BEGIN_TEMPLATE - recursive subroutine $Xradix_sort$big(x,iorder,isize,iradix) +recursive subroutine $Xradix_sort$big(x,iorder,isize,iradix) implicit none + BEGIN_DOC ! Sort integer array x(isize) using the radix sort algorithm. ! iorder in input should be (1,2,3,...,isize), and in output @@ -552,24 +703,14 @@ BEGIN_TEMPLATE endif -! !$OMP PARALLEL DEFAULT(SHARED) if (isize > 1000000) -! !$OMP SINGLE if (i3>1_$int_type) then -! !$OMP TASK FIRSTPRIVATE(iradix_new,i3) SHARED(x,iorder) if(i3 > 1000000) call $Xradix_sort$big(x,iorder,i3,iradix_new-1) -! !$OMP END TASK endif if (isize-i3>1_$int_type) then -! !$OMP TASK FIRSTPRIVATE(iradix_new,i3) SHARED(x,iorder) if(isize-i3 > 1000000) call $Xradix_sort$big(x(i3+1_$int_type),iorder(i3+1_$int_type),isize-i3,iradix_new-1) -! !$OMP END TASK endif -! !$OMP TASKWAIT -! !$OMP END SINGLE -! !$OMP END PARALLEL - return endif @@ -624,16 +765,11 @@ BEGIN_TEMPLATE if (i1>1_$int_type) then - !$OMP TASK FIRSTPRIVATE(i0,iradix,i1) SHARED(x,iorder) if(i1 >1000000) call $Xradix_sort$big(x(i0+1_$int_type),iorder(i0+1_$int_type),i1,iradix-1) - !$OMP END TASK endif if (i0>1) then - !$OMP TASK FIRSTPRIVATE(i0,iradix) SHARED(x,iorder) if(i0 >1000000) call $Xradix_sort$big(x,iorder,i0,iradix-1) - !$OMP END TASK endif - !$OMP TASKWAIT end @@ -646,3 +782,4 @@ SUBST [ X, type, integer_size, is_big, big, int_type ] END_TEMPLATE + From b19569905057f36aedbd478620d57cf4f8b4542b Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Thu, 28 Oct 2021 15:19:45 +0200 Subject: [PATCH 10/86] added H_matrix_diag_all_dets --- src/determinants/utils.irp.f | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/determinants/utils.irp.f b/src/determinants/utils.irp.f index 3aec16f9..bd2ee293 100644 --- a/src/determinants/utils.irp.f +++ b/src/determinants/utils.irp.f @@ -20,6 +20,25 @@ BEGIN_PROVIDER [ double precision, H_matrix_all_dets,(N_det,N_det) ] !$OMP END PARALLEL DO END_PROVIDER +BEGIN_PROVIDER [ double precision, H_matrix_diag_all_dets,(N_det) ] + use bitmasks + implicit none + BEGIN_DOC + ! |H| matrix on the basis of the Slater determinants defined by psi_det + END_DOC + integer :: i + double precision :: hij + integer :: degree(N_det) + call i_H_j(psi_det(1,1,1),psi_det(1,1,1),N_int,hij) + !$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,hij,degree) & + !$OMP SHARED (N_det, psi_det, N_int,H_matrix_diag_all_dets) + do i =1,N_det + call i_H_j(psi_det(1,1,i),psi_det(1,1,i),N_int,hij) + H_matrix_diag_all_dets(i) = hij + enddo + !$OMP END PARALLEL DO +END_PROVIDER + BEGIN_PROVIDER [ double precision, S2_matrix_all_dets,(N_det,N_det) ] use bitmasks From 18bb5ee9172841bd4c8a33ca144f65be2b469a22 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Fri, 29 Oct 2021 11:44:37 +0200 Subject: [PATCH 11/86] added davidson for diagonal dress --- .../dav_diag_dressed_ext_rout.irp.f | 481 ++++++++++++++++++ .../dav_double_dress_ext_rout.irp.f | 2 +- .../dav_dressed_ext_rout.irp.f | 4 +- src/dav_general_mat/dav_ext_rout.irp.f | 8 +- src/determinants/utils.irp.f | 2 + 5 files changed, 491 insertions(+), 6 deletions(-) create mode 100644 src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f diff --git a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f new file mode 100644 index 00000000..2f3d7f80 --- /dev/null +++ b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f @@ -0,0 +1,481 @@ + +subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc) + use mmap_module + implicit none + BEGIN_DOC + ! Generic Davidson diagonalization with ONE DIAGONAL DRESSING OPERATOR + ! + ! Dress_jj : DIAGONAL DRESSING of the Hamiltonian + ! + ! H_jj : specific diagonal H matrix elements to diagonalize de Davidson + ! + ! u_in : guess coefficients on the various states. Overwritten on exit + ! + ! sze : leftmost dimension of u_in + ! + ! sze : Number of determinants + ! + ! N_st : Number of eigenstates + ! + ! N_st_diag_in : Number of states in which H is diagonalized. Assumed > sze + ! + ! Initial guess vectors are not necessarily orthonormal + ! + ! hcalc subroutine to compute W = H U (see routine hcalc_template for template of input/output) + END_DOC + integer, intent(in) :: sze, N_st, N_st_diag_in + double precision, intent(in) :: H_jj(sze),Dress_jj(sze) + double precision, intent(inout) :: u_in(sze,N_st_diag_in) + double precision, intent(out) :: energies(N_st) + external hcalc + + integer :: iter, N_st_diag + integer :: i,j,k,l,m + logical, intent(inout) :: converged + + double precision, external :: u_dot_v, u_dot_u + + integer :: k_pairs, kl + + integer :: iter2, itertot + double precision, allocatable :: y(:,:), h(:,:), lambda(:) + double precision, allocatable :: residual_norm(:) + character*(16384) :: write_buffer + double precision :: to_print(2,N_st) + double precision :: cpu, wall + integer :: shift, shift2, itermax, istate + double precision :: r1, r2, alpha + integer :: nproc_target + integer :: order(N_st_diag_in) + double precision :: cmax + double precision, allocatable :: U(:,:), overlap(:,:)!, S_d(:,:) + double precision, pointer :: W(:,:) + logical :: disk_based + double precision :: energy_shift(N_st_diag_in*davidson_sze_max) + + include 'constants.include.F' + + N_st_diag = N_st_diag_in + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, y, h, lambda + if (N_st_diag*3 > sze) then + print *, 'error in Davidson :' + print *, 'Increase n_det_max_full to ', N_st_diag*3 + stop -1 + endif + + itermax = max(2,min(davidson_sze_max, sze/N_st_diag))+1 + itertot = 0 + + if (state_following) then + allocate(overlap(N_st_diag*itermax, N_st_diag*itermax)) + else + allocate(overlap(1,1)) ! avoid 'if' for deallocate + endif + overlap = 0.d0 + + provide threshold_davidson !nthreads_davidson + call write_time(6) + write(6,'(A)') '' + write(6,'(A)') 'Davidson Diagonalization' + write(6,'(A)') '------------------------' + write(6,'(A)') '' + + ! Find max number of cores to fit in memory + ! ----------------------------------------- + + nproc_target = nproc + double precision :: rss + integer :: maxab + maxab = sze + + m=1 + disk_based = .False. + call resident_memory(rss) + do + r1 = 8.d0 * &! bytes + ( dble(sze)*(N_st_diag*itermax) &! U + + 1.d0*dble(sze*m)*(N_st_diag*itermax) &! W + + 2.0d0*(N_st_diag*itermax)**2 &! h,y + + 2.d0*(N_st_diag*itermax) &! s2,lambda + + 1.d0*(N_st_diag) &! residual_norm + ! In H_S2_u_0_nstates_zmq + + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on collector + + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on slave + + 0.5d0*maxab &! idx0 in H_S2_u_0_nstates_openmp_work_* + + nproc_target * &! In OMP section + ( 1.d0*(N_int*maxab) &! buffer + + 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx + ) / 1024.d0**3 + + if (nproc_target == 0) then + call check_mem(r1,irp_here) + nproc_target = 1 + exit + endif + + if (r1+rss < qp_max_mem) then + exit + endif + + if (itermax > 4) then + itermax = itermax - 1 + else if (m==1.and.disk_based_davidson) then + m=0 + disk_based = .True. + itermax = 6 + else + nproc_target = nproc_target - 1 + endif + + enddo + nthreads_davidson = nproc_target + TOUCH nthreads_davidson + call write_int(6,N_st,'Number of states') + call write_int(6,N_st_diag,'Number of states in diagonalization') + call write_int(6,sze,'Number of basis functions') + call write_int(6,nproc_target,'Number of threads for diagonalization') + call write_double(6, r1, 'Memory(Gb)') + if (disk_based) then + print *, 'Using swap space to reduce RAM' + endif + + double precision, allocatable :: H_jj_tmp(:) + ASSERT (N_st > 0) + ASSERT (sze > 0) + allocate(H_jj_tmp(sze)) + + do i=1,sze + H_jj_tmp(i) = H_jj(i) + Dress_jj(i) + enddo + + !--------------- + + write(6,'(A)') '' + write_buffer = '=====' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ ===========' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + write_buffer = 'Iter' + do i=1,N_st + write_buffer = trim(write_buffer)//' Energy Residual ' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + write_buffer = '=====' + do i=1,N_st + write_buffer = trim(write_buffer)//' ================ ===========' + enddo + write(6,'(A)') write_buffer(1:6+41*N_st) + + + allocate(W(sze,N_st_diag*itermax)) + + allocate( & + ! Large + U(sze,N_st_diag*itermax), & + ! Small + h(N_st_diag*itermax,N_st_diag*itermax), & + y(N_st_diag*itermax,N_st_diag*itermax), & + residual_norm(N_st_diag), & + lambda(N_st_diag*itermax)) + + h = 0.d0 + U = 0.d0 + y = 0.d0 + + + ASSERT (N_st > 0) + ASSERT (N_st_diag >= N_st) + ASSERT (sze > 0) + + ! Davidson iterations + ! =================== + + converged = .False. + + ! Initialize from N_st to N_st_diat with gaussian random numbers + ! to be sure to have overlap with any eigenvectors + do k=N_st+1,N_st_diag + u_in(k,k) = 10.d0 + do i=1,sze + call random_number(r1) + call random_number(r2) + r1 = dsqrt(-2.d0*dlog(r1)) + r2 = dtwo_pi*r2 + u_in(i,k) = r1*dcos(r2) + enddo + enddo + ! Normalize all states + do k=1,N_st_diag + call normalize(u_in(1,k),sze) + enddo + + ! Copy from the guess input "u_in" to the working vectors "U" + do k=1,N_st_diag + do i=1,sze + U(i,k) = u_in(i,k) + enddo + enddo + + + do while (.not.converged) + itertot = itertot+1 + if (itertot == 8) then + exit + endif + + do iter=1,itermax-1 + + shift = N_st_diag*(iter-1) + shift2 = N_st_diag*iter + + if ((iter > 1).or.(itertot == 1)) then + ! Compute |W_k> = \sum_i |i> + ! ----------------------------------- + + ! Gram-Schmidt to orthogonalize all new guess with the previous vectors + call ortho_qr(U,size(U,1),sze,shift2) + call ortho_qr(U,size(U,1),sze,shift2) + ! it does W = H U with W(sze,N_st_diag),U(sze,N_st_diag) + ! where sze is the size of the vector, N_st_diag is the number of states + call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag,sze) + ! Compute then the DIAGONAL PART OF THE DRESSING + ! += Dress_jj(i) * + call dressing_diag_uv(W(1,shift+1),U(1,shift+1),Dress_jj,N_st_diag_in,sze) + else + ! Already computed in update below + continue + endif + + ! Compute h_kl = = + ! ------------------------------------------- + + call dgemm('T','N', shift2, shift2, sze, & + 1.d0, U, size(U,1), W, size(W,1), & + 0.d0, h, size(h,1)) + + ! Diagonalize h y = lambda y + ! --------------- + + call lapack_diag(lambda,y,h,size(h,1),shift2) + + if (state_following) then + + overlap = -1.d0 + do k=1,shift2 + do i=1,shift2 + overlap(k,i) = dabs(y(k,i)) + enddo + enddo + do k=1,N_st + cmax = -1.d0 + do i=1,N_st + if (overlap(i,k) > cmax) then + cmax = overlap(i,k) + order(k) = i + endif + enddo + do i=1,N_st_diag + overlap(order(k),i) = -1.d0 + enddo + enddo + overlap = y + do k=1,N_st + l = order(k) + if (k /= l) then + y(1:shift2,k) = overlap(1:shift2,l) + endif + enddo + do k=1,N_st + overlap(k,1) = lambda(k) + enddo + do k=1,N_st + l = order(k) + if (k /= l) then + lambda(k) = overlap(l,1) + endif + enddo + + endif + + + ! Express eigenvectors of h in the determinant basis + ! -------------------------------------------------- + + call dgemm('N','N', sze, N_st_diag, shift2, & + 1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1)) + call dgemm('N','N', sze, N_st_diag, shift2, & + 1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1)) + + ! Compute residual vector and davidson step + ! ----------------------------------------- + + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k) + do k=1,N_st_diag + do i=1,sze + U(i,shift2+k) = & + (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & + /max(H_jj_tmp(i) - lambda (k),1.d-2) + enddo + + if (k <= N_st) then + residual_norm(k) = u_dot_u(U(1,shift2+k),sze) + to_print(1,k) = lambda(k) + to_print(2,k) = residual_norm(k) + endif + enddo + !$OMP END PARALLEL DO + + + if ((itertot>1).and.(iter == 1)) then + !don't print + continue + else + write(*,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter-1, to_print(1:2,1:N_st) + endif + + ! Check convergence + if (iter > 1) then + converged = dabs(maxval(residual_norm(1:N_st))) < threshold_davidson + endif + + + do k=1,N_st + if (residual_norm(k) > 1.e8) then + print *, 'Davidson failed' + stop -1 + endif + enddo + if (converged) then + exit + endif + + logical, external :: qp_stop + if (qp_stop()) then + converged = .True. + exit + endif + + + enddo + + call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & + W, size(W,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) + do k=1,N_st_diag + do i=1,sze + W(i,k) = u_in(i,k) + enddo + enddo + + call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & + U, size(U,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) + do k=1,N_st_diag + do i=1,sze + U(i,k) = u_in(i,k) + enddo + enddo + call ortho_qr(U,size(U,1),sze,N_st_diag) + call ortho_qr(U,size(U,1),sze,N_st_diag) + do j=1,N_st_diag + k=1 + do while ((k 1).or.(itertot == 1)) then ! Compute |W_k> = \sum_i |i> ! ----------------------------------- - ! Gram-Schmidt to orthogonalize all new guess with the previous vectors call ortho_qr(U,size(U,1),sze,shift2) call ortho_qr(U,size(U,1),sze,shift2) @@ -345,6 +344,9 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co enddo + ! Re-contract U and update W + ! -------------------------------- + call dgemm('N','N', sze, N_st_diag, shift2, 1.d0, & W, size(W,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) do k=1,N_st_diag @@ -360,8 +362,8 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co U(i,k) = u_in(i,k) enddo enddo - call ortho_qr(U,size(U,1),sze,N_st_diag) - call ortho_qr(U,size(U,1),sze,N_st_diag) + call ortho_qr(U,size(U,1),sze,N_st_diag) + call ortho_qr(U,size(U,1),sze,N_st_diag) do j=1,N_st_diag k=1 do while ((k Date: Fri, 5 Nov 2021 15:17:39 +0100 Subject: [PATCH 12/86] removed stupid assert --- .../dav_double_dress_ext_rout.irp.f | 2 -- src/mo_two_e_ints/map_integrals.irp.f | 30 +++++++++---------- 2 files changed, 15 insertions(+), 17 deletions(-) diff --git a/src/dav_general_mat/dav_double_dress_ext_rout.irp.f b/src/dav_general_mat/dav_double_dress_ext_rout.irp.f index 4f4572fa..884fd672 100644 --- a/src/dav_general_mat/dav_double_dress_ext_rout.irp.f +++ b/src/dav_general_mat/dav_double_dress_ext_rout.irp.f @@ -207,8 +207,6 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies ASSERT (N_st > 0) ASSERT (N_st_diag_in >= N_st) ASSERT (sze > 0) - ASSERT (Nint > 0) - ASSERT (Nint == N_int) ! Davidson iterations ! =================== diff --git a/src/mo_two_e_ints/map_integrals.irp.f b/src/mo_two_e_ints/map_integrals.irp.f index 9f73d518..272916e3 100644 --- a/src/mo_two_e_ints/map_integrals.irp.f +++ b/src/mo_two_e_ints/map_integrals.irp.f @@ -302,21 +302,21 @@ end integer(key_kind) :: idx double precision :: tmp - icount = 1 ! Avoid division by zero - do j=1,mo_num - do i=1,j-1 - call two_e_integrals_index(i,j,j,i,idx) - !DIR$ FORCEINLINE - call map_get(mo_integrals_map,idx,tmp) - banned_excitation(i,j) = dabs(tmp) < 1.d-14 - banned_excitation(j,i) = banned_excitation(i,j) - if (banned_excitation(i,j)) icount = icount+2 - enddo - enddo - use_banned_excitation = (mo_num*mo_num) / icount <= 100 !1% - if (use_banned_excitation) then - print *, 'Using sparsity of exchange integrals' - endif +!icount = 1 ! Avoid division by zero +!do j=1,mo_num +! do i=1,j-1 +! call two_e_integrals_index(i,j,j,i,idx) +! !DIR$ FORCEINLINE +! call map_get(mo_integrals_map,idx,tmp) +! banned_excitation(i,j) = dabs(tmp) < 1.d-14 +! banned_excitation(j,i) = banned_excitation(i,j) +! if (banned_excitation(i,j)) icount = icount+2 +! enddo +!enddo +!use_banned_excitation = (mo_num*mo_num) / icount <= 100 !1% +!if (use_banned_excitation) then +! print *, 'Using sparsity of exchange integrals' +!endif END_PROVIDER From af169a4e3cb3502df3ea0946f77f626e9d5a4aad Mon Sep 17 00:00:00 2001 From: FiletoRodriguez Date: Tue, 9 Nov 2021 15:48:49 +0100 Subject: [PATCH 13/86] Added grad_rho --- src/dft_one_e/mu_erf_dft.irp.f | 2 ++ src/dft_utils_func/mu_of_r_dft.irp.f | 2 +- src/kohn_sham_rs/rs_ks_scf.irp.f | 2 +- 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/dft_one_e/mu_erf_dft.irp.f b/src/dft_one_e/mu_erf_dft.irp.f index f9bff24d..bf590c84 100644 --- a/src/dft_one_e/mu_erf_dft.irp.f +++ b/src/dft_one_e/mu_erf_dft.irp.f @@ -22,6 +22,8 @@ BEGIN_PROVIDER [double precision, mu_of_r_dft, (n_points_final_grid)] mu_of_r_dft(i) = mu_of_r_hf(i) else if(mu_dft_type == "rsc")then mu_of_r_dft(i) = mu_rsc_of_r(i) + else if(mu_dft_type == "grad_rho")then + mu_of_r_dft(i) = mu_grad_rho(i) else print*,'mu_dft_type is not of good type = ',mu_dft_type print*,'it must be of type Read, cst, hf, rsc' diff --git a/src/dft_utils_func/mu_of_r_dft.irp.f b/src/dft_utils_func/mu_of_r_dft.irp.f index 7cba0a60..0e9a0f1b 100644 --- a/src/dft_utils_func/mu_of_r_dft.irp.f +++ b/src/dft_utils_func/mu_of_r_dft.irp.f @@ -17,7 +17,7 @@ double precision function mu_grad_rho_func(r) integer :: m double precision :: rho, dm_a, dm_b, grad_dm_a(3), grad_dm_b(3) double precision :: eta, grad_rho(3), grad_sqr - eta = 0.135d0 + eta = mu_erf call density_and_grad_alpha_beta(r,dm_a,dm_b, grad_dm_a, grad_dm_b) rho = dm_a + dm_b do m = 1,3 diff --git a/src/kohn_sham_rs/rs_ks_scf.irp.f b/src/kohn_sham_rs/rs_ks_scf.irp.f index 5d23544e..84b85136 100644 --- a/src/kohn_sham_rs/rs_ks_scf.irp.f +++ b/src/kohn_sham_rs/rs_ks_scf.irp.f @@ -17,7 +17,7 @@ program rs_ks_scf print*, '**************************' print*, 'mu_erf_dft = ',mu_erf_dft print*, '**************************' - call check_coherence_functional +! call check_coherence_functional call create_guess call orthonormalize_mos call run From d6542e62a3cc3880b08aa85258467abae7be7c6b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 17 Nov 2021 09:02:26 +0100 Subject: [PATCH 14/86] Fix floating-point exception --- src/csf/sigma_vector.irp.f | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 85ed5f84..77f6190b 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -1,9 +1,12 @@ real*8 function logabsgamma(x) implicit none real*8, intent(in) :: x - logabsgamma = log(abs(gamma(x))) + logabsgamma = 1.d32 ! Avoid floating point exception + if (x>0.d0) then + logabsgamma = log(abs(gamma(x))) + endif end function logabsgamma - + BEGIN_PROVIDER [ integer, NSOMOMax] &BEGIN_PROVIDER [ integer, NCSFMax] &BEGIN_PROVIDER [ integer*8, NMO] From 3d478029e8d8d5a8b2bd492c749ce1ad689168ad Mon Sep 17 00:00:00 2001 From: ydamour Date: Thu, 18 Nov 2021 09:19:41 +0100 Subject: [PATCH 15/86] test intel bug --- config/ifort.cfg | 2 +- src/utils/intel_check_omp.irp.f | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) create mode 100644 src/utils/intel_check_omp.irp.f diff --git a/config/ifort.cfg b/config/ifort.cfg index 714c4b10..9d8302b8 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DINTEL_CHECK_OMP # Global options ################ diff --git a/src/utils/intel_check_omp.irp.f b/src/utils/intel_check_omp.irp.f new file mode 100644 index 00000000..6933377c --- /dev/null +++ b/src/utils/intel_check_omp.irp.f @@ -0,0 +1,16 @@ +subroutine intel_check_omp() + +! Doc : idk + + implicit none + + IRP_IF INTEL_CHECK_OMP + call omp_set_max_active_levels(5) + print*,'INTEL_CHECK_OMP: true' + IRP_ELSE + call omp_set_nested(.True.) + !call omp_set_nested(.False.) + print*,'INTEL_CHECK_OMP: false' + IRP_ENDIF + +end From d521bfaa6f5664b76809f4a5439fb69c5f40e50a Mon Sep 17 00:00:00 2001 From: ydamour Date: Thu, 18 Nov 2021 14:54:34 +0100 Subject: [PATCH 16/86] test comp flags --- config/gfortran.cfg | 2 +- config/ifort.cfg | 2 +- config/ifort_2019.cfg | 63 +++++++++++++++++++++++++++++++++ config/ifort_2021.cfg | 63 +++++++++++++++++++++++++++++++++ src/utils/intel_check_omp.irp.f | 14 +++++--- 5 files changed, 137 insertions(+), 7 deletions(-) create mode 100644 config/ifort_2019.cfg create mode 100644 config/ifort_2021.cfg diff --git a/config/gfortran.cfg b/config/gfortran.cfg index 342acae9..ec72e722 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -13,7 +13,7 @@ FC : gfortran -g -ffree-line-length-none -I . -fPIC LAPACK_LIB : -lblas -llapack IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 --assert +IRPF90_FLAGS : --ninja --align=32 --assert -DGNU_CHECK_OMP # Global options ################ diff --git a/config/ifort.cfg b/config/ifort.cfg index 9d8302b8..63c4a5d3 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL -DINTEL_CHECK_OMP +IRPF90_FLAGS : --ninja --align=32 -DINTEL # Global options ################ diff --git a/config/ifort_2019.cfg b/config/ifort_2019.cfg new file mode 100644 index 00000000..35cf63f7 --- /dev/null +++ b/config/ifort_2019.cfg @@ -0,0 +1,63 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : ifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DINTEL2019_CHECK_OMP + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FC : -traceback +FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + diff --git a/config/ifort_2021.cfg b/config/ifort_2021.cfg new file mode 100644 index 00000000..78e201f2 --- /dev/null +++ b/config/ifort_2021.cfg @@ -0,0 +1,63 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : ifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DINTEL2021_CHECK_OMP + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FC : -traceback +FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + diff --git a/src/utils/intel_check_omp.irp.f b/src/utils/intel_check_omp.irp.f index 6933377c..af86b131 100644 --- a/src/utils/intel_check_omp.irp.f +++ b/src/utils/intel_check_omp.irp.f @@ -4,13 +4,17 @@ subroutine intel_check_omp() implicit none - IRP_IF INTEL_CHECK_OMP + IRP_IF INTEL2021_CHECK_OMP call omp_set_max_active_levels(5) - print*,'INTEL_CHECK_OMP: true' - IRP_ELSE + print*,'INTEL2021_CHECK_OMP: true' + IRP_ENDIF + IRP_IF INTEL2019_CHECK_OMP call omp_set_nested(.True.) - !call omp_set_nested(.False.) - print*,'INTEL_CHECK_OMP: false' + print*,'INTEL2019_CHECK_OMP: true' + IRP_ENDIF + IRP_IF GNU_CHECK_OMP + call omp_set_nested(.True.) + print*,'GNU_CHECK_OMP: true' IRP_ENDIF end From 243315ae7ccc64f03d1386fd3ebc99eebc6f3dac Mon Sep 17 00:00:00 2001 From: ydamour Date: Thu, 18 Nov 2021 14:55:17 +0100 Subject: [PATCH 17/86] TEST, file has to be removed after --- src/fci/test_intel_check_omp.irp.f | 115 +++++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) create mode 100644 src/fci/test_intel_check_omp.irp.f diff --git a/src/fci/test_intel_check_omp.irp.f b/src/fci/test_intel_check_omp.irp.f new file mode 100644 index 00000000..8a4711b3 --- /dev/null +++ b/src/fci/test_intel_check_omp.irp.f @@ -0,0 +1,115 @@ +program test_intel_check_omp + + use omp_lib + + implicit none + + integer :: i,j,k,l,m,n,x + double precision :: w1,w2,c1,c2 + double precision, allocatable :: accu(:,:,:,:) + + x = 4 + allocate(accu(x,x,x,x)) + + accu = 0d0 + + !$OMP PARALLEL + print*, 'Hello1 from:', OMP_GET_THREAD_NUM() + !$OMP END PARALLEL + + print*,'omp_get_max_active_levels:',omp_get_max_active_levels() + call intel_check_omp() + print*,'omp_get_max_active_levels:',omp_get_max_active_levels() + + !call omp_set_max_active_levels(20000) + + !$OMP PARALLEL + print*, 'Hello2 from:', OMP_GET_THREAD_NUM() + !$OMP END PARALLEL + + call wall_time(w1) + call cpu_time(c1) + !$OMP PARALLEL & + !$OMP PRIVATE(i,j,k,l,m,n) & + !$OMP SHARED(accu) + + print*,'level 1',omp_get_num_threads() + !$OMP DO + do l = 1, x + do k = 1, x + do j = 1, x + do i = 1, x + accu(i,j,k,l) = accu(i,j,k,l) + 1d0 + enddo + enddo + enddo + enddo + !$OMP END DO + + !$OMP PARALLEL & + !$OMP PRIVATE(i,j,k,l,m,n) & + !$OMP SHARED(accu) + + print*,'level 2',omp_get_num_threads() + !$OMP DO + do l = 1, x + do k = 1, x + do j = 1, x + do i = 1, x + accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 + enddo + enddo + enddo + enddo + !$OMP END DO + + !$OMP PARALLEL & + !$OMP PRIVATE(i,j,k,l,m,n) & + !$OMP SHARED(accu) + + print*,'level 3',omp_get_num_threads() + !$OMP DO + do l = 1, x + do k = 1, x + do j = 1, x + do i = 1, x + accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 + enddo + enddo + enddo + enddo + !$OMP END DO + + !$OMP PARALLEL & + !$OMP PRIVATE(i,j,k,l,m,n) & + !$OMP SHARED(accu) + + print*,'level 4',omp_get_num_threads() + !$OMP DO + do l = 1, x + do k = 1, x + do j = 1, x + do i = 1, x + accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 + enddo + enddo + enddo + enddo + !$OMP END DO + + !$OMP END PARALLEL + + !$OMP END PARALLEL + + !$OMP END PARALLEL + + !$OMP END PARALLEL + + call wall_time(w2) + call cpu_time(c2) + + print*,accu(1,1,1,1) + print*,'wall time:', w2-w1 + print*,'cpu time:', c2-c1 + print*,'ration',(c2-c1)/(w2-w1) +end From 612f5a5e9c1dc697bf07560bfdc92dcd58a3218e Mon Sep 17 00:00:00 2001 From: ydamour Date: Fri, 19 Nov 2021 09:57:04 +0100 Subject: [PATCH 18/86] add a test to check if omp works on multiple levels --- config/ifort.cfg | 2 +- src/fci/check_omp.irp.f | 242 +++++++++++++++++++ src/fci/test_intel_check_omp.irp.f | 115 --------- src/utils/intel_check_omp.irp.f | 20 -- src/utils/test_set_multiple_levels_omp.irp.f | 16 ++ 5 files changed, 259 insertions(+), 136 deletions(-) create mode 100644 src/fci/check_omp.irp.f delete mode 100644 src/fci/test_intel_check_omp.irp.f delete mode 100644 src/utils/intel_check_omp.irp.f create mode 100644 src/utils/test_set_multiple_levels_omp.irp.f diff --git a/config/ifort.cfg b/config/ifort.cfg index 63c4a5d3..714c4b10 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DINTEL # Global options ################ diff --git a/src/fci/check_omp.irp.f b/src/fci/check_omp.irp.f new file mode 100644 index 00000000..ffc113d6 --- /dev/null +++ b/src/fci/check_omp.irp.f @@ -0,0 +1,242 @@ +program check_omp + + use omp_lib + + implicit none + + integer :: i,j,k,l,m,n,x,z,setting + double precision :: w1,w2,c1,c2 + double precision, allocatable :: accu(:,:,:,:) + logical :: must_exit, verbose, is_working + + x = 4 + allocate(accu(x,x,x,x)) + + verbose = .False. + + accu = 0d0 + must_exit = .False. + + !$OMP PARALLEL + if (OMP_GET_NUM_THREADS() == 1) then + print*,'' + print*,'1 thread, no parallelization possible' + print*,'' + must_exit=.True. + endif + !$OMP END PARALLEL + if (must_exit) then + call abort + endif + + ! reset the number of max active levels + !call omp_set_max_active_levels(1) + + !print*,'omp_get_max_active_levels:',omp_get_max_active_levels() + !call intel_check_omp() + !print*,'omp_get_max_active_levels:',omp_get_max_active_levels() + + ! set the number of threads + call omp_set_num_threads(2) + + do z = 1, 4 + + if (must_exit) then + exit + endif + + call omp_set_max_active_levels(1) + call omp_set_nested(.False.) + + if (z==1) then + call test_set_multiple_levels_omp() + !call test_set_multiple_levels_omp + elseif (z==2) then + call omp_set_max_active_levels(5) + elseif (z==3) then + call omp_set_nested(.True.) + else + call omp_set_nested(.True.) + call omp_set_max_active_levels(5) + endif + + setting = z-1 + + !$OMP PARALLEL & + !$OMP PRIVATE(i,j,k,l,m,n) & + !$OMP SHARED(accu) + + if (verbose) then + print*,'Nb threads level 1:', omp_get_num_threads() + endif + + !$OMP MASTER + if (omp_get_num_threads()==1) then + print*,'Setting',setting,"error at level 1" + setting = -1 + endif + !$OMP END MASTER + + ! !$OMP DO + ! do l = 1, x + ! do k = 1, x + ! do j = 1, x + ! do i = 1, x + ! accu(i,j,k,l) = accu(i,j,k,l) + 1d0 + ! enddo + ! enddo + ! enddo + ! enddo + ! !$OMP END DO + + !$OMP PARALLEL & + !$OMP PRIVATE(i,j,k,l,m,n) & + !$OMP SHARED(accu) + + if (verbose) then + print*,'Nb threads level 2:', omp_get_num_threads() + endif + + !$OMP MASTER + if (omp_get_num_threads()==1 .and. setting >= 0) then + print*,'Setting',setting,"error at level 2" + setting = -1 + endif + !$OMP END MASTER + + ! !$OMP DO + ! do l = 1, x + ! do k = 1, x + ! do j = 1, x + ! do i = 1, x + ! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 + ! enddo + ! enddo + ! enddo + ! enddo + ! !$OMP END DO + + !$OMP PARALLEL & + !$OMP PRIVATE(i,j,k,l,m,n) & + !$OMP SHARED(accu) + + if (verbose) then + print*,'Nb threads level 3:', omp_get_num_threads() + endif + + !$OMP MASTER + if (omp_get_num_threads()==1 .and. setting >= 0) then + print*,'Setting',setting,"error at level 3" + setting = -1 + endif + !$OMP END MASTER + + ! !$OMP DO + ! do l = 1, x + ! do k = 1, x + ! do j = 1, x + ! do i = 1, x + ! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 + ! enddo + ! enddo + ! enddo + ! enddo + ! !$OMP END DO + + !$OMP PARALLEL & + !$OMP PRIVATE(i,j,k,l,m,n) & + !$OMP SHARED(accu) + + if (verbose) then + print*,'Nb threads level 4:', omp_get_num_threads() + endif + + !$OMP MASTER + if (omp_get_num_threads()==1 .and. setting >= 0) then + print*,'Setting',setting,"error at level 4" + elseif(omp_get_num_threads()==1 .or. setting == 0) then + else + must_exit = .True. + endif + + if ( z == 1 .and. setting == 0) then + is_working = .True. + elseif (z == 1 .and. setting == -1) then + is_working = .False. + else + endif + !$OMP END MASTER + + ! !$OMP DO + ! do l = 1, x + ! do k = 1, x + ! do j = 1, x + ! do i = 1, x + ! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 + ! enddo + ! enddo + ! enddo + ! enddo + ! !$OMP END DO + + !$OMP END PARALLEL + + !$OMP END PARALLEL + + !$OMP END PARALLEL + + !$OMP END PARALLEL + + enddo + + print*,'' + + if (setting == 1) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Please use the irpf90 flags -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' + elseif (setting == 2) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_nested(.True.)' + print*,'' + print*,'Please use the irpf90 flag -DSET_NESTED in qp2/config/${compiler_name}.cfg' + elseif (setting == 3) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_nested(.True.)' + print*,'+' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Please use the irpf90 flags -DSET_NESTED -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' + else + print*,'The parallelization on multiple levels does not work with:' + print*,'call omp_set_max_active_levels(5)' + print*,'or' + print*,'call omp_set_nested(.True.)' + print*,'or' + print*,'call omp_set_nested(.True.)' + print*,'+' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Good luck...' + endif + + if (is_working) then + print*,'' + print*,'==========================================================' + print*,'Your actual set up works for parallelization with 4 levels' + print*,'==========================================================' + print*,'' + else + print*,'' + print*,'===================================================================' + print*,'Your actual set up works for parallelization with 4 levels' + print*,'Please look at the previous messages to understand the requirements' + print*,'If it does not work even with the right irpf90 flags, clean and' + print*,'recompile your code at ${QP_ROOT}' + print*,'===================================================================' + print*,'' + endif + +end + diff --git a/src/fci/test_intel_check_omp.irp.f b/src/fci/test_intel_check_omp.irp.f deleted file mode 100644 index 8a4711b3..00000000 --- a/src/fci/test_intel_check_omp.irp.f +++ /dev/null @@ -1,115 +0,0 @@ -program test_intel_check_omp - - use omp_lib - - implicit none - - integer :: i,j,k,l,m,n,x - double precision :: w1,w2,c1,c2 - double precision, allocatable :: accu(:,:,:,:) - - x = 4 - allocate(accu(x,x,x,x)) - - accu = 0d0 - - !$OMP PARALLEL - print*, 'Hello1 from:', OMP_GET_THREAD_NUM() - !$OMP END PARALLEL - - print*,'omp_get_max_active_levels:',omp_get_max_active_levels() - call intel_check_omp() - print*,'omp_get_max_active_levels:',omp_get_max_active_levels() - - !call omp_set_max_active_levels(20000) - - !$OMP PARALLEL - print*, 'Hello2 from:', OMP_GET_THREAD_NUM() - !$OMP END PARALLEL - - call wall_time(w1) - call cpu_time(c1) - !$OMP PARALLEL & - !$OMP PRIVATE(i,j,k,l,m,n) & - !$OMP SHARED(accu) - - print*,'level 1',omp_get_num_threads() - !$OMP DO - do l = 1, x - do k = 1, x - do j = 1, x - do i = 1, x - accu(i,j,k,l) = accu(i,j,k,l) + 1d0 - enddo - enddo - enddo - enddo - !$OMP END DO - - !$OMP PARALLEL & - !$OMP PRIVATE(i,j,k,l,m,n) & - !$OMP SHARED(accu) - - print*,'level 2',omp_get_num_threads() - !$OMP DO - do l = 1, x - do k = 1, x - do j = 1, x - do i = 1, x - accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 - enddo - enddo - enddo - enddo - !$OMP END DO - - !$OMP PARALLEL & - !$OMP PRIVATE(i,j,k,l,m,n) & - !$OMP SHARED(accu) - - print*,'level 3',omp_get_num_threads() - !$OMP DO - do l = 1, x - do k = 1, x - do j = 1, x - do i = 1, x - accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 - enddo - enddo - enddo - enddo - !$OMP END DO - - !$OMP PARALLEL & - !$OMP PRIVATE(i,j,k,l,m,n) & - !$OMP SHARED(accu) - - print*,'level 4',omp_get_num_threads() - !$OMP DO - do l = 1, x - do k = 1, x - do j = 1, x - do i = 1, x - accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 - enddo - enddo - enddo - enddo - !$OMP END DO - - !$OMP END PARALLEL - - !$OMP END PARALLEL - - !$OMP END PARALLEL - - !$OMP END PARALLEL - - call wall_time(w2) - call cpu_time(c2) - - print*,accu(1,1,1,1) - print*,'wall time:', w2-w1 - print*,'cpu time:', c2-c1 - print*,'ration',(c2-c1)/(w2-w1) -end diff --git a/src/utils/intel_check_omp.irp.f b/src/utils/intel_check_omp.irp.f deleted file mode 100644 index af86b131..00000000 --- a/src/utils/intel_check_omp.irp.f +++ /dev/null @@ -1,20 +0,0 @@ -subroutine intel_check_omp() - -! Doc : idk - - implicit none - - IRP_IF INTEL2021_CHECK_OMP - call omp_set_max_active_levels(5) - print*,'INTEL2021_CHECK_OMP: true' - IRP_ENDIF - IRP_IF INTEL2019_CHECK_OMP - call omp_set_nested(.True.) - print*,'INTEL2019_CHECK_OMP: true' - IRP_ENDIF - IRP_IF GNU_CHECK_OMP - call omp_set_nested(.True.) - print*,'GNU_CHECK_OMP: true' - IRP_ENDIF - -end diff --git a/src/utils/test_set_multiple_levels_omp.irp.f b/src/utils/test_set_multiple_levels_omp.irp.f new file mode 100644 index 00000000..c4f721a1 --- /dev/null +++ b/src/utils/test_set_multiple_levels_omp.irp.f @@ -0,0 +1,16 @@ +subroutine test_set_multiple_levels_omp() + +! Doc : idk + + implicit none + + IRP_IF SET_MAX_ACT + print*,'SET_MAX_ACT: True, call omp_set_max_active_levels(5)' + call omp_set_max_active_levels(5) + IRP_ENDIF + IRP_IF SET_NESTED + print*,'SET_NESTED: True, call omp_set_nested(.True.)' + call omp_set_nested(.True.) + IRP_ENDIF + +end From f260f628250f25ccd78c3b866c465f0544f54362 Mon Sep 17 00:00:00 2001 From: ydamour Date: Fri, 19 Nov 2021 09:58:54 +0100 Subject: [PATCH 19/86] update --- config/ifort_2019.cfg | 63 ------------------------------------------- config/ifort_2021.cfg | 63 ------------------------------------------- 2 files changed, 126 deletions(-) delete mode 100644 config/ifort_2019.cfg delete mode 100644 config/ifort_2021.cfg diff --git a/config/ifort_2019.cfg b/config/ifort_2019.cfg deleted file mode 100644 index 35cf63f7..00000000 --- a/config/ifort_2019.cfg +++ /dev/null @@ -1,63 +0,0 @@ -# Common flags -############## -# -# -mkl=[parallel|sequential] : Use the MKL library -# --ninja : Allow the utilisation of ninja. It is mandatory ! -# --align=32 : Align all provided arrays on a 32-byte boundary -# -[COMMON] -FC : ifort -fpic -LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps -IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL -DINTEL2019_CHECK_OMP - -# Global options -################ -# -# 1 : Activate -# 0 : Deactivate -# -[OPTION] -MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below -CACHE : 0 ; Enable cache_compile.py -OPENMP : 1 ; Append OpenMP flags - -# Optimization flags -#################### -# -# -xHost : Compile a binary optimized for the current architecture -# -O2 : O3 not better than O2. -# -ip : Inter-procedural optimizations -# -ftz : Flushes denormal results to zero -# -[OPT] -FC : -traceback -FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g - -# Profiling flags -################# -# -[PROFILE] -FC : -p -g -FCFLAGS : -xSSE4.2 -O2 -ip -ftz - -# Debugging flags -################# -# -# -traceback : Activate backtrace on runtime -# -fpe0 : All floating point exaceptions -# -C : Checks uninitialized variables, array subscripts, etc... -# -g : Extra debugging information -# -xSSE2 : Valgrind needs a very simple x86 executable -# -[DEBUG] -FC : -g -traceback -FCFLAGS : -xSSE2 -C -fpe0 -implicitnone - -# OpenMP flags -################# -# -[OPENMP] -FC : -qopenmp -IRPF90_FLAGS : --openmp - diff --git a/config/ifort_2021.cfg b/config/ifort_2021.cfg deleted file mode 100644 index 78e201f2..00000000 --- a/config/ifort_2021.cfg +++ /dev/null @@ -1,63 +0,0 @@ -# Common flags -############## -# -# -mkl=[parallel|sequential] : Use the MKL library -# --ninja : Allow the utilisation of ninja. It is mandatory ! -# --align=32 : Align all provided arrays on a 32-byte boundary -# -[COMMON] -FC : ifort -fpic -LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps -IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL -DINTEL2021_CHECK_OMP - -# Global options -################ -# -# 1 : Activate -# 0 : Deactivate -# -[OPTION] -MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below -CACHE : 0 ; Enable cache_compile.py -OPENMP : 1 ; Append OpenMP flags - -# Optimization flags -#################### -# -# -xHost : Compile a binary optimized for the current architecture -# -O2 : O3 not better than O2. -# -ip : Inter-procedural optimizations -# -ftz : Flushes denormal results to zero -# -[OPT] -FC : -traceback -FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g - -# Profiling flags -################# -# -[PROFILE] -FC : -p -g -FCFLAGS : -xSSE4.2 -O2 -ip -ftz - -# Debugging flags -################# -# -# -traceback : Activate backtrace on runtime -# -fpe0 : All floating point exaceptions -# -C : Checks uninitialized variables, array subscripts, etc... -# -g : Extra debugging information -# -xSSE2 : Valgrind needs a very simple x86 executable -# -[DEBUG] -FC : -g -traceback -FCFLAGS : -xSSE2 -C -fpe0 -implicitnone - -# OpenMP flags -################# -# -[OPENMP] -FC : -qopenmp -IRPF90_FLAGS : --openmp - From d997b807e41da06472b04644c4cb69792ffb4fdc Mon Sep 17 00:00:00 2001 From: ydamour Date: Fri, 19 Nov 2021 11:06:26 +0100 Subject: [PATCH 20/86] update errror message --- src/fci/check_omp.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fci/check_omp.irp.f b/src/fci/check_omp.irp.f index ffc113d6..1413ba7e 100644 --- a/src/fci/check_omp.irp.f +++ b/src/fci/check_omp.irp.f @@ -218,7 +218,7 @@ program check_omp print*,'+' print*,'call omp_set_max_active_levels(5)' print*,'' - print*,'Good luck...' + print*,'Try an other compiler and good luck...' endif if (is_working) then From 62cb1531269715d2db628b1ea7272281d22ce42c Mon Sep 17 00:00:00 2001 From: ydamour Date: Fri, 19 Nov 2021 12:01:37 +0100 Subject: [PATCH 21/86] cleaner test version --- src/fci/check_omp.irp.f | 55 ++++++++++++++++++----------------------- 1 file changed, 24 insertions(+), 31 deletions(-) diff --git a/src/fci/check_omp.irp.f b/src/fci/check_omp.irp.f index 1413ba7e..bd5c204f 100644 --- a/src/fci/check_omp.irp.f +++ b/src/fci/check_omp.irp.f @@ -4,15 +4,19 @@ program check_omp implicit none - integer :: i,j,k,l,m,n,x,z,setting + integer :: i,j,k,l,m,n,x,z,setting,nb_setting double precision :: w1,w2,c1,c2 double precision, allocatable :: accu(:,:,:,:) logical :: must_exit, verbose, is_working + logical, allocatable :: is_working_n(:) x = 4 - allocate(accu(x,x,x,x)) + nb_setting = 4 - verbose = .False. + allocate(accu(x,x,x,x)) + allocate(is_working_n(nb_setting)) + + verbose = .True. accu = 0d0 must_exit = .False. @@ -39,11 +43,9 @@ program check_omp ! set the number of threads call omp_set_num_threads(2) - do z = 1, 4 + is_working_n = .True. - if (must_exit) then - exit - endif + do z = 1, nb_setting call omp_set_max_active_levels(1) call omp_set_nested(.False.) @@ -67,13 +69,13 @@ program check_omp !$OMP SHARED(accu) if (verbose) then - print*,'Nb threads level 1:', omp_get_num_threads() + print*,'Setting:',setting,'Nb threads level 1:', omp_get_num_threads() endif !$OMP MASTER if (omp_get_num_threads()==1) then print*,'Setting',setting,"error at level 1" - setting = -1 + is_working_n(z) = .False. endif !$OMP END MASTER @@ -94,13 +96,13 @@ program check_omp !$OMP SHARED(accu) if (verbose) then - print*,'Nb threads level 2:', omp_get_num_threads() + print*,'Setting:',setting,'Nb threads level 2:', omp_get_num_threads() endif !$OMP MASTER - if (omp_get_num_threads()==1 .and. setting >= 0) then + if (omp_get_num_threads()==1 .and. is_working_n(z)) then print*,'Setting',setting,"error at level 2" - setting = -1 + is_working_n(z) = .False. endif !$OMP END MASTER @@ -121,13 +123,13 @@ program check_omp !$OMP SHARED(accu) if (verbose) then - print*,'Nb threads level 3:', omp_get_num_threads() + print*,'Setting:',setting,'Nb threads level 3:', omp_get_num_threads() endif !$OMP MASTER - if (omp_get_num_threads()==1 .and. setting >= 0) then + if (omp_get_num_threads()==1 .and. is_working_n(z)) then print*,'Setting',setting,"error at level 3" - setting = -1 + is_working_n(z) = .False. endif !$OMP END MASTER @@ -148,22 +150,13 @@ program check_omp !$OMP SHARED(accu) if (verbose) then - print*,'Nb threads level 4:', omp_get_num_threads() + print*,'Setting:',setting,'Nb threads level 4:', omp_get_num_threads() endif !$OMP MASTER - if (omp_get_num_threads()==1 .and. setting >= 0) then + if (omp_get_num_threads()==1 .and. is_working_n(z)) then print*,'Setting',setting,"error at level 4" - elseif(omp_get_num_threads()==1 .or. setting == 0) then - else - must_exit = .True. - endif - - if ( z == 1 .and. setting == 0) then - is_working = .True. - elseif (z == 1 .and. setting == -1) then - is_working = .False. - else + is_working_n(z) = .False. endif !$OMP END MASTER @@ -191,17 +184,17 @@ program check_omp print*,'' - if (setting == 1) then + if (is_working_n(2)) then print*,'The parallelization works on 4 levels with:' print*,'call omp_set_max_active_levels(5)' print*,'' print*,'Please use the irpf90 flags -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' - elseif (setting == 2) then + elseif (is_working_n(3)) then print*,'The parallelization works on 4 levels with:' print*,'call omp_set_nested(.True.)' print*,'' print*,'Please use the irpf90 flag -DSET_NESTED in qp2/config/${compiler_name}.cfg' - elseif (setting == 3) then + elseif (is_working_n(4)) then print*,'The parallelization works on 4 levels with:' print*,'call omp_set_nested(.True.)' print*,'+' @@ -221,7 +214,7 @@ program check_omp print*,'Try an other compiler and good luck...' endif - if (is_working) then + if (is_working_n(1)) then print*,'' print*,'==========================================================' print*,'Your actual set up works for parallelization with 4 levels' From 0a4aec9f5ebd1c7246a0747037a7b5c715007c8f Mon Sep 17 00:00:00 2001 From: ydamour Date: Fri, 19 Nov 2021 22:39:59 +0100 Subject: [PATCH 22/86] script test, omp flag --- config/ifort.cfg | 2 +- config/ifort_avx.cfg | 2 +- config/ifort_mpi.cfg | 2 +- config/ifort_rome.cfg | 2 +- config/ifort_xHost.cfg | 2 +- scripts/verif_omp/check_actual_setup.sh | 10 + scripts/verif_omp/check_omp_v2.f90 | 175 +++++++++++++ scripts/verif_omp/check_required_setup.sh | 19 ++ scripts/verif_omp/study_omp.sh | 24 ++ src/fci/check_omp.irp.f | 235 ------------------ src/fci/check_omp_actual_setup.irp.f | 174 +++++++++++++ ...mp.irp.f => set_multiple_levels_omp.irp.f} | 2 +- 12 files changed, 408 insertions(+), 241 deletions(-) create mode 100755 scripts/verif_omp/check_actual_setup.sh create mode 100644 scripts/verif_omp/check_omp_v2.f90 create mode 100755 scripts/verif_omp/check_required_setup.sh create mode 100755 scripts/verif_omp/study_omp.sh delete mode 100644 src/fci/check_omp.irp.f create mode 100644 src/fci/check_omp_actual_setup.irp.f rename src/utils/{test_set_multiple_levels_omp.irp.f => set_multiple_levels_omp.irp.f} (87%) diff --git a/config/ifort.cfg b/config/ifort.cfg index 714c4b10..f8685bc0 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -58,6 +58,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp +FC : -qopenmp -w IRPF90_FLAGS : --openmp diff --git a/config/ifort_avx.cfg b/config/ifort_avx.cfg index a2cb4c8a..b14369d3 100644 --- a/config/ifort_avx.cfg +++ b/config/ifort_avx.cfg @@ -58,6 +58,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp +FC : -qopenmp -w IRPF90_FLAGS : --openmp diff --git a/config/ifort_mpi.cfg b/config/ifort_mpi.cfg index e0d489a0..16be2ed2 100644 --- a/config/ifort_mpi.cfg +++ b/config/ifort_mpi.cfg @@ -59,6 +59,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp +FC : -qopenmp -w IRPF90_FLAGS : --openmp diff --git a/config/ifort_rome.cfg b/config/ifort_rome.cfg index 5ed01227..9bd41096 100644 --- a/config/ifort_rome.cfg +++ b/config/ifort_rome.cfg @@ -58,6 +58,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp +FC : -qopenmp -w IRPF90_FLAGS : --openmp diff --git a/config/ifort_xHost.cfg b/config/ifort_xHost.cfg index ddb4aa2d..aa5bb966 100644 --- a/config/ifort_xHost.cfg +++ b/config/ifort_xHost.cfg @@ -58,6 +58,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp +FC : -qopenmp -w IRPF90_FLAGS : --openmp diff --git a/scripts/verif_omp/check_actual_setup.sh b/scripts/verif_omp/check_actual_setup.sh new file mode 100755 index 00000000..f275394f --- /dev/null +++ b/scripts/verif_omp/check_actual_setup.sh @@ -0,0 +1,10 @@ +#!/bin/sh + +echo "" +echo "Please wait..." +echo "" +cd ../../src/fci +ninja || echo "Please recompile from the root" +echo "" +./check_omp_actual_setup +cd ../../scripts/verif_omp diff --git a/scripts/verif_omp/check_omp_v2.f90 b/scripts/verif_omp/check_omp_v2.f90 new file mode 100644 index 00000000..ca6af8bd --- /dev/null +++ b/scripts/verif_omp/check_omp_v2.f90 @@ -0,0 +1,175 @@ +program check_omp_v2 + + use omp_lib + + implicit none + + integer :: accu, accu2 + integer :: s, n_setting + logical :: verbose, test_versions + logical, allocatable :: is_working(:) + + verbose = .False. + test_versions = .True. + n_setting = 4 + + allocate(is_working(n_setting)) + + is_working = .False. + + ! set the number of threads + call omp_set_num_threads(2) + + do s = 1, n_setting + + accu = 0 + accu2 = 0 + + call omp_set_max_active_levels(1) + call omp_set_nested(.False.) + + if (s==1) then + !call set_multiple_levels_omp() + cycle + elseif (s==2) then + call omp_set_max_active_levels(5) + elseif (s==3) then + call omp_set_nested(.True.) + else + call omp_set_nested(.True.) + call omp_set_max_active_levels(5) + endif + + ! Level 1 + !$OMP PARALLEL + if (verbose) then + print*,'Num threads level 1:',omp_get_num_threads() + endif + + ! Level 2 + !$OMP PARALLEL + if (verbose) then + print*,'Num threads level 2:',omp_get_num_threads() + endif + + ! Level 3 + !$OMP PARALLEL + if (verbose) then + print*,'Num threads level 3:',omp_get_num_threads() + endif + + call check_omp_in_subroutine(accu2) + + ! Level 4 + !$OMP PARALLEL + + if (verbose) then + print*,'Num threads level 4:',omp_get_num_threads() + endif + + !$OMP ATOMIC + accu = accu + 1 + !$OMP END ATOMIC + + !$OMP END PARALLEL + + + !$OMP END PARALLEL + + + !$OMP END PARALLEL + + + !$OMP END PARALLEL + + if (verbose) then + print*,'Setting:',s,'accu=',accu + print*,'Setting:',s,'accu2=',accu2 + endif + + if (accu == 16 .and. accu2 == 16) then + is_working(s) = .True. + endif + + enddo + + if (verbose) then + if (is_working(2)) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Please use the irpf90 flags -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' + elseif (is_working(3)) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_nested(.True.)' + print*,'' + print*,'Please use the irpf90 flag -DSET_NESTED in qp2/config/${compiler_name}.cfg' + elseif (is_working(4)) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_nested(.True.)' + print*,'+' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Please use the irpf90 flags -DSET_NESTED -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' + else + print*,'The parallelization on multiple levels does not work with:' + print*,'call omp_set_max_active_levels(5)' + print*,'or' + print*,'call omp_set_nested(.True.)' + print*,'or' + print*,'call omp_set_nested(.True.)' + print*,'+' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Try an other compiler and good luck...' + endif + + ! if (is_working(1)) then + ! print*,'' + ! print*,'==========================================================' + ! print*,'Your actual set up works for parallelization with 4 levels' + ! print*,'==========================================================' + ! print*,'' + ! else + ! print*,'' + ! print*,'===================================================================' + ! print*,'Your actual set up does not work for parallelization with 4 levels' + ! print*,'Please look at the previous messages to understand the requirements' + ! print*,'===================================================================' + ! print*,'' + ! endif + endif + + ! List of working flags + if (test_versions) then + print*,'Tests:',is_working(2:4) + endif + + ! IRPF90_FLAGS + if (is_working(2)) then + print*,'-DSET_MAX_ACT' + elseif (is_working(3)) then + print*,'-DSET_NESTED' + elseif (is_working(4)) then + print*,'-DSET_MAX_ACT -DSET_NESTED' + else + print*,'ERROR' + endif + +end + +subroutine check_omp_in_subroutine(accu2) + + implicit none + + integer, intent(inout) :: accu2 + + !$OMP PARALLEL + + !$OMP ATOMIC + accu2 = accu2 + 1 + !$OMP END ATOMIC + + !$OMP END PARALLEL + +end diff --git a/scripts/verif_omp/check_required_setup.sh b/scripts/verif_omp/check_required_setup.sh new file mode 100755 index 00000000..facb6cbb --- /dev/null +++ b/scripts/verif_omp/check_required_setup.sh @@ -0,0 +1,19 @@ +#!/bin/sh + +# take one argument which is the compiler used +# return the required IRPF90_FLAGS for the $1 compiler + +if [ -z "$1" ] +then + echo "Give the compiler in argument" +else + +$1 --version > /dev/null \ +&& $1 -O0 -fopenmp check_omp_v2.f90 \ +&& ./a.out | tail -n 1 + + +# if there is an error or if the compiler is not found +$1 --version > /dev/null || echo 'compiler not found' + +fi diff --git a/scripts/verif_omp/study_omp.sh b/scripts/verif_omp/study_omp.sh new file mode 100755 index 00000000..1fdd7b26 --- /dev/null +++ b/scripts/verif_omp/study_omp.sh @@ -0,0 +1,24 @@ +#!/bin/sh + +list_comp="ifort gfortran-7 gfortran-8 gfortran-9" + +FILE=results.dat + +touch $FILE +rm $FILE + +echo "1: omp_set_max_active_levels(5)" >> $FILE +echo "2: omp_set_nested(.True.)" >> $FILE +echo "3: 1 + 2" >> $FILE +echo "" >> $FILE +echo "1 2 3" >> $FILE +for comp in $list_comp +do + $comp --version > /dev/null \ + && $comp -O0 -fopenmp check_omp_v2.f90 \ + && echo $(./a.out | grep "Tests:" | cut -d ":" -f2- ) $(echo " : ") $($comp --version | head -n 1) >> $FILE + +done + +cat $FILE + diff --git a/src/fci/check_omp.irp.f b/src/fci/check_omp.irp.f deleted file mode 100644 index bd5c204f..00000000 --- a/src/fci/check_omp.irp.f +++ /dev/null @@ -1,235 +0,0 @@ -program check_omp - - use omp_lib - - implicit none - - integer :: i,j,k,l,m,n,x,z,setting,nb_setting - double precision :: w1,w2,c1,c2 - double precision, allocatable :: accu(:,:,:,:) - logical :: must_exit, verbose, is_working - logical, allocatable :: is_working_n(:) - - x = 4 - nb_setting = 4 - - allocate(accu(x,x,x,x)) - allocate(is_working_n(nb_setting)) - - verbose = .True. - - accu = 0d0 - must_exit = .False. - - !$OMP PARALLEL - if (OMP_GET_NUM_THREADS() == 1) then - print*,'' - print*,'1 thread, no parallelization possible' - print*,'' - must_exit=.True. - endif - !$OMP END PARALLEL - if (must_exit) then - call abort - endif - - ! reset the number of max active levels - !call omp_set_max_active_levels(1) - - !print*,'omp_get_max_active_levels:',omp_get_max_active_levels() - !call intel_check_omp() - !print*,'omp_get_max_active_levels:',omp_get_max_active_levels() - - ! set the number of threads - call omp_set_num_threads(2) - - is_working_n = .True. - - do z = 1, nb_setting - - call omp_set_max_active_levels(1) - call omp_set_nested(.False.) - - if (z==1) then - call test_set_multiple_levels_omp() - !call test_set_multiple_levels_omp - elseif (z==2) then - call omp_set_max_active_levels(5) - elseif (z==3) then - call omp_set_nested(.True.) - else - call omp_set_nested(.True.) - call omp_set_max_active_levels(5) - endif - - setting = z-1 - - !$OMP PARALLEL & - !$OMP PRIVATE(i,j,k,l,m,n) & - !$OMP SHARED(accu) - - if (verbose) then - print*,'Setting:',setting,'Nb threads level 1:', omp_get_num_threads() - endif - - !$OMP MASTER - if (omp_get_num_threads()==1) then - print*,'Setting',setting,"error at level 1" - is_working_n(z) = .False. - endif - !$OMP END MASTER - - ! !$OMP DO - ! do l = 1, x - ! do k = 1, x - ! do j = 1, x - ! do i = 1, x - ! accu(i,j,k,l) = accu(i,j,k,l) + 1d0 - ! enddo - ! enddo - ! enddo - ! enddo - ! !$OMP END DO - - !$OMP PARALLEL & - !$OMP PRIVATE(i,j,k,l,m,n) & - !$OMP SHARED(accu) - - if (verbose) then - print*,'Setting:',setting,'Nb threads level 2:', omp_get_num_threads() - endif - - !$OMP MASTER - if (omp_get_num_threads()==1 .and. is_working_n(z)) then - print*,'Setting',setting,"error at level 2" - is_working_n(z) = .False. - endif - !$OMP END MASTER - - ! !$OMP DO - ! do l = 1, x - ! do k = 1, x - ! do j = 1, x - ! do i = 1, x - ! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 - ! enddo - ! enddo - ! enddo - ! enddo - ! !$OMP END DO - - !$OMP PARALLEL & - !$OMP PRIVATE(i,j,k,l,m,n) & - !$OMP SHARED(accu) - - if (verbose) then - print*,'Setting:',setting,'Nb threads level 3:', omp_get_num_threads() - endif - - !$OMP MASTER - if (omp_get_num_threads()==1 .and. is_working_n(z)) then - print*,'Setting',setting,"error at level 3" - is_working_n(z) = .False. - endif - !$OMP END MASTER - - ! !$OMP DO - ! do l = 1, x - ! do k = 1, x - ! do j = 1, x - ! do i = 1, x - ! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 - ! enddo - ! enddo - ! enddo - ! enddo - ! !$OMP END DO - - !$OMP PARALLEL & - !$OMP PRIVATE(i,j,k,l,m,n) & - !$OMP SHARED(accu) - - if (verbose) then - print*,'Setting:',setting,'Nb threads level 4:', omp_get_num_threads() - endif - - !$OMP MASTER - if (omp_get_num_threads()==1 .and. is_working_n(z)) then - print*,'Setting',setting,"error at level 4" - is_working_n(z) = .False. - endif - !$OMP END MASTER - - ! !$OMP DO - ! do l = 1, x - ! do k = 1, x - ! do j = 1, x - ! do i = 1, x - ! accu(i,j,k,l) = accu(i,j,k,l)+ 1d0 - ! enddo - ! enddo - ! enddo - ! enddo - ! !$OMP END DO - - !$OMP END PARALLEL - - !$OMP END PARALLEL - - !$OMP END PARALLEL - - !$OMP END PARALLEL - - enddo - - print*,'' - - if (is_working_n(2)) then - print*,'The parallelization works on 4 levels with:' - print*,'call omp_set_max_active_levels(5)' - print*,'' - print*,'Please use the irpf90 flags -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' - elseif (is_working_n(3)) then - print*,'The parallelization works on 4 levels with:' - print*,'call omp_set_nested(.True.)' - print*,'' - print*,'Please use the irpf90 flag -DSET_NESTED in qp2/config/${compiler_name}.cfg' - elseif (is_working_n(4)) then - print*,'The parallelization works on 4 levels with:' - print*,'call omp_set_nested(.True.)' - print*,'+' - print*,'call omp_set_max_active_levels(5)' - print*,'' - print*,'Please use the irpf90 flags -DSET_NESTED -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' - else - print*,'The parallelization on multiple levels does not work with:' - print*,'call omp_set_max_active_levels(5)' - print*,'or' - print*,'call omp_set_nested(.True.)' - print*,'or' - print*,'call omp_set_nested(.True.)' - print*,'+' - print*,'call omp_set_max_active_levels(5)' - print*,'' - print*,'Try an other compiler and good luck...' - endif - - if (is_working_n(1)) then - print*,'' - print*,'==========================================================' - print*,'Your actual set up works for parallelization with 4 levels' - print*,'==========================================================' - print*,'' - else - print*,'' - print*,'===================================================================' - print*,'Your actual set up works for parallelization with 4 levels' - print*,'Please look at the previous messages to understand the requirements' - print*,'If it does not work even with the right irpf90 flags, clean and' - print*,'recompile your code at ${QP_ROOT}' - print*,'===================================================================' - print*,'' - endif - -end - diff --git a/src/fci/check_omp_actual_setup.irp.f b/src/fci/check_omp_actual_setup.irp.f new file mode 100644 index 00000000..70514bd3 --- /dev/null +++ b/src/fci/check_omp_actual_setup.irp.f @@ -0,0 +1,174 @@ +program check_omp_actual_setup + + use omp_lib + + implicit none + + integer :: accu, accu2 + integer :: s, n_setting + logical :: verbose, test_versions + logical, allocatable :: is_working(:) + + verbose = .True. + test_versions = .False. + n_setting = 4 + + allocate(is_working(n_setting)) + + is_working = .False. + + ! set the number of threads + call omp_set_num_threads(2) + + do s = 1, n_setting + + accu = 0 + accu2 = 0 + + call omp_set_max_active_levels(1) + call omp_set_nested(.False.) + + if (s==1) then + call set_multiple_levels_omp() + elseif (s==2) then + call omp_set_max_active_levels(5) + elseif (s==3) then + call omp_set_nested(.True.) + else + call omp_set_nested(.True.) + call omp_set_max_active_levels(5) + endif + + ! Level 1 + !$OMP PARALLEL + if (verbose) then + print*,'Num threads level 1:',omp_get_num_threads() + endif + + ! Level 2 + !$OMP PARALLEL + if (verbose) then + print*,'Num threads level 2:',omp_get_num_threads() + endif + + ! Level 3 + !$OMP PARALLEL + if (verbose) then + print*,'Num threads level 3:',omp_get_num_threads() + endif + + call check_omp_in_subroutine(accu2) + + ! Level 4 + !$OMP PARALLEL + + if (verbose) then + print*,'Num threads level 4:',omp_get_num_threads() + endif + + !$OMP ATOMIC + accu = accu + 1 + !$OMP END ATOMIC + + !$OMP END PARALLEL + + + !$OMP END PARALLEL + + + !$OMP END PARALLEL + + + !$OMP END PARALLEL + + if (verbose) then + print*,'Setting:',s,'accu=',accu + print*,'Setting:',s,'accu2=',accu2 + endif + + if (accu == 16 .and. accu2 == 16) then + is_working(s) = .True. + endif + + enddo + + if (verbose) then + if (is_working(2)) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Please use the irpf90 flags -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' + elseif (is_working(3)) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_nested(.True.)' + print*,'' + print*,'Please use the irpf90 flag -DSET_NESTED in qp2/config/${compiler_name}.cfg' + elseif (is_working(4)) then + print*,'The parallelization works on 4 levels with:' + print*,'call omp_set_nested(.True.)' + print*,'+' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Please use the irpf90 flags -DSET_NESTED -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' + else + print*,'The parallelization on multiple levels does not work with:' + print*,'call omp_set_max_active_levels(5)' + print*,'or' + print*,'call omp_set_nested(.True.)' + print*,'or' + print*,'call omp_set_nested(.True.)' + print*,'+' + print*,'call omp_set_max_active_levels(5)' + print*,'' + print*,'Try an other compiler and good luck...' + endif + + if (is_working(1)) then + print*,'' + print*,'==========================================================' + print*,'Your actual set up works for parallelization with 4 levels' + print*,'==========================================================' + print*,'' + else + print*,'' + print*,'===================================================================' + print*,'Your actual set up does not work for parallelization with 4 levels' + print*,'Please look at the previous messages to understand the requirements' + print*,'===================================================================' + print*,'' + endif + endif + + ! List of working flags + if (test_versions) then + print*,is_working(2:4) + endif + + ! IRPF90_FLAGS + if (is_working(2)) then + print*,'-DSET_MAX_ACT' + elseif (is_working(3)) then + print*,'-DSET_NESTED' + elseif (is_working(4)) then + print*,'-DSET_MAX_ACT -DSET_NESTED' + else + print*,'ERROR' + endif + +end + +subroutine check_omp_in_subroutine(accu2) + + implicit none + + integer, intent(inout) :: accu2 + + !$OMP PARALLEL + + !$OMP ATOMIC + accu2 = accu2 + 1 + !$OMP END ATOMIC + + !$OMP END PARALLEL + +end diff --git a/src/utils/test_set_multiple_levels_omp.irp.f b/src/utils/set_multiple_levels_omp.irp.f similarity index 87% rename from src/utils/test_set_multiple_levels_omp.irp.f rename to src/utils/set_multiple_levels_omp.irp.f index c4f721a1..a09f615a 100644 --- a/src/utils/test_set_multiple_levels_omp.irp.f +++ b/src/utils/set_multiple_levels_omp.irp.f @@ -1,4 +1,4 @@ -subroutine test_set_multiple_levels_omp() +subroutine set_multiple_levels_omp() ! Doc : idk From 991c198220d75cf87301479d2fff618dcfe2b8c4 Mon Sep 17 00:00:00 2001 From: ydamour Date: Fri, 19 Nov 2021 22:53:05 +0100 Subject: [PATCH 23/86] davidson with IRPF90 flags for multiple levels omp --- src/davidson/davidson_parallel.irp.f | 3 ++- src/davidson/davidson_parallel_csf.irp.f | 4 +++- src/davidson/davidson_parallel_nos2.irp.f | 4 +++- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f index 8fd023da..fcee16bc 100644 --- a/src/davidson/davidson_parallel.irp.f +++ b/src/davidson/davidson_parallel.irp.f @@ -508,7 +508,8 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze) endif - call omp_set_max_active_levels(5) + !call omp_set_max_active_levels(5) + call set_multiple_levels_omp() !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread) ithread = omp_get_thread_num() diff --git a/src/davidson/davidson_parallel_csf.irp.f b/src/davidson/davidson_parallel_csf.irp.f index fe651b1d..90e4303e 100644 --- a/src/davidson/davidson_parallel_csf.irp.f +++ b/src/davidson/davidson_parallel_csf.irp.f @@ -464,7 +464,9 @@ subroutine H_u_0_nstates_zmq(v_0,u_0,N_st,sze) print *, irp_here, ': Failed in zmq_set_running' endif - call omp_set_max_active_levels(4) + !call omp_set_max_active_levels(4) + call set_multiple_levels_omp() + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread) ithread = omp_get_thread_num() if (ithread == 0 ) then diff --git a/src/davidson/davidson_parallel_nos2.irp.f b/src/davidson/davidson_parallel_nos2.irp.f index 84cbe3af..091b8666 100644 --- a/src/davidson/davidson_parallel_nos2.irp.f +++ b/src/davidson/davidson_parallel_nos2.irp.f @@ -464,7 +464,9 @@ subroutine H_u_0_nstates_zmq(v_0,u_0,N_st,sze) print *, irp_here, ': Failed in zmq_set_running' endif - call omp_set_max_active_levels(4) + !call omp_set_max_active_levels(4) + call set_multiple_levels_omp() + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread) ithread = omp_get_thread_num() if (ithread == 0 ) then From c93938e44307021f8e7a9ae52bfc3d0c06d9323f Mon Sep 17 00:00:00 2001 From: ydamour Date: Fri, 19 Nov 2021 23:53:20 +0100 Subject: [PATCH 24/86] remove test omp compilation flag --- config/ifort.cfg | 2 +- config/ifort_avx.cfg | 2 +- config/ifort_mpi.cfg | 2 +- config/ifort_rome.cfg | 2 +- config/ifort_xHost.cfg | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/config/ifort.cfg b/config/ifort.cfg index f8685bc0..714c4b10 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -58,6 +58,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp -w +FC : -qopenmp IRPF90_FLAGS : --openmp diff --git a/config/ifort_avx.cfg b/config/ifort_avx.cfg index b14369d3..a2cb4c8a 100644 --- a/config/ifort_avx.cfg +++ b/config/ifort_avx.cfg @@ -58,6 +58,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp -w +FC : -qopenmp IRPF90_FLAGS : --openmp diff --git a/config/ifort_mpi.cfg b/config/ifort_mpi.cfg index 16be2ed2..e0d489a0 100644 --- a/config/ifort_mpi.cfg +++ b/config/ifort_mpi.cfg @@ -59,6 +59,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp -w +FC : -qopenmp IRPF90_FLAGS : --openmp diff --git a/config/ifort_rome.cfg b/config/ifort_rome.cfg index 9bd41096..5ed01227 100644 --- a/config/ifort_rome.cfg +++ b/config/ifort_rome.cfg @@ -58,6 +58,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp -w +FC : -qopenmp IRPF90_FLAGS : --openmp diff --git a/config/ifort_xHost.cfg b/config/ifort_xHost.cfg index aa5bb966..ddb4aa2d 100644 --- a/config/ifort_xHost.cfg +++ b/config/ifort_xHost.cfg @@ -58,6 +58,6 @@ FCFLAGS : -xSSE2 -C -fpe0 -implicitnone ################# # [OPENMP] -FC : -qopenmp -w +FC : -qopenmp IRPF90_FLAGS : --openmp From 082b32b24f5817ea2f5e217835701a4507677ef7 Mon Sep 17 00:00:00 2001 From: ydamour Date: Tue, 23 Nov 2021 10:33:37 +0100 Subject: [PATCH 25/86] remove comments --- src/utils/set_multiple_levels_omp.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/utils/set_multiple_levels_omp.irp.f b/src/utils/set_multiple_levels_omp.irp.f index a09f615a..4be3af5b 100644 --- a/src/utils/set_multiple_levels_omp.irp.f +++ b/src/utils/set_multiple_levels_omp.irp.f @@ -5,11 +5,11 @@ subroutine set_multiple_levels_omp() implicit none IRP_IF SET_MAX_ACT - print*,'SET_MAX_ACT: True, call omp_set_max_active_levels(5)' + !print*,'SET_MAX_ACT: True, call omp_set_max_active_levels(5)' call omp_set_max_active_levels(5) IRP_ENDIF IRP_IF SET_NESTED - print*,'SET_NESTED: True, call omp_set_nested(.True.)' + !print*,'SET_NESTED: True, call omp_set_nested(.True.)' call omp_set_nested(.True.) IRP_ENDIF From adc94fcb2958e711fb0884a747d8f81ebc3761f9 Mon Sep 17 00:00:00 2001 From: ydamour Date: Tue, 23 Nov 2021 14:55:37 +0100 Subject: [PATCH 26/86] script to automatically add the omp irpf90 flags --- scripts/verif_omp/update_comp.sh | 39 ++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100755 scripts/verif_omp/update_comp.sh diff --git a/scripts/verif_omp/update_comp.sh b/scripts/verif_omp/update_comp.sh new file mode 100755 index 00000000..2199c3f6 --- /dev/null +++ b/scripts/verif_omp/update_comp.sh @@ -0,0 +1,39 @@ +#!/bin/bash + +# Compiler +COMP=$1 + +# Path to file.cfg +config_PATH="../../config/" +END="*.cfg" +CONFIG="/config/" + +#LIST=${config_PATH}${COMP}${END} # without ${QP_ROOT} +LIST=${QP_ROOT}${CONFIG}${COMP}${END} + +if [ -z "$1" ] +then + echo "Give the compiler in argument" +else + + # List of the config files for the compiler + #list_files=$(ls ../../config/$comp*.cfg) #does not give the right list + list_files=${LIST} + echo "Files that will be modified:" + echo $list_files + + # Add the flags + for file in $list_files + do + echo $file + ACTUAL=$(grep "IRPF90_FLAGS : --openmp" $file) + FLAGS=$(./check_required_setup.sh $COMP) + SPACE=" " + BASE="IRPF90_FLAGS : --openmp" + NEW=${BASE}${SPACE}${FLAGS} + + sed "s/${ACTUAL}/${NEW}/" $file + # -i # to change the files + done + +fi From 7fcd03b911424770fcd833549f4e573569f83604 Mon Sep 17 00:00:00 2001 From: ydamour Date: Tue, 23 Nov 2021 15:00:54 +0100 Subject: [PATCH 27/86] comments --- scripts/verif_omp/check_actual_setup.sh | 2 ++ scripts/verif_omp/study_omp.sh | 6 ++++++ 2 files changed, 8 insertions(+) diff --git a/scripts/verif_omp/check_actual_setup.sh b/scripts/verif_omp/check_actual_setup.sh index f275394f..6eaa4517 100755 --- a/scripts/verif_omp/check_actual_setup.sh +++ b/scripts/verif_omp/check_actual_setup.sh @@ -1,5 +1,7 @@ #!/bin/sh +# go in qp2/src/fci to run check_omp_actual_setup +# to see if we can run in parallel an omp section in another one echo "" echo "Please wait..." echo "" diff --git a/scripts/verif_omp/study_omp.sh b/scripts/verif_omp/study_omp.sh index 1fdd7b26..00668d59 100755 --- a/scripts/verif_omp/study_omp.sh +++ b/scripts/verif_omp/study_omp.sh @@ -1,17 +1,22 @@ #!/bin/sh +# list of compilers list_comp="ifort gfortran-7 gfortran-8 gfortran-9" +# file to store the results FILE=results.dat touch $FILE rm $FILE +# Comments echo "1: omp_set_max_active_levels(5)" >> $FILE echo "2: omp_set_nested(.True.)" >> $FILE echo "3: 1 + 2" >> $FILE echo "" >> $FILE echo "1 2 3" >> $FILE + +# loop on the comp for comp in $list_comp do $comp --version > /dev/null \ @@ -20,5 +25,6 @@ do done +# Display cat $FILE From b16edd29e7959901b4676914fbcd319343f9a013 Mon Sep 17 00:00:00 2001 From: ydamour Date: Thu, 25 Nov 2021 10:28:44 +0100 Subject: [PATCH 28/86] fixed error --- config/ifort.cfg | 2 +- config/ifort_debug.cfg | 2 +- config/ifort_rome.cfg | 2 +- scripts/verif_omp/update_comp.sh | 22 ++++++++++++++++------ 4 files changed, 19 insertions(+), 9 deletions(-) diff --git a/config/ifort.cfg b/config/ifort.cfg index 714c4b10..0382360a 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DINTEL # Global options ################ diff --git a/config/ifort_debug.cfg b/config/ifort_debug.cfg index 9b718380..d70b1465 100644 --- a/config/ifort_debug.cfg +++ b/config/ifort_debug.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL +IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL # Global options ################ diff --git a/config/ifort_rome.cfg b/config/ifort_rome.cfg index 5ed01227..1ac78717 100644 --- a/config/ifort_rome.cfg +++ b/config/ifort_rome.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DINTEL # Global options ################ diff --git a/scripts/verif_omp/update_comp.sh b/scripts/verif_omp/update_comp.sh index 2199c3f6..14b644de 100755 --- a/scripts/verif_omp/update_comp.sh +++ b/scripts/verif_omp/update_comp.sh @@ -21,17 +21,27 @@ else list_files=${LIST} echo "Files that will be modified:" echo $list_files - + + # Flags that must be added + FLAGS=$(./check_required_setup.sh $COMP) + # Add the flags for file in $list_files do echo $file - ACTUAL=$(grep "IRPF90_FLAGS : --openmp" $file) - FLAGS=$(./check_required_setup.sh $COMP) - SPACE=" " - BASE="IRPF90_FLAGS : --openmp" - NEW=${BASE}${SPACE}${FLAGS} + BASE="IRPF90_FLAGS : --ninja" + ACTUAL=$(grep "$BASE" $file) + # To have only one time each flag + grep " -DSET_MAX_ACT" $file && ${ACTUAL/" -DSET_MAX"/""} + grep " -DSET_NESTED" $file && ${ACTUAL/" -DSET_NESTED"/""} + SPACE=" " + + NEW=${ACTUAL}${SPACE}${FLAGS} + + # Debug + #echo ${NEW} + sed "s/${ACTUAL}/${NEW}/" $file # -i # to change the files done From fbfcc98f41bc53c58e5895ed8551fa8a485dd540 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 25 Nov 2021 14:46:20 +0100 Subject: [PATCH 29/86] Added save_wavefunction_truncated(ci_threshold) --- src/cis/EZFIO.cfg | 1 - src/cis/cis.irp.f | 2 +- src/cisd/cisd.irp.f | 2 +- src/determinants/EZFIO.cfg | 6 ++++++ 4 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/cis/EZFIO.cfg b/src/cis/EZFIO.cfg index 7e0eeb03..955d1bef 100644 --- a/src/cis/EZFIO.cfg +++ b/src/cis/EZFIO.cfg @@ -5,4 +5,3 @@ interface: ezfio size: (determinants.n_states) - diff --git a/src/cis/cis.irp.f b/src/cis/cis.irp.f index acec29c2..5001041e 100644 --- a/src/cis/cis.irp.f +++ b/src/cis/cis.irp.f @@ -79,6 +79,6 @@ subroutine run call ezfio_set_cis_energy(CI_energy) psi_coef = ci_eigenvectors SOFT_TOUCH psi_coef - call save_wavefunction_truncated(1.d-12) + call save_wavefunction_truncated(ci_threshold) end diff --git a/src/cisd/cisd.irp.f b/src/cisd/cisd.irp.f index 6c55e2ff..3ad81fef 100644 --- a/src/cisd/cisd.irp.f +++ b/src/cisd/cisd.irp.f @@ -63,7 +63,7 @@ subroutine run endif psi_coef = ci_eigenvectors SOFT_TOUCH psi_coef - call save_wavefunction + call save_wavefunction_truncated(ci_threshold) call ezfio_set_cisd_energy(CI_energy) do i = 1,N_states diff --git a/src/determinants/EZFIO.cfg b/src/determinants/EZFIO.cfg index 662c6fbb..12fe06ac 100644 --- a/src/determinants/EZFIO.cfg +++ b/src/determinants/EZFIO.cfg @@ -136,3 +136,9 @@ doc: If |true|, discard any Slater determinants with an interaction smaller than interface: ezfio,provider,ocaml default: False +[ci_threshold] +type: Threshold +doc: Cut-off to apply to the CI coefficients when the wave function is stored +interface: ezfio,provider,ocaml +default: 0. + From 691d8957dc19c22b9b18a17c049eff7cdf014e0d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 26 Nov 2021 12:50:26 +0100 Subject: [PATCH 30/86] Changed ci_threshold into save_threshold --- src/cis/cis.irp.f | 2 +- src/cisd/cisd.irp.f | 2 +- src/determinants/EZFIO.cfg | 12 ++++++------ 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/cis/cis.irp.f b/src/cis/cis.irp.f index 5001041e..ab2294ad 100644 --- a/src/cis/cis.irp.f +++ b/src/cis/cis.irp.f @@ -79,6 +79,6 @@ subroutine run call ezfio_set_cis_energy(CI_energy) psi_coef = ci_eigenvectors SOFT_TOUCH psi_coef - call save_wavefunction_truncated(ci_threshold) + call save_wavefunction_truncated(save_threshold) end diff --git a/src/cisd/cisd.irp.f b/src/cisd/cisd.irp.f index 3ad81fef..fca3b10e 100644 --- a/src/cisd/cisd.irp.f +++ b/src/cisd/cisd.irp.f @@ -63,7 +63,7 @@ subroutine run endif psi_coef = ci_eigenvectors SOFT_TOUCH psi_coef - call save_wavefunction_truncated(ci_threshold) + call save_wavefunction_truncated(save_threshold) call ezfio_set_cisd_energy(CI_energy) do i = 1,N_states diff --git a/src/determinants/EZFIO.cfg b/src/determinants/EZFIO.cfg index 12fe06ac..5e109de8 100644 --- a/src/determinants/EZFIO.cfg +++ b/src/determinants/EZFIO.cfg @@ -48,7 +48,7 @@ default: 1 [threshold_generators] type: Threshold -doc: Thresholds on generators (fraction of the square of the norm) +doc: Thresholds on generators (fraction of the square of the norm) interface: ezfio,provider,ocaml default: 0.999 @@ -80,7 +80,7 @@ type: integer [psi_coef] interface: ezfio doc: Coefficients of the wave function -type: double precision +type: double precision size: (determinants.n_det,determinants.n_states) [psi_det] @@ -92,7 +92,7 @@ size: (determinants.n_int*determinants.bit_kind/8,2,determinants.n_det) [psi_coef_qp_edit] interface: ezfio doc: Coefficients of the wave function -type: double precision +type: double precision size: (determinants.n_det_qp_edit,determinants.n_states) [psi_det_qp_edit] @@ -126,17 +126,17 @@ default: 1. [thresh_sym] type: Threshold -doc: Thresholds to check if a determinant is connected with HF +doc: Thresholds to check if a determinant is connected with HF interface: ezfio,provider,ocaml default: 1.e-15 [pseudo_sym] type: logical -doc: If |true|, discard any Slater determinants with an interaction smaller than thresh_sym with HF. +doc: If |true|, discard any Slater determinants with an interaction smaller than thresh_sym with HF. interface: ezfio,provider,ocaml default: False -[ci_threshold] +[save_threshold] type: Threshold doc: Cut-off to apply to the CI coefficients when the wave function is stored interface: ezfio,provider,ocaml From 4318b0a04b2d54003f7ea7ad42b380ca8ddfb3a5 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 29 Nov 2021 10:39:34 +0100 Subject: [PATCH 31/86] OpenMP nested merged --- INSTALL.rst | 122 ++++-------- config/ifort_2019_avx.cfg | 63 +++++++ config/ifort_2019_avx_mpi.cfg | 64 +++++++ .../{ifort_rome.cfg => ifort_2019_rome.cfg} | 2 +- config/ifort_2019_sse4.cfg | 63 +++++++ config/ifort_2019_sse4_mpi.cfg | 64 +++++++ config/ifort_2019_xHost.cfg | 63 +++++++ config/{ifort_avx.cfg => ifort_2021_avx.cfg} | 2 +- ...ort_avx_mpi.cfg => ifort_2021_avx_mpi.cfg} | 2 +- config/{ifort.cfg => ifort_2021_sse4.cfg} | 2 +- ...{ifort_mpi.cfg => ifort_2021_sse4_mpi.cfg} | 2 +- .../{ifort_xHost.cfg => ifort_2021_xHost.cfg} | 2 +- config/ifort_debug.cfg | 66 ------- scripts/verif_omp/check_actual_setup.sh | 12 -- .../{check_omp_v2.f90 => check_omp.f90} | 0 scripts/verif_omp/check_required_setup.sh | 2 +- scripts/verif_omp/study_omp.sh | 2 +- src/cipsi/pt2_stoch_routines.irp.f | 4 +- src/cipsi/slave_cipsi.irp.f | 6 +- src/davidson/davidson_parallel.irp.f | 3 +- src/davidson/davidson_parallel_csf.irp.f | 3 +- src/davidson/davidson_parallel_nos2.irp.f | 3 +- src/dressing/run_dress_slave.irp.f | 6 +- src/fci/check_omp_actual_setup.irp.f | 174 ------------------ src/utils/set_multiple_levels_omp.irp.f | 28 ++- 25 files changed, 386 insertions(+), 374 deletions(-) create mode 100644 config/ifort_2019_avx.cfg create mode 100644 config/ifort_2019_avx_mpi.cfg rename config/{ifort_rome.cfg => ifort_2019_rome.cfg} (95%) create mode 100644 config/ifort_2019_sse4.cfg create mode 100644 config/ifort_2019_sse4_mpi.cfg create mode 100644 config/ifort_2019_xHost.cfg rename config/{ifort_avx.cfg => ifort_2021_avx.cfg} (96%) rename config/{ifort_avx_mpi.cfg => ifort_2021_avx_mpi.cfg} (96%) rename config/{ifort.cfg => ifort_2021_sse4.cfg} (96%) rename config/{ifort_mpi.cfg => ifort_2021_sse4_mpi.cfg} (96%) rename config/{ifort_xHost.cfg => ifort_2021_xHost.cfg} (96%) delete mode 100644 config/ifort_debug.cfg delete mode 100755 scripts/verif_omp/check_actual_setup.sh rename scripts/verif_omp/{check_omp_v2.f90 => check_omp.f90} (100%) delete mode 100644 src/fci/check_omp_actual_setup.irp.f diff --git a/INSTALL.rst b/INSTALL.rst index 229bf40a..64e48598 100644 --- a/INSTALL.rst +++ b/INSTALL.rst @@ -2,9 +2,9 @@ Installation ============ -The |qp| can be downloaded on GitHub as an `archive -`_ or as a `git -repository `_. +|qp| can be downloaded on GitHub as an `archive +`_ or as a `git +repository `_. .. code:: bash @@ -19,16 +19,16 @@ Before anything, go into your :file:`quantum_package` directory and run This script will create the :file:`quantum_package.rc` bash script, which -sets all the environment variables required for the normal operation of the -*Quantum Package*. It will also initialize the git submodules that are +sets all the environment variables required for the normal operation of +|qp|. It will also initialize the git submodules that are required, and tell you which external dependencies are missing and need to be installed. The required dependencies are located in the -`external/qp2-dependencies` directory, such that once QP is configured the +`external/qp2-dependencies` directory, such that once |qp| is configured the internet connection is not needed any more. When all dependencies have been installed, (the :command:`configure` will -inform you) source the :file:`quantum_package.rc` in order to load all -environment variables and compile the |QP|. +inform you what is missing) source the :file:`quantum_package.rc` in order to +load all environment variables and compile |QP|. Now all the requirements are met, you can compile the programs using @@ -37,6 +37,15 @@ Now all the requirements are met, you can compile the programs using make +Installation of dependencies via a Conda environment +==================================================== + +.. code:: bash + + conda env create -f qp2.yml + + + Requirements ============ @@ -64,8 +73,8 @@ architecture. Modify it if needed, and run :command:`configure` with .. code:: bash - cp ./config/gfortran.example config/gfortran.cfg - ./configure -c config/gfortran.cfg + cp ./config/gfortran.example config/gfortran_avx.cfg + ./configure -c config/gfortran_avx.cfg .. note:: @@ -86,45 +95,33 @@ The command is to be used as follows: .. code:: bash - ./configure --install= + ./configure -i The following packages are supported by the :command:`configure` installer: * ninja -* irpf90 * zeromq * f77zmq * gmp * ocaml (:math:`\approx` 5 minutes) -* ezfio * docopt * resultsFile * bats +* zlib Example: .. code:: bash - ./configure -i ezfio + ./configure -i ninja -.. note:: - - When installing the ocaml package, you will be asked the location of where - it should be installed. A safe option is to enter the path proposed by the - |QP|: - - QP>> Please install it here: /your_quantum_package_directory/bin - - So just enter the proposition of the |QP| and press enter. If the :command:`configure` executable fails to install a specific dependency ----------------------------------------------------------------------------- -If the :command:`configure` executable does not succeed to install a specific -dependency, there are some proposition of how to download and install the -minimal dependencies to compile and use the |QP|. - +If the :command:`configure` executable does not succeed in installing a specific +dependency, you should try to install the dependency on your system by yourself. Before doing anything below, try to install the packages with your package manager (:command:`apt`, :command:`yum`, etc). @@ -149,11 +146,11 @@ IRPF90 *IRPF90* is a Fortran code generator for programming using the Implicit Reference to Parameters (IRP) method. -If you have *pip* for Python2, you can do +If you have *pip* for Python2, you can do .. code:: bash - python2 -m pip install --user irpf90 + python3 -m pip install --user irpf90 Otherwise, @@ -262,53 +259,6 @@ With Debian or Ubuntu, you can use sudo apt install libgmp-dev -libcap ------- - -Libcap is a library for getting and setting POSIX.1e draft 15 capabilities. - -* Download the latest version of libcap here: - ``_ - and move it in the :file:`${QP_ROOT}/external` directory - -* Extract the archive, go into the :file:`libcap-*/libcap` directory and run - the following command - -.. code:: bash - - prefix=$QP_ROOT make install - -With Debian or Ubuntu, you can use - -.. code:: bash - - sudo apt install libcap-dev - - -Bubblewrap ----------- - -Bubblewrap is an unprivileged sandboxing tool. - -* Download Bubblewrap here: - ``_ - and move it in the :file:`${QP_ROOT}/external` directory - -* Extract the archive, go into the :file:`bubblewrap-*` directory and run - the following commands - -.. code:: bash - - ./configure --prefix=$QP_ROOT && make -j 8 - make install-exec-am - - -With Debian or Ubuntu, you can use - -.. code:: bash - - sudo apt install bubblewrap - OCaml @@ -327,7 +277,7 @@ OCaml ``_ and move it in the :file:`${QP_ROOT}/external` directory -* If you use OCaml only with the |qp|, you can install the OPAM directory +* If you use OCaml only with |qp|, you can install the OPAM directory containing the compiler and all the installed libraries in the :file:`${QP_ROOT}/external` directory as @@ -352,14 +302,14 @@ OCaml .. code:: bash - opam init --comp=4.07.1 + opam init --comp=4.11.1 eval `${QP_ROOT}/bin/opam env` If the installation fails because of bwrap, you can initialize opam using: .. code:: bash - opam init --disable-sandboxing --comp=4.07.1 + opam init --disable-sandboxing --comp=4.11.1 eval `${QP_ROOT}/bin/opam env` * Install the required external OCaml libraries @@ -369,17 +319,6 @@ OCaml opam install ocamlbuild cryptokit zmq sexplib ppx_sexp_conv ppx_deriving getopt -EZFIO ------ - -*EZFIO* is the Easy Fortran Input/Output library generator. - -* Download EZFIO here : ``_ and move - the downloaded archive in the :file:`${QP_ROOT}/external` directory - -* Extract the archive, and rename it as :file:`${QP_ROOT}/external/ezfio` - - Docopt ------ @@ -406,7 +345,7 @@ resultsFile *resultsFile* is a Python package to extract data from output files of quantum chemistry codes. -If you have *pip* for Python3, you can do +If you have *pip* for Python3, you can do .. code:: bash @@ -414,3 +353,4 @@ If you have *pip* for Python3, you can do + diff --git a/config/ifort_2019_avx.cfg b/config/ifort_2019_avx.cfg new file mode 100644 index 00000000..b929baf5 --- /dev/null +++ b/config/ifort_2019_avx.cfg @@ -0,0 +1,63 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : ifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT -DSET_NESTED + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FC : -traceback +FCFLAGS : -xAVX -O2 -ip -ftz -g + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + diff --git a/config/ifort_2019_avx_mpi.cfg b/config/ifort_2019_avx_mpi.cfg new file mode 100644 index 00000000..383fa68c --- /dev/null +++ b/config/ifort_2019_avx_mpi.cfg @@ -0,0 +1,64 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : mpiifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_MAX_ACT -DSET_NESTED + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FCFLAGS : -mavx -axAVX -O2 -ip -ftz -g -traceback + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -march=corei7 -O2 -ip -ftz + + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + diff --git a/config/ifort_rome.cfg b/config/ifort_2019_rome.cfg similarity index 95% rename from config/ifort_rome.cfg rename to config/ifort_2019_rome.cfg index 1ac78717..c0396f42 100644 --- a/config/ifort_rome.cfg +++ b/config/ifort_2019_rome.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT -DSET_NESTED # Global options ################ diff --git a/config/ifort_2019_sse4.cfg b/config/ifort_2019_sse4.cfg new file mode 100644 index 00000000..460322c1 --- /dev/null +++ b/config/ifort_2019_sse4.cfg @@ -0,0 +1,63 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : ifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT -DSET_NESTED + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FC : -traceback +FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + diff --git a/config/ifort_2019_sse4_mpi.cfg b/config/ifort_2019_sse4_mpi.cfg new file mode 100644 index 00000000..4c871591 --- /dev/null +++ b/config/ifort_2019_sse4_mpi.cfg @@ -0,0 +1,64 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : mpiifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_MAX_ACT -DSET_NESTED + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FCFLAGS : -msse4.2 -O2 -ip -ftz -g -traceback + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -msse4.2 -O2 -ip -ftz + + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + diff --git a/config/ifort_2019_xHost.cfg b/config/ifort_2019_xHost.cfg new file mode 100644 index 00000000..1820ab47 --- /dev/null +++ b/config/ifort_2019_xHost.cfg @@ -0,0 +1,63 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : ifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=64 -DINTEL -DSET_MAX_ACT -DSET_NESTED + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FC : -traceback +FCFLAGS : -xHost -O2 -ip -ftz -g + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + diff --git a/config/ifort_avx.cfg b/config/ifort_2021_avx.cfg similarity index 96% rename from config/ifort_avx.cfg rename to config/ifort_2021_avx.cfg index a2cb4c8a..b7b3261e 100644 --- a/config/ifort_avx.cfg +++ b/config/ifort_2021_avx.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT # Global options ################ diff --git a/config/ifort_avx_mpi.cfg b/config/ifort_2021_avx_mpi.cfg similarity index 96% rename from config/ifort_avx_mpi.cfg rename to config/ifort_2021_avx_mpi.cfg index f2bb8889..e060657f 100644 --- a/config/ifort_avx_mpi.cfg +++ b/config/ifort_2021_avx_mpi.cfg @@ -9,7 +9,7 @@ FC : mpiifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_MAX_ACT # Global options ################ diff --git a/config/ifort.cfg b/config/ifort_2021_sse4.cfg similarity index 96% rename from config/ifort.cfg rename to config/ifort_2021_sse4.cfg index 0382360a..ad4f2990 100644 --- a/config/ifort.cfg +++ b/config/ifort_2021_sse4.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT # Global options ################ diff --git a/config/ifort_mpi.cfg b/config/ifort_2021_sse4_mpi.cfg similarity index 96% rename from config/ifort_mpi.cfg rename to config/ifort_2021_sse4_mpi.cfg index e0d489a0..f4a093ec 100644 --- a/config/ifort_mpi.cfg +++ b/config/ifort_2021_sse4_mpi.cfg @@ -9,7 +9,7 @@ FC : mpiifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL +IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_MAX_ACT # Global options ################ diff --git a/config/ifort_xHost.cfg b/config/ifort_2021_xHost.cfg similarity index 96% rename from config/ifort_xHost.cfg rename to config/ifort_2021_xHost.cfg index ddb4aa2d..f57e8709 100644 --- a/config/ifort_xHost.cfg +++ b/config/ifort_2021_xHost.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=64 -DINTEL +IRPF90_FLAGS : --ninja --align=64 -DINTEL -DSET_MAX_ACT # Global options ################ diff --git a/config/ifort_debug.cfg b/config/ifort_debug.cfg deleted file mode 100644 index d70b1465..00000000 --- a/config/ifort_debug.cfg +++ /dev/null @@ -1,66 +0,0 @@ -# Common flags -############## -# -# -mkl=[parallel|sequential] : Use the MKL library -# --ninja : Allow the utilisation of ninja. It is mandatory ! -# --align=32 : Align all provided arrays on a 32-byte boundary -# -[COMMON] -FC : ifort -fpic -LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps -IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 --assert -DINTEL - -# Global options -################ -# -# 1 : Activate -# 0 : Deactivate -# -[OPTION] -MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below -CACHE : 0 ; Enable cache_compile.py -OPENMP : 1 ; Append OpenMP flags - -# Optimization flags -#################### -# -# -xHost : Compile a binary optimized for the current architecture -# -O2 : O3 not better than O2. -# -ip : Inter-procedural optimizations -# -ftz : Flushes denormal results to zero -# -[OPT] -FC : -traceback -FCFLAGS : -msse4.2 -O2 -ip -ftz -g - - -# Profiling flags -################# -# -[PROFILE] -FC : -p -g -FCFLAGS : -msse4.2 -O2 -ip -ftz - - -# Debugging flags -################# -# -# -traceback : Activate backtrace on runtime -# -fpe0 : All floating point exaceptions -# -C : Checks uninitialized variables, array subscripts, etc... -# -g : Extra debugging information -# -msse4.2 : Valgrind needs a very simple x86 executable -# -[DEBUG] -FC : -g -traceback -FCFLAGS : -msse4.2 -check all -debug all -fpe-all=0 -implicitnone - - -# OpenMP flags -################# -# -[OPENMP] -FC : -qopenmp -IRPF90_FLAGS : --openmp - diff --git a/scripts/verif_omp/check_actual_setup.sh b/scripts/verif_omp/check_actual_setup.sh deleted file mode 100755 index 6eaa4517..00000000 --- a/scripts/verif_omp/check_actual_setup.sh +++ /dev/null @@ -1,12 +0,0 @@ -#!/bin/sh - -# go in qp2/src/fci to run check_omp_actual_setup -# to see if we can run in parallel an omp section in another one -echo "" -echo "Please wait..." -echo "" -cd ../../src/fci -ninja || echo "Please recompile from the root" -echo "" -./check_omp_actual_setup -cd ../../scripts/verif_omp diff --git a/scripts/verif_omp/check_omp_v2.f90 b/scripts/verif_omp/check_omp.f90 similarity index 100% rename from scripts/verif_omp/check_omp_v2.f90 rename to scripts/verif_omp/check_omp.f90 diff --git a/scripts/verif_omp/check_required_setup.sh b/scripts/verif_omp/check_required_setup.sh index facb6cbb..367530b6 100755 --- a/scripts/verif_omp/check_required_setup.sh +++ b/scripts/verif_omp/check_required_setup.sh @@ -9,7 +9,7 @@ then else $1 --version > /dev/null \ -&& $1 -O0 -fopenmp check_omp_v2.f90 \ +&& $1 -O0 -fopenmp check_omp.f90 \ && ./a.out | tail -n 1 diff --git a/scripts/verif_omp/study_omp.sh b/scripts/verif_omp/study_omp.sh index 00668d59..900d04e1 100755 --- a/scripts/verif_omp/study_omp.sh +++ b/scripts/verif_omp/study_omp.sh @@ -20,7 +20,7 @@ echo "1 2 3" >> $FILE for comp in $list_comp do $comp --version > /dev/null \ - && $comp -O0 -fopenmp check_omp_v2.f90 \ + && $comp -O0 -fopenmp check_omp.f90 \ && echo $(./a.out | grep "Tests:" | cut -d ":" -f2- ) $(echo " : ") $($comp --version | head -n 1) >> $FILE done diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index b366a268..b14bdf8d 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -288,7 +288,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) call write_int(6,nproc_target,'Number of threads for PT2') call write_double(6,mem,'Memory (Gb)') - call omp_set_max_active_levels(1) + call set_multiple_levels_omp(.False.) print '(A)', '========== ======================= ===================== ===================== ===========' @@ -315,7 +315,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) endif !$OMP END PARALLEL call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') - call omp_set_max_active_levels(8) + call set_multiple_levels_omp(.True.) print '(A)', '========== ======================= ===================== ===================== ===========' diff --git a/src/cipsi/slave_cipsi.irp.f b/src/cipsi/slave_cipsi.irp.f index 510c667b..ddfc050e 100644 --- a/src/cipsi/slave_cipsi.irp.f +++ b/src/cipsi/slave_cipsi.irp.f @@ -4,7 +4,7 @@ subroutine run_slave_cipsi ! Helper program for distributed parallelism END_DOC - call omp_set_max_active_levels(1) + call set_multiple_levels_omp(.False.) distributed_davidson = .False. read_wf = .False. SOFT_TOUCH read_wf distributed_davidson @@ -171,9 +171,9 @@ subroutine run_slave_main call write_double(6,(t1-t0),'Broadcast time') !--- - call omp_set_max_active_levels(8) + call set_multiple_levels_omp(.True.) call davidson_slave_tcp(0) - call omp_set_max_active_levels(1) + call set_multiple_levels_omp(.False.) print *, mpi_rank, ': Davidson done' !--- diff --git a/src/davidson/davidson_parallel.irp.f b/src/davidson/davidson_parallel.irp.f index fcee16bc..e627dfc9 100644 --- a/src/davidson/davidson_parallel.irp.f +++ b/src/davidson/davidson_parallel.irp.f @@ -508,8 +508,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze) endif - !call omp_set_max_active_levels(5) - call set_multiple_levels_omp() + call set_multiple_levels_omp(.True.) !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread) ithread = omp_get_thread_num() diff --git a/src/davidson/davidson_parallel_csf.irp.f b/src/davidson/davidson_parallel_csf.irp.f index 90e4303e..d8e9bffa 100644 --- a/src/davidson/davidson_parallel_csf.irp.f +++ b/src/davidson/davidson_parallel_csf.irp.f @@ -464,8 +464,7 @@ subroutine H_u_0_nstates_zmq(v_0,u_0,N_st,sze) print *, irp_here, ': Failed in zmq_set_running' endif - !call omp_set_max_active_levels(4) - call set_multiple_levels_omp() + call set_multiple_levels_omp(.True.) !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread) ithread = omp_get_thread_num() diff --git a/src/davidson/davidson_parallel_nos2.irp.f b/src/davidson/davidson_parallel_nos2.irp.f index 091b8666..597b001f 100644 --- a/src/davidson/davidson_parallel_nos2.irp.f +++ b/src/davidson/davidson_parallel_nos2.irp.f @@ -464,8 +464,7 @@ subroutine H_u_0_nstates_zmq(v_0,u_0,N_st,sze) print *, irp_here, ': Failed in zmq_set_running' endif - !call omp_set_max_active_levels(4) - call set_multiple_levels_omp() + call set_multiple_levels_omp(.True.) !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread) ithread = omp_get_thread_num() diff --git a/src/dressing/run_dress_slave.irp.f b/src/dressing/run_dress_slave.irp.f index a33fb1dd..08b654c9 100644 --- a/src/dressing/run_dress_slave.irp.f +++ b/src/dressing/run_dress_slave.irp.f @@ -72,7 +72,7 @@ subroutine run_dress_slave(thread,iproce,energy) provide psi_energy ending = dress_N_cp+1 ntask_tbd = 0 - call omp_set_max_active_levels(8) + call set_multiple_levels_omp(.True.) !$OMP PARALLEL DEFAULT(SHARED) & !$OMP PRIVATE(interesting, breve_delta_m, task_id) & @@ -84,7 +84,7 @@ subroutine run_dress_slave(thread,iproce,energy) zmq_socket_push = new_zmq_push_socket(thread) integer, external :: connect_to_taskserver !$OMP CRITICAL - call omp_set_max_active_levels(1) + call set_multiple_levels_omp(.False.) if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then print *, irp_here, ': Unable to connect to task server' stop -1 @@ -296,7 +296,7 @@ subroutine run_dress_slave(thread,iproce,energy) !$OMP END CRITICAL !$OMP END PARALLEL - call omp_set_max_active_levels(1) + call set_multiple_levels_omp(.False.) ! do i=0,dress_N_cp+1 ! call omp_destroy_lock(lck_sto(i)) ! end do diff --git a/src/fci/check_omp_actual_setup.irp.f b/src/fci/check_omp_actual_setup.irp.f deleted file mode 100644 index 70514bd3..00000000 --- a/src/fci/check_omp_actual_setup.irp.f +++ /dev/null @@ -1,174 +0,0 @@ -program check_omp_actual_setup - - use omp_lib - - implicit none - - integer :: accu, accu2 - integer :: s, n_setting - logical :: verbose, test_versions - logical, allocatable :: is_working(:) - - verbose = .True. - test_versions = .False. - n_setting = 4 - - allocate(is_working(n_setting)) - - is_working = .False. - - ! set the number of threads - call omp_set_num_threads(2) - - do s = 1, n_setting - - accu = 0 - accu2 = 0 - - call omp_set_max_active_levels(1) - call omp_set_nested(.False.) - - if (s==1) then - call set_multiple_levels_omp() - elseif (s==2) then - call omp_set_max_active_levels(5) - elseif (s==3) then - call omp_set_nested(.True.) - else - call omp_set_nested(.True.) - call omp_set_max_active_levels(5) - endif - - ! Level 1 - !$OMP PARALLEL - if (verbose) then - print*,'Num threads level 1:',omp_get_num_threads() - endif - - ! Level 2 - !$OMP PARALLEL - if (verbose) then - print*,'Num threads level 2:',omp_get_num_threads() - endif - - ! Level 3 - !$OMP PARALLEL - if (verbose) then - print*,'Num threads level 3:',omp_get_num_threads() - endif - - call check_omp_in_subroutine(accu2) - - ! Level 4 - !$OMP PARALLEL - - if (verbose) then - print*,'Num threads level 4:',omp_get_num_threads() - endif - - !$OMP ATOMIC - accu = accu + 1 - !$OMP END ATOMIC - - !$OMP END PARALLEL - - - !$OMP END PARALLEL - - - !$OMP END PARALLEL - - - !$OMP END PARALLEL - - if (verbose) then - print*,'Setting:',s,'accu=',accu - print*,'Setting:',s,'accu2=',accu2 - endif - - if (accu == 16 .and. accu2 == 16) then - is_working(s) = .True. - endif - - enddo - - if (verbose) then - if (is_working(2)) then - print*,'The parallelization works on 4 levels with:' - print*,'call omp_set_max_active_levels(5)' - print*,'' - print*,'Please use the irpf90 flags -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' - elseif (is_working(3)) then - print*,'The parallelization works on 4 levels with:' - print*,'call omp_set_nested(.True.)' - print*,'' - print*,'Please use the irpf90 flag -DSET_NESTED in qp2/config/${compiler_name}.cfg' - elseif (is_working(4)) then - print*,'The parallelization works on 4 levels with:' - print*,'call omp_set_nested(.True.)' - print*,'+' - print*,'call omp_set_max_active_levels(5)' - print*,'' - print*,'Please use the irpf90 flags -DSET_NESTED -DSET_MAX_ACT in qp2/config/${compiler_name}.cfg' - else - print*,'The parallelization on multiple levels does not work with:' - print*,'call omp_set_max_active_levels(5)' - print*,'or' - print*,'call omp_set_nested(.True.)' - print*,'or' - print*,'call omp_set_nested(.True.)' - print*,'+' - print*,'call omp_set_max_active_levels(5)' - print*,'' - print*,'Try an other compiler and good luck...' - endif - - if (is_working(1)) then - print*,'' - print*,'==========================================================' - print*,'Your actual set up works for parallelization with 4 levels' - print*,'==========================================================' - print*,'' - else - print*,'' - print*,'===================================================================' - print*,'Your actual set up does not work for parallelization with 4 levels' - print*,'Please look at the previous messages to understand the requirements' - print*,'===================================================================' - print*,'' - endif - endif - - ! List of working flags - if (test_versions) then - print*,is_working(2:4) - endif - - ! IRPF90_FLAGS - if (is_working(2)) then - print*,'-DSET_MAX_ACT' - elseif (is_working(3)) then - print*,'-DSET_NESTED' - elseif (is_working(4)) then - print*,'-DSET_MAX_ACT -DSET_NESTED' - else - print*,'ERROR' - endif - -end - -subroutine check_omp_in_subroutine(accu2) - - implicit none - - integer, intent(inout) :: accu2 - - !$OMP PARALLEL - - !$OMP ATOMIC - accu2 = accu2 + 1 - !$OMP END ATOMIC - - !$OMP END PARALLEL - -end diff --git a/src/utils/set_multiple_levels_omp.irp.f b/src/utils/set_multiple_levels_omp.irp.f index 4be3af5b..b4764e4a 100644 --- a/src/utils/set_multiple_levels_omp.irp.f +++ b/src/utils/set_multiple_levels_omp.irp.f @@ -1,16 +1,26 @@ -subroutine set_multiple_levels_omp() +subroutine set_multiple_levels_omp(activate) -! Doc : idk + BEGIN_DOC +! If true, activate OpenMP nested parallelism. If false, deactivate. + END_DOC implicit none + logical, intent(in) :: activate - IRP_IF SET_MAX_ACT - !print*,'SET_MAX_ACT: True, call omp_set_max_active_levels(5)' + if (activate) then call omp_set_max_active_levels(5) - IRP_ENDIF - IRP_IF SET_NESTED - !print*,'SET_NESTED: True, call omp_set_nested(.True.)' - call omp_set_nested(.True.) - IRP_ENDIF + + IRP_IF SET_NESTED + call omp_set_nested(.True.) + IRP_ENDIF + + else + + call omp_set_max_active_levels(1) + + IRP_IF SET_NESTED + call omp_set_nested(.False.) + IRP_ENDIF + end if end From 82d1ca035ec488293a89830e7bc9779642661c46 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 29 Nov 2021 10:43:14 +0100 Subject: [PATCH 32/86] Removed set_max_act flags --- config/gfortran.cfg | 8 ++++---- config/gfortran_avx.cfg | 8 ++++---- config/gfortran_debug.cfg | 8 ++++---- config/gfortran_mpi.cfg | 8 ++++---- config/ifort_2019_avx.cfg | 2 +- config/ifort_2019_avx_mpi.cfg | 2 +- config/ifort_2019_rome.cfg | 2 +- config/ifort_2019_sse4.cfg | 2 +- config/ifort_2019_sse4_mpi.cfg | 2 +- config/ifort_2019_xHost.cfg | 2 +- config/ifort_2021_avx.cfg | 2 +- config/ifort_2021_avx_mpi.cfg | 2 +- config/ifort_2021_sse4.cfg | 2 +- config/ifort_2021_sse4_mpi.cfg | 2 +- config/ifort_2021_xHost.cfg | 2 +- 15 files changed, 27 insertions(+), 27 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index ec72e722..56bb6ba4 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -13,7 +13,7 @@ FC : gfortran -g -ffree-line-length-none -I . -fPIC LAPACK_LIB : -lblas -llapack IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 --assert -DGNU_CHECK_OMP +IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED # Global options ################ @@ -35,14 +35,14 @@ OPENMP : 1 ; Append OpenMP flags # -ffast-math and the Fortran-specific # -fno-protect-parens and -fstack-arrays. [OPT] -FCFLAGS : -Ofast +FCFLAGS : -Ofast # Profiling flags ################# # [PROFILE] FC : -p -g -FCFLAGS : -Ofast +FCFLAGS : -Ofast # Debugging flags ################# @@ -58,5 +58,5 @@ FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurpris # [OPENMP] FC : -fopenmp -IRPF90_FLAGS : --openmp +IRPF90_FLAGS : --openmp diff --git a/config/gfortran_avx.cfg b/config/gfortran_avx.cfg index 4f45e3a1..747dff67 100644 --- a/config/gfortran_avx.cfg +++ b/config/gfortran_avx.cfg @@ -13,7 +13,7 @@ FC : gfortran -ffree-line-length-none -I . -mavx -g -fPIC LAPACK_LIB : -llapack -lblas IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 +IRPF90_FLAGS : --ninja --align=32 -DSET_NESTED # Global options ################ @@ -42,7 +42,7 @@ FCFLAGS : -Ofast -mavx # [PROFILE] FC : -p -g -FCFLAGS : -Ofast +FCFLAGS : -Ofast # Debugging flags ################# @@ -51,12 +51,12 @@ FCFLAGS : -Ofast # -g : Extra debugging information # [DEBUG] -FCFLAGS : -fcheck=all -g +FCFLAGS : -fcheck=all -g # OpenMP flags ################# # [OPENMP] FC : -fopenmp -IRPF90_FLAGS : --openmp +IRPF90_FLAGS : --openmp diff --git a/config/gfortran_debug.cfg b/config/gfortran_debug.cfg index 926255e0..51e5a500 100644 --- a/config/gfortran_debug.cfg +++ b/config/gfortran_debug.cfg @@ -13,7 +13,7 @@ FC : gfortran -g -ffree-line-length-none -I . -fPIC LAPACK_LIB : -lblas -llapack IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 --assert +IRPF90_FLAGS : --ninja --align=32 --assert -DSET_NESTED # Global options ################ @@ -35,14 +35,14 @@ OPENMP : 1 ; Append OpenMP flags # -ffast-math and the Fortran-specific # -fno-protect-parens and -fstack-arrays. [OPT] -FCFLAGS : -Ofast +FCFLAGS : -Ofast # Profiling flags ################# # [PROFILE] FC : -p -g -FCFLAGS : -Ofast +FCFLAGS : -Ofast # Debugging flags ################# @@ -59,5 +59,5 @@ FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurpris # [OPENMP] FC : -fopenmp -IRPF90_FLAGS : --openmp +IRPF90_FLAGS : --openmp diff --git a/config/gfortran_mpi.cfg b/config/gfortran_mpi.cfg index d72160c1..1af3ca45 100644 --- a/config/gfortran_mpi.cfg +++ b/config/gfortran_mpi.cfg @@ -13,7 +13,7 @@ FC : mpif90 -ffree-line-length-none -I . -g -fPIC LAPACK_LIB : -lblas -llapack IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DMPI +IRPF90_FLAGS : --ninja --align=32 -DMPI -DSET_NESTED # Global options ################ @@ -35,14 +35,14 @@ OPENMP : 1 ; Append OpenMP flags # -ffast-math and the Fortran-specific # -fno-protect-parens and -fstack-arrays. [OPT] -FCFLAGS : -Ofast -msse4.2 +FCFLAGS : -Ofast -msse4.2 # Profiling flags ################# # [PROFILE] FC : -p -g -FCFLAGS : -Ofast -msse4.2 +FCFLAGS : -Ofast -msse4.2 # Debugging flags ################# @@ -51,7 +51,7 @@ FCFLAGS : -Ofast -msse4.2 # -g : Extra debugging information # [DEBUG] -FCFLAGS : -fcheck=all -g +FCFLAGS : -fcheck=all -g # OpenMP flags ################# diff --git a/config/ifort_2019_avx.cfg b/config/ifort_2019_avx.cfg index b929baf5..661a0e8f 100644 --- a/config/ifort_2019_avx.cfg +++ b/config/ifort_2019_avx.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT -DSET_NESTED +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED # Global options ################ diff --git a/config/ifort_2019_avx_mpi.cfg b/config/ifort_2019_avx_mpi.cfg index 383fa68c..2d212db5 100644 --- a/config/ifort_2019_avx_mpi.cfg +++ b/config/ifort_2019_avx_mpi.cfg @@ -9,7 +9,7 @@ FC : mpiifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_MAX_ACT -DSET_NESTED +IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_NESTED # Global options ################ diff --git a/config/ifort_2019_rome.cfg b/config/ifort_2019_rome.cfg index c0396f42..e923a1dd 100644 --- a/config/ifort_2019_rome.cfg +++ b/config/ifort_2019_rome.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT -DSET_NESTED +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED # Global options ################ diff --git a/config/ifort_2019_sse4.cfg b/config/ifort_2019_sse4.cfg index 460322c1..a3aa7cbd 100644 --- a/config/ifort_2019_sse4.cfg +++ b/config/ifort_2019_sse4.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT -DSET_NESTED +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED # Global options ################ diff --git a/config/ifort_2019_sse4_mpi.cfg b/config/ifort_2019_sse4_mpi.cfg index 4c871591..6959d176 100644 --- a/config/ifort_2019_sse4_mpi.cfg +++ b/config/ifort_2019_sse4_mpi.cfg @@ -9,7 +9,7 @@ FC : mpiifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_MAX_ACT -DSET_NESTED +IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_NESTED # Global options ################ diff --git a/config/ifort_2019_xHost.cfg b/config/ifort_2019_xHost.cfg index 1820ab47..22d28803 100644 --- a/config/ifort_2019_xHost.cfg +++ b/config/ifort_2019_xHost.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=64 -DINTEL -DSET_MAX_ACT -DSET_NESTED +IRPF90_FLAGS : --ninja --align=64 -DINTEL -DSET_NESTED # Global options ################ diff --git a/config/ifort_2021_avx.cfg b/config/ifort_2021_avx.cfg index b7b3261e..6f657052 100644 --- a/config/ifort_2021_avx.cfg +++ b/config/ifort_2021_avx.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT +IRPF90_FLAGS : --ninja --align=32 -DINTEL # Global options ################ diff --git a/config/ifort_2021_avx_mpi.cfg b/config/ifort_2021_avx_mpi.cfg index e060657f..c991a4a9 100644 --- a/config/ifort_2021_avx_mpi.cfg +++ b/config/ifort_2021_avx_mpi.cfg @@ -9,7 +9,7 @@ FC : mpiifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_MAX_ACT +IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL # Global options ################ diff --git a/config/ifort_2021_sse4.cfg b/config/ifort_2021_sse4.cfg index ad4f2990..a6299665 100644 --- a/config/ifort_2021_sse4.cfg +++ b/config/ifort_2021_sse4.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_MAX_ACT +IRPF90_FLAGS : --ninja --align=32 -DINTEL # Global options ################ diff --git a/config/ifort_2021_sse4_mpi.cfg b/config/ifort_2021_sse4_mpi.cfg index f4a093ec..6ae56d2a 100644 --- a/config/ifort_2021_sse4_mpi.cfg +++ b/config/ifort_2021_sse4_mpi.cfg @@ -9,7 +9,7 @@ FC : mpiifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL -DSET_MAX_ACT +IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL # Global options ################ diff --git a/config/ifort_2021_xHost.cfg b/config/ifort_2021_xHost.cfg index f57e8709..1e76a69d 100644 --- a/config/ifort_2021_xHost.cfg +++ b/config/ifort_2021_xHost.cfg @@ -9,7 +9,7 @@ FC : ifort -fpic LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 -IRPF90_FLAGS : --ninja --align=64 -DINTEL -DSET_MAX_ACT +IRPF90_FLAGS : --ninja --align=64 -DINTEL # Global options ################ From 8c521906488177db9dd3695cb49e08aadbd98e31 Mon Sep 17 00:00:00 2001 From: FiletoRodriguez Date: Tue, 30 Nov 2021 15:35:19 +0100 Subject: [PATCH 33/86] added src/tools/save_natorb_no_ref.irp.f --- src/determinants/density_matrix.irp.f | 38 +++++++++++++++++++++++++++ src/tools/save_natorb_no_ref.irp.f | 24 +++++++++++++++++ 2 files changed, 62 insertions(+) create mode 100644 src/tools/save_natorb_no_ref.irp.f diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index 6a474662..fa4b3328 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -268,6 +268,44 @@ subroutine set_natural_mos soft_touch mo_occ end + +subroutine save_natural_mos_canon_label + implicit none + BEGIN_DOC + ! Save natural orbitals, obtained by diagonalization of the one-body density matrix in + ! the |MO| basis + END_DOC + call set_natural_mos_canon_label + call nullify_small_elements(ao_num,mo_num,mo_coef,size(mo_coef,1),1.d-10) + call orthonormalize_mos + call save_mos +end + +subroutine set_natural_mos_canon_label + implicit none + BEGIN_DOC + ! Set natural orbitals, obtained by diagonalization of the one-body density matrix + ! in the |MO| basis + END_DOC + character*(64) :: label + double precision, allocatable :: tmp(:,:) + + label = "Canonical" + integer :: i,j,iorb,jorb + do i = 1, n_virt_orb + iorb = list_virt(i) + do j = 1, n_core_inact_act_orb + jorb = list_core_inact_act(j) + enddo + enddo + call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label) + soft_touch mo_occ +end + + + + + subroutine set_natorb_no_ov_rot implicit none BEGIN_DOC diff --git a/src/tools/save_natorb_no_ref.irp.f b/src/tools/save_natorb_no_ref.irp.f new file mode 100644 index 00000000..9d253fa0 --- /dev/null +++ b/src/tools/save_natorb_no_ref.irp.f @@ -0,0 +1,24 @@ +program save_natorb + implicit none + BEGIN_DOC +! Save natural |MOs| into the |EZFIO|. +! +! This program reads the wave function stored in the |EZFIO| directory, +! extracts the corresponding natural orbitals and setd them as the new +! |MOs|. +! +! If this is a multi-state calculation, the density matrix that produces +! the natural orbitals is obtained from an average of the density +! matrices of each state with the corresponding +! :option:`determinants state_average_weight` + END_DOC + read_wf = .True. + touch read_wf + call save_natural_mos_canon_label + call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('None') + call ezfio_set_mo_one_e_ints_io_mo_one_e_integrals('None') + call ezfio_set_mo_one_e_ints_io_mo_integrals_kinetic('None') + call ezfio_set_mo_one_e_ints_io_mo_integrals_n_e('None') + call ezfio_set_mo_one_e_ints_io_mo_integrals_pseudo('None') +end + From bd6ccc6b926811164b311455c057baef40512975 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 3 Dec 2021 14:49:17 +0100 Subject: [PATCH 34/86] Added psi_csf_coef --- src/csf/conversion.irp.f | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index fecc6123..7fdca2af 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -1,3 +1,12 @@ +BEGIN_PROVIDER [ double precision, psi_csf_coef, (N_csf, N_states) ] + implicit none + BEGIN_DOC + ! Wafe function in CSF basis + END_DOC + + call convertWFfromDETtoCSF(N_states,psi_coef, psi_csf_coef) +END_PROVIDER + subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) use cfunctions use bitmasks From fc7c8313e32f7d30cefee6498ecc4967962e5faa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 3 Dec 2021 15:30:31 +0100 Subject: [PATCH 35/86] Fixed bug in det-csf provider --- src/csf/conversion.irp.f | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index 7fdca2af..c8bc9199 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -4,7 +4,10 @@ BEGIN_PROVIDER [ double precision, psi_csf_coef, (N_csf, N_states) ] ! Wafe function in CSF basis END_DOC - call convertWFfromDETtoCSF(N_states,psi_coef, psi_csf_coef) + double precision, allocatable :: buffer(:,:) + allocate ( buffer(N_det, N_states) ) + buffer(1:N_det, 1:N_states) = psi_coef(1:N_det, 1:N_states) + call convertWFfromDETtoCSF(N_states, buffer, psi_csf_coef) END_PROVIDER subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) From 3b3f7a7de9209a22868058f6f11168aee7be4235 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 5 Dec 2021 22:45:21 +0100 Subject: [PATCH 36/86] Added truncate_wf --- RELEASE_NOTES.org | 1 + src/tools/truncate_wf.irp.f | 98 +++++++++++++++++++++++++++++++++++++ 2 files changed, 99 insertions(+) create mode 100644 src/tools/truncate_wf.irp.f diff --git a/RELEASE_NOTES.org b/RELEASE_NOTES.org index 98830f3f..586bf431 100644 --- a/RELEASE_NOTES.org +++ b/RELEASE_NOTES.org @@ -58,6 +58,7 @@ symmetry in matrices - qp_export_as_tgz exports also plugin codes - Added a basis module containing basis set information + - Added qp_run truncate_wf *** Code diff --git a/src/tools/truncate_wf.irp.f b/src/tools/truncate_wf.irp.f new file mode 100644 index 00000000..6c66c8ec --- /dev/null +++ b/src/tools/truncate_wf.irp.f @@ -0,0 +1,98 @@ +program truncate_wf + implicit none + BEGIN_DOC +! Truncate the wave function + END_DOC + read_wf = .True. + if (s2_eig) then + call routine_s2 + else + call routine + endif +end + +subroutine routine + implicit none + integer :: ndet_max + print*, 'Max number of determinants ?' + read(5,*) ndet_max + integer(bit_kind), allocatable :: psi_det_tmp(:,:,:) + double precision, allocatable :: psi_coef_tmp(:,:) + allocate(psi_det_tmp(N_int,2,ndet_max),psi_coef_tmp(ndet_max, N_states)) + + integer :: i,j + double precision :: accu(N_states) + accu = 0.d0 + do i = 1, ndet_max + do j = 1, N_int + psi_det_tmp(j,1,i) = psi_det_sorted(j,1,i) + psi_det_tmp(j,2,i) = psi_det_sorted(j,2,i) + enddo + do j = 1, N_states + psi_coef_tmp(i,j) = psi_coef_sorted(i,j) + accu(j) += psi_coef_tmp(i,j) **2 + enddo + enddo + do j = 1, N_states + accu(j) = 1.d0/dsqrt(accu(j)) + enddo + do j = 1, N_states + do i = 1, ndet_max + psi_coef_tmp(i,j) = psi_coef_tmp(i,j) * accu(j) + enddo + enddo + + call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,size(psi_coef_tmp,1),psi_coef_tmp) + +end + +subroutine routine_s2 + implicit none + integer :: ndet_max + double precision :: wmin + integer(bit_kind), allocatable :: psi_det_tmp(:,:,:) + double precision, allocatable :: psi_coef_tmp(:,:) + integer :: i,j,k + double precision :: accu(N_states) + + print *, 'Weights of the CFG' + do i=1,N_det + print *, i, real(weight_configuration(det_to_configuration(i),:)), real(sum(weight_configuration(det_to_configuration(i),:))) + enddo + print*, 'Min weight of the configuration?' + read(5,*) wmin + + ndet_max = 0 + do i=1,N_det + if (maxval(weight_configuration( det_to_configuration(i),:)) < wmin) cycle + ndet_max = ndet_max+1 + enddo + + allocate(psi_det_tmp(N_int,2,ndet_max),psi_coef_tmp(ndet_max, N_states)) + + accu = 0.d0 + k=0 + do i = 1, N_det + if (maxval(weight_configuration( det_to_configuration(i),:)) < wmin) cycle + k = k+1 + do j = 1, N_int + psi_det_tmp(j,1,k) = psi_det(j,1,i) + psi_det_tmp(j,2,k) = psi_det(j,2,i) + enddo + do j = 1, N_states + psi_coef_tmp(k,j) = psi_coef(i,j) + accu(j) += psi_coef_tmp(k,j)**2 + enddo + enddo + do j = 1, N_states + accu(j) = 1.d0/dsqrt(accu(j)) + enddo + do j = 1, N_states + do i = 1, ndet_max + psi_coef_tmp(i,j) = psi_coef_tmp(i,j) * accu(j) + enddo + enddo + + call save_wavefunction_general(ndet_max,N_states,psi_det_tmp,size(psi_coef_tmp,1),psi_coef_tmp) + +end From 13eee57e6789fd3de7047ee90fb826213a5b896d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 7 Dec 2021 19:30:32 +0100 Subject: [PATCH 37/86] Update for TREXIOv2 --- bin/qp_convert_output_to_ezfio | 26 +++++++++++++++----------- config/ifort_2021_avx.cfg | 2 +- config/ifort_2021_avx_mpi.cfg | 2 +- config/ifort_2021_sse4.cfg | 2 +- config/ifort_2021_sse4_mpi.cfg | 2 +- config/ifort_2021_xHost.cfg | 2 +- ocaml/qp_create_ezfio.ml | 30 ++++++++++++++---------------- src/basis/EZFIO.cfg | 10 +++++----- src/basis/basis.irp.f | 9 ++++++--- 9 files changed, 45 insertions(+), 40 deletions(-) diff --git a/bin/qp_convert_output_to_ezfio b/bin/qp_convert_output_to_ezfio index 1c7394fc..9412b090 100755 --- a/bin/qp_convert_output_to_ezfio +++ b/bin/qp_convert_output_to_ezfio @@ -195,48 +195,52 @@ def write_ezfio(res, filename): # P a r s i n g # # ~#~#~#~#~#~#~ # + inucl = {} + for i, a in enumerate(res.geometry): + inucl[a.coord] = i + nbasis = 0 - nucl_center = [] + nucl_index = [] curr_center = -1 nucl_shell_num = [] ang_mom = [] nshell = 0 - shell_prim_index = [1] + nshell_tot = 0 + shell_index = [] shell_prim_num = [] for b in res.basis: s = b.sym if str.count(s, "y") + str.count(s, "x") == 0: - c = b.center + c = inucl[b.center] nshell += 1 + nshell_tot += 1 if c != curr_center: curr_center = c - nucl_center.append(nbasis+1) nucl_shell_num.append(nshell) nshell = 0 nbasis += 1 + nucl_index.append(c+1) coefficient += b.coef[:len(b.prim)] exponent += [p.expo for p in b.prim] ang_mom.append(str.count(s, "z")) - shell_prim_index.append(len(exponent)+1) shell_prim_num.append(len(b.prim)) - - nucl_shell_num.append(nshell+1) - nucl_shell_num = nucl_shell_num[1:] + shell_index += [nshell_tot+1] * len(b.prim) # ~#~#~#~#~ # # W r i t e # # ~#~#~#~#~ # ezfio.set_basis_basis("Read from ResultsFile") - ezfio.set_basis_basis_nucleus_index(nucl_center) - ezfio.set_basis_prim_num(len(coefficient)) ezfio.set_basis_shell_num(len(ang_mom)) + ezfio.set_basis_basis_nucleus_index(nucl_index) + ezfio.set_basis_prim_num(len(coefficient)) + ezfio.set_basis_nucleus_shell_num(nucl_shell_num) ezfio.set_basis_prim_coef(coefficient) ezfio.set_basis_prim_expo(exponent) ezfio.set_basis_shell_ang_mom(ang_mom) ezfio.set_basis_shell_prim_num(shell_prim_num) - ezfio.set_basis_shell_prim_index(shell_prim_index) + ezfio.set_basis_shell_index(shell_index) print("OK") diff --git a/config/ifort_2021_avx.cfg b/config/ifort_2021_avx.cfg index 6f657052..8fadda67 100644 --- a/config/ifort_2021_avx.cfg +++ b/config/ifort_2021_avx.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : ifort -fpic -LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DINTEL diff --git a/config/ifort_2021_avx_mpi.cfg b/config/ifort_2021_avx_mpi.cfg index c991a4a9..b6b74b73 100644 --- a/config/ifort_2021_avx_mpi.cfg +++ b/config/ifort_2021_avx_mpi.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : mpiifort -fpic -LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL diff --git a/config/ifort_2021_sse4.cfg b/config/ifort_2021_sse4.cfg index a6299665..269023da 100644 --- a/config/ifort_2021_sse4.cfg +++ b/config/ifort_2021_sse4.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : ifort -fpic -LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DINTEL diff --git a/config/ifort_2021_sse4_mpi.cfg b/config/ifort_2021_sse4_mpi.cfg index 6ae56d2a..41df87bc 100644 --- a/config/ifort_2021_sse4_mpi.cfg +++ b/config/ifort_2021_sse4_mpi.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : mpiifort -fpic -LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL diff --git a/config/ifort_2021_xHost.cfg b/config/ifort_2021_xHost.cfg index 1e76a69d..05c271f3 100644 --- a/config/ifort_2021_xHost.cfg +++ b/config/ifort_2021_xHost.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : ifort -fpic -LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=64 -DINTEL diff --git a/ocaml/qp_create_ezfio.ml b/ocaml/qp_create_ezfio.ml index a4865e2b..e51dd0ef 100644 --- a/ocaml/qp_create_ezfio.ml +++ b/ocaml/qp_create_ezfio.ml @@ -585,12 +585,18 @@ let run ?o b au c d m p cart xyz_file = let shell_prim_num = list_map List.length lc in - let shell_prim_idx = + Printf.printf "Coucou\n%!"; + let shell_idx = + Printf.printf "Coucou\n%!"; + let rec make_list n accu = function + | 0 -> accu + | i -> make_list n (n :: accu) (i-1) + in let rec aux count accu = function | [] -> List.rev accu | l::rest -> - let newcount = count+(List.length l) in - aux newcount (count::accu) rest + let new_l = make_list count accu (List.length l) in + aux (count+1) new_l rest in aux 1 [] lc in @@ -602,20 +608,12 @@ let run ?o b au c d m p cart xyz_file = ~rank:1 ~dim:[| shell_num |] ~data:shell_prim_num); Ezfio.set_basis_shell_ang_mom (Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| shell_num |] ~data:ang_mom ) ; - Ezfio.set_basis_shell_prim_index (Ezfio.ezfio_array_of_list - ~rank:1 ~dim:[| shell_num |] ~data:shell_prim_idx) ; + Ezfio.set_basis_shell_index (Ezfio.ezfio_array_of_list + ~rank:1 ~dim:[| prim_num |] ~data:shell_idx) ; Ezfio.set_basis_basis_nucleus_index (Ezfio.ezfio_array_of_list - ~rank:1 ~dim:[| nucl_num |] - ~data:( - list_map (fun (_,n) -> Nucl_number.to_int n) basis - |> List.fold_left (fun accu i -> - match accu with - | [] -> [] - | (h,j) :: rest -> if j == i then ((h+1,j)::rest) else ((h+1,i)::(h+1,j)::rest) - ) [(0,0)] - |> List.rev - |> List.map fst - )) ; + ~rank:1 ~dim:[| shell_num |] + ~data:( list_map (fun (_,n) -> Nucl_number.to_int n) basis) + ) ; Ezfio.set_basis_nucleus_shell_num(Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| nucl_num |] ~data:( diff --git a/src/basis/EZFIO.cfg b/src/basis/EZFIO.cfg index a6df8e7a..a6864418 100644 --- a/src/basis/EZFIO.cfg +++ b/src/basis/EZFIO.cfg @@ -37,16 +37,16 @@ doc: Number of primitives in a shell size: (basis.shell_num) interface: ezfio, provider -[shell_prim_index] +[shell_index] type: integer -doc: Index of the first primitive of the shell -size: (basis.shell_num) +doc: Index of the shell for each primitive +size: (basis.prim_num) interface: ezfio, provider [basis_nucleus_index] type: integer -doc: Index of the nucleus on which the shell is centered -size: (nuclei.nucl_num) +doc: Nucleus on which the shell is centered +size: (basis.shell_num) interface: ezfio, provider [prim_normalization_factor] diff --git a/src/basis/basis.irp.f b/src/basis/basis.irp.f index 6a406e28..b750d75a 100644 --- a/src/basis/basis.irp.f +++ b/src/basis/basis.irp.f @@ -30,8 +30,10 @@ BEGIN_PROVIDER [ double precision, shell_normalization_factor , (shell_num) ] powA(3) = 0 norm = 0.d0 - do k=shell_prim_index(i),shell_prim_index(i)+shell_prim_num(i)-1 - do j=shell_prim_index(i),shell_prim_index(i)+shell_prim_num(i)-1 + do k=1, prim_num + if (shell_index(k) /= i) cycle + do j=1, prim_num + if (shell_index(j) /= i) cycle call overlap_gaussian_xyz(C_A,C_A,prim_expo(j),prim_expo(k), & powA,powA,overlap_x,overlap_y,overlap_z,c,nz) norm = norm+c*prim_coef(j)*prim_coef(k) * prim_normalization_factor(j) * prim_normalization_factor(k) @@ -91,7 +93,8 @@ BEGIN_PROVIDER [ double precision, prim_normalization_factor , (prim_num) ] powA(2) = 0 powA(3) = 0 - do k=shell_prim_index(i),shell_prim_index(i)+shell_prim_num(i)-1 + do k=1, prim_num + if (shell_index(k) /= i) cycle call overlap_gaussian_xyz(C_A,C_A,prim_expo(k),prim_expo(k), & powA,powA,overlap_x,overlap_y,overlap_z,norm,nz) prim_normalization_factor(k) = 1.d0/dsqrt(norm) From dc43924aa69d744278122d2c521674218c752169 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 7 Dec 2021 22:53:28 +0100 Subject: [PATCH 38/86] Cleaning --- src/cipsi/pt2_stoch_routines.irp.f | 1 - src/cipsi/selection_buffer.irp.f | 17 ++++++++--------- src/cipsi/slave_cipsi.irp.f | 2 +- src/determinants/h_apply.irp.f | 5 +---- 4 files changed, 10 insertions(+), 15 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index b14bdf8d..ce393c27 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -117,7 +117,6 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull integer, intent(in) :: N_in -! integer, intent(inout) :: N_in double precision, intent(in) :: relative_error, E(N_states) type(pt2_type), intent(inout) :: pt2_data, pt2_data_err ! diff --git a/src/cipsi/selection_buffer.irp.f b/src/cipsi/selection_buffer.irp.f index 10132086..a50b02e6 100644 --- a/src/cipsi/selection_buffer.irp.f +++ b/src/cipsi/selection_buffer.irp.f @@ -60,6 +60,7 @@ subroutine add_to_selection_buffer(b, det, val) b%val(b%cur) = val if(b%cur == size(b%val)) then call sort_selection_buffer(b) + b%cur = b%cur-1 end if end if end subroutine @@ -144,8 +145,8 @@ subroutine sort_selection_buffer(b) double precision :: rss double precision, external :: memory_of_double, memory_of_int - rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3)) - call check_mem(rss,irp_here) +! rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3)) +! call check_mem(rss,irp_here) allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3))) do i=1,b%cur iorder(i) = i @@ -225,14 +226,14 @@ subroutine make_selection_buffer_s2(b) endif dup = .True. do k=1,N_int - if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) & - .or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then + if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) .or. & + (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then dup = .False. exit endif enddo if (dup) then - val(i) = max(val(i), val(j)) + val(i) = min(val(i), val(j)) duplicate(j) = .True. endif j+=1 @@ -282,9 +283,6 @@ subroutine make_selection_buffer_s2(b) call configuration_to_dets_size(o(1,1,i),sze,elec_alpha_num,N_int) n_d = n_d + sze if (n_d > b%cur) then -! if (n_d - b%cur > b%cur - n_d + sze) then -! n_d = n_d - sze -! endif exit endif enddo @@ -329,10 +327,11 @@ subroutine remove_duplicates_in_selection_buffer(b) integer(bit_kind), allocatable :: tmp_array(:,:,:) logical, allocatable :: duplicate(:) - n_d = b%cur logical :: found_duplicates double precision :: rss double precision, external :: memory_of_double + + n_d = b%cur rss = (4*N_int+4)*memory_of_double(n_d) call check_mem(rss,irp_here) diff --git a/src/cipsi/slave_cipsi.irp.f b/src/cipsi/slave_cipsi.irp.f index ddfc050e..f96aaa6a 100644 --- a/src/cipsi/slave_cipsi.irp.f +++ b/src/cipsi/slave_cipsi.irp.f @@ -311,7 +311,7 @@ subroutine run_slave_main if (mpi_master) then print *, 'Running PT2' endif - !$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target+1) + !$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target) i = omp_get_thread_num() call run_pt2_slave(0,i,pt2_e0_denominator) !$OMP END PARALLEL diff --git a/src/determinants/h_apply.irp.f b/src/determinants/h_apply.irp.f index 98fafb4a..d01ad1c7 100644 --- a/src/determinants/h_apply.irp.f +++ b/src/determinants/h_apply.irp.f @@ -322,10 +322,7 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc) ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num) enddo do i=1,n_selected - do j=1,N_int - H_apply_buffer(iproc)%det(j,1,i+H_apply_buffer(iproc)%N_det) = det_buffer(j,1,i) - H_apply_buffer(iproc)%det(j,2,i+H_apply_buffer(iproc)%N_det) = det_buffer(j,2,i) - enddo + H_apply_buffer(iproc)%det(:,:,i+H_apply_buffer(iproc)%N_det) = det_buffer(:,:,i) ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i+H_apply_buffer(iproc)%N_det)) )== elec_alpha_num) ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i+H_apply_buffer(iproc)%N_det))) == elec_beta_num) enddo From 41f9c8ea6b2593ab1a7cd48cb0387ea8cc95262c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 8 Dec 2021 01:47:18 +0100 Subject: [PATCH 39/86] Fixed OpenMP bug in selection (slave_large) --- src/cipsi/pt2_stoch_routines.irp.f | 18 +++++++------- src/cipsi/run_pt2_slave.irp.f | 35 +++++++++++++-------------- src/cipsi/selection_buffer.irp.f | 4 +-- src/determinants/density_matrix.irp.f | 6 ++--- src/determinants/determinants.irp.f | 1 - 5 files changed, 31 insertions(+), 33 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index ce393c27..cf7ae33c 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -318,10 +318,10 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) print '(A)', '========== ======================= ===================== ===================== ===========' - do k=1,N_states - pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate) - enddo - SOFT_TOUCH pt2_overlap + do k=1,N_states + pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate) + enddo + SOFT_TOUCH pt2_overlap enddo FREE pt2_stoch_istate @@ -575,11 +575,11 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_ endif do i=1,n_tasks if(index(i).gt.size(pt2_data_I,1).or.index(i).lt.1)then - print*,'PB !!!' - print*,'If you see this, send a bug report with the following content' - print*,irp_here - print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1) - stop -1 + print*,'PB !!!' + print*,'If you see this, send a bug report with the following content' + print*,irp_here + print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1) + stop -1 endif call pt2_add(pt2_data_I(index(i)),1.d0,pt2_data_task(i)) f(index(i)) -= 1 diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index a72d3dbb..f1001f89 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -31,12 +31,11 @@ subroutine run_pt2_slave(thread,iproc,energy) double precision, intent(in) :: energy(N_states_diag) integer, intent(in) :: thread, iproc - call run_pt2_slave_large(thread,iproc,energy) -! if (N_det > nproc*(elec_alpha_num * (mo_num-elec_alpha_num))**2) then -! call run_pt2_slave_large(thread,iproc,energy) -! else -! call run_pt2_slave_small(thread,iproc,energy) -! endif + if (N_det > 100000 ) then + call run_pt2_slave_large(thread,iproc,energy) + else + call run_pt2_slave_small(thread,iproc,energy) + endif end subroutine run_pt2_slave_small(thread,iproc,energy) @@ -67,7 +66,6 @@ subroutine run_pt2_slave_small(thread,iproc,energy) double precision, external :: memory_of_double, memory_of_int integer :: bsize ! Size of selection buffers -! logical :: sending allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max)) allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max)) @@ -85,7 +83,6 @@ subroutine run_pt2_slave_small(thread,iproc,energy) buffer_ready = .False. n_tasks = 1 -! sending = .False. done = .False. do while (.not.done) @@ -119,14 +116,13 @@ subroutine run_pt2_slave_small(thread,iproc,energy) do k=1,n_tasks call pt2_alloc(pt2_data(k),N_states) b%cur = 0 -!double precision :: time2 -!call wall_time(time2) + double precision :: time2 + call wall_time(time2) call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k))) -!call wall_time(time1) -!print *, i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1)) + call wall_time(time1) +! print *, i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1)) enddo call wall_time(time1) -!print *, '-->', i_generator(1), time1-time0, n_tasks integer, external :: tasks_done_to_taskserver if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then @@ -164,6 +160,11 @@ end subroutine subroutine run_pt2_slave_large(thread,iproc,energy) use selection_types use f77_zmq + BEGIN_DOC +! This subroutine can miss important determinants when the PT2 is completely +! computed. It should be called only for large workloads where the PT2 is +! interrupted before the end + END_DOC implicit none double precision, intent(in) :: energy(N_states_diag) @@ -234,30 +235,28 @@ subroutine run_pt2_slave_large(thread,iproc,energy) ASSERT (b%N == bsize) endif - double precision :: time0, time1 - call wall_time(time0) call pt2_alloc(pt2_data,N_states) b%cur = 0 call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator)) - call wall_time(time1) integer, external :: tasks_done_to_taskserver if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then done = .true. endif call sort_selection_buffer(b) - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call omp_set_lock(global_selection_buffer_lock) global_selection_buffer%mini = b%mini call merge_selection_buffers(b,global_selection_buffer) b%cur=0 call omp_unset_lock(global_selection_buffer_lock) - if ( iproc == 1 ) then + if ( iproc == 1 .or. i_generator < 100 .or. done) then call omp_set_lock(global_selection_buffer_lock) + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) global_selection_buffer%cur = 0 call omp_unset_lock(global_selection_buffer_lock) else + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) endif diff --git a/src/cipsi/selection_buffer.irp.f b/src/cipsi/selection_buffer.irp.f index a50b02e6..79899139 100644 --- a/src/cipsi/selection_buffer.irp.f +++ b/src/cipsi/selection_buffer.irp.f @@ -87,8 +87,8 @@ subroutine merge_selection_buffers(b1, b2) double precision :: rss double precision, external :: memory_of_double sze = max(size(b1%val), size(b2%val)) - rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze) - call check_mem(rss,irp_here) +! rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze) +! call check_mem(rss,irp_here) allocate(val(sze), detmp(N_int, 2, sze)) i1=1 i2=1 diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index 6a474662..49f1a05c 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -330,12 +330,12 @@ BEGIN_PROVIDER [ double precision, c0_weight, (N_states) ] c = maxval(psi_coef(:,i) * psi_coef(:,i)) c0_weight(i) = 1.d0/(c+1.d-20) enddo - c = 1.d0/minval(c0_weight(:)) + c = 1.d0/sum(c0_weight(:)) do i=1,N_states c0_weight(i) = c0_weight(i) * c enddo else - c0_weight = 1.d0 + c0_weight(:) = 1.d0 endif END_PROVIDER @@ -352,7 +352,7 @@ BEGIN_PROVIDER [ double precision, state_average_weight, (N_states) ] if (weight_one_e_dm == 0) then state_average_weight(:) = c0_weight(:) else if (weight_one_e_dm == 1) then - state_average_weight(:) = 1./N_states + state_average_weight(:) = 1.d0/N_states else call ezfio_has_determinants_state_average_weight(exists) if (exists) then diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f index 2a6057de..b8c8658f 100644 --- a/src/determinants/determinants.irp.f +++ b/src/determinants/determinants.irp.f @@ -84,7 +84,6 @@ BEGIN_PROVIDER [ integer, psi_det_size ] else psi_det_size = 1 endif - psi_det_size = max(psi_det_size,100000) call write_int(6,psi_det_size,'Dimension of the psi arrays') endif IRP_IF MPI_DEBUG From f1b8d5547492ee2afcbc6a3198117482fd55e1e3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 8 Dec 2021 01:57:16 +0100 Subject: [PATCH 40/86] Notes --- RELEASE_NOTES.org | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/RELEASE_NOTES.org b/RELEASE_NOTES.org index 586bf431..01875f10 100644 --- a/RELEASE_NOTES.org +++ b/RELEASE_NOTES.org @@ -31,6 +31,7 @@ - Fixed bug in molden (Au -> Angs) - Fixed bug with non-contiguous MOs in active space and deleter MOs - Complete network-free installation + - Fixed bug in selection when computing full PT2 *** User interface @@ -86,7 +87,7 @@ - Using Intel IPP for sorting when using Intel compiler - Removed parallelism in sorting - Compute banned_excitations from exchange integrals to accelerate with local MOs - + From f2e3a12c054434559955f8b287515ee03bbe7341 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 10 Dec 2021 14:35:28 +0100 Subject: [PATCH 41/86] Updated constant PT2 selection --- src/cipsi/selection_weight.irp.f | 24 ++++++++++++++---------- src/determinants/EZFIO.cfg | 2 +- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/cipsi/selection_weight.irp.f b/src/cipsi/selection_weight.irp.f index 3c09e59a..756c65a1 100644 --- a/src/cipsi/selection_weight.irp.f +++ b/src/cipsi/selection_weight.irp.f @@ -38,11 +38,11 @@ subroutine update_pt2_and_variance_weights(pt2_data, N_st) avg = sum(pt2(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero - dt = 8.d0 !* selection_factor + dt = 4.d0 !* selection_factor do k=1,N_st - element = exp(dt*(pt2(k)/avg - 1.d0)) - element = min(2.0d0 , element) - element = max(0.5d0 , element) + element = pt2(k) !exp(dt*(pt2(k)/avg - 1.d0)) +! element = min(2.0d0 , element) +! element = max(0.5d0 , element) pt2_match_weight(k) *= element enddo @@ -50,9 +50,9 @@ subroutine update_pt2_and_variance_weights(pt2_data, N_st) avg = sum(variance(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero do k=1,N_st - element = exp(dt*(variance(k)/avg -1.d0)) - element = min(2.0d0 , element) - element = max(0.5d0 , element) + element = variance(k) ! exp(dt*(variance(k)/avg -1.d0)) +! element = min(2.0d0 , element) +! element = max(0.5d0 , element) variance_match_weight(k) *= element enddo @@ -62,6 +62,9 @@ subroutine update_pt2_and_variance_weights(pt2_data, N_st) variance_match_weight(:) = 1.d0 endif + pt2_match_weight(:) = pt2_match_weight(:)/sum(pt2_match_weight(:)) + variance_match_weight(:) = variance_match_weight(:)/sum(variance_match_weight(:)) + threshold_davidson_pt2 = min(1.d-6, & max(threshold_davidson, 1.e-1 * PT2_relative_error * minval(abs(pt2(1:N_states)))) ) @@ -87,7 +90,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ] selection_weight(1:N_states) = c0_weight(1:N_states) case (2) - print *, 'Using pt2-matching weight in selection' + print *, 'Using PT2-matching weight in selection' selection_weight(1:N_states) = c0_weight(1:N_states) * pt2_match_weight(1:N_states) print *, '# PT2 weight ', real(pt2_match_weight(:),4) @@ -97,7 +100,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ] print *, '# var weight ', real(variance_match_weight(:),4) case (4) - print *, 'Using variance- and pt2-matching weights in selection' + print *, 'Using variance- and PT2-matching weights in selection' selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states)) print *, '# PT2 weight ', real(pt2_match_weight(:),4) print *, '# var weight ', real(variance_match_weight(:),4) @@ -112,7 +115,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ] selection_weight(1:N_states) = c0_weight(1:N_states) case (7) - print *, 'Input weights multiplied by variance- and pt2-matching' + print *, 'Input weights multiplied by variance- and PT2-matching' selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states)) * state_average_weight(1:N_states) print *, '# PT2 weight ', real(pt2_match_weight(:),4) print *, '# var weight ', real(variance_match_weight(:),4) @@ -128,6 +131,7 @@ BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ] print *, '# var weight ', real(variance_match_weight(:),4) end select + selection_weight(:) = selection_weight(:)/sum(selection_weight(:)) print *, '# Total weight ', real(selection_weight(:),4) END_PROVIDER diff --git a/src/determinants/EZFIO.cfg b/src/determinants/EZFIO.cfg index 5e109de8..016f8b20 100644 --- a/src/determinants/EZFIO.cfg +++ b/src/determinants/EZFIO.cfg @@ -42,7 +42,7 @@ default: 2 [weight_selection] type: integer -doc: Weight used in the selection. 0: input state-average weight, 1: 1./(c_0^2), 2: rPT2 matching, 3: variance matching, 4: variance and rPT2 matching, 5: variance minimization and matching, 6: CI coefficients 7: input state-average multiplied by variance and rPT2 matching 8: input state-average multiplied by rPT2 matching 9: input state-average multiplied by variance matching +doc: Weight used in the selection. 0: input state-average weight, 1: 1./(c_0^2), 2: PT2 matching, 3: variance matching, 4: variance and PT2 matching, 5: variance minimization and matching, 6: CI coefficients 7: input state-average multiplied by variance and PT2 matching 8: input state-average multiplied by PT2 matching 9: input state-average multiplied by variance matching interface: ezfio,provider,ocaml default: 1 From b2cb796d908005d63ae669d15c0b5485ed8af05c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 10 Dec 2021 18:43:05 +0100 Subject: [PATCH 42/86] Removed debug prints --- ocaml/qp_create_ezfio.ml | 2 -- src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f | 8 ++++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/ocaml/qp_create_ezfio.ml b/ocaml/qp_create_ezfio.ml index e51dd0ef..8fcaf5fc 100644 --- a/ocaml/qp_create_ezfio.ml +++ b/ocaml/qp_create_ezfio.ml @@ -585,9 +585,7 @@ let run ?o b au c d m p cart xyz_file = let shell_prim_num = list_map List.length lc in - Printf.printf "Coucou\n%!"; let shell_idx = - Printf.printf "Coucou\n%!"; let rec make_list n accu = function | 0 -> accu | i -> make_list n (n :: accu) (i-1) diff --git a/src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f b/src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f index eb247dea..26ed5ae6 100644 --- a/src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f +++ b/src/two_rdm_routines/davidson_like_state_av_2rdm.irp.f @@ -529,10 +529,14 @@ subroutine orb_range_2_rdm_state_av_openmp_work_$N_int(big_array,dim1,norb,list_ c_average += c_1(l) * c_1(l) * state_weights(l) enddo - call update_keys_values(keys,values,nkeys,dim1,big_array,lock_2rdm) + if (nkeys > 0) then + call update_keys_values(keys,values,nkeys,dim1,big_array,lock_2rdm) + endif nkeys = 0 call orb_range_diag_to_all_2_rdm_dm_buffer(tmp_det,c_average,orb_bitmask,list_orb_reverse,ispin,sze_buff,nkeys,keys,values) - call update_keys_values(keys,values,nkeys,dim1,big_array,lock_2rdm) + if (nkeys > 0) then + call update_keys_values(keys,values,nkeys,dim1,big_array,lock_2rdm) + endif nkeys = 0 end do From 9d0e7c7034e0d0089fdd29ab68c61cb160cb733e Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Fri, 17 Dec 2021 18:15:47 +0100 Subject: [PATCH 43/86] moved a subroutine from determinant to bitmask --- src/bitmask/bitmasks_routines.irp.f | 15 ++++++++++++++ src/determinants/slater_rules.irp.f | 31 ++++++++++++++++++++++++++++- 2 files changed, 45 insertions(+), 1 deletion(-) diff --git a/src/bitmask/bitmasks_routines.irp.f b/src/bitmask/bitmasks_routines.irp.f index c34d54dc..9c6f4f0c 100644 --- a/src/bitmask/bitmasks_routines.irp.f +++ b/src/bitmask/bitmasks_routines.irp.f @@ -268,6 +268,21 @@ subroutine print_spindet(string,Nint) end +subroutine print_det_one_dimension(string,Nint) + use bitmasks + implicit none + BEGIN_DOC + ! Subroutine to print the content of a determinant using the '+-' notation + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: string(Nint) + character*(2048) :: output(1) + + call bitstring_to_str( output(1), string, Nint ) + print *, trim(output(1)) + +end + logical function is_integer_in_string(bite,string,Nint) use bitmasks implicit none diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 04cf861f..3a33a37d 100644 --- a/src/determinants/slater_rules.irp.f +++ b/src/determinants/slater_rules.irp.f @@ -438,7 +438,7 @@ subroutine bitstring_to_list_ab( string, list, n_elements, Nint) use bitmasks implicit none BEGIN_DOC - ! Gives the inidices(+1) of the bits set to 1 in the bit string + ! Gives the indices(+1) of the bits set to 1 in the bit string ! For alpha/beta determinants. END_DOC integer, intent(in) :: Nint @@ -472,6 +472,35 @@ subroutine bitstring_to_list_ab( string, list, n_elements, Nint) end +!subroutine bitstring_to_list( string, list, n_elements, Nint) +! use bitmasks +! implicit none +! BEGIN_DOC +! ! Gives the indices(+1) of the bits set to 1 in the bit string +! END_DOC +! integer, intent(in) :: Nint +! integer(bit_kind), intent(in) :: string(Nint) +! integer, intent(out) :: list(Nint*bit_kind_size) +! integer, intent(out) :: n_elements +! +! integer :: i, j, ishift +! integer(bit_kind) :: l +! +! n_elements = 0 +! ishift = 1 +! do i=1,Nint +! l = string(i) +! do while (l /= 0_bit_kind) +! j = trailz(l) +! n_elements = n_elements + 1 +! l = ibclr(l,j) +! list(n_elements) = ishift+j +! enddo +! ishift = ishift + bit_kind_size +! enddo +! +!end + subroutine i_H_j_s2(key_i,key_j,Nint,hij,s2) use bitmasks From 7fba7a120907319fb346df605e07100763596501 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 23 Dec 2021 15:14:54 +0100 Subject: [PATCH 44/86] Removed qmkl --- config/ifort_2021_avx.cfg | 2 +- config/ifort_2021_avx_mpi.cfg | 2 +- config/ifort_2021_sse4.cfg | 2 +- config/ifort_2021_sse4_mpi.cfg | 2 +- config/ifort_2021_xHost.cfg | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/config/ifort_2021_avx.cfg b/config/ifort_2021_avx.cfg index 8fadda67..6f657052 100644 --- a/config/ifort_2021_avx.cfg +++ b/config/ifort_2021_avx.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : ifort -fpic -LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DINTEL diff --git a/config/ifort_2021_avx_mpi.cfg b/config/ifort_2021_avx_mpi.cfg index b6b74b73..c991a4a9 100644 --- a/config/ifort_2021_avx_mpi.cfg +++ b/config/ifort_2021_avx_mpi.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : mpiifort -fpic -LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL diff --git a/config/ifort_2021_sse4.cfg b/config/ifort_2021_sse4.cfg index 269023da..a6299665 100644 --- a/config/ifort_2021_sse4.cfg +++ b/config/ifort_2021_sse4.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : ifort -fpic -LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DINTEL diff --git a/config/ifort_2021_sse4_mpi.cfg b/config/ifort_2021_sse4_mpi.cfg index 41df87bc..6ae56d2a 100644 --- a/config/ifort_2021_sse4_mpi.cfg +++ b/config/ifort_2021_sse4_mpi.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : mpiifort -fpic -LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 -DMPI -DINTEL diff --git a/config/ifort_2021_xHost.cfg b/config/ifort_2021_xHost.cfg index 05c271f3..1e76a69d 100644 --- a/config/ifort_2021_xHost.cfg +++ b/config/ifort_2021_xHost.cfg @@ -7,7 +7,7 @@ # [COMMON] FC : ifort -fpic -LAPACK_LIB : -qmkl=parallel -lirc -lsvml -limf -lipps +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=64 -DINTEL From 2a98378fcab6454c060e3cd4ad543506c16e2103 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 30 Dec 2021 14:43:14 +0100 Subject: [PATCH 45/86] Fix basis bugs when working on trexio --- ocaml/qp_create_ezfio.ml | 60 +++++++++++++++++++++++----------------- src/pseudo/EZFIO.cfg | 6 ++-- 2 files changed, 38 insertions(+), 28 deletions(-) diff --git a/ocaml/qp_create_ezfio.ml b/ocaml/qp_create_ezfio.ml index 8fcaf5fc..be6c305b 100644 --- a/ocaml/qp_create_ezfio.ml +++ b/ocaml/qp_create_ezfio.ml @@ -91,7 +91,7 @@ let run ?o b au c d m p cart xyz_file = | Element e -> Element.to_string e | Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e) in - Hashtbl.find basis_table key + Hashtbl.find basis_table key in let temp_filename = @@ -132,7 +132,7 @@ let run ?o b au c d m p cart xyz_file = Element.to_string elem.Atom.element in Hashtbl.add basis_table key new_channel - ) nuclei + ) nuclei end | Some (key, basis) -> (*Aux basis *) begin @@ -277,6 +277,16 @@ let run ?o b au c d m p cart xyz_file = ) nuclei in + let z_core = + List.map (fun x -> + Positive_int.to_int x.Pseudo.n_elec + |> float_of_int + ) pseudo + in + let nucl_num = (List.length z_core) in + Ezfio.set_pseudo_nucl_charge_remove (Ezfio.ezfio_array_of_list + ~rank:1 ~dim:[| nucl_num |] ~data:z_core); + let molecule = let n_elec_to_remove = List.fold_left (fun accu x -> @@ -293,13 +303,13 @@ let run ?o b au c d m p cart xyz_file = Molecule.nuclei = let charges = list_map (fun x -> Positive_int.to_int x.Pseudo.n_elec - |> Float.of_int) pseudo + |> Float.of_int) pseudo |> Array.of_list in List.mapi (fun i x -> { x with Atom.charge = (Charge.to_float x.Atom.charge) -. charges.(i) |> Charge.of_float } - ) molecule.Molecule.nuclei + ) molecule.Molecule.nuclei } in let nuclei = @@ -356,11 +366,11 @@ let run ?o b au c d m p cart xyz_file = in if (x > accu) then x else accu - ) 0 x.Pseudo.non_local + ) 0 x.Pseudo.non_local in if (x > accu) then x else accu - ) 0 pseudo + ) 0 pseudo in let kmax = @@ -368,10 +378,10 @@ let run ?o b au c d m p cart xyz_file = list_map (fun x -> List.filter (fun (y,_) -> (Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i) - x.Pseudo.non_local - |> List.length ) pseudo + x.Pseudo.non_local + |> List.length ) pseudo |> List.fold_left (fun accu x -> - if accu > x then accu else x) 0 + if accu > x then accu else x) 0 ) |> Array.fold_left (fun accu i -> if i > accu then i else accu) 0 @@ -396,11 +406,11 @@ let run ?o b au c d m p cart xyz_file = in tmp_array_dz_k.(i).(j) <- y; tmp_array_n_k.(i).(j) <- z; - ) x.Pseudo.local + ) x.Pseudo.local ) pseudo ; let concat_2d tmp_array = let data = - Array.map Array.to_list tmp_array + Array.map Array.to_list tmp_array |> Array.to_list |> List.concat in @@ -438,14 +448,14 @@ let run ?o b au c d m p cart xyz_file = tmp_array_dz_kl.(k).(i).(j) <- y; tmp_array_n_kl.(k).(i).(j) <- z; last_idx.(k) <- i+1; - ) x.Pseudo.non_local + ) x.Pseudo.non_local ) pseudo ; let concat_3d tmp_array = let data = Array.map (fun x -> Array.map Array.to_list x |> Array.to_list - |> List.concat) tmp_array + |> List.concat) tmp_array |> Array.to_list |> List.concat in @@ -513,8 +523,8 @@ let run ?o b au c d m p cart xyz_file = Ezfio.set_ao_basis_ao_num ao_num; Ezfio.set_ao_basis_ao_basis b; Ezfio.set_basis_basis b; - let ao_prim_num = list_map (fun (_,g,_) -> List.length g.Gto.lc) long_basis - and ao_nucl = list_map (fun (_,_,n) -> Nucl_number.to_int n) long_basis + let ao_prim_num = list_map (fun (_,g,_) -> List.length g.Gto.lc) long_basis + and ao_nucl = list_map (fun (_,_,n) -> Nucl_number.to_int n) long_basis and ao_power= let l = list_map (fun (x,_,_) -> x) long_basis in (list_map (fun t -> Positive_int.to_int Angmom.Xyz.(t.x)) l)@ @@ -526,7 +536,7 @@ let run ?o b au c d m p cart xyz_file = else s) 0 ao_prim_num in let gtos = - list_map (fun (_,x,_) -> x) long_basis + list_map (fun (_,x,_) -> x) long_basis in let create_expo_coef ec = @@ -534,10 +544,10 @@ let run ?o b au c d m p cart xyz_file = begin match ec with | `Coefs -> list_map (fun x-> list_map (fun (_,coef) -> - AO_coef.to_float coef) x.Gto.lc) gtos + AO_coef.to_float coef) x.Gto.lc) gtos | `Expos -> list_map (fun x-> list_map (fun (prim,_) -> AO_expo.to_float - prim.GaussianPrimitive.expo) x.Gto.lc) gtos + prim.GaussianPrimitive.expo) x.Gto.lc) gtos end in let rec get_n n accu = function @@ -567,7 +577,7 @@ let run ?o b au c d m p cart xyz_file = list_map ( fun (g,_) -> g.Gto.lc ) basis in let ang_mom = - list_map (fun (l : (GaussianPrimitive.t * Qptypes.AO_coef.t) list) -> + list_map (fun (l : (GaussianPrimitive.t * Qptypes.AO_coef.t) list) -> let x, _ = List.hd l in Angmom.to_l x.GaussianPrimitive.sym |> Qptypes.Positive_int.to_int ) lc @@ -577,7 +587,7 @@ let run ?o b au c d m p cart xyz_file = |> List.concat in let coef = - list_map (fun l -> + list_map (fun l -> list_map (fun (_,x) -> Qptypes.AO_coef.to_float x) l ) lc |> List.concat @@ -610,14 +620,14 @@ let run ?o b au c d m p cart xyz_file = ~rank:1 ~dim:[| prim_num |] ~data:shell_idx) ; Ezfio.set_basis_basis_nucleus_index (Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| shell_num |] - ~data:( list_map (fun (_,n) -> Nucl_number.to_int n) basis) + ~data:( list_map (fun (_,n) -> Nucl_number.to_int n) basis) ) ; Ezfio.set_basis_nucleus_shell_num(Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| nucl_num |] ~data:( list_map (fun (_,n) -> Nucl_number.to_int n) basis - |> List.fold_left (fun accu i -> - match accu with + |> List.fold_left (fun accu i -> + match accu with | [] -> [(1,i)] | (h,j) :: rest -> if j == i then ((h+1,j)::rest) else ((1,i)::(h,j)::rest) ) [] @@ -713,7 +723,7 @@ If a file with the same name as the basis set exists, this file will be read. O anonymous "FILE" Mandatory "Input file in xyz format or z-matrix."; ] - |> set_specs + |> set_specs end; @@ -737,7 +747,7 @@ If a file with the same name as the basis set exists, this file will be read. O | None -> 0 | Some x -> ( if x.[0] = 'm' then ~- (int_of_string (String.sub x 1 (String.length x - 1))) - else + else int_of_string x ) in diff --git a/src/pseudo/EZFIO.cfg b/src/pseudo/EZFIO.cfg index 952ebe04..2b76a5c3 100644 --- a/src/pseudo/EZFIO.cfg +++ b/src/pseudo/EZFIO.cfg @@ -10,7 +10,7 @@ type:integer interface: ezfio,provider [pseudo_n_k] -doc: Number of gaussians in the local component +doc: Powers of r - 2 in the local component type: integer interface: ezfio,provider size: (nuclei.nucl_num,pseudo.pseudo_klocmax) @@ -38,7 +38,7 @@ type:integer interface: ezfio,provider [pseudo_n_kl] -doc: Number of functions in the non-local component +doc: Powers of r - 2 in the non-local component type: integer interface: ezfio,provider size: (nuclei.nucl_num,pseudo.pseudo_kmax,0:pseudo.pseudo_lmax) @@ -69,7 +69,7 @@ default: 1000 [pseudo_grid_rmax] type: double precision -doc: R_max of the QMC grid +doc: R_max of the QMC grid interface: ezfio,provider,ocaml default: 10.0 From bc71a23ffb963234fe9b5652a248a832dc4c56bf Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 4 Jan 2022 12:53:34 +0100 Subject: [PATCH 46/86] Bug in molden + bug in print --- src/cipsi/pt2_stoch_routines.irp.f | 2 +- src/tools/molden.irp.f | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 3fa2641a..14b1d060 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -131,7 +131,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted PROVIDE psi_det_hii selection_weight pseudo_sym - PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max + PROVIDE list_act list_inact list_core list_virt list_del seniority_max PROVIDE excitation_beta_max excitation_alpha_max excitation_max if (h0_type == 'CFG') then diff --git a/src/tools/molden.irp.f b/src/tools/molden.irp.f index 417b25ad..830a141e 100644 --- a/src/tools/molden.irp.f +++ b/src/tools/molden.irp.f @@ -52,8 +52,8 @@ program molden l += 1 if (l > ao_num) exit enddo - write(i_unit_output,*)'' enddo + write(i_unit_output,*)'' enddo From 1ee940018b8d778b3cbab3cbc4f849124d9f63cd Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 7 Jan 2022 15:08:51 +0100 Subject: [PATCH 47/86] Added ifort_2019_mpi_rome.cfg --- config/ifort_2019_mpi_rome.cfg | 63 ++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 config/ifort_2019_mpi_rome.cfg diff --git a/config/ifort_2019_mpi_rome.cfg b/config/ifort_2019_mpi_rome.cfg new file mode 100644 index 00000000..171219e6 --- /dev/null +++ b/config/ifort_2019_mpi_rome.cfg @@ -0,0 +1,63 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : mpiifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DINTEL -DSET_NESTED + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FC : -traceback -shared-intel +FCFLAGS : -O2 -ip -g -march=core-avx2 -align array64byte -fma -ftz -fomit-frame-pointer + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + From cf3f510704b76cd23cc463aa9237327e1b82311d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 7 Jan 2022 15:11:05 +0100 Subject: [PATCH 48/86] Added ifort_2021_mpi_rome.cfg --- config/ifort_2021_mpi_rome.cfg | 63 ++++++++++++++++++++++++++++++++++ config/ifort_2021_rome.cfg | 63 ++++++++++++++++++++++++++++++++++ 2 files changed, 126 insertions(+) create mode 100644 config/ifort_2021_mpi_rome.cfg create mode 100644 config/ifort_2021_rome.cfg diff --git a/config/ifort_2021_mpi_rome.cfg b/config/ifort_2021_mpi_rome.cfg new file mode 100644 index 00000000..8413d23d --- /dev/null +++ b/config/ifort_2021_mpi_rome.cfg @@ -0,0 +1,63 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : mpiifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DINTEL + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FC : -traceback -shared-intel +FCFLAGS : -O2 -ip -g -march=core-avx2 -align array64byte -fma -ftz -fomit-frame-pointer + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + diff --git a/config/ifort_2021_rome.cfg b/config/ifort_2021_rome.cfg new file mode 100644 index 00000000..b3023186 --- /dev/null +++ b/config/ifort_2021_rome.cfg @@ -0,0 +1,63 @@ +# Common flags +############## +# +# -mkl=[parallel|sequential] : Use the MKL library +# --ninja : Allow the utilisation of ninja. It is mandatory ! +# --align=32 : Align all provided arrays on a 32-byte boundary +# +[COMMON] +FC : ifort -fpic +LAPACK_LIB : -mkl=parallel -lirc -lsvml -limf -lipps +IRPF90 : irpf90 +IRPF90_FLAGS : --ninja --align=32 -DINTEL + +# Global options +################ +# +# 1 : Activate +# 0 : Deactivate +# +[OPTION] +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +CACHE : 0 ; Enable cache_compile.py +OPENMP : 1 ; Append OpenMP flags + +# Optimization flags +#################### +# +# -xHost : Compile a binary optimized for the current architecture +# -O2 : O3 not better than O2. +# -ip : Inter-procedural optimizations +# -ftz : Flushes denormal results to zero +# +[OPT] +FC : -traceback -shared-intel +FCFLAGS : -O2 -ip -g -march=core-avx2 -align array64byte -fma -ftz -fomit-frame-pointer + +# Profiling flags +################# +# +[PROFILE] +FC : -p -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz + +# Debugging flags +################# +# +# -traceback : Activate backtrace on runtime +# -fpe0 : All floating point exaceptions +# -C : Checks uninitialized variables, array subscripts, etc... +# -g : Extra debugging information +# -xSSE2 : Valgrind needs a very simple x86 executable +# +[DEBUG] +FC : -g -traceback +FCFLAGS : -xSSE2 -C -fpe0 -implicitnone + +# OpenMP flags +################# +# +[OPENMP] +FC : -qopenmp +IRPF90_FLAGS : --openmp + From 5e7978304d5a258aa49905813c3205d08e2f2d88 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 11 Jan 2022 11:25:48 +0100 Subject: [PATCH 49/86] Documentation --- src/two_body_rdm/two_e_dm_mo.irp.f | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/two_body_rdm/two_e_dm_mo.irp.f b/src/two_body_rdm/two_e_dm_mo.irp.f index 4dadd2e6..a4dea15f 100644 --- a/src/two_body_rdm/two_e_dm_mo.irp.f +++ b/src/two_body_rdm/two_e_dm_mo.irp.f @@ -1,9 +1,8 @@ BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num)] implicit none BEGIN_DOC - ! two_e_dm_bb_mo(i,j,k,l,istate) = STATE SPECIFIC physicist notation for 2RDM of beta/beta electrons - ! - ! + ! \sum_{\sigma \sigma'} + ! ! ! where the indices (i,j,k,l) belong to all MOs. ! @@ -12,7 +11,7 @@ BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num)] ! !!!!! WARNING !!!!! IF "no_core_density" then all elements involving at least one CORE MO are set to zero ! The state-averaged two-electron energy : ! - ! \sum_{i,j,k,l = 1, mo_num} two_e_dm_mo(i,j,k,l) * < ii jj | kk ll > + ! \sum_{i,j,k,l = 1, mo_num} two_e_dm_mo(i,j,k,l) * < kk ll | ii jj > END_DOC two_e_dm_mo = 0.d0 integer :: i,j,k,l,iorb,jorb,korb,lorb,istate From 188ccf0d06579319346ca7f20cf2f7b969fe36a7 Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Thu, 20 Jan 2022 20:10:50 +0100 Subject: [PATCH 50/86] removed bug in subroutine of dav_general_mat --- src/csf/configurations.irp.f | 24 ++++++++++++++ .../dav_diag_dressed_ext_rout.irp.f | 32 +------------------ src/determinants/s2.irp.f | 6 +++- src/mo_guess/h_core_guess_routine.irp.f | 2 +- 4 files changed, 31 insertions(+), 33 deletions(-) diff --git a/src/csf/configurations.irp.f b/src/csf/configurations.irp.f index 8e2a513c..ce5d48ab 100644 --- a/src/csf/configurations.irp.f +++ b/src/csf/configurations.irp.f @@ -779,6 +779,7 @@ subroutine binary_search_cfg(cfgInp,addcfg) end subroutine BEGIN_PROVIDER [ integer, psi_configuration_to_psi_det, (2,N_configuration) ] +&BEGIN_PROVIDER [ integer, psi_configuration_n_det, (N_configuration) ] &BEGIN_PROVIDER [ integer, psi_configuration_to_psi_det_data, (N_det) ] implicit none @@ -867,6 +868,29 @@ end subroutine enddo deallocate(dets, old_order) + integer :: ndet_conf + do i = 1, N_configuration + ndet_conf = psi_configuration_to_psi_det(2,i) - psi_configuration_to_psi_det(1,i) + 1 + psi_configuration_n_det(i) = ndet_conf + enddo END_PROVIDER + +BEGIN_PROVIDER [ integer, n_elec_alpha_for_psi_configuration, (N_configuration)] + implicit none + integer :: i,j,k,l + integer(bit_kind) :: det_tmp(N_int,2),det_alpha(N_int) + n_elec_alpha_for_psi_configuration = 0 + do i = 1, N_configuration + j = psi_configuration_to_psi_det(2,i) + det_tmp(:,:) = psi_det(:,:,j) + k = 0 + do l = 1, N_int + det_alpha(N_int) = iand(det_tmp(l,1),psi_configuration(l,1,i)) + k += popcnt(det_alpha(l)) + enddo + n_elec_alpha_for_psi_configuration(i) = k + enddo + +END_PROVIDER diff --git a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f index 2f3d7f80..243e9995 100644 --- a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f +++ b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f @@ -1,5 +1,5 @@ -subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc) +subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc) use mmap_module implicit none BEGIN_DOC @@ -412,36 +412,6 @@ subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_d FREE nthreads_davidson end -subroutine hcalc_template(v,u,N_st,sze) - use bitmasks - implicit none - BEGIN_DOC - ! Template of routine for the application of H - ! - ! Here, it is done with the Hamiltonian matrix - ! - ! on the set of determinants of psi_det - ! - ! Computes $v = H | u \rangle$ - ! - END_DOC - integer, intent(in) :: N_st,sze - double precision, intent(in) :: u(sze,N_st) - double precision, intent(inout) :: v(sze,N_st) - integer :: i,j,istate - v = 0.d0 - do istate = 1, N_st - do i = 1, sze - do j = 1, sze - v(i,istate) += H_matrix_all_dets(j,i) * u(j,istate) - enddo - enddo - do i = 1, sze - v(i,istate) += u(i,istate) * nuclear_repulsion - enddo - enddo -end - subroutine dressing_diag_uv(v,u,dress_diag,N_st,sze) implicit none BEGIN_DOC diff --git a/src/determinants/s2.irp.f b/src/determinants/s2.irp.f index d73b2dbf..2c1a8757 100644 --- a/src/determinants/s2.irp.f +++ b/src/determinants/s2.irp.f @@ -103,13 +103,17 @@ BEGIN_PROVIDER [ double precision, expected_s2] END_PROVIDER -BEGIN_PROVIDER [ double precision, s2_values, (N_states) ] + BEGIN_PROVIDER [ double precision, s2_values, (N_states) ] +&BEGIN_PROVIDER [ double precision, s_values, (N_states) ] implicit none BEGIN_DOC ! array of the averaged values of the S^2 operator on the various states END_DOC integer :: i call u_0_S2_u_0(s2_values,psi_coef,n_det,psi_det,N_int,N_states,psi_det_size) + do i = 1, N_states + s_values(i) = 0.5d0 *(-1.d0 + dsqrt(1.d0 + 4 * s2_values(i))) + enddo END_PROVIDER diff --git a/src/mo_guess/h_core_guess_routine.irp.f b/src/mo_guess/h_core_guess_routine.irp.f index cbf23a9a..fcbdde49 100644 --- a/src/mo_guess/h_core_guess_routine.irp.f +++ b/src/mo_guess/h_core_guess_routine.irp.f @@ -7,7 +7,7 @@ subroutine hcore_guess label = 'Guess' call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, & size(mo_one_e_integrals,1), & - size(mo_one_e_integrals,2),label,1,.false.) + size(mo_one_e_integrals,2),label,1,.true.) call nullify_small_elements(ao_num, mo_num, mo_coef, size(mo_coef,1), 1.d-12 ) call save_mos TOUCH mo_coef mo_label From a65902aa33da727fa48ce69c81a0fd4caad7d75d Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Tue, 25 Jan 2022 18:20:03 +0100 Subject: [PATCH 51/86] fixed bug in Laplacians --- src/dft_utils_in_r/ao_in_r.irp.f | 34 +++++++++++++++++++++----------- src/dft_utils_in_r/mo_in_r.irp.f | 2 +- 2 files changed, 24 insertions(+), 12 deletions(-) diff --git a/src/dft_utils_in_r/ao_in_r.irp.f b/src/dft_utils_in_r/ao_in_r.irp.f index 6fa6a4c7..38478d21 100644 --- a/src/dft_utils_in_r/ao_in_r.irp.f +++ b/src/dft_utils_in_r/ao_in_r.irp.f @@ -91,7 +91,19 @@ enddo END_PROVIDER - BEGIN_PROVIDER[double precision, aos_lapl_in_r_array, (ao_num,n_points_final_grid,3)] + BEGIN_PROVIDER [double precision, aos_lapl_in_r_array_transp, (ao_num, n_points_final_grid,3)] + implicit none + integer :: i,j,m + do i = 1, n_points_final_grid + do j = 1, ao_num + do m = 1, 3 + aos_lapl_in_r_array_transp(j,i,m) = aos_lapl_in_r_array(m,j,i) + enddo + enddo + enddo + END_PROVIDER + + BEGIN_PROVIDER [double precision, aos_lapl_in_r_array, (3,ao_num,n_points_final_grid)] implicit none BEGIN_DOC ! aos_lapl_in_r_array(i,j,k) = value of the kth component of the laplacian of jth ao on the ith grid point @@ -100,20 +112,20 @@ END_DOC integer :: i,j,m double precision :: aos_array(ao_num), r(3) - double precision :: aos_grad_array(ao_num,3) - double precision :: aos_lapl_array(ao_num,3) + double precision :: aos_grad_array(3,ao_num) + double precision :: aos_lapl_array(3,ao_num) !$OMP PARALLEL DO & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i,r,aos_array,aos_grad_array,aos_lapl_array,j,m) & !$OMP SHARED(aos_lapl_in_r_array,n_points_final_grid,ao_num,final_grid_points) - do m = 1, 3 - do i = 1, n_points_final_grid - r(1) = final_grid_points(1,i) - r(2) = final_grid_points(2,i) - r(3) = final_grid_points(3,i) - call give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_lapl_array) - do j = 1, ao_num - aos_lapl_in_r_array(j,i,m) = aos_lapl_array(j,m) + do i = 1, n_points_final_grid + r(1) = final_grid_points(1,i) + r(2) = final_grid_points(2,i) + r(3) = final_grid_points(3,i) + call give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_lapl_array) + do j = 1, ao_num + do m = 1, 3 + aos_lapl_in_r_array(m,j,i) = aos_lapl_array(m,j) enddo enddo enddo diff --git a/src/dft_utils_in_r/mo_in_r.irp.f b/src/dft_utils_in_r/mo_in_r.irp.f index 0a8b4d52..192cb25a 100644 --- a/src/dft_utils_in_r/mo_in_r.irp.f +++ b/src/dft_utils_in_r/mo_in_r.irp.f @@ -138,7 +138,7 @@ integer :: m mos_lapl_in_r_array = 0.d0 do m=1,3 - call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_coef_transp,mo_num,aos_lapl_in_r_array(1,1,m),ao_num,0.d0,mos_lapl_in_r_array(1,1,m),mo_num) + call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_coef_transp,mo_num,aos_lapl_in_r_array_transp(1,1,m),ao_num,0.d0,mos_lapl_in_r_array(1,1,m),mo_num) enddo END_PROVIDER From d84e3fa236f91132af65747b9707cb1ef8e109b7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 28 Jan 2022 20:16:01 +0100 Subject: [PATCH 52/86] Dressed davidson with CSF --- src/davidson/diagonalize_ci.irp.f | 1 - src/davidson_dressed/diagonalize_ci.irp.f | 316 +++++++++++++--------- 2 files changed, 192 insertions(+), 125 deletions(-) diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index fb991b65..54e248cc 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -1,4 +1,3 @@ - BEGIN_PROVIDER [ double precision, CI_energy, (N_states_diag) ] implicit none BEGIN_DOC diff --git a/src/davidson_dressed/diagonalize_ci.irp.f b/src/davidson_dressed/diagonalize_ci.irp.f index 709ee0e6..b58ce9c0 100644 --- a/src/davidson_dressed/diagonalize_ci.irp.f +++ b/src/davidson_dressed/diagonalize_ci.irp.f @@ -21,133 +21,201 @@ END_PROVIDER BEGIN_PROVIDER [ double precision, CI_electronic_energy_dressed, (N_states_diag) ] &BEGIN_PROVIDER [ double precision, CI_eigenvectors_dressed, (N_det,N_states_diag) ] &BEGIN_PROVIDER [ double precision, CI_eigenvectors_s2_dressed, (N_states_diag) ] - BEGIN_DOC - ! Eigenvectors/values of the CI matrix - END_DOC - implicit none - double precision :: ovrlp,u_dot_v - integer :: i_good_state - integer, allocatable :: index_good_state_array(:) - logical, allocatable :: good_state_array(:) - double precision, allocatable :: s2_values_tmp(:) - integer :: i_other_state - double precision, allocatable :: eigenvectors(:,:), eigenvectors_s2(:,:), eigenvalues(:) - integer :: i_state - double precision :: e_0 - integer :: i,j,k,mrcc_state - double precision, allocatable :: s2_eigvalues(:) - double precision, allocatable :: e_array(:) - integer, allocatable :: iorder(:) - - PROVIDE threshold_davidson nthreads_davidson - ! Guess values for the "N_states" states of the CI_eigenvectors_dressed - do j=1,min(N_states,N_det) - do i=1,N_det - CI_eigenvectors_dressed(i,j) = psi_coef(i,j) - enddo - enddo - - do j=min(N_states,N_det)+1,N_states_diag - do i=1,N_det - CI_eigenvectors_dressed(i,j) = 0.d0 - enddo - enddo - - if (diag_algorithm == "Davidson") then - - do j=1,min(N_states,N_det) - do i=1,N_det - CI_eigenvectors_dressed(i,j) = psi_coef(i,j) - enddo - enddo - logical :: converged - converged = .False. - call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,& - size(CI_eigenvectors_dressed,1), CI_electronic_energy_dressed,& - N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged) - - else if (diag_algorithm == "Lapack") then - - allocate (eigenvectors(size(H_matrix_dressed,1),N_det)) - allocate (eigenvalues(N_det)) - - call lapack_diag(eigenvalues,eigenvectors, & - H_matrix_dressed,size(H_matrix_dressed,1),N_det) - CI_electronic_energy_dressed(:) = 0.d0 - if (s2_eig) then - i_state = 0 - allocate (s2_eigvalues(N_det)) - allocate(index_good_state_array(N_det),good_state_array(N_det)) - good_state_array = .False. - - call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,& - N_det,size(eigenvectors,1)) - do j=1,N_det - ! Select at least n_states states with S^2 values closed to "expected_s2" - if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then - i_state +=1 - index_good_state_array(i_state) = j - good_state_array(j) = .True. - endif - if(i_state.eq.N_states) then - exit - endif + BEGIN_DOC + ! Eigenvectors/values of the CI matrix + END_DOC + implicit none + double precision :: ovrlp,u_dot_v + integer :: i_good_state + integer, allocatable :: index_good_state_array(:) + logical, allocatable :: good_state_array(:) + double precision, allocatable :: s2_values_tmp(:) + integer :: i_other_state + double precision, allocatable :: eigenvectors(:,:), eigenvectors_s2(:,:), eigenvalues(:) + integer :: i_state + double precision :: e_0 + integer :: i,j,k,mrcc_state + double precision, allocatable :: s2_eigvalues(:) + double precision, allocatable :: e_array(:) + integer, allocatable :: iorder(:) + logical :: converged + logical :: do_csf + + PROVIDE threshold_davidson nthreads_davidson + ! Guess values for the "N_states" states of the CI_eigenvectors_dressed + do j=1,min(N_states,N_det) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = psi_coef(i,j) + enddo + enddo + + do j=min(N_states,N_det)+1,N_states_diag + do i=1,N_det + CI_eigenvectors_dressed(i,j) = 0.d0 + enddo + enddo + + do_csf = s2_eig .and. only_expected_s2 .and. csf_based + + if (diag_algorithm == "Davidson") then + + do j=1,min(N_states,N_det) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = psi_coef(i,j) enddo - if(i_state .ne.0)then - ! Fill the first "i_state" states that have a correct S^2 value - do j = 1, i_state - do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,index_good_state_array(j)) - enddo - CI_electronic_energy_dressed(j) = eigenvalues(index_good_state_array(j)) - CI_eigenvectors_s2_dressed(j) = s2_eigvalues(index_good_state_array(j)) - enddo - i_other_state = 0 - do j = 1, N_det - if(good_state_array(j))cycle - i_other_state +=1 - if(i_state+i_other_state.gt.n_states_diag)then - exit - endif - do i=1,N_det - CI_eigenvectors_dressed(i,i_state+i_other_state) = eigenvectors(i,j) - enddo - CI_electronic_energy_dressed(i_state+i_other_state) = eigenvalues(j) - CI_eigenvectors_s2_dressed(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) - enddo - else - print*,'' - print*,'!!!!!!!! WARNING !!!!!!!!!' - print*,' Within the ',N_det,'determinants selected' - print*,' and the ',N_states_diag,'states requested' - print*,' We did not find any state with S^2 values close to ',expected_s2 - print*,' We will then set the first N_states eigenvectors of the H matrix' - print*,' as the CI_eigenvectors_dressed' - print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space' - print*,'' - do j=1,min(N_states_diag,N_det) - do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) - enddo - CI_electronic_energy_dressed(j) = eigenvalues(j) - CI_eigenvectors_s2_dressed(j) = s2_eigvalues(j) - enddo - endif - deallocate(index_good_state_array,good_state_array) - deallocate(s2_eigvalues) + enddo + converged = .False. + if (do_csf) then + call davidson_diag_H_csf(psi_det,CI_eigenvectors_dressed, & + size(CI_eigenvectors_dressed,1),CI_electronic_energy_dressed, & + N_det,N_csf,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged) else - call u_0_S2_u_0(CI_eigenvectors_s2_dressed,eigenvectors,N_det,psi_det,N_int,& - min(N_det,N_states_diag),size(eigenvectors,1)) - ! Select the "N_states_diag" states of lowest energy - do j=1,min(N_det,N_states_diag) - do i=1,N_det - CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) - enddo - CI_electronic_energy_dressed(j) = eigenvalues(j) - enddo + call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,& + size(CI_eigenvectors_dressed,1), CI_electronic_energy_dressed,& + N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged) endif - deallocate(eigenvectors,eigenvalues) - endif + + integer :: N_states_diag_save + N_states_diag_save = N_states_diag + do while (.not.converged) + double precision, allocatable :: CI_electronic_energy_tmp (:) + double precision, allocatable :: CI_eigenvectors_tmp (:,:) + double precision, allocatable :: CI_s2_tmp (:) + + N_states_diag *= 2 + TOUCH N_states_diag + + if (do_csf) then + + allocate (CI_electronic_energy_tmp (N_states_diag) ) + allocate (CI_eigenvectors_tmp (N_det,N_states_diag) ) + + CI_electronic_energy_tmp(1:N_states_diag_save) = CI_electronic_energy_dressed(1:N_states_diag_save) + CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = CI_eigenvectors_dressed(1:N_det,1:N_states_diag_save) + + call davidson_diag_H_csf(psi_det,CI_eigenvectors_tmp, & + size(CI_eigenvectors_tmp,1),CI_electronic_energy_tmp, & + N_det,N_csf,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged) + + CI_electronic_energy_dressed(1:N_states_diag_save) = CI_electronic_energy_tmp(1:N_states_diag_save) + CI_eigenvectors_dressed(1:N_det,1:N_states_diag_save) = CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) + + deallocate (CI_electronic_energy_tmp) + deallocate (CI_eigenvectors_tmp) + + else + + allocate (CI_electronic_energy_tmp (N_states_diag) ) + allocate (CI_eigenvectors_tmp (N_det,N_states_diag) ) + allocate (CI_s2_tmp (N_states_diag) ) + + CI_electronic_energy_tmp(1:N_states_diag_save) = CI_electronic_energy_dressed(1:N_states_diag_save) + CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = CI_eigenvectors_dressed(1:N_det,1:N_states_diag_save) + CI_s2_tmp(1:N_states_diag_save) = CI_eigenvectors_s2_dressed(1:N_states_diag_save) + + call davidson_diag_HS2(psi_det,CI_eigenvectors_tmp, CI_s2_tmp, & + size(CI_eigenvectors_tmp,1),CI_electronic_energy_tmp, & + N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1,converged) + + CI_electronic_energy_dressed(1:N_states_diag_save) = CI_electronic_energy_tmp(1:N_states_diag_save) + CI_eigenvectors_dressed(1:N_det,1:N_states_diag_save) = CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) + CI_eigenvectors_s2_dressed(1:N_states_diag_save) = CI_s2_tmp(1:N_states_diag_save) + + deallocate (CI_electronic_energy_tmp) + deallocate (CI_eigenvectors_tmp) + deallocate (CI_s2_tmp) + + endif + + enddo + if (N_states_diag > N_states_diag_save) then + N_states_diag = N_states_diag_save + TOUCH N_states_diag + endif + + else if (diag_algorithm == "Lapack") then + + print *, 'Diagonalization of H using Lapack' + allocate (eigenvectors(size(H_matrix_dressed,1),N_det)) + allocate (eigenvalues(N_det)) + + call lapack_diag(eigenvalues,eigenvectors, & + H_matrix_dressed,size(H_matrix_dressed,1),N_det) + CI_electronic_energy_dressed(:) = 0.d0 + if (s2_eig) then + i_state = 0 + allocate (s2_eigvalues(N_det)) + allocate(index_good_state_array(N_det),good_state_array(N_det)) + good_state_array = .False. + + call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,& + N_det,size(eigenvectors,1)) + do j=1,N_det + ! Select at least n_states states with S^2 values closed to "expected_s2" + if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then + i_state +=1 + index_good_state_array(i_state) = j + good_state_array(j) = .True. + endif + if(i_state.eq.N_states) then + exit + endif + enddo + if(i_state .ne.0)then + ! Fill the first "i_state" states that have a correct S^2 value + do j = 1, i_state + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,index_good_state_array(j)) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(index_good_state_array(j)) + CI_eigenvectors_s2_dressed(j) = s2_eigvalues(index_good_state_array(j)) + enddo + i_other_state = 0 + do j = 1, N_det + if(good_state_array(j))cycle + i_other_state +=1 + if(i_state+i_other_state.gt.n_states_diag)then + exit + endif + do i=1,N_det + CI_eigenvectors_dressed(i,i_state+i_other_state) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(i_state+i_other_state) = eigenvalues(j) + CI_eigenvectors_s2_dressed(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) + enddo + else + print*,'' + print*,'!!!!!!!! WARNING !!!!!!!!!' + print*,' Within the ',N_det,'determinants selected' + print*,' and the ',N_states_diag,'states requested' + print*,' We did not find any state with S^2 values close to ',expected_s2 + print*,' We will then set the first N_states eigenvectors of the H matrix' + print*,' as the CI_eigenvectors_dressed' + print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space' + print*,'' + do j=1,min(N_states_diag,N_det) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(j) + CI_eigenvectors_s2_dressed(j) = s2_eigvalues(j) + enddo + endif + deallocate(index_good_state_array,good_state_array) + deallocate(s2_eigvalues) + else + call u_0_S2_u_0(CI_eigenvectors_s2_dressed,eigenvectors,N_det,psi_det,N_int,& + min(N_det,N_states_diag),size(eigenvectors,1)) + ! Select the "N_states_diag" states of lowest energy + do j=1,min(N_det,N_states_diag) + do i=1,N_det + CI_eigenvectors_dressed(i,j) = eigenvectors(i,j) + enddo + CI_electronic_energy_dressed(j) = eigenvalues(j) + enddo + endif + deallocate(eigenvectors,eigenvalues) + endif END_PROVIDER From dc42b639aff512c1fdab2e40e301bb864ef1737b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 28 Jan 2022 20:50:10 +0100 Subject: [PATCH 53/86] Minor changes --- bin/qp_plugins | 5 ++++- etc/qp.rc | 3 +++ scripts/module/module_handler.py | 1 + src/csf/conversion.irp.f | 21 ++++++++++++++++++++- src/csf/sigma_vector.irp.f | 4 ++-- src/determinants/spindeterminants.irp.f | 2 +- 6 files changed, 31 insertions(+), 5 deletions(-) diff --git a/bin/qp_plugins b/bin/qp_plugins index ef0f5a45..c9158422 100755 --- a/bin/qp_plugins +++ b/bin/qp_plugins @@ -6,6 +6,7 @@ Usage: qp_plugins download [-n ] qp_plugins install ... qp_plugins uninstall + qp_plugins remove qp_plugins update [-r ] qp_plugins create -n [-r ] [...] @@ -24,6 +25,8 @@ Options: uninstall Uninstall a plugin + remove Uninstall a plugin + update Update the repository create @@ -274,7 +277,7 @@ def main(arguments): subprocess.check_call(["qp_create_ninja", "update"]) print("[ OK ]") - elif arguments["uninstall"]: + elif arguments["uninstall"] or arguments["remove"]: m_instance = ModuleHandler([QP_SRC]) d_descendant = m_instance.dict_descendant diff --git a/etc/qp.rc b/etc/qp.rc index 7661aadf..c56661c7 100644 --- a/etc/qp.rc +++ b/etc/qp.rc @@ -204,6 +204,9 @@ _qp_Complete() uninstall) COMPREPLY=( $(compgen -W "$(qp_plugins list -i)" -- $cur ) ) return 0;; + remove) + COMPREPLY=( $(compgen -W "$(qp_plugins list -i)" -- $cur ) ) + return 0;; create) COMPREPLY=( $(compgen -W "-n " -- $cur ) ) return 0;; diff --git a/scripts/module/module_handler.py b/scripts/module/module_handler.py index d66918e2..6dd74f34 100755 --- a/scripts/module/module_handler.py +++ b/scripts/module/module_handler.py @@ -116,6 +116,7 @@ def get_l_module_descendant(d_child, l_module): print("Error: ", file=sys.stderr) print("`{0}` is not a submodule".format(module), file=sys.stderr) print("Check the typo (spelling, case, '/', etc.) ", file=sys.stderr) +# pass sys.exit(1) return list(set(l)) diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index c8bc9199..b52b766d 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -38,6 +38,8 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) integer s, bfIcfg integer countcsf + integer MS + MS = elec_alpha_num-elec_beta_num countcsf = 0 phasedet = 1.0d0 do i = 1,N_configuration @@ -61,7 +63,24 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) if (psi_configuration(k,1,i) == 0_bit_kind) cycle s = s + popcnt(psi_configuration(k,1,i)) enddo - bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) + + ! Test 1 +! if(iand(MS,1) .EQ. 0) then +! bfIcfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1)))) +! else +! bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) +! endif + +! Test 2 +! double precision :: binom1, binom2 +! double precision, external :: logabsgamma +! binom1 = dexp(logabsgamma(1.0d0*(s+1)) & +! - logabsgamma(1.0d0*(((s+1)/2)+1)) & +! - logabsgamma(1.0d0*(s-(((s+1)/2))+1))); +! binom2 = dexp(logabsgamma(1.0d0*(s+1)) & +! - logabsgamma(1.0d0*((((s+3)/2)+1)+1)) & +! - logabsgamma(1.0d0*(s-(((s+3)/2)+1)+1))); +! bfIcfg = max(1,nint(binom1 - binom2)) ! perhaps blocking with CFGs of same seniority ! can be more efficient diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 0d24ae57..7286e91e 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -65,7 +65,7 @@ dimcsfpercfg = 2 else if(iand(MS,1) .EQ. 0) then - !dimcsfpercfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1)))) +! dimcsfpercfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1)))) binom1 = dexp(logabsgamma(1.0d0*(i+1)) & - logabsgamma(1.0d0*((i/2)+1)) & - logabsgamma(1.0d0*(i-((i/2))+1))); @@ -74,7 +74,7 @@ - logabsgamma(1.0d0*(i-((i/2)+1)+1))); dimcsfpercfg = max(1,nint(binom1 - binom2)) else - !dimcsfpercfg = max(1,nint((binom(i,(i+1)/2)-binom(i,(i+3)/2)))) +! dimcsfpercfg = max(1,nint((binom(i,(i+1)/2)-binom(i,(i+3)/2)))) binom1 = dexp(logabsgamma(1.0d0*(i+1)) & - logabsgamma(1.0d0*(((i+1)/2)+1)) & - logabsgamma(1.0d0*(i-(((i+1)/2))+1))); diff --git a/src/determinants/spindeterminants.irp.f b/src/determinants/spindeterminants.irp.f index dea4a566..dd55e112 100644 --- a/src/determinants/spindeterminants.irp.f +++ b/src/determinants/spindeterminants.irp.f @@ -585,7 +585,7 @@ END_PROVIDER enddo !$OMP ENDDO !$OMP END PARALLEL - call i8radix_sort(to_sort, psi_bilinear_matrix_transp_order, N_det,-1) + call i8sort(to_sort, psi_bilinear_matrix_transp_order, N_det) call iset_order(psi_bilinear_matrix_transp_rows,psi_bilinear_matrix_transp_order,N_det) call iset_order(psi_bilinear_matrix_transp_columns,psi_bilinear_matrix_transp_order,N_det) !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l) From d428b721b230c7933dde1e055d48f5fb1e722424 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 4 Feb 2022 11:09:33 +0100 Subject: [PATCH 54/86] FIxed bug in CSF --- .../grid_becke_vector.irp.f | 14 +++++++++++++ src/csf/conversion.irp.f | 21 +++++-------------- src/csf/sigma_vector.irp.f | 18 ++-------------- src/davidson/diagonalize_ci.irp.f | 2 ++ src/utils/sort.irp.f | 6 ++++-- 5 files changed, 27 insertions(+), 34 deletions(-) diff --git a/src/becke_numerical_grid/grid_becke_vector.irp.f b/src/becke_numerical_grid/grid_becke_vector.irp.f index a72200f7..343bd054 100644 --- a/src/becke_numerical_grid/grid_becke_vector.irp.f +++ b/src/becke_numerical_grid/grid_becke_vector.irp.f @@ -58,3 +58,17 @@ END_PROVIDER enddo END_PROVIDER + +BEGIN_PROVIDER [double precision, final_grid_points_transp, (n_points_final_grid,3)] + implicit none + BEGIN_DOC +! Transposed final_grid_points + END_DOC + + integer :: i,j + do j=1,3 + do i=1,n_points_final_grid + final_grid_points_transp(i,j) = final_grid_points(j,i) + enddo + enddo +END_PROVIDER diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index b52b766d..9f7f4442 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -65,22 +65,11 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) enddo ! Test 1 -! if(iand(MS,1) .EQ. 0) then -! bfIcfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1)))) -! else -! bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) -! endif - -! Test 2 -! double precision :: binom1, binom2 -! double precision, external :: logabsgamma -! binom1 = dexp(logabsgamma(1.0d0*(s+1)) & -! - logabsgamma(1.0d0*(((s+1)/2)+1)) & -! - logabsgamma(1.0d0*(s-(((s+1)/2))+1))); -! binom2 = dexp(logabsgamma(1.0d0*(s+1)) & -! - logabsgamma(1.0d0*((((s+3)/2)+1)+1)) & -! - logabsgamma(1.0d0*(s-(((s+3)/2)+1)+1))); -! bfIcfg = max(1,nint(binom1 - binom2)) + if(iand(MS,1) .EQ. 0) then + bfIcfg = max(1,nint((binom(s,s/2)-binom(s,s/2+1)))) + else + bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) + endif ! perhaps blocking with CFGs of same seniority ! can be more efficient diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 7286e91e..4d409f50 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -65,23 +65,9 @@ dimcsfpercfg = 2 else if(iand(MS,1) .EQ. 0) then -! dimcsfpercfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1)))) - binom1 = dexp(logabsgamma(1.0d0*(i+1)) & - - logabsgamma(1.0d0*((i/2)+1)) & - - logabsgamma(1.0d0*(i-((i/2))+1))); - binom2 = dexp(logabsgamma(1.0d0*(i+1)) & - - logabsgamma(1.0d0*(((i/2)+1)+1)) & - - logabsgamma(1.0d0*(i-((i/2)+1)+1))); - dimcsfpercfg = max(1,nint(binom1 - binom2)) + dimcsfpercfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1)))) else -! dimcsfpercfg = max(1,nint((binom(i,(i+1)/2)-binom(i,(i+3)/2)))) - binom1 = dexp(logabsgamma(1.0d0*(i+1)) & - - logabsgamma(1.0d0*(((i+1)/2)+1)) & - - logabsgamma(1.0d0*(i-(((i+1)/2))+1))); - binom2 = dexp(logabsgamma(1.0d0*(i+1)) & - - logabsgamma(1.0d0*((((i+3)/2)+1)+1)) & - - logabsgamma(1.0d0*(i-(((i+3)/2)+1)+1))); - dimcsfpercfg = max(1,nint(binom1 - binom2)) + dimcsfpercfg = max(1,nint((binom(i,(i+1)/2)-binom(i,(i+3)/2)))) endif endif n_CSF += ncfg * dimcsfpercfg diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index 54e248cc..46ad8f78 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -3,6 +3,7 @@ BEGIN_PROVIDER [ double precision, CI_energy, (N_states_diag) ] BEGIN_DOC ! :c:data:`n_states` lowest eigenvalues of the |CI| matrix END_DOC + PROVIDE distributed_davidson integer :: j character*(8) :: st @@ -246,6 +247,7 @@ subroutine diagonalize_CI ! eigenstates of the |CI| matrix. END_DOC integer :: i,j + PROVIDE distributed_davidson do j=1,N_states do i=1,N_det psi_coef(i,j) = CI_eigenvectors(i,j) diff --git a/src/utils/sort.irp.f b/src/utils/sort.irp.f index a63eb4a3..ff40263c 100644 --- a/src/utils/sort.irp.f +++ b/src/utils/sort.irp.f @@ -356,7 +356,8 @@ BEGIN_TEMPLATE if ( isize < 32) then call insertion_$Xsort(x,iorder,isize) else - call $Xradix_sort(x,iorder,isize,-1) +! call $Xradix_sort(x,iorder,isize,-1) + call quick_$Xsort(x,iorder,isize) endif end subroutine $Xsort @@ -450,7 +451,8 @@ BEGIN_TEMPLATE if ( isize < 32) then call insertion_$Xsort(x,iorder,isize) else - call $Xradix_sort(x,iorder,isize,-1) +! call $Xradix_sort(x,iorder,isize,-1) + call quick_$Xsort(x,iorder,isize) endif end subroutine $Xsort From 27ef2ff39fb8fbb7948b7841e3c2937e9b967177 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 4 Feb 2022 15:01:08 +0100 Subject: [PATCH 55/86] Fix Davidson --- .../diagonalization_hcsf_dressed.irp.f | 23 ++++++------------- .../diagonalization_hs2_dressed.irp.f | 10 ++++---- 2 files changed, 12 insertions(+), 21 deletions(-) diff --git a/src/davidson/diagonalization_hcsf_dressed.irp.f b/src/davidson/diagonalization_hcsf_dressed.irp.f index b6f438a0..0c3c6f92 100644 --- a/src/davidson/diagonalization_hcsf_dressed.irp.f +++ b/src/davidson/diagonalization_hcsf_dressed.irp.f @@ -299,7 +299,7 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N shift = N_st_diag*(iter-1) shift2 = N_st_diag*iter - if ((iter > 1).or.(itertot == 1)) then +! if ((iter > 1).or.(itertot == 1)) then ! Compute |W_k> = \sum_i |i> ! ----------------------------------- @@ -309,10 +309,10 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N else call H_u_0_nstates_openmp(W,U,N_st_diag,sze) endif - else - ! Already computed in update below - continue - endif +! else +! ! Already computed in update below +! continue +! endif if (dressing_state > 0) then @@ -508,17 +508,8 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N enddo - ! Re-contract U and update W - ! -------------------------------- - - call dgemm('N','N', sze_csf, N_st_diag, shift2, 1.d0, & - W_csf, size(W_csf,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) - do k=1,N_st_diag - do i=1,sze_csf - W_csf(i,k) = u_in(i,k) - enddo - enddo - call convertWFfromCSFtoDET(N_st_diag,W_csf,W) + ! Re-contract U + ! ------------- call dgemm('N','N', sze_csf, N_st_diag, shift2, 1.d0, & U_csf, size(U_csf,1), y, size(y,1), 0.d0, u_in, size(u_in,1)) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 1a27a75e..d37b7386 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -349,7 +349,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ shift = N_st_diag*(iter-1) shift2 = N_st_diag*iter - if ((iter > 1).or.(itertot == 1)) then +! if ((iter > 1).or.(itertot == 1)) then ! Compute |W_k> = \sum_i |i> ! ----------------------------------- @@ -359,10 +359,10 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ call H_S2_u_0_nstates_openmp(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze) endif S(1:sze,shift+1:shift+N_st_diag) = real(S_d(1:sze,1:N_st_diag)) - else - ! Already computed in update below - continue - endif +! else +! ! Already computed in update below +! continue +! endif if (dressing_state > 0) then From 753399f40c329a8764a859bd8f5ae39fd6390fdb Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 7 Feb 2022 10:58:57 +0100 Subject: [PATCH 56/86] Fix CSF --- src/csf/conversion.irp.f | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index 9f7f4442..7d6a9ca8 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -63,13 +63,14 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) if (psi_configuration(k,1,i) == 0_bit_kind) cycle s = s + popcnt(psi_configuration(k,1,i)) enddo - - ! Test 1 - if(iand(MS,1) .EQ. 0) then - bfIcfg = max(1,nint((binom(s,s/2)-binom(s,s/2+1)))) - else bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) - endif + +! ! Test 1 +! if(iand(MS,1) .EQ. 0) then +! bfIcfg = max(1,nint((binom(s,s/2)-binom(s,s/2+1)))) +! else +! bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) +! endif ! perhaps blocking with CFGs of same seniority ! can be more efficient From 64d80fd2737b6995723b1583ca2ebfac16a59ec3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 7 Feb 2022 11:02:54 +0100 Subject: [PATCH 57/86] Fix CSF --- src/csf/conversion.irp.f | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index 7d6a9ca8..f6f12ba9 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -58,19 +58,19 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) enddo enddo - s = 0 + s = 0 ! s == total number of SOMOs do k=1,N_int if (psi_configuration(k,1,i) == 0_bit_kind) cycle s = s + popcnt(psi_configuration(k,1,i)) enddo - bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) -! ! Test 1 -! if(iand(MS,1) .EQ. 0) then -! bfIcfg = max(1,nint((binom(s,s/2)-binom(s,s/2+1)))) -! else -! bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) -! endif + bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) + + if(iand(s,1) .EQ. 0) then + bfIcfg = max(1,nint((binom(s,s/2)-binom(s,(s/2)+1)))) + else + bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) + endif ! perhaps blocking with CFGs of same seniority ! can be more efficient From 7770e4df588168f339dba89b5396e7a9e50a26ed Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 7 Feb 2022 23:34:09 +0100 Subject: [PATCH 58/86] Fixing CSF --- src/csf/conversion.irp.f | 10 +++++----- src/utils/set_multiple_levels_omp.irp.f | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index f6f12ba9..1ab5ccaa 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -66,11 +66,11 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) - if(iand(s,1) .EQ. 0) then - bfIcfg = max(1,nint((binom(s,s/2)-binom(s,(s/2)+1)))) - else - bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) - endif +! if(iand(s,1) .EQ. 0) then +! bfIcfg = max(1,nint((binom(s,s/2)-binom(s,(s/2)+1)))) +! else +! bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) +! endif ! perhaps blocking with CFGs of same seniority ! can be more efficient diff --git a/src/utils/set_multiple_levels_omp.irp.f b/src/utils/set_multiple_levels_omp.irp.f index b4764e4a..572a13f4 100644 --- a/src/utils/set_multiple_levels_omp.irp.f +++ b/src/utils/set_multiple_levels_omp.irp.f @@ -8,7 +8,7 @@ subroutine set_multiple_levels_omp(activate) logical, intent(in) :: activate if (activate) then - call omp_set_max_active_levels(5) + call omp_set_max_active_levels(3) IRP_IF SET_NESTED call omp_set_nested(.True.) From c6acad0b0a6665ae5820d8f966d7565ea59a2000 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Tue, 8 Feb 2022 00:01:08 +0100 Subject: [PATCH 59/86] Trying to fix csf. --- external/qp2-dependencies | 2 +- src/csf/conversion.irp.f | 12 +++++------- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/external/qp2-dependencies b/external/qp2-dependencies index bc856147..90ee61f5 160000 --- a/external/qp2-dependencies +++ b/external/qp2-dependencies @@ -1 +1 @@ -Subproject commit bc856147f6e626a6616b20344e5b8e3f30f44a92 +Subproject commit 90ee61f5041c7c94a0c605625a264860292813a0 diff --git a/src/csf/conversion.irp.f b/src/csf/conversion.irp.f index 1ab5ccaa..75f6e539 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -64,13 +64,11 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out) s = s + popcnt(psi_configuration(k,1,i)) enddo - bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) - -! if(iand(s,1) .EQ. 0) then -! bfIcfg = max(1,nint((binom(s,s/2)-binom(s,(s/2)+1)))) -! else -! bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) -! endif + if(iand(s,1) .EQ. 0) then + bfIcfg = max(1,nint((binom(s,s/2)-binom(s,(s/2)+1)))) + else + bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1)))) + endif ! perhaps blocking with CFGs of same seniority ! can be more efficient From 173ea9eab1c461b38ac50b6efc1ff715645b805a Mon Sep 17 00:00:00 2001 From: Emmanuel Giner Date: Tue, 15 Feb 2022 11:02:39 +0100 Subject: [PATCH 60/86] minor modifs in print_wf.irp.f --- src/tools/print_wf.irp.f | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/tools/print_wf.irp.f b/src/tools/print_wf.irp.f index 7e51caaf..64eb1a1f 100644 --- a/src/tools/print_wf.irp.f +++ b/src/tools/print_wf.irp.f @@ -32,8 +32,9 @@ subroutine routine double precision :: norm_mono_a,norm_mono_b double precision :: norm_mono_a_2,norm_mono_b_2 double precision :: norm_mono_a_pert_2,norm_mono_b_pert_2 - double precision :: norm_mono_a_pert,norm_mono_b_pert + double precision :: norm_mono_a_pert,norm_mono_b_pert,norm_double_1 double precision :: delta_e,coef_2_2 + norm_mono_a = 0.d0 norm_mono_b = 0.d0 norm_mono_a_2 = 0.d0 @@ -42,6 +43,7 @@ subroutine routine norm_mono_b_pert = 0.d0 norm_mono_a_pert_2 = 0.d0 norm_mono_b_pert_2 = 0.d0 + norm_double_1 = 0.d0 do i = 1, min(N_det_print_wf,N_det) print*,'' print*,'i = ',i @@ -93,6 +95,7 @@ subroutine routine print*,'h1,p1 = ',h1,p1 print*,'s2',s2 print*,'h2,p2 = ',h2,p2 + norm_double_1 += dabs(psi_coef_sorted(i,1)/psi_coef_sorted(1,1)) endif print*,' = ',hij @@ -109,6 +112,7 @@ subroutine routine print*,'' print*,'L1 norm of mono alpha = ',norm_mono_a print*,'L1 norm of mono beta = ',norm_mono_b + print*,'L1 norm of double exc = ',norm_double_1 print*, '---' print*,'L2 norm of mono alpha = ',norm_mono_a_2 print*,'L2 norm of mono beta = ',norm_mono_b_2 From 39c00dd990b359dd3b17d7048a1b03633bd87d14 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 5 Mar 2022 15:31:16 +0100 Subject: [PATCH 61/86] Better sorting in spindeterminants --- external/qp2-dependencies | 2 +- src/determinants/spindeterminants.irp.f | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/external/qp2-dependencies b/external/qp2-dependencies index bc856147..90ee61f5 160000 --- a/external/qp2-dependencies +++ b/external/qp2-dependencies @@ -1 +1 @@ -Subproject commit bc856147f6e626a6616b20344e5b8e3f30f44a92 +Subproject commit 90ee61f5041c7c94a0c605625a264860292813a0 diff --git a/src/determinants/spindeterminants.irp.f b/src/determinants/spindeterminants.irp.f index dea4a566..dd55e112 100644 --- a/src/determinants/spindeterminants.irp.f +++ b/src/determinants/spindeterminants.irp.f @@ -585,7 +585,7 @@ END_PROVIDER enddo !$OMP ENDDO !$OMP END PARALLEL - call i8radix_sort(to_sort, psi_bilinear_matrix_transp_order, N_det,-1) + call i8sort(to_sort, psi_bilinear_matrix_transp_order, N_det) call iset_order(psi_bilinear_matrix_transp_rows,psi_bilinear_matrix_transp_order,N_det) call iset_order(psi_bilinear_matrix_transp_columns,psi_bilinear_matrix_transp_order,N_det) !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l) From 980b48d9061c9ac74cf11e95df166f3740124d65 Mon Sep 17 00:00:00 2001 From: eginer Date: Mon, 7 Mar 2022 16:36:35 +0100 Subject: [PATCH 62/86] added the possibility to unset frozen core orbitals --- bin/qp_set_frozen_core | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/bin/qp_set_frozen_core b/bin/qp_set_frozen_core index 879c71de..bc6f6834 100755 --- a/bin/qp_set_frozen_core +++ b/bin/qp_set_frozen_core @@ -7,12 +7,13 @@ setting all MOs as Active, except the n/2 first ones which are set as Core. If pseudo-potentials are used, all the MOs are set as Active. Usage: - qp_set_frozen_core [-q|--query] [(-l|-s|--large|--small)] EZFIO_DIR + qp_set_frozen_core [-q|--query] [(-l|-s|-u|--large|--small|--unset)] EZFIO_DIR Options: -q --query Prints in the standard output the number of frozen MOs -l --large Use a small core -s --small Use a large core + -u --unset Unset frozen core Default numbers of frozen electrons: @@ -88,7 +89,9 @@ def main(arguments): elif charge <= 54: n_frozen += 9 elif charge <= 86: n_frozen += 18 elif charge <= 118: n_frozen += 27 + elif arguments["--unset"]: + n_frozen = 0 else: # default for charge in ezfio.nuclei_nucl_charge: if charge <= 4: pass From cef2ab8a91effadc642f08f80807802a9a90152f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Mar 2022 11:24:17 +0100 Subject: [PATCH 63/86] Accelerated PT2 --- external/qp2-dependencies | 2 +- src/cipsi/run_pt2_slave.irp.f | 8 ++++---- src/davidson/u0_hs2_u0.irp.f | 16 +++++++++------- 3 files changed, 14 insertions(+), 12 deletions(-) diff --git a/external/qp2-dependencies b/external/qp2-dependencies index 90ee61f5..bc856147 160000 --- a/external/qp2-dependencies +++ b/external/qp2-dependencies @@ -1 +1 @@ -Subproject commit 90ee61f5041c7c94a0c605625a264860292813a0 +Subproject commit bc856147f6e626a6616b20344e5b8e3f30f44a92 diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index f1001f89..731e40ac 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -31,11 +31,11 @@ subroutine run_pt2_slave(thread,iproc,energy) double precision, intent(in) :: energy(N_states_diag) integer, intent(in) :: thread, iproc - if (N_det > 100000 ) then - call run_pt2_slave_large(thread,iproc,energy) - else +! if (N_det > 100000 ) then +! call run_pt2_slave_large(thread,iproc,energy) +! else call run_pt2_slave_small(thread,iproc,energy) - endif +! endif end subroutine run_pt2_slave_small(thread,iproc,energy) diff --git a/src/davidson/u0_hs2_u0.irp.f b/src/davidson/u0_hs2_u0.irp.f index 8f7bf06b..38fb56bd 100644 --- a/src/davidson/u0_hs2_u0.irp.f +++ b/src/davidson/u0_hs2_u0.irp.f @@ -203,7 +203,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_t,s_t,u_t,N_st,sze,istart,iend, integer, allocatable :: doubles(:) integer, allocatable :: singles_a(:) integer, allocatable :: singles_b(:) - integer, allocatable :: idx(:), idx0(:) + integer, allocatable :: idx(:), buffer_lrow(:), idx0(:) integer :: maxab, n_singles_a, n_singles_b, kcol_prev integer*8 :: k8 logical :: compute_singles @@ -253,7 +253,7 @@ compute_singles=.True. !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, & !$OMP lcol, lrow, l_a, l_b, utl, kk, u_is_sparse, & !$OMP buffer, doubles, n_doubles, umax, & - !$OMP tmp_det2, hij, sij, idx, l, kcol_prev, & + !$OMP tmp_det2, hij, sij, idx, buffer_lrow, l, kcol_prev, & !$OMP singles_a, n_singles_a, singles_b, ratio, & !$OMP n_singles_b, k8, last_found,left,right,right_max) @@ -264,7 +264,7 @@ compute_singles=.True. singles_a(maxab), & singles_b(maxab), & doubles(maxab), & - idx(maxab), utl(N_st,block_size)) + idx(maxab), buffer_lrow(maxab), utl(N_st,block_size)) kcol_prev=-1 @@ -332,18 +332,20 @@ compute_singles=.True. l_a = psi_bilinear_matrix_columns_loc(lcol) ASSERT (l_a <= N_det) - !DIR$ UNROLL(8) - !DIR$ LOOP COUNT avg(50000) do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol) lrow = psi_bilinear_matrix_rows(l_a) ASSERT (lrow <= N_det_alpha_unique) - buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow) ! hot spot + buffer_lrow(j) = lrow ASSERT (l_a <= N_det) idx(j) = l_a l_a = l_a+1 enddo + + do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol) + buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, buffer_lrow(j)) ! hot spot + enddo j = j-1 call get_all_spin_singles_$N_int( & @@ -789,7 +791,7 @@ compute_singles=.True. end do !$OMP END DO - deallocate(buffer, singles_a, singles_b, doubles, idx, utl) + deallocate(buffer, singles_a, singles_b, doubles, idx, buffer_lrow, utl) !$OMP END PARALLEL end From 6b118362df31a7ed647274d2864e737b171bcef2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Mar 2022 23:30:13 +0100 Subject: [PATCH 64/86] Accelerating PT2 again --- src/cipsi/run_pt2_slave.irp.f | 57 +++++++++++++++++++++-------------- 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index 731e40ac..f9171a42 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -31,11 +31,11 @@ subroutine run_pt2_slave(thread,iproc,energy) double precision, intent(in) :: energy(N_states_diag) integer, intent(in) :: thread, iproc -! if (N_det > 100000 ) then -! call run_pt2_slave_large(thread,iproc,energy) -! else + if (N_det > 100000 ) then + call run_pt2_slave_large(thread,iproc,energy) + else call run_pt2_slave_small(thread,iproc,energy) -! endif + endif end subroutine run_pt2_slave_small(thread,iproc,energy) @@ -116,10 +116,10 @@ subroutine run_pt2_slave_small(thread,iproc,energy) do k=1,n_tasks call pt2_alloc(pt2_data(k),N_states) b%cur = 0 - double precision :: time2 - call wall_time(time2) +! double precision :: time2 +! call wall_time(time2) call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k))) - call wall_time(time1) +! call wall_time(time1) ! print *, i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1)) enddo call wall_time(time1) @@ -172,8 +172,8 @@ subroutine run_pt2_slave_large(thread,iproc,energy) integer :: rc, i integer :: worker_id, ctask, ltask - character*(512) :: task - integer :: task_id(1) + character*(512), allocatable :: task(:) + integer, allocatable :: task_id(:) integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket @@ -184,15 +184,16 @@ subroutine run_pt2_slave_large(thread,iproc,energy) type(selection_buffer) :: b logical :: done, buffer_ready - type(pt2_type) :: pt2_data + type(pt2_type), allocatable :: pt2_data(:) integer :: n_tasks, k, N - integer :: i_generator, subset - + integer, allocatable :: i_generator(:), subset(:) integer :: bsize ! Size of selection buffers logical :: sending PROVIDE global_selection_buffer global_selection_buffer_lock + allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max)) + allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max)) zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() integer, external :: connect_to_taskserver @@ -211,6 +212,9 @@ subroutine run_pt2_slave_large(thread,iproc,energy) done = .False. do while (.not.done) + n_tasks = max(1,n_tasks) + n_tasks = min(pt2_n_tasks_max,n_tasks) + integer, external :: get_tasks_from_taskserver if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then exit @@ -221,11 +225,9 @@ subroutine run_pt2_slave_large(thread,iproc,energy) endif if (n_tasks == 0) exit - call sscanf_ddd(task, subset, i_generator, N) - if( pt2_F(i_generator) <= 0 .or. pt2_F(i_generator) > N_det ) then - print *, irp_here - stop 'bug in selection' - endif + do k=1,n_tasks + call sscanf_ddd(task(k), subset(k), i_generator(k), N) + enddo if (b%N == 0) then ! Only first time bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2) @@ -235,9 +237,14 @@ subroutine run_pt2_slave_large(thread,iproc,energy) ASSERT (b%N == bsize) endif - call pt2_alloc(pt2_data,N_states) - b%cur = 0 - call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator)) + double precision :: time0, time1 + call wall_time(time0) + do k=1,n_tasks + call pt2_alloc(pt2_data(k),N_states) + b%cur = 0 + call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k))) + enddo + call wall_time(time1) integer, external :: tasks_done_to_taskserver if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then @@ -249,7 +256,7 @@ subroutine run_pt2_slave_large(thread,iproc,energy) call merge_selection_buffers(b,global_selection_buffer) b%cur=0 call omp_unset_lock(global_selection_buffer_lock) - if ( iproc == 1 .or. i_generator < 100 .or. done) then + if ( iproc == 1 .or. i_generator(1) < 100 .or. done) then call omp_set_lock(global_selection_buffer_lock) call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) @@ -260,7 +267,13 @@ subroutine run_pt2_slave_large(thread,iproc,energy) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) endif - call pt2_dealloc(pt2_data) + do k=1,n_tasks + call pt2_dealloc(pt2_data(k)) + enddo + b%cur=0 +! ! Try to adjust n_tasks at least 5 seconds per task + n_tasks = min(2*n_tasks,int( dble(5*n_tasks) / (time1 - time0 + 1.d0))) + n_tasks = min(n_tasks, pt2_n_tasks_max) end do call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) From 0c8f5e5f0b8537a3aa01e692ba21cbbd07509a42 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Mar 2022 23:43:29 +0100 Subject: [PATCH 65/86] Accelerating PT2 again --- src/cipsi/run_pt2_slave.irp.f | 43 ++++++++++++----------------------- 1 file changed, 15 insertions(+), 28 deletions(-) diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index f9171a42..083865f3 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -172,8 +172,8 @@ subroutine run_pt2_slave_large(thread,iproc,energy) integer :: rc, i integer :: worker_id, ctask, ltask - character*(512), allocatable :: task(:) - integer, allocatable :: task_id(:) + character*(512) :: task + integer :: task_id(1) integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket integer(ZMQ_PTR) :: zmq_to_qp_run_socket @@ -184,16 +184,15 @@ subroutine run_pt2_slave_large(thread,iproc,energy) type(selection_buffer) :: b logical :: done, buffer_ready - type(pt2_type), allocatable :: pt2_data(:) + type(pt2_type) :: pt2_data integer :: n_tasks, k, N - integer, allocatable :: i_generator(:), subset(:) + integer :: i_generator, subset + integer :: bsize ! Size of selection buffers logical :: sending PROVIDE global_selection_buffer global_selection_buffer_lock - allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max)) - allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max)) zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() integer, external :: connect_to_taskserver @@ -212,9 +211,6 @@ subroutine run_pt2_slave_large(thread,iproc,energy) done = .False. do while (.not.done) - n_tasks = max(1,n_tasks) - n_tasks = min(pt2_n_tasks_max,n_tasks) - integer, external :: get_tasks_from_taskserver if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then exit @@ -225,9 +221,11 @@ subroutine run_pt2_slave_large(thread,iproc,energy) endif if (n_tasks == 0) exit - do k=1,n_tasks - call sscanf_ddd(task(k), subset(k), i_generator(k), N) - enddo + call sscanf_ddd(task, subset, i_generator, N) + if( pt2_F(i_generator) <= 0 .or. pt2_F(i_generator) > N_det ) then + print *, irp_here + stop 'bug in selection' + endif if (b%N == 0) then ! Only first time bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2) @@ -237,14 +235,9 @@ subroutine run_pt2_slave_large(thread,iproc,energy) ASSERT (b%N == bsize) endif - double precision :: time0, time1 - call wall_time(time0) - do k=1,n_tasks - call pt2_alloc(pt2_data(k),N_states) - b%cur = 0 - call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k))) - enddo - call wall_time(time1) + call pt2_alloc(pt2_data,N_states) + b%cur = 0 + call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator)) integer, external :: tasks_done_to_taskserver if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then @@ -256,7 +249,7 @@ subroutine run_pt2_slave_large(thread,iproc,energy) call merge_selection_buffers(b,global_selection_buffer) b%cur=0 call omp_unset_lock(global_selection_buffer_lock) - if ( iproc == 1 .or. i_generator(1) < 100 .or. done) then + if ( iproc == 1 .or. i_generator < 100 .or. done) then call omp_set_lock(global_selection_buffer_lock) call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) @@ -267,13 +260,7 @@ subroutine run_pt2_slave_large(thread,iproc,energy) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) endif - do k=1,n_tasks - call pt2_dealloc(pt2_data(k)) - enddo - b%cur=0 -! ! Try to adjust n_tasks at least 5 seconds per task - n_tasks = min(2*n_tasks,int( dble(5*n_tasks) / (time1 - time0 + 1.d0))) - n_tasks = min(n_tasks, pt2_n_tasks_max) + call pt2_dealloc(pt2_data) end do call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) From 25c50aab59aebe83ed2ad2b110eb1e943526ba16 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 9 Mar 2022 10:23:27 +0100 Subject: [PATCH 66/86] Improving PT2 --- src/cipsi/pt2_stoch_routines.irp.f | 4 ++-- src/cipsi/run_pt2_slave.irp.f | 36 ++++++++++++++++++++---------- src/cipsi/selection.irp.f | 10 ++------- src/ezfio_files/output.irp.f | 2 +- src/utils/memory.irp.f | 2 +- 5 files changed, 30 insertions(+), 24 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 14b1d060..5019c957 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -291,7 +291,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) print '(A)', '========== ======================= ===================== ===================== ===========' - print '(A)', ' Samples Energy Variance Norm^2 Seconds' + print '(A)', ' Samples Energy Variance Norm^2 Seconds' print '(A)', '========== ======================= ===================== ===================== ===========' PROVIDE global_selection_buffer @@ -537,7 +537,7 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_ if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then time1 = time - print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.4)', c, & + print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.1)', c, & pt2_data % pt2(pt2_stoch_istate) +E, & pt2_data_err % pt2(pt2_stoch_istate), & pt2_data % variance(pt2_stoch_istate), & diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index 083865f3..a8215a98 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -190,8 +190,12 @@ subroutine run_pt2_slave_large(thread,iproc,energy) integer :: bsize ! Size of selection buffers logical :: sending + double precision :: time_shift + PROVIDE global_selection_buffer global_selection_buffer_lock + call random_number(time_shift) + time_shift = time_shift*15.d0 zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() @@ -209,6 +213,9 @@ subroutine run_pt2_slave_large(thread,iproc,energy) sending = .False. done = .False. + double precision :: time0, time1 + call wall_time(time0) + time0 = time0+time_shift do while (.not.done) integer, external :: get_tasks_from_taskserver @@ -244,20 +251,25 @@ subroutine run_pt2_slave_large(thread,iproc,energy) done = .true. endif call sort_selection_buffer(b) - call omp_set_lock(global_selection_buffer_lock) - global_selection_buffer%mini = b%mini - call merge_selection_buffers(b,global_selection_buffer) - b%cur=0 - call omp_unset_lock(global_selection_buffer_lock) - if ( iproc == 1 .or. i_generator < 100 .or. done) then + + call wall_time(time1) + if (time1-time0 > 15.d0) then call omp_set_lock(global_selection_buffer_lock) - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) - call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) - global_selection_buffer%cur = 0 + global_selection_buffer%mini = b%mini + call merge_selection_buffers(b,global_selection_buffer) + b%cur=0 call omp_unset_lock(global_selection_buffer_lock) - else - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) - call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) + call wall_time(time0) + if ( iproc == 1 .or. i_generator < 100 .or. done) then + call omp_set_lock(global_selection_buffer_lock) + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) + call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) + global_selection_buffer%cur = 0 + call omp_unset_lock(global_selection_buffer_lock) + else + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) + call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) + endif endif call pt2_dealloc(pt2_data) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index f1ec6ff6..acb91fb5 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -474,17 +474,11 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d ! endif do i=1,fullinteresting(0) - do k=1,N_int - fullminilist(k,1,i) = psi_det_sorted(k,1,fullinteresting(i)) - fullminilist(k,2,i) = psi_det_sorted(k,2,fullinteresting(i)) - enddo + fullminilist(:,:,i) = psi_det_sorted(:,:,fullinteresting(i)) enddo do i=1,interesting(0) - do k=1,N_int - minilist(k,1,i) = psi_det_sorted(k,1,interesting(i)) - minilist(k,2,i) = psi_det_sorted(k,2,interesting(i)) - enddo + minilist(:,:,i) = psi_det_sorted(:,:,interesting(i)) enddo do s2=s1,2 diff --git a/src/ezfio_files/output.irp.f b/src/ezfio_files/output.irp.f index 48512f92..7b2663a0 100644 --- a/src/ezfio_files/output.irp.f +++ b/src/ezfio_files/output.irp.f @@ -25,7 +25,7 @@ subroutine write_time(iunit) ct = ct - output_cpu_time_0 call wall_time(wt) wt = wt - output_wall_time_0 - write(6,'(A,F14.6,A,F14.6,A)') & + write(6,'(A,F14.2,A,F14.2,A)') & '.. >>>>> [ WALL TIME: ', wt, ' s ] [ CPU TIME: ', ct, ' s ] <<<<< ..' write(6,*) end diff --git a/src/utils/memory.irp.f b/src/utils/memory.irp.f index 3ea242b0..d5a066a1 100644 --- a/src/utils/memory.irp.f +++ b/src/utils/memory.irp.f @@ -114,7 +114,7 @@ subroutine print_memory_usage() call resident_memory(rss) call total_memory(mem) - write(*,'(A,F14.6,A,F14.6,A)') & + write(*,'(A,F14.3,A,F14.3,A)') & '.. >>>>> [ RES MEM : ', rss , & ' GB ] [ VIRT MEM : ', mem, ' GB ] <<<<< ..' end From 416ff24ff44cbb7dd5fabea1c3415ea720432146 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 9 Mar 2022 10:40:30 +0100 Subject: [PATCH 67/86] Fixed previous commit --- src/cipsi/run_pt2_slave.irp.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index a8215a98..9e046877 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -266,10 +266,10 @@ subroutine run_pt2_slave_large(thread,iproc,energy) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) global_selection_buffer%cur = 0 call omp_unset_lock(global_selection_buffer_lock) - else - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) - call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) endif + else + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) + call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) endif call pt2_dealloc(pt2_data) From 27dc0c06aea0ae63ed55621106df40353201e3a2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 10 Mar 2022 00:55:23 +0100 Subject: [PATCH 68/86] Optimize PT2 --- src/cipsi/run_pt2_slave.irp.f | 18 ++++---- src/cipsi/selection_buffer.irp.f | 71 +++++++++++++++++++------------- 2 files changed, 51 insertions(+), 38 deletions(-) diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index 9e046877..30fc7ce0 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -253,22 +253,22 @@ subroutine run_pt2_slave_large(thread,iproc,energy) call sort_selection_buffer(b) call wall_time(time1) - if (time1-time0 > 15.d0) then +! if (time1-time0 > 15.d0) then call omp_set_lock(global_selection_buffer_lock) global_selection_buffer%mini = b%mini call merge_selection_buffers(b,global_selection_buffer) b%cur=0 call omp_unset_lock(global_selection_buffer_lock) call wall_time(time0) - if ( iproc == 1 .or. i_generator < 100 .or. done) then - call omp_set_lock(global_selection_buffer_lock) - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) - call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) - global_selection_buffer%cur = 0 - call omp_unset_lock(global_selection_buffer_lock) - endif +! endif + + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) + if ( iproc == 1 .or. i_generator < 100 .or. done) then + call omp_set_lock(global_selection_buffer_lock) + call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) + global_selection_buffer%cur = 0 + call omp_unset_lock(global_selection_buffer_lock) else - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) endif diff --git a/src/cipsi/selection_buffer.irp.f b/src/cipsi/selection_buffer.irp.f index 79899139..1f743e0e 100644 --- a/src/cipsi/selection_buffer.irp.f +++ b/src/cipsi/selection_buffer.irp.f @@ -92,38 +92,51 @@ subroutine merge_selection_buffers(b1, b2) allocate(val(sze), detmp(N_int, 2, sze)) i1=1 i2=1 - do i=1,nmwen - if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then - exit - else if (i1 > b1%cur) then - val(i) = b2%val(i2) - detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2) - detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2) - i2=i2+1 - else if (i2 > b2%cur) then - val(i) = b1%val(i1) - detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1) - detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1) - i1=i1+1 - else - if (b1%val(i1) <= b2%val(i2)) then - val(i) = b1%val(i1) - detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1) - detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1) - i1=i1+1 + + select case (N_int) +BEGIN_TEMPLATE + case $case + do i=1,nmwen + if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then + exit + else if (i1 > b1%cur) then + val(i) = b2%val(i2) + detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2) + detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2) + i2=i2+1 + else if (i2 > b2%cur) then + val(i) = b1%val(i1) + detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1) + detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1) + i1=i1+1 else - val(i) = b2%val(i2) - detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2) - detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2) - i2=i2+1 + if (b1%val(i1) <= b2%val(i2)) then + val(i) = b1%val(i1) + detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1) + detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1) + i1=i1+1 + else + val(i) = b2%val(i2) + detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2) + detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2) + i2=i2+1 + endif endif - endif - enddo + enddo + do i=nmwen+1,b2%N + val(i) = 0.d0 +! detmp(1:$N_int,1,i) = 0_bit_kind +! detmp(1:$N_int,2,i) = 0_bit_kind + enddo +SUBST [ case, N_int ] +(1); 1;; +(2); 2;; +(3); 3;; +(4); 4;; +default; N_int;; +END_TEMPLATE + end select deallocate(b2%det, b2%val) - do i=nmwen+1,b2%N - val(i) = 0.d0 - detmp(1:N_int,1:2,i) = 0_bit_kind - enddo b2%det => detmp b2%val => val b2%mini = min(b2%mini,b2%val(b2%N)) From 6b0162e22991717d21cab150b952b9fdb006d824 Mon Sep 17 00:00:00 2001 From: ydamour Date: Tue, 15 Mar 2022 16:25:21 +0100 Subject: [PATCH 69/86] dipole moments x,y,z --- src/determinants/dipole_moments.irp.f | 4 +++- src/tools/print_dipole.irp.f | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/determinants/dipole_moments.irp.f b/src/determinants/dipole_moments.irp.f index 8a5f1a2d..c3675e7d 100644 --- a/src/determinants/dipole_moments.irp.f +++ b/src/determinants/dipole_moments.irp.f @@ -55,11 +55,13 @@ END_PROVIDER - subroutine print_z_dipole_moment_only + subroutine print_dipole_moments implicit none print*, '' print*, '' print*, '****************************************' + print*, 'x_dipole_moment = ',x_dipole_moment + print*, 'y_dipole_moment = ',y_dipole_moment print*, 'z_dipole_moment = ',z_dipole_moment print*, '****************************************' end diff --git a/src/tools/print_dipole.irp.f b/src/tools/print_dipole.irp.f index 8351308e..1d095af9 100644 --- a/src/tools/print_dipole.irp.f +++ b/src/tools/print_dipole.irp.f @@ -1,5 +1,5 @@ program print_dipole implicit none - call print_z_dipole_moment_only + call print_dipole_moments end From cf96b74b52443e63d20c8d414315299ce26591ad Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 16 Mar 2022 10:26:18 +0100 Subject: [PATCH 70/86] Remove debug --- external/qp2-dependencies | 2 +- src/ao_basis/spherical_to_cartesian.irp.f | 2 +- src/determinants/dipole_moments.irp.f | 22 +++++++++++----------- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/external/qp2-dependencies b/external/qp2-dependencies index bc856147..90ee61f5 160000 --- a/external/qp2-dependencies +++ b/external/qp2-dependencies @@ -1 +1 @@ -Subproject commit bc856147f6e626a6616b20344e5b8e3f30f44a92 +Subproject commit 90ee61f5041c7c94a0c605625a264860292813a0 diff --git a/src/ao_basis/spherical_to_cartesian.irp.f b/src/ao_basis/spherical_to_cartesian.irp.f index 33a3bc89..336161f8 100644 --- a/src/ao_basis/spherical_to_cartesian.irp.f +++ b/src/ao_basis/spherical_to_cartesian.irp.f @@ -1,7 +1,7 @@ ! Spherical to cartesian transformation matrix obtained with ! Horton (http://theochem.github.com/horton/, 2015) -! First index is the index of the carteisan AO, obtained by ao_power_index +! First index is the index of the cartesian AO, obtained by ao_power_index ! Second index is the index of the spherical AO BEGIN_PROVIDER [ double precision, cart_to_sphe_0, (1,1) ] diff --git a/src/determinants/dipole_moments.irp.f b/src/determinants/dipole_moments.irp.f index 8a5f1a2d..733dd535 100644 --- a/src/determinants/dipole_moments.irp.f +++ b/src/determinants/dipole_moments.irp.f @@ -9,7 +9,7 @@ double precision :: weight, r(3) double precision :: cpu0,cpu1,nuclei_part_z,nuclei_part_y,nuclei_part_x - call cpu_time(cpu0) +! call cpu_time(cpu0) z_dipole_moment = 0.d0 y_dipole_moment = 0.d0 x_dipole_moment = 0.d0 @@ -26,10 +26,10 @@ enddo enddo - print*,'electron part for z_dipole = ',z_dipole_moment - print*,'electron part for y_dipole = ',y_dipole_moment - print*,'electron part for x_dipole = ',x_dipole_moment - +! print*,'electron part for z_dipole = ',z_dipole_moment +! print*,'electron part for y_dipole = ',y_dipole_moment +! print*,'electron part for x_dipole = ',x_dipole_moment +! nuclei_part_z = 0.d0 nuclei_part_y = 0.d0 nuclei_part_x = 0.d0 @@ -38,18 +38,18 @@ nuclei_part_y += nucl_charge(i) * nucl_coord(i,2) nuclei_part_x += nucl_charge(i) * nucl_coord(i,1) enddo - print*,'nuclei part for z_dipole = ',nuclei_part_z - print*,'nuclei part for y_dipole = ',nuclei_part_y - print*,'nuclei part for x_dipole = ',nuclei_part_x - +! print*,'nuclei part for z_dipole = ',nuclei_part_z +! print*,'nuclei part for y_dipole = ',nuclei_part_y +! print*,'nuclei part for x_dipole = ',nuclei_part_x +! do istate = 1, N_states z_dipole_moment(istate) += nuclei_part_z y_dipole_moment(istate) += nuclei_part_y x_dipole_moment(istate) += nuclei_part_x enddo - call cpu_time(cpu1) - print*,'Time to provide the dipole moment :',cpu1-cpu0 +! call cpu_time(cpu1) +! print*,'Time to provide the dipole moment :',cpu1-cpu0 END_PROVIDER From 7da10a66cfb6c6bba3913f669e3bd79b79fdcf3e Mon Sep 17 00:00:00 2001 From: ydamour Date: Wed, 16 Mar 2022 11:42:26 +0100 Subject: [PATCH 71/86] output print dipole for n_states >= 1 + read_wf true --- src/determinants/dipole_moments.irp.f | 15 ++++++++++++--- src/tools/print_dipole.irp.f | 2 ++ 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/src/determinants/dipole_moments.irp.f b/src/determinants/dipole_moments.irp.f index 932c1c51..06fca0cd 100644 --- a/src/determinants/dipole_moments.irp.f +++ b/src/determinants/dipole_moments.irp.f @@ -57,11 +57,20 @@ END_PROVIDER subroutine print_dipole_moments implicit none + integer :: i print*, '' print*, '' print*, '****************************************' - print*, 'x_dipole_moment = ',x_dipole_moment - print*, 'y_dipole_moment = ',y_dipole_moment - print*, 'z_dipole_moment = ',z_dipole_moment + write(*,'(A10)',advance='no') ' State : ' + do i = 1,N_states + write(*,'(i16)',advance='no') i + end do + write(*,*) '' + write(*,'(A17,100(1pE16.8))') 'x_dipole_moment = ',x_dipole_moment + write(*,'(A17,100(1pE16.8))') 'y_dipole_moment = ',y_dipole_moment + write(*,'(A17,100(1pE16.8))') 'z_dipole_moment = ',z_dipole_moment + !print*, 'x_dipole_moment = ',x_dipole_moment + !print*, 'y_dipole_moment = ',y_dipole_moment + !print*, 'z_dipole_moment = ',z_dipole_moment print*, '****************************************' end diff --git a/src/tools/print_dipole.irp.f b/src/tools/print_dipole.irp.f index 1d095af9..8db9aa09 100644 --- a/src/tools/print_dipole.irp.f +++ b/src/tools/print_dipole.irp.f @@ -1,5 +1,7 @@ program print_dipole implicit none + read_wf = .True. + TOUCH read_wf call print_dipole_moments end From 22b28fc77435dc74268a952a3c1e30e016601d66 Mon Sep 17 00:00:00 2001 From: ydamour Date: Tue, 22 Mar 2022 10:49:39 +0100 Subject: [PATCH 72/86] csf fix segfault --- src/csf/sigma_vector.irp.f | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 4d409f50..beb827ba 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -52,10 +52,15 @@ ncfgpersomo = cfg_seniority_index(i+2) else k = 0 - do while(cfg_seniority_index(i+2+k) < ncfgpersomo) - k = k + 2 - ncfgpersomo = cfg_seniority_index(i+2+k) - enddo + if ((i+2+k) < size(cfg_seniority_index,1)) then + do while(cfg_seniority_index(i+2+k) < ncfgpersomo) + k = k + 2 + if ((i+2+k) >= size(cfg_seniority_index,1)) then + exit + endif + ncfgpersomo = cfg_seniority_index(i+2+k) + enddo + endif endif endif ncfg = ncfgpersomo - ncfgprev @@ -75,10 +80,15 @@ ncfgprev = cfg_seniority_index(i+2) else k = 0 - do while(cfg_seniority_index(i+2+k) < ncfgprev) - k = k + 2 - ncfgprev = cfg_seniority_index(i+2+k) - enddo + if ((i+2+k) < size(cfg_seniority_index,1)) then + do while(cfg_seniority_index(i+2+k) < ncfgprev) + k = k + 2 + if ((i+2+k) >= size(cfg_seniority_index,1)) then + exit + endif + ncfgprev = cfg_seniority_index(i+2+k) + enddo + endif endif enddo END_PROVIDER From 8a759e6a943ae3604dc0d7636c4a2bf9da6af03c Mon Sep 17 00:00:00 2001 From: ydamour Date: Thu, 24 Mar 2022 16:14:31 +0100 Subject: [PATCH 73/86] csf remove do while loops --- src/csf/sigma_vector.irp.f | 58 +++++++++++++++++++++++++------------- 1 file changed, 38 insertions(+), 20 deletions(-) diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index beb827ba..026dd839 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -51,16 +51,24 @@ if(cfg_seniority_index(i+2) > ncfgpersomo) then ncfgpersomo = cfg_seniority_index(i+2) else - k = 0 - if ((i+2+k) < size(cfg_seniority_index,1)) then - do while(cfg_seniority_index(i+2+k) < ncfgpersomo) - k = k + 2 - if ((i+2+k) >= size(cfg_seniority_index,1)) then - exit - endif - ncfgpersomo = cfg_seniority_index(i+2+k) - enddo - endif + ! l = i+k+2 + ! Loop over l with a constraint to ensure that l <= size(cfg_seniority_index,1)-1 + ! Old version commented just below + do l = min(size(cfg_seniority_index,1)-1, i+2), size(cfg_seniority_index,1)-1, 2 + if (cfg_seniority_index(l) >= ncfgpersomo) then + ncfgpersomo = cfg_seniority_index(l) + endif + enddo + !k = 0 + !if ((i+2+k) < size(cfg_seniority_index,1)) then + ! do while(cfg_seniority_index(i+2+k) < ncfgpersomo) + ! k = k + 2 + ! if ((i+2+k) >= size(cfg_seniority_index,1)) then + ! exit + ! endif + ! ncfgpersomo = cfg_seniority_index(i+2+k) + ! enddo + !endif endif endif ncfg = ncfgpersomo - ncfgprev @@ -79,16 +87,26 @@ if(cfg_seniority_index(i+2) > ncfgprev) then ncfgprev = cfg_seniority_index(i+2) else - k = 0 - if ((i+2+k) < size(cfg_seniority_index,1)) then - do while(cfg_seniority_index(i+2+k) < ncfgprev) - k = k + 2 - if ((i+2+k) >= size(cfg_seniority_index,1)) then - exit - endif - ncfgprev = cfg_seniority_index(i+2+k) - enddo - endif + ! l = i+k+2 + ! Loop over l with a constraint to ensure that l <= size(cfg_seniority_index,1)-1 + ! Old version commented just below + do l = min(size(cfg_seniority_index,1)-1, i+2), size(cfg_seniority_index,1)-1, 2 + print*,'l' + if (cfg_seniority_index(l) >= ncfgprev) then + ncfgprev = cfg_seniority_index(l) + endif + print*,'ncfgprev', ncfgprev + enddo + !k = 0 + !if ((i+2+k) < size(cfg_seniority_index,1)) then + ! do while(cfg_seniority_index(i+2+k) < ncfgprev) + ! k = k + 2 + ! if ((i+2+k) >= size(cfg_seniority_index,1)) then + ! exit + ! endif + ! ncfgprev = cfg_seniority_index(i+2+k) + ! enddo + !endif endif enddo END_PROVIDER From bda895104242464d927be55e4b6a8426e23975c0 Mon Sep 17 00:00:00 2001 From: ydamour Date: Thu, 24 Mar 2022 16:18:51 +0100 Subject: [PATCH 74/86] remove print --- src/csf/sigma_vector.irp.f | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 026dd839..5aaba9a3 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -91,11 +91,9 @@ ! Loop over l with a constraint to ensure that l <= size(cfg_seniority_index,1)-1 ! Old version commented just below do l = min(size(cfg_seniority_index,1)-1, i+2), size(cfg_seniority_index,1)-1, 2 - print*,'l' if (cfg_seniority_index(l) >= ncfgprev) then ncfgprev = cfg_seniority_index(l) endif - print*,'ncfgprev', ncfgprev enddo !k = 0 !if ((i+2+k) < size(cfg_seniority_index,1)) then From e63fa3fdd5f9c1770fccad32d93bdd045b7ccf6f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 25 Mar 2022 09:30:43 +0100 Subject: [PATCH 75/86] Fixed tooth_width=0.0 --- src/cipsi/pt2_stoch_routines.irp.f | 3 +-- src/cipsi/selection.irp.f | 2 +- src/dressing/alpha_factory.irp.f | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 5019c957..db0b1527 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -842,9 +842,8 @@ END_PROVIDER do t=1, pt2_N_teeth tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t)) if (tooth_width == 0.d0) then - tooth_width = sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1))) + tooth_width = max(1.d-15,sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1)))) endif - ASSERT(tooth_width > 0.d0) do i=pt2_n_0(t)+1, pt2_n_0(t+1) pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width end do diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index acb91fb5..d4d44c2d 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -1550,7 +1550,7 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) use bitmasks implicit none BEGIN_DOC - ! Gives the inidices(+1) of the bits set to 1 in the bit string + ! Gives the indices(+1) of the bits set to 1 in the bit string END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: string(Nint) diff --git a/src/dressing/alpha_factory.irp.f b/src/dressing/alpha_factory.irp.f index 5eeeb1a6..c7adffe3 100644 --- a/src/dressing/alpha_factory.irp.f +++ b/src/dressing/alpha_factory.irp.f @@ -1179,7 +1179,7 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) use bitmasks implicit none BEGIN_DOC - ! Gives the inidices(+1) of the bits set to 1 in the bit string + ! Gives the indices(+1) of the bits set to 1 in the bit string END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: string(Nint) From 1a890a78df6d90d73a633cccc1c0b9cc35e373be Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 25 Mar 2022 09:32:56 +0100 Subject: [PATCH 76/86] dsqrt --- src/cipsi/pt2_stoch_routines.irp.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index db0b1527..c7cee1ac 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -523,15 +523,15 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_ ! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969) if(c > 2) then eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = sqrt(eqt / (dble(c) - 1.5d0)) + eqt = dsqrt(eqt / (dble(c) - 1.5d0)) pt2_data_err % pt2(pt2_stoch_istate) = eqt eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = sqrt(eqt / (dble(c) - 1.5d0)) + eqt = dsqrt(eqt / (dble(c) - 1.5d0)) pt2_data_err % variance(pt2_stoch_istate) = eqt eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqta(:) = sqrt(eqta(:) / (dble(c) - 1.5d0)) + eqta(:) = dsqrt(eqta(:) / (dble(c) - 1.5d0)) pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:) From 511a80e062213a76d2bc7aa7cf7179c74786de24 Mon Sep 17 00:00:00 2001 From: ydamour Date: Mon, 28 Mar 2022 20:08:35 +0200 Subject: [PATCH 77/86] add excitation energies in eV --- src/cis/cis.irp.f | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/cis/cis.irp.f b/src/cis/cis.irp.f index ab2294ad..f72197c2 100644 --- a/src/cis/cis.irp.f +++ b/src/cis/cis.irp.f @@ -62,6 +62,7 @@ subroutine run else call H_apply_cis endif + print*,'' print *, 'N_det = ', N_det print*,'******************************' print *, 'Energies of the states:' @@ -69,11 +70,13 @@ subroutine run print *, i, CI_energy(i) enddo if (N_states > 1) then - print*,'******************************' - print*,'Excitation energies ' + print*,'' + print*,'******************************************************' + print*,'Excitation energies (au) (eV)' do i = 2, N_states - print*, i ,CI_energy(i) - CI_energy(1) + print*, i ,CI_energy(i) - CI_energy(1), (CI_energy(i) - CI_energy(1))/0.0367502d0 enddo + print*,'' endif call ezfio_set_cis_energy(CI_energy) From e3e403692195d04e2c1e15546d9eea738eab909e Mon Sep 17 00:00:00 2001 From: ydamour Date: Tue, 5 Apr 2022 16:12:47 +0200 Subject: [PATCH 78/86] Fix psi_det_size --- src/determinants/determinants.irp.f | 43 +++++++++++++++-------------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f index b8c8658f..eeadf779 100644 --- a/src/determinants/determinants.irp.f +++ b/src/determinants/determinants.irp.f @@ -77,28 +77,31 @@ BEGIN_PROVIDER [ integer, psi_det_size ] END_DOC PROVIDE ezfio_filename logical :: exists - if (mpi_master) then - call ezfio_has_determinants_n_det(exists) - if (exists) then - call ezfio_get_determinants_n_det(psi_det_size) - else - psi_det_size = 1 + psi_det_size = 1 + PROVIDE mpi_master + if (read_wf) then + if (mpi_master) then + call ezfio_has_determinants_n_det(exists) + if (exists) then + call ezfio_get_determinants_n_det(psi_det_size) + else + psi_det_size = 1 + endif + call write_int(6,psi_det_size,'Dimension of the psi arrays') endif - call write_int(6,psi_det_size,'Dimension of the psi arrays') + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST( psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read psi_det_size with MPI' + endif + IRP_ENDIF endif - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - IRP_IF MPI - include 'mpif.h' - integer :: ierr - call MPI_BCAST( psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read psi_det_size with MPI' - endif - IRP_ENDIF - END_PROVIDER From e6d08356577968e79a81faa56dbbca83a4d62855 Mon Sep 17 00:00:00 2001 From: ydamour Date: Fri, 8 Apr 2022 17:21:03 +0200 Subject: [PATCH 79/86] fix error pt2 from det already in the wf --- src/cipsi/selection.irp.f | 34 +++++++++++++++++++++++++++++----- 1 file changed, 29 insertions(+), 5 deletions(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index d4d44c2d..2d8d34d5 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -195,7 +195,10 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d integer :: l_a, nmax, idx integer, allocatable :: indices(:), exc_degree(:), iorder(:) - double precision, parameter :: norm_thr = 1.d-16 + + ! Removed to avoid introducing determinants already presents in the wf + !double precision, parameter :: norm_thr = 1.d-16 + allocate (indices(N_det), & exc_degree(max(N_det_alpha_unique,N_det_beta_unique))) @@ -215,10 +218,11 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d i = psi_bilinear_matrix_rows(l_a) if (nt + exc_degree(i) <= 4) then idx = psi_det_sorted_order(psi_bilinear_matrix_order(l_a)) - if (psi_average_norm_contrib_sorted(idx) > norm_thr) then + ! Removed to avoid introducing determinants already presents in the wf + !if (psi_average_norm_contrib_sorted(idx) > norm_thr) then indices(k) = idx k=k+1 - endif + !endif endif enddo enddo @@ -242,10 +246,11 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d idx = psi_det_sorted_order( & psi_bilinear_matrix_order( & psi_bilinear_matrix_transp_order(l_a))) - if (psi_average_norm_contrib_sorted(idx) > norm_thr) then + ! Removed to avoid introducing determinants already presents in the wf + !if (psi_average_norm_contrib_sorted(idx) > norm_thr) then indices(k) = idx k=k+1 - endif + !endif endif enddo enddo @@ -566,6 +571,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d double precision, external :: diag_H_mat_elem_fock double precision :: E_shift double precision :: s_weight(N_states,N_states) + logical, external :: is_in_wavefunction PROVIDE dominant_dets_of_cfgs N_dominant_dets_of_cfgs do jstate=1,N_states do istate=1,N_states @@ -830,6 +836,24 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d end select end do + ! To force the inclusion of determinants with a positive pt2 contribution + if (e_pert(istate) > 1d-8) then + w = -huge(1.0) + endif + +!!!BEGIN_DEBUG +! ! To check if the pt2 is taking determinants already in the wf +! if (is_in_wavefunction(det(N_int,1),N_int)) then +! print*, 'A determinant contributing to the pt2 is already in' +! print*, 'the wave function:' +! call print_det(det(N_int,1),N_int) +! print*,'contribution to the pt2 for the states:', e_pert(:) +! print*,'error in the filtering in' +! print*, 'cipsi/selection.irp.f sub: selecte_singles_and_doubles' +! print*, 'abort' +! call abort +! endif +!!!END_DEBUG integer(bit_kind) :: occ(N_int,2), n if (h0_type == 'CFG') then From 52c460367de1ba0e584d4668aca79fa9ec6549a1 Mon Sep 17 00:00:00 2001 From: ydamour Date: Mon, 11 Apr 2022 13:55:00 +0200 Subject: [PATCH 80/86] fix error pt2 --- src/cipsi/selection.irp.f | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 2d8d34d5..1317fcf3 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -834,12 +834,13 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d endif end select - end do - ! To force the inclusion of determinants with a positive pt2 contribution - if (e_pert(istate) > 1d-8) then - w = -huge(1.0) - endif + ! To force the inclusion of determinants with a positive pt2 contribution + if (e_pert(istate) > 1d-8) then + w = -huge(1.0) + endif + + end do !!!BEGIN_DEBUG ! ! To check if the pt2 is taking determinants already in the wf From 19185c06f4c39bbba3dd50d029f4acb8b52f1075 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 11 Apr 2022 23:55:17 +0200 Subject: [PATCH 81/86] Add cipsi_save.sh --- scripts/cipsi_save.sh | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 scripts/cipsi_save.sh diff --git a/scripts/cipsi_save.sh b/scripts/cipsi_save.sh new file mode 100644 index 00000000..a4d9b65e --- /dev/null +++ b/scripts/cipsi_save.sh @@ -0,0 +1,27 @@ +#!/bin/bash +# +# This script runs a CIPSI calculation as a sequence of single CIPSI iterations. +# After each iteration, the EZFIO directory is saved. +# +# Usage: cipsi_save [EZFIO_FILE] [NDET] +# +# Example: cipsi_save file.ezfio 10000 + +EZ=$1 +NDETMAX=$2 + +qp set_file ${EZ} +qp reset -d +qp set determinants read_wf true +declare -i NDET +NDET=1 +while [[ ${NDET} -lt ${NDETMAX} ]] +do + NDET=$(($NDET + $NDET)) + qp set determinants n_det_max $NDET + qp run fci > ${EZ}.out + NDET=$(qp get determinants n_det) + mv ${EZ}.out ${EZ}.${NDET}.out + cp -r ${EZ} ${EZ}.${NDET} +done + From 69138a2d25e5ed6e5924f6b9c28bc5846a86c06e Mon Sep 17 00:00:00 2001 From: kossoski Date: Wed, 13 Apr 2022 13:25:39 +0200 Subject: [PATCH 82/86] Hierarchy CI --- src/cipsi/EZFIO.cfg | 6 ++++++ src/cipsi/selection.irp.f | 19 +++++++++++++++++++ 2 files changed, 25 insertions(+) diff --git a/src/cipsi/EZFIO.cfg b/src/cipsi/EZFIO.cfg index 7fcf19eb..e01359c5 100644 --- a/src/cipsi/EZFIO.cfg +++ b/src/cipsi/EZFIO.cfg @@ -34,3 +34,9 @@ doc: Maximum number of excitation for beta determinants with respect to the Hart interface: ezfio,ocaml,provider default: -1 +[twice_hierarchy_max] +type: integer +doc: Twice the maximum hierarchy parameter (excitation degree plus half the seniority number). Using -1 selects all determinants +interface: ezfio,ocaml,provider +default: -1 + diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 1317fcf3..c8bc75d3 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -713,6 +713,25 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d if (do_cycle) cycle endif + if (twice_hierarchy_max >= 0) then + s = 0 + do k=1,N_int + s = s + popcnt(ieor(det(k,1),det(k,2))) + enddo + if ( mod(s,2)>0 ) stop 'For now, hierarchy CI is defined only for an even number of electrons' + if (excitation_ref == 1) then + call get_excitation_degree(HF_bitmask,det(1,1),degree,N_int) + else if (excitation_ref == 2) then + stop 'For now, hierarchy CI is defined only for a single reference determinant' +! do k=1,N_dominant_dets_of_cfgs +! call get_excitation_degree(dominant_dets_of_cfgs(1,1,k),det(1,1),degree,N_int) +! enddo + endif + integer :: twice_hierarchy + twice_hierarchy = degree + s/2 + if (twice_hierarchy_max > twice_hierarchy_max) cycle + endif + Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) w = 0d0 From 62c28db6da5887e3198e4491ce7671f74dc003f0 Mon Sep 17 00:00:00 2001 From: kossoski Date: Wed, 13 Apr 2022 13:32:14 +0200 Subject: [PATCH 83/86] correction --- src/cipsi/selection.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index c8bc75d3..d4f184f3 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -729,7 +729,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d endif integer :: twice_hierarchy twice_hierarchy = degree + s/2 - if (twice_hierarchy_max > twice_hierarchy_max) cycle + if (twice_hierarchy > twice_hierarchy_max) cycle endif Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) From 8cbabc64943194c17543bc5c72d61dce3597e655 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 13 Apr 2022 13:40:04 +0200 Subject: [PATCH 84/86] Fixed ref values for tests --- src/fci/40.fci.bats | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fci/40.fci.bats b/src/fci/40.fci.bats index f2c78067..864a9d59 100644 --- a/src/fci/40.fci.bats +++ b/src/fci/40.fci.bats @@ -59,13 +59,13 @@ function run_stoch() { @test "HCO" { # 12.2868s qp set_file hco.ezfio - run -113.389297812482 6.e-4 100000 + run -113.393356604085 6.e-4 100000 } @test "H2O2" { # 12.9214s qp set_file h2o2.ezfio qp set_mo_class --core="[1-2]" --act="[3-24]" --del="[25-38]" - run -151.00467 1.e-4 100000 + run -151.005848404095 1.e-4 100000 } @test "HBO" { # 13.3144s From 3762409767713d1df7f7f99dbc034372d86a599b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 13 Apr 2022 17:58:24 +0200 Subject: [PATCH 85/86] Fixed ref values for tests --- src/fci/40.fci.bats | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/fci/40.fci.bats b/src/fci/40.fci.bats index 864a9d59..3139ebb8 100644 --- a/src/fci/40.fci.bats +++ b/src/fci/40.fci.bats @@ -59,43 +59,43 @@ function run_stoch() { @test "HCO" { # 12.2868s qp set_file hco.ezfio - run -113.393356604085 6.e-4 100000 + run -113.393356604085 1.e-3 100000 } @test "H2O2" { # 12.9214s qp set_file h2o2.ezfio qp set_mo_class --core="[1-2]" --act="[3-24]" --del="[25-38]" - run -151.005848404095 1.e-4 100000 + run -151.005848404095 1.e-3 100000 } @test "HBO" { # 13.3144s [[ -n $TRAVIS ]] && skip qp set_file hbo.ezfio - run -100.212560384678 1.e-3 100000 + run -100.214099486337 1.e-3 100000 } @test "H2O" { # 11.3727s [[ -n $TRAVIS ]] && skip qp set_file h2o.ezfio - run -76.2361605151999 3.e-4 100000 + run -76.2361605151999 5.e-4 100000 } @test "ClO" { # 13.3755s [[ -n $TRAVIS ]] && skip qp set_file clo.ezfio - run -534.545616787223 3.e-4 100000 + run -534.546453546852 1.e-3 100000 } @test "SO" { # 13.4952s [[ -n $TRAVIS ]] && skip qp set_file so.ezfio - run -26.0096209515081 1.e-3 100000 + run -26.0176563764039 1.e-3 100000 } @test "H2S" { # 13.6745s [[ -n $TRAVIS ]] && skip qp set_file h2s.ezfio - run -398.859168655255 3.e-4 100000 + run -398.859577605891 5.e-4 100000 } @test "OH" { # 13.865s @@ -113,13 +113,13 @@ function run_stoch() { @test "H3COH" { # 14.7299s [[ -n $TRAVIS ]] && skip qp set_file h3coh.ezfio - run -115.205191406072 3.e-4 100000 + run -115.205632960026 1.e-3 100000 } @test "SiH3" { # 15.99s [[ -n $TRAVIS ]] && skip qp set_file sih3.ezfio - run -5.57241217753818 3.e-4 100000 + run -5.57241217753818 5.e-4 100000 } @test "CH4" { # 16.1612s @@ -132,7 +132,7 @@ function run_stoch() { @test "ClF" { # 16.8864s [[ -n $TRAVIS ]] && skip qp set_file clf.ezfio - run -559.169313755572 3.e-4 100000 + run -559.169748890031 1.e-3 100000 } @test "SO2" { # 17.5645s @@ -146,14 +146,14 @@ function run_stoch() { [[ -n $TRAVIS ]] && skip qp set_file c2h2.ezfio qp set_mo_class --act="[1-30]" --del="[31-36]" - run -12.3685464085969 3.e-4 100000 + run -12.3685464085969 1.e-3 100000 } @test "N2" { # 18.0198s [[ -n $TRAVIS ]] && skip qp set_file n2.ezfio qp set_mo_class --core="[1,2]" --act="[3-40]" --del="[41-60]" - run -109.28681540699360 3.e-4 100000 + run -109.287917088107 1.e-3 100000 } @test "N2H4" { # 18.5006s @@ -167,7 +167,7 @@ function run_stoch() { [[ -n $TRAVIS ]] && skip qp set_file co2.ezfio qp set_mo_class --core="[1,2]" --act="[3-30]" --del="[31-42]" - run -187.968547952413 3.e-4 100000 + run -187.970184372047 1.e-3 100000 } @@ -182,6 +182,6 @@ function run_stoch() { [[ -n $TRAVIS ]] && skip qp set_file hcn.ezfio qp set_mo_class --core="[1,2]" --act="[3-40]" --del="[41-55]" - run -93.0771143355433 3.e-4 100000 + run -93.0777619629755 1.e-3 100000 } From a1ed2282faa2e78fee014197f1da167603988c8a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 13 Apr 2022 19:54:14 +0200 Subject: [PATCH 86/86] Adjust tests --- src/fci/40.fci.bats | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/fci/40.fci.bats b/src/fci/40.fci.bats index 3139ebb8..1a0c5507 100644 --- a/src/fci/40.fci.bats +++ b/src/fci/40.fci.bats @@ -132,28 +132,28 @@ function run_stoch() { @test "ClF" { # 16.8864s [[ -n $TRAVIS ]] && skip qp set_file clf.ezfio - run -559.169748890031 1.e-3 100000 + run -559.169748890031 1.5e-3 100000 } @test "SO2" { # 17.5645s [[ -n $TRAVIS ]] && skip qp set_file so2.ezfio qp set_mo_class --core="[1-8]" --act="[9-87]" - run -41.5746738713298 3.e-4 100000 + run -41.5746738713298 1.5e-3 100000 } @test "C2H2" { # 17.6827s [[ -n $TRAVIS ]] && skip qp set_file c2h2.ezfio qp set_mo_class --act="[1-30]" --del="[31-36]" - run -12.3685464085969 1.e-3 100000 + run -12.3685464085969 2.e-3 100000 } @test "N2" { # 18.0198s [[ -n $TRAVIS ]] && skip qp set_file n2.ezfio qp set_mo_class --core="[1,2]" --act="[3-40]" --del="[41-60]" - run -109.287917088107 1.e-3 100000 + run -109.287917088107 1.5e-3 100000 } @test "N2H4" { # 18.5006s @@ -167,7 +167,7 @@ function run_stoch() { [[ -n $TRAVIS ]] && skip qp set_file co2.ezfio qp set_mo_class --core="[1,2]" --act="[3-30]" --del="[31-42]" - run -187.970184372047 1.e-3 100000 + run -187.970184372047 1.5e-3 100000 }