mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 20:23:40 +02:00
Add print_ci_vector in tools (#11)
* Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver
This commit is contained in:
parent
ca4f8ebdca
commit
347e918a4a
@ -1,8 +1,5 @@
|
|||||||
open Core
|
|
||||||
open Qptypes
|
open Qptypes
|
||||||
|
|
||||||
module StringHashtbl = Hashtbl.Make(String)
|
|
||||||
|
|
||||||
type pub_state =
|
type pub_state =
|
||||||
| Waiting
|
| Waiting
|
||||||
| Running of string
|
| Running of string
|
||||||
@ -29,15 +26,15 @@ type t =
|
|||||||
progress_bar : Progress_bar.t option ;
|
progress_bar : Progress_bar.t option ;
|
||||||
running : bool;
|
running : bool;
|
||||||
accepting_clients : bool;
|
accepting_clients : bool;
|
||||||
data : string StringHashtbl.t;
|
data : (string, string) Hashtbl.t;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let debug_env =
|
let debug_env =
|
||||||
match Sys.getenv "QP_TASK_DEBUG" with
|
try
|
||||||
| Some x -> x <> ""
|
Sys.getenv "QP_TASK_DEBUG"; true
|
||||||
| None -> false
|
with Not_found -> false
|
||||||
|
|
||||||
|
|
||||||
let debug str =
|
let debug str =
|
||||||
@ -64,7 +61,7 @@ let bind_socket ~socket_type ~socket ~port =
|
|||||||
Zmq.Socket.bind socket @@ Printf.sprintf "tcp://*:%d" port;
|
Zmq.Socket.bind socket @@ Printf.sprintf "tcp://*:%d" port;
|
||||||
loop (-1)
|
loop (-1)
|
||||||
with
|
with
|
||||||
| Unix.Unix_error _ -> (Time.pause @@ Time.Span.of_sec 1. ; loop (i-1) )
|
| Unix.Unix_error _ -> (Unix.sleep 1 ; loop (i-1) )
|
||||||
| other_exception -> raise other_exception
|
| other_exception -> raise other_exception
|
||||||
in loop 60
|
in loop 60
|
||||||
|
|
||||||
@ -77,28 +74,34 @@ let hostname = lazy (
|
|||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
external get_ipv4_address_for_interface : string -> string =
|
||||||
|
"get_ipv4_address_for_interface" ;;
|
||||||
|
|
||||||
let ip_address = lazy (
|
let ip_address = lazy (
|
||||||
match Sys.getenv "QP_NIC" with
|
let interface =
|
||||||
|
try Some (Sys.getenv "QP_NIC")
|
||||||
|
with Not_found -> None
|
||||||
|
in
|
||||||
|
match interface with
|
||||||
| None ->
|
| None ->
|
||||||
begin
|
begin
|
||||||
try
|
try
|
||||||
|
let host =
|
||||||
Lazy.force hostname
|
Lazy.force hostname
|
||||||
|> Unix.Inet_addr.of_string_or_getbyname
|
|> Unix.gethostbyname
|
||||||
|> Unix.Inet_addr.to_string
|
in
|
||||||
|
Unix.string_of_inet_addr host.h_addr_list.(0);
|
||||||
with
|
with
|
||||||
| Unix.Unix_error _ ->
|
| Unix.Unix_error _ ->
|
||||||
failwith "Unable to find IP address from host name."
|
failwith "Unable to find IP address from host name."
|
||||||
end
|
end
|
||||||
| Some interface ->
|
| Some interface ->
|
||||||
begin
|
let result = get_ipv4_address_for_interface interface in
|
||||||
try
|
if String.sub result 0 5 = "error" then
|
||||||
ok_exn Linux_ext.get_ipv4_address_for_interface interface
|
Printf.sprintf "Unable to use network interface %s" interface
|
||||||
with
|
|> failwith
|
||||||
| Unix.Unix_error _ ->
|
else
|
||||||
Lazy.force hostname
|
result
|
||||||
|> Unix.Inet_addr.of_string_or_getbyname
|
|
||||||
|> Unix.Inet_addr.to_string
|
|
||||||
end
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
@ -209,7 +212,7 @@ let end_job msg program_state rep_socket pair_socket =
|
|||||||
address_inproc = None;
|
address_inproc = None;
|
||||||
running = true;
|
running = true;
|
||||||
accepting_clients = false;
|
accepting_clients = false;
|
||||||
data = StringHashtbl.create ();
|
data = Hashtbl.create 23;
|
||||||
}
|
}
|
||||||
|
|
||||||
and wait n =
|
and wait n =
|
||||||
@ -335,8 +338,10 @@ let del_task msg program_state rep_socket =
|
|||||||
and success () =
|
and success () =
|
||||||
|
|
||||||
let queue =
|
let queue =
|
||||||
List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
List.fold_left
|
||||||
~init:program_state.queue task_ids
|
(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
||||||
|
program_state.queue
|
||||||
|
task_ids
|
||||||
in
|
in
|
||||||
let accepting_clients =
|
let accepting_clients =
|
||||||
(Queuing_system.number_of_queued queue > Queuing_system.number_of_clients queue)
|
(Queuing_system.number_of_queued queue > Queuing_system.number_of_clients queue)
|
||||||
@ -383,10 +388,11 @@ let add_task msg program_state rep_socket =
|
|||||||
|
|
||||||
let result =
|
let result =
|
||||||
let new_queue, new_bar =
|
let new_queue, new_bar =
|
||||||
List.fold ~f:(fun (queue, bar) task ->
|
List.fold_left (fun (queue, bar) task ->
|
||||||
Queuing_system.add_task ~task queue,
|
Queuing_system.add_task ~task queue,
|
||||||
increment_progress_bar bar)
|
increment_progress_bar bar)
|
||||||
~init:(program_state.queue, program_state.progress_bar) tasks
|
(program_state.queue, program_state.progress_bar)
|
||||||
|
tasks
|
||||||
in
|
in
|
||||||
{ program_state with
|
{ program_state with
|
||||||
queue = new_queue;
|
queue = new_queue;
|
||||||
@ -547,10 +553,11 @@ let task_done msg program_state rep_socket =
|
|||||||
|
|
||||||
and success () =
|
and success () =
|
||||||
let new_queue, new_bar =
|
let new_queue, new_bar =
|
||||||
List.fold ~f:(fun (queue, bar) task_id ->
|
List.fold_left (fun (queue, bar) task_id ->
|
||||||
Queuing_system.end_task ~task_id ~client_id queue,
|
Queuing_system.end_task ~task_id ~client_id queue,
|
||||||
increment_progress_bar bar)
|
increment_progress_bar bar)
|
||||||
~init:(program_state.queue, program_state.progress_bar) task_ids
|
(program_state.queue, program_state.progress_bar)
|
||||||
|
task_ids
|
||||||
in
|
in
|
||||||
|
|
||||||
let accepting_clients =
|
let accepting_clients =
|
||||||
@ -593,7 +600,7 @@ let put_data msg rest_of_msg program_state rep_socket =
|
|||||||
in
|
in
|
||||||
|
|
||||||
let success () =
|
let success () =
|
||||||
StringHashtbl.set program_state.data ~key ~data:value ;
|
Hashtbl.add program_state.data key value ;
|
||||||
Message.PutDataReply (Message.PutDataReply_msg.create ())
|
Message.PutDataReply (Message.PutDataReply_msg.create ())
|
||||||
|> Message.to_string
|
|> Message.to_string
|
||||||
|> Zmq.Socket.send rep_socket;
|
|> Zmq.Socket.send rep_socket;
|
||||||
@ -623,9 +630,8 @@ let get_data msg program_state rep_socket =
|
|||||||
|
|
||||||
let success () =
|
let success () =
|
||||||
let value =
|
let value =
|
||||||
match StringHashtbl.find program_state.data key with
|
try Hashtbl.find program_state.data key with
|
||||||
| Some value -> value
|
| Not_found -> "\000"
|
||||||
| None -> "\000"
|
|
||||||
in
|
in
|
||||||
Message.GetDataReply (Message.GetDataReply_msg.create ~value)
|
Message.GetDataReply (Message.GetDataReply_msg.create ~value)
|
||||||
|> Message.to_string_list
|
|> Message.to_string_list
|
||||||
@ -677,13 +683,16 @@ let abort program_state rep_socket =
|
|||||||
aux [] queue 1
|
aux [] queue 1
|
||||||
in
|
in
|
||||||
let queue =
|
let queue =
|
||||||
List.fold ~f:(fun queue task_id ->
|
List.fold_left
|
||||||
Queuing_system.end_task ~task_id ~client_id queue)
|
(fun queue task_id -> Queuing_system.end_task ~task_id ~client_id queue)
|
||||||
~init:queue tasks
|
queue
|
||||||
|
tasks
|
||||||
in
|
in
|
||||||
let queue =
|
let queue =
|
||||||
List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
List.fold_left
|
||||||
~init:queue tasks
|
(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
||||||
|
queue
|
||||||
|
tasks
|
||||||
in
|
in
|
||||||
let queue =
|
let queue =
|
||||||
Queuing_system.del_client ~client_id queue
|
Queuing_system.del_client ~client_id queue
|
||||||
@ -777,7 +786,7 @@ let run ~port =
|
|||||||
address_inproc = None;
|
address_inproc = None;
|
||||||
progress_bar = None ;
|
progress_bar = None ;
|
||||||
accepting_clients = false;
|
accepting_clients = false;
|
||||||
data = StringHashtbl.create ();
|
data = Hashtbl.create 23;
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@ type t =
|
|||||||
progress_bar : Progress_bar.t option ;
|
progress_bar : Progress_bar.t option ;
|
||||||
running : bool;
|
running : bool;
|
||||||
accepting_clients : bool;
|
accepting_clients : bool;
|
||||||
data : (string, string) Core.Hashtbl.t ;
|
data : (string, string) Hashtbl.t ;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,3 +1,6 @@
|
|||||||
true: package(core,cryptokit,zmq,str,ppx_sexp_conv,ppx_deriving,getopt)
|
true: package(core,cryptokit,zmq,str,ppx_sexp_conv,ppx_deriving,getopt)
|
||||||
true: thread
|
true: thread
|
||||||
false: profile
|
false: profile
|
||||||
|
<*byte> : linkdep(c_bindings.o), custom
|
||||||
|
<*.native>: linkdep(c_bindings.o)
|
||||||
|
|
||||||
|
69
ocaml/c_bindings.c
Normal file
69
ocaml/c_bindings.c
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
#include <caml/mlvalues.h>
|
||||||
|
#include <caml/memory.h>
|
||||||
|
#include <caml/alloc.h>
|
||||||
|
#include <caml/custom.h>
|
||||||
|
#include <caml/threads.h>
|
||||||
|
|
||||||
|
#include <string.h>
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* Adapted from
|
||||||
|
https://github.com/monadbobo/ocaml-core/blob/master/base/core/lib/linux_ext_stubs.c
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include <unistd.h>
|
||||||
|
#include <sys/ioctl.h>
|
||||||
|
#include <net/if.h>
|
||||||
|
#include <sys/socket.h>
|
||||||
|
#include <netinet/in.h>
|
||||||
|
#include <arpa/inet.h>
|
||||||
|
|
||||||
|
CAMLprim value get_ipv4_address_for_interface(value v_interface)
|
||||||
|
{
|
||||||
|
CAMLparam1(v_interface);
|
||||||
|
struct ifreq ifr;
|
||||||
|
int fd = -1;
|
||||||
|
value res;
|
||||||
|
char* error = NULL;
|
||||||
|
|
||||||
|
memset(&ifr, 0, sizeof(ifr));
|
||||||
|
ifr.ifr_addr.sa_family = AF_INET;
|
||||||
|
/* [ifr] is already initialized to zero, so it doesn't matter if the
|
||||||
|
incoming string is too long, and [strncpy] fails to add a \0. */
|
||||||
|
strncpy(ifr.ifr_name, String_val(v_interface), IFNAMSIZ - 1);
|
||||||
|
|
||||||
|
caml_enter_blocking_section();
|
||||||
|
fd = socket(AF_INET, SOCK_DGRAM, 0);
|
||||||
|
|
||||||
|
if (fd == -1)
|
||||||
|
error = "error: couldn't allocate socket";
|
||||||
|
else {
|
||||||
|
if (ioctl(fd, SIOCGIFADDR, &ifr) < 0)
|
||||||
|
error = "error: ioctl(fd, SIOCGIFADDR, ...) failed";
|
||||||
|
|
||||||
|
(void) close(fd);
|
||||||
|
}
|
||||||
|
|
||||||
|
caml_leave_blocking_section();
|
||||||
|
|
||||||
|
if (error == NULL) {
|
||||||
|
/* This is weird but doing the usual casting causes errors when using
|
||||||
|
* the new gcc on CentOS 6. This solution was picked up on Red Hat's
|
||||||
|
* bugzilla or something. It also works to memcpy a sockaddr into
|
||||||
|
* a sockaddr_in. This is faster hopefully.
|
||||||
|
*/
|
||||||
|
union {
|
||||||
|
struct sockaddr sa;
|
||||||
|
struct sockaddr_in sain;
|
||||||
|
} u;
|
||||||
|
u.sa = ifr.ifr_addr;
|
||||||
|
res = caml_copy_string(inet_ntoa(u.sain.sin_addr));
|
||||||
|
}
|
||||||
|
else
|
||||||
|
res = caml_copy_string(error);
|
||||||
|
CAMLreturn(res);
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
|
@ -7,6 +7,7 @@ dispatch begin function
|
|||||||
| After_rules ->
|
| After_rules ->
|
||||||
begin
|
begin
|
||||||
flag ["ocaml";"compile";"native";"gprof"] (S [ A "-p"]);
|
flag ["ocaml";"compile";"native";"gprof"] (S [ A "-p"]);
|
||||||
|
pdep ["link"] "linkdep" (fun param -> [param]);
|
||||||
end
|
end
|
||||||
| _ -> ()
|
| _ -> ()
|
||||||
end
|
end
|
||||||
|
@ -1,11 +1,10 @@
|
|||||||
open Core
|
|
||||||
open Qptypes
|
open Qptypes
|
||||||
|
|
||||||
let basis () =
|
let basis () =
|
||||||
let ezfio_filename =
|
let ezfio_filename =
|
||||||
Sys.argv.(1)
|
Sys.argv.(1)
|
||||||
in
|
in
|
||||||
if (not (Sys.file_exists_exn ezfio_filename)) then
|
if (not (Sys.file_exists ezfio_filename)) then
|
||||||
failwith "Error reading EZFIO file";
|
failwith "Error reading EZFIO file";
|
||||||
Ezfio.set_file ezfio_filename;
|
Ezfio.set_file ezfio_filename;
|
||||||
let basis =
|
let basis =
|
||||||
@ -22,7 +21,7 @@ let mo () =
|
|||||||
let ezfio_filename =
|
let ezfio_filename =
|
||||||
Sys.argv.(1)
|
Sys.argv.(1)
|
||||||
in
|
in
|
||||||
if (not (Sys.file_exists_exn ezfio_filename)) then
|
if (not (Sys.file_exists ezfio_filename)) then
|
||||||
failwith "Error reading EZFIO file";
|
failwith "Error reading EZFIO file";
|
||||||
Ezfio.set_file ezfio_filename;
|
Ezfio.set_file ezfio_filename;
|
||||||
let mo_coef =
|
let mo_coef =
|
||||||
@ -39,7 +38,7 @@ let psi_det () =
|
|||||||
let ezfio_filename =
|
let ezfio_filename =
|
||||||
Sys.argv.(1)
|
Sys.argv.(1)
|
||||||
in
|
in
|
||||||
if (not (Sys.file_exists_exn ezfio_filename)) then
|
if (not (Sys.file_exists ezfio_filename)) then
|
||||||
failwith "Error reading EZFIO file";
|
failwith "Error reading EZFIO file";
|
||||||
Ezfio.set_file ezfio_filename;
|
Ezfio.set_file ezfio_filename;
|
||||||
let psi_det =
|
let psi_det =
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
open Qputils
|
open Qputils
|
||||||
open Qptypes
|
open Qptypes
|
||||||
open Core
|
|
||||||
|
|
||||||
(*
|
(*
|
||||||
* Command-line arguments
|
* Command-line arguments
|
||||||
@ -46,7 +45,7 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
|
|
||||||
|
|
||||||
let mo_class =
|
let mo_class =
|
||||||
Array.init mo_num ~f:(fun i -> None)
|
Array.init mo_num (fun i -> None)
|
||||||
in
|
in
|
||||||
|
|
||||||
(* Check input data *)
|
(* Check input data *)
|
||||||
@ -113,7 +112,8 @@ 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 (fun x ->
|
||||||
|
let open Excitation in
|
||||||
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),
|
||||||
@ -128,7 +128,8 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
Excitation.double_of_singles aa aa ;
|
Excitation.double_of_singles aa aa ;
|
||||||
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 (fun x ->
|
||||||
|
let open Excitation in
|
||||||
match x with
|
match x with
|
||||||
| Single _ -> assert false
|
| Single _ -> assert false
|
||||||
| Double (x,y,z,t) ->
|
| Double (x,y,z,t) ->
|
||||||
@ -146,19 +147,20 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
and extract_hole2 (_,_,h,_) = h
|
and extract_hole2 (_,_,h,_) = h
|
||||||
and extract_particle2 (_,_,_,p) = p
|
and extract_particle2 (_,_,_,p) = p
|
||||||
in
|
in
|
||||||
|
let init = Bitlist.zero n_int in
|
||||||
let result = [
|
let result = [
|
||||||
List.map ~f:extract_hole single_excitations
|
List.map extract_hole single_excitations
|
||||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
|> List.fold_left Bitlist.or_operator init;
|
||||||
List.map ~f:extract_particle single_excitations
|
List.map extract_particle single_excitations
|
||||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
|> List.fold_left Bitlist.or_operator init;
|
||||||
List.map ~f:extract_hole1 double_excitations
|
List.map extract_hole1 double_excitations
|
||||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
|> List.fold_left Bitlist.or_operator init;
|
||||||
List.map ~f:extract_particle1 double_excitations
|
List.map extract_particle1 double_excitations
|
||||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
|> List.fold_left Bitlist.or_operator init;
|
||||||
List.map ~f:extract_hole2 double_excitations
|
List.map extract_hole2 double_excitations
|
||||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
|> List.fold_left Bitlist.or_operator init;
|
||||||
List.map ~f:extract_particle2 double_excitations
|
List.map extract_particle2 double_excitations
|
||||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
|> List.fold_left Bitlist.or_operator init;
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
|
|
||||||
@ -167,7 +169,8 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
*)
|
*)
|
||||||
|
|
||||||
(* Write masks *)
|
(* Write masks *)
|
||||||
let result = List.map ~f:(fun x ->
|
let result =
|
||||||
|
List.map (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
|
||||||
@ -194,7 +197,7 @@ let set ~core ~inact ~act ~virt ~del =
|
|||||||
|
|
||||||
let data =
|
let data =
|
||||||
Array.to_list mo_class
|
Array.to_list mo_class
|
||||||
|> List.map ~f:(fun x -> match x with
|
|> List.map (fun x -> match x with
|
||||||
|None -> assert false
|
|None -> assert false
|
||||||
| Some x -> MO_class.to_string x
|
| Some x -> MO_class.to_string x
|
||||||
)
|
)
|
||||||
@ -276,42 +279,6 @@ let run ~q ?(core="[]") ?(inact="[]") ?(act="[]") ?(virt="[]") ?(del="[]") ezfio
|
|||||||
set ~core ~inact ~act ~virt ~del
|
set ~core ~inact ~act ~virt ~del
|
||||||
|
|
||||||
|
|
||||||
let ezfio_file =
|
|
||||||
let failure filename =
|
|
||||||
eprintf "'%s' is not an EZFIO file.\n%!" filename;
|
|
||||||
exit 1
|
|
||||||
in
|
|
||||||
Command.Spec.Arg_type.create
|
|
||||||
(fun filename ->
|
|
||||||
match Sys.is_directory filename with
|
|
||||||
| `Yes ->
|
|
||||||
begin
|
|
||||||
match Sys.is_file (filename ^ "/.version") with
|
|
||||||
| `Yes -> filename
|
|
||||||
| _ -> failure filename
|
|
||||||
end
|
|
||||||
| _ -> failure filename
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
let default range =
|
|
||||||
let failure filename =
|
|
||||||
eprintf "'%s' is not a regular file.\n%!" filename;
|
|
||||||
exit 1
|
|
||||||
in
|
|
||||||
Command.Spec.Arg_type.create
|
|
||||||
(fun filename ->
|
|
||||||
match Sys.is_directory filename with
|
|
||||||
| `Yes ->
|
|
||||||
begin
|
|
||||||
match Sys.is_file (filename^"/.version") with
|
|
||||||
| `Yes -> filename
|
|
||||||
| _ -> failure filename
|
|
||||||
end
|
|
||||||
| _ -> failure filename
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let open Command_line in
|
let open Command_line in
|
||||||
|
@ -33,7 +33,7 @@ subroutine get_s2(key_i,key_j,Nint,s2)
|
|||||||
implicit none
|
implicit none
|
||||||
use bitmasks
|
use bitmasks
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Returns <S^2>
|
! Returns $\langle S^2 \rangle - S_z^2 S_z$
|
||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: Nint
|
integer, intent(in) :: Nint
|
||||||
integer(bit_kind), intent(in) :: key_i(Nint,2)
|
integer(bit_kind), intent(in) :: key_i(Nint,2)
|
||||||
|
@ -24,33 +24,33 @@
|
|||||||
|
|
||||||
do j=1,elec_beta_num
|
do j=1,elec_beta_num
|
||||||
! F-K
|
! F-K
|
||||||
do i=1,elec_beta_num
|
do i=1,elec_beta_num !CC
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
- (Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
- (Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F+K/2
|
! F+K/2
|
||||||
do i=elec_beta_num+1,elec_alpha_num
|
do i=elec_beta_num+1,elec_alpha_num !CA
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
+ 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
+ 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F
|
! F
|
||||||
do i=elec_alpha_num+1, mo_num
|
do i=elec_alpha_num+1, mo_num !CV
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do j=elec_beta_num+1,elec_alpha_num
|
do j=elec_beta_num+1,elec_alpha_num
|
||||||
! F+K/2
|
! F+K/2
|
||||||
do i=1,elec_beta_num
|
do i=1,elec_beta_num !AC
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
+ 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
+ 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F
|
! F
|
||||||
do i=elec_beta_num+1,elec_alpha_num
|
do i=elec_beta_num+1,elec_alpha_num !AA
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F-K/2
|
! F-K/2
|
||||||
do i=elec_alpha_num+1, mo_num
|
do i=elec_alpha_num+1, mo_num !AV
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
- 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
- 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
@ -58,16 +58,16 @@
|
|||||||
|
|
||||||
do j=elec_alpha_num+1, mo_num
|
do j=elec_alpha_num+1, mo_num
|
||||||
! F
|
! F
|
||||||
do i=1,elec_beta_num
|
do i=1,elec_beta_num !VC
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F-K/2
|
! F-K/2
|
||||||
do i=elec_beta_num+1,elec_alpha_num
|
do i=elec_beta_num+1,elec_alpha_num !VA
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j))&
|
||||||
- 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
- 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
! F+K
|
! F+K
|
||||||
do i=elec_alpha_num+1,mo_num
|
do i=elec_alpha_num+1,mo_num !VV
|
||||||
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j)) &
|
Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_mo_alpha(i,j)+Fock_matrix_mo_beta(i,j)) &
|
||||||
+ (Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
+ (Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||||
enddo
|
enddo
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
BEGIN_PROVIDER [double precision, SCF_density_matrix_ao_alpha, (ao_num,ao_num) ]
|
BEGIN_PROVIDER [double precision, SCF_density_matrix_ao_alpha, (ao_num,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! S^{-1}.P_alpha.S^{-1}
|
! $C.C^t$ over $\alpha$ MOs
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
call dgemm('N','T',ao_num,ao_num,elec_alpha_num,1.d0, &
|
call dgemm('N','T',ao_num,ao_num,elec_alpha_num,1.d0, &
|
||||||
@ -14,7 +14,7 @@ END_PROVIDER
|
|||||||
BEGIN_PROVIDER [ double precision, SCF_density_matrix_ao_beta, (ao_num,ao_num) ]
|
BEGIN_PROVIDER [ double precision, SCF_density_matrix_ao_beta, (ao_num,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! S^{-1}.P_beta.S^{-1}
|
! $C.C^t$ over $\beta$ MOs
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
call dgemm('N','T',ao_num,ao_num,elec_beta_num,1.d0, &
|
call dgemm('N','T',ao_num,ao_num,elec_beta_num,1.d0, &
|
||||||
@ -27,7 +27,7 @@ END_PROVIDER
|
|||||||
BEGIN_PROVIDER [ double precision, SCF_density_matrix_ao, (ao_num,ao_num) ]
|
BEGIN_PROVIDER [ double precision, SCF_density_matrix_ao, (ao_num,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! S^{-1}.P.S^{-1} where P = C.C^t
|
! Sum of $\alpha$ and $\beta$ density matrices
|
||||||
END_DOC
|
END_DOC
|
||||||
ASSERT (size(SCF_density_matrix_ao,1) == size(SCF_density_matrix_ao_alpha,1))
|
ASSERT (size(SCF_density_matrix_ao,1) == size(SCF_density_matrix_ao_alpha,1))
|
||||||
if (elec_alpha_num== elec_beta_num) then
|
if (elec_alpha_num== elec_beta_num) then
|
||||||
|
35
src/tools/print_ci_vectors.irp.f
Normal file
35
src/tools/print_ci_vectors.irp.f
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
program print_wf
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Print the ground state wave function stored in the |EZFIO| directory
|
||||||
|
! in the intermediate normalization.
|
||||||
|
!
|
||||||
|
! It also prints a lot of information regarding the excitation
|
||||||
|
! operators from the reference determinant ! and a first-order
|
||||||
|
! perturbative analysis of the wave function.
|
||||||
|
!
|
||||||
|
! If the wave function strongly deviates from the first-order analysis,
|
||||||
|
! something funny is going on :)
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
|
||||||
|
! this has to be done in order to be sure that N_det, psi_det and
|
||||||
|
! psi_coef are the wave function stored in the |EZFIO| directory.
|
||||||
|
read_wf = .True.
|
||||||
|
touch read_wf
|
||||||
|
call routine
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine routine
|
||||||
|
implicit none
|
||||||
|
integer :: i,k
|
||||||
|
integer :: degree
|
||||||
|
do i = 1, N_det
|
||||||
|
print *, 'Determinant ', i
|
||||||
|
call debug_det(psi_det(1,1,i),N_int)
|
||||||
|
print '(4E20.12,X)', (psi_coef(i,k), k=1,N_states)
|
||||||
|
print *, ''
|
||||||
|
print *, ''
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
Loading…
Reference in New Issue
Block a user