LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 20:35:19 +01:00
Code Issues Releases Wiki Activity

Errors in QPtypes

Browse Source
This commit is contained in:
Anthony Scemama 2017-06-13 13:13:02 +02:00
parent e986a3cd44
commit 7a2acd04ea
2 changed files with 116 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

154
ocaml/qp_set_mo_class.ml
View File

@ -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)

58
ocaml/qptypes_generator.ml
View File

@ -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