diff --git a/ocaml/Bitlist.ml b/ocaml/Bitlist.ml index 88f9b4dd..b6792bb7 100644 --- a/ocaml/Bitlist.ml +++ b/ocaml/Bitlist.ml @@ -7,82 +7,61 @@ Type for bits strings list of Bits *) -type t = Bit.t list +type t = int64 array + + +let n_int = Array.length + +(* Create a zero bit list *) +let zero n_int = + Array.make (N_int_number.to_int n_int) 0L (* String representation *) let to_string b = - let rec do_work accu = function - | [] -> accu - | head :: tail -> - let new_accu = (Bit.to_string head) ^ accu - in do_work new_accu tail + let int64_to_string x = + String.init 64 (fun i -> + if Int64.logand x @@ Int64.shift_left 1L i <> 0L then + '+' + else + '-') in - do_work "" b + Array.map int64_to_string b + |> Array.to_list + |> String.concat "" let of_string ?(zero='0') ?(one='1') s = - List.init (String.length s) (String.get s) - |> List.rev_map ( fun c -> - if (c = zero) then Bit.Zero - else if (c = one) then Bit.One - else (failwith ("Error in bitstring ") ) ) + let n_int = ( (String.length s - 1) lsr 6 ) + 1 in + let result = Array.make n_int 0L in + String.iteri (fun i c -> + if c = one then + begin + let iint = i lsr 6 in (* i / 64 *) + let k = i - (iint lsl 6) in + result.(iint) <- Int64.logor result.(iint) @@ Int64.shift_left 1L k; + end) s; + result -let of_string_mp s = - List.init (String.length s) (String.get s) - |> List.rev_map (function - | '-' -> Bit.Zero - | '+' -> Bit.One - | _ -> failwith ("Error in bitstring ") ) +let of_string_mp = of_string ~zero:'-' ~one:'+' (* Create a bit list from an int64 *) -let of_int64 i = - - let rec do_work accu = function - | 0L -> Bit.Zero :: accu |> List.rev - | 1L -> Bit.One :: accu |> List.rev - | i -> - let b = - match (Int64.logand i 1L ) with - | 0L -> Bit.Zero - | 1L -> Bit.One - | _ -> raise (Failure "i land 1 not in (0,1)") - in - do_work (b :: accu) (Int64.shift_right_logical i 1) - in - - let adjust_length result = - let rec do_work accu = function - | 64 -> List.rev accu - | i when i>64 -> raise (Failure "Error in of_int64 > 64") - | i when i<0 -> raise (Failure "Error in of_int64 < 0") - | i -> do_work (Bit.Zero :: accu) (i+1) - in - do_work (List.rev result) (List.length result) - in - adjust_length (do_work [] i) - +let of_int64 i = [| i |] (* Create an int64 from a bit list *) -let to_int64 l = - assert ( (List.length l) <= 64) ; - let rec do_work accu = function - | [] -> accu - | Bit.Zero::tail -> do_work Int64.(shift_left accu 1) tail - | Bit.One::tail -> do_work Int64.(logor one (shift_left accu 1)) tail - in do_work Int64.zero (List.rev l) +let to_int64 = function + | [| i |] -> i + | _ -> failwith "N_int > 1" -(* Create a bit list from a list of int64 *) -let of_int64_list l = - List.map of_int64 l - |> List.concat - (* Create a bit list from an array of int64 *) -let of_int64_array l = - Array.map of_int64 l - |> Array.to_list - |> List.concat +external of_int64_array : int64 array -> t = "%identity" +external to_int64_array : t -> int64 array = "%identity" + + +(* Create a bit list from a list of int64 *) +let of_int64_list l = + Array.of_list l |> of_int64_array (* Compute n_int *) @@ -91,101 +70,64 @@ let n_int_of_mo_num mo_num = N_int_number.of_int ( (mo_num-1)/bit_kind_size + 1 ) -(* Create a zero bit list *) -let zero n_int = - let n_int = N_int_number.to_int n_int in - let a = Array.init n_int (fun i-> 0L) in - of_int64_list ( Array.to_list a ) - (* Create an int64 list from a bit list *) let to_int64_list l = - let rec do_work accu buf counter = function - | [] -> - begin - match buf with - | [] -> accu - | _ -> (List.rev buf)::accu - end - | i::tail -> - if (counter < 64) then - do_work accu (i::buf) (counter+1) tail - else - do_work ( (List.rev (i::buf))::accu) [] 1 tail - in - let l = do_work [] [] 1 l - in - List.rev_map to_int64 l + to_int64_array l |> Array.to_list -(* Create an array of int64 from a bit list *) -let to_int64_array l = - to_int64_list l - |> Array.of_list (* Create a bit list from a list of MO indices *) let of_mo_number_list n_int l = - let n_int = N_int_number.to_int n_int in - let length = n_int*64 in - let a = Array.make length (Bit.Zero) in - List.iter (fun i-> a.((MO_number.to_int i)-1) <- Bit.One) l; - Array.to_list a + let result = zero n_int in + List.iter (fun j -> + let i = (MO_number.to_int j) - 1 in + let iint = i lsr 6 in (* i / 64 *) + let k = i - (iint lsl 6) in + result.(iint) <- Int64.logor result.(iint) @@ Int64.shift_left 1L k; + ) l; + result let to_mo_number_list l = - let a = Array.of_list l in - let mo_num = MO_number.get_max () in - let rec do_work accu = function - | 0 -> accu - | i -> - begin - let new_accu = - match a.(i-1) with - | Bit.One -> (MO_number.of_int ~max:mo_num i)::accu - | Bit.Zero -> accu - in - do_work new_accu (i-1) - end + let rec aux_one x shift accu = function + | -1 -> accu + | i -> if Int64.logand x (Int64.shift_left 1L i) <> 0L then + aux_one x shift ( (i+shift) ::accu) (i-1) + else + aux_one x shift accu (i-1) in - do_work [] (List.length l) - + Array.mapi (fun i x -> + let shift = (i lsr 6) lsl 6 + 1 in + aux_one x shift [] 63 + ) l + |> Array.to_list + |> List.concat + |> List.map MO_number.of_int (* logical operations on bit_list *) -let logical_operator2 op a b = - let rec do_work_binary result a b = - match a, b with - | [], [] -> result - | [], _ | _ , [] -> raise (Failure "Lists should have same length") - | (ha::ta), (hb::tb) -> - let newbit = op ha hb - in do_work_binary (newbit::result) ta tb +let and_operator a b = Array.map2 Int64.logand a b +let xor_operator a b = Array.map2 Int64.logxor a b +let or_operator a b = Array.map2 Int64.logor a b +let not_operator b = Array.map Int64.lognot b + + + +let pop_sign = + let mask = + (Int64.pred (Int64.shift_left 1L 63)) in - List.rev (do_work_binary [] a b) - - -let logical_operator1 op b = - let rec do_work_unary result b = - match b with - | [] -> result - | (hb::tb) -> - let newbit = op hb - in do_work_unary (newbit::result) tb - in - List.rev (do_work_unary [] b) - - -let and_operator a b = logical_operator2 Bit.and_operator a b -let xor_operator a b = logical_operator2 Bit.xor_operator a b -let or_operator a b = logical_operator2 Bit.or_operator a b -let not_operator b = logical_operator1 Bit.not_operator b + fun x -> Int64.logand mask x let popcnt b = - List.fold_left (fun accu -> function - | Bit.One -> accu+1 - | Bit.Zero -> accu - ) 0 b + Array.fold_left (fun accu x -> + if x >= 0L then + accu + (Z.popcount @@ Z.of_int64 x) + else + accu + 1 + (Z.popcount @@ Z.of_int64 (pop_sign x)) + ) 0 b diff --git a/ocaml/Bitlist.mli b/ocaml/Bitlist.mli index 1f230f08..8d421c7f 100644 --- a/ocaml/Bitlist.mli +++ b/ocaml/Bitlist.mli @@ -1,4 +1,4 @@ -type t = Bit.t list +type t (** The zero bit list *) val zero : Qptypes.N_int_number.t -> t diff --git a/ocaml/Determinant.ml b/ocaml/Determinant.ml index 6f248470..0a18a4c6 100644 --- a/ocaml/Determinant.ml +++ b/ocaml/Determinant.ml @@ -25,19 +25,6 @@ let to_bitlist_couple x = in (xa,xb) -let bitlist_to_string ~mo_num x = - let len = - MO_number.to_int mo_num - in - let s = - List.map (function - | Bit.Zero -> "-" - | Bit.One -> "+" - ) x - |> String.concat "" - in - String.sub s 0 len - let of_int64_array ~n_int ~alpha ~beta x = @@ -48,37 +35,29 @@ let of_int64_array ~n_int ~alpha ~beta x = in if ( (Bitlist.popcnt a) <> alpha) then begin - let mo_num = MO_number.get_max () in - let mo_num = MO_number.of_int mo_num ~max:mo_num in failwith (Printf.sprintf "Expected %d electrons in alpha determinant -%s" alpha (bitlist_to_string ~mo_num:mo_num a) ) +%s" alpha (Bitlist.to_string a) ) end; if ( (Bitlist.popcnt b) <> beta ) then begin - let mo_num = MO_number.get_max () in - let mo_num = MO_number.of_int mo_num ~max:mo_num in failwith (Printf.sprintf "Expected %d electrons in beta determinant -%s" beta (bitlist_to_string ~mo_num:mo_num b) ) +%s" beta (Bitlist.to_string b) ) end; x -let of_bitlist_couple ?n_int ~alpha ~beta (xa,xb) = +let of_bitlist_couple ~n_int ~alpha ~beta (xa,xb) = let ba, bb = Bitlist.to_int64_array xa , Bitlist.to_int64_array xb - and n_int = - match n_int with - | Some x -> x - | None -> Bitlist.n_int_of_mo_num (List.length xa) in of_int64_array ~n_int ~alpha ~beta (Array.concat [ba;bb]) let to_string ~mo_num x = let (xa,xb) = to_bitlist_couple x in - [ " " ; bitlist_to_string ~mo_num xa ; "\n" ; - " " ; bitlist_to_string ~mo_num xb ] + [ " " ; Bitlist.to_string xa ; "\n" ; + " " ; Bitlist.to_string xb ] |> String.concat "" diff --git a/ocaml/Determinant.mli b/ocaml/Determinant.mli index 49ba1057..73f91dc7 100644 --- a/ocaml/Determinant.mli +++ b/ocaml/Determinant.mli @@ -24,7 +24,7 @@ val to_alpha_beta : t -> (int64 array)*(int64 array) val to_bitlist_couple : t -> Bitlist.t * Bitlist.t (** Create from a bit list *) -val of_bitlist_couple : ?n_int:Qptypes.N_int_number.t -> +val of_bitlist_couple : n_int:Qptypes.N_int_number.t -> alpha:Qptypes.Elec_alpha_number.t -> beta:Qptypes.Elec_beta_number.t -> Bitlist.t * Bitlist.t -> t diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index a676cf76..e074d615 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -472,6 +472,7 @@ psi_det = %s (* Handle determinants *) let psi_det = + let n_int = N_int_number.of_int @@ (MO_number.get_max () - 1) / 64 + 1 in let n_alpha = Ezfio.get_electrons_elec_alpha_num () |> Elec_alpha_number.of_int and n_beta = Ezfio.get_electrons_elec_beta_num () @@ -483,8 +484,8 @@ psi_det = %s begin let newdet = (Bitlist.of_string ~zero:'-' ~one:'+' alpha , - Bitlist.of_string ~zero:'-' ~one:'+' beta) - |> Determinant.of_bitlist_couple ~alpha:n_alpha ~beta:n_beta + Bitlist.of_string ~zero:'-' ~one:'+' beta) + |> Determinant.of_bitlist_couple ~n_int ~alpha:n_alpha ~beta:n_beta |> Determinant.sexp_of_t |> Sexplib.Sexp.to_string in @@ -492,9 +493,11 @@ psi_det = %s end | _::tail -> read_dets accu tail in + (* let dets = List.map String_ext.rev dets in + *) let a = read_dets [] dets |> String.concat "" diff --git a/ocaml/_tags b/ocaml/_tags index 8c354c8b..55b1c681 100644 --- a/ocaml/_tags +++ b/ocaml/_tags @@ -1,4 +1,4 @@ -true: package(cryptokit,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt) +true: package(cryptokit,zarith,zmq,str,sexplib,ppx_sexp_conv,ppx_deriving,getopt) true: thread false: profile <*byte> : linkdep(c_bindings.o), custom diff --git a/ocaml/qp_set_mo_class.ml b/ocaml/qp_set_mo_class.ml index e806082c..942e2cc2 100644 --- a/ocaml/qp_set_mo_class.ml +++ b/ocaml/qp_set_mo_class.ml @@ -112,9 +112,9 @@ let set ~core ~inact ~act ~virt ~del = and av = Excitation.create_single act virt in let single_excitations = [ ia ; aa ; av ] - |> List.map (fun x -> + |> List.map (fun z -> let open Excitation in - match x with + match z 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) ) @@ -187,9 +187,10 @@ 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 + Bitlist.to_int64_list + ( MO_class.to_bitlist n_int ( Hole.to_mo_class x) ) @ + Bitlist.to_int64_list + ( MO_class.to_bitlist n_int (Particle.to_mo_class y) ) 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 diff --git a/src/cipsi/run_selection_slave.irp.f b/src/cipsi/run_selection_slave.irp.f index ac889794..70ad543f 100644 --- a/src/cipsi/run_selection_slave.irp.f +++ b/src/cipsi/run_selection_slave.irp.f @@ -85,7 +85,7 @@ subroutine run_selection_slave(thread,iproc,energy) if(ctask > 0) then call sort_selection_buffer(buf) ! call merge_selection_buffers(buf,buf2) -print *, task_id(1), pt2(1), buf%cur, ctask +!print *, task_id(1), pt2(1), buf%cur, ctask call push_selection_results(zmq_socket_push, pt2, variance, norm, buf, task_id(1), ctask) ! buf%mini = buf2%mini pt2(:) = 0d0 diff --git a/src/fci/40.fci.bats b/src/fci/40.fci.bats index f3b7db2c..812cd3d4 100644 --- a/src/fci/40.fci.bats +++ b/src/fci/40.fci.bats @@ -36,24 +36,24 @@ function run_stoch() { [[ -n $TRAVIS ]] && skip qp set_file f2.ezfio qp set_frozen_core - run_stoch -199.30496 1.e-4 + run_stoch -199.30486 1.e-4 } @test "NH3" { # 10.6657s qp set_file nh3.ezfio qp set_mo_class --core="[1-4]" --act="[5-72]" - run -56.244753429144986 1.e-5 + run -56.244753429144986 1.e-4 } @test "DHNO" { # 11.4721s qp set_file dhno.ezfio qp set_mo_class --core="[1-7]" --act="[8-64]" - run -130.459020029816 1.e-5 + run -130.459020029816 1.e-4 } @test "HCO" { # 12.2868s qp set_file hco.ezfio - run -113.297494345682 2.e-05 + run -113.297494345682 1.e-4 } @test "H2O2" { # 12.9214s @@ -65,82 +65,82 @@ function run_stoch() { @test "HBO" { # 13.3144s [[ -n $TRAVIS ]] && skip qp set_file hbo.ezfio - run -100.214185815312 1.e-5 + run -100.212829869715 1.e-4 } @test "H2O" { # 11.3727s [[ -n $TRAVIS ]] && skip qp set_file h2o.ezfio - run -76.2359268957699 2.e-5 + run -76.2359268957699 1.e-4 } @test "ClO" { # 13.3755s [[ -n $TRAVIS ]] && skip qp set_file clo.ezfio - run -534.546005867797 5.e-5 + run -534.545881614967 1.e-4 } @test "SO" { # 13.4952s [[ -n $TRAVIS ]] && skip qp set_file so.ezfio - run -26.0124797722154 1.e-5 + run -26.0158153138924 1.e-4 } @test "H2S" { # 13.6745s [[ -n $TRAVIS ]] && skip qp set_file h2s.ezfio - run -398.859480581924 1.e-5 + run -398.859168655255 1.e-4 } @test "OH" { # 13.865s [[ -n $TRAVIS ]] && skip qp set_file oh.ezfio - run -75.6119887538831 1.e-05 + run -75.6120779012574 1.e-4 } @test "SiH2_3B1" { # 13.938ss [[ -n $TRAVIS ]] && skip qp set_file sih2_3b1.ezfio - run -290.017539006762 1.e-5 + run -290.017539006762 1.e-4 } @test "H3COH" { # 14.7299s [[ -n $TRAVIS ]] && skip qp set_file h3coh.ezfio - run -115.205054063687 1.e-5 + run -115.205941463667 1.e-4 } @test "SiH3" { # 15.99s [[ -n $TRAVIS ]] && skip qp set_file sih3.ezfio - run -5.57269434557089 2.e-05 + run -5.57241217753818 1.e-4 } @test "CH4" { # 16.1612s [[ -n $TRAVIS ]] && skip qp set_file ch4.ezfio qp set_mo_class --core="[1]" --act="[2-30]" --del="[31-59]" - run -40.2409059687324 2.e-5 + run -40.2409678239136 1.e-4 } @test "ClF" { # 16.8864s [[ -n $TRAVIS ]] && skip qp set_file clf.ezfio - run -559.170406471496 1.e-5 + run -559.170272077166 1.e-4 } @test "SO2" { # 17.5645s [[ -n $TRAVIS ]] && skip qp set_file so2.ezfio qp set_mo_class --core="[1-8]" --act="[9-87]" - run -41.5746738713298 5.e-5 + run -41.5746738713298 1.e-4 } @test "C2H2" { # 17.6827s [[ -n $TRAVIS ]] && skip qp set_file c2h2.ezfio qp set_mo_class --act="[1-30]" --del="[31-36]" - run -12.3670840202635 2.e-5 + run -12.3656179738175 1.e-4 } @test "N2" { # 18.0198s @@ -154,14 +154,14 @@ function run_stoch() { [[ -n $TRAVIS ]] && skip qp set_file n2h4.ezfio qp set_mo_class --core="[1-2]" --act="[3-24]" --del="[25-48]" - run -111.367234092521 2.e-5 + run -111.367332681559 1.e-4 } @test "CO2" { # 21.1748s [[ -n $TRAVIS ]] && skip qp set_file co2.ezfio qp set_mo_class --core="[1,2]" --act="[3-30]" --del="[31-42]" - run -187.969676381867 1.e-5 + run -187.968599504402 1.e-4 } @@ -169,13 +169,13 @@ function run_stoch() { [[ -n $TRAVIS ]] && skip qp set_file cu_nh3_4_2plus.ezfio qp set_mo_class --core="[1-24]" --act="[25-45]" --del="[46-87]" - run -1862.98610987882 1.e-05 + run -1862.98614665139 1.e-04 } @test "HCN" { # 20.3273s [[ -n $TRAVIS ]] && skip qp set_file hcn.ezfio qp set_mo_class --core="[1,2]" --act="[3-40]" --del="[41-55]" - run -93.0799328685679 2.e-5 + run -93.0728641601823 1.e-4 }