mirror of
https://github.com/LCPQ/quantum_package
synced 2024-07-23 03:07:34 +02:00
Merge pull request #201 from scemama/master
DIIS in HF + Fixed FCI bugs (correlation_ratio)
This commit is contained in:
commit
73de13320b
@ -4,6 +4,8 @@
|
|||||||
# - sudo apt-get install gfortran liblapack-dev gcc
|
# - sudo apt-get install gfortran liblapack-dev gcc
|
||||||
# - sudo apt-get install graphviz
|
# - sudo apt-get install graphviz
|
||||||
|
|
||||||
|
dist: trusty
|
||||||
|
|
||||||
sudo: false
|
sudo: false
|
||||||
|
|
||||||
addons:
|
addons:
|
||||||
@ -25,7 +27,7 @@ python:
|
|||||||
- "2.6"
|
- "2.6"
|
||||||
|
|
||||||
script:
|
script:
|
||||||
- ./configure --production ./config/travis.cfg
|
- ./configure ./config/travis.cfg
|
||||||
- source ./quantum_package.rc ; qp_module.py install Full_CI Full_CI_ZMQ Hartree_Fock CAS_SD_ZMQ mrcepa0 All_singles
|
- source ./quantum_package.rc ; qp_module.py install Full_CI Full_CI_ZMQ Hartree_Fock CAS_SD_ZMQ mrcepa0 All_singles
|
||||||
- source ./quantum_package.rc ; ninja
|
- source ./quantum_package.rc ; ninja
|
||||||
- source ./quantum_package.rc ; cd ocaml ; make ; cd -
|
- source ./quantum_package.rc ; cd ocaml ; make ; cd -
|
||||||
|
@ -13,7 +13,7 @@
|
|||||||
FC : gfortran -g -ffree-line-length-none -I .
|
FC : gfortran -g -ffree-line-length-none -I .
|
||||||
LAPACK_LIB : -llapack -lblas
|
LAPACK_LIB : -llapack -lblas
|
||||||
IRPF90 : irpf90
|
IRPF90 : irpf90
|
||||||
IRPF90_FLAGS : --ninja --align=32
|
IRPF90_FLAGS : --ninja --align=32 --assert
|
||||||
|
|
||||||
# Global options
|
# Global options
|
||||||
################
|
################
|
||||||
|
63
config/ifort_mpi.cfg
Normal file
63
config/ifort_mpi.cfg
Normal file
@ -0,0 +1,63 @@
|
|||||||
|
# Common flags
|
||||||
|
##############
|
||||||
|
#
|
||||||
|
# -mkl=[parallel|sequential] : Use the MKL library
|
||||||
|
# --ninja : Allow the utilisation of ninja. It is mandatory !
|
||||||
|
# --align=32 : Align all provided arrays on a 32-byte boundary
|
||||||
|
#
|
||||||
|
[COMMON]
|
||||||
|
FC : mpif90
|
||||||
|
LAPACK_LIB : -mkl=parallel
|
||||||
|
IRPF90 : irpf90
|
||||||
|
IRPF90_FLAGS : --ninja --align=32 -DMPI
|
||||||
|
|
||||||
|
# Global options
|
||||||
|
################
|
||||||
|
#
|
||||||
|
# 1 : Activate
|
||||||
|
# 0 : Deactivate
|
||||||
|
#
|
||||||
|
[OPTION]
|
||||||
|
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
|
||||||
|
CACHE : 1 ; Enable cache_compile.py
|
||||||
|
OPENMP : 1 ; Append OpenMP flags
|
||||||
|
|
||||||
|
# Optimization flags
|
||||||
|
####################
|
||||||
|
#
|
||||||
|
# -xHost : Compile a binary optimized for the current architecture
|
||||||
|
# -O2 : O3 not better than O2.
|
||||||
|
# -ip : Inter-procedural optimizations
|
||||||
|
# -ftz : Flushes denormal results to zero
|
||||||
|
#
|
||||||
|
[OPT]
|
||||||
|
FCFLAGS : -xAVX -O2 -ip -ftz -g -traceback
|
||||||
|
|
||||||
|
# Profiling flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
[PROFILE]
|
||||||
|
FC : -p -g
|
||||||
|
FCFLAGS : -xSSE4.2 -O2 -ip -ftz
|
||||||
|
|
||||||
|
# Debugging flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
# -traceback : Activate backtrace on runtime
|
||||||
|
# -fpe0 : All floating point exaceptions
|
||||||
|
# -C : Checks uninitialized variables, array subscripts, etc...
|
||||||
|
# -g : Extra debugging information
|
||||||
|
# -xSSE2 : Valgrind needs a very simple x86 executable
|
||||||
|
#
|
||||||
|
[DEBUG]
|
||||||
|
FC : -g -traceback
|
||||||
|
FCFLAGS : -xSSE2 -C -fpe0
|
||||||
|
IRPF90_FLAGS : --openmp
|
||||||
|
|
||||||
|
# OpenMP flags
|
||||||
|
#################
|
||||||
|
#
|
||||||
|
[OPENMP]
|
||||||
|
FC : -openmp
|
||||||
|
IRPF90_FLAGS : --openmp
|
||||||
|
|
21
configure
vendored
21
configure
vendored
@ -2,7 +2,7 @@
|
|||||||
# -*- coding: utf-8 -*-
|
# -*- coding: utf-8 -*-
|
||||||
"""configure
|
"""configure
|
||||||
|
|
||||||
Usage: configure <config_file> (--production | --development)
|
Usage: configure <config_file>
|
||||||
|
|
||||||
|
|
||||||
Options:
|
Options:
|
||||||
@ -10,18 +10,10 @@ Options:
|
|||||||
config_file A config file with all the information for compiling.
|
config_file A config file with all the information for compiling.
|
||||||
Example config_files are given in config/
|
Example config_files are given in config/
|
||||||
|
|
||||||
--production You can only compile **all** the modules with this flag,
|
|
||||||
but it will compile lighting fast.
|
|
||||||
|
|
||||||
--development this will create a build.ninja for each directory which
|
|
||||||
contains a binary. In a second step you may compile them
|
|
||||||
individually if you like.
|
|
||||||
|
|
||||||
|
|
||||||
Examples:
|
Examples:
|
||||||
|
|
||||||
./configure config/gfortran.cfg --production
|
./configure config/gfortran.cfg
|
||||||
./configure config/ifort.cfg --development
|
./configure config/ifort.cfg
|
||||||
|
|
||||||
|
|
||||||
"""
|
"""
|
||||||
@ -34,10 +26,7 @@ import sys
|
|||||||
|
|
||||||
from os.path import join
|
from os.path import join
|
||||||
|
|
||||||
if not any(i in ["--production", "--development"] for i in sys.argv):
|
if len(sys.argv) != 2:
|
||||||
sys.argv += ["--development"]
|
|
||||||
|
|
||||||
if len(sys.argv) != 3:
|
|
||||||
print __doc__
|
print __doc__
|
||||||
sys.exit()
|
sys.exit()
|
||||||
|
|
||||||
@ -528,7 +517,7 @@ def create_ninja_and_rc(l_installed):
|
|||||||
qp_create_ninja = os.path.join(QP_ROOT, "scripts", "compilation",
|
qp_create_ninja = os.path.join(QP_ROOT, "scripts", "compilation",
|
||||||
"qp_create_ninja.py")
|
"qp_create_ninja.py")
|
||||||
|
|
||||||
l = [qp_create_ninja, "create"] + sys.argv[1:]
|
l = [qp_create_ninja, "create", "--development"] + sys.argv[1:]
|
||||||
|
|
||||||
try:
|
try:
|
||||||
with open('/dev/null', 'w') as dnull:
|
with open('/dev/null', 'w') as dnull:
|
||||||
|
@ -862,7 +862,7 @@ S 9
|
|||||||
4 0.174186 0.435946
|
4 0.174186 0.435946
|
||||||
5 0.312836 -0.008188
|
5 0.312836 -0.008188
|
||||||
6 0.561850 0.049509
|
6 0.561850 0.049509
|
||||||
7 9077 -0.114576
|
7 1.009077 -0.114576
|
||||||
8 1.812290 -0.067207
|
8 1.812290 -0.067207
|
||||||
9 3.254852 0.017250
|
9 3.254852 0.017250
|
||||||
S 1
|
S 1
|
||||||
|
@ -898,7 +898,7 @@ S 9
|
|||||||
4 0.174186 0.435946
|
4 0.174186 0.435946
|
||||||
5 0.312836 -0.008188
|
5 0.312836 -0.008188
|
||||||
6 0.561850 0.049509
|
6 0.561850 0.049509
|
||||||
7 9077 -0.114576
|
7 1.009077 -0.114576
|
||||||
8 1.812290 -0.067207
|
8 1.812290 -0.067207
|
||||||
9 3.254852 0.017250
|
9 3.254852 0.017250
|
||||||
S 1
|
S 1
|
||||||
|
@ -688,7 +688,7 @@ S 9
|
|||||||
4 0.174186 0.435946
|
4 0.174186 0.435946
|
||||||
5 0.312836 -0.008188
|
5 0.312836 -0.008188
|
||||||
6 0.561850 0.049509
|
6 0.561850 0.049509
|
||||||
7 9077 -0.114576
|
7 1.009077 -0.114576
|
||||||
8 1.812290 -0.067207
|
8 1.812290 -0.067207
|
||||||
9 3.254852 0.017250
|
9 3.254852 0.017250
|
||||||
S 1
|
S 1
|
||||||
|
@ -1150,7 +1150,7 @@ S 9
|
|||||||
4 0.174186 0.435946
|
4 0.174186 0.435946
|
||||||
5 0.312836 -0.008188
|
5 0.312836 -0.008188
|
||||||
6 0.561850 0.049509
|
6 0.561850 0.049509
|
||||||
7 9077 -0.114576
|
7 1.009077 -0.114576
|
||||||
8 1.812290 -0.067207
|
8 1.812290 -0.067207
|
||||||
9 3.254852 0.017250
|
9 3.254852 0.017250
|
||||||
S 1
|
S 1
|
||||||
|
457
ocaml/Gamess.ml
Normal file
457
ocaml/Gamess.ml
Normal file
@ -0,0 +1,457 @@
|
|||||||
|
(** CONTRL *)
|
||||||
|
type scftyp_t = RHF | ROHF | MCSCF | NONE
|
||||||
|
let string_of_scftyp = function
|
||||||
|
| RHF -> "RHF"
|
||||||
|
| ROHF -> "ROHF"
|
||||||
|
| MCSCF -> "MCSCF"
|
||||||
|
| NONE -> "NONE"
|
||||||
|
|
||||||
|
type contrl =
|
||||||
|
{ scftyp: scftyp_t ;
|
||||||
|
maxit: int;
|
||||||
|
ispher: int;
|
||||||
|
icharg: int;
|
||||||
|
mult: int;
|
||||||
|
mplevl: int;
|
||||||
|
}
|
||||||
|
|
||||||
|
let string_of_contrl c =
|
||||||
|
Printf.sprintf " $CONTRL
|
||||||
|
EXETYP=RUN COORD=UNIQUE UNITS=ANGS
|
||||||
|
RUNTYP=ENERGY SCFTYP=%s CITYP=NONE
|
||||||
|
MAXIT=%d
|
||||||
|
ISPHER=%d
|
||||||
|
MULT=%d
|
||||||
|
ICHARG=%d
|
||||||
|
MPLEVL=%d
|
||||||
|
$END"
|
||||||
|
(string_of_scftyp c.scftyp)
|
||||||
|
c.maxit c.ispher c.mult c.icharg c.mplevl
|
||||||
|
|
||||||
|
let make_contrl ?(maxit=100) ?(ispher=1) ?(mplevl=0) ~mult ~charge scftyp =
|
||||||
|
{ scftyp ; maxit ; ispher ; mult ; icharg=charge ; mplevl }
|
||||||
|
|
||||||
|
|
||||||
|
(** Vec *)
|
||||||
|
type vec_t =
|
||||||
|
| Canonical of string
|
||||||
|
| Natural of string
|
||||||
|
|
||||||
|
let read_mos guide filename =
|
||||||
|
let text =
|
||||||
|
let ic = open_in filename in
|
||||||
|
let n = in_channel_length ic in
|
||||||
|
let s = Bytes.create n in
|
||||||
|
really_input ic s 0 n;
|
||||||
|
close_in ic;
|
||||||
|
s
|
||||||
|
in
|
||||||
|
|
||||||
|
let re_vec =
|
||||||
|
Str.regexp " \\$VEC *\n"
|
||||||
|
and re_natural =
|
||||||
|
Str.regexp guide
|
||||||
|
and re_end =
|
||||||
|
Str.regexp " \\$END *\n"
|
||||||
|
and re_eol =
|
||||||
|
Str.regexp "\n"
|
||||||
|
in
|
||||||
|
let i =
|
||||||
|
Str.search_forward re_natural text 0
|
||||||
|
in
|
||||||
|
let start =
|
||||||
|
Str.search_forward re_vec text i
|
||||||
|
in
|
||||||
|
let i =
|
||||||
|
Str.search_forward re_end text start
|
||||||
|
in
|
||||||
|
let finish =
|
||||||
|
Str.search_forward re_eol text i
|
||||||
|
in
|
||||||
|
String.sub text start (finish-start)
|
||||||
|
|
||||||
|
let read_until_found f tries =
|
||||||
|
let result =
|
||||||
|
List.fold_left (fun accu x ->
|
||||||
|
match accu with
|
||||||
|
| Some mos -> Some mos
|
||||||
|
| None ->
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Some (read_mos x f)
|
||||||
|
with Not_found ->
|
||||||
|
None
|
||||||
|
end
|
||||||
|
) None tries
|
||||||
|
in
|
||||||
|
match result with
|
||||||
|
| Some mos -> mos
|
||||||
|
| None -> raise Not_found
|
||||||
|
|
||||||
|
let read_natural_mos f =
|
||||||
|
let tries = [
|
||||||
|
"--- NATURAL ORBITALS OF MCSCF ---" ;
|
||||||
|
"MP2 NATURAL ORBITALS" ]
|
||||||
|
in
|
||||||
|
read_until_found f tries
|
||||||
|
|
||||||
|
let read_canonical_mos f =
|
||||||
|
let tries = [
|
||||||
|
"--- OPTIMIZED MCSCF MO-S ---" ;
|
||||||
|
"--- CLOSED SHELL ORBITALS ---" ;
|
||||||
|
"--- OPEN SHELL ORBITALS ---"
|
||||||
|
]
|
||||||
|
in
|
||||||
|
read_until_found f tries
|
||||||
|
|
||||||
|
let string_of_vec = function
|
||||||
|
| Natural filename -> read_natural_mos filename
|
||||||
|
| Canonical filename -> read_canonical_mos filename
|
||||||
|
|
||||||
|
(** GUESS *)
|
||||||
|
type guess_t =
|
||||||
|
| Huckel
|
||||||
|
| Hcore
|
||||||
|
| Canonical of (int*string)
|
||||||
|
| Natural of (int*string)
|
||||||
|
|
||||||
|
let guess_of_string s =
|
||||||
|
match String.lowercase s with
|
||||||
|
| "huckel" -> Huckel
|
||||||
|
| "hcore" -> Hcore
|
||||||
|
| _ -> raise (Invalid_argument "Bad MO guess")
|
||||||
|
|
||||||
|
let string_of_guess g =
|
||||||
|
[
|
||||||
|
" $GUESS\n" ; " GUESS=" ;
|
||||||
|
begin
|
||||||
|
match g with
|
||||||
|
| Hcore -> "HCORE\n"
|
||||||
|
| Huckel -> "HUCKEL\n"
|
||||||
|
| Canonical (norb,_) | Natural (norb,_) -> Printf.sprintf "MOREAD\n NORB=%d\n" norb
|
||||||
|
end
|
||||||
|
; " $END" ;
|
||||||
|
match g with
|
||||||
|
| Hcore
|
||||||
|
| Huckel -> ""
|
||||||
|
| Natural (_,filename) -> "\n\n"^(string_of_vec (Natural filename))
|
||||||
|
| Canonical (_,filename) ->"\n\n"^(string_of_vec (Canonical filename))
|
||||||
|
] |> String.concat ""
|
||||||
|
|
||||||
|
|
||||||
|
(** BASIS *)
|
||||||
|
let string_of_basis =
|
||||||
|
Printf.sprintf " $BASIS
|
||||||
|
GBASIS=%s
|
||||||
|
$END"
|
||||||
|
|
||||||
|
|
||||||
|
(** DATA *)
|
||||||
|
type coord_t =
|
||||||
|
| Atom of Element.t
|
||||||
|
| Diatomic_homo of (Element.t*float)
|
||||||
|
| Diatomic of (Element.t*Element.t*float)
|
||||||
|
| Xyz of (Element.t*float*float*float) list
|
||||||
|
|
||||||
|
|
||||||
|
type data_t =
|
||||||
|
{ sym: Sym.t ;
|
||||||
|
title: string;
|
||||||
|
xyz: string;
|
||||||
|
nucl_charge: int;
|
||||||
|
}
|
||||||
|
|
||||||
|
let data_of_atom ele =
|
||||||
|
let atom =
|
||||||
|
Element.to_string ele
|
||||||
|
in
|
||||||
|
let charge =
|
||||||
|
Element.to_charge ele
|
||||||
|
|> Charge.to_int
|
||||||
|
in
|
||||||
|
{ sym=Sym.D4h ;
|
||||||
|
title=Printf.sprintf "%s" atom ;
|
||||||
|
xyz=Printf.sprintf "%s %d.0 0. 0. 0." atom charge ;
|
||||||
|
nucl_charge = charge
|
||||||
|
}
|
||||||
|
|
||||||
|
let data_of_diatomic_homo ele r =
|
||||||
|
assert (r > 0.);
|
||||||
|
let atom =
|
||||||
|
Element.to_string ele
|
||||||
|
in
|
||||||
|
let charge =
|
||||||
|
Element.to_charge ele
|
||||||
|
|> Charge.to_int
|
||||||
|
in
|
||||||
|
{ sym=Sym.D4h ;
|
||||||
|
title=Printf.sprintf "%s2" atom ;
|
||||||
|
xyz=Printf.sprintf "%s %d.0 0. 0. %f" atom charge (-.r *. 0.5) ;
|
||||||
|
nucl_charge = 2*charge
|
||||||
|
}
|
||||||
|
|
||||||
|
let data_of_diatomic ele1 ele2 r =
|
||||||
|
assert (r > 0.);
|
||||||
|
let atom1, atom2 =
|
||||||
|
Element.to_string ele1,
|
||||||
|
Element.to_string ele2
|
||||||
|
in
|
||||||
|
let charge1, charge2 =
|
||||||
|
Charge.to_int @@ Element.to_charge ele1,
|
||||||
|
Charge.to_int @@ Element.to_charge ele2
|
||||||
|
in
|
||||||
|
{ sym=Sym.C4v ;
|
||||||
|
title=Printf.sprintf "%s%s" atom1 atom2 ;
|
||||||
|
xyz=Printf.sprintf "%s %d.0 0. 0. 0.\n%s %d.0 0. 0. %f"
|
||||||
|
atom1 charge1 atom2 charge2 r ;
|
||||||
|
nucl_charge = charge1 + charge2
|
||||||
|
}
|
||||||
|
|
||||||
|
let data_of_xyz l =
|
||||||
|
{ sym = Sym.C1 ;
|
||||||
|
title = "..." ;
|
||||||
|
xyz = String.concat "\n" (
|
||||||
|
List.map (fun (e,x,y,z) -> Printf.sprintf "%s %f %f %f %f"
|
||||||
|
(Element.to_string e) (Element.to_charge e)
|
||||||
|
x y z) l ) ;
|
||||||
|
nucl_charge = List.fold_left (fun accu (e,_,_,_) ->
|
||||||
|
accu + (int_of_float @@ Element.to_charge e) ) 0 l
|
||||||
|
}
|
||||||
|
|
||||||
|
let make_data = function
|
||||||
|
| Atom ele -> data_of_atom ele
|
||||||
|
| Diatomic_homo (ele,r) -> data_of_diatomic_homo ele r
|
||||||
|
| Diatomic (ele1,ele2,r) -> data_of_diatomic ele1 ele2 r
|
||||||
|
| Xyz l -> data_of_xyz l
|
||||||
|
|
||||||
|
let string_of_data d =
|
||||||
|
String.concat "\n" [ " $DATA" ;
|
||||||
|
d.title ;
|
||||||
|
Sym.to_data d.sym ;
|
||||||
|
] ^ d.xyz ^ "\n $END"
|
||||||
|
|
||||||
|
|
||||||
|
(** GUGDM *)
|
||||||
|
type gugdm2_t = int
|
||||||
|
|
||||||
|
let string_of_gugdm2 = function
|
||||||
|
| 1 -> ""
|
||||||
|
| i when i<1 -> raise (Invalid_argument "Nstates must be > 0")
|
||||||
|
| i ->
|
||||||
|
let s =
|
||||||
|
Array.make i "1."
|
||||||
|
|> Array.to_list
|
||||||
|
|> String.concat ","
|
||||||
|
in
|
||||||
|
Printf.sprintf "
|
||||||
|
$GUGDM2
|
||||||
|
WSTATE(1)=%s
|
||||||
|
$END
|
||||||
|
" s
|
||||||
|
|
||||||
|
|
||||||
|
type gugdia_t =
|
||||||
|
{ nstate : int ;
|
||||||
|
itermx : int ;
|
||||||
|
}
|
||||||
|
|
||||||
|
let string_of_gugdia g =
|
||||||
|
Printf.sprintf "
|
||||||
|
$GUGDIA
|
||||||
|
PRTTOL=0.0001
|
||||||
|
NSTATE=%d
|
||||||
|
ITERMX=%d
|
||||||
|
$END
|
||||||
|
" g.nstate g.itermx
|
||||||
|
|
||||||
|
|
||||||
|
let make_gugdia ?(itermx=500) nstate =
|
||||||
|
assert (nstate > 0);
|
||||||
|
assert (itermx > 1);
|
||||||
|
{ nstate ; itermx }
|
||||||
|
|
||||||
|
|
||||||
|
(** MCSCF *)
|
||||||
|
type mcscf_t = FULLNR | SOSCF | FOCAS
|
||||||
|
|
||||||
|
let string_of_mcscf m =
|
||||||
|
" $MCSCF\n" ^
|
||||||
|
begin
|
||||||
|
match m with
|
||||||
|
| FOCAS -> " FOCAS=.T. SOSCF=.F. FULLNR=.F."
|
||||||
|
| SOSCF -> " FOCAS=.F. SOSCF=.T. FULLNR=.F."
|
||||||
|
| FULLNR -> " FOCAS=.F. SOSCF=.F. FULLNR=.T."
|
||||||
|
end ^ "
|
||||||
|
CISTEP=GUGA EKT=.F. QUAD=.F. JACOBI=.f.
|
||||||
|
MAXIT=1000
|
||||||
|
$END"
|
||||||
|
|
||||||
|
|
||||||
|
type drt_t =
|
||||||
|
{ nmcc: int ;
|
||||||
|
ndoc: int ;
|
||||||
|
nalp: int ;
|
||||||
|
nval: int ;
|
||||||
|
istsym: int;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
let make_drt ?(istsym=1) n_elec_alpha n_elec_beta n_e n_act =
|
||||||
|
let n_elec_tot =
|
||||||
|
n_elec_alpha + n_elec_beta
|
||||||
|
in
|
||||||
|
let nmcc =
|
||||||
|
(n_elec_tot - n_e)/2
|
||||||
|
in
|
||||||
|
let ndoc =
|
||||||
|
n_elec_beta - nmcc
|
||||||
|
in
|
||||||
|
let nalp =
|
||||||
|
(n_elec_alpha - nmcc - ndoc)
|
||||||
|
in
|
||||||
|
let nval =
|
||||||
|
n_act - ndoc - nalp
|
||||||
|
in
|
||||||
|
{ nmcc ; ndoc ; nalp ; nval ; istsym }
|
||||||
|
|
||||||
|
let string_of_drt drt sym =
|
||||||
|
Printf.sprintf " $DRT
|
||||||
|
NMCC=%d
|
||||||
|
NDOC=%d
|
||||||
|
NALP=%d
|
||||||
|
NVAL=%d
|
||||||
|
NEXT=0
|
||||||
|
ISTSYM=%d
|
||||||
|
FORS=.TRUE.
|
||||||
|
GROUP=C1
|
||||||
|
MXNINT= 600000
|
||||||
|
NPRT=2
|
||||||
|
$END"
|
||||||
|
drt.nmcc drt.ndoc drt.nalp drt.nval drt.istsym
|
||||||
|
|
||||||
|
(** MP2 *)
|
||||||
|
let string_of_mp2 = " $MP2
|
||||||
|
MP2PRP=.TRUE.
|
||||||
|
$END"
|
||||||
|
|
||||||
|
|
||||||
|
(** Computation *)
|
||||||
|
type computation = HF | MP2 | CAS of (int*int)
|
||||||
|
|
||||||
|
type system =
|
||||||
|
{ mult: int ; charge: int ; basis: string ; coord: coord_t }
|
||||||
|
|
||||||
|
let n_elec system =
|
||||||
|
let data =
|
||||||
|
make_data system.coord
|
||||||
|
in
|
||||||
|
data.nucl_charge - system.charge
|
||||||
|
|
||||||
|
let n_elec_alpha_beta system =
|
||||||
|
let n =
|
||||||
|
n_elec system
|
||||||
|
and m =
|
||||||
|
system.mult
|
||||||
|
in
|
||||||
|
let alpha =
|
||||||
|
(n+m-1)/2
|
||||||
|
in
|
||||||
|
let beta =
|
||||||
|
n - alpha
|
||||||
|
in
|
||||||
|
(alpha, beta)
|
||||||
|
|
||||||
|
|
||||||
|
let create_single_det_input ~mp2 ~guess ?(vecfile="") s =
|
||||||
|
let scftyp =
|
||||||
|
match s.mult with
|
||||||
|
| 1 -> RHF
|
||||||
|
| _ -> ROHF
|
||||||
|
and mult = s.mult
|
||||||
|
and charge = s.charge
|
||||||
|
and n_elec_alpha, _ =
|
||||||
|
n_elec_alpha_beta s
|
||||||
|
and mplevl =
|
||||||
|
if mp2 then 2 else 0
|
||||||
|
in
|
||||||
|
[
|
||||||
|
make_contrl ~mult ~charge ~mplevl scftyp
|
||||||
|
|> string_of_contrl
|
||||||
|
;
|
||||||
|
begin
|
||||||
|
match vecfile with
|
||||||
|
| "" -> string_of_guess guess
|
||||||
|
| vecfile -> string_of_guess (Canonical (n_elec_alpha, vecfile))
|
||||||
|
end
|
||||||
|
;
|
||||||
|
string_of_basis s.basis
|
||||||
|
;
|
||||||
|
if mp2 then
|
||||||
|
string_of_mp2
|
||||||
|
else
|
||||||
|
""
|
||||||
|
;
|
||||||
|
make_data s.coord
|
||||||
|
|> string_of_data
|
||||||
|
] |> String.concat "\n\n"
|
||||||
|
|
||||||
|
|
||||||
|
let create_hf_input ~guess =
|
||||||
|
create_single_det_input ~mp2:false ~guess
|
||||||
|
|
||||||
|
let create_mp2_input ~guess =
|
||||||
|
create_single_det_input ~mp2:true ~guess
|
||||||
|
|
||||||
|
|
||||||
|
let create_cas_input ?(vecfile="") ~guess ~nstate s n_e n_a =
|
||||||
|
let scftyp = MCSCF
|
||||||
|
and mult = s.mult
|
||||||
|
and charge = s.charge
|
||||||
|
in
|
||||||
|
let n_elec_alpha, n_elec_beta =
|
||||||
|
n_elec_alpha_beta s
|
||||||
|
in
|
||||||
|
let drt =
|
||||||
|
make_drt n_elec_alpha n_elec_beta n_e n_a
|
||||||
|
in
|
||||||
|
let data =
|
||||||
|
make_data s.coord
|
||||||
|
in
|
||||||
|
[
|
||||||
|
make_contrl ~mult ~charge scftyp
|
||||||
|
|> string_of_contrl
|
||||||
|
;
|
||||||
|
begin
|
||||||
|
match vecfile with
|
||||||
|
| "" -> string_of_guess guess
|
||||||
|
| vecfile ->
|
||||||
|
let norb =
|
||||||
|
drt.nmcc + drt.ndoc + drt.nval + drt.nalp
|
||||||
|
in
|
||||||
|
try
|
||||||
|
string_of_guess (Natural (norb, vecfile))
|
||||||
|
with Not_found ->
|
||||||
|
string_of_guess (Canonical (norb, vecfile))
|
||||||
|
end
|
||||||
|
;
|
||||||
|
string_of_basis s.basis
|
||||||
|
;
|
||||||
|
string_of_mcscf FULLNR
|
||||||
|
;
|
||||||
|
string_of_drt drt data.sym
|
||||||
|
;
|
||||||
|
make_gugdia nstate
|
||||||
|
|> string_of_gugdia
|
||||||
|
;
|
||||||
|
string_of_gugdm2 nstate
|
||||||
|
;
|
||||||
|
string_of_data data
|
||||||
|
] |> String.concat "\n\n"
|
||||||
|
|
||||||
|
|
||||||
|
let create_input ?(vecfile="") ?(guess=Huckel) ~system ~nstate = function
|
||||||
|
| HF -> create_hf_input ~vecfile ~guess system
|
||||||
|
| MP2 -> create_mp2_input ~vecfile ~guess system
|
||||||
|
| CAS (n_e,n_a) -> create_cas_input ~vecfile ~nstate ~guess system n_e n_a
|
||||||
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
|||||||
open Qptypes;;
|
open Qptypes
|
||||||
open Core.Std;;
|
open Core.Std
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ sym : Symmetry.t ;
|
{ sym : Symmetry.t ;
|
||||||
@ -11,8 +11,7 @@ let to_string p =
|
|||||||
Printf.sprintf "(%s, %f)"
|
Printf.sprintf "(%s, %f)"
|
||||||
(Symmetry.to_string s)
|
(Symmetry.to_string s)
|
||||||
(AO_expo.to_float e)
|
(AO_expo.to_float e)
|
||||||
;;
|
|
||||||
|
|
||||||
let of_sym_expo s e =
|
let of_sym_expo s e =
|
||||||
{ sym=s ; expo=e}
|
{ sym=s ; expo=e}
|
||||||
;;
|
|
12
ocaml/Gto.ml
12
ocaml/Gto.ml
@ -10,17 +10,17 @@ type fmt =
|
|||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ sym : Symmetry.t ;
|
{ sym : Symmetry.t ;
|
||||||
lc : ((Primitive.t * AO_coef.t) list)
|
lc : ((GaussianPrimitive.t * AO_coef.t) list)
|
||||||
} with sexp
|
} with sexp
|
||||||
|
|
||||||
|
|
||||||
let of_prim_coef_list pc =
|
let of_prim_coef_list pc =
|
||||||
let (p,c) = List.hd_exn pc in
|
let (p,c) = List.hd_exn pc in
|
||||||
let sym = p.Primitive.sym in
|
let sym = p.GaussianPrimitive.sym in
|
||||||
let rec check = function
|
let rec check = function
|
||||||
| [] -> `OK
|
| [] -> `OK
|
||||||
| (p,c)::tl ->
|
| (p,c)::tl ->
|
||||||
if p.Primitive.sym <> sym then
|
if p.GaussianPrimitive.sym <> sym then
|
||||||
`Failed
|
`Failed
|
||||||
else
|
else
|
||||||
check tl
|
check tl
|
||||||
@ -59,7 +59,7 @@ let read_one in_channel =
|
|||||||
let coef = String.tr ~target:'D' ~replacement:'e' coef
|
let coef = String.tr ~target:'D' ~replacement:'e' coef
|
||||||
in
|
in
|
||||||
let p =
|
let p =
|
||||||
Primitive.of_sym_expo sym
|
GaussianPrimitive.of_sym_expo sym
|
||||||
(AO_expo.of_float (Float.of_string expo) )
|
(AO_expo.of_float (Float.of_string expo) )
|
||||||
and c = AO_coef.of_float (Float.of_string coef) in
|
and c = AO_coef.of_float (Float.of_string coef) in
|
||||||
read_lines ( (p,c)::result) (i-1)
|
read_lines ( (p,c)::result) (i-1)
|
||||||
@ -80,7 +80,7 @@ let to_string_gamess { sym = sym ; lc = lc } =
|
|||||||
let rec do_work accu i = function
|
let rec do_work accu i = function
|
||||||
| [] -> List.rev accu
|
| [] -> List.rev accu
|
||||||
| (p,c)::tail ->
|
| (p,c)::tail ->
|
||||||
let p = AO_expo.to_float p.Primitive.expo
|
let p = AO_expo.to_float p.GaussianPrimitive.expo
|
||||||
and c = AO_coef.to_float c
|
and c = AO_coef.to_float c
|
||||||
in
|
in
|
||||||
let result =
|
let result =
|
||||||
@ -100,7 +100,7 @@ let to_string_gaussian { sym = sym ; lc = lc } =
|
|||||||
let rec do_work accu i = function
|
let rec do_work accu i = function
|
||||||
| [] -> List.rev accu
|
| [] -> List.rev accu
|
||||||
| (p,c)::tail ->
|
| (p,c)::tail ->
|
||||||
let p = AO_expo.to_float p.Primitive.expo
|
let p = AO_expo.to_float p.GaussianPrimitive.expo
|
||||||
and c = AO_coef.to_float c
|
and c = AO_coef.to_float c
|
||||||
in
|
in
|
||||||
let result =
|
let result =
|
||||||
|
@ -6,12 +6,12 @@ type fmt =
|
|||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ sym : Symmetry.t ;
|
{ sym : Symmetry.t ;
|
||||||
lc : (Primitive.t * Qptypes.AO_coef.t) list;
|
lc : (GaussianPrimitive.t * Qptypes.AO_coef.t) list;
|
||||||
} with sexp
|
} with sexp
|
||||||
|
|
||||||
(** Create from a list of Primitive.t * Qptypes.AO_coef.t *)
|
(** Create from a list of GaussianPrimitive.t * Qptypes.AO_coef.t *)
|
||||||
val of_prim_coef_list :
|
val of_prim_coef_list :
|
||||||
(Primitive.t * Qptypes.AO_coef.t) list -> t
|
(GaussianPrimitive.t * Qptypes.AO_coef.t) list -> t
|
||||||
|
|
||||||
(** Read from a file *)
|
(** Read from a file *)
|
||||||
val read_one : in_channel -> t
|
val read_one : in_channel -> t
|
||||||
|
@ -112,8 +112,8 @@ end = struct
|
|||||||
let s = Symmetry.Xyz.to_symmetry b.ao_power.(i) in
|
let s = Symmetry.Xyz.to_symmetry b.ao_power.(i) in
|
||||||
let ao_prim_num = AO_prim_number.to_int b.ao_prim_num.(i) in
|
let ao_prim_num = AO_prim_number.to_int b.ao_prim_num.(i) in
|
||||||
let prims = List.init ao_prim_num ~f:(fun j ->
|
let prims = List.init ao_prim_num ~f:(fun j ->
|
||||||
let prim = { Primitive.sym = s ;
|
let prim = { GaussianPrimitive.sym = s ;
|
||||||
Primitive.expo = b.ao_expo.(ao_num*j+i)
|
GaussianPrimitive.expo = b.ao_expo.(ao_num*j+i)
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
let coef = b.ao_coef.(ao_num*j+i) in
|
let coef = b.ao_coef.(ao_num*j+i) in
|
||||||
|
@ -1,32 +1,32 @@
|
|||||||
open Qptypes;;
|
open Qptypes
|
||||||
open Qputils;;
|
open Qputils
|
||||||
open Core.Std;;
|
open Core.Std
|
||||||
|
|
||||||
type t_mo =
|
type t_mo =
|
||||||
{ mo_tot_num : MO_number.t ;
|
{ mo_tot_num : MO_number.t ;
|
||||||
mo_label : MO_label.t;
|
mo_label : MO_label.t;
|
||||||
mo_occ : MO_occ.t array;
|
mo_class : MO_class.t array;
|
||||||
mo_coef : (MO_coef.t array) array;
|
mo_occ : MO_occ.t array;
|
||||||
ao_md5 : MD5.t;
|
mo_coef : (MO_coef.t array) array;
|
||||||
} with sexp
|
ao_md5 : MD5.t;
|
||||||
|
} with sexp
|
||||||
|
|
||||||
module Mo_basis : sig
|
module Mo_basis : sig
|
||||||
type t = t_mo
|
type t = t_mo
|
||||||
val read : unit -> t option
|
val read : unit -> t option
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
val to_rst : t -> Rst_string.t
|
val to_rst : t -> Rst_string.t
|
||||||
end = struct
|
end = struct
|
||||||
type t = t_mo
|
type t = t_mo
|
||||||
|
let get_default = Qpackage.get_ezfio_default "mo_basis"
|
||||||
let get_default = Qpackage.get_ezfio_default "mo_basis";;
|
|
||||||
|
|
||||||
let read_mo_label () =
|
let read_mo_label () =
|
||||||
if not (Ezfio.has_mo_basis_mo_label ()) then
|
if not (Ezfio.has_mo_basis_mo_label ()) then
|
||||||
Ezfio.set_mo_basis_mo_label "None"
|
Ezfio.set_mo_basis_mo_label "None"
|
||||||
;
|
;
|
||||||
Ezfio.get_mo_basis_mo_label ()
|
Ezfio.get_mo_basis_mo_label ()
|
||||||
|> MO_label.of_string
|
|> MO_label.of_string
|
||||||
;;
|
|
||||||
|
|
||||||
let read_ao_md5 () =
|
let read_ao_md5 () =
|
||||||
let ao_md5 =
|
let ao_md5 =
|
||||||
@ -46,12 +46,28 @@ end = struct
|
|||||||
if (ao_md5 <> result) then
|
if (ao_md5 <> result) then
|
||||||
failwith "The current MOs don't correspond to the current AOs.";
|
failwith "The current MOs don't correspond to the current AOs.";
|
||||||
result
|
result
|
||||||
;;
|
|
||||||
|
|
||||||
let read_mo_tot_num () =
|
let read_mo_tot_num () =
|
||||||
Ezfio.get_mo_basis_mo_tot_num ()
|
Ezfio.get_mo_basis_mo_tot_num ()
|
||||||
|> MO_number.of_int
|
|> MO_number.of_int
|
||||||
;;
|
|
||||||
|
|
||||||
|
let read_mo_class () =
|
||||||
|
if not (Ezfio.has_mo_basis_mo_class ()) then
|
||||||
|
begin
|
||||||
|
let mo_tot_num = MO_number.to_int (read_mo_tot_num ()) in
|
||||||
|
let data =
|
||||||
|
Array.init mo_tot_num ~f:(fun _ -> MO_class.(to_string (Active [])))
|
||||||
|
|> Array.to_list
|
||||||
|
in
|
||||||
|
Ezfio.ezfio_array_of_list ~rank:1
|
||||||
|
~dim:[| mo_tot_num |] ~data:data
|
||||||
|
|> Ezfio.set_mo_basis_mo_class
|
||||||
|
end;
|
||||||
|
Ezfio.flattened_ezfio (Ezfio.get_mo_basis_mo_class () )
|
||||||
|
|> Array.map ~f:MO_class.of_string
|
||||||
|
|
||||||
|
|
||||||
let read_mo_occ () =
|
let read_mo_occ () =
|
||||||
if not (Ezfio.has_mo_basis_mo_label ()) then
|
if not (Ezfio.has_mo_basis_mo_label ()) then
|
||||||
@ -60,41 +76,42 @@ end = struct
|
|||||||
and elec_beta_num = Ezfio.get_electrons_elec_beta_num ()
|
and elec_beta_num = Ezfio.get_electrons_elec_beta_num ()
|
||||||
and mo_tot_num = MO_number.to_int (read_mo_tot_num ()) in
|
and mo_tot_num = MO_number.to_int (read_mo_tot_num ()) in
|
||||||
let data = Array.init mo_tot_num ~f:(fun i ->
|
let data = Array.init mo_tot_num ~f:(fun i ->
|
||||||
if (i<elec_beta_num) then 2.
|
if (i<elec_beta_num) then 2.
|
||||||
else if (i < elec_alpha_num) then 1.
|
else if (i < elec_alpha_num) then 1.
|
||||||
else 0.) |> Array.to_list in
|
else 0.) |> Array.to_list in
|
||||||
Ezfio.ezfio_array_of_list ~rank:1
|
Ezfio.ezfio_array_of_list ~rank:1
|
||||||
~dim:[| mo_tot_num |] ~data:data
|
~dim:[| mo_tot_num |] ~data:data
|
||||||
|> Ezfio.set_mo_basis_mo_occ
|
|> Ezfio.set_mo_basis_mo_occ
|
||||||
end;
|
end;
|
||||||
Ezfio.flattened_ezfio (Ezfio.get_mo_basis_mo_occ () )
|
Ezfio.flattened_ezfio (Ezfio.get_mo_basis_mo_occ () )
|
||||||
|> Array.map ~f:MO_occ.of_float
|
|> Array.map ~f:MO_occ.of_float
|
||||||
;;
|
|
||||||
|
|
||||||
let read_mo_coef () =
|
let read_mo_coef () =
|
||||||
let a = Ezfio.get_mo_basis_mo_coef ()
|
let a = Ezfio.get_mo_basis_mo_coef ()
|
||||||
|> Ezfio.flattened_ezfio
|
|> Ezfio.flattened_ezfio
|
||||||
|> Array.map ~f:MO_coef.of_float
|
|> Array.map ~f:MO_coef.of_float
|
||||||
in
|
in
|
||||||
let mo_tot_num = read_mo_tot_num () |> MO_number.to_int in
|
let mo_tot_num = read_mo_tot_num () |> MO_number.to_int in
|
||||||
let ao_num = (Array.length a)/mo_tot_num in
|
let ao_num = (Array.length a)/mo_tot_num in
|
||||||
Array.init mo_tot_num ~f:(fun j ->
|
Array.init mo_tot_num ~f:(fun j ->
|
||||||
Array.sub ~pos:(j*ao_num) ~len:(ao_num) a
|
Array.sub ~pos:(j*ao_num) ~len:(ao_num) a
|
||||||
)
|
)
|
||||||
;;
|
|
||||||
|
|
||||||
let read () =
|
let read () =
|
||||||
if (Ezfio.has_mo_basis_mo_tot_num ()) then
|
if (Ezfio.has_mo_basis_mo_tot_num ()) then
|
||||||
Some
|
Some
|
||||||
{ mo_tot_num = read_mo_tot_num ();
|
{ mo_tot_num = read_mo_tot_num ();
|
||||||
mo_label = read_mo_label () ;
|
mo_label = read_mo_label () ;
|
||||||
mo_occ = read_mo_occ ();
|
mo_class = read_mo_class ();
|
||||||
mo_coef = read_mo_coef ();
|
mo_occ = read_mo_occ ();
|
||||||
ao_md5 = read_ao_md5 ();
|
mo_coef = read_mo_coef ();
|
||||||
}
|
ao_md5 = read_ao_md5 ();
|
||||||
|
}
|
||||||
else
|
else
|
||||||
None
|
None
|
||||||
;;
|
|
||||||
|
|
||||||
let mo_coef_to_string mo_coef =
|
let mo_coef_to_string mo_coef =
|
||||||
let ao_num = Array.length mo_coef.(0)
|
let ao_num = Array.length mo_coef.(0)
|
||||||
@ -102,53 +119,53 @@ end = struct
|
|||||||
let rec print_five imin imax =
|
let rec print_five imin imax =
|
||||||
match (imax-imin+1) with
|
match (imax-imin+1) with
|
||||||
| 1 ->
|
| 1 ->
|
||||||
let header = [ Printf.sprintf " #%15d" (imin+1) ; ] in
|
let header = [ Printf.sprintf " #%15d" (imin+1) ; ] in
|
||||||
let new_lines =
|
let new_lines =
|
||||||
List.init ao_num ~f:(fun i ->
|
List.init ao_num ~f:(fun i ->
|
||||||
Printf.sprintf " %3d %15.10f " (i+1)
|
Printf.sprintf " %3d %15.10f " (i+1)
|
||||||
(MO_coef.to_float mo_coef.(imin ).(i)) )
|
(MO_coef.to_float mo_coef.(imin ).(i)) )
|
||||||
in header @ new_lines
|
in header @ new_lines
|
||||||
| 2 ->
|
| 2 ->
|
||||||
let header = [ Printf.sprintf " #%15d %15d" (imin+1) (imin+2) ; ] in
|
let header = [ Printf.sprintf " #%15d %15d" (imin+1) (imin+2) ; ] in
|
||||||
let new_lines =
|
let new_lines =
|
||||||
List.init ao_num ~f:(fun i ->
|
List.init ao_num ~f:(fun i ->
|
||||||
Printf.sprintf " %3d %15.10f %15.10f" (i+1)
|
Printf.sprintf " %3d %15.10f %15.10f" (i+1)
|
||||||
(MO_coef.to_float mo_coef.(imin ).(i))
|
(MO_coef.to_float mo_coef.(imin ).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+1).(i)) )
|
(MO_coef.to_float mo_coef.(imin+1).(i)) )
|
||||||
in header @ new_lines
|
in header @ new_lines
|
||||||
| 3 ->
|
| 3 ->
|
||||||
let header = [ Printf.sprintf " #%15d %15d %15d"
|
let header = [ Printf.sprintf " #%15d %15d %15d"
|
||||||
(imin+1) (imin+2) (imin+3); ] in
|
(imin+1) (imin+2) (imin+3); ] in
|
||||||
let new_lines =
|
let new_lines =
|
||||||
List.init ao_num ~f:(fun i ->
|
List.init ao_num ~f:(fun i ->
|
||||||
Printf.sprintf " %3d %15.10f %15.10f %15.10f" (i+1)
|
Printf.sprintf " %3d %15.10f %15.10f %15.10f" (i+1)
|
||||||
(MO_coef.to_float mo_coef.(imin ).(i))
|
(MO_coef.to_float mo_coef.(imin ).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+1).(i))
|
(MO_coef.to_float mo_coef.(imin+1).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+2).(i)) )
|
(MO_coef.to_float mo_coef.(imin+2).(i)) )
|
||||||
in header @ new_lines
|
in header @ new_lines
|
||||||
| 4 ->
|
| 4 ->
|
||||||
let header = [ Printf.sprintf " #%15d %15d %15d %15d"
|
let header = [ Printf.sprintf " #%15d %15d %15d %15d"
|
||||||
(imin+1) (imin+2) (imin+3) (imin+4) ; ] in
|
(imin+1) (imin+2) (imin+3) (imin+4) ; ] in
|
||||||
let new_lines =
|
let new_lines =
|
||||||
List.init ao_num ~f:(fun i ->
|
List.init ao_num ~f:(fun i ->
|
||||||
Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f" (i+1)
|
Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f" (i+1)
|
||||||
(MO_coef.to_float mo_coef.(imin ).(i))
|
(MO_coef.to_float mo_coef.(imin ).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+1).(i))
|
(MO_coef.to_float mo_coef.(imin+1).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+2).(i))
|
(MO_coef.to_float mo_coef.(imin+2).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+3).(i)) )
|
(MO_coef.to_float mo_coef.(imin+3).(i)) )
|
||||||
in header @ new_lines
|
in header @ new_lines
|
||||||
| 5 ->
|
| 5 ->
|
||||||
let header = [ Printf.sprintf " #%15d %15d %15d %15d %15d"
|
let header = [ Printf.sprintf " #%15d %15d %15d %15d %15d"
|
||||||
(imin+1) (imin+2) (imin+3) (imin+4) (imin+5) ; ] in
|
(imin+1) (imin+2) (imin+3) (imin+4) (imin+5) ; ] in
|
||||||
let new_lines =
|
let new_lines =
|
||||||
List.init ao_num ~f:(fun i ->
|
List.init ao_num ~f:(fun i ->
|
||||||
Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f %15.10f" (i+1)
|
Printf.sprintf " %3d %15.10f %15.10f %15.10f %15.10f %15.10f" (i+1)
|
||||||
(MO_coef.to_float mo_coef.(imin ).(i))
|
(MO_coef.to_float mo_coef.(imin ).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+1).(i))
|
(MO_coef.to_float mo_coef.(imin+1).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+2).(i))
|
(MO_coef.to_float mo_coef.(imin+2).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+3).(i))
|
(MO_coef.to_float mo_coef.(imin+3).(i))
|
||||||
(MO_coef.to_float mo_coef.(imin+4).(i)) )
|
(MO_coef.to_float mo_coef.(imin+4).(i)) )
|
||||||
in header @ new_lines
|
in header @ new_lines
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
in
|
in
|
||||||
let rec create_list accu i =
|
let rec create_list accu i =
|
||||||
@ -158,7 +175,7 @@ end = struct
|
|||||||
(print_five i (mo_tot_num-1) |> String.concat ~sep:"\n")::accu |> List.rev
|
(print_five i (mo_tot_num-1) |> String.concat ~sep:"\n")::accu |> List.rev
|
||||||
in
|
in
|
||||||
create_list [] 0 |> String.concat ~sep:"\n\n"
|
create_list [] 0 |> String.concat ~sep:"\n\n"
|
||||||
;;
|
|
||||||
|
|
||||||
let to_rst b =
|
let to_rst b =
|
||||||
Printf.sprintf "
|
Printf.sprintf "
|
||||||
@ -174,29 +191,32 @@ MO coefficients ::
|
|||||||
|
|
||||||
%s
|
%s
|
||||||
"
|
"
|
||||||
(MO_label.to_string b.mo_label)
|
(MO_label.to_string b.mo_label)
|
||||||
(MO_number.to_string b.mo_tot_num)
|
(MO_number.to_string b.mo_tot_num)
|
||||||
(mo_coef_to_string b.mo_coef)
|
(mo_coef_to_string b.mo_coef)
|
||||||
|> Rst_string.of_string
|
|> Rst_string.of_string
|
||||||
|
|
||||||
;;
|
|
||||||
|
|
||||||
let to_string b =
|
let to_string b =
|
||||||
Printf.sprintf "
|
Printf.sprintf "
|
||||||
mo_label = %s
|
mo_label = %s
|
||||||
mo_tot_num = \"%s\"
|
mo_tot_num = \"%s\"
|
||||||
|
mo_clas = %s
|
||||||
mo_occ = %s
|
mo_occ = %s
|
||||||
mo_coef = %s
|
mo_coef = %s
|
||||||
"
|
"
|
||||||
(MO_label.to_string b.mo_label)
|
(MO_label.to_string b.mo_label)
|
||||||
(MO_number.to_string b.mo_tot_num)
|
(MO_number.to_string b.mo_tot_num)
|
||||||
(b.mo_occ |> Array.to_list |> List.map
|
(b.mo_class |> Array.to_list |> List.map
|
||||||
~f:(MO_occ.to_string) |> String.concat ~sep:", " )
|
~f:(MO_class.to_string) |> String.concat ~sep:", " )
|
||||||
(b.mo_coef |> Array.map
|
(b.mo_occ |> Array.to_list |> List.map
|
||||||
~f:(fun x-> Array.map ~f:MO_coef.to_string x |> String.concat_array
|
~f:(MO_occ.to_string) |> String.concat ~sep:", " )
|
||||||
~sep:"," ) |>
|
(b.mo_coef |> Array.map
|
||||||
String.concat_array ~sep:"\n" )
|
~f:(fun x-> Array.map ~f:MO_coef.to_string x |> String.concat_array
|
||||||
;;
|
~sep:"," ) |>
|
||||||
|
String.concat_array ~sep:"\n" )
|
||||||
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -1,46 +1,63 @@
|
|||||||
open Core.Std;;
|
open Core.Std
|
||||||
open Qptypes ;;
|
open Qptypes
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
| Core of MO_number.t list
|
| Core of MO_number.t list
|
||||||
| Inactive of MO_number.t list
|
| Inactive of MO_number.t list
|
||||||
| Active of MO_number.t list
|
| Active of MO_number.t list
|
||||||
| Virtual of MO_number.t list
|
| Virtual of MO_number.t list
|
||||||
| Deleted of MO_number.t list
|
| Deleted of MO_number.t list
|
||||||
with sexp
|
with sexp
|
||||||
|
|
||||||
|
|
||||||
let to_string x =
|
let to_string x =
|
||||||
let print_list l =
|
let print_list l =
|
||||||
let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l
|
let s = List.map ~f:(fun x-> MO_number.to_int x |> string_of_int )l
|
||||||
|> (String.concat ~sep:", ")
|
|> (String.concat ~sep:", ")
|
||||||
in
|
in
|
||||||
"("^s^")"
|
"("^s^")"
|
||||||
in
|
in
|
||||||
|
|
||||||
match x with
|
match x with
|
||||||
| Core l -> "Core : "^(print_list l)
|
| Core [] -> "Core"
|
||||||
|
| Inactive [] -> "Inactive"
|
||||||
|
| Active [] -> "Active"
|
||||||
|
| Virtual [] -> "Virtual"
|
||||||
|
| Deleted [] -> "Deleted"
|
||||||
|
| Core l -> "Core : "^(print_list l)
|
||||||
| Inactive l -> "Inactive : "^(print_list l)
|
| Inactive l -> "Inactive : "^(print_list l)
|
||||||
| Active l -> "Active : "^(print_list l)
|
| Active l -> "Active : "^(print_list l)
|
||||||
| Virtual l -> "Virtual : "^(print_list l)
|
| Virtual l -> "Virtual : "^(print_list l)
|
||||||
| Deleted l -> "Deleted : "^(print_list l)
|
| Deleted l -> "Deleted : "^(print_list l)
|
||||||
;;
|
|
||||||
|
|
||||||
|
let of_string s =
|
||||||
|
match (String.lowercase s) with
|
||||||
|
| "core" -> Core []
|
||||||
|
| "inactive" -> Inactive []
|
||||||
|
| "active" -> Active []
|
||||||
|
| "virtual" -> Virtual []
|
||||||
|
| "deleted" -> Deleted []
|
||||||
|
| _ -> failwith "MO_class should be (Core|Inactive|Active|Virtual|Deleted)"
|
||||||
|
|
||||||
|
|
||||||
let _mo_number_list_of_range range =
|
let _mo_number_list_of_range range =
|
||||||
Range.of_string range |> List.map ~f:MO_number.of_int
|
Range.of_string range |> List.map ~f:MO_number.of_int
|
||||||
;;
|
|
||||||
|
|
||||||
|
let create_core range = Core (_mo_number_list_of_range range)
|
||||||
|
let create_inactive range = Inactive (_mo_number_list_of_range range)
|
||||||
|
let create_active range = Active (_mo_number_list_of_range range)
|
||||||
|
let create_virtual range = Virtual (_mo_number_list_of_range range)
|
||||||
|
let create_deleted range = Deleted (_mo_number_list_of_range range)
|
||||||
|
|
||||||
let create_core range = Core (_mo_number_list_of_range range) ;;
|
|
||||||
let create_inactive range = Inactive (_mo_number_list_of_range range) ;;
|
|
||||||
let create_active range = Active (_mo_number_list_of_range range) ;;
|
|
||||||
let create_virtual range = Virtual (_mo_number_list_of_range range) ;;
|
|
||||||
let create_deleted range = Deleted (_mo_number_list_of_range range) ;;
|
|
||||||
|
|
||||||
let to_bitlist n_int x =
|
let to_bitlist n_int x =
|
||||||
match x with
|
match x with
|
||||||
| Core l
|
| Core l
|
||||||
| Inactive l
|
| Inactive l
|
||||||
| Active l
|
| Active l
|
||||||
| Virtual l
|
| Virtual l
|
||||||
| Deleted l -> Bitlist.of_mo_number_list n_int l
|
| Deleted l -> Bitlist.of_mo_number_list n_int l
|
||||||
;;
|
|
||||||
|
|
||||||
|
@ -19,3 +19,6 @@ val to_bitlist : Qptypes.N_int_number.t -> t -> Bitlist.t
|
|||||||
|
|
||||||
(** Convert to string for printing *)
|
(** Convert to string for printing *)
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
|
|
||||||
|
val of_string : string -> t
|
||||||
|
|
||||||
|
@ -324,33 +324,28 @@ end
|
|||||||
|
|
||||||
(** GetPsiReply_msg : Reply to the GetPsi message *)
|
(** GetPsiReply_msg : Reply to the GetPsi message *)
|
||||||
module GetPsiReply_msg : sig
|
module GetPsiReply_msg : sig
|
||||||
type t =
|
type t = string list
|
||||||
{ client_id : Id.Client.t ;
|
val create : psi:Psi.t -> t
|
||||||
psi : Psi.t }
|
|
||||||
val create : client_id:Id.Client.t -> psi:Psi.t -> t
|
|
||||||
val to_string_list : t -> string list
|
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
end = struct
|
end = struct
|
||||||
type t =
|
type t = string list
|
||||||
{ client_id : Id.Client.t ;
|
let create ~psi =
|
||||||
psi : Psi.t }
|
|
||||||
let create ~client_id ~psi =
|
|
||||||
{ client_id ; psi }
|
|
||||||
let to_string x =
|
|
||||||
let g, s =
|
let g, s =
|
||||||
match x.psi.Psi.n_det_generators, x.psi.Psi.n_det_selectors with
|
match psi.Psi.n_det_generators, psi.Psi.n_det_selectors with
|
||||||
| Some g, Some s -> Strictly_positive_int.to_int g, Strictly_positive_int.to_int s
|
| Some g, Some s -> Strictly_positive_int.to_int g, Strictly_positive_int.to_int s
|
||||||
| _ -> -1, -1
|
| _ -> -1, -1
|
||||||
in
|
in
|
||||||
Printf.sprintf "get_psi_reply %d %d %d %d %d %d"
|
let head =
|
||||||
(Id.Client.to_int x.client_id)
|
Printf.sprintf "get_psi_reply %d %d %d %d %d"
|
||||||
(Strictly_positive_int.to_int x.psi.Psi.n_state)
|
(Strictly_positive_int.to_int psi.Psi.n_state)
|
||||||
(Strictly_positive_int.to_int x.psi.Psi.n_det)
|
(Strictly_positive_int.to_int psi.Psi.n_det)
|
||||||
(Strictly_positive_int.to_int x.psi.Psi.psi_det_size)
|
(Strictly_positive_int.to_int psi.Psi.psi_det_size)
|
||||||
g s
|
g s
|
||||||
let to_string_list x =
|
in
|
||||||
[ to_string x ;
|
[ head ; psi.Psi.psi_det ; psi.Psi.psi_coef ; psi.Psi.energy ]
|
||||||
x.psi.Psi.psi_det ; x.psi.Psi.psi_coef ; x.psi.Psi.energy ]
|
let to_string = function
|
||||||
|
| head :: _ :: _ :: _ :: [] -> head
|
||||||
|
| _ -> raise (Invalid_argument "Bad wave function message")
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -759,7 +754,6 @@ let to_string = function
|
|||||||
|
|
||||||
let to_string_list = function
|
let to_string_list = function
|
||||||
| PutPsi x -> PutPsi_msg.to_string_list x
|
| PutPsi x -> PutPsi_msg.to_string_list x
|
||||||
| GetPsiReply x -> GetPsiReply_msg.to_string_list x
|
|
||||||
| PutVector x -> PutVector_msg.to_string_list x
|
| PutVector x -> PutVector_msg.to_string_list x
|
||||||
| GetVectorReply x -> GetVectorReply_msg.to_string_list x
|
| GetVectorReply x -> GetVectorReply_msg.to_string_list x
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
|
@ -2,6 +2,7 @@ open Core.Std ;;
|
|||||||
open Qptypes ;;
|
open Qptypes ;;
|
||||||
|
|
||||||
exception MultiplicityError of string;;
|
exception MultiplicityError of string;;
|
||||||
|
exception XYZError ;;
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
nuclei : Atom.t list ;
|
nuclei : Atom.t list ;
|
||||||
@ -144,8 +145,16 @@ let of_xyz_file
|
|||||||
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
|
?(charge=(Charge.of_int 0)) ?(multiplicity=(Multiplicity.of_int 1))
|
||||||
?(units=Units.Angstrom)
|
?(units=Units.Angstrom)
|
||||||
filename =
|
filename =
|
||||||
let (_,buffer) = In_channel.read_all filename
|
let (x,buffer) = In_channel.read_all filename
|
||||||
|> String.lsplit2_exn ~on:'\n' in
|
|> String.lsplit2_exn ~on:'\n'
|
||||||
|
in
|
||||||
|
let result =
|
||||||
|
try
|
||||||
|
int_of_string x > 0
|
||||||
|
with
|
||||||
|
| Failure "int_of_string" -> false
|
||||||
|
in
|
||||||
|
if not result then raise XYZError;
|
||||||
let (_,buffer) = String.lsplit2_exn buffer ~on:'\n' in
|
let (_,buffer) = String.lsplit2_exn buffer ~on:'\n' in
|
||||||
of_xyz_string ~charge ~multiplicity ~units buffer
|
of_xyz_string ~charge ~multiplicity ~units buffer
|
||||||
|
|
||||||
@ -166,7 +175,7 @@ let of_file
|
|||||||
filename =
|
filename =
|
||||||
try
|
try
|
||||||
of_xyz_file ~charge ~multiplicity ~units filename
|
of_xyz_file ~charge ~multiplicity ~units filename
|
||||||
with _ ->
|
with XYZError ->
|
||||||
of_zmt_file ~charge ~multiplicity ~units filename
|
of_zmt_file ~charge ~multiplicity ~units filename
|
||||||
|
|
||||||
|
|
||||||
|
@ -2,7 +2,7 @@ open Core.Std
|
|||||||
open Qptypes
|
open Qptypes
|
||||||
|
|
||||||
|
|
||||||
module Primitive_local : sig
|
module GaussianPrimitive_local : sig
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
expo : AO_expo.t ;
|
expo : AO_expo.t ;
|
||||||
@ -29,7 +29,7 @@ end = struct
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
module Primitive_non_local : sig
|
module GaussianPrimitive_non_local : sig
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
expo : AO_expo.t ;
|
expo : AO_expo.t ;
|
||||||
@ -64,8 +64,8 @@ end
|
|||||||
type t = {
|
type t = {
|
||||||
element : Element.t ;
|
element : Element.t ;
|
||||||
n_elec : Positive_int.t ;
|
n_elec : Positive_int.t ;
|
||||||
local : (Primitive_local.t * AO_coef.t ) list ;
|
local : (GaussianPrimitive_local.t * AO_coef.t ) list ;
|
||||||
non_local : (Primitive_non_local.t * AO_coef.t ) list
|
non_local : (GaussianPrimitive_non_local.t * AO_coef.t ) list
|
||||||
} with sexp
|
} with sexp
|
||||||
|
|
||||||
let empty e =
|
let empty e =
|
||||||
@ -83,8 +83,8 @@ let to_string_local = function
|
|||||||
( Printf.sprintf "%20s %8s %20s" "Coeff." "r^n" "Exp." ) ::
|
( Printf.sprintf "%20s %8s %20s" "Coeff." "r^n" "Exp." ) ::
|
||||||
( List.map t ~f:(fun (l,c) -> Printf.sprintf "%20f %8d %20f"
|
( List.map t ~f:(fun (l,c) -> Printf.sprintf "%20f %8d %20f"
|
||||||
(AO_coef.to_float c)
|
(AO_coef.to_float c)
|
||||||
(R_power.to_int l.Primitive_local.r_power)
|
(R_power.to_int l.GaussianPrimitive_local.r_power)
|
||||||
(AO_expo.to_float l.Primitive_local.expo)
|
(AO_expo.to_float l.GaussianPrimitive_local.expo)
|
||||||
) )
|
) )
|
||||||
|> String.concat ~sep:"\n"
|
|> String.concat ~sep:"\n"
|
||||||
|
|
||||||
@ -97,12 +97,12 @@ let to_string_non_local = function
|
|||||||
( Printf.sprintf "%20s %8s %20s %8s" "Coeff." "r^n" "Exp." "Proj") ::
|
( Printf.sprintf "%20s %8s %20s %8s" "Coeff." "r^n" "Exp." "Proj") ::
|
||||||
( List.map t ~f:(fun (l,c) ->
|
( List.map t ~f:(fun (l,c) ->
|
||||||
let p =
|
let p =
|
||||||
Positive_int.to_int l.Primitive_non_local.proj
|
Positive_int.to_int l.GaussianPrimitive_non_local.proj
|
||||||
in
|
in
|
||||||
Printf.sprintf "%20f %8d %20f |%d><%d|"
|
Printf.sprintf "%20f %8d %20f |%d><%d|"
|
||||||
(AO_coef.to_float c)
|
(AO_coef.to_float c)
|
||||||
(R_power.to_int l.Primitive_non_local.r_power)
|
(R_power.to_int l.GaussianPrimitive_non_local.r_power)
|
||||||
(AO_expo.to_float l.Primitive_non_local.expo)
|
(AO_expo.to_float l.GaussianPrimitive_non_local.expo)
|
||||||
p p
|
p p
|
||||||
) )
|
) )
|
||||||
|> String.concat ~sep:"\n"
|
|> String.concat ~sep:"\n"
|
||||||
@ -223,7 +223,7 @@ let read_element in_channel element =
|
|||||||
let decode_local (pseudo,data) =
|
let decode_local (pseudo,data) =
|
||||||
let decode_local_n n rest =
|
let decode_local_n n rest =
|
||||||
let result, rest =
|
let result, rest =
|
||||||
loop Primitive_local.of_expo_r_power [] (Positive_int.to_int n,rest)
|
loop GaussianPrimitive_local.of_expo_r_power [] (Positive_int.to_int n,rest)
|
||||||
in
|
in
|
||||||
{ pseudo with local = result }, rest
|
{ pseudo with local = result }, rest
|
||||||
in
|
in
|
||||||
@ -241,7 +241,7 @@ let read_element in_channel element =
|
|||||||
let decode_non_local (pseudo,data) =
|
let decode_non_local (pseudo,data) =
|
||||||
let decode_non_local_n proj n (pseudo,data) =
|
let decode_non_local_n proj n (pseudo,data) =
|
||||||
let result, rest =
|
let result, rest =
|
||||||
loop (Primitive_non_local.of_proj_expo_r_power proj)
|
loop (GaussianPrimitive_non_local.of_proj_expo_r_power proj)
|
||||||
[] (Positive_int.to_int n, data)
|
[] (Positive_int.to_int n, data)
|
||||||
in
|
in
|
||||||
{ pseudo with non_local = pseudo.non_local @ result }, rest
|
{ pseudo with non_local = pseudo.non_local @ result }, rest
|
||||||
|
@ -25,7 +25,7 @@ type t =
|
|||||||
state : Message.State.t option ;
|
state : Message.State.t option ;
|
||||||
address_tcp : Address.Tcp.t option ;
|
address_tcp : Address.Tcp.t option ;
|
||||||
address_inproc : Address.Inproc.t option ;
|
address_inproc : Address.Inproc.t option ;
|
||||||
psi : Message.Psi.t option;
|
psi : Message.GetPsiReply_msg.t option;
|
||||||
vector : Message.Vector.t option;
|
vector : Message.Vector.t option;
|
||||||
progress_bar : Progress_bar.t option ;
|
progress_bar : Progress_bar.t option ;
|
||||||
running : bool;
|
running : bool;
|
||||||
@ -483,7 +483,7 @@ let put_psi msg rest_of_msg program_state rep_socket =
|
|||||||
in
|
in
|
||||||
let new_program_state =
|
let new_program_state =
|
||||||
{ program_state with
|
{ program_state with
|
||||||
psi = Some psi_local
|
psi = Some (Message.GetPsiReply_msg.create ~psi:psi_local)
|
||||||
}
|
}
|
||||||
and client_id =
|
and client_id =
|
||||||
msg.Message.PutPsi_msg.client_id
|
msg.Message.PutPsi_msg.client_id
|
||||||
@ -496,17 +496,12 @@ let put_psi msg rest_of_msg program_state rep_socket =
|
|||||||
|
|
||||||
|
|
||||||
let get_psi msg program_state rep_socket =
|
let get_psi msg program_state rep_socket =
|
||||||
|
begin
|
||||||
let client_id =
|
match program_state.psi with
|
||||||
msg.Message.GetPsi_msg.client_id
|
| None -> failwith "No wave function saved in TaskServer"
|
||||||
in
|
| Some psi_message -> ZMQ.Socket.send_all rep_socket psi_message
|
||||||
match program_state.psi with
|
end;
|
||||||
| None -> failwith "No wave function saved in TaskServer"
|
program_state
|
||||||
| Some psi ->
|
|
||||||
Message.GetPsiReply (Message.GetPsiReply_msg.create ~client_id ~psi)
|
|
||||||
|> Message.to_string_list
|
|
||||||
|> ZMQ.Socket.send_all rep_socket;
|
|
||||||
program_state
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -4,7 +4,7 @@ type t =
|
|||||||
state : Message.State.t option ;
|
state : Message.State.t option ;
|
||||||
address_tcp : Address.Tcp.t option ;
|
address_tcp : Address.Tcp.t option ;
|
||||||
address_inproc : Address.Inproc.t option ;
|
address_inproc : Address.Inproc.t option ;
|
||||||
psi : Message.Psi.t option;
|
psi : Message.GetPsiReply_msg.t option;
|
||||||
vector : Message.Vector.t option ;
|
vector : Message.Vector.t option ;
|
||||||
progress_bar : Progress_bar.t option ;
|
progress_bar : Progress_bar.t option ;
|
||||||
running : bool;
|
running : bool;
|
||||||
|
@ -420,7 +420,7 @@ let run ?o b c d m p cart xyz_file =
|
|||||||
let x =
|
let x =
|
||||||
List.fold x.Pseudo.non_local ~init:0 ~f:(fun accu (x,_) ->
|
List.fold x.Pseudo.non_local ~init:0 ~f:(fun accu (x,_) ->
|
||||||
let x =
|
let x =
|
||||||
Positive_int.to_int x.Pseudo.Primitive_non_local.proj
|
Positive_int.to_int x.Pseudo.GaussianPrimitive_non_local.proj
|
||||||
in
|
in
|
||||||
if (x > accu) then x
|
if (x > accu) then x
|
||||||
else accu
|
else accu
|
||||||
@ -435,7 +435,7 @@ let run ?o b c d m p cart xyz_file =
|
|||||||
Array.init (lmax+1) ~f:(fun i->
|
Array.init (lmax+1) ~f:(fun i->
|
||||||
List.map pseudo ~f:(fun x ->
|
List.map pseudo ~f:(fun x ->
|
||||||
List.filter x.Pseudo.non_local ~f:(fun (y,_) ->
|
List.filter x.Pseudo.non_local ~f:(fun (y,_) ->
|
||||||
(Positive_int.to_int y.Pseudo.Primitive_non_local.proj) = i)
|
(Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj) = i)
|
||||||
|> List.length )
|
|> List.length )
|
||||||
|> List.fold ~init:0 ~f:(fun accu x ->
|
|> List.fold ~init:0 ~f:(fun accu x ->
|
||||||
if accu > x then accu else x)
|
if accu > x then accu else x)
|
||||||
@ -458,8 +458,8 @@ let run ?o b c d m p cart xyz_file =
|
|||||||
List.iteri x.Pseudo.local ~f:(fun i (y,c) ->
|
List.iteri x.Pseudo.local ~f:(fun i (y,c) ->
|
||||||
tmp_array_v_k.(i).(j) <- AO_coef.to_float c;
|
tmp_array_v_k.(i).(j) <- AO_coef.to_float c;
|
||||||
let y, z =
|
let y, z =
|
||||||
AO_expo.to_float y.Pseudo.Primitive_local.expo,
|
AO_expo.to_float y.Pseudo.GaussianPrimitive_local.expo,
|
||||||
R_power.to_int y.Pseudo.Primitive_local.r_power
|
R_power.to_int y.Pseudo.GaussianPrimitive_local.r_power
|
||||||
in
|
in
|
||||||
tmp_array_dz_k.(i).(j) <- y;
|
tmp_array_dz_k.(i).(j) <- y;
|
||||||
tmp_array_n_k.(i).(j) <- z;
|
tmp_array_n_k.(i).(j) <- z;
|
||||||
@ -494,9 +494,9 @@ let run ?o b c d m p cart xyz_file =
|
|||||||
in
|
in
|
||||||
List.iter x.Pseudo.non_local ~f:(fun (y,c) ->
|
List.iter x.Pseudo.non_local ~f:(fun (y,c) ->
|
||||||
let k, y, z =
|
let k, y, z =
|
||||||
Positive_int.to_int y.Pseudo.Primitive_non_local.proj,
|
Positive_int.to_int y.Pseudo.GaussianPrimitive_non_local.proj,
|
||||||
AO_expo.to_float y.Pseudo.Primitive_non_local.expo,
|
AO_expo.to_float y.Pseudo.GaussianPrimitive_non_local.expo,
|
||||||
R_power.to_int y.Pseudo.Primitive_non_local.r_power
|
R_power.to_int y.Pseudo.GaussianPrimitive_non_local.r_power
|
||||||
in
|
in
|
||||||
let i =
|
let i =
|
||||||
last_idx.(k)
|
last_idx.(k)
|
||||||
@ -602,7 +602,7 @@ let run ?o b c d m p cart xyz_file =
|
|||||||
List.map x.Gto.lc ~f:(fun (_,coef) -> AO_coef.to_float coef) )
|
List.map x.Gto.lc ~f:(fun (_,coef) -> AO_coef.to_float coef) )
|
||||||
| `Expos -> List.map gtos ~f:(fun x->
|
| `Expos -> List.map gtos ~f:(fun x->
|
||||||
List.map x.Gto.lc ~f:(fun (prim,_) -> AO_expo.to_float
|
List.map x.Gto.lc ~f:(fun (prim,_) -> AO_expo.to_float
|
||||||
prim.Primitive.expo) )
|
prim.GaussianPrimitive.expo) )
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
let rec get_n n accu = function
|
let rec get_n n accu = function
|
||||||
|
@ -120,10 +120,11 @@ let run slave exe ezfio_file =
|
|||||||
| Some (_,x) -> x^" "
|
| Some (_,x) -> x^" "
|
||||||
| None -> assert false
|
| None -> assert false
|
||||||
in
|
in
|
||||||
match (Sys.command (prefix^exe^ezfio_file)) with
|
let exit_code =
|
||||||
| 0 -> ()
|
match (Sys.command (prefix^exe^ezfio_file)) with
|
||||||
| i -> Printf.printf "Program exited with code %d.\n%!" i;
|
| 0 -> 0
|
||||||
;
|
| i -> (Printf.printf "Program exited with code %d.\n%!" i; i)
|
||||||
|
in
|
||||||
|
|
||||||
TaskServer.stop ~port:port_number;
|
TaskServer.stop ~port:port_number;
|
||||||
Thread.join task_thread;
|
Thread.join task_thread;
|
||||||
@ -132,7 +133,8 @@ let run slave exe ezfio_file =
|
|||||||
|
|
||||||
let duration = Time.diff (Time.now()) time_start
|
let duration = Time.diff (Time.now()) time_start
|
||||||
|> Core.Span.to_string in
|
|> Core.Span.to_string in
|
||||||
Printf.printf "Wall time : %s\n\n" duration
|
Printf.printf "Wall time : %s\n\n" duration;
|
||||||
|
exit exit_code
|
||||||
|
|
||||||
let spec =
|
let spec =
|
||||||
let open Command.Spec in
|
let open Command.Spec in
|
||||||
|
@ -1,305 +0,0 @@
|
|||||||
open Qputils;;
|
|
||||||
open Qptypes;;
|
|
||||||
open Core.Std;;
|
|
||||||
|
|
||||||
(*
|
|
||||||
* Command-line arguments
|
|
||||||
* ----------------------
|
|
||||||
*)
|
|
||||||
|
|
||||||
let build_mask from upto n_int =
|
|
||||||
let from = MO_number.to_int from
|
|
||||||
and upto = MO_number.to_int upto
|
|
||||||
and n_int = N_int_number.to_int n_int
|
|
||||||
in
|
|
||||||
let rec build_mask bit = function
|
|
||||||
| 0 -> []
|
|
||||||
| i ->
|
|
||||||
if ( i = upto ) then
|
|
||||||
Bit.One::(build_mask Bit.One (i-1))
|
|
||||||
else if ( i = from ) then
|
|
||||||
Bit.One::(build_mask Bit.Zero (i-1))
|
|
||||||
else
|
|
||||||
bit::(build_mask bit (i-1))
|
|
||||||
in
|
|
||||||
let starting_bit =
|
|
||||||
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
|
|
||||||
else Bit.Zero
|
|
||||||
in
|
|
||||||
build_mask starting_bit (n_int*64)
|
|
||||||
|> List.rev
|
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
let failure s = raise (Failure s)
|
|
||||||
;;
|
|
||||||
|
|
||||||
type t =
|
|
||||||
| Core
|
|
||||||
| Inactive
|
|
||||||
| Active
|
|
||||||
| Virtual
|
|
||||||
| Deleted
|
|
||||||
| None
|
|
||||||
;;
|
|
||||||
|
|
||||||
let t_to_string = function
|
|
||||||
| Core -> "core"
|
|
||||||
| Inactive -> "inactive"
|
|
||||||
| Active -> "active"
|
|
||||||
| Virtual -> "virtual"
|
|
||||||
| Deleted -> "deleted"
|
|
||||||
| None -> assert false
|
|
||||||
;;
|
|
||||||
|
|
||||||
let run ?(core="[]") ?(inact="[]") ?(act="[]") ?(virt="[]") ?(del="[]") ezfio_filename =
|
|
||||||
|
|
||||||
Ezfio.set_file ezfio_filename ;
|
|
||||||
if not (Ezfio.has_mo_basis_mo_tot_num ()) then
|
|
||||||
failure "mo_basis/mo_tot_num not found" ;
|
|
||||||
|
|
||||||
let mo_tot_num = Ezfio.get_mo_basis_mo_tot_num () in
|
|
||||||
let n_int =
|
|
||||||
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
|
|
||||||
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
|
|
||||||
in
|
|
||||||
|
|
||||||
|
|
||||||
let mo_class = Array.init mo_tot_num ~f:(fun i -> None) in
|
|
||||||
|
|
||||||
(* Check input data *)
|
|
||||||
let apply_class l =
|
|
||||||
let rec apply_class t = function
|
|
||||||
| [] -> ()
|
|
||||||
| k::tail -> let i = MO_number.to_int k in
|
|
||||||
begin
|
|
||||||
match mo_class.(i-1) with
|
|
||||||
| None -> mo_class.(i-1) <- t ;
|
|
||||||
apply_class t tail;
|
|
||||||
| x -> failure
|
|
||||||
(Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
|
|
||||||
i (t_to_string x) (t_to_string t))
|
|
||||||
end
|
|
||||||
in
|
|
||||||
match l with
|
|
||||||
| MO_class.Core x -> apply_class Core x
|
|
||||||
| MO_class.Inactive x -> apply_class Inactive x
|
|
||||||
| MO_class.Active x -> apply_class Active x
|
|
||||||
| MO_class.Virtual x -> apply_class Virtual x
|
|
||||||
| MO_class.Deleted x -> apply_class Deleted x
|
|
||||||
in
|
|
||||||
|
|
||||||
let core_input = core in
|
|
||||||
let core = MO_class.create_core core in
|
|
||||||
let inact = MO_class.create_inactive inact in
|
|
||||||
let act = MO_class.create_active act in
|
|
||||||
let virt = MO_class.create_virtual virt in
|
|
||||||
let del = MO_class.create_deleted del in
|
|
||||||
|
|
||||||
apply_class core ;
|
|
||||||
apply_class inact ;
|
|
||||||
apply_class act ;
|
|
||||||
apply_class virt ;
|
|
||||||
apply_class del ;
|
|
||||||
|
|
||||||
for i=1 to (Array.length mo_class)
|
|
||||||
do
|
|
||||||
if (mo_class.(i-1) = None) then
|
|
||||||
failure (Printf.sprintf "Orbital %d is not specified (mo_tot_num = %d)" i mo_tot_num)
|
|
||||||
done;
|
|
||||||
|
|
||||||
|
|
||||||
(* Debug output *)
|
|
||||||
MO_class.to_string core |> print_endline ;
|
|
||||||
MO_class.to_string inact |> print_endline ;
|
|
||||||
MO_class.to_string act |> print_endline ;
|
|
||||||
MO_class.to_string virt |> print_endline ;
|
|
||||||
MO_class.to_string del |> print_endline ;
|
|
||||||
|
|
||||||
(* Create masks *)
|
|
||||||
let ia = Excitation.create_single inact act
|
|
||||||
and aa = Excitation.create_single act act
|
|
||||||
and av = Excitation.create_single act virt
|
|
||||||
and iv = Excitation.create_single inact virt
|
|
||||||
in
|
|
||||||
let single_excitations = [| ia ; aa ; av ; iv |]
|
|
||||||
|> Array.map ~f:Excitation.(fun x ->
|
|
||||||
match x with
|
|
||||||
| Single (x,y) ->
|
|
||||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
|
||||||
| Double _ -> assert false
|
|
||||||
)
|
|
||||||
|
|
||||||
and double_excitations = [|
|
|
||||||
Excitation.double_of_singles ia ia ;
|
|
||||||
Excitation.double_of_singles ia aa ;
|
|
||||||
Excitation.double_of_singles ia iv ;
|
|
||||||
Excitation.double_of_singles ia av ;
|
|
||||||
|
|
||||||
Excitation.double_of_singles aa aa ;
|
|
||||||
Excitation.double_of_singles aa iv ;
|
|
||||||
Excitation.double_of_singles aa av ;
|
|
||||||
|
|
||||||
Excitation.double_of_singles iv aa ;
|
|
||||||
Excitation.double_of_singles iv av ;
|
|
||||||
|
|
||||||
(* Excitation.double_of_singles iv iv ; *)
|
|
||||||
|]
|
|
||||||
|
|
||||||
|> Array.map ~f:Excitation.(fun x ->
|
|
||||||
match x with
|
|
||||||
| Single _ -> assert false
|
|
||||||
| Double (x,y,z,t) ->
|
|
||||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class y) ,
|
|
||||||
MO_class.to_bitlist n_int (Hole.to_mo_class z),
|
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
|
|
||||||
)
|
|
||||||
in
|
|
||||||
|
|
||||||
let extract_hole (h,_) = h
|
|
||||||
and extract_particle (_,p) = p
|
|
||||||
and extract_hole1 (h,_,_,_) = h
|
|
||||||
and extract_particle1 (_,p,_,_) = p
|
|
||||||
and extract_hole2 (_,_,h,_) = h
|
|
||||||
and extract_particle2 (_,_,_,p) = p
|
|
||||||
in
|
|
||||||
(* --> TODO : This might be wrong *)
|
|
||||||
let result_ref =
|
|
||||||
let core = MO_class.create_inactive core_input in
|
|
||||||
let cv = Excitation.create_single core virt in
|
|
||||||
let cv = match cv with
|
|
||||||
| Excitation.Single (x,y) ->
|
|
||||||
( MO_class.to_bitlist n_int (Excitation.Hole.to_mo_class x),
|
|
||||||
MO_class.to_bitlist n_int (Excitation.Particle.to_mo_class y) )
|
|
||||||
| Excitation.Double _ -> assert false
|
|
||||||
in
|
|
||||||
let iv = match iv with
|
|
||||||
| Excitation.Single (x,y) ->
|
|
||||||
( MO_class.to_bitlist n_int (Excitation.Hole.to_mo_class x),
|
|
||||||
MO_class.to_bitlist n_int (Excitation.Particle.to_mo_class y) )
|
|
||||||
| Excitation.Double _ -> assert false
|
|
||||||
in
|
|
||||||
[ Bitlist.or_operator (extract_hole iv) (extract_hole cv);
|
|
||||||
extract_particle iv ]
|
|
||||||
in
|
|
||||||
(* <-- TODO : This might be wrong *)
|
|
||||||
|
|
||||||
let n_single = Array.length single_excitations in
|
|
||||||
let n_mask = Array.length double_excitations in
|
|
||||||
let zero = List.init (N_int_number.to_int n_int) ~f:(fun i -> 0L)
|
|
||||||
|> Bitlist.of_int64_list in
|
|
||||||
let result_gen = (List.init n_single ~f:(fun i-> [
|
|
||||||
extract_hole single_excitations.(i) ;
|
|
||||||
extract_particle single_excitations.(i) ;
|
|
||||||
extract_hole1 double_excitations.(i) ;
|
|
||||||
extract_particle1 double_excitations.(i) ;
|
|
||||||
extract_hole2 double_excitations.(i) ;
|
|
||||||
extract_particle2 double_excitations.(i) ; ])
|
|
||||||
)@(List.init (n_mask-n_single) ~f:(fun i-> [
|
|
||||||
zero ; zero ;
|
|
||||||
extract_hole1 double_excitations.(n_single+i) ;
|
|
||||||
extract_particle1 double_excitations.(n_single+i) ;
|
|
||||||
extract_hole2 double_excitations.(n_single+i) ;
|
|
||||||
extract_particle2 double_excitations.(n_single+i) ; ])
|
|
||||||
)
|
|
||||||
|> List.concat
|
|
||||||
in
|
|
||||||
|
|
||||||
(* Print bitmasks *)
|
|
||||||
print_endline "Reference Bitmasks:";
|
|
||||||
List.iter ~f:(fun x-> print_endline (Bitlist.to_string x)) result_ref;
|
|
||||||
|
|
||||||
print_endline "Generators Bitmasks:";
|
|
||||||
List.iter ~f:(fun x-> print_endline (Bitlist.to_string x)) result_gen;
|
|
||||||
|
|
||||||
(* Transform to int64 *)
|
|
||||||
let result_gen = List.map ~f:(fun x ->
|
|
||||||
let y = Bitlist.to_int64_list x in y@y )
|
|
||||||
result_gen
|
|
||||||
|> List.concat
|
|
||||||
in
|
|
||||||
let result_ref = List.map ~f:(fun x ->
|
|
||||||
let y = Bitlist.to_int64_list x in y@y )
|
|
||||||
result_ref
|
|
||||||
|> List.concat
|
|
||||||
in
|
|
||||||
|
|
||||||
(* Write generators masks *)
|
|
||||||
Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
|
|
||||||
Ezfio.set_bitmasks_bit_kind 8;
|
|
||||||
Ezfio.set_bitmasks_n_mask_gen n_mask;
|
|
||||||
Ezfio.ezfio_array_of_list ~rank:4 ~dim:([| (N_int_number.to_int n_int) ; 2; 6; n_mask|]) ~data:result_gen
|
|
||||||
|> Ezfio.set_bitmasks_generators ;
|
|
||||||
|
|
||||||
(* Write CAS reference masks *)
|
|
||||||
Ezfio.set_bitmasks_n_mask_cas 1;
|
|
||||||
Ezfio.ezfio_array_of_list ~rank:3 ~dim:([| (N_int_number.to_int n_int) ; 2; 1|]) ~data:result_ref
|
|
||||||
|> Ezfio.set_bitmasks_cas ;
|
|
||||||
|
|
||||||
|
|
||||||
;;
|
|
||||||
|
|
||||||
let ezfio_file =
|
|
||||||
let failure filename =
|
|
||||||
eprintf "'%s' is not an EZFIO file.\n%!" filename;
|
|
||||||
exit 1
|
|
||||||
in
|
|
||||||
Command.Spec.Arg_type.create
|
|
||||||
(fun filename ->
|
|
||||||
match Sys.is_directory filename with
|
|
||||||
| `Yes ->
|
|
||||||
begin
|
|
||||||
match Sys.is_file (filename ^ "/.version") with
|
|
||||||
| `Yes -> filename
|
|
||||||
| _ -> failure filename
|
|
||||||
end
|
|
||||||
| _ -> failure filename
|
|
||||||
)
|
|
||||||
;;
|
|
||||||
|
|
||||||
let default range =
|
|
||||||
let failure filename =
|
|
||||||
eprintf "'%s' is not a regular file.\n%!" filename;
|
|
||||||
exit 1
|
|
||||||
in
|
|
||||||
Command.Spec.Arg_type.create
|
|
||||||
(fun filename ->
|
|
||||||
match Sys.is_directory filename with
|
|
||||||
| `Yes ->
|
|
||||||
begin
|
|
||||||
match Sys.is_file (filename^"/.version") with
|
|
||||||
| `Yes -> filename
|
|
||||||
| _ -> failure filename
|
|
||||||
end
|
|
||||||
| _ -> failure filename
|
|
||||||
)
|
|
||||||
;;
|
|
||||||
|
|
||||||
let spec =
|
|
||||||
let open Command.Spec in
|
|
||||||
empty
|
|
||||||
+> flag "core" (optional string) ~doc:"range Range of core orbitals"
|
|
||||||
+> flag "inact" (optional string) ~doc:"range Range of inactive orbitals"
|
|
||||||
+> flag "act" (optional string) ~doc:"range Range of active orbitals"
|
|
||||||
+> flag "virt" (optional string) ~doc:"range Range of virtual orbitals"
|
|
||||||
+> flag "del" (optional string) ~doc:"range Range of deleted orbitals"
|
|
||||||
+> anon ("ezfio_filename" %: ezfio_file)
|
|
||||||
;;
|
|
||||||
|
|
||||||
let command =
|
|
||||||
Command.basic
|
|
||||||
~summary: "Quantum Package command"
|
|
||||||
~readme:(fun () ->
|
|
||||||
"Set the orbital classes in an EZFIO directory
|
|
||||||
The range of MOs has the form : \"[36-53,72-107,126-131]\"
|
|
||||||
")
|
|
||||||
spec
|
|
||||||
(fun core inact act virt del ezfio_filename () -> run ?core ?inact ?act ?virt ?del ezfio_filename )
|
|
||||||
;;
|
|
||||||
|
|
||||||
let () =
|
|
||||||
Command.run command
|
|
||||||
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
|||||||
open Qputils;;
|
open Qputils
|
||||||
open Qptypes;;
|
open Qptypes
|
||||||
open Core.Std;;
|
open Core.Std
|
||||||
|
|
||||||
(*
|
(*
|
||||||
* Command-line arguments
|
* Command-line arguments
|
||||||
@ -15,12 +15,12 @@ let build_mask from upto n_int =
|
|||||||
let rec build_mask bit = function
|
let rec build_mask bit = function
|
||||||
| 0 -> []
|
| 0 -> []
|
||||||
| i ->
|
| i ->
|
||||||
if ( i = upto ) then
|
if ( i = upto ) then
|
||||||
Bit.One::(build_mask Bit.One (i-1))
|
Bit.One::(build_mask Bit.One (i-1))
|
||||||
else if ( i = from ) then
|
else if ( i = from ) then
|
||||||
Bit.One::(build_mask Bit.Zero (i-1))
|
Bit.One::(build_mask Bit.Zero (i-1))
|
||||||
else
|
else
|
||||||
bit::(build_mask bit (i-1))
|
bit::(build_mask bit (i-1))
|
||||||
in
|
in
|
||||||
let starting_bit =
|
let starting_bit =
|
||||||
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
|
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
|
||||||
@ -28,69 +28,62 @@ let build_mask from upto n_int =
|
|||||||
in
|
in
|
||||||
build_mask starting_bit (n_int*64)
|
build_mask starting_bit (n_int*64)
|
||||||
|> List.rev
|
|> List.rev
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
type t =
|
|
||||||
| Core
|
|
||||||
| Inactive
|
|
||||||
| Active
|
|
||||||
| Virtual
|
|
||||||
| Deleted
|
|
||||||
| None
|
|
||||||
;;
|
|
||||||
|
|
||||||
let t_to_string = function
|
type t = MO_class.t option
|
||||||
| Core -> "core"
|
|
||||||
| Inactive -> "inactive"
|
|
||||||
| Active -> "active"
|
|
||||||
| Virtual -> "virtual"
|
|
||||||
| Deleted -> "deleted"
|
|
||||||
| None -> assert false
|
|
||||||
;;
|
|
||||||
|
|
||||||
let set ~core ~inact ~act ~virt ~del =
|
let set ~core ~inact ~act ~virt ~del =
|
||||||
|
|
||||||
let mo_tot_num =
|
let mo_tot_num =
|
||||||
Ezfio.get_mo_basis_mo_tot_num ()
|
Ezfio.get_mo_basis_mo_tot_num ()
|
||||||
in
|
in
|
||||||
let n_int =
|
let n_int =
|
||||||
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
|
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
|
||||||
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
|
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
let mo_class =
|
let mo_class =
|
||||||
Array.init mo_tot_num ~f:(fun i -> None)
|
Array.init mo_tot_num ~f:(fun i -> None)
|
||||||
in
|
in
|
||||||
|
|
||||||
(* Check input data *)
|
(* Check input data *)
|
||||||
let apply_class l =
|
let apply_class l =
|
||||||
let rec apply_class t = function
|
let rec apply_class t = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| k::tail -> let i = MO_number.to_int k in
|
| k::tail -> let i = MO_number.to_int k in
|
||||||
begin
|
begin
|
||||||
match mo_class.(i-1) with
|
match mo_class.(i-1) with
|
||||||
| None -> mo_class.(i-1) <- t ;
|
| None -> mo_class.(i-1) <- Some t ;
|
||||||
apply_class t tail;
|
apply_class t tail;
|
||||||
| x -> failwith
|
| Some x -> failwith
|
||||||
(Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
|
(Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
|
||||||
i (t_to_string x) (t_to_string t))
|
i (MO_class.to_string x) (MO_class.to_string t))
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
match l with
|
match l with
|
||||||
| MO_class.Core x -> apply_class Core x
|
| MO_class.Core x -> apply_class (MO_class.Core []) x
|
||||||
| MO_class.Inactive x -> apply_class Inactive x
|
| MO_class.Inactive x -> apply_class (MO_class.Inactive []) x
|
||||||
| MO_class.Active x -> apply_class Active x
|
| MO_class.Active x -> apply_class (MO_class.Active []) x
|
||||||
| MO_class.Virtual x -> apply_class Virtual x
|
| MO_class.Virtual x -> apply_class (MO_class.Virtual []) x
|
||||||
| MO_class.Deleted x -> apply_class Deleted x
|
| MO_class.Deleted x -> apply_class (MO_class.Deleted []) x
|
||||||
in
|
in
|
||||||
|
|
||||||
let core = MO_class.create_core core in
|
let check f x =
|
||||||
let inact = MO_class.create_inactive inact in
|
try f x with Invalid_argument a ->
|
||||||
let act = MO_class.create_active act in
|
begin
|
||||||
let virt = MO_class.create_virtual virt in
|
Printf.printf "Number of MOs: %d\n%!" mo_tot_num;
|
||||||
let del = MO_class.create_deleted del in
|
raise (Invalid_argument a)
|
||||||
|
end
|
||||||
|
in
|
||||||
|
|
||||||
|
let core = check MO_class.create_core core in
|
||||||
|
let inact = check MO_class.create_inactive inact in
|
||||||
|
let act = check MO_class.create_active act in
|
||||||
|
let virt = check MO_class.create_virtual virt in
|
||||||
|
let del = check MO_class.create_deleted del in
|
||||||
|
|
||||||
apply_class core ;
|
apply_class core ;
|
||||||
apply_class inact ;
|
apply_class inact ;
|
||||||
@ -98,6 +91,8 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
apply_class virt ;
|
apply_class virt ;
|
||||||
apply_class del ;
|
apply_class del ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
for i=1 to (Array.length mo_class)
|
for i=1 to (Array.length mo_class)
|
||||||
do
|
do
|
||||||
if (mo_class.(i-1) = None) then
|
if (mo_class.(i-1) = None) then
|
||||||
@ -118,13 +113,13 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
and av = Excitation.create_single act virt
|
and av = Excitation.create_single act virt
|
||||||
in
|
in
|
||||||
let single_excitations = [ ia ; aa ; av ]
|
let single_excitations = [ ia ; aa ; av ]
|
||||||
|> List.map ~f:Excitation.(fun x ->
|
|> List.map ~f:Excitation.(fun x ->
|
||||||
match x with
|
match x with
|
||||||
| Single (x,y) ->
|
| Single (x,y) ->
|
||||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
||||||
| Double _ -> assert false
|
| Double _ -> assert false
|
||||||
)
|
)
|
||||||
|
|
||||||
and double_excitations = [
|
and double_excitations = [
|
||||||
Excitation.double_of_singles ia ia ;
|
Excitation.double_of_singles ia ia ;
|
||||||
@ -134,14 +129,14 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
Excitation.double_of_singles aa av ;
|
Excitation.double_of_singles aa av ;
|
||||||
Excitation.double_of_singles av av ]
|
Excitation.double_of_singles av av ]
|
||||||
|> List.map ~f:Excitation.(fun x ->
|
|> List.map ~f:Excitation.(fun x ->
|
||||||
match x with
|
match x with
|
||||||
| Single _ -> assert false
|
| Single _ -> assert false
|
||||||
| Double (x,y,z,t) ->
|
| Double (x,y,z,t) ->
|
||||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class y) ,
|
MO_class.to_bitlist n_int (Particle.to_mo_class y) ,
|
||||||
MO_class.to_bitlist n_int (Hole.to_mo_class z),
|
MO_class.to_bitlist n_int (Hole.to_mo_class z),
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
|
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
|
||||||
)
|
)
|
||||||
in
|
in
|
||||||
|
|
||||||
let extract_hole (h,_) = h
|
let extract_hole (h,_) = h
|
||||||
@ -171,9 +166,9 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
|
|
||||||
(* Write masks *)
|
(* Write masks *)
|
||||||
let result = List.map ~f:(fun x ->
|
let result = List.map ~f:(fun x ->
|
||||||
let y = Bitlist.to_int64_list x in y@y )
|
let y = Bitlist.to_int64_list x in y@y )
|
||||||
result
|
result
|
||||||
|> List.concat
|
|> List.concat
|
||||||
in
|
in
|
||||||
|
|
||||||
Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
|
Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
|
||||||
@ -187,57 +182,83 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
match aa with
|
match aa with
|
||||||
| Double _ -> assert false
|
| Double _ -> assert false
|
||||||
| Single (x,y) ->
|
| Single (x,y) ->
|
||||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x) ) @
|
( MO_class.to_bitlist n_int (Hole.to_mo_class x) ) @
|
||||||
( MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
( MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
||||||
|> Bitlist.to_int64_list
|
|> Bitlist.to_int64_list
|
||||||
in
|
in
|
||||||
Ezfio.set_bitmasks_n_mask_cas 1;
|
Ezfio.set_bitmasks_n_mask_cas 1;
|
||||||
Ezfio.ezfio_array_of_list ~rank:3 ~dim:([| (N_int_number.to_int n_int) ; 2; 1|]) ~data:result
|
Ezfio.ezfio_array_of_list ~rank:3 ~dim:([| (N_int_number.to_int n_int) ; 2; 1|]) ~data:result
|
||||||
|> Ezfio.set_bitmasks_cas;
|
|> Ezfio.set_bitmasks_cas;
|
||||||
;;
|
|
||||||
|
let data =
|
||||||
|
Array.to_list mo_class
|
||||||
|
|> List.map ~f:(fun x -> match x with
|
||||||
|
|None -> assert false
|
||||||
|
| Some x -> MO_class.to_string x
|
||||||
|
)
|
||||||
|
in
|
||||||
|
Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_tot_num |] ~data
|
||||||
|
|> Ezfio.set_mo_basis_mo_class
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let get () =
|
let get () =
|
||||||
|
let data =
|
||||||
|
match Input.Mo_basis.read () with
|
||||||
|
| None -> failwith "Unable to read MOs"
|
||||||
|
| Some x -> x
|
||||||
|
in
|
||||||
|
|
||||||
let mo_tot_num =
|
let mo_tot_num =
|
||||||
Ezfio.get_mo_basis_mo_tot_num ()
|
MO_number.to_int data.Input_mo_basis.mo_tot_num
|
||||||
in
|
in
|
||||||
|
|
||||||
let n_int =
|
let n_int =
|
||||||
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
|
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
|
||||||
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
|
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
|
||||||
in
|
|
||||||
|
|
||||||
let bitmasks =
|
|
||||||
match Input.Bitmasks.read () with
|
|
||||||
| Some x -> x
|
|
||||||
| None -> failwith "No data to print"
|
|
||||||
in
|
|
||||||
assert (bitmasks.Input.Bitmasks.n_mask_gen |> Bitmask_number.to_int = 1);
|
|
||||||
assert (bitmasks.Input.Bitmasks.n_mask_cas |> Bitmask_number.to_int = 1);
|
|
||||||
|
|
||||||
let (generators,cas) =
|
|
||||||
Bitlist.of_int64_array bitmasks.Input.Bitmasks.generators,
|
|
||||||
Bitlist.of_int64_array bitmasks.Input.Bitmasks.cas
|
|
||||||
in
|
in
|
||||||
|
|
||||||
Printf.printf "MO : %d\n" mo_tot_num;
|
Printf.printf "MO : %d\n" mo_tot_num;
|
||||||
Printf.printf "n_int: %d\n" (N_int_number.to_int n_int);
|
Printf.printf "n_int: %d\n" (N_int_number.to_int n_int);
|
||||||
Printf.printf "Gen : %s\nCAS : %s\n"
|
|
||||||
(Bitlist.to_string generators)
|
|
||||||
(Bitlist.to_string cas)
|
|
||||||
|
|
||||||
;;
|
|
||||||
|
|
||||||
let run ~print ?(core="[]") ?(inact="[]") ?(act="[]") ?(virt="[]") ?(del="[]") ezfio_filename =
|
let rec work ?(core="[") ?(inact="[") ?(act="[") ?(virt="[") ?(del="[") i l =
|
||||||
|
match l with
|
||||||
|
| [] ->
|
||||||
|
let (core, inact, act, virt, del) =
|
||||||
|
(core ^"]",
|
||||||
|
inact ^"]",
|
||||||
|
act ^"]",
|
||||||
|
virt ^"]",
|
||||||
|
del ^"]")
|
||||||
|
in
|
||||||
|
set ~core ~inact ~act ~virt ~del
|
||||||
|
| (MO_class.Core _) :: rest ->
|
||||||
|
work ~core:(Printf.sprintf "%s,%d" core i) ~inact ~act ~virt ~del (i+1) rest
|
||||||
|
| (MO_class.Inactive _) :: rest ->
|
||||||
|
work ~inact:(Printf.sprintf "%s,%d" inact i) ~core ~act ~virt ~del (i+1) rest
|
||||||
|
| (MO_class.Active _) :: rest ->
|
||||||
|
work ~act:(Printf.sprintf "%s,%d" act i) ~inact ~core ~virt ~del (i+1) rest
|
||||||
|
| (MO_class.Virtual _) :: rest ->
|
||||||
|
work ~virt:(Printf.sprintf "%s,%d" virt i) ~inact ~act ~core ~del (i+1) rest
|
||||||
|
| (MO_class.Deleted _) :: rest ->
|
||||||
|
work ~del:(Printf.sprintf "%s,%d" del i) ~inact ~act ~virt ~core (i+1) rest
|
||||||
|
in
|
||||||
|
work 1 (Array.to_list data.Input_mo_basis.mo_class)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let run ~q ?(core="[]") ?(inact="[]") ?(act="[]") ?(virt="[]") ?(del="[]") ezfio_filename =
|
||||||
|
|
||||||
Ezfio.set_file ezfio_filename ;
|
Ezfio.set_file ezfio_filename ;
|
||||||
if not (Ezfio.has_mo_basis_mo_tot_num ()) then
|
if not (Ezfio.has_mo_basis_mo_tot_num ()) then
|
||||||
failwith "mo_basis/mo_tot_num not found" ;
|
failwith "mo_basis/mo_tot_num not found" ;
|
||||||
|
|
||||||
if print then
|
if q then
|
||||||
get ()
|
get ()
|
||||||
else
|
else
|
||||||
set ~core ~inact ~act ~virt ~del
|
set ~core ~inact ~act ~virt ~del
|
||||||
;;
|
|
||||||
|
|
||||||
let ezfio_file =
|
let ezfio_file =
|
||||||
let failure filename =
|
let failure filename =
|
||||||
@ -255,7 +276,7 @@ let ezfio_file =
|
|||||||
end
|
end
|
||||||
| _ -> failure filename
|
| _ -> failure filename
|
||||||
)
|
)
|
||||||
;;
|
|
||||||
|
|
||||||
let default range =
|
let default range =
|
||||||
let failure filename =
|
let failure filename =
|
||||||
@ -273,7 +294,7 @@ let default range =
|
|||||||
end
|
end
|
||||||
| _ -> failure filename
|
| _ -> failure filename
|
||||||
)
|
)
|
||||||
;;
|
|
||||||
|
|
||||||
let spec =
|
let spec =
|
||||||
let open Command.Spec in
|
let open Command.Spec in
|
||||||
@ -283,9 +304,9 @@ let spec =
|
|||||||
+> flag "act" (optional string) ~doc:"range Range of active orbitals"
|
+> flag "act" (optional string) ~doc:"range Range of active orbitals"
|
||||||
+> flag "virt" (optional string) ~doc:"range Range of virtual orbitals"
|
+> flag "virt" (optional string) ~doc:"range Range of virtual orbitals"
|
||||||
+> flag "del" (optional string) ~doc:"range Range of deleted orbitals"
|
+> flag "del" (optional string) ~doc:"range Range of deleted orbitals"
|
||||||
+> flag "print" no_arg ~doc:" Print the current masks"
|
+> flag "q" no_arg ~doc:" Query: print the current masks"
|
||||||
+> anon ("ezfio_filename" %: ezfio_file)
|
+> anon ("ezfio_filename" %: ezfio_file)
|
||||||
;;
|
|
||||||
|
|
||||||
let command =
|
let command =
|
||||||
Command.basic
|
Command.basic
|
||||||
@ -295,8 +316,8 @@ let command =
|
|||||||
The range of MOs has the form : \"[36-53,72-107,126-131]\"
|
The range of MOs has the form : \"[36-53,72-107,126-131]\"
|
||||||
")
|
")
|
||||||
spec
|
spec
|
||||||
(fun core inact act virt del print ezfio_filename () -> run ~print ?core ?inact ?act ?virt ?del ezfio_filename )
|
(fun core inact act virt del q ezfio_filename () -> run ~q ?core ?inact ?act ?virt ?del ezfio_filename )
|
||||||
;;
|
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
Command.run command
|
Command.run command
|
||||||
|
@ -2,42 +2,52 @@ open Core.Std;;
|
|||||||
|
|
||||||
let input_data = "
|
let input_data = "
|
||||||
* Positive_float : float
|
* Positive_float : float
|
||||||
assert (x >= 0.) ;
|
if not (x >= 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Positive_float : (x >= 0.) : x=%f\" x));
|
||||||
|
|
||||||
* Strictly_positive_float : float
|
* Strictly_positive_float : float
|
||||||
assert (x > 0.) ;
|
if not (x > 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_float : (x > 0.) : x=%f\" x));
|
||||||
|
|
||||||
* Negative_float : float
|
* Negative_float : float
|
||||||
assert (x <= 0.) ;
|
if not (x <= 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Negative_float : (x <= 0.) : x=%f\" x));
|
||||||
|
|
||||||
* Strictly_negative_float : float
|
* Strictly_negative_float : float
|
||||||
assert (x < 0.) ;
|
if not (x < 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
|
||||||
|
|
||||||
* Positive_int64 : int64
|
* Positive_int64 : int64
|
||||||
assert (x >= 0L) ;
|
if not (x >= 0L) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Positive_int64 : (x >= 0L) : x=%s\" (Int64.to_string x)));
|
||||||
|
|
||||||
* Positive_int : int
|
* Positive_int : int
|
||||||
assert (x >= 0) ;
|
if not (x >= 0) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
|
||||||
|
|
||||||
* Strictly_positive_int : int
|
* Strictly_positive_int : int
|
||||||
assert (x > 0) ;
|
if not (x > 0) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_int : (x > 0) : x=%d\" x));
|
||||||
|
|
||||||
* Negative_int : int
|
* Negative_int : int
|
||||||
assert (x <= 0) ;
|
if not (x <= 0) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
|
||||||
|
|
||||||
* Det_coef : float
|
* Det_coef : float
|
||||||
assert (x >= -1.) ;
|
if (x < -1.) || (x > 1.) then
|
||||||
assert (x <= 1.) ;
|
raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
|
||||||
|
|
||||||
* Normalized_float : float
|
* Normalized_float : float
|
||||||
assert (x <= 1.) ;
|
if (x < 0.) || (x > 1.) then
|
||||||
assert (x >= 0.) ;
|
raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
|
||||||
|
|
||||||
* Strictly_negative_int : int
|
* Strictly_negative_int : int
|
||||||
assert (x < 0) ;
|
if not (x < 0) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_int : (x < 0) : x=%d\" x));
|
||||||
|
|
||||||
* Non_empty_string : string
|
* Non_empty_string : string
|
||||||
assert (x <> \"\") ;
|
if (x = \"\") then
|
||||||
|
raise (Invalid_argument \"Non_empty_string\");
|
||||||
|
|
||||||
|
|
||||||
* Det_number_max : int
|
* Det_number_max : int
|
||||||
@ -53,13 +63,13 @@ let input_data = "
|
|||||||
* Bit_kind_size : int
|
* Bit_kind_size : int
|
||||||
begin match x with
|
begin match x with
|
||||||
| 8 | 16 | 32 | 64 -> ()
|
| 8 | 16 | 32 | 64 -> ()
|
||||||
| _ -> raise (Failure \"Bit_kind_size should be (8|16|32|64).\")
|
| _ -> raise (Invalid_argument \"Bit_kind_size should be (8|16|32|64).\")
|
||||||
end;
|
end;
|
||||||
|
|
||||||
* Bit_kind : int
|
* Bit_kind : int
|
||||||
begin match x with
|
begin match x with
|
||||||
| 1 | 2 | 4 | 8 -> ()
|
| 1 | 2 | 4 | 8 -> ()
|
||||||
| _ -> raise (Failure \"Bit_kind should be (1|2|4|8).\")
|
| _ -> raise (Invalid_argument \"Bit_kind should be (1|2|4|8).\")
|
||||||
end;
|
end;
|
||||||
|
|
||||||
* Bitmask_number : int
|
* Bitmask_number : int
|
||||||
@ -68,12 +78,14 @@ let input_data = "
|
|||||||
* MO_coef : float
|
* MO_coef : float
|
||||||
|
|
||||||
* MO_occ : float
|
* MO_occ : float
|
||||||
assert (x >= 0.);
|
if (x < 0.) || (x > 2.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"MO_occ : (0. <= x <= 2.) : x=%f\" x));
|
||||||
|
|
||||||
* AO_coef : float
|
* AO_coef : float
|
||||||
|
|
||||||
* AO_expo : float
|
* AO_expo : float
|
||||||
assert (x >= 0.) ;
|
if (x < 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"AO_expo : (x >= 0.) : x=%f\" x));
|
||||||
|
|
||||||
* AO_prim_number : int
|
* AO_prim_number : int
|
||||||
assert (x > 0) ;
|
assert (x > 0) ;
|
||||||
@ -165,7 +177,7 @@ end = struct
|
|||||||
match (String.lowercase s) with
|
match (String.lowercase s) with
|
||||||
| \"huckel\" -> Huckel
|
| \"huckel\" -> Huckel
|
||||||
| \"hcore\" -> HCore
|
| \"hcore\" -> HCore
|
||||||
| _ -> failwith (\"Wrong Guess type : \"^s)
|
| _ -> raise (Invalid_argument (\"Wrong Guess type : \"^s))
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -189,7 +201,7 @@ end = struct
|
|||||||
| \"read\" -> Read
|
| \"read\" -> Read
|
||||||
| \"write\" -> Write
|
| \"write\" -> Write
|
||||||
| \"none\" -> None
|
| \"none\" -> None
|
||||||
| _ -> failwith (\"Wrong IO type : \"^s)
|
| _ -> raise (Invalid_argument (\"Wrong IO type : \"^s))
|
||||||
|
|
||||||
end
|
end
|
||||||
"
|
"
|
||||||
@ -267,7 +279,9 @@ end = struct
|
|||||||
begin
|
begin
|
||||||
match max with
|
match max with
|
||||||
| %s -> ()
|
| %s -> ()
|
||||||
| i -> assert ( x <= i )
|
| i ->
|
||||||
|
if ( x > i ) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"%s: %%s\" (%s.to_string x) ))
|
||||||
end ;
|
end ;
|
||||||
x
|
x
|
||||||
end
|
end
|
||||||
@ -296,7 +310,7 @@ let parse_input_ezfio input=
|
|||||||
in
|
in
|
||||||
Printf.sprintf ezfio_template
|
Printf.sprintf ezfio_template
|
||||||
name typ typ typ typ typ typ typ typ (String.capitalize typ)
|
name typ typ typ typ typ typ typ typ (String.capitalize typ)
|
||||||
ezfio_func ezfio_func max min typ typ max msg min
|
ezfio_func ezfio_func max min typ typ max msg min name (String.capitalize typ)
|
||||||
end
|
end
|
||||||
| _ -> failwith "Error in input_ezfio"
|
| _ -> failwith "Error in input_ezfio"
|
||||||
in
|
in
|
||||||
|
@ -1,13 +1,13 @@
|
|||||||
open Core.Std;;
|
open Core.Std
|
||||||
open Qptypes;;
|
open Qptypes
|
||||||
|
|
||||||
let test_prim () =
|
let test_prim () =
|
||||||
let p =
|
let p =
|
||||||
{ Primitive.sym = Symmetry.P ;
|
{ GaussianPrimitive.sym = Symmetry.P ;
|
||||||
Primitive.expo = AO_expo.of_float 0.15} in
|
GaussianPrimitive.expo = AO_expo.of_float 0.15} in
|
||||||
Primitive.to_string p
|
GaussianPrimitive.to_string p
|
||||||
|> print_string
|
|> print_string
|
||||||
;;
|
|
||||||
|
|
||||||
let test_gto_1 () =
|
let test_gto_1 () =
|
||||||
let in_channel = open_in "/home/scemama/quantum_package/data/basis/cc-pvdz" in
|
let in_channel = open_in "/home/scemama/quantum_package/data/basis/cc-pvdz" in
|
||||||
@ -27,23 +27,22 @@ let test_gto_1 () =
|
|||||||
if (gto3 = gto3) then
|
if (gto3 = gto3) then
|
||||||
print_endline "gto3 = gto3";
|
print_endline "gto3 = gto3";
|
||||||
|
|
||||||
;;
|
|
||||||
|
|
||||||
let test_gto_2 () =
|
let test_gto_2 () =
|
||||||
let in_channel = open_in "/home/scemama/quantum_package/data/basis/cc-pvdz" in
|
let in_channel = open_in "/home/scemama/quantum_package/data/basis/cc-pvdz" in
|
||||||
ignore (input_line in_channel);
|
ignore (input_line in_channel);
|
||||||
let basis = Basis.read in_channel (Nucl_number.of_int 1) in
|
let basis = Basis.read in_channel (Nucl_number.of_int 1) in
|
||||||
List.iter basis ~f:(fun (x,n)-> Printf.printf "%d:%s\n" (Nucl_number.to_int n) (Gto.to_string x))
|
List.iter basis ~f:(fun (x,n)-> Printf.printf "%d:%s\n" (Nucl_number.to_int n) (Gto.to_string x))
|
||||||
;;
|
|
||||||
|
|
||||||
let test_gto () =
|
let test_gto () =
|
||||||
let in_channel = open_in "/home/scemama/quantum_package/data/basis/cc-pvdz" in
|
let in_channel = open_in "/home/scemama/quantum_package/data/basis/cc-pvdz" in
|
||||||
let basis = Basis.read_element in_channel (Nucl_number.of_int 1) Element.C in
|
let basis = Basis.read_element in_channel (Nucl_number.of_int 1) Element.C in
|
||||||
List.iter basis ~f:(fun (x,n)-> Printf.printf "%d:%s\n" (Nucl_number.to_int n) (Gto.to_string x))
|
List.iter basis ~f:(fun (x,n)-> Printf.printf "%d:%s\n" (Nucl_number.to_int n) (Gto.to_string x))
|
||||||
;;
|
|
||||||
|
|
||||||
let test_module () =
|
let test_module () =
|
||||||
test_gto_1()
|
test_gto_1()
|
||||||
;;
|
|
||||||
|
|
||||||
test_module ();;
|
|
||||||
|
test_module ()
|
||||||
|
@ -1,11 +1,12 @@
|
|||||||
program selection_slave
|
program prog_selection_slave
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Helper program to compute the PT2 in distributed mode.
|
! Helper program to compute the PT2 in distributed mode.
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
read_wf = .False.
|
read_wf = .False.
|
||||||
SOFT_TOUCH read_wf
|
distributed_davidson = .False.
|
||||||
|
SOFT_TOUCH read_wf distributed_davidson
|
||||||
call provide_everything
|
call provide_everything
|
||||||
call switch_qp_run_to_master
|
call switch_qp_run_to_master
|
||||||
call run_wf
|
call run_wf
|
||||||
@ -23,19 +24,21 @@ subroutine run_wf
|
|||||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
double precision :: energy(N_states)
|
double precision :: energy(N_states)
|
||||||
character*(64) :: states(1)
|
character*(64) :: states(4)
|
||||||
integer :: rc, i
|
integer :: rc, i
|
||||||
|
|
||||||
call provide_everything
|
call provide_everything
|
||||||
|
|
||||||
zmq_context = f77_zmq_ctx_new ()
|
zmq_context = f77_zmq_ctx_new ()
|
||||||
states(1) = 'selection'
|
states(1) = 'selection'
|
||||||
|
states(2) = 'davidson'
|
||||||
|
states(3) = 'pt2'
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
do
|
do
|
||||||
|
|
||||||
call wait_for_states(states,zmq_state,1)
|
call wait_for_states(states,zmq_state,4)
|
||||||
|
|
||||||
if(trim(zmq_state) == 'Stopped') then
|
if(trim(zmq_state) == 'Stopped') then
|
||||||
|
|
||||||
@ -51,43 +54,40 @@ subroutine run_wf
|
|||||||
|
|
||||||
!$OMP PARALLEL PRIVATE(i)
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
i = omp_get_thread_num()
|
i = omp_get_thread_num()
|
||||||
call selection_slave_tcp(i, energy)
|
call run_selection_slave(0, i, energy)
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
print *, 'Selection done'
|
print *, 'Selection done'
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'davidson') then
|
||||||
|
|
||||||
|
! Davidson
|
||||||
|
! --------
|
||||||
|
|
||||||
|
print *, 'Davidson'
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
call omp_set_nested(.True.)
|
||||||
|
call davidson_slave_tcp(0)
|
||||||
|
call omp_set_nested(.False.)
|
||||||
|
print *, 'Davidson done'
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'pt2') then
|
||||||
|
|
||||||
|
! PT2
|
||||||
|
! ---
|
||||||
|
|
||||||
|
print *, 'PT2'
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
|
||||||
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call run_selection_slave(0, i, energy)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
print *, 'PT2 done'
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine update_energy(energy)
|
|
||||||
implicit none
|
|
||||||
double precision, intent(in) :: energy(N_states)
|
|
||||||
BEGIN_DOC
|
|
||||||
! Update energy when it is received from ZMQ
|
|
||||||
END_DOC
|
|
||||||
integer :: j,k
|
|
||||||
do j=1,N_states
|
|
||||||
do k=1,N_det
|
|
||||||
CI_eigenvectors(k,j) = psi_coef(k,j)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
|
|
||||||
if (.True.) then
|
|
||||||
do k=1,N_states
|
|
||||||
ci_electronic_energy(k) = energy(k)
|
|
||||||
enddo
|
|
||||||
TOUCH ci_electronic_energy CI_eigenvectors_s2 CI_eigenvectors
|
|
||||||
endif
|
|
||||||
|
|
||||||
call write_double(6,ci_energy,'Energy')
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine selection_slave_tcp(i,energy)
|
|
||||||
implicit none
|
|
||||||
double precision, intent(in) :: energy(N_states)
|
|
||||||
integer, intent(in) :: i
|
|
||||||
|
|
||||||
call run_selection_slave(0,i,energy)
|
|
||||||
end
|
|
||||||
|
|
||||||
|
@ -1,29 +0,0 @@
|
|||||||
program pouet
|
|
||||||
implicit none
|
|
||||||
integer :: i,k
|
|
||||||
|
|
||||||
|
|
||||||
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
||||||
integer :: N_st, degree
|
|
||||||
N_st = N_states
|
|
||||||
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
|
|
||||||
character*(64) :: perturbation
|
|
||||||
double precision :: i_H_psi_array(N_states),diag_H_mat_elem,h,i_O1_psi_array(N_states)
|
|
||||||
double precision :: E_CI_before(N_states)
|
|
||||||
integer :: n_det_before
|
|
||||||
threshold_generators = threshold_generators_pt2
|
|
||||||
threshold_selectors = threshold_selectors_pt2
|
|
||||||
SOFT_TOUCH threshold_generators threshold_selectors
|
|
||||||
call H_apply_FCI_PT2_new(pt2, norm_pert, H_pert_diag, N_st)
|
|
||||||
|
|
||||||
print *, 'Final step'
|
|
||||||
print *, 'N_det = ', N_det
|
|
||||||
print *, 'N_states = ', N_states
|
|
||||||
print *, 'PT2 = ', pt2
|
|
||||||
print *, 'E = ', CI_energy(1:N_states)
|
|
||||||
print *, 'E+PT2 = ', CI_energy(1:N_states)+pt2(1:N_states)
|
|
||||||
print *, '-----'
|
|
||||||
call ezfio_set_full_ci_energy_pt2(CI_energy(1)+pt2(1))
|
|
||||||
deallocate(pt2,norm_pert)
|
|
||||||
end
|
|
||||||
|
|
@ -167,7 +167,7 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
|
|||||||
double precision, allocatable :: val(:)
|
double precision, allocatable :: val(:)
|
||||||
integer(bit_kind), allocatable :: det(:,:,:)
|
integer(bit_kind), allocatable :: det(:,:,:)
|
||||||
integer, allocatable :: task_id(:)
|
integer, allocatable :: task_id(:)
|
||||||
integer :: done, Nindex
|
integer :: Nindex
|
||||||
integer, allocatable :: index(:)
|
integer, allocatable :: index(:)
|
||||||
double precision, save :: time0 = -1.d0
|
double precision, save :: time0 = -1.d0
|
||||||
double precision :: time, timeLast, Nabove_old
|
double precision :: time, timeLast, Nabove_old
|
||||||
@ -249,11 +249,6 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
|
|||||||
if(Nabove(1) < 5d0) cycle
|
if(Nabove(1) < 5d0) cycle
|
||||||
call get_first_tooth(actually_computed, tooth)
|
call get_first_tooth(actually_computed, tooth)
|
||||||
|
|
||||||
done = 0
|
|
||||||
do i=first_det_of_teeth(tooth), first_det_of_teeth(tooth+1)-1
|
|
||||||
if(actually_computed(i)) done = done + 1
|
|
||||||
end do
|
|
||||||
|
|
||||||
E0 = sum(pt2_detail(1,:first_det_of_teeth(tooth)-1))
|
E0 = sum(pt2_detail(1,:first_det_of_teeth(tooth)-1))
|
||||||
if (tooth <= comb_teeth) then
|
if (tooth <= comb_teeth) then
|
||||||
prop = ((1d0 - dfloat(comb_teeth - tooth + 1) * comb_step) - pt2_cweight(first_det_of_teeth(tooth)-1))
|
prop = ((1d0 - dfloat(comb_teeth - tooth + 1) * comb_step) - pt2_cweight(first_det_of_teeth(tooth)-1))
|
||||||
@ -273,11 +268,9 @@ subroutine pt2_collector(E, b, tbc, comb, Ncomb, computed, pt2_detail, sumabove,
|
|||||||
else
|
else
|
||||||
if (Nabove(tooth) > Nabove_old) then
|
if (Nabove(tooth) > Nabove_old) then
|
||||||
print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, ''
|
print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', Nabove(tooth), avg+E, eqt, time-time0, ''
|
||||||
!print "(4(G23.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth)
|
|
||||||
Nabove_old = Nabove(tooth)
|
Nabove_old = Nabove(tooth)
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
!print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth)
|
|
||||||
end if
|
end if
|
||||||
end do pullLoop
|
end do pullLoop
|
||||||
|
|
||||||
@ -352,27 +345,6 @@ subroutine get_first_tooth(computed, first_teeth)
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine get_last_full_tooth(computed, last_tooth)
|
|
||||||
implicit none
|
|
||||||
logical, intent(in) :: computed(N_det_generators)
|
|
||||||
integer, intent(out) :: last_tooth
|
|
||||||
integer :: i, j, missing
|
|
||||||
|
|
||||||
last_tooth = 0
|
|
||||||
combLoop : do i=comb_teeth, 1, -1
|
|
||||||
missing = 1+ ishft(first_det_of_teeth(i+1)-first_det_of_teeth(i),-4) ! /16
|
|
||||||
do j=first_det_of_teeth(i), first_det_of_teeth(i+1)-1
|
|
||||||
if(.not.computed(j)) then
|
|
||||||
missing -= 1
|
|
||||||
if(missing < 0) cycle combLoop
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
last_tooth = i
|
|
||||||
exit
|
|
||||||
end do combLoop
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, size_tbc ]
|
BEGIN_PROVIDER [ integer, size_tbc ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -410,52 +382,6 @@ subroutine get_carlo_workbatch(computed, comb, Ncomb, tbc)
|
|||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine get_filling_teeth(computed, tbc)
|
|
||||||
implicit none
|
|
||||||
integer, intent(inout) :: tbc(0:size_tbc)
|
|
||||||
logical, intent(inout) :: computed(N_det_generators)
|
|
||||||
integer :: i, j, k, last_full, dets(comb_teeth)
|
|
||||||
|
|
||||||
call get_last_full_tooth(computed, last_full)
|
|
||||||
if(last_full /= 0) then
|
|
||||||
if (tbc(0) > size(tbc) - first_det_of_teeth(last_full+1) -2) then
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
k = tbc(0)+1
|
|
||||||
do j=1,first_det_of_teeth(last_full+1)-1
|
|
||||||
if(.not.(computed(j))) then
|
|
||||||
tbc(k) = j
|
|
||||||
k=k+1
|
|
||||||
computed(j) = .true.
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
tbc(0) = k-1
|
|
||||||
end if
|
|
||||||
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
subroutine reorder_tbc(tbc)
|
|
||||||
implicit none
|
|
||||||
integer, intent(inout) :: tbc(0:size_tbc)
|
|
||||||
logical, allocatable :: ltbc(:)
|
|
||||||
integer :: i, ci
|
|
||||||
|
|
||||||
allocate(ltbc(size_tbc))
|
|
||||||
ltbc(:) = .false.
|
|
||||||
do i=1,tbc(0)
|
|
||||||
ltbc(tbc(i)) = .true.
|
|
||||||
end do
|
|
||||||
|
|
||||||
ci = 0
|
|
||||||
do i=1,size_tbc
|
|
||||||
if(ltbc(i)) then
|
|
||||||
ci = ci+1
|
|
||||||
tbc(ci) = i
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
|
|
||||||
subroutine get_comb(stato, dets, ct)
|
subroutine get_comb(stato, dets, ct)
|
||||||
implicit none
|
implicit none
|
||||||
@ -545,6 +471,7 @@ end subroutine
|
|||||||
end if
|
end if
|
||||||
norm_left -= pt2_weight(i)
|
norm_left -= pt2_weight(i)
|
||||||
end do
|
end do
|
||||||
|
first_det_of_comb = max(1,first_det_of_comb)
|
||||||
call write_int(6, first_det_of_comb-1, 'Size of deterministic set')
|
call write_int(6, first_det_of_comb-1, 'Size of deterministic set')
|
||||||
|
|
||||||
comb_step = (1d0 - pt2_cweight(first_det_of_comb-1)) * comb_step
|
comb_step = (1d0 - pt2_cweight(first_det_of_comb-1)) * comb_step
|
||||||
|
@ -31,16 +31,6 @@ double precision function integral8(i,j,k,l)
|
|||||||
end function
|
end function
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(1), psi_phasemask, (N_int*bit_kind_size, 2, N_det)]
|
|
||||||
use bitmasks
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i
|
|
||||||
do i=1, N_det
|
|
||||||
call get_mask_phase(psi_det_sorted(1,1,i), psi_phasemask(1,1,i))
|
|
||||||
end do
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
subroutine assert(cond, msg)
|
subroutine assert(cond, msg)
|
||||||
character(*), intent(in) :: msg
|
character(*), intent(in) :: msg
|
||||||
@ -57,18 +47,22 @@ subroutine get_mask_phase(det, phasemask)
|
|||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: det(N_int, 2)
|
integer(bit_kind), intent(in) :: det(N_int, 2)
|
||||||
integer(1), intent(out) :: phasemask(2,N_int*bit_kind_size)
|
integer, intent(out) :: phasemask(2,N_int*bit_kind_size)
|
||||||
integer :: s, ni, i
|
integer :: s, ni, i
|
||||||
logical :: change
|
logical :: change
|
||||||
|
|
||||||
phasemask = 0_1
|
phasemask = 0_1
|
||||||
do s=1,2
|
do s=1,2
|
||||||
change = .false.
|
change = .false.
|
||||||
do ni=1,N_int
|
do ni=1,N_int
|
||||||
do i=0,bit_kind_size-1
|
do i=0,bit_kind_size-1
|
||||||
if(BTEST(det(ni, s), i)) change = .not. change
|
if(BTEST(det(ni, s), i)) then
|
||||||
if(change) phasemask(s, (ni-1)*bit_kind_size + i + 1) = 1_1
|
change = .not. change
|
||||||
|
endif
|
||||||
|
if(change) then
|
||||||
|
phasemask(s, ishft(ni-1,bit_kind_shift) + i + 1) = 1_1
|
||||||
|
endif
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
@ -111,10 +105,10 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2)
|
|||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(1), intent(in) :: phasemask(2,*)
|
integer, intent(in) :: phasemask(2,*)
|
||||||
integer, intent(in) :: s1, s2, h1, h2, p1, p2
|
integer, intent(in) :: s1, s2, h1, h2, p1, p2
|
||||||
logical :: change
|
logical :: change
|
||||||
integer(1) :: np1
|
integer :: np1
|
||||||
integer :: np
|
integer :: np
|
||||||
double precision, save :: res(0:1) = (/1d0, -1d0/)
|
double precision, save :: res(0:1) = (/1d0, -1d0/)
|
||||||
|
|
||||||
@ -134,7 +128,7 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
|||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
||||||
integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size)
|
integer, intent(in) :: phasemask(2,N_int*bit_kind_size)
|
||||||
logical, intent(in) :: bannedOrb(mo_tot_num)
|
logical, intent(in) :: bannedOrb(mo_tot_num)
|
||||||
double precision, intent(in) :: coefs(N_states)
|
double precision, intent(in) :: coefs(N_states)
|
||||||
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
||||||
@ -193,7 +187,7 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
|||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
||||||
integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size)
|
integer, intent(in) :: phasemask(2,N_int*bit_kind_size)
|
||||||
logical, intent(in) :: bannedOrb(mo_tot_num)
|
logical, intent(in) :: bannedOrb(mo_tot_num)
|
||||||
double precision, intent(in) :: coefs(N_states)
|
double precision, intent(in) :: coefs(N_states)
|
||||||
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
||||||
@ -225,32 +219,32 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
|||||||
if(lbanned(i)) cycle
|
if(lbanned(i)) cycle
|
||||||
hij = (integral8(p1, p2, i, hole) - integral8(p2, p1, i, hole))
|
hij = (integral8(p1, p2, i, hole) - integral8(p2, p1, i, hole))
|
||||||
hij *= get_phase_bi(phasemask, sp, sp, i, p1, hole, p2)
|
hij *= get_phase_bi(phasemask, sp, sp, i, p1, hole, p2)
|
||||||
vect(:,i) += hij * coefs
|
vect(1:N_states,i) += hij * coefs(1:N_states)
|
||||||
end do
|
end do
|
||||||
do i=hole+1,mo_tot_num
|
do i=hole+1,mo_tot_num
|
||||||
if(lbanned(i)) cycle
|
if(lbanned(i)) cycle
|
||||||
hij = (integral8(p1, p2, hole, i) - integral8(p2, p1, hole, i))
|
hij = (integral8(p1, p2, hole, i) - integral8(p2, p1, hole, i))
|
||||||
hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2)
|
hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2)
|
||||||
vect(:,i) += hij * coefs
|
vect(1:N_states,i) += hij * coefs(1:N_states)
|
||||||
end do
|
end do
|
||||||
|
|
||||||
call apply_particle(mask, sp, p2, det, ok, N_int)
|
call apply_particle(mask, sp, p2, det, ok, N_int)
|
||||||
call i_h_j(gen, det, N_int, hij)
|
call i_h_j(gen, det, N_int, hij)
|
||||||
vect(:, p2) += hij * coefs
|
vect(1:N_states, p2) += hij * coefs(1:N_states)
|
||||||
else
|
else
|
||||||
p2 = p(1, sh)
|
p2 = p(1, sh)
|
||||||
do i=1,mo_tot_num
|
do i=1,mo_tot_num
|
||||||
if(lbanned(i)) cycle
|
if(lbanned(i)) cycle
|
||||||
hij = integral8(p1, p2, i, hole)
|
hij = integral8(p1, p2, i, hole)
|
||||||
hij *= get_phase_bi(phasemask, sp, sh, i, p1, hole, p2)
|
hij *= get_phase_bi(phasemask, sp, sh, i, p1, hole, p2)
|
||||||
vect(:,i) += hij * coefs
|
vect(1:N_states,i) += hij * coefs(1:N_states)
|
||||||
end do
|
end do
|
||||||
end if
|
end if
|
||||||
deallocate(lbanned)
|
deallocate(lbanned)
|
||||||
|
|
||||||
call apply_particle(mask, sp, p1, det, ok, N_int)
|
call apply_particle(mask, sp, p1, det, ok, N_int)
|
||||||
call i_h_j(gen, det, N_int, hij)
|
call i_h_j(gen, det, N_int, hij)
|
||||||
vect(:, p1) += hij * coefs
|
vect(1:N_states, p1) += hij * coefs(1:N_states)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -259,7 +253,7 @@ subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
|||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
||||||
integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size)
|
integer, intent(in) :: phasemask(2,N_int*bit_kind_size)
|
||||||
logical, intent(in) :: bannedOrb(mo_tot_num)
|
logical, intent(in) :: bannedOrb(mo_tot_num)
|
||||||
double precision, intent(in) :: coefs(N_states)
|
double precision, intent(in) :: coefs(N_states)
|
||||||
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
double precision, intent(inout) :: vect(N_states, mo_tot_num)
|
||||||
@ -278,7 +272,7 @@ subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
|||||||
if(lbanned(i)) cycle
|
if(lbanned(i)) cycle
|
||||||
call apply_particle(mask, sp, i, det, ok, N_int)
|
call apply_particle(mask, sp, i, det, ok, N_int)
|
||||||
call i_h_j(gen, det, N_int, hij)
|
call i_h_j(gen, det, N_int, hij)
|
||||||
vect(:, i) += hij * coefs
|
vect(1:N_states, i) += hij * coefs(1:N_states)
|
||||||
end do
|
end do
|
||||||
deallocate(lbanned)
|
deallocate(lbanned)
|
||||||
end
|
end
|
||||||
@ -312,6 +306,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
|||||||
logical :: monoAdo, monoBdo
|
logical :: monoAdo, monoBdo
|
||||||
integer :: maskInd
|
integer :: maskInd
|
||||||
|
|
||||||
|
integer(bit_kind), allocatable:: preinteresting_det(:,:,:)
|
||||||
|
allocate (preinteresting_det(N_int,2,N_det))
|
||||||
|
|
||||||
PROVIDE fragment_count
|
PROVIDE fragment_count
|
||||||
|
|
||||||
monoAdo = .true.
|
monoAdo = .true.
|
||||||
@ -336,17 +333,18 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
|||||||
integer, allocatable :: indices(:), exc_degree(:), iorder(:)
|
integer, allocatable :: indices(:), exc_degree(:), iorder(:)
|
||||||
allocate (indices(N_det), &
|
allocate (indices(N_det), &
|
||||||
exc_degree(max(N_det_alpha_unique,N_det_beta_unique)))
|
exc_degree(max(N_det_alpha_unique,N_det_beta_unique)))
|
||||||
k=1
|
|
||||||
do i=1,N_det_alpha_unique
|
|
||||||
call get_excitation_degree_spin(psi_det_alpha_unique(1,i), &
|
|
||||||
psi_det_generators(1,1,i_generator), exc_degree(i), N_int)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
||||||
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
||||||
PROVIDE psi_bilinear_matrix_transp_order
|
PROVIDE psi_bilinear_matrix_transp_order
|
||||||
|
|
||||||
|
k=1
|
||||||
|
do i=1,N_det_alpha_unique
|
||||||
|
call get_excitation_degree_spin(psi_det_alpha_unique(1,i), &
|
||||||
|
psi_det_generators(1,1,i_generator), exc_degree(i), N_int)
|
||||||
|
enddo
|
||||||
|
|
||||||
do j=1,N_det_beta_unique
|
do j=1,N_det_beta_unique
|
||||||
call get_excitation_degree_spin(psi_det_beta_unique(1,j), &
|
call get_excitation_degree_spin(psi_det_beta_unique(1,j), &
|
||||||
psi_det_generators(1,2,i_generator), nt, N_int)
|
psi_det_generators(1,2,i_generator), nt, N_int)
|
||||||
@ -415,6 +413,10 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
|||||||
if(i <= N_det_selectors) then
|
if(i <= N_det_selectors) then
|
||||||
preinteresting(0) += 1
|
preinteresting(0) += 1
|
||||||
preinteresting(preinteresting(0)) = i
|
preinteresting(preinteresting(0)) = i
|
||||||
|
do j=1,N_int
|
||||||
|
preinteresting_det(j,1,preinteresting(0)) = psi_det_sorted(j,1,i)
|
||||||
|
preinteresting_det(j,2,preinteresting(0)) = psi_det_sorted(j,2,i)
|
||||||
|
enddo
|
||||||
else if(nt <= 2) then
|
else if(nt <= 2) then
|
||||||
prefullinteresting(0) += 1
|
prefullinteresting(0) += 1
|
||||||
prefullinteresting(prefullinteresting(0)) = i
|
prefullinteresting(prefullinteresting(0)) = i
|
||||||
@ -441,35 +443,36 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
|
|||||||
|
|
||||||
do ii=1,preinteresting(0)
|
do ii=1,preinteresting(0)
|
||||||
i = preinteresting(ii)
|
i = preinteresting(ii)
|
||||||
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,preinteresting(ii)))
|
mobMask(1,1) = iand(negMask(1,1), preinteresting_det(1,1,ii))
|
||||||
mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,preinteresting(ii)))
|
mobMask(1,2) = iand(negMask(1,2), preinteresting_det(1,2,ii))
|
||||||
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
|
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
|
||||||
do j=2,N_int
|
do j=2,N_int
|
||||||
mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(1,1,preinteresting(ii)))
|
mobMask(j,1) = iand(negMask(j,1), preinteresting_det(j,1,ii))
|
||||||
mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(1,2,preinteresting(ii)))
|
mobMask(j,2) = iand(negMask(j,2), preinteresting_det(j,2,ii))
|
||||||
nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if(nt <= 4) then
|
if(nt <= 4) then
|
||||||
interesting(0) += 1
|
interesting(0) += 1
|
||||||
interesting(interesting(0)) = i
|
interesting(interesting(0)) = i
|
||||||
minilist(1,1,interesting(0)) = psi_det_sorted(1,1,preinteresting(ii))
|
minilist(1,1,interesting(0)) = preinteresting_det(1,1,ii)
|
||||||
minilist(1,2,interesting(0)) = psi_det_sorted(1,2,preinteresting(ii))
|
minilist(1,2,interesting(0)) = preinteresting_det(1,2,ii)
|
||||||
do j=2,N_int
|
do j=2,N_int
|
||||||
minilist(j,1,interesting(0)) = psi_det_sorted(1,1,preinteresting(ii))
|
minilist(j,1,interesting(0)) = preinteresting_det(j,1,ii)
|
||||||
minilist(j,2,interesting(0)) = psi_det_sorted(1,2,preinteresting(ii))
|
minilist(j,2,interesting(0)) = preinteresting_det(j,2,ii)
|
||||||
enddo
|
enddo
|
||||||
if(nt <= 2) then
|
if(nt <= 2) then
|
||||||
fullinteresting(0) += 1
|
fullinteresting(0) += 1
|
||||||
fullinteresting(fullinteresting(0)) = i
|
fullinteresting(fullinteresting(0)) = i
|
||||||
fullminilist(1,1,fullinteresting(0)) = psi_det_sorted(1,1,preinteresting(ii))
|
fullminilist(1,1,fullinteresting(0)) = preinteresting_det(1,1,ii)
|
||||||
fullminilist(1,2,fullinteresting(0)) = psi_det_sorted(1,2,preinteresting(ii))
|
fullminilist(1,2,fullinteresting(0)) = preinteresting_det(1,2,ii)
|
||||||
do j=2,N_int
|
do j=2,N_int
|
||||||
fullminilist(j,1,fullinteresting(0)) = psi_det_sorted(1,1,preinteresting(ii))
|
fullminilist(j,1,fullinteresting(0)) = preinteresting_det(j,1,ii)
|
||||||
fullminilist(j,2,fullinteresting(0)) = psi_det_sorted(1,2,preinteresting(ii))
|
fullminilist(j,2,fullinteresting(0)) = preinteresting_det(j,2,ii)
|
||||||
enddo
|
enddo
|
||||||
end if
|
end if
|
||||||
end if
|
end if
|
||||||
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
do ii=1,prefullinteresting(0)
|
do ii=1,prefullinteresting(0)
|
||||||
@ -627,12 +630,13 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
|
|||||||
logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2)
|
logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2)
|
||||||
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
|
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
|
||||||
|
|
||||||
integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt
|
integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt
|
||||||
integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2)
|
integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2)
|
||||||
|
integer :: phasemask(2,N_int*bit_kind_size)
|
||||||
! logical :: bandon
|
! logical :: bandon
|
||||||
!
|
!
|
||||||
! bandon = .false.
|
! bandon = .false.
|
||||||
PROVIDE psi_phasemask psi_selectors_coef_transp
|
PROVIDE psi_selectors_coef_transp
|
||||||
mat = 0d0
|
mat = 0d0
|
||||||
|
|
||||||
do i=1,N_int
|
do i=1,N_int
|
||||||
@ -691,12 +695,13 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere
|
|||||||
call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int)
|
call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int)
|
||||||
|
|
||||||
if (interesting(i) >= i_gen) then
|
if (interesting(i) >= i_gen) then
|
||||||
|
call get_mask_phase(psi_det_sorted(1,1,interesting(i)), phasemask)
|
||||||
if(nt == 4) then
|
if(nt == 4) then
|
||||||
call get_d2(det(1,1,i), psi_phasemask(1,1,interesting(i)), bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
call get_d2(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||||
else if(nt == 3) then
|
else if(nt == 3) then
|
||||||
call get_d1(det(1,1,i), psi_phasemask(1,1,interesting(i)), bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
call get_d1(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||||
else
|
else
|
||||||
call get_d0(det(1,1,i), psi_phasemask(1,1,interesting(i)), bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
call get_d0(det(1,1,i), phasemask, bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i)))
|
||||||
end if
|
end if
|
||||||
else
|
else
|
||||||
if(nt == 4) call past_d2(banned, p, sp)
|
if(nt == 4) call past_d2(banned, p, sp)
|
||||||
@ -711,7 +716,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
|||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
|
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
|
||||||
integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size)
|
integer, intent(in) :: phasemask(2,N_int*bit_kind_size)
|
||||||
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
|
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
|
||||||
double precision, intent(in) :: coefs(N_states)
|
double precision, intent(in) :: coefs(N_states)
|
||||||
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
|
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
|
||||||
@ -829,7 +834,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
|||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
|
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2)
|
||||||
integer(1),intent(in) :: phasemask(2,N_int*bit_kind_size)
|
integer,intent(in) :: phasemask(2,N_int*bit_kind_size)
|
||||||
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
|
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
|
||||||
integer(bit_kind) :: det(N_int, 2)
|
integer(bit_kind) :: det(N_int, 2)
|
||||||
double precision, intent(in) :: coefs(N_states)
|
double precision, intent(in) :: coefs(N_states)
|
||||||
@ -1001,7 +1006,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
|
|||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2)
|
||||||
integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size)
|
integer, intent(in) :: phasemask(2,N_int*bit_kind_size)
|
||||||
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
|
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
|
||||||
integer(bit_kind) :: det(N_int, 2)
|
integer(bit_kind) :: det(N_int, 2)
|
||||||
double precision, intent(in) :: coefs(N_states)
|
double precision, intent(in) :: coefs(N_states)
|
||||||
|
@ -19,13 +19,14 @@ end
|
|||||||
|
|
||||||
subroutine run_wf
|
subroutine run_wf
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
double precision :: energy(N_states)
|
double precision :: energy(N_states)
|
||||||
character*(64) :: states(4)
|
character*(64) :: states(4)
|
||||||
integer :: rc, i
|
integer :: rc, i, ierr
|
||||||
|
|
||||||
call provide_everything
|
call provide_everything
|
||||||
|
|
||||||
|
@ -5,7 +5,8 @@ program selection_slave
|
|||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
read_wf = .False.
|
read_wf = .False.
|
||||||
SOFT_TOUCH read_wf
|
distributed_davidson = .False.
|
||||||
|
SOFT_TOUCH read_wf distributed_davidson
|
||||||
call provide_everything
|
call provide_everything
|
||||||
call switch_qp_run_to_master
|
call switch_qp_run_to_master
|
||||||
call run_wf
|
call run_wf
|
||||||
@ -13,7 +14,7 @@ end
|
|||||||
|
|
||||||
subroutine provide_everything
|
subroutine provide_everything
|
||||||
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context
|
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context
|
||||||
PROVIDE pt2_e0_denominator mo_tot_num N_int fragment_count
|
PROVIDE pt2_e0_denominator mo_tot_num N_int fragment_count
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine run_wf
|
subroutine run_wf
|
||||||
@ -23,19 +24,21 @@ subroutine run_wf
|
|||||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
double precision :: energy(N_states)
|
double precision :: energy(N_states)
|
||||||
character*(64) :: states(1)
|
character*(64) :: states(4)
|
||||||
integer :: rc, i
|
integer :: rc, i
|
||||||
|
|
||||||
call provide_everything
|
call provide_everything
|
||||||
|
|
||||||
zmq_context = f77_zmq_ctx_new ()
|
zmq_context = f77_zmq_ctx_new ()
|
||||||
states(1) = 'selection'
|
states(1) = 'selection'
|
||||||
|
states(2) = 'davidson'
|
||||||
|
states(3) = 'pt2'
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
do
|
do
|
||||||
|
|
||||||
call wait_for_states(states,zmq_state,1)
|
call wait_for_states(states,zmq_state,3)
|
||||||
|
|
||||||
if(trim(zmq_state) == 'Stopped') then
|
if(trim(zmq_state) == 'Stopped') then
|
||||||
|
|
||||||
@ -51,21 +54,30 @@ subroutine run_wf
|
|||||||
|
|
||||||
!$OMP PARALLEL PRIVATE(i)
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
i = omp_get_thread_num()
|
i = omp_get_thread_num()
|
||||||
call selection_slave_tcp(i, energy)
|
call run_selection_slave(0,i,energy)
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
print *, 'Selection done'
|
print *, 'Selection done'
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'pt2') then
|
||||||
|
|
||||||
|
! PT2
|
||||||
|
! ---
|
||||||
|
|
||||||
|
print *, 'PT2'
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
|
||||||
|
logical :: lstop
|
||||||
|
lstop = .False.
|
||||||
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call run_pt2_slave(0,i,energy,lstop)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
print *, 'PT2 done'
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine selection_slave_tcp(i,energy)
|
|
||||||
implicit none
|
|
||||||
double precision, intent(in) :: energy(N_states)
|
|
||||||
integer, intent(in) :: i
|
|
||||||
|
|
||||||
call run_selection_slave(0,i,energy)
|
|
||||||
end
|
|
||||||
|
|
||||||
|
@ -102,7 +102,7 @@ subroutine selection_collector(b, N, pt2)
|
|||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
zmq_socket_pull = new_zmq_pull_socket()
|
zmq_socket_pull = new_zmq_pull_socket()
|
||||||
call create_selection_buffer(N, N*8, b2)
|
call create_selection_buffer(N, N*2, b2)
|
||||||
allocate(task_id(N_det_generators))
|
allocate(task_id(N_det_generators))
|
||||||
more = 1
|
more = 1
|
||||||
pt2(:) = 0d0
|
pt2(:) = 0d0
|
||||||
|
1
plugins/Full_CI_ZMQ_MPI/NEEDED_CHILDREN_MODULES
Normal file
1
plugins/Full_CI_ZMQ_MPI/NEEDED_CHILDREN_MODULES
Normal file
@ -0,0 +1 @@
|
|||||||
|
Full_CI_ZMQ MPI
|
14
plugins/Full_CI_ZMQ_MPI/README.rst
Normal file
14
plugins/Full_CI_ZMQ_MPI/README.rst
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
===============
|
||||||
|
Full_CI_ZMQ_MPI
|
||||||
|
===============
|
||||||
|
|
||||||
|
MPI Slave for Full_CI with ZMQ
|
||||||
|
|
||||||
|
Needed Modules
|
||||||
|
==============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
||||||
|
Documentation
|
||||||
|
=============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
101
plugins/Full_CI_ZMQ_MPI/selection_davidson_slave_mpi.irp.f
Normal file
101
plugins/Full_CI_ZMQ_MPI/selection_davidson_slave_mpi.irp.f
Normal file
@ -0,0 +1,101 @@
|
|||||||
|
program selection_slave
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Helper program to compute the PT2 in distributed mode.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
read_wf = .False.
|
||||||
|
distributed_davidson = .False.
|
||||||
|
SOFT_TOUCH read_wf distributed_davidson
|
||||||
|
call provide_everything
|
||||||
|
call switch_qp_run_to_master
|
||||||
|
call run_wf
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine provide_everything
|
||||||
|
PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context
|
||||||
|
PROVIDE pt2_e0_denominator mo_tot_num N_int fragment_count MPI_Initialized
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine run_wf
|
||||||
|
use f77_zmq
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
|
double precision :: energy(N_states)
|
||||||
|
character*(64) :: states(4)
|
||||||
|
integer :: rc, i, ierr
|
||||||
|
|
||||||
|
call provide_everything
|
||||||
|
|
||||||
|
zmq_context = f77_zmq_ctx_new ()
|
||||||
|
states(1) = 'selection'
|
||||||
|
states(2) = 'davidson'
|
||||||
|
states(3) = 'pt2'
|
||||||
|
|
||||||
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
|
do
|
||||||
|
|
||||||
|
call wait_for_states(states,zmq_state,3)
|
||||||
|
|
||||||
|
if(trim(zmq_state) == 'Stopped') then
|
||||||
|
|
||||||
|
exit
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'selection') then
|
||||||
|
|
||||||
|
! Selection
|
||||||
|
! ---------
|
||||||
|
|
||||||
|
print *, 'Selection'
|
||||||
|
if (is_mpi_master) then
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
endif
|
||||||
|
IRP_IF MIP
|
||||||
|
call MPI_BCAST(n,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call run_selection_slave(0,i,energy)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
print *, 'Selection done'
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'davidson') then
|
||||||
|
|
||||||
|
! Davidson
|
||||||
|
! --------
|
||||||
|
|
||||||
|
print *, 'Davidson'
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
call omp_set_nested(.True.)
|
||||||
|
call davidson_slave_tcp(0)
|
||||||
|
call omp_set_nested(.False.)
|
||||||
|
print *, 'Davidson done'
|
||||||
|
|
||||||
|
else if (trim(zmq_state) == 'pt2') then
|
||||||
|
|
||||||
|
! PT2
|
||||||
|
! ---
|
||||||
|
|
||||||
|
print *, 'PT2'
|
||||||
|
call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states)
|
||||||
|
|
||||||
|
logical :: lstop
|
||||||
|
lstop = .False.
|
||||||
|
!$OMP PARALLEL PRIVATE(i)
|
||||||
|
i = omp_get_thread_num()
|
||||||
|
call run_pt2_slave(0,i,energy,lstop)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
print *, 'PT2 done'
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
end do
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -14,9 +14,9 @@ BEGIN_PROVIDER [ integer, N_det_generators ]
|
|||||||
good = .True.
|
good = .True.
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
good = good .and. ( &
|
good = good .and. ( &
|
||||||
iand(not(cas_bitmask(k,1,l)), psi_det(k,1,i)) == &
|
iand(not(cas_bitmask(k,1,l)), psi_det_sorted(k,1,i)) == &
|
||||||
iand(not(cas_bitmask(k,1,l)), HF_bitmask(k,1)) ) .and. ( &
|
iand(not(cas_bitmask(k,1,l)), HF_bitmask(k,1)) ) .and. ( &
|
||||||
iand(not(cas_bitmask(k,2,l)), psi_det(k,2,i)) == &
|
iand(not(cas_bitmask(k,2,l)), psi_det_sorted(k,2,i)) == &
|
||||||
iand(not(cas_bitmask(k,2,l)), HF_bitmask(k,2)) )
|
iand(not(cas_bitmask(k,2,l)), HF_bitmask(k,2)) )
|
||||||
enddo
|
enddo
|
||||||
if (good) then
|
if (good) then
|
||||||
@ -46,9 +46,9 @@ END_PROVIDER
|
|||||||
good = .True.
|
good = .True.
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
good = good .and. ( &
|
good = good .and. ( &
|
||||||
iand(not(cas_bitmask(k,1,l)), psi_det(k,1,i)) == &
|
iand(not(cas_bitmask(k,1,l)), psi_det_sorted(k,1,i)) == &
|
||||||
iand(not(cas_bitmask(k,1,l)), HF_bitmask(k,1)) .and. ( &
|
iand(not(cas_bitmask(k,1,l)), HF_bitmask(k,1)) .and. ( &
|
||||||
iand(not(cas_bitmask(k,2,l)), psi_det(k,2,i)) == &
|
iand(not(cas_bitmask(k,2,l)), psi_det_sorted(k,2,i)) == &
|
||||||
iand(not(cas_bitmask(k,2,l)), HF_bitmask(k,2) )) )
|
iand(not(cas_bitmask(k,2,l)), HF_bitmask(k,2) )) )
|
||||||
enddo
|
enddo
|
||||||
if (good) then
|
if (good) then
|
||||||
@ -58,8 +58,8 @@ END_PROVIDER
|
|||||||
if (good) then
|
if (good) then
|
||||||
m = m+1
|
m = m+1
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
psi_det_generators(k,1,m) = psi_det(k,1,i)
|
psi_det_generators(k,1,m) = psi_det_sorted(k,1,i)
|
||||||
psi_det_generators(k,2,m) = psi_det(k,2,i)
|
psi_det_generators(k,2,m) = psi_det_sorted(k,2,i)
|
||||||
enddo
|
enddo
|
||||||
psi_coef_generators(m,:) = psi_coef(m,:)
|
psi_coef_generators(m,:) = psi_coef(m,:)
|
||||||
endif
|
endif
|
||||||
|
196
plugins/Hartree_Fock/DIIS.irp.f
Normal file
196
plugins/Hartree_Fock/DIIS.irp.f
Normal file
@ -0,0 +1,196 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, threshold_DIIS_nonzero ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! If threshold_DIIS is zero, choose sqrt(thresh_scf)
|
||||||
|
END_DOC
|
||||||
|
if (threshold_DIIS == 0.d0) then
|
||||||
|
threshold_DIIS_nonzero = dsqrt(thresh_scf)
|
||||||
|
else
|
||||||
|
threshold_DIIS_nonzero = threshold_DIIS
|
||||||
|
endif
|
||||||
|
ASSERT (threshold_DIIS_nonzero >= 0.d0)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, FPS_SPF_Matrix_AO, (AO_num, AO_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Commutator FPS - SPF
|
||||||
|
END_DOC
|
||||||
|
double precision, allocatable :: scratch(:,:)
|
||||||
|
allocate( &
|
||||||
|
scratch(AO_num_align, AO_num) &
|
||||||
|
)
|
||||||
|
|
||||||
|
! Compute FP
|
||||||
|
|
||||||
|
call dgemm('N','N',AO_num,AO_num,AO_num, &
|
||||||
|
1.d0, &
|
||||||
|
Fock_Matrix_AO,Size(Fock_Matrix_AO,1), &
|
||||||
|
HF_Density_Matrix_AO,Size(HF_Density_Matrix_AO,1), &
|
||||||
|
0.d0, &
|
||||||
|
scratch,Size(scratch,1))
|
||||||
|
|
||||||
|
! Compute FPS
|
||||||
|
|
||||||
|
call dgemm('N','N',AO_num,AO_num,AO_num, &
|
||||||
|
1.d0, &
|
||||||
|
scratch,Size(scratch,1), &
|
||||||
|
AO_Overlap,Size(AO_Overlap,1), &
|
||||||
|
0.d0, &
|
||||||
|
FPS_SPF_Matrix_AO,Size(FPS_SPF_Matrix_AO,1))
|
||||||
|
|
||||||
|
! Compute SP
|
||||||
|
|
||||||
|
call dgemm('N','N',AO_num,AO_num,AO_num, &
|
||||||
|
1.d0, &
|
||||||
|
AO_Overlap,Size(AO_Overlap,1), &
|
||||||
|
HF_Density_Matrix_AO,Size(HF_Density_Matrix_AO,1), &
|
||||||
|
0.d0, &
|
||||||
|
scratch,Size(scratch,1))
|
||||||
|
|
||||||
|
! Compute FPS - SPF
|
||||||
|
|
||||||
|
call dgemm('N','N',AO_num,AO_num,AO_num, &
|
||||||
|
-1.d0, &
|
||||||
|
scratch,Size(scratch,1), &
|
||||||
|
Fock_Matrix_AO,Size(Fock_Matrix_AO,1), &
|
||||||
|
1.d0, &
|
||||||
|
FPS_SPF_Matrix_AO,Size(FPS_SPF_Matrix_AO,1))
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
bEGIN_PROVIDER [double precision, FPS_SPF_Matrix_MO, (mo_tot_num, mo_tot_num)]
|
||||||
|
implicit none
|
||||||
|
begin_doc
|
||||||
|
! Commutator FPS - SPF in MO basis
|
||||||
|
end_doc
|
||||||
|
call ao_to_mo(FPS_SPF_Matrix_AO, size(FPS_SPF_Matrix_AO,1), &
|
||||||
|
FPS_SPF_Matrix_MO, size(FPS_SPF_Matrix_MO,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, eigenvalues_Fock_matrix_AO, (AO_num) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, eigenvectors_Fock_matrix_AO, (AO_num_align,AO_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Eigenvalues and eigenvectors of the Fock matrix over the AO basis
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision, allocatable :: scratch(:,:),work(:),Xt(:,:)
|
||||||
|
integer :: lwork,info
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
lwork = 3*AO_num - 1
|
||||||
|
allocate( &
|
||||||
|
scratch(AO_num_align,AO_num), &
|
||||||
|
work(lwork), &
|
||||||
|
Xt(AO_num,AO_num) &
|
||||||
|
)
|
||||||
|
|
||||||
|
! Calculate Xt
|
||||||
|
|
||||||
|
do i=1,AO_num
|
||||||
|
do j=1,AO_num
|
||||||
|
Xt(i,j) = X_Matrix_AO(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Calculate Fock matrix in orthogonal basis: F' = Xt.F.X
|
||||||
|
|
||||||
|
call dgemm('N','N',AO_num,AO_num,AO_num, &
|
||||||
|
1.d0, &
|
||||||
|
Fock_matrix_AO,size(Fock_matrix_AO,1), &
|
||||||
|
X_Matrix_AO,size(X_Matrix_AO,1), &
|
||||||
|
0.d0, &
|
||||||
|
eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1))
|
||||||
|
|
||||||
|
call dgemm('N','N',AO_num,AO_num,AO_num, &
|
||||||
|
1.d0, &
|
||||||
|
Xt,size(Xt,1), &
|
||||||
|
eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1), &
|
||||||
|
0.d0, &
|
||||||
|
scratch,size(scratch,1))
|
||||||
|
|
||||||
|
! Diagonalize F' to obtain eigenvectors in orthogonal basis C' and eigenvalues
|
||||||
|
|
||||||
|
call dsyev('V','U',AO_num, &
|
||||||
|
scratch,size(scratch,1), &
|
||||||
|
eigenvalues_Fock_matrix_AO, &
|
||||||
|
work,lwork,info)
|
||||||
|
|
||||||
|
if(info /= 0) then
|
||||||
|
print *, irp_here//' failed : ', info
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Back-transform eigenvectors: C =X.C'
|
||||||
|
|
||||||
|
call dgemm('N','N',AO_num,AO_num,AO_num, &
|
||||||
|
1.d0, &
|
||||||
|
X_matrix_AO,size(X_matrix_AO,1), &
|
||||||
|
scratch,size(scratch,1), &
|
||||||
|
0.d0, &
|
||||||
|
eigenvectors_Fock_matrix_AO,size(eigenvectors_Fock_matrix_AO,1))
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, X_matrix_AO, (AO_num_align,AO_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Matrix X = S^{-1/2} obtained by SVD
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: num_linear_dependencies
|
||||||
|
integer :: LDA, LDC
|
||||||
|
double precision, allocatable :: U(:,:),Vt(:,:), D(:)
|
||||||
|
integer :: info, i, j, k
|
||||||
|
|
||||||
|
LDA = size(AO_overlap,1)
|
||||||
|
LDC = size(X_matrix_AO,1)
|
||||||
|
|
||||||
|
allocate( &
|
||||||
|
U(LDC,AO_num), &
|
||||||
|
Vt(LDA,AO_num), &
|
||||||
|
D(AO_num))
|
||||||
|
|
||||||
|
call svd( &
|
||||||
|
AO_overlap,LDA, &
|
||||||
|
U,LDC, &
|
||||||
|
D, &
|
||||||
|
Vt,LDA, &
|
||||||
|
AO_num,AO_num)
|
||||||
|
|
||||||
|
num_linear_dependencies = 0
|
||||||
|
do i=1,AO_num
|
||||||
|
print*,D(i)
|
||||||
|
if(abs(D(i)) <= threshold_overlap_AO_eigenvalues) then
|
||||||
|
D(i) = 0.d0
|
||||||
|
num_linear_dependencies += 1
|
||||||
|
else
|
||||||
|
ASSERT (D(i) > 0.d0)
|
||||||
|
D(i) = 1.d0/sqrt(D(i))
|
||||||
|
endif
|
||||||
|
do j=1,AO_num
|
||||||
|
X_matrix_AO(j,i) = 0.d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
write(*,*) 'linear dependencies',num_linear_dependencies
|
||||||
|
! stop
|
||||||
|
|
||||||
|
do k=1,AO_num
|
||||||
|
if(D(k) /= 0.d0) then
|
||||||
|
do j=1,AO_num
|
||||||
|
do i=1,AO_num
|
||||||
|
X_matrix_AO(i,j) = X_matrix_AO(i,j) + U(i,k)*D(k)*Vt(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
@ -1,6 +1,24 @@
|
|||||||
|
[threshold_overlap_ao_eigenvalues]
|
||||||
|
type: Threshold
|
||||||
|
doc: Threshold on the magnitude of the smallest eigenvalues of the overlap matrix in the AO basis
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-6
|
||||||
|
|
||||||
|
[max_dim_diis]
|
||||||
|
type: integer
|
||||||
|
doc: Maximum size of the DIIS extrapolation procedure
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 15
|
||||||
|
|
||||||
|
[threshold_diis]
|
||||||
|
type: Threshold
|
||||||
|
doc: Threshold on the convergence of the DIIS error vector during a Hartree-Fock calculation. If 0. is chosen, the square root of thresh_scf will be used.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.
|
||||||
|
|
||||||
[thresh_scf]
|
[thresh_scf]
|
||||||
type: Threshold
|
type: Threshold
|
||||||
doc: Threshold on the convergence of the Hartree Fock energy
|
doc: Threshold on the convergence of the Hartree Fock energy.
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: 1.e-10
|
default: 1.e-10
|
||||||
|
|
||||||
@ -8,13 +26,19 @@ default: 1.e-10
|
|||||||
type: Strictly_positive_int
|
type: Strictly_positive_int
|
||||||
doc: Maximum number of SCF iterations
|
doc: Maximum number of SCF iterations
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: 200
|
default: 500
|
||||||
|
|
||||||
[level_shift]
|
[level_shift]
|
||||||
type: Positive_float
|
type: Positive_float
|
||||||
doc: Energy shift on the virtual MOs to improve SCF convergence
|
doc: Energy shift on the virtual MOs to improve SCF convergence
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: 0.5
|
default: 0.0
|
||||||
|
|
||||||
|
[scf_algorithm]
|
||||||
|
type: character*(32)
|
||||||
|
doc: Type of SCF algorithm used. Possible choices are [ Simple | DIIS]
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: DIIS
|
||||||
|
|
||||||
[mo_guess_type]
|
[mo_guess_type]
|
||||||
type: MO_guess
|
type: MO_guess
|
||||||
|
@ -18,57 +18,57 @@
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,n
|
integer :: i,j,n
|
||||||
if (elec_alpha_num == elec_beta_num) then
|
if (elec_alpha_num == elec_beta_num) then
|
||||||
Fock_matrix_mo = Fock_matrix_alpha_mo
|
Fock_matrix_mo = Fock_matrix_mo_alpha
|
||||||
else
|
else
|
||||||
|
|
||||||
do j=1,elec_beta_num
|
do j=1,elec_beta_num
|
||||||
! F-K
|
! F-K
|
||||||
do i=1,elec_beta_num
|
do i=1,elec_beta_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
- (Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
|
- (Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F+K/2
|
! F+K/2
|
||||||
do i=elec_beta_num+1,elec_alpha_num
|
do i=elec_beta_num+1,elec_alpha_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
+ 0.5d0*(Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
|
+ 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F
|
! F
|
||||||
do i=elec_alpha_num+1, mo_tot_num
|
do i=elec_alpha_num+1, mo_tot_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do j=elec_beta_num+1,elec_alpha_num
|
do j=elec_beta_num+1,elec_alpha_num
|
||||||
! F+K/2
|
! F+K/2
|
||||||
do i=1,elec_beta_num
|
do i=1,elec_beta_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
+ 0.5d0*(Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
|
+ 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F
|
! F
|
||||||
do i=elec_beta_num+1,elec_alpha_num
|
do i=elec_beta_num+1,elec_alpha_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F-K/2
|
! F-K/2
|
||||||
do i=elec_alpha_num+1, mo_tot_num
|
do i=elec_alpha_num+1, mo_tot_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
- 0.5d0*(Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
|
- 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do j=elec_alpha_num+1, mo_tot_num
|
do j=elec_alpha_num+1, mo_tot_num
|
||||||
! F
|
! F
|
||||||
do i=1,elec_beta_num
|
do i=1,elec_beta_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F-K/2
|
! F-K/2
|
||||||
do i=elec_beta_num+1,elec_alpha_num
|
do i=elec_beta_num+1,elec_alpha_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
- 0.5d0*(Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
|
- 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F+K
|
! F+K
|
||||||
do i=elec_alpha_num+1,mo_tot_num
|
do i=elec_alpha_num+1,mo_tot_num
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j)) &
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j)) &
|
||||||
+ (Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
|
+ (Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -81,8 +81,8 @@ END_PROVIDER
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, Fock_matrix_alpha_ao, (ao_num_align, ao_num) ]
|
BEGIN_PROVIDER [ double precision, Fock_matrix_ao_alpha, (ao_num_align, ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, Fock_matrix_beta_ao, (ao_num_align, ao_num) ]
|
&BEGIN_PROVIDER [ double precision, Fock_matrix_ao_beta, (ao_num_align, ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Alpha Fock matrix in AO basis set
|
! Alpha Fock matrix in AO basis set
|
||||||
@ -92,8 +92,8 @@ END_PROVIDER
|
|||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
!DIR$ VECTOR ALIGNED
|
!DIR$ VECTOR ALIGNED
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
Fock_matrix_alpha_ao(i,j) = ao_mono_elec_integral(i,j) + ao_bi_elec_integral_alpha(i,j)
|
Fock_matrix_ao_alpha(i,j) = ao_mono_elec_integral(i,j) + ao_bi_elec_integral_alpha(i,j)
|
||||||
Fock_matrix_beta_ao (i,j) = ao_mono_elec_integral(i,j) + ao_bi_elec_integral_beta (i,j)
|
Fock_matrix_ao_beta (i,j) = ao_mono_elec_integral(i,j) + ao_bi_elec_integral_beta (i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -261,12 +261,7 @@ END_PROVIDER
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, Fock_matrix_mo_alpha, (mo_tot_num_align,mo_tot_num) ]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, Fock_matrix_alpha_mo, (mo_tot_num_align,mo_tot_num) ]
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Fock matrix on the MO basis
|
! Fock matrix on the MO basis
|
||||||
@ -275,18 +270,18 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_alpha_mo, (mo_tot_num_align,mo_to
|
|||||||
allocate ( T(ao_num_align,mo_tot_num) )
|
allocate ( T(ao_num_align,mo_tot_num) )
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
call dgemm('N','N', ao_num, mo_tot_num, ao_num, &
|
call dgemm('N','N', ao_num, mo_tot_num, ao_num, &
|
||||||
1.d0, Fock_matrix_alpha_ao,size(Fock_matrix_alpha_ao,1), &
|
1.d0, Fock_matrix_ao_alpha,size(Fock_matrix_ao_alpha,1), &
|
||||||
mo_coef, size(mo_coef,1), &
|
mo_coef, size(mo_coef,1), &
|
||||||
0.d0, T, ao_num_align)
|
0.d0, T, ao_num_align)
|
||||||
call dgemm('T','N', mo_tot_num, mo_tot_num, ao_num, &
|
call dgemm('T','N', mo_tot_num, mo_tot_num, ao_num, &
|
||||||
1.d0, mo_coef,size(mo_coef,1), &
|
1.d0, mo_coef,size(mo_coef,1), &
|
||||||
T, size(T,1), &
|
T, size(T,1), &
|
||||||
0.d0, Fock_matrix_alpha_mo, mo_tot_num_align)
|
0.d0, Fock_matrix_mo_alpha, mo_tot_num_align)
|
||||||
deallocate(T)
|
deallocate(T)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, Fock_matrix_beta_mo, (mo_tot_num_align,mo_tot_num) ]
|
BEGIN_PROVIDER [ double precision, Fock_matrix_mo_beta, (mo_tot_num_align,mo_tot_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Fock matrix on the MO basis
|
! Fock matrix on the MO basis
|
||||||
@ -295,13 +290,13 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_beta_mo, (mo_tot_num_align,mo_tot
|
|||||||
allocate ( T(ao_num_align,mo_tot_num) )
|
allocate ( T(ao_num_align,mo_tot_num) )
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
call dgemm('N','N', ao_num, mo_tot_num, ao_num, &
|
call dgemm('N','N', ao_num, mo_tot_num, ao_num, &
|
||||||
1.d0, Fock_matrix_beta_ao,size(Fock_matrix_beta_ao,1), &
|
1.d0, Fock_matrix_ao_beta,size(Fock_matrix_ao_beta,1), &
|
||||||
mo_coef, size(mo_coef,1), &
|
mo_coef, size(mo_coef,1), &
|
||||||
0.d0, T, ao_num_align)
|
0.d0, T, ao_num_align)
|
||||||
call dgemm('T','N', mo_tot_num, mo_tot_num, ao_num, &
|
call dgemm('T','N', mo_tot_num, mo_tot_num, ao_num, &
|
||||||
1.d0, mo_coef,size(mo_coef,1), &
|
1.d0, mo_coef,size(mo_coef,1), &
|
||||||
T, size(T,1), &
|
T, size(T,1), &
|
||||||
0.d0, Fock_matrix_beta_mo, mo_tot_num_align)
|
0.d0, Fock_matrix_mo_beta, mo_tot_num_align)
|
||||||
deallocate(T)
|
deallocate(T)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
@ -316,8 +311,8 @@ BEGIN_PROVIDER [ double precision, HF_energy ]
|
|||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
HF_energy += 0.5d0 * ( &
|
HF_energy += 0.5d0 * ( &
|
||||||
(ao_mono_elec_integral(i,j) + Fock_matrix_alpha_ao(i,j) ) * HF_density_matrix_ao_alpha(i,j) +&
|
(ao_mono_elec_integral(i,j) + Fock_matrix_ao_alpha(i,j) ) * HF_density_matrix_ao_alpha(i,j) +&
|
||||||
(ao_mono_elec_integral(i,j) + Fock_matrix_beta_ao (i,j) ) * HF_density_matrix_ao_beta (i,j) )
|
(ao_mono_elec_integral(i,j) + Fock_matrix_ao_beta (i,j) ) * HF_density_matrix_ao_beta (i,j) )
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -337,7 +332,7 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_ao, (ao_num_align, ao_num) ]
|
|||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
!DIR$ VECTOR ALIGNED
|
!DIR$ VECTOR ALIGNED
|
||||||
do i=1,ao_num_align
|
do i=1,ao_num_align
|
||||||
Fock_matrix_ao(i,j) = Fock_matrix_alpha_ao(i,j)
|
Fock_matrix_ao(i,j) = Fock_matrix_ao_alpha(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
else
|
else
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
BEGIN_PROVIDER [ double precision, HF_density_matrix_ao_alpha, (ao_num_align,ao_num) ]
|
BEGIN_PROVIDER [double precision, HF_density_matrix_ao_alpha, (ao_num_align,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! S^-1 x Alpha density matrix in the AO basis x S^-1
|
! S^-1 x Alpha density matrix in the AO basis x S^-1
|
||||||
|
283
plugins/Hartree_Fock/Roothaan_Hall_SCF.irp.f
Normal file
283
plugins/Hartree_Fock/Roothaan_Hall_SCF.irp.f
Normal file
@ -0,0 +1,283 @@
|
|||||||
|
subroutine Roothaan_Hall_SCF
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Roothaan-Hall algorithm for SCF Hartree-Fock calculation
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision :: energy_SCF,energy_SCF_previous,Delta_energy_SCF
|
||||||
|
double precision :: max_error_DIIS,max_error_DIIS_alpha,max_error_DIIS_beta
|
||||||
|
double precision, allocatable :: Fock_matrix_DIIS(:,:,:),error_matrix_DIIS(:,:,:)
|
||||||
|
|
||||||
|
integer :: iteration_SCF,dim_DIIS,index_dim_DIIS
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
double precision, allocatable :: mo_coef_save(:,:)
|
||||||
|
|
||||||
|
allocate(mo_coef_save(ao_num,mo_tot_num), &
|
||||||
|
Fock_matrix_DIIS (ao_num,ao_num,max_dim_DIIS), &
|
||||||
|
error_matrix_DIIS(ao_num,ao_num,max_dim_DIIS) &
|
||||||
|
)
|
||||||
|
|
||||||
|
call write_time(output_hartree_fock)
|
||||||
|
|
||||||
|
write(output_hartree_fock,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
|
||||||
|
'====','================','================','================'
|
||||||
|
write(output_hartree_fock,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
|
||||||
|
' N ', 'Energy ', 'Energy diff ', 'DIIS error '
|
||||||
|
write(output_hartree_fock,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
|
||||||
|
'====','================','================','================'
|
||||||
|
|
||||||
|
! Initialize energies and density matrices
|
||||||
|
|
||||||
|
energy_SCF_previous = HF_energy
|
||||||
|
Delta_energy_SCF = 1.d0
|
||||||
|
iteration_SCF = 0
|
||||||
|
dim_DIIS = 0
|
||||||
|
max_error_DIIS = 1.d0
|
||||||
|
|
||||||
|
|
||||||
|
!
|
||||||
|
! Start of main SCF loop
|
||||||
|
!
|
||||||
|
do while(( (max_error_DIIS > threshold_DIIS_nonzero).or.(dabs(Delta_energy_SCF) > thresh_SCF) ) .and. (iteration_SCF < n_it_SCF_max))
|
||||||
|
|
||||||
|
! Increment cycle number
|
||||||
|
|
||||||
|
iteration_SCF += 1
|
||||||
|
|
||||||
|
! Current size of the DIIS space
|
||||||
|
|
||||||
|
dim_DIIS = min(dim_DIIS+1,max_dim_DIIS)
|
||||||
|
|
||||||
|
if (scf_algorithm == 'DIIS') then
|
||||||
|
|
||||||
|
! Store Fock and error matrices at each iteration
|
||||||
|
do j=1,ao_num
|
||||||
|
do i=1,ao_num
|
||||||
|
index_dim_DIIS = mod(dim_DIIS-1,max_dim_DIIS)+1
|
||||||
|
Fock_matrix_DIIS (i,j,index_dim_DIIS) = Fock_matrix_AO(i,j)
|
||||||
|
error_matrix_DIIS(i,j,index_dim_DIIS) = FPS_SPF_matrix_AO(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Compute the extrapolated Fock matrix
|
||||||
|
|
||||||
|
call extrapolate_Fock_matrix( &
|
||||||
|
error_matrix_DIIS,Fock_matrix_DIIS, &
|
||||||
|
Fock_matrix_AO,size(Fock_matrix_AO,1), &
|
||||||
|
iteration_SCF,dim_DIIS &
|
||||||
|
)
|
||||||
|
|
||||||
|
Fock_matrix_AO_alpha = Fock_matrix_AO*0.5d0
|
||||||
|
Fock_matrix_AO_beta = Fock_matrix_AO*0.5d0
|
||||||
|
TOUCH Fock_matrix_AO_alpha Fock_matrix_AO_beta
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
MO_coef = eigenvectors_Fock_matrix_MO
|
||||||
|
|
||||||
|
TOUCH MO_coef
|
||||||
|
|
||||||
|
! Calculate error vectors
|
||||||
|
|
||||||
|
max_error_DIIS = maxval(Abs(FPS_SPF_Matrix_MO))
|
||||||
|
|
||||||
|
! SCF energy
|
||||||
|
|
||||||
|
energy_SCF = HF_energy
|
||||||
|
Delta_Energy_SCF = energy_SCF - energy_SCF_previous
|
||||||
|
if ( (SCF_algorithm == 'DIIS').and.(Delta_Energy_SCF > 0.d0) ) then
|
||||||
|
Fock_matrix_AO(1:ao_num,1:ao_num) = Fock_matrix_DIIS (1:ao_num,1:ao_num,index_dim_DIIS)
|
||||||
|
Fock_matrix_AO_alpha = Fock_matrix_AO*0.5d0
|
||||||
|
Fock_matrix_AO_beta = Fock_matrix_AO*0.5d0
|
||||||
|
TOUCH Fock_matrix_AO_alpha Fock_matrix_AO_beta
|
||||||
|
endif
|
||||||
|
|
||||||
|
double precision :: level_shift_save
|
||||||
|
level_shift_save = level_shift
|
||||||
|
mo_coef_save(1:ao_num,1:mo_tot_num) = mo_coef(1:ao_num,1:mo_tot_num)
|
||||||
|
do while (Delta_Energy_SCF > 0.d0)
|
||||||
|
mo_coef(1:ao_num,1:mo_tot_num) = mo_coef_save
|
||||||
|
TOUCH mo_coef
|
||||||
|
level_shift = level_shift + 0.1d0
|
||||||
|
mo_coef(1:ao_num,1:mo_tot_num) = eigenvectors_Fock_matrix_MO(1:ao_num,1:mo_tot_num)
|
||||||
|
TOUCH mo_coef level_shift
|
||||||
|
Delta_Energy_SCF = HF_energy - energy_SCF_previous
|
||||||
|
energy_SCF = HF_energy
|
||||||
|
if (level_shift-level_shift_save > 1.d0) exit
|
||||||
|
dim_DIIS=0
|
||||||
|
enddo
|
||||||
|
level_shift = level_shift_save
|
||||||
|
SOFT_TOUCH level_shift
|
||||||
|
energy_SCF_previous = energy_SCF
|
||||||
|
|
||||||
|
! Print results at the end of each iteration
|
||||||
|
|
||||||
|
write(output_hartree_fock,'(I4, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, I3)') &
|
||||||
|
iteration_SCF, energy_SCF, Delta_energy_SCF, max_error_DIIS, dim_DIIS
|
||||||
|
|
||||||
|
if (Delta_energy_SCF < 0.d0) then
|
||||||
|
call save_mos
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!
|
||||||
|
! End of Main SCF loop
|
||||||
|
!
|
||||||
|
|
||||||
|
write(output_hartree_fock,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
|
||||||
|
'====','================','================','================'
|
||||||
|
write(output_hartree_fock,*)
|
||||||
|
|
||||||
|
if(.not.no_oa_or_av_opt)then
|
||||||
|
call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo,size(Fock_matrix_mo,1),size(Fock_matrix_mo,2),mo_label,1)
|
||||||
|
endif
|
||||||
|
|
||||||
|
call write_double(output_hartree_fock, Energy_SCF, 'Hartree-Fock energy')
|
||||||
|
call ezfio_set_hartree_fock_energy(Energy_SCF)
|
||||||
|
|
||||||
|
call write_time(output_hartree_fock)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine extrapolate_Fock_matrix( &
|
||||||
|
error_matrix_DIIS,Fock_matrix_DIIS, &
|
||||||
|
Fock_matrix_AO_,size_Fock_matrix_AO, &
|
||||||
|
iteration_SCF,dim_DIIS &
|
||||||
|
)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the extrapolated Fock matrix using the DIIS procedure
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision,intent(in) :: Fock_matrix_DIIS(ao_num,ao_num,*),error_matrix_DIIS(ao_num,ao_num,*)
|
||||||
|
integer,intent(in) :: iteration_SCF, size_Fock_matrix_AO
|
||||||
|
double precision,intent(inout):: Fock_matrix_AO_(size_Fock_matrix_AO,ao_num)
|
||||||
|
integer,intent(inout) :: dim_DIIS
|
||||||
|
|
||||||
|
double precision,allocatable :: B_matrix_DIIS(:,:),X_vector_DIIS(:)
|
||||||
|
double precision,allocatable :: C_vector_DIIS(:)
|
||||||
|
|
||||||
|
double precision,allocatable :: scratch(:,:)
|
||||||
|
integer :: i,j,k,i_DIIS,j_DIIS
|
||||||
|
|
||||||
|
allocate( &
|
||||||
|
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1), &
|
||||||
|
X_vector_DIIS(dim_DIIS+1), &
|
||||||
|
C_vector_DIIS(dim_DIIS+1), &
|
||||||
|
scratch(ao_num,ao_num) &
|
||||||
|
)
|
||||||
|
|
||||||
|
! Compute the matrices B and X
|
||||||
|
do j=1,dim_DIIS
|
||||||
|
do i=1,dim_DIIS
|
||||||
|
|
||||||
|
j_DIIS = mod(iteration_SCF-j,max_dim_DIIS)+1
|
||||||
|
i_DIIS = mod(iteration_SCF-i,max_dim_DIIS)+1
|
||||||
|
|
||||||
|
! Compute product of two errors vectors
|
||||||
|
|
||||||
|
call dgemm('N','N',ao_num,ao_num,ao_num, &
|
||||||
|
1.d0, &
|
||||||
|
error_matrix_DIIS(1,1,i_DIIS),size(error_matrix_DIIS,1), &
|
||||||
|
error_matrix_DIIS(1,1,j_DIIS),size(error_matrix_DIIS,1), &
|
||||||
|
0.d0, &
|
||||||
|
scratch,size(scratch,1))
|
||||||
|
|
||||||
|
! Compute Trace
|
||||||
|
|
||||||
|
B_matrix_DIIS(i,j) = 0.d0
|
||||||
|
do k=1,ao_num
|
||||||
|
B_matrix_DIIS(i,j) = B_matrix_DIIS(i,j) + scratch(k,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Pad B matrix and build the X matrix
|
||||||
|
|
||||||
|
do i=1,dim_DIIS
|
||||||
|
B_matrix_DIIS(i,dim_DIIS+1) = -1.d0
|
||||||
|
B_matrix_DIIS(dim_DIIS+1,i) = -1.d0
|
||||||
|
C_vector_DIIS(i) = 0.d0
|
||||||
|
enddo
|
||||||
|
B_matrix_DIIS(dim_DIIS+1,dim_DIIS+1) = 0.d0
|
||||||
|
C_vector_DIIS(dim_DIIS+1) = -1.d0
|
||||||
|
|
||||||
|
! Solve the linear system C = B.X
|
||||||
|
|
||||||
|
integer :: info
|
||||||
|
integer,allocatable :: ipiv(:)
|
||||||
|
|
||||||
|
allocate( &
|
||||||
|
ipiv(dim_DIIS+1) &
|
||||||
|
)
|
||||||
|
|
||||||
|
double precision, allocatable :: AF(:,:)
|
||||||
|
allocate (AF(dim_DIIS+1,dim_DIIS+1))
|
||||||
|
double precision :: rcond, ferr, berr
|
||||||
|
integer :: iwork(dim_DIIS+1), lwork
|
||||||
|
|
||||||
|
call dsysvx('N','U',dim_DIIS+1,1, &
|
||||||
|
B_matrix_DIIS,size(B_matrix_DIIS,1), &
|
||||||
|
AF, size(AF,1), &
|
||||||
|
ipiv, &
|
||||||
|
C_vector_DIIS,size(C_vector_DIIS,1), &
|
||||||
|
X_vector_DIIS,size(X_vector_DIIS,1), &
|
||||||
|
rcond, &
|
||||||
|
ferr, &
|
||||||
|
berr, &
|
||||||
|
scratch,-1, &
|
||||||
|
iwork, &
|
||||||
|
info &
|
||||||
|
)
|
||||||
|
lwork = int(scratch(1,1))
|
||||||
|
deallocate(scratch)
|
||||||
|
allocate(scratch(lwork,1))
|
||||||
|
|
||||||
|
call dsysvx('N','U',dim_DIIS+1,1, &
|
||||||
|
B_matrix_DIIS,size(B_matrix_DIIS,1), &
|
||||||
|
AF, size(AF,1), &
|
||||||
|
ipiv, &
|
||||||
|
C_vector_DIIS,size(C_vector_DIIS,1), &
|
||||||
|
X_vector_DIIS,size(X_vector_DIIS,1), &
|
||||||
|
rcond, &
|
||||||
|
ferr, &
|
||||||
|
berr, &
|
||||||
|
scratch,size(scratch), &
|
||||||
|
iwork, &
|
||||||
|
info &
|
||||||
|
)
|
||||||
|
|
||||||
|
if(info < 0) then
|
||||||
|
stop 'bug in DIIS'
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (rcond > 1.d-12) then
|
||||||
|
|
||||||
|
! Compute extrapolated Fock matrix
|
||||||
|
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO PRIVATE(i,j,k) DEFAULT(SHARED)
|
||||||
|
do j=1,ao_num
|
||||||
|
do i=1,ao_num
|
||||||
|
Fock_matrix_AO_(i,j) = 0.d0
|
||||||
|
enddo
|
||||||
|
do k=1,dim_DIIS
|
||||||
|
do i=1,ao_num
|
||||||
|
Fock_matrix_AO_(i,j) = Fock_matrix_AO_(i,j) + &
|
||||||
|
X_vector_DIIS(k)*Fock_matrix_DIIS(i,j,dim_DIIS-k+1)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
else
|
||||||
|
dim_DIIS = 0
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
@ -13,7 +13,7 @@ end
|
|||||||
subroutine create_guess
|
subroutine create_guess
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Create an MO guess if no MOs are present in the EZFIO directory
|
! Create a MO guess if no MOs are present in the EZFIO directory
|
||||||
END_DOC
|
END_DOC
|
||||||
logical :: exists
|
logical :: exists
|
||||||
PROVIDE ezfio_filename
|
PROVIDE ezfio_filename
|
||||||
@ -34,21 +34,30 @@ subroutine create_guess
|
|||||||
endif
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
ao_to_mo
|
||||||
|
|
||||||
subroutine run
|
subroutine run
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Run SCF calculation
|
||||||
|
END_DOC
|
||||||
|
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
|
||||||
! Run SCF calculation
|
|
||||||
END_DOC
|
|
||||||
double precision :: SCF_energy_before,SCF_energy_after,diag_H_mat_elem
|
double precision :: SCF_energy_before,SCF_energy_after,diag_H_mat_elem
|
||||||
double precision :: E0
|
double precision :: EHF
|
||||||
integer :: i_it, i, j, k
|
integer :: i_it, i, j, k
|
||||||
|
|
||||||
E0 = HF_energy
|
EHF = HF_energy
|
||||||
|
|
||||||
mo_label = "Canonical"
|
mo_label = "Canonical"
|
||||||
call damping_SCF
|
|
||||||
|
! Choose SCF algorithm
|
||||||
|
|
||||||
|
! call damping_SCF ! Deprecated routine
|
||||||
|
call Roothaan_Hall_SCF
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -114,7 +114,6 @@ subroutine damping_SCF
|
|||||||
mo_coef = eigenvectors_fock_matrix_mo
|
mo_coef = eigenvectors_fock_matrix_mo
|
||||||
TOUCH mo_coef
|
TOUCH mo_coef
|
||||||
|
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') '====','================','================','================', '===='
|
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') '====','================','================','================', '===='
|
||||||
write(output_hartree_fock,*)
|
write(output_hartree_fock,*)
|
||||||
|
@ -11,84 +11,94 @@
|
|||||||
double precision, allocatable :: work(:), F(:,:), S(:,:)
|
double precision, allocatable :: work(:), F(:,:), S(:,:)
|
||||||
|
|
||||||
|
|
||||||
allocate( F(mo_tot_num_align,mo_tot_num) )
|
allocate( F(mo_tot_num,mo_tot_num) )
|
||||||
do j=1,mo_tot_num
|
do j=1,mo_tot_num
|
||||||
do i=1,mo_tot_num
|
do i=1,mo_tot_num
|
||||||
F(i,j) = Fock_matrix_mo(i,j)
|
F(i,j) = Fock_matrix_mo(i,j)
|
||||||
enddo
|
enddo
|
||||||
|
enddo
|
||||||
|
if(no_oa_or_av_opt)then
|
||||||
|
integer :: iorb,jorb
|
||||||
|
do i = 1, n_act_orb
|
||||||
|
iorb = list_act(i)
|
||||||
|
do j = 1, n_inact_orb
|
||||||
|
jorb = list_inact(j)
|
||||||
|
F(iorb,jorb) = 0.d0
|
||||||
|
F(jorb,iorb) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
if(no_oa_or_av_opt)then
|
do j = 1, n_virt_orb
|
||||||
integer :: iorb,jorb
|
jorb = list_virt(j)
|
||||||
do i = 1, n_act_orb
|
F(iorb,jorb) = 0.d0
|
||||||
iorb = list_act(i)
|
F(jorb,iorb) = 0.d0
|
||||||
do j = 1, n_inact_orb
|
|
||||||
jorb = list_inact(j)
|
|
||||||
F(iorb,jorb) = 0.d0
|
|
||||||
F(jorb,iorb) = 0.d0
|
|
||||||
enddo
|
|
||||||
do j = 1, n_virt_orb
|
|
||||||
jorb = list_virt(j)
|
|
||||||
F(iorb,jorb) = 0.d0
|
|
||||||
F(jorb,iorb) = 0.d0
|
|
||||||
enddo
|
|
||||||
do j = 1, n_core_orb
|
|
||||||
jorb = list_core(j)
|
|
||||||
F(iorb,jorb) = 0.d0
|
|
||||||
F(jorb,iorb) = 0.d0
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
! Insert level shift here
|
|
||||||
do i = elec_beta_num+1, elec_alpha_num
|
|
||||||
F(i,i) += 0.5d0*level_shift
|
|
||||||
enddo
|
enddo
|
||||||
|
do j = 1, n_core_orb
|
||||||
do i = elec_alpha_num+1, mo_tot_num
|
jorb = list_core(j)
|
||||||
F(i,i) += level_shift
|
F(iorb,jorb) = 0.d0
|
||||||
|
F(jorb,iorb) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
|
enddo
|
||||||
n = mo_tot_num
|
endif
|
||||||
lwork = 1+6*n + 2*n*n
|
|
||||||
liwork = 3 + 5*n
|
|
||||||
|
|
||||||
allocate(work(lwork), iwork(liwork) )
|
|
||||||
|
! Insert level shift here
|
||||||
lwork = -1
|
do i = elec_beta_num+1, elec_alpha_num
|
||||||
liwork = -1
|
F(i,i) += 0.5d0*level_shift
|
||||||
|
enddo
|
||||||
call dsyevd( 'V', 'U', mo_tot_num, F, &
|
|
||||||
size(F,1), diagonal_Fock_matrix_mo, &
|
do i = elec_alpha_num+1, mo_tot_num
|
||||||
work, lwork, iwork, liwork, info)
|
F(i,i) += level_shift
|
||||||
|
enddo
|
||||||
if (info /= 0) then
|
|
||||||
print *, irp_here//' failed : ', info
|
n = mo_tot_num
|
||||||
stop 1
|
lwork = 1+6*n + 2*n*n
|
||||||
endif
|
liwork = 3 + 5*n
|
||||||
lwork = int(work(1))
|
|
||||||
liwork = iwork(1)
|
allocate(work(lwork))
|
||||||
deallocate(work,iwork)
|
allocate(iwork(liwork) )
|
||||||
allocate(work(lwork), iwork(liwork) )
|
|
||||||
|
lwork = -1
|
||||||
call dsyevd( 'V', 'U', mo_tot_num, F, &
|
liwork = -1
|
||||||
size(F,1), diagonal_Fock_matrix_mo, &
|
|
||||||
work, lwork, iwork, liwork, info)
|
call dsyevd( 'V', 'U', mo_tot_num, F, &
|
||||||
|
size(F,1), diagonal_Fock_matrix_mo, &
|
||||||
if (info /= 0) then
|
work, lwork, iwork, liwork, info)
|
||||||
print *, irp_here//' failed : ', info
|
|
||||||
stop 1
|
if (info /= 0) then
|
||||||
endif
|
print *, irp_here//' DSYEVD failed : ', info
|
||||||
|
stop 1
|
||||||
call dgemm('N','N',ao_num,mo_tot_num,mo_tot_num, 1.d0, &
|
endif
|
||||||
mo_coef, size(mo_coef,1), F, size(F,1), &
|
lwork = int(work(1))
|
||||||
0.d0, eigenvectors_Fock_matrix_mo, size(eigenvectors_Fock_matrix_mo,1))
|
liwork = iwork(1)
|
||||||
deallocate(work, iwork, F)
|
deallocate(iwork)
|
||||||
|
deallocate(work)
|
||||||
|
|
||||||
|
allocate(work(lwork))
|
||||||
|
allocate(iwork(liwork) )
|
||||||
|
call dsyevd( 'V', 'U', mo_tot_num, F, &
|
||||||
|
size(F,1), diagonal_Fock_matrix_mo, &
|
||||||
|
work, lwork, iwork, liwork, info)
|
||||||
|
deallocate(iwork)
|
||||||
|
|
||||||
|
|
||||||
|
if (info /= 0) then
|
||||||
|
call dsyev( 'V', 'L', mo_tot_num, F, &
|
||||||
|
size(F,1), diagonal_Fock_matrix_mo, &
|
||||||
|
work, lwork, info)
|
||||||
|
|
||||||
|
if (info /= 0) then
|
||||||
|
print *, irp_here//' DSYEV failed : ', info
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
call dgemm('N','N',ao_num,mo_tot_num,mo_tot_num, 1.d0, &
|
||||||
|
mo_coef, size(mo_coef,1), F, size(F,1), &
|
||||||
|
0.d0, eigenvectors_Fock_matrix_mo, size(eigenvectors_Fock_matrix_mo,1))
|
||||||
|
deallocate(work, F)
|
||||||
|
|
||||||
|
|
||||||
! endif
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -22,7 +22,7 @@ subroutine huckel_guess
|
|||||||
Fock_matrix_ao(i,j) = c*ao_overlap(i,j)*(ao_mono_elec_integral_diag(i) + &
|
Fock_matrix_ao(i,j) = c*ao_overlap(i,j)*(ao_mono_elec_integral_diag(i) + &
|
||||||
ao_mono_elec_integral_diag(j))
|
ao_mono_elec_integral_diag(j))
|
||||||
enddo
|
enddo
|
||||||
Fock_matrix_ao(j,j) = Fock_matrix_alpha_ao(j,j)
|
Fock_matrix_ao(j,j) = Fock_matrix_ao_alpha(j,j)
|
||||||
enddo
|
enddo
|
||||||
TOUCH Fock_matrix_ao
|
TOUCH Fock_matrix_ao
|
||||||
mo_coef = eigenvectors_fock_matrix_mo
|
mo_coef = eigenvectors_fock_matrix_mo
|
||||||
|
14
plugins/Hartree_Fock_SlaterDressed/EZFIO.cfg
Normal file
14
plugins/Hartree_Fock_SlaterDressed/EZFIO.cfg
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
[slater_expo_ezfio]
|
||||||
|
type: double precision
|
||||||
|
doc: Exponents of the additional Slater functions
|
||||||
|
size: (nuclei.nucl_num)
|
||||||
|
interface: ezfio, provider
|
||||||
|
|
||||||
|
[slater_coef_ezfio]
|
||||||
|
type: double precision
|
||||||
|
doc: Exponents of the additional Slater functions
|
||||||
|
size: (nuclei.nucl_num,mo_basis.mo_tot_num)
|
||||||
|
interface: ezfio, provider
|
||||||
|
|
||||||
|
|
||||||
|
|
53
plugins/Hartree_Fock_SlaterDressed/LinearSystem.irp.f
Normal file
53
plugins/Hartree_Fock_SlaterDressed/LinearSystem.irp.f
Normal file
@ -0,0 +1,53 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, cusp_A, (nucl_num, nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Equations to solve : A.X = B
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: mu, A, B
|
||||||
|
|
||||||
|
cusp_A = 0.d0
|
||||||
|
do A=1,nucl_num
|
||||||
|
cusp_A(A,A) = slater_expo(A)/nucl_charge(A) * slater_value_at_nucl(A,A)
|
||||||
|
do B=1,nucl_num
|
||||||
|
cusp_A(A,B) -= slater_value_at_nucl(B,A)
|
||||||
|
! Projector
|
||||||
|
do mu=1,mo_tot_num
|
||||||
|
cusp_A(A,B) += MOSlaOverlap_matrix(mu,B) * mo_value_at_nucl(mu,A)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, cusp_B, (nucl_num, mo_tot_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Equations to solve : A.C = B
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i, A, info
|
||||||
|
|
||||||
|
do i=1,mo_tot_num
|
||||||
|
do A=1,nucl_num
|
||||||
|
cusp_B(A,i) = mo_value_at_nucl(i,A)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, cusp_C, (nucl_num, mo_tot_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Equations to solve : A.C = B
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision, allocatable :: AF(:,:)
|
||||||
|
integer :: info
|
||||||
|
allocate ( AF(nucl_num,nucl_num) )
|
||||||
|
|
||||||
|
call get_pseudo_inverse(cusp_A,nucl_num,nucl_num,AF,size(AF,1))
|
||||||
|
call dgemm('N','N',nucl_num,mo_tot_num,nucl_num,1.d0, &
|
||||||
|
AF,size(AF,1), cusp_B, size(cusp_B,1), 0.d0, cusp_C, size(cusp_C,1))
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
98
plugins/Hartree_Fock_SlaterDressed/SCF_dressed.irp.f
Normal file
98
plugins/Hartree_Fock_SlaterDressed/SCF_dressed.irp.f
Normal file
@ -0,0 +1,98 @@
|
|||||||
|
program scf
|
||||||
|
BEGIN_DOC
|
||||||
|
! Produce `Hartree_Fock` MO orbital with Slater cusp dressing
|
||||||
|
! output: mo_basis.mo_tot_num mo_basis.mo_label mo_basis.ao_md5 mo_basis.mo_coef mo_basis.mo_occ
|
||||||
|
! output: hartree_fock.energy
|
||||||
|
! optional: mo_basis.mo_coef
|
||||||
|
END_DOC
|
||||||
|
call check_mos
|
||||||
|
call debug
|
||||||
|
call run
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine check_mos
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Create a MO guess if no MOs are present in the EZFIO directory
|
||||||
|
END_DOC
|
||||||
|
logical :: exists
|
||||||
|
PROVIDE ezfio_filename
|
||||||
|
call ezfio_has_mo_basis_mo_coef(exists)
|
||||||
|
if (.not.exists) then
|
||||||
|
print *, 'Please run SCF first'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine debug
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k
|
||||||
|
print *, 'A'
|
||||||
|
do i=1,nucl_num
|
||||||
|
print *, i, cusp_A(1:nucl_num, i)
|
||||||
|
enddo
|
||||||
|
print *, 'B'
|
||||||
|
do i=1,mo_tot_num
|
||||||
|
print *, i, cusp_B(1:nucl_num, i)
|
||||||
|
enddo
|
||||||
|
print *, 'X'
|
||||||
|
do i=1,mo_tot_num
|
||||||
|
print *, i, cusp_C(1:nucl_num, i)
|
||||||
|
enddo
|
||||||
|
print *, '-----'
|
||||||
|
return
|
||||||
|
do k=-100,100
|
||||||
|
double precision :: x, y, z
|
||||||
|
x = 0.01d0 * k
|
||||||
|
y = 0.d0
|
||||||
|
do i=1,ao_num
|
||||||
|
z = 0.d0
|
||||||
|
do j=1,ao_prim_num(i)
|
||||||
|
z += ao_coef_normalized_ordered_transp(j,i) * dexp(-ao_expo_ordered_transp(j,i) * x**2)
|
||||||
|
enddo
|
||||||
|
y += mo_coef(i,1) * z
|
||||||
|
y += exp(-slater_expo(1)*dabs(x)) * slater_coef(1,1)
|
||||||
|
z = 0.d0
|
||||||
|
do j=1,ao_prim_num(i)
|
||||||
|
z += ao_coef_normalized_ordered_transp(j,i) * dexp(-ao_expo_ordered_transp(j,i) * x**2)
|
||||||
|
enddo
|
||||||
|
y -= z * GauSlaOverlap_matrix(i,1)* slater_coef(1,1)
|
||||||
|
enddo
|
||||||
|
print *, x, y
|
||||||
|
enddo
|
||||||
|
print *, '-----'
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine run
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Run SCF calculation
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision :: SCF_energy_before,SCF_energy_after,diag_H_mat_elem
|
||||||
|
double precision :: EHF
|
||||||
|
integer :: i_it, i, j, k
|
||||||
|
|
||||||
|
mo_label = "CuspDressed"
|
||||||
|
|
||||||
|
|
||||||
|
print *, HF_energy
|
||||||
|
|
||||||
|
call ezfio_set_Hartree_Fock_SlaterDressed_slater_coef_ezfio(cusp_C)
|
||||||
|
|
||||||
|
do i=1,ao_num
|
||||||
|
print *, mo_coef(i,1), cusp_corrected_mos(i,1)
|
||||||
|
enddo
|
||||||
|
mo_coef(1:ao_num,1:mo_tot_num) = cusp_corrected_mos(1:ao_num,1:mo_tot_num)
|
||||||
|
TOUCH mo_coef
|
||||||
|
|
||||||
|
EHF = HF_energy
|
||||||
|
print *, HF_energy
|
||||||
|
! call Roothaan_Hall_SCF
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
66
plugins/Hartree_Fock_SlaterDressed/at_nucl.irp.f
Normal file
66
plugins/Hartree_Fock_SlaterDressed/at_nucl.irp.f
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision , ao_value_at_nucl, (ao_num,nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Values of the atomic orbitals at the nucleus
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: x,y,z,expo,poly, r2
|
||||||
|
|
||||||
|
do k=1,nucl_num
|
||||||
|
do i=1,ao_num
|
||||||
|
x = nucl_coord(ao_nucl(i),1) - nucl_coord(k,1)
|
||||||
|
y = nucl_coord(ao_nucl(i),2) - nucl_coord(k,2)
|
||||||
|
z = nucl_coord(ao_nucl(i),3) - nucl_coord(k,3)
|
||||||
|
poly = x**(ao_power(i,1)) * y**(ao_power(i,2)) * z**(ao_power(i,3))
|
||||||
|
if (poly == 0.d0) cycle
|
||||||
|
|
||||||
|
r2 = (x*x) + (y*y) + (z*z)
|
||||||
|
ao_value_at_nucl(i,k) = 0.d0
|
||||||
|
do j=1,ao_prim_num(i)
|
||||||
|
expo = ao_expo_ordered_transp(j,i)*r2
|
||||||
|
if (expo > 40.d0) cycle
|
||||||
|
ao_value_at_nucl(i,k) = ao_value_at_nucl(i,k) + &
|
||||||
|
ao_coef_normalized_ordered_transp(j,i) * &
|
||||||
|
dexp(-expo)
|
||||||
|
enddo
|
||||||
|
ao_value_at_nucl(i,k) *= poly
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_value_at_nucl, (mo_tot_num,nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Values of the molecular orbitals at the nucleus
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
call dgemm('N','N',mo_tot_num,nucl_num,ao_num,1.d0, &
|
||||||
|
mo_coef_transp, size(mo_coef_transp,1), &
|
||||||
|
ao_value_at_nucl, size(ao_value_at_nucl,1), &
|
||||||
|
0.d0, mo_value_at_nucl, size(mo_value_at_nucl,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision , slater_value_at_nucl, (nucl_num,nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Values of the Slater orbitals (1) at the nucleus (2)
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: x,y,z,expo,poly, r
|
||||||
|
|
||||||
|
do k=1,nucl_num
|
||||||
|
do i=1,nucl_num
|
||||||
|
x = nucl_coord(i,1) - nucl_coord(k,1)
|
||||||
|
y = nucl_coord(i,2) - nucl_coord(k,2)
|
||||||
|
z = nucl_coord(i,3) - nucl_coord(k,3)
|
||||||
|
|
||||||
|
! expo = slater_expo(i)*slater_expo(i)*((x*x) + (y*y) + (z*z))
|
||||||
|
! if (expo > 160.d0) cycle
|
||||||
|
! expo = dsqrt(expo)
|
||||||
|
expo = slater_expo(i) * dsqrt((x*x) + (y*y) + (z*z))
|
||||||
|
slater_value_at_nucl(i,k) = dexp(-expo) * slater_normalization(i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
624
plugins/Hartree_Fock_SlaterDressed/integrals.irp.f
Normal file
624
plugins/Hartree_Fock_SlaterDressed/integrals.irp.f
Normal file
@ -0,0 +1,624 @@
|
|||||||
|
!*****************************************************************************
|
||||||
|
subroutine GauSlaOverlap(expGau,cGau,aGau,expSla,cSla,result)
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the overlap integral between a Gaussian function
|
||||||
|
! with arbitrary angular momemtum and a s-type Slater function
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
! Input variables
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
|
||||||
|
! Final value of the integrals
|
||||||
|
double precision :: ss,ps,ds
|
||||||
|
double precision :: pxs,pys,pzs
|
||||||
|
double precision :: dxxs,dyys,dzzs,dxys,dxzs,dyzs
|
||||||
|
|
||||||
|
double precision :: pi,E,AB,AxBx,AyBy,AzBz,t,u,k
|
||||||
|
|
||||||
|
pi = 4d0*atan(1d0)
|
||||||
|
|
||||||
|
! calculate the length AB between the two centers and other usful quantities
|
||||||
|
|
||||||
|
AB = (cGau(1)-cSla(1))**2 + (cGau(2)-cSla(2))**2 + (cGau(3)-cSla(3))**2
|
||||||
|
AB = dsqrt(AB)
|
||||||
|
|
||||||
|
AxBx = (cGau(1)-cSla(1))/2d0
|
||||||
|
AyBy = (cGau(2)-cSla(2))/2d0
|
||||||
|
AzBz = (cGau(3)-cSla(3))/2d0
|
||||||
|
ds = 0.d0
|
||||||
|
|
||||||
|
! intermediate variables
|
||||||
|
|
||||||
|
t = expSla*dsqrt(0.25d0/expGau)
|
||||||
|
u = dsqrt(expGau)*AB
|
||||||
|
|
||||||
|
double precision :: d, et2
|
||||||
|
if(AB > 0d0) then
|
||||||
|
|
||||||
|
! (s|s)
|
||||||
|
ss = 0.d0
|
||||||
|
|
||||||
|
d = derfc(t+u)
|
||||||
|
if (dabs(d) > 1.d-30) then
|
||||||
|
ss = (t+u)*d*dexp(2d0*t*(t+u))
|
||||||
|
endif
|
||||||
|
|
||||||
|
d = derfc(t-u)
|
||||||
|
if (dabs(d) > 1.d-30) then
|
||||||
|
ss -= (t-u)*d*dexp(2d0*t*(t-u))
|
||||||
|
endif
|
||||||
|
|
||||||
|
! (p|s)
|
||||||
|
ps = 0.d0
|
||||||
|
if (t*t-u*u > 300.d0) then
|
||||||
|
et2 = huge(1.0)
|
||||||
|
else
|
||||||
|
et2 = dexp(t*t-u*u)
|
||||||
|
endif
|
||||||
|
if (et2 /= 0.d0) then
|
||||||
|
d = derfc(t-u)
|
||||||
|
if (d /= 0.d0) then
|
||||||
|
ps += dexp((t-u)**2)*(1d0+2d0*t*(t-u))*d
|
||||||
|
endif
|
||||||
|
d = derfc(t+u)
|
||||||
|
if (d /= 0.d0) then
|
||||||
|
ps += dexp((t+u)**2)*(1d0+2d0*t*(t+u))*d
|
||||||
|
endif
|
||||||
|
ps *= dsqrt(pi)
|
||||||
|
ps -= 4d0*t
|
||||||
|
ps *= et2/dsqrt(pi)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! (d|s)
|
||||||
|
! ds = 4d0*dexp(2d0*t*(t-u))*t*(-((1d0+t**2-t*u)*derfc(t-u))+dexp(4d0*t*u)*(1d0+t*(t+u))*derfc(t+u))
|
||||||
|
ds = 0.d0
|
||||||
|
d = derfc(t+u)
|
||||||
|
if (d /= 0.d0) then
|
||||||
|
ds = dexp(4d0*t*u)*(1d0+t*(t+u))*d
|
||||||
|
endif
|
||||||
|
d = derfc(t-u)
|
||||||
|
if (d /= 0.d0) then
|
||||||
|
ds -= (1d0+t*t-t*u)*d
|
||||||
|
endif
|
||||||
|
|
||||||
|
if ( dabs(ds) > 1.d-100) then
|
||||||
|
ds *= 4d0*dexp(2d0*t*(t-u))*t
|
||||||
|
endif
|
||||||
|
|
||||||
|
! backward scaling
|
||||||
|
ds = 3d0*ss/u**5d0 - 3d0*ps/u**4d0 + ds/u**3d0
|
||||||
|
ps = ps/u**2-ss/u**3d0
|
||||||
|
ss = ss/u
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
! concentric case
|
||||||
|
d = derfc(t)
|
||||||
|
if (d /= 0.d0) then
|
||||||
|
et2 = dexp(t*t)
|
||||||
|
ss = 2d0*et2*((-2d0*t)/dsqrt(pi)+et2*(1d0+2d0*t*t)*d)
|
||||||
|
ps = (8d0*et2*t*(-2d0*(1d0+t*t)+et2*dsqrt(pi)*t*(3d0+2d0*t*t)*d))/(3d0*dsqrt(pi))
|
||||||
|
else
|
||||||
|
ss = 0.d0
|
||||||
|
ps = 0.d0
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
k = t**3d0*dexp(-t*t)*4d0*pi/expSla**(3d0/2d0)
|
||||||
|
|
||||||
|
! (s|s)
|
||||||
|
ss = k*ss
|
||||||
|
|
||||||
|
! (p|s)
|
||||||
|
ps = k*ps
|
||||||
|
|
||||||
|
pxs = AxBx*ps
|
||||||
|
pys = AyBy*ps
|
||||||
|
pzs = AzBz*ps
|
||||||
|
|
||||||
|
! (d|s)
|
||||||
|
ds = k*ds
|
||||||
|
|
||||||
|
dxxs = (2d0*ss+ps)/(4d0*expGau) + AxBx**2*ds
|
||||||
|
dyys = (2d0*ss+ps)/(4d0*expGau) + AyBy**2*ds
|
||||||
|
dzzs = (2d0*ss+ps)/(4d0*expGau) + AzBz**2*ds
|
||||||
|
|
||||||
|
dxys = AxBx*AyBy*ds
|
||||||
|
dxzs = AxBx*AzBz*ds
|
||||||
|
dyzs = AyBy*AzBz*ds
|
||||||
|
|
||||||
|
select case (sum(aGau))
|
||||||
|
case (0)
|
||||||
|
result = ss
|
||||||
|
|
||||||
|
case (1)
|
||||||
|
if (aGau(1) == 1) then
|
||||||
|
result = pxs
|
||||||
|
else if (aGau(2) == 1) then
|
||||||
|
result = pys
|
||||||
|
else if (aGau(3) == 1) then
|
||||||
|
result = pzs
|
||||||
|
endif
|
||||||
|
|
||||||
|
case (2)
|
||||||
|
if (aGau(1) == 2) then
|
||||||
|
result = dxxs
|
||||||
|
else if (aGau(2) == 2) then
|
||||||
|
result = dyys
|
||||||
|
else if (aGau(3) == 2) then
|
||||||
|
result = dzzs
|
||||||
|
else if (aGau(1)+aGau(2) == 2) then
|
||||||
|
result = dxys
|
||||||
|
else if (aGau(1)+aGau(3) == 2) then
|
||||||
|
result = dxzs
|
||||||
|
else if (aGau(2)+aGau(3) == 2) then
|
||||||
|
result = dyzs
|
||||||
|
endif
|
||||||
|
|
||||||
|
case default
|
||||||
|
stop 'GauSlaOverlap not implemented'
|
||||||
|
|
||||||
|
end select
|
||||||
|
|
||||||
|
end
|
||||||
|
!*****************************************************************************
|
||||||
|
|
||||||
|
!*****************************************************************************
|
||||||
|
subroutine GauSlaKinetic(expGau,cGau,aGau,expSla,cSla,result)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the kinetic energy integral between a Gaussian function
|
||||||
|
! with arbitrary angular momemtum and a s-type Slater function
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
! Input variables
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
|
||||||
|
! Final value of the integrals
|
||||||
|
double precision :: ss,ps,ds
|
||||||
|
double precision :: pxs,pys,pzs
|
||||||
|
double precision :: dxxs,dyys,dzzs,dxys,dxzs,dyzs
|
||||||
|
|
||||||
|
double precision :: pi,E,AB,AxBx,AyBy,AzBz,t,u,k
|
||||||
|
|
||||||
|
pi = 4d0*atan(1d0)
|
||||||
|
|
||||||
|
! calculate the length AB between the two centers
|
||||||
|
|
||||||
|
AB = (cGau(1)-cSla(1))**2 + (cGau(2)-cSla(2))**2 + (cGau(3)-cSla(3))**2
|
||||||
|
AB = dsqrt(AB)
|
||||||
|
|
||||||
|
AxBx = (cGau(1)-cSla(1))/2d0
|
||||||
|
AyBy = (cGau(2)-cSla(2))/2d0
|
||||||
|
AzBz = (cGau(3)-cSla(3))/2d0
|
||||||
|
|
||||||
|
! intermediate variables
|
||||||
|
|
||||||
|
t = expSla*dsqrt(0.25d0/expGau)
|
||||||
|
u = dsqrt(expGau)*AB
|
||||||
|
|
||||||
|
if(AB > 0d0) then
|
||||||
|
|
||||||
|
! (s|s)
|
||||||
|
ss = (1d0+t*(t-u))*derfc(t-u)*dexp(2d0*t*(t-u)) - (1d0+t*(t+u))*derfc(t+u)*dexp(2d0*t*(t+u))
|
||||||
|
|
||||||
|
! (p|s)
|
||||||
|
ps = (dexp(t**2-2d0*t*u-u**2)*(4d0*dexp(2d0*t*u)*(1d0+t**2) &
|
||||||
|
+ dsqrt(pi)*t*(-(dexp(t**2+u**2)*(3d0+2d0*t*(t-u))*derfc(t-u)) &
|
||||||
|
- dexp(2d0*t*u+(t+u)**2)*(3d0+2d0*t*(t+u))*derfc(t+u))))/dsqrt(pi)
|
||||||
|
|
||||||
|
! (d|s)
|
||||||
|
ds = (-8d0*dexp(t**2-u**2)*u+4d0*dexp(2d0*t*(t-u))*dsqrt(pi)*t**2*((2d0+t**2-t*u)*derfc(t-u) &
|
||||||
|
- dexp(4d0*t*u)*(2d0+t*(t+u))*derfc(t+u)))/dsqrt(pi)
|
||||||
|
|
||||||
|
! backward scaling
|
||||||
|
ds = 3d0*ss/u**5d0 - 3d0*ps/u**4d0 + ds/u**3d0
|
||||||
|
ps = ps/u**2-ss/u**3d0
|
||||||
|
ss = ss/u
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
! concentric case
|
||||||
|
ss = (4d0*dexp(t**2)*(1d0+t**2))/dsqrt(pi)-2d0*dexp(2d0*t**2)*t*(3d0+2d0*t**2)*derfc(t)
|
||||||
|
ps = (8d0*dexp(t**2)*(-1d0+4d0*t**2+2d0*t**4d0-dexp(t**2)*dsqrt(pi)*t**3d0*(5d0+2d0*t**2)*derfc(t)))/(3d0*dsqrt(pi))
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
k = expSla*dsqrt(expGau)*t**3d0*dexp(-t*t)*4d0*pi/expSla**(3d0/2d0)
|
||||||
|
|
||||||
|
! (s|s)
|
||||||
|
ss = k*ss
|
||||||
|
|
||||||
|
! (p|s)
|
||||||
|
ps = k*ps
|
||||||
|
|
||||||
|
pxs = AxBx*ps
|
||||||
|
pys = AyBy*ps
|
||||||
|
pzs = AzBz*ps
|
||||||
|
|
||||||
|
! (d|s)
|
||||||
|
ds = k*ds
|
||||||
|
|
||||||
|
dxxs = (2d0*ss+ps)/(4d0*expGau) + AxBx**2*ds
|
||||||
|
dyys = (2d0*ss+ps)/(4d0*expGau) + AyBy**2*ds
|
||||||
|
dzzs = (2d0*ss+ps)/(4d0*expGau) + AzBz**2*ds
|
||||||
|
|
||||||
|
dxys = AxBx*AyBy*ds
|
||||||
|
dxzs = AxBx*AzBz*ds
|
||||||
|
dyzs = AyBy*AzBz*ds
|
||||||
|
|
||||||
|
select case (sum(aGau))
|
||||||
|
case (0)
|
||||||
|
result = ss
|
||||||
|
|
||||||
|
case (1)
|
||||||
|
if (aGau(1) == 1) then
|
||||||
|
result = pxs
|
||||||
|
else if (aGau(2) == 1) then
|
||||||
|
result = pys
|
||||||
|
else if (aGau(3) == 1) then
|
||||||
|
result = pzs
|
||||||
|
endif
|
||||||
|
|
||||||
|
case (2)
|
||||||
|
if (aGau(1) == 2) then
|
||||||
|
result = dxxs
|
||||||
|
else if (aGau(2) == 2) then
|
||||||
|
result = dyys
|
||||||
|
else if (aGau(3) == 2) then
|
||||||
|
result = dzzs
|
||||||
|
else if (aGau(1)+aGau(2) == 2) then
|
||||||
|
result = dxys
|
||||||
|
else if (aGau(1)+aGau(3) == 2) then
|
||||||
|
result = dxzs
|
||||||
|
else if (aGau(2)+aGau(3) == 2) then
|
||||||
|
result = dyzs
|
||||||
|
endif
|
||||||
|
|
||||||
|
case default
|
||||||
|
stop 'GauSlaOverlap not implemented'
|
||||||
|
|
||||||
|
end select
|
||||||
|
|
||||||
|
end
|
||||||
|
!*****************************************************************************
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
!*****************************************************************************
|
||||||
|
subroutine GauSlaNuclear(expGau,cGau,aGau,expSla,cSla,ZNuc,cNuc,result)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Compute the nuclear attraction integral between a Gaussian function
|
||||||
|
! with arbitrary angular momemtum and a s-type Slater function
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
! Input variables
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
double precision,intent(in) :: cNuc(3)
|
||||||
|
double precision,intent(in) :: ZNuc
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
|
||||||
|
! Final value of the overlap integral
|
||||||
|
double precision :: ss,ps,ds,fs
|
||||||
|
double precision :: pxs,pys,pzs
|
||||||
|
|
||||||
|
double precision :: pi,E,AB,x,y,k
|
||||||
|
|
||||||
|
pi = 4d0*atan(1d0)
|
||||||
|
E = exp(1d0)
|
||||||
|
|
||||||
|
! calculate the length AB between the two centers
|
||||||
|
|
||||||
|
AB = (cGau(1)-cSla(1))**2 + (cGau(2)-cSla(2))**2 + (cGau(3)-cSla(3))**2
|
||||||
|
AB = dsqrt(AB)
|
||||||
|
|
||||||
|
! intermediate variables
|
||||||
|
|
||||||
|
x = dsqrt(expSla**2/(4d0*expGau))
|
||||||
|
y = dsqrt(expGau)*AB
|
||||||
|
|
||||||
|
if(AB > 0d0) then
|
||||||
|
ss = (1d0+x*(x+y))*derfc(x+y)*dexp(2d0*x*(x+y)) - (1d0+x*(x-y))*derfc(x-y)*dexp(2d0*x*(x-y))
|
||||||
|
ss = ss/y
|
||||||
|
else
|
||||||
|
ss = (4d0*E**x**2*(1d0+x**2))/dsqrt(Pi)-2d0*E**(2d0*x**2)*x*(3d0+2d0*x**2)*dErfc(x)
|
||||||
|
endif
|
||||||
|
|
||||||
|
k = expSla*dsqrt(expGau)*x**3d0*dexp(-x*x)*4d0*pi/expSla**(3d0/2d0)
|
||||||
|
ss = k*ss
|
||||||
|
|
||||||
|
! Print result
|
||||||
|
write(*,*) ss
|
||||||
|
result = 0.d0
|
||||||
|
|
||||||
|
end
|
||||||
|
!*****************************************************************************
|
||||||
|
|
||||||
|
double precision function BoysF0(t)
|
||||||
|
implicit none
|
||||||
|
double precision, intent(in) :: t
|
||||||
|
double precision :: pi
|
||||||
|
|
||||||
|
pi = 4d0*atan(1d0)
|
||||||
|
|
||||||
|
if(t > 0d0) then
|
||||||
|
BoysF0 = 0.5d0*dsqrt(pi/t)*derf(dsqrt(t))
|
||||||
|
else
|
||||||
|
BoysF0 = 1d0
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
!*****************************************************************************
|
||||||
|
|
||||||
|
!TODO
|
||||||
|
subroutine GauSlaOverlap_write(expGau,cGau,aGau,expSla,cSla,result,iunit)
|
||||||
|
implicit none
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
integer,intent(in) :: iunit
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
write(iunit, *) &
|
||||||
|
'SDrSla[ {',expGau,',{',cGau(1),',',cGau(2),',',cGau(3),'},{',aGau(1),',',aGau(2),',',aGau(3),'} },{', expSla,', {',cSla(1),',',cSla(2),',',cSla(3),'} } ],'
|
||||||
|
result = 0.d0
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine GauSlaOverlap_read(expGau,cGau,aGau,expSla,cSla,result,iunit)
|
||||||
|
implicit none
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
integer,intent(in) :: iunit
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
read(iunit, *) result
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine GauSlaKinetic_write(expGau,cGau,aGau,expSla,cSla,result,iunit)
|
||||||
|
implicit none
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
integer,intent(in) :: iunit
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
write(iunit, *) &
|
||||||
|
'TDrSla[ {',expGau,',{',cGau(1),',',cGau(2),',',cGau(3),'},{',aGau(1),',',aGau(2),',',aGau(3),'} },{', expSla,',{',cSla(1),',',cSla(2),',',cSla(3),'} } ],'
|
||||||
|
result = 0.d0
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine GauSlaKinetic_read(expGau,cGau,aGau,expSla,cSla,result,iunit)
|
||||||
|
implicit none
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
integer,intent(in) :: iunit
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
read(iunit, *) result
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine GauSlaNuclear_write(expGau,cGau,aGau,expSla,cSla,ZNuc,cNuc,result,iunit)
|
||||||
|
implicit none
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
double precision,intent(in) :: cNuc(3)
|
||||||
|
double precision,intent(in) :: ZNuc
|
||||||
|
integer,intent(in) :: iunit
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
write(iunit, *) &
|
||||||
|
'VDrSla[ {',expGau,',{',cGau(1),',',cGau(2),',',cGau(3),'},{',aGau(1),',',aGau(2),',',aGau(3),'} },{ ', expSla,',{',cSla(1),',',cSla(2),',',cSla(3),'} }, {', ZNuc, ',{', cNuc(1),',', cNuc(2),',', cNuc(3), '} } ],'
|
||||||
|
result = 0.d0
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine GauSlaNuclear_read(expGau,cGau,aGau,expSla,cSla,ZNuc,cNuc,result,iunit)
|
||||||
|
implicit none
|
||||||
|
double precision,intent(in) :: expGau,expSla
|
||||||
|
double precision,intent(in) :: cGau(3),cSla(3)
|
||||||
|
integer,intent(in) :: aGau(3)
|
||||||
|
double precision,intent(in) :: cNuc(3)
|
||||||
|
double precision,intent(in) :: ZNuc
|
||||||
|
integer,intent(in) :: iunit
|
||||||
|
double precision,intent(out) :: result
|
||||||
|
read(iunit, *) result
|
||||||
|
end
|
||||||
|
!TODO
|
||||||
|
|
||||||
|
BEGIN_TEMPLATE
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, GauSla$X_matrix, (ao_num, nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! <Gaussian | Slater> overlap matrix
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: cGau(3)
|
||||||
|
double precision :: cSla(3)
|
||||||
|
double precision :: expSla, res, expGau
|
||||||
|
integer :: aGau(3)
|
||||||
|
|
||||||
|
!TODO
|
||||||
|
logical :: read
|
||||||
|
integer :: iunit
|
||||||
|
integer :: getunitandopen
|
||||||
|
|
||||||
|
inquire(FILE=trim(ezfio_filename)//'/work/GauSla$X.dat',EXIST=read)
|
||||||
|
if (read) then
|
||||||
|
print *, 'READ $X'
|
||||||
|
iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSla$X.dat','r')
|
||||||
|
else
|
||||||
|
print *, 'WRITE $X'
|
||||||
|
iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSla$X.inp','w')
|
||||||
|
write(iunit,*) '{'
|
||||||
|
endif
|
||||||
|
!TODO
|
||||||
|
|
||||||
|
do k=1,nucl_num
|
||||||
|
cSla(1:3) = nucl_coord_transp(1:3,k)
|
||||||
|
expSla = slater_expo(k)
|
||||||
|
|
||||||
|
do i=1,ao_num
|
||||||
|
cGau(1:3) = nucl_coord_transp(1:3, ao_nucl(i))
|
||||||
|
aGau(1:3) = ao_power(i,1:3)
|
||||||
|
GauSla$X_matrix(i,k) = 0.d0
|
||||||
|
|
||||||
|
do j=1,ao_prim_num(i)
|
||||||
|
expGau = ao_expo_ordered_transp(j,i)
|
||||||
|
! call GauSla$X(expGau,cGau,aGau,expSla,cSla,res)
|
||||||
|
if (read) then
|
||||||
|
call GauSla$X_read(expGau,cGau,aGau,expSla,cSla,res,iunit)
|
||||||
|
else
|
||||||
|
call GauSla$X_write(expGau,cGau,aGau,expSla,cSla,res,iunit)
|
||||||
|
endif
|
||||||
|
GauSla$X_matrix(i,k) += ao_coef_normalized_ordered_transp(j,i) * res
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
if (.not.read) then
|
||||||
|
write(iunit,*) '0.}'
|
||||||
|
endif
|
||||||
|
close(iunit)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, MOSla$X_matrix, (mo_tot_num, nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! <MO | Slater>
|
||||||
|
END_DOC
|
||||||
|
call dgemm('N','N',mo_tot_num,nucl_num,ao_num,1.d0, &
|
||||||
|
mo_coef_transp, size(mo_coef_transp,1), &
|
||||||
|
GauSla$X_matrix, size(GauSla$X_matrix,1), &
|
||||||
|
0.d0, MOSla$X_matrix, size(MOSla$X_matrix,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, AO_orthoSla$X_matrix, (ao_num, nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! <AO_ortho | Slater>
|
||||||
|
END_DOC
|
||||||
|
call dgemm('T','N',ao_num,nucl_num,ao_num,1.d0, &
|
||||||
|
ao_ortho_canonical_coef, size(ao_ortho_canonical_coef,1), &
|
||||||
|
GauSla$X_matrix, size(GauSla$X_matrix,1), &
|
||||||
|
0.d0, AO_orthoSla$X_matrix, size(AO_orthoSla$X_matrix,1))
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
SUBST [ X ]
|
||||||
|
|
||||||
|
Overlap ;;
|
||||||
|
Kinetic ;;
|
||||||
|
|
||||||
|
END_TEMPLATE
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, GauSlaNuclear_matrix, (ao_num, nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! <Gaussian | Slater> overlap matrix
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,A
|
||||||
|
double precision :: cGau(3)
|
||||||
|
double precision :: cSla(3)
|
||||||
|
double precision :: expSla, res, expGau, Znuc, cNuc(3)
|
||||||
|
integer :: aGau(3)
|
||||||
|
|
||||||
|
!TODO
|
||||||
|
logical :: read
|
||||||
|
integer :: iunit
|
||||||
|
integer :: getunitandopen
|
||||||
|
|
||||||
|
inquire(FILE=trim(ezfio_filename)//'/work/GauSlaNuclear.dat',EXIST=read)
|
||||||
|
if (read) then
|
||||||
|
print *, 'READ Nuclear'
|
||||||
|
iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSlaNuclear.dat','r')
|
||||||
|
else
|
||||||
|
print *, 'WRITE Nuclear'
|
||||||
|
iunit = getunitandopen(trim(ezfio_filename)//'/work/GauSlaNuclear.inp','w')
|
||||||
|
write(iunit,*)'{'
|
||||||
|
endif
|
||||||
|
!TODO
|
||||||
|
|
||||||
|
do k=1,nucl_num
|
||||||
|
cSla(1:3) = nucl_coord_transp(1:3,k)
|
||||||
|
expSla = slater_expo(k)
|
||||||
|
|
||||||
|
do i=1,ao_num
|
||||||
|
cGau(1:3) = nucl_coord_transp(1:3, ao_nucl(i))
|
||||||
|
aGau(1:3) = ao_power(i,1:3)
|
||||||
|
GauSlaNuclear_matrix(i,k) = 0.d0
|
||||||
|
|
||||||
|
do j=1,ao_prim_num(i)
|
||||||
|
expGau = ao_expo_ordered_transp(j,i)
|
||||||
|
do A=1,nucl_num
|
||||||
|
cNuc(1:3) = nucl_coord_transp(1:3,A)
|
||||||
|
Znuc = nucl_charge(A)
|
||||||
|
! call GauSlaNuclear(expGau,cGau,aGau,expSla,cSla,Znuc,cNuc,res)
|
||||||
|
if (read) then
|
||||||
|
call GauSlaNuclear_read(expGau,cGau,aGau,expSla,cSla,Znuc,cNuc,res,iunit)
|
||||||
|
else
|
||||||
|
call GauSlaNuclear_write(expGau,cGau,aGau,expSla,cSla,Znuc,cNuc,res,iunit)
|
||||||
|
endif
|
||||||
|
GauSlaNuclear_matrix(i,k) += ao_coef_normalized_ordered_transp(j,i) * res
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
if (.not.read) then
|
||||||
|
write(iunit,*) '0.}'
|
||||||
|
endif
|
||||||
|
close(iunit)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, GauSlaH_matrix, (ao_num, nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Core hamiltonian in AO basis
|
||||||
|
END_DOC
|
||||||
|
GauSlaH_matrix(1:ao_num,1:nucl_num) = &
|
||||||
|
GauSlaKinetic_matrix(1:ao_num,1:nucl_num) + &
|
||||||
|
GauSlaNuclear_matrix(1:ao_num,1:nucl_num)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, MOSlaNuclear_matrix, (mo_tot_num, nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! <MO | Slater>
|
||||||
|
END_DOC
|
||||||
|
call dgemm('N','N',mo_tot_num,nucl_num,ao_num,1.d0, &
|
||||||
|
mo_coef_transp, size(mo_coef_transp,1), &
|
||||||
|
GauSlaNuclear_matrix, size(GauSlaNuclear_matrix,1), &
|
||||||
|
0.d0, MOSlaNuclear_matrix, size(MOSlaNuclear_matrix,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, AO_orthoSlaH_matrix, (ao_num, nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! <AO ortho | Slater>
|
||||||
|
END_DOC
|
||||||
|
call dgemm('T','N',ao_num,nucl_num,ao_num,1.d0, &
|
||||||
|
ao_ortho_canonical_coef, size(ao_ortho_canonical_coef,1), &
|
||||||
|
GauSlaH_matrix, size(GauSlaH_matrix,1), &
|
||||||
|
0.d0, AO_orthoSlaH_matrix, size(AO_orthoSlaH_matrix,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
43
plugins/Hartree_Fock_SlaterDressed/slater.irp.f
Normal file
43
plugins/Hartree_Fock_SlaterDressed/slater.irp.f
Normal file
@ -0,0 +1,43 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, slater_expo, (nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Exponents of the Slater functions
|
||||||
|
END_DOC
|
||||||
|
logical :: exists
|
||||||
|
call ezfio_has_Hartree_Fock_SlaterDressed_slater_expo_ezfio(exists)
|
||||||
|
if (exists) then
|
||||||
|
slater_expo(1:nucl_num) = slater_expo_ezfio(1:nucl_num)
|
||||||
|
else
|
||||||
|
slater_expo(1:nucl_num) = nucl_charge(1:nucl_num)
|
||||||
|
call ezfio_set_Hartree_Fock_SlaterDressed_slater_expo_ezfio(slater_expo)
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, slater_coef, (nucl_num,mo_tot_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Exponents of the Slater functions
|
||||||
|
END_DOC
|
||||||
|
logical :: exists
|
||||||
|
slater_coef = 0.d0
|
||||||
|
call ezfio_has_Hartree_Fock_SlaterDressed_slater_coef_ezfio(exists)
|
||||||
|
if (exists) then
|
||||||
|
slater_coef = slater_coef_ezfio
|
||||||
|
else
|
||||||
|
call ezfio_set_Hartree_Fock_SlaterDressed_slater_coef_ezfio(slater_coef)
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, slater_normalization, (nucl_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Normalization of Slater functions : sqrt(expo^3/pi)
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
do i=1,nucl_num
|
||||||
|
slater_normalization(i) = dsqrt( slater_expo(i)**3/dacos(-1.d0) )
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
@ -21,15 +21,22 @@ subroutine run
|
|||||||
selection_criterion_factor = 0.d0
|
selection_criterion_factor = 0.d0
|
||||||
TOUCH selection_criterion_min selection_criterion selection_criterion_factor
|
TOUCH selection_criterion_min selection_criterion selection_criterion_factor
|
||||||
call H_apply_mp2_selection(pt2, norm_pert, H_pert_diag, N_st)
|
call H_apply_mp2_selection(pt2, norm_pert, H_pert_diag, N_st)
|
||||||
|
touch N_det psi_det psi_coef
|
||||||
psi_det = psi_det_sorted
|
psi_det = psi_det_sorted
|
||||||
psi_coef = psi_coef_sorted
|
psi_coef = psi_coef_sorted
|
||||||
touch N_det psi_det psi_coef
|
touch N_det psi_det psi_coef
|
||||||
|
do i=N_det,1,-1
|
||||||
|
if (dabs(psi_coef(i,1)) <= 1.d-8) then
|
||||||
|
N_det -= 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
print*,'N_det = ',N_det
|
print*,'N_det = ',N_det
|
||||||
print*,'-----'
|
print*,'-----'
|
||||||
print *, 'PT2 = ', pt2(1)
|
print *, 'PT2 = ', pt2(1)
|
||||||
print *, 'E = ', HF_energy
|
print *, 'E = ', HF_energy
|
||||||
print *, 'E_before +PT2 = ', HF_energy+pt2(1)
|
print *, 'E_before +PT2 = ', HF_energy+pt2(1)
|
||||||
N_det = min(N_det,N_det_max)
|
N_det = min(N_det,N_det_max)
|
||||||
|
touch N_det psi_det psi_coef
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
call ezfio_set_mp2_energy(HF_energy+pt2(1))
|
call ezfio_set_mp2_energy(HF_energy+pt2(1))
|
||||||
deallocate(pt2,norm_pert,H_pert_diag)
|
deallocate(pt2,norm_pert,H_pert_diag)
|
||||||
|
1
plugins/MPI/NEEDED_CHILDREN_MODULES
Normal file
1
plugins/MPI/NEEDED_CHILDREN_MODULES
Normal file
@ -0,0 +1 @@
|
|||||||
|
|
14
plugins/MPI/README.rst
Normal file
14
plugins/MPI/README.rst
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
===
|
||||||
|
MPI
|
||||||
|
===
|
||||||
|
|
||||||
|
Providers for MPI programs.
|
||||||
|
|
||||||
|
Needed Modules
|
||||||
|
==============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
||||||
|
Documentation
|
||||||
|
=============
|
||||||
|
.. Do not edit this section It was auto-generated
|
||||||
|
.. by the `update_README.py` script.
|
46
plugins/MPI/bcast.irp.f
Normal file
46
plugins/MPI/bcast.irp.f
Normal file
@ -0,0 +1,46 @@
|
|||||||
|
subroutine mpi_bcast_psi()
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Put the wave function on the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: ierr
|
||||||
|
character*(256) :: msg
|
||||||
|
|
||||||
|
IRP_IF MPI
|
||||||
|
call MPI_BCast(N_states, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
call MPI_BCast(N_det, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
call MPI_BCast(psi_det_size, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
|
||||||
|
TOUCH psi_det_size N_det N_states
|
||||||
|
|
||||||
|
call MPI_BCast(psi_det, N_det, MPI_INTEGER8, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
call MPI_BCast(psi_coef, psi_det_size, MPI_DOUBLE_PRECISION* N_states, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
|
||||||
|
|
||||||
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0)
|
||||||
|
if (rc8 /= psi_det_size*N_states*8_8) then
|
||||||
|
print *, '77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
TOUCH psi_det psi_coef
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,energy,size_energy*8,0)
|
||||||
|
if (rc /= size_energy*8) then
|
||||||
|
print *, '77_zmq_recv(zmq_to_qp_run_socket,energy,size_energy*8,0)'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (N_det_generators_read > 0) then
|
||||||
|
N_det_generators = N_det_generators_read
|
||||||
|
TOUCH N_det_generators
|
||||||
|
endif
|
||||||
|
if (N_det_selectors_read > 0) then
|
||||||
|
N_det_selectors = N_det_selectors_read
|
||||||
|
TOUCH N_det_selectors
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
68
plugins/MPI/utils.irp.f
Normal file
68
plugins/MPI/utils.irp.f
Normal file
@ -0,0 +1,68 @@
|
|||||||
|
BEGIN_PROVIDER [ logical, MPI_Initialized ]
|
||||||
|
&BEGIN_PROVIDER [ logical, has_mpi ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! This is true when MPI_Init has been called
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
IRP_IF MPI
|
||||||
|
integer :: ierr
|
||||||
|
call MPI_Init(ierr)
|
||||||
|
if (ierr /= 0) then
|
||||||
|
print *, ierr
|
||||||
|
print *, 'MPI failed to initialize'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
MPI_Initialized = .True.
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, MPI_rank ]
|
||||||
|
&BEGIN_PROVIDER [ integer, MPI_size ]
|
||||||
|
&BEGIN_PROVIDER [ logical, is_MPI_master ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Usual MPI variables
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
PROVIDE MPI_Initialized
|
||||||
|
|
||||||
|
IRP_IF MPI
|
||||||
|
integer :: ierr
|
||||||
|
call mpi_comm_size(MPI_COMM_WORLD, MPI_size, ierr)
|
||||||
|
if (ierr /= 0) then
|
||||||
|
print *, ierr
|
||||||
|
print *, 'Unable to get MPI_size'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
call mpi_comm_rank(MPI_COMM_WORLD, MPI_rank, ierr)
|
||||||
|
if (ierr /= 0) then
|
||||||
|
print *, ierr
|
||||||
|
print *, 'Unable to get MPI_rank'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
is_MPI_master = (MPI_rank == 0)
|
||||||
|
IRP_ELSE
|
||||||
|
MPI_rank = 0
|
||||||
|
MPI_size = 1
|
||||||
|
is_MPI_master = .True.
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine qp_mpi_finalize()
|
||||||
|
implicit none
|
||||||
|
PROVIDE MPI_Initialized
|
||||||
|
IRP_IF MPI
|
||||||
|
integer :: ierr
|
||||||
|
call MPI_Finalize(ierr)
|
||||||
|
if (ierr /= 0) then
|
||||||
|
print *, ierr
|
||||||
|
print *, 'Unable to finalize MPI'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
end subroutine
|
||||||
|
|
@ -15,11 +15,17 @@ subroutine routine_3
|
|||||||
|
|
||||||
print *, 'N_det = ', N_det
|
print *, 'N_det = ', N_det
|
||||||
print *, 'N_states = ', N_states
|
print *, 'N_states = ', N_states
|
||||||
print *, 'PT2 = ', second_order_pt_new(1)
|
|
||||||
print *, 'E = ', CI_energy(1)
|
integer :: i
|
||||||
print *, 'E+PT2 = ', CI_energy(1)+second_order_pt_new(1)
|
do i=1,N_states
|
||||||
|
print *, 'State = ', i
|
||||||
|
print *, 'PT2 = ', second_order_pt_new(i)
|
||||||
|
print *, 'E = ', CI_energy(i)
|
||||||
|
print *, 'E+PT2 = ', CI_energy(i)+second_order_pt_new(i)
|
||||||
|
print *, '-----------------------------'
|
||||||
|
enddo
|
||||||
print *,'****** DIAGONALIZATION OF DRESSED MATRIX ******'
|
print *,'****** DIAGONALIZATION OF DRESSED MATRIX ******'
|
||||||
print *, 'E dressed= ', CI_dressed_pt2_new_energy(1)
|
print *, 'E dressed= ', CI_dressed_pt2_new_energy(i)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
@ -1,38 +0,0 @@
|
|||||||
program MRPT
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! TODO
|
|
||||||
END_DOC
|
|
||||||
print *, ' _/ '
|
|
||||||
print *, ' -:\_?, _Jm####La '
|
|
||||||
print *, 'J"(:" > _]#AZ#Z#UUZ##, '
|
|
||||||
print *, '_,::./ %(|i%12XmX1*1XL _?, '
|
|
||||||
print *, ' \..\ _\(vmWQwodY+ia%lnL _",/ ( '
|
|
||||||
print *, ' .:< ]J=mQD?WXn<uQWmmvd, -.-:=!'
|
|
||||||
print *, ' "{Z jC]QW|=3Zv)Bi3BmXv3 = _7'
|
|
||||||
print *, ' ]h[Z6)WQ;)jZs]C;|$BZv+, : ./ '
|
|
||||||
print *, ' -#sJX%$Wmm#ev]hinW#Xi:` c ; '
|
|
||||||
print *, ' #X#X23###1}vI$WWmX1>|,)nr" '
|
|
||||||
print *, ' 4XZ#Xov1v}=)vnXAX1nnv;1n" '
|
|
||||||
print *, ' ]XX#ZXoovvvivnnnlvvo2*i7 '
|
|
||||||
print *, ' "23Z#1S2oo2XXSnnnoSo2>v" '
|
|
||||||
print *, ' miX#L -~`""!!1}oSoe|i7 '
|
|
||||||
print *, ' 4cn#m, v221=|v[ '
|
|
||||||
print *, ' ]hI3Zma,;..__wXSe=+vo '
|
|
||||||
print *, ' ]Zov*XSUXXZXZXSe||vo2 '
|
|
||||||
print *, ' ]Z#><iiii|i||||==vn2( '
|
|
||||||
print *, ' ]Z#i<ii||+|=||=:{no2[ '
|
|
||||||
print *, ' ]ZUsiiiiivi|=||=vo22[ '
|
|
||||||
print *, ' ]XZvlliiIi|i=|+|vooo '
|
|
||||||
print *, ' =v1llli||||=|||||lii( '
|
|
||||||
print *, ' ]iillii||||||||=>=|< '
|
|
||||||
print *, ' -ziiiii||||||+||==+> '
|
|
||||||
print *, ' -%|+++||=|=+|=|==/ '
|
|
||||||
print *, ' -a>====+|====-:- '
|
|
||||||
print *, ' "~,- -- /- '
|
|
||||||
print *, ' -. )> '
|
|
||||||
print *, ' .~ +- '
|
|
||||||
print *, ' . .... : . '
|
|
||||||
print *, ' -------~ '
|
|
||||||
print *, ''
|
|
||||||
end
|
|
@ -1 +1 @@
|
|||||||
Determinants Davidson
|
Determinants Davidson Psiref_CAS
|
||||||
|
193
plugins/MRPT_Utils/density_matrix_based.irp.f
Normal file
193
plugins/MRPT_Utils/density_matrix_based.irp.f
Normal file
@ -0,0 +1,193 @@
|
|||||||
|
subroutine contrib_1h2p_dm_based(accu)
|
||||||
|
implicit none
|
||||||
|
integer :: i_i,i_r,i_v,i_a,i_b
|
||||||
|
integer :: i,r,v,a,b
|
||||||
|
integer :: ispin,jspin
|
||||||
|
integer :: istate
|
||||||
|
double precision, intent(out) :: accu(N_states)
|
||||||
|
double precision :: active_int(n_act_orb,2)
|
||||||
|
double precision :: delta_e(n_act_orb,2,N_states)
|
||||||
|
double precision :: get_mo_bielec_integral
|
||||||
|
accu = 0.d0
|
||||||
|
!do i_i = 1, 1
|
||||||
|
do i_i = 1, n_inact_orb
|
||||||
|
i = list_inact(i_i)
|
||||||
|
! do i_r = 1, 1
|
||||||
|
do i_r = 1, n_virt_orb
|
||||||
|
r = list_virt(i_r)
|
||||||
|
! do i_v = 1, 1
|
||||||
|
do i_v = 1, n_virt_orb
|
||||||
|
v = list_virt(i_v)
|
||||||
|
do i_a = 1, n_act_orb
|
||||||
|
a = list_act(i_a)
|
||||||
|
active_int(i_a,1) = get_mo_bielec_integral(i,a,r,v,mo_integrals_map) ! direct
|
||||||
|
active_int(i_a,2) = get_mo_bielec_integral(i,a,v,r,mo_integrals_map) ! exchange
|
||||||
|
do istate = 1, N_states
|
||||||
|
do jspin=1, 2
|
||||||
|
delta_e(i_a,jspin,istate) = one_anhil(i_a,jspin,istate) &
|
||||||
|
- fock_virt_total_spin_trace(r,istate) &
|
||||||
|
- fock_virt_total_spin_trace(v,istate) &
|
||||||
|
+ fock_core_inactive_total_spin_trace(i,istate)
|
||||||
|
delta_e(i_a,jspin,istate) = 1.d0/delta_e(i_a,jspin,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do i_a = 1, n_act_orb
|
||||||
|
a = list_act(i_a)
|
||||||
|
do i_b = 1, n_act_orb
|
||||||
|
! do i_b = i_a, i_a
|
||||||
|
b = list_act(i_b)
|
||||||
|
do ispin = 1, 2 ! spin of (i --> r)
|
||||||
|
do jspin = 1, 2 ! spin of (a --> v)
|
||||||
|
if(ispin == jspin .and. r.le.v)cycle ! condition not to double count
|
||||||
|
do istate = 1, N_states
|
||||||
|
if(ispin == jspin)then
|
||||||
|
accu(istate) += (active_int(i_a,1) - active_int(i_a,2)) * one_body_dm_mo_spin_index(a,b,istate,ispin) &
|
||||||
|
* (active_int(i_b,1) - active_int(i_b,2)) &
|
||||||
|
* delta_e(i_a,jspin,istate)
|
||||||
|
else
|
||||||
|
accu(istate) += active_int(i_a,1) * one_body_dm_mo_spin_index(a,b,istate,ispin) * delta_e(i_a,ispin,istate) &
|
||||||
|
* active_int(i_b,1)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine contrib_2h1p_dm_based(accu)
|
||||||
|
implicit none
|
||||||
|
integer :: i_i,i_j,i_v,i_a,i_b
|
||||||
|
integer :: i,j,v,a,b
|
||||||
|
integer :: ispin,jspin
|
||||||
|
integer :: istate
|
||||||
|
double precision, intent(out) :: accu(N_states)
|
||||||
|
double precision :: active_int(n_act_orb,2)
|
||||||
|
double precision :: delta_e(n_act_orb,2,N_states)
|
||||||
|
double precision :: get_mo_bielec_integral
|
||||||
|
accu = 0.d0
|
||||||
|
do i_i = 1, n_inact_orb
|
||||||
|
i = list_inact(i_i)
|
||||||
|
do i_j = 1, n_inact_orb
|
||||||
|
j = list_inact(i_j)
|
||||||
|
do i_v = 1, n_virt_orb
|
||||||
|
v = list_virt(i_v)
|
||||||
|
do i_a = 1, n_act_orb
|
||||||
|
a = list_act(i_a)
|
||||||
|
active_int(i_a,1) = get_mo_bielec_integral(i,j,v,a,mo_integrals_map) ! direct
|
||||||
|
active_int(i_a,2) = get_mo_bielec_integral(i,j,a,v,mo_integrals_map) ! exchange
|
||||||
|
do istate = 1, N_states
|
||||||
|
do jspin=1, 2
|
||||||
|
! delta_e(i_a,jspin,istate) =
|
||||||
|
!
|
||||||
|
delta_e(i_a,jspin,istate) = one_creat(i_a,jspin,istate) - fock_virt_total_spin_trace(v,istate) &
|
||||||
|
+ fock_core_inactive_total_spin_trace(i,istate) &
|
||||||
|
+ fock_core_inactive_total_spin_trace(j,istate)
|
||||||
|
delta_e(i_a,jspin,istate) = 1.d0/delta_e(i_a,jspin,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do i_a = 1, n_act_orb
|
||||||
|
a = list_act(i_a)
|
||||||
|
do i_b = 1, n_act_orb
|
||||||
|
! do i_b = i_a, i_a
|
||||||
|
b = list_act(i_b)
|
||||||
|
do ispin = 1, 2 ! spin of (i --> v)
|
||||||
|
do jspin = 1, 2 ! spin of (j --> a)
|
||||||
|
if(ispin == jspin .and. i.le.j)cycle ! condition not to double count
|
||||||
|
do istate = 1, N_states
|
||||||
|
if(ispin == jspin)then
|
||||||
|
accu(istate) += (active_int(i_a,1) - active_int(i_a,2)) * one_body_dm_dagger_mo_spin_index(a,b,istate,ispin) &
|
||||||
|
* (active_int(i_b,1) - active_int(i_b,2)) &
|
||||||
|
* delta_e(i_a,jspin,istate)
|
||||||
|
else
|
||||||
|
accu(istate) += active_int(i_a,1) * one_body_dm_dagger_mo_spin_index(a,b,istate,ispin) * delta_e(i_a,ispin,istate) &
|
||||||
|
* active_int(i_b,1)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
!subroutine contrib_2p_dm_based(accu)
|
||||||
|
!implicit none
|
||||||
|
!integer :: i_r,i_v,i_a,i_b,i_c,i_d
|
||||||
|
!integer :: r,v,a,b,c,d
|
||||||
|
!integer :: ispin,jspin
|
||||||
|
!integer :: istate
|
||||||
|
!double precision, intent(out) :: accu(N_states)
|
||||||
|
!double precision :: active_int(n_act_orb,n_act_orb,2)
|
||||||
|
!double precision :: delta_e(n_act_orb,n_act_orb,2,2,N_states)
|
||||||
|
!double precision :: get_mo_bielec_integral
|
||||||
|
!accu = 0.d0
|
||||||
|
!do i_r = 1, n_virt_orb
|
||||||
|
! r = list_virt(i_r)
|
||||||
|
! do i_v = 1, n_virt_orb
|
||||||
|
! v = list_virt(i_v)
|
||||||
|
! do i_a = 1, n_act_orb
|
||||||
|
! a = list_act(i_a)
|
||||||
|
! do i_b = 1, n_act_orb
|
||||||
|
! b = list_act(i_b)
|
||||||
|
! active_int(i_a,i_b,1) = get_mo_bielec_integral(a,b,r,v,mo_integrals_map) ! direct
|
||||||
|
! active_int(i_a,i_b,2) = get_mo_bielec_integral(a,b,v,r,mo_integrals_map) ! direct
|
||||||
|
! do istate = 1, N_states
|
||||||
|
! do jspin=1, 2 ! spin of i_a
|
||||||
|
! do ispin = 1, 2 ! spin of i_b
|
||||||
|
! delta_e(i_a,i_b,jspin,ispin,istate) = two_anhil(i_a,i_b,jspin,ispin,istate) &
|
||||||
|
! - fock_virt_total_spin_trace(r,istate) &
|
||||||
|
! - fock_virt_total_spin_trace(v,istate)
|
||||||
|
! delta_e(i_a,i_b,jspin,ispin,istate) = 1.d0/delta_e(i_a,i_b,jspin,ispin,istate)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! ! diagonal terms
|
||||||
|
! do i_a = 1, n_act_orb
|
||||||
|
! a = list_act(i_a)
|
||||||
|
! do i_b = 1, n_act_orb
|
||||||
|
! b = list_act(i_b)
|
||||||
|
! do ispin = 1, 2 ! spin of (a --> r)
|
||||||
|
! do jspin = 1, 2 ! spin of (b --> v)
|
||||||
|
! if(ispin == jspin .and. r.le.v)cycle ! condition not to double count
|
||||||
|
! if(ispin == jspin .and. a.le.b)cycle ! condition not to double count
|
||||||
|
! do istate = 1, N_states
|
||||||
|
! if(ispin == jspin)then
|
||||||
|
! double precision :: contrib_spin
|
||||||
|
! if(ispin == 1)then
|
||||||
|
! contrib_spin = two_body_dm_aa_diag_act(i_a,i_b)
|
||||||
|
! else
|
||||||
|
! contrib_spin = two_body_dm_bb_diag_act(i_a,i_b)
|
||||||
|
! endif
|
||||||
|
! accu(istate) += (active_int(i_a,i_b,1) - active_int(i_a,i_b,2)) * contrib_spin &
|
||||||
|
! * (active_int(i_a,i_b,1) - active_int(i_a,i_b,2)) &
|
||||||
|
! * delta_e(i_a,i_b,ispin,jspin,istate)
|
||||||
|
! else
|
||||||
|
! accu(istate) += 0.5d0 * active_int(i_a,i_b,1) * two_body_dm_ab_diag_act(i_a,i_b) * delta_e(i_a,i_b,ispin,jspin,istate) &
|
||||||
|
! * active_int(i_a,i_b,1)
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
|
||||||
|
!end
|
||||||
|
|
@ -1,9 +1,9 @@
|
|||||||
BEGIN_PROVIDER [ double precision, energy_cas_dyall, (N_states)]
|
BEGIN_PROVIDER [ double precision, energy_cas_dyall, (N_states)]
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i
|
integer :: i
|
||||||
double precision :: energies(N_states_diag)
|
double precision :: energies(N_states)
|
||||||
do i = 1, N_states
|
do i = 1, N_states
|
||||||
call u0_H_dyall_u0(energies,psi_active,psi_coef,n_det,psi_det_size,psi_det_size,N_states_diag,i)
|
call u0_H_dyall_u0(energies,psi_active,psi_coef,n_det_ref,psi_det_size,psi_det_size,N_states,i)
|
||||||
energy_cas_dyall(i) = energies(i)
|
energy_cas_dyall(i) = energies(i)
|
||||||
print*, 'energy_cas_dyall(i)', energy_cas_dyall(i)
|
print*, 'energy_cas_dyall(i)', energy_cas_dyall(i)
|
||||||
enddo
|
enddo
|
||||||
@ -13,9 +13,9 @@ END_PROVIDER
|
|||||||
BEGIN_PROVIDER [ double precision, energy_cas_dyall_no_exchange, (N_states)]
|
BEGIN_PROVIDER [ double precision, energy_cas_dyall_no_exchange, (N_states)]
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i
|
integer :: i
|
||||||
double precision :: energies(N_states_diag)
|
double precision :: energies(N_states)
|
||||||
do i = 1, N_states
|
do i = 1, N_states
|
||||||
call u0_H_dyall_u0_no_exchange(energies,psi_active,psi_coef,n_det,psi_det_size,psi_det_size,N_states_diag,i)
|
call u0_H_dyall_u0_no_exchange(energies,psi_active,psi_coef,n_det_ref,psi_det_size,psi_det_size,N_states,i)
|
||||||
energy_cas_dyall_no_exchange(i) = energies(i)
|
energy_cas_dyall_no_exchange(i) = energies(i)
|
||||||
print*, 'energy_cas_dyall(i)_no_exchange', energy_cas_dyall_no_exchange(i)
|
print*, 'energy_cas_dyall(i)_no_exchange', energy_cas_dyall_no_exchange(i)
|
||||||
enddo
|
enddo
|
||||||
@ -28,22 +28,22 @@ BEGIN_PROVIDER [ double precision, one_creat, (n_act_orb,2,N_states)]
|
|||||||
integer :: i,j
|
integer :: i,j
|
||||||
integer :: ispin
|
integer :: ispin
|
||||||
integer :: orb, hole_particle,spin_exc
|
integer :: orb, hole_particle,spin_exc
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
use bitmasks
|
use bitmasks
|
||||||
|
|
||||||
integer :: iorb
|
integer :: iorb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb = list_act(iorb)
|
orb = list_act(iorb)
|
||||||
hole_particle = 1
|
hole_particle = 1
|
||||||
spin_exc = ispin
|
spin_exc = ispin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -53,8 +53,8 @@ BEGIN_PROVIDER [ double precision, one_creat, (n_act_orb,2,N_states)]
|
|||||||
enddo
|
enddo
|
||||||
do state_target = 1,N_states
|
do state_target = 1,N_states
|
||||||
call apply_exc_to_psi(orb,hole_particle,spin_exc, &
|
call apply_exc_to_psi(orb,hole_particle,spin_exc, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
one_creat(iorb,ispin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
one_creat(iorb,ispin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -68,22 +68,22 @@ BEGIN_PROVIDER [ double precision, one_anhil, (n_act_orb,2,N_states)]
|
|||||||
integer :: i,j
|
integer :: i,j
|
||||||
integer :: ispin
|
integer :: ispin
|
||||||
integer :: orb, hole_particle,spin_exc
|
integer :: orb, hole_particle,spin_exc
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb
|
integer :: iorb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb = list_act(iorb)
|
orb = list_act(iorb)
|
||||||
hole_particle = -1
|
hole_particle = -1
|
||||||
spin_exc = ispin
|
spin_exc = ispin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -93,8 +93,8 @@ BEGIN_PROVIDER [ double precision, one_anhil, (n_act_orb,2,N_states)]
|
|||||||
enddo
|
enddo
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
call apply_exc_to_psi(orb,hole_particle,spin_exc, &
|
call apply_exc_to_psi(orb,hole_particle,spin_exc, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
one_anhil(iorb,ispin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
one_anhil(iorb,ispin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -109,15 +109,15 @@ BEGIN_PROVIDER [ double precision, two_creat, (n_act_orb,n_act_orb,2,2,N_states)
|
|||||||
integer :: ispin,jspin
|
integer :: ispin,jspin
|
||||||
integer :: orb_i, hole_particle_i,spin_exc_i
|
integer :: orb_i, hole_particle_i,spin_exc_i
|
||||||
integer :: orb_j, hole_particle_j,spin_exc_j
|
integer :: orb_j, hole_particle_j,spin_exc_j
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb,jorb
|
integer :: iorb,jorb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb_i = list_act(iorb)
|
orb_i = list_act(iorb)
|
||||||
@ -128,8 +128,8 @@ BEGIN_PROVIDER [ double precision, two_creat, (n_act_orb,n_act_orb,2,2,N_states)
|
|||||||
orb_j = list_act(jorb)
|
orb_j = list_act(jorb)
|
||||||
hole_particle_j = 1
|
hole_particle_j = 1
|
||||||
spin_exc_j = jspin
|
spin_exc_j = jspin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -139,10 +139,10 @@ BEGIN_PROVIDER [ double precision, two_creat, (n_act_orb,n_act_orb,2,2,N_states)
|
|||||||
enddo
|
enddo
|
||||||
do state_target = 1 , N_states
|
do state_target = 1 , N_states
|
||||||
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
two_creat(iorb,jorb,ispin,jspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
two_creat(iorb,jorb,ispin,jspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -159,16 +159,16 @@ BEGIN_PROVIDER [ double precision, two_anhil, (n_act_orb,n_act_orb,2,2,N_states)
|
|||||||
integer :: ispin,jspin
|
integer :: ispin,jspin
|
||||||
integer :: orb_i, hole_particle_i,spin_exc_i
|
integer :: orb_i, hole_particle_i,spin_exc_i
|
||||||
integer :: orb_j, hole_particle_j,spin_exc_j
|
integer :: orb_j, hole_particle_j,spin_exc_j
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb,jorb
|
integer :: iorb,jorb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
state_target = 1
|
state_target = 1
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb_i = list_act(iorb)
|
orb_i = list_act(iorb)
|
||||||
@ -179,8 +179,8 @@ BEGIN_PROVIDER [ double precision, two_anhil, (n_act_orb,n_act_orb,2,2,N_states)
|
|||||||
orb_j = list_act(jorb)
|
orb_j = list_act(jorb)
|
||||||
hole_particle_j = -1
|
hole_particle_j = -1
|
||||||
spin_exc_j = jspin
|
spin_exc_j = jspin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -189,10 +189,10 @@ BEGIN_PROVIDER [ double precision, two_anhil, (n_act_orb,n_act_orb,2,2,N_states)
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
two_anhil(iorb,jorb,ispin,jspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
two_anhil(iorb,jorb,ispin,jspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -208,15 +208,15 @@ BEGIN_PROVIDER [ double precision, one_anhil_one_creat, (n_act_orb,n_act_orb,2,2
|
|||||||
integer :: ispin,jspin
|
integer :: ispin,jspin
|
||||||
integer :: orb_i, hole_particle_i,spin_exc_i
|
integer :: orb_i, hole_particle_i,spin_exc_i
|
||||||
integer :: orb_j, hole_particle_j,spin_exc_j
|
integer :: orb_j, hole_particle_j,spin_exc_j
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
|
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
integer :: iorb,jorb
|
integer :: iorb,jorb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb_i = list_act(iorb)
|
orb_i = list_act(iorb)
|
||||||
@ -227,8 +227,8 @@ BEGIN_PROVIDER [ double precision, one_anhil_one_creat, (n_act_orb,n_act_orb,2,2
|
|||||||
orb_j = list_act(jorb)
|
orb_j = list_act(jorb)
|
||||||
hole_particle_j = -1
|
hole_particle_j = -1
|
||||||
spin_exc_j = jspin
|
spin_exc_j = jspin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -238,14 +238,14 @@ BEGIN_PROVIDER [ double precision, one_anhil_one_creat, (n_act_orb,n_act_orb,2,2
|
|||||||
enddo
|
enddo
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
if(orb_i == orb_j .and. ispin .ne. jspin)then
|
if(orb_i == orb_j .and. ispin .ne. jspin)then
|
||||||
call u0_H_dyall_u0_no_exchange(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0_no_exchange(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
one_anhil_one_creat(iorb,jorb,ispin,jspin,state_target) = energy_cas_dyall_no_exchange(state_target) - energies(state_target)
|
one_anhil_one_creat(iorb,jorb,ispin,jspin,state_target) = energy_cas_dyall_no_exchange(state_target) - energies(state_target)
|
||||||
else
|
else
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
one_anhil_one_creat(iorb,jorb,ispin,jspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
one_anhil_one_creat(iorb,jorb,ispin,jspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
@ -264,16 +264,16 @@ BEGIN_PROVIDER [ double precision, two_anhil_one_creat, (n_act_orb,n_act_orb,n_a
|
|||||||
integer :: orb_i, hole_particle_i,spin_exc_i
|
integer :: orb_i, hole_particle_i,spin_exc_i
|
||||||
integer :: orb_j, hole_particle_j,spin_exc_j
|
integer :: orb_j, hole_particle_j,spin_exc_j
|
||||||
integer :: orb_k, hole_particle_k,spin_exc_k
|
integer :: orb_k, hole_particle_k,spin_exc_k
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb,jorb
|
integer :: iorb,jorb
|
||||||
integer :: korb
|
integer :: korb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb_i = list_act(iorb)
|
orb_i = list_act(iorb)
|
||||||
@ -289,8 +289,8 @@ BEGIN_PROVIDER [ double precision, two_anhil_one_creat, (n_act_orb,n_act_orb,n_a
|
|||||||
orb_k = list_act(korb)
|
orb_k = list_act(korb)
|
||||||
hole_particle_k = -1
|
hole_particle_k = -1
|
||||||
spin_exc_k = kspin
|
spin_exc_k = kspin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -301,12 +301,12 @@ BEGIN_PROVIDER [ double precision, two_anhil_one_creat, (n_act_orb,n_act_orb,n_a
|
|||||||
|
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_k,hole_particle_k,spin_exc_k, &
|
call apply_exc_to_psi(orb_k,hole_particle_k,spin_exc_k, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
two_anhil_one_creat(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
two_anhil_one_creat(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -326,16 +326,16 @@ BEGIN_PROVIDER [ double precision, two_creat_one_anhil, (n_act_orb,n_act_orb,n_a
|
|||||||
integer :: orb_i, hole_particle_i,spin_exc_i
|
integer :: orb_i, hole_particle_i,spin_exc_i
|
||||||
integer :: orb_j, hole_particle_j,spin_exc_j
|
integer :: orb_j, hole_particle_j,spin_exc_j
|
||||||
integer :: orb_k, hole_particle_k,spin_exc_k
|
integer :: orb_k, hole_particle_k,spin_exc_k
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb,jorb
|
integer :: iorb,jorb
|
||||||
integer :: korb
|
integer :: korb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb_i = list_act(iorb)
|
orb_i = list_act(iorb)
|
||||||
@ -351,8 +351,8 @@ BEGIN_PROVIDER [ double precision, two_creat_one_anhil, (n_act_orb,n_act_orb,n_a
|
|||||||
orb_k = list_act(korb)
|
orb_k = list_act(korb)
|
||||||
hole_particle_k = -1
|
hole_particle_k = -1
|
||||||
spin_exc_k = kspin
|
spin_exc_k = kspin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -362,12 +362,12 @@ BEGIN_PROVIDER [ double precision, two_creat_one_anhil, (n_act_orb,n_act_orb,n_a
|
|||||||
enddo
|
enddo
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
call apply_exc_to_psi(orb_k,hole_particle_k,spin_exc_k, &
|
call apply_exc_to_psi(orb_k,hole_particle_k,spin_exc_k, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
two_creat_one_anhil(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
two_creat_one_anhil(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -387,16 +387,16 @@ BEGIN_PROVIDER [ double precision, three_creat, (n_act_orb,n_act_orb,n_act_orb,2
|
|||||||
integer :: orb_i, hole_particle_i,spin_exc_i
|
integer :: orb_i, hole_particle_i,spin_exc_i
|
||||||
integer :: orb_j, hole_particle_j,spin_exc_j
|
integer :: orb_j, hole_particle_j,spin_exc_j
|
||||||
integer :: orb_k, hole_particle_k,spin_exc_k
|
integer :: orb_k, hole_particle_k,spin_exc_k
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb,jorb
|
integer :: iorb,jorb
|
||||||
integer :: korb
|
integer :: korb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb_i = list_act(iorb)
|
orb_i = list_act(iorb)
|
||||||
@ -412,8 +412,8 @@ BEGIN_PROVIDER [ double precision, three_creat, (n_act_orb,n_act_orb,n_act_orb,2
|
|||||||
orb_k = list_act(korb)
|
orb_k = list_act(korb)
|
||||||
hole_particle_k = 1
|
hole_particle_k = 1
|
||||||
spin_exc_k = kspin
|
spin_exc_k = kspin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -423,12 +423,12 @@ BEGIN_PROVIDER [ double precision, three_creat, (n_act_orb,n_act_orb,n_act_orb,2
|
|||||||
enddo
|
enddo
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_k,hole_particle_k,spin_exc_k, &
|
call apply_exc_to_psi(orb_k,hole_particle_k,spin_exc_k, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
three_creat(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
three_creat(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -448,16 +448,16 @@ BEGIN_PROVIDER [ double precision, three_anhil, (n_act_orb,n_act_orb,n_act_orb,2
|
|||||||
integer :: orb_i, hole_particle_i,spin_exc_i
|
integer :: orb_i, hole_particle_i,spin_exc_i
|
||||||
integer :: orb_j, hole_particle_j,spin_exc_j
|
integer :: orb_j, hole_particle_j,spin_exc_j
|
||||||
integer :: orb_k, hole_particle_k,spin_exc_k
|
integer :: orb_k, hole_particle_k,spin_exc_k
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb,jorb
|
integer :: iorb,jorb
|
||||||
integer :: korb
|
integer :: korb
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
do iorb = 1,n_act_orb
|
do iorb = 1,n_act_orb
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
orb_i = list_act(iorb)
|
orb_i = list_act(iorb)
|
||||||
@ -473,8 +473,8 @@ BEGIN_PROVIDER [ double precision, three_anhil, (n_act_orb,n_act_orb,n_act_orb,2
|
|||||||
orb_k = list_act(korb)
|
orb_k = list_act(korb)
|
||||||
hole_particle_k = -1
|
hole_particle_k = -1
|
||||||
spin_exc_k = kspin
|
spin_exc_k = kspin
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, n_states_diag
|
do j = 1, n_states
|
||||||
psi_in_out_coef(i,j) = psi_coef(i,j)
|
psi_in_out_coef(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -484,12 +484,12 @@ BEGIN_PROVIDER [ double precision, three_anhil, (n_act_orb,n_act_orb,n_act_orb,2
|
|||||||
enddo
|
enddo
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
call apply_exc_to_psi(orb_i,hole_particle_i,spin_exc_i, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
call apply_exc_to_psi(orb_j,hole_particle_j,spin_exc_j, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call apply_exc_to_psi(orb_k,hole_particle_k,spin_exc_k, &
|
call apply_exc_to_psi(orb_k,hole_particle_k,spin_exc_k, &
|
||||||
norm_out,psi_in_out,psi_in_out_coef, n_det,n_det,n_det,N_states_diag)
|
norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states)
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
three_anhil(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
three_anhil(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall(state_target) - energies(state_target)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -511,15 +511,15 @@ END_PROVIDER
|
|||||||
integer :: ispin,jspin
|
integer :: ispin,jspin
|
||||||
integer :: orb_i, hole_particle_i
|
integer :: orb_i, hole_particle_i
|
||||||
integer :: orb_v
|
integer :: orb_v
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb,jorb,i_ok
|
integer :: iorb,jorb,i_ok
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
double precision :: hij
|
double precision :: hij
|
||||||
double precision :: norm(N_states,2),norm_no_inv(N_states,2),norm_bis(N_states,2)
|
double precision :: norm(N_states,2),norm_no_inv(N_states,2),norm_bis(N_states,2)
|
||||||
double precision :: energies_alpha_beta(N_states,2)
|
double precision :: energies_alpha_beta(N_states,2)
|
||||||
@ -541,10 +541,10 @@ END_PROVIDER
|
|||||||
do state_target =1 , N_states
|
do state_target =1 , N_states
|
||||||
one_anhil_one_creat_inact_virt_norm(iorb,vorb,state_target,ispin) = 0.d0
|
one_anhil_one_creat_inact_virt_norm(iorb,vorb,state_target,ispin) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
psi_in_out(j,1,i) = psi_det(j,1,i)
|
psi_in_out(j,1,i) = psi_ref(j,1,i)
|
||||||
psi_in_out(j,2,i) = psi_det(j,2,i)
|
psi_in_out(j,2,i) = psi_ref(j,2,i)
|
||||||
enddo
|
enddo
|
||||||
call do_mono_excitation(psi_in_out(1,1,i),orb_i,orb_v,ispin,i_ok)
|
call do_mono_excitation(psi_in_out(1,1,i),orb_i,orb_v,ispin,i_ok)
|
||||||
if(i_ok.ne.1)then
|
if(i_ok.ne.1)then
|
||||||
@ -552,7 +552,7 @@ END_PROVIDER
|
|||||||
call debug_det(psi_in_out,N_int)
|
call debug_det(psi_in_out,N_int)
|
||||||
print*, 'pb, i_ok ne 0 !!!'
|
print*, 'pb, i_ok ne 0 !!!'
|
||||||
endif
|
endif
|
||||||
call i_H_j(psi_in_out(1,1,i),psi_det(1,1,i),N_int,hij)
|
call i_H_j(psi_in_out(1,1,i),psi_ref(1,1,i),N_int,hij)
|
||||||
do j = 1, n_states
|
do j = 1, n_states
|
||||||
double precision :: coef,contrib
|
double precision :: coef,contrib
|
||||||
coef = psi_coef(i,j) !* psi_coef(i,j)
|
coef = psi_coef(i,j) !* psi_coef(i,j)
|
||||||
@ -585,7 +585,7 @@ END_PROVIDER
|
|||||||
energies_alpha_beta(state_target, ispin) = - mo_bielec_integral_jj_exchange(orb_i,orb_v)
|
energies_alpha_beta(state_target, ispin) = - mo_bielec_integral_jj_exchange(orb_i,orb_v)
|
||||||
! energies_alpha_beta(state_target, ispin) = 0.d0
|
! energies_alpha_beta(state_target, ispin) = 0.d0
|
||||||
if(norm(state_target,ispin) .ne. 0.d0 .and. dabs(norm_no_inv(state_target,ispin)) .gt. thresh_norm)then
|
if(norm(state_target,ispin) .ne. 0.d0 .and. dabs(norm_no_inv(state_target,ispin)) .gt. thresh_norm)then
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
energies_alpha_beta(state_target, ispin) += energies(state_target)
|
energies_alpha_beta(state_target, ispin) += energies(state_target)
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
@ -616,15 +616,15 @@ BEGIN_PROVIDER [ double precision, one_anhil_inact, (n_inact_orb,n_act_orb,N_Sta
|
|||||||
integer :: i,iorb,j
|
integer :: i,iorb,j
|
||||||
integer :: ispin,jspin
|
integer :: ispin,jspin
|
||||||
integer :: orb_i, hole_particle_i
|
integer :: orb_i, hole_particle_i
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: jorb,i_ok,aorb,orb_a
|
integer :: jorb,i_ok,aorb,orb_a
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
double precision :: hij
|
double precision :: hij
|
||||||
double precision :: norm(N_states,2),norm_no_inv(N_states,2)
|
double precision :: norm(N_states,2),norm_no_inv(N_states,2)
|
||||||
double precision :: energies_alpha_beta(N_states,2)
|
double precision :: energies_alpha_beta(N_states,2)
|
||||||
@ -645,10 +645,10 @@ BEGIN_PROVIDER [ double precision, one_anhil_inact, (n_inact_orb,n_act_orb,N_Sta
|
|||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
norm_bis = 0.d0
|
norm_bis = 0.d0
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
psi_in_out(j,1,i) = psi_det(j,1,i)
|
psi_in_out(j,1,i) = psi_ref(j,1,i)
|
||||||
psi_in_out(j,2,i) = psi_det(j,2,i)
|
psi_in_out(j,2,i) = psi_ref(j,2,i)
|
||||||
enddo
|
enddo
|
||||||
call do_mono_excitation(psi_in_out(1,1,i),orb_i,orb_a,ispin,i_ok)
|
call do_mono_excitation(psi_in_out(1,1,i),orb_i,orb_a,ispin,i_ok)
|
||||||
if(i_ok.ne.1)then
|
if(i_ok.ne.1)then
|
||||||
@ -656,7 +656,7 @@ BEGIN_PROVIDER [ double precision, one_anhil_inact, (n_inact_orb,n_act_orb,N_Sta
|
|||||||
psi_in_out_coef(i,j) = 0.d0
|
psi_in_out_coef(i,j) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
else
|
else
|
||||||
call i_H_j(psi_in_out(1,1,i),psi_det(1,1,i),N_int,hij)
|
call i_H_j(psi_in_out(1,1,i),psi_ref(1,1,i),N_int,hij)
|
||||||
do j = 1, n_states
|
do j = 1, n_states
|
||||||
double precision :: coef,contrib
|
double precision :: coef,contrib
|
||||||
coef = psi_coef(i,j) !* psi_coef(i,j)
|
coef = psi_coef(i,j) !* psi_coef(i,j)
|
||||||
@ -688,7 +688,7 @@ BEGIN_PROVIDER [ double precision, one_anhil_inact, (n_inact_orb,n_act_orb,N_Sta
|
|||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
energies_alpha_beta(state_target, ispin) = 0.d0
|
energies_alpha_beta(state_target, ispin) = 0.d0
|
||||||
if(norm(state_target,ispin) .ne. 0.d0 .and. dabs(norm_no_inv(state_target,ispin)) .gt. thresh_norm)then
|
if(norm(state_target,ispin) .ne. 0.d0 .and. dabs(norm_no_inv(state_target,ispin)) .gt. thresh_norm)then
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
energies_alpha_beta(state_target, ispin) += energies(state_target)
|
energies_alpha_beta(state_target, ispin) += energies(state_target)
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
@ -701,11 +701,6 @@ BEGIN_PROVIDER [ double precision, one_anhil_inact, (n_inact_orb,n_act_orb,N_Sta
|
|||||||
else
|
else
|
||||||
one_anhil_inact(iorb,aorb,state_target) = 0.d0
|
one_anhil_inact(iorb,aorb,state_target) = 0.d0
|
||||||
endif
|
endif
|
||||||
! print*, '********'
|
|
||||||
! print*, energies_alpha_beta(state_target,1) , energies_alpha_beta(state_target,2)
|
|
||||||
! print*, norm_bis(state_target,1) , norm_bis(state_target,2)
|
|
||||||
! print*, one_anhil_inact(iorb,aorb,state_target)
|
|
||||||
! print*, one_creat(aorb,1,state_target)
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -719,15 +714,15 @@ BEGIN_PROVIDER [ double precision, one_creat_virt, (n_act_orb,n_virt_orb,N_State
|
|||||||
integer :: ispin,jspin
|
integer :: ispin,jspin
|
||||||
integer :: orb_i, hole_particle_i
|
integer :: orb_i, hole_particle_i
|
||||||
integer :: orb_v
|
integer :: orb_v
|
||||||
double precision :: norm_out(N_states_diag)
|
double precision :: norm_out(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states))
|
||||||
|
|
||||||
integer :: iorb,jorb,i_ok,aorb,orb_a
|
integer :: iorb,jorb,i_ok,aorb,orb_a
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
double precision :: hij
|
double precision :: hij
|
||||||
double precision :: norm(N_states,2),norm_no_inv(N_states,2)
|
double precision :: norm(N_states,2),norm_no_inv(N_states,2)
|
||||||
double precision :: energies_alpha_beta(N_states,2)
|
double precision :: energies_alpha_beta(N_states,2)
|
||||||
@ -748,10 +743,10 @@ BEGIN_PROVIDER [ double precision, one_creat_virt, (n_act_orb,n_virt_orb,N_State
|
|||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
norm_bis = 0.d0
|
norm_bis = 0.d0
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
psi_in_out(j,1,i) = psi_det(j,1,i)
|
psi_in_out(j,1,i) = psi_ref(j,1,i)
|
||||||
psi_in_out(j,2,i) = psi_det(j,2,i)
|
psi_in_out(j,2,i) = psi_ref(j,2,i)
|
||||||
enddo
|
enddo
|
||||||
call do_mono_excitation(psi_in_out(1,1,i),orb_a,orb_v,ispin,i_ok)
|
call do_mono_excitation(psi_in_out(1,1,i),orb_a,orb_v,ispin,i_ok)
|
||||||
if(i_ok.ne.1)then
|
if(i_ok.ne.1)then
|
||||||
@ -759,7 +754,7 @@ BEGIN_PROVIDER [ double precision, one_creat_virt, (n_act_orb,n_virt_orb,N_State
|
|||||||
psi_in_out_coef(i,j) = 0.d0
|
psi_in_out_coef(i,j) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
else
|
else
|
||||||
call i_H_j(psi_in_out(1,1,i),psi_det(1,1,i),N_int,hij)
|
call i_H_j(psi_in_out(1,1,i),psi_ref(1,1,i),N_int,hij)
|
||||||
do j = 1, n_states
|
do j = 1, n_states
|
||||||
double precision :: coef,contrib
|
double precision :: coef,contrib
|
||||||
coef = psi_coef(i,j) !* psi_coef(i,j)
|
coef = psi_coef(i,j) !* psi_coef(i,j)
|
||||||
@ -791,7 +786,7 @@ BEGIN_PROVIDER [ double precision, one_creat_virt, (n_act_orb,n_virt_orb,N_State
|
|||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
energies_alpha_beta(state_target, ispin) = 0.d0
|
energies_alpha_beta(state_target, ispin) = 0.d0
|
||||||
if(norm(state_target,ispin) .ne. 0.d0 .and. dabs(norm_no_inv(state_target,ispin)) .gt. thresh_norm)then
|
if(norm(state_target,ispin) .ne. 0.d0 .and. dabs(norm_no_inv(state_target,ispin)) .gt. thresh_norm)then
|
||||||
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det,n_det,n_det,N_states_diag,state_target)
|
call u0_H_dyall_u0(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target)
|
||||||
! print*, energies(state_target)
|
! print*, energies(state_target)
|
||||||
energies_alpha_beta(state_target, ispin) += energies(state_target)
|
energies_alpha_beta(state_target, ispin) += energies(state_target)
|
||||||
endif
|
endif
|
||||||
@ -825,19 +820,19 @@ END_PROVIDER
|
|||||||
integer :: ispin,jspin
|
integer :: ispin,jspin
|
||||||
integer :: orb_i, hole_particle_i
|
integer :: orb_i, hole_particle_i
|
||||||
integer :: orb_v
|
integer :: orb_v
|
||||||
double precision :: norm_out(N_states_diag),diag_elem(N_det),interact_psi0(N_det)
|
double precision :: norm_out(N_states),diag_elem(N_det),interact_psi0(N_det)
|
||||||
double precision :: delta_e_inact_virt(N_states)
|
double precision :: delta_e_inact_virt(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
double precision, allocatable :: H_matrix(:,:),eigenvectors(:,:),eigenvalues(:)
|
double precision, allocatable :: H_matrix(:,:),eigenvectors(:,:),eigenvalues(:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag),H_matrix(N_det+1,N_det+1))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states),H_matrix(N_det+1,N_det+1))
|
||||||
allocate (eigenvectors(size(H_matrix,1),N_det+1))
|
allocate (eigenvectors(size(H_matrix,1),N_det+1))
|
||||||
allocate (eigenvalues(N_det+1))
|
allocate (eigenvalues(N_det+1))
|
||||||
|
|
||||||
integer :: iorb,jorb,i_ok
|
integer :: iorb,jorb,i_ok
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
double precision :: hij
|
double precision :: hij
|
||||||
double precision :: energies_alpha_beta(N_states,2)
|
double precision :: energies_alpha_beta(N_states,2)
|
||||||
|
|
||||||
@ -857,10 +852,10 @@ END_PROVIDER
|
|||||||
- fock_virt_total_spin_trace(orb_v,j)
|
- fock_virt_total_spin_trace(orb_v,j)
|
||||||
enddo
|
enddo
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
psi_in_out(j,1,i) = psi_det(j,1,i)
|
psi_in_out(j,1,i) = psi_ref(j,1,i)
|
||||||
psi_in_out(j,2,i) = psi_det(j,2,i)
|
psi_in_out(j,2,i) = psi_ref(j,2,i)
|
||||||
enddo
|
enddo
|
||||||
call do_mono_excitation(psi_in_out(1,1,i),orb_i,orb_v,ispin,i_ok)
|
call do_mono_excitation(psi_in_out(1,1,i),orb_i,orb_v,ispin,i_ok)
|
||||||
if(i_ok.ne.1)then
|
if(i_ok.ne.1)then
|
||||||
@ -870,7 +865,7 @@ END_PROVIDER
|
|||||||
endif
|
endif
|
||||||
interact_psi0(i) = 0.d0
|
interact_psi0(i) = 0.d0
|
||||||
do j = 1 , N_det
|
do j = 1 , N_det
|
||||||
call i_H_j(psi_in_out(1,1,i),psi_det(1,1,j),N_int,hij)
|
call i_H_j(psi_in_out(1,1,i),psi_ref(1,1,j),N_int,hij)
|
||||||
interact_psi0(i) += hij * psi_coef(j,1)
|
interact_psi0(i) += hij * psi_coef(j,1)
|
||||||
enddo
|
enddo
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
@ -973,21 +968,21 @@ subroutine give_singles_and_partial_doubles_1h1p_contrib(matrix_1h1p,e_corr_from
|
|||||||
integer :: ispin,jspin
|
integer :: ispin,jspin
|
||||||
integer :: orb_i, hole_particle_i
|
integer :: orb_i, hole_particle_i
|
||||||
integer :: orb_v
|
integer :: orb_v
|
||||||
double precision :: norm_out(N_states_diag),diag_elem(N_det),interact_psi0(N_det)
|
double precision :: norm_out(N_states),diag_elem(N_det),interact_psi0(N_det)
|
||||||
double precision :: delta_e_inact_virt(N_states)
|
double precision :: delta_e_inact_virt(N_states)
|
||||||
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
integer(bit_kind), allocatable :: psi_in_out(:,:,:)
|
||||||
double precision, allocatable :: psi_in_out_coef(:,:)
|
double precision, allocatable :: psi_in_out_coef(:,:)
|
||||||
double precision, allocatable :: H_matrix(:,:),eigenvectors(:,:),eigenvalues(:),interact_cas(:,:)
|
double precision, allocatable :: H_matrix(:,:),eigenvectors(:,:),eigenvalues(:),interact_cas(:,:)
|
||||||
double precision, allocatable :: delta_e_det(:,:)
|
double precision, allocatable :: delta_e_det(:,:)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det,N_states_diag),H_matrix(N_det+1,N_det+1))
|
allocate (psi_in_out(N_int,2,n_det_ref),psi_in_out_coef(n_det_ref,N_states),H_matrix(N_det+1,N_det+1))
|
||||||
allocate (eigenvectors(size(H_matrix,1),N_det+1))
|
allocate (eigenvectors(size(H_matrix,1),N_det+1))
|
||||||
allocate (eigenvalues(N_det+1),interact_cas(N_det,N_det))
|
allocate (eigenvalues(N_det+1),interact_cas(N_det,N_det))
|
||||||
allocate (delta_e_det(N_det,N_det))
|
allocate (delta_e_det(N_det,N_det))
|
||||||
|
|
||||||
integer :: iorb,jorb,i_ok
|
integer :: iorb,jorb,i_ok
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
double precision :: energies(n_states_diag)
|
double precision :: energies(n_states)
|
||||||
double precision :: hij
|
double precision :: hij
|
||||||
double precision :: energies_alpha_beta(N_states,2)
|
double precision :: energies_alpha_beta(N_states,2)
|
||||||
double precision :: lamda_pt2(N_det)
|
double precision :: lamda_pt2(N_det)
|
||||||
@ -1009,10 +1004,10 @@ subroutine give_singles_and_partial_doubles_1h1p_contrib(matrix_1h1p,e_corr_from
|
|||||||
- fock_virt_total_spin_trace(orb_v,j)
|
- fock_virt_total_spin_trace(orb_v,j)
|
||||||
enddo
|
enddo
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
do i = 1, n_det
|
do i = 1, n_det_ref
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
psi_in_out(j,1,i) = psi_det(j,1,i)
|
psi_in_out(j,1,i) = psi_ref(j,1,i)
|
||||||
psi_in_out(j,2,i) = psi_det(j,2,i)
|
psi_in_out(j,2,i) = psi_ref(j,2,i)
|
||||||
enddo
|
enddo
|
||||||
call do_mono_excitation(psi_in_out(1,1,i),orb_i,orb_v,ispin,i_ok)
|
call do_mono_excitation(psi_in_out(1,1,i),orb_i,orb_v,ispin,i_ok)
|
||||||
if(i_ok.ne.1)then
|
if(i_ok.ne.1)then
|
||||||
@ -1022,8 +1017,8 @@ subroutine give_singles_and_partial_doubles_1h1p_contrib(matrix_1h1p,e_corr_from
|
|||||||
endif
|
endif
|
||||||
interact_psi0(i) = 0.d0
|
interact_psi0(i) = 0.d0
|
||||||
do j = 1 , N_det
|
do j = 1 , N_det
|
||||||
call i_H_j(psi_in_out(1,1,i),psi_det(1,1,j),N_int,hij)
|
call i_H_j(psi_in_out(1,1,i),psi_ref(1,1,j),N_int,hij)
|
||||||
call get_delta_e_dyall(psi_det(1,1,j),psi_in_out(1,1,i),coef_array,hij,delta_e_det(i,j))
|
call get_delta_e_dyall(psi_ref(1,1,j),psi_in_out(1,1,i),delta_e_det(i,j))
|
||||||
interact_cas(i,j) = hij
|
interact_cas(i,j) = hij
|
||||||
interact_psi0(i) += hij * psi_coef(j,1)
|
interact_psi0(i) += hij * psi_coef(j,1)
|
||||||
enddo
|
enddo
|
||||||
|
@ -62,7 +62,7 @@ subroutine mrpt_dress(delta_ij_, Ndet,i_generator,n_selected,det_buffer,Nint,ip
|
|||||||
call find_connections_previous(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist)
|
call find_connections_previous(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist)
|
||||||
|
|
||||||
if(N_tq > 0) then
|
if(N_tq > 0) then
|
||||||
call create_minilist(key_mask, psi_det, miniList, idx_miniList, N_det, N_minilist, Nint)
|
call create_minilist(key_mask, psi_ref, miniList, idx_miniList, N_det, N_minilist, Nint)
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
|
||||||
@ -79,14 +79,15 @@ subroutine mrpt_dress(delta_ij_, Ndet,i_generator,n_selected,det_buffer,Nint,ip
|
|||||||
phase_array =0.d0
|
phase_array =0.d0
|
||||||
do i = 1,idx_alpha(0)
|
do i = 1,idx_alpha(0)
|
||||||
index_i = idx_alpha(i)
|
index_i = idx_alpha(i)
|
||||||
call i_h_j(tq(1,1,i_alpha),psi_det(1,1,index_i),Nint,hialpha)
|
call i_h_j(tq(1,1,i_alpha),psi_ref(1,1,index_i),Nint,hialpha)
|
||||||
double precision :: coef_array(N_states)
|
double precision :: coef_array(N_states)
|
||||||
do i_state = 1, N_states
|
do i_state = 1, N_states
|
||||||
coef_array(i_state) = psi_coef(index_i,i_state)
|
coef_array(i_state) = psi_coef(index_i,i_state)
|
||||||
enddo
|
enddo
|
||||||
call get_delta_e_dyall(psi_det(1,1,index_i),tq(1,1,i_alpha),coef_array,hialpha,delta_e)
|
call get_delta_e_dyall(psi_ref(1,1,index_i),tq(1,1,i_alpha),delta_e)
|
||||||
|
! call get_delta_e_dyall_general_mp(psi_ref(1,1,index_i),tq(1,1,i_alpha),delta_e)
|
||||||
hij_array(index_i) = hialpha
|
hij_array(index_i) = hialpha
|
||||||
call get_excitation(psi_det(1,1,index_i),tq(1,1,i_alpha),exc,degree,phase,N_int)
|
call get_excitation(psi_ref(1,1,index_i),tq(1,1,i_alpha),exc,degree,phase,N_int)
|
||||||
! phase_array(index_i) = phase
|
! phase_array(index_i) = phase
|
||||||
do i_state = 1,N_states
|
do i_state = 1,N_states
|
||||||
delta_e_inv_array(index_i,i_state) = 1.d0/delta_e(i_state)
|
delta_e_inv_array(index_i,i_state) = 1.d0/delta_e(i_state)
|
||||||
@ -99,12 +100,12 @@ subroutine mrpt_dress(delta_ij_, Ndet,i_generator,n_selected,det_buffer,Nint,ip
|
|||||||
call omp_set_lock( psi_ref_bis_lock(index_i) )
|
call omp_set_lock( psi_ref_bis_lock(index_i) )
|
||||||
do j = 1, idx_alpha(0)
|
do j = 1, idx_alpha(0)
|
||||||
index_j = idx_alpha(j)
|
index_j = idx_alpha(j)
|
||||||
! call get_excitation(psi_det(1,1,index_i),psi_det(1,1,index_i),exc,degree,phase,N_int)
|
! call get_excitation(psi_ref(1,1,index_i),psi_ref(1,1,index_i),exc,degree,phase,N_int)
|
||||||
! if(index_j.ne.index_i)then
|
! if(index_j.ne.index_i)then
|
||||||
! if(phase_array(index_j) * phase_array(index_i) .ne. phase)then
|
! if(phase_array(index_j) * phase_array(index_i) .ne. phase)then
|
||||||
! print*, phase_array(index_j) , phase_array(index_i) ,phase
|
! print*, phase_array(index_j) , phase_array(index_i) ,phase
|
||||||
! call debug_det(psi_det(1,1,index_i),N_int)
|
! call debug_det(psi_ref(1,1,index_i),N_int)
|
||||||
! call debug_det(psi_det(1,1,index_j),N_int)
|
! call debug_det(psi_ref(1,1,index_j),N_int)
|
||||||
! call debug_det(tq(1,1,i_alpha),N_int)
|
! call debug_det(tq(1,1,i_alpha),N_int)
|
||||||
! stop
|
! stop
|
||||||
! endif
|
! endif
|
||||||
@ -122,14 +123,14 @@ end
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), gen_det_sorted, (N_int,2,N_det_generators,2) ]
|
BEGIN_PROVIDER [ integer(bit_kind), gen_det_ref_sorted, (N_int,2,N_det_generators,2) ]
|
||||||
&BEGIN_PROVIDER [ integer, gen_det_shortcut, (0:N_det_generators,2) ]
|
&BEGIN_PROVIDER [ integer, gen_det_ref_shortcut, (0:N_det_generators,2) ]
|
||||||
&BEGIN_PROVIDER [ integer, gen_det_version, (N_int, N_det_generators,2) ]
|
&BEGIN_PROVIDER [ integer, gen_det_ref_version, (N_int, N_det_generators,2) ]
|
||||||
&BEGIN_PROVIDER [ integer, gen_det_idx, (N_det_generators,2) ]
|
&BEGIN_PROVIDER [ integer, gen_det_ref_idx, (N_det_generators,2) ]
|
||||||
gen_det_sorted(:,:,:,1) = psi_det_generators(:,:,:N_det_generators)
|
gen_det_ref_sorted(:,:,:,1) = psi_det_generators(:,:,:N_det_generators)
|
||||||
gen_det_sorted(:,:,:,2) = psi_det_generators(:,:,:N_det_generators)
|
gen_det_ref_sorted(:,:,:,2) = psi_det_generators(:,:,:N_det_generators)
|
||||||
call sort_dets_ab_v(gen_det_sorted(:,:,:,1), gen_det_idx(:,1), gen_det_shortcut(0:,1), gen_det_version(:,:,1), N_det_generators, N_int)
|
call sort_dets_ab_v(gen_det_ref_sorted(:,:,:,1), gen_det_ref_idx(:,1), gen_det_ref_shortcut(0:,1), gen_det_ref_version(:,:,1), N_det_generators, N_int)
|
||||||
call sort_dets_ba_v(gen_det_sorted(:,:,:,2), gen_det_idx(:,2), gen_det_shortcut(0:,2), gen_det_version(:,:,2), N_det_generators, N_int)
|
call sort_dets_ba_v(gen_det_ref_sorted(:,:,:,2), gen_det_ref_idx(:,2), gen_det_ref_shortcut(0:,2), gen_det_ref_version(:,:,2), N_det_generators, N_int)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
@ -58,8 +58,6 @@
|
|||||||
delta_ij_tmp = 0.d0
|
delta_ij_tmp = 0.d0
|
||||||
call H_apply_mrpt_1h1p(delta_ij_tmp,N_det)
|
call H_apply_mrpt_1h1p(delta_ij_tmp,N_det)
|
||||||
double precision :: e_corr_from_1h1p_singles(N_states)
|
double precision :: e_corr_from_1h1p_singles(N_states)
|
||||||
!call give_singles_and_partial_doubles_1h1p_contrib(delta_ij_tmp,e_corr_from_1h1p_singles)
|
|
||||||
!call give_1h1p_only_doubles_spin_cross(delta_ij_tmp)
|
|
||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
do i_state = 1, N_states
|
do i_state = 1, N_states
|
||||||
do i = 1, N_det
|
do i = 1, N_det
|
||||||
@ -121,7 +119,7 @@
|
|||||||
|
|
||||||
! 1h2p
|
! 1h2p
|
||||||
delta_ij_tmp = 0.d0
|
delta_ij_tmp = 0.d0
|
||||||
!call give_1h2p_contrib(delta_ij_tmp)
|
call give_1h2p_contrib(delta_ij_tmp)
|
||||||
call H_apply_mrpt_1h2p(delta_ij_tmp,N_det)
|
call H_apply_mrpt_1h2p(delta_ij_tmp,N_det)
|
||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
do i_state = 1, N_states
|
do i_state = 1, N_states
|
||||||
@ -137,7 +135,7 @@
|
|||||||
|
|
||||||
! 2h1p
|
! 2h1p
|
||||||
delta_ij_tmp = 0.d0
|
delta_ij_tmp = 0.d0
|
||||||
!call give_2h1p_contrib(delta_ij_tmp)
|
call give_2h1p_contrib(delta_ij_tmp)
|
||||||
call H_apply_mrpt_2h1p(delta_ij_tmp,N_det)
|
call H_apply_mrpt_2h1p(delta_ij_tmp,N_det)
|
||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
do i_state = 1, N_states
|
do i_state = 1, N_states
|
||||||
@ -223,9 +221,9 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, CI_electronic_dressed_pt2_new_energy, (N_states_diag) ]
|
BEGIN_PROVIDER [ double precision, CI_electronic_dressed_pt2_new_energy, (N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors, (N_det,N_states_diag) ]
|
&BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors, (N_det,N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors_s2, (N_states_diag) ]
|
&BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors_s2, (N_states) ]
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Eigenvectors/values of the CI matrix
|
! Eigenvectors/values of the CI matrix
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -244,14 +242,14 @@ END_PROVIDER
|
|||||||
double precision, allocatable :: e_array(:)
|
double precision, allocatable :: e_array(:)
|
||||||
integer, allocatable :: iorder(:)
|
integer, allocatable :: iorder(:)
|
||||||
|
|
||||||
! Guess values for the "N_states_diag" states of the CI_dressed_pt2_new_eigenvectors
|
! Guess values for the "N_states" states of the CI_dressed_pt2_new_eigenvectors
|
||||||
do j=1,min(N_states_diag,N_det)
|
do j=1,min(N_states,N_det)
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_dressed_pt2_new_eigenvectors(i,j) = psi_coef(i,j)
|
CI_dressed_pt2_new_eigenvectors(i,j) = psi_coef(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do j=N_det+1,N_states_diag
|
do j=N_det+1,N_states
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_dressed_pt2_new_eigenvectors(i,j) = 0.d0
|
CI_dressed_pt2_new_eigenvectors(i,j) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
@ -267,14 +265,14 @@ END_PROVIDER
|
|||||||
allocate (eigenvectors(size(H_matrix_all_dets,1),N_det))
|
allocate (eigenvectors(size(H_matrix_all_dets,1),N_det))
|
||||||
allocate (eigenvalues(N_det))
|
allocate (eigenvalues(N_det))
|
||||||
call lapack_diag(eigenvalues,eigenvectors, &
|
call lapack_diag(eigenvalues,eigenvectors, &
|
||||||
H_matrix_all_dets,size(H_matrix_all_dets,1),N_det)
|
Hmatrix_dressed_pt2_new_symmetrized(1,1,1),size(H_matrix_all_dets,1),N_det)
|
||||||
CI_electronic_energy(:) = 0.d0
|
CI_electronic_dressed_pt2_new_energy(:) = 0.d0
|
||||||
if (s2_eig) then
|
if (s2_eig) then
|
||||||
i_state = 0
|
i_state = 0
|
||||||
allocate (s2_eigvalues(N_det))
|
allocate (s2_eigvalues(N_det))
|
||||||
allocate(index_good_state_array(N_det),good_state_array(N_det))
|
allocate(index_good_state_array(N_det),good_state_array(N_det))
|
||||||
good_state_array = .False.
|
good_state_array = .False.
|
||||||
call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,&
|
call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_ref,N_int,&
|
||||||
N_det,size(eigenvectors,1))
|
N_det,size(eigenvectors,1))
|
||||||
do j=1,N_det
|
do j=1,N_det
|
||||||
! Select at least n_states states with S^2 values closed to "expected_s2"
|
! Select at least n_states states with S^2 values closed to "expected_s2"
|
||||||
@ -291,54 +289,54 @@ END_PROVIDER
|
|||||||
! Fill the first "i_state" states that have a correct S^2 value
|
! Fill the first "i_state" states that have a correct S^2 value
|
||||||
do j = 1, i_state
|
do j = 1, i_state
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j))
|
CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j))
|
||||||
enddo
|
enddo
|
||||||
CI_electronic_energy(j) = eigenvalues(index_good_state_array(j))
|
CI_electronic_dressed_pt2_new_energy(j) = eigenvalues(index_good_state_array(j))
|
||||||
CI_eigenvectors_s2(j) = s2_eigvalues(index_good_state_array(j))
|
CI_dressed_pt2_new_eigenvectors_s2(j) = s2_eigvalues(index_good_state_array(j))
|
||||||
enddo
|
enddo
|
||||||
i_other_state = 0
|
i_other_state = 0
|
||||||
do j = 1, N_det
|
do j = 1, N_det
|
||||||
if(good_state_array(j))cycle
|
if(good_state_array(j))cycle
|
||||||
i_other_state +=1
|
i_other_state +=1
|
||||||
if(i_state+i_other_state.gt.n_states_diag)then
|
if(i_state+i_other_state.gt.n_states)then
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j)
|
CI_dressed_pt2_new_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j)
|
||||||
enddo
|
enddo
|
||||||
CI_electronic_energy(i_state+i_other_state) = eigenvalues(j)
|
CI_electronic_dressed_pt2_new_energy(i_state+i_other_state) = eigenvalues(j)
|
||||||
CI_eigenvectors_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state)
|
CI_dressed_pt2_new_eigenvectors_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else
|
else
|
||||||
print*,''
|
print*,''
|
||||||
print*,'!!!!!!!! WARNING !!!!!!!!!'
|
print*,'!!!!!!!! WARNING !!!!!!!!!'
|
||||||
print*,' Within the ',N_det,'determinants selected'
|
print*,' Within the ',N_det,'determinants selected'
|
||||||
print*,' and the ',N_states_diag,'states requested'
|
print*,' and the ',N_states,'states requested'
|
||||||
print*,' We did not find any state with S^2 values close to ',expected_s2
|
print*,' We did not find any state with S^2 values close to ',expected_s2
|
||||||
print*,' We will then set the first N_states eigenvectors of the H matrix'
|
print*,' We will then set the first N_states eigenvectors of the H matrix'
|
||||||
print*,' as the CI_eigenvectors'
|
print*,' as the CI_dressed_pt2_new_eigenvectors'
|
||||||
print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space'
|
print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space'
|
||||||
print*,''
|
print*,''
|
||||||
do j=1,min(N_states_diag,N_det)
|
do j=1,min(N_states,N_det)
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors(i,j) = eigenvectors(i,j)
|
CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,j)
|
||||||
enddo
|
enddo
|
||||||
CI_electronic_energy(j) = eigenvalues(j)
|
CI_electronic_dressed_pt2_new_energy(j) = eigenvalues(j)
|
||||||
CI_eigenvectors_s2(j) = s2_eigvalues(j)
|
CI_dressed_pt2_new_eigenvectors_s2(j) = s2_eigvalues(j)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
deallocate(index_good_state_array,good_state_array)
|
deallocate(index_good_state_array,good_state_array)
|
||||||
deallocate(s2_eigvalues)
|
deallocate(s2_eigvalues)
|
||||||
else
|
else
|
||||||
call u_0_S2_u_0(CI_eigenvectors_s2,eigenvectors,N_det,psi_det,N_int,&
|
call u_0_S2_u_0(CI_dressed_pt2_new_eigenvectors_s2,eigenvectors,N_det,psi_ref,N_int,&
|
||||||
min(N_det,N_states_diag),size(eigenvectors,1))
|
min(N_det,N_states),size(eigenvectors,1))
|
||||||
! Select the "N_states_diag" states of lowest energy
|
! Select the "N_states" states of lowest energy
|
||||||
do j=1,min(N_det,N_states_diag)
|
do j=1,min(N_det,N_states)
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors(i,j) = eigenvectors(i,j)
|
CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,j)
|
||||||
enddo
|
enddo
|
||||||
CI_electronic_energy(j) = eigenvalues(j)
|
CI_electronic_dressed_pt2_new_energy(j) = eigenvalues(j)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
deallocate(eigenvectors,eigenvalues)
|
deallocate(eigenvectors,eigenvalues)
|
||||||
@ -348,7 +346,7 @@ END_PROVIDER
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states_diag) ]
|
BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! N_states lowest eigenvalues of the CI matrix
|
! N_states lowest eigenvalues of the CI matrix
|
||||||
@ -357,11 +355,11 @@ BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states_diag) ]
|
|||||||
integer :: j
|
integer :: j
|
||||||
character*(8) :: st
|
character*(8) :: st
|
||||||
call write_time(output_determinants)
|
call write_time(output_determinants)
|
||||||
do j=1,N_states_diag
|
do j=1,N_states
|
||||||
CI_dressed_pt2_new_energy(j) = CI_electronic_dressed_pt2_new_energy(j) + nuclear_repulsion
|
CI_dressed_pt2_new_energy(j) = CI_electronic_dressed_pt2_new_energy(j) + nuclear_repulsion
|
||||||
write(st,'(I4)') j
|
write(st,'(I4)') j
|
||||||
call write_double(output_determinants,CI_dressed_pt2_new_energy(j),'Energy of state '//trim(st))
|
call write_double(output_determinants,CI_dressed_pt2_new_energy(j),'Energy of state '//trim(st))
|
||||||
call write_double(output_determinants,CI_eigenvectors_s2(j),'S^2 of state '//trim(st))
|
call write_double(output_determinants,CI_dressed_pt2_new_eigenvectors_s2(j),'S^2 of state '//trim(st))
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
@ -22,8 +22,8 @@ subroutine give_2h1p_contrib(matrix_2h1p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
@ -45,7 +45,7 @@ subroutine give_2h1p_contrib(matrix_2h1p)
|
|||||||
integer :: index_orb_act_mono(N_det,3)
|
integer :: index_orb_act_mono(N_det,3)
|
||||||
|
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
do ispin = 1, 2 ! spin of the couple a-a^dagger (i,r)
|
do ispin = 1, 2 ! spin of the couple a-a^dagger (i,r)
|
||||||
do jspin = 1, 2 ! spin of the couple z-a^dagger (j,a)
|
do jspin = 1, 2 ! spin of the couple z-a^dagger (j,a)
|
||||||
@ -53,8 +53,8 @@ subroutine give_2h1p_contrib(matrix_2h1p)
|
|||||||
do a = 1, n_act_orb ! First active
|
do a = 1, n_act_orb ! First active
|
||||||
aorb = list_act(a)
|
aorb = list_act(a)
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation inactive -- > virtual
|
! Do the excitation inactive -- > virtual
|
||||||
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
||||||
@ -64,7 +64,7 @@ subroutine give_2h1p_contrib(matrix_2h1p)
|
|||||||
call clear_bit_to_integer(jorb,det_tmp(1,jspin),N_int) ! hole in "jorb" of spin Jspin
|
call clear_bit_to_integer(jorb,det_tmp(1,jspin),N_int) ! hole in "jorb" of spin Jspin
|
||||||
call set_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! particle in "aorb" of spin Jspin
|
call set_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! particle in "aorb" of spin Jspin
|
||||||
|
|
||||||
! Check if the excitation is possible or not on psi_det(idet)
|
! Check if the excitation is possible or not on psi_ref(idet)
|
||||||
accu_elec= 0
|
accu_elec= 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
accu_elec+= popcnt(det_tmp(inint,jspin))
|
accu_elec+= popcnt(det_tmp(inint,jspin))
|
||||||
@ -81,7 +81,7 @@ subroutine give_2h1p_contrib(matrix_2h1p)
|
|||||||
perturb_dets(inint,1,a,jspin,ispin) = det_tmp(inint,1)
|
perturb_dets(inint,1,a,jspin,ispin) = det_tmp(inint,1)
|
||||||
perturb_dets(inint,2,a,jspin,ispin) = det_tmp(inint,2)
|
perturb_dets(inint,2,a,jspin,ispin) = det_tmp(inint,2)
|
||||||
enddo
|
enddo
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
perturb_dets_phase(a,jspin,ispin) = phase
|
perturb_dets_phase(a,jspin,ispin) = phase
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
delta_e(a,jspin,istate) = one_creat(a,jspin,istate) &
|
delta_e(a,jspin,istate) = one_creat(a,jspin,istate) &
|
||||||
@ -109,7 +109,7 @@ subroutine give_2h1p_contrib(matrix_2h1p)
|
|||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | a_{b} a^{\dagger}_a | Idet>
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | a_{b} a^{\dagger}_a | Idet>
|
||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
if(idx(jdet).ne.idet)then
|
if(idx(jdet).ne.idet)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,2,1)) !!! a^{\dagger}_a
|
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,2,1)) !!! a^{\dagger}_a
|
||||||
@ -150,7 +150,7 @@ subroutine give_2h1p_contrib(matrix_2h1p)
|
|||||||
! you determine the interaction between the excited determinant and the other parent | Jdet >
|
! you determine the interaction between the excited determinant and the other parent | Jdet >
|
||||||
! | det_tmp > = a^{\dagger}_{rorb,ispin} a^{\dagger}_{borb,kspin} a_{jorb,kspin} a_{iorb,ispin} | Jdet >
|
! | det_tmp > = a^{\dagger}_{rorb,ispin} a^{\dagger}_{borb,kspin} a_{jorb,kspin} a_{iorb,ispin} | Jdet >
|
||||||
! hja = < det_tmp | H | Jdet >
|
! hja = < det_tmp | H | Jdet >
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
||||||
if(kspin == ispin)then
|
if(kspin == ispin)then
|
||||||
hja = phase * (active_int(borb,2) - active_int(borb,1) )
|
hja = phase * (active_int(borb,2) - active_int(borb,1) )
|
||||||
else
|
else
|
||||||
@ -216,8 +216,8 @@ subroutine give_1h2p_contrib(matrix_1h2p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
@ -239,7 +239,7 @@ subroutine give_1h2p_contrib(matrix_1h2p)
|
|||||||
integer :: index_orb_act_mono(N_det,3)
|
integer :: index_orb_act_mono(N_det,3)
|
||||||
|
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
do ispin = 1, 2 ! spin of the couple a-a^dagger (iorb,rorb)
|
do ispin = 1, 2 ! spin of the couple a-a^dagger (iorb,rorb)
|
||||||
do jspin = 1, 2 ! spin of the couple a-a^dagger (aorb,vorb)
|
do jspin = 1, 2 ! spin of the couple a-a^dagger (aorb,vorb)
|
||||||
@ -247,8 +247,8 @@ subroutine give_1h2p_contrib(matrix_1h2p)
|
|||||||
aorb = list_act(a)
|
aorb = list_act(a)
|
||||||
if(ispin == jspin .and. vorb.le.rorb)cycle ! condition not to double count
|
if(ispin == jspin .and. vorb.le.rorb)cycle ! condition not to double count
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation inactive -- > virtual
|
! Do the excitation inactive -- > virtual
|
||||||
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
||||||
@ -258,7 +258,7 @@ subroutine give_1h2p_contrib(matrix_1h2p)
|
|||||||
call clear_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! hole in "aorb" of spin Jspin
|
call clear_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! hole in "aorb" of spin Jspin
|
||||||
call set_bit_to_integer(vorb,det_tmp(1,jspin),N_int) ! particle in "vorb" of spin Jspin
|
call set_bit_to_integer(vorb,det_tmp(1,jspin),N_int) ! particle in "vorb" of spin Jspin
|
||||||
|
|
||||||
! Check if the excitation is possible or not on psi_det(idet)
|
! Check if the excitation is possible or not on psi_ref(idet)
|
||||||
accu_elec= 0
|
accu_elec= 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
accu_elec+= popcnt(det_tmp(inint,jspin))
|
accu_elec+= popcnt(det_tmp(inint,jspin))
|
||||||
@ -280,7 +280,7 @@ subroutine give_1h2p_contrib(matrix_1h2p)
|
|||||||
det_tmp(inint,2) = perturb_dets(inint,2,a,jspin,ispin)
|
det_tmp(inint,2) = perturb_dets(inint,2,a,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
perturb_dets_phase(a,jspin,ispin) = phase
|
perturb_dets_phase(a,jspin,ispin) = phase
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
delta_e(a,jspin,istate) = one_anhil(a,jspin,istate) &
|
delta_e(a,jspin,istate) = one_anhil(a,jspin,istate) &
|
||||||
@ -308,7 +308,7 @@ subroutine give_1h2p_contrib(matrix_1h2p)
|
|||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | a^{\dagger}_b a_{a} | Idet>
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | a^{\dagger}_b a_{a} | Idet>
|
||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
if(idx(jdet).ne.idet)then
|
if(idx(jdet).ne.idet)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a
|
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a
|
||||||
@ -350,7 +350,7 @@ subroutine give_1h2p_contrib(matrix_1h2p)
|
|||||||
! | det_tmp > = a^{\dagger}_{rorb,ispin} a^{\dagger}_{vorb,kspin} a_{borb,kspin} a_{iorb,ispin} | Jdet >
|
! | det_tmp > = a^{\dagger}_{rorb,ispin} a^{\dagger}_{vorb,kspin} a_{borb,kspin} a_{iorb,ispin} | Jdet >
|
||||||
! hja = < det_tmp | H | Jdet >
|
! hja = < det_tmp | H | Jdet >
|
||||||
|
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
||||||
if(kspin == ispin)then
|
if(kspin == ispin)then
|
||||||
hja = phase * (active_int(borb,1) - active_int(borb,2) )
|
hja = phase * (active_int(borb,1) - active_int(borb,2) )
|
||||||
else
|
else
|
||||||
@ -418,8 +418,8 @@ subroutine give_1h1p_contrib(matrix_1h1p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
@ -430,20 +430,20 @@ subroutine give_1h1p_contrib(matrix_1h1p)
|
|||||||
- fock_virt_total_spin_trace(rorb,j)
|
- fock_virt_total_spin_trace(rorb,j)
|
||||||
enddo
|
enddo
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Case of the mono excitations
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Case of the mono excitations
|
||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
do ispin = 1, 2 ! spin of the couple a-a^dagger (i,r)
|
do ispin = 1, 2 ! spin of the couple a-a^dagger (i,r)
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation inactive -- > virtual
|
! Do the excitation inactive -- > virtual
|
||||||
double precision :: himono,delta_e(N_states),coef_mono(N_states)
|
double precision :: himono,delta_e(N_states),coef_mono(N_states)
|
||||||
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
||||||
call set_bit_to_integer(rorb,det_tmp(1,ispin),N_int) ! particle in "rorb" of spin Ispin
|
call set_bit_to_integer(rorb,det_tmp(1,ispin),N_int) ! particle in "rorb" of spin Ispin
|
||||||
call i_H_j(psi_det(1,1,idet),det_tmp,N_int,himono)
|
call i_H_j(psi_ref(1,1,idet),det_tmp,N_int,himono)
|
||||||
|
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
! delta_e(state_target) = one_anhil_one_creat_inact_virt(i,r,state_target) + delta_e_inact_virt(state_target)
|
! delta_e(state_target) = one_anhil_one_creat_inact_virt(i,r,state_target) + delta_e_inact_virt(state_target)
|
||||||
@ -451,7 +451,7 @@ subroutine give_1h1p_contrib(matrix_1h1p)
|
|||||||
coef_mono(state_target) = himono / delta_e(state_target)
|
coef_mono(state_target) = himono / delta_e(state_target)
|
||||||
enddo
|
enddo
|
||||||
if(idx(jdet).ne.idet)then
|
if(idx(jdet).ne.idet)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
aorb = (exc(1,2,1)) !!! a^{\dagger}_a
|
aorb = (exc(1,2,1)) !!! a^{\dagger}_a
|
||||||
@ -464,15 +464,15 @@ subroutine give_1h1p_contrib(matrix_1h1p)
|
|||||||
jspin = 2
|
jspin = 2
|
||||||
endif
|
endif
|
||||||
|
|
||||||
call get_excitation_degree(psi_det(1,1,idx(jdet)),det_tmp,degree_scalar,N_int)
|
call get_excitation_degree(psi_ref(1,1,idx(jdet)),det_tmp,degree_scalar,N_int)
|
||||||
if(degree_scalar .ne. 2)then
|
if(degree_scalar .ne. 2)then
|
||||||
print*, 'pb !!!'
|
print*, 'pb !!!'
|
||||||
print*, degree_scalar
|
print*, degree_scalar
|
||||||
call debug_det(psi_det(1,1,idx(jdet)),N_int)
|
call debug_det(psi_ref(1,1,idx(jdet)),N_int)
|
||||||
call debug_det(det_tmp,N_int)
|
call debug_det(det_tmp,N_int)
|
||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
||||||
if(ispin == jspin )then
|
if(ispin == jspin )then
|
||||||
hij = -get_mo_bielec_integral(iorb,aorb,rorb,borb,mo_integrals_map) &
|
hij = -get_mo_bielec_integral(iorb,aorb,rorb,borb,mo_integrals_map) &
|
||||||
+ get_mo_bielec_integral(iorb,aorb,borb,rorb,mo_integrals_map)
|
+ get_mo_bielec_integral(iorb,aorb,borb,rorb,mo_integrals_map)
|
||||||
@ -482,17 +482,17 @@ subroutine give_1h1p_contrib(matrix_1h1p)
|
|||||||
hij = hij * phase
|
hij = hij * phase
|
||||||
double precision :: hij_test
|
double precision :: hij_test
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
call i_H_j(psi_det(1,1,idx(jdet)),det_tmp,N_int,hij_test)
|
call i_H_j(psi_ref(1,1,idx(jdet)),det_tmp,N_int,hij_test)
|
||||||
if(dabs(hij - hij_test).gt.1.d-10)then
|
if(dabs(hij - hij_test).gt.1.d-10)then
|
||||||
print*, 'ahah pb !!'
|
print*, 'ahah pb !!'
|
||||||
print*, 'hij .ne. hij_test'
|
print*, 'hij .ne. hij_test'
|
||||||
print*, hij,hij_test
|
print*, hij,hij_test
|
||||||
call debug_det(psi_det(1,1,idx(jdet)),N_int)
|
call debug_det(psi_ref(1,1,idx(jdet)),N_int)
|
||||||
call debug_det(det_tmp,N_int)
|
call debug_det(det_tmp,N_int)
|
||||||
print*, ispin, jspin
|
print*, ispin, jspin
|
||||||
print*,iorb,borb,rorb,aorb
|
print*,iorb,borb,rorb,aorb
|
||||||
print*, phase
|
print*, phase
|
||||||
call i_H_j_verbose(psi_det(1,1,idx(jdet)),det_tmp,N_int,hij_test)
|
call i_H_j_verbose(psi_ref(1,1,idx(jdet)),det_tmp,N_int,hij_test)
|
||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
@ -542,13 +542,13 @@ subroutine give_1h1p_sec_order_singles_contrib(matrix_1h1p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
double precision :: himono,delta_e(N_states),coef_mono(N_states)
|
double precision :: himono,delta_e(N_states),coef_mono(N_states)
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
do r = 1, n_virt_orb ! First virtual
|
do r = 1, n_virt_orb ! First virtual
|
||||||
@ -563,13 +563,13 @@ subroutine give_1h1p_sec_order_singles_contrib(matrix_1h1p)
|
|||||||
- fock_virt_total_spin_trace(rorb,j)
|
- fock_virt_total_spin_trace(rorb,j)
|
||||||
enddo
|
enddo
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation inactive -- > virtual
|
! Do the excitation inactive -- > virtual
|
||||||
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
||||||
call set_bit_to_integer(rorb,det_tmp(1,ispin),N_int) ! particle in "rorb" of spin Ispin
|
call set_bit_to_integer(rorb,det_tmp(1,ispin),N_int) ! particle in "rorb" of spin Ispin
|
||||||
call i_H_j(psi_det(1,1,idet),det_tmp,N_int,himono)
|
call i_H_j(psi_ref(1,1,idet),det_tmp,N_int,himono)
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_pert(inint,1,i,r,ispin) = det_tmp(inint,1)
|
det_pert(inint,1,i,r,ispin) = det_tmp(inint,1)
|
||||||
det_pert(inint,2,i,r,ispin) = det_tmp(inint,2)
|
det_pert(inint,2,i,r,ispin) = det_tmp(inint,2)
|
||||||
@ -630,7 +630,7 @@ subroutine give_1h1p_sec_order_singles_contrib(matrix_1h1p)
|
|||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
!
|
!
|
||||||
if(idx(jdet).ne.idet)then
|
if(idx(jdet).ne.idet)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
aorb = (exc(1,2,1)) !!! a^{\dagger}_a
|
aorb = (exc(1,2,1)) !!! a^{\dagger}_a
|
||||||
@ -642,24 +642,24 @@ subroutine give_1h1p_sec_order_singles_contrib(matrix_1h1p)
|
|||||||
jspin = 2
|
jspin = 2
|
||||||
endif
|
endif
|
||||||
|
|
||||||
call get_excitation_degree(psi_det(1,1,idx(jdet)),det_tmp,degree_scalar,N_int)
|
call get_excitation_degree(psi_ref(1,1,idx(jdet)),det_tmp,degree_scalar,N_int)
|
||||||
if(degree_scalar .ne. 2)then
|
if(degree_scalar .ne. 2)then
|
||||||
print*, 'pb !!!'
|
print*, 'pb !!!'
|
||||||
print*, degree_scalar
|
print*, degree_scalar
|
||||||
call debug_det(psi_det(1,1,idx(jdet)),N_int)
|
call debug_det(psi_ref(1,1,idx(jdet)),N_int)
|
||||||
call debug_det(det_tmp,N_int)
|
call debug_det(det_tmp,N_int)
|
||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
||||||
double precision :: hij_test
|
double precision :: hij_test
|
||||||
hij_test = 0.d0
|
hij_test = 0.d0
|
||||||
call i_H_j(psi_det(1,1,idx(jdet)),det_tmp,N_int,hij_test)
|
call i_H_j(psi_ref(1,1,idx(jdet)),det_tmp,N_int,hij_test)
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
matrix_1h1p(idx(jdet),idet,state_target) += hij_test* coef_det_pert(i,r,ispin,state_target,2)
|
matrix_1h1p(idx(jdet),idet,state_target) += hij_test* coef_det_pert(i,r,ispin,state_target,2)
|
||||||
enddo
|
enddo
|
||||||
else
|
else
|
||||||
hij_test = 0.d0
|
hij_test = 0.d0
|
||||||
call i_H_j(psi_det(1,1,idet),det_tmp,N_int,hij_test)
|
call i_H_j(psi_ref(1,1,idet),det_tmp,N_int,hij_test)
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
matrix_1h1p(idet,idet,state_target) += hij_test* coef_det_pert(i,r,ispin,state_target,2)
|
matrix_1h1p(idet,idet,state_target) += hij_test* coef_det_pert(i,r,ispin,state_target,2)
|
||||||
enddo
|
enddo
|
||||||
@ -701,13 +701,13 @@ subroutine give_1p_sec_order_singles_contrib(matrix_1p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
double precision :: himono,delta_e(N_states),coef_mono(N_states)
|
double precision :: himono,delta_e(N_states),coef_mono(N_states)
|
||||||
integer :: state_target
|
integer :: state_target
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
do i = 1, n_act_orb ! First active
|
do i = 1, n_act_orb ! First active
|
||||||
iorb = list_act(i)
|
iorb = list_act(i)
|
||||||
do r = 1, n_virt_orb ! First virtual
|
do r = 1, n_virt_orb ! First virtual
|
||||||
@ -721,8 +721,8 @@ subroutine give_1p_sec_order_singles_contrib(matrix_1p)
|
|||||||
delta_e_act_virt(j) = - fock_virt_total_spin_trace(rorb,j)
|
delta_e_act_virt(j) = - fock_virt_total_spin_trace(rorb,j)
|
||||||
enddo
|
enddo
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation active -- > virtual
|
! Do the excitation active -- > virtual
|
||||||
call do_mono_excitation(det_tmp,iorb,rorb,ispin,i_ok)
|
call do_mono_excitation(det_tmp,iorb,rorb,ispin,i_ok)
|
||||||
@ -739,7 +739,7 @@ subroutine give_1p_sec_order_singles_contrib(matrix_1p)
|
|||||||
enddo
|
enddo
|
||||||
cycle
|
cycle
|
||||||
endif
|
endif
|
||||||
call i_H_j(psi_det(1,1,idet),det_tmp,N_int,himono)
|
call i_H_j(psi_ref(1,1,idet),det_tmp,N_int,himono)
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_pert(inint,1,i,r,ispin) = det_tmp(inint,1)
|
det_pert(inint,1,i,r,ispin) = det_tmp(inint,1)
|
||||||
det_pert(inint,2,i,r,ispin) = det_tmp(inint,2)
|
det_pert(inint,2,i,r,ispin) = det_tmp(inint,2)
|
||||||
@ -803,8 +803,8 @@ subroutine give_1p_sec_order_singles_contrib(matrix_1p)
|
|||||||
enddo
|
enddo
|
||||||
do jdet = 1,N_det
|
do jdet = 1,N_det
|
||||||
double precision :: coef_array(N_states),hij_test
|
double precision :: coef_array(N_states),hij_test
|
||||||
call i_H_j(det_tmp,psi_det(1,1,jdet),N_int,himono)
|
call i_H_j(det_tmp,psi_ref(1,1,jdet),N_int,himono)
|
||||||
call get_delta_e_dyall(psi_det(1,1,jdet),det_tmp,coef_array,hij_test,delta_e)
|
call get_delta_e_dyall(psi_ref(1,1,jdet),det_tmp,delta_e)
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
! matrix_1p(idet,jdet,state_target) += himono * coef_det_pert(i,r,ispin,state_target,1)
|
! matrix_1p(idet,jdet,state_target) += himono * coef_det_pert(i,r,ispin,state_target,1)
|
||||||
matrix_1p(idet,jdet,state_target) += himono * hij_det_pert(i,r,ispin) / delta_e(state_target)
|
matrix_1p(idet,jdet,state_target) += himono * hij_det_pert(i,r,ispin) / delta_e(state_target)
|
||||||
@ -850,8 +850,8 @@ subroutine give_1h1p_only_doubles_spin_cross(matrix_1h1p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
@ -862,7 +862,7 @@ subroutine give_1h1p_only_doubles_spin_cross(matrix_1h1p)
|
|||||||
- fock_virt_total_spin_trace(rorb,j)
|
- fock_virt_total_spin_trace(rorb,j)
|
||||||
enddo
|
enddo
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_double_alpha_beta(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_double_alpha_beta(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Case of the mono excitations
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Case of the mono excitations
|
||||||
do ispin = 1, 2
|
do ispin = 1, 2
|
||||||
@ -872,8 +872,8 @@ subroutine give_1h1p_only_doubles_spin_cross(matrix_1h1p)
|
|||||||
do b = 1, n_act_orb
|
do b = 1, n_act_orb
|
||||||
borb = list_act(b)
|
borb = list_act(b)
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation (i-->a)(ispin) + (b-->r)(other_spin(ispin))
|
! Do the excitation (i-->a)(ispin) + (b-->r)(other_spin(ispin))
|
||||||
integer :: i_ok,corb,dorb
|
integer :: i_ok,corb,dorb
|
||||||
@ -904,7 +904,7 @@ subroutine give_1h1p_only_doubles_spin_cross(matrix_1h1p)
|
|||||||
pert_det(inint,2,a,b,ispin) = det_tmp(inint,2)
|
pert_det(inint,2,a,b,ispin) = det_tmp(inint,2)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call i_H_j(psi_det(1,1,idet),det_tmp,N_int,hidouble)
|
call i_H_j(psi_ref(1,1,idet),det_tmp,N_int,hidouble)
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
delta_e(state_target) = one_anhil_one_creat(a,b,ispin,jspin,state_target) + delta_e_inact_virt(state_target)
|
delta_e(state_target) = one_anhil_one_creat(a,b,ispin,jspin,state_target) + delta_e_inact_virt(state_target)
|
||||||
pert_det_coef(a,b,ispin,state_target) = hidouble / delta_e(state_target)
|
pert_det_coef(a,b,ispin,state_target) = hidouble / delta_e(state_target)
|
||||||
@ -915,7 +915,7 @@ subroutine give_1h1p_only_doubles_spin_cross(matrix_1h1p)
|
|||||||
enddo
|
enddo
|
||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
if(idx(jdet).ne.idet)then
|
if(idx(jdet).ne.idet)then
|
||||||
call get_double_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
integer :: c,d,state_target
|
integer :: c,d,state_target
|
||||||
integer(bit_kind) :: det_tmp_bis(N_int,2)
|
integer(bit_kind) :: det_tmp_bis(N_int,2)
|
||||||
! excitation from I --> J
|
! excitation from I --> J
|
||||||
@ -935,8 +935,8 @@ subroutine give_1h1p_only_doubles_spin_cross(matrix_1h1p)
|
|||||||
det_tmp_bis(inint,2) = pert_det(inint,2,c,d,2)
|
det_tmp_bis(inint,2) = pert_det(inint,2,c,d,2)
|
||||||
enddo
|
enddo
|
||||||
double precision :: hjdouble_1,hjdouble_2
|
double precision :: hjdouble_1,hjdouble_2
|
||||||
call i_H_j(psi_det(1,1,idx(jdet)),det_tmp,N_int,hjdouble_1)
|
call i_H_j(psi_ref(1,1,idx(jdet)),det_tmp,N_int,hjdouble_1)
|
||||||
call i_H_j(psi_det(1,1,idx(jdet)),det_tmp_bis,N_int,hjdouble_2)
|
call i_H_j(psi_ref(1,1,idx(jdet)),det_tmp_bis,N_int,hjdouble_2)
|
||||||
do state_target = 1, N_states
|
do state_target = 1, N_states
|
||||||
matrix_1h1p(idx(jdet),idet,state_target) += (pert_det_coef(c,d,1,state_target) * hjdouble_1 + pert_det_coef(c,d,2,state_target) * hjdouble_2 )
|
matrix_1h1p(idx(jdet),idet,state_target) += (pert_det_coef(c,d,1,state_target) * hjdouble_1 + pert_det_coef(c,d,2,state_target) * hjdouble_2 )
|
||||||
enddo
|
enddo
|
||||||
|
@ -24,8 +24,8 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
@ -50,9 +50,9 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
integer :: istate
|
integer :: istate
|
||||||
|
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono_or_exchange(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono_or_exchange(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
! if(idet == 81)then
|
! if(idet == 81)then
|
||||||
! call get_excitation_degree_vector_mono_or_exchange_verbose(psi_det(1,1,1),psi_det(1,1,idet),degree,N_int,N_det,idx)
|
! call get_excitation_degree_vector_mono_or_exchange_verbose(psi_ref(1,1,1),psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
! endif
|
! endif
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
do ispin = 1, 2 ! spin of the couple a-a^dagger (i,r)
|
do ispin = 1, 2 ! spin of the couple a-a^dagger (i,r)
|
||||||
@ -61,8 +61,8 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
do a = 1, n_act_orb ! First active
|
do a = 1, n_act_orb ! First active
|
||||||
aorb = list_act(a)
|
aorb = list_act(a)
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation inactive -- > virtual
|
! Do the excitation inactive -- > virtual
|
||||||
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
||||||
@ -72,7 +72,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
call clear_bit_to_integer(jorb,det_tmp(1,jspin),N_int) ! hole in "jorb" of spin Jspin
|
call clear_bit_to_integer(jorb,det_tmp(1,jspin),N_int) ! hole in "jorb" of spin Jspin
|
||||||
call set_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! particle in "aorb" of spin Jspin
|
call set_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! particle in "aorb" of spin Jspin
|
||||||
|
|
||||||
! Check if the excitation is possible or not on psi_det(idet)
|
! Check if the excitation is possible or not on psi_ref(idet)
|
||||||
accu_elec= 0
|
accu_elec= 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
accu_elec+= popcnt(det_tmp(inint,jspin))
|
accu_elec+= popcnt(det_tmp(inint,jspin))
|
||||||
@ -90,7 +90,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
perturb_dets(inint,1,a,jspin,ispin) = det_tmp(inint,1)
|
perturb_dets(inint,1,a,jspin,ispin) = det_tmp(inint,1)
|
||||||
perturb_dets(inint,2,a,jspin,ispin) = det_tmp(inint,2)
|
perturb_dets(inint,2,a,jspin,ispin) = det_tmp(inint,2)
|
||||||
enddo
|
enddo
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
perturb_dets_phase(a,jspin,ispin) = phase
|
perturb_dets_phase(a,jspin,ispin) = phase
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
delta_e(a,jspin,istate) = one_creat(a,jspin,istate) &
|
delta_e(a,jspin,istate) = one_creat(a,jspin,istate) &
|
||||||
@ -124,7 +124,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
if(idx(jdet).ne.idet)then
|
if(idx(jdet).ne.idet)then
|
||||||
if(degree(jdet)==1)then
|
if(degree(jdet)==1)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
i_hole = list_act_reverse(exc(1,1,1)) !!! a_a
|
i_hole = list_act_reverse(exc(1,1,1)) !!! a_a
|
||||||
@ -149,7 +149,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
fock_operator_local(i_part,i_hole,kspin) = hij * phase ! phase less fock operator
|
fock_operator_local(i_part,i_hole,kspin) = hij * phase ! phase less fock operator
|
||||||
endif
|
endif
|
||||||
else if(degree(jdet)==2)then
|
else if(degree(jdet)==2)then
|
||||||
call get_double_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a
|
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a
|
||||||
index_orb_act_mono(idx(jdet),2) = list_act_reverse(exc(1,2,1)) !!! a^{\dagger}_{b}
|
index_orb_act_mono(idx(jdet),2) = list_act_reverse(exc(1,2,1)) !!! a^{\dagger}_{b}
|
||||||
@ -196,7 +196,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
det_tmp_bis(inint,2) = perturb_dets(inint,2,corb,jspin,ispin)
|
det_tmp_bis(inint,2) = perturb_dets(inint,2,corb,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
! ! < idet | H | det_tmp > = phase * (ir|cv)
|
! ! < idet | H | det_tmp > = phase * (ir|cv)
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hib= phase * (active_int(corb,1) - active_int(corb,2))
|
hib= phase * (active_int(corb,1) - active_int(corb,2))
|
||||||
else
|
else
|
||||||
@ -215,7 +215,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
! < jdet | H | det_tmp_bis > = phase * (ir|cv)
|
! < jdet | H | det_tmp_bis > = phase * (ir|cv)
|
||||||
call get_double_excitation(det_tmp_bis,psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(det_tmp_bis,psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hja= phase * (active_int(corb,1) - active_int(corb,2))
|
hja= phase * (active_int(corb,1) - active_int(corb,2))
|
||||||
else
|
else
|
||||||
@ -243,7 +243,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
det_tmp_bis(inint,2) = perturb_dets(inint,2,corb,jspin,ispin)
|
det_tmp_bis(inint,2) = perturb_dets(inint,2,corb,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
! < idet | H | det_tmp > = phase * ( (ir|cv) - (iv|cr) )
|
! < idet | H | det_tmp > = phase * ( (ir|cv) - (iv|cr) )
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hib= phase * (active_int(corb,1) - active_int(corb,2))
|
hib= phase * (active_int(corb,1) - active_int(corb,2))
|
||||||
else
|
else
|
||||||
@ -260,7 +260,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
! < jdet | H | det_tmp_bis > = phase * ( (ir|cv) - (iv|cr) )
|
! < jdet | H | det_tmp_bis > = phase * ( (ir|cv) - (iv|cr) )
|
||||||
call get_double_excitation(det_tmp_bis,psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(det_tmp_bis,psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hja= phase * (active_int(corb,1) - active_int(corb,2))
|
hja= phase * (active_int(corb,1) - active_int(corb,2))
|
||||||
else
|
else
|
||||||
@ -296,7 +296,7 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
det_tmp_bis(inint,2) = perturb_dets(inint,2,aorb,jspin,ispin)
|
det_tmp_bis(inint,2) = perturb_dets(inint,2,aorb,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
! | det_tmp > = a^{\dagger}_{aorb,beta} | Idet >
|
! | det_tmp > = a^{\dagger}_{aorb,beta} | Idet >
|
||||||
call get_double_excitation(det_tmp,psi_det(1,1,idet),exc,phase,N_int)
|
call get_double_excitation(det_tmp,psi_ref(1,1,idet),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hib= phase * (active_int(aorb,1) - active_int(aorb,2))
|
hib= phase * (active_int(aorb,1) - active_int(aorb,2))
|
||||||
else
|
else
|
||||||
@ -312,15 +312,15 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p)
|
|||||||
else if(index_orb_act_mono(idx(jdet),1) == index_orb_act_mono(idx(jdet),4))then !! closed shell double excitation
|
else if(index_orb_act_mono(idx(jdet),1) == index_orb_act_mono(idx(jdet),4))then !! closed shell double excitation
|
||||||
|
|
||||||
else
|
else
|
||||||
call get_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,degree_scalar,phase,N_int)
|
call get_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,degree_scalar,phase,N_int)
|
||||||
integer :: h1,h2,p1,p2,s1,s2 , degree_scalar
|
integer :: h1,h2,p1,p2,s1,s2 , degree_scalar
|
||||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
print*, h1,p1,h2,p2,s1,s2
|
print*, h1,p1,h2,p2,s1,s2
|
||||||
call debug_det(psi_det(1,1,idet),N_int)
|
call debug_det(psi_ref(1,1,idet),N_int)
|
||||||
call debug_det(psi_det(1,1,idx(jdet)),N_int)
|
call debug_det(psi_ref(1,1,idx(jdet)),N_int)
|
||||||
print*, idet,idx(jdet)
|
print*, idet,idx(jdet)
|
||||||
print*, 'pb !!!!!!!!!!!!!'
|
print*, 'pb !!!!!!!!!!!!!'
|
||||||
call get_excitation_degree_vector_mono_or_exchange_verbose(psi_det(1,1,1),psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono_or_exchange_verbose(psi_ref(1,1,1),psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
@ -398,8 +398,8 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
@ -430,7 +430,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
+ fock_core_inactive_total_spin_trace(iorb,istate)
|
+ fock_core_inactive_total_spin_trace(iorb,istate)
|
||||||
enddo
|
enddo
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono_or_exchange(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono_or_exchange(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
do ispin = 1, 2 ! spin of the couple a-a^dagger (iorb,rorb)
|
do ispin = 1, 2 ! spin of the couple a-a^dagger (iorb,rorb)
|
||||||
do jspin = 1, 2 ! spin of the couple a-a^dagger (aorb,vorb)
|
do jspin = 1, 2 ! spin of the couple a-a^dagger (aorb,vorb)
|
||||||
@ -443,8 +443,8 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
enddo
|
enddo
|
||||||
if(ispin == jspin .and. vorb.le.rorb)cycle ! condition not to double count
|
if(ispin == jspin .and. vorb.le.rorb)cycle ! condition not to double count
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation inactive -- > virtual
|
! Do the excitation inactive -- > virtual
|
||||||
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
||||||
@ -454,7 +454,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
call clear_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! hole in "aorb" of spin Jspin
|
call clear_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! hole in "aorb" of spin Jspin
|
||||||
call set_bit_to_integer(vorb,det_tmp(1,jspin),N_int) ! particle in "vorb" of spin Jspin
|
call set_bit_to_integer(vorb,det_tmp(1,jspin),N_int) ! particle in "vorb" of spin Jspin
|
||||||
|
|
||||||
! Check if the excitation is possible or not on psi_det(idet)
|
! Check if the excitation is possible or not on psi_ref(idet)
|
||||||
accu_elec= 0
|
accu_elec= 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
accu_elec+= popcnt(det_tmp(inint,jspin))
|
accu_elec+= popcnt(det_tmp(inint,jspin))
|
||||||
@ -477,7 +477,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
det_tmp(inint,2) = perturb_dets(inint,2,a,jspin,ispin)
|
det_tmp(inint,2) = perturb_dets(inint,2,a,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
perturb_dets_phase(a,jspin,ispin) = phase
|
perturb_dets_phase(a,jspin,ispin) = phase
|
||||||
|
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
@ -501,7 +501,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
if(idx(jdet).ne.idet)then
|
if(idx(jdet).ne.idet)then
|
||||||
if(degree(jdet)==1)then
|
if(degree(jdet)==1)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
i_hole = list_act_reverse(exc(1,1,1)) !!! a_a
|
i_hole = list_act_reverse(exc(1,1,1)) !!! a_a
|
||||||
@ -526,7 +526,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
fock_operator_local(i_part,i_hole,kspin) = hij * phase ! phase less fock operator
|
fock_operator_local(i_part,i_hole,kspin) = hij * phase ! phase less fock operator
|
||||||
endif
|
endif
|
||||||
else if(degree(jdet)==2)then
|
else if(degree(jdet)==2)then
|
||||||
call get_double_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a
|
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a
|
||||||
index_orb_act_mono(idx(jdet),2) = list_act_reverse(exc(1,2,1)) !!! a^{\dagger}_{b}
|
index_orb_act_mono(idx(jdet),2) = list_act_reverse(exc(1,2,1)) !!! a^{\dagger}_{b}
|
||||||
@ -575,7 +575,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
det_tmp_bis(inint,2) = perturb_dets(inint,2,corb,jspin,ispin)
|
det_tmp_bis(inint,2) = perturb_dets(inint,2,corb,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
! < idet | H | det_tmp > = phase * (ir|cv)
|
! < idet | H | det_tmp > = phase * (ir|cv)
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hib= phase * (active_int(corb,1) - active_int(corb,2))
|
hib= phase * (active_int(corb,1) - active_int(corb,2))
|
||||||
else
|
else
|
||||||
@ -590,7 +590,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
! < det_tmp | H | det_tmp_bis > = F_{aorb,borb}
|
! < det_tmp | H | det_tmp_bis > = F_{aorb,borb}
|
||||||
hab = (fock_operator_local(aorb,borb,kspin) ) * phase
|
hab = (fock_operator_local(aorb,borb,kspin) ) * phase
|
||||||
! < jdet | H | det_tmp_bis > = phase * (ir|cv)
|
! < jdet | H | det_tmp_bis > = phase * (ir|cv)
|
||||||
call get_double_excitation(det_tmp_bis,psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(det_tmp_bis,psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hja= phase * (active_int(corb,1) - active_int(corb,2))
|
hja= phase * (active_int(corb,1) - active_int(corb,2))
|
||||||
else
|
else
|
||||||
@ -617,7 +617,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
det_tmp_bis(inint,2) = perturb_dets(inint,2,corb,jspin,ispin)
|
det_tmp_bis(inint,2) = perturb_dets(inint,2,corb,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
! < idet | H | det_tmp > = phase * ( (ir|cv) - (iv|cr) )
|
! < idet | H | det_tmp > = phase * ( (ir|cv) - (iv|cr) )
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hib= phase * (active_int(corb,1) - active_int(corb,2))
|
hib= phase * (active_int(corb,1) - active_int(corb,2))
|
||||||
else
|
else
|
||||||
@ -630,7 +630,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
! ! < det_tmp | H | det_tmp_bis > = F_{aorb,borb}
|
! ! < det_tmp | H | det_tmp_bis > = F_{aorb,borb}
|
||||||
hab = fock_operator_local(aorb,borb,kspin) * phase
|
hab = fock_operator_local(aorb,borb,kspin) * phase
|
||||||
! < jdet | H | det_tmp_bis > = phase * ( (ir|cv) - (iv|cr) )
|
! < jdet | H | det_tmp_bis > = phase * ( (ir|cv) - (iv|cr) )
|
||||||
call get_double_excitation(det_tmp_bis,psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(det_tmp_bis,psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hja= phase * (active_int(corb,1) - active_int(corb,2))
|
hja= phase * (active_int(corb,1) - active_int(corb,2))
|
||||||
else
|
else
|
||||||
@ -665,7 +665,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
det_tmp_bis(inint,1) = perturb_dets(inint,1,aorb,jspin,ispin)
|
det_tmp_bis(inint,1) = perturb_dets(inint,1,aorb,jspin,ispin)
|
||||||
det_tmp_bis(inint,2) = perturb_dets(inint,2,aorb,jspin,ispin)
|
det_tmp_bis(inint,2) = perturb_dets(inint,2,aorb,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
call get_double_excitation(det_tmp,psi_det(1,1,idet),exc,phase,N_int)
|
call get_double_excitation(det_tmp,psi_ref(1,1,idet),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hib= phase * (active_int(borb,1) - active_int(borb,2))
|
hib= phase * (active_int(borb,1) - active_int(borb,2))
|
||||||
else
|
else
|
||||||
@ -674,8 +674,8 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
if( index_orb_act_mono(idx(jdet),1) == index_orb_act_mono(idx(jdet),5))then
|
if( index_orb_act_mono(idx(jdet),1) == index_orb_act_mono(idx(jdet),5))then
|
||||||
call do_mono_excitation(det_tmp_bis,list_act(borb),list_act(aorb),1,i_ok)
|
call do_mono_excitation(det_tmp_bis,list_act(borb),list_act(aorb),1,i_ok)
|
||||||
if(i_ok .ne. 1)then
|
if(i_ok .ne. 1)then
|
||||||
call debug_det(psi_det(1,1,idet),N_int)
|
call debug_det(psi_ref(1,1,idet),N_int)
|
||||||
call debug_det(psi_det(1,1,idx(jdet)),N_int)
|
call debug_det(psi_ref(1,1,idx(jdet)),N_int)
|
||||||
print*, aorb, borb
|
print*, aorb, borb
|
||||||
call debug_det(det_tmp,N_int)
|
call debug_det(det_tmp,N_int)
|
||||||
stop
|
stop
|
||||||
@ -692,7 +692,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
hab = fock_operator_local(aorb,borb,1) * phase
|
hab = fock_operator_local(aorb,borb,1) * phase
|
||||||
call get_double_excitation(det_tmp_bis,psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(det_tmp_bis,psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hja= phase * (active_int(borb,1) - active_int(borb,2))
|
hja= phase * (active_int(borb,1) - active_int(borb,2))
|
||||||
else
|
else
|
||||||
@ -716,7 +716,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
det_tmp_bis(inint,1) = perturb_dets(inint,1,aorb,jspin,ispin)
|
det_tmp_bis(inint,1) = perturb_dets(inint,1,aorb,jspin,ispin)
|
||||||
det_tmp_bis(inint,2) = perturb_dets(inint,2,aorb,jspin,ispin)
|
det_tmp_bis(inint,2) = perturb_dets(inint,2,aorb,jspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
call get_double_excitation(det_tmp,psi_det(1,1,idet),exc,phase,N_int)
|
call get_double_excitation(det_tmp,psi_ref(1,1,idet),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hib= phase * (active_int(borb,1) - active_int(borb,2))
|
hib= phase * (active_int(borb,1) - active_int(borb,2))
|
||||||
else
|
else
|
||||||
@ -725,8 +725,8 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
if( index_orb_act_mono(idx(jdet),1) == index_orb_act_mono(idx(jdet),5))then
|
if( index_orb_act_mono(idx(jdet),1) == index_orb_act_mono(idx(jdet),5))then
|
||||||
call do_mono_excitation(det_tmp_bis,list_act(borb),list_act(aorb),2,i_ok)
|
call do_mono_excitation(det_tmp_bis,list_act(borb),list_act(aorb),2,i_ok)
|
||||||
if(i_ok .ne. 1)then
|
if(i_ok .ne. 1)then
|
||||||
call debug_det(psi_det(1,1,idet),N_int)
|
call debug_det(psi_ref(1,1,idet),N_int)
|
||||||
call debug_det(psi_det(1,1,idx(jdet)),N_int)
|
call debug_det(psi_ref(1,1,idx(jdet)),N_int)
|
||||||
print*, aorb, borb
|
print*, aorb, borb
|
||||||
call debug_det(det_tmp,N_int)
|
call debug_det(det_tmp,N_int)
|
||||||
stop
|
stop
|
||||||
@ -739,7 +739,7 @@ subroutine give_1h2p_contrib_sec_order(matrix_1h2p)
|
|||||||
call get_mono_excitation(det_tmp,det_tmp_bis,exc,phase,N_int)
|
call get_mono_excitation(det_tmp,det_tmp_bis,exc,phase,N_int)
|
||||||
! < det_tmp | H | det_tmp_bis > = F_{aorb,borb}
|
! < det_tmp | H | det_tmp_bis > = F_{aorb,borb}
|
||||||
hab = fock_operator_local(aorb,borb,2) * phase
|
hab = fock_operator_local(aorb,borb,2) * phase
|
||||||
call get_double_excitation(det_tmp_bis,psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(det_tmp_bis,psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if(ispin == jspin)then
|
if(ispin == jspin)then
|
||||||
hja= phase * (active_int(borb,1) - active_int(borb,2))
|
hja= phase * (active_int(borb,1) - active_int(borb,2))
|
||||||
else
|
else
|
||||||
|
@ -11,8 +11,8 @@ BEGIN_PROVIDER [integer(bit_kind), psi_active, (N_int,2,psi_det_size)]
|
|||||||
!print*, 'psi_active '
|
!print*, 'psi_active '
|
||||||
do i = 1, N_det
|
do i = 1, N_det
|
||||||
do j = 1, N_int
|
do j = 1, N_int
|
||||||
psi_active(j,1,i) = iand(psi_det(j,1,i),cas_bitmask(j,1,1))
|
psi_active(j,1,i) = iand(psi_ref(j,1,i),cas_bitmask(j,1,1))
|
||||||
psi_active(j,2,i) = iand(psi_det(j,2,i),cas_bitmask(j,1,1))
|
psi_active(j,2,i) = iand(psi_ref(j,2,i),cas_bitmask(j,1,1))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
@ -152,7 +152,7 @@ subroutine give_particles_in_virt_space(det_1,n_particles_spin,n_particles,parti
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final)
|
subroutine get_delta_e_dyall(det_1,det_2,delta_e_final)
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! routine that returns the delta_e with the Moller Plesset and Dyall operators
|
! routine that returns the delta_e with the Moller Plesset and Dyall operators
|
||||||
!
|
!
|
||||||
@ -170,7 +170,6 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final)
|
|||||||
use bitmasks
|
use bitmasks
|
||||||
double precision, intent(out) :: delta_e_final(N_states)
|
double precision, intent(out) :: delta_e_final(N_states)
|
||||||
integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2)
|
integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2)
|
||||||
double precision, intent(in) :: coef_array(N_states),hij
|
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
integer :: i_state
|
integer :: i_state
|
||||||
|
|
||||||
@ -293,20 +292,9 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final)
|
|||||||
if (n_holes_act == 0 .and. n_particles_act == 1) then
|
if (n_holes_act == 0 .and. n_particles_act == 1) then
|
||||||
ispin = particle_list_practical(1,1)
|
ispin = particle_list_practical(1,1)
|
||||||
i_particle_act = particle_list_practical(2,1)
|
i_particle_act = particle_list_practical(2,1)
|
||||||
! call get_excitation_degree(det_1,det_2,degree,N_int)
|
|
||||||
! if(degree == 1)then
|
|
||||||
! call get_excitation(det_1,det_2,exc,degree,phase,N_int)
|
|
||||||
! call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
|
||||||
! i_hole = list_inact_reverse(h1)
|
|
||||||
! i_part = list_act_reverse(p1)
|
|
||||||
! do i_state = 1, N_states
|
|
||||||
! delta_e_act(i_state) += one_anhil_inact(i_hole,i_part,i_state)
|
|
||||||
! enddo
|
|
||||||
! else if (degree == 2)then
|
|
||||||
do i_state = 1, N_states
|
do i_state = 1, N_states
|
||||||
delta_e_act(i_state) += one_creat(i_particle_act,ispin,i_state)
|
delta_e_act(i_state) += one_creat(i_particle_act,ispin,i_state)
|
||||||
enddo
|
enddo
|
||||||
! endif
|
|
||||||
|
|
||||||
else if (n_holes_act == 1 .and. n_particles_act == 0) then
|
else if (n_holes_act == 1 .and. n_particles_act == 0) then
|
||||||
ispin = hole_list_practical(1,1)
|
ispin = hole_list_practical(1,1)
|
||||||
@ -433,3 +421,159 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_delta_e_dyall_general_mp(det_1,det_2,delta_e_final)
|
||||||
|
BEGIN_DOC
|
||||||
|
! routine that returns the delta_e with the Moller Plesset and Dyall operators
|
||||||
|
!
|
||||||
|
! with det_1 being a determinant from the cas, and det_2 being a perturber
|
||||||
|
!
|
||||||
|
! Delta_e(det_1,det_2) = sum (hole) epsilon(hole) + sum(part) espilon(part) + delta_e(act)
|
||||||
|
!
|
||||||
|
! where hole is necessary in the inactive, part necessary in the virtuals
|
||||||
|
!
|
||||||
|
! and delta_e(act) is obtained as the sum of energies of excitations a la MP
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
use bitmasks
|
||||||
|
double precision, intent(out) :: delta_e_final(N_states)
|
||||||
|
integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2)
|
||||||
|
integer :: i,j,k,l
|
||||||
|
integer :: i_state
|
||||||
|
|
||||||
|
integer :: n_holes_spin(2)
|
||||||
|
integer :: n_holes
|
||||||
|
integer :: holes_list(N_int*bit_kind_size,2)
|
||||||
|
|
||||||
|
|
||||||
|
double precision :: delta_e_inactive(N_states)
|
||||||
|
integer :: i_hole_inact
|
||||||
|
|
||||||
|
|
||||||
|
call give_holes_in_inactive_space(det_2,n_holes_spin,n_holes,holes_list)
|
||||||
|
delta_e_inactive = 0.d0
|
||||||
|
do i = 1, n_holes_spin(1)
|
||||||
|
i_hole_inact = holes_list(i,1)
|
||||||
|
do i_state = 1, N_states
|
||||||
|
delta_e_inactive += fock_core_inactive_total_spin_trace(i_hole_inact,i_state)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i = 1, n_holes_spin(2)
|
||||||
|
i_hole_inact = holes_list(i,2)
|
||||||
|
do i_state = 1, N_states
|
||||||
|
delta_e_inactive(i_state) += fock_core_inactive_total_spin_trace(i_hole_inact,i_state)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
double precision :: delta_e_virt(N_states)
|
||||||
|
integer :: i_part_virt
|
||||||
|
integer :: n_particles_spin(2)
|
||||||
|
integer :: n_particles
|
||||||
|
integer :: particles_list(N_int*bit_kind_size,2)
|
||||||
|
|
||||||
|
call give_particles_in_virt_space(det_2,n_particles_spin,n_particles,particles_list)
|
||||||
|
delta_e_virt = 0.d0
|
||||||
|
do i = 1, n_particles_spin(1)
|
||||||
|
i_part_virt = particles_list(i,1)
|
||||||
|
do i_state = 1, N_states
|
||||||
|
delta_e_virt += fock_virt_total_spin_trace(i_part_virt,i_state)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i = 1, n_particles_spin(2)
|
||||||
|
i_part_virt = particles_list(i,2)
|
||||||
|
do i_state = 1, N_states
|
||||||
|
delta_e_virt += fock_virt_total_spin_trace(i_part_virt,i_state)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
integer :: n_holes_spin_act(2),n_particles_spin_act(2)
|
||||||
|
integer :: n_holes_act,n_particles_act
|
||||||
|
integer :: holes_active_list(2*n_act_orb,2)
|
||||||
|
integer :: holes_active_list_spin_traced(4*n_act_orb)
|
||||||
|
integer :: particles_active_list(2*n_act_orb,2)
|
||||||
|
integer :: particles_active_list_spin_traced(4*n_act_orb)
|
||||||
|
double precision :: delta_e_act(N_states)
|
||||||
|
delta_e_act = 0.d0
|
||||||
|
call give_holes_and_particles_in_active_space(det_1,det_2,n_holes_spin_act,n_particles_spin_act, &
|
||||||
|
n_holes_act,n_particles_act,holes_active_list,particles_active_list)
|
||||||
|
integer :: icount,icountbis
|
||||||
|
integer :: hole_list_practical(2,elec_num_tab(1)+elec_num_tab(2)), particle_list_practical(2,elec_num_tab(1)+elec_num_tab(2))
|
||||||
|
icount = 0
|
||||||
|
icountbis = 0
|
||||||
|
do i = 1, n_holes_spin_act(1)
|
||||||
|
icount += 1
|
||||||
|
icountbis += 1
|
||||||
|
hole_list_practical(1,icountbis) = 1 ! spin
|
||||||
|
hole_list_practical(2,icountbis) = holes_active_list(i,1) ! index of active orb
|
||||||
|
holes_active_list_spin_traced(icount) = holes_active_list(i,1)
|
||||||
|
enddo
|
||||||
|
do i = 1, n_holes_spin_act(2)
|
||||||
|
icount += 1
|
||||||
|
icountbis += 1
|
||||||
|
hole_list_practical(1,icountbis) = 2
|
||||||
|
hole_list_practical(2,icountbis) = holes_active_list(i,2)
|
||||||
|
holes_active_list_spin_traced(icount) = holes_active_list(i,2)
|
||||||
|
enddo
|
||||||
|
if(icount .ne. n_holes_act) then
|
||||||
|
print*,''
|
||||||
|
print*, icount, n_holes_act
|
||||||
|
print * , 'pb in holes_active_list_spin_traced !!'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
icount = 0
|
||||||
|
icountbis = 0
|
||||||
|
do i = 1, n_particles_spin_act(1)
|
||||||
|
icount += 1
|
||||||
|
icountbis += 1
|
||||||
|
particle_list_practical(1,icountbis) = 1
|
||||||
|
particle_list_practical(2,icountbis) = particles_active_list(i,1)
|
||||||
|
particles_active_list_spin_traced(icount) = particles_active_list(i,1)
|
||||||
|
enddo
|
||||||
|
do i = 1, n_particles_spin_act(2)
|
||||||
|
icount += 1
|
||||||
|
icountbis += 1
|
||||||
|
particle_list_practical(1,icountbis) = 2
|
||||||
|
particle_list_practical(2,icountbis) = particles_active_list(i,2)
|
||||||
|
particles_active_list_spin_traced(icount) = particles_active_list(i,2)
|
||||||
|
enddo
|
||||||
|
if(icount .ne. n_particles_act) then
|
||||||
|
print*, icount, n_particles_act
|
||||||
|
print * , 'pb in particles_active_list_spin_traced !!'
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
integer :: i_hole_act, j_hole_act, k_hole_act
|
||||||
|
integer :: i_particle_act, j_particle_act, k_particle_act
|
||||||
|
|
||||||
|
|
||||||
|
integer :: ispin,jspin,kspin
|
||||||
|
|
||||||
|
do i = 1, n_holes_act
|
||||||
|
ispin = hole_list_practical(1,i)
|
||||||
|
i_hole_act = hole_list_practical(2,i)
|
||||||
|
do i_state = 1, N_states
|
||||||
|
delta_e_act(i_state) += one_anhil(i_hole_act , ispin,i_state)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i = 1, n_particles_act
|
||||||
|
ispin = particle_list_practical(1,i)
|
||||||
|
i_particle_act = particle_list_practical(2,i)
|
||||||
|
do i_state = 1, N_states
|
||||||
|
delta_e_act(i_state) += one_creat(i_particle_act, ispin,i_state)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i_state = 1, n_states
|
||||||
|
delta_e_final(i_state) = delta_e_act(i_state) + delta_e_inactive(i_state) - delta_e_virt(i_state)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
@ -51,8 +51,8 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
@ -79,7 +79,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
+ fock_core_inactive_total_spin_trace(iorb,istate)
|
+ fock_core_inactive_total_spin_trace(iorb,istate)
|
||||||
enddo
|
enddo
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono_or_exchange(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono_or_exchange(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
do ispin = 1, 2 ! spin of the couple a-a^dagger (iorb,rorb)
|
do ispin = 1, 2 ! spin of the couple a-a^dagger (iorb,rorb)
|
||||||
do jspin = 1, 2 ! spin of the couple a-a^dagger (aorb,vorb)
|
do jspin = 1, 2 ! spin of the couple a-a^dagger (aorb,vorb)
|
||||||
@ -90,8 +90,8 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
enddo
|
enddo
|
||||||
if(ispin == jspin .and. vorb.le.rorb)cycle ! condition not to double count
|
if(ispin == jspin .and. vorb.le.rorb)cycle ! condition not to double count
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation inactive -- > virtual
|
! Do the excitation inactive -- > virtual
|
||||||
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
||||||
@ -101,7 +101,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
call clear_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! hole in "aorb" of spin Jspin
|
call clear_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! hole in "aorb" of spin Jspin
|
||||||
call set_bit_to_integer(vorb,det_tmp(1,jspin),N_int) ! particle in "vorb" of spin Jspin
|
call set_bit_to_integer(vorb,det_tmp(1,jspin),N_int) ! particle in "vorb" of spin Jspin
|
||||||
|
|
||||||
! Check if the excitation is possible or not on psi_det(idet)
|
! Check if the excitation is possible or not on psi_ref(idet)
|
||||||
accu_elec= 0
|
accu_elec= 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
accu_elec+= popcnt(det_tmp(inint,jspin))
|
accu_elec+= popcnt(det_tmp(inint,jspin))
|
||||||
@ -116,7 +116,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
perturb_dets(inint,2,a,jspin,ispin) = det_tmp(inint,2)
|
perturb_dets(inint,2,a,jspin,ispin) = det_tmp(inint,2)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
perturb_dets_phase(a,jspin,ispin) = phase
|
perturb_dets_phase(a,jspin,ispin) = phase
|
||||||
|
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
@ -138,7 +138,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | K_{ab} | Idet>
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | K_{ab} | Idet>
|
||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
if(degree(jdet)==1)then
|
if(degree(jdet)==1)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
i_hole = list_act_reverse(exc(1,1,1)) !!! a_a
|
i_hole = list_act_reverse(exc(1,1,1)) !!! a_a
|
||||||
@ -163,7 +163,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
fock_operator_local(i_part,i_hole,kspin) = hij * phase ! phase less fock operator
|
fock_operator_local(i_part,i_hole,kspin) = hij * phase ! phase less fock operator
|
||||||
endif
|
endif
|
||||||
else if(degree(jdet)==2)then
|
else if(degree(jdet)==2)then
|
||||||
call get_double_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a ALPHA
|
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a ALPHA
|
||||||
index_orb_act_mono(idx(jdet),2) = list_act_reverse(exc(1,2,1)) !!! a^{\dagger}_{b} ALPHA
|
index_orb_act_mono(idx(jdet),2) = list_act_reverse(exc(1,2,1)) !!! a^{\dagger}_{b} ALPHA
|
||||||
@ -209,13 +209,13 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
det_tmp(inint,1) = perturb_dets(inint,1,aorb,kspin,ispin)
|
det_tmp(inint,1) = perturb_dets(inint,1,aorb,kspin,ispin)
|
||||||
det_tmp(inint,2) = perturb_dets(inint,2,aorb,kspin,ispin)
|
det_tmp(inint,2) = perturb_dets(inint,2,aorb,kspin,ispin)
|
||||||
enddo
|
enddo
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
if(kspin == ispin)then
|
if(kspin == ispin)then
|
||||||
hia = phase * (active_int(aorb,1) - active_int(aorb,2) )
|
hia = phase * (active_int(aorb,1) - active_int(aorb,2) )
|
||||||
else
|
else
|
||||||
hia = phase * active_int(aorb,1)
|
hia = phase * active_int(aorb,1)
|
||||||
endif
|
endif
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
||||||
if(kspin == ispin)then
|
if(kspin == ispin)then
|
||||||
hja = phase * (active_int(borb,1) - active_int(borb,2) )
|
hja = phase * (active_int(borb,1) - active_int(borb,2) )
|
||||||
else
|
else
|
||||||
@ -254,7 +254,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
if(dabs(hia).le.1.d-12)cycle
|
if(dabs(hia).le.1.d-12)cycle
|
||||||
if(dabs(hab).le.1.d-12)cycle
|
if(dabs(hab).le.1.d-12)cycle
|
||||||
|
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
||||||
if(jspin == ispin)then
|
if(jspin == ispin)then
|
||||||
hjb = phase * (active_int(corb,1) - active_int(corb,2) )
|
hjb = phase * (active_int(corb,1) - active_int(corb,2) )
|
||||||
else
|
else
|
||||||
@ -307,7 +307,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
hab = fock_operator_local(aorb,borb,1) * phase
|
hab = fock_operator_local(aorb,borb,1) * phase
|
||||||
|
|
||||||
if(dabs(hab).le.1.d-12)cycle
|
if(dabs(hab).le.1.d-12)cycle
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
||||||
if(ispin == 2)then
|
if(ispin == 2)then
|
||||||
hjb = phase * (active_int(aorb,1) - active_int(aorb,2) )
|
hjb = phase * (active_int(aorb,1) - active_int(aorb,2) )
|
||||||
else if (ispin == 1)then
|
else if (ispin == 1)then
|
||||||
@ -341,7 +341,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
hab = fock_operator_local(aorb,borb,2) * phase
|
hab = fock_operator_local(aorb,borb,2) * phase
|
||||||
|
|
||||||
if(dabs(hab).le.1.d-12)cycle
|
if(dabs(hab).le.1.d-12)cycle
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
||||||
if(ispin == 1)then
|
if(ispin == 1)then
|
||||||
hjb = phase * (active_int(borb,1) - active_int(borb,2) )
|
hjb = phase * (active_int(borb,1) - active_int(borb,2) )
|
||||||
else if (ispin == 2)then
|
else if (ispin == 2)then
|
||||||
@ -380,7 +380,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
hab = fock_operator_local(aorb,borb,1) * phase
|
hab = fock_operator_local(aorb,borb,1) * phase
|
||||||
|
|
||||||
if(dabs(hab).le.1.d-12)cycle
|
if(dabs(hab).le.1.d-12)cycle
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
||||||
if(ispin == 2)then
|
if(ispin == 2)then
|
||||||
hjb = phase * (active_int(borb,1) - active_int(borb,2) )
|
hjb = phase * (active_int(borb,1) - active_int(borb,2) )
|
||||||
else if (ispin == 1)then
|
else if (ispin == 1)then
|
||||||
@ -415,7 +415,7 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
hab = fock_operator_local(aorb,borb,2) * phase
|
hab = fock_operator_local(aorb,borb,2) * phase
|
||||||
|
|
||||||
if(dabs(hab).le.1.d-12)cycle
|
if(dabs(hab).le.1.d-12)cycle
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
||||||
if(ispin == 1)then
|
if(ispin == 1)then
|
||||||
hjb = phase * (active_int(borb,1) - active_int(borb,2) )
|
hjb = phase * (active_int(borb,1) - active_int(borb,2) )
|
||||||
else if (ispin == 2)then
|
else if (ispin == 2)then
|
||||||
@ -433,9 +433,9 @@ subroutine give_1h2p_new(matrix_1h2p)
|
|||||||
|
|
||||||
else
|
else
|
||||||
! one should not fall in this case ...
|
! one should not fall in this case ...
|
||||||
call debug_det(psi_det(1,1,i),N_int)
|
call debug_det(psi_ref(1,1,i),N_int)
|
||||||
call debug_det(psi_det(1,1,idx(jdet)),N_int)
|
call debug_det(psi_ref(1,1,idx(jdet)),N_int)
|
||||||
call get_double_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
call decode_exc(exc,2,h1,p1,h2,p2,s1,s2)
|
call decode_exc(exc,2,h1,p1,h2,p2,s1,s2)
|
||||||
integer :: h1, p1, h2, p2, s1, s2
|
integer :: h1, p1, h2, p2, s1, s2
|
||||||
print*, h1, p1, h2, p2, s1, s2
|
print*, h1, p1, h2, p2, s1, s2
|
||||||
@ -519,8 +519,8 @@ subroutine give_2h1p_new(matrix_2h1p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do i = 1, n_inact_orb ! First inactive
|
do i = 1, n_inact_orb ! First inactive
|
||||||
iorb = list_inact(i)
|
iorb = list_inact(i)
|
||||||
@ -547,7 +547,7 @@ subroutine give_2h1p_new(matrix_2h1p)
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
call get_excitation_degree_vector_mono(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector_mono(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
do ispin = 1, 2 ! spin of the couple a-a^dagger (i,r)
|
do ispin = 1, 2 ! spin of the couple a-a^dagger (i,r)
|
||||||
do jspin = 1, 2 ! spin of the couple z-a^dagger (j,a)
|
do jspin = 1, 2 ! spin of the couple z-a^dagger (j,a)
|
||||||
@ -555,8 +555,8 @@ subroutine give_2h1p_new(matrix_2h1p)
|
|||||||
do a = 1, n_act_orb ! First active
|
do a = 1, n_act_orb ! First active
|
||||||
aorb = list_act(a)
|
aorb = list_act(a)
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation inactive -- > virtual
|
! Do the excitation inactive -- > virtual
|
||||||
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
call clear_bit_to_integer(iorb,det_tmp(1,ispin),N_int) ! hole in "iorb" of spin Ispin
|
||||||
@ -566,7 +566,7 @@ subroutine give_2h1p_new(matrix_2h1p)
|
|||||||
call clear_bit_to_integer(jorb,det_tmp(1,jspin),N_int) ! hole in "jorb" of spin Jspin
|
call clear_bit_to_integer(jorb,det_tmp(1,jspin),N_int) ! hole in "jorb" of spin Jspin
|
||||||
call set_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! particle in "aorb" of spin Jspin
|
call set_bit_to_integer(aorb,det_tmp(1,jspin),N_int) ! particle in "aorb" of spin Jspin
|
||||||
|
|
||||||
! Check if the excitation is possible or not on psi_det(idet)
|
! Check if the excitation is possible or not on psi_ref(idet)
|
||||||
accu_elec= 0
|
accu_elec= 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
accu_elec+= popcnt(det_tmp(inint,jspin))
|
accu_elec+= popcnt(det_tmp(inint,jspin))
|
||||||
@ -580,7 +580,7 @@ subroutine give_2h1p_new(matrix_2h1p)
|
|||||||
perturb_dets(inint,1,a,jspin,ispin) = det_tmp(inint,1)
|
perturb_dets(inint,1,a,jspin,ispin) = det_tmp(inint,1)
|
||||||
perturb_dets(inint,2,a,jspin,ispin) = det_tmp(inint,2)
|
perturb_dets(inint,2,a,jspin,ispin) = det_tmp(inint,2)
|
||||||
enddo
|
enddo
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
perturb_dets_phase(a,jspin,ispin) = phase
|
perturb_dets_phase(a,jspin,ispin) = phase
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
delta_e(a,jspin,istate) = one_creat(a,jspin,istate) + delta_e_inactive_virt(istate)
|
delta_e(a,jspin,istate) = one_creat(a,jspin,istate) + delta_e_inactive_virt(istate)
|
||||||
@ -602,7 +602,7 @@ subroutine give_2h1p_new(matrix_2h1p)
|
|||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | a_{b} a^{\dagger}_a | Idet>
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | a_{b} a^{\dagger}_a | Idet>
|
||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
if(degree(jdet)==1)then
|
if(degree(jdet)==1)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
i_part = list_act_reverse(exc(1,2,1)) ! a^{\dagger}_{aorb}
|
i_part = list_act_reverse(exc(1,2,1)) ! a^{\dagger}_{aorb}
|
||||||
@ -658,7 +658,7 @@ subroutine give_2h1p_new(matrix_2h1p)
|
|||||||
! you determine the interaction between the excited determinant and the other parent | Jdet >
|
! you determine the interaction between the excited determinant and the other parent | Jdet >
|
||||||
! | det_tmp > = a^{\dagger}_{rorb,ispin} a^{\dagger}_{borb,kspin} a_{jorb,kspin} a_{iorb,ispin} | Jdet >
|
! | det_tmp > = a^{\dagger}_{rorb,ispin} a^{\dagger}_{borb,kspin} a_{jorb,kspin} a_{iorb,ispin} | Jdet >
|
||||||
! hja = < det_tmp | H | Jdet >
|
! hja = < det_tmp | H | Jdet >
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp,exc,phase,N_int)
|
||||||
if(kspin == ispin)then
|
if(kspin == ispin)then
|
||||||
hja = phase * (active_int(borb,1) - active_int(borb,2) )
|
hja = phase * (active_int(borb,1) - active_int(borb,2) )
|
||||||
else
|
else
|
||||||
@ -698,7 +698,7 @@ subroutine give_2h1p_new(matrix_2h1p)
|
|||||||
hab = fock_operator_local(borb,aorb,kspin) * phase
|
hab = fock_operator_local(borb,aorb,kspin) * phase
|
||||||
if(dabs(hab).le.1.d-10)cycle
|
if(dabs(hab).le.1.d-10)cycle
|
||||||
|
|
||||||
call get_double_excitation(psi_det(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idx(jdet)),det_tmp_bis,exc,phase,N_int)
|
||||||
if(jspin == ispin)then
|
if(jspin == ispin)then
|
||||||
hjb = phase * (active_int(corb,1) - active_int(corb,2) )
|
hjb = phase * (active_int(corb,1) - active_int(corb,2) )
|
||||||
else
|
else
|
||||||
|
@ -50,8 +50,8 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
|
|
||||||
elec_num_tab_local = 0
|
elec_num_tab_local = 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
elec_num_tab_local(1) += popcnt(psi_det(inint,1,1))
|
elec_num_tab_local(1) += popcnt(psi_ref(inint,1,1))
|
||||||
elec_num_tab_local(2) += popcnt(psi_det(inint,2,1))
|
elec_num_tab_local(2) += popcnt(psi_ref(inint,2,1))
|
||||||
enddo
|
enddo
|
||||||
do v = 1, n_virt_orb ! First virtual
|
do v = 1, n_virt_orb ! First virtual
|
||||||
vorb = list_virt(v)
|
vorb = list_virt(v)
|
||||||
@ -82,8 +82,8 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
- fock_virt_total_spin_trace(vorb,istate)
|
- fock_virt_total_spin_trace(vorb,istate)
|
||||||
enddo
|
enddo
|
||||||
do idet = 1, N_det
|
do idet = 1, N_det
|
||||||
! call get_excitation_degree_vector_mono(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
! call get_excitation_degree_vector_mono(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
call get_excitation_degree_vector(psi_det,psi_det(1,1,idet),degree,N_int,N_det,idx)
|
call get_excitation_degree_vector(psi_ref,psi_ref(1,1,idet),degree,N_int,N_det,idx)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Precomputation of matrix elements
|
||||||
do ispin = 1, 2 ! spin of the couple a-a^dagger (aorb,rorb)
|
do ispin = 1, 2 ! spin of the couple a-a^dagger (aorb,rorb)
|
||||||
do jspin = 1, 2 ! spin of the couple a-a^dagger (borb,vorb)
|
do jspin = 1, 2 ! spin of the couple a-a^dagger (borb,vorb)
|
||||||
@ -108,8 +108,8 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
cycle ! condition not to double count
|
cycle ! condition not to double count
|
||||||
endif
|
endif
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
det_tmp(inint,1) = psi_det(inint,1,idet)
|
det_tmp(inint,1) = psi_ref(inint,1,idet)
|
||||||
det_tmp(inint,2) = psi_det(inint,2,idet)
|
det_tmp(inint,2) = psi_ref(inint,2,idet)
|
||||||
enddo
|
enddo
|
||||||
! Do the excitation (aorb,ispin) --> (rorb,ispin)
|
! Do the excitation (aorb,ispin) --> (rorb,ispin)
|
||||||
call clear_bit_to_integer(aorb,det_tmp(1,ispin),N_int) ! hole in "aorb" of spin Ispin
|
call clear_bit_to_integer(aorb,det_tmp(1,ispin),N_int) ! hole in "aorb" of spin Ispin
|
||||||
@ -119,7 +119,7 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
call clear_bit_to_integer(borb,det_tmp(1,jspin),N_int) ! hole in "borb" of spin Jspin
|
call clear_bit_to_integer(borb,det_tmp(1,jspin),N_int) ! hole in "borb" of spin Jspin
|
||||||
call set_bit_to_integer(vorb,det_tmp(1,jspin),N_int) ! particle in "vorb" of spin Jspin
|
call set_bit_to_integer(vorb,det_tmp(1,jspin),N_int) ! particle in "vorb" of spin Jspin
|
||||||
|
|
||||||
! Check if the excitation is possible or not on psi_det(idet)
|
! Check if the excitation is possible or not on psi_ref(idet)
|
||||||
accu_elec= 0
|
accu_elec= 0
|
||||||
do inint = 1, N_int
|
do inint = 1, N_int
|
||||||
accu_elec+= popcnt(det_tmp(inint,1)) + popcnt(det_tmp(inint,2))
|
accu_elec+= popcnt(det_tmp(inint,1)) + popcnt(det_tmp(inint,2))
|
||||||
@ -134,7 +134,7 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
perturb_dets(inint,2,a,b,ispin,jspin) = det_tmp(inint,2)
|
perturb_dets(inint,2,a,b,ispin,jspin) = det_tmp(inint,2)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
call get_double_excitation(psi_det(1,1,idet),det_tmp,exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),det_tmp,exc,phase,N_int)
|
||||||
perturb_dets_phase(a,b,ispin,jspin) = phase
|
perturb_dets_phase(a,b,ispin,jspin) = phase
|
||||||
|
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
@ -146,16 +146,16 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
else
|
else
|
||||||
perturb_dets_hij(a,b,ispin,jspin) = phase * active_int(a,b,1)
|
perturb_dets_hij(a,b,ispin,jspin) = phase * active_int(a,b,1)
|
||||||
endif
|
endif
|
||||||
call i_H_j(psi_det(1,1,idet),det_tmp,N_int,hij)
|
call i_H_j(psi_ref(1,1,idet),det_tmp,N_int,hij)
|
||||||
if(hij.ne.perturb_dets_hij(a,b,ispin,jspin))then
|
if(hij.ne.perturb_dets_hij(a,b,ispin,jspin))then
|
||||||
print*, active_int(a,b,1) , active_int(b,a,1)
|
print*, active_int(a,b,1) , active_int(b,a,1)
|
||||||
double precision :: hmono,hdouble
|
double precision :: hmono,hdouble
|
||||||
call i_H_j_verbose(psi_det(1,1,idet),det_tmp,N_int,hij,hmono,hdouble)
|
call i_H_j_verbose(psi_ref(1,1,idet),det_tmp,N_int,hij,hmono,hdouble)
|
||||||
print*, 'pb !! hij.ne.perturb_dets_hij(a,b,ispin,jspin)'
|
print*, 'pb !! hij.ne.perturb_dets_hij(a,b,ispin,jspin)'
|
||||||
print*, ispin,jspin
|
print*, ispin,jspin
|
||||||
print*, aorb,rorb,borb,vorb
|
print*, aorb,rorb,borb,vorb
|
||||||
print*, hij,perturb_dets_hij(a,b,ispin,jspin)
|
print*, hij,perturb_dets_hij(a,b,ispin,jspin)
|
||||||
call debug_det(psi_det(1,1,idet),N_int)
|
call debug_det(psi_ref(1,1,idet),N_int)
|
||||||
call debug_det(det_tmp,N_int)
|
call debug_det(det_tmp,N_int)
|
||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
@ -170,7 +170,7 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | K_{ab} | Idet>
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!! <Jdet | K_{ab} | Idet>
|
||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
if(degree(jdet)==1)then
|
if(degree(jdet)==1)then
|
||||||
call get_mono_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_mono_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
i_hole = list_act_reverse(exc(1,1,1)) !!! a_a
|
i_hole = list_act_reverse(exc(1,1,1)) !!! a_a
|
||||||
@ -195,7 +195,7 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
fock_operator_local(i_part,i_hole,kspin) = hij * phase ! phase less fock operator
|
fock_operator_local(i_part,i_hole,kspin) = hij * phase ! phase less fock operator
|
||||||
endif
|
endif
|
||||||
else if(degree(jdet)==2)then
|
else if(degree(jdet)==2)then
|
||||||
call get_double_excitation(psi_det(1,1,idet),psi_det(1,1,idx(jdet)),exc,phase,N_int)
|
call get_double_excitation(psi_ref(1,1,idet),psi_ref(1,1,idx(jdet)),exc,phase,N_int)
|
||||||
if (exc(0,1,1) == 1) then
|
if (exc(0,1,1) == 1) then
|
||||||
! Mono alpha
|
! Mono alpha
|
||||||
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a ALPHA
|
index_orb_act_mono(idx(jdet),1) = list_act_reverse(exc(1,1,1)) !!! a_a ALPHA
|
||||||
@ -262,7 +262,7 @@ subroutine give_2p_new(matrix_2p)
|
|||||||
do jdet = 1, idx(0)
|
do jdet = 1, idx(0)
|
||||||
! if(idx(jdet).gt.idet)cycle
|
! if(idx(jdet).gt.idet)cycle
|
||||||
do istate = 1, N_states
|
do istate = 1, N_states
|
||||||
call i_H_j(psi_det(1,1,idx(jdet)),det_tmp,N_int,hij)
|
call i_H_j(psi_ref(1,1,idx(jdet)),det_tmp,N_int,hij)
|
||||||
matrix_2p(idx(jdet),idet,istate) += hij * perturb_dets_hij(a,b,ispin,jspin) * delta_e_inv(a,b,ispin,jspin,istate)
|
matrix_2p(idx(jdet),idet,istate) += hij * perturb_dets_hij(a,b,ispin,jspin) * delta_e_inv(a,b,ispin,jspin,istate)
|
||||||
enddo
|
enddo
|
||||||
enddo ! jdet
|
enddo ! jdet
|
||||||
|
@ -226,18 +226,15 @@ subroutine pt2_moller_plesset ($arguments)
|
|||||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
delta_e = (Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)) + &
|
delta_e = (Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)) + &
|
||||||
(Fock_matrix_diag_mo(h2) - Fock_matrix_diag_mo(p2))
|
(Fock_matrix_diag_mo(h2) - Fock_matrix_diag_mo(p2))
|
||||||
delta_e = 1.d0/delta_e
|
|
||||||
! print*,'h1,p1',h1,p1
|
|
||||||
! print*,'h2,p2',h2,p2
|
|
||||||
else if (degree == 1) then
|
else if (degree == 1) then
|
||||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||||
delta_e = Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)
|
delta_e = Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)
|
||||||
delta_e = 1.d0/delta_e
|
|
||||||
else
|
else
|
||||||
delta_e = 0.d0
|
delta_e = 0.d0
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (delta_e /= 0.d0) then
|
if (dabs(delta_e) > 1.d-10) then
|
||||||
|
delta_e = 1.d0/delta_e
|
||||||
call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
|
call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
|
||||||
h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
|
h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
|
||||||
else
|
else
|
||||||
@ -246,11 +243,6 @@ subroutine pt2_moller_plesset ($arguments)
|
|||||||
endif
|
endif
|
||||||
do i =1,N_st
|
do i =1,N_st
|
||||||
H_pert_diag(i) = h
|
H_pert_diag(i) = h
|
||||||
! if(dabs(i_H_psi_array(i)).gt.1.d-8)then
|
|
||||||
! print*, i_H_psi_array(i)
|
|
||||||
! call debug_det(det_pert,N_int)
|
|
||||||
! print*, h1,p1,h2,p2,s1,s2
|
|
||||||
! endif
|
|
||||||
c_pert(i) = i_H_psi_array(i) *delta_e
|
c_pert(i) = i_H_psi_array(i) *delta_e
|
||||||
e_2_pert(i) = c_pert(i) * i_H_psi_array(i)
|
e_2_pert(i) = c_pert(i) * i_H_psi_array(i)
|
||||||
enddo
|
enddo
|
||||||
|
@ -30,7 +30,7 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
do i=1,N_det_selectors
|
do i=1,N_det_generators
|
||||||
psi_selectors_coef(i,k) = psi_coef_generators(i,k)
|
psi_selectors_coef(i,k) = psi_coef_generators(i,k)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
@ -9,6 +9,7 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
|
|||||||
integer, intent(in) :: size_energy
|
integer, intent(in) :: size_energy
|
||||||
double precision, intent(out) :: energy(size_energy)
|
double precision, intent(out) :: energy(size_energy)
|
||||||
integer :: rc
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
character*(256) :: msg
|
character*(256) :: msg
|
||||||
|
|
||||||
write(msg,*) 'put_psi ', worker_id, N_states, N_det, psi_det_size, n_det_generators, n_det_selectors
|
write(msg,*) 'put_psi ', worker_id, N_states, N_det, psi_det_size, n_det_generators, n_det_selectors
|
||||||
@ -19,15 +20,15 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
|
|||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,ZMQ_SNDMORE)
|
||||||
if (rc /= N_int*2*N_det*bit_kind) then
|
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,ZMQ_SNDMORE)
|
||||||
if (rc /= psi_det_size*N_states*8) then
|
if (rc8 /= psi_det_size*N_states*8_8) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)'
|
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -59,6 +60,7 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
|
|||||||
integer, intent(in) :: size_energy
|
integer, intent(in) :: size_energy
|
||||||
double precision, intent(out) :: energy(size_energy)
|
double precision, intent(out) :: energy(size_energy)
|
||||||
integer :: rc
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
character*(64) :: msg
|
character*(64) :: msg
|
||||||
|
|
||||||
write(msg,*) 'get_psi ', worker_id
|
write(msg,*) 'get_psi ', worker_id
|
||||||
@ -78,33 +80,30 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
|
|||||||
|
|
||||||
integer :: N_states_read, N_det_read, psi_det_size_read
|
integer :: N_states_read, N_det_read, psi_det_size_read
|
||||||
integer :: N_det_selectors_read, N_det_generators_read
|
integer :: N_det_selectors_read, N_det_generators_read
|
||||||
read(msg(14:rc),*) rc, N_states_read, N_det_read, psi_det_size_read, &
|
read(msg(14:rc),*) N_states_read, N_det_read, psi_det_size_read, &
|
||||||
N_det_generators_read, N_det_selectors_read
|
N_det_generators_read, N_det_selectors_read
|
||||||
if (rc /= worker_id) then
|
|
||||||
print *, 'Wrong worker ID'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
N_states = N_states_read
|
N_states = N_states_read
|
||||||
N_det = N_det_read
|
N_det = N_det_read
|
||||||
psi_det_size = psi_det_size_read
|
psi_det_size = psi_det_size_read
|
||||||
|
TOUCH psi_det_size N_det N_states
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,0)
|
||||||
if (rc /= N_int*2*N_det*bit_kind) then
|
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
||||||
print *, 'f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
print *, 'f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,0)
|
||||||
if (rc /= psi_det_size*N_states*8) then
|
if (rc8 /= psi_det_size*N_states*8_8) then
|
||||||
print *, '77_zmq_recv(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)'
|
print *, '77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
TOUCH psi_det_size N_det N_states psi_det psi_coef
|
TOUCH psi_det psi_coef
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,energy,size_energy*8,0)
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,energy,size_energy*8,0)
|
||||||
if (rc /= size_energy*8) then
|
if (rc /= size_energy*8) then
|
||||||
print *, 'f77_zmq_recv(zmq_to_qp_run_socket,energy,size_energy*8,0)'
|
print *, '77_zmq_recv(zmq_to_qp_run_socket,energy,size_energy*8,0)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
@ -9,6 +9,7 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
|
|||||||
integer, intent(in) :: size_energy
|
integer, intent(in) :: size_energy
|
||||||
double precision, intent(out) :: energy(size_energy)
|
double precision, intent(out) :: energy(size_energy)
|
||||||
integer :: rc
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
character*(256) :: msg
|
character*(256) :: msg
|
||||||
|
|
||||||
write(msg,*) 'put_psi ', worker_id, N_states, N_det, psi_det_size, n_det_generators, n_det_selectors
|
write(msg,*) 'put_psi ', worker_id, N_states, N_det, psi_det_size, n_det_generators, n_det_selectors
|
||||||
@ -19,15 +20,15 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
|
|||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,ZMQ_SNDMORE)
|
||||||
if (rc /= N_int*2*N_det*bit_kind) then
|
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,ZMQ_SNDMORE)
|
||||||
if (rc /= psi_det_size*N_states*8) then
|
if (rc8 /= psi_det_size*N_states*8_8) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)'
|
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -59,6 +60,7 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
|
|||||||
integer, intent(in) :: size_energy
|
integer, intent(in) :: size_energy
|
||||||
double precision, intent(out) :: energy(size_energy)
|
double precision, intent(out) :: energy(size_energy)
|
||||||
integer :: rc
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
character*(64) :: msg
|
character*(64) :: msg
|
||||||
|
|
||||||
write(msg,*) 'get_psi ', worker_id
|
write(msg,*) 'get_psi ', worker_id
|
||||||
@ -78,27 +80,23 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
|
|||||||
|
|
||||||
integer :: N_states_read, N_det_read, psi_det_size_read
|
integer :: N_states_read, N_det_read, psi_det_size_read
|
||||||
integer :: N_det_selectors_read, N_det_generators_read
|
integer :: N_det_selectors_read, N_det_generators_read
|
||||||
read(msg(14:rc),*) rc, N_states_read, N_det_read, psi_det_size_read, &
|
read(msg(14:rc),*) N_states_read, N_det_read, psi_det_size_read, &
|
||||||
N_det_generators_read, N_det_selectors_read
|
N_det_generators_read, N_det_selectors_read
|
||||||
if (rc /= worker_id) then
|
|
||||||
print *, 'Wrong worker ID'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
N_states = N_states_read
|
N_states = N_states_read
|
||||||
N_det = N_det_read
|
N_det = N_det_read
|
||||||
psi_det_size = psi_det_size_read
|
psi_det_size = psi_det_size_read
|
||||||
TOUCH psi_det_size N_det N_states
|
TOUCH psi_det_size N_det N_states
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,0)
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
|
||||||
if (rc /= N_int*2*N_det*bit_kind) then
|
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
||||||
print *, 'f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
print *, 'f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,0)
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0)
|
||||||
if (rc /= psi_det_size*N_states*8) then
|
if (rc8 /= psi_det_size*N_states*8_8) then
|
||||||
print *, '77_zmq_recv(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)'
|
print *, '77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
TOUCH psi_det psi_coef
|
TOUCH psi_det psi_coef
|
||||||
|
@ -98,19 +98,18 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
|
|||||||
integer :: mobiles(2), smallerlist
|
integer :: mobiles(2), smallerlist
|
||||||
logical, external :: detEq, is_generable
|
logical, external :: detEq, is_generable
|
||||||
!double precision, external :: get_dij, get_dij_index
|
!double precision, external :: get_dij, get_dij_index
|
||||||
|
double precision :: Delta_E_inv(N_states)
|
||||||
|
|
||||||
|
if (perturbative_triples) then
|
||||||
|
PROVIDE one_anhil fock_virt_total fock_core_inactive_total one_creat
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
leng = max(N_det_generators, N_det_non_ref)
|
leng = max(N_det_generators, N_det_non_ref)
|
||||||
allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref), sij_cache(N_det_non_ref))
|
allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref), sij_cache(N_det_non_ref))
|
||||||
allocate(idx_alpha(0:psi_det_size), degree_alpha(psi_det_size))
|
allocate(idx_alpha(0:psi_det_size), degree_alpha(psi_det_size))
|
||||||
!create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint)
|
|
||||||
call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint)
|
call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint)
|
||||||
|
|
||||||
! if(fullMatch) then
|
|
||||||
! return
|
|
||||||
! end if
|
|
||||||
|
|
||||||
allocate(ptr_microlist(0:mo_tot_num*2+1), &
|
allocate(ptr_microlist(0:mo_tot_num*2+1), &
|
||||||
N_microlist(0:mo_tot_num*2) )
|
N_microlist(0:mo_tot_num*2) )
|
||||||
allocate( microlist(Nint,2,N_minilist*4), &
|
allocate( microlist(Nint,2,N_minilist*4), &
|
||||||
@ -138,7 +137,7 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
|
|||||||
if(N_minilist == 0) return
|
if(N_minilist == 0) return
|
||||||
|
|
||||||
|
|
||||||
if(key_mask(1,1) /= 0) then !!!!!!!!!!! PAS GENERAL !!!!!!!!!
|
if(sum(abs(key_mask(1:N_int,1))) /= 0) then
|
||||||
allocate(microlist_zero(Nint,2,N_minilist), idx_microlist_zero(N_minilist))
|
allocate(microlist_zero(Nint,2,N_minilist), idx_microlist_zero(N_minilist))
|
||||||
|
|
||||||
allocate( microlist(Nint,2,N_minilist*4), &
|
allocate( microlist(Nint,2,N_minilist*4), &
|
||||||
@ -191,14 +190,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
|
|||||||
end do
|
end do
|
||||||
end if
|
end if
|
||||||
|
|
||||||
if (perturbative_triples) then
|
|
||||||
double precision :: Delta_E_inv(N_states)
|
|
||||||
double precision, external :: diag_H_mat_elem
|
|
||||||
do i_state=1,N_states
|
|
||||||
Delta_E_inv(i_state) = 1.d0 / (psi_ref_energy_diagonalized(i_state) - diag_H_mat_elem(tq(1,1,i_alpha),N_int) )
|
|
||||||
enddo
|
|
||||||
endif
|
|
||||||
|
|
||||||
do l_sd=1,idx_alpha(0)
|
do l_sd=1,idx_alpha(0)
|
||||||
k_sd = idx_alpha(l_sd)
|
k_sd = idx_alpha(l_sd)
|
||||||
call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hij_cache(k_sd))
|
call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hij_cache(k_sd))
|
||||||
@ -236,9 +227,6 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
|
|||||||
enddo
|
enddo
|
||||||
logical :: ok
|
logical :: ok
|
||||||
call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, Nint)
|
call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, Nint)
|
||||||
if (perturbative_triples) then
|
|
||||||
ok = ok .and. ( (degree2 /= 1).and.(degree /=1) )
|
|
||||||
endif
|
|
||||||
|
|
||||||
do i_state=1,N_states
|
do i_state=1,N_states
|
||||||
dIK(i_state) = dij(i_I, idx_alpha(k_sd), i_state)
|
dIK(i_state) = dij(i_I, idx_alpha(k_sd), i_state)
|
||||||
@ -262,11 +250,30 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
else if (perturbative_triples) then
|
else if (perturbative_triples) then
|
||||||
|
! Linked
|
||||||
|
|
||||||
hka = hij_cache(idx_alpha(k_sd))
|
hka = hij_cache(idx_alpha(k_sd))
|
||||||
do i_state=1,N_states
|
if (dabs(hka) > 1.d-12) then
|
||||||
dka(i_state) = hka * Delta_E_inv(i_state)
|
call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv)
|
||||||
enddo
|
|
||||||
|
do i_state=1,N_states
|
||||||
|
ASSERT (Delta_E_inv(i_state) < 0.d0)
|
||||||
|
dka(i_state) = hka / Delta_E_inv(i_state)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (perturbative_triples.and. (degree2 == 1) ) then
|
||||||
|
call i_h_j(psi_ref(1,1,i_I),tmp_det,Nint,hka)
|
||||||
|
hka = hij_cache(idx_alpha(k_sd)) - hka
|
||||||
|
if (dabs(hka) > 1.d-12) then
|
||||||
|
call get_delta_e_dyall_general_mp(psi_ref(1,1,i_I),tq(1,1,i_alpha),Delta_E_inv)
|
||||||
|
do i_state=1,N_states
|
||||||
|
ASSERT (Delta_E_inv(i_state) < 0.d0)
|
||||||
|
dka(i_state) = hka / Delta_E_inv(i_state)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
@ -47,6 +47,9 @@ subroutine run(N_st,energy)
|
|||||||
enddo
|
enddo
|
||||||
call diagonalize_ci_dressed(lambda)
|
call diagonalize_ci_dressed(lambda)
|
||||||
E_new = sum(ci_energy_dressed(1:N_states))
|
E_new = sum(ci_energy_dressed(1:N_states))
|
||||||
|
! if (.true.) then
|
||||||
|
! provide delta_ij_mrcc_pouet
|
||||||
|
! endif
|
||||||
delta_E = (E_new - E_old)/dble(N_states)
|
delta_E = (E_new - E_old)/dble(N_states)
|
||||||
print *, ''
|
print *, ''
|
||||||
call write_double(6,thresh_mrcc,"thresh_mrcc")
|
call write_double(6,thresh_mrcc,"thresh_mrcc")
|
||||||
|
@ -1,4 +1,7 @@
|
|||||||
program read_integrals
|
program read_integrals
|
||||||
|
|
||||||
|
PROVIDE ezfio_filename
|
||||||
|
call ezfio_set_integrals_monoelec_disk_access_mo_one_integrals("None")
|
||||||
call run
|
call run
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -18,9 +21,10 @@ subroutine run
|
|||||||
real(integral_kind), allocatable :: buffer_values(:)
|
real(integral_kind), allocatable :: buffer_values(:)
|
||||||
integer(key_kind) :: key
|
integer(key_kind) :: key
|
||||||
|
|
||||||
call ezfio_set_mo_basis_mo_tot_num(mo_tot_num)
|
call ezfio_get_mo_basis_mo_tot_num(mo_tot_num)
|
||||||
|
|
||||||
allocate (A(mo_tot_num_align,mo_tot_num))
|
allocate (A(mo_tot_num_align,mo_tot_num))
|
||||||
|
A = 0.d0
|
||||||
|
|
||||||
iunit = getunitandopen('kinetic_mo','r')
|
iunit = getunitandopen('kinetic_mo','r')
|
||||||
do
|
do
|
||||||
@ -41,6 +45,10 @@ subroutine run
|
|||||||
close(iunit)
|
close(iunit)
|
||||||
call write_one_e_integrals('mo_ne_integral', A, size(A,1), size(A,2))
|
call write_one_e_integrals('mo_ne_integral', A, size(A,1), size(A,2))
|
||||||
|
|
||||||
|
call write_one_e_integrals('mo_pseudo_integral', mo_pseudo_integral,&
|
||||||
|
size(mo_pseudo_integral,1), size(mo_pseudo_integral,2))
|
||||||
|
|
||||||
|
|
||||||
call ezfio_set_integrals_monoelec_disk_access_mo_one_integrals("Read")
|
call ezfio_set_integrals_monoelec_disk_access_mo_one_integrals("Read")
|
||||||
|
|
||||||
allocate(buffer_i(mo_tot_num**4), buffer_values(mo_tot_num**4))
|
allocate(buffer_i(mo_tot_num**4), buffer_values(mo_tot_num**4))
|
||||||
@ -56,7 +64,7 @@ subroutine run
|
|||||||
13 continue
|
13 continue
|
||||||
close(iunit)
|
close(iunit)
|
||||||
|
|
||||||
call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_values, 0.d0)
|
call insert_into_mo_integrals_map(n_integrals,buffer_i,buffer_values,0.d0)
|
||||||
|
|
||||||
call map_sort(mo_integrals_map)
|
call map_sort(mo_integrals_map)
|
||||||
|
|
||||||
|
@ -183,6 +183,8 @@ def get_type_dict():
|
|||||||
str_ocaml_type,
|
str_ocaml_type,
|
||||||
str_fortran_type)
|
str_fortran_type)
|
||||||
|
|
||||||
|
fancy_type["MO_class"] = Type("MO_class", "MO_class", "character*(32)")
|
||||||
|
|
||||||
# ~#~#~#~#~#~#~#~ #
|
# ~#~#~#~#~#~#~#~ #
|
||||||
# F i n a l i z e #
|
# F i n a l i z e #
|
||||||
# ~#~#~#~#~#~#~#~ #
|
# ~#~#~#~#~#~#~#~ #
|
||||||
|
@ -3,7 +3,7 @@
|
|||||||
convert output of gamess/GAU$$IAN to ezfio
|
convert output of gamess/GAU$$IAN to ezfio
|
||||||
|
|
||||||
Usage:
|
Usage:
|
||||||
qp_convert_output_to_ezfio.py <file.out> [--ezfio=<folder.ezfio>]
|
qp_convert_output_to_ezfio.py <file.out> [--ezfio=<ezfio_directory>]
|
||||||
|
|
||||||
Option:
|
Option:
|
||||||
file.out is the file to check (like gamess.out)
|
file.out is the file to check (like gamess.out)
|
||||||
@ -20,18 +20,17 @@ from functools import reduce
|
|||||||
# Add to the path #
|
# Add to the path #
|
||||||
# ~#~#~#~#~#~#~#~ #
|
# ~#~#~#~#~#~#~#~ #
|
||||||
|
|
||||||
|
|
||||||
try:
|
try:
|
||||||
QP_ROOT = os.environ["QP_ROOT"]
|
QP_ROOT = os.environ["QP_ROOT"]
|
||||||
except:
|
except:
|
||||||
print "Error: QP_ROOT environment variable not found."
|
print "Error: QP_ROOT environment variable not found."
|
||||||
sys.exit(1)
|
sys.exit(1)
|
||||||
else:
|
else:
|
||||||
|
|
||||||
sys.path = [ QP_ROOT + "/install/EZFIO/Python",
|
sys.path = [ QP_ROOT + "/install/EZFIO/Python",
|
||||||
QP_ROOT + "/resultsFile",
|
QP_ROOT + "/resultsFile",
|
||||||
QP_ROOT + "/scripts"] + sys.path
|
QP_ROOT + "/scripts"] + sys.path
|
||||||
|
|
||||||
|
|
||||||
# ~#~#~#~#~#~ #
|
# ~#~#~#~#~#~ #
|
||||||
# I m p o r t #
|
# I m p o r t #
|
||||||
# ~#~#~#~#~#~ #
|
# ~#~#~#~#~#~ #
|
||||||
@ -280,12 +279,13 @@ def write_ezfio(res, filename):
|
|||||||
# {% for coef,n,zeta for l_param}
|
# {% for coef,n,zeta for l_param}
|
||||||
# {coef,n, zeta}
|
# {coef,n, zeta}
|
||||||
|
|
||||||
|
|
||||||
# OUTPUT
|
# OUTPUT
|
||||||
|
|
||||||
# Local are 1 array padded by max(n_max_block) when l == 0 (output:k_loc_max)
|
# Local are 1 array padded by max(n_max_block) when l == 0 (output:k_loc_max)
|
||||||
# v_k[n-2][atom] = value
|
# v_k[n-2][atom] = value
|
||||||
|
|
||||||
#No Local are 2 array padded with max of lmax_block when l!=0 (output:lmax+1) and max(n_max_block)whem l !=0 (kmax)
|
#Non Local are 2 array padded with max of lmax_block when l!=0 (output:lmax+1) and max(n_max_block)whem l !=0 (kmax)
|
||||||
# v_kl[l][n-2][atom] = value
|
# v_kl[l][n-2][atom] = value
|
||||||
|
|
||||||
def pad(array, size, value=0):
|
def pad(array, size, value=0):
|
||||||
@ -309,8 +309,16 @@ def write_ezfio(res, filename):
|
|||||||
array_l_max_block.append(l_max_block)
|
array_l_max_block.append(l_max_block)
|
||||||
array_z_remove.append(z_remove)
|
array_z_remove.append(z_remove)
|
||||||
|
|
||||||
matrix.append([[coef_n_zeta.split()[1:] for coef_n_zeta in l.split('\n')] for l in array_party[1:]])
|
x = [[ filter(None,coef_n_zeta.split()) for coef_n_zeta in l.split('\n')] \
|
||||||
|
for l in array_party[1:] ]
|
||||||
|
# x = []
|
||||||
|
# for l in array_party[1:]:
|
||||||
|
# y = []
|
||||||
|
# for coef_n_zeta in l.split('\n'):
|
||||||
|
# z = coef_n_zeta.split()
|
||||||
|
# if z : y.append(z)
|
||||||
|
# x.append(y)
|
||||||
|
# matrix.append(x)
|
||||||
return (matrix, array_l_max_block, array_z_remove)
|
return (matrix, array_l_max_block, array_z_remove)
|
||||||
|
|
||||||
def get_local_stuff(matrix):
|
def get_local_stuff(matrix):
|
||||||
@ -319,7 +327,6 @@ def write_ezfio(res, filename):
|
|||||||
k_loc_max = max(len(i) for i in matrix_local_unpad)
|
k_loc_max = max(len(i) for i in matrix_local_unpad)
|
||||||
|
|
||||||
matrix_local = [ pad(ll, k_loc_max, [0., 2, 0.]) for ll in matrix_local_unpad]
|
matrix_local = [ pad(ll, k_loc_max, [0., 2, 0.]) for ll in matrix_local_unpad]
|
||||||
|
|
||||||
m_coef = [[float(i[0]) for i in atom] for atom in matrix_local]
|
m_coef = [[float(i[0]) for i in atom] for atom in matrix_local]
|
||||||
m_n = [[int(i[1]) - 2 for i in atom] for atom in matrix_local]
|
m_n = [[int(i[1]) - 2 for i in atom] for atom in matrix_local]
|
||||||
m_zeta = [[float(i[2]) for i in atom] for atom in matrix_local]
|
m_zeta = [[float(i[2]) for i in atom] for atom in matrix_local]
|
||||||
@ -343,9 +350,21 @@ def write_ezfio(res, filename):
|
|||||||
return (l_max_block, k_max, m_coef_noloc, m_n_noloc, m_zeta_noloc)
|
return (l_max_block, k_max, m_coef_noloc, m_n_noloc, m_zeta_noloc)
|
||||||
|
|
||||||
try:
|
try:
|
||||||
pseudo_str = res_file.get_pseudo()
|
pseudo_str = []
|
||||||
matrix, array_l_max_block, array_z_remove = parse_str(pseudo_str)
|
label = ezfio.get_nuclei_nucl_label()
|
||||||
|
for ecp in res.pseudo:
|
||||||
|
pseudo_str += [ "%(label)s GEN %(zcore)d %(lmax)d" % { "label": label[ ecp["atom"]-1 ],
|
||||||
|
"zcore": ecp["zcore"], "lmax": ecp["lmax"] } ]
|
||||||
|
lmax = ecp["lmax"]
|
||||||
|
for l in [lmax] + list(range(0,lmax)):
|
||||||
|
pseudo_str += [ "%d"%len(ecp[str(l)]) ]
|
||||||
|
for t in ecp[str(l)]:
|
||||||
|
pseudo_str += [ "%f %d %f"%t ]
|
||||||
|
pseudo_str += [""]
|
||||||
|
pseudo_str = "\n".join(pseudo_str)
|
||||||
|
|
||||||
|
matrix, array_l_max_block, array_z_remove = parse_str(pseudo_str)
|
||||||
|
array_z_remove = map(float,array_z_remove)
|
||||||
except:
|
except:
|
||||||
ezfio.set_pseudo_do_pseudo(False)
|
ezfio.set_pseudo_do_pseudo(False)
|
||||||
else:
|
else:
|
||||||
@ -355,14 +374,18 @@ def write_ezfio(res, filename):
|
|||||||
# Z _ e f f , a l p h a / b e t a _ e l e c #
|
# Z _ e f f , a l p h a / b e t a _ e l e c #
|
||||||
# ~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~ #
|
# ~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~ #
|
||||||
|
|
||||||
ezfio.pseudo_charge_remove = array_z_remove
|
ezfio.set_pseudo_nucl_charge_remove(array_z_remove)
|
||||||
ezfio.nuclei_nucl_charge = [i - j for i, j in zip(ezfio.nuclei_nucl_charge, array_z_remove)]
|
charge = ezfio.get_nuclei_nucl_charge()
|
||||||
|
charge = [ i - j for i, j in zip(charge, array_z_remove) ]
|
||||||
|
ezfio.set_nuclei_nucl_charge (charge)
|
||||||
|
|
||||||
import math
|
import math
|
||||||
num_elec = sum(ezfio.nuclei_nucl_charge)
|
num_elec_diff = sum(array_z_remove)/2
|
||||||
|
nalpha = ezfio.get_electrons_elec_alpha_num() - num_elec_diff
|
||||||
|
nbeta = ezfio.get_electrons_elec_beta_num() - num_elec_diff
|
||||||
|
|
||||||
ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.))
|
ezfio.set_electrons_elec_alpha_num(nalpha)
|
||||||
ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.))
|
ezfio.set_electrons_elec_beta_num( nbeta )
|
||||||
|
|
||||||
# Change all the array 'cause EZFIO
|
# Change all the array 'cause EZFIO
|
||||||
# v_kl (v, l) => v_kl(l,v)
|
# v_kl (v, l) => v_kl(l,v)
|
||||||
@ -421,3 +444,12 @@ if __name__ == '__main__':
|
|||||||
print file_, 'recognized as', str(res_file).split('.')[-1].split()[0]
|
print file_, 'recognized as', str(res_file).split('.')[-1].split()[0]
|
||||||
|
|
||||||
write_ezfio(res_file, ezfio_file)
|
write_ezfio(res_file, ezfio_file)
|
||||||
|
if os.system("qp_run save_ortho_mos "+ezfio_file) != 0:
|
||||||
|
print """Warning: You need to run
|
||||||
|
|
||||||
|
qp_run save_ortho_mos """+ezfio_file+"""
|
||||||
|
|
||||||
|
to be sure your MOs will be orthogonal, which is not the case when
|
||||||
|
the MOs are read from output files (not enough precision in output)."""
|
||||||
|
|
||||||
|
|
||||||
|
@ -71,6 +71,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
! -----------------------
|
! -----------------------
|
||||||
|
|
||||||
integer :: rc
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
integer :: N_states_read, N_det_read, psi_det_size_read
|
integer :: N_states_read, N_det_read, psi_det_size_read
|
||||||
integer :: N_det_selectors_read, N_det_generators_read
|
integer :: N_det_selectors_read, N_det_generators_read
|
||||||
double precision :: energy(N_st)
|
double precision :: energy(N_st)
|
||||||
@ -90,14 +91,9 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
read(msg(14:rc),*) rc, N_states_read, N_det_read, psi_det_size_read, &
|
read(msg(14:rc),*) N_states_read, N_det_read, psi_det_size_read, &
|
||||||
N_det_generators_read, N_det_selectors_read
|
N_det_generators_read, N_det_selectors_read
|
||||||
|
|
||||||
if (rc /= worker_id) then
|
|
||||||
print *, 'Wrong worker ID'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
if (N_states_read /= N_st) then
|
if (N_states_read /= N_st) then
|
||||||
print *, N_st
|
print *, N_st
|
||||||
stop 'error : N_st'
|
stop 'error : N_st'
|
||||||
@ -110,16 +106,16 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
|
|
||||||
allocate(u_t(N_st,N_det_read))
|
allocate(u_t(N_st,N_det_read))
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det_read*bit_kind,0)
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det_read*bit_kind,0)
|
||||||
if (rc /= N_int*2*N_det_read*bit_kind) then
|
if (rc8 /= N_int*2_8*N_det_read*bit_kind) then
|
||||||
print *, 'f77_zmq_recv(zmq_to_qp_run_socket,psi_det,N_int*2*N_det_read*bit_kind,0)'
|
print *, 'f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det_read*bit_kind,0)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,u_t,size(u_t)*8,0)
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,u_t,size(u_t)*8_8,0)
|
||||||
if (rc /= size(u_t)*8) then
|
if (rc8 /= size(u_t)*8_8) then
|
||||||
print *, rc, size(u_t)*8
|
print *, rc, size(u_t)*8
|
||||||
print *, 'f77_zmq_recv(zmq_to_qp_run_socket,u_t,size(u_t)*8,0)'
|
print *, 'f77_zmq_recv8(zmq_to_qp_run_socket,u_t,size(u_t)*8_8,0)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -159,6 +155,7 @@ subroutine davidson_push_results(zmq_socket_push, v_t, s_t, imin, imax, task_id)
|
|||||||
double precision ,intent(in) :: v_t(N_states_diag,N_det)
|
double precision ,intent(in) :: v_t(N_states_diag,N_det)
|
||||||
double precision ,intent(in) :: s_t(N_states_diag,N_det)
|
double precision ,intent(in) :: s_t(N_states_diag,N_det)
|
||||||
integer :: rc, sz
|
integer :: rc, sz
|
||||||
|
integer*8 :: rc8
|
||||||
|
|
||||||
sz = (imax-imin+1)*N_states_diag
|
sz = (imax-imin+1)*N_states_diag
|
||||||
|
|
||||||
@ -171,11 +168,11 @@ subroutine davidson_push_results(zmq_socket_push, v_t, s_t, imin, imax, task_id)
|
|||||||
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
||||||
if(rc /= 4) stop "davidson_push_results failed to push imax"
|
if(rc /= 4) stop "davidson_push_results failed to push imax"
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, v_t(1,imin), 8*sz, ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz, ZMQ_SNDMORE)
|
||||||
if(rc /= 8*sz) stop "davidson_push_results failed to push vt"
|
if(rc8 /= 8_8*sz) stop "davidson_push_results failed to push vt"
|
||||||
|
|
||||||
rc = f77_zmq_send( zmq_socket_push, s_t(1,imin), 8*sz, 0)
|
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz, 0)
|
||||||
if(rc /= 8*sz) stop "davidson_push_results failed to push st"
|
if(rc8 /= 8_8*sz) stop "davidson_push_results failed to push st"
|
||||||
|
|
||||||
! Activate is zmq_socket_push is a REQ
|
! Activate is zmq_socket_push is a REQ
|
||||||
IRP_IF ZMQ_PUSH
|
IRP_IF ZMQ_PUSH
|
||||||
@ -202,6 +199,7 @@ subroutine davidson_pull_results(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
|||||||
double precision ,intent(out) :: s_t(N_states_diag,N_det)
|
double precision ,intent(out) :: s_t(N_states_diag,N_det)
|
||||||
|
|
||||||
integer :: rc, sz
|
integer :: rc, sz
|
||||||
|
integer*8 :: rc8
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
|
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
|
||||||
if(rc /= 4) stop "davidson_pull_results failed to pull task_id"
|
if(rc /= 4) stop "davidson_pull_results failed to pull task_id"
|
||||||
@ -214,11 +212,11 @@ subroutine davidson_pull_results(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
|||||||
|
|
||||||
sz = (imax-imin+1)*N_states_diag
|
sz = (imax-imin+1)*N_states_diag
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, v_t(1,imin), 8*sz, 0)
|
rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz, 0)
|
||||||
if(rc /= 8*sz) stop "davidson_pull_results failed to pull v_t"
|
if(rc8 /= 8*sz) stop "davidson_pull_results failed to pull v_t"
|
||||||
|
|
||||||
rc = f77_zmq_recv( zmq_socket_pull, s_t(1,imin), 8*sz, 0)
|
rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz, 0)
|
||||||
if(rc /= 8*sz) stop "davidson_pull_results failed to pull s_t"
|
if(rc8 /= 8*sz) stop "davidson_pull_results failed to pull s_t"
|
||||||
|
|
||||||
! Activate if zmq_socket_pull is a REP
|
! Activate if zmq_socket_pull is a REP
|
||||||
IRP_IF ZMQ_PUSH
|
IRP_IF ZMQ_PUSH
|
||||||
@ -322,6 +320,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
|||||||
|
|
||||||
character*(512) :: task
|
character*(512) :: task
|
||||||
integer :: rc
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
double precision :: energy(N_st)
|
double precision :: energy(N_st)
|
||||||
energy = 0.d0
|
energy = 0.d0
|
||||||
|
|
||||||
@ -329,25 +328,25 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
|||||||
write(task,*) 'put_psi ', 1, N_st, N_det, N_det
|
write(task,*) 'put_psi ', 1, N_st, N_det, N_det
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(task),len(trim(task)),ZMQ_SNDMORE)
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(task),len(trim(task)),ZMQ_SNDMORE)
|
||||||
if (rc /= len(trim(task))) then
|
if (rc /= len(trim(task))) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,trim(task),len(trim(task)),ZMQ_SNDMORE)'
|
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,trim(task),len(trim(task)),ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,ZMQ_SNDMORE)
|
||||||
if (rc /= N_int*2*N_det*bit_kind) then
|
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,u_t,size(u_t)*8,ZMQ_SNDMORE)
|
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,u_t,size(u_t)*8_8,ZMQ_SNDMORE)
|
||||||
if (rc /= size(u_t)*8) then
|
if (rc8 /= size(u_t)*8_8) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,u_t,size(u_t)*8,ZMQ_SNDMORE)'
|
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,u_t,int(size(u_t)*8,8),ZMQ_SNDMORE)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,energy,N_st*8,0)
|
rc = f77_zmq_send(zmq_to_qp_run_socket,energy,N_st*8,0)
|
||||||
if (rc /= N_st*8) then
|
if (rc /= N_st*8) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,energy,size_energy*8,0)'
|
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,energy,int(size_energy*8,8),0)'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -415,3 +414,18 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
|||||||
enddo
|
enddo
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, nthreads_davidson ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of threads for Davdison
|
||||||
|
END_DOC
|
||||||
|
nthreads_davidson = nproc
|
||||||
|
character*(32) :: env
|
||||||
|
call getenv('NTHREADS_DAVIDSON',env)
|
||||||
|
if (trim(env) /= '') then
|
||||||
|
read(env,*) nthreads_davidson
|
||||||
|
endif
|
||||||
|
call write_int(6,nthreads_davidson,'Number of threads for Diagonalization')
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -139,7 +139,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
|
|||||||
write(iunit,'(A)') trim(write_buffer)
|
write(iunit,'(A)') trim(write_buffer)
|
||||||
write_buffer = ' Iter'
|
write_buffer = ' Iter'
|
||||||
do i=1,N_st
|
do i=1,N_st
|
||||||
write_buffer = trim(write_buffer)//' Energy S^2 Residual '
|
write_buffer = trim(write_buffer)//' Energy S^2 Residual '
|
||||||
enddo
|
enddo
|
||||||
write(iunit,'(A)') trim(write_buffer)
|
write(iunit,'(A)') trim(write_buffer)
|
||||||
write_buffer = '===== '
|
write_buffer = '===== '
|
||||||
|
@ -40,7 +40,7 @@ END_PROVIDER
|
|||||||
double precision, allocatable :: e_array(:)
|
double precision, allocatable :: e_array(:)
|
||||||
integer, allocatable :: iorder(:)
|
integer, allocatable :: iorder(:)
|
||||||
|
|
||||||
PROVIDE threshold_davidson
|
PROVIDE threshold_davidson nthreads_davidson
|
||||||
! Guess values for the "N_states" states of the CI_eigenvectors
|
! Guess values for the "N_states" states of the CI_eigenvectors
|
||||||
do j=1,min(N_states,N_det)
|
do j=1,min(N_states,N_det)
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
|
@ -134,8 +134,8 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_t,s_t,u_t,N_st,sze,istart,iend,
|
|||||||
! Prepare the array of all alpha single excitations
|
! Prepare the array of all alpha single excitations
|
||||||
! -------------------------------------------------
|
! -------------------------------------------------
|
||||||
|
|
||||||
PROVIDE N_int
|
PROVIDE N_int nthreads_davidson
|
||||||
!$OMP PARALLEL DEFAULT(NONE) &
|
!$OMP PARALLEL DEFAULT(NONE) NUM_THREADS(nthreads_davidson) &
|
||||||
!$OMP SHARED(psi_bilinear_matrix_rows, N_det, &
|
!$OMP SHARED(psi_bilinear_matrix_rows, N_det, &
|
||||||
!$OMP psi_bilinear_matrix_columns, &
|
!$OMP psi_bilinear_matrix_columns, &
|
||||||
!$OMP psi_det_alpha_unique, psi_det_beta_unique, &
|
!$OMP psi_det_alpha_unique, psi_det_beta_unique, &
|
||||||
|
@ -76,7 +76,8 @@ subroutine resize_H_apply_buffer(new_size,iproc)
|
|||||||
allocate ( buffer_det(N_int,2,new_size), &
|
allocate ( buffer_det(N_int,2,new_size), &
|
||||||
buffer_coef(new_size,N_states), &
|
buffer_coef(new_size,N_states), &
|
||||||
buffer_e2(new_size,N_states) )
|
buffer_e2(new_size,N_states) )
|
||||||
|
buffer_coef = 0.d0
|
||||||
|
buffer_e2 = 0.d0
|
||||||
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
buffer_det(k,1,i) = H_apply_buffer(iproc)%det(k,1,i)
|
buffer_det(k,1,i) = H_apply_buffer(iproc)%det(k,1,i)
|
||||||
|
@ -15,6 +15,57 @@
|
|||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, one_body_dm_mo_spin_index, (mo_tot_num_align,mo_tot_num,N_states,2) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,ispin,istate
|
||||||
|
ispin = 1
|
||||||
|
do istate = 1, N_states
|
||||||
|
do j = 1, mo_tot_num
|
||||||
|
do i = 1, mo_tot_num
|
||||||
|
one_body_dm_mo_spin_index(i,j,istate,ispin) = one_body_dm_mo_alpha(i,j,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
ispin = 2
|
||||||
|
do istate = 1, N_states
|
||||||
|
do j = 1, mo_tot_num
|
||||||
|
do i = 1, mo_tot_num
|
||||||
|
one_body_dm_mo_spin_index(i,j,istate,ispin) = one_body_dm_mo_beta(i,j,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, one_body_dm_dagger_mo_spin_index, (mo_tot_num_align,mo_tot_num,N_states,2) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,ispin,istate
|
||||||
|
ispin = 1
|
||||||
|
do istate = 1, N_states
|
||||||
|
do j = 1, mo_tot_num
|
||||||
|
one_body_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_body_dm_mo_alpha(j,j,istate)
|
||||||
|
do i = j+1, mo_tot_num
|
||||||
|
one_body_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_body_dm_mo_alpha(i,j,istate)
|
||||||
|
one_body_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_body_dm_mo_alpha(i,j,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
ispin = 2
|
||||||
|
do istate = 1, N_states
|
||||||
|
do j = 1, mo_tot_num
|
||||||
|
one_body_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_body_dm_mo_beta(j,j,istate)
|
||||||
|
do i = j+1, mo_tot_num
|
||||||
|
one_body_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_body_dm_mo_beta(i,j,istate)
|
||||||
|
one_body_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_body_dm_mo_beta(i,j,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha, (mo_tot_num_align,mo_tot_num,N_states) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha, (mo_tot_num_align,mo_tot_num,N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta, (mo_tot_num_align,mo_tot_num,N_states) ]
|
&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta, (mo_tot_num_align,mo_tot_num,N_states) ]
|
||||||
implicit none
|
implicit none
|
||||||
@ -285,6 +336,8 @@ END_PROVIDER
|
|||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_dm_ao_alpha, (ao_num_align,ao_num) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_ao_alpha, (ao_num_align,ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_dm_ao_beta, (ao_num_align,ao_num) ]
|
&BEGIN_PROVIDER [ double precision, one_body_dm_ao_beta, (ao_num_align,ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, one_body_dm_ao_alpha_no_align, (ao_num,ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, one_body_dm_ao_beta_no_align, (ao_num,ao_num) ]
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! one body density matrix on the AO basis : rho_AO(alpha) , rho_AO(beta)
|
! one body density matrix on the AO basis : rho_AO(alpha) , rho_AO(beta)
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -303,11 +356,16 @@ END_PROVIDER
|
|||||||
! if(dabs(dm_mo).le.1.d-10)cycle
|
! if(dabs(dm_mo).le.1.d-10)cycle
|
||||||
one_body_dm_ao_alpha(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_alpha
|
one_body_dm_ao_alpha(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_alpha
|
||||||
one_body_dm_ao_beta(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_beta
|
one_body_dm_ao_beta(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_beta
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
do i = 1, ao_num
|
||||||
|
do j = 1, ao_num
|
||||||
|
one_body_dm_ao_alpha_no_align(j,i) = one_body_dm_ao_alpha(j,i)
|
||||||
|
one_body_dm_ao_beta_no_align(j,i) = one_body_dm_ao_beta(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -1977,7 +1977,7 @@ subroutine ac_operator(iorb,ispin,key,hjj,Nint,na,nb)
|
|||||||
!DIR$ FORCEINLINE
|
!DIR$ FORCEINLINE
|
||||||
call bitstring_to_list_ab(key, occ, tmp, Nint)
|
call bitstring_to_list_ab(key, occ, tmp, Nint)
|
||||||
ASSERT (tmp(1) == elec_alpha_num)
|
ASSERT (tmp(1) == elec_alpha_num)
|
||||||
ASSERT (tmp(2) == elec_alpha_num)
|
ASSERT (tmp(2) == elec_beta_num)
|
||||||
|
|
||||||
k = ishft(iorb-1,-bit_kind_shift)+1
|
k = ishft(iorb-1,-bit_kind_shift)+1
|
||||||
ASSERT (k >0)
|
ASSERT (k >0)
|
||||||
|
@ -294,7 +294,7 @@ BEGIN_PROVIDER [ type(map_type), mo_integrals_map ]
|
|||||||
call bielec_integrals_index(mo_tot_num,mo_tot_num,mo_tot_num,mo_tot_num,key_max)
|
call bielec_integrals_index(mo_tot_num,mo_tot_num,mo_tot_num,mo_tot_num,key_max)
|
||||||
sze = key_max
|
sze = key_max
|
||||||
call map_init(mo_integrals_map,sze)
|
call map_init(mo_integrals_map,sze)
|
||||||
print*, 'MO map initialized'
|
print*, 'MO map initialized: ', sze
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
subroutine insert_into_ao_integrals_map(n_integrals,buffer_i, buffer_values)
|
subroutine insert_into_ao_integrals_map(n_integrals,buffer_i, buffer_values)
|
||||||
|
@ -6,7 +6,9 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_coef, (ao_num_align,ao_num)]
|
|||||||
! ao_ortho_lowdin_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_lowdin orbital
|
! ao_ortho_lowdin_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_lowdin orbital
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
double precision :: tmp_matrix(ao_num_align,ao_num),accu
|
double precision :: accu
|
||||||
|
double precision, allocatable :: tmp_matrix(:,:)
|
||||||
|
allocate (tmp_matrix(ao_num_align,ao_num))
|
||||||
tmp_matrix(:,:) = 0.d0
|
tmp_matrix(:,:) = 0.d0
|
||||||
do j=1, ao_num
|
do j=1, ao_num
|
||||||
tmp_matrix(j,j) = 1.d0
|
tmp_matrix(j,j) = 1.d0
|
||||||
@ -17,6 +19,7 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_coef, (ao_num_align,ao_num)]
|
|||||||
ao_ortho_lowdin_coef(j,i) = tmp_matrix(i,j)
|
ao_ortho_lowdin_coef(j,i) = tmp_matrix(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
deallocate(tmp_matrix)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_ortho_lowdin_overlap, (ao_num_align,ao_num)]
|
BEGIN_PROVIDER [double precision, ao_ortho_lowdin_overlap, (ao_num_align,ao_num)]
|
||||||
|
@ -21,8 +21,8 @@ interface: ezfio
|
|||||||
size: (mo_basis.mo_tot_num)
|
size: (mo_basis.mo_tot_num)
|
||||||
|
|
||||||
[mo_class]
|
[mo_class]
|
||||||
type: character*(32)
|
type: MO_class
|
||||||
doc: c: core, i: inactive, a: active, v: virtual, d: deleted
|
doc: Core|Inactive|Active|Virtual|Deleted
|
||||||
interface: ezfio, provider
|
interface: ezfio, provider
|
||||||
size: (mo_basis.mo_tot_num)
|
size: (mo_basis.mo_tot_num)
|
||||||
|
|
||||||
|
@ -82,6 +82,15 @@ END_PROVIDER
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef_inv, (ao_num,ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! ao_ortho_canonical_coef^(-1)
|
||||||
|
END_DOC
|
||||||
|
call get_pseudo_inverse(ao_ortho_canonical_coef,ao_num,ao_num, &
|
||||||
|
ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef, (ao_num_align,ao_num)]
|
BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef, (ao_num_align,ao_num)]
|
||||||
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num ]
|
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num ]
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -68,6 +68,18 @@ END_PROVIDER
|
|||||||
endif
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_coef_in_ao_ortho_basis, (ao_num_align, mo_tot_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! MO coefficients in orthogonalized AO basis
|
||||||
|
END_DOC
|
||||||
|
call dgemm('T','N',ao_num,mo_tot_num,ao_num,1.d0, &
|
||||||
|
ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef_inv,1),&
|
||||||
|
mo_coef, size(mo_coef,1), 0.d0, &
|
||||||
|
mo_coef_in_ao_ortho_basis, size(mo_coef_in_ao_ortho_basis,1))
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ character*(64), mo_label ]
|
BEGIN_PROVIDER [ character*(64), mo_label ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -139,8 +151,6 @@ BEGIN_PROVIDER [ double precision, mo_occ, (mo_tot_num) ]
|
|||||||
endif
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine ao_to_mo(A_ao,LDA_ao,A_mo,LDA_mo)
|
subroutine ao_to_mo(A_ao,LDA_ao,A_mo,LDA_mo)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -259,3 +269,62 @@ subroutine mix_mo_jk(j,k)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
subroutine ao_ortho_cano_to_ao(A_ao,LDA_ao,A,LDA)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the AO basis to the orthogonal AO basis
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA
|
||||||
|
double precision, intent(in) :: A_ao(LDA_ao,*)
|
||||||
|
double precision, intent(out) :: A(LDA,*)
|
||||||
|
double precision, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(ao_num_align,ao_num) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
|
||||||
|
call dgemm('T','N', ao_num, ao_num, ao_num, &
|
||||||
|
1.d0, &
|
||||||
|
ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef_inv,1), &
|
||||||
|
A_ao,LDA_ao, &
|
||||||
|
0.d0, T, ao_num_align)
|
||||||
|
|
||||||
|
call dgemm('N','N', ao_num, ao_num, ao_num, 1.d0, &
|
||||||
|
T, size(T,1), &
|
||||||
|
ao_ortho_canonical_coef_inv,size(ao_ortho_canonical_coef_inv,1),&
|
||||||
|
0.d0, A, LDA)
|
||||||
|
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine mo_to_ao_ortho_cano(A_mo,LDA_mo,A_ao,LDA_ao)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the AO orthogonal basis to the AO basis
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
double precision, intent(in) :: A_mo(LDA_mo)
|
||||||
|
double precision, intent(out) :: A_ao(LDA_ao)
|
||||||
|
double precision, allocatable :: T(:,:), SC(:,:)
|
||||||
|
|
||||||
|
allocate ( SC(ao_num_align,mo_tot_num) )
|
||||||
|
allocate ( T(mo_tot_num_align,ao_num) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
|
||||||
|
call dgemm('N','N', ao_num, mo_tot_num, ao_num, &
|
||||||
|
1.d0, ao_overlap,size(ao_overlap,1), &
|
||||||
|
ao_ortho_canonical_coef, size(ao_ortho_canonical_coef,1), &
|
||||||
|
0.d0, SC, ao_num_align)
|
||||||
|
|
||||||
|
call dgemm('N','T', mo_tot_num, ao_num, mo_tot_num, &
|
||||||
|
1.d0, A_mo,LDA_mo, &
|
||||||
|
SC, size(SC,1), &
|
||||||
|
0.d0, T, mo_tot_num_align)
|
||||||
|
|
||||||
|
call dgemm('N','N', ao_num, ao_num, mo_tot_num, &
|
||||||
|
1.d0, SC,size(SC,1), &
|
||||||
|
T, mo_tot_num_align, &
|
||||||
|
0.d0, A_ao, LDA_ao)
|
||||||
|
|
||||||
|
deallocate(T,SC)
|
||||||
|
end
|
||||||
|
|
||||||
|
@ -72,6 +72,8 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m)
|
|||||||
double precision, allocatable :: S_half(:,:)
|
double precision, allocatable :: S_half(:,:)
|
||||||
!DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D
|
!DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D
|
||||||
integer :: info, i, j
|
integer :: info, i, j
|
||||||
|
!call ortho_lowdin(overlap,LDA,N,C,LDC,m)
|
||||||
|
!return
|
||||||
|
|
||||||
if (n < 2) then
|
if (n < 2) then
|
||||||
return
|
return
|
||||||
@ -200,7 +202,7 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m)
|
|||||||
!
|
!
|
||||||
! LDC : leftmost dimension of C
|
! LDC : leftmost dimension of C
|
||||||
!
|
!
|
||||||
! m : Coefficients matrix is MxN, ( array is (LDC,N) )
|
! M : Coefficients matrix is MxN, ( array is (LDC,N) )
|
||||||
!
|
!
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
@ -211,7 +213,6 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m)
|
|||||||
double precision, allocatable :: Vt(:,:)
|
double precision, allocatable :: Vt(:,:)
|
||||||
double precision, allocatable :: D(:)
|
double precision, allocatable :: D(:)
|
||||||
double precision, allocatable :: S_half(:,:)
|
double precision, allocatable :: S_half(:,:)
|
||||||
!DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D
|
|
||||||
integer :: info, i, j, k
|
integer :: info, i, j, k
|
||||||
|
|
||||||
if (n < 2) then
|
if (n < 2) then
|
||||||
@ -298,12 +299,12 @@ subroutine get_pseudo_inverse(A,m,n,C,LDA)
|
|||||||
allocate(work(lwork))
|
allocate(work(lwork))
|
||||||
call dgesvd('S','A', m, n, A_tmp, m,D,U,m,Vt,n,work,lwork,info)
|
call dgesvd('S','A', m, n, A_tmp, m,D,U,m,Vt,n,work,lwork,info)
|
||||||
if (info /= 0) then
|
if (info /= 0) then
|
||||||
print *, info, ': SVD failed'
|
print *, info, ':: SVD failed'
|
||||||
stop 1
|
stop 1
|
||||||
endif
|
endif
|
||||||
|
|
||||||
do i=1,n
|
do i=1,n
|
||||||
if (abs(D(i)) > 1.d-6) then
|
if (dabs(D(i)) > 1.d-6) then
|
||||||
D(i) = 1.d0/D(i)
|
D(i) = 1.d0/D(i)
|
||||||
else
|
else
|
||||||
D(i) = 0.d0
|
D(i) = 0.d0
|
||||||
|
@ -14,7 +14,7 @@ function run_HF() {
|
|||||||
test_exe SCF || skip
|
test_exe SCF || skip
|
||||||
qp_edit -c $1
|
qp_edit -c $1
|
||||||
ezfio set_file $1
|
ezfio set_file $1
|
||||||
ezfio set hartree_fock thresh_scf 1.e-11
|
ezfio set hartree_fock thresh_scf 1.e-8
|
||||||
qp_run SCF $1
|
qp_run SCF $1
|
||||||
energy="$(ezfio get hartree_fock energy)"
|
energy="$(ezfio get hartree_fock energy)"
|
||||||
eq $energy $2 $thresh
|
eq $energy $2 $thresh
|
||||||
|
Loading…
Reference in New Issue
Block a user