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..75f6e539 100644 --- a/src/csf/conversion.irp.f +++ b/src/csf/conversion.irp.f @@ -58,29 +58,17 @@ 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 - ! 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(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/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/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 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/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.) 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