From 2ea2bf2e362d330456d777163b514558503cefad Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 1 Dec 2015 23:06:52 +0100 Subject: [PATCH 01/47] Save wavefunction in CISD --- plugins/CISD_selected/cisd_selection.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/CISD_selected/cisd_selection.irp.f b/plugins/CISD_selected/cisd_selection.irp.f index b2178860..22169776 100644 --- a/plugins/CISD_selected/cisd_selection.irp.f +++ b/plugins/CISD_selected/cisd_selection.irp.f @@ -31,9 +31,9 @@ program cisd print *, 'PT2 = ', pt2(i) print *, 'E = ', CI_energy(i) print *, 'E_before +PT2 = ', (E_old(i)+pt2(i)) -! print *, 'E+PT2_new= ', (E_old(1)+1.d0*pt2(1)+H_pert_diag(1))/(1.d0 +norm_pert(1)) enddo E_old = CI_energy + call save_wavefunction if (abort_all) then exit endif @@ -42,7 +42,7 @@ program cisd touch N_det psi_det psi_coef call diagonalize_CI deallocate(pt2,norm_pert,H_pert_diag) - call save_wavefunction + call save_wavefunction call ezfio_set_cisd_selected_energy(CI_energy) call ezfio_set_cisd_selected_energy_pt2(CI_energy+pt2) end From 408862dc1b930bd2e4422bde4abbe9d28959c6ed Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 1 Dec 2015 23:16:04 +0100 Subject: [PATCH 02/47] Exists -> exist --- ocaml/qp_edit.ml | 2 +- ocaml/qp_print.ml | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index f6a2ac9c..24a61b78 100644 --- a/ocaml/qp_edit.ml +++ b/ocaml/qp_edit.ml @@ -169,7 +169,7 @@ let run check_only ezfio_filename = (* Open EZFIO *) if (not (Sys.file_exists_exn ezfio_filename)) then - failwith (ezfio_filename^" does not exists"); + failwith (ezfio_filename^" does not exist"); Ezfio.set_file ezfio_filename; diff --git a/ocaml/qp_print.ml b/ocaml/qp_print.ml index 4edb2f8e..ec584066 100644 --- a/ocaml/qp_print.ml +++ b/ocaml/qp_print.ml @@ -41,7 +41,7 @@ let run_i ~action ezfio_filename = let action = create_i_action action in if (not (Sys.file_exists_exn ezfio_filename)) then - failwith (ezfio_filename^" does not exists"); + failwith (ezfio_filename^" does not exist"); Ezfio.set_file ezfio_filename; @@ -133,7 +133,7 @@ let run_i ~action ezfio_filename = let run_o ~action ezfio_filename = if (not (Sys.file_exists_exn ezfio_filename)) then - failwith (ezfio_filename^" does not exists"); + failwith (ezfio_filename^" does not exist"); (* Open EZFIO *) Ezfio.set_file ezfio_filename; From 3a4b41257f63398c26527b3e0fbb5dff008fe031 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 2 Dec 2015 00:32:04 +0100 Subject: [PATCH 03/47] Transposed arrays for pseudos --- src/Integrals_Monoelec/pot_ao_ints.irp.f | 56 +++++++------ .../pot_ao_pseudo_ints.irp.f | 80 ++++++++++++------- 2 files changed, 76 insertions(+), 60 deletions(-) diff --git a/src/Integrals_Monoelec/pot_ao_ints.irp.f b/src/Integrals_Monoelec/pot_ao_ints.irp.f index 09b67425..eadc0b72 100644 --- a/src/Integrals_Monoelec/pot_ao_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_ints.irp.f @@ -26,7 +26,7 @@ n_pt_in = n_pt_max_integrals - !$OMP DO SCHEDULE (guided) + !$OMP DO SCHEDULE (dynamic) do j = 1, ao_num num_A = ao_nucl(j) @@ -81,23 +81,17 @@ integer :: power_A(3),power_B(3) integer :: i,j,k,l,n_pt_in,m double precision ::overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult - ! Important for OpenMP ao_nucl_elec_integral_per_atom = 0.d0 - - do k = 1, nucl_num - C_center(1) = nucl_coord(k,1) - C_center(2) = nucl_coord(k,2) - C_center(3) = nucl_coord(k,3) !$OMP PARALLEL & !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i,j,l,m,alpha,beta,A_center,B_center,power_A,power_B, & - !$OMP num_A,num_B,c,n_pt_in) & - !$OMP SHARED (k,ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp, & - !$OMP n_pt_max_integrals,ao_nucl_elec_integral_per_atom,nucl_num,C_center) + !$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,power_A,power_B, & + !$OMP num_A,num_B,c,n_pt_in,C_center) & + !$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp, & + !$OMP n_pt_max_integrals,ao_nucl_elec_integral_per_atom,nucl_num) n_pt_in = n_pt_max_integrals - !$OMP DO SCHEDULE (guided) + !$OMP DO SCHEDULE (dynamic) double precision :: c do j = 1, ao_num @@ -108,29 +102,33 @@ A_center(1) = nucl_coord(num_A,1) A_center(2) = nucl_coord(num_A,2) A_center(3) = nucl_coord(num_A,3) - do i = 1, ao_num - power_B(1)= ao_power(i,1) - power_B(2)= ao_power(i,2) - power_B(3)= ao_power(i,3) - num_B = ao_nucl(i) - B_center(1) = nucl_coord(num_B,1) - B_center(2) = nucl_coord(num_B,2) - B_center(3) = nucl_coord(num_B,3) - c = 0.d0 - do l=1,ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - do m=1,ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - c = c + NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in) & - * ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i) + do k = 1, nucl_num + C_center(1) = nucl_coord(k,1) + C_center(2) = nucl_coord(k,2) + C_center(3) = nucl_coord(k,3) + do i = 1, ao_num + power_B(1)= ao_power(i,1) + power_B(2)= ao_power(i,2) + power_B(3)= ao_power(i,3) + num_B = ao_nucl(i) + B_center(1) = nucl_coord(num_B,1) + B_center(2) = nucl_coord(num_B,2) + B_center(3) = nucl_coord(num_B,3) + c = 0.d0 + do l=1,ao_prim_num(j) + alpha = ao_expo_ordered_transp(l,j) + do m=1,ao_prim_num(i) + beta = ao_expo_ordered_transp(m,i) + c = c + NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in) & + * ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i) + enddo enddo + ao_nucl_elec_integral_per_atom(i,j,k) = -c enddo - ao_nucl_elec_integral_per_atom(i,j,k) = -c enddo enddo !$OMP END DO !$OMP END PARALLEL - enddo END_PROVIDER diff --git a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f index e18bc006..2856807b 100644 --- a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f @@ -28,12 +28,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu ao_pseudo_integral_local = 0.d0 - !! Dump array - integer, allocatable :: n_k_dump(:) - double precision, allocatable :: v_k_dump(:), dz_k_dump(:) - - allocate(n_k_dump(1:pseudo_klocmax), v_k_dump(1:pseudo_klocmax), dz_k_dump(1:pseudo_klocmax)) - print*, 'Providing the nuclear electron pseudo integrals (local)' call wall_time(wall_1) @@ -44,11 +38,10 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,& !$OMP num_A,num_B,Z,c,n_pt_in, & - !$OMP v_k_dump,n_k_dump, dz_k_dump, & !$OMP wall_0,wall_2,thread_num) & !$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp,& !$OMP ao_pseudo_integral_local,nucl_num,nucl_charge, & - !$OMP pseudo_klocmax,pseudo_lmax,pseudo_kmax,pseudo_v_k,pseudo_n_k, pseudo_dz_k,& + !$OMP pseudo_klocmax,pseudo_lmax,pseudo_kmax,pseudo_v_k_transp,pseudo_n_k_transp, pseudo_dz_k_transp,& !$OMP wall_1) !$ thread_num = omp_get_thread_num() @@ -84,11 +77,10 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu C_center(1:3) = nucl_coord(k,1:3) - v_k_dump = pseudo_v_k(k,1:pseudo_klocmax) - n_k_dump = pseudo_n_k(k,1:pseudo_klocmax) - dz_k_dump = pseudo_dz_k(k,1:pseudo_klocmax) - - c = c + Vloc(pseudo_klocmax, v_k_dump,n_k_dump, dz_k_dump,& + c = c + Vloc(pseudo_klocmax, & + pseudo_v_k_transp (1,k), & + pseudo_n_k_transp (1,k), & + pseudo_dz_k_transp(1,k), & A_center,power_A,alpha,B_center,power_B,beta,C_center) enddo @@ -112,8 +104,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu !$OMP END PARALLEL - deallocate(n_k_dump,v_k_dump, dz_k_dump) - END_PROVIDER @@ -135,12 +125,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu ao_pseudo_integral_non_local = 0.d0 - !! Dump array - integer, allocatable :: n_kl_dump(:,:) - double precision, allocatable :: v_kl_dump(:,:), dz_kl_dump(:,:) - - allocate(n_kl_dump(pseudo_kmax,0:pseudo_lmax), v_kl_dump(pseudo_kmax,0:pseudo_lmax), dz_kl_dump(pseudo_kmax,0:pseudo_lmax)) - print*, 'Providing the nuclear electron pseudo integrals (non-local)' call wall_time(wall_1) @@ -150,14 +134,14 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i,j,k,l,m,alpha,beta,A_center,B_center,C_center,power_A,power_B,& !$OMP num_A,num_B,Z,c,n_pt_in, & - !$OMP n_kl_dump, v_kl_dump, dz_kl_dump, & !$OMP wall_0,wall_2,thread_num) & !$OMP SHARED (ao_num,ao_prim_num,ao_expo_ordered_transp,ao_power,ao_nucl,nucl_coord,ao_coef_normalized_ordered_transp,& !$OMP ao_pseudo_integral_non_local,nucl_num,nucl_charge,& - !$OMP pseudo_klocmax,pseudo_lmax,pseudo_kmax,pseudo_n_kl, pseudo_v_kl, pseudo_dz_kl,& + !$OMP pseudo_klocmax,pseudo_lmax,pseudo_kmax,pseudo_n_kl_transp, pseudo_v_kl_transp, pseudo_dz_kl_transp,& !$OMP wall_1) !$ thread_num = omp_get_thread_num() + !$OMP DO SCHEDULE (guided) do j = 1, ao_num @@ -191,12 +175,11 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu C_center(1:3) = nucl_coord(k,1:3) - n_kl_dump = pseudo_n_kl(k,1:pseudo_kmax,0:pseudo_lmax) - v_kl_dump = pseudo_v_kl(k,1:pseudo_kmax,0:pseudo_lmax) - dz_kl_dump = pseudo_dz_kl(k,1:pseudo_kmax,0:pseudo_lmax) - - c = c + Vpseudo(pseudo_lmax,pseudo_kmax,v_kl_dump,n_kl_dump,dz_kl_dump,A_center,power_A,alpha,B_center,power_B,beta,C_center) - + c = c + Vpseudo(pseudo_lmax,pseudo_kmax, & + pseudo_v_kl_transp(1,0,k), & + pseudo_n_kl_transp(1,0,k), & + pseudo_dz_kl_transp(1,0,k), & + A_center,power_A,alpha,B_center,power_B,beta,C_center) enddo ao_pseudo_integral_non_local(i,j) = ao_pseudo_integral_non_local(i,j) +& ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i)*c @@ -215,13 +198,48 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu enddo !$OMP END DO + !$OMP END PARALLEL - deallocate(n_kl_dump,v_kl_dump, dz_kl_dump) - END_PROVIDER + BEGIN_PROVIDER [ double precision, pseudo_v_k_transp, (pseudo_klocmax,nucl_num) ] +&BEGIN_PROVIDER [ integer , pseudo_n_k_transp, (pseudo_klocmax,nucl_num) ] +&BEGIN_PROVIDER [ double precision, pseudo_dz_k_transp, (pseudo_klocmax,nucl_num)] + implicit none + BEGIN_DOC + ! Transposed arrays for pseudopotentials + END_DOC + integer :: i,j + do j=1,nucl_num + do i=1,pseudo_klocmax + pseudo_v_k_transp (i,j) = pseudo_v_k (j,i) + pseudo_n_k_transp (i,j) = pseudo_n_k (j,i) + pseudo_dz_k_transp(i,j) = pseudo_dz_k(j,i) + enddo + enddo +END_PROVIDER + + BEGIN_PROVIDER [ double precision, pseudo_v_kl_transp, (pseudo_kmax,0:pseudo_lmax,nucl_num) ] +&BEGIN_PROVIDER [ integer , pseudo_n_kl_transp, (pseudo_kmax,0:pseudo_lmax,nucl_num) ] +&BEGIN_PROVIDER [ double precision, pseudo_dz_kl_transp, (pseudo_kmax,0:pseudo_lmax,nucl_num)] + implicit none + BEGIN_DOC + ! Transposed arrays for pseudopotentials + END_DOC + + integer :: i,j,l + do j=1,nucl_num + do l=0,pseudo_lmax + do i=1,pseudo_kmax + pseudo_v_kl_transp (i,l,j) = pseudo_v_kl (j,i,l) + pseudo_n_kl_transp (i,l,j) = pseudo_n_kl (j,i,l) + pseudo_dz_kl_transp(i,l,j) = pseudo_dz_kl(j,i,l) + enddo + enddo + enddo +END_PROVIDER From cdf11866c4194baaef1f403ff53f5be55e8baa61 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 3 Dec 2015 23:51:10 +0100 Subject: [PATCH 04/47] Created task server in ocaml --- ocaml/Address.ml | 48 ++++++ ocaml/Id.ml | 33 ++++ ocaml/Message.ml | 301 +++++++++++++++++++++++++++++++++++ ocaml/Queuing_system.ml | 116 ++++++++++++++ ocaml/TaskServer.ml | 286 +++++++++++++++++++++++++++++++++ ocaml/_tags | 2 +- ocaml/test_message.ml | 89 +++++++++++ ocaml/test_queuing_system.ml | 102 ++++++++++++ ocaml/test_task_server.ml | 5 + ocaml/test_task_server.py | 46 ++++++ 10 files changed, 1027 insertions(+), 1 deletion(-) create mode 100644 ocaml/Address.ml create mode 100644 ocaml/Id.ml create mode 100644 ocaml/Message.ml create mode 100644 ocaml/Queuing_system.ml create mode 100644 ocaml/TaskServer.ml create mode 100644 ocaml/test_message.ml create mode 100644 ocaml/test_queuing_system.ml create mode 100644 ocaml/test_task_server.ml create mode 100755 ocaml/test_task_server.py diff --git a/ocaml/Address.ml b/ocaml/Address.ml new file mode 100644 index 00000000..5f3bb748 --- /dev/null +++ b/ocaml/Address.ml @@ -0,0 +1,48 @@ +open Core.Std + +module Tcp : sig + type t + val of_string : string -> t + val to_string : t -> string +end = struct + type t = string + let of_string x = + assert (String.is_prefix ~prefix:"tcp://" x); + x + let to_string x = x +end + +module Ipc : sig + type t + val of_string : string -> t + val to_string : t -> string +end = struct + type t = string + let of_string x = + assert (String.is_prefix ~prefix:"ipc://" x); + x + let to_string x = x +end + +module Inproc : sig + type t + val of_string : string -> t + val to_string : t -> string +end = struct + type t = string + let of_string x = + assert (String.is_prefix ~prefix:"inproc://" x); + x + let to_string x = x +end + +type t = +| Tcp of Tcp.t +| Ipc of Ipc.t +| Inproc of Inproc.t + +let to_string = function +| Tcp x -> Tcp.to_string x +| Ipc x -> Ipc.to_string x +| Inproc x -> Inproc.to_string x + diff --git a/ocaml/Id.ml b/ocaml/Id.ml new file mode 100644 index 00000000..660c3452 --- /dev/null +++ b/ocaml/Id.ml @@ -0,0 +1,33 @@ +open Core.Std + +module Id : sig + type t + val of_int : int -> t + val to_int : t -> int + val of_string : string -> t + val to_string : t -> string + val increment : t -> t + val decrement : t -> t +end += struct + type t = int + let of_int x = + assert (x>0); x + let to_int x = x + let of_string x = + Int.of_string x + |> of_int + let to_string x = + Int.to_string x + let increment x = x + 1 + let decrement x = x - 1 +end + +module Task = struct + include Id +end + +module Client = struct + include Id +end + diff --git a/ocaml/Message.ml b/ocaml/Message.ml new file mode 100644 index 00000000..43982059 --- /dev/null +++ b/ocaml/Message.ml @@ -0,0 +1,301 @@ +open Core.Std + +(** New job : Request to create a new multi-tasked job *) + +module State : sig + type t + val of_string : string -> t + val to_string : t -> string +end = struct + type t = string + let of_string x = x + let to_string x = x +end + +module Newjob_msg : sig + type t = + { state: State.t; + address_tcp: Address.Tcp.t ; + address_inproc: Address.Inproc.t; + } + val create : address_tcp:string -> address_inproc:string -> state:string -> t + val to_string : t -> string +end = struct + type t = + { state: State.t; + address_tcp: Address.Tcp.t ; + address_inproc: Address.Inproc.t; + } + let create ~address_tcp ~address_inproc ~state = + { state = State.of_string state; + address_tcp = Address.Tcp.of_string address_tcp ; + address_inproc = Address.Inproc.of_string address_inproc ; + } + let to_string t = + Printf.sprintf "newjob %s %s %s" + ( State.to_string t.state ) + ( Address.Tcp.to_string t.address_tcp ) + ( Address.Inproc.to_string t.address_inproc ) +end + + +(** Connect : connect a new client to the task server *) + +module Connect_msg : sig + type t = Tcp | Inproc | Ipc + val create : typ:string -> t + val to_string : t -> string +end = struct + type t = Tcp | Inproc | Ipc + let create ~typ = + match typ with + | "tcp" -> Tcp + | "inproc" -> Inproc + | "ipc" -> Ipc + | _ -> assert false + let to_string = function + | Tcp -> "connect tcp" + | Inproc -> "connect inproc" + | Ipc -> "connect ipc" +end + +(** ConnectReply : Reply to the connect messsage *) + +module ConnectReply_msg : sig + type t = + { client_id: Id.Client.t ; + state: State.t ; + push_address: Address.t; + } + val create : state:State.t -> client_id:Id.Client.t -> push_address:Address.t -> t + val to_string : t -> string +end = struct + type t = + { client_id: Id.Client.t ; + state: State.t ; + push_address: Address.t; + } + let create ~state ~client_id ~push_address = + { client_id ; state ; push_address } + let to_string x = + Printf.sprintf "connect_reply %s %d %s" + (State.to_string x.state) + (Id.Client.to_int x.client_id) + (Address.to_string x.push_address) +end + + +(** Disconnect : disconnect a client from the task server *) +module Disconnect_msg : sig + type t = + { client_id: Id.Client.t ; + state: State.t ; + } + val create : state:string -> client_id:string -> t + val to_string : t -> string +end = struct + type t = + { client_id: Id.Client.t ; + state: State.t ; + } + let create ~state ~client_id = + { client_id = Id.Client.of_string client_id ; state = State.of_string state } + let to_string x = + Printf.sprintf "disconnect %s %d" + (State.to_string x.state) + (Id.Client.to_int x.client_id) +end + + +(** AddTask : Add a new task to the queue *) +module AddTask_msg : sig + type t = + { state: State.t; + task: string; + } + val create : state:string -> task:string -> t + val to_string : t -> string +end = struct + type t = + { state: State.t; + task: string; + } + let create ~state ~task = { state = State.of_string state ; task } + let to_string x = + Printf.sprintf "add_task %s %s" (State.to_string x.state) x.task +end + + +(** AddTaskReply : Reply to the AddTask message *) +module AddTaskReply_msg : sig + type t + val create : task_id:Id.Task.t -> t + val to_string : t -> string +end = struct + type t = Id.Task.t + let create ~task_id = task_id + let to_string x = + Printf.sprintf "add_task_reply %d" (Id.Task.to_int x) +end + + +(** GetTask : get a new task to do *) +module GetTask_msg : sig + type t = + { client_id: Id.Client.t ; + state: State.t ; + } + val create : state:string -> client_id:string -> t + val to_string : t -> string +end = struct + type t = + { client_id: Id.Client.t ; + state: State.t ; + } + let create ~state ~client_id = + { client_id = Id.Client.of_string client_id ; state = State.of_string state } + let to_string x = + Printf.sprintf "get_task %s %d" + (State.to_string x.state) + (Id.Client.to_int x.client_id) +end + +(** GetTaskReply : Reply to the GetTask message *) +module GetTaskReply_msg : sig + type t + val create : task_id:Id.Task.t -> task:string -> t + val to_string : t -> string +end = struct + type t = + { task_id: Id.Task.t ; + task : string ; + } + let create ~task_id ~task = { task_id ; task } + let to_string x = + Printf.sprintf "get_task_reply %d %s" (Id.Task.to_int x.task_id) x.task +end + + +(** TaskDone : Inform the server that a task is finished *) +module TaskDone_msg : sig + type t = + { client_id: Id.Client.t ; + state: State.t ; + task_id: Id.Task.t; + } + val create : state:string -> client_id:string -> task_id:string -> t + val to_string : t -> string +end = struct + type t = + { client_id: Id.Client.t ; + state: State.t ; + task_id: Id.Task.t; + } + let create ~state ~client_id ~task_id = + { client_id = Id.Client.of_string client_id ; + state = State.of_string state ; + task_id = Id.Task.of_string task_id } + let to_string x = + Printf.sprintf "task_done %s %d %d" + (State.to_string x.state) + (Id.Client.to_int x.client_id) + (Id.Task.to_int x.task_id) +end + +(** Terminate *) +module Terminate_msg : sig + type t + val create : unit -> t + val to_string : t -> string +end = struct + type t = Terminate + let create () = Terminate + let to_string x = "terminate" +end + +(** OK *) +module Ok_msg : sig + type t + val create : unit -> t + val to_string : t -> string +end = struct + type t = Ok + let create () = Ok + let to_string x = "ok" +end + +(** Error *) +module Error_msg : sig + type t + val create : string -> t + val to_string : t -> string +end = struct + type t = string + let create x = x + let to_string x = + String.concat ~sep:" " [ "error" ; x ] +end + + + +(** Message *) + +type t = +| Newjob of Newjob_msg.t +| Connect of Connect_msg.t +| ConnectReply of ConnectReply_msg.t +| Disconnect of Disconnect_msg.t +| GetTask of GetTask_msg.t +| GetTaskReply of GetTaskReply_msg.t +| AddTask of AddTask_msg.t +| AddTaskReply of AddTaskReply_msg.t +| TaskDone of TaskDone_msg.t +| Terminate of Terminate_msg.t +| Ok of Ok_msg.t +| Error of Error_msg.t + + +let of_string s = + let l = + String.split ~on:' ' s + |> List.map ~f:String.strip + |> List.map ~f:String.lowercase + |> List.filter ~f:(fun x -> (String.strip x) <> "") + in + match l with + | "add_task" :: state :: task -> + AddTask (AddTask_msg.create ~state ~task:(String.concat ~sep:" " task) ) + | "get_task" :: state :: client_id :: [] -> + GetTask (GetTask_msg.create ~state ~client_id) + | "task_done" :: state :: client_id :: task_id :: [] -> + TaskDone (TaskDone_msg.create ~state ~client_id ~task_id) + | "disconnect" :: state :: client_id :: [] -> + Disconnect (Disconnect_msg.create ~state ~client_id) + | "connect" :: t :: [] -> + Connect (Connect_msg.create t) + | "new_job" :: state :: push_address_tcp :: push_address_inproc :: [] -> + Newjob (Newjob_msg.create push_address_tcp push_address_inproc state) + | "terminate" :: [] -> + Terminate (Terminate_msg.create () ) + | "ok" :: [] -> + Ok (Ok_msg.create ()) + | "error" :: rest -> + Error (Error_msg.create (String.concat ~sep:" " rest)) + | _ -> failwith "Message not understood" + + +let to_string = function +| Newjob x -> Newjob_msg.to_string x +| Connect x -> Connect_msg.to_string x +| ConnectReply x -> ConnectReply_msg.to_string x +| Disconnect x -> Disconnect_msg.to_string x +| GetTask x -> GetTask_msg.to_string x +| GetTaskReply x -> GetTaskReply_msg.to_string x +| AddTask x -> AddTask_msg.to_string x +| AddTaskReply x -> AddTaskReply_msg.to_string x +| TaskDone x -> TaskDone_msg.to_string x +| Terminate x -> Terminate_msg.to_string x +| Ok x -> Ok_msg.to_string x +| Error x -> Error_msg.to_string x + + diff --git a/ocaml/Queuing_system.ml b/ocaml/Queuing_system.ml new file mode 100644 index 00000000..7a927a60 --- /dev/null +++ b/ocaml/Queuing_system.ml @@ -0,0 +1,116 @@ +open Core.Std + + +type t = +{ queued : Id.Task.t list ; + running : (Id.Task.t, Id.Client.t) Map.Poly.t ; + tasks : (Id.Task.t, string) Map.Poly.t; + clients : Id.Client.t Set.Poly.t; + next_client_id : Id.Client.t; + next_task_id : Id.Task.t; +} + + + +let create () = + { queued = [] ; + running = Map.Poly.empty ; + tasks = Map.Poly.empty; + clients = Set.Poly.empty; + next_client_id = Id.Client.of_int 1; + next_task_id = Id.Task.of_int 1; + } + + + + +let add_task ~task q = + let task_id = + q.next_task_id + in + { q with + queued = q.queued @ [ task_id ] ; + tasks = Map.add q.tasks ~key:task_id ~data:task ; + next_task_id = Id.Task.increment task_id ; + }, task_id + + +let add_client q = + let client_id = + q.next_client_id + in + { q with + clients = Set.add q.clients client_id; + next_client_id = Id.Client.increment client_id; + }, client_id + + +let pop_task ~client_id q = + let { queued ; running ; _ } = + q + in + assert (Set.mem q.clients client_id); + match queued with + | task_id :: new_queue -> + let new_q = + { q with + queued = new_queue ; + running = Map.add running ~key:task_id ~data:client_id ; + } + in new_q, Some task_id, (Map.find q.tasks task_id) + | [] -> q, None, None + + +let del_client ~client_id q = + assert (Set.mem q.clients client_id); + { q with + clients = Set.remove q.clients client_id } + + +let end_task ~task_id ~client_id q = + let { running ; tasks ; _ } = + q + in + assert (Set.mem q.clients client_id); + let () = + match Map.Poly.find running task_id with + | None -> failwith "Task already finished" + | Some client_id_check -> assert (client_id_check = client_id) + in + { q with + running = Map.remove running task_id ; + tasks = Map.remove tasks task_id ; + } + + + +let number_of_queued q = + List.length q.queued + +let number_of_running q = + Map.length q.running + + +let to_string { queued ; running ; tasks ; _ } = + let q = + List.map ~f:Id.Task.to_string queued + |> String.concat ~sep:" ; " + and r = + Map.Poly.to_alist running + |> List.map ~f:(fun (t,c) -> "("^(Id.Task.to_string t)^", " + ^(Id.Client.to_string c)^")") + |> String.concat ~sep:" ; " + and t = + Map.Poly.to_alist tasks + |> List.map ~f:(fun (t,c) -> "("^(Id.Task.to_string t)^", \"" + ^c^"\")") + |> String.concat ~sep:" ; " + in + Printf.sprintf "{ +queued : { %s } +running : { %s } +tasks : [ %s + ] +}" q r t + + diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml new file mode 100644 index 00000000..4c5b2ff2 --- /dev/null +++ b/ocaml/TaskServer.ml @@ -0,0 +1,286 @@ +open Core.Std +open Qptypes + +(** +The tasks server listens on a REQ socket and accepts the following commands: + +* "new_job %s %s %s" state push_address_tcp push_address_inproc -> "OK" + -> "OK" + +* "connect %s" ["tcp"|"inproc"] + -> "%d %s %s" id state push_address + +* "disconnect %d" id + -> "OK" + +* "get_task %d %s" id state + -> "%d %s" task_id task + +* "task_done %d task_id %s" id state + -> "%d %s" task_id task + +*) + +let bind_socket ~socket_type ~socket ~address = + try + ZMQ.Socket.bind socket address + with + | Unix.Unix_error (_, message, f) -> + failwith @@ Printf.sprintf + "\n%s\nUnable to bind the %s socket :\n %s\n%s" + f socket_type address message + | other_exception -> raise other_exception + + +(** Name of the host on which the server runs *) +let hostname = lazy ( + try + Unix.gethostname () + with + | _ -> "localhost" + ) + + +(** IP address *) +let ip_address = lazy ( + match Sys.getenv "QP_NIC" with + | None -> + begin + try + Lazy.force hostname + |> Unix.Inet_addr.of_string_or_getbyname + |> Unix.Inet_addr.to_string + with + | Unix.Unix_error _ -> + failwith "Unable to find IP address from host name." + end + | Some interface -> + begin + try + ok_exn Linux_ext.get_ipv4_address_for_interface interface + with + | Unix.Unix_error _ -> + Lazy.force hostname + |> Unix.Inet_addr.of_string_or_getbyname + |> Unix.Inet_addr.to_string + end +) + +(** Initial ZeroMQ port : + Random port number between 49152 and 65535 *) +let port = lazy ( + 1024 + (Random.int (49151-1024)) ) + +let stop () = + let zmq_context = + ZMQ.Context.create () + in + let req_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.req + and address = + Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) (Lazy.force port) + in + ZMQ.Socket.connect req_socket address; + + Message.Terminate (Message.Terminate_msg.create ()) + |> Message.to_string + |> ZMQ.Socket.send req_socket ; + + let msg = + ZMQ.Socket.recv req_socket + |> Message.of_string + in + let () = + match msg with + | Message.Ok _ -> () + | _ -> failwith "Problem in termination" + in + ZMQ.Socket.set_linger_period req_socket 1000; + ZMQ.Socket.close req_socket + + +(** Run the task server *) +let run () = + + let zmq_context = + ZMQ.Context.create () + in + + let rep_socket = + ZMQ.Socket.create zmq_context ZMQ.Socket.rep + and address = + Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) (Lazy.force port) + in + bind_socket "REP" rep_socket address; + + let pollitem = + ZMQ.Poll.mask_of + [| (rep_socket, ZMQ.Poll.In) |] + in + + (** State variables *) + let q = ref + (Queuing_system.create ()) + and running = + ref true + and job = + ref None + in + + let get_state () = + match !job with + | None -> None + | Some j -> Some j.Message.Newjob_msg.state + in + + let get_tcp_address () = + match !job with + | Some j -> Address.Tcp j.Message.Newjob_msg.address_tcp + | None -> assert false + in + + let get_inproc_address () = + match !job with + | Some j -> Address.Inproc j.Message.Newjob_msg.address_inproc + | None -> assert false + in + + let ok = + Message.Ok (Message.Ok_msg.create ()) + in + + while ( !running ) + do + let state = + get_state () + and polling = + ZMQ.Poll.poll ~timeout:1000 pollitem + in + + let terminate () = + running := false; + Message.to_string ok + |> ZMQ.Socket.send rep_socket + + and newjob x = + q := Queuing_system.create (); + job := Some x; + Message.to_string ok + |> ZMQ.Socket.send rep_socket + + and connect state msg = + let push_address = + match msg with + | Message.Connect_msg.Tcp -> get_tcp_address () + | Message.Connect_msg.Inproc -> get_inproc_address () + | Message.Connect_msg.Ipc -> assert false + in + let new_q, client_id = + Queuing_system.add_client !q + in + q := new_q; + Message.ConnectReply (Message.ConnectReply_msg.create + ~state ~client_id ~push_address) + |> Message.to_string + |> ZMQ.Socket.send rep_socket + + and disconnect state msg = + let s, c = + msg.Message.Disconnect_msg.state , + msg.Message.Disconnect_msg.client_id + in + assert (s = state); + let new_q = + Queuing_system.del_client ~client_id:c !q + in + q := new_q; + Message.to_string ok + |> ZMQ.Socket.send rep_socket + + and add_task state msg = + let s, task = + msg.Message.AddTask_msg.state, + msg.Message.AddTask_msg.task + in + assert (s = state); + let new_q, task_id = + Queuing_system.add_task ~task !q + in + q := new_q; + Message.to_string ok + |> ZMQ.Socket.send rep_socket + + and get_task state msg = + let s, client_id = + msg.Message.GetTask_msg.state, + msg.Message.GetTask_msg.client_id + in + assert (s = state); + let new_q, task_id, task = + Queuing_system.pop_task ~client_id !q + in + q := new_q; + let reply = + match (task, task_id) with + | Some task, Some task_id -> + Message.GetTaskReply (Message.GetTaskReply_msg.create ~task ~task_id) + | _ -> Message.Terminate (Message.Terminate_msg.create ()) + in + Message.to_string reply + |> ZMQ.Socket.send rep_socket + + and task_done state msg = + let s, client_id, task_id = + msg.Message.TaskDone_msg.state, + msg.Message.TaskDone_msg.client_id, + msg.Message.TaskDone_msg.task_id + in + assert (s = state); + let new_q = + Queuing_system.end_task ~task_id ~client_id !q + in + q := new_q; + Message.to_string ok + |> ZMQ.Socket.send rep_socket + + and error msg = + Message.Error (Message.Error_msg.create msg) + |> Message.to_string + |> ZMQ.Socket.send rep_socket + in + + if (polling.(0) = Some ZMQ.Poll.In) then + let raw_message = + ZMQ.Socket.recv rep_socket + in + try + let message = + Message.of_string raw_message + in + Printf.printf "%s\n%!" (Message.to_string message); + Printf.printf "%s\n%!" (Queuing_system.to_string !q); + match (state, message) with + | _ , Message.Terminate _ -> terminate () + | None , Message.Newjob x -> newjob x + | None , _ -> error "No job is running" + | _ , Message.Newjob _ -> error "A job is already running" + | Some s, Message.Connect x -> connect s x + | Some s, Message.Disconnect x -> disconnect s x + | Some s, Message.AddTask x -> add_task s x + | Some s, Message.GetTask x -> get_task s x + | Some s, Message.TaskDone x -> task_done s x + | _ , _ -> + error ("Invalid message : "^(Message.to_string message)) + with + | Failure f -> error (f^" : "^raw_message) + | Assert_failure (f,i,j) -> error (Printf.sprintf "%s:%d:%d : %s" f i j raw_message) + + done; + ZMQ.Socket.set_linger_period rep_socket 1000; + ZMQ.Socket.close rep_socket + + +let () = + Printf.printf "export QP_RUN_ADDRESS=tcp://%s:%d\n%!" (Lazy.force ip_address) (Lazy.force port) + + diff --git a/ocaml/_tags b/ocaml/_tags index 519d558f..112ee73f 100644 --- a/ocaml/_tags +++ b/ocaml/_tags @@ -1,2 +1,2 @@ -true: package(core,sexplib.syntax,cryptokit) +true: package(core,sexplib.syntax,cryptokit,ZMQ) true: thread diff --git a/ocaml/test_message.ml b/ocaml/test_message.ml new file mode 100644 index 00000000..90b73d5e --- /dev/null +++ b/ocaml/test_message.ml @@ -0,0 +1,89 @@ +open Core.Std + +let () = + Message.of_string "new_job tcp://127.0.0.1 inproc://ao_ints:12345 ao_integrals" + |> Message.to_string + |> print_endline + ; + + Message.of_string "connect tcp" + |> Message.to_string + |> print_endline + ; + + Message.of_string "connect inproc" + |> Message.to_string + |> print_endline + ; + + Message.of_string "disconnect 3 mystate" + |> Message.to_string + |> print_endline + ; + + Message.of_string "get_task 3 mystate" + |> Message.to_string + |> print_endline + ; + + Message.of_string "task_done 1 mystate 3" + |> Message.to_string + |> print_endline + ; + + Message.of_string "add_task mystate 1 2 3 4 5 6" + |> Message.to_string + |> print_endline + ; + + try + Message.of_string "new_job inproc://ao_ints tcp://127.0.0.1:12345 ao_integrals" + |> Message.to_string + |> print_endline + ; + failwith "Should have failed" + with + | Assert_failure _ -> print_endline "OK" + ; + + try + Message.of_string "new_job tcp://ao_ints inproc://ao_ints" + |> Message.to_string + |> print_endline + ; + assert false + with + | Failure _ -> print_endline "OK" + ; + + try + Message.of_string "disconnect -4 mystate" + |> Message.to_string + |> print_endline + ; + assert false + with + | Assert_failure _ -> print_endline "OK" + ; + + try + Message.of_string "disconnect mystate 3" + |> Message.to_string + |> print_endline + ; + assert false + with + | Failure _ -> print_endline "OK" + ; + + try + Message.of_string "connect tcp tcp://127.0.0.1" + |> Message.to_string + |> print_endline + ; + assert false + with + | Failure _ -> print_endline "OK" + ; + + diff --git a/ocaml/test_queuing_system.ml b/ocaml/test_queuing_system.ml new file mode 100644 index 00000000..aa2fa280 --- /dev/null +++ b/ocaml/test_queuing_system.ml @@ -0,0 +1,102 @@ +open Core.Std + +let () = + + let nclients = + 8 + in + + let q = + Queuing_system.create () + in + + let tasks = + Array.init 20 ~f:(fun i -> Printf.sprintf "Task %d" i) + |> Array.to_list + in + + let (q,_) = + List.fold_left tasks ~init:(q, q.Queuing_system.next_task_id) + ~f:(fun (q,_) task -> Queuing_system.add_task ~task q) + in + print_endline @@ Queuing_system.to_string q ; + + let rec aux q clients = function + | 0 -> q, clients + | i -> + let new_q, client_id = + Queuing_system.add_client q + in + aux new_q (client_id::clients) (i-1) + in + let q, _ = + aux q [] nclients + in + + let rec aux q = function + | 0 -> q + | i -> + begin + let c = + Id.Client.of_int i + in + let new_q, task_id, task = + Queuing_system.pop_task ~client_id:c q + in + begin + match task_id, task with + | Some task_id, Some task -> + Printf.printf "Task Running: %d %s\n" (Id.Task.to_int task_id) task + | _ -> Printf.printf "Done!\n" + end; + aux new_q (i-1) + end + in + + let rec aux2 q = function + | 0 -> q + | i -> + begin + let task_id = + (Id.Task.of_int i) + in + try + let client_id = + Map.Poly.find_exn q.Queuing_system.running task_id + in + let new_q = + Queuing_system.end_task ~task_id ~client_id q + in + Printf.printf "Task Done : %d\n" (Id.Task.to_int task_id) ; + aux2 new_q (i-1) + with + | _ -> aux2 q 0 + end + in + let q = + aux q nclients + in + print_endline @@ Queuing_system.to_string q ; + + let q = + aux2 q nclients + in + print_endline @@ Queuing_system.to_string q ; + Printf.printf "Queued : %d\n Running : %d\n" + (Queuing_system.number_of_queued q) + (Queuing_system.number_of_running q) + ; + let q = + aux q nclients + in + print_endline @@ Queuing_system.to_string q ; + let q = + aux2 q nclients + in + print_endline @@ Queuing_system.to_string q ; + + +(* + List.map ~f:Id.Task.to_int tasks + |> List.iter ~f:(fun x -> Printf.printf "%d\n" x) +*) diff --git a/ocaml/test_task_server.ml b/ocaml/test_task_server.ml new file mode 100644 index 00000000..55f74202 --- /dev/null +++ b/ocaml/test_task_server.ml @@ -0,0 +1,5 @@ +open Core + +let () = + TaskServer.run () + diff --git a/ocaml/test_task_server.py b/ocaml/test_task_server.py new file mode 100755 index 00000000..07835820 --- /dev/null +++ b/ocaml/test_task_server.py @@ -0,0 +1,46 @@ +#!/usr/bin/python + +import zmq +import sys, os + + +def main(): + context = zmq.Context() + socket = context.socket(zmq.REQ) + socket.connect(os.environ["QP_RUN_ADDRESS"]) + + def send(msg,expected): + print "Send : ", msg + socket.send(msg) + reply = socket.recv() + print "Reply : ", reply + print "" + assert (reply == expected) + + + send("new_job ao_integrals tcp://130.120.229.139:12345 inproc://ao_integrals", + "ok") + send("new_job ao_integrals tcp://130.120.229.139:12345 inproc://ao_integrals", + "error A job is already running") + + send("connect","error Message not understood : connect") + + send("connect tcp","connect_reply ao_integrals 1 tcp://130.120.229.139:12345") + send("connect inproc","connect_reply ao_integrals 2 inproc://ao_integrals") + send("disconnect ao_integrals 3","error Queuing_system.ml:65:2 : disconnect ao_integrals 3") + send("disconnect ao_integrals 2","ok") + send("connect inproc","connect_reply ao_integrals 3 inproc://ao_integrals") + + for i in range(10): + send("add_task ao_integrals %d %d"%(i,i+10), "ok") + + for i in range(10): + send("get_task ao_integrals 3", "get_task_reply %d %d %d"%(i+1,i,i+10)) + send("task_done ao_integrals 3 %d"%(i+1), "ok") + + send("get_task ao_integrals 3", "terminate") + + send("terminate","ok") + +if __name__ == '__main__': + main() From df6ca0ee05ddc1f368e2243a331262098ce480c1 Mon Sep 17 00:00:00 2001 From: caffarel Date: Fri, 4 Dec 2015 20:02:35 +0100 Subject: [PATCH 05/47] Downgraded ZeroMQ to 4.0.7 --- configure | 2 +- install/scripts/install_zeromq.sh | 11 +++-- ocaml/qp_edit.ml | 50 ++++++++++---------- plugins/CISD/.gitignore | 1 + plugins/CISD_selected/.gitignore | 1 + plugins/CISD_selected/README.rst | 4 ++ plugins/FCIdump/.gitignore | 1 + plugins/Full_CI/.gitignore | 1 + plugins/Hartree_Fock/.gitignore | 1 + plugins/Hartree_Fock/README.rst | 4 +- plugins/MP2/.gitignore | 2 + plugins/MP2/README.rst | 29 ++++++++++++ plugins/QmcChem/.gitignore | 1 + src/AO_Basis/README.rst | 2 +- src/Bitmask/README.rst | 14 +++--- src/Determinants/README.rst | 2 +- src/Ezfio_files/README.rst | 36 +++++++++------ src/Integrals_Bielec/.gitignore | 1 + src/Integrals_Bielec/README.rst | 77 ++++++++++++++++++------------- src/MOGuess/.gitignore | 4 +- src/MOGuess/README.rst | 8 ++++ src/MO_Basis/README.rst | 10 ++-- src/Utils/README.rst | 27 +++++++---- src/ZMQ/README.rst | 35 ++++++++++++-- 24 files changed, 220 insertions(+), 104 deletions(-) diff --git a/configure b/configure index 84291ad8..96332a32 100755 --- a/configure +++ b/configure @@ -134,7 +134,7 @@ ezfio = Info( default_path=join(QP_ROOT_INSTALL, "EZFIO")) zeromq = Info( - url='http://download.zeromq.org/zeromq-4.1.3.tar.gz', + url='http://download.zeromq.org/zeromq-4.0.7.tar.gz', description=' ZeroMQ', default_path=join(QP_ROOT_LIB, "libzmq.a")) diff --git a/install/scripts/install_zeromq.sh b/install/scripts/install_zeromq.sh index 9508f457..73b59019 100755 --- a/install/scripts/install_zeromq.sh +++ b/install/scripts/install_zeromq.sh @@ -14,12 +14,15 @@ function _install() cd "${BUILD}" ./configure --without-libsodium || exit 1 make -j 8 || exit 1 - rm -f -- "${QP_ROOT}"/lib/libzmq.a "${QP_ROOT}"/lib/libzmq.so "${QP_ROOT}"/lib/libzmq.so.5 - cp .libs/libzmq.a "${QP_ROOT}"/lib - cp .libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.5 + rm -f -- "${QP_ROOT}"/lib/libzmq.a "${QP_ROOT}"/lib/libzmq.so "${QP_ROOT}"/lib/libzmq.so.? +# cp .libs/libzmq.a "${QP_ROOT}"/lib +# cp .libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.5 + cp src/.libs/libzmq.a "${QP_ROOT}"/lib + cp src/.libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.4 cp include/{zmq.h,zmq_utils.h} "${QP_ROOT}"/lib cd "${QP_ROOT}"/lib - ln -s libzmq.so.5 libzmq.so +# ln -s libzmq.so.5 libzmq.so + ln -s libzmq.so.4 libzmq.so cd ${ORIG} return 0 } diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index f6a2ac9c..772293b0 100644 --- a/ocaml/qp_edit.ml +++ b/ocaml/qp_edit.ml @@ -17,12 +17,12 @@ type keyword = | Electrons | Mo_basis | Nuclei -| Determinants -| Hartree_fock -| Integrals_bielec | Perturbation -| Properties +| Hartree_fock | Pseudo +| Integrals_bielec +| Determinants +| Properties ;; @@ -32,12 +32,12 @@ let keyword_to_string = function | Electrons -> "Electrons" | Mo_basis -> "MO basis" | Nuclei -> "Molecule" -| Determinants -> "Determinants" -| Hartree_fock -> "Hartree_fock" -| Integrals_bielec -> "Integrals_bielec" | Perturbation -> "Perturbation" -| Properties -> "Properties" +| Hartree_fock -> "Hartree_fock" | Pseudo -> "Pseudo" +| Integrals_bielec -> "Integrals_bielec" +| Determinants -> "Determinants" +| Properties -> "Properties" ;; @@ -86,18 +86,18 @@ let get s = f Ao_basis.(read, to_rst) | Determinants_by_hand -> f Determinants_by_hand.(read, to_rst) - | Determinants -> - f Determinants.(read, to_rst) - | Hartree_fock -> - f Hartree_fock.(read, to_rst) - | Integrals_bielec -> - f Integrals_bielec.(read, to_rst) | Perturbation -> f Perturbation.(read, to_rst) - | Properties -> - f Properties.(read, to_rst) + | Hartree_fock -> + f Hartree_fock.(read, to_rst) | Pseudo -> f Pseudo.(read, to_rst) + | Integrals_bielec -> + f Integrals_bielec.(read, to_rst) + | Determinants -> + f Determinants.(read, to_rst) + | Properties -> + f Properties.(read, to_rst) end with | Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "") @@ -135,12 +135,12 @@ let set str s = in let open Input in match s with - | Determinants -> write Determinants.(of_rst, write) s - | Hartree_fock -> write Hartree_fock.(of_rst, write) s - | Integrals_bielec -> write Integrals_bielec.(of_rst, write) s | Perturbation -> write Perturbation.(of_rst, write) s - | Properties -> write Properties.(of_rst, write) s + | Hartree_fock -> write Hartree_fock.(of_rst, write) s | Pseudo -> write Pseudo.(of_rst, write) s + | Integrals_bielec -> write Integrals_bielec.(of_rst, write) s + | Determinants -> write Determinants.(of_rst, write) s + | Properties -> write Properties.(of_rst, write) s | Electrons -> write Electrons.(of_rst, write) s | Determinants_by_hand -> write Determinants_by_hand.(of_rst, write) s | Nuclei -> write Nuclei.(of_rst, write) s @@ -188,12 +188,12 @@ let run check_only ezfio_filename = Nuclei ; Ao_basis; Electrons ; - Determinants ; - Hartree_fock ; - Integrals_bielec ; Perturbation ; - Properties ; + Hartree_fock ; Pseudo ; + Integrals_bielec ; + Determinants ; + Properties ; Mo_basis; Determinants_by_hand ; ] @@ -212,7 +212,7 @@ let run check_only ezfio_filename = match check_only with | true -> () | false -> - Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename + Printf.sprintf "%s %s" editor temp_filename |> Sys.command_exn ; diff --git a/plugins/CISD/.gitignore b/plugins/CISD/.gitignore index 5c7aee18..2630f994 100644 --- a/plugins/CISD/.gitignore +++ b/plugins/CISD/.gitignore @@ -20,6 +20,7 @@ Pseudo Selectors_full SingleRefMethod Utils +ZMQ cisd cisd_lapack ezfio_interface.irp.f diff --git a/plugins/CISD_selected/.gitignore b/plugins/CISD_selected/.gitignore index e9803984..6145158a 100644 --- a/plugins/CISD_selected/.gitignore +++ b/plugins/CISD_selected/.gitignore @@ -23,6 +23,7 @@ Pseudo Selectors_full SingleRefMethod Utils +ZMQ cisd_selection ezfio_interface.irp.f irpf90.make diff --git a/plugins/CISD_selected/README.rst b/plugins/CISD_selected/README.rst index dfc4c406..a3d2410d 100644 --- a/plugins/CISD_selected/README.rst +++ b/plugins/CISD_selected/README.rst @@ -196,6 +196,10 @@ Documentation .. by the `update_README.py` script. +`cisd `_ + Undocumented + + h_apply_cisd Calls H_apply on the HF determinant and selects all connected single and double excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. diff --git a/plugins/FCIdump/.gitignore b/plugins/FCIdump/.gitignore index 0a548a14..ec4d9d34 100644 --- a/plugins/FCIdump/.gitignore +++ b/plugins/FCIdump/.gitignore @@ -16,6 +16,7 @@ Makefile.depend Nuclei Pseudo Utils +ZMQ ezfio_interface.irp.f fcidump irpf90.make diff --git a/plugins/Full_CI/.gitignore b/plugins/Full_CI/.gitignore index a806bcbc..fe4ea27b 100644 --- a/plugins/Full_CI/.gitignore +++ b/plugins/Full_CI/.gitignore @@ -22,6 +22,7 @@ Properties Pseudo Selectors_full Utils +ZMQ ezfio_interface.irp.f full_ci full_ci_no_skip diff --git a/plugins/Hartree_Fock/.gitignore b/plugins/Hartree_Fock/.gitignore index c44ada99..9f1c0929 100644 --- a/plugins/Hartree_Fock/.gitignore +++ b/plugins/Hartree_Fock/.gitignore @@ -18,6 +18,7 @@ Nuclei Pseudo SCF Utils +ZMQ ezfio_interface.irp.f irpf90.make irpf90_entities diff --git a/plugins/Hartree_Fock/README.rst b/plugins/Hartree_Fock/README.rst index 26976226..aad4fd56 100644 --- a/plugins/Hartree_Fock/README.rst +++ b/plugins/Hartree_Fock/README.rst @@ -52,7 +52,7 @@ Documentation Diagonal Fock matrix in the MO basis -`diagonal_fock_matrix_mo_sum `_ +`diagonal_fock_matrix_mo_sum `_ diagonal element of the fock matrix calculated as the sum over all the interactions with all the electrons in the RHF determinant diagonal_Fock_matrix_mo_sum(i) = sum_{j=1, N_elec} 2 J_ij -K_ij @@ -114,7 +114,7 @@ Documentation .br -`fock_mo_to_ao `_ +`fock_mo_to_ao `_ Undocumented diff --git a/plugins/MP2/.gitignore b/plugins/MP2/.gitignore index 228b1c9d..82d50427 100644 --- a/plugins/MP2/.gitignore +++ b/plugins/MP2/.gitignore @@ -22,8 +22,10 @@ Pseudo Selectors_full SingleRefMethod Utils +ZMQ ezfio_interface.irp.f irpf90.make irpf90_entities mp2 +mp2_wf tags \ No newline at end of file diff --git a/plugins/MP2/README.rst b/plugins/MP2/README.rst index 062b48c9..98b3140e 100644 --- a/plugins/MP2/README.rst +++ b/plugins/MP2/README.rst @@ -83,6 +83,35 @@ h_apply_mp2_monoexc Assume N_int is already provided. +h_apply_mp2_selection + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_mp2_selection_diexc + Undocumented + + +h_apply_mp2_selection_diexcorg + Generate all double excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_mp2_selection_diexcp + Undocumented + + +h_apply_mp2_selection_monoexc + Generate all single excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + `mp2 `_ Undocumented + +`mp2_wf `_ + Save the MP2 wave function + diff --git a/plugins/QmcChem/.gitignore b/plugins/QmcChem/.gitignore index 608403d4..5f364702 100644 --- a/plugins/QmcChem/.gitignore +++ b/plugins/QmcChem/.gitignore @@ -16,6 +16,7 @@ Makefile.depend Nuclei Pseudo Utils +ZMQ ezfio_interface.irp.f irpf90.make irpf90_entities diff --git a/src/AO_Basis/README.rst b/src/AO_Basis/README.rst index e0a487fe..0596085c 100644 --- a/src/AO_Basis/README.rst +++ b/src/AO_Basis/README.rst @@ -117,7 +117,7 @@ Documentation :math:`\int \chi_i(r) \chi_j(r) dr)` -`ao_overlap_abs `_ +`ao_overlap_abs `_ Overlap between absolute value of atomic basis functions: :math:`\int |\chi_i(r)| |\chi_j(r)| dr)` diff --git a/src/Bitmask/README.rst b/src/Bitmask/README.rst index 4a128f43..697ef620 100644 --- a/src/Bitmask/README.rst +++ b/src/Bitmask/README.rst @@ -80,7 +80,7 @@ Documentation Bitmask to include all possible single excitations from Hartree-Fock -`core_bitmask `_ +`core_bitmask `_ Reunion of the inactive, active and virtual bitmasks @@ -142,7 +142,7 @@ Documentation Hartree Fock bit mask -`i_bitmask_gen `_ +`i_bitmask_gen `_ Current bitmask for the generators @@ -150,7 +150,7 @@ Documentation Bitmasks for the inactive orbitals that are excited in post CAS method -`inact_virt_bitmask `_ +`inact_virt_bitmask `_ Reunion of the inactive and virtual bitmasks @@ -158,7 +158,7 @@ Documentation Undocumented -`list_inact `_ +`list_inact `_ Undocumented @@ -167,7 +167,7 @@ Documentation occupations "list(N_int*bit_kind_size,2) -`list_virt `_ +`list_virt `_ Undocumented @@ -219,11 +219,11 @@ Documentation Reference bit mask, used in Slater rules, chosen as Hartree-Fock bitmask -`reunion_of_bitmask `_ +`reunion_of_bitmask `_ Reunion of the inactive, active and virtual bitmasks -`unpaired_alpha_electrons `_ +`unpaired_alpha_electrons `_ Bitmask reprenting the unpaired alpha electrons in the HF_bitmask diff --git a/src/Determinants/README.rst b/src/Determinants/README.rst index 19eec306..bd5c91ab 100644 --- a/src/Determinants/README.rst +++ b/src/Determinants/README.rst @@ -316,7 +316,7 @@ Documentation idx(0) is the number of determinants that interact with key1 -`filter_connected_i_h_psi0_sc2 `_ +`filter_connected_i_h_psi0_sc2 `_ standard filter_connected_i_H_psi but returns in addition .br the array of the index of the non connected determinants to key1 diff --git a/src/Ezfio_files/README.rst b/src/Ezfio_files/README.rst index c7183a64..90e717bc 100644 --- a/src/Ezfio_files/README.rst +++ b/src/Ezfio_files/README.rst @@ -203,6 +203,14 @@ output_bitmask Output file for Bitmask +output_cisd + Output file for CISD + + +output_cisd_selected + Output file for CISD_selected + + `output_cpu_time_0 `_ Initial CPU and wall times when printing in the output files @@ -219,6 +227,10 @@ output_ezfio_files Output file for Ezfio_files +output_fcidump + Output file for FCIdump + + output_full_ci Output file for Full_CI @@ -247,12 +259,8 @@ output_moguess Output file for MOGuess -output_mrcc_cassd - Output file for MRCC_CASSD - - -output_mrcc_utils - Output file for MRCC_Utils +output_mp2 + Output file for MP2 output_nuclei @@ -271,18 +279,14 @@ output_pseudo Output file for Pseudo -output_psiref_cas - Output file for Psiref_CAS - - -output_psiref_utils - Output file for Psiref_Utils - - output_selectors_full Output file for Selectors_full +output_singlerefmethod + Output file for SingleRefMethod + + output_utils Output file for Utils @@ -291,6 +295,10 @@ output_utils Initial CPU and wall times when printing in the output files +output_zmq + Output file for ZMQ + + `write_bool `_ Write an logical value in output diff --git a/src/Integrals_Bielec/.gitignore b/src/Integrals_Bielec/.gitignore index f4bdeaca..ad6b465d 100644 --- a/src/Integrals_Bielec/.gitignore +++ b/src/Integrals_Bielec/.gitignore @@ -13,6 +13,7 @@ Makefile.depend Nuclei Pseudo Utils +ZMQ ezfio_interface.irp.f irpf90.make irpf90_entities diff --git a/src/Integrals_Bielec/README.rst b/src/Integrals_Bielec/README.rst index f09d1a9c..a22d791d 100644 --- a/src/Integrals_Bielec/README.rst +++ b/src/Integrals_Bielec/README.rst @@ -31,6 +31,7 @@ Needed Modules * `Pseudo `_ * `Bitmask `_ +* `ZMQ `_ Documentation ============= @@ -47,7 +48,7 @@ Documentation i(r1) j(r1) 1/r12 k(r2) l(r2) -`ao_bielec_integral_schwartz `_ +`ao_bielec_integral_schwartz `_ Needed to compute Schwartz inequalities @@ -61,6 +62,14 @@ Documentation i(r1) j(r2) 1/r12 k(r1) l(r2) +`ao_bielec_integrals_in_map_collector `_ + Collects results from the AO integral calculation + + +`ao_bielec_integrals_in_map_slave `_ + Computes a buffer of integrals + + `ao_integrals_map `_ AO integrals @@ -89,7 +98,7 @@ Documentation Frees the memory of the AO map -`clear_mo_map `_ +`clear_mo_map `_ Frees the memory of the MO map @@ -97,6 +106,10 @@ Documentation Compute AO 1/r12 integrals for all i and fixed j,k,l +`compute_ao_integrals_jl `_ + Parallel client for AO integrals + + `disk_access_ao_integrals `_ Read/Write AO integrals from/to disk [ Write | Read | None ] @@ -109,15 +122,15 @@ Documentation Compute integrals on the fly -`dump_ao_integrals `_ +`dump_ao_integrals `_ Save to disk the $ao integrals -`dump_mo_integrals `_ +`dump_mo_integrals `_ Save to disk the $ao integrals -`eri `_ +`eri `_ ATOMIC PRIMTIVE bielectronic integral between the 4 primitives :: primitive_1 = x1**(a_x) y1**(a_y) z1**(a_z) exp(-alpha * r1**2) primitive_2 = x1**(b_x) y1**(b_y) z1**(b_z) exp(- beta * r1**2) @@ -139,7 +152,7 @@ Documentation t_w(i,2,k) = t(i) -`general_primitive_integral `_ +`general_primitive_integral `_ Computes the integral where p,q,r,s are Gaussian primitives @@ -161,11 +174,11 @@ Documentation Returns the number of elements in the AO map -`get_mo_bielec_integral `_ +`get_mo_bielec_integral `_ Returns one integral in the MO basis -`get_mo_bielec_integral_schwartz `_ +`get_mo_bielec_integral_schwartz `_ Returns one integral in the MO basis @@ -174,47 +187,47 @@ Documentation i for j,k,l fixed. -`get_mo_bielec_integrals_existing_ik `_ +`get_mo_bielec_integrals_ij `_ Returns multiple integrals in the MO basis, all - i(1)j(1) 1/r12 k(2)l(2) - i for j,k,l fixed. + i(1)j(2) 1/r12 k(1)l(2) + i, j for k,l fixed. -`get_mo_map_size `_ +`get_mo_map_size `_ Return the number of elements in the MO map -`give_polynom_mult_center_x `_ +`give_polynom_mult_center_x `_ subroutine that returns the explicit polynom in term of the "t" variable of the following polynomw : I_x1(a_x, d_x,p,q) * I_x1(a_y, d_y,p,q) * I_x1(a_z, d_z,p,q) -`i_x1_new `_ +`i_x1_new `_ recursive function involved in the bielectronic integral -`i_x1_pol_mult `_ +`i_x1_pol_mult `_ recursive function involved in the bielectronic integral -`i_x1_pol_mult_a1 `_ +`i_x1_pol_mult_a1 `_ recursive function involved in the bielectronic integral -`i_x1_pol_mult_a2 `_ +`i_x1_pol_mult_a2 `_ recursive function involved in the bielectronic integral -`i_x1_pol_mult_recurs `_ +`i_x1_pol_mult_recurs `_ recursive function involved in the bielectronic integral -`i_x2_new `_ +`i_x2_new `_ recursive function involved in the bielectronic integral -`i_x2_pol_mult `_ +`i_x2_pol_mult `_ recursive function involved in the bielectronic integral @@ -222,21 +235,21 @@ Documentation Create new entry into AO map -`insert_into_mo_integrals_map `_ +`insert_into_mo_integrals_map `_ Create new entry into MO map, or accumulate in an existing entry -`integrale_new `_ +`integrale_new `_ calculate the integral of the polynom :: I_x1(a_x+b_x, c_x+d_x,p,q) * I_x1(a_y+b_y, c_y+d_y,p,q) * I_x1(a_z+b_z, c_z+d_z,p,q) between ( 0 ; 1) -`load_ao_integrals `_ +`load_ao_integrals `_ Read from disk the $ao integrals -`load_mo_integrals `_ +`load_mo_integrals `_ Read from disk the $ao integrals @@ -244,43 +257,43 @@ Documentation Returns one integral in the MO basis -`mo_bielec_integral_jj `_ +`mo_bielec_integral_jj `_ mo_bielec_integral_jj(i,j) = J_ij mo_bielec_integral_jj_exchange(i,j) = K_ij mo_bielec_integral_jj_anti(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_anti `_ +`mo_bielec_integral_jj_anti `_ mo_bielec_integral_jj(i,j) = J_ij mo_bielec_integral_jj_exchange(i,j) = K_ij mo_bielec_integral_jj_anti(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_anti_from_ao `_ +`mo_bielec_integral_jj_anti_from_ao `_ mo_bielec_integral_jj_from_ao(i,j) = J_ij mo_bielec_integral_jj_exchange_from_ao(i,j) = J_ij mo_bielec_integral_jj_anti_from_ao(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_exchange `_ +`mo_bielec_integral_jj_exchange `_ mo_bielec_integral_jj(i,j) = J_ij mo_bielec_integral_jj_exchange(i,j) = K_ij mo_bielec_integral_jj_anti(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_exchange_from_ao `_ +`mo_bielec_integral_jj_exchange_from_ao `_ mo_bielec_integral_jj_from_ao(i,j) = J_ij mo_bielec_integral_jj_exchange_from_ao(i,j) = J_ij mo_bielec_integral_jj_anti_from_ao(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_from_ao `_ +`mo_bielec_integral_jj_from_ao `_ mo_bielec_integral_jj_from_ao(i,j) = J_ij mo_bielec_integral_jj_exchange_from_ao(i,j) = J_ij mo_bielec_integral_jj_anti_from_ao(i,j) = J_ij - K_ij -`mo_bielec_integral_schwartz `_ +`mo_bielec_integral_schwartz `_ Needed to compute Schwartz inequalities @@ -304,7 +317,7 @@ Documentation Aligned n_pt_max_integrals -`n_pt_sup `_ +`n_pt_sup `_ Returns the upper boundary of the degree of the polynomial involved in the bielctronic integral : Ix(a_x,b_x,c_x,d_x) * Iy(a_y,b_y,c_y,d_y) * Iz(a_z,b_z,c_z,d_z) diff --git a/src/MOGuess/.gitignore b/src/MOGuess/.gitignore index a912636d..e9ba5cf5 100644 --- a/src/MOGuess/.gitignore +++ b/src/MOGuess/.gitignore @@ -15,6 +15,8 @@ Nuclei Pseudo Utils ezfio_interface.irp.f +guess_overlap irpf90.make irpf90_entities -tags \ No newline at end of file +tags +truncate_mos \ No newline at end of file diff --git a/src/MOGuess/README.rst b/src/MOGuess/README.rst index 86f352a9..06a21370 100644 --- a/src/MOGuess/README.rst +++ b/src/MOGuess/README.rst @@ -43,6 +43,10 @@ Documentation supposed to be the Identity +`guess_mimi `_ + Produce `H_core` MO orbital + + `h_core_guess `_ Produce `H_core` MO orbital output: mo_basis.mo_tot_num mo_basis.mo_label mo_basis.ao_md5 mo_basis.mo_coef mo_basis.mo_occ @@ -51,3 +55,7 @@ Documentation `hcore_guess `_ Produce `H_core` MO orbital + +`prog_truncate_mo `_ + Truncate MO set + diff --git a/src/MO_Basis/README.rst b/src/MO_Basis/README.rst index 87df08b1..afc6008b 100644 --- a/src/MO_Basis/README.rst +++ b/src/MO_Basis/README.rst @@ -76,11 +76,11 @@ Documentation by convention, the '-' MO is in the greater index (max(j,k)) -`mo_as_eigvectors_of_mo_matrix `_ +`mo_as_eigvectors_of_mo_matrix `_ Undocumented -`mo_as_eigvectors_of_mo_matrix_sort_by_observable `_ +`mo_as_eigvectors_of_mo_matrix_sort_by_observable `_ Undocumented @@ -116,7 +116,7 @@ Documentation Undocumented -`mo_sort_by_observable `_ +`mo_sort_by_observable `_ Undocumented @@ -143,3 +143,7 @@ Documentation `save_mos `_ Undocumented + +`save_mos_truncated `_ + Undocumented + diff --git a/src/Utils/README.rst b/src/Utils/README.rst index e3c36e71..ecd5db56 100644 --- a/src/Utils/README.rst +++ b/src/Utils/README.rst @@ -36,7 +36,7 @@ Documentation Compute 1st dimension such that it is aligned for vectorization. -`apply_rotation `_ +`apply_rotation `_ Apply the rotation found by find_rotation @@ -122,7 +122,7 @@ Documentation 1/n! -`find_rotation `_ +`find_rotation `_ Find A.C = B @@ -148,7 +148,7 @@ Documentation Undocumented -`get_pseudo_inverse `_ +`get_pseudo_inverse `_ Find C = A^-1 @@ -420,7 +420,7 @@ Documentation contains the new order of the elements. -`lapack_diag `_ +`lapack_diag `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -431,7 +431,7 @@ Documentation .br -`lapack_diag_s2 `_ +`lapack_diag_s2 `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -442,7 +442,7 @@ Documentation .br -`lapack_diagd `_ +`lapack_diagd `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -453,7 +453,7 @@ Documentation .br -`lapack_partial_diag `_ +`lapack_partial_diag `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -482,7 +482,7 @@ Documentation Number of current OpenMP threads -`ortho_lowdin `_ +`ortho_lowdin `_ Compute C_new=C_old.S^-1/2 canonical orthogonalization. .br overlap : overlap matrix @@ -597,7 +597,7 @@ Documentation to be in integer*8 format -`set_zero_extra_diag `_ +`set_zero_extra_diag `_ Undocumented @@ -615,6 +615,15 @@ Documentation Stop the progress bar +`svd `_ + Compute A = U.D.Vt + .br + LDx : leftmost dimension of x + .br + Dimsneion of A is m x n + .br + + `trap_signals `_ What to do when a signal is caught. Here, trap Ctrl-C and call the control_C subroutine. diff --git a/src/ZMQ/README.rst b/src/ZMQ/README.rst index 9a12751d..f189ce24 100644 --- a/src/ZMQ/README.rst +++ b/src/ZMQ/README.rst @@ -5,11 +5,38 @@ ZMQ Socket address : defined as an environment variable : QP_RUN_ADDRESS -Needed Modules -============== -.. Do not edit this section It was auto-generated -.. by the `update_README.py` script. Documentation ============= .. Do not edit this section It was auto-generated .. by the `update_README.py` script. + + +`qp_run_address `_ + Address of the qp_run socket + Example : tcp://130.120.229.139:12345 + + +`zmq_context `_ + Context for the ZeroMQ library + + +`zmq_port `_ + Undocumented + + +`zmq_port_start `_ + Address of the qp_run socket + Example : tcp://130.120.229.139:12345 + + +`zmq_socket_pull `_ + Socket which pulls the results (2) + + +`zmq_socket_push `_ + Socket on which to push the results (1) + + +`zmq_to_qp_run_socket `_ + Socket on which the qp_run process replies + From cc56ac8d3af43a7d300cca19910abf6e0e9e5c3c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 7 Dec 2015 22:03:33 +0100 Subject: [PATCH 06/47] Task Server --- ocaml/.gitignore | 6 + ocaml/Message.ml | 23 ++ ocaml/TaskServer.ml | 32 +- ocaml/create_git_sha1.sh | 12 + ocaml/qp_edit.ml | 50 +-- ocaml/qp_run.ml | 33 +- ocaml/test_task_server.ml | 2 +- ocaml/test_task_server.py | 4 +- src/Integrals_Bielec/ao_bi_integrals.irp.f | 64 +--- .../ao_bielec_integrals_in_map_slave.irp.f | 116 ++++--- src/ZMQ/NEEDED_CHILDREN_MODULES | 2 +- src/ZMQ/zmq.irp.f | 297 ++++++++++++++++-- 12 files changed, 467 insertions(+), 174 deletions(-) create mode 100755 ocaml/create_git_sha1.sh diff --git a/ocaml/.gitignore b/ocaml/.gitignore index 5618a6c0..51fdb52b 100644 --- a/ocaml/.gitignore +++ b/ocaml/.gitignore @@ -39,9 +39,15 @@ test_excitation test_excitation.byte test_gto test_gto.byte +test_message +test_message.byte test_mo_label test_mo_label.byte test_molecule test_molecule.byte test_point3d test_point3d.byte +test_queuing_system +test_queuing_system.byte +test_task_server +test_task_server.byte diff --git a/ocaml/Message.ml b/ocaml/Message.ml index 43982059..f47d6cec 100644 --- a/ocaml/Message.ml +++ b/ocaml/Message.ml @@ -106,6 +106,27 @@ end = struct (Id.Client.to_int x.client_id) end +module DisconnectReply_msg : sig + type t = + { finished: bool ; + state: State.t ; + } + val create : state:State.t -> finished:bool -> t + val to_string : t -> string +end = struct + type t = + { finished: bool; + state: State.t ; + } + let create ~state ~finished = + { state ; finished } + let to_string x = + Printf.sprintf "disconnect_reply %s %d" + (State.to_string x.state) + (if x.finished then 1 else 0) +end + + (** AddTask : Add a new task to the queue *) module AddTask_msg : sig @@ -245,6 +266,7 @@ type t = | Connect of Connect_msg.t | ConnectReply of ConnectReply_msg.t | Disconnect of Disconnect_msg.t +| DisconnectReply of DisconnectReply_msg.t | GetTask of GetTask_msg.t | GetTaskReply of GetTaskReply_msg.t | AddTask of AddTask_msg.t @@ -289,6 +311,7 @@ let to_string = function | Connect x -> Connect_msg.to_string x | ConnectReply x -> ConnectReply_msg.to_string x | Disconnect x -> Disconnect_msg.to_string x +| DisconnectReply x -> DisconnectReply_msg.to_string x | GetTask x -> GetTask_msg.to_string x | GetTaskReply x -> GetTaskReply_msg.to_string x | AddTask x -> AddTask_msg.to_string x diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 4c5b2ff2..1f882540 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -66,19 +66,15 @@ let ip_address = lazy ( end ) -(** Initial ZeroMQ port : - Random port number between 49152 and 65535 *) -let port = lazy ( - 1024 + (Random.int (49151-1024)) ) -let stop () = +let stop ~port = let zmq_context = ZMQ.Context.create () in let req_socket = ZMQ.Socket.create zmq_context ZMQ.Socket.req and address = - Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) (Lazy.force port) + Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) port in ZMQ.Socket.connect req_socket address; @@ -100,7 +96,7 @@ let stop () = (** Run the task server *) -let run () = +let run ~port = let zmq_context = ZMQ.Context.create () @@ -109,7 +105,7 @@ let run () = let rep_socket = ZMQ.Socket.create zmq_context ZMQ.Socket.rep and address = - Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) (Lazy.force port) + Printf.sprintf "tcp://%s:%d" (Lazy.force ip_address) port in bind_socket "REP" rep_socket address; @@ -118,6 +114,8 @@ let run () = [| (rep_socket, ZMQ.Poll.In) |] in + Printf.printf "Task server running : %s\n%!" address; + (** State variables *) let q = ref (Queuing_system.create ()) @@ -194,7 +192,13 @@ let run () = Queuing_system.del_client ~client_id:c !q in q := new_q; - Message.to_string ok + let finished = + Queuing_system.number_of_queued !q + + Queuing_system.number_of_running !q = 0 + in + Message.DisconnectReply (Message.DisconnectReply_msg.create + ~state ~finished) + |> Message.to_string |> ZMQ.Socket.send rep_socket and add_task state msg = @@ -257,8 +261,12 @@ let run () = let message = Message.of_string raw_message in - Printf.printf "%s\n%!" (Message.to_string message); - Printf.printf "%s\n%!" (Queuing_system.to_string !q); +(* + Printf.printf "%d %d : %s\n%!" + (Queuing_system.number_of_queued !q) + (Queuing_system.number_of_running !q) + (Message.to_string message); + Printf.printf "%s\n%!" (Queuing_system.to_string !q); *) match (state, message) with | _ , Message.Terminate _ -> terminate () | None , Message.Newjob x -> newjob x @@ -280,7 +288,9 @@ let run () = ZMQ.Socket.close rep_socket +(* let () = Printf.printf "export QP_RUN_ADDRESS=tcp://%s:%d\n%!" (Lazy.force ip_address) (Lazy.force port) +*) diff --git a/ocaml/create_git_sha1.sh b/ocaml/create_git_sha1.sh new file mode 100755 index 00000000..75174319 --- /dev/null +++ b/ocaml/create_git_sha1.sh @@ -0,0 +1,12 @@ +#!/bin/bash + +SHA1=$(git log -1 | head -1 | cut -d ' ' -f 2) +DATE=$(git log -1 | grep Date | cut -d ':' -f 2) +MESSAGE=$(git log -1 | tail -1) +cat << EOF > Git.ml +open Core.Std +let sha1 = "$SHA1" |> String.strip +let date = "$DATE" |> String.strip +let message = "$MESSAGE" |> String.strip +EOF + diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index dd22025a..a693aa2f 100644 --- a/ocaml/qp_edit.ml +++ b/ocaml/qp_edit.ml @@ -17,12 +17,12 @@ type keyword = | Electrons | Mo_basis | Nuclei -| Perturbation -| Hartree_fock -| Pseudo -| Integrals_bielec | Determinants +| Integrals_bielec +| Pseudo +| Perturbation | Properties +| Hartree_fock ;; @@ -32,12 +32,12 @@ let keyword_to_string = function | Electrons -> "Electrons" | Mo_basis -> "MO basis" | Nuclei -> "Molecule" -| Perturbation -> "Perturbation" -| Hartree_fock -> "Hartree_fock" -| Pseudo -> "Pseudo" -| Integrals_bielec -> "Integrals_bielec" | Determinants -> "Determinants" +| Integrals_bielec -> "Integrals_bielec" +| Pseudo -> "Pseudo" +| Perturbation -> "Perturbation" | Properties -> "Properties" +| Hartree_fock -> "Hartree_fock" ;; @@ -86,18 +86,18 @@ let get s = f Ao_basis.(read, to_rst) | Determinants_by_hand -> f Determinants_by_hand.(read, to_rst) - | Perturbation -> - f Perturbation.(read, to_rst) - | Hartree_fock -> - f Hartree_fock.(read, to_rst) - | Pseudo -> - f Pseudo.(read, to_rst) - | Integrals_bielec -> - f Integrals_bielec.(read, to_rst) | Determinants -> f Determinants.(read, to_rst) + | Integrals_bielec -> + f Integrals_bielec.(read, to_rst) + | Pseudo -> + f Pseudo.(read, to_rst) + | Perturbation -> + f Perturbation.(read, to_rst) | Properties -> f Properties.(read, to_rst) + | Hartree_fock -> + f Hartree_fock.(read, to_rst) end with | Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "") @@ -135,12 +135,12 @@ let set str s = in let open Input in match s with - | Perturbation -> write Perturbation.(of_rst, write) s - | Hartree_fock -> write Hartree_fock.(of_rst, write) s - | Pseudo -> write Pseudo.(of_rst, write) s - | Integrals_bielec -> write Integrals_bielec.(of_rst, write) s | Determinants -> write Determinants.(of_rst, write) s + | Integrals_bielec -> write Integrals_bielec.(of_rst, write) s + | Pseudo -> write Pseudo.(of_rst, write) s + | Perturbation -> write Perturbation.(of_rst, write) s | Properties -> write Properties.(of_rst, write) s + | Hartree_fock -> write Hartree_fock.(of_rst, write) s | Electrons -> write Electrons.(of_rst, write) s | Determinants_by_hand -> write Determinants_by_hand.(of_rst, write) s | Nuclei -> write Nuclei.(of_rst, write) s @@ -169,7 +169,7 @@ let run check_only ezfio_filename = (* Open EZFIO *) if (not (Sys.file_exists_exn ezfio_filename)) then - failwith (ezfio_filename^" does not exist"); + failwith (ezfio_filename^" does not exists"); Ezfio.set_file ezfio_filename; @@ -188,12 +188,12 @@ let run check_only ezfio_filename = Nuclei ; Ao_basis; Electrons ; - Perturbation ; - Hartree_fock ; - Pseudo ; - Integrals_bielec ; Determinants ; + Integrals_bielec ; + Pseudo ; + Perturbation ; Properties ; + Hartree_fock ; Mo_basis; Determinants_by_hand ; ] diff --git a/ocaml/qp_run.ml b/ocaml/qp_run.ml index eb1445d8..600c6f24 100644 --- a/ocaml/qp_run.ml +++ b/ocaml/qp_run.ml @@ -17,13 +17,38 @@ let run exe ezfio_file = if (not (List.exists ~f:(fun (x,_) -> x = exe) executables)) then failwith ("Executable "^exe^" not found"); + Printf.printf "%s\n" (Time.to_string time_start); Printf.printf "===============\nQuantum Package\n===============\n\n"; - Printf.printf "Date : %s\n\n%!" (Time.to_string time_start); + Printf.printf "Git Commit: %s\n" Git.message; + Printf.printf "Git Date : %s\n" Git.date; + Printf.printf "Git SHA1 : %s\n" Git.sha1; + Printf.printf "\n\n%!"; + + (** Check input *) match (Sys.command ("qp_edit -c "^ezfio_file)) with | 0 -> () | i -> failwith "Error: Input inconsistent\n"; ; + + + (** Start task server *) + let port_number = + 12345 + in + let address = + Printf.sprintf "tcp://%s:%d" (Lazy.force TaskServer.ip_address) port_number + in + let task_thread = + let thread = + Thread.create ( fun () -> + TaskServer.run port_number ) + in + thread (); + in + Unix.putenv ~key:"QP_RUN_ADDRESS" ~data:address; + + (** Run executable *) let exe = match (List.find ~f:(fun (x,_) -> x = exe) executables) with | None -> assert false @@ -34,6 +59,9 @@ let run exe ezfio_file = | i -> Printf.printf "Program exited with code %d.\n%!" i; ; + TaskServer.stop ~port:port_number; + Thread.join task_thread; + let duration = Time.diff (Time.now()) time_start |> Core.Span.to_string in Printf.printf "Wall time : %s\n\n" duration; @@ -60,6 +88,7 @@ Executes a Quantum Package binary file among these:\n\n" (fun exe ezfio_file () -> run exe ezfio_file ) - |> Command.run + |> Command.run ~version: Git.sha1 ~build_info: Git.message ;; + diff --git a/ocaml/test_task_server.ml b/ocaml/test_task_server.ml index 55f74202..e6a6106b 100644 --- a/ocaml/test_task_server.ml +++ b/ocaml/test_task_server.ml @@ -1,5 +1,5 @@ open Core let () = - TaskServer.run () + TaskServer.run 12345 diff --git a/ocaml/test_task_server.py b/ocaml/test_task_server.py index 07835820..cb7da8ee 100755 --- a/ocaml/test_task_server.py +++ b/ocaml/test_task_server.py @@ -11,7 +11,7 @@ def main(): def send(msg,expected): print "Send : ", msg - socket.send(msg) + print " -> ", socket.send(msg) reply = socket.recv() print "Reply : ", reply print "" @@ -28,7 +28,7 @@ def main(): send("connect tcp","connect_reply ao_integrals 1 tcp://130.120.229.139:12345") send("connect inproc","connect_reply ao_integrals 2 inproc://ao_integrals") send("disconnect ao_integrals 3","error Queuing_system.ml:65:2 : disconnect ao_integrals 3") - send("disconnect ao_integrals 2","ok") + send("disconnect ao_integrals 2","disconnect_reply ao_integrals 1") send("connect inproc","connect_reply ao_integrals 3 inproc://ao_integrals") for i in range(10): diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index 53ce68e9..6987d06b 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -348,7 +348,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] real(integral_kind),allocatable :: buffer_value(:) integer :: n_integrals, rc - integer :: jl_pairs(2,ao_num*(ao_num+1)/2), kk, m, j1, i1, lmax + integer :: kk, m, j1, i1, lmax integral = ao_bielec_integral(1,1,1,1) @@ -368,55 +368,23 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] call wall_time(wall_1) call cpu_time(cpu_1) - integer(ZMQ_PTR) :: zmq_socket_rep_inproc, zmq_socket_push_inproc - zmq_socket_rep_inproc = f77_zmq_socket(zmq_context, ZMQ_REP) - rc = f77_zmq_bind(zmq_socket_rep_inproc, 'inproc://req_rep') - if (rc /= 0) then - stop 'Unable to connect zmq_socket_rep_inproc' - endif - - integer(ZMQ_PTR) :: thread(0:nproc) - external :: ao_bielec_integrals_in_map_slave, ao_bielec_integrals_in_map_collector - rc = pthread_create( thread(0), ao_bielec_integrals_in_map_collector ) - ! Create client threads - do i=1,nproc - rc = pthread_create( thread(i), ao_bielec_integrals_in_map_slave ) - enddo - - character*(64) :: message_string - - do l = ao_num, 1, -1 - rc = f77_zmq_recv( zmq_socket_rep_inproc, message_string, 64, 0) - print *, l - ! TODO : error handling - ASSERT (rc >= 0) - ASSERT (message == 'get_ao_integrals') - rc = f77_zmq_send( zmq_socket_rep_inproc, l, 4, 0) - enddo - do i=1,nproc - rc = f77_zmq_recv( zmq_socket_rep_inproc, message_string, 64, 0) - ! TODO : error handling - ASSERT (rc >= 0) - ASSERT (message == 'get_ao_integrals') - rc = f77_zmq_send( zmq_socket_rep_inproc, 0, 4, 0) - enddo - ! TODO terminer thread(0) - - rc = f77_zmq_unbind(zmq_socket_rep_inproc, 'inproc://req_rep') - do i=1,nproc - rc = pthread_join( thread(i) ) - enddo + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + call new_parallel_job(zmq_to_qp_run_socket,'ao_integrals') - zmq_socket_push_inproc = f77_zmq_socket(zmq_context, ZMQ_PUSH) - rc = f77_zmq_connect(zmq_socket_push_inproc, 'inproc://push_pull') - if (rc /= 0) then - stop 'Unable to connect zmq_socket_push_inproc' - endif - rc = f77_zmq_send( zmq_socket_push_inproc, -1, 4, ZMQ_SNDMORE) - rc = f77_zmq_send( zmq_socket_push_inproc, 0_key_kind, key_kind, ZMQ_SNDMORE) - rc = f77_zmq_send( zmq_socket_push_inproc, 0_integral_kind, integral_kind, 0) + character*(32) :: task + do l=1,ao_num + do j = 1, l + if (ao_overlap_abs(j,l) < ao_integrals_threshold) then + cycle + endif + write(task,*) j, l + call add_task_to_taskserver(zmq_to_qp_run_socket,task) + enddo + enddo + external :: ao_bielec_integrals_in_map_slave_inproc, ao_bielec_integrals_in_map_collector + call new_parallel_threads(ao_bielec_integrals_in_map_slave_inproc, ao_bielec_integrals_in_map_collector) - rc = pthread_join( thread(0) ) + call end_parallel_job(zmq_to_qp_run_socket,'ao_integrals') print*, 'Sorting the map' call map_sort(ao_integrals_map) diff --git a/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f b/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f index 7aa59c0d..e21014b8 100644 --- a/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f +++ b/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f @@ -1,4 +1,20 @@ -subroutine ao_bielec_integrals_in_map_slave +subroutine ao_bielec_integrals_in_map_slave_tcp + implicit none + BEGIN_DOC +! Computes a buffer of integrals + END_DOC + call ao_bielec_integrals_in_map_slave(0) +end + +subroutine ao_bielec_integrals_in_map_slave_inproc + implicit none + BEGIN_DOC +! Computes a buffer of integrals + END_DOC + call ao_bielec_integrals_in_map_slave(1) +end + +subroutine ao_bielec_integrals_in_map_slave(thread) use map_module use f77_zmq implicit none @@ -6,51 +22,61 @@ subroutine ao_bielec_integrals_in_map_slave ! Computes a buffer of integrals END_DOC + integer, intent(in) :: thread + integer :: j,l,n_integrals integer :: rc - character*(8), external :: zmq_port - integer(ZMQ_PTR) :: zmq_socket_req_inproc, zmq_socket_push_inproc real(integral_kind), allocatable :: buffer_value(:) integer(key_kind), allocatable :: buffer_i(:) + + integer :: worker_id, task_id + character*(512) :: task + + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + + integer(ZMQ_PTR) :: zmq_socket_push + zmq_socket_push = f77_zmq_socket(zmq_context, ZMQ_PUSH) + if (thread == 1) then + rc = f77_zmq_connect(zmq_socket_push, trim(zmq_socket_pull_inproc_address)) + else + rc = f77_zmq_connect(zmq_socket_push, trim(zmq_socket_push_tcp_address)) + endif + if (rc /= 0) then + stop 'Unable to connect zmq_socket_push_tcp' + endif allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) ) - ! Sockets - zmq_socket_req_inproc = f77_zmq_socket(zmq_context, ZMQ_REQ) - rc = f77_zmq_connect(zmq_socket_req_inproc, 'inproc://req_rep') - if (rc /= 0) then - stop 'Unable to connect zmq_socket_req_inproc' - endif + call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) - zmq_socket_push_inproc = f77_zmq_socket(zmq_context, ZMQ_PUSH) - rc = f77_zmq_connect(zmq_socket_push_inproc, 'inproc://push_pull') - if (rc /= 0) then - stop 'Unable to connect zmq_socket_push_inproc' - endif - - - - rc = f77_zmq_send( zmq_socket_req_inproc, 'get_ao_integrals', 16, 0) - rc = f77_zmq_recv( zmq_socket_req_inproc, l, 4, 0) - - do while (l > 0) - rc = f77_zmq_send( zmq_socket_req_inproc, 'get_ao_integrals', 16, 0) - - do j = 1, l - if (ao_overlap_abs(j,l) < ao_integrals_threshold) then - cycle - endif - call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value) - rc = f77_zmq_send( zmq_socket_push_inproc, n_integrals, 4, ZMQ_SNDMORE) - rc = f77_zmq_send( zmq_socket_push_inproc, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE) - rc = f77_zmq_send( zmq_socket_push_inproc, buffer_value, integral_kind*n_integrals, 0) - enddo - rc = f77_zmq_recv( zmq_socket_req_inproc, l, 4, 0) + do + call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) + if (task_id == 0) then + exit + endif + read(task,*) j, l + call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value) + rc = f77_zmq_send( zmq_socket_push, n_integrals, 4, ZMQ_SNDMORE) + rc = f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE) + rc = f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, 0) + call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) enddo deallocate( buffer_i, buffer_value ) - rc = f77_zmq_disconnect(zmq_socket_req_inproc, 'inproc://req_rep') + integer :: finished + call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id,finished) + + if (finished /= 0) then + rc = f77_zmq_send( zmq_socket_push, -1, 4, 0) + endif + + rc = f77_zmq_disconnect(zmq_socket_push,trim(zmq_socket_push_tcp_address)) + rc = f77_zmq_close(zmq_socket_push) + end @@ -64,36 +90,24 @@ subroutine ao_bielec_integrals_in_map_collector integer :: j,l,n_integrals integer :: rc - character*(8), external :: zmq_port - integer(ZMQ_PTR) :: zmq_socket_pull_inproc real(integral_kind), allocatable :: buffer_value(:) integer(key_kind), allocatable :: buffer_i(:) allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) ) - zmq_socket_pull_inproc = f77_zmq_socket(zmq_context, ZMQ_PULL) - rc = f77_zmq_bind(zmq_socket_pull_inproc, 'inproc://push_pull') - if (rc /= 0) then - stop 'Unable to connect zmq_socket_pull_inproc' - endif - n_integrals = 0 do while (n_integrals >= 0) - rc = f77_zmq_recv( zmq_socket_pull_inproc, n_integrals, 4, 0) - if (n_integrals > -1) then - rc = f77_zmq_recv( zmq_socket_pull_inproc, buffer_i, key_kind*n_integrals, 0) - rc = f77_zmq_recv( zmq_socket_pull_inproc, buffer_value, integral_kind*n_integrals, 0) + rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0) + if (n_integrals >= 0) then + rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0) + rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0) call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value) - else - rc = f77_zmq_recv( zmq_socket_pull_inproc, buffer_i, key_kind, 0) - rc = f77_zmq_recv( zmq_socket_pull_inproc, buffer_value, integral_kind, 0) endif enddo - rc = f77_zmq_unbind(zmq_socket_pull_inproc, 'inproc://push_pull') - deallocate( buffer_i, buffer_value ) + end diff --git a/src/ZMQ/NEEDED_CHILDREN_MODULES b/src/ZMQ/NEEDED_CHILDREN_MODULES index 8b137891..19028952 100644 --- a/src/ZMQ/NEEDED_CHILDREN_MODULES +++ b/src/ZMQ/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ - +Utils diff --git a/src/ZMQ/zmq.irp.f b/src/ZMQ/zmq.irp.f index 1577e12f..6a887422 100644 --- a/src/ZMQ/zmq.irp.f +++ b/src/ZMQ/zmq.irp.f @@ -20,10 +20,10 @@ END_PROVIDER character*(128) :: buffer call getenv('QP_RUN_ADDRESS',buffer) if (trim(buffer) == '') then - stop 'QP_RUN_ADDRESS environment variable not defined' + print *, 'This run should be started with the qp_run command' + stop -1 endif - print *, trim(buffer) integer :: i do i=len(buffer),1,-1 if ( buffer(i:i) == ':') then @@ -44,62 +44,293 @@ function zmq_port(ishift) end -BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_to_qp_run_socket ] +function new_zmq_to_qp_run_socket() implicit none BEGIN_DOC ! Socket on which the qp_run process replies END_DOC integer :: rc - zmq_to_qp_run_socket = f77_zmq_socket(zmq_context, ZMQ_REQ) - rc = f77_zmq_connect(zmq_to_qp_run_socket, trim(qp_run_address)) + character*(8), external :: zmq_port + integer(ZMQ_PTR) :: new_zmq_to_qp_run_socket + + new_zmq_to_qp_run_socket = f77_zmq_socket(zmq_context, ZMQ_REQ) + rc = f77_zmq_connect(new_zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0))) if (rc /= 0) then - stop 'Unable to connect zmq_to_qp_run_socket' + stop 'Unable to connect new_zmq_to_qp_run_socket' endif integer :: i i=4 - rc = f77_zmq_setsockopt(zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 120000, i) + rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_SNDTIMEO, 120000, i) if (rc /= 0) then - stop 'Unable to set send timout in zmq_to_qp_run_socket' + stop 'Unable to set send timout in new_zmq_to_qp_run_socket' endif - rc = f77_zmq_setsockopt(zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 120000, i) + rc = f77_zmq_setsockopt(new_zmq_to_qp_run_socket, ZMQ_RCVTIMEO, 120000, i) if (rc /= 0) then - stop 'Unable to set recv timout in zmq_to_qp_run_socket' + stop 'Unable to set recv timout in new_zmq_to_qp_run_socket' endif -END_PROVIDER +end -BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_socket_push ] - implicit none - BEGIN_DOC - ! Socket on which to push the results (1) - END_DOC - integer :: rc - character*(64) :: address - character*(8), external :: zmq_port - zmq_socket_push = f77_zmq_socket(zmq_context, ZMQ_PUSH) - address = trim(qp_run_address)//':'//zmq_port(1) - rc = f77_zmq_connect(zmq_socket_push, trim(address)) - if (rc /= 0) then - stop 'Unable to connect zmq_socket_push' - endif - -END_PROVIDER -BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_socket_pull ] + BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_socket_pull ] +&BEGIN_PROVIDER [ character*(128), zmq_socket_pull_tcp_address ] +&BEGIN_PROVIDER [ character*(128), zmq_socket_push_tcp_address ] +&BEGIN_PROVIDER [ character*(128), zmq_socket_pull_inproc_address ] implicit none BEGIN_DOC ! Socket which pulls the results (2) END_DOC integer :: rc - character*(64) :: address character*(8), external :: zmq_port + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + + zmq_socket_pull_tcp_address = 'tcp://*:'//zmq_port(1) + zmq_socket_push_tcp_address = trim(qp_run_address)//':'//zmq_port(1) + zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(1) + zmq_socket_pull = f77_zmq_socket(zmq_context, ZMQ_PULL) - address = 'tcp://*:'//zmq_port(2) - rc = f77_zmq_bind(zmq_socket_pull, trim(address)) + rc = f77_zmq_bind(zmq_socket_pull, zmq_socket_pull_tcp_address) + rc = f77_zmq_bind(zmq_socket_pull, zmq_socket_pull_inproc_address) if (rc /= 0) then - stop 'Unable to connect zmq_socket_pull' + stop 'Unable to bind zmq_socket_pull (tcp)' endif - + END_PROVIDER + BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_thread, (0:nproc) ] +&BEGIN_PROVIDER [ character*(128), zmq_state ] + implicit none + BEGIN_DOC +! Threads executing work through the ZeroMQ interface + END_DOC + zmq_thread = 0_ZMQ_PTR + zmq_state = '' +END_PROVIDER + +subroutine new_parallel_job(zmq_to_qp_run_socket,name) + implicit none + BEGIN_DOC +! Start a new parallel job with name 'name'. The slave tasks execute subroutine 'slave' + END_DOC + character*(*), intent(in) :: name + + character*(512) :: message + integer :: rc + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR), intent(out) :: zmq_to_qp_run_socket + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + message = 'new_job '//name//' '//zmq_socket_push_tcp_address//' '//zmq_socket_pull_inproc_address + rc = f77_zmq_send(zmq_to_qp_run_socket,message,len(trim(message)),0) + rc = f77_zmq_recv(zmq_to_qp_run_socket,message,510,0) + message = trim(message(1:rc)) + if (message(1:2) /= 'ok') then + print *, 'Unable to start parallel job : '//name + stop 1 + endif + + zmq_state = name + SOFT_TOUCH zmq_state zmq_thread + +end + +subroutine new_parallel_threads(slave,collector) + implicit none + BEGIN_DOC +! Start a new parallel job with name 'name'. The slave tasks execute subroutine 'slave' + END_DOC + external :: slave, collector + integer :: i,rc + + + rc = pthread_create( zmq_thread(0), collector) + do i=1,nproc + rc = pthread_create( zmq_thread(i), slave ) + enddo + SOFT_TOUCH zmq_thread zmq_state + +end + +subroutine connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) + implicit none + BEGIN_DOC +! Connect to the task server and obtain the worker ID + END_DOC + integer, intent(out) :: worker_id + integer, intent(in) :: thread + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + + character*(512) :: message + character*(128) :: reply, state, address + integer :: rc + + if (thread == 1) then + rc = f77_zmq_send(zmq_to_qp_run_socket, "connect inproc", 14, 0) + else + rc = f77_zmq_send(zmq_to_qp_run_socket, "connect tcp", 11, 0) + endif + + rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) + message = trim(message(1:rc)) + read(message,*) reply, state, worker_id, address + if ( (trim(reply) /= 'connect_reply') .and. & + (trim(state) /= trim(zmq_state)) ) then + print *, 'Reply: ', trim(reply) + print *, 'State: ', trim(state), '/', trim(zmq_state) + print *, 'Address: ', trim(address) + stop -1 + endif + +end + +subroutine disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id,finished) + implicit none + BEGIN_DOC +! Disconnect from the task server + END_DOC + integer, intent(in) :: worker_id + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + integer, intent(out) :: finished + + integer :: rc + character*(64) :: message, reply, state + write(message,*) 'disconnect '//trim(zmq_state), worker_id + + rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), len(trim(message)), 0) + + rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) + message = trim(message(1:rc)) + + read(message,*) reply, state, finished + if ( (trim(reply) /= 'disconnect_reply').or. & + (trim(state) /= zmq_state) ) then + print *, 'Unable to disconnect' + print *, trim(message) + stop -1 + endif + +end + +subroutine add_task_to_taskserver(zmq_to_qp_run_socket,task) + implicit none + BEGIN_DOC +! Get a task from the task server + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + character*(*), intent(in) :: task + + integer :: rc + character*(512) :: message + write(message,*) 'add_task '//trim(zmq_state)//' '//trim(task) + + rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), len(trim(message)), 0) + + rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) + message = trim(message(1:rc)) + if (trim(message) /= 'ok') then + print *, trim(task) + print *, 'Unable to add the next task' + stop -1 + endif + +end + +subroutine task_done_to_taskserver(zmq_to_qp_run_socket,worker_id, task_id) + implicit none + BEGIN_DOC +! Get a task from the task server + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + integer, intent(in) :: worker_id, task_id + + integer :: rc + character*(512) :: message + write(message,*) 'task_done '//trim(zmq_state), worker_id, task_id + + rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), len(trim(message)), 0) + + rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) + message = trim(message(1:rc)) + if (trim(message) /= 'ok') then + print *, 'Unable to send task_done message' + stop -1 + endif + +end + +subroutine get_task_from_taskserver(zmq_to_qp_run_socket,worker_id,task_id,task) + implicit none + BEGIN_DOC +! Get a task from the task server + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + integer, intent(in) :: worker_id + integer, intent(out) :: task_id + character*(512), intent(out) :: task + + character*(512) :: message + character*(64) :: reply + integer :: rc + + write(message,*) 'get_task '//trim(zmq_state), worker_id + + rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), len(trim(message)), 0) + + rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0) + message = trim(message(1:rc)) + read(message,*) reply + if (trim(reply) == 'get_task_reply') then + read(message,*) reply, task_id + rc = 15 + do while (message(rc:rc) == ' ') + rc += 1 + enddo + do while (message(rc:rc) /= ' ') + rc += 1 + enddo + rc += 1 + task = message(rc:) + else if (trim(reply) == 'terminate') then + task_id = 0 + task = 'terminate' + else + print *, 'Unable to get the next task' + print *, trim(message) + stop -1 + endif + +end + + +subroutine end_parallel_job(zmq_to_qp_run_socket,name) + implicit none + BEGIN_DOC +! End a new parallel job with name 'name'. The slave tasks execute subroutine 'slave' + END_DOC + integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket + character*(*), intent(in) :: name + + character*(512) :: message + integer :: i,rc + + if (name /= zmq_state) then + stop 'Wrong end of job' + endif + + do i=1,nproc + rc = pthread_join( zmq_thread(i) ) + if (rc /= 0) then + print *, 'Unable to join thread : ', i + stop -1 + endif + zmq_thread(i) = 0 + enddo + zmq_state = 'None' + character*(8), external :: zmq_port + rc = f77_zmq_disconnect(zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0))) + rc = f77_zmq_close(zmq_to_qp_run_socket) + + SOFT_TOUCH zmq_thread zmq_state + +end From 7f65192e6881cb398671327706730a08bb0c09a8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 7 Dec 2015 22:26:42 +0100 Subject: [PATCH 07/47] Added ZMQ in ocaml installation --- install/scripts/install_ocaml.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/scripts/install_ocaml.sh b/install/scripts/install_ocaml.sh index 5c9bb89e..4cc64d0a 100755 --- a/install/scripts/install_ocaml.sh +++ b/install/scripts/install_ocaml.sh @@ -5,7 +5,7 @@ QP_ROOT=$PWD cd - # Normal installation -PACKAGES="core cryptokit ocamlfind sexplib" +PACKAGES="core cryptokit ocamlfind sexplib ZMQ" declare -i i i=$(gcc -dumpversion | cut -d '.' -f 2) From e223b1b7e4ab55688d40b4c696e85659d7ec967f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Dec 2015 11:31:02 +0100 Subject: [PATCH 08/47] Add ZMQ before ocaml install --- configure | 2 +- install/scripts/install_ocaml.sh | 20 ++++++++++++++++++-- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/configure b/configure index 96332a32..c43b6593 100755 --- a/configure +++ b/configure @@ -52,7 +52,7 @@ QP_ROOT_INSTALL = join(QP_ROOT, "install") os.environ["PATH"] = os.environ["PATH"] + ":" + QP_ROOT_BIN d_dependency = { - "ocaml": ["m4", "curl", "zlib", "patch", "gcc"], + "ocaml": ["m4", "curl", "zlib", "patch", "gcc", "zeromq"], "m4": ["make"], "curl": ["make"], "zlib": ["gcc", "make"], diff --git a/install/scripts/install_ocaml.sh b/install/scripts/install_ocaml.sh index 4cc64d0a..a2bbc7ba 100755 --- a/install/scripts/install_ocaml.sh +++ b/install/scripts/install_ocaml.sh @@ -7,14 +7,30 @@ cd - # Normal installation PACKAGES="core cryptokit ocamlfind sexplib ZMQ" +# Needed for ZeroMQ +export C_INCLUDE_PATH="${QP_ROOT}"/lib:"${C_INCLUDE_PATH}" +export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}" +export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}" + declare -i i -i=$(gcc -dumpversion | cut -d '.' -f 2) -if [[ i -lt 6 ]] +i=$(gcc -dumpversion | cut -d '.' -f 1) +if [[ i -lt 4 ]] then echo "GCC version $(gcc -dumpversion) too old. GCC >= 4.6 required." exit 1 fi + +if [[ i -eq 4 ]] +then + i=$(gcc -dumpversion | cut -d '.' -f 2) + if [[ i -lt 6 ]] + then + echo "GCC version $(gcc -dumpversion) too old. GCC >= 4.6 required." + exit 1 + fi +fi + if [[ -d ${HOME}/.opam ]] then source ${HOME}/.opam/opam-init/init.sh > /dev/null 2> /dev/null || true From 88205e0b255f456901481e4c8c13135fc8e3e8bb Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Dec 2015 11:39:24 +0100 Subject: [PATCH 09/47] Added Git.ml generation in ocaml --- ocaml/Makefile | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/ocaml/Makefile b/ocaml/Makefile index dce21ca5..01473ec2 100644 --- a/ocaml/Makefile +++ b/ocaml/Makefile @@ -24,7 +24,7 @@ ALL_EXE=$(patsubst %.ml,%.native,$(wildcard qp_*.ml)) qp_edit.native default: $(ALL_TESTS) $(ALL_EXE) .gitignore .gitignore: $(MLFILES) - @for i in .gitignore ezfio.ml Qptypes.ml qptypes_generator.byte _build $(ALL_EXE) $(ALL_TESTS) \ + @for i in .gitignore ezfio.ml Qptypes.ml Git.ml qptypes_generator.byte _build $(ALL_EXE) $(ALL_TESTS) \ $(patsubst %.ml,%,$(wildcard test_*.ml)) $(patsubst %.ml,%,$(wildcard qp_*.ml)) \ $(shell grep Input Input_auto_generated.ml | awk '{print $$2 ".ml"}') \ qp_edit.ml qp_edit qp_edit.native Input_auto_generated.ml;\ @@ -34,6 +34,7 @@ default: $(ALL_TESTS) $(ALL_EXE) .gitignore executables: $(QP_ROOT)/data/executables + $(QP_ROOT)/data/executables: remake_executables $(QP_ROOT)/scripts/module/create_executables_list.sh @@ -68,8 +69,9 @@ ezfio.ml: ${QP_ROOT}/install/EZFIO/Ocaml/ezfio.ml qptypes_generator.byte: qptypes_generator.ml $(OCAMLBUILD) qptypes_generator.byte -use-ocamlfind -Qptypes.ml: qptypes_generator.byte +Git.ml Qptypes.ml: qptypes_generator.byte ./qptypes_generator.byte > Qptypes.ml + ./create_git_sha1.sh ${QP_ROOT}/install/EZFIO/Ocaml/ezfio.ml: $(NINJA) -C ${QP_ROOT}/install/EZFIO @@ -78,5 +80,5 @@ Input_auto_generated.ml qp_edit.ml: ei_handler.py ocaml_global clean: - rm -rf _build Qptypes.ml Input_auto_generated.ml $(ALL_EXE) $(ALL_TESTS) + rm -rf _build Qptypes.ml Git.ml Input_auto_generated.ml $(ALL_EXE) $(ALL_TESTS) From cdb7f35e48e799f9cdfc7997196077ced70c1a6c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Dec 2015 12:21:05 +0100 Subject: [PATCH 10/47] tput sgr0 after vim --- ocaml/qp_edit.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index a693aa2f..adde69a7 100644 --- a/ocaml/qp_edit.ml +++ b/ocaml/qp_edit.ml @@ -212,7 +212,7 @@ let run check_only ezfio_filename = match check_only with | true -> () | false -> - Printf.sprintf "%s %s" editor temp_filename + Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename |> Sys.command_exn ; From e27a7ccec1f6541f5fce6a2483b82063fe9d3072 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Dec 2015 12:23:03 +0100 Subject: [PATCH 11/47] touch only if executable --- scripts/compilation/qp_create_ninja.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/compilation/qp_create_ninja.py b/scripts/compilation/qp_create_ninja.py index a57c7cbf..7fd5d248 100755 --- a/scripts/compilation/qp_create_ninja.py +++ b/scripts/compilation/qp_create_ninja.py @@ -637,7 +637,7 @@ def ninja_binaries_rule(): # c m d # # ~#~#~ # - l_cmd = ["cd $module_abs/IRPF90_temp", "ninja $out && touch $out"] + l_cmd = ["cd $module_abs/IRPF90_temp", "ninja $out && [[ -x $out ]] && touch $out"] # ~#~#~#~#~#~ # # s t r i n g # From e85a5927a1910a9e7a9946306ce64d214308b8b2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Dec 2015 13:24:43 +0100 Subject: [PATCH 12/47] Natural orbitals using SVD --- config/ifort.cfg | 4 +-- install/Downloads/.gitignore | 0 ocaml/.gitignore | 1 + plugins/CAS_SD/cas_s_selected.irp.f | 2 +- scripts/compilation/qp_create_ninja.py | 2 +- src/Determinants/density_matrix.irp.f | 14 +++----- src/MO_Basis/mo_overlap.irp.f | 2 +- src/MO_Basis/utils.irp.f | 47 ++++++++++++++++++++++++++ src/Utils/LinearAlgebra.irp.f | 7 ++-- 9 files changed, 61 insertions(+), 18 deletions(-) delete mode 100644 install/Downloads/.gitignore diff --git a/config/ifort.cfg b/config/ifort.cfg index c1d7e968..bfa41c03 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -31,14 +31,14 @@ OPENMP : 1 ; Append OpenMP flags # -ftz : Flushes denormal results to zero # [OPT] -FCFLAGS : -xSSE4.2 -O2 -ip -opt-prefetch -ftz -g +FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g # Profiling flags ################# # [PROFILE] FC : -p -g -FCFLAGS : -xSSE4.2 -O2 -ip -opt-prefetch -ftz +FCFLAGS : -xSSE4.2 -O2 -ip -ftz # Debugging flags ################# diff --git a/install/Downloads/.gitignore b/install/Downloads/.gitignore deleted file mode 100644 index e69de29b..00000000 diff --git a/ocaml/.gitignore b/ocaml/.gitignore index 51fdb52b..761a0130 100644 --- a/ocaml/.gitignore +++ b/ocaml/.gitignore @@ -1,6 +1,7 @@ _build ezfio.ml .gitignore +Git.ml Input_auto_generated.ml Input_determinants.ml Input_hartree_fock.ml diff --git a/plugins/CAS_SD/cas_s_selected.irp.f b/plugins/CAS_SD/cas_s_selected.irp.f index 7a72a243..b1fd542a 100644 --- a/plugins/CAS_SD/cas_s_selected.irp.f +++ b/plugins/CAS_SD/cas_s_selected.irp.f @@ -30,7 +30,7 @@ program full_ci endif do while (N_det < N_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max) - call H_apply_CAS_S_selected(pt2, norm_pert, H_pert_diag, N_st) + call H_apply_CAS_S_selected_no_skip(pt2, norm_pert, H_pert_diag, N_st) PROVIDE psi_coef PROVIDE psi_det diff --git a/scripts/compilation/qp_create_ninja.py b/scripts/compilation/qp_create_ninja.py index 7fd5d248..325d7860 100755 --- a/scripts/compilation/qp_create_ninja.py +++ b/scripts/compilation/qp_create_ninja.py @@ -637,7 +637,7 @@ def ninja_binaries_rule(): # c m d # # ~#~#~ # - l_cmd = ["cd $module_abs/IRPF90_temp", "ninja $out && [[ -x $out ]] && touch $out"] + l_cmd = ["cd $module_abs/IRPF90_temp", "ninja $out && for i in $out ; do [ -x $$i ] && touch $$i ; done"] # ~#~#~#~#~#~ # # s t r i n g # diff --git a/src/Determinants/density_matrix.irp.f b/src/Determinants/density_matrix.irp.f index 9aeb658e..e5d243f4 100644 --- a/src/Determinants/density_matrix.irp.f +++ b/src/Determinants/density_matrix.irp.f @@ -10,7 +10,7 @@ double precision :: ck, cl, ckl double precision :: phase integer :: h1,h2,p1,p2,s1,s2, degree - integer :: exc(0:2,2,2),n_occ_alpha + integer :: exc(0:2,2,2),n_occ(2) double precision, allocatable :: tmp_a(:,:), tmp_b(:,:) if(only_single_double_dm)then @@ -22,7 +22,7 @@ one_body_dm_mo_beta = 0.d0 !$OMP PARALLEL DEFAULT(NONE) & !$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)& + !$OMP tmp_a, tmp_b, n_occ)& !$OMP SHARED(psi_det,psi_coef,N_int,N_states,state_average_weight,elec_alpha_num,& !$OMP elec_beta_num,one_body_dm_mo_alpha,one_body_dm_mo_beta,N_det,mo_tot_num_align,& !$OMP mo_tot_num) @@ -31,8 +31,7 @@ tmp_b = 0.d0 !$OMP DO SCHEDULE(dynamic) do k=1,N_det - call bitstring_to_list(psi_det(1,1,k), occ(1,1), n_occ_alpha, N_int) - call bitstring_to_list(psi_det(1,2,k), occ(1,2), n_occ_alpha, N_int) + call bitstring_to_list_ab(psi_det(1,1,k), occ, n_occ, N_int) do m=1,N_states ck = psi_coef(k,m)*psi_coef(k,m) * state_average_weight(m) do l=1,elec_alpha_num @@ -182,13 +181,10 @@ subroutine set_natural_mos END_DOC character*(64) :: label double precision, allocatable :: tmp(:,:) - allocate(tmp(size(one_body_dm_mo,1),size(one_body_dm_mo,2))) - ! Negation to have the occupied MOs first after the diagonalization - tmp = one_body_dm_mo label = "Natural" - call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,-1) - deallocate(tmp) +! call mo_as_eigvectors_of_mo_matrix(one_body_dm_mo,size(one_body_dm_mo,1),mo_tot_num,label,-1) + call mo_as_svd_vectors_of_mo_matrix(one_body_dm_mo,size(one_body_dm_mo,1),mo_tot_num,mo_tot_num,label) end subroutine save_natural_mos diff --git a/src/MO_Basis/mo_overlap.irp.f b/src/MO_Basis/mo_overlap.irp.f index 9b8b48f0..c7e146bc 100644 --- a/src/MO_Basis/mo_overlap.irp.f +++ b/src/MO_Basis/mo_overlap.irp.f @@ -4,7 +4,7 @@ BEGIN_PROVIDER [ double precision, mo_overlap,(mo_tot_num_align,mo_tot_num)] integer :: i,j,n,l double precision :: f integer :: lmax - lmax = iand(ao_num,-4) + lmax = (ao_num/4) * 4 !$OMP PARALLEL DO SCHEDULE(STATIC) DEFAULT(NONE) & !$OMP PRIVATE(i,j,n,l) & !$OMP SHARED(mo_overlap,mo_coef,ao_overlap, & diff --git a/src/MO_Basis/utils.irp.f b/src/MO_Basis/utils.irp.f index 0d8ef5fa..462addc0 100644 --- a/src/MO_Basis/utils.irp.f +++ b/src/MO_Basis/utils.irp.f @@ -100,6 +100,53 @@ subroutine mo_as_eigvectors_of_mo_matrix(matrix,n,m,label,sign) mo_label = label end +subroutine mo_as_svd_vectors_of_mo_matrix(matrix,lda,m,n,label) + implicit none + integer,intent(in) :: lda,m,n + character*(64), intent(in) :: label + double precision, intent(in) :: matrix(lda,n) + + integer :: i,j + double precision, allocatable :: mo_coef_new(:,:), U(:,:),D(:), A(:,:), Vt(:,:), work(:) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A + + call write_time(output_mo_basis) + if (m /= mo_tot_num) then + print *, irp_here, ': Error : m/= mo_tot_num' + stop 1 + endif + + allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num_align,m),D(m),Vt(lda,n)) + + do j=1,n + do i=1,m + A(i,j) = matrix(i,j) + enddo + enddo + mo_coef_new = mo_coef + + call svd(A,lda,U,lda,D,Vt,lda,m,n) + + write (output_mo_basis,'(A)'), 'MOs are now **'//trim(label)//'**' + write (output_mo_basis,'(A)'), '' + write (output_mo_basis,'(A)'), 'Eigenvalues' + write (output_mo_basis,'(A)'), '-----------' + write (output_mo_basis,'(A)'), '' + write (output_mo_basis,'(A)'), '======== ================' + + do i=1,m + write (output_mo_basis,'(I8,X,F16.10)'), i,D(i) + enddo + write (output_mo_basis,'(A)'), '======== ================' + write (output_mo_basis,'(A)'), '' + + call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),U,size(U,1),0.d0,mo_coef,size(mo_coef,1)) + deallocate(A,mo_coef_new,U,Vt,D) + call write_time(output_mo_basis) + + mo_label = label +end + subroutine mo_as_eigvectors_of_mo_matrix_sort_by_observable(matrix,observable,n,m,label) implicit none integer,intent(in) :: n,m diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f index e3ef0bfe..82e8a4c1 100644 --- a/src/Utils/LinearAlgebra.irp.f +++ b/src/Utils/LinearAlgebra.irp.f @@ -70,9 +70,8 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) double precision :: Vt(lda,n) double precision :: D(n) double precision :: S_half(lda,n) - double precision,allocatable :: work(:) - !DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D, work - integer :: info, lwork, i, j, k + !DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D + integer :: info, i, j, k call svd(overlap,lda,U,ldc,D,Vt,lda,m,n) @@ -82,7 +81,7 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) !$OMP DO do i=1,n - if ( D(i) < 1.d-12 ) then + if ( D(i) < 1.d-6 ) then D(i) = 0.d0 else D(i) = 1.d0/dsqrt(D(i)) From f51269dd79c60a6298c2f4f7ab4b18d0f8ad25fa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Dec 2015 14:40:23 +0100 Subject: [PATCH 13/47] Corrected date in Git.ml --- ocaml/create_git_sha1.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/create_git_sha1.sh b/ocaml/create_git_sha1.sh index 75174319..7b47e96f 100755 --- a/ocaml/create_git_sha1.sh +++ b/ocaml/create_git_sha1.sh @@ -1,7 +1,7 @@ #!/bin/bash SHA1=$(git log -1 | head -1 | cut -d ' ' -f 2) -DATE=$(git log -1 | grep Date | cut -d ':' -f 2) +DATE=$(git log -1 | grep Date | cut -d ':' -f 2-) MESSAGE=$(git log -1 | tail -1) cat << EOF > Git.ml open Core.Std From 72925c98573bffaa8400baadd4b61ce91c3cea67 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Dec 2015 15:03:56 +0100 Subject: [PATCH 14/47] touch only if executable --- scripts/compilation/qp_create_ninja.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/compilation/qp_create_ninja.py b/scripts/compilation/qp_create_ninja.py index 7fd5d248..325d7860 100755 --- a/scripts/compilation/qp_create_ninja.py +++ b/scripts/compilation/qp_create_ninja.py @@ -637,7 +637,7 @@ def ninja_binaries_rule(): # c m d # # ~#~#~ # - l_cmd = ["cd $module_abs/IRPF90_temp", "ninja $out && [[ -x $out ]] && touch $out"] + l_cmd = ["cd $module_abs/IRPF90_temp", "ninja $out && for i in $out ; do [ -x $$i ] && touch $$i ; done"] # ~#~#~#~#~#~ # # s t r i n g # From b39ae633a4825a8993d4112e91d48fa6d1ec6954 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 8 Dec 2015 15:43:36 +0100 Subject: [PATCH 15/47] 1.d-4 threshold in orthonormalization --- ocaml/.gitignore | 1 + src/Utils/LinearAlgebra.irp.f | 16 +++++++++------- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/ocaml/.gitignore b/ocaml/.gitignore index 51fdb52b..761a0130 100644 --- a/ocaml/.gitignore +++ b/ocaml/.gitignore @@ -1,6 +1,7 @@ _build ezfio.ml .gitignore +Git.ml Input_auto_generated.ml Input_determinants.ml Input_hartree_fock.ml diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f index e3ef0bfe..df80ca2c 100644 --- a/src/Utils/LinearAlgebra.irp.f +++ b/src/Utils/LinearAlgebra.irp.f @@ -82,7 +82,7 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) !$OMP DO do i=1,n - if ( D(i) < 1.d-12 ) then + if ( D(i) < 1.d-4 ) then D(i) = 0.d0 else D(i) = 1.d0/dsqrt(D(i)) @@ -94,13 +94,15 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) !$OMP END DO do k=1,n - !$OMP DO - do j=1,n - do i=1,n - S_half(i,j) = S_half(i,j) + U(i,k)*D(k)*Vt(k,j) + if (D(k) /= 0.d0) then + !$OMP DO + do j=1,n + do i=1,n + S_half(i,j) = S_half(i,j) + U(i,k)*D(k)*Vt(k,j) + enddo enddo - enddo - !$OMP END DO NOWAIT + !$OMP END DO NOWAIT + endif enddo !$OMP BARRIER From 6025113cbcc704f42c912506e27cdacda5f94b21 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 9 Dec 2015 10:18:12 +0100 Subject: [PATCH 16/47] Canonical orthonormalization --- src/MOGuess/mo_ortho_canonical.irp.f | 42 +++++++++++++++++++ src/MOGuess/pot_mo_ortho_canonical_ints.irp.f | 25 +++++++++++ 2 files changed, 67 insertions(+) create mode 100644 src/MOGuess/mo_ortho_canonical.irp.f create mode 100644 src/MOGuess/pot_mo_ortho_canonical_ints.irp.f diff --git a/src/MOGuess/mo_ortho_canonical.irp.f b/src/MOGuess/mo_ortho_canonical.irp.f new file mode 100644 index 00000000..a4027555 --- /dev/null +++ b/src/MOGuess/mo_ortho_canonical.irp.f @@ -0,0 +1,42 @@ + +BEGIN_PROVIDER [double precision, ao_ortho_canonical_coef, (ao_num_align,ao_num)] + implicit none + BEGIN_DOC +! matrix of the coefficients of the mos generated by the +! orthonormalization by the S^{-1/2} canonical transformation of the aos +! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital + END_DOC + integer :: i,j,k,l + tmp_matrix(:,:) = 0.d0 + do j=1, ao_num + tmp_matrix(j,j) = 1.d0 + enddo + call ortho_canonical(ao_overlap,ao_num_align,ao_num,ao_ortho_canonical_coef,ao_num_align,mo_tot_num) + SOFT_TOUCH mo_tot_num +END_PROVIDER + +BEGIN_PROVIDER [double precision, ao_ortho_canonical_overlap, (ao_num_align,ao_num)] + implicit none + BEGIN_DOC +! overlap matrix of the ao_ortho_canonical +! supposed to be the Identity + END_DOC + integer :: i,j,k,l + double precision :: c + do j=1, ao_num + do i=1, ao_num + ao_ortho_canonical_overlap(i,j) = 0.d0 + enddo + enddo + do k=1, ao_num + do j=1, ao_num + c = 0.d0 + do l=1, ao_num + c += ao_ortho_canonical_coef(j,l) * ao_overlap(k,l) + enddo + do i=1, ao_num + ao_ortho_canonical_overlap(i,j) += ao_ortho_canonical_coef(i,k) * c + enddo + enddo + enddo +END_PROVIDER diff --git a/src/MOGuess/pot_mo_ortho_canonical_ints.irp.f b/src/MOGuess/pot_mo_ortho_canonical_ints.irp.f new file mode 100644 index 00000000..9c61ebcd --- /dev/null +++ b/src/MOGuess/pot_mo_ortho_canonical_ints.irp.f @@ -0,0 +1,25 @@ +BEGIN_PROVIDER [double precision, ao_ortho_canonical_nucl_elec_integral, (mo_tot_num_align,mo_tot_num)] + implicit none + integer :: i1,j1,i,j + double precision :: c_i1,c_j1 + + ao_ortho_canonical_nucl_elec_integral = 0.d0 + !$OMP PARALLEL DO DEFAULT(none) & + !$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) & + !$OMP SHARED(mo_tot_num,ao_num,ao_ortho_canonical_coef, & + !$OMP ao_ortho_canonical_nucl_elec_integral, ao_nucl_elec_integral) + do i = 1, mo_tot_num + do j = 1, mo_tot_num + do i1 = 1,ao_num + c_i1 = ao_ortho_canonical_coef(i1,i) + do j1 = 1,ao_num + c_j1 = c_i1*ao_ortho_canonical_coef(j1,j) + ao_ortho_canonical_nucl_elec_integral(j,i) = ao_ortho_canonical_nucl_elec_integral(j,i) + & + c_j1 * ao_nucl_elec_integral(j1,i1) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO +END_PROVIDER + From 53ba9511869b045e92bcf1a142ecdd8077dd2c16 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 9 Dec 2015 18:53:38 +0100 Subject: [PATCH 17/47] Added canonical orthogonalization and accelerated Tasks --- ocaml/Message.ml | 3 +- ocaml/Qpackage.ml | 1 - ocaml/Queuing_system.ml | 4 +- ocaml/TaskServer.ml | 67 +++++++++++++---- plugins/Hartree_Fock/huckel.irp.f | 2 - plugins/MP2/H_apply.irp.f | 2 +- plugins/Perturbation/pt2_equations.irp.f | 14 +++- src/Determinants/H_apply.template.f | 3 +- src/Integrals_Bielec/ao_bi_integrals.irp.f | 13 ++-- src/MOGuess/H_CORE_guess.irp.f | 2 - src/MOGuess/guess_overlap.irp.f | 2 - src/MOGuess/h_core_guess_routine.irp.f | 2 - src/MOGuess/mo_ortho_lowdin.irp.f | 12 +-- .../ao_ortho_canonical.irp.f} | 31 ++++---- src/MO_Basis/mos.irp.f | 12 ++- src/Utils/LinearAlgebra.irp.f | 74 ++++++++++++++++++- 16 files changed, 177 insertions(+), 67 deletions(-) rename src/{MOGuess/mo_ortho_canonical.irp.f => MO_Basis/ao_ortho_canonical.irp.f} (59%) diff --git a/ocaml/Message.ml b/ocaml/Message.ml index f47d6cec..ee5ff80c 100644 --- a/ocaml/Message.ml +++ b/ocaml/Message.ml @@ -280,9 +280,8 @@ type t = let of_string s = let l = String.split ~on:' ' s - |> List.map ~f:String.strip - |> List.map ~f:String.lowercase |> List.filter ~f:(fun x -> (String.strip x) <> "") + |> List.map ~f:String.lowercase in match l with | "add_task" :: state :: task -> diff --git a/ocaml/Qpackage.ml b/ocaml/Qpackage.ml index 3656327f..bd0d34fc 100644 --- a/ocaml/Qpackage.ml +++ b/ocaml/Qpackage.ml @@ -55,7 +55,6 @@ let executables = lazy ( In_channel.input_lines in_channel |> List.map ~f:(fun x -> let e = String.split ~on:' ' x - |> List.map ~f:String.strip |> List.filter ~f:(fun x -> x <> "") in match e with diff --git a/ocaml/Queuing_system.ml b/ocaml/Queuing_system.ml index 7a927a60..7407d78d 100644 --- a/ocaml/Queuing_system.ml +++ b/ocaml/Queuing_system.ml @@ -29,12 +29,14 @@ let add_task ~task q = q.next_task_id in { q with - queued = q.queued @ [ task_id ] ; + queued = task_id :: q.queued ; tasks = Map.add q.tasks ~key:task_id ~data:task ; next_task_id = Id.Task.increment task_id ; }, task_id + + let add_client q = let client_id = q.next_client_id diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index 1f882540..61eec19f 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -80,7 +80,7 @@ let stop ~port = Message.Terminate (Message.Terminate_msg.create ()) |> Message.to_string - |> ZMQ.Socket.send req_socket ; + |> ZMQ.Socket.send ~block:false req_socket ; let msg = ZMQ.Socket.recv req_socket @@ -158,13 +158,13 @@ let run ~port = let terminate () = running := false; Message.to_string ok - |> ZMQ.Socket.send rep_socket + |> ZMQ.Socket.send ~block:false rep_socket and newjob x = q := Queuing_system.create (); job := Some x; Message.to_string ok - |> ZMQ.Socket.send rep_socket + |> ZMQ.Socket.send ~block:false rep_socket and connect state msg = let push_address = @@ -180,7 +180,7 @@ let run ~port = Message.ConnectReply (Message.ConnectReply_msg.create ~state ~client_id ~push_address) |> Message.to_string - |> ZMQ.Socket.send rep_socket + |> ZMQ.Socket.send ~block:false rep_socket and disconnect state msg = let s, c = @@ -199,7 +199,7 @@ let run ~port = Message.DisconnectReply (Message.DisconnectReply_msg.create ~state ~finished) |> Message.to_string - |> ZMQ.Socket.send rep_socket + |> ZMQ.Socket.send ~block:false rep_socket and add_task state msg = let s, task = @@ -207,12 +207,53 @@ let run ~port = msg.Message.AddTask_msg.task in assert (s = state); - let new_q, task_id = - Queuing_system.add_task ~task !q - in - q := new_q; Message.to_string ok - |> ZMQ.Socket.send rep_socket + |> ZMQ.Socket.send ~block:false rep_socket + ; + begin + match + String.split ~on:' ' msg.Message.AddTask_msg.task + |> List.filter ~f:(fun x -> x <> "") + with + | "triangle" :: str_l :: [] -> + begin + let l = + Int.of_string str_l + in + for j=1 to l + do + let task = + Printf.sprintf "%d %s" j str_l + in + let new_q, _ = + Queuing_system.add_task ~task !q + in + q := new_q + done + end + | "range" :: str_i :: str_j :: [] -> + begin + let i, j = + Int.of_string str_i, + Int.of_string str_j + in + for k=i to (j+1) + do + let task = + Int.to_string k + in + let new_q, task_id = + Queuing_system.add_task ~task !q + in + q := new_q + done + end + | _ -> + let new_q, task_id = + Queuing_system.add_task ~task !q + in + q := new_q + end and get_task state msg = let s, client_id = @@ -231,7 +272,7 @@ let run ~port = | _ -> Message.Terminate (Message.Terminate_msg.create ()) in Message.to_string reply - |> ZMQ.Socket.send rep_socket + |> ZMQ.Socket.send ~block:false rep_socket and task_done state msg = let s, client_id, task_id = @@ -245,12 +286,12 @@ let run ~port = in q := new_q; Message.to_string ok - |> ZMQ.Socket.send rep_socket + |> ZMQ.Socket.send ~block:false rep_socket and error msg = Message.Error (Message.Error_msg.create msg) |> Message.to_string - |> ZMQ.Socket.send rep_socket + |> ZMQ.Socket.send ~block:false rep_socket in if (polling.(0) = Some ZMQ.Poll.In) then diff --git a/plugins/Hartree_Fock/huckel.irp.f b/plugins/Hartree_Fock/huckel.irp.f index 8f61f0cf..103de83a 100644 --- a/plugins/Hartree_Fock/huckel.irp.f +++ b/plugins/Hartree_Fock/huckel.irp.f @@ -8,8 +8,6 @@ subroutine huckel_guess double precision :: c character*(64) :: label - mo_coef = ao_ortho_lowdin_coef - TOUCH mo_coef label = "Guess" call mo_as_eigvectors_of_mo_matrix(mo_mono_elec_integral, & size(mo_mono_elec_integral,1), & diff --git a/plugins/MP2/H_apply.irp.f b/plugins/MP2/H_apply.irp.f index a79e3879..a5489149 100644 --- a/plugins/MP2/H_apply.irp.f +++ b/plugins/MP2/H_apply.irp.f @@ -8,7 +8,7 @@ s.set_perturbation("Moller_plesset") print s s = H_apply("mp2_selection") -s.set_selection_pt2("Moller_plesset") +s.set_selection_pt2("Moller_Plesset") print s END_SHELL diff --git a/plugins/Perturbation/pt2_equations.irp.f b/plugins/Perturbation/pt2_equations.irp.f index f49ee2ff..8e40d0fd 100644 --- a/plugins/Perturbation/pt2_equations.irp.f +++ b/plugins/Perturbation/pt2_equations.irp.f @@ -123,8 +123,8 @@ subroutine pt2_moller_plesset ($arguments) call get_excitation(ref_bitmask,det_pert,exc,degree,phase,Nint) if (degree == 2) then call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - delta_e = Fock_matrix_diag_mo(h1) + Fock_matrix_diag_mo(h2) - & - (Fock_matrix_diag_mo(p1) + Fock_matrix_diag_mo(p2)) + delta_e = (Fock_matrix_diag_mo(h1) + Fock_matrix_diag_mo(h2)) - & + (Fock_matrix_diag_mo(p1) + Fock_matrix_diag_mo(p2)) delta_e = 1.d0/delta_e else if (degree == 1) then call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) @@ -134,8 +134,14 @@ subroutine pt2_moller_plesset ($arguments) delta_e = 0.d0 endif - call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array) - h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) + if (delta_e /= 0.d0) then + ! call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array) + call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) + h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) + else + i_H_psi_array(:) = 0.d0 + h = 0.d0 + endif do i =1,n_st H_pert_diag(i) = h c_pert(i) = i_H_psi_array(i) *delta_e diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index 58ae8b08..e949c0d2 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -261,6 +261,7 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl ! Build array of the non-zero integrals of second excitation $filter_integrals + if (ispin == 1) then integer :: jjj @@ -269,7 +270,7 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl i_b = occ_hole_tmp(kk,other_spin) ASSERT (i_b > 0) ASSERT (i_b <= mo_tot_num) - do jjj=1,N_elec_in_key_part_2(other_spin) ! particule + do jjj=1,N_elec_in_key_part_2(other_spin) ! particle j_b = occ_particle_tmp(jjj,other_spin) ASSERT (j_b > 0) ASSERT (j_b <= mo_tot_num) diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index 6987d06b..8bae1a1e 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -371,19 +371,16 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] integer(ZMQ_PTR) :: zmq_to_qp_run_socket call new_parallel_job(zmq_to_qp_run_socket,'ao_integrals') + character*(32) :: task do l=1,ao_num - do j = 1, l - if (ao_overlap_abs(j,l) < ao_integrals_threshold) then - cycle - endif - write(task,*) j, l - call add_task_to_taskserver(zmq_to_qp_run_socket,task) - enddo + write(task,*) 'triangle', l + call add_task_to_taskserver(zmq_to_qp_run_socket,task) enddo + external :: ao_bielec_integrals_in_map_slave_inproc, ao_bielec_integrals_in_map_collector call new_parallel_threads(ao_bielec_integrals_in_map_slave_inproc, ao_bielec_integrals_in_map_collector) - + call end_parallel_job(zmq_to_qp_run_socket,'ao_integrals') print*, 'Sorting the map' diff --git a/src/MOGuess/H_CORE_guess.irp.f b/src/MOGuess/H_CORE_guess.irp.f index b65fe07d..d3e2eef9 100644 --- a/src/MOGuess/H_CORE_guess.irp.f +++ b/src/MOGuess/H_CORE_guess.irp.f @@ -5,8 +5,6 @@ program H_CORE_guess END_DOC implicit none character*(64) :: label - mo_coef = ao_ortho_lowdin_coef - TOUCH mo_coef label = "Guess" call mo_as_eigvectors_of_mo_matrix(mo_mono_elec_integral, & size(mo_mono_elec_integral,1), & diff --git a/src/MOGuess/guess_overlap.irp.f b/src/MOGuess/guess_overlap.irp.f index c2f090e5..7d75e118 100644 --- a/src/MOGuess/guess_overlap.irp.f +++ b/src/MOGuess/guess_overlap.irp.f @@ -5,8 +5,6 @@ program guess_mimi implicit none character*(64) :: label - mo_coef = ao_ortho_lowdin_coef - TOUCH mo_coef label = "Guess" call mo_as_eigvectors_of_mo_matrix(ao_overlap, & size(ao_overlap,1), & diff --git a/src/MOGuess/h_core_guess_routine.irp.f b/src/MOGuess/h_core_guess_routine.irp.f index 605c7c8a..23899160 100644 --- a/src/MOGuess/h_core_guess_routine.irp.f +++ b/src/MOGuess/h_core_guess_routine.irp.f @@ -4,8 +4,6 @@ subroutine hcore_guess END_DOC implicit none character*(64) :: label - mo_coef = ao_ortho_lowdin_coef - TOUCH mo_coef label = "Guess" call mo_as_eigvectors_of_mo_matrix(mo_mono_elec_integral, & size(mo_mono_elec_integral,1), & diff --git a/src/MOGuess/mo_ortho_lowdin.irp.f b/src/MOGuess/mo_ortho_lowdin.irp.f index c73bb553..90672b5e 100644 --- a/src/MOGuess/mo_ortho_lowdin.irp.f +++ b/src/MOGuess/mo_ortho_lowdin.irp.f @@ -1,4 +1,3 @@ - BEGIN_PROVIDER [double precision, ao_ortho_lowdin_coef, (ao_num_align,ao_num)] implicit none BEGIN_DOC @@ -8,13 +7,9 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_coef, (ao_num_align,ao_num)] END_DOC integer :: i,j,k,l double precision :: tmp_matrix(ao_num_align,ao_num),accu + tmp_matrix(:,:) = 0.d0 do j=1, ao_num - do i=1, ao_num - tmp_matrix(i,j) = 0.d0 - enddo - enddo - do i=1, ao_num - tmp_matrix(i,i) = 1.d0 + tmp_matrix(j,j) = 1.d0 enddo call ortho_lowdin(ao_overlap,ao_num_align,ao_num,tmp_matrix,ao_num_align,ao_num) do i=1, ao_num @@ -23,6 +18,7 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_coef, (ao_num_align,ao_num)] enddo enddo END_PROVIDER + BEGIN_PROVIDER [double precision, ao_ortho_lowdin_overlap, (ao_num_align,ao_num)] implicit none BEGIN_DOC @@ -40,7 +36,7 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_overlap, (ao_num_align,ao_num) do j=1, ao_num c = 0.d0 do l=1, ao_num - c = ao_ortho_lowdin_coef(j,l) * ao_overlap(k,l) + c += ao_ortho_lowdin_coef(j,l) * ao_overlap(k,l) enddo do i=1, ao_num ao_ortho_lowdin_overlap(i,j) += ao_ortho_lowdin_coef(i,k) * c diff --git a/src/MOGuess/mo_ortho_canonical.irp.f b/src/MO_Basis/ao_ortho_canonical.irp.f similarity index 59% rename from src/MOGuess/mo_ortho_canonical.irp.f rename to src/MO_Basis/ao_ortho_canonical.irp.f index a4027555..f9862abb 100644 --- a/src/MOGuess/mo_ortho_canonical.irp.f +++ b/src/MO_Basis/ao_ortho_canonical.irp.f @@ -1,21 +1,20 @@ - -BEGIN_PROVIDER [double precision, ao_ortho_canonical_coef, (ao_num_align,ao_num)] + BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef, (ao_num_align,ao_num)] +&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num ] implicit none BEGIN_DOC ! matrix of the coefficients of the mos generated by the ! orthonormalization by the S^{-1/2} canonical transformation of the aos ! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital END_DOC - integer :: i,j,k,l - tmp_matrix(:,:) = 0.d0 - do j=1, ao_num - tmp_matrix(j,j) = 1.d0 + integer :: i + ao_ortho_canonical_coef(:,:) = 0.d0 + do i=1,ao_num + ao_ortho_canonical_coef(i,i) = 1.d0 enddo - call ortho_canonical(ao_overlap,ao_num_align,ao_num,ao_ortho_canonical_coef,ao_num_align,mo_tot_num) - SOFT_TOUCH mo_tot_num + call ortho_canonical(ao_overlap,ao_num_align,ao_num,ao_ortho_canonical_coef,ao_num_align,ao_ortho_canonical_num) END_PROVIDER -BEGIN_PROVIDER [double precision, ao_ortho_canonical_overlap, (ao_num_align,ao_num)] +BEGIN_PROVIDER [double precision, ao_ortho_canonical_overlap, (ao_ortho_canonical_num,ao_ortho_canonical_num)] implicit none BEGIN_DOC ! overlap matrix of the ao_ortho_canonical @@ -23,19 +22,19 @@ BEGIN_PROVIDER [double precision, ao_ortho_canonical_overlap, (ao_num_align,ao_n END_DOC integer :: i,j,k,l double precision :: c - do j=1, ao_num - do i=1, ao_num + do j=1, ao_ortho_canonical_num + do i=1, ao_ortho_canonical_num ao_ortho_canonical_overlap(i,j) = 0.d0 enddo enddo - do k=1, ao_num - do j=1, ao_num + do j=1, ao_ortho_canonical_num + do k=1, ao_num c = 0.d0 do l=1, ao_num - c += ao_ortho_canonical_coef(j,l) * ao_overlap(k,l) + c += ao_ortho_canonical_coef(l,j) * ao_overlap(l,k) enddo - do i=1, ao_num - ao_ortho_canonical_overlap(i,j) += ao_ortho_canonical_coef(i,k) * c + do i=1, ao_ortho_canonical_num + ao_ortho_canonical_overlap(i,j) += ao_ortho_canonical_coef(k,i) * c enddo enddo enddo diff --git a/src/MO_Basis/mos.irp.f b/src/MO_Basis/mos.irp.f index 016b48ad..5756b7de 100644 --- a/src/MO_Basis/mos.irp.f +++ b/src/MO_Basis/mos.irp.f @@ -9,8 +9,9 @@ BEGIN_PROVIDER [ integer, mo_tot_num ] if (exists) then call ezfio_get_mo_basis_mo_tot_num(mo_tot_num) else - mo_tot_num = ao_num + mo_tot_num = ao_ortho_canonical_num endif + call write_int(6,mo_tot_num,'mo_tot_num') ASSERT (mo_tot_num > 0) END_PROVIDER @@ -56,7 +57,14 @@ END_PROVIDER deallocate(buffer) else ! Orthonormalized AO basis - mo_coef = 0. + do i=1,mo_tot_num + do j=1,ao_num + mo_coef(j,i) = ao_ortho_canonical_coef(j,i) + enddo + do j=ao_num+1,ao_num_align + mo_coef(j,i) = 0.d0 + enddo + enddo endif END_PROVIDER diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f index 14c1d8dd..a859a913 100644 --- a/src/Utils/LinearAlgebra.irp.f +++ b/src/Utils/LinearAlgebra.irp.f @@ -42,11 +42,81 @@ subroutine svd(A,LDA,U,LDU,D,Vt,LDVt,m,n) end +subroutine ortho_canonical(overlap,LDA,N,C,LDC,m) + implicit none + BEGIN_DOC + ! Compute C_new=C_old.U.s^-1/2 canonical orthogonalization. + ! + ! overlap : overlap matrix + ! + ! LDA : leftmost dimension of overlap array + ! + ! N : Overlap matrix is NxN (array is (LDA,N) ) + ! + ! C : Coefficients of the vectors to orthogonalize. On exit, + ! orthogonal vectors + ! + ! LDC : leftmost dimension of C + ! + ! m : Coefficients matrix is MxN, ( array is (LDC,N) ) + ! + END_DOC + + integer, intent(in) :: lda, ldc, n + integer, intent(out) :: m + double precision, intent(in) :: overlap(lda,n) + double precision, intent(inout) :: C(ldc,n) + double precision, allocatable :: U(:,:) + double precision, allocatable :: Vt(:,:) + double precision, allocatable :: D(:) + double precision, allocatable :: S_half(:,:) + !DEC$ ATTRIBUTES ALIGN : 64 :: U, Vt, D + integer :: info, i, j + + allocate (U(ldc,n), Vt(lda,n), D(n), S_half(lda,n)) + + call svd(overlap,lda,U,ldc,D,Vt,lda,n,n) + + m=n + do i=1,n + if ( D(i) >= 1.d-4 ) then + D(i) = 1.d0/dsqrt(D(i)) + else + m = i-1 + exit + endif + enddo + do i=m+1,n + D(i) = 0.d0 + enddo + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(S_half,U,D,Vt,n,C,m) & + !$OMP PRIVATE(i,j) + + !$OMP DO + do j=1,n + do i=1,n + S_half(i,j) = U(i,j)*D(j) + enddo + do i=1,n + U(i,j) = C(i,j) + enddo + enddo + !$OMP END DO + + !$OMP END PARALLEL + + call dgemm('N','N',n,m,n,1.d0,U,size(U,1),S_half,size(S_half,1),0.d0,C,size(C,1)) + deallocate (U, Vt, D, S_half) + +end + subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) implicit none BEGIN_DOC - ! Compute C_new=C_old.S^-1/2 canonical orthogonalization. + ! Compute C_new=C_old.S^-1/2 orthogonalization. ! ! overlap : overlap matrix ! @@ -81,7 +151,7 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) !$OMP DO do i=1,n - if ( D(i) < 1.d-4 ) then + if ( D(i) < 1.d-5 ) then D(i) = 0.d0 else D(i) = 1.d0/dsqrt(D(i)) From 9661db8cf8e6d255be54df8677a2998ef74c8316 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 9 Dec 2015 21:21:03 +0100 Subject: [PATCH 18/47] Updated bitmasks when the number of MOs is < ao_num --- config/ifort.cfg | 1 + src/Bitmask/bitmasks.irp.f | 40 +++++++++++++++++-- .../pot_ao_pseudo_ints.irp.f | 4 +- src/Utils/LinearAlgebra.irp.f | 4 +- 4 files changed, 41 insertions(+), 8 deletions(-) diff --git a/config/ifort.cfg b/config/ifort.cfg index bfa41c03..2b2fe0a2 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -52,6 +52,7 @@ FCFLAGS : -xSSE4.2 -O2 -ip -ftz [DEBUG] FC : -g -traceback FCFLAGS : -xSSE2 -C -fpe0 +IRPF90_FLAGS : --openmp # OpenMP flags ################# diff --git a/src/Bitmask/bitmasks.irp.f b/src/Bitmask/bitmasks.irp.f index 29588369..f54532ca 100644 --- a/src/Bitmask/bitmasks.irp.f +++ b/src/Bitmask/bitmasks.irp.f @@ -141,6 +141,19 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask_restart, (N_int,2,6,N_gen enddo endif + integer :: i + do k=1,N_generators_bitmask + do ispin=1,2 + do i=1,N_int + generators_bitmask_restart(i,ispin,s_hole ,k) = iand(full_ijkl_bitmask(i,d_hole1),generators_bitmask_restart(i,ispin,s_hole,k) ) + generators_bitmask_restart(i,ispin,s_part ,k) = iand(full_ijkl_bitmask(i,d_part1),generators_bitmask_restart(i,ispin,s_part,k) ) + generators_bitmask_restart(i,ispin,d_hole1,k) = iand(full_ijkl_bitmask(i,d_hole1),generators_bitmask_restart(i,ispin,d_hole1,k) ) + generators_bitmask_restart(i,ispin,d_part1,k) = iand(full_ijkl_bitmask(i,d_part1),generators_bitmask_restart(i,ispin,d_part1,k) ) + generators_bitmask_restart(i,ispin,d_hole2,k) = iand(full_ijkl_bitmask(i,d_hole2),generators_bitmask_restart(i,ispin,d_hole2,k) ) + generators_bitmask_restart(i,ispin,d_part2,k) = iand(full_ijkl_bitmask(i,d_part2),generators_bitmask_restart(i,ispin,d_part2,k) ) + enddo + enddo + enddo END_PROVIDER @@ -172,7 +185,7 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_ if (exists) then call ezfio_get_bitmasks_generators(generators_bitmask) else - integer :: k, ispin + integer :: k, ispin, i do k=1,N_generators_bitmask do ispin=1,2 generators_bitmask(:,ispin,s_hole ,k) = full_ijkl_bitmask(:,d_hole1) @@ -185,6 +198,18 @@ BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6,N_generators_ enddo endif + do k=1,N_generators_bitmask + do ispin=1,2 + do i=1,N_int + generators_bitmask(i,ispin,s_hole ,k) = iand(full_ijkl_bitmask(i,d_hole1),generators_bitmask(i,ispin,s_hole,k) ) + generators_bitmask(i,ispin,s_part ,k) = iand(full_ijkl_bitmask(i,d_part1),generators_bitmask(i,ispin,s_part,k) ) + generators_bitmask(i,ispin,d_hole1,k) = iand(full_ijkl_bitmask(i,d_hole1),generators_bitmask(i,ispin,d_hole1,k) ) + generators_bitmask(i,ispin,d_part1,k) = iand(full_ijkl_bitmask(i,d_part1),generators_bitmask(i,ispin,d_part1,k) ) + generators_bitmask(i,ispin,d_hole2,k) = iand(full_ijkl_bitmask(i,d_hole2),generators_bitmask(i,ispin,d_hole2,k) ) + generators_bitmask(i,ispin,d_part2,k) = iand(full_ijkl_bitmask(i,d_part2),generators_bitmask(i,ispin,d_part2,k) ) + enddo + enddo + enddo END_PROVIDER BEGIN_PROVIDER [ integer, N_cas_bitmask ] @@ -223,7 +248,7 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ] ! Bitmasks for CAS reference determinants. (N_int, alpha/beta, CAS reference) END_DOC logical :: exists - integer :: i,i_part,i_gen,j + integer :: i,i_part,i_gen,j,k PROVIDE ezfio_filename call ezfio_has_bitmasks_cas(exists) @@ -240,14 +265,21 @@ BEGIN_PROVIDER [ integer(bit_kind), cas_bitmask, (N_int,2,N_cas_bitmask) ] else i_part = 2 i_gen = 1 - do j = 1, N_cas_bitmask - do i = 1, N_int + do j=1, N_cas_bitmask + do i=1, N_int cas_bitmask(i,1,j) = generators_bitmask_restart(i,1,i_part,i_gen) cas_bitmask(i,2,j) = generators_bitmask_restart(i,2,i_part,i_gen) enddo enddo endif endif + do i=1,N_cas_bitmask + do j = 1, N_cas_bitmask + do k=1,N_int + cas_bitmask(k,j,i) = iand(cas_bitmask(k,j,i),full_ijkl_bitmask(k,j)) + enddo + enddo + enddo END_PROVIDER diff --git a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f index 2856807b..59693cdb 100644 --- a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f @@ -24,7 +24,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0 integer :: thread_num - !$ integer :: omp_get_thread_num + integer :: omp_get_thread_num ao_pseudo_integral_local = 0.d0 @@ -118,7 +118,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu integer :: power_A(3),power_B(3) integer :: i,j,k,l,n_pt_in,m double precision :: Vloc, Vpseudo - !$ integer :: omp_get_thread_num + integer :: omp_get_thread_num double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0 integer :: thread_num diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f index a859a913..746b5f13 100644 --- a/src/Utils/LinearAlgebra.irp.f +++ b/src/Utils/LinearAlgebra.irp.f @@ -79,7 +79,7 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m) m=n do i=1,n - if ( D(i) >= 1.d-4 ) then + if ( D(i) >= 1.d-6 ) then D(i) = 1.d0/dsqrt(D(i)) else m = i-1 @@ -151,7 +151,7 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m) !$OMP DO do i=1,n - if ( D(i) < 1.d-5 ) then + if ( D(i) < 1.d-6 ) then D(i) = 0.d0 else D(i) = 1.d0/dsqrt(D(i)) From 204984bdd8cccab3374ed51018c7b0b04a59e5af Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 9 Dec 2015 23:20:34 +0100 Subject: [PATCH 19/47] Fixed AO integrals (reliable socket) --- src/Integrals_Bielec/ao_bi_integrals.irp.f | 1 + .../ao_bielec_integrals_in_map_slave.irp.f | 9 ++++++++- src/Integrals_Bielec/qp_ao_ints.irp.f | 20 +++++++++++++++++++ src/ZMQ/zmq.irp.f | 14 ++++++++++--- 4 files changed, 40 insertions(+), 4 deletions(-) create mode 100644 src/Integrals_Bielec/qp_ao_ints.irp.f diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index 8bae1a1e..b1f1dba0 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -373,6 +373,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] character*(32) :: task + do l=1,ao_num write(task,*) 'triangle', l call add_task_to_taskserver(zmq_to_qp_run_socket,task) diff --git a/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f b/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f index e21014b8..818247ff 100644 --- a/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f +++ b/src/Integrals_Bielec/ao_bielec_integrals_in_map_slave.irp.f @@ -38,7 +38,8 @@ subroutine ao_bielec_integrals_in_map_slave(thread) zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() integer(ZMQ_PTR) :: zmq_socket_push - zmq_socket_push = f77_zmq_socket(zmq_context, ZMQ_PUSH) +! zmq_socket_push = f77_zmq_socket(zmq_context, ZMQ_PUSH) + zmq_socket_push = f77_zmq_socket(zmq_context, ZMQ_REQ ) if (thread == 1) then rc = f77_zmq_connect(zmq_socket_push, trim(zmq_socket_pull_inproc_address)) else @@ -63,6 +64,8 @@ subroutine ao_bielec_integrals_in_map_slave(thread) rc = f77_zmq_send( zmq_socket_push, buffer_i, key_kind*n_integrals, ZMQ_SNDMORE) rc = f77_zmq_send( zmq_socket_push, buffer_value, integral_kind*n_integrals, 0) call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) + character*(2) :: ok + rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0) enddo deallocate( buffer_i, buffer_value ) @@ -72,6 +75,7 @@ subroutine ao_bielec_integrals_in_map_slave(thread) if (finished /= 0) then rc = f77_zmq_send( zmq_socket_push, -1, 4, 0) + rc = f77_zmq_recv( zmq_socket_push, ok, 2, ZMQ_NOBLOCK) endif rc = f77_zmq_disconnect(zmq_socket_push,trim(zmq_socket_push_tcp_address)) @@ -102,7 +106,10 @@ subroutine ao_bielec_integrals_in_map_collector if (n_integrals >= 0) then rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0) rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0) + rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) call insert_into_ao_integrals_map(n_integrals,buffer_i,buffer_value) + else + rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) endif enddo diff --git a/src/Integrals_Bielec/qp_ao_ints.irp.f b/src/Integrals_Bielec/qp_ao_ints.irp.f new file mode 100644 index 00000000..dbeee9d7 --- /dev/null +++ b/src/Integrals_Bielec/qp_ao_ints.irp.f @@ -0,0 +1,20 @@ +program qp_ao_ints + implicit none + BEGIN_DOC +! Increments a running calculation to compute AO integrals + END_DOC + + ! Set the state of the ZMQ + zmq_state = 'ao_integrals' + + ! Provide everything needed + double precision :: integral, ao_bielec_integral + integral = ao_bielec_integral(1,1,1,1) + + !$OMP PARALLEL DEFAULT(PRIVATE) + call ao_bielec_integrals_in_map_slave_tcp + !$OMP END PARALLEL + + print *, 'Done' +end + diff --git a/src/ZMQ/zmq.irp.f b/src/ZMQ/zmq.irp.f index 6a887422..234271a0 100644 --- a/src/ZMQ/zmq.irp.f +++ b/src/ZMQ/zmq.irp.f @@ -87,7 +87,8 @@ end zmq_socket_push_tcp_address = trim(qp_run_address)//':'//zmq_port(1) zmq_socket_pull_inproc_address = 'inproc://'//zmq_port(1) - zmq_socket_pull = f77_zmq_socket(zmq_context, ZMQ_PULL) +! zmq_socket_pull = f77_zmq_socket(zmq_context, ZMQ_PULL) + zmq_socket_pull = f77_zmq_socket(zmq_context, ZMQ_REP ) rc = f77_zmq_bind(zmq_socket_pull, zmq_socket_pull_tcp_address) rc = f77_zmq_bind(zmq_socket_pull, zmq_socket_pull_inproc_address) if (rc /= 0) then @@ -104,7 +105,7 @@ END_PROVIDER ! Threads executing work through the ZeroMQ interface END_DOC zmq_thread = 0_ZMQ_PTR - zmq_state = '' + zmq_state = 'No_state' END_PROVIDER subroutine new_parallel_job(zmq_to_qp_run_socket,name) @@ -317,6 +318,7 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,name) stop 'Wrong end of job' endif + ! Wait for Slaves do i=1,nproc rc = pthread_join( zmq_thread(i) ) if (rc /= 0) then @@ -324,12 +326,18 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,name) stop -1 endif zmq_thread(i) = 0 + print *, 'joined ', i enddo - zmq_state = 'None' + ! Wait for collector + rc = pthread_join( zmq_thread(0) ) + zmq_thread(0) = 0 + print *, 'joined ', 0 + zmq_state = 'No_state' character*(8), external :: zmq_port rc = f77_zmq_disconnect(zmq_to_qp_run_socket, trim(qp_run_address)//':'//trim(zmq_port(0))) rc = f77_zmq_close(zmq_to_qp_run_socket) + SOFT_TOUCH zmq_thread zmq_state end From 13857ccebe649b0b8a8ae20c389a1f98c6f364c4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 11 Dec 2015 14:32:41 +0100 Subject: [PATCH 20/47] Using normalized atomic basis functions now --- config/ifort.cfg | 2 +- src/AO_Basis/aos.irp.f | 15 +++++++++-- src/Integrals_Bielec/ao_bi_integrals.irp.f | 26 +++++++++---------- src/Integrals_Monoelec/pot_ao_ints.irp.f | 22 ++++++++-------- .../pot_ao_pseudo_ints.irp.f | 6 ++--- src/Integrals_Monoelec/spread_dipole_ao.irp.f | 12 ++++----- src/Integrals_Monoelec/var_pt2_ratio.irp.f | 0 src/Utils/LinearAlgebra.irp.f | 9 +++++++ src/Utils/constants.include.F | 2 +- src/Utils/integration.irp.f | 8 +++--- src/Utils/one_e_integration.irp.f | 6 ++--- 11 files changed, 63 insertions(+), 45 deletions(-) delete mode 100644 src/Integrals_Monoelec/var_pt2_ratio.irp.f diff --git a/config/ifort.cfg b/config/ifort.cfg index 2b2fe0a2..100b87af 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -31,7 +31,7 @@ OPENMP : 1 ; Append OpenMP flags # -ftz : Flushes denormal results to zero # [OPT] -FCFLAGS : -xSSE4.2 -O2 -ip -ftz -g +FCFLAGS : -axSSE4.2,AVX -O2 -ip -ftz -g # Profiling flags ################# diff --git a/src/AO_Basis/aos.irp.f b/src/AO_Basis/aos.irp.f index 27a79b4f..e16909bb 100644 --- a/src/AO_Basis/aos.irp.f +++ b/src/AO_Basis/aos.irp.f @@ -24,9 +24,9 @@ BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num_align,ao_prim_num BEGIN_DOC ! Coefficients including the AO normalization END_DOC - double precision :: norm, norm2,overlap_x,overlap_y,overlap_z,C_A(3) + double precision :: norm, norm2,overlap_x,overlap_y,overlap_z,C_A(3), c integer :: l, powA(3), nz - integer :: i,j + integer :: i,j,k nz=100 C_A(1) = 0.d0 C_A(2) = 0.d0 @@ -39,6 +39,17 @@ BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num_align,ao_prim_num call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j),powA,powA,overlap_x,overlap_y,overlap_z,norm,nz) ao_coef_normalized(i,j) = ao_coef(i,j)/sqrt(norm) enddo + ! Normalization of the contracted basis functions + norm = 0.d0 + do j=1,ao_prim_num(i) + do k=1,ao_prim_num(i) + call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz) + norm = norm+c*ao_coef_normalized(i,j)*ao_coef_normalized(i,k) + enddo + enddo + do j=1,ao_prim_num(i) + ao_coef_normalized(i,j) = ao_coef_normalized(i,j)/sqrt(norm) + enddo enddo END_PROVIDER diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index b1f1dba0..dd19f9d4 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -40,24 +40,22 @@ double precision function ao_bielec_integral(i,j,k,l) L_center(p) = nucl_coord(num_l,p) enddo + double precision :: coef1, coef2, coef3, coef4 + double precision :: p_inv,q_inv + double precision :: general_primitive_integral + do p = 1, ao_prim_num(i) - double precision :: coef1 coef1 = ao_coef_normalized_ordered_transp(p,i) do q = 1, ao_prim_num(j) - double precision :: coef2 coef2 = coef1*ao_coef_normalized_ordered_transp(q,j) - double precision :: p_inv,q_inv call give_explicit_poly_and_gaussian(P_new,P_center,pp,fact_p,iorder_p,& ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j), & I_power,J_power,I_center,J_center,dim1) p_inv = 1.d0/pp do r = 1, ao_prim_num(k) - double precision :: coef3 coef3 = coef2*ao_coef_normalized_ordered_transp(r,k) do s = 1, ao_prim_num(l) - double precision :: coef4 coef4 = coef3*ao_coef_normalized_ordered_transp(s,l) - double precision :: general_primitive_integral call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q,& ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l), & K_power,L_power,K_center,L_center,dim1) @@ -65,7 +63,7 @@ double precision function ao_bielec_integral(i,j,k,l) integral = general_primitive_integral(dim1, & P_new,P_center,fact_p,pp,p_inv,iorder_p, & Q_new,Q_center,fact_q,qq,q_inv,iorder_q) - ao_bielec_integral += coef4 * integral + ao_bielec_integral = ao_bielec_integral + coef4 * integral enddo ! s enddo ! r enddo ! q @@ -94,7 +92,7 @@ double precision function ao_bielec_integral(i,j,k,l) I_power(1),J_power(1),K_power(1),L_power(1), & I_power(2),J_power(2),K_power(2),L_power(2), & I_power(3),J_power(3),K_power(3),L_power(3)) - ao_bielec_integral += coef4 * integral + ao_bielec_integral = ao_bielec_integral + coef4 * integral enddo ! s enddo ! r enddo ! q @@ -479,11 +477,11 @@ double precision function general_primitive_integral(dim, & enddo n_Ix = 0 do ix = 0, iorder_p(1) - if (abs(P_new(ix,1)) < 1.d-8) cycle + if (abs(P_new(ix,1)) < ao_integrals_threshold) cycle a = P_new(ix,1) do jx = 0, iorder_q(1) d = a*Q_new(jx,1) - if (abs(d) < 1.d-8) cycle + if (abs(d) < ao_integrals_threshold) cycle !DEC$ FORCEINLINE call give_polynom_mult_center_x(P_center(1),Q_center(1),ix,jx,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dx,nx) !DEC$ FORCEINLINE @@ -500,11 +498,11 @@ double precision function general_primitive_integral(dim, & enddo n_Iy = 0 do iy = 0, iorder_p(2) - if (abs(P_new(iy,2)) > 1.d-8) then + if (abs(P_new(iy,2)) > ao_integrals_threshold) then b = P_new(iy,2) do jy = 0, iorder_q(2) e = b*Q_new(jy,2) - if (abs(e) < 1.d-8) cycle + if (abs(e) < ao_integrals_threshold) cycle !DEC$ FORCEINLINE call give_polynom_mult_center_x(P_center(2),Q_center(2),iy,jy,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dy,ny) !DEC$ FORCEINLINE @@ -522,11 +520,11 @@ double precision function general_primitive_integral(dim, & enddo n_Iz = 0 do iz = 0, iorder_p(3) - if (abs(P_new(iz,3)) > 1.d-8) then + if (abs(P_new(iz,3)) > ao_integrals_threshold) then c = P_new(iz,3) do jz = 0, iorder_q(3) f = c*Q_new(jz,3) - if (abs(f) < 1.d-8) cycle + if (abs(f) < ao_integrals_threshold) cycle !DEC$ FORCEINLINE call give_polynom_mult_center_x(P_center(3),Q_center(3),iz,jz,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dz,nz) !DEC$ FORCEINLINE diff --git a/src/Integrals_Monoelec/pot_ao_ints.irp.f b/src/Integrals_Monoelec/pot_ao_ints.irp.f index eadc0b72..3c23b458 100644 --- a/src/Integrals_Monoelec/pot_ao_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_ints.irp.f @@ -171,7 +171,7 @@ include 'Utils/constants.include.F' enddo const_factor = dist*rho const = p * dist_integral - if(const_factor.ge.80.d0)then + if(const_factor > 80.d0)then NAI_pol_mult = 0.d0 return endif @@ -375,10 +375,10 @@ recursive subroutine I_x1_pol_mult_mono_elec(a,c,R1x,R1xp,R2x,d,nd,n_pt_in) Y(ix) = 0.d0 enddo call I_x2_pol_mult_mono_elec(c-1,R1x,R1xp,R2x,X,nx,n_pt_in) - do ix=0,nx - X(ix) *= c - enddo - call multiply_poly(X,nx,R2x,2,d,nd) + do ix=0,nx + X(ix) *= dble(c) + enddo + call multiply_poly(X,nx,R2x,2,d,nd) ny=0 call I_x2_pol_mult_mono_elec(c,R1x,R1xp,R2x,Y,ny,n_pt_in) call multiply_poly(Y,ny,R1x,2,d,nd) @@ -390,10 +390,10 @@ recursive subroutine I_x1_pol_mult_mono_elec(a,c,R1x,R1xp,R2x,d,nd,n_pt_in) nx = 0 call I_x1_pol_mult_mono_elec(a-2,c,R1x,R1xp,R2x,X,nx,n_pt_in) ! print*,'nx a-2,c= ',nx - do ix=0,nx - X(ix) *= a-1 - enddo - call multiply_poly(X,nx,R2x,2,d,nd) + do ix=0,nx + X(ix) *= dble(a-1) + enddo + call multiply_poly(X,nx,R2x,2,d,nd) ! print*,'nd out = ',nd nx = nd @@ -403,7 +403,7 @@ recursive subroutine I_x1_pol_mult_mono_elec(a,c,R1x,R1xp,R2x,d,nd,n_pt_in) call I_x1_pol_mult_mono_elec(a-1,c-1,R1x,R1xp,R2x,X,nx,n_pt_in) ! print*,'nx a-1,c-1 = ',nx do ix=0,nx - X(ix) *= c + X(ix) *= dble(c) enddo call multiply_poly(X,nx,R2x,2,d,nd) ny=0 @@ -444,7 +444,7 @@ recursive subroutine I_x2_pol_mult_mono_elec(c,R1x,R1xp,R2x,d,nd,dim) call I_x1_pol_mult_mono_elec(0,c-2,R1x,R1xp,R2x,X,nx,dim) ! print*,'nx 0,c-2 = ',nx do ix=0,nx - X(ix) *= c-1 + X(ix) *= dble(c-1) enddo call multiply_poly(X,nx,R2x,2,d,nd) ! print*,'nd = ',nd diff --git a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f index 59693cdb..f3efaa4c 100644 --- a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f @@ -68,7 +68,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu c = 0.d0 if (dabs(ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i))& - < 1.d-10) then + < ao_integrals_threshold) then cycle endif do k = 1, nucl_num @@ -165,10 +165,10 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu c = 0.d0 if (dabs(ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i))& - < 1.d-10) then + < ao_integrals_threshold) then cycle endif - + do k = 1, nucl_num double precision :: Z Z = nucl_charge(k) diff --git a/src/Integrals_Monoelec/spread_dipole_ao.irp.f b/src/Integrals_Monoelec/spread_dipole_ao.irp.f index d7aa738a..5611ec7f 100644 --- a/src/Integrals_Monoelec/spread_dipole_ao.irp.f +++ b/src/Integrals_Monoelec/spread_dipole_ao.irp.f @@ -55,11 +55,11 @@ beta = ao_expo_ordered_transp(l,i) call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1) call overlap_bourrin_spread(A_center(1),B_center(1),alpha,beta,power_A(1),power_B(1),tmp,lower_exp_val,dx,dim1) - accu_x += c*(tmp*overlap_y*overlap_z) + accu_x += c*tmp*overlap_y*overlap_z call overlap_bourrin_spread(A_center(2),B_center(2),alpha,beta,power_A(2),power_B(2),tmp,lower_exp_val,dx,dim1) - accu_y += c*(tmp*overlap_x*overlap_z) + accu_y += c*tmp*overlap_x*overlap_z call overlap_bourrin_spread(A_center(3),B_center(3),alpha,beta,power_A(3),power_B(3),tmp,lower_exp_val,dx,dim1) - accu_z += c*(tmp*overlap_y*overlap_x) + accu_z += c*tmp*overlap_y*overlap_x enddo enddo ao_spread_x(i,j) = accu_x @@ -130,11 +130,11 @@ call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1) call overlap_bourrin_dipole(A_center(1),B_center(1),alpha,beta,power_A(1),power_B(1),tmp,lower_exp_val,dx,dim1) - accu_x = accu_x + c*(tmp*overlap_y*overlap_z) + accu_x = accu_x + c*tmp*overlap_y*overlap_z call overlap_bourrin_dipole(A_center(2),B_center(2),alpha,beta,power_A(2),power_B(2),tmp,lower_exp_val,dx,dim1) - accu_y = accu_y + c*(tmp*overlap_x*overlap_z) + accu_y = accu_y + c*tmp*overlap_x*overlap_z call overlap_bourrin_dipole(A_center(3),B_center(3),alpha,beta,power_A(3),power_B(3),tmp,lower_exp_val,dx,dim1) - accu_z = accu_z + c*(tmp*overlap_y*overlap_x) + accu_z = accu_z + c*tmp*overlap_y*overlap_x enddo enddo ao_dipole_x(i,j) = accu_x diff --git a/src/Integrals_Monoelec/var_pt2_ratio.irp.f b/src/Integrals_Monoelec/var_pt2_ratio.irp.f deleted file mode 100644 index e69de29b..00000000 diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f index 746b5f13..bcfd43b8 100644 --- a/src/Utils/LinearAlgebra.irp.f +++ b/src/Utils/LinearAlgebra.irp.f @@ -83,13 +83,22 @@ subroutine ortho_canonical(overlap,LDA,N,C,LDC,m) D(i) = 1.d0/dsqrt(D(i)) else m = i-1 + print *, 'Removed Linear dependencies below:', 1.d0/D(m) exit endif enddo do i=m+1,n + print *, D(i) D(i) = 0.d0 enddo + do i=1,m + if ( D(i) >= 1.d5 ) then + print *, 'Warning: Basis set may have linear dependence problems' + endif + enddo + + !$OMP PARALLEL DEFAULT(NONE) & !$OMP SHARED(S_half,U,D,Vt,n,C,m) & !$OMP PRIVATE(i,j) diff --git a/src/Utils/constants.include.F b/src/Utils/constants.include.F index 632dc50b..b55880c3 100644 --- a/src/Utils/constants.include.F +++ b/src/Utils/constants.include.F @@ -1,4 +1,4 @@ -integer, parameter :: max_dim = 255 +integer, parameter :: max_dim = 511 integer, parameter :: SIMD_vector = 32 double precision, parameter :: pi = dacos(-1.d0) diff --git a/src/Utils/integration.irp.f b/src/Utils/integration.irp.f index e9c3f9ab..ade130f7 100644 --- a/src/Utils/integration.irp.f +++ b/src/Utils/integration.irp.f @@ -78,7 +78,7 @@ subroutine give_explicit_poly_and_gaussian(P_new,P_center,p,fact_k,iorder,alpha, !DEC$ FORCEINLINE call gaussian_product(alpha,A_center,beta,B_center,fact_k,p,P_center) - if (fact_k < 1.d-8) then + if (fact_k < ao_integrals_threshold) then fact_k = 0.d0 return endif @@ -210,7 +210,7 @@ subroutine gaussian_product(a,xa,b,xb,k,p,xp) xab(3) = xa(3)-xb(3) ab = ab*p_inv k = ab*(xab(1)*xab(1)+xab(2)*xab(2)+xab(3)*xab(3)) - if (k > 20.d0) then + if (k > 40.d0) then k=0.d0 return endif @@ -249,7 +249,7 @@ subroutine gaussian_product_x(a,xa,b,xb,k,p,xp) xab = xa-xb ab = ab*p_inv k = ab*xab*xab - if (k > 20.d0) then + if (k > 40.d0) then k=0.d0 return endif @@ -580,7 +580,7 @@ double precision function rint_large_n(n,rho) enddo t2=0.d0 do l=0,k - t2=t2+(-1.d0)**l/fact(l+1)/fact(k-l) + t2=t2+(-1.d0)**l/(fact(l+1)*fact(k-l)) enddo alpha_k=t2*fact(k+1)*fact(k)*(-1.d0)**k alpha_k= alpha_k/t1 diff --git a/src/Utils/one_e_integration.irp.f b/src/Utils/one_e_integration.irp.f index fd15054e..1b74f430 100644 --- a/src/Utils/one_e_integration.irp.f +++ b/src/Utils/one_e_integration.irp.f @@ -150,19 +150,19 @@ subroutine overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,& integer :: i do i = 1,iorder_p(1) - overlap_x += P_new(i,1) * F_integral_tab(i) + overlap_x = overlap_x + P_new(i,1) * F_integral_tab(i) enddo call gaussian_product_x(alpha,A_center(1),beta,B_center(1),fact_p,p,P_center(1)) overlap_x *= fact_p do i = 1,iorder_p(2) - overlap_y += P_new(i,2) * F_integral_tab(i) + overlap_y = overlap_y + P_new(i,2) * F_integral_tab(i) enddo call gaussian_product_x(alpha,A_center(2),beta,B_center(2),fact_p,p,P_center(2)) overlap_y *= fact_p do i = 1,iorder_p(3) - overlap_z += P_new(i,3) * F_integral_tab(i) + overlap_z = overlap_z + P_new(i,3) * F_integral_tab(i) enddo call gaussian_product_x(alpha,A_center(3),beta,B_center(3),fact_p,p,P_center(3)) overlap_z *= fact_p From c2063fb722cfe5729e9696ff52ab4dafa3f5ca59 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 11 Dec 2015 14:40:13 +0100 Subject: [PATCH 21/47] Fixed f77zmq.h in configure --- configure | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/configure b/configure index c43b6593..77d395eb 100755 --- a/configure +++ b/configure @@ -141,7 +141,8 @@ zeromq = Info( f77zmq = Info( url='{head}/zeromq/f77_zmq/{tail}'.format(**path_github), description=' F77-ZeroMQ', - default_path=join(QP_ROOT_LIB, "libf77zmq.a")) + default_path=join(QP_ROOT_LIB, "libf77zmq.a") + " " + \ + join(QP_ROOT, "src", "ZMQ", "f77zmq.h") ) p_graphviz = Info( url='https://github.com/xflr6/graphviz/archive/master.tar.gz', From ffaa461afc7b0bb3e219089eb3fe421aa76dfd39 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 11 Dec 2015 14:52:29 +0100 Subject: [PATCH 22/47] Added thresh to constants --- src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f | 6 ++++-- src/Utils/constants.include.F | 1 + src/Utils/integration.irp.f | 2 +- 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f index f3efaa4c..615ed127 100644 --- a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f @@ -15,6 +15,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu BEGIN_DOC ! Local pseudo-potential END_DOC + include 'Utils/constants.include.F' double precision :: alpha, beta, gama, delta integer :: num_A,num_B double precision :: A_center(3),B_center(3),C_center(3) @@ -68,7 +69,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu c = 0.d0 if (dabs(ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i))& - < ao_integrals_threshold) then + < thresh) then cycle endif do k = 1, nucl_num @@ -112,6 +113,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu BEGIN_DOC ! Local pseudo-potential END_DOC + include 'Utils/constants.include.F' double precision :: alpha, beta, gama, delta integer :: num_A,num_B double precision :: A_center(3),B_center(3),C_center(3) @@ -165,7 +167,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu c = 0.d0 if (dabs(ao_coef_normalized_ordered_transp(l,j)*ao_coef_normalized_ordered_transp(m,i))& - < ao_integrals_threshold) then + < thresh) then cycle endif diff --git a/src/Utils/constants.include.F b/src/Utils/constants.include.F index b55880c3..991ef80a 100644 --- a/src/Utils/constants.include.F +++ b/src/Utils/constants.include.F @@ -8,3 +8,4 @@ double precision, parameter :: dfour_pi = 4.d0*dacos(-1.d0) double precision, parameter :: dtwo_pi = 2.d0*dacos(-1.d0) double precision, parameter :: inv_sq_pi = 1.d0/dsqrt(dacos(-1.d0)) double precision, parameter :: inv_sq_pi_2 = 0.5d0/dsqrt(dacos(-1.d0)) +double precision, parameter :: thresh = 1.d-15 diff --git a/src/Utils/integration.irp.f b/src/Utils/integration.irp.f index ade130f7..ad57c52d 100644 --- a/src/Utils/integration.irp.f +++ b/src/Utils/integration.irp.f @@ -78,7 +78,7 @@ subroutine give_explicit_poly_and_gaussian(P_new,P_center,p,fact_k,iorder,alpha, !DEC$ FORCEINLINE call gaussian_product(alpha,A_center,beta,B_center,fact_k,p,P_center) - if (fact_k < ao_integrals_threshold) then + if (fact_k < thresh) then fact_k = 0.d0 return endif From 9c94916ad172c1555f1df79726deaae363a43a9f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 11 Dec 2015 15:09:19 +0100 Subject: [PATCH 23/47] Print error in configure for travis --- configure | 4 ++-- plugins/Perturbation/pt2_equations.irp.f | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/configure b/configure index 77d395eb..3a76ca4f 100755 --- a/configure +++ b/configure @@ -196,8 +196,8 @@ def check_output(*popenargs, **kwargs): cmd = popenargs[0] error = subprocess.CalledProcessError(retcode, cmd) error.output = output -# print output -# print unused_err + print output + print unused_err raise error return output diff --git a/plugins/Perturbation/pt2_equations.irp.f b/plugins/Perturbation/pt2_equations.irp.f index 8e40d0fd..68ce9836 100644 --- a/plugins/Perturbation/pt2_equations.irp.f +++ b/plugins/Perturbation/pt2_equations.irp.f @@ -123,8 +123,8 @@ subroutine pt2_moller_plesset ($arguments) call get_excitation(ref_bitmask,det_pert,exc,degree,phase,Nint) if (degree == 2) then call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - delta_e = (Fock_matrix_diag_mo(h1) + Fock_matrix_diag_mo(h2)) - & - (Fock_matrix_diag_mo(p1) + Fock_matrix_diag_mo(p2)) + delta_e = (Fock_matrix_diag_mo(h1) - Fock_matrix_diag_mo(p1)) + & + (Fock_matrix_diag_mo(h2) - Fock_matrix_diag_mo(p2)) delta_e = 1.d0/delta_e else if (degree == 1) then call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) @@ -142,7 +142,7 @@ subroutine pt2_moller_plesset ($arguments) i_H_psi_array(:) = 0.d0 h = 0.d0 endif - do i =1,n_st + do i =1,N_st H_pert_diag(i) = h c_pert(i) = i_H_psi_array(i) *delta_e e_2_pert(i) = c_pert(i) * i_H_psi_array(i) From 77adda256aca4ccf24023fc49796a7f158f89b12 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 11 Dec 2015 15:11:43 +0100 Subject: [PATCH 24/47] Repaired Download in travis --- configure | 4 ++-- install/Downloads/.empty | 0 2 files changed, 2 insertions(+), 2 deletions(-) create mode 100644 install/Downloads/.empty diff --git a/configure b/configure index 3a76ca4f..77d395eb 100755 --- a/configure +++ b/configure @@ -196,8 +196,8 @@ def check_output(*popenargs, **kwargs): cmd = popenargs[0] error = subprocess.CalledProcessError(retcode, cmd) error.output = output - print output - print unused_err +# print output +# print unused_err raise error return output diff --git a/install/Downloads/.empty b/install/Downloads/.empty new file mode 100644 index 00000000..e69de29b From 6cd35b90bffa8692f8ee3b2b0ed1569ff81f4baa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 11 Dec 2015 15:32:05 +0100 Subject: [PATCH 25/47] thr --- src/Integrals_Bielec/ao_bi_integrals.irp.f | 44 +++++++++++----------- 1 file changed, 21 insertions(+), 23 deletions(-) diff --git a/src/Integrals_Bielec/ao_bi_integrals.irp.f b/src/Integrals_Bielec/ao_bi_integrals.irp.f index dd19f9d4..07416e61 100644 --- a/src/Integrals_Bielec/ao_bi_integrals.irp.f +++ b/src/Integrals_Bielec/ao_bi_integrals.irp.f @@ -127,8 +127,8 @@ double precision function ao_bielec_integral_schwartz_accel(i,j,k,l) num_k = ao_nucl(k) num_l = ao_nucl(l) ao_bielec_integral_schwartz_accel = 0.d0 - double precision :: thresh - thresh = ao_integrals_threshold*ao_integrals_threshold + double precision :: thr + thr = ao_integrals_threshold*ao_integrals_threshold allocate(schwartz_kl(0:ao_prim_num(l),0:ao_prim_num(k))) @@ -179,18 +179,18 @@ double precision function ao_bielec_integral_schwartz_accel(i,j,k,l) P_new,P_center,fact_p,pp,p_inv,iorder_p, & P_new,P_center,fact_p,pp,p_inv,iorder_p) * & coef2*coef2 - if (schwartz_kl(0,0)*schwartz_ij < thresh) then + if (schwartz_kl(0,0)*schwartz_ij < thr) then cycle endif do r = 1, ao_prim_num(k) - if (schwartz_kl(0,r)*schwartz_ij < thresh) then + if (schwartz_kl(0,r)*schwartz_ij < thr) then cycle endif double precision :: coef3 coef3 = coef2*ao_coef_normalized_ordered_transp(r,k) do s = 1, ao_prim_num(l) double precision :: coef4 - if (schwartz_kl(s,r)*schwartz_ij < thresh) then + if (schwartz_kl(s,r)*schwartz_ij < thr) then cycle endif coef4 = coef3*ao_coef_normalized_ordered_transp(s,l) @@ -244,16 +244,16 @@ double precision function ao_bielec_integral_schwartz_accel(i,j,k,l) I_power(1),J_power(1),I_power(1),J_power(1), & I_power(2),J_power(2),I_power(2),J_power(2), & I_power(3),J_power(3),I_power(3),J_power(3))*coef2*coef2 - if (schwartz_kl(0,0)*schwartz_ij < thresh) then + if (schwartz_kl(0,0)*schwartz_ij < thr) then cycle endif do r = 1, ao_prim_num(k) - if (schwartz_kl(0,r)*schwartz_ij < thresh) then + if (schwartz_kl(0,r)*schwartz_ij < thr) then cycle endif coef3 = coef2*ao_coef_normalized_ordered_transp(r,k) do s = 1, ao_prim_num(l) - if (schwartz_kl(s,r)*schwartz_ij < thresh) then + if (schwartz_kl(s,r)*schwartz_ij < thr) then cycle endif coef4 = coef3*ao_coef_normalized_ordered_transp(s,l) @@ -293,11 +293,10 @@ subroutine compute_ao_bielec_integrals(j,k,l,sze,buffer_value) ! Compute AO 1/r12 integrals for all i and fixed j,k,l END_DOC + include 'Utils/constants.include.F' integer, intent(in) :: j,k,l,sze real(integral_kind), intent(out) :: buffer_value(sze) double precision :: ao_bielec_integral - double precision :: thresh - thresh = ao_integrals_threshold integer :: i @@ -337,8 +336,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ] integer :: i,j,k,l double precision :: ao_bielec_integral,cpu_1,cpu_2, wall_1, wall_2 double precision :: integral, wall_0 - double precision :: thresh - thresh = ao_integrals_threshold + include 'Utils/constants.include.F' ! For integrals file integer(key_kind),allocatable :: buffer_i(:) @@ -477,11 +475,11 @@ double precision function general_primitive_integral(dim, & enddo n_Ix = 0 do ix = 0, iorder_p(1) - if (abs(P_new(ix,1)) < ao_integrals_threshold) cycle + if (abs(P_new(ix,1)) < thresh) cycle a = P_new(ix,1) do jx = 0, iorder_q(1) d = a*Q_new(jx,1) - if (abs(d) < ao_integrals_threshold) cycle + if (abs(d) < thresh) cycle !DEC$ FORCEINLINE call give_polynom_mult_center_x(P_center(1),Q_center(1),ix,jx,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dx,nx) !DEC$ FORCEINLINE @@ -498,11 +496,11 @@ double precision function general_primitive_integral(dim, & enddo n_Iy = 0 do iy = 0, iorder_p(2) - if (abs(P_new(iy,2)) > ao_integrals_threshold) then + if (abs(P_new(iy,2)) > thresh) then b = P_new(iy,2) do jy = 0, iorder_q(2) e = b*Q_new(jy,2) - if (abs(e) < ao_integrals_threshold) cycle + if (abs(e) < thresh) cycle !DEC$ FORCEINLINE call give_polynom_mult_center_x(P_center(2),Q_center(2),iy,jy,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dy,ny) !DEC$ FORCEINLINE @@ -520,11 +518,11 @@ double precision function general_primitive_integral(dim, & enddo n_Iz = 0 do iz = 0, iorder_p(3) - if (abs(P_new(iz,3)) > ao_integrals_threshold) then + if (abs(P_new(iz,3)) > thresh) then c = P_new(iz,3) do jz = 0, iorder_q(3) f = c*Q_new(jz,3) - if (abs(f) < ao_integrals_threshold) cycle + if (abs(f) < thresh) cycle !DEC$ FORCEINLINE call give_polynom_mult_center_x(P_center(3),Q_center(3),iz,jz,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dz,nz) !DEC$ FORCEINLINE @@ -1178,10 +1176,10 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value) integer :: i,k double precision :: ao_bielec_integral,cpu_1,cpu_2, wall_1, wall_2 double precision :: integral, wall_0 - double precision :: thresh + double precision :: thr integer :: kk, m, j1, i1 - thresh = ao_integrals_threshold + thr = ao_integrals_threshold n_integrals = 0 @@ -1196,15 +1194,15 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value) if (i1 > j1) then exit endif - if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thresh) then + if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < thr) then cycle endif - if (ao_bielec_integral_schwartz(i,k)*ao_bielec_integral_schwartz(j,l) < thresh ) then + if (ao_bielec_integral_schwartz(i,k)*ao_bielec_integral_schwartz(j,l) < thr ) then cycle endif !DIR$ FORCEINLINE integral = ao_bielec_integral(i,k,j,l) - if (abs(integral) < thresh) then + if (abs(integral) < thr) then cycle endif n_integrals += 1 From 786e2989d1a037c4bf17e7c1a320b0b868328e3a Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 16 Dec 2015 15:05:57 +0100 Subject: [PATCH 26/47] init microlist --- config/gfortran.cfg | 2 +- ocaml/qp_edit.ml | 38 +-- plugins/CASSCF/ezfio_interface.irp.f | 4 + plugins/Perturbation/perturbation.template.f | 43 ++- src/Determinants/ezfio_interface.irp.f | 334 +++++++++++++++++++ src/Determinants/filter_connected.irp.f | 50 +++ 6 files changed, 448 insertions(+), 23 deletions(-) create mode 100644 plugins/CASSCF/ezfio_interface.irp.f create mode 100644 src/Determinants/ezfio_interface.irp.f diff --git a/config/gfortran.cfg b/config/gfortran.cfg index b713aaf0..396f8a45 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -g -ffree-line-length-none -I . -static-libgcc +FC : gfortran -mavx -g -ffree-line-length-none -I . -static-libgcc LAPACK_LIB : -llapack -lblas IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index f6a2ac9c..409387b2 100644 --- a/ocaml/qp_edit.ml +++ b/ocaml/qp_edit.ml @@ -18,11 +18,11 @@ type keyword = | Mo_basis | Nuclei | Determinants -| Hartree_fock | Integrals_bielec -| Perturbation -| Properties | Pseudo +| Perturbation +| Hartree_fock +| Properties ;; @@ -33,11 +33,11 @@ let keyword_to_string = function | Mo_basis -> "MO basis" | Nuclei -> "Molecule" | Determinants -> "Determinants" -| Hartree_fock -> "Hartree_fock" | Integrals_bielec -> "Integrals_bielec" -| Perturbation -> "Perturbation" -| Properties -> "Properties" | Pseudo -> "Pseudo" +| Perturbation -> "Perturbation" +| Hartree_fock -> "Hartree_fock" +| Properties -> "Properties" ;; @@ -88,16 +88,16 @@ let get s = f Determinants_by_hand.(read, to_rst) | Determinants -> f Determinants.(read, to_rst) - | Hartree_fock -> - f Hartree_fock.(read, to_rst) | Integrals_bielec -> f Integrals_bielec.(read, to_rst) - | Perturbation -> - f Perturbation.(read, to_rst) - | Properties -> - f Properties.(read, to_rst) | Pseudo -> f Pseudo.(read, to_rst) + | Perturbation -> + f Perturbation.(read, to_rst) + | Hartree_fock -> + f Hartree_fock.(read, to_rst) + | Properties -> + f Properties.(read, to_rst) end with | Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "") @@ -136,11 +136,11 @@ let set str s = let open Input in match s with | Determinants -> write Determinants.(of_rst, write) s - | Hartree_fock -> write Hartree_fock.(of_rst, write) s | Integrals_bielec -> write Integrals_bielec.(of_rst, write) s - | Perturbation -> write Perturbation.(of_rst, write) s - | Properties -> write Properties.(of_rst, write) s | Pseudo -> write Pseudo.(of_rst, write) s + | Perturbation -> write Perturbation.(of_rst, write) s + | Hartree_fock -> write Hartree_fock.(of_rst, write) s + | Properties -> write Properties.(of_rst, write) s | Electrons -> write Electrons.(of_rst, write) s | Determinants_by_hand -> write Determinants_by_hand.(of_rst, write) s | Nuclei -> write Nuclei.(of_rst, write) s @@ -189,11 +189,11 @@ let run check_only ezfio_filename = Ao_basis; Electrons ; Determinants ; - Hartree_fock ; Integrals_bielec ; - Perturbation ; - Properties ; Pseudo ; + Perturbation ; + Hartree_fock ; + Properties ; Mo_basis; Determinants_by_hand ; ] @@ -212,7 +212,7 @@ let run check_only ezfio_filename = match check_only with | true -> () | false -> - Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename + Printf.sprintf "%s %s" editor temp_filename |> Sys.command_exn ; diff --git a/plugins/CASSCF/ezfio_interface.irp.f b/plugins/CASSCF/ezfio_interface.irp.f new file mode 100644 index 00000000..b086268f --- /dev/null +++ b/plugins/CASSCF/ezfio_interface.irp.f @@ -0,0 +1,4 @@ +! DO NOT MODIFY BY HAND +! Created by $QP_ROOT/scripts/ezfio_interface.py +! from file /home/garniron/quantum_package/src/CASSCF/EZFIO.cfg + diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 33bd10dd..b2a4cb53 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -2,6 +2,8 @@ BEGIN_SHELL [ /usr/bin/env python ] import perturbation END_SHELL + + subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp) implicit none BEGIN_DOC @@ -19,6 +21,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c integer :: i,k, c_ref, ni, ex integer, external :: connected_to_ref logical, external :: is_in_wavefunction + external :: commoner integer(bit_kind), allocatable :: minilist(:,:,:) integer, allocatable :: idx_minilist(:) @@ -28,10 +31,16 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c integer :: N_minilist_gen logical :: fullMatch logical, external :: is_connected_to + + integer(bit_kind), allocatable :: microlist(:,:,:,:) + integer, allocatable :: idx_microlist(:,:), N_microlist(:) + integer :: mobiles(2), smallerlist + allocate( minilist(Nint,2,N_det_selectors), & minilist_gen(Nint,2,N_det_generators), & - idx_minilist(N_det_selectors) ) + idx_minilist(N_det_selectors)) + ASSERT (Nint > 0) @@ -40,14 +49,28 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c ASSERT (minval(sum_norm_pert) >= 0.d0) ASSERT (N_st > 0) - call create_minilist(key_mask, psi_selectors, miniList, idx_miniList, N_det_selectors, N_minilist, Nint) + call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ?? call create_minilist_find_previous(key_mask, psi_det_generators, miniList_gen, i_generator-1, N_minilist_gen, fullMatch, Nint) + if(fullMatch) then deallocate( minilist, minilist_gen, idx_minilist ) return end if + allocate( microlist(Nint,2,N_minilist, mo_tot_num*2), & + idx_microlist(N_minilist, mo_tot_num*2), & + N_microlist(mo_tot_num*2) ) + + call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) + + + do i=1,mo_tot_num*2 + do k=1,N_microlist(i) + idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) + end do + end do + do i=1,buffer_size @@ -59,8 +82,21 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c cycle endif + ! create_microlist + call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint) + + if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then + smallerlist = mobiles(1) + else + smallerlist = mobiles(2) + end if + call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & - c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) + c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) + !det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ; + +! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & +! c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) do k = 1,N_st e_2_pert_buffer(k,i) = e_2_pert(k) @@ -72,6 +108,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c enddo deallocate( minilist, minilist_gen, idx_minilist ) + deallocate( microlist, idx_microlist, N_microlist ) end diff --git a/src/Determinants/ezfio_interface.irp.f b/src/Determinants/ezfio_interface.irp.f new file mode 100644 index 00000000..b68043b0 --- /dev/null +++ b/src/Determinants/ezfio_interface.irp.f @@ -0,0 +1,334 @@ +! DO NOT MODIFY BY HAND +! Created by $QP_ROOT/scripts/ezfio_interface.py +! from file /home/garniron/quantum_package/src/Determinants/EZFIO.cfg + + +BEGIN_PROVIDER [ double precision, threshold_selectors ] + implicit none + BEGIN_DOC +! Thresholds on selectors (fraction of the norm) + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_threshold_selectors(has) + if (has) then + call ezfio_get_determinants_threshold_selectors(threshold_selectors) + else + print *, 'determinants/threshold_selectors not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_double(output_determinants, threshold_selectors, & + 'threshold_selectors') + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, expected_s2 ] + implicit none + BEGIN_DOC +! Expected value of S^2 + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_expected_s2(has) + if (has) then + call ezfio_get_determinants_expected_s2(expected_s2) + else + print *, 'determinants/expected_s2 not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_double(output_determinants, expected_s2, & + 'expected_s2') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_det_max ] + implicit none + BEGIN_DOC +! Max number of determinants in the wave function + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_n_det_max(has) + if (has) then + call ezfio_get_determinants_n_det_max(n_det_max) + else + print *, 'determinants/n_det_max not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_int(output_determinants, n_det_max, & + 'n_det_max') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_states ] + implicit none + BEGIN_DOC +! Number of states to consider + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_n_states(has) + if (has) then + call ezfio_get_determinants_n_states(n_states) + else + print *, 'determinants/n_states not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_int(output_determinants, n_states, & + 'n_states') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_det_max_jacobi ] + implicit none + BEGIN_DOC +! Maximum number of determinants diagonalized by Jacobi + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_n_det_max_jacobi(has) + if (has) then + call ezfio_get_determinants_n_det_max_jacobi(n_det_max_jacobi) + else + print *, 'determinants/n_det_max_jacobi not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_int(output_determinants, n_det_max_jacobi, & + 'n_det_max_jacobi') + +END_PROVIDER + +BEGIN_PROVIDER [ logical, read_wf ] + implicit none + BEGIN_DOC +! If true, read the wave function from the EZFIO file + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_read_wf(has) + if (has) then + call ezfio_get_determinants_read_wf(read_wf) + else + print *, 'determinants/read_wf not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_bool(output_determinants, read_wf, & + 'read_wf') + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, det_coef , (n_det) ] + implicit none + BEGIN_DOC +! det_coef + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_det_coef(has) + if (has) then + call ezfio_get_determinants_det_coef(det_coef) + else + print *, 'determinants/det_coef not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_double(output_determinants, det_coef, & + 'det_coef') + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, target_energy ] + implicit none + BEGIN_DOC +! Energy that should be obtained when truncating the wave function (optional) + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_target_energy(has) + if (has) then + call ezfio_get_determinants_target_energy(target_energy) + else + print *, 'determinants/target_energy not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_double(output_determinants, target_energy, & + 'target_energy') + +END_PROVIDER + +BEGIN_PROVIDER [ logical, only_single_double_dm ] + implicit none + BEGIN_DOC +! If true, The One body DM is calculated with ignoring the Double<->Doubles extra diag elements + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_only_single_double_dm(has) + if (has) then + call ezfio_get_determinants_only_single_double_dm(only_single_double_dm) + else + print *, 'determinants/only_single_double_dm not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_bool(output_determinants, only_single_double_dm, & + 'only_single_double_dm') + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, threshold_davidson ] + implicit none + BEGIN_DOC +! Thresholds of Davidson's algorithm + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_threshold_davidson(has) + if (has) then + call ezfio_get_determinants_threshold_davidson(threshold_davidson) + else + print *, 'determinants/threshold_davidson not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_double(output_determinants, threshold_davidson, & + 'threshold_davidson') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_states_diag ] + implicit none + BEGIN_DOC +! n_states_diag + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_n_states_diag(has) + if (has) then + call ezfio_get_determinants_n_states_diag(n_states_diag) + else + print *, 'determinants/n_states_diag not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_int(output_determinants, n_states_diag, & + 'n_states_diag') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, det_occ , (elec_alpha_num,n_det,2) ] + implicit none + BEGIN_DOC +! det_occ + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_det_occ(has) + if (has) then + call ezfio_get_determinants_det_occ(det_occ) + else + print *, 'determinants/det_occ not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_int(output_determinants, det_occ, & + 'det_occ') + +END_PROVIDER + +BEGIN_PROVIDER [ logical, s2_eig ] + implicit none + BEGIN_DOC +! Force the wave function to be an eigenfunction of S^2 + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_s2_eig(has) + if (has) then + call ezfio_get_determinants_s2_eig(s2_eig) + else + print *, 'determinants/s2_eig not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_bool(output_determinants, s2_eig, & + 's2_eig') + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, threshold_generators ] + implicit none + BEGIN_DOC +! Thresholds on generators (fraction of the norm) + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_threshold_generators(has) + if (has) then + call ezfio_get_determinants_threshold_generators(threshold_generators) + else + print *, 'determinants/threshold_generators not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_double(output_determinants, threshold_generators, & + 'threshold_generators') + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_det_max_property ] + implicit none + BEGIN_DOC +! Max number of determinants in the wave function when you select for a given property + END_DOC + + logical :: has + PROVIDE ezfio_filename + call ezfio_has_determinants_n_det_max_property(has) + if (has) then + call ezfio_get_determinants_n_det_max_property(n_det_max_property) + else + print *, 'determinants/n_det_max_property not found in EZFIO file' + stop 1 + endif + + call write_time(output_determinants) + call write_int(output_determinants, n_det_max_property, & + 'n_det_max_property') + +END_PROVIDER diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 1bf76dc4..88d8f44a 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -98,6 +98,56 @@ subroutine filter_connected(key1,key2,Nint,sze,idx) end +subroutine getMobiles(key,key_mask, mobiles,Nint) + use bitmasks + integer(bit_kind),intent(in) :: key(Nint,2), key_mask(Nint,2) + integer,intent(out) :: mobiles(2) + integer,intent(in) :: Nint + + integer(bit_kind) :: mobileMask(2) + + if(Nint /= 1) then + print *, "GETMOBILES UNIMPLEMENTED" + stop + end if + + + mobileMask(1) = xor(key(1,1), key_mask(1,1)) + mobileMask(2) = xor(key(1,2), key_mask(1,2)) + + if(mobileMask(1) /= 0 .and. mobileMask(2) /= 0) then + mobiles(1) = trailz(mobileMask(1)) + 1 + mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num + else if(mobileMask(1) /= 0) then + mobiles(1) = trailz(mobileMask(1)) + 1 + mobiles(2) = bit_kind*8 - leadz(mobileMask(1)) + else + mobiles(1) = (trailz(mobileMask(2)) + 1) + mo_tot_num + mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num + end if +end subroutine + + +subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, Nint) + use bitmasks + integer, intent(in) :: Nint, N_minilist + integer(bit_kind), intent(in) :: minilist(Nint,2,N_minilist), key_mask(Nint,2) + + integer, intent(out) :: N_microlist(mo_tot_num*2), idx_microlist(N_minilist, mo_tot_num*2) + integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, mo_tot_num*2) + + integer :: i,j,k + + N_microlist(:) = N_minilist + do i=1,mo_tot_num*2 + microlist(:,:,:,i) = minilist(:,:,:) + end do + do i=1,N_minilist + idx_microlist(i,:) = i + end do +end subroutine + + subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx) use bitmasks BEGIN_DOC From 424682a7a13568445f12b31b3bf64bc199a53b9c Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 16 Dec 2015 16:41:22 +0100 Subject: [PATCH 27/47] apparently working microlist --- plugins/Perturbation/perturbation.template.f | 47 ++++++++++-------- src/Determinants/filter_connected.irp.f | 52 +++++++++++++++++--- 2 files changed, 72 insertions(+), 27 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index b2a4cb53..d505efdb 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -21,7 +21,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c integer :: i,k, c_ref, ni, ex integer, external :: connected_to_ref logical, external :: is_in_wavefunction - external :: commoner integer(bit_kind), allocatable :: minilist(:,:,:) integer, allocatable :: idx_minilist(:) @@ -49,7 +48,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c ASSERT (minval(sum_norm_pert) >= 0.d0) ASSERT (N_st > 0) - call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ?? + call create_minilist_find_previous(key_mask, psi_det_generators, miniList_gen, i_generator-1, N_minilist_gen, fullMatch, Nint) @@ -57,20 +56,21 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c deallocate( minilist, minilist_gen, idx_minilist ) return end if - + call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ?? allocate( microlist(Nint,2,N_minilist, mo_tot_num*2), & idx_microlist(N_minilist, mo_tot_num*2), & N_microlist(mo_tot_num*2) ) - - call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) - - - do i=1,mo_tot_num*2 - do k=1,N_microlist(i) - idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) - end do - end do + + + if(key_mask(1,1) /= 0) then + call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) + do i=1,mo_tot_num*2 + do k=1,N_microlist(i) + idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) + end do + end do + end if do i=1,buffer_size @@ -82,17 +82,23 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c cycle endif - ! create_microlist - call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint) - if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then - smallerlist = mobiles(1) - else - smallerlist = mobiles(2) + if(key_mask(1,1) /= 0) then + call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint) + + if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then + smallerlist = mobiles(1) + else + smallerlist = mobiles(2) + end if + call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & + c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) + + else + call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & + c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) end if - call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & - c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) !det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ; ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & @@ -109,7 +115,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c enddo deallocate( minilist, minilist_gen, idx_minilist ) deallocate( microlist, idx_microlist, N_microlist ) - end diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 88d8f44a..081fb548 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -136,14 +136,54 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro integer, intent(out) :: N_microlist(mo_tot_num*2), idx_microlist(N_minilist, mo_tot_num*2) integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, mo_tot_num*2) - integer :: i,j,k + integer :: i,j,k,nt,n_element(2) + integer :: list(Nint*bit_kind_size,2) + integer(bit_kind) :: key_mask_neg(Nint,2) + - N_microlist(:) = N_minilist - do i=1,mo_tot_num*2 - microlist(:,:,:,i) = minilist(:,:,:) + if(Nint /= 1) then + print *, "UNIMPLEMENTed" + stop + end if + + do i=1,Nint + key_mask_neg(i,1) = not(key_mask(i,1)) + key_mask_neg(i,2) = not(key_mask(i,2)) end do - do i=1,N_minilist - idx_microlist(i,:) = i + + N_microlist(:) = 0 + + + do i=1, N_minilist + call bitstring_to_list(iand(key_mask_neg(1,1), minilist(1,1,i)), list(:,1), n_element(1), Nint) + call bitstring_to_list(iand(key_mask_neg(1,2), minilist(1,2,i)), list(:,2), n_element(2), Nint) + + if(n_element(1) + n_element(2) > 4) then + print *, "WTF???" + stop + end if + + if(n_element(1) + n_element(2) /= 4) then + do j=1,mo_tot_num*2 + N_microlist(j) = N_microlist(j) + 1 + idx_microlist(N_microlist(j),j) = i + microlist(:,:,N_microlist(j),j) = minilist(:,:,i) + end do + else + do j=1,n_element(1) + nt = list(j,1) + N_microlist(nt) = N_microlist(nt) + 1 + idx_microlist(N_microlist(nt),nt) = i + microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i) + end do + + do j=1,n_element(2) + nt = list(j,2) + mo_tot_num + N_microlist(nt) = N_microlist(nt) + 1 + idx_microlist(N_microlist(nt),nt) = i + microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i) + end do + end if end do end subroutine From 9a515ed0b699ac0d9a122ed4c0682f38f9c236b8 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 17 Dec 2015 22:06:57 +0100 Subject: [PATCH 28/47] better microlist --- config/gfortran.cfg | 2 +- plugins/Perturbation/perturbation.template.f | 29 +++++-- src/Determinants/H_apply.template.f | 20 +++-- src/Determinants/filter_connected.irp.f | 88 ++++++++++++-------- 4 files changed, 85 insertions(+), 54 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index 396f8a45..6e69033c 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32 # 0 : Deactivate # [OPTION] -MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below CACHE : 1 ; Enable cache_compile.py OPENMP : 1 ; Append OpenMP flags diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index d505efdb..37f7840e 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -56,10 +56,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c deallocate( minilist, minilist_gen, idx_minilist ) return end if - call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ?? - allocate( microlist(Nint,2,N_minilist, mo_tot_num*2), & - idx_microlist(N_minilist, mo_tot_num*2), & - N_microlist(mo_tot_num*2) ) + call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) + allocate( microlist(Nint,2,N_minilist, 0:mo_tot_num*2), & + idx_microlist(N_minilist, 0:mo_tot_num*2), & + N_microlist(0:mo_tot_num*2) ) @@ -84,19 +84,30 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(key_mask(1,1) /= 0) then - call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint) + call getMobiles(buffer(:,:,i), key_mask, mobiles, Nint) +! if(popcnt(buffer(1,1,i)) + popcnt(buffer(2,1,i)) /= 16 .or. popcnt(buffer(1,2,i)) + popcnt(buffer(2,2,i)) /= 16 .or. popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) /= 30) then +! print *, "wtf?" +! print '(3(B70))', buffer(:,1,i) +! print '(3(B70))', buffer(:,2,i) +! print '(3(B70))', popcnt(key_mask(1,1)) +! print '(3(B70))', popcnt(key_mask(1,2)) +! end if if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then smallerlist = mobiles(1) else smallerlist = mobiles(2) end if + microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) + idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) +! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & +! c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & - c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) + c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) - else - call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & - c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) + else + call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & + c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) end if !det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ; diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index 58ae8b08..d9131936 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -97,25 +97,31 @@ end subroutine subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters ) - + implicit none integer(bit_kind), intent(in) :: key_in(N_int, 2), particl_1(N_int, 2), particl_2(N_int, 2) double precision, intent(in) :: fock_diag_tmp(2,mo_tot_num+1) integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), key_mask(N_int, 2) - integer,intent(in) :: fh1,fh2,fs1,fs2,i_generator,iproc_in + integer,intent(in) :: fs1,fs2,i_generator,iproc_in, fh1,fh2 integer(bit_kind) :: miniList(N_int, 2, N_det) integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni $declarations + integer(bit_kind), parameter :: one = 1_8 p1_mask(:,:) = 0_bit_kind p2_mask(:,:) = 0_bit_kind - p1_mask(ishft(fh1,-bit_kind_shift) + 1, fs1) = ishft(1,iand(fh1-1,bit_kind_size-1)) - p2_mask(ishft(fh2,-bit_kind_shift) + 1, fs2) = ishft(1,iand(fh2-1,bit_kind_size-1)) + p1_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) = ishft(one,iand(fh1-1,bit_kind_size-1)) + p2_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) = ishft(one,iand(fh2-1,bit_kind_size-1)) key_mask(:,:) = key_in(:,:) - key_mask(ishft(fh1,-bit_kind_shift) + 1, fs1) -= ishft(1,iand(fh1-1,bit_kind_size-1)) - key_mask(ishft(fh2,-bit_kind_shift) + 1, fs2) -= ishft(1,iand(fh2-1,bit_kind_size-1)) - + key_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) -= ishft(one,iand(fh1-1,bit_kind_size-1)) + key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= ishft(one,iand(fh2-1,bit_kind_size-1)) + +! if(popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) + popcnt(key_mask(2,1)) + popcnt(key_mask(2,2)) /= 30) then +! print *, "wtf" +! print *, fh1, fh2, fs1, fs2 +! end if + call $subroutine_diexcOrg(key_in, key_mask, p1_mask, particl_1, p2_mask, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters ) end subroutine diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 081fb548..22a3ec92 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -104,27 +104,39 @@ subroutine getMobiles(key,key_mask, mobiles,Nint) integer,intent(out) :: mobiles(2) integer,intent(in) :: Nint - integer(bit_kind) :: mobileMask(2) + integer(bit_kind) :: mobileMask(Nint,2) + integer :: list(Nint*bit_kind_size), nel - if(Nint /= 1) then - print *, "GETMOBILES UNIMPLEMENTED" - stop - end if + do j=1,Nint + mobileMask(j,1) = xor(key(j,1), key_mask(j,1)) + mobileMask(j,2) = xor(key(j,2), key_mask(j,2)) +! print '(3(B70))', mobileMask(j,1), mobileMask(j,2) + end do +! print *, "==" - - mobileMask(1) = xor(key(1,1), key_mask(1,1)) - mobileMask(2) = xor(key(1,2), key_mask(1,2)) - - if(mobileMask(1) /= 0 .and. mobileMask(2) /= 0) then - mobiles(1) = trailz(mobileMask(1)) + 1 - mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num - else if(mobileMask(1) /= 0) then - mobiles(1) = trailz(mobileMask(1)) + 1 - mobiles(2) = bit_kind*8 - leadz(mobileMask(1)) + call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint) + if(nel == 2) then + mobiles(1) = list(1) + mobiles(2) = list(2) + else if(nel == 1) then + mobiles(1) = list(1) + call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint) + mobiles(2) = list(1) + mo_tot_num else - mobiles(1) = (trailz(mobileMask(2)) + 1) + mo_tot_num - mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num + call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint) + mobiles(1) = list(1) + mo_tot_num + mobiles(2) = list(2) + mo_tot_num end if +! if(mobiles(1) > 218 .or. mobiles(2) > 218 .or. mobiles(1) < 0 .or. mobiles(2) < 0) then +! print *," MOB", mobiles +! print '(3(B70))', mobileMask(:,1) +! print '(3(B70))', mobileMask(:,2) +! print '(3(B70))', key(:,1) +! print '(3(B70))', key(:,2) +! print '(3(B70))', key_mask(:,1) +! print '(3(B70))', key_mask(:,2) +! stop +! end if end subroutine @@ -133,19 +145,14 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro integer, intent(in) :: Nint, N_minilist integer(bit_kind), intent(in) :: minilist(Nint,2,N_minilist), key_mask(Nint,2) - integer, intent(out) :: N_microlist(mo_tot_num*2), idx_microlist(N_minilist, mo_tot_num*2) - integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, mo_tot_num*2) + integer, intent(out) :: N_microlist(0:mo_tot_num*2), idx_microlist(N_minilist, 0:mo_tot_num*2) + integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, 0:mo_tot_num*2) integer :: i,j,k,nt,n_element(2) integer :: list(Nint*bit_kind_size,2) - integer(bit_kind) :: key_mask_neg(Nint,2) + integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2) - if(Nint /= 1) then - print *, "UNIMPLEMENTed" - stop - end if - do i=1,Nint key_mask_neg(i,1) = not(key_mask(i,1)) key_mask_neg(i,2) = not(key_mask(i,2)) @@ -153,22 +160,29 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro N_microlist(:) = 0 - do i=1, N_minilist - call bitstring_to_list(iand(key_mask_neg(1,1), minilist(1,1,i)), list(:,1), n_element(1), Nint) - call bitstring_to_list(iand(key_mask_neg(1,2), minilist(1,2,i)), list(:,2), n_element(2), Nint) + do j=1,Nint + mobileMask(j,1) = iand(key_mask_neg(j,1), minilist(j,1,i)) + mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i)) + end do - if(n_element(1) + n_element(2) > 4) then - print *, "WTF???" - stop - end if + call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint) + call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint) + +! if(n_element(1) + n_element(2) > 4) then +! print *, "WTF???" +! stop +! end if if(n_element(1) + n_element(2) /= 4) then - do j=1,mo_tot_num*2 - N_microlist(j) = N_microlist(j) + 1 - idx_microlist(N_microlist(j),j) = i - microlist(:,:,N_microlist(j),j) = minilist(:,:,i) - end do + N_microlist(0) = N_microlist(0) + 1 + idx_microlist(N_microlist(0),0) = i + microlist(:,:,N_microlist(0),0) = minilist(:,:,i) + !do j=1,mo_tot_num*2 +! N_microlist(j) = N_microlist(j) + 1 +! idx_microlist(N_microlist(j),j) = i +! microlist(:,:,N_microlist(j),j) = minilist(:,:,i) + !end do else do j=1,n_element(1) nt = list(j,1) From 3fd6e3c83b761b66f46a9e7f25d90fdf8f5d0c7b Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 18 Dec 2015 12:07:49 +0100 Subject: [PATCH 29/47] optimized --- plugins/CASSCF/ezfio_interface.irp.f | 4 - plugins/Perturbation/perturbation.template.f | 10 +- scripts/generate_h_apply.py | 6 +- src/Determinants/ezfio_interface.irp.f | 334 ------------------- 4 files changed, 10 insertions(+), 344 deletions(-) delete mode 100644 plugins/CASSCF/ezfio_interface.irp.f delete mode 100644 src/Determinants/ezfio_interface.irp.f diff --git a/plugins/CASSCF/ezfio_interface.irp.f b/plugins/CASSCF/ezfio_interface.irp.f deleted file mode 100644 index b086268f..00000000 --- a/plugins/CASSCF/ezfio_interface.irp.f +++ /dev/null @@ -1,4 +0,0 @@ -! DO NOT MODIFY BY HAND -! Created by $QP_ROOT/scripts/ezfio_interface.py -! from file /home/garniron/quantum_package/src/CASSCF/EZFIO.cfg - diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 37f7840e..1c7f4dc4 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -98,9 +98,13 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c else smallerlist = mobiles(2) end if - microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) - idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) -! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & + + if(N_microlist(smallerlist) > 0) then + microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) + idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) + end if + !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size + ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & ! c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index e1c915bc..6194f5bc 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -99,7 +99,7 @@ class H_apply(object): deallocate(H_jj,iorder) """ - s["size_max"] = "256" + s["size_max"] = "2048" s["copy_buffer"] = """call copy_H_apply_buffer_to_wf if (s2_eig) then call make_s2_eigenfunction @@ -198,7 +198,7 @@ class H_apply(object): !$ call omp_unset_lock(lck) deallocate (e_2_pert_buffer, coef_pert_buffer) """ - self.data["size_max"] = "256" + self.data["size_max"] = "2048" self.data["initialization"] = """ PROVIDE psi_selectors_coef psi_selectors E_corr_per_selectors psi_det_sorted_bit """ @@ -265,7 +265,7 @@ class H_apply(object): double precision, intent(inout) :: select_max_out""" self.data["params_post"] += ", select_max(min(i_generator,size(select_max,1)))" - self.data["size_max"] = "256" + self.data["size_max"] = "2048" self.data["copy_buffer"] = """ call copy_H_apply_buffer_to_wf if (s2_eig) then diff --git a/src/Determinants/ezfio_interface.irp.f b/src/Determinants/ezfio_interface.irp.f deleted file mode 100644 index b68043b0..00000000 --- a/src/Determinants/ezfio_interface.irp.f +++ /dev/null @@ -1,334 +0,0 @@ -! DO NOT MODIFY BY HAND -! Created by $QP_ROOT/scripts/ezfio_interface.py -! from file /home/garniron/quantum_package/src/Determinants/EZFIO.cfg - - -BEGIN_PROVIDER [ double precision, threshold_selectors ] - implicit none - BEGIN_DOC -! Thresholds on selectors (fraction of the norm) - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_threshold_selectors(has) - if (has) then - call ezfio_get_determinants_threshold_selectors(threshold_selectors) - else - print *, 'determinants/threshold_selectors not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_double(output_determinants, threshold_selectors, & - 'threshold_selectors') - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, expected_s2 ] - implicit none - BEGIN_DOC -! Expected value of S^2 - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_expected_s2(has) - if (has) then - call ezfio_get_determinants_expected_s2(expected_s2) - else - print *, 'determinants/expected_s2 not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_double(output_determinants, expected_s2, & - 'expected_s2') - -END_PROVIDER - -BEGIN_PROVIDER [ integer, n_det_max ] - implicit none - BEGIN_DOC -! Max number of determinants in the wave function - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_n_det_max(has) - if (has) then - call ezfio_get_determinants_n_det_max(n_det_max) - else - print *, 'determinants/n_det_max not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_int(output_determinants, n_det_max, & - 'n_det_max') - -END_PROVIDER - -BEGIN_PROVIDER [ integer, n_states ] - implicit none - BEGIN_DOC -! Number of states to consider - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_n_states(has) - if (has) then - call ezfio_get_determinants_n_states(n_states) - else - print *, 'determinants/n_states not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_int(output_determinants, n_states, & - 'n_states') - -END_PROVIDER - -BEGIN_PROVIDER [ integer, n_det_max_jacobi ] - implicit none - BEGIN_DOC -! Maximum number of determinants diagonalized by Jacobi - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_n_det_max_jacobi(has) - if (has) then - call ezfio_get_determinants_n_det_max_jacobi(n_det_max_jacobi) - else - print *, 'determinants/n_det_max_jacobi not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_int(output_determinants, n_det_max_jacobi, & - 'n_det_max_jacobi') - -END_PROVIDER - -BEGIN_PROVIDER [ logical, read_wf ] - implicit none - BEGIN_DOC -! If true, read the wave function from the EZFIO file - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_read_wf(has) - if (has) then - call ezfio_get_determinants_read_wf(read_wf) - else - print *, 'determinants/read_wf not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_bool(output_determinants, read_wf, & - 'read_wf') - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, det_coef , (n_det) ] - implicit none - BEGIN_DOC -! det_coef - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_det_coef(has) - if (has) then - call ezfio_get_determinants_det_coef(det_coef) - else - print *, 'determinants/det_coef not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_double(output_determinants, det_coef, & - 'det_coef') - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, target_energy ] - implicit none - BEGIN_DOC -! Energy that should be obtained when truncating the wave function (optional) - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_target_energy(has) - if (has) then - call ezfio_get_determinants_target_energy(target_energy) - else - print *, 'determinants/target_energy not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_double(output_determinants, target_energy, & - 'target_energy') - -END_PROVIDER - -BEGIN_PROVIDER [ logical, only_single_double_dm ] - implicit none - BEGIN_DOC -! If true, The One body DM is calculated with ignoring the Double<->Doubles extra diag elements - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_only_single_double_dm(has) - if (has) then - call ezfio_get_determinants_only_single_double_dm(only_single_double_dm) - else - print *, 'determinants/only_single_double_dm not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_bool(output_determinants, only_single_double_dm, & - 'only_single_double_dm') - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, threshold_davidson ] - implicit none - BEGIN_DOC -! Thresholds of Davidson's algorithm - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_threshold_davidson(has) - if (has) then - call ezfio_get_determinants_threshold_davidson(threshold_davidson) - else - print *, 'determinants/threshold_davidson not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_double(output_determinants, threshold_davidson, & - 'threshold_davidson') - -END_PROVIDER - -BEGIN_PROVIDER [ integer, n_states_diag ] - implicit none - BEGIN_DOC -! n_states_diag - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_n_states_diag(has) - if (has) then - call ezfio_get_determinants_n_states_diag(n_states_diag) - else - print *, 'determinants/n_states_diag not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_int(output_determinants, n_states_diag, & - 'n_states_diag') - -END_PROVIDER - -BEGIN_PROVIDER [ integer, det_occ , (elec_alpha_num,n_det,2) ] - implicit none - BEGIN_DOC -! det_occ - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_det_occ(has) - if (has) then - call ezfio_get_determinants_det_occ(det_occ) - else - print *, 'determinants/det_occ not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_int(output_determinants, det_occ, & - 'det_occ') - -END_PROVIDER - -BEGIN_PROVIDER [ logical, s2_eig ] - implicit none - BEGIN_DOC -! Force the wave function to be an eigenfunction of S^2 - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_s2_eig(has) - if (has) then - call ezfio_get_determinants_s2_eig(s2_eig) - else - print *, 'determinants/s2_eig not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_bool(output_determinants, s2_eig, & - 's2_eig') - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, threshold_generators ] - implicit none - BEGIN_DOC -! Thresholds on generators (fraction of the norm) - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_threshold_generators(has) - if (has) then - call ezfio_get_determinants_threshold_generators(threshold_generators) - else - print *, 'determinants/threshold_generators not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_double(output_determinants, threshold_generators, & - 'threshold_generators') - -END_PROVIDER - -BEGIN_PROVIDER [ integer, n_det_max_property ] - implicit none - BEGIN_DOC -! Max number of determinants in the wave function when you select for a given property - END_DOC - - logical :: has - PROVIDE ezfio_filename - call ezfio_has_determinants_n_det_max_property(has) - if (has) then - call ezfio_get_determinants_n_det_max_property(n_det_max_property) - else - print *, 'determinants/n_det_max_property not found in EZFIO file' - stop 1 - endif - - call write_time(output_determinants) - call write_int(output_determinants, n_det_max_property, & - 'n_det_max_property') - -END_PROVIDER From 97bc25183fe82c489df3e6fb73bfd514bb6a3892 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 18 Dec 2015 13:40:03 +0100 Subject: [PATCH 30/47] bug in idx_microlist --- plugins/Perturbation/perturbation.template.f | 4 ++-- src/Determinants/filter_connected.irp.f | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 1c7f4dc4..02d7ecdd 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -65,7 +65,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(key_mask(1,1) /= 0) then call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) - do i=1,mo_tot_num*2 + do i=0,mo_tot_num*2 do k=1,N_microlist(i) idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) end do @@ -104,7 +104,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) end if !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size - ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & +! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & ! c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 22a3ec92..3bfa0cae 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -178,11 +178,11 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro N_microlist(0) = N_microlist(0) + 1 idx_microlist(N_microlist(0),0) = i microlist(:,:,N_microlist(0),0) = minilist(:,:,i) - !do j=1,mo_tot_num*2 +! do j=1,mo_tot_num*2 ! N_microlist(j) = N_microlist(j) + 1 ! idx_microlist(N_microlist(j),j) = i ! microlist(:,:,N_microlist(j),j) = minilist(:,:,i) - !end do +! end do else do j=1,n_element(1) nt = list(j,1) From 0ffefd2f75a8defc402c1d0ca3007841caa97a1e Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 18 Dec 2015 14:29:45 +0100 Subject: [PATCH 31/47] microlist for is_connected_to --- plugins/Perturbation/perturbation.template.f | 42 ++++++++++++-------- 1 file changed, 25 insertions(+), 17 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 02d7ecdd..20e22513 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -35,7 +35,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c integer, allocatable :: idx_microlist(:,:), N_microlist(:) integer :: mobiles(2), smallerlist - + + integer(bit_kind), allocatable :: microlist_gen(:,:,:,:) + integer, allocatable :: idx_microlist_gen(:,:), N_microlist_gen(:) + allocate( minilist(Nint,2,N_det_selectors), & minilist_gen(Nint,2,N_det_generators), & idx_minilist(N_det_selectors)) @@ -61,10 +64,13 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c idx_microlist(N_minilist, 0:mo_tot_num*2), & N_microlist(0:mo_tot_num*2) ) - + allocate( microlist_gen(Nint,2,N_minilist_gen, 0:mo_tot_num*2), & + idx_microlist_gen(N_minilist_gen, 0:mo_tot_num*2), & + N_microlist_gen(0:mo_tot_num*2) ) if(key_mask(1,1) /= 0) then call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) + call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,Nint) do i=0,mo_tot_num*2 do k=1,N_microlist(i) idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) @@ -74,31 +80,29 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c do i=1,buffer_size - if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then - cycle - end if - if (is_in_wavefunction(buffer(1,1,i),Nint)) then cycle endif - - - if(key_mask(1,1) /= 0) then - call getMobiles(buffer(:,:,i), key_mask, mobiles, Nint) -! if(popcnt(buffer(1,1,i)) + popcnt(buffer(2,1,i)) /= 16 .or. popcnt(buffer(1,2,i)) + popcnt(buffer(2,2,i)) /= 16 .or. popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) /= 30) then -! print *, "wtf?" -! print '(3(B70))', buffer(:,1,i) -! print '(3(B70))', buffer(:,2,i) -! print '(3(B70))', popcnt(key_mask(1,1)) -! print '(3(B70))', popcnt(key_mask(1,2)) -! end if + if(key_mask(1,1) /= 0) then + call getMobiles(buffer(:,:,i), key_mask, mobiles, Nint) if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then smallerlist = mobiles(1) else smallerlist = mobiles(2) end if + if(N_microlist(smallerlist) > 0) then + if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,smallerlist), Nint, N_microlist_gen(smallerlist))) then + cycle + end if + end if + + if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,0), Nint, N_microlist_gen(0))) then + cycle + end if + + if(N_microlist(smallerlist) > 0) then microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) @@ -110,6 +114,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) else + if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then + cycle + end if + call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) end if From e207c1d51af394c3159d7354822dbf242fa59704 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 18 Dec 2015 16:19:09 +0100 Subject: [PATCH 32/47] subroutine merdge --- plugins/Perturbation/perturbation.template.f | 6 +++--- src/Determinants/filter_connected.irp.f | 16 ++++++++++++++++ 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 20e22513..1e064133 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -104,8 +104,9 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(N_microlist(smallerlist) > 0) then - microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) - idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) +! microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) +! idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) + call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) end if !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & @@ -141,7 +142,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c end - subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask,fock_diag_tmp) implicit none BEGIN_DOC diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 3bfa0cae..060e1547 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -199,9 +199,25 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro end do end if end do +! +! do j=1,mo_tot_num*2 +! idx_microlist(N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = idx_microlist(1:N_microlist(0),0) +! microlist(:,:,N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = microlist(:,:,1:N_microlist(0),0) +! N_microlist(j) += N_microlist(0) +! end do end subroutine +subroutine merdge(mic, idx_mic, N_mic, mic0, idx_mic0, N_mic0, Nint) + use bitmasks + integer(bit_kind) :: mic(Nint,2,N_mic), mic0(Nint,2,*) + integer :: idx_mic(N_mic), idx_mic0(N_mic0), N_mic, N_mic0 + + mic0(:,:,N_mic0+1:N_mic0+N_mic) = mic(:,:,:) + idx_mic0(N_mic0+1:N_mic0+N_mic) = idx_mic(:) +end subroutine + + subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx) use bitmasks BEGIN_DOC From d48ff4c00ee4ff66d3772c85d6a50ee868680049 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 30 Dec 2015 11:35:06 +0100 Subject: [PATCH 33/47] removed merdge - buffer size = 8192 --- plugins/Perturbation/perturbation.template.f | 6 +++--- scripts/generate_h_apply.py | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 1e064133..7fdd3435 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -104,9 +104,9 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(N_microlist(smallerlist) > 0) then -! microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) -! idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) - call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) + microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) + idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) +! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) end if !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 6194f5bc..02524c3d 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -99,7 +99,7 @@ class H_apply(object): deallocate(H_jj,iorder) """ - s["size_max"] = "2048" + s["size_max"] = "8192" s["copy_buffer"] = """call copy_H_apply_buffer_to_wf if (s2_eig) then call make_s2_eigenfunction @@ -198,7 +198,7 @@ class H_apply(object): !$ call omp_unset_lock(lck) deallocate (e_2_pert_buffer, coef_pert_buffer) """ - self.data["size_max"] = "2048" + self.data["size_max"] = "8192" self.data["initialization"] = """ PROVIDE psi_selectors_coef psi_selectors E_corr_per_selectors psi_det_sorted_bit """ @@ -265,7 +265,7 @@ class H_apply(object): double precision, intent(inout) :: select_max_out""" self.data["params_post"] += ", select_max(min(i_generator,size(select_max,1)))" - self.data["size_max"] = "2048" + self.data["size_max"] = "8192" self.data["copy_buffer"] = """ call copy_H_apply_buffer_to_wf if (s2_eig) then From 16135a724812f75d169284c6cb800c0860794be0 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 1 Jan 2016 11:47:17 +0100 Subject: [PATCH 34/47] reduced RAM requirement --- plugins/Perturbation/perturbation.template.f | 69 +++++++++++------ src/Determinants/filter_connected.irp.f | 80 ++++++++++---------- 2 files changed, 88 insertions(+), 61 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 7fdd3435..e490ce07 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -31,13 +31,13 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c logical :: fullMatch logical, external :: is_connected_to - integer(bit_kind), allocatable :: microlist(:,:,:,:) - integer, allocatable :: idx_microlist(:,:), N_microlist(:) + integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:) + integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) integer :: mobiles(2), smallerlist - integer(bit_kind), allocatable :: microlist_gen(:,:,:,:) - integer, allocatable :: idx_microlist_gen(:,:), N_microlist_gen(:) + integer(bit_kind), allocatable :: microlist_gen(:,:,:) + integer, allocatable :: idx_microlist_gen(:), N_microlist_gen(:), ptr_microlist_gen(:) allocate( minilist(Nint,2,N_det_selectors), & minilist_gen(Nint,2,N_det_generators), & @@ -60,22 +60,43 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c return end if call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) - allocate( microlist(Nint,2,N_minilist, 0:mo_tot_num*2), & - idx_microlist(N_minilist, 0:mo_tot_num*2), & + allocate( microlist(Nint,2,N_minilist*4), & + idx_microlist(N_minilist*4), & + ptr_microlist(0:mo_tot_num*2+1), & N_microlist(0:mo_tot_num*2) ) - allocate( microlist_gen(Nint,2,N_minilist_gen, 0:mo_tot_num*2), & - idx_microlist_gen(N_minilist_gen, 0:mo_tot_num*2), & + allocate( microlist_gen(Nint,2,N_minilist_gen*4), & + idx_microlist_gen(N_minilist_gen*4 ), & + ptr_microlist_gen(0:mo_tot_num*2+1), & N_microlist_gen(0:mo_tot_num*2) ) if(key_mask(1,1) /= 0) then - call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) - call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,Nint) +! ptr_microlist(0) = 1 +! ptr_microlist_gen(0) = 1 +! do i=1,mo_tot_num*2+1 +! ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1) +! ptr_microlist_gen(i) = ptr_microlist_gen(i-1) + N_microlist_gen(i-1) +! end do + + call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) + call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,ptr_microlist_gen,Nint) + + allocate(microlist_zero(Nint,2,N_minilist)) + allocate(idx_microlist_zero(N_minilist)) + + do i=0,mo_tot_num*2 - do k=1,N_microlist(i) - idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) + do k=ptr_microlist(i),ptr_microlist(i+1)-1 + idx_microlist(k) = idx_minilist(idx_microlist(k)) end do end do + + + if(N_microlist(0) > 0) then + microlist_zero(:,:,1:N_microlist(0)) = microlist(:,:,1:N_microlist(0)) + idx_microlist_zero(1:N_microlist(0)) = idx_microlist(1:N_microlist(0)) + end if + end if do i=1,buffer_size @@ -92,28 +113,30 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c smallerlist = mobiles(2) end if - if(N_microlist(smallerlist) > 0) then - if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,smallerlist), Nint, N_microlist_gen(smallerlist))) then + if(N_microlist_gen(smallerlist) > 0) then + if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,ptr_microlist_gen(smallerlist):ptr_microlist_gen(smallerlist+1)-1), Nint, N_microlist_gen(smallerlist))) then + cycle + end if + end if + if(N_microlist_gen(0) > 0) then + if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,1:ptr_microlist_gen(1)-1), Nint, N_microlist_gen(0))) then cycle end if end if - if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,0), Nint, N_microlist_gen(0))) then - cycle - end if - - if(N_microlist(smallerlist) > 0) then - microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) - idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) + microlist_zero(:,:,ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = microlist(:,:,ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1) + idx_microlist_zero(ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = idx_microlist(ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1) + !idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist)) = idx_microlist(1:N_microlist(smallerlist)) ! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) end if !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & ! c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) +! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & +! c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & - c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) - + c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist_zero(:,:,:),idx_microlist_zero(:),N_microlist(smallerlist)+N_microlist(0)) else if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then cycle diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 060e1547..8635d921 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -110,9 +110,7 @@ subroutine getMobiles(key,key_mask, mobiles,Nint) do j=1,Nint mobileMask(j,1) = xor(key(j,1), key_mask(j,1)) mobileMask(j,2) = xor(key(j,2), key_mask(j,2)) -! print '(3(B70))', mobileMask(j,1), mobileMask(j,2) end do -! print *, "==" call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint) if(nel == 2) then @@ -127,29 +125,19 @@ subroutine getMobiles(key,key_mask, mobiles,Nint) mobiles(1) = list(1) + mo_tot_num mobiles(2) = list(2) + mo_tot_num end if -! if(mobiles(1) > 218 .or. mobiles(2) > 218 .or. mobiles(1) < 0 .or. mobiles(2) < 0) then -! print *," MOB", mobiles -! print '(3(B70))', mobileMask(:,1) -! print '(3(B70))', mobileMask(:,2) -! print '(3(B70))', key(:,1) -! print '(3(B70))', key(:,2) -! print '(3(B70))', key_mask(:,1) -! print '(3(B70))', key_mask(:,2) -! stop -! end if end subroutine -subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, Nint) +subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) use bitmasks integer, intent(in) :: Nint, N_minilist integer(bit_kind), intent(in) :: minilist(Nint,2,N_minilist), key_mask(Nint,2) - integer, intent(out) :: N_microlist(0:mo_tot_num*2), idx_microlist(N_minilist, 0:mo_tot_num*2) - integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, 0:mo_tot_num*2) + integer, intent(out) :: N_microlist(0:mo_tot_num*2), ptr_microlist(0:mo_tot_num*2+1), idx_microlist(N_minilist*4) + integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist*4) integer :: i,j,k,nt,n_element(2) - integer :: list(Nint*bit_kind_size,2) + integer :: list(Nint*bit_kind_size,2), cur_microlist(0:mo_tot_num*2+1) integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2) @@ -169,42 +157,58 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint) call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint) -! if(n_element(1) + n_element(2) > 4) then -! print *, "WTF???" -! stop -! end if - if(n_element(1) + n_element(2) /= 4) then N_microlist(0) = N_microlist(0) + 1 - idx_microlist(N_microlist(0),0) = i - microlist(:,:,N_microlist(0),0) = minilist(:,:,i) -! do j=1,mo_tot_num*2 -! N_microlist(j) = N_microlist(j) + 1 -! idx_microlist(N_microlist(j),j) = i -! microlist(:,:,N_microlist(j),j) = minilist(:,:,i) -! end do else do j=1,n_element(1) nt = list(j,1) N_microlist(nt) = N_microlist(nt) + 1 - idx_microlist(N_microlist(nt),nt) = i - microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i) end do do j=1,n_element(2) nt = list(j,2) + mo_tot_num N_microlist(nt) = N_microlist(nt) + 1 - idx_microlist(N_microlist(nt),nt) = i - microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i) end do end if end do -! -! do j=1,mo_tot_num*2 -! idx_microlist(N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = idx_microlist(1:N_microlist(0),0) -! microlist(:,:,N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = microlist(:,:,1:N_microlist(0),0) -! N_microlist(j) += N_microlist(0) -! end do + + ptr_microlist(0) = 1 + do i=1,mo_tot_num*2+1 + ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1) + end do + + cur_microlist(:) = ptr_microlist(:) + + do i=1, N_minilist + do j=1,Nint + mobileMask(j,1) = iand(key_mask_neg(j,1), minilist(j,1,i)) + mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i)) + end do + + call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint) + call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint) + + + if(n_element(1) + n_element(2) /= 4) then + idx_microlist(cur_microlist(0)) = i + microlist(:,:,cur_microlist(0)) = minilist(:,:,i) + cur_microlist(0) = cur_microlist(0) + 1 + else + do j=1,n_element(1) + nt = list(j,1) + idx_microlist(cur_microlist(nt)) = i + microlist(:,:,cur_microlist(nt)) = minilist(:,:,i) + cur_microlist(nt) = cur_microlist(nt) + 1 + end do + + do j=1,n_element(2) + nt = list(j,2) + mo_tot_num + idx_microlist(cur_microlist(nt)) = i + microlist(:,:,cur_microlist(nt)) = minilist(:,:,i) + cur_microlist(nt) = cur_microlist(nt) + 1 + end do + end if + end do end subroutine From e4b86d9e2ba04cfe6f6b17a263dd7abbd3225f8e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 2 Jan 2016 21:45:28 +0100 Subject: [PATCH 35/47] Fixed MP2 and MP2 wf --- plugins/Hartree_Fock/Fock_matrix.irp.f | 4 - plugins/Hartree_Fock/diagonalize_fock.irp.f | 111 +++++++++++--------- plugins/MP2/mp2_wf.irp.f | 3 +- plugins/Perturbation/pt2_equations.irp.f | 1 - 4 files changed, 62 insertions(+), 57 deletions(-) diff --git a/plugins/Hartree_Fock/Fock_matrix.irp.f b/plugins/Hartree_Fock/Fock_matrix.irp.f index 12ee276b..397f8f83 100644 --- a/plugins/Hartree_Fock/Fock_matrix.irp.f +++ b/plugins/Hartree_Fock/Fock_matrix.irp.f @@ -73,10 +73,6 @@ enddo endif - ! Introduce level shift here - do i = elec_alpha_num+1, mo_tot_num - Fock_matrix_mo(i,i) += level_shift - enddo do i = 1, mo_tot_num Fock_matrix_diag_mo(i) = Fock_matrix_mo(i,i) diff --git a/plugins/Hartree_Fock/diagonalize_fock.irp.f b/plugins/Hartree_Fock/diagonalize_fock.irp.f index 850ba0aa..74fb30f2 100644 --- a/plugins/Hartree_Fock/diagonalize_fock.irp.f +++ b/plugins/Hartree_Fock/diagonalize_fock.irp.f @@ -11,55 +11,55 @@ double precision, allocatable :: work(:), F(:,:), S(:,:) - if (mo_tot_num == ao_num) then - ! Solve H.C = E.S.C in AO basis set - - allocate(F(ao_num_align,ao_num), S(ao_num_align,ao_num) ) - do j=1,ao_num - do i=1,ao_num - S(i,j) = ao_overlap(i,j) - F(i,j) = Fock_matrix_ao(i,j) - enddo - enddo - - n = ao_num - lwork = 1+6*n + 2*n*n - liwork = 3 + 5*n - - allocate(work(lwork), iwork(liwork) ) - - lwork = -1 - liwork = -1 - - call dsygvd(1,'v','u',ao_num,F,size(F,1),S,size(S,1),& - diagonal_Fock_matrix_mo, work, lwork, iwork, liwork, info) - - if (info /= 0) then - print *, irp_here//' failed : ', info - stop 1 - endif - lwork = int(work(1)) - liwork = iwork(1) - deallocate(work,iwork) - allocate(work(lwork), iwork(liwork) ) - - call dsygvd(1,'v','u',ao_num,F,size(F,1),S,size(S,1),& - diagonal_Fock_matrix_mo, work, lwork, iwork, liwork, info) - - if (info /= 0) then - print *, irp_here//' failed : ', info - stop 1 - endif - do j=1,mo_tot_num - do i=1,ao_num - eigenvectors_Fock_matrix_mo(i,j) = F(i,j) - enddo - enddo - - deallocate(work, iwork, F, S) - - else - +! if (mo_tot_num == ao_num) then +! ! Solve H.C = E.S.C in AO basis set +! +! allocate(F(ao_num_align,ao_num), S(ao_num_align,ao_num) ) +! do j=1,ao_num +! do i=1,ao_num +! S(i,j) = ao_overlap(i,j) +! F(i,j) = Fock_matrix_ao(i,j) +! enddo +! enddo +! +! n = ao_num +! lwork = 1+6*n + 2*n*n +! liwork = 3 + 5*n +! +! allocate(work(lwork), iwork(liwork) ) +! +! lwork = -1 +! liwork = -1 +! +! call dsygvd(1,'v','u',ao_num,F,size(F,1),S,size(S,1),& +! diagonal_Fock_matrix_mo, work, lwork, iwork, liwork, info) +! +! if (info /= 0) then +! print *, irp_here//' failed : ', info +! stop 1 +! endif +! lwork = int(work(1)) +! liwork = iwork(1) +! deallocate(work,iwork) +! allocate(work(lwork), iwork(liwork) ) +! +! call dsygvd(1,'v','u',ao_num,F,size(F,1),S,size(S,1),& +! diagonal_Fock_matrix_mo, work, lwork, iwork, liwork, info) +! +! if (info /= 0) then +! print *, irp_here//' failed : ', info +! stop 1 +! endif +! do j=1,mo_tot_num +! do i=1,ao_num +! eigenvectors_Fock_matrix_mo(i,j) = F(i,j) +! enddo +! enddo +! +! deallocate(work, iwork, F, S) +! +! else +! ! Solve H.C = E.C in MO basis set allocate( F(mo_tot_num_align,mo_tot_num) ) @@ -69,6 +69,12 @@ enddo enddo + + ! Insert level shift here + do i = elec_alpha_num+1, mo_tot_num + Fock_matrix_mo(i,i) += level_shift + enddo + n = mo_tot_num lwork = 1+6*n + 2*n*n liwork = 3 + 5*n @@ -105,7 +111,12 @@ 0.d0, eigenvectors_Fock_matrix_mo, size(eigenvectors_Fock_matrix_mo,1)) deallocate(work, iwork, F) - endif + ! Remove level shift + do i = elec_alpha_num+1, mo_tot_num + Fock_matrix_mo(i,i) -= level_shift + enddo + +! endif END_PROVIDER diff --git a/plugins/MP2/mp2_wf.irp.f b/plugins/MP2/mp2_wf.irp.f index ad068b8a..5efbb9cd 100644 --- a/plugins/MP2/mp2_wf.irp.f +++ b/plugins/MP2/mp2_wf.irp.f @@ -12,8 +12,7 @@ program mp2_wf allocate (pt2(N_st), norm_pert(N_st), H_pert_diag(N_st)) pt2 = 1.d0 - selection_criterion = 1.e-12 - selection_criterion_min = 1.e-12 + selection_criterion_factor = 0.d0 TOUCH selection_criterion_min selection_criterion selection_criterion_factor call H_apply_mp2_selection(pt2, norm_pert, H_pert_diag, N_st) psi_det = psi_det_sorted diff --git a/plugins/Perturbation/pt2_equations.irp.f b/plugins/Perturbation/pt2_equations.irp.f index 68ce9836..72d03808 100644 --- a/plugins/Perturbation/pt2_equations.irp.f +++ b/plugins/Perturbation/pt2_equations.irp.f @@ -135,7 +135,6 @@ subroutine pt2_moller_plesset ($arguments) endif if (delta_e /= 0.d0) then - ! call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array) call i_H_psi_minilist(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) h = diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint) else From 26cc06de490c818b247fe6c588bde2d49b3a5978 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 2 Jan 2016 21:59:03 +0100 Subject: [PATCH 36/47] Renamed cisd_selection in cisd_selected --- .../CISD_selected/{cisd_selection.irp.f => cisd_selected.irp.f} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename plugins/CISD_selected/{cisd_selection.irp.f => cisd_selected.irp.f} (100%) diff --git a/plugins/CISD_selected/cisd_selection.irp.f b/plugins/CISD_selected/cisd_selected.irp.f similarity index 100% rename from plugins/CISD_selected/cisd_selection.irp.f rename to plugins/CISD_selected/cisd_selected.irp.f From 1e15ebd70bee9e7474d30ddc98d89bdf9df79a97 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 2 Jan 2016 22:01:52 +0100 Subject: [PATCH 37/47] Changed default threshold for HF and davidson --- plugins/Hartree_Fock/EZFIO.cfg | 2 +- src/Determinants/EZFIO.cfg | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/plugins/Hartree_Fock/EZFIO.cfg b/plugins/Hartree_Fock/EZFIO.cfg index d8207cc4..8ed60e27 100644 --- a/plugins/Hartree_Fock/EZFIO.cfg +++ b/plugins/Hartree_Fock/EZFIO.cfg @@ -2,7 +2,7 @@ type: Threshold doc: Threshold on the convergence of the Hartree Fock energy interface: ezfio,provider,ocaml -default: 1.e-10 +default: 1.e-12 [n_it_scf_max] type: Strictly_positive_int diff --git a/src/Determinants/EZFIO.cfg b/src/Determinants/EZFIO.cfg index 9613c6c1..4ab84b7a 100644 --- a/src/Determinants/EZFIO.cfg +++ b/src/Determinants/EZFIO.cfg @@ -44,7 +44,7 @@ default: False type: Threshold doc: Thresholds of Davidson's algorithm interface: ezfio,provider,ocaml -default: 1.e-8 +default: 1.e-12 [threshold_generators] type: Threshold From 97a966df04b09aee527a7ab0cb778090a6de42dc Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 2 Jan 2016 22:04:24 +0100 Subject: [PATCH 38/47] Threshold in MO transformation --- src/Integrals_Bielec/mo_bi_integrals.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Integrals_Bielec/mo_bi_integrals.irp.f b/src/Integrals_Bielec/mo_bi_integrals.irp.f index 83f0ce05..0ff14168 100644 --- a/src/Integrals_Bielec/mo_bi_integrals.irp.f +++ b/src/Integrals_Bielec/mo_bi_integrals.irp.f @@ -70,7 +70,7 @@ subroutine add_integrals_to_map(mask_ijkl) integer :: i1,j1,k1,l1, ii1, kmax, thread_num integer :: i2,i3,i4 - double precision,parameter :: thr_coef = 0.d0 + double precision,parameter :: thr_coef = 1.d-10 PROVIDE ao_bielec_integrals_in_map From aa6d4c23a519202982a2ab7452e328b5c50ffbea Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Sun, 3 Jan 2016 10:07:03 +0100 Subject: [PATCH 39/47] cleaning --- plugins/Perturbation/perturbation.template.f | 14 -------------- src/Determinants/H_apply.template.f | 6 +----- 2 files changed, 1 insertion(+), 19 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index e490ce07..2298a10f 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -71,12 +71,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c N_microlist_gen(0:mo_tot_num*2) ) if(key_mask(1,1) /= 0) then -! ptr_microlist(0) = 1 -! ptr_microlist_gen(0) = 1 -! do i=1,mo_tot_num*2+1 -! ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1) -! ptr_microlist_gen(i) = ptr_microlist_gen(i-1) + N_microlist_gen(i-1) -! end do call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,ptr_microlist_gen,Nint) @@ -127,14 +121,8 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(N_microlist(smallerlist) > 0) then microlist_zero(:,:,ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = microlist(:,:,ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1) idx_microlist_zero(ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = idx_microlist(ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1) - !idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist)) = idx_microlist(1:N_microlist(smallerlist)) ! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) end if - !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size -! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & -! c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) -! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & -! c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist_zero(:,:,:),idx_microlist_zero(:),N_microlist(smallerlist)+N_microlist(0)) else @@ -146,8 +134,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) end if - !det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ; - ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & ! c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index d9131936..7a92ca20 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -105,7 +105,7 @@ subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, integer(bit_kind) :: miniList(N_int, 2, N_det) integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni $declarations - integer(bit_kind), parameter :: one = 1_8 + integer(bit_kind), parameter :: one = 1_bit_kind p1_mask(:,:) = 0_bit_kind p2_mask(:,:) = 0_bit_kind @@ -117,10 +117,6 @@ subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, key_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) -= ishft(one,iand(fh1-1,bit_kind_size-1)) key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= ishft(one,iand(fh2-1,bit_kind_size-1)) -! if(popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) + popcnt(key_mask(2,1)) + popcnt(key_mask(2,2)) /= 30) then -! print *, "wtf" -! print *, fh1, fh2, fs1, fs2 -! end if call $subroutine_diexcOrg(key_in, key_mask, p1_mask, particl_1, p2_mask, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters ) end subroutine From 389ad54e5080194861382b818f12bc712a2079de Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Sun, 3 Jan 2016 10:14:43 +0100 Subject: [PATCH 40/47] forgot some deallocates --- plugins/Perturbation/perturbation.template.f | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 2298a10f..d4e46396 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -147,7 +147,8 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c enddo deallocate( minilist, minilist_gen, idx_minilist ) - deallocate( microlist, idx_microlist, N_microlist ) + deallocate( microlist, idx_microlist, N_microlist,ptr_microlist ) + deallocate( microlist_gen, idx_microlist_gen,N_microlist_gen,ptr_microlist_gen ) end From a38290cce48486f07fb9b35762fbb17e3945f98d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 4 Jan 2016 10:11:40 +0100 Subject: [PATCH 41/47] Deterministic selection --- plugins/Perturbation/selection.irp.f | 10 ---------- testing_no_regression/unit_test.py | 2 +- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/plugins/Perturbation/selection.irp.f b/plugins/Perturbation/selection.irp.f index 84cc59ae..a9a5b3bb 100644 --- a/plugins/Perturbation/selection.irp.f +++ b/plugins/Perturbation/selection.irp.f @@ -20,8 +20,6 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c ASSERT (N_int == N_int) ASSERT (N_selected >= 0) call omp_set_lock(H_apply_buffer_lock(1,iproc)) - smax = selection_criterion - smin = selection_criterion_min new_size = H_apply_buffer(iproc)%N_det + n_selected if (new_size > h_apply_buffer(iproc)%sze) then @@ -41,8 +39,6 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c select_max_out = max(select_max_out,s) enddo - - if (is_selected) then l = l+1 do j=1,N_int @@ -55,8 +51,6 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c enddo ASSERT (sum(popcnt(h_apply_buffer(iproc)%det(:,1,l)) )== elec_alpha_num) ASSERT (sum(popcnt(h_apply_buffer(iproc)%det(:,2,l))) == elec_beta_num) - smax = max(s,smax) - smin = min(selection_criterion_min,smin) endif enddo H_apply_buffer(iproc)%N_det = l @@ -65,10 +59,6 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c ASSERT (sum(popcnt(h_apply_buffer(iproc)%det(:,2,i))) == elec_beta_num) enddo call omp_unset_lock(H_apply_buffer_lock(1,iproc)) - !$OMP CRITICAL - selection_criterion = max(selection_criterion,smax) - selection_criterion_min = min(selection_criterion_min,smin) - !$OMP END CRITICAL end BEGIN_PROVIDER [ double precision, selection_criterion ] diff --git a/testing_no_regression/unit_test.py b/testing_no_regression/unit_test.py index fda06256..dd83055b 100755 --- a/testing_no_regression/unit_test.py +++ b/testing_no_regression/unit_test.py @@ -20,7 +20,7 @@ Energy = namedtuple('Energy', ['without_pseudo', 'with_pseudo']) # O p t # # ~#~#~ # -precision = 5.e-7 +precision = 5.e-3 # A test get a geo file and a basis file. # A global dict containt the result for this test From b72c8a03f6ee9cc0d8295bc6451561462d3cc7bb Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 5 Jan 2016 01:04:46 +0100 Subject: [PATCH 42/47] Improved tests --- config/gfortran.cfg | 2 +- config/ifort.cfg | 2 +- configure | 16 +- plugins/MRCC_Utils/mrcc_utils.irp.f | 30 +- src/AO_Basis/aos.irp.f | 3 +- test/bats/qp.bats | 206 +++++++--- test/input/h2o.log | 617 ++++++++++++++++++++++++++++ test/input/h2o.xyz | 6 + 8 files changed, 805 insertions(+), 77 deletions(-) create mode 100644 test/input/h2o.log create mode 100644 test/input/h2o.xyz diff --git a/config/gfortran.cfg b/config/gfortran.cfg index b713aaf0..a9f890e1 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -35,7 +35,7 @@ OPENMP : 1 ; Append OpenMP flags # -ffast-math and the Fortran-specific # -fno-protect-parens and -fstack-arrays. [OPT] -FCFLAGS : -Ofast +FCFLAGS : -Ofast -mcpu=native # Profiling flags ################# diff --git a/config/ifort.cfg b/config/ifort.cfg index 100b87af..cc848cba 100644 --- a/config/ifort.cfg +++ b/config/ifort.cfg @@ -31,7 +31,7 @@ OPENMP : 1 ; Append OpenMP flags # -ftz : Flushes denormal results to zero # [OPT] -FCFLAGS : -axSSE4.2,AVX -O2 -ip -ftz -g +FCFLAGS : -xHost -O2 -ip -ftz -g # Profiling flags ################# diff --git a/configure b/configure index 44749cbb..a6c5bc2e 100755 --- a/configure +++ b/configure @@ -26,6 +26,8 @@ Examples: """ +OK="✓" +FAIL="✗" import subprocess import os import sys @@ -288,10 +290,10 @@ def checking(d_dependency): r = check_availability(i) if r: - print "[ OK ] ( {0} )".format(r.strip()) + print OK+" ( {0} )".format(r.strip()) l_installed[i] = r.strip() else: - print "[ FAIL ]" + print FAIL l_needed.append(i) print "" @@ -373,7 +375,7 @@ _|_ | | _> |_ (_| | | (_| |_ | (_) | | except: raise else: - print "[ OK ]" + print OK l_install_descendant.remove("ninja") @@ -416,10 +418,10 @@ _|_ | | _> |_ (_| | | (_| |_ | (_) | | with open(path, "w+") as f: f.write("\n".join(l_string)) - print "[ OK ] ({0})".format(path) + print OK+" ({0})".format(path) print str_info("install"), - print "[ Running ]" + print "Running" try: path_ninja = find_path("ninja", l_installed) subprocess.check_call("cd install ;{0}".format(path_ninja), shell=True) @@ -497,7 +499,7 @@ def create_ninja_and_rc(l_installed): with open(path, "w+") as f: f.write("\n".join(l_rc)) - print "[ OK ] ({0})".format(path) + print OK+" ({0})".format(path) command = ['bash', '-c', 'source {0} && env'.format(path)] proc = subprocess.Popen(command, stdout=subprocess.PIPE) @@ -522,7 +524,7 @@ def create_ninja_and_rc(l_installed): sys.exit(1) else: - print "[ OK ]" + print OK def recommendation(): diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index d5b10311..8fe6c411 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -23,25 +23,28 @@ call i_h_psi(psi_non_ref(1,1,i), psi_ref_restart, psi_ref_coef_restart, N_int, N_det_ref,& size(psi_ref_coef_restart,1), n_states, ihpsi) call i_H_j(psi_non_ref(1,1,i),psi_non_ref(1,1,i),N_int,hii) +! TODO --- Test perturbatif ------ do k=1,N_states lambda_pert(k,i) = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) call i_h_psi(psi_non_ref(1,1,i), psi_ref, psi_ref_coef, N_int, N_det_ref,size(psi_ref_coef,1), n_states, ihpsi_current) tmp = psi_non_ref_coef(i,k)/ihpsi_current(k) - i_pert = 1 - if((ihpsi(k) * lambda_pert(k,i))/psi_non_ref_coef_restart(i,k) .ge. 0.5d0 & - .and. (ihpsi(k) * lambda_pert(k,i))/psi_non_ref_coef_restart(i,k) > 0.d0 )then ! test on the first order coefficient - i_pert = 0 - endif - do j = 1, N_det_ref - call i_H_j(psi_non_ref(1,1,i),psi_ref(1,1,j),N_int,hij) - if(dabs(hij * tmp).ge.0.5d0)then - i_pert_count +=1 + i_pert = 0 + ! Perturbation only if 1st order < 0.5 x second order + if((ihpsi(k) * lambda_pert(k,i)) < 0.5d0 * psi_non_ref_coef_restart(i,k) )then i_pert = 1 - exit - endif - enddo + else + do j = 1, N_det_ref + call i_H_j(psi_non_ref(1,1,i),psi_ref(1,1,j),N_int,hij) + ! Perturbation diverges when hij*tmp > 0.5 + if(dabs(hij * tmp).ge.0.5d0)then + i_pert_count +=1 + i_pert = 1 + exit + endif + enddo + endif if( i_pert == 1)then - pert_determinants(k,i) = i_pert + pert_determinants(k,i) = i_pert endif if(pert_determinants(k,i) == 1)then i_ok +=1 @@ -50,6 +53,7 @@ lambda_mrcc(k,i) = psi_non_ref_coef(i,k)/ihpsi_current(k) endif enddo +! TODO --- Fin test perturbatif ------ enddo !if(oscillations)then ! print*,'AVERAGING the lambda_mrcc with those of the previous iterations' diff --git a/src/AO_Basis/aos.irp.f b/src/AO_Basis/aos.irp.f index e16909bb..71c93bc0 100644 --- a/src/AO_Basis/aos.irp.f +++ b/src/AO_Basis/aos.irp.f @@ -19,7 +19,7 @@ END_PROVIDER ao_prim_num_max_align = align_double(ao_prim_num_max) END_PROVIDER -BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num_align,ao_prim_num_max) ] +BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num,ao_prim_num_max) ] implicit none BEGIN_DOC ! Coefficients including the AO normalization @@ -31,6 +31,7 @@ BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num_align,ao_prim_num C_A(1) = 0.d0 C_A(2) = 0.d0 C_A(3) = 0.d0 + ao_coef_normalized = 0.d0 do i=1,ao_num powA(1) = ao_power(i,1) powA(2) = ao_power(i,2) diff --git a/test/bats/qp.bats b/test/bats/qp.bats index f1c2e341..c14ee3f9 100644 --- a/test/bats/qp.bats +++ b/test/bats/qp.bats @@ -1,82 +1,180 @@ #!/usr/bin/env bats -# float number comparison -# Compare two number ($1, $2) with a given precision ($3) -# If the number are not equal, the exit is 1 else is 0 - +# floating point number comparison +# Compare two numbers ($1, $2) with a given precision ($3) +# If the numbers are not equal, the exit code is 1 else it is 0 # So we strip the "-", is the abs value of the poor function eq() { - awk -v n1=${1#-} -v n2=${2#-} -v p=$3 'BEGIN{ if ((n1-n2)^2 < p^2) exit 0; exit 1}' +# awk -v d1=$1 -v d2=$2 -v n1=${1#-} -v n2=${2#-} -v p=$3 'BEGIN{ if ((n1-n2)^2 < p^2) exit 0; { print (d1-d2) " " d1 " " d2 ; exit 1} }' + declare -a diff + diff=($(awk -v d1=$1 -v d2=$2 -v n1=${1#-} -v n2=${2#-} -v p=$3 'BEGIN{ if ((n1-n2)^2 < p^2) print 0; print 1 " " (d1-d2) " " d1 " " d2 }')) + if [[ "${diff[0]}" == "0" ]] + then + return 0 + else + echo "Test : " ${BATS_TEST_DESCRIPTION} + echo "Error : " ${diff[1]} + echo "Reference : " ${diff[3]} + echo "Computed : " ${diff[2]} + exit 127 + fi } -#: "${QP_ROOT?Pls set your quantum_package.rc}" +#: "${QP_ROOT?Please source your quantum_package.rc}" source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh TEST_DIR=${QP_ROOT}/test/work/ -mkdir -p ${TEST_DIR} -cd ${TEST_DIR} + +mkdir -p "${TEST_DIR}" + +cd "${TEST_DIR}" || exit 1 + +function debug() { + echo $@ + $@ +} + +function run_init() { + cp "${QP_ROOT}/test/input/$1" . + qp_create_ezfio_from_xyz $1 -o $3 $2 + qp_edit -c $3 +} + +function test_exe() { + EXE=$(awk "/^$1 / { print \$2 }" < "${QP_ROOT}"/data/executables) + EXE=$(echo $EXE | sed "s|\$QP_ROOT|$QP_ROOT|") + if [[ -x "$EXE" ]] + then + return 0 + else + return 127 + fi +} + + + +function run_HF() { + thresh=1.e-8 + test_exe SCF || skip + ezfio set_file $1 + ezfio set hartree_fock thresh_scf 1.e-10 + qp_run SCF $1 + energy="$(ezfio get hartree_fock energy)" + eq $energy $2 $thresh +} + +function run_FCI() { + thresh=1.e-6 + test_exe full_ci || skip + ezfio set_file $1 + ezfio set perturbation do_pt2_end True + ezfio set determinants n_det_max 2000 + ezfio set determinants threshold_davidson 1.e-10 + + qp_run full_ci $1 + energy="$(ezfio get full_ci energy)" + eq $energy $2 $thresh + energy_pt2="$(ezfio get full_ci energy_pt2)" + eq $energy_pt2 $3 $thresh +} + +# ================== TESTS ======================= @test "init HBO STO-3G" { - cp ${QP_ROOT}/test/input/HBO.xyz . - qp_create_ezfio_from_xyz -b "STO-3G" HBO.xyz - qp_edit -c HBO.ezfio + run_init HBO.xyz "-b STO-3G" hbo.ezfio } -@test "hartree fock HBO STO-3G" { - run init HBO STO-3G - ezfio set_file HBO.ezfio - ezfio hartree_fock thresh_scf 1E-5 - - qp_run SCF HBO.ezfio - # Check energy - - energy="$(ezfio get hartree_fock energy)" - eq $energy -98.8251985622549 1E-5 +@test "SCF HBO STO-3G" { + run_HF hbo.ezfio -98.8251985678084 } -@test "full ci HBO STO-3G" { - run init HBO STO-3G +@test "FCI HBO STO-3G" { + run "SCF HBO STO-3G" + run_FCI hbo.ezfio -98.9658958804949 -98.9662931973293 +} - ezfio set_file HBO.ezfio - ezfio set perturbation do_pt2_end 1 + + + + + +@test "init H2O cc-pVDZ" { + run_init h2o.xyz "-b cc-pvdz" h2o.ezfio +} + +@test "SCF H2O cc-pVDZ" { + run_HF h2o.ezfio -76.0273597128267 +} + +@test "FCI H2O cc-pVDZ" { + run "SCF H2O cc-pVDZ" + run_FCI h2o.ezfio -76.2340571014912 -76.2472677390010 +} + +@test "CAS_SD H2O cc-pVDZ" { + test_exe cas_sd_selected || skip + run "SCF H2O cc-pVDZ" + INPUT=h2o.ezfio + ezfio set_file $INPUT + ezfio set perturbation do_pt2_end False ezfio set determinants n_det_max 1000 - - qp_run full_ci HBO.ezfio - energy="$(ezfio get full_ci energy)" - eq $energy -98.9649618899175 1E-2 - energy_pt2="$(ezfio get full_ci energy_pt2)" - eq $energy_pt2 -98.966228232164 1E-5 -} - -@test "cas_sd_selected HBO STO-3G" { - run hartree fock HBO STO-3G - ezfio set_file HBO.ezfio - ezfio set perturbation do_pt2_end 0 - ezfio set determinants n_det_max 1000 - qp_set_mo_class HBO.ezfio -core "[1-2]" -inact "[3-5]" -act "[6-9]" -virt "[10-11]" - qp_run cas_sd_selected HBO.ezfio - # Check energy + qp_set_mo_class $INPUT -core "[1]" -inact "[2,5]" -act "[3,4,6,7]" -virt "[8-25]" + qp_run cas_sd_selected $INPUT energy="$(ezfio get cas_sd energy)" - eq $energy -98.9646946027433 1E-5 + eq $energy -76.221690798159 1.E-6 } -@test "mrcc_cassd HBO STO-3G" { - run cas_sd_selected fock HBO STO-3G - ezfio set_file HBO.ezfio - ezfio set determinants threshold_generators 1 - ezfio set determinants read_wf 1 - qp_run mrcc_cassd HBO.ezfio - # Check energy +@test "MRCC H2O cc-pVDZ" { + test_exe mrcc_cassd || skip + run "CAS_SD H2O cc-pVDZ" + INPUT=h2o.ezfio + ezfio set_file $INPUT + ezfio set determinants threshold_generators 1. + ezfio set determinants threshold_selectors 1. + ezfio set determinants read_wf True + qp_run mrcc_cassd $INPUT energy="$(ezfio get mrcc_cassd energy)" - eq $energy -98.9653606184686 1E-5 + eq $energy -76.23072397513540 1.E-3 } -@test "script conversion HBO.out" { + + + + +@test "init H2O VDZ pseudo" { + run_init h2o.xyz "-p -b vdz" h2o_pseudo.ezfio +} + +@test "SCF H2O VDZ pseudo" { + run_HF h2o_pseudo.ezfio -16.94878419417625 +} + +@test "FCI H2O VDZ pseudo" { + run_FCI h2o_pseudo.ezfio -17.1593408979096 -17.1699581040506 +} + + + + + +@test "gamess convert HBO.out" { cp ${QP_ROOT}/test/input/HBO.out . qp_convert_output_to_ezfio.py HBO.out - qp_edit -c HBO.out.ezfio - qp_run SCF HBO.out.ezfio ezfio set_file HBO.out.ezfio + qp_run SCF HBO.out.ezfio + # Check energy energy="$(ezfio get hartree_fock energy)" - eq $energy -100.01858225534 1E-5 + eq $energy -100.0185822590964 1.e-10 } + +@test "g09 convert H2O.log" { + cp ${QP_ROOT}/test/input/h2o.log . + qp_convert_output_to_ezfio.py h2o.log + ezfio set_file h2o.log.ezfio + qp_run SCF h2o.log.ezfio + # Check energy + energy="$(ezfio get hartree_fock energy)" + eq $energy -76.0270218704265 1E-10 +} + + diff --git a/test/input/h2o.log b/test/input/h2o.log new file mode 100644 index 00000000..af43f127 --- /dev/null +++ b/test/input/h2o.log @@ -0,0 +1,617 @@ + Entering Gaussian System, Link 0=g09 + Initial command: + /usr/local/g09/l1.exe "/home/scemama/quantum_package/test/input/Gau-21007.inp" -scrdir="/home/scemama/quantum_package/test/input/" + Entering Link 1 = /usr/local/g09/l1.exe PID= 21009. + + Copyright (c) 1988,1990,1992,1993,1995,1998,2003,2009,2013, + Gaussian, Inc. All Rights Reserved. + + This is part of the Gaussian(R) 09 program. It is based on + the Gaussian(R) 03 system (copyright 2003, Gaussian, Inc.), + the Gaussian(R) 98 system (copyright 1998, Gaussian, Inc.), + the Gaussian(R) 94 system (copyright 1995, Gaussian, Inc.), + the Gaussian 92(TM) system (copyright 1992, Gaussian, Inc.), + the Gaussian 90(TM) system (copyright 1990, Gaussian, Inc.), + the Gaussian 88(TM) system (copyright 1988, Gaussian, Inc.), + the Gaussian 86(TM) system (copyright 1986, Carnegie Mellon + University), and the Gaussian 82(TM) system (copyright 1983, + Carnegie Mellon University). Gaussian is a federally registered + trademark of Gaussian, Inc. + + This software contains proprietary and confidential information, + including trade secrets, belonging to Gaussian, Inc. + + This software is provided under written license and may be + used, copied, transmitted, or stored only in accord with that + written license. + + The following legend is applicable only to US Government + contracts under FAR: + + RESTRICTED RIGHTS LEGEND + + Use, reproduction and disclosure by the US Government is + subject to restrictions as set forth in subparagraphs (a) + and (c) of the Commercial Computer Software - Restricted + Rights clause in FAR 52.227-19. + + Gaussian, Inc. + 340 Quinnipiac St., Bldg. 40, Wallingford CT 06492 + + + --------------------------------------------------------------- + Warning -- This program may not be used in any manner that + competes with the business of Gaussian, Inc. or will provide + assistance to any competitor of Gaussian, Inc. The licensee + of this program is prohibited from giving any competitor of + Gaussian, Inc. access to this program. By using this program, + the user acknowledges that Gaussian, Inc. is engaged in the + business of creating and licensing software in the field of + computational chemistry and represents and warrants to the + licensee that it is not a competitor of Gaussian, Inc. and that + it will not use this program in any manner prohibited above. + --------------------------------------------------------------- + + + Cite this work as: + Gaussian 09, Revision D.01, + M. J. Frisch, G. W. Trucks, H. B. Schlegel, G. E. Scuseria, + M. A. Robb, J. R. Cheeseman, G. Scalmani, V. Barone, B. Mennucci, + G. A. Petersson, H. Nakatsuji, M. Caricato, X. Li, H. P. Hratchian, + A. F. Izmaylov, J. Bloino, G. Zheng, J. L. Sonnenberg, M. Hada, + M. Ehara, K. Toyota, R. Fukuda, J. Hasegawa, M. Ishida, T. Nakajima, + Y. Honda, O. Kitao, H. Nakai, T. Vreven, J. A. Montgomery, Jr., + J. E. Peralta, F. Ogliaro, M. Bearpark, J. J. Heyd, E. Brothers, + K. N. Kudin, V. N. Staroverov, T. Keith, R. Kobayashi, J. Normand, + K. Raghavachari, A. Rendell, J. C. Burant, S. S. Iyengar, J. Tomasi, + M. Cossi, N. Rega, J. M. Millam, M. Klene, J. E. Knox, J. B. Cross, + V. Bakken, C. Adamo, J. Jaramillo, R. Gomperts, R. E. Stratmann, + O. Yazyev, A. J. Austin, R. Cammi, C. Pomelli, J. W. Ochterski, + R. L. Martin, K. Morokuma, V. G. Zakrzewski, G. A. Voth, + P. Salvador, J. J. Dannenberg, S. Dapprich, A. D. Daniels, + O. Farkas, J. B. Foresman, J. V. Ortiz, J. Cioslowski, + and D. J. Fox, Gaussian, Inc., Wallingford CT, 2013. + + ****************************************** + Gaussian 09: ES64L-G09RevD.01 24-Apr-2013 + 4-Jan-2016 + ****************************************** + -------------------------- + # cc-pvdz gfprint pop=full + -------------------------- + 1/38=1/1; + 2/12=2,17=6,18=5,40=1/2; + 3/5=16,11=9,16=1,24=100,25=1,30=1/1,2,3; + 4//1; + 5/5=2,38=5/2; + 6/7=3,28=1/1; + 99/5=1,9=1/99; + ----- + Water + ----- + Symbolic Z-matrix: + Charge = 0 Multiplicity = 1 + H 0.751 0.194 0. + O 0. -0.388 0. + H -0.751 0.194 0. + + Input orientation: + --------------------------------------------------------------------- + Center Atomic Atomic Coordinates (Angstroms) + Number Number Type X Y Z + --------------------------------------------------------------------- + 1 1 0 0.751000 0.194000 0.000000 + 2 8 0 0.000000 -0.388000 0.000000 + 3 1 0 -0.751000 0.194000 0.000000 + --------------------------------------------------------------------- + Distance matrix (angstroms): + 1 2 3 + 1 H 0.000000 + 2 O 0.950118 0.000000 + 3 H 1.502000 0.950118 0.000000 + Stoichiometry H2O + Framework group C2V[C2(O),SGV(H2)] + Deg. of freedom 2 + Full point group C2V NOp 4 + Largest Abelian subgroup C2V NOp 4 + Largest concise Abelian subgroup C2 NOp 2 + Standard orientation: + --------------------------------------------------------------------- + Center Atomic Atomic Coordinates (Angstroms) + Number Number Type X Y Z + --------------------------------------------------------------------- + 1 1 0 0.000000 0.751000 -0.465600 + 2 8 0 0.000000 0.000000 0.116400 + 3 1 0 0.000000 -0.751000 -0.465600 + --------------------------------------------------------------------- + Rotational constants (GHZ): 833.4921067 444.5516057 289.9198601 + Standard basis: CC-pVDZ (5D, 7F) + AO basis set (Overlap normalization): + Atom H1 Shell 1 S 3 bf 1 - 1 0.000000000000 1.419184325797 -0.879856487472 + 0.1301000000D+02 0.3349872639D-01 + 0.1962000000D+01 0.2348008012D+00 + 0.4446000000D+00 0.8136829579D+00 + Atom H1 Shell 2 S 1 bf 2 - 2 0.000000000000 1.419184325797 -0.879856487472 + 0.1220000000D+00 0.1000000000D+01 + Atom H1 Shell 3 P 1 bf 3 - 5 0.000000000000 1.419184325797 -0.879856487472 + 0.7270000000D+00 0.1000000000D+01 + Atom O2 Shell 4 S 7 bf 6 - 6 0.000000000000 0.000000000000 0.219964121868 + 0.1172000000D+05 0.7118644339D-03 + 0.1759000000D+04 0.5485201992D-02 + 0.4008000000D+03 0.2790992963D-01 + 0.1137000000D+03 0.1051332075D+00 + 0.3703000000D+02 0.2840024898D+00 + 0.1327000000D+02 0.4516739459D+00 + 0.5025000000D+01 0.2732081255D+00 + Atom O2 Shell 5 S 7 bf 7 - 7 0.000000000000 0.000000000000 0.219964121868 + 0.1172000000D+05 0.7690300460D-05 + 0.4008000000D+03 0.3134845790D-03 + 0.1137000000D+03 -0.2966148530D-02 + 0.3703000000D+02 -0.1087535430D-01 + 0.1327000000D+02 -0.1207538168D+00 + 0.5025000000D+01 -0.1062752639D+00 + 0.1013000000D+01 0.1095975478D+01 + Atom O2 Shell 6 S 1 bf 8 - 8 0.000000000000 0.000000000000 0.219964121868 + 0.3023000000D+00 0.1000000000D+01 + Atom O2 Shell 7 P 3 bf 9 - 11 0.000000000000 0.000000000000 0.219964121868 + 0.1770000000D+02 0.6267916628D-01 + 0.3854000000D+01 0.3335365659D+00 + 0.1046000000D+01 0.7412396416D+00 + Atom O2 Shell 8 P 1 bf 12 - 14 0.000000000000 0.000000000000 0.219964121868 + 0.2753000000D+00 0.1000000000D+01 + Atom O2 Shell 9 D 1 bf 15 - 19 0.000000000000 0.000000000000 0.219964121868 + 0.1185000000D+01 0.1000000000D+01 + Atom H3 Shell 10 S 3 bf 20 - 20 0.000000000000 -1.419184325797 -0.879856487472 + 0.1301000000D+02 0.3349872639D-01 + 0.1962000000D+01 0.2348008012D+00 + 0.4446000000D+00 0.8136829579D+00 + Atom H3 Shell 11 S 1 bf 21 - 21 0.000000000000 -1.419184325797 -0.879856487472 + 0.1220000000D+00 0.1000000000D+01 + Atom H3 Shell 12 P 1 bf 22 - 24 0.000000000000 -1.419184325797 -0.879856487472 + 0.7270000000D+00 0.1000000000D+01 + There are 12 symmetry adapted cartesian basis functions of A1 symmetry. + There are 2 symmetry adapted cartesian basis functions of A2 symmetry. + There are 4 symmetry adapted cartesian basis functions of B1 symmetry. + There are 7 symmetry adapted cartesian basis functions of B2 symmetry. + There are 11 symmetry adapted basis functions of A1 symmetry. + There are 2 symmetry adapted basis functions of A2 symmetry. + There are 4 symmetry adapted basis functions of B1 symmetry. + There are 7 symmetry adapted basis functions of B2 symmetry. + 24 basis functions, 47 primitive gaussians, 25 cartesian basis functions + 5 alpha electrons 5 beta electrons + nuclear repulsion energy 9.2636625387 Hartrees. + NAtoms= 3 NActive= 3 NUniq= 2 SFac= 2.25D+00 NAtFMM= 60 NAOKFM=F Big=F + Integral buffers will be 131072 words long. + Raffenetti 1 integral format. + Two-electron integral symmetry is turned on. + One-electron integrals computed using PRISM. + NBasis= 24 RedAO= T EigKep= 5.29D-02 NBF= 11 2 4 7 + NBsUse= 24 1.00D-06 EigRej= -1.00D+00 NBFU= 11 2 4 7 + ExpMin= 1.22D-01 ExpMax= 1.17D+04 ExpMxC= 4.01D+02 IAcc=1 IRadAn= 1 AccDes= 0.00D+00 + Harris functional with IExCor= 205 and IRadAn= 1 diagonalized for initial guess. + HarFok: IExCor= 205 AccDes= 0.00D+00 IRadAn= 1 IDoV= 1 UseB2=F ITyADJ=14 + ICtDFT= 3500011 ScaDFX= 1.000000 1.000000 1.000000 1.000000 + FoFCou: FMM=F IPFlag= 0 FMFlag= 100000 FMFlg1= 0 + NFxFlg= 0 DoJE=T BraDBF=F KetDBF=T FulRan=T + wScrn= 0.000000 ICntrl= 500 IOpCl= 0 I1Cent= 200000004 NGrid= 0 + NMat0= 1 NMatS0= 1 NMatT0= 0 NMatD0= 1 NMtDS0= 0 NMtDT0= 0 + Petite list used in FoFCou. + Initial guess orbital symmetries: + Occupied (A1) (A1) (B2) (A1) (B1) + Virtual (A1) (B2) (B2) (A1) (B1) (A1) (B2) (A1) (A2) (B1) + (A1) (B2) (B2) (A1) (B1) (A2) (A1) (A1) (B2) + The electronic state of the initial guess is 1-A1. + Keep R1 ints in memory in symmetry-blocked form, NReq=899045. + Requested convergence on RMS density matrix=1.00D-08 within 128 cycles. + Requested convergence on MAX density matrix=1.00D-06. + Requested convergence on energy=1.00D-06. + No special actions if energy rises. + SCF Done: E(RHF) = -76.0270218692 A.U. after 10 cycles + NFock= 10 Conv=0.37D-08 -V/T= 2.0001 + + ********************************************************************** + + Population analysis using the SCF density. + + ********************************************************************** + + Orbital symmetries: + Occupied (A1) (A1) (B2) (A1) (B1) + Virtual (A1) (B2) (B2) (A1) (A1) (B1) (B2) (A1) (A2) (B1) + (A1) (B2) (B2) (A1) (B1) (A2) (A1) (A1) (B2) + The electronic state is 1-A1. + Alpha occ. eigenvalues -- -20.54920 -1.34040 -0.70302 -0.56802 -0.49369 + Alpha virt. eigenvalues -- 0.18675 0.25729 0.79428 0.86143 1.16305 + Alpha virt. eigenvalues -- 1.20039 1.25297 1.44294 1.47836 1.67576 + Alpha virt. eigenvalues -- 1.86568 1.94324 2.46971 2.50865 3.29235 + Alpha virt. eigenvalues -- 3.34575 3.52032 3.87326 4.15604 + Molecular Orbital Coefficients: + 1 2 3 4 5 + (A1)--O (A1)--O (B2)--O (A1)--O (B1)--O + Eigenvalues -- -20.54920 -1.34040 -0.70302 -0.56802 -0.49369 + 1 1 H 1S -0.00028 0.19664 0.32943 -0.20637 0.00000 + 2 2S 0.00042 0.00987 0.08843 -0.03877 0.00000 + 3 3PX 0.00000 0.00000 0.00000 0.00000 0.03138 + 4 3PY 0.00059 -0.03777 -0.02324 0.03180 0.00000 + 5 3PZ -0.00050 0.02069 0.03278 0.00778 0.00000 + 6 2 O 1S 0.99709 -0.20851 0.00000 -0.07051 0.00000 + 7 2S 0.01533 0.44166 0.00000 0.15096 0.00000 + 8 3S -0.00262 0.37055 0.00000 0.35244 0.00000 + 9 4PX 0.00000 0.00000 0.00000 0.00000 0.63093 + 10 4PY 0.00000 0.00000 0.49100 0.00000 0.00000 + 11 4PZ -0.00179 -0.08026 0.00000 0.54612 0.00000 + 12 5PX 0.00000 0.00000 0.00000 0.00000 0.49530 + 13 5PY 0.00000 0.00000 0.21981 0.00000 0.00000 + 14 5PZ 0.00046 0.01423 0.00000 0.36440 0.00000 + 15 6D 0 0.00001 0.00126 0.00000 -0.01798 0.00000 + 16 6D+1 0.00000 0.00000 0.00000 0.00000 -0.01831 + 17 6D-1 0.00000 0.00000 -0.02712 0.00000 0.00000 + 18 6D+2 -0.00015 -0.00309 0.00000 0.00460 0.00000 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S -0.00028 0.19664 -0.32943 -0.20637 0.00000 + 21 2S 0.00042 0.00987 -0.08843 -0.03877 0.00000 + 22 3PX 0.00000 0.00000 0.00000 0.00000 0.03138 + 23 3PY -0.00059 0.03777 -0.02324 -0.03180 0.00000 + 24 3PZ -0.00050 0.02069 -0.03278 0.00778 0.00000 + 6 7 8 9 10 + (A1)--V (B2)--V (B2)--V (A1)--V (A1)--V + Eigenvalues -- 0.18675 0.25729 0.79428 0.86143 1.16305 + 1 1 H 1S -0.05736 0.02438 0.94544 0.77982 0.56148 + 2 2S -0.83228 1.45858 -0.67483 -0.54297 0.11259 + 3 3PX 0.00000 0.00000 0.00000 0.00000 0.00000 + 4 3PY 0.01819 -0.02133 0.07599 0.30237 -0.08600 + 5 3PZ -0.01667 0.01785 -0.15491 -0.06066 0.24578 + 6 2 O 1S -0.08470 0.00000 0.00000 0.05179 0.04908 + 7 2S 0.07170 0.00000 0.00000 -0.25498 -0.11616 + 8 3S 1.00958 0.00000 0.00000 0.32136 -0.76806 + 9 4PX 0.00000 0.00000 0.00000 0.00000 0.00000 + 10 4PY 0.00000 -0.28107 -0.26539 0.00000 0.00000 + 11 4PZ -0.18794 0.00000 0.00000 0.33069 -0.75153 + 12 5PX 0.00000 0.00000 0.00000 0.00000 0.00000 + 13 5PY 0.00000 -0.67110 -0.47510 0.00000 0.00000 + 14 5PZ -0.33396 0.00000 0.00000 -0.01731 1.29116 + 15 6D 0 0.00754 0.00000 0.00000 0.00137 -0.01192 + 16 6D+1 0.00000 0.00000 0.00000 0.00000 0.00000 + 17 6D-1 0.00000 0.02180 -0.11235 0.00000 0.00000 + 18 6D+2 -0.01036 0.00000 0.00000 -0.10806 -0.00658 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S -0.05736 -0.02438 -0.94544 0.77982 0.56148 + 21 2S -0.83228 -1.45858 0.67483 -0.54297 0.11259 + 22 3PX 0.00000 0.00000 0.00000 0.00000 0.00000 + 23 3PY -0.01819 -0.02133 0.07599 -0.30237 0.08600 + 24 3PZ -0.01667 -0.01785 0.15491 -0.06066 0.24578 + 11 12 13 14 15 + (B1)--V (B2)--V (A1)--V (A2)--V (B1)--V + Eigenvalues -- 1.20039 1.25297 1.44294 1.47836 1.67576 + 1 1 H 1S 0.00000 -0.38329 0.33223 0.00000 0.00000 + 2 2S 0.00000 -0.83750 -0.21212 0.00000 0.00000 + 3 3PX 0.00072 0.00000 0.00000 0.68636 0.76853 + 4 3PY 0.00000 0.30080 -0.32477 0.00000 0.00000 + 5 3PZ 0.00000 -0.19091 -0.55042 0.00000 0.00000 + 6 2 O 1S 0.00000 0.00000 0.03828 0.00000 0.00000 + 7 2S 0.00000 0.00000 -0.52866 0.00000 0.00000 + 8 3S 0.00000 0.00000 0.51190 0.00000 0.00000 + 9 4PX -0.96763 0.00000 0.00000 0.00000 -0.03438 + 10 4PY 0.00000 -0.73129 0.00000 0.00000 0.00000 + 11 4PZ 0.00000 0.00000 -0.12361 0.00000 0.00000 + 12 5PX 1.03124 0.00000 0.00000 0.00000 -0.62892 + 13 5PY 0.00000 1.77186 0.00000 0.00000 0.00000 + 14 5PZ 0.00000 0.00000 0.73469 0.00000 0.00000 + 15 6D 0 0.00000 0.00000 0.11514 0.00000 0.00000 + 16 6D+1 0.00401 0.00000 0.00000 0.00000 -0.16015 + 17 6D-1 0.00000 -0.04687 0.00000 0.00000 0.00000 + 18 6D+2 0.00000 0.00000 0.00231 0.00000 0.00000 + 19 6D-2 0.00000 0.00000 0.00000 0.13020 0.00000 + 20 3 H 1S 0.00000 0.38329 0.33223 0.00000 0.00000 + 21 2S 0.00000 0.83750 -0.21212 0.00000 0.00000 + 22 3PX 0.00072 0.00000 0.00000 -0.68636 0.76853 + 23 3PY 0.00000 0.30080 0.32477 0.00000 0.00000 + 24 3PZ 0.00000 0.19091 -0.55042 0.00000 0.00000 + 16 17 18 19 20 + (A1)--V (B2)--V (B2)--V (A1)--V (B1)--V + Eigenvalues -- 1.86568 1.94324 2.46971 2.50865 3.29235 + 1 1 H 1S -0.84001 -0.38827 -0.30714 -0.48425 0.00000 + 2 2S -0.39058 -0.09139 -0.32899 -0.15539 0.00000 + 3 3PX 0.00000 0.00000 0.00000 0.00000 0.40419 + 4 3PY 0.37339 -0.47886 0.72852 0.74408 0.00000 + 5 3PZ 0.02270 -0.69333 -0.55830 -0.53873 0.00000 + 6 2 O 1S -0.00133 0.00000 0.00000 -0.05007 0.00000 + 7 2S -1.59472 0.00000 0.00000 0.76301 0.00000 + 8 3S 3.05475 0.00000 0.00000 0.77692 0.00000 + 9 4PX 0.00000 0.00000 0.00000 0.00000 0.00794 + 10 4PY 0.00000 -0.00344 0.84802 0.00000 0.00000 + 11 4PZ -0.12317 0.00000 0.00000 -0.67503 0.00000 + 12 5PX 0.00000 0.00000 0.00000 0.00000 -0.31702 + 13 5PY 0.00000 0.90137 0.15151 0.00000 0.00000 + 14 5PZ -0.96855 0.00000 0.00000 -0.17344 0.00000 + 15 6D 0 -0.11340 0.00000 0.00000 -0.05378 0.00000 + 16 6D+1 0.00000 0.00000 0.00000 0.00000 1.04510 + 17 6D-1 0.00000 0.03018 0.14264 0.00000 0.00000 + 18 6D+2 0.10791 0.00000 0.00000 0.22259 0.00000 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S -0.84001 0.38827 0.30714 -0.48425 0.00000 + 21 2S -0.39058 0.09139 0.32899 -0.15539 0.00000 + 22 3PX 0.00000 0.00000 0.00000 0.00000 0.40419 + 23 3PY -0.37339 -0.47886 0.72852 -0.74408 0.00000 + 24 3PZ 0.02270 0.69333 0.55830 -0.53873 0.00000 + 21 22 23 24 + (A2)--V (A1)--V (A1)--V (B2)--V + Eigenvalues -- 3.34575 3.52032 3.87326 4.15604 + 1 1 H 1S 0.00000 -0.31669 -1.26352 1.11159 + 2 2S 0.00000 -0.03908 -0.19214 0.29097 + 3 3PX -0.37623 0.00000 0.00000 0.00000 + 4 3PY 0.00000 0.35703 0.62282 -0.61226 + 5 3PZ 0.00000 0.31793 -0.49973 0.49729 + 6 2 O 1S 0.00000 -0.01447 -0.06182 0.00000 + 7 2S 0.00000 -0.15549 -0.15289 0.00000 + 8 3S 0.00000 0.57546 2.29321 0.00000 + 9 4PX 0.00000 0.00000 0.00000 0.00000 + 10 4PY 0.00000 0.00000 0.00000 -0.48554 + 11 4PZ 0.00000 -0.02517 -0.41868 0.00000 + 12 5PX 0.00000 0.00000 0.00000 0.00000 + 13 5PY 0.00000 0.00000 0.00000 -1.15446 + 14 5PZ 0.00000 -0.54861 -0.92743 0.00000 + 15 6D 0 0.00000 1.08916 0.13090 0.00000 + 16 6D+1 0.00000 0.00000 0.00000 0.00000 + 17 6D-1 0.00000 0.00000 0.00000 1.32912 + 18 6D+2 0.00000 0.17380 -1.16185 0.00000 + 19 6D-2 1.06901 0.00000 0.00000 0.00000 + 20 3 H 1S 0.00000 -0.31669 -1.26352 -1.11159 + 21 2S 0.00000 -0.03908 -0.19214 -0.29097 + 22 3PX 0.37623 0.00000 0.00000 0.00000 + 23 3PY 0.00000 -0.35703 -0.62282 -0.61226 + 24 3PZ 0.00000 0.31793 -0.49973 -0.49729 + Density Matrix: + 1 2 3 4 5 + 1 1 H 1S 0.37956 + 2 2S 0.07815 0.01884 + 3 3PX 0.00000 0.00000 0.00197 + 4 3PY -0.04329 -0.00732 0.00000 0.00596 + 5 3PZ 0.02653 0.00560 0.00000 -0.00259 0.00313 + 6 2 O 1S -0.05346 0.00219 0.00000 0.01245 -0.01072 + 7 2S 0.11138 -0.00297 0.00000 -0.02375 0.02061 + 8 3S 0.00027 -0.02001 0.00000 -0.00558 0.02082 + 9 4PX 0.00000 0.00000 0.03959 0.00000 0.00000 + 10 4PY 0.32350 0.08684 0.00000 -0.02282 0.03219 + 11 4PZ -0.25697 -0.04393 0.00000 0.04080 0.00517 + 12 5PX 0.00000 0.00000 0.03108 0.00000 0.00000 + 13 5PY 0.14483 0.03888 0.00000 -0.01022 0.01441 + 14 5PZ -0.14480 -0.02797 0.00000 0.02210 0.00626 + 15 6D 0 0.00792 0.00142 0.00000 -0.00124 -0.00023 + 16 6D+1 0.00000 0.00000 -0.00115 0.00000 0.00000 + 17 6D-1 -0.01787 -0.00480 0.00000 0.00126 -0.00178 + 18 6D+2 -0.00311 -0.00042 0.00000 0.00053 -0.00006 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S -0.05454 -0.03838 0.00000 -0.01267 -0.01667 + 21 2S -0.03838 -0.01244 0.00000 0.00090 -0.00599 + 22 3PX 0.00000 0.00000 0.00197 0.00000 0.00000 + 23 3PY 0.01267 -0.00090 0.00000 -0.00380 -0.00045 + 24 3PZ -0.01667 -0.00599 0.00000 0.00045 -0.00117 + 6 7 8 9 10 + 6 2 O 1S 2.08528 + 7 2S -0.17489 0.43618 + 8 3S -0.20945 0.43364 0.52305 + 9 4PX 0.00000 0.00000 0.00000 0.79614 + 10 4PY 0.00000 0.00000 0.00000 0.00000 0.48215 + 11 4PZ -0.04710 0.09393 0.32547 0.00000 0.00000 + 12 5PX 0.00000 0.00000 0.00000 0.62500 0.00000 + 13 5PY 0.00000 0.00000 0.00000 0.00000 0.21586 + 14 5PZ -0.05640 0.12261 0.26740 0.00000 0.00000 + 15 6D 0 0.00204 -0.00431 -0.01174 0.00000 0.00000 + 16 6D+1 0.00000 0.00000 0.00000 -0.02311 0.00000 + 17 6D-1 0.00000 0.00000 0.00000 0.00000 -0.02663 + 18 6D+2 0.00033 -0.00134 0.00096 0.00000 0.00000 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S -0.05346 0.11138 0.00027 0.00000 -0.32350 + 21 2S 0.00219 -0.00297 -0.02001 0.00000 -0.08684 + 22 3PX 0.00000 0.00000 0.00000 0.03959 0.00000 + 23 3PY -0.01245 0.02375 0.00558 0.00000 -0.02282 + 24 3PZ -0.01072 0.02061 0.02082 0.00000 -0.03219 + 11 12 13 14 15 + 11 4PZ 0.60938 + 12 5PX 0.00000 0.49064 + 13 5PY 0.00000 0.00000 0.09664 + 14 5PZ 0.39573 0.00000 0.00000 0.26598 + 15 6D 0 -0.01984 0.00000 0.00000 -0.01306 0.00065 + 16 6D+1 0.00000 -0.01814 0.00000 0.00000 0.00000 + 17 6D-1 0.00000 0.00000 -0.01192 0.00000 0.00000 + 18 6D+2 0.00552 0.00000 0.00000 0.00327 -0.00017 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S -0.25697 0.00000 -0.14483 -0.14480 0.00792 + 21 2S -0.04393 0.00000 -0.03888 -0.02797 0.00142 + 22 3PX 0.00000 0.03108 0.00000 0.00000 0.00000 + 23 3PY -0.04080 0.00000 -0.01022 -0.02210 0.00124 + 24 3PZ 0.00517 0.00000 -0.01441 0.00626 -0.00023 + 16 17 18 19 20 + 16 6D+1 0.00067 + 17 6D-1 0.00000 0.00147 + 18 6D+2 0.00000 0.00000 0.00006 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S 0.00000 0.01787 -0.00311 0.00000 0.37956 + 21 2S 0.00000 0.00480 -0.00042 0.00000 0.07815 + 22 3PX -0.00115 0.00000 0.00000 0.00000 0.00000 + 23 3PY 0.00000 0.00126 -0.00053 0.00000 0.04329 + 24 3PZ 0.00000 0.00178 -0.00006 0.00000 0.02653 + 21 22 23 24 + 21 2S 0.01884 + 22 3PX 0.00000 0.00197 + 23 3PY 0.00732 0.00000 0.00596 + 24 3PZ 0.00560 0.00000 0.00259 0.00313 + Full Mulliken population analysis: + 1 2 3 4 5 + 1 1 H 1S 0.37956 + 2 2S 0.05352 0.01884 + 3 3PX 0.00000 0.00000 0.00197 + 4 3PY 0.00000 0.00000 0.00000 0.00596 + 5 3PZ 0.00000 0.00000 0.00000 0.00000 0.00313 + 6 2 O 1S -0.00272 0.00014 0.00000 -0.00106 -0.00071 + 7 2S 0.03388 -0.00106 0.00000 0.00859 0.00577 + 8 3S 0.00013 -0.01302 0.00000 0.00173 0.00501 + 9 4PX 0.00000 0.00000 0.00793 0.00000 0.00000 + 10 4PY 0.07296 0.00727 0.00000 0.00370 0.00904 + 11 4PZ 0.04491 0.00285 0.00000 0.01146 -0.00009 + 12 5PX 0.00000 0.00000 0.01229 0.00000 0.00000 + 13 5PY 0.07135 0.01200 0.00000 -0.00079 0.00355 + 14 5PZ 0.05528 0.00669 0.00000 0.00545 0.00128 + 15 6D 0 0.00012 0.00000 0.00000 0.00022 0.00005 + 16 6D+1 0.00000 0.00000 0.00023 0.00000 0.00000 + 17 6D-1 0.00348 0.00010 0.00000 0.00020 0.00004 + 18 6D+2 0.00039 0.00001 0.00000 -0.00001 0.00001 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S -0.00681 -0.01195 0.00000 0.00209 0.00000 + 21 2S -0.01195 -0.00761 0.00000 -0.00016 0.00000 + 22 3PX 0.00000 0.00000 0.00011 0.00000 0.00000 + 23 3PY 0.00209 -0.00016 0.00000 0.00099 0.00000 + 24 3PZ 0.00000 0.00000 0.00000 0.00000 -0.00006 + 6 7 8 9 10 + 6 2 O 1S 2.08528 + 7 2S -0.03938 0.43618 + 8 3S -0.03850 0.34354 0.52305 + 9 4PX 0.00000 0.00000 0.00000 0.79614 + 10 4PY 0.00000 0.00000 0.00000 0.00000 0.48215 + 11 4PZ 0.00000 0.00000 0.00000 0.00000 0.00000 + 12 5PX 0.00000 0.00000 0.00000 0.31329 0.00000 + 13 5PY 0.00000 0.00000 0.00000 0.00000 0.10820 + 14 5PZ 0.00000 0.00000 0.00000 0.00000 0.00000 + 15 6D 0 0.00000 0.00000 0.00000 0.00000 0.00000 + 16 6D+1 0.00000 0.00000 0.00000 0.00000 0.00000 + 17 6D-1 0.00000 0.00000 0.00000 0.00000 0.00000 + 18 6D+2 0.00000 0.00000 0.00000 0.00000 0.00000 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S -0.00272 0.03388 0.00013 0.00000 0.07296 + 21 2S 0.00014 -0.00106 -0.01302 0.00000 0.00727 + 22 3PX 0.00000 0.00000 0.00000 0.00793 0.00000 + 23 3PY -0.00106 0.00859 0.00173 0.00000 0.00370 + 24 3PZ -0.00071 0.00577 0.00501 0.00000 0.00904 + 11 12 13 14 15 + 11 4PZ 0.60938 + 12 5PX 0.00000 0.49064 + 13 5PY 0.00000 0.00000 0.09664 + 14 5PZ 0.19837 0.00000 0.00000 0.26598 + 15 6D 0 0.00000 0.00000 0.00000 0.00000 0.00065 + 16 6D+1 0.00000 0.00000 0.00000 0.00000 0.00000 + 17 6D-1 0.00000 0.00000 0.00000 0.00000 0.00000 + 18 6D+2 0.00000 0.00000 0.00000 0.00000 0.00000 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S 0.04491 0.00000 0.07135 0.05528 0.00012 + 21 2S 0.00285 0.00000 0.01200 0.00669 0.00000 + 22 3PX 0.00000 0.01229 0.00000 0.00000 0.00000 + 23 3PY 0.01146 0.00000 -0.00079 0.00545 0.00022 + 24 3PZ -0.00009 0.00000 0.00355 0.00128 0.00005 + 16 17 18 19 20 + 16 6D+1 0.00067 + 17 6D-1 0.00000 0.00147 + 18 6D+2 0.00000 0.00000 0.00006 + 19 6D-2 0.00000 0.00000 0.00000 0.00000 + 20 3 H 1S 0.00000 0.00348 0.00039 0.00000 0.37956 + 21 2S 0.00000 0.00010 0.00001 0.00000 0.05352 + 22 3PX 0.00023 0.00000 0.00000 0.00000 0.00000 + 23 3PY 0.00000 0.00020 -0.00001 0.00000 0.00000 + 24 3PZ 0.00000 0.00004 0.00001 0.00000 0.00000 + 21 22 23 24 + 21 2S 0.01884 + 22 3PX 0.00000 0.00197 + 23 3PY 0.00000 0.00000 0.00596 + 24 3PZ 0.00000 0.00000 0.00000 0.00313 + Gross orbital populations: + 1 + 1 1 H 1S 0.69619 + 2 2S 0.06760 + 3 3PX 0.02253 + 4 3PY 0.03835 + 5 3PZ 0.02702 + 6 2 O 1S 1.99870 + 7 2S 0.83469 + 8 3S 0.81580 + 9 4PX 1.12530 + 10 4PY 0.77630 + 11 4PZ 0.92601 + 12 5PX 0.82852 + 13 5PY 0.37705 + 14 5PZ 0.60175 + 15 6D 0 0.00141 + 16 6D+1 0.00113 + 17 6D-1 0.00912 + 18 6D+2 0.00085 + 19 6D-2 0.00000 + 20 3 H 1S 0.69619 + 21 2S 0.06760 + 22 3PX 0.02253 + 23 3PY 0.03835 + 24 3PZ 0.02702 + Condensed to atoms (all electrons): + 1 2 3 + 1 H 0.516491 0.368645 -0.033447 + 2 O 0.368645 7.559331 0.368645 + 3 H -0.033447 0.368645 0.516491 + Mulliken charges: + 1 + 1 H 0.148311 + 2 O -0.296621 + 3 H 0.148311 + Sum of Mulliken charges = 0.00000 + Mulliken charges with hydrogens summed into heavy atoms: + 1 + 2 O 0.000000 + Electronic spatial extent (au): = 18.6306 + Charge= 0.0000 electrons + Dipole moment (field-independent basis, Debye): + X= 0.0000 Y= 0.0000 Z= -2.0504 Tot= 2.0504 + Quadrupole moment (field-independent basis, Debye-Ang): + XX= -7.0170 YY= -4.1394 ZZ= -5.8813 + XY= 0.0000 XZ= 0.0000 YZ= 0.0000 + Traceless Quadrupole moment (field-independent basis, Debye-Ang): + XX= -1.3377 YY= 1.5398 ZZ= -0.2021 + XY= 0.0000 XZ= 0.0000 YZ= 0.0000 + Octapole moment (field-independent basis, Debye-Ang**2): + XXX= 0.0000 YYY= 0.0000 ZZZ= -1.2054 XYY= 0.0000 + XXY= 0.0000 XXZ= -0.3034 XZZ= 0.0000 YZZ= 0.0000 + YYZ= -1.2707 XYZ= 0.0000 + Hexadecapole moment (field-independent basis, Debye-Ang**3): + XXXX= -4.8304 YYYY= -5.4619 ZZZZ= -5.7829 XXXY= 0.0000 + XXXZ= 0.0000 YYYX= 0.0000 YYYZ= 0.0000 ZZZX= 0.0000 + ZZZY= 0.0000 XXYY= -2.0030 XXZZ= -1.8252 YYZZ= -1.5165 + XXYZ= 0.0000 YYXZ= 0.0000 ZZXY= 0.0000 + N-N= 9.263662538697D+00 E-N=-1.992894401430D+02 KE= 7.601675874489D+01 + Symmetry A1 KE= 6.796065821176D+01 + Symmetry A2 KE= 2.830900309443D-35 + Symmetry B1 KE= 4.555880950352D+00 + Symmetry B2 KE= 3.500219582782D+00 + Orbital energies and kinetic energies (alpha): + 1 2 + 1 (A1)--O -20.549199 29.200169 + 2 (A1)--O -1.340404 2.611477 + 3 (B2)--O -0.703024 1.750110 + 4 (A1)--O -0.568024 2.168683 + 5 (B1)--O -0.493693 2.277940 + 6 (A1)--V 0.186746 0.769854 + 7 (B2)--V 0.257291 0.751015 + 8 (B2)--V 0.794278 1.917220 + 9 (A1)--V 0.861426 2.258716 + 10 (A1)--V 1.163048 2.989486 + 11 (B1)--V 1.200386 3.667758 + 12 (B2)--V 1.252967 2.845942 + 13 (A1)--V 1.442943 2.225860 + 14 (A2)--V 1.478361 1.966785 + 15 (B1)--V 1.675760 2.128393 + 16 (A1)--V 1.865681 3.518334 + 17 (B2)--V 1.943242 2.337567 + 18 (B2)--V 2.469713 4.302650 + 19 (A1)--V 2.508646 4.514523 + 20 (B1)--V 3.292350 4.420288 + 21 (A2)--V 3.345753 4.501105 + 22 (A1)--V 3.520320 4.698046 + 23 (A1)--V 3.873260 5.467765 + 24 (B2)--V 4.156040 5.820990 + Total kinetic energy from orbitals= 7.601675874489D+01 + 1\1\GINC-LPQLX139\SP\RHF\CC-pVDZ\H2O1\SCEMAMA\04-Jan-2016\0\\# cc-pvdz + gfprint pop=full\\Water\\0,1\H,0,0.751,0.194,0.\O,0,0.,-0.388,0.\H,0, + -0.751,0.194,0.\\Version=ES64L-G09RevD.01\State=1-A1\HF=-76.0270219\RM + SD=3.738e-09\Dipole=0.,0.8066933,0.\Quadrupole=1.1448392,-0.1502634,-0 + .9945758,0.,0.,0.\PG=C02V [C2(O1),SGV(H2)]\\@ + + + A DANDELION FROM A LOVER MEANS MORE THAN AN ORCHID FROM A FRIEND. + Job cpu time: 0 days 0 hours 0 minutes 0.5 seconds. + File lengths (MBytes): RWF= 5 Int= 0 D2E= 0 Chk= 1 Scr= 1 + Normal termination of Gaussian 09 at Mon Jan 4 23:00:03 2016. diff --git a/test/input/h2o.xyz b/test/input/h2o.xyz new file mode 100644 index 00000000..e8cd039b --- /dev/null +++ b/test/input/h2o.xyz @@ -0,0 +1,6 @@ +3 +XYZ file: coordinates in Angstrom +H 0.7510000000 0.1940000000 0.0000000000 +O 0.0000000000 -0.3880000000 0.0000000000 +H -0.7510000000 0.1940000000 0.0000000000 + From cb896093da35d470417c306c2e71c7eaa379f205 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 5 Jan 2016 01:10:24 +0100 Subject: [PATCH 43/47] Test GCC version fixed --- install/scripts/install_ocaml.sh | 13 ++----------- test/bats/qp.bats | 11 +++++++++-- 2 files changed, 11 insertions(+), 13 deletions(-) diff --git a/install/scripts/install_ocaml.sh b/install/scripts/install_ocaml.sh index aeacbf6b..3f48b4b3 100755 --- a/install/scripts/install_ocaml.sh +++ b/install/scripts/install_ocaml.sh @@ -23,23 +23,14 @@ check_version() i=$(gcc -dumpversion) -if check_version i 4.6 +check_version i 4.6 +if [[ $? -ne 0 ]] then echo "GCC version $(gcc -dumpversion) too old. GCC >= 4.6 required." exit 1 fi -if [[ i -eq 4 ]] -then - i=$(gcc -dumpversion | cut -d '.' -f 2) - if [[ i -lt 6 ]] - then - echo "GCC version $(gcc -dumpversion) too old. GCC >= 4.6 required." - exit 1 - fi -fi - if [[ -d ${HOME}/.opam ]] then source ${HOME}/.opam/opam-init/init.sh > /dev/null 2> /dev/null || true diff --git a/test/bats/qp.bats b/test/bats/qp.bats index c14ee3f9..2cbc3f45 100644 --- a/test/bats/qp.bats +++ b/test/bats/qp.bats @@ -64,7 +64,7 @@ function run_HF() { } function run_FCI() { - thresh=1.e-6 + thresh=1.e-5 test_exe full_ci || skip ezfio set_file $1 ezfio set perturbation do_pt2_end True @@ -90,7 +90,7 @@ function run_FCI() { @test "FCI HBO STO-3G" { run "SCF HBO STO-3G" - run_FCI hbo.ezfio -98.9658958804949 -98.9662931973293 + run_FCI hbo.ezfio -98.965287146032395 -98.966244481929749 } @@ -178,3 +178,10 @@ function run_FCI() { } + + +# TODO N_int = 1,2,3,4,5 +# TODO mod(64) MOs +# TODO All G2 SCF energies +# TODO Long and short tests + From 1db2f21b5ebb221fd313db86a84a62ccd29e474e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 5 Jan 2016 01:43:41 +0100 Subject: [PATCH 44/47] Removed -mavx in config/gfortran --- config/gfortran.cfg | 4 ++-- test/bats/qp.bats | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index 97962d64..c0bc19f5 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -mavx -g -ffree-line-length-none -I . -static-libgcc +FC : gfortran -g -ffree-line-length-none -I . -static-libgcc LAPACK_LIB : -llapack -lblas IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 @@ -35,7 +35,7 @@ OPENMP : 1 ; Append OpenMP flags # -ffast-math and the Fortran-specific # -fno-protect-parens and -fstack-arrays. [OPT] -FCFLAGS : -Ofast -mcpu=native +FCFLAGS : -Ofast -march=native # Profiling flags ################# diff --git a/test/bats/qp.bats b/test/bats/qp.bats index 2cbc3f45..ebbb571f 100644 --- a/test/bats/qp.bats +++ b/test/bats/qp.bats @@ -64,7 +64,7 @@ function run_HF() { } function run_FCI() { - thresh=1.e-5 + thresh=1.e-4 test_exe full_ci || skip ezfio set_file $1 ezfio set perturbation do_pt2_end True @@ -90,7 +90,7 @@ function run_FCI() { @test "FCI HBO STO-3G" { run "SCF HBO STO-3G" - run_FCI hbo.ezfio -98.965287146032395 -98.966244481929749 + run_FCI hbo.ezfio -98.965709048681845 -98.965709048681504 } @@ -184,4 +184,6 @@ function run_FCI() { # TODO mod(64) MOs # TODO All G2 SCF energies # TODO Long and short tests +# TODO MP2 +# TODO CISD_selected From a446273744b23407f61bf413124aaf2eaefc960b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 5 Jan 2016 01:52:44 +0100 Subject: [PATCH 45/47] More robust HBO FCI test --- test/bats/qp.bats | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/test/bats/qp.bats b/test/bats/qp.bats index ebbb571f..dc58d196 100644 --- a/test/bats/qp.bats +++ b/test/bats/qp.bats @@ -64,18 +64,18 @@ function run_HF() { } function run_FCI() { - thresh=1.e-4 + thresh=1.e-5 test_exe full_ci || skip ezfio set_file $1 ezfio set perturbation do_pt2_end True - ezfio set determinants n_det_max 2000 + ezfio set determinants n_det_max $2 ezfio set determinants threshold_davidson 1.e-10 qp_run full_ci $1 energy="$(ezfio get full_ci energy)" - eq $energy $2 $thresh + eq $energy $3 $thresh energy_pt2="$(ezfio get full_ci energy_pt2)" - eq $energy_pt2 $3 $thresh + eq $energy_pt2 $4 $thresh } # ================== TESTS ======================= @@ -90,7 +90,7 @@ function run_FCI() { @test "FCI HBO STO-3G" { run "SCF HBO STO-3G" - run_FCI hbo.ezfio -98.965709048681845 -98.965709048681504 + run_FCI hbo.ezfio 5000 -98.9661184343292 -98.9662954089732 } @@ -108,7 +108,7 @@ function run_FCI() { @test "FCI H2O cc-pVDZ" { run "SCF H2O cc-pVDZ" - run_FCI h2o.ezfio -76.2340571014912 -76.2472677390010 + run_FCI h2o.ezfio 2000 -76.2340571014912 -76.2472677390010 } @test "CAS_SD H2O cc-pVDZ" { @@ -150,7 +150,7 @@ function run_FCI() { } @test "FCI H2O VDZ pseudo" { - run_FCI h2o_pseudo.ezfio -17.1593408979096 -17.1699581040506 + run_FCI h2o_pseudo.ezfio 2000 -17.1593408979096 -17.1699581040506 } From 780cc7ec3c9241138a9fa9085e2c43d15766f2c9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 5 Jan 2016 02:00:20 +0100 Subject: [PATCH 46/47] Removed annoying HBO test --- test/bats/qp.bats | 6 ------ 1 file changed, 6 deletions(-) diff --git a/test/bats/qp.bats b/test/bats/qp.bats index dc58d196..45924479 100644 --- a/test/bats/qp.bats +++ b/test/bats/qp.bats @@ -88,12 +88,6 @@ function run_FCI() { run_HF hbo.ezfio -98.8251985678084 } -@test "FCI HBO STO-3G" { - run "SCF HBO STO-3G" - run_FCI hbo.ezfio 5000 -98.9661184343292 -98.9662954089732 -} - - From 06cada2d92b4aecc09d58a64edcacf8fe86e9046 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 6 Jan 2016 20:53:40 +0100 Subject: [PATCH 47/47] Minor changes in tests --- ocaml/qp_print_basis.ml | 20 ++++++++++++++++++++ src/AO_Basis/aos.irp.f | 2 +- test/bats/qp.bats | 4 ---- 3 files changed, 21 insertions(+), 5 deletions(-) create mode 100644 ocaml/qp_print_basis.ml diff --git a/ocaml/qp_print_basis.ml b/ocaml/qp_print_basis.ml new file mode 100644 index 00000000..60abd8b9 --- /dev/null +++ b/ocaml/qp_print_basis.ml @@ -0,0 +1,20 @@ +open Core.Std +open Qptypes + +let () = + let ezfio_filename = + Sys.argv.(1) + in + if (not (Sys.file_exists_exn ezfio_filename)) then + failwith "Error reading EZFIO file"; + Ezfio.set_file ezfio_filename; + let basis = + match Input.Ao_basis.read () with + | Some basis -> basis + | _ -> failwith "Error reading basis set" + in + Input.Ao_basis.to_rst basis + |> Rst_string.to_string + |> print_endline + + diff --git a/src/AO_Basis/aos.irp.f b/src/AO_Basis/aos.irp.f index 71c93bc0..ea426c2f 100644 --- a/src/AO_Basis/aos.irp.f +++ b/src/AO_Basis/aos.irp.f @@ -19,7 +19,7 @@ END_PROVIDER ao_prim_num_max_align = align_double(ao_prim_num_max) END_PROVIDER -BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num,ao_prim_num_max) ] +BEGIN_PROVIDER [ double precision, ao_coef_normalized, (ao_num_align,ao_prim_num_max) ] implicit none BEGIN_DOC ! Coefficients including the AO normalization diff --git a/test/bats/qp.bats b/test/bats/qp.bats index 45924479..7745c188 100644 --- a/test/bats/qp.bats +++ b/test/bats/qp.bats @@ -5,7 +5,6 @@ # If the numbers are not equal, the exit code is 1 else it is 0 # So we strip the "-", is the abs value of the poor function eq() { -# awk -v d1=$1 -v d2=$2 -v n1=${1#-} -v n2=${2#-} -v p=$3 'BEGIN{ if ((n1-n2)^2 < p^2) exit 0; { print (d1-d2) " " d1 " " d2 ; exit 1} }' declare -a diff diff=($(awk -v d1=$1 -v d2=$2 -v n1=${1#-} -v n2=${2#-} -v p=$3 'BEGIN{ if ((n1-n2)^2 < p^2) print 0; print 1 " " (d1-d2) " " d1 " " d2 }')) if [[ "${diff[0]}" == "0" ]] @@ -101,13 +100,11 @@ function run_FCI() { } @test "FCI H2O cc-pVDZ" { - run "SCF H2O cc-pVDZ" run_FCI h2o.ezfio 2000 -76.2340571014912 -76.2472677390010 } @test "CAS_SD H2O cc-pVDZ" { test_exe cas_sd_selected || skip - run "SCF H2O cc-pVDZ" INPUT=h2o.ezfio ezfio set_file $INPUT ezfio set perturbation do_pt2_end False @@ -120,7 +117,6 @@ function run_FCI() { @test "MRCC H2O cc-pVDZ" { test_exe mrcc_cassd || skip - run "CAS_SD H2O cc-pVDZ" INPUT=h2o.ezfio ezfio set_file $INPUT ezfio set determinants threshold_generators 1.