running UHF HF and DFT opt and freq works

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

Hide file tree

Showing 25 changed files with 71 additions and 59 deletions.
diff --git a/src/ddscf/uhf_hessv2.F b/src/ddscf/uhf_hessv2.F
@@ -1,4 +1,4 @@
-      subroutine uhf_hessv2(rtdb, acc, g_x, g_ax)
+      subroutine uhf_hessv2(acc, g_x, g_ax)
 *
 * $Id$
 *
@@ -24,9 +24,13 @@ subroutine uhf_hessv2(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     

diff --git a/src/mp2_grad/mp2_lai_fock_uhf.F b/src/mp2_grad/mp2_lai_fock_uhf.F
@@ -137,7 +137,7 @@ subroutine mp2_lai_fock_uhf(geom, basis,
       call int_init(rtdb,1,basis)
       call schwarz_init(geom,basis)
 
-      call fock_2e(geom, basis, nfock, jfac, kfac,
+      call fock_2e(rtdb, geom, basis, nfock, jfac, kfac,
      $     tol2e, oskel, g_dens, g_fock,.false. )
 c     
       call int_terminate()
@@ -269,7 +269,7 @@ subroutine mp2_wij_fock_uhf(rtdb, geom, basis, tol2e,
       call int_init(rtdb,1,basis)
       call schwarz_init(geom,basis)
 
-      call fock_2e(geom, basis, nfock, jfac, kfac,
+      call fock_2e(rtdb, geom, basis, nfock, jfac, kfac,
      $     tol2e, oskel, g_dens, g_fock, .false.)
 c     
       call int_terminate()

diff --git a/src/nwdft/rt_tddft/closedshell/rt_tddft_cs_prop.F b/src/nwdft/rt_tddft/closedshell/rt_tddft_cs_prop.F
@@ -7,7 +7,7 @@
 C>  Propagates closed shell density matrix using von Neumann
 C>  dynamics.
 C--------------------------------------------------------------------
-      subroutine rt_tddft_cs_prop (params)
+      subroutine rt_tddft_cs_prop (rtdb, params)
       implicit none
 
 #include "errquit.fh"
@@ -25,6 +25,7 @@ subroutine rt_tddft_cs_prop (params)
 
 
 C     == Inputs ==
+      integer, intent(in)              :: rtdb
       type(rt_params_t), intent(inout) :: params  !< struct containing parameters
 
 
@@ -186,7 +187,8 @@ subroutine rt_tddft_cs_prop (params)
 C
       params%skip_fock = .false.
 
-      call zfock_cs_build (params, g_zdens_ao, energies, g_zfock_ao)
+      call zfock_cs_build (rtdb, params, g_zdens_ao, energies,
+     &                     g_zfock_ao)
       call canorg_trans (params,"F","AO->MO", g_zfock_ao, g_zfock_mo)
 
       if ( (params%mocap_active).or.(params%cap_active) ) then

diff --git a/src/nwdft/rt_tddft/closedshell/rt_tddft_cs_tdfock.F b/src/nwdft/rt_tddft/closedshell/rt_tddft_cs_tdfock.F
@@ -8,7 +8,7 @@
 C> building Fock matrix from density matrix in AO basis,
 C> and calculating and adding dipole interation with external uniform E-field.
 C--------------------------------------------------------------------
-      logical function rt_tddft_cs_tdfock (params, tt, g_zdens_ao,
+      logical function rt_tddft_cs_tdfock (rtdb, params, tt, g_zdens_ao,
      $     energies, g_zfock_ao)
 
       implicit none
@@ -24,6 +24,7 @@ logical function rt_tddft_cs_tdfock (params, tt, g_zdens_ao,
 
 
 C     == Inputs ==
+      integer, intent(in)           :: rtdb
       type(rt_params_t), intent(in) :: params         !< struct containing parameters
       double precision, intent(in)  :: tt             !< current time
       integer, intent(in)           :: g_zdens_ao     !< complex dens mat, ns_ao x ns_ao
@@ -69,7 +70,8 @@ logical function rt_tddft_cs_tdfock (params, tt, g_zdens_ao,
 C     calculates energies.  Note, the input g_zdens_ao is in AO basis,
 C     and the output g_zfock_ao is also in AO basis.
 C
-      call zfock_cs_build (params, g_zdens_ao, energies, g_zfock_ao)
+      call zfock_cs_build (rtdb, params, g_zdens_ao, energies,
+     &                     g_zfock_ao)
       call ga_sync ()           !XXX needed?
 
 

diff --git a/src/nwdft/rt_tddft/closedshell/zfock_cs_build.F b/src/nwdft/rt_tddft/closedshell/zfock_cs_build.F
@@ -12,7 +12,8 @@
 C     All quantities are in the atomic orbital (AO) basis.
 C
 
-      subroutine zfock_cs_build (params, g_zdens, energies, g_zfock)
+      subroutine zfock_cs_build (rtdb, params, g_zdens, 
+     &                           energies, g_zfock)
       implicit none
 
 #include "errquit.fh"
@@ -29,6 +30,7 @@ subroutine zfock_cs_build (params, g_zdens, energies, g_zfock)
 
 
 C     == Inputs ==
+      integer, intent(in)           :: rtdb
       type(rt_params_t), intent(in) :: params
       integer, intent(in)           :: g_zdens
 
@@ -161,7 +163,7 @@ subroutine zfock_cs_build (params, g_zdens, energies, g_zfock)
          energies%xc(1) = ener2
          energies%xc(2) = 0d0
 
-         call zfock_cs_exchim (params, g_densim, ener1, g_v1)
+         call zfock_cs_exchim (rtdb, params, g_densim, ener1, g_v1)
          call ga_add (1d0, g_v1, 1d0, g_fockim, g_fockim)
          energies%xc(1) = energies%xc(1) + ener1
 

diff --git a/src/nwdft/rt_tddft/closedshell/zfock_cs_exchim.F b/src/nwdft/rt_tddft/closedshell/zfock_cs_exchim.F
@@ -4,7 +4,7 @@
 C     Computes the imaginary part of the exchange for a complex Fock
 C     matrix.
 C
-      subroutine zfock_cs_exchim (params, g_densim, Excim, g_fxim)
+      subroutine zfock_cs_exchim (rtdb, params, g_densim, Excim, g_fxim)
       implicit none
 
 #include "bas.fh"
@@ -19,6 +19,7 @@ subroutine zfock_cs_exchim (params, g_densim, Excim, g_fxim)
 
 
 C     == Inputs ==
+      integer, intent(in)           :: rtdb
       type(rt_params_t), intent(in) :: params
       integer, intent(in)           :: g_densim
 
@@ -58,7 +59,7 @@ subroutine zfock_cs_exchim (params, g_densim, Excim, g_fxim)
       jfac = 0.0d0
       kfac = -0.5d0*xfac(1)
 
-      call fock_2e(geom, ao_bas_han, 1, jfac, kfac,
+      call fock_2e(rtdb, geom, ao_bas_han, 1, jfac, kfac,
      $     params%tol2e_im, oskel, g_densim, g_fxim, .true.)
 
 C      call asym_fock2e (g_fxim)  !xxx 

diff --git a/src/nwdft/scf_dft/dft_fockbld.F b/src/nwdft/scf_dft/dft_fockbld.F
@@ -525,7 +525,7 @@ subroutine dft_fockbld(rtdb,natoms,ntotel,
 c
 c     == Add exact pot contributions ==
       if (exact_pot.eq.1) then
-        call xc_exact_pot(Ecoul_aux, g_dens, g_vxc, g_rho_exact,
+        call xc_exact_pot(rtdb, Ecoul_aux, g_dens, g_vxc, g_rho_exact,
      &                    dif_lamda, g_tmp_exact, g_addit_exact)
       end if
 c

diff --git a/src/nwdft/scf_dft/fukui.F b/src/nwdft/scf_dft/fukui.F
@@ -211,26 +211,26 @@ Subroutine fukui(g_movecs, k_eval, tol2e, rtdb,
       jfac(2) = 1.0d0
       kfac(2) = 0.0d0
       call ga_zero(g_orb)
-      call fock_2e(geom, AO_bas_han, 1, jfac, kfac,
+      call fock_2e(rtdb, geom, AO_bas_han, 1, jfac, kfac,
      &             tol2e, oskel, g_dens_HOMO(1), g_orb, .false.)
       int_HaHa = ga_ddot(g_dens_HOMO(1), g_orb)
 c
       int_HaLb = ga_ddot(g_dens_LUMO(2), g_orb)
 c
       call ga_zero(g_orb)
-      call fock_2e(geom, AO_bas_han, 1, jfac, kfac,
+      call fock_2e(rtdb, geom, AO_bas_han, 1, jfac, kfac,
      &             tol2e, oskel, g_dens_HOMO(2), g_orb, .false.)
       int_HbHb = ga_ddot(g_dens_HOMO(2), g_orb)
 c
       int_LaHb = ga_ddot(g_dens_LUMO(1), g_orb)
 c
       call ga_zero(g_orb)
-      call fock_2e(geom, AO_bas_han, 1, jfac, kfac,
+      call fock_2e(rtdb, geom, AO_bas_han, 1, jfac, kfac,
      &             tol2e, oskel, g_dens_LUMO(1), g_orb, .false.)
       int_LaLa = ga_ddot(g_dens_LUMO(1), g_orb)
 c
       call ga_zero(g_orb)
-      call fock_2e(geom, AO_bas_han, 1, jfac, kfac,
+      call fock_2e(rtdb, geom, AO_bas_han, 1, jfac, kfac,
      &             tol2e, oskel, g_dens_LUMO(2), g_orb, .false.)
       int_LbLb = ga_ddot(g_dens_LUMO(2), g_orb)
 c
@@ -265,7 +265,7 @@ Subroutine fukui(g_movecs, k_eval, tol2e, rtdb,
      &             int_mb(icetobfr), natoms)
       Exc_zero = Exc(1)
       call ga_zero(g_orb)
-      call fock_2e(geom, AO_bas_han, 1, jfac, kfac,
+      call fock_2e(rtdb, geom, AO_bas_han, 1, jfac, kfac,
      &             tol2e, oskel, g_dens_HOMO(1), g_orb, .false.)
       do isp = 1, ipol
         int_vxc_H(isp) = ga_ddot(g_dens_HOMO(isp), g_vxc(isp))
@@ -789,7 +789,7 @@ Subroutine xc_pot(rtdb, Exc, ecoul,nExc, iVxc_opt, g_xcinv,
              kfac(2) = 0d0
               g_vxc(2) = ga_create_atom_blocked(geom,ao_bas_han,'jk')
               g_dens(2)=g_dens(1)
-              call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+              call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &             tol2e, oskel, g_dens(1), g_vxc(1), .false.)
               Exc(1) = Exc(1)+0.5d0*ga_ddot(g_dens(1),g_vxc(1))
               call ga_zero(g_vxc(2))
@@ -798,7 +798,7 @@ Subroutine xc_pot(rtdb, Exc, ecoul,nExc, iVxc_opt, g_xcinv,
               if (.not. ga_destroy(g_vxc(2))) call errquit
      $             ('xc_getv: ga corrupt?',0, GA_ERR)
             else
-              call fock_2e(geom, AO_bas_han, 1, jfac, kfac,
+              call fock_2e(rtdb, geom, AO_bas_han, 1, jfac, kfac,
      &             tol2e, oskel, g_dens(1), g_vxc(1), .false.)
             Exc(1) = Exc(1)+0.5d0*ga_ddot(g_dens(1),g_vxc(1))
             endif
@@ -808,7 +808,7 @@ Subroutine xc_pot(rtdb, Exc, ecoul,nExc, iVxc_opt, g_xcinv,
                jfac(2)=0.d0
                kfac(1)=-1.0d0*xfac(1)
                kfac(2)=-1.0d0*xfac(1)
-               call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+               call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &              tol2e, oskel, g_dens, g_vxc, .false.)
                Exc(1) = Exc(1)+0.5d0*(ga_ddot(g_dens(1),g_vxc(1)) +
      &              ga_ddot(g_dens(2),g_vxc(2)))
@@ -831,7 +831,7 @@ Subroutine xc_pot(rtdb, Exc, ecoul,nExc, iVxc_opt, g_xcinv,
                g_d(2)  = g_dens(1)
                g_d(3)  = g_dens(2)
                g_d(4)  = g_dens(2)
-               call fock_2e(geom, AO_bas_han, 4, jfac, kfac,
+               call fock_2e(rtdb, geom, AO_bas_han, 4, jfac, kfac,
      &              tol2e, oskel, g_d(1), g_jk(1),.false. )
                call ga_zero(g_jk(1))
                call ga_zero(g_jk(3))

diff --git a/src/nwdft/scf_dft_cg/dft_roks_fock.F b/src/nwdft/scf_dft_cg/dft_roks_fock.F
@@ -350,7 +350,7 @@ subroutine dft_roks_fock(rtdb, geom, basis, nclosed, nopen, nmo,
         kfactor(1)=-0.5d0*xc_hfexch()
         kfactor(2)=0d0
         kfactor(3)=-0.5d0*xc_hfexch()
-        call fock_2e(geom, basis, nfock, jfactor, kfactor,
+        call fock_2e(rtdb, geom, basis, nfock, jfactor, kfactor,
      $     tol2e, oskel, iv_dens, iv_fock, .false.)
       else 
 c
@@ -379,7 +379,7 @@ subroutine dft_roks_fock(rtdb, geom, basis, nclosed, nopen, nmo,
         kfactor(1)=-0.5d0*xc_hfexch()
         kfactor(2)=0d0
         kfactor(3)=-0.5d0*xc_hfexch()
-        call fock_2e(geom, basis, nfock, jfactor, kfactor,
+        call fock_2e(rtdb, geom, basis, nfock, jfactor, kfactor,
      $     tol2e, oskel, iv_dens, g_tmp, .false., .false.)
         call ga_dadd(1d0,iv_fock,1d0,g_tmp(1),iv_fock)
         if (nopen.gt.0) then
@@ -402,7 +402,7 @@ subroutine dft_roks_fock(rtdb, geom, basis, nclosed, nopen, nmo,
         kfactor(1)=0d0
         kfactor(2)=0d0
         kfactor(3)=0d0
-        call fock_2e(geom, basis, nfock, jfactor, kfactor,
+        call fock_2e(rtdb, geom, basis, nfock, jfactor, kfactor,
      $     tol2e, oskel, iv_dens, g_tmp, .false., .true.)
         call ga_dadd(1d0,iv_fock,1d0,g_tmp(1),iv_fock)
         if (nopen.gt.0) then

diff --git a/src/nwdft/scf_dft_cg/dft_uks_energy.F b/src/nwdft/scf_dft_cg/dft_uks_energy.F
@@ -180,7 +180,7 @@ subroutine dft_uks_energy( rtdb, g_vecs, eone, etwo, exc, enrep,
         kfac(2)=xc_hfexch()
         kfac(3)=0d0
         kfac(4)=xc_hfexch()
-        call fock_2e(geom, basis, nfock, jfac, kfac, tol2e,
+        call fock_2e(rtdb, geom, basis, nfock, jfac, kfac, tol2e,
      $     oskel, d, f, .false.)
       else ! for attenuated calculations
 c
@@ -205,7 +205,7 @@ subroutine dft_uks_energy( rtdb, g_vecs, eone, etwo, exc, enrep,
         do ifock = 1,nfock
          call ga_zero(g_tmp(ifock))
         end do
-        call fock_2e(geom, basis, nfock, jfac, kfac, tol2e, 
+        call fock_2e(rtdb, geom, basis, nfock, jfac, kfac, tol2e, 
      &     oskel, d, g_tmp, .false., .false.)
         do ifock = 1,nfock
          call ga_dadd(1d0,f(ifock),1d0,g_tmp(ifock),f(ifock))
@@ -225,7 +225,7 @@ subroutine dft_uks_energy( rtdb, g_vecs, eone, etwo, exc, enrep,
         do ifock = 1,nfock
          call ga_zero(g_tmp(ifock))
         end do
-        call fock_2e(geom, basis, nfock, jfac, kfac, tol2e, 
+        call fock_2e(rtdb, geom, basis, nfock, jfac, kfac, tol2e, 
      &     oskel, d, g_tmp, .false., .false.)
         do ifock = 1,nfock
          call ga_dadd(1d0,f(ifock),1d0,g_tmp(ifock),f(ifock))

diff --git a/src/nwdft/scf_dft_cg/dft_uks_hessv_2e.F b/src/nwdft/scf_dft_cg/dft_uks_hessv_2e.F
@@ -191,7 +191,7 @@ subroutine dft_uks_hessv_2e(acc, g_x, g_ax, nvec)
 c
       if(util_print('dft timings', print_high))
      &      time1_2e=util_cpusec()   ! start 2e build time
-      call fock_2e(geom, basis, nfock, jfac, kfac,
+      call fock_2e(rtdb, geom, basis, nfock, jfac, kfac,
      $     tol2e_local, oskel_local, g_dens, g_fock, .false.)
       if(util_print('dft timings', print_high))
      &      time2_2e=util_cpusec()   ! end 2e build time

diff --git a/src/nwdft/so_dft/getv_coul.F b/src/nwdft/so_dft/getv_coul.F
@@ -71,7 +71,7 @@ subroutine getv_coul(rtdb, ecoul, g_densso, g_fockso, g_v)
       kfac(2) = 0.0d0
       call ga_zero(g_tmp(1))
       call ga_zero(g_tmp(2))
-      call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+      call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &              tol2e, oskel, g_dens, g_tmp, .false.)
 c
 c     Accumulate contribution 

diff --git a/src/nwdft/so_dft/getv_exch0.F b/src/nwdft/so_dft/getv_exch0.F
@@ -83,7 +83,7 @@ subroutine getv_exch0(rtdb, exch0, g_densso, g_fockso, g_v, which)
          if (.not. chk_dens(rtdb, g_dens)) goto 1000
 c
 c        Calculate 2e contribution
-         call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+         call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &        tol2e, oskel, g_dens, g_tmp, .false.)  ! false implies symmetrization
 c
 c        Accumulate contribution 
@@ -115,7 +115,7 @@ subroutine getv_exch0(rtdb, exch0, g_densso, g_fockso, g_v, which)
          if (.not. chk_dens(rtdb, g_dens)) goto 1000
 c
 c        Calculate 2e contribution
-         call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+         call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &        tol2e, oskel, g_dens, g_tmp, .true.)  ! true implies no symmetrization
          call asym_fock2e(g_tmp(1))  ! asymmetrize outside
          call asym_fock2e(g_tmp(2))  ! asymmetrize outside

diff --git a/src/nwdft/so_dft/getv_exchX.F b/src/nwdft/so_dft/getv_exchX.F
@@ -85,7 +85,7 @@ subroutine getv_exchX(rtdb, exchX, g_densso, g_fockso, g_v, which)
          if (.not. chk_dens(rtdb, g_dens)) goto 1000
 c
 c        Calculate 2e contribution
-         call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+         call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &              tol2e, oskel, g_dens, g_tmp, .false.) ! symm
 c
 c        Accumulate contribution 
@@ -117,7 +117,7 @@ subroutine getv_exchX(rtdb, exchX, g_densso, g_fockso, g_v, which)
          if (.not. chk_dens(rtdb, g_dens)) goto 1000
 c
 c        Calculate 2e contribution
-         call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+         call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &             tol2e, oskel, g_dens, g_tmp, .true.)  ! true implies no symmetrization
          call asym_fock2e(g_tmp(1))  ! asymmetrize outside
          call asym_fock2e(g_tmp(2))  ! asymmetrize outside

diff --git a/src/nwdft/so_dft/getv_exchY.F b/src/nwdft/so_dft/getv_exchY.F
@@ -84,7 +84,7 @@ subroutine getv_exchY(rtdb, exchY, g_densso, g_fockso, g_v, which)
          if (.not. chk_dens(rtdb, g_dens)) goto 1000
 c
 c        Calculate 2e contribution
-         call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+         call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &              tol2e, oskel, g_dens, g_tmp, .false.) ! symm
 c
 c        Accumulate contribution 
@@ -116,7 +116,7 @@ subroutine getv_exchY(rtdb, exchY, g_densso, g_fockso, g_v, which)
          if (.not. chk_dens(rtdb, g_dens)) goto 1000
 c
 c        Calculate 2e contribution
-         call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+         call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &             tol2e, oskel, g_dens, g_tmp, .true.) 
          call asym_fock2e(g_tmp(1))  ! asymmetrize outside
          call asym_fock2e(g_tmp(2))  ! asymmetrize outside

diff --git a/src/nwdft/so_dft/getv_exchZ.F b/src/nwdft/so_dft/getv_exchZ.F
@@ -83,7 +83,7 @@ subroutine getv_exchZ(rtdb, exchZ, g_densso, g_fockso, g_v, which)
          if (.not. chk_dens(rtdb, g_dens)) goto 1000
 c
 c        Calculate 2e contribution
-         call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+         call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &              tol2e, oskel, g_dens, g_tmp, .false.)  ! symmetrize
 c
 c        Accumulate contribution 
@@ -115,7 +115,7 @@ subroutine getv_exchZ(rtdb, exchZ, g_densso, g_fockso, g_v, which)
          if (.not. chk_dens(rtdb, g_dens)) goto 1000
 c
 c        Calculate 2e contribution
-         call fock_2e(geom, AO_bas_han, 2, jfac, kfac,
+         call fock_2e(rtdb, geom, AO_bas_han, 2, jfac, kfac,
      &             tol2e, oskel, g_dens, g_tmp, .true.)  ! true implies no symmetrization
          call asym_fock2e(g_tmp(1))  ! asymmetrize outside
          call asym_fock2e(g_tmp(2))  ! asymmetrize outside