From b1a9866ac25023ca5d90c310f7fa2b76267ebf04 Mon Sep 17 00:00:00 2001
From: Mahin Hackler <mhackler>
Date: Thu, 20 Feb 2003 01:26:28 +0000
Subject: [PATCH] geom_freeze function call added

---
 src/ccsd/ccsd_driver.F    | 15 ++++-----------
 src/ddscf/localize.F      |  4 ++--
 src/moints/direct_mp2.F   | 13 ++++---------
 src/moints/mointdriver.F  | 13 ++++---------
 src/mp2_grad/mp2_energy.F | 27 +++++++++++++++++----------
 src/uccsdt/uccsdt.F       | 11 +++--------
 src/util/corr_mk_ref.F    | 31 ++++++++++++++++++-------------
 7 files changed, 52 insertions(+), 62 deletions(-)

diff --git a/src/ccsd/ccsd_driver.F b/src/ccsd/ccsd_driver.F
index 0e40041c65..fa67e0dcb2 100644
--- a/src/ccsd/ccsd_driver.F
+++ b/src/ccsd/ccsd_driver.F
@@ -1,6 +1,6 @@
       subroutine ccsd_driver( rtdb, geom, basis, movecs_in,
      $     oconverged)
-C     $Id: ccsd_driver.F,v 2.35 2001-08-01 20:49:44 windus Exp $
+C     $Id: ccsd_driver.F,v 2.36 2003-02-20 01:23:04 mhackler Exp $
        implicit none
 #include "mafdecls.fh"
 #include "global.fh"
@@ -116,17 +116,10 @@ c
 c
 c Get frozen core & virtual offsets
 c
-       if (rtdb_get(rtdb,'ccsd:frozen core:freeze by atoms',mt_log, 1, 
-     $      status)) then
-          if (.not. geom_num_core(geom,occ_frozen)) 
-     $        call errquit('ccsd: geom_num_core?',0)
-       else if (rtdb_get(rtdb, 'ccsd:frozen core', MT_INT, 1,
-     $         occ_frozen)) then
-      else
-         if (.not.rtdb_get(rtdb,'occ_frozen',MT_INT,1,occ_frozen))
-     $        occ_frozen = 0
-         occ_frozen = 0
+      if(.not. geom_freeze(rtdb, geom, 'ccsd', occ_frozen)) then
+        call errquit('ccsd: unable to freeze core orbitals', 0)
       endif
+
       if (.not. rtdb_put(rtdb,'ccsd:number frozen core',MT_INT,1,
      $     occ_frozen))
      $   call errquit('ccsddriver: rtdb failure for occ_frozen',555)
diff --git a/src/ddscf/localize.F b/src/ddscf/localize.F
index c231936e2f..cbaa481193 100644
--- a/src/ddscf/localize.F
+++ b/src/ddscf/localize.F
@@ -20,7 +20,7 @@ c
       end
       subroutine testlocalize(rtdb)
 *
-* $Id: localize.F,v 1.9 2000-10-23 15:51:39 windus Exp $
+* $Id: localize.F,v 1.10 2003-02-20 01:23:50 mhackler Exp $
 *
       implicit none
 #include "cscf.fh"
@@ -103,7 +103,7 @@ c
 c     
 c     Localize the core orbitals
 c     
-         if (.not. geom_num_core(geom,ncore)) ncore = 0
+         if (.not. geom_num_core(rtdb, geom, 'ddscf', ncore)) ncore = 0
          if (ncore .gt. 0) then
             do i = 1, ncore
                iloc(i) = i
diff --git a/src/moints/direct_mp2.F b/src/moints/direct_mp2.F
index bc14d6f70f..0657b265ae 100644
--- a/src/moints/direct_mp2.F
+++ b/src/moints/direct_mp2.F
@@ -1,5 +1,5 @@
        logical function direct_mp2(rtdb)
-C$Id: direct_mp2.F,v 1.47 2001-02-20 23:32:09 edo Exp $
+C$Id: direct_mp2.F,v 1.48 2003-02-20 01:24:18 mhackler Exp $
        implicit none
 #include "mafdecls.fh"
 #include "tcgmsg.fh"
@@ -170,15 +170,10 @@ c
 c
 c Get frozen core and virtual offset
 c
-       if (rtdb_get(rtdb,'mp2:frozen core:freeze by atoms',mt_log, 1, 
-     $              status)) then
-	  if (.not. geom_num_core(geom,occ_frozen)) 
-     $          call errquit('direct_mp2: geom_num_core?',0)
-       else if (rtdb_get(rtdb, 'mp2:frozen core', MT_INT, 1,
-     $                   occ_frozen)) then
-       else
-         occ_frozen = 0
+       if(.not. geom_freeze(rtdb, geom, 'mp2', occ_frozen)) then
+          call errquit('direct_mp2: unable to get frozen core',0)
        endif
+
        if (.not.rtdb_get(rtdb, 'mp2:frozen virtual', MT_INT, 1,
      $                   vir_frozen)) vir_frozen = 0
 c
diff --git a/src/moints/mointdriver.F b/src/moints/mointdriver.F
index 445d737cea..087b7ebcc3 100644
--- a/src/moints/mointdriver.F
+++ b/src/moints/mointdriver.F
@@ -1,5 +1,5 @@
        subroutine moint_driver( rtdb, geom, basis, movecs_in )
-C$Id: mointdriver.F,v 1.68 2000-10-23 15:52:29 windus Exp $
+C$Id: mointdriver.F,v 1.69 2003-02-20 01:24:19 mhackler Exp $
        implicit none
 #include "mafdecls.fh"
 #include "global.fh"
@@ -160,15 +160,10 @@ c
 c
 c Get frozen core and virtual offset
 c
-       if (rtdb_get(rtdb,'mp2:frozen core:freeze by atoms',mt_log, 1, 
-     $              status)) then
-	  if (.not. geom_num_core(geom,occ_frozen)) 
-     $          call errquit('direct_mp2: geom_num_core?',0)
-       else if (rtdb_get(rtdb, 'mp2:frozen core', MT_INT, 1,
-     $                   occ_frozen)) then
-       else
-         occ_frozen = 0
+       if(.not. geom_freeze(rtdb, geom, 'mp2', occ_frozen)) then
+          call errquit('direct_mp2: unable to get frozen core',0)
        endif
+
        if (.not.rtdb_get(rtdb, 'mp2:frozen virtual', MT_INT, 1,
      $                   vir_frozen)) vir_frozen = 0
 
diff --git a/src/mp2_grad/mp2_energy.F b/src/mp2_grad/mp2_energy.F
index 22d66791e4..40edf01b93 100644
--- a/src/mp2_grad/mp2_energy.F
+++ b/src/mp2_grad/mp2_energy.F
@@ -1,6 +1,6 @@
       subroutine mp2_energy(rtdb,geom,basis,movecs,task)
 *
-* $Id: mp2_energy.F,v 1.53 2002-10-14 16:21:53 windus Exp $
+* $Id: mp2_energy.F,v 1.54 2003-02-20 01:24:51 mhackler Exp $
 *
       implicit none
 #include "mafdecls.fh"
@@ -80,6 +80,9 @@ c
       external cphf
       logical file_write_ga,file_read_ga
       external file_write_ga,file_read_ga
+      logical geom_freeze
+      external geom_freeze
+
       character*(nw_max_path_len) cphf_sol
       integer natoms, l_grad, k_grad, g_tmpa, g_tmpb
 c     
@@ -113,15 +116,19 @@ c
       if(nbf.ne.nbf_vecs)call errquit('mp2: MO vectors mismatch?',0)
       nmo = nmos(1)
 c     
-      if (rtdb_get(rtdb,'mp2:frozen core:freeze by atoms',mt_log, 1, 
-     $     status)) then
-         if (.not. geom_num_core(geom,noa_frozen)) 
-     $        call errquit('semi_direct_mp2: geom_num_core?',0)
-      else if (rtdb_get(rtdb, 'mp2:frozen core', MT_INT, 1,
-     $        noa_frozen)) then
-      else
-         noa_frozen = 0
-      endif
+C      if (rtdb_get(rtdb,'mp2:frozen core:freeze by atoms',mt_log, 1, 
+C     $     status)) then
+C         if (.not. geom_num_core(geom,noa_frozen)) 
+C     $        call errquit('semi_direct_mp2: geom_num_core?',0)
+C      else if (rtdb_get(rtdb, 'mp2:frozen core', MT_INT, 1,
+C     $        noa_frozen)) then
+C      else
+C         noa_frozen = 0
+C      endif
+
+       if(.not. geom_freeze(rtdb,geom,'mp2',noa_frozen)) then
+            call errquit('mp2_grad: unable to get frozen core',0)
+       endif
 c
       if(.not.rtdb_put(rtdb,'mp2:number frozen core',MT_INT,1,
      $      noa_frozen))
diff --git a/src/uccsdt/uccsdt.F b/src/uccsdt/uccsdt.F
index 0c55be092c..1c1f5b86dc 100644
--- a/src/uccsdt/uccsdt.F
+++ b/src/uccsdt/uccsdt.F
@@ -200,15 +200,10 @@ c
 c
 c     Figure out frozen core options
 c
-      if (rtdb_get(rtdb,'uccsdt:frozen core:freeze by atoms',mt_log, 1, 
-     $     status)) then
-         if (.not. geom_num_core(geom,nc(1))) 
-     $        call errquit('semi_direct_uccsd: geom_num_core?',0)
-      else if (rtdb_get(rtdb, 'uccsdt:frozen core', mt_int, 1,
-     $        nc(1))) then
-      else
-         nc(1) = 0
+      if(.not. geom_freeze(rtdb, geom, 'uccsdt', nc(1))) then
+         call errquit('semi_direct_uccsd: unable get get frozen core',0)
       endif
+ 
       nc(2) = nc(1)
 c
 c     From the no. of electrons etc, figure out the no. of occupied
diff --git a/src/util/corr_mk_ref.F b/src/util/corr_mk_ref.F
index cac7cea944..da29b9b02e 100644
--- a/src/util/corr_mk_ref.F
+++ b/src/util/corr_mk_ref.F
@@ -3,7 +3,7 @@ C NAME
 C     Corr_Mk_Ref -- Create reference for correlated calculation
 C
 C REVISION
-C     $Id: corr_mk_ref.F,v 1.10 2001-01-09 20:28:24 edo Exp $
+C     $Id: corr_mk_ref.F,v 1.11 2003-02-20 01:26:28 mhackler Exp $
 C
 C SYNOPSIS
       Logical Function Corr_Mk_Ref(RTDB, Mod, Geom, Basis, DoSCF, 
@@ -335,18 +335,23 @@ C     have complete generality.
 C
 C     First for frozen core
 C
-      Write (Key, '(a,'':'',a,'':'',a)') Mod(1:MLen), 'frozen core',
-     $     'freeze by atoms'
-      Write (Key2, '(a,'':'',a)') Mod(1:MLen), 'frozen core'
-      If ( RTDB_Get(RTDB, Key(1:Inp_StrLen(Key)), MT_Log, 1,
-     $     Status) ) Then
-         If (.NOT. Geom_Num_Core(Geom, NFrzOcc) ) Call ErrQuit(
-     $        'corr_mk_ref: problem with geom_num_core', 0)
-      ElseIf ( RTDB_Get(RTDB, Key2(1:Inp_StrLen(Key2)), MT_Int, 1,
-     $        NFrzOcc) ) Then
-      Else
-         NFrzOcc = 0
-      EndIf
+C      Write (Key, '(a,'':'',a,'':'',a)') Mod(1:MLen), 'frozen core',
+C     $     'freeze by atoms'
+C      Write (Key2, '(a,'':'',a)') Mod(1:MLen), 'frozen core'
+C      If ( RTDB_Get(RTDB, Key(1:Inp_StrLen(Key)), MT_Log, 1,
+C     $     Status) ) Then
+C         If (.NOT. Geom_Num_Core(Geom, NFrzOcc) ) Call ErrQuit(
+C     $        'corr_mk_ref: problem with geom_num_core', 0)
+C      ElseIf ( RTDB_Get(RTDB, Key2(1:Inp_StrLen(Key2)), MT_Int, 1,
+C     $        NFrzOcc) ) Then
+C      Else
+C         NFrzOcc = 0
+C      EndIf
+
+       if(.not. geom_freeze(rtdb, geom, Mod, NFrzOcc)) then
+          call errquit('corr_mk_ref: problem with geom_freeze',0)
+       endif
+
 C
 C     Then for frozen virtuals
 C