From 7a2acd04eaec1ffa3cbf54405f33447bad89428c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 13 Jun 2017 13:13:02 +0200 Subject: [PATCH] Errors in QPtypes --- ocaml/qp_set_mo_class.ml | 154 +++++++++++++++++++------------------ ocaml/qptypes_generator.ml | 58 ++++++++------ 2 files changed, 116 insertions(+), 96 deletions(-) diff --git a/ocaml/qp_set_mo_class.ml b/ocaml/qp_set_mo_class.ml index 6e58506b..7451d87d 100644 --- a/ocaml/qp_set_mo_class.ml +++ b/ocaml/qp_set_mo_class.ml @@ -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) diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index 160a07d0..06006181 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -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