mirror of
https://github.com/LCPQ/quantum_package
synced 2024-07-03 01:45:59 +02:00
Removed triangle
This commit is contained in:
parent
cc53cff932
commit
0dea2e88c5
|
@ -150,18 +150,18 @@ end
|
||||||
module AddTask_msg : sig
|
module AddTask_msg : sig
|
||||||
type t =
|
type t =
|
||||||
{ state: State.t;
|
{ state: State.t;
|
||||||
task: string;
|
tasks: string list;
|
||||||
}
|
}
|
||||||
val create : state:string -> task:string -> t
|
val create : state:string -> tasks:string list -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
end = struct
|
end = struct
|
||||||
type t =
|
type t =
|
||||||
{ state: State.t;
|
{ state: State.t;
|
||||||
task: string;
|
tasks: string list;
|
||||||
}
|
}
|
||||||
let create ~state ~task = { state = State.of_string state ; task }
|
let create ~state ~tasks = { state = State.of_string state ; tasks }
|
||||||
let to_string x =
|
let to_string x =
|
||||||
Printf.sprintf "add_task %s %s" (State.to_string x.state) x.task
|
Printf.sprintf "add_task %s %s" (State.to_string x.state) (String.concat ~sep:"|" x.tasks)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -182,44 +182,44 @@ end
|
||||||
module DelTask_msg : sig
|
module DelTask_msg : sig
|
||||||
type t =
|
type t =
|
||||||
{ state: State.t;
|
{ state: State.t;
|
||||||
task_id: Id.Task.t
|
task_ids: Id.Task.t list
|
||||||
}
|
}
|
||||||
val create : state:string -> task_id:int -> t
|
val create : state:string -> task_ids:int list -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
end = struct
|
end = struct
|
||||||
type t =
|
type t =
|
||||||
{ state: State.t;
|
{ state: State.t;
|
||||||
task_id: Id.Task.t
|
task_ids: Id.Task.t list
|
||||||
}
|
}
|
||||||
let create ~state ~task_id =
|
let create ~state ~task_ids =
|
||||||
{ state = State.of_string state ;
|
{ state = State.of_string state ;
|
||||||
task_id = Id.Task.of_int task_id
|
task_ids = List.map ~f:Id.Task.of_int task_ids
|
||||||
}
|
}
|
||||||
let to_string x =
|
let to_string x =
|
||||||
Printf.sprintf "del_task %s %d"
|
Printf.sprintf "del_task %s %s"
|
||||||
(State.to_string x.state)
|
(State.to_string x.state)
|
||||||
(Id.Task.to_int x.task_id)
|
(String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
(** DelTaskReply : Reply to the DelTask message *)
|
(** DelTaskReply : Reply to the DelTask message *)
|
||||||
module DelTaskReply_msg : sig
|
module DelTaskReply_msg : sig
|
||||||
type t
|
type t
|
||||||
val create : task_id:Id.Task.t -> more:bool -> t
|
val create : task_ids:Id.Task.t list -> more:bool -> t
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
end = struct
|
end = struct
|
||||||
type t = {
|
type t = {
|
||||||
task_id : Id.Task.t ;
|
task_ids : Id.Task.t list;
|
||||||
more : bool;
|
more : bool;
|
||||||
}
|
}
|
||||||
let create ~task_id ~more = { task_id ; more }
|
let create ~task_ids ~more = { task_ids ; more }
|
||||||
let to_string x =
|
let to_string x =
|
||||||
let more =
|
let more =
|
||||||
if x.more then "more"
|
if x.more then "more"
|
||||||
else "done"
|
else "done"
|
||||||
in
|
in
|
||||||
Printf.sprintf "del_task_reply %s %d"
|
Printf.sprintf "del_task_reply %s %s"
|
||||||
more (Id.Task.to_int x.task_id)
|
more (String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -460,27 +460,27 @@ module TaskDone_msg : sig
|
||||||
type t =
|
type t =
|
||||||
{ client_id: Id.Client.t ;
|
{ client_id: Id.Client.t ;
|
||||||
state: State.t ;
|
state: State.t ;
|
||||||
task_id: Id.Task.t ;
|
task_ids: Id.Task.t list ;
|
||||||
}
|
}
|
||||||
val create : state:string -> client_id:int -> task_id:int -> t
|
val create : state:string -> client_id:int -> task_ids:int list -> 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 ;
|
||||||
state: State.t ;
|
state: State.t ;
|
||||||
task_id: Id.Task.t;
|
task_ids: Id.Task.t list;
|
||||||
}
|
}
|
||||||
let create ~state ~client_id ~task_id =
|
let create ~state ~client_id ~task_ids =
|
||||||
{ client_id = Id.Client.of_int client_id ;
|
{ client_id = Id.Client.of_int client_id ;
|
||||||
state = State.of_string state ;
|
state = State.of_string state ;
|
||||||
task_id = Id.Task.of_int task_id;
|
task_ids = List.map ~f:Id.Task.of_int task_ids;
|
||||||
}
|
}
|
||||||
|
|
||||||
let to_string x =
|
let to_string x =
|
||||||
Printf.sprintf "task_done %s %d %d"
|
Printf.sprintf "task_done %s %d %s"
|
||||||
(State.to_string x.state)
|
(State.to_string x.state)
|
||||||
(Id.Client.to_int x.client_id)
|
(Id.Client.to_int x.client_id)
|
||||||
(Id.Task.to_int x.task_id)
|
(String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids)
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Terminate *)
|
(** Terminate *)
|
||||||
|
@ -550,14 +550,14 @@ type t =
|
||||||
let of_string s =
|
let of_string s =
|
||||||
let open Message_lexer in
|
let open Message_lexer in
|
||||||
match parse s with
|
match parse s with
|
||||||
| AddTask_ { state ; task } ->
|
| AddTask_ { state ; tasks } ->
|
||||||
AddTask (AddTask_msg.create ~state ~task)
|
AddTask (AddTask_msg.create ~state ~tasks)
|
||||||
| DelTask_ { state ; task_id } ->
|
| DelTask_ { state ; task_ids } ->
|
||||||
DelTask (DelTask_msg.create ~state ~task_id)
|
DelTask (DelTask_msg.create ~state ~task_ids)
|
||||||
| GetTask_ { state ; client_id } ->
|
| GetTask_ { state ; client_id } ->
|
||||||
GetTask (GetTask_msg.create ~state ~client_id)
|
GetTask (GetTask_msg.create ~state ~client_id)
|
||||||
| TaskDone_ { state ; task_id ; client_id } ->
|
| TaskDone_ { state ; task_ids ; client_id } ->
|
||||||
TaskDone (TaskDone_msg.create ~state ~client_id ~task_id)
|
TaskDone (TaskDone_msg.create ~state ~client_id ~task_ids)
|
||||||
| Disconnect_ { state ; client_id } ->
|
| Disconnect_ { state ; client_id } ->
|
||||||
Disconnect (Disconnect_msg.create ~state ~client_id)
|
Disconnect (Disconnect_msg.create ~state ~client_id)
|
||||||
| Connect_ socket ->
|
| Connect_ socket ->
|
||||||
|
|
|
@ -6,7 +6,6 @@ type kw_type =
|
||||||
| INTEGER of int
|
| INTEGER of int
|
||||||
| FLOAT of float
|
| FLOAT of float
|
||||||
| NONE
|
| NONE
|
||||||
| END_OF_FILE
|
|
||||||
| ADD_TASK
|
| ADD_TASK
|
||||||
| DEL_TASK
|
| DEL_TASK
|
||||||
| GET_TASK
|
| GET_TASK
|
||||||
|
@ -24,19 +23,19 @@ type kw_type =
|
||||||
| SET_RUNNING
|
| SET_RUNNING
|
||||||
| SET_WAITING
|
| SET_WAITING
|
||||||
|
|
||||||
type state_task = { state : string ; task : string ; }
|
type state_tasks = { state : string ; tasks : string list ; }
|
||||||
type state_taskid = { state : string ; task_id : int ; }
|
type state_taskids = { state : string ; task_ids : int list ; }
|
||||||
|
type state_taskids_clientid = { state : string ; task_ids : int list ; client_id : int ; }
|
||||||
type state_clientid = { state : string ; client_id : int ; }
|
type state_clientid = { state : string ; client_id : int ; }
|
||||||
type state_taskid_clientid = { state : string ; task_id : int ; 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 msg =
|
type msg =
|
||||||
| AddTask_ of state_task
|
| AddTask_ of state_tasks
|
||||||
| DelTask_ of state_taskid
|
| DelTask_ of state_taskids
|
||||||
| GetTask_ of state_clientid
|
| GetTask_ of state_clientid
|
||||||
| TaskDone_ of state_taskid_clientid
|
| TaskDone_ of state_taskids_clientid
|
||||||
| Disconnect_ of state_clientid
|
| Disconnect_ of state_clientid
|
||||||
| Connect_ of string
|
| Connect_ of string
|
||||||
| NewJob_ of state_tcp_inproc
|
| NewJob_ of state_tcp_inproc
|
||||||
|
@ -52,7 +51,7 @@ type msg =
|
||||||
}
|
}
|
||||||
|
|
||||||
let word = [^' ' '\t' '\n']+
|
let word = [^' ' '\t' '\n']+
|
||||||
let text = [^' ']+[^'\n']+
|
let text = [^ ' ' '|']+[^ '|']+
|
||||||
let integer = ['0'-'9']+
|
let integer = ['0'-'9']+
|
||||||
let real = '-'? integer '.' integer (['e' 'E'] '-'? integer)?
|
let real = '-'? integer '.' integer (['e' 'E'] '-'? integer)?
|
||||||
|
|
||||||
|
@ -61,11 +60,20 @@ let white = [' ' '\t']+
|
||||||
|
|
||||||
rule get_text = parse
|
rule get_text = parse
|
||||||
| text as t { TEXT t }
|
| text as t { TEXT t }
|
||||||
|
| eof { TERMINATE }
|
||||||
|
| _ { NONE }
|
||||||
|
|
||||||
|
and get_int = parse
|
||||||
|
| integer as i { INTEGER (int_of_string i) }
|
||||||
|
| eof { TERMINATE }
|
||||||
|
| _ { NONE }
|
||||||
|
|
||||||
|
and get_word = parse
|
||||||
|
| word as w { WORD w }
|
||||||
|
| eof { TERMINATE }
|
||||||
| _ { NONE }
|
| _ { NONE }
|
||||||
|
|
||||||
and kw = parse
|
and kw = parse
|
||||||
| integer as i { INTEGER (int_of_string i) }
|
|
||||||
| real as r { FLOAT (float_of_string r)}
|
|
||||||
| "add_task" { ADD_TASK }
|
| "add_task" { ADD_TASK }
|
||||||
| "del_task" { DEL_TASK }
|
| "del_task" { DEL_TASK }
|
||||||
| "get_task" { GET_TASK }
|
| "get_task" { GET_TASK }
|
||||||
|
@ -82,24 +90,23 @@ and kw = parse
|
||||||
| "set_stopped" { SET_STOPPED }
|
| "set_stopped" { SET_STOPPED }
|
||||||
| "set_running" { SET_RUNNING }
|
| "set_running" { SET_RUNNING }
|
||||||
| "set_waiting" { SET_WAITING }
|
| "set_waiting" { SET_WAITING }
|
||||||
| word as w { WORD w }
|
|
||||||
| eof { END_OF_FILE }
|
|
||||||
| _ { NONE }
|
| _ { NONE }
|
||||||
|
|
||||||
|
|
||||||
{
|
{
|
||||||
let rec read_text lexbuf =
|
let rec read_text ?(accu=[]) lexbuf =
|
||||||
let token =
|
let token =
|
||||||
get_text lexbuf
|
get_text lexbuf
|
||||||
in
|
in
|
||||||
match token with
|
match token with
|
||||||
| TEXT t -> t
|
| TEXT t -> read_text ~accu:(t::accu) lexbuf
|
||||||
| NONE -> read_text lexbuf
|
| TERMINATE -> List.rev accu
|
||||||
|
| NONE -> read_text ~accu lexbuf
|
||||||
| _ -> failwith "Error in MessageLexer (2)"
|
| _ -> failwith "Error in MessageLexer (2)"
|
||||||
|
|
||||||
and read_word lexbuf =
|
and read_word lexbuf =
|
||||||
let token =
|
let token =
|
||||||
kw lexbuf
|
get_word lexbuf
|
||||||
in
|
in
|
||||||
match token with
|
match token with
|
||||||
| WORD w -> w
|
| WORD w -> w
|
||||||
|
@ -108,13 +115,23 @@ and kw = parse
|
||||||
|
|
||||||
and read_int lexbuf =
|
and read_int lexbuf =
|
||||||
let token =
|
let token =
|
||||||
kw lexbuf
|
get_int lexbuf
|
||||||
in
|
in
|
||||||
match token with
|
match token with
|
||||||
| INTEGER i -> i
|
| INTEGER i -> i
|
||||||
| NONE -> read_int lexbuf
|
| NONE -> read_int lexbuf
|
||||||
| _ -> failwith "Error in MessageLexer (4)"
|
| _ -> failwith "Error in MessageLexer (4)"
|
||||||
|
|
||||||
|
and read_ints ?(accu=[]) lexbuf =
|
||||||
|
let token =
|
||||||
|
get_int lexbuf
|
||||||
|
in
|
||||||
|
match token with
|
||||||
|
| INTEGER i -> read_ints ~accu:(i::accu) lexbuf
|
||||||
|
| TERMINATE -> List.rev accu
|
||||||
|
| NONE -> read_ints ~accu lexbuf
|
||||||
|
| _ -> failwith "Error in MessageLexer (4)"
|
||||||
|
|
||||||
and parse_rec lexbuf =
|
and parse_rec lexbuf =
|
||||||
let token =
|
let token =
|
||||||
kw lexbuf
|
kw lexbuf
|
||||||
|
@ -122,13 +139,13 @@ and kw = parse
|
||||||
match token with
|
match token with
|
||||||
| ADD_TASK ->
|
| ADD_TASK ->
|
||||||
let state = read_word lexbuf in
|
let state = read_word lexbuf in
|
||||||
let task = read_text lexbuf in
|
let tasks = read_text lexbuf in
|
||||||
AddTask_ { state ; task }
|
AddTask_ { state ; tasks }
|
||||||
|
|
||||||
| DEL_TASK ->
|
| DEL_TASK ->
|
||||||
let state = read_word lexbuf in
|
let state = read_word lexbuf in
|
||||||
let task_id = read_int lexbuf in
|
let task_ids = read_ints lexbuf in
|
||||||
DelTask_ { state ; task_id }
|
DelTask_ { state ; task_ids }
|
||||||
|
|
||||||
| GET_TASK ->
|
| GET_TASK ->
|
||||||
let state = read_word lexbuf in
|
let state = read_word lexbuf in
|
||||||
|
@ -138,8 +155,8 @@ and kw = parse
|
||||||
| TASK_DONE ->
|
| TASK_DONE ->
|
||||||
let state = read_word lexbuf in
|
let state = read_word lexbuf in
|
||||||
let client_id = read_int lexbuf in
|
let client_id = read_int lexbuf in
|
||||||
let task_id = read_int lexbuf in
|
let task_ids = read_ints lexbuf in
|
||||||
TaskDone_ { state ; task_id ; client_id }
|
TaskDone_ { state ; task_ids ; client_id }
|
||||||
|
|
||||||
| DISCONNECT ->
|
| DISCONNECT ->
|
||||||
let state = read_word lexbuf in
|
let state = read_word lexbuf in
|
||||||
|
@ -177,7 +194,7 @@ and kw = parse
|
||||||
EndJob_ state
|
EndJob_ state
|
||||||
|
|
||||||
| ERROR ->
|
| ERROR ->
|
||||||
let message = read_text lexbuf in
|
let message = List.hd (read_text lexbuf) in
|
||||||
Error_ message
|
Error_ message
|
||||||
|
|
||||||
| OK -> Ok_
|
| OK -> Ok_
|
||||||
|
@ -198,9 +215,12 @@ and kw = parse
|
||||||
let debug () =
|
let debug () =
|
||||||
let l = [
|
let l = [
|
||||||
"add_task state_pouet Task pouet zob" ;
|
"add_task state_pouet Task pouet zob" ;
|
||||||
|
"add_task state_pouet Task pouet zob |Task2 zob | Task3 prout" ;
|
||||||
"del_task state_pouet 12345" ;
|
"del_task state_pouet 12345" ;
|
||||||
|
"del_task state_pouet 12345 | 6789 | 10 | 11" ;
|
||||||
"get_task state_pouet 12" ;
|
"get_task state_pouet 12" ;
|
||||||
"task_done state_pouet 12 12345";
|
"task_done state_pouet 12 12345";
|
||||||
|
"task_done state_pouet 12 12345 | 678 | 91011";
|
||||||
"connect tcp";
|
"connect tcp";
|
||||||
"disconnect state_pouet 12";
|
"disconnect state_pouet 12";
|
||||||
"new_job state_pouet tcp://test.com:12345 ipc:///dev/shm/x.socket";
|
"new_job state_pouet tcp://test.com:12345 ipc:///dev/shm/x.socket";
|
||||||
|
@ -218,10 +238,10 @@ and kw = parse
|
||||||
|> List.map parse
|
|> List.map parse
|
||||||
in
|
in
|
||||||
List.map (function
|
List.map (function
|
||||||
| AddTask_ { state ; task } -> Printf.sprintf "ADD_TASK state:\"%s\" task:\"%s\"" state task
|
| AddTask_ { state ; tasks } -> Printf.sprintf "ADD_TASK state:\"%s\" tasks:{\"%s\"}" state (String.concat "\"}|{\"" tasks)
|
||||||
| DelTask_ { state ; task_id } -> Printf.sprintf "DEL_TASK state:\"%s\" task_id:%d" state task_id
|
| DelTask_ { state ; task_ids } -> Printf.sprintf "DEL_TASK state:\"%s\" task_ids:{%s}" state (String.concat "|" @@ List.map string_of_int task_ids)
|
||||||
| GetTask_ { state ; client_id } -> Printf.sprintf "GET_TASK state:\"%s\" task_id:%d" state client_id
|
| GetTask_ { state ; client_id } -> Printf.sprintf "GET_TASK state:\"%s\" task_id:%d" state client_id
|
||||||
| TaskDone_ { state ; task_id ; client_id } -> Printf.sprintf "TASK_DONE state:\"%s\" task_id:%d client_id:%d" state task_id client_id
|
| TaskDone_ { state ; task_ids ; client_id } -> Printf.sprintf "TASK_DONE state:\"%s\" task_ids:{%s} client_id:%d" state (String.concat "|" @@ List.map string_of_int task_ids) client_id
|
||||||
| Disconnect_ { state ; client_id } -> Printf.sprintf "DISCONNECT state:\"%s\" client_id:%d" state client_id
|
| Disconnect_ { state ; client_id } -> Printf.sprintf "DISCONNECT state:\"%s\" client_id:%d" state client_id
|
||||||
| 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
|
||||||
|
|
|
@ -289,9 +289,9 @@ let disconnect msg program_state rep_socket =
|
||||||
|
|
||||||
let del_task msg program_state rep_socket =
|
let del_task msg program_state rep_socket =
|
||||||
|
|
||||||
let state, task_id =
|
let state, task_ids =
|
||||||
msg.Message.DelTask_msg.state,
|
msg.Message.DelTask_msg.state,
|
||||||
msg.Message.DelTask_msg.task_id
|
msg.Message.DelTask_msg.task_ids
|
||||||
in
|
in
|
||||||
|
|
||||||
let failure () =
|
let failure () =
|
||||||
|
@ -302,13 +302,14 @@ let del_task msg program_state rep_socket =
|
||||||
|
|
||||||
let new_program_state =
|
let new_program_state =
|
||||||
{ program_state with
|
{ program_state with
|
||||||
queue = Queuing_system.del_task ~task_id program_state.queue
|
queue = List.fold ~f:(fun queue task_id -> Queuing_system.del_task ~task_id queue)
|
||||||
|
~init:program_state.queue task_ids
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
let more =
|
let more =
|
||||||
(Queuing_system.number_of_tasks new_program_state.queue > 0)
|
(Queuing_system.number_of_tasks new_program_state.queue > 0)
|
||||||
in
|
in
|
||||||
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_id ~more)
|
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_ids ~more)
|
||||||
|> Message.to_string
|
|> Message.to_string
|
||||||
|> ZMQ.Socket.send ~block:true rep_socket ; (** /!\ Has to be blocking *)
|
|> ZMQ.Socket.send ~block:true rep_socket ; (** /!\ Has to be blocking *)
|
||||||
new_program_state
|
new_program_state
|
||||||
|
@ -329,9 +330,9 @@ let del_task msg program_state rep_socket =
|
||||||
|
|
||||||
let add_task msg program_state rep_socket =
|
let add_task msg program_state rep_socket =
|
||||||
|
|
||||||
let state, task =
|
let state, tasks =
|
||||||
msg.Message.AddTask_msg.state,
|
msg.Message.AddTask_msg.state,
|
||||||
msg.Message.AddTask_msg.task
|
msg.Message.AddTask_msg.tasks
|
||||||
in
|
in
|
||||||
|
|
||||||
let increment_progress_bar = function
|
let increment_progress_bar = function
|
||||||
|
@ -339,59 +340,12 @@ let add_task msg program_state rep_socket =
|
||||||
| None -> None
|
| None -> None
|
||||||
in
|
in
|
||||||
|
|
||||||
let rec add_task_triangle program_state imax = function
|
|
||||||
| 0 -> program_state
|
|
||||||
| i ->
|
|
||||||
let task =
|
|
||||||
Printf.sprintf "%d %d" i imax
|
|
||||||
in
|
|
||||||
let new_program_state =
|
|
||||||
{ program_state with
|
|
||||||
queue = Queuing_system.add_task ~task program_state.queue ;
|
|
||||||
progress_bar = increment_progress_bar program_state.progress_bar ;
|
|
||||||
}
|
|
||||||
in
|
|
||||||
add_task_triangle new_program_state imax (i-1)
|
|
||||||
in
|
|
||||||
|
|
||||||
let rec add_task_range program_state i = function
|
|
||||||
| j when (j < i) -> program_state
|
|
||||||
| j ->
|
|
||||||
let task =
|
|
||||||
Printf.sprintf "%d" j
|
|
||||||
in
|
|
||||||
let new_program_state =
|
|
||||||
{ program_state with
|
|
||||||
queue = Queuing_system.add_task ~task program_state.queue ;
|
|
||||||
progress_bar = increment_progress_bar program_state.progress_bar ;
|
|
||||||
}
|
|
||||||
in
|
|
||||||
add_task_range new_program_state i (j-1)
|
|
||||||
in
|
|
||||||
|
|
||||||
let new_program_state = function
|
|
||||||
| "triangle" :: i_str :: [] ->
|
|
||||||
let imax =
|
|
||||||
Int.of_string i_str
|
|
||||||
in
|
|
||||||
add_task_triangle program_state imax imax
|
|
||||||
| "range" :: i_str :: j_str :: [] ->
|
|
||||||
let i, j =
|
|
||||||
Int.of_string i_str,
|
|
||||||
Int.of_string j_str
|
|
||||||
in
|
|
||||||
add_task_range program_state i j
|
|
||||||
| _ ->
|
|
||||||
{ program_state with
|
|
||||||
queue = Queuing_system.add_task ~task program_state.queue ;
|
|
||||||
progress_bar = increment_progress_bar program_state.progress_bar ;
|
|
||||||
}
|
|
||||||
in
|
|
||||||
|
|
||||||
let result =
|
let result =
|
||||||
String.split ~on:' ' task
|
{ program_state with
|
||||||
|> List.filter ~f:(fun x -> x <> "")
|
queue = List.fold ~f:(fun queue task -> Queuing_system.add_task ~task queue)
|
||||||
|> new_program_state
|
~init:program_state.queue tasks ;
|
||||||
|
progress_bar = increment_progress_bar program_state.progress_bar ;
|
||||||
|
}
|
||||||
in
|
in
|
||||||
reply_ok rep_socket;
|
reply_ok rep_socket;
|
||||||
result
|
result
|
||||||
|
@ -448,10 +402,10 @@ let get_task msg program_state rep_socket pair_socket =
|
||||||
|
|
||||||
let task_done msg program_state rep_socket =
|
let task_done msg program_state rep_socket =
|
||||||
|
|
||||||
let state, client_id, task_id =
|
let state, client_id, task_ids =
|
||||||
msg.Message.TaskDone_msg.state,
|
msg.Message.TaskDone_msg.state,
|
||||||
msg.Message.TaskDone_msg.client_id,
|
msg.Message.TaskDone_msg.client_id,
|
||||||
msg.Message.TaskDone_msg.task_id
|
msg.Message.TaskDone_msg.task_ids
|
||||||
in
|
in
|
||||||
|
|
||||||
let increment_progress_bar = function
|
let increment_progress_bar = function
|
||||||
|
@ -466,7 +420,8 @@ let task_done msg program_state rep_socket =
|
||||||
and success () =
|
and success () =
|
||||||
let result =
|
let result =
|
||||||
{ program_state with
|
{ program_state with
|
||||||
queue = Queuing_system.end_task ~task_id ~client_id program_state.queue ;
|
queue = List.fold ~f:(fun queue task_id -> Queuing_system.end_task ~task_id
|
||||||
|
~client_id queue) ~init:program_state.queue task_ids ;
|
||||||
progress_bar = increment_progress_bar program_state.progress_bar ;
|
progress_bar = increment_progress_bar program_state.progress_bar ;
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
|
|
|
@ -346,6 +346,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
|
||||||
|
|
||||||
integer :: n_integrals, rc
|
integer :: n_integrals, rc
|
||||||
integer :: kk, m, j1, i1, lmax
|
integer :: kk, m, j1, i1, lmax
|
||||||
|
character*(64) :: fmt
|
||||||
|
|
||||||
integral = ao_bielec_integral(1,1,1,1)
|
integral = ao_bielec_integral(1,1,1,1)
|
||||||
|
|
||||||
|
@ -365,14 +366,16 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
|
||||||
call cpu_time(cpu_1)
|
call cpu_time(cpu_1)
|
||||||
|
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
|
||||||
character*(32) :: task
|
|
||||||
|
|
||||||
call new_parallel_job(zmq_to_qp_run_socket,'ao_integrals')
|
call new_parallel_job(zmq_to_qp_run_socket,'ao_integrals')
|
||||||
|
|
||||||
do l=ao_num,1,-1
|
character(len=:), allocatable :: task
|
||||||
write(task,*) "triangle ", l
|
allocate(character(len=ao_num*12) :: task)
|
||||||
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
|
||||||
|
do l=1,ao_num
|
||||||
|
write(task,fmt) (i,l, i=1,l)
|
||||||
|
call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task))
|
||||||
enddo
|
enddo
|
||||||
|
deallocate(task)
|
||||||
|
|
||||||
call zmq_set_running(zmq_to_qp_run_socket)
|
call zmq_set_running(zmq_to_qp_run_socket)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user