Accelerated Davidson

src/Dets/davidson.irp.f

@@ -12,7 +12,7 @@ BEGIN_PROVIDER [ integer, davidson_sze_max]
   ! Max number of Davidson sizes
   END_DOC
   ASSERT (davidson_sze_max <= davidson_iter_max)
-  davidson_sze_max = 10
+  davidson_sze_max = 4
 END_PROVIDER
 
 subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
@@ -40,7 +40,7 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
   double precision, intent(out)  :: energies(N_st)
   
   integer                        :: iter
-  integer                        :: i,j,k,l
+  integer                        :: i,j,k,l,m
   logical                        :: converged
   
   double precision               :: overlap(N_st,N_st)
@@ -69,23 +69,9 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
   ASSERT (sze > 0)
   ASSERT (Nint > 0)
   ASSERT (Nint == N_int)
-  ! Conventions:
-  ! i,j : 1,sze
-  ! k,l : 1,N_st
   
-  !$OMP PARALLEL DEFAULT(NONE)                                       &
+  ! Initialization
-      !$OMP PRIVATE(k,i) SHARED(U,u_in,sze,N_st)
+  ! ==============
-  do k=1,N_st
-    !$OMP DO
-    do i=1,sze
-      U(i,k,1) = u_in(i,k)
-    enddo
-    !$OMP END DO NOWAIT
-  enddo
-  !$OMP END PARALLEL
-  
-  ! Orthonormalize initial guess
-  ! ============================
   
   k_pairs=0
   do l=1,N_st
@@ -95,34 +81,54 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
       kl_pairs(2,k_pairs) = l
     enddo
   enddo
-  !$OMP PARALLEL DO DEFAULT(NONE)                                  &
-      !$OMP  SHARED(U,sze,N_st,overlap,kl_pairs,k_pairs)           &
-      !$OMP  PRIVATE(k,l,kl)
-  do kl=1,k_pairs
-    k = kl_pairs(1,kl)
-    l = kl_pairs(2,kl)
-    if (k==l) then
-      overlap(k,k) = u_dot_u(U(1,k,1),sze)
-    endif
-    overlap(k,l) = u_dot_v(U(1,k,1),U(1,l,1),sze)
-    overlap(l,k) = overlap(k,l)
-  enddo
-  !$OMP END PARALLEL DO
-  call ortho_lowdin(overlap,size(overlap,1),N_st,U,size(U,1),sze)
   
-  !$OMP PARALLEL DO DEFAULT(NONE)                                    &
+  !$OMP PARALLEL DEFAULT(NONE)                                       &
-      !$OMP PRIVATE(i)                                               &
+      !$OMP  SHARED(U,sze,N_st,overlap,kl_pairs,k_pairs,             &
-      !$OMP SHARED(H_jj,Nint,dets_in,sze)
+      !$OMP  H_jj,Nint,dets_in,u_in)                                 &
+      !$OMP  PRIVATE(k,l,kl,i)
+  
+  !$OMP DO
   do i=1,sze
     H_jj(i) = diag_h_mat_elem(dets_in(1,1,i),Nint)
   enddo
-  !$OMP END PARALLEL DO
+  !$OMP END DO NOWAIT
+  
+  ! Orthonormalize initial guess
+  ! ============================
+  
+  !$OMP DO
+  do kl=1,k_pairs
+    k = kl_pairs(1,kl)
+    l = kl_pairs(2,kl)
+    if (k/=l) then
+      overlap(k,l) = u_dot_v(U_in(1,k),U_in(1,l),sze)
+      overlap(l,k) = overlap(k,l)
+    else
+      overlap(k,k) = u_dot_u(U_in(1,k),sze)
+    endif
+  enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+  call ortho_lowdin(overlap,size(overlap,1),N_st,U_in,size(U_in,1),sze)
   
   ! Davidson iterations
   ! ===================
   
   converged = .False.
   
+  do while (.not.converged)
+    
+    !$OMP PARALLEL DEFAULT(NONE)                                     &
+        !$OMP PRIVATE(k,i) SHARED(U,u_in,sze,N_st)
+    do k=1,N_st
+      !$OMP DO
+      do i=1,sze
+        U(i,k,1) = u_in(i,k)
+      enddo
+      !$OMP END DO 
+    enddo
+    !$OMP END PARALLEL
+    
     do iter=1,davidson_sze_max-1
       print *,  'iter = ',iter
       
@@ -147,23 +153,34 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
       
       ! Compute h_kl = <u_k | W_l> = <u_k| H |u_l>
       ! -------------------------------------------
+
+      !$OMP PARALLEL 
+      !$OMP SINGLE
       do l=1,N_st
         do iter2=1,iter-1
           do k=1,N_st
+            !$OMP TASK FIRSTPRIVATE(k,iter,l,iter2)
             h(k,iter2,l,iter) = u_dot_v(U(1,k,iter2),W(1,l),sze)
             h(k,iter,l,iter2) = h(k,iter2,l,iter)
+            !$OMP END TASK
           enddo
         enddo
         do k=1,l
+          !$OMP TASK FIRSTPRIVATE(k,iter,l)
           h(k,iter,l,iter) = u_dot_v(U(1,k,iter),W(1,l),sze)
           h(l,iter,k,iter) = h(k,iter,l,iter)
+          !$OMP END TASK
         enddo
       enddo
+      !$OMP END SINGLE NOWAIT
+      !$OMP TASKWAIT
+      !$OMP END PARALLEL
       
       ! Diagonalize h
       ! -------------
       call lapack_diag(lambda,y,h,N_st*davidson_sze_max,N_st*iter)
       
+      print *,  lambda(1:4)
       ! Express eigenvectors of h in the determinant basis
       ! --------------------------------------------------
       
@@ -233,8 +250,15 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
         enddo
         call normalize( U(1,k,iter+1), sze )
       enddo
-    
     enddo
+    
+    if (.not.converged) then
+      iter = davidson_sze_max
+    endif
+    
+    ! Re-contract to u_in
+    ! -----------
+    
     do k=1,N_st
       energies(k) = lambda(k)
       do i=1,sze
@@ -247,6 +271,8 @@ subroutine davidson_diag(dets_in,u_in,energies,dim_in,sze,N_st,Nint)
       enddo
     enddo
     
+  enddo
+
   deallocate (                                                       &
       kl_pairs,                                                      &
       H_jj,                                                          &

src/Dets/slater_rules.irp.f

@@ -971,7 +971,7 @@ subroutine H_u_0(v_0,u_0,H_jj,n,keys_tmp,Nint)
       !$OMP PRIVATE(i,hij,j,k,idx,jj) SHARED(n,H_jj,u_0,keys_tmp,Nint)&
       !$OMP SHARED(v_0)
   allocate(idx(0:n))
-  !$OMP DO SCHEDULE(dynamic)
+  !$OMP DO SCHEDULE(guided)
   do i=1,n
     v_0(i) = H_jj(i) * u_0(i)
     call filter_connected(keys_tmp,keys_tmp(1,1,i),Nint,n,idx)