From b23b160c4e2cff83e87815dcbc3543922bbe75da Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 28 Jun 2023 14:32:55 -0500 Subject: [PATCH 01/64] ormas bitmask ezfio --- src/bitmask/EZFIO.cfg | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/bitmask/EZFIO.cfg b/src/bitmask/EZFIO.cfg index 9d713304..25812ca0 100644 --- a/src/bitmask/EZFIO.cfg +++ b/src/bitmask/EZFIO.cfg @@ -3,3 +3,27 @@ type: integer doc: Number of active |MOs| interface: ezfio +[ormas_n_space] +type: integer +doc: Number of active spaces +interface: ezfio, provider, ocaml +default: 1 + +[ormas_mstart] +type: integer +doc: starting orb for each ORMAS space +size: (bitmask.ormas_n_space) +interface: ezfio, provider, ocaml + +[ormas_min_e] +type: integer +doc: min number of electrons in each ORMAS space +size: (bitmask.ormas_n_space) +interface: ezfio, provider, ocaml + +[ormas_max_e] +type: integer +doc: max number of electrons in each ORMAS space +size: (bitmask.ormas_n_space) +interface: ezfio, provider, ocaml + From 56d5843210099a2c7ba84951737e276a3677ce1c Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 28 Jun 2023 18:23:10 -0500 Subject: [PATCH 02/64] ormas bitmasks --- src/bitmask/EZFIO.cfg | 15 +- src/bitmask/bitmasks_ormas.irp.f | 209 ++++++++++++++++++++++++++ src/cipsi/selection.irp.f | 5 + src/cipsi_tc_bi_ortho/selection.irp.f | 5 + 4 files changed, 231 insertions(+), 3 deletions(-) create mode 100644 src/bitmask/bitmasks_ormas.irp.f diff --git a/src/bitmask/EZFIO.cfg b/src/bitmask/EZFIO.cfg index 25812ca0..13007509 100644 --- a/src/bitmask/EZFIO.cfg +++ b/src/bitmask/EZFIO.cfg @@ -3,6 +3,12 @@ type: integer doc: Number of active |MOs| interface: ezfio +[do_ormas] +type: logical +doc: if |true| restrict selection based on ORMAS rules +interface: ezfio, provider, ocaml +default: false + [ormas_n_space] type: integer doc: Number of active spaces @@ -13,17 +19,20 @@ default: 1 type: integer doc: starting orb for each ORMAS space size: (bitmask.ormas_n_space) -interface: ezfio, provider, ocaml +interface: ezfio +#default: (1) [ormas_min_e] type: integer doc: min number of electrons in each ORMAS space size: (bitmask.ormas_n_space) -interface: ezfio, provider, ocaml +interface: ezfio +#default: (0) [ormas_max_e] type: integer doc: max number of electrons in each ORMAS space size: (bitmask.ormas_n_space) -interface: ezfio, provider, ocaml +interface: ezfio +#default: (electrons.elec_num) diff --git a/src/bitmask/bitmasks_ormas.irp.f b/src/bitmask/bitmasks_ormas.irp.f new file mode 100644 index 00000000..0308e226 --- /dev/null +++ b/src/bitmask/bitmasks_ormas.irp.f @@ -0,0 +1,209 @@ +use bitmasks + +BEGIN_PROVIDER [integer, ormas_mstart, (ormas_n_space) ] + implicit none + call + implicit none + BEGIN_DOC +! first orbital idx in each active space + END_DOC + + logical :: has + PROVIDE ezfio_filename + if (mpi_master) then + + call ezfio_has_bitmask_ormas_mstart(has) + if (has) then +! write(6,'(A)') '.. >>>>> [ IO READ: ormas_mstart ] <<<<< ..' + call ezfio_get_bitmask_ormas_mstart(ormas_mstart) + ASSERT (ormas_mstart(1).eq.1) + else if (ormas_n_space.eq.1) then + ormas_mstart = 1 + else + print *, 'bitmask/ormas_mstart not found in EZFIO file' + stop 1 + endif + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST( ormas_mstart, ormas_n_space, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read ormas_mstart with MPI' + endif + IRP_ENDIF + +! call write_time(6) + + +END_PROVIDER + +BEGIN_PROVIDER [integer, ormas_min_e, (ormas_n_space) ] + implicit none + call + implicit none + BEGIN_DOC +! min nelec in each active space + END_DOC + + logical :: has + PROVIDE ezfio_filename + if (mpi_master) then + + call ezfio_has_bitmask_ormas_min_e(has) + if (has) then +! write(6,'(A)') '.. >>>>> [ IO READ: ormas_min_e ] <<<<< ..' + call ezfio_get_bitmask_ormas_min_e(ormas_min_e) + else if (ormas_n_space.eq.1) then + ormas_min_e = 0 + else + print *, 'bitmask/ormas_min_e not found in EZFIO file' + stop 1 + endif + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST( ormas_min_e, ormas_n_space, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read ormas_min_e with MPI' + endif + IRP_ENDIF + +! call write_time(6) + +END_PROVIDER + +BEGIN_PROVIDER [integer, ormas_max_e, (ormas_n_space) ] + implicit none + call + implicit none + BEGIN_DOC +! max nelec in each active space + END_DOC + + logical :: has + PROVIDE ezfio_filename + if (mpi_master) then + + call ezfio_has_bitmask_ormas_max_e(has) + if (has) then +! write(6,'(A)') '.. >>>>> [ IO READ: ormas_max_e ] <<<<< ..' + call ezfio_get_bitmask_ormas_max_e(ormas_max_e) + else if (ormas_n_space.eq.1) then + ormas_max_e = elec_num + else + print *, 'bitmask/ormas_max_e not found in EZFIO file' + stop 1 + endif + endif + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + IRP_IF MPI + include 'mpif.h' + integer :: ierr + call MPI_BCAST( ormas_max_e, ormas_n_space, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read ormas_max_e with MPI' + endif + IRP_ENDIF + +! call write_time(6) + +END_PROVIDER + + BEGIN_PROVIDER [ integer, ormas_n_orb, (ormas_n_space) ] +&BEGIN_PROVIDER [ integer, ormas_max_n_orb ] + implicit none + BEGIN_DOC + ! number of orbitals in each ormas space + END_DOC + ormas_n_orb = 0 + ormas_n_orb(ormas_n_space) = mo_num + 1 - ormas_mstart(ormas_n_space) + do i = ormas_n_space-1, 1, -1 + ormas_n_orb(i) = ormas_mstart(i+1) - ormas_mstart(i) + ASSERT (ormas_n_orb(i).ge.1) + enddo + ormas_max_n_orb = max(ormas_n_orb) +END_PROVIDER + +BEGIN_PROVIDER [ integer, ormas_list_orb, (ormas_max_n_orb, ormas_n_space) ] + implicit none + BEGIN_DOC + ! list of orbitals in each ormas space + END_DOC + ormas_list_orb = 0 + i = 1 + do j = 1, ormas_n_space + do k = 1, ormas_n_orb(j) + ormas_list_orb(k,j) = i + i += 1 + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [ integer(bit_kind), ormas_bitmask, (N_int, ormas_n_space) ] + implicit none + BEGIN_DOC + ! bitmask for each ormas space + END_DOC + ormas_bitmask = 0_bit_kind + do j = 1, ormas_n_space + call list_to_bitstring(ormas_bitmask(1,j), ormas_list_orb(:,j), ormas_n_orb(j), N_int) + enddo +END_PROVIDER + +subroutine ormas_occ(key_in, occupancies) + implicit none + BEGIN_DOC + ! number of electrons in each ormas space + END_DOC + integer(bit_kind), intent(in) :: key_in(N_int,2) + integer, intent(out) :: occupancies(ormas_n_space) + integer :: i,ispin,ispace + + occupancies = 0 + ! TODO: get start/end of each space within N_int + do ispace=1,ormas_n_space + do ispin=1,2 + do i=1,N_int + occupancies(ispace) += popcnt(iand(ormas_bitmask(i,ispace),key_in(i,ispin))) + enddo + enddo + enddo +end + +logical function det_allowed_ormas(key_in) + implicit none + BEGIN_DOC + ! return true if det has allowable ormas occupations + END_DOC + integer(bit_kind), intent(in) :: key_in(N_int,2) + integer :: i,ispin,ispace,occ + + det_allowed_ormas = .True. + if (ormas_n_space.eq.1) return + det_allowed_ormas = .False. + ! TODO: get start/end of each space within N_int + do ispace=1,ormas_n_space + occ = 0 + do ispin=1,2 + do i=1,N_int + occ += popcnt(iand(ormas_bitmask(i,ispace),key_in(i,ispin))) + enddo + enddo + if ((occ.lt.ormas_min_e(ispace)).or.(occ.gt.ormas_max_e(ispace)) return + enddo + det_allowed_ormas = .True. +end + diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 6f40a809..3928c965 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -595,6 +595,11 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d if( val == 0d0) cycle call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + if (do_ormas) then + logical, external :: det_allowed_ormas + if (.not.det_allowed_ormas(det)) cycle + endif + if (do_only_cas) then integer, external :: number_of_holes, number_of_particles if (number_of_particles(det)>0) then diff --git a/src/cipsi_tc_bi_ortho/selection.irp.f b/src/cipsi_tc_bi_ortho/selection.irp.f index 4c271a4b..4a9c4231 100644 --- a/src/cipsi_tc_bi_ortho/selection.irp.f +++ b/src/cipsi_tc_bi_ortho/selection.irp.f @@ -785,6 +785,11 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + if (do_ormas) then + logical, external :: det_allowed_ormas + if (.not.det_allowed_ormas(det)) cycle + endif + if(do_only_cas) then if( number_of_particles(det) > 0 ) cycle if( number_of_holes(det) > 0 ) cycle From b593352c0faf2d18f77db5894497f5b4bc041084 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Wed, 28 Jun 2023 18:34:34 -0500 Subject: [PATCH 03/64] minor fix --- src/bitmask/bitmasks_ormas.irp.f | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/src/bitmask/bitmasks_ormas.irp.f b/src/bitmask/bitmasks_ormas.irp.f index 0308e226..336022e5 100644 --- a/src/bitmask/bitmasks_ormas.irp.f +++ b/src/bitmask/bitmasks_ormas.irp.f @@ -1,8 +1,6 @@ use bitmasks BEGIN_PROVIDER [integer, ormas_mstart, (ormas_n_space) ] - implicit none - call implicit none BEGIN_DOC ! first orbital idx in each active space @@ -43,8 +41,6 @@ BEGIN_PROVIDER [integer, ormas_mstart, (ormas_n_space) ] END_PROVIDER BEGIN_PROVIDER [integer, ormas_min_e, (ormas_n_space) ] - implicit none - call implicit none BEGIN_DOC ! min nelec in each active space @@ -83,8 +79,6 @@ BEGIN_PROVIDER [integer, ormas_min_e, (ormas_n_space) ] END_PROVIDER BEGIN_PROVIDER [integer, ormas_max_e, (ormas_n_space) ] - implicit none - call implicit none BEGIN_DOC ! max nelec in each active space @@ -128,13 +122,14 @@ END_PROVIDER BEGIN_DOC ! number of orbitals in each ormas space END_DOC + integer :: i ormas_n_orb = 0 ormas_n_orb(ormas_n_space) = mo_num + 1 - ormas_mstart(ormas_n_space) do i = ormas_n_space-1, 1, -1 ormas_n_orb(i) = ormas_mstart(i+1) - ormas_mstart(i) ASSERT (ormas_n_orb(i).ge.1) enddo - ormas_max_n_orb = max(ormas_n_orb) + ormas_max_n_orb = maxval(ormas_n_orb) END_PROVIDER BEGIN_PROVIDER [ integer, ormas_list_orb, (ormas_max_n_orb, ormas_n_space) ] @@ -142,6 +137,7 @@ BEGIN_PROVIDER [ integer, ormas_list_orb, (ormas_max_n_orb, ormas_n_space) ] BEGIN_DOC ! list of orbitals in each ormas space END_DOC + integer :: i,j,k ormas_list_orb = 0 i = 1 do j = 1, ormas_n_space @@ -157,6 +153,7 @@ BEGIN_PROVIDER [ integer(bit_kind), ormas_bitmask, (N_int, ormas_n_space) ] BEGIN_DOC ! bitmask for each ormas space END_DOC + integer :: j ormas_bitmask = 0_bit_kind do j = 1, ormas_n_space call list_to_bitstring(ormas_bitmask(1,j), ormas_list_orb(:,j), ormas_n_orb(j), N_int) @@ -202,7 +199,7 @@ logical function det_allowed_ormas(key_in) occ += popcnt(iand(ormas_bitmask(i,ispace),key_in(i,ispin))) enddo enddo - if ((occ.lt.ormas_min_e(ispace)).or.(occ.gt.ormas_max_e(ispace)) return + if ((occ.lt.ormas_min_e(ispace)).or.(occ.gt.ormas_max_e(ispace))) return enddo det_allowed_ormas = .True. end From 5296ce031d6707b9d4587ac8abb38a2ccd36d4c3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 8 Feb 2024 08:51:00 +0100 Subject: [PATCH 04/64] Update README.md --- README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/README.md b/README.md index 5a35f63d..7a9503d7 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,9 @@ executables for Quantum Package. Please use ifort as long as you can, and consider switching to gfortran in the long term. +--- + + # Quantum Package 2.2 From 992732813881397b9e854381f803f0056b6616ba Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 28 Feb 2024 18:15:25 +0100 Subject: [PATCH 05/64] Changed dummy into ghost --- ocaml/Angmom.ml | 3 +-- ocaml/Basis.ml | 2 +- ocaml/Element.ml | 38 ++++++++++++++++++------------------ ocaml/qp_create_ezfio.ml | 42 ++++++++++++++++++++-------------------- 4 files changed, 42 insertions(+), 43 deletions(-) diff --git a/ocaml/Angmom.ml b/ocaml/Angmom.ml index ed13e8dc..2da09340 100644 --- a/ocaml/Angmom.ml +++ b/ocaml/Angmom.ml @@ -26,8 +26,7 @@ let of_string = function | "J" | "j" -> J | "K" | "k" -> K | "L" | "l" -> L - | x -> raise (Failure ("Angmom should be S|P|D|F|G|H|I|J|K|L, -not "^x^".")) + | x -> raise (Failure ("Angmom should be S|P|D|F|G|H|I|J|K|L, not "^x^".")) let of_char = function | 'S' | 's' -> S diff --git a/ocaml/Basis.ml b/ocaml/Basis.ml index 9b0c6a38..f951a5f3 100644 --- a/ocaml/Basis.ml +++ b/ocaml/Basis.ml @@ -17,7 +17,7 @@ let read in_channel at_number = (** Find an element in the basis set file *) let find in_channel element = seek_in in_channel 0; - let element_read = ref Element.X in + let element_read = ref Element.Og in while !element_read <> element do let buffer = input_line in_channel in diff --git a/ocaml/Element.ml b/ocaml/Element.ml index f0d4455d..a794b2bb 100644 --- a/ocaml/Element.ml +++ b/ocaml/Element.ml @@ -4,7 +4,7 @@ open Qptypes exception ElementError of string type t = X - + |H |He |Li|Be |B |C |N |O |F |Ne |Na|Mg |Al|Si|P |S |Cl|Ar @@ -20,7 +20,7 @@ type t = X let of_string x = match (String.capitalize_ascii (String.lowercase_ascii x)) with -| "X" | "Dummy" -> X +| "X" | "Ghost" -> X | "H" | "Hydrogen" -> H | "He" | "Helium" -> He | "Li" | "Lithium" -> Li @@ -265,7 +265,7 @@ let to_string = function let to_long_string = function -| X -> "Dummy" +| X -> "Ghost" | H -> "Hydrogen" | He -> "Helium" | Li -> "Lithium" @@ -492,20 +492,20 @@ let to_charge c = | No -> 102 | Lr -> 103 | Rf -> 104 - | Db -> 105 - | Sg -> 106 - | Bh -> 107 - | Hs -> 108 - | Mt -> 109 - | Ds -> 110 - | Rg -> 111 - | Cn -> 112 - | Nh -> 113 - | Fl -> 114 - | Mc -> 115 - | Lv -> 116 - | Ts -> 117 - | Og -> 118 + | Db -> 105 + | Sg -> 106 + | Bh -> 107 + | Hs -> 108 + | Mt -> 109 + | Ds -> 110 + | Rg -> 111 + | Cn -> 112 + | Nh -> 113 + | Fl -> 114 + | Mc -> 115 + | Lv -> 116 + | Ts -> 117 + | Og -> 118 in Charge.of_int result @@ -565,7 +565,7 @@ let of_charge c = match (Charge.to_int c) with | 52 -> Te | 53 -> I | 54 -> Xe -| 55 -> Cs +| 55 -> Cs | 56 -> Ba | 57 -> La | 58 -> Ce @@ -880,7 +880,7 @@ let vdw_radius x = | Ts -> None | Og -> None in - match result x with + match result x with | Some y -> Some (Positive_float.of_float @@ Units.angstrom_to_bohr *. y ) | None -> None diff --git a/ocaml/qp_create_ezfio.ml b/ocaml/qp_create_ezfio.ml index 8e452762..4e17c0ad 100644 --- a/ocaml/qp_create_ezfio.ml +++ b/ocaml/qp_create_ezfio.ml @@ -6,8 +6,8 @@ type element = | Element of Element.t | Int_elem of (Nucl_number.t * Element.t) -(** Handle dummy atoms placed on bonds *) -let dummy_centers ~threshold ~molecule ~nuclei = +(** Handle ghost atoms placed on bonds *) +let ghost_centers ~threshold ~molecule ~nuclei = let d = Molecule.distance_matrix molecule in @@ -68,11 +68,11 @@ let run ?o b au c d m p cart xyz_file = (Molecule.of_file xyz_file ~charge:(Charge.of_int c) ~multiplicity:(Multiplicity.of_int m) ) in - let dummy = - dummy_centers ~threshold:d ~molecule ~nuclei:molecule.Molecule.nuclei + let ghost = + ghost_centers ~threshold:d ~molecule ~nuclei:molecule.Molecule.nuclei in let nuclei = - molecule.Molecule.nuclei @ dummy + molecule.Molecule.nuclei @ ghost in @@ -145,8 +145,6 @@ let run ?o b au c d m p cart xyz_file = | i :: k :: [] -> (Nucl_number.of_int @@ int_of_string i, Element.of_string k) | _ -> failwith "Expected format is int,Element:basis" in Int_elem result - and basis = - String.lowercase_ascii basis in let key = match elem with @@ -313,7 +311,7 @@ let run ?o b au c d m p cart xyz_file = } in let nuclei = - molecule.Molecule.nuclei @ dummy + molecule.Molecule.nuclei @ ghost in @@ -491,11 +489,7 @@ let run ?o b au c d m p cart xyz_file = |> List.rev |> list_map (fun (x,i) -> try - let e = - match x.Atom.element with - | Element.X -> Element.H - | e -> e - in + let e = x.Atom.element in let key = Int_elem (i,x.Atom.element) in @@ -507,9 +501,15 @@ let run ?o b au c d m p cart xyz_file = in try Basis.read_element (basis_channel key) i e - with Not_found -> - failwith (Printf.sprintf "Basis not found for atom %d (%s)" (Nucl_number.to_int i) - (Element.to_string x.Atom.element) ) + with _ -> + try + if e = Element.X then + Basis.read_element (basis_channel key) i (Element.H) + else + raise Not_found + with Not_found -> + failwith (Printf.sprintf "Basis not found for atom %d (%s)" (Nucl_number.to_int i) + (Element.to_string x.Atom.element) ) with | End_of_file -> failwith ("Element "^(Element.to_string x.Atom.element)^" not found in basis set.") @@ -710,9 +710,9 @@ If a file with the same name as the basis set exists, this file will be read. O arg=With_arg ""; doc="Total charge of the molecule. Default is 0. For negative values, use m instead of -, for ex m1"} ; - { opt=Optional ; short='d'; long="dummy"; + { opt=Optional ; short='g'; long="ghost"; arg=With_arg ""; - doc="Add dummy atoms. x * (covalent radii of the atoms)."} ; + doc="Add ghost atoms. x * (covalent radii of the atoms)."} ; { opt=Optional ; short='m'; long="multiplicity"; arg=With_arg ""; @@ -756,8 +756,8 @@ If a file with the same name as the basis set exists, this file will be read. O int_of_string x ) in - let dummy = - match Command_line.get "dummy" with + let ghost = + match Command_line.get "ghost" with | None -> 0. | Some x -> float_of_string x in @@ -782,7 +782,7 @@ If a file with the same name as the basis set exists, this file will be read. O | x::_ -> x in - run ?o:output basis au charge dummy multiplicity pseudo cart xyz_filename + run ?o:output basis au charge ghost multiplicity pseudo cart xyz_filename ) with (* | Failure txt -> Printf.eprintf "Fatal error: %s\n%!" txt *) From 36bae4971dc273b0aefc7d1efecd0d48b8421815 Mon Sep 17 00:00:00 2001 From: eginer Date: Thu, 29 Feb 2024 18:44:40 +0100 Subject: [PATCH 06/64] added some j for plotting --- plugins/local/tc_scf/jast_schmos_90.irp.f | 318 ++++++++++++++++++++++ plugins/local/tc_scf/plot_j_schMos.irp.f | 69 +++++ src/cipsi/selection.irp.f | 10 + 3 files changed, 397 insertions(+) create mode 100644 plugins/local/tc_scf/jast_schmos_90.irp.f create mode 100644 plugins/local/tc_scf/plot_j_schMos.irp.f diff --git a/plugins/local/tc_scf/jast_schmos_90.irp.f b/plugins/local/tc_scf/jast_schmos_90.irp.f new file mode 100644 index 00000000..5c5e625f --- /dev/null +++ b/plugins/local/tc_scf/jast_schmos_90.irp.f @@ -0,0 +1,318 @@ + BEGIN_PROVIDER [integer , m_max_sm_7] +&BEGIN_PROVIDER [integer , n_max_sm_7] +&BEGIN_PROVIDER [integer , o_max_sm_7] + implicit none + BEGIN_DOC +! maximum value of the "m", "n" and "o" integer in the Jastrow function as in Eq. (4) +! of Schmidt,Moskowitz, JCP, 93, 4172 (1990) for the SM_7 version of Table IV + END_DOC + m_max_sm_7 = 4 + n_max_sm_7 = 0 + o_max_sm_7 = 4 +END_PROVIDER + + BEGIN_PROVIDER [integer , m_max_sm_9] +&BEGIN_PROVIDER [integer , n_max_sm_9] +&BEGIN_PROVIDER [integer , o_max_sm_9] + implicit none + BEGIN_DOC +! maximum value of the "m", "n" and "o" integer in the Jastrow function as in Eq. (4) +! of Schmidt,Moskowitz, JCP, 93, 4172 (1990) for the SM_9 version of Table IV + END_DOC + m_max_sm_9 = 4 + n_max_sm_9 = 2 + o_max_sm_9 = 4 +END_PROVIDER + + + BEGIN_PROVIDER [integer , m_max_sm_17] +&BEGIN_PROVIDER [integer , n_max_sm_17] +&BEGIN_PROVIDER [integer , o_max_sm_17] + implicit none + BEGIN_DOC +! maximum value of the "m", "n" and "o" integer in the Jastrow function as in Eq. (4) +! of Schmidt,Moskowitz, JCP, 93, 4172 (1990) for the SM_17 version of Table IV + END_DOC + m_max_sm_17 = 6 + n_max_sm_17 = 2 + o_max_sm_17 = 6 +END_PROVIDER + + +BEGIN_PROVIDER [ double precision, c_mn_o_sm_7, (0:m_max_sm_7,0:n_max_sm_7,0:o_max_sm_7,2:10)] + implicit none + BEGIN_DOC + ! + !c_mn_o_7(0:4,0:4,2:10) = coefficient for the SM_7 correlation factor as given is Table IV of + ! Schmidt,Moskowitz, JCP, 93, 4172 (1990) + ! the first index (0:4) is the "m" integer for the 1e part + ! the second index(0:0) is the "n" integer for the 1e part WHICH IS ALWAYS SET TO 0 FOR SM_7 + ! the third index (0:4) is the "o" integer for the 2e part + ! the fourth index (2:10) is the nuclear charge of the atom + END_DOC + c_mn_o_sm_7 = 0.d0 + integer :: i + do i = 2, 10 ! loop over nuclear charge + c_mn_o_sm_7(0,0,1,i) = 0.5d0 ! all the linear terms are set to 1/2 to satisfy the anti-parallel spin condition + enddo + ! He atom + ! two electron terms + c_mn_o_sm_7(0,0,2,2) = 0.50516d0 + c_mn_o_sm_7(0,0,3,2) = -0.19313d0 + c_mn_o_sm_7(0,0,4,2) = 0.30276d0 + ! one-electron terms + c_mn_o_sm_7(2,0,0,2) = -0.16995d0 + c_mn_o_sm_7(3,0,0,2) = -0.34505d0 + c_mn_o_sm_7(4,0,0,2) = -0.54777d0 + ! Ne atom + ! two electron terms + c_mn_o_sm_7(0,0,2,10) = -0.792d0 + c_mn_o_sm_7(0,0,3,10) = 1.05232d0 + c_mn_o_sm_7(0,0,4,10) = -0.65615d0 + ! one-electron terms + c_mn_o_sm_7(2,0,0,10) = -0.13312d0 + c_mn_o_sm_7(3,0,0,10) = -0.00131d0 + c_mn_o_sm_7(4,0,0,10) = 0.09083d0 + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, c_mn_o_sm_9, (0:m_max_sm_9,0:n_max_sm_9,0:o_max_sm_9,2:10)] + implicit none + BEGIN_DOC + ! + !c_mn_o_9(0:4,0:4,2:10) = coefficient for the SM_9 correlation factor as given is Table IV of + ! Schmidt,Moskowitz, JCP, 93, 4172 (1990) + ! the first index (0:4) is the "m" integer for the 1e part + ! the second index(0:0) is the "n" integer for the 1e part WHICH IS ALWAYS SET TO 0 FOR SM_9 + ! the third index (0:4) is the "o" integer for the 2e part + ! the fourth index (2:10) is the nuclear charge of the atom + END_DOC + c_mn_o_sm_9 = 0.d0 + integer :: i + do i = 2, 10 ! loop over nuclear charge + c_mn_o_sm_9(0,0,1,i) = 0.5d0 ! all the linear terms are set to 1/2 to satisfy the anti-parallel spin condition + enddo + ! He atom + ! two electron terms + c_mn_o_sm_9(0,0,2,2) = 0.50516d0 + c_mn_o_sm_9(0,0,3,2) = -0.19313d0 + c_mn_o_sm_9(0,0,4,2) = 0.30276d0 + ! one-electron terms + c_mn_o_sm_9(2,0,0,2) = -0.16995d0 + c_mn_o_sm_9(3,0,0,2) = -0.34505d0 + c_mn_o_sm_9(4,0,0,2) = -0.54777d0 + ! Ne atom + ! two electron terms + c_mn_o_sm_9(0,0,2,10) = -0.792d0 + c_mn_o_sm_9(0,0,3,10) = 1.05232d0 + c_mn_o_sm_9(0,0,4,10) = -0.65615d0 + ! one-electron terms + c_mn_o_sm_9(2,0,0,10) = -0.13312d0 + c_mn_o_sm_9(3,0,0,10) = -0.00131d0 + c_mn_o_sm_9(4,0,0,10) = 0.09083d0 + +END_PROVIDER + +BEGIN_PROVIDER [ double precision, c_mn_o_sm_17, (0:m_max_sm_17,0:n_max_sm_17,0:o_max_sm_17,2:10)] + implicit none + BEGIN_DOC + ! + !c_mn_o_17(0:4,0:4,2:10) = coefficient for the SM_17 correlation factor as given is Table IV of + ! Schmidt,Moskowitz, JCP, 93, 4172 (1990) + ! the first index (0:4) is the "m" integer for the 1e part + ! the second index(0:0) is the "n" integer for the 1e part WHICH IS ALWAYS SET TO 0 FOR SM_17 + ! the third index (0:4) is the "o" integer for the 2e part + ! the fourth index (2:10) is the nuclear charge of the atom + END_DOC + c_mn_o_sm_17 = 0.d0 + integer :: i + do i = 2, 10 ! loop over nuclear charge + c_mn_o_sm_17(0,0,1,i) = 0.5d0 ! all the linear terms are set to 1/2 to satisfy the anti-parallel spin condition + enddo + ! He atom + ! two electron terms + c_mn_o_sm_17(0,0,2,2) = 0.09239d0 + c_mn_o_sm_17(0,0,3,2) = -0.38664d0 + c_mn_o_sm_17(0,0,4,2) = 0.95764d0 + ! one-electron terms + c_mn_o_sm_17(2,0,0,2) = 0.23208d0 + c_mn_o_sm_17(3,0,0,2) = -0.45032d0 + c_mn_o_sm_17(4,0,0,2) = 0.82777d0 + c_mn_o_sm_17(2,2,0,2) = -4.15388d0 + ! ee-n terms + c_mn_o_sm_17(2,0,2,2) = 0.80622d0 + c_mn_o_sm_17(2,2,2,2) = 10.19704d0 + c_mn_o_sm_17(4,0,2,2) = -4.96259d0 + c_mn_o_sm_17(2,0,4,2) = -1.35647d0 + c_mn_o_sm_17(4,2,2,2) = -5.90907d0 + c_mn_o_sm_17(6,0,2,2) = 0.90343d0 + c_mn_o_sm_17(4,0,4,2) = 5.50739d0 + c_mn_o_sm_17(2,2,4,2) = -0.03154d0 + c_mn_o_sm_17(2,0,6,2) = -1.1051860 + + + ! Ne atom + ! two electron terms + c_mn_o_sm_17(0,0,2,10) = -0.80909d0 + c_mn_o_sm_17(0,0,3,10) = -0.00219d0 + c_mn_o_sm_17(0,0,4,10) = 0.59188d0 + ! one-electron terms + c_mn_o_sm_17(2,0,0,10) = -0.00567d0 + c_mn_o_sm_17(3,0,0,10) = 0.14011d0 + c_mn_o_sm_17(4,0,0,10) = -0.05671d0 + c_mn_o_sm_17(2,2,0,10) = -3.33767d0 + ! ee-n terms + c_mn_o_sm_17(2,0,2,10) = 1.95067d0 + c_mn_o_sm_17(2,2,2,10) = 6.83340d0 + c_mn_o_sm_17(4,0,2,10) = -3.29231d0 + c_mn_o_sm_17(2,0,4,10) = -2.44998d0 + c_mn_o_sm_17(4,2,2,10) = -2.13029d0 + c_mn_o_sm_17(6,0,2,10) = 2.25768d0 + c_mn_o_sm_17(4,0,4,10) = 1.97951d0 + c_mn_o_sm_17(2,2,4,10) = -2.0924160 + c_mn_o_sm_17(2,0,6,10) = 0.35493d0 + +END_PROVIDER + + BEGIN_PROVIDER [ double precision, b_I_sm_90,(2:10)] +&BEGIN_PROVIDER [ double precision, d_I_sm_90,(2:10)] + implicit none + BEGIN_DOC +! "b_I" and "d_I" parameters of Eqs. (4) and (5) of Schmidt,Moskowitz, JCP, 93, 4172 (1990) + END_DOC + b_I_sm_90 = 1.d0 + d_I_sm_90 = 1.d0 + +END_PROVIDER + +subroutine get_full_sm_90_jastrow(r1,r2,rI,sm_j,i_charge, j_1e,j_2e,j_een,j_tot) + implicit none + double precision, intent(in) :: r1(3),r2(3),rI(3) + integer, intent(in) :: sm_j, i_charge + double precision, intent(out):: j_1e,j_2e,j_een,j_tot + BEGIN_DOC + ! Jastrow function as in Eq. (4) of Schmidt,Moskowitz, JCP, 93, 4172 (1990) + ! the i_charge variable is the integer specifying the charge of the atom for the Jastrow + ! the sm_j integer variable represents the "quality" of the jastrow : sm_j = 7, 9, 17 + END_DOC + double precision :: r_inucl,r_jnucl,r_ij,b_I, d_I + b_I = b_I_sm_90(i_charge) + d_I = d_I_sm_90(i_charge) + call get_rescaled_variables_j_sm_90(r1,r2,rI,b_I,d_I,r_inucl,r_jnucl,r_ij) + call jastrow_func_sm_90(r_inucl,r_jnucl,r_ij,sm_j,i_charge, j_1e,j_2e,j_een,j_tot) +end + +subroutine get_rescaled_variables_j_sm_90(r1,r2,rI,b_I,d_I,r_inucl,r_jnucl,r_ij) + implicit none + BEGIN_DOC + ! rescaled variables of Eq. (5) and (6) of Schmidt,Moskowitz, JCP, 93, 4172 (1990) + ! the "b_I" and "d_I" parameters are the same as in Eqs. (5) and (6) + END_DOC + double precision, intent(in) :: r1(3),r2(3),rI(3) + double precision, intent(in) :: b_I, d_I + double precision, intent(out):: r_inucl,r_jnucl,r_ij + double precision :: rin, rjn, rij + integer :: i + rin = 0.d0 + rjn = 0.d0 + rij = 0.d0 + do i = 1,3 + rin += (r1(i) - rI(i)) * (r1(i) - rI(i)) + rjn += (r2(i) - rI(i)) * (r2(i) - rI(i)) + rij += (r2(i) - r1(i)) * (r2(i) - r1(i)) + enddo + rin = dsqrt(rin) + rjn = dsqrt(rjn) + rij = dsqrt(rij) + r_inucl = b_I * rin/(1.d0 + b_I * rin) + r_jnucl = b_I * rjn/(1.d0 + b_I * rjn) + r_ij = d_I * rij/(1.d0 + b_I * rij) +end + +subroutine jastrow_func_sm_90(r_inucl,r_jnucl,r_ij,sm_j,i_charge, j_1e,j_2e,j_een,j_tot) + implicit none + BEGIN_DOC + ! Jastrow function as in Eq. (4) of Schmidt,Moskowitz, JCP, 93, 4172 (1990) + ! Here the r_inucl, r_jnucl are the rescaled variables as defined in Eq. (5) with "b_I" + ! r_ij is the rescaled variable as defined in Eq. (6) with "d_I" + ! the i_charge variable is the integer specifying the charge of the atom for the Jastrow + ! the sm_j integer variable represents the "quality" of the jastrow : sm_j = 7, 9, 17 + ! + ! it returns the j_1e : sum of terms with "o" = "n" = 0, "m" /= 0, + ! j_2e : sum of terms with "m" = "n" = 0, "o" /= 0, + ! j_een : sum of terms with "m" /=0, "n" /= 0, "o" /= 0, + ! j_tot : the total sum + END_DOC + double precision, intent(in) :: r_inucl,r_jnucl,r_ij + integer, intent(in) :: sm_j,i_charge + double precision, intent(out):: j_1e,j_2e,j_een,j_tot + j_1e = 0.D0 + j_2e = 0.D0 + j_een = 0.D0 + double precision :: delta_mn,jastrow_sm_90_atomic + integer :: m,n,o +BEGIN_TEMPLATE + ! pure 2e part + n = 0 + m = 0 + if(sm_j == $X )then + do o = 1, o_max_sm_$X + if(dabs(c_mn_o_sm_$X(m,n,o,i_charge)).lt.1.d-10)cycle + j_2e += c_mn_o_sm_$X(m,n,o,i_charge) * jastrow_sm_90_atomic(m,n,o,i_charge,r_inucl,r_jnucl,r_ij) + enddo +! else +! print*,'sm_j = ',sm_j +! print*,'not implemented, stop' +! stop + endif + ! pure one-e part + o = 0 + if(sm_j == $X)then + do n = 2, n_max_sm_$X + do m = 2, m_max_sm_$X + j_1e += c_mn_o_sm_$X(m,n,o,i_charge) * jastrow_sm_90_atomic(m,n,o,i_charge,r_inucl,r_jnucl,r_ij) + enddo + enddo +! else +! print*,'sm_j = ',sm_j +! print*,'not implemented, stop' +! stop + endif + ! e-e-n part + if(sm_j == $X)then + do o = 1, o_max_sm_$X + do m = 2, m_max_sm_$X + do n = 2, n_max_sm_$X + j_een += c_mn_o_sm_$X(m,n,o,i_charge) * jastrow_sm_90_atomic(m,n,o,i_charge,r_inucl,r_jnucl,r_ij) + enddo + enddo + enddo + else +! print*,'sm_j = ',sm_j +! print*,'not implemented, stop' +! stop + endif + j_tot = j_1e + j_2e + j_een +SUBST [ X] + 7 ;; + 9 ;; + 17 ;; +END_TEMPLATE +end + +double precision function jastrow_sm_90_atomic(m,n,o,i_charge,r_inucl,r_jnucl,r_ij) + implicit none + BEGIN_DOC +! contribution to the function of Eq. (4) of Schmidt,Moskowitz, JCP, 93, 4172 (1990) +! for a given m,n,o and atom + END_DOC + double precision, intent(in) :: r_inucl,r_jnucl,r_ij + integer , intent(in) :: m,n,o,i_charge + double precision :: delta_mn + if(m==n)then + delta_mn = 0.5d0 + else + delta_mn = 1.D0 + endif + jastrow_sm_90_atomic = delta_mn * (r_inucl**m * r_jnucl**n + r_jnucl**m * r_inucl**n)*r_ij**o +end diff --git a/plugins/local/tc_scf/plot_j_schMos.irp.f b/plugins/local/tc_scf/plot_j_schMos.irp.f new file mode 100644 index 00000000..eda0dd25 --- /dev/null +++ b/plugins/local/tc_scf/plot_j_schMos.irp.f @@ -0,0 +1,69 @@ +program plot_j + implicit none + double precision :: r1(3),rI(3),r2(3) + double precision :: r12,dx,xmax, j_1e,j_2e,j_een,j_tot + double precision :: j_mu_F_x_j + integer :: i,nx,m,i_charge,sm_j + + character*(128) :: output + integer :: i_unit_output_He_sm_7,i_unit_output_Ne_sm_7 + integer :: i_unit_output_He_sm_17,i_unit_output_Ne_sm_17 + integer :: getUnitAndOpen + output='J_SM_7_He' + i_unit_output_He_sm_7 = getUnitAndOpen(output,'w') + output='J_SM_7_Ne' + i_unit_output_Ne_sm_7 = getUnitAndOpen(output,'w') + + output='J_SM_17_He' + i_unit_output_He_sm_17 = getUnitAndOpen(output,'w') + output='J_SM_17_Ne' + i_unit_output_Ne_sm_17 = getUnitAndOpen(output,'w') + + rI = 0.d0 + r1 = 0.d0 + r2 = 0.d0 + r1(1) = 1.5d0 + xmax = 20.d0 + r2(1) = -xmax*0.5d0 + nx = 1000 + dx = xmax/dble(nx) + do i = 1, nx + r12 = 0.d0 + do m = 1, 3 + r12 += (r1(m) - r2(m))*(r1(m) - r2(m)) + enddo + r12 = dsqrt(r12) + double precision :: jmu,env_nucl,jmu_env,jmu_scaled, jmu_scaled_env + double precision :: b_I,d_I,r_inucl,r_jnucl,r_ij + b_I = 1.D0 + d_I = 1.D0 + call get_rescaled_variables_j_sm_90(r1,r2,rI,b_I,d_I,r_inucl,r_jnucl,r_ij) + jmu=j_mu_F_x_j(r12) + jmu_scaled=j_mu_F_x_j(r_ij) + jmu_env = jmu * env_nucl(r1) * env_nucl(r2) +! jmu_scaled_env= jmu_scaled * (1.d0 - env_coef(1) * dexp(-env_expo(1)*r_inucl**2)) * (1.d0 - env_coef(1) * dexp(-env_expo(1)*r_jnucl**2)) + jmu_scaled_env= jmu_scaled * env_nucl(r1) * env_nucl(r2) + ! He + i_charge = 2 + ! SM 7 Jastrow + sm_j = 7 + call get_full_sm_90_jastrow(r1,r2,rI,sm_j,i_charge, j_1e,j_2e,j_een,j_tot) + write(i_unit_output_He_sm_7,'(100(F16.10,X))')r2(1),r12,j_mu_F_x_j(r12), j_1e,j_2e,j_een,j_tot,jmu_env,jmu_scaled,jmu_scaled_env + ! SM 17 Jastrow + sm_j = 17 + call get_full_sm_90_jastrow(r1,r2,rI,sm_j,i_charge, j_1e,j_2e,j_een,j_tot) + write(i_unit_output_He_sm_17,'(100(F16.10,X))')r2(1),r12,j_mu_F_x_j(r12), j_1e,j_2e,j_een,j_tot,jmu_env,jmu_scaled,jmu_scaled_env + ! Ne + i_charge = 10 + ! SM 7 Jastrow + sm_j = 7 + call get_full_sm_90_jastrow(r1,r2,rI,sm_j,i_charge, j_1e,j_2e,j_een,j_tot) + write(i_unit_output_Ne_sm_7,'(100(F16.10,X))')r2(1),r12,j_mu_F_x_j(r12), j_1e,j_2e,j_een,j_tot,jmu_env,jmu_scaled,jmu_scaled_env + ! SM 17 Jastrow + sm_j = 17 + call get_full_sm_90_jastrow(r1,r2,rI,sm_j,i_charge, j_1e,j_2e,j_een,j_tot) + write(i_unit_output_Ne_sm_17,'(100(F16.10,X))')r2(1),r12,j_mu_F_x_j(r12), j_1e,j_2e,j_een,j_tot,jmu_env,jmu_scaled,jmu_scaled_env + r2(1) += dx + enddo + +end diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index b8fa2895..59cfdff8 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -845,7 +845,13 @@ subroutine fill_buffer_$DOUBLE(i_generator, sp, h1, h2, bannedOrb, banned, fock_ if (h0_type == 'CFG') then w = min(w, e_pert(istate) * s_weight(istate,istate)) / c0_weight(istate) else +! if(dabs(e_pert(istate) * s_weight(istate,istate)).gt.1.d-5)then +! print*,w,e_pert(istate) * s_weight(istate,istate) +! endif w = min(w, e_pert(istate) * s_weight(istate,istate)) +! if(dabs(e_pert(istate) * s_weight(istate,istate)).gt.1.d-5)then +! print*,w +! endif endif end select @@ -883,6 +889,10 @@ subroutine fill_buffer_$DOUBLE(i_generator, sp, h1, h2, bannedOrb, banned, fock_ w *= dsqrt(dble(n)) endif + if(dabs(w).gt.1.d-5)then + print*,w,buf%mini + endif + if(w <= buf%mini) then call add_to_selection_buffer(buf, det, w) end if From 590463063f9151693c4deb07b50f2dc86a61bc10 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 5 Mar 2024 15:37:09 +0100 Subject: [PATCH 07/64] Adapted trexio file for full path --- src/trexio/export_trexio.irp.f | 2 +- src/trexio/export_trexio_routines.irp.f | 20 ++++++++++++++++---- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/src/trexio/export_trexio.irp.f b/src/trexio/export_trexio.irp.f index f9ecc17f..ff12aebb 100644 --- a/src/trexio/export_trexio.irp.f +++ b/src/trexio/export_trexio.irp.f @@ -2,6 +2,6 @@ program export_trexio_prog implicit none read_wf = .True. SOFT_TOUCH read_wf - call export_trexio(.False.) + call export_trexio(.False.,.False.) end diff --git a/src/trexio/export_trexio_routines.irp.f b/src/trexio/export_trexio_routines.irp.f index f25ae370..034b142e 100644 --- a/src/trexio/export_trexio_routines.irp.f +++ b/src/trexio/export_trexio_routines.irp.f @@ -1,18 +1,28 @@ -subroutine export_trexio(update) +subroutine export_trexio(update,full_path) use trexio implicit none BEGIN_DOC ! Exports the wave function in TREXIO format END_DOC - logical, intent(in) :: update + logical, intent(in) :: update, full_path integer(trexio_t) :: f(N_states) ! TREXIO file handle integer(trexio_exit_code) :: rc - integer :: k + integer :: k, iunit double precision, allocatable :: factor(:) - character*(256) :: filenames(N_states) + character*(256) :: filenames(N_states), fp character :: rw + integer, external :: getunitandopen + + if (full_path) then + fp = trexio_filename + call system('realpath '//trim(fp)//' > '//trim(fp)//'.tmp') + iunit = getunitandopen(trim(fp)//'.tmp','r') + read(iunit,'(A)') trexio_filename + close(iunit, status='delete') + endif + filenames(1) = trexio_filename do k=2,N_states write(filenames(k),'(A,I3.3)') trim(trexio_filename)//'.', k-1 @@ -49,6 +59,8 @@ subroutine export_trexio(update) enddo call ezfio_set_trexio_trexio_file(trexio_filename) + + ! ------------------------------------------------------------------------------ ! Electrons From 92a3ecae45247bbf0d003aa71c416ceba1e6207b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 5 Mar 2024 15:39:57 +0100 Subject: [PATCH 08/64] Fix propagation of error codes in qp command --- etc/qp.rc | 2 ++ 1 file changed, 2 insertions(+) diff --git a/etc/qp.rc b/etc/qp.rc index d316faf5..bd061e3e 100644 --- a/etc/qp.rc +++ b/etc/qp.rc @@ -120,7 +120,9 @@ function qp() if [[ $? -eq 0 ]] ; then COMMAND='qp_$@' eval "$COMMAND" "${EZFIO_FILE}" + result=$? unset COMMAND + return $result else _qp_usage fi From 72daa98fa34b13758f4ef28df61e405fc24c90d1 Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 5 Mar 2024 17:24:29 +0100 Subject: [PATCH 09/64] introduced TODO comments in TC --- plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f | 1 + plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f b/plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f index c767f090..5f37b11e 100644 --- a/plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f +++ b/plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f @@ -520,6 +520,7 @@ compute_singles=.True. ASSERT (lrow <= N_det_alpha_unique) tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) + ! TODO: i_htc "optimized" for normal ordering for single/double by spin ! call i_h_j_single_spin( tmp_det, tmp_det2, $N_int, 1, hij) if(do_right)then call htilde_mu_mat_opt_bi_ortho_tot(tmp_det,tmp_det2,$N_int,hij) diff --git a/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f b/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f index a9e22e03..75f3dfbe 100644 --- a/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f +++ b/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f @@ -230,6 +230,7 @@ end allocate(H_jj(N_det),vec_tmp(N_det,n_states_diag)) + ! TODO : OPEN-MP do i = 1, N_det call htilde_mu_mat_opt_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i)) enddo @@ -277,7 +278,6 @@ end do istate = N_states+1, n_states_diag vec_tmp(istate,istate) = 1.d0 enddo - !call davidson_general_ext_rout_nonsym_b1space(vec_tmp, H_jj, eigval_right_tc_bi_orth, N_det, n_states, n_states_diag, converged, H_tc_u_0_opt) converged = .False. i_it = 0 do while (.not. converged) @@ -364,6 +364,7 @@ subroutine bi_normalize(u_l, u_r, n, ld, nstates) !!!! Normalization of right eigenvectors |Phi> accu = 0.d0 + ! TODO: dot product lapack do j = 1, n accu += u_r(j,i) * u_r(j,i) enddo From 89aaf304603d24faec884be10559c1a4f07cd3c3 Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 5 Mar 2024 19:18:04 +0100 Subject: [PATCH 10/64] removed stupid print in fci --- src/cipsi/selection.irp.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 59cfdff8..ae84f84e 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -889,9 +889,9 @@ subroutine fill_buffer_$DOUBLE(i_generator, sp, h1, h2, bannedOrb, banned, fock_ w *= dsqrt(dble(n)) endif - if(dabs(w).gt.1.d-5)then - print*,w,buf%mini - endif +! if(dabs(w).gt.1.d-5)then +! print*,w,buf%mini +! endif if(w <= buf%mini) then call add_to_selection_buffer(buf, det, w) From 2ea789bee9f25306b0dd5696238045480d479e30 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 8 Mar 2024 17:25:48 +0100 Subject: [PATCH 11/64] removed STUPID stop in save_tc_natorb --- .../tc_bi_ortho/save_tc_bi_ortho_nat.irp.f | 3 ++- plugins/local/tc_bi_ortho/tc_natorb.irp.f | 2 -- plugins/local/tc_scf/routines_rotates.irp.f | 22 +++++++++---------- 3 files changed, 13 insertions(+), 14 deletions(-) diff --git a/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f b/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f index 6b3acce6..02e8144f 100644 --- a/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f +++ b/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f @@ -33,7 +33,8 @@ program tc_natorb_bi_ortho read_wf = .True. touch read_wf - call print_energy_and_mos() + logical :: good_angles + call print_energy_and_mos(good_angles) call save_tc_natorb() call print_angles_tc() !call minimize_tc_orb_angles() diff --git a/plugins/local/tc_bi_ortho/tc_natorb.irp.f b/plugins/local/tc_bi_ortho/tc_natorb.irp.f index b8cf5e81..cc24256f 100644 --- a/plugins/local/tc_bi_ortho/tc_natorb.irp.f +++ b/plugins/local/tc_bi_ortho/tc_natorb.irp.f @@ -33,7 +33,6 @@ do i = 1, ao_num write(*, '(100(F16.10,X))') tc_transition_matrix_ao(:,i,1,1) enddo - stop thr_d = 1.d-6 thr_nd = 1.d-6 @@ -52,7 +51,6 @@ ! call diag_mat_per_fock_degen( fock_diag, dm_tmp, mo_num, thr_d, thr_nd, thr_deg & ! , natorb_tc_leigvec_mo, natorb_tc_reigvec_mo, natorb_tc_eigval) ! endif - call non_hrmt_bieig(mo_num, dm_tmp, thresh_biorthog_diag, thresh_biorthog_nondiag & , natorb_tc_leigvec_mo, natorb_tc_reigvec_mo & , mo_num, natorb_tc_eigval ) diff --git a/plugins/local/tc_scf/routines_rotates.irp.f b/plugins/local/tc_scf/routines_rotates.irp.f index c42e846e..fbfc9beb 100644 --- a/plugins/local/tc_scf/routines_rotates.irp.f +++ b/plugins/local/tc_scf/routines_rotates.irp.f @@ -439,18 +439,18 @@ subroutine print_energy_and_mos(good_angles) if(max_angle_left_right .lt. thresh_lr_angle) then print *, ' Maximum angle BELOW 45 degrees, everthing is OK !' good_angles = .true. - else if(max_angle_left_right .gt. thresh_lr_angle .and. max_angle_left_right .lt. 75.d0) then - print *, ' Maximum angle between thresh_lr_angle and 75 degrees, this is not the best for TC-CI calculations ...' - good_angles = .false. - else if(max_angle_left_right .gt. 75.d0) then - print *, ' Maximum angle between ABOVE 75 degrees, YOU WILL CERTAINLY FIND TROUBLES IN TC-CI calculations ...' - good_angles = .false. +! else if(max_angle_left_right .gt. thresh_lr_angle .and. max_angle_left_right .lt. 75.d0) then +! print *, ' Maximum angle between thresh_lr_angle and 75 degrees, this is not the best for TC-CI calculations ...' +! good_angles = .false. +! else if(max_angle_left_right .gt. 75.d0) then +! print *, ' Maximum angle between ABOVE 75 degrees, YOU WILL CERTAINLY FIND TROUBLES IN TC-CI calculations ...' +! good_angles = .false. endif - - print *, ' Diag Fock elem, product of left/right norm, angle left/right ' - do i = 1, mo_num - write(*, '(I3,X,100(F16.10,X))') i, Fock_matrix_tc_mo_tot(i,i), overlap_mo_l(i,i)*overlap_mo_r(i,i), angle_left_right(i) - enddo +! +! print *, ' Diag Fock elem, product of left/right norm, angle left/right ' +! do i = 1, mo_num +! write(*, '(I3,X,100(F16.10,X))') i, Fock_matrix_tc_mo_tot(i,i), overlap_mo_l(i,i)*overlap_mo_r(i,i), angle_left_right(i) +! enddo end From 9175fb21c9dcbe931f89d96cf1297221693d5fde Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 12 Mar 2024 14:05:38 +0100 Subject: [PATCH 12/64] modifs in json and diagonalize_ci for fci tc bi --- .../local/cipsi_tc_bi_ortho/selection.irp.f | 7 +- .../cipsi_tc_bi_ortho/stochastic_cipsi.irp.f | 1 - .../cipsi_tc_bi_ortho/write_cipsi_json.irp.f | 29 +++- plugins/local/fci_tc_bi/diagonalize_ci.irp.f | 124 ++++++------------ .../local/tc_bi_ortho/tc_h_eigvectors.irp.f | 18 +-- 5 files changed, 82 insertions(+), 97 deletions(-) diff --git a/plugins/local/cipsi_tc_bi_ortho/selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f index 06cf848b..a01d4131 100644 --- a/plugins/local/cipsi_tc_bi_ortho/selection.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f @@ -980,8 +980,11 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d psi_h_alpha = mat_l(istate, p1, p2) pt2_data % overlap(:,istate) = pt2_data % overlap(:,istate) + coef(:) * coef(istate) - pt2_data % variance(istate) = pt2_data % variance(istate) + dabs(e_pert(istate)) - pt2_data % pt2(istate) = pt2_data % pt2(istate) + e_pert(istate) + if(e_pert(istate).gt.0.d0)then! accumulate the positive part of the pt2 + pt2_data % variance(istate) = pt2_data % variance(istate) + e_pert(istate) + else ! accumulate the negative part of the pt2 + pt2_data % pt2(istate) = pt2_data % pt2(istate) + e_pert(istate) + endif select case (weight_selection) case(5) diff --git a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f index 66d82964..2a7273d3 100644 --- a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f @@ -57,7 +57,6 @@ subroutine run_stochastic_cipsi ! endif print_pt2 = .False. call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) -! call routine_save_right ! if (N_det > N_det_max) then diff --git a/plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f b/plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f index 98a402a2..f8c95d38 100644 --- a/plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f @@ -9,6 +9,8 @@ subroutine write_cipsi_json(pt2_data, pt2_data_err) call lock_io character*(64), allocatable :: fmtk(:) + double precision:: pt2_minus,pt2_plus,pt2_tot, pt2_abs + double precision :: error_pt2_minus, error_pt2_plus, error_pt2_tot, error_pt2_abs integer :: N_states_p, N_iter_p N_states_p = min(N_states,N_det) N_iter_p = min(N_iter,8) @@ -26,15 +28,34 @@ subroutine write_cipsi_json(pt2_data, pt2_data_err) endif write(json_unit, json_array_open_fmt) 'states' do k=1,N_states_p + pt2_plus = pt2_data % variance(k) + pt2_minus = pt2_data % pt2(k) + pt2_abs = pt2_plus - pt2_minus + pt2_tot = pt2_plus + pt2_minus + error_pt2_minus = pt2_data_err % pt2(k) + error_pt2_plus = pt2_data_err % variance(k) + error_pt2_tot = dsqrt(error_pt2_minus**2+error_pt2_plus**2) + error_pt2_abs = error_pt2_tot ! same variance because independent variables write(json_unit, json_dict_uopen_fmt) write(json_unit, json_real_fmt) 'energy', psi_energy_with_nucl_rep(k) write(json_unit, json_real_fmt) 's2', psi_s2(k) - write(json_unit, json_real_fmt) 'pt2', pt2_data % pt2(k) - write(json_unit, json_real_fmt) 'pt2_err', pt2_data_err % pt2(k) + + write(json_unit, json_real_fmt) 'pt2', pt2_tot + write(json_unit, json_real_fmt) 'pt2_err', error_pt2_tot + + write(json_unit, json_real_fmt) 'pt2_minus', pt2_minus + write(json_unit, json_real_fmt) 'pt2_minus_err', error_pt2_minus + + write(json_unit, json_real_fmt) 'pt2_abs', pt2_abs + write(json_unit, json_real_fmt) 'pt2_abs_err', error_pt2_abs + + write(json_unit, json_real_fmt) 'pt2_plus', pt2_plus + write(json_unit, json_real_fmt) 'pt2_plus_err', error_pt2_plus + write(json_unit, json_real_fmt) 'rpt2', pt2_data % rpt2(k) write(json_unit, json_real_fmt) 'rpt2_err', pt2_data_err % rpt2(k) - write(json_unit, json_real_fmt) 'variance', pt2_data % variance(k) - write(json_unit, json_real_fmt) 'variance_err', pt2_data_err % variance(k) +! write(json_unit, json_real_fmt) 'variance', pt2_data % variance(k) +! write(json_unit, json_real_fmt) 'variance_err', pt2_data_err % variance(k) write(json_unit, json_array_open_fmt) 'ex_energy' do i=2,N_iter_p write(json_unit, fmtk(i)) extrapolated_energy(i,k) diff --git a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f index 6c8f3431..a9ded70c 100644 --- a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f +++ b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f @@ -11,49 +11,61 @@ subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) use selection_types implicit none integer, intent(inout) :: ndet ! number of determinants from before - double precision, intent(inout) :: E_tc, norm ! E and norm from previous wave function + double precision, intent(inout) :: E_tc(N_states), norm(N_states) ! E and norm from previous wave function type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function logical, intent(in) :: print_pt2 - integer :: i, j - double precision :: pt2_tmp, pt1_norm, rpt2_tmp, abs_pt2 + integer :: i, j,k + double precision:: pt2_minus,pt2_plus,pt2_tot, pt2_abs,pt1_norm,rpt2_tot + double precision :: error_pt2_minus, error_pt2_plus, error_pt2_tot, error_pt2_abs PROVIDE mo_l_coef mo_r_coef - pt2_tmp = pt2_data % pt2(1) - abs_pt2 = pt2_data % variance(1) - pt1_norm = pt2_data % overlap(1,1) - rpt2_tmp = pt2_tmp/(1.d0 + pt1_norm) - print*,'*****' print*,'New wave function information' print*,'N_det tc = ',N_det - print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth - print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(1) - print*,'Ndet, E_tc = ',N_det,eigval_right_tc_bi_orth(1) - print*,'*****' - - if(print_pt2) then - print*,'*****' - print*,'previous wave function info' - print*,'norm(before) = ',norm - print*,'E(before) = ',E_tc - print*,'PT1 norm = ',dsqrt(pt1_norm) - print*,'PT2 = ',pt2_tmp - print*,'rPT2 = ',rpt2_tmp - print*,'|PT2| = ',abs_pt2 - print*,'Positive PT2 = ',(pt2_tmp + abs_pt2)*0.5d0 - print*,'Negative PT2 = ',(pt2_tmp - abs_pt2)*0.5d0 - print*,'E(before) + PT2 = ',E_tc + pt2_tmp/norm - print*,'E(before) +rPT2 = ',E_tc + rpt2_tmp/norm - write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tmp/norm,E_tc + rpt2_tmp/norm,abs_pt2 - print*,'*****' - endif + do k = 1, N_states + print*,'************' + print*,'State ',k + pt2_plus = pt2_data % variance(k) + pt2_minus = pt2_data % pt2(k) + pt2_abs = pt2_plus - pt2_minus + pt2_tot = pt2_plus + pt2_minus +! error_pt2_minus = pt2_data_err % pt2(k) +! error_pt2_plus = pt2_data_err % variance(k) +! error_pt2_tot = dsqrt(error_pt2_minus**2+error_pt2_plus**2) +! error_pt2_abs = error_pt2_tot ! same variance because independent variables + + pt1_norm = pt2_data % overlap(k,k) + rpt2_tot = pt2_tot / (1.d0 + pt1_norm) + + + print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth(k) + print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(k) + print*,'*****' + + if(print_pt2) then + print*,'*****' + print*,'previous wave function info' + print*,'norm(before) = ',norm + print*,'E(before) = ',E_tc + print*,'PT1 norm = ',dsqrt(pt1_norm) + print*,'PT2 = ',pt2_tot + print*,'rPT2 = ',rpt2_tot + print*,'|PT2| = ',pt2_abs + print*,'Positive PT2 = ',pt2_plus + print*,'Negative PT2 = ',pt2_minus + print*,'E(before) + PT2 = ',E_tc + pt2_tot/norm + print*,'E(before) +rPT2 = ',E_tc + rpt2_tot/norm + write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tot/norm,E_tc + rpt2_tot/norm,pt2_minus, pt2_plus + print*,'*****' + endif + E_tc(k) = eigval_right_tc_bi_orth(k) + norm(k) = norm_ground_left_right_bi_orth(k) + enddo psi_energy(1:N_states) = eigval_right_tc_bi_orth(1:N_states) - nuclear_repulsion psi_s2(1:N_states) = s2_eigvec_tc_bi_orth(1:N_states) - E_tc = eigval_right_tc_bi_orth(1) - norm = norm_ground_left_right_bi_orth ndet = N_det do j = 1, N_states do i = 1, N_det @@ -71,53 +83,3 @@ end ! --- -subroutine print_CI_dressed(ndet, E_tc, norm, pt2_data, print_pt2) - - BEGIN_DOC - ! Replace the coefficients of the CI states by the coefficients of the - ! eigenstates of the CI matrix - END_DOC - - use selection_types - implicit none - integer, intent(inout) :: ndet ! number of determinants from before - double precision, intent(inout) :: E_tc,norm ! E and norm from previous wave function - type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function - logical, intent(in) :: print_pt2 - integer :: i, j - - print*,'*****' - print*,'New wave function information' - print*,'N_det tc = ',N_det - print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth - print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(1) - print*,'Ndet, E_tc = ',N_det,eigval_right_tc_bi_orth(1) - print*,'*****' - - if(print_pt2) then - print*,'*****' - print*,'previous wave function info' - print*,'norm(before) = ',norm - print*,'E(before) = ',E_tc - print*,'PT1 norm = ',dsqrt(pt2_data % overlap(1,1)) - print*,'E(before) + PT2 = ',E_tc + (pt2_data % pt2(1))/norm - print*,'PT2 = ',pt2_data % pt2(1) - print*,'Ndet, E_tc, E+PT2 = ',ndet,E_tc,E_tc + (pt2_data % pt2(1))/norm,dsqrt(pt2_data % overlap(1,1)) - print*,'*****' - endif - - E_tc = eigval_right_tc_bi_orth(1) - norm = norm_ground_left_right_bi_orth - ndet = N_det - - do j = 1, N_states - do i = 1, N_det - psi_coef(i,j) = reigvec_tc_bi_orth(i,j) - enddo - enddo - SOFT_TOUCH eigval_left_tc_bi_orth eigval_right_tc_bi_orth leigvec_tc_bi_orth norm_ground_left_right_bi_orth psi_coef reigvec_tc_bi_orth - -end - -! --- - diff --git a/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f b/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f index 75f3dfbe..c90c84c5 100644 --- a/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f +++ b/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f @@ -45,12 +45,12 @@ end ! --- - BEGIN_PROVIDER [double precision, eigval_right_tc_bi_orth, (N_states) ] -&BEGIN_PROVIDER [double precision, eigval_left_tc_bi_orth , (N_states) ] -&BEGIN_PROVIDER [double precision, reigvec_tc_bi_orth , (N_det,N_states)] -&BEGIN_PROVIDER [double precision, leigvec_tc_bi_orth , (N_det,N_states)] -&BEGIN_PROVIDER [double precision, s2_eigvec_tc_bi_orth , (N_states) ] -&BEGIN_PROVIDER [double precision, norm_ground_left_right_bi_orth ] + BEGIN_PROVIDER [double precision, eigval_right_tc_bi_orth , (N_states) ] +&BEGIN_PROVIDER [double precision, eigval_left_tc_bi_orth , (N_states) ] +&BEGIN_PROVIDER [double precision, reigvec_tc_bi_orth , (N_det,N_states)] +&BEGIN_PROVIDER [double precision, leigvec_tc_bi_orth , (N_det,N_states)] +&BEGIN_PROVIDER [double precision, s2_eigvec_tc_bi_orth , (N_states) ] +&BEGIN_PROVIDER [double precision, norm_ground_left_right_bi_orth , (N_states) ] BEGIN_DOC ! eigenvalues, right and left eigenvectors of the transcorrelated Hamiltonian on the BI-ORTHO basis @@ -309,13 +309,13 @@ end deallocate(Stmp) print*,'leigvec_tc_bi_orth(1,1),reigvec_tc_bi_orth(1,1) = ', leigvec_tc_bi_orth(1,1), reigvec_tc_bi_orth(1,1) + norm_ground_left_right_bi_orth = 0.d0 do i = 1, N_states - norm_ground_left_right_bi_orth = 0.d0 do j = 1, N_det - norm_ground_left_right_bi_orth += leigvec_tc_bi_orth(j,i) * reigvec_tc_bi_orth(j,i) + norm_ground_left_right_bi_orth(i) += leigvec_tc_bi_orth(j,i) * reigvec_tc_bi_orth(j,i) enddo print*,' state ', i - print*,' norm l/r = ', norm_ground_left_right_bi_orth + print*,' norm l/r = ', norm_ground_left_right_bi_orth(i) print*,' = ', s2_eigvec_tc_bi_orth(i) enddo From 6e35f8f8f8735bd4a898fabbc6bf552f382e517a Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 12 Mar 2024 15:30:52 +0100 Subject: [PATCH 13/64] fixed n_states > 1 for TC --- .../cipsi_tc_bi_ortho/stochastic_cipsi.irp.f | 2 +- plugins/local/fci_tc_bi/diagonalize_ci.irp.f | 80 ++++++----- .../local/tc_bi_ortho/tc_h_eigvectors.irp.f | 27 ++-- src/iterations/summary_tc.irp.f | 125 ++++++++++++++++++ 4 files changed, 181 insertions(+), 53 deletions(-) create mode 100644 src/iterations/summary_tc.irp.f diff --git a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f index 2a7273d3..59ea3f11 100644 --- a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f @@ -98,7 +98,7 @@ subroutine run_stochastic_cipsi call ZMQ_pt2(E_denom, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection ! stop - call print_summary(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, N_det, N_configuration, N_states, psi_s2) + call print_summary_tc(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, N_det, N_configuration, N_states, psi_s2) call save_energy(psi_energy_with_nucl_rep, pt2_data % pt2) diff --git a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f index a9ded70c..a5242b87 100644 --- a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f +++ b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f @@ -20,48 +20,44 @@ subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) PROVIDE mo_l_coef mo_r_coef - print*,'*****' - print*,'New wave function information' - print*,'N_det tc = ',N_det - do k = 1, N_states - print*,'************' - print*,'State ',k - pt2_plus = pt2_data % variance(k) - pt2_minus = pt2_data % pt2(k) - pt2_abs = pt2_plus - pt2_minus - pt2_tot = pt2_plus + pt2_minus -! error_pt2_minus = pt2_data_err % pt2(k) -! error_pt2_plus = pt2_data_err % variance(k) -! error_pt2_tot = dsqrt(error_pt2_minus**2+error_pt2_plus**2) -! error_pt2_abs = error_pt2_tot ! same variance because independent variables - - pt1_norm = pt2_data % overlap(k,k) - rpt2_tot = pt2_tot / (1.d0 + pt1_norm) - - - print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth(k) - print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(k) - print*,'*****' - - if(print_pt2) then - print*,'*****' - print*,'previous wave function info' - print*,'norm(before) = ',norm - print*,'E(before) = ',E_tc - print*,'PT1 norm = ',dsqrt(pt1_norm) - print*,'PT2 = ',pt2_tot - print*,'rPT2 = ',rpt2_tot - print*,'|PT2| = ',pt2_abs - print*,'Positive PT2 = ',pt2_plus - print*,'Negative PT2 = ',pt2_minus - print*,'E(before) + PT2 = ',E_tc + pt2_tot/norm - print*,'E(before) +rPT2 = ',E_tc + rpt2_tot/norm - write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tot/norm,E_tc + rpt2_tot/norm,pt2_minus, pt2_plus - print*,'*****' - endif - E_tc(k) = eigval_right_tc_bi_orth(k) - norm(k) = norm_ground_left_right_bi_orth(k) - enddo +! print*,'*****' +! print*,'New wave function information' +! print*,'N_det tc = ',N_det +! do k = 1, N_states +! print*,'************' +! print*,'State ',k +! pt2_plus = pt2_data % variance(k) +! pt2_minus = pt2_data % pt2(k) +! pt2_abs = pt2_plus - pt2_minus +! pt2_tot = pt2_plus + pt2_minus +! +! pt1_norm = pt2_data % overlap(k,k) +! rpt2_tot = pt2_tot / (1.d0 + pt1_norm) +! +! +! print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth(k) +! print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(k) +! print*,'*****' +! +! if(print_pt2) then +! print*,'*****' +! print*,'previous wave function info' +! print*,'norm(before) = ',norm +! print*,'E(before) = ',E_tc +! print*,'PT1 norm = ',dsqrt(pt1_norm) +! print*,'PT2 = ',pt2_tot +! print*,'rPT2 = ',rpt2_tot +! print*,'|PT2| = ',pt2_abs +! print*,'Positive PT2 = ',pt2_plus +! print*,'Negative PT2 = ',pt2_minus +! print*,'E(before) + PT2 = ',E_tc + pt2_tot/norm +! print*,'E(before) +rPT2 = ',E_tc + rpt2_tot/norm +! write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tot/norm,E_tc + rpt2_tot/norm,pt2_minus, pt2_plus +! print*,'*****' +! endif +! E_tc(k) = eigval_right_tc_bi_orth(k) +! norm(k) = norm_ground_left_right_bi_orth(k) +! enddo psi_energy(1:N_states) = eigval_right_tc_bi_orth(1:N_states) - nuclear_repulsion psi_s2(1:N_states) = s2_eigvec_tc_bi_orth(1:N_states) diff --git a/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f b/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f index c90c84c5..6bf3d99e 100644 --- a/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f +++ b/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f @@ -86,17 +86,20 @@ end endif call non_hrmt_real_diag(N_det, H_prime, leigvec_tc_bi_orth_tmp, reigvec_tc_bi_orth_tmp, n_real_tc_bi_orth_eigval_right, eigval_right_tmp) + if(N_states.gt.1)then + print*,'n_real_tc_bi_orth_eigval_right = ',n_real_tc_bi_orth_eigval_right + endif ! do i = 1, N_det ! call get_H_tc_s2_l0_r0(leigvec_tc_bi_orth_tmp(1,i),reigvec_tc_bi_orth_tmp(1,i),1,N_det,expect_e(i), s2_values_tmp(i)) ! enddo call get_H_tc_s2_l0_r0(leigvec_tc_bi_orth_tmp,reigvec_tc_bi_orth_tmp,N_det,N_det,expect_e, s2_values_tmp) + allocate(index_good_state_array(N_det),good_state_array(N_det)) i_state = 0 good_state_array = .False. if(s2_eig) then - if(only_expected_s2) then do j = 1, N_det ! Select at least n_states states with S^2 values closed to "expected_s2" @@ -116,6 +119,9 @@ end good_state_array(j) = .True. enddo endif + if(N_states.gt.1)then + print*,'i_state = ',i_state + endif if(i_state .ne. 0) then ! Fill the first "i_state" states that have a correct S^2 value @@ -338,11 +344,6 @@ end TOUCH psi_r_coef_bi_ortho call ezfio_set_tc_bi_ortho_psi_r_coef_bi_ortho(buffer) deallocate(buffer) -! print*,'After diag' -! do i = 1, N_det! old version -! print*,'i',i,psi_l_coef_bi_ortho(i,1),psi_r_coef_bi_ortho(i,1) -! call debug_det(psi_det(1,1,i),N_int) -! enddo END_PROVIDER @@ -357,23 +358,29 @@ subroutine bi_normalize(u_l, u_r, n, ld, nstates) implicit none integer, intent(in) :: n, ld, nstates double precision, intent(inout) :: u_l(ld,nstates), u_r(ld,nstates) - integer :: i, j - double precision :: accu, tmp + integer :: i, j,j_loc + double precision :: accu, tmp, maxval_tmp do i = 1, nstates !!!! Normalization of right eigenvectors |Phi> accu = 0.d0 ! TODO: dot product lapack + maxval_tmp = 0.d0 do j = 1, n accu += u_r(j,i) * u_r(j,i) + if(dabs(u_r(j,i)).gt.maxval_tmp)then + maxval_tmp = dabs(u_r(j,i)) + j_loc = j + endif enddo accu = 1.d0/dsqrt(accu) print*,'accu_r = ',accu + print*,'j_loc = ',j_loc do j = 1, n u_r(j,i) *= accu enddo - tmp = u_r(1,i) / dabs(u_r(1,i)) + tmp = u_r(j_loc,i) / dabs(u_r(j_loc,i)) do j = 1, n u_r(j,i) *= tmp enddo @@ -390,7 +397,7 @@ subroutine bi_normalize(u_l, u_r, n, ld, nstates) else accu = 1.d0/dsqrt(-accu) endif - tmp = (u_l(1,i) * u_r(1,i) )/dabs(u_l(1,i) * u_r(1,i)) + tmp = (u_l(j_loc,i) * u_r(j_loc,i) )/dabs(u_l(j_loc,i) * u_r(j_loc,i)) do j = 1, n u_l(j,i) *= accu * tmp u_r(j,i) *= accu diff --git a/src/iterations/summary_tc.irp.f b/src/iterations/summary_tc.irp.f new file mode 100644 index 00000000..00c2ba38 --- /dev/null +++ b/src/iterations/summary_tc.irp.f @@ -0,0 +1,125 @@ +subroutine print_summary_tc(e_,pt2_data,pt2_data_err,n_det_,n_configuration_,n_st,s2_) + use selection_types + implicit none + BEGIN_DOC +! Print the extrapolated energy in the output + END_DOC + + integer, intent(in) :: n_det_, n_configuration_, n_st + double precision, intent(in) :: e_(n_st), s2_(n_st) + type(pt2_type) , intent(in) :: pt2_data, pt2_data_err + integer :: i, k + integer :: N_states_p + character*(9) :: pt2_string + character*(512) :: fmt + double precision, allocatable :: pt2_minus(:),pt2_plus(:),pt2_tot(:), pt2_abs(:),pt1_norm(:),rpt2_tot(:) + double precision, allocatable :: error_pt2_minus(:), error_pt2_plus(:), error_pt2_tot(:), error_pt2_abs(:) + + if (do_pt2) then + pt2_string = ' ' + else + pt2_string = '(approx)' + endif + + N_states_p = min(N_det_,n_st) + + allocate(pt2_minus(N_states_p),pt2_plus(N_states_p),pt2_tot(N_states_p), pt2_abs(N_states_p),pt1_norm(N_states_p),rpt2_tot(N_states_p)) + allocate(error_pt2_minus(N_states_p), error_pt2_plus(N_states_p), error_pt2_tot(N_states_p), error_pt2_abs(N_states_p)) + do k = 1, N_states_p + pt2_plus(k) = pt2_data % variance(k) + pt2_minus(k) = pt2_data % pt2(k) + pt2_abs(k) = pt2_plus(k) - pt2_minus(k) + pt2_tot(k) = pt2_plus(k) + pt2_minus(k) + pt1_norm(k) = pt2_data % overlap(k,k) + rpt2_tot(k) = pt2_tot(k) / (1.d0 + pt1_norm(k)) + error_pt2_minus(k) = pt2_data_err % pt2(k) + error_pt2_plus(k) = pt2_data_err % variance(k) + error_pt2_tot(k) = dsqrt(error_pt2_minus(k)**2+error_pt2_plus(k)**2) + error_pt2_abs(k) = error_pt2_tot(k) ! same variance because independent variables + enddo + k=1 + write(*,'(A40,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,pt2_minus,pt2_plus,pt2_abs=',n_det_,e_(k),e_(k) + pt2_tot(k),e_(k) + rpt2_tot(k),pt2_minus(k), pt2_plus(k),pt2_abs(k) + + print *, '' + print '(A,I12)', 'Summary at N_det = ', N_det_ + print '(A)', '-----------------------------------' + print *, '' + + write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=============================''))' + write(*,fmt) + write(fmt,*) '(13X,', N_states_p, '(6X,A7,1X,I6,10X))' + write(*,fmt) ('State',k, k=1,N_states_p) + write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=============================''))' + write(*,fmt) + write(fmt,*) '(A13,', N_states_p, '(1X,F14.8,15X))' + write(*,fmt) '# E ', e_(1:N_states_p) + if (N_states_p > 1) then + write(*,fmt) '# Excit. (au)', e_(1:N_states_p)-e_(1) + write(*,fmt) '# Excit. (eV)', (e_(1:N_states_p)-e_(1))*27.211396641308d0 + endif + write(fmt,*) '(A13,', 2*N_states_p, '(1X,F14.8))' + write(*,fmt) '# PT2 '//pt2_string, (pt2_tot(k), error_pt2_tot(k), k=1,N_states_p) + write(*,fmt) '# rPT2'//pt2_string, (rpt2_tot(k), error_pt2_tot(k), k=1,N_states_p) + write(*,'(A)') '#' + write(*,fmt) '# E+PT2 ', (e_(k)+pt2_tot(k) ,error_pt2_tot(k), k=1,N_states_p) + write(*,fmt) '# E+rPT2 ', (e_(k)+rpt2_tot(k),error_pt2_tot(k), k=1,N_states_p) + if (N_states_p > 1) then + write(*,fmt) '# Excit. (au)', ( (e_(k)+pt2_tot(k)-e_(1)-pt2_tot(1)), & + dsqrt(error_pt2_tot(k)*error_pt2_tot(k)+error_pt2_tot(1)*error_pt2_tot(1)), k=1,N_states_p) + write(*,fmt) '# Excit. (eV)', ( (e_(k)+pt2_tot(k)-e_(1)-pt2_tot(1))*27.211396641308d0, & + dsqrt(error_pt2_tot(k)*error_pt2_tot(k)+error_pt2_tot(1)*error_pt2_tot(1))*27.211396641308d0, k=1,N_states_p) + endif + write(fmt,*) '(''# ============'',', N_states_p, '(1X,''=============================''))' + write(*,fmt) + print *, '' + + print *, 'N_det = ', N_det_ + print *, 'N_states = ', n_st + if (s2_eig) then + print *, 'N_cfg = ', N_configuration_ + if (only_expected_s2) then + print *, 'N_csf = ', N_csf + endif + endif + print *, '' + + do k=1, N_states_p + print*,'* State ',k + print *, '< S^2 > = ', s2_(k) + print *, 'E = ', e_(k) + print *, 'PT norm = ', pt1_norm(k) + print *, 'PT2 = ', pt2_tot(k), ' +/- ', error_pt2_tot(k) + print *, 'rPT2 = ', rpt2_tot(k), ' +/- ', error_pt2_tot(k) + print *, 'E+PT2 '//pt2_string//' = ', e_(k)+pt2_tot(k) , ' +/- ', error_pt2_tot(k) + print *, 'E+rPT2'//pt2_string//' = ', e_(k)+rpt2_tot(k), ' +/- ', error_pt2_tot(k) + print *, 'Positive PT2 = ',pt2_plus(k),' +/- ',error_pt2_plus(k) + print *, 'Negative PT2 = ',pt2_minus(k),' +/- ',error_pt2_minus(k) + print *, 'Abs PT2 = ',pt2_abs(k), ' +/- ',error_pt2_abs(k) + print *, '' + enddo + + print *, '-----' + if(n_st.gt.1)then + print *, 'Variational Energy difference (au | eV)' + do i=2, N_states_p + print*,'Delta E = ', (e_(i) - e_(1)), & + (e_(i) - e_(1)) * 27.211396641308d0 + enddo + print *, '-----' + print*, 'Variational + perturbative Energy difference (au | eV)' + do i=2, N_states_p + print*,'Delta E = ', (e_(i)+ pt2_tot(i) - (e_(1) + pt2_tot(1))), & + (e_(i)+ pt2_tot(i) - (e_(1) + pt2_tot(1))) * 27.211396641308d0 + enddo + print *, '-----' + print*, 'Variational + renormalized perturbative Energy difference (au | eV)' + do i=2, N_states_p + print*,'Delta E = ', (e_(i)+ rpt2_tot(i) - (e_(1) + rpt2_tot(1))), & + (e_(i)+ rpt2_tot(i) - (e_(1) + rpt2_tot(1))) * 27.211396641308d0 + enddo + endif + +! call print_energy_components() + +end subroutine + From 0ef067337d9cffd2fba9b1bc29afe071c696f883 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 12 Mar 2024 16:37:16 +0100 Subject: [PATCH 14/64] Introducing cipsi_utils for CIPSI and TC-CIPSI --- plugins/local/cipsi_tc_bi_ortho/NEED | 1 + plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f | 2 +- .../pt2_stoch_routines.irp.f | 869 +--------------- .../cipsi_tc_bi_ortho/stochastic_cipsi.irp.f | 2 +- plugins/local/fci_tc_bi/NEED | 1 + plugins/local/fci_tc_bi/selectors.irp.f | 2 +- src/cipsi/NEED | 1 + src/cipsi/pt2_stoch_routines.irp.f | 924 +----------------- src/generators_full_tc/README.rst | 9 + .../generators_full_tc}/generators.irp.f | 48 +- 10 files changed, 56 insertions(+), 1803 deletions(-) create mode 100644 src/generators_full_tc/README.rst rename {plugins/local/fci_tc_bi => src/generators_full_tc}/generators.irp.f (51%) diff --git a/plugins/local/cipsi_tc_bi_ortho/NEED b/plugins/local/cipsi_tc_bi_ortho/NEED index 8f05be69..d329326c 100644 --- a/plugins/local/cipsi_tc_bi_ortho/NEED +++ b/plugins/local/cipsi_tc_bi_ortho/NEED @@ -1,3 +1,4 @@ +cipsi_utils json mpi perturbation diff --git a/plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f index fb907cb3..65e0790a 100644 --- a/plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f @@ -65,7 +65,7 @@ subroutine run_cipsi if (N_det > N_det_max) then psi_det(1:N_int,1:2,1:N_det) = psi_det_generators(1:N_int,1:2,1:N_det) - psi_coef(1:N_det,1:N_states) = psi_coef_sorted_tc_gen(1:N_det,1:N_states) + psi_coef(1:N_det,1:N_states) = psi_coef_sorted_gen(1:N_det,1:N_states) N_det = N_det_max soft_touch N_det psi_det psi_coef if (s2_eig) then diff --git a/plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f b/plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f index 284b2bc8..6e1a6748 100644 --- a/plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f @@ -1,868 +1,3 @@ -BEGIN_PROVIDER [ integer, pt2_stoch_istate ] - implicit none - BEGIN_DOC - ! State for stochatsic PT2 - END_DOC - pt2_stoch_istate = 1 -END_PROVIDER - - BEGIN_PROVIDER [ integer, pt2_F, (N_det_generators) ] -&BEGIN_PROVIDER [ integer, pt2_n_tasks_max ] - implicit none - logical, external :: testTeethBuilding - integer :: i,j - pt2_n_tasks_max = elec_alpha_num*elec_alpha_num + elec_alpha_num*elec_beta_num - n_core_orb*2 - pt2_n_tasks_max = min(pt2_n_tasks_max,1+N_det_generators/10000) - call write_int(6,pt2_n_tasks_max,'pt2_n_tasks_max') - - pt2_F(:) = max(int(sqrt(float(pt2_n_tasks_max))),1) - do i=1,pt2_n_0(1+pt2_N_teeth/4) - pt2_F(i) = pt2_n_tasks_max*pt2_min_parallel_tasks - enddo - do i=1+pt2_n_0(pt2_N_teeth-pt2_N_teeth/4), pt2_n_0(pt2_N_teeth-pt2_N_teeth/10) - pt2_F(i) = pt2_min_parallel_tasks - enddo - do i=1+pt2_n_0(pt2_N_teeth-pt2_N_teeth/10), N_det_generators - pt2_F(i) = 1 - enddo - -END_PROVIDER - - BEGIN_PROVIDER [ integer, pt2_N_teeth ] -&BEGIN_PROVIDER [ integer, pt2_minDetInFirstTeeth ] - implicit none - logical, external :: testTeethBuilding - - if(N_det_generators < 500) then - pt2_minDetInFirstTeeth = 1 - pt2_N_teeth = 1 - else - pt2_minDetInFirstTeeth = min(5, N_det_generators) - do pt2_N_teeth=100,2,-1 - if(testTeethBuilding(pt2_minDetInFirstTeeth, pt2_N_teeth)) exit - end do - end if - call write_int(6,pt2_N_teeth,'Number of comb teeth') -END_PROVIDER - - -logical function testTeethBuilding(minF, N) - implicit none - integer, intent(in) :: minF, N - integer :: n0, i - double precision :: u0, Wt, r - - double precision, allocatable :: tilde_w(:), tilde_cW(:) - integer, external :: dress_find_sample - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - - rss = memory_of_double(2*N_det_generators+1) - call check_mem(rss,irp_here) - - allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) - - double precision :: norm2 - norm2 = 0.d0 - do i=N_det_generators,1,-1 - tilde_w(i) = psi_coef_sorted_tc_gen(i,pt2_stoch_istate) * & - psi_coef_sorted_tc_gen(i,pt2_stoch_istate) - norm2 = norm2 + tilde_w(i) - enddo - - f = 1.d0/norm2 - tilde_w(:) = tilde_w(:) * f - - tilde_cW(0) = -1.d0 - do i=1,N_det_generators - tilde_cW(i) = tilde_cW(i-1) + tilde_w(i) - enddo - tilde_cW(:) = tilde_cW(:) + 1.d0 - deallocate(tilde_w) - - n0 = 0 - testTeethBuilding = .false. - double precision :: f - integer :: minFN - minFN = N_det_generators - minF * N - f = 1.d0/dble(N) - do - u0 = tilde_cW(n0) - r = tilde_cW(n0 + minF) - Wt = (1d0 - u0) * f - if (dabs(Wt) <= 1.d-3) then - exit - endif - if(Wt >= r - u0) then - testTeethBuilding = .true. - exit - end if - n0 += 1 - if(n0 > minFN) then - exit - end if - end do - deallocate(tilde_cW) - -end function - - - -subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) - use f77_zmq - use selection_types - - implicit none - - integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull - integer, intent(in) :: N_in -! integer, intent(inout) :: N_in - double precision, intent(in) :: relative_error, E(N_states) - type(pt2_type), intent(inout) :: pt2_data, pt2_data_err -! - integer :: i, N - - double precision :: state_average_weight_save(N_states), w(N_states,4) - integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket - type(selection_buffer) :: b - - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_tc psi_det_sorted_tc - PROVIDE psi_det_hii selection_weight pseudo_sym - PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max - PROVIDE excitation_beta_max excitation_alpha_max excitation_max - - if (h0_type == 'CFG') then - PROVIDE psi_configuration_hii det_to_configuration - endif - - if (N_det <= max(4,N_states) .or. pt2_N_teeth < 2) then - print*,'ZMQ_selection' - call ZMQ_selection(N_in, pt2_data) - else - print*,'else ZMQ_selection' - - N = max(N_in,1) * N_states - state_average_weight_save(:) = state_average_weight(:) - if (int(N,8)*2_8 > huge(1)) then - print *, irp_here, ': integer too large' - stop -1 - endif - call create_selection_buffer(N, N*2, b) - ASSERT (associated(b%det)) - ASSERT (associated(b%val)) - - do pt2_stoch_istate=1,N_states - state_average_weight(:) = 0.d0 - state_average_weight(pt2_stoch_istate) = 1.d0 - TOUCH state_average_weight pt2_stoch_istate selection_weight - - PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w - PROVIDE pt2_u pt2_J pt2_R - call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') - - integer, external :: zmq_put_psi - integer, external :: zmq_put_N_det_generators - integer, external :: zmq_put_N_det_selectors - integer, external :: zmq_put_dvector - integer, external :: zmq_put_ivector - if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then - stop 'Unable to put psi on ZMQ server' - endif - if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_generators on ZMQ server' - endif - if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_selectors on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then - stop 'Unable to put energy on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then - stop 'Unable to put state_average_weight on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then - stop 'Unable to put selection_weight on ZMQ server' - endif - if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then - stop 'Unable to put pt2_stoch_istate on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) then - stop 'Unable to put threshold_generators on ZMQ server' - endif - - - integer, external :: add_task_to_taskserver - character(300000) :: task - - integer :: j,k,ipos,ifirst - ifirst=0 - - ipos=0 - do i=1,N_det_generators - if (pt2_F(i) > 1) then - ipos += 1 - endif - enddo - call write_int(6,sum(pt2_F),'Number of tasks') - call write_int(6,ipos,'Number of fragmented tasks') - - ipos=1 - do i= 1, N_det_generators - do j=1,pt2_F(pt2_J(i)) - write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in - ipos += 30 - if (ipos > 300000-30) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - ipos=1 - if (ifirst == 0) then - ifirst=1 - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - endif - endif - end do - enddo - if (ipos > 1) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - endif - - integer, external :: zmq_set_running - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - - - double precision :: mem_collector, mem, rss - - call resident_memory(rss) - - mem_collector = 8.d0 * & ! bytes - ( 1.d0*pt2_n_tasks_max & ! task_id, index - + 0.635d0*N_det_generators & ! f,d - + pt2_n_tasks_max*pt2_type_size(N_states) & ! pt2_data_task - + N_det_generators*pt2_type_size(N_states) & ! pt2_data_I - + 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3 - + 1.d0*(N_int*2.d0*N + N) & ! selection buffer - + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer - ) / 1024.d0**3 - - integer :: nproc_target, ii - nproc_target = nthreads_pt2 - ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) - - do - mem = mem_collector + & ! - nproc_target * 8.d0 * & ! bytes - ( 0.5d0*pt2_n_tasks_max & ! task_id - + 64.d0*pt2_n_tasks_max & ! task - + pt2_type_size(N_states)*pt2_n_tasks_max*N_states & ! pt2, variance, overlap - + 1.d0*pt2_n_tasks_max & ! i_generator, subset - + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer - + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer - + 2.0d0*(ii) & ! preinteresting, interesting, - ! prefullinteresting, fullinteresting - + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist - + 1.0d0*(N_states*mo_num*mo_num) & ! mat - ) / 1024.d0**3 - - if (nproc_target == 0) then - call check_mem(mem,irp_here) - nproc_target = 1 - exit - endif - - if (mem+rss < qp_max_mem) then - exit - endif - - nproc_target = nproc_target - 1 - - enddo - call write_int(6,nproc_target,'Number of threads for PT2') - call write_double(6,mem,'Memory (Gb)') - - call omp_set_max_active_levels(1) - - - print '(A)', '========== ======================= ===================== ===================== ===========' - print '(A)', ' Samples Energy Variance Norm^2 Seconds' - print '(A)', '========== ======================= ===================== ===================== ===========' - - PROVIDE global_selection_buffer - - !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) & - !$OMP PRIVATE(i) - i = omp_get_thread_num() - if (i==0) then - - call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, pt2_data, pt2_data_err, b, N) - pt2_data % rpt2(pt2_stoch_istate) = & - pt2_data % pt2(pt2_stoch_istate)/(1.d0+pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate)) - - !TODO : We should use here the correct formula for the error of X/Y - pt2_data_err % rpt2(pt2_stoch_istate) = & - pt2_data_err % pt2(pt2_stoch_istate)/(1.d0 + pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate)) - - else - call pt2_slave_inproc(i) - endif - !$OMP END PARALLEL - call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') - call omp_set_max_active_levels(8) - - print '(A)', '========== ======================= ===================== ===================== ===========' - - do k=1,N_states - pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate) - enddo - SOFT_TOUCH pt2_overlap - - enddo - FREE pt2_stoch_istate - - ! Symmetrize overlap - do j=2,N_states - do i=1,j-1 - pt2_overlap(i,j) = 0.5d0 * (pt2_overlap(i,j) + pt2_overlap(j,i)) - pt2_overlap(j,i) = pt2_overlap(i,j) - enddo - enddo - - print *, 'Overlap of perturbed states:' - do k=1,N_states - print *, pt2_overlap(k,:) - enddo - print *, '-------' - - if (N_in > 0) then - b%cur = min(N_in,b%cur) - if (s2_eig) then - call make_selection_buffer_s2(b) - else - call remove_duplicates_in_selection_buffer(b) - endif - call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) - endif - call delete_selection_buffer(b) - - state_average_weight(:) = state_average_weight_save(:) - TOUCH state_average_weight - call update_pt2_and_variance_weights(pt2_data, N_states) - endif - - -end subroutine - - -subroutine pt2_slave_inproc(i) - implicit none - integer, intent(in) :: i - - PROVIDE global_selection_buffer - call run_pt2_slave(1,i,pt2_e0_denominator) +subroutine provide_for_zmq_pt2 + PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc psi_det_sorted_tc_order end - - -subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_err, b, N_) - use f77_zmq - use selection_types - use bitmasks - implicit none - - - integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - double precision, intent(in) :: relative_error, E - type(pt2_type), intent(inout) :: pt2_data, pt2_data_err - type(selection_buffer), intent(inout) :: b - integer, intent(in) :: N_ - - type(pt2_type), allocatable :: pt2_data_task(:) - type(pt2_type), allocatable :: pt2_data_I(:) - type(pt2_type), allocatable :: pt2_data_S(:) - type(pt2_type), allocatable :: pt2_data_S2(:) - type(pt2_type) :: pt2_data_teeth - integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - integer, external :: zmq_delete_tasks_async_send - integer, external :: zmq_delete_tasks_async_recv - integer, external :: zmq_abort - integer, external :: pt2_find_sample_lr - - PROVIDE pt2_stoch_istate - - integer :: more, n, i, p, c, t, n_tasks, U - integer, allocatable :: task_id(:) - integer, allocatable :: index(:) - - double precision :: v, x, x2, x3, avg, avg2, avg3(N_states), eqt, E0, v0, n0(N_states) - double precision :: eqta(N_states) - double precision :: time, time1, time0 - - integer, allocatable :: f(:) - logical, allocatable :: d(:) - logical :: do_exit, stop_now, sending - logical, external :: qp_stop - type(selection_buffer) :: b2 - - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - - sending =.False. - - rss = memory_of_int(pt2_n_tasks_max*2+N_det_generators*2) - rss += memory_of_double(N_states*N_det_generators)*3.d0 - rss += memory_of_double(N_states*pt2_n_tasks_max)*3.d0 - rss += memory_of_double(pt2_N_teeth+1)*4.d0 - call check_mem(rss,irp_here) - - ! If an allocation is added here, the estimate of the memory should also be - ! updated in ZMQ_pt2 - allocate(task_id(pt2_n_tasks_max), index(pt2_n_tasks_max), f(N_det_generators)) - allocate(d(N_det_generators+1)) - allocate(pt2_data_task(pt2_n_tasks_max)) - allocate(pt2_data_I(N_det_generators)) - allocate(pt2_data_S(pt2_N_teeth+1)) - allocate(pt2_data_S2(pt2_N_teeth+1)) - - - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - call create_selection_buffer(N_, N_*2, b2) - - - pt2_data % pt2(pt2_stoch_istate) = -huge(1.) - pt2_data_err % pt2(pt2_stoch_istate) = huge(1.) - pt2_data % variance(pt2_stoch_istate) = huge(1.) - pt2_data_err % variance(pt2_stoch_istate) = huge(1.) - pt2_data % overlap(:,pt2_stoch_istate) = 0.d0 - pt2_data_err % overlap(:,pt2_stoch_istate) = huge(1.) - n = 1 - t = 0 - U = 0 - do i=1,pt2_n_tasks_max - call pt2_alloc(pt2_data_task(i),N_states) - enddo - do i=1,pt2_N_teeth+1 - call pt2_alloc(pt2_data_S(i),N_states) - call pt2_alloc(pt2_data_S2(i),N_states) - enddo - do i=1,N_det_generators - call pt2_alloc(pt2_data_I(i),N_states) - enddo - f(:) = pt2_F(:) - d(:) = .false. - n_tasks = 0 - E0 = E - v0 = 0.d0 - n0(:) = 0.d0 - more = 1 - call wall_time(time0) - time1 = time0 - - do_exit = .false. - stop_now = .false. - do while (n <= N_det_generators) - if(f(pt2_J(n)) == 0) then - d(pt2_J(n)) = .true. - do while(d(U+1)) - U += 1 - end do - - ! Deterministic part - do while(t <= pt2_N_teeth) - if(U >= pt2_n_0(t+1)) then - t=t+1 - E0 = 0.d0 - v0 = 0.d0 - n0(:) = 0.d0 - do i=pt2_n_0(t),1,-1 - E0 += pt2_data_I(i) % pt2(pt2_stoch_istate) - v0 += pt2_data_I(i) % variance(pt2_stoch_istate) - n0(:) += pt2_data_I(i) % overlap(:,pt2_stoch_istate) - end do - else - exit - end if - end do - - ! Add Stochastic part - c = pt2_R(n) - if(c > 0) then - - call pt2_alloc(pt2_data_teeth,N_states) - do p=pt2_N_teeth, 1, -1 - v = pt2_u_0 + pt2_W_T * (pt2_u(c) + dble(p-1)) - i = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(p),pt2_n_0(p+1)) - v = pt2_W_T / pt2_w(i) - call pt2_add ( pt2_data_teeth, v, pt2_data_I(i) ) - call pt2_add ( pt2_data_S(p), 1.d0, pt2_data_teeth ) - call pt2_add2( pt2_data_S2(p), 1.d0, pt2_data_teeth ) - enddo - call pt2_dealloc(pt2_data_teeth) - - avg = E0 + pt2_data_S(t) % pt2(pt2_stoch_istate) / dble(c) - avg2 = v0 + pt2_data_S(t) % variance(pt2_stoch_istate) / dble(c) - avg3(:) = n0(:) + pt2_data_S(t) % overlap(:,pt2_stoch_istate) / dble(c) - if ((avg /= 0.d0) .or. (n == N_det_generators) ) then - do_exit = .true. - endif - if (qp_stop()) then - stop_now = .True. - endif - pt2_data % pt2(pt2_stoch_istate) = avg - pt2_data % variance(pt2_stoch_istate) = avg2 - pt2_data % overlap(:,pt2_stoch_istate) = avg3(:) - call wall_time(time) - ! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969) - if(c > 2) then - eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = sqrt(eqt / (dble(c) - 1.5d0)) - pt2_data_err % pt2(pt2_stoch_istate) = eqt - - eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = sqrt(eqt / (dble(c) - 1.5d0)) - pt2_data_err % variance(pt2_stoch_istate) = eqt - - eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqta(:) = sqrt(eqta(:) / (dble(c) - 1.5d0)) - pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:) - - - if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then - time1 = time - print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.4)', c, & - pt2_data % pt2(pt2_stoch_istate) +E, & - pt2_data_err % pt2(pt2_stoch_istate), & - pt2_data % variance(pt2_stoch_istate), & - pt2_data_err % variance(pt2_stoch_istate), & - pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate), & - pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate), & - time-time0 - if (stop_now .or. ( & - (do_exit .and. (dabs(pt2_data_err % pt2(pt2_stoch_istate)) / & - (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) <= relative_error))) ) then - if (zmq_abort(zmq_to_qp_run_socket) == -1) then - call sleep(10) - if (zmq_abort(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Error in sending abort signal (2)' - endif - endif - endif - endif - endif - end if - n += 1 - else if(more == 0) then - exit - else - call pull_pt2_results(zmq_socket_pull, index, pt2_data_task, task_id, n_tasks, b2) - if(n_tasks > pt2_n_tasks_max)then - print*,'PB !!!' - print*,'If you see this, send a bug report with the following content' - print*,irp_here - print*,'n_tasks,pt2_n_tasks_max = ',n_tasks,pt2_n_tasks_max - stop -1 - endif - if (zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_tasks,sending) == -1) then - stop 'PT2: Unable to delete tasks (send)' - endif - do i=1,n_tasks - if(index(i).gt.size(pt2_data_I,1).or.index(i).lt.1)then - print*,'PB !!!' - print*,'If you see this, send a bug report with the following content' - print*,irp_here - print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1) - stop -1 - endif - call pt2_add(pt2_data_I(index(i)),1.d0,pt2_data_task(i)) - f(index(i)) -= 1 - end do - do i=1, b2%cur - ! We assume the pulled buffer is sorted - if (b2%val(i) > b%mini) exit - call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i)) - end do - if (zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,more,sending) == -1) then - stop 'PT2: Unable to delete tasks (recv)' - endif - end if - end do - do i=1,N_det_generators - call pt2_dealloc(pt2_data_I(i)) - enddo - do i=1,pt2_N_teeth+1 - call pt2_dealloc(pt2_data_S(i)) - call pt2_dealloc(pt2_data_S2(i)) - enddo - do i=1,pt2_n_tasks_max - call pt2_dealloc(pt2_data_task(i)) - enddo -!print *, 'deleting b2' - call delete_selection_buffer(b2) -!print *, 'sorting b' - call sort_selection_buffer(b) -!print *, 'done' - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - -end subroutine - - -integer function pt2_find_sample(v, w) - implicit none - double precision, intent(in) :: v, w(0:N_det_generators) - integer, external :: pt2_find_sample_lr - - pt2_find_sample = pt2_find_sample_lr(v, w, 0, N_det_generators) -end function - - -integer function pt2_find_sample_lr(v, w, l_in, r_in) - implicit none - double precision, intent(in) :: v, w(0:N_det_generators) - integer, intent(in) :: l_in,r_in - integer :: i,l,r - - l=l_in - r=r_in - - do while(r-l > 1) - i = shiftr(r+l,1) - if(w(i) < v) then - l = i - else - r = i - end if - end do - i = r - do r=i+1,N_det_generators - if (w(r) /= w(i)) then - exit - endif - enddo - pt2_find_sample_lr = r-1 -end function - - -BEGIN_PROVIDER [ integer, pt2_n_tasks ] - implicit none - BEGIN_DOC - ! Number of parallel tasks for the Monte Carlo - END_DOC - pt2_n_tasks = N_det_generators -END_PROVIDER - -BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)] - implicit none - integer, allocatable :: seed(:) - integer :: m,i - call random_seed(size=m) - allocate(seed(m)) - do i=1,m - seed(i) = i - enddo - call random_seed(put=seed) - deallocate(seed) - - call RANDOM_NUMBER(pt2_u) - END_PROVIDER - - BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)] -&BEGIN_PROVIDER[ integer, pt2_R, (N_det_generators)] - implicit none - BEGIN_DOC -! pt2_J contains the list of generators after ordering them according to the -! Monte Carlo sampling. -! -! pt2_R(i) is the number of combs drawn when determinant i is computed. - END_DOC - integer :: N_c, N_j - integer :: U, t, i - double precision :: v - integer, external :: pt2_find_sample_lr - - logical, allocatable :: pt2_d(:) - integer :: m,l,r,k - integer :: ncache - integer, allocatable :: ii(:,:) - double precision :: dt - - ncache = min(N_det_generators,10000) - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - rss = memory_of_int(ncache)*dble(pt2_N_teeth) + memory_of_int(N_det_generators) - call check_mem(rss,irp_here) - - allocate(ii(pt2_N_teeth,ncache),pt2_d(N_det_generators)) - - pt2_R(:) = 0 - pt2_d(:) = .false. - N_c = 0 - N_j = pt2_n_0(1) - do i=1,N_j - pt2_d(i) = .true. - pt2_J(i) = i - end do - - U = 0 - do while(N_j < pt2_n_tasks) - - if (N_c+ncache > N_det_generators) then - ncache = N_det_generators - N_c - endif - - !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(dt,v,t,k) - do k=1, ncache - dt = pt2_u_0 - do t=1, pt2_N_teeth - v = dt + pt2_W_T *pt2_u(N_c+k) - dt = dt + pt2_W_T - ii(t,k) = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(t),pt2_n_0(t+1)) - end do - enddo - !$OMP END PARALLEL DO - - do k=1,ncache - !ADD_COMB - N_c = N_c+1 - do t=1, pt2_N_teeth - i = ii(t,k) - if(.not. pt2_d(i)) then - N_j += 1 - pt2_J(N_j) = i - pt2_d(i) = .true. - end if - end do - - pt2_R(N_j) = N_c - - !FILL_TOOTH - do while(U < N_det_generators) - U += 1 - if(.not. pt2_d(U)) then - N_j += 1 - pt2_J(N_j) = U - pt2_d(U) = .true. - exit - end if - end do - if (N_j >= pt2_n_tasks) exit - end do - enddo - - if(N_det_generators > 1) then - pt2_R(N_det_generators-1) = 0 - pt2_R(N_det_generators) = N_c - end if - - deallocate(ii,pt2_d) - -END_PROVIDER - - - - BEGIN_PROVIDER [ double precision, pt2_w, (N_det_generators) ] -&BEGIN_PROVIDER [ double precision, pt2_cW, (0:N_det_generators) ] -&BEGIN_PROVIDER [ double precision, pt2_W_T ] -&BEGIN_PROVIDER [ double precision, pt2_u_0 ] -&BEGIN_PROVIDER [ integer, pt2_n_0, (pt2_N_teeth+1) ] - implicit none - integer :: i, t - double precision, allocatable :: tilde_w(:), tilde_cW(:) - double precision :: r, tooth_width - integer, external :: pt2_find_sample - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - rss = memory_of_double(2*N_det_generators+1) - call check_mem(rss,irp_here) - - if (N_det_generators == 1) then - - pt2_w(1) = 1.d0 - pt2_cw(1) = 1.d0 - pt2_u_0 = 1.d0 - pt2_W_T = 0.d0 - pt2_n_0(1) = 0 - pt2_n_0(2) = 1 - - else - - allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) - - tilde_cW(0) = 0d0 - - do i=1,N_det_generators - tilde_w(i) = psi_coef_sorted_tc_gen(i,pt2_stoch_istate)**2 !+ 1.d-20 - enddo - - double precision :: norm2 - norm2 = 0.d0 - do i=N_det_generators,1,-1 - norm2 += tilde_w(i) - enddo - - tilde_w(:) = tilde_w(:) / norm2 - - tilde_cW(0) = -1.d0 - do i=1,N_det_generators - tilde_cW(i) = tilde_cW(i-1) + tilde_w(i) - enddo - tilde_cW(:) = tilde_cW(:) + 1.d0 - - pt2_n_0(1) = 0 - do - pt2_u_0 = tilde_cW(pt2_n_0(1)) - r = tilde_cW(pt2_n_0(1) + pt2_minDetInFirstTeeth) - pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth) - if(pt2_W_T >= r - pt2_u_0) then - exit - end if - pt2_n_0(1) += 1 - if(N_det_generators - pt2_n_0(1) < pt2_minDetInFirstTeeth * pt2_N_teeth) then - print *, "teeth building failed" - stop -1 - end if - end do - - do t=2, pt2_N_teeth - r = pt2_u_0 + pt2_W_T * dble(t-1) - pt2_n_0(t) = pt2_find_sample(r, tilde_cW) - end do - pt2_n_0(pt2_N_teeth+1) = N_det_generators - - pt2_w(:pt2_n_0(1)) = tilde_w(:pt2_n_0(1)) - do t=1, pt2_N_teeth - tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t)) - if (tooth_width == 0.d0) then - tooth_width = sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1))) - endif - ASSERT(tooth_width > 0.d0) - do i=pt2_n_0(t)+1, pt2_n_0(t+1) - pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width - end do - end do - - pt2_cW(0) = 0d0 - do i=1,N_det_generators - pt2_cW(i) = pt2_cW(i-1) + pt2_w(i) - end do - pt2_n_0(pt2_N_teeth+1) = N_det_generators - - endif -END_PROVIDER - - - - - diff --git a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f index 66d82964..2200373b 100644 --- a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f @@ -62,7 +62,7 @@ subroutine run_stochastic_cipsi ! if (N_det > N_det_max) then ! psi_det(1:N_int,1:2,1:N_det) = psi_det_generators(1:N_int,1:2,1:N_det) -! psi_coef(1:N_det,1:N_states) = psi_coef_sorted_tc_gen(1:N_det,1:N_states) +! psi_coef(1:N_det,1:N_states) = psi_coef_sorted_gen(1:N_det,1:N_states) ! N_det = N_det_max ! soft_touch N_det psi_det psi_coef ! if (s2_eig) then diff --git a/plugins/local/fci_tc_bi/NEED b/plugins/local/fci_tc_bi/NEED index 3bb9515a..8e9ae1c8 100644 --- a/plugins/local/fci_tc_bi/NEED +++ b/plugins/local/fci_tc_bi/NEED @@ -1,3 +1,4 @@ +generators_full_tc json tc_bi_ortho davidson_undressed diff --git a/plugins/local/fci_tc_bi/selectors.irp.f b/plugins/local/fci_tc_bi/selectors.irp.f index 7f93ae55..606660fd 100644 --- a/plugins/local/fci_tc_bi/selectors.irp.f +++ b/plugins/local/fci_tc_bi/selectors.irp.f @@ -40,7 +40,7 @@ END_PROVIDER enddo do k=1,N_states do i=1,N_det_selectors - psi_selectors_coef(i,k) = psi_coef_sorted_tc_gen(i,k) + psi_selectors_coef(i,k) = psi_coef_sorted_gen(i,k) psi_selectors_coef_tc(i,1,k) = psi_l_coef_sorted_bi_ortho(i,k) psi_selectors_coef_tc(i,2,k) = psi_r_coef_sorted_bi_ortho(i,k) enddo diff --git a/src/cipsi/NEED b/src/cipsi/NEED index 89c128ec..ddd1e8cc 100644 --- a/src/cipsi/NEED +++ b/src/cipsi/NEED @@ -1,3 +1,4 @@ +cipsi_utils json perturbation zmq diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 3b048c14..228e0ef1 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -1,923 +1,3 @@ -BEGIN_PROVIDER [ integer, pt2_stoch_istate ] - implicit none - BEGIN_DOC - ! State for stochatsic PT2 - END_DOC - pt2_stoch_istate = 1 -END_PROVIDER - - BEGIN_PROVIDER [ integer, pt2_F, (N_det_generators) ] -&BEGIN_PROVIDER [ integer, pt2_n_tasks_max ] - implicit none - logical, external :: testTeethBuilding - integer :: i,j - pt2_n_tasks_max = elec_alpha_num*elec_alpha_num + elec_alpha_num*elec_beta_num - n_core_orb*2 - pt2_n_tasks_max = min(pt2_n_tasks_max,1+N_det_generators/10000) - call write_int(6,pt2_n_tasks_max,'pt2_n_tasks_max') - - pt2_F(:) = max(int(sqrt(float(pt2_n_tasks_max))),1) - do i=1,pt2_n_0(1+pt2_N_teeth/4) - pt2_F(i) = pt2_n_tasks_max*pt2_min_parallel_tasks - enddo - do i=1+pt2_n_0(pt2_N_teeth-pt2_N_teeth/4), pt2_n_0(pt2_N_teeth-pt2_N_teeth/10) - pt2_F(i) = pt2_min_parallel_tasks - enddo - do i=1+pt2_n_0(pt2_N_teeth-pt2_N_teeth/10), N_det_generators - pt2_F(i) = 1 - enddo - -END_PROVIDER - - BEGIN_PROVIDER [ integer, pt2_N_teeth ] -&BEGIN_PROVIDER [ integer, pt2_minDetInFirstTeeth ] - implicit none - logical, external :: testTeethBuilding - - if(N_det_generators < 1024) then - pt2_minDetInFirstTeeth = 1 - pt2_N_teeth = 1 - else - pt2_minDetInFirstTeeth = min(5, N_det_generators) - do pt2_N_teeth=100,2,-1 - if(testTeethBuilding(pt2_minDetInFirstTeeth, pt2_N_teeth)) exit - end do - end if - call write_int(6,pt2_N_teeth,'Number of comb teeth') -END_PROVIDER - - -logical function testTeethBuilding(minF, N) - implicit none - integer, intent(in) :: minF, N - integer :: n0, i - double precision :: u0, Wt, r - - double precision, allocatable :: tilde_w(:), tilde_cW(:) - integer, external :: dress_find_sample - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - - rss = memory_of_double(2*N_det_generators+1) - call check_mem(rss,irp_here) - - allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) - - double precision :: norm2 - norm2 = 0.d0 - do i=N_det_generators,1,-1 - tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate) * & - psi_coef_sorted_gen(i,pt2_stoch_istate) - norm2 = norm2 + tilde_w(i) - enddo - - f = 1.d0/norm2 - tilde_w(:) = tilde_w(:) * f - - tilde_cW(0) = -1.d0 - do i=1,N_det_generators - tilde_cW(i) = tilde_cW(i-1) + tilde_w(i) - enddo - tilde_cW(:) = tilde_cW(:) + 1.d0 - deallocate(tilde_w) - - n0 = 0 - testTeethBuilding = .false. - double precision :: f - integer :: minFN - minFN = N_det_generators - minF * N - f = 1.d0/dble(N) - do - u0 = tilde_cW(n0) - r = tilde_cW(n0 + minF) - Wt = (1d0 - u0) * f - if (dabs(Wt) <= 1.d-3) then - exit - endif - if(Wt >= r - u0) then - testTeethBuilding = .true. - exit - end if - n0 += 1 - if(n0 > minFN) then - exit - end if - end do - deallocate(tilde_cW) - -end function - - - -subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) - use f77_zmq - use selection_types - - implicit none - - integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull - integer, intent(in) :: N_in - double precision, intent(in) :: relative_error, E(N_states) - type(pt2_type), intent(inout) :: pt2_data, pt2_data_err -! - integer :: i, N - - double precision :: state_average_weight_save(N_states), w(N_states,4) - integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket - type(selection_buffer) :: b - - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted - PROVIDE psi_det_hii selection_weight pseudo_sym - PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max - PROVIDE excitation_beta_max excitation_alpha_max excitation_max - - if (h0_type == 'CFG') then - PROVIDE psi_configuration_hii det_to_configuration - endif - - if (N_det <= max(4,N_states) .or. pt2_N_teeth < 2) then - call ZMQ_selection(N_in, pt2_data) - else - - N = max(N_in,1) * N_states - state_average_weight_save(:) = state_average_weight(:) - if (int(N,8)*2_8 > huge(1)) then - print *, irp_here, ': integer too large' - stop -1 - endif - call create_selection_buffer(N, N*2, b) - ASSERT (associated(b%det)) - ASSERT (associated(b%val)) - - do pt2_stoch_istate=1,N_states - state_average_weight(:) = 0.d0 - state_average_weight(pt2_stoch_istate) = 1.d0 - TOUCH state_average_weight pt2_stoch_istate selection_weight - - PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w - PROVIDE psi_selectors pt2_u pt2_J pt2_R - call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') - - integer, external :: zmq_put_psi - integer, external :: zmq_put_N_det_generators - integer, external :: zmq_put_N_det_selectors - integer, external :: zmq_put_dvector - integer, external :: zmq_put_ivector - if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then - stop 'Unable to put psi on ZMQ server' - endif - if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_generators on ZMQ server' - endif - if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_selectors on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then - stop 'Unable to put energy on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then - stop 'Unable to put state_average_weight on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then - stop 'Unable to put selection_weight on ZMQ server' - endif - if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then - stop 'Unable to put pt2_stoch_istate on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) then - stop 'Unable to put threshold_generators on ZMQ server' - endif - - - integer, external :: add_task_to_taskserver - character(300000) :: task - - integer :: j,k,ipos,ifirst - ifirst=0 - - ipos=0 - do i=1,N_det_generators - if (pt2_F(i) > 1) then - ipos += 1 - endif - enddo - call write_int(6,sum(pt2_F),'Number of tasks') - call write_int(6,ipos,'Number of fragmented tasks') - - ipos=1 - do i= 1, N_det_generators - do j=1,pt2_F(pt2_J(i)) - write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in - ipos += 30 - if (ipos > 300000-30) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - ipos=1 - if (ifirst == 0) then - ifirst=1 - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - endif - endif - end do - enddo - if (ipos > 1) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - endif - - integer, external :: zmq_set_running - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - - - double precision :: mem_collector, mem, rss - - call resident_memory(rss) - - mem_collector = 8.d0 * & ! bytes - ( 1.d0*pt2_n_tasks_max & ! task_id, index - + 0.635d0*N_det_generators & ! f,d - + pt2_n_tasks_max*pt2_type_size(N_states) & ! pt2_data_task - + N_det_generators*pt2_type_size(N_states) & ! pt2_data_I - + 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3 - + 1.d0*(N_int*2.d0*N + N) & ! selection buffer - + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer - ) / 1024.d0**3 - - integer :: nproc_target, ii - nproc_target = nthreads_pt2 - ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) - - do - mem = mem_collector + & ! - nproc_target * 8.d0 * & ! bytes - ( 0.5d0*pt2_n_tasks_max & ! task_id - + 64.d0*pt2_n_tasks_max & ! task - + pt2_type_size(N_states)*pt2_n_tasks_max*N_states & ! pt2, variance, overlap - + 1.d0*pt2_n_tasks_max & ! i_generator, subset - + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer - + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer - + 2.0d0*(ii) & ! preinteresting, interesting, - ! prefullinteresting, fullinteresting - + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist - + 1.0d0*(N_states*mo_num*mo_num) & ! mat - ) / 1024.d0**3 - - if (nproc_target == 0) then - call check_mem(mem,irp_here) - nproc_target = 1 - exit - endif - - if (mem+rss < qp_max_mem) then - exit - endif - - nproc_target = nproc_target - 1 - - enddo - call write_int(6,nproc_target,'Number of threads for PT2') - call write_double(6,mem,'Memory (Gb)') - - call set_multiple_levels_omp(.False.) - - - print '(A)', '========== ==================== ================ ================ ================ ============= ===========' - print '(A)', ' Samples Energy PT2 Variance Norm^2 Convergence Seconds' - print '(A)', '========== ==================== ================ ================ ================ ============= ===========' - - PROVIDE global_selection_buffer - - !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) & - !$OMP PRIVATE(i) - i = omp_get_thread_num() - if (i==0) then - - call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, pt2_data, pt2_data_err, b, N) - pt2_data % rpt2(pt2_stoch_istate) = & - pt2_data % pt2(pt2_stoch_istate)/(1.d0+pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate)) - - !TODO : We should use here the correct formula for the error of X/Y - pt2_data_err % rpt2(pt2_stoch_istate) = & - pt2_data_err % pt2(pt2_stoch_istate)/(1.d0 + pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate)) - - else - call pt2_slave_inproc(i) - endif - !$OMP END PARALLEL - call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') - call set_multiple_levels_omp(.True.) - - print '(A)', '========== ==================== ================ ================ ================ ============= ===========' - - - do k=1,N_states - pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate) - enddo - SOFT_TOUCH pt2_overlap - - enddo - FREE pt2_stoch_istate - - ! Symmetrize overlap - do j=2,N_states - do i=1,j-1 - pt2_overlap(i,j) = 0.5d0 * (pt2_overlap(i,j) + pt2_overlap(j,i)) - pt2_overlap(j,i) = pt2_overlap(i,j) - enddo - enddo - - print *, 'Overlap of perturbed states:' - do k=1,N_states - print *, pt2_overlap(k,:) - enddo - print *, '-------' - - if (N_in > 0) then - b%cur = min(N_in,b%cur) - if (s2_eig) then - call make_selection_buffer_s2(b) - else - call remove_duplicates_in_selection_buffer(b) - endif - call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) - endif - call delete_selection_buffer(b) - - state_average_weight(:) = state_average_weight_save(:) - TOUCH state_average_weight - call update_pt2_and_variance_weights(pt2_data, N_states) - endif - - -end subroutine - - -subroutine pt2_slave_inproc(i) - implicit none - integer, intent(in) :: i - - PROVIDE global_selection_buffer - call run_pt2_slave(1,i,pt2_e0_denominator) +subroutine provide_for_zmq_pt2 + PROVIDE psi_selectors_coef_transp psi_det_sorted psi_det_sorted_order end - - -subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_err, b, N_) - use f77_zmq - use selection_types - use bitmasks - implicit none - - - integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - double precision, intent(in) :: relative_error, E - type(pt2_type), intent(inout) :: pt2_data, pt2_data_err - type(selection_buffer), intent(inout) :: b - integer, intent(in) :: N_ - - type(pt2_type), allocatable :: pt2_data_task(:) - type(pt2_type), allocatable :: pt2_data_I(:) - type(pt2_type), allocatable :: pt2_data_S(:) - type(pt2_type), allocatable :: pt2_data_S2(:) - type(pt2_type) :: pt2_data_teeth - integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - integer, external :: zmq_delete_tasks_async_send - integer, external :: zmq_delete_tasks_async_recv - integer, external :: zmq_abort - integer, external :: pt2_find_sample_lr - - PROVIDE pt2_stoch_istate - - integer :: more, n, i, p, c, t, n_tasks, U - integer, allocatable :: task_id(:) - integer, allocatable :: index(:) - - double precision :: v, x, x2, x3, avg, avg2, avg3(N_states), eqt, E0, v0, n0(N_states) - double precision :: eqta(N_states) - double precision :: time, time1, time0 - - integer, allocatable :: f(:) - logical, allocatable :: d(:) - logical :: do_exit, stop_now, sending - logical, external :: qp_stop - type(selection_buffer) :: b2 - - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - - character(len=20) :: format_str1, str_error1, format_str2, str_error2 - character(len=20) :: format_str3, str_error3, format_str4, str_error4 - character(len=20) :: format_value1, format_value2, format_value3, format_value4 - character(len=20) :: str_value1, str_value2, str_value3, str_value4 - character(len=20) :: str_conv - double precision :: value1, value2, value3, value4 - double precision :: error1, error2, error3, error4 - integer :: size1,size2,size3,size4 - - double precision :: conv_crit - - sending =.False. - - rss = memory_of_int(pt2_n_tasks_max*2+N_det_generators*2) - rss += memory_of_double(N_states*N_det_generators)*3.d0 - rss += memory_of_double(N_states*pt2_n_tasks_max)*3.d0 - rss += memory_of_double(pt2_N_teeth+1)*4.d0 - call check_mem(rss,irp_here) - - ! If an allocation is added here, the estimate of the memory should also be - ! updated in ZMQ_pt2 - allocate(task_id(pt2_n_tasks_max), index(pt2_n_tasks_max), f(N_det_generators)) - allocate(d(N_det_generators+1)) - allocate(pt2_data_task(pt2_n_tasks_max)) - allocate(pt2_data_I(N_det_generators)) - allocate(pt2_data_S(pt2_N_teeth+1)) - allocate(pt2_data_S2(pt2_N_teeth+1)) - - - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - call create_selection_buffer(N_, N_*2, b2) - - - pt2_data % pt2(pt2_stoch_istate) = -huge(1.) - pt2_data_err % pt2(pt2_stoch_istate) = huge(1.) - pt2_data % variance(pt2_stoch_istate) = huge(1.) - pt2_data_err % variance(pt2_stoch_istate) = huge(1.) - pt2_data % overlap(:,pt2_stoch_istate) = 0.d0 - pt2_data_err % overlap(:,pt2_stoch_istate) = huge(1.) - n = 1 - t = 0 - U = 0 - do i=1,pt2_n_tasks_max - call pt2_alloc(pt2_data_task(i),N_states) - enddo - do i=1,pt2_N_teeth+1 - call pt2_alloc(pt2_data_S(i),N_states) - call pt2_alloc(pt2_data_S2(i),N_states) - enddo - do i=1,N_det_generators - call pt2_alloc(pt2_data_I(i),N_states) - enddo - f(:) = pt2_F(:) - d(:) = .false. - n_tasks = 0 - E0 = E - v0 = 0.d0 - n0(:) = 0.d0 - more = 1 - call wall_time(time0) - time1 = time0 - - do_exit = .false. - stop_now = .false. - do while (n <= N_det_generators) - if(f(pt2_J(n)) == 0) then - d(pt2_J(n)) = .true. - do while(d(U+1)) - U += 1 - end do - - ! Deterministic part - do while(t <= pt2_N_teeth) - if(U >= pt2_n_0(t+1)) then - t=t+1 - E0 = 0.d0 - v0 = 0.d0 - n0(:) = 0.d0 - do i=pt2_n_0(t),1,-1 - E0 += pt2_data_I(i) % pt2(pt2_stoch_istate) - v0 += pt2_data_I(i) % variance(pt2_stoch_istate) - n0(:) += pt2_data_I(i) % overlap(:,pt2_stoch_istate) - end do - else - exit - end if - end do - - ! Add Stochastic part - c = pt2_R(n) - if(c > 0) then - - call pt2_alloc(pt2_data_teeth,N_states) - do p=pt2_N_teeth, 1, -1 - v = pt2_u_0 + pt2_W_T * (pt2_u(c) + dble(p-1)) - i = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(p),pt2_n_0(p+1)) - v = pt2_W_T / pt2_w(i) - call pt2_add ( pt2_data_teeth, v, pt2_data_I(i) ) - call pt2_add ( pt2_data_S(p), 1.d0, pt2_data_teeth ) - call pt2_add2( pt2_data_S2(p), 1.d0, pt2_data_teeth ) - enddo - call pt2_dealloc(pt2_data_teeth) - - avg = E0 + pt2_data_S(t) % pt2(pt2_stoch_istate) / dble(c) - avg2 = v0 + pt2_data_S(t) % variance(pt2_stoch_istate) / dble(c) - avg3(:) = n0(:) + pt2_data_S(t) % overlap(:,pt2_stoch_istate) / dble(c) - if ((avg /= 0.d0) .or. (n == N_det_generators) ) then - do_exit = .true. - endif - if (qp_stop()) then - stop_now = .True. - endif - pt2_data % pt2(pt2_stoch_istate) = avg - pt2_data % variance(pt2_stoch_istate) = avg2 - pt2_data % overlap(:,pt2_stoch_istate) = avg3(:) - call wall_time(time) - ! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969) - if(c > 2) then - eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = dsqrt(eqt / (dble(c) - 1.5d0)) - pt2_data_err % pt2(pt2_stoch_istate) = eqt - - eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = dsqrt(eqt / (dble(c) - 1.5d0)) - pt2_data_err % variance(pt2_stoch_istate) = eqt - - eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqta(:) = dsqrt(eqta(:) / (dble(c) - 1.5d0)) - pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:) - - - if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then - time1 = time - - value1 = pt2_data % pt2(pt2_stoch_istate) + E - error1 = pt2_data_err % pt2(pt2_stoch_istate) - value2 = pt2_data % pt2(pt2_stoch_istate) - error2 = pt2_data_err % pt2(pt2_stoch_istate) - value3 = pt2_data % variance(pt2_stoch_istate) - error3 = pt2_data_err % variance(pt2_stoch_istate) - value4 = pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate) - error4 = pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate) - - ! Max size of the values (FX.Y) with X=size - size1 = 15 - size2 = 12 - size3 = 12 - size4 = 12 - - ! To generate the format: number(error) - call format_w_error(value1,error1,size1,8,format_value1,str_error1) - call format_w_error(value2,error2,size2,8,format_value2,str_error2) - call format_w_error(value3,error3,size3,8,format_value3,str_error3) - call format_w_error(value4,error4,size4,8,format_value4,str_error4) - - ! value > string with the right format - write(str_value1,'('//format_value1//')') value1 - write(str_value2,'('//format_value2//')') value2 - write(str_value3,'('//format_value3//')') value3 - write(str_value4,'('//format_value4//')') value4 - - ! Convergence criterion - conv_crit = dabs(pt2_data_err % pt2(pt2_stoch_istate)) / & - (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) - write(str_conv,'(G10.3)') conv_crit - - write(*,'(I10,X,X,A20,X,A16,X,A16,X,A16,X,A12,X,F10.1)') c,& - adjustl(adjustr(str_value1)//'('//str_error1(1:1)//')'),& - adjustl(adjustr(str_value2)//'('//str_error2(1:1)//')'),& - adjustl(adjustr(str_value3)//'('//str_error3(1:1)//')'),& - adjustl(adjustr(str_value4)//'('//str_error4(1:1)//')'),& - adjustl(str_conv),& - time-time0 - - ! Old print - !print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.1,ES16.6,ES16.6)', c, & - ! pt2_data % pt2(pt2_stoch_istate) +E, & - ! pt2_data_err % pt2(pt2_stoch_istate), & - ! pt2_data % variance(pt2_stoch_istate), & - ! pt2_data_err % variance(pt2_stoch_istate), & - ! pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate), & - ! pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate), & - ! time-time0, & - ! pt2_data % pt2(pt2_stoch_istate), & - ! dabs(pt2_data_err % pt2(pt2_stoch_istate)) / & - ! (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) - - if (stop_now .or. ( & - (do_exit .and. (dabs(pt2_data_err % pt2(pt2_stoch_istate)) / & - (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) <= relative_error))) ) then - if (zmq_abort(zmq_to_qp_run_socket) == -1) then - call sleep(10) - if (zmq_abort(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Error in sending abort signal (2)' - endif - endif - endif - endif - endif - end if - n += 1 - else if(more == 0) then - exit - else - call pull_pt2_results(zmq_socket_pull, index, pt2_data_task, task_id, n_tasks, b2) - if(n_tasks > pt2_n_tasks_max)then - print*,'PB !!!' - print*,'If you see this, send a bug report with the following content' - print*,irp_here - print*,'n_tasks,pt2_n_tasks_max = ',n_tasks,pt2_n_tasks_max - stop -1 - endif - if (zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_tasks,sending) == -1) then - stop 'PT2: Unable to delete tasks (send)' - endif - do i=1,n_tasks - if(index(i).gt.size(pt2_data_I,1).or.index(i).lt.1)then - print*,'PB !!!' - print*,'If you see this, send a bug report with the following content' - print*,irp_here - print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1) - stop -1 - endif - call pt2_add(pt2_data_I(index(i)),1.d0,pt2_data_task(i)) - f(index(i)) -= 1 - end do - do i=1, b2%cur - ! We assume the pulled buffer is sorted - if (b2%val(i) > b%mini) exit - call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i)) - end do - if (zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,more,sending) == -1) then - stop 'PT2: Unable to delete tasks (recv)' - endif - end if - end do - do i=1,N_det_generators - call pt2_dealloc(pt2_data_I(i)) - enddo - do i=1,pt2_N_teeth+1 - call pt2_dealloc(pt2_data_S(i)) - call pt2_dealloc(pt2_data_S2(i)) - enddo - do i=1,pt2_n_tasks_max - call pt2_dealloc(pt2_data_task(i)) - enddo -!print *, 'deleting b2' - call delete_selection_buffer(b2) -!print *, 'sorting b' - call sort_selection_buffer(b) -!print *, 'done' - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - -end subroutine - - -integer function pt2_find_sample(v, w) - implicit none - double precision, intent(in) :: v, w(0:N_det_generators) - integer, external :: pt2_find_sample_lr - - pt2_find_sample = pt2_find_sample_lr(v, w, 0, N_det_generators) -end function - - -integer function pt2_find_sample_lr(v, w, l_in, r_in) - implicit none - double precision, intent(in) :: v, w(0:N_det_generators) - integer, intent(in) :: l_in,r_in - integer :: i,l,r - - l=l_in - r=r_in - - do while(r-l > 1) - i = shiftr(r+l,1) - if(w(i) < v) then - l = i - else - r = i - end if - end do - i = r - do r=i+1,N_det_generators - if (w(r) /= w(i)) then - exit - endif - enddo - pt2_find_sample_lr = r-1 -end function - - -BEGIN_PROVIDER [ integer, pt2_n_tasks ] - implicit none - BEGIN_DOC - ! Number of parallel tasks for the Monte Carlo - END_DOC - pt2_n_tasks = N_det_generators -END_PROVIDER - -BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)] - implicit none - integer, allocatable :: seed(:) - integer :: m,i - call random_seed(size=m) - allocate(seed(m)) - do i=1,m - seed(i) = i - enddo - call random_seed(put=seed) - deallocate(seed) - - call RANDOM_NUMBER(pt2_u) - END_PROVIDER - - BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)] -&BEGIN_PROVIDER[ integer, pt2_R, (N_det_generators)] - implicit none - BEGIN_DOC -! pt2_J contains the list of generators after ordering them according to the -! Monte Carlo sampling. -! -! pt2_R(i) is the number of combs drawn when determinant i is computed. - END_DOC - integer :: N_c, N_j - integer :: U, t, i - double precision :: v - integer, external :: pt2_find_sample_lr - - logical, allocatable :: pt2_d(:) - integer :: m,l,r,k - integer :: ncache - integer, allocatable :: ii(:,:) - double precision :: dt - - ncache = min(N_det_generators,10000) - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - rss = memory_of_int(ncache)*dble(pt2_N_teeth) + memory_of_int(N_det_generators) - call check_mem(rss,irp_here) - - allocate(ii(pt2_N_teeth,ncache),pt2_d(N_det_generators)) - - pt2_R(:) = 0 - pt2_d(:) = .false. - N_c = 0 - N_j = pt2_n_0(1) - do i=1,N_j - pt2_d(i) = .true. - pt2_J(i) = i - end do - - U = 0 - do while(N_j < pt2_n_tasks) - - if (N_c+ncache > N_det_generators) then - ncache = N_det_generators - N_c - endif - - !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(dt,v,t,k) - do k=1, ncache - dt = pt2_u_0 - do t=1, pt2_N_teeth - v = dt + pt2_W_T *pt2_u(N_c+k) - dt = dt + pt2_W_T - ii(t,k) = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(t),pt2_n_0(t+1)) - end do - enddo - !$OMP END PARALLEL DO - - do k=1,ncache - !ADD_COMB - N_c = N_c+1 - do t=1, pt2_N_teeth - i = ii(t,k) - if(.not. pt2_d(i)) then - N_j += 1 - pt2_J(N_j) = i - pt2_d(i) = .true. - end if - end do - - pt2_R(N_j) = N_c - - !FILL_TOOTH - do while(U < N_det_generators) - U += 1 - if(.not. pt2_d(U)) then - N_j += 1 - pt2_J(N_j) = U - pt2_d(U) = .true. - exit - end if - end do - if (N_j >= pt2_n_tasks) exit - end do - enddo - - if(N_det_generators > 1) then - pt2_R(N_det_generators-1) = 0 - pt2_R(N_det_generators) = N_c - end if - - deallocate(ii,pt2_d) - -END_PROVIDER - - - - BEGIN_PROVIDER [ double precision, pt2_w, (N_det_generators) ] -&BEGIN_PROVIDER [ double precision, pt2_cW, (0:N_det_generators) ] -&BEGIN_PROVIDER [ double precision, pt2_W_T ] -&BEGIN_PROVIDER [ double precision, pt2_u_0 ] -&BEGIN_PROVIDER [ integer, pt2_n_0, (pt2_N_teeth+1) ] - implicit none - integer :: i, t - double precision, allocatable :: tilde_w(:), tilde_cW(:) - double precision :: r, tooth_width - integer, external :: pt2_find_sample - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - rss = memory_of_double(2*N_det_generators+1) - call check_mem(rss,irp_here) - - if (N_det_generators == 1) then - - pt2_w(1) = 1.d0 - pt2_cw(1) = 1.d0 - pt2_u_0 = 1.d0 - pt2_W_T = 0.d0 - pt2_n_0(1) = 0 - pt2_n_0(2) = 1 - - else - - allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) - - tilde_cW(0) = 0d0 - - do i=1,N_det_generators - tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20 - enddo - - double precision :: norm2 - norm2 = 0.d0 - do i=N_det_generators,1,-1 - norm2 += tilde_w(i) - enddo - - tilde_w(:) = tilde_w(:) / norm2 - - tilde_cW(0) = -1.d0 - do i=1,N_det_generators - tilde_cW(i) = tilde_cW(i-1) + tilde_w(i) - enddo - tilde_cW(:) = tilde_cW(:) + 1.d0 - - pt2_n_0(1) = 0 - do - pt2_u_0 = tilde_cW(pt2_n_0(1)) - r = tilde_cW(pt2_n_0(1) + pt2_minDetInFirstTeeth) - pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth) - if(pt2_W_T >= r - pt2_u_0) then - exit - end if - pt2_n_0(1) += 1 - if(N_det_generators - pt2_n_0(1) < pt2_minDetInFirstTeeth * pt2_N_teeth) then - print *, "teeth building failed" - stop -1 - end if - end do - - do t=2, pt2_N_teeth - r = pt2_u_0 + pt2_W_T * dble(t-1) - pt2_n_0(t) = pt2_find_sample(r, tilde_cW) - end do - pt2_n_0(pt2_N_teeth+1) = N_det_generators - - pt2_w(:pt2_n_0(1)) = tilde_w(:pt2_n_0(1)) - do t=1, pt2_N_teeth - tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t)) - if (tooth_width == 0.d0) then - tooth_width = max(1.d-15,sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1)))) - endif - ASSERT(tooth_width > 0.d0) - do i=pt2_n_0(t)+1, pt2_n_0(t+1) - pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width - end do - end do - - pt2_cW(0) = 0d0 - do i=1,N_det_generators - pt2_cW(i) = pt2_cW(i-1) + pt2_w(i) - end do - pt2_n_0(pt2_N_teeth+1) = N_det_generators - - endif -END_PROVIDER - - - - - diff --git a/src/generators_full_tc/README.rst b/src/generators_full_tc/README.rst new file mode 100644 index 00000000..4e59ee3b --- /dev/null +++ b/src/generators_full_tc/README.rst @@ -0,0 +1,9 @@ +=============== +generators_full +=============== + +Module defining the generator determinants as all the determinants of the +variational space. + +This module is intended to be included in the :file:`NEED` file to define +a full set of generators. diff --git a/plugins/local/fci_tc_bi/generators.irp.f b/src/generators_full_tc/generators.irp.f similarity index 51% rename from plugins/local/fci_tc_bi/generators.irp.f rename to src/generators_full_tc/generators.irp.f index bf972423..a9da7dbc 100644 --- a/plugins/local/fci_tc_bi/generators.irp.f +++ b/src/generators_full_tc/generators.irp.f @@ -34,23 +34,49 @@ END_PROVIDER END_PROVIDER - BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc_gen, (N_int,2,psi_det_size) ] -&BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc_gen, (psi_det_size,N_states) ] -&BEGIN_PROVIDER [ integer, psi_det_sorted_tc_gen_order, (psi_det_size) ] + BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_gen, (N_int,2,psi_det_size) ] +&BEGIN_PROVIDER [ double precision, psi_coef_sorted_gen, (psi_det_size,N_states) ] +&BEGIN_PROVIDER [ integer, psi_det_sorted_gen_order, (psi_det_size) ] implicit none BEGIN_DOC ! For Single reference wave functions, the generator is the ! Hartree-Fock determinant END_DOC - psi_det_sorted_tc_gen = psi_det_sorted_tc - psi_coef_sorted_tc_gen = psi_coef_sorted_tc - psi_det_sorted_tc_gen_order = psi_det_sorted_tc_order - integer :: i -! do i = 1,N_det -! print*,'i = ',i -! call debug_det(psi_det_sorted_tc(1,1,i),N_int) -! enddo + psi_det_sorted_gen = psi_det_sorted_tc + psi_coef_sorted_gen = psi_coef_sorted_tc + psi_det_sorted_gen_order = psi_det_sorted_tc_order END_PROVIDER +BEGIN_PROVIDER [integer, degree_max_generators] + implicit none + BEGIN_DOC +! Max degree of excitation (respect to HF) of the generators + END_DOC + integer :: i,degree + degree_max_generators = 0 + do i = 1, N_det_generators + call get_excitation_degree(HF_bitmask,psi_det_generators(1,1,i),degree,N_int) + if(degree .gt. degree_max_generators)then + degree_max_generators = degree + endif + enddo +END_PROVIDER + +BEGIN_PROVIDER [ integer, size_select_max] + implicit none + BEGIN_DOC + ! Size of the select_max array + END_DOC + size_select_max = 10000 +END_PROVIDER + +BEGIN_PROVIDER [ double precision, select_max, (size_select_max) ] + implicit none + BEGIN_DOC + ! Memo to skip useless selectors + END_DOC + select_max = huge(1.d0) +END_PROVIDER + From 9a15fecd6a164375ead8684c6a836147b548f4fa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 12 Mar 2024 16:42:08 +0100 Subject: [PATCH 15/64] Merging CIPSI and TC-CIPSI --- .../cipsi_tc_bi_ortho/zmq_selection.irp.f | 234 ------------------ .../zmq_selection.irp.f | 0 2 files changed, 234 deletions(-) delete mode 100644 plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f rename src/{cipsi => cipsi_utils}/zmq_selection.irp.f (100%) diff --git a/plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f deleted file mode 100644 index 22db643f..00000000 --- a/plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f +++ /dev/null @@ -1,234 +0,0 @@ -subroutine ZMQ_selection(N_in, pt2_data) - use f77_zmq - use selection_types - - implicit none - - integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull - integer, intent(in) :: N_in - type(selection_buffer) :: b - integer :: i, l, N - integer, external :: omp_get_thread_num - type(pt2_type), intent(inout) :: pt2_data - -! PROVIDE psi_det psi_coef N_det qp_max_mem N_states pt2_F s2_eig N_det_generators - - N = max(N_in,1) - N = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2) - if (.True.) then - PROVIDE pt2_e0_denominator nproc - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order selection_weight pseudo_sym - PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max - PROVIDE excitation_beta_max excitation_alpha_max excitation_max - - call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'selection') - - integer, external :: zmq_put_psi - integer, external :: zmq_put_N_det_generators - integer, external :: zmq_put_N_det_selectors - integer, external :: zmq_put_dvector - - if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then - stop 'Unable to put psi on ZMQ server' - endif - if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_generators on ZMQ server' - endif - if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then - stop 'Unable to put N_det_selectors on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then - stop 'Unable to put energy on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then - stop 'Unable to put state_average_weight on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then - stop 'Unable to put selection_weight on ZMQ server' - endif - if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) then - stop 'Unable to put threshold_generators on ZMQ server' - endif - call create_selection_buffer(N, N*2, b) - endif - - integer, external :: add_task_to_taskserver - character(len=100000) :: task - integer :: j,k,ipos - ipos=1 - task = ' ' - - do i= 1, N_det_generators - do j=1,pt2_F(i) - write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, i, N - ipos += 30 - if (ipos > 100000-30) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - ipos=1 - endif - end do - enddo - if (ipos > 1) then - if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then - stop 'Unable to add task to task server' - endif - endif - N = max(N_in,1) - - - ASSERT (associated(b%det)) - ASSERT (associated(b%val)) - - integer, external :: zmq_set_running - if (zmq_set_running(zmq_to_qp_run_socket) == -1) then - print *, irp_here, ': Failed in zmq_set_running' - endif - - integer :: nproc_target - if (N_det < 3*nproc) then - nproc_target = N_det/4 - else - nproc_target = nproc - endif - double precision :: mem - mem = 8.d0 * N_det * (N_int * 2.d0 * 3.d0 + 3.d0 + 5.d0) / (1024.d0**3) - call write_double(6,mem,'Estimated memory/thread (Gb)') - if (qp_max_mem > 0) then - nproc_target = max(1,int(dble(qp_max_mem)/(0.1d0 + mem))) - nproc_target = min(nproc_target,nproc) - endif - - f(:) = 1.d0 - if (.not.do_pt2) then - double precision :: f(N_states), u_dot_u - do k=1,min(N_det,N_states) - f(k) = 1.d0 / u_dot_u(psi_selectors_coef(1,k), N_det_selectors) - enddo - endif - - !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2_data) PRIVATE(i) NUM_THREADS(nproc_target+1) - i = omp_get_thread_num() - if (i==0) then - call selection_collector(zmq_socket_pull, b, N, pt2_data) - else - call selection_slave_inproc(i) - endif - !$OMP END PARALLEL - - call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'selection') - if (N_in > 0) then - if (s2_eig) then - call make_selection_buffer_s2(b) - endif - call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) - endif - call delete_selection_buffer(b) - - do k=1,N_states - pt2_data % pt2(k) = pt2_data % pt2(k) * f(k) - pt2_data % variance(k) = pt2_data % variance(k) * f(k) - do l=1,N_states - pt2_data % overlap(k,l) = pt2_data % overlap(k,l) * dsqrt(f(k)*f(l)) - pt2_data % overlap(l,k) = pt2_data % overlap(l,k) * dsqrt(f(k)*f(l)) - enddo - - pt2_data % rpt2(k) = & - pt2_data % pt2(k)/(1.d0 + pt2_data % overlap(k,k)) - enddo - - pt2_overlap(:,:) = pt2_data % overlap(:,:) - - print *, 'Overlap of perturbed states:' - do l=1,N_states - print *, pt2_overlap(l,:) - enddo - print *, '-------' - SOFT_TOUCH pt2_overlap - call update_pt2_and_variance_weights(pt2_data, N_states) - -end subroutine - - -subroutine selection_slave_inproc(i) - implicit none - integer, intent(in) :: i - - call run_selection_slave(1,i,pt2_e0_denominator) -end - -subroutine selection_collector(zmq_socket_pull, b, N, pt2_data) - use f77_zmq - use selection_types - use bitmasks - implicit none - - - integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - type(selection_buffer), intent(inout) :: b - integer, intent(in) :: N - type(pt2_type), intent(inout) :: pt2_data - type(pt2_type) :: pt2_data_tmp - - double precision :: pt2_mwen(N_states) - double precision :: variance_mwen(N_states) - double precision :: norm2_mwen(N_states) - integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - - integer(ZMQ_PTR), external :: new_zmq_pull_socket - - integer :: msg_size, rc, more - integer :: acc, i, j, robin, ntask - double precision, pointer :: val(:) - integer(bit_kind), pointer :: det(:,:,:) - integer, allocatable :: task_id(:) - type(selection_buffer) :: b2 - - - - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - call create_selection_buffer(N, N*2, b2) - integer :: k - double precision :: rss - double precision, external :: memory_of_int - rss = memory_of_int(N_det_generators) - call check_mem(rss,irp_here) - allocate(task_id(N_det_generators)) - more = 1 - pt2_data % pt2(:) = 0d0 - pt2_data % variance(:) = 0.d0 - pt2_data % overlap(:,:) = 0.d0 - call pt2_alloc(pt2_data_tmp,N_states) - do while (more == 1) - call pull_selection_results(zmq_socket_pull, pt2_data_tmp, b2%val(1), b2%det(1,1,1), b2%cur, task_id, ntask) - - call pt2_add(pt2_data, 1.d0, pt2_data_tmp) - do i=1, b2%cur - call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i)) - if (b2%val(i) > b%mini) exit - end do - - do i=1, ntask - if(task_id(i) == 0) then - print *, "Error in collector" - endif - integer, external :: zmq_delete_task - if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id(i),more) == -1) then - stop 'Unable to delete task' - endif - end do - end do - call pt2_dealloc(pt2_data_tmp) - - - call delete_selection_buffer(b2) - call sort_selection_buffer(b) - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) -end subroutine - diff --git a/src/cipsi/zmq_selection.irp.f b/src/cipsi_utils/zmq_selection.irp.f similarity index 100% rename from src/cipsi/zmq_selection.irp.f rename to src/cipsi_utils/zmq_selection.irp.f From 1769efddca34f996d0d3a169bea08030c6a9e0ed Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 12 Mar 2024 16:52:53 +0100 Subject: [PATCH 16/64] fixed the qp_test of tc_scf --- plugins/local/tc_scf/11.tc_scf.bats | 44 ++++++++++++++++------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/plugins/local/tc_scf/11.tc_scf.bats b/plugins/local/tc_scf/11.tc_scf.bats index b81c2f4b..f5f2e3c1 100644 --- a/plugins/local/tc_scf/11.tc_scf.bats +++ b/plugins/local/tc_scf/11.tc_scf.bats @@ -10,16 +10,17 @@ function run_Ne() { qp create_ezfio -b cc-pcvdz Ne.xyz -o Ne_tc_scf qp run scf + qp set tc_keywords tc_integ_type numeric + qp set jastrow env_type Sum_Gauss qp set hamiltonian mu_erf 0.87 - qp set tc_keywords j1b_type 3 - qp set tc_keywords j1b_pen [1.5] - qp set tc_keywords bi_ortho True - qp set tc_keywords test_cycle_tc True + qp set jastrow j1e_type None + qp set jastrow env_coef "[1.]" + qp set jastrow env_expo "[1.5]" qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out eref=-128.552134 energy="$(qp get tc_scf bitc_energy)" - eq $energy $eref 1e-6 + eq $energy $eref 2e-4 } @@ -33,16 +34,17 @@ function run_C() { qp create_ezfio -b cc-pcvdz C.xyz -o C_tc_scf -m 3 qp run scf + qp set tc_keywords tc_integ_type numeric + qp set jastrow env_type Sum_Gauss qp set hamiltonian mu_erf 0.87 - qp set tc_keywords j1b_type 3 - qp set tc_keywords j1b_pen [1.5] - qp set tc_keywords bi_ortho True - qp set tc_keywords test_cycle_tc True + qp set jastrow j1e_type None + qp set jastrow env_coef "[1.]" + qp set jastrow env_expo "[1.5]" qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out eref=-37.691254356408791 energy="$(qp get tc_scf bitc_energy)" - eq $energy $eref 1e-6 + eq $energy $eref 2e-4 } @@ -57,16 +59,17 @@ function run_O() { qp create_ezfio -b cc-pcvdz O.xyz -o O_tc_scf -m 3 qp run scf + qp set tc_keywords tc_integ_type numeric + qp set jastrow env_type Sum_Gauss + qp set jastrow j1e_type None + qp set jastrow env_coef "[1.]" + qp set jastrow env_expo "[1.5]" qp set hamiltonian mu_erf 0.87 - qp set tc_keywords j1b_type 3 - qp set tc_keywords j1b_pen [1.5] - qp set tc_keywords bi_ortho True - qp set tc_keywords test_cycle_tc True qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out eref=-74.814687229354590 energy="$(qp get tc_scf bitc_energy)" - eq $energy $eref 1e-6 + eq $energy $eref 2e-4 } @@ -82,16 +85,17 @@ function run_ch2() { qp create_ezfio -b "C:cc-pcvdz|H:cc-pvdz" ch2.xyz -o ch2_tc_scf qp run scf + qp set tc_keywords tc_integ_type numeric + qp set jastrow env_type Sum_Gauss + qp set jastrow j1e_type None + qp set jastrow env_coef "[1., 1., 1.]" + qp set jastrow env_expo '[1.5,10000,10000]' qp set hamiltonian mu_erf 0.87 - qp set tc_keywords j1b_type 3 - qp set tc_keywords j1b_pen '[1.5,10000,10000]' - qp set tc_keywords bi_ortho True - qp set tc_keywords test_cycle_tc True qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out eref=-38.903247818077737 energy="$(qp get tc_scf bitc_energy)" - eq $energy $eref 1e-6 + eq $energy $eref 2e-4 } From a42c79ca34111ac449bdf2b18243ef38f9d4abe6 Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 12 Mar 2024 17:09:58 +0100 Subject: [PATCH 17/64] The test works for fci_tc_bi but not for tc_bi_ortho --- plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats b/plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats index 93bed2ab..33afcb92 100644 --- a/plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats +++ b/plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats @@ -14,7 +14,7 @@ function run_Ne() { qp run tc_bi_ortho | tee Ne_tc_scf.cisd_tc_bi_ortho.out eref=-128.77020441279302 energy=$(get_e Ne_tc_scf.cisd_tc_bi_ortho.out) - eq $energy $eref 1e-6 + eq $energy $eref 2e-4 } @@ -29,7 +29,7 @@ function run_C() { qp run tc_bi_ortho | tee C_tc_scf.cisd_tc_bi_ortho.out eref=-37.757536149952514 energy=$(get_e C_tc_scf.cisd_tc_bi_ortho.out) - eq $energy $eref 1e-6 + eq $energy $eref 2e-4 } @@ -43,7 +43,7 @@ function run_O() { qp run tc_bi_ortho | tee O_tc_scf.cisd_tc_bi_ortho.out eref=-74.908518517716161 energy=$(get_e O_tc_scf.cisd_tc_bi_ortho.out) - eq $energy $eref 1e-6 + eq $energy $eref 2e-4 } From f816773102c06547c1f8d3a5f5b492321b4fd84f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 12 Mar 2024 17:21:35 +0100 Subject: [PATCH 18/64] Refactor CIPSI / TC-CIPSI --- plugins/local/cipsi_tc_bi_ortho/energy.irp.f | 32 - .../local/cipsi_tc_bi_ortho/environment.irp.f | 14 - .../local/cipsi_tc_bi_ortho/lock_2rdm.irp.f | 0 .../cipsi_tc_bi_ortho/run_pt2_slave.irp.f | 546 ----------- .../run_selection_slave.irp.f | 261 +---- .../local/cipsi_tc_bi_ortho/selection.irp.f | 150 +-- .../cipsi_tc_bi_ortho/selection_buffer.irp.f | 424 --------- .../cipsi_tc_bi_ortho/selection_weight.irp.f | 134 --- .../local/cipsi_tc_bi_ortho/slave_cipsi.irp.f | 348 ------- src/cipsi/cipsi.irp.f | 11 +- src/cipsi/energy.irp.f | 9 - src/cipsi/lock_2rdm.irp.f | 0 src/cipsi/pt2_type.irp.f | 128 --- src/cipsi/run_selection_slave.irp.f | 259 +---- src/cipsi/selection.irp.f | 104 +- src/cipsi/selection_types.f90 | 25 - src/cipsi_utils/README.rst | 5 + src/{cipsi => cipsi_utils}/environment.irp.f | 0 src/cipsi_utils/pt2_stoch_routines.irp.f | 891 ++++++++++++++++++ .../cipsi_utils}/pt2_type.irp.f | 0 .../run_pt2_slave.irp.f | 0 src/cipsi_utils/run_selection_slave.irp.f | 257 +++++ .../selection_buffer.irp.f | 0 .../cipsi_utils}/selection_types.f90 | 0 .../selection_weight.irp.f | 0 src/{cipsi => cipsi_utils}/slave_cipsi.irp.f | 5 +- 26 files changed, 1303 insertions(+), 2300 deletions(-) delete mode 100644 plugins/local/cipsi_tc_bi_ortho/environment.irp.f delete mode 100644 plugins/local/cipsi_tc_bi_ortho/lock_2rdm.irp.f delete mode 100644 plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f delete mode 100644 plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f delete mode 100644 plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f delete mode 100644 plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f delete mode 100644 src/cipsi/lock_2rdm.irp.f delete mode 100644 src/cipsi/pt2_type.irp.f delete mode 100644 src/cipsi/selection_types.f90 create mode 100644 src/cipsi_utils/README.rst rename src/{cipsi => cipsi_utils}/environment.irp.f (100%) create mode 100644 src/cipsi_utils/pt2_stoch_routines.irp.f rename {plugins/local/cipsi_tc_bi_ortho => src/cipsi_utils}/pt2_type.irp.f (100%) rename src/{cipsi => cipsi_utils}/run_pt2_slave.irp.f (100%) create mode 100644 src/cipsi_utils/run_selection_slave.irp.f rename src/{cipsi => cipsi_utils}/selection_buffer.irp.f (100%) rename {plugins/local/cipsi_tc_bi_ortho => src/cipsi_utils}/selection_types.f90 (100%) rename src/{cipsi => cipsi_utils}/selection_weight.irp.f (100%) rename src/{cipsi => cipsi_utils}/slave_cipsi.irp.f (98%) diff --git a/plugins/local/cipsi_tc_bi_ortho/energy.irp.f b/plugins/local/cipsi_tc_bi_ortho/energy.irp.f index 16f4528e..3698e5c2 100644 --- a/plugins/local/cipsi_tc_bi_ortho/energy.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/energy.irp.f @@ -15,37 +15,5 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ] pt2_E0_denominator = eigval_right_tc_bi_orth -! if (initialize_pt2_E0_denominator) then -! if (h0_type == "EN") then -! pt2_E0_denominator(1:N_states) = psi_energy(1:N_states) -! else if (h0_type == "HF") then -! do i=1,N_states -! j = maxloc(abs(psi_coef(:,i)),1) -! pt2_E0_denominator(i) = psi_det_hii(j) -! enddo -! else if (h0_type == "Barycentric") then -! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) -! else if (h0_type == "CFG") then -! pt2_E0_denominator(1:N_states) = psi_energy(1:N_states) -! else -! print *, h0_type, ' not implemented' -! stop -! endif -! do i=1,N_states -! call write_double(6,pt2_E0_denominator(i)+nuclear_repulsion, 'PT2 Energy denominator') -! enddo -! else -! pt2_E0_denominator = -huge(1.d0) -! endif - -END_PROVIDER - - -BEGIN_PROVIDER [ double precision, pt2_overlap, (N_states, N_states) ] - implicit none - BEGIN_DOC - ! Overlap between the perturbed wave functions - END_DOC - pt2_overlap(1:N_states,1:N_states) = 0.d0 END_PROVIDER diff --git a/plugins/local/cipsi_tc_bi_ortho/environment.irp.f b/plugins/local/cipsi_tc_bi_ortho/environment.irp.f deleted file mode 100644 index 5c0e0820..00000000 --- a/plugins/local/cipsi_tc_bi_ortho/environment.irp.f +++ /dev/null @@ -1,14 +0,0 @@ -BEGIN_PROVIDER [ integer, nthreads_pt2 ] - implicit none - BEGIN_DOC - ! Number of threads for Davidson - END_DOC - nthreads_pt2 = nproc - character*(32) :: env - call getenv('QP_NTHREADS_PT2',env) - if (trim(env) /= '') then - read(env,*) nthreads_pt2 - call write_int(6,nthreads_pt2,'Target number of threads for PT2') - endif -END_PROVIDER - diff --git a/plugins/local/cipsi_tc_bi_ortho/lock_2rdm.irp.f b/plugins/local/cipsi_tc_bi_ortho/lock_2rdm.irp.f deleted file mode 100644 index e69de29b..00000000 diff --git a/plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f b/plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f deleted file mode 100644 index d4f45649..00000000 --- a/plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f +++ /dev/null @@ -1,546 +0,0 @@ - use omp_lib - use selection_types - use f77_zmq -BEGIN_PROVIDER [ integer(omp_lock_kind), global_selection_buffer_lock ] - use omp_lib - implicit none - BEGIN_DOC - ! Global buffer for the OpenMP selection - END_DOC - call omp_init_lock(global_selection_buffer_lock) -END_PROVIDER - -BEGIN_PROVIDER [ type(selection_buffer), global_selection_buffer ] - use omp_lib - implicit none - BEGIN_DOC - ! Global buffer for the OpenMP selection - END_DOC - call omp_set_lock(global_selection_buffer_lock) - call delete_selection_buffer(global_selection_buffer) - call create_selection_buffer(N_det_generators, 2*N_det_generators, & - global_selection_buffer) - call omp_unset_lock(global_selection_buffer_lock) -END_PROVIDER - - -subroutine run_pt2_slave(thread,iproc,energy) - use selection_types - use f77_zmq - implicit none - - double precision, intent(in) :: energy(N_states_diag) - integer, intent(in) :: thread, iproc - call run_pt2_slave_large(thread,iproc,energy) -! if (N_det > 100000 ) then -! call run_pt2_slave_large(thread,iproc,energy) -! else -! call run_pt2_slave_small(thread,iproc,energy) -! endif -end - -subroutine run_pt2_slave_small(thread,iproc,energy) - use selection_types - use f77_zmq - implicit none - - double precision, intent(in) :: energy(N_states_diag) - integer, intent(in) :: thread, iproc - integer :: rc, i - - integer :: worker_id, ctask, ltask - character*(512), allocatable :: task(:) - integer, allocatable :: task_id(:) - - integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - - integer(ZMQ_PTR), external :: new_zmq_push_socket - integer(ZMQ_PTR) :: zmq_socket_push - - type(selection_buffer) :: b - logical :: done, buffer_ready - - type(pt2_type), allocatable :: pt2_data(:) - integer :: n_tasks, k, N - integer, allocatable :: i_generator(:), subset(:) - - double precision, external :: memory_of_double, memory_of_int - integer :: bsize ! Size of selection buffers - - allocate(task_id(pt2_n_tasks_max), task(pt2_n_tasks_max)) - allocate(pt2_data(pt2_n_tasks_max), i_generator(pt2_n_tasks_max), subset(pt2_n_tasks_max)) - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - - integer, external :: connect_to_taskserver - if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - return - endif - - zmq_socket_push = new_zmq_push_socket(thread) - - b%N = 0 - buffer_ready = .False. - n_tasks = 1 - - done = .False. - do while (.not.done) - - n_tasks = max(1,n_tasks) - n_tasks = min(pt2_n_tasks_max,n_tasks) - - integer, external :: get_tasks_from_taskserver - if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then - exit - endif - done = task_id(n_tasks) == 0 - if (done) then - n_tasks = n_tasks-1 - endif - if (n_tasks == 0) exit - - do k=1,n_tasks - call sscanf_ddd(task(k), subset(k), i_generator(k), N) - enddo - if (b%N == 0) then - ! Only first time - bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2) - call create_selection_buffer(bsize, bsize*2, b) - buffer_ready = .True. - else - ASSERT (b%N == bsize) - endif - - double precision :: time0, time1 - call wall_time(time0) - do k=1,n_tasks - call pt2_alloc(pt2_data(k),N_states) - b%cur = 0 - call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k))) - enddo - call wall_time(time1) - - integer, external :: tasks_done_to_taskserver - if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then - done = .true. - endif - call sort_selection_buffer(b) - call push_pt2_results(zmq_socket_push, i_generator, pt2_data, b, task_id, n_tasks) - do k=1,n_tasks - call pt2_dealloc(pt2_data(k)) - enddo - b%cur=0 - -! ! Try to adjust n_tasks around nproc/2 seconds per job - n_tasks = min(2*n_tasks,int( dble(n_tasks * nproc/2) / (time1 - time0 + 1.d0))) - n_tasks = min(n_tasks, pt2_n_tasks_max) -! n_tasks = 1 - end do - - integer, external :: disconnect_from_taskserver - do i=1,300 - if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) /= -2) exit - call usleep(500) - print *, 'Retry disconnect...' - end do - - call end_zmq_push_socket(zmq_socket_push,thread) - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - if (buffer_ready) then - call delete_selection_buffer(b) - endif - deallocate(pt2_data) -end subroutine - - -subroutine run_pt2_slave_large(thread,iproc,energy) - use selection_types - use f77_zmq - implicit none - - double precision, intent(in) :: energy(N_states_diag) - integer, intent(in) :: thread, iproc - integer :: rc, i - - integer :: worker_id, ctask, ltask - character*(512) :: task - integer :: task_id(1) - - integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - - integer(ZMQ_PTR), external :: new_zmq_push_socket - integer(ZMQ_PTR) :: zmq_socket_push - - type(selection_buffer) :: b - logical :: done, buffer_ready - - type(pt2_type) :: pt2_data - integer :: n_tasks, k, N - integer :: i_generator, subset - integer :: ifirst - - integer :: bsize ! Size of selection buffers - logical :: sending - PROVIDE global_selection_buffer global_selection_buffer_lock - - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - - integer, external :: connect_to_taskserver - if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - return - endif - - zmq_socket_push = new_zmq_push_socket(thread) - - ifirst = 0 - b%N = 0 - buffer_ready = .False. - n_tasks = 1 - - sending = .False. - done = .False. - do while (.not.done) - - integer, external :: get_tasks_from_taskserver - if (get_tasks_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task, n_tasks) == -1) then - exit - endif - done = task_id(1) == 0 - if (done) then - n_tasks = n_tasks-1 - endif - if (n_tasks == 0) exit - - call sscanf_ddd(task, subset, i_generator, N) - if( pt2_F(i_generator) <= 0 .or. pt2_F(i_generator) > N_det ) then - print *, irp_here - stop 'bug in selection' - endif - if (b%N == 0) then - ! Only first time - bsize = min(N, (elec_alpha_num * (mo_num-elec_alpha_num))**2) - call create_selection_buffer(bsize, bsize*2, b) - buffer_ready = .True. - else - ASSERT (b%N == bsize) - endif - - double precision :: time0, time1 - call wall_time(time0) - call pt2_alloc(pt2_data,N_states) - b%cur = 0 - call select_connected(i_generator,energy,pt2_data,b,subset,pt2_F(i_generator)) - call wall_time(time1) - - integer, external :: tasks_done_to_taskserver - if (tasks_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,n_tasks) == -1) then - done = .true. - endif - call sort_selection_buffer(b) - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) - call omp_set_lock(global_selection_buffer_lock) - global_selection_buffer%mini = b%mini - call merge_selection_buffers(b,global_selection_buffer) - if (ifirst /= 0 ) then - b%cur=0 - else - ifirst = 1 - endif - call omp_unset_lock(global_selection_buffer_lock) - if ( iproc == 1 ) then - call omp_set_lock(global_selection_buffer_lock) - call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) - global_selection_buffer%cur = 0 - call omp_unset_lock(global_selection_buffer_lock) - else - call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) - endif - - call pt2_dealloc(pt2_data) - end do - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) - - integer, external :: disconnect_from_taskserver - do i=1,300 - if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) /= -2) exit - call sleep(1) - print *, 'Retry disconnect...' - end do - - call end_zmq_push_socket(zmq_socket_push,thread) - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - if (buffer_ready) then - call delete_selection_buffer(b) - endif - FREE global_selection_buffer -end subroutine - - -subroutine push_pt2_results(zmq_socket_push, index, pt2_data, b, task_id, n_tasks) - use selection_types - use f77_zmq - implicit none - - integer(ZMQ_PTR), intent(in) :: zmq_socket_push - type(pt2_type), intent(in) :: pt2_data(n_tasks) - integer, intent(in) :: n_tasks, index(n_tasks), task_id(n_tasks) - type(selection_buffer), intent(inout) :: b - - logical :: sending - sending = .False. - call push_pt2_results_async_send(zmq_socket_push, index, pt2_data, b, task_id, n_tasks, sending) - call push_pt2_results_async_recv(zmq_socket_push, b%mini, sending) -end subroutine - - -subroutine push_pt2_results_async_send(zmq_socket_push, index, pt2_data, b, task_id, n_tasks, sending) - use selection_types - use f77_zmq - implicit none - - integer(ZMQ_PTR), intent(in) :: zmq_socket_push - type(pt2_type), intent(in) :: pt2_data(n_tasks) - integer, intent(in) :: n_tasks, index(n_tasks), task_id(n_tasks) - type(selection_buffer), intent(inout) :: b - logical, intent(inout) :: sending - integer :: rc, i - integer*8 :: rc8 - double precision, allocatable :: pt2_serialized(:,:) - - if (sending) then - print *, irp_here, ': sending is true' - stop -1 - endif - sending = .True. - - rc = f77_zmq_send( zmq_socket_push, n_tasks, 4, ZMQ_SNDMORE) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 1 - return - else if(rc /= 4) then - stop 'push' - endif - - - rc = f77_zmq_send( zmq_socket_push, index, 4*n_tasks, ZMQ_SNDMORE) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 2 - return - else if(rc /= 4*n_tasks) then - stop 'push' - endif - - - allocate(pt2_serialized (pt2_type_size(N_states),n_tasks) ) - do i=1,n_tasks - call pt2_serialize(pt2_data(i),N_states,pt2_serialized(1,i)) - enddo - - rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE) - deallocate(pt2_serialized) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 3 - return - else if(rc /= size(pt2_serialized)*8) then - stop 'push' - endif - - - rc = f77_zmq_send( zmq_socket_push, task_id, n_tasks*4, ZMQ_SNDMORE) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 6 - return - else if(rc /= 4*n_tasks) then - stop 'push' - endif - - - if (b%cur == 0) then - - rc = f77_zmq_send( zmq_socket_push, b%cur, 4, 0) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 7 - return - else if(rc /= 4) then - stop 'push' - endif - - else - - rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 7 - return - else if(rc /= 4) then - stop 'push' - endif - - - rc8 = f77_zmq_send8( zmq_socket_push, b%val, 8_8*int(b%cur,8), ZMQ_SNDMORE) - if (rc8 == -1_8) then - print *, irp_here, ': error sending result' - stop 8 - return - else if(rc8 /= 8_8*int(b%cur,8)) then - stop 'push' - endif - - - rc8 = f77_zmq_send8( zmq_socket_push, b%det, int(bit_kind*N_int*2,8)*int(b%cur,8), 0) - if (rc8 == -1_8) then - print *, irp_here, ': error sending result' - stop 9 - return - else if(rc8 /= int(N_int*2*8,8)*int(b%cur,8)) then - stop 'push' - endif - - endif - -end subroutine - -subroutine push_pt2_results_async_recv(zmq_socket_push,mini,sending) - use selection_types - use f77_zmq - implicit none - - integer(ZMQ_PTR), intent(in) :: zmq_socket_push - double precision, intent(out) :: mini - logical, intent(inout) :: sending - integer :: rc - - if (.not.sending) return - -! Activate is zmq_socket_push is a REQ -IRP_IF ZMQ_PUSH -IRP_ELSE - character*(2) :: ok - rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 10 - return - else if ((rc /= 2).and.(ok(1:2) /= 'ok')) then - print *, irp_here//': error in receiving ok' - stop -1 - endif - rc = f77_zmq_recv( zmq_socket_push, mini, 8, 0) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 11 - return - else if (rc /= 8) then - print *, irp_here//': error in receiving mini' - stop 12 - endif -IRP_ENDIF - sending = .False. -end subroutine - - - -subroutine pull_pt2_results(zmq_socket_pull, index, pt2_data, task_id, n_tasks, b) - use selection_types - use f77_zmq - implicit none - integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - type(pt2_type), intent(inout) :: pt2_data(*) - type(selection_buffer), intent(inout) :: b - integer, intent(out) :: index(*) - integer, intent(out) :: n_tasks, task_id(*) - integer :: rc, rn, i - integer*8 :: rc8 - double precision, allocatable :: pt2_serialized(:,:) - - rc = f77_zmq_recv( zmq_socket_pull, n_tasks, 4, 0) - if (rc == -1) then - n_tasks = 1 - task_id(1) = 0 - else if(rc /= 4) then - stop 'pull' - endif - - rc = f77_zmq_recv( zmq_socket_pull, index, 4*n_tasks, 0) - if (rc == -1) then - n_tasks = 1 - task_id(1) = 0 - else if(rc /= 4*n_tasks) then - stop 'pull' - endif - - allocate(pt2_serialized (pt2_type_size(N_states),n_tasks) ) - rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized)*n_tasks, 0) - if (rc == -1) then - n_tasks = 1 - task_id(1) = 0 - else if(rc /= 8*size(pt2_serialized)) then - stop 'pull' - endif - - do i=1,n_tasks - call pt2_deserialize(pt2_data(i),N_states,pt2_serialized(1,i)) - enddo - deallocate(pt2_serialized) - - rc = f77_zmq_recv( zmq_socket_pull, task_id, n_tasks*4, 0) - if (rc == -1) then - n_tasks = 1 - task_id(1) = 0 - else if(rc /= 4*n_tasks) then - stop 'pull' - endif - - rc = f77_zmq_recv( zmq_socket_pull, b%cur, 4, 0) - if (rc == -1) then - n_tasks = 1 - task_id(1) = 0 - else if(rc /= 4) then - stop 'pull' - endif - - if (b%cur > 0) then - - rc8 = f77_zmq_recv8( zmq_socket_pull, b%val, 8_8*int(b%cur,8), 0) - if (rc8 == -1_8) then - n_tasks = 1 - task_id(1) = 0 - else if(rc8 /= 8_8*int(b%cur,8)) then - stop 'pull' - endif - - rc8 = f77_zmq_recv8( zmq_socket_pull, b%det, int(bit_kind*N_int*2,8)*int(b%cur,8), 0) - if (rc8 == -1_8) then - n_tasks = 1 - task_id(1) = 0 - else if(rc8 /= int(N_int*2*8,8)*int(b%cur,8)) then - stop 'pull' - endif - - endif - -! Activate is zmq_socket_pull is a REP -IRP_IF ZMQ_PUSH -IRP_ELSE - rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, ZMQ_SNDMORE) - if (rc == -1) then - n_tasks = 1 - task_id(1) = 0 - else if (rc /= 2) then - print *, irp_here//': error in sending ok' - stop -1 - endif - rc = f77_zmq_send( zmq_socket_pull, b%mini, 8, 0) -IRP_ENDIF - -end subroutine - diff --git a/plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f b/plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f index 39c83c4b..aaf2f31d 100644 --- a/plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f @@ -1,258 +1,5 @@ -subroutine run_selection_slave(thread, iproc, energy) - - use f77_zmq - use selection_types - - implicit none - - double precision, intent(in) :: energy(N_states) - integer, intent(in) :: thread, iproc - integer :: rc, i - - integer :: worker_id, task_id(1), ctask, ltask - character*(512) :: task - - integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - - integer(ZMQ_PTR), external :: new_zmq_push_socket - integer(ZMQ_PTR) :: zmq_socket_push - - type(selection_buffer) :: buf, buf2 - logical :: done, buffer_ready - type(pt2_type) :: pt2_data - - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order N_int pt2_F pseudo_sym - PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc weight_selection - - call pt2_alloc(pt2_data,N_states) - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - - integer, external :: connect_to_taskserver - if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - return - endif - - zmq_socket_push = new_zmq_push_socket(thread) - - buf%N = 0 - buffer_ready = .False. - ctask = 1 - - do - integer, external :: get_task_from_taskserver - if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id(ctask), task) == -1) then - exit - endif - done = task_id(ctask) == 0 - if (done) then - ctask = ctask - 1 - else - integer :: i_generator, N, subset, bsize - call sscanf_ddd(task, subset, i_generator, N) - if(buf%N == 0) then - ! Only first time - call create_selection_buffer(N, N*2, buf) - buffer_ready = .True. - else - if (N /= buf%N) then - print *, 'N=', N - print *, 'buf%N=', buf%N - print *, 'bug in ', irp_here - stop '-1' - end if - end if - call select_connected(i_generator, energy, pt2_data, buf, subset, pt2_F(i_generator)) - endif - - integer, external :: task_done_to_taskserver - - if(done .or. ctask == size(task_id)) then - do i=1, ctask - if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) == -1) then - call usleep(100) - if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) == -1) then - ctask = 0 - done = .true. - exit - endif - endif - end do - if(ctask > 0) then - call sort_selection_buffer(buf) -! call merge_selection_buffers(buf,buf2) - call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask) - call pt2_dealloc(pt2_data) - call pt2_alloc(pt2_data,N_states) -! buf%mini = buf2%mini - buf%cur = 0 - end if - ctask = 0 - end if - - if(done) exit - ctask = ctask + 1 - end do - - if(ctask > 0) then - call sort_selection_buffer(buf) -! call merge_selection_buffers(buf,buf2) - call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask) -! buf%mini = buf2%mini - buf%cur = 0 - end if - ctask = 0 - call pt2_dealloc(pt2_data) - - integer, external :: disconnect_from_taskserver - if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then - continue - endif - - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - call end_zmq_push_socket(zmq_socket_push,thread) - if (buffer_ready) then - call delete_selection_buffer(buf) -! call delete_selection_buffer(buf2) - endif -end subroutine - - -subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntasks) - use f77_zmq - use selection_types - implicit none - - integer(ZMQ_PTR), intent(in) :: zmq_socket_push - type(pt2_type), intent(in) :: pt2_data - type(selection_buffer), intent(inout) :: b - integer, intent(in) :: ntasks, task_id(*) - integer :: rc - double precision, allocatable :: pt2_serialized(:) - - rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE) - if(rc /= 4) then - print *, 'f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)' - endif - - - allocate(pt2_serialized (pt2_type_size(N_states)) ) - call pt2_serialize(pt2_data,N_states,pt2_serialized) - - rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 3 - return - else if(rc /= size(pt2_serialized)*8) then - stop 'push' - endif - deallocate(pt2_serialized) - - if (b%cur > 0) then - - rc = f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE) - if(rc /= 8*b%cur) then - print *, 'f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE)' - endif - - rc = f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE) - if(rc /= bit_kind*N_int*2*b%cur) then - print *, 'f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE)' - endif - - endif - - rc = f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE) - if(rc /= 4) then - print *, 'f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE)' - endif - - rc = f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0) - if(rc /= 4*ntasks) then - print *, 'f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0)' - endif - -! Activate is zmq_socket_push is a REQ -IRP_IF ZMQ_PUSH -IRP_ELSE - character*(2) :: ok - rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0) - if ((rc /= 2).and.(ok(1:2) /= 'ok')) then - print *, irp_here//': error in receiving ok' - stop -1 - endif -IRP_ENDIF - -end subroutine - - -subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_id, ntasks) - use f77_zmq - use selection_types - implicit none - integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - type(pt2_type), intent(inout) :: pt2_data - double precision, intent(out) :: val(*) - integer(bit_kind), intent(out) :: det(N_int, 2, *) - integer, intent(out) :: N, ntasks, task_id(*) - integer :: rc, rn, i - double precision, allocatable :: pt2_serialized(:) - - rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0) - if(rc /= 4) then - print *, 'f77_zmq_recv( zmq_socket_pull, N, 4, 0)' - endif - - allocate(pt2_serialized (pt2_type_size(N_states)) ) - rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized), 0) - if (rc == -1) then - ntasks = 1 - task_id(1) = 0 - else if(rc /= 8*size(pt2_serialized)) then - stop 'pull' - endif - - call pt2_deserialize(pt2_data,N_states,pt2_serialized) - deallocate(pt2_serialized) - - if (N>0) then - rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0) - if(rc /= 8*N) then - print *, 'f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0)' - endif - - rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0) - if(rc /= bit_kind*N_int*2*N) then - print *, 'f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0)' - endif - endif - - rc = f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0) - if(rc /= 4) then - print *, 'f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0)' - endif - - rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0) - if(rc /= 4*ntasks) then - print *, 'f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0)' - endif - -! Activate is zmq_socket_pull is a REP -IRP_IF ZMQ_PUSH -IRP_ELSE - rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) - if (rc /= 2) then - print *, irp_here//': error in sending ok' - stop -1 - endif -IRP_ENDIF -end subroutine - - +subroutine provide_for_selection_slave + PROVIDE psi_det_sorted_tc_order + PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc +end diff --git a/plugins/local/cipsi_tc_bi_ortho/selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f index 06cf848b..9b8cc81e 100644 --- a/plugins/local/cipsi_tc_bi_ortho/selection.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f @@ -76,6 +76,8 @@ subroutine select_connected(i_generator,E0,pt2_data,b,subset,csubset) double precision, allocatable :: fock_diag_tmp(:,:) + if (csubset == 0) return + allocate(fock_diag_tmp(2,mo_num+1)) call build_fock_tmp_tc(fock_diag_tmp, psi_det_generators(1,1,i_generator), N_int) @@ -86,10 +88,13 @@ subroutine select_connected(i_generator,E0,pt2_data,b,subset,csubset) particle_mask(k,1) = iand(generators_bitmask(k,1,s_part), not(psi_det_generators(k,1,i_generator)) ) particle_mask(k,2) = iand(generators_bitmask(k,2,s_part), not(psi_det_generators(k,2,i_generator)) ) enddo + if ((subset == 1).and.(sum(hole_mask(:,2)) == 0_bit_kind)) then + ! No beta electron to excite + call select_singles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,b) + endif call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,b,subset,csubset) deallocate(fock_diag_tmp) -end subroutine select_connected - +end subroutine double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint) @@ -136,7 +141,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint) end -subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock_diag_tmp, E0, pt2_data, buf, subset, csubset) +subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, fock_diag_tmp, E0, pt2_data, buf, subset, csubset) use bitmasks use selection_types implicit none @@ -151,8 +156,6 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock type(pt2_type), intent(inout) :: pt2_data type(selection_buffer), intent(inout) :: buf - double precision, parameter :: norm_thr = 1.d-16 - integer :: h1, h2, s1, s2, s3, i1, i2, ib, sp, k, i, j, nt, ii, sze integer :: maskInd integer :: N_holes(2), N_particles(2) @@ -170,6 +173,7 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock integer, allocatable :: preinteresting(:), prefullinteresting(:) integer, allocatable :: interesting(:), fullinteresting(:) integer, allocatable :: tmp_array(:) + integer, allocatable :: indices(:), exc_degree(:), iorder(:) integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) logical, allocatable :: banned(:,:,:), bannedOrb(:,:) @@ -178,15 +182,16 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_rows psi_bilinear_matrix_order psi_bilinear_matrix_transp_order PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_tc + PROVIDE psi_selectors_coef_transp_tc psi_det_sorted_tc_order PROVIDE banned_excitation monoAdo = .true. monoBdo = .true. + if (csubset == 0) return do k=1,N_int hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1)) @@ -198,7 +203,11 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock call bitstring_to_list_ab(hole , hole_list , N_holes , N_int) call bitstring_to_list_ab(particle, particle_list, N_particles, N_int) - allocate( indices(N_det), exc_degree( max(N_det_alpha_unique, N_det_beta_unique) ) ) + ! Removed to avoid introducing determinants already presents in the wf + !double precision, parameter :: norm_thr = 1.d-16 + + allocate (indices(N_det), & + exc_degree(max(N_det_alpha_unique,N_det_beta_unique))) ! Pre-compute excitation degrees wrt alpha determinants k=1 @@ -214,73 +223,76 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock if (nt > 2) cycle do l_a=psi_bilinear_matrix_columns_loc(j), psi_bilinear_matrix_columns_loc(j+1)-1 i = psi_bilinear_matrix_rows(l_a) - if(nt + exc_degree(i) <= 4) then + if (nt + exc_degree(i) <= 4) then idx = psi_det_sorted_tc_order(psi_bilinear_matrix_order(l_a)) -! if (psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then + ! Removed to avoid introducing determinants already presents in the wf + !if (psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then indices(k) = idx - k = k + 1 -! endif + k=k+1 + !endif endif enddo enddo ! Pre-compute excitation degrees wrt beta determinants do i=1,N_det_beta_unique - call get_excitation_degree_spin(psi_det_beta_unique(1,i), psi_det_generators(1,2,i_generator), exc_degree(i), N_int) + call get_excitation_degree_spin(psi_det_beta_unique(1,i), & + psi_det_generators(1,2,i_generator), exc_degree(i), N_int) enddo ! Iterate on 0S alpha, and find betas TQ such that exc_degree <= 4 - ! Remove also contributions < 1.d-20) do j=1,N_det_alpha_unique - call get_excitation_degree_spin(psi_det_alpha_unique(1,j), psi_det_generators(1,1,i_generator), nt, N_int) + call get_excitation_degree_spin(psi_det_alpha_unique(1,j), & + psi_det_generators(1,1,i_generator), nt, N_int) if (nt > 1) cycle - do l_a = psi_bilinear_matrix_transp_rows_loc(j), psi_bilinear_matrix_transp_rows_loc(j+1)-1 + do l_a=psi_bilinear_matrix_transp_rows_loc(j), psi_bilinear_matrix_transp_rows_loc(j+1)-1 i = psi_bilinear_matrix_transp_columns(l_a) - if(exc_degree(i) < 3) cycle - if(nt + exc_degree(i) <= 4) then + if (exc_degree(i) < 3) cycle + if (nt + exc_degree(i) <= 4) then idx = psi_det_sorted_tc_order( & psi_bilinear_matrix_order( & psi_bilinear_matrix_transp_order(l_a))) -! if(psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then + ! Removed to avoid introducing determinants already presents in the wf + !if(psi_average_norm_contrib_sorted_tc(idx) > norm_thr) then indices(k) = idx - k = k + 1 -! endif + k=k+1 + !endif endif enddo enddo deallocate(exc_degree) - nmax = k - 1 + nmax=k-1 call isort_noidx(indices,nmax) ! Start with 32 elements. Size will double along with the filtering. - allocate(preinteresting(0:32), prefullinteresting(0:32), interesting(0:32), fullinteresting(0:32)) + allocate(preinteresting(0:32), prefullinteresting(0:32), & + interesting(0:32), fullinteresting(0:32)) preinteresting(:) = 0 prefullinteresting(:) = 0 - do i = 1, N_int + do i=1,N_int negMask(i,1) = not(psi_det_generators(i,1,i_generator)) negMask(i,2) = not(psi_det_generators(i,2,i_generator)) - enddo - - do k = 1, nmax + end do + do k=1,nmax i = indices(k) mobMask(1,1) = iand(negMask(1,1), psi_det_sorted_tc(1,1,i)) mobMask(1,2) = iand(negMask(1,2), psi_det_sorted_tc(1,2,i)) nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) - do j = 2, N_int + do j=2,N_int mobMask(j,1) = iand(negMask(j,1), psi_det_sorted_tc(j,1,i)) mobMask(j,2) = iand(negMask(j,2), psi_det_sorted_tc(j,2,i)) nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) - enddo + end do if(nt <= 4) then if(i <= N_det_selectors) then sze = preinteresting(0) - if(sze+1 == size(preinteresting)) then - allocate(tmp_array(0:sze)) + if (sze+1 == size(preinteresting)) then + allocate (tmp_array(0:sze)) tmp_array(0:sze) = preinteresting(0:sze) deallocate(preinteresting) allocate(preinteresting(0:2*sze)) @@ -289,9 +301,9 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock endif preinteresting(0) = sze+1 preinteresting(sze+1) = i - elseif(nt <= 2) then + else if(nt <= 2) then sze = prefullinteresting(0) - if(sze+1 == size(prefullinteresting)) then + if (sze+1 == size(prefullinteresting)) then allocate (tmp_array(0:sze)) tmp_array(0:sze) = prefullinteresting(0:sze) deallocate(prefullinteresting) @@ -301,20 +313,16 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock endif prefullinteresting(0) = sze+1 prefullinteresting(sze+1) = i - endif - endif - - enddo + end if + end if + end do deallocate(indices) - allocate( banned(mo_num, mo_num,2), bannedOrb(mo_num, 2) ) - allocate( mat(N_states, mo_num, mo_num) ) - allocate( mat_l(N_states, mo_num, mo_num), mat_r(N_states, mo_num, mo_num) ) + allocate(banned(mo_num, mo_num,2), bannedOrb(mo_num, 2)) + allocate(mat(N_states, mo_num, mo_num)) + allocate(mat_l(N_states, mo_num, mo_num), mat_r(N_states, mo_num, mo_num)) maskInd = -1 - - - do s1 = 1, 2 do i1 = N_holes(s1), 1, -1 ! Generate low excitations first @@ -347,17 +355,17 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock do ii = 1, preinteresting(0) i = preinteresting(ii) - select case(N_int) - case(1) + select case (N_int) + case (1) mobMask(1,1) = iand(negMask(1,1), psi_det_sorted_tc(1,1,i)) mobMask(1,2) = iand(negMask(1,2), psi_det_sorted_tc(1,2,i)) nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) - case(2) + case (2) mobMask(1:2,1) = iand(negMask(1:2,1), psi_det_sorted_tc(1:2,1,i)) mobMask(1:2,2) = iand(negMask(1:2,2), psi_det_sorted_tc(1:2,2,i)) nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + & popcnt(mobMask(2, 1)) + popcnt(mobMask(2, 2)) - case(3) + case (3) mobMask(1:3,1) = iand(negMask(1:3,1), psi_det_sorted_tc(1:3,1,i)) mobMask(1:3,2) = iand(negMask(1:3,2), psi_det_sorted_tc(1:3,2,i)) nt = 0 @@ -370,8 +378,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock nt = nt+ popcnt(mobMask(j, 2)) if (nt > 4) exit endif - enddo - case(4) + end do + case (4) mobMask(1:4,1) = iand(negMask(1:4,1), psi_det_sorted_tc(1:4,1,i)) mobMask(1:4,2) = iand(negMask(1:4,2), psi_det_sorted_tc(1:4,2,i)) nt = 0 @@ -384,7 +392,7 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock nt = nt+ popcnt(mobMask(j, 2)) if (nt > 4) exit endif - enddo + end do case default mobMask(1:N_int,1) = iand(negMask(1:N_int,1), psi_det_sorted_tc(1:N_int,1,i)) mobMask(1:N_int,2) = iand(negMask(1:N_int,2), psi_det_sorted_tc(1:N_int,2,i)) @@ -398,12 +406,12 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock nt = nt+ popcnt(mobMask(j, 2)) if (nt > 4) exit endif - enddo + end do end select if(nt <= 4) then sze = interesting(0) - if(sze+1 == size(interesting)) then + if (sze+1 == size(interesting)) then allocate (tmp_array(0:sze)) tmp_array(0:sze) = interesting(0:sze) deallocate(interesting) @@ -425,8 +433,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock endif fullinteresting(0) = sze+1 fullinteresting(sze+1) = i - endif - endif + end if + end if enddo @@ -456,10 +464,10 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock endif fullinteresting(0) = sze+1 fullinteresting(sze+1) = i - endif - enddo - allocate( fullminilist (N_int, 2, fullinteresting(0)), & - minilist (N_int, 2, interesting(0)) ) + end if + end do + allocate (fullminilist (N_int, 2, fullinteresting(0)), & + minilist (N_int, 2, interesting(0)) ) do i = 1, fullinteresting(0) do k = 1, N_int @@ -517,7 +525,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting, mat_l, mat_r) call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf, mat_l, mat_r) - endif + end if + enddo @@ -533,7 +542,8 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock deallocate(banned, bannedOrb,mat) deallocate(mat_l, mat_r) -end subroutine select_singles_and_doubles + +end subroutine ! --- @@ -924,13 +934,13 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d call htilde_mu_mat_opt_bi_ortho_no_3e(psi_selectors(1,1,iii), det, N_int, i_h_alpha) call htilde_mu_mat_opt_bi_ortho_no_3e(det, psi_selectors(1,1,iii), N_int, alpha_h_i) print*,i_h_alpha,alpha_h_i - call debug_det(psi_selectors(1,1,iii),N_int) - enddo + call debug_det(psi_selectors(1,1,iii),N_int) + enddo ! print*,'psi_det ' ! do iii = 1, N_det! old version ! print*,'iii',iii,psi_l_coef_bi_ortho(iii,1),psi_r_coef_bi_ortho(iii,1) -! call debug_det(psi_det(1,1,iii),N_int) -! enddo +! call debug_det(psi_det(1,1,iii),N_int) +! enddo stop endif endif @@ -938,7 +948,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d psi_h_alpha = mat_l(istate, p1, p2) alpha_h_psi = mat_r(istate, p1, p2) endif - val = 4.d0 * psi_h_alpha * alpha_h_psi + val = 4.d0 * psi_h_alpha * alpha_h_psi tmp = dsqrt(delta_E * delta_E + val) ! if (delta_E < 0.d0) then ! tmp = -tmp @@ -946,21 +956,21 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d e_pert(istate) = 0.25 * val / delta_E ! e_pert(istate) = 0.5d0 * (tmp - delta_E) if(dsqrt(dabs(tmp)).gt.1.d-4.and.dabs(alpha_h_psi).gt.1.d-4)then - coef(istate) = e_pert(istate) / psi_h_alpha + coef(istate) = e_pert(istate) / psi_h_alpha else - coef(istate) = alpha_h_psi / delta_E + coef(istate) = alpha_h_psi / delta_E endif if(selection_tc == 1)then - if(e_pert(istate).lt.0.d0)then + if(e_pert(istate).lt.0.d0)then e_pert(istate)=0.d0 - else + else e_pert(istate)=-e_pert(istate) endif else if(selection_tc == -1)then if(e_pert(istate).gt.0.d0)e_pert(istate)=0.d0 endif - + ! if(selection_tc == 1 )then ! if(e_pert(istate).lt.0.d0)then ! e_pert(istate) = 0.d0 diff --git a/plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f deleted file mode 100644 index 0bd51464..00000000 --- a/plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f +++ /dev/null @@ -1,424 +0,0 @@ - -subroutine create_selection_buffer(N, size_in, res) - use selection_types - implicit none - BEGIN_DOC -! Allocates the memory for a selection buffer. -! The arrays have dimension size_in and the maximum number of elements is N - END_DOC - - integer, intent(in) :: N, size_in - type(selection_buffer), intent(out) :: res - - integer :: siz - siz = max(size_in,1) - - double precision :: rss - double precision, external :: memory_of_double - rss = memory_of_double(siz)*(N_int*2+1) - call check_mem(rss,irp_here) - - allocate(res%det(N_int, 2, siz), res%val(siz)) - - res%val(:) = 0d0 - res%det(:,:,:) = 0_8 - res%N = N - res%mini = 0d0 - res%cur = 0 -end subroutine - -subroutine delete_selection_buffer(b) - use selection_types - implicit none - type(selection_buffer), intent(inout) :: b - if (associated(b%det)) then - deallocate(b%det) - endif - if (associated(b%val)) then - deallocate(b%val) - endif - NULLIFY(b%det) - NULLIFY(b%val) - b%cur = 0 - b%mini = 0.d0 - b%N = 0 -end - - -subroutine add_to_selection_buffer(b, det, val) - use selection_types - implicit none - - type(selection_buffer), intent(inout) :: b - integer(bit_kind), intent(in) :: det(N_int, 2) - double precision, intent(in) :: val - integer :: i - - if(b%N > 0 .and. val <= b%mini) then - b%cur += 1 - b%det(1:N_int,1:2,b%cur) = det(1:N_int,1:2) - b%val(b%cur) = val - if(b%cur == size(b%val)) then - call sort_selection_buffer(b) - end if - end if -end subroutine - -subroutine merge_selection_buffers(b1, b2) - use selection_types - implicit none - BEGIN_DOC -! Merges the selection buffers b1 and b2 into b2 - END_DOC - type(selection_buffer), intent(inout) :: b1 - type(selection_buffer), intent(inout) :: b2 - integer(bit_kind), pointer :: detmp(:,:,:) - double precision, pointer :: val(:) - integer :: i, i1, i2, k, nmwen, sze - if (b1%cur == 0) return - do while (b1%val(b1%cur) > b2%mini) - b1%cur = b1%cur-1 - if (b1%cur == 0) then - return - endif - enddo - nmwen = min(b1%N, b1%cur+b2%cur) - double precision :: rss - double precision, external :: memory_of_double - sze = max(size(b1%val), size(b2%val)) - rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze) - call check_mem(rss,irp_here) - allocate(val(sze), detmp(N_int, 2, sze)) - i1=1 - i2=1 - do i=1,nmwen - if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then - exit - else if (i1 > b1%cur) then - val(i) = b2%val(i2) - detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2) - detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2) - i2=i2+1 - else if (i2 > b2%cur) then - val(i) = b1%val(i1) - detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1) - detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1) - i1=i1+1 - else - if (b1%val(i1) <= b2%val(i2)) then - val(i) = b1%val(i1) - detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1) - detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1) - i1=i1+1 - else - val(i) = b2%val(i2) - detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2) - detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2) - i2=i2+1 - endif - endif - enddo - deallocate(b2%det, b2%val) - do i=nmwen+1,b2%N - val(i) = 0.d0 - detmp(1:N_int,1:2,i) = 0_bit_kind - enddo - b2%det => detmp - b2%val => val -! if(selection_tc == 1)then -! b2%mini = max(b2%mini,b2%val(b2%N)) -! else - b2%mini = min(b2%mini,b2%val(b2%N)) -! endif - b2%cur = nmwen -end - - -subroutine sort_selection_buffer(b) - use selection_types - implicit none - - type(selection_buffer), intent(inout) :: b - integer, allocatable :: iorder(:) - integer(bit_kind), pointer :: detmp(:,:,:) - integer :: i, nmwen - logical, external :: detEq - if (b%N == 0 .or. b%cur == 0) return - nmwen = min(b%N, b%cur) - - double precision :: rss - double precision, external :: memory_of_double, memory_of_int - rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3)) - call check_mem(rss,irp_here) - allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3))) - do i=1,b%cur - iorder(i) = i - end do - call dsort(b%val, iorder, b%cur) - do i=1, nmwen - detmp(1:N_int,1,i) = b%det(1:N_int,1,iorder(i)) - detmp(1:N_int,2,i) = b%det(1:N_int,2,iorder(i)) - end do - deallocate(b%det,iorder) - b%det => detmp -! if(selection_tc == 1)then -! b%mini = max(b%mini,b%val(b%N)) -! else - b%mini = min(b%mini,b%val(b%N)) -! endif - b%cur = nmwen -end subroutine - -subroutine make_selection_buffer_s2(b) - use selection_types - type(selection_buffer), intent(inout) :: b - - integer(bit_kind), allocatable :: o(:,:,:) - double precision, allocatable :: val(:) - - integer :: n_d - integer :: i,k,sze,n_alpha,j,n - logical :: dup - - ! Sort - integer, allocatable :: iorder(:) - integer*8, allocatable :: bit_tmp(:) - integer*8, external :: configuration_search_key - integer(bit_kind), allocatable :: tmp_array(:,:,:) - logical, allocatable :: duplicate(:) - - n_d = b%cur - double precision :: rss - double precision, external :: memory_of_double - rss = (4*N_int+4)*memory_of_double(n_d) - call check_mem(rss,irp_here) - allocate(o(N_int,2,n_d), iorder(n_d), duplicate(n_d), bit_tmp(n_d), & - tmp_array(N_int,2,n_d), val(n_d) ) - - do i=1,n_d - do k=1,N_int - o(k,1,i) = ieor(b%det(k,1,i), b%det(k,2,i)) - o(k,2,i) = iand(b%det(k,1,i), b%det(k,2,i)) - enddo - iorder(i) = i - bit_tmp(i) = configuration_search_key(o(1,1,i),N_int) - enddo - - deallocate(b%det) - - call i8sort(bit_tmp,iorder,n_d) - - do i=1,n_d - do k=1,N_int - tmp_array(k,1,i) = o(k,1,iorder(i)) - tmp_array(k,2,i) = o(k,2,iorder(i)) - enddo - val(i) = b%val(iorder(i)) - duplicate(i) = .False. - enddo - - ! Find duplicates - do i=1,n_d-1 - if (duplicate(i)) then - cycle - endif - j = i+1 - do while (bit_tmp(j)==bit_tmp(i)) - if (duplicate(j)) then - j+=1 - if (j>n_d) then - exit - endif - cycle - endif - dup = .True. - do k=1,N_int - if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) & - .or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then - dup = .False. - exit - endif - enddo - if (dup) then - val(i) = max(val(i), val(j)) - duplicate(j) = .True. - endif - j+=1 - if (j>n_d) then - exit - endif - enddo - enddo - - deallocate (b%val) - ! Copy filtered result - integer :: n_p - n_p=0 - do i=1,n_d - if (duplicate(i)) then - cycle - endif - n_p = n_p + 1 - do k=1,N_int - o(k,1,n_p) = tmp_array(k,1,i) - o(k,2,n_p) = tmp_array(k,2,i) - enddo - val(n_p) = val(i) - enddo - - ! Sort by importance - do i=1,n_p - iorder(i) = i - end do - call dsort(val,iorder,n_p) - do i=1,n_p - do k=1,N_int - tmp_array(k,1,i) = o(k,1,iorder(i)) - tmp_array(k,2,i) = o(k,2,iorder(i)) - enddo - enddo - do i=1,n_p - do k=1,N_int - o(k,1,i) = tmp_array(k,1,i) - o(k,2,i) = tmp_array(k,2,i) - enddo - enddo - - ! Create determinants - n_d = 0 - do i=1,n_p - call configuration_to_dets_size(o(1,1,i),sze,elec_alpha_num,N_int) - n_d = n_d + sze - if (n_d > b%cur) then -! if (n_d - b%cur > b%cur - n_d + sze) then -! n_d = n_d - sze -! endif - exit - endif - enddo - - rss = (4*N_int+2)*memory_of_double(n_d) - call check_mem(rss,irp_here) - allocate(b%det(N_int,2,2*n_d), b%val(2*n_d)) - k=1 - do i=1,n_p - n=n_d - call configuration_to_dets_size(o(1,1,i),n,elec_alpha_num,N_int) - call configuration_to_dets(o(1,1,i),b%det(1,1,k),n,elec_alpha_num,N_int) - do j=k,k+n-1 - b%val(j) = val(i) - enddo - k = k+n - if (k > n_d) exit - enddo - deallocate(o) - b%cur = n_d - b%N = n_d -end - - - - -subroutine remove_duplicates_in_selection_buffer(b) - use selection_types - type(selection_buffer), intent(inout) :: b - - integer(bit_kind), allocatable :: o(:,:,:) - double precision, allocatable :: val(:) - - integer :: n_d - integer :: i,k,sze,n_alpha,j,n - logical :: dup - - ! Sort - integer, allocatable :: iorder(:) - integer*8, allocatable :: bit_tmp(:) - integer*8, external :: det_search_key - integer(bit_kind), allocatable :: tmp_array(:,:,:) - logical, allocatable :: duplicate(:) - - n_d = b%cur - logical :: found_duplicates - double precision :: rss - double precision, external :: memory_of_double - rss = (4*N_int+4)*memory_of_double(n_d) - call check_mem(rss,irp_here) - - found_duplicates = .False. - allocate(iorder(n_d), duplicate(n_d), bit_tmp(n_d), & - tmp_array(N_int,2,n_d), val(n_d) ) - - do i=1,n_d - iorder(i) = i - bit_tmp(i) = det_search_key(b%det(1,1,i),N_int) - enddo - - call i8sort(bit_tmp,iorder,n_d) - - do i=1,n_d - do k=1,N_int - tmp_array(k,1,i) = b%det(k,1,iorder(i)) - tmp_array(k,2,i) = b%det(k,2,iorder(i)) - enddo - val(i) = b%val(iorder(i)) - duplicate(i) = .False. - enddo - - ! Find duplicates - do i=1,n_d-1 - if (duplicate(i)) then - cycle - endif - j = i+1 - do while (bit_tmp(j)==bit_tmp(i)) - if (duplicate(j)) then - j+=1 - if (j>n_d) then - exit - endif - cycle - endif - dup = .True. - do k=1,N_int - if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) & - .or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then - dup = .False. - exit - endif - enddo - if (dup) then - duplicate(j) = .True. - found_duplicates = .True. - endif - j+=1 - if (j>n_d) then - exit - endif - enddo - enddo - - if (found_duplicates) then - - ! Copy filtered result - integer :: n_p - n_p=0 - do i=1,n_d - if (duplicate(i)) then - cycle - endif - n_p = n_p + 1 - do k=1,N_int - b%det(k,1,n_p) = tmp_array(k,1,i) - b%det(k,2,n_p) = tmp_array(k,2,i) - enddo - val(n_p) = val(i) - enddo - b%cur=n_p - b%N=n_p - - endif - -end - - - diff --git a/plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f deleted file mode 100644 index 3c09e59a..00000000 --- a/plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f +++ /dev/null @@ -1,134 +0,0 @@ -BEGIN_PROVIDER [ double precision, pt2_match_weight, (N_states) ] - implicit none - BEGIN_DOC - ! Weights adjusted along the selection to make the PT2 contributions - ! of each state coincide. - END_DOC - pt2_match_weight(:) = 1.d0 -END_PROVIDER - - - -BEGIN_PROVIDER [ double precision, variance_match_weight, (N_states) ] - implicit none - BEGIN_DOC - ! Weights adjusted along the selection to make the variances - ! of each state coincide. - END_DOC - variance_match_weight(:) = 1.d0 -END_PROVIDER - - - -subroutine update_pt2_and_variance_weights(pt2_data, N_st) - implicit none - use selection_types - BEGIN_DOC -! Updates the PT2- and Variance- matching weights. - END_DOC - integer, intent(in) :: N_st - type(pt2_type), intent(in) :: pt2_data - double precision :: pt2(N_st) - double precision :: variance(N_st) - - double precision :: avg, element, dt, x - integer :: k - pt2(:) = pt2_data % pt2(:) - variance(:) = pt2_data % variance(:) - - avg = sum(pt2(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero - - dt = 8.d0 !* selection_factor - do k=1,N_st - element = exp(dt*(pt2(k)/avg - 1.d0)) - element = min(2.0d0 , element) - element = max(0.5d0 , element) - pt2_match_weight(k) *= element - enddo - - - avg = sum(variance(1:N_st)) / dble(N_st) + 1.d-32 ! Avoid future division by zero - - do k=1,N_st - element = exp(dt*(variance(k)/avg -1.d0)) - element = min(2.0d0 , element) - element = max(0.5d0 , element) - variance_match_weight(k) *= element - enddo - - if (N_det < 100) then - ! For tiny wave functions, weights are 1.d0 - pt2_match_weight(:) = 1.d0 - variance_match_weight(:) = 1.d0 - endif - - threshold_davidson_pt2 = min(1.d-6, & - max(threshold_davidson, 1.e-1 * PT2_relative_error * minval(abs(pt2(1:N_states)))) ) - - SOFT_TOUCH pt2_match_weight variance_match_weight threshold_davidson_pt2 -end - - - - -BEGIN_PROVIDER [ double precision, selection_weight, (N_states) ] - implicit none - BEGIN_DOC - ! Weights used in the selection criterion - END_DOC - select case (weight_selection) - - case (0) - print *, 'Using input weights in selection' - selection_weight(1:N_states) = c0_weight(1:N_states) * state_average_weight(1:N_states) - - case (1) - print *, 'Using 1/c_max^2 weight in selection' - selection_weight(1:N_states) = c0_weight(1:N_states) - - case (2) - print *, 'Using pt2-matching weight in selection' - selection_weight(1:N_states) = c0_weight(1:N_states) * pt2_match_weight(1:N_states) - print *, '# PT2 weight ', real(pt2_match_weight(:),4) - - case (3) - print *, 'Using variance-matching weight in selection' - selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states) - print *, '# var weight ', real(variance_match_weight(:),4) - - case (4) - print *, 'Using variance- and pt2-matching weights in selection' - selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states)) - print *, '# PT2 weight ', real(pt2_match_weight(:),4) - print *, '# var weight ', real(variance_match_weight(:),4) - - case (5) - print *, 'Using variance-matching weight in selection' - selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states) - print *, '# var weight ', real(variance_match_weight(:),4) - - case (6) - print *, 'Using CI coefficient-based selection' - selection_weight(1:N_states) = c0_weight(1:N_states) - - case (7) - print *, 'Input weights multiplied by variance- and pt2-matching' - selection_weight(1:N_states) = c0_weight(1:N_states) * sqrt(variance_match_weight(1:N_states) * pt2_match_weight(1:N_states)) * state_average_weight(1:N_states) - print *, '# PT2 weight ', real(pt2_match_weight(:),4) - print *, '# var weight ', real(variance_match_weight(:),4) - - case (8) - print *, 'Input weights multiplied by pt2-matching' - selection_weight(1:N_states) = c0_weight(1:N_states) * pt2_match_weight(1:N_states) * state_average_weight(1:N_states) - print *, '# PT2 weight ', real(pt2_match_weight(:),4) - - case (9) - print *, 'Input weights multiplied by variance-matching' - selection_weight(1:N_states) = c0_weight(1:N_states) * variance_match_weight(1:N_states) * state_average_weight(1:N_states) - print *, '# var weight ', real(variance_match_weight(:),4) - - end select - print *, '# Total weight ', real(selection_weight(:),4) - -END_PROVIDER - diff --git a/plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f deleted file mode 100644 index 6343bf8b..00000000 --- a/plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f +++ /dev/null @@ -1,348 +0,0 @@ -subroutine run_slave_cipsi - - BEGIN_DOC - ! Helper program for distributed parallelism - END_DOC - - implicit none - - call omp_set_max_active_levels(1) - distributed_davidson = .False. - read_wf = .False. - SOFT_TOUCH read_wf distributed_davidson - call provide_everything - call switch_qp_run_to_master - call run_slave_main -end - -subroutine provide_everything - PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag - - PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context - PROVIDE psi_det psi_coef threshold_generators state_average_weight - PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym -end - - -subroutine run_slave_main - - use f77_zmq - - implicit none - IRP_IF MPI - include 'mpif.h' - IRP_ENDIF - - integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - double precision :: energy(N_states) - character*(64) :: states(10) - character*(64) :: old_state - integer :: rc, i, ierr - double precision :: t0, t1 - - integer, external :: zmq_get_dvector, zmq_get_N_det_generators - integer, external :: zmq_get8_dvector - integer, external :: zmq_get_ivector - integer, external :: zmq_get_psi, zmq_get_N_det_selectors, zmq_get_psi_bilinear - integer, external :: zmq_get_psi_notouch - integer, external :: zmq_get_N_states_diag - - zmq_context = f77_zmq_ctx_new () - states(1) = 'selection' - states(2) = 'davidson' - states(3) = 'pt2' - old_state = 'Waiting' - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - - PROVIDE psi_det psi_coef threshold_generators state_average_weight mpi_master - PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator - PROVIDE N_det_generators N_states N_states_diag pt2_e0_denominator mpi_rank - - IRP_IF MPI - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - do - - if (mpi_master) then - call wait_for_states(states,zmq_state,size(states)) - if (zmq_state(1:64) == old_state(1:64)) then - call usleep(200) - cycle - else - old_state(1:64) = zmq_state(1:64) - endif - print *, trim(zmq_state) - endif - - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - IRP_IF MPI - call MPI_BCAST (zmq_state, 128, MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here, 'error in broadcast of zmq_state' - endif - IRP_ENDIF - - if(zmq_state(1:7) == 'Stopped') then - exit - endif - - - if (zmq_state(1:9) == 'selection') then - - ! Selection - ! --------- - - call wall_time(t0) - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_psi') - IRP_ENDIF - if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_dvector threshold_generators') - IRP_ENDIF - if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_dvector energy') - IRP_ENDIF - if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_N_det_generators') - IRP_ENDIF - if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_N_det_selectors') - IRP_ENDIF - if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_dvector state_average_weight') - IRP_ENDIF - if (zmq_get_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_dvector selection_weight') - IRP_ENDIF - if (zmq_get_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) cycle - pt2_e0_denominator(1:N_states) = energy(1:N_states) - TOUCH pt2_e0_denominator state_average_weight threshold_generators selection_weight psi_det psi_coef - - if (mpi_master) then - print *, 'N_det', N_det - print *, 'N_det_generators', N_det_generators - print *, 'N_det_selectors', N_det_selectors - print *, 'pt2_e0_denominator', pt2_e0_denominator - print *, 'pt2_stoch_istate', pt2_stoch_istate - print *, 'state_average_weight', state_average_weight - print *, 'selection_weight', selection_weight - endif - call wall_time(t1) - call write_double(6,(t1-t0),'Broadcast time') - - IRP_IF MPI_DEBUG - call mpi_print('Entering OpenMP section') - IRP_ENDIF - !$OMP PARALLEL PRIVATE(i) - i = omp_get_thread_num() - call run_selection_slave(0,i,energy) - !$OMP END PARALLEL - print *, mpi_rank, ': Selection done' - IRP_IF MPI - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here, 'error in barrier' - endif - IRP_ENDIF - call mpi_print('----------') - - else if (zmq_state(1:8) == 'davidson') then - - ! Davidson - ! -------- - - call wall_time(t0) - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_N_states_diag') - IRP_ENDIF - if (zmq_get_N_states_diag(zmq_to_qp_run_socket,1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_psi') - IRP_ENDIF - if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle - - call wall_time(t1) - call write_double(6,(t1-t0),'Broadcast time') - - !--- - call omp_set_max_active_levels(8) - call davidson_slave_tcp(0) - call omp_set_max_active_levels(1) - print *, mpi_rank, ': Davidson done' - !--- - - IRP_IF MPI - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here, 'error in barrier' - endif - IRP_ENDIF - call mpi_print('----------') - - else if (zmq_state(1:3) == 'pt2') then - - ! PT2 - ! --- - - IRP_IF MPI - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here, 'error in barrier' - endif - IRP_ENDIF - call wall_time(t0) - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_psi') - IRP_ENDIF - if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_N_det_generators') - IRP_ENDIF - if (zmq_get_N_det_generators (zmq_to_qp_run_socket, 1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_N_det_selectors') - IRP_ENDIF - if (zmq_get_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_dvector threshold_generators') - IRP_ENDIF - if (zmq_get_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_dvector energy') - IRP_ENDIF - if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_ivector pt2_stoch_istate') - IRP_ENDIF - if (zmq_get_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_dvector state_average_weight') - IRP_ENDIF - if (zmq_get_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) cycle - IRP_IF MPI_DEBUG - call mpi_print('zmq_get_dvector selection_weight') - IRP_ENDIF - if (zmq_get_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) cycle - pt2_e0_denominator(1:N_states) = energy(1:N_states) - SOFT_TOUCH pt2_e0_denominator state_average_weight pt2_stoch_istate threshold_generators selection_weight psi_det psi_coef N_det_generators N_det_selectors - - - call wall_time(t1) - call write_double(6,(t1-t0),'Broadcast time') - IRP_IF MPI - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here, 'error in barrier' - endif - IRP_ENDIF - - - IRP_IF MPI_DEBUG - call mpi_print('Entering OpenMP section') - IRP_ENDIF - if (.true.) then - integer :: nproc_target, ii - double precision :: mem_collector, mem, rss - - call resident_memory(rss) - - nproc_target = nthreads_pt2 - ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) - - do - mem = rss + & ! - nproc_target * 8.d0 * & ! bytes - ( 0.5d0*pt2_n_tasks_max & ! task_id - + 64.d0*pt2_n_tasks_max & ! task - + 3.d0*pt2_n_tasks_max*N_states & ! pt2, variance, norm - + 1.d0*pt2_n_tasks_max & ! i_generator, subset - + 3.d0*(N_int*2.d0*ii+ ii) & ! selection buffer - + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer - + 2.0d0*(ii) & ! preinteresting, interesting, - ! prefullinteresting, fullinteresting - + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist - + 1.0d0*(N_states*mo_num*mo_num) & ! mat - ) / 1024.d0**3 - - if (nproc_target == 0) then - call check_mem(mem,irp_here) - nproc_target = 1 - exit - endif - - if (mem+rss < qp_max_mem) then - exit - endif - - nproc_target = nproc_target - 1 - - enddo - - if (N_det > 100000) then - - if (mpi_master) then - print *, 'N_det', N_det - print *, 'N_det_generators', N_det_generators - print *, 'N_det_selectors', N_det_selectors - print *, 'pt2_e0_denominator', pt2_e0_denominator - print *, 'pt2_stoch_istate', pt2_stoch_istate - print *, 'state_average_weight', state_average_weight - print *, 'selection_weight', selection_weight - print *, 'Number of threads', nproc_target - endif - - if (h0_type == 'CFG') then - PROVIDE det_to_configuration - endif - - PROVIDE global_selection_buffer pt2_N_teeth pt2_F N_det_generators - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_tc_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted_tc - - PROVIDE psi_det_hii selection_weight pseudo_sym pt2_min_parallel_tasks - - if (mpi_master) then - print *, 'Running PT2' - endif - !$OMP PARALLEL PRIVATE(i) NUM_THREADS(nproc_target+1) - i = omp_get_thread_num() - call run_pt2_slave(0,i,pt2_e0_denominator) - !$OMP END PARALLEL - FREE state_average_weight - print *, mpi_rank, ': PT2 done' - print *, '-------' - - endif - endif - - IRP_IF MPI - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - print *, irp_here, 'error in barrier' - endif - IRP_ENDIF - call mpi_print('----------') - - endif - - end do - IRP_IF MPI - call MPI_finalize(ierr) - IRP_ENDIF -end - - - diff --git a/src/cipsi/cipsi.irp.f b/src/cipsi/cipsi.irp.f index cf770049..446e8d87 100644 --- a/src/cipsi/cipsi.irp.f +++ b/src/cipsi/cipsi.irp.f @@ -1,10 +1,13 @@ subroutine run_cipsi - implicit none - use selection_types + BEGIN_DOC -! Selected Full Configuration Interaction with deterministic selection and -! stochastic PT2. + ! Selected Full Configuration Interaction with deterministic selection and + ! stochastic PT2. END_DOC + + use selection_types + + implicit none integer :: i,j,k type(pt2_type) :: pt2_data, pt2_data_err double precision, allocatable :: zeros(:) diff --git a/src/cipsi/energy.irp.f b/src/cipsi/energy.irp.f index 1f7cf122..4b496c11 100644 --- a/src/cipsi/energy.irp.f +++ b/src/cipsi/energy.irp.f @@ -36,12 +36,3 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ] endif END_PROVIDER - -BEGIN_PROVIDER [ double precision, pt2_overlap, (N_states, N_states) ] - implicit none - BEGIN_DOC - ! Overlap between the perturbed wave functions - END_DOC - pt2_overlap(1:N_states,1:N_states) = 0.d0 -END_PROVIDER - diff --git a/src/cipsi/lock_2rdm.irp.f b/src/cipsi/lock_2rdm.irp.f deleted file mode 100644 index e69de29b..00000000 diff --git a/src/cipsi/pt2_type.irp.f b/src/cipsi/pt2_type.irp.f deleted file mode 100644 index ee90d421..00000000 --- a/src/cipsi/pt2_type.irp.f +++ /dev/null @@ -1,128 +0,0 @@ -subroutine pt2_alloc(pt2_data,N) - implicit none - use selection_types - type(pt2_type), intent(inout) :: pt2_data - integer, intent(in) :: N - integer :: k - - allocate(pt2_data % pt2(N) & - ,pt2_data % variance(N) & - ,pt2_data % rpt2(N) & - ,pt2_data % overlap(N,N) & - ) - - pt2_data % pt2(:) = 0.d0 - pt2_data % variance(:) = 0.d0 - pt2_data % rpt2(:) = 0.d0 - pt2_data % overlap(:,:) = 0.d0 - -end subroutine - -subroutine pt2_dealloc(pt2_data) - implicit none - use selection_types - type(pt2_type), intent(inout) :: pt2_data - deallocate(pt2_data % pt2 & - ,pt2_data % variance & - ,pt2_data % rpt2 & - ,pt2_data % overlap & - ) -end subroutine - -subroutine pt2_add(p1, w, p2) - implicit none - use selection_types - BEGIN_DOC -! p1 += w * p2 - END_DOC - type(pt2_type), intent(inout) :: p1 - double precision, intent(in) :: w - type(pt2_type), intent(in) :: p2 - - if (w == 1.d0) then - - p1 % pt2(:) = p1 % pt2(:) + p2 % pt2(:) - p1 % rpt2(:) = p1 % rpt2(:) + p2 % rpt2(:) - p1 % variance(:) = p1 % variance(:) + p2 % variance(:) - p1 % overlap(:,:) = p1 % overlap(:,:) + p2 % overlap(:,:) - - else - - p1 % pt2(:) = p1 % pt2(:) + w * p2 % pt2(:) - p1 % rpt2(:) = p1 % rpt2(:) + w * p2 % rpt2(:) - p1 % variance(:) = p1 % variance(:) + w * p2 % variance(:) - p1 % overlap(:,:) = p1 % overlap(:,:) + w * p2 % overlap(:,:) - - endif - -end subroutine - - -subroutine pt2_add2(p1, w, p2) - implicit none - use selection_types - BEGIN_DOC -! p1 += w * p2**2 - END_DOC - type(pt2_type), intent(inout) :: p1 - double precision, intent(in) :: w - type(pt2_type), intent(in) :: p2 - - if (w == 1.d0) then - - p1 % pt2(:) = p1 % pt2(:) + p2 % pt2(:) * p2 % pt2(:) - p1 % rpt2(:) = p1 % rpt2(:) + p2 % rpt2(:) * p2 % rpt2(:) - p1 % variance(:) = p1 % variance(:) + p2 % variance(:) * p2 % variance(:) - p1 % overlap(:,:) = p1 % overlap(:,:) + p2 % overlap(:,:) * p2 % overlap(:,:) - - else - - p1 % pt2(:) = p1 % pt2(:) + w * p2 % pt2(:) * p2 % pt2(:) - p1 % rpt2(:) = p1 % rpt2(:) + w * p2 % rpt2(:) * p2 % rpt2(:) - p1 % variance(:) = p1 % variance(:) + w * p2 % variance(:) * p2 % variance(:) - p1 % overlap(:,:) = p1 % overlap(:,:) + w * p2 % overlap(:,:) * p2 % overlap(:,:) - - endif - -end subroutine - - -subroutine pt2_serialize(pt2_data, n, x) - implicit none - use selection_types - type(pt2_type), intent(in) :: pt2_data - integer, intent(in) :: n - double precision, intent(out) :: x(*) - - integer :: i,k,n2 - - n2 = n*n - x(1:n) = pt2_data % pt2(1:n) - k=n - x(k+1:k+n) = pt2_data % rpt2(1:n) - k=k+n - x(k+1:k+n) = pt2_data % variance(1:n) - k=k+n - x(k+1:k+n2) = reshape(pt2_data % overlap(1:n,1:n), (/ n2 /)) - -end - -subroutine pt2_deserialize(pt2_data, n, x) - implicit none - use selection_types - type(pt2_type), intent(inout) :: pt2_data - integer, intent(in) :: n - double precision, intent(in) :: x(*) - - integer :: i,k,n2 - - n2 = n*n - pt2_data % pt2(1:n) = x(1:n) - k=n - pt2_data % rpt2(1:n) = x(k+1:k+n) - k=k+n - pt2_data % variance(1:n) = x(k+1:k+n) - k=k+n - pt2_data % overlap(1:n,1:n) = reshape(x(k+1:k+n2), (/ n, n /)) - -end diff --git a/src/cipsi/run_selection_slave.irp.f b/src/cipsi/run_selection_slave.irp.f index 87ebca40..38a8f362 100644 --- a/src/cipsi/run_selection_slave.irp.f +++ b/src/cipsi/run_selection_slave.irp.f @@ -1,256 +1,5 @@ -subroutine run_selection_slave(thread,iproc,energy) - use f77_zmq - use selection_types - implicit none - - double precision, intent(in) :: energy(N_states) - integer, intent(in) :: thread, iproc - integer :: rc, i - - integer :: worker_id, task_id(1), ctask, ltask - character*(512) :: task - - integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket - integer(ZMQ_PTR) :: zmq_to_qp_run_socket - - integer(ZMQ_PTR), external :: new_zmq_push_socket - integer(ZMQ_PTR) :: zmq_socket_push - - type(selection_buffer) :: buf, buf2 - logical :: done, buffer_ready - type(pt2_type) :: pt2_data - - PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order - PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order N_int pt2_F pseudo_sym - PROVIDE psi_selectors_coef_transp psi_det_sorted weight_selection - - call pt2_alloc(pt2_data,N_states) - - zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() - - integer, external :: connect_to_taskserver - if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - return - endif - - zmq_socket_push = new_zmq_push_socket(thread) - - buf%N = 0 - buffer_ready = .False. - ctask = 1 - - do - integer, external :: get_task_from_taskserver - if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id(ctask), task) == -1) then - exit - endif - done = task_id(ctask) == 0 - if (done) then - ctask = ctask - 1 - else - integer :: i_generator, N, subset, bsize - call sscanf_ddd(task, subset, i_generator, N) - if(buf%N == 0) then - ! Only first time - call create_selection_buffer(N, N*2, buf) - buffer_ready = .True. - else - if (N /= buf%N) then - print *, 'N=', N - print *, 'buf%N=', buf%N - print *, 'bug in ', irp_here - stop '-1' - end if - end if - call select_connected(i_generator, energy, pt2_data, buf, subset, pt2_F(i_generator)) - endif - - integer, external :: task_done_to_taskserver - - if(done .or. ctask == size(task_id)) then - do i=1, ctask - if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) == -1) then - call usleep(100) - if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) == -1) then - ctask = 0 - done = .true. - exit - endif - endif - end do - if(ctask > 0) then - call sort_selection_buffer(buf) -! call merge_selection_buffers(buf,buf2) - call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask) - call pt2_dealloc(pt2_data) - call pt2_alloc(pt2_data,N_states) -! buf%mini = buf2%mini - buf%cur = 0 - end if - ctask = 0 - end if - - if(done) exit - ctask = ctask + 1 - end do - - if(ctask > 0) then - call sort_selection_buffer(buf) -! call merge_selection_buffers(buf,buf2) - call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask) -! buf%mini = buf2%mini - buf%cur = 0 - end if - ctask = 0 - call pt2_dealloc(pt2_data) - - integer, external :: disconnect_from_taskserver - if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then - continue - endif - - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) - call end_zmq_push_socket(zmq_socket_push,thread) - if (buffer_ready) then - call delete_selection_buffer(buf) -! call delete_selection_buffer(buf2) - endif -end subroutine - - -subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntasks) - use f77_zmq - use selection_types - implicit none - - integer(ZMQ_PTR), intent(in) :: zmq_socket_push - type(pt2_type), intent(in) :: pt2_data - type(selection_buffer), intent(inout) :: b - integer, intent(in) :: ntasks, task_id(*) - integer :: rc - double precision, allocatable :: pt2_serialized(:) - - rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE) - if(rc /= 4) then - print *, 'f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)' - endif - - - allocate(pt2_serialized (pt2_type_size(N_states)) ) - call pt2_serialize(pt2_data,N_states,pt2_serialized) - - rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE) - if (rc == -1) then - print *, irp_here, ': error sending result' - stop 3 - return - else if(rc /= size(pt2_serialized)*8) then - stop 'push' - endif - deallocate(pt2_serialized) - - if (b%cur > 0) then - - rc = f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE) - if(rc /= 8*b%cur) then - print *, 'f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE)' - endif - - rc = f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE) - if(rc /= bit_kind*N_int*2*b%cur) then - print *, 'f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE)' - endif - - endif - - rc = f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE) - if(rc /= 4) then - print *, 'f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE)' - endif - - rc = f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0) - if(rc /= 4*ntasks) then - print *, 'f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0)' - endif - -! Activate is zmq_socket_push is a REQ -IRP_IF ZMQ_PUSH -IRP_ELSE - character*(2) :: ok - rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0) - if ((rc /= 2).and.(ok(1:2) /= 'ok')) then - print *, irp_here//': error in receiving ok' - stop -1 - endif -IRP_ENDIF - -end subroutine - - -subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_id, ntasks) - use f77_zmq - use selection_types - implicit none - integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - type(pt2_type), intent(inout) :: pt2_data - double precision, intent(out) :: val(*) - integer(bit_kind), intent(out) :: det(N_int, 2, *) - integer, intent(out) :: N, ntasks, task_id(*) - integer :: rc, rn, i - double precision, allocatable :: pt2_serialized(:) - - rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0) - if(rc /= 4) then - print *, 'f77_zmq_recv( zmq_socket_pull, N, 4, 0)' - endif - - allocate(pt2_serialized (pt2_type_size(N_states)) ) - rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized), 0) - if (rc == -1) then - ntasks = 1 - task_id(1) = 0 - else if(rc /= 8*size(pt2_serialized)) then - stop 'pull' - endif - - call pt2_deserialize(pt2_data,N_states,pt2_serialized) - deallocate(pt2_serialized) - - if (N>0) then - rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0) - if(rc /= 8*N) then - print *, 'f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0)' - endif - - rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0) - if(rc /= bit_kind*N_int*2*N) then - print *, 'f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0)' - endif - endif - - rc = f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0) - if(rc /= 4) then - print *, 'f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0)' - endif - - rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0) - if(rc /= 4*ntasks) then - print *, 'f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0)' - endif - -! Activate is zmq_socket_pull is a REP -IRP_IF ZMQ_PUSH -IRP_ELSE - rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) - if (rc /= 2) then - print *, irp_here//': error in sending ok' - stop -1 - endif -IRP_ENDIF -end subroutine - - +subroutine provide_for_selection_slave + PROVIDE psi_det_sorted_order + PROVIDE psi_selectors_coef_transp psi_det_sorted +end diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index ae84f84e..50749272 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -141,12 +141,12 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint) end -subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,buf,subset,csubset) +subroutine select_singles_and_doubles(i_generator, hole_mask, particle_mask, fock_diag_tmp, E0, pt2_data, buf, subset, csubset) use bitmasks use selection_types implicit none BEGIN_DOC -! WARNING /!\ : It is assumed that the generators and selectors are psi_det_sorted + ! WARNING /!\ : It is assumed that the generators and selectors are psi_det_sorted END_DOC integer, intent(in) :: i_generator, subset, csubset @@ -156,28 +156,35 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d type(pt2_type), intent(inout) :: pt2_data type(selection_buffer), intent(inout) :: buf - integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii,sze - integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2), pmask(N_int, 2) - logical :: fullMatch, ok + integer :: h1, h2, s1, s2, s3, i1, i2, ib, sp, k, i, j, nt, ii, sze + integer :: maskInd + integer :: N_holes(2), N_particles(2) + integer :: hole_list(N_int*bit_kind_size,2) + integer :: particle_list(N_int*bit_kind_size,2) + integer :: l_a, nmax, idx + integer :: nb_count, maskInd_save + integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2), pmask(N_int, 2) + integer(bit_kind) :: mobMask(N_int, 2), negMask(N_int, 2) + logical :: fullMatch, ok + logical :: monoAdo, monoBdo + logical :: monoBdo_save + logical :: found - integer(bit_kind) :: mobMask(N_int, 2), negMask(N_int, 2) - integer,allocatable :: preinteresting(:), prefullinteresting(:) - integer,allocatable :: interesting(:), fullinteresting(:) - integer,allocatable :: tmp_array(:) - integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) - logical, allocatable :: banned(:,:,:), bannedOrb(:,:) - double precision, allocatable :: coef_fullminilist_rev(:,:) + integer, allocatable :: preinteresting(:), prefullinteresting(:) + integer, allocatable :: interesting(:), fullinteresting(:) + integer, allocatable :: tmp_array(:) + integer, allocatable :: indices(:), exc_degree(:), iorder(:) + integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) + logical, allocatable :: banned(:,:,:), bannedOrb(:,:) + double precision, allocatable :: coef_fullminilist_rev(:,:) + double precision, allocatable :: mat(:,:,:) - double precision, allocatable :: mat(:,:,:) - - logical :: monoAdo, monoBdo - integer :: maskInd PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_rows psi_bilinear_matrix_order psi_bilinear_matrix_transp_order PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp + PROVIDE psi_selectors_coef_transp psi_det_sorted_order PROVIDE banned_excitation monoAdo = .true. @@ -192,17 +199,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), particle_mask(k,2)) enddo - - integer :: N_holes(2), N_particles(2) - integer :: hole_list(N_int*bit_kind_size,2) - integer :: particle_list(N_int*bit_kind_size,2) - call bitstring_to_list_ab(hole , hole_list , N_holes , N_int) call bitstring_to_list_ab(particle, particle_list, N_particles, N_int) - integer :: l_a, nmax, idx - integer, allocatable :: indices(:), exc_degree(:), iorder(:) - ! Removed to avoid introducing determinants already presents in the wf !double precision, parameter :: norm_thr = 1.d-16 @@ -320,22 +319,19 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d allocate(banned(mo_num, mo_num,2), bannedOrb(mo_num, 2)) - allocate (mat(N_states, mo_num, mo_num)) + allocate(mat(N_states, mo_num, mo_num)) maskInd = -1 - integer :: nb_count, maskInd_save - logical :: monoBdo_save - logical :: found - do s1=1,2 - do i1=N_holes(s1),1,-1 ! Generate low excitations first + do s1 = 1, 2 + do i1 = N_holes(s1), 1, -1 ! Generate low excitations first found = .False. monoBdo_save = monoBdo maskInd_save = maskInd - do s2=s1,2 + do s2 = s1, 2 ib = 1 if(s1 == s2) ib = i1+1 - do i2=N_holes(s2),ib,-1 + do i2 = N_holes(s2), ib, -1 maskInd = maskInd + 1 if(mod(maskInd, csubset) == (subset-1)) then found = .True. @@ -349,14 +345,14 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d maskInd = maskInd_save h1 = hole_list(i1,s1) - call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int) + call apply_hole(psi_det_generators(1,1,i_generator), s1, h1, pmask, ok, N_int) negMask = not(pmask) interesting(0) = 0 fullinteresting(0) = 0 - do ii=1,preinteresting(0) + do ii = 1, preinteresting(0) i = preinteresting(ii) select case (N_int) case (1) @@ -372,7 +368,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d mobMask(1:3,1) = iand(negMask(1:3,1), psi_det_sorted(1:3,1,i)) mobMask(1:3,2) = iand(negMask(1:3,2), psi_det_sorted(1:3,2,i)) nt = 0 - do j=3,1,-1 + do j = 3, 1, -1 if (mobMask(j,1) /= 0_bit_kind) then nt = nt+ popcnt(mobMask(j, 1)) if (nt > 4) exit @@ -386,7 +382,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d mobMask(1:4,1) = iand(negMask(1:4,1), psi_det_sorted(1:4,1,i)) mobMask(1:4,2) = iand(negMask(1:4,2), psi_det_sorted(1:4,2,i)) nt = 0 - do j=4,1,-1 + do j = 4, 1, -1 if (mobMask(j,1) /= 0_bit_kind) then nt = nt+ popcnt(mobMask(j, 1)) if (nt > 4) exit @@ -400,7 +396,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d mobMask(1:N_int,1) = iand(negMask(1:N_int,1), psi_det_sorted(1:N_int,1,i)) mobMask(1:N_int,2) = iand(negMask(1:N_int,2), psi_det_sorted(1:N_int,2,i)) nt = 0 - do j=N_int,1,-1 + do j = N_int, 1, -1 if (mobMask(j,1) /= 0_bit_kind) then nt = nt+ popcnt(mobMask(j, 1)) if (nt > 4) exit @@ -441,7 +437,7 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d end do - do ii=1,prefullinteresting(0) + do ii = 1, prefullinteresting(0) i = prefullinteresting(ii) nt = 0 mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) @@ -480,40 +476,38 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d minilist(:,:,i) = psi_det_sorted(:,:,interesting(i)) enddo - do s2=s1,2 + do s2 = s1, 2 sp = s1 - if(s1 /= s2) then - sp = 3 - endif + if(s1 /= s2) sp = 3 ib = 1 if(s1 == s2) ib = i1+1 monoAdo = .true. - do i2=N_holes(s2),ib,-1 ! Generate low excitations first + do i2 = N_holes(s2), ib, -1 ! Generate low excitations first h2 = hole_list(i2,s2) call apply_hole(pmask, s2,h2, mask, ok, N_int) banned(:,:,1) = banned_excitation(:,:) banned(:,:,2) = banned_excitation(:,:) - do j=1,mo_num + do j = 1, mo_num bannedOrb(j, 1) = .true. bannedOrb(j, 2) = .true. enddo - do s3=1,2 - do i=1,N_particles(s3) + do s3 = 1, 2 + do i = 1, N_particles(s3) bannedOrb(particle_list(i,s3), s3) = .false. enddo enddo if(s1 /= s2) then if(monoBdo) then bannedOrb(h1,s1) = .false. - end if + endif if(monoAdo) then bannedOrb(h2,s2) = .false. monoAdo = .false. - end if - end if + endif + endif maskInd = maskInd + 1 if(mod(maskInd, csubset) == (subset-1)) then @@ -522,12 +516,18 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d if(fullMatch) cycle call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting) + call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2_data, mat, buf) end if + + enddo + if(s1 /= s2) monoBdo = .false. enddo - deallocate(fullminilist,minilist) + + deallocate(fullminilist, minilist) + enddo enddo deallocate(preinteresting, prefullinteresting, interesting, fullinteresting) diff --git a/src/cipsi/selection_types.f90 b/src/cipsi/selection_types.f90 deleted file mode 100644 index 58ce0e03..00000000 --- a/src/cipsi/selection_types.f90 +++ /dev/null @@ -1,25 +0,0 @@ -module selection_types - type selection_buffer - integer :: N, cur - integer(8) , pointer :: det(:,:,:) - double precision, pointer :: val(:) - double precision :: mini - endtype - - type pt2_type - double precision, allocatable :: pt2(:) - double precision, allocatable :: rpt2(:) - double precision, allocatable :: variance(:) - double precision, allocatable :: overlap(:,:) - endtype - - contains - - integer function pt2_type_size(N) - implicit none - integer, intent(in) :: N - pt2_type_size = (3*n + n*n) - end function - -end module - diff --git a/src/cipsi_utils/README.rst b/src/cipsi_utils/README.rst new file mode 100644 index 00000000..8e98e3ac --- /dev/null +++ b/src/cipsi_utils/README.rst @@ -0,0 +1,5 @@ +=========== +cipsi_utils +=========== + +Common functions for CIPSI and TC-CIPSI diff --git a/src/cipsi/environment.irp.f b/src/cipsi_utils/environment.irp.f similarity index 100% rename from src/cipsi/environment.irp.f rename to src/cipsi_utils/environment.irp.f diff --git a/src/cipsi_utils/pt2_stoch_routines.irp.f b/src/cipsi_utils/pt2_stoch_routines.irp.f new file mode 100644 index 00000000..f067d0be --- /dev/null +++ b/src/cipsi_utils/pt2_stoch_routines.irp.f @@ -0,0 +1,891 @@ +BEGIN_PROVIDER [ integer, pt2_stoch_istate ] + implicit none + BEGIN_DOC + ! State for stochatsic PT2 + END_DOC + pt2_stoch_istate = 1 +END_PROVIDER + + BEGIN_PROVIDER [ integer, pt2_F, (N_det_generators) ] +&BEGIN_PROVIDER [ integer, pt2_n_tasks_max ] + implicit none + logical, external :: testTeethBuilding + integer :: i,j + pt2_n_tasks_max = elec_alpha_num*elec_alpha_num + elec_alpha_num*elec_beta_num - n_core_orb*2 + pt2_n_tasks_max = min(pt2_n_tasks_max,1+N_det_generators/10000) + call write_int(6,pt2_n_tasks_max,'pt2_n_tasks_max') + + pt2_F(:) = max(int(sqrt(float(pt2_n_tasks_max))),1) + do i=1,pt2_n_0(1+pt2_N_teeth/4) + pt2_F(i) = pt2_n_tasks_max*pt2_min_parallel_tasks + enddo + do i=1+pt2_n_0(pt2_N_teeth-pt2_N_teeth/4), pt2_n_0(pt2_N_teeth-pt2_N_teeth/10) + pt2_F(i) = pt2_min_parallel_tasks + enddo + do i=1+pt2_n_0(pt2_N_teeth-pt2_N_teeth/10), N_det_generators + pt2_F(i) = 1 + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ integer, pt2_N_teeth ] +&BEGIN_PROVIDER [ integer, pt2_minDetInFirstTeeth ] + implicit none + logical, external :: testTeethBuilding + + if(N_det_generators < 1024) then + pt2_minDetInFirstTeeth = 1 + pt2_N_teeth = 1 + else + pt2_minDetInFirstTeeth = min(5, N_det_generators) + do pt2_N_teeth=100,2,-1 + if(testTeethBuilding(pt2_minDetInFirstTeeth, pt2_N_teeth)) exit + end do + end if + call write_int(6,pt2_N_teeth,'Number of comb teeth') +END_PROVIDER + + +logical function testTeethBuilding(minF, N) + implicit none + integer, intent(in) :: minF, N + integer :: n0, i + double precision :: u0, Wt, r + + double precision, allocatable :: tilde_w(:), tilde_cW(:) + integer, external :: dress_find_sample + + double precision :: rss + double precision, external :: memory_of_double, memory_of_int + + rss = memory_of_double(2*N_det_generators+1) + call check_mem(rss,irp_here) + + allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) + + double precision :: norm2 + norm2 = 0.d0 + do i=N_det_generators,1,-1 + tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate) * & + psi_coef_sorted_gen(i,pt2_stoch_istate) + norm2 = norm2 + tilde_w(i) + enddo + + f = 1.d0/norm2 + tilde_w(:) = tilde_w(:) * f + + tilde_cW(0) = -1.d0 + do i=1,N_det_generators + tilde_cW(i) = tilde_cW(i-1) + tilde_w(i) + enddo + tilde_cW(:) = tilde_cW(:) + 1.d0 + deallocate(tilde_w) + + n0 = 0 + testTeethBuilding = .false. + double precision :: f + integer :: minFN + minFN = N_det_generators - minF * N + f = 1.d0/dble(N) + do + u0 = tilde_cW(n0) + r = tilde_cW(n0 + minF) + Wt = (1d0 - u0) * f + if (dabs(Wt) <= 1.d-3) then + exit + endif + if(Wt >= r - u0) then + testTeethBuilding = .true. + exit + end if + n0 += 1 + if(n0 > minFN) then + exit + end if + end do + deallocate(tilde_cW) + +end function + + +!subroutine provide_for_zmq_pt2 +! PROVIDE psi_det_sorted_order psi_selectors_coef_transp psi_det_sorted +!end + +subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) + use f77_zmq + use selection_types + + implicit none + + integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull + integer, intent(in) :: N_in + double precision, intent(in) :: relative_error, E(N_states) + type(pt2_type), intent(inout) :: pt2_data, pt2_data_err +! + integer :: i, N + + double precision :: state_average_weight_save(N_states), w(N_states,4) + integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket + type(selection_buffer) :: b + + PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique + PROVIDE psi_bilinear_matrix_rows psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns + PROVIDE psi_bilinear_matrix_transp_order + PROVIDE psi_det_hii selection_weight pseudo_sym + PROVIDE n_act_orb n_inact_orb n_core_orb n_virt_orb n_del_orb seniority_max + PROVIDE excitation_beta_max excitation_alpha_max excitation_max + + call provide_for_zmq_pt2 + + if (h0_type == 'CFG') then + PROVIDE psi_configuration_hii det_to_configuration + endif + + if (N_det <= max(4,N_states) .or. pt2_N_teeth < 2) then + call ZMQ_selection(N_in, pt2_data) + else + + N = max(N_in,1) * N_states + state_average_weight_save(:) = state_average_weight(:) + if (int(N,8)*2_8 > huge(1)) then + print *, irp_here, ': integer too large' + stop -1 + endif + call create_selection_buffer(N, N*2, b) + ASSERT (associated(b%det)) + ASSERT (associated(b%val)) + + do pt2_stoch_istate=1,N_states + state_average_weight(:) = 0.d0 + state_average_weight(pt2_stoch_istate) = 1.d0 + TOUCH state_average_weight pt2_stoch_istate selection_weight + + PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w + PROVIDE psi_selectors pt2_u pt2_J pt2_R + call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') + + integer, external :: zmq_put_psi + integer, external :: zmq_put_N_det_generators + integer, external :: zmq_put_N_det_selectors + integer, external :: zmq_put_dvector + integer, external :: zmq_put_ivector + if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then + stop 'Unable to put psi on ZMQ server' + endif + if (zmq_put_N_det_generators(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_generators on ZMQ server' + endif + if (zmq_put_N_det_selectors(zmq_to_qp_run_socket, 1) == -1) then + stop 'Unable to put N_det_selectors on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',pt2_e0_denominator,size(pt2_e0_denominator)) == -1) then + stop 'Unable to put energy on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'state_average_weight',state_average_weight,N_states) == -1) then + stop 'Unable to put state_average_weight on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'selection_weight',selection_weight,N_states) == -1) then + stop 'Unable to put selection_weight on ZMQ server' + endif + if (zmq_put_ivector(zmq_to_qp_run_socket,1,'pt2_stoch_istate',pt2_stoch_istate,1) == -1) then + stop 'Unable to put pt2_stoch_istate on ZMQ server' + endif + if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_generators',(/threshold_generators/),1) == -1) then + stop 'Unable to put threshold_generators on ZMQ server' + endif + + + integer, external :: add_task_to_taskserver + character(300000) :: task + + integer :: j,k,ipos,ifirst + ifirst=0 + + ipos=0 + do i=1,N_det_generators + if (pt2_F(i) > 1) then + ipos += 1 + endif + enddo + call write_int(6,sum(pt2_F),'Number of tasks') + call write_int(6,ipos,'Number of fragmented tasks') + + ipos=1 + do i= 1, N_det_generators + do j=1,pt2_F(pt2_J(i)) + write(task(ipos:ipos+30),'(I9,1X,I9,1X,I9,''|'')') j, pt2_J(i), N_in + ipos += 30 + if (ipos > 300000-30) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + ipos=1 + if (ifirst == 0) then + ifirst=1 + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + endif + endif + end do + enddo + if (ipos > 1) then + if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then + stop 'Unable to add task to task server' + endif + endif + + integer, external :: zmq_set_running + if (zmq_set_running(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Failed in zmq_set_running' + endif + + + double precision :: mem_collector, mem, rss + + call resident_memory(rss) + + mem_collector = 8.d0 * & ! bytes + ( 1.d0*pt2_n_tasks_max & ! task_id, index + + 0.635d0*N_det_generators & ! f,d + + pt2_n_tasks_max*pt2_type_size(N_states) & ! pt2_data_task + + N_det_generators*pt2_type_size(N_states) & ! pt2_data_I + + 4.d0*(pt2_N_teeth+1) & ! S, S2, T2, T3 + + 1.d0*(N_int*2.d0*N + N) & ! selection buffer + + 1.d0*(N_int*2.d0*N + N) & ! sort selection buffer + ) / 1024.d0**3 + + integer :: nproc_target, ii + nproc_target = nthreads_pt2 + ii = min(N_det, (elec_alpha_num*(mo_num-elec_alpha_num))**2) + + do + mem = mem_collector + & ! + nproc_target * 8.d0 * & ! bytes + ( 0.5d0*pt2_n_tasks_max & ! task_id + + 64.d0*pt2_n_tasks_max & ! task + + pt2_type_size(N_states)*pt2_n_tasks_max*N_states & ! pt2, variance, overlap + + 1.d0*pt2_n_tasks_max & ! i_generator, subset + + 1.d0*(N_int*2.d0*ii+ ii) & ! selection buffer + + 1.d0*(N_int*2.d0*ii+ ii) & ! sort selection buffer + + 2.0d0*(ii) & ! preinteresting, interesting, + ! prefullinteresting, fullinteresting + + 2.0d0*(N_int*2*ii) & ! minilist, fullminilist + + 1.0d0*(N_states*mo_num*mo_num) & ! mat + ) / 1024.d0**3 + + if (nproc_target == 0) then + call check_mem(mem,irp_here) + nproc_target = 1 + exit + endif + + if (mem+rss < qp_max_mem) then + exit + endif + + nproc_target = nproc_target - 1 + + enddo + call write_int(6,nproc_target,'Number of threads for PT2') + call write_double(6,mem,'Memory (Gb)') + + call set_multiple_levels_omp(.False.) + + + print '(A)', '========== ==================== ================ ================ ================ ============= ===========' + print '(A)', ' Samples Energy PT2 Variance Norm^2 Convergence Seconds' + print '(A)', '========== ==================== ================ ================ ================ ============= ===========' + + PROVIDE global_selection_buffer + + !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(nproc_target+1) & + !$OMP PRIVATE(i) + i = omp_get_thread_num() + if (i==0) then + + call pt2_collector(zmq_socket_pull, E(pt2_stoch_istate),relative_error, pt2_data, pt2_data_err, b, N) + pt2_data % rpt2(pt2_stoch_istate) = & + pt2_data % pt2(pt2_stoch_istate)/(1.d0+pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate)) + + !TODO : We should use here the correct formula for the error of X/Y + pt2_data_err % rpt2(pt2_stoch_istate) = & + pt2_data_err % pt2(pt2_stoch_istate)/(1.d0 + pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate)) + + else + call pt2_slave_inproc(i) + endif + !$OMP END PARALLEL + call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2') + call set_multiple_levels_omp(.True.) + + print '(A)', '========== ==================== ================ ================ ================ ============= ===========' + + + do k=1,N_states + pt2_overlap(pt2_stoch_istate,k) = pt2_data % overlap(k,pt2_stoch_istate) + enddo + SOFT_TOUCH pt2_overlap + + enddo + FREE pt2_stoch_istate + + ! Symmetrize overlap + do j=2,N_states + do i=1,j-1 + pt2_overlap(i,j) = 0.5d0 * (pt2_overlap(i,j) + pt2_overlap(j,i)) + pt2_overlap(j,i) = pt2_overlap(i,j) + enddo + enddo + + print *, 'Overlap of perturbed states:' + do k=1,N_states + print *, pt2_overlap(k,:) + enddo + print *, '-------' + + if (N_in > 0) then + b%cur = min(N_in,b%cur) + if (s2_eig) then + call make_selection_buffer_s2(b) + else + call remove_duplicates_in_selection_buffer(b) + endif + call fill_H_apply_buffer_no_selection(b%cur,b%det,N_int,0) + endif + call delete_selection_buffer(b) + + state_average_weight(:) = state_average_weight_save(:) + TOUCH state_average_weight + call update_pt2_and_variance_weights(pt2_data, N_states) + endif + + +end subroutine + + +subroutine pt2_slave_inproc(i) + implicit none + integer, intent(in) :: i + + PROVIDE global_selection_buffer + call run_pt2_slave(1,i,pt2_e0_denominator) +end + + +subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_err, b, N_) + use f77_zmq + use selection_types + use bitmasks + implicit none + + + integer(ZMQ_PTR), intent(in) :: zmq_socket_pull + double precision, intent(in) :: relative_error, E + type(pt2_type), intent(inout) :: pt2_data, pt2_data_err + type(selection_buffer), intent(inout) :: b + integer, intent(in) :: N_ + + type(pt2_type), allocatable :: pt2_data_task(:) + type(pt2_type), allocatable :: pt2_data_I(:) + type(pt2_type), allocatable :: pt2_data_S(:) + type(pt2_type), allocatable :: pt2_data_S2(:) + type(pt2_type) :: pt2_data_teeth + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + integer, external :: zmq_delete_tasks_async_send + integer, external :: zmq_delete_tasks_async_recv + integer, external :: zmq_abort + integer, external :: pt2_find_sample_lr + + PROVIDE pt2_stoch_istate + + integer :: more, n, i, p, c, t, n_tasks, U + integer, allocatable :: task_id(:) + integer, allocatable :: index(:) + + double precision :: v, x, x2, x3, avg, avg2, avg3(N_states), eqt, E0, v0, n0(N_states) + double precision :: eqta(N_states) + double precision :: time, time1, time0 + + integer, allocatable :: f(:) + logical, allocatable :: d(:) + logical :: do_exit, stop_now, sending + logical, external :: qp_stop + type(selection_buffer) :: b2 + + + double precision :: rss + double precision, external :: memory_of_double, memory_of_int + + character(len=20) :: format_str1, str_error1, format_str2, str_error2 + character(len=20) :: format_str3, str_error3, format_str4, str_error4 + character(len=20) :: format_value1, format_value2, format_value3, format_value4 + character(len=20) :: str_value1, str_value2, str_value3, str_value4 + character(len=20) :: str_conv + double precision :: value1, value2, value3, value4 + double precision :: error1, error2, error3, error4 + integer :: size1,size2,size3,size4 + + double precision :: conv_crit + + sending =.False. + + rss = memory_of_int(pt2_n_tasks_max*2+N_det_generators*2) + rss += memory_of_double(N_states*N_det_generators)*3.d0 + rss += memory_of_double(N_states*pt2_n_tasks_max)*3.d0 + rss += memory_of_double(pt2_N_teeth+1)*4.d0 + call check_mem(rss,irp_here) + + ! If an allocation is added here, the estimate of the memory should also be + ! updated in ZMQ_pt2 + allocate(task_id(pt2_n_tasks_max), index(pt2_n_tasks_max), f(N_det_generators)) + allocate(d(N_det_generators+1)) + allocate(pt2_data_task(pt2_n_tasks_max)) + allocate(pt2_data_I(N_det_generators)) + allocate(pt2_data_S(pt2_N_teeth+1)) + allocate(pt2_data_S2(pt2_N_teeth+1)) + + + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + call create_selection_buffer(N_, N_*2, b2) + + + pt2_data % pt2(pt2_stoch_istate) = -huge(1.) + pt2_data_err % pt2(pt2_stoch_istate) = huge(1.) + pt2_data % variance(pt2_stoch_istate) = huge(1.) + pt2_data_err % variance(pt2_stoch_istate) = huge(1.) + pt2_data % overlap(:,pt2_stoch_istate) = 0.d0 + pt2_data_err % overlap(:,pt2_stoch_istate) = huge(1.) + n = 1 + t = 0 + U = 0 + do i=1,pt2_n_tasks_max + call pt2_alloc(pt2_data_task(i),N_states) + enddo + do i=1,pt2_N_teeth+1 + call pt2_alloc(pt2_data_S(i),N_states) + call pt2_alloc(pt2_data_S2(i),N_states) + enddo + do i=1,N_det_generators + call pt2_alloc(pt2_data_I(i),N_states) + enddo + f(:) = pt2_F(:) + d(:) = .false. + n_tasks = 0 + E0 = E + v0 = 0.d0 + n0(:) = 0.d0 + more = 1 + call wall_time(time0) + time1 = time0 + + do_exit = .false. + stop_now = .false. + do while (n <= N_det_generators) + if(f(pt2_J(n)) == 0) then + d(pt2_J(n)) = .true. + do while(d(U+1)) + U += 1 + end do + + ! Deterministic part + do while(t <= pt2_N_teeth) + if(U >= pt2_n_0(t+1)) then + t=t+1 + E0 = 0.d0 + v0 = 0.d0 + n0(:) = 0.d0 + do i=pt2_n_0(t),1,-1 + E0 += pt2_data_I(i) % pt2(pt2_stoch_istate) + v0 += pt2_data_I(i) % variance(pt2_stoch_istate) + n0(:) += pt2_data_I(i) % overlap(:,pt2_stoch_istate) + end do + else + exit + end if + end do + + ! Add Stochastic part + c = pt2_R(n) + if(c > 0) then + + call pt2_alloc(pt2_data_teeth,N_states) + do p=pt2_N_teeth, 1, -1 + v = pt2_u_0 + pt2_W_T * (pt2_u(c) + dble(p-1)) + i = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(p),pt2_n_0(p+1)) + v = pt2_W_T / pt2_w(i) + call pt2_add ( pt2_data_teeth, v, pt2_data_I(i) ) + call pt2_add ( pt2_data_S(p), 1.d0, pt2_data_teeth ) + call pt2_add2( pt2_data_S2(p), 1.d0, pt2_data_teeth ) + enddo + call pt2_dealloc(pt2_data_teeth) + + avg = E0 + pt2_data_S(t) % pt2(pt2_stoch_istate) / dble(c) + avg2 = v0 + pt2_data_S(t) % variance(pt2_stoch_istate) / dble(c) + avg3(:) = n0(:) + pt2_data_S(t) % overlap(:,pt2_stoch_istate) / dble(c) + if ((avg /= 0.d0) .or. (n == N_det_generators) ) then + do_exit = .true. + endif + if (qp_stop()) then + stop_now = .True. + endif + pt2_data % pt2(pt2_stoch_istate) = avg + pt2_data % variance(pt2_stoch_istate) = avg2 + pt2_data % overlap(:,pt2_stoch_istate) = avg3(:) + call wall_time(time) + ! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969) + if(c > 2) then + eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability + eqt = sqrt(eqt / (dble(c) - 1.5d0)) + pt2_data_err % pt2(pt2_stoch_istate) = eqt + + eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability + eqt = sqrt(eqt / (dble(c) - 1.5d0)) + pt2_data_err % variance(pt2_stoch_istate) = eqt + + eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability + eqta(:) = sqrt(eqta(:) / (dble(c) - 1.5d0)) + pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:) + + + if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then + time1 = time + print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.4)', c, & + pt2_data % pt2(pt2_stoch_istate) +E, & + pt2_data_err % pt2(pt2_stoch_istate), & + pt2_data % variance(pt2_stoch_istate), & + pt2_data_err % variance(pt2_stoch_istate), & + pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate), & + pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate), & + time-time0 + if (stop_now .or. ( & + (do_exit .and. (dabs(pt2_data_err % pt2(pt2_stoch_istate)) / & + (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) <= relative_error))) ) then + if (zmq_abort(zmq_to_qp_run_socket) == -1) then + call sleep(10) + if (zmq_abort(zmq_to_qp_run_socket) == -1) then + print *, irp_here, ': Error in sending abort signal (2)' + endif + endif + endif + endif + endif + end if + n += 1 + else if(more == 0) then + exit + else + call pull_pt2_results(zmq_socket_pull, index, pt2_data_task, task_id, n_tasks, b2) + if(n_tasks > pt2_n_tasks_max)then + print*,'PB !!!' + print*,'If you see this, send a bug report with the following content' + print*,irp_here + print*,'n_tasks,pt2_n_tasks_max = ',n_tasks,pt2_n_tasks_max + stop -1 + endif + if (zmq_delete_tasks_async_send(zmq_to_qp_run_socket,task_id,n_tasks,sending) == -1) then + stop 'PT2: Unable to delete tasks (send)' + endif + do i=1,n_tasks + if(index(i).gt.size(pt2_data_I,1).or.index(i).lt.1)then + print*,'PB !!!' + print*,'If you see this, send a bug report with the following content' + print*,irp_here + print*,'i,index(i),size(pt2_data_I,1) = ',i,index(i),size(pt2_data_I,1) + stop -1 + endif + call pt2_add(pt2_data_I(index(i)),1.d0,pt2_data_task(i)) + f(index(i)) -= 1 + end do + do i=1, b2%cur + ! We assume the pulled buffer is sorted + if (b2%val(i) > b%mini) exit + call add_to_selection_buffer(b, b2%det(1,1,i), b2%val(i)) + end do + if (zmq_delete_tasks_async_recv(zmq_to_qp_run_socket,more,sending) == -1) then + stop 'PT2: Unable to delete tasks (recv)' + endif + end if + end do + do i=1,N_det_generators + call pt2_dealloc(pt2_data_I(i)) + enddo + do i=1,pt2_N_teeth+1 + call pt2_dealloc(pt2_data_S(i)) + call pt2_dealloc(pt2_data_S2(i)) + enddo + do i=1,pt2_n_tasks_max + call pt2_dealloc(pt2_data_task(i)) + enddo +!print *, 'deleting b2' + call delete_selection_buffer(b2) +!print *, 'sorting b' + call sort_selection_buffer(b) +!print *, 'done' + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + +end subroutine + + +integer function pt2_find_sample(v, w) + implicit none + double precision, intent(in) :: v, w(0:N_det_generators) + integer, external :: pt2_find_sample_lr + + pt2_find_sample = pt2_find_sample_lr(v, w, 0, N_det_generators) +end function + + +integer function pt2_find_sample_lr(v, w, l_in, r_in) + implicit none + double precision, intent(in) :: v, w(0:N_det_generators) + integer, intent(in) :: l_in,r_in + integer :: i,l,r + + l=l_in + r=r_in + + do while(r-l > 1) + i = shiftr(r+l,1) + if(w(i) < v) then + l = i + else + r = i + end if + end do + i = r + do r=i+1,N_det_generators + if (w(r) /= w(i)) then + exit + endif + enddo + pt2_find_sample_lr = r-1 +end function + + +BEGIN_PROVIDER [ integer, pt2_n_tasks ] + implicit none + BEGIN_DOC + ! Number of parallel tasks for the Monte Carlo + END_DOC + pt2_n_tasks = N_det_generators +END_PROVIDER + +BEGIN_PROVIDER[ double precision, pt2_u, (N_det_generators)] + implicit none + integer, allocatable :: seed(:) + integer :: m,i + call random_seed(size=m) + allocate(seed(m)) + do i=1,m + seed(i) = i + enddo + call random_seed(put=seed) + deallocate(seed) + + call RANDOM_NUMBER(pt2_u) + END_PROVIDER + + BEGIN_PROVIDER[ integer, pt2_J, (N_det_generators)] +&BEGIN_PROVIDER[ integer, pt2_R, (N_det_generators)] + implicit none + BEGIN_DOC +! pt2_J contains the list of generators after ordering them according to the +! Monte Carlo sampling. +! +! pt2_R(i) is the number of combs drawn when determinant i is computed. + END_DOC + integer :: N_c, N_j + integer :: U, t, i + double precision :: v + integer, external :: pt2_find_sample_lr + + logical, allocatable :: pt2_d(:) + integer :: m,l,r,k + integer :: ncache + integer, allocatable :: ii(:,:) + double precision :: dt + + ncache = min(N_det_generators,10000) + + double precision :: rss + double precision, external :: memory_of_double, memory_of_int + rss = memory_of_int(ncache)*dble(pt2_N_teeth) + memory_of_int(N_det_generators) + call check_mem(rss,irp_here) + + allocate(ii(pt2_N_teeth,ncache),pt2_d(N_det_generators)) + + pt2_R(:) = 0 + pt2_d(:) = .false. + N_c = 0 + N_j = pt2_n_0(1) + do i=1,N_j + pt2_d(i) = .true. + pt2_J(i) = i + end do + + U = 0 + do while(N_j < pt2_n_tasks) + + if (N_c+ncache > N_det_generators) then + ncache = N_det_generators - N_c + endif + + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(dt,v,t,k) + do k=1, ncache + dt = pt2_u_0 + do t=1, pt2_N_teeth + v = dt + pt2_W_T *pt2_u(N_c+k) + dt = dt + pt2_W_T + ii(t,k) = pt2_find_sample_lr(v, pt2_cW,pt2_n_0(t),pt2_n_0(t+1)) + end do + enddo + !$OMP END PARALLEL DO + + do k=1,ncache + !ADD_COMB + N_c = N_c+1 + do t=1, pt2_N_teeth + i = ii(t,k) + if(.not. pt2_d(i)) then + N_j += 1 + pt2_J(N_j) = i + pt2_d(i) = .true. + end if + end do + + pt2_R(N_j) = N_c + + !FILL_TOOTH + do while(U < N_det_generators) + U += 1 + if(.not. pt2_d(U)) then + N_j += 1 + pt2_J(N_j) = U + pt2_d(U) = .true. + exit + end if + end do + if (N_j >= pt2_n_tasks) exit + end do + enddo + + if(N_det_generators > 1) then + pt2_R(N_det_generators-1) = 0 + pt2_R(N_det_generators) = N_c + end if + + deallocate(ii,pt2_d) + +END_PROVIDER + + + + BEGIN_PROVIDER [ double precision, pt2_w, (N_det_generators) ] +&BEGIN_PROVIDER [ double precision, pt2_cW, (0:N_det_generators) ] +&BEGIN_PROVIDER [ double precision, pt2_W_T ] +&BEGIN_PROVIDER [ double precision, pt2_u_0 ] +&BEGIN_PROVIDER [ integer, pt2_n_0, (pt2_N_teeth+1) ] + implicit none + integer :: i, t + double precision, allocatable :: tilde_w(:), tilde_cW(:) + double precision :: r, tooth_width + integer, external :: pt2_find_sample + + double precision :: rss + double precision, external :: memory_of_double, memory_of_int + rss = memory_of_double(2*N_det_generators+1) + call check_mem(rss,irp_here) + + if (N_det_generators == 1) then + + pt2_w(1) = 1.d0 + pt2_cw(1) = 1.d0 + pt2_u_0 = 1.d0 + pt2_W_T = 0.d0 + pt2_n_0(1) = 0 + pt2_n_0(2) = 1 + + else + + allocate(tilde_w(N_det_generators), tilde_cW(0:N_det_generators)) + + tilde_cW(0) = 0d0 + + do i=1,N_det_generators + tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20 + enddo + + double precision :: norm2 + norm2 = 0.d0 + do i=N_det_generators,1,-1 + norm2 += tilde_w(i) + enddo + + tilde_w(:) = tilde_w(:) / norm2 + + tilde_cW(0) = -1.d0 + do i=1,N_det_generators + tilde_cW(i) = tilde_cW(i-1) + tilde_w(i) + enddo + tilde_cW(:) = tilde_cW(:) + 1.d0 + + pt2_n_0(1) = 0 + do + pt2_u_0 = tilde_cW(pt2_n_0(1)) + r = tilde_cW(pt2_n_0(1) + pt2_minDetInFirstTeeth) + pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth) + if(pt2_W_T >= r - pt2_u_0) then + exit + end if + pt2_n_0(1) += 1 + if(N_det_generators - pt2_n_0(1) < pt2_minDetInFirstTeeth * pt2_N_teeth) then + print *, "teeth building failed" + stop -1 + end if + end do + + do t=2, pt2_N_teeth + r = pt2_u_0 + pt2_W_T * dble(t-1) + pt2_n_0(t) = pt2_find_sample(r, tilde_cW) + end do + pt2_n_0(pt2_N_teeth+1) = N_det_generators + + pt2_w(:pt2_n_0(1)) = tilde_w(:pt2_n_0(1)) + do t=1, pt2_N_teeth + tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t)) + if (tooth_width == 0.d0) then + tooth_width = sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1))) + endif + ASSERT(tooth_width > 0.d0) + do i=pt2_n_0(t)+1, pt2_n_0(t+1) + pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width + end do + end do + + pt2_cW(0) = 0d0 + do i=1,N_det_generators + pt2_cW(i) = pt2_cW(i-1) + pt2_w(i) + end do + pt2_n_0(pt2_N_teeth+1) = N_det_generators + + endif +END_PROVIDER + + + + + +BEGIN_PROVIDER [ double precision, pt2_overlap, (N_states, N_states) ] + implicit none + BEGIN_DOC + ! Overlap between the perturbed wave functions + END_DOC + pt2_overlap(1:N_states,1:N_states) = 0.d0 +END_PROVIDER + + diff --git a/plugins/local/cipsi_tc_bi_ortho/pt2_type.irp.f b/src/cipsi_utils/pt2_type.irp.f similarity index 100% rename from plugins/local/cipsi_tc_bi_ortho/pt2_type.irp.f rename to src/cipsi_utils/pt2_type.irp.f diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi_utils/run_pt2_slave.irp.f similarity index 100% rename from src/cipsi/run_pt2_slave.irp.f rename to src/cipsi_utils/run_pt2_slave.irp.f diff --git a/src/cipsi_utils/run_selection_slave.irp.f b/src/cipsi_utils/run_selection_slave.irp.f new file mode 100644 index 00000000..783bed0f --- /dev/null +++ b/src/cipsi_utils/run_selection_slave.irp.f @@ -0,0 +1,257 @@ +subroutine run_selection_slave(thread,iproc,energy) + use f77_zmq + use selection_types + implicit none + + double precision, intent(in) :: energy(N_states) + integer, intent(in) :: thread, iproc + integer :: rc, i + + integer :: worker_id, task_id(1), ctask, ltask + character*(512) :: task + + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + integer(ZMQ_PTR), external :: new_zmq_push_socket + integer(ZMQ_PTR) :: zmq_socket_push + + type(selection_buffer) :: buf, buf2 + logical :: done, buffer_ready + type(pt2_type) :: pt2_data + + PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique + PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns + PROVIDE psi_bilinear_matrix_transp_order N_int pt2_F pseudo_sym + PROVIDE psi_bilinear_matrix_rows psi_bilinear_matrix_order weight_selection + + call provide_for_selection_slave + + call pt2_alloc(pt2_data,N_states) + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + + integer, external :: connect_to_taskserver + if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + return + endif + + zmq_socket_push = new_zmq_push_socket(thread) + + buf%N = 0 + buffer_ready = .False. + ctask = 1 + + do + integer, external :: get_task_from_taskserver + if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id(ctask), task) == -1) then + exit + endif + done = task_id(ctask) == 0 + if (done) then + ctask = ctask - 1 + else + integer :: i_generator, N, subset, bsize + call sscanf_ddd(task, subset, i_generator, N) + if(buf%N == 0) then + ! Only first time + call create_selection_buffer(N, N*2, buf) + buffer_ready = .True. + else + if (N /= buf%N) then + print *, 'N=', N + print *, 'buf%N=', buf%N + print *, 'bug in ', irp_here + stop '-1' + end if + end if + call select_connected(i_generator, energy, pt2_data, buf, subset, pt2_F(i_generator)) + endif + + integer, external :: task_done_to_taskserver + + if(done .or. ctask == size(task_id)) then + do i=1, ctask + if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) == -1) then + call usleep(100) + if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id(i)) == -1) then + ctask = 0 + done = .true. + exit + endif + endif + end do + if(ctask > 0) then + call sort_selection_buffer(buf) +! call merge_selection_buffers(buf,buf2) + call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask) + call pt2_dealloc(pt2_data) + call pt2_alloc(pt2_data,N_states) +! buf%mini = buf2%mini + buf%cur = 0 + end if + ctask = 0 + end if + + if(done) exit + ctask = ctask + 1 + end do + + if(ctask > 0) then + call sort_selection_buffer(buf) +! call merge_selection_buffers(buf,buf2) + call push_selection_results(zmq_socket_push, pt2_data, buf, task_id(1), ctask) +! buf%mini = buf2%mini + buf%cur = 0 + end if + ctask = 0 + call pt2_dealloc(pt2_data) + + integer, external :: disconnect_from_taskserver + if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then + continue + endif + + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + call end_zmq_push_socket(zmq_socket_push,thread) + if (buffer_ready) then + call delete_selection_buffer(buf) +! call delete_selection_buffer(buf2) + endif +end subroutine + + +subroutine push_selection_results(zmq_socket_push, pt2_data, b, task_id, ntasks) + use f77_zmq + use selection_types + implicit none + + integer(ZMQ_PTR), intent(in) :: zmq_socket_push + type(pt2_type), intent(in) :: pt2_data + type(selection_buffer), intent(inout) :: b + integer, intent(in) :: ntasks, task_id(*) + integer :: rc + double precision, allocatable :: pt2_serialized(:) + + rc = f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE) + if(rc /= 4) then + print *, 'f77_zmq_send( zmq_socket_push, b%cur, 4, ZMQ_SNDMORE)' + endif + + + allocate(pt2_serialized (pt2_type_size(N_states)) ) + call pt2_serialize(pt2_data,N_states,pt2_serialized) + + rc = f77_zmq_send( zmq_socket_push, pt2_serialized, size(pt2_serialized)*8, ZMQ_SNDMORE) + if (rc == -1) then + print *, irp_here, ': error sending result' + stop 3 + return + else if(rc /= size(pt2_serialized)*8) then + stop 'push' + endif + deallocate(pt2_serialized) + + if (b%cur > 0) then + + rc = f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE) + if(rc /= 8*b%cur) then + print *, 'f77_zmq_send( zmq_socket_push, b%val(1), 8*b%cur, ZMQ_SNDMORE)' + endif + + rc = f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE) + if(rc /= bit_kind*N_int*2*b%cur) then + print *, 'f77_zmq_send( zmq_socket_push, b%det(1,1,1), bit_kind*N_int*2*b%cur, ZMQ_SNDMORE)' + endif + + endif + + rc = f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE) + if(rc /= 4) then + print *, 'f77_zmq_send( zmq_socket_push, ntasks, 4, ZMQ_SNDMORE)' + endif + + rc = f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0) + if(rc /= 4*ntasks) then + print *, 'f77_zmq_send( zmq_socket_push, task_id(1), ntasks*4, 0)' + endif + +! Activate is zmq_socket_push is a REQ +IRP_IF ZMQ_PUSH +IRP_ELSE + character*(2) :: ok + rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0) + if ((rc /= 2).and.(ok(1:2) /= 'ok')) then + print *, irp_here//': error in receiving ok' + stop -1 + endif +IRP_ENDIF + +end subroutine + + +subroutine pull_selection_results(zmq_socket_pull, pt2_data, val, det, N, task_id, ntasks) + use f77_zmq + use selection_types + implicit none + integer(ZMQ_PTR), intent(in) :: zmq_socket_pull + type(pt2_type), intent(inout) :: pt2_data + double precision, intent(out) :: val(*) + integer(bit_kind), intent(out) :: det(N_int, 2, *) + integer, intent(out) :: N, ntasks, task_id(*) + integer :: rc, rn, i + double precision, allocatable :: pt2_serialized(:) + + rc = f77_zmq_recv( zmq_socket_pull, N, 4, 0) + if(rc /= 4) then + print *, 'f77_zmq_recv( zmq_socket_pull, N, 4, 0)' + endif + + allocate(pt2_serialized (pt2_type_size(N_states)) ) + rc = f77_zmq_recv( zmq_socket_pull, pt2_serialized, 8*size(pt2_serialized), 0) + if (rc == -1) then + ntasks = 1 + task_id(1) = 0 + else if(rc /= 8*size(pt2_serialized)) then + stop 'pull' + endif + + call pt2_deserialize(pt2_data,N_states,pt2_serialized) + deallocate(pt2_serialized) + + if (N>0) then + rc = f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0) + if(rc /= 8*N) then + print *, 'f77_zmq_recv( zmq_socket_pull, val(1), 8*N, 0)' + endif + + rc = f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0) + if(rc /= bit_kind*N_int*2*N) then + print *, 'f77_zmq_recv( zmq_socket_pull, det(1,1,1), bit_kind*N_int*2*N, 0)' + endif + endif + + rc = f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0) + if(rc /= 4) then + print *, 'f77_zmq_recv( zmq_socket_pull, ntasks, 4, 0)' + endif + + rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0) + if(rc /= 4*ntasks) then + print *, 'f77_zmq_recv( zmq_socket_pull, task_id(1), ntasks*4, 0)' + endif + +! Activate is zmq_socket_pull is a REP +IRP_IF ZMQ_PUSH +IRP_ELSE + rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) + if (rc /= 2) then + print *, irp_here//': error in sending ok' + stop -1 + endif +IRP_ENDIF +end subroutine + + + diff --git a/src/cipsi/selection_buffer.irp.f b/src/cipsi_utils/selection_buffer.irp.f similarity index 100% rename from src/cipsi/selection_buffer.irp.f rename to src/cipsi_utils/selection_buffer.irp.f diff --git a/plugins/local/cipsi_tc_bi_ortho/selection_types.f90 b/src/cipsi_utils/selection_types.f90 similarity index 100% rename from plugins/local/cipsi_tc_bi_ortho/selection_types.f90 rename to src/cipsi_utils/selection_types.f90 diff --git a/src/cipsi/selection_weight.irp.f b/src/cipsi_utils/selection_weight.irp.f similarity index 100% rename from src/cipsi/selection_weight.irp.f rename to src/cipsi_utils/selection_weight.irp.f diff --git a/src/cipsi/slave_cipsi.irp.f b/src/cipsi_utils/slave_cipsi.irp.f similarity index 98% rename from src/cipsi/slave_cipsi.irp.f rename to src/cipsi_utils/slave_cipsi.irp.f index ddfc050e..8be48f40 100644 --- a/src/cipsi/slave_cipsi.irp.f +++ b/src/cipsi_utils/slave_cipsi.irp.f @@ -303,10 +303,11 @@ subroutine run_slave_main PROVIDE global_selection_buffer pt2_N_teeth pt2_F N_det_generators PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique - PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order + PROVIDE psi_bilinear_matrix_rows psi_bilinear_matrix_order PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns - PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted + PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp PROVIDE psi_det_hii selection_weight pseudo_sym pt2_min_parallel_tasks + call provide_for_zmq_pt2 if (mpi_master) then print *, 'Running PT2' From 6b7f2411b17c87368cbe56a03aad157819fcd1aa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 12 Mar 2024 17:31:49 +0100 Subject: [PATCH 19/64] Add NEED in cipsi_utils --- src/cipsi_utils/NEED | 1 + 1 file changed, 1 insertion(+) create mode 100644 src/cipsi_utils/NEED diff --git a/src/cipsi_utils/NEED b/src/cipsi_utils/NEED new file mode 100644 index 00000000..d3d4d2c7 --- /dev/null +++ b/src/cipsi_utils/NEED @@ -0,0 +1 @@ +determinants From 37588e520766f303acaecd26b1dc16484b69f80f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 12 Mar 2024 17:32:38 +0100 Subject: [PATCH 20/64] Add NEED in generators_full_tc --- src/generators_full_tc/NEED | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 src/generators_full_tc/NEED diff --git a/src/generators_full_tc/NEED b/src/generators_full_tc/NEED new file mode 100644 index 00000000..0cf7d3aa --- /dev/null +++ b/src/generators_full_tc/NEED @@ -0,0 +1,2 @@ +determinants +hartree_fock From 0618372b29284e16aeb3dd0cfc9b62377571a03d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 12 Mar 2024 17:38:30 +0100 Subject: [PATCH 21/64] Commented out select_singles in TC --- plugins/local/cipsi_tc_bi_ortho/selection.irp.f | 8 ++++---- src/.gitignore | 1 + 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/plugins/local/cipsi_tc_bi_ortho/selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f index 9b8cc81e..b1c02102 100644 --- a/plugins/local/cipsi_tc_bi_ortho/selection.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f @@ -88,10 +88,10 @@ subroutine select_connected(i_generator,E0,pt2_data,b,subset,csubset) particle_mask(k,1) = iand(generators_bitmask(k,1,s_part), not(psi_det_generators(k,1,i_generator)) ) particle_mask(k,2) = iand(generators_bitmask(k,2,s_part), not(psi_det_generators(k,2,i_generator)) ) enddo - if ((subset == 1).and.(sum(hole_mask(:,2)) == 0_bit_kind)) then - ! No beta electron to excite - call select_singles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,b) - endif +! if ((subset == 1).and.(sum(hole_mask(:,2)) == 0_bit_kind)) then +! ! No beta electron to excite +! call select_singles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,b) +! endif call select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2_data,b,subset,csubset) deallocate(fock_diag_tmp) end subroutine diff --git a/src/.gitignore b/src/.gitignore index 6353c21a..abc6a4c0 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -1,5 +1,6 @@ * !README.rst +!NEED !*/ */* !*/*.* From fdc418d72a12eb307a0cf875225794fbd37dde11 Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 12 Mar 2024 17:45:50 +0100 Subject: [PATCH 22/64] fixed print in TC --- plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f | 1 + plugins/local/fci_tc_bi/diagonalize_ci.irp.f | 6 ++++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f index 8863b7bc..721564e6 100644 --- a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f @@ -91,6 +91,7 @@ subroutine run_stochastic_cipsi to_select = max(N_states_diag, to_select) E_denom = E_tc ! TC Energy of the current wave function + print*,'E_tc = ',E_tc call pt2_dealloc(pt2_data) call pt2_dealloc(pt2_data_err) call pt2_alloc(pt2_data, N_states) diff --git a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f index a5242b87..5fcce5eb 100644 --- a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f +++ b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f @@ -55,9 +55,11 @@ subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) ! write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tot/norm,E_tc + rpt2_tot/norm,pt2_minus, pt2_plus ! print*,'*****' ! endif -! E_tc(k) = eigval_right_tc_bi_orth(k) -! norm(k) = norm_ground_left_right_bi_orth(k) ! enddo + do k = 1, N_states + E_tc(k) = eigval_right_tc_bi_orth(k) + norm(k) = norm_ground_left_right_bi_orth(k) + enddo psi_energy(1:N_states) = eigval_right_tc_bi_orth(1:N_states) - nuclear_repulsion psi_s2(1:N_states) = s2_eigvec_tc_bi_orth(1:N_states) From a56488e3a865dccc98d7984dd2cc4a7be1885539 Mon Sep 17 00:00:00 2001 From: eginer Date: Tue, 12 Mar 2024 18:23:09 +0100 Subject: [PATCH 23/64] fci_tc_bi_ortho works for multi state ninja --- .../cipsi_tc_bi_ortho/stochastic_cipsi.irp.f | 57 ++++--------------- plugins/local/fci_tc_bi/diagonalize_ci.irp.f | 42 +------------- .../local/tc_bi_ortho/psi_det_tc_sorted.irp.f | 8 ++- src/cipsi/pt2_stoch_routines.irp.f | 2 +- src/cipsi_utils/slave_cipsi.irp.f | 2 +- 5 files changed, 20 insertions(+), 91 deletions(-) diff --git a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f index 721564e6..99a8de7e 100644 --- a/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f @@ -11,15 +11,13 @@ subroutine run_stochastic_cipsi implicit none integer :: i, j, k, ndet integer :: to_select - logical :: print_pt2 logical :: has type(pt2_type) :: pt2_data, pt2_data_err double precision :: rss - double precision :: correlation_energy_ratio, E_denom, E_tc, norm + double precision :: correlation_energy_ratio double precision :: hf_energy_ref double precision :: relative_error - double precision, allocatable :: ept2(:), pt1(:), extrap_energy(:) - double precision, allocatable :: zeros(:) + double precision, allocatable :: zeros(:),E_tc(:), norm(:) logical, external :: qp_stop double precision, external :: memory_of_double @@ -32,14 +30,13 @@ subroutine run_stochastic_cipsi write(*,*) i, Fock_matrix_tc_mo_tot(i,i) enddo - N_iter = 1 threshold_generators = 1.d0 SOFT_TOUCH threshold_generators rss = memory_of_double(N_states)*4.d0 call check_mem(rss, irp_here) - allocate(zeros(N_states)) + allocate(zeros(N_states),E_tc(N_states), norm(N_states)) call pt2_alloc(pt2_data, N_states) call pt2_alloc(pt2_data_err, N_states) @@ -55,8 +52,7 @@ subroutine run_stochastic_cipsi ! if (s2_eig) then ! call make_s2_eigenfunction ! endif - print_pt2 = .False. - call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) + call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm) ! if (N_det > N_det_max) then @@ -67,19 +63,16 @@ subroutine run_stochastic_cipsi ! if (s2_eig) then ! call make_s2_eigenfunction ! endif -! print_pt2 = .False. -! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2) +! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm) ! call routine_save_right ! endif - allocate(ept2(1000),pt1(1000),extrap_energy(100)) correlation_energy_ratio = 0.d0 ! thresh_it_dav = 5.d-5 ! soft_touch thresh_it_dav - print_pt2 = .True. do while( (N_det < N_det_max) .and. & (maxval(abs(pt2_data % pt2(1:N_states))) > pt2_max)) @@ -90,13 +83,12 @@ subroutine run_stochastic_cipsi to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor) to_select = max(N_states_diag, to_select) - E_denom = E_tc ! TC Energy of the current wave function print*,'E_tc = ',E_tc call pt2_dealloc(pt2_data) call pt2_dealloc(pt2_data_err) call pt2_alloc(pt2_data, N_states) call pt2_alloc(pt2_data_err, N_states) - call ZMQ_pt2(E_denom, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection + call ZMQ_pt2(E_tc, pt2_data, pt2_data_err, relative_error,to_select) ! Stochastic PT2 and selection ! stop call print_summary_tc(psi_energy_with_nucl_rep, pt2_data, pt2_data_err, N_det, N_configuration, N_states, psi_s2) @@ -117,48 +109,19 @@ subroutine run_stochastic_cipsi PROVIDE psi_det PROVIDE psi_det_sorted_tc - ept2(N_iter-1) = E_tc + nuclear_repulsion + (pt2_data % pt2(1))/norm - pt1(N_iter-1) = dsqrt(pt2_data % overlap(1,1)) - call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) + call diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm) ! stop if (qp_stop()) exit enddo -! print*,'data to extrapolate ' -! do i = 2, N_iter -! print*,'iteration ',i -! print*,'pt1,Ept2',pt1(i),ept2(i) -! call get_extrapolated_energy(i-1,ept2(i),pt1(i),extrap_energy(i)) -! do j = 2, i -! print*,'j,e,energy',j,extrap_energy(j) -! enddo -! enddo - -! thresh_it_dav = 5.d-6 -! soft_touch thresh_it_dav call pt2_dealloc(pt2_data) call pt2_dealloc(pt2_data_err) call pt2_alloc(pt2_data, N_states) call pt2_alloc(pt2_data_err, N_states) call ZMQ_pt2(E_tc, pt2_data, pt2_data_err, relative_error,0) ! Stochastic PT2 and selection - call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2) -! if (.not.qp_stop()) then -! if (N_det < N_det_max) then -! thresh_it_dav = 5.d-7 -! soft_touch thresh_it_dav -! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2) -! endif -! -! call pt2_dealloc(pt2_data) -! call pt2_dealloc(pt2_data_err) -! call pt2_alloc(pt2_data, N_states) -! call pt2_alloc(pt2_data_err, N_states) -! call ZMQ_pt2(E_denom, pt2_data, pt2_data_err, relative_error, 0) ! Stochastic PT2 -! call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm,pt2_data,print_pt2) -! endif -! call pt2_dealloc(pt2_data) -! call pt2_dealloc(pt2_data_err) -! call routine_save_right + call diagonalize_CI_tc_bi_ortho(ndet, E_tc,norm) + call pt2_dealloc(pt2_data) + call pt2_dealloc(pt2_data_err) end diff --git a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f index 5fcce5eb..85518116 100644 --- a/plugins/local/fci_tc_bi/diagonalize_ci.irp.f +++ b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f @@ -1,7 +1,7 @@ ! --- -subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) +subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm ) BEGIN_DOC ! Replace the coefficients of the CI states by the coefficients of the @@ -12,50 +12,10 @@ subroutine diagonalize_CI_tc_bi_ortho(ndet, E_tc, norm, pt2_data, print_pt2) implicit none integer, intent(inout) :: ndet ! number of determinants from before double precision, intent(inout) :: E_tc(N_states), norm(N_states) ! E and norm from previous wave function - type(pt2_type) , intent(in) :: pt2_data ! PT2 from previous wave function - logical, intent(in) :: print_pt2 integer :: i, j,k - double precision:: pt2_minus,pt2_plus,pt2_tot, pt2_abs,pt1_norm,rpt2_tot - double precision :: error_pt2_minus, error_pt2_plus, error_pt2_tot, error_pt2_abs PROVIDE mo_l_coef mo_r_coef -! print*,'*****' -! print*,'New wave function information' -! print*,'N_det tc = ',N_det -! do k = 1, N_states -! print*,'************' -! print*,'State ',k -! pt2_plus = pt2_data % variance(k) -! pt2_minus = pt2_data % pt2(k) -! pt2_abs = pt2_plus - pt2_minus -! pt2_tot = pt2_plus + pt2_minus -! -! pt1_norm = pt2_data % overlap(k,k) -! rpt2_tot = pt2_tot / (1.d0 + pt1_norm) -! -! -! print*,'norm_ground_left_right_bi_orth = ',norm_ground_left_right_bi_orth(k) -! print*,'eigval_right_tc = ',eigval_right_tc_bi_orth(k) -! print*,'*****' -! -! if(print_pt2) then -! print*,'*****' -! print*,'previous wave function info' -! print*,'norm(before) = ',norm -! print*,'E(before) = ',E_tc -! print*,'PT1 norm = ',dsqrt(pt1_norm) -! print*,'PT2 = ',pt2_tot -! print*,'rPT2 = ',rpt2_tot -! print*,'|PT2| = ',pt2_abs -! print*,'Positive PT2 = ',pt2_plus -! print*,'Negative PT2 = ',pt2_minus -! print*,'E(before) + PT2 = ',E_tc + pt2_tot/norm -! print*,'E(before) +rPT2 = ',E_tc + rpt2_tot/norm -! write(*,'(A28,X,I10,X,100(F16.8,X))')'Ndet,E,E+PT2,E+RPT2,|PT2|=',ndet,E_tc ,E_tc + pt2_tot/norm,E_tc + rpt2_tot/norm,pt2_minus, pt2_plus -! print*,'*****' -! endif -! enddo do k = 1, N_states E_tc(k) = eigval_right_tc_bi_orth(k) norm(k) = norm_ground_left_right_bi_orth(k) diff --git a/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f b/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f index 5dad91ca..eef99de8 100644 --- a/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f +++ b/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f @@ -11,10 +11,16 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_tc, (psi_det_size) ] psi_average_norm_contrib_tc(:) = 0.d0 do k=1,N_states do i=1,N_det - psi_average_norm_contrib_tc(i) = & +! print*,dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k)),psi_l_coef_bi_ortho(i,k),psi_r_coef_bi_ortho(i,k) + psi_average_norm_contrib_tc(i) += & dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k))*state_average_weight(k) enddo enddo +! print*,'***' +! do i = 1, N_det +! print*,psi_average_norm_contrib_tc(i) +! enddo + print*,'sum(psi_average_norm_contrib_tc(1:N_det))',sum(psi_average_norm_contrib_tc(1:N_det)) f = 1.d0/sum(psi_average_norm_contrib_tc(1:N_det)) do i=1,N_det psi_average_norm_contrib_tc(i) = psi_average_norm_contrib_tc(i)*f diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 228e0ef1..bd5943da 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -1,3 +1,3 @@ subroutine provide_for_zmq_pt2 - PROVIDE psi_selectors_coef_transp psi_det_sorted psi_det_sorted_order + PROVIDE psi_selectors_coef_transp psi_det_sorted psi_det_sorted_order psi_det_hii end diff --git a/src/cipsi_utils/slave_cipsi.irp.f b/src/cipsi_utils/slave_cipsi.irp.f index 8be48f40..3e778270 100644 --- a/src/cipsi_utils/slave_cipsi.irp.f +++ b/src/cipsi_utils/slave_cipsi.irp.f @@ -306,7 +306,7 @@ subroutine run_slave_main PROVIDE psi_bilinear_matrix_rows psi_bilinear_matrix_order PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp - PROVIDE psi_det_hii selection_weight pseudo_sym pt2_min_parallel_tasks + PROVIDE selection_weight pseudo_sym pt2_min_parallel_tasks call provide_for_zmq_pt2 if (mpi_master) then From 88cf5d23f19985ec7bca38db6445a2b1607fc063 Mon Sep 17 00:00:00 2001 From: eginer Date: Wed, 13 Mar 2024 11:20:03 +0100 Subject: [PATCH 24/64] changed print_tc_wf --- plugins/local/tc_bi_ortho/print_tc_wf.irp.f | 3 ++- plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f | 4 ++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/plugins/local/tc_bi_ortho/print_tc_wf.irp.f b/plugins/local/tc_bi_ortho/print_tc_wf.irp.f index c755485b..2b88bc5b 100644 --- a/plugins/local/tc_bi_ortho/print_tc_wf.irp.f +++ b/plugins/local/tc_bi_ortho/print_tc_wf.irp.f @@ -37,7 +37,8 @@ subroutine write_l_r_wf integer :: i print*,'Writing the left-right wf' do i = 1, N_det - write(i_unit_output,*)i, psi_l_coef_sorted_bi_ortho_left(i)/psi_l_coef_sorted_bi_ortho_left(1) & + write(i_unit_output,*)i, psi_coef_sorted_tc(i,1)/psi_coef_sorted_tc(i,1) & + , psi_l_coef_sorted_bi_ortho_left(i)/psi_l_coef_sorted_bi_ortho_left(1) & , psi_r_coef_sorted_bi_ortho_right(i)/psi_r_coef_sorted_bi_ortho_right(1) enddo diff --git a/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f b/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f index eef99de8..3996ca4c 100644 --- a/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f +++ b/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f @@ -25,6 +25,10 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_tc, (psi_det_size) ] do i=1,N_det psi_average_norm_contrib_tc(i) = psi_average_norm_contrib_tc(i)*f enddo + f = 0.d0 + do i=1,N_det + f+= psi_average_norm_contrib_tc(i) + enddo END_PROVIDER From cfdaf722df84c98ba231d3153e7ee3747300c193 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 15 Mar 2024 15:40:18 +0100 Subject: [PATCH 25/64] added the keyword to minimize tc angles at the end of TC SCF --- plugins/local/tc_keywords/EZFIO.cfg | 5 +++++ plugins/local/tc_scf/tc_scf.irp.f | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/plugins/local/tc_keywords/EZFIO.cfg b/plugins/local/tc_keywords/EZFIO.cfg index 93ff790f..bc691fc3 100644 --- a/plugins/local/tc_keywords/EZFIO.cfg +++ b/plugins/local/tc_keywords/EZFIO.cfg @@ -280,3 +280,8 @@ doc: approach used to evaluate TC integrals [ analytic | numeric | semi-analytic interface: ezfio,ocaml,provider default: semi-analytic +[minimize_lr_angles] +type: logical +doc: If |true|, you minimize the angle between the left and right vectors associated to degenerate orbitals +interface: ezfio,provider,ocaml +default: False diff --git a/plugins/local/tc_scf/tc_scf.irp.f b/plugins/local/tc_scf/tc_scf.irp.f index d8c5ab66..768069d6 100644 --- a/plugins/local/tc_scf/tc_scf.irp.f +++ b/plugins/local/tc_scf/tc_scf.irp.f @@ -78,7 +78,9 @@ program tc_scf ! TODO ! rotate angles in separate code only if necessary - !call minimize_tc_orb_angles() + if(minimize_lr_angles)then + call minimize_tc_orb_angles() + endif call print_energy_and_mos(good_angles) endif From cb8c823a2c098f7023d0e858f77ab5b88cf9f518 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 15 Mar 2024 16:27:02 +0100 Subject: [PATCH 26/64] added script_tc_bh_h2o_gd_exc.sh in fci_tc_bi --- .../fci_tc_bi/script_tc_bh_h2o_gd_exc.sh | 85 +++++++++++++++++++ 1 file changed, 85 insertions(+) create mode 100755 plugins/local/fci_tc_bi/script_tc_bh_h2o_gd_exc.sh diff --git a/plugins/local/fci_tc_bi/script_tc_bh_h2o_gd_exc.sh b/plugins/local/fci_tc_bi/script_tc_bh_h2o_gd_exc.sh new file mode 100755 index 00000000..0d655fdd --- /dev/null +++ b/plugins/local/fci_tc_bi/script_tc_bh_h2o_gd_exc.sh @@ -0,0 +1,85 @@ +#!/bin/bash + +source ~/qp2/quantum_package.rc + +## Define the system/basis/charge/mult and genric keywords +system=H2O +xyz=${system}.xyz +basis=6-31g +mult=1 +charge=0 +j2e_type="Boys_Handy" +thresh_tcscf=1e-10 +io_tc_integ="Write" +nstates=4 + + + +##################### Function to create the EZFIO +function create_ezfio (){ + qp create_ezfio -b $basis -m $mult -c $charge $xyz -o $ezfio + qp run scf | tee ${EZFIO_FILE}.scf.out +} + +##################### Function to set parameters for BH9 jastrow +function BH_9 (){ + j2e_type="Boys_Handy" # type of correlation factor: Boys Handy type + env_type="None" # Boys Handy J does not use our envelopes + j1e_type="None" # Boys Handy J does not use our J1body + tc_integ_type="numeric" # Boys Handy requires numerical integrals + jBH_size=9 # Number of parameters for the BH + +######## All parameters for the H2O and Boys Handy Jastrow + jBH_c=[[0.50000,-0.57070,0.49861,-0.78663,0.01990,0.13386,-0.60446,-1.67160,1.36590],[0.0,0.0,0.0,0.0,0.12063,-0.18527,0.12324,-0.11187,-0.06558],[0.0,0.0,0.0,0.0,0.12063,-0.18527,0.12324,-0.11187,-0.06558]] + jBH_m=[[0,0,0,0,2,3,4,2,2],[0,0,0,0,2,3,4,2,2],[0,0,0,0,2,3,4,2,2]] + jBH_n=[[0,0,0,0,0,0,0,2,0],[0,0,0,0,0,0,0,2,0],[0,0,0,0,0,0,0,2,0]] + jBH_o=[[1,2,3,4,0,0,0,0,2],[1,2,3,4,0,0,0,0,2],[1,2,3,4,0,0,0,0,2]] + jBH_ee=[1.0,1.0,1.0] + jBH_en=[1.0,1.0,1.0] + + set_BH_J_keywords +} + + +function set_BH_J_keywords (){ + qp set jastrow j2e_type $j2e_type # set the jastrow two-e type + qp set jastrow env_type $env_type + qp set jastrow j1e_type $j1e_type + qp set jastrow jBH_size $jBH_size # set the number of parameters in Boys-Handy jastrow + qp set jastrow jBH_c "$jBH_c" # set the parameters which are lists for Boys-Handy + qp set jastrow jBH_m "$jBH_m" # + qp set jastrow jBH_n "$jBH_n" # + qp set jastrow jBH_o "$jBH_o" # + qp set jastrow jBH_ee $jBH_ee # + qp set jastrow jBH_en $jBH_en # + qp set tc_keywords tc_integ_type $tc_integ_type # set the analytical or numerical integrals + qp set tc_keywords thresh_tcscf $thresh_tcscf + qp set tc_keywords io_tc_integ $io_tc_integ # set the io + rm ${EZFIO_FILE}/tc_bi_ortho/psi_* +} + +function run_ground_state (){ + qp set tc_keywords minimize_lr_angles True + qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out + qp set_frozen_core + qp set determinants n_det_max 1e6 + qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi.out +} + +function run_excited_state (){ + qp set determinants n_states $nstates + qp run cis | tee ${EZFIO_FILE}.cis.out + rm ${EZFIO_FILE}/tc_bi_ortho/psi_* + qp run tc_bi_ortho | tee ${EZFIO_FILE}.tc_cis_nst_${nstates}.out + qp set determinants read_wf True + qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi_nst_${nstates}.out + +} + + +## BH9 calculations +ezfio=${system}_${charge}_${basis}_${j2e_type} +create_ezfio +BH_9 +run_ground_state +run_excited_state From a8de10987febc04dd3c416451e27a87ed50e4034 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 15 Mar 2024 17:10:22 +0100 Subject: [PATCH 27/64] added script_tc_jmu_h2o_gd_exc.sh --- .../fci_tc_bi/script_tc_jmu_h2o_gd_exc.sh | 84 +++++++++++++++++++ plugins/local/tc_bi_ortho/TODO | 2 + 2 files changed, 86 insertions(+) create mode 100755 plugins/local/fci_tc_bi/script_tc_jmu_h2o_gd_exc.sh create mode 100644 plugins/local/tc_bi_ortho/TODO diff --git a/plugins/local/fci_tc_bi/script_tc_jmu_h2o_gd_exc.sh b/plugins/local/fci_tc_bi/script_tc_jmu_h2o_gd_exc.sh new file mode 100755 index 00000000..e74888ec --- /dev/null +++ b/plugins/local/fci_tc_bi/script_tc_jmu_h2o_gd_exc.sh @@ -0,0 +1,84 @@ +#!/bin/bash +source ~/qp2/quantum_package.rc + +## Define the system/basis/charge/mult and genric keywords +system=H2O +xyz=${system}.xyz +basis=6-31g +mult=1 +charge=0 +j2e_type=Mu +thresh_tcscf=1e-10 +io_tc_integ="Write" +nstates=4 +nol_standard=False +tc_integ_type=numeric # can be changed for semi-analytic + +if (( $nol_standard == "False" )) +then + three_body_h_tc=True +else + three_body_h_tc=False +fi + + +##################### Function to create the EZFIO +function create_ezfio (){ + qp create_ezfio -b $basis -m $mult -c $charge $xyz -o $ezfio + qp run scf | tee ${EZFIO_FILE}.scf.out +} + +function set_env_j_keywords (){ + + qp set hamiltonian mu_erf 0.87 + qp set jastrow env_type Sum_Gauss + qp set jastrow env_coef "${coef}" + qp set tc_keywords tc_integ_type $tc_integ_type + qp set jastrow j1e_type $j1e_type + qp set jastrow j2e_type $j2e_type + qp set jastrow env_expo "${alpha}" +} + +function run_ground_state (){ + qp set tc_keywords minimize_lr_angles True + qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out + qp set_frozen_core + qp set determinants n_det_max 1e6 + qp set perturbation pt2_max 0.001 + qp set tc_keywords nol_standard $nol_standard + qp set tc_keywords three_body_h_tc $three_body_h_tc + qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi.out +} + +function run_excited_state (){ + qp set determinants n_states $nstates + qp run cis | tee ${EZFIO_FILE}.cis.out + rm ${EZFIO_FILE}/tc_bi_ortho/psi_* + qp run tc_bi_ortho | tee ${EZFIO_FILE}.tc_cis_nst_${nstates}.out + qp set determinants read_wf True + qp run fci_tc_bi_ortho | tee ${EZFIO_FILE}.fci_tc_bi_nst_${nstates}.out + +} + + +# Define J(mu) with envelope and without j1e +j2e_type=Mu +j1e_type=None +ezfio=${system}_${charge}_${basis}_${j2e_type}_${j1e_type} +create_ezfio +alpha=[2.0,1000.,1000.] # parameters for H2O +coef=[1.,1.,1.] # parameters for H2O +set_env_j_keywords +run_ground_state +run_excited_state + +# Define J(mu) with envelope and with a charge Harmonizer for J1e +j2e_type=Mu +j1e_type=Charge_Harmonizer +ezfio=${system}_${charge}_${basis}_${j2e_type}_${j1e_type} +create_ezfio +alpha=[2.5,1000.,1000.] # parameters for H2O +coef=[1.,1.,1.] # parameters for H2O +set_env_j_keywords +run_ground_state +run_excited_state diff --git a/plugins/local/tc_bi_ortho/TODO b/plugins/local/tc_bi_ortho/TODO new file mode 100644 index 00000000..e1f195b8 --- /dev/null +++ b/plugins/local/tc_bi_ortho/TODO @@ -0,0 +1,2 @@ +S^2 !! +Bi orthonormalize the eigenvectors of H_tc after Davidson or lapack From 0a8d57abd91ab3ae73d693756528f0fb11874c5b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 15 Mar 2024 18:19:00 +0100 Subject: [PATCH 28/64] Accelerated BH Jastrow --- .../non_h_ints_mu/jast_deriv_utils_vect.irp.f | 226 +++++++++++------- 1 file changed, 144 insertions(+), 82 deletions(-) diff --git a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f index 31ad5756..33563102 100644 --- a/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f @@ -4,7 +4,7 @@ subroutine get_grad1_u12_withsq_r1_seq(ipoint, n_grid2, resx, resy, resz, res) BEGIN_DOC - ! + ! ! grad_1 u(r1,r2) ! ! we use grid for r1 and extra_grid for r2 @@ -167,9 +167,9 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) integer :: jpoint integer :: i_nucl, p, mpA, npA, opA double precision :: r2(3) - double precision :: dx, dy, dz, r12, tmp + double precision :: dx, dy, dz, r12, tmp, r12_inv double precision :: mu_val, mu_tmp, mu_der(3) - double precision :: rn(3), f1A, gard1_f1A(3), f2A, gard2_f2A(3), g12, gard1_g12(3) + double precision :: rn(3), f1A, grad1_f1A(3), f2A, grad2_f2A(3), g12, grad1_g12(3) double precision :: tmp1, tmp2 @@ -181,7 +181,7 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) ! d/dy1 j(mu,r12) = 0.5 * [(1 - erf(mu * r12)) / r12] * (y1 - y2) ! d/dz1 j(mu,r12) = 0.5 * [(1 - erf(mu * r12)) / r12] * (z1 - z2) - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r2(1) = final_grid_points_extra(1,jpoint) r2(2) = final_grid_points_extra(2,jpoint) @@ -191,15 +191,19 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) dy = r1(2) - r2(2) dz = r1(3) - r2(3) - r12 = dsqrt(dx * dx + dy * dy + dz * dz) - if(r12 .lt. 1d-10) then - gradx(jpoint) = 0.d0 - grady(jpoint) = 0.d0 - gradz(jpoint) = 0.d0 + r12 = dx * dx + dy * dy + dz * dz + + if(r12 .lt. 1d-20) then + gradx(jpoint) = 0.d0 + grady(jpoint) = 0.d0 + gradz(jpoint) = 0.d0 cycle endif - tmp = 0.5d0 * (1.d0 - derf(mu_erf * r12)) / r12 + r12_inv = 1.d0/dsqrt(r12) + r12 = r12*r12_inv + + tmp = 0.5d0 * (1.d0 - derf(mu_erf * r12)) * r12_inv gradx(jpoint) = tmp * dx grady(jpoint) = tmp * dy @@ -208,10 +212,10 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) elseif(j2e_type .eq. "Mur") then - ! d/dx1 j(mu(r1,r2),r12) = exp(-(mu(r1,r2)*r12)**2) /(2 *sqrt(pi) * mu(r1,r2)**2 ) d/dx1 mu(r1,r2) + ! d/dx1 j(mu(r1,r2),r12) = exp(-(mu(r1,r2)*r12)**2) /(2 *sqrt(pi) * mu(r1,r2)**2 ) d/dx1 mu(r1,r2) ! + 0.5 * (1 - erf(mu(r1,r2) *r12))/r12 * (x1 - x2) - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r2(1) = final_grid_points_extra(1,jpoint) r2(2) = final_grid_points_extra(2,jpoint) @@ -220,23 +224,29 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) dx = r1(1) - r2(1) dy = r1(2) - r2(2) dz = r1(3) - r2(3) - r12 = dsqrt(dx * dx + dy * dy + dz * dz) - call mu_r_val_and_grad(r1, r2, mu_val, mu_der) - mu_tmp = mu_val * r12 - tmp = inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / (mu_val * mu_val) - gradx(jpoint) = tmp * mu_der(1) - grady(jpoint) = tmp * mu_der(2) - gradz(jpoint) = tmp * mu_der(3) + r12 = dx * dx + dy * dy + dz * dz - if(r12 .lt. 1d-10) then + if(r12 .lt. 1d-20) then gradx(jpoint) = 0.d0 grady(jpoint) = 0.d0 gradz(jpoint) = 0.d0 cycle endif - tmp = 0.5d0 * (1.d0 - derf(mu_tmp)) / r12 + r12_inv = 1.d0/dsqrt(r12) + r12 = r12*r12_inv + + call mu_r_val_and_grad(r1, r2, mu_val, mu_der) + + mu_tmp = mu_val * r12 + tmp = inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / (mu_val * mu_val) + + gradx(jpoint) = tmp * mu_der(1) + grady(jpoint) = tmp * mu_der(2) + gradz(jpoint) = tmp * mu_der(3) + + tmp = 0.5d0 * (1.d0 - derf(mu_tmp)) * r12_inv gradx(jpoint) = gradx(jpoint) + tmp * dx grady(jpoint) = grady(jpoint) + tmp * dy @@ -254,7 +264,7 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) PROVIDE a_boys - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r2(1) = final_grid_points_extra(1,jpoint) r2(2) = final_grid_points_extra(2,jpoint) @@ -263,14 +273,17 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) dx = r1(1) - r2(1) dy = r1(2) - r2(2) dz = r1(3) - r2(3) - r12 = dsqrt(dx * dx + dy * dy + dz * dz) + r12 = dx * dx + dy * dy + dz * dz + if(r12 .lt. 1d-10) then - gradx(jpoint) = 0.d0 - grady(jpoint) = 0.d0 - gradz(jpoint) = 0.d0 + gradx(jpoint) = 0.d0 + grady(jpoint) = 0.d0 + gradz(jpoint) = 0.d0 cycle endif + r12 = dsqrt(r12) + tmp = 1.d0 + a_boys * r12 tmp = 0.5d0 / (r12 * tmp * tmp) @@ -281,24 +294,60 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) elseif(j2e_type .eq. "Boys_Handy") then + integer :: powmax + powmax = max(maxval(jBH_m),maxval(jBH_n)) + + double precision, allocatable :: f1A_power(:), f2A_power(:), double_p(:), g12_power(:) + allocate (f1A_power(-1:powmax), f2A_power(-1:powmax), g12_power(-1:powmax), double_p(0:powmax)) + + do p=0,powmax + double_p(p) = dble(p) + enddo + + f1A_power(-1) = 0.d0 + f2A_power(-1) = 0.d0 + g12_power(-1) = 0.d0 + + f1A_power(0) = 1.d0 + f2A_power(0) = 1.d0 + g12_power(0) = 1.d0 + do jpoint = 1, n_points_extra_final_grid ! r2 r2(1) = final_grid_points_extra(1,jpoint) r2(2) = final_grid_points_extra(2,jpoint) r2(3) = final_grid_points_extra(3,jpoint) - gradx(jpoint) = 0.d0 - grady(jpoint) = 0.d0 - gradz(jpoint) = 0.d0 - do i_nucl = 1, nucl_num + gradx(jpoint) = 0.d0 + grady(jpoint) = 0.d0 + gradz(jpoint) = 0.d0 + + do i_nucl = 1, nucl_num rn(1) = nucl_coord(i_nucl,1) rn(2) = nucl_coord(i_nucl,2) rn(3) = nucl_coord(i_nucl,3) - call jBH_elem_fct_grad(jBH_en(i_nucl), r1, rn, f1A, gard1_f1A) - call jBH_elem_fct_grad(jBH_en(i_nucl), r2, rn, f2A, gard2_f2A) - call jBH_elem_fct_grad(jBH_ee(i_nucl), r1, r2, g12, gard1_g12) + call jBH_elem_fct_grad(jBH_en(i_nucl), r1, rn, f1A, grad1_f1A) + call jBH_elem_fct_grad(jBH_en(i_nucl), r2, rn, f2A, grad2_f2A) + call jBH_elem_fct_grad(jBH_ee(i_nucl), r1, r2, g12, grad1_g12) + + + ! Compute powers of f1A and f2A + + do p = 1, maxval(jBH_m(:,i_nucl)) + f1A_power(p) = f1A_power(p-1) * f1A + enddo + + do p = 1, maxval(jBH_n(:,i_nucl)) + f2A_power(p) = f2A_power(p-1) * f2A + enddo + + do p = 1, maxval(jBH_o(:,i_nucl)) + g12_power(p) = g12_power(p-1) * g12 + enddo + + do p = 1, jBH_size mpA = jBH_m(p,i_nucl) @@ -309,23 +358,31 @@ subroutine grad1_j12_r1_seq(r1, n_grid2, gradx, grady, gradz) tmp = tmp * 0.5d0 endif - tmp1 = 0.d0 - if(mpA .gt. 0) then - tmp1 = tmp1 + dble(mpA) * f1A**dble(mpA-1) * f2A**dble(npA) - endif - if(npA .gt. 0) then - tmp1 = tmp1 + dble(npA) * f1A**dble(npA-1) * f2A**dble(mpA) - endif - tmp1 = tmp1 * g12**dble(opA) +!TODO : Powers to optimize here - tmp2 = 0.d0 - if(opA .gt. 0) then - tmp2 = tmp2 + dble(opA) * g12**dble(opA-1) * (f1A**dble(mpA) * f2A**dble(npA) + f1A**dble(npA) * f2A**dble(mpA)) - endif +! tmp1 = 0.d0 +! if(mpA .gt. 0) then +! tmp1 = tmp1 + dble(mpA) * f1A**(mpA-1) * f2A**npA +! endif +! if(npA .gt. 0) then +! tmp1 = tmp1 + dble(npA) * f1A**(npA-1) * f2A**mpA +! endif +! tmp1 = tmp1 * g12**(opA) +! +! tmp2 = 0.d0 +! if(opA .gt. 0) then +! tmp2 = tmp2 + dble(opA) * g12**(opA-1) * (f1A**(mpA) * f2A**(npA) + f1A**(npA) * f2A**(mpA)) +! endif - gradx(jpoint) = gradx(jpoint) + tmp * (tmp1 * gard1_f1A(1) + tmp2 * gard1_g12(1)) - grady(jpoint) = grady(jpoint) + tmp * (tmp1 * gard1_f1A(2) + tmp2 * gard1_g12(2)) - gradz(jpoint) = gradz(jpoint) + tmp * (tmp1 * gard1_f1A(3) + tmp2 * gard1_g12(3)) + tmp1 = double_p(mpA) * f1A_power(mpA-1) * f2A_power(npA) + double_p(npA) * f1A_power(npA-1) * f2A_power(mpA) + tmp1 = tmp1 * g12_power(opA) + + tmp2 = double_p(opA) * g12_power(opA-1) * (f1A_power(mpA) * f2A_power(npA) + f1A_power(npA) * f2A_power(mpA)) + + + gradx(jpoint) = gradx(jpoint) + tmp * (tmp1 * grad1_f1A(1) + tmp2 * grad1_g12(1)) + grady(jpoint) = grady(jpoint) + tmp * (tmp1 * grad1_f1A(2) + tmp2 * grad1_g12(2)) + gradz(jpoint) = gradz(jpoint) + tmp * (tmp1 * grad1_f1A(3) + tmp2 * grad1_g12(3)) enddo ! p enddo ! i_nucl enddo ! jpoint @@ -361,10 +418,10 @@ subroutine grad1_jmu_r1_seq(mu, r1, n_grid2, gradx, grady, gradz) integer :: jpoint double precision :: r2(3) - double precision :: dx, dy, dz, r12, tmp + double precision :: dx, dy, dz, r12, r12_inv, tmp - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r2(1) = final_grid_points_extra(1,jpoint) r2(2) = final_grid_points_extra(2,jpoint) @@ -374,15 +431,19 @@ subroutine grad1_jmu_r1_seq(mu, r1, n_grid2, gradx, grady, gradz) dy = r1(2) - r2(2) dz = r1(3) - r2(3) - r12 = dsqrt(dx * dx + dy * dy + dz * dz) - if(r12 .lt. 1d-10) then - gradx(jpoint) = 0.d0 - grady(jpoint) = 0.d0 - gradz(jpoint) = 0.d0 + r12 = dx * dx + dy * dy + dz * dz + + if(r12 .lt. 1d-20) then + gradx(jpoint) = 0.d0 + grady(jpoint) = 0.d0 + gradz(jpoint) = 0.d0 cycle endif - tmp = 0.5d0 * (1.d0 - derf(mu * r12)) / r12 + r12_inv = 1.d0 / dsqrt(r12) + r12 = r12 * r12_inv + + tmp = 0.5d0 * (1.d0 - derf(mu * r12)) * r12_inv gradx(jpoint) = tmp * dx grady(jpoint) = tmp * dy @@ -406,7 +467,7 @@ subroutine j12_r1_seq(r1, n_grid2, res) integer :: jpoint double precision :: r2(3) double precision :: dx, dy, dz - double precision :: mu_tmp, r12 + double precision :: mu_tmp, r12, mu_erf_inv PROVIDE final_grid_points_extra @@ -414,20 +475,21 @@ subroutine j12_r1_seq(r1, n_grid2, res) PROVIDE mu_erf - do jpoint = 1, n_points_extra_final_grid ! r2 - + mu_erf_inv = 1.d0 / mu_erf + do jpoint = 1, n_points_extra_final_grid ! r2 + r2(1) = final_grid_points_extra(1,jpoint) r2(2) = final_grid_points_extra(2,jpoint) r2(3) = final_grid_points_extra(3,jpoint) - + dx = r1(1) - r2(1) dy = r1(2) - r2(2) dz = r1(3) - r2(3) r12 = dsqrt(dx * dx + dy * dy + dz * dz) mu_tmp = mu_erf * r12 - - res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf + + res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) * mu_erf_inv enddo elseif(j2e_type .eq. "Boys") then @@ -436,7 +498,7 @@ subroutine j12_r1_seq(r1, n_grid2, res) PROVIDE a_boys - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r2(1) = final_grid_points_extra(1,jpoint) r2(2) = final_grid_points_extra(2,jpoint) @@ -478,19 +540,19 @@ subroutine jmu_r1_seq(mu, r1, n_grid2, res) tmp1 = inv_sq_pi_2 / mu - do jpoint = 1, n_points_extra_final_grid ! r2 - + do jpoint = 1, n_points_extra_final_grid ! r2 + r2(1) = final_grid_points_extra(1,jpoint) r2(2) = final_grid_points_extra(2,jpoint) r2(3) = final_grid_points_extra(3,jpoint) - + dx = r1(1) - r2(1) dy = r1(2) - r2(2) dz = r1(3) - r2(3) r12 = dsqrt(dx * dx + dy * dy + dz * dz) tmp2 = mu * r12 - + res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(tmp2)) - tmp1 * dexp(-tmp2*tmp2) enddo @@ -517,7 +579,7 @@ subroutine env_nucl_r1_seq(n_grid2, res) res = 1.d0 - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r(1) = final_grid_points_extra(1,jpoint) r(2) = final_grid_points_extra(2,jpoint) r(3) = final_grid_points_extra(3,jpoint) @@ -536,7 +598,7 @@ subroutine env_nucl_r1_seq(n_grid2, res) res = 1.d0 - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r(1) = final_grid_points_extra(1,jpoint) r(2) = final_grid_points_extra(2,jpoint) r(3) = final_grid_points_extra(3,jpoint) @@ -556,7 +618,7 @@ subroutine env_nucl_r1_seq(n_grid2, res) res = 1.d0 - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r(1) = final_grid_points_extra(1,jpoint) r(2) = final_grid_points_extra(2,jpoint) r(3) = final_grid_points_extra(3,jpoint) @@ -574,7 +636,7 @@ subroutine env_nucl_r1_seq(n_grid2, res) res = 1.d0 - do jpoint = 1, n_points_extra_final_grid ! r2 + do jpoint = 1, n_points_extra_final_grid ! r2 r(1) = final_grid_points_extra(1,jpoint) r(2) = final_grid_points_extra(2,jpoint) r(3) = final_grid_points_extra(3,jpoint) @@ -604,7 +666,7 @@ end subroutine get_grad1_u12_2e_r1_seq(ipoint, n_grid2, resx, resy, resz) BEGIN_DOC - ! + ! ! grad_1 u_2e(r1,r2) ! ! we use grid for r1 and extra_grid for r2 @@ -724,7 +786,7 @@ end subroutine get_u12_2e_r1_seq(ipoint, n_grid2, res) BEGIN_DOC - ! + ! ! u_2e(r1,r2) ! ! we use grid for r1 and extra_grid for r2 @@ -820,11 +882,11 @@ end ! --- -subroutine jBH_elem_fct_grad(alpha, r1, r2, fct, gard1_fct) +subroutine jBH_elem_fct_grad(alpha, r1, r2, fct, grad1_fct) implicit none double precision, intent(in) :: alpha, r1(3), r2(3) - double precision, intent(out) :: fct, gard1_fct(3) + double precision, intent(out) :: fct, grad1_fct(3) double precision :: dist, tmp1, tmp2 dist = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & @@ -836,18 +898,18 @@ subroutine jBH_elem_fct_grad(alpha, r1, r2, fct, gard1_fct) fct = alpha * dist * tmp1 if(dist .lt. 1d-10) then - gard1_fct(1) = 0.d0 - gard1_fct(2) = 0.d0 - gard1_fct(3) = 0.d0 + grad1_fct(1) = 0.d0 + grad1_fct(2) = 0.d0 + grad1_fct(3) = 0.d0 else tmp2 = alpha * tmp1 * tmp1 / dist - gard1_fct(1) = tmp2 * (r1(1) - r2(1)) - gard1_fct(2) = tmp2 * (r1(2) - r2(2)) - gard1_fct(3) = tmp2 * (r1(3) - r2(3)) + grad1_fct(1) = tmp2 * (r1(1) - r2(1)) + grad1_fct(2) = tmp2 * (r1(2) - r2(2)) + grad1_fct(3) = tmp2 * (r1(3) - r2(3)) endif return -end +end ! --- From a29c67a7381c5240ddabf9c02ae9e37a89831ee8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 16 Mar 2024 15:21:40 +0100 Subject: [PATCH 29/64] Implemented #322 --- scripts/ezfio_interface/qp_edit_template | 140 ++++++++++++++--------- 1 file changed, 86 insertions(+), 54 deletions(-) diff --git a/scripts/ezfio_interface/qp_edit_template b/scripts/ezfio_interface/qp_edit_template index fe718a50..65c77384 100644 --- a/scripts/ezfio_interface/qp_edit_template +++ b/scripts/ezfio_interface/qp_edit_template @@ -8,14 +8,14 @@ open Sexplib.Std (** Interactive editing of the input. -WARNING +WARNING This file is automatically generated by `${{QP_ROOT}}/scripts/ezfio_interface/ei_handler.py` *) (** Keywords used to define input sections *) -type keyword = +type keyword = | Ao_basis | Determinants_by_hand | Electrons @@ -37,7 +37,7 @@ let keyword_to_string = function (** Create the header of the temporary file *) -let file_header filename = +let file_header filename = Printf.sprintf " ================================================================== Quantum Package @@ -47,7 +47,7 @@ Editing file `%s` " filename - + (** Creates the header of a section *) let make_header kw = @@ -58,14 +58,14 @@ let make_header kw = (** Returns the rst string of section [s] *) -let get s = +let get s = let header = (make_header s) in - let f (read,to_rst) = + let f (read,to_rst) = match read () with | Some text -> header ^ (Rst_string.to_string (to_rst text)) | None -> "" in - let rst = + let rst = try begin let open Input in @@ -84,27 +84,27 @@ let get s = end with | Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "") - in + in rst (** Applies the changes from the string [str] corresponding to section [s] *) -let set str s = +let set str s = let header = (make_header s) in match String_ext.substr_index ~pos:0 ~pattern:header str with | None -> () - | Some idx -> + | Some idx -> begin let index_begin = idx + (String.length header) in - let index_end = + let index_end = match ( String_ext.substr_index ~pos:(index_begin+(String.length header)+1) ~pattern:"==" str) with | Some i -> i | None -> String.length str in let l = index_end - index_begin in - let str = String.sub str index_begin l + let str = String.sub str index_begin l |> Rst_string.of_string in let write (of_rst,w) s = @@ -129,28 +129,36 @@ let set str s = (** Creates the temporary file for interactive editing *) -let create_temp_file ezfio_filename fields = - let temp_filename = Filename.temp_file "qp_edit_" ".rst" in +let create_temp_file ?filename ezfio_filename fields = + let temp_filename = + match filename with + | None -> Filename.temp_file "qp_edit_" ".rst" + | Some f -> f + in + let () = + match filename with + | None -> at_exit (fun () -> Sys.remove temp_filename) + | _ -> () + in begin let oc = open_out temp_filename in - (file_header ezfio_filename) :: (List.map get fields) - |> String.concat "\n" + (file_header ezfio_filename) :: (List.map get fields) + |> String.concat "\n" |> Printf.fprintf oc "%s"; close_out oc; - at_exit (fun () -> Sys.remove temp_filename); temp_filename end - -let run check_only ?ndet ?state ezfio_filename = + +let run check_only ?ndet ?state ?read ?write ezfio_filename = (* Set check_only if the arguments are not empty *) let check_only = - match ndet, state with - | None, None -> check_only + match ndet, state, read with + | None, None, None -> check_only | _ -> true in @@ -163,7 +171,7 @@ let run check_only ?ndet ?state ezfio_filename = (* Clean qp_stop status *) [ "qpstop" ; "qpkill" ] |> List.iter (fun f -> - let stopfile = + let stopfile = Filename.concat (Qpackage.ezfio_work ezfio_filename) f in if Sys.file_exists stopfile then @@ -173,7 +181,7 @@ let run check_only ?ndet ?state ezfio_filename = (* Reorder basis set *) begin match Input.Ao_basis.read() with - | Some aos -> + | Some aos -> let ordering = Input.Ao_basis.ordering aos in let test = Array.copy ordering in Array.sort compare test ; @@ -184,7 +192,7 @@ let run check_only ?ndet ?state ezfio_filename = Input.Ao_basis.write new_aos; match Input.Mo_basis.read() with | None -> () - | Some mos -> + | Some mos -> let new_mos = Input.Mo_basis.reorder mos ordering in Input.Mo_basis.write new_mos end @@ -200,7 +208,7 @@ let run check_only ?ndet ?state ezfio_filename = begin match state with | None -> () - | Some range -> + | Some range -> begin Input.Determinants_by_hand.extract_states range end @@ -210,14 +218,14 @@ let run check_only ?ndet ?state ezfio_filename = (* let output = (file_header ezfio_filename) :: ( List.map get [ - Ao_basis ; - Mo_basis ; + Ao_basis ; + Mo_basis ; ]) in String.concat output |> print_string *) - + let tasks = [ Nuclei_by_hand ; Ao_basis; @@ -230,33 +238,41 @@ let run check_only ?ndet ?state ezfio_filename = (* Create the temp file *) let temp_filename = - create_temp_file ezfio_filename tasks + match read, write with + | None, None -> create_temp_file ezfio_filename tasks + | Some filename, None -> filename + | None, filename -> create_temp_file ?filename ezfio_filename tasks + | x, y -> failwith "read and write options are incompatible" in - (* Open the temp file with external editor *) - let editor = - try Sys.getenv "EDITOR" - with Not_found -> "vi" + + let () = + match check_only with + | true -> () + | false -> + begin + (* Open the temp file with external editor *) + let editor = + try Sys.getenv "EDITOR" + with Not_found -> "vi" + in + Printf.sprintf "%s %s" editor temp_filename + |> Sys.command |> ignore + end in - match check_only with - | true -> () - | false -> - Printf.sprintf "%s %s" editor temp_filename - |> Sys.command |> ignore - ; - - (* Re-read the temp file *) - let temp_string = - let ic = open_in temp_filename in - let result = - input_lines ic - |> String.concat "\n" + if write = None then + (* Re-read the temp file *) + let temp_string = + let ic = open_in temp_filename in + let result = + input_lines ic + |> String.concat "\n" + in + close_in ic; + result in - close_in ic; - result - in - List.iter (fun x -> set temp_string x) tasks + List.iter (fun x -> set temp_string x) tasks @@ -264,7 +280,7 @@ let run check_only ?ndet ?state ezfio_filename = (** Remove the backup file *) let remove_backup ezfio_filename = - let backup_filename = + let backup_filename = Printf.sprintf "%s/work/backup.tar" ezfio_filename in try Sys.remove backup_filename @@ -273,7 +289,7 @@ let remove_backup ezfio_filename = (** Create a backup file in case of an exception *) let create_backup ezfio_filename = remove_backup ezfio_filename; - let backup_filename = + let backup_filename = Printf.sprintf "%s/work/backup.tar" ezfio_filename in try @@ -289,7 +305,7 @@ let create_backup ezfio_filename = (** Restore the backup file when an exception occuprs *) let restore_backup ezfio_filename = - let filename = + let filename = Printf.sprintf "%s/work/backup.tar" ezfio_filename in if Sys.file_exists filename then @@ -312,6 +328,16 @@ let () = doc="Checks the input data"; arg=Without_arg; }}; + {{ + short='w'; long="write"; opt=Optional; + doc="Writes the qp_edit file to a file\""; + arg=With_arg ""; }}; + + {{ + short='r'; long="read"; opt=Optional; + doc="Reads the file and applies it to the EZFIO\""; + arg=With_arg ""; }}; + {{ short='n'; long="ndet"; opt=Optional; doc="Truncates the wavefunction to the target number of determinants"; arg=With_arg ""; }}; @@ -328,6 +354,12 @@ let () = end; (* Handle options *) + let write = + Command_line.get "write" + in + let read = + Command_line.get "read" + in let ndet = match Command_line.get "ndet" with | None -> None @@ -353,7 +385,7 @@ let () = (* Run the program *) try if (not c) then create_backup ezfio_filename; - run c ?ndet ?state ezfio_filename + run c ?ndet ?state ?read ?write ezfio_filename with | Failure exc | Invalid_argument exc -> From 00859876d5f82e0f0281b658ae118b8d3ba484fa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 18 Mar 2024 17:53:22 +0100 Subject: [PATCH 30/64] Fixed read/write in qp_edit --- scripts/ezfio_interface/qp_edit_template | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/scripts/ezfio_interface/qp_edit_template b/scripts/ezfio_interface/qp_edit_template index 65c77384..2380660e 100644 --- a/scripts/ezfio_interface/qp_edit_template +++ b/scripts/ezfio_interface/qp_edit_template @@ -156,10 +156,10 @@ let create_temp_file ?filename ezfio_filename fields = let run check_only ?ndet ?state ?read ?write ezfio_filename = (* Set check_only if the arguments are not empty *) - let check_only = - match ndet, state, read with - | None, None, None -> check_only - | _ -> true + let open_editor = + match ndet, state, read, write with + | None, None, None, None -> not check_only + | _ -> false in (* Open EZFIO *) @@ -246,10 +246,7 @@ let run check_only ?ndet ?state ?read ?write ezfio_filename = in - let () = - match check_only with - | true -> () - | false -> + if open_editor then begin (* Open the temp file with external editor *) let editor = @@ -258,8 +255,7 @@ let run check_only ?ndet ?state ?read ?write ezfio_filename = in Printf.sprintf "%s %s" editor temp_filename |> Sys.command |> ignore - end - in + end; if write = None then (* Re-read the temp file *) From 183980943298f9738968507392a815a4f49f94f7 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 19 Mar 2024 14:47:01 +0100 Subject: [PATCH 31/64] Introduced all_shells_closed --- src/scf_utils/fock_matrix.irp.f | 18 ++++++++---------- src/scf_utils/scf_density_matrix_ao.irp.f | 10 +++++++++- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/src/scf_utils/fock_matrix.irp.f b/src/scf_utils/fock_matrix.irp.f index 1942e542..6054b99c 100644 --- a/src/scf_utils/fock_matrix.irp.f +++ b/src/scf_utils/fock_matrix.irp.f @@ -11,13 +11,13 @@ ! |-----------------------| ! | Fcv | F^a | Rvv | ! - ! C: Core, O: Open, V: Virtual - ! + ! C: Core, O: Open, V: Virtual + ! ! Rcc = Acc Fcc^a + Bcc Fcc^b ! Roo = Aoo Foo^a + Boo Foo^b ! Rvv = Avv Fvv^a + Bvv Fvv^b ! Fcv = (F^a + F^b)/2 - ! + ! ! F^a: Fock matrix alpha (MO), F^b: Fock matrix beta (MO) ! A,B: Coupling parameters ! @@ -26,10 +26,10 @@ ! cc oo vv ! A -0.5 0.5 1.5 ! B 1.5 0.5 -0.5 - ! + ! END_DOC integer :: i,j,n - if (elec_alpha_num == elec_beta_num) then + if (all_shells_closed) then Fock_matrix_mo = Fock_matrix_mo_alpha else ! Core @@ -102,7 +102,7 @@ ! ! END_DOC !integer :: i,j,n - !if (elec_alpha_num == elec_beta_num) then + !if (all_shells_closed) then ! Fock_matrix_mo = Fock_matrix_mo_alpha !else @@ -192,7 +192,7 @@ do j = 1, n_core_orb jorb = list_core(j) Fock_matrix_mo(iorb,jorb) = 0.d0 - Fock_matrix_mo(jorb,iorb) = 0.d0 + Fock_matrix_mo(jorb,iorb) = 0.d0 enddo enddo endif @@ -229,9 +229,7 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_ao, (ao_num, ao_num) ] call mo_to_ao(Fock_matrix_mo,size(Fock_matrix_mo,1), & Fock_matrix_ao,size(Fock_matrix_ao,1)) else - if ( (elec_alpha_num == elec_beta_num).and. & - (level_shift == 0.) ) & - then + if (all_shells_closed.and. (level_shift == 0.)) then integer :: i,j do j=1,ao_num do i=1,ao_num diff --git a/src/scf_utils/scf_density_matrix_ao.irp.f b/src/scf_utils/scf_density_matrix_ao.irp.f index 55fa8e7c..3813aa61 100644 --- a/src/scf_utils/scf_density_matrix_ao.irp.f +++ b/src/scf_utils/scf_density_matrix_ao.irp.f @@ -1,3 +1,11 @@ +BEGIN_PROVIDER [ logical, all_shells_closed ] + implicit none + BEGIN_DOC + ! + END_DOC + all_shells_closed = (elec_alpha_num == elec_beta_num) +END_PROVIDER + BEGIN_PROVIDER [double precision, SCF_density_matrix_ao_alpha, (ao_num,ao_num) ] implicit none BEGIN_DOC @@ -30,7 +38,7 @@ BEGIN_PROVIDER [ double precision, SCF_density_matrix_ao, (ao_num,ao_num) ] ! Sum of $\alpha$ and $\beta$ density matrices END_DOC ASSERT (size(SCF_density_matrix_ao,1) == size(SCF_density_matrix_ao_alpha,1)) - if (elec_alpha_num== elec_beta_num) then + if (all_shells_closed) then SCF_density_matrix_ao = SCF_density_matrix_ao_alpha + SCF_density_matrix_ao_alpha else ASSERT (size(SCF_density_matrix_ao,1) == size(SCF_density_matrix_ao_beta ,1)) From 7aff1a33a9b7d3871d7c5e8cda3bcf15258ce94a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 20 Mar 2024 09:20:21 +0100 Subject: [PATCH 32/64] Fixed nested parallelism in cholesky --- src/ao_two_e_ints/cholesky.irp.f | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ao_two_e_ints/cholesky.irp.f b/src/ao_two_e_ints/cholesky.irp.f index 2977f0f4..33304026 100644 --- a/src/ao_two_e_ints/cholesky.irp.f +++ b/src/ao_two_e_ints/cholesky.irp.f @@ -66,7 +66,8 @@ END_PROVIDER else - PROVIDE nucl_coord + PROVIDE nucl_coord ao_two_e_integral_schwartz + call set_multiple_levels_omp(.False.) if (do_direct_integrals) then if (ao_two_e_integral(1,1,1,1) < huge(1.d0)) then From df9299c661c4b87adf69a03a5b91b080093f096f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 20 Mar 2024 16:06:44 +0100 Subject: [PATCH 33/64] Updated documentation --- .readthedocs.yaml | 32 + docs/ref | 2 +- docs/source/appendix/contributors.rst | 25 +- docs/source/appendix/references.rst | 8 + docs/source/appendix/research.rst | 8 - docs/source/auto_generate.py | 3 +- docs/source/conf.py | 4 +- docs/source/intro/intro.rst | 32 +- docs/source/intro/selected.bib | 182 ---- docs/source/modules/becke_numerical_grid.rst | 770 ++++++++++++++++- docs/source/modules/cipsi.rst | 2 +- docs/source/references.bib | 847 +++++++++++++++++++ external/irpf90 | 2 +- src/cipsi/README.rst | 6 +- src/cipsi_utils/pt2_stoch_routines.irp.f | 3 + src/cipsi_utils/zmq_selection.irp.f | 3 + src/trexio/import_trexio_determinants.irp.f | 2 +- 17 files changed, 1679 insertions(+), 252 deletions(-) create mode 100644 .readthedocs.yaml create mode 100644 docs/source/appendix/references.rst delete mode 100644 docs/source/appendix/research.rst delete mode 100644 docs/source/intro/selected.bib create mode 100644 docs/source/references.bib diff --git a/.readthedocs.yaml b/.readthedocs.yaml new file mode 100644 index 00000000..f114dbf9 --- /dev/null +++ b/.readthedocs.yaml @@ -0,0 +1,32 @@ +# .readthedocs.yaml +# Read the Docs configuration file +# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details + +# Required +version: 2 + +# Set the OS, Python version and other tools you might need +build: + os: ubuntu-22.04 + tools: + python: "3.12" + # You can also specify other tool versions: + # nodejs: "19" + # rust: "1.64" + # golang: "1.19" + +# Build documentation in the "docs/" directory with Sphinx +sphinx: + configuration: docs/source/conf.py + +# Optionally build your docs in additional formats such as PDF and ePub +# formats: +# - pdf +# - epub + +# Optional but recommended, declare the Python requirements required +# to build your documentation +# See https://docs.readthedocs.io/en/stable/guides/reproducible-builds.html +python: + install: + - requirements: docs/requirements.txt diff --git a/docs/ref b/docs/ref index 58cc4721..49599966 100644 --- a/docs/ref +++ b/docs/ref @@ -20,5 +20,5 @@ Then, to reference for "myref" just type :ref:`myref` or use `IRPF90`_ and define _IRPF90: http://irpf90.ups-tlse.fr somewhere -* References of published results with QP should be added into docs/source/research.bib in bibtex +* References of published results with QP should be added into docs/source/references.bib in bibtex format diff --git a/docs/source/appendix/contributors.rst b/docs/source/appendix/contributors.rst index bf58adc2..e3574e5a 100644 --- a/docs/source/appendix/contributors.rst +++ b/docs/source/appendix/contributors.rst @@ -2,13 +2,13 @@ Contributors ============ -The |qp| is maintained by +The |qp| is maintained by -Anthony Scemama +Anthony Scemama | `Laboratoire de Chimie et Physique Quantiques `_, | CNRS - Université Paul Sabatier | Toulouse, France - | scemama@irsamc.ups-tlse.fr + | scemama@irsamc.ups-tlse.fr Emmanuel Giner @@ -18,27 +18,27 @@ Emmanuel Giner | emmanuel.giner@lct.jussieu.fr -Thomas Applencourt - | `Argonne Leadership Computing Facility `_ - | Argonne, USA - | tapplencourt@anl.gov - - - The following people have contributed to this project (by alphabetical order): +* Abdallah Ammar +* Thomas Applencourt * Roland Assaraf * Pierrette Barbaresco * Anouar Benali * Chandler Bennet * Michel Caffarel +* Vijay Gopal Chilkuri +* Yann Damour * Grégoire David +* Amanda Dumi * Anthony Ferté -* Madeline Galbraith +* Madeline Galbraith * Yann Garniron * Kevin Gasperich +* Fabris Kossoski * Pierre-François Loos * Jean-Paul Malrieu +* Antoine Marie * Barry Moore * Julien Paquier * Barthélémy Pradines @@ -49,6 +49,7 @@ The following people have contributed to this project (by alphabetical order): * Mikaël Véril -If you have contributed and don't appear in this list, please modify this file +If you have contributed and don't appear in this list, please modify the file +`$QP_ROOT/docs/source/appendix/contributors.rst` and submit a pull request. diff --git a/docs/source/appendix/references.rst b/docs/source/appendix/references.rst new file mode 100644 index 00000000..b277a6ac --- /dev/null +++ b/docs/source/appendix/references.rst @@ -0,0 +1,8 @@ +References +========== + +.. bibliography:: /references.bib + :style: unsrt + :all: + + diff --git a/docs/source/appendix/research.rst b/docs/source/appendix/research.rst deleted file mode 100644 index 992cc1eb..00000000 --- a/docs/source/appendix/research.rst +++ /dev/null @@ -1,8 +0,0 @@ -Some research made with the |qp| -================================ - -.. bibliography:: /research.bib - :style: unsrt - :all: - - diff --git a/docs/source/auto_generate.py b/docs/source/auto_generate.py index d767b922..6b50bce9 100755 --- a/docs/source/auto_generate.py +++ b/docs/source/auto_generate.py @@ -29,7 +29,8 @@ def generate_modules(abs_module, entities): rst += ["", "EZFIO parameters", "----------------", ""] config_file = configparser.ConfigParser() with open(EZFIO, 'r') as f: - config_file.readfp(f) +# config_file.readfp(f) + config_file.read_file(f) for section in config_file.sections(): doc = config_file.get(section, "doc") doc = " " + doc.replace("\n", "\n\n ")+"\n" diff --git a/docs/source/conf.py b/docs/source/conf.py index 21498968..bafd95fa 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -70,7 +70,7 @@ master_doc = 'index' # # This is also used if you do content translation via gettext catalogs. # Usually you set "language" from the command line for these cases. -language = None +language = "en" # List of patterns, relative to source directory, that match files and # directories to ignore when looking for source files. @@ -208,3 +208,5 @@ epub_exclude_files = ['search.html'] # -- Extension configuration ------------------------------------------------- +bibtex_bibfiles = [ "references.bib" ] + diff --git a/docs/source/intro/intro.rst b/docs/source/intro/intro.rst index aecd072d..6561f11a 100644 --- a/docs/source/intro/intro.rst +++ b/docs/source/intro/intro.rst @@ -11,25 +11,25 @@ The |qp| What it is ========== -The |qp| is an open-source **programming environment** for quantum chemistry. -It has been built from the **developper** point of view in order to help -the design of new quantum chemistry methods, -especially for `wave function theory `_ (|WFT|). +The |qp| is an open-source **programming environment** for quantum chemistry. +It has been built from the **developper** point of view in order to help +the design of new quantum chemistry methods, +especially for `wave function theory `_ (|WFT|). -From the **user** point of view, the |qp| proposes a stand-alone path -to use optimized selected configuration interaction |sCI| based on the -|CIPSI| algorithm that can efficiently reach near-full configuration interaction -|FCI| quality for relatively large systems (see for instance :cite:`Caffarel_2016,Caffarel_2016.2,Loos_2018,Scemama_2018,Dash_2018,Garniron_2017.2,Loos_2018,Garniron_2018,Giner2018Oct`). -To have a simple example of how to use the |CIPSI| program, go to the `users_guide/quickstart`. +From the **user** point of view, the |qp| proposes a stand-alone path +to use optimized selected configuration interaction |sCI| based on the +|CIPSI| algorithm that can efficiently reach near-full configuration interaction +|FCI| quality for relatively large systems. +To have a simple example of how to use the |CIPSI| program, go to the `users_guide/quickstart`. The main goal is the development of selected configuration interaction |sCI| methods and multi-reference perturbation theory |MRPT| in the -determinant-driven paradigm. It also contains the very basics of Kohn-Sham `density functional theory `_ |KS-DFT| and `range-separated hybrids `_ |RSH|. +determinant-driven paradigm. It also contains the very basics of Kohn-Sham `density functional theory `_ |KS-DFT| and `range-separated hybrids `_ |RSH|. -The determinant-driven framework allows the programmer to include any arbitrary set of -determinants in the variational space, and thus gives a complete freedom in the methodological -development. The basic ingredients of |RSH| together with those of the |WFT| framework available in the |qp| library allows one to easily develop range-separated DFT (|RSDFT|) approaches (see for instance the plugins at ``_). +The determinant-driven framework allows the programmer to include any arbitrary set of +determinants in the variational space, and thus gives a complete freedom in the methodological +development. The basic ingredients of |RSH| together with those of the |WFT| framework available in the |qp| library allows one to easily develop range-separated DFT (|RSDFT|) approaches (see for instance the plugins at ``_). All the programs are developed with the `IRPF90`_ code generator, which considerably simplifies the collaborative development, and the development of new features. @@ -40,20 +40,20 @@ What it is not ============== The |qp| is *not* a general purpose quantum chemistry program. -First of all, it is a *library* to develop new theories and algorithms in quantum chemistry. +First of all, it is a *library* to develop new theories and algorithms in quantum chemistry. Therefore, beside the use of the programs of the core modules, the users of the |qp| should develop their own programs. The |qp| has been designed specifically for |sCI|, so all the algorithms which are programmed are not adapted to run SCF or DFT calculations on thousands of atoms. Currently, the systems targeted have less than 600 -molecular orbitals. This limit is due to the memory bottleneck induced by the storring of the two-electron integrals (see ``mo_two_e_integrals`` and ``ao_two_e_integrals``). +molecular orbitals. This limit is due to the memory bottleneck induced by the storring of the two-electron integrals (see ``mo_two_e_integrals`` and ``ao_two_e_integrals``). The |qp| is *not* a massive production code. For conventional methods such as Hartree-Fock, CISD or MP2, the users are recommended to use the existing standard production codes which are designed to make these methods run fast. Again, the role of the |qp| is to make life simple for the developer. Once a new method is developed and tested, the developer is encouraged -to consider re-expressing it with an integral-driven formulation, and to +to consider re-expressing it with an integral-driven formulation, and to implement the new method in open-source production codes, such as `NWChem`_ or |GAMESS|. diff --git a/docs/source/intro/selected.bib b/docs/source/intro/selected.bib deleted file mode 100644 index 32df8bce..00000000 --- a/docs/source/intro/selected.bib +++ /dev/null @@ -1,182 +0,0 @@ -@article{Bytautas_2009, - doi = {10.1016/j.chemphys.2008.11.021}, - url = {https://doi.org/10.1016%2Fj.chemphys.2008.11.021}, - year = 2009, - month = {feb}, - publisher = {Elsevier {BV}}, - volume = {356}, - number = {1-3}, - pages = {64--75}, - author = {Laimutis Bytautas and Klaus Ruedenberg}, - title = {A priori identification of configurational deadwood}, - journal = {Chemical Physics} -} - -@article{Anderson_2018, - doi = {10.1016/j.comptc.2018.08.017}, - url = {https://doi.org/10.1016%2Fj.comptc.2018.08.017}, - year = 2018, - month = {oct}, - publisher = {Elsevier {BV}}, - volume = {1142}, - pages = {66--77}, - author = {James S.M. Anderson and Farnaz Heidar-Zadeh and Paul W. Ayers}, - title = {Breaking the curse of dimension for the electronic Schrodinger equation with functional analysis}, - journal = {Computational and Theoretical Chemistry} -} - -@article{Bender_1969, - doi = {10.1103/physrev.183.23}, - url = {http://dx.doi.org/10.1103/PhysRev.183.23}, - year = 1969, - month = {jul}, - publisher = {American Physical Society ({APS})}, - volume = {183}, - number = {1}, - pages = {23--30}, - author = {Charles F. Bender and Ernest R. Davidson}, - title = {Studies in Configuration Interaction: The First-Row Diatomic Hydrides}, - journal = {Phys. Rev.} -} - -@article{Whitten_1969, - doi = {10.1063/1.1671985}, - url = {https://doi.org/10.1063%2F1.1671985}, - year = 1969, - month = {dec}, - publisher = {{AIP} Publishing}, - volume = {51}, - number = {12}, - pages = {5584--5596}, - author = {J. L. Whitten and Melvyn Hackmeyer}, - title = {Configuration Interaction Studies of Ground and Excited States of Polyatomic Molecules. I. The {CI} Formulation and Studies of Formaldehyde}, - journal = {The Journal of Chemical Physics} -} - -@article{Huron_1973, - doi = {10.1063/1.1679199}, - url = {https://doi.org/10.1063%2F1.1679199}, - year = 1973, - month = {jun}, - publisher = {{AIP} Publishing}, - volume = {58}, - number = {12}, - pages = {5745--5759}, - author = {B. Huron and J. P. Malrieu and P. Rancurel}, - title = {Iterative perturbation calculations of ground and excited state energies from multiconfigurational zeroth-order wavefunctions}, - journal = {The Journal of Chemical Physics} -} - -@article{Knowles_1984, - author="Peter J. Knowles and Nicholas C Handy", - year=1984, - journal={Chem. Phys. Letters}, - volume=111, - pages="315--321", - title="A New Determinant-based Full Configuration Interaction Method" -} - - -@article{Scemama_2013, - author = {{Scemama}, A. and {Giner}, E.}, - title = "{An efficient implementation of Slater-Condon rules}", - journal = {ArXiv [physics.comp-ph]}, - pages = {1311.6244}, - year = 2013, - month = nov, - url = {https://arxiv.org/abs/1311.6244} -} - -@article{Sharma_2017, - doi = {10.1021/acs.jctc.6b01028}, - url = {https://doi.org/10.1021%2Facs.jctc.6b01028}, - year = 2017, - month = {mar}, - publisher = {American Chemical Society ({ACS})}, - volume = {13}, - number = {4}, - pages = {1595--1604}, - author = {Sandeep Sharma and Adam A. Holmes and Guillaume Jeanmairet and Ali Alavi and C. J. Umrigar}, - title = {Semistochastic Heat-Bath Configuration Interaction Method: Selected Configuration Interaction with Semistochastic Perturbation Theory}, - journal = {Journal of Chemical Theory and Computation} -} - -@article{Holmes_2016, - doi = {10.1021/acs.jctc.6b00407}, - url = {https://doi.org/10.1021%2Facs.jctc.6b00407}, - year = 2016, - month = {aug}, - publisher = {American Chemical Society ({ACS})}, - volume = {12}, - number = {8}, - pages = {3674--3680}, - author = {Adam A. Holmes and Norm M. Tubman and C. J. Umrigar}, - title = {Heat-Bath Configuration Interaction: An Efficient Selected Configuration Interaction Algorithm Inspired by Heat-Bath Sampling}, - journal = {Journal of Chemical Theory and Computation} -} -@article{Evangelisti_1983, - doi = {10.1016/0301-0104(83)85011-3}, - url = {https://doi.org/10.1016%2F0301-0104%2883%2985011-3}, - year = 1983, - month = {feb}, - publisher = {Elsevier {BV}}, - volume = {75}, - number = {1}, - pages = {91--102}, - author = {Stefano Evangelisti and Jean-Pierre Daudey and Jean-Paul Malrieu}, - title = {Convergence of an improved {CIPSI} algorithm}, - journal = {Chemical Physics} -} -@article{Booth_2009, - doi = {10.1063/1.3193710}, - url = {https://doi.org/10.1063%2F1.3193710}, - year = 2009, - publisher = {{AIP} Publishing}, - volume = {131}, - number = {5}, - pages = {054106}, - author = {George H. Booth and Alex J. W. Thom and Ali Alavi}, - title = {Fermion Monte Carlo without fixed nodes: A game of life, death, and annihilation in Slater determinant space}, - journal = {The Journal of Chemical Physics} -} -@article{Booth_2010, - doi = {10.1063/1.3407895}, - url = {https://doi.org/10.1063%2F1.3407895}, - year = 2010, - month = {may}, - publisher = {{AIP} Publishing}, - volume = {132}, - number = {17}, - pages = {174104}, - author = {George H. Booth and Ali Alavi}, - title = {Approaching chemical accuracy using full configuration-interaction quantum Monte Carlo: A study of ionization potentials}, - journal = {The Journal of Chemical Physics} -} -@article{Cleland_2010, - doi = {10.1063/1.3302277}, - url = {https://doi.org/10.1063%2F1.3302277}, - year = 2010, - month = {jan}, - publisher = {{AIP} Publishing}, - volume = {132}, - number = {4}, - pages = {041103}, - author = {Deidre Cleland and George H. Booth and Ali Alavi}, - title = {Communications: Survival of the fittest: Accelerating convergence in full configuration-interaction quantum Monte Carlo}, - journal = {The Journal of Chemical Physics} -} - -@article{Garniron_2017b, - doi = {10.1063/1.4992127}, - url = {https://doi.org/10.1063%2F1.4992127}, - year = 2017, - month = {jul}, - publisher = {{AIP} Publishing}, - volume = {147}, - number = {3}, - pages = {034101}, - author = {Yann Garniron and Anthony Scemama and Pierre-Fran{\c{c}}ois Loos and Michel Caffarel}, - title = {Hybrid stochastic-deterministic calculation of the second-order perturbative contribution of multireference perturbation theory}, - journal = {The Journal of Chemical Physics} -} - diff --git a/docs/source/modules/becke_numerical_grid.rst b/docs/source/modules/becke_numerical_grid.rst index e67c443a..27a95877 100644 --- a/docs/source/modules/becke_numerical_grid.rst +++ b/docs/source/modules/becke_numerical_grid.rst @@ -99,6 +99,71 @@ EZFIO parameters Default: 1.e-20 +.. option:: my_grid_becke + + if True, the number of angular and radial grid points are read from EZFIO + + Default: False + +.. option:: my_n_pt_r_grid + + Number of radial grid points given from input + + Default: 300 + +.. option:: my_n_pt_a_grid + + Number of angular grid points given from input. Warning, this number cannot be any integer. See file list_angular_grid + + Default: 1202 + +.. option:: n_points_extra_final_grid + + Total number of extra_grid points + + +.. option:: extra_grid_type_sgn + + Type of extra_grid used for the Becke's numerical extra_grid. Can be, by increasing accuracy: [ 0 | 1 | 2 | 3 ] + + Default: 0 + +.. option:: thresh_extra_grid + + threshold on the weight of a given extra_grid point + + Default: 1.e-20 + +.. option:: my_extra_grid_becke + + if True, the number of angular and radial extra_grid points are read from EZFIO + + Default: False + +.. option:: my_n_pt_r_extra_grid + + Number of radial extra_grid points given from input + + Default: 300 + +.. option:: my_n_pt_a_extra_grid + + Number of angular extra_grid points given from input. Warning, this number cannot be any integer. See file list_angular_extra_grid + + Default: 1202 + +.. option:: rad_grid_type + + method used to sample the radial space. Possible choices are [KNOWLES | GILL] + + Default: KNOWLES + +.. option:: extra_rad_grid_type + + method used to sample the radial space. Possible choices are [KNOWLES | GILL] + + Default: KNOWLES + Providers --------- @@ -122,6 +187,8 @@ Providers :columns: 3 * :c:data:`final_weight_at_r` + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` * :c:data:`grid_points_per_atom` @@ -156,6 +223,66 @@ Providers * :c:data:`grid_points_per_atom` +.. c:var:: angular_quadrature_points_extra + + + File : :file:`becke_numerical_grid/angular_extra_grid.irp.f` + + .. code:: fortran + + double precision, allocatable :: angular_quadrature_points_extra (n_points_extra_integration_angular,3) + double precision, allocatable :: weights_angular_points_extra (n_points_extra_integration_angular) + + + weights and grid points_extra for the integration on the angular variables on + the unit sphere centered on (0,0,0) + According to the LEBEDEV scheme + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`n_points_extra_radial_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + + +.. c:var:: dr_radial_extra_integral + + + File : :file:`becke_numerical_grid/extra_grid.irp.f` + + .. code:: fortran + + double precision, allocatable :: grid_points_extra_radial (n_points_extra_radial_grid) + double precision :: dr_radial_extra_integral + + + points_extra in [0,1] to map the radial integral [0,\infty] + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`n_points_extra_radial_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + + .. c:var:: dr_radial_integral @@ -223,6 +350,11 @@ Providers .. hlist:: :columns: 3 + * :c:data:`ao_abs_int_grid` + * :c:data:`ao_overlap_abs_grid` + * :c:data:`ao_prod_abs_r` + * :c:data:`ao_prod_center` + * :c:data:`ao_prod_dist_grid` * :c:data:`aos_grad_in_r_array` * :c:data:`aos_in_r_array` * :c:data:`aos_lapl_in_r_array` @@ -241,11 +373,60 @@ Providers * :c:data:`energy_x_pbe` * :c:data:`energy_x_sr_lda` * :c:data:`energy_x_sr_pbe` + * :c:data:`f_psi_cas_ab` + * :c:data:`f_psi_hf_ab` + * :c:data:`final_grid_points_transp` + * :c:data:`mo_grad_ints` * :c:data:`mos_in_r_array` * :c:data:`mos_in_r_array_omp` + * :c:data:`mu_average_prov` + * :c:data:`mu_grad_rho` + * :c:data:`mu_of_r_dft_average` + * :c:data:`mu_rsc_of_r` * :c:data:`one_e_dm_and_grad_alpha_in_r` +.. c:var:: final_grid_points_extra + + + File : :file:`becke_numerical_grid/extra_grid_vector.irp.f` + + .. code:: fortran + + double precision, allocatable :: final_grid_points_extra (3,n_points_extra_final_grid) + double precision, allocatable :: final_weight_at_r_vector_extra (n_points_extra_final_grid) + integer, allocatable :: index_final_points_extra (3,n_points_extra_final_grid) + integer, allocatable :: index_final_points_extra_reverse (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) + + + final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point + + final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions + + index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point + + index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + * :c:data:`n_points_extra_final_grid` + * :c:data:`n_points_extra_radial_grid` + * :c:data:`nucl_num` + * :c:data:`thresh_extra_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`aos_in_r_array_extra` + + .. c:var:: final_grid_points_per_atom @@ -272,12 +453,28 @@ Providers * :c:data:`nucl_num` * :c:data:`thresh_grid` - Needed by: + + +.. c:var:: final_grid_points_transp + + + File : :file:`becke_numerical_grid/grid_becke_vector.irp.f` + + .. code:: fortran + + double precision, allocatable :: final_grid_points_transp (n_points_final_grid,3) + + + Transposed final_grid_points + + Needs: .. hlist:: :columns: 3 - * :c:data:`aos_in_r_array_per_atom` + * :c:data:`final_grid_points` + * :c:data:`n_points_final_grid` + .. c:var:: final_weight_at_r @@ -304,6 +501,8 @@ Providers * :c:data:`m_knowles` * :c:data:`n_points_radial_grid` * :c:data:`nucl_num` + * :c:data:`r_gill` + * :c:data:`rad_grid_type` * :c:data:`weight_at_r` Needed by: @@ -317,6 +516,43 @@ Providers * :c:data:`n_pts_per_atom` +.. c:var:: final_weight_at_r_extra + + + File : :file:`becke_numerical_grid/extra_grid.irp.f` + + .. code:: fortran + + double precision, allocatable :: final_weight_at_r_extra (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) + + + Total weight on each grid point which takes into account all Lebedev, Voronoi and radial weights. + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`alpha_knowles` + * :c:data:`angular_quadrature_points_extra` + * :c:data:`extra_rad_grid_type` + * :c:data:`grid_atomic_number` + * :c:data:`grid_points_extra_radial` + * :c:data:`m_knowles` + * :c:data:`n_points_extra_radial_grid` + * :c:data:`nucl_num` + * :c:data:`r_gill` + * :c:data:`weight_at_r_extra` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`final_grid_points_extra` + * :c:data:`n_points_extra_final_grid` + + .. c:var:: final_weight_at_r_vector @@ -355,6 +591,11 @@ Providers .. hlist:: :columns: 3 + * :c:data:`ao_abs_int_grid` + * :c:data:`ao_overlap_abs_grid` + * :c:data:`ao_prod_abs_r` + * :c:data:`ao_prod_center` + * :c:data:`ao_prod_dist_grid` * :c:data:`aos_grad_in_r_array` * :c:data:`aos_in_r_array` * :c:data:`aos_lapl_in_r_array` @@ -373,11 +614,60 @@ Providers * :c:data:`energy_x_pbe` * :c:data:`energy_x_sr_lda` * :c:data:`energy_x_sr_pbe` + * :c:data:`f_psi_cas_ab` + * :c:data:`f_psi_hf_ab` + * :c:data:`final_grid_points_transp` + * :c:data:`mo_grad_ints` * :c:data:`mos_in_r_array` * :c:data:`mos_in_r_array_omp` + * :c:data:`mu_average_prov` + * :c:data:`mu_grad_rho` + * :c:data:`mu_of_r_dft_average` + * :c:data:`mu_rsc_of_r` * :c:data:`one_e_dm_and_grad_alpha_in_r` +.. c:var:: final_weight_at_r_vector_extra + + + File : :file:`becke_numerical_grid/extra_grid_vector.irp.f` + + .. code:: fortran + + double precision, allocatable :: final_grid_points_extra (3,n_points_extra_final_grid) + double precision, allocatable :: final_weight_at_r_vector_extra (n_points_extra_final_grid) + integer, allocatable :: index_final_points_extra (3,n_points_extra_final_grid) + integer, allocatable :: index_final_points_extra_reverse (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) + + + final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point + + final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions + + index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point + + index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + * :c:data:`n_points_extra_final_grid` + * :c:data:`n_points_extra_radial_grid` + * :c:data:`nucl_num` + * :c:data:`thresh_extra_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`aos_in_r_array_extra` + + .. c:var:: final_weight_at_r_vector_per_atom @@ -404,12 +694,6 @@ Providers * :c:data:`nucl_num` * :c:data:`thresh_grid` - Needed by: - - .. hlist:: - :columns: 3 - - * :c:data:`aos_in_r_array_per_atom` .. c:var:: grid_atomic_number @@ -438,9 +722,77 @@ Providers :columns: 3 * :c:data:`final_weight_at_r` + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` * :c:data:`grid_points_per_atom` +.. c:var:: grid_points_extra_per_atom + + + File : :file:`becke_numerical_grid/extra_grid.irp.f` + + .. code:: fortran + + double precision, allocatable :: grid_points_extra_per_atom (3,n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) + + + x,y,z coordinates of grid points_extra used for integration in 3d space + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`alpha_knowles` + * :c:data:`angular_quadrature_points_extra` + * :c:data:`extra_rad_grid_type` + * :c:data:`grid_atomic_number` + * :c:data:`grid_points_extra_radial` + * :c:data:`m_knowles` + * :c:data:`n_points_extra_radial_grid` + * :c:data:`nucl_coord` + * :c:data:`nucl_num` + * :c:data:`r_gill` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`final_grid_points_extra` + * :c:data:`weight_at_r_extra` + + +.. c:var:: grid_points_extra_radial + + + File : :file:`becke_numerical_grid/extra_grid.irp.f` + + .. code:: fortran + + double precision, allocatable :: grid_points_extra_radial (n_points_extra_radial_grid) + double precision :: dr_radial_extra_integral + + + points_extra in [0,1] to map the radial integral [0,\infty] + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`n_points_extra_radial_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + + .. c:var:: grid_points_per_atom @@ -466,6 +818,8 @@ Providers * :c:data:`n_points_radial_grid` * :c:data:`nucl_coord` * :c:data:`nucl_num` + * :c:data:`r_gill` + * :c:data:`rad_grid_type` Needed by: @@ -544,6 +898,11 @@ Providers .. hlist:: :columns: 3 + * :c:data:`ao_abs_int_grid` + * :c:data:`ao_overlap_abs_grid` + * :c:data:`ao_prod_abs_r` + * :c:data:`ao_prod_center` + * :c:data:`ao_prod_dist_grid` * :c:data:`aos_grad_in_r_array` * :c:data:`aos_in_r_array` * :c:data:`aos_lapl_in_r_array` @@ -562,11 +921,101 @@ Providers * :c:data:`energy_x_pbe` * :c:data:`energy_x_sr_lda` * :c:data:`energy_x_sr_pbe` + * :c:data:`f_psi_cas_ab` + * :c:data:`f_psi_hf_ab` + * :c:data:`final_grid_points_transp` + * :c:data:`mo_grad_ints` * :c:data:`mos_in_r_array` * :c:data:`mos_in_r_array_omp` + * :c:data:`mu_average_prov` + * :c:data:`mu_grad_rho` + * :c:data:`mu_of_r_dft_average` + * :c:data:`mu_rsc_of_r` * :c:data:`one_e_dm_and_grad_alpha_in_r` +.. c:var:: index_final_points_extra + + + File : :file:`becke_numerical_grid/extra_grid_vector.irp.f` + + .. code:: fortran + + double precision, allocatable :: final_grid_points_extra (3,n_points_extra_final_grid) + double precision, allocatable :: final_weight_at_r_vector_extra (n_points_extra_final_grid) + integer, allocatable :: index_final_points_extra (3,n_points_extra_final_grid) + integer, allocatable :: index_final_points_extra_reverse (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) + + + final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point + + final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions + + index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point + + index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + * :c:data:`n_points_extra_final_grid` + * :c:data:`n_points_extra_radial_grid` + * :c:data:`nucl_num` + * :c:data:`thresh_extra_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`aos_in_r_array_extra` + + +.. c:var:: index_final_points_extra_reverse + + + File : :file:`becke_numerical_grid/extra_grid_vector.irp.f` + + .. code:: fortran + + double precision, allocatable :: final_grid_points_extra (3,n_points_extra_final_grid) + double precision, allocatable :: final_weight_at_r_vector_extra (n_points_extra_final_grid) + integer, allocatable :: index_final_points_extra (3,n_points_extra_final_grid) + integer, allocatable :: index_final_points_extra_reverse (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) + + + final_grid_points_extra(1:3,j) = (/ x, y, z /) of the jth grid point + + final_weight_at_r_vector_extra(i) = Total weight function of the ith grid point which contains the Lebedev, Voronoi and radial weights contributions + + index_final_points_extra(1:3,i) = gives the angular, radial and atomic indices associated to the ith grid point + + index_final_points_extra_reverse(i,j,k) = index of the grid point having i as angular, j as radial and l as atomic indices + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + * :c:data:`n_points_extra_final_grid` + * :c:data:`n_points_extra_radial_grid` + * :c:data:`nucl_num` + * :c:data:`thresh_extra_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`aos_in_r_array_extra` + + .. c:var:: index_final_points_per_atom @@ -593,12 +1042,6 @@ Providers * :c:data:`nucl_num` * :c:data:`thresh_grid` - Needed by: - - .. hlist:: - :columns: 3 - - * :c:data:`aos_in_r_array_per_atom` .. c:var:: index_final_points_per_atom_reverse @@ -627,12 +1070,6 @@ Providers * :c:data:`nucl_num` * :c:data:`thresh_grid` - Needed by: - - .. hlist:: - :columns: 3 - - * :c:data:`aos_in_r_array_per_atom` .. c:var:: index_final_points_reverse @@ -673,6 +1110,11 @@ Providers .. hlist:: :columns: 3 + * :c:data:`ao_abs_int_grid` + * :c:data:`ao_overlap_abs_grid` + * :c:data:`ao_prod_abs_r` + * :c:data:`ao_prod_center` + * :c:data:`ao_prod_dist_grid` * :c:data:`aos_grad_in_r_array` * :c:data:`aos_in_r_array` * :c:data:`aos_lapl_in_r_array` @@ -691,8 +1133,16 @@ Providers * :c:data:`energy_x_pbe` * :c:data:`energy_x_sr_lda` * :c:data:`energy_x_sr_pbe` + * :c:data:`f_psi_cas_ab` + * :c:data:`f_psi_hf_ab` + * :c:data:`final_grid_points_transp` + * :c:data:`mo_grad_ints` * :c:data:`mos_in_r_array` * :c:data:`mos_in_r_array_omp` + * :c:data:`mu_average_prov` + * :c:data:`mu_grad_rho` + * :c:data:`mu_of_r_dft_average` + * :c:data:`mu_rsc_of_r` * :c:data:`one_e_dm_and_grad_alpha_in_r` @@ -714,9 +1164,148 @@ Providers :columns: 3 * :c:data:`final_weight_at_r` + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` * :c:data:`grid_points_per_atom` +.. c:var:: n_points_extra_final_grid + + + File : :file:`becke_numerical_grid/extra_grid_vector.irp.f` + + .. code:: fortran + + integer :: n_points_extra_final_grid + + + Number of points_extra which are non zero + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`n_points_extra_radial_grid` + * :c:data:`nucl_num` + * :c:data:`thresh_extra_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`aos_in_r_array_extra` + * :c:data:`aos_in_r_array_extra_transp` + * :c:data:`final_grid_points_extra` + + +.. c:var:: n_points_extra_grid_per_atom + + + File : :file:`becke_numerical_grid/extra_grid.irp.f` + + .. code:: fortran + + integer :: n_points_extra_grid_per_atom + + + Number of grid points_extra per atom + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`n_points_extra_radial_grid` + + + +.. c:var:: n_points_extra_integration_angular + + + File : :file:`becke_numerical_grid/extra_grid.irp.f` + + .. code:: fortran + + integer :: n_points_extra_radial_grid + integer :: n_points_extra_integration_angular + + + n_points_extra_radial_grid = number of radial grid points_extra per atom + + n_points_extra_integration_angular = number of angular grid points_extra per atom + + These numbers are automatically set by setting the grid_type_sgn parameter + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`extra_grid_type_sgn` + * :c:data:`my_extra_grid_becke` + * :c:data:`my_n_pt_a_extra_grid` + * :c:data:`my_n_pt_r_extra_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`angular_quadrature_points_extra` + * :c:data:`final_grid_points_extra` + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + * :c:data:`grid_points_extra_radial` + * :c:data:`n_points_extra_final_grid` + * :c:data:`n_points_extra_grid_per_atom` + * :c:data:`weight_at_r_extra` + + +.. c:var:: n_points_extra_radial_grid + + + File : :file:`becke_numerical_grid/extra_grid.irp.f` + + .. code:: fortran + + integer :: n_points_extra_radial_grid + integer :: n_points_extra_integration_angular + + + n_points_extra_radial_grid = number of radial grid points_extra per atom + + n_points_extra_integration_angular = number of angular grid points_extra per atom + + These numbers are automatically set by setting the grid_type_sgn parameter + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`extra_grid_type_sgn` + * :c:data:`my_extra_grid_becke` + * :c:data:`my_n_pt_a_extra_grid` + * :c:data:`my_n_pt_r_extra_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`angular_quadrature_points_extra` + * :c:data:`final_grid_points_extra` + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + * :c:data:`grid_points_extra_radial` + * :c:data:`n_points_extra_final_grid` + * :c:data:`n_points_extra_grid_per_atom` + * :c:data:`weight_at_r_extra` + + .. c:var:: n_points_final_grid @@ -744,9 +1333,17 @@ Providers .. hlist:: :columns: 3 + * :c:data:`act_mos_in_r_array` * :c:data:`alpha_dens_kin_in_r` + * :c:data:`ao_abs_int_grid` + * :c:data:`ao_overlap_abs_grid` + * :c:data:`ao_prod_abs_r` + * :c:data:`ao_prod_center` + * :c:data:`ao_prod_dist_grid` * :c:data:`aos_grad_in_r_array` * :c:data:`aos_grad_in_r_array_transp` + * :c:data:`aos_grad_in_r_array_transp_3` + * :c:data:`aos_grad_in_r_array_transp_bis` * :c:data:`aos_in_r_array` * :c:data:`aos_in_r_array_transp` * :c:data:`aos_lapl_in_r_array` @@ -759,6 +1356,14 @@ Providers * :c:data:`aos_vxc_alpha_lda_w` * :c:data:`aos_vxc_alpha_pbe_w` * :c:data:`aos_vxc_alpha_sr_pbe_w` + * :c:data:`basis_mos_in_r_array` + * :c:data:`core_density` + * :c:data:`core_inact_act_mos_grad_in_r_array` + * :c:data:`core_inact_act_mos_in_r_array` + * :c:data:`core_inact_act_v_kl_contracted` + * :c:data:`core_mos_in_r_array` + * :c:data:`effective_alpha_dm` + * :c:data:`effective_spin_dm` * :c:data:`elec_beta_num_grid_becke` * :c:data:`energy_c_lda` * :c:data:`energy_c_sr_lda` @@ -766,14 +1371,39 @@ Providers * :c:data:`energy_x_pbe` * :c:data:`energy_x_sr_lda` * :c:data:`energy_x_sr_pbe` + * :c:data:`f_psi_cas_ab` + * :c:data:`f_psi_cas_ab_old` + * :c:data:`f_psi_hf_ab` * :c:data:`final_grid_points` + * :c:data:`final_grid_points_transp` + * :c:data:`full_occ_2_rdm_cntrctd` + * :c:data:`full_occ_2_rdm_cntrctd_trans` + * :c:data:`full_occ_v_kl_cntrctd` + * :c:data:`grad_total_cas_on_top_density` + * :c:data:`inact_density` + * :c:data:`inact_mos_in_r_array` * :c:data:`kinetic_density_generalized` + * :c:data:`mo_grad_ints` * :c:data:`mos_grad_in_r_array` * :c:data:`mos_grad_in_r_array_tranp` + * :c:data:`mos_grad_in_r_array_transp_3` + * :c:data:`mos_grad_in_r_array_transp_bis` * :c:data:`mos_in_r_array` * :c:data:`mos_in_r_array_omp` * :c:data:`mos_in_r_array_transp` * :c:data:`mos_lapl_in_r_array` + * :c:data:`mos_lapl_in_r_array_tranp` + * :c:data:`mu_average_prov` + * :c:data:`mu_grad_rho` + * :c:data:`mu_of_r_dft` + * :c:data:`mu_of_r_dft_average` + * :c:data:`mu_of_r_hf` + * :c:data:`mu_of_r_prov` + * :c:data:`mu_of_r_psi_cas` + * :c:data:`mu_rsc_of_r` + * :c:data:`one_e_act_density_alpha` + * :c:data:`one_e_act_density_beta` + * :c:data:`one_e_cas_total_density` * :c:data:`one_e_dm_and_grad_alpha_in_r` * :c:data:`pot_grad_x_alpha_ao_pbe` * :c:data:`pot_grad_x_alpha_ao_sr_pbe` @@ -789,6 +1419,8 @@ Providers * :c:data:`potential_x_alpha_ao_sr_lda` * :c:data:`potential_xc_alpha_ao_lda` * :c:data:`potential_xc_alpha_ao_sr_lda` + * :c:data:`total_cas_on_top_density` + * :c:data:`virt_mos_in_r_array` .. c:var:: n_points_grid_per_atom @@ -928,7 +1560,6 @@ Providers .. hlist:: :columns: 3 - * :c:data:`aos_in_r_array_per_atom` * :c:data:`final_grid_points_per_atom` @@ -960,10 +1591,31 @@ Providers .. hlist:: :columns: 3 - * :c:data:`aos_in_r_array_per_atom` * :c:data:`final_grid_points_per_atom` +.. c:var:: r_gill + + + File : :file:`becke_numerical_grid/grid_becke.irp.f` + + .. code:: fortran + + double precision :: r_gill + + + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r` + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + * :c:data:`grid_points_per_atom` + + .. c:var:: weight_at_r @@ -1001,6 +1653,43 @@ Providers * :c:data:`final_weight_at_r` +.. c:var:: weight_at_r_extra + + + File : :file:`becke_numerical_grid/extra_grid.irp.f` + + .. code:: fortran + + double precision, allocatable :: weight_at_r_extra (n_points_extra_integration_angular,n_points_extra_radial_grid,nucl_num) + + + Weight function at grid points_extra : w_n(r) according to the equation (22) + of Becke original paper (JCP, 88, 1988) + + The "n" discrete variable represents the nucleis which in this array is + represented by the last dimension and the points_extra are labelled by the + other dimensions. + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`grid_points_extra_per_atom` + * :c:data:`n_points_extra_radial_grid` + * :c:data:`nucl_coord_transp` + * :c:data:`nucl_dist_inv` + * :c:data:`nucl_num` + * :c:data:`slater_bragg_type_inter_distance_ua` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + + .. c:var:: weights_angular_points @@ -1032,6 +1721,37 @@ Providers * :c:data:`grid_points_per_atom` +.. c:var:: weights_angular_points_extra + + + File : :file:`becke_numerical_grid/angular_extra_grid.irp.f` + + .. code:: fortran + + double precision, allocatable :: angular_quadrature_points_extra (n_points_extra_integration_angular,3) + double precision, allocatable :: weights_angular_points_extra (n_points_extra_integration_angular) + + + weights and grid points_extra for the integration on the angular variables on + the unit sphere centered on (0,0,0) + According to the LEBEDEV scheme + + Needs: + + .. hlist:: + :columns: 3 + + * :c:data:`n_points_extra_radial_grid` + + Needed by: + + .. hlist:: + :columns: 3 + + * :c:data:`final_weight_at_r_extra` + * :c:data:`grid_points_extra_per_atom` + + Subroutines / functions ----------------------- @@ -1043,7 +1763,7 @@ Subroutines / functions .. code:: fortran - double precision function cell_function_becke(r,atom_number) + double precision function cell_function_becke(r, atom_number) atom_number :: atom on which the cell function of Becke (1988, JCP,88(4)) @@ -1067,7 +1787,7 @@ Subroutines / functions .. code:: fortran - double precision function derivative_knowles_function(alpha,m,x) + double precision function derivative_knowles_function(alpha, m, x) Derivative of the function proposed by Knowles (JCP, 104, 1996) for distributing the radial points @@ -1118,7 +1838,7 @@ Subroutines / functions .. code:: fortran - double precision function knowles_function(alpha,m,x) + double precision function knowles_function(alpha, m, x) Function proposed by Knowles (JCP, 104, 1996) for distributing the radial points : diff --git a/docs/source/modules/cipsi.rst b/docs/source/modules/cipsi.rst index 501a91dd..77212469 100644 --- a/docs/source/modules/cipsi.rst +++ b/docs/source/modules/cipsi.rst @@ -21,7 +21,7 @@ The :c:func:`run_cipsi` subroutine iteratively: * If :option:`determinants s2_eig` is |true|, it adds all the necessary determinants to allow the eigenstates of |H| to be eigenstates of |S^2| * Diagonalizes |H| in the enlarged internal space -* Computes the |PT2| contribution to the energy stochastically :cite:`Garniron_2017.2` +* Computes the |PT2| contribution to the energy stochastically :cite:`Garniron_2017b` or deterministically, depending on :option:`perturbation do_pt2` * Extrapolates the variational energy by fitting :math:`E=E_\text{FCI} - \alpha\, E_\text{PT2}` diff --git a/docs/source/references.bib b/docs/source/references.bib new file mode 100644 index 00000000..6580eefa --- /dev/null +++ b/docs/source/references.bib @@ -0,0 +1,847 @@ + +@article{Ammar_2023, + author = {Ammar, Abdallah and Scemama, Anthony and Giner, Emmanuel}, + title = {{Transcorrelated selected configuration interaction in a bi-orthonormal basis and with a cheap three-body correlation factor}}, + journal = {J. Chem. Phys.}, + volume = {159}, + number = {11}, + year = {2023}, + month = sep, + issn = {0021-9606}, + publisher = {AIP Publishing}, + doi = {10.1063/5.0163831} +} + +@article{Ammar_2023.2, + author = {Ammar, Abdallah and Scemama, Anthony and Giner, Emmanuel}, + title = {{Biorthonormal Orbital Optimization with a Cheap Core-Electron-Free Three-Body Correlation Factor for Quantum Monte Carlo and Transcorrelation}}, + journal = {J. Chem. Theory Comput.}, + volume = {19}, + number = {15}, + pages = {4883--4896}, + year = {2023}, + month = aug, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.3c00257} +} + +@article{Damour_2023, + author = {Damour, Yann and Quintero-Monsebaiz, Ra{\'{u}}l and Caffarel, Michel and Jacquemin, Denis and Kossoski, F{\'{a}}bris and Scemama, Anthony and Loos, Pierre-Fran{\c{c}}ois}, + title = {{Ground- and Excited-State Dipole Moments and Oscillator Strengths of Full Configuration Interaction Quality}}, + journal = {J. Chem. Theory Comput.}, + volume = {19}, + number = {1}, + pages = {221--234}, + year = {2023}, + month = jan, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.2c01111} +} + +@article{Ammar_2022, + author = {Ammar, Abdallah and Scemama, Anthony and Giner, Emmanuel}, + title = {{Extension of selected configuration interaction for transcorrelated methods}}, + journal = {J. Chem. Phys.}, + volume = {157}, + number = {13}, + year = {2022}, + month = oct, + issn = {0021-9606}, + publisher = {AIP Publishing}, + doi = {10.1063/5.0115524} +} + +@article{Ammar_2022.2, + author = {Ammar, Abdallah and Giner, Emmanuel and Scemama, Anthony}, + title = {{Optimization of Large Determinant Expansions in Quantum Monte Carlo}}, + journal = {J. Chem. Theory Comput.}, + volume = {18}, + number = {9}, + pages = {5325--5336}, + year = {2022}, + month = sep, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.2c00556} +} + +@article{Monino_2022, + author = {Monino, Enzo and Boggio-Pasqua, Martial and Scemama, Anthony and Jacquemin, Denis and Loos, Pierre-Fran{\c{c}}ois}, + title = {{Reference Energies for Cyclobutadiene: Automerization and Excited States}}, + journal = {J. Phys. Chem. A}, + volume = {126}, + number = {28}, + pages = {4664--4679}, + year = {2022}, + month = jul, + issn = {1089-5639}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jpca.2c02480} +} + +@article{Cuzzocrea_2022, + author = {Cuzzocrea, Alice and Moroni, Saverio and Scemama, Anthony and Filippi, Claudia}, + title = {{Reference Excitation Energies of Increasingly Large Molecules: A QMC Study of Cyanine Dyes}}, + journal = {J. Chem. Theory Comput.}, + volume = {18}, + number = {2}, + pages = {1089--1095}, + year = {2022}, + month = feb, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.1c01162} +} + +@article{Damour_2021, + author = {Damour, Yann and V{\'{e}}ril, Micka{\"{e}}l and Kossoski, F{\'{a}}bris and Caffarel, Michel and Jacquemin, Denis and Scemama, Anthony and Loos, Pierre-Fran{\c{c}}ois}, + title = {{Accurate full configuration interaction correlation energy estimates for five- and six-membered rings}}, + journal = {J. Chem. Phys.}, + volume = {155}, + number = {13}, + year = {2021}, + month = oct, + issn = {0021-9606}, + publisher = {AIP Publishing}, + doi = {10.1063/5.0065314} +} + +@article{Veril_2021, + author = {V{\'{e}}ril, Micka{\"{e}}l and Scemama, Anthony and Caffarel, Michel and Lipparini, Filippo and Boggio-Pasqua, Martial and Jacquemin, Denis and Loos, Pierre-Fran{\c{c}}ois}, + title = {{QUESTDB: A database of highly accurate excitation energies for the electronic structure community}}, + journal = {WIREs Comput. Mol. Sci.}, + volume = {11}, + number = {5}, + pages = {e1517}, + year = {2021}, + month = sep, + issn = {1759-0876}, + publisher = {John Wiley {\&} Sons, Ltd}, + doi = {10.1002/wcms.1517} +} + +@article{Kossoski_2021, + author = {Kossoski, F{\'{a}}bris and Marie, Antoine and Scemama, Anthony and Caffarel, Michel and Loos, Pierre-Fran{\c{c}}ois}, + title = {{Excited States from State-Specific Orbital-Optimized Pair Coupled Cluster}}, + journal = {J. Chem. Theory Comput.}, + volume = {17}, + number = {8}, + pages = {4756--4768}, + year = {2021}, + month = aug, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.1c00348} +} + +@article{Dash_2021, + author = {Dash, Monika and Moroni, Saverio and Filippi, Claudia and Scemama, Anthony}, + title = {{Tailoring CIPSI Expansions for QMC Calculations of Electronic Excitations: The Case Study of Thiophene}}, + journal = {J. Chem. Theory Comput.}, + volume = {17}, + number = {6}, + pages = {3426--3434}, + year = {2021}, + month = jun, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.1c00212} +} + +@article{Loos_2020, + author = {Loos, Pierre-Fran{\c{c}}ois and Lipparini, Filippo and Boggio-Pasqua, Martial and Scemama, Anthony and Jacquemin, Denis}, + title = {{A Mountaineering Strategy to Excited States: Highly Accurate Energies and Benchmarks for Medium Sized Molecules}}, + journal = {J. Chem. Theory Comput.}, + volume = {16}, + number = {3}, + pages = {1711--1741}, + year = {2020}, + month = mar, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.9b01216} +} + +@article{Loos_2020.2, + author = {Loos, Pierre-Fran{\c{c}}ois and Pradines, Barth{\'{e}}l{\'{e}}my and Scemama, Anthony and Giner, Emmanuel and Toulouse, Julien}, + title = {{Density-Based Basis-Set Incompleteness Correction for GW Methods}}, + journal = {J. Chem. Theory Comput.}, + volume = {16}, + number = {2}, + pages = {1018--1028}, + year = {2020}, + month = feb, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.9b01067} +} + +@article{Loos_2020.3, + author = {Loos, Pierre-Fran{\c{c}}ois and Scemama, Anthony and Jacquemin, Denis}, + title = {{The Quest for Highly Accurate Excitation Energies: A Computational Perspective}}, + journal = {J. Phys. Chem. Lett.}, + volume = {11}, + number = {6}, + pages = {2374--2383}, + year = {2020}, + month = mar, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jpclett.0c00014} +} + +@article{Giner_2020, + author = {Giner, Emmanuel and Scemama, Anthony and Loos, Pierre-Fran{\c{c}}ois and Toulouse, Julien}, + title = {{A basis-set error correction based on density-functional theory for strongly correlated molecular systems}}, + journal = {J. Chem. Phys.}, + volume = {152}, + number = {17}, + year = {2020}, + month = may, + issn = {0021-9606}, + publisher = {AIP Publishing}, + doi = {10.1063/5.0002892} +} + +@article{Loos_2020.4, + author = {Loos, Pierre-Fran{\c{c}}ois and Scemama, Anthony and Boggio-Pasqua, Martial and Jacquemin, Denis}, + title = {{Mountaineering Strategy to Excited States: Highly Accurate Energies and Benchmarks for Exotic Molecules and Radicals}}, + journal = {J. Chem. Theory Comput.}, + volume = {16}, + number = {6}, + pages = {3720--3736}, + year = {2020}, + month = jun, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.0c00227} +} + +@article{Benali_2020, + author = {Benali, Anouar and Gasperich, Kevin and Jordan, Kenneth D. and Applencourt, Thomas and Luo, Ye and Bennett, M. Chandler and Krogel, Jaron T. and Shulenburger, Luke and Kent, Paul R. C. and Loos, Pierre-Fran{\c{c}}ois and Scemama, Anthony and Caffarel, Michel}, + title = {{Toward a systematic improvement of the fixed-node approximation in diffusion Monte Carlo for solids{\textemdash}A case study in diamond}}, + journal = {J. Chem. Phys.}, + volume = {153}, + number = {18}, + year = {2020}, + month = nov, + issn = {0021-9606}, + publisher = {AIP Publishing}, + doi = {10.1063/5.0021036} +} + +@article{Scemama_2020, + author = {Scemama, Anthony and Giner, Emmanuel and Benali, Anouar and Loos, Pierre-Fran{\c{c}}ois}, + title = {{Taming the fixed-node error in diffusion Monte Carlo via range separation}}, + journal = {J. Chem. Phys.}, + volume = {153}, + number = {17}, + year = {2020}, + month = nov, + issn = {0021-9606}, + publisher = {AIP Publishing}, + doi = {10.1063/5.0026324} +} + +@article{Loos_2020.5, + author = {Loos, Pierre-Fran{\c{c}}ois and Damour, Yann and Scemama, Anthony}, + title = {{The performance of CIPSI on the ground state electronic energy of benzene}}, + journal = {J. Chem. Phys.}, + volume = {153}, + number = {17}, + year = {2020}, + month = nov, + issn = {0021-9606}, + publisher = {AIP Publishing}, + doi = {10.1063/5.0027617} +} + +@article{Loos_2019, + author = {Loos, Pierre-Fran{\c{c}}ois and Pradines, Barth{\'{e}}l{\'{e}}my and Scemama, Anthony and Toulouse, Julien and Giner, Emmanuel}, + title = {{A Density-Based Basis-Set Correction for Wave Function Theory}}, + journal = {J. Phys. Chem. Lett.}, + volume = {10}, + number = {11}, + pages = {2931--2937}, + year = {2019}, + month = jun, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jpclett.9b01176} +} + +@article{Dash_2019, + author = {Dash, Monika and Feldt, Jonas and Moroni, Saverio and Scemama, Anthony and Filippi, Claudia}, + title = {{Excited States with Selected Configuration Interaction-Quantum Monte Carlo: Chemically Accurate Excitation Energies and Geometries}}, + journal = {J. Chem. Theory Comput.}, + volume = {15}, + number = {9}, + pages = {4896--4906}, + year = {2019}, + month = sep, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.9b00476} +} + +@article{Burton2019May, + author = {Burton, Hugh G. A. and Thom, Alex J. W.}, + title = {{A General Approach for Multireference Ground and Excited States using Non-Orthogonal Configuration Interaction}}, + journal = {arXiv}, + year = {2019}, + month = {May}, + eprint = {1905.02626}, + url = {https://arxiv.org/abs/1905.02626} +} + + +@article{Giner_2019, + author = {Giner, Emmanuel and Scemama, Anthony and Toulouse, Julien and Loos, Pierre-Fran{\c{c}}ois}, + title = {{Chemically accurate excitation energies with small basis sets}}, + journal = {J. Chem. Phys.}, + volume = {151}, + number = {14}, + year = {2019}, + month = oct, + issn = {0021-9606}, + publisher = {AIP Publishing}, + doi = {10.1063/1.5122976} +} + + + +@article{Garniron_2019, + doi = {10.1021/acs.jctc.9b00176}, + url = {https://doi.org/10.1021%2Facs.jctc.9b00176}, + year = 2019, + month = {may}, + publisher = {American Chemical Society ({ACS})}, + author = {Yann Garniron and Thomas Applencourt and Kevin Gasperich and Anouar Benali and Anthony Ferte and Julien Paquier and Bartélémy Pradines and Roland Assaraf and Peter Reinhardt and Julien Toulouse and Pierrette Barbaresco and Nicolas Renon and Gregoire David and Jean-Paul Malrieu and Mickael Veril and Michel Caffarel and Pierre-Francois Loos and Emmanuel Giner and Anthony Scemama}, + title = {Quantum Package 2.0: An Open-Source Determinant-Driven Suite of Programs}, + journal = {Journal of Chemical Theory and Computation} +} + +@article{Scemama_2019, + doi = {10.1016/j.rechem.2019.100002}, + url = {https://doi.org/10.1016%2Fj.rechem.2019.100002}, + year = 2019, + month = {may}, + publisher = {Elsevier {BV}}, + pages = {100002}, + author = {Anthony Scemama and Michel Caffarel and Anouar Benali and Denis Jacquemin and Pierre-Fran{\c{c}}ois Loos}, + title = {Influence of pseudopotentials on excitation energies from selected configuration interaction and diffusion Monte Carlo}, + journal = {Results in Chemistry} +} + + +@article{Applencourt2018Dec, + author = {Applencourt, Thomas and Gasperich, Kevin and Scemama, Anthony}, + title = {{Spin adaptation with determinant-based selected configuration interaction}}, + journal = {arXiv}, + year = {2018}, + month = {Dec}, + eprint = {1812.06902}, + url = {https://arxiv.org/abs/1812.06902} +} + +@article{Loos2019Mar, + author = {Loos, Pierre-Fran\c{c}ois and Boggio-Pasqua, Martial and Scemama, Anthony and Caffarel, Michel and Jacquemin, Denis}, + title = {{Reference Energies for Double Excitations}}, + journal = {J. Chem. Theory Comput.}, + volume = {15}, + number = {3}, + pages = {1939--1956}, + year = {2019}, + month = {Mar}, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.8b01205} +} + +@article{PinedaFlores2019Feb, + author = {Pineda Flores, Sergio and Neuscamman, Eric}, + title = {{Excited State Specific Multi-Slater Jastrow Wave Functions}}, + journal = {J. Phys. Chem. A}, + volume = {123}, + number = {8}, + pages = {1487--1497}, + year = {2019}, + month = {Feb}, + issn = {1089-5639}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jpca.8b10671} +} + +@phdthesis{yann_garniron_2019_2558127, + author = {Yann Garniron}, + title = {{Development and parallel implementation of + selected configuration interaction methods}}, + school = {Université de Toulouse}, + year = 2019, + month = feb, + doi = {10.5281/zenodo.2558127}, + url = {https://doi.org/10.5281/zenodo.2558127} +} + +@article{Giner_2018, + doi = {10.1063/1.5052714}, + url = {https://doi.org/10.1063%2F1.5052714}, + year = 2018, + month = {nov}, + publisher = {{AIP} Publishing}, + volume = {149}, + number = {19}, + pages = {194301}, + author = {Emmanuel Giner and Barth{\'{e}}lemy Pradines and Anthony Fert{\'{e}} and Roland Assaraf and Andreas Savin and Julien Toulouse}, + title = {Curing basis-set convergence of wave-function theory using density-functional theory: A systematically improvable approach}, + journal = {The Journal of Chemical Physics} +} + + +@article{Giner2018Oct, + author = {Giner, Emmanuel and Tew, David and Garniron, Yann and Alavi, Ali}, + title = {{Interplay between electronic correlation and metal-ligand delocalization in the spectroscopy of transition metal compounds: case study on a series of planar Cu2+complexes.}}, + journal = {J. Chem. Theory Comput.}, + year = {2018}, + month = {Oct}, + issn = {1549-9618}, + publisher = {American Chemical Society}, + doi = {10.1021/acs.jctc.8b00591} +} + +@article{Loos_2018, + doi = {10.1021/acs.jctc.8b00406}, + url = {https://doi.org/10.1021%2Facs.jctc.8b00406}, + year = 2018, + month = {jul}, + publisher = {American Chemical Society ({ACS})}, + volume = {14}, + number = {8}, + pages = {4360--4379}, + author = {Pierre-Fran{\c{c}}ois Loos and Anthony Scemama and Aymeric Blondel and Yann Garniron and Michel Caffarel and Denis Jacquemin}, + title = {A Mountaineering Strategy to Excited States: Highly Accurate Reference Energies and Benchmarks}, + journal = {Journal of Chemical Theory and Computation} +} +@article{Scemama_2018, + doi = {10.1021/acs.jctc.7b01250}, + url = {https://doi.org/10.1021%2Facs.jctc.7b01250}, + year = 2018, + month = {jan}, + publisher = {American Chemical Society ({ACS})}, + volume = {14}, + number = {3}, + pages = {1395--1402}, + author = {Anthony Scemama and Yann Garniron and Michel Caffarel and Pierre-Fran{\c{c}}ois Loos}, + title = {Deterministic Construction of Nodal Surfaces within Quantum Monte Carlo: The Case of {FeS}}, + journal = {Journal of Chemical Theory and Computation} +} +@article{Scemama_2018.2, + doi = {10.1063/1.5041327}, + url = {https://doi.org/10.1063%2F1.5041327}, + year = 2018, + month = {jul}, + publisher = {{AIP} Publishing}, + volume = {149}, + number = {3}, + pages = {034108}, + author = {Anthony Scemama and Anouar Benali and Denis Jacquemin and Michel Caffarel and Pierre-Fran{\c{c}}ois Loos}, + title = {Excitation energies from diffusion Monte Carlo using selected configuration interaction nodes}, + journal = {The Journal of Chemical Physics} +} +@article{Dash_2018, + doi = {10.1021/acs.jctc.8b00393}, + url = {https://doi.org/10.1021%2Facs.jctc.8b00393}, + year = 2018, + month = {jun}, + publisher = {American Chemical Society ({ACS})}, + volume = {14}, + number = {8}, + pages = {4176--4182}, + author = {Monika Dash and Saverio Moroni and Anthony Scemama and Claudia Filippi}, + title = {Perturbatively Selected Configuration-Interaction Wave Functions for Efficient Geometry Optimization in Quantum Monte Carlo}, + journal = {Journal of Chemical Theory and Computation} +} +@article{Garniron_2018, + doi = {10.1063/1.5044503}, + url = {https://doi.org/10.1063%2F1.5044503}, + year = 2018, + month = {aug}, + publisher = {{AIP} Publishing}, + volume = {149}, + number = {6}, + pages = {064103}, + author = {Yann Garniron and Anthony Scemama and Emmanuel Giner and Michel Caffarel and Pierre-Fran{\c{c}}ois Loos}, + title = {Selected configuration interaction dressed by perturbation}, + journal = {The Journal of Chemical Physics} +} +@article{Giner_2017, + doi = {10.1063/1.4984616}, + url = {https://doi.org/10.1063%2F1.4984616}, + year = 2017, + month = {jun}, + publisher = {{AIP} Publishing}, + volume = {146}, + number = {22}, + pages = {224108}, + author = {Emmanuel Giner and Celestino Angeli and Yann Garniron and Anthony Scemama and Jean-Paul Malrieu}, + title = {A Jeziorski-Monkhorst fully uncontracted multi-reference perturbative treatment. I. Principles, second-order versions, and tests on ground state potential energy curves}, + journal = {The Journal of Chemical Physics} +} +@article{Garniron_2017, + doi = {10.1063/1.4980034}, + url = {https://doi.org/10.1063%2F1.4980034}, + year = 2017, + month = {apr}, + publisher = {{AIP} Publishing}, + volume = {146}, + number = {15}, + pages = {154107}, + author = {Yann Garniron and Emmanuel Giner and Jean-Paul Malrieu and Anthony Scemama}, + title = {Alternative definition of excitation amplitudes in multi-reference state-specific coupled cluster}, + journal = {The Journal of Chemical Physics} +} +@article{Garniron_2017.2, + doi = {10.1063/1.4992127}, + url = {https://doi.org/10.1063%2F1.4992127}, + year = 2017, + month = {jul}, + publisher = {{AIP} Publishing}, + volume = {147}, + number = {3}, + pages = {034101}, + author = {Yann Garniron and Anthony Scemama and Pierre-Fran{\c{c}}ois Loos and Michel Caffarel}, + title = {Hybrid stochastic-deterministic calculation of the second-order perturbative contribution of multireference perturbation theory}, + journal = {The Journal of Chemical Physics} +} +@article{Giner_2017.2, + doi = {10.1016/j.comptc.2017.03.001}, + url = {https://doi.org/10.1016%2Fj.comptc.2017.03.001}, + year = 2017, + month = {sep}, + publisher = {Elsevier {BV}}, + volume = {1116}, + pages = {134--140}, + author = {E. Giner and C. Angeli and A. Scemama and J.-P. Malrieu}, + title = {Orthogonal Valence Bond Hamiltonians incorporating dynamical correlation effects}, + journal = {Computational and Theoretical Chemistry} +} + +@article{Giner_2017.3, + author = {Giner, Emmanuel and Tenti, Lorenzo and Angeli, Celestino and Ferré, Nicolas}, + title = {Computation of the Isotropic Hyperfine Coupling Constant: Efficiency and Insights from a New Approach Based on Wave Function Theory}, + journal = {Journal of Chemical Theory and Computation}, + volume = {13}, + number = {2}, + pages = {475-487}, + year = {2017}, + doi = {10.1021/acs.jctc.6b00827}, + note ={PMID: 28094936}, + URL = {https://doi.org/10.1021/acs.jctc.6b00827}, + eprint = {https://doi.org/10.1021/acs.jctc.6b00827} +} + +@article{Giner2016Mar, + author = {Giner, Emmanuel and Angeli, Celestino}, + title = {{Spin density and orbital optimization in open shell systems: A rational and computationally efficient proposal}}, + journal = {J. Chem. Phys.}, + volume = {144}, + number = {10}, + pages = {104104}, + year = {2016}, + month = {Mar}, + issn = {0021-9606}, + publisher = {American Institute of Physics}, + doi = {10.1063/1.4943187} +} +@article{Giner_2016, + doi = {10.1063/1.4940781}, + url = {https://doi.org/10.1063%2F1.4940781}, + year = 2016, + month = {feb}, + publisher = {{AIP} Publishing}, + volume = {144}, + number = {6}, + pages = {064101}, + author = {E. Giner and G. David and A. Scemama and J. P. Malrieu}, + title = {A simple approach to the state-specific {MR}-{CC} using the intermediate Hamiltonian formalism}, + journal = {The Journal of Chemical Physics} +} + +@article{Caffarel_2016, + doi = {10.1063/1.4947093}, + url = {https://doi.org/10.1063%2F1.4947093}, + year = 2016, + month = {apr}, + publisher = {{AIP} Publishing}, + volume = {144}, + number = {15}, + pages = {151103}, + author = {Michel Caffarel and Thomas Applencourt and Emmanuel Giner and Anthony Scemama}, + title = {Communication: Toward an improved control of the fixed-node error in quantum Monte Carlo: The case of the water molecule}, + journal = {The Journal of Chemical Physics} +} +@incollection{Caffarel_2016.2, + doi = {10.1021/bk-2016-1234.ch002}, + url = {https://doi.org/10.1021%2Fbk-2016-1234.ch002}, + year = 2016, + month = {jan}, + publisher = {American Chemical Society}, + pages = {15--46}, + author = {Michel Caffarel and Thomas Applencourt and Emmanuel Giner and Anthony Scemama}, + title = {Using CIPSI Nodes in Diffusion Monte Carlo}, + booktitle = {{ACS} Symposium Series} +} +@article{Giner_2015, + doi = {10.1063/1.4905528}, + url = {https://doi.org/10.1063%2F1.4905528}, + year = 2015, + month = {jan}, + publisher = {{AIP} Publishing}, + volume = {142}, + number = {4}, + pages = {044115}, + author = {Emmanuel Giner and Anthony Scemama and Michel Caffarel}, + title = {Fixed-node diffusion Monte Carlo potential energy curve of the fluorine molecule F2 using selected configuration interaction trial wavefunctions}, + journal = {The Journal of Chemical Physics} +} + +@article{Giner2015Sep, + author = {Giner, Emmanuel and Angeli, Celestino}, + title = {{Metal-ligand delocalization and spin density in the CuCl2 and [CuCl4]2{-} molecules: Some insights from wave function theory}}, + journal = {J. Chem. Phys.}, + volume = {143}, + number = {12}, + pages = {124305}, + year = {2015}, + month = {Sep}, + issn = {0021-9606}, + publisher = {American Institute of Physics}, + doi = {10.1063/1.4931639} +} + +@article{Scemama_2014, + doi = {10.1063/1.4903985}, + url = {https://doi.org/10.1063%2F1.4903985}, + year = 2014, + month = {dec}, + publisher = {{AIP} Publishing}, + volume = {141}, + number = {24}, + pages = {244110}, + author = {A. Scemama and T. Applencourt and E. Giner and M. Caffarel}, + title = {Accurate nonrelativistic ground-state energies of 3d transition metal atoms}, + journal = {The Journal of Chemical Physics} +} +@article{Caffarel_2014, + doi = {10.1021/ct5004252}, + url = {https://doi.org/10.1021%2Fct5004252}, + year = 2014, + month = {nov}, + publisher = {American Chemical Society ({ACS})}, + volume = {10}, + number = {12}, + pages = {5286--5296}, + author = {Michel Caffarel and Emmanuel Giner and Anthony Scemama and Alejandro Ram{\'{\i}}rez-Sol{\'{\i}}s}, + title = {Spin Density Distribution in Open-Shell Transition Metal Systems: A Comparative Post-Hartree-Fock, Density Functional Theory, and Quantum Monte Carlo Study of the CuCl2 Molecule}, + journal = {Journal of Chemical Theory and Computation} +} +@article{Giner_2013, + doi = {10.1139/cjc-2013-0017}, + url = {https://doi.org/10.1139%2Fcjc-2013-0017}, + year = 2013, + month = {sep}, + publisher = {Canadian Science Publishing}, + volume = {91}, + number = {9}, + pages = {879--885}, + author = {Emmanuel Giner and Anthony Scemama and Michel Caffarel}, + title = {Using perturbatively selected configuration interaction in quantum Monte Carlo calculations}, + journal = {Canadian Journal of Chemistry} +} + +@article{Scemama2013Nov, + author = {Scemama, Anthony and Giner, Emmanuel}, + title = {{An efficient implementation of Slater-Condon rules}}, + journal = {arXiv}, + year = {2013}, + month = {Nov}, + eprint = {1311.6244}, + url = {https://arxiv.org/abs/1311.6244} +} + + + +@article{Bytautas_2009, + doi = {10.1016/j.chemphys.2008.11.021}, + url = {https://doi.org/10.1016%2Fj.chemphys.2008.11.021}, + year = 2009, + month = {feb}, + publisher = {Elsevier {BV}}, + volume = {356}, + number = {1-3}, + pages = {64--75}, + author = {Laimutis Bytautas and Klaus Ruedenberg}, + title = {A priori identification of configurational deadwood}, + journal = {Chemical Physics} +} + +@article{Anderson_2018, + doi = {10.1016/j.comptc.2018.08.017}, + url = {https://doi.org/10.1016%2Fj.comptc.2018.08.017}, + year = 2018, + month = {oct}, + publisher = {Elsevier {BV}}, + volume = {1142}, + pages = {66--77}, + author = {James S.M. Anderson and Farnaz Heidar-Zadeh and Paul W. Ayers}, + title = {Breaking the curse of dimension for the electronic Schrodinger equation with functional analysis}, + journal = {Computational and Theoretical Chemistry} +} + +@article{Bender_1969, + doi = {10.1103/physrev.183.23}, + url = {http://dx.doi.org/10.1103/PhysRev.183.23}, + year = 1969, + month = {jul}, + publisher = {American Physical Society ({APS})}, + volume = {183}, + number = {1}, + pages = {23--30}, + author = {Charles F. Bender and Ernest R. Davidson}, + title = {Studies in Configuration Interaction: The First-Row Diatomic Hydrides}, + journal = {Phys. Rev.} +} + +@article{Whitten_1969, + doi = {10.1063/1.1671985}, + url = {https://doi.org/10.1063%2F1.1671985}, + year = 1969, + month = {dec}, + publisher = {{AIP} Publishing}, + volume = {51}, + number = {12}, + pages = {5584--5596}, + author = {J. L. Whitten and Melvyn Hackmeyer}, + title = {Configuration Interaction Studies of Ground and Excited States of Polyatomic Molecules. I. The {CI} Formulation and Studies of Formaldehyde}, + journal = {The Journal of Chemical Physics} +} + +@article{Huron_1973, + doi = {10.1063/1.1679199}, + url = {https://doi.org/10.1063%2F1.1679199}, + year = 1973, + month = {jun}, + publisher = {{AIP} Publishing}, + volume = {58}, + number = {12}, + pages = {5745--5759}, + author = {B. Huron and J. P. Malrieu and P. Rancurel}, + title = {Iterative perturbation calculations of ground and excited state energies from multiconfigurational zeroth-order wavefunctions}, + journal = {The Journal of Chemical Physics} +} + +@article{Knowles_1984, + author="Peter J. Knowles and Nicholas C Handy", + year=1984, + journal={Chem. Phys. Letters}, + volume=111, + pages="315--321", + title="A New Determinant-based Full Configuration Interaction Method" +} + + +@article{Sharma_2017, + doi = {10.1021/acs.jctc.6b01028}, + url = {https://doi.org/10.1021%2Facs.jctc.6b01028}, + year = 2017, + month = {mar}, + publisher = {American Chemical Society ({ACS})}, + volume = {13}, + number = {4}, + pages = {1595--1604}, + author = {Sandeep Sharma and Adam A. Holmes and Guillaume Jeanmairet and Ali Alavi and C. J. Umrigar}, + title = {Semistochastic Heat-Bath Configuration Interaction Method: Selected Configuration Interaction with Semistochastic Perturbation Theory}, + journal = {Journal of Chemical Theory and Computation} +} + +@article{Holmes_2016, + doi = {10.1021/acs.jctc.6b00407}, + url = {https://doi.org/10.1021%2Facs.jctc.6b00407}, + year = 2016, + month = {aug}, + publisher = {American Chemical Society ({ACS})}, + volume = {12}, + number = {8}, + pages = {3674--3680}, + author = {Adam A. Holmes and Norm M. Tubman and C. J. Umrigar}, + title = {Heat-Bath Configuration Interaction: An Efficient Selected Configuration Interaction Algorithm Inspired by Heat-Bath Sampling}, + journal = {Journal of Chemical Theory and Computation} +} +@article{Evangelisti_1983, + doi = {10.1016/0301-0104(83)85011-3}, + url = {https://doi.org/10.1016%2F0301-0104%2883%2985011-3}, + year = 1983, + month = {feb}, + publisher = {Elsevier {BV}}, + volume = {75}, + number = {1}, + pages = {91--102}, + author = {Stefano Evangelisti and Jean-Pierre Daudey and Jean-Paul Malrieu}, + title = {Convergence of an improved {CIPSI} algorithm}, + journal = {Chemical Physics} +} +@article{Booth_2009, + doi = {10.1063/1.3193710}, + url = {https://doi.org/10.1063%2F1.3193710}, + year = 2009, + publisher = {{AIP} Publishing}, + volume = {131}, + number = {5}, + pages = {054106}, + author = {George H. Booth and Alex J. W. Thom and Ali Alavi}, + title = {Fermion Monte Carlo without fixed nodes: A game of life, death, and annihilation in Slater determinant space}, + journal = {The Journal of Chemical Physics} +} +@article{Booth_2010, + doi = {10.1063/1.3407895}, + url = {https://doi.org/10.1063%2F1.3407895}, + year = 2010, + month = {may}, + publisher = {{AIP} Publishing}, + volume = {132}, + number = {17}, + pages = {174104}, + author = {George H. Booth and Ali Alavi}, + title = {Approaching chemical accuracy using full configuration-interaction quantum Monte Carlo: A study of ionization potentials}, + journal = {The Journal of Chemical Physics} +} +@article{Cleland_2010, + doi = {10.1063/1.3302277}, + url = {https://doi.org/10.1063%2F1.3302277}, + year = 2010, + month = {jan}, + publisher = {{AIP} Publishing}, + volume = {132}, + number = {4}, + pages = {041103}, + author = {Deidre Cleland and George H. Booth and Ali Alavi}, + title = {Communications: Survival of the fittest: Accelerating convergence in full configuration-interaction quantum Monte Carlo}, + journal = {The Journal of Chemical Physics} +} + +@article{Garniron_2017b, + doi = {10.1063/1.4992127}, + url = {https://doi.org/10.1063%2F1.4992127}, + year = 2017, + month = {jul}, + publisher = {{AIP} Publishing}, + volume = {147}, + number = {3}, + pages = {034101}, + author = {Yann Garniron and Anthony Scemama and Pierre-Fran{\c{c}}ois Loos and Michel Caffarel}, + title = {Hybrid stochastic-deterministic calculation of the second-order perturbative contribution of multireference perturbation theory}, + journal = {The Journal of Chemical Physics} +} + + + diff --git a/external/irpf90 b/external/irpf90 index 4ab1b175..ba1a2837 160000 --- a/external/irpf90 +++ b/external/irpf90 @@ -1 +1 @@ -Subproject commit 4ab1b175fc7ed0d96c1912f13dc53579b24157a6 +Subproject commit ba1a2837aa61cb8f9892860cec544d7c6659badd diff --git a/src/cipsi/README.rst b/src/cipsi/README.rst index 054f938f..7385de5b 100644 --- a/src/cipsi/README.rst +++ b/src/cipsi/README.rst @@ -15,18 +15,18 @@ The :c:func:`run_cipsi` subroutine iteratively: * If :option:`determinants s2_eig` is |true|, it adds all the necessary determinants to allow the eigenstates of |H| to be eigenstates of |S^2| * Diagonalizes |H| in the enlarged internal space -* Computes the |PT2| contribution to the energy stochastically :cite:`Garniron_2017.2` +* Computes the |PT2| contribution to the energy stochastically :cite:`Garniron_2017b` or deterministically, depending on :option:`perturbation do_pt2` * Extrapolates the variational energy by fitting :math:`E=E_\text{FCI} - \alpha\, E_\text{PT2}` The difference between :c:func:`run_stochastic_cipsi` and :c:func:`run_cipsi` is that :c:func:`run_stochastic_cipsi` selects the determinants on the fly with the computation -of the stochastic |PT2| :cite:`Garniron_2017.2`. Hence, it is a semi-stochastic selection. It +of the stochastic |PT2| :cite:`Garniron_2017b`. Hence, it is a semi-stochastic selection. It * Selects the most important determinants from the external space and adds them to the internal space, on the fly with the computation of the PT2 with the stochastic algorithm - presented in :cite:`Garniron_2017.2`. + presented in :cite:`Garniron_2017b`. * If :option:`determinants s2_eig` is |true|, it adds all the necessary determinants to allow the eigenstates of |H| to be eigenstates of |S^2| * Extrapolates the variational energy by fitting diff --git a/src/cipsi_utils/pt2_stoch_routines.irp.f b/src/cipsi_utils/pt2_stoch_routines.irp.f index f067d0be..c33dcfe7 100644 --- a/src/cipsi_utils/pt2_stoch_routines.irp.f +++ b/src/cipsi_utils/pt2_stoch_routines.irp.f @@ -117,6 +117,9 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) use selection_types implicit none + BEGIN_DOC +! Computes the PT2 energy using ZMQ + END_DOC integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull integer, intent(in) :: N_in diff --git a/src/cipsi_utils/zmq_selection.irp.f b/src/cipsi_utils/zmq_selection.irp.f index 1bfe87c0..5c2f8fc8 100644 --- a/src/cipsi_utils/zmq_selection.irp.f +++ b/src/cipsi_utils/zmq_selection.irp.f @@ -3,6 +3,9 @@ subroutine ZMQ_selection(N_in, pt2_data) use selection_types implicit none + BEGIN_DOC +! Performs the determinant selection using ZeroMQ + END_DOC integer(ZMQ_PTR) :: zmq_to_qp_run_socket , zmq_socket_pull integer, intent(in) :: N_in diff --git a/src/trexio/import_trexio_determinants.irp.f b/src/trexio/import_trexio_determinants.irp.f index 1759bb94..7be576c6 100644 --- a/src/trexio/import_trexio_determinants.irp.f +++ b/src/trexio/import_trexio_determinants.irp.f @@ -1,4 +1,4 @@ -program import_determinants_ao +program import_trexio_determinants call run end From c63b69e8dac8017d6415df602c5f7f5c02e35a2a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 20 Mar 2024 16:12:34 +0100 Subject: [PATCH 34/64] Fixing ReadtheDocs --- docs/requirements.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/requirements.txt b/docs/requirements.txt index b73f3706..135f6044 100644 --- a/docs/requirements.txt +++ b/docs/requirements.txt @@ -1,2 +1,2 @@ -sphinxcontrib-bibtex==0.4.0 -sphinx-rtd-theme==0.4.2 +sphinxcontrib-bibtex +sphinx-rtd-theme From 1fd93d76b6ad7d7733834bae2da0b9dbbea8d49f Mon Sep 17 00:00:00 2001 From: eginer Date: Thu, 21 Mar 2024 15:31:06 +0100 Subject: [PATCH 35/64] working on the tuto --- plugins/README.rst | 76 +++++++++++++++ plugins/tuto_plugins/n2.xyz | 4 + .../tuto_plugins/tuto_I/print_one_e_h.irp.f | 20 ++++ plugins/tuto_plugins/tuto_I/tuto_I.rst | 97 +++++++++++++++++++ 4 files changed, 197 insertions(+) create mode 100644 plugins/README.rst create mode 100644 plugins/tuto_plugins/n2.xyz create mode 100644 plugins/tuto_plugins/tuto_I/print_one_e_h.irp.f create mode 100644 plugins/tuto_plugins/tuto_I/tuto_I.rst diff --git a/plugins/README.rst b/plugins/README.rst new file mode 100644 index 00000000..7f3f3c75 --- /dev/null +++ b/plugins/README.rst @@ -0,0 +1,76 @@ +============================== +Tutorial for creating a plugin +============================== + +Introduction: what is a plugin, and what this tuto will be about ? +============================================================ +The QP is split into two kinds of routines/global variables (i.e. providers): + i) the core modules locatedin qp2/src/, which contains all the bulk of a quantum chemistry software (integrals, matrix elements between Slater determinants, linear algebra routines, DFT stuffs etc..) + ii) the plugins which are external stuffs connected to the qp2/src/ stuffs. + +More precisely, a plugin of the QP is a directory where you can create routines, +providers and executables that use all the global variables/functions/routines already created +in the modules ofqp2/src or in other plugins. + +Instead of giving a theoretical lecture on what is a plugin, +we will go through a series of examples that allow you to do the following thing: + I) print out one- and two-electron integrals on the AO/MO basis, + creates two providers which manipulate these objects, + print out these providers, + II) browse the Slater determinants stored in the EZFIO wave function and compute their matrix elements, + III) build the Hamiltonian matrix and diagonalize it either with Lapck or Davidson, + IV) print out the one- and two-electron rdms, + V) obtain the AOs and MOs on the DFT grid, together with the density, + +This tuto is as follows: + i) you READ THIS FILE UNTIL THE END in order to get the big picture and vocabulary, + ii) you go to the directory qp2/plugins/tuto_plugins/ and you will find detailed tuto there for each of the 5 examples. + +Creating a plugin: the basic +---------------------------- +The first thing to do is to be in the QPSH mode: you execute the qp2/bin/qpsh script that essentially loads all +the environement variables and allows for the completion of command lines in bash (that is an AMAZING feature :) + +Then, you need to known where you want to create your plugin, and what is the name of the plugin. +!!!! WARINING: The plugins are NECESSARILY located in qp2/plugins/ !!!! +Ex: If you want to create a plugin named "my_fancy_plugin" in the directory plugins/plugins_test/, +this goes with the command +qp plugins create -n my_fancy_plugin -r plugins_test/ + +Then, to create plugin of your dreams, the two questions you need to answer are the following: +a) What do I need to compute what I want, which means what are the objects that I need ? + There are two kind of objects: + + the routines/functions + Ex: Linear algebra routines, integration routines etc ... + + the global variables which are called the PROVIDERS + Ex: one-electron integrals, Slater determinants, density matrices etc ... +b) Where do I find these objects ? + The objects (routines/functions/providers) are necessarily created in other modules/plugins + Ex: the routine "lapack_diagd" (which diagonalises a real hermitian matrix) is located in the file + qp2/src/utils/linear_algebra.irp.f + therefore it "belongs" to the module "utils" + : the routine "ao_to_mo" (which converts a given matrix A from the AO basis to the MO basis) is located in the file + qp2/src/mo_one_e_ints/ao_to_mo.irp.f + therefore it "belongs" to the module "mo_one_e_ints" + : the provider "ao_one_e_integrals" (which is the integrals of one-body part of H on the AO basis) is located in the file + qp2/src/mo_one_e_ints/ao_to_mo.irp.f + therefore it belongs to the module "mo_one_e_ints" + : the provider "one_e_dm_mo_beta_average" (which is the state average beta density matrix on the MO basis) is located in the file + qp2/src/determinants/density_matrix.irp.f + therefore it belongs to the module "determinants" + +To import all the variables that you need, you just need to write the name of the plugins in the file "NEED" +Ex: to import all the variables/routines of the module "utils", "determinants" and "mo_one_e_ints" you will have the following NEED file: +utils +determinants +mo_one_e_ints + +TIPS +---- +There are many many routines/providers in the core modules of QP. Nevertheless, as everything is coded with the IRPF90, you can use the following amazing tools: irpman +irpman can be used in command line in bash to obtain all the info on a routine or variable ! +Ex: execute the following command line : +irpman ao_one_e_integrals +Then it appears all the information you want on ao_one_e_integrals, including where it is created, the type, dimension if it is an array, what providers it needs to be built, and what providers need this provider. + + diff --git a/plugins/tuto_plugins/n2.xyz b/plugins/tuto_plugins/n2.xyz new file mode 100644 index 00000000..016732d8 --- /dev/null +++ b/plugins/tuto_plugins/n2.xyz @@ -0,0 +1,4 @@ +2 +N2 Geo: Experiment Mult: 1 symmetry: 14 +N 0.0 0.0 0.5488 +N 0.0 0.0 -0.5488 diff --git a/plugins/tuto_plugins/tuto_I/print_one_e_h.irp.f b/plugins/tuto_plugins/tuto_I/print_one_e_h.irp.f new file mode 100644 index 00000000..5d8dc1e7 --- /dev/null +++ b/plugins/tuto_plugins/tuto_I/print_one_e_h.irp.f @@ -0,0 +1,20 @@ +program my_program_to_print_stuffs + implicit none + BEGIN_DOC +! TODO : Put the documentation of the program here + END_DOC + integer :: i,j + print*,'AO integrals ' + do i = 1, ao_num + do j = 1, ao_num + print*,j,i,ao_one_e_integrals(j,i) + enddo + enddo + + print*,'MO integrals ' + do i = 1, mo_num + do j = 1, mo_num + print*,j,i,mo_one_e_integrals(j,i) + enddo + enddo +end diff --git a/plugins/tuto_plugins/tuto_I/tuto_I.rst b/plugins/tuto_plugins/tuto_I/tuto_I.rst new file mode 100644 index 00000000..05db8635 --- /dev/null +++ b/plugins/tuto_plugins/tuto_I/tuto_I.rst @@ -0,0 +1,97 @@ +====================================== +Tutorial for plugin I: One-e integrals +====================================== + +!!! Requirements: + a) you know how to create an EZFIO file and run calculations with QP + (check the tuto: ``), + b) you have an EZFIO file in the sto-3g from the file H2.xyz in plugins/tuto_plugins, + and you have run an HF calculation giving an energy of -1.116759 a.u., + c) you made an qp set_file YOUR_EZFIO_FILE_FOR_H2 in order to be, + d) you have READ the ../README.rst file to HAVE THE VOCABULARY. + +Our goals: +---------- +We want to create a plugin to do the following things: + a) print out one- and two-electron integrals on the AO/MO basis, + b) creates two providers which manipulate these objects, + c) print out these providers, + +I) Starting: creating the plugin +-------------------------------- +We will go step-by-step through these plugins. + +The name of the plugin will be "plugin_I", and its location is in "tuto_plugins". +Therefore to create the plugin, we do + +$ qp plugins create -n plugin_I -r tuto_plugins +Then to an "ls" in qp2/plugins/tuto_plugins/ +and you will find a directory called "plugin_I". +In that directory you will find: + i) a "NEED" file that will eventually contain all the other modules/plugins needed by our "plugin_I" + ii) a "README.rst" file that you can AND SHOULD modify in order to document what is doing the plugin. + iii) a "plugin_I.irp.f" file that is a program to be compiled and just printing "Hello world" + +II) Specifying the dependencies +------------------------------- +The next step is to know what are the other modules/plugins that we need to do what we want. +We need here + a) the one-electron integrals on the AO basis, which are computed in qp2/src/ao_one_e_ints/ + b) the one-electron integrals on the MO basis, which are computed in qp2/src/mo_one_e_ints/ + c) the two-electron integrals on the AO basis, which are computed in qp2/src/ao_two_e_ints/ + d) the two-electron integrals on the MO basis, which are computed in qp2/src/mo_two_e_ints/ + +Therefore, we will need the following four modules: +a) ao_one_e_ints +b) mo_one_e_ints +c) ao_two_e_ints +d) mo_two_e_ints + +You can then create the following "NEED" file by executing the following command +$ cat < NEED +ao_one_e_ints +mo_one_e_ints +ao_two_e_ints +mo_two_e_ints +EOF + +II) Installing the plugin +------------------------- +Now that we have specified the various depenencies we need now to INSTALL the plugin, which means to create the equivalent of a Makefile for the compilation. +To do it we simply do +$ qp plugins install plugin_I + +III) Compiling the void plugin +------------------------------ +It is customary to compile first your "void" plugin, void in the sense that it does not contain anything else than the program printing "Hello world". +To do so, just go in the plugin and execute the following command +$ ninja +It does a lot of stuffs, but it must conclude with something like +" +make: Leaving directory 'SOME_PATH_TOWARD_YOUR_QP2_DIRECTORY/qp2/ocaml' +" + +Since that it has compiled, an executable "plugin_I" has been created. +Also, if you make "ls" in the "plugin_I" you will notice that many symbolink links have been created, and among which the four modules that you included in the NEED file. +All the other modules (Ex:"ao_basis", "utils") are here because they are need by some of the four modules that you need. +The variables that we need are +ao_one_e_integrals +mo_one_e_integrals +You can check them with +irpman ao_one_e_integral +irpman mo_one_e_integral +in order to get some information on where they are created, and many more information. +We will modify the executable such that it prints out the integrals. + + +IV) Printing out the one-electron integrals +-------------------------------------------- +We will create a program that will print out the one-electron integrals on the AO and MO basis. +You can then copy the file "print_one_e_h.irp.f" in your plugin. +In the file you will see that we simply browse the two arrays "ao_one_e_integrals" and "mo_one_e_integrals", which are global variables (providers) and we browse them until either "ao_num" or "mo_num" which are also providers representing the number of AOs or MOs. +You can check these variables with irpman ! +If you recompile using "ninja" as before, and another executable has been created "print_one_e_h". +Then, you can run the program on the ezfio file by doing +qp run print_one_e_h +and will print out the data you need :) + From 7bc6b888549cf976ce7bee7b06e85109636552a7 Mon Sep 17 00:00:00 2001 From: eginer Date: Thu, 21 Mar 2024 15:31:23 +0100 Subject: [PATCH 36/64] added H2.xyz in tuto_plugins --- plugins/tuto_plugins/H2.xyz | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 plugins/tuto_plugins/H2.xyz diff --git a/plugins/tuto_plugins/H2.xyz b/plugins/tuto_plugins/H2.xyz new file mode 100644 index 00000000..7af12291 --- /dev/null +++ b/plugins/tuto_plugins/H2.xyz @@ -0,0 +1,6 @@ +2 +H2, equilibrium geometry +H 0.0 0.0 0. +H 0.0 0.0 0.74 + + From 9d3743e530f2b7d342778a32bc2ca89e36f97044 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 22 Mar 2024 14:56:39 +0100 Subject: [PATCH 37/64] added some providers and the first tutorial for plugins --- plugins/README.rst | 4 +- .../tuto_I/print_traces_on_e.irp.f | 24 ++++ .../tuto_plugins/tuto_I/print_two_e_h.irp.f | 32 +++++ .../tuto_plugins/tuto_I/traces_one_e.irp.f | 111 ++++++++++++++++++ plugins/tuto_plugins/tuto_I/tuto_I.rst | 65 +++++++--- src/ao_one_e_ints/ao_one_e_ints.irp.f | 10 ++ src/scf_utils/fock_matrix.irp.f | 4 + src/utils/linear_algebra.irp.f | 19 +++ 8 files changed, 250 insertions(+), 19 deletions(-) create mode 100644 plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f create mode 100644 plugins/tuto_plugins/tuto_I/print_two_e_h.irp.f create mode 100644 plugins/tuto_plugins/tuto_I/traces_one_e.irp.f diff --git a/plugins/README.rst b/plugins/README.rst index 7f3f3c75..7fc011a3 100644 --- a/plugins/README.rst +++ b/plugins/README.rst @@ -22,6 +22,8 @@ we will go through a series of examples that allow you to do the following thing IV) print out the one- and two-electron rdms, V) obtain the AOs and MOs on the DFT grid, together with the density, +How the tutorial will be done +----------------------------- This tuto is as follows: i) you READ THIS FILE UNTIL THE END in order to get the big picture and vocabulary, ii) you go to the directory qp2/plugins/tuto_plugins/ and you will find detailed tuto there for each of the 5 examples. @@ -32,7 +34,7 @@ The first thing to do is to be in the QPSH mode: you execute the qp2/bin/qpsh sc the environement variables and allows for the completion of command lines in bash (that is an AMAZING feature :) Then, you need to known where you want to create your plugin, and what is the name of the plugin. -!!!! WARINING: The plugins are NECESSARILY located in qp2/plugins/ !!!! +!!!! WARNING: The plugins are NECESSARILY located in qp2/plugins/ !!!! Ex: If you want to create a plugin named "my_fancy_plugin" in the directory plugins/plugins_test/, this goes with the command qp plugins create -n my_fancy_plugin -r plugins_test/ diff --git a/plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f b/plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f new file mode 100644 index 00000000..2bf3b86b --- /dev/null +++ b/plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f @@ -0,0 +1,24 @@ +program my_program + implicit none + BEGIN_DOC +! This program is there essentially to show how one can use providers in programs + END_DOC + integer :: i,j + double precision :: accu + print*,'Trace on the AO basis ' + print*,trace_ao_one_e_ints + print*,'Trace on the AO basis after projection on the MO basis' + print*,trace_ao_one_e_ints_from_mo + print*,'Trace of MO integrals ' + print*,trace_mo_one_e_ints + print*,'ao_num = ',ao_num + print*,'mo_num = ',mo_num + if(ao_num .ne. mo_num)then + print*,'The AO basis and MO basis are different ...' + print*,'Trace on the AO basis should not be the same as Trace of MO integrals' + print*,'Only the second one must be equal to the trace on the MO integrals' + else + print*,'The AO basis and MO basis are the same !' + print*,'All traces should coincide ' + endif +end diff --git a/plugins/tuto_plugins/tuto_I/print_two_e_h.irp.f b/plugins/tuto_plugins/tuto_I/print_two_e_h.irp.f new file mode 100644 index 00000000..eaeb6c98 --- /dev/null +++ b/plugins/tuto_plugins/tuto_I/print_two_e_h.irp.f @@ -0,0 +1,32 @@ +program my_program_to_print_stuffs + implicit none + BEGIN_DOC +! TODO : Put the documentation of the program here + END_DOC + integer :: i,j,k,l + double precision :: integral + double precision :: get_ao_two_e_integral, get_two_e_integral ! declaration of the functions + print*,'AO integrals, physicist notations : ' + do i = 1, ao_num + do j = 1, ao_num + do k = 1, ao_num + do l = 1, ao_num + integral = get_ao_two_e_integral(i, j, k, l, ao_integrals_map) + print*,i,j,k,l,integral + enddo + enddo + enddo + enddo + + print*,'MO integrals, physicist notations : ' + do i = 1, mo_num + do j = 1, mo_num + do k = 1, mo_num + do l = 1, mo_num + integral = get_two_e_integral(i, j, k, l, mo_integrals_map) + print*,i,j,k,l,integral + enddo + enddo + enddo + enddo +end diff --git a/plugins/tuto_plugins/tuto_I/traces_one_e.irp.f b/plugins/tuto_plugins/tuto_I/traces_one_e.irp.f new file mode 100644 index 00000000..e71d49fc --- /dev/null +++ b/plugins/tuto_plugins/tuto_I/traces_one_e.irp.f @@ -0,0 +1,111 @@ + +! This file is an example of the kind of manipulations that you can do with providers +! + +!!!!!!!!!!!!!!!!!!!!!!!!!! Main providers useful for the program !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!!! type name +BEGIN_PROVIDER [ double precision, trace_mo_one_e_ints] + implicit none + BEGIN_DOC +! trace_mo_one_e_ints = Trace of the one-electron integrals on the MO basis +! +! = sum_i mo_one_e_integrals(i,i) + END_DOC + integer :: i + trace_mo_one_e_ints = 0.d0 + do i = 1, mo_num + trace_mo_one_e_ints += mo_one_e_integrals(i,i) + enddo +END_PROVIDER + +BEGIN_PROVIDER [ double precision, trace_ao_one_e_ints] + implicit none + BEGIN_DOC +! trace_ao_one_e_ints = Trace of the one-electron integrals on the AO basis taking into account the non orthogonality +! +! Be aware that the trace of an operator in a non orthonormal basis is Tr(A S^{-1}) = \sum_{m,n}(A_mn S^{-1}_mn) +! +! WARNING: it is equal to the trace on the MO basis if and only if the AO basis and MO basis +! have the same number of functions + END_DOC + integer :: i,j + double precision, allocatable :: inv_overlap_times_integrals(:,:) ! = h S^{-1} + allocate(inv_overlap_times_integrals(ao_num,ao_num)) + ! routine that computes the product of two matrices, you can check it with + ! irpman get_AB_prod + call get_AB_prod(ao_one_e_integrals,ao_num,ao_num,s_inv,ao_num,inv_overlap_times_integrals) + ! Tr(inv_overlap_times_integrals) = Tr(h S^{-1}) + trace_ao_one_e_ints = 0.d0 + do i = 1, ao_num + trace_ao_one_e_ints += inv_overlap_times_integrals(i,i) + enddo + ! + ! testing the formula Tr(A S^{-1}) = \sum_{m,n}(A_mn S^{-1}_mn) + double precision :: test + test = 0.d0 + do i = 1, ao_num + do j = 1, ao_num + test += ao_one_e_integrals(j,i) * s_inv(i,j) + enddo + enddo + if(dabs(accu - trace_ao_one_e_ints).gt.1.d-12)then + print*,'Warning ! ' + print*,'Something is wrong because Tr(AB) \ne sum_{mn}A_mn B_nm' + endif +END_PROVIDER + +BEGIN_PROVIDER [ double precision, trace_ao_one_e_ints_from_mo] + implicit none + BEGIN_DOC +! trace_ao_one_e_ints_from_mo = Trace of the one-electron integrals on the AO basis after projection on the MO basis +! +! = Tr([SC h {SC}^+] S^{-1}) +! +! = Be aware that the trace of an operator in a non orthonormal basis is = Tr(A S^{-1}) where S is the metric +! Must be equal to the trace_mo_one_e_ints + END_DOC + integer :: i + double precision, allocatable :: inv_overlap_times_integrals(:,:) + allocate(inv_overlap_times_integrals(ao_num,ao_num)) + ! Using the provider ao_one_e_integrals_from_mo = [SC h {SC}^+] + call get_AB_prod(ao_one_e_integrals_from_mo,ao_num,ao_num,s_inv,ao_num,inv_overlap_times_integrals) + ! inv_overlap_times_integrals = [SC h {SC}^+] S^{-1} + trace_ao_one_e_ints_from_mo = 0.d0 + ! Computing the trace + do i = 1, ao_num + trace_ao_one_e_ints_from_mo += inv_overlap_times_integrals(i,i) + enddo +END_PROVIDER + +!!!!!!!!!!!!!!!!!!!!!!!!!!! Additional providers to check some stuffs !!!!!!!!!!!!!!!!!!!!!!!!! + +BEGIN_PROVIDER [ double precision, ao_one_e_int_no_ov_from_mo, (ao_num, ao_num) ] + BEGIN_DOC + ! ao_one_e_int_no_ov_from_mo = C mo_one_e_integrals C^T + ! + ! WARNING : NON EQUAL TO ao_one_e_integrals due to the non orthogonality + END_DOC + call mo_to_ao_no_overlap(mo_one_e_integrals,mo_num,ao_one_e_int_no_ov_from_mo,ao_num) +END_PROVIDER + +BEGIN_PROVIDER [ double precision, ao_one_e_int_no_ov_from_mo_ov_ov, (ao_num, ao_num)] + BEGIN_DOC + ! ao_one_e_int_no_ov_from_mo_ov_ov = S ao_one_e_int_no_ov_from_mo S = SC mo_one_e_integrals (SC)^T + ! + ! EQUAL TO ao_one_e_integrals ONLY IF ao_num = mo_num + END_DOC + double precision, allocatable :: tmp(:,:) + allocate(tmp(ao_num, ao_num)) + call get_AB_prod(ao_overlap,ao_num,ao_num,ao_one_e_int_no_ov_from_mo,ao_num,tmp) + call get_AB_prod(tmp,ao_num,ao_num,ao_overlap,ao_num,ao_one_e_int_no_ov_from_mo_ov_ov) +END_PROVIDER + +BEGIN_PROVIDER [ double precision, c_t_s_c, (mo_num, mo_num)] + implicit none + BEGIN_DOC +! C^T S C = should be the identity + END_DOC + call get_AB_prod(mo_coef_transp,mo_num,ao_num,S_mo_coef,mo_num,c_t_s_c) +END_PROVIDER + diff --git a/plugins/tuto_plugins/tuto_I/tuto_I.rst b/plugins/tuto_plugins/tuto_I/tuto_I.rst index 05db8635..fea07e3d 100644 --- a/plugins/tuto_plugins/tuto_I/tuto_I.rst +++ b/plugins/tuto_plugins/tuto_I/tuto_I.rst @@ -1,14 +1,15 @@ -====================================== -Tutorial for plugin I: One-e integrals -====================================== +===================================================================== +Tutorial for plugin I: One-e integrals (duration: 20 minutes at most) +===================================================================== -!!! Requirements: - a) you know how to create an EZFIO file and run calculations with QP +Requirements +------------ + a) You know how to create an EZFIO file and run calculations with QP (check the tuto: ``), - b) you have an EZFIO file in the sto-3g from the file H2.xyz in plugins/tuto_plugins, - and you have run an HF calculation giving an energy of -1.116759 a.u., - c) you made an qp set_file YOUR_EZFIO_FILE_FOR_H2 in order to be, - d) you have READ the ../README.rst file to HAVE THE VOCABULARY. + b) You have an EZFIO file with MOs created (with the 'scf' executable for instance). + As we are going to print out some integrals, don't take a too large system/basis (Ex: H2, cc-pVDZ is ok :) + c) You made an qp set_file YOUR_EZFIO_FILE_FOR_H2 in order to work on that ezfio folder, + d) You have READ the ../README.rst file to HAVE THE VOCABULARY. Our goals: ---------- @@ -22,14 +23,14 @@ I) Starting: creating the plugin We will go step-by-step through these plugins. The name of the plugin will be "plugin_I", and its location is in "tuto_plugins". -Therefore to create the plugin, we do +Therefore to create the plugin, we do: -$ qp plugins create -n plugin_I -r tuto_plugins -Then to an "ls" in qp2/plugins/tuto_plugins/ -and you will find a directory called "plugin_I". +qp plugins create -n plugin_I -r tuto_plugins + +Then do an "ls" in qp2/plugins/tuto_plugins/ and you will find a directory called "plugin_I". In that directory you will find: - i) a "NEED" file that will eventually contain all the other modules/plugins needed by our "plugin_I" - ii) a "README.rst" file that you can AND SHOULD modify in order to document what is doing the plugin. + i) a "NEED" file that will eventually contain all the other modules/plugins needed by our "plugin_I" + ii) a "README.rst" file that you can AND SHOULD modify in order to document what is doing the plugin. iii) a "plugin_I.irp.f" file that is a program to be compiled and just printing "Hello world" II) Specifying the dependencies @@ -78,8 +79,8 @@ The variables that we need are ao_one_e_integrals mo_one_e_integrals You can check them with -irpman ao_one_e_integral -irpman mo_one_e_integral +irpman ao_one_e_integrals +irpman mo_one_e_integrals in order to get some information on where they are created, and many more information. We will modify the executable such that it prints out the integrals. @@ -87,7 +88,7 @@ We will modify the executable such that it prints out the integrals. IV) Printing out the one-electron integrals -------------------------------------------- We will create a program that will print out the one-electron integrals on the AO and MO basis. -You can then copy the file "print_one_e_h.irp.f" in your plugin. +You can then copy the file "print_one_e_h.irp.f" located in "plugins/tuto_plugins/tuto_I" in your plugin. In the file you will see that we simply browse the two arrays "ao_one_e_integrals" and "mo_one_e_integrals", which are global variables (providers) and we browse them until either "ao_num" or "mo_num" which are also providers representing the number of AOs or MOs. You can check these variables with irpman ! If you recompile using "ninja" as before, and another executable has been created "print_one_e_h". @@ -95,3 +96,31 @@ Then, you can run the program on the ezfio file by doing qp run print_one_e_h and will print out the data you need :) +By the way, as the file "plugin_I.irp.f" contains nothing but a "Hello world" print, you can simply remove it if you want. +V) Printing out the two-electron integrals +------------------------------------------ +We will now create a file that prints out the two-electron integrals in the AO and MO basis. +These can be accessed with the following subroutines : ++) get_ao_two_e_integral for the AO basis ++) get_two_e_integral for the MO basis +check them with irpman ! +To print the two-electron integrals, you can copy the file "print_two_e_h.irp.f" in your plugin and recompile. +Then just run the program +qp run print_two_e_h +and it will print all the things you want :) + +VI) Creating new providers and a program to print them +------------------------------------------------------ +We will now create new providers that manipulates the objects that we just printed. +As an example, we will compute the trace of the one electron integrals in the AO and MO basis. +In the file "traces_one_e.irp.f" you will find the several new providers among which + a) trace_mo_one_e_ints : simply the sum of the diagonal matrix element of the one-electron integrals + b) trace_ao_one_e_ints : the corresponding trace on the AO basis : Sum(m,n) S^{-1}_{mn} h_{mn} + c) trace_ao_one_e_ints_from_mo : the trace on the AO basis with the integrals obtained first from the MO basis +As explained in these files, "trace_mo_one_e_ints" is equal to "trace_ao_one_e_ints" only if the number of AO basis functions is equal to the number of MO basis functions, which means if you work with cartesian functions. +(You can check with "qp create_ezfio -h" for the option to create an EZFIO with cartesian basis functions) + +In the file "print_traces_on_e.irp.f" you will find an example of executable that prints out the various providers. +Copy these two files in your plugin and recompile to execute it. + +Execute the program print_traces_on_e and check for the results ! diff --git a/src/ao_one_e_ints/ao_one_e_ints.irp.f b/src/ao_one_e_ints/ao_one_e_ints.irp.f index 65981dc9..9b914dee 100644 --- a/src/ao_one_e_ints/ao_one_e_ints.irp.f +++ b/src/ao_one_e_ints/ao_one_e_ints.irp.f @@ -45,3 +45,13 @@ BEGIN_PROVIDER [ double precision, ao_one_e_integrals_imag,(ao_num,ao_num)] END_PROVIDER + +BEGIN_PROVIDER [ double precision, ao_one_e_integrals_from_mo, (ao_num, ao_num)] + implicit none + BEGIN_DOC +! Integrals of the one e hamiltonian obtained from the integrals on the MO basis +! +! WARNING : this is equal to ao_one_e_integrals only if the AO and MO basis have the same number of functions + END_DOC + call mo_to_ao(mo_one_e_integrals,mo_num,ao_one_e_integrals_from_mo,ao_num) +END_PROVIDER diff --git a/src/scf_utils/fock_matrix.irp.f b/src/scf_utils/fock_matrix.irp.f index 1942e542..c8fa8333 100644 --- a/src/scf_utils/fock_matrix.irp.f +++ b/src/scf_utils/fock_matrix.irp.f @@ -166,6 +166,10 @@ if(frozen_orb_scf)then integer :: iorb,jorb + ! active|core|active + !active | | 0 | + !core | 0 | | 0 + !active | | 0 | do i = 1, n_core_orb iorb = list_core(i) do j = 1, n_act_orb diff --git a/src/utils/linear_algebra.irp.f b/src/utils/linear_algebra.irp.f index 26e390b7..20386b30 100644 --- a/src/utils/linear_algebra.irp.f +++ b/src/utils/linear_algebra.irp.f @@ -2041,3 +2041,22 @@ subroutine get_A_squared(A,n,A2) double precision, intent(out):: A2(n,n) call dgemm('N','N',n,n,n,1.d0,A,size(A,1),A,size(A,1),0.d0,A2,size(A2,1)) end + +subroutine get_AB_prod(A,n,m,B,l,AB) + implicit none + BEGIN_DOC +! AB = A B where A is n x m, B is m x l. Use the dgemm routine + END_DOC + double precision, intent(in) :: A(n,m),B(m,l) + integer, intent(in) :: n,m,l + double precision, intent(out):: AB(n,l) + if(size(A,2).ne.m.or.size(B,1).ne.m)then + print*,'error in get_AB_prod ! ' + print*,'matrices do not have the good dimension ' + print*,'size(A,2) = ',size(A,2) + print*,'size(B,1) = ',size(B,1) + print*,'m = ',m + stop + endif + call dgemm('N','N',n,l,m,1.d0,A,size(A,1),B,size(B,1),0.d0,AB,size(AB,1)) +end From dd2f0a2c0770b9d1e26522fa7a80f1ee55865408 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 22 Mar 2024 16:30:08 +0100 Subject: [PATCH 38/64] added the introduction to the plugins tutorial --- docs/source/appendix/contributors.rst | 1 + docs/source/index.rst | 3 +- external/irpf90 | 2 +- plugins/README.rst | 148 +++++++++++++++++--------- 4 files changed, 104 insertions(+), 50 deletions(-) diff --git a/docs/source/appendix/contributors.rst b/docs/source/appendix/contributors.rst index e3574e5a..74837282 100644 --- a/docs/source/appendix/contributors.rst +++ b/docs/source/appendix/contributors.rst @@ -46,6 +46,7 @@ The following people have contributed to this project (by alphabetical order): * Nicolas Renon * Lorenzo Tenti * Julien Toulouse +* Diata Traoré * Mikaël Véril diff --git a/docs/source/index.rst b/docs/source/index.rst index 4231b1f8..e7e63260 100644 --- a/docs/source/index.rst +++ b/docs/source/index.rst @@ -39,9 +39,9 @@ programmers_guide/programming programmers_guide/ezfio programmers_guide/plugins + programmers_guide/plugins_tuto_intro programmers_guide/new_ks programmers_guide/index - programmers_guide/plugins .. toctree:: @@ -52,5 +52,6 @@ appendix/benchmarks appendix/license appendix/contributors + appendix/references diff --git a/external/irpf90 b/external/irpf90 index ba1a2837..4ab1b175 160000 --- a/external/irpf90 +++ b/external/irpf90 @@ -1 +1 @@ -Subproject commit ba1a2837aa61cb8f9892860cec544d7c6659badd +Subproject commit 4ab1b175fc7ed0d96c1912f13dc53579b24157a6 diff --git a/plugins/README.rst b/plugins/README.rst index 7fc011a3..3214a619 100644 --- a/plugins/README.rst +++ b/plugins/README.rst @@ -3,76 +3,128 @@ Tutorial for creating a plugin ============================== Introduction: what is a plugin, and what this tuto will be about ? -============================================================ -The QP is split into two kinds of routines/global variables (i.e. providers): - i) the core modules locatedin qp2/src/, which contains all the bulk of a quantum chemistry software (integrals, matrix elements between Slater determinants, linear algebra routines, DFT stuffs etc..) - ii) the plugins which are external stuffs connected to the qp2/src/ stuffs. +================================================================== + +The |QP| is split into two kinds of routines/global variables (i.e. *providers*): + i) the **core modules** locatedin qp2/src/, which contains all the bulk of a quantum chemistry software (integrals, matrix elements between Slater determinants, linear algebra routines, DFT stuffs etc..) + ii) the **plugins** which are external routines/*providers* connected to the qp2/src/ routines/*providers*. -More precisely, a plugin of the QP is a directory where you can create routines, +More precisely, a **plugin** of the |QP| is a directory where you can create routines, providers and executables that use all the global variables/functions/routines already created -in the modules ofqp2/src or in other plugins. +in the modules of qp2/src or in other plugins. Instead of giving a theoretical lecture on what is a plugin, we will go through a series of examples that allow you to do the following thing: - I) print out one- and two-electron integrals on the AO/MO basis, - creates two providers which manipulate these objects, - print out these providers, - II) browse the Slater determinants stored in the EZFIO wave function and compute their matrix elements, - III) build the Hamiltonian matrix and diagonalize it either with Lapck or Davidson, - IV) print out the one- and two-electron rdms, - V) obtain the AOs and MOs on the DFT grid, together with the density, + +i) print out **one- and two-electron integrals** on the AO/MO basis, creates two providers which manipulate these objects, print out these providers, + +ii) browse the **Slater determinants stored** in the |EZFIO| wave function and compute their matrix elements, + +iii) build the **Hamiltonian matrix** and **diagonalize** it either with **Lapack or Davidson**, + +iv) print out the **one- and two-electron rdms**, + +v) obtain the **AOs** and **MOs** on the **DFT grid**, together with the **density**, How the tutorial will be done ----------------------------- + This tuto is as follows: - i) you READ THIS FILE UNTIL THE END in order to get the big picture and vocabulary, - ii) you go to the directory qp2/plugins/tuto_plugins/ and you will find detailed tuto there for each of the 5 examples. + + i) you **READ THIS FILE UNTIL THE END** in order to get the big picture and vocabulary, + + ii) you go to the directory :file:`qp2/plugins/tuto_plugins/` and you will find detailed tutorials for each of the 5 examples. Creating a plugin: the basic ---------------------------- + The first thing to do is to be in the QPSH mode: you execute the qp2/bin/qpsh script that essentially loads all the environement variables and allows for the completion of command lines in bash (that is an AMAZING feature :) -Then, you need to known where you want to create your plugin, and what is the name of the plugin. -!!!! WARNING: The plugins are NECESSARILY located in qp2/plugins/ !!!! +Then, you need to known **where** you want to create your plugin, and what is the **name** of the plugin. + +.. important:: + + The plugins are **NECESSARILY** located in qp2/plugins/, and from there you can create any structures of directories. + + Ex: If you want to create a plugin named "my_fancy_plugin" in the directory plugins/plugins_test/, this goes with the command -qp plugins create -n my_fancy_plugin -r plugins_test/ -Then, to create plugin of your dreams, the two questions you need to answer are the following: -a) What do I need to compute what I want, which means what are the objects that I need ? +.. code:: bash + + qp plugins create -n my_fancy_plugin -r plugins_test/ + +Then, to create the plugin of your dreams, the two questions you need to answer are the following: + +1) What do I **need** to compute what I want, which means what are the **objects** that I need ? + There are two kind of objects: - + the routines/functions + + + the *routines/functions*: + Ex: Linear algebra routines, integration routines etc ... - + the global variables which are called the PROVIDERS + + + the global variables which are called the *providers*: + Ex: one-electron integrals, Slater determinants, density matrices etc ... -b) Where do I find these objects ? - The objects (routines/functions/providers) are necessarily created in other modules/plugins - Ex: the routine "lapack_diagd" (which diagonalises a real hermitian matrix) is located in the file - qp2/src/utils/linear_algebra.irp.f - therefore it "belongs" to the module "utils" - : the routine "ao_to_mo" (which converts a given matrix A from the AO basis to the MO basis) is located in the file - qp2/src/mo_one_e_ints/ao_to_mo.irp.f - therefore it "belongs" to the module "mo_one_e_ints" - : the provider "ao_one_e_integrals" (which is the integrals of one-body part of H on the AO basis) is located in the file - qp2/src/mo_one_e_ints/ao_to_mo.irp.f - therefore it belongs to the module "mo_one_e_ints" - : the provider "one_e_dm_mo_beta_average" (which is the state average beta density matrix on the MO basis) is located in the file - qp2/src/determinants/density_matrix.irp.f - therefore it belongs to the module "determinants" -To import all the variables that you need, you just need to write the name of the plugins in the file "NEED" -Ex: to import all the variables/routines of the module "utils", "determinants" and "mo_one_e_ints" you will have the following NEED file: -utils -determinants -mo_one_e_ints +2) **Where do I find** these objects ? -TIPS ----- -There are many many routines/providers in the core modules of QP. Nevertheless, as everything is coded with the IRPF90, you can use the following amazing tools: irpman -irpman can be used in command line in bash to obtain all the info on a routine or variable ! -Ex: execute the following command line : -irpman ao_one_e_integrals -Then it appears all the information you want on ao_one_e_integrals, including where it is created, the type, dimension if it is an array, what providers it needs to be built, and what providers need this provider. + The objects (routines/functions/providers) are necessarily created in other *modules/plugins*. + +.. seealso:: + + The routine :c:func:`lapack_diagd` (which diagonalises a real hermitian matrix) is located in the file + :file:`qp2/src/utils/linear_algebra.irp.f` + therefore it "belongs" to the module "utils" + + The routine :c:func:`ao_to_mo` (which converts a given matrix A from the AO basis to the MO basis) is located in the file + :file:`qp2/src/mo_one_e_ints/ao_to_mo.irp.f` + therefore it "belongs" to the module "mo_one_e_ints" + + The provider :c:data:`ao_one_e_integrals` (which is the integrals of one-body part of H on the AO basis) is located in the file + :file:`qp2/src/mo_one_e_ints/ao_to_mo.irp.f` + therefore it belongs to the module "mo_one_e_ints" + + The provider :c:data:`one_e_dm_mo_beta_average` (which is the state average beta density matrix on the MO basis) is located in the file + :file:`qp2/src/determinants/density_matrix.irp.f` + therefore it belongs to the module "determinants" + +To import all the variables that you need, you just need to write the name of the plugins in the :file:`NEED` file . + +To import all the variables/routines of the module "utils", "determinants" and "mo_one_e_ints", the :file:`NEED` file you will need is simply the following: + +.. code:: bash + + cat NEED + + utils + determinants + mo_one_e_ints + + +.. important:: + + There are **many** routines/providers in the core modules of QP. + + Nevertheless, as everything is coded with the |IRPF90|, you can use the following amazing tools: :command:`irpman` + + :command:`irpman` can be used in command line in bash to obtain all the info on a routine or variable ! + + +Example: execute the following command line : + +.. code:: bash + + irpman ao_one_e_integrals + +Then all the information you need on :c:data:`ao_one_e_integrals` will appear on the screen. +This includes + - **where** the provider is created, (*i.e.* the actual file where the provider is designed) + - the **type** of the provider (*i.e.* a logical, integer etc ...) + - the **dimension** if it is an array, + - what other *providers* are **needed** to build this provider, + - what other *providers* **need** this provider. From e0af6d84258ebc3540628d59c62d3d937ca5a9e3 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 22 Mar 2024 17:29:32 +0100 Subject: [PATCH 39/64] added properly the first tuto! --- docs/source/index.rst | 1 + plugins/README.rst | 35 ++-- plugins/tuto_plugins/tuto_I/tuto_I.rst | 220 ++++++++++++++++++------- 3 files changed, 175 insertions(+), 81 deletions(-) diff --git a/docs/source/index.rst b/docs/source/index.rst index e7e63260..273582d4 100644 --- a/docs/source/index.rst +++ b/docs/source/index.rst @@ -40,6 +40,7 @@ programmers_guide/ezfio programmers_guide/plugins programmers_guide/plugins_tuto_intro + programmers_guide/plugins_tuto_I programmers_guide/new_ks programmers_guide/index diff --git a/plugins/README.rst b/plugins/README.rst index 3214a619..3dc50873 100644 --- a/plugins/README.rst +++ b/plugins/README.rst @@ -2,12 +2,12 @@ Tutorial for creating a plugin ============================== -Introduction: what is a plugin, and what this tuto will be about ? -================================================================== +Introduction: what is a plugin, and what tutorial will be about ? +================================================================= The |QP| is split into two kinds of routines/global variables (i.e. *providers*): - i) the **core modules** locatedin qp2/src/, which contains all the bulk of a quantum chemistry software (integrals, matrix elements between Slater determinants, linear algebra routines, DFT stuffs etc..) - ii) the **plugins** which are external routines/*providers* connected to the qp2/src/ routines/*providers*. + 1) the **core modules** locatedin qp2/src/, which contains all the bulk of a quantum chemistry software (integrals, matrix elements between Slater determinants, linear algebra routines, DFT stuffs etc..) + 2) the **plugins** which are external routines/*providers* connected to the qp2/src/ routines/*providers*. More precisely, a **plugin** of the |QP| is a directory where you can create routines, providers and executables that use all the global variables/functions/routines already created @@ -16,24 +16,24 @@ in the modules of qp2/src or in other plugins. Instead of giving a theoretical lecture on what is a plugin, we will go through a series of examples that allow you to do the following thing: -i) print out **one- and two-electron integrals** on the AO/MO basis, creates two providers which manipulate these objects, print out these providers, +1) print out **one- and two-electron integrals** on the AO/MO basis, creates two providers which manipulate these objects, print out these providers, -ii) browse the **Slater determinants stored** in the |EZFIO| wave function and compute their matrix elements, +2) browse the **Slater determinants stored** in the |EZFIO| wave function and compute their matrix elements, -iii) build the **Hamiltonian matrix** and **diagonalize** it either with **Lapack or Davidson**, +3) build the **Hamiltonian matrix** and **diagonalize** it either with **Lapack or Davidson**, -iv) print out the **one- and two-electron rdms**, +4) print out the **one- and two-electron rdms**, -v) obtain the **AOs** and **MOs** on the **DFT grid**, together with the **density**, +5) obtain the **AOs** and **MOs** on the **DFT grid**, together with the **density**, How the tutorial will be done ----------------------------- This tuto is as follows: - i) you **READ THIS FILE UNTIL THE END** in order to get the big picture and vocabulary, + 1) you **READ THIS FILE UNTIL THE END** in order to get the big picture and vocabulary, - ii) you go to the directory :file:`qp2/plugins/tuto_plugins/` and you will find detailed tutorials for each of the 5 examples. + 2) you go to the directory :file:`qp2/plugins/tuto_plugins/` and you will find detailed tutorials for each of the 5 examples. Creating a plugin: the basic ---------------------------- @@ -77,23 +77,23 @@ Then, to create the plugin of your dreams, the two questions you need to answer The routine :c:func:`lapack_diagd` (which diagonalises a real hermitian matrix) is located in the file :file:`qp2/src/utils/linear_algebra.irp.f` - therefore it "belongs" to the module "utils" + therefore it "belongs" to the module :ref:`module_utils` The routine :c:func:`ao_to_mo` (which converts a given matrix A from the AO basis to the MO basis) is located in the file :file:`qp2/src/mo_one_e_ints/ao_to_mo.irp.f` - therefore it "belongs" to the module "mo_one_e_ints" + therefore it "belongs" to the module :ref:`module_mo_one_e_ints` The provider :c:data:`ao_one_e_integrals` (which is the integrals of one-body part of H on the AO basis) is located in the file - :file:`qp2/src/mo_one_e_ints/ao_to_mo.irp.f` - therefore it belongs to the module "mo_one_e_ints" + :file:`qp2/src/ao_one_e_ints/ao_one_e_ints.irp.f` + therefore it belongs to the module :ref:`module_ao_one_e_ints` The provider :c:data:`one_e_dm_mo_beta_average` (which is the state average beta density matrix on the MO basis) is located in the file :file:`qp2/src/determinants/density_matrix.irp.f` - therefore it belongs to the module "determinants" + therefore it belongs to the module :ref:`module_determinants` To import all the variables that you need, you just need to write the name of the plugins in the :file:`NEED` file . -To import all the variables/routines of the module "utils", "determinants" and "mo_one_e_ints", the :file:`NEED` file you will need is simply the following: +To import all the variables/routines of the module :ref:`module_utils`, :ref:`module_determinants` and :ref:`module_mo_one_e_ints`, the :file:`NEED` file you will need is simply the following: .. code:: bash @@ -121,6 +121,7 @@ Example: execute the following command line : Then all the information you need on :c:data:`ao_one_e_integrals` will appear on the screen. This includes + - **where** the provider is created, (*i.e.* the actual file where the provider is designed) - the **type** of the provider (*i.e.* a logical, integer etc ...) - the **dimension** if it is an array, diff --git a/plugins/tuto_plugins/tuto_I/tuto_I.rst b/plugins/tuto_plugins/tuto_I/tuto_I.rst index fea07e3d..43b4af0b 100644 --- a/plugins/tuto_plugins/tuto_I/tuto_I.rst +++ b/plugins/tuto_plugins/tuto_I/tuto_I.rst @@ -1,126 +1,218 @@ -===================================================================== -Tutorial for plugin I: One-e integrals (duration: 20 minutes at most) -===================================================================== +============================================= +Tuto I: One- and two-e integrals (20 minutes) +============================================= Requirements ------------ - a) You know how to create an EZFIO file and run calculations with QP - (check the tuto: ``), - b) You have an EZFIO file with MOs created (with the 'scf' executable for instance). - As we are going to print out some integrals, don't take a too large system/basis (Ex: H2, cc-pVDZ is ok :) - c) You made an qp set_file YOUR_EZFIO_FILE_FOR_H2 in order to work on that ezfio folder, - d) You have READ the ../README.rst file to HAVE THE VOCABULARY. +1) You know how to create an |EZFIO| file and run calculations with |QP| (check the tuto: ``_), + +2) You have an |EZFIO| file with MOs created (with the :ref:`scf` executable for instance). As we are going to print out some integrals, don't take a too large system/basis (Ex: H2, cc-pVDZ is ok :) + +3) You made an qp set_file YOUR_EZFIO_FILE_FOR_H2 in order to work on that ezfio folder. + +4) You have READ the :file:`qp2/plugins/README.rst` file to HAVE THE **VOCABULARY**. Our goals: ---------- We want to create a plugin to do the following things: - a) print out one- and two-electron integrals on the AO/MO basis, - b) creates two providers which manipulate these objects, - c) print out these providers, + 1) print out one- and two-electron integrals on the AO/MO basis, -I) Starting: creating the plugin --------------------------------- + 2) creates two providers which manipulate these objects, + + 3) print out these providers. + +I) Getting started: creating the plugin +--------------------------------------- We will go step-by-step through these plugins. -The name of the plugin will be "plugin_I", and its location is in "tuto_plugins". +We will create a plugin named "plugin_I", and its location will be in "tuto_plugins". Therefore to create the plugin, we do: -qp plugins create -n plugin_I -r tuto_plugins +.. code:: bash + + qp plugins create -n plugin_I -r tuto_plugins Then do an "ls" in qp2/plugins/tuto_plugins/ and you will find a directory called "plugin_I". + In that directory you will find: - i) a "NEED" file that will eventually contain all the other modules/plugins needed by our "plugin_I" - ii) a "README.rst" file that you can AND SHOULD modify in order to document what is doing the plugin. - iii) a "plugin_I.irp.f" file that is a program to be compiled and just printing "Hello world" + +1) a :file:`NEED` file that will eventually contain all the other modules/plugins needed by our "plugin_I", + +2) a :file:`README.rst` file that you can and **SHOULD** modify in order to **DOCUMENT** what is doing the plugin, + +3) a :file:`plugin_I.irp.f` file that is a program to be compiled and just printing "Hello world" II) Specifying the dependencies ------------------------------- The next step is to know what are the other modules/plugins that we need to do what we want. We need here - a) the one-electron integrals on the AO basis, which are computed in qp2/src/ao_one_e_ints/ - b) the one-electron integrals on the MO basis, which are computed in qp2/src/mo_one_e_ints/ - c) the two-electron integrals on the AO basis, which are computed in qp2/src/ao_two_e_ints/ - d) the two-electron integrals on the MO basis, which are computed in qp2/src/mo_two_e_ints/ + +a) the one-electron integrals on the AO basis, which are computed in :file:`qp2/src/ao_one_e_ints/` + +b) the one-electron integrals on the MO basis, which are computed in :file:`qp2/src/mo_one_e_ints/` + +c) the two-electron integrals on the AO basis, which are computed in :file:`qp2/src/ao_two_e_ints/` + +d) the two-electron integrals on the MO basis, which are computed in :file:`qp2/src/mo_two_e_ints/` Therefore, we will need the following four modules: -a) ao_one_e_ints -b) mo_one_e_ints -c) ao_two_e_ints -d) mo_two_e_ints + + a) ao_one_e_ints + b) mo_one_e_ints + c) ao_two_e_ints + d) mo_two_e_ints You can then create the following "NEED" file by executing the following command -$ cat < NEED -ao_one_e_ints -mo_one_e_ints -ao_two_e_ints -mo_two_e_ints -EOF + +.. code:: bash + + cat < NEED + ao_one_e_ints + mo_one_e_ints + ao_two_e_ints + mo_two_e_ints + EOF II) Installing the plugin ------------------------- Now that we have specified the various depenencies we need now to INSTALL the plugin, which means to create the equivalent of a Makefile for the compilation. + To do it we simply do -$ qp plugins install plugin_I + +.. code:: bash + + qp plugins install plugin_I + III) Compiling the void plugin ------------------------------ It is customary to compile first your "void" plugin, void in the sense that it does not contain anything else than the program printing "Hello world". + To do so, just go in the plugin and execute the following command -$ ninja + +.. code:: bash + + ninja + It does a lot of stuffs, but it must conclude with something like -" -make: Leaving directory 'SOME_PATH_TOWARD_YOUR_QP2_DIRECTORY/qp2/ocaml' -" + +.. code:: bash + + make: Leaving directory 'SOME_PATH_TOWARD_YOUR_QP2_DIRECTORY/qp2/ocaml' + Since that it has compiled, an executable "plugin_I" has been created. + Also, if you make "ls" in the "plugin_I" you will notice that many symbolink links have been created, and among which the four modules that you included in the NEED file. -All the other modules (Ex:"ao_basis", "utils") are here because they are need by some of the four modules that you need. + +All the other modules (Ex::ref:`module_ao_basis`, :ref:`module_utils`) are here because they are need by some of the four modules that you need. The variables that we need are -ao_one_e_integrals -mo_one_e_integrals + +:data:`ao_one_e_integrals` + +:data:`mo_one_e_integrals` + You can check them with -irpman ao_one_e_integrals -irpman mo_one_e_integrals + +.. code:: bash + + irpman ao_one_e_integrals + + +.. code:: bash + + irpman mo_one_e_integrals + in order to get some information on where they are created, and many more information. -We will modify the executable such that it prints out the integrals. +We will now create an executable such that it prints out the integrals. IV) Printing out the one-electron integrals -------------------------------------------- -We will create a program that will print out the one-electron integrals on the AO and MO basis. -You can then copy the file "print_one_e_h.irp.f" located in "plugins/tuto_plugins/tuto_I" in your plugin. -In the file you will see that we simply browse the two arrays "ao_one_e_integrals" and "mo_one_e_integrals", which are global variables (providers) and we browse them until either "ao_num" or "mo_num" which are also providers representing the number of AOs or MOs. -You can check these variables with irpman ! -If you recompile using "ninja" as before, and another executable has been created "print_one_e_h". +We will now create a program that will print out the one-electron integrals on the AO and MO basis. + +You can then copy the file :file:`qp2/plugins/tuto_plugins/tuto_I/print_one_e_h.irp.f` in your plugin. + +In this file you will see that we simply browse the two arrays :data:`ao_one_e_integrals` and :data:`mo_one_e_integrals`, which are the providers and we browse them until either :data:`ao_num` or :data:`mo_num` which are also providers representing the number of AOs or MOs. + + +.. seealso:: + + You can check these variables with :command:`irpman` ! + +If you recompile using |ninja| as before, and another executable has been created "print_one_e_h". Then, you can run the program on the ezfio file by doing -qp run print_one_e_h + +.. code:: bash + + qp run print_one_e_h + and will print out the data you need :) -By the way, as the file "plugin_I.irp.f" contains nothing but a "Hello world" print, you can simply remove it if you want. +By the way, as the file :file:`plugin_I.irp.f` contains nothing but a "Hello world" print, you can simply remove it if you want. + V) Printing out the two-electron integrals ------------------------------------------ We will now create a file that prints out the two-electron integrals in the AO and MO basis. These can be accessed with the following subroutines : -+) get_ao_two_e_integral for the AO basis -+) get_two_e_integral for the MO basis -check them with irpman ! -To print the two-electron integrals, you can copy the file "print_two_e_h.irp.f" in your plugin and recompile. + +1- :c:func:`get_ao_two_e_integral` for the AO basis + +2- :c:func:`get_two_e_integral` for the MO basis + + +.. seealso:: + + check them with irpman ! + +To print the two-electron integrals, you can copy the file :file:`qp2/plugins/tuto_plugins/tuto_I/print_two_e_h.irp.f` in your plugin and recompile with |ninja|. Then just run the program -qp run print_two_e_h + +.. code:: bash + + qp run print_two_e_h + and it will print all the things you want :) VI) Creating new providers and a program to print them ------------------------------------------------------ We will now create new providers that manipulates the objects that we just printed. As an example, we will compute the trace of the one electron integrals in the AO and MO basis. -In the file "traces_one_e.irp.f" you will find the several new providers among which - a) trace_mo_one_e_ints : simply the sum of the diagonal matrix element of the one-electron integrals - b) trace_ao_one_e_ints : the corresponding trace on the AO basis : Sum(m,n) S^{-1}_{mn} h_{mn} - c) trace_ao_one_e_ints_from_mo : the trace on the AO basis with the integrals obtained first from the MO basis -As explained in these files, "trace_mo_one_e_ints" is equal to "trace_ao_one_e_ints" only if the number of AO basis functions is equal to the number of MO basis functions, which means if you work with cartesian functions. -(You can check with "qp create_ezfio -h" for the option to create an EZFIO with cartesian basis functions) +In the file :file:`qp2/plugins/tuto_plugins/tuto_I/traces_one_e.irp.f` you will find the several new providers among which -In the file "print_traces_on_e.irp.f" you will find an example of executable that prints out the various providers. + 1- :c:data:`trace_mo_one_e_ints` : simply the sum of the diagonal matrix element of the one-electron integrals + + 2- :c:data:`trace_ao_one_e_ints` : the corresponding trace on the AO basis + .. math:: + + \text{Tr}({\bf h}{\bf S}^{-1}) = \sum_{m,n} S^{-1}_{mn} h_{mn} + + + 3- :c:data:`trace_ao_one_e_ints_from_mo` : the trace on the AO basis with the integrals obtained first from the MO basis + .. math:: + + \text{Tr}({\bf \tilde{h}}{\bf S}^{-1}) = \text{Tr}\big({\bf SC h}({\bf SC }^T){\bf S}^{-1}\big) + +Just copy the :file:`qp2/plugins/tuto_plugins/tuto_I/traces_one_e.irp.f` in your plugin and recompile. + +.. seealso:: + + Once it has compiled, check your new providers with :command:`irpman` ! + +As explained in the files :file:`qp2/plugins/tuto_plugins/tuto_I/traces_one_e.irp.f` and :file:`qp2/plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f`, :c:data:`trace_mo_one_e_ints` is equal to :c:data:`trace_ao_one_e_ints` only if the number of AO basis functions is equal to the number of MO basis functions, which means if you work with cartesian functions. + + +.. seealso:: + + You can check with :command:`qp create_ezfio -h` for the option to create an |EZFIO| with cartesian basis functions + +In the file :file:`qp2/plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f` you will find an example of executable that prints out the various providers. Copy these two files in your plugin and recompile to execute it. -Execute the program print_traces_on_e and check for the results ! +Execute the program print_traces_on_e and check for the results with + +.. code:: bash + + qp run print_traces_on_e + +The code in :file:`qp2/plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f` should be easy to read, I let the reader interpret it. From 64523de3aecf31a90ed791fbb87be40094f1f930 Mon Sep 17 00:00:00 2001 From: eginer Date: Fri, 22 Mar 2024 18:33:17 +0100 Subject: [PATCH 40/64] minor modifs in cipsi_tc_bi_ortho/selection.irp.f --- plugins/local/cipsi_tc_bi_ortho/selection.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/local/cipsi_tc_bi_ortho/selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f index e0637fa5..12163e06 100644 --- a/plugins/local/cipsi_tc_bi_ortho/selection.irp.f +++ b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f @@ -960,7 +960,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d ! endif e_pert(istate) = 0.25 * val / delta_E ! e_pert(istate) = 0.5d0 * (tmp - delta_E) - if(dsqrt(dabs(tmp)).gt.1.d-4.and.dabs(alpha_h_psi).gt.1.d-4)then + if(dsqrt(tmp).gt.1.d-4.and.dabs(psi_h_alpha).gt.1.d-4)then coef(istate) = e_pert(istate) / psi_h_alpha else coef(istate) = alpha_h_psi / delta_E From 9abc0c996af808e0cd77c4cbe0fb4ffa1c585a47 Mon Sep 17 00:00:00 2001 From: eginer Date: Mon, 25 Mar 2024 17:00:14 +0100 Subject: [PATCH 41/64] mv tuto_plugins in local --- plugins/{ => local}/tuto_plugins/H2.xyz | 0 plugins/{ => local}/tuto_plugins/n2.xyz | 0 plugins/{ => local}/tuto_plugins/tuto_I/print_one_e_h.irp.f | 0 plugins/{ => local}/tuto_plugins/tuto_I/print_traces_on_e.irp.f | 0 plugins/{ => local}/tuto_plugins/tuto_I/print_two_e_h.irp.f | 0 plugins/{ => local}/tuto_plugins/tuto_I/traces_one_e.irp.f | 0 plugins/{ => local}/tuto_plugins/tuto_I/tuto_I.rst | 0 7 files changed, 0 insertions(+), 0 deletions(-) rename plugins/{ => local}/tuto_plugins/H2.xyz (100%) rename plugins/{ => local}/tuto_plugins/n2.xyz (100%) rename plugins/{ => local}/tuto_plugins/tuto_I/print_one_e_h.irp.f (100%) rename plugins/{ => local}/tuto_plugins/tuto_I/print_traces_on_e.irp.f (100%) rename plugins/{ => local}/tuto_plugins/tuto_I/print_two_e_h.irp.f (100%) rename plugins/{ => local}/tuto_plugins/tuto_I/traces_one_e.irp.f (100%) rename plugins/{ => local}/tuto_plugins/tuto_I/tuto_I.rst (100%) diff --git a/plugins/tuto_plugins/H2.xyz b/plugins/local/tuto_plugins/H2.xyz similarity index 100% rename from plugins/tuto_plugins/H2.xyz rename to plugins/local/tuto_plugins/H2.xyz diff --git a/plugins/tuto_plugins/n2.xyz b/plugins/local/tuto_plugins/n2.xyz similarity index 100% rename from plugins/tuto_plugins/n2.xyz rename to plugins/local/tuto_plugins/n2.xyz diff --git a/plugins/tuto_plugins/tuto_I/print_one_e_h.irp.f b/plugins/local/tuto_plugins/tuto_I/print_one_e_h.irp.f similarity index 100% rename from plugins/tuto_plugins/tuto_I/print_one_e_h.irp.f rename to plugins/local/tuto_plugins/tuto_I/print_one_e_h.irp.f diff --git a/plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f b/plugins/local/tuto_plugins/tuto_I/print_traces_on_e.irp.f similarity index 100% rename from plugins/tuto_plugins/tuto_I/print_traces_on_e.irp.f rename to plugins/local/tuto_plugins/tuto_I/print_traces_on_e.irp.f diff --git a/plugins/tuto_plugins/tuto_I/print_two_e_h.irp.f b/plugins/local/tuto_plugins/tuto_I/print_two_e_h.irp.f similarity index 100% rename from plugins/tuto_plugins/tuto_I/print_two_e_h.irp.f rename to plugins/local/tuto_plugins/tuto_I/print_two_e_h.irp.f diff --git a/plugins/tuto_plugins/tuto_I/traces_one_e.irp.f b/plugins/local/tuto_plugins/tuto_I/traces_one_e.irp.f similarity index 100% rename from plugins/tuto_plugins/tuto_I/traces_one_e.irp.f rename to plugins/local/tuto_plugins/tuto_I/traces_one_e.irp.f diff --git a/plugins/tuto_plugins/tuto_I/tuto_I.rst b/plugins/local/tuto_plugins/tuto_I/tuto_I.rst similarity index 100% rename from plugins/tuto_plugins/tuto_I/tuto_I.rst rename to plugins/local/tuto_plugins/tuto_I/tuto_I.rst From a7a43dafb6cb6f41b41a5b417206c6d090f24186 Mon Sep 17 00:00:00 2001 From: eginer Date: Mon, 25 Mar 2024 17:02:28 +0100 Subject: [PATCH 42/64] modified the doc according to the new path of tuto plugin --- docs/source/programmers_guide/plugins_tuto_I.rst | 1 + docs/source/programmers_guide/plugins_tuto_intro.rst | 1 + 2 files changed, 2 insertions(+) create mode 100644 docs/source/programmers_guide/plugins_tuto_I.rst create mode 100644 docs/source/programmers_guide/plugins_tuto_intro.rst diff --git a/docs/source/programmers_guide/plugins_tuto_I.rst b/docs/source/programmers_guide/plugins_tuto_I.rst new file mode 100644 index 00000000..27864487 --- /dev/null +++ b/docs/source/programmers_guide/plugins_tuto_I.rst @@ -0,0 +1 @@ +.. include:: ../../../plugins/local/tuto_plugins/tuto_I/tuto_I.rst diff --git a/docs/source/programmers_guide/plugins_tuto_intro.rst b/docs/source/programmers_guide/plugins_tuto_intro.rst new file mode 100644 index 00000000..63482462 --- /dev/null +++ b/docs/source/programmers_guide/plugins_tuto_intro.rst @@ -0,0 +1 @@ +.. include:: ../../../plugins/README.rst From 54d836f029d9f28b5bf1e86c03704d19239d5654 Mon Sep 17 00:00:00 2001 From: ydamour Date: Tue, 26 Mar 2024 11:31:04 +0100 Subject: [PATCH 43/64] state following --- .../diagonalization_hs2_dressed.irp.f | 158 +++++++++++++----- src/davidson/diagonalize_ci.irp.f | 89 +++++++++- 2 files changed, 206 insertions(+), 41 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 1ead9d78..3513f215 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -522,6 +522,84 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ enddo endif + if (state_following) then + if (.not. only_expected_s2) then + print*,'' + print*,'!!! State following only available with only_expected_s2 = .True. !!!' + STOP + endif + endif + + if (state_following) then + + integer :: state(N_st), idx + double precision :: omax + logical :: used + logical, allocatable :: ok(:) + double precision, allocatable :: overlp(:,:) + + allocate(overlp(shift2,N_st),ok(shift2)) + + overlp = 0d0 + do j = 1, shift2-1, N_st_diag + + ! Computes some states from the guess vectors + ! Psi(:,j:j+N_st_diag) = U y(:,j:j+N_st_diag) and put them + ! in U(1,shift2+1:shift2+1+N_st_diag) as temporary array + call dgemm('N','N', sze, N_st_diag, shift2, & + 1.d0, U, size(U,1), y(1,j), size(y,1), 0.d0, U(1,shift2+1), size(U,1)) + + ! Overlap + do l = 1, N_st + do k = 1, N_st_diag + do i = 1, sze + overlp(k+j-1,l) += U(i,l) * U(i,shift2+k) + enddo + enddo + enddo + + enddo + + state = 0 + do l = 1, N_st + + omax = 0d0 + idx = 0 + do k = 1, shift2 + + ! Already used ? + used = .False. + do i = 1, N_st + if (state(i) == k) then + used = .True. + endif + enddo + + ! Maximum overlap + if (dabs(overlp(k,l)) > omax .and. .not. used .and. state_ok(k)) then + omax = dabs(overlp(k,l)) + idx = k + endif + enddo + + state(l) = idx + enddo + + ! tmp array before setting state_ok + ok = .False. + do l = 1, N_st + ok(state(l)) = .True. + enddo + + do k = 1, shift2 + if (.not. ok(k)) then + state_ok(k) = .False. + endif + enddo + + deallocate(overlp,ok) + endif + do k=1,shift2 if (.not. state_ok(k)) then do l=k+1,shift2 @@ -537,46 +615,46 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ endif enddo - if (state_following) then - - overlap = -1.d0 - do k=1,shift2 - do i=1,shift2 - overlap(k,i) = dabs(y(k,i)) - enddo - enddo - do k=1,N_st - cmax = -1.d0 - do i=1,N_st - if (overlap(i,k) > cmax) then - cmax = overlap(i,k) - order(k) = i - endif - enddo - do i=1,N_st_diag - overlap(order(k),i) = -1.d0 - enddo - enddo - overlap = y - do k=1,N_st - l = order(k) - if (k /= l) then - y(1:shift2,k) = overlap(1:shift2,l) - endif - enddo - do k=1,N_st - overlap(k,1) = lambda(k) - overlap(k,2) = s2(k) - enddo - do k=1,N_st - l = order(k) - if (k /= l) then - lambda(k) = overlap(l,1) - s2(k) = overlap(l,2) - endif - enddo - - endif +! if (state_following) then +! +! overlap = -1.d0 +! do k=1,shift2 +! do i=1,shift2 +! overlap(k,i) = dabs(y(k,i)) +! enddo +! enddo +! do k=1,N_st +! cmax = -1.d0 +! do i=1,N_st +! if (overlap(i,k) > cmax) then +! cmax = overlap(i,k) +! order(k) = i +! endif +! enddo +! do i=1,N_st_diag +! overlap(order(k),i) = -1.d0 +! enddo +! enddo +! overlap = y +! do k=1,N_st +! l = order(k) +! if (k /= l) then +! y(1:shift2,k) = overlap(1:shift2,l) +! endif +! enddo +! do k=1,N_st +! overlap(k,1) = lambda(k) +! overlap(k,2) = s2(k) +! enddo +! do k=1,N_st +! l = order(k) +! if (k /= l) then +! lambda(k) = overlap(l,1) +! s2(k) = overlap(l,2) +! endif +! enddo +! +! endif ! Express eigenvectors of h in the determinant basis diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index 46ad8f78..8fbac58a 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -123,6 +123,7 @@ END_PROVIDER endif enddo + if (N_states_diag > N_states_diag_save) then N_states_diag = N_states_diag_save TOUCH N_states_diag @@ -133,24 +134,95 @@ END_PROVIDER print *, 'Diagonalization of H using Lapack' allocate (eigenvectors(size(H_matrix_all_dets,1),N_det)) allocate (eigenvalues(N_det)) + if (s2_eig) then + double precision, parameter :: alpha = 0.1d0 allocate (H_prime(N_det,N_det) ) + H_prime(1:N_det,1:N_det) = H_matrix_all_dets(1:N_det,1:N_det) + & alpha * S2_matrix_all_dets(1:N_det,1:N_det) + do j=1,N_det H_prime(j,j) = H_prime(j,j) - alpha*expected_s2 enddo + call lapack_diag(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det) call nullify_small_elements(N_det,N_det,eigenvectors,size(eigenvectors,1),1.d-12) + CI_electronic_energy(:) = 0.d0 i_state = 0 + allocate (s2_eigvalues(N_det)) allocate(index_good_state_array(N_det),good_state_array(N_det)) + good_state_array = .False. call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,& N_det,size(eigenvectors,1)) - if (only_expected_s2) then + + if (state_following) then + if (.not. only_expected_s2) then + print*,'' + print*,'!!! State following only available with only_expected_s2 = .True. !!!' + STOP + endif + if (N_det < N_states) then + print*,'' + print*,'!!! State following requires at least N_states determinants to be activated !!!' + STOP + endif + endif + + if (state_following .and. only_expected_s2) then + + integer :: state(N_states), idx,l + double precision :: overlp(N_det), omax + logical :: ok(N_det), used + + i_state = 0 + state = 0 + do l = 1, N_states + + ! Overlap wrt each state + overlp = 0d0 + do k = 1, N_det + do i = 1, N_det + overlp(k) = overlp(k) + psi_coef(i,l) * eigenvectors(i,k) + enddo + enddo + + ! Idx of the state with the maximum overlap not already "used" + omax = 0d0 + idx = 0 + do k = 1, N_det + + ! Already used ? + used = .False. + do i = 1, N_states + if (state(i) == k) then + used = .True. + endif + enddo + + ! Maximum overlap + if (dabs(overlp(k)) > omax .and. .not. used) then + if (dabs(s2_eigvalues(k)-expected_s2) > 0.5d0) cycle + omax = dabs(overlp(k)) + idx = k + endif + enddo + + state(l) = idx + i_state +=1 + enddo + + do i = 1, i_state + index_good_state_array(i) = state(i) + good_state_array(i) = .True. + enddo + + else if (only_expected_s2) then + do j=1,N_det ! Select at least n_states states with S^2 values closed to "expected_s2" if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then @@ -158,17 +230,23 @@ END_PROVIDER index_good_state_array(i_state) = j good_state_array(j) = .True. endif + if(i_state.eq.N_states) then exit endif enddo + else + do j=1,N_det index_good_state_array(j) = j good_state_array(j) = .True. enddo + endif + if(i_state .ne.0)then + ! Fill the first "i_state" states that have a correct S^2 value do j = 1, i_state do i=1,N_det @@ -177,6 +255,7 @@ END_PROVIDER CI_electronic_energy(j) = eigenvalues(index_good_state_array(j)) CI_s2(j) = s2_eigvalues(index_good_state_array(j)) enddo + i_other_state = 0 do j = 1, N_det if(good_state_array(j))cycle @@ -201,6 +280,7 @@ END_PROVIDER print*,' as the CI_eigenvectors' print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space' print*,'' + do j=1,min(N_states_diag,N_det) do i=1,N_det CI_eigenvectors(i,j) = eigenvectors(i,j) @@ -209,14 +289,18 @@ END_PROVIDER CI_s2(j) = s2_eigvalues(j) enddo endif + deallocate(index_good_state_array,good_state_array) deallocate(s2_eigvalues) + else + call lapack_diag(eigenvalues,eigenvectors, & H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) CI_electronic_energy(:) = 0.d0 call u_0_S2_u_0(CI_s2,eigenvectors,N_det,psi_det,N_int, & min(N_det,N_states_diag),size(eigenvectors,1)) + ! Select the "N_states_diag" states of lowest energy do j=1,min(N_det,N_states_diag) do i=1,N_det @@ -224,7 +308,9 @@ END_PROVIDER enddo CI_electronic_energy(j) = eigenvalues(j) enddo + endif + do k=1,N_states_diag CI_electronic_energy(k) = 0.d0 do j=1,N_det @@ -235,6 +321,7 @@ END_PROVIDER enddo enddo enddo + deallocate(eigenvectors,eigenvalues) endif From 57657cb1636cace7d49026c15bca8cb299598907 Mon Sep 17 00:00:00 2001 From: ydamour Date: Tue, 26 Mar 2024 15:22:20 +0100 Subject: [PATCH 44/64] bugfix large N_det --- src/davidson/diagonalize_ci.irp.f | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/davidson/diagonalize_ci.irp.f b/src/davidson/diagonalize_ci.irp.f index 8fbac58a..59c8313a 100644 --- a/src/davidson/diagonalize_ci.irp.f +++ b/src/davidson/diagonalize_ci.irp.f @@ -176,8 +176,12 @@ END_PROVIDER if (state_following .and. only_expected_s2) then integer :: state(N_states), idx,l - double precision :: overlp(N_det), omax - logical :: ok(N_det), used + double precision :: omax + double precision, allocatable :: overlp(:) + logical :: used + logical, allocatable :: ok(:) + + allocate(overlp(N_det), ok(N_det)) i_state = 0 state = 0 @@ -216,6 +220,8 @@ END_PROVIDER i_state +=1 enddo + deallocate(overlp, ok) + do i = 1, i_state index_good_state_array(i) = state(i) good_state_array(i) = .True. From f07db955f8c4c8151921e13686bd34cd37a8a24a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 26 Mar 2024 16:15:20 +0100 Subject: [PATCH 45/64] Fix qp_set_frozen_core --- bin/qp_set_frozen_core | 1 + 1 file changed, 1 insertion(+) diff --git a/bin/qp_set_frozen_core b/bin/qp_set_frozen_core index f9761144..d2821bd9 100755 --- a/bin/qp_set_frozen_core +++ b/bin/qp_set_frozen_core @@ -83,6 +83,7 @@ def main(arguments): elif charge <= 118: n_frozen += 43 elif arguments["--small"]: + for charge in ezfio.nuclei_nucl_charge: if charge <= 4: pass elif charge <= 18: n_frozen += 1 elif charge <= 36: n_frozen += 5 From 868988b44604ac494341e28285e78126cf9a27cc Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 27 Mar 2024 14:18:23 +0100 Subject: [PATCH 46/64] Restored PT2 print --- src/cipsi_utils/pt2_stoch_routines.irp.f | 52 +++++++++++++++++++----- 1 file changed, 42 insertions(+), 10 deletions(-) diff --git a/src/cipsi_utils/pt2_stoch_routines.irp.f b/src/cipsi_utils/pt2_stoch_routines.irp.f index c33dcfe7..100335f6 100644 --- a/src/cipsi_utils/pt2_stoch_routines.irp.f +++ b/src/cipsi_utils/pt2_stoch_routines.irp.f @@ -543,27 +543,59 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_ ! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969) if(c > 2) then eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = sqrt(eqt / (dble(c) - 1.5d0)) + eqt = dsqrt(eqt / (dble(c) - 1.5d0)) pt2_data_err % pt2(pt2_stoch_istate) = eqt eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = sqrt(eqt / (dble(c) - 1.5d0)) + eqt = dsqrt(eqt / (dble(c) - 1.5d0)) pt2_data_err % variance(pt2_stoch_istate) = eqt eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqta(:) = sqrt(eqta(:) / (dble(c) - 1.5d0)) + eqta(:) = dsqrt(eqta(:) / (dble(c) - 1.5d0)) pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:) if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then time1 = time - print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.4)', c, & - pt2_data % pt2(pt2_stoch_istate) +E, & - pt2_data_err % pt2(pt2_stoch_istate), & - pt2_data % variance(pt2_stoch_istate), & - pt2_data_err % variance(pt2_stoch_istate), & - pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate), & - pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate), & + + value1 = pt2_data % pt2(pt2_stoch_istate) + E + error1 = pt2_data_err % pt2(pt2_stoch_istate) + value2 = pt2_data % pt2(pt2_stoch_istate) + error2 = pt2_data_err % pt2(pt2_stoch_istate) + value3 = pt2_data % variance(pt2_stoch_istate) + error3 = pt2_data_err % variance(pt2_stoch_istate) + value4 = pt2_data % overlap(pt2_stoch_istate,pt2_stoch_istate) + error4 = pt2_data_err % overlap(pt2_stoch_istate,pt2_stoch_istate) + + ! Max size of the values (FX.Y) with X=size + size1 = 15 + size2 = 12 + size3 = 12 + size4 = 12 + + ! To generate the format: number(error) + call format_w_error(value1,error1,size1,8,format_value1,str_error1) + call format_w_error(value2,error2,size2,8,format_value2,str_error2) + call format_w_error(value3,error3,size3,8,format_value3,str_error3) + call format_w_error(value4,error4,size4,8,format_value4,str_error4) + + ! value > string with the right format + write(str_value1,'('//format_value1//')') value1 + write(str_value2,'('//format_value2//')') value2 + write(str_value3,'('//format_value3//')') value3 + write(str_value4,'('//format_value4//')') value4 + + ! Convergence criterion + conv_crit = dabs(pt2_data_err % pt2(pt2_stoch_istate)) / & + (1.d-20 + dabs(pt2_data % pt2(pt2_stoch_istate)) ) + write(str_conv,'(G10.3)') conv_crit + + write(*,'(I10,X,X,A20,X,A16,X,A16,X,A16,X,A12,X,F10.1)') c,& + adjustl(adjustr(str_value1)//'('//str_error1(1:1)//')'),& + adjustl(adjustr(str_value2)//'('//str_error2(1:1)//')'),& + adjustl(adjustr(str_value3)//'('//str_error3(1:1)//')'),& + adjustl(adjustr(str_value4)//'('//str_error4(1:1)//')'),& + adjustl(str_conv),& time-time0 if (stop_now .or. ( & (do_exit .and. (dabs(pt2_data_err % pt2(pt2_stoch_istate)) / & From 7a3379a43ec7924d7836fe7750b818a4e5a67634 Mon Sep 17 00:00:00 2001 From: ydamour Date: Wed, 27 Mar 2024 16:56:05 +0100 Subject: [PATCH 47/64] bugfix davidson recontraction + update --- .../diagonalization_hs2_dressed.irp.f | 22 ++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 3513f215..fd967ecc 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -139,7 +139,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ integer :: iter2, itertot double precision, allocatable :: y(:,:), h(:,:), h_p(:,:), lambda(:), s2(:) real, allocatable :: y_s(:,:) - double precision, allocatable :: s_(:,:), s_tmp(:,:) + double precision, allocatable :: s_(:,:), s_tmp(:,:), prev_y(:,:) double precision :: diag_h_mat_elem double precision, allocatable :: residual_norm(:) character*(16384) :: write_buffer @@ -288,6 +288,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ h(N_st_diag*itermax,N_st_diag*itermax), & ! h_p(N_st_diag*itermax,N_st_diag*itermax), & y(N_st_diag*itermax,N_st_diag*itermax), & + prev_y(N_st_diag*itermax,N_st_diag*itermax), & s_(N_st_diag*itermax,N_st_diag*itermax), & s_tmp(N_st_diag*itermax,N_st_diag*itermax), & residual_norm(N_st_diag), & @@ -301,6 +302,10 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ s_ = 0.d0 s_tmp = 0.d0 + prev_y = 0.d0 + do i = 1, N_st_diag*itermax + prev_y(i,i) = 1d0 + enddo ASSERT (N_st > 0) ASSERT (N_st_diag >= N_st) @@ -479,6 +484,10 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ if (info > 0) then ! Numerical errors propagate. We need to reduce the number of iterations itermax = iter-1 + + ! eigenvectors of the previous iteration + y = prev_y + shift2 = shift2 - N_st_diag exit endif @@ -553,7 +562,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ do l = 1, N_st do k = 1, N_st_diag do i = 1, sze - overlp(k+j-1,l) += U(i,l) * U(i,shift2+k) + overlp(k+j-1,l) += u_in(i,l) * U(i,shift2+k) enddo enddo enddo @@ -576,7 +585,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ enddo ! Maximum overlap - if (dabs(overlp(k,l)) > omax .and. .not. used .and. state_ok(k)) then + if ((dabs(overlp(k,l)) > omax) .and. (.not. used) .and. state_ok(k)) then omax = dabs(overlp(k,l)) idx = k endif @@ -615,6 +624,9 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ endif enddo + ! Swapped eigenvectors + prev_y = y + ! if (state_following) then ! ! overlap = -1.d0 @@ -677,7 +689,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ do i=1,sze U(i,shift2+k) = & (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & - /max(H_jj(i) - lambda (k),1.d-2) + /max(dabs(H_jj(i) - lambda (k)),1.d-2) * dsign(1d0,H_jj(i) - lambda (k)) enddo if (k <= N_st) then @@ -792,7 +804,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_ residual_norm, & U, overlap, & h, y_s, S_d, & - y, s_, s_tmp, & + y, s_, s_tmp, prev_y, & lambda & ) FREE nthreads_davidson From 4e692558a653bd1ccc36a2e19551dea8201e2ab3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 2 Apr 2024 17:41:19 +0200 Subject: [PATCH 48/64] Changed total memory to resident memory in check --- src/utils/memory.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils/memory.irp.f b/src/utils/memory.irp.f index ab85c21b..e69bf71e 100644 --- a/src/utils/memory.irp.f +++ b/src/utils/memory.irp.f @@ -107,7 +107,7 @@ subroutine check_mem(rss_in,routine) double precision, intent(in) :: rss_in character*(*) :: routine double precision :: mem - call total_memory(mem) + call resident_memory(mem) mem += rss_in if (mem > qp_max_mem) then call print_memory_usage() From d93b529b36ed27b611bcfb7196b7b51727d8be18 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 3 Apr 2024 11:49:55 +0200 Subject: [PATCH 49/64] Improve (T) --- src/ccsd/ccsd_t_space_orb_stoch.irp.f | 32 ++++++++++++++++----------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/src/ccsd/ccsd_t_space_orb_stoch.irp.f b/src/ccsd/ccsd_t_space_orb_stoch.irp.f index 13fa4f1a..293baa2d 100644 --- a/src/ccsd/ccsd_t_space_orb_stoch.irp.f +++ b/src/ccsd/ccsd_t_space_orb_stoch.irp.f @@ -181,8 +181,8 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ integer :: nbuckets nbuckets = 100 + double precision, allocatable :: ED(:) double precision, allocatable :: wsum(:) - allocate(wsum(nbuckets)) converged = .False. Ncomputed = 0_8 @@ -197,7 +197,8 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ iright = Nabc integer*8, allocatable :: bounds(:,:) - allocate (bounds(2,nbuckets)) + allocate(wsum(nbuckets), ED(nbuckets), bounds(2,nbuckets)) + ED(:) = 0.d0 do isample=1,nbuckets eta = 1.d0/dble(nbuckets) * dble(isample) ieta = binary_search(waccu,eta,Nabc) @@ -233,7 +234,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ enddo ! Deterministic part - if (imin < Nabc) then + if (imin <= Nabc) then ieta=imin sampled(ieta) = 0_8 a = abc(1,ieta) @@ -254,7 +255,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ ! Stochastic part call random_number(eta) do isample=1,nbuckets - if (imin >= bounds(2,isample)) then + if (imin > bounds(2,isample)) then cycle endif ieta = binary_search(waccu,(eta + dble(isample-1))/dble(nbuckets),Nabc)+1 @@ -280,7 +281,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ enddo call wall_time(t01) - if ((t01-t00 > 1.0d0).or.(imin >= Nabc)) then + if ((t01-t00 > 1.0d0).or.(imin > Nabc)) then !$OMP TASKWAIT call wall_time(t01) @@ -300,8 +301,11 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ do isample=1,nbuckets - if (imin >= bounds(2,isample)) then - energy_det = energy_det + sum(memo(bounds(1,isample):bounds(2,isample))) + if (imin > bounds(2,isample)) then + if (ED(isample) == 0.d0) then + ED(isample) = sum(memo(bounds(1,isample):bounds(2,isample))) + endif + energy_det = energy_det + ED(isample) scale = scale - wsum(isample) else exit @@ -310,12 +314,14 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ isample = min(isample,nbuckets) do ieta=bounds(1,isample), Nabc - w = dble(max(sampled(ieta),0_8)) - tmp = w * memo(ieta) * Pabc(ieta) - ET = ET + tmp - ET2 = ET2 + tmp * memo(ieta) * Pabc(ieta) - norm = norm + w + if (sampled(ieta) < 0_8) cycle + w = dble(sampled(ieta)) + tmp = w * memo(ieta) * Pabc(ieta) + ET = ET + tmp + ET2 = ET2 + tmp * memo(ieta) * Pabc(ieta) + norm = norm + w enddo + norm = norm/scale if (norm > 0.d0) then energy_stoch = ET / norm @@ -327,7 +333,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ print '('' '',F20.8, '' '', ES12.4,'' '', F8.2,'' '')', eccsd+energy, dsqrt(variance/(norm-1.d0)), 100.*real(Ncomputed)/real(Nabc) endif !$OMP END MASTER - if (imin >= Nabc) exit + if (imin > Nabc) exit enddo !$OMP END PARALLEL From e4ce9ef2193529ff1887d7ec62abb2233869f50f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 3 Apr 2024 15:32:56 +0200 Subject: [PATCH 50/64] Upgrade trexio version in configure --- configure | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/configure b/configure index e211cfd7..41c0123d 100755 --- a/configure +++ b/configure @@ -9,7 +9,7 @@ echo "QP_ROOT="$QP_ROOT unset CC unset CCXX -TREXIO_VERSION=2.3.2 +TREXIO_VERSION=2.4.2 # Force GCC instead of ICC for dependencies export CC=gcc @@ -219,7 +219,7 @@ EOF tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz cd trexio-${VERSION} ./configure --prefix=\${QP_ROOT} --without-hdf5 CFLAGS='-g' - make -j 8 && make -j 8 check && make -j 8 install + (make -j 8 || make) && make check && make -j 8 install tar -zxvf "\${QP_ROOT}"/external/qp2-dependencies/${ARCHITECTURE}/ninja.tar.gz mv ninja "\${QP_ROOT}"/bin/ EOF @@ -233,7 +233,7 @@ EOF tar -zxf trexio-${VERSION}.tar.gz && rm trexio-${VERSION}.tar.gz cd trexio-${VERSION} ./configure --prefix=\${QP_ROOT} CFLAGS="-g" - make -j 8 && make -j 8 check && make -j 8 install + (make -j 8 || make) && make check && make -j 8 install EOF elif [[ ${PACKAGE} = qmckl ]] ; then @@ -245,7 +245,7 @@ EOF tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz cd qmckl-${VERSION} ./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc CFLAGS='-g' - make && make -j 4 check && make install + (make -j 8 || make) && make check && make install EOF elif [[ ${PACKAGE} = qmckl-intel ]] ; then @@ -257,7 +257,7 @@ EOF tar -zxf qmckl-${VERSION}.tar.gz && rm qmckl-${VERSION}.tar.gz cd qmckl-${VERSION} ./configure --prefix=\${QP_ROOT} --enable-hpc --disable-doc --with-icc --with-ifort CFLAGS='-g' - make && make -j 4 check && make install + (make -j 8 || make) && make check && make install EOF From b22c835ec8d415c7cecfa76ab98ea6ed9f4903f2 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 3 Apr 2024 16:59:15 +0200 Subject: [PATCH 51/64] Add nthreads_pt2 to (T) --- src/ccsd/ccsd_t_space_orb_stoch.irp.f | 4 +++- src/{cipsi_utils => ezfio_files}/environment.irp.f | 0 2 files changed, 3 insertions(+), 1 deletion(-) rename src/{cipsi_utils => ezfio_files}/environment.irp.f (100%) diff --git a/src/ccsd/ccsd_t_space_orb_stoch.irp.f b/src/ccsd/ccsd_t_space_orb_stoch.irp.f index 293baa2d..618d50e4 100644 --- a/src/ccsd/ccsd_t_space_orb_stoch.irp.f +++ b/src/ccsd/ccsd_t_space_orb_stoch.irp.f @@ -110,6 +110,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ double precision :: eocc double precision :: norm integer :: isample + PROVIDE nthreads_pt2 ! Prepare table of triplets (a,b,c) @@ -216,11 +217,12 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ print '(A)', ' ======================= ============== ==========' + call set_multiple_levels_omp(.False.) call wall_time(t00) imin = 1_8 !$OMP PARALLEL & !$OMP PRIVATE(ieta,eta,a,b,c,kiter,isample) & - !$OMP DEFAULT(SHARED) + !$OMP DEFAULT(SHARED) NUM_THREADS(nthreads_pt2) do kiter=1,Nabc diff --git a/src/cipsi_utils/environment.irp.f b/src/ezfio_files/environment.irp.f similarity index 100% rename from src/cipsi_utils/environment.irp.f rename to src/ezfio_files/environment.irp.f From 0c8845f5f208e1c405a6aa5aba1ceb276ddbdcdf Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 4 Apr 2024 15:06:30 +0200 Subject: [PATCH 52/64] Fix qp_convert --- bin/qp_convert_output_to_ezfio | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/qp_convert_output_to_ezfio b/bin/qp_convert_output_to_ezfio index 1b33f156..6f2d02d0 100755 --- a/bin/qp_convert_output_to_ezfio +++ b/bin/qp_convert_output_to_ezfio @@ -227,8 +227,8 @@ def write_ezfio(res, filename): shell_index += [nshell_tot] * len(b.prim) shell_num = len(ang_mom) - assert(shell_index[0] = 1) - assert(shell_index[-1] = shell_num) + assert(shell_index[0] == 1) + assert(shell_index[-1] == shell_num) # ~#~#~#~#~ # # W r i t e # From 43648cddb04771bf269e791d76cec68b742f27f1 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 5 Apr 2024 14:24:42 +0200 Subject: [PATCH 53/64] Fixed qp_plugins update --- bin/qp_plugins | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bin/qp_plugins b/bin/qp_plugins index e53b08e9..b1fbeec0 100755 --- a/bin/qp_plugins +++ b/bin/qp_plugins @@ -97,7 +97,7 @@ end def get_repositories(): l_result = [f for f in os.listdir(QP_PLUGINS) \ - if f not in [".gitignore", "local"] ] + if f not in [".gitignore", "local", "README.rst"] ] return sorted(l_result) From 6848470850c946da9a3b1b8af0d6037fd9d5de92 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 5 Apr 2024 14:25:32 +0200 Subject: [PATCH 54/64] Fix underflow in EZFIO --- src/mo_basis/utils.irp.f | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/mo_basis/utils.irp.f b/src/mo_basis/utils.irp.f index 5f664c41..987c394a 100644 --- a/src/mo_basis/utils.irp.f +++ b/src/mo_basis/utils.irp.f @@ -228,7 +228,11 @@ subroutine mo_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,eig,label) 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)) do i=1,m - eig(i) = D(i) + if (eig(i) > 1.d-20) then + eig(i) = D(i) + else + eig(i) = 0.d0 + endif enddo deallocate(A,mo_coef_new,U,Vt,D) From 8e0a9be9ad3a5e21b5b3c05c7e78e4a4fff8960e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 5 Apr 2024 14:25:45 +0200 Subject: [PATCH 55/64] Add metadata to TREXIO --- src/trexio/export_trexio_routines.irp.f | 54 ++++++++++++++++++++++++- 1 file changed, 53 insertions(+), 1 deletion(-) diff --git a/src/trexio/export_trexio_routines.irp.f b/src/trexio/export_trexio_routines.irp.f index 034b142e..63630243 100644 --- a/src/trexio/export_trexio_routines.irp.f +++ b/src/trexio/export_trexio_routines.irp.f @@ -59,7 +59,59 @@ subroutine export_trexio(update,full_path) enddo call ezfio_set_trexio_trexio_file(trexio_filename) - + + +! ------------------------------------------------------------------------------ + +! Metadata +! -------- + + integer :: code_num, author_num + character*(64) :: code(100), author(100), user + character*(64), parameter :: qp2_code = "QuantumPackage" + + call getenv("USER",user) + do k=1,N_states + rc = trexio_read_metadata_code_num(f(k), code_num) + if (rc == TREXIO_ATTR_MISSING) then + i = 1 + code(:) = "" + else + rc = trexio_read_metadata_code(f(k), code, 64) + do i=1, code_num + if (trim(code(i)) == trim(qp2_code)) then + exit + endif + enddo + endif + if (i == code_num+1) then + code(i) = qp2_code + rc = trexio_write_metadata_code_num(f(k), i) + call trexio_assert(rc, TREXIO_SUCCESS) + rc = trexio_write_metadata_code(f(k), code, 64) + call trexio_assert(rc, TREXIO_SUCCESS) + endif + + rc = trexio_read_metadata_author_num(f(k), author_num) + if (rc == TREXIO_ATTR_MISSING) then + i = 1 + author(:) = "" + else + rc = trexio_read_metadata_author(f(k), author, 64) + do i=1, author_num + if (trim(author(i)) == trim(user)) then + exit + endif + enddo + endif + if (i == author_num+1) then + author(i) = user + rc = trexio_write_metadata_author_num(f(k), i) + call trexio_assert(rc, TREXIO_SUCCESS) + rc = trexio_write_metadata_author(f(k), author, 64) + call trexio_assert(rc, TREXIO_SUCCESS) + endif + enddo ! ------------------------------------------------------------------------------ From 88cffcb26999f685b9c7ef78d61bb71961cf3d9d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 5 Apr 2024 17:51:48 +0200 Subject: [PATCH 56/64] Force MOs to be on axes. Nice for atoms --- src/ao_one_e_ints/ao_ortho_canonical.irp.f | 2 ++ src/scf_utils/diagonalize_fock.irp.f | 2 +- src/scf_utils/roothaan_hall_scf.irp.f | 26 +++++++++++++++++++--- 3 files changed, 26 insertions(+), 4 deletions(-) diff --git a/src/ao_one_e_ints/ao_ortho_canonical.irp.f b/src/ao_one_e_ints/ao_ortho_canonical.irp.f index 668b920d..eff7e7be 100644 --- a/src/ao_one_e_ints/ao_ortho_canonical.irp.f +++ b/src/ao_one_e_ints/ao_ortho_canonical.irp.f @@ -138,6 +138,8 @@ END_PROVIDER deallocate(S) endif + FREE ao_overlap + END_PROVIDER BEGIN_PROVIDER [double precision, ao_ortho_canonical_overlap, (ao_ortho_canonical_num,ao_ortho_canonical_num)] diff --git a/src/scf_utils/diagonalize_fock.irp.f b/src/scf_utils/diagonalize_fock.irp.f index 5188581a..b9042b29 100644 --- a/src/scf_utils/diagonalize_fock.irp.f +++ b/src/scf_utils/diagonalize_fock.irp.f @@ -47,7 +47,7 @@ BEGIN_PROVIDER [ double precision, eigenvectors_Fock_matrix_mo, (ao_num,mo_num) do j = 1, n_core_orb jorb = list_core(j) F(iorb,jorb) = 0.d0 - F(jorb,iorb) = 0.d0 + F(jorb,iorb) = 0.d0 enddo enddo endif diff --git a/src/scf_utils/roothaan_hall_scf.irp.f b/src/scf_utils/roothaan_hall_scf.irp.f index 730cb496..3f5c8549 100644 --- a/src/scf_utils/roothaan_hall_scf.irp.f +++ b/src/scf_utils/roothaan_hall_scf.irp.f @@ -13,9 +13,9 @@ END_DOC integer :: iteration_SCF,dim_DIIS,index_dim_DIIS logical :: converged - integer :: i,j + integer :: i,j,m logical, external :: qp_stop - double precision, allocatable :: mo_coef_save(:,:) + double precision, allocatable :: mo_coef_save(:,:), S(:,:) PROVIDE ao_md5 mo_occ level_shift @@ -208,9 +208,29 @@ END_DOC size(Fock_matrix_mo,2),mo_label,1,.true.) call restore_symmetry(ao_num, mo_num, mo_coef, size(mo_coef,1), 1.d-10) call orthonormalize_mos - call save_mos endif + + ! Identify degenerate MOs and force them on the axes + allocate(S(ao_num,ao_num)) + i=1 + do while (i1) then + call dgemm('N','T',ao_num,ao_num,m,1.d0,mo_coef(1,i),size(mo_coef,1),mo_coef(1,i),size(mo_coef,1),0.d0,S,size(S,1)) + call pivoted_cholesky( S, m, -1.d0, ao_num, mo_coef(1,i)) + endif + i = j+1 + enddo + + + call save_mos + call write_double(6, Energy_SCF, 'SCF energy') call write_time(6) From 43b83ee8e9fc93de3675b36cc04592a81c9f33b4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 9 Apr 2024 12:34:35 +0200 Subject: [PATCH 57/64] Better error message --- scripts/compilation/qp_create_ninja | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/scripts/compilation/qp_create_ninja b/scripts/compilation/qp_create_ninja index e67d896b..75b50c82 100755 --- a/scripts/compilation/qp_create_ninja +++ b/scripts/compilation/qp_create_ninja @@ -802,8 +802,12 @@ if __name__ == "__main__": pickle_path = os.path.join(QP_ROOT, "config", "qp_create_ninja.pickle") if arguments["update"]: + try: with open(pickle_path, 'rb') as handle: arguments = pickle.load(handle) + except FileNotFoundError: + print("\n-----\nError: Please run 'configure -c config/'\n-----\n") + raise elif arguments["create"]: From 4fe07d97b099d96c36192603f2af4f70938b7eb0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 9 Apr 2024 12:41:53 +0200 Subject: [PATCH 58/64] Added MP2 program --- src/mp2/H_apply.irp.f | 15 +++++++++++++++ src/mp2/NEED | 6 ++++++ src/mp2/README.rst | 4 ++++ src/mp2/mp2.irp.f | 21 +++++++++++++++++++++ 4 files changed, 46 insertions(+) create mode 100644 src/mp2/H_apply.irp.f create mode 100644 src/mp2/NEED create mode 100644 src/mp2/README.rst create mode 100644 src/mp2/mp2.irp.f diff --git a/src/mp2/H_apply.irp.f b/src/mp2/H_apply.irp.f new file mode 100644 index 00000000..471dde50 --- /dev/null +++ b/src/mp2/H_apply.irp.f @@ -0,0 +1,15 @@ +use bitmasks +BEGIN_SHELL [ /usr/bin/env python3 ] +from generate_h_apply import * +from perturbation import perturbations + +s = H_apply("mp2") +s.set_perturbation("Moller_plesset") +#s.set_perturbation("epstein_nesbet") +print(s) + +s = H_apply("mp2_selection") +s.set_selection_pt2("Moller_Plesset") +print(s) +END_SHELL + diff --git a/src/mp2/NEED b/src/mp2/NEED new file mode 100644 index 00000000..6eaf5b93 --- /dev/null +++ b/src/mp2/NEED @@ -0,0 +1,6 @@ +generators_full +selectors_full +determinants +davidson +davidson_undressed +perturbation diff --git a/src/mp2/README.rst b/src/mp2/README.rst new file mode 100644 index 00000000..192a75f1 --- /dev/null +++ b/src/mp2/README.rst @@ -0,0 +1,4 @@ +=== +mp2 +=== + diff --git a/src/mp2/mp2.irp.f b/src/mp2/mp2.irp.f new file mode 100644 index 00000000..b8e0cc4a --- /dev/null +++ b/src/mp2/mp2.irp.f @@ -0,0 +1,21 @@ +program mp2 + call run +end + +subroutine run + implicit none + double precision, allocatable :: pt2(:), norm_pert(:) + double precision :: H_pert_diag, E_old + integer :: N_st, iter + PROVIDE Fock_matrix_diag_mo H_apply_buffer_allocated + N_st = N_states + allocate (pt2(N_st), norm_pert(N_st)) + E_old = HF_energy + call H_apply_mp2(pt2, norm_pert, H_pert_diag, N_st) + print *, 'N_det = ', N_det + print *, 'N_states = ', N_states + print *, 'MP2 = ', pt2 + print *, 'E = ', E_old + print *, 'E+MP2 = ', E_old+pt2 + deallocate(pt2,norm_pert) +end From e35e65ea2ce077434068fdc0e7b04aac4add2536 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 17 Apr 2024 11:40:00 +0200 Subject: [PATCH 59/64] Abs in CCSD --- Makefile | 2 +- src/ccsd/ccsd_t_space_orb_stoch.irp.f | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/Makefile b/Makefile index 0be38b3c..d9c9eb47 100644 --- a/Makefile +++ b/Makefile @@ -2,4 +2,4 @@ default: build.ninja bash -c "source quantum_package.rc ; ninja" build.ninja: - @bash -c ' echo '' ; echo xxxxxxxxxxxxxxxxxx ; echo "The QP is not configured yet. Please run the ./configure command" ; echo xxxxxxxxxxxxxxxxxx ; echo '' ; ./configure --help' | more + @bash -c ' echo '' ; echo xxxxxxxxxxxxxxxxxx ; echo "QP is not configured yet. Please run the ./configure command" ; echo xxxxxxxxxxxxxxxxxx ; echo '' ; ./configure --help' | more diff --git a/src/ccsd/ccsd_t_space_orb_stoch.irp.f b/src/ccsd/ccsd_t_space_orb_stoch.irp.f index 618d50e4..2aa134d1 100644 --- a/src/ccsd/ccsd_t_space_orb_stoch.irp.f +++ b/src/ccsd/ccsd_t_space_orb_stoch.irp.f @@ -125,7 +125,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ do b = a+1, nV do c = b+1, nV Nabc = Nabc + 1_8 - Pabc(Nabc) = -1.d0/(f_v(a) + f_v(b) + f_v(c)) + Pabc(Nabc) = 1.d0/(f_v(a) + f_v(b) + f_v(c)) abc(1,Nabc) = int(a,2) abc(2,Nabc) = int(b,2) abc(3,Nabc) = int(c,2) @@ -135,13 +135,13 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ abc(1,Nabc) = int(a,2) abc(2,Nabc) = int(b,2) abc(3,Nabc) = int(a,2) - Pabc(Nabc) = -1.d0/(2.d0*f_v(a) + f_v(b)) + Pabc(Nabc) = 1.d0/(2.d0*f_v(a) + f_v(b)) Nabc = Nabc + 1_8 abc(1,Nabc) = int(b,2) abc(2,Nabc) = int(a,2) abc(3,Nabc) = int(b,2) - Pabc(Nabc) = -1.d0/(f_v(a) + 2.d0*f_v(b)) + Pabc(Nabc) = 1.d0/(f_v(a) + 2.d0*f_v(b)) enddo enddo @@ -150,6 +150,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ enddo ! Sort triplets in decreasing Pabc + Pabc(:) = -dabs(Pabc(:)) call dsort_big(Pabc, iorder, Nabc) ! Normalize From cf479a80afc02dd1f9ff534937052afe5ae64cd9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 17 Apr 2024 18:06:53 +0200 Subject: [PATCH 60/64] Avoid divergence in (T) --- src/ccsd/ccsd_t_space_orb_stoch.irp.f | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/ccsd/ccsd_t_space_orb_stoch.irp.f b/src/ccsd/ccsd_t_space_orb_stoch.irp.f index 2aa134d1..1093c59d 100644 --- a/src/ccsd/ccsd_t_space_orb_stoch.irp.f +++ b/src/ccsd/ccsd_t_space_orb_stoch.irp.f @@ -125,7 +125,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ do b = a+1, nV do c = b+1, nV Nabc = Nabc + 1_8 - Pabc(Nabc) = 1.d0/(f_v(a) + f_v(b) + f_v(c)) + Pabc(Nabc) = f_v(a) + f_v(b) + f_v(c) abc(1,Nabc) = int(a,2) abc(2,Nabc) = int(b,2) abc(3,Nabc) = int(c,2) @@ -135,13 +135,13 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ abc(1,Nabc) = int(a,2) abc(2,Nabc) = int(b,2) abc(3,Nabc) = int(a,2) - Pabc(Nabc) = 1.d0/(2.d0*f_v(a) + f_v(b)) + Pabc(Nabc) = 2.d0*f_v(a) + f_v(b) Nabc = Nabc + 1_8 abc(1,Nabc) = int(b,2) abc(2,Nabc) = int(a,2) abc(3,Nabc) = int(b,2) - Pabc(Nabc) = 1.d0/(f_v(a) + 2.d0*f_v(b)) + Pabc(Nabc) = f_v(a) + 2.d0*f_v(b) enddo enddo @@ -150,7 +150,7 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ enddo ! Sort triplets in decreasing Pabc - Pabc(:) = -dabs(Pabc(:)) + Pabc(:) = -1.d0/max(0.2d0,Pabc(:)) call dsort_big(Pabc, iorder, Nabc) ! Normalize @@ -165,7 +165,6 @@ subroutine ccsd_par_t_space_stoch(nO,nV,t1,t2,f_o,f_v,v_vvvo,v_vvoo,v_vooo,energ call i8set_order_big(abc, iorder, Nabc) - ! Cumulative distribution for sampling waccu(Nabc) = 0.d0 do i8=Nabc-1,1,-1 From 4f293298c345c30470cab0c79b4de4b38f4fb851 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 22 Apr 2024 10:45:31 +0200 Subject: [PATCH 61/64] Updated irpf90 --- external/irpf90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/irpf90 b/external/irpf90 index 4ab1b175..76946321 160000 --- a/external/irpf90 +++ b/external/irpf90 @@ -1 +1 @@ -Subproject commit 4ab1b175fc7ed0d96c1912f13dc53579b24157a6 +Subproject commit 76946321d64b0be58933a6f37d6a0781b96dff86 From c8b91f980eb54b78fe127d87727abe493065b08b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 22 Apr 2024 10:58:42 +0200 Subject: [PATCH 62/64] Updated irpf90 --- external/irpf90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/irpf90 b/external/irpf90 index 76946321..451c93a5 160000 --- a/external/irpf90 +++ b/external/irpf90 @@ -1 +1 @@ -Subproject commit 76946321d64b0be58933a6f37d6a0781b96dff86 +Subproject commit 451c93a52c1ca3f78ce2f0e4add773d6e44e561a From ecfdaf9eea971db1f0ce8df598670a67a45dc86b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 22 Apr 2024 11:03:26 +0200 Subject: [PATCH 63/64] Updated irpf90 --- external/irpf90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/irpf90 b/external/irpf90 index 451c93a5..beac6153 160000 --- a/external/irpf90 +++ b/external/irpf90 @@ -1 +1 @@ -Subproject commit 451c93a52c1ca3f78ce2f0e4add773d6e44e561a +Subproject commit beac615343f421bd6c0571a408ba389a6d5a32ac From f35bc230368a954e351c5e64dd3e9e19d5978023 Mon Sep 17 00:00:00 2001 From: eginer Date: Wed, 24 Apr 2024 14:48:23 +0200 Subject: [PATCH 64/64] Begining to make some cleaning in TC --- .../local/bi_ort_ints/total_twoe_pot.irp.f | 22 +++++++++++++++++++ plugins/local/mo_localization/README.md | 2 +- .../normal_ordered.irp.f | 0 .../normal_ordered_contractions.irp.f | 0 .../normal_ordered_old.irp.f | 0 .../normal_ordered_v0.irp.f | 0 .../h_biortho.irp.f | 0 .../h_mat_triple.irp.f | 0 .../h_tc_bi_ortho_psi.irp.f | 0 .../h_tc_s2_u0.irp.f | 0 .../slater_tc_3e_slow.irp.f | 0 .../slater_tc_opt.irp.f | 0 .../slater_tc_opt_diag.irp.f | 0 .../slater_tc_opt_double.irp.f | 0 .../slater_tc_opt_single.irp.f | 0 .../slater_tc_slow.irp.f | 0 .../{tc_bi_ortho => slater_tc}/tc_hmat.irp.f | 0 plugins/local/tc_bi_ortho/NEED | 6 +---- 18 files changed, 24 insertions(+), 6 deletions(-) rename plugins/local/{tc_bi_ortho => normal_order_old}/normal_ordered.irp.f (100%) rename plugins/local/{tc_bi_ortho => normal_order_old}/normal_ordered_contractions.irp.f (100%) rename plugins/local/{tc_bi_ortho => normal_order_old}/normal_ordered_old.irp.f (100%) rename plugins/local/{tc_bi_ortho => normal_order_old}/normal_ordered_v0.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/h_biortho.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/h_mat_triple.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/h_tc_bi_ortho_psi.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/h_tc_s2_u0.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/slater_tc_3e_slow.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/slater_tc_opt.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/slater_tc_opt_diag.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/slater_tc_opt_double.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/slater_tc_opt_single.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/slater_tc_slow.irp.f (100%) rename plugins/local/{tc_bi_ortho => slater_tc}/tc_hmat.irp.f (100%) diff --git a/plugins/local/bi_ort_ints/total_twoe_pot.irp.f b/plugins/local/bi_ort_ints/total_twoe_pot.irp.f index 5e6a24e9..42a7ba62 100644 --- a/plugins/local/bi_ort_ints/total_twoe_pot.irp.f +++ b/plugins/local/bi_ort_ints/total_twoe_pot.irp.f @@ -176,6 +176,28 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num, END_PROVIDER +BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_transp, (mo_num, mo_num, mo_num, mo_num)] + implicit none + BEGIN_DOC + ! + ! mo_bi_ortho_tc_two_e_transp(i,j,k,l) = = transpose of mo_bi_ortho_tc_two_e + ! + ! the potential V(r_12) contains ALL TWO-E CONTRIBUTION OF THE TC-HAMILTONIAN + ! + END_DOC + + integer :: i,j,k,l + do i = 1, mo_num + do j = 1, mo_num + do k = 1, mo_num + do l = 1, mo_num + mo_bi_ortho_tc_two_e_transp(i,j,k,l) = mo_bi_ortho_tc_two_e_transp(k,l,i,j) + enddo + enddo + enddo + enddo + +END_PROVIDER ! --- BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num)] diff --git a/plugins/local/mo_localization/README.md b/plugins/local/mo_localization/README.md index c28a5ee1..512e36af 100644 --- a/plugins/local/mo_localization/README.md +++ b/plugins/local/mo_localization/README.md @@ -3,7 +3,7 @@ To localize the MOs: ``` qp run localization ``` -By default, the different otbital classes are automatically set by splitting +By default, the different orbital classes are automatically set by splitting the orbitales in the following classes: - Core -> Core - Active, doubly occupied -> Inactive diff --git a/plugins/local/tc_bi_ortho/normal_ordered.irp.f b/plugins/local/normal_order_old/normal_ordered.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/normal_ordered.irp.f rename to plugins/local/normal_order_old/normal_ordered.irp.f diff --git a/plugins/local/tc_bi_ortho/normal_ordered_contractions.irp.f b/plugins/local/normal_order_old/normal_ordered_contractions.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/normal_ordered_contractions.irp.f rename to plugins/local/normal_order_old/normal_ordered_contractions.irp.f diff --git a/plugins/local/tc_bi_ortho/normal_ordered_old.irp.f b/plugins/local/normal_order_old/normal_ordered_old.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/normal_ordered_old.irp.f rename to plugins/local/normal_order_old/normal_ordered_old.irp.f diff --git a/plugins/local/tc_bi_ortho/normal_ordered_v0.irp.f b/plugins/local/normal_order_old/normal_ordered_v0.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/normal_ordered_v0.irp.f rename to plugins/local/normal_order_old/normal_ordered_v0.irp.f diff --git a/plugins/local/tc_bi_ortho/h_biortho.irp.f b/plugins/local/slater_tc/h_biortho.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/h_biortho.irp.f rename to plugins/local/slater_tc/h_biortho.irp.f diff --git a/plugins/local/tc_bi_ortho/h_mat_triple.irp.f b/plugins/local/slater_tc/h_mat_triple.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/h_mat_triple.irp.f rename to plugins/local/slater_tc/h_mat_triple.irp.f diff --git a/plugins/local/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f b/plugins/local/slater_tc/h_tc_bi_ortho_psi.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f rename to plugins/local/slater_tc/h_tc_bi_ortho_psi.irp.f diff --git a/plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f b/plugins/local/slater_tc/h_tc_s2_u0.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f rename to plugins/local/slater_tc/h_tc_s2_u0.irp.f diff --git a/plugins/local/tc_bi_ortho/slater_tc_3e_slow.irp.f b/plugins/local/slater_tc/slater_tc_3e_slow.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/slater_tc_3e_slow.irp.f rename to plugins/local/slater_tc/slater_tc_3e_slow.irp.f diff --git a/plugins/local/tc_bi_ortho/slater_tc_opt.irp.f b/plugins/local/slater_tc/slater_tc_opt.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/slater_tc_opt.irp.f rename to plugins/local/slater_tc/slater_tc_opt.irp.f diff --git a/plugins/local/tc_bi_ortho/slater_tc_opt_diag.irp.f b/plugins/local/slater_tc/slater_tc_opt_diag.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/slater_tc_opt_diag.irp.f rename to plugins/local/slater_tc/slater_tc_opt_diag.irp.f diff --git a/plugins/local/tc_bi_ortho/slater_tc_opt_double.irp.f b/plugins/local/slater_tc/slater_tc_opt_double.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/slater_tc_opt_double.irp.f rename to plugins/local/slater_tc/slater_tc_opt_double.irp.f diff --git a/plugins/local/tc_bi_ortho/slater_tc_opt_single.irp.f b/plugins/local/slater_tc/slater_tc_opt_single.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/slater_tc_opt_single.irp.f rename to plugins/local/slater_tc/slater_tc_opt_single.irp.f diff --git a/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f b/plugins/local/slater_tc/slater_tc_slow.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/slater_tc_slow.irp.f rename to plugins/local/slater_tc/slater_tc_slow.irp.f diff --git a/plugins/local/tc_bi_ortho/tc_hmat.irp.f b/plugins/local/slater_tc/tc_hmat.irp.f similarity index 100% rename from plugins/local/tc_bi_ortho/tc_hmat.irp.f rename to plugins/local/slater_tc/tc_hmat.irp.f diff --git a/plugins/local/tc_bi_ortho/NEED b/plugins/local/tc_bi_ortho/NEED index 9a0c20ef..01841e02 100644 --- a/plugins/local/tc_bi_ortho/NEED +++ b/plugins/local/tc_bi_ortho/NEED @@ -1,6 +1,2 @@ -bi_ort_ints -bi_ortho_mos -tc_keywords -non_hermit_dav -dav_general_mat tc_scf +slater_tc