From 514b13bc2fa5c7619e459dba63a41544d5cb87f2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 26 Nov 2017 23:47:11 +0100 Subject: [PATCH] Introduced put/get in OCaml --- ocaml/Message.ml | 394 +++++------------------- ocaml/Message_lexer.mll | 59 +--- ocaml/TaskServer.ml | 134 +++----- ocaml/TaskServer.mli | 10 +- plugins/Selectors_full/zmq.irp.f | 334 +++++++++++++++++--- src/Davidson/davidson_parallel.irp.f | 95 +----- src/Determinants/density_matrix.irp.f | 50 ++- src/Determinants/mono_excitations.irp.f | 2 +- src/Determinants/s2.irp.f | 1 - src/Determinants/slater_rules.irp.f | 1 - src/Determinants/spindeterminants.irp.f | 14 - 11 files changed, 437 insertions(+), 657 deletions(-) diff --git a/ocaml/Message.ml b/ocaml/Message.ml index 2ffd1da1..b5de7e83 100644 --- a/ocaml/Message.ml +++ b/ocaml/Message.ml @@ -264,304 +264,74 @@ end = struct Printf.sprintf "get_task_reply 0" end -(** GetPsi : get the current variational wave function *) -module GetPsi_msg : sig - type t = - { client_id: Id.Client.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_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 ; - n_state ; n_det ; psi_det_size ; n_det_generators ; - n_det_selectors ; psi } - - let to_string x = - match x.n_det_generators, x.n_det_selectors with - | Some g, Some 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) - (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 - -(** PutPsiReply_msg : Reply to the PutPsi message *) -module PutPsiReply_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_psi_reply %d" - (Id.Client.to_int x.client_id) -end - - -(** GetVector : get the current vector (Davidson) *) -module GetVector_msg : sig - type t = - { client_id: Id.Client.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 +(** PutData: put some data in the hash table *) +module PutData_msg : sig type t = - { client_id : Id.Client.t ; - vector : Vector.t } - val create : client_id:Id.Client.t -> vector:Vector.t -> t + { client_id : Id.Client.t ; + key : string; } + val create : client_id: int -> key: string -> t val to_string : t -> string - val to_string_list : t -> string list end = struct - type t = - { client_id : Id.Client.t ; - vector : Vector.t } - let create ~client_id ~vector = - { client_id ; vector } - let to_string x = - Printf.sprintf "get_vector_reply %d %d" - (Id.Client.to_int x.client_id) - (Strictly_positive_int.to_int x.vector.Vector.size) - let to_string_list x = - [ to_string x ; x.vector.Vector.data ] -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 + type t = + { client_id : Id.Client.t ; + key : string; } + let create ~client_id ~key = { client_id = Id.Client.of_int client_id ; - vector ; size - } - + key ; } 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" + Printf.sprintf "put_data %d %s" + (Id.Client.to_int x.client_id) x.key end -(** PutVectorReply_msg : Reply to the PutVector message *) -module PutVectorReply_msg : sig + +(** PutDataReply_msg : Reply to the PutData message *) +module PutDataReply_msg : sig type t - val create : client_id:Id.Client.t -> t + val create : unit -> t val to_string : t -> string end = struct - type t = - { client_id : Id.Client.t ; - } - let create ~client_id = - { client_id; } + 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 +end = struct + type t = + { client_id : Id.Client.t ; + key : string } + let create ~client_id ~key = + { client_id = Id.Client.of_int client_id ; key } let to_string x = - Printf.sprintf "put_vector_reply %d" - (Id.Client.to_int x.client_id) + Printf.sprintf "get_data %d %s" + (Id.Client.to_int x.client_id) x.key +end + + +(** GetDataReply_msg : Reply to the GetData message *) +module GetDataReply_msg : sig + type t + val create : value:string -> t + val to_string : t -> string + val to_string_list : t -> string list +end = struct + type t = string + let create ~value = value + let to_string x = + Printf.sprintf "get_data_reply %d %s" + (String.length x) x + let to_string_list x = [ + Printf.sprintf "get_data_reply %d" + (String.length x); x ] end @@ -644,14 +414,10 @@ end (** Message *) type t = -| GetPsi of GetPsi_msg.t -| PutPsi of PutPsi_msg.t -| GetPsiReply of GetPsiReply_msg.t -| PutPsiReply of PutPsiReply_msg.t -| GetVector of GetVector_msg.t -| PutVector of PutVector_msg.t -| GetVectorReply of GetVectorReply_msg.t -| PutVectorReply of PutVectorReply_msg.t +| GetData of GetData_msg.t +| PutData of PutData_msg.t +| GetDataReply of GetDataReply_msg.t +| PutDataReply of PutDataReply_msg.t | Newjob of Newjob_msg.t | Endjob of Endjob_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) | EndJob_ state -> Endjob (Endjob_msg.create state) - | GetPsi_ client_id -> - GetPsi (GetPsi_msg.create ~client_id) - | PutPsi_ { client_id ; n_state ; n_det ; psi_det_size ; n_det_generators ; n_det_selectors } -> - begin - 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 ) + | GetData_ { client_id ; key } -> + GetData (GetData_msg.create ~client_id ~key) + | PutData_ { client_id ; key } -> + PutData (PutData_msg.create ~client_id ~key) | Terminate_ -> Terminate (Terminate_msg.create ) | Abort_ -> Abort (Abort_msg.create ) | SetWaiting_ -> SetWaiting @@ -722,10 +474,10 @@ let of_string s = let to_string = function -| GetPsi x -> GetPsi_msg.to_string x -| PutPsiReply x -> PutPsiReply_msg.to_string x -| GetVector x -> GetVector_msg.to_string x -| PutVectorReply x -> PutVectorReply_msg.to_string x +| GetData x -> GetData_msg.to_string x +| PutData x -> PutData_msg.to_string x +| PutDataReply x -> PutDataReply_msg.to_string x +| GetDataReply x -> GetDataReply_msg.to_string x | Newjob x -> Newjob_msg.to_string x | Endjob x -> Endjob_msg.to_string x | Connect x -> Connect_msg.to_string x @@ -740,21 +492,15 @@ let to_string = function | AddTaskReply x -> AddTaskReply_msg.to_string x | TaskDone x -> TaskDone_msg.to_string x | Terminate x -> Terminate_msg.to_string x -| Abort x -> Abort_msg.to_string x +| Abort x -> Abort_msg.to_string x | Ok x -> Ok_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" | SetRunning -> "set_running" | SetWaiting -> "set_waiting" let to_string_list = function -| PutPsi x -> PutPsi_msg.to_string_list x -| PutVector x -> PutVector_msg.to_string_list x -| GetVectorReply x -> GetVectorReply_msg.to_string_list x +| GetDataReply x -> GetDataReply_msg.to_string_list x | _ -> assert false diff --git a/ocaml/Message_lexer.mll b/ocaml/Message_lexer.mll index f01a3eec..4d5bc702 100644 --- a/ocaml/Message_lexer.mll +++ b/ocaml/Message_lexer.mll @@ -16,10 +16,8 @@ type kw_type = | END_JOB | TERMINATE | ABORT - | GET_PSI - | PUT_PSI - | GET_VECTOR - | PUT_VECTOR + | GET_DATA + | PUT_DATA | OK | ERROR | 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 psi = { client_id: int ; n_state: int ; n_det: int ; psi_det_size: int ; 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 = | AddTask_ of state_tasks @@ -46,10 +44,8 @@ type msg = | EndJob_ of string | Terminate_ | Abort_ - | GetPsi_ of int - | PutPsi_ of psi - | GetVector_ of int - | PutVector_ of vector + | GetData_ of client_id_key + | PutData_ of client_id_key | Ok_ | Error_ of string | SetStopped_ @@ -89,12 +85,10 @@ and kw = parse | "connect" { CONNECT } | "new_job" { NEW_JOB } | "end_job" { END_JOB } + | "put_data" { PUT_DATA } + | "get_data" { GET_DATA } | "terminate" { TERMINATE } | "abort" { ABORT } - | "get_psi" { GET_PSI } - | "put_psi" { PUT_PSI } - | "get_vector" { GET_PSI } - | "put_vector" { PUT_PSI } | "ok" { OK } | "error" { ERROR } | "set_stopped" { SET_STOPPED } @@ -173,30 +167,15 @@ and kw = parse let client_id = read_int lexbuf in Disconnect_ { state ; client_id } - | GET_PSI -> + | GET_DATA -> let client_id = read_int lexbuf in - GetPsi_ client_id + let key = read_word lexbuf in + GetData_ { client_id ; key } - | PUT_PSI -> - let client_id = read_int lexbuf in - let n_state = read_int lexbuf in - let n_det = read_int lexbuf in - 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 -> + | PUT_DATA -> 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 } + let key = read_word lexbuf in + PutData_ { client_id ; key } | CONNECT -> let socket = read_word lexbuf in @@ -267,16 +246,8 @@ and kw = parse | 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 | EndJob_ state -> Printf.sprintf "END_JOB state:\"%s\"" state - | GetPsi_ client_id -> Printf.sprintf "GET_PSI client_id:%d" client_id - | PutPsi_ { client_id ; n_state ; n_det ; psi_det_size ; n_det_generators ; n_det_selectors } -> - 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 + | GetData_ { client_id; key } -> Printf.sprintf "GET_DATA client_id:%d key:%s" client_id key + | PutData_ { client_id ; key } -> Printf.sprintf "PUT_DATA client_id:%d key:%s" client_id key | Terminate_ -> "TERMINATE" | Abort_ -> "ABORT" | SetWaiting_ -> "SET_WAITING" diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 68fa133f..103265fd 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -25,10 +25,9 @@ type t = state : Message.State.t option ; address_tcp : Address.Tcp.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 ; running : bool; + data : (string, string) Hashtbl.t; } @@ -458,104 +457,48 @@ let task_done msg program_state rep_socket = end -let put_psi msg rest_of_msg program_state rep_socket = - let psi_local = - 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; +let put_data msg rest_of_msg program_state rep_socket = - new_program_state - - -let get_psi msg program_state rep_socket = - 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 - | [ x ] -> x - | _ -> failwith "Badly formed put_vector message" - in - Message.Vector.create - ~size:msg.Message.PutVector_msg.size - ~data - 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 - |> 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 + debug (Message.PutData_msg.to_string msg); + let () = + let key, value = + msg.Message.PutData_msg.key, + match rest_of_msg with + | [ x ] -> x + | _ -> failwith "Badly formed put_data message" in - match program_state.vector with - | None -> failwith "No wave function saved in TaskServer" - | Some vector -> - Message.GetVectorReply (Message.GetVectorReply_msg.create ~client_id ~vector) - |> Message.to_string_list - |> ZMQ.Socket.send_all rep_socket; - program_state + Hashtbl.set program_state.data ~key ~data:value ; + + Message.PutDataReply (Message.PutDataReply_msg.create ()) + |> Message.to_string + |> ZMQ.Socket.send rep_socket + in + program_state + +let get_data msg program_state rep_socket = + + 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 + |> ZMQ.Socket.send_all rep_socket + in + program_state let terminate program_state rep_socket = reply_ok rep_socket; { program_state with - psi = None; - vector = None; address_tcp = None; address_inproc = None; running = false @@ -675,12 +618,11 @@ let run ~port = let initial_program_state = { queue = Queuing_system.create () ; running = true ; - psi = None; - vector = None; state = None; address_tcp = None; address_inproc = None; progress_bar = None ; + data = Hashtbl.create ~hashable:String.hashable (); } in @@ -747,10 +689,8 @@ let run ~port = match program_state.state, message with | _ , Message.Terminate _ -> terminate program_state rep_socket | _ , Message.Abort _ -> abort program_state rep_socket - | _ , Message.PutVector x -> put_vector x rest program_state rep_socket - | _ , Message.GetVector x -> get_vector 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 + | _ , Message.PutData x -> put_data x rest program_state rep_socket + | _ , Message.GetData x -> get_data x program_state rep_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 | Some _, Message.Endjob x -> end_job x program_state rep_socket pair_socket diff --git a/ocaml/TaskServer.mli b/ocaml/TaskServer.mli index 4f93dc77..0fe5c2dc 100644 --- a/ocaml/TaskServer.mli +++ b/ocaml/TaskServer.mli @@ -4,10 +4,9 @@ type t = state : Message.State.t option ; address_tcp : Address.Tcp.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 ; 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 *) 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 *) val error : string -> t -> [> `Req ] ZMQ.Socket.t -> t diff --git a/plugins/Selectors_full/zmq.irp.f b/plugins/Selectors_full/zmq.irp.f index 88f7fa06..6f19b7f4 100644 --- a/plugins/Selectors_full/zmq.irp.f +++ b/plugins/Selectors_full/zmq.irp.f @@ -12,42 +12,201 @@ subroutine zmq_put_psi(zmq_to_qp_run_socket,worker_id, energy, size_energy) integer*8 :: rc8 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) 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' 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_8*N_det*bit_kind,ZMQ_SNDMORE)' - 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)' + rc = f77_zmq_send(zmq_to_qp_run_socket,x,size_x*8,0) + if (rc /= size_x*8) then + print *, irp_here, ': Error sending '//name stop 'error' endif 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 *, 'Error in put_psi_reply' + print *, irp_here, ': Error in put_data_reply' stop 'error' endif 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) use f77_zmq @@ -63,59 +222,132 @@ subroutine zmq_get_psi(zmq_to_qp_run_socket, worker_id, energy, size_energy) integer*8 :: rc8 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) 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' endif 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 *, 'Error in get_psi_reply' + print *, irp_here, ': Error in get_data_reply' stop 'error' 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) 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' endif 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 - 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' 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 +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 + + + diff --git a/src/Davidson/davidson_parallel.irp.f b/src/Davidson/davidson_parallel.irp.f index 0b229e49..a1c1a37e 100644 --- a/src/Davidson/davidson_parallel.irp.f +++ b/src/Davidson/davidson_parallel.irp.f @@ -36,7 +36,7 @@ subroutine davidson_run_slave(thread,iproc) zmq_socket_push = new_zmq_push_socket(thread) call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) 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_push_socket(zmq_socket_push,thread) 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 (energy(N_st)) if (mpi_master) then - write(msg, *) 'get_psi ', worker_id - rc = f77_zmq_send(zmq_to_qp_run_socket,trim(msg),len(trim(msg)),0) - 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 + call zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'u_t', u_t, size(u_t)) + call zmq_get_dvector(zmq_to_qp_run_socket, worker_id, 'energy', energy, size(energy)) endif @@ -132,13 +89,6 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze, include 'mpif.h' 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)) @@ -358,40 +308,13 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze) integer :: rc integer*8 :: rc8 double precision :: energy(N_st) + energy = 0.d0 - task = ' ' - write(task,*) 'put_psi ', 1, N_st, N_det, N_det - rc = f77_zmq_send(zmq_to_qp_run_socket,trim(task),len(trim(task)),ZMQ_SNDMORE) - if (rc /= len(trim(task))) then - 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 + call zmq_put_N_states_diag(zmq_to_qp_run_socket, 1) + call zmq_put_psi_det(zmq_to_qp_run_socket, 1) + call zmq_put_dvector(zmq_to_qp_run_socket, 1, 'u_t', u_t, size(u_t)) + call zmq_put_dvector(zmq_to_qp_run_socket, 1, 'energy', energy, size(energy)) deallocate(u_t) diff --git a/src/Determinants/density_matrix.irp.f b/src/Determinants/density_matrix.irp.f index 4fa33daa..b948182d 100644 --- a/src/Determinants/density_matrix.irp.f +++ b/src/Determinants/density_matrix.irp.f @@ -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_beta_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,mo_tot_num) ] implicit none BEGIN_DOC ! 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 - 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 integer :: i,j,ispin,istate ispin = 1 @@ -65,7 +65,7 @@ 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 integer :: i,j,ispin,istate ispin = 1 @@ -92,8 +92,8 @@ 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_beta, (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,mo_tot_num,N_states) ] implicit none BEGIN_DOC ! 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 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 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 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_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_b = 0.d0 !$OMP DO SCHEDULE(guided) @@ -205,8 +205,8 @@ 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_beta, (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,mo_tot_num) ] implicit none BEGIN_DOC ! 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 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 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) - 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_b = 0.d0 !$OMP DO SCHEDULE(dynamic) @@ -288,7 +288,7 @@ END_PROVIDER !$OMP END PARALLEL 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 BEGIN_DOC ! 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 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 BEGIN_DOC ! rho(alpha) - rho(beta) @@ -336,7 +336,7 @@ BEGIN_PROVIDER [ double precision, state_average_weight, (N_states) ] 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 ! one body spin density matrix on the AO basis : rho_AO(alpha) - rho_AO(beta) END_DOC @@ -360,10 +360,8 @@ BEGIN_PROVIDER [ double precision, one_body_spin_density_ao, (ao_num_align,ao_nu END_PROVIDER - BEGIN_PROVIDER [ double precision, one_body_dm_ao_alpha, (ao_num_align,ao_num) ] -&BEGIN_PROVIDER [ double precision, one_body_dm_ao_beta, (ao_num_align,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_PROVIDER [ double precision, one_body_dm_ao_alpha, (ao_num,ao_num) ] +&BEGIN_PROVIDER [ double precision, one_body_dm_ao_beta, (ao_num,ao_num) ] BEGIN_DOC ! one body density matrix on the AO basis : rho_AO(alpha) , rho_AO(beta) END_DOC @@ -386,18 +384,12 @@ END_PROVIDER 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 - 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_beta_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,mo_tot_num,N_states) ] implicit none BEGIN_DOC ! 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 tmp_a, tmp_b, n_occ)& !$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) - 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_b = 0.d0 !$OMP DO SCHEDULE(dynamic) diff --git a/src/Determinants/mono_excitations.irp.f b/src/Determinants/mono_excitations.irp.f index ab0d5af3..9b8d55f4 100644 --- a/src/Determinants/mono_excitations.irp.f +++ b/src/Determinants/mono_excitations.irp.f @@ -19,7 +19,7 @@ BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)] 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 integer :: i0,j0,i,j,k0,k integer :: n_occ_ab(2) diff --git a/src/Determinants/s2.irp.f b/src/Determinants/s2.irp.f index 0340361d..1df4721e 100644 --- a/src/Determinants/s2.irp.f +++ b/src/Determinants/s2.irp.f @@ -10,7 +10,6 @@ double precision function diag_S_mat_elem(key_i,Nint) END_DOC integer :: nup, i integer(bit_kind) :: xorvec(N_int_max) - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec do i=1,Nint xorvec(i) = xor(key_i(i,1),key_i(i,2)) diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index eb128715..f3dd1441 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -11,7 +11,6 @@ subroutine get_excitation_degree(key1,key2,degree,Nint) integer, intent(out) :: degree integer(bit_kind) :: xorvec(2*N_int_max) - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec integer :: l ASSERT (Nint > 0) diff --git a/src/Determinants/spindeterminants.irp.f b/src/Determinants/spindeterminants.irp.f index 1d873af8..136872b4 100644 --- a/src/Determinants/spindeterminants.irp.f +++ b/src/Determinants/spindeterminants.irp.f @@ -943,7 +943,6 @@ subroutine get_all_spin_singles_and_doubles_1(buffer, idx, spindet, size_buffer, n_singles = 1 n_doubles = 1 - !DIR$ VECTOR ALIGNED do i=1,size_buffer degree = popcnt( xor( spindet, buffer(i) ) ) if ( degree == 4 ) then @@ -1011,7 +1010,6 @@ subroutine get_all_spin_doubles_1(buffer, idx, spindet, size_buffer, doubles, n_ integer :: degree n_doubles = 1 - !DIR$ VECTOR ALIGNED do i=1,size_buffer degree = popcnt(xor( spindet, buffer(i) )) 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 :: degree - integer, external :: align_double - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree n_singles = 1 n_doubles = 1 - !DIR$ VECTOR ALIGNED do i=1,size_buffer do k=1,$N_int @@ -1069,7 +1063,6 @@ subroutine get_all_spin_singles_and_doubles_$N_int(buffer, idx, spindet, size_bu endif do k=2,$N_int - !DIR$ VECTOR ALIGNED if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then degree = degree + popcnt(xorvec(k)) 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 :: degree - integer, external :: align_double - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec - n_singles = 1 - !DIR$ VECTOR ALIGNED do i=1,size_buffer 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) n_doubles = 1 - !DIR$ VECTOR ALIGNED do i=1,size_buffer do k=1,$N_int @@ -1179,7 +1166,6 @@ subroutine get_all_spin_doubles_$N_int(buffer, idx, spindet, size_buffer, double endif do k=2,$N_int - !DIR$ VECTOR ALIGNED if ( (degree <= 4).and.(xorvec(k) /= 0_8) ) then degree = degree + popcnt(xorvec(k)) endif