LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-16 09:35:19 +02:00
Code Releases Activity

Merge branch 'dev-stable' of github.com:quantumpackage/qp2 into dev-stable

Browse Source
This commit is contained in:
Anthony Scemama 2023-05-16 14:28:29 +02:00
commit 646e187ac9
33 changed files with 2681 additions and 450 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.github/workflows/compilation.yml vendored
View File

@ -48,6 +48,7 @@ jobs:
./configure -i docopt || :
./configure -i resultsFile || :
./configure -i bats || :
./configure -i trexio-nohdf5 || :
./configure -c ./config/gfortran_debug.cfg
- name: Compilation
run: |

8
.github/workflows/configuration.yml vendored
View File

@ -22,7 +22,7 @@ jobs:
- uses: actions/checkout@v3
- name: Install dependencies
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
run: |
./configure -i zlib || echo OK
@ -50,6 +50,12 @@ jobs:
- name: bats
run: |
./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
run: |
./configure -c config/gfortran_debug.cfg

35
configure vendored
View File

@ -9,6 +9,8 @@ echo "QP_ROOT="$QP_ROOT
unset CC
unset CCXX
TREXIO_VERSION=2.3.2
# Force GCC instead of ICC for dependencies
export CC=gcc
@ -189,7 +191,7 @@ if [[ "${PACKAGES}.x" != ".x" ]] ; then
fi
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
@ -203,6 +205,31 @@ for PACKAGE in ${PACKAGES} ; do
mv ninja "\${QP_ROOT}"/bin/
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
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
EOF
elif [[ ${PACKAGE} = gmp ]] ; then
@ -338,6 +365,12 @@ if [[ ${ZEROMQ} = $(not_found) ]] ; then
fail
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)
if [[ ${F77ZMQ} = $(not_found) ]] ; then
error "Fortran binding of ZeroMQ (f77zmq) is not installed."

5
data/basis/none Normal file
View File

@ -0,0 +1,5 @@
$DATA
HYDROGEN
$END

2
etc/qp.rc
View File

@ -188,7 +188,7 @@ _qp_Complete()
;;
esac;;
set_file)
COMPREPLY=( $(compgen -W "$(for i in $(find . -name ezfio | sed 's/ezfio$/.version/') ; do [[ -f $i ]] && echo ${i%/.version} ; 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
;;
plugins)

8
ocaml/Input_ao_basis.ml
View File

@ -247,8 +247,7 @@ end = struct
let read () =
if (Ezfio.has_ao_basis_ao_basis ()) then
begin
try
let result =
{ ao_basis = read_ao_basis ();
ao_num = read_ao_num () ;
@ -267,9 +266,8 @@ end = struct
|> MD5.to_string
|> Ezfio.set_ao_basis_ao_md5 ;
Some result
end
else
None
with
| _ -> (Ezfio.set_ao_basis_ao_md5 "None" ; None)
;;

262
ocaml/qp_create_ezfio.ml
View File

@ -478,6 +478,7 @@ let run ?o b au c d m p cart xyz_file =
let nmax =
Nucl_number.get_max ()
in
let rec do_work (accu:(Atom.t*Nucl_number.t) list) (n:int) = function
| [] -> accu
| e::tail ->
@ -520,141 +521,144 @@ let run ?o b au c d m p cart xyz_file =
in
let long_basis = Long_basis.of_basis basis in
let ao_num = List.length long_basis in
Ezfio.set_ao_basis_ao_num ao_num;
Ezfio.set_ao_basis_ao_basis b;
Ezfio.set_basis_basis b;
let ao_prim_num = list_map (fun (_,g,_) -> List.length g.Gto.lc) long_basis
and ao_nucl = list_map (fun (_,_,n) -> Nucl_number.to_int n) long_basis
and ao_power=
let l = list_map (fun (x,_,_) -> x) long_basis in
(list_map (fun t -> Positive_int.to_int Angmom.Xyz.(t.x)) l)@
(list_map (fun t -> Positive_int.to_int Angmom.Xyz.(t.y)) l)@
(list_map (fun t -> Positive_int.to_int Angmom.Xyz.(t.z)) l)
in
let ao_prim_num_max = List.fold_left (fun s x ->
if x > s then x
else s) 0 ao_prim_num
in
let gtos =
list_map (fun (_,x,_) -> x) long_basis
in
let create_expo_coef ec =
let coefs =
begin match ec with
| `Coefs -> list_map (fun x->
list_map (fun (_,coef) ->
AO_coef.to_float coef) x.Gto.lc) gtos
| `Expos -> list_map (fun x->
list_map (fun (prim,_) -> AO_expo.to_float
prim.GaussianPrimitive.expo) x.Gto.lc) gtos
end
if ao_num > 0 then
begin
Ezfio.set_ao_basis_ao_num ao_num;
Ezfio.set_ao_basis_ao_basis b;
Ezfio.set_basis_basis b;
let ao_prim_num = list_map (fun (_,g,_) -> List.length g.Gto.lc) long_basis
and ao_nucl = list_map (fun (_,_,n) -> Nucl_number.to_int n) long_basis
and ao_power=
let l = list_map (fun (x,_,_) -> x) long_basis in
(list_map (fun t -> Positive_int.to_int Angmom.Xyz.(t.x)) l)@
(list_map (fun t -> Positive_int.to_int Angmom.Xyz.(t.y)) l)@
(list_map (fun t -> Positive_int.to_int Angmom.Xyz.(t.z)) l)
in
let rec get_n n accu = function
| [] -> List.rev accu
| h::tail ->
let y =
begin match List.nth_opt h n with
| Some x -> x
| None -> 0.
let ao_prim_num_max = List.fold_left (fun s x ->
if x > s then x
else s) 0 ao_prim_num
in
let gtos =
list_map (fun (_,x,_) -> x) long_basis
in
let create_expo_coef ec =
let coefs =
begin match ec with
| `Coefs -> list_map (fun x->
list_map (fun (_,coef) ->
AO_coef.to_float coef) x.Gto.lc) gtos
| `Expos -> list_map (fun x->
list_map (fun (prim,_) -> AO_expo.to_float
prim.GaussianPrimitive.expo) x.Gto.lc) gtos
end
in
get_n n (y::accu) tail
in
let rec get_n n accu = function
| [] -> List.rev accu
| h::tail ->
let y =
begin match List.nth_opt h n with
| Some x -> x
| None -> 0.
end
in
get_n n (y::accu) tail
in
let rec build accu = function
| n when n=ao_prim_num_max -> accu
| n -> build ( accu @ (get_n n [] coefs) ) (n+1)
in
build [] 0
in
let rec build accu = function
| n when n=ao_prim_num_max -> accu
| n -> build ( accu @ (get_n n [] coefs) ) (n+1)
in
build [] 0
in
let ao_coef = create_expo_coef `Coefs
and ao_expo = create_expo_coef `Expos
in
let () =
let shell_num = List.length basis in
let lc : (GaussianPrimitive.t * Qptypes.AO_coef.t) list list =
list_map ( fun (g,_) -> g.Gto.lc ) basis
in
let ang_mom =
list_map (fun (l : (GaussianPrimitive.t * Qptypes.AO_coef.t) list) ->
let x, _ = List.hd l in
Angmom.to_l x.GaussianPrimitive.sym |> Qptypes.Positive_int.to_int
) lc
in
let expo =
list_map (fun l -> list_map (fun (x,_) -> Qptypes.AO_expo.to_float x.GaussianPrimitive.expo) l ) lc
|> List.concat
in
let coef =
list_map (fun l ->
list_map (fun (_,x) -> Qptypes.AO_coef.to_float x) l
) lc
|> List.concat
in
let shell_prim_num =
list_map List.length lc
in
let shell_idx =
let rec make_list n accu = function
| 0 -> accu
| i -> make_list n (n :: accu) (i-1)
let ao_coef = create_expo_coef `Coefs
and ao_expo = create_expo_coef `Expos
in
let rec aux count accu = function
| [] -> List.rev accu
| l::rest ->
let new_l = make_list count accu (List.length l) in
aux (count+1) new_l rest
in
aux 1 [] lc
in
let prim_num = List.length coef in
Ezfio.set_basis_typ "Gaussian";
Ezfio.set_basis_shell_num shell_num;
Ezfio.set_basis_prim_num prim_num ;
Ezfio.set_basis_shell_prim_num (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| shell_num |] ~data:shell_prim_num);
Ezfio.set_basis_shell_ang_mom (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| shell_num |] ~data:ang_mom ) ;
Ezfio.set_basis_shell_index (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| prim_num |] ~data:shell_idx) ;
Ezfio.set_basis_basis_nucleus_index (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| shell_num |]
~data:( list_map (fun (_,n) -> Nucl_number.to_int n) basis)
) ;
Ezfio.set_basis_nucleus_shell_num(Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| nucl_num |]
~data:(
list_map (fun (_,n) -> Nucl_number.to_int n) basis
|> List.fold_left (fun accu i ->
match accu with
| [] -> [(1,i)]
| (h,j) :: rest -> if j == i then ((h+1,j)::rest) else ((1,i)::(h,j)::rest)
) []
|> List.rev
|> List.map fst
)) ;
Ezfio.set_basis_prim_coef (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| prim_num |] ~data:coef) ;
Ezfio.set_basis_prim_expo (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| prim_num |] ~data:expo) ;
let () =
let shell_num = List.length basis in
let lc : (GaussianPrimitive.t * Qptypes.AO_coef.t) list list =
list_map ( fun (g,_) -> g.Gto.lc ) basis
in
let ang_mom =
list_map (fun (l : (GaussianPrimitive.t * Qptypes.AO_coef.t) list) ->
let x, _ = List.hd l in
Angmom.to_l x.GaussianPrimitive.sym |> Qptypes.Positive_int.to_int
) lc
in
let expo =
list_map (fun l -> list_map (fun (x,_) -> Qptypes.AO_expo.to_float x.GaussianPrimitive.expo) l ) lc
|> List.concat
in
let coef =
list_map (fun l ->
list_map (fun (_,x) -> Qptypes.AO_coef.to_float x) l
) lc
|> List.concat
in
let shell_prim_num =
list_map List.length lc
in
let shell_idx =
let rec make_list n accu = function
| 0 -> accu
| i -> make_list n (n :: accu) (i-1)
in
let rec aux count accu = function
| [] -> List.rev accu
| l::rest ->
let new_l = make_list count accu (List.length l) in
aux (count+1) new_l rest
in
aux 1 [] lc
in
let prim_num = List.length coef in
Ezfio.set_basis_typ "Gaussian";
Ezfio.set_basis_shell_num shell_num;
Ezfio.set_basis_prim_num prim_num ;
Ezfio.set_basis_shell_prim_num (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| shell_num |] ~data:shell_prim_num);
Ezfio.set_basis_shell_ang_mom (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| shell_num |] ~data:ang_mom ) ;
Ezfio.set_basis_shell_index (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| prim_num |] ~data:shell_idx) ;
Ezfio.set_basis_basis_nucleus_index (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| shell_num |]
~data:( list_map (fun (_,n) -> Nucl_number.to_int n) basis)
) ;
Ezfio.set_basis_nucleus_shell_num(Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| nucl_num |]
~data:(
list_map (fun (_,n) -> Nucl_number.to_int n) basis
|> List.fold_left (fun accu i ->
match accu with
| [] -> [(1,i)]
| (h,j) :: rest -> if j == i then ((h+1,j)::rest) else ((1,i)::(h,j)::rest)
) []
|> List.rev
|> List.map fst
)) ;
Ezfio.set_basis_prim_coef (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| prim_num |] ~data:coef) ;
Ezfio.set_basis_prim_expo (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| prim_num |] ~data:expo) ;
Ezfio.set_ao_basis_ao_prim_num (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| ao_num |] ~data:ao_prim_num) ;
Ezfio.set_ao_basis_ao_nucl(Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| ao_num |] ~data:ao_nucl) ;
Ezfio.set_ao_basis_ao_power(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; 3 |] ~data:ao_power) ;
Ezfio.set_ao_basis_ao_coef(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_coef) ;
Ezfio.set_ao_basis_ao_expo(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_expo) ;
Ezfio.set_ao_basis_ao_cartesian(cart);
in
match Input.Ao_basis.read () with
| None -> failwith "Error in basis"
| Some x -> Input.Ao_basis.write x
Ezfio.set_ao_basis_ao_prim_num (Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| ao_num |] ~data:ao_prim_num) ;
Ezfio.set_ao_basis_ao_nucl(Ezfio.ezfio_array_of_list
~rank:1 ~dim:[| ao_num |] ~data:ao_nucl) ;
Ezfio.set_ao_basis_ao_power(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; 3 |] ~data:ao_power) ;
Ezfio.set_ao_basis_ao_coef(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_coef) ;
Ezfio.set_ao_basis_ao_expo(Ezfio.ezfio_array_of_list
~rank:2 ~dim:[| ao_num ; ao_prim_num_max |] ~data:ao_expo) ;
Ezfio.set_ao_basis_ao_cartesian(cart);
in
match Input.Ao_basis.read () with
| None -> failwith "Error in basis"
| Some x -> Input.Ao_basis.write x
end
in
let () =
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
)
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

2
scripts/compilation/qp_create_ninja
View File

@ -38,7 +38,7 @@ def comp_path(path):
from qp_path import QP_ROOT, QP_SRC, QP_EZFIO
LIB = " -lz"
LIB = " -lz -ltrexio"
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"
ROOT_BUILD_NINJA = join("$QP_ROOT", "config", "build.ninja")

36
scripts/ezfio_interface/qp_edit_template
View File

@ -172,25 +172,23 @@ let run check_only ?ndet ?state ezfio_filename =
(* Reorder basis set *)
begin
let aos =
match Input.Ao_basis.read() with
| Some x -> x
| _ -> assert false
in
let ordering = Input.Ao_basis.ordering aos in
let test = Array.copy ordering in
Array.sort compare test ;
if test <> ordering then
begin
Printf.eprintf "Warning: Basis set is not properly ordered. Redordering.\n";
let new_aos = Input.Ao_basis.reorder aos in
Input.Ao_basis.write new_aos;
match Input.Mo_basis.read() with
| None -> ()
| Some mos ->
let new_mos = Input.Mo_basis.reorder mos ordering in
Input.Mo_basis.write new_mos
end
match Input.Ao_basis.read() with
| Some aos ->
let ordering = Input.Ao_basis.ordering aos in
let test = Array.copy ordering in
Array.sort compare test ;
if test <> ordering then
begin
Printf.eprintf "Warning: Basis set is not properly ordered. Redordering.\n";
let new_aos = Input.Ao_basis.reorder aos in
Input.Ao_basis.write new_aos;
match Input.Mo_basis.read() with
| None -> ()
| Some mos ->
let new_mos = Input.Mo_basis.reorder mos ordering in
Input.Mo_basis.write new_mos
end
| _ -> ()
end;
begin

18
scripts/qp_exc_energy.py
View File

@ -42,13 +42,15 @@ import sys, os
import scipy
import scipy.stats
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 """
with open(filename,'r') as f:
lines = json.load(f)['fci']
data = qp_json.load_last(ezfio_filename)
for method in data.keys():
x = data[method]
lines = x
print(f"State: {state}")
@ -138,15 +140,15 @@ def compute(data):
return mu, err, bias, p
filename = sys.argv[1]
print(filename)
ezfio_filename = sys.argv[1]
print(ezfio_filename)
if len(sys.argv) > 2:
state = int(sys.argv[2])
else:
state = 1
data = read_data(filename,state)
data = read_data(ezfio_filename,state)
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
A = np.array( [ [ data[-1][1], 1. ],

80
scripts/qp_extract_cipsi_data.py
View File

@ -1,55 +1,37 @@
#!/usr/bin/env python3
import re
import qp_json
import sys
# Read output file
with open(sys.argv[1], 'r') as file:
output = file.read()
if len(sys.argv) == 1:
print(f"syntax: {sys.argv[0]} EZFIO_FILE")
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)

425
scripts/qp_import_trexio.py Executable file
View File

@ -0,0 +1,425 @@
#!/usr/bin/env python3
"""
convert TREXIO file to EZFIO
Usage:
qp_import_trexio [-o EZFIO_DIR] FILE
Options:
-o --output=EZFIO_DIR Produced directory
by default is FILE.ezfio
"""
import sys
import os
import numpy as np
from functools import reduce
from ezfio import ezfio
from docopt import docopt
try:
import trexio
except ImportError:
print("Error: trexio python module is not found. Try python3 -m pip install trexio")
sys.exit(1)
try:
QP_ROOT = os.environ["QP_ROOT"]
QP_EZFIO = os.environ["QP_EZFIO"]
except KeyError:
print("Error: QP_ROOT environment variable not found.")
sys.exit(1)
else:
sys.path = [QP_EZFIO + "/Python",
QP_ROOT + "/install/resultsFile",
QP_ROOT + "/install",
QP_ROOT + "/scripts"] + sys.path
def generate_xyz(l):
def create_z(x,y,z):
return (x, y, l-(x+y))
def create_y(accu,x,y,z):
if y == 0:
result = [create_z(x,y,z)] + accu
else:
result = create_y([create_z(x,y,z)] + accu , x, y-1, z)
return result
def create_x(accu,x,y,z):
if x == 0:
result = create_y([], x,y,z) + accu
else:
xnew = x-1
ynew = l-xnew
result = create_x(create_y([],x,y,z) + accu , xnew, ynew, z)
return result
result = create_x([], l, 0, 0)
result.reverse()
return result
def write_ezfio(trexio_filename, filename):
try:
trexio_file = trexio.File(trexio_filename,mode='r',back_end=trexio.TREXIO_TEXT)
except:
trexio_file = trexio.File(trexio_filename,mode='r',back_end=trexio.TREXIO_HDF5)
ezfio.set_file(filename)
ezfio.set_trexio_trexio_file(trexio_filename)
print("Nuclei\t\t...\t", end=' ')
charge = [0.]
if trexio.has_nucleus(trexio_file):
charge = trexio.read_nucleus_charge(trexio_file)
ezfio.set_nuclei_nucl_num(len(charge))
ezfio.set_nuclei_nucl_charge(charge)
coord = trexio.read_nucleus_coord(trexio_file)
coord = np.transpose(coord)
ezfio.set_nuclei_nucl_coord(coord)
label = trexio.read_nucleus_label(trexio_file)
nucl_num = trexio.read_nucleus_num(trexio_file)
# Transformt H1 into H
import re
p = re.compile(r'(\d*)$')
label = [p.sub("", x).capitalize() for x in label]
ezfio.set_nuclei_nucl_label(label)
print("OK")
else:
ezfio.set_nuclei_nucl_num(1)
ezfio.set_nuclei_nucl_charge([0.])
ezfio.set_nuclei_nucl_coord([0.,0.,0.])
ezfio.set_nuclei_nucl_label(["X"])
print("None")
print("Electrons\t...\t", end=' ')
try:
num_beta = trexio.read_electron_dn_num(trexio_file)
except:
num_beta = int(sum(charge))//2
try:
num_alpha = trexio.read_electron_up_num(trexio_file)
except:
num_alpha = int(sum(charge)) - num_beta
if num_alpha == 0:
print("\n\nError: There are zero electrons in the TREXIO file.\n\n")
sys.exit(1)
ezfio.set_electrons_elec_alpha_num(num_alpha)
ezfio.set_electrons_elec_beta_num(num_beta)
print(f"{num_alpha} {num_beta}")
print("Basis\t\t...\t", end=' ')
shell_num = 0
try:
basis_type = trexio.read_basis_type(trexio_file)
if basis_type.lower() not in ["gaussian", "slater"]:
raise TypeError
shell_num = trexio.read_basis_shell_num(trexio_file)
prim_num = trexio.read_basis_prim_num(trexio_file)
ang_mom = trexio.read_basis_shell_ang_mom(trexio_file)
nucl_index = trexio.read_basis_nucleus_index(trexio_file)
exponent = trexio.read_basis_exponent(trexio_file)
coefficient = trexio.read_basis_coefficient(trexio_file)
shell_index = trexio.read_basis_shell_index(trexio_file)
ao_shell = trexio.read_ao_shell(trexio_file)
ezfio.set_basis_basis("Read from TREXIO")
ezfio.set_basis_shell_num(shell_num)
ezfio.set_basis_prim_num(prim_num)
ezfio.set_basis_shell_ang_mom(ang_mom)
ezfio.set_basis_basis_nucleus_index([ x+1 for x in nucl_index ])
ezfio.set_basis_prim_expo(exponent)
ezfio.set_basis_prim_coef(coefficient)
nucl_shell_num = []
prev = None
m = 0
for i in ao_shell:
if i != prev:
m += 1
if prev is None or nucl_index[i] != nucl_index[prev]:
nucl_shell_num.append(m)
m = 0
prev = i
assert (len(nucl_shell_num) == nucl_num)
shell_prim_num = []
prev = shell_index[0]
count = 0
for i in shell_index:
if i != prev:
shell_prim_num.append(count)
count = 0
count += 1
prev = i
shell_prim_num.append(count)
assert (len(shell_prim_num) == shell_num)
ezfio.set_basis_shell_prim_num(shell_prim_num)
ezfio.set_basis_shell_index([x+1 for x in shell_index])
ezfio.set_basis_nucleus_shell_num(nucl_shell_num)
shell_factor = trexio.read_basis_shell_factor(trexio_file)
prim_factor = trexio.read_basis_prim_factor(trexio_file)
print("OK")
except:
print("None")
ezfio.set_ao_basis_ao_cartesian(True)
print("AOS\t\t...\t", end=' ')
try:
cartesian = trexio.read_ao_cartesian(trexio_file)
except:
cartesian = True
if not cartesian:
raise TypeError('Only cartesian TREXIO files can be converted')
ao_num = trexio.read_ao_num(trexio_file)
ezfio.set_ao_basis_ao_num(ao_num)
if shell_num > 0:
ao_shell = trexio.read_ao_shell(trexio_file)
at = [ nucl_index[i]+1 for i in ao_shell ]
ezfio.set_ao_basis_ao_nucl(at)
num_prim0 = [ 0 for i in range(shell_num) ]
for i in shell_index:
num_prim0[i] += 1
coef = {}
expo = {}
for i,c in enumerate(coefficient):
idx = shell_index[i]
if idx in coef:
coef[idx].append(c)
expo[idx].append(exponent[i])
else:
coef[idx] = [c]
expo[idx] = [exponent[i]]
coefficient = []
exponent = []
power_x = []
power_y = []
power_z = []
num_prim = []
for i in range(shell_num):
for x,y,z in generate_xyz(ang_mom[i]):
power_x.append(x)
power_y.append(y)
power_z.append(z)
coefficient.append(coef[i])
exponent.append(expo[i])
num_prim.append(num_prim0[i])
assert (len(coefficient) == ao_num)
ezfio.set_ao_basis_ao_power(power_x + power_y + power_z)
ezfio.set_ao_basis_ao_prim_num(num_prim)
prim_num_max = max( [ len(x) for x in coefficient ] )
for i in range(ao_num):
coefficient[i] += [0. for j in range(len(coefficient[i]), prim_num_max)]
exponent [i] += [0. for j in range(len(exponent[i]), prim_num_max)]
coefficient = reduce(lambda x, y: x + y, coefficient, [])
exponent = reduce(lambda x, y: x + y, exponent , [])
coef = []
expo = []
for i in range(prim_num_max):
for j in range(i, len(coefficient), prim_num_max):
coef.append(coefficient[j])
expo.append(exponent[j])
# ezfio.set_ao_basis_ao_prim_num_max(prim_num_max)
ezfio.set_ao_basis_ao_coef(coef)
ezfio.set_ao_basis_ao_expo(expo)
ezfio.set_ao_basis_ao_basis("Read from TREXIO")
print("OK")
else:
print("None")
# _
# |\/| _ _ |_) _. _ o _
# | | (_) _> |_) (_| _> | _>
#
print("MOS\t\t...\t", end=' ')
labels = { "Canonical" : "Canonical",
"RHF" : "Canonical",
"BOYS" : "Localized",
"ROHF" : "Canonical",
"UHF" : "Canonical",
"Natural": "Natural" }
try:
label = labels[trexio.read_mo_type(trexio_file)]
except:
label = "None"
ezfio.set_mo_basis_mo_label(label)
try:
clss = trexio.read_mo_class(trexio_file)
core = [ i for i in clss if i.lower() == "core" ]
inactive = [ i for i in clss if i.lower() == "inactive" ]
active = [ i for i in clss if i.lower() == "active" ]
virtual = [ i for i in clss if i.lower() == "virtual" ]
deleted = [ i for i in clss if i.lower() == "deleted" ]
except trexio.Error:
pass
try:
mo_num = trexio.read_mo_num(trexio_file)
ezfio.set_mo_basis_mo_num(mo_num)
MoMatrix = trexio.read_mo_coefficient(trexio_file)
ezfio.set_mo_basis_mo_coef(MoMatrix)
mo_occ = [ 0. for i in range(mo_num) ]
for i in range(num_alpha):
mo_occ[i] += 1.
for i in range(num_beta):
mo_occ[i] += 1.
ezfio.set_mo_basis_mo_occ(mo_occ)
print("OK")
except:
print("None")
print("Pseudos\t\t...\t", end=' ')
ezfio.set_pseudo_do_pseudo(False)
if trexio.has_ecp_ang_mom(trexio_file):
ezfio.set_pseudo_do_pseudo(True)
max_ang_mom_plus_1 = trexio.read_ecp_max_ang_mom_plus_1(trexio_file)
z_core = trexio.read_ecp_z_core(trexio_file)
ang_mom = trexio.read_ecp_ang_mom(trexio_file)
nucleus_index = trexio.read_ecp_nucleus_index(trexio_file)
exponent = trexio.read_ecp_exponent(trexio_file)
coefficient = trexio.read_ecp_coefficient(trexio_file)
power = trexio.read_ecp_power(trexio_file)
lmax = max( max_ang_mom_plus_1 ) - 1
ezfio.set_pseudo_pseudo_lmax(lmax)
ezfio.set_pseudo_nucl_charge_remove(z_core)
prev_center = None
ecp = {}
for i in range(len(ang_mom)):
center = nucleus_index[i]
if center != prev_center:
ecp[center] = { "lmax": max_ang_mom_plus_1[center],
"zcore": z_core[center],
"contr": {} }
for j in range(max_ang_mom_plus_1[center]+1):
ecp[center]["contr"][j] = []
ecp[center]["contr"][ang_mom[i]].append( (coefficient[i], power[i], exponent[i]) )
prev_center = center
ecp_loc = {}
ecp_nl = {}
kmax = 0
klocmax = 0
for center in ecp:
ecp_nl [center] = {}
for k in ecp[center]["contr"]:
if k == ecp[center]["lmax"]:
ecp_loc[center] = ecp[center]["contr"][k]
klocmax = max(len(ecp_loc[center]), klocmax)
else:
ecp_nl [center][k] = ecp[center]["contr"][k]
kmax = max(len(ecp_nl [center][k]), kmax)
ezfio.set_pseudo_pseudo_klocmax(klocmax)
ezfio.set_pseudo_pseudo_kmax(kmax)
pseudo_n_k = [[0 for _ in range(nucl_num)] for _ in range(klocmax)]
pseudo_v_k = [[0. for _ in range(nucl_num)] for _ in range(klocmax)]
pseudo_dz_k = [[0. for _ in range(nucl_num)] for _ in range(klocmax)]
pseudo_n_kl = [[[0 for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
pseudo_v_kl = [[[0. for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
pseudo_dz_kl = [[[0. for _ in range(nucl_num)] for _ in range(kmax)] for _ in range(lmax+1)]
for center in ecp_loc:
for k in range( len(ecp_loc[center]) ):
v, n, dz = ecp_loc[center][k]
pseudo_n_k[k][center] = n
pseudo_v_k[k][center] = v
pseudo_dz_k[k][center] = dz
ezfio.set_pseudo_pseudo_n_k(pseudo_n_k)
ezfio.set_pseudo_pseudo_v_k(pseudo_v_k)
ezfio.set_pseudo_pseudo_dz_k(pseudo_dz_k)
for center in ecp_nl:
for l in range( len(ecp_nl[center]) ):
for k in range( len(ecp_nl[center][l]) ):
v, n, dz = ecp_nl[center][l][k]
pseudo_n_kl[l][k][center] = n
pseudo_v_kl[l][k][center] = v
pseudo_dz_kl[l][k][center] = dz
ezfio.set_pseudo_pseudo_n_kl(pseudo_n_kl)
ezfio.set_pseudo_pseudo_v_kl(pseudo_v_kl)
ezfio.set_pseudo_pseudo_dz_kl(pseudo_dz_kl)
print("OK")
else:
print("None")
def get_full_path(file_path):
file_path = os.path.expanduser(file_path)
file_path = os.path.expandvars(file_path)
return file_path
if __name__ == '__main__':
ARGUMENTS = docopt(__doc__)
FILE = get_full_path(ARGUMENTS['FILE'])
trexio_filename = FILE
if ARGUMENTS["--output"]:
EZFIO_FILE = get_full_path(ARGUMENTS["--output"])
else:
EZFIO_FILE = "{0}.ezfio".format(FILE)
write_ezfio(trexio_filename, EZFIO_FILE)
sys.stdout.flush()

66
scripts/utility/qp_json.py Normal file
View 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)

232
src/ao_two_e_ints/two_e_integrals.irp.f
View File

@ -563,8 +563,20 @@ double precision function general_primitive_integral(dim, &
d_poly(i)=0.d0
enddo
!DIR$ FORCEINLINE
call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
! call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
integer :: ib, ic
if (ior(n_Ix,n_Iy) >= 0) then
do ib=0,n_Ix
do ic = 0,n_Iy
d_poly(ib+ic) = d_poly(ib+ic) + Iy_pol(ic) * Ix_pol(ib)
enddo
enddo
do n_pt_tmp = n_Ix+n_Iy, 0, -1
if (d_poly(n_pt_tmp) /= 0.d0) exit
enddo
endif
if (n_pt_tmp == -1) then
return
endif
@ -573,8 +585,21 @@ double precision function general_primitive_integral(dim, &
d1(i)=0.d0
enddo
!DIR$ FORCEINLINE
call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
! call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
if (ior(n_pt_tmp,n_Iz) >= 0) then
! Bottleneck here
do ib=0,n_pt_tmp
do ic = 0,n_Iz
d1(ib+ic) = d1(ib+ic) + Iz_pol(ic) * d_poly(ib)
enddo
enddo
do n_pt_out = n_pt_tmp+n_Iz, 0, -1
if (d1(n_pt_out) /= 0.d0) exit
enddo
endif
double precision :: rint_sum
accu = accu + rint_sum(n_pt_out,const,d1)
@ -921,8 +946,20 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
X(ix) *= dble(a-1)
enddo
!DIR$ FORCEINLINE
call multiply_poly(X,nx,B_10,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_10,2,d,nd)
if (nx >= 0) then
integer :: ib
do ib=0,nx
d(ib ) = d(ib ) + B_10(0) * X(ib)
d(ib+1) = d(ib+1) + B_10(1) * X(ib)
d(ib+2) = d(ib+2) + B_10(2) * X(ib)
enddo
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
nx = nd
!DIR$ LOOP COUNT(8)
@ -943,8 +980,19 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
X(ix) *= c
enddo
endif
!DIR$ FORCEINLINE
call multiply_poly(X,nx,B_00,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_00,2,d,nd)
if (nx >= 0) then
do ib=0,nx
d(ib ) = d(ib ) + B_00(0) * X(ib)
d(ib+1) = d(ib+1) + B_00(1) * X(ib)
d(ib+2) = d(ib+2) + B_00(2) * X(ib)
enddo
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
endif
ny=0
@ -961,9 +1009,19 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
call I_x1_pol_mult_recurs(a-1,c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
endif
!DIR$ FORCEINLINE
call multiply_poly(Y,ny,C_00,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,C_00,2,d,nd)
if (ny >= 0) then
do ib=0,ny
d(ib ) = d(ib ) + C_00(0) * Y(ib)
d(ib+1) = d(ib+1) + C_00(1) * Y(ib)
d(ib+2) = d(ib+2) + C_00(2) * Y(ib)
enddo
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
end
recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
@ -1001,8 +1059,20 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
enddo
endif
!DIR$ FORCEINLINE
call multiply_poly(X,nx,B_00,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_00,2,d,nd)
if (nx >= 0) then
integer :: ib
do ib=0,nx
d(ib ) = d(ib ) + B_00(0) * X(ib)
d(ib+1) = d(ib+1) + B_00(1) * X(ib)
d(ib+2) = d(ib+2) + B_00(2) * X(ib)
enddo
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
ny=0
@ -1012,8 +1082,19 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
enddo
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
!DIR$ FORCEINLINE
call multiply_poly(Y,ny,C_00,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,C_00,2,d,nd)
if (ny >= 0) then
do ib=0,ny
d(ib ) = d(ib ) + C_00(0) * Y(ib)
d(ib+1) = d(ib+1) + C_00(1) * Y(ib)
d(ib+2) = d(ib+2) + C_00(2) * Y(ib)
enddo
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
end
@ -1040,8 +1121,20 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
nx = 0
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,X,nx,n_pt_in)
!DIR$ FORCEINLINE
call multiply_poly(X,nx,B_10,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_10,2,d,nd)
if (nx >= 0) then
integer :: ib
do ib=0,nx
d(ib ) = d(ib ) + B_10(0) * X(ib)
d(ib+1) = d(ib+1) + B_10(1) * X(ib)
d(ib+2) = d(ib+2) + B_10(2) * X(ib)
enddo
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
nx = nd
!DIR$ LOOP COUNT(8)
@ -1059,8 +1152,19 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
enddo
endif
!DIR$ FORCEINLINE
call multiply_poly(X,nx,B_00,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_00,2,d,nd)
if (nx >= 0) then
do ib=0,nx
d(ib ) = d(ib ) + B_00(0) * X(ib)
d(ib+1) = d(ib+1) + B_00(1) * X(ib)
d(ib+2) = d(ib+2) + B_00(2) * X(ib)
enddo
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
ny=0
!DIR$ LOOP COUNT(8)
@ -1070,9 +1174,19 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
!DIR$ FORCEINLINE
call I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
!DIR$ FORCEINLINE
call multiply_poly(Y,ny,C_00,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,C_00,2,d,nd)
if (ny >= 0) then
do ib=0,ny
d(ib ) = d(ib ) + C_00(0) * Y(ib)
d(ib+1) = d(ib+1) + C_00(1) * Y(ib)
d(ib+2) = d(ib+2) + C_00(2) * Y(ib)
enddo
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
end
recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
@ -1119,8 +1233,21 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
Y(1) = D_00(1)
Y(2) = D_00(2)
!DIR$ FORCEINLINE
call multiply_poly(Y,ny,D_00,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,D_00,2,d,nd)
if (ny >= 0) then
integer :: ib
do ib=0,ny
d(ib ) = d(ib ) + D_00(0) * Y(ib)
d(ib+1) = d(ib+1) + D_00(1) * Y(ib)
d(ib+2) = d(ib+2) + D_00(2) * Y(ib)
enddo
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
return
case default
@ -1137,8 +1264,19 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
X(ix) *= dble(c-1)
enddo
!DIR$ FORCEINLINE
call multiply_poly(X,nx,B_01,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(X,nx,B_01,2,d,nd)
if (nx >= 0) then
do ib=0,nx
d(ib ) = d(ib ) + B_01(0) * X(ib)
d(ib+1) = d(ib+1) + B_01(1) * X(ib)
d(ib+2) = d(ib+2) + B_01(2) * X(ib)
enddo
do nd = nx+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
ny = 0
!DIR$ LOOP COUNT(6)
@ -1147,8 +1285,19 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
enddo
call I_x2_pol_mult(c-1,B_10,B_01,B_00,C_00,D_00,Y,ny,dim)
!DIR$ FORCEINLINE
call multiply_poly(Y,ny,D_00,2,d,nd)
! !DIR$ FORCEINLINE
! call multiply_poly(Y,ny,D_00,2,d,nd)
if (ny >= 0) then
do ib=0,ny
d(ib ) = d(ib ) + D_00(0) * Y(ib)
d(ib+1) = d(ib+1) + D_00(1) * Y(ib)
d(ib+2) = d(ib+2) + D_00(2) * Y(ib)
enddo
do nd = ny+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
endif
end select
end
@ -1206,3 +1355,34 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
enddo
end
subroutine multiply_poly_local(b,nb,c,nc,d,nd)
implicit none
BEGIN_DOC
! Multiply two polynomials
! D(t) += B(t)*C(t)
END_DOC
integer, intent(in) :: nb, nc
integer, intent(out) :: nd
double precision, intent(in) :: b(0:nb), c(0:nc)
double precision, intent(inout) :: d(0:nb+nc)
integer :: ndtmp
integer :: ib, ic, id, k
if(ior(nc,nb) < 0) return !False if nc>=0 and nb>=0
do ib=0,nb
do ic = 0,nc
d(ib+ic) = d(ib+ic) + c(ic) * b(ib)
enddo
enddo
do nd = nb+nc,0,-1
if (d(nd) /= 0.d0) exit
enddo
end

152
src/ccsd/ccsd_space_orb_sub.irp.f
View File

@ -109,7 +109,7 @@ subroutine run_ccsd_space_orb
call update_t1(nO,nV,cc_space_f_o,cc_space_f_v,r1,t1)
call update_t2(nO,nV,cc_space_f_o,cc_space_f_v,r2,t2)
else
print*,'Unkonw cc_method_method: '//cc_update_method
print*,'Unkown cc_method_method: '//cc_update_method
endif
call update_tau_space(nO,nV,t1,t2,tau)
@ -169,7 +169,7 @@ subroutine run_ccsd_space_orb
! New
print*,'Computing (T) correction...'
call wall_time(ta)
call ccsd_par_t_space_v2(nO,nV,t1,t2,cc_space_f_o,cc_space_f_v &
call ccsd_par_t_space_v3(nO,nV,t1,t2,cc_space_f_o,cc_space_f_v &
,cc_space_v_vvvo,cc_space_v_vvoo,cc_space_v_vooo,e_t)
call wall_time(tb)
print*,'Time: ',tb-ta, ' s'
@ -211,8 +211,8 @@ subroutine ccsd_energy_space(nO,nV,tau,t1,energy)
!$omp default(none)
e = 0d0
!$omp do
do i = 1, nO
do a = 1, nV
do a = 1, nV
do i = 1, nO
e = e + 2d0 * cc_space_f_vo(a,i) * t1(i,a)
enddo
enddo
@ -255,7 +255,7 @@ subroutine update_tau_space(nO,nV,t1,t2,tau)
!$OMP SHARED(nO,nV,tau,t2,t1) &
!$OMP PRIVATE(i,j,a,b) &
!$OMP DEFAULT(NONE)
!$OMP DO collapse(3)
!$OMP DO
do b = 1, nV
do a = 1, nV
do j = 1, nO
@ -373,7 +373,7 @@ subroutine compute_r1_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
!$omp shared(nO,nV,X_voov,t2,t1) &
!$omp private(u,beta,i,a) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do beta = 1, nV
do u = 1, nO
do i = 1, nO
@ -412,7 +412,7 @@ subroutine compute_r1_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
!$omp shared(nO,nV,cc_space_v_ovov,cc_space_v_voov,X_ovov) &
!$omp private(u,beta,i,a) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do beta = 1, nV
do u = 1, nO
do a = 1, nv
@ -452,7 +452,7 @@ subroutine compute_r1_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
!$omp shared(nO,nV,cc_space_v_vvov,W_vvov,T_vvoo,tau) &
!$omp private(b,beta,i,a) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do beta = 1, nV
do i = 1, nO
do b = 1, nV
@ -464,11 +464,11 @@ subroutine compute_r1_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
enddo
!$omp end do nowait
!$omp do collapse(3)
do i = 1, nO
do b = 1, nV
do a = 1, nV
do u = 1, nO
!$omp do
do u = 1, nO
do i = 1, nO
do b = 1, nV
do a = 1, nV
T_vvoo(a,b,i,u) = tau(i,u,a,b)
enddo
enddo
@ -504,8 +504,8 @@ subroutine compute_r1_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
!$omp shared(nO,nV,cc_space_v_vooo,W_oovo) &
!$omp private(u,a,i,j) &
!$omp default(none)
!$omp do collapse(3)
do u = 1, nO
!$omp do
do a = 1, nV
do j = 1, nO
do i = 1, nO
@ -513,8 +513,8 @@ subroutine compute_r1_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do
!$omp end parallel
call dgemm('T','N', nO, nV, nO*nO*nV, &
@ -527,9 +527,7 @@ subroutine compute_r1_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r1,max_r1)
max_r1 = 0d0
do a = 1, nV
do i = 1, nO
if (dabs(r1(i,a)) > max_r1) then
max_r1 = dabs(r1(i,a))
endif
max_r1 = max(dabs(r1(i,a)), max_r1)
enddo
enddo
@ -657,7 +655,7 @@ subroutine compute_H_vv(nO,nV,t1,t2,tau,H_vv)
! H_vv(a,beta) = H_vv(a,beta) - cc_space_w_vvoo(a,b,i,j) * tau(i,j,beta,b)
! H_vv(a,beta) = H_vv(a,beta) - cc_space_w_vvoo(a,b,i,j) * tmp_tau(b,i,j,beta)
!$omp do collapse(3)
!$omp do
do beta = 1, nV
do j = 1, nO
do i = 1, nO
@ -727,7 +725,7 @@ subroutine compute_H_vo(nO,nV,t1,t2,H_vo)
! H_vo(a,i) = H_vo(a,i) + cc_space_w_vvoo(a,b,i,j) * t1(j,b)
! H_vo(a,i) = H_vo(a,i) + w(a,i,j,b) * t1(j,b)
!$omp do collapse(3)
!$omp do
do b = 1, nV
do j = 1, nO
do i = 1, nO
@ -787,7 +785,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,cc_space_v_oovv) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -863,7 +861,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,t2,X_oovv) &
!$omp private(u,v,gam,a) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do a = 1, nV
do gam = 1, nV
do v = 1, nO
@ -885,7 +883,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,Y_oovv) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -921,7 +919,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,X_oovv) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -957,7 +955,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,X_vovv,cc_space_v_ovvv) &
!$omp private(u,a,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do u = 1, nO
@ -979,7 +977,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,Y_oovv) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -1014,8 +1012,8 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,X_vovo,cc_space_v_ovov) &
!$omp private(u,v,gam,i) &
!$omp default(none)
!$omp do collapse(3)
do i = 1, nO
!$omp do
do gam = 1, nV
do u = 1, nO
do a = 1, nV
@ -1023,8 +1021,8 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do
!$omp end parallel
call dgemm('N','N',nV*nO*nV,nV,nO, &
@ -1041,7 +1039,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,X_oovv) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -1079,7 +1077,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,X_oovv) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -1116,8 +1114,8 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,X_vovo,cc_space_v_ovvo) &
!$omp private(a,v,gam,i) &
!$omp default(none)
!$omp do collapse(3)
do i = 1, nO
!$omp do
do gam = 1, nV
do v = 1, nO
do a = 1, nV
@ -1125,8 +1123,8 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do
!$omp end parallel
call dgemm('N','N',nO,nO*nV*nO,nV, &
@ -1143,7 +1141,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,X_oovv) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -1182,19 +1180,19 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,X_ovvo,Y_voov,K1,J1,t2) &
!$omp private(u,v,gam,beta,i,a) &
!$omp default(none)
!$omp do collapse(3)
do i = 1, nO
!$omp do
do a = 1, nV
do beta = 1, nV
do u = 1, nO
X_ovvo(u,beta,a,i) = 0.5d0 * (2d0 * J1(u,a,beta,i) - K1(u,a,i,beta))
X_ovvo(u,beta,a,i) = (J1(u,a,beta,i) - 0.5d0 * K1(u,a,i,beta))
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do nowait
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do v = 1, nO
do i = 1, nO
@ -1216,7 +1214,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,Z_ovov) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -1252,7 +1250,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,K1,X_ovov,Y_ovov,t2) &
!$omp private(u,a,i,beta,gam) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do beta = 1, nV
do u = 1, nO
do a = 1, nV
@ -1264,7 +1262,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
enddo
!$omp end do nowait
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do v = 1, nO
do a = 1, nV
@ -1286,7 +1284,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,Z_ovov) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -1319,7 +1317,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,K1,X_ovov,Z_ovov,t2) &
!$omp private(u,v,gam,beta,i,a) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do a = 1, nV
do i = 1, nO
do gam = 1, nV
@ -1331,7 +1329,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
enddo
!$omp end do nowait
!$omp do collapse(3)
!$omp do
do beta = 1, nV
do v = 1, nO
do a = 1, nV
@ -1353,7 +1351,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2,Z_ovov) &
!$omp private(u,v,gam,beta) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do v = 1, nO
@ -1373,7 +1371,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
!$omp shared(nO,nV,r2) &
!$omp private(i,j,a,b) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do b = 1, nV
do a = 1, nV
do j = 1, nO
@ -1391,9 +1389,7 @@ subroutine compute_r2_space(nO,nV,t1,t2,tau,H_oo,H_vv,H_vo,r2,max_r2)
do a = 1, nV
do j = 1, nO
do i = 1, nO
if (dabs(r2(i,j,a,b)) > max_r2) then
max_r2 = dabs(r2(i,j,a,b))
endif
max_r2 = max(r2(i,j,a,b), max_r2)
enddo
enddo
enddo
@ -1448,7 +1444,7 @@ subroutine compute_A1(nO,nV,t1,t2,tau,A1)
!$omp shared(nO,nV,A1,cc_space_v_oooo,cc_space_v_ovoo,X_vooo) &
!$omp private(u,v,i,j) &
!$omp default(none)
!$omp do collapse(3)
!$omp do collapse(2)
do j = 1, nO
do i = 1, nO
do v = 1, nO
@ -1462,7 +1458,7 @@ subroutine compute_A1(nO,nV,t1,t2,tau,A1)
! A1(u,v,i,j) += cc_space_v_ovoo(u,a,i,j) * t1(v,a) &
!$omp do collapse(3)
!$omp do collapse(2)
do j = 1, nO
do i = 1, nO
do u = 1, nO
@ -1484,7 +1480,7 @@ subroutine compute_A1(nO,nV,t1,t2,tau,A1)
!$omp shared(nO,nV,A1,Y_oooo) &
!$omp private(u,v,i,j) &
!$omp default(none)
!$omp do collapse(3)
!$omp do collapse(2)
do j = 1, nO
do i = 1, nO
do v = 1, nO
@ -1553,7 +1549,7 @@ subroutine compute_B1(nO,nV,t1,t2,B1)
!$omp shared(nO,nV,B1,cc_space_v_vvvv,cc_space_v_vvov,X_vvvo) &
!$omp private(a,b,beta,gam) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do b = 1, nV
@ -1564,8 +1560,8 @@ subroutine compute_B1(nO,nV,t1,t2,B1)
enddo
enddo
!$omp end do nowait
!$omp do collapse(3)
do i = 1, nO
!$omp do
do gam = 1, nV
do b = 1, nV
do a = 1, nV
@ -1573,8 +1569,8 @@ subroutine compute_B1(nO,nV,t1,t2,B1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do
!$omp end parallel
! B1(a,b,beta,gam) -= cc_space_v_vvvo(a,b,beta,i) * t1(i,gam) &
@ -1594,7 +1590,7 @@ subroutine compute_B1(nO,nV,t1,t2,B1)
!$omp shared(nV,B1,Y_vvvv) &
!$omp private(a,b,beta,gam) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do gam = 1, nV
do beta = 1, nV
do b = 1, nV
@ -1658,7 +1654,7 @@ subroutine compute_g_occ(nO,nV,t1,t2,H_oo,g_occ)
enddo
!$omp end do
!$omp do collapse(1)
!$omp do
do i = 1, nO
do j = 1, nO
do a = 1, nV
@ -1720,7 +1716,7 @@ subroutine compute_g_vir(nO,nV,t1,t2,H_vv,g_vir)
enddo
!$omp end do
!$omp do collapse(1)
!$omp do
do beta = 1, nV
do i = 1, nO
do b = 1, nV
@ -1788,8 +1784,8 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
!$omp shared(nO,nV,J1,v_ovvo,v_ovoo,X_ovoo) &
!$omp private(i,j,a,u,beta) &
!$omp default(none)
!$omp do collapse(3)
do i = 1, nO
!$omp do
do beta = 1, nV
do a = 1, nV
do u = 1, nO
@ -1797,10 +1793,10 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do nowait
!$omp do collapse(3)
!$omp do collapse(2)
do j = 1, nO
do i = 1, nO
do a = 1, nV
@ -1822,8 +1818,8 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
!$omp shared(nO,nV,J1,Y_ovov) &
!$omp private(i,beta,a,u) &
!$omp default(none)
!$omp do collapse(3)
do i = 1, nO
!$omp do
do beta = 1, nV
do a = 1, nV
do u = 1, nO
@ -1831,8 +1827,8 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do
!$omp end parallel
deallocate(X_ovoo)
@ -1849,7 +1845,7 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
!$omp shared(nO,nV,t2,t1,Y_ovov,X_voov,v_vvoo) &
!$omp private(i,beta,a,u,b,j) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do b = 1, nV
do j = 1, nO
do beta = 1, nV
@ -1861,7 +1857,7 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
enddo
!$omp end do nowait
!$omp do collapse(3)
!$omp do
do b = 1, nV
do j = 1, nO
do i = 1, nO
@ -1886,8 +1882,8 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
!$omp shared(nO,nV,J1,Z_ovvo,t2,Y_vovo,v_vvoo,X_ovvo) &
!$omp private(i,beta,a,u,j,b) &
!$omp default(none)
!$omp do collapse(3)
do i = 1, nO
!$omp do
do beta = 1, nV
do a = 1, nV
do u = 1, nO
@ -1895,12 +1891,12 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do nowait
!+ 0.5d0 * (2d0 * cc_space_v_vvoo(a,b,i,j) - cc_space_v_vvoo(b,a,i,j)) * t2(u,j,beta,b)
!$omp do collapse(3)
do j = 1, nO
!$omp do
do b = 1, nV
do i = 1, nO
do a = 1, nV
@ -1908,11 +1904,11 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do nowait
!$omp do collapse(3)
do j = 1, nO
!$omp do
do b = 1, nV
do beta = 1, nV
do u = 1, nO
@ -1920,8 +1916,8 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do
!$omp end parallel
call dgemm('N','T',nO*nV,nV*nO,nV*nO, &
@ -1933,8 +1929,8 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
!$omp shared(nO,nV,J1,Z_ovvo) &
!$omp private(i,beta,a,u) &
!$omp default(none)
!$omp do collapse(3)
do i = 1, nO
!$omp do
do beta = 1, nV
do a = 1, nV
do u = 1, nO
@ -1942,8 +1938,8 @@ subroutine compute_J1(nO,nV,t1,t2,v_ovvo,v_ovoo,v_vvvo,v_vvoo,J1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do
!$omp end parallel
deallocate(X_ovvo,Z_ovvo,Y_ovov)
@ -2003,7 +1999,7 @@ subroutine compute_K1(nO,nV,t1,t2,v_ovoo,v_vvoo,v_ovov,v_vvov,K1)
!$omp shared(nO,nV,K1,X,Y,v_vvoo,v_ovov,t1,t2) &
!$omp private(i,beta,a,u,j,b) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do beta = 1, nV
do i = 1, nO
do a = 1, nV
@ -2015,8 +2011,8 @@ subroutine compute_K1(nO,nV,t1,t2,v_ovoo,v_vvoo,v_ovov,v_vvov,K1)
enddo
!$omp end do nowait
!$omp do collapse(3)
do i = 1, nO
!$omp do
do a = 1, nV
do j = 1, nO
do b = 1, nV
@ -2024,11 +2020,11 @@ subroutine compute_K1(nO,nV,t1,t2,v_ovoo,v_vvoo,v_ovov,v_vvov,K1)
enddo
enddo
enddo
!$omp end do nowait
enddo
!$omp end do nowait
!$omp do collapse(3)
do j = 1, nO
!$omp do
do b = 1, nV
do beta = 1, nV
do u = 1, nO
@ -2036,8 +2032,8 @@ subroutine compute_K1(nO,nV,t1,t2,v_ovoo,v_vvoo,v_ovov,v_vvov,K1)
enddo
enddo
enddo
!$omp end do
enddo
!$omp end do
!$omp end parallel
call dgemm('N','N',nO*nV*nO,nV,nO, &
@ -2060,7 +2056,7 @@ subroutine compute_K1(nO,nV,t1,t2,v_ovoo,v_vvoo,v_ovov,v_vvov,K1)
!$omp shared(nO,nV,K1,Z) &
!$omp private(i,beta,a,u) &
!$omp default(none)
!$omp do collapse(3)
!$omp do
do beta = 1, nV
do i = 1, nO
do a = 1, nV

247
src/ccsd/ccsd_t_space_orb.irp.f
View File

@ -8,15 +8,15 @@ subroutine ccsd_par_t_space(nO,nV,t1,t2,energy)
double precision, intent(in) :: t1(nO, nV)
double precision, intent(in) :: t2(nO, nO, nV, nV)
double precision, intent(out) :: energy
double precision, allocatable :: W(:,:,:,:,:,:)
double precision, allocatable :: V(:,:,:,:,:,:)
integer :: i,j,k,a,b,c
allocate(W(nO,nO,nO,nV,nV,nV))
allocate(V(nO,nO,nO,nV,nV,nV))
call form_w(nO,nV,t2,W)
call form_w(nO,nV,t2,W)
call form_v(nO,nV,t1,W,V)
energy = 0d0
@ -33,9 +33,9 @@ subroutine ccsd_par_t_space(nO,nV,t1,t2,energy)
enddo
enddo
enddo
energy = energy / 3d0
deallocate(V,W)
end
@ -46,7 +46,7 @@ subroutine form_w(nO,nV,t2,W)
integer, intent(in) :: nO,nV
double precision, intent(in) :: t2(nO, nO, nV, nV)
double precision, intent(out) :: W(nO, nO, nO, nV, nV, nV)
integer :: i,j,k,l,a,b,c,d
W = 0d0
@ -133,7 +133,7 @@ subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
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_ijk(:,:,:), V_ijk(:,:,:)
@ -141,7 +141,7 @@ subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
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_ijk
!allocate(W(nV,nV,nV,nO,nO,nO))
!allocate(V(nV,nV,nV,nO,nO,nO))
allocate(W_ijk(nV,nV,nV), V_ijk(nV,nV,nV))
@ -154,10 +154,10 @@ subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
!$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
@ -181,7 +181,7 @@ subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
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) &
@ -208,10 +208,10 @@ subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
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
@ -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
!$OMP END DO
!$OMP END DO NOWAIT
!$OMP CRITICAL
energy = energy + e
!$OMP END CRITICAL
@ -267,7 +267,7 @@ subroutine ccsd_par_t_space_v2(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energy)
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_ijk,V_ijk,X_vvvo,X_ovoo,T_vvoo,T_ovvo,T_vo)
@ -285,78 +285,178 @@ subroutine form_w_ijk(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W)
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(nV,nV,nV)!,nO,nO,nO)
integer :: l,a,b,c,d
double precision, allocatable, dimension(:,:,:) :: X, Y, Z
!W = 0d0
!do i = 1, nO
! do j = 1, nO
! do k = 1, nO
!$OMP PARALLEL &
!$OMP SHARED(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W) &
!$OMP PRIVATE(a,b,c,d,l) &
!$OMP DEFAULT(NONE)
!$OMP DO collapse(2)
do c = 1, nV
do b = 1, nV
do a = 1, nV
W(a,b,c) = 0d0
allocate(X(nV,nV,nV))
allocate(Y(nV,nV,nV))
allocate(Z(nV,nV,nV))
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
!$OMP PARALLEL DO
do b = 1, nV
do a = 1, nV
do d = 1, nV
Z(d,a,b) = X_vvvo(d,b,a,i)
enddo
enddo
enddo
!$OMP END DO nowait
!$OMP END PARALLEL DO
!$OMP DO collapse(2)
call dgemm('T','N',nV*nV,nV,nV, 1.d0, &
Z, nV, T_vvoo(1,1,k,j), nV, 0.d0, W, nV*nV)
!$OMP PARALLEL DO
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
- 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
do a = 1, nV
do d = 1, nV
Z(d,a,c) = X_vvvo(d,c,a,i)
enddo
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
!$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 b = 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
deallocate(X,Y,Z)
! !$OMP PARALLEL &
! !$OMP SHARED(nO,nV,i,j,k,T_vvoo,T_ovvo,X_vvvo,X_ovoo,W) &
! !$OMP PRIVATE(a,b,c,d,l) &
! !$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
@ -382,7 +482,7 @@ implicit none
!do i = 1, nO
! do j = 1, nO
! do k = 1, nO
!$OMP PARALLEL &
!$OMP SHARED(nO,nV,i,j,k,T_vo,X_vvoo,W,V) &
!$OMP PRIVATE(a,b,c) &
@ -404,9 +504,10 @@ implicit none
enddo
!$OMP END DO
!$OMP END PARALLEL
! enddo
! enddo
!enddo
end

400
src/ccsd/ccsd_t_space_orb_abc.irp.f Normal file
View File

@ -0,0 +1,400 @@
! 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(:,:,:), W_cab(:,:,:), W_bca(:,:,:)
double precision, allocatable :: W_bac(:,:,:), W_cba(:,:,:), W_acb(:,:,:)
double precision, allocatable :: V_abc(:,:,:), V_cab(:,:,:), V_bca(:,:,:)
double precision, allocatable :: V_bac(:,:,:), V_cba(:,:,:), V_acb(:,:,:)
double precision, allocatable :: X_vovv(:,:,:,:), X_ooov(:,:,:,:), X_oovv(:,:,:,:)
double precision, allocatable :: T_voov(:,:,:,:), T_oovv(:,:,:,:)
integer :: i,j,k,l,a,b,c,d
double precision :: e,ta,tb, delta, delta_abc, x1, x2, x3
allocate(X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV), X_oovv(nO,nO,nV,nV))
allocate(T_voov(nV,nO,nO,nV),T_oovv(nO,nO,nV,nV))
call set_multiple_levels_omp(.False.)
! Temporary arrays
!$OMP PARALLEL &
!$OMP SHARED(nO,nV,T_voov,T_oovv,X_vovv,X_ooov,X_oovv, &
!$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_vovv(d,i,b,a,i) * T_voov(d,j,c,k)
!$OMP DO
do a = 1, nV
do b = 1, nV
do i = 1, nO
do d = 1, nV
X_vovv(d,i,b,a) = v_vvvo(b,a,d,i)
enddo
enddo
enddo
enddo
!$OMP END DO nowait
!$OMP DO
do c = 1, nV
do j = 1, nO
do k = 1, nO
do d = 1, nV
T_voov(d,k,j,c) = 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_ooov(l,j,k,c) * T_oovv(l,i,a,b) &
!$OMP DO
do c = 1, nV
do k = 1, nO
do j = 1, nO
do l = 1, nO
X_ooov(l,j,k,c) = v_vooo(c,j,k,l)
enddo
enddo
enddo
enddo
!$OMP END DO nowait
!$OMP DO
do b = 1, nV
do a = 1, nV
do i = 1, nO
do l = 1, nO
T_oovv(l,i,a,b) = t2(i,l,a,b)
enddo
enddo
enddo
enddo
!$OMP END DO nowait
!X_oovv(j,k,b,c) * T1_vo(a,i) &
!$OMP DO
do c = 1, nV
do b = 1, nV
do k = 1, nO
do j = 1, nO
X_oovv(j,k,b,c) = v_vvoo(b,c,j,k)
enddo
enddo
enddo
enddo
!$OMP END DO nowait
!$OMP END PARALLEL
energy = 0d0
!$OMP PARALLEL &
!$OMP PRIVATE(a,b,c,x1) &
!$OMP PRIVATE(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
!$OMP V_abc, V_cab, V_bca, V_bac, V_cba, V_acb ) &
!$OMP PRIVATE(i,j,k,e,delta,delta_abc) &
!$OMP DEFAULT(SHARED)
allocate( W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO), &
W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO), &
V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO), &
V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO) )
e = 0d0
!$OMP DO SCHEDULE(dynamic)
do a = 1, nV
do b = a+1, nV
do c = b+1, nV
delta_abc = f_v(a) + f_v(b) + f_v(c)
call form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
call form_v_abc(nO,nV,a,b,c,t1,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
do k = 1, nO
do j = 1, nO
do i = 1, nO
delta = 1.d0 / (f_o(i) + f_o(j) + f_o(k) - delta_abc)
e = e + delta * ( &
(4d0 * (W_abc(i,j,k) - W_cba(i,j,k)) + &
W_bca(i,j,k) - W_bac(i,j,k) + &
W_cab(i,j,k) - W_acb(i,j,k) ) * (V_abc(i,j,k) - V_cba(i,j,k)) + &
(4d0 * (W_acb(i,j,k) - W_bca(i,j,k)) + &
W_cba(i,j,k) - W_cab(i,j,k) + &
W_bac(i,j,k) - W_abc(i,j,k) ) * (V_acb(i,j,k) - V_bca(i,j,k)) + &
(4d0 * (W_bac(i,j,k) - W_cab(i,j,k)) + &
W_acb(i,j,k) - W_abc(i,j,k) + &
W_cba(i,j,k) - W_bca(i,j,k) ) * (V_bac(i,j,k) - V_cab(i,j,k)) )
enddo
enddo
enddo
enddo
enddo
c = a
do b = 1, nV
if (b == c) cycle
delta_abc = f_v(a) + f_v(b) + f_v(c)
call form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
call form_v_abc(nO,nV,a,b,c,t1,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
do k = 1, nO
do j = 1, nO
do i = 1, nO
delta = 1.0d0 / (f_o(i) + f_o(j) + f_o(k) - delta_abc)
e = e + delta * ( &
(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)) + &
(4d0 * W_acb(i,j,k) + W_cba(i,j,k) + W_bac(i,j,k)) * (V_acb(i,j,k) - V_bca(i,j,k)) + &
(4d0 * W_bac(i,j,k) + W_acb(i,j,k) + W_cba(i,j,k)) * (V_bac(i,j,k) - V_cab(i,j,k)) )
enddo
enddo
enddo
enddo
enddo
!$OMP END DO NOWAIT
!$OMP CRITICAL
energy = energy + e
!$OMP END CRITICAL
deallocate(W_abc, W_cab, W_bca, W_bac, W_cba, W_acb, &
V_abc, V_cab, V_bca, V_bac, V_cba, V_acb )
!$OMP END PARALLEL
energy = energy / 3.d0
deallocate(X_vovv,X_ooov,T_voov,T_oovv)
end
subroutine form_w_abc(nO,nV,a,b,c,T_voov,T_oovv,X_vovv,X_ooov,W_abc,W_cba,W_bca,W_cab,W_bac,W_acb)
implicit none
integer, intent(in) :: nO,nV,a,b,c
double precision, intent(in) :: T_voov(nV,nO,nO,nV), T_oovv(nO,nO,nV,nV)
double precision, intent(in) :: X_vovv(nV,nO,nV,nV), X_ooov(nO,nO,nO,nV)
double precision, intent(out) :: W_abc(nO,nO,nO)
double precision, intent(out) :: W_cba(nO,nO,nO)
double precision, intent(out) :: W_bca(nO,nO,nO)
double precision, intent(out) :: W_cab(nO,nO,nO)
double precision, intent(out) :: W_bac(nO,nO,nO)
double precision, intent(out) :: W_acb(nO,nO,nO)
integer :: l,i,j,k,d
double precision, allocatable, dimension(:,:,:,:) :: W_ikj
double precision, allocatable :: X(:,:,:,:)
allocate(W_ikj(nO,nO,nO,6))
allocate(X(nV,nO,nO,3))
do k=1,nO
do i=1,nO
do d=1,nV
X(d,i,k,1) = T_voov(d,k,i,a)
X(d,i,k,2) = T_voov(d,k,i,b)
X(d,i,k,3) = T_voov(d,k,i,c)
enddo
enddo
enddo
! X_vovv(d,i,c,a) * T_voov(d,j,k,b) : i jk
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,c,a), nV, T_voov(1,1,1,b), nV, 0.d0, W_abc, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,c,b), nV, T_voov(1,1,1,a), nV, 0.d0, W_bac, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,a,c), nV, T_voov(1,1,1,b), nV, 0.d0, W_cba, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,a,b), nV, T_voov(1,1,1,c), nV, 0.d0, W_bca, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,b,c), nV, T_voov(1,1,1,a), nV, 0.d0, W_cab, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,b,a), nV, T_voov(1,1,1,c), nV, 0.d0, W_acb, nO)
! T_voov(d,i,j,a) * X_vovv(d,k,b,c) : ij k
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,a), nV, X_vovv(1,1,b,c), nV, 1.d0, W_abc, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,b), nV, X_vovv(1,1,a,c), nV, 1.d0, W_bac, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,c), nV, X_vovv(1,1,b,a), nV, 1.d0, W_cba, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,b), nV, X_vovv(1,1,c,a), nV, 1.d0, W_bca, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,c), nV, X_vovv(1,1,a,b), nV, 1.d0, W_cab, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,a), nV, X_vovv(1,1,c,b), nV, 1.d0, W_acb, nO*nO)
! X_vovv(d,k,a,c) * T_voov(d,j,i,b) : k ji
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,2), nV, X_vovv(1,1,a,c), nV, 1.d0, W_abc, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,1), nV, X_vovv(1,1,b,c), nV, 1.d0, W_bac, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,2), nV, X_vovv(1,1,c,a), nV, 1.d0, W_cba, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,3), nV, X_vovv(1,1,b,a), nV, 1.d0, W_bca, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,1), nV, X_vovv(1,1,c,b), nV, 1.d0, W_cab, nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,3), nV, X_vovv(1,1,a,b), nV, 1.d0, W_acb, nO*nO)
! X_vovv(d,i,b,a) * T_voov(d,k,j,c) : i kj
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,b,a), nV, X(1,1,1,3), nV, 1.d0, W_abc, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,a,b), nV, X(1,1,1,3), nV, 1.d0, W_bac, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,b,c), nV, X(1,1,1,1), nV, 1.d0, W_cba, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,c,b), nV, X(1,1,1,1), nV, 1.d0, W_bca, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,a,c), nV, X(1,1,1,2), nV, 1.d0, W_cab, nO)
call dgemm('T','N', nO, nO*nO, nV, 1.d0, X_vovv(1,1,c,a), nV, X(1,1,1,2), nV, 1.d0, W_acb, nO)
! T_voov(d,k,i,c) * X_vovv(d,j,a,b) : ki j
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,3), nV, X_vovv(1,1,a,b), nV, 0.d0, W_ikj(1,1,1,1), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,3), nV, X_vovv(1,1,b,a), nV, 0.d0, W_ikj(1,1,1,2), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,1), nV, X_vovv(1,1,c,b), nV, 0.d0, W_ikj(1,1,1,3), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,1), nV, X_vovv(1,1,b,c), nV, 0.d0, W_ikj(1,1,1,4), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,2), nV, X_vovv(1,1,c,a), nV, 0.d0, W_ikj(1,1,1,5), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, X(1,1,1,2), nV, X_vovv(1,1,a,c), nV, 0.d0, W_ikj(1,1,1,6), nO*nO)
! T_voov(d,i,k,a) * X_vovv(d,j,c,b) : ik j
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,a), nV, X_vovv(1,1,c,b), nV, 1.d0, W_ikj(1,1,1,1), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,b), nV, X_vovv(1,1,c,a), nV, 1.d0, W_ikj(1,1,1,2), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,c), nV, X_vovv(1,1,a,b), nV, 1.d0, W_ikj(1,1,1,3), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,b), nV, X_vovv(1,1,a,c), nV, 1.d0, W_ikj(1,1,1,4), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,c), nV, X_vovv(1,1,b,a), nV, 1.d0, W_ikj(1,1,1,5), nO*nO)
call dgemm('T','N', nO*nO, nO, nV, 1.d0, T_voov(1,1,1,a), nV, X_vovv(1,1,b,c), nV, 1.d0, W_ikj(1,1,1,6), nO*nO)
deallocate(X)
allocate(X(nO,nO,nO,3))
do k=1,nO
do j=1,nO
do l=1,nO
X(l,j,k,1) = X_ooov(l,k,j,a)
X(l,j,k,2) = X_ooov(l,k,j,b)
X(l,j,k,3) = X_ooov(l,k,j,c)
enddo
enddo
enddo
! - T_oovv(l,i,a,b) * X_ooov(l,j,k,c) : i jk
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,a,b), nO, X_ooov(1,1,1,c), nO, 1.d0, W_abc, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,b,a), nO, X_ooov(1,1,1,c), nO, 1.d0, W_bac, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,c,b), nO, X_ooov(1,1,1,a), nO, 1.d0, W_cba, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,b,c), nO, X_ooov(1,1,1,a), nO, 1.d0, W_bca, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,c,a), nO, X_ooov(1,1,1,b), nO, 1.d0, W_cab, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,a,c), nO, X_ooov(1,1,1,b), nO, 1.d0, W_acb, nO)
! - T_oovv(l,i,a,c) * X_ooov(l,k,j,b) : i kj
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,a,c), nO, X(1,1,1,2), nO, 1.d0, W_abc, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,b,c), nO, X(1,1,1,1), nO, 1.d0, W_bac, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,c,a), nO, X(1,1,1,2), nO, 1.d0, W_cba, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,b,a), nO, X(1,1,1,3), nO, 1.d0, W_bca, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,c,b), nO, X(1,1,1,1), nO, 1.d0, W_cab, nO)
call dgemm('T','N', nO, nO*nO, nO, -1.d0, T_oovv(1,1,a,b), nO, X(1,1,1,3), nO, 1.d0, W_acb, nO)
! - X_ooov(l,i,j,b) * T_oovv(l,k,c,a) : ij k
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,b), nO, T_oovv(1,1,c,a), nO, 1.d0, W_abc, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,a), nO, T_oovv(1,1,c,b), nO, 1.d0, W_bac, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,b), nO, T_oovv(1,1,a,c), nO, 1.d0, W_cba, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,c), nO, T_oovv(1,1,a,b), nO, 1.d0, W_bca, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,a), nO, T_oovv(1,1,b,c), nO, 1.d0, W_cab, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,c), nO, T_oovv(1,1,b,a), nO, 1.d0, W_acb, nO*nO)
! - X_ooov(l,j,i,a) * T_oovv(l,k,c,b) : ji k
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,1), nO, T_oovv(1,1,c,b), nO, 1.d0, W_abc, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,2), nO, T_oovv(1,1,c,a), nO, 1.d0, W_bac, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,3), nO, T_oovv(1,1,a,b), nO, 1.d0, W_cba, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,2), nO, T_oovv(1,1,a,c), nO, 1.d0, W_bca, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,3), nO, T_oovv(1,1,b,a), nO, 1.d0, W_cab, nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,1), nO, T_oovv(1,1,b,c), nO, 1.d0, W_acb, nO*nO)
! - X_ooov(l,k,i,a) * T_oovv(l,j,b,c) : ki j
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,1), nO, T_oovv(1,1,b,c), nO, 1.d0, W_ikj(1,1,1,1), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,2), nO, T_oovv(1,1,a,c), nO, 1.d0, W_ikj(1,1,1,2), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,3), nO, T_oovv(1,1,b,a), nO, 1.d0, W_ikj(1,1,1,3), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,2), nO, T_oovv(1,1,c,a), nO, 1.d0, W_ikj(1,1,1,4), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,3), nO, T_oovv(1,1,a,b), nO, 1.d0, W_ikj(1,1,1,5), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X(1,1,1,1), nO, T_oovv(1,1,c,b), nO, 1.d0, W_ikj(1,1,1,6), nO*nO)
! - X_ooov(l,i,k,c) * T_oovv(l,j,b,a) : ik j
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,c), nO, T_oovv(1,1,b,a), nO, 1.d0, W_ikj(1,1,1,1), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,c), nO, T_oovv(1,1,a,b), nO, 1.d0, W_ikj(1,1,1,2), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,a), nO, T_oovv(1,1,b,c), nO, 1.d0, W_ikj(1,1,1,3), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,a), nO, T_oovv(1,1,c,b), nO, 1.d0, W_ikj(1,1,1,4), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,b), nO, T_oovv(1,1,a,c), nO, 1.d0, W_ikj(1,1,1,5), nO*nO)
call dgemm('T','N', nO*nO, nO, nO, -1.d0, X_ooov(1,1,1,b), nO, T_oovv(1,1,c,a), nO, 1.d0, W_ikj(1,1,1,6), nO*nO)
do k=1,nO
do j=1,nO
do i=1,nO
W_abc(i,j,k) = W_abc(i,j,k) + W_ikj(i,k,j,1)
W_bac(i,j,k) = W_bac(i,j,k) + W_ikj(i,k,j,2)
W_cba(i,j,k) = W_cba(i,j,k) + W_ikj(i,k,j,3)
W_bca(i,j,k) = W_bca(i,j,k) + W_ikj(i,k,j,4)
W_cab(i,j,k) = W_cab(i,j,k) + W_ikj(i,k,j,5)
W_acb(i,j,k) = W_acb(i,j,k) + W_ikj(i,k,j,6)
enddo
enddo
enddo
deallocate(X,W_ikj)
end
! V_abc
subroutine form_v_abc(nO,nV,a,b,c,T_ov,X_oovv,W_abc,V_abc,W_cba,V_cba,W_bca,V_bca,W_cab,V_cab,W_bac,V_bac,W_acb,V_acb)
implicit none
integer, intent(in) :: nO,nV,a,b,c
double precision, intent(in) :: T_ov(nO,nV)
double precision, intent(in) :: X_oovv(nO,nO,nV,nV)
double precision, intent(in) :: W_abc(nO,nO,nO), W_cab(nO,nO,nO), W_bca(nO,nO,nO)
double precision, intent(in) :: W_bac(nO,nO,nO), W_cba(nO,nO,nO), W_acb(nO,nO,nO)
double precision, intent(out) :: V_abc(nO,nO,nO), V_cab(nO,nO,nO), V_bca(nO,nO,nO)
double precision, intent(out) :: V_bac(nO,nO,nO), V_cba(nO,nO,nO), V_acb(nO,nO,nO)
integer :: i,j,k
do k = 1, nO
do j = 1, nO
do i = 1, nO
V_abc(i,j,k) = W_abc(i,j,k) &
+ X_oovv(j,k,b,c) * T_ov(i,a) &
+ X_oovv(i,k,a,c) * T_ov(j,b) &
+ X_oovv(i,j,a,b) * T_ov(k,c)
V_cba(i,j,k) = W_cba(i,j,k) &
+ X_oovv(j,k,b,a) * T_ov(i,c) &
+ X_oovv(i,k,c,a) * T_ov(j,b) &
+ X_oovv(i,j,c,b) * T_ov(k,a)
V_bca(i,j,k) = W_bca(i,j,k) &
+ X_oovv(j,k,c,a) * T_ov(i,b) &
+ X_oovv(i,k,b,a) * T_ov(j,c) &
+ X_oovv(i,j,b,c) * T_ov(k,a)
V_cab(i,j,k) = W_cab(i,j,k) &
+ X_oovv(j,k,a,b) * T_ov(i,c) &
+ X_oovv(i,k,c,b) * T_ov(j,a) &
+ X_oovv(i,j,c,a) * T_ov(k,b)
V_bac(i,j,k) = W_bac(i,j,k) &
+ X_oovv(j,k,a,c) * T_ov(i,b) &
+ X_oovv(i,k,b,c) * T_ov(j,a) &
+ X_oovv(i,j,b,a) * T_ov(k,c)
V_acb(i,j,k) = W_acb(i,j,k) &
+ X_oovv(j,k,c,b) * T_ov(i,a) &
+ X_oovv(i,k,a,b) * T_ov(j,c) &
+ X_oovv(i,j,a,c) * T_ov(k,b)
enddo
enddo
enddo
end

2
src/iterations/print_extrapolation.irp.f
View File

@ -25,7 +25,7 @@ subroutine print_extrapolated_energy
write(*,*) 'minimum PT2 ', 'Extrapolated energy'
write(*,*) '=========== ', '==================='
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
write(*,*) '=========== ', '==================='

5
src/mo_basis/utils.irp.f
View File

@ -3,7 +3,6 @@ subroutine save_mos
double precision, allocatable :: buffer(:,:)
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_label(mo_label)
call ezfio_set_mo_basis_ao_md5(ao_md5)
@ -27,7 +26,7 @@ subroutine save_mos_no_occ
double precision, allocatable :: buffer(:,:)
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_label(mo_label)
!call ezfio_set_mo_basis_ao_md5(ao_md5)
@ -48,7 +47,7 @@ subroutine save_mos_truncated(n)
double precision, allocatable :: buffer(:,:)
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_label(mo_label)

29
src/tc_bi_ortho/dav_h_tc_s2.irp.f
View File

@ -304,22 +304,23 @@ subroutine davidson_hs2_nonsym_b1space(u_in, H_jj, s2_out,energies, sze, N_st, N
! Penalty method
! --------------
if (s2_eig) then
h_p = s_
do k=1,shift2
h_p(k,k) = h_p(k,k) - expected_s2
enddo
if (only_expected_s2) then
alpha = 0.1d0
h_p = h + alpha*h_p
else
alpha = 0.0001d0
h_p = h + alpha*h_p
endif
else
! if (s2_eig) then
! h_p = s_
! do k=1,shift2
! h_p(k,k) = h_p(k,k) - expected_s2
! enddo
! if (only_expected_s2) then
! alpha = 0.1d0
! h_p = h + alpha*h_p
! else
! alpha = 0.0001d0
! h_p = h + alpha*h_p
! endif
! else
h_p = h
alpha = 0.d0
endif
! endif
! Diagonalize h y = lambda y
! ---------------------------

54
src/trexio/EZFIO.cfg Normal file
View File

@ -0,0 +1,54 @@
[backend]
type: integer
doc: Back-end used in TREXIO. 0: HDF5, 1:Text
interface: ezfio, ocaml, provider
default: 0
[trexio_file]
type: character*(256)
doc: Name of the exported TREXIO file
interface: ezfio, ocaml, provider
default: None
[export_rdm]
type: logical
doc: If True, export two-body reduced density matrix
interface: ezfio, ocaml, provider
default: False
[export_ao_one_e_ints]
type: logical
doc: If True, export one-electron integrals in AO basis
interface: ezfio, ocaml, provider
default: False
[export_mo_one_e_ints]
type: logical
doc: If True, export one-electron integrals in MO basis
interface: ezfio, ocaml, provider
default: False
[export_ao_two_e_ints]
type: logical
doc: If True, export two-electron integrals in AO basis
interface: ezfio, ocaml, provider
default: False
[export_ao_two_e_ints_cholesky]
type: logical
doc: If True, export Cholesky-decomposed two-electron integrals in AO basis
interface: ezfio, ocaml, provider
default: False
[export_mo_two_e_ints]
type: logical
doc: If True, export two-electron integrals in MO basis
interface: ezfio, ocaml, provider
default: False
[export_mo_two_e_ints_cholesky]
type: logical
doc: If True, export Cholesky-decomposed two-electron integrals in MO basis
interface: ezfio, ocaml, provider
default: False

8
src/trexio/NEED Normal file
View File

@ -0,0 +1,8 @@
ezfio_files
determinants
mo_one_e_ints
mo_two_e_ints
ao_two_e_ints
ao_one_e_ints
two_body_rdm
hartree_fock

6
src/trexio/README.rst Normal file
View File

@ -0,0 +1,6 @@
======
trexio
======
Module for handling TREXIO files.
See https://github.com/trex-coe/trexio

7
src/trexio/export_trexio.irp.f Normal file
View File

@ -0,0 +1,7 @@
program export_trexio_prog
implicit none
read_wf = .True.
SOFT_TOUCH read_wf
call export_trexio
end

623
src/trexio/export_trexio_routines.irp.f Normal file
View File

@ -0,0 +1,623 @@
subroutine export_trexio
use trexio
implicit none
BEGIN_DOC
! Exports the wave function in TREXIO format
END_DOC
integer(trexio_t) :: f(N_states) ! TREXIO file handle
integer(trexio_exit_code) :: rc
integer :: k
double precision, allocatable :: factor(:)
character*(256) :: filenames(N_states)
filenames(1) = trexio_filename
do k=2,N_states
write(filenames(k),'(A,I3.3)') trim(trexio_filename)//'.', k-1
enddo
do k=1,N_states
print *, 'TREXIO file : ', trim(filenames(k))
call system('test -f '//trim(filenames(k))//' && mv '//trim(filenames(k))//' '//trim(filenames(k))//'.bak')
enddo
print *, ''
do k=1,N_states
if (backend == 0) then
f(k) = trexio_open(filenames(k), 'u', TREXIO_HDF5, rc)
else if (backend == 1) then
f(k) = trexio_open(filenames(k), 'u', TREXIO_TEXT, rc)
endif
if (f(k) == 0_8) then
print *, 'Unable to open TREXIO file for writing'
print *, 'rc = ', rc
stop -1
endif
enddo
call ezfio_set_trexio_trexio_file(trexio_filename)
! ------------------------------------------------------------------------------
! Electrons
! ---------
print *, 'Electrons'
rc = trexio_write_electron_up_num(f(1), elec_alpha_num)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_electron_dn_num(f(1), elec_beta_num)
call trexio_assert(rc, TREXIO_SUCCESS)
! Nuclei
! ------
print *, 'Nuclei'
rc = trexio_write_nucleus_num(f(1), nucl_num)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_nucleus_charge(f(1), nucl_charge)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_nucleus_coord(f(1), nucl_coord_transp)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_nucleus_label(f(1), nucl_label, 32)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_nucleus_repulsion(f(1), nuclear_repulsion)
call trexio_assert(rc, TREXIO_SUCCESS)
! Pseudo-potentials
! -----------------
if (do_pseudo) then
print *, 'ECP'
integer :: num
num = 0
do k=1,pseudo_klocmax
do i=1,nucl_num
if (pseudo_dz_k(i,k) /= 0.d0) then
num = num+1
end if
end do
end do
do l=0,pseudo_lmax
do k=1,pseudo_kmax
do i=1,nucl_num
if (pseudo_dz_kl(i,k,l) /= 0.d0) then
num = num+1
end if
end do
end do
end do
integer, allocatable :: ang_mom(:), nucleus_index(:), power(:), lmax(:)
double precision, allocatable :: exponent(:), coefficient(:)
allocate(ang_mom(num), nucleus_index(num), exponent(num), coefficient(num), power(num), &
lmax(nucl_num) )
do i=1,nucl_num
lmax(i) = -1
do l=0,pseudo_lmax
do k=1,pseudo_kmax
if (pseudo_dz_kl_transp(k,l,i) /= 0.d0) then
lmax(i) = max(lmax(i), l)
end if
end do
end do
end do
j = 0
do i=1,nucl_num
do k=1,pseudo_klocmax
if (pseudo_dz_k_transp(k,i) /= 0.d0) then
j = j+1
ang_mom(j) = lmax(i)+1
nucleus_index(j) = i
exponent(j) = pseudo_dz_k_transp(k,i)
coefficient(j) = pseudo_v_k_transp(k,i)
power(j) = pseudo_n_k_transp(k,i)
end if
end do
do l=0,lmax(i)
do k=1,pseudo_kmax
if (pseudo_dz_kl_transp(k,l,i) /= 0.d0) then
j = j+1
ang_mom(j) = l
nucleus_index(j) = i
exponent(j) = pseudo_dz_kl_transp(k,l,i)
coefficient(j) = pseudo_v_kl_transp(k,l,i)
power(j) = pseudo_n_kl_transp(k,l,i)
end if
end do
end do
end do
lmax(:) = lmax(:)+1
rc = trexio_write_ecp_max_ang_mom_plus_1(f(1), lmax)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ecp_z_core(f(1), int(nucl_charge_remove))
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ecp_num(f(1), num)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ecp_ang_mom(f(1), ang_mom)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ecp_nucleus_index(f(1), nucleus_index)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ecp_exponent(f(1), exponent)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ecp_coefficient(f(1), coefficient)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ecp_power(f(1), power)
call trexio_assert(rc, TREXIO_SUCCESS)
endif
! Basis
! -----
print *, 'Basis'
rc = trexio_write_basis_type(f(1), 'Gaussian', len('Gaussian'))
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_basis_prim_num(f(1), prim_num)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_basis_shell_num(f(1), shell_num)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_basis_nucleus_index(f(1), basis_nucleus_index)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_basis_shell_ang_mom(f(1), shell_ang_mom)
call trexio_assert(rc, TREXIO_SUCCESS)
allocate(factor(shell_num))
if (ao_normalized) then
factor(1:shell_num) = shell_normalization_factor(1:shell_num)
else
factor(1:shell_num) = 1.d0
endif
rc = trexio_write_basis_shell_factor(f(1), factor)
call trexio_assert(rc, TREXIO_SUCCESS)
deallocate(factor)
rc = trexio_write_basis_shell_index(f(1), shell_index)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_basis_exponent(f(1), prim_expo)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_basis_coefficient(f(1), prim_coef)
call trexio_assert(rc, TREXIO_SUCCESS)
allocate(factor(prim_num))
if (primitives_normalized) then
factor(1:prim_num) = prim_normalization_factor(1:prim_num)
else
factor(1:prim_num) = 1.d0
endif
rc = trexio_write_basis_prim_factor(f(1), factor)
call trexio_assert(rc, TREXIO_SUCCESS)
deallocate(factor)
! Atomic orbitals
! ---------------
print *, 'AOs'
rc = trexio_write_ao_num(f(1), ao_num)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ao_cartesian(f(1), 1)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ao_shell(f(1), ao_shell)
call trexio_assert(rc, TREXIO_SUCCESS)
integer :: i, pow0(3), powA(3), j, l, nz
double precision :: normA, norm0, C_A(3), overlap_x, overlap_z, overlap_y, c
nz=100
C_A(1) = 0.d0
C_A(2) = 0.d0
C_A(3) = 0.d0
allocate(factor(ao_num))
if (ao_normalized) then
do i=1,ao_num
l = ao_first_of_shell(ao_shell(i))
factor(i) = (ao_coef_normalized(i,1)+tiny(1.d0))/(ao_coef_normalized(l,1)+tiny(1.d0))
enddo
else
factor(:) = 1.d0
endif
rc = trexio_write_ao_normalization(f(1), factor)
call trexio_assert(rc, TREXIO_SUCCESS)
deallocate(factor)
! One-e AO integrals
! ------------------
if (export_ao_one_e_ints) then
print *, 'AO one-e integrals'
rc = trexio_write_ao_1e_int_overlap(f(1),ao_overlap)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ao_1e_int_kinetic(f(1),ao_kinetic_integrals)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_ao_1e_int_potential_n_e(f(1),ao_integrals_n_e)
call trexio_assert(rc, TREXIO_SUCCESS)
if (do_pseudo) then
rc = trexio_write_ao_1e_int_ecp(f(1), ao_pseudo_integrals_local + ao_pseudo_integrals_non_local)
call trexio_assert(rc, TREXIO_SUCCESS)
endif
rc = trexio_write_ao_1e_int_core_hamiltonian(f(1),ao_one_e_integrals)
call trexio_assert(rc, TREXIO_SUCCESS)
end if
! Two-e AO integrals
! ------------------
if (export_ao_two_e_ints) then
print *, 'AO two-e integrals'
PROVIDE ao_two_e_integrals_in_map
integer(8), parameter :: BUFSIZE=100000_8
double precision :: eri_buffer(BUFSIZE), integral
integer(4) :: eri_index(4,BUFSIZE)
integer(8) :: icount, offset
double precision, external :: get_ao_two_e_integral
icount = 0_8
offset = 0_8
do l=1,ao_num
do k=1,ao_num
do j=l,ao_num
do i=k,ao_num
if (i==j .and. k<l) cycle
if (i<j) cycle
integral = get_ao_two_e_integral(i,j,k,l,ao_integrals_map)
if (integral == 0.d0) cycle
icount += 1_8
eri_buffer(icount) = integral
eri_index(1,icount) = i
eri_index(2,icount) = j
eri_index(3,icount) = k
eri_index(4,icount) = l
if (icount == BUFSIZE) then
rc = trexio_write_ao_2e_int_eri(f(1), offset, icount, eri_index, eri_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
offset += icount
icount = 0_8
end if
end do
end do
end do
end do
if (icount >= 0_8) then
rc = trexio_write_ao_2e_int_eri(f(1), offset, icount, eri_index, eri_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
end if
end if
! Two-e AO integrals - Cholesky
! -----------------------------
integer(4) :: chol_index(3,BUFSIZE)
double precision :: chol_buffer(BUFSIZE)
if (export_ao_two_e_ints_cholesky) then
print *, 'AO two-e integrals Cholesky'
rc = trexio_write_ao_2e_int_eri_cholesky_num(f(1), cholesky_ao_num)
call trexio_assert(rc, TREXIO_SUCCESS)
icount = 0_8
offset = 0_8
do k=1,cholesky_ao_num
do j=1,ao_num
do i=1,ao_num
integral = cholesky_ao(i,j,k)
if (integral == 0.d0) cycle
icount += 1_8
chol_buffer(icount) = integral
chol_index(1,icount) = i
chol_index(2,icount) = j
chol_index(3,icount) = k
if (icount == BUFSIZE) then
rc = trexio_write_ao_2e_int_eri_cholesky(f(1), offset, icount, chol_index, chol_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
offset += icount
icount = 0_8
end if
end do
end do
end do
if (icount > 0_8) then
rc = trexio_write_ao_2e_int_eri_cholesky(f(1), offset, icount, chol_index, chol_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
end if
end if
! Molecular orbitals
! ------------------
print *, 'MOs'
rc = trexio_write_mo_type(f(1), mo_label, len(trim(mo_label)))
call trexio_assert(rc, TREXIO_SUCCESS)
do k=1,N_states
rc = trexio_write_mo_num(f(k), mo_num)
call trexio_assert(rc, TREXIO_SUCCESS)
enddo
rc = trexio_write_mo_coefficient(f(1), mo_coef)
call trexio_assert(rc, TREXIO_SUCCESS)
if ( (trim(mo_label) == 'Canonical').and. &
(export_mo_two_e_ints_cholesky.or.export_mo_two_e_ints) ) then
rc = trexio_write_mo_energy(f(1), fock_matrix_diag_mo)
call trexio_assert(rc, TREXIO_SUCCESS)
endif
rc = trexio_write_mo_class(f(1), mo_class, len(mo_class(1)))
call trexio_assert(rc, TREXIO_SUCCESS)
! One-e MO integrals
! ------------------
if (export_mo_one_e_ints) then
print *, 'MO one-e integrals'
rc = trexio_write_mo_1e_int_kinetic(f(1),mo_kinetic_integrals)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_mo_1e_int_potential_n_e(f(1),mo_integrals_n_e)
call trexio_assert(rc, TREXIO_SUCCESS)
if (do_pseudo) then
rc = trexio_write_mo_1e_int_ecp(f(1),mo_pseudo_integrals_local)
call trexio_assert(rc, TREXIO_SUCCESS)
endif
rc = trexio_write_mo_1e_int_core_hamiltonian(f(1),mo_one_e_integrals)
call trexio_assert(rc, TREXIO_SUCCESS)
end if
! Two-e MO integrals
! ------------------
if (export_mo_two_e_ints) then
print *, 'MO two-e integrals'
PROVIDE mo_two_e_integrals_in_map
double precision, external :: mo_two_e_integral
icount = 0_8
offset = 0_8
do l=1,mo_num
do k=1,mo_num
do j=l,mo_num
do i=k,mo_num
if (i==j .and. k<l) cycle
if (i<j) cycle
integral = mo_two_e_integral(i,j,k,l)
if (integral == 0.d0) cycle
icount += 1_8
eri_buffer(icount) = integral
eri_index(1,icount) = i
eri_index(2,icount) = j
eri_index(3,icount) = k
eri_index(4,icount) = l
if (icount == BUFSIZE) then
rc = trexio_write_mo_2e_int_eri(f(1), offset, icount, eri_index, eri_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
offset += icount
icount = 0_8
end if
end do
end do
end do
end do
if (icount > 0_8) then
rc = trexio_write_mo_2e_int_eri(f(1), offset, icount, eri_index, eri_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
end if
end if
! Two-e MO integrals - Cholesky
! -----------------------------
if (export_mo_two_e_ints_cholesky) then
print *, 'MO two-e integrals Cholesky'
rc = trexio_write_mo_2e_int_eri_cholesky_num(f(1), cholesky_ao_num)
call trexio_assert(rc, TREXIO_SUCCESS)
icount = 0_8
offset = 0_8
do k=1,cholesky_ao_num
do j=1,mo_num
do i=1,mo_num
integral = cholesky_mo(i,j,k)
if (integral == 0.d0) cycle
icount += 1_8
chol_buffer(icount) = integral
chol_index(1,icount) = i
chol_index(2,icount) = j
chol_index(3,icount) = k
if (icount == BUFSIZE) then
rc = trexio_write_mo_2e_int_eri_cholesky(f(1), offset, icount, chol_index, chol_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
offset += icount
icount = 0_8
end if
end do
end do
end do
if (icount > 0_8) then
rc = trexio_write_mo_2e_int_eri_cholesky(f(1), offset, icount, chol_index, chol_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
end if
end if
! One-e RDM
! ---------
do k=1,N_states
rc = trexio_write_rdm_1e(f(k),one_e_dm_mo_alpha(:,:,k) + one_e_dm_mo_beta(:,:,k))
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_rdm_1e_up(f(k),one_e_dm_mo_alpha(:,:,k))
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_rdm_1e_dn(f(k),one_e_dm_mo_beta(:,:,k))
call trexio_assert(rc, TREXIO_SUCCESS)
enddo
! Two-e RDM
! ---------
if (export_rdm) then
PROVIDE two_e_dm_mo
print *, 'Two-e RDM'
icount = 0_8
offset = 0_8
do l=1,mo_num
do k=1,mo_num
do j=1,mo_num
do i=1,mo_num
integral = two_e_dm_mo(i,j,k,l)
if (integral == 0.d0) cycle
icount += 1_8
eri_buffer(icount) = integral
eri_index(1,icount) = i
eri_index(2,icount) = j
eri_index(3,icount) = k
eri_index(4,icount) = l
if (icount == BUFSIZE) then
rc = trexio_write_rdm_2e(f(1), offset, icount, eri_index, eri_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
offset += icount
icount = 0_8
end if
end do
end do
end do
end do
if (icount >= 0_8) then
rc = trexio_write_rdm_2e(f(1), offset, icount, eri_index, eri_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
end if
end if
! ------------------------------------------------------------------------------
! Determinants
! ------------
integer*8, allocatable :: det_buffer(:,:,:)
double precision, allocatable :: coef_buffer(:,:)
integer :: nint
rc = trexio_get_int64_num(f(1), nint)
call trexio_assert(rc, TREXIO_SUCCESS)
! nint = N_int
if (nint /= N_int) then
stop 'Problem with N_int'
endif
allocate ( det_buffer(nint, 2, BUFSIZE), coef_buffer(BUFSIZE, n_states) )
do k=1, N_states
icount = 0_8
offset = 0_8
rc = trexio_write_state_num(f(k), n_states)
call trexio_assert(rc, TREXIO_SUCCESS)
! Will need to be updated with TREXIO 2.4
! rc = trexio_write_state_id(f(k), k-1)
rc = trexio_write_state_id(f(k), k)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_state_file_name(f(k), filenames, len(filenames(1)))
call trexio_assert(rc, TREXIO_SUCCESS)
enddo
do k=1,n_det
icount += 1_8
det_buffer(1:nint, 1:2, icount) = psi_det(1:N_int, 1:2, k)
coef_buffer(icount,1:N_states) = psi_coef(k,1:N_states)
if (icount == BUFSIZE) then
do i=1,N_states
rc = trexio_write_determinant_list(f(i), offset, icount, det_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_determinant_coefficient(f(i), offset, icount, coef_buffer(1,i))
call trexio_assert(rc, TREXIO_SUCCESS)
end do
offset += icount
icount = 0_8
end if
end do
if (icount >= 0_8) then
do i=1,N_states
rc = trexio_write_determinant_list(f(i), offset, icount, det_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_write_determinant_coefficient(f(i), offset, icount, coef_buffer(1,i))
call trexio_assert(rc, TREXIO_SUCCESS)
end do
end if
deallocate ( det_buffer, coef_buffer )
do k=1,N_states
rc = trexio_close(f(k))
call trexio_assert(rc, TREXIO_SUCCESS)
enddo
end
! -*- mode: f90 -*-

79
src/trexio/import_trexio_determinants.irp.f Normal file
View File

@ -0,0 +1,79 @@
program import_determinants_ao
call run
end
subroutine run
use trexio
use map_module
implicit none
BEGIN_DOC
! Program to import determinants from TREXIO
END_DOC
integer(trexio_t) :: f ! TREXIO file handle
integer(trexio_exit_code) :: rc
integer :: m
double precision, allocatable :: coef_buffer(:,:)
integer*8 , allocatable :: det_buffer(:,:,:)
f = trexio_open(trexio_filename, 'r', TREXIO_AUTO, rc)
if (f == 0_8) then
print *, 'Unable to open TREXIO file for reading'
print *, 'rc = ', rc
stop -1
endif
! Determinants
! ------------
integer :: nint, nstates
integer :: bufsize
rc = trexio_read_state_num(f, nstates)
call trexio_assert(rc, TREXIO_SUCCESS)
! rc = trexio_read_determinant_int64_num(f, nint)
! call trexio_assert(rc, TREXIO_SUCCESS)
nint = N_int
if (nint /= N_int) then
stop 'Problem with N_int'
endif
integer*8 :: offset, icount
rc = trexio_read_determinant_num(f, bufsize)
call trexio_assert(rc, TREXIO_SUCCESS)
print *, 'N_det = ', bufsize
allocate ( det_buffer(nint, 2, bufsize), coef_buffer(bufsize, n_states) )
offset = 0_8
icount = bufsize
rc = trexio_read_determinant_list(f, offset, icount, det_buffer)
call trexio_assert(rc, TREXIO_SUCCESS)
if (icount /= bufsize) then
print *, 'error: bufsize /= N_det: ', bufsize, icount
stop -1
endif
do m=1,nstates
rc = trexio_set_state(f, m-1)
call trexio_assert(rc, TREXIO_SUCCESS)
rc = trexio_read_determinant_coefficient(f, offset, icount, coef_buffer(1,m))
call trexio_assert(rc, TREXIO_SUCCESS)
if (icount /= bufsize) then
print *, 'error: bufsize /= N_det for state', m, ':', icount, bufsize
stop -1
endif
enddo
call save_wavefunction_general(bufsize,nstates,det_buffer,size(coef_buffer,1),coef_buffer)
end

146
src/trexio/import_trexio_integrals.irp.f Normal file
View File

@ -0,0 +1,146 @@
program import_integrals_ao
use trexio
implicit none
integer(trexio_t) :: f ! TREXIO file handle
integer(trexio_exit_code) :: rc
f = trexio_open(trexio_filename, 'r', TREXIO_AUTO, rc)
if (f == 0_8) then
print *, 'Unable to open TREXIO file for reading'
print *, 'rc = ', rc
stop -1
endif
call run(f)
rc = trexio_close(f)
call trexio_assert(rc, TREXIO_SUCCESS)
end
subroutine run(f)
use trexio
use map_module
implicit none
BEGIN_DOC
! Program to import integrals from TREXIO
END_DOC
integer(trexio_t), intent(in) :: f ! TREXIO file handle
integer(trexio_exit_code) :: rc
integer ::i,j,k,l
integer(8) :: m, n_integrals
double precision :: integral
integer(key_kind), allocatable :: buffer_i(:)
real(integral_kind), allocatable :: buffer_values(:)
double precision, allocatable :: A(:,:)
double precision, allocatable :: V(:)
integer , allocatable :: Vi(:,:)
double precision :: s
if (trexio_has_nucleus_repulsion(f) == TREXIO_SUCCESS) then
rc = trexio_read_nucleus_repulsion(f, s)
call trexio_assert(rc, TREXIO_SUCCESS)
if (rc /= TREXIO_SUCCESS) then
print *, irp_here, rc
print *, 'Error reading nuclear repulsion'
stop -1
endif
call ezfio_set_nuclei_nuclear_repulsion(s)
call ezfio_set_nuclei_io_nuclear_repulsion('Read')
endif
! AO integrals
! ------------
allocate(A(ao_num, ao_num))
if (trexio_has_ao_1e_int_overlap(f) == TREXIO_SUCCESS) then
rc = trexio_read_ao_1e_int_overlap(f, A)
if (rc /= TREXIO_SUCCESS) then
print *, irp_here
print *, 'Error reading AO overlap'
stop -1
endif
call ezfio_set_ao_one_e_ints_ao_integrals_overlap(A)
call ezfio_set_ao_one_e_ints_io_ao_integrals_overlap('Read')
endif
if (trexio_has_ao_1e_int_kinetic(f) == TREXIO_SUCCESS) then
rc = trexio_read_ao_1e_int_kinetic(f, A)
if (rc /= TREXIO_SUCCESS) then
print *, irp_here
print *, 'Error reading AO kinetic integrals'
stop -1
endif
call ezfio_set_ao_one_e_ints_ao_integrals_kinetic(A)
call ezfio_set_ao_one_e_ints_io_ao_integrals_kinetic('Read')
endif
! if (trexio_has_ao_1e_int_ecp(f) == TREXIO_SUCCESS) then
! rc = trexio_read_ao_1e_int_ecp(f, A)
! if (rc /= TREXIO_SUCCESS) then
! print *, irp_here
! print *, 'Error reading AO ECP local integrals'
! stop -1
! endif
! call ezfio_set_ao_one_e_ints_ao_integrals_pseudo(A)
! call ezfio_set_ao_one_e_ints_io_ao_integrals_pseudo('Read')
! endif
if (trexio_has_ao_1e_int_potential_n_e(f) == TREXIO_SUCCESS) then
rc = trexio_read_ao_1e_int_potential_n_e(f, A)
if (rc /= TREXIO_SUCCESS) then
print *, irp_here
print *, 'Error reading AO potential N-e integrals'
stop -1
endif
call ezfio_set_ao_one_e_ints_ao_integrals_n_e(A)
call ezfio_set_ao_one_e_ints_io_ao_integrals_n_e('Read')
endif
deallocate(A)
! AO 2e integrals
! ---------------
PROVIDE ao_integrals_map
integer*4 :: BUFSIZE
BUFSIZE=ao_num**2
allocate(buffer_i(BUFSIZE), buffer_values(BUFSIZE))
allocate(Vi(4,BUFSIZE), V(BUFSIZE))
integer*8 :: offset, icount
offset = 0_8
icount = BUFSIZE
rc = TREXIO_SUCCESS
do while (icount == size(V))
rc = trexio_read_ao_2e_int_eri(f, offset, icount, Vi, V)
do m=1,icount
i = Vi(1,m)
j = Vi(2,m)
k = Vi(3,m)
l = Vi(4,m)
integral = V(m)
call two_e_integrals_index(i, j, k, l, buffer_i(m) )
buffer_values(m) = integral
enddo
call insert_into_ao_integrals_map(int(icount,4),buffer_i,buffer_values)
offset = offset + icount
if (rc /= TREXIO_SUCCESS) then
exit
endif
end do
n_integrals = offset
call map_sort(ao_integrals_map)
call map_unique(ao_integrals_map)
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
end

20
src/trexio/trexio_file.irp.f Normal file
View File

@ -0,0 +1,20 @@
BEGIN_PROVIDER [ character*(1024), trexio_filename ]
implicit none
BEGIN_DOC
! Name of the TREXIO file
END_DOC
character*(1024) :: prefix
trexio_filename = trexio_file
if (trexio_file == 'None') then
prefix = trim(ezfio_work_dir)//trim(ezfio_filename)
if (backend == 0) then
trexio_filename = trim(prefix)//'.h5'
else if (backend == 1) then
trexio_filename = trim(prefix)
endif
endif
END_PROVIDER

1
src/trexio/trexio_module.F90 Normal file
View File

@ -0,0 +1 @@
#include "trexio_f.f90"

9
src/two_body_rdm/two_e_dm_mo.irp.f
View File

@ -16,13 +16,13 @@ BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num)]
two_e_dm_mo = 0.d0
integer :: i,j,k,l,iorb,jorb,korb,lorb,istate
do l=1,mo_num
do l=1,n_core_inact_act_orb
lorb = list_core_inact_act(l)
do k=1,mo_num
do k=1,n_core_inact_act_orb
korb = list_core_inact_act(k)
do j=1,mo_num
do j=1,n_core_inact_act_orb
jorb = list_core_inact_act(j)
do i=1,mo_num
do i=1,n_core_inact_act_orb
iorb = list_core_inact_act(i)
two_e_dm_mo(iorb,jorb,korb,lorb) = state_av_full_occ_2_rdm_spin_trace_mo(i,j,k,l)
enddo
@ -30,7 +30,6 @@ BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num)]
enddo
enddo
two_e_dm_mo(:,:,:,:) = two_e_dm_mo(:,:,:,:)
! * 2.d0
END_PROVIDER

129
src/utils/integration.irp.f
View File

@ -428,6 +428,112 @@ end subroutine
subroutine multiply_poly_0c(b,c,nc,d,nd)
implicit none
BEGIN_DOC
! Multiply two polynomials
! D(t) += B(t)*C(t)
END_DOC
integer, intent(in) :: nc
integer, intent(out) :: nd
double precision, intent(in) :: b(0:0), c(0:nc)
double precision, intent(inout) :: d(0:0+nc)
integer :: ic
do ic = 0,nc
d(ic) = d(ic) + c(ic) * b(0)
enddo
do nd = nc,0,-1
if (d(nd) /= 0.d0) exit
enddo
end
subroutine multiply_poly_1c(b,c,nc,d,nd)
implicit none
BEGIN_DOC
! Multiply two polynomials
! D(t) += B(t)*C(t)
END_DOC
integer, intent(in) :: nc
integer, intent(out) :: nd
double precision, intent(in) :: b(0:1), c(0:nc)
double precision, intent(inout) :: d(0:1+nc)
integer :: ic, id
if(nc < 0) return
do ic = 0,nc
d( ic) = d( ic) + c(ic) * b(0)
d(1+ic) = d(1+ic) + c(ic) * b(1)
enddo
do nd = nc+1,0,-1
if (d(nd) /= 0.d0) exit
enddo
end
subroutine multiply_poly_2c(b,c,nc,d,nd)
implicit none
BEGIN_DOC
! Multiply two polynomials
! D(t) += B(t)*C(t)
END_DOC
integer, intent(in) :: nc
integer, intent(out) :: nd
double precision, intent(in) :: b(0:2), c(0:nc)
double precision, intent(inout) :: d(0:2+nc)
integer :: ic, id, k
if (nc <0) return
do ic = 0,nc
d( ic) = d( ic) + c(ic) * b(0)
d(1+ic) = d(1+ic) + c(ic) * b(1)
d(2+ic) = d(2+ic) + c(ic) * b(2)
enddo
do nd = nc+2,0,-1
if (d(nd) /= 0.d0) exit
enddo
end
subroutine multiply_poly_3c(b,c,nc,d,nd)
implicit none
BEGIN_DOC
! Multiply two polynomials
! D(t) += B(t)*C(t)
END_DOC
integer, intent(in) :: nc
integer, intent(out) :: nd
double precision, intent(in) :: b(0:3), c(0:nc)
double precision, intent(inout) :: d(0:3+nc)
integer :: ic, id
if (nc <0) return
do ic = 1,nc
d( ic) = d(1+ic) + c(ic) * b(0)
d(1+ic) = d(1+ic) + c(ic) * b(1)
d(2+ic) = d(1+ic) + c(ic) * b(2)
d(3+ic) = d(1+ic) + c(ic) * b(3)
enddo
do nd = nc+3,0,-1
if (d(nd) /= 0.d0) exit
enddo
end
subroutine multiply_poly(b,nb,c,nc,d,nd)
@ -444,29 +550,16 @@ subroutine multiply_poly(b,nb,c,nc,d,nd)
integer :: ndtmp
integer :: ib, ic, id, k
if(ior(nc,nb) >= 0) then ! True if nc>=0 and nb>=0
continue
else
return
endif
ndtmp = nb+nc
if(ior(nc,nb) < 0) return !False if nc>=0 and nb>=0
do ic = 0,nc
d(ic) = d(ic) + c(ic) * b(0)
enddo
do ib=1,nb
d(ib) = d(ib) + c(0) * b(ib)
do ic = 1,nc
do ib=0,nb
do ic = 0,nc
d(ib+ic) = d(ib+ic) + c(ic) * b(ib)
enddo
enddo
do nd = ndtmp,0,-1
if (d(nd) == 0.d0) then
cycle
endif
exit
do nd = nb+nc,0,-1
if (d(nd) /= 0.d0) exit
enddo
end

30
src/utils/linear_algebra.irp.f
View File

@ -1823,41 +1823,39 @@ subroutine pivoted_cholesky( A, rank, tol, ndim, U)
! U is allocated inside this subroutine
! rank is the number of Cholesky vectors depending on tol
!
integer :: ndim
integer, intent(inout) :: rank
double precision, dimension(ndim, ndim), intent(inout) :: A
double precision, dimension(ndim, rank), intent(out) :: U
double precision, intent(in) :: tol
integer :: ndim
integer, intent(inout) :: rank
double precision, intent(inout) :: A(ndim, ndim)
double precision, intent(out) :: U(ndim, rank)
double precision, intent(in) :: tol
integer, dimension(:), allocatable :: piv
double precision, dimension(:), allocatable :: work
character, parameter :: uplo = "U"
integer :: N, LDA
integer :: LDA
integer :: info
integer :: k, l, rank0
external :: dpstrf
rank0 = rank
N = size(A, dim=1)
LDA = N
allocate(piv(N))
allocate(work(2*N))
call dpstrf(uplo, N, A, LDA, piv, rank, tol, work, info)
LDA = ndim
allocate(piv(ndim))
allocate(work(2*ndim))
call dpstrf(uplo, ndim, A, LDA, piv, rank, tol, work, info)
if (rank > rank0) then
print *, 'Bug: rank > rank0 in pivoted cholesky. Increase rank before calling'
stop
end if
do k = 1, N
A(k+1:, k) = 0.00D+0
do k = 1, ndim
A(k+1:ndim, k) = 0.00D+0
end do
! TODO: It should be possible to use only one vector of size (1:rank) as a buffer
! to do the swapping in-place
U(:,:) = 0.00D+0
do k = 1, N
do k = 1, ndim
l = piv(k)
U(l, :) = A(1:rank, k)
U(l, 1:rank) = A(1:rank, k)
end do
end subroutine pivoted_cholesky

4
src/utils_cc/update_t.irp.f
View File

@ -22,7 +22,7 @@ subroutine update_t1(nO,nV,f_o,f_v,r1,t1)
!$OMP SHARED(nO,nV,t1,r1,cc_level_shift,f_o,f_v) &
!$OMP PRIVATE(i,a) &
!$OMP DEFAULT(NONE)
!$OMP DO collapse(1)
!$OMP DO
do a = 1, nV
do i = 1, nO
t1(i,a) = t1(i,a) - r1(i,a) / (f_o(i) - f_v(a) - cc_level_shift)
@ -57,7 +57,7 @@ subroutine update_t2(nO,nV,f_o,f_v,r2,t2)
!$OMP SHARED(nO,nV,t2,r2,cc_level_shift,f_o,f_v) &
!$OMP PRIVATE(i,j,a,b) &
!$OMP DEFAULT(NONE)
!$OMP DO collapse(3)
!$OMP DO
do b = 1, nV
do a = 1, nV
do j = 1, nO