comp-chem/NWChem
1
0
Fork 0
mirror of https://github.com/nwchemgit/nwchem.git synced 2026-07-29 06:35:39 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

geom_freeze function call added

Browse source
This commit is contained in:
Mahin Hackler 2003-02-20 01:26:28 +00:00
parent de1d02f721
commit b1a9866ac2
7 changed files with 52 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/ccsd/ccsd_driver.F
View file

@ -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)

4
src/ddscf/localize.F
View file

@ -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

13
src/moints/direct_mp2.F
View file

@ -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

13
src/moints/mointdriver.F
View file

@ -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

27
src/mp2_grad/mp2_energy.F
View file

@ -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))

11
src/uccsdt/uccsdt.F
View file

@ -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

31
src/util/corr_mk_ref.F
View file

@ -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