LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-18 12:03:57 +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
| 0 -> []
| i ->
if ( i = upto ) then
Bit.One::(build_mask Bit.One (i-1))
else if ( i = from ) then
Bit.One::(build_mask Bit.Zero (i-1))
else
bit::(build_mask bit (i-1))
if ( i = upto ) then
Bit.One::(build_mask Bit.One (i-1))
else if ( i = from ) then
Bit.One::(build_mask Bit.Zero (i-1))
else
bit::(build_mask bit (i-1))
in
let starting_bit =
if ( (upto >= n_int*64) || (upto < 0) ) then Bit.One
@ -31,80 +31,75 @@ let build_mask from upto n_int =
type t =
| Core
| Inactive
| Active
| Virtual
| Deleted
| None
let t_to_string = function
| Core -> "core"
| Inactive -> "inactive"
| Active -> "active"
| Virtual -> "virtual"
| Deleted -> "deleted"
| None -> assert false
type t = MO_class.t option
let set ~core ~inact ~act ~virt ~del =
let mo_tot_num =
Ezfio.get_mo_basis_mo_tot_num ()
Ezfio.get_mo_basis_mo_tot_num ()
in
let n_int =
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
try N_int_number.of_int (Ezfio.get_determinants_n_int ())
with _ -> Bitlist.n_int_of_mo_tot_num mo_tot_num
in
let mo_class =
Array.init mo_tot_num ~f:(fun i -> None)
Array.init mo_tot_num ~f:(fun i -> None)
in
(* Check input data *)
let apply_class l =
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
match mo_class.(i-1) with
| None -> mo_class.(i-1) <- t ;
| None -> mo_class.(i-1) <- Some t ;
apply_class t tail;
| x -> failwith
(Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
i (t_to_string x) (t_to_string t))
| Some x -> failwith
(Printf.sprintf "Orbital %d is defined both in the %s and %s spaces"
i (MO_class.to_string x) (MO_class.to_string t))
end
in
match l with
| MO_class.Core x -> apply_class Core x
| MO_class.Inactive x -> apply_class Inactive x
| MO_class.Active x -> apply_class Active x
| MO_class.Virtual x -> apply_class Virtual x
| MO_class.Deleted x -> apply_class Deleted x
| MO_class.Core x -> apply_class (MO_class.Core []) x
| MO_class.Inactive x -> apply_class (MO_class.Inactive []) x
| MO_class.Active x -> apply_class (MO_class.Active []) x
| MO_class.Virtual x -> apply_class (MO_class.Virtual []) x
| MO_class.Deleted x -> apply_class (MO_class.Deleted []) x
in
let core = MO_class.create_core core in
let inact = MO_class.create_inactive inact in
let act = MO_class.create_active act in
let virt = MO_class.create_virtual virt in
let del = MO_class.create_deleted del in
let check f x =
try f x with Invalid_argument a ->
begin
Printf.printf "Number of MOs: %d\n%!" mo_tot_num;
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 inact ;
apply_class act ;
apply_class virt ;
apply_class del ;
for i=1 to (Array.length mo_class)
do
if (mo_class.(i-1) = None) then
failwith (Printf.sprintf "Orbital %d is not specified (mo_tot_num = %d)" i mo_tot_num)
done;
(* Debug output *)
MO_class.to_string core |> 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
in
let single_excitations = [ ia ; aa ; av ]
|> List.map ~f:Excitation.(fun x ->
match x with
| Single (x,y) ->
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
| Double _ -> assert false
)
|> List.map ~f:Excitation.(fun x ->
match x with
| Single (x,y) ->
( MO_class.to_bitlist n_int (Hole.to_mo_class x),
MO_class.to_bitlist n_int (Particle.to_mo_class y) )
| Double _ -> assert false
)
and double_excitations = [
Excitation.double_of_singles ia ia ;
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 av av ]
|> List.map ~f:Excitation.(fun x ->
match x with
| Single _ -> assert false
| Double (x,y,z,t) ->
( 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 (Hole.to_mo_class z),
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
)
match x with
| Single _ -> assert false
| Double (x,y,z,t) ->
( 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 (Hole.to_mo_class z),
MO_class.to_bitlist n_int (Particle.to_mo_class t) )
)
in
let extract_hole (h,_) = h
and extract_particle (_,p) = p
and extract_hole1 (h,_,_,_) = h
@ -171,9 +166,9 @@ let set ~core ~inact ~act ~virt ~del =
(* Write masks *)
let result = List.map ~f:(fun x ->
let y = Bitlist.to_int64_list x in y@y )
result
|> List.concat
let y = Bitlist.to_int64_list x in y@y )
result
|> List.concat
in
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
| Double _ -> assert false
| Single (x,y) ->
( MO_class.to_bitlist n_int (Hole.to_mo_class x) ) @
( MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|> Bitlist.to_int64_list
( MO_class.to_bitlist n_int (Hole.to_mo_class x) ) @
( MO_class.to_bitlist n_int (Particle.to_mo_class y) )
|> Bitlist.to_int64_list
in
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.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 () =
@ -228,17 +234,17 @@ let get () =
in
set ~core ~inact ~act ~virt ~del
| (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 ->
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 ->
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 ->
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 ->
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
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 = "
* 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
assert (x > 0.) ;
if not (x > 0.) then
raise (Invalid_argument (Printf.sprintf \"Strictly_positive_float : (x > 0.) : x=%f\" x));
* 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
assert (x < 0.) ;
if not (x < 0.) then
raise (Invalid_argument (Printf.sprintf \"Strictly_negative_float : (x < 0.) : x=%f\" x));
* 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
assert (x >= 0) ;
if not (x >= 0) then
raise (Invalid_argument (Printf.sprintf \"Positive_int : (x >= 0) : x=%d\" x));
* 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
assert (x <= 0) ;
if not (x <= 0) then
raise (Invalid_argument (Printf.sprintf \"Negative_int : (x <= 0) : x=%d\" x));
* Det_coef : float
assert (x >= -1.) ;
assert (x <= 1.) ;
if (x < -1.) || (x > 1.) then
raise (Invalid_argument (Printf.sprintf \"Det_coef : (-1. <= x <= 1.) : x=%f\" x));
* Normalized_float : float
assert (x <= 1.) ;
assert (x >= 0.) ;
if (x < 0.) || (x > 1.) then
raise (Invalid_argument (Printf.sprintf \"Normalized_float : (0. <= x <= 1.) : x=%f\" x));
* 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
assert (x <> \"\") ;
if (x = \"\") then
raise (Invalid_argument \"Non_empty_string\");
* Det_number_max : int
@ -53,13 +63,13 @@ let input_data = "
* Bit_kind_size : int
begin match x with
| 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;
* Bit_kind : int
begin match x with
| 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;
* Bitmask_number : int
@ -68,12 +78,14 @@ let input_data = "
* MO_coef : 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_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
assert (x > 0) ;
@ -165,7 +177,7 @@ end = struct
match (String.lowercase s) with
| \"huckel\" -> Huckel
| \"hcore\" -> HCore
| _ -> failwith (\"Wrong Guess type : \"^s)
| _ -> raise (Invalid_argument (\"Wrong Guess type : \"^s))
end
@ -189,7 +201,7 @@ end = struct
| \"read\" -> Read
| \"write\" -> Write
| \"none\" -> None
| _ -> failwith (\"Wrong IO type : \"^s)
| _ -> raise (Invalid_argument (\"Wrong IO type : \"^s))
end
"
@ -267,7 +279,9 @@ end = struct
begin
match max with
| %s -> ()
| i -> assert ( x <= i )
| i ->
if ( x > i ) then
raise (Invalid_argument (Printf.sprintf \"%s: %%s\" (%s.to_string x) ))
end ;
x
end
@ -296,7 +310,7 @@ let parse_input_ezfio input=
in
Printf.sprintf ezfio_template
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
| _ -> failwith "Error in input_ezfio"
in