mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-22 11:33:29 +01:00
fixed the Input_ao_extra_basis.ml and beginning to work on extra_basis
This commit is contained in:
eginer
parent
b17934d604
commit
fe675fab92
534
ocaml/Input_ao_extra_basis.ml
Normal file
534
ocaml/Input_ao_extra_basis.ml
Normal file
@ -0,0 +1,534 @@
|
|||||||
|
open Qptypes;;
|
||||||
|
open Qputils;;
|
||||||
|
open Sexplib.Std;;
|
||||||
|
|
||||||
|
module Ao_extra_basis : sig
|
||||||
|
type t =
|
||||||
|
{ ao_extra_basis : AO_basis_name.t;
|
||||||
|
ao_extra_num : AO_number.t ;
|
||||||
|
ao_extra_prim_num : AO_prim_number.t array;
|
||||||
|
ao_extra_prim_num_max : AO_prim_number.t;
|
||||||
|
ao_extra_nucl : Nucl_number.t array;
|
||||||
|
ao_extra_power : Angmom.Xyz.t array;
|
||||||
|
ao_extra_coef : AO_coef.t array;
|
||||||
|
ao_extra_expo : AO_expo.t array;
|
||||||
|
ao_extra_cartesian : bool;
|
||||||
|
ao_extra_normalized : bool;
|
||||||
|
primitives_normalized_extra : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
val read : unit -> t option
|
||||||
|
val to_string : t -> string
|
||||||
|
val to_basis : t -> Basis.t
|
||||||
|
val reorder : t -> t
|
||||||
|
val ordering : t -> int array
|
||||||
|
val write : t -> unit
|
||||||
|
val to_md5 : t -> MD5.t
|
||||||
|
val to_rst : t -> Rst_string.t
|
||||||
|
end = struct
|
||||||
|
type t =
|
||||||
|
{ ao_extra_basis : AO_basis_name.t;
|
||||||
|
ao_extra_num : AO_number.t ;
|
||||||
|
ao_extra_prim_num : AO_prim_number.t array;
|
||||||
|
ao_extra_prim_num_max : AO_prim_number.t;
|
||||||
|
ao_extra_nucl : Nucl_number.t array;
|
||||||
|
ao_extra_power : Angmom.Xyz.t array;
|
||||||
|
ao_extra_coef : AO_coef.t array;
|
||||||
|
ao_extra_expo : AO_expo.t array;
|
||||||
|
ao_extra_cartesian : bool;
|
||||||
|
ao_extra_normalized : bool;
|
||||||
|
primitives_normalized_extra : bool;
|
||||||
|
} [@@deriving sexp]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let get_default = Qpackage.get_ezfio_default "ao_extra_basis";;
|
||||||
|
|
||||||
|
let read_ao_extra_basis () =
|
||||||
|
let result =
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_basis ()
|
||||||
|
in
|
||||||
|
if result <> "None" then
|
||||||
|
AO_basis_name.of_string result
|
||||||
|
else failwith "No basis"
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_num () =
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_num ()
|
||||||
|
|> AO_number.of_int
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_prim_num () =
|
||||||
|
if Ezfio.has_ao_extra_basis_ao_extra_prim_num () then
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_prim_num ()
|
||||||
|
|> Ezfio.flattened_ezfio
|
||||||
|
|> Array.map AO_prim_number.of_int
|
||||||
|
else
|
||||||
|
[||]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_prim_num_max () =
|
||||||
|
if Ezfio.has_ao_extra_basis_ao_extra_prim_num () then
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_prim_num ()
|
||||||
|
|> Ezfio.flattened_ezfio
|
||||||
|
|> Array.fold_left (fun x y -> if x>y then x else y) 0
|
||||||
|
|> AO_prim_number.of_int
|
||||||
|
else
|
||||||
|
AO_prim_number.of_int 0
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_nucl () =
|
||||||
|
if Ezfio.has_ao_extra_basis_ao_extra_nucl () then
|
||||||
|
let nmax = Nucl_number.get_max () in
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_nucl ()
|
||||||
|
|> Ezfio.flattened_ezfio
|
||||||
|
|> Array.map (fun x-> Nucl_number.of_int ~max:nmax x)
|
||||||
|
else
|
||||||
|
[||]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_power () =
|
||||||
|
if Ezfio.has_ao_extra_basis_ao_extra_power () then
|
||||||
|
let x = Ezfio.get_ao_extra_basis_ao_extra_power () in
|
||||||
|
let dim = x.Ezfio.dim.(0) in
|
||||||
|
let data = Ezfio.flattened_ezfio x in
|
||||||
|
let result = Array.init dim (fun x -> "") in
|
||||||
|
for i=1 to dim
|
||||||
|
do
|
||||||
|
if (data.(i-1) > 0) then
|
||||||
|
result.(i-1) <- result.(i-1)^"x"^(string_of_int data.(i-1));
|
||||||
|
if (data.(dim+i-1) > 0) then
|
||||||
|
result.(i-1) <- result.(i-1)^"y"^(string_of_int data.(dim+i-1));
|
||||||
|
if (data.(2*dim+i-1) > 0) then
|
||||||
|
result.(i-1) <- result.(i-1)^"z"^(string_of_int data.(2*dim+i-1));
|
||||||
|
done;
|
||||||
|
Array.map Angmom.Xyz.of_string result
|
||||||
|
else
|
||||||
|
[||]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_coef () =
|
||||||
|
if Ezfio.has_ao_extra_basis_ao_extra_coef () then
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_coef ()
|
||||||
|
|> Ezfio.flattened_ezfio
|
||||||
|
|> Array.map AO_coef.of_float
|
||||||
|
else
|
||||||
|
[||]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_expo () =
|
||||||
|
if Ezfio.has_ao_extra_basis_ao_extra_expo () then
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_expo ()
|
||||||
|
|> Ezfio.flattened_ezfio
|
||||||
|
|> Array.map AO_expo.of_float
|
||||||
|
else
|
||||||
|
[||]
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_cartesian () =
|
||||||
|
if not (Ezfio.has_ao_extra_basis_ao_extra_cartesian ()) then
|
||||||
|
get_default "ao_extra_cartesian"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_ao_extra_basis_ao_extra_cartesian
|
||||||
|
;
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_cartesian ()
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_ao_extra_normalized () =
|
||||||
|
if not (Ezfio.has_ao_extra_basis_ao_extra_normalized()) then
|
||||||
|
get_default "ao_extra_normalized"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_ao_extra_basis_ao_extra_normalized
|
||||||
|
;
|
||||||
|
Ezfio.get_ao_extra_basis_ao_extra_normalized ()
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_primitives_normalized_extra () =
|
||||||
|
if not (Ezfio.has_ao_extra_basis_primitives_normalized_extra()) then
|
||||||
|
get_default "primitives_normalized_extra"
|
||||||
|
|> bool_of_string
|
||||||
|
|> Ezfio.set_ao_extra_basis_primitives_normalized_extra
|
||||||
|
;
|
||||||
|
Ezfio.get_ao_extra_basis_primitives_normalized_extra ()
|
||||||
|
;;
|
||||||
|
|
||||||
|
let to_long_basis b =
|
||||||
|
let ao_extra_num = AO_number.to_int b.ao_extra_num in
|
||||||
|
let gto_array = Array.init (AO_number.to_int b.ao_extra_num)
|
||||||
|
(fun i ->
|
||||||
|
let s = Angmom.Xyz.to_symmetry b.ao_extra_power.(i) in
|
||||||
|
let ao_extra_prim_num = AO_prim_number.to_int b.ao_extra_prim_num.(i) in
|
||||||
|
let prims = List.init ao_extra_prim_num (fun j ->
|
||||||
|
let prim = { GaussianPrimitive.sym = s ;
|
||||||
|
GaussianPrimitive.expo = b.ao_extra_expo.(ao_extra_num*j+i)
|
||||||
|
}
|
||||||
|
in
|
||||||
|
let coef = b.ao_extra_coef.(ao_extra_num*j+i) in
|
||||||
|
(prim,coef)
|
||||||
|
) in
|
||||||
|
Gto.of_prim_coef_list prims
|
||||||
|
)
|
||||||
|
in
|
||||||
|
let rec do_work accu sym gto nucl =
|
||||||
|
match (sym, gto, nucl) with
|
||||||
|
| (s::srest, g::grest, n::nrest) ->
|
||||||
|
do_work ((s,g,n)::accu) srest grest nrest
|
||||||
|
| ([],[],[]) -> List.rev accu
|
||||||
|
| _ -> assert false
|
||||||
|
in
|
||||||
|
do_work []
|
||||||
|
(Array.to_list b.ao_extra_power)
|
||||||
|
(Array.to_list gto_array)
|
||||||
|
(Array.to_list b.ao_extra_nucl)
|
||||||
|
;;
|
||||||
|
let to_basis b =
|
||||||
|
to_long_basis b
|
||||||
|
|> Long_basis.to_basis
|
||||||
|
;;
|
||||||
|
|
||||||
|
let to_md5 b =
|
||||||
|
let short_basis = to_basis b in
|
||||||
|
Basis.to_md5 short_basis
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let write_md5 b =
|
||||||
|
to_md5 b
|
||||||
|
|> MD5.to_string
|
||||||
|
|> Ezfio.set_ao_extra_basis_ao_extra_md5
|
||||||
|
;;
|
||||||
|
|
||||||
|
let write_ao_extra_basis name =
|
||||||
|
AO_basis_name.to_string name
|
||||||
|
|> Ezfio.set_ao_extra_basis_ao_extra_basis
|
||||||
|
;;
|
||||||
|
|
||||||
|
let write b =
|
||||||
|
let { ao_extra_basis ;
|
||||||
|
ao_extra_num ;
|
||||||
|
ao_extra_prim_num ;
|
||||||
|
ao_extra_prim_num_max ;
|
||||||
|
ao_extra_nucl ;
|
||||||
|
ao_extra_power ;
|
||||||
|
ao_extra_coef ;
|
||||||
|
ao_extra_expo ;
|
||||||
|
ao_extra_cartesian ;
|
||||||
|
ao_extra_normalized ;
|
||||||
|
primitives_normalized_extra ;
|
||||||
|
} = b
|
||||||
|
in
|
||||||
|
write_md5 b ;
|
||||||
|
write_ao_extra_basis ao_extra_basis;
|
||||||
|
let ao_extra_num = AO_number.to_int ao_extra_num
|
||||||
|
and ao_extra_prim_num_max = AO_prim_number.to_int ao_extra_prim_num_max
|
||||||
|
in
|
||||||
|
let ao_extra_prim_num =
|
||||||
|
Array.to_list ao_extra_prim_num
|
||||||
|
|> list_map AO_prim_number.to_int
|
||||||
|
in
|
||||||
|
Ezfio.set_ao_extra_basis_ao_extra_prim_num (Ezfio.ezfio_array_of_list
|
||||||
|
~rank:1 ~dim:[| ao_extra_num |] ~data:ao_extra_prim_num) ;
|
||||||
|
|
||||||
|
let ao_extra_nucl =
|
||||||
|
Array.to_list ao_extra_nucl
|
||||||
|
|> list_map Nucl_number.to_int
|
||||||
|
in
|
||||||
|
Ezfio.set_ao_extra_basis_ao_extra_nucl(Ezfio.ezfio_array_of_list
|
||||||
|
~rank:1 ~dim:[| ao_extra_num |] ~data:ao_extra_nucl) ;
|
||||||
|
|
||||||
|
let ao_extra_power =
|
||||||
|
let l = Array.to_list ao_extra_power in
|
||||||
|
List.concat [
|
||||||
|
(list_map (fun a -> Positive_int.to_int a.Angmom.Xyz.x) l) ;
|
||||||
|
(list_map (fun a -> Positive_int.to_int a.Angmom.Xyz.y) l) ;
|
||||||
|
(list_map (fun a -> Positive_int.to_int a.Angmom.Xyz.z) l) ]
|
||||||
|
in
|
||||||
|
Ezfio.set_ao_extra_basis_ao_extra_power(Ezfio.ezfio_array_of_list
|
||||||
|
~rank:2 ~dim:[| ao_extra_num ; 3 |] ~data:ao_extra_power) ;
|
||||||
|
|
||||||
|
Ezfio.set_ao_extra_basis_ao_extra_cartesian(ao_extra_cartesian);
|
||||||
|
Ezfio.set_ao_extra_basis_ao_extra_normalized(ao_extra_normalized);
|
||||||
|
Ezfio.set_ao_extra_basis_primitives_normalized_extra(primitives_normalized_extra);
|
||||||
|
|
||||||
|
let ao_extra_coef =
|
||||||
|
Array.to_list ao_extra_coef
|
||||||
|
|> list_map AO_coef.to_float
|
||||||
|
in
|
||||||
|
Ezfio.set_ao_extra_basis_ao_extra_coef(Ezfio.ezfio_array_of_list
|
||||||
|
~rank:2 ~dim:[| ao_extra_num ; ao_extra_prim_num_max |] ~data:ao_extra_coef) ;
|
||||||
|
|
||||||
|
let ao_extra_expo =
|
||||||
|
Array.to_list ao_extra_expo
|
||||||
|
|> list_map AO_expo.to_float
|
||||||
|
in
|
||||||
|
Ezfio.set_ao_extra_basis_ao_extra_expo(Ezfio.ezfio_array_of_list
|
||||||
|
~rank:2 ~dim:[| ao_extra_num ; ao_extra_prim_num_max |] ~data:ao_extra_expo) ;
|
||||||
|
|
||||||
|
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
let read () =
|
||||||
|
try
|
||||||
|
let result =
|
||||||
|
{ ao_extra_basis = read_ao_extra_basis ();
|
||||||
|
ao_extra_num = read_ao_extra_num () ;
|
||||||
|
ao_extra_prim_num = read_ao_extra_prim_num ();
|
||||||
|
ao_extra_prim_num_max = read_ao_extra_prim_num_max ();
|
||||||
|
ao_extra_nucl = read_ao_extra_nucl ();
|
||||||
|
ao_extra_power = read_ao_extra_power ();
|
||||||
|
ao_extra_coef = read_ao_extra_coef () ;
|
||||||
|
ao_extra_expo = read_ao_extra_expo () ;
|
||||||
|
ao_extra_cartesian = read_ao_extra_cartesian () ;
|
||||||
|
ao_extra_normalized = read_ao_extra_normalized () ;
|
||||||
|
primitives_normalized_extra = read_primitives_normalized_extra () ;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
to_md5 result
|
||||||
|
|> MD5.to_string
|
||||||
|
|> Ezfio.set_ao_extra_basis_ao_extra_md5 ;
|
||||||
|
Some result
|
||||||
|
with
|
||||||
|
| _ -> ( "None"
|
||||||
|
|> Digest.string
|
||||||
|
|> Digest.to_hex
|
||||||
|
|> Ezfio.set_ao_extra_basis_ao_extra_md5 ; None)
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
let ordering b =
|
||||||
|
let ordered_basis =
|
||||||
|
to_basis b
|
||||||
|
|> Long_basis.of_basis
|
||||||
|
|> Array.of_list
|
||||||
|
and unordered_basis =
|
||||||
|
to_long_basis b
|
||||||
|
|> Array.of_list
|
||||||
|
in
|
||||||
|
let find x a =
|
||||||
|
let rec find x a i =
|
||||||
|
if i = Array.length a then
|
||||||
|
find2 x a 0
|
||||||
|
else
|
||||||
|
if a.(i) = Some x then
|
||||||
|
(a.(i) <- None ; i)
|
||||||
|
else
|
||||||
|
find x a (i+1)
|
||||||
|
and find2 (s,g,n) a i =
|
||||||
|
if i = Array.length a then -1
|
||||||
|
else
|
||||||
|
match a.(i) with
|
||||||
|
| None -> find2 (s,g,n) a (i+1)
|
||||||
|
| Some (s', g', n') ->
|
||||||
|
if s <> s' || n <> n' then find2 (s,g,n) a (i+1)
|
||||||
|
else
|
||||||
|
let lc = list_map (fun (prim, _) -> prim) g.Gto.lc
|
||||||
|
and lc' = list_map (fun (prim, _) -> prim) g'.Gto.lc
|
||||||
|
in
|
||||||
|
if lc <> lc' then find2 (s,g,n) a (i+1) else (a.(i) <- None ; i)
|
||||||
|
in
|
||||||
|
find x a 0
|
||||||
|
in
|
||||||
|
let search_array = Array.map (fun i -> Some i) unordered_basis in
|
||||||
|
Array.map (fun x -> find x search_array) ordered_basis
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
let of_long_basis long_basis name ao_extra_cartesian =
|
||||||
|
let ao_extra_num = List.length long_basis |> AO_number.of_int in
|
||||||
|
let ao_extra_prim_num =
|
||||||
|
list_map (fun (_,g,_) -> List.length g.Gto.lc
|
||||||
|
|> AO_prim_number.of_int ) long_basis
|
||||||
|
|> Array.of_list
|
||||||
|
and ao_extra_nucl =
|
||||||
|
list_map (fun (_,_,n) -> n) long_basis
|
||||||
|
|> Array.of_list
|
||||||
|
and ao_extra_power =
|
||||||
|
list_map (fun (x,_,_) -> x) long_basis
|
||||||
|
|> Array.of_list
|
||||||
|
in
|
||||||
|
let ao_extra_prim_num_max = Array.fold_left (fun s x ->
|
||||||
|
if AO_prim_number.to_int x > s then AO_prim_number.to_int x else s) 0
|
||||||
|
ao_extra_prim_num
|
||||||
|
|> AO_prim_number.of_int
|
||||||
|
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
|
||||||
|
let rec get_n n accu = function
|
||||||
|
| [] -> List.rev accu
|
||||||
|
| h::tail ->
|
||||||
|
let y =
|
||||||
|
try List.nth h n
|
||||||
|
with _ -> 0.
|
||||||
|
in
|
||||||
|
get_n n (y::accu) tail
|
||||||
|
in
|
||||||
|
let rec build accu = function
|
||||||
|
| n when n=(AO_prim_number.to_int ao_extra_prim_num_max) -> accu
|
||||||
|
| n -> build ( accu @ (get_n n [] coefs) ) (n+1)
|
||||||
|
in
|
||||||
|
build [] 0
|
||||||
|
in
|
||||||
|
|
||||||
|
let ao_extra_coef = create_expo_coef `Coefs
|
||||||
|
|> Array.of_list
|
||||||
|
|> Array.map AO_coef.of_float
|
||||||
|
and ao_extra_expo = create_expo_coef `Expos
|
||||||
|
|> Array.of_list
|
||||||
|
|> Array.map AO_expo.of_float
|
||||||
|
in
|
||||||
|
{ ao_extra_basis = name ;
|
||||||
|
ao_extra_num ; ao_extra_prim_num ; ao_extra_prim_num_max ; ao_extra_nucl ;
|
||||||
|
ao_extra_power ; ao_extra_coef ; ao_extra_expo ; ao_extra_cartesian ;
|
||||||
|
ao_extra_normalized = bool_of_string @@ get_default "ao_extra_normalized";
|
||||||
|
primitives_normalized_extra = bool_of_string @@ get_default "primitives_normalized_extra";
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
|
||||||
|
let reorder b =
|
||||||
|
let order = ordering b in
|
||||||
|
let f a = Array.init (Array.length a) (fun i -> a.(order.(i))) in
|
||||||
|
let ao_extra_prim_num_max = AO_prim_number.to_int b.ao_extra_prim_num_max
|
||||||
|
and ao_extra_num = AO_number.to_int b.ao_extra_num in
|
||||||
|
let ao_extra_coef =
|
||||||
|
Array.init ao_extra_prim_num_max (fun i ->
|
||||||
|
f @@ Array.init ao_extra_num (fun j -> b.ao_extra_coef.(i*ao_extra_num + j) )
|
||||||
|
) |> Array.to_list |> Array.concat
|
||||||
|
in
|
||||||
|
let ao_extra_expo =
|
||||||
|
Array.init ao_extra_prim_num_max (fun i ->
|
||||||
|
f @@ Array.init ao_extra_num (fun j -> b.ao_extra_expo.(i*ao_extra_num + j) )
|
||||||
|
) |> Array.to_list |> Array.concat
|
||||||
|
in
|
||||||
|
{ b with
|
||||||
|
ao_extra_prim_num = f b.ao_extra_prim_num ;
|
||||||
|
ao_extra_nucl = f b.ao_extra_nucl ;
|
||||||
|
ao_extra_power = f b.ao_extra_power ;
|
||||||
|
ao_extra_coef ;
|
||||||
|
ao_extra_expo ;
|
||||||
|
}
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let to_rst b =
|
||||||
|
let print_sym =
|
||||||
|
let l = List.init (Array.length b.ao_extra_power) (
|
||||||
|
fun i -> ( (i+1),b.ao_extra_nucl.(i),b.ao_extra_power.(i) ) )
|
||||||
|
in
|
||||||
|
let rec do_work = function
|
||||||
|
| [] -> []
|
||||||
|
| (i,n,x)::tail ->
|
||||||
|
(Printf.sprintf " %5d %6d %-8s\n" i (Nucl_number.to_int n)
|
||||||
|
(Angmom.Xyz.to_string x)
|
||||||
|
)::(do_work tail)
|
||||||
|
in do_work l
|
||||||
|
|> String.concat ""
|
||||||
|
in
|
||||||
|
|
||||||
|
let short_basis = to_basis b in
|
||||||
|
Printf.sprintf "
|
||||||
|
Name of the AO basis ::
|
||||||
|
|
||||||
|
ao_extra_basis = %s
|
||||||
|
|
||||||
|
Cartesian coordinates (6d,10f,...) ::
|
||||||
|
|
||||||
|
ao_extra_cartesian = %s
|
||||||
|
|
||||||
|
Use normalized primitive functions ::
|
||||||
|
|
||||||
|
primitives_normalized_extra = %s
|
||||||
|
|
||||||
|
Use normalized basis functions ::
|
||||||
|
|
||||||
|
ao_extra_normalized = %s
|
||||||
|
|
||||||
|
Basis set (read-only) ::
|
||||||
|
|
||||||
|
%s
|
||||||
|
|
||||||
|
|
||||||
|
======= ========= ===========
|
||||||
|
Basis Nucleus Symmetries
|
||||||
|
======= ========= ===========
|
||||||
|
%s
|
||||||
|
======= ========= ===========
|
||||||
|
|
||||||
|
" (AO_basis_name.to_string b.ao_extra_basis)
|
||||||
|
(string_of_bool b.ao_extra_cartesian)
|
||||||
|
(string_of_bool b.primitives_normalized_extra)
|
||||||
|
(string_of_bool b.ao_extra_normalized)
|
||||||
|
(Basis.to_string short_basis
|
||||||
|
|> String_ext.split ~on:'\n'
|
||||||
|
|> list_map (fun x-> " "^x)
|
||||||
|
|> String.concat "\n"
|
||||||
|
) print_sym
|
||||||
|
|
||||||
|
|> Rst_string.of_string
|
||||||
|
;;
|
||||||
|
|
||||||
|
let read_rst s =
|
||||||
|
let s = Rst_string.to_string s
|
||||||
|
|> String_ext.split ~on:'\n'
|
||||||
|
in
|
||||||
|
let rec extract_basis = function
|
||||||
|
| [] -> failwith "Error in basis set"
|
||||||
|
| line :: tail ->
|
||||||
|
let line = String.trim line in
|
||||||
|
if line = "Basis set (read-only) ::" then
|
||||||
|
String.concat "\n" tail
|
||||||
|
else
|
||||||
|
extract_basis tail
|
||||||
|
in
|
||||||
|
extract_basis s
|
||||||
|
;;
|
||||||
|
|
||||||
|
let to_string b =
|
||||||
|
Printf.sprintf "
|
||||||
|
ao_extra_basis = %s
|
||||||
|
ao_extra_num = %s
|
||||||
|
ao_extra_prim_num = %s
|
||||||
|
ao_extra_prim_num_max = %s
|
||||||
|
ao_extra_nucl = %s
|
||||||
|
ao_extra_power = %s
|
||||||
|
ao_extra_coef = %s
|
||||||
|
ao_extra_expo = %s
|
||||||
|
ao_extra_cartesian = %s
|
||||||
|
ao_extra_normalized = %s
|
||||||
|
primitives_normalized_extra = %s
|
||||||
|
md5 = %s
|
||||||
|
"
|
||||||
|
(AO_basis_name.to_string b.ao_extra_basis)
|
||||||
|
(AO_number.to_string b.ao_extra_num)
|
||||||
|
(b.ao_extra_prim_num |> Array.to_list |> list_map
|
||||||
|
(AO_prim_number.to_string) |> String.concat ", " )
|
||||||
|
(AO_prim_number.to_string b.ao_extra_prim_num_max)
|
||||||
|
(b.ao_extra_nucl |> Array.to_list |> list_map Nucl_number.to_string |>
|
||||||
|
String.concat ", ")
|
||||||
|
(b.ao_extra_power |> Array.to_list |> list_map (fun x->
|
||||||
|
"("^(Angmom.Xyz.to_string x)^")" )|> String.concat ", ")
|
||||||
|
(b.ao_extra_coef |> Array.to_list |> list_map AO_coef.to_string
|
||||||
|
|> String.concat ", ")
|
||||||
|
(b.ao_extra_expo |> Array.to_list |> list_map AO_expo.to_string
|
||||||
|
|> String.concat ", ")
|
||||||
|
(b.ao_extra_cartesian |> string_of_bool)
|
||||||
|
(b.ao_extra_normalized |> string_of_bool)
|
||||||
|
(b.primitives_normalized_extra |> string_of_bool)
|
||||||
|
(to_md5 b |> MD5.to_string )
|
||||||
|
|
||||||
|
;;
|
||||||
|
end
|
||||||
|
|
||||||
87
plugins/local/ao_extra_basis/density_extra.irp.f
Normal file
87
plugins/local/ao_extra_basis/density_extra.irp.f
Normal file
@ -0,0 +1,87 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, effective_ao_extra_dm, (ao_extra_num, ao_extra_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! effective density matrix : rho_pq x N_p x N_q x E_pq x (pi/gamma_pq)^3/2
|
||||||
|
!
|
||||||
|
! where rho_pq is the usual density matrix
|
||||||
|
!
|
||||||
|
! N_p and N_q are the normalization factors associated with the two Gaussians
|
||||||
|
!
|
||||||
|
! E_pq is the prefactor resulting from the Gaussian product
|
||||||
|
!
|
||||||
|
! gamma_pq = gamma_p + gamm_q
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
do i = 1, ao_extra_num
|
||||||
|
do j = 1, ao_extra_num
|
||||||
|
effective_ao_extra_dm(j,i) = ao_extra_one_e_dm(j,i) * ao_extra_coef_normalized(j,1) * ao_extra_coef_normalized(i,1) &
|
||||||
|
* inv_pi_gamma_pq_3_2_ao_extra(j,i) * E_pq_ao_extra(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, gamma_pq_ao_extra, (ao_extra_num,ao_extra_num)]
|
||||||
|
&BEGIN_PROVIDER [ double precision, inv_gamma_pq_ao_extra, (ao_extra_num,ao_extra_num)]
|
||||||
|
&BEGIN_PROVIDER [ double precision, inv_pi_gamma_pq_3_2_ao_extra, (ao_extra_num,ao_extra_num)]
|
||||||
|
&BEGIN_PROVIDER [ double precision, sqrt_gamma_pq_ao_extra, (ao_extra_num,ao_extra_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! gamma_pq_ao_extra = gamma_p + gamma_q
|
||||||
|
!
|
||||||
|
! inv_gamma_pq_ao_extra = 1/(gamma_p + gamma_q)
|
||||||
|
!
|
||||||
|
! sqrt_gamma_pq_ao_extra = sqrt(gamma_p + gamma_q)
|
||||||
|
!
|
||||||
|
! WARNING :: VALID ONLY IN THE CASE OF A PURELY 1S BASIS
|
||||||
|
END_DOC
|
||||||
|
include 'constants.include.F'
|
||||||
|
integer :: i,j
|
||||||
|
do i = 1, ao_extra_num
|
||||||
|
do j = 1, ao_extra_num
|
||||||
|
gamma_pq_ao_extra(j,i) = ao_extra_expo(j,1) + ao_extra_expo(i,1)
|
||||||
|
inv_gamma_pq_ao_extra(j,i) = 1.d0/gamma_pq_ao_extra(j,i)
|
||||||
|
sqrt_gamma_pq_ao_extra(j,i) = dsqrt(gamma_pq_ao_extra(j,i))
|
||||||
|
inv_pi_gamma_pq_3_2_ao_extra(j,i) = (pi * inv_gamma_pq_ao_extra(j,i))**(1.5d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, E_pq_ao_extra, (ao_extra_num,ao_extra_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! E_pq_ao_extra = exp(-alpha_p alpha_q/gamma_pq (Q_p - Q_q)^2)
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
do i = 1, ao_extra_num
|
||||||
|
do j = 1, ao_extra_num
|
||||||
|
E_pq_ao_extra(j,i) = dexp(-ao_extra_center_1s_dist(j,i)**2 * ao_extra_expo(j,1)*ao_extra_expo(i,1)*inv_gamma_pq_ao_extra(j,i))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_extra_center_1s, (3,ao_extra_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Original position of each extra AO
|
||||||
|
END_DOC
|
||||||
|
integer :: i,i_nucl
|
||||||
|
do i = 1, ao_extra_num
|
||||||
|
i_nucl= ao_extra_nucl(i)
|
||||||
|
ao_extra_center_1s(1:3,i) = extra_nucl_coord(i_nucl,1:3)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, ao_extra_center_1s_dist, (ao_extra_num,ao_extra_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j
|
||||||
|
do i = 1, ao_extra_num
|
||||||
|
do j = 1, ao_extra_num
|
||||||
|
ao_extra_center_1s_dist(j,i) = (ao_extra_center_1s(1,j) - ao_extra_center_1s(1,i))**2 &
|
||||||
|
+ (ao_extra_center_1s(2,j) - ao_extra_center_1s(2,i))**2 &
|
||||||
|
+ (ao_extra_center_1s(3,j) - ao_extra_center_1s(3,i))**2
|
||||||
|
ao_extra_center_1s_dist(j,i)=dsqrt(ao_extra_center_1s_dist(j,i))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
23
plugins/local/extra_basis_int/coul_1s.irp.f
Normal file
23
plugins/local/extra_basis_int/coul_1s.irp.f
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
double precision function coul_full_pq_r_1s(p,q,R,R_p,R_q)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! coul_full_pq_r_1s(p,q,r) = \int d^3r phi_p(r) phi_q(r) 1/(r-R)
|
||||||
|
!
|
||||||
|
! where phi_q and phi_p are centered in R_q and R_p.
|
||||||
|
!
|
||||||
|
! WARNING :: works only for purely 1s extra basis !!
|
||||||
|
END_DOC
|
||||||
|
double precision, intent(in) :: R(3),R_p(3),R_q(3)
|
||||||
|
integer, intent(in) :: p,q
|
||||||
|
double precision :: coef,dist,P_pq(3),coefaos
|
||||||
|
coefaos= ao_extra_coef_normalized(p,1) * ao_extra_coef_normalized(q,1)
|
||||||
|
coef = inv_pi_gamma_pq_3_2_ao_extra(p,q) * E_pq_ao_extra(p,q)
|
||||||
|
P_pq = ao_extra_expo(p,1) * R_p + ao_extra_expo(q,1) * R_q
|
||||||
|
P_pq = P_pq * inv_gamma_pq_ao_extra(q,p)
|
||||||
|
dist = (P_pq(1)-R(1)) * (P_pq(1)-R(1))
|
||||||
|
dist+= (P_pq(2)-R(2)) * (P_pq(2)-R(2))
|
||||||
|
dist+= (P_pq(3)-R(3)) * (P_pq(3)-R(3))
|
||||||
|
dist = dsqrt(dist)
|
||||||
|
coul_full_pq_r_1s = coefaos * coef * derf(sqrt_gamma_pq_ao_extra(q,p) * dist)/dist
|
||||||
|
|
||||||
|
end
|
||||||
@ -9,7 +9,8 @@ program extra_basis_int
|
|||||||
! call routine_pot_ne_extra
|
! call routine_pot_ne_extra
|
||||||
! call routine_test_pot_ne_mixed
|
! call routine_test_pot_ne_mixed
|
||||||
! call routine_pot_ne
|
! call routine_pot_ne
|
||||||
call routine_test_pot_ne_extra_mixed
|
! call routine_test_pot_ne_extra_mixed
|
||||||
|
call routine_test_coul_1s
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -122,3 +123,27 @@ subroutine routine_test_pot_ne_extra_mixed
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
subroutine routine_test_coul_1s
|
||||||
|
implicit none
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: r(3) ,mu_in,NAI_pol_mult_erf_ao_extra
|
||||||
|
double precision :: ref,new, accu,coul_full_pq_r_1s,v_nucl_extra_ao
|
||||||
|
r(1) = 0.d0
|
||||||
|
r(2) = 0.5d0
|
||||||
|
r(3) = -1.5d0
|
||||||
|
r=nucl_coord(1,1:3)
|
||||||
|
mu_in = 1.d+10
|
||||||
|
accu = 0.d0
|
||||||
|
do i = 1, ao_extra_num
|
||||||
|
do j = 1, ao_extra_num
|
||||||
|
! do i = 1, 1
|
||||||
|
! do j = 1, 1
|
||||||
|
ref = NAI_pol_mult_erf_ao_extra(i, j, mu_in, r)
|
||||||
|
new = coul_full_pq_r_1s(i,j,r,ao_extra_center_1s(1,i),ao_extra_center_1s(1,j))
|
||||||
|
! new = v_nucl_extra_ao(i,j)
|
||||||
|
accu += dabs(new-ref)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
print*,'accu = ',accu
|
||||||
|
end
|
||||||
|
|||||||
@ -120,3 +120,19 @@ BEGIN_PROVIDER [ double precision, extra_center_of_mass, (3) ]
|
|||||||
extra_center_of_mass(:) = extra_center_of_mass(:)*s
|
extra_center_of_mass(:) = extra_center_of_mass(:)*s
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, extra_nucl_dist, (extra_nucl_num,extra_nucl_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: x,y,z
|
||||||
|
do i = 1, extra_nucl_num
|
||||||
|
do j = 1, extra_nucl_num
|
||||||
|
x = extra_nucl_coord(i,1)-extra_nucl_coord(j,1)
|
||||||
|
y = extra_nucl_coord(i,2)-extra_nucl_coord(j,2)
|
||||||
|
z = extra_nucl_coord(i,3)-extra_nucl_coord(j,3)
|
||||||
|
extra_nucl_dist(j,i) = x*x+y*y+z*z
|
||||||
|
extra_nucl_dist(j,i) = dsqrt(extra_nucl_dist(j,i))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|||||||
@ -35,3 +35,167 @@ BEGIN_PROVIDER [logical, use_cgtos]
|
|||||||
! call write_time(6)
|
! call write_time(6)
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_expo_cgtos_ord_transp, (ao_prim_num_max, ao_num)]
|
||||||
|
&BEGIN_PROVIDER [double precision, ao_expo_pw_ord_transp, (4, ao_prim_num_max, ao_num)]
|
||||||
|
&BEGIN_PROVIDER [double precision, ao_expo_phase_ord_transp, (4, ao_prim_num_max, ao_num)]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j, m
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_prim_num_max
|
||||||
|
|
||||||
|
ao_expo_cgtos_ord_transp(i,j) = ao_expo_cgtos_ord(j,i)
|
||||||
|
|
||||||
|
do m = 1, 4
|
||||||
|
ao_expo_pw_ord_transp(m,i,j) = ao_expo_pw_ord(m,j,i)
|
||||||
|
ao_expo_phase_ord_transp(m,i,j) = ao_expo_phase_ord(m,j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, ao_coef_norm_cgtos_ord, (ao_num, ao_prim_num_max)]
|
||||||
|
&BEGIN_PROVIDER [complex*16 , ao_expo_cgtos_ord, (ao_num, ao_prim_num_max)]
|
||||||
|
&BEGIN_PROVIDER [double precision, ao_expo_pw_ord, (4, ao_num, ao_prim_num_max)]
|
||||||
|
&BEGIN_PROVIDER [double precision, ao_expo_phase_ord, (4, ao_num, ao_prim_num_max)]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j, m
|
||||||
|
integer :: iorder(ao_prim_num_max)
|
||||||
|
double precision :: d(ao_prim_num_max,11)
|
||||||
|
|
||||||
|
d = 0.d0
|
||||||
|
|
||||||
|
do i = 1, ao_num
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
iorder(j) = j
|
||||||
|
d(j,1) = ao_expo(i,j)
|
||||||
|
d(j,2) = ao_coef_norm_cgtos(i,j)
|
||||||
|
d(j,3) = ao_expo_im(i,j)
|
||||||
|
|
||||||
|
do m = 1, 3
|
||||||
|
d(j,3+m) = ao_expo_pw(m,i,j)
|
||||||
|
enddo
|
||||||
|
d(j,7) = d(j,4) * d(j,4) + d(j,5) * d(j,5) + d(j,6) * d(j,6)
|
||||||
|
|
||||||
|
do m = 1, 3
|
||||||
|
d(j,7+m) = ao_expo_phase(m,i,j)
|
||||||
|
enddo
|
||||||
|
d(j,11) = d(j,8) + d(j,9) + d(j,10)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call dsort(d(1,1), iorder, ao_prim_num(i))
|
||||||
|
do j = 2, 11
|
||||||
|
call dset_order(d(1,j), iorder, ao_prim_num(i))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
ao_expo_cgtos_ord (i,j) = d(j,1) + (0.d0, 1.d0) * d(j,3)
|
||||||
|
ao_coef_norm_cgtos_ord(i,j) = d(j,2)
|
||||||
|
|
||||||
|
do m = 1, 4
|
||||||
|
ao_expo_pw_ord(m,i,j) = d(j,3+m)
|
||||||
|
ao_expo_phase_ord(m,i,j) = d(j,7+m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, ao_coef_cgtos_norm_ord_transp, (ao_prim_num_max, ao_num)]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do i = 1, ao_prim_num_max
|
||||||
|
ao_coef_cgtos_norm_ord_transp(i,j) = ao_coef_norm_cgtos_ord(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, ao_coef_norm_cgtos, (ao_num, ao_prim_num_max)]
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i, j, ii, m, powA(3), nz
|
||||||
|
double precision :: norm
|
||||||
|
double precision :: kA2, phiA
|
||||||
|
complex*16 :: expo, expo_inv, C_Ae(3), C_Ap(3)
|
||||||
|
complex*16 :: overlap_x, overlap_y, overlap_z
|
||||||
|
complex*16 :: integ1, integ2, C1, C2
|
||||||
|
|
||||||
|
nz = 100
|
||||||
|
|
||||||
|
ao_coef_norm_cgtos = 0.d0
|
||||||
|
|
||||||
|
do i = 1, ao_num
|
||||||
|
|
||||||
|
ii = ao_nucl(i)
|
||||||
|
powA(1) = ao_power(i,1)
|
||||||
|
powA(2) = ao_power(i,2)
|
||||||
|
powA(3) = ao_power(i,3)
|
||||||
|
|
||||||
|
if(primitives_normalized) then
|
||||||
|
|
||||||
|
! Normalization of the primitives
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
|
||||||
|
expo = ao_expo(i,j) + (0.d0, 1.d0) * ao_expo_im(i,j)
|
||||||
|
expo_inv = (1.d0, 0.d0) / expo
|
||||||
|
do m = 1, 3
|
||||||
|
C_Ap(m) = nucl_coord(ii,m)
|
||||||
|
C_Ae(m) = nucl_coord(ii,m) - (0.d0, 0.5d0) * expo_inv * ao_expo_pw(m,i,j)
|
||||||
|
enddo
|
||||||
|
phiA = ao_expo_phase(1,i,j) + ao_expo_phase(2,i,j) + ao_expo_phase(3,i,j)
|
||||||
|
KA2 = ao_expo_pw(1,i,j) * ao_expo_pw(1,i,j) &
|
||||||
|
+ ao_expo_pw(2,i,j) * ao_expo_pw(2,i,j) &
|
||||||
|
+ ao_expo_pw(3,i,j) * ao_expo_pw(3,i,j)
|
||||||
|
|
||||||
|
C1 = zexp(-(0.d0, 2.d0) * phiA - 0.5d0 * expo_inv * KA2)
|
||||||
|
C2 = zexp(-(0.5d0, 0.d0) * real(expo_inv) * KA2)
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz(C_Ae, C_Ae, expo, expo, powA, powA, &
|
||||||
|
C_Ap, C_Ap, overlap_x, overlap_y, overlap_z, integ1, nz)
|
||||||
|
|
||||||
|
call overlap_cgaussian_xyz(conjg(C_Ae), C_Ae, conjg(expo), expo, powA, powA, &
|
||||||
|
conjg(C_Ap), C_Ap, overlap_x, overlap_y, overlap_z, integ2, nz)
|
||||||
|
|
||||||
|
norm = 2.d0 * real(C1 * integ1 + C2 * integ2)
|
||||||
|
|
||||||
|
!ao_coef_norm_cgtos(i,j) = 1.d0 / dsqrt(norm)
|
||||||
|
ao_coef_norm_cgtos(i,j) = ao_coef(i,j) / dsqrt(norm)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
do j = 1, ao_prim_num(i)
|
||||||
|
ao_coef_norm_cgtos(i,j) = ao_coef(i,j)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif ! primitives_normalized
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -1,163 +1,3 @@
|
|||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_coef_cgtos_norm_ord_transp, (ao_prim_num_max, ao_num)]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i, j
|
|
||||||
|
|
||||||
do j = 1, ao_num
|
|
||||||
do i = 1, ao_prim_num_max
|
|
||||||
ao_coef_cgtos_norm_ord_transp(i,j) = ao_coef_norm_cgtos_ord(j,i)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [complex*16, ao_expo_cgtos_ord_transp, (ao_prim_num_max, ao_num)]
|
|
||||||
&BEGIN_PROVIDER [double precision, ao_expo_pw_ord_transp, (4, ao_prim_num_max, ao_num)]
|
|
||||||
&BEGIN_PROVIDER [double precision, ao_expo_phase_ord_transp, (4, ao_prim_num_max, ao_num)]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i, j, m
|
|
||||||
|
|
||||||
do j = 1, ao_num
|
|
||||||
do i = 1, ao_prim_num_max
|
|
||||||
|
|
||||||
ao_expo_cgtos_ord_transp(i,j) = ao_expo_cgtos_ord(j,i)
|
|
||||||
|
|
||||||
do m = 1, 4
|
|
||||||
ao_expo_pw_ord_transp(m,i,j) = ao_expo_pw_ord(m,j,i)
|
|
||||||
ao_expo_phase_ord_transp(m,i,j) = ao_expo_phase_ord(m,j,i)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_coef_norm_cgtos, (ao_num, ao_prim_num_max)]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i, j, ii, m, powA(3), nz
|
|
||||||
double precision :: norm
|
|
||||||
double precision :: kA2, phiA
|
|
||||||
complex*16 :: expo, expo_inv, C_Ae(3), C_Ap(3)
|
|
||||||
complex*16 :: overlap_x, overlap_y, overlap_z
|
|
||||||
complex*16 :: integ1, integ2, C1, C2
|
|
||||||
|
|
||||||
nz = 100
|
|
||||||
|
|
||||||
ao_coef_norm_cgtos = 0.d0
|
|
||||||
|
|
||||||
do i = 1, ao_num
|
|
||||||
|
|
||||||
ii = ao_nucl(i)
|
|
||||||
powA(1) = ao_power(i,1)
|
|
||||||
powA(2) = ao_power(i,2)
|
|
||||||
powA(3) = ao_power(i,3)
|
|
||||||
|
|
||||||
if(primitives_normalized) then
|
|
||||||
|
|
||||||
! Normalization of the primitives
|
|
||||||
do j = 1, ao_prim_num(i)
|
|
||||||
|
|
||||||
expo = ao_expo(i,j) + (0.d0, 1.d0) * ao_expo_im(i,j)
|
|
||||||
expo_inv = (1.d0, 0.d0) / expo
|
|
||||||
do m = 1, 3
|
|
||||||
C_Ap(m) = nucl_coord(ii,m)
|
|
||||||
C_Ae(m) = nucl_coord(ii,m) - (0.d0, 0.5d0) * expo_inv * ao_expo_pw(m,i,j)
|
|
||||||
enddo
|
|
||||||
phiA = ao_expo_phase(1,i,j) + ao_expo_phase(2,i,j) + ao_expo_phase(3,i,j)
|
|
||||||
KA2 = ao_expo_pw(1,i,j) * ao_expo_pw(1,i,j) &
|
|
||||||
+ ao_expo_pw(2,i,j) * ao_expo_pw(2,i,j) &
|
|
||||||
+ ao_expo_pw(3,i,j) * ao_expo_pw(3,i,j)
|
|
||||||
|
|
||||||
C1 = zexp(-(0.d0, 2.d0) * phiA - 0.5d0 * expo_inv * KA2)
|
|
||||||
C2 = zexp(-(0.5d0, 0.d0) * real(expo_inv) * KA2)
|
|
||||||
|
|
||||||
call overlap_cgaussian_xyz(C_Ae, C_Ae, expo, expo, powA, powA, &
|
|
||||||
C_Ap, C_Ap, overlap_x, overlap_y, overlap_z, integ1, nz)
|
|
||||||
|
|
||||||
call overlap_cgaussian_xyz(conjg(C_Ae), C_Ae, conjg(expo), expo, powA, powA, &
|
|
||||||
conjg(C_Ap), C_Ap, overlap_x, overlap_y, overlap_z, integ2, nz)
|
|
||||||
|
|
||||||
norm = 2.d0 * real(C1 * integ1 + C2 * integ2)
|
|
||||||
|
|
||||||
!ao_coef_norm_cgtos(i,j) = 1.d0 / dsqrt(norm)
|
|
||||||
ao_coef_norm_cgtos(i,j) = ao_coef(i,j) / dsqrt(norm)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
else
|
|
||||||
|
|
||||||
do j = 1, ao_prim_num(i)
|
|
||||||
ao_coef_norm_cgtos(i,j) = ao_coef(i,j)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
endif ! primitives_normalized
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_coef_norm_cgtos_ord, (ao_num, ao_prim_num_max)]
|
|
||||||
&BEGIN_PROVIDER [complex*16 , ao_expo_cgtos_ord, (ao_num, ao_prim_num_max)]
|
|
||||||
&BEGIN_PROVIDER [double precision, ao_expo_pw_ord, (4, ao_num, ao_prim_num_max)]
|
|
||||||
&BEGIN_PROVIDER [double precision, ao_expo_phase_ord, (4, ao_num, ao_prim_num_max)]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer :: i, j, m
|
|
||||||
integer :: iorder(ao_prim_num_max)
|
|
||||||
double precision :: d(ao_prim_num_max,11)
|
|
||||||
|
|
||||||
d = 0.d0
|
|
||||||
|
|
||||||
do i = 1, ao_num
|
|
||||||
|
|
||||||
do j = 1, ao_prim_num(i)
|
|
||||||
iorder(j) = j
|
|
||||||
d(j,1) = ao_expo(i,j)
|
|
||||||
d(j,2) = ao_coef_norm_cgtos(i,j)
|
|
||||||
d(j,3) = ao_expo_im(i,j)
|
|
||||||
|
|
||||||
do m = 1, 3
|
|
||||||
d(j,3+m) = ao_expo_pw(m,i,j)
|
|
||||||
enddo
|
|
||||||
d(j,7) = d(j,4) * d(j,4) + d(j,5) * d(j,5) + d(j,6) * d(j,6)
|
|
||||||
|
|
||||||
do m = 1, 3
|
|
||||||
d(j,7+m) = ao_expo_phase(m,i,j)
|
|
||||||
enddo
|
|
||||||
d(j,11) = d(j,8) + d(j,9) + d(j,10)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
call dsort(d(1,1), iorder, ao_prim_num(i))
|
|
||||||
do j = 2, 11
|
|
||||||
call dset_order(d(1,j), iorder, ao_prim_num(i))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
do j = 1, ao_prim_num(i)
|
|
||||||
ao_expo_cgtos_ord (i,j) = d(j,1) + (0.d0, 1.d0) * d(j,3)
|
|
||||||
ao_coef_norm_cgtos_ord(i,j) = d(j,2)
|
|
||||||
|
|
||||||
do m = 1, 4
|
|
||||||
ao_expo_pw_ord(m,i,j) = d(j,3+m)
|
|
||||||
ao_expo_phase_ord(m,i,j) = d(j,7+m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, ao_overlap_cgtos, (ao_num, ao_num)]
|
BEGIN_PROVIDER [double precision, ao_overlap_cgtos, (ao_num, ao_num)]
|
||||||
@ -282,23 +122,3 @@ END_PROVIDER
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [logical, use_pw]
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
logical :: exist
|
|
||||||
|
|
||||||
use_pw = .false.
|
|
||||||
|
|
||||||
call ezfio_has_ao_basis_ao_expo_pw(exist)
|
|
||||||
if(exist) then
|
|
||||||
PROVIDE ao_expo_pw_ord_transp
|
|
||||||
if(maxval(dabs(ao_expo_pw_ord_transp(4,:,:))) .gt. 1d-15) use_pw = .true.
|
|
||||||
endif
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
! ---
|
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user