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