mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Introduced put/get in OCaml
This commit is contained in:
parent
d6ac6e6e73
commit
514b13bc2f
370
ocaml/Message.ml
370
ocaml/Message.ml
@ -264,304 +264,74 @@ end = struct
|
|||||||
Printf.sprintf "get_task_reply 0"
|
Printf.sprintf "get_task_reply 0"
|
||||||
end
|
end
|
||||||
|
|
||||||
(** GetPsi : get the current variational wave function *)
|
|
||||||
module GetPsi_msg : sig
|
(** PutData: put some data in the hash table *)
|
||||||
|
module PutData_msg : sig
|
||||||
type t =
|
type t =
|
||||||
{ client_id : Id.Client.t ;
|
{ client_id : Id.Client.t ;
|
||||||
}
|
key : string; }
|
||||||
val create : client_id:int -> t
|
val create : client_id: int -> key: string -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
end = struct
|
end = struct
|
||||||
type t =
|
type t =
|
||||||
{ client_id : Id.Client.t ;
|
{ client_id : Id.Client.t ;
|
||||||
}
|
key : string; }
|
||||||
let create ~client_id =
|
let create ~client_id ~key =
|
||||||
{ client_id = Id.Client.of_int client_id }
|
|
||||||
let to_string x =
|
|
||||||
Printf.sprintf "get_psi %d"
|
|
||||||
(Id.Client.to_int x.client_id)
|
|
||||||
end
|
|
||||||
|
|
||||||
module Psi : sig
|
|
||||||
type t =
|
|
||||||
{
|
|
||||||
n_state : Strictly_positive_int.t ;
|
|
||||||
n_det : Strictly_positive_int.t ;
|
|
||||||
psi_det_size : Strictly_positive_int.t ;
|
|
||||||
n_det_generators : Strictly_positive_int.t option;
|
|
||||||
n_det_selectors : Strictly_positive_int.t option;
|
|
||||||
psi_det : string ;
|
|
||||||
psi_coef : string ;
|
|
||||||
energy : string;
|
|
||||||
}
|
|
||||||
val create : n_state:Strictly_positive_int.t
|
|
||||||
-> n_det:Strictly_positive_int.t
|
|
||||||
-> psi_det_size:Strictly_positive_int.t
|
|
||||||
-> n_det_generators:Strictly_positive_int.t option
|
|
||||||
-> n_det_selectors:Strictly_positive_int.t option
|
|
||||||
-> psi_det:string -> psi_coef:string -> energy:string -> t
|
|
||||||
end = struct
|
|
||||||
type t =
|
|
||||||
{
|
|
||||||
n_state : Strictly_positive_int.t ;
|
|
||||||
n_det : Strictly_positive_int.t ;
|
|
||||||
psi_det_size : Strictly_positive_int.t ;
|
|
||||||
n_det_generators : Strictly_positive_int.t option;
|
|
||||||
n_det_selectors : Strictly_positive_int.t option;
|
|
||||||
psi_det : string ;
|
|
||||||
psi_coef : string ;
|
|
||||||
energy : string ;
|
|
||||||
}
|
|
||||||
let create ~n_state ~n_det ~psi_det_size
|
|
||||||
~n_det_generators ~n_det_selectors ~psi_det ~psi_coef
|
|
||||||
~energy =
|
|
||||||
assert (Strictly_positive_int.to_int n_det <=
|
|
||||||
Strictly_positive_int.to_int psi_det_size );
|
|
||||||
{ n_state; n_det ; psi_det_size ;
|
|
||||||
n_det_generators ; n_det_selectors ;
|
|
||||||
psi_det ; psi_coef ; energy }
|
|
||||||
end
|
|
||||||
|
|
||||||
(** GetPsiReply_msg : Reply to the GetPsi message *)
|
|
||||||
module GetPsiReply_msg : sig
|
|
||||||
type t = string list
|
|
||||||
val create : psi:Psi.t -> t
|
|
||||||
val to_string : t -> string
|
|
||||||
end = struct
|
|
||||||
type t = string list
|
|
||||||
let create ~psi =
|
|
||||||
let g, s =
|
|
||||||
match psi.Psi.n_det_generators, psi.Psi.n_det_selectors with
|
|
||||||
| Some g, Some s -> Strictly_positive_int.to_int g, Strictly_positive_int.to_int s
|
|
||||||
| _ -> -1, -1
|
|
||||||
in
|
|
||||||
let head =
|
|
||||||
Printf.sprintf "get_psi_reply %d %d %d %d %d"
|
|
||||||
(Strictly_positive_int.to_int psi.Psi.n_state)
|
|
||||||
(Strictly_positive_int.to_int psi.Psi.n_det)
|
|
||||||
(Strictly_positive_int.to_int psi.Psi.psi_det_size)
|
|
||||||
g s
|
|
||||||
in
|
|
||||||
[ head ; psi.Psi.psi_det ; psi.Psi.psi_coef ; psi.Psi.energy ]
|
|
||||||
let to_string = function
|
|
||||||
| head :: _ :: _ :: _ :: [] -> head
|
|
||||||
| _ -> raise (Invalid_argument "Bad wave function message")
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
(** PutPsi : put the current variational wave function *)
|
|
||||||
module PutPsi_msg : sig
|
|
||||||
type t =
|
|
||||||
{ client_id : Id.Client.t ;
|
|
||||||
n_state : Strictly_positive_int.t ;
|
|
||||||
n_det : Strictly_positive_int.t ;
|
|
||||||
psi_det_size : Strictly_positive_int.t ;
|
|
||||||
n_det_generators : Strictly_positive_int.t option;
|
|
||||||
n_det_selectors : Strictly_positive_int.t option;
|
|
||||||
psi : Psi.t option }
|
|
||||||
val create :
|
|
||||||
client_id:int ->
|
|
||||||
n_state:int ->
|
|
||||||
n_det:int ->
|
|
||||||
psi_det_size:int ->
|
|
||||||
psi_det:string option ->
|
|
||||||
psi_coef:string option ->
|
|
||||||
n_det_generators: int option ->
|
|
||||||
n_det_selectors:int option ->
|
|
||||||
energy:string option -> t
|
|
||||||
val to_string_list : t -> string list
|
|
||||||
val to_string : t -> string
|
|
||||||
end = struct
|
|
||||||
type t =
|
|
||||||
{ client_id : Id.Client.t ;
|
|
||||||
n_state : Strictly_positive_int.t ;
|
|
||||||
n_det : Strictly_positive_int.t ;
|
|
||||||
psi_det_size : Strictly_positive_int.t ;
|
|
||||||
n_det_generators : Strictly_positive_int.t option;
|
|
||||||
n_det_selectors : Strictly_positive_int.t option;
|
|
||||||
psi : Psi.t option }
|
|
||||||
let create ~client_id ~n_state ~n_det ~psi_det_size ~psi_det ~psi_coef
|
|
||||||
~n_det_generators ~n_det_selectors ~energy =
|
|
||||||
let n_state, n_det, psi_det_size =
|
|
||||||
Strictly_positive_int.of_int n_state,
|
|
||||||
Strictly_positive_int.of_int n_det,
|
|
||||||
Strictly_positive_int.of_int psi_det_size
|
|
||||||
in
|
|
||||||
assert (Strictly_positive_int.to_int psi_det_size >=
|
|
||||||
Strictly_positive_int.to_int n_det);
|
|
||||||
let n_det_generators, n_det_selectors =
|
|
||||||
match n_det_generators, n_det_selectors with
|
|
||||||
| Some x, Some y ->
|
|
||||||
Some (Strictly_positive_int.of_int x),
|
|
||||||
Some (Strictly_positive_int.of_int y)
|
|
||||||
| _ -> None, None
|
|
||||||
in
|
|
||||||
let psi =
|
|
||||||
match (psi_det, psi_coef, energy) with
|
|
||||||
| (Some psi_det, Some psi_coef, Some energy) ->
|
|
||||||
Some (Psi.create ~n_state ~n_det ~psi_det_size ~psi_det
|
|
||||||
~psi_coef ~n_det_generators ~n_det_selectors ~energy)
|
|
||||||
| _ -> None
|
|
||||||
in
|
|
||||||
{ client_id = Id.Client.of_int client_id ;
|
{ client_id = Id.Client.of_int client_id ;
|
||||||
n_state ; n_det ; psi_det_size ; n_det_generators ;
|
key ; }
|
||||||
n_det_selectors ; psi }
|
|
||||||
|
|
||||||
let to_string x =
|
let to_string x =
|
||||||
match x.n_det_generators, x.n_det_selectors with
|
Printf.sprintf "put_data %d %s"
|
||||||
| Some g, Some s ->
|
(Id.Client.to_int x.client_id) x.key
|
||||||
Printf.sprintf "put_psi %d %d %d %d %d %d"
|
|
||||||
(Id.Client.to_int x.client_id)
|
|
||||||
(Strictly_positive_int.to_int x.n_state)
|
|
||||||
(Strictly_positive_int.to_int x.n_det)
|
|
||||||
(Strictly_positive_int.to_int x.psi_det_size)
|
|
||||||
(Strictly_positive_int.to_int g)
|
|
||||||
(Strictly_positive_int.to_int s)
|
|
||||||
| _, _ ->
|
|
||||||
Printf.sprintf "put_psi %d %d %d %d %d %d"
|
|
||||||
(Id.Client.to_int x.client_id)
|
|
||||||
(Strictly_positive_int.to_int x.n_state)
|
|
||||||
(Strictly_positive_int.to_int x.n_det)
|
|
||||||
(Strictly_positive_int.to_int x.psi_det_size)
|
|
||||||
(-1) (-1)
|
|
||||||
|
|
||||||
let to_string_list x =
|
|
||||||
match x.psi with
|
|
||||||
| Some psi ->
|
|
||||||
[ to_string x ; psi.Psi.psi_det ; psi.Psi.psi_coef ; psi.Psi.energy ]
|
|
||||||
| None ->
|
|
||||||
[ to_string x ; "None" ; "None" ; "None" ]
|
|
||||||
end
|
end
|
||||||
|
|
||||||
(** PutPsiReply_msg : Reply to the PutPsi message *)
|
|
||||||
module PutPsiReply_msg : sig
|
(** PutDataReply_msg : Reply to the PutData message *)
|
||||||
|
module PutDataReply_msg : sig
|
||||||
type t
|
type t
|
||||||
val create : client_id:Id.Client.t -> t
|
val create : unit -> t
|
||||||
|
val to_string : t -> string
|
||||||
|
end = struct
|
||||||
|
type t = unit
|
||||||
|
let create () = ()
|
||||||
|
let to_string () = "put_data_reply ok"
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(** GetData: put some data in the hash table *)
|
||||||
|
module GetData_msg : sig
|
||||||
|
type t =
|
||||||
|
{ client_id : Id.Client.t ;
|
||||||
|
key : string; }
|
||||||
|
val create : client_id: int -> key: string -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
end = struct
|
end = struct
|
||||||
type t =
|
type t =
|
||||||
{ client_id : Id.Client.t ;
|
{ client_id : Id.Client.t ;
|
||||||
}
|
key : string }
|
||||||
let create ~client_id =
|
let create ~client_id ~key =
|
||||||
{ client_id; }
|
{ client_id = Id.Client.of_int client_id ; key }
|
||||||
let to_string x =
|
let to_string x =
|
||||||
Printf.sprintf "put_psi_reply %d"
|
Printf.sprintf "get_data %d %s"
|
||||||
(Id.Client.to_int x.client_id)
|
(Id.Client.to_int x.client_id) x.key
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
(** GetVector : get the current vector (Davidson) *)
|
(** GetDataReply_msg : Reply to the GetData message *)
|
||||||
module GetVector_msg : sig
|
module GetDataReply_msg : sig
|
||||||
type t =
|
type t
|
||||||
{ client_id: Id.Client.t ;
|
val create : value:string -> t
|
||||||
}
|
|
||||||
val create : client_id:int -> t
|
|
||||||
val to_string : t -> string
|
|
||||||
end = struct
|
|
||||||
type t =
|
|
||||||
{ client_id: Id.Client.t ;
|
|
||||||
}
|
|
||||||
let create ~client_id =
|
|
||||||
{ client_id = Id.Client.of_int client_id }
|
|
||||||
let to_string x =
|
|
||||||
Printf.sprintf "get_vector %d"
|
|
||||||
(Id.Client.to_int x.client_id)
|
|
||||||
end
|
|
||||||
|
|
||||||
module Vector : sig
|
|
||||||
type t =
|
|
||||||
{
|
|
||||||
size : Strictly_positive_int.t;
|
|
||||||
data : string;
|
|
||||||
}
|
|
||||||
val create : size:Strictly_positive_int.t -> data:string -> t
|
|
||||||
end = struct
|
|
||||||
type t =
|
|
||||||
{
|
|
||||||
size : Strictly_positive_int.t;
|
|
||||||
data : string;
|
|
||||||
}
|
|
||||||
let create ~size ~data =
|
|
||||||
{ size ; data }
|
|
||||||
end
|
|
||||||
|
|
||||||
(** GetVectorReply_msg : Reply to the GetVector message *)
|
|
||||||
module GetVectorReply_msg : sig
|
|
||||||
type t =
|
|
||||||
{ client_id : Id.Client.t ;
|
|
||||||
vector : Vector.t }
|
|
||||||
val create : client_id:Id.Client.t -> vector:Vector.t -> t
|
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
val to_string_list : t -> string list
|
val to_string_list : t -> string list
|
||||||
end = struct
|
end = struct
|
||||||
type t =
|
type t = string
|
||||||
{ client_id : Id.Client.t ;
|
let create ~value = value
|
||||||
vector : Vector.t }
|
|
||||||
let create ~client_id ~vector =
|
|
||||||
{ client_id ; vector }
|
|
||||||
let to_string x =
|
let to_string x =
|
||||||
Printf.sprintf "get_vector_reply %d %d"
|
Printf.sprintf "get_data_reply %d %s"
|
||||||
(Id.Client.to_int x.client_id)
|
(String.length x) x
|
||||||
(Strictly_positive_int.to_int x.vector.Vector.size)
|
let to_string_list x = [
|
||||||
let to_string_list x =
|
Printf.sprintf "get_data_reply %d"
|
||||||
[ to_string x ; x.vector.Vector.data ]
|
(String.length x); x ]
|
||||||
end
|
|
||||||
|
|
||||||
(** PutVector : put the current variational wave function *)
|
|
||||||
module PutVector_msg : sig
|
|
||||||
type t =
|
|
||||||
{ client_id : Id.Client.t ;
|
|
||||||
size : Strictly_positive_int.t ;
|
|
||||||
vector : Vector.t option;
|
|
||||||
}
|
|
||||||
val create :
|
|
||||||
client_id:int -> size:int -> data:string option -> t
|
|
||||||
val to_string_list : t -> string list
|
|
||||||
val to_string : t -> string
|
|
||||||
end = struct
|
|
||||||
type t =
|
|
||||||
{ client_id : Id.Client.t ;
|
|
||||||
size : Strictly_positive_int.t ;
|
|
||||||
vector : Vector.t option;
|
|
||||||
}
|
|
||||||
let create ~client_id ~size ~data =
|
|
||||||
let size =
|
|
||||||
Strictly_positive_int.of_int size
|
|
||||||
in
|
|
||||||
let vector =
|
|
||||||
match data with
|
|
||||||
| None -> None
|
|
||||||
| Some s -> Some (Vector.create ~size ~data:s)
|
|
||||||
in
|
|
||||||
{ client_id = Id.Client.of_int client_id ;
|
|
||||||
vector ; size
|
|
||||||
}
|
|
||||||
|
|
||||||
let to_string x =
|
|
||||||
Printf.sprintf "put_vector %d %d"
|
|
||||||
(Id.Client.to_int x.client_id)
|
|
||||||
(Strictly_positive_int.to_int x.size)
|
|
||||||
|
|
||||||
let to_string_list x =
|
|
||||||
match x.vector with
|
|
||||||
| Some v -> [ to_string x ; v.Vector.data ]
|
|
||||||
| None -> failwith "Empty vector"
|
|
||||||
end
|
|
||||||
|
|
||||||
(** PutVectorReply_msg : Reply to the PutVector message *)
|
|
||||||
module PutVectorReply_msg : sig
|
|
||||||
type t
|
|
||||||
val create : client_id:Id.Client.t -> t
|
|
||||||
val to_string : t -> string
|
|
||||||
end = struct
|
|
||||||
type t =
|
|
||||||
{ client_id : Id.Client.t ;
|
|
||||||
}
|
|
||||||
let create ~client_id =
|
|
||||||
{ client_id; }
|
|
||||||
let to_string x =
|
|
||||||
Printf.sprintf "put_vector_reply %d"
|
|
||||||
(Id.Client.to_int x.client_id)
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -644,14 +414,10 @@ end
|
|||||||
(** Message *)
|
(** Message *)
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
| GetPsi of GetPsi_msg.t
|
| GetData of GetData_msg.t
|
||||||
| PutPsi of PutPsi_msg.t
|
| PutData of PutData_msg.t
|
||||||
| GetPsiReply of GetPsiReply_msg.t
|
| GetDataReply of GetDataReply_msg.t
|
||||||
| PutPsiReply of PutPsiReply_msg.t
|
| PutDataReply of PutDataReply_msg.t
|
||||||
| GetVector of GetVector_msg.t
|
|
||||||
| PutVector of PutVector_msg.t
|
|
||||||
| GetVectorReply of GetVectorReply_msg.t
|
|
||||||
| PutVectorReply of PutVectorReply_msg.t
|
|
||||||
| Newjob of Newjob_msg.t
|
| Newjob of Newjob_msg.t
|
||||||
| Endjob of Endjob_msg.t
|
| Endjob of Endjob_msg.t
|
||||||
| Connect of Connect_msg.t
|
| Connect of Connect_msg.t
|
||||||
@ -693,24 +459,10 @@ let of_string s =
|
|||||||
Newjob (Newjob_msg.create push_address_tcp push_address_inproc state)
|
Newjob (Newjob_msg.create push_address_tcp push_address_inproc state)
|
||||||
| EndJob_ state ->
|
| EndJob_ state ->
|
||||||
Endjob (Endjob_msg.create state)
|
Endjob (Endjob_msg.create state)
|
||||||
| GetPsi_ client_id ->
|
| GetData_ { client_id ; key } ->
|
||||||
GetPsi (GetPsi_msg.create ~client_id)
|
GetData (GetData_msg.create ~client_id ~key)
|
||||||
| PutPsi_ { client_id ; n_state ; n_det ; psi_det_size ; n_det_generators ; n_det_selectors } ->
|
| PutData_ { client_id ; key } ->
|
||||||
begin
|
PutData (PutData_msg.create ~client_id ~key)
|
||||||
match n_det_selectors, n_det_generators with
|
|
||||||
| Some s, Some g ->
|
|
||||||
PutPsi (PutPsi_msg.create ~client_id ~n_state ~n_det ~psi_det_size
|
|
||||||
~n_det_generators:(Some g) ~n_det_selectors:(Some s)
|
|
||||||
~psi_det:None ~psi_coef:None ~energy:None )
|
|
||||||
| _ ->
|
|
||||||
PutPsi (PutPsi_msg.create ~client_id ~n_state ~n_det ~psi_det_size
|
|
||||||
~n_det_generators:None ~n_det_selectors:None
|
|
||||||
~psi_det:None ~psi_coef:None ~energy:None )
|
|
||||||
end
|
|
||||||
| GetVector_ client_id ->
|
|
||||||
GetVector (GetVector_msg.create ~client_id)
|
|
||||||
| PutVector_ { client_id ; size } ->
|
|
||||||
PutVector (PutVector_msg.create ~client_id ~size ~data:None )
|
|
||||||
| Terminate_ -> Terminate (Terminate_msg.create )
|
| Terminate_ -> Terminate (Terminate_msg.create )
|
||||||
| Abort_ -> Abort (Abort_msg.create )
|
| Abort_ -> Abort (Abort_msg.create )
|
||||||
| SetWaiting_ -> SetWaiting
|
| SetWaiting_ -> SetWaiting
|
||||||
@ -722,10 +474,10 @@ let of_string s =
|
|||||||
|
|
||||||
|
|
||||||
let to_string = function
|
let to_string = function
|
||||||
| GetPsi x -> GetPsi_msg.to_string x
|
| GetData x -> GetData_msg.to_string x
|
||||||
| PutPsiReply x -> PutPsiReply_msg.to_string x
|
| PutData x -> PutData_msg.to_string x
|
||||||
| GetVector x -> GetVector_msg.to_string x
|
| PutDataReply x -> PutDataReply_msg.to_string x
|
||||||
| PutVectorReply x -> PutVectorReply_msg.to_string x
|
| GetDataReply x -> GetDataReply_msg.to_string x
|
||||||
| Newjob x -> Newjob_msg.to_string x
|
| Newjob x -> Newjob_msg.to_string x
|
||||||
| Endjob x -> Endjob_msg.to_string x
|
| Endjob x -> Endjob_msg.to_string x
|
||||||
| Connect x -> Connect_msg.to_string x
|
| Connect x -> Connect_msg.to_string x
|
||||||
@ -743,18 +495,12 @@ let to_string = function
|
|||||||
| Abort x -> Abort_msg.to_string x
|
| Abort x -> Abort_msg.to_string x
|
||||||
| Ok x -> Ok_msg.to_string x
|
| Ok x -> Ok_msg.to_string x
|
||||||
| Error x -> Error_msg.to_string x
|
| Error x -> Error_msg.to_string x
|
||||||
| PutPsi x -> PutPsi_msg.to_string x
|
|
||||||
| GetPsiReply x -> GetPsiReply_msg.to_string x
|
|
||||||
| PutVector x -> PutVector_msg.to_string x
|
|
||||||
| GetVectorReply x -> GetVectorReply_msg.to_string x
|
|
||||||
| SetStopped -> "set_stopped"
|
| SetStopped -> "set_stopped"
|
||||||
| SetRunning -> "set_running"
|
| SetRunning -> "set_running"
|
||||||
| SetWaiting -> "set_waiting"
|
| SetWaiting -> "set_waiting"
|
||||||
|
|
||||||
|
|
||||||
let to_string_list = function
|
let to_string_list = function
|
||||||
| PutPsi x -> PutPsi_msg.to_string_list x
|
| GetDataReply x -> GetDataReply_msg.to_string_list x
|
||||||
| PutVector x -> PutVector_msg.to_string_list x
|
|
||||||
| GetVectorReply x -> GetVectorReply_msg.to_string_list x
|
|
||||||
| _ -> assert false
|
| _ -> assert false
|
||||||
|
|
||||||
|
@ -16,10 +16,8 @@ type kw_type =
|
|||||||
| END_JOB
|
| END_JOB
|
||||||
| TERMINATE
|
| TERMINATE
|
||||||
| ABORT
|
| ABORT
|
||||||
| GET_PSI
|
| GET_DATA
|
||||||
| PUT_PSI
|
| PUT_DATA
|
||||||
| GET_VECTOR
|
|
||||||
| PUT_VECTOR
|
|
||||||
| OK
|
| OK
|
||||||
| ERROR
|
| ERROR
|
||||||
| SET_STOPPED
|
| SET_STOPPED
|
||||||
@ -33,7 +31,7 @@ type state_clientid = { state : string ; client_id : int ; }
|
|||||||
type state_tcp_inproc = { state : string ; push_address_tcp : string ; push_address_inproc : string ; }
|
type state_tcp_inproc = { state : string ; push_address_tcp : string ; push_address_inproc : string ; }
|
||||||
type psi = { client_id: int ; n_state: int ; n_det: int ; psi_det_size: int ;
|
type psi = { client_id: int ; n_state: int ; n_det: int ; psi_det_size: int ;
|
||||||
n_det_generators: int option ; n_det_selectors: int option ; }
|
n_det_generators: int option ; n_det_selectors: int option ; }
|
||||||
type vector = { client_id: int ; size: int }
|
type client_id_key = { client_id: int ; key: string }
|
||||||
|
|
||||||
type msg =
|
type msg =
|
||||||
| AddTask_ of state_tasks
|
| AddTask_ of state_tasks
|
||||||
@ -46,10 +44,8 @@ type msg =
|
|||||||
| EndJob_ of string
|
| EndJob_ of string
|
||||||
| Terminate_
|
| Terminate_
|
||||||
| Abort_
|
| Abort_
|
||||||
| GetPsi_ of int
|
| GetData_ of client_id_key
|
||||||
| PutPsi_ of psi
|
| PutData_ of client_id_key
|
||||||
| GetVector_ of int
|
|
||||||
| PutVector_ of vector
|
|
||||||
| Ok_
|
| Ok_
|
||||||
| Error_ of string
|
| Error_ of string
|
||||||
| SetStopped_
|
| SetStopped_
|
||||||
@ -89,12 +85,10 @@ and kw = parse
|
|||||||
| "connect" { CONNECT }
|
| "connect" { CONNECT }
|
||||||
| "new_job" { NEW_JOB }
|
| "new_job" { NEW_JOB }
|
||||||
| "end_job" { END_JOB }
|
| "end_job" { END_JOB }
|
||||||
|
| "put_data" { PUT_DATA }
|
||||||
|
| "get_data" { GET_DATA }
|
||||||
| "terminate" { TERMINATE }
|
| "terminate" { TERMINATE }
|
||||||
| "abort" { ABORT }
|
| "abort" { ABORT }
|
||||||
| "get_psi" { GET_PSI }
|
|
||||||
| "put_psi" { PUT_PSI }
|
|
||||||
| "get_vector" { GET_PSI }
|
|
||||||
| "put_vector" { PUT_PSI }
|
|
||||||
| "ok" { OK }
|
| "ok" { OK }
|
||||||
| "error" { ERROR }
|
| "error" { ERROR }
|
||||||
| "set_stopped" { SET_STOPPED }
|
| "set_stopped" { SET_STOPPED }
|
||||||
@ -173,30 +167,15 @@ and kw = parse
|
|||||||
let client_id = read_int lexbuf in
|
let client_id = read_int lexbuf in
|
||||||
Disconnect_ { state ; client_id }
|
Disconnect_ { state ; client_id }
|
||||||
|
|
||||||
| GET_PSI ->
|
| GET_DATA ->
|
||||||
let client_id = read_int lexbuf in
|
let client_id = read_int lexbuf in
|
||||||
GetPsi_ client_id
|
let key = read_word lexbuf in
|
||||||
|
GetData_ { client_id ; key }
|
||||||
|
|
||||||
| PUT_PSI ->
|
| PUT_DATA ->
|
||||||
let client_id = read_int lexbuf in
|
let client_id = read_int lexbuf in
|
||||||
let n_state = read_int lexbuf in
|
let key = read_word lexbuf in
|
||||||
let n_det = read_int lexbuf in
|
PutData_ { client_id ; key }
|
||||||
let psi_det_size = read_int lexbuf in
|
|
||||||
let n_det_generators, n_det_selectors =
|
|
||||||
try
|
|
||||||
(Some (read_int lexbuf), Some (read_int lexbuf))
|
|
||||||
with (Failure _) -> (None, None)
|
|
||||||
in
|
|
||||||
PutPsi_ { client_id ; n_state ; n_det ; psi_det_size ; n_det_generators ; n_det_selectors }
|
|
||||||
|
|
||||||
| GET_VECTOR ->
|
|
||||||
let client_id = read_int lexbuf in
|
|
||||||
GetVector_ client_id
|
|
||||||
|
|
||||||
| PUT_VECTOR ->
|
|
||||||
let client_id = read_int lexbuf in
|
|
||||||
let size = read_int lexbuf in
|
|
||||||
PutVector_ { client_id ; size }
|
|
||||||
|
|
||||||
| CONNECT ->
|
| CONNECT ->
|
||||||
let socket = read_word lexbuf in
|
let socket = read_word lexbuf in
|
||||||
@ -267,16 +246,8 @@ and kw = parse
|
|||||||
| Connect_ socket -> Printf.sprintf "CONNECT socket:\"%s\"" socket
|
| Connect_ socket -> Printf.sprintf "CONNECT socket:\"%s\"" socket
|
||||||
| NewJob_ { state ; push_address_tcp ; push_address_inproc } -> Printf.sprintf "NEW_JOB state:\"%s\" tcp:\"%s\" inproc:\"%s\"" state push_address_tcp push_address_inproc
|
| NewJob_ { state ; push_address_tcp ; push_address_inproc } -> Printf.sprintf "NEW_JOB state:\"%s\" tcp:\"%s\" inproc:\"%s\"" state push_address_tcp push_address_inproc
|
||||||
| EndJob_ state -> Printf.sprintf "END_JOB state:\"%s\"" state
|
| EndJob_ state -> Printf.sprintf "END_JOB state:\"%s\"" state
|
||||||
| GetPsi_ client_id -> Printf.sprintf "GET_PSI client_id:%d" client_id
|
| GetData_ { client_id; key } -> Printf.sprintf "GET_DATA client_id:%d key:%s" client_id key
|
||||||
| PutPsi_ { client_id ; n_state ; n_det ; psi_det_size ; n_det_generators ; n_det_selectors } ->
|
| PutData_ { client_id ; key } -> Printf.sprintf "PUT_DATA client_id:%d key:%s" client_id key
|
||||||
begin
|
|
||||||
match n_det_selectors, n_det_generators with
|
|
||||||
| Some s, Some g -> Printf.sprintf "PUT_PSI client_id:%d n_state:%d n_det:%d psi_det_size:%d n_det_generators:%d n_det_selectors:%d" client_id n_state n_det psi_det_size g s
|
|
||||||
| _ -> Printf.sprintf "PUT_PSI client_id:%d n_state:%d n_det:%d psi_det_size:%d" client_id n_state n_det psi_det_size
|
|
||||||
end
|
|
||||||
| GetVector_ client_id -> Printf.sprintf "GET_VECTOR client_id:%d" client_id
|
|
||||||
| PutVector_ { client_id ; size } ->
|
|
||||||
Printf.sprintf "PUT_VECTOR client_id:%d size:%d" client_id size
|
|
||||||
| Terminate_ -> "TERMINATE"
|
| Terminate_ -> "TERMINATE"
|
||||||
| Abort_ -> "ABORT"
|
| Abort_ -> "ABORT"
|
||||||
| SetWaiting_ -> "SET_WAITING"
|
| SetWaiting_ -> "SET_WAITING"
|
||||||
|
@ -25,10 +25,9 @@ type t =
|
|||||||
state : Message.State.t option ;
|
state : Message.State.t option ;
|
||||||
address_tcp : Address.Tcp.t option ;
|
address_tcp : Address.Tcp.t option ;
|
||||||
address_inproc : Address.Inproc.t option ;
|
address_inproc : Address.Inproc.t option ;
|
||||||
psi : Message.GetPsiReply_msg.t option;
|
|
||||||
vector : Message.Vector.t option;
|
|
||||||
progress_bar : Progress_bar.t option ;
|
progress_bar : Progress_bar.t option ;
|
||||||
running : bool;
|
running : bool;
|
||||||
|
data : (string, string) Hashtbl.t;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -458,95 +457,41 @@ let task_done msg program_state rep_socket =
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
let put_psi msg rest_of_msg program_state rep_socket =
|
|
||||||
|
|
||||||
let psi_local =
|
let put_data msg rest_of_msg program_state rep_socket =
|
||||||
match msg.Message.PutPsi_msg.psi with
|
|
||||||
| Some x -> x
|
|
||||||
| None ->
|
|
||||||
begin
|
|
||||||
let psi_det, psi_coef, energy =
|
|
||||||
match rest_of_msg with
|
|
||||||
| [ x ; y ; e ] -> x, y, e
|
|
||||||
| _ -> failwith "Badly formed put_psi message"
|
|
||||||
in
|
|
||||||
Message.Psi.create
|
|
||||||
~n_state:msg.Message.PutPsi_msg.n_state
|
|
||||||
~n_det:msg.Message.PutPsi_msg.n_det
|
|
||||||
~psi_det_size:msg.Message.PutPsi_msg.psi_det_size
|
|
||||||
~n_det_generators:msg.Message.PutPsi_msg.n_det_generators
|
|
||||||
~n_det_selectors:msg.Message.PutPsi_msg.n_det_selectors
|
|
||||||
~psi_det
|
|
||||||
~psi_coef
|
|
||||||
~energy
|
|
||||||
end
|
|
||||||
in
|
|
||||||
let new_program_state =
|
|
||||||
{ program_state with
|
|
||||||
psi = Some (Message.GetPsiReply_msg.create ~psi:psi_local)
|
|
||||||
}
|
|
||||||
and client_id =
|
|
||||||
msg.Message.PutPsi_msg.client_id
|
|
||||||
in
|
|
||||||
Message.PutPsiReply (Message.PutPsiReply_msg.create ~client_id)
|
|
||||||
|> Message.to_string
|
|
||||||
|> ZMQ.Socket.send rep_socket;
|
|
||||||
|
|
||||||
new_program_state
|
debug (Message.PutData_msg.to_string msg);
|
||||||
|
let () =
|
||||||
|
let key, value =
|
||||||
let get_psi msg program_state rep_socket =
|
msg.Message.PutData_msg.key,
|
||||||
begin
|
|
||||||
match program_state.psi with
|
|
||||||
| None -> failwith "No wave function saved in TaskServer"
|
|
||||||
| Some psi_message -> ZMQ.Socket.send_all rep_socket psi_message
|
|
||||||
end;
|
|
||||||
program_state
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let put_vector msg rest_of_msg program_state rep_socket =
|
|
||||||
|
|
||||||
let vector_local =
|
|
||||||
match msg.Message.PutVector_msg.vector with
|
|
||||||
| Some x -> x
|
|
||||||
| None ->
|
|
||||||
begin
|
|
||||||
let data =
|
|
||||||
match rest_of_msg with
|
match rest_of_msg with
|
||||||
| [ x ] -> x
|
| [ x ] -> x
|
||||||
| _ -> failwith "Badly formed put_vector message"
|
| _ -> failwith "Badly formed put_data message"
|
||||||
in
|
in
|
||||||
Message.Vector.create
|
Hashtbl.set program_state.data ~key ~data:value ;
|
||||||
~size:msg.Message.PutVector_msg.size
|
|
||||||
~data
|
Message.PutDataReply (Message.PutDataReply_msg.create ())
|
||||||
end
|
|
||||||
in
|
|
||||||
let new_program_state =
|
|
||||||
{ program_state with
|
|
||||||
vector = Some vector_local
|
|
||||||
}
|
|
||||||
and client_id =
|
|
||||||
msg.Message.PutVector_msg.client_id
|
|
||||||
in
|
|
||||||
Message.PutVectorReply (Message.PutVectorReply_msg.create ~client_id)
|
|
||||||
|> Message.to_string
|
|> Message.to_string
|
||||||
|> ZMQ.Socket.send rep_socket;
|
|> ZMQ.Socket.send rep_socket
|
||||||
|
|
||||||
new_program_state
|
|
||||||
|
|
||||||
|
|
||||||
let get_vector msg program_state rep_socket =
|
|
||||||
|
|
||||||
let client_id =
|
|
||||||
msg.Message.GetVector_msg.client_id
|
|
||||||
in
|
in
|
||||||
match program_state.vector with
|
program_state
|
||||||
| None -> failwith "No wave function saved in TaskServer"
|
|
||||||
| Some vector ->
|
let get_data msg program_state rep_socket =
|
||||||
Message.GetVectorReply (Message.GetVectorReply_msg.create ~client_id ~vector)
|
|
||||||
|
debug (Message.GetData_msg.to_string msg);
|
||||||
|
let () =
|
||||||
|
let key =
|
||||||
|
msg.Message.GetData_msg.key
|
||||||
|
in
|
||||||
|
let value =
|
||||||
|
match Hashtbl.find program_state.data key with
|
||||||
|
| Some value -> value
|
||||||
|
| None -> ""
|
||||||
|
in
|
||||||
|
Message.GetDataReply (Message.GetDataReply_msg.create ~value)
|
||||||
|> Message.to_string_list
|
|> Message.to_string_list
|
||||||
|> ZMQ.Socket.send_all rep_socket;
|
|> ZMQ.Socket.send_all rep_socket
|
||||||
|
in
|
||||||
program_state
|
program_state
|
||||||
|
|
||||||
|
|
||||||
@ -554,8 +499,6 @@ let get_vector msg program_state rep_socket =
|
|||||||
let terminate program_state rep_socket =
|
let terminate program_state rep_socket =
|
||||||
reply_ok rep_socket;
|
reply_ok rep_socket;
|
||||||
{ program_state with
|
{ program_state with
|
||||||
psi = None;
|
|
||||||
vector = None;
|
|
||||||
address_tcp = None;
|
address_tcp = None;
|
||||||
address_inproc = None;
|
address_inproc = None;
|
||||||
running = false
|
running = false
|
||||||
@ -675,12 +618,11 @@ let run ~port =
|
|||||||
let initial_program_state =
|
let initial_program_state =
|
||||||
{ queue = Queuing_system.create () ;
|
{ queue = Queuing_system.create () ;
|
||||||
running = true ;
|
running = true ;
|
||||||
psi = None;
|
|
||||||
vector = None;
|
|
||||||
state = None;
|
state = None;
|
||||||
address_tcp = None;
|
address_tcp = None;
|
||||||
address_inproc = None;
|
address_inproc = None;
|
||||||
progress_bar = None ;
|
progress_bar = None ;
|
||||||
|
data = Hashtbl.create ~hashable:String.hashable ();
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
|
|
||||||
@ -747,10 +689,8 @@ let run ~port =
|
|||||||
match program_state.state, message with
|
match program_state.state, message with
|
||||||
| _ , Message.Terminate _ -> terminate program_state rep_socket
|
| _ , Message.Terminate _ -> terminate program_state rep_socket
|
||||||
| _ , Message.Abort _ -> abort program_state rep_socket
|
| _ , Message.Abort _ -> abort program_state rep_socket
|
||||||
| _ , Message.PutVector x -> put_vector x rest program_state rep_socket
|
| _ , Message.PutData x -> put_data x rest program_state rep_socket
|
||||||
| _ , Message.GetVector x -> get_vector x program_state rep_socket
|
| _ , Message.GetData x -> get_data x program_state rep_socket
|
||||||
| _ , Message.PutPsi x -> put_psi x rest program_state rep_socket
|
|
||||||
| _ , Message.GetPsi x -> get_psi x program_state rep_socket
|
|
||||||
| None , Message.Newjob x -> new_job x program_state rep_socket pair_socket
|
| None , Message.Newjob x -> new_job x program_state rep_socket pair_socket
|
||||||
| _ , Message.Newjob _ -> error "A job is already running" program_state rep_socket
|
| _ , Message.Newjob _ -> error "A job is already running" program_state rep_socket
|
||||||
| Some _, Message.Endjob x -> end_job x program_state rep_socket pair_socket
|
| Some _, Message.Endjob x -> end_job x program_state rep_socket pair_socket
|
||||||
|
@ -4,10 +4,9 @@ type t =
|
|||||||
state : Message.State.t option ;
|
state : Message.State.t option ;
|
||||||
address_tcp : Address.Tcp.t option ;
|
address_tcp : Address.Tcp.t option ;
|
||||||
address_inproc : Address.Inproc.t option ;
|
address_inproc : Address.Inproc.t option ;
|
||||||
psi : Message.GetPsiReply_msg.t option;
|
|
||||||
vector : Message.Vector.t option ;
|
|
||||||
progress_bar : Progress_bar.t option ;
|
progress_bar : Progress_bar.t option ;
|
||||||
running : bool;
|
running : bool;
|
||||||
|
data : (string, string) Core.Hashtbl.t ;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -70,13 +69,6 @@ val get_task: Message.GetTask_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> [> `Pair]
|
|||||||
(** Terminate server *)
|
(** Terminate server *)
|
||||||
val terminate : t -> [> `Req ] ZMQ.Socket.t -> t
|
val terminate : t -> [> `Req ] ZMQ.Socket.t -> t
|
||||||
|
|
||||||
(** Put a wave function in the task server *)
|
|
||||||
val put_psi :
|
|
||||||
Message.PutPsi_msg.t -> string list -> t -> [> `Req ] ZMQ.Socket.t -> t
|
|
||||||
|
|
||||||
(** Get the wave function stored in the task server *)
|
|
||||||
val get_psi : Message.GetPsi_msg.t -> t -> [> `Req ] ZMQ.Socket.t -> t
|
|
||||||
|
|
||||||
(** Reply an Error message *)
|
(** Reply an Error message *)
|
||||||
val error : string -> t -> [> `Req ] ZMQ.Socket.t -> t
|
val error : string -> t -> [> `Req ] ZMQ.Socket.t -> t
|
||||||
|
|
||||||
|
@ -12,42 +12,201 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy)
|
|||||||
integer*8 :: rc8
|
integer*8 :: rc8
|
||||||
character*(256) :: msg
|
character*(256) :: msg
|
||||||
|
|
||||||
write(msg,*) 'put_psi ', worker_id, N_states, N_det, psi_det_size, n_det_generators, n_det_selectors
|
call zmq_put_N_states(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_put_N_det(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_put_psi_det_size(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_put_psi_det(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_put_psi_coef(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_put_N_det_generators(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_put_N_det_selectors(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_put_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size_energy)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine zmq_put_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Put the X vector on the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
character*(*) :: name
|
||||||
|
integer, intent(in) :: size_x
|
||||||
|
double precision, intent(out) :: x(size_x)
|
||||||
|
integer :: rc
|
||||||
|
character*(256) :: msg
|
||||||
|
|
||||||
|
|
||||||
|
write(msg,'(A,X,I,X,A)') 'put_data', worker_id, name
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
|
||||||
if (rc /= len(trim(msg))) then
|
if (rc /= len(trim(msg))) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)'
|
print *, irp_here, ': Error sending '//name
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,ZMQ_SNDMORE)
|
rc = f77_zmq_send(zmq_to_qp_run_socket,x,size_x*8,0)
|
||||||
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
if (rc /= size_x*8) then
|
||||||
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,ZMQ_SNDMORE)'
|
print *, irp_here, ': Error sending '//name
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,ZMQ_SNDMORE)
|
|
||||||
if (rc8 /= psi_det_size*N_states*8_8) then
|
|
||||||
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,ZMQ_SNDMORE)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,energy,size_energy*8,0)
|
|
||||||
if (rc /= size_energy*8) then
|
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,energy,size_energy*8,0)'
|
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
if (msg(1:rc) /= 'put_psi_reply 1') then
|
if (msg(1:rc) /= 'put_data_reply ok') then
|
||||||
print *, rc, trim(msg)
|
print *, rc, trim(msg)
|
||||||
print *, 'Error in put_psi_reply'
|
print *, irp_here, ': Error in put_data_reply'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_TEMPLATE
|
||||||
|
|
||||||
|
subroutine zmq_put_$X(zmq_to_qp_run_socket,worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Put $X on the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: rc
|
||||||
|
character*(256) :: msg
|
||||||
|
|
||||||
|
write(msg,'(A,X,I,X,A)') 'put_data', worker_id, '$X'
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
|
||||||
|
if (rc /= len(trim(msg))) then
|
||||||
|
print *, irp_here, ': Error sending $X'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,$X,4,0)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, irp_here, ': Error sending $X'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
|
if (msg(1:rc) /= 'put_data_reply ok') then
|
||||||
|
print *, rc, trim(msg)
|
||||||
|
print *, irp_here, ': Error in put_data_reply'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine zmq_get_$X(zmq_to_qp_run_socket, worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Get $X from the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: rc
|
||||||
|
character*(64) :: msg
|
||||||
|
|
||||||
|
write(msg,'(A,X,I,X,A)') 'get_data', worker_id, '$X'
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
|
||||||
|
if (rc /= len(trim(msg))) then
|
||||||
|
print *, irp_here, ': Error getting $X'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
|
if (msg(1:14) /= 'get_data_reply') then
|
||||||
|
print *, rc, trim(msg)
|
||||||
|
print *, irp_here, ': Error in get_data_reply'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,$X,4,0)
|
||||||
|
if (rc /= 4) then
|
||||||
|
print *, rc
|
||||||
|
print *, irp_here, ': Error getting $X'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
SUBST [ X ]
|
||||||
|
|
||||||
|
N_states ;;
|
||||||
|
N_det ;;
|
||||||
|
psi_det_size ;;
|
||||||
|
N_det_generators ;;
|
||||||
|
N_det_selectors ;;
|
||||||
|
N_states_diag ;;
|
||||||
|
|
||||||
|
END_TEMPLATE
|
||||||
|
|
||||||
|
subroutine zmq_put_psi_det(zmq_to_qp_run_socket,worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Put psi_det on the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: rc, rc8
|
||||||
|
character*(256) :: msg
|
||||||
|
|
||||||
|
write(msg,'(A,X,I,X,A)') 'put_data', worker_id, 'psi_det'
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
|
||||||
|
if (rc /= len(trim(msg))) then
|
||||||
|
print *, irp_here, ': Error sending psi_det'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,0)
|
||||||
|
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
||||||
|
print *, irp_here, ': Error sending psi_det'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
|
if (msg(1:rc) /= 'put_data_reply ok') then
|
||||||
|
print *, rc, trim(msg)
|
||||||
|
print *, irp_here, ': Error in put_data_reply'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine zmq_put_psi_coef(zmq_to_qp_run_socket,worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Put psi_coef on the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: rc, rc8
|
||||||
|
character*(256) :: msg
|
||||||
|
|
||||||
|
write(msg,'(A,X,I,X,A)') 'put_data', worker_id, 'psi_coef'
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),ZMQ_SNDMORE)
|
||||||
|
if (rc /= len(trim(msg))) then
|
||||||
|
print *, irp_here, ': Error sending psi_coef'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8_8,0)
|
||||||
|
if (rc8 /= psi_det_size*N_states*8_8) then
|
||||||
|
print *, irp_here, ': Error sending psi_coef'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
|
if (msg(1:rc) /= 'put_data_reply ok') then
|
||||||
|
print *, rc, trim(msg)
|
||||||
|
print *, irp_here, ': Error in put_data_reply'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
!---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
|
subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
|
||||||
use f77_zmq
|
use f77_zmq
|
||||||
@ -63,59 +222,132 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy)
|
|||||||
integer*8 :: rc8
|
integer*8 :: rc8
|
||||||
character*(64) :: msg
|
character*(64) :: msg
|
||||||
|
|
||||||
write(msg,*) 'get_psi ', worker_id
|
call zmq_get_N_states(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_get_N_det(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_get_psi_det_size(zmq_to_qp_run_socket, worker_id)
|
||||||
|
TOUCH psi_det_size N_det N_states
|
||||||
|
|
||||||
|
call zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
|
||||||
|
call zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id)
|
||||||
|
TOUCH psi_det psi_coef
|
||||||
|
|
||||||
|
call zmq_get_N_det_generators(zmq_to_qp_run_socket, worker_id)
|
||||||
|
TOUCH N_det_generators
|
||||||
|
|
||||||
|
call zmq_get_N_det_selectors(zmq_to_qp_run_socket, worker_id)
|
||||||
|
TOUCH N_det_selectors
|
||||||
|
|
||||||
|
call zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size_energy)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Get psi_det from the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
|
character*(64) :: msg
|
||||||
|
|
||||||
|
|
||||||
|
write(msg,'(A,X,I,X,A)') 'get_data', worker_id, 'psi_det'
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
|
||||||
if (rc /= len(trim(msg))) then
|
if (rc /= len(trim(msg))) then
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)'
|
print *, irp_here, ': Error getting psi_det'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
if (msg(1:13) /= 'get_psi_reply') then
|
if (msg(1:14) /= 'get_data_reply') then
|
||||||
print *, rc, trim(msg)
|
print *, rc, trim(msg)
|
||||||
print *, 'Error in get_psi_reply'
|
print *, irp_here, ': Error in get_data_reply'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
integer :: N_states_read, N_det_read, psi_det_size_read
|
|
||||||
integer :: N_det_selectors_read, N_det_generators_read
|
|
||||||
read(msg(14:rc),*) N_states_read, N_det_read, psi_det_size_read, &
|
|
||||||
N_det_generators_read, N_det_selectors_read
|
|
||||||
|
|
||||||
N_states = N_states_read
|
|
||||||
N_det = N_det_read
|
|
||||||
psi_det_size = psi_det_size_read
|
|
||||||
TOUCH psi_det_size N_det N_states
|
|
||||||
|
|
||||||
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,int(N_int*2_8*N_det*bit_kind,8),0)
|
||||||
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
||||||
print *, 'f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
print *, irp_here, ': Error getting psi_det'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Get psi_coef from the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
|
character*(64) :: msg
|
||||||
|
|
||||||
|
|
||||||
|
write(msg,'(A,X,I,X,A)') 'get_data', worker_id, 'psi_coef'
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
|
||||||
|
if (rc /= len(trim(msg))) then
|
||||||
|
print *, irp_here, ': Error getting psi_coef'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
|
if (msg(1:14) /= 'get_data_reply') then
|
||||||
|
print *, rc, trim(msg)
|
||||||
|
print *, irp_here, ': Error in get_data_reply'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0)
|
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,int(psi_det_size*N_states*8_8,8),0)
|
||||||
if (rc8 /= psi_det_size*N_states*8_8) then
|
if (rc8 /= psi_det_size*N_states*8_8) then
|
||||||
print *, '77_zmq_recv8(zmq_to_qp_run_socket,psi_coef,psi_det_size*N_states*8,ZMQ_SNDMORE)'
|
print *, irp_here, ': Error getting psi_coef'
|
||||||
stop 'error'
|
stop 'error'
|
||||||
endif
|
endif
|
||||||
TOUCH psi_det psi_coef
|
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,energy,size_energy*8,0)
|
|
||||||
if (rc /= size_energy*8) then
|
|
||||||
print *, '77_zmq_recv(zmq_to_qp_run_socket,energy,size_energy*8,0)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
if (N_det_generators_read > 0) then
|
|
||||||
N_det_generators = N_det_generators_read
|
|
||||||
TOUCH N_det_generators
|
|
||||||
endif
|
|
||||||
if (N_det_selectors_read > 0) then
|
|
||||||
N_det_selectors = N_det_selectors_read
|
|
||||||
TOUCH N_det_selectors
|
|
||||||
endif
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_x)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Get psi_coef from the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer, intent(in) :: size_x
|
||||||
|
character*(*), intent(in) :: name
|
||||||
|
double precision, intent(out) :: x(size_x)
|
||||||
|
integer :: rc
|
||||||
|
integer*8 :: rc8
|
||||||
|
character*(64) :: msg
|
||||||
|
|
||||||
|
write(msg,'(A,X,I,X,A)') 'get_data', worker_id, name
|
||||||
|
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
|
||||||
|
if (rc /= len(trim(msg))) then
|
||||||
|
print *, irp_here, ': Error getting '//name
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
||||||
|
if (msg(1:14) /= 'get_data_reply') then
|
||||||
|
print *, rc, trim(msg)
|
||||||
|
print *, irp_here, ': Error in get_data_reply'
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
|
||||||
|
rc = f77_zmq_recv(zmq_to_qp_run_socket,x,size_x*8,0)
|
||||||
|
if (rc /= size_x*8) then
|
||||||
|
print *, irp_here, ': Error getting '//name
|
||||||
|
stop 'error'
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -36,7 +36,7 @@ subroutine davidson_run_slave(thread,iproc)
|
|||||||
zmq_socket_push = new_zmq_push_socket(thread)
|
zmq_socket_push = new_zmq_push_socket(thread)
|
||||||
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
|
||||||
if(worker_id == -1) then
|
if(worker_id == -1) then
|
||||||
print *, 'WORKER -1'
|
print *, 'Exited'
|
||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
call end_zmq_push_socket(zmq_socket_push,thread)
|
call end_zmq_push_socket(zmq_socket_push,thread)
|
||||||
return
|
return
|
||||||
@ -76,55 +76,12 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
|
|
||||||
|
|
||||||
allocate(u_t(N_st,N_det))
|
allocate(u_t(N_st,N_det))
|
||||||
|
allocate (energy(N_st))
|
||||||
|
|
||||||
if (mpi_master) then
|
if (mpi_master) then
|
||||||
|
|
||||||
write(msg, *) 'get_psi ', worker_id
|
call zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'u_t', u_t, size(u_t))
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)
|
call zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size(energy))
|
||||||
if (rc /= len(trim(msg))) then
|
|
||||||
print *, 'f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,msg,len(msg),0)
|
|
||||||
if (msg(1:13) /= 'get_psi_reply') then
|
|
||||||
print *, rc, trim(msg)
|
|
||||||
print *, 'Error in get_psi_reply'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
read(msg(14:rc),*) N_states_read, N_det_read, psi_det_size_read, &
|
|
||||||
N_det_generators_read, N_det_selectors_read
|
|
||||||
|
|
||||||
if (N_states_read /= N_st) then
|
|
||||||
print *, N_st
|
|
||||||
stop 'error : N_st'
|
|
||||||
endif
|
|
||||||
|
|
||||||
if (N_det_read /= N_det) then
|
|
||||||
print *, N_det
|
|
||||||
stop 'N_det /= N_det_read'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det_read*bit_kind,0)
|
|
||||||
if (rc8 /= N_int*2_8*N_det_read*bit_kind) then
|
|
||||||
print *, 'f77_zmq_recv8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det_read*bit_kind,0)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc8 = f77_zmq_recv8(zmq_to_qp_run_socket,u_t,size(u_t)*8_8,0)
|
|
||||||
if (rc8 /= size(u_t)*8_8) then
|
|
||||||
print *, rc, size(u_t)*8
|
|
||||||
print *, 'f77_zmq_recv8(zmq_to_qp_run_socket,u_t,size(u_t)*8_8,0)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
allocate (energy(N_st))
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,energy,N_st*8,0)
|
|
||||||
if (rc /= N_st*8) then
|
|
||||||
print *, '77_zmq_recv(zmq_to_qp_run_socket,energy,N_st*8,0)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -132,13 +89,6 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
include 'mpif.h'
|
include 'mpif.h'
|
||||||
integer :: ierr
|
integer :: ierr
|
||||||
|
|
||||||
call MPI_BARRIER(MPI_COMM_WORLD,ierr)
|
|
||||||
print *, mpi_rank, size(u_t)
|
|
||||||
call sleep(1)
|
|
||||||
if (ierr /= MPI_SUCCESS) then
|
|
||||||
print *, irp_here//': Unable to broadcast N_st'
|
|
||||||
stop -1
|
|
||||||
endif
|
|
||||||
call broadcast_chunks_double(u_t,size(u_t))
|
call broadcast_chunks_double(u_t,size(u_t))
|
||||||
|
|
||||||
|
|
||||||
@ -358,40 +308,13 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
|||||||
integer :: rc
|
integer :: rc
|
||||||
integer*8 :: rc8
|
integer*8 :: rc8
|
||||||
double precision :: energy(N_st)
|
double precision :: energy(N_st)
|
||||||
|
|
||||||
energy = 0.d0
|
energy = 0.d0
|
||||||
|
|
||||||
task = ' '
|
call zmq_put_N_states_diag(zmq_to_qp_run_socket, 1)
|
||||||
write(task,*) 'put_psi ', 1, N_st, N_det, N_det
|
call zmq_put_psi_det(zmq_to_qp_run_socket, 1)
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,trim(task),len(trim(task)),ZMQ_SNDMORE)
|
call zmq_put_dvector(zmq_to_qp_run_socket, 1, 'u_t', u_t, size(u_t))
|
||||||
if (rc /= len(trim(task))) then
|
call zmq_put_dvector(zmq_to_qp_run_socket, 1, 'energy', energy, size(energy))
|
||||||
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,trim(task),len(trim(task)),ZMQ_SNDMORE)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2_8*N_det*bit_kind,ZMQ_SNDMORE)
|
|
||||||
if (rc8 /= N_int*2_8*N_det*bit_kind) then
|
|
||||||
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,psi_det,N_int*2*N_det*bit_kind,ZMQ_SNDMORE)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc8 = f77_zmq_send8(zmq_to_qp_run_socket,u_t,size(u_t)*8_8,ZMQ_SNDMORE)
|
|
||||||
if (rc8 /= size(u_t)*8_8) then
|
|
||||||
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,u_t,int(size(u_t)*8,8),ZMQ_SNDMORE)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc = f77_zmq_send(zmq_to_qp_run_socket,energy,N_st*8,0)
|
|
||||||
if (rc /= N_st*8) then
|
|
||||||
print *, 'f77_zmq_send8(zmq_to_qp_run_socket,energy,int(size_energy*8,8),0)'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
rc = f77_zmq_recv(zmq_to_qp_run_socket,task,len(task),0)
|
|
||||||
if (task(1:rc) /= 'put_psi_reply 1') then
|
|
||||||
print *, rc, trim(task)
|
|
||||||
print *, 'Error in put_psi_reply'
|
|
||||||
stop 'error'
|
|
||||||
endif
|
|
||||||
|
|
||||||
deallocate(u_t)
|
deallocate(u_t)
|
||||||
|
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha_average, (mo_tot_num_align,mo_tot_num) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha_average, (mo_tot_num,mo_tot_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta_average, (mo_tot_num_align,mo_tot_num) ]
|
&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta_average, (mo_tot_num,mo_tot_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Alpha and beta one-body density matrix for each state
|
! Alpha and beta one-body density matrix for each state
|
||||||
@ -41,7 +41,7 @@ BEGIN_PROVIDER [ double precision, one_body_dm_mo_diff, (mo_tot_num,mo_tot_num,2
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_dm_mo_spin_index, (mo_tot_num_align,mo_tot_num,N_states,2) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_mo_spin_index, (mo_tot_num,mo_tot_num,N_states,2) ]
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j,ispin,istate
|
integer :: i,j,ispin,istate
|
||||||
ispin = 1
|
ispin = 1
|
||||||
@ -65,7 +65,7 @@ END_PROVIDER
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_dm_dagger_mo_spin_index, (mo_tot_num_align,mo_tot_num,N_states,2) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_dagger_mo_spin_index, (mo_tot_num,mo_tot_num,N_states,2) ]
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j,ispin,istate
|
integer :: i,j,ispin,istate
|
||||||
ispin = 1
|
ispin = 1
|
||||||
@ -92,8 +92,8 @@ END_PROVIDER
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha, (mo_tot_num_align,mo_tot_num,N_states) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha, (mo_tot_num,mo_tot_num,N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta, (mo_tot_num_align,mo_tot_num,N_states) ]
|
&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta, (mo_tot_num,mo_tot_num,N_states) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Alpha and beta one-body density matrix for each state
|
! Alpha and beta one-body density matrix for each state
|
||||||
@ -117,12 +117,12 @@ END_PROVIDER
|
|||||||
!$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, &
|
!$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, &
|
||||||
!$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2)&
|
!$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2)&
|
||||||
!$OMP SHARED(psi_det,psi_coef,N_int,N_states,elec_alpha_num,&
|
!$OMP SHARED(psi_det,psi_coef,N_int,N_states,elec_alpha_num,&
|
||||||
!$OMP elec_beta_num,one_body_dm_mo_alpha,one_body_dm_mo_beta,N_det,mo_tot_num_align,&
|
!$OMP elec_beta_num,one_body_dm_mo_alpha,one_body_dm_mo_beta,N_det,&
|
||||||
!$OMP mo_tot_num,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns, &
|
!$OMP mo_tot_num,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns, &
|
||||||
!$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns, &
|
!$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns, &
|
||||||
!$OMP psi_bilinear_matrix_order_reverse, psi_det_alpha_unique, psi_det_beta_unique, &
|
!$OMP psi_bilinear_matrix_order_reverse, psi_det_alpha_unique, psi_det_beta_unique, &
|
||||||
!$OMP psi_bilinear_matrix_values, psi_bilinear_matrix_transp_values)
|
!$OMP psi_bilinear_matrix_values, psi_bilinear_matrix_transp_values)
|
||||||
allocate(tmp_a(mo_tot_num_align,mo_tot_num,N_states), tmp_b(mo_tot_num_align,mo_tot_num,N_states) )
|
allocate(tmp_a(mo_tot_num,mo_tot_num,N_states), tmp_b(mo_tot_num,mo_tot_num,N_states) )
|
||||||
tmp_a = 0.d0
|
tmp_a = 0.d0
|
||||||
tmp_b = 0.d0
|
tmp_b = 0.d0
|
||||||
!$OMP DO SCHEDULE(guided)
|
!$OMP DO SCHEDULE(guided)
|
||||||
@ -205,8 +205,8 @@ END_PROVIDER
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_single_double_dm_mo_alpha, (mo_tot_num_align,mo_tot_num) ]
|
BEGIN_PROVIDER [ double precision, one_body_single_double_dm_mo_alpha, (mo_tot_num,mo_tot_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_single_double_dm_mo_beta, (mo_tot_num_align,mo_tot_num) ]
|
&BEGIN_PROVIDER [ double precision, one_body_single_double_dm_mo_beta, (mo_tot_num,mo_tot_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Alpha and beta one-body density matrix for each state
|
! Alpha and beta one-body density matrix for each state
|
||||||
@ -230,9 +230,9 @@ END_PROVIDER
|
|||||||
!$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, &
|
!$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, &
|
||||||
!$OMP tmp_a, tmp_b, n_occ_alpha,degree_respect_to_HF_k,degree_respect_to_HF_l)&
|
!$OMP tmp_a, tmp_b, n_occ_alpha,degree_respect_to_HF_k,degree_respect_to_HF_l)&
|
||||||
!$OMP SHARED(ref_bitmask,psi_det,psi_coef,N_int,N_states,state_average_weight,elec_alpha_num,&
|
!$OMP SHARED(ref_bitmask,psi_det,psi_coef,N_int,N_states,state_average_weight,elec_alpha_num,&
|
||||||
!$OMP elec_beta_num,one_body_single_double_dm_mo_alpha,one_body_single_double_dm_mo_beta,N_det,mo_tot_num_align,&
|
!$OMP elec_beta_num,one_body_single_double_dm_mo_alpha,one_body_single_double_dm_mo_beta,N_det,&
|
||||||
!$OMP mo_tot_num)
|
!$OMP mo_tot_num)
|
||||||
allocate(tmp_a(mo_tot_num_align,mo_tot_num), tmp_b(mo_tot_num_align,mo_tot_num) )
|
allocate(tmp_a(mo_tot_num,mo_tot_num), tmp_b(mo_tot_num,mo_tot_num) )
|
||||||
tmp_a = 0.d0
|
tmp_a = 0.d0
|
||||||
tmp_b = 0.d0
|
tmp_b = 0.d0
|
||||||
!$OMP DO SCHEDULE(dynamic)
|
!$OMP DO SCHEDULE(dynamic)
|
||||||
@ -288,7 +288,7 @@ END_PROVIDER
|
|||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_dm_mo, (mo_tot_num_align,mo_tot_num) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_mo, (mo_tot_num,mo_tot_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! One-body density matrix
|
! One-body density matrix
|
||||||
@ -296,7 +296,7 @@ BEGIN_PROVIDER [ double precision, one_body_dm_mo, (mo_tot_num_align,mo_tot_num)
|
|||||||
one_body_dm_mo = one_body_dm_mo_alpha_average + one_body_dm_mo_beta_average
|
one_body_dm_mo = one_body_dm_mo_alpha_average + one_body_dm_mo_beta_average
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_spin_density_mo, (mo_tot_num_align,mo_tot_num) ]
|
BEGIN_PROVIDER [ double precision, one_body_spin_density_mo, (mo_tot_num,mo_tot_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! rho(alpha) - rho(beta)
|
! rho(alpha) - rho(beta)
|
||||||
@ -336,7 +336,7 @@ BEGIN_PROVIDER [ double precision, state_average_weight, (N_states) ]
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_spin_density_ao, (ao_num_align,ao_num) ]
|
BEGIN_PROVIDER [ double precision, one_body_spin_density_ao, (ao_num,ao_num) ]
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! one body spin density matrix on the AO basis : rho_AO(alpha) - rho_AO(beta)
|
! one body spin density matrix on the AO basis : rho_AO(alpha) - rho_AO(beta)
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -360,10 +360,8 @@ BEGIN_PROVIDER [ double precision, one_body_spin_density_ao, (ao_num_align,ao_nu
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_dm_ao_alpha, (ao_num_align,ao_num) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_ao_alpha, (ao_num,ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_dm_ao_beta, (ao_num_align,ao_num) ]
|
&BEGIN_PROVIDER [ double precision, one_body_dm_ao_beta, (ao_num,ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_dm_ao_alpha_no_align, (ao_num,ao_num) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_dm_ao_beta_no_align, (ao_num,ao_num) ]
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! one body density matrix on the AO basis : rho_AO(alpha) , rho_AO(beta)
|
! one body density matrix on the AO basis : rho_AO(alpha) , rho_AO(beta)
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -386,18 +384,12 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
do i = 1, ao_num
|
|
||||||
do j = 1, ao_num
|
|
||||||
one_body_dm_ao_alpha_no_align(j,i) = one_body_dm_ao_alpha(j,i)
|
|
||||||
one_body_dm_ao_beta_no_align(j,i) = one_body_dm_ao_beta(j,i)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha_old, (mo_tot_num_align,mo_tot_num,N_states) ]
|
BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha_old, (mo_tot_num,mo_tot_num,N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta_old, (mo_tot_num_align,mo_tot_num,N_states) ]
|
&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta_old, (mo_tot_num,mo_tot_num,N_states) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Alpha and beta one-body density matrix for each state
|
! Alpha and beta one-body density matrix for each state
|
||||||
@ -417,9 +409,9 @@ END_PROVIDER
|
|||||||
!$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, &
|
!$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, &
|
||||||
!$OMP tmp_a, tmp_b, n_occ)&
|
!$OMP tmp_a, tmp_b, n_occ)&
|
||||||
!$OMP SHARED(psi_det,psi_coef,N_int,N_states,elec_alpha_num,&
|
!$OMP SHARED(psi_det,psi_coef,N_int,N_states,elec_alpha_num,&
|
||||||
!$OMP elec_beta_num,one_body_dm_mo_alpha_old,one_body_dm_mo_beta_old,N_det,mo_tot_num_align,&
|
!$OMP elec_beta_num,one_body_dm_mo_alpha_old,one_body_dm_mo_beta_old,N_det,&
|
||||||
!$OMP mo_tot_num)
|
!$OMP mo_tot_num)
|
||||||
allocate(tmp_a(mo_tot_num_align,mo_tot_num,N_states), tmp_b(mo_tot_num_align,mo_tot_num,N_states) )
|
allocate(tmp_a(mo_tot_num,mo_tot_num,N_states), tmp_b(mo_tot_num,mo_tot_num,N_states) )
|
||||||
tmp_a = 0.d0
|
tmp_a = 0.d0
|
||||||
tmp_b = 0.d0
|
tmp_b = 0.d0
|
||||||
!$OMP DO SCHEDULE(dynamic)
|
!$OMP DO SCHEDULE(dynamic)
|
||||||
|
@ -19,7 +19,7 @@ BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)]
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_tot_num_align, mo_tot_num) ]
|
BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_tot_num, mo_tot_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i0,j0,i,j,k0,k
|
integer :: i0,j0,i,j,k0,k
|
||||||
integer :: n_occ_ab(2)
|
integer :: n_occ_ab(2)
|
||||||
|
@ -10,7 +10,6 @@ double precision function diag_S_mat_elem(key_i,Nint)
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer :: nup, i
|
integer :: nup, i
|
||||||
integer(bit_kind) :: xorvec(N_int_max)
|
integer(bit_kind) :: xorvec(N_int_max)
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
|
||||||
|
|
||||||
do i=1,Nint
|
do i=1,Nint
|
||||||
xorvec(i) = xor(key_i(i,1),key_i(i,2))
|
xorvec(i) = xor(key_i(i,1),key_i(i,2))
|
||||||
|
@ -11,7 +11,6 @@ subroutine get_excitation_degree(key1,key2,degree,Nint)
|
|||||||
integer, intent(out) :: degree
|
integer, intent(out) :: degree
|
||||||
|
|
||||||
integer(bit_kind) :: xorvec(2*N_int_max)
|
integer(bit_kind) :: xorvec(2*N_int_max)
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
|
||||||
integer :: l
|
integer :: l
|
||||||
|
|
||||||
ASSERT (Nint > 0)
|
ASSERT (Nint > 0)
|
||||||
|
@ -943,7 +943,6 @@ subroutine get_all_spin_singles_and_doubles_1(buffer, idx, spindet, size_buffer,
|
|||||||
|
|
||||||
n_singles = 1
|
n_singles = 1
|
||||||
n_doubles = 1
|
n_doubles = 1
|
||||||
!DIR$ VECTOR ALIGNED
|
|
||||||
do i=1,size_buffer
|
do i=1,size_buffer
|
||||||
degree = popcnt( xor( spindet, buffer(i) ) )
|
degree = popcnt( xor( spindet, buffer(i) ) )
|
||||||
if ( degree == 4 ) then
|
if ( degree == 4 ) then
|
||||||
@ -1011,7 +1010,6 @@ subroutine get_all_spin_doubles_1(buffer, idx, spindet, size_buffer, doubles, n_
|
|||||||
integer :: degree
|
integer :: degree
|
||||||
|
|
||||||
n_doubles = 1
|
n_doubles = 1
|
||||||
!DIR$ VECTOR ALIGNED
|
|
||||||
do i=1,size_buffer
|
do i=1,size_buffer
|
||||||
degree = popcnt(xor( spindet, buffer(i) ))
|
degree = popcnt(xor( spindet, buffer(i) ))
|
||||||
if ( degree == 4 ) then
|
if ( degree == 4 ) then
|
||||||
@ -1050,12 +1048,8 @@ subroutine get_all_spin_singles_and_doubles_$N_int(buffer, idx, spindet, size_bu
|
|||||||
integer(bit_kind) :: xorvec($N_int)
|
integer(bit_kind) :: xorvec($N_int)
|
||||||
integer :: degree
|
integer :: degree
|
||||||
|
|
||||||
integer, external :: align_double
|
|
||||||
|
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree
|
|
||||||
n_singles = 1
|
n_singles = 1
|
||||||
n_doubles = 1
|
n_doubles = 1
|
||||||
!DIR$ VECTOR ALIGNED
|
|
||||||
do i=1,size_buffer
|
do i=1,size_buffer
|
||||||
|
|
||||||
do k=1,$N_int
|
do k=1,$N_int
|
||||||
@ -1069,7 +1063,6 @@ subroutine get_all_spin_singles_and_doubles_$N_int(buffer, idx, spindet, size_bu
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
do k=2,$N_int
|
do k=2,$N_int
|
||||||
!DIR$ VECTOR ALIGNED
|
|
||||||
if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then
|
if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then
|
||||||
degree = degree + popcnt(xorvec(k))
|
degree = degree + popcnt(xorvec(k))
|
||||||
endif
|
endif
|
||||||
@ -1110,12 +1103,7 @@ subroutine get_all_spin_singles_$N_int(buffer, idx, spindet, size_buffer, single
|
|||||||
integer(bit_kind) :: xorvec($N_int)
|
integer(bit_kind) :: xorvec($N_int)
|
||||||
integer :: degree
|
integer :: degree
|
||||||
|
|
||||||
integer, external :: align_double
|
|
||||||
|
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec
|
|
||||||
|
|
||||||
n_singles = 1
|
n_singles = 1
|
||||||
!DIR$ VECTOR ALIGNED
|
|
||||||
do i=1,size_buffer
|
do i=1,size_buffer
|
||||||
|
|
||||||
do k=1,$N_int
|
do k=1,$N_int
|
||||||
@ -1165,7 +1153,6 @@ subroutine get_all_spin_doubles_$N_int(buffer, idx, spindet, size_buffer, double
|
|||||||
integer(bit_kind) :: xorvec($N_int)
|
integer(bit_kind) :: xorvec($N_int)
|
||||||
|
|
||||||
n_doubles = 1
|
n_doubles = 1
|
||||||
!DIR$ VECTOR ALIGNED
|
|
||||||
do i=1,size_buffer
|
do i=1,size_buffer
|
||||||
|
|
||||||
do k=1,$N_int
|
do k=1,$N_int
|
||||||
@ -1179,7 +1166,6 @@ subroutine get_all_spin_doubles_$N_int(buffer, idx, spindet, size_buffer, double
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
do k=2,$N_int
|
do k=2,$N_int
|
||||||
!DIR$ VECTOR ALIGNED
|
|
||||||
if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then
|
if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then
|
||||||
degree = degree + popcnt(xorvec(k))
|
degree = degree + popcnt(xorvec(k))
|
||||||
endif
|
endif
|
||||||
|
Loading…
Reference in New Issue
Block a user