From 0dea2e88c5e39a2752732b5f5343dd64ddf6fbd2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 28 Feb 2017 13:28:36 +0100 Subject: [PATCH] Removed triangle --- ocaml/Message.ml | 60 ++++++++--------- ocaml/Message_lexer.mll | 78 ++++++++++++++-------- ocaml/TaskServer.ml | 77 +++++---------------- src/Integrals_Bielec/ao_bi_integrals.irp.f | 13 ++-- 4 files changed, 103 insertions(+), 125 deletions(-) diff --git a/ocaml/Message.ml b/ocaml/Message.ml index 3a1f5c57..2ed38864 100644 --- a/ocaml/Message.ml +++ b/ocaml/Message.ml @@ -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 -> diff --git a/ocaml/Message_lexer.mll b/ocaml/Message_lexer.mll index 45ffc4d4..c67f4528 100644 --- a/ocaml/Message_lexer.mll +++ b/ocaml/Message_lexer.mll @@ -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 state = read_word lexbuf in + let task_ids = read_ints lexbuf in + DelTask_ { state ; task_ids } | GET_TASK -> let state = read_word lexbuf in @@ -137,9 +154,9 @@ 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 client_id = read_int lexbuf in + 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 diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 9d830437..7013b671 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -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 diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index 68a7a050..196bfce4 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -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)