Improved convergence of multi-state

plugins/MRCC_Utils/mrcc_utils.irp.f

@@ -149,26 +149,31 @@ END_PROVIDER
      
      allocate (eigenvectors(size(CI_eigenvectors_dressed,1),size(CI_eigenvectors_dressed,2)), &
      eigenvalues(size(CI_electronic_energy_dressed,1)))
+     do j=1,min(N_states,N_det)
+       do i=1,N_det
+         eigenvectors(i,j) = psi_coef(i,j)
+       enddo
+     enddo
      do mrcc_state=1,N_states
-      do i=1,N_det
-        eigenvectors(i,1) = psi_coef(i,mrcc_state)
+      do j=mrcc_state,min(N_states,N_det)
+        do i=1,N_det
+          eigenvectors(i,j) = psi_coef(i,j)
+        enddo
       enddo
       call davidson_diag_mrcc_HS2(psi_det,eigenvectors,&
             size(eigenvectors,1), &
-            eigenvalues,N_det,1,N_states_diag,N_int, &
+            eigenvalues,N_det,N_states,N_states_diag,N_int, &
             output_determinants,mrcc_state)
-      CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,1)
-      CI_electronic_energy_dressed(mrcc_state) = eigenvalues(1)
-      if (mrcc_state == 1) then
-        do k=N_states+1,N_states_diag
-          CI_eigenvectors_dressed(1:N_det,k) = eigenvectors(1:N_det,k)
-          CI_electronic_energy_dressed(k) = eigenvalues(k)
-        enddo
-      endif
-     enddo
-     call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,&
+      CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,mrcc_state)
+      CI_electronic_energy_dressed(mrcc_state) = eigenvalues(mrcc_state)
+   enddo
+   do k=N_states+1,N_states_diag
+     CI_eigenvectors_dressed(1:N_det,k) = eigenvectors(1:N_det,k)
+     CI_electronic_energy_dressed(k) = eigenvalues(k)
+   enddo
+   call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,&
           N_states_diag,size(CI_eigenvectors_dressed,1))
-     deallocate (eigenvectors,eigenvalues)
+   deallocate (eigenvectors,eigenvalues)
 
      
    else if (diag_algorithm == "Lapack") then
@@ -716,7 +721,7 @@ END_PROVIDER
     factor = 1.d0
     resold = huge(1.d0)
 
-    do k=0,hh_nex
+    do k=0,hh_nex*hh_nex
       !$OMP PARALLEL default(shared) private(cx, i, a_col, a_coll)
       
       !$OMP DO
@@ -751,15 +756,15 @@ END_PROVIDER
         X(a_col) = X_new(a_col)
       end do
       if (res > resold) then
-        factor = -factor * 0.5d0
+        factor = factor * 0.5d0
       endif
       resold = res
       
-      if(mod(k, 100) == 0) then
+      if(iand(k, 4095) == 0) then
         print *, "res ", k, res
       end if
       
-      if(res < 1d-9) exit
+      if(res < 1d-12) exit
     end do
     
     norm = 0.d0

plugins/mrcepa0/mrcepa0_general.irp.f

@@ -37,9 +37,9 @@ subroutine run(N_st,energy)
     lambda = 1.d0
     do while (delta_E > thresh_mrcc)
       iteration += 1
-      print *,  '===========================' 
-      print *,  'MRCEPA0 Iteration', iteration
-      print *,  '===========================' 
+      print *,  '===============================================' 
+      print *,  'MRCEPA0 Iteration', iteration, '/', n_it_mrcc_max
+      print *,  '===============================================' 
       print *,  ''
       E_old = sum(ci_energy_dressed(1:N_states))
       do i=1,N_st
@@ -48,6 +48,8 @@ subroutine run(N_st,energy)
       call diagonalize_ci_dressed(lambda)
       E_new = sum(ci_energy_dressed(1:N_states))
       delta_E = (E_new - E_old)/dble(N_states)
+      print *,  ''
+      call write_double(6,thresh_mrcc,"thresh_mrcc")
       call write_double(6,delta_E,"delta_E")
       delta_E = dabs(delta_E)
       call save_wavefunction

src/Davidson/diagonalization_hs2.irp.f

@@ -326,32 +326,32 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
 
       if (state_following) then
 
-        integer                        :: coord(2), order(N_st_diag)
+        integer                        :: order(N_st_diag)
+        double precision               :: cmax
+
         overlap = -1.d0
-        do i=1,shift2
-          do k=1,shift2
+        do k=1,shift2
+          do i=1,shift2
             overlap(k,i) = dabs(y(k,i))
           enddo
         enddo
         do k=1,N_st
-          coord = maxloc(overlap)
-          order( coord(2) )  = coord(1)
-          do i=1,shift2
-            overlap(coord(1),i) = -1.d0
+          cmax = -1.d0
+          do i=1,N_st_diag
+            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
-        print *,  order(1:N_st)
-        do i=1,shift2
-         do k=1,shift2
-           overlap(k,i) = y(k,i)
-         enddo
-        enddo
+        overlap = y
         do k=1,N_st
           l = order(k)
           if (k /= l) then
-            do i=1,shift2
-              y(i,k) = overlap(i,l)
-            enddo
+            y(1:shift2,k) = overlap(1:shift2,l)
           endif
         enddo
         do k=1,N_st