fix rtdb passing in UHF using same sad hack as ROHF

nwchemgit · May 6, 2021 · 026550e · 026550e
1 parent e59f731
commit 026550e
Show file tree

Hide file tree

Showing 4 changed files with 18 additions and 13 deletions.
diff --git a/src/ddscf/rohf_hessv2.F b/src/ddscf/rohf_hessv2.F
@@ -17,10 +17,10 @@ subroutine rohf_hessv2( acc, g_x, g_ax )
       integer icol,ilo(2),ihi(2)
       logical oprint, olprint
       double precision dnrm
-      integer rohf_get_rtdb
-      external rohf_get_rtdb
+      integer scf_get_rtdb
+      external scf_get_rtdb
 c
-      rtdb = rohf_get_rtdb()
+      rtdb = scf_get_rtdb()
 c     
 c     Check
 c     

diff --git a/src/ddscf/rohf_wrap.F b/src/ddscf/rohf_wrap.F
@@ -13,19 +13,19 @@ block data crohf_data
      $     noskew/.true./
       end
 
-      subroutine rohf_set_rtdb(rtdb)
+      subroutine scf_set_rtdb(rtdb)
       implicit none
       integer rtdb
       integer rtdbcopy
-      common /rohfrtdbcommon/ rtdbcopy
+      common /scrtdbcommon/ rtdbcopy
       rtdbcopy = rtdb
       end
 
-      integer function rohf_get_rtdb()
+      integer function scf_get_rtdb()
       implicit none
       integer rtdbcopy
-      common /rohfrtdbcommon/ rtdbcopy
-      rohf_get_rtdb = rtdbcopy
+      common /scfrtdbcommon/ rtdbcopy
+      scf_get_rtdb = rtdbcopy
       end
 
       subroutine rohf_init( rtdb)
@@ -43,7 +43,7 @@ subroutine rohf_init( rtdb)
       integer rtdb
       external crohf_data ! For T3D linker
 c     
-      call rohf_set_rtdb(rtdb)
+      call scf_set_rtdb(rtdb)
 c
       if (crohf_init_flag.gt.0)
      $     call errquit('rohf internals already initialised?',0,
@@ -255,10 +255,10 @@ subroutine rohf_hessv( acc, g_x, g_ax )
 c     
       integer gtype,grow,gcol,growp,gcolp
 c
-      integer rohf_get_rtdb
-      external rohf_get_rtdb
+      integer scf_get_rtdb
+      external scf_get_rtdb
 c
-      rtdb = rohf_get_rtdb()
+      rtdb = scf_get_rtdb()
 c     
 c     Check
 c     

diff --git a/src/ddscf/uhf.F b/src/ddscf/uhf.F
@@ -192,6 +192,7 @@ subroutine uhf_init(rtdb)
 #include "global.fh"
 #include "mafdecls.fh"
       integer rtdb
+      call scf_set_rtdb(rtdb)
 c
       cuhf_vlen = nalpha*(nmo-nalpha) + nbeta*(nmo-nbeta)
 c

diff --git a/src/ddscf/uhf_hessv.F b/src/ddscf/uhf_hessv.F
@@ -1,4 +1,4 @@
-      subroutine uhf_hessv(rtdb, acc, g_x, g_ax)
+      subroutine uhf_hessv(acc, g_x, g_ax)
 *
 * $Id$
 *
@@ -24,9 +24,13 @@ subroutine uhf_hessv(rtdb, acc, g_x, g_ax)
       integer ilo(2),ihi(2)
 c
       logical oprint, olprint
+      integer scf_get_rtdb
+      external scf_get_rtdb
 c
       oprint = util_print("hessv",print_high)
       olprint = oprint .and. (ga_nodeid().eq.0)
+
+      rtdb = scf_get_rtdb()
 c
 c     Multiply a set of vectors by the level-shifted UHF hessian.
 c