Merge branch 'dev' of github.com:QuantumPackage/qp2 into dev

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

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(s,1) .EQ. 0) then
-!    if(iand(MS,1) .EQ. 0) then
+      bfIcfg = max(1,nint((binom(s,s/2)-binom(s,(s/2)+1))))
-!      bfIcfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1))))
+    else
-!    else
+      bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
-!      bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
+    endif
-!    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

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))))
+        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))
       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)));
-        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))
       endif
     endif
     n_CSF += ncfg * dimcsfpercfg

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><i|H|u_k>
         ! -----------------------------------
 
@@ -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
+!      else
-         ! Already computed in update below
+!         ! Already computed in update below
-         continue
+!         continue
-      endif
+!      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
+    ! Re-contract U
-    ! --------------------------------
+    ! -------------
-
-    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)
 
     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))

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><i|H|u_k>
         ! -----------------------------------
 
@@ -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
+!      else
-         ! Already computed in update below
+!         ! Already computed in update below
-         continue
+!         continue
-      endif
+!      endif
 
       if (dressing_state > 0) then
 

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)

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.)

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