From c68a30a155b824f1bd602e7da67b819ffb4c18a4 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science@gmail.com>
Date: Thu, 6 May 2021 22:01:39 -0700
Subject: [PATCH] more BGJ fixes

---
 src/nwdft/scf_dft_cg/dft_roks_hessv.F          | 8 +++++++-
 src/nwdft/scf_dft_cg/dft_roks_hessv_2e.F       | 6 +++---
 src/nwdft/scf_dft_cg/dft_roks_hessv_xx.F       | 9 +++++----
 src/nwdft/scf_dft_cg/dft_roks_search_precond.F | 5 +++++
 src/nwdft/scf_dft_cg/dft_uks_hessv.F           | 6 ++++++
 src/nwdft/scf_dft_cg/dft_uks_search_precond.F  | 5 +++++
 6 files changed, 31 insertions(+), 8 deletions(-)

diff --git a/src/nwdft/scf_dft_cg/dft_roks_hessv.F b/src/nwdft/scf_dft_cg/dft_roks_hessv.F
index 91e149403a..c573966c79 100644
--- a/src/nwdft/scf_dft_cg/dft_roks_hessv.F
+++ b/src/nwdft/scf_dft_cg/dft_roks_hessv.F
@@ -6,10 +6,16 @@ subroutine dft_roks_hessv( acc, g_x, g_ax )
 c     
 c     $Id$
 c
+      integer rtdb
       integer g_x, g_ax
       double precision acc
 c     
       integer gtype,grow,gcol,growp,gcolp
+c
+      integer scf_get_rtdb
+      external scf_get_rtdb
+c
+      rtdb = scf_get_rtdb()
 c     
 c     Check
 c     
@@ -30,7 +36,7 @@ subroutine dft_roks_hessv( acc, g_x, g_ax )
 c     
 c     Call internal routine
 c     
-      call dft_roks_hessv_xx( basis, geom, nbf, nmo,
+      call dft_roks_hessv_xx( rtdb, basis, geom, nbf, nmo,
      $     nclosed, nopen,
      $     pflg, g_movecs, oskel, 
      $     crohf_g_fcv, crohf_g_fpv, crohf_g_fcp,
diff --git a/src/nwdft/scf_dft_cg/dft_roks_hessv_2e.F b/src/nwdft/scf_dft_cg/dft_roks_hessv_2e.F
index aea628867b..24763c793d 100644
--- a/src/nwdft/scf_dft_cg/dft_roks_hessv_2e.F
+++ b/src/nwdft/scf_dft_cg/dft_roks_hessv_2e.F
@@ -1,4 +1,4 @@
-      subroutine dft_roks_hessv_2e( basis, geom, nbf, nmo, nclosed,
+      subroutine dft_roks_hessv_2e(rtdb, basis, geom, nbf, nmo, nclosed,
      $                      nopen, g_movec, oskel, g_x, acc, g_ax )
 C     $Id$
       implicit none
@@ -12,7 +12,7 @@ subroutine dft_roks_hessv_2e( basis, geom, nbf, nmo, nclosed,
 c     
 c     Return the ROKS orbital 2e-Hessian vector product, g_ax = A * g_x
 c     
-      integer basis, geom       ! basis & geom handle
+      integer rtdb, basis, geom       ! basis & geom handle
       integer nbf, nclosed, nopen ! Basis size and occupation
       integer nmo               ! No. of linearly dependent MOs
       integer g_movec           ! MO coefficients
@@ -41,7 +41,7 @@ subroutine dft_roks_hessv_2e( basis, geom, nbf, nmo, nclosed,
       integer dims(3), chnk(3)
       integer alo(3), ahi(3), blo(3), bhi(3), clo(3), chi(3)
       integer g_dd, g_ff
-      integer rtdb, calc_type
+      integer calc_type
 c
       integer ga_create_atom_blocked
       external ga_create_atom_blocked
diff --git a/src/nwdft/scf_dft_cg/dft_roks_hessv_xx.F b/src/nwdft/scf_dft_cg/dft_roks_hessv_xx.F
index ebad7a0d1d..5141bc7717 100644
--- a/src/nwdft/scf_dft_cg/dft_roks_hessv_xx.F
+++ b/src/nwdft/scf_dft_cg/dft_roks_hessv_xx.F
@@ -1,4 +1,4 @@
-      subroutine dft_roks_hessv_xx( basis, geom, nbf, 
+      subroutine dft_roks_hessv_xx( rtdb, basis, geom, nbf, 
      $     nmo, nclosed, nopen, 
      $     pflg,
      $     g_movecs, oskel, g_fcv, g_fpv, g_fcp,
@@ -9,9 +9,9 @@ subroutine dft_roks_hessv_xx( basis, geom, nbf,
 #include "global.fh"
 #include "mafdecls.fh"
 #include "rtdb.fh"
-#include "bgj.fh"
+!#include "bgj.fh"
 c     
-      integer basis, geom
+      integer rtdb, basis, geom
       integer nbf, nmo, nclosed, nopen
       integer pflg
       integer g_movecs
@@ -33,7 +33,8 @@ subroutine dft_roks_hessv_xx( basis, geom, nbf,
      $        g_x, g_ax )
       endif
       if (pflg .gt. 1) then
-         call dft_roks_hessv_2e( basis, geom, nbf, nmo, nclosed, nopen,
+         call dft_roks_hessv_2e( rtdb, basis, geom, 
+     $        nbf, nmo, nclosed, nopen,
      $        g_movecs, oskel, g_x, acc, ! was min(1d-6,acc)
      $        g_ax )
       endif
diff --git a/src/nwdft/scf_dft_cg/dft_roks_search_precond.F b/src/nwdft/scf_dft_cg/dft_roks_search_precond.F
index 7914cf3bfa..b8677c4cc7 100644
--- a/src/nwdft/scf_dft_cg/dft_roks_search_precond.F
+++ b/src/nwdft/scf_dft_cg/dft_roks_search_precond.F
@@ -82,6 +82,11 @@ subroutine dft_roks_search_precond(rtdb, g_grad, g_work)
       endif
 c
       call ga_zero(g_work)      ! ESSENTIAL
+!
+! this is required to make rtdb available to dft_roks_hessv
+! without changing the function signature
+!
+      call scf_set_rtdb(rtdb)
 c     
 c     Attempt to solve the damned equations
 c
diff --git a/src/nwdft/scf_dft_cg/dft_uks_hessv.F b/src/nwdft/scf_dft_cg/dft_uks_hessv.F
index ed015d2003..6f1f0134cf 100644
--- a/src/nwdft/scf_dft_cg/dft_uks_hessv.F
+++ b/src/nwdft/scf_dft_cg/dft_uks_hessv.F
@@ -12,11 +12,17 @@ subroutine dft_uks_hessv(acc, g_x, g_ax)
 #include "global.fh"
 
 c     
+      integer rtdb
       double precision acc      ! [input] required accuracy of products
       integer g_x               ! [input] handle to input vectors
       integer g_ax              ! [input] handle to output products
 c
       integer gtype, vlen, nvec, nvecp, g_tmp
+c
+      integer scf_get_rtdb
+      external scf_get_rtdb
+c
+      rtdb = scf_get_rtdb()
 c
 c     Multiply a set of vectors by the level-shifted UHF hessian.
 c     
diff --git a/src/nwdft/scf_dft_cg/dft_uks_search_precond.F b/src/nwdft/scf_dft_cg/dft_uks_search_precond.F
index 4754819ae6..dea623fe0d 100644
--- a/src/nwdft/scf_dft_cg/dft_uks_search_precond.F
+++ b/src/nwdft/scf_dft_cg/dft_uks_search_precond.F
@@ -93,6 +93,11 @@ subroutine dft_uks_search_precond(rtdb, g_grad, g_work)
 *      call uhf_precond(g_work, 0.0d0)
 c
       call ga_zero(g_work)      ! ESSENTIAL
+!
+! this is required to make rtdb available to dft_roks_hessv
+! without changing the function signature
+!
+      call scf_set_rtdb(rtdb)
 c     
 c     Attempt to solve the damned equations
 c