mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-30 20:53:42 +02:00
Merge branch 'dev-stable' of github.com:quantumpackage/qp2 into dev-stable
This commit is contained in:
commit
646e187ac9
1
.github/workflows/compilation.yml
vendored
1
.github/workflows/compilation.yml
vendored
@ -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
8
.github/workflows/configuration.yml
vendored
@ -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
35
configure
vendored
@ -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
5
data/basis/none
Normal file
@ -0,0 +1,5 @@
|
||||
$DATA
|
||||
|
||||
HYDROGEN
|
||||
|
||||
$END
|
@ -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)
|
||||
|
@ -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)
|
||||
;;
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
||||
|
@ -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")
|
||||
|
@ -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
|
||||
|
@ -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. ],
|
||||
|
@ -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
425
scripts/qp_import_trexio.py
Executable 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
66
scripts/utility/qp_json.py
Normal file
@ -0,0 +1,66 @@
|
||||
#!/usr/bin/env python
|
||||
import os
|
||||
import json
|
||||
|
||||
def fix_json(s):
|
||||
"""Properly termitates an incomplete JSON file"""
|
||||
|
||||
s = s.replace(' ','')
|
||||
s = s.replace('\n','')
|
||||
s = s.replace('\t','')
|
||||
s = s.replace(",{}",'')
|
||||
tmp = [ c for c in s if c in "[]{}" ]
|
||||
tmp = "".join(tmp)
|
||||
tmp_old = ""
|
||||
while tmp != tmp_old:
|
||||
tmp_old = tmp
|
||||
tmp = tmp.replace("{}","")
|
||||
tmp = tmp.replace("[]","")
|
||||
while s[-1] in [ ',', '\n', ' ', '\t' ]:
|
||||
s = s[:-1]
|
||||
tmp = [ c for c in tmp ]
|
||||
tmp.reverse()
|
||||
for c in tmp:
|
||||
if c == '[': s += "]"
|
||||
elif c == '{': s += "}"
|
||||
return s
|
||||
|
||||
|
||||
def load(filename):
|
||||
"""Loads a JSON file after calling the fix_json function."""
|
||||
with open(filename,'r') as f:
|
||||
data = f.read()
|
||||
new_data = fix_json(data)
|
||||
return json.loads(new_data)
|
||||
|
||||
|
||||
def load_all(ezfio_filename):
|
||||
"""Loads all JSON files of an EZFIO."""
|
||||
d = {}
|
||||
prefix = ezfio_filename+'/json/'
|
||||
for filename in [ x for x in os.listdir(prefix) if x.endswith(".json")]:
|
||||
d[filename] = load(prefix+filename)
|
||||
return d
|
||||
|
||||
|
||||
def load_last(ezfio_filename):
|
||||
"""Loads last JSON file of an EZFIO."""
|
||||
d = {}
|
||||
prefix = ezfio_filename+'/json/'
|
||||
l = [ x for x in os.listdir(prefix) if x.endswith(".json")]
|
||||
l.sort()
|
||||
filename = l[-1]
|
||||
print(filename)
|
||||
return load(prefix+filename)
|
||||
|
||||
|
||||
def fix(ezfio_filename):
|
||||
"""Fixes all JSON files in an EZFIO."""
|
||||
d = load_all(ezfio_filename)
|
||||
prefix = ezfio_filename+'/json/'
|
||||
for filename in d.keys():
|
||||
with open(prefix+filename, 'w') as json_file:
|
||||
json.dump(d[filename], json_file)
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
400
src/ccsd/ccsd_t_space_orb_abc.irp.f
Normal 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
|
||||
|
@ -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(*,*) '=========== ', '==================='
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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
54
src/trexio/EZFIO.cfg
Normal 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
8
src/trexio/NEED
Normal 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
6
src/trexio/README.rst
Normal 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
7
src/trexio/export_trexio.irp.f
Normal 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
623
src/trexio/export_trexio_routines.irp.f
Normal 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
79
src/trexio/import_trexio_determinants.irp.f
Normal 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
146
src/trexio/import_trexio_integrals.irp.f
Normal 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
20
src/trexio/trexio_file.irp.f
Normal 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
1
src/trexio/trexio_module.F90
Normal file
@ -0,0 +1 @@
|
||||
#include "trexio_f.f90"
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user