LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-09 12:44:07 +01:00
Code Issues Releases Wiki Activity

Removed triangle

Browse Source
This commit is contained in:
Anthony Scemama 2017-02-28 13:28:36 +01:00
parent cc53cff932
commit 0dea2e88c5
4 changed files with 103 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
ocaml/Message.ml
View File

@ -150,18 +150,18 @@ end
module AddTask_msg : sig
type 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
end = struct
type 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 =
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
@ -182,44 +182,44 @@ end
module DelTask_msg : sig
type 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
end = struct
type 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 ;
task_id = Id.Task.of_int task_id
task_ids = List.map ~f:Id.Task.of_int task_ids
}
let to_string x =
Printf.sprintf "del_task %s %d"
Printf.sprintf "del_task %s %s"
(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
(** DelTaskReply : Reply to the DelTask message *)
module DelTaskReply_msg : sig
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
end = struct
type t = {
task_id : Id.Task.t ;
task_ids : Id.Task.t list;
more : bool;
}
let create ~task_id ~more = { task_id ; more }
let create ~task_ids ~more = { task_ids ; more }
let to_string x =
let more =
if x.more then "more"
else "done"
in
Printf.sprintf "del_task_reply %s %d"
more (Id.Task.to_int x.task_id)
Printf.sprintf "del_task_reply %s %s"
more (String.concat ~sep:"|" @@ List.map ~f:Id.Task.to_string x.task_ids)
end
@ -460,27 +460,27 @@ module TaskDone_msg : sig
type t =
{ client_id: Id.Client.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
end = struct
type t =
{ client_id: Id.Client.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 ;
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 =
Printf.sprintf "task_done %s %d %d"
Printf.sprintf "task_done %s %d %s"
(State.to_string x.state)
(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
(** Terminate *)
@ -550,14 +550,14 @@ type t =
let of_string s =
let open Message_lexer in
match parse s with
| AddTask_ { state ; task } ->
AddTask (AddTask_msg.create ~state ~task)
| DelTask_ { state ; task_id } ->
DelTask (DelTask_msg.create ~state ~task_id)
| AddTask_ { state ; tasks } ->
AddTask (AddTask_msg.create ~state ~tasks)
| DelTask_ { state ; task_ids } ->
DelTask (DelTask_msg.create ~state ~task_ids)
| GetTask_ { state ; client_id } ->
GetTask (GetTask_msg.create ~state ~client_id)
| TaskDone_ { state ; task_id ; client_id } ->
TaskDone (TaskDone_msg.create ~state ~client_id ~task_id)
| TaskDone_ { state ; task_ids ; client_id } ->
TaskDone (TaskDone_msg.create ~state ~client_id ~task_ids)
| Disconnect_ { state ; client_id } ->
Disconnect (Disconnect_msg.create ~state ~client_id)
| Connect_ socket ->

74
ocaml/Message_lexer.mll
View File

@ -6,7 +6,6 @@ type kw_type =
| INTEGER of int
| FLOAT of float
| NONE
| END_OF_FILE
| ADD_TASK
| DEL_TASK
| GET_TASK
@ -24,19 +23,19 @@ type kw_type =
| SET_RUNNING
| SET_WAITING
type state_task = { state : string ; task : string ; }
type state_taskid = { state : string ; task_id : int ; }
type state_tasks = { state : string ; tasks : string list ; }
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_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 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 msg =
| AddTask_ of state_task
| DelTask_ of state_taskid
| AddTask_ of state_tasks
| DelTask_ of state_taskids
| GetTask_ of state_clientid
| TaskDone_ of state_taskid_clientid
| TaskDone_ of state_taskids_clientid
| Disconnect_ of state_clientid
| Connect_ of string
| NewJob_ of state_tcp_inproc
@ -52,7 +51,7 @@ type msg =
}
let word = [^' ' '\t' '\n']+
let text = [^' ']+[^'\n']+
let text = [^ ' ' '|']+[^ '|']+
let integer = ['0'-'9']+
let real = '-'? integer '.' integer (['e' 'E'] '-'? integer)?
@ -61,11 +60,20 @@ let white = [' ' '\t']+
rule get_text = parse
| 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 }
and kw = parse
| integer as i { INTEGER (int_of_string i) }
| real as r { FLOAT (float_of_string r)}
| "add_task" { ADD_TASK }
| "del_task" { DEL_TASK }
| "get_task" { GET_TASK }
@ -82,24 +90,23 @@ and kw = parse
| "set_stopped" { SET_STOPPED }
| "set_running" { SET_RUNNING }
| "set_waiting" { SET_WAITING }
| word as w { WORD w }
| eof { END_OF_FILE }
| _ { NONE }
{
let rec read_text lexbuf =
let rec read_text ?(accu=[]) lexbuf =
let token =
get_text lexbuf
in
match token with
| TEXT t -> t
| NONE -> read_text lexbuf
| TEXT t -> read_text ~accu:(t::accu) lexbuf
| TERMINATE -> List.rev accu
| NONE -> read_text ~accu lexbuf
| _ -> failwith "Error in MessageLexer (2)"
and read_word lexbuf =
let token =
kw lexbuf
get_word lexbuf
in
match token with
| WORD w -> w
@ -108,13 +115,23 @@ and kw = parse
and read_int lexbuf =
let token =
kw lexbuf
get_int lexbuf
in
match token with
| INTEGER i -> i
| NONE -> read_int lexbuf
| _ -> 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 =
let token =
kw lexbuf
@ -122,13 +139,13 @@ and kw = parse
match token with
| ADD_TASK ->
let state = read_word lexbuf in
let task = read_text lexbuf in
AddTask_ { state ; task }
let tasks = read_text lexbuf in
AddTask_ { state ; tasks }
| DEL_TASK ->
let state = read_word lexbuf in
let task_id = read_int lexbuf in
DelTask_ { state ; task_id }
let task_ids = read_ints lexbuf in
DelTask_ { state ; task_ids }
| GET_TASK ->
let state = read_word lexbuf in
@ -138,8 +155,8 @@ and kw = parse
| TASK_DONE ->
let state = read_word lexbuf in
let client_id = read_int lexbuf in
let task_id = read_int lexbuf in
TaskDone_ { state ; task_id ; client_id }
let task_ids = read_ints lexbuf in
TaskDone_ { state ; task_ids ; client_id }
| DISCONNECT ->
let state = read_word lexbuf in
@ -177,7 +194,7 @@ and kw = parse
EndJob_ state
| ERROR ->
let message = read_text lexbuf in
let message = List.hd (read_text lexbuf) in
Error_ message
| OK -> Ok_
@ -198,9 +215,12 @@ and kw = parse
let debug () =
let l = [
"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 | 6789 | 10 | 11" ;
"get_task state_pouet 12" ;
"task_done state_pouet 12 12345";
"task_done state_pouet 12 12345 | 678 | 91011";
"connect tcp";
"disconnect state_pouet 12";
"new_job state_pouet tcp://test.com:12345 ipc:///dev/shm/x.socket";
@ -218,10 +238,10 @@ and kw = parse
|> List.map parse
in
List.map (function
| AddTask_ { state ; task } -> Printf.sprintf "ADD_TASK state:\"%s\" task:\"%s\"" state task
| DelTask_ { state ; task_id } -> Printf.sprintf "DEL_TASK state:\"%s\" task_id:%d" state task_id
| AddTask_ { state ; tasks } -> Printf.sprintf "ADD_TASK state:\"%s\" tasks:{\"%s\"}" state (String.concat "\"}|{\"" tasks)
| 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
| 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
| 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

77
ocaml/TaskServer.ml
View File

@ -289,9 +289,9 @@ let disconnect 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.task_id
msg.Message.DelTask_msg.task_ids
in
let failure () =
@ -302,13 +302,14 @@ let del_task msg program_state rep_socket =
let new_program_state =
{ 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
let more =
(Queuing_system.number_of_tasks new_program_state.queue > 0)
in
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_id ~more)
Message.DelTaskReply (Message.DelTaskReply_msg.create ~task_ids ~more)
|> Message.to_string
|> ZMQ.Socket.send ~block:true rep_socket ; (** /!\ Has to be blocking *)
new_program_state
@ -329,9 +330,9 @@ let del_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.task
msg.Message.AddTask_msg.tasks
in
let increment_progress_bar = function
@ -339,59 +340,12 @@ let add_task msg program_state rep_socket =
| None -> None
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 =
String.split ~on:' ' task
|> List.filter ~f:(fun x -> x <> "")
|> new_program_state
{ program_state with
queue = List.fold ~f:(fun queue task -> Queuing_system.add_task ~task queue)
~init:program_state.queue tasks ;
progress_bar = increment_progress_bar program_state.progress_bar ;
}
in
reply_ok rep_socket;
result
@ -448,10 +402,10 @@ let get_task msg program_state rep_socket pair_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.client_id,
msg.Message.TaskDone_msg.task_id
msg.Message.TaskDone_msg.task_ids
in
let increment_progress_bar = function
@ -466,7 +420,8 @@ let task_done msg program_state rep_socket =
and success () =
let result =
{ 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 ;
}
in

13
src/Integrals_Bielec/ao_bi_integrals.irp.f
View File

@ -346,6 +346,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
integer :: n_integrals, rc
integer :: kk, m, j1, i1, lmax
character*(64) :: fmt
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)
integer(ZMQ_PTR) :: zmq_to_qp_run_socket
character*(32) :: task
call new_parallel_job(zmq_to_qp_run_socket,'ao_integrals')
do l=ao_num,1,-1
write(task,*) "triangle ", l
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
character(len=:), allocatable :: task
allocate(character(len=ao_num*12) :: 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
deallocate(task)
call zmq_set_running(zmq_to_qp_run_socket)