mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 20:23:40 +02:00
Merge branch 'dev-stable' of https://github.com/AbdAmmar/qp2 into dev-stable
Conflicts: scripts/qp_extract_cipsi_data.py
This commit is contained in:
commit
30649c50af
1
.github/workflows/compilation.yml
vendored
1
.github/workflows/compilation.yml
vendored
@ -48,6 +48,7 @@ jobs:
|
|||||||
./configure -i docopt || :
|
./configure -i docopt || :
|
||||||
./configure -i resultsFile || :
|
./configure -i resultsFile || :
|
||||||
./configure -i bats || :
|
./configure -i bats || :
|
||||||
|
./configure -i trexio-nohdf5 || :
|
||||||
./configure -c ./config/gfortran_debug.cfg
|
./configure -c ./config/gfortran_debug.cfg
|
||||||
- name: Compilation
|
- name: Compilation
|
||||||
run: |
|
run: |
|
||||||
|
8
.github/workflows/configuration.yml
vendored
8
.github/workflows/configuration.yml
vendored
@ -22,7 +22,7 @@ jobs:
|
|||||||
- uses: actions/checkout@v3
|
- uses: actions/checkout@v3
|
||||||
- name: Install dependencies
|
- name: Install dependencies
|
||||||
run: |
|
run: |
|
||||||
sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config
|
sudo apt install gfortran gcc liblapack-dev libblas-dev wget python3 make m4 pkg-config hdf5
|
||||||
- name: zlib
|
- name: zlib
|
||||||
run: |
|
run: |
|
||||||
./configure -i zlib || echo OK
|
./configure -i zlib || echo OK
|
||||||
@ -50,6 +50,12 @@ jobs:
|
|||||||
- name: bats
|
- name: bats
|
||||||
run: |
|
run: |
|
||||||
./configure -i bats || echo OK
|
./configure -i bats || echo OK
|
||||||
|
- name: trexio-nohdf5
|
||||||
|
run: |
|
||||||
|
./configure -i trexio-nohdf5 || echo OK
|
||||||
|
- name: trexio
|
||||||
|
run: |
|
||||||
|
./configure -i trexio || echo OK
|
||||||
- name: Final check
|
- name: Final check
|
||||||
run: |
|
run: |
|
||||||
./configure -c config/gfortran_debug.cfg
|
./configure -c config/gfortran_debug.cfg
|
||||||
|
@ -46,7 +46,7 @@ def main(arguments):
|
|||||||
append_bats(dirname, filenames)
|
append_bats(dirname, filenames)
|
||||||
else:
|
else:
|
||||||
for (dirname, _, filenames) in os.walk(os.getcwd(), followlinks=False):
|
for (dirname, _, filenames) in os.walk(os.getcwd(), followlinks=False):
|
||||||
if "IRPF90_temp" not in dirname:
|
if "IRPF90_temp" not in dirname and "external" not in dirname:
|
||||||
append_bats(dirname, filenames)
|
append_bats(dirname, filenames)
|
||||||
l_bats = [y for _, y in sorted(l_bats)]
|
l_bats = [y for _, y in sorted(l_bats)]
|
||||||
|
|
||||||
@ -67,6 +67,7 @@ def main(arguments):
|
|||||||
os.system(test+" python3 bats_to_sh.py "+bats_file+
|
os.system(test+" python3 bats_to_sh.py "+bats_file+
|
||||||
"| bash")
|
"| bash")
|
||||||
else:
|
else:
|
||||||
|
# print(" ".join(["bats", "--verbose-run", "--trace", bats_file]))
|
||||||
subprocess.check_call(["bats", "--verbose-run", "--trace", bats_file], env=os.environ)
|
subprocess.check_call(["bats", "--verbose-run", "--trace", bats_file], env=os.environ)
|
||||||
|
|
||||||
|
|
||||||
|
37
configure
vendored
37
configure
vendored
@ -9,6 +9,8 @@ echo "QP_ROOT="$QP_ROOT
|
|||||||
unset CC
|
unset CC
|
||||||
unset CCXX
|
unset CCXX
|
||||||
|
|
||||||
|
TREXIO_VERSION=2.3.2
|
||||||
|
|
||||||
# Force GCC instead of ICC for dependencies
|
# Force GCC instead of ICC for dependencies
|
||||||
export CC=gcc
|
export CC=gcc
|
||||||
|
|
||||||
@ -189,7 +191,7 @@ if [[ "${PACKAGES}.x" != ".x" ]] ; then
|
|||||||
fi
|
fi
|
||||||
|
|
||||||
if [[ ${PACKAGES} = all ]] ; then
|
if [[ ${PACKAGES} = all ]] ; then
|
||||||
PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats"
|
PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats trexio"
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
||||||
@ -203,6 +205,33 @@ for PACKAGE in ${PACKAGES} ; do
|
|||||||
mv ninja "\${QP_ROOT}"/bin/
|
mv ninja "\${QP_ROOT}"/bin/
|
||||||
EOF
|
EOF
|
||||||
|
|
||||||
|
elif [[ ${PACKAGE} = trexio-nohdf5 ]] ; then
|
||||||
|
|
||||||
|
VERSION=$TREXIO_VERSION
|
||||||
|
execute << EOF
|
||||||
|
cd "\${QP_ROOT}"/external
|
||||||
|
wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
|
||||||
|
tar -zxf trexio-${VERSION}.tar.gz
|
||||||
|
cd trexio-${VERSION}
|
||||||
|
./configure --prefix=\${QP_ROOT} --without-hdf5
|
||||||
|
make -j 8 && make -j 8 check && make -j 8 install
|
||||||
|
cp ${QP_ROOT}/include/trexio_f.f90 ${QP_ROOT}/src/ezfio_files
|
||||||
|
tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/${ARCHITECTURE}/ninja.tar.gz
|
||||||
|
mv ninja "\${QP_ROOT}"/bin/
|
||||||
|
EOF
|
||||||
|
elif [[ ${PACKAGE} = trexio ]] ; then
|
||||||
|
|
||||||
|
VERSION=$TREXIO_VERSION
|
||||||
|
execute << EOF
|
||||||
|
cd "\${QP_ROOT}"/external
|
||||||
|
wget https://github.com/TREX-CoE/trexio/releases/download/v${VERSION}/trexio-${VERSION}.tar.gz
|
||||||
|
tar -zxf trexio-${VERSION}.tar.gz
|
||||||
|
cd trexio-${VERSION}
|
||||||
|
./configure --prefix=\${QP_ROOT}
|
||||||
|
make -j 8 && make -j 8 check && make -j 8 install
|
||||||
|
cp ${QP_ROOT}/include/trexio_f.f90 ${QP_ROOT}/src/ezfio_files
|
||||||
|
EOF
|
||||||
|
|
||||||
|
|
||||||
elif [[ ${PACKAGE} = gmp ]] ; then
|
elif [[ ${PACKAGE} = gmp ]] ; then
|
||||||
|
|
||||||
@ -338,6 +367,12 @@ if [[ ${ZEROMQ} = $(not_found) ]] ; then
|
|||||||
fail
|
fail
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
TREXIO=$(find_lib -ltrexio)
|
||||||
|
if [[ ${TREXIO} = $(not_found) ]] ; then
|
||||||
|
error "TREXIO (trexio,trexio-nohdf5) is not installed. If you don't have HDF5, use trexio-nohdf5"
|
||||||
|
fail
|
||||||
|
fi
|
||||||
|
|
||||||
F77ZMQ=$(find_lib -lzmq -lf77zmq -lpthread)
|
F77ZMQ=$(find_lib -lzmq -lf77zmq -lpthread)
|
||||||
if [[ ${F77ZMQ} = $(not_found) ]] ; then
|
if [[ ${F77ZMQ} = $(not_found) ]] ; then
|
||||||
error "Fortran binding of ZeroMQ (f77zmq) is not installed."
|
error "Fortran binding of ZeroMQ (f77zmq) is not installed."
|
||||||
|
5
data/basis/none
Normal file
5
data/basis/none
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
$DATA
|
||||||
|
|
||||||
|
HYDROGEN
|
||||||
|
|
||||||
|
$END
|
12
etc/qp.rc
12
etc/qp.rc
@ -110,6 +110,11 @@ function qp()
|
|||||||
unset COMMAND
|
unset COMMAND
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
"test")
|
||||||
|
shift
|
||||||
|
qp_test $@
|
||||||
|
;;
|
||||||
|
|
||||||
*)
|
*)
|
||||||
which "qp_$1" &> /dev/null
|
which "qp_$1" &> /dev/null
|
||||||
if [[ $? -eq 0 ]] ; then
|
if [[ $? -eq 0 ]] ; then
|
||||||
@ -183,7 +188,7 @@ _qp_Complete()
|
|||||||
;;
|
;;
|
||||||
esac;;
|
esac;;
|
||||||
set_file)
|
set_file)
|
||||||
COMPREPLY=( $(compgen -W "$(for i in * ; do [[ -f ${i}/ezfio/.version ]] && echo $i ; done)" -- ${cur} ) )
|
COMPREPLY=( $(compgen -W "$(for i in */ $(find . -name ezfio | sed 's/ezfio$/.version/') ; do [[ -f $i ]] && echo ${i%/.version} ; done)" -- ${cur} ) )
|
||||||
return 0
|
return 0
|
||||||
;;
|
;;
|
||||||
plugins)
|
plugins)
|
||||||
@ -215,10 +220,15 @@ _qp_Complete()
|
|||||||
return 0
|
return 0
|
||||||
;;
|
;;
|
||||||
esac;;
|
esac;;
|
||||||
|
test)
|
||||||
|
COMPREPLY=( $(compgen -W "-v -a " -- $cur ) )
|
||||||
|
return 0
|
||||||
|
;;
|
||||||
*)
|
*)
|
||||||
COMPREPLY=( $(compgen -W 'plugins set_file \
|
COMPREPLY=( $(compgen -W 'plugins set_file \
|
||||||
unset_file man \
|
unset_file man \
|
||||||
create_ezfio \
|
create_ezfio \
|
||||||
|
test \
|
||||||
convert_output_to_ezfio \
|
convert_output_to_ezfio \
|
||||||
-h update' -- $cur ) )
|
-h update' -- $cur ) )
|
||||||
|
|
||||||
|
@ -247,8 +247,7 @@ end = struct
|
|||||||
|
|
||||||
|
|
||||||
let read () =
|
let read () =
|
||||||
if (Ezfio.has_ao_basis_ao_basis ()) then
|
try
|
||||||
begin
|
|
||||||
let result =
|
let result =
|
||||||
{ ao_basis = read_ao_basis ();
|
{ ao_basis = read_ao_basis ();
|
||||||
ao_num = read_ao_num () ;
|
ao_num = read_ao_num () ;
|
||||||
@ -267,9 +266,8 @@ end = struct
|
|||||||
|> MD5.to_string
|
|> MD5.to_string
|
||||||
|> Ezfio.set_ao_basis_ao_md5 ;
|
|> Ezfio.set_ao_basis_ao_md5 ;
|
||||||
Some result
|
Some result
|
||||||
end
|
with
|
||||||
else
|
| _ -> (Ezfio.set_ao_basis_ao_md5 "None" ; None)
|
||||||
None
|
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
@ -478,6 +478,7 @@ let run ?o b au c d m p cart xyz_file =
|
|||||||
let nmax =
|
let nmax =
|
||||||
Nucl_number.get_max ()
|
Nucl_number.get_max ()
|
||||||
in
|
in
|
||||||
|
|
||||||
let rec do_work (accu:(Atom.t*Nucl_number.t) list) (n:int) = function
|
let rec do_work (accu:(Atom.t*Nucl_number.t) list) (n:int) = function
|
||||||
| [] -> accu
|
| [] -> accu
|
||||||
| e::tail ->
|
| e::tail ->
|
||||||
@ -520,6 +521,8 @@ let run ?o b au c d m p cart xyz_file =
|
|||||||
in
|
in
|
||||||
let long_basis = Long_basis.of_basis basis in
|
let long_basis = Long_basis.of_basis basis in
|
||||||
let ao_num = List.length long_basis in
|
let ao_num = List.length long_basis in
|
||||||
|
if ao_num > 0 then
|
||||||
|
begin
|
||||||
Ezfio.set_ao_basis_ao_num ao_num;
|
Ezfio.set_ao_basis_ao_num ao_num;
|
||||||
Ezfio.set_ao_basis_ao_basis b;
|
Ezfio.set_ao_basis_ao_basis b;
|
||||||
Ezfio.set_basis_basis b;
|
Ezfio.set_basis_basis b;
|
||||||
@ -655,6 +658,7 @@ let run ?o b au c d m p cart xyz_file =
|
|||||||
match Input.Ao_basis.read () with
|
match Input.Ao_basis.read () with
|
||||||
| None -> failwith "Error in basis"
|
| None -> failwith "Error in basis"
|
||||||
| Some x -> Input.Ao_basis.write x
|
| Some x -> Input.Ao_basis.write x
|
||||||
|
end
|
||||||
in
|
in
|
||||||
let () =
|
let () =
|
||||||
try write_file () with
|
try write_file () with
|
||||||
@ -781,7 +785,7 @@ If a file with the same name as the basis set exists, this file will be read. O
|
|||||||
run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
|
run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename
|
||||||
)
|
)
|
||||||
with
|
with
|
||||||
| Failure txt -> Printf.eprintf "Fatal error: %s\n%!" txt
|
(* | Failure txt -> Printf.eprintf "Fatal error: %s\n%!" txt *)
|
||||||
| Command_line.Error txt -> Printf.eprintf "Command line error: %s\n%!" txt
|
| Command_line.Error txt -> Printf.eprintf "Command line error: %s\n%!" txt
|
||||||
|
|
||||||
|
|
||||||
|
@ -38,7 +38,7 @@ def comp_path(path):
|
|||||||
|
|
||||||
from qp_path import QP_ROOT, QP_SRC, QP_EZFIO
|
from qp_path import QP_ROOT, QP_SRC, QP_EZFIO
|
||||||
|
|
||||||
LIB = " -lz"
|
LIB = " -lz -ltrexio"
|
||||||
EZFIO_LIB = join("$QP_ROOT", "lib", "libezfio_irp.a")
|
EZFIO_LIB = join("$QP_ROOT", "lib", "libezfio_irp.a")
|
||||||
ZMQ_LIB = join("$QP_ROOT", "lib", "libf77zmq.a") + " " + join("$QP_ROOT", "lib", "libzmq.a") + " -lstdc++ -lrt -ldl"
|
ZMQ_LIB = join("$QP_ROOT", "lib", "libf77zmq.a") + " " + join("$QP_ROOT", "lib", "libzmq.a") + " -lstdc++ -lrt -ldl"
|
||||||
ROOT_BUILD_NINJA = join("$QP_ROOT", "config", "build.ninja")
|
ROOT_BUILD_NINJA = join("$QP_ROOT", "config", "build.ninja")
|
||||||
|
@ -172,11 +172,8 @@ let run check_only ?ndet ?state ezfio_filename =
|
|||||||
|
|
||||||
(* Reorder basis set *)
|
(* Reorder basis set *)
|
||||||
begin
|
begin
|
||||||
let aos =
|
|
||||||
match Input.Ao_basis.read() with
|
match Input.Ao_basis.read() with
|
||||||
| Some x -> x
|
| Some aos ->
|
||||||
| _ -> assert false
|
|
||||||
in
|
|
||||||
let ordering = Input.Ao_basis.ordering aos in
|
let ordering = Input.Ao_basis.ordering aos in
|
||||||
let test = Array.copy ordering in
|
let test = Array.copy ordering in
|
||||||
Array.sort compare test ;
|
Array.sort compare test ;
|
||||||
@ -191,6 +188,7 @@ let run check_only ?ndet ?state ezfio_filename =
|
|||||||
let new_mos = Input.Mo_basis.reorder mos ordering in
|
let new_mos = Input.Mo_basis.reorder mos ordering in
|
||||||
Input.Mo_basis.write new_mos
|
Input.Mo_basis.write new_mos
|
||||||
end
|
end
|
||||||
|
| _ -> ()
|
||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
@ -42,13 +42,15 @@ import sys, os
|
|||||||
import scipy
|
import scipy
|
||||||
import scipy.stats
|
import scipy.stats
|
||||||
from math import sqrt, gamma, exp
|
from math import sqrt, gamma, exp
|
||||||
import json
|
import qp_json
|
||||||
|
|
||||||
|
|
||||||
def read_data(filename,state):
|
def read_data(ezfio_filename,state):
|
||||||
""" Read energies and PT2 from input file """
|
""" Read energies and PT2 from input file """
|
||||||
with open(filename,'r') as f:
|
data = qp_json.load_last(ezfio_filename)
|
||||||
lines = json.load(f)['fci']
|
for method in data.keys():
|
||||||
|
x = data[method]
|
||||||
|
lines = x
|
||||||
|
|
||||||
print(f"State: {state}")
|
print(f"State: {state}")
|
||||||
|
|
||||||
@ -138,15 +140,15 @@ def compute(data):
|
|||||||
|
|
||||||
return mu, err, bias, p
|
return mu, err, bias, p
|
||||||
|
|
||||||
filename = sys.argv[1]
|
ezfio_filename = sys.argv[1]
|
||||||
print(filename)
|
print(ezfio_filename)
|
||||||
if len(sys.argv) > 2:
|
if len(sys.argv) > 2:
|
||||||
state = int(sys.argv[2])
|
state = int(sys.argv[2])
|
||||||
else:
|
else:
|
||||||
state = 1
|
state = 1
|
||||||
data = read_data(filename,state)
|
data = read_data(ezfio_filename,state)
|
||||||
mu, err, bias, _ = compute(data)
|
mu, err, bias, _ = compute(data)
|
||||||
print(" %s: %8.3f +/- %5.3f eV\n"%(filename, mu, err))
|
print(" %s: %8.3f +/- %5.3f eV\n"%(ezfio_filename, mu, err))
|
||||||
|
|
||||||
import numpy as np
|
import numpy as np
|
||||||
A = np.array( [ [ data[-1][1], 1. ],
|
A = np.array( [ [ data[-1][1], 1. ],
|
||||||
|
@ -1,57 +1,37 @@
|
|||||||
#!/usr/bin/env python3
|
#!/usr/bin/env python3
|
||||||
|
|
||||||
import re
|
import qp_json
|
||||||
import sys
|
import sys
|
||||||
|
|
||||||
# Read output file
|
if len(sys.argv) == 1:
|
||||||
with open(sys.argv[1], 'r') as file:
|
print(f"syntax: {sys.argv[0]} EZFIO_FILE")
|
||||||
output = file.read()
|
|
||||||
|
d = qp_json.load_all(sys.argv[1])
|
||||||
|
|
||||||
|
k = [ x for x in d.keys() ]
|
||||||
|
k.sort()
|
||||||
|
|
||||||
|
print("# Energy PT2 PT2_err rPT2 rPT2_err exFCI\n")
|
||||||
|
for f in k:
|
||||||
|
try:
|
||||||
|
j = d[f]["fci"]
|
||||||
|
except:
|
||||||
|
continue
|
||||||
|
|
||||||
|
print(f"# {f}")
|
||||||
|
for e in j:
|
||||||
|
|
||||||
|
out = f" {e['n_det']:8d}"
|
||||||
|
|
||||||
|
nstates = len(e["states"])
|
||||||
|
for ee in e["states"]:
|
||||||
|
try:
|
||||||
|
exc_energy = ee['ex_energy'][0]
|
||||||
|
except:
|
||||||
|
exc_energy = 0.
|
||||||
|
out += f" {ee['energy']:16.8f} {ee['pt2']:e} {ee['pt2_err']:e} {ee['rpt2']:e} {ee['rpt2_err']:e} {exc_energy:16.8f}"
|
||||||
|
print(out)
|
||||||
|
|
||||||
|
print("\n")
|
||||||
|
|
||||||
|
|
||||||
def extract_data(output):
|
|
||||||
lines = output.split("\n")
|
|
||||||
data = []
|
|
||||||
|
|
||||||
n_det = None
|
|
||||||
e = None
|
|
||||||
pt2 = None
|
|
||||||
err_pt2 = None
|
|
||||||
rpt2 = None
|
|
||||||
err_rpt2 = None
|
|
||||||
e_ex = None
|
|
||||||
|
|
||||||
|
|
||||||
reading = False
|
|
||||||
for iline, line in enumerate(lines):
|
|
||||||
if line.startswith("Summary at N_det"):
|
|
||||||
reading = False
|
|
||||||
|
|
||||||
if not reading and line.startswith(" N_det "):
|
|
||||||
n_det = int(re.search(r"N_det\s+=\s+(\d+)", line).group(1))
|
|
||||||
reading = True
|
|
||||||
|
|
||||||
if reading:
|
|
||||||
if line.startswith(" E "):
|
|
||||||
e = float(re.search(r"E\s+=\s+(-?\d+\.\d+)", line).group(1))
|
|
||||||
elif line.startswith(" PT2 "):
|
|
||||||
pt2 = float(re.search(r"PT2\s+=\s+(-?\d+\.\d+E?.\d*)", line).group(1))
|
|
||||||
err_pt2 = float(re.search(r"\+/-\s+(-?\d+\.\d+E?.\d*)", line).group(1))
|
|
||||||
elif line.startswith(" rPT2 "):
|
|
||||||
rpt2 = float(re.search(r"rPT2\s+=\s+(-?\d+\.\d+E?.\d*)", line).group(1))
|
|
||||||
err_rpt2 = float(re.search(r"\+/-\s+(-?\d+\.\d+E?.\d*)", line).group(1))
|
|
||||||
elif "minimum PT2 Extrapolated energy" in line:
|
|
||||||
e_ex_line = lines[iline+2]
|
|
||||||
e_ex = float(e_ex_line.split()[1])
|
|
||||||
reading = False
|
|
||||||
|
|
||||||
new_data = " {:8d} {:16.8f} {:e} {:e} {:e} {:e} {:16.8f}".format(n_det, e, pt2, err_pt2, rpt2, err_rpt2, e_ex)
|
|
||||||
data.append(new_data)
|
|
||||||
n_det = e = pt2 = err_pt2 = rpt2 = err_rpt2 = e_ex = None
|
|
||||||
|
|
||||||
return data
|
|
||||||
|
|
||||||
data = extract_data(output)
|
|
||||||
|
|
||||||
for item in data:
|
|
||||||
print(item)
|
|
||||||
|
|
||||||
|
66
scripts/utility/qp_json.py
Normal file
66
scripts/utility/qp_json.py
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
#!/usr/bin/env python
|
||||||
|
import os
|
||||||
|
import json
|
||||||
|
|
||||||
|
def fix_json(s):
|
||||||
|
"""Properly termitates an incomplete JSON file"""
|
||||||
|
|
||||||
|
s = s.replace(' ','')
|
||||||
|
s = s.replace('\n','')
|
||||||
|
s = s.replace('\t','')
|
||||||
|
s = s.replace(",{}",'')
|
||||||
|
tmp = [ c for c in s if c in "[]{}" ]
|
||||||
|
tmp = "".join(tmp)
|
||||||
|
tmp_old = ""
|
||||||
|
while tmp != tmp_old:
|
||||||
|
tmp_old = tmp
|
||||||
|
tmp = tmp.replace("{}","")
|
||||||
|
tmp = tmp.replace("[]","")
|
||||||
|
while s[-1] in [ ',', '\n', ' ', '\t' ]:
|
||||||
|
s = s[:-1]
|
||||||
|
tmp = [ c for c in tmp ]
|
||||||
|
tmp.reverse()
|
||||||
|
for c in tmp:
|
||||||
|
if c == '[': s += "]"
|
||||||
|
elif c == '{': s += "}"
|
||||||
|
return s
|
||||||
|
|
||||||
|
|
||||||
|
def load(filename):
|
||||||
|
"""Loads a JSON file after calling the fix_json function."""
|
||||||
|
with open(filename,'r') as f:
|
||||||
|
data = f.read()
|
||||||
|
new_data = fix_json(data)
|
||||||
|
return json.loads(new_data)
|
||||||
|
|
||||||
|
|
||||||
|
def load_all(ezfio_filename):
|
||||||
|
"""Loads all JSON files of an EZFIO."""
|
||||||
|
d = {}
|
||||||
|
prefix = ezfio_filename+'/json/'
|
||||||
|
for filename in [ x for x in os.listdir(prefix) if x.endswith(".json")]:
|
||||||
|
d[filename] = load(prefix+filename)
|
||||||
|
return d
|
||||||
|
|
||||||
|
|
||||||
|
def load_last(ezfio_filename):
|
||||||
|
"""Loads last JSON file of an EZFIO."""
|
||||||
|
d = {}
|
||||||
|
prefix = ezfio_filename+'/json/'
|
||||||
|
l = [ x for x in os.listdir(prefix) if x.endswith(".json")]
|
||||||
|
l.sort()
|
||||||
|
filename = l[-1]
|
||||||
|
print(filename)
|
||||||
|
return load(prefix+filename)
|
||||||
|
|
||||||
|
|
||||||
|
def fix(ezfio_filename):
|
||||||
|
"""Fixes all JSON files in an EZFIO."""
|
||||||
|
d = load_all(ezfio_filename)
|
||||||
|
prefix = ezfio_filename+'/json/'
|
||||||
|
for filename in d.keys():
|
||||||
|
with open(prefix+filename, 'w') as json_file:
|
||||||
|
json.dump(d[filename], json_file)
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -12,21 +12,21 @@ double precision function ao_value(i,r)
|
|||||||
integer :: power_ao(3)
|
integer :: power_ao(3)
|
||||||
double precision :: accu,dx,dy,dz,r2
|
double precision :: accu,dx,dy,dz,r2
|
||||||
num_ao = ao_nucl(i)
|
num_ao = ao_nucl(i)
|
||||||
! power_ao(1:3)= ao_power(i,1:3)
|
power_ao(1:3)= ao_power(i,1:3)
|
||||||
! center_ao(1:3) = nucl_coord(num_ao,1:3)
|
center_ao(1:3) = nucl_coord(num_ao,1:3)
|
||||||
! dx = (r(1) - center_ao(1))
|
dx = (r(1) - center_ao(1))
|
||||||
! dy = (r(2) - center_ao(2))
|
dy = (r(2) - center_ao(2))
|
||||||
! dz = (r(3) - center_ao(3))
|
dz = (r(3) - center_ao(3))
|
||||||
! r2 = dx*dx + dy*dy + dz*dz
|
r2 = dx*dx + dy*dy + dz*dz
|
||||||
! dx = dx**power_ao(1)
|
dx = dx**power_ao(1)
|
||||||
! dy = dy**power_ao(2)
|
dy = dy**power_ao(2)
|
||||||
! dz = dz**power_ao(3)
|
dz = dz**power_ao(3)
|
||||||
|
|
||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
! do m=1,ao_prim_num(i)
|
do m=1,ao_prim_num(i)
|
||||||
! beta = ao_expo_ordered_transp(m,i)
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
! accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
|
accu += ao_coef_normalized_ordered_transp(m,i) * dexp(-beta*r2)
|
||||||
! enddo
|
enddo
|
||||||
ao_value = accu * dx * dy * dz
|
ao_value = accu * dx * dy * dz
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -1,2 +1,3 @@
|
|||||||
ao_basis
|
ao_basis
|
||||||
pseudo
|
pseudo
|
||||||
|
cosgtos_ao_int
|
||||||
|
@ -1,27 +1,47 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_overlap , (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_overlap , (ao_num, ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, ao_overlap_x, (ao_num, ao_num) ]
|
&BEGIN_PROVIDER [ double precision, ao_overlap_x, (ao_num, ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, ao_overlap_y, (ao_num, ao_num) ]
|
&BEGIN_PROVIDER [ double precision, ao_overlap_y, (ao_num, ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, ao_overlap_z, (ao_num, ao_num) ]
|
&BEGIN_PROVIDER [ double precision, ao_overlap_z, (ao_num, ao_num) ]
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Overlap between atomic basis functions:
|
! Overlap between atomic basis functions:
|
||||||
!
|
!
|
||||||
! :math:`\int \chi_i(r) \chi_j(r) dr`
|
! :math:`\int \chi_i(r) \chi_j(r) dr`
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,n,l
|
|
||||||
double precision :: f
|
implicit none
|
||||||
integer :: dim1
|
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||||
double precision :: overlap, overlap_x, overlap_y, overlap_z
|
double precision :: overlap, overlap_x, overlap_y, overlap_z
|
||||||
double precision :: alpha, beta, c
|
double precision :: alpha, beta, c
|
||||||
double precision :: A_center(3), B_center(3)
|
double precision :: A_center(3), B_center(3)
|
||||||
integer :: power_A(3), power_B(3)
|
|
||||||
ao_overlap = 0.d0
|
ao_overlap = 0.d0
|
||||||
ao_overlap_x = 0.d0
|
ao_overlap_x = 0.d0
|
||||||
ao_overlap_y = 0.d0
|
ao_overlap_y = 0.d0
|
||||||
ao_overlap_z = 0.d0
|
ao_overlap_z = 0.d0
|
||||||
|
|
||||||
if(read_ao_integrals_overlap) then
|
if(read_ao_integrals_overlap) then
|
||||||
|
|
||||||
call ezfio_get_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
|
call ezfio_get_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
|
||||||
print *, 'AO overlap integrals read from disk'
|
print *, 'AO overlap integrals read from disk'
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
if(use_cosgtos) then
|
||||||
|
!print*, ' use_cosgtos for ao_overlap ?', use_cosgtos
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
ao_overlap (i,j) = ao_overlap_cosgtos (i,j)
|
||||||
|
ao_overlap_x(i,j) = ao_overlap_cosgtos_x(i,j)
|
||||||
|
ao_overlap_y(i,j) = ao_overlap_cosgtos_y(i,j)
|
||||||
|
ao_overlap_z(i,j) = ao_overlap_cosgtos_z(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
dim1=100
|
dim1=100
|
||||||
@ -69,7 +89,11 @@
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
if (write_ao_integrals_overlap) then
|
if (write_ao_integrals_overlap) then
|
||||||
call ezfio_set_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
|
call ezfio_set_ao_one_e_ints_ao_integrals_overlap(ao_overlap(1:ao_num, 1:ao_num))
|
||||||
print *, 'AO overlap integrals written to disk'
|
print *, 'AO overlap integrals written to disk'
|
||||||
@ -77,6 +101,8 @@
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -85,6 +111,8 @@ BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
|||||||
ao_overlap_imag = 0.d0
|
ao_overlap_imag = 0.d0
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -98,37 +126,39 @@ BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
|||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_overlap_abs, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_overlap_abs, (ao_num, ao_num) ]
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Overlap between absolute values of atomic basis functions:
|
! Overlap between absolute values of atomic basis functions:
|
||||||
!
|
!
|
||||||
! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
|
! :math:`\int |\chi_i(r)| |\chi_j(r)| dr`
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,n,l
|
|
||||||
double precision :: f
|
implicit none
|
||||||
integer :: dim1
|
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||||
double precision :: overlap, overlap_x, overlap_y, overlap_z
|
double precision :: overlap_x, overlap_y, overlap_z
|
||||||
double precision :: alpha, beta
|
double precision :: alpha, beta
|
||||||
double precision :: A_center(3), B_center(3)
|
double precision :: A_center(3), B_center(3)
|
||||||
integer :: power_A(3), power_B(3)
|
|
||||||
double precision :: lower_exp_val, dx
|
double precision :: lower_exp_val, dx
|
||||||
|
|
||||||
if(is_periodic) then
|
if(is_periodic) then
|
||||||
|
|
||||||
do j = 1, ao_num
|
do j = 1, ao_num
|
||||||
do i = 1, ao_num
|
do i = 1, ao_num
|
||||||
ao_overlap_abs(i,j) = cdabs(ao_overlap_complex(i,j))
|
ao_overlap_abs(i,j) = cdabs(ao_overlap_complex(i,j))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
dim1=100
|
dim1=100
|
||||||
lower_exp_val = 40.d0
|
lower_exp_val = 40.d0
|
||||||
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
||||||
!$OMP DEFAULT(NONE) &
|
!$OMP DEFAULT(NONE) &
|
||||||
!$OMP PRIVATE(A_center,B_center,power_A,power_B, &
|
!$OMP PRIVATE(A_center,B_center,power_A,power_B, &
|
||||||
!$OMP overlap_x,overlap_y, overlap_z, overlap, &
|
!$OMP overlap_x,overlap_y, overlap_z, &
|
||||||
!$OMP alpha, beta,i,j,dx) &
|
!$OMP alpha, beta,i,j,dx) &
|
||||||
!$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
|
!$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
|
||||||
!$OMP ao_overlap_abs,ao_num,ao_coef_normalized_ordered_transp,ao_nucl,&
|
!$OMP ao_overlap_abs,ao_num,ao_coef_normalized_ordered_transp,ao_nucl,&
|
||||||
@ -161,9 +191,13 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
|
BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -1,7 +1,10 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_deriv2_x, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_deriv2_x, (ao_num, ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, ao_deriv2_y, (ao_num, ao_num) ]
|
&BEGIN_PROVIDER [ double precision, ao_deriv2_y, (ao_num, ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, ao_deriv2_z, (ao_num, ao_num) ]
|
&BEGIN_PROVIDER [ double precision, ao_deriv2_z, (ao_num, ao_num) ]
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Second derivative matrix elements in the |AO| basis.
|
! Second derivative matrix elements in the |AO| basis.
|
||||||
!
|
!
|
||||||
@ -11,15 +14,28 @@
|
|||||||
! \langle \chi_i(x,y,z) | \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
|
! \langle \chi_i(x,y,z) | \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
|
||||||
!
|
!
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,n,l
|
|
||||||
double precision :: f
|
implicit none
|
||||||
integer :: dim1
|
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||||
double precision :: overlap, overlap_y, overlap_z
|
double precision :: overlap, overlap_y, overlap_z
|
||||||
double precision :: overlap_x0, overlap_y0, overlap_z0
|
double precision :: overlap_x0, overlap_y0, overlap_z0
|
||||||
double precision :: alpha, beta, c
|
double precision :: alpha, beta, c
|
||||||
double precision :: A_center(3), B_center(3)
|
double precision :: A_center(3), B_center(3)
|
||||||
integer :: power_A(3), power_B(3)
|
|
||||||
double precision :: d_a_2,d_2
|
double precision :: d_a_2,d_2
|
||||||
|
|
||||||
|
if(use_cosgtos) then
|
||||||
|
!print*, 'use_cosgtos for ao_kinetic_integrals ?', use_cosgtos
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
ao_deriv2_x(i,j) = ao_deriv2_cosgtos_x(i,j)
|
||||||
|
ao_deriv2_y(i,j) = ao_deriv2_cosgtos_y(i,j)
|
||||||
|
ao_deriv2_z(i,j) = ao_deriv2_cosgtos_z(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
dim1=100
|
dim1=100
|
||||||
|
|
||||||
! -- Dummy call to provide everything
|
! -- Dummy call to provide everything
|
||||||
@ -117,8 +133,12 @@
|
|||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
|
BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -1,3 +1,6 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine give_all_erf_kl_ao(integrals_ao,mu_in,C_center)
|
subroutine give_all_erf_kl_ao(integrals_ao,mu_in,C_center)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -15,36 +18,104 @@ subroutine give_all_erf_kl_ao(integrals_ao,mu_in,C_center)
|
|||||||
enddo
|
enddo
|
||||||
end
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
|
double precision function NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
!
|
||||||
! Computes the following integral :
|
! Computes the following integral :
|
||||||
! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
||||||
|
!
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
integer, intent(in) :: i_ao, j_ao
|
integer, intent(in) :: i_ao, j_ao
|
||||||
double precision, intent(in) :: mu_in, C_center(3)
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
|
||||||
integer :: i, j, num_A, num_B, power_A(3), power_B(3), n_pt_in
|
integer :: i, j, num_A, num_B, power_A(3), power_B(3), n_pt_in
|
||||||
double precision :: A_center(3), B_center(3), integral, alpha, beta
|
double precision :: A_center(3), B_center(3), integral, alpha, beta
|
||||||
|
|
||||||
double precision :: NAI_pol_mult_erf
|
double precision :: NAI_pol_mult_erf
|
||||||
|
|
||||||
num_A = ao_nucl(i_ao)
|
num_A = ao_nucl(i_ao)
|
||||||
power_A(1:3) = ao_power(i_ao,1:3)
|
power_A(1:3) = ao_power(i_ao,1:3)
|
||||||
A_center(1:3) = nucl_coord(num_A,1:3)
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
num_B = ao_nucl(j_ao)
|
num_B = ao_nucl(j_ao)
|
||||||
power_B(1:3) = ao_power(j_ao,1:3)
|
power_B(1:3) = ao_power(j_ao,1:3)
|
||||||
B_center(1:3) = nucl_coord(num_B,1:3)
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
|
||||||
n_pt_in = n_pt_max_integrals
|
n_pt_in = n_pt_max_integrals
|
||||||
|
|
||||||
NAI_pol_mult_erf_ao = 0.d0
|
NAI_pol_mult_erf_ao = 0.d0
|
||||||
do i = 1, ao_prim_num(i_ao)
|
do i = 1, ao_prim_num(i_ao)
|
||||||
alpha = ao_expo_ordered_transp(i,i_ao)
|
alpha = ao_expo_ordered_transp(i,i_ao)
|
||||||
do j = 1, ao_prim_num(j_ao)
|
do j = 1, ao_prim_num(j_ao)
|
||||||
beta = ao_expo_ordered_transp(j,j_ao)
|
beta = ao_expo_ordered_transp(j,j_ao)
|
||||||
|
|
||||||
integral = NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in,mu_in)
|
integral = NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in,mu_in)
|
||||||
|
|
||||||
NAI_pol_mult_erf_ao += integral * ao_coef_normalized_ordered_transp(j,j_ao) * ao_coef_normalized_ordered_transp(i,i_ao)
|
NAI_pol_mult_erf_ao += integral * ao_coef_normalized_ordered_transp(j,j_ao) * ao_coef_normalized_ordered_transp(i,i_ao)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
end
|
end function NAI_pol_mult_erf_ao
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
double precision function NAI_pol_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Computes the following integral :
|
||||||
|
! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i_ao, j_ao
|
||||||
|
double precision, intent(in) :: beta, B_center(3)
|
||||||
|
double precision, intent(in) :: mu_in, C_center(3)
|
||||||
|
|
||||||
|
integer :: i, j, power_A1(3), power_A2(3), n_pt_in
|
||||||
|
double precision :: A1_center(3), A2_center(3), alpha1, alpha2, coef12, coef1, integral
|
||||||
|
|
||||||
|
double precision, external :: NAI_pol_mult_erf_with1s, NAI_pol_mult_erf_ao
|
||||||
|
|
||||||
|
ASSERT(beta .ge. 0.d0)
|
||||||
|
if(beta .lt. 1d-10) then
|
||||||
|
NAI_pol_mult_erf_ao_with1s = NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
power_A1(1:3) = ao_power(i_ao,1:3)
|
||||||
|
power_A2(1:3) = ao_power(j_ao,1:3)
|
||||||
|
|
||||||
|
A1_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
|
||||||
|
A2_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
|
||||||
|
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
|
||||||
|
NAI_pol_mult_erf_ao_with1s = 0.d0
|
||||||
|
do i = 1, ao_prim_num(i_ao)
|
||||||
|
alpha1 = ao_expo_ordered_transp (i,i_ao)
|
||||||
|
coef1 = ao_coef_normalized_ordered_transp(i,i_ao)
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num(j_ao)
|
||||||
|
alpha2 = ao_expo_ordered_transp(j,j_ao)
|
||||||
|
coef12 = coef1 * ao_coef_normalized_ordered_transp(j,j_ao)
|
||||||
|
if(dabs(coef12) .lt. 1d-14) cycle
|
||||||
|
|
||||||
|
integral = NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
|
||||||
|
, beta, B_center, C_center, n_pt_in, mu_in )
|
||||||
|
|
||||||
|
NAI_pol_mult_erf_ao_with1s += integral * coef12
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end function NAI_pol_mult_erf_ao_with1s
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
double precision function NAI_pol_mult_erf(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in, mu_in)
|
||||||
|
|
||||||
@ -127,58 +198,221 @@ end function NAI_pol_mult_erf
|
|||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
|
subroutine NAI_pol_mult_erf_v(A_center, B_center, power_A, power_B, alpha, beta, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
|
||||||
double precision function NAI_pol_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_center)
|
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
!
|
!
|
||||||
! Computes the following integral :
|
! Computes the following integral :
|
||||||
! $\int_{-\infty}^{infty} dr \chi_i(r) \chi_j(r) e^{-\beta (r - B_center)^2} \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
||||||
|
! \frac{\erf(\mu |r - R_C |)}{| r - R_C |}$.
|
||||||
!
|
!
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer, intent(in) :: i_ao, j_ao
|
|
||||||
double precision, intent(in) :: beta, B_center(3)
|
|
||||||
double precision, intent(in) :: mu_in, C_center(3)
|
|
||||||
|
|
||||||
integer :: i, j, power_A1(3), power_A2(3), n_pt_in
|
integer, intent(in) :: n_pt_in, n_points, LD_C, LD_resv
|
||||||
double precision :: A1_center(3), A2_center(3), alpha1, alpha2, coef12, coef1, integral
|
integer, intent(in) :: power_A(3), power_B(3)
|
||||||
|
double precision, intent(in) :: A_center(3), B_center(3), alpha, beta, mu_in
|
||||||
|
double precision, intent(in) :: C_center(LD_C,3)
|
||||||
|
double precision, intent(out) :: res_v(LD_resv)
|
||||||
|
|
||||||
double precision, external :: NAI_pol_mult_erf_with1s, NAI_pol_mult_erf_ao
|
integer :: i, n_pt, n_pt_out, ipoint
|
||||||
|
double precision :: P_center(3)
|
||||||
|
double precision :: d(0:n_pt_in), coeff, dist, const, factor
|
||||||
|
double precision :: const_factor, dist_integral
|
||||||
|
double precision :: accu, p_inv, p, rho, p_inv_2
|
||||||
|
double precision :: p_new, p_new2, coef_tmp
|
||||||
|
|
||||||
ASSERT(beta .ge. 0.d0)
|
double precision :: rint
|
||||||
if(beta .lt. 1d-10) then
|
|
||||||
NAI_pol_mult_erf_ao_with1s = NAI_pol_mult_erf_ao(i_ao, j_ao, mu_in, C_center)
|
res_V(1:LD_resv) = 0.d0
|
||||||
|
|
||||||
|
p = alpha + beta
|
||||||
|
p_inv = 1.d0 / p
|
||||||
|
p_inv_2 = 0.5d0 * p_inv
|
||||||
|
rho = alpha * beta * p_inv
|
||||||
|
p_new = mu_in / dsqrt(p + mu_in * mu_in)
|
||||||
|
p_new2 = p_new * p_new
|
||||||
|
coef_tmp = p * p_new2
|
||||||
|
|
||||||
|
dist = 0.d0
|
||||||
|
do i = 1, 3
|
||||||
|
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
||||||
|
dist += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
const_factor = dist * rho
|
||||||
|
if(const_factor > 80.d0) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
factor = dexp(-const_factor)
|
||||||
|
coeff = dtwo_pi * factor * p_inv * p_new
|
||||||
|
|
||||||
|
n_pt = 2 * ( power_A(1) + power_B(1) + power_A(2) + power_B(2) + power_A(3) + power_B(3) )
|
||||||
|
|
||||||
|
if(n_pt == 0) then
|
||||||
|
|
||||||
|
do ipoint = 1, n_points
|
||||||
|
dist_integral = 0.d0
|
||||||
|
do i = 1, 3
|
||||||
|
dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
|
||||||
|
enddo
|
||||||
|
const = coef_tmp * dist_integral
|
||||||
|
|
||||||
|
res_v(ipoint) = coeff * rint(0, const)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
do ipoint = 1, n_points
|
||||||
|
dist_integral = 0.d0
|
||||||
|
do i = 1, 3
|
||||||
|
dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
|
||||||
|
enddo
|
||||||
|
const = coef_tmp * dist_integral
|
||||||
|
|
||||||
|
do i = 0, n_pt_in
|
||||||
|
d(i) = 0.d0
|
||||||
|
enddo
|
||||||
|
call give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center(ipoint,1:3), n_pt_in, d, n_pt_out, p_inv_2, p_new2, P_center)
|
||||||
|
|
||||||
|
if(n_pt_out < 0) then
|
||||||
|
res_v(ipoint) = 0.d0
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
||||||
|
accu = 0.d0
|
||||||
|
do i = 0, n_pt_out, 2
|
||||||
|
accu += d(i) * rint(i/2, const)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
res_v(ipoint) = accu * coeff
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine NAI_pol_mult_erf_v
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
double precision function NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
|
||||||
|
, beta, B_center, C_center, n_pt_in, mu_in )
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Computes the following integral :
|
||||||
|
!
|
||||||
|
! .. math::
|
||||||
|
!
|
||||||
|
! \int dx (x - A1_x)^a_1 (x - B1_x)^a_2 \exp(-\alpha_1 (x - A1_x)^2 - \alpha_2 (x - A2_x)^2)
|
||||||
|
! \int dy (y - A1_y)^b_1 (y - B1_y)^b_2 \exp(-\alpha_1 (y - A1_y)^2 - \alpha_2 (y - A2_y)^2)
|
||||||
|
! \int dz (x - A1_z)^c_1 (z - B1_z)^c_2 \exp(-\alpha_1 (z - A1_z)^2 - \alpha_2 (z - A2_z)^2)
|
||||||
|
! \exp(-\beta (r - B)^2)
|
||||||
|
! \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: n_pt_in
|
||||||
|
integer, intent(in) :: power_A1(3), power_A2(3)
|
||||||
|
double precision, intent(in) :: C_center(3), A1_center(3), A2_center(3), B_center(3)
|
||||||
|
double precision, intent(in) :: alpha1, alpha2, beta, mu_in
|
||||||
|
|
||||||
|
integer :: i, n_pt, n_pt_out
|
||||||
|
double precision :: alpha12, alpha12_inv, alpha12_inv_2, rho12, A12_center(3), dist12, const_factor12
|
||||||
|
double precision :: p, p_inv, p_inv_2, rho, P_center(3), dist, const_factor
|
||||||
|
double precision :: dist_integral
|
||||||
|
double precision :: d(0:n_pt_in), coeff, const, factor
|
||||||
|
double precision :: accu
|
||||||
|
double precision :: p_new
|
||||||
|
|
||||||
|
double precision :: rint
|
||||||
|
|
||||||
|
|
||||||
|
! e^{-alpha1 (r - A1)^2} e^{-alpha2 (r - A2)^2} = e^{-K12} e^{-alpha12 (r - A12)^2}
|
||||||
|
alpha12 = alpha1 + alpha2
|
||||||
|
alpha12_inv = 1.d0 / alpha12
|
||||||
|
alpha12_inv_2 = 0.5d0 * alpha12_inv
|
||||||
|
rho12 = alpha1 * alpha2 * alpha12_inv
|
||||||
|
A12_center(1) = (alpha1 * A1_center(1) + alpha2 * A2_center(1)) * alpha12_inv
|
||||||
|
A12_center(2) = (alpha1 * A1_center(2) + alpha2 * A2_center(2)) * alpha12_inv
|
||||||
|
A12_center(3) = (alpha1 * A1_center(3) + alpha2 * A2_center(3)) * alpha12_inv
|
||||||
|
dist12 = (A1_center(1) - A2_center(1)) * (A1_center(1) - A2_center(1)) &
|
||||||
|
+ (A1_center(2) - A2_center(2)) * (A1_center(2) - A2_center(2)) &
|
||||||
|
+ (A1_center(3) - A2_center(3)) * (A1_center(3) - A2_center(3))
|
||||||
|
|
||||||
|
const_factor12 = dist12 * rho12
|
||||||
|
if(const_factor12 > 80.d0) then
|
||||||
|
NAI_pol_mult_erf_with1s = 0.d0
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
power_A1(1:3) = ao_power(i_ao,1:3)
|
! ---
|
||||||
power_A2(1:3) = ao_power(j_ao,1:3)
|
|
||||||
|
|
||||||
A1_center(1:3) = nucl_coord(ao_nucl(i_ao),1:3)
|
! e^{-K12} e^{-alpha12 (r - A12)^2} e^{-beta (r - B)^2} = e^{-K} e^{-p (r - P)^2}
|
||||||
A2_center(1:3) = nucl_coord(ao_nucl(j_ao),1:3)
|
p = alpha12 + beta
|
||||||
|
p_inv = 1.d0 / p
|
||||||
|
p_inv_2 = 0.5d0 * p_inv
|
||||||
|
rho = alpha12 * beta * p_inv
|
||||||
|
P_center(1) = (alpha12 * A12_center(1) + beta * B_center(1)) * p_inv
|
||||||
|
P_center(2) = (alpha12 * A12_center(2) + beta * B_center(2)) * p_inv
|
||||||
|
P_center(3) = (alpha12 * A12_center(3) + beta * B_center(3)) * p_inv
|
||||||
|
dist = (A12_center(1) - B_center(1)) * (A12_center(1) - B_center(1)) &
|
||||||
|
+ (A12_center(2) - B_center(2)) * (A12_center(2) - B_center(2)) &
|
||||||
|
+ (A12_center(3) - B_center(3)) * (A12_center(3) - B_center(3))
|
||||||
|
|
||||||
n_pt_in = n_pt_max_integrals
|
const_factor = const_factor12 + dist * rho
|
||||||
|
if(const_factor > 80.d0) then
|
||||||
|
NAI_pol_mult_erf_with1s = 0.d0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
NAI_pol_mult_erf_ao_with1s = 0.d0
|
dist_integral = (P_center(1) - C_center(1)) * (P_center(1) - C_center(1)) &
|
||||||
do i = 1, ao_prim_num(i_ao)
|
+ (P_center(2) - C_center(2)) * (P_center(2) - C_center(2)) &
|
||||||
alpha1 = ao_expo_ordered_transp (i,i_ao)
|
+ (P_center(3) - C_center(3)) * (P_center(3) - C_center(3))
|
||||||
coef1 = ao_coef_normalized_ordered_transp(i,i_ao)
|
|
||||||
|
|
||||||
do j = 1, ao_prim_num(j_ao)
|
! ---
|
||||||
alpha2 = ao_expo_ordered_transp(j,j_ao)
|
|
||||||
coef12 = coef1 * ao_coef_normalized_ordered_transp(j,j_ao)
|
|
||||||
if(dabs(coef12) .lt. 1d-14) cycle
|
|
||||||
|
|
||||||
integral = NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
|
p_new = mu_in / dsqrt(p + mu_in * mu_in)
|
||||||
, beta, B_center, C_center, n_pt_in, mu_in )
|
factor = dexp(-const_factor)
|
||||||
|
coeff = dtwo_pi * factor * p_inv * p_new
|
||||||
|
|
||||||
NAI_pol_mult_erf_ao_with1s += integral * coef12
|
n_pt = 2 * ( (power_A1(1) + power_A2(1)) + (power_A1(2) + power_A2(2)) + (power_A1(3) + power_A2(3)) )
|
||||||
enddo
|
const = p * dist_integral * p_new * p_new
|
||||||
|
if(n_pt == 0) then
|
||||||
|
NAI_pol_mult_erf_with1s = coeff * rint(0, const)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 0, n_pt_in
|
||||||
|
d(i) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
|
p_new = p_new * p_new
|
||||||
|
call give_polynomial_mult_center_one_e_erf_opt( A1_center, A2_center, power_A1, power_A2, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
|
||||||
|
|
||||||
end function NAI_pol_mult_erf_ao_with1s
|
if(n_pt_out < 0) then
|
||||||
|
NAI_pol_mult_erf_with1s = 0.d0
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
||||||
|
accu = 0.d0
|
||||||
|
do i = 0, n_pt_out, 2
|
||||||
|
accu += d(i) * rint(i/2, const)
|
||||||
|
enddo
|
||||||
|
NAI_pol_mult_erf_with1s = accu * coeff
|
||||||
|
|
||||||
|
end function NAI_pol_mult_erf_with1s
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine NAI_pol_mult_erf_with1s_v(A1_center, A2_center, power_A1, power_A2, alpha1, alpha2, beta, B_center, LD_B, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
|
subroutine NAI_pol_mult_erf_with1s_v(A1_center, A2_center, power_A1, power_A2, alpha1, alpha2, beta, B_center, LD_B, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
|
||||||
|
|
||||||
@ -428,107 +662,6 @@ subroutine give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A
|
|||||||
end subroutine give_polynomial_mult_center_one_e_erf_opt
|
end subroutine give_polynomial_mult_center_one_e_erf_opt
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
subroutine NAI_pol_mult_erf_v(A_center, B_center, power_A, power_B, alpha, beta, C_center, LD_C, n_pt_in, mu_in, res_v, LD_resv, n_points)
|
|
||||||
|
|
||||||
BEGIN_DOC
|
|
||||||
!
|
|
||||||
! Computes the following integral :
|
|
||||||
!
|
|
||||||
! .. math::
|
|
||||||
!
|
|
||||||
! \int dr (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
|
|
||||||
! \frac{\erf(\mu |r - R_C |)}{| r - R_C |}$.
|
|
||||||
!
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
include 'utils/constants.include.F'
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer, intent(in) :: n_pt_in, n_points, LD_C, LD_resv
|
|
||||||
integer, intent(in) :: power_A(3), power_B(3)
|
|
||||||
double precision, intent(in) :: A_center(3), B_center(3), alpha, beta, mu_in
|
|
||||||
double precision, intent(in) :: C_center(LD_C,3)
|
|
||||||
double precision, intent(out) :: res_v(LD_resv)
|
|
||||||
|
|
||||||
integer :: i, n_pt, n_pt_out, ipoint
|
|
||||||
double precision :: P_center(3)
|
|
||||||
double precision :: d(0:n_pt_in), coeff, dist, const, factor
|
|
||||||
double precision :: const_factor, dist_integral
|
|
||||||
double precision :: accu, p_inv, p, rho, p_inv_2
|
|
||||||
double precision :: p_new, p_new2, coef_tmp
|
|
||||||
|
|
||||||
double precision :: rint
|
|
||||||
|
|
||||||
res_V(1:LD_resv) = 0.d0
|
|
||||||
|
|
||||||
p = alpha + beta
|
|
||||||
p_inv = 1.d0 / p
|
|
||||||
p_inv_2 = 0.5d0 * p_inv
|
|
||||||
rho = alpha * beta * p_inv
|
|
||||||
p_new = mu_in / dsqrt(p + mu_in * mu_in)
|
|
||||||
p_new2 = p_new * p_new
|
|
||||||
coef_tmp = p * p_new2
|
|
||||||
|
|
||||||
dist = 0.d0
|
|
||||||
do i = 1, 3
|
|
||||||
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
|
||||||
dist += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
const_factor = dist * rho
|
|
||||||
if(const_factor > 80.d0) then
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
factor = dexp(-const_factor)
|
|
||||||
coeff = dtwo_pi * factor * p_inv * p_new
|
|
||||||
|
|
||||||
n_pt = 2 * ( power_A(1) + power_B(1) + power_A(2) + power_B(2) + power_A(3) + power_B(3) )
|
|
||||||
|
|
||||||
if(n_pt == 0) then
|
|
||||||
|
|
||||||
do ipoint = 1, n_points
|
|
||||||
dist_integral = 0.d0
|
|
||||||
do i = 1, 3
|
|
||||||
dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
|
|
||||||
enddo
|
|
||||||
const = coef_tmp * dist_integral
|
|
||||||
|
|
||||||
res_v(ipoint) = coeff * rint(0, const)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
else
|
|
||||||
|
|
||||||
do ipoint = 1, n_points
|
|
||||||
dist_integral = 0.d0
|
|
||||||
do i = 1, 3
|
|
||||||
dist_integral += (P_center(i) - C_center(ipoint,i)) * (P_center(i) - C_center(ipoint,i))
|
|
||||||
enddo
|
|
||||||
const = coef_tmp * dist_integral
|
|
||||||
|
|
||||||
do i = 0, n_pt_in
|
|
||||||
d(i) = 0.d0
|
|
||||||
enddo
|
|
||||||
call give_polynomial_mult_center_one_e_erf_opt(A_center, B_center, power_A, power_B, C_center(ipoint,1:3), n_pt_in, d, n_pt_out, p_inv_2, p_new2, P_center)
|
|
||||||
|
|
||||||
if(n_pt_out < 0) then
|
|
||||||
res_v(ipoint) = 0.d0
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
|
|
||||||
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
|
||||||
accu = 0.d0
|
|
||||||
do i = 0, n_pt_out, 2
|
|
||||||
accu += d(i) * rint(i/2, const)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
res_v(ipoint) = accu * coeff
|
|
||||||
enddo
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
end subroutine NAI_pol_mult_erf_v
|
|
||||||
|
|
||||||
|
|
||||||
subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in)
|
subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out,mu_in)
|
||||||
|
|
||||||
@ -659,113 +792,3 @@ subroutine give_polynomial_mult_center_one_e_erf(A_center,B_center,alpha,beta,po
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
double precision function NAI_pol_mult_erf_with1s( A1_center, A2_center, power_A1, power_A2, alpha1, alpha2 &
|
|
||||||
, beta, B_center, C_center, n_pt_in, mu_in )
|
|
||||||
|
|
||||||
BEGIN_DOC
|
|
||||||
!
|
|
||||||
! Computes the following integral :
|
|
||||||
!
|
|
||||||
! .. math::
|
|
||||||
!
|
|
||||||
! \int dx (x - A1_x)^a_1 (x - B1_x)^a_2 \exp(-\alpha_1 (x - A1_x)^2 - \alpha_2 (x - A2_x)^2)
|
|
||||||
! \int dy (y - A1_y)^b_1 (y - B1_y)^b_2 \exp(-\alpha_1 (y - A1_y)^2 - \alpha_2 (y - A2_y)^2)
|
|
||||||
! \int dz (x - A1_z)^c_1 (z - B1_z)^c_2 \exp(-\alpha_1 (z - A1_z)^2 - \alpha_2 (z - A2_z)^2)
|
|
||||||
! \exp(-\beta (r - B)^2)
|
|
||||||
! \frac{\erf(\mu |r - R_C|)}{|r - R_C|}$.
|
|
||||||
!
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
include 'utils/constants.include.F'
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer, intent(in) :: n_pt_in
|
|
||||||
integer, intent(in) :: power_A1(3), power_A2(3)
|
|
||||||
double precision, intent(in) :: C_center(3), A1_center(3), A2_center(3), B_center(3)
|
|
||||||
double precision, intent(in) :: alpha1, alpha2, beta, mu_in
|
|
||||||
|
|
||||||
integer :: i, n_pt, n_pt_out
|
|
||||||
double precision :: alpha12, alpha12_inv, alpha12_inv_2, rho12, A12_center(3), dist12, const_factor12
|
|
||||||
double precision :: p, p_inv, p_inv_2, rho, P_center(3), dist, const_factor
|
|
||||||
double precision :: dist_integral
|
|
||||||
double precision :: d(0:n_pt_in), coeff, const, factor
|
|
||||||
double precision :: accu
|
|
||||||
double precision :: p_new
|
|
||||||
|
|
||||||
double precision :: rint
|
|
||||||
|
|
||||||
|
|
||||||
! e^{-alpha1 (r - A1)^2} e^{-alpha2 (r - A2)^2} = e^{-K12} e^{-alpha12 (r - A12)^2}
|
|
||||||
alpha12 = alpha1 + alpha2
|
|
||||||
alpha12_inv = 1.d0 / alpha12
|
|
||||||
alpha12_inv_2 = 0.5d0 * alpha12_inv
|
|
||||||
rho12 = alpha1 * alpha2 * alpha12_inv
|
|
||||||
A12_center(1) = (alpha1 * A1_center(1) + alpha2 * A2_center(1)) * alpha12_inv
|
|
||||||
A12_center(2) = (alpha1 * A1_center(2) + alpha2 * A2_center(2)) * alpha12_inv
|
|
||||||
A12_center(3) = (alpha1 * A1_center(3) + alpha2 * A2_center(3)) * alpha12_inv
|
|
||||||
dist12 = (A1_center(1) - A2_center(1)) * (A1_center(1) - A2_center(1)) &
|
|
||||||
+ (A1_center(2) - A2_center(2)) * (A1_center(2) - A2_center(2)) &
|
|
||||||
+ (A1_center(3) - A2_center(3)) * (A1_center(3) - A2_center(3))
|
|
||||||
|
|
||||||
const_factor12 = dist12 * rho12
|
|
||||||
if(const_factor12 > 80.d0) then
|
|
||||||
NAI_pol_mult_erf_with1s = 0.d0
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
! e^{-K12} e^{-alpha12 (r - A12)^2} e^{-beta (r - B)^2} = e^{-K} e^{-p (r - P)^2}
|
|
||||||
p = alpha12 + beta
|
|
||||||
p_inv = 1.d0 / p
|
|
||||||
p_inv_2 = 0.5d0 * p_inv
|
|
||||||
rho = alpha12 * beta * p_inv
|
|
||||||
P_center(1) = (alpha12 * A12_center(1) + beta * B_center(1)) * p_inv
|
|
||||||
P_center(2) = (alpha12 * A12_center(2) + beta * B_center(2)) * p_inv
|
|
||||||
P_center(3) = (alpha12 * A12_center(3) + beta * B_center(3)) * p_inv
|
|
||||||
dist = (A12_center(1) - B_center(1)) * (A12_center(1) - B_center(1)) &
|
|
||||||
+ (A12_center(2) - B_center(2)) * (A12_center(2) - B_center(2)) &
|
|
||||||
+ (A12_center(3) - B_center(3)) * (A12_center(3) - B_center(3))
|
|
||||||
|
|
||||||
const_factor = const_factor12 + dist * rho
|
|
||||||
if(const_factor > 80.d0) then
|
|
||||||
NAI_pol_mult_erf_with1s = 0.d0
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
dist_integral = (P_center(1) - C_center(1)) * (P_center(1) - C_center(1)) &
|
|
||||||
+ (P_center(2) - C_center(2)) * (P_center(2) - C_center(2)) &
|
|
||||||
+ (P_center(3) - C_center(3)) * (P_center(3) - C_center(3))
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
p_new = mu_in / dsqrt(p + mu_in * mu_in)
|
|
||||||
factor = dexp(-const_factor)
|
|
||||||
coeff = dtwo_pi * factor * p_inv * p_new
|
|
||||||
|
|
||||||
n_pt = 2 * ( (power_A1(1) + power_A2(1)) + (power_A1(2) + power_A2(2)) + (power_A1(3) + power_A2(3)) )
|
|
||||||
const = p * dist_integral * p_new * p_new
|
|
||||||
if(n_pt == 0) then
|
|
||||||
NAI_pol_mult_erf_with1s = coeff * rint(0, const)
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
do i = 0, n_pt_in
|
|
||||||
d(i) = 0.d0
|
|
||||||
enddo
|
|
||||||
p_new = p_new * p_new
|
|
||||||
call give_polynomial_mult_center_one_e_erf_opt( A1_center, A2_center, power_A1, power_A2, C_center, n_pt_in, d, n_pt_out, p_inv_2, p_new, P_center)
|
|
||||||
|
|
||||||
if(n_pt_out < 0) then
|
|
||||||
NAI_pol_mult_erf_with1s = 0.d0
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
|
|
||||||
! sum of integrals of type : int {t,[0,1]} exp-(rho.(P-Q)^2 * t^2) * t^i
|
|
||||||
accu = 0.d0
|
|
||||||
do i = 0, n_pt_out, 2
|
|
||||||
accu += d(i) * rint(i/2, const)
|
|
||||||
enddo
|
|
||||||
NAI_pol_mult_erf_with1s = accu * coeff
|
|
||||||
|
|
||||||
end function NAI_pol_mult_erf_with1s
|
|
||||||
|
@ -1,4 +1,8 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Nucleus-electron interaction, in the |AO| basis set.
|
! Nucleus-electron interaction, in the |AO| basis set.
|
||||||
!
|
!
|
||||||
@ -6,30 +10,38 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
!
|
!
|
||||||
! These integrals also contain the pseudopotential integrals.
|
! These integrals also contain the pseudopotential integrals.
|
||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
|
||||||
double precision :: alpha, beta, gama, delta
|
|
||||||
integer :: num_A,num_B
|
|
||||||
double precision :: A_center(3),B_center(3),C_center(3)
|
|
||||||
integer :: power_A(3),power_B(3)
|
|
||||||
integer :: i,j,k,l,n_pt_in,m
|
|
||||||
double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
|
|
||||||
|
|
||||||
if (read_ao_integrals_n_e) then
|
implicit none
|
||||||
call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
|
integer :: num_A, num_B, power_A(3), power_B(3)
|
||||||
print *, 'AO N-e integrals read from disk'
|
integer :: i, j, k, l, n_pt_in, m
|
||||||
else
|
double precision :: alpha, beta
|
||||||
|
double precision :: A_center(3),B_center(3),C_center(3)
|
||||||
|
double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
|
||||||
|
|
||||||
ao_integrals_n_e = 0.d0
|
ao_integrals_n_e = 0.d0
|
||||||
|
|
||||||
! _
|
if (read_ao_integrals_n_e) then
|
||||||
! /| / |_)
|
|
||||||
! | / | \
|
call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
|
||||||
!
|
print *, 'AO N-e integrals read from disk'
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
if(use_cosgtos) then
|
||||||
|
!print *, " use_cosgtos for ao_integrals_n_e ?", use_cosgtos
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
ao_integrals_n_e(i,j) = ao_integrals_n_e_cosgtos(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
!$OMP PARALLEL &
|
!$OMP PARALLEL &
|
||||||
!$OMP DEFAULT (NONE) &
|
!$OMP DEFAULT (NONE) &
|
||||||
!$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,&
|
!$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,&
|
||||||
!$OMP num_A,num_B,Z,c,n_pt_in) &
|
!$OMP num_A,num_B,Z,c,c1,n_pt_in) &
|
||||||
!$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp,&
|
!$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp,&
|
||||||
!$OMP n_pt_max_integrals,ao_integrals_n_e,nucl_num,nucl_charge)
|
!$OMP n_pt_max_integrals,ao_integrals_n_e,nucl_num,nucl_charge)
|
||||||
|
|
||||||
@ -54,7 +66,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
do m=1,ao_prim_num(i)
|
do m=1,ao_prim_num(i)
|
||||||
beta = ao_expo_ordered_transp(m,i)
|
beta = ao_expo_ordered_transp(m,i)
|
||||||
|
|
||||||
double precision :: c
|
double precision :: c, c1
|
||||||
c = 0.d0
|
c = 0.d0
|
||||||
|
|
||||||
do k = 1, nucl_num
|
do k = 1, nucl_num
|
||||||
@ -63,8 +75,16 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
|
|
||||||
C_center(1:3) = nucl_coord(k,1:3)
|
C_center(1:3) = nucl_coord(k,1:3)
|
||||||
|
|
||||||
c = c - Z * NAI_pol_mult(A_center,B_center, &
|
!print *, ' '
|
||||||
power_A,power_B,alpha,beta,C_center,n_pt_in)
|
!print *, A_center, B_center, C_center, power_A, power_B
|
||||||
|
!print *, alpha, beta
|
||||||
|
|
||||||
|
c1 = NAI_pol_mult( A_center, B_center, power_A, power_B &
|
||||||
|
, alpha, beta, C_center, n_pt_in )
|
||||||
|
|
||||||
|
!print *, ' c1 = ', c1
|
||||||
|
|
||||||
|
c = c - Z * c1
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j) &
|
ao_integrals_n_e(i,j) = ao_integrals_n_e(i,j) &
|
||||||
@ -77,13 +97,13 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
|
|
||||||
!$OMP END DO
|
!$OMP END DO
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
IF (DO_PSEUDO) THEN
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
IF(do_pseudo) THEN
|
||||||
ao_integrals_n_e += ao_pseudo_integrals
|
ao_integrals_n_e += ao_pseudo_integrals
|
||||||
ENDIF
|
ENDIF
|
||||||
IF(point_charges) THEN
|
|
||||||
ao_integrals_n_e += ao_integrals_pt_chrg
|
|
||||||
ENDIF
|
|
||||||
|
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -102,7 +122,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_imag, (ao_num,ao_num)]
|
|||||||
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
double precision :: alpha, beta, gama, delta
|
double precision :: alpha, beta
|
||||||
integer :: num_A,num_B
|
integer :: num_A,num_B
|
||||||
double precision :: A_center(3),B_center(3),C_center(3)
|
double precision :: A_center(3),B_center(3),C_center(3)
|
||||||
integer :: power_A(3),power_B(3)
|
integer :: power_A(3),power_B(3)
|
||||||
@ -125,7 +145,7 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nuc
|
|||||||
! :math:`\langle \chi_i | -\frac{1}{|r-R_A|} | \chi_j \rangle`
|
! :math:`\langle \chi_i | -\frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||||
END_DOC
|
END_DOC
|
||||||
implicit none
|
implicit none
|
||||||
double precision :: alpha, beta, gama, delta
|
double precision :: alpha, beta
|
||||||
integer :: i_c,num_A,num_B
|
integer :: i_c,num_A,num_B
|
||||||
double precision :: A_center(3),B_center(3),C_center(3)
|
double precision :: A_center(3),B_center(3),C_center(3)
|
||||||
integer :: power_A(3),power_B(3)
|
integer :: power_A(3),power_B(3)
|
||||||
@ -268,6 +288,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out)
|
subroutine give_polynomial_mult_center_one_e(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out)
|
||||||
implicit none
|
implicit none
|
||||||
@ -579,61 +600,3 @@ double precision function V_r(n,alpha)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
double precision function V_phi(n,m)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Computes the angular $\phi$ part of the nuclear attraction integral:
|
|
||||||
!
|
|
||||||
! $\int_{0}^{2 \pi} \cos(\phi)^n \sin(\phi)^m d\phi$.
|
|
||||||
END_DOC
|
|
||||||
integer :: n,m, i
|
|
||||||
double precision :: prod, Wallis
|
|
||||||
prod = 1.d0
|
|
||||||
do i = 0,shiftr(n,1)-1
|
|
||||||
prod = prod/ (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
|
|
||||||
enddo
|
|
||||||
V_phi = 4.d0 * prod * Wallis(m)
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
double precision function V_theta(n,m)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Computes the angular $\theta$ part of the nuclear attraction integral:
|
|
||||||
!
|
|
||||||
! $\int_{0}^{\pi} \cos(\theta)^n \sin(\theta)^m d\theta$
|
|
||||||
END_DOC
|
|
||||||
integer :: n,m,i
|
|
||||||
double precision :: Wallis, prod
|
|
||||||
include 'utils/constants.include.F'
|
|
||||||
V_theta = 0.d0
|
|
||||||
prod = 1.d0
|
|
||||||
do i = 0,shiftr(n,1)-1
|
|
||||||
prod = prod / (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
|
|
||||||
enddo
|
|
||||||
V_theta = (prod+prod) * Wallis(m)
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
double precision function Wallis(n)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Wallis integral:
|
|
||||||
!
|
|
||||||
! $\int_{0}^{\pi} \cos(\theta)^n d\theta$.
|
|
||||||
END_DOC
|
|
||||||
double precision :: fact
|
|
||||||
integer :: n,p
|
|
||||||
include 'utils/constants.include.F'
|
|
||||||
if(iand(n,1).eq.0)then
|
|
||||||
Wallis = fact(shiftr(n,1))
|
|
||||||
Wallis = pi * fact(n) / (dble(ibset(0_8,n)) * (Wallis+Wallis)*Wallis)
|
|
||||||
else
|
|
||||||
p = shiftr(n,1)
|
|
||||||
Wallis = fact(p)
|
|
||||||
Wallis = dble(ibset(0_8,p+p)) * Wallis*Wallis / fact(p+p+1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -4,13 +4,6 @@ doc: Read/Write |AO| integrals from/to disk [ Write | Read | None ]
|
|||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: None
|
default: None
|
||||||
|
|
||||||
[ao_integrals_threshold]
|
|
||||||
type: Threshold
|
|
||||||
doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero
|
|
||||||
interface: ezfio,provider,ocaml
|
|
||||||
default: 1.e-15
|
|
||||||
ezfio_name: threshold_ao
|
|
||||||
|
|
||||||
[do_direct_integrals]
|
[do_direct_integrals]
|
||||||
type: logical
|
type: logical
|
||||||
doc: Compute integrals on the fly (very slow, only for debugging)
|
doc: Compute integrals on the fly (very slow, only for debugging)
|
||||||
@ -22,4 +15,4 @@ ezfio_name: direct
|
|||||||
type: logical
|
type: logical
|
||||||
doc: Perform Cholesky decomposition of AO integrals
|
doc: Perform Cholesky decomposition of AO integrals
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: True
|
default: False
|
||||||
|
@ -1,23 +1,42 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function ao_two_e_integral(i, j, k, l)
|
double precision function ao_two_e_integral(i, j, k, l)
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! integral of the AO basis <ik|jl> or (ij|kl)
|
! integral of the AO basis <ik|jl> or (ij|kl)
|
||||||
! i(r1) j(r1) 1/r12 k(r2) l(r2)
|
! i(r1) j(r1) 1/r12 k(r2) l(r2)
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
integer,intent(in) :: i,j,k,l
|
implicit none
|
||||||
integer :: p,q,r,s
|
|
||||||
double precision :: I_center(3),J_center(3),K_center(3),L_center(3)
|
|
||||||
integer :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
|
|
||||||
double precision :: integral
|
|
||||||
include 'utils/constants.include.F'
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
|
||||||
|
integer :: p, q, r, s
|
||||||
|
integer :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
|
||||||
|
integer :: iorder_p(3), iorder_q(3)
|
||||||
|
double precision :: I_center(3), J_center(3), K_center(3), L_center(3)
|
||||||
|
double precision :: integral
|
||||||
double precision :: P_new(0:max_dim,3),P_center(3),fact_p,pp
|
double precision :: P_new(0:max_dim,3),P_center(3),fact_p,pp
|
||||||
double precision :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq
|
double precision :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq
|
||||||
integer :: iorder_p(3), iorder_q(3)
|
|
||||||
double precision :: ao_two_e_integral_schwartz_accel
|
double precision :: ao_two_e_integral_schwartz_accel
|
||||||
|
|
||||||
|
double precision :: ao_two_e_integral_cosgtos
|
||||||
|
|
||||||
|
|
||||||
|
if(use_cosgtos) then
|
||||||
|
!print *, ' use_cosgtos for ao_two_e_integral ?', use_cosgtos
|
||||||
|
|
||||||
|
ao_two_e_integral = ao_two_e_integral_cosgtos(i, j, k, l)
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
|
if (ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
|
||||||
|
|
||||||
ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l)
|
ao_two_e_integral = ao_two_e_integral_schwartz_accel(i,j,k,l)
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
dim1 = n_pt_max_integrals
|
dim1 = n_pt_max_integrals
|
||||||
@ -102,8 +121,12 @@ double precision function ao_two_e_integral(i,j,k,l)
|
|||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)
|
double precision function ao_two_e_integral_schwartz_accel(i,j,k,l)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -421,12 +444,15 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz, (ao_num, ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz, (ao_num, ao_num) ]
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Needed to compute Schwartz inequalities
|
! Needed to compute Schwartz inequalities
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
integer :: i, k
|
integer :: i, k
|
||||||
double precision :: ao_two_e_integral,cpu_1,cpu_2, wall_1, wall_2
|
double precision :: ao_two_e_integral,cpu_1,cpu_2, wall_1, wall_2
|
||||||
|
|
||||||
@ -445,6 +471,7 @@ BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function general_primitive_integral(dim, &
|
double precision function general_primitive_integral(dim, &
|
||||||
P_new,P_center,fact_p,p,p_inv,iorder_p, &
|
P_new,P_center,fact_p,p,p_inv,iorder_p, &
|
||||||
|
@ -257,7 +257,7 @@ subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END DO
|
!$OMP END DO NOWAIT
|
||||||
!$OMP CRITICAL
|
!$OMP CRITICAL
|
||||||
energy = energy + e
|
energy = energy + e
|
||||||
!$OMP END CRITICAL
|
!$OMP END CRITICAL
|
||||||
@ -287,75 +287,175 @@ subroutine form_w_ijk(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W)
|
|||||||
double precision, intent(out) :: W(nV,nV,nV)!,nO,nO,nO)
|
double precision, intent(out) :: W(nV,nV,nV)!,nO,nO,nO)
|
||||||
|
|
||||||
integer :: l,a,b,c,d
|
integer :: l,a,b,c,d
|
||||||
|
double precision, allocatable, dimension(:,:,:) :: X, Y, Z
|
||||||
|
|
||||||
!W = 0d0
|
!W = 0d0
|
||||||
!do i = 1, nO
|
!do i = 1, nO
|
||||||
! do j = 1, nO
|
! do j = 1, nO
|
||||||
! do k = 1, nO
|
! do k = 1, nO
|
||||||
|
|
||||||
!$OMP PARALLEL &
|
allocate(X(nV,nV,nV))
|
||||||
!$OMP SHARED(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W) &
|
allocate(Y(nV,nV,nV))
|
||||||
!$OMP PRIVATE(a,b,c,d,l) &
|
allocate(Z(nV,nV,nV))
|
||||||
!$OMP DEFAULT(NONE)
|
|
||||||
!$OMP DO collapse(2)
|
!$OMP PARALLEL DO
|
||||||
do c = 1, nV
|
|
||||||
do b = 1, nV
|
do b = 1, nV
|
||||||
do a = 1, nV
|
do a = 1, nV
|
||||||
W(a,b,c) = 0d0
|
|
||||||
|
|
||||||
do d = 1, nV
|
do d = 1, nV
|
||||||
!W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
|
Z(d,a,b) = X_vvvo(d,b,a,i)
|
||||||
W(a,b,c) = W(a,b,c) &
|
|
||||||
! chem (bd|ai)
|
|
||||||
! phys <ba|di>
|
|
||||||
!+ cc_space_v_vvvo(b,a,d,i) * t2(k,j,c,d) &
|
|
||||||
!+ cc_space_v_vvvo(c,a,d,i) * t2(j,k,b,d) & ! bc kj
|
|
||||||
!+ cc_space_v_vvvo(a,c,d,k) * t2(j,i,b,d) & ! prev ac ik
|
|
||||||
!+ cc_space_v_vvvo(b,c,d,k) * t2(i,j,a,d) & ! prev ab ij
|
|
||||||
!+ cc_space_v_vvvo(c,b,d,j) * t2(i,k,a,d) & ! prev bc kj
|
|
||||||
!+ cc_space_v_vvvo(a,b,d,j) * t2(k,i,c,d) ! prev ac ik
|
|
||||||
+ X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j) &
|
|
||||||
+ X_vvvo(d,c,a,i) * T_vvoo(d,b,j,k) & ! bc kj
|
|
||||||
+ X_vvvo(d,a,c,k) * T_vvoo(d,b,j,i) & ! prev ac ik
|
|
||||||
+ X_vvvo(d,b,c,k) * T_vvoo(d,a,i,j) & ! prev ab ij
|
|
||||||
+ X_vvvo(d,c,b,j) * T_vvoo(d,a,i,k) & ! prev bc kj
|
|
||||||
+ X_vvvo(d,a,b,j) * T_vvoo(d,c,k,i) ! prev ac ik
|
|
||||||
enddo
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
enddo
|
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
|
||||||
enddo
|
Z, nV, T_vvoo(1,1,k,j), nV, 0.d0, W, nV*nV)
|
||||||
enddo
|
|
||||||
!$OMP END DO nowait
|
|
||||||
|
|
||||||
!$OMP DO collapse(2)
|
!$OMP PARALLEL DO
|
||||||
|
do c = 1, nV
|
||||||
|
do a = 1, nV
|
||||||
|
do d = 1, nV
|
||||||
|
Z(d,a,c) = X_vvvo(d,c,a,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
|
||||||
|
Z, nV, T_vvoo(1,1,j,k), nV, 0.d0, Y, nV*nV)
|
||||||
|
|
||||||
|
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
|
||||||
|
X_vvvo(1,1,1,k), nV, T_vvoo(1,1,j,i), nV, 1.d0, Y, nV*nV)
|
||||||
|
|
||||||
|
call dgemm('T','N',nV,nV*nV,nV, 1.d0, &
|
||||||
|
T_vvoo(1,1,i,j), nV, X_vvvo(1,1,1,k), nV, 1.d0, W, nV)
|
||||||
|
|
||||||
|
call dgemm('T','N',nV,nV*nV,nV, 1.d0, &
|
||||||
|
T_vvoo(1,1,i,k), nV, X_vvvo(1,1,1,j), nV, 1.d0, Y, nV)
|
||||||
|
|
||||||
|
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
|
||||||
|
X_vvvo(1,1,1,j), nV, T_vvoo(1,1,k,i), nV, 1.d0, W, nV*nV)
|
||||||
|
|
||||||
|
deallocate(Z)
|
||||||
|
|
||||||
|
|
||||||
|
allocate(Z(nO,nV,nV))
|
||||||
|
|
||||||
|
call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
|
||||||
|
T_ovvo(1,1,1,i), nO, X_ovoo(1,1,j,k), nO, 1.d0, W, nV*nV)
|
||||||
|
|
||||||
|
call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
|
||||||
|
T_ovvo(1,1,1,i), nO, X_ovoo(1,1,k,j), nO, 1.d0, Y, nV*nV)
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO
|
||||||
|
do c = 1, nV
|
||||||
|
do a = 1, nV
|
||||||
|
do l = 1, nO
|
||||||
|
Z(l,a,c) = T_ovvo(l,c,a,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
|
||||||
|
Z, nO, X_ovoo(1,1,i,j), nO, 1.d0, Y, nV*nV)
|
||||||
|
|
||||||
|
call dgemm('T','N',nV,nV*nV,nO, -1.d0, &
|
||||||
|
X_ovoo(1,1,j,i), nO, T_ovvo(1,1,1,k), nO, 1.d0, Y, nV)
|
||||||
|
|
||||||
|
call dgemm('T','N',nV,nV*nV,nO, -1.d0, &
|
||||||
|
X_ovoo(1,1,k,i), nO, T_ovvo(1,1,1,j), nO, 1.d0, W, nV)
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO
|
||||||
|
do b = 1, nV
|
||||||
|
do a = 1, nV
|
||||||
|
do l = 1, nO
|
||||||
|
Z(l,a,b) = T_ovvo(l,b,a,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
call dgemm('T','N',nV*nV,nV,nO, -1.d0, &
|
||||||
|
Z, nO, X_ovoo(1,1,i,k), nO, 1.d0, W, nV*nV)
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO
|
||||||
do c = 1, nV
|
do c = 1, nV
|
||||||
do b = 1, nV
|
do b = 1, nV
|
||||||
do a = 1, nV
|
do a = 1, nV
|
||||||
|
W(a,b,c) = W(a,b,c) + Y(a,c,b)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
do l = 1, nO
|
deallocate(X,Y,Z)
|
||||||
!W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
|
|
||||||
W(a,b,c) = W(a,b,c) &
|
|
||||||
! chem (ck|jl)
|
|
||||||
! phys <cj|kl>
|
|
||||||
!- cc_space_v_vooo(c,j,k,l) * t2(i,l,a,b) &
|
|
||||||
!- cc_space_v_vooo(b,k,j,l) * t2(i,l,a,c) & ! bc kj
|
|
||||||
!- cc_space_v_vooo(b,i,j,l) * t2(k,l,c,a) & ! prev ac ik
|
|
||||||
!- cc_space_v_vooo(a,j,i,l) * t2(k,l,c,b) & ! prev ab ij
|
|
||||||
!- cc_space_v_vooo(a,k,i,l) * t2(j,l,b,c) & ! prev bc kj
|
|
||||||
!- cc_space_v_vooo(c,i,k,l) * t2(j,l,b,a) ! prev ac ik
|
|
||||||
- X_ovoo(l,c,j,k) * T_ovvo(l,a,b,i) &
|
|
||||||
- X_ovoo(l,b,k,j) * T_ovvo(l,a,c,i) & ! bc kj
|
|
||||||
- X_ovoo(l,b,i,j) * T_ovvo(l,c,a,k) & ! prev ac ik
|
|
||||||
- X_ovoo(l,a,j,i) * T_ovvo(l,c,b,k) & ! prev ab ij
|
|
||||||
- X_ovoo(l,a,k,i) * T_ovvo(l,b,c,j) & ! prev bc kj
|
|
||||||
- X_ovoo(l,c,i,k) * T_ovvo(l,b,a,j) ! prev ac ik
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
enddo
|
! !$OMP PARALLEL &
|
||||||
enddo
|
! !$OMP SHARED(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W) &
|
||||||
!$OMP END DO
|
! !$OMP PRIVATE(a,b,c,d,l) &
|
||||||
!$OMP END PARALLEL
|
! !$OMP DEFAULT(NONE)
|
||||||
|
!
|
||||||
|
! !$OMP DO collapse(2)
|
||||||
|
! do c = 1, nV
|
||||||
|
! do b = 1, nV
|
||||||
|
! do a = 1, nV
|
||||||
|
! W(a,b,c) = 0.d0
|
||||||
|
!
|
||||||
|
! do d = 1, nV
|
||||||
|
! !W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
|
||||||
|
! W(a,b,c) = W(a,b,c) &
|
||||||
|
! ! chem (bd|ai)
|
||||||
|
! ! phys <ba|di>
|
||||||
|
! !+ cc_space_v_vvvo(b,a,d,i) * t2(k,j,c,d) &
|
||||||
|
! !+ cc_space_v_vvvo(c,a,d,i) * t2(j,k,b,d) & ! bc kj
|
||||||
|
! !+ cc_space_v_vvvo(a,c,d,k) * t2(j,i,b,d) & ! prev ac ik
|
||||||
|
! !+ cc_space_v_vvvo(b,c,d,k) * t2(i,j,a,d) & ! prev ab ij
|
||||||
|
! !+ cc_space_v_vvvo(c,b,d,j) * t2(i,k,a,d) & ! prev bc kj
|
||||||
|
! !+ cc_space_v_vvvo(a,b,d,j) * t2(k,i,c,d) ! prev ac ik
|
||||||
|
! + X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j) &
|
||||||
|
! + X_vvvo(d,c,a,i) * T_vvoo(d,b,j,k) & ! bc kj
|
||||||
|
! + X_vvvo(d,a,c,k) * T_vvoo(d,b,j,i) & ! prev ac ik
|
||||||
|
! + X_vvvo(d,b,c,k) * T_vvoo(d,a,i,j) & ! prev ab ij
|
||||||
|
! + X_vvvo(d,c,b,j) * T_vvoo(d,a,i,k) & ! prev bc kj
|
||||||
|
! + X_vvvo(d,a,b,j) * T_vvoo(d,c,k,i) ! prev ac ik
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! !$OMP END DO nowait
|
||||||
|
!
|
||||||
|
! !$OMP DO collapse(2)
|
||||||
|
! do c = 1, nV
|
||||||
|
! do b = 1, nV
|
||||||
|
! do a = 1, nV
|
||||||
|
!
|
||||||
|
! do l = 1, nO
|
||||||
|
! !W(i,j,k,a,b,c) = W(i,j,k,a,b,c) &
|
||||||
|
! W(a,b,c) = W(a,b,c) &
|
||||||
|
! ! chem (ck|jl)
|
||||||
|
! ! phys <cj|kl>
|
||||||
|
! !- cc_space_v_vooo(c,j,k,l) * t2(i,l,a,b) &
|
||||||
|
! !- cc_space_v_vooo(b,k,j,l) * t2(i,l,a,c) & ! bc kj
|
||||||
|
! !- cc_space_v_vooo(b,i,j,l) * t2(k,l,c,a) & ! prev ac ik
|
||||||
|
! !- cc_space_v_vooo(a,j,i,l) * t2(k,l,c,b) & ! prev ab ij
|
||||||
|
! !- cc_space_v_vooo(a,k,i,l) * t2(j,l,b,c) & ! prev bc kj
|
||||||
|
! !- cc_space_v_vooo(c,i,k,l) * t2(j,l,b,a) ! prev ac ik
|
||||||
|
! - T_ovvo(l,a,b,i) * X_ovoo(l,c,j,k) &
|
||||||
|
! - T_ovvo(l,a,c,i) * X_ovoo(l,b,k,j) & ! bc kj
|
||||||
|
! - T_ovvo(l,c,a,k) * X_ovoo(l,b,i,j) & ! prev ac ik
|
||||||
|
! - T_ovvo(l,c,b,k) * X_ovoo(l,a,j,i) & ! prev ab ij
|
||||||
|
! - T_ovvo(l,b,c,j) * X_ovoo(l,a,k,i) & ! prev bc kj
|
||||||
|
! - T_ovvo(l,b,a,j) * X_ovoo(l,c,i,k) ! prev ac ik
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! !$OMP END DO
|
||||||
|
! !$OMP END PARALLEL
|
||||||
|
|
||||||
! enddo
|
! enddo
|
||||||
! enddo
|
! enddo
|
||||||
@ -410,3 +510,4 @@ implicit none
|
|||||||
!enddo
|
!enddo
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
252
src/ccsd/ccsd_t_space_orb_abc.irp.f
Normal file
252
src/ccsd/ccsd_t_space_orb_abc.irp.f
Normal file
@ -0,0 +1,252 @@
|
|||||||
|
! Main
|
||||||
|
|
||||||
|
subroutine ccsd_par_t_space_v3(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: nO,nV
|
||||||
|
double precision, intent(in) :: t1(nO,nV), f_o(nO), f_v(nV)
|
||||||
|
double precision, intent(in) :: t2(nO,nO,nV,nV)
|
||||||
|
double precision, intent(in) :: v_vvvo(nV,nV,nV,nO), v_vvoo(nV,nV,nO,nO), v_vooo(nV,nO,nO,nO)
|
||||||
|
double precision, intent(out) :: energy
|
||||||
|
|
||||||
|
double precision, allocatable :: W(:,:,:,:,:,:)
|
||||||
|
double precision, allocatable :: V(:,:,:,:,:,:)
|
||||||
|
double precision, allocatable :: W_abc(:,:,:), V_abc(:,:,:)
|
||||||
|
double precision, allocatable :: W_cab(:,:,:), W_cba(:,:,:)
|
||||||
|
double precision, allocatable :: W_bca(:,:,:), V_cba(:,:,:)
|
||||||
|
double precision, allocatable :: X_vvvo(:,:,:,:), X_ovoo(:,:,:,:), X_vvoo(:,:,:,:)
|
||||||
|
double precision, allocatable :: T_vvoo(:,:,:,:), T_ovvo(:,:,:,:), T_vo(:,:)
|
||||||
|
integer :: i,j,k,l,a,b,c,d
|
||||||
|
double precision :: e,ta,tb, delta, delta_abc
|
||||||
|
|
||||||
|
!allocate(W(nV,nV,nV,nO,nO,nO))
|
||||||
|
!allocate(V(nV,nV,nV,nO,nO,nO))
|
||||||
|
allocate(W_abc(nO,nO,nO), V_abc(nO,nO,nO), W_cab(nO,nO,nO))
|
||||||
|
allocate(W_bca(nO,nO,nO), V_cba(nO,nO,nO), W_cba(nO,nO,nO))
|
||||||
|
allocate(X_vvvo(nV,nV,nV,nO), X_ovoo(nO,nV,nO,nO), X_vvoo(nV,nV,nO,nO))
|
||||||
|
allocate(T_vvoo(nV,nV,nO,nO), T_ovvo(nO,nV,nV,nO), T_vo(nV,nO))
|
||||||
|
|
||||||
|
! Temporary arrays
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP SHARED(nO,nV,T_vvoo,T_ovvo,T_vo,X_vvvo,X_ovoo,X_vvoo, &
|
||||||
|
!$OMP t1,t2,v_vvvo,v_vooo,v_vvoo) &
|
||||||
|
!$OMP PRIVATE(a,b,c,d,i,j,k,l) &
|
||||||
|
!$OMP DEFAULT(NONE)
|
||||||
|
|
||||||
|
!v_vvvo(b,a,d,i) * t2(k,j,c,d) &
|
||||||
|
!X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j)
|
||||||
|
|
||||||
|
!$OMP DO collapse(3)
|
||||||
|
do i = 1, nO
|
||||||
|
do a = 1, nV
|
||||||
|
do b = 1, nV
|
||||||
|
do d = 1, nV
|
||||||
|
X_vvvo(d,b,a,i) = v_vvvo(b,a,d,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO nowait
|
||||||
|
|
||||||
|
!$OMP DO collapse(3)
|
||||||
|
do j = 1, nO
|
||||||
|
do k = 1, nO
|
||||||
|
do c = 1, nV
|
||||||
|
do d = 1, nV
|
||||||
|
T_vvoo(d,c,k,j) = t2(k,j,c,d)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO nowait
|
||||||
|
|
||||||
|
!v_vooo(c,j,k,l) * t2(i,l,a,b) &
|
||||||
|
!X_ovoo(l,c,j,k) * T_ovvo(l,a,b,i) &
|
||||||
|
|
||||||
|
!$OMP DO collapse(3)
|
||||||
|
do k = 1, nO
|
||||||
|
do j = 1, nO
|
||||||
|
do c = 1, nV
|
||||||
|
do l = 1, nO
|
||||||
|
X_ovoo(l,c,j,k) = v_vooo(c,j,k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO nowait
|
||||||
|
|
||||||
|
!$OMP DO collapse(3)
|
||||||
|
do i = 1, nO
|
||||||
|
do b = 1, nV
|
||||||
|
do a = 1, nV
|
||||||
|
do l = 1, nO
|
||||||
|
T_ovvo(l,a,b,i) = t2(i,l,a,b)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO nowait
|
||||||
|
|
||||||
|
!v_vvoo(b,c,j,k) * t1(i,a) &
|
||||||
|
!X_vvoo(b,c,k,j) * T1_vo(a,i) &
|
||||||
|
|
||||||
|
!$OMP DO collapse(3)
|
||||||
|
do j = 1, nO
|
||||||
|
do k = 1, nO
|
||||||
|
do c = 1, nV
|
||||||
|
do b = 1, nV
|
||||||
|
X_vvoo(b,c,k,j) = v_vvoo(b,c,j,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO nowait
|
||||||
|
|
||||||
|
!$OMP DO collapse(1)
|
||||||
|
do i = 1, nO
|
||||||
|
do a = 1, nV
|
||||||
|
T_vo(a,i) = t1(i,a)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call wall_time(ta)
|
||||||
|
energy = 0d0
|
||||||
|
do c = 1, nV
|
||||||
|
do b = 1, nV
|
||||||
|
do a = 1, nV
|
||||||
|
delta_abc = f_v(a) + f_v(b) + f_v(c)
|
||||||
|
call form_w_abc(nO,nV,a,b,c,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_abc)
|
||||||
|
call form_w_abc(nO,nV,b,c,a,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_bca)
|
||||||
|
call form_w_abc(nO,nV,c,a,b,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_cab)
|
||||||
|
call form_w_abc(nO,nV,c,b,a,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_cba)
|
||||||
|
|
||||||
|
call form_v_abc(nO,nV,a,b,c,T_vo,X_vvoo,W_abc,V_abc)
|
||||||
|
call form_v_abc(nO,nV,c,b,a,T_vo,X_vvoo,W_cba,V_cba)
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP SHARED(energy,nO,a,b,c,W_abc,W_cab,W_bca,V_abc,V_cba,f_o,f_v,delta_abc)&
|
||||||
|
!$OMP PRIVATE(i,j,k,e,delta) &
|
||||||
|
!$OMP DEFAULT(NONE)
|
||||||
|
e = 0d0
|
||||||
|
!$OMP DO
|
||||||
|
do i = 1, nO
|
||||||
|
do j = 1, nO
|
||||||
|
do k = 1, nO
|
||||||
|
delta = 1d0 / (f_o(i) + f_o(j) + f_o(k) - delta_abc)
|
||||||
|
!energy = energy + (4d0 * W(i,j,k,a,b,c) + W(i,j,k,b,c,a) + W(i,j,k,c,a,b)) * (V(i,j,k,a,b,c) - V(i,j,k,c,b,a)) / (cc_space_f_o(i) + cc_space_f_o(j) + cc_space_f_o(k) - cc_space_f_v(a) - cc_space_f_v(b) - cc_space_f_v(c)) !delta_ooovvv(i,j,k,a,b,c)
|
||||||
|
e = e + (4d0 * W_abc(i,j,k) + W_bca(i,j,k) + W_cab(i,j,k))&
|
||||||
|
* (V_abc(i,j,k) - V_cba(i,j,k)) * delta
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
!$OMP CRITICAL
|
||||||
|
energy = energy + e
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call wall_time(tb)
|
||||||
|
write(*,'(F12.2,A5,F12.2,A2)') dble(i)/dble(nO)*100d0, '% in ', tb - ta, ' s'
|
||||||
|
enddo
|
||||||
|
|
||||||
|
energy = energy / 3d0
|
||||||
|
|
||||||
|
deallocate(W_abc,V_abc,W_cab,V_cba,W_bca,X_vvvo,X_ovoo,T_vvoo,T_ovvo,T_vo)
|
||||||
|
!deallocate(V,W)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine form_w_abc(nO,nV,a,b,c,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_abc)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: nO,nV,a,b,c
|
||||||
|
!double precision, intent(in) :: t2(nO,nO,nV,nV)
|
||||||
|
double precision, intent(in) :: T_vvoo(nV,nV,nO,nO), T_ovvo(nO,nV,nV,nO)
|
||||||
|
double precision, intent(in) :: X_vvvo(nV,nV,nV,nO), X_ovoo(nO,nV,nO,nO)
|
||||||
|
double precision, intent(out) :: W_abc(nO,nO,nO)
|
||||||
|
|
||||||
|
integer :: l,i,j,k,d
|
||||||
|
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP SHARED(nO,nV,a,b,c,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W_abc) &
|
||||||
|
!$OMP PRIVATE(i,j,k,d,l) &
|
||||||
|
!$OMP DEFAULT(NONE)
|
||||||
|
|
||||||
|
!$OMP DO collapse(3)
|
||||||
|
do k = 1, nO
|
||||||
|
do j = 1, nO
|
||||||
|
do i = 1, nO
|
||||||
|
W_abc(i,j,k) = 0.d0
|
||||||
|
|
||||||
|
do d = 1, nV
|
||||||
|
W_abc(i,j,k) = W_abc(i,j,k) &
|
||||||
|
+ X_vvvo(d,b,a,i) * T_vvoo(d,c,k,j) &
|
||||||
|
+ X_vvvo(d,c,a,i) * T_vvoo(d,b,j,k) &
|
||||||
|
+ X_vvvo(d,a,c,k) * T_vvoo(d,b,j,i) &
|
||||||
|
+ X_vvvo(d,b,c,k) * T_vvoo(d,a,i,j) &
|
||||||
|
+ X_vvvo(d,c,b,j) * T_vvoo(d,a,i,k) &
|
||||||
|
+ X_vvvo(d,a,b,j) * T_vvoo(d,c,k,i)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do l = 1, nO
|
||||||
|
W_abc(i,j,k) = W_abc(i,j,k) &
|
||||||
|
- T_ovvo(l,a,b,i) * X_ovoo(l,c,j,k) &
|
||||||
|
- T_ovvo(l,a,c,i) * X_ovoo(l,b,k,j) & ! bc kj
|
||||||
|
- T_ovvo(l,c,a,k) * X_ovoo(l,b,i,j) & ! prev ac ik
|
||||||
|
- T_ovvo(l,c,b,k) * X_ovoo(l,a,j,i) & ! prev ab ij
|
||||||
|
- T_ovvo(l,b,c,j) * X_ovoo(l,a,k,i) & ! prev bc kj
|
||||||
|
- T_ovvo(l,b,a,j) * X_ovoo(l,c,i,k) ! prev ac ik
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
! V_abc
|
||||||
|
|
||||||
|
subroutine form_v_abc(nO,nV,a,b,c,T_vo,X_vvoo,W,V)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: nO,nV,a,b,c
|
||||||
|
!double precision, intent(in) :: t1(nO,nV)
|
||||||
|
double precision, intent(in) :: T_vo(nV,nO)
|
||||||
|
double precision, intent(in) :: X_vvoo(nV,nV,nO,nO)
|
||||||
|
double precision, intent(in) :: W(nO,nO,nO)
|
||||||
|
double precision, intent(out) :: V(nO,nO,nO)
|
||||||
|
|
||||||
|
integer :: i,j,k
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP SHARED(nO,nV,a,b,c,T_vo,X_vvoo,W,V) &
|
||||||
|
!$OMP PRIVATE(i,j,k) &
|
||||||
|
!$OMP DEFAULT(NONE)
|
||||||
|
!$OMP DO collapse(2)
|
||||||
|
do k = 1, nO
|
||||||
|
do j = 1, nO
|
||||||
|
do i = 1, nO
|
||||||
|
!V(i,j,k,a,b,c) = V(i,j,k,a,b,c) + W(i,j,k,a,b,c) &
|
||||||
|
V(i,j,k) = W(i,j,k) &
|
||||||
|
+ X_vvoo(b,c,k,j) * T_vo(a,i) &
|
||||||
|
+ X_vvoo(a,c,k,i) * T_vo(b,j) &
|
||||||
|
+ X_vvoo(a,b,j,i) * T_vo(c,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
end
|
||||||
|
|
19
src/cosgtos_ao_int/EZFIO.cfg
Normal file
19
src/cosgtos_ao_int/EZFIO.cfg
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
[ao_expoim_cosgtos]
|
||||||
|
type: double precision
|
||||||
|
doc: imag part for Exponents for each primitive of each cosGTOs |AO|
|
||||||
|
size: (ao_basis.ao_num,ao_basis.ao_prim_num_max)
|
||||||
|
interface: ezfio, provider
|
||||||
|
|
||||||
|
[use_cosgtos]
|
||||||
|
type: logical
|
||||||
|
doc: If true, use cosgtos for AO integrals
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: False
|
||||||
|
|
||||||
|
[ao_integrals_threshold]
|
||||||
|
type: Threshold
|
||||||
|
doc: If | (pq|rs) | < `ao_integrals_threshold` then (pq|rs) is zero
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-15
|
||||||
|
ezfio_name: threshold_ao
|
||||||
|
|
4
src/cosgtos_ao_int/README.rst
Normal file
4
src/cosgtos_ao_int/README.rst
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
==============
|
||||||
|
cosgtos_ao_int
|
||||||
|
==============
|
||||||
|
|
210
src/cosgtos_ao_int/aos_cosgtos.irp.f
Normal file
210
src/cosgtos_ao_int/aos_cosgtos.irp.f
Normal file
@ -0,0 +1,210 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_coef_norm_ord_transp_cosgtos, (ao_prim_num_max, ao_num) ]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_prim_num_max
|
||||||
|
ao_coef_norm_ord_transp_cosgtos(i,j) = ao_coef_norm_ord_cosgtos(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_expo_ord_transp_cosgtos, (ao_prim_num_max, ao_num) ]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_prim_num_max
|
||||||
|
ao_expo_ord_transp_cosgtos(i,j) = ao_expo_ord_cosgtos(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_coef_norm_cosgtos, (ao_num, ao_prim_num_max) ]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j, powA(3), nz
|
||||||
|
double precision :: norm
|
||||||
|
complex*16 :: overlap_x, overlap_y, overlap_z, C_A(3)
|
||||||
|
complex*16 :: integ1, integ2, expo
|
||||||
|
|
||||||
|
nz = 100
|
||||||
|
|
||||||
|
C_A(1) = (0.d0, 0.d0)
|
||||||
|
C_A(2) = (0.d0, 0.d0)
|
||||||
|
C_A(3) = (0.d0, 0.d0)
|
||||||
|
|
||||||
|
ao_coef_norm_cosgtos = 0.d0
|
||||||
|
|
||||||
|
do i = 1, ao_num
|
||||||
|
|
||||||
|
powA(1) = ao_power(i,1)
|
||||||
|
powA(2) = ao_power(i,2)
|
||||||
|
powA(3) = ao_power(i,3)
|
||||||
|
|
||||||
|
! Normalization of the primitives
|
||||||
|
if(primitives_normalized) then
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
|
||||||
|
expo = ao_expo(i,j) + (0.d0, 1.d0) * ao_expoim_cosgtos(i,j)
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz(C_A, C_A, expo, expo, powA, powA, overlap_x, overlap_y, overlap_z, integ1, nz)
|
||||||
|
call overlap_cgaussian_xyz(C_A, C_A, conjg(expo), expo, powA, powA, overlap_x, overlap_y, overlap_z, integ2, nz)
|
||||||
|
|
||||||
|
norm = 2.d0 * real( integ1 + integ2 )
|
||||||
|
|
||||||
|
ao_coef_norm_cosgtos(i,j) = ao_coef(i,j) / dsqrt(norm)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
ao_coef_norm_cosgtos(i,j) = ao_coef(i,j)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_coef_norm_ord_cosgtos, (ao_num, ao_prim_num_max) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16 , ao_expo_ord_cosgtos, (ao_num, ao_prim_num_max) ]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
integer :: iorder(ao_prim_num_max)
|
||||||
|
double precision :: d(ao_prim_num_max,3)
|
||||||
|
|
||||||
|
d = 0.d0
|
||||||
|
|
||||||
|
do i = 1, ao_num
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
iorder(j) = j
|
||||||
|
d(j,1) = ao_expo(i,j)
|
||||||
|
d(j,2) = ao_coef_norm_cosgtos(i,j)
|
||||||
|
d(j,3) = ao_expoim_cosgtos(i,j)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call dsort (d(1,1), iorder, ao_prim_num(i))
|
||||||
|
call dset_order(d(1,2), iorder, ao_prim_num(i))
|
||||||
|
call dset_order(d(1,3), iorder, ao_prim_num(i))
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
ao_expo_ord_cosgtos (i,j) = d(j,1) + (0.d0, 1.d0) * d(j,3)
|
||||||
|
ao_coef_norm_ord_cosgtos(i,j) = d(j,2)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos, (ao_num, ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_x, (ao_num, ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_y, (ao_num, ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ao_overlap_cosgtos_z, (ao_num, ao_num) ]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||||
|
double precision :: c, overlap, overlap_x, overlap_y, overlap_z
|
||||||
|
complex*16 :: alpha, beta, A_center(3), B_center(3)
|
||||||
|
complex*16 :: overlap1, overlap_x1, overlap_y1, overlap_z1
|
||||||
|
complex*16 :: overlap2, overlap_x2, overlap_y2, overlap_z2
|
||||||
|
|
||||||
|
ao_overlap_cosgtos = 0.d0
|
||||||
|
ao_overlap_cosgtos_x = 0.d0
|
||||||
|
ao_overlap_cosgtos_y = 0.d0
|
||||||
|
ao_overlap_cosgtos_z = 0.d0
|
||||||
|
|
||||||
|
dim1 = 100
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
||||||
|
!$OMP DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE( A_center, B_center, power_A, power_B, alpha, beta, i, j, n, l, c &
|
||||||
|
!$OMP , overlap_x , overlap_y , overlap_z , overlap &
|
||||||
|
!$OMP , overlap_x1, overlap_y1, overlap_z1, overlap1 &
|
||||||
|
!$OMP , overlap_x2, overlap_y2, overlap_z2, overlap2 ) &
|
||||||
|
!$OMP SHARED( nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1 &
|
||||||
|
!$OMP , ao_overlap_cosgtos_x, ao_overlap_cosgtos_y, ao_overlap_cosgtos_z, ao_overlap_cosgtos &
|
||||||
|
!$OMP , ao_coef_norm_ord_transp_cosgtos, ao_expo_ord_transp_cosgtos )
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
|
||||||
|
A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0)
|
||||||
|
A_center(2) = nucl_coord(ao_nucl(j),2) * (1.d0, 0.d0)
|
||||||
|
A_center(3) = nucl_coord(ao_nucl(j),3) * (1.d0, 0.d0)
|
||||||
|
power_A(1) = ao_power(j,1)
|
||||||
|
power_A(2) = ao_power(j,2)
|
||||||
|
power_A(3) = ao_power(j,3)
|
||||||
|
|
||||||
|
do i = 1, ao_num
|
||||||
|
|
||||||
|
B_center(1) = nucl_coord(ao_nucl(i),1) * (1.d0, 0.d0)
|
||||||
|
B_center(2) = nucl_coord(ao_nucl(i),2) * (1.d0, 0.d0)
|
||||||
|
B_center(3) = nucl_coord(ao_nucl(i),3) * (1.d0, 0.d0)
|
||||||
|
power_B(1) = ao_power(i,1)
|
||||||
|
power_B(2) = ao_power(i,2)
|
||||||
|
power_B(3) = ao_power(i,3)
|
||||||
|
|
||||||
|
do n = 1, ao_prim_num(j)
|
||||||
|
alpha = ao_expo_ord_transp_cosgtos(n,j)
|
||||||
|
|
||||||
|
do l = 1, ao_prim_num(i)
|
||||||
|
c = ao_coef_norm_ord_transp_cosgtos(n,j) * ao_coef_norm_ord_transp_cosgtos(l,i)
|
||||||
|
beta = ao_expo_ord_transp_cosgtos(l,i)
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_x1, overlap_y1, overlap_z1, overlap1, dim1 )
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, conjg(alpha), beta, power_A, power_B &
|
||||||
|
, overlap_x2, overlap_y2, overlap_z2, overlap2, dim1 )
|
||||||
|
|
||||||
|
overlap_x = 2.d0 * real( overlap_x1 + overlap_x2 )
|
||||||
|
overlap_y = 2.d0 * real( overlap_y1 + overlap_y2 )
|
||||||
|
overlap_z = 2.d0 * real( overlap_z1 + overlap_z2 )
|
||||||
|
overlap = 2.d0 * real( overlap1 + overlap2 )
|
||||||
|
|
||||||
|
ao_overlap_cosgtos(i,j) = ao_overlap_cosgtos(i,j) + c * overlap
|
||||||
|
|
||||||
|
if( isnan(ao_overlap_cosgtos(i,j)) ) then
|
||||||
|
print*,'i, j', i, j
|
||||||
|
print*,'l, n', l, n
|
||||||
|
print*,'c, overlap', c, overlap
|
||||||
|
print*, overlap_x, overlap_y, overlap_z
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
ao_overlap_cosgtos_x(i,j) = ao_overlap_cosgtos_x(i,j) + c * overlap_x
|
||||||
|
ao_overlap_cosgtos_y(i,j) = ao_overlap_cosgtos_y(i,j) + c * overlap_y
|
||||||
|
ao_overlap_cosgtos_z(i,j) = ao_overlap_cosgtos_z(i,j) + c * overlap_z
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
|
||||||
|
|
7
src/cosgtos_ao_int/cosgtos_ao_int.irp.f
Normal file
7
src/cosgtos_ao_int/cosgtos_ao_int.irp.f
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
program cosgtos_ao_int
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! TODO : Put the documentation of the program here
|
||||||
|
END_DOC
|
||||||
|
print *, 'Hello world'
|
||||||
|
end
|
535
src/cosgtos_ao_int/one_e_Coul_integrals.irp.f
Normal file
535
src/cosgtos_ao_int/one_e_Coul_integrals.irp.f
Normal file
@ -0,0 +1,535 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_integrals_n_e_cosgtos, (ao_num, ao_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Nucleus-electron interaction, in the cosgtos |AO| basis set.
|
||||||
|
!
|
||||||
|
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: num_A, num_B, power_A(3), power_B(3)
|
||||||
|
integer :: i, j, k, l, n_pt_in, m
|
||||||
|
double precision :: c, Z, A_center(3), B_center(3), C_center(3)
|
||||||
|
complex*16 :: alpha, beta, c1, c2
|
||||||
|
|
||||||
|
complex*16 :: NAI_pol_mult_cosgtos
|
||||||
|
|
||||||
|
ao_integrals_n_e_cosgtos = 0.d0
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP DEFAULT (NONE) &
|
||||||
|
!$OMP PRIVATE ( i, j, k, l, m, alpha, beta, A_center, B_center, C_center &
|
||||||
|
!$OMP , power_A, power_B, num_A, num_B, Z, c, c1, c2, n_pt_in ) &
|
||||||
|
!$OMP SHARED ( ao_num, ao_prim_num, ao_nucl, nucl_coord, ao_power, nucl_num, nucl_charge &
|
||||||
|
!$OMP , ao_expo_ord_transp_cosgtos, ao_coef_norm_ord_transp_cosgtos &
|
||||||
|
!$OMP , n_pt_max_integrals, ao_integrals_n_e_cosgtos )
|
||||||
|
|
||||||
|
n_pt_in = n_pt_max_integrals
|
||||||
|
|
||||||
|
!$OMP DO SCHEDULE (dynamic)
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
num_A = ao_nucl(j)
|
||||||
|
power_A(1:3) = ao_power(j,1:3)
|
||||||
|
A_center(1:3) = nucl_coord(num_A,1:3)
|
||||||
|
|
||||||
|
do i = 1, ao_num
|
||||||
|
num_B = ao_nucl(i)
|
||||||
|
power_B(1:3) = ao_power(i,1:3)
|
||||||
|
B_center(1:3) = nucl_coord(num_B,1:3)
|
||||||
|
|
||||||
|
do l = 1, ao_prim_num(j)
|
||||||
|
alpha = ao_expo_ord_transp_cosgtos(l,j)
|
||||||
|
|
||||||
|
do m = 1, ao_prim_num(i)
|
||||||
|
beta = ao_expo_ord_transp_cosgtos(m,i)
|
||||||
|
|
||||||
|
c = 0.d0
|
||||||
|
do k = 1, nucl_num
|
||||||
|
|
||||||
|
Z = nucl_charge(k)
|
||||||
|
|
||||||
|
C_center(1:3) = nucl_coord(k,1:3)
|
||||||
|
|
||||||
|
!print *, ' '
|
||||||
|
!print *, A_center, B_center, C_center, power_A, power_B
|
||||||
|
!print *, real(alpha), real(beta)
|
||||||
|
|
||||||
|
c1 = NAI_pol_mult_cosgtos( A_center, B_center, power_A, power_B &
|
||||||
|
, alpha, beta, C_center, n_pt_in )
|
||||||
|
|
||||||
|
!c2 = c1
|
||||||
|
c2 = NAI_pol_mult_cosgtos( A_center, B_center, power_A, power_B &
|
||||||
|
, conjg(alpha), beta, C_center, n_pt_in )
|
||||||
|
|
||||||
|
!print *, ' c1 = ', real(c1)
|
||||||
|
!print *, ' c2 = ', real(c2)
|
||||||
|
|
||||||
|
c = c - Z * 2.d0 * real(c1 + c2)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
ao_integrals_n_e_cosgtos(i,j) = ao_integrals_n_e_cosgtos(i,j) &
|
||||||
|
+ ao_coef_norm_ord_transp_cosgtos(l,j) &
|
||||||
|
* ao_coef_norm_ord_transp_cosgtos(m,i) * c
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
complex*16 function NAI_pol_mult_cosgtos(A_center, B_center, power_A, power_B, alpha, beta, C_center, n_pt_in)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Computes the electron-nucleus attraction with two primitves cosgtos.
|
||||||
|
!
|
||||||
|
! :math:`\langle g_i | \frac{1}{|r-R_c|} | g_j \rangle`
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
integer, intent(in) :: n_pt_in, power_A(3), power_B(3)
|
||||||
|
double precision, intent(in) :: C_center(3), A_center(3), B_center(3)
|
||||||
|
complex*16, intent(in) :: alpha, beta
|
||||||
|
|
||||||
|
integer :: i, n_pt, n_pt_out
|
||||||
|
double precision :: dist, const_mod
|
||||||
|
complex*16 :: p, p_inv, rho, dist_integral, const, const_factor, coeff, factor
|
||||||
|
complex*16 :: accu, P_center(3)
|
||||||
|
complex*16 :: d(0:n_pt_in)
|
||||||
|
|
||||||
|
complex*16 :: V_n_e_cosgtos
|
||||||
|
complex*16 :: crint
|
||||||
|
|
||||||
|
if ( (A_center(1)/=B_center(1)) .or. (A_center(2)/=B_center(2)) .or. (A_center(3)/=B_center(3)) .or. &
|
||||||
|
(A_center(1)/=C_center(1)) .or. (A_center(2)/=C_center(2)) .or. (A_center(3)/=C_center(3)) ) then
|
||||||
|
|
||||||
|
continue
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
NAI_pol_mult_cosgtos = V_n_e_cosgtos( power_A(1), power_A(2), power_A(3) &
|
||||||
|
, power_B(1), power_B(2), power_B(3) &
|
||||||
|
, alpha, beta )
|
||||||
|
return
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
p = alpha + beta
|
||||||
|
p_inv = (1.d0, 0.d0) / p
|
||||||
|
rho = alpha * beta * p_inv
|
||||||
|
|
||||||
|
dist = 0.d0
|
||||||
|
dist_integral = (0.d0, 0.d0)
|
||||||
|
do i = 1, 3
|
||||||
|
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
||||||
|
dist += (A_center(i) - B_center(i)) * (A_center(i) - B_center(i))
|
||||||
|
dist_integral += (P_center(i) - C_center(i)) * (P_center(i) - C_center(i))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
const_factor = dist * rho
|
||||||
|
const = p * dist_integral
|
||||||
|
|
||||||
|
const_mod = dsqrt(real(const_factor)*real(const_factor) + aimag(const_factor)*aimag(const_factor))
|
||||||
|
if(const_mod > 80.d0) then
|
||||||
|
NAI_pol_mult_cosgtos = (0.d0, 0.d0)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
factor = zexp(-const_factor)
|
||||||
|
coeff = dtwo_pi * factor * p_inv
|
||||||
|
|
||||||
|
do i = 0, n_pt_in
|
||||||
|
d(i) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
n_pt = 2 * ( (power_A(1) + power_B(1)) + (power_A(2) + power_B(2)) + (power_A(3) + power_B(3)) )
|
||||||
|
if(n_pt == 0) then
|
||||||
|
NAI_pol_mult_cosgtos = coeff * crint(0, const)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
call give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
|
||||||
|
, power_A, power_B, C_center, n_pt_in, d, n_pt_out)
|
||||||
|
|
||||||
|
if(n_pt_out < 0) then
|
||||||
|
NAI_pol_mult_cosgtos = (0.d0, 0.d0)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
accu = (0.d0, 0.d0)
|
||||||
|
do i = 0, n_pt_out, 2
|
||||||
|
accu += crint(shiftr(i, 1), const) * d(i)
|
||||||
|
|
||||||
|
! print *, shiftr(i, 1), real(const), real(d(i)), real(crint(shiftr(i, 1), const))
|
||||||
|
enddo
|
||||||
|
NAI_pol_mult_cosgtos = accu * coeff
|
||||||
|
|
||||||
|
end function NAI_pol_mult_cosgtos
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine give_cpolynomial_mult_center_one_e( A_center, B_center, alpha, beta &
|
||||||
|
, power_A, power_B, C_center, n_pt_in, d, n_pt_out)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns the explicit polynomial in terms of the "t" variable of the following
|
||||||
|
!
|
||||||
|
! $I_{x1}(a_x, d_x,p,q) \times I_{x1}(a_y, d_y,p,q) \times I_{x1}(a_z, d_z,p,q)$.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: n_pt_in, power_A(3), power_B(3)
|
||||||
|
double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
|
||||||
|
complex*16, intent(in) :: alpha, beta
|
||||||
|
integer, intent(out) :: n_pt_out
|
||||||
|
complex*16, intent(out) :: d(0:n_pt_in)
|
||||||
|
|
||||||
|
integer :: a_x, b_x, a_y, b_y, a_z, b_z
|
||||||
|
integer :: n_pt1, n_pt2, n_pt3, dim, i, n_pt_tmp
|
||||||
|
complex*16 :: p, P_center(3), rho, p_inv, p_inv_2
|
||||||
|
complex*16 :: R1x(0:2), B01(0:2), R1xp(0:2),R2x(0:2)
|
||||||
|
complex*16 :: d1(0:n_pt_in), d2(0:n_pt_in), d3(0:n_pt_in)
|
||||||
|
|
||||||
|
ASSERT (n_pt_in > 1)
|
||||||
|
|
||||||
|
p = alpha + beta
|
||||||
|
p_inv = (1.d0, 0.d0) / p
|
||||||
|
p_inv_2 = 0.5d0 * p_inv
|
||||||
|
|
||||||
|
do i = 1, 3
|
||||||
|
P_center(i) = (alpha * A_center(i) + beta * B_center(i)) * p_inv
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do i = 0, n_pt_in
|
||||||
|
d(i) = (0.d0, 0.d0)
|
||||||
|
d1(i) = (0.d0, 0.d0)
|
||||||
|
d2(i) = (0.d0, 0.d0)
|
||||||
|
d3(i) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
n_pt1 = n_pt_in
|
||||||
|
|
||||||
|
R1x(0) = (P_center(1) - A_center(1))
|
||||||
|
R1x(1) = (0.d0, 0.d0)
|
||||||
|
R1x(2) = -(P_center(1) - C_center(1))
|
||||||
|
|
||||||
|
R1xp(0) = (P_center(1) - B_center(1))
|
||||||
|
R1xp(1) = (0.d0, 0.d0)
|
||||||
|
R1xp(2) = -(P_center(1) - C_center(1))
|
||||||
|
|
||||||
|
R2x(0) = p_inv_2
|
||||||
|
R2x(1) = (0.d0, 0.d0)
|
||||||
|
R2x(2) = -p_inv_2
|
||||||
|
|
||||||
|
a_x = power_A(1)
|
||||||
|
b_x = power_B(1)
|
||||||
|
call I_x1_pol_mult_one_e_cosgtos(a_x, b_x, R1x, R1xp, R2x, d1, n_pt1, n_pt_in)
|
||||||
|
|
||||||
|
if(n_pt1 < 0) then
|
||||||
|
n_pt_out = -1
|
||||||
|
do i = 0, n_pt_in
|
||||||
|
d(i) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
n_pt2 = n_pt_in
|
||||||
|
|
||||||
|
R1x(0) = (P_center(2) - A_center(2))
|
||||||
|
R1x(1) = (0.d0, 0.d0)
|
||||||
|
R1x(2) = -(P_center(2) - C_center(2))
|
||||||
|
|
||||||
|
R1xp(0) = (P_center(2) - B_center(2))
|
||||||
|
R1xp(1) = (0.d0, 0.d0)
|
||||||
|
R1xp(2) = -(P_center(2) - C_center(2))
|
||||||
|
|
||||||
|
a_y = power_A(2)
|
||||||
|
b_y = power_B(2)
|
||||||
|
call I_x1_pol_mult_one_e_cosgtos(a_y, b_y, R1x, R1xp, R2x, d2, n_pt2, n_pt_in)
|
||||||
|
|
||||||
|
if(n_pt2 < 0) then
|
||||||
|
n_pt_out = -1
|
||||||
|
do i = 0, n_pt_in
|
||||||
|
d(i) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
n_pt3 = n_pt_in
|
||||||
|
|
||||||
|
R1x(0) = (P_center(3) - A_center(3))
|
||||||
|
R1x(1) = (0.d0, 0.d0)
|
||||||
|
R1x(2) = -(P_center(3) - C_center(3))
|
||||||
|
|
||||||
|
R1xp(0) = (P_center(3) - B_center(3))
|
||||||
|
R1xp(1) = (0.d0, 0.d0)
|
||||||
|
R1xp(2) = -(P_center(3) - C_center(3))
|
||||||
|
|
||||||
|
a_z = power_A(3)
|
||||||
|
b_z = power_B(3)
|
||||||
|
call I_x1_pol_mult_one_e_cosgtos(a_z, b_z, R1x, R1xp, R2x, d3, n_pt3, n_pt_in)
|
||||||
|
|
||||||
|
if(n_pt3 < 0) then
|
||||||
|
n_pt_out = -1
|
||||||
|
do i = 0, n_pt_in
|
||||||
|
d(i) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
n_pt_tmp = 0
|
||||||
|
call multiply_cpoly(d1, n_pt1, d2, n_pt2, d, n_pt_tmp)
|
||||||
|
do i = 0, n_pt_tmp
|
||||||
|
d1(i) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
n_pt_out = 0
|
||||||
|
call multiply_cpoly(d, n_pt_tmp, d3, n_pt3, d1, n_pt_out)
|
||||||
|
do i = 0, n_pt_out
|
||||||
|
d(i) = d1(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end subroutine give_cpolynomial_mult_center_one_e
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
recursive subroutine I_x1_pol_mult_one_e_cosgtos(a, c, R1x, R1xp, R2x, d, nd, n_pt_in)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Recursive routine involved in the electron-nucleus potential
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
integer, intent(in) :: a, c, n_pt_in
|
||||||
|
complex*16, intent(in) :: R1x(0:2), R1xp(0:2), R2x(0:2)
|
||||||
|
integer, intent(inout) :: nd
|
||||||
|
complex*16, intent(inout) :: d(0:n_pt_in)
|
||||||
|
|
||||||
|
integer :: nx, ix, dim, iy, ny
|
||||||
|
complex*16 :: X(0:max_dim)
|
||||||
|
complex*16 :: Y(0:max_dim)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
|
||||||
|
|
||||||
|
dim = n_pt_in
|
||||||
|
|
||||||
|
if( (a==0) .and. (c==0)) then
|
||||||
|
|
||||||
|
nd = 0
|
||||||
|
d(0) = (1.d0, 0.d0)
|
||||||
|
return
|
||||||
|
|
||||||
|
elseif( (c < 0) .or. (nd < 0) ) then
|
||||||
|
|
||||||
|
nd = -1
|
||||||
|
return
|
||||||
|
|
||||||
|
elseif((a == 0) .and. (c .ne. 0)) then
|
||||||
|
|
||||||
|
call I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, n_pt_in)
|
||||||
|
|
||||||
|
elseif(a == 1) then
|
||||||
|
|
||||||
|
nx = nd
|
||||||
|
do ix = 0, n_pt_in
|
||||||
|
X(ix) = (0.d0, 0.d0)
|
||||||
|
Y(ix) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call I_x2_pol_mult_one_e_cosgtos(c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
|
||||||
|
|
||||||
|
do ix = 0, nx
|
||||||
|
X(ix) *= dble(c)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call multiply_cpoly(X, nx, R2x, 2, d, nd)
|
||||||
|
|
||||||
|
ny = 0
|
||||||
|
call I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, Y, ny, n_pt_in)
|
||||||
|
call multiply_cpoly(Y, ny, R1x, 2, d, nd)
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
nx = 0
|
||||||
|
do ix = 0, n_pt_in
|
||||||
|
X(ix) = (0.d0, 0.d0)
|
||||||
|
Y(ix) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call I_x1_pol_mult_one_e_cosgtos(a-2, c, R1x, R1xp, R2x, X, nx, n_pt_in)
|
||||||
|
|
||||||
|
do ix = 0, nx
|
||||||
|
X(ix) *= dble(a-1)
|
||||||
|
enddo
|
||||||
|
call multiply_cpoly(X, nx, R2x, 2, d, nd)
|
||||||
|
|
||||||
|
nx = nd
|
||||||
|
do ix = 0, n_pt_in
|
||||||
|
X(ix) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call I_x1_pol_mult_one_e_cosgtos(a-1, c-1, R1x, R1xp, R2x, X, nx, n_pt_in)
|
||||||
|
do ix = 0, nx
|
||||||
|
X(ix) *= dble(c)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call multiply_cpoly(X, nx, R2x, 2, d, nd)
|
||||||
|
|
||||||
|
ny = 0
|
||||||
|
call I_x1_pol_mult_one_e_cosgtos(a-1, c, R1x, R1xp, R2x, Y, ny, n_pt_in)
|
||||||
|
call multiply_cpoly(Y, ny, R1x, 2, d, nd)
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine I_x1_pol_mult_one_e_cosgtos
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
recursive subroutine I_x2_pol_mult_one_e_cosgtos(c, R1x, R1xp, R2x, d, nd, dim)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Recursive routine involved in the electron-nucleus potential
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
integer, intent(in) :: dim, c
|
||||||
|
complex*16, intent(in) :: R1x(0:2), R1xp(0:2), R2x(0:2)
|
||||||
|
integer, intent(inout) :: nd
|
||||||
|
complex*16, intent(out) :: d(0:max_dim)
|
||||||
|
|
||||||
|
integer :: i, nx, ix, ny
|
||||||
|
complex*16 :: X(0:max_dim), Y(0:max_dim)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: X, Y
|
||||||
|
|
||||||
|
if(c == 0) then
|
||||||
|
|
||||||
|
nd = 0
|
||||||
|
d(0) = (1.d0, 0.d0)
|
||||||
|
return
|
||||||
|
|
||||||
|
elseif((nd < 0) .or. (c < 0)) then
|
||||||
|
|
||||||
|
nd = -1
|
||||||
|
return
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
nx = 0
|
||||||
|
do ix = 0, dim
|
||||||
|
X(ix) = (0.d0, 0.d0)
|
||||||
|
Y(ix) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call I_x1_pol_mult_one_e_cosgtos(0, c-2, R1x, R1xp, R2x, X, nx, dim)
|
||||||
|
|
||||||
|
do ix = 0, nx
|
||||||
|
X(ix) *= dble(c-1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call multiply_cpoly(X, nx, R2x, 2, d, nd)
|
||||||
|
|
||||||
|
ny = 0
|
||||||
|
do ix = 0, dim
|
||||||
|
Y(ix) = (0.d0, 0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call I_x1_pol_mult_one_e_cosgtos(0, c-1, R1x, R1xp, R2x, Y, ny, dim)
|
||||||
|
|
||||||
|
if(ny .ge. 0) then
|
||||||
|
call multiply_cpoly(Y, ny, R1xp, 2, d, nd)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine I_x2_pol_mult_one_e_cosgtos
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
complex*16 function V_n_e_cosgtos(a_x, a_y, a_z, b_x, b_y, b_z, alpha, beta)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Primitve nuclear attraction between the two primitves centered on the same atom.
|
||||||
|
!
|
||||||
|
! $p_1 = x^{a_x} y^{a_y} z^{a_z} \exp(-\alpha r^2)$
|
||||||
|
!
|
||||||
|
! $p_2 = x^{b_x} y^{b_y} z^{b_z} \exp(-\beta r^2)$
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: a_x, a_y, a_z, b_x, b_y, b_z
|
||||||
|
complex*16, intent(in) :: alpha, beta
|
||||||
|
|
||||||
|
double precision :: V_phi, V_theta
|
||||||
|
complex*16 :: V_r_cosgtos
|
||||||
|
|
||||||
|
if( (iand(a_x + b_x, 1) == 1) .or. &
|
||||||
|
(iand(a_y + b_y, 1) == 1) .or. &
|
||||||
|
(iand(a_z + b_z, 1) == 1) ) then
|
||||||
|
|
||||||
|
V_n_e_cosgtos = (0.d0, 0.d0)
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
V_n_e_cosgtos = V_r_cosgtos(a_x + b_x + a_y + b_y + a_z + b_z + 1, alpha + beta) &
|
||||||
|
* V_phi(a_x + b_x, a_y + b_y) &
|
||||||
|
* V_theta(a_z + b_z, a_x + b_x + a_y + b_y + 1)
|
||||||
|
endif
|
||||||
|
|
||||||
|
end function V_n_e_cosgtos
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
complex*16 function V_r_cosgtos(n, alpha)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the radial part of the nuclear attraction integral:
|
||||||
|
!
|
||||||
|
! $\int_{0}^{\infty} r^n \exp(-\alpha r^2) dr$
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
include 'utils/constants.include.F'
|
||||||
|
|
||||||
|
integer , intent(in) :: n
|
||||||
|
complex*16, intent(in) :: alpha
|
||||||
|
|
||||||
|
double precision :: fact
|
||||||
|
|
||||||
|
if(iand(n, 1) .eq. 1) then
|
||||||
|
V_r_cosgtos = 0.5d0 * fact(shiftr(n, 1)) / (alpha**(shiftr(n, 1) + 1))
|
||||||
|
else
|
||||||
|
V_r_cosgtos = sqpi * fact(n) / fact(shiftr(n, 1)) * (0.5d0/zsqrt(alpha))**(n+1)
|
||||||
|
endif
|
||||||
|
|
||||||
|
end function V_r_cosgtos
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
223
src/cosgtos_ao_int/one_e_kin_integrals.irp.f
Normal file
223
src/cosgtos_ao_int/one_e_kin_integrals.irp.f
Normal file
@ -0,0 +1,223 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_x, (ao_num, ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_y, (ao_num, ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ao_deriv2_cosgtos_z, (ao_num, ao_num) ]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, n, l, dim1, power_A(3), power_B(3)
|
||||||
|
double precision :: c, deriv_tmp
|
||||||
|
complex*16 :: alpha, beta, A_center(3), B_center(3)
|
||||||
|
complex*16 :: overlap_x, overlap_y, overlap_z, overlap
|
||||||
|
complex*16 :: overlap_x0_1, overlap_y0_1, overlap_z0_1
|
||||||
|
complex*16 :: overlap_x0_2, overlap_y0_2, overlap_z0_2
|
||||||
|
complex*16 :: overlap_m2_1, overlap_p2_1
|
||||||
|
complex*16 :: overlap_m2_2, overlap_p2_2
|
||||||
|
complex*16 :: deriv_tmp_1, deriv_tmp_2
|
||||||
|
|
||||||
|
|
||||||
|
dim1 = 100
|
||||||
|
|
||||||
|
! -- Dummy call to provide everything
|
||||||
|
|
||||||
|
A_center(:) = (0.0d0, 0.d0)
|
||||||
|
B_center(:) = (1.0d0, 0.d0)
|
||||||
|
alpha = (1.0d0, 0.d0)
|
||||||
|
beta = (0.1d0, 0.d0)
|
||||||
|
power_A = 1
|
||||||
|
power_B = 0
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap, dim1 )
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
||||||
|
!$OMP DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE( A_center, B_center, power_A, power_B, alpha, beta, i, j, l, n, c &
|
||||||
|
!$OMP , deriv_tmp, deriv_tmp_1, deriv_tmp_2 &
|
||||||
|
!$OMP , overlap_x, overlap_y, overlap_z, overlap &
|
||||||
|
!$OMP , overlap_m2_1, overlap_p2_1, overlap_m2_2, overlap_p2_2 &
|
||||||
|
!$OMP , overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap_x0_2, overlap_y0_2, overlap_z0_2 ) &
|
||||||
|
!$OMP SHARED( nucl_coord, ao_power, ao_prim_num, ao_num, ao_nucl, dim1 &
|
||||||
|
!$OMP , ao_coef_norm_ord_transp_cosgtos, ao_expo_ord_transp_cosgtos &
|
||||||
|
!$OMP , ao_deriv2_cosgtos_x, ao_deriv2_cosgtos_y, ao_deriv2_cosgtos_z )
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
A_center(1) = nucl_coord(ao_nucl(j),1) * (1.d0, 0.d0)
|
||||||
|
A_center(2) = nucl_coord(ao_nucl(j),2) * (1.d0, 0.d0)
|
||||||
|
A_center(3) = nucl_coord(ao_nucl(j),3) * (1.d0, 0.d0)
|
||||||
|
power_A(1) = ao_power(j,1)
|
||||||
|
power_A(2) = ao_power(j,2)
|
||||||
|
power_A(3) = ao_power(j,3)
|
||||||
|
|
||||||
|
do i = 1, ao_num
|
||||||
|
B_center(1) = nucl_coord(ao_nucl(i),1) * (1.d0, 0.d0)
|
||||||
|
B_center(2) = nucl_coord(ao_nucl(i),2) * (1.d0, 0.d0)
|
||||||
|
B_center(3) = nucl_coord(ao_nucl(i),3) * (1.d0, 0.d0)
|
||||||
|
power_B(1) = ao_power(i,1)
|
||||||
|
power_B(2) = ao_power(i,2)
|
||||||
|
power_B(3) = ao_power(i,3)
|
||||||
|
|
||||||
|
ao_deriv2_cosgtos_x(i,j) = 0.d0
|
||||||
|
ao_deriv2_cosgtos_y(i,j) = 0.d0
|
||||||
|
ao_deriv2_cosgtos_z(i,j) = 0.d0
|
||||||
|
|
||||||
|
do n = 1, ao_prim_num(j)
|
||||||
|
alpha = ao_expo_ord_transp_cosgtos(n,j)
|
||||||
|
|
||||||
|
do l = 1, ao_prim_num(i)
|
||||||
|
c = ao_coef_norm_ord_transp_cosgtos(n,j) * ao_coef_norm_ord_transp_cosgtos(l,i)
|
||||||
|
beta = ao_expo_ord_transp_cosgtos(l,i)
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_x0_1, overlap_y0_1, overlap_z0_1, overlap, dim1 )
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||||
|
, overlap_x0_2, overlap_y0_2, overlap_z0_2, overlap, dim1 )
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
power_A(1) = power_A(1) - 2
|
||||||
|
if(power_A(1) > -1) then
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_m2_1, overlap_y, overlap_z, overlap, dim1 )
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||||
|
, overlap_m2_2, overlap_y, overlap_z, overlap, dim1 )
|
||||||
|
else
|
||||||
|
overlap_m2_1 = (0.d0, 0.d0)
|
||||||
|
overlap_m2_2 = (0.d0, 0.d0)
|
||||||
|
endif
|
||||||
|
|
||||||
|
power_A(1) = power_A(1) + 4
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_p2_1, overlap_y, overlap_z, overlap, dim1 )
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||||
|
, overlap_p2_2, overlap_y, overlap_z, overlap, dim1 )
|
||||||
|
|
||||||
|
power_A(1) = power_A(1) - 2
|
||||||
|
|
||||||
|
deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(1) + 1.d0) * overlap_x0_1 &
|
||||||
|
+ power_A(1) * (power_A(1) - 1.d0) * overlap_m2_1 &
|
||||||
|
+ 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_y0_1 * overlap_z0_1
|
||||||
|
|
||||||
|
deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(1) + 1.d0) * overlap_x0_2 &
|
||||||
|
+ power_A(1) * (power_A(1) - 1.d0) * overlap_m2_2 &
|
||||||
|
+ 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_y0_2 * overlap_z0_2
|
||||||
|
|
||||||
|
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
|
||||||
|
|
||||||
|
ao_deriv2_cosgtos_x(i,j) += c * deriv_tmp
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
power_A(2) = power_A(2) - 2
|
||||||
|
if(power_A(2) > -1) then
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_x, overlap_m2_1, overlap_y, overlap, dim1 )
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||||
|
, overlap_x, overlap_m2_2, overlap_y, overlap, dim1 )
|
||||||
|
else
|
||||||
|
overlap_m2_1 = (0.d0, 0.d0)
|
||||||
|
overlap_m2_2 = (0.d0, 0.d0)
|
||||||
|
endif
|
||||||
|
|
||||||
|
power_A(2) = power_A(2) + 4
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_x, overlap_p2_1, overlap_y, overlap, dim1 )
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||||
|
, overlap_x, overlap_p2_2, overlap_y, overlap, dim1 )
|
||||||
|
|
||||||
|
power_A(2) = power_A(2) - 2
|
||||||
|
|
||||||
|
deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(2) + 1.d0) * overlap_y0_1 &
|
||||||
|
+ power_A(2) * (power_A(2) - 1.d0) * overlap_m2_1 &
|
||||||
|
+ 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_x0_1 * overlap_z0_1
|
||||||
|
|
||||||
|
deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(2) + 1.d0) * overlap_y0_2 &
|
||||||
|
+ power_A(2) * (power_A(2) - 1.d0) * overlap_m2_2 &
|
||||||
|
+ 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_x0_2 * overlap_z0_2
|
||||||
|
|
||||||
|
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
|
||||||
|
|
||||||
|
ao_deriv2_cosgtos_y(i,j) += c * deriv_tmp
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
power_A(3) = power_A(3) - 2
|
||||||
|
if(power_A(3) > -1) then
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_x, overlap_y, overlap_m2_1, overlap, dim1 )
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||||
|
, overlap_x, overlap_y, overlap_m2_2, overlap, dim1 )
|
||||||
|
else
|
||||||
|
overlap_m2_1 = (0.d0, 0.d0)
|
||||||
|
overlap_m2_2 = (0.d0, 0.d0)
|
||||||
|
endif
|
||||||
|
|
||||||
|
power_A(3) = power_A(3) + 4
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
|
||||||
|
, overlap_x, overlap_y, overlap_p2_1, overlap, dim1 )
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz( A_center, B_center, alpha, conjg(beta), power_A, power_B &
|
||||||
|
, overlap_x, overlap_y, overlap_p2_2, overlap, dim1 )
|
||||||
|
|
||||||
|
power_A(3) = power_A(3) - 2
|
||||||
|
|
||||||
|
deriv_tmp_1 = ( -2.d0 * alpha * (2.d0 * power_A(3) + 1.d0) * overlap_z0_1 &
|
||||||
|
+ power_A(3) * (power_A(3) - 1.d0) * overlap_m2_1 &
|
||||||
|
+ 4.d0 * alpha * alpha * overlap_p2_1 ) * overlap_x0_1 * overlap_y0_1
|
||||||
|
|
||||||
|
deriv_tmp_2 = ( -2.d0 * alpha * (2.d0 * power_A(3) + 1.d0) * overlap_z0_2 &
|
||||||
|
+ power_A(3) * (power_A(3) - 1.d0) * overlap_m2_2 &
|
||||||
|
+ 4.d0 * alpha * alpha * overlap_p2_2 ) * overlap_x0_2 * overlap_y0_2
|
||||||
|
|
||||||
|
deriv_tmp = 2.d0 * real(deriv_tmp_1 + deriv_tmp_2)
|
||||||
|
|
||||||
|
ao_deriv2_cosgtos_z(i,j) += c * deriv_tmp
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, ao_kinetic_integrals_cosgtos, (ao_num, ao_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Kinetic energy integrals in the cosgtos |AO| basis.
|
||||||
|
!
|
||||||
|
! $\langle \chi_i |\hat{T}| \chi_j \rangle$
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(i, j) &
|
||||||
|
!$OMP SHARED(ao_num, ao_kinetic_integrals_cosgtos, ao_deriv2_cosgtos_x, ao_deriv2_cosgtos_y, ao_deriv2_cosgtos_z)
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
ao_kinetic_integrals_cosgtos(i,j) = -0.5d0 * ( ao_deriv2_cosgtos_x(i,j) &
|
||||||
|
+ ao_deriv2_cosgtos_y(i,j) &
|
||||||
|
+ ao_deriv2_cosgtos_z(i,j) )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
1584
src/cosgtos_ao_int/two_e_Coul_integrals.irp.f
Normal file
1584
src/cosgtos_ao_int/two_e_Coul_integrals.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
@ -25,7 +25,7 @@ subroutine print_extrapolated_energy
|
|||||||
write(*,*) 'minimum PT2 ', 'Extrapolated energy'
|
write(*,*) 'minimum PT2 ', 'Extrapolated energy'
|
||||||
write(*,*) '=========== ', '==================='
|
write(*,*) '=========== ', '==================='
|
||||||
do k=2,N_iter_p
|
do k=2,N_iter_p
|
||||||
write(*,'(F11.4,2X,F18.8)') pt2_iterations(1,k), extrapolated_energy(k,1)
|
write(*,'(F11.4,2X,F18.8)') pt2_iterations(1,N_iter_p+1-k), extrapolated_energy(k,1)
|
||||||
enddo
|
enddo
|
||||||
write(*,*) '=========== ', '==================='
|
write(*,*) '=========== ', '==================='
|
||||||
|
|
||||||
|
@ -3,7 +3,6 @@ subroutine save_mos
|
|||||||
double precision, allocatable :: buffer(:,:)
|
double precision, allocatable :: buffer(:,:)
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
|
|
||||||
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
|
||||||
call ezfio_set_mo_basis_mo_num(mo_num)
|
call ezfio_set_mo_basis_mo_num(mo_num)
|
||||||
call ezfio_set_mo_basis_mo_label(mo_label)
|
call ezfio_set_mo_basis_mo_label(mo_label)
|
||||||
call ezfio_set_mo_basis_ao_md5(ao_md5)
|
call ezfio_set_mo_basis_ao_md5(ao_md5)
|
||||||
@ -27,7 +26,7 @@ subroutine save_mos_no_occ
|
|||||||
double precision, allocatable :: buffer(:,:)
|
double precision, allocatable :: buffer(:,:)
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
|
|
||||||
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
! call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
||||||
!call ezfio_set_mo_basis_mo_num(mo_num)
|
!call ezfio_set_mo_basis_mo_num(mo_num)
|
||||||
!call ezfio_set_mo_basis_mo_label(mo_label)
|
!call ezfio_set_mo_basis_mo_label(mo_label)
|
||||||
!call ezfio_set_mo_basis_ao_md5(ao_md5)
|
!call ezfio_set_mo_basis_ao_md5(ao_md5)
|
||||||
@ -48,7 +47,7 @@ subroutine save_mos_truncated(n)
|
|||||||
double precision, allocatable :: buffer(:,:)
|
double precision, allocatable :: buffer(:,:)
|
||||||
integer :: i,j,n
|
integer :: i,j,n
|
||||||
|
|
||||||
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
! call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
||||||
|
|
||||||
call ezfio_set_mo_basis_mo_num(n)
|
call ezfio_set_mo_basis_mo_num(n)
|
||||||
call ezfio_set_mo_basis_mo_label(mo_label)
|
call ezfio_set_mo_basis_mo_label(mo_label)
|
||||||
|
97
src/mo_localization/84.mo_localization.bats
Normal file
97
src/mo_localization/84.mo_localization.bats
Normal file
@ -0,0 +1,97 @@
|
|||||||
|
#!/usr/bin/env bats
|
||||||
|
|
||||||
|
source $QP_ROOT/tests/bats/common.bats.sh
|
||||||
|
source $QP_ROOT/quantum_package.rc
|
||||||
|
|
||||||
|
zero () {
|
||||||
|
if [ -z "$1" ]; then echo 0.0; else echo $1; fi
|
||||||
|
}
|
||||||
|
|
||||||
|
function run() {
|
||||||
|
thresh1=1e-10
|
||||||
|
thresh2=1e-12
|
||||||
|
thresh3=1e-4
|
||||||
|
test_exe scf || skip
|
||||||
|
qp set_file $1
|
||||||
|
qp edit --check
|
||||||
|
qp reset -d
|
||||||
|
qp set_frozen_core
|
||||||
|
qp set localization localization_method boys
|
||||||
|
file="$(echo $1 | sed 's/.ezfio//g')"
|
||||||
|
energy="$(cat $1/hartree_fock/energy)"
|
||||||
|
fb_err1="$(qp run debug_gradient_loc | grep 'Max error' | tail -n 1 | awk '{print $3}')"
|
||||||
|
fb_err2="$(qp run debug_hessian_loc | grep 'Max error' | tail -n 1 | awk '{print $3}')"
|
||||||
|
qp run localization > $file.loc.out
|
||||||
|
fb_energy="$(qp run print_energy | grep -A 1 'Nuclear repulsion energy' | tail -n 1 )"
|
||||||
|
fb_c="$(cat $file.loc.out | grep 'Criterion:Core' | tail -n 1 | awk '{print $3}')i"
|
||||||
|
fb_i="$(cat $file.loc.out | grep 'Criterion:Inactive' | tail -n 1 | awk '{print $3}')"
|
||||||
|
fb_a="$(cat $file.loc.out | grep 'Criterion:Active' | tail -n 1 | awk '{print $3}')"
|
||||||
|
fb_v="$(cat $file.loc.out | grep 'Criterion:Virtual' | tail -n 1 | awk '{print $3}')"
|
||||||
|
qp reset -a
|
||||||
|
qp run scf
|
||||||
|
qp set_frozen_core
|
||||||
|
qp set localization localization_method pipek
|
||||||
|
pm_err1="$(qp run debug_gradient_loc | grep 'Max error' | tail -n 1 | awk '{print $3}')"
|
||||||
|
pm_err2="$(qp run debug_hessian_loc | grep 'Max error' | tail -n 1 | awk '{print $3}')"
|
||||||
|
qp run localization > $file.loc.out
|
||||||
|
pm_c="$(cat $file.loc.out | grep 'Criterion:Core' | tail -n 1 | awk '{print $3}')i"
|
||||||
|
pm_i="$(cat $file.loc.out | grep 'Criterion:Inactive' | tail -n 1 | awk '{print $3}')"
|
||||||
|
pm_a="$(cat $file.loc.out | grep 'Criterion:Active' | tail -n 1 | awk '{print $3}')"
|
||||||
|
pm_v="$(cat $file.loc.out | grep 'Criterion:Virtual' | tail -n 1 | awk '{print $3}')"
|
||||||
|
pm_energy="$(qp run print_energy | grep -A 1 'Nuclear repulsion energy' | tail -n 1 )"
|
||||||
|
qp set localization localization_method boys
|
||||||
|
qp reset -a
|
||||||
|
qp run scf
|
||||||
|
qp set_frozen_core
|
||||||
|
eq $energy $fb_energy $thresh1
|
||||||
|
eq $fb_err1 0.0 $thresh2
|
||||||
|
eq $fb_err2 0.0 $thresh2
|
||||||
|
eq $energy $pm_energy $thresh1
|
||||||
|
eq $pm_err1 0.0 $thresh2
|
||||||
|
eq $pm_err2 0.0 $thresh2
|
||||||
|
fb_c=$(zero $fb_c)
|
||||||
|
fb_i=$(zero $fb_i)
|
||||||
|
fb_a=$(zero $fb_a)
|
||||||
|
fb_v=$(zero $fb_v)
|
||||||
|
pm_c=$(zero $pm_c)
|
||||||
|
pm_i=$(zero $pm_i)
|
||||||
|
pm_a=$(zero $pm_a)
|
||||||
|
pm_v=$(zero $pm_v)
|
||||||
|
eq $fb_c $2 $thresh3
|
||||||
|
eq $fb_i $3 $thresh3
|
||||||
|
eq $fb_a $4 $thresh3
|
||||||
|
eq $fb_v $5 $thresh3
|
||||||
|
eq $pm_c $6 $thresh3
|
||||||
|
eq $pm_i $7 $thresh3
|
||||||
|
eq $pm_a $8 $thresh3
|
||||||
|
eq $pm_v $9 $thresh3
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "b2_stretched" {
|
||||||
|
run b2_stretched.ezfio -32.1357551678876 -47.0041982094667 0.0 -223.470015856259 -1.99990778964451 -2.51376723927071 0.0 -12.8490602539275
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "clo" {
|
||||||
|
run clo.ezfio -44.1624001765291 -32.4386660941387 0.0 -103.666309287187 -5.99985418946811 -5.46871580225222 0.0 -20.2480064922275
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "clf" {
|
||||||
|
run clf.ezfio -47.5143398826967 -35.7206886315104 0.0 -107.043029033468 -5.99994222062230 -6.63916513458470 0.0 -19.7035159913484
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "h2o2" {
|
||||||
|
run h2o2.ezfio -7.76848143170524 -30.9694344369829 0.0 -175.898343829453 -1.99990497554575 -5.62980322957485 0.0 -33.5699813186666
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "h2o" {
|
||||||
|
run h2o.ezfio 0.0 -2.52317434969591 0.0 -45.3136377925359 0.0 -3.01248365356981 0.0 -22.4470831240924
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "h3coh" {
|
||||||
|
run h3coh.ezfio -3.66763692804590 -24.0463089480870 0.0 -111.485948435075 -1.99714061342078 -4.89242181322988 0.0 -23.6405412057679
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "n2h4" {
|
||||||
|
run n2h4.ezfio -7.46608163002070 -35.7632174051822 0.0 -305.913449004632 -1.99989326143356 -4.62496615892268 0.0 -51.5171904685553
|
||||||
|
}
|
||||||
|
|
54
src/mo_localization/EZFIO.cfg
Normal file
54
src/mo_localization/EZFIO.cfg
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
[localization_method]
|
||||||
|
type: character*(32)
|
||||||
|
doc: Method for the orbital localization. boys: Foster-Boys, pipek: Pipek-Mezey.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: boys
|
||||||
|
|
||||||
|
[localization_max_nb_iter]
|
||||||
|
type: integer
|
||||||
|
doc: Maximal number of iterations for the orbital localization.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1000
|
||||||
|
|
||||||
|
[localization_use_hessian]
|
||||||
|
type: logical
|
||||||
|
doc: If true, it uses the trust region algorithm with the gradient and the diagonal of the hessian. Else it computes the rotation between each pair of MOs that should be applied to maximize/minimize the localization criterion. The last option is not easy to converge.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: true
|
||||||
|
|
||||||
|
[auto_mo_class]
|
||||||
|
type: logical
|
||||||
|
doc: If true, set automatically the classes.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: true
|
||||||
|
|
||||||
|
[thresh_loc_max_elem_grad]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold for the convergence, the localization exits when the largest element in the gradient is smaller than thresh_localization_max_elem_grad.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-6
|
||||||
|
|
||||||
|
[kick_in_mos]
|
||||||
|
type: logical
|
||||||
|
doc: If True, it applies a rotation of an angle angle_pre_rot between the MOs of a same mo_class before the localization.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: true
|
||||||
|
|
||||||
|
[angle_pre_rot]
|
||||||
|
type: double precision
|
||||||
|
doc: To define the angle for the rotation of the MOs before the localization (in rad).
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.1
|
||||||
|
|
||||||
|
[sort_mos_by_e]
|
||||||
|
type: logical
|
||||||
|
doc: If True, the MOs are sorted using the diagonal elements of the Fock matrix.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: false
|
||||||
|
|
||||||
|
[debug_hf]
|
||||||
|
type: logical
|
||||||
|
doc: If True, prints the HF energy before/after the different steps of the localization. Only for debugging.
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: false
|
||||||
|
|
3
src/mo_localization/NEED
Normal file
3
src/mo_localization/NEED
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
hartree_fock
|
||||||
|
utils_trust_region
|
||||||
|
determinants
|
113
src/mo_localization/README.md
Normal file
113
src/mo_localization/README.md
Normal file
@ -0,0 +1,113 @@
|
|||||||
|
# Orbital localisation
|
||||||
|
To localize the MOs:
|
||||||
|
```
|
||||||
|
qp run localization
|
||||||
|
```
|
||||||
|
By default, the different otbital classes are automatically set by splitting
|
||||||
|
the orbitales in the following classes:
|
||||||
|
- Core -> Core
|
||||||
|
- Active, doubly occupied -> Inactive
|
||||||
|
- Active, singly occupied -> Active
|
||||||
|
- Active, empty -> Virtual
|
||||||
|
- Deleted -> Deleted
|
||||||
|
The orbitals will be localized among each class, excpect the deleted ones.
|
||||||
|
If you want to choose another splitting, you can set
|
||||||
|
```
|
||||||
|
qp set mo_localization auto_mo_class false
|
||||||
|
```
|
||||||
|
and define the classes with
|
||||||
|
```
|
||||||
|
qp set_mo_class -c [] -a [] -v [] -i [] -d []
|
||||||
|
```
|
||||||
|
for more information
|
||||||
|
```
|
||||||
|
qp set_mo_class -q
|
||||||
|
```
|
||||||
|
We don't care about the name of the
|
||||||
|
mo classes. The algorithm just localizes all the MOs of
|
||||||
|
a given class between them, for all the classes, except the deleted MOs.
|
||||||
|
If you are using the last option don't forget to reset the initial mo classes
|
||||||
|
after the localization.
|
||||||
|
|
||||||
|
Before the localization, a kick is done for each mo class
|
||||||
|
(except the deleted ones) to break the MOs. This is done by
|
||||||
|
doing a given rotation between the MOs.
|
||||||
|
This feature can be removed by setting:
|
||||||
|
```
|
||||||
|
qp set localization kick_in_mos false
|
||||||
|
```
|
||||||
|
and the default angle for the rotation can be changed with:
|
||||||
|
```
|
||||||
|
qp set localization angle_pre_rot 1e-3 # or something else
|
||||||
|
```
|
||||||
|
|
||||||
|
After the localization, the MOs of each class (except the deleted ones)
|
||||||
|
can be sorted between them using the diagonal elements of
|
||||||
|
the fock matrix with:
|
||||||
|
```
|
||||||
|
qp set localization sort_mos_by_e true
|
||||||
|
```
|
||||||
|
|
||||||
|
You can check the Hartree-Fock energy before/during/after the localization
|
||||||
|
by putting (only for debugging):
|
||||||
|
```
|
||||||
|
qp set localization debug_hf true
|
||||||
|
```
|
||||||
|
|
||||||
|
## Foster-Boys & Pipek-Mezey
|
||||||
|
Foster-Boys:
|
||||||
|
```
|
||||||
|
qp set localization localization_method boys
|
||||||
|
```
|
||||||
|
|
||||||
|
Pipek-Mezey:
|
||||||
|
```
|
||||||
|
qp set localization localization_method pipek
|
||||||
|
```
|
||||||
|
|
||||||
|
# Break the spatial symmetry of the MOs
|
||||||
|
This program work exactly as the localization.
|
||||||
|
To break the spatial symmetry of the MOs:
|
||||||
|
```
|
||||||
|
qp run break_spatial_sym
|
||||||
|
```
|
||||||
|
The default angle for the rotations is too big for this kind of
|
||||||
|
application, a value between 1e-3 and 1e-6 should break the spatial
|
||||||
|
symmetry with just a small change in the energy:
|
||||||
|
```
|
||||||
|
qp set localization angle_pre_rot 1e-3
|
||||||
|
```
|
||||||
|
|
||||||
|
# With or without hessian + trust region
|
||||||
|
With hessian + trust region
|
||||||
|
```
|
||||||
|
qp set localization localisation_use_hessian true
|
||||||
|
```
|
||||||
|
It uses the trust region algorithm with the diagonal of the hessian of the
|
||||||
|
localization criterion with respect to the MO rotations.
|
||||||
|
|
||||||
|
Without the hessian and the trust region
|
||||||
|
```
|
||||||
|
qp set localization localisation_use_hessian false
|
||||||
|
```
|
||||||
|
By doing so it does not require to store the hessian but the
|
||||||
|
convergence is not easy, in particular for virtual MOs.
|
||||||
|
It seems that it not possible to converge with Pipek-Mezey
|
||||||
|
localization with this approach.
|
||||||
|
|
||||||
|
# Parameters
|
||||||
|
Some other parameters are available for the localization (qp edit for more details).
|
||||||
|
|
||||||
|
# Tests
|
||||||
|
```
|
||||||
|
qp test
|
||||||
|
```
|
||||||
|
|
||||||
|
# Org files
|
||||||
|
The org files are stored in the directory org in order to avoid overwriting on user changes.
|
||||||
|
The org files can be modified, to export the change to the source code, run
|
||||||
|
```
|
||||||
|
./TANGLE_org_mode.sh
|
||||||
|
mv *.irp.f ../.
|
||||||
|
```
|
||||||
|
|
27
src/mo_localization/break_spatial_sym.irp.f
Normal file
27
src/mo_localization/break_spatial_sym.irp.f
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
! ! A small program to break the spatial symmetry of the MOs.
|
||||||
|
|
||||||
|
! ! You have to defined your MO classes or set security_mo_class to false
|
||||||
|
! ! with:
|
||||||
|
! ! qp set orbital_optimization security_mo_class false
|
||||||
|
|
||||||
|
! ! The default angle for the rotations is too big for this kind of
|
||||||
|
! ! application, a value between 1e-3 and 1e-6 should break the spatial
|
||||||
|
! ! symmetry with just a small change in the energy.
|
||||||
|
|
||||||
|
|
||||||
|
program break_spatial_sym
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Break the symmetry of the MOs with a rotation
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
kick_in_mos = .True.
|
||||||
|
TOUCH kick_in_mos
|
||||||
|
|
||||||
|
call set_classes_loc
|
||||||
|
call apply_pre_rotation
|
||||||
|
call unset_classes_loc
|
||||||
|
|
||||||
|
end
|
65
src/mo_localization/debug_gradient_loc.irp.f
Normal file
65
src/mo_localization/debug_gradient_loc.irp.f
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
program debug_gradient_loc
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Check if the gradient is correct
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: list_size, n
|
||||||
|
integer, allocatable :: list(:)
|
||||||
|
double precision, allocatable :: v_grad(:), v_grad2(:)
|
||||||
|
double precision :: norm, max_elem, threshold, max_error
|
||||||
|
integer :: i, nb_error
|
||||||
|
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
list_size = dim_list_act_orb
|
||||||
|
|
||||||
|
allocate(list(list_size))
|
||||||
|
|
||||||
|
list = list_act
|
||||||
|
|
||||||
|
n = list_size*(list_size-1)/2
|
||||||
|
|
||||||
|
allocate(v_grad(n),v_grad2(n))
|
||||||
|
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys'
|
||||||
|
call gradient_FB(n,list_size,list,v_grad,max_elem,norm)
|
||||||
|
call gradient_FB_omp(n,list_size,list,v_grad2,max_elem,norm)
|
||||||
|
elseif (localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey'
|
||||||
|
call gradient_PM(n,list_size,list,v_grad,max_elem,norm)
|
||||||
|
call gradient_PM(n,list_size,list,v_grad2,max_elem,norm)
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
print*,i,v_grad(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
v_grad = v_grad - v_grad2
|
||||||
|
|
||||||
|
nb_error = 0
|
||||||
|
max_elem = 0d0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (dabs(v_grad(i)) > threshold) then
|
||||||
|
print*,v_grad(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (dabs(v_grad(i)) > max_elem) then
|
||||||
|
max_elem = v_grad(i)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Threshold error', threshold
|
||||||
|
print*, 'Nb error', nb_error
|
||||||
|
print*,'Max error', max_elem
|
||||||
|
|
||||||
|
deallocate(v_grad,v_grad2)
|
||||||
|
|
||||||
|
end
|
65
src/mo_localization/debug_hessian_loc.irp.f
Normal file
65
src/mo_localization/debug_hessian_loc.irp.f
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
program debug_hessian_loc
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Check if the hessian is correct
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: list_size, n
|
||||||
|
integer, allocatable :: list(:)
|
||||||
|
double precision, allocatable :: H(:), H2(:)
|
||||||
|
double precision :: threshold, max_error, max_elem
|
||||||
|
integer :: i, nb_error
|
||||||
|
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
list_size = dim_list_act_orb
|
||||||
|
|
||||||
|
allocate(list(list_size))
|
||||||
|
|
||||||
|
list = list_act
|
||||||
|
|
||||||
|
n = list_size*(list_size-1)/2
|
||||||
|
|
||||||
|
allocate(H(n),H2(n))
|
||||||
|
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys'
|
||||||
|
call hessian_FB(n,list_size,list,H)
|
||||||
|
call hessian_FB_omp(n,list_size,list,H2)
|
||||||
|
elseif(localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey'
|
||||||
|
call hessian_PM(n,list_size,list,H)
|
||||||
|
call hessian_PM(n,list_size,list,H2)
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
print*,i,H(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
H = H - H2
|
||||||
|
|
||||||
|
nb_error = 0
|
||||||
|
max_elem = 0d0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (dabs(H(i)) > threshold) then
|
||||||
|
print*,H(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (dabs(H(i)) > max_elem) then
|
||||||
|
max_elem = H(i)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Threshold error', threshold
|
||||||
|
print*, 'Nb error', nb_error
|
||||||
|
print*,'Max error', max_elem
|
||||||
|
|
||||||
|
deallocate(H,H2)
|
||||||
|
|
||||||
|
end
|
16
src/mo_localization/kick_the_mos.irp.f
Normal file
16
src/mo_localization/kick_the_mos.irp.f
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
program kick_the_mos
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! To do a small rotation of the MOs
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
kick_in_mos = .True.
|
||||||
|
TOUCH kick_in_mos
|
||||||
|
|
||||||
|
call set_classes_loc
|
||||||
|
call apply_pre_rotation
|
||||||
|
call unset_classes_loc
|
||||||
|
|
||||||
|
end
|
520
src/mo_localization/localization.irp.f
Normal file
520
src/mo_localization/localization.irp.f
Normal file
@ -0,0 +1,520 @@
|
|||||||
|
program localization
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call set_classes_loc
|
||||||
|
call run_localization
|
||||||
|
call unset_classes_loc
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Variables:
|
||||||
|
! | pre_rot(mo_num, mo_num) | double precision | Matrix for the pre rotation |
|
||||||
|
! | R(mo_num,mo_num) | double precision | Rotation matrix |
|
||||||
|
! | tmp_R(:,:) | double precision | Rottation matrix in a subsapce |
|
||||||
|
! | prev_mos(ao_num, mo_num) | double precision | Previous mo_coef |
|
||||||
|
! | spatial_extent(mo_num) | double precision | Spatial extent of the orbitals |
|
||||||
|
! | criterion | double precision | Localization criterion |
|
||||||
|
! | prev_criterion | double precision | Previous criterion |
|
||||||
|
! | criterion_model | double precision | Estimated next criterion |
|
||||||
|
! | rho | double precision | Ratio to measure the agreement between the model |
|
||||||
|
! | | | and the reality |
|
||||||
|
! | delta | double precision | Radisu of the trust region |
|
||||||
|
! | norm_grad | double precision | Norm of the gradient |
|
||||||
|
! | info | integer | for dsyev from Lapack |
|
||||||
|
! | max_elem | double precision | maximal element in the gradient |
|
||||||
|
! | v_grad(:) | double precision | Gradient |
|
||||||
|
! | H(:,:) | double precision | Hessian (diagonal) |
|
||||||
|
! | e_val(:) | double precision | Eigenvalues of the hessian |
|
||||||
|
! | W(:,:) | double precision | Eigenvectors of the hessian |
|
||||||
|
! | tmp_x(:) | double precision | Step in 1D (in a subaspace) |
|
||||||
|
! | tmp_m_x(:,:) | double precision | Step in 2D (in a subaspace) |
|
||||||
|
! | tmp_list(:) | double precision | List of MOs in a mo_class |
|
||||||
|
! | i,j,k | integer | Indexes in the full MO space |
|
||||||
|
! | tmp_i, tmp_j, tmp_k | integer | Indexes in a subspace |
|
||||||
|
! | l | integer | Index for the mo_class |
|
||||||
|
! | key(:) | integer | Key to sort the eigenvalues of the hessian |
|
||||||
|
! | nb_iter | integer | Number of iterations |
|
||||||
|
! | must_exit | logical | To exit the trust region loop |
|
||||||
|
! | cancel_step | logical | To cancel a step |
|
||||||
|
! | not_*converged | logical | To localize the different mo classes |
|
||||||
|
! | t* | double precision | To measure the time |
|
||||||
|
! | n | integer | mo_num*(mo_num-1)/2, number of orbital parameters |
|
||||||
|
! | tmp_n | integer | dim_subspace*(dim_subspace-1)/2 |
|
||||||
|
! | | | Number of dimension in the subspace |
|
||||||
|
|
||||||
|
! Variables in qp_edit for the localization:
|
||||||
|
! | localization_method |
|
||||||
|
! | localization_max_nb_iter |
|
||||||
|
! | default_mo_class |
|
||||||
|
! | thresh_loc_max_elem_grad |
|
||||||
|
! | kick_in_mos |
|
||||||
|
! | angle_pre_rot |
|
||||||
|
|
||||||
|
! + all the variables for the trust region
|
||||||
|
|
||||||
|
! Cf. qp_edit orbital optimization
|
||||||
|
|
||||||
|
|
||||||
|
subroutine run_localization
|
||||||
|
|
||||||
|
include 'pi.h'
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Orbital localization
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
double precision, allocatable :: pre_rot(:,:), R(:,:)
|
||||||
|
double precision, allocatable :: prev_mos(:,:), spatial_extent(:), tmp_R(:,:)
|
||||||
|
double precision :: criterion, norm_grad
|
||||||
|
integer :: i,j,k,l,p, tmp_i, tmp_j, tmp_k
|
||||||
|
integer :: info
|
||||||
|
integer :: n, tmp_n, tmp_list_size
|
||||||
|
double precision, allocatable :: v_grad(:), H(:), tmp_m_x(:,:), tmp_x(:),W(:),e_val(:)
|
||||||
|
double precision :: max_elem, t1, t2, t3, t4, t5, t6
|
||||||
|
integer, allocatable :: tmp_list(:), key(:)
|
||||||
|
double precision :: prev_criterion, rho, delta, criterion_model
|
||||||
|
integer :: nb_iter, nb_sub_iter
|
||||||
|
logical :: not_converged, not_core_converged
|
||||||
|
logical :: not_act_converged, not_inact_converged, not_virt_converged
|
||||||
|
logical :: use_trust_region, must_exit, cancel_step,enforce_step_cancellation
|
||||||
|
|
||||||
|
n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(spatial_extent(mo_num))
|
||||||
|
allocate(pre_rot(mo_num, mo_num), R(mo_num, mo_num))
|
||||||
|
allocate(prev_mos(ao_num, mo_num))
|
||||||
|
|
||||||
|
! Locality before the localization
|
||||||
|
call compute_spatial_extent(spatial_extent)
|
||||||
|
|
||||||
|
! Choice of the method
|
||||||
|
print*,''
|
||||||
|
print*,'Localization method:',localization_method
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys localization'
|
||||||
|
elseif (localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey localization'
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
! Localization criterion (FB, PM, ...) for each mo_class
|
||||||
|
print*,'### Before the pre rotation'
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
if (debug_hf) then
|
||||||
|
print*,'HF energy:', HF_energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
do l = 1, 4
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list_size = dim_list_core_orb
|
||||||
|
elseif (l==2) then ! act
|
||||||
|
tmp_list_size = dim_list_act_orb
|
||||||
|
elseif (l==3) then ! inact
|
||||||
|
tmp_list_size = dim_list_inact_orb
|
||||||
|
else ! virt
|
||||||
|
tmp_list_size = dim_list_virt_orb
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Allocation tmp array
|
||||||
|
allocate(tmp_list(tmp_list_size))
|
||||||
|
|
||||||
|
! To give the list of MOs in a mo_class
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list = list_core
|
||||||
|
elseif (l==2) then
|
||||||
|
tmp_list = list_act
|
||||||
|
elseif (l==3) then
|
||||||
|
tmp_list = list_inact
|
||||||
|
else
|
||||||
|
tmp_list = list_virt
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (tmp_list_size >= 2) then
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list,criterion)
|
||||||
|
print*,'Criterion:', criterion, mo_class(tmp_list(1))
|
||||||
|
endif
|
||||||
|
|
||||||
|
deallocate(tmp_list)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
!print*,'HF', HF_energy
|
||||||
|
|
||||||
|
! Loc
|
||||||
|
|
||||||
|
! Pre rotation, to give a little kick in the MOs
|
||||||
|
call apply_pre_rotation()
|
||||||
|
|
||||||
|
! Criterion after the pre rotation
|
||||||
|
! Localization criterion (FB, PM, ...) for each mo_class
|
||||||
|
print*,'### After the pre rotation'
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
if (debug_hf) then
|
||||||
|
touch mo_coef
|
||||||
|
print*,'HF energy:', HF_energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
do l = 1, 4
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list_size = dim_list_core_orb
|
||||||
|
elseif (l==2) then ! act
|
||||||
|
tmp_list_size = dim_list_act_orb
|
||||||
|
elseif (l==3) then ! inact
|
||||||
|
tmp_list_size = dim_list_inact_orb
|
||||||
|
else ! virt
|
||||||
|
tmp_list_size = dim_list_virt_orb
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (tmp_list_size >= 2) then
|
||||||
|
! Allocation tmp array
|
||||||
|
allocate(tmp_list(tmp_list_size))
|
||||||
|
|
||||||
|
! To give the list of MOs in a mo_class
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list = list_core
|
||||||
|
elseif (l==2) then
|
||||||
|
tmp_list = list_act
|
||||||
|
elseif (l==3) then
|
||||||
|
tmp_list = list_inact
|
||||||
|
else
|
||||||
|
tmp_list = list_virt
|
||||||
|
endif
|
||||||
|
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list,criterion)
|
||||||
|
print*,'Criterion:', criterion, trim(mo_class(tmp_list(1)))
|
||||||
|
|
||||||
|
deallocate(tmp_list)
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
!print*,'HF', HF_energy
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'========================'
|
||||||
|
print*,' Orbital localization'
|
||||||
|
print*,'========================'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
!Initialization
|
||||||
|
not_converged = .TRUE.
|
||||||
|
|
||||||
|
! To do the localization only if there is at least 2 MOs
|
||||||
|
if (dim_list_core_orb >= 2) then
|
||||||
|
not_core_converged = .TRUE.
|
||||||
|
else
|
||||||
|
not_core_converged = .FALSE.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (dim_list_act_orb >= 2) then
|
||||||
|
not_act_converged = .TRUE.
|
||||||
|
else
|
||||||
|
not_act_converged = .FALSE.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (dim_list_inact_orb >= 2) then
|
||||||
|
not_inact_converged = .TRUE.
|
||||||
|
else
|
||||||
|
not_inact_converged = .FALSE.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (dim_list_virt_orb >= 2) then
|
||||||
|
not_virt_converged = .TRUE.
|
||||||
|
else
|
||||||
|
not_virt_converged = .FALSE.
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Loop over the mo_classes
|
||||||
|
do l = 1, 4
|
||||||
|
|
||||||
|
if (l==1) then ! core
|
||||||
|
not_converged = not_core_converged
|
||||||
|
tmp_list_size = dim_list_core_orb
|
||||||
|
elseif (l==2) then ! act
|
||||||
|
not_converged = not_act_converged
|
||||||
|
tmp_list_size = dim_list_act_orb
|
||||||
|
elseif (l==3) then ! inact
|
||||||
|
not_converged = not_inact_converged
|
||||||
|
tmp_list_size = dim_list_inact_orb
|
||||||
|
else ! virt
|
||||||
|
not_converged = not_virt_converged
|
||||||
|
tmp_list_size = dim_list_virt_orb
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Next iteration if converged = true
|
||||||
|
if (.not. not_converged) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Allocation tmp array
|
||||||
|
allocate(tmp_list(tmp_list_size))
|
||||||
|
|
||||||
|
! To give the list of MOs in a mo_class
|
||||||
|
if (l==1) then ! core
|
||||||
|
tmp_list = list_core
|
||||||
|
elseif (l==2) then
|
||||||
|
tmp_list = list_act
|
||||||
|
elseif (l==3) then
|
||||||
|
tmp_list = list_inact
|
||||||
|
else
|
||||||
|
tmp_list = list_virt
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (not_converged) then
|
||||||
|
print*,''
|
||||||
|
print*,'###', trim(mo_class(tmp_list(1))), 'MOs ###'
|
||||||
|
print*,''
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Size for the 2D -> 1D transformation
|
||||||
|
tmp_n = tmp_list_size * (tmp_list_size - 1)/2
|
||||||
|
|
||||||
|
! Without hessian + trust region
|
||||||
|
if (.not. localization_use_hessian) then
|
||||||
|
|
||||||
|
! Allocation of temporary arrays
|
||||||
|
allocate(v_grad(tmp_n), tmp_m_x(tmp_list_size, tmp_list_size))
|
||||||
|
allocate(tmp_R(tmp_list_size, tmp_list_size), tmp_x(tmp_n))
|
||||||
|
|
||||||
|
! Criterion
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list, prev_criterion)
|
||||||
|
|
||||||
|
! Init
|
||||||
|
nb_iter = 0
|
||||||
|
delta = 1d0
|
||||||
|
|
||||||
|
!Loop
|
||||||
|
do while (not_converged)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'***********************'
|
||||||
|
print*,'Iteration', nb_iter
|
||||||
|
print*,'***********************'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
! Angles of rotation
|
||||||
|
call theta_localization(tmp_list, tmp_list_size, tmp_m_x, max_elem)
|
||||||
|
tmp_m_x = - tmp_m_x * delta
|
||||||
|
|
||||||
|
! Rotation submatrix
|
||||||
|
call rotation_matrix(tmp_m_x, tmp_list_size, tmp_R, tmp_list_size, tmp_list_size, &
|
||||||
|
info, enforce_step_cancellation)
|
||||||
|
|
||||||
|
! To ensure that the rotation matrix is unitary
|
||||||
|
if (enforce_step_cancellation) then
|
||||||
|
print*, 'Step cancellation, too large error in the rotation matrix'
|
||||||
|
delta = delta * 0.5d0
|
||||||
|
cycle
|
||||||
|
else
|
||||||
|
delta = min(delta * 2d0, 1d0)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Full rotation matrix and application of the rotation
|
||||||
|
call sub_to_full_rotation_matrix(tmp_list_size, tmp_list, tmp_R, R)
|
||||||
|
call apply_mo_rotation(R, prev_mos)
|
||||||
|
|
||||||
|
! Update the needed data
|
||||||
|
call update_data_localization()
|
||||||
|
|
||||||
|
! New criterion
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list, criterion)
|
||||||
|
print*,'Criterion:', trim(mo_class(tmp_list(1))), nb_iter, criterion
|
||||||
|
print*,'Max elem :', max_elem
|
||||||
|
print*,'Delta :', delta
|
||||||
|
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
|
||||||
|
! Exit
|
||||||
|
if (nb_iter >= localization_max_nb_iter .or. dabs(max_elem) < thresh_loc_max_elem_grad) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Save the changes
|
||||||
|
call update_data_localization()
|
||||||
|
call save_mos()
|
||||||
|
TOUCH mo_coef
|
||||||
|
|
||||||
|
! Deallocate
|
||||||
|
deallocate(v_grad, tmp_m_x, tmp_list)
|
||||||
|
deallocate(tmp_R, tmp_x)
|
||||||
|
|
||||||
|
! Trust region
|
||||||
|
else
|
||||||
|
|
||||||
|
! Allocation of temporary arrays
|
||||||
|
allocate(v_grad(tmp_n), H(tmp_n), tmp_m_x(tmp_list_size, tmp_list_size))
|
||||||
|
allocate(tmp_R(tmp_list_size, tmp_list_size))
|
||||||
|
allocate(tmp_x(tmp_n), W(tmp_n), e_val(tmp_n), key(tmp_n))
|
||||||
|
|
||||||
|
! ### Initialization ###
|
||||||
|
delta = 0d0 ! can be deleted (normally)
|
||||||
|
nb_iter = 0 ! Must start at 0 !!!
|
||||||
|
rho = 0.5d0 ! Must be 0.5
|
||||||
|
|
||||||
|
! Compute the criterion before the loop
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list, prev_criterion)
|
||||||
|
|
||||||
|
! Loop until the convergence
|
||||||
|
do while (not_converged)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'***********************'
|
||||||
|
print*,'Iteration', nb_iter
|
||||||
|
print*,'***********************'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
! Gradient
|
||||||
|
call gradient_localization(tmp_n, tmp_list_size, tmp_list, v_grad, max_elem, norm_grad)
|
||||||
|
! Diagonal hessian
|
||||||
|
call hessian_localization(tmp_n, tmp_list_size, tmp_list, H)
|
||||||
|
|
||||||
|
! Diagonalization of the diagonal hessian by hands
|
||||||
|
!call diagonalization_hessian(tmp_n,H,e_val,w)
|
||||||
|
do i = 1, tmp_n
|
||||||
|
e_val(i) = H(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Key list for dsort
|
||||||
|
do i = 1, tmp_n
|
||||||
|
key(i) = i
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Sort of the eigenvalues
|
||||||
|
call dsort(e_val, key, tmp_n)
|
||||||
|
|
||||||
|
! Eigenvectors
|
||||||
|
W = 0d0
|
||||||
|
do i = 1, tmp_n
|
||||||
|
W(i) = dble(key(i))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! To enter in the loop just after
|
||||||
|
cancel_step = .True.
|
||||||
|
nb_sub_iter = 0
|
||||||
|
|
||||||
|
! Loop to reduce the trust radius until the criterion decreases and rho >= thresh_rho
|
||||||
|
do while (cancel_step)
|
||||||
|
print*,'-----------------------------'
|
||||||
|
print*, mo_class(tmp_list(1))
|
||||||
|
print*,'Iteration:', nb_iter
|
||||||
|
print*,'Sub iteration:', nb_sub_iter
|
||||||
|
print*,'Max elem grad:', max_elem
|
||||||
|
print*,'-----------------------------'
|
||||||
|
|
||||||
|
! Hessian,gradient,Criterion -> x
|
||||||
|
call trust_region_step_w_expected_e(tmp_n,1, H, W, e_val, v_grad, prev_criterion, &
|
||||||
|
rho, nb_iter, delta, criterion_model, tmp_x, must_exit)
|
||||||
|
|
||||||
|
! Internal loop exit condition
|
||||||
|
if (must_exit) then
|
||||||
|
print*,'trust_region_step_w_expected_e sent: Exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! 1D tmp -> 2D tmp
|
||||||
|
call vec_to_mat_v2(tmp_n, tmp_list_size, tmp_x, tmp_m_x)
|
||||||
|
|
||||||
|
! Rotation submatrix (square matrix tmp_list_size by tmp_list_size)
|
||||||
|
call rotation_matrix(tmp_m_x, tmp_list_size, tmp_R, tmp_list_size, tmp_list_size, &
|
||||||
|
info, enforce_step_cancellation)
|
||||||
|
|
||||||
|
if (enforce_step_cancellation) then
|
||||||
|
print*, 'Step cancellation, too large error in the rotation matrix'
|
||||||
|
rho = 0d0
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
! tmp_R to R, subspace to full space
|
||||||
|
call sub_to_full_rotation_matrix(tmp_list_size, tmp_list, tmp_R, R)
|
||||||
|
|
||||||
|
! Rotation of the MOs
|
||||||
|
call apply_mo_rotation(R, prev_mos)
|
||||||
|
|
||||||
|
! Update the things related to mo_coef
|
||||||
|
call update_data_localization()
|
||||||
|
|
||||||
|
! Update the criterion
|
||||||
|
call criterion_localization(tmp_list_size, tmp_list, criterion)
|
||||||
|
print*,'Criterion:', trim(mo_class(tmp_list(1))), nb_iter, criterion
|
||||||
|
|
||||||
|
! Criterion -> step accepted or rejected
|
||||||
|
call trust_region_is_step_cancelled(nb_iter, prev_criterion, criterion, &
|
||||||
|
criterion_model, rho, cancel_step)
|
||||||
|
|
||||||
|
! Cancellation of the step, previous MOs
|
||||||
|
if (cancel_step) then
|
||||||
|
mo_coef = prev_mos
|
||||||
|
endif
|
||||||
|
|
||||||
|
nb_sub_iter = nb_sub_iter + 1
|
||||||
|
enddo
|
||||||
|
!call save_mos() !### depend of the time for 1 iteration
|
||||||
|
|
||||||
|
! To exit the external loop if must_exti = .True.
|
||||||
|
if (must_exit) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Step accepted, nb iteration + 1
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
|
||||||
|
! External loop exit conditions
|
||||||
|
if (DABS(max_elem) < thresh_loc_max_elem_grad) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
if (nb_iter > localization_max_nb_iter) then
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Deallocation of temporary arrays
|
||||||
|
deallocate(v_grad, H, tmp_m_x, tmp_R, tmp_list, tmp_x, W, e_val, key)
|
||||||
|
|
||||||
|
! Save the MOs
|
||||||
|
call save_mos()
|
||||||
|
TOUCH mo_coef
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
if (debug_hf) then
|
||||||
|
touch mo_coef
|
||||||
|
print*,'HF energy:', HF_energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Seems unecessary
|
||||||
|
TOUCH mo_coef
|
||||||
|
|
||||||
|
! To sort the MOs using the diagonal elements of the Fock matrix
|
||||||
|
if (sort_mos_by_e) then
|
||||||
|
call run_sort_by_fock_energies()
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Debug
|
||||||
|
if (debug_hf) then
|
||||||
|
touch mo_coef
|
||||||
|
print*,'HF energy:', HF_energy
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Locality after the localization
|
||||||
|
call compute_spatial_extent(spatial_extent)
|
||||||
|
|
||||||
|
end
|
2008
src/mo_localization/localization_sub.irp.f
Normal file
2008
src/mo_localization/localization_sub.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
7
src/mo_localization/org/TANGLE_org_mode.sh
Executable file
7
src/mo_localization/org/TANGLE_org_mode.sh
Executable file
@ -0,0 +1,7 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
list='ls *.org'
|
||||||
|
for element in $list
|
||||||
|
do
|
||||||
|
emacs --batch $element -f org-babel-tangle
|
||||||
|
done
|
28
src/mo_localization/org/break_spatial_sym.org
Normal file
28
src/mo_localization/org/break_spatial_sym.org
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
! A small program to break the spatial symmetry of the MOs.
|
||||||
|
|
||||||
|
! You have to defined your MO classes or set security_mo_class to false
|
||||||
|
! with:
|
||||||
|
! qp set orbital_optimization security_mo_class false
|
||||||
|
|
||||||
|
! The default angle for the rotations is too big for this kind of
|
||||||
|
! application, a value between 1e-3 and 1e-6 should break the spatial
|
||||||
|
! symmetry with just a small change in the energy.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle break_spatial_sym.irp.f
|
||||||
|
program break_spatial_sym
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Break the symmetry of the MOs with a rotation
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
kick_in_mos = .True.
|
||||||
|
TOUCH kick_in_mos
|
||||||
|
|
||||||
|
call set_classes_loc
|
||||||
|
call apply_pre_rotation
|
||||||
|
call unset_classes_loc
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
67
src/mo_localization/org/debug_gradient_loc.org
Normal file
67
src/mo_localization/org/debug_gradient_loc.org
Normal file
@ -0,0 +1,67 @@
|
|||||||
|
#+BEGIN_SRC f90 :comments org :tangle debug_gradient_loc.irp.f
|
||||||
|
program debug_gradient_loc
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Check if the gradient is correct
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: list_size, n
|
||||||
|
integer, allocatable :: list(:)
|
||||||
|
double precision, allocatable :: v_grad(:), v_grad2(:)
|
||||||
|
double precision :: norm, max_elem, threshold, max_error
|
||||||
|
integer :: i, nb_error
|
||||||
|
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
list_size = dim_list_act_orb
|
||||||
|
|
||||||
|
allocate(list(list_size))
|
||||||
|
|
||||||
|
list = list_act
|
||||||
|
|
||||||
|
n = list_size*(list_size-1)/2
|
||||||
|
|
||||||
|
allocate(v_grad(n),v_grad2(n))
|
||||||
|
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys'
|
||||||
|
call gradient_FB(n,list_size,list,v_grad,max_elem,norm)
|
||||||
|
call gradient_FB_omp(n,list_size,list,v_grad2,max_elem,norm)
|
||||||
|
elseif (localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey'
|
||||||
|
call gradient_PM(n,list_size,list,v_grad,max_elem,norm)
|
||||||
|
call gradient_PM(n,list_size,list,v_grad2,max_elem,norm)
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
print*,i,v_grad(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
v_grad = v_grad - v_grad2
|
||||||
|
|
||||||
|
nb_error = 0
|
||||||
|
max_elem = 0d0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (dabs(v_grad(i)) > threshold) then
|
||||||
|
print*,v_grad(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (dabs(v_grad(i)) > max_elem) then
|
||||||
|
max_elem = v_grad(i)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Threshold error', threshold
|
||||||
|
print*, 'Nb error', nb_error
|
||||||
|
print*,'Max error', max_elem
|
||||||
|
|
||||||
|
deallocate(v_grad,v_grad2)
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
67
src/mo_localization/org/debug_hessian_loc.org
Normal file
67
src/mo_localization/org/debug_hessian_loc.org
Normal file
@ -0,0 +1,67 @@
|
|||||||
|
#+BEGIN_SRC f90 :comments org :tangle debug_hessian_loc.irp.f
|
||||||
|
program debug_hessian_loc
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! Check if the hessian is correct
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: list_size, n
|
||||||
|
integer, allocatable :: list(:)
|
||||||
|
double precision, allocatable :: H(:), H2(:)
|
||||||
|
double precision :: threshold, max_error, max_elem
|
||||||
|
integer :: i, nb_error
|
||||||
|
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
list_size = dim_list_act_orb
|
||||||
|
|
||||||
|
allocate(list(list_size))
|
||||||
|
|
||||||
|
list = list_act
|
||||||
|
|
||||||
|
n = list_size*(list_size-1)/2
|
||||||
|
|
||||||
|
allocate(H(n),H2(n))
|
||||||
|
|
||||||
|
if (localization_method == 'boys') then
|
||||||
|
print*,'Foster-Boys'
|
||||||
|
call hessian_FB(n,list_size,list,H)
|
||||||
|
call hessian_FB_omp(n,list_size,list,H2)
|
||||||
|
elseif(localization_method == 'pipek') then
|
||||||
|
print*,'Pipek-Mezey'
|
||||||
|
call hessian_PM(n,list_size,list,H)
|
||||||
|
call hessian_PM(n,list_size,list,H2)
|
||||||
|
else
|
||||||
|
print*,'Unknown localization_method, please select boys or pipek'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
print*,i,H(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
H = H - H2
|
||||||
|
|
||||||
|
nb_error = 0
|
||||||
|
max_elem = 0d0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (dabs(H(i)) > threshold) then
|
||||||
|
print*,H(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (dabs(H(i)) > max_elem) then
|
||||||
|
max_elem = H(i)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Threshold error', threshold
|
||||||
|
print*, 'Nb error', nb_error
|
||||||
|
print*,'Max error', max_elem
|
||||||
|
|
||||||
|
deallocate(H,H2)
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
18
src/mo_localization/org/kick_the_mos.org
Normal file
18
src/mo_localization/org/kick_the_mos.org
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
#+BEGIN_SRC f90 :comments org :tangle kick_the_mos.irp.f
|
||||||
|
program kick_the_mos
|
||||||
|
|
||||||
|
!BEGIN_DOC
|
||||||
|
! To do a small rotation of the MOs
|
||||||
|
!END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
kick_in_mos = .True.
|
||||||
|
TOUCH kick_in_mos
|
||||||
|
|
||||||
|
call set_classes_loc
|
||||||
|
call apply_pre_rotation
|
||||||
|
call unset_classes_loc
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
2899
src/mo_localization/org/localization.org
Normal file
2899
src/mo_localization/org/localization.org
Normal file
File diff suppressed because it is too large
Load Diff
62
src/mo_optimization/83.mo_optimization.bats
Normal file
62
src/mo_optimization/83.mo_optimization.bats
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
#!/usr/bin/env bats
|
||||||
|
|
||||||
|
source $QP_ROOT/tests/bats/common.bats.sh
|
||||||
|
source $QP_ROOT/quantum_package.rc
|
||||||
|
|
||||||
|
|
||||||
|
function run() {
|
||||||
|
thresh=2e-3
|
||||||
|
test_exe scf || skip
|
||||||
|
qp set_file $1
|
||||||
|
qp edit --check
|
||||||
|
qp reset -a
|
||||||
|
qp run scf
|
||||||
|
qp set_frozen_core
|
||||||
|
qp set determinants n_states 2
|
||||||
|
qp set determinants read_wf true
|
||||||
|
qp set mo_two_e_ints io_mo_two_e_integrals None
|
||||||
|
file="$(echo $1 | sed 's/.ezfio//g')"
|
||||||
|
qp run cis
|
||||||
|
qp run debug_gradient_list_opt > $file.debug_g.out
|
||||||
|
err3="$(grep 'Max error:' $file.debug_g.out | awk '{print $3}')"
|
||||||
|
qp run debug_hessian_list_opt > $file.debug_h1.out
|
||||||
|
err1="$(grep 'Max error:' $file.debug_h1.out | awk '{print $3}')"
|
||||||
|
qp run orb_opt > $file.opt1.out
|
||||||
|
energy1="$(grep 'State average energy:' $file.opt1.out | tail -n 1 | awk '{print $4}')"
|
||||||
|
qp set orbital_optimization optimization_method diag
|
||||||
|
qp reset -d
|
||||||
|
qp run scf
|
||||||
|
qp run cis
|
||||||
|
qp run debug_hessian_list_opt > $file.debug_h2.out
|
||||||
|
err2="$(grep 'Max error_H:' $file.debug_h2.out | awk '{print $3}')"
|
||||||
|
qp run orb_opt > $file.opt2.out
|
||||||
|
energy2="$(grep 'State average energy:' $file.opt2.out | tail -n 1 | awk '{print $4}')"
|
||||||
|
qp set orbital_optimization optimization_method full
|
||||||
|
qp reset -d
|
||||||
|
qp run scf
|
||||||
|
eq $energy1 $2 $thresh
|
||||||
|
eq $energy2 $3 $thresh
|
||||||
|
eq $err1 0.0 1e-12
|
||||||
|
eq $err2 0.0 1e-12
|
||||||
|
eq $err3 0.0 1e-12
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "b2_stretched" {
|
||||||
|
run b2_stretched.ezfio -48.9852901484277 -48.9852937541510
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "h2o" {
|
||||||
|
run h2o.ezfio -75.9025622449206 -75.8691844585879
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "h2s" {
|
||||||
|
run h2s.ezfio -398.576255809878 -398.574145943928
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "hbo" {
|
||||||
|
run hbo.ezfio -99.9234823022109 -99.9234763597840
|
||||||
|
}
|
||||||
|
|
||||||
|
@test "hco" {
|
||||||
|
run hco.ezfio -113.204915552241 -113.204905207050
|
||||||
|
}
|
23
src/mo_optimization/EZFIO.cfg
Normal file
23
src/mo_optimization/EZFIO.cfg
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
[optimization_method]
|
||||||
|
type: character*(32)
|
||||||
|
doc: Define the kind of hessian for the orbital optimization full : full hessian, diag : diagonal hessian, none : no hessian
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: full
|
||||||
|
|
||||||
|
[n_det_max_opt]
|
||||||
|
type: integer
|
||||||
|
doc: Maximal number of the determinants in the wf for the orbital optimization (to stop the optimization if n_det > n_det_max_opt)
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 200000
|
||||||
|
|
||||||
|
[optimization_max_nb_iter]
|
||||||
|
type: integer
|
||||||
|
doc: Maximal number of iterations for the orbital optimization
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 20
|
||||||
|
|
||||||
|
[thresh_opt_max_elem_grad]
|
||||||
|
type: double precision
|
||||||
|
doc: Threshold for the convergence, the optimization exits when the biggest element in the gradient is smaller than thresh_optimization_max_elem_grad
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 1.e-5
|
7
src/mo_optimization/NEED
Normal file
7
src/mo_optimization/NEED
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
two_body_rdm
|
||||||
|
hartree_fock
|
||||||
|
cipsi
|
||||||
|
davidson_undressed
|
||||||
|
selectors_full
|
||||||
|
generators_full
|
||||||
|
utils_trust_region
|
74
src/mo_optimization/README.md
Normal file
74
src/mo_optimization/README.md
Normal file
@ -0,0 +1,74 @@
|
|||||||
|
# Orbital optimization
|
||||||
|
|
||||||
|
## Methods
|
||||||
|
Different methods are available:
|
||||||
|
- full hessian
|
||||||
|
```
|
||||||
|
qp set orbital_optimization optimization_method full
|
||||||
|
```
|
||||||
|
- diagonal hessian
|
||||||
|
```
|
||||||
|
qp set orbital_optimization optimization_method diag
|
||||||
|
```
|
||||||
|
- identity matrix
|
||||||
|
```
|
||||||
|
qp set orbital_optimization optimization_method none
|
||||||
|
```
|
||||||
|
|
||||||
|
After the optimization the ezfio contains the optimized orbitals
|
||||||
|
|
||||||
|
## For a fixed number of determinants
|
||||||
|
To optimize the MOs for the actual determinants:
|
||||||
|
```
|
||||||
|
qp run orb_opt
|
||||||
|
```
|
||||||
|
|
||||||
|
## For a complete optimization, i.e, with a larger and larger wave function
|
||||||
|
To optimize the MOs with a larger and larger wave function:
|
||||||
|
```
|
||||||
|
qp run optimization
|
||||||
|
```
|
||||||
|
|
||||||
|
The results are stored in the EZFIO in "mo_optimization/result_opt",
|
||||||
|
with the following format:
|
||||||
|
(1) (2) (3) (4)
|
||||||
|
1: Number of determinants in the wf,
|
||||||
|
2: Cispi energy before the optimization,
|
||||||
|
3: Cipsi energy after the optimization,
|
||||||
|
4: Energy difference between (2) and (3).
|
||||||
|
|
||||||
|
The optimization process if the following:
|
||||||
|
- we do a first cipsi step to obtain a small number of determinants in the wf
|
||||||
|
- we run an orbital optimization for this wf
|
||||||
|
- we do a new cipsi step to double the number of determinants in the wf
|
||||||
|
- we run an orbital optimization for this wf
|
||||||
|
- ...
|
||||||
|
- we do that until the energy difference between (2) and (3) is
|
||||||
|
smaller than the targeted accuracy for the cispi (targeted_accuracy_cipsi in qp edit)
|
||||||
|
or the wf is larger than a given size (n_det_max_opt in qp_edit)
|
||||||
|
- after that you can reset your determinants (qp reset -d) and run a clean Cispi calculation
|
||||||
|
|
||||||
|
### End of the optimization
|
||||||
|
You can choos the number of determinants after what the
|
||||||
|
optimization will stop:
|
||||||
|
```
|
||||||
|
qp set orbital_optimization n_det_max_opt 1e5 # or any number
|
||||||
|
```
|
||||||
|
## Weight of the states
|
||||||
|
You can change the weights of the differents states directly in qp edit.
|
||||||
|
It will affect ths weights used in the orbital optimization.
|
||||||
|
|
||||||
|
# Tests
|
||||||
|
To run the tests:
|
||||||
|
```
|
||||||
|
qp test
|
||||||
|
```
|
||||||
|
|
||||||
|
# Org files
|
||||||
|
The org files are stored in the directory org in order to avoid overwriting on user changes.
|
||||||
|
The org files can be modified, to export the change to the source code, run
|
||||||
|
```
|
||||||
|
./TANGLE_org_mode.sh
|
||||||
|
mv *.irp.f ../.
|
||||||
|
```
|
||||||
|
|
12
src/mo_optimization/class.irp.f
Normal file
12
src/mo_optimization/class.irp.f
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
BEGIN_PROVIDER [ logical, do_only_1h1p ]
|
||||||
|
&BEGIN_PROVIDER [ logical, do_only_cas ]
|
||||||
|
&BEGIN_PROVIDER [ logical, do_ddci ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! In the FCI case, all those are always false
|
||||||
|
END_DOC
|
||||||
|
do_only_1h1p = .False.
|
||||||
|
do_only_cas = .False.
|
||||||
|
do_ddci = .False.
|
||||||
|
END_PROVIDER
|
||||||
|
|
1
src/mo_optimization/constants.h
Normal file
1
src/mo_optimization/constants.h
Normal file
@ -0,0 +1 @@
|
|||||||
|
logical, parameter :: debug=.False.
|
78
src/mo_optimization/debug_gradient_list_opt.irp.f
Normal file
78
src/mo_optimization/debug_gradient_list_opt.irp.f
Normal file
@ -0,0 +1,78 @@
|
|||||||
|
! Debug the gradient
|
||||||
|
|
||||||
|
! *Program to check the gradient*
|
||||||
|
|
||||||
|
! The program compares the result of the first and last code for the
|
||||||
|
! gradient.
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | n | integer | number of orbitals pairs (p,q) p<q |
|
||||||
|
! | v_grad(n) | double precision | Original gradient |
|
||||||
|
! | v_grad2(n) | double precision | Gradient |
|
||||||
|
! | i | integer | index |
|
||||||
|
! | threshold | double precision | threshold for the errors |
|
||||||
|
! | max_error | double precision | maximal error in the gradient |
|
||||||
|
! | nb_error | integer | number of error in the gradient |
|
||||||
|
|
||||||
|
|
||||||
|
program debug_gradient_list
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: v_grad(:), v_grad2(:)
|
||||||
|
integer :: n,m
|
||||||
|
integer :: i
|
||||||
|
double precision :: threshold
|
||||||
|
double precision :: max_error, max_elem, norm
|
||||||
|
integer :: nb_error
|
||||||
|
|
||||||
|
m = dim_list_act_orb
|
||||||
|
! Definition of n
|
||||||
|
n = m*(m-1)/2
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(v_grad(n), v_grad2(n))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
call diagonalize_ci ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Gradient
|
||||||
|
call gradient_list_opt(n,m,list_act,v_grad,max_elem,norm)
|
||||||
|
call first_gradient_list_opt(n,m,list_act,v_grad2)
|
||||||
|
|
||||||
|
|
||||||
|
v_grad = v_grad - v_grad2
|
||||||
|
nb_error = 0
|
||||||
|
max_error = 0d0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(v_grad(i)) > threshold) then
|
||||||
|
print*,i,v_grad(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
|
||||||
|
if (ABS(v_grad(i)) > max_error) then
|
||||||
|
max_error = v_grad(i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'Check the gradient'
|
||||||
|
print*,'Threshold:', threshold
|
||||||
|
print*,'Nb error:', nb_error
|
||||||
|
print*,'Max error:', max_error
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(v_grad,v_grad2)
|
||||||
|
|
||||||
|
end program
|
76
src/mo_optimization/debug_gradient_opt.irp.f
Normal file
76
src/mo_optimization/debug_gradient_opt.irp.f
Normal file
@ -0,0 +1,76 @@
|
|||||||
|
! Debug the gradient
|
||||||
|
|
||||||
|
! *Program to check the gradient*
|
||||||
|
|
||||||
|
! The program compares the result of the first and last code for the
|
||||||
|
! gradient.
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | n | integer | number of orbitals pairs (p,q) p<q |
|
||||||
|
! | v_grad(n) | double precision | Original gradient |
|
||||||
|
! | v_grad2(n) | double precision | Gradient |
|
||||||
|
! | i | integer | index |
|
||||||
|
! | threshold | double precision | threshold for the errors |
|
||||||
|
! | max_error | double precision | maximal error in the gradient |
|
||||||
|
! | nb_error | integer | number of error in the gradient |
|
||||||
|
|
||||||
|
|
||||||
|
program debug_gradient
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: v_grad(:), v_grad2(:)
|
||||||
|
integer :: n
|
||||||
|
integer :: i
|
||||||
|
double precision :: threshold
|
||||||
|
double precision :: max_error, max_elem
|
||||||
|
integer :: nb_error
|
||||||
|
|
||||||
|
! Definition of n
|
||||||
|
n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(v_grad(n), v_grad2(n))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
call diagonalize_ci ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Gradient
|
||||||
|
call first_gradient_opt(n,v_grad)
|
||||||
|
call gradient_opt(n,v_grad2,max_elem)
|
||||||
|
|
||||||
|
v_grad = v_grad - v_grad2
|
||||||
|
nb_error = 0
|
||||||
|
max_error = 0d0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(v_grad(i)) > threshold) then
|
||||||
|
print*,v_grad(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
|
||||||
|
if (ABS(v_grad(i)) > max_error) then
|
||||||
|
max_error = v_grad(i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'Check the gradient'
|
||||||
|
print*,'Threshold :', threshold
|
||||||
|
print*,'Nb error :', nb_error
|
||||||
|
print*,'Max error :', max_error
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(v_grad,v_grad2)
|
||||||
|
|
||||||
|
end program
|
147
src/mo_optimization/debug_hessian_list_opt.irp.f
Normal file
147
src/mo_optimization/debug_hessian_list_opt.irp.f
Normal file
@ -0,0 +1,147 @@
|
|||||||
|
! Debug the hessian
|
||||||
|
|
||||||
|
! *Program to check the hessian matrix*
|
||||||
|
|
||||||
|
! The program compares the result of the first and last code for the
|
||||||
|
! hessian. First of all the 4D hessian and after the 2D hessian.
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | number of MOs |
|
||||||
|
! | optimization_method | string | Method for the orbital optimization: |
|
||||||
|
! | | | - 'full' -> full hessian |
|
||||||
|
! | | | - 'diag' -> diagonal hessian |
|
||||||
|
! | dim_list_act_orb | integer | number of active MOs |
|
||||||
|
! | list_act(dim_list_act_orb) | integer | list of the actives MOs |
|
||||||
|
! | | | |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | m | integer | number of MOs in the list |
|
||||||
|
! | | | (active MOs) |
|
||||||
|
! | n | integer | number of orbitals pairs (p,q) p<q |
|
||||||
|
! | | | n = m*(m-1)/2 |
|
||||||
|
! | H(n,n) | double precision | Original hessian matrix (2D) |
|
||||||
|
! | H2(n,n) | double precision | Hessian matrix (2D) |
|
||||||
|
! | h_f(mo_num,mo_num,mo_num,mo_num) | double precision | Original hessian matrix (4D) |
|
||||||
|
! | h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D) |
|
||||||
|
! | i,j,p,q,k | integer | indexes |
|
||||||
|
! | threshold | double precision | threshold for the errors |
|
||||||
|
! | max_error | double precision | maximal error in the 4D hessian |
|
||||||
|
! | max_error_H | double precision | maximal error in the 2D hessian |
|
||||||
|
! | nb_error | integer | number of errors in the 4D hessian |
|
||||||
|
! | nb_error_H | integer | number of errors in the 2D hessian |
|
||||||
|
|
||||||
|
|
||||||
|
program debug_hessian_list_opt
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
|
||||||
|
integer :: n,m
|
||||||
|
integer :: i,j,k,l
|
||||||
|
double precision :: max_error, max_error_H
|
||||||
|
integer :: nb_error, nb_error_H
|
||||||
|
double precision :: threshold
|
||||||
|
|
||||||
|
m = dim_list_act_orb !mo_num
|
||||||
|
|
||||||
|
! Definition of n
|
||||||
|
n = m*(m-1)/2
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Hessian
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
print*,'Use the full hessian matrix'
|
||||||
|
allocate(H(n,n),H2(n,n))
|
||||||
|
allocate(h_f(m,m,m,m),h_f2(m,m,m,m))
|
||||||
|
|
||||||
|
call hessian_list_opt(n,m,list_act,H,h_f)
|
||||||
|
call first_hessian_list_opt(n,m,list_act,H2,h_f2)
|
||||||
|
!call hessian_opt(n,H2,h_f2)
|
||||||
|
|
||||||
|
! Difference
|
||||||
|
h_f = h_f - h_f2
|
||||||
|
H = H - H2
|
||||||
|
max_error = 0d0
|
||||||
|
nb_error = 0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do l = 1, m
|
||||||
|
do k= 1, m
|
||||||
|
do j = 1, m
|
||||||
|
do i = 1, m
|
||||||
|
if (ABS(h_f(i,j,k,l)) > threshold) then
|
||||||
|
print*,h_f(i,j,k,l)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
|
||||||
|
max_error = h_f(i,j,k,l)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
max_error_H = 0d0
|
||||||
|
nb_error_H = 0
|
||||||
|
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(H(i,j)) > threshold) then
|
||||||
|
print*, H(i,j)
|
||||||
|
nb_error_H = nb_error_H + 1
|
||||||
|
|
||||||
|
if (ABS(H(i,j)) > ABS(max_error_H)) then
|
||||||
|
max_error_H = H(i,j)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(H, H2, h_f, h_f2)
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
print*, 'Use the diagonal hessian matrix'
|
||||||
|
allocate(H(n,1),H2(n,1))
|
||||||
|
call diag_hessian_list_opt(n,m,list_act,H)
|
||||||
|
call first_diag_hessian_list_opt(n,m,list_act,H2)
|
||||||
|
|
||||||
|
H = H - H2
|
||||||
|
|
||||||
|
max_error_H = 0d0
|
||||||
|
nb_error_H = 0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(H(i,1)) > threshold) then
|
||||||
|
print*, H(i,1)
|
||||||
|
nb_error_H = nb_error_H + 1
|
||||||
|
|
||||||
|
if (ABS(H(i,1)) > ABS(max_error_H)) then
|
||||||
|
max_error_H = H(i,1)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
print*,'Check of the full hessian'
|
||||||
|
print*,'Threshold:', threshold
|
||||||
|
print*,'Nb error:', nb_error
|
||||||
|
print*,'Max error:', max_error
|
||||||
|
print*,''
|
||||||
|
else
|
||||||
|
print*,'Check of the diagonal hessian'
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,'Nb error_H:', nb_error_H
|
||||||
|
print*,'Max error_H:', max_error_H
|
||||||
|
|
||||||
|
end program
|
171
src/mo_optimization/debug_hessian_opt.irp.f
Normal file
171
src/mo_optimization/debug_hessian_opt.irp.f
Normal file
@ -0,0 +1,171 @@
|
|||||||
|
! Debug the hessian
|
||||||
|
|
||||||
|
! *Program to check the hessian matrix*
|
||||||
|
|
||||||
|
! The program compares the result of the first and last code for the
|
||||||
|
! hessian. First of all the 4D hessian and after the 2D hessian.
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | n | integer | number of orbitals pairs (p,q) p<q |
|
||||||
|
! | H(n,n) | double precision | Original hessian matrix (2D) |
|
||||||
|
! | H2(n,n) | double precision | Hessian matrix (2D) |
|
||||||
|
! | h_f(mo_num,mo_num,mo_num,mo_num) | double precision | Original hessian matrix (4D) |
|
||||||
|
! | h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D) |
|
||||||
|
! | method | integer | - 1: full hessian |
|
||||||
|
! | | | - 2: diagonal hessian |
|
||||||
|
! | i,j,p,q,k | integer | indexes |
|
||||||
|
! | threshold | double precision | threshold for the errors |
|
||||||
|
! | max_error | double precision | maximal error in the 4D hessian |
|
||||||
|
! | max_error_H | double precision | maximal error in the 2D hessian |
|
||||||
|
! | nb_error | integer | number of errors in the 4D hessian |
|
||||||
|
! | nb_error_H | integer | number of errors in the 2D hessian |
|
||||||
|
|
||||||
|
|
||||||
|
program debug_hessian
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
|
||||||
|
integer :: n
|
||||||
|
integer :: i,j,k,l
|
||||||
|
double precision :: max_error, max_error_H
|
||||||
|
integer :: nb_error, nb_error_H
|
||||||
|
double precision :: threshold
|
||||||
|
|
||||||
|
! Definition of n
|
||||||
|
n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(H(n,n),H2(n,n))
|
||||||
|
allocate(h_f(mo_num,mo_num,mo_num,mo_num),h_f2(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
! Hessian
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
|
||||||
|
print*,'Use the full hessian matrix'
|
||||||
|
call hessian_opt(n,H,h_f)
|
||||||
|
call first_hessian_opt(n,H2,h_f2)
|
||||||
|
|
||||||
|
! Difference
|
||||||
|
h_f = h_f - h_f2
|
||||||
|
H = H - H2
|
||||||
|
max_error = 0d0
|
||||||
|
nb_error = 0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k= 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
if (ABS(h_f(i,j,k,l)) > threshold) then
|
||||||
|
print*,h_f(i,j,k,l)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
|
||||||
|
max_error = h_f(i,j,k,l)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
max_error_H = 0d0
|
||||||
|
nb_error_H = 0
|
||||||
|
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(H(i,j)) > threshold) then
|
||||||
|
print*, H(i,j)
|
||||||
|
nb_error_H = nb_error_H + 1
|
||||||
|
|
||||||
|
if (ABS(H(i,j)) > ABS(max_error_H)) then
|
||||||
|
max_error_H = H(i,j)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif (optimization_method == 'diag') then
|
||||||
|
|
||||||
|
print*, 'Use the diagonal hessian matrix'
|
||||||
|
call diag_hessian_opt(n,H,h_f)
|
||||||
|
call first_diag_hessian_opt(n,H2,h_f2)
|
||||||
|
|
||||||
|
h_f = h_f - h_f2
|
||||||
|
max_error = 0d0
|
||||||
|
nb_error = 0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
|
||||||
|
if (ABS(h_f(i,j,k,l)) > threshold) then
|
||||||
|
|
||||||
|
print*,h_f(i,j,k,l)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
|
||||||
|
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
|
||||||
|
max_error = h_f(i,j,k,l)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
h=H-H2
|
||||||
|
|
||||||
|
max_error_H = 0d0
|
||||||
|
nb_error_H = 0
|
||||||
|
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(H(i,j)) > threshold) then
|
||||||
|
print*, H(i,j)
|
||||||
|
nb_error_H = nb_error_H + 1
|
||||||
|
|
||||||
|
if (ABS(H(i,j)) > ABS(max_error_H)) then
|
||||||
|
max_error_H = H(i,j)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
print*,'Unknown optimization_method, please select full, diag'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
print*,'Check the full hessian'
|
||||||
|
else
|
||||||
|
print*,'Check the diagonal hessian'
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,'Threshold :', threshold
|
||||||
|
print*,'Nb error :', nb_error
|
||||||
|
print*,'Max error :', max_error
|
||||||
|
print*,''
|
||||||
|
print*,'Nb error_H :', nb_error_H
|
||||||
|
print*,'Max error_H :', max_error_H
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(H,H2,h_f,h_f2)
|
||||||
|
|
||||||
|
end program
|
1556
src/mo_optimization/diagonal_hessian_list_opt.irp.f
Normal file
1556
src/mo_optimization/diagonal_hessian_list_opt.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
1511
src/mo_optimization/diagonal_hessian_opt.irp.f
Normal file
1511
src/mo_optimization/diagonal_hessian_opt.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
136
src/mo_optimization/diagonalization_hessian.irp.f
Normal file
136
src/mo_optimization/diagonalization_hessian.irp.f
Normal file
@ -0,0 +1,136 @@
|
|||||||
|
! Diagonalization of the hessian
|
||||||
|
|
||||||
|
! Just a matrix diagonalization using Lapack
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | n | integer | mo_num*(mo_num-1)/2 |
|
||||||
|
! | H(n,n) | double precision | hessian |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | e_val(n) | double precision | eigenvalues of the hessian |
|
||||||
|
! | w(n,n) | double precision | eigenvectors of the hessian |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | nb_negative_nv | integer | number of negative eigenvalues |
|
||||||
|
! | lwork | integer | for Lapack |
|
||||||
|
! | work(lwork,n) | double precision | temporary array for Lapack |
|
||||||
|
! | info | integer | if 0 -> ok, else problem in the diagonalization |
|
||||||
|
! | i,j | integer | dummy indexes |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine diagonalization_hessian(n,H,e_val,w)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
double precision, intent(in) :: H(n,n)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: e_val(n), w(n,n)
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: work(:,:)
|
||||||
|
integer, allocatable :: key(:)
|
||||||
|
integer :: info,lwork
|
||||||
|
integer :: i,j
|
||||||
|
integer :: nb_negative_vp
|
||||||
|
double precision :: t1,t2,t3,max_elem
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---Diagonalization_hessian---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
! Allocation
|
||||||
|
! For Lapack
|
||||||
|
lwork=3*n-1
|
||||||
|
|
||||||
|
allocate(work(lwork,n))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
! Copy the hessian matrix, the eigenvectors will be store in W
|
||||||
|
W=H
|
||||||
|
|
||||||
|
! Diagonalization of the hessian
|
||||||
|
call dsyev('V','U',n,W,size(W,1),e_val,work,lwork,info)
|
||||||
|
|
||||||
|
if (info /= 0) then
|
||||||
|
print*, 'Error diagonalization : diagonalization_hessian'
|
||||||
|
print*, 'info = ', info
|
||||||
|
call ABORT
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print *, 'vp Hess:'
|
||||||
|
write(*,'(100(F10.5))') real(e_val(:))
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Number of negative eigenvalues
|
||||||
|
max_elem = 0d0
|
||||||
|
nb_negative_vp = 0
|
||||||
|
do i = 1, n
|
||||||
|
if (e_val(i) < 0d0) then
|
||||||
|
nb_negative_vp = nb_negative_vp + 1
|
||||||
|
if (e_val(i) < max_elem) then
|
||||||
|
max_elem = e_val(i)
|
||||||
|
endif
|
||||||
|
!print*,'e_val < 0 :', e_val(i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,'Number of negative eigenvalues:', nb_negative_vp
|
||||||
|
print*,'Lowest eigenvalue:',max_elem
|
||||||
|
|
||||||
|
!nb_negative_vp = 0
|
||||||
|
!do i = 1, n
|
||||||
|
! if (e_val(i) < -thresh_eig) then
|
||||||
|
! nb_negative_vp = nb_negative_vp + 1
|
||||||
|
! endif
|
||||||
|
!enddo
|
||||||
|
!print*,'Number of negative eigenvalues <', -thresh_eig,':', nb_negative_vp
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(work)
|
||||||
|
|
||||||
|
elseif (optimization_method == 'diag') then
|
||||||
|
! Diagonalization of the diagonal hessian by hands
|
||||||
|
allocate(key(n))
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
e_val(i) = H(i,i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Key list for dsort
|
||||||
|
do i = 1, n
|
||||||
|
key(i) = i
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Sort of the eigenvalues
|
||||||
|
call dsort(e_val, key, n)
|
||||||
|
|
||||||
|
! Eigenvectors
|
||||||
|
W = 0d0
|
||||||
|
do i = 1, n
|
||||||
|
j = key(i)
|
||||||
|
W(j,i) = 1d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(key)
|
||||||
|
else
|
||||||
|
print*,'Diagonalization_hessian, abort'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in diagonalization_hessian:', t3
|
||||||
|
|
||||||
|
print*,'---End diagonalization_hessian---'
|
||||||
|
|
||||||
|
end subroutine
|
372
src/mo_optimization/first_diagonal_hessian_list_opt.irp.f
Normal file
372
src/mo_optimization/first_diagonal_hessian_list_opt.irp.f
Normal file
@ -0,0 +1,372 @@
|
|||||||
|
subroutine first_diag_hessian_list_opt(tmp_n,m,list,H)!, h_tmpr)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!===========================================================================
|
||||||
|
! Compute the diagonal hessian of energy with respects to orbital rotations
|
||||||
|
!===========================================================================
|
||||||
|
|
||||||
|
!===========
|
||||||
|
! Variables
|
||||||
|
!===========
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: tmp_n, m, list(m)
|
||||||
|
! tmp_n : integer, tmp_n = m*(m-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: H(tmp_n)!, h_tmpr(m,m,m,m)
|
||||||
|
! H : n by n double precision matrix containing the 2D hessian
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: hessian(:,:,:,:), tmp(:,:),h_tmpr(:,:,:,:)
|
||||||
|
integer :: p,q, tmp_p,tmp_q
|
||||||
|
integer :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
|
||||||
|
integer :: pq,rs,tmp_pq,tmp_rs
|
||||||
|
double precision :: t1,t2,t3
|
||||||
|
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
|
||||||
|
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
|
||||||
|
! p,q,r,s : integer, indexes of the 4D hessian matrix
|
||||||
|
! t,u,v : integer, indexes to compute hessian elements
|
||||||
|
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
|
||||||
|
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
|
||||||
|
|
||||||
|
! Function
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
! get_two_e_integral : double precision function, two e integrals
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
|
||||||
|
! two_e_dm_mo : two body density matrix
|
||||||
|
|
||||||
|
print*,'---first_diag_hess_list---'
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(hessian(m,m,m,m),tmp(tmp_n,tmp_n),h_tmpr(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
! From Anderson et. al. (2014)
|
||||||
|
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
|
||||||
|
|
||||||
|
! LaTeX formula :
|
||||||
|
|
||||||
|
!\begin{align*}
|
||||||
|
!H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
|
||||||
|
!&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u)
|
||||||
|
!+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
|
||||||
|
!-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
|
||||||
|
!&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv})
|
||||||
|
!+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
|
||||||
|
!&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs} \Gamma_{ps}^{uv}) \\
|
||||||
|
!&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts})
|
||||||
|
!\end{align*}
|
||||||
|
|
||||||
|
!================
|
||||||
|
! Initialization
|
||||||
|
!================
|
||||||
|
hessian = 0d0
|
||||||
|
|
||||||
|
CALL wall_time(t1)
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, first term
|
||||||
|
!========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
|
||||||
|
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! First line, second term
|
||||||
|
!=========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
|
||||||
|
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, third term
|
||||||
|
!========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Second line, first term
|
||||||
|
!=========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
|
||||||
|
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!==========================
|
||||||
|
! Second line, second term
|
||||||
|
!==========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
|
||||||
|
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! Third line, first term
|
||||||
|
!========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
|
||||||
|
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Third line, second term
|
||||||
|
!=========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
|
||||||
|
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
|
||||||
|
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
|
||||||
|
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t2)
|
||||||
|
t2 = t2 - t1
|
||||||
|
print*, 'Time to compute the hessian :', t2
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Permutations
|
||||||
|
!==============
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
do tmp_r = 1, m
|
||||||
|
do tmp_s = 1, m
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
|
||||||
|
h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
|
||||||
|
- hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! 4D matrix -> 2D matrix
|
||||||
|
!========================
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
! 4D mo_num matrix to 2D n matrix
|
||||||
|
do tmp_rs = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
|
||||||
|
do tmp_pq = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
|
||||||
|
tmp(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do p = 1, tmp_n
|
||||||
|
H(p) = tmp(p,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (debug) then
|
||||||
|
print*,'2D diag Hessian matrix'
|
||||||
|
do tmp_pq = 1, tmp_n
|
||||||
|
write(*,'(100(F10.5))') tmp(tmp_pq,:)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(hessian,h_tmpr,tmp)
|
||||||
|
|
||||||
|
print*,'---End first_diag_hess_list---'
|
||||||
|
|
||||||
|
end subroutine
|
344
src/mo_optimization/first_diagonal_hessian_opt.irp.f
Normal file
344
src/mo_optimization/first_diagonal_hessian_opt.irp.f
Normal file
@ -0,0 +1,344 @@
|
|||||||
|
subroutine first_diag_hessian_opt(n,H, h_tmpr)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!===========================================================================
|
||||||
|
! Compute the diagonal hessian of energy with respects to orbital rotations
|
||||||
|
!===========================================================================
|
||||||
|
|
||||||
|
!===========
|
||||||
|
! Variables
|
||||||
|
!===========
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
! n : integer, n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: H(n,n), h_tmpr(mo_num,mo_num,mo_num,mo_num)
|
||||||
|
! H : n by n double precision matrix containing the 2D hessian
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: hessian(:,:,:,:)
|
||||||
|
integer :: p,q
|
||||||
|
integer :: r,s,t,u,v
|
||||||
|
integer :: pq,rs
|
||||||
|
double precision :: t1,t2,t3
|
||||||
|
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
|
||||||
|
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
|
||||||
|
! p,q,r,s : integer, indexes of the 4D hessian matrix
|
||||||
|
! t,u,v : integer, indexes to compute hessian elements
|
||||||
|
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
|
||||||
|
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
|
||||||
|
|
||||||
|
! Function
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
! get_two_e_integral : double precision function, two e integrals
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
|
||||||
|
! two_e_dm_mo : two body density matrix
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(hessian(mo_num,mo_num,mo_num,mo_num))!,h_tmpr(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'Enter in first_diag_hessien'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! From Anderson et. al. (2014)
|
||||||
|
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
|
||||||
|
|
||||||
|
! LaTeX formula :
|
||||||
|
|
||||||
|
!\begin{align*}
|
||||||
|
!H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
|
||||||
|
!&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u)
|
||||||
|
!+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
|
||||||
|
!-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
|
||||||
|
!&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv})
|
||||||
|
!+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
|
||||||
|
!&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs} \Gamma_{ps}^{uv}) \\
|
||||||
|
!&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts})
|
||||||
|
!\end{align*}
|
||||||
|
|
||||||
|
!================
|
||||||
|
! Initialization
|
||||||
|
!================
|
||||||
|
hessian = 0d0
|
||||||
|
|
||||||
|
CALL wall_time(t1)
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, first term
|
||||||
|
!========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
|
||||||
|
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! First line, second term
|
||||||
|
!=========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
|
||||||
|
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, third term
|
||||||
|
!========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Second line, first term
|
||||||
|
!=========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
|
||||||
|
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!==========================
|
||||||
|
! Second line, second term
|
||||||
|
!==========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
|
||||||
|
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! Third line, first term
|
||||||
|
!========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
|
||||||
|
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Third line, second term
|
||||||
|
!=========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
|
||||||
|
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
|
||||||
|
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
|
||||||
|
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t2)
|
||||||
|
t2 = t2 - t1
|
||||||
|
print*, 'Time to compute the hessian :', t2
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Permutations
|
||||||
|
!==============
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
h_tmpr(p,q,r,s) = (hessian(p,q,r,s) - hessian(q,p,r,s) - hessian(p,q,s,r) + hessian(q,p,s,r))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! 4D matrix -> 2D matrix
|
||||||
|
!========================
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
! 4D mo_num matrix to 2D n matrix
|
||||||
|
do rs = 1, n
|
||||||
|
call vec_to_mat_index(rs,r,s)
|
||||||
|
do pq = 1, n
|
||||||
|
call vec_to_mat_index(pq,p,q)
|
||||||
|
H(pq,rs) = h_tmpr(p,q,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (debug) then
|
||||||
|
print*,'2D diag Hessian matrix'
|
||||||
|
do pq = 1, n
|
||||||
|
write(*,'(100(F10.5))') H(pq,:)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(hessian)
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'Leave first_diag_hessien'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
125
src/mo_optimization/first_gradient_list_opt.irp.f
Normal file
125
src/mo_optimization/first_gradient_list_opt.irp.f
Normal file
@ -0,0 +1,125 @@
|
|||||||
|
! First gradient
|
||||||
|
|
||||||
|
subroutine first_gradient_list_opt(tmp_n,m,list,v_grad)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!===================================================================
|
||||||
|
! Compute the gradient of energy with respects to orbital rotations
|
||||||
|
!===================================================================
|
||||||
|
|
||||||
|
! Check if read_wf = true, else :
|
||||||
|
! qp set determinant read_wf true
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: tmp_n,m,list(m)
|
||||||
|
! n : integer, n = m*(m-1)/2
|
||||||
|
! m = list_size
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: v_grad(tmp_n)
|
||||||
|
! v_grad : double precision vector of length n containeing the gradient
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: grad(:,:),A(:,:)
|
||||||
|
double precision :: norm
|
||||||
|
integer :: i,p,q,r,s,t,tmp_i,tmp_p,tmp_q,tmp_r,tmp_s,tmp_t
|
||||||
|
! grad : double precision matrix containing the gradient before the permutation
|
||||||
|
! A : double precision matrix containing the gradient after the permutation
|
||||||
|
! norm : double precision number, the norm of the vector gradient
|
||||||
|
! i,p,q,r,s,t : integer, indexes
|
||||||
|
! istate : integer, the electronic state
|
||||||
|
|
||||||
|
! Function
|
||||||
|
double precision :: get_two_e_integral, norm2
|
||||||
|
! get_two_e_integral : double precision function that gives the two e integrals
|
||||||
|
! norm2 : double precision function that gives the norm of a vector
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo : one body density matrix (state average)
|
||||||
|
! two_e_dm_mo : two body density matrix (state average)
|
||||||
|
|
||||||
|
print*,'---first_gradient_list---'
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(grad(m,m),A(m,m))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
v_grad = 0d0
|
||||||
|
grad = 0d0
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
!grad(tmp_p,tmp_q) = 0d0
|
||||||
|
do r = 1, mo_num
|
||||||
|
grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do t = 1, mo_num
|
||||||
|
|
||||||
|
grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) &
|
||||||
|
+ get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
|
||||||
|
- get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector
|
||||||
|
do tmp_i = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_i,tmp_p,tmp_q)
|
||||||
|
v_grad(tmp_i)=(grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display, vector containing the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Vector containing the gradient :'
|
||||||
|
write(*,'(100(F10.5))') v_grad(1:tmp_n)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Norm of the vector
|
||||||
|
norm = norm2(v_grad)
|
||||||
|
print*, 'Norm : ', norm
|
||||||
|
|
||||||
|
! Matrix gradient
|
||||||
|
A = 0d0
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
A(tmp_p,tmp_q) = grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display, matrix containting the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Matrix containing the gradient :'
|
||||||
|
do tmp_i = 1, m
|
||||||
|
write(*,'(100(E12.5))') A(tmp_i,1:m)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(grad,A)
|
||||||
|
|
||||||
|
print*,'---End first_gradient_list---'
|
||||||
|
|
||||||
|
end subroutine
|
128
src/mo_optimization/first_gradient_opt.irp.f
Normal file
128
src/mo_optimization/first_gradient_opt.irp.f
Normal file
@ -0,0 +1,128 @@
|
|||||||
|
! First gradient
|
||||||
|
|
||||||
|
subroutine first_gradient_opt(n,v_grad)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!===================================================================
|
||||||
|
! Compute the gradient of energy with respects to orbital rotations
|
||||||
|
!===================================================================
|
||||||
|
|
||||||
|
! Check if read_wf = true, else :
|
||||||
|
! qp set determinant read_wf true
|
||||||
|
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
! n : integer, n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: v_grad(n)
|
||||||
|
! v_grad : double precision vector of length n containeing the gradient
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: grad(:,:),A(:,:)
|
||||||
|
double precision :: norm
|
||||||
|
integer :: i,p,q,r,s,t
|
||||||
|
integer :: istate
|
||||||
|
! grad : double precision matrix containing the gradient before the permutation
|
||||||
|
! A : double precision matrix containing the gradient after the permutation
|
||||||
|
! norm : double precision number, the norm of the vector gradient
|
||||||
|
! i,p,q,r,s,t : integer, indexes
|
||||||
|
! istate : integer, the electronic state
|
||||||
|
|
||||||
|
! Function
|
||||||
|
double precision :: get_two_e_integral, norm2
|
||||||
|
! get_two_e_integral : double precision function that gives the two e integrals
|
||||||
|
! norm2 : double precision function that gives the norm of a vector
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo : one body density matrix (state average)
|
||||||
|
! two_e_dm_mo : two body density matrix (state average)
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(grad(mo_num,mo_num),A(mo_num,mo_num))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'---first_gradient---'
|
||||||
|
endif
|
||||||
|
|
||||||
|
v_grad = 0d0
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
grad(p,q) = 0d0
|
||||||
|
do r = 1, mo_num
|
||||||
|
grad(p,q) = grad(p,q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do t= 1, mo_num
|
||||||
|
|
||||||
|
grad(p,q) = grad(p,q) &
|
||||||
|
+ get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
|
||||||
|
- get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector
|
||||||
|
do i=1,n
|
||||||
|
call vec_to_mat_index(i,p,q)
|
||||||
|
v_grad(i)=(grad(p,q) - grad(q,p))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display, vector containing the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Vector containing the gradient :'
|
||||||
|
write(*,'(100(F10.5))') v_grad(1:n)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Norm of the vector
|
||||||
|
norm = norm2(v_grad)
|
||||||
|
print*, 'Norm : ', norm
|
||||||
|
|
||||||
|
! Matrix gradient
|
||||||
|
A = 0d0
|
||||||
|
do q=1,mo_num
|
||||||
|
do p=1,mo_num
|
||||||
|
A(p,q) = grad(p,q) - grad(q,p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display, matrix containting the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Matrix containing the gradient :'
|
||||||
|
do i = 1, mo_num
|
||||||
|
write(*,'(100(E12.5))') A(i,1:mo_num)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(grad,A)
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'---End first_gradient---'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
365
src/mo_optimization/first_hessian_list_opt.irp.f
Normal file
365
src/mo_optimization/first_hessian_list_opt.irp.f
Normal file
@ -0,0 +1,365 @@
|
|||||||
|
subroutine first_hessian_list_opt(tmp_n,m,list,H,h_tmpr)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!==================================================================
|
||||||
|
! Compute the hessian of energy with respects to orbital rotations
|
||||||
|
!==================================================================
|
||||||
|
|
||||||
|
!===========
|
||||||
|
! Variables
|
||||||
|
!===========
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: tmp_n, m, list(m)
|
||||||
|
!tmp_n : integer, tmp_n = m*(m-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: H(tmp_n,tmp_n),h_tmpr(m,m,m,m)
|
||||||
|
! H : n by n double precision matrix containing the 2D hessian
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: hessian(:,:,:,:)
|
||||||
|
integer :: p,q, tmp_p,tmp_q
|
||||||
|
integer :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
|
||||||
|
integer :: pq,rs,tmp_pq,tmp_rs
|
||||||
|
double precision :: t1,t2,t3,t4,t5,t6
|
||||||
|
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
|
||||||
|
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
|
||||||
|
! p,q,r,s : integer, indexes of the 4D hessian matrix
|
||||||
|
! t,u,v : integer, indexes to compute hessian elements
|
||||||
|
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
|
||||||
|
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
|
||||||
|
|
||||||
|
! Funtion
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
! get_two_e_integral : double precision function, two e integrals
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
|
||||||
|
! two_e_dm_mo : two body density matrix
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(hessian(m,m,m,m))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
print*,'---first_hess_list---'
|
||||||
|
|
||||||
|
! From Anderson et. al. (2014)
|
||||||
|
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
|
||||||
|
|
||||||
|
CALL wall_time(t1)
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
hessian = 0d0
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, first term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
|
||||||
|
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 1 :', t6
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! First line, second term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
|
||||||
|
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 2 :', t6
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, third term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q)&
|
||||||
|
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 3 :', t6
|
||||||
|
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Second line, first term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
|
||||||
|
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l2 1 :', t6
|
||||||
|
|
||||||
|
!==========================
|
||||||
|
! Second line, second term
|
||||||
|
!==========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
|
||||||
|
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l2 2 :', t6
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! Third line, first term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
|
||||||
|
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l3 1 :', t6
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Third line, second term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
|
||||||
|
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
|
||||||
|
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
|
||||||
|
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l3 2 :', t6
|
||||||
|
|
||||||
|
CALL wall_time(t2)
|
||||||
|
t3 = t2 -t1
|
||||||
|
print*,'Time to compute the hessian : ', t3
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Permutations
|
||||||
|
!==============
|
||||||
|
|
||||||
|
! Hessian(p,q,r,s) = P_pq P_rs [ ...]
|
||||||
|
! => Hessian(p,q,r,s) = (p,q,r,s) - (q,p,r,s) - (p,q,s,r) + (q,p,s,r)
|
||||||
|
|
||||||
|
do tmp_s = 1, m
|
||||||
|
do tmp_r = 1, m
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
|
||||||
|
h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = (hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
|
||||||
|
- hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! 4D matrix to 2D matrix
|
||||||
|
!========================
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
! 4D mo_num matrix to 2D n matrix
|
||||||
|
do tmp_pq = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
|
||||||
|
do tmp_rs = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
|
||||||
|
H(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (debug) then
|
||||||
|
print*,'2D Hessian matrix'
|
||||||
|
do tmp_pq = 1, tmp_n
|
||||||
|
write(*,'(100(F10.5))') H(tmp_pq,:)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(hessian)
|
||||||
|
|
||||||
|
print*,'---End first_hess_list---'
|
||||||
|
|
||||||
|
end subroutine
|
360
src/mo_optimization/first_hessian_opt.irp.f
Normal file
360
src/mo_optimization/first_hessian_opt.irp.f
Normal file
@ -0,0 +1,360 @@
|
|||||||
|
subroutine first_hessian_opt(n,H,h_tmpr)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!==================================================================
|
||||||
|
! Compute the hessian of energy with respects to orbital rotations
|
||||||
|
!==================================================================
|
||||||
|
|
||||||
|
!===========
|
||||||
|
! Variables
|
||||||
|
!===========
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
!n : integer, n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: H(n,n),h_tmpr(mo_num,mo_num,mo_num,mo_num)
|
||||||
|
! H : n by n double precision matrix containing the 2D hessian
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: hessian(:,:,:,:)
|
||||||
|
integer :: p,q
|
||||||
|
integer :: r,s,t,u,v
|
||||||
|
integer :: pq,rs
|
||||||
|
double precision :: t1,t2,t3,t4,t5,t6
|
||||||
|
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
|
||||||
|
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
|
||||||
|
! p,q,r,s : integer, indexes of the 4D hessian matrix
|
||||||
|
! t,u,v : integer, indexes to compute hessian elements
|
||||||
|
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
|
||||||
|
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
|
||||||
|
|
||||||
|
! Funtion
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
! get_two_e_integral : double precision function, two e integrals
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
|
||||||
|
! two_e_dm_mo : two body density matrix
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(hessian(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'Enter in first_hess'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! From Anderson et. al. (2014)
|
||||||
|
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
|
||||||
|
|
||||||
|
CALL wall_time(t1)
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
hessian = 0d0
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, first term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
|
||||||
|
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 1 :', t6
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! First line, second term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
|
||||||
|
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 2 :', t6
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, third term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q)&
|
||||||
|
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 3 :', t6
|
||||||
|
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Second line, first term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
|
||||||
|
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l2 1 :', t6
|
||||||
|
|
||||||
|
!==========================
|
||||||
|
! Second line, second term
|
||||||
|
!==========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
|
||||||
|
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l2 2 :', t6
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! Third line, first term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
|
||||||
|
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l3 1 :', t6
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Third line, second term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
|
||||||
|
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
|
||||||
|
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
|
||||||
|
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l3 2 :', t6
|
||||||
|
|
||||||
|
CALL wall_time(t2)
|
||||||
|
t3 = t2 -t1
|
||||||
|
print*,'Time to compute the hessian : ', t3
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Permutations
|
||||||
|
!==============
|
||||||
|
|
||||||
|
! Hessian(p,q,r,s) = P_pq P_rs [ ...]
|
||||||
|
! => Hessian(p,q,r,s) = (p,q,r,s) - (q,p,r,s) - (p,q,s,r) + (q,p,s,r)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
h_tmpr(p,q,r,s) = (hessian(p,q,r,s) - hessian(q,p,r,s) - hessian(p,q,s,r) + hessian(q,p,s,r))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! 4D matrix to 2D matrix
|
||||||
|
!========================
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
! 4D mo_num matrix to 2D n matrix
|
||||||
|
do pq = 1, n
|
||||||
|
call vec_to_mat_index(pq,p,q)
|
||||||
|
do rs = 1, n
|
||||||
|
call vec_to_mat_index(rs,r,s)
|
||||||
|
H(pq,rs) = h_tmpr(p,q,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (debug) then
|
||||||
|
print*,'2D Hessian matrix'
|
||||||
|
do pq = 1, n
|
||||||
|
write(*,'(100(F10.5))') H(pq,:)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(hessian)
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'Leave first_hess'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
381
src/mo_optimization/gradient_list_opt.irp.f
Normal file
381
src/mo_optimization/gradient_list_opt.irp.f
Normal file
@ -0,0 +1,381 @@
|
|||||||
|
! Gradient
|
||||||
|
|
||||||
|
! The gradient of the CI energy with respects to the orbital rotation
|
||||||
|
! is:
|
||||||
|
! (C-c C-x C-l)
|
||||||
|
! $$
|
||||||
|
! G(p,q) = \mathcal{P}_{pq} \left[ \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
|
||||||
|
! \sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
|
||||||
|
! \right]
|
||||||
|
! $$
|
||||||
|
|
||||||
|
|
||||||
|
! $$
|
||||||
|
! \mathcal{P}_{pq}= 1 - (p \leftrightarrow q)
|
||||||
|
! $$
|
||||||
|
|
||||||
|
! $$
|
||||||
|
! G(p,q) = \left[
|
||||||
|
! \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
|
||||||
|
! \sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
|
||||||
|
! \right] -
|
||||||
|
! \left[
|
||||||
|
! \sum_r (h_q^r \gamma_r^p - h_r^p \gamma_q^r) +
|
||||||
|
! \sum_{rst}(v_{qt}^{rs} \Gamma_{rs}^{pt} - v_{rs}^{pt}
|
||||||
|
! \Gamma_{qt}^{rs})
|
||||||
|
! \right]
|
||||||
|
! $$
|
||||||
|
|
||||||
|
! Where p,q,r,s,t are general spatial orbitals
|
||||||
|
! mo_num : the number of molecular orbitals
|
||||||
|
! $$h$$ : One electron integrals
|
||||||
|
! $$\gamma$$ : One body density matrix (state average in our case)
|
||||||
|
! $$v$$ : Two electron integrals
|
||||||
|
! $$\Gamma$$ : Two body density matrice (state average in our case)
|
||||||
|
|
||||||
|
! The gradient is a mo_num by mo_num matrix, p,q,r,s,t take all the
|
||||||
|
! values between 1 and mo_num (1 and mo_num include).
|
||||||
|
|
||||||
|
! To do that we compute $$G(p,q)$$ for all the pairs (p,q).
|
||||||
|
|
||||||
|
! Source :
|
||||||
|
! Seniority-based coupled cluster theory
|
||||||
|
! J. Chem. Phys. 141, 244104 (2014); https://doi.org/10.1063/1.4904384
|
||||||
|
! Thomas M. Henderson, Ireneusz W. Bulik, Tamar Stein, and Gustavo
|
||||||
|
! E. Scuseria
|
||||||
|
|
||||||
|
! *Compute the gradient of energy with respects to orbital rotations*
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | number of MOs |
|
||||||
|
! | mo_one_e_integrals(mo_num,mo_num) | double precision | mono_electronic integrals |
|
||||||
|
! | one_e_dm_mo(mo_num,mo_num) | double precision | one e- density matrix |
|
||||||
|
! | two_e_dm_mo(mo_num,mo_num,mo_num,mo_num) | double precision | two e- density matrix |
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | n | integer | mo_num*(mo_num-1)/2 |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | v_grad(n) | double precision | the gradient |
|
||||||
|
! | max_elem | double precision | maximum element of the gradient |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | grad(mo_num,mo_num) | double precison | gradient before the tranformation in a vector |
|
||||||
|
! | A((mo_num,mo_num) | doubre precision | gradient after the permutations |
|
||||||
|
! | norm | double precision | norm of the gradient |
|
||||||
|
! | p, q | integer | indexes of the element in the matrix grad |
|
||||||
|
! | i | integer | index for the tranformation in a vector |
|
||||||
|
! | r, s, t | integer | indexes dor the sums |
|
||||||
|
! | t1, t2, t3 | double precision | t3 = t2 - t1, time to compute the gradient |
|
||||||
|
! | t4, t5, t6 | double precission | t6 = t5 - t4, time to compute each element |
|
||||||
|
! | tmp_bi_int_3(mo_num,mo_num,mo_num) | double precision | 3 indexes temporary array for the bi-electronic integrals |
|
||||||
|
! | tmp_2rdm_3(mo_num,mo_num,mo_num) | double precision | 3 indexes temporary array for the two e- density matrix |
|
||||||
|
! | tmp_accu(mo_num,mo_num) | double precision | temporary array |
|
||||||
|
|
||||||
|
! Function:
|
||||||
|
! | get_two_e_integral | double precision | bi-electronic integrals |
|
||||||
|
! | dnrm2 | double precision | (Lapack) norm |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine gradient_list_opt(n,m,list,v_grad,max_elem,norm)
|
||||||
|
use omp_lib
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n,m,list(m)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: v_grad(n), max_elem, norm
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: grad(:,:),A(:,:)
|
||||||
|
integer :: i,p,q,r,s,t, tmp_p, tmp_q, tmp_i
|
||||||
|
double precision :: t1,t2,t3,t4,t5,t6
|
||||||
|
|
||||||
|
double precision, allocatable :: tmp_accu(:,:), tmp_mo_one_e_integrals(:,:),tmp_one_e_dm_mo(:,:)
|
||||||
|
double precision, allocatable :: tmp_bi_int_3(:,:,:), tmp_2rdm_3(:,:,:)
|
||||||
|
|
||||||
|
! Functions
|
||||||
|
double precision :: get_two_e_integral, dnrm2
|
||||||
|
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---gradient---'
|
||||||
|
|
||||||
|
! Allocation of shared arrays
|
||||||
|
allocate(grad(m,m),A(m,m))
|
||||||
|
allocate(tmp_mo_one_e_integrals(m,mo_num),tmp_one_e_dm_mo(mo_num,m))
|
||||||
|
|
||||||
|
|
||||||
|
! Initialization omp
|
||||||
|
call omp_set_max_active_levels(1)
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP PRIVATE( &
|
||||||
|
!$OMP p,q,r,s,t,tmp_p,tmp_q, &
|
||||||
|
!$OMP tmp_accu,tmp_bi_int_3, tmp_2rdm_3) &
|
||||||
|
!$OMP SHARED(grad, one_e_dm_mo,m,list,mo_num,mo_one_e_integrals, &
|
||||||
|
!$OMP mo_integrals_map,tmp_one_e_dm_mo, tmp_mo_one_e_integrals,t4,t5,t6) &
|
||||||
|
!$OMP DEFAULT(SHARED)
|
||||||
|
|
||||||
|
! Allocation of private arrays
|
||||||
|
allocate(tmp_accu(m,m))
|
||||||
|
allocate(tmp_bi_int_3(mo_num,mo_num,m))
|
||||||
|
allocate(tmp_2rdm_3(mo_num,mo_num,m))
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
grad(tmp_p,tmp_q) = 0d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
! Term 1
|
||||||
|
|
||||||
|
! Without optimization the term 1 is :
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! grad(p,q) = grad(p,q) &
|
||||||
|
! + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
|
||||||
|
! - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
! Since the matrix multiplication A.B is defined like :
|
||||||
|
! \begin{equation}
|
||||||
|
! c_{ij} = \sum_k a_{ik}.b_{kj}
|
||||||
|
! \end{equation}
|
||||||
|
! The previous equation can be rewritten as a matrix multplication
|
||||||
|
|
||||||
|
|
||||||
|
!****************
|
||||||
|
! Opt first term
|
||||||
|
!****************
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do r = 1, mo_num
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
tmp_mo_one_e_integrals(tmp_p,r) = mo_one_e_integrals(p,r)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do r = 1, mo_num
|
||||||
|
tmp_one_e_dm_mo(r,tmp_q) = one_e_dm_mo(r,q)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
call dgemm('N','N',m,m,mo_num,1d0,&
|
||||||
|
tmp_mo_one_e_integrals, size(tmp_mo_one_e_integrals,1),&
|
||||||
|
tmp_one_e_dm_mo,size(tmp_one_e_dm_mo,1),0d0,tmp_accu,size(tmp_accu,1))
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
|
||||||
|
grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + (tmp_accu(tmp_p,tmp_q) - tmp_accu(tmp_q,tmp_p))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t4)
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
! call dgemm('N','N',mo_num,mo_num,mo_num,1d0,mo_one_e_integrals,&
|
||||||
|
! mo_num,one_e_dm_mo,mo_num,0d0,tmp_accu,mo_num)
|
||||||
|
!
|
||||||
|
! !$OMP DO
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do p = 1, mo_num
|
||||||
|
!
|
||||||
|
! grad(p,q) = grad(p,q) + (tmp_accu(p,q) - tmp_accu(q,p))
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! !$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'Gradient, first term (s) :', t6
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
! Term 2
|
||||||
|
|
||||||
|
! Without optimization the second term is :
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
! do t= 1, mo_num
|
||||||
|
|
||||||
|
! grad(p,q) = grad(p,q) &
|
||||||
|
! + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
|
||||||
|
! - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
! Using the bielectronic integral properties :
|
||||||
|
! get_two_e_integral(p,t,r,s,mo_integrals_map) = get_two_e_integral(r,s,p,t,mo_integrals_map)
|
||||||
|
|
||||||
|
! Using the two body matrix properties :
|
||||||
|
! two_e_dm_mo(p,t,r,s) = two_e_dm_mo(r,s,p,t)
|
||||||
|
|
||||||
|
! t is one the right, we can put it on the external loop and create 3
|
||||||
|
! indexes temporary array
|
||||||
|
! r,s can be seen as one index
|
||||||
|
|
||||||
|
! By doing so, a matrix multiplication appears
|
||||||
|
|
||||||
|
|
||||||
|
!*****************
|
||||||
|
! Opt second term
|
||||||
|
!*****************
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t4)
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do t = 1, mo_num
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
|
||||||
|
tmp_bi_int_3(r,s,tmp_p) = get_two_e_integral(r,s,p,t,mo_integrals_map)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
|
||||||
|
tmp_2rdm_3(r,s,tmp_q) = two_e_dm_mo(r,s,q,t)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call dgemm('T','N',m,m,mo_num*mo_num,1d0,tmp_bi_int_3,&
|
||||||
|
mo_num*mo_num,tmp_2rdm_3,mo_num*mo_num,0d0,tmp_accu,size(tmp_accu,1))
|
||||||
|
|
||||||
|
!$OMP CRITICAL
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
|
||||||
|
grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + tmp_accu(tmp_p,tmp_q) - tmp_accu(tmp_q,tmp_p)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'Gradient second term (s) : ', t6
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
! Deallocation of private arrays
|
||||||
|
|
||||||
|
deallocate(tmp_bi_int_3,tmp_2rdm_3,tmp_accu)
|
||||||
|
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call omp_set_max_active_levels(4)
|
||||||
|
|
||||||
|
! Permutation, 2D matrix -> vector, transformation
|
||||||
|
! In addition there is a permutation in the gradient formula :
|
||||||
|
! \begin{equation}
|
||||||
|
! P_{pq} = 1 - (p <-> q)
|
||||||
|
! \end{equation}
|
||||||
|
|
||||||
|
! We need a vector to use the gradient. Here the gradient is a
|
||||||
|
! antisymetric matrix so we can transform it in a vector of length
|
||||||
|
! mo_num*(mo_num-1)/2.
|
||||||
|
|
||||||
|
! Here we do these two things at the same time.
|
||||||
|
|
||||||
|
|
||||||
|
do i=1,n
|
||||||
|
call vec_to_mat_index(i,p,q)
|
||||||
|
v_grad(i)=(grad(p,q) - grad(q,p))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug, diplay the vector containing the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Vector containing the gradient :'
|
||||||
|
write(*,'(100(F10.5))') v_grad(1:n)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Norm of the gradient
|
||||||
|
! The norm can be useful.
|
||||||
|
|
||||||
|
norm = dnrm2(n,v_grad,1)
|
||||||
|
print*, 'Gradient norm : ', norm
|
||||||
|
|
||||||
|
! Maximum element in the gradient
|
||||||
|
! The maximum element in the gradient is very important for the
|
||||||
|
! convergence criterion of the Newton method.
|
||||||
|
|
||||||
|
|
||||||
|
! Max element of the gradient
|
||||||
|
max_elem = 0d0
|
||||||
|
do i = 1, n
|
||||||
|
if (DABS(v_grad(i)) > DABS(max_elem)) then
|
||||||
|
max_elem = v_grad(i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Max element in the gradient :', max_elem
|
||||||
|
|
||||||
|
! Debug, display the matrix containting the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
! Matrix gradient
|
||||||
|
A = 0d0
|
||||||
|
do q=1,m
|
||||||
|
do p=1,m
|
||||||
|
A(p,q) = grad(p,q) - grad(q,p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'Matrix containing the gradient :'
|
||||||
|
do i = 1, m
|
||||||
|
write(*,'(100(F10.5))') A(i,1:m)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Deallocation of shared arrays and end
|
||||||
|
|
||||||
|
deallocate(grad,A, tmp_mo_one_e_integrals,tmp_one_e_dm_mo)
|
||||||
|
|
||||||
|
print*,'---End gradient---'
|
||||||
|
|
||||||
|
end subroutine
|
346
src/mo_optimization/gradient_opt.irp.f
Normal file
346
src/mo_optimization/gradient_opt.irp.f
Normal file
@ -0,0 +1,346 @@
|
|||||||
|
! Gradient
|
||||||
|
|
||||||
|
! The gradient of the CI energy with respects to the orbital rotation
|
||||||
|
! is:
|
||||||
|
! (C-c C-x C-l)
|
||||||
|
! $$
|
||||||
|
! G(p,q) = \mathcal{P}_{pq} \left[ \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
|
||||||
|
! \sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
|
||||||
|
! \right]
|
||||||
|
! $$
|
||||||
|
|
||||||
|
|
||||||
|
! $$
|
||||||
|
! \mathcal{P}_{pq}= 1 - (p \leftrightarrow q)
|
||||||
|
! $$
|
||||||
|
|
||||||
|
! $$
|
||||||
|
! G(p,q) = \left[
|
||||||
|
! \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
|
||||||
|
! \sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
|
||||||
|
! \right] -
|
||||||
|
! \left[
|
||||||
|
! \sum_r (h_q^r \gamma_r^p - h_r^p \gamma_q^r) +
|
||||||
|
! \sum_{rst}(v_{qt}^{rs} \Gamma_{rs}^{pt} - v_{rs}^{pt}
|
||||||
|
! \Gamma_{qt}^{rs})
|
||||||
|
! \right]
|
||||||
|
! $$
|
||||||
|
|
||||||
|
! Where p,q,r,s,t are general spatial orbitals
|
||||||
|
! mo_num : the number of molecular orbitals
|
||||||
|
! $$h$$ : One electron integrals
|
||||||
|
! $$\gamma$$ : One body density matrix (state average in our case)
|
||||||
|
! $$v$$ : Two electron integrals
|
||||||
|
! $$\Gamma$$ : Two body density matrice (state average in our case)
|
||||||
|
|
||||||
|
! The gradient is a mo_num by mo_num matrix, p,q,r,s,t take all the
|
||||||
|
! values between 1 and mo_num (1 and mo_num include).
|
||||||
|
|
||||||
|
! To do that we compute $$G(p,q)$$ for all the pairs (p,q).
|
||||||
|
|
||||||
|
! Source :
|
||||||
|
! Seniority-based coupled cluster theory
|
||||||
|
! J. Chem. Phys. 141, 244104 (2014); https://doi.org/10.1063/1.4904384
|
||||||
|
! Thomas M. Henderson, Ireneusz W. Bulik, Tamar Stein, and Gustavo
|
||||||
|
! E. Scuseria
|
||||||
|
|
||||||
|
! *Compute the gradient of energy with respects to orbital rotations*
|
||||||
|
|
||||||
|
! Provided:
|
||||||
|
! | mo_num | integer | number of MOs |
|
||||||
|
! | mo_one_e_integrals(mo_num,mo_num) | double precision | mono_electronic integrals |
|
||||||
|
! | one_e_dm_mo(mo_num,mo_num) | double precision | one e- density matrix |
|
||||||
|
! | two_e_dm_mo(mo_num,mo_num,mo_num,mo_num) | double precision | two e- density matrix |
|
||||||
|
|
||||||
|
! Input:
|
||||||
|
! | n | integer | mo_num*(mo_num-1)/2 |
|
||||||
|
|
||||||
|
! Output:
|
||||||
|
! | v_grad(n) | double precision | the gradient |
|
||||||
|
! | max_elem | double precision | maximum element of the gradient |
|
||||||
|
|
||||||
|
! Internal:
|
||||||
|
! | grad(mo_num,mo_num) | double precison | gradient before the tranformation in a vector |
|
||||||
|
! | A((mo_num,mo_num) | doubre precision | gradient after the permutations |
|
||||||
|
! | norm | double precision | norm of the gradient |
|
||||||
|
! | p, q | integer | indexes of the element in the matrix grad |
|
||||||
|
! | i | integer | index for the tranformation in a vector |
|
||||||
|
! | r, s, t | integer | indexes dor the sums |
|
||||||
|
! | t1, t2, t3 | double precision | t3 = t2 - t1, time to compute the gradient |
|
||||||
|
! | t4, t5, t6 | double precission | t6 = t5 - t4, time to compute each element |
|
||||||
|
! | tmp_bi_int_3(mo_num,mo_num,mo_num) | double precision | 3 indexes temporary array for the bi-electronic integrals |
|
||||||
|
! | tmp_2rdm_3(mo_num,mo_num,mo_num) | double precision | 3 indexes temporary array for the two e- density matrix |
|
||||||
|
! | tmp_accu(mo_num,mo_num) | double precision | temporary array |
|
||||||
|
|
||||||
|
! Function:
|
||||||
|
! | get_two_e_integral | double precision | bi-electronic integrals |
|
||||||
|
! | dnrm2 | double precision | (Lapack) norm |
|
||||||
|
|
||||||
|
|
||||||
|
subroutine gradient_opt(n,v_grad,max_elem)
|
||||||
|
use omp_lib
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: v_grad(n), max_elem
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: grad(:,:),A(:,:)
|
||||||
|
double precision :: norm
|
||||||
|
integer :: i,p,q,r,s,t
|
||||||
|
double precision :: t1,t2,t3,t4,t5,t6
|
||||||
|
|
||||||
|
double precision, allocatable :: tmp_accu(:,:)
|
||||||
|
double precision, allocatable :: tmp_bi_int_3(:,:,:), tmp_2rdm_3(:,:,:)
|
||||||
|
|
||||||
|
! Functions
|
||||||
|
double precision :: get_two_e_integral, dnrm2
|
||||||
|
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---gradient---'
|
||||||
|
|
||||||
|
! Allocation of shared arrays
|
||||||
|
allocate(grad(mo_num,mo_num),A(mo_num,mo_num))
|
||||||
|
|
||||||
|
! Initialization omp
|
||||||
|
call omp_set_max_active_levels(1)
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP PRIVATE( &
|
||||||
|
!$OMP p,q,r,s,t, &
|
||||||
|
!$OMP tmp_accu, tmp_bi_int_3, tmp_2rdm_3) &
|
||||||
|
!$OMP SHARED(grad, one_e_dm_mo, mo_num,mo_one_e_integrals, &
|
||||||
|
!$OMP mo_integrals_map,t4,t5,t6) &
|
||||||
|
!$OMP DEFAULT(SHARED)
|
||||||
|
|
||||||
|
! Allocation of private arrays
|
||||||
|
allocate(tmp_accu(mo_num,mo_num))
|
||||||
|
allocate(tmp_bi_int_3(mo_num,mo_num,mo_num))
|
||||||
|
allocate(tmp_2rdm_3(mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1,mo_num
|
||||||
|
grad(p,q) = 0d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
! Term 1
|
||||||
|
|
||||||
|
! Without optimization the term 1 is :
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! grad(p,q) = grad(p,q) &
|
||||||
|
! + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
|
||||||
|
! - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
! Since the matrix multiplication A.B is defined like :
|
||||||
|
! \begin{equation}
|
||||||
|
! c_{ij} = \sum_k a_{ik}.b_{kj}
|
||||||
|
! \end{equation}
|
||||||
|
! The previous equation can be rewritten as a matrix multplication
|
||||||
|
|
||||||
|
|
||||||
|
!****************
|
||||||
|
! Opt first term
|
||||||
|
!****************
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t4)
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
call dgemm('N','N',mo_num,mo_num,mo_num,1d0,mo_one_e_integrals,&
|
||||||
|
mo_num,one_e_dm_mo,mo_num,0d0,tmp_accu,mo_num)
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
grad(p,q) = grad(p,q) + (tmp_accu(p,q) - tmp_accu(q,p))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'Gradient, first term (s) :', t6
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
! Term 2
|
||||||
|
|
||||||
|
! Without optimization the second term is :
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
! do t= 1, mo_num
|
||||||
|
|
||||||
|
! grad(p,q) = grad(p,q) &
|
||||||
|
! + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
|
||||||
|
! - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
! Using the bielectronic integral properties :
|
||||||
|
! get_two_e_integral(p,t,r,s,mo_integrals_map) = get_two_e_integral(r,s,p,t,mo_integrals_map)
|
||||||
|
|
||||||
|
! Using the two body matrix properties :
|
||||||
|
! two_e_dm_mo(p,t,r,s) = two_e_dm_mo(r,s,p,t)
|
||||||
|
|
||||||
|
! t is one the right, we can put it on the external loop and create 3
|
||||||
|
! indexes temporary array
|
||||||
|
! r,s can be seen as one index
|
||||||
|
|
||||||
|
! By doing so, a matrix multiplication appears
|
||||||
|
|
||||||
|
|
||||||
|
!*****************
|
||||||
|
! Opt second term
|
||||||
|
!*****************
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t4)
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do t = 1, mo_num
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
|
||||||
|
tmp_bi_int_3(r,s,p) = get_two_e_integral(r,s,p,t,mo_integrals_map)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do q = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
|
||||||
|
tmp_2rdm_3(r,s,q) = two_e_dm_mo(r,s,q,t)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call dgemm('T','N',mo_num,mo_num,mo_num*mo_num,1d0,tmp_bi_int_3,&
|
||||||
|
mo_num*mo_num,tmp_2rdm_3,mo_num*mo_num,0d0,tmp_accu,mo_num)
|
||||||
|
|
||||||
|
!$OMP CRITICAL
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
grad(p,q) = grad(p,q) + tmp_accu(p,q) - tmp_accu(q,p)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'Gradient second term (s) : ', t6
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
! Deallocation of private arrays
|
||||||
|
|
||||||
|
deallocate(tmp_bi_int_3,tmp_2rdm_3,tmp_accu)
|
||||||
|
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call omp_set_max_active_levels(4)
|
||||||
|
|
||||||
|
! Permutation, 2D matrix -> vector, transformation
|
||||||
|
! In addition there is a permutation in the gradient formula :
|
||||||
|
! \begin{equation}
|
||||||
|
! P_{pq} = 1 - (p <-> q)
|
||||||
|
! \end{equation}
|
||||||
|
|
||||||
|
! We need a vector to use the gradient. Here the gradient is a
|
||||||
|
! antisymetric matrix so we can transform it in a vector of length
|
||||||
|
! mo_num*(mo_num-1)/2.
|
||||||
|
|
||||||
|
! Here we do these two things at the same time.
|
||||||
|
|
||||||
|
|
||||||
|
do i=1,n
|
||||||
|
call vec_to_mat_index(i,p,q)
|
||||||
|
v_grad(i)=(grad(p,q) - grad(q,p))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug, diplay the vector containing the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Vector containing the gradient :'
|
||||||
|
write(*,'(100(F10.5))') v_grad(1:n)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Norm of the gradient
|
||||||
|
! The norm can be useful.
|
||||||
|
|
||||||
|
norm = dnrm2(n,v_grad,1)
|
||||||
|
print*, 'Gradient norm : ', norm
|
||||||
|
|
||||||
|
! Maximum element in the gradient
|
||||||
|
! The maximum element in the gradient is very important for the
|
||||||
|
! convergence criterion of the Newton method.
|
||||||
|
|
||||||
|
|
||||||
|
! Max element of the gradient
|
||||||
|
max_elem = 0d0
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(v_grad(i)) > ABS(max_elem)) then
|
||||||
|
max_elem = v_grad(i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Max element in the gradient :', max_elem
|
||||||
|
|
||||||
|
! Debug, display the matrix containting the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
! Matrix gradient
|
||||||
|
A = 0d0
|
||||||
|
do q=1,mo_num
|
||||||
|
do p=1,mo_num
|
||||||
|
A(p,q) = grad(p,q) - grad(q,p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'Matrix containing the gradient :'
|
||||||
|
do i = 1, mo_num
|
||||||
|
write(*,'(100(F10.5))') A(i,1:mo_num)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Deallocation of shared arrays and end
|
||||||
|
|
||||||
|
deallocate(grad,A)
|
||||||
|
|
||||||
|
print*,'---End gradient---'
|
||||||
|
|
||||||
|
end subroutine
|
1129
src/mo_optimization/hessian_list_opt.irp.f
Normal file
1129
src/mo_optimization/hessian_list_opt.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
1043
src/mo_optimization/hessian_opt.irp.f
Normal file
1043
src/mo_optimization/hessian_opt.irp.f
Normal file
File diff suppressed because it is too large
Load Diff
141
src/mo_optimization/my_providers.irp.f
Normal file
141
src/mo_optimization/my_providers.irp.f
Normal file
@ -0,0 +1,141 @@
|
|||||||
|
! Dimensions of MOs
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim_core ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of core MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim_core = dim_list_core_orb*(dim_list_core_orb-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim_act ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of active MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim_act = dim_list_act_orb*(dim_list_act_orb-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim_inact ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of inactive MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim_inact = dim_list_inact_orb*(dim_list_inact_orb-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim_virt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of virtual MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim_virt = dim_list_virt_orb*(dim_list_virt_orb-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! Energies/criterions
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, my_st_av_energy ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! State average CI energy
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
!call update_st_av_ci_energy(my_st_av_energy)
|
||||||
|
call state_average_energy(my_st_av_energy)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! With all the MOs
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, my_gradient_opt, (n_mo_dim) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, my_CC1_opt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the energy with respect to the MO rotations, for all the MOs.
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision :: norm_grad
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
call gradient_opt(n_mo_dim, my_gradient_opt, my_CC1_opt, norm_grad)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, my_hessian_opt, (n_mo_dim, n_mo_dim) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the energy with respect to the MO rotations, for all the MOs.
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision, allocatable :: h_f(:,:,:,:)
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
allocate(h_f(mo_num, mo_num, mo_num, mo_num))
|
||||||
|
|
||||||
|
call hessian_list_opt(n_mo_dim, my_hessian_opt, h_f)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! With the list of active MOs
|
||||||
|
! Can be generalized to any mo_class by changing the list/dimension
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, my_gradient_list_opt, (n_mo_dim_act) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, my_CC2_opt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the energy with respect to the MO rotations, only for the active MOs !
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision :: norm_grad
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map !one_e_dm_mo two_e_dm_mo mo_one_e_integrals
|
||||||
|
|
||||||
|
call gradient_list_opt(n_mo_dim_act, dim_list_act_orb, list_act, my_gradient_list_opt, my_CC2_opt, norm_grad)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, my_hessian_list_opt, (n_mo_dim_act, n_mo_dim_act) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the energy with respect to the MO rotations, only for the active MOs !
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision, allocatable :: h_f(:,:,:,:)
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
allocate(h_f(dim_list_act_orb, dim_list_act_orb, dim_list_act_orb, dim_list_act_orb))
|
||||||
|
|
||||||
|
call hessian_list_opt(n_mo_dim_act, dim_list_act_orb, list_act, my_hessian_list_opt, h_f)
|
||||||
|
|
||||||
|
END_PROVIDER
|
86
src/mo_optimization/optimization.irp.f
Normal file
86
src/mo_optimization/optimization.irp.f
Normal file
@ -0,0 +1,86 @@
|
|||||||
|
program optimization
|
||||||
|
|
||||||
|
read_wf = .true. ! must be True for the orbital optimization !!!
|
||||||
|
TOUCH read_wf
|
||||||
|
call run_optimization
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine run_optimization
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision :: e_cipsi, e_opt, delta_e
|
||||||
|
integer :: nb_iter,i
|
||||||
|
logical :: not_converged
|
||||||
|
character (len=100) :: filename
|
||||||
|
|
||||||
|
PROVIDE psi_det psi_coef mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
not_converged = .True.
|
||||||
|
nb_iter = 0
|
||||||
|
|
||||||
|
! To start from the wf
|
||||||
|
N_det_max = max(n_det,5)
|
||||||
|
TOUCH N_det_max
|
||||||
|
|
||||||
|
open(unit=10, file=trim(ezfio_filename)//'/mo_optimization/result_opt')
|
||||||
|
write(10,*) " Ndet E_cipsi E_opt Delta_e"
|
||||||
|
call state_average_energy(e_cipsi)
|
||||||
|
write(10,'(I10, 3F15.7)') n_det, e_cipsi, e_cipsi, 0d0
|
||||||
|
close(10)
|
||||||
|
|
||||||
|
do while (not_converged)
|
||||||
|
print*,''
|
||||||
|
print*,'======================'
|
||||||
|
print*,' Cipsi step:', nb_iter
|
||||||
|
print*,'======================'
|
||||||
|
print*,''
|
||||||
|
print*,'********** cipsi step **********'
|
||||||
|
! cispi calculation
|
||||||
|
call run_stochastic_cipsi
|
||||||
|
|
||||||
|
! State average energy after the cipsi step
|
||||||
|
call state_average_energy(e_cipsi)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'********** optimization step **********'
|
||||||
|
! orbital optimization
|
||||||
|
call run_orb_opt_trust_v2
|
||||||
|
|
||||||
|
! State average energy after the orbital optimization
|
||||||
|
call state_average_energy(e_opt)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'********** diff step **********'
|
||||||
|
! Gain in energy
|
||||||
|
delta_e = e_opt - e_cipsi
|
||||||
|
print*, 'Gain in energy during the orbital optimization:', delta_e
|
||||||
|
|
||||||
|
open(unit=10, file=trim(ezfio_filename)//'/mo_optimization/result_opt', position='append')
|
||||||
|
write(10,'(I10, 3F15.7)') n_det, e_cipsi, e_opt, delta_e
|
||||||
|
close(10)
|
||||||
|
|
||||||
|
! Exit
|
||||||
|
if (delta_e > 1d-12) then
|
||||||
|
print*, 'WARNING, something wrong happened'
|
||||||
|
print*, 'The gain (delta_e) in energy during the optimization process'
|
||||||
|
print*, 'is > 0, but it must be < 0'
|
||||||
|
print*, 'The program will exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (n_det > n_det_max_opt) then
|
||||||
|
print*, 'The number of determinants in the wf > n_det_max_opt'
|
||||||
|
print*, 'The program will exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! To double the number of determinants in the wf
|
||||||
|
N_det_max = int(dble(n_det * 2)*0.9)
|
||||||
|
TOUCH N_det_max
|
||||||
|
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
22
src/mo_optimization/orb_opt.irp.f
Normal file
22
src/mo_optimization/orb_opt.irp.f
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
! Orbital optimization program
|
||||||
|
|
||||||
|
! This is an optimization program for molecular orbitals. It produces
|
||||||
|
! orbital rotations in order to lower the energy of a truncated wave
|
||||||
|
! function.
|
||||||
|
! This program just optimize the orbitals for a fixed number of
|
||||||
|
! determinants. This optimization process must be repeated for different
|
||||||
|
! number of determinants.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! Main program : orb_opt_trust
|
||||||
|
|
||||||
|
|
||||||
|
program orb_opt
|
||||||
|
read_wf = .true. ! must be True for the orbital optimization !!!
|
||||||
|
TOUCH read_wf
|
||||||
|
io_mo_two_e_integrals = 'None'
|
||||||
|
TOUCH io_mo_two_e_integrals
|
||||||
|
call run_orb_opt_trust_v2
|
||||||
|
end
|
7
src/mo_optimization/org/TANGLE_org_mode.sh
Executable file
7
src/mo_optimization/org/TANGLE_org_mode.sh
Executable file
@ -0,0 +1,7 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
list='ls *.org'
|
||||||
|
for element in $list
|
||||||
|
do
|
||||||
|
emacs --batch $element -f org-babel-tangle
|
||||||
|
done
|
17
src/mo_optimization/org/TODO.org
Normal file
17
src/mo_optimization/org/TODO.org
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
TODO:
|
||||||
|
** TODO Keep under surveillance the performance of rotation matrix
|
||||||
|
- is the fix ok ?
|
||||||
|
** DONE Provider state_average_weight
|
||||||
|
** DONE Diagonal hessian for orbital optimization with a list of MOs
|
||||||
|
** DONE Something to force the step cancellation if R.R^T > treshold
|
||||||
|
** TODO Iterative method to compute the rotation matrix
|
||||||
|
- doesn't work actually
|
||||||
|
** DONE Test trust region with polynomial functions
|
||||||
|
** DONE Optimization/Localization program using the template
|
||||||
|
** DONE Correction OMP hessian shared/private arrays
|
||||||
|
** DONE State average energy
|
||||||
|
** DONE Correction of Rho
|
||||||
|
** TODO Check the PROVIDE/FREE/TOUCH
|
||||||
|
** TODO research of lambda without the power 2
|
||||||
|
** DONE Clean the OMP sections
|
||||||
|
|
79
src/mo_optimization/org/debug_gradient_list_opt.org
Normal file
79
src/mo_optimization/org/debug_gradient_list_opt.org
Normal file
@ -0,0 +1,79 @@
|
|||||||
|
* Debug the gradient
|
||||||
|
|
||||||
|
*Program to check the gradient*
|
||||||
|
|
||||||
|
The program compares the result of the first and last code for the
|
||||||
|
gradient.
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| n | integer | number of orbitals pairs (p,q) p<q |
|
||||||
|
| v_grad(n) | double precision | Original gradient |
|
||||||
|
| v_grad2(n) | double precision | Gradient |
|
||||||
|
| i | integer | index |
|
||||||
|
| threshold | double precision | threshold for the errors |
|
||||||
|
| max_error | double precision | maximal error in the gradient |
|
||||||
|
| nb_error | integer | number of error in the gradient |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle debug_gradient_list_opt.irp.f
|
||||||
|
program debug_gradient_list
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: v_grad(:), v_grad2(:)
|
||||||
|
integer :: n,m
|
||||||
|
integer :: i
|
||||||
|
double precision :: threshold
|
||||||
|
double precision :: max_error, max_elem, norm
|
||||||
|
integer :: nb_error
|
||||||
|
|
||||||
|
m = dim_list_act_orb
|
||||||
|
! Definition of n
|
||||||
|
n = m*(m-1)/2
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(v_grad(n), v_grad2(n))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
call diagonalize_ci ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Gradient
|
||||||
|
call gradient_list_opt(n,m,list_act,v_grad,max_elem,norm)
|
||||||
|
call first_gradient_list_opt(n,m,list_act,v_grad2)
|
||||||
|
|
||||||
|
|
||||||
|
v_grad = v_grad - v_grad2
|
||||||
|
nb_error = 0
|
||||||
|
max_error = 0d0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(v_grad(i)) > threshold) then
|
||||||
|
print*,i,v_grad(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
|
||||||
|
if (ABS(v_grad(i)) > max_error) then
|
||||||
|
max_error = v_grad(i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'Check the gradient'
|
||||||
|
print*,'Threshold:', threshold
|
||||||
|
print*,'Nb error:', nb_error
|
||||||
|
print*,'Max error:', max_error
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(v_grad,v_grad2)
|
||||||
|
|
||||||
|
end program
|
||||||
|
#+END_SRC
|
77
src/mo_optimization/org/debug_gradient_opt.org
Normal file
77
src/mo_optimization/org/debug_gradient_opt.org
Normal file
@ -0,0 +1,77 @@
|
|||||||
|
* Debug the gradient
|
||||||
|
|
||||||
|
*Program to check the gradient*
|
||||||
|
|
||||||
|
The program compares the result of the first and last code for the
|
||||||
|
gradient.
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| n | integer | number of orbitals pairs (p,q) p<q |
|
||||||
|
| v_grad(n) | double precision | Original gradient |
|
||||||
|
| v_grad2(n) | double precision | Gradient |
|
||||||
|
| i | integer | index |
|
||||||
|
| threshold | double precision | threshold for the errors |
|
||||||
|
| max_error | double precision | maximal error in the gradient |
|
||||||
|
| nb_error | integer | number of error in the gradient |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle debug_gradient_opt.irp.f
|
||||||
|
program debug_gradient
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: v_grad(:), v_grad2(:)
|
||||||
|
integer :: n
|
||||||
|
integer :: i
|
||||||
|
double precision :: threshold
|
||||||
|
double precision :: max_error, max_elem
|
||||||
|
integer :: nb_error
|
||||||
|
|
||||||
|
! Definition of n
|
||||||
|
n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(v_grad(n), v_grad2(n))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
call diagonalize_ci ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Gradient
|
||||||
|
call first_gradient_opt(n,v_grad)
|
||||||
|
call gradient_opt(n,v_grad2,max_elem)
|
||||||
|
|
||||||
|
v_grad = v_grad - v_grad2
|
||||||
|
nb_error = 0
|
||||||
|
max_error = 0d0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(v_grad(i)) > threshold) then
|
||||||
|
print*,v_grad(i)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
|
||||||
|
if (ABS(v_grad(i)) > max_error) then
|
||||||
|
max_error = v_grad(i)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'Check the gradient'
|
||||||
|
print*,'Threshold :', threshold
|
||||||
|
print*,'Nb error :', nb_error
|
||||||
|
print*,'Max error :', max_error
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(v_grad,v_grad2)
|
||||||
|
|
||||||
|
end program
|
||||||
|
#+END_SRC
|
148
src/mo_optimization/org/debug_hessian_list_opt.org
Normal file
148
src/mo_optimization/org/debug_hessian_list_opt.org
Normal file
@ -0,0 +1,148 @@
|
|||||||
|
* Debug the hessian
|
||||||
|
|
||||||
|
*Program to check the hessian matrix*
|
||||||
|
|
||||||
|
The program compares the result of the first and last code for the
|
||||||
|
hessian. First of all the 4D hessian and after the 2D hessian.
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
| optimization_method | string | Method for the orbital optimization: |
|
||||||
|
| | | - 'full' -> full hessian |
|
||||||
|
| | | - 'diag' -> diagonal hessian |
|
||||||
|
| dim_list_act_orb | integer | number of active MOs |
|
||||||
|
| list_act(dim_list_act_orb) | integer | list of the actives MOs |
|
||||||
|
| | | |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| m | integer | number of MOs in the list |
|
||||||
|
| | | (active MOs) |
|
||||||
|
| n | integer | number of orbitals pairs (p,q) p<q |
|
||||||
|
| | | n = m*(m-1)/2 |
|
||||||
|
| H(n,n) | double precision | Original hessian matrix (2D) |
|
||||||
|
| H2(n,n) | double precision | Hessian matrix (2D) |
|
||||||
|
| h_f(mo_num,mo_num,mo_num,mo_num) | double precision | Original hessian matrix (4D) |
|
||||||
|
| h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D) |
|
||||||
|
| i,j,p,q,k | integer | indexes |
|
||||||
|
| threshold | double precision | threshold for the errors |
|
||||||
|
| max_error | double precision | maximal error in the 4D hessian |
|
||||||
|
| max_error_H | double precision | maximal error in the 2D hessian |
|
||||||
|
| nb_error | integer | number of errors in the 4D hessian |
|
||||||
|
| nb_error_H | integer | number of errors in the 2D hessian |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle debug_hessian_list_opt.irp.f
|
||||||
|
program debug_hessian_list_opt
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
|
||||||
|
integer :: n,m
|
||||||
|
integer :: i,j,k,l
|
||||||
|
double precision :: max_error, max_error_H
|
||||||
|
integer :: nb_error, nb_error_H
|
||||||
|
double precision :: threshold
|
||||||
|
|
||||||
|
m = dim_list_act_orb !mo_num
|
||||||
|
|
||||||
|
! Definition of n
|
||||||
|
n = m*(m-1)/2
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Hessian
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
print*,'Use the full hessian matrix'
|
||||||
|
allocate(H(n,n),H2(n,n))
|
||||||
|
allocate(h_f(m,m,m,m),h_f2(m,m,m,m))
|
||||||
|
|
||||||
|
call hessian_list_opt(n,m,list_act,H,h_f)
|
||||||
|
call first_hessian_list_opt(n,m,list_act,H2,h_f2)
|
||||||
|
!call hessian_opt(n,H2,h_f2)
|
||||||
|
|
||||||
|
! Difference
|
||||||
|
h_f = h_f - h_f2
|
||||||
|
H = H - H2
|
||||||
|
max_error = 0d0
|
||||||
|
nb_error = 0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do l = 1, m
|
||||||
|
do k= 1, m
|
||||||
|
do j = 1, m
|
||||||
|
do i = 1, m
|
||||||
|
if (ABS(h_f(i,j,k,l)) > threshold) then
|
||||||
|
print*,h_f(i,j,k,l)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
|
||||||
|
max_error = h_f(i,j,k,l)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
max_error_H = 0d0
|
||||||
|
nb_error_H = 0
|
||||||
|
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(H(i,j)) > threshold) then
|
||||||
|
print*, H(i,j)
|
||||||
|
nb_error_H = nb_error_H + 1
|
||||||
|
|
||||||
|
if (ABS(H(i,j)) > ABS(max_error_H)) then
|
||||||
|
max_error_H = H(i,j)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(H, H2, h_f, h_f2)
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
print*, 'Use the diagonal hessian matrix'
|
||||||
|
allocate(H(n,1),H2(n,1))
|
||||||
|
call diag_hessian_list_opt(n,m,list_act,H)
|
||||||
|
call first_diag_hessian_list_opt(n,m,list_act,H2)
|
||||||
|
|
||||||
|
H = H - H2
|
||||||
|
|
||||||
|
max_error_H = 0d0
|
||||||
|
nb_error_H = 0
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(H(i,1)) > threshold) then
|
||||||
|
print*, H(i,1)
|
||||||
|
nb_error_H = nb_error_H + 1
|
||||||
|
|
||||||
|
if (ABS(H(i,1)) > ABS(max_error_H)) then
|
||||||
|
max_error_H = H(i,1)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
print*,'Check of the full hessian'
|
||||||
|
print*,'Threshold:', threshold
|
||||||
|
print*,'Nb error:', nb_error
|
||||||
|
print*,'Max error:', max_error
|
||||||
|
print*,''
|
||||||
|
else
|
||||||
|
print*,'Check of the diagonal hessian'
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,'Nb error_H:', nb_error_H
|
||||||
|
print*,'Max error_H:', max_error_H
|
||||||
|
|
||||||
|
end program
|
||||||
|
#+END_SRC
|
172
src/mo_optimization/org/debug_hessian_opt.org
Normal file
172
src/mo_optimization/org/debug_hessian_opt.org
Normal file
@ -0,0 +1,172 @@
|
|||||||
|
* Debug the hessian
|
||||||
|
|
||||||
|
*Program to check the hessian matrix*
|
||||||
|
|
||||||
|
The program compares the result of the first and last code for the
|
||||||
|
hessian. First of all the 4D hessian and after the 2D hessian.
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| n | integer | number of orbitals pairs (p,q) p<q |
|
||||||
|
| H(n,n) | double precision | Original hessian matrix (2D) |
|
||||||
|
| H2(n,n) | double precision | Hessian matrix (2D) |
|
||||||
|
| h_f(mo_num,mo_num,mo_num,mo_num) | double precision | Original hessian matrix (4D) |
|
||||||
|
| h_f2(mo_num,mo_num,mo_num,mo_num) | double precision | Hessian matrix (4D) |
|
||||||
|
| method | integer | - 1: full hessian |
|
||||||
|
| | | - 2: diagonal hessian |
|
||||||
|
| i,j,p,q,k | integer | indexes |
|
||||||
|
| threshold | double precision | threshold for the errors |
|
||||||
|
| max_error | double precision | maximal error in the 4D hessian |
|
||||||
|
| max_error_H | double precision | maximal error in the 2D hessian |
|
||||||
|
| nb_error | integer | number of errors in the 4D hessian |
|
||||||
|
| nb_error_H | integer | number of errors in the 2D hessian |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle debug_hessian_opt.irp.f
|
||||||
|
program debug_hessian
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: H(:,:),H2(:,:), h_f(:,:,:,:), h_f2(:,:,:,:)
|
||||||
|
integer :: n
|
||||||
|
integer :: i,j,k,l
|
||||||
|
double precision :: max_error, max_error_H
|
||||||
|
integer :: nb_error, nb_error_H
|
||||||
|
double precision :: threshold
|
||||||
|
|
||||||
|
! Definition of n
|
||||||
|
n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ! Vérifier pour suppression
|
||||||
|
|
||||||
|
! Allocation
|
||||||
|
allocate(H(n,n),H2(n,n))
|
||||||
|
allocate(h_f(mo_num,mo_num,mo_num,mo_num),h_f2(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
! Hessian
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
|
||||||
|
print*,'Use the full hessian matrix'
|
||||||
|
call hessian_opt(n,H,h_f)
|
||||||
|
call first_hessian_opt(n,H2,h_f2)
|
||||||
|
|
||||||
|
! Difference
|
||||||
|
h_f = h_f - h_f2
|
||||||
|
H = H - H2
|
||||||
|
max_error = 0d0
|
||||||
|
nb_error = 0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k= 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
if (ABS(h_f(i,j,k,l)) > threshold) then
|
||||||
|
print*,h_f(i,j,k,l)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
|
||||||
|
max_error = h_f(i,j,k,l)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
max_error_H = 0d0
|
||||||
|
nb_error_H = 0
|
||||||
|
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(H(i,j)) > threshold) then
|
||||||
|
print*, H(i,j)
|
||||||
|
nb_error_H = nb_error_H + 1
|
||||||
|
|
||||||
|
if (ABS(H(i,j)) > ABS(max_error_H)) then
|
||||||
|
max_error_H = H(i,j)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif (optimization_method == 'diag') then
|
||||||
|
|
||||||
|
print*, 'Use the diagonal hessian matrix'
|
||||||
|
call diag_hessian_opt(n,H,h_f)
|
||||||
|
call first_diag_hessian_opt(n,H2,h_f2)
|
||||||
|
|
||||||
|
h_f = h_f - h_f2
|
||||||
|
max_error = 0d0
|
||||||
|
nb_error = 0
|
||||||
|
threshold = 1d-12
|
||||||
|
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
|
||||||
|
if (ABS(h_f(i,j,k,l)) > threshold) then
|
||||||
|
|
||||||
|
print*,h_f(i,j,k,l)
|
||||||
|
nb_error = nb_error + 1
|
||||||
|
|
||||||
|
if (ABS(h_f(i,j,k,l)) > ABS(max_error)) then
|
||||||
|
max_error = h_f(i,j,k,l)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
h=H-H2
|
||||||
|
|
||||||
|
max_error_H = 0d0
|
||||||
|
nb_error_H = 0
|
||||||
|
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(H(i,j)) > threshold) then
|
||||||
|
print*, H(i,j)
|
||||||
|
nb_error_H = nb_error_H + 1
|
||||||
|
|
||||||
|
if (ABS(H(i,j)) > ABS(max_error_H)) then
|
||||||
|
max_error_H = H(i,j)
|
||||||
|
endif
|
||||||
|
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
print*,'Unknown optimization_method, please select full, diag'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
print*,'Check the full hessian'
|
||||||
|
else
|
||||||
|
print*,'Check the diagonal hessian'
|
||||||
|
endif
|
||||||
|
|
||||||
|
print*,'Threshold :', threshold
|
||||||
|
print*,'Nb error :', nb_error
|
||||||
|
print*,'Max error :', max_error
|
||||||
|
print*,''
|
||||||
|
print*,'Nb error_H :', nb_error_H
|
||||||
|
print*,'Max error_H :', max_error_H
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(H,H2,h_f,h_f2)
|
||||||
|
|
||||||
|
end program
|
||||||
|
#+END_SRC
|
1561
src/mo_optimization/org/diagonal_hessian_list_opt.org
Normal file
1561
src/mo_optimization/org/diagonal_hessian_list_opt.org
Normal file
File diff suppressed because it is too large
Load Diff
1516
src/mo_optimization/org/diagonal_hessian_opt.org
Normal file
1516
src/mo_optimization/org/diagonal_hessian_opt.org
Normal file
File diff suppressed because it is too large
Load Diff
138
src/mo_optimization/org/diagonalization_hessian.org
Normal file
138
src/mo_optimization/org/diagonalization_hessian.org
Normal file
@ -0,0 +1,138 @@
|
|||||||
|
* Diagonalization of the hessian
|
||||||
|
|
||||||
|
Just a matrix diagonalization using Lapack
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| n | integer | mo_num*(mo_num-1)/2 |
|
||||||
|
| H(n,n) | double precision | hessian |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| e_val(n) | double precision | eigenvalues of the hessian |
|
||||||
|
| w(n,n) | double precision | eigenvectors of the hessian |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| nb_negative_nv | integer | number of negative eigenvalues |
|
||||||
|
| lwork | integer | for Lapack |
|
||||||
|
| work(lwork,n) | double precision | temporary array for Lapack |
|
||||||
|
| info | integer | if 0 -> ok, else problem in the diagonalization |
|
||||||
|
| i,j | integer | dummy indexes |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle diagonalization_hessian.irp.f
|
||||||
|
subroutine diagonalization_hessian(n,H,e_val,w)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
double precision, intent(in) :: H(n,n)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: e_val(n), w(n,n)
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: work(:,:)
|
||||||
|
integer, allocatable :: key(:)
|
||||||
|
integer :: info,lwork
|
||||||
|
integer :: i,j
|
||||||
|
integer :: nb_negative_vp
|
||||||
|
double precision :: t1,t2,t3,max_elem
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---Diagonalization_hessian---'
|
||||||
|
|
||||||
|
call wall_time(t1)
|
||||||
|
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
! Allocation
|
||||||
|
! For Lapack
|
||||||
|
lwork=3*n-1
|
||||||
|
|
||||||
|
allocate(work(lwork,n))
|
||||||
|
|
||||||
|
! Calculation
|
||||||
|
|
||||||
|
! Copy the hessian matrix, the eigenvectors will be store in W
|
||||||
|
W=H
|
||||||
|
|
||||||
|
! Diagonalization of the hessian
|
||||||
|
call dsyev('V','U',n,W,size(W,1),e_val,work,lwork,info)
|
||||||
|
|
||||||
|
if (info /= 0) then
|
||||||
|
print*, 'Error diagonalization : diagonalization_hessian'
|
||||||
|
print*, 'info = ', info
|
||||||
|
call ABORT
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print *, 'vp Hess:'
|
||||||
|
write(*,'(100(F10.5))') real(e_val(:))
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Number of negative eigenvalues
|
||||||
|
max_elem = 0d0
|
||||||
|
nb_negative_vp = 0
|
||||||
|
do i = 1, n
|
||||||
|
if (e_val(i) < 0d0) then
|
||||||
|
nb_negative_vp = nb_negative_vp + 1
|
||||||
|
if (e_val(i) < max_elem) then
|
||||||
|
max_elem = e_val(i)
|
||||||
|
endif
|
||||||
|
!print*,'e_val < 0 :', e_val(i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,'Number of negative eigenvalues:', nb_negative_vp
|
||||||
|
print*,'Lowest eigenvalue:',max_elem
|
||||||
|
|
||||||
|
!nb_negative_vp = 0
|
||||||
|
!do i = 1, n
|
||||||
|
! if (e_val(i) < -thresh_eig) then
|
||||||
|
! nb_negative_vp = nb_negative_vp + 1
|
||||||
|
! endif
|
||||||
|
!enddo
|
||||||
|
!print*,'Number of negative eigenvalues <', -thresh_eig,':', nb_negative_vp
|
||||||
|
|
||||||
|
! Deallocation
|
||||||
|
deallocate(work)
|
||||||
|
|
||||||
|
elseif (optimization_method == 'diag') then
|
||||||
|
! Diagonalization of the diagonal hessian by hands
|
||||||
|
allocate(key(n))
|
||||||
|
|
||||||
|
do i = 1, n
|
||||||
|
e_val(i) = H(i,i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Key list for dsort
|
||||||
|
do i = 1, n
|
||||||
|
key(i) = i
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Sort of the eigenvalues
|
||||||
|
call dsort(e_val, key, n)
|
||||||
|
|
||||||
|
! Eigenvectors
|
||||||
|
W = 0d0
|
||||||
|
do i = 1, n
|
||||||
|
j = key(i)
|
||||||
|
W(j,i) = 1d0
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(key)
|
||||||
|
else
|
||||||
|
print*,'Diagonalization_hessian, abort'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
|
||||||
|
call wall_time(t2)
|
||||||
|
t3 = t2 - t1
|
||||||
|
print*,'Time in diagonalization_hessian:', t3
|
||||||
|
|
||||||
|
print*,'---End diagonalization_hessian---'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
||||||
|
|
376
src/mo_optimization/org/first_diagonal_hessian_list_opt.org
Normal file
376
src/mo_optimization/org/first_diagonal_hessian_list_opt.org
Normal file
@ -0,0 +1,376 @@
|
|||||||
|
* First diagonal hessian
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments :tangle first_diagonal_hessian_list_opt.irp.f
|
||||||
|
subroutine first_diag_hessian_list_opt(tmp_n,m,list,H)!, h_tmpr)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!===========================================================================
|
||||||
|
! Compute the diagonal hessian of energy with respects to orbital rotations
|
||||||
|
!===========================================================================
|
||||||
|
|
||||||
|
!===========
|
||||||
|
! Variables
|
||||||
|
!===========
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: tmp_n, m, list(m)
|
||||||
|
! tmp_n : integer, tmp_n = m*(m-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: H(tmp_n)!, h_tmpr(m,m,m,m)
|
||||||
|
! H : n by n double precision matrix containing the 2D hessian
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: hessian(:,:,:,:), tmp(:,:),h_tmpr(:,:,:,:)
|
||||||
|
integer :: p,q, tmp_p,tmp_q
|
||||||
|
integer :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
|
||||||
|
integer :: pq,rs,tmp_pq,tmp_rs
|
||||||
|
double precision :: t1,t2,t3
|
||||||
|
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
|
||||||
|
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
|
||||||
|
! p,q,r,s : integer, indexes of the 4D hessian matrix
|
||||||
|
! t,u,v : integer, indexes to compute hessian elements
|
||||||
|
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
|
||||||
|
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
|
||||||
|
|
||||||
|
! Function
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
! get_two_e_integral : double precision function, two e integrals
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
|
||||||
|
! two_e_dm_mo : two body density matrix
|
||||||
|
|
||||||
|
print*,'---first_diag_hess_list---'
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(hessian(m,m,m,m),tmp(tmp_n,tmp_n),h_tmpr(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
! From Anderson et. al. (2014)
|
||||||
|
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
|
||||||
|
|
||||||
|
! LaTeX formula :
|
||||||
|
|
||||||
|
!\begin{align*}
|
||||||
|
!H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
|
||||||
|
!&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u)
|
||||||
|
!+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
|
||||||
|
!-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
|
||||||
|
!&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv})
|
||||||
|
!+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
|
||||||
|
!&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs} \Gamma_{ps}^{uv}) \\
|
||||||
|
!&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts})
|
||||||
|
!\end{align*}
|
||||||
|
|
||||||
|
!================
|
||||||
|
! Initialization
|
||||||
|
!================
|
||||||
|
hessian = 0d0
|
||||||
|
|
||||||
|
CALL wall_time(t1)
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, first term
|
||||||
|
!========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
|
||||||
|
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! First line, second term
|
||||||
|
!=========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
|
||||||
|
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, third term
|
||||||
|
!========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Second line, first term
|
||||||
|
!=========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
|
||||||
|
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!==========================
|
||||||
|
! Second line, second term
|
||||||
|
!==========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
|
||||||
|
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! Third line, first term
|
||||||
|
!========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
|
||||||
|
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Third line, second term
|
||||||
|
!=========================
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
|
||||||
|
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
|
||||||
|
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
|
||||||
|
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t2)
|
||||||
|
t2 = t2 - t1
|
||||||
|
print*, 'Time to compute the hessian :', t2
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Permutations
|
||||||
|
!==============
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
do tmp_r = 1, m
|
||||||
|
do tmp_s = 1, m
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
|
||||||
|
h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
|
||||||
|
- hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! 4D matrix -> 2D matrix
|
||||||
|
!========================
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
! 4D mo_num matrix to 2D n matrix
|
||||||
|
do tmp_rs = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
|
||||||
|
do tmp_pq = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
|
||||||
|
tmp(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do p = 1, tmp_n
|
||||||
|
H(p) = tmp(p,p)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (debug) then
|
||||||
|
print*,'2D diag Hessian matrix'
|
||||||
|
do tmp_pq = 1, tmp_n
|
||||||
|
write(*,'(100(F10.5))') tmp(tmp_pq,:)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(hessian,h_tmpr,tmp)
|
||||||
|
|
||||||
|
print*,'---End first_diag_hess_list---'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
348
src/mo_optimization/org/first_diagonal_hessian_opt.org
Normal file
348
src/mo_optimization/org/first_diagonal_hessian_opt.org
Normal file
@ -0,0 +1,348 @@
|
|||||||
|
* First diagonal hessian
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments :tangle first_diagonal_hessian_opt.irp.f
|
||||||
|
subroutine first_diag_hessian_opt(n,H, h_tmpr)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!===========================================================================
|
||||||
|
! Compute the diagonal hessian of energy with respects to orbital rotations
|
||||||
|
!===========================================================================
|
||||||
|
|
||||||
|
!===========
|
||||||
|
! Variables
|
||||||
|
!===========
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
! n : integer, n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: H(n,n), h_tmpr(mo_num,mo_num,mo_num,mo_num)
|
||||||
|
! H : n by n double precision matrix containing the 2D hessian
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: hessian(:,:,:,:)
|
||||||
|
integer :: p,q
|
||||||
|
integer :: r,s,t,u,v
|
||||||
|
integer :: pq,rs
|
||||||
|
double precision :: t1,t2,t3
|
||||||
|
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
|
||||||
|
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
|
||||||
|
! p,q,r,s : integer, indexes of the 4D hessian matrix
|
||||||
|
! t,u,v : integer, indexes to compute hessian elements
|
||||||
|
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
|
||||||
|
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
|
||||||
|
|
||||||
|
! Function
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
! get_two_e_integral : double precision function, two e integrals
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
|
||||||
|
! two_e_dm_mo : two body density matrix
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(hessian(mo_num,mo_num,mo_num,mo_num))!,h_tmpr(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'Enter in first_diag_hessien'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! From Anderson et. al. (2014)
|
||||||
|
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
|
||||||
|
|
||||||
|
! LaTeX formula :
|
||||||
|
|
||||||
|
!\begin{align*}
|
||||||
|
!H_{pq,rs} &= \dfrac{\partial^2 E(x)}{\partial x_{pq}^2} \\
|
||||||
|
!&= \mathcal{P}_{pq} \mathcal{P}_{rs} [ \frac{1}{2} \sum_u [\delta_{qr}(h_p^u \gamma_u^s + h_u^s \gamma_p^u)
|
||||||
|
!+ \delta_{ps}(h_r^u \gamma_u^q + h_u^q \gamma_u^r)]
|
||||||
|
!-(h_p^s \gamma_r^q + h_r^q \gamma_p^s) \\
|
||||||
|
!&+ \frac{1}{2} \sum_{tuv} [\delta_{qr}(v_{pt}^{uv} \Gamma_{uv}^{st} +v_{uv}^{st} \Gamma_{pt}^{uv})
|
||||||
|
!+ \delta_{ps}(v_{uv}^{qt} \Gamma_{rt}^{uv} + v_{rt}^{uv}\Gamma_{uv}^{qt})] \\
|
||||||
|
!&+ \sum_{uv} (v_{pr}^{uv} \Gamma_{uv}^{qs} + v_{uv}^{qs} \Gamma_{ps}^{uv}) \\
|
||||||
|
!&- \sum_{tu} (v_{pu}^{st} \Gamma_{rt}^{qu}+v_{pu}^{tr} \Gamma_{tr}^{qu}+v_{rt}^{qu}\Gamma_{pu}^{st} + v_{tr}^{qu}\Gamma_{pu}^{ts})
|
||||||
|
!\end{align*}
|
||||||
|
|
||||||
|
!================
|
||||||
|
! Initialization
|
||||||
|
!================
|
||||||
|
hessian = 0d0
|
||||||
|
|
||||||
|
CALL wall_time(t1)
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, first term
|
||||||
|
!========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
|
||||||
|
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! First line, second term
|
||||||
|
!=========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
|
||||||
|
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, third term
|
||||||
|
!========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Second line, first term
|
||||||
|
!=========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
|
||||||
|
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!==========================
|
||||||
|
! Second line, second term
|
||||||
|
!==========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
|
||||||
|
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! Third line, first term
|
||||||
|
!========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
|
||||||
|
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Third line, second term
|
||||||
|
!=========================
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
! Permutations
|
||||||
|
if (((p==r) .and. (q==s)) .or. ((q==r) .and. (p==s)) &
|
||||||
|
.or. ((p==s) .and. (q==r))) then
|
||||||
|
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
|
||||||
|
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
|
||||||
|
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
|
||||||
|
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t2)
|
||||||
|
t2 = t2 - t1
|
||||||
|
print*, 'Time to compute the hessian :', t2
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Permutations
|
||||||
|
!==============
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
h_tmpr(p,q,r,s) = (hessian(p,q,r,s) - hessian(q,p,r,s) - hessian(p,q,s,r) + hessian(q,p,s,r))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! 4D matrix -> 2D matrix
|
||||||
|
!========================
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
! 4D mo_num matrix to 2D n matrix
|
||||||
|
do rs = 1, n
|
||||||
|
call vec_to_mat_index(rs,r,s)
|
||||||
|
do pq = 1, n
|
||||||
|
call vec_to_mat_index(pq,p,q)
|
||||||
|
H(pq,rs) = h_tmpr(p,q,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (debug) then
|
||||||
|
print*,'2D diag Hessian matrix'
|
||||||
|
do pq = 1, n
|
||||||
|
write(*,'(100(F10.5))') H(pq,:)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(hessian)
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'Leave first_diag_hessien'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
#+END_SRC
|
127
src/mo_optimization/org/first_gradient_list_opt.org
Normal file
127
src/mo_optimization/org/first_gradient_list_opt.org
Normal file
@ -0,0 +1,127 @@
|
|||||||
|
* First gradient
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle first_gradient_list_opt.irp.f
|
||||||
|
subroutine first_gradient_list_opt(tmp_n,m,list,v_grad)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!===================================================================
|
||||||
|
! Compute the gradient of energy with respects to orbital rotations
|
||||||
|
!===================================================================
|
||||||
|
|
||||||
|
! Check if read_wf = true, else :
|
||||||
|
! qp set determinant read_wf true
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: tmp_n,m,list(m)
|
||||||
|
! n : integer, n = m*(m-1)/2
|
||||||
|
! m = list_size
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: v_grad(tmp_n)
|
||||||
|
! v_grad : double precision vector of length n containeing the gradient
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: grad(:,:),A(:,:)
|
||||||
|
double precision :: norm
|
||||||
|
integer :: i,p,q,r,s,t,tmp_i,tmp_p,tmp_q,tmp_r,tmp_s,tmp_t
|
||||||
|
! grad : double precision matrix containing the gradient before the permutation
|
||||||
|
! A : double precision matrix containing the gradient after the permutation
|
||||||
|
! norm : double precision number, the norm of the vector gradient
|
||||||
|
! i,p,q,r,s,t : integer, indexes
|
||||||
|
! istate : integer, the electronic state
|
||||||
|
|
||||||
|
! Function
|
||||||
|
double precision :: get_two_e_integral, norm2
|
||||||
|
! get_two_e_integral : double precision function that gives the two e integrals
|
||||||
|
! norm2 : double precision function that gives the norm of a vector
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo : one body density matrix (state average)
|
||||||
|
! two_e_dm_mo : two body density matrix (state average)
|
||||||
|
|
||||||
|
print*,'---first_gradient_list---'
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(grad(m,m),A(m,m))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
v_grad = 0d0
|
||||||
|
grad = 0d0
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
!grad(tmp_p,tmp_q) = 0d0
|
||||||
|
do r = 1, mo_num
|
||||||
|
grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do t = 1, mo_num
|
||||||
|
|
||||||
|
grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) &
|
||||||
|
+ get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
|
||||||
|
- get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector
|
||||||
|
do tmp_i = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_i,tmp_p,tmp_q)
|
||||||
|
v_grad(tmp_i)=(grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display, vector containing the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Vector containing the gradient :'
|
||||||
|
write(*,'(100(F10.5))') v_grad(1:tmp_n)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Norm of the vector
|
||||||
|
norm = norm2(v_grad)
|
||||||
|
print*, 'Norm : ', norm
|
||||||
|
|
||||||
|
! Matrix gradient
|
||||||
|
A = 0d0
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
A(tmp_p,tmp_q) = grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display, matrix containting the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Matrix containing the gradient :'
|
||||||
|
do tmp_i = 1, m
|
||||||
|
write(*,'(100(E12.5))') A(tmp_i,1:m)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(grad,A)
|
||||||
|
|
||||||
|
print*,'---End first_gradient_list---'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
#+END_SRC
|
130
src/mo_optimization/org/first_gradient_opt.org
Normal file
130
src/mo_optimization/org/first_gradient_opt.org
Normal file
@ -0,0 +1,130 @@
|
|||||||
|
* First gradient
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle first_gradient_opt.irp.f
|
||||||
|
subroutine first_gradient_opt(n,v_grad)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!===================================================================
|
||||||
|
! Compute the gradient of energy with respects to orbital rotations
|
||||||
|
!===================================================================
|
||||||
|
|
||||||
|
! Check if read_wf = true, else :
|
||||||
|
! qp set determinant read_wf true
|
||||||
|
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
! n : integer, n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: v_grad(n)
|
||||||
|
! v_grad : double precision vector of length n containeing the gradient
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: grad(:,:),A(:,:)
|
||||||
|
double precision :: norm
|
||||||
|
integer :: i,p,q,r,s,t
|
||||||
|
integer :: istate
|
||||||
|
! grad : double precision matrix containing the gradient before the permutation
|
||||||
|
! A : double precision matrix containing the gradient after the permutation
|
||||||
|
! norm : double precision number, the norm of the vector gradient
|
||||||
|
! i,p,q,r,s,t : integer, indexes
|
||||||
|
! istate : integer, the electronic state
|
||||||
|
|
||||||
|
! Function
|
||||||
|
double precision :: get_two_e_integral, norm2
|
||||||
|
! get_two_e_integral : double precision function that gives the two e integrals
|
||||||
|
! norm2 : double precision function that gives the norm of a vector
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo : one body density matrix (state average)
|
||||||
|
! two_e_dm_mo : two body density matrix (state average)
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(grad(mo_num,mo_num),A(mo_num,mo_num))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'---first_gradient---'
|
||||||
|
endif
|
||||||
|
|
||||||
|
v_grad = 0d0
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
grad(p,q) = 0d0
|
||||||
|
do r = 1, mo_num
|
||||||
|
grad(p,q) = grad(p,q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do t= 1, mo_num
|
||||||
|
|
||||||
|
grad(p,q) = grad(p,q) &
|
||||||
|
+ get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
|
||||||
|
- get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector
|
||||||
|
do i=1,n
|
||||||
|
call vec_to_mat_index(i,p,q)
|
||||||
|
v_grad(i)=(grad(p,q) - grad(q,p))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display, vector containing the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Vector containing the gradient :'
|
||||||
|
write(*,'(100(F10.5))') v_grad(1:n)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Norm of the vector
|
||||||
|
norm = norm2(v_grad)
|
||||||
|
print*, 'Norm : ', norm
|
||||||
|
|
||||||
|
! Matrix gradient
|
||||||
|
A = 0d0
|
||||||
|
do q=1,mo_num
|
||||||
|
do p=1,mo_num
|
||||||
|
A(p,q) = grad(p,q) - grad(q,p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display, matrix containting the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Matrix containing the gradient :'
|
||||||
|
do i = 1, mo_num
|
||||||
|
write(*,'(100(E12.5))') A(i,1:mo_num)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(grad,A)
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'---End first_gradient---'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
#+END_SRC
|
370
src/mo_optimization/org/first_hessian_list_opt.org
Normal file
370
src/mo_optimization/org/first_hessian_list_opt.org
Normal file
@ -0,0 +1,370 @@
|
|||||||
|
* First hessian
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments :tangle first_hessian_list_opt.irp.f
|
||||||
|
subroutine first_hessian_list_opt(tmp_n,m,list,H,h_tmpr)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!==================================================================
|
||||||
|
! Compute the hessian of energy with respects to orbital rotations
|
||||||
|
!==================================================================
|
||||||
|
|
||||||
|
!===========
|
||||||
|
! Variables
|
||||||
|
!===========
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: tmp_n, m, list(m)
|
||||||
|
!tmp_n : integer, tmp_n = m*(m-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: H(tmp_n,tmp_n),h_tmpr(m,m,m,m)
|
||||||
|
! H : n by n double precision matrix containing the 2D hessian
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: hessian(:,:,:,:)
|
||||||
|
integer :: p,q, tmp_p,tmp_q
|
||||||
|
integer :: r,s,t,u,v,tmp_r,tmp_s,tmp_t,tmp_u,tmp_v
|
||||||
|
integer :: pq,rs,tmp_pq,tmp_rs
|
||||||
|
double precision :: t1,t2,t3,t4,t5,t6
|
||||||
|
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
|
||||||
|
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
|
||||||
|
! p,q,r,s : integer, indexes of the 4D hessian matrix
|
||||||
|
! t,u,v : integer, indexes to compute hessian elements
|
||||||
|
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
|
||||||
|
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
|
||||||
|
|
||||||
|
! Funtion
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
! get_two_e_integral : double precision function, two e integrals
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
|
||||||
|
! two_e_dm_mo : two body density matrix
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(hessian(m,m,m,m))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
print*,'---first_hess_list---'
|
||||||
|
|
||||||
|
! From Anderson et. al. (2014)
|
||||||
|
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
|
||||||
|
|
||||||
|
CALL wall_time(t1)
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
hessian = 0d0
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, first term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
|
||||||
|
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 1 :', t6
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! First line, second term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
|
||||||
|
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 2 :', t6
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, third term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q)&
|
||||||
|
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 3 :', t6
|
||||||
|
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Second line, first term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
|
||||||
|
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l2 1 :', t6
|
||||||
|
|
||||||
|
!==========================
|
||||||
|
! Second line, second term
|
||||||
|
!==========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
|
||||||
|
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l2 2 :', t6
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! Third line, first term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
|
||||||
|
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l3 1 :', t6
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Third line, second term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do tmp_r = 1, m
|
||||||
|
r = list(tmp_r)
|
||||||
|
do tmp_s = 1, m
|
||||||
|
s = list(tmp_s)
|
||||||
|
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(tmp_p,tmp_q,tmp_r,tmp_s) = hessian(tmp_p,tmp_q,tmp_r,tmp_s) &
|
||||||
|
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
|
||||||
|
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
|
||||||
|
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
|
||||||
|
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l3 2 :', t6
|
||||||
|
|
||||||
|
CALL wall_time(t2)
|
||||||
|
t3 = t2 -t1
|
||||||
|
print*,'Time to compute the hessian : ', t3
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Permutations
|
||||||
|
!==============
|
||||||
|
|
||||||
|
! Hessian(p,q,r,s) = P_pq P_rs [ ...]
|
||||||
|
! => Hessian(p,q,r,s) = (p,q,r,s) - (q,p,r,s) - (p,q,s,r) + (q,p,s,r)
|
||||||
|
|
||||||
|
do tmp_s = 1, m
|
||||||
|
do tmp_r = 1, m
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
|
||||||
|
h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s) = (hessian(tmp_p,tmp_q,tmp_r,tmp_s) - hessian(tmp_q,tmp_p,tmp_r,tmp_s) &
|
||||||
|
- hessian(tmp_p,tmp_q,tmp_s,tmp_r) + hessian(tmp_q,tmp_p,tmp_s,tmp_r))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! 4D matrix to 2D matrix
|
||||||
|
!========================
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
! 4D mo_num matrix to 2D n matrix
|
||||||
|
do tmp_pq = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_pq,tmp_p,tmp_q)
|
||||||
|
do tmp_rs = 1, tmp_n
|
||||||
|
call vec_to_mat_index(tmp_rs,tmp_r,tmp_s)
|
||||||
|
H(tmp_pq,tmp_rs) = h_tmpr(tmp_p,tmp_q,tmp_r,tmp_s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (debug) then
|
||||||
|
print*,'2D Hessian matrix'
|
||||||
|
do tmp_pq = 1, tmp_n
|
||||||
|
write(*,'(100(F10.5))') H(tmp_pq,:)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(hessian)
|
||||||
|
|
||||||
|
print*,'---End first_hess_list---'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
#+END_SRC
|
365
src/mo_optimization/org/first_hessian_opt.org
Normal file
365
src/mo_optimization/org/first_hessian_opt.org
Normal file
@ -0,0 +1,365 @@
|
|||||||
|
* First hessian
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments :tangle first_hessian_opt.irp.f
|
||||||
|
subroutine first_hessian_opt(n,H,h_tmpr)
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
!==================================================================
|
||||||
|
! Compute the hessian of energy with respects to orbital rotations
|
||||||
|
!==================================================================
|
||||||
|
|
||||||
|
!===========
|
||||||
|
! Variables
|
||||||
|
!===========
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
!n : integer, n = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: H(n,n),h_tmpr(mo_num,mo_num,mo_num,mo_num)
|
||||||
|
! H : n by n double precision matrix containing the 2D hessian
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: hessian(:,:,:,:)
|
||||||
|
integer :: p,q
|
||||||
|
integer :: r,s,t,u,v
|
||||||
|
integer :: pq,rs
|
||||||
|
double precision :: t1,t2,t3,t4,t5,t6
|
||||||
|
! hessian : mo_num 4D double precision matrix containing the hessian before the permutations
|
||||||
|
! h_tmpr : mo_num 4D double precision matrix containing the hessian after the permutations
|
||||||
|
! p,q,r,s : integer, indexes of the 4D hessian matrix
|
||||||
|
! t,u,v : integer, indexes to compute hessian elements
|
||||||
|
! pq,rs : integer, indexes for the conversion from 4D to 2D hessian matrix
|
||||||
|
! t1,t2,t3 : double precision, t3 = t2 - t1, time to compute the hessian
|
||||||
|
|
||||||
|
! Funtion
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
! get_two_e_integral : double precision function, two e integrals
|
||||||
|
|
||||||
|
! Provided :
|
||||||
|
! mo_one_e_integrals : mono e- integrals
|
||||||
|
! get_two_e_integral : two e- integrals
|
||||||
|
! one_e_dm_mo_alpha, one_e_dm_mo_beta : one body density matrix
|
||||||
|
! two_e_dm_mo : two body density matrix
|
||||||
|
|
||||||
|
!============
|
||||||
|
! Allocation
|
||||||
|
!============
|
||||||
|
|
||||||
|
allocate(hessian(mo_num,mo_num,mo_num,mo_num))
|
||||||
|
|
||||||
|
!=============
|
||||||
|
! Calculation
|
||||||
|
!=============
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'Enter in first_hess'
|
||||||
|
endif
|
||||||
|
|
||||||
|
! From Anderson et. al. (2014)
|
||||||
|
! The Journal of Chemical Physics 141, 244104 (2014); doi: 10.1063/1.4904384
|
||||||
|
|
||||||
|
CALL wall_time(t1)
|
||||||
|
|
||||||
|
! Initialization
|
||||||
|
hessian = 0d0
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, first term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,p) * one_e_dm_mo(u,s) &
|
||||||
|
+ mo_one_e_integrals(s,u) * one_e_dm_mo(p,u))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 1 :', t6
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! First line, second term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
mo_one_e_integrals(u,r) * one_e_dm_mo(u,q) &
|
||||||
|
+ mo_one_e_integrals(q,u) * one_e_dm_mo(r,u))
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 2 :', t6
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! First line, third term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
- mo_one_e_integrals(s,p) * one_e_dm_mo(r,q)&
|
||||||
|
- mo_one_e_integrals(q,r) * one_e_dm_mo(p,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l1 3 :', t6
|
||||||
|
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Second line, first term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
|
||||||
|
if (q==r) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(u,v,p,t,mo_integrals_map) * two_e_dm_mo(u,v,s,t) &
|
||||||
|
+ get_two_e_integral(s,t,u,v,mo_integrals_map) * two_e_dm_mo(p,t,u,v))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l2 1 :', t6
|
||||||
|
|
||||||
|
!==========================
|
||||||
|
! Second line, second term
|
||||||
|
!==========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
|
||||||
|
if (p==s) then
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) + 0.5d0 * ( &
|
||||||
|
get_two_e_integral(q,t,u,v,mo_integrals_map) * two_e_dm_mo(r,t,u,v) &
|
||||||
|
+ get_two_e_integral(u,v,r,t,mo_integrals_map) * two_e_dm_mo(u,v,q,t))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l2 2 :', t6
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! Third line, first term
|
||||||
|
!========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
|
||||||
|
do u = 1, mo_num
|
||||||
|
do v = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
+ get_two_e_integral(u,v,p,r,mo_integrals_map) * two_e_dm_mo(u,v,q,s) &
|
||||||
|
+ get_two_e_integral(q,s,u,v,mo_integrals_map) * two_e_dm_mo(p,r,u,v)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l3 1 :', t6
|
||||||
|
|
||||||
|
!=========================
|
||||||
|
! Third line, second term
|
||||||
|
!=========================
|
||||||
|
|
||||||
|
CALL wall_time(t4)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
! do p = 1, mo_num
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do r = 1, mo_num
|
||||||
|
! do s = 1, mo_num
|
||||||
|
|
||||||
|
do t = 1, mo_num
|
||||||
|
do u = 1, mo_num
|
||||||
|
|
||||||
|
hessian(p,q,r,s) = hessian(p,q,r,s) &
|
||||||
|
- get_two_e_integral(s,t,p,u,mo_integrals_map) * two_e_dm_mo(r,t,q,u) &
|
||||||
|
- get_two_e_integral(t,s,p,u,mo_integrals_map) * two_e_dm_mo(t,r,q,u) &
|
||||||
|
- get_two_e_integral(q,u,r,t,mo_integrals_map) * two_e_dm_mo(p,u,s,t) &
|
||||||
|
- get_two_e_integral(q,u,t,r,mo_integrals_map) * two_e_dm_mo(p,u,t,s)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
CALL wall_time(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'l3 2 :', t6
|
||||||
|
|
||||||
|
CALL wall_time(t2)
|
||||||
|
t3 = t2 -t1
|
||||||
|
print*,'Time to compute the hessian : ', t3
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Permutations
|
||||||
|
!==============
|
||||||
|
|
||||||
|
! Hessian(p,q,r,s) = P_pq P_rs [ ...]
|
||||||
|
! => Hessian(p,q,r,s) = (p,q,r,s) - (q,p,r,s) - (p,q,s,r) + (q,p,s,r)
|
||||||
|
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
h_tmpr(p,q,r,s) = (hessian(p,q,r,s) - hessian(q,p,r,s) - hessian(p,q,s,r) + hessian(q,p,s,r))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!========================
|
||||||
|
! 4D matrix to 2D matrix
|
||||||
|
!========================
|
||||||
|
|
||||||
|
! Convert the hessian mo_num * mo_num * mo_num * mo_num matrix in a
|
||||||
|
! 2D n * n matrix (n = mo_num*(mo_num-1)/2)
|
||||||
|
! H(pq,rs) : p<q and r<s
|
||||||
|
|
||||||
|
! 4D mo_num matrix to 2D n matrix
|
||||||
|
do pq = 1, n
|
||||||
|
call vec_to_mat_index(pq,p,q)
|
||||||
|
do rs = 1, n
|
||||||
|
call vec_to_mat_index(rs,r,s)
|
||||||
|
H(pq,rs) = h_tmpr(p,q,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Display
|
||||||
|
if (debug) then
|
||||||
|
print*,'2D Hessian matrix'
|
||||||
|
do pq = 1, n
|
||||||
|
write(*,'(100(F10.5))') H(pq,:)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
!==============
|
||||||
|
! Deallocation
|
||||||
|
!==============
|
||||||
|
|
||||||
|
deallocate(hessian)
|
||||||
|
|
||||||
|
if (debug) then
|
||||||
|
print*,'Leave first_hess'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
#+END_SRC
|
393
src/mo_optimization/org/gradient_list_opt.org
Normal file
393
src/mo_optimization/org/gradient_list_opt.org
Normal file
@ -0,0 +1,393 @@
|
|||||||
|
* Gradient
|
||||||
|
|
||||||
|
The gradient of the CI energy with respects to the orbital rotation
|
||||||
|
is:
|
||||||
|
(C-c C-x C-l)
|
||||||
|
$$
|
||||||
|
G(p,q) = \mathcal{P}_{pq} \left[ \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
|
||||||
|
\sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
|
||||||
|
\right]
|
||||||
|
$$
|
||||||
|
|
||||||
|
|
||||||
|
$$
|
||||||
|
\mathcal{P}_{pq}= 1 - (p \leftrightarrow q)
|
||||||
|
$$
|
||||||
|
|
||||||
|
$$
|
||||||
|
G(p,q) = \left[
|
||||||
|
\sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
|
||||||
|
\sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
|
||||||
|
\right] -
|
||||||
|
\left[
|
||||||
|
\sum_r (h_q^r \gamma_r^p - h_r^p \gamma_q^r) +
|
||||||
|
\sum_{rst}(v_{qt}^{rs} \Gamma_{rs}^{pt} - v_{rs}^{pt}
|
||||||
|
\Gamma_{qt}^{rs})
|
||||||
|
\right]
|
||||||
|
$$
|
||||||
|
|
||||||
|
Where p,q,r,s,t are general spatial orbitals
|
||||||
|
mo_num : the number of molecular orbitals
|
||||||
|
$$h$$ : One electron integrals
|
||||||
|
$$\gamma$$ : One body density matrix (state average in our case)
|
||||||
|
$$v$$ : Two electron integrals
|
||||||
|
$$\Gamma$$ : Two body density matrice (state average in our case)
|
||||||
|
|
||||||
|
The gradient is a mo_num by mo_num matrix, p,q,r,s,t take all the
|
||||||
|
values between 1 and mo_num (1 and mo_num include).
|
||||||
|
|
||||||
|
To do that we compute $$G(p,q)$$ for all the pairs (p,q).
|
||||||
|
|
||||||
|
Source :
|
||||||
|
Seniority-based coupled cluster theory
|
||||||
|
J. Chem. Phys. 141, 244104 (2014); https://doi.org/10.1063/1.4904384
|
||||||
|
Thomas M. Henderson, Ireneusz W. Bulik, Tamar Stein, and Gustavo
|
||||||
|
E. Scuseria
|
||||||
|
|
||||||
|
*Compute the gradient of energy with respects to orbital rotations*
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
| mo_one_e_integrals(mo_num,mo_num) | double precision | mono_electronic integrals |
|
||||||
|
| one_e_dm_mo(mo_num,mo_num) | double precision | one e- density matrix |
|
||||||
|
| two_e_dm_mo(mo_num,mo_num,mo_num,mo_num) | double precision | two e- density matrix |
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| n | integer | mo_num*(mo_num-1)/2 |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| v_grad(n) | double precision | the gradient |
|
||||||
|
| max_elem | double precision | maximum element of the gradient |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| grad(mo_num,mo_num) | double precison | gradient before the tranformation in a vector |
|
||||||
|
| A((mo_num,mo_num) | doubre precision | gradient after the permutations |
|
||||||
|
| norm | double precision | norm of the gradient |
|
||||||
|
| p, q | integer | indexes of the element in the matrix grad |
|
||||||
|
| i | integer | index for the tranformation in a vector |
|
||||||
|
| r, s, t | integer | indexes dor the sums |
|
||||||
|
| t1, t2, t3 | double precision | t3 = t2 - t1, time to compute the gradient |
|
||||||
|
| t4, t5, t6 | double precission | t6 = t5 - t4, time to compute each element |
|
||||||
|
| tmp_bi_int_3(mo_num,mo_num,mo_num) | double precision | 3 indexes temporary array for the bi-electronic integrals |
|
||||||
|
| tmp_2rdm_3(mo_num,mo_num,mo_num) | double precision | 3 indexes temporary array for the two e- density matrix |
|
||||||
|
| tmp_accu(mo_num,mo_num) | double precision | temporary array |
|
||||||
|
|
||||||
|
Function:
|
||||||
|
| get_two_e_integral | double precision | bi-electronic integrals |
|
||||||
|
| dnrm2 | double precision | (Lapack) norm |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
subroutine gradient_list_opt(n,m,list,v_grad,max_elem,norm)
|
||||||
|
use omp_lib
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n,m,list(m)
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: v_grad(n), max_elem, norm
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: grad(:,:),A(:,:)
|
||||||
|
integer :: i,p,q,r,s,t, tmp_p, tmp_q, tmp_i
|
||||||
|
double precision :: t1,t2,t3,t4,t5,t6
|
||||||
|
|
||||||
|
double precision, allocatable :: tmp_accu(:,:), tmp_mo_one_e_integrals(:,:),tmp_one_e_dm_mo(:,:)
|
||||||
|
double precision, allocatable :: tmp_bi_int_3(:,:,:), tmp_2rdm_3(:,:,:)
|
||||||
|
|
||||||
|
! Functions
|
||||||
|
double precision :: get_two_e_integral, dnrm2
|
||||||
|
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---gradient---'
|
||||||
|
|
||||||
|
! Allocation of shared arrays
|
||||||
|
allocate(grad(m,m),A(m,m))
|
||||||
|
allocate(tmp_mo_one_e_integrals(m,mo_num),tmp_one_e_dm_mo(mo_num,m))
|
||||||
|
|
||||||
|
|
||||||
|
! Initialization omp
|
||||||
|
call omp_set_max_active_levels(1)
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP PRIVATE( &
|
||||||
|
!$OMP p,q,r,s,t,tmp_p,tmp_q, &
|
||||||
|
!$OMP tmp_accu,tmp_bi_int_3, tmp_2rdm_3) &
|
||||||
|
!$OMP SHARED(grad, one_e_dm_mo,m,list,mo_num,mo_one_e_integrals, &
|
||||||
|
!$OMP mo_integrals_map,tmp_one_e_dm_mo, tmp_mo_one_e_integrals,t4,t5,t6) &
|
||||||
|
!$OMP DEFAULT(SHARED)
|
||||||
|
|
||||||
|
! Allocation of private arrays
|
||||||
|
allocate(tmp_accu(m,m))
|
||||||
|
allocate(tmp_bi_int_3(mo_num,mo_num,m))
|
||||||
|
allocate(tmp_2rdm_3(mo_num,mo_num,m))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Calculation
|
||||||
|
*** Initialization
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
!$OMP DO
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
grad(tmp_p,tmp_q) = 0d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Term 1
|
||||||
|
|
||||||
|
Without optimization the term 1 is :
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
grad(p,q) = grad(p,q) &
|
||||||
|
+ mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
Since the matrix multiplication A.B is defined like :
|
||||||
|
\begin{equation}
|
||||||
|
c_{ij} = \sum_k a_{ik}.b_{kj}
|
||||||
|
\end{equation}
|
||||||
|
The previous equation can be rewritten as a matrix multplication
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
!****************
|
||||||
|
! Opt first term
|
||||||
|
!****************
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do r = 1, mo_num
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
tmp_mo_one_e_integrals(tmp_p,r) = mo_one_e_integrals(p,r)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do r = 1, mo_num
|
||||||
|
tmp_one_e_dm_mo(r,tmp_q) = one_e_dm_mo(r,q)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
call dgemm('N','N',m,m,mo_num,1d0,&
|
||||||
|
tmp_mo_one_e_integrals, size(tmp_mo_one_e_integrals,1),&
|
||||||
|
tmp_one_e_dm_mo,size(tmp_one_e_dm_mo,1),0d0,tmp_accu,size(tmp_accu,1))
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
|
||||||
|
grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + (tmp_accu(tmp_p,tmp_q) - tmp_accu(tmp_q,tmp_p))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t4)
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
! call dgemm('N','N',mo_num,mo_num,mo_num,1d0,mo_one_e_integrals,&
|
||||||
|
! mo_num,one_e_dm_mo,mo_num,0d0,tmp_accu,mo_num)
|
||||||
|
!
|
||||||
|
! !$OMP DO
|
||||||
|
! do q = 1, mo_num
|
||||||
|
! do p = 1, mo_num
|
||||||
|
!
|
||||||
|
! grad(p,q) = grad(p,q) + (tmp_accu(p,q) - tmp_accu(q,p))
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! !$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'Gradient, first term (s) :', t6
|
||||||
|
!$OMP END MASTER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Term 2
|
||||||
|
|
||||||
|
Without optimization the second term is :
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do t= 1, mo_num
|
||||||
|
|
||||||
|
grad(p,q) = grad(p,q) &
|
||||||
|
+ get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
|
||||||
|
- get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
Using the bielectronic integral properties :
|
||||||
|
get_two_e_integral(p,t,r,s,mo_integrals_map) = get_two_e_integral(r,s,p,t,mo_integrals_map)
|
||||||
|
|
||||||
|
Using the two body matrix properties :
|
||||||
|
two_e_dm_mo(p,t,r,s) = two_e_dm_mo(r,s,p,t)
|
||||||
|
|
||||||
|
t is one the right, we can put it on the external loop and create 3
|
||||||
|
indexes temporary array
|
||||||
|
r,s can be seen as one index
|
||||||
|
|
||||||
|
By doing so, a matrix multiplication appears
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
!*****************
|
||||||
|
! Opt second term
|
||||||
|
!*****************
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t4)
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do t = 1, mo_num
|
||||||
|
|
||||||
|
do tmp_p = 1, m
|
||||||
|
p = list(tmp_p)
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
|
||||||
|
tmp_bi_int_3(r,s,tmp_p) = get_two_e_integral(r,s,p,t,mo_integrals_map)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do tmp_q = 1, m
|
||||||
|
q = list(tmp_q)
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
|
||||||
|
tmp_2rdm_3(r,s,tmp_q) = two_e_dm_mo(r,s,q,t)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call dgemm('T','N',m,m,mo_num*mo_num,1d0,tmp_bi_int_3,&
|
||||||
|
mo_num*mo_num,tmp_2rdm_3,mo_num*mo_num,0d0,tmp_accu,size(tmp_accu,1))
|
||||||
|
|
||||||
|
!$OMP CRITICAL
|
||||||
|
do tmp_q = 1, m
|
||||||
|
do tmp_p = 1, m
|
||||||
|
|
||||||
|
grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + tmp_accu(tmp_p,tmp_q) - tmp_accu(tmp_q,tmp_p)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'Gradient second term (s) : ', t6
|
||||||
|
!$OMP END MASTER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Deallocation of private arrays
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
deallocate(tmp_bi_int_3,tmp_2rdm_3,tmp_accu)
|
||||||
|
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call omp_set_max_active_levels(4)
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Permutation, 2D matrix -> vector, transformation
|
||||||
|
In addition there is a permutation in the gradient formula :
|
||||||
|
\begin{equation}
|
||||||
|
P_{pq} = 1 - (p <-> q)
|
||||||
|
\end{equation}
|
||||||
|
|
||||||
|
We need a vector to use the gradient. Here the gradient is a
|
||||||
|
antisymetric matrix so we can transform it in a vector of length
|
||||||
|
mo_num*(mo_num-1)/2.
|
||||||
|
|
||||||
|
Here we do these two things at the same time.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
do i=1,n
|
||||||
|
call vec_to_mat_index(i,p,q)
|
||||||
|
v_grad(i)=(grad(p,q) - grad(q,p))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug, diplay the vector containing the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Vector containing the gradient :'
|
||||||
|
write(*,'(100(F10.5))') v_grad(1:n)
|
||||||
|
endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Norm of the gradient
|
||||||
|
The norm can be useful.
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
norm = dnrm2(n,v_grad,1)
|
||||||
|
print*, 'Gradient norm : ', norm
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Maximum element in the gradient
|
||||||
|
The maximum element in the gradient is very important for the
|
||||||
|
convergence criterion of the Newton method.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
! Max element of the gradient
|
||||||
|
max_elem = 0d0
|
||||||
|
do i = 1, n
|
||||||
|
if (DABS(v_grad(i)) > DABS(max_elem)) then
|
||||||
|
max_elem = v_grad(i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Max element in the gradient :', max_elem
|
||||||
|
|
||||||
|
! Debug, display the matrix containting the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
! Matrix gradient
|
||||||
|
A = 0d0
|
||||||
|
do q=1,m
|
||||||
|
do p=1,m
|
||||||
|
A(p,q) = grad(p,q) - grad(q,p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'Matrix containing the gradient :'
|
||||||
|
do i = 1, m
|
||||||
|
write(*,'(100(F10.5))') A(i,1:m)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Deallocation of shared arrays and end
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_list_opt.irp.f
|
||||||
|
deallocate(grad,A, tmp_mo_one_e_integrals,tmp_one_e_dm_mo)
|
||||||
|
|
||||||
|
print*,'---End gradient---'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
|
358
src/mo_optimization/org/gradient_opt.org
Normal file
358
src/mo_optimization/org/gradient_opt.org
Normal file
@ -0,0 +1,358 @@
|
|||||||
|
* Gradient
|
||||||
|
|
||||||
|
The gradient of the CI energy with respects to the orbital rotation
|
||||||
|
is:
|
||||||
|
(C-c C-x C-l)
|
||||||
|
$$
|
||||||
|
G(p,q) = \mathcal{P}_{pq} \left[ \sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
|
||||||
|
\sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
|
||||||
|
\right]
|
||||||
|
$$
|
||||||
|
|
||||||
|
|
||||||
|
$$
|
||||||
|
\mathcal{P}_{pq}= 1 - (p \leftrightarrow q)
|
||||||
|
$$
|
||||||
|
|
||||||
|
$$
|
||||||
|
G(p,q) = \left[
|
||||||
|
\sum_r (h_p^r \gamma_r^q - h_r^q \gamma_p^r) +
|
||||||
|
\sum_{rst}(v_{pt}^{rs} \Gamma_{rs}^{qt} - v_{rs}^{qt} \Gamma_{pt}^{rs})
|
||||||
|
\right] -
|
||||||
|
\left[
|
||||||
|
\sum_r (h_q^r \gamma_r^p - h_r^p \gamma_q^r) +
|
||||||
|
\sum_{rst}(v_{qt}^{rs} \Gamma_{rs}^{pt} - v_{rs}^{pt}
|
||||||
|
\Gamma_{qt}^{rs})
|
||||||
|
\right]
|
||||||
|
$$
|
||||||
|
|
||||||
|
Where p,q,r,s,t are general spatial orbitals
|
||||||
|
mo_num : the number of molecular orbitals
|
||||||
|
$$h$$ : One electron integrals
|
||||||
|
$$\gamma$$ : One body density matrix (state average in our case)
|
||||||
|
$$v$$ : Two electron integrals
|
||||||
|
$$\Gamma$$ : Two body density matrice (state average in our case)
|
||||||
|
|
||||||
|
The gradient is a mo_num by mo_num matrix, p,q,r,s,t take all the
|
||||||
|
values between 1 and mo_num (1 and mo_num include).
|
||||||
|
|
||||||
|
To do that we compute $$G(p,q)$$ for all the pairs (p,q).
|
||||||
|
|
||||||
|
Source :
|
||||||
|
Seniority-based coupled cluster theory
|
||||||
|
J. Chem. Phys. 141, 244104 (2014); https://doi.org/10.1063/1.4904384
|
||||||
|
Thomas M. Henderson, Ireneusz W. Bulik, Tamar Stein, and Gustavo
|
||||||
|
E. Scuseria
|
||||||
|
|
||||||
|
*Compute the gradient of energy with respects to orbital rotations*
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
| mo_one_e_integrals(mo_num,mo_num) | double precision | mono_electronic integrals |
|
||||||
|
| one_e_dm_mo(mo_num,mo_num) | double precision | one e- density matrix |
|
||||||
|
| two_e_dm_mo(mo_num,mo_num,mo_num,mo_num) | double precision | two e- density matrix |
|
||||||
|
|
||||||
|
Input:
|
||||||
|
| n | integer | mo_num*(mo_num-1)/2 |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| v_grad(n) | double precision | the gradient |
|
||||||
|
| max_elem | double precision | maximum element of the gradient |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| grad(mo_num,mo_num) | double precison | gradient before the tranformation in a vector |
|
||||||
|
| A((mo_num,mo_num) | doubre precision | gradient after the permutations |
|
||||||
|
| norm | double precision | norm of the gradient |
|
||||||
|
| p, q | integer | indexes of the element in the matrix grad |
|
||||||
|
| i | integer | index for the tranformation in a vector |
|
||||||
|
| r, s, t | integer | indexes dor the sums |
|
||||||
|
| t1, t2, t3 | double precision | t3 = t2 - t1, time to compute the gradient |
|
||||||
|
| t4, t5, t6 | double precission | t6 = t5 - t4, time to compute each element |
|
||||||
|
| tmp_bi_int_3(mo_num,mo_num,mo_num) | double precision | 3 indexes temporary array for the bi-electronic integrals |
|
||||||
|
| tmp_2rdm_3(mo_num,mo_num,mo_num) | double precision | 3 indexes temporary array for the two e- density matrix |
|
||||||
|
| tmp_accu(mo_num,mo_num) | double precision | temporary array |
|
||||||
|
|
||||||
|
Function:
|
||||||
|
| get_two_e_integral | double precision | bi-electronic integrals |
|
||||||
|
| dnrm2 | double precision | (Lapack) norm |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
subroutine gradient_opt(n,v_grad,max_elem)
|
||||||
|
use omp_lib
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
! in
|
||||||
|
integer, intent(in) :: n
|
||||||
|
|
||||||
|
! out
|
||||||
|
double precision, intent(out) :: v_grad(n), max_elem
|
||||||
|
|
||||||
|
! internal
|
||||||
|
double precision, allocatable :: grad(:,:),A(:,:)
|
||||||
|
double precision :: norm
|
||||||
|
integer :: i,p,q,r,s,t
|
||||||
|
double precision :: t1,t2,t3,t4,t5,t6
|
||||||
|
|
||||||
|
double precision, allocatable :: tmp_accu(:,:)
|
||||||
|
double precision, allocatable :: tmp_bi_int_3(:,:,:), tmp_2rdm_3(:,:,:)
|
||||||
|
|
||||||
|
! Functions
|
||||||
|
double precision :: get_two_e_integral, dnrm2
|
||||||
|
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'---gradient---'
|
||||||
|
|
||||||
|
! Allocation of shared arrays
|
||||||
|
allocate(grad(mo_num,mo_num),A(mo_num,mo_num))
|
||||||
|
|
||||||
|
! Initialization omp
|
||||||
|
call omp_set_max_active_levels(1)
|
||||||
|
|
||||||
|
!$OMP PARALLEL &
|
||||||
|
!$OMP PRIVATE( &
|
||||||
|
!$OMP p,q,r,s,t, &
|
||||||
|
!$OMP tmp_accu, tmp_bi_int_3, tmp_2rdm_3) &
|
||||||
|
!$OMP SHARED(grad, one_e_dm_mo, mo_num,mo_one_e_integrals, &
|
||||||
|
!$OMP mo_integrals_map,t4,t5,t6) &
|
||||||
|
!$OMP DEFAULT(SHARED)
|
||||||
|
|
||||||
|
! Allocation of private arrays
|
||||||
|
allocate(tmp_accu(mo_num,mo_num))
|
||||||
|
allocate(tmp_bi_int_3(mo_num,mo_num,mo_num))
|
||||||
|
allocate(tmp_2rdm_3(mo_num,mo_num,mo_num))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Calculation
|
||||||
|
*** Initialization
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
!$OMP DO
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1,mo_num
|
||||||
|
grad(p,q) = 0d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Term 1
|
||||||
|
|
||||||
|
Without optimization the term 1 is :
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
grad(p,q) = grad(p,q) &
|
||||||
|
+ mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) &
|
||||||
|
- mo_one_e_integrals(r,q) * one_e_dm_mo(p,r)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
Since the matrix multiplication A.B is defined like :
|
||||||
|
\begin{equation}
|
||||||
|
c_{ij} = \sum_k a_{ik}.b_{kj}
|
||||||
|
\end{equation}
|
||||||
|
The previous equation can be rewritten as a matrix multplication
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
!****************
|
||||||
|
! Opt first term
|
||||||
|
!****************
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t4)
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
call dgemm('N','N',mo_num,mo_num,mo_num,1d0,mo_one_e_integrals,&
|
||||||
|
mo_num,one_e_dm_mo,mo_num,0d0,tmp_accu,mo_num)
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
grad(p,q) = grad(p,q) + (tmp_accu(p,q) - tmp_accu(q,p))
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'Gradient, first term (s) :', t6
|
||||||
|
!$OMP END MASTER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Term 2
|
||||||
|
|
||||||
|
Without optimization the second term is :
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do q = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do t= 1, mo_num
|
||||||
|
|
||||||
|
grad(p,q) = grad(p,q) &
|
||||||
|
+ get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) &
|
||||||
|
- get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
Using the bielectronic integral properties :
|
||||||
|
get_two_e_integral(p,t,r,s,mo_integrals_map) = get_two_e_integral(r,s,p,t,mo_integrals_map)
|
||||||
|
|
||||||
|
Using the two body matrix properties :
|
||||||
|
two_e_dm_mo(p,t,r,s) = two_e_dm_mo(r,s,p,t)
|
||||||
|
|
||||||
|
t is one the right, we can put it on the external loop and create 3
|
||||||
|
indexes temporary array
|
||||||
|
r,s can be seen as one index
|
||||||
|
|
||||||
|
By doing so, a matrix multiplication appears
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
!*****************
|
||||||
|
! Opt second term
|
||||||
|
!*****************
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t4)
|
||||||
|
!$OMP END MASTER
|
||||||
|
|
||||||
|
!$OMP DO
|
||||||
|
do t = 1, mo_num
|
||||||
|
|
||||||
|
do p = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
|
||||||
|
tmp_bi_int_3(r,s,p) = get_two_e_integral(r,s,p,t,mo_integrals_map)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do q = 1, mo_num
|
||||||
|
do s = 1, mo_num
|
||||||
|
do r = 1, mo_num
|
||||||
|
|
||||||
|
tmp_2rdm_3(r,s,q) = two_e_dm_mo(r,s,q,t)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call dgemm('T','N',mo_num,mo_num,mo_num*mo_num,1d0,tmp_bi_int_3,&
|
||||||
|
mo_num*mo_num,tmp_2rdm_3,mo_num*mo_num,0d0,tmp_accu,mo_num)
|
||||||
|
|
||||||
|
!$OMP CRITICAL
|
||||||
|
do q = 1, mo_num
|
||||||
|
do p = 1, mo_num
|
||||||
|
|
||||||
|
grad(p,q) = grad(p,q) + tmp_accu(p,q) - tmp_accu(q,p)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP MASTER
|
||||||
|
CALL wall_TIME(t5)
|
||||||
|
t6 = t5-t4
|
||||||
|
print*,'Gradient second term (s) : ', t6
|
||||||
|
!$OMP END MASTER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Deallocation of private arrays
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
deallocate(tmp_bi_int_3,tmp_2rdm_3,tmp_accu)
|
||||||
|
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
call omp_set_max_active_levels(4)
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Permutation, 2D matrix -> vector, transformation
|
||||||
|
In addition there is a permutation in the gradient formula :
|
||||||
|
\begin{equation}
|
||||||
|
P_{pq} = 1 - (p <-> q)
|
||||||
|
\end{equation}
|
||||||
|
|
||||||
|
We need a vector to use the gradient. Here the gradient is a
|
||||||
|
antisymetric matrix so we can transform it in a vector of length
|
||||||
|
mo_num*(mo_num-1)/2.
|
||||||
|
|
||||||
|
Here we do these two things at the same time.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
do i=1,n
|
||||||
|
call vec_to_mat_index(i,p,q)
|
||||||
|
v_grad(i)=(grad(p,q) - grad(q,p))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Debug, diplay the vector containing the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
print*,'Vector containing the gradient :'
|
||||||
|
write(*,'(100(F10.5))') v_grad(1:n)
|
||||||
|
endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Norm of the gradient
|
||||||
|
The norm can be useful.
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
norm = dnrm2(n,v_grad,1)
|
||||||
|
print*, 'Gradient norm : ', norm
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Maximum element in the gradient
|
||||||
|
The maximum element in the gradient is very important for the
|
||||||
|
convergence criterion of the Newton method.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
! Max element of the gradient
|
||||||
|
max_elem = 0d0
|
||||||
|
do i = 1, n
|
||||||
|
if (ABS(v_grad(i)) > ABS(max_elem)) then
|
||||||
|
max_elem = v_grad(i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Max element in the gradient :', max_elem
|
||||||
|
|
||||||
|
! Debug, display the matrix containting the gradient elements
|
||||||
|
if (debug) then
|
||||||
|
! Matrix gradient
|
||||||
|
A = 0d0
|
||||||
|
do q=1,mo_num
|
||||||
|
do p=1,mo_num
|
||||||
|
A(p,q) = grad(p,q) - grad(q,p)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'Matrix containing the gradient :'
|
||||||
|
do i = 1, mo_num
|
||||||
|
write(*,'(100(F10.5))') A(i,1:mo_num)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Deallocation of shared arrays and end
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle gradient_opt.irp.f
|
||||||
|
deallocate(grad,A)
|
||||||
|
|
||||||
|
print*,'---End gradient---'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
|
1141
src/mo_optimization/org/hessian_list_opt.org
Normal file
1141
src/mo_optimization/org/hessian_list_opt.org
Normal file
File diff suppressed because it is too large
Load Diff
1056
src/mo_optimization/org/hessian_opt.org
Normal file
1056
src/mo_optimization/org/hessian_opt.org
Normal file
File diff suppressed because it is too large
Load Diff
308
src/mo_optimization/org/my_providers.org
Normal file
308
src/mo_optimization/org/my_providers.org
Normal file
@ -0,0 +1,308 @@
|
|||||||
|
* Providers
|
||||||
|
** Dimensions of MOs
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim = mo_num*(mo_num-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim_core ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of core MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim_core = dim_list_core_orb*(dim_list_core_orb-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim_act ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of active MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim_act = dim_list_act_orb*(dim_list_act_orb-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim_inact ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of inactive MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim_inact = dim_list_inact_orb*(dim_list_inact_orb-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ integer, n_mo_dim_virt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of different pairs (i,j) of virtual MOs we can build,
|
||||||
|
! with i>j
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
n_mo_dim_virt = dim_list_virt_orb*(dim_list_virt_orb-1)/2
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Energies/criterions
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_st_av_energy ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! State average CI energy
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
!call update_st_av_ci_energy(my_st_av_energy)
|
||||||
|
call state_average_energy(my_st_av_energy)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Gradient/hessian
|
||||||
|
*** Orbital optimization
|
||||||
|
**** With all the MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_gradient_opt, (n_mo_dim) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, my_CC1_opt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the energy with respect to the MO rotations, for all the MOs.
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision :: norm_grad
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
call gradient_opt(n_mo_dim, my_gradient_opt, my_CC1_opt, norm_grad)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_hessian_opt, (n_mo_dim, n_mo_dim) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the energy with respect to the MO rotations, for all the MOs.
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision, allocatable :: h_f(:,:,:,:)
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
allocate(h_f(mo_num, mo_num, mo_num, mo_num))
|
||||||
|
|
||||||
|
call hessian_list_opt(n_mo_dim, my_hessian_opt, h_f)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
**** With the list of active MOs
|
||||||
|
Can be generalized to any mo_class by changing the list/dimension
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_gradient_list_opt, (n_mo_dim_act) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, my_CC2_opt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the energy with respect to the MO rotations, only for the active MOs !
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision :: norm_grad
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map !one_e_dm_mo two_e_dm_mo mo_one_e_integrals
|
||||||
|
|
||||||
|
call gradient_list_opt(n_mo_dim_act, dim_list_act_orb, list_act, my_gradient_list_opt, my_CC2_opt, norm_grad)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_hessian_list_opt, (n_mo_dim_act, n_mo_dim_act) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the energy with respect to the MO rotations, only for the active MOs !
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision, allocatable :: h_f(:,:,:,:)
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
allocate(h_f(dim_list_act_orb, dim_list_act_orb, dim_list_act_orb, dim_list_act_orb))
|
||||||
|
|
||||||
|
call hessian_list_opt(n_mo_dim_act, dim_list_act_orb, list_act, my_hessian_list_opt, h_f)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Orbital localization
|
||||||
|
**** Gradient
|
||||||
|
***** Core MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org
|
||||||
|
!:tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_gradient_loc_core, (n_mo_dim_core) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, my_CC_loc_core ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the MO localization with respect to the MO rotations for the core MOs
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision :: norm_grad
|
||||||
|
|
||||||
|
!PROVIDE something ?
|
||||||
|
|
||||||
|
call gradient_localization(n_mo_dim_core, dim_list_core_orb, list_core, my_gradient_loc_core, my_CC_loc_core , norm_grad)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
***** Active MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org
|
||||||
|
!:tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_gradient_loc_act, (n_mo_dim_act) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, my_CC_loc_act ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the MO localization with respect to the MO rotations for the active MOs
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision :: norm_grad
|
||||||
|
|
||||||
|
!PROVIDE something ?
|
||||||
|
|
||||||
|
call gradient_localization(n_mo_dim_act, dim_list_act_orb, list_act, my_gradient_loc_act, my_CC_loc_act , norm_grad)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
***** Inactive MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org !
|
||||||
|
:tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_gradient_loc_inact, (n_mo_dim_inact) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, my_CC_loc_inact ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the MO localization with respect to the MO rotations for the inactive MOs
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision :: norm_grad
|
||||||
|
|
||||||
|
!PROVIDE something ?
|
||||||
|
|
||||||
|
call gradient_localization(n_mo_dim_inact, dim_list_inact_orb, list_inact, my_gradient_loc_inact, my_CC_loc_inact , norm_grad)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
***** Virtual MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org
|
||||||
|
!:tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_gradient_loc_virt, (n_mo_dim_virt) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, my_CC_loc_virt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Gradient of the MO localization with respect to the MO rotations for the virtual MOs
|
||||||
|
! - Maximal element of the gradient in absolute value
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
double precision :: norm_grad
|
||||||
|
|
||||||
|
!PROVIDE something ?
|
||||||
|
|
||||||
|
call gradient_localization(n_mo_dim_virt, dim_list_virt_orb, list_virt, my_gradient_loc_virt, my_CC_loc_virt , norm_grad)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
**** Hessian
|
||||||
|
***** Core MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org
|
||||||
|
!:tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_hessian_loc_core, (n_mo_dim_core) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Hessian of the MO localization with respect to the MO rotations for the core MOs
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
!PROVIDE something ?
|
||||||
|
|
||||||
|
call hessian_localization(n_mo_dim_core, dim_list_core_orb, list_core, my_hessian_loc_core)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
***** Active MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org
|
||||||
|
!:tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_hessian_loc_act, (n_mo_dim_act) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Hessian of the MO localization with respect to the MO rotations for the active MOs
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
!PROVIDE something ?
|
||||||
|
|
||||||
|
call hessian_localization(n_mo_dim_act, dim_list_act_orb, list_act, my_hessian_loc_act)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
***** Inactive MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org
|
||||||
|
!:tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_hessian_loc_inact, (n_mo_dim_inact) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Hessian of the MO localization with respect to the MO rotations for the inactive MOs
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
!PROVIDE something ?
|
||||||
|
|
||||||
|
call hessian_localization(n_mo_dim_inact, dim_list_inact_orb, list_inact, my_hessian_loc_inact)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
***** Virtual MOs
|
||||||
|
#+BEGIN_SRC f90 :comments org
|
||||||
|
!:tangle my_providers.irp.f
|
||||||
|
BEGIN_PROVIDER [ double precision, my_hessian_loc_virt, (n_mo_dim_virt) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! - Hessian of the MO localization with respect to the MO rotations for the virtual MOs
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
!PROVIDE something ?
|
||||||
|
|
||||||
|
call hessian_localization(n_mo_dim_virt, dim_list_virt_orb, list_virt, my_hessian_loc_virt)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
#+END_SRC
|
||||||
|
|
91
src/mo_optimization/org/optimization.org
Normal file
91
src/mo_optimization/org/optimization.org
Normal file
@ -0,0 +1,91 @@
|
|||||||
|
#+BEGIN_SRC f90 :comments org :tangle optimization.irp.f
|
||||||
|
program optimization
|
||||||
|
|
||||||
|
read_wf = .true. ! must be True for the orbital optimization !!!
|
||||||
|
TOUCH read_wf
|
||||||
|
call run_optimization
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle optimization.irp.f
|
||||||
|
subroutine run_optimization
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision :: e_cipsi, e_opt, delta_e
|
||||||
|
integer :: nb_iter,i
|
||||||
|
logical :: not_converged
|
||||||
|
character (len=100) :: filename
|
||||||
|
|
||||||
|
PROVIDE psi_det psi_coef mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
not_converged = .True.
|
||||||
|
nb_iter = 0
|
||||||
|
|
||||||
|
! To start from the wf
|
||||||
|
N_det_max = max(n_det,5)
|
||||||
|
TOUCH N_det_max
|
||||||
|
|
||||||
|
open(unit=10, file=trim(ezfio_filename)//'/mo_optimization/result_opt')
|
||||||
|
write(10,*) " Ndet E_cipsi E_opt Delta_e"
|
||||||
|
call state_average_energy(e_cipsi)
|
||||||
|
write(10,'(I10, 3F15.7)') n_det, e_cipsi, e_cipsi, 0d0
|
||||||
|
close(10)
|
||||||
|
|
||||||
|
do while (not_converged)
|
||||||
|
print*,''
|
||||||
|
print*,'======================'
|
||||||
|
print*,' Cipsi step:', nb_iter
|
||||||
|
print*,'======================'
|
||||||
|
print*,''
|
||||||
|
print*,'********** cipsi step **********'
|
||||||
|
! cispi calculation
|
||||||
|
call run_stochastic_cipsi
|
||||||
|
|
||||||
|
! State average energy after the cipsi step
|
||||||
|
call state_average_energy(e_cipsi)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'********** optimization step **********'
|
||||||
|
! orbital optimization
|
||||||
|
call run_orb_opt_trust_v2
|
||||||
|
|
||||||
|
! State average energy after the orbital optimization
|
||||||
|
call state_average_energy(e_opt)
|
||||||
|
|
||||||
|
print*,''
|
||||||
|
print*,'********** diff step **********'
|
||||||
|
! Gain in energy
|
||||||
|
delta_e = e_opt - e_cipsi
|
||||||
|
print*, 'Gain in energy during the orbital optimization:', delta_e
|
||||||
|
|
||||||
|
open(unit=10, file=trim(ezfio_filename)//'/mo_optimization/result_opt', position='append')
|
||||||
|
write(10,'(I10, 3F15.7)') n_det, e_cipsi, e_opt, delta_e
|
||||||
|
close(10)
|
||||||
|
|
||||||
|
! Exit
|
||||||
|
if (delta_e > 1d-12) then
|
||||||
|
print*, 'WARNING, something wrong happened'
|
||||||
|
print*, 'The gain (delta_e) in energy during the optimization process'
|
||||||
|
print*, 'is > 0, but it must be < 0'
|
||||||
|
print*, 'The program will exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (n_det > n_det_max_opt) then
|
||||||
|
print*, 'The number of determinants in the wf > n_det_max_opt'
|
||||||
|
print*, 'The program will exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! To double the number of determinants in the wf
|
||||||
|
N_det_max = int(dble(n_det * 2)*0.9)
|
||||||
|
TOUCH N_det_max
|
||||||
|
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
#+END_SRC
|
349
src/mo_optimization/org/orb_opt_trust_v2.org
Normal file
349
src/mo_optimization/org/orb_opt_trust_v2.org
Normal file
@ -0,0 +1,349 @@
|
|||||||
|
* Orbital optimization program
|
||||||
|
|
||||||
|
This is an optimization program for molecular orbitals. It produces
|
||||||
|
orbital rotations in order to lower the energy of a truncated wave
|
||||||
|
function.
|
||||||
|
This program just optimize the orbitals for a fixed number of
|
||||||
|
determinants. This optimization process must be repeated for different
|
||||||
|
number of determinants.
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle orb_opt.irp.f
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
* Main program : orb_opt_trust
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle orb_opt.irp.f
|
||||||
|
program orb_opt
|
||||||
|
read_wf = .true. ! must be True for the orbital optimization !!!
|
||||||
|
TOUCH read_wf
|
||||||
|
io_mo_two_e_integrals = 'None'
|
||||||
|
TOUCH io_mo_two_e_integrals
|
||||||
|
call run_orb_opt_trust_v2
|
||||||
|
end
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
* Subroutine : run_orb_opt_trust
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle run_orb_opt_trust_v2.irp.f
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
Subroutine to optimize the MOs using a trust region algorithm:
|
||||||
|
- choice of the method
|
||||||
|
- initialization
|
||||||
|
- optimization until convergence
|
||||||
|
|
||||||
|
The optimization use the trust region algorithm, the different parts
|
||||||
|
are explained in the corresponding subroutine files.
|
||||||
|
|
||||||
|
qp_edit:
|
||||||
|
| thresh_opt_max_elem_grad |
|
||||||
|
| optimization_max_nb_iter |
|
||||||
|
| optimization_method |
|
||||||
|
|
||||||
|
Provided:
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
| ao_num | integer | number of AOs |
|
||||||
|
| N_states | integer | number of states |
|
||||||
|
| ci_energy(N_states) | double precision | CI energies |
|
||||||
|
| state_average_weight(N_states) | double precision | Weight of the different states |
|
||||||
|
|
||||||
|
Variables:
|
||||||
|
| m | integer | number of active MOs |
|
||||||
|
| tmp_n | integer | m*(m-1)/2, number of MO parameters |
|
||||||
|
| tmp_n2 | integer | m*(m-1)/2 or 1 if the hessian is diagonal |
|
||||||
|
| v_grad(tmp_n) | double precision | gradient |
|
||||||
|
| H(tmp_n,tmp_n) | double precision | hessian (2D) |
|
||||||
|
| h_f(m,m,m,m) | double precision | hessian (4D) |
|
||||||
|
| e_val(m) | double precision | eigenvalues of the hessian |
|
||||||
|
| w(m,m) | double precision | eigenvectors of the hessian |
|
||||||
|
| x(m) | double precision | step given by the trust region |
|
||||||
|
| m_x(m,m) | double precision | step given by the trust region after |
|
||||||
|
| tmp_R(m,m) | double precision | rotation matrix for active MOs |
|
||||||
|
| R(mo_num,mo_num) | double precision | full rotation matrix |
|
||||||
|
| prev_mos(ao_num,mo_num) | double precision | previous MOs (before the rotation) |
|
||||||
|
| new_mos(ao_num,mo_num) | double precision | new MOs (after the roration) |
|
||||||
|
| delta | double precision | radius of the trust region |
|
||||||
|
| rho | double precision | agreement between the model and the exact function |
|
||||||
|
| max_elem | double precision | maximum element in the gradient |
|
||||||
|
| i | integer | index |
|
||||||
|
| tmp_i,tmp_j | integer | indexes in the subspace containing only |
|
||||||
|
| | | the active MOs |
|
||||||
|
| converged | logical | convergence of the algorithm |
|
||||||
|
| cancel_step | logical | if the step must be cancelled |
|
||||||
|
| nb_iter | integer | number of iterations (accepted) |
|
||||||
|
| nb_diag | integer | number of diagonalizations of the CI matrix |
|
||||||
|
| nb_cancel | integer | number of cancelled steps for the actual iteration |
|
||||||
|
| nb_cancel_tot | integer | total number of cancel steps |
|
||||||
|
| info | integer | if 0 ok, else problem in the diagonalization of |
|
||||||
|
| | | the hessian with the Lapack routine |
|
||||||
|
| criterion | double precision | energy at a given step |
|
||||||
|
| prev_criterion | double precision | energy before the rotation |
|
||||||
|
| criterion_model | double precision | estimated energy after the rotation using |
|
||||||
|
| | | a Taylor series |
|
||||||
|
| must_exit | logical | To exit the trust region algorithm when |
|
||||||
|
| | | criterion - criterion_model is too small |
|
||||||
|
| enforce_step_cancellation | logical | To force the cancellation of the step if the |
|
||||||
|
| | | error in the rotation matrix is too large |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle run_orb_opt_trust_v2.irp.f
|
||||||
|
subroutine run_orb_opt_trust_v2
|
||||||
|
|
||||||
|
include 'constants.h'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Orbital optimization
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
! Variables
|
||||||
|
|
||||||
|
double precision, allocatable :: R(:,:)
|
||||||
|
double precision, allocatable :: H(:,:),h_f(:,:,:,:)
|
||||||
|
double precision, allocatable :: v_grad(:)
|
||||||
|
double precision, allocatable :: prev_mos(:,:),new_mos(:,:)
|
||||||
|
integer :: info
|
||||||
|
integer :: n
|
||||||
|
integer :: i,j,p,q,k
|
||||||
|
double precision :: max_elem_grad, delta, rho, norm_grad, normalization_factor
|
||||||
|
logical :: cancel_step
|
||||||
|
integer :: nb_iter, nb_diag, nb_cancel, nb_cancel_tot, nb_sub_iter
|
||||||
|
double precision :: t1, t2, t3
|
||||||
|
double precision :: prev_criterion, criterion, criterion_model
|
||||||
|
logical :: not_converged, must_exit, enforce_step_cancellation
|
||||||
|
integer :: m, tmp_n, tmp_i, tmp_j, tmp_k, tmp_n2
|
||||||
|
integer,allocatable :: tmp_list(:), key(:)
|
||||||
|
double precision, allocatable :: tmp_m_x(:,:),tmp_R(:,:), tmp_x(:), W(:,:), e_val(:)
|
||||||
|
|
||||||
|
PROVIDE mo_two_e_integrals_in_map ci_energy psi_det psi_coef
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Allocation
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle run_orb_opt_trust_v2.irp.f
|
||||||
|
allocate(R(mo_num,mo_num)) ! rotation matrix
|
||||||
|
allocate(prev_mos(ao_num,mo_num), new_mos(ao_num,mo_num)) ! old and new MOs
|
||||||
|
|
||||||
|
! Definition of m and tmp_n
|
||||||
|
m = dim_list_act_orb
|
||||||
|
tmp_n = m*(m-1)/2
|
||||||
|
|
||||||
|
allocate(tmp_list(m))
|
||||||
|
allocate(tmp_R(m,m), tmp_m_x(m,m), tmp_x(tmp_n))
|
||||||
|
allocate(e_val(tmp_n),key(tmp_n),v_grad(tmp_n))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Method
|
||||||
|
There are three different methods :
|
||||||
|
- the "full" hessian, which uses all the elements of the hessian
|
||||||
|
matrix"
|
||||||
|
- the "diagonal" hessian, which uses only the diagonal elements of the
|
||||||
|
hessian
|
||||||
|
- without the hessian (hessian = identity matrix)
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle run_orb_opt_trust_v2.irp.f
|
||||||
|
!Display the method
|
||||||
|
print*, 'Method :', optimization_method
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
print*, 'Full hessian'
|
||||||
|
allocate(H(tmp_n,tmp_n), h_f(m,m,m,m),W(tmp_n,tmp_n))
|
||||||
|
tmp_n2 = tmp_n
|
||||||
|
elseif (optimization_method == 'diag') then
|
||||||
|
print*,'Diagonal hessian'
|
||||||
|
allocate(H(tmp_n,1),W(tmp_n,1))
|
||||||
|
tmp_n2 = 1
|
||||||
|
elseif (optimization_method == 'none') then
|
||||||
|
print*,'No hessian'
|
||||||
|
allocate(H(tmp_n,1),W(tmp_n,1))
|
||||||
|
tmp_n2 = 1
|
||||||
|
else
|
||||||
|
print*,'Unknown optimization_method, please select full, diag or none'
|
||||||
|
call abort
|
||||||
|
endif
|
||||||
|
print*, 'Absolute value of the hessian:', absolute_eig
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Calculations
|
||||||
|
*** Algorithm
|
||||||
|
|
||||||
|
Here is the main algorithm of the optimization:
|
||||||
|
- First of all we initialize some parameters and we compute the
|
||||||
|
criterion (the ci energy) before doing any MO rotations
|
||||||
|
- We compute the gradient and the hessian for the active MOs
|
||||||
|
- We diagonalize the hessian
|
||||||
|
- We compute a step and loop to reduce the radius of the
|
||||||
|
trust region (and the size of the step by the way) until the step is
|
||||||
|
accepted
|
||||||
|
- We repeat the process until the convergence
|
||||||
|
NB: the convergence criterion can be changed
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle run_orb_opt_trust_v2.irp.f
|
||||||
|
! Loop until the convergence of the optimization
|
||||||
|
! call diagonalize_ci
|
||||||
|
|
||||||
|
!### Initialization ###
|
||||||
|
nb_iter = 0
|
||||||
|
rho = 0.5d0
|
||||||
|
not_converged = .True.
|
||||||
|
tmp_list = list_act ! Optimization of the active MOs
|
||||||
|
nb_cancel_tot = 0
|
||||||
|
|
||||||
|
! Renormalization of the weights of the states
|
||||||
|
call state_weight_normalization
|
||||||
|
|
||||||
|
! Compute the criterion before the loop
|
||||||
|
call state_average_energy(prev_criterion)
|
||||||
|
|
||||||
|
do while (not_converged)
|
||||||
|
print*,''
|
||||||
|
print*,'******************'
|
||||||
|
print*,'Iteration', nb_iter
|
||||||
|
print*,'******************'
|
||||||
|
print*,''
|
||||||
|
|
||||||
|
! Gradient
|
||||||
|
call gradient_list_opt(tmp_n, m, tmp_list, v_grad, max_elem_grad, norm_grad)
|
||||||
|
|
||||||
|
! Hessian
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
! Full hessian
|
||||||
|
call hessian_list_opt(tmp_n, m, tmp_list, H, h_f)
|
||||||
|
|
||||||
|
! Diagonalization of the hessian
|
||||||
|
call diagonalization_hessian(tmp_n, H, e_val, w)
|
||||||
|
|
||||||
|
elseif (optimization_method == 'diag') then
|
||||||
|
! Diagonal hessian
|
||||||
|
call diag_hessian_list_opt(tmp_n, m, tmp_list, H)
|
||||||
|
else
|
||||||
|
! Identity matrix
|
||||||
|
do tmp_i = 1, tmp_n
|
||||||
|
H(tmp_i,1) = 1d0
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (optimization_method /= 'full') then
|
||||||
|
! Sort
|
||||||
|
do tmp_i = 1, tmp_n
|
||||||
|
key(tmp_i) = tmp_i
|
||||||
|
e_val(tmp_i) = H(tmp_i,1)
|
||||||
|
enddo
|
||||||
|
call dsort(e_val,key,tmp_n)
|
||||||
|
|
||||||
|
! Eigenvalues and eigenvectors
|
||||||
|
do tmp_i = 1, tmp_n
|
||||||
|
w(tmp_i,1) = dble(key(tmp_i))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Init before the internal loop
|
||||||
|
cancel_step = .True. ! To enter in the loop just after
|
||||||
|
nb_cancel = 0
|
||||||
|
nb_sub_iter = 0
|
||||||
|
|
||||||
|
! Loop to reduce the trust radius until the criterion decreases and rho >= thresh_rho
|
||||||
|
do while (cancel_step)
|
||||||
|
print*,''
|
||||||
|
print*,'-----------------------------'
|
||||||
|
print*,'Iteration: ', nb_iter
|
||||||
|
print*,'Sub iteration:', nb_sub_iter
|
||||||
|
print*,'Max elem grad:', max_elem_grad
|
||||||
|
print*,'-----------------------------'
|
||||||
|
|
||||||
|
! Hessian,gradient,Criterion -> x
|
||||||
|
call trust_region_step_w_expected_e(tmp_n,tmp_n2,H,W,e_val,v_grad,prev_criterion,rho,nb_iter,delta,criterion_model,tmp_x,must_exit)
|
||||||
|
|
||||||
|
if (must_exit) then
|
||||||
|
print*,'step_in_trust_region sends: Exit'
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! 1D tmp -> 2D tmp
|
||||||
|
call vec_to_mat_v2(tmp_n, m, tmp_x, tmp_m_x)
|
||||||
|
|
||||||
|
! Rotation matrix for the active MOs
|
||||||
|
call rotation_matrix(tmp_m_x, m, tmp_R, m, m, info, enforce_step_cancellation)
|
||||||
|
|
||||||
|
! Security to ensure an unitary transformation
|
||||||
|
if (enforce_step_cancellation) then
|
||||||
|
print*, 'Step cancellation, too large error in the rotation matrix'
|
||||||
|
rho = 0d0
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
|
||||||
|
! tmp_R to R, subspace to full space
|
||||||
|
call sub_to_full_rotation_matrix(m, tmp_list, tmp_R, R)
|
||||||
|
|
||||||
|
! MO rotations
|
||||||
|
call apply_mo_rotation(R, prev_mos)
|
||||||
|
|
||||||
|
! Update of the energy before the diagonalization of the hamiltonian
|
||||||
|
call clear_mo_map
|
||||||
|
TOUCH mo_coef psi_det psi_coef ci_energy two_e_dm_mo
|
||||||
|
call state_average_energy(criterion)
|
||||||
|
|
||||||
|
! Criterion -> step accepted or rejected
|
||||||
|
call trust_region_is_step_cancelled(nb_iter, prev_criterion, criterion, criterion_model, rho, cancel_step)
|
||||||
|
|
||||||
|
! Cancellation of the step if necessary
|
||||||
|
if (cancel_step) then
|
||||||
|
mo_coef = prev_mos
|
||||||
|
call save_mos()
|
||||||
|
nb_cancel = nb_cancel + 1
|
||||||
|
nb_cancel_tot = nb_cancel_tot + 1
|
||||||
|
else
|
||||||
|
! Diagonalization of the hamiltonian
|
||||||
|
FREE ci_energy! To enforce the recomputation
|
||||||
|
call diagonalize_ci
|
||||||
|
call save_wavefunction_unsorted
|
||||||
|
|
||||||
|
! Energy obtained after the diagonalization of the CI matrix
|
||||||
|
call state_average_energy(prev_criterion)
|
||||||
|
endif
|
||||||
|
|
||||||
|
nb_sub_iter = nb_sub_iter + 1
|
||||||
|
enddo
|
||||||
|
call save_mos() !### depend of the time for 1 iteration
|
||||||
|
|
||||||
|
! To exit the external loop if must_exit = .True.
|
||||||
|
if (must_exit) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Step accepted, nb iteration + 1
|
||||||
|
nb_iter = nb_iter + 1
|
||||||
|
|
||||||
|
! External loop exit conditions
|
||||||
|
if (DABS(max_elem_grad) < thresh_opt_max_elem_grad) then
|
||||||
|
print*,'Converged: DABS(max_elem_grad) < thresh_opt_max_elem_grad'
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
if (nb_iter >= optimization_max_nb_iter) then
|
||||||
|
print*,'Not converged: nb_iter >= optimization_max_nb_iter'
|
||||||
|
not_converged = .False.
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (.not. not_converged) then
|
||||||
|
print*,'#############################'
|
||||||
|
print*,' End of the optimization'
|
||||||
|
print*,'#############################'
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Deallocation, end
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle run_orb_opt_trust_v2.irp.f
|
||||||
|
deallocate(v_grad,H,R,W,e_val)
|
||||||
|
deallocate(prev_mos,new_mos)
|
||||||
|
if (optimization_method == 'full') then
|
||||||
|
deallocate(h_f)
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
||||||
|
|
73
src/mo_optimization/org/state_average_energy.org
Normal file
73
src/mo_optimization/org/state_average_energy.org
Normal file
@ -0,0 +1,73 @@
|
|||||||
|
* State average energy
|
||||||
|
|
||||||
|
Calculation of the state average energy from the integrals and the
|
||||||
|
density matrices.
|
||||||
|
|
||||||
|
\begin{align*}
|
||||||
|
E = \sum_{ij} h_{ij} \gamma_{ij} + \frac{1}{2} v_{ij}^{kl} \Gamma_{ij}^{kl}
|
||||||
|
\end{align*}
|
||||||
|
$h_{ij}$: mono-electronic integral
|
||||||
|
$\gamma_{ij}$: one electron density matrix
|
||||||
|
$v_{ij}^{kl}$: bi-electronic integral
|
||||||
|
$\Gamma_{ij}^{kl}$: two electrons density matrix
|
||||||
|
|
||||||
|
TODO: OMP version
|
||||||
|
|
||||||
|
PROVIDED:
|
||||||
|
| mo_one_e_integrals | double precision | mono-electronic integrals |
|
||||||
|
| get_two_e_integral | double precision | bi-electronic integrals |
|
||||||
|
| one_e_dm_mo | double precision | one electron density matrix |
|
||||||
|
| two_e_dm_mo | double precision | two electrons density matrix |
|
||||||
|
| nuclear_repulsion | double precision | nuclear repulsion |
|
||||||
|
| mo_num | integer | number of MOs |
|
||||||
|
|
||||||
|
Output:
|
||||||
|
| energy | double precision | state average energy |
|
||||||
|
|
||||||
|
Internal:
|
||||||
|
| mono_e | double precision | mono-electronic energy |
|
||||||
|
| bi_e | double precision | bi-electronic energy |
|
||||||
|
| i,j,k,l | integer | indexes to loop over the MOs |
|
||||||
|
|
||||||
|
#+BEGIN_SRC f90 :comments org :tangle state_average_energy.irp.f
|
||||||
|
subroutine state_average_energy(energy)
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
double precision, intent(out) :: energy
|
||||||
|
|
||||||
|
double precision :: get_two_e_integral
|
||||||
|
double precision :: mono_e, bi_e
|
||||||
|
integer :: i,j,k,l
|
||||||
|
|
||||||
|
! mono electronic part
|
||||||
|
mono_e = 0d0
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
mono_e = mono_e + mo_one_e_integrals(i,j) * one_e_dm_mo(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! bi electronic part
|
||||||
|
bi_e = 0d0
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
bi_e = bi_e + get_two_e_integral(i,j,k,l,mo_integrals_map) * two_e_dm_mo(i,j,k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! State average energy
|
||||||
|
energy = mono_e + 0.5d0 * bi_e + nuclear_repulsion
|
||||||
|
|
||||||
|
! Check
|
||||||
|
!call print_energy_components
|
||||||
|
|
||||||
|
print*,'State average energy:', energy
|
||||||
|
!print*,ci_energy
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
31
src/mo_optimization/org/state_weight_normalization.org
Normal file
31
src/mo_optimization/org/state_weight_normalization.org
Normal file
@ -0,0 +1,31 @@
|
|||||||
|
#+BEGIN_SRC f90 :comments org :tangle state_weight_normalization.irp.f
|
||||||
|
subroutine state_weight_normalization
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Renormalization of the state weights or enforcing state average
|
||||||
|
! weights for orbital optimization
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
double precision :: normalization_factor
|
||||||
|
|
||||||
|
! To normalize the sum of the state weights
|
||||||
|
normalization_factor = 0d0
|
||||||
|
do i = 1, N_states
|
||||||
|
normalization_factor = normalization_factor + state_average_weight(i)
|
||||||
|
enddo
|
||||||
|
normalization_factor = 1d0 / normalization_factor
|
||||||
|
|
||||||
|
do i = 1, N_states
|
||||||
|
state_average_weight(i) = state_average_weight(i) * normalization_factor
|
||||||
|
enddo
|
||||||
|
TOUCH state_average_weight
|
||||||
|
|
||||||
|
print*, 'Number of states:', N_states
|
||||||
|
print*, 'State average weights:'
|
||||||
|
print*, state_average_weight(:)
|
||||||
|
|
||||||
|
end
|
||||||
|
#+END_SRC
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user