mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 14:01:46 +02:00
Errors in QPtypes
This commit is contained in:
parent
e986a3cd44
commit
7a2acd04ea
@ -15,12 +15,12 @@ let build_mask from upto n_int =
|
|||||||
let rec build_mask bit = function
|
let rec build_mask bit = function
|
||||||
| 0 -> []
|
| 0 -> []
|
||||||
| i ->
|
| i ->
|
||||||
if ( i = upto ) then
|
if ( i = upto ) then
|
||||||
Bit.One::(build_mask Bit.One (i-1))
|
Bit.One::(build_mask Bit.One (i-1))
|
||||||
else if ( i = from ) then
|
else if ( i = from ) then
|
||||||
Bit.One::(build_mask Bit.Zero (i-1))
|
Bit.One::(build_mask Bit.Zero (i-1))
|
||||||
else
|
else
|
||||||
bit::(build_mask bit (i-1))
|
bit::(build_mask bit (i-1))
|
||||||
in
|
in
|
||||||
let starting_bit =
|
let starting_bit =
|
||||||
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
|
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
|
||||||
@ -31,80 +31,75 @@ let build_mask from upto n_int =
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
type t =
|
type t = MO_class.t option
|
||||||
| Core
|
|
||||||
| Inactive
|
|
||||||
| Active
|
|
||||||
| Virtual
|
|
||||||
| Deleted
|
|
||||||
| None
|
|
||||||
|
|
||||||
|
|
||||||
let t_to_string = function
|
|
||||||
| Core -> "core"
|
|
||||||
| Inactive -> "inactive"
|
|
||||||
| Active -> "active"
|
|
||||||
| Virtual -> "virtual"
|
|
||||||
| Deleted -> "deleted"
|
|
||||||
| None -> assert false
|
|
||||||
|
|
||||||
|
|
||||||
let set ~core ~inact ~act ~virt ~del =
|
let set ~core ~inact ~act ~virt ~del =
|
||||||
|
|
||||||
let mo_tot_num =
|
let mo_tot_num =
|
||||||
Ezfio.get_mo_basis_mo_tot_num ()
|
Ezfio.get_mo_basis_mo_tot_num ()
|
||||||
in
|
in
|
||||||
let n_int =
|
let n_int =
|
||||||
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
|
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
|
||||||
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
|
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
|
||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
let mo_class =
|
let mo_class =
|
||||||
Array.init mo_tot_num ~f:(fun i -> None)
|
Array.init mo_tot_num ~f:(fun i -> None)
|
||||||
in
|
in
|
||||||
|
|
||||||
(* Check input data *)
|
(* Check input data *)
|
||||||
let apply_class l =
|
let apply_class l =
|
||||||
let rec apply_class t = function
|
let rec apply_class t = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| k::tail -> let i = MO_number.to_int k in
|
| k::tail -> let i = MO_number.to_int k in
|
||||||
begin
|
begin
|
||||||
match mo_class.(i-1) with
|
match mo_class.(i-1) with
|
||||||
| None -> mo_class.(i-1) <- t ;
|
| None -> mo_class.(i-1) <- Some t ;
|
||||||
apply_class t tail;
|
apply_class t tail;
|
||||||
| x -> failwith
|
| Some x -> failwith
|
||||||
(Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
|
(Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
|
||||||
i (t_to_string x) (t_to_string t))
|
i (MO_class.to_string x) (MO_class.to_string t))
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
match l with
|
match l with
|
||||||
| MO_class.Core x -> apply_class Core x
|
| MO_class.Core x -> apply_class (MO_class.Core []) x
|
||||||
| MO_class.Inactive x -> apply_class Inactive x
|
| MO_class.Inactive x -> apply_class (MO_class.Inactive []) x
|
||||||
| MO_class.Active x -> apply_class Active x
|
| MO_class.Active x -> apply_class (MO_class.Active []) x
|
||||||
| MO_class.Virtual x -> apply_class Virtual x
|
| MO_class.Virtual x -> apply_class (MO_class.Virtual []) x
|
||||||
| MO_class.Deleted x -> apply_class Deleted x
|
| MO_class.Deleted x -> apply_class (MO_class.Deleted []) x
|
||||||
in
|
in
|
||||||
|
|
||||||
let core = MO_class.create_core core in
|
let check f x =
|
||||||
let inact = MO_class.create_inactive inact in
|
try f x with Invalid_argument a ->
|
||||||
let act = MO_class.create_active act in
|
begin
|
||||||
let virt = MO_class.create_virtual virt in
|
Printf.printf "Number of MOs: %d\n%!" mo_tot_num;
|
||||||
let del = MO_class.create_deleted del in
|
raise (Invalid_argument a)
|
||||||
|
end
|
||||||
|
in
|
||||||
|
|
||||||
|
let core = check MO_class.create_core core in
|
||||||
|
let inact = check MO_class.create_inactive inact in
|
||||||
|
let act = check MO_class.create_active act in
|
||||||
|
let virt = check MO_class.create_virtual virt in
|
||||||
|
let del = check MO_class.create_deleted del in
|
||||||
|
|
||||||
apply_class core ;
|
apply_class core ;
|
||||||
apply_class inact ;
|
apply_class inact ;
|
||||||
apply_class act ;
|
apply_class act ;
|
||||||
apply_class virt ;
|
apply_class virt ;
|
||||||
apply_class del ;
|
apply_class del ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
for i=1 to (Array.length mo_class)
|
for i=1 to (Array.length mo_class)
|
||||||
do
|
do
|
||||||
if (mo_class.(i-1) = None) then
|
if (mo_class.(i-1) = None) then
|
||||||
failwith (Printf.sprintf "Orbital %d is not specified (mo_tot_num = %d)" i mo_tot_num)
|
failwith (Printf.sprintf "Orbital %d is not specified (mo_tot_num = %d)" i mo_tot_num)
|
||||||
done;
|
done;
|
||||||
|
|
||||||
|
|
||||||
(* Debug output *)
|
(* Debug output *)
|
||||||
MO_class.to_string core |> print_endline ;
|
MO_class.to_string core |> print_endline ;
|
||||||
MO_class.to_string inact |> print_endline ;
|
MO_class.to_string inact |> print_endline ;
|
||||||
@ -118,14 +113,14 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
and av = Excitation.create_single act virt
|
and av = Excitation.create_single act virt
|
||||||
in
|
in
|
||||||
let single_excitations = [ ia ; aa ; av ]
|
let single_excitations = [ ia ; aa ; av ]
|
||||||
|> List.map ~f:Excitation.(fun x ->
|
|> List.map ~f:Excitation.(fun x ->
|
||||||
match x with
|
match x with
|
||||||
| Single (x,y) ->
|
| Single (x,y) ->
|
||||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
||||||
| Double _ -> assert false
|
| Double _ -> assert false
|
||||||
)
|
)
|
||||||
|
|
||||||
and double_excitations = [
|
and double_excitations = [
|
||||||
Excitation.double_of_singles ia ia ;
|
Excitation.double_of_singles ia ia ;
|
||||||
Excitation.double_of_singles ia aa ;
|
Excitation.double_of_singles ia aa ;
|
||||||
@ -134,16 +129,16 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
Excitation.double_of_singles aa av ;
|
Excitation.double_of_singles aa av ;
|
||||||
Excitation.double_of_singles av av ]
|
Excitation.double_of_singles av av ]
|
||||||
|> List.map ~f:Excitation.(fun x ->
|
|> List.map ~f:Excitation.(fun x ->
|
||||||
match x with
|
match x with
|
||||||
| Single _ -> assert false
|
| Single _ -> assert false
|
||||||
| Double (x,y,z,t) ->
|
| Double (x,y,z,t) ->
|
||||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class y) ,
|
MO_class.to_bitlist n_int (Particle.to_mo_class y) ,
|
||||||
MO_class.to_bitlist n_int (Hole.to_mo_class z),
|
MO_class.to_bitlist n_int (Hole.to_mo_class z),
|
||||||
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
|
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
|
||||||
)
|
)
|
||||||
in
|
in
|
||||||
|
|
||||||
let extract_hole (h,_) = h
|
let extract_hole (h,_) = h
|
||||||
and extract_particle (_,p) = p
|
and extract_particle (_,p) = p
|
||||||
and extract_hole1 (h,_,_,_) = h
|
and extract_hole1 (h,_,_,_) = h
|
||||||
@ -171,9 +166,9 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
|
|
||||||
(* Write masks *)
|
(* Write masks *)
|
||||||
let result = List.map ~f:(fun x ->
|
let result = List.map ~f:(fun x ->
|
||||||
let y = Bitlist.to_int64_list x in y@y )
|
let y = Bitlist.to_int64_list x in y@y )
|
||||||
result
|
result
|
||||||
|> List.concat
|
|> List.concat
|
||||||
in
|
in
|
||||||
|
|
||||||
Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
|
Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
|
||||||
@ -187,13 +182,24 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
match aa with
|
match aa with
|
||||||
| Double _ -> assert false
|
| Double _ -> assert false
|
||||||
| Single (x,y) ->
|
| Single (x,y) ->
|
||||||
( MO_class.to_bitlist n_int (Hole.to_mo_class x) ) @
|
( MO_class.to_bitlist n_int (Hole.to_mo_class x) ) @
|
||||||
( MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
( MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|
||||||
|> Bitlist.to_int64_list
|
|> Bitlist.to_int64_list
|
||||||
in
|
in
|
||||||
Ezfio.set_bitmasks_n_mask_cas 1;
|
Ezfio.set_bitmasks_n_mask_cas 1;
|
||||||
Ezfio.ezfio_array_of_list ~rank:3 ~dim:([| (N_int_number.to_int n_int) ; 2; 1|]) ~data:result
|
Ezfio.ezfio_array_of_list ~rank:3 ~dim:([| (N_int_number.to_int n_int) ; 2; 1|]) ~data:result
|
||||||
|> Ezfio.set_bitmasks_cas
|
|> Ezfio.set_bitmasks_cas;
|
||||||
|
|
||||||
|
let data =
|
||||||
|
Array.to_list mo_class
|
||||||
|
|> List.map ~f:(fun x -> match x with
|
||||||
|
|None -> assert false
|
||||||
|
| Some x -> MO_class.to_string x
|
||||||
|
)
|
||||||
|
in
|
||||||
|
Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_tot_num |] ~data
|
||||||
|
|> Ezfio.set_mo_basis_mo_class
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let get () =
|
let get () =
|
||||||
@ -228,17 +234,17 @@ let get () =
|
|||||||
in
|
in
|
||||||
set ~core ~inact ~act ~virt ~del
|
set ~core ~inact ~act ~virt ~del
|
||||||
| (MO_class.Core _) :: rest ->
|
| (MO_class.Core _) :: rest ->
|
||||||
work ~core:(Printf.sprintf "%s,%d" core i) ~inact ~act ~virt ~del (i-1) rest
|
work ~core:(Printf.sprintf "%s,%d" core i) ~inact ~act ~virt ~del (i+1) rest
|
||||||
| (MO_class.Inactive _) :: rest ->
|
| (MO_class.Inactive _) :: rest ->
|
||||||
work ~inact:(Printf.sprintf "%s,%d" inact i) ~core ~act ~virt ~del (i-1) rest
|
work ~inact:(Printf.sprintf "%s,%d" inact i) ~core ~act ~virt ~del (i+1) rest
|
||||||
| (MO_class.Active _) :: rest ->
|
| (MO_class.Active _) :: rest ->
|
||||||
work ~act:(Printf.sprintf "%s,%d" act i) ~inact ~core ~virt ~del (i-1) rest
|
work ~act:(Printf.sprintf "%s,%d" act i) ~inact ~core ~virt ~del (i+1) rest
|
||||||
| (MO_class.Virtual _) :: rest ->
|
| (MO_class.Virtual _) :: rest ->
|
||||||
work ~virt:(Printf.sprintf "%s,%d" virt i) ~inact ~act ~core ~del (i-1) rest
|
work ~virt:(Printf.sprintf "%s,%d" virt i) ~inact ~act ~core ~del (i+1) rest
|
||||||
| (MO_class.Deleted _) :: rest ->
|
| (MO_class.Deleted _) :: rest ->
|
||||||
work ~del:(Printf.sprintf "%s,%d" del i) ~inact ~act ~virt ~core (i-1) rest
|
work ~del:(Printf.sprintf "%s,%d" del i) ~inact ~act ~virt ~core (i+1) rest
|
||||||
in
|
in
|
||||||
work (Array.length data.Input_mo_basis.mo_class) (Array.to_list data.Input_mo_basis.mo_class)
|
work 1 (Array.to_list data.Input_mo_basis.mo_class)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -2,42 +2,52 @@ open Core.Std;;
|
|||||||
|
|
||||||
let input_data = "
|
let input_data = "
|
||||||
* Positive_float : float
|
* Positive_float : float
|
||||||
assert (x >= 0.) ;
|
if not (x >= 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Positive_float : (x >= 0.) : x=%f\" x));
|
||||||
|
|
||||||
* Strictly_positive_float : float
|
* Strictly_positive_float : float
|
||||||
assert (x > 0.) ;
|
if not (x > 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_float : (x > 0.) : x=%f\" x));
|
||||||
|
|
||||||
* Negative_float : float
|
* Negative_float : float
|
||||||
assert (x <= 0.) ;
|
if not (x <= 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Negative_float : (x <= 0.) : x=%f\" x));
|
||||||
|
|
||||||
* Strictly_negative_float : float
|
* Strictly_negative_float : float
|
||||||
assert (x < 0.) ;
|
if not (x < 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
|
||||||
|
|
||||||
* Positive_int64 : int64
|
* Positive_int64 : int64
|
||||||
assert (x >= 0L) ;
|
if not (x >= 0L) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Positive_int64 : (x >= 0L) : x=%s\" (Int64.to_string x)));
|
||||||
|
|
||||||
* Positive_int : int
|
* Positive_int : int
|
||||||
assert (x >= 0) ;
|
if not (x >= 0) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
|
||||||
|
|
||||||
* Strictly_positive_int : int
|
* Strictly_positive_int : int
|
||||||
assert (x > 0) ;
|
if not (x > 0) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_int : (x > 0) : x=%d\" x));
|
||||||
|
|
||||||
* Negative_int : int
|
* Negative_int : int
|
||||||
assert (x <= 0) ;
|
if not (x <= 0) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
|
||||||
|
|
||||||
* Det_coef : float
|
* Det_coef : float
|
||||||
assert (x >= -1.) ;
|
if (x < -1.) || (x > 1.) then
|
||||||
assert (x <= 1.) ;
|
raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
|
||||||
|
|
||||||
* Normalized_float : float
|
* Normalized_float : float
|
||||||
assert (x <= 1.) ;
|
if (x < 0.) || (x > 1.) then
|
||||||
assert (x >= 0.) ;
|
raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
|
||||||
|
|
||||||
* Strictly_negative_int : int
|
* Strictly_negative_int : int
|
||||||
assert (x < 0) ;
|
if not (x < 0) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_int : (x < 0) : x=%d\" x));
|
||||||
|
|
||||||
* Non_empty_string : string
|
* Non_empty_string : string
|
||||||
assert (x <> \"\") ;
|
if (x = \"\") then
|
||||||
|
raise (Invalid_argument \"Non_empty_string\");
|
||||||
|
|
||||||
|
|
||||||
* Det_number_max : int
|
* Det_number_max : int
|
||||||
@ -53,13 +63,13 @@ let input_data = "
|
|||||||
* Bit_kind_size : int
|
* Bit_kind_size : int
|
||||||
begin match x with
|
begin match x with
|
||||||
| 8 | 16 | 32 | 64 -> ()
|
| 8 | 16 | 32 | 64 -> ()
|
||||||
| _ -> raise (Failure \"Bit_kind_size should be (8|16|32|64).\")
|
| _ -> raise (Invalid_argument \"Bit_kind_size should be (8|16|32|64).\")
|
||||||
end;
|
end;
|
||||||
|
|
||||||
* Bit_kind : int
|
* Bit_kind : int
|
||||||
begin match x with
|
begin match x with
|
||||||
| 1 | 2 | 4 | 8 -> ()
|
| 1 | 2 | 4 | 8 -> ()
|
||||||
| _ -> raise (Failure \"Bit_kind should be (1|2|4|8).\")
|
| _ -> raise (Invalid_argument \"Bit_kind should be (1|2|4|8).\")
|
||||||
end;
|
end;
|
||||||
|
|
||||||
* Bitmask_number : int
|
* Bitmask_number : int
|
||||||
@ -68,12 +78,14 @@ let input_data = "
|
|||||||
* MO_coef : float
|
* MO_coef : float
|
||||||
|
|
||||||
* MO_occ : float
|
* MO_occ : float
|
||||||
assert (x >= 0.);
|
if (x < 0.) || (x > 2.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"MO_occ : (0. <= x <= 2.) : x=%f\" x));
|
||||||
|
|
||||||
* AO_coef : float
|
* AO_coef : float
|
||||||
|
|
||||||
* AO_expo : float
|
* AO_expo : float
|
||||||
assert (x >= 0.) ;
|
if (x < 0.) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"AO_expo : (x >= 0.) : x=%f\" x));
|
||||||
|
|
||||||
* AO_prim_number : int
|
* AO_prim_number : int
|
||||||
assert (x > 0) ;
|
assert (x > 0) ;
|
||||||
@ -165,7 +177,7 @@ end = struct
|
|||||||
match (String.lowercase s) with
|
match (String.lowercase s) with
|
||||||
| \"huckel\" -> Huckel
|
| \"huckel\" -> Huckel
|
||||||
| \"hcore\" -> HCore
|
| \"hcore\" -> HCore
|
||||||
| _ -> failwith (\"Wrong Guess type : \"^s)
|
| _ -> raise (Invalid_argument (\"Wrong Guess type : \"^s))
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -189,7 +201,7 @@ end = struct
|
|||||||
| \"read\" -> Read
|
| \"read\" -> Read
|
||||||
| \"write\" -> Write
|
| \"write\" -> Write
|
||||||
| \"none\" -> None
|
| \"none\" -> None
|
||||||
| _ -> failwith (\"Wrong IO type : \"^s)
|
| _ -> raise (Invalid_argument (\"Wrong IO type : \"^s))
|
||||||
|
|
||||||
end
|
end
|
||||||
"
|
"
|
||||||
@ -267,7 +279,9 @@ end = struct
|
|||||||
begin
|
begin
|
||||||
match max with
|
match max with
|
||||||
| %s -> ()
|
| %s -> ()
|
||||||
| i -> assert ( x <= i )
|
| i ->
|
||||||
|
if ( x > i ) then
|
||||||
|
raise (Invalid_argument (Printf.sprintf \"%s: %%s\" (%s.to_string x) ))
|
||||||
end ;
|
end ;
|
||||||
x
|
x
|
||||||
end
|
end
|
||||||
@ -296,7 +310,7 @@ let parse_input_ezfio input=
|
|||||||
in
|
in
|
||||||
Printf.sprintf ezfio_template
|
Printf.sprintf ezfio_template
|
||||||
name typ typ typ typ typ typ typ typ (String.capitalize typ)
|
name typ typ typ typ typ typ typ typ (String.capitalize typ)
|
||||||
ezfio_func ezfio_func max min typ typ max msg min
|
ezfio_func ezfio_func max min typ typ max msg min name (String.capitalize typ)
|
||||||
end
|
end
|
||||||
| _ -> failwith "Error in input_ezfio"
|
| _ -> failwith "Error in input_ezfio"
|
||||||
in
|
in
|
||||||
|
Loading…
Reference in New Issue
Block a user