From dec7cefc12220614e7f93a4fbdc660a7a75a565f Mon Sep 17 00:00:00 2001
From: edoapra <edoardo.apra@gmail.com>
Date: Thu, 23 Feb 2023 18:09:56 -0800
Subject: [PATCH] back_to_atguess directive: if d_e > 1d-1 after
 back_to_atguess cycles, back to at guess

---
 src/nwdft/scf_dft/dft_scf.F    | 22 ++++++++++++++++++++--
 src/nwdft/scf_dft/dft_scfcvg.F | 11 ++++++++++-
 2 files changed, 30 insertions(+), 3 deletions(-)

diff --git a/src/nwdft/scf_dft/dft_scf.F b/src/nwdft/scf_dft/dft_scf.F
index 819e45a58c..6b8239cb00 100644
--- a/src/nwdft/scf_dft/dft_scf.F
+++ b/src/nwdft/scf_dft/dft_scf.F
@@ -248,6 +248,7 @@ C     RTDB flag for printing out all matrices
       logical lprint_mats  !print matrices to stdout?
       logical lsave_mats   !save matrices to file?
       logical molden, forceatguess, save_evals, densmat
+      integer back_to_atguess
       character*256 file_mat1,movecs_in_org
       integer ma_type, no_sflip,l_at_flip,k_at_flip
       character*26 date
@@ -862,9 +863,13 @@ c       optionally, g_x2c_c2u is also allocated and kept.
       end if                    ! do_x2c
 c
 c     == determine guess ==
+      if(.not.rtdb_get(rtdb,'back_to_atguess',mt_int,1,
+     N     back_to_atguess)) 
+     .     back_to_atguess=0
       if(.not.rtdb_get(rtdb,'forceatguess',mt_log,1,forceatguess)) 
      .     forceatguess=.false.
-      if(forceatguess) movecs_in='atomic'
+ 1993 if(forceatguess) movecs_in='atomic'
+      if(movecs_in.eq.'atomic') back_to_atguess=0
       call dft_guessin(movecs_in,ldmix,ncanorg,fon,
      ,     vecs_or_dens,
      ,     ipol,nbf_ao,g_movecs,g_gmovecs,
@@ -1820,8 +1825,21 @@ c
       call dft_scfcvg(rms, derr, Etold, Etnew,
      &                e_conv, d_conv, g_conv, ipol, 
      &                iter, iterations, idone, rtdb,
-     &                converged, diising)
+     &     converged, diising,
+     B     back_to_atguess)
 c
+      if(movecs_in.ne.'atomic'.and.back_to_atguess.lt.0) then
+         movecs_in='atomic'
+         if(ga_nodeid().eq.0)
+     W        write(luout,*) ' restart from atomic guess'
+         if (.not. ga_destroy(g_denso(1))) call errquit
+     &        ('dft_scf: could not destroy g_denso', 0, GA_ERR)
+         if(ipol.eq.2) then
+            if (.not. ga_destroy(g_denso(2))) call errquit
+     &           ('dft_scf: could not destroy g_dens2', 0, GA_ERR)
+         endif
+         goto 1993
+      endif
       if (oprint_time)
      &     call dft_tstamp(' called scfcvg ')
 c
diff --git a/src/nwdft/scf_dft/dft_scfcvg.F b/src/nwdft/scf_dft/dft_scfcvg.F
index c5028312b0..993ea4a42e 100644
--- a/src/nwdft/scf_dft/dft_scfcvg.F
+++ b/src/nwdft/scf_dft/dft_scfcvg.F
@@ -1,6 +1,7 @@
       subroutine dft_scfcvg(rms, derr, etold, etnew, e_conv, 
      &                      d_conv, g_conv, ipol, iter, iterations, 
-     &                      idone, rtdb, converged, diising)
+     &     idone, rtdb, converged, diising,
+     B     back_to_atguess)
 c
 c     $Id$
 c
@@ -21,6 +22,7 @@ c
       integer rtdb              ! [input]
       logical converged         ! [output]
       logical diising           ! [input]
+      integer back_to_atguess   ! [in/out]
 c
 #include "mafdecls.fh"
 #include "rtdb.fh"
@@ -89,6 +91,13 @@ c     Check over-all convergence.
 c
       converged = e_conv_logical.and.d_conv_logical.and.g_conv_logical
       if (converged)idone = 1
+c
+c     try at guess if d_e > 1d-1 after back_to_atguess iterations
+c
+      if(.not.converged.and.back_to_atguess.gt.0) then
+         if(abde.gt.1d-1.and.iter.gt.back_to_atguess)
+     B        back_to_atguess=-1
+      endif
 c     
 c     Check iteration value.
 c