mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-06-24 06:02:26 +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:
Anthony Scemama
Thomas Applencourt
parent
ca4f8ebdca
commit
347e918a4a
|
|
@ -1,8 +1,5 @@
|
|||
open Core
|
||||
open Qptypes
|
||||
|
||||
module StringHashtbl = Hashtbl.Make(String)
|
||||
|
||||
type pub_state =
|
||||
| Waiting
|
||||
| Running of string
|
||||
|
|
@ -29,15 +26,15 @@ type t =
|
|||
progress_bar : Progress_bar.t option ;
|
||||
running : bool;
|
||||
accepting_clients : bool;
|
||||
data : string StringHashtbl.t;
|
||||
data : (string, string) Hashtbl.t;
|
||||
}
|
||||
|
||||
|
||||
|
||||
let debug_env =
|
||||
match Sys.getenv "QP_TASK_DEBUG" with
|
||||
| Some x -> x <> ""
|
||||
| None -> false
|
||||
try
|
||||
Sys.getenv "QP_TASK_DEBUG"; true
|
||||
with Not_found -> false
|
||||
|
||||
|
||||
let debug str =
|
||||
|
|
@ -64,7 +61,7 @@ let bind_socket ~socket_type ~socket ~port =
|
|||
Zmq.Socket.bind socket @@ Printf.sprintf "tcp://*:%d" port;
|
||||
loop (-1)
|
||||
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
|
||||
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 (
|
||||
match Sys.getenv "QP_NIC" with
|
||||
let interface =
|
||||
try Some (Sys.getenv "QP_NIC")
|
||||
with Not_found -> None
|
||||
in
|
||||
match interface with
|
||||
| None ->
|
||||
begin
|
||||
try
|
||||
Lazy.force hostname
|
||||
|> Unix.Inet_addr.of_string_or_getbyname
|
||||
|> Unix.Inet_addr.to_string
|
||||
let host =
|
||||
Lazy.force hostname
|
||||
|> Unix.gethostbyname
|
||||
in
|
||||
Unix.string_of_inet_addr host.h_addr_list.(0);
|
||||
with
|
||||
| Unix.Unix_error _ ->
|
||||
failwith "Unable to find IP address from host name."
|
||||
end
|
||||
| Some interface ->
|
||||
begin
|
||||
try
|
||||
ok_exn Linux_ext.get_ipv4_address_for_interface interface
|
||||
with
|
||||
| Unix.Unix_error _ ->
|
||||
Lazy.force hostname
|
||||
|> Unix.Inet_addr.of_string_or_getbyname
|
||||
|> Unix.Inet_addr.to_string
|
||||
end
|
||||
let result = get_ipv4_address_for_interface interface in
|
||||
if String.sub result 0 5 = "error" then
|
||||
Printf.sprintf "Unable to use network interface %s" interface
|
||||
|> failwith
|
||||
else
|
||||
result
|
||||
)
|
||||
|
||||
|
||||
|
|
@ -209,7 +212,7 @@ let end_job msg program_state rep_socket pair_socket =
|
|||
address_inproc = None;
|
||||
running = true;
|
||||
accepting_clients = false;
|
||||
data = StringHashtbl.create ();
|
||||
data = Hashtbl.create 23;
|
||||
}
|
||||
|
||||
and wait n =
|
||||
|
|
@ -335,8 +338,10 @@ let del_task msg program_state rep_socket =
|
|||
and success () =
|
||||
|
||||
let queue =
|
||||
List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
||||
~init:program_state.queue task_ids
|
||||
List.fold_left
|
||||
(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
||||
program_state.queue
|
||||
task_ids
|
||||
in
|
||||
let accepting_clients =
|
||||
(Queuing_system.number_of_queued queue > Queuing_system.number_of_clients queue)
|
||||
|
|
@ -382,11 +387,12 @@ let add_task msg program_state rep_socket =
|
|||
in
|
||||
|
||||
let result =
|
||||
let new_queue, new_bar =
|
||||
List.fold ~f:(fun (queue, bar) task ->
|
||||
Queuing_system.add_task ~task queue,
|
||||
increment_progress_bar bar)
|
||||
~init:(program_state.queue, program_state.progress_bar) tasks
|
||||
let new_queue, new_bar =
|
||||
List.fold_left (fun (queue, bar) task ->
|
||||
Queuing_system.add_task ~task queue,
|
||||
increment_progress_bar bar)
|
||||
(program_state.queue, program_state.progress_bar)
|
||||
tasks
|
||||
in
|
||||
{ program_state with
|
||||
queue = new_queue;
|
||||
|
|
@ -547,10 +553,11 @@ let task_done msg program_state rep_socket =
|
|||
|
||||
and success () =
|
||||
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,
|
||||
increment_progress_bar bar)
|
||||
~init:(program_state.queue, program_state.progress_bar) task_ids
|
||||
(program_state.queue, program_state.progress_bar)
|
||||
task_ids
|
||||
in
|
||||
|
||||
let accepting_clients =
|
||||
|
|
@ -593,7 +600,7 @@ let put_data msg rest_of_msg program_state rep_socket =
|
|||
in
|
||||
|
||||
let success () =
|
||||
StringHashtbl.set program_state.data ~key ~data:value ;
|
||||
Hashtbl.add program_state.data key value ;
|
||||
Message.PutDataReply (Message.PutDataReply_msg.create ())
|
||||
|> Message.to_string
|
||||
|> Zmq.Socket.send rep_socket;
|
||||
|
|
@ -623,9 +630,8 @@ let get_data msg program_state rep_socket =
|
|||
|
||||
let success () =
|
||||
let value =
|
||||
match StringHashtbl.find program_state.data key with
|
||||
| Some value -> value
|
||||
| None -> "\000"
|
||||
try Hashtbl.find program_state.data key with
|
||||
| Not_found -> "\000"
|
||||
in
|
||||
Message.GetDataReply (Message.GetDataReply_msg.create ~value)
|
||||
|> Message.to_string_list
|
||||
|
|
@ -677,13 +683,16 @@ let abort program_state rep_socket =
|
|||
aux [] queue 1
|
||||
in
|
||||
let queue =
|
||||
List.fold ~f:(fun queue task_id ->
|
||||
Queuing_system.end_task ~task_id ~client_id queue)
|
||||
~init:queue tasks
|
||||
List.fold_left
|
||||
(fun queue task_id -> Queuing_system.end_task ~task_id ~client_id queue)
|
||||
queue
|
||||
tasks
|
||||
in
|
||||
let queue =
|
||||
List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
||||
~init:queue tasks
|
||||
List.fold_left
|
||||
(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
||||
queue
|
||||
tasks
|
||||
in
|
||||
let queue =
|
||||
Queuing_system.del_client ~client_id queue
|
||||
|
|
@ -777,7 +786,7 @@ let run ~port =
|
|||
address_inproc = None;
|
||||
progress_bar = None ;
|
||||
accepting_clients = false;
|
||||
data = StringHashtbl.create ();
|
||||
data = Hashtbl.create 23;
|
||||
}
|
||||
in
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ type t =
|
|||
progress_bar : Progress_bar.t option ;
|
||||
running : 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: thread
|
||||
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 ->
|
||||
begin
|
||||
flag ["ocaml";"compile";"native";"gprof"] (S [ A "-p"]);
|
||||
pdep ["link"] "linkdep" (fun param -> [param]);
|
||||
end
|
||||
| _ -> ()
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,11 +1,10 @@
|
|||
open Core
|
||||
open Qptypes
|
||||
|
||||
let basis () =
|
||||
let ezfio_filename =
|
||||
Sys.argv.(1)
|
||||
in
|
||||
if (not (Sys.file_exists_exn ezfio_filename)) then
|
||||
if (not (Sys.file_exists ezfio_filename)) then
|
||||
failwith "Error reading EZFIO file";
|
||||
Ezfio.set_file ezfio_filename;
|
||||
let basis =
|
||||
|
|
@ -22,7 +21,7 @@ let mo () =
|
|||
let ezfio_filename =
|
||||
Sys.argv.(1)
|
||||
in
|
||||
if (not (Sys.file_exists_exn ezfio_filename)) then
|
||||
if (not (Sys.file_exists ezfio_filename)) then
|
||||
failwith "Error reading EZFIO file";
|
||||
Ezfio.set_file ezfio_filename;
|
||||
let mo_coef =
|
||||
|
|
@ -39,7 +38,7 @@ let psi_det () =
|
|||
let ezfio_filename =
|
||||
Sys.argv.(1)
|
||||
in
|
||||
if (not (Sys.file_exists_exn ezfio_filename)) then
|
||||
if (not (Sys.file_exists ezfio_filename)) then
|
||||
failwith "Error reading EZFIO file";
|
||||
Ezfio.set_file ezfio_filename;
|
||||
let psi_det =
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
open Qputils
|
||||
open Qptypes
|
||||
open Core
|
||||
|
||||
(*
|
||||
* Command-line arguments
|
||||
|
|
@ -46,7 +45,7 @@ let set ~core ~inact ~act ~virt ~del =
|
|||
|
||||
|
||||
let mo_class =
|
||||
Array.init mo_num ~f:(fun i -> None)
|
||||
Array.init mo_num (fun i -> None)
|
||||
in
|
||||
|
||||
(* Check input data *)
|
||||
|
|
@ -113,7 +112,8 @@ 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 ->
|
||||
|> List.map (fun x ->
|
||||
let open Excitation in
|
||||
match x with
|
||||
| Single (x,y) ->
|
||||
( 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 av ;
|
||||
Excitation.double_of_singles av av ]
|
||||
|> List.map ~f:Excitation.(fun x ->
|
||||
|> List.map (fun x ->
|
||||
let open Excitation in
|
||||
match x with
|
||||
| Single _ -> assert false
|
||||
| Double (x,y,z,t) ->
|
||||
|
|
@ -146,19 +147,20 @@ let set ~core ~inact ~act ~virt ~del =
|
|||
and extract_hole2 (_,_,h,_) = h
|
||||
and extract_particle2 (_,_,_,p) = p
|
||||
in
|
||||
let init = Bitlist.zero n_int in
|
||||
let result = [
|
||||
List.map ~f:extract_hole single_excitations
|
||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
||||
List.map ~f:extract_particle single_excitations
|
||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
||||
List.map ~f:extract_hole1 double_excitations
|
||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
||||
List.map ~f:extract_particle1 double_excitations
|
||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
||||
List.map ~f:extract_hole2 double_excitations
|
||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
||||
List.map ~f:extract_particle2 double_excitations
|
||||
|> List.fold ~init:(Bitlist.zero n_int) ~f:Bitlist.or_operator ;
|
||||
List.map extract_hole single_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_particle single_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_hole1 double_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_particle1 double_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_hole2 double_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
List.map extract_particle2 double_excitations
|
||||
|> List.fold_left Bitlist.or_operator init;
|
||||
]
|
||||
in
|
||||
|
||||
|
|
@ -167,10 +169,11 @@ 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 )
|
||||
let result =
|
||||
List.map (fun x ->
|
||||
let y = Bitlist.to_int64_list x in y@y )
|
||||
result
|
||||
|> List.concat
|
||||
|> List.concat
|
||||
in
|
||||
|
||||
Ezfio.set_bitmasks_n_int (N_int_number.to_int n_int);
|
||||
|
|
@ -194,7 +197,7 @@ let set ~core ~inact ~act ~virt ~del =
|
|||
|
||||
let data =
|
||||
Array.to_list mo_class
|
||||
|> List.map ~f:(fun x -> match x with
|
||||
|> List.map (fun x -> match x with
|
||||
|None -> assert false
|
||||
| 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
|
||||
|
||||
|
||||
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 open Command_line in
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ subroutine get_s2(key_i,key_j,Nint,s2)
|
|||
implicit none
|
||||
use bitmasks
|
||||
BEGIN_DOC
|
||||
! Returns <S^2>
|
||||
! Returns $\langle S^2 \rangle - S_z^2 S_z$
|
||||
END_DOC
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: key_i(Nint,2)
|
||||
|
|
|
|||
|
|
@ -24,33 +24,33 @@
|
|||
|
||||
do j=1,elec_beta_num
|
||||
! 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_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||
enddo
|
||||
! 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))&
|
||||
+ 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||
enddo
|
||||
! 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))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
do j=elec_beta_num+1,elec_alpha_num
|
||||
! 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))&
|
||||
+ 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||
enddo
|
||||
! 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))
|
||||
enddo
|
||||
! 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))&
|
||||
- 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||
enddo
|
||||
|
|
@ -58,16 +58,16 @@
|
|||
|
||||
do j=elec_alpha_num+1, mo_num
|
||||
! 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))
|
||||
enddo
|
||||
! 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))&
|
||||
- 0.5d0*(Fock_matrix_mo_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||
enddo
|
||||
! 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_beta(i,j) - Fock_matrix_mo_alpha(i,j))
|
||||
enddo
|
||||
|
|
@ -123,22 +123,22 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_ao, (ao_num, ao_num) ]
|
|||
END_DOC
|
||||
|
||||
if(frozen_orb_scf)then
|
||||
call mo_to_ao(Fock_matrix_mo,size(Fock_matrix_mo,1), &
|
||||
Fock_matrix_ao,size(Fock_matrix_ao,1))
|
||||
else
|
||||
if ( (elec_alpha_num == elec_beta_num).and. &
|
||||
(level_shift == 0.) ) &
|
||||
then
|
||||
integer :: i,j
|
||||
do j=1,ao_num
|
||||
do i=1,ao_num
|
||||
Fock_matrix_ao(i,j) = Fock_matrix_ao_alpha(i,j)
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
call mo_to_ao(Fock_matrix_mo,size(Fock_matrix_mo,1), &
|
||||
call mo_to_ao(Fock_matrix_mo,size(Fock_matrix_mo,1), &
|
||||
Fock_matrix_ao,size(Fock_matrix_ao,1))
|
||||
endif
|
||||
else
|
||||
if ( (elec_alpha_num == elec_beta_num).and. &
|
||||
(level_shift == 0.) ) &
|
||||
then
|
||||
integer :: i,j
|
||||
do j=1,ao_num
|
||||
do i=1,ao_num
|
||||
Fock_matrix_ao(i,j) = Fock_matrix_ao_alpha(i,j)
|
||||
enddo
|
||||
enddo
|
||||
else
|
||||
call mo_to_ao(Fock_matrix_mo,size(Fock_matrix_mo,1), &
|
||||
Fock_matrix_ao,size(Fock_matrix_ao,1))
|
||||
endif
|
||||
endif
|
||||
END_PROVIDER
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
BEGIN_PROVIDER [double precision, SCF_density_matrix_ao_alpha, (ao_num,ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! S^{-1}.P_alpha.S^{-1}
|
||||
! $C.C^t$ over $\alpha$ MOs
|
||||
END_DOC
|
||||
|
||||
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) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! S^{-1}.P_beta.S^{-1}
|
||||
! $C.C^t$ over $\beta$ MOs
|
||||
END_DOC
|
||||
|
||||
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) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! S^{-1}.P.S^{-1} where P = C.C^t
|
||||
! Sum of $\alpha$ and $\beta$ density matrices
|
||||
END_DOC
|
||||
ASSERT (size(SCF_density_matrix_ao,1) == size(SCF_density_matrix_ao_alpha,1))
|
||||
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