diff --git a/.travis.yml b/.travis.yml index 57991ba3..22cd358e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -9,12 +9,12 @@ sudo: false addons: apt: packages: - - zlib1g-dev - - libgmp3-dev - gfortran - gcc - liblapack-dev - graphviz +# - zlib1g-dev +# - libgmp3-dev cache: directories: @@ -29,4 +29,4 @@ script: - source ./quantum_package.rc ; qp_module.py install Full_CI Full_CI_ZMQ Hartree_Fock CAS_SD_ZMQ mrcepa0 All_singles - source ./quantum_package.rc ; ninja - source ./quantum_package.rc ; cd ocaml ; make ; cd - - - source ./quantum_package.rc ; cd tests ; ./run_tests.sh #-v + - source ./quantum_package.rc ; cd tests ; ./run_tests.sh -v diff --git a/README.md b/README.md index bb63b691..c9e1b12d 100644 --- a/README.md +++ b/README.md @@ -24,7 +24,7 @@ Demo * Python >= 2.6 * GNU make * Bash -* Blast/Lapack +* Blas/Lapack * unzip * g++ (For ninja) @@ -137,6 +137,10 @@ interface: ezfio #FAQ +### Opam error: cryptokit + +You need to install `gmp-dev`. + ### Error: ezfio_* is already defined. #### Why ? diff --git a/configure b/configure index 8cb02608..85285f9b 100755 --- a/configure +++ b/configure @@ -71,8 +71,8 @@ d_dependency = { "emsl": ["python"], "gcc": [], "g++": [], - "zeromq" : [ "g++" ], - "f77zmq" : [ "zeromq", "python" ], + "zeromq" : [ "g++", "make" ], + "f77zmq" : [ "zeromq", "python", "make" ], "python": [], "ninja": ["g++", "python"], "make": [], @@ -102,7 +102,7 @@ curl = Info( default_path=join(QP_ROOT_BIN, "curl")) zlib = Info( - url='http://zlib.net/zlib-1.2.8.tar.gz', + url='http://www.zlib.net/zlib-1.2.11.tar.gz', description=' zlib', default_path=join(QP_ROOT_LIB, "libz.a")) @@ -150,7 +150,6 @@ f77zmq = Info( url='{head}/zeromq/f77_zmq/{tail}'.format(**path_github), description=' F77-ZeroMQ', default_path=join(QP_ROOT_LIB, "libf77zmq.a") ) -# join(QP_ROOT, "src", "ZMQ", "f77zmq.h") ) p_graphviz = Info( url='https://github.com/xflr6/graphviz/archive/master.tar.gz', @@ -166,7 +165,7 @@ d_info = dict() for m in ["ocaml", "m4", "curl", "zlib", "patch", "irpf90", "docopt", "resultsFile", "ninja", "emsl", "ezfio", "p_graphviz", - "zeromq", "f77zmq","bats" ]: + "zeromq", "f77zmq","bats"]: exec ("d_info['{0}']={0}".format(m)) @@ -494,16 +493,24 @@ def create_ninja_and_rc(l_installed): 'export PYTHONPATH="${QP_EZFIO}/Python":"${QP_PYTHON}":"${PYTHONPATH}"', 'export PATH="${QP_PYTHON}":"${QP_ROOT}"/bin:"${QP_ROOT}"/ocaml:"${PATH}"', 'export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}"', - 'export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"', "", - 'source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh', "", - 'source ${HOME}/.opam/opam-init/init.sh > /dev/null 2> /dev/null || true', + 'export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}"', + 'export C_INCLUDE_PATH="${C_INCLUDE_PATH}":"${QP_ROOT}"/include', + '', + 'source ${QP_ROOT}/install/EZFIO/Bash/ezfio.sh', '', '# Choose the correct network interface', '# export QP_NIC=ib0', '# export QP_NIC=eth0', - "" + '' ] + qp_opam_root = os.getenv('OPAMROOT') + if not qp_opam_root: + qp_opam_root = '${HOME}/.opam' + l_rc.append('export QP_OPAM={0}'.format(qp_opam_root)) + l_rc.append('source ${QP_OPAM}/opam-init/init.sh > /dev/null 2> /dev/null || true') + l_rc.append('') + path = join(QP_ROOT, "quantum_package.rc") with open(path, "w+") as f: f.write("\n".join(l_rc)) diff --git a/include/.empty b/include/.empty new file mode 100644 index 00000000..e69de29b diff --git a/install/scripts/build.sh b/install/scripts/build.sh index 79a71065..5071b5aa 100755 --- a/install/scripts/build.sh +++ b/install/scripts/build.sh @@ -4,7 +4,11 @@ BUILD=_build/${TARGET} rm -rf -- ${BUILD} mkdir ${BUILD} || exit 1 -tar -zxf Downloads/${TARGET}.tar.gz --strip-components=1 --directory=${BUILD} || exit 1 +if [[ -f Downloads/${TARGET}.tar.gz ]] ; then + tar -zxf Downloads/${TARGET}.tar.gz --strip-components=1 --directory=${BUILD} || exit 1 +elif [[ -f Downloads/${TARGET}.tar.bz2 ]] ; then + tar -jxf Downloads/${TARGET}.tar.bz2 --strip-components=1 --directory=${BUILD} || exit 1 +fi _install || exit 1 rm -rf -- ${BUILD} _build/${TARGET}.log exit 0 diff --git a/install/scripts/install_curl.sh b/install/scripts/install_curl.sh index c3a48024..6194a0e0 100755 --- a/install/scripts/install_curl.sh +++ b/install/scripts/install_curl.sh @@ -10,10 +10,4 @@ function _install() mv curl.ermine ${QP_ROOT}/bin/curl || return 1 } -BUILD=_build/${TARGET} -rm -rf -- ${BUILD} -mkdir ${BUILD} || exit 1 -tar -xvjf Downloads/${TARGET}.tar.bz2 --strip-components=1 --directory=${BUILD} || exit 1 -_install || exit 1 -rm -rf -- ${BUILD} _build/${TARGET}.log -exit 0 \ No newline at end of file +source scripts/build.sh diff --git a/install/scripts/install_f77zmq.sh b/install/scripts/install_f77zmq.sh index 8357857c..92388337 100755 --- a/install/scripts/install_f77zmq.sh +++ b/install/scripts/install_f77zmq.sh @@ -7,10 +7,9 @@ function _install() cd .. QP_ROOT=$PWD cd - - export C_INCLUDE_PATH="${C_INCLUDE_PATH}":"${QP_ROOT}"/lib set -e set -u - export ZMQ_H="${QP_ROOT}"/lib/zmq.h + export ZMQ_H="${QP_ROOT}"/include/zmq.h cd "${BUILD}" make -j 8 || exit 1 mv libf77zmq.a "${QP_ROOT}"/lib || exit 1 diff --git a/install/scripts/install_gmp.sh b/install/scripts/install_gmp.sh new file mode 100755 index 00000000..9aea2973 --- /dev/null +++ b/install/scripts/install_gmp.sh @@ -0,0 +1,17 @@ +#!/bin/bash -x + +TARGET=gmp + +function _install() +{ + rm -rf -- ${TARGET} + mkdir ${TARGET} || exit 1 + cd .. + QP_ROOT=$PWD + cd - + cd ${BUILD} + ./configure --prefix=$QP_ROOT && make -j 8 || exit 1 + make install || exit 1 +} + +source scripts/build.sh diff --git a/install/scripts/install_m4.sh b/install/scripts/install_m4.sh index ca62a025..5a52d757 100755 --- a/install/scripts/install_m4.sh +++ b/install/scripts/install_m4.sh @@ -8,8 +8,7 @@ function _install() QP_ROOT=$PWD cd - cd ${BUILD} - ./configure && make || exit 1 - ln -sf ${PWD}/src/m4 ${QP_ROOT}/bin || exit 1 + ./configure --prefix=$QP_ROOT && make || exit 1 } source scripts/build.sh diff --git a/install/scripts/install_ocaml.sh b/install/scripts/install_ocaml.sh index 913ae75d..b82216d3 100755 --- a/install/scripts/install_ocaml.sh +++ b/install/scripts/install_ocaml.sh @@ -5,11 +5,11 @@ QP_ROOT=$PWD cd - # Normal installation -PACKAGES="core cryptokit zarith ocamlfind sexplib ZMQ" +PACKAGES="core cryptokit.1.10 ocamlfind sexplib ZMQ" #ppx_sexp_conv # Needed for ZeroMQ -export C_INCLUDE_PATH="${QP_ROOT}"/lib:"${C_INCLUDE_PATH}" +export C_INCLUDE_PATH="${QP_ROOT}"/include:"${C_INCLUDE_PATH}" export LIBRARY_PATH="${QP_ROOT}"/lib:"${LIBRARY_PATH}" export LD_LIBRARY_PATH="${QP_ROOT}"/lib:"${LD_LIBRARY_PATH}" diff --git a/install/scripts/install_patch.sh b/install/scripts/install_patch.sh index 10522401..224ac8f8 100755 --- a/install/scripts/install_patch.sh +++ b/install/scripts/install_patch.sh @@ -9,11 +9,11 @@ function _install() QP_ROOT=$PWD cd - cd ${BUILD} - ./configure --prefix=${QP_ROOT}/install/${TARGET} && make || exit 1 + ./configure --prefix=${QP_ROOT} && make || exit 1 make install || exit 1 cd - cp ${TARGET}/bin/${TARGET} ${QP_ROOT}/bin || exit 1 rm -R -- ${TARGET} || exit 1 } -source scripts/build.sh \ No newline at end of file +source scripts/build.sh diff --git a/install/scripts/install_zeromq.sh b/install/scripts/install_zeromq.sh index 3bf2a715..f6596f9c 100755 --- a/install/scripts/install_zeromq.sh +++ b/install/scripts/install_zeromq.sh @@ -7,22 +7,13 @@ function _install() cd .. QP_ROOT=$PWD cd - - export C_INCLUDE_PATH="${C_INCLUDE_PATH}":./ set -e set -u ORIG=$(pwd) cd "${BUILD}" - ./configure --without-libsodium || exit 1 + ./configure --prefix=$QP_ROOT --without-libsodium || exit 1 make -j 8 || exit 1 - rm -f -- "${QP_ROOT}"/lib/libzmq.a "${QP_ROOT}"/lib/libzmq.so "${QP_ROOT}"/lib/libzmq.so.? - cp .libs/libzmq.a "${QP_ROOT}"/lib - cp .libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.5 -# cp src/.libs/libzmq.a "${QP_ROOT}"/lib -# cp src/.libs/libzmq.so "${QP_ROOT}"/lib/libzmq.so.4 - cp include/{zmq.h,zmq_utils.h} "${QP_ROOT}"/lib - cd "${QP_ROOT}"/lib - ln -s libzmq.so.5 libzmq.so -# ln -s libzmq.so.4 libzmq.so + make install || exit 1 cd ${ORIG} return 0 } diff --git a/install/scripts/install_zlib.sh b/install/scripts/install_zlib.sh index 06ce67f3..ea268f2e 100755 --- a/install/scripts/install_zlib.sh +++ b/install/scripts/install_zlib.sh @@ -11,11 +11,8 @@ function _install() cd - cd ${BUILD} ./configure && make || exit 1 - make install prefix=$QP_ROOT/install/${TARGET} || exit 1 - ln -s -f $QP_ROOT/install/${TARGET}/lib/libz.so $QP_ROOT/lib || exit 1 - ln -s -f $QP_ROOT/install/${TARGET}/lib/libz.a $QP_ROOT/lib || exit 1 - ln -s -f $QP_ROOT/install/${TARGET}/include/zlib.h $QP_ROOT/lib || exit 1 - ln -s -f $QP_ROOT/install/${TARGET}/include/zconf.h $QP_ROOT/lib || exit 1 + ./configure --prefix=$QP_ROOT && make || exit 1 + make install || exit 1 } source scripts/build.sh diff --git a/ocaml/Pseudo.ml b/ocaml/Pseudo.ml index 3fb4736e..7f813937 100644 --- a/ocaml/Pseudo.ml +++ b/ocaml/Pseudo.ml @@ -124,23 +124,27 @@ let to_string t = let find in_channel element = In_channel.seek in_channel 0L; - let element_read, old_pos = - ref Element.X, + let loop, element_read, old_pos = + ref true, + ref None, ref (In_channel.pos in_channel) in - while !element_read <> element + + while !loop do - let buffer = - old_pos := In_channel.pos in_channel; - match In_channel.input_line in_channel with - | Some line -> String.split ~on:' ' line - |> List.hd_exn - | None -> "" - in try - element_read := Element.of_string buffer + let buffer = + old_pos := In_channel.pos in_channel; + match In_channel.input_line in_channel with + | Some line -> String.split ~on:' ' line + |> List.hd_exn + | None -> raise End_of_file + in + element_read := Some (Element.of_string buffer); + loop := !element_read <> (Some element) with | Element.ElementError _ -> () + | End_of_file -> loop := false done ; In_channel.seek in_channel !old_pos; !element_read @@ -148,124 +152,126 @@ let find in_channel element = (** Read the Pseudopotential in GAMESS format *) let read_element in_channel element = - ignore (find in_channel element); - - let rec read result = - match In_channel.input_line in_channel with - | None -> result - | Some line -> - if (String.strip line = "") then - result - else - read (line::result) - in - - let data = - read [] - |> List.rev - in - - let debug_data = - String.concat ~sep:"\n" data - in - - let decode_first_line = function - | first_line :: rest -> + match find in_channel element with + | Some e when e = element -> begin - let first_line_split = - String.split first_line ~on:' ' - |> List.filter ~f:(fun x -> (String.strip x) <> "") + let rec read result = + match In_channel.input_line in_channel with + | None -> result + | Some line -> + if (String.strip line = "") then + result + else + read (line::result) in - match first_line_split with - | e :: "GEN" :: n :: p -> - { element = Element.of_string e ; - n_elec = Int.of_string n |> Positive_int.of_int ; - local = [] ; - non_local = [] - }, rest - | _ -> failwith ( - Printf.sprintf "Unable to read Pseudopotential : \n%s\n" - debug_data ) - end - | _ -> failwith ("Error reading pseudopotential\n"^debug_data) - in - let rec loop create_primitive accu = function - | (0,rest) -> List.rev accu, rest - | (n,line::rest) -> - begin - match - String.split line ~on:' ' - |> List.filter ~f:(fun x -> String.strip x <> "") - with - | c :: i :: e :: [] -> - let i = - Int.of_string i - in - let elem = - ( create_primitive - (Float.of_string e |> AO_expo.of_float) - (i-2 |> R_power.of_int), - Float.of_string c |> AO_coef.of_float - ) - in - loop create_primitive (elem::accu) (n-1, rest) + let data = + read [] + |> List.rev + in + + let debug_data = + String.concat ~sep:"\n" data + in + + let decode_first_line = function + | first_line :: rest -> + begin + let first_line_split = + String.split first_line ~on:' ' + |> List.filter ~f:(fun x -> (String.strip x) <> "") + in + match first_line_split with + | e :: "GEN" :: n :: p -> + { element = Element.of_string e ; + n_elec = Int.of_string n |> Positive_int.of_int ; + local = [] ; + non_local = [] + }, rest + | _ -> failwith ( + Printf.sprintf "Unable to read Pseudopotential : \n%s\n" + debug_data ) + end | _ -> failwith ("Error reading pseudopotential\n"^debug_data) - end - | _ -> failwith ("Error reading pseudopotential\n"^debug_data) - in + in - let decode_local (pseudo,data) = - let decode_local_n n rest = - let result, rest = - loop Primitive_local.of_expo_r_power [] (Positive_int.to_int n,rest) + let rec loop create_primitive accu = function + | (0,rest) -> List.rev accu, rest + | (n,line::rest) -> + begin + match + String.split line ~on:' ' + |> List.filter ~f:(fun x -> String.strip x <> "") + with + | c :: i :: e :: [] -> + let i = + Int.of_string i + in + let elem = + ( create_primitive + (Float.of_string e |> AO_expo.of_float) + (i-2 |> R_power.of_int), + Float.of_string c |> AO_coef.of_float + ) + in + loop create_primitive (elem::accu) (n-1, rest) + | _ -> failwith ("Error reading pseudopotential\n"^debug_data) + end + | _ -> failwith ("Error reading pseudopotential\n"^debug_data) in - { pseudo with local = result }, rest - in - match data with - | n :: rest -> - let n = - String.strip n - |> Int.of_string - |> Positive_int.of_int + + let decode_local (pseudo,data) = + let decode_local_n n rest = + let result, rest = + loop Primitive_local.of_expo_r_power [] (Positive_int.to_int n,rest) + in + { pseudo with local = result }, rest in - decode_local_n n rest - | _ -> failwith ("Unable to read (non-)local pseudopotential\n"^debug_data) - in - - let decode_non_local (pseudo,data) = - let decode_non_local_n proj n (pseudo,data) = - let result, rest = - loop (Primitive_non_local.of_proj_expo_r_power proj) - [] (Positive_int.to_int n, data) + match data with + | n :: rest -> + let n = + String.strip n + |> Int.of_string + |> Positive_int.of_int + in + decode_local_n n rest + | _ -> failwith ("Unable to read (non-)local pseudopotential\n"^debug_data) in - { pseudo with non_local = pseudo.non_local @ result }, rest - in - let rec new_proj (pseudo,data) proj = - match data with - | n :: rest -> - let n = - String.strip n - |> Int.of_string - |> Positive_int.of_int - in - let result = - decode_non_local_n proj n (pseudo,rest) - and proj_next = - (Positive_int.to_int proj)+1 - |> Positive_int.of_int - in - new_proj result proj_next - | _ -> pseudo - in - new_proj (pseudo,data) (Positive_int.of_int 0) - in - decode_first_line data - |> decode_local - |> decode_non_local + let decode_non_local (pseudo,data) = + let decode_non_local_n proj n (pseudo,data) = + let result, rest = + loop (Primitive_non_local.of_proj_expo_r_power proj) + [] (Positive_int.to_int n, data) + in + { pseudo with non_local = pseudo.non_local @ result }, rest + in + let rec new_proj (pseudo,data) proj = + match data with + | n :: rest -> + let n = + String.strip n + |> Int.of_string + |> Positive_int.of_int + in + let result = + decode_non_local_n proj n (pseudo,rest) + and proj_next = + (Positive_int.to_int proj)+1 + |> Positive_int.of_int + in + new_proj result proj_next + | _ -> pseudo + in + new_proj (pseudo,data) (Positive_int.of_int 0) + in + + decode_first_line data + |> decode_local + |> decode_non_local + end + | _ -> empty element - include To_md5 diff --git a/ocaml/qp_create_guess.ml b/ocaml/qp_create_guess.ml index 62af57de..bebfdad3 100644 --- a/ocaml/qp_create_guess.ml +++ b/ocaml/qp_create_guess.ml @@ -88,8 +88,9 @@ let run ~multiplicity ezfio_file = ~alpha:(Elec_alpha_number.of_int alpha_new) ~beta:(Elec_beta_number.of_int beta_new) pair ) in + let c = - Array.create ~len:(List.length determinants) (Det_coef.of_float 1.) + Array.init (List.length determinants) (fun _ -> Det_coef.of_float ((Random.float 2.)-.1.)) in determinants diff --git a/plugins/All_singles/.gitignore b/plugins/All_singles/.gitignore new file mode 100644 index 00000000..7ac9fbf6 --- /dev/null +++ b/plugins/All_singles/.gitignore @@ -0,0 +1,5 @@ +IRPF90_temp/ +IRPF90_man/ +irpf90.make +irpf90_entities +tags \ No newline at end of file diff --git a/plugins/All_singles/README.rst b/plugins/All_singles/README.rst index d3888edc..8836ddd6 100644 --- a/plugins/All_singles/README.rst +++ b/plugins/All_singles/README.rst @@ -15,6 +15,7 @@ Needed Modules * `Properties `_ * `Selectors_no_sorted `_ * `Utils `_ +* `Davidson `_ Documentation ============= diff --git a/plugins/All_singles/tree_dependency.png b/plugins/All_singles/tree_dependency.png new file mode 100644 index 00000000..e69de29b diff --git a/plugins/CAS_SD/.gitignore b/plugins/CAS_SD/.gitignore index 380d6cbf..57b1926f 100644 --- a/plugins/CAS_SD/.gitignore +++ b/plugins/CAS_SD/.gitignore @@ -3,6 +3,7 @@ .ninja_log AO_Basis Bitmask +Davidson Determinants Electrons Ezfio_files diff --git a/plugins/CAS_SD/README.rst b/plugins/CAS_SD/README.rst index 11f5d4cc..20ffa64f 100644 --- a/plugins/CAS_SD/README.rst +++ b/plugins/CAS_SD/README.rst @@ -107,6 +107,7 @@ Needed Modules * `Perturbation `_ * `Selectors_full `_ * `Generators_CAS `_ +* `Davidson `_ Documentation ============= @@ -193,31 +194,6 @@ h_apply_cas_s_selected_monoexc Assume N_int is already provided. -h_apply_cas_s_selected_no_skip - Calls H_apply on the HF determinant and selects all connected single and double - excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. - - -h_apply_cas_s_selected_no_skip_diexc - Undocumented - - -h_apply_cas_s_selected_no_skip_diexcorg - Generate all double excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -h_apply_cas_s_selected_no_skip_diexcp - Undocumented - - -h_apply_cas_s_selected_no_skip_monoexc - Generate all single excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - h_apply_cas_sd Calls H_apply on the HF determinant and selects all connected single and double excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. diff --git a/plugins/CAS_SD_ZMQ/cassd_zmq.irp.f b/plugins/CAS_SD_ZMQ/cassd_zmq.irp.f index 6844ed90..881f74c3 100644 --- a/plugins/CAS_SD_ZMQ/cassd_zmq.irp.f +++ b/plugins/CAS_SD_ZMQ/cassd_zmq.irp.f @@ -5,11 +5,15 @@ program fci_zmq double precision, allocatable :: pt2(:) integer :: degree + double precision :: threshold_davidson_in allocate (pt2(N_states)) pt2 = 1.d0 - diag_algorithm = "Lapack" + threshold_davidson_in = threshold_davidson + threshold_davidson = threshold_davidson_in * 100.d0 + SOFT_TOUCH threshold_davidson + if (N_det > N_det_max) then call diagonalize_CI @@ -33,20 +37,11 @@ program fci_zmq double precision :: E_CI_before(N_states) - integer :: n_det_before + integer :: n_det_before, to_select print*,'Beginning the selection ...' E_CI_before(1:N_states) = CI_energy(1:N_states) do while ( (N_det < N_det_max) .and. (maxval(abs(pt2(1:N_states))) > pt2_max) ) - n_det_before = N_det - call ZMQ_selection(max(256-N_det, N_det), pt2) - - PROVIDE psi_coef - PROVIDE psi_det - PROVIDE psi_det_sorted - - call diagonalize_CI - call save_wavefunction print *, 'N_det = ', N_det print *, 'N_states = ', N_states @@ -71,12 +66,38 @@ program fci_zmq endif E_CI_before(1:N_states) = CI_energy(1:N_states) call ezfio_set_cas_sd_zmq_energy(CI_energy(1)) + + n_det_before = N_det + to_select = 2*N_det + to_select = max(64-to_select, to_select) + to_select = min(to_select,N_det_max-n_det_before) + call ZMQ_selection(to_select, pt2) + + PROVIDE psi_coef + PROVIDE psi_det + PROVIDE psi_det_sorted + + if (N_det == N_det_max) then + threshold_davidson = threshold_davidson_in + SOFT_TOUCH threshold_davidson + endif + call diagonalize_CI + call save_wavefunction + call ezfio_set_cas_sd_zmq_energy(CI_energy(1)) enddo + + if (N_det < N_det_max) then + threshold_davidson = threshold_davidson_in + SOFT_TOUCH threshold_davidson + call diagonalize_CI + call save_wavefunction + call ezfio_set_cas_sd_zmq_energy(CI_energy(1)) + endif integer :: exc_max, degree_min exc_max = 0 print *, 'CAS determinants : ', N_det_cas - do i=1,min(N_det_cas,10) + do i=1,min(N_det_cas,20) do k=i,N_det_cas call get_excitation_degree(psi_cas(1,1,k),psi_cas(1,1,i),degree,N_int) exc_max = max(exc_max,degree) @@ -108,7 +129,7 @@ program fci_zmq endif call save_wavefunction call ezfio_set_cas_sd_zmq_energy(CI_energy(1)) - call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before+pt2) + call ezfio_set_cas_sd_zmq_energy_pt2(E_CI_before(1)+pt2(1)) end diff --git a/plugins/CAS_SD_ZMQ/selection.irp.f b/plugins/CAS_SD_ZMQ/selection.irp.f index f90ee488..33aab57d 100644 --- a/plugins/CAS_SD_ZMQ/selection.irp.f +++ b/plugins/CAS_SD_ZMQ/selection.irp.f @@ -112,7 +112,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2) if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1_1 get_phase_bi = res(iand(np,1_1)) -end subroutine +end function diff --git a/plugins/Full_CI/.gitignore b/plugins/Full_CI/.gitignore index 674f56da..70d637ea 100644 --- a/plugins/Full_CI/.gitignore +++ b/plugins/Full_CI/.gitignore @@ -3,6 +3,7 @@ .ninja_log AO_Basis Bitmask +Davidson Determinants Electrons Ezfio_files @@ -28,7 +29,6 @@ full_ci full_ci_no_skip irpf90.make irpf90_entities -micro_pt2 tags target_pt2 var_pt2_ratio \ No newline at end of file diff --git a/plugins/Full_CI/README.rst b/plugins/Full_CI/README.rst index 750db44c..77a0bd64 100644 --- a/plugins/Full_CI/README.rst +++ b/plugins/Full_CI/README.rst @@ -16,6 +16,7 @@ Needed Modules * `Perturbation `_ * `Selectors_full `_ * `Generators_full `_ +* `Davidson `_ Documentation ============= @@ -77,6 +78,31 @@ h_apply_fci_monoexc Assume N_int is already provided. +h_apply_fci_no_selection + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_fci_no_selection_diexc + Undocumented + + +h_apply_fci_no_selection_diexcorg + Generate all double excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_no_selection_diexcp + Undocumented + + +h_apply_fci_no_selection_monoexc + Generate all single excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + h_apply_fci_no_skip Calls H_apply on the HF determinant and selects all connected single and double excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. @@ -144,118 +170,6 @@ h_apply_fci_pt2_slave_tcp Computes a buffer over the network -h_apply_pt2_mono_delta_rho - Calls H_apply on the HF determinant and selects all connected single and double - excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. - - -h_apply_pt2_mono_delta_rho_diexc - Undocumented - - -h_apply_pt2_mono_delta_rho_diexcorg - Generate all double excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -h_apply_pt2_mono_delta_rho_diexcp - Undocumented - - -h_apply_pt2_mono_delta_rho_monoexc - Generate all single excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -h_apply_pt2_mono_di_delta_rho - Calls H_apply on the HF determinant and selects all connected single and double - excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. - - -h_apply_pt2_mono_di_delta_rho_diexc - Undocumented - - -h_apply_pt2_mono_di_delta_rho_diexcorg - Generate all double excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -h_apply_pt2_mono_di_delta_rho_diexcp - Undocumented - - -h_apply_pt2_mono_di_delta_rho_monoexc - Generate all single excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -h_apply_select_mono_delta_rho - Calls H_apply on the HF determinant and selects all connected single and double - excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. - - -h_apply_select_mono_delta_rho_diexc - Undocumented - - -h_apply_select_mono_delta_rho_diexcorg - Generate all double excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -h_apply_select_mono_delta_rho_diexcp - Undocumented - - -h_apply_select_mono_delta_rho_monoexc - Generate all single excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -h_apply_select_mono_di_delta_rho - Calls H_apply on the HF determinant and selects all connected single and double - excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. - - -h_apply_select_mono_di_delta_rho_diexc - Undocumented - - -h_apply_select_mono_di_delta_rho_diexcorg - Generate all double excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -h_apply_select_mono_di_delta_rho_diexcp - Undocumented - - -h_apply_select_mono_di_delta_rho_monoexc - Generate all single excitations of key_in using the bit masks of holes and - particles. - Assume N_int is already provided. - - -`micro_pt2 `_ - Helper program to compute the PT2 in distributed mode. - - -`provide_everything `_ - Undocumented - - -`run_wf `_ - Undocumented - - `var_pt2_ratio_run `_ Undocumented diff --git a/plugins/Full_CI_ZMQ/.gitignore b/plugins/Full_CI_ZMQ/.gitignore new file mode 100644 index 00000000..7ac9fbf6 --- /dev/null +++ b/plugins/Full_CI_ZMQ/.gitignore @@ -0,0 +1,5 @@ +IRPF90_temp/ +IRPF90_man/ +irpf90.make +irpf90_entities +tags \ No newline at end of file diff --git a/plugins/Full_CI_ZMQ/README.rst b/plugins/Full_CI_ZMQ/README.rst new file mode 100644 index 00000000..d1677a7d --- /dev/null +++ b/plugins/Full_CI_ZMQ/README.rst @@ -0,0 +1,461 @@ +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. + + +.. image:: tree_dependency.png + +* `Perturbation `_ +* `Selectors_full `_ +* `Generators_full `_ +* `ZMQ `_ +* `Full_CI `_ + +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. + + +`add_task_to_taskserver `_ + Get a task from the task server + + +`add_to_selection_buffer `_ + Undocumented + + +`assert `_ + Undocumented + + +`connect_to_taskserver `_ + Connect to the task server and obtain the worker ID + + +`create_selection_buffer `_ + Undocumented + + +`disconnect_from_taskserver `_ + Disconnect from the task server + + +`end_parallel_job `_ + End a new parallel job with name 'name'. The slave tasks execute subroutine 'slave' + + +`end_zmq_pair_socket `_ + Terminate socket on which the results are sent. + + +`end_zmq_pull_socket `_ + Terminate socket on which the results are sent. + + +`end_zmq_push_socket `_ + Terminate socket on which the results are sent. + + +`end_zmq_sub_socket `_ + Terminate socket on which the results are sent. + + +`end_zmq_to_qp_run_socket `_ + Terminate the socket from the application to qp_run + + +`fci_zmq `_ + Undocumented + + +`fill_buffer_double `_ + Undocumented + + +`fill_buffer_single `_ + Undocumented + + +`full_ci `_ + Undocumented + + +`get_d0 `_ + Undocumented + + +`get_d1 `_ + Undocumented + + +`get_d2 `_ + Undocumented + + +`get_m0 `_ + Undocumented + + +`get_m1 `_ + Undocumented + + +`get_m2 `_ + Undocumented + + +`get_mask_phase `_ + Undocumented + + +`get_phase_bi `_ + Undocumented + + +`get_task_from_taskserver `_ + Get a task from the task server + + +h_apply_fci + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_fci_diexc + Undocumented + + +h_apply_fci_diexcorg + Generate all double excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_diexcp + Undocumented + + +h_apply_fci_mono + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_fci_mono_diexc + Undocumented + + +h_apply_fci_mono_diexcorg + Generate all double excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_mono_diexcp + Undocumented + + +h_apply_fci_mono_monoexc + Generate all single excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_monoexc + Generate all single excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_no_selection + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_fci_no_selection_diexc + Undocumented + + +h_apply_fci_no_selection_diexcorg + Generate all double excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_no_selection_diexcp + Undocumented + + +h_apply_fci_no_selection_monoexc + Generate all single excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_no_skip + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_fci_no_skip_diexc + Undocumented + + +h_apply_fci_no_skip_diexcorg + Generate all double excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_no_skip_diexcp + Undocumented + + +h_apply_fci_no_skip_monoexc + Generate all single excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_pt2 + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_fci_pt2_collector + Collects results from the selection in an array of generators + + +h_apply_fci_pt2_diexc + Undocumented + + +h_apply_fci_pt2_diexcorg + Generate all double excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_pt2_diexcp + Undocumented + + +h_apply_fci_pt2_monoexc + Generate all single excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_fci_pt2_slave + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_fci_pt2_slave_inproc + Computes a buffer using threads + + +h_apply_fci_pt2_slave_tcp + Computes a buffer over the network + + +`integral8 `_ + Undocumented + + +`new_parallel_job `_ + Start a new parallel job with name 'name'. The slave tasks execute subroutine 'slave' + + +`new_zmq_pair_socket `_ + Socket on which the collector and the main communicate + + +`new_zmq_pull_socket `_ + Socket on which the results are sent. If thread is 1, use inproc + + +`new_zmq_push_socket `_ + Socket on which the results are sent. If thread is 1, use inproc + + +`new_zmq_sub_socket `_ + Socket to read the state published by the Task server + + +`new_zmq_to_qp_run_socket `_ + Socket on which the qp_run process replies + + +`past_d1 `_ + Undocumented + + +`past_d2 `_ + Undocumented + + +`provide_everything `_ + Undocumented + + +`psi_phasemask `_ + Undocumented + + +`pull_selection_results `_ + Undocumented + + +`push_selection_results `_ + Undocumented + + +`qp_run_address `_ + Address of the qp_run socket + Example : tcp://130.120.229.139:12345 + + +`reset_zmq_addresses `_ + Socket which pulls the results (2) + + +`run_selection_slave `_ + Undocumented + + +`run_wf `_ + Undocumented + + +`select_connected `_ + Undocumented + + +`select_doubles `_ + Undocumented + + +`select_singles `_ + Select determinants connected to i_det by H + + +`selection_collector `_ + Undocumented + + +`selection_slave `_ + Helper program to compute the PT2 in distributed mode. + + +`selection_slave_inproc `_ + Undocumented + + +`selection_slave_tcp `_ + Undocumented + + +`sort_selection_buffer `_ + Undocumented + + +`splash_p `_ + Undocumented + + +`splash_pq `_ + Undocumented + + +`spot_hasbeen `_ + Undocumented + + +`spot_isinwf `_ + Undocumented + + +`switch_qp_run_to_master `_ + Address of the master qp_run socket + Example : tcp://130.120.229.139:12345 + + +`task_done_to_taskserver `_ + Get a task from the task server + + +`update_energy `_ + Update energy when it is received from ZMQ + + +`var_pt2_ratio_run `_ + Undocumented + + +`wait_for_next_state `_ + Undocumented + + +`wait_for_state `_ + Wait for the ZMQ state to be ready + + +`wait_for_states `_ + Wait for the ZMQ state to be ready + + +`zmq_context `_ + Context for the ZeroMQ library + + +`zmq_delete_task `_ + When a task is done, it has to be removed from the list of tasks on the qp_run + queue. This guarantees that the results have been received in the pull. + + +`zmq_port `_ + Return the value of the ZMQ port from the corresponding integer + + +`zmq_port_start `_ + Address of the qp_run socket + Example : tcp://130.120.229.139:12345 + + +`zmq_selection `_ + Undocumented + + +`zmq_set_running `_ + Set the job to Running in QP-run + + +`zmq_socket_pair_inproc_address `_ + Socket which pulls the results (2) + + +`zmq_socket_pull_inproc_address `_ + Socket which pulls the results (2) + + +`zmq_socket_pull_tcp_address `_ + Socket which pulls the results (2) + + +`zmq_socket_push_inproc_address `_ + Socket which pulls the results (2) + + +`zmq_socket_push_tcp_address `_ + Socket which pulls the results (2) + + +`zmq_socket_sub_tcp_address `_ + Socket which pulls the results (2) + + +`zmq_state `_ + Threads executing work through the ZeroMQ interface + diff --git a/plugins/Full_CI_ZMQ/fci_zmq.irp.f b/plugins/Full_CI_ZMQ/fci_zmq.irp.f index 382e8652..ae0d7989 100644 --- a/plugins/Full_CI_ZMQ/fci_zmq.irp.f +++ b/plugins/Full_CI_ZMQ/fci_zmq.irp.f @@ -11,10 +11,9 @@ program fci_zmq allocate (pt2(N_states)) pt2 = 1.d0 - diag_algorithm = "Lapack" threshold_davidson_in = threshold_davidson + threshold_davidson = threshold_davidson_in * 100.d0 SOFT_TOUCH threshold_davidson - threshold_davidson = 1.d-4 if (N_det > N_det_max) then call diagonalize_CI @@ -43,31 +42,6 @@ program fci_zmq n_det_before = 0 do while ( (N_det < N_det_max) .and. (maxval(abs(pt2(1:N_states))) > pt2_max) ) - n_det_before = N_det - to_select = 3*N_det - to_select = max(1024-to_select, to_select) - to_select = min(to_select, N_det_max-n_det_before) - call ZMQ_selection(to_select, pt2) - - PROVIDE psi_coef - PROVIDE psi_det - PROVIDE psi_det_sorted - - if (N_det == N_det_max) then - threshold_davidson = threshold_davidson_in - SOFT_TOUCH threshold_davidson - endif - call diagonalize_CI - call save_wavefunction - -! if (N_det > N_det_max) then -! psi_det = psi_det_sorted -! psi_coef = psi_coef_sorted -! N_det = N_det_max -! soft_touch N_det psi_det psi_coef -! call diagonalize_CI -! call save_wavefunction -! endif print *, 'N_det = ', N_det print *, 'N_states = ', N_states @@ -91,9 +65,35 @@ program fci_zmq enddo endif E_CI_before(1:N_states) = CI_energy(1:N_states) - call ezfio_set_full_ci_zmq_energy(CI_energy) + call ezfio_set_full_ci_zmq_energy(CI_energy(1)) + + n_det_before = N_det + to_select = 2*N_det + to_select = max(64-to_select, to_select) + to_select = min(to_select, N_det_max-n_det_before) + call ZMQ_selection(to_select, pt2) + + PROVIDE psi_coef + PROVIDE psi_det + PROVIDE psi_det_sorted + + if (N_det == N_det_max) then + threshold_davidson = threshold_davidson_in + SOFT_TOUCH threshold_davidson + endif + call diagonalize_CI + call save_wavefunction + call ezfio_set_full_ci_zmq_energy(CI_energy(1)) enddo + if (N_det < N_det_max) then + threshold_davidson = threshold_davidson_in + SOFT_TOUCH threshold_davidson + call diagonalize_CI + call save_wavefunction + call ezfio_set_full_ci_zmq_energy(CI_energy(1)) + endif + if(do_pt2_end)then print*,'Last iteration only to compute the PT2' threshold_selectors = max(threshold_selectors,threshold_selectors_pt2) @@ -111,9 +111,11 @@ program fci_zmq print *, 'E+PT2 = ', E_CI_before+pt2 print *, '-----' enddo - call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before+pt2) + call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1)) endif call save_wavefunction + call ezfio_set_full_ci_zmq_energy(CI_energy(1)) + call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1)) end diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 3f351004..b0078b18 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -112,7 +112,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2) if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1_1 get_phase_bi = res(iand(np,1_1)) -end subroutine +end function diff --git a/plugins/Full_CI_ZMQ/tree_dependency.png b/plugins/Full_CI_ZMQ/tree_dependency.png new file mode 100644 index 00000000..e69de29b diff --git a/plugins/Generators_full/README.rst b/plugins/Generators_full/README.rst index c30193a2..d1fc68ec 100644 --- a/plugins/Generators_full/README.rst +++ b/plugins/Generators_full/README.rst @@ -33,7 +33,7 @@ Documentation .. by the `update_README.py` script. -`degree_max_generators `_ +`degree_max_generators `_ Max degree of excitation (respect to HF) of the generators @@ -52,10 +52,10 @@ Documentation Hartree-Fock determinant -`select_max `_ +`select_max `_ Memo to skip useless selectors -`size_select_max `_ +`size_select_max `_ Size of the select_max array diff --git a/plugins/Generators_restart/tree_dependency.png b/plugins/Generators_restart/tree_dependency.png new file mode 100644 index 00000000..e69de29b diff --git a/plugins/Hartree_Fock/README.rst b/plugins/Hartree_Fock/README.rst index 77521b94..2e329163 100644 --- a/plugins/Hartree_Fock/README.rst +++ b/plugins/Hartree_Fock/README.rst @@ -67,11 +67,11 @@ Documentation Alpha Fock matrix in AO basis set -`fock_matrix_alpha_mo `_ +`fock_matrix_alpha_mo `_ Fock matrix on the MO basis -`fock_matrix_ao `_ +`fock_matrix_ao `_ Fock matrix in AO basis set @@ -79,7 +79,7 @@ Documentation Alpha Fock matrix in AO basis set -`fock_matrix_beta_mo `_ +`fock_matrix_beta_mo `_ Fock matrix on the MO basis @@ -115,7 +115,7 @@ Documentation .br -`fock_mo_to_ao `_ +`fock_mo_to_ao `_ Undocumented @@ -135,7 +135,7 @@ Documentation S^-1 Beta density matrix in the AO basis x S^-1 -`hf_energy `_ +`hf_energy `_ Hartree-Fock energy diff --git a/plugins/MRCC_Utils/.gitignore b/plugins/MRCC_Utils/.gitignore index 4c65ce66..7a0dd517 100644 --- a/plugins/MRCC_Utils/.gitignore +++ b/plugins/MRCC_Utils/.gitignore @@ -3,6 +3,7 @@ .ninja_log AO_Basis Bitmask +Davidson Determinants Electrons Ezfio_files diff --git a/plugins/MRCC_Utils/README.rst b/plugins/MRCC_Utils/README.rst index 39b5684c..ae041734 100644 --- a/plugins/MRCC_Utils/README.rst +++ b/plugins/MRCC_Utils/README.rst @@ -36,11 +36,19 @@ Documentation Compute 1st dimension such that it is aligned for vectorization. -`apply_rotation `_ +`apply_hole_local `_ + Undocumented + + +`apply_particle_local `_ + Undocumented + + +`apply_rotation `_ Apply the rotation found by find_rotation -`approx_dble `_ +`approx_dble `_ Undocumented @@ -63,23 +71,23 @@ Documentation Binomial coefficients -`ci_eigenvectors_dressed `_ - Eigenvectors/values of the CI matrix +`ci_eigenvectors_dressed `_ + Eigenvectors/values of the dressed CI matrix -`ci_eigenvectors_s2_dressed `_ - Eigenvectors/values of the CI matrix +`ci_eigenvectors_s2_dressed `_ + Eigenvectors/values of the dressed CI matrix -`ci_electronic_energy_dressed `_ - Eigenvectors/values of the CI matrix +`ci_electronic_energy_dressed `_ + Eigenvectors/values of the dressed CI matrix -`ci_energy_dressed `_ +`ci_energy_dressed `_ N_states lowest eigenvalues of the dressed CI matrix -`davidson_diag_hjj_mrcc `_ +`davidson_diag_hjj_mrcc `_ Davidson diagonalization with specific diagonal elements of the H matrix .br H_jj : specific diagonal H matrix elements to diagonalize de Davidson @@ -95,12 +103,39 @@ Documentation .br N_st : Number of eigenstates .br + N_st_diag : Number of states in which H is diagonalized + .br iunit : Unit for the I/O .br Initial guess vectors are not necessarily orthonormal -`davidson_diag_mrcc `_ +`davidson_diag_hjj_sjj_mrcc `_ + Davidson diagonalization with specific diagonal elements of the H matrix + .br + H_jj : specific diagonal H matrix elements to diagonalize de Davidson + .br + S2_jj : specific diagonal S^2 matrix elements + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + N_st_diag : Number of states in which H is diagonalized. Assumed > sze + .br + iunit : Unit for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_mrcc `_ Davidson diagonalization. .br dets_in : bitmasks corresponding to determinants @@ -119,19 +154,38 @@ Documentation Initial guess vectors are not necessarily orthonormal -`dble_fact `_ +`davidson_diag_mrcc_hs2 `_ + Davidson diagonalization. + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + iunit : Unit number for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`dble_fact `_ Undocumented -`dble_fact_even `_ +`dble_fact_even `_ n!! -`dble_fact_odd `_ +`dble_fact_odd `_ n!! -`dble_logfact `_ +`dble_logfact `_ n!! @@ -139,19 +193,23 @@ Documentation Undocumented -`delta_ii `_ - Dressing matrix in N_det basis +`dec_exc `_ + Undocumented -`delta_ij `_ - Dressing matrix in N_det basis - - -`diagonalize_ci_dressed `_ +`diagonalize_ci_dressed `_ Replace the coefficients of the CI states by the coefficients of the eigenstates of the CI matrix +`dij `_ + Undocumented + + +`dij_unique `_ + Undocumented + + `dset_order `_ array A has already been sorted, and iorder has contains the new order of elements of A. This subroutine changes the order of x to match the new order of A. @@ -170,10 +228,26 @@ Documentation contains the new order of the elements. +`dtranspose `_ + Transpose input matrix A into output matrix B + + `erf0 `_ Undocumented +`exc_inf `_ + Undocumented + + +`exccmp `_ + Undocumented + + +`exceq `_ + Undocumented + + `f_integral `_ function that calculates the following integral \int_{\-infty}^{+\infty} x^n \exp(-p x^2) dx @@ -183,19 +257,19 @@ Documentation n! -`fact_inv `_ +`fact_inv `_ 1/n! -`find_rotation `_ +`find_rotation `_ Find A.C = B -`find_triples_and_quadruples `_ +`find_triples_and_quadruples `_ Undocumented -`find_triples_and_quadruples_micro `_ +`find_triples_and_quadruples_micro `_ Undocumented @@ -221,7 +295,15 @@ Documentation Undocumented -`get_pseudo_inverse `_ +`get_dij `_ + Undocumented + + +`get_dij_index `_ + Undocumented + + +`get_pseudo_inverse `_ Find C = A^-1 @@ -306,11 +388,63 @@ h_apply_mrcc_pt2_monoexc Assume N_int is already provided. -`h_matrix_dressed `_ +h_apply_mrcepa_pt2 + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_mrcepa_pt2_collector + Collects results from the selection in an array of generators + + +h_apply_mrcepa_pt2_diexc + Undocumented + + +h_apply_mrcepa_pt2_diexcorg + Generate all double excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_mrcepa_pt2_diexcp + Undocumented + + +h_apply_mrcepa_pt2_monoexc + Generate all single excitations of key_in using the bit masks of holes and + particles. + Assume N_int is already provided. + + +h_apply_mrcepa_pt2_slave + Calls H_apply on the HF determinant and selects all connected single and double + excitations (of the same symmetry). Auto-generated by the ``generate_h_apply`` script. + + +h_apply_mrcepa_pt2_slave_inproc + Computes a buffer using threads + + +h_apply_mrcepa_pt2_slave_tcp + Computes a buffer over the network + + +`h_matrix_dressed `_ Dressed H with Delta_ij -`h_u_0_mrcc `_ +`h_s2_u_0_mrcc_nstates `_ + Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + .br + n : number of determinants + .br + H_jj : array of + .br + S2_jj : array of + + +`h_u_0_mrcc_nstates `_ Computes v_0 = H|u_0> .br n : number of determinants @@ -392,7 +526,15 @@ h_apply_mrcc_pt2_monoexc Hermite polynomial -`hij_mrcc `_ +`hh_exists `_ + Undocumented + + +`hh_shortcut `_ + Undocumented + + +`hij_mrcc `_ < ref | H | Non-ref > matrix @@ -523,7 +665,7 @@ h_apply_mrcc_pt2_monoexc to be in integer*8 format -`inv_int `_ +`inv_int `_ 1/i @@ -541,6 +683,10 @@ h_apply_mrcc_pt2_monoexc iradix should be -1 in input. +`is_generable `_ + Undocumented + + `iset_order `_ array A has already been sorted, and iorder has contains the new order of elements of A. This subroutine changes the order of x to match the new order of A. @@ -559,15 +705,19 @@ h_apply_mrcc_pt2_monoexc contains the new order of the elements. -`lambda_mrcc `_ +`lambda_mrcc `_ cm/ or perturbative 1/Delta_E(m) -`lambda_mrcc_pt2 `_ +`lambda_mrcc_kept `_ cm/ or perturbative 1/Delta_E(m) -`lapack_diag `_ +`lambda_mrcc_pt2 `_ + cm/ or perturbative 1/Delta_E(m) + + +`lapack_diag `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -578,7 +728,7 @@ h_apply_mrcc_pt2_monoexc .br -`lapack_diag_s2 `_ +`lapack_diag_s2 `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -589,7 +739,7 @@ h_apply_mrcc_pt2_monoexc .br -`lapack_diagd `_ +`lapack_diagd `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -600,7 +750,7 @@ h_apply_mrcc_pt2_monoexc .br -`lapack_partial_diag `_ +`lapack_partial_diag `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -611,19 +761,27 @@ h_apply_mrcc_pt2_monoexc .br -`logfact `_ +`logfact `_ n! -`lowercase `_ +`lowercase `_ Transform to lower case +`map_load_from_disk `_ + Undocumented + + +`map_save_to_disk `_ + Undocumented + + `mrcc_dress `_ Undocumented -`mrcc_iterations `_ +`mrmode `_ Undocumented @@ -632,12 +790,24 @@ h_apply_mrcc_pt2_monoexc D(t) =! D(t) +( B(t)*C(t)) -`normalize `_ +`n_ex_exists `_ + Undocumented + + +`n_hh_exists `_ + Undocumented + + +`n_pp_exists `_ + Undocumented + + +`normalize `_ Normalizes vector u u is expected to be aligned in memory. -`nproc `_ +`nproc `_ Number of current OpenMP threads @@ -659,7 +829,7 @@ h_apply_mrcc_pt2_monoexc .br -`ortho_lowdin `_ +`ortho_lowdin `_ Compute C_new=C_old.S^-1/2 orthogonalization. .br overlap : overlap matrix @@ -677,6 +847,19 @@ h_apply_mrcc_pt2_monoexc .br +`ortho_qr `_ + Orthogonalization using Q.R factorization + .br + A : matrix to orthogonalize + .br + LDA : leftmost dimension of A + .br + n : Number of rows of A + .br + m : Number of columns of A + .br + + `overlap_a_b_c `_ Undocumented @@ -707,6 +890,10 @@ h_apply_mrcc_pt2_monoexc Undocumented +`pp_exists `_ + Undocumented + + `progress_active `_ Current status for displaying progress bars. Global variable. @@ -727,6 +914,14 @@ h_apply_mrcc_pt2_monoexc Current status for displaying progress bars. Global variable. +`psi_non_ref_sorted `_ + Undocumented + + +`psi_non_ref_sorted_idx `_ + Undocumented + + `psi_ref_lock `_ Locks on ref determinants to fill delta_ij @@ -735,6 +930,10 @@ h_apply_mrcc_pt2_monoexc Recenter two polynomials +`rho_mrcc `_ + Undocumented + + `rint `_ .. math:: .br @@ -762,10 +961,6 @@ h_apply_mrcc_pt2_monoexc Undocumented -`run_mrcc `_ - Undocumented - - `run_progress `_ Display a progress bar with documentation of what is happening @@ -774,7 +969,15 @@ h_apply_mrcc_pt2_monoexc Undocumented -`set_generators_bitmasks_as_holes_and_particles `_ +`searchdet `_ + Undocumented + + +`searchexc `_ + Undocumented + + +`set_generators_bitmasks_as_holes_and_particles `_ Undocumented @@ -790,7 +993,7 @@ h_apply_mrcc_pt2_monoexc to be in integer*8 format -`set_zero_extra_diag `_ +`set_zero_extra_diag `_ Undocumented @@ -800,6 +1003,14 @@ h_apply_mrcc_pt2_monoexc contains the new order of the elements. +`sort_det `_ + Undocumented + + +`sort_exc `_ + Undocumented + + `start_progress `_ Starts the progress bar @@ -817,18 +1028,37 @@ h_apply_mrcc_pt2_monoexc .br -`u_dot_u `_ +`tamise_exc `_ + Uncodumented : TODO + + +`transpose `_ + Transpose input matrix A into output matrix B + + +`u_0_h_u_0_mrcc_nstates `_ + Computes e_0 = / + .br + n : number of determinants + .br + + +`u_dot_u `_ Compute -`u_dot_v `_ +`u_dot_v `_ Compute -`wall_time `_ +`unsortedsearchdet `_ + Undocumented + + +`wall_time `_ The equivalent of cpu_time, but for the wall time. -`write_git_log `_ +`write_git_log `_ Write the last git commit in file iunit. diff --git a/plugins/MRCC_Utils/amplitudes.irp.f b/plugins/MRCC_Utils/amplitudes.irp.f index 72d3ea67..f9cb51ad 100644 --- a/plugins/MRCC_Utils/amplitudes.irp.f +++ b/plugins/MRCC_Utils/amplitudes.irp.f @@ -66,9 +66,18 @@ END_PROVIDER +BEGIN_PROVIDER [ integer, n_exc_active_sze ] + implicit none + BEGIN_DOC + ! Dimension of arrays to avoid zero-sized arrays + END_DOC + n_exc_active_sze = max(n_exc_active,1) +END_PROVIDER - BEGIN_PROVIDER [ integer, active_excitation_to_determinants_idx, (0:N_det_ref+1, n_exc_active) ] -&BEGIN_PROVIDER [ double precision, active_excitation_to_determinants_val, (N_states,N_det_ref+1, n_exc_active) ] + + + BEGIN_PROVIDER [ integer, active_excitation_to_determinants_idx, (0:N_det_ref+1, n_exc_active_sze) ] +&BEGIN_PROVIDER [ double precision, active_excitation_to_determinants_val, (N_states,N_det_ref+1, n_exc_active_sze) ] implicit none BEGIN_DOC ! Sparse matrix A containing the matrix to transform the active excitations to @@ -80,7 +89,8 @@ END_PROVIDER double precision :: phase logical :: ok integer, external :: searchDet - + + PROVIDE psi_non_ref_sorted_idx psi_ref_coef !$OMP PARALLEL default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int,& !$OMP active_excitation_to_determinants_val, active_excitation_to_determinants_idx)& @@ -117,6 +127,7 @@ END_PROVIDER wk += 1 do s=1,N_states active_excitation_to_determinants_val(s,wk, ppp) = psi_ref_coef(lref(i), s) + enddo active_excitation_to_determinants_idx(wk, ppp) = i else if(lref(i) < 0) then @@ -136,10 +147,10 @@ END_PROVIDER END_PROVIDER - BEGIN_PROVIDER [ integer, mrcc_AtA_ind, (N_det_ref * n_exc_active) ] -&BEGIN_PROVIDER [ double precision, mrcc_AtA_val, (N_states, N_det_ref * n_exc_active) ] -&BEGIN_PROVIDER [ integer, mrcc_col_shortcut, (n_exc_active) ] -&BEGIN_PROVIDER [ integer, mrcc_N_col, (n_exc_active) ] + BEGIN_PROVIDER [ integer, mrcc_AtA_ind, (N_det_ref * n_exc_active_sze) ] +&BEGIN_PROVIDER [ double precision, mrcc_AtA_val, (N_states, N_det_ref * n_exc_active_sze) ] +&BEGIN_PROVIDER [ integer, mrcc_col_shortcut, (n_exc_active_sze) ] +&BEGIN_PROVIDER [ integer, mrcc_N_col, (n_exc_active_sze) ] implicit none BEGIN_DOC ! A is active_excitation_to_determinants in At.A @@ -149,7 +160,7 @@ END_PROVIDER double precision, allocatable :: t(:), A_val_mwen(:,:), As2_val_mwen(:,:) integer, allocatable :: A_ind_mwen(:) double precision :: sij - PROVIDE psi_non_ref + PROVIDE psi_non_ref active_excitation_to_determinants_val mrcc_AtA_ind(:) = 0 mrcc_AtA_val(:,:) = 0.d0 @@ -157,7 +168,6 @@ END_PROVIDER mrcc_N_col(:) = 0 AtA_size = 0 - !$OMP PARALLEL default(none) shared(k, active_excitation_to_determinants_idx,& !$OMP active_excitation_to_determinants_val, hh_nex) & !$OMP private(at_row, a_col, t, i, r1, r2, wk, A_ind_mwen, A_val_mwen,& @@ -170,7 +180,6 @@ END_PROVIDER do at_roww = 1, n_exc_active ! hh_nex at_row = active_pp_idx(at_roww) wk = 0 - if(mod(at_roww, 100) == 0) print *, "AtA", at_row, "/", hh_nex do a_coll = 1, n_exc_active a_col = active_pp_idx(a_coll) @@ -224,7 +233,7 @@ END_PROVIDER deallocate (A_ind_mwen, A_val_mwen, As2_val_mwen, t) !$OMP END PARALLEL - print *, "ATA SIZE", ata_size + print *, "At.A SIZE", ata_size END_PROVIDER diff --git a/plugins/MRCC_Utils/davidson.irp.f b/plugins/MRCC_Utils/davidson.irp.f index e667d255..6bdadb24 100644 --- a/plugins/MRCC_Utils/davidson.irp.f +++ b/plugins/MRCC_Utils/davidson.irp.f @@ -807,7 +807,7 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz ! Diagonalize h ! ------------- call lapack_diag(lambda,y,h,size(h,1),shift2) - + ! Compute S2 for each eigenvector ! ------------------------------- @@ -829,7 +829,9 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0) enddo else - state_ok(k) = .True. + do k=1,size(state_ok) + state_ok(k) = .True. + enddo endif do k=1,shift2 @@ -908,30 +910,30 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz ! ----------------------- do k=1,N_st_diag - if (state_ok(k)) then +! if (state_ok(k)) then do i=1,sze U(i,shift2+k) = (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & * (1.d0 + s2(k) * U(i,shift2+k) - S(i,shift2+k) - S_z2_Sz & )/max(H_jj(i) - lambda (k),1.d-2) enddo - else - ! Randomize components with bad - do i=1,sze-2,2 - call random_number(r1) - call random_number(r2) - r1 = dsqrt(-2.d0*dlog(r1)) - r2 = dtwo_pi*r2 - U(i,shift2+k) = r1*dcos(r2) - U(i+1,shift2+k) = r1*dsin(r2) - enddo - do i=sze-2+1,sze - call random_number(r1) - call random_number(r2) - r1 = dsqrt(-2.d0*dlog(r1)) - r2 = dtwo_pi*r2 - U(i,shift2+k) = r1*dcos(r2) - enddo - endif +! else +! ! Randomize components with bad +! do i=1,sze-2,2 +! call random_number(r1) +! call random_number(r2) +! r1 = dsqrt(-2.d0*dlog(r1)) +! r2 = dtwo_pi*r2 +! U(i,shift2+k) = r1*dcos(r2) +! U(i+1,shift2+k) = r1*dsin(r2) +! enddo +! do i=sze-2+1,sze +! call random_number(r1) +! call random_number(r2) +! r1 = dsqrt(-2.d0*dlog(r1)) +! r2 = dtwo_pi*r2 +! U(i,shift2+k) = r1*dcos(r2) +! enddo +! endif if (k <= N_st) then residual_norm(k) = u_dot_u(U(1,shift2+k),sze) @@ -1040,6 +1042,7 @@ subroutine H_S2_u_0_mrcc_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,istate_i call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) + PROVIDE delta_ij_s2 !$OMP PARALLEL DEFAULT(NONE) & !$OMP PRIVATE(i,hij,s2,j,k,jj,vt,st,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)& !$OMP SHARED(n,keys_tmp,ut,Nint,v_0,s_0,sorted,shortcut,sort_idx,version,N_st,N_st_8, & diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 9cf0330b..f9f65617 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -33,6 +33,7 @@ END_PROVIDER if (ihpsi_current(k) == 0.d0) then ihpsi_current(k) = 1.d-32 endif +! lambda_mrcc(k,i) = psi_non_ref_coef(i,k)/ihpsi_current(k) lambda_mrcc(k,i) = min(-1.d-32,psi_non_ref_coef(i,k)/ihpsi_current(k) ) lambda_pert = 1.d0 / (psi_ref_energy_diagonalized(k)-hii) if (lambda_pert / lambda_mrcc(k,i) < 0.5d0) then @@ -77,19 +78,6 @@ BEGIN_PROVIDER [ double precision, hij_mrcc, (N_det_non_ref,N_det_ref) ] END_PROVIDER -! BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref,N_det_ref) ] -!&BEGIN_PROVIDER [ double precision, delta_ii, (N_states,N_det_ref) ] -! implicit none -! BEGIN_DOC -! ! Dressing matrix in N_det basis -! END_DOC -! integer :: i,j,m -! delta_ij = 0.d0 -! delta_ii = 0.d0 -! call H_apply_mrcc(delta_ij,delta_ii,N_states,N_det_non_ref,N_det_ref) -! -!END_PROVIDER - BEGIN_PROVIDER [ double precision, h_matrix_dressed, (N_det,N_det,N_states) ] implicit none @@ -173,8 +161,8 @@ END_PROVIDER enddo call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,& N_states_diag,size(CI_eigenvectors_dressed,1)) - deallocate (eigenvectors,eigenvalues) + deallocate (eigenvectors,eigenvalues) else if (diag_algorithm == "Lapack") then @@ -699,14 +687,12 @@ END_PROVIDER allocate(rho_mrcc_init(N_det_non_ref)) allocate(x_new(hh_nex)) allocate(x(hh_nex), AtB(hh_nex)) - x = 0d0 - do s=1,N_states AtB(:) = 0.d0 !$OMP PARALLEL default(none) shared(k, psi_non_ref_coef, active_excitation_to_determinants_idx,& - !$OMP active_excitation_to_determinants_val, x, N_det_ref, hh_nex, N_det_non_ref) & + !$OMP active_excitation_to_determinants_val, N_det_ref, hh_nex, N_det_non_ref) & !$OMP private(at_row, a_col, i, j, r1, r2, wk, A_ind_mwen, A_val_mwen, a_coll, at_roww)& !$OMP shared(N_states,mrcc_col_shortcut, mrcc_N_col, AtB, mrcc_AtA_val, mrcc_AtA_ind, s, n_exc_active, active_pp_idx) @@ -762,21 +748,19 @@ END_PROVIDER end do deallocate(lref) + do i=1,N_det_non_ref + rho_mrcc(i,s) = rho_mrcc_init(i) + enddo + x_new = x double precision :: factor, resold factor = 1.d0 resold = huge(1.d0) - do k=0,hh_nex*hh_nex - !$OMP PARALLEL default(shared) private(cx, i, a_col, a_coll) - - !$OMP DO - do i=1,N_det_non_ref - rho_mrcc(i,s) = rho_mrcc_init(i) - enddo - !$OMP END DO NOWAIT - + do k=0,10*hh_nex + res = 0.d0 + !$OMP PARALLEL default(shared) private(cx, i, a_col, a_coll) reduction(+:res) !$OMP DO do a_coll = 1, n_exc_active a_col = active_pp_idx(a_coll) @@ -785,23 +769,12 @@ END_PROVIDER cx = cx + x(mrcc_AtA_ind(i)) * mrcc_AtA_val(s,i) end do x_new(a_col) = AtB(a_col) + cx * factor - end do - !$OMP END DO - - !$OMP END PARALLEL - - - res = 0.d0 - do a_coll=1,n_exc_active - a_col = active_pp_idx(a_coll) - do j=1,N_det_non_ref - i = active_excitation_to_determinants_idx(j,a_coll) - if (i==0) exit - rho_mrcc(i,s) = rho_mrcc(i,s) + active_excitation_to_determinants_val(s,j,a_coll) * X_new(a_col) - enddo res = res + (X_new(a_col) - X(a_col))*(X_new(a_col) - X(a_col)) X(a_col) = X_new(a_col) end do + !$OMP END DO + !$OMP END PARALLEL + if (res > resold) then factor = factor * 0.5d0 endif @@ -811,9 +784,23 @@ END_PROVIDER print *, "res ", k, res end if - if(res < 1d-12) exit + if(res < 1d-10) exit end do - + dIj_unique(1:size(X), s) = X(1:size(X)) + + enddo + + do s=1,N_states + + do a_coll=1,n_exc_active + a_col = active_pp_idx(a_coll) + do j=1,N_det_non_ref + i = active_excitation_to_determinants_idx(j,a_coll) + if (i==0) exit + rho_mrcc(i,s) = rho_mrcc(i,s) + active_excitation_to_determinants_val(s,j,a_coll) * dIj_unique(a_col,s) + enddo + end do + norm = 0.d0 do i=1,N_det_non_ref norm = norm + rho_mrcc(i,s)*rho_mrcc(i,s) @@ -825,122 +812,11 @@ END_PROVIDER enddo ! Norm now contains the norm of Psi + A.X - print *, k, "res : ", res, "norm : ", sqrt(norm) - -!--------------- -! double precision :: e_0, overlap -! double precision, allocatable :: u_0(:) -! integer(bit_kind), allocatable :: keys_tmp(:,:,:) -! allocate (u_0(N_det), keys_tmp(N_int,2,N_det) ) -! k=0 -! overlap = 0.d0 -! do i=1,N_det_ref -! k = k+1 -! u_0(k) = psi_ref_coef(i,1) -! keys_tmp(:,:,k) = psi_ref(:,:,i) -! overlap += u_0(k)*psi_ref_coef(i,1) -! enddo -! norm = 0.d0 -! do i=1,N_det_non_ref -! k = k+1 -! u_0(k) = psi_non_ref_coef(i,1) -! keys_tmp(:,:,k) = psi_non_ref(:,:,i) -! overlap += u_0(k)*psi_non_ref_coef(i,1) -! enddo -! -! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det) -! print *, 'Energy of |Psi_CASSD> : ', e_0 + nuclear_repulsion, overlap -! -! k=0 -! overlap = 0.d0 -! do i=1,N_det_ref -! k = k+1 -! u_0(k) = psi_ref_coef(i,1) -! keys_tmp(:,:,k) = psi_ref(:,:,i) -! overlap += u_0(k)*psi_ref_coef(i,1) -! enddo -! norm = 0.d0 -! do i=1,N_det_non_ref -! k = k+1 -! ! f is such that f.\tilde{c_i} = c_i -! f = psi_non_ref_coef(i,1) / rho_mrcc(i,1) -! -! ! Avoid numerical instabilities -! f = min(f,2.d0) -! f = max(f,-2.d0) -! -! f = 1.d0 -! -! u_0(k) = rho_mrcc(i,1)*f -! keys_tmp(:,:,k) = psi_non_ref(:,:,i) -! norm += u_0(k)**2 -! overlap += u_0(k)*psi_non_ref_coef(i,1) -! enddo -! -! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det) -! print *, 'Energy of |(1+T)Psi_0> : ', e_0 + nuclear_repulsion, overlap -! -! f = 1.d0/norm -! norm = 1.d0 -! do i=1,N_det_ref -! norm = norm - psi_ref_coef(i,s)*psi_ref_coef(i,s) -! enddo -! f = dsqrt(f*norm) -! overlap = norm -! do i=1,N_det_non_ref -! u_0(k) = rho_mrcc(i,1)*f -! overlap += u_0(k)*psi_non_ref_coef(i,1) -! enddo -! -! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det) -! print *, 'Energy of |(1+T)Psi_0> (normalized) : ', e_0 + nuclear_repulsion, overlap -! -! k=0 -! overlap = 0.d0 -! do i=1,N_det_ref -! k = k+1 -! u_0(k) = psi_ref_coef(i,1) -! keys_tmp(:,:,k) = psi_ref(:,:,i) -! overlap += u_0(k)*psi_ref_coef(i,1) -! enddo -! norm = 0.d0 -! do i=1,N_det_non_ref -! k = k+1 -! ! f is such that f.\tilde{c_i} = c_i -! f = psi_non_ref_coef(i,1) / rho_mrcc(i,1) -! -! ! Avoid numerical instabilities -! f = min(f,2.d0) -! f = max(f,-2.d0) -! -! u_0(k) = rho_mrcc(i,1)*f -! keys_tmp(:,:,k) = psi_non_ref(:,:,i) -! norm += u_0(k)**2 -! overlap += u_0(k)*psi_non_ref_coef(i,1) -! enddo -! -! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det) -! print *, 'Energy of |(1+T)Psi_0> (mu_i): ', e_0 + nuclear_repulsion, overlap -! -! f = 1.d0/norm -! norm = 1.d0 -! do i=1,N_det_ref -! norm = norm - psi_ref_coef(i,s)*psi_ref_coef(i,s) -! enddo -! overlap = norm -! f = dsqrt(f*norm) -! do i=1,N_det_non_ref -! u_0(k) = rho_mrcc(i,1)*f -! overlap += u_0(k)*psi_non_ref_coef(i,1) -! enddo -! -! call u_0_H_u_0(e_0,u_0,N_det,keys_tmp,N_int,1,N_det) -! print *, 'Energy of |(1+T)Psi_0> (normalized mu_i) : ', e_0 + nuclear_repulsion, overlap -! -! deallocate(u_0, keys_tmp) -! -!--------------- + print *, "norm : ", sqrt(norm) + enddo + + do s=1,N_states norm = 0.d0 double precision :: f do i=1,N_det_non_ref @@ -948,12 +824,16 @@ END_PROVIDER rho_mrcc(i,s) = 1.d-32 endif - ! f is such that f.\tilde{c_i} = c_i - f = psi_non_ref_coef(i,s) / rho_mrcc(i,s) + if (lambda_type == 2) then + f = 1.d0 + else + ! f is such that f.\tilde{c_i} = c_i + f = psi_non_ref_coef(i,s) / rho_mrcc(i,s) - ! Avoid numerical instabilities - f = min(f,2.d0) - f = max(f,-2.d0) + ! Avoid numerical instabilities + f = min(f,2.d0) + f = max(f,-2.d0) + endif norm = norm + f*f *rho_mrcc(i,s)*rho_mrcc(i,s) rho_mrcc(i,s) = f @@ -988,7 +868,6 @@ END_PROVIDER ! rho_mrcc now contains the product of the scaling factors and the ! normalization constant - dIj_unique(1:size(X), s) = X(1:size(X)) end do END_PROVIDER diff --git a/plugins/MRCC_Utils/multi_state.irp.f b/plugins/MRCC_Utils/multi_state.irp.f new file mode 100644 index 00000000..b4a2a3cb --- /dev/null +++ b/plugins/MRCC_Utils/multi_state.irp.f @@ -0,0 +1,101 @@ +subroutine multi_state(CI_electronic_energy_dressed_,CI_eigenvectors_dressed_,LDA) + implicit none + BEGIN_DOC + ! Multi-state mixing + END_DOC + integer, intent(in) :: LDA + double precision, intent(inout) :: CI_electronic_energy_dressed_(N_states) + double precision, intent(inout) :: CI_eigenvectors_dressed_(LDA,N_states) + double precision, allocatable :: h(:,:,:), s(:,:), Psi(:,:), H_Psi(:,:,:), H_jj(:) + + allocate( h(N_states,N_states,0:N_states), s(N_states,N_states) ) + allocate( Psi(LDA,N_states), H_Psi(LDA,N_states,0:N_states) ) + allocate (H_jj(LDA) ) + +! e_0(i) = u_dot_v(v_0(1,i),u_0(1,i),n)/u_dot_u(u_0(1,i),n) + + integer :: i,j,k,istate + double precision :: U(N_states,N_states), Vt(N_states,N_states), D(N_states) + double precision, external :: diag_H_mat_elem + do istate=1,N_states + do i=1,N_det + H_jj(i) = diag_H_mat_elem(psi_det(1,1,i),N_int) + enddo + + do i=1,N_det_ref + H_jj(idx_ref(i)) += delta_ii(istate,i) + enddo + + do k=1,N_states + do i=1,N_det + Psi(i,k) = CI_eigenvectors_dressed_(i,k) + enddo + enddo + call H_u_0_mrcc_nstates(H_Psi(1,1,istate),Psi,H_jj,N_det,psi_det,N_int,istate,N_states,LDA) + + do k=1,N_states + do i=1,N_states + double precision, external :: u_dot_v + h(i,k,istate) = u_dot_v(Psi(1,i), H_Psi(1,k,istate), N_det) + enddo + enddo + enddo + + do k=1,N_states + do i=1,N_states + s(i,k) = u_dot_v(Psi(1,i), Psi(1,k), N_det) + enddo + enddo + + print *, s(:,:) + print *, '' + + h(:,:,0) = h(:,:,1) + do istate=2,N_states + U(:,:) = h(:,:,0) + call dgemm('N','N',N_states,N_states,N_states,1.d0,& + U, size(U,1), h(1,1,istate), size(h,1), 0.d0, & + h(1,1,0), size(Vt,1)) + enddo + + call svd(h(1,1,0), size(h,1), U, size(U,1), D, Vt, size(Vt,1), N_states, N_states) + do k=1,N_states + D(k) = D(k)**(1./dble(N_states)) + if (D(k) > 0.d0) then + D(k) = -D(k) + endif + enddo + + do j=1,N_states + do i=1,N_states + h(i,j,0) = 0.d0 + do k=1,N_states + h(i,j,0) += U(i,k) * D(k) * Vt(k,j) + enddo + enddo + enddo + + print *, h(:,:,0) + print *,'' + + integer :: LWORK, INFO + double precision, allocatable :: WORK(:) + LWORK=3*N_states + allocate (WORK(LWORK)) + call dsygv(1, 'V', 'U', N_states, h(1,1,0), size(h,1), s, size(s,1), D, WORK, LWORK, INFO) + deallocate(WORK) + + do j=1,N_states + do i=1,N_det + CI_eigenvectors_dressed_(i,j) = 0.d0 + do k=1,N_states + CI_eigenvectors_dressed_(i,j) += Psi(i,k) * h(k,j,0) + enddo + enddo + CI_electronic_energy_dressed_(j) = D(j) + enddo + + + deallocate (h,s, H_jj) + deallocate( Psi, H_Psi ) +end diff --git a/plugins/MRPT_Utils/EZFIO.cfg b/plugins/MRPT_Utils/EZFIO.cfg index db7b127a..2fcc26ad 100644 --- a/plugins/MRPT_Utils/EZFIO.cfg +++ b/plugins/MRPT_Utils/EZFIO.cfg @@ -5,23 +5,3 @@ interface: ezfio,provider,ocaml default: True -[save_heff_eigenvectors] -type: logical -doc: If true, you save the eigenvectors of the effective hamiltonian -interface: ezfio,provider,ocaml -default: False - - -[pure_state_specific_mrpt2] -type: logical -doc: If true, diagonalize the dressed matrix for each state and do a state following of the initial states -interface: ezfio,provider,ocaml -default: True - - -[N_states_diag_heff] -type: States_number -doc: Number of eigenvectors obtained with the effective hamiltonian -interface: ezfio,provider,ocaml -default: 1 - diff --git a/plugins/MRPT_Utils/ezfio_interface.irp.f b/plugins/MRPT_Utils/ezfio_interface.irp.f index 6c015ef9..3112b9b6 100644 --- a/plugins/MRPT_Utils/ezfio_interface.irp.f +++ b/plugins/MRPT_Utils/ezfio_interface.irp.f @@ -1,6 +1,10 @@ ! DO NOT MODIFY BY HAND ! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py +<<<<<<< HEAD ! from file /home/giner/qp_fork/quantum_package/src/MRPT_Utils/EZFIO.cfg +======= +! from file /home/scemama/quantum_package/src/MRPT_Utils/EZFIO.cfg +>>>>>>> 4a552cc8fe36ae7c8c86eb714c2f032b44330ea0 BEGIN_PROVIDER [ logical, do_third_order_1h1p ] @@ -21,6 +25,7 @@ BEGIN_PROVIDER [ logical, do_third_order_1h1p ] endif END_PROVIDER +<<<<<<< HEAD BEGIN_PROVIDER [ logical, save_heff_eigenvectors ] implicit none @@ -78,3 +83,5 @@ BEGIN_PROVIDER [ logical, pure_state_specific_mrpt2 ] endif END_PROVIDER +======= +>>>>>>> 4a552cc8fe36ae7c8c86eb714c2f032b44330ea0 diff --git a/plugins/MRPT_Utils/mrpt_utils.irp.f b/plugins/MRPT_Utils/mrpt_utils.irp.f index 52bd258b..d7b1f0f6 100644 --- a/plugins/MRPT_Utils/mrpt_utils.irp.f +++ b/plugins/MRPT_Utils/mrpt_utils.irp.f @@ -1,5 +1,5 @@ - BEGIN_PROVIDER [ double precision, delta_ij, (N_det_ref,N_det_ref,N_states) ] + BEGIN_PROVIDER [ double precision, delta_ij, (N_det,N_det,N_states) ] &BEGIN_PROVIDER [ double precision, second_order_pt_new, (N_states) ] &BEGIN_PROVIDER [ double precision, second_order_pt_new_1h, (N_states) ] &BEGIN_PROVIDER [ double precision, second_order_pt_new_1p, (N_states) ] @@ -11,7 +11,7 @@ &BEGIN_PROVIDER [ double precision, second_order_pt_new_2h2p, (N_states) ] implicit none BEGIN_DOC - ! Dressing matrix in N_det_ref basis + ! Dressing matrix in N_det basis END_DOC integer :: i,j,m integer :: i_state @@ -21,18 +21,17 @@ delta_ij = 0.d0 - allocate (delta_ij_tmp(N_det_ref,N_det_ref,N_states)) + allocate (delta_ij_tmp(N_det,N_det,N_states)) ! 1h delta_ij_tmp = 0.d0 - call H_apply_mrpt_1h(delta_ij_tmp,N_det_ref) + call H_apply_mrpt_1h(delta_ij_tmp,N_det) accu = 0.d0 do i_state = 1, N_states - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) - do j = 1, N_det_ref - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) + do i = 1, N_det + do j = 1, N_det + accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) enddo enddo @@ -40,243 +39,169 @@ enddo print*, '1h = ',accu - ! 1p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_1p(delta_ij_tmp,N_det_ref) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) - do j = 1, N_det_ref -! print*, accu -! print*,delta_ij_tmp(j,i,i_state) , psi_ref_coef(i,i_state) , psi_ref_coef(j,i_state) - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_1p(i_state) = accu(i_state) - enddo - print*, '1p = ',accu - - ! 1h1p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_1h1p(delta_ij_tmp,N_det_ref) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) - do j = 1, N_det_ref - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - double precision :: accu_diag,accu_non_diag - accu_diag = 0.d0 - accu_non_diag = 0.d0 - do i = 1, N_det_ref - accu_diag += delta_ij_tmp(i,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(i,i_state) - do j = 1, N_det_ref - if(i == j)cycle - accu_non_diag += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - enddo - enddo - second_order_pt_new_1h1p(i_state) = accu(i_state) - enddo - !double precision :: neutral, ionic - !neutral = 0.d0 - !do i = 1, 2 - ! do j = 1, N_det_ref - ! neutral += psi_ref_coef(j,1) * delta_ij_tmp(j,i,1) * psi_ref_coef(i,1) - ! enddo - !enddo - !do i = 3, 4 - ! do j = 1, N_det_ref - ! ionic += psi_ref_coef(j,1) * delta_ij_tmp(j,i,1) * psi_ref_coef(i,1) - ! enddo - !enddo - !neutral = delta_ij_tmp(1,1,1) * psi_ref_coef(1,1)**2 + delta_ij_tmp(2,2,1) * psi_ref_coef(2,1)**2 & - ! + delta_ij_tmp(1,2,1) * psi_ref_coef(1,1)* psi_ref_coef(2,1) + delta_ij_tmp(2,1,1) * psi_ref_coef(1,1)* psi_ref_coef(2,1) - !ionic = delta_ij_tmp(3,3,1) * psi_ref_coef(3,1)**2 + delta_ij_tmp(4,4,1) * psi_ref_coef(4,1)**2 & - ! + delta_ij_tmp(3,4,1) * psi_ref_coef(3,1)* psi_ref_coef(4,1) + delta_ij_tmp(4,3,1) * psi_ref_coef(3,1)* psi_ref_coef(4,1) - !neutral = delta_ij_tmp(1,1,1) - !ionic = delta_ij_tmp(3,3,1) - !print*, 'neutral = ',neutral - !print*, 'ionic = ',ionic - print*, '1h1p = ',accu - - !! 1h1p third order - !if(do_third_order_1h1p)then - ! delta_ij_tmp = 0.d0 - ! call give_1h1p_sec_order_singles_contrib(delta_ij_tmp) - ! accu = 0.d0 - ! do i_state = 1, N_states - ! do i = 1, N_det_ref - ! write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) - ! do j = 1, N_det_ref - ! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - ! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - ! enddo - ! enddo - ! second_order_pt_new_1h1p(i_state) = accu(i_state) - ! enddo - ! print*, '1h1p(3)',accu - !endif - - ! 2h - delta_ij_tmp = 0.d0 - call H_apply_mrpt_2h(delta_ij_tmp,N_det_ref) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) - do j = 1, N_det_ref - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_2h(i_state) = accu(i_state) - enddo - print*, '2h = ',accu - - ! 2p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_2p(delta_ij_tmp,N_det_ref) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) - do j = 1, N_det_ref - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_2p(i_state) = accu(i_state) - enddo - print*, '2p = ',accu - - ! 1h2p - delta_ij_tmp = 0.d0 - call give_1h2p_contrib(delta_ij_tmp) - !!!call H_apply_mrpt_1h2p(delta_ij_tmp,N_det_ref) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) - do j = 1, N_det_ref - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_1h2p(i_state) = accu(i_state) - enddo - print*, '1h2p = ',accu - - ! 2h1p - delta_ij_tmp = 0.d0 - call give_2h1p_contrib(delta_ij_tmp) - !!!!call H_apply_mrpt_2h1p(delta_ij_tmp,N_det_ref) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) - do j = 1, N_det_ref - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_2h1p(i_state) = accu(i_state) - enddo - print*, '2h1p = ',accu - - ! 2h2p - - double precision :: contrib_2h2p(N_states) - call give_2h2p(contrib_2h2p) - do i_state = 1, N_states - do i = 1, N_det_ref - delta_ij(i,i,i_state) += contrib_2h2p(i_state) - enddo - second_order_pt_new_2h2p(i_state) = contrib_2h2p(i_state) - enddo - print*, '2h2p = ',contrib_2h2p + ! 1p + delta_ij_tmp = 0.d0 + call H_apply_mrpt_1p(delta_ij_tmp,N_det) + accu = 0.d0 + do i_state = 1, N_states + do i = 1, N_det + do j = 1, N_det + accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) + enddo + enddo + second_order_pt_new_1p(i_state) = accu(i_state) + enddo + print*, '1p = ',accu -! ! 2h2p old fashion -! delta_ij_tmp = 0.d0 -! call H_apply_mrpt_2h2p(delta_ij_tmp,N_det_ref) -! accu = 0.d0 -! do i_state = 1, N_states -! do i = 1, N_det_ref -! write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,i_state) -! do j = 1, N_det_ref -! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) -! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) -! enddo -! enddo -! second_order_pt_new_2h2p(i_state) = accu(i_state) -! enddo -! print*, '2h2p = ',accu - + ! 1h1p + delta_ij_tmp = 0.d0 + call H_apply_mrpt_1h1p(delta_ij_tmp,N_det) + double precision :: e_corr_from_1h1p_singles(N_states) +!call give_singles_and_partial_doubles_1h1p_contrib(delta_ij_tmp,e_corr_from_1h1p_singles) +!call give_1h1p_only_doubles_spin_cross(delta_ij_tmp) + accu = 0.d0 + do i_state = 1, N_states + do i = 1, N_det + do j = 1, N_det + accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) + enddo + enddo + second_order_pt_new_1h1p(i_state) = accu(i_state) + enddo + print*, '1h1p = ',accu + + ! 1h1p third order + if(do_third_order_1h1p)then + delta_ij_tmp = 0.d0 + call give_1h1p_sec_order_singles_contrib(delta_ij_tmp) + accu = 0.d0 + do i_state = 1, N_states + do i = 1, N_det + do j = 1, N_det + accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) + enddo + enddo + second_order_pt_new_1h1p(i_state) = accu(i_state) + enddo + print*, '1h1p(3)',accu + endif + + ! 2h + delta_ij_tmp = 0.d0 + call H_apply_mrpt_2h(delta_ij_tmp,N_det) + accu = 0.d0 + do i_state = 1, N_states + do i = 1, N_det + do j = 1, N_det + accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) + enddo + enddo + second_order_pt_new_2h(i_state) = accu(i_state) + enddo + print*, '2h = ',accu + + ! 2p + delta_ij_tmp = 0.d0 + call H_apply_mrpt_2p(delta_ij_tmp,N_det) + accu = 0.d0 + do i_state = 1, N_states + do i = 1, N_det + do j = 1, N_det + accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) + enddo + enddo + second_order_pt_new_2p(i_state) = accu(i_state) + enddo + print*, '2p = ',accu + + ! 1h2p + delta_ij_tmp = 0.d0 +!call give_1h2p_contrib(delta_ij_tmp) + call H_apply_mrpt_1h2p(delta_ij_tmp,N_det) + accu = 0.d0 + do i_state = 1, N_states + do i = 1, N_det + do j = 1, N_det + accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) + enddo + enddo + second_order_pt_new_1h2p(i_state) = accu(i_state) + enddo + print*, '1h2p = ',accu + + ! 2h1p + delta_ij_tmp = 0.d0 +!call give_2h1p_contrib(delta_ij_tmp) + call H_apply_mrpt_2h1p(delta_ij_tmp,N_det) + accu = 0.d0 + do i_state = 1, N_states + do i = 1, N_det + do j = 1, N_det + accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) + delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) + enddo + enddo + second_order_pt_new_2h1p(i_state) = accu(i_state) + enddo + print*, '2h1p = ',accu + + ! 2h2p +!delta_ij_tmp = 0.d0 +!call H_apply_mrpt_2h2p(delta_ij_tmp,N_det) +!accu = 0.d0 +!do i_state = 1, N_states +!do i = 1, N_det +! do j = 1, N_det +! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) +! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) +! enddo +!enddo +!second_order_pt_new_2h2p(i_state) = accu(i_state) +!enddo +!print*, '2h2p = ',accu + + double precision :: contrib_2h2p(N_states) + call give_2h2p(contrib_2h2p) + do i_state = 1, N_states + do i = 1, N_det + delta_ij(i,i,i_state) += contrib_2h2p(i_state) + enddo + second_order_pt_new_2h2p(i_state) = contrib_2h2p(i_state) + enddo + print*, '2h2p = ',contrib_2h2p(1) + ! total accu = 0.d0 - print*, 'naked matrix' - double precision, allocatable :: hmatrix(:,:) - double precision:: hij,h00 - allocate(hmatrix(N_det_ref, N_det_ref)) - call i_h_j(psi_ref(1,1,1),psi_ref(1,1,1),N_int,h00) - do i = 1, N_det_ref - do j = 1, N_det_Ref - call i_h_j(psi_ref(1,1,i),psi_ref(1,1,j),N_int,hij) - hmatrix(i,j) = hij - enddo - hmatrix(i,i) += - h00 - enddo - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')hmatrix(i,:) - enddo - print*, '' - print*, '' - print*, '' do i_state = 1, N_states - print*,'state ',i_state - do i = 1, N_det_ref - do j = 1, N_det_Ref - call i_h_j(psi_ref(1,1,i),psi_ref(1,1,j),N_int,hij) - hmatrix(i,j) = hij - enddo - hmatrix(i,i) += - h00 + do i = 1, N_det +! write(*,'(1000(F16.10,x))')delta_ij(i,:,:) + do j = i_state, N_det + accu(i_state) += delta_ij(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) enddo - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')delta_ij(i,:,i_state) - do j = 1 , N_det_ref - accu(i_state) += delta_ij(j,i,i_state) * psi_ref_coef(i,i_state) * psi_ref_coef(j,i_state) - hmatrix(i,j) += delta_ij(j,i,i_state) - enddo - enddo - second_order_pt_new(i_state) = accu(i_state) - print*, 'total= ',accu(i_state) - - do i = 1, N_det_ref - write(*,'(1000(F16.10,x))')hmatrix(i,:) - enddo - enddo - deallocate(hmatrix) + second_order_pt_new(i_state) = accu(i_state) + print*, 'total= ',accu(i_state) + enddo END_PROVIDER - BEGIN_PROVIDER [double precision, Hmatrix_dressed_pt2_new, (N_det_ref,N_det_ref,N_states)] + BEGIN_PROVIDER [double precision, Hmatrix_dressed_pt2_new, (N_det,N_det,N_states)] implicit none integer :: i,j,i_state - double precision :: hij do i_state = 1, N_states - do i = 1,N_det_ref - do j = 1,N_det_ref - call i_h_j(psi_ref(1,1,j),psi_ref(1,1,i),N_int,hij) - Hmatrix_dressed_pt2_new(j,i,i_state) = hij + delta_ij(j,i,i_state) + do i = 1,N_det + do j = 1,N_det + Hmatrix_dressed_pt2_new(j,i,i_state) = H_matrix_all_dets(j,i) + delta_ij(j,i,i_state) enddo enddo enddo @@ -284,29 +209,23 @@ END_PROVIDER - BEGIN_PROVIDER [double precision, Hmatrix_dressed_pt2_new_symmetrized, (N_det_ref,N_det_ref,N_states)] + BEGIN_PROVIDER [double precision, Hmatrix_dressed_pt2_new_symmetrized, (N_det,N_det,N_states)] implicit none integer :: i,j,i_state - double precision :: hij - double precision :: accu(N_states) - accu = 0.d0 do i_state = 1, N_states - do i = 1,N_det_ref - do j = 1,N_det_ref - call i_h_j(psi_ref(1,1,j),psi_ref(1,1,i),N_int,hij) - Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state) = hij & + do i = 1,N_det + do j = i,N_det + Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state) = H_matrix_all_dets(j,i) & + 0.5d0 * ( delta_ij(j,i,i_state) + delta_ij(i,j,i_state) ) -! Hmatrix_dressed_pt2_new_symmetrized(i,j,i_state) = Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state) - accu(i_State) += psi_ref_coef(i,i_State) * Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state) * psi_ref_coef(j,i_State) + Hmatrix_dressed_pt2_new_symmetrized(i,j,i_state) = Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state) enddo enddo enddo - print*, 'accu = ',accu + nuclear_repulsion END_PROVIDER - BEGIN_PROVIDER [ double precision, CI_electronic_dressed_pt2_new_energy, (N_states_diag_heff) ] - &BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors, (N_det_ref,N_states) ] - &BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors_s2, (N_states) ] + BEGIN_PROVIDER [ double precision, CI_electronic_dressed_pt2_new_energy, (N_states_diag) ] + &BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors, (N_det,N_states_diag) ] + &BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors_s2, (N_states_diag) ] BEGIN_DOC ! Eigenvectors/values of the CI matrix END_DOC @@ -317,25 +236,23 @@ END_PROVIDER logical, allocatable :: good_state_array(:) double precision, allocatable :: s2_values_tmp(:) integer :: i_other_state - double precision, allocatable :: eigenvectors(:,:), eigenvalues(:), hmatrix_tmp(:,:) + double precision, allocatable :: eigenvectors(:,:), eigenvalues(:) integer :: i_state double precision :: s2,e_0 integer :: i,j,k double precision, allocatable :: s2_eigvalues(:) double precision, allocatable :: e_array(:) integer, allocatable :: iorder(:) - double precision :: overlap(N_det_ref) - double precision, allocatable :: psi_tmp(:) - ! Guess values for the "N_states_diag_heff" states of the CI_dressed_pt2_new_eigenvectors - do j=1,min(N_states,N_det_ref) - do i=1,N_det_ref - CI_dressed_pt2_new_eigenvectors(i,j) = psi_ref_coef(i,j) + ! Guess values for the "N_states_diag" states of the CI_dressed_pt2_new_eigenvectors + do j=1,min(N_states_diag,N_det) + do i=1,N_det + CI_dressed_pt2_new_eigenvectors(i,j) = psi_coef(i,j) enddo enddo - do j=min(N_states,N_det_ref)+1,N_states_diag_heff - do i=1,N_det_ref + do j=N_det+1,N_states_diag + do i=1,N_det CI_dressed_pt2_new_eigenvectors(i,j) = 0.d0 enddo enddo @@ -345,165 +262,93 @@ END_PROVIDER print*, 'Davidson not yet implemented for the dressing ... ' stop - else if (diag_algorithm == "Lapack") then - allocate (eigenvectors(N_det_ref,N_det_ref)) - allocate (eigenvalues(N_det_ref)) - if(pure_state_specific_mrpt2)then - allocate (hmatrix_tmp(N_det_ref,N_det_ref)) - allocate (iorder(N_det_ref)) - allocate (psi_tmp(N_det_ref)) - print*,'' - print*,'***************************' - do i_state = 1, N_states !! Big loop over states - print*,'' - print*,'Diagonalizing with the dressing for state',i_state - do i = 1, N_det_ref - do j = 1, N_det_ref - hmatrix_tmp(j,i) = Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state) - enddo -! print*,i,hmatrix_tmp(i,i)+nuclear_repulsion - enddo - call lapack_diag(eigenvalues,eigenvectors,hmatrix_tmp,N_det_ref,N_det_ref) - write(*,'(A86)')'Looking for the most overlapping state within all eigenvectors of the dressed matrix' - print*,'' - print*,'Calculating the overlap for ...' - do i = 1, N_det_ref - overlap(i) = 0.d0 - iorder(i) = i - print*,'eigenvector',i - do j = 1, N_det_ref - overlap(i)+= psi_ref_coef(j,i_state) * eigenvectors(j,i) - enddo - overlap(i) = -dabs(overlap(i)) - print*,'energy = ',eigenvalues(i) + nuclear_repulsion - print*,'overlap = ',dabs(overlap(i)) - enddo - print*,'' - print*,'Sorting the eigenvectors per overlap' - call dsort(overlap,iorder,n_det_ref) - do j = 1, N_det_ref - print*,overlap(j),iorder(j) - enddo - print*,'' - print*,'The most overlapping state is the ',iorder(1) - print*,'with the overlap of ',dabs(overlap(1)) - print*,'and an energy of ',eigenvalues(iorder(1)) + nuclear_repulsion - print*,'Calculating the S^2 value ...' - do i=1,N_det_ref - CI_dressed_pt2_new_eigenvectors(i,i_state) = eigenvectors(i,iorder(1)) - psi_tmp(i) = eigenvectors(i,iorder(1)) - enddo - CI_electronic_dressed_pt2_new_energy(i_state) = eigenvalues(iorder(1)) - print*, 'CI_electronic_dressed_pt2_new_energy',CI_electronic_dressed_pt2_new_energy(i_state) - call u_0_S2_u_0(CI_dressed_pt2_new_eigenvectors_s2(i_state),psi_tmp,N_det_ref,psi_det,N_int,1,N_det_ref) - print*,'S^2 = ', CI_dressed_pt2_new_eigenvectors_s2(i_state) - enddo - !else if(state_average)then - ! print*,'' - ! print*,'***************************' - ! print*,'' - ! print*,'Doing state average dressings' - ! allocate (hmatrix_tmp(N_det_ref,N_det_ref)) - ! hmatrix_tmp = 0.d0 - ! do i_state = 1, N_states !! Big loop over states - ! do i = 1, N_det_ref - ! do j = 1, N_det_ref - ! hmatrix_tmp(j,i) += Hmatrix_dressed_pt2_new_symmetrized(j,i,i_state) - ! enddo - ! enddo - ! enddo + else if (diag_algorithm == "Lapack") then + allocate (eigenvectors(size(H_matrix_all_dets,1),N_det)) + allocate (eigenvalues(N_det)) + call lapack_diag(eigenvalues,eigenvectors, & + H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) + CI_electronic_energy(:) = 0.d0 + if (s2_eig) then + 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)) + 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 + i_state +=1 + index_good_state_array(i_state) = j + good_state_array(j) = .True. + endif + if(i_state.eq.N_states) then + exit + endif + enddo + 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 + CI_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j)) + enddo + CI_electronic_energy(j) = eigenvalues(index_good_state_array(j)) + CI_eigenvectors_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 + i_other_state +=1 + if(i_state+i_other_state.gt.n_states_diag)then + exit + endif + do i=1,N_det + CI_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j) + enddo + CI_electronic_energy(i_state+i_other_state) = eigenvalues(j) + CI_eigenvectors_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) + enddo - ! deallocate(hmatrix_tmp) - - else - - call lapack_diag(eigenvalues,eigenvectors, & - Hmatrix_dressed_pt2_new_symmetrized(1,1,1),N_det_ref,N_det_ref) - CI_electronic_dressed_pt2_new_energy(:) = 0.d0 - if (s2_eig) then - i_state = 0 - allocate (s2_eigvalues(N_det_ref)) - allocate(index_good_state_array(N_det_ref),good_state_array(N_det_ref)) - good_state_array = .False. - call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det_ref,psi_det,N_int,& - N_det_ref,size(eigenvectors,1)) - do j=1,N_det_ref - ! Select at least n_states states with S^2 values closed to "expected_s2" - print*, eigenvalues(j)+nuclear_repulsion, s2_eigvalues(j) - if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then - i_state += 1 - index_good_state_array(i_state) = j - good_state_array(j) = .True. - endif - if (i_state==N_states) then - exit - endif - enddo - if (i_state /= 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_ref - CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j)) - enddo - CI_electronic_dressed_pt2_new_energy(j) = eigenvalues(index_good_state_array(j)) - CI_dressed_pt2_new_eigenvectors_s2(j) = s2_eigvalues(index_good_state_array(j)) - enddo - i_other_state = 0 - do j = 1, N_det_ref - if(good_state_array(j))cycle - i_other_state +=1 - if(i_state+i_other_state.gt.n_states)then - exit - endif - do i=1,N_det_ref - CI_dressed_pt2_new_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j) - enddo - CI_electronic_dressed_pt2_new_energy(i_state+i_other_state) = eigenvalues(j) - CI_dressed_pt2_new_eigenvectors_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) - enddo - - else - print*,'' - print*,'!!!!!!!! WARNING !!!!!!!!!' - print*,' Within the ',N_det_ref,'determinants selected' - print*,' and the ',N_states_diag_heff,'states requested' - print*,' We did not find any state with S^2 values close to ',expected_s2 - print*,' We will then set the first N_states eigenvectors of the H matrix' - print*,' as the CI_dressed_pt2_new_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_heff,N_det_ref) - do i=1,N_det_ref - CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,j) - enddo - CI_electronic_dressed_pt2_new_energy(j) = eigenvalues(j) - CI_dressed_pt2_new_eigenvectors_s2(j) = s2_eigvalues(j) - enddo - endif - deallocate(index_good_state_array,good_state_array) - deallocate(s2_eigvalues) - else - call u_0_S2_u_0(CI_dressed_pt2_new_eigenvectors_s2,eigenvectors,N_det_ref,psi_det,N_int,& - min(N_det_ref,N_states_diag_heff),size(eigenvectors,1)) - ! Select the "N_states_diag_heff" states of lowest energy - do j=1,min(N_det_ref,N_states) - do i=1,N_det_ref - CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,j) - enddo - CI_electronic_dressed_pt2_new_energy(j) = eigenvalues(j) - enddo - endif - deallocate(eigenvectors,eigenvalues) + else + print*,'' + print*,'!!!!!!!! WARNING !!!!!!!!!' + print*,' Within the ',N_det,'determinants selected' + print*,' and the ',N_states_diag,'states requested' + print*,' We did not find any state with S^2 values close to ',expected_s2 + print*,' We will then set the first N_states eigenvectors of the H matrix' + 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) + enddo + CI_electronic_energy(j) = eigenvalues(j) + CI_eigenvectors_s2(j) = s2_eigvalues(j) + enddo + endif + deallocate(index_good_state_array,good_state_array) + deallocate(s2_eigvalues) + else + call u_0_S2_u_0(CI_eigenvectors_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 + CI_eigenvectors(i,j) = eigenvectors(i,j) + enddo + CI_electronic_energy(j) = eigenvalues(j) + enddo endif - - endif + deallocate(eigenvectors,eigenvalues) + endif END_PROVIDER -BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states) ] +BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states_diag) ] implicit none BEGIN_DOC ! N_states lowest eigenvalues of the CI matrix @@ -512,11 +357,11 @@ BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states) ] integer :: j character*(8) :: st call write_time(output_determinants) - do j=1,N_states + do j=1,N_states_diag CI_dressed_pt2_new_energy(j) = CI_electronic_dressed_pt2_new_energy(j) + nuclear_repulsion write(st,'(I4)') j call write_double(output_determinants,CI_dressed_pt2_new_energy(j),'Energy of state '//trim(st)) - call write_double(output_determinants, CI_dressed_pt2_new_eigenvectors_s2(j) ,'S^2 of state '//trim(st)) + call write_double(output_determinants,CI_eigenvectors_s2(j),'S^2 of state '//trim(st)) enddo END_PROVIDER diff --git a/plugins/MRPT_Utils/psi_active_prov.irp.f b/plugins/MRPT_Utils/psi_active_prov.irp.f index ec6bbe50..794742b4 100644 --- a/plugins/MRPT_Utils/psi_active_prov.irp.f +++ b/plugins/MRPT_Utils/psi_active_prov.irp.f @@ -9,12 +9,11 @@ BEGIN_PROVIDER [integer(bit_kind), psi_active, (N_int,2,psi_det_size)] integer :: i,j,k,l provide cas_bitmask !print*, 'psi_active ' - do i = 1, N_det_ref + do i = 1, N_det do j = 1, N_int - psi_active(j,1,i) = iand(psi_ref(j,1,i),cas_bitmask(j,1,1)) - psi_active(j,2,i) = iand(psi_ref(j,2,i),cas_bitmask(j,1,1)) + psi_active(j,1,i) = iand(psi_det(j,1,i),cas_bitmask(j,1,1)) + psi_active(j,2,i) = iand(psi_det(j,2,i),cas_bitmask(j,1,1)) enddo -! call debug_det(psi_active(1,1,i),N_int) enddo END_PROVIDER @@ -181,35 +180,25 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final) double precision :: delta_e_inactive(N_states) - integer :: i_hole_inact, list_holes_inact(n_inact_orb,2) + integer :: i_hole_inact call get_excitation_degree(det_1,det_2,degree,N_int) if(degree>2)then - do i_state = 1, N_States - delta_e_final(i_state) = -1.d+10 - enddo + delta_e_final = -1.d+10 return endif call give_holes_in_inactive_space(det_2,n_holes_spin,n_holes,holes_list) delta_e_inactive = 0.d0 - integer :: n_holes_total - n_holes_total = 0 do i = 1, n_holes_spin(1) i_hole_inact = holes_list(i,1) - n_holes_total +=1 - list_holes_inact(n_holes_total,1) = i_hole_inact - list_holes_inact(n_holes_total,2) = 1 do i_state = 1, N_states - delta_e_inactive(i_state) += fock_core_inactive_total_spin_trace(i_hole_inact,i_state) + delta_e_inactive += fock_core_inactive_total_spin_trace(i_hole_inact,i_state) enddo enddo do i = 1, n_holes_spin(2) i_hole_inact = holes_list(i,2) - n_holes_total +=1 - list_holes_inact(n_holes_total,1) = i_hole_inact - list_holes_inact(n_holes_total,2) = 2 do i_state = 1, N_states delta_e_inactive(i_state) += fock_core_inactive_total_spin_trace(i_hole_inact,i_state) enddo @@ -226,14 +215,14 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final) do i = 1, n_particles_spin(1) i_part_virt = particles_list(i,1) do i_state = 1, N_states - delta_e_virt(i_state) += fock_virt_total_spin_trace(i_part_virt,i_state) + delta_e_virt += fock_virt_total_spin_trace(i_part_virt,i_state) enddo enddo do i = 1, n_particles_spin(2) i_part_virt = particles_list(i,2) do i_state = 1, N_states - delta_e_virt(i_state) += fock_virt_total_spin_trace(i_part_virt,i_state) + delta_e_virt += fock_virt_total_spin_trace(i_part_virt,i_state) enddo enddo @@ -304,39 +293,27 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final) if (n_holes_act == 0 .and. n_particles_act == 1) then ispin = particle_list_practical(1,1) i_particle_act = particle_list_practical(2,1) - call get_excitation_degree(det_1,det_2,degree,N_int) - if(degree == 1)then - call get_excitation(det_1,det_2,exc,degree,phase,N_int) - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - i_hole = list_inact_reverse(h1) - i_part = list_act_reverse(p1) - do i_state = 1, N_states - delta_e_act(i_state) += one_anhil_inact(i_hole,i_part,i_state) - enddo - else if (degree == 2)then +! call get_excitation_degree(det_1,det_2,degree,N_int) +! if(degree == 1)then +! call get_excitation(det_1,det_2,exc,degree,phase,N_int) +! call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) +! i_hole = list_inact_reverse(h1) +! i_part = list_act_reverse(p1) +! do i_state = 1, N_states +! delta_e_act(i_state) += one_anhil_inact(i_hole,i_part,i_state) +! enddo +! else if (degree == 2)then do i_state = 1, N_states delta_e_act(i_state) += one_creat(i_particle_act,ispin,i_state) enddo - endif +! endif else if (n_holes_act == 1 .and. n_particles_act == 0) then ispin = hole_list_practical(1,1) i_hole_act = hole_list_practical(2,1) - call get_excitation_degree(det_1,det_2,degree,N_int) - if(degree == 1)then - call get_excitation(det_1,det_2,exc,degree,phase,N_int) - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - i_hole = list_act_reverse(h1) - i_part = list_virt_reverse(p1) - do i_state = 1, N_states - delta_e_act(i_state) += one_creat_virt(i_hole,i_part,i_state) -! delta_e_act += 1.d12 - enddo - else if (degree == 2)then do i_state = 1, N_states delta_e_act(i_state) += one_anhil(i_hole_act , ispin,i_state) enddo - endif else if (n_holes_act == 1 .and. n_particles_act == 1) then ! first hole @@ -385,44 +362,17 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final) ! first hole ispin = hole_list_practical(1,1) i_hole_act = hole_list_practical(2,1) - ! first particle - kspin = particle_list_practical(1,1) + ! first particle + jspin = particle_list_practical(1,1) i_particle_act = particle_list_practical(2,1) - ! first particle - jspin = particle_list_practical(1,2) + ! second particle + kspin = particle_list_practical(1,2) j_particle_act = particle_list_practical(2,2) + do i_state = 1, N_states - delta_e_act(i_state) += two_creat_one_anhil(i_particle_act,j_particle_act,i_hole_act,kspin,jspin,ispin,i_state) + delta_e_act(i_state) += two_creat_one_anhil(i_particle_act,j_particle_act,i_hole_act,jspin,kspin,ispin,i_state) enddo - -! ! First find the particle that has been added from the inactive -! ! -! integer :: spin_hole_inact, spin_hole_part_act -! spin_hole_inact = list_holes_inact(1,2) -! -! ! by convention, you first make a movement in the cas -! ! first hole -! i_hole_act = hole_list_practical(2,1) -! if(particle_list_practical(1,1) == spin_hole_inact)then -! ! first particle -! i_particle_act = particle_list_practical(1,2) -! ! second particle -! j_particle_act = particle_list_practical(2,2) -! else if (particle_list_practical(1,2) == spin_hole_inact)then -! ! first particle -! i_particle_act = particle_list_practical(2,2) -! ! second particle -! j_particle_act = particle_list_practical(1,2) -! else -! print*, 'pb in n_holes_act == 1 .and. n_particles_act == 2 !!' -! stop -! endif - -! do i_state = 1, N_states -! delta_e_act(i_state) += two_creat_one_anhil(i_particle_act,j_particle_act,i_hole_act,i_state) -! enddo - else if (n_holes_act == 3 .and. n_particles_act == 0) then ! first hole ispin = hole_list_practical(1,1) @@ -469,9 +419,7 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final) enddo endif else if (n_holes_act .ge. 2 .and. n_particles_act .ge.2) then - do i = 1, N_states - delta_e_act(i_state) = -1.d12 - enddo + delta_e_act = -10000000.d0 endif !print*, 'one_anhil_spin_trace' @@ -482,312 +430,6 @@ subroutine get_delta_e_dyall(det_1,det_2,coef_array,hij,delta_e_final) delta_e_final(i_state) = delta_e_act(i_state) + delta_e_inactive(i_state) - delta_e_virt(i_state) enddo !write(*,'(100(f16.10,X))'), delta_e_final(1) , delta_e_act(1) , delta_e_inactive(1) , delta_e_virt(1) -!write(*,'(100(f16.10,X))'), delta_e_final(2) , delta_e_act(2) , delta_e_inactive(2) , delta_e_virt(2) end - -subroutine get_delta_e_dyall_fast(det_1,det_2,delta_e_final) - BEGIN_DOC - ! routine that returns the delta_e with the Moller Plesset and Dyall operators - ! - ! with det_1 being a determinant from the cas, and det_2 being a perturber - ! - ! Delta_e(det_1,det_2) = sum (hole) epsilon(hole) + sum(part) espilon(part) + delta_e(act) - ! - ! where hole is necessary in the inactive, part necessary in the virtuals - ! - ! and delta_e(act) is obtained from the contracted application of the excitation - ! - ! operator in the active space that lead from det_1 to det_2 - END_DOC - implicit none - use bitmasks - double precision, intent(out) :: delta_e_final(N_states) - integer(bit_kind), intent(in) :: det_1(N_int,2),det_2(N_int,2) - integer :: i,j,k,l - integer :: i_state - - integer :: n_holes_spin(2) - integer :: n_holes - integer :: holes_list(N_int*bit_kind_size,2) - - - double precision :: delta_e_inactive(N_states) - integer :: i_hole_inact, list_holes_inact(n_inact_orb,2) - - call get_excitation_degree(det_1,det_2,degree,N_int) - if(degree>2)then - do i_state = 1, N_States - delta_e_final(i_state) = -1.d+10 - enddo - return - endif - - call give_holes_in_inactive_space(det_2,n_holes_spin,n_holes,holes_list) - delta_e_inactive = 0.d0 - integer :: n_holes_total - n_holes_total = 0 - do i = 1, n_holes_spin(1) - i_hole_inact = holes_list(i,1) - n_holes_total +=1 - list_holes_inact(n_holes_total,1) = i_hole_inact - list_holes_inact(n_holes_total,2) = 1 - do i_state = 1, N_states - delta_e_inactive(i_state) += fock_core_inactive_total_spin_trace(i_hole_inact,i_state) - enddo - enddo - - do i = 1, n_holes_spin(2) - i_hole_inact = holes_list(i,2) - n_holes_total +=1 - list_holes_inact(n_holes_total,1) = i_hole_inact - list_holes_inact(n_holes_total,2) = 2 - do i_state = 1, N_states - delta_e_inactive(i_state) += fock_core_inactive_total_spin_trace(i_hole_inact,i_state) - enddo - enddo - - double precision :: delta_e_virt(N_states) - integer :: i_part_virt - integer :: n_particles_spin(2) - integer :: n_particles - integer :: particles_list(N_int*bit_kind_size,2) - - call give_particles_in_virt_space(det_2,n_particles_spin,n_particles,particles_list) - delta_e_virt = 0.d0 - do i = 1, n_particles_spin(1) - i_part_virt = particles_list(i,1) - do i_state = 1, N_states - delta_e_virt(i_state) += fock_virt_total_spin_trace(i_part_virt,i_state) - enddo - enddo - - do i = 1, n_particles_spin(2) - i_part_virt = particles_list(i,2) - do i_state = 1, N_states - delta_e_virt(i_state) += fock_virt_total_spin_trace(i_part_virt,i_state) - enddo - enddo - - - integer :: n_holes_spin_act(2),n_particles_spin_act(2) - integer :: n_holes_act,n_particles_act - integer :: holes_active_list(2*n_act_orb,2) - integer :: holes_active_list_spin_traced(4*n_act_orb) - integer :: particles_active_list(2*n_act_orb,2) - integer :: particles_active_list_spin_traced(4*n_act_orb) - double precision :: delta_e_act(N_states) - delta_e_act = 0.d0 - call give_holes_and_particles_in_active_space(det_1,det_2,n_holes_spin_act,n_particles_spin_act, & - n_holes_act,n_particles_act,holes_active_list,particles_active_list) - integer :: icount,icountbis - integer :: hole_list_practical(2,elec_num_tab(1)+elec_num_tab(2)), particle_list_practical(2,elec_num_tab(1)+elec_num_tab(2)) - icount = 0 - icountbis = 0 - do i = 1, n_holes_spin_act(1) - icount += 1 - icountbis += 1 - hole_list_practical(1,icountbis) = 1 - hole_list_practical(2,icountbis) = holes_active_list(i,1) - holes_active_list_spin_traced(icount) = holes_active_list(i,1) - enddo - do i = 1, n_holes_spin_act(2) - icount += 1 - icountbis += 1 - hole_list_practical(1,icountbis) = 2 - hole_list_practical(2,icountbis) = holes_active_list(i,2) - holes_active_list_spin_traced(icount) = holes_active_list(i,2) - enddo - if(icount .ne. n_holes_act) then - print*,'' - print*, icount, n_holes_act - print * , 'pb in holes_active_list_spin_traced !!' - stop - endif - - icount = 0 - icountbis = 0 - do i = 1, n_particles_spin_act(1) - icount += 1 - icountbis += 1 - particle_list_practical(1,icountbis) = 1 - particle_list_practical(2,icountbis) = particles_active_list(i,1) - particles_active_list_spin_traced(icount) = particles_active_list(i,1) - enddo - do i = 1, n_particles_spin_act(2) - icount += 1 - icountbis += 1 - particle_list_practical(1,icountbis) = 2 - particle_list_practical(2,icountbis) = particles_active_list(i,2) - particles_active_list_spin_traced(icount) = particles_active_list(i,2) - enddo - if(icount .ne. n_particles_act) then - print*, icount, n_particles_act - print * , 'pb in particles_active_list_spin_traced !!' - stop - endif - - - integer :: i_hole_act, j_hole_act, k_hole_act - integer :: i_particle_act, j_particle_act, k_particle_act - - - integer :: ispin,jspin,kspin - if (n_holes_act == 0 .and. n_particles_act == 1) then - ispin = particle_list_practical(1,1) - i_particle_act = particle_list_practical(2,1) - call get_excitation_degree(det_1,det_2,degree,N_int) - if(degree == 1)then - call get_excitation(det_1,det_2,exc,degree,phase,N_int) - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - i_hole = list_inact_reverse(h1) - i_part = list_act_reverse(p1) - do i_state = 1, N_states - delta_e_act(i_state) += one_anhil_inact(i_hole,i_part,i_state) - enddo - else if (degree == 2)then - do i_state = 1, N_states - delta_e_act(i_state) += one_creat(i_particle_act,ispin,i_state) - enddo - endif - - else if (n_holes_act == 1 .and. n_particles_act == 0) then - ispin = hole_list_practical(1,1) - i_hole_act = hole_list_practical(2,1) - call get_excitation_degree(det_1,det_2,degree,N_int) - if(degree == 1)then - call get_excitation(det_1,det_2,exc,degree,phase,N_int) - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - i_hole = list_act_reverse(h1) - i_part = list_virt_reverse(p1) - do i_state = 1, N_states - delta_e_act(i_state) += one_creat_virt(i_hole,i_part,i_state) - enddo - else if (degree == 2)then - do i_state = 1, N_states - delta_e_act(i_state) += one_anhil(i_hole_act , ispin,i_state) - enddo - endif - - else if (n_holes_act == 1 .and. n_particles_act == 1) then - ! first hole - ispin = hole_list_practical(1,1) - i_hole_act = hole_list_practical(2,1) - ! first particle - jspin = particle_list_practical(1,1) - i_particle_act = particle_list_practical(2,1) - do i_state = 1, N_states - delta_e_act(i_state) += one_anhil_one_creat(i_particle_act,i_hole_act,jspin,ispin,i_state) - enddo - - else if (n_holes_act == 2 .and. n_particles_act == 0) then - ispin = hole_list_practical(1,1) - i_hole_act = hole_list_practical(2,1) - jspin = hole_list_practical(1,2) - j_hole_act = hole_list_practical(2,2) - do i_state = 1, N_states - delta_e_act(i_state) += two_anhil(i_hole_act,j_hole_act,ispin,jspin,i_state) - enddo - - else if (n_holes_act == 0 .and. n_particles_act == 2) then - ispin = particle_list_practical(1,1) - i_particle_act = particle_list_practical(2,1) - jspin = particle_list_practical(1,2) - j_particle_act = particle_list_practical(2,2) - do i_state = 1, N_states - delta_e_act(i_state) += two_creat(i_particle_act,j_particle_act,ispin,jspin,i_state) - enddo - - else if (n_holes_act == 2 .and. n_particles_act == 1) then - ! first hole - ispin = hole_list_practical(1,1) - i_hole_act = hole_list_practical(2,1) - ! second hole - jspin = hole_list_practical(1,2) - j_hole_act = hole_list_practical(2,2) - ! first particle - kspin = particle_list_practical(1,1) - i_particle_act = particle_list_practical(2,1) - do i_state = 1, N_states - delta_e_act(i_state) += two_anhil_one_creat(i_particle_act,i_hole_act,j_hole_act,kspin,ispin,jspin,i_state) - enddo - - else if (n_holes_act == 1 .and. n_particles_act == 2) then - - ! first hole - ispin = hole_list_practical(1,1) - i_hole_act = hole_list_practical(2,1) - ! first particle - kspin = particle_list_practical(1,1) - i_particle_act = particle_list_practical(2,1) - ! first particle - jspin = particle_list_practical(1,2) - j_particle_act = particle_list_practical(2,2) - do i_state = 1, N_states - delta_e_act(i_state) += two_creat_one_anhil(i_particle_act,j_particle_act,i_hole_act,kspin,jspin,ispin,i_state) - enddo - - else if (n_holes_act == 3 .and. n_particles_act == 0) then - ! first hole - ispin = hole_list_practical(1,1) - i_hole_act = hole_list_practical(2,1) - ! second hole - jspin = hole_list_practical(1,2) - j_hole_act = hole_list_practical(2,2) - ! third hole - kspin = hole_list_practical(1,3) - k_hole_act = hole_list_practical(2,3) - do i_state = 1, N_states - delta_e_act(i_state) += three_anhil(i_hole_act,j_hole_act,k_hole_act,ispin,jspin,kspin,i_state) - enddo - - else if (n_holes_act == 0 .and. n_particles_act == 3) then - ! first particle - ispin = particle_list_practical(1,1) - i_particle_act = particle_list_practical(2,1) - ! second particle - jspin = particle_list_practical(1,2) - j_particle_act = particle_list_practical(2,2) - ! second particle - kspin = particle_list_practical(1,3) - k_particle_act = particle_list_practical(2,3) - do i_state = 1, N_states - delta_e_act(i_state) += three_creat(i_particle_act,j_particle_act,k_particle_act,ispin,jspin,kspin,i_state) - enddo - - else if (n_holes_act .eq. 0 .and. n_particles_act .eq.0)then - integer :: degree - integer(bit_kind) :: det_1_active(N_int,2) - integer :: h1,h2,p1,p2,s1,s2 - integer :: exc(0:2,2,2) - integer :: i_hole, i_part - double precision :: phase - call get_excitation_degree(det_1,det_2,degree,N_int) - if(degree == 1)then - call get_excitation(det_1,det_2,exc,degree,phase,N_int) - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - i_hole = list_inact_reverse(h1) - i_part = list_virt_reverse(p1) - do i_state = 1, N_states - delta_e_act(i_state) += one_anhil_one_creat_inact_virt(i_hole,i_part,i_state) - enddo - endif - else if (n_holes_act .ge. 2 .and. n_particles_act .ge.2) then - do i = 1, N_states - delta_e_act(i_state) = -10000000.d0 - enddo - endif - -!print*, 'one_anhil_spin_trace' -!print*, one_anhil_spin_trace(1), one_anhil_spin_trace(2) - - - do i_state = 1, n_states - delta_e_final(i_state) = delta_e_act(i_state) + delta_e_inactive(i_state) - delta_e_virt(i_state) - enddo -!write(*,'(100(f16.10,X))'), delta_e_final(2) , delta_e_act(2) , delta_e_inactive(2) , delta_e_virt(2) - -end - - diff --git a/plugins/Perturbation/README.rst b/plugins/Perturbation/README.rst index 810a58e1..1657e079 100644 --- a/plugins/Perturbation/README.rst +++ b/plugins/Perturbation/README.rst @@ -88,6 +88,7 @@ Needed Modules * `Properties `_ * `Hartree_Fock `_ +* `Davidson `_ Documentation ============= @@ -107,13 +108,13 @@ Documentation Undocumented -perturb_buffer_by_mono_delta_rho_one_point - Applly pertubration ``delta_rho_one_point`` to the buffer of determinants generated in the H_apply +perturb_buffer_by_mono_dipole_moment_z + Applly pertubration ``dipole_moment_z`` to the buffer of determinants generated in the H_apply routine. -perturb_buffer_by_mono_dipole_moment_z - Applly pertubration ``dipole_moment_z`` to the buffer of determinants generated in the H_apply +perturb_buffer_by_mono_dummy + Applly pertubration ``dummy`` to the buffer of determinants generated in the H_apply routine. @@ -152,13 +153,13 @@ perturb_buffer_by_mono_moller_plesset routine. -perturb_buffer_delta_rho_one_point - Applly pertubration ``delta_rho_one_point`` to the buffer of determinants generated in the H_apply +perturb_buffer_dipole_moment_z + Applly pertubration ``dipole_moment_z`` to the buffer of determinants generated in the H_apply routine. -perturb_buffer_dipole_moment_z - Applly pertubration ``dipole_moment_z`` to the buffer of determinants generated in the H_apply +perturb_buffer_dummy + Applly pertubration ``dummy`` to the buffer of determinants generated in the H_apply routine. @@ -197,27 +198,6 @@ perturb_buffer_moller_plesset routine. -`pt2_delta_rho_one_point `_ - compute the perturbatibe contribution to the Integrated Spin density at z = z_one point of one determinant - .br - for the various n_st states, at various level of theory. - .br - c_pert(i) = /( - ) - .br - e_2_pert(i) = c_pert(i) * - .br - H_pert_diag(i) = c_pert(i)^2 * - .br - To get the contribution of the first order : - .br - = sum(over i) e_2_pert(i) - .br - To get the contribution of the diagonal elements of the second order : - .br - [ + + sum(over i) H_pert_diag(i) ] / [1. + sum(over i) c_pert(i) **2] - .br - - `pt2_dipole_moment_z `_ compute the perturbatibe contribution to the dipole moment of one determinant .br @@ -239,7 +219,11 @@ perturb_buffer_moller_plesset .br -`pt2_epstein_nesbet `_ +`pt2_dummy `_ + Dummy perturbation to add all connected determinants. + + +`pt2_epstein_nesbet `_ compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution .br for the various N_st states. @@ -250,7 +234,7 @@ perturb_buffer_moller_plesset .br -`pt2_epstein_nesbet_2x2 `_ +`pt2_epstein_nesbet_2x2 `_ compute the Epstein-Nesbet 2x2 diagonalization coefficient and energetic contribution .br for the various N_st states. @@ -261,7 +245,7 @@ perturb_buffer_moller_plesset .br -`pt2_epstein_nesbet_sc2 `_ +`pt2_epstein_nesbet_sc2 `_ compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution .br for the various N_st states, but with the CISD_SC2 energies and coefficients @@ -272,7 +256,7 @@ perturb_buffer_moller_plesset .br -`pt2_epstein_nesbet_sc2_no_projected `_ +`pt2_epstein_nesbet_sc2_no_projected `_ compute the Epstein-Nesbet perturbative first order coefficient and second order energetic contribution .br for the various N_st states, @@ -296,7 +280,7 @@ perturb_buffer_moller_plesset H_pert_diag = c_pert -`pt2_epstein_nesbet_sc2_projected `_ +`pt2_epstein_nesbet_sc2_projected `_ compute the Epstein-Nesbet perturbative first order coefficient and second order energetic contribution .br for the various N_st states, @@ -331,12 +315,12 @@ perturb_buffer_moller_plesset .br -`pt2_max `_ +`pt2_max `_ The selection process stops when the largest PT2 (for all the state) is lower than pt2_max in absolute value -`pt2_moller_plesset `_ +`pt2_moller_plesset `_ compute the standard Moller-Plesset perturbative first order coefficient and second order energetic contribution .br for the various n_st states. @@ -368,7 +352,7 @@ perturb_buffer_moller_plesset Threshold to select determinants. Set by selection routines. -`var_pt2_ratio `_ +`var_pt2_ratio `_ The selection process stops when the energy ratio variational/(variational+PT2) is equal to var_pt2_ratio diff --git a/plugins/Psiref_CAS/.gitignore b/plugins/Psiref_CAS/.gitignore index 69ebdc69..d79d94d9 100644 --- a/plugins/Psiref_CAS/.gitignore +++ b/plugins/Psiref_CAS/.gitignore @@ -3,6 +3,7 @@ .ninja_log AO_Basis Bitmask +Davidson Determinants Electrons Ezfio_files diff --git a/plugins/Psiref_CAS/README.rst b/plugins/Psiref_CAS/README.rst index 5d511317..a217e36c 100644 --- a/plugins/Psiref_CAS/README.rst +++ b/plugins/Psiref_CAS/README.rst @@ -58,6 +58,7 @@ Needed Modules .. image:: tree_dependency.png * `Psiref_Utils `_ +* `Davidson `_ Documentation ============= diff --git a/plugins/Psiref_Utils/README.rst b/plugins/Psiref_Utils/README.rst index 35232d23..2ceb6b98 100644 --- a/plugins/Psiref_Utils/README.rst +++ b/plugins/Psiref_Utils/README.rst @@ -154,11 +154,11 @@ Documentation Compute 1st dimension such that it is aligned for vectorization. -`apply_rotation `_ +`apply_rotation `_ Apply the rotation found by find_rotation -`approx_dble `_ +`approx_dble `_ Undocumented @@ -181,19 +181,19 @@ Documentation Binomial coefficients -`dble_fact `_ +`dble_fact `_ Undocumented -`dble_fact_even `_ +`dble_fact_even `_ n!! -`dble_fact_odd `_ +`dble_fact_odd `_ n!! -`dble_logfact `_ +`dble_logfact `_ n!! @@ -219,6 +219,10 @@ Documentation contains the new order of the elements. +`dtranspose `_ + Transpose input matrix A into output matrix B + + `erf0 `_ Undocumented @@ -236,11 +240,11 @@ Documentation n! -`fact_inv `_ +`fact_inv `_ 1/n! -`find_rotation `_ +`find_rotation `_ Find A.C = B @@ -270,7 +274,7 @@ Documentation Returns the index of the determinant in the ``psi_ref_sorted_bit`` array -`get_pseudo_inverse `_ +`get_pseudo_inverse `_ Find C = A^-1 @@ -531,7 +535,7 @@ Documentation to be in integer*8 format -`inv_int `_ +`inv_int `_ 1/i @@ -571,7 +575,7 @@ Documentation contains the new order of the elements. -`lapack_diag `_ +`lapack_diag `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -582,7 +586,7 @@ Documentation .br -`lapack_diag_s2 `_ +`lapack_diag_s2 `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -593,7 +597,7 @@ Documentation .br -`lapack_diagd `_ +`lapack_diagd `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -604,7 +608,7 @@ Documentation .br -`lapack_partial_diag `_ +`lapack_partial_diag `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -615,14 +619,22 @@ Documentation .br -`logfact `_ +`logfact `_ n! -`lowercase `_ +`lowercase `_ Transform to lower case +`map_load_from_disk `_ + Undocumented + + +`map_save_to_disk `_ + Undocumented + + `multiply_poly `_ Multiply two polynomials D(t) =! D(t) +( B(t)*C(t)) @@ -635,12 +647,12 @@ Documentation idx_non_ref_rev gives the reverse. -`normalize `_ +`normalize `_ Normalizes vector u u is expected to be aligned in memory. -`nproc `_ +`nproc `_ Number of current OpenMP threads @@ -662,7 +674,7 @@ Documentation .br -`ortho_lowdin `_ +`ortho_lowdin `_ Compute C_new=C_old.S^-1/2 orthogonalization. .br overlap : overlap matrix @@ -680,6 +692,19 @@ Documentation .br +`ortho_qr `_ + Orthogonalization using Q.R factorization + .br + A : matrix to orthogonalize + .br + LDA : leftmost dimension of A + .br + n : Number of rows of A + .br + m : Number of columns of A + .br + + `overlap_a_b_c `_ Undocumented @@ -860,7 +885,7 @@ Documentation to be in integer*8 format -`set_zero_extra_diag `_ +`set_zero_extra_diag `_ Undocumented @@ -887,18 +912,22 @@ Documentation .br -`u_dot_u `_ +`transpose `_ + Transpose input matrix A into output matrix B + + +`u_dot_u `_ Compute -`u_dot_v `_ +`u_dot_v `_ Compute -`wall_time `_ +`wall_time `_ The equivalent of cpu_time, but for the wall time. -`write_git_log `_ +`write_git_log `_ Write the last git commit in file iunit. diff --git a/plugins/Psiref_threshold/psi_ref.irp.f b/plugins/Psiref_threshold/psi_ref.irp.f index 5e722822..ee69ef5c 100644 --- a/plugins/Psiref_threshold/psi_ref.irp.f +++ b/plugins/Psiref_threshold/psi_ref.irp.f @@ -6,19 +6,22 @@ use bitmasks &BEGIN_PROVIDER [ integer, N_det_ref ] implicit none BEGIN_DOC - ! Reference wave function, defined as determinants with coefficients > 0.05 + ! Reference wave function, defined as determinants with amplitudes > 0.05 ! idx_ref gives the indice of the ref determinant in psi_det. END_DOC integer :: i, k, l logical :: good - double precision, parameter :: threshold=0.05d0 + double precision, parameter :: threshold=0.05d0 + double precision :: t(N_states) N_det_ref = 0 - t = threshold * abs_psi_coef_max + do l = 1, N_states + t(l) = threshold * abs_psi_coef_max(l) + enddo do i=1,N_det good = .False. - do l = 1, N_states + do l=1, N_states psi_ref_coef(i,l) = 0.d0 - good = good.or.(dabs(psi_coef(i,l)) > t) + good = good.or.(dabs(psi_coef(i,l)) > t(l)) enddo if (good) then N_det_ref = N_det_ref+1 diff --git a/plugins/QmcChem/e_curve_qmc.irp.f b/plugins/QmcChem/e_curve_qmc.irp.f index 4beed3fa..169db84e 100644 --- a/plugins/QmcChem/e_curve_qmc.irp.f +++ b/plugins/QmcChem/e_curve_qmc.irp.f @@ -1,10 +1,12 @@ program e_curve use bitmasks implicit none - integer :: i,j,k, nab, m, l + integer :: i,j,k, kk, nab, m, l double precision :: norm, E, hij, num, ci, cj integer, allocatable :: iorder(:) double precision , allocatable :: norm_sort(:) + PROVIDE mo_bielec_integrals_in_map + nab = n_det_alpha_unique+n_det_beta_unique allocate ( norm_sort(0:nab), iorder(0:nab) ) @@ -60,7 +62,7 @@ program e_curve num = 0.d0 norm = 0.d0 m = 0 - !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,l,det_i,det_j,ci,cj,hij) REDUCTION(+:norm,m,num) + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,kk,l,det_i,det_j,ci,cj,hij) REDUCTION(+:norm,m,num) allocate( det_i(N_int,2), det_j(N_int,2)) !$OMP DO SCHEDULE(guided) do k=1,n_det @@ -68,15 +70,19 @@ program e_curve cycle endif ci = psi_bilinear_matrix_values(k,1) - det_i(:,1) = psi_det_alpha_unique(:,psi_bilinear_matrix_rows(k)) - det_i(:,2) = psi_det_beta_unique(:,psi_bilinear_matrix_columns(k)) + do kk=1,N_int + det_i(kk,1) = psi_det_alpha_unique(kk,psi_bilinear_matrix_rows(k)) + det_i(kk,2) = psi_det_beta_unique(kk,psi_bilinear_matrix_columns(k)) + enddo do l=1,n_det if (psi_bilinear_matrix_values(l,1) == 0.d0) then cycle endif cj = psi_bilinear_matrix_values(l,1) - det_j(:,1) = psi_det_alpha_unique(:,psi_bilinear_matrix_rows(l)) - det_j(:,2) = psi_det_beta_unique(:,psi_bilinear_matrix_columns(l)) + do kk=1,N_int + det_j(kk,1) = psi_det_alpha_unique(kk,psi_bilinear_matrix_rows(l)) + det_j(kk,2) = psi_det_beta_unique(kk,psi_bilinear_matrix_columns(l)) + enddo call i_h_j(det_i, det_j, N_int, hij) num = num + ci*cj*hij enddo diff --git a/plugins/Selectors_full/README.rst b/plugins/Selectors_full/README.rst index 393e9421..fc264fc1 100644 --- a/plugins/Selectors_full/README.rst +++ b/plugins/Selectors_full/README.rst @@ -161,15 +161,19 @@ Documentation n_double_selectors = number of double excitations in the selectors determinants -`psi_selectors `_ +`psi_selectors `_ Determinants on which we apply for perturbation. -`psi_selectors_coef `_ +`psi_selectors_coef `_ Determinants on which we apply for perturbation. -`psi_selectors_diag_h_mat `_ +`psi_selectors_coef_transp `_ + Transposed psi_selectors + + +`psi_selectors_diag_h_mat `_ Diagonal elements of the H matrix for each selectors @@ -177,7 +181,7 @@ Documentation Undocumented -`zmq_get_psi `_ +`zmq_get_psi `_ Get the wave function from the qp_run scheduler diff --git a/plugins/Selectors_no_sorted/tree_dependency.png b/plugins/Selectors_no_sorted/tree_dependency.png new file mode 100644 index 00000000..e69de29b diff --git a/plugins/mrcc_selected/dressing.irp.f b/plugins/mrcc_selected/dressing.irp.f new file mode 100644 index 00000000..c772e2aa --- /dev/null +++ b/plugins/mrcc_selected/dressing.irp.f @@ -0,0 +1,1076 @@ +use bitmasks + + + + BEGIN_PROVIDER [ double precision, delta_ij_mrcc, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii_mrcc, (N_states, N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2_mrcc, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii_s2_mrcc, (N_states, N_det_ref) ] + use bitmasks + implicit none + integer :: gen, h, p, n, t, i, h1, h2, p1, p2, s1, s2, iproc + integer(bit_kind) :: mask(N_int, 2), omask(N_int, 2) + integer(bit_kind),allocatable :: buf(:,:,:) + logical :: ok + logical, external :: detEq + + delta_ij_mrcc = 0d0 + delta_ii_mrcc = 0d0 + delta_ij_s2_mrcc = 0d0 + delta_ii_s2_mrcc = 0d0 + PROVIDE dij + provide hh_shortcut psi_det_size! lambda_mrcc + !$OMP PARALLEL DO default(none) schedule(dynamic) & + !$OMP shared(psi_det_generators, N_det_generators, hh_exists, pp_exists, N_int, hh_shortcut) & + !$OMP shared(N_det_non_ref, N_det_ref, delta_ii_mrcc, delta_ij_mrcc, delta_ii_s2_mrcc, delta_ij_s2_mrcc) & + !$OMP private(h, n, mask, omask, buf, ok, iproc) + do gen= 1, N_det_generators + allocate(buf(N_int, 2, N_det_non_ref)) + iproc = omp_get_thread_num() + 1 + if(mod(gen, 1000) == 0) print *, "mrcc ", gen, "/", N_det_generators + do h=1, hh_shortcut(0) + call apply_hole_local(psi_det_generators(1,1,gen), hh_exists(1, h), mask, ok, N_int) + if(.not. ok) cycle + omask = 0_bit_kind + if(hh_exists(1, h) /= 0) omask = mask + n = 1 + do p=hh_shortcut(h), hh_shortcut(h+1)-1 + call apply_particle_local(mask, pp_exists(1, p), buf(1,1,n), ok, N_int) + if(ok) n = n + 1 + if(n > N_det_non_ref) stop "MRCC..." + end do + n = n - 1 + + if(n /= 0) then + call mrcc_part_dress(delta_ij_mrcc, delta_ii_mrcc, delta_ij_s2_mrcc, delta_ii_s2_mrcc, gen,n,buf,N_int,omask) + endif + + end do + deallocate(buf) + end do + !$OMP END PARALLEL DO +END_PROVIDER + + +! subroutine blit(b1, b2) +! double precision :: b1(N_states,N_det_non_ref,N_det_ref), b2(N_states,N_det_non_ref,N_det_ref) +! b1 = b1 + b2 +! end subroutine + + +subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_generator,n_selected,det_buffer,Nint,key_mask) + use bitmasks + implicit none + + integer, intent(in) :: i_generator,n_selected, Nint + double precision, intent(inout) :: delta_ij_(N_states,N_det_non_ref,N_det_ref) + double precision, intent(inout) :: delta_ii_(N_states,N_det_ref) + double precision, intent(inout) :: delta_ij_s2_(N_states,N_det_non_ref,N_det_ref) + double precision, intent(inout) :: delta_ii_s2_(N_states,N_det_ref) + + integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) + integer :: i,j,k,l,m + integer,allocatable :: idx_alpha(:), degree_alpha(:) + logical :: good, fullMatch + + integer(bit_kind),allocatable :: tq(:,:,:) + integer :: N_tq, c_ref ,degree + + double precision :: hIk, hla, hIl, sla, dIk(N_states), dka(N_states), dIa(N_states) + double precision, allocatable :: dIa_hla(:,:), dIa_sla(:,:) + double precision :: haj, phase, phase2 + double precision :: f(N_states), ci_inv(N_states) + integer :: exc(0:2,2,2) + integer :: h1,h2,p1,p2,s1,s2 + integer(bit_kind) :: tmp_det(Nint,2) + integer :: iint, ipos + integer :: i_state, k_sd, l_sd, i_I, i_alpha + + integer(bit_kind),allocatable :: miniList(:,:,:) + integer(bit_kind),intent(in) :: key_mask(Nint, 2) + integer,allocatable :: idx_miniList(:) + integer :: N_miniList, ni, leng + double precision, allocatable :: hij_cache(:), sij_cache(:) + + integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:) + integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) + integer :: mobiles(2), smallerlist + logical, external :: detEq, is_generable + !double precision, external :: get_dij, get_dij_index + + + leng = max(N_det_generators, N_det_non_ref) + allocate(miniList(Nint, 2, leng), tq(Nint,2,n_selected), idx_minilist(leng), hij_cache(N_det_non_ref), sij_cache(N_det_non_ref)) + allocate(idx_alpha(0:psi_det_size), degree_alpha(psi_det_size)) + !create_minilist_find_previous(key_mask, fullList, miniList, N_fullList, N_miniList, fullMatch, Nint) + call create_minilist_find_previous(key_mask, psi_det_generators, miniList, i_generator-1, N_miniList, fullMatch, Nint) + +! if(fullMatch) then +! return +! end if + + allocate(ptr_microlist(0:mo_tot_num*2+1), & + N_microlist(0:mo_tot_num*2) ) + allocate( microlist(Nint,2,N_minilist*4), & + idx_microlist(N_minilist*4)) + + if(key_mask(1,1) /= 0) then + call create_microlist(miniList, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) + call filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microlist,ptr_microlist,N_microlist,key_mask) + else + call filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_minilist) + end if + + + + deallocate(microlist, idx_microlist) + + allocate (dIa_hla(N_states,N_det_non_ref), dIa_sla(N_states,N_det_non_ref)) + + ! |I> + + ! |alpha> + + if(N_tq > 0) then + call create_minilist(key_mask, psi_non_ref, miniList, idx_minilist, N_det_non_ref, N_minilist, Nint) + if(N_minilist == 0) return + + + if(key_mask(1,1) /= 0) then !!!!!!!!!!! PAS GENERAL !!!!!!!!! + allocate(microlist_zero(Nint,2,N_minilist), idx_microlist_zero(N_minilist)) + + allocate( microlist(Nint,2,N_minilist*4), & + idx_microlist(N_minilist*4)) + call create_microlist(miniList, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) + + + do i=0,mo_tot_num*2 + do k=ptr_microlist(i),ptr_microlist(i+1)-1 + idx_microlist(k) = idx_minilist(idx_microlist(k)) + end do + end do + + do l=1,N_microlist(0) + do k=1,Nint + microlist_zero(k,1,l) = microlist(k,1,l) + microlist_zero(k,2,l) = microlist(k,2,l) + enddo + idx_microlist_zero(l) = idx_microlist(l) + enddo + end if + end if + + + do i_alpha=1,N_tq + if(key_mask(1,1) /= 0) then + call getMobiles(tq(1,1,i_alpha), key_mask, mobiles, Nint) + + if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then + smallerlist = mobiles(1) + else + smallerlist = mobiles(2) + end if + + + do l=0,N_microlist(smallerlist)-1 + microlist_zero(:,:,ptr_microlist(1) + l) = microlist(:,:,ptr_microlist(smallerlist) + l) + idx_microlist_zero(ptr_microlist(1) + l) = idx_microlist(ptr_microlist(smallerlist) + l) + end do + + call get_excitation_degree_vector(microlist_zero,tq(1,1,i_alpha),degree_alpha,Nint,N_microlist(smallerlist)+N_microlist(0),idx_alpha) + do j=1,idx_alpha(0) + idx_alpha(j) = idx_microlist_zero(idx_alpha(j)) + end do + + else + call get_excitation_degree_vector(miniList,tq(1,1,i_alpha),degree_alpha,Nint,N_minilist,idx_alpha) + do j=1,idx_alpha(0) + idx_alpha(j) = idx_miniList(idx_alpha(j)) + end do + end if + + + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hij_cache(k_sd)) + call get_s2(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,sij_cache(k_sd)) + enddo + ! |I> + do i_I=1,N_det_ref + ! Find triples and quadruple grand parents + call get_excitation_degree(tq(1,1,i_alpha),psi_ref(1,1,i_I),degree,Nint) + if (degree > 4) then + cycle + endif + + do i_state=1,N_states + dIa(i_state) = 0.d0 + enddo + + ! |alpha> + do k_sd=1,idx_alpha(0) + ! Loop if lambda == 0 + logical :: loop +! loop = .True. +! do i_state=1,N_states +! if (lambda_mrcc(i_state,idx_alpha(k_sd)) /= 0.d0) then +! loop = .False. +! exit +! endif +! enddo +! if (loop) then +! cycle +! endif + + call get_excitation_degree(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),degree,Nint) + if (degree > 2) then + cycle + endif + + ! + ! + !hIk = hij_mrcc(idx_alpha(k_sd),i_I) + ! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(k_sd)),Nint,hIk) + + do i_state=1,N_states + dIK(i_state) = dij(i_I, idx_alpha(k_sd), i_state) + !dIk(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(k_sd)), N_int) !!hIk * lambda_mrcc(i_state,idx_alpha(k_sd)) + !dIk(i_state) = psi_non_ref_coef(idx_alpha(k_sd), i_state) / psi_ref_coef(i_I, i_state) + enddo + + + ! |l> = Exc(k -> alpha) |I> + call get_excitation(psi_non_ref(1,1,idx_alpha(k_sd)),tq(1,1,i_alpha),exc,degree,phase,Nint) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + do k=1,N_int + tmp_det(k,1) = psi_ref(k,1,i_I) + tmp_det(k,2) = psi_ref(k,2,i_I) + enddo + logical :: ok + call apply_excitation(psi_ref(1,1,i_I), exc, tmp_det, ok, Nint) + if(.not. ok) cycle + + ! + do i_state=1,N_states + dka(i_state) = 0.d0 + enddo + do l_sd=k_sd+1,idx_alpha(0) + call get_excitation_degree(tmp_det,psi_non_ref(1,1,idx_alpha(l_sd)),degree,Nint) + if (degree == 0) then + +! loop = .True. +! do i_state=1,N_states +! if (lambda_mrcc(i_state,idx_alpha(l_sd)) /= 0.d0) then +! loop = .False. +! exit +! endif +! enddo + loop = .false. + if (.not.loop) then + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),exc,degree,phase2,Nint) + hIl = hij_mrcc(idx_alpha(l_sd),i_I) +! call i_h_j(psi_ref(1,1,i_I),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hIl) + do i_state=1,N_states + dka(i_state) = dij(i_I, idx_alpha(l_sd), i_state) * phase * phase2 + !dka(i_state) = get_dij(psi_ref(1,1,i_I), psi_non_ref(1,1,idx_alpha(l_sd)), N_int) * phase * phase2 !hIl * lambda_mrcc(i_state,idx_alpha(l_sd)) * phase * phase2 + !dka(i_state) = psi_non_ref_coef(idx_alpha(l_sd), i_state) / psi_ref_coef(i_I, i_state) * phase * phase2 + enddo + endif + + exit + endif + enddo + do i_state=1,N_states + dIa(i_state) = dIa(i_state) + dIk(i_state) * dka(i_state) + enddo + enddo + + do i_state=1,N_states + ci_inv(i_state) = psi_ref_coef_inv(i_I,i_state) + enddo + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + hla = hij_cache(k_sd) + sla = sij_cache(k_sd) +! call i_h_j(tq(1,1,i_alpha),psi_non_ref(1,1,idx_alpha(l_sd)),Nint,hla) + do i_state=1,N_states + dIa_hla(i_state,k_sd) = dIa(i_state) * hla + dIa_sla(i_state,k_sd) = dIa(i_state) * sla + enddo + enddo + call omp_set_lock( psi_ref_lock(i_I) ) + do i_state=1,N_states + if(dabs(psi_ref_coef(i_I,i_state)).ge.1.d-3)then + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd) + delta_ii_(i_state,i_I) = delta_ii_(i_state,i_I) - dIa_hla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) + delta_ij_s2_(i_state,k_sd,i_I) = delta_ij_s2_(i_state,k_sd,i_I) + dIa_sla(i_state,k_sd) + delta_ii_s2_(i_state,i_I) = delta_ii_s2_(i_state,i_I) - dIa_sla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) + enddo + else + delta_ii_(i_state,i_I) = 0.d0 + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + 0.5d0*dIa_hla(i_state,k_sd) + delta_ij_s2_(i_state,k_sd,i_I) = delta_ij_s2_(i_state,k_sd,i_I) + 0.5d0*dIa_sla(i_state,k_sd) + enddo + endif + enddo + call omp_unset_lock( psi_ref_lock(i_I) ) + enddo + enddo + deallocate (dIa_hla,dIa_sla,hij_cache,sij_cache) + deallocate(miniList, idx_miniList) +end + + + + + BEGIN_PROVIDER [ double precision, delta_ij, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii, (N_states, N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii_s2, (N_states, N_det_ref) ] + use bitmasks + implicit none + integer :: i, j, i_state + + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc + + if(mrmode == 3) then + do i = 1, N_det_ref + do i_state = 1, N_states + delta_ii(i_state,i)= delta_ii_mrcc(i_state,i) + delta_ii_s2(i_state,i)= delta_ii_s2_mrcc(i_state,i) + enddo + do j = 1, N_det_non_ref + do i_state = 1, N_states + delta_ij(i_state,j,i) = delta_ij_mrcc(i_state,j,i) + delta_ij_s2(i_state,j,i) = delta_ij_s2_mrcc(i_state,j,i) + enddo + end do + end do + + ! =-=-= BEGIN STATE AVERAGE +! do i = 1, N_det_ref +! delta_ii(:,i)= delta_ii_mrcc(1,i) +! delta_ii_s2(:,i)= delta_ii_s2_mrcc(1,i) +! do i_state = 2, N_states +! delta_ii(:,i) += delta_ii_mrcc(i_state,i) +! delta_ii_s2(:,i) += delta_ii_s2_mrcc(i_state,i) +! enddo +! do j = 1, N_det_non_ref +! delta_ij(:,j,i) = delta_ij_mrcc(1,j,i) +! delta_ij_s2(:,j,i) = delta_ij_s2_mrcc(1,j,i) +! do i_state = 2, N_states +! delta_ij(:,j,i) += delta_ij_mrcc(i_state,j,i) +! delta_ij_s2(:,j,i) += delta_ij_s2_mrcc(i_state,j,i) +! enddo +! end do +! end do +! delta_ij = delta_ij * (1.d0/dble(N_states)) +! delta_ii = delta_ii * (1.d0/dble(N_states)) + ! =-=-= END STATE AVERAGE + ! + ! do i = 1, N_det_ref + ! delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) - delta_sub_ii(i,i_state) + ! do j = 1, N_det_non_ref + ! delta_ij(i_state,j,i) = delta_mrcepa0_ij(i,j,i_state) - delta_sub_ij(i,j,i_state) + ! end do + ! end do + else if(mrmode == 2) then + do i = 1, N_det_ref + do i_state = 1, N_states + delta_ii(i_state,i)= delta_ii_old(i_state,i) + delta_ii_s2(i_state,i)= delta_ii_s2_old(i_state,i) + enddo + do j = 1, N_det_non_ref + do i_state = 1, N_states + delta_ij(i_state,j,i) = delta_ij_old(i_state,j,i) + delta_ij_s2(i_state,j,i) = delta_ij_s2_old(i_state,j,i) + enddo + end do + end do + else if(mrmode == 1) then + do i = 1, N_det_ref + do i_state = 1, N_states + delta_ii(i_state,i)= delta_mrcepa0_ii(i,i_state) + delta_ii_s2(i_state,i)= delta_mrcepa0_ii_s2(i,i_state) + enddo + do j = 1, N_det_non_ref + do i_state = 1, N_states + delta_ij(i_state,j,i) = delta_mrcepa0_ij(i,j,i_state) + delta_ij_s2(i_state,j,i) = delta_mrcepa0_ij_s2(i,j,i_state) + enddo + end do + end do + else + stop "invalid mrmode" + end if +END_PROVIDER + + +BEGIN_PROVIDER [ integer, HP, (2,N_det_non_ref) ] + integer :: i + do i=1,N_det_non_ref + call getHP(psi_non_ref(1,1,i), HP(1,i), HP(2,i), N_int) + end do +END_PROVIDER + + BEGIN_PROVIDER [ integer, cepa0_shortcut, (0:N_det_non_ref+1) ] +&BEGIN_PROVIDER [ integer, det_cepa0_idx, (N_det_non_ref) ] +&BEGIN_PROVIDER [ integer(bit_kind), det_cepa0_active, (N_int,2,N_det_non_ref) ] +&BEGIN_PROVIDER [ integer(bit_kind), det_ref_active, (N_int,2,N_det_ref) ] +&BEGIN_PROVIDER [ integer(bit_kind), active_sorb, (N_int,2) ] +&BEGIN_PROVIDER [ integer(bit_kind), det_cepa0, (N_int,2,N_det_non_ref) ] +&BEGIN_PROVIDER [ integer, nlink, (N_det_ref) ] +&BEGIN_PROVIDER [ integer, linked, (N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ integer, blokMwen, (N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, searchance, (N_det_ref) ] +&BEGIN_PROVIDER [ integer, child_num, (N_det_non_ref,N_det_ref) ] + + use bitmasks + implicit none + + integer(bit_kind),allocatable :: det_noactive(:,:,:) + integer, allocatable :: shortcut(:), idx(:) + integer(bit_kind) :: nonactive_sorb(N_int,2), det(N_int, 2) + integer i, II, j, k, n, ni, blok, degree + logical, external :: detEq + + allocate(det_noactive(N_int, 2, N_det_non_ref)) + allocate(idx(N_det_non_ref), shortcut(0:N_det_non_ref+1)) + print *, "pre start" + active_sorb(:,:) = 0_8 + nonactive_sorb(:,:) = not(0_8) + + if(N_det_ref > 1) then + do i=1, N_det_ref + do k=1, N_int + active_sorb(k,1) = ior(psi_ref(k,1,i), active_sorb(k,1)) + active_sorb(k,2) = ior(psi_ref(k,2,i), active_sorb(k,2)) + nonactive_sorb(k,1) = iand(psi_ref(k,1,i), nonactive_sorb(k,1)) + nonactive_sorb(k,2) = iand(psi_ref(k,2,i), nonactive_sorb(k,2)) + end do + end do + do k=1, N_int + active_sorb(k,1) = iand(active_sorb(k,1), not(nonactive_sorb(k,1))) + active_sorb(k,2) = iand(active_sorb(k,2), not(nonactive_sorb(k,2))) + end do + end if + + + do i=1, N_det_non_ref + do k=1, N_int + det_noactive(k,1,i) = iand(psi_non_ref(k,1,i), not(active_sorb(k,1))) + det_noactive(k,2,i) = iand(psi_non_ref(k,2,i), not(active_sorb(k,2))) + end do + end do + + call sort_dets_ab(det_noactive, det_cepa0_idx, cepa0_shortcut, N_det_non_ref, N_int) + + do i=1,N_det_non_ref + det_cepa0(:,:,i) = psi_non_ref(:,:,det_cepa0_idx(i)) + end do + + cepa0_shortcut(0) = 1 + cepa0_shortcut(1) = 1 + do i=2,N_det_non_ref + if(.not. detEq(det_noactive(1,1,i), det_noactive(1,1,i-1), N_int)) then + cepa0_shortcut(0) += 1 + cepa0_shortcut(cepa0_shortcut(0)) = i + end if + end do + cepa0_shortcut(cepa0_shortcut(0)+1) = N_det_non_ref+1 + + if(.true.) then + do i=1,cepa0_shortcut(0) + n = cepa0_shortcut(i+1) - cepa0_shortcut(i) + call sort_dets_ab(det_cepa0(1,1,cepa0_shortcut(i)), idx, shortcut, n, N_int) + do k=1,n + idx(k) = det_cepa0_idx(cepa0_shortcut(i)-1+idx(k)) + end do + det_cepa0_idx(cepa0_shortcut(i):cepa0_shortcut(i)+n-1) = idx(:n) + end do + end if + + + do i=1,N_det_ref + do k=1, N_int + det_ref_active(k,1,i) = iand(psi_ref(k,1,i), active_sorb(k,1)) + det_ref_active(k,2,i) = iand(psi_ref(k,2,i), active_sorb(k,2)) + end do + end do + + do i=1,N_det_non_ref + do k=1, N_int + det_cepa0_active(k,1,i) = iand(psi_non_ref(k,1,det_cepa0_idx(i)), active_sorb(k,1)) + det_cepa0_active(k,2,i) = iand(psi_non_ref(k,2,det_cepa0_idx(i)), active_sorb(k,2)) + end do + end do + + do i=1,N_det_non_ref + if(.not. detEq(psi_non_ref(1,1,det_cepa0_idx(i)), det_cepa0(1,1,i),N_int)) stop "STOOOP" + end do + + searchance = 0d0 + child_num = 0 + do J = 1, N_det_ref + nlink(J) = 0 + do blok=1,cepa0_shortcut(0) + do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) + if(degree <= 2) then + nlink(J) += 1 + linked(nlink(J),J) = k + child_num(k, J) = nlink(J) + blokMwen(nlink(J),J) = blok + searchance(J) += 1d0 + log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) + end if + end do + end do + end do + print *, "pre done" +END_PROVIDER + + +! BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] +! use bitmasks +! implicit none +! integer :: i,j,k +! double precision :: Hjk, Hki, Hij, pre(N_det_ref), wall +! integer :: i_state, degree, npre, ipre(N_det_ref), npres(N_det_ref) +! +! ! provide lambda_mrcc +! npres = 0 +! delta_cas = 0d0 +! call wall_time(wall) +! print *, "dcas ", wall +! do i_state = 1, N_states +! !!$OMP PARALLEL DO default(none) schedule(dynamic) private(pre,npre,ipre,j,k,Hjk,Hki,degree) shared(npres,lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,N_det_ref) +! do k=1,N_det_non_ref +! if(lambda_mrcc(i_state, k) == 0d0) cycle +! npre = 0 +! do i=1,N_det_ref +! call i_h_j(psi_non_ref(1,1,k),psi_ref(1,1,i), N_int,Hki) +! if(Hki /= 0d0) then +! !!$OMP ATOMIC +! npres(i) += 1 +! npre += 1 +! ipre(npre) = i +! pre(npre) = Hki +! end if +! end do +! +! +! do i=1,npre +! do j=1,i +! !!$OMP ATOMIC +! delta_cas(ipre(i),ipre(j),i_state) += pre(i) * pre(j) * lambda_mrcc(i_state, k) +! end do +! end do +! end do +! !!$OMP END PARALLEL DO +! npre=0 +! do i=1,N_det_ref +! npre += npres(i) +! end do +! !stop +! do i=1,N_det_ref +! do j=1,i +! delta_cas(j,i,i_state) = delta_cas(i,j,i_state) +! end do +! end do +! end do +! +! call wall_time(wall) +! print *, "dcas", wall +! ! stop +! END_PROVIDER + + + BEGIN_PROVIDER [ double precision, delta_cas, (N_det_ref, N_det_ref, N_states) ] +&BEGIN_PROVIDER [ double precision, delta_cas_s2, (N_det_ref, N_det_ref, N_states) ] + use bitmasks + implicit none + integer :: i,j,k + double precision :: Sjk,Hjk, Hki, Hij + !double precision, external :: get_dij + integer i_state, degree + + provide lambda_mrcc dIj + do i_state = 1, N_states + !$OMP PARALLEL DO default(none) schedule(dynamic) private(j,k,Sjk,Hjk,Hki,degree) shared(lambda_mrcc,i_state, N_det_non_ref,psi_ref, psi_non_ref,N_int,delta_cas,delta_cas_s2,N_det_ref,dij) + do i=1,N_det_ref + do j=1,i + call get_excitation_degree(psi_ref(1,1,i), psi_ref(1,1,j), degree, N_int) + delta_cas(i,j,i_state) = 0d0 + delta_cas_s2(i,j,i_state) = 0d0 + do k=1,N_det_non_ref + + call i_h_j(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Hjk) + call get_s2(psi_ref(1,1,j), psi_non_ref(1,1,k),N_int,Sjk) + + delta_cas(i,j,i_state) += Hjk * dij(i, k, i_state) ! * Hki * lambda_mrcc(i_state, k) + delta_cas_s2(i,j,i_state) += Sjk * dij(i, k, i_state) ! * Ski * lambda_mrcc(i_state, k) + end do + delta_cas(j,i,i_state) = delta_cas(i,j,i_state) + delta_cas_s2(j,i,i_state) = delta_cas_s2(i,j,i_state) + end do + end do + !$OMP END PARALLEL DO + end do + END_PROVIDER + + + + +logical function isInCassd(a,Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: a(Nint,2) + integer(bit_kind) :: inac, virt + integer :: ni, i, deg + + + isInCassd = .false. + + deg = 0 + do i=1,2 + do ni=1,Nint + virt = iand(not(HF_bitmask(ni,i)), not(active_sorb(ni,i))) + deg += popcnt(iand(virt, a(ni,i))) + if(deg > 2) return + end do + end do + + deg = 0 + do i=1,2 + do ni=1,Nint + inac = iand(HF_bitmask(ni,i), not(active_sorb(ni,i))) + deg += popcnt(xor(iand(inac,a(ni,i)), inac)) + if(deg > 2) return + end do + end do + isInCassd = .true. +end function + + +subroutine getHP(a,h,p,Nint) + use bitmasks + implicit none + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: a(Nint,2) + integer, intent(out) :: h, p + integer(bit_kind) :: inac, virt + integer :: ni, i, deg + + + !isInCassd = .false. + h = 0 + p = 0 + + deg = 0 + lp : do i=1,2 + do ni=1,Nint + virt = iand(not(HF_bitmask(ni,i)), not(active_sorb(ni,i))) + deg += popcnt(iand(virt, a(ni,i))) + if(deg > 2) exit lp + end do + end do lp + p = deg + + deg = 0 + lh : do i=1,2 + do ni=1,Nint + inac = iand(HF_bitmask(ni,i), not(active_sorb(ni,i))) + deg += popcnt(xor(iand(inac,a(ni,i)), inac)) + if(deg > 2) exit lh + end do + end do lh + h = deg + !isInCassd = .true. +end function + + + BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii, (N_det_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij_s2, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_mrcepa0_ii_s2, (N_det_ref,N_states) ] + use bitmasks + implicit none + + integer :: i_state, i, i_I, J, k, degree, degree2, m, l, deg, ni + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_, sortRefIdx(N_det_ref) + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_IJ, phase_al, diI, hIi, hJi, delta_JI, dkI(1), HkI, ci_inv(1), dia_hla(1) + double precision :: contrib, contrib2, contrib_s2, contrib2_s2, HIIi, HJk, wall + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), made_hole(N_int,2), made_particle(N_int,2), myActive(N_int,2) + integer(bit_kind),allocatable :: sortRef(:,:,:) + integer, allocatable :: idx_sorted_bit(:) + integer, external :: get_index_in_psi_det_sorted_bit, searchDet + logical, external :: is_in_wavefunction, detEq + !double precision, external :: get_dij + integer :: II, blok + integer*8, save :: notf = 0 + + call wall_time(wall) + allocate(idx_sorted_bit(N_det), sortRef(N_int,2,N_det_ref)) + + sortRef(:,:,:) = det_ref_active(:,:,:) + call sort_det(sortRef, sortRefIdx, N_det_ref, N_int) + + idx_sorted_bit(:) = -1 + do i=1,N_det_non_ref + idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i + enddo + + ! To provide everything + contrib = dij(1, 1, 1) + + delta_mrcepa0_ii(:,:) = 0d0 + delta_mrcepa0_ij(:,:,:) = 0d0 + delta_mrcepa0_ii_s2(:,:) = 0d0 + delta_mrcepa0_ij_s2(:,:,:) = 0d0 + + do i_state = 1, N_states + !$OMP PARALLEL DO default(none) schedule(dynamic) shared(delta_mrcepa0_ij, delta_mrcepa0_ii, delta_mrcepa0_ij_s2, delta_mrcepa0_ii_s2) & + !$OMP private(m,i,II,J,k,degree,myActive,made_hole,made_particle,hjk,contrib,contrib2,contrib_s2,contrib2_s2) & + !$OMP shared(active_sorb, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef, cepa0_shortcut, det_cepa0_active) & + !$OMP shared(N_det_ref, N_det_non_ref,N_int,det_cepa0_idx,lambda_mrcc,det_ref_active, delta_cas, delta_cas_s2) & + !$OMP shared(notf,i_state, sortRef, sortRefIdx, dij) + do blok=1,cepa0_shortcut(0) + do i=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 + do II=1,N_det_ref + call get_excitation_degree(psi_ref(1,1,II),psi_non_ref(1,1,det_cepa0_idx(i)),degree,N_int) + if (degree > 2 ) cycle + + do ni=1,N_int + made_hole(ni,1) = iand(det_ref_active(ni,1,II), xor(det_cepa0_active(ni,1,i), det_ref_active(ni,1,II))) + made_hole(ni,2) = iand(det_ref_active(ni,2,II), xor(det_cepa0_active(ni,2,i), det_ref_active(ni,2,II))) + + made_particle(ni,1) = iand(det_cepa0_active(ni,1,i), xor(det_cepa0_active(ni,1,i), det_ref_active(ni,1,II))) + made_particle(ni,2) = iand(det_cepa0_active(ni,2,i), xor(det_cepa0_active(ni,2,i), det_ref_active(ni,2,II))) + end do + + + kloop: do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 !i + !if(lambda_mrcc(i_state, det_cepa0_idx(k)) == 0d0) cycle + + do ni=1,N_int + if(iand(made_hole(ni,1), det_cepa0_active(ni,1,k)) /= 0) cycle kloop + if(iand(made_particle(ni,1), det_cepa0_active(ni,1,k)) /= made_particle(ni,1)) cycle kloop + if(iand(made_hole(ni,2), det_cepa0_active(ni,2,k)) /= 0) cycle kloop + if(iand(made_particle(ni,2), det_cepa0_active(ni,2,k)) /= made_particle(ni,2)) cycle kloop + end do + do ni=1,N_int + myActive(ni,1) = xor(det_cepa0_active(ni,1,k), made_hole(ni,1)) + myActive(ni,1) = xor(myActive(ni,1), made_particle(ni,1)) + myActive(ni,2) = xor(det_cepa0_active(ni,2,k), made_hole(ni,2)) + myActive(ni,2) = xor(myActive(ni,2), made_particle(ni,2)) + end do + + j = searchDet(sortRef, myActive, N_det_ref, N_int) + if(j == -1) then + cycle + end if + j = sortRefIdx(j) + !$OMP ATOMIC + notf = notf+1 + +! call i_h_j(psi_non_ref(1,1,det_cepa0_idx(k)),psi_ref(1,1,J),N_int,HJk) + contrib = delta_cas(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state) + contrib_s2 = delta_cas_s2(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state) + + if(dabs(psi_ref_coef(J,i_state)).ge.1.d-3) then + contrib2 = contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state) + contrib2_s2 = contrib_s2 / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state) + !$OMP ATOMIC + delta_mrcepa0_ii(J,i_state) -= contrib2 + delta_mrcepa0_ii_s2(J,i_state) -= contrib2_s2 + else + contrib = contrib * 0.5d0 + contrib_s2 = contrib_s2 * 0.5d0 + end if + !$OMP ATOMIC + delta_mrcepa0_ij(J, det_cepa0_idx(i), i_state) += contrib + delta_mrcepa0_ij_s2(J, det_cepa0_idx(i), i_state) += contrib_s2 + + end do kloop + end do + end do + end do + !$OMP END PARALLEL DO + end do + deallocate(idx_sorted_bit) + call wall_time(wall) + print *, "cepa0", wall, notf + +END_PROVIDER + + + BEGIN_PROVIDER [ double precision, delta_sub_ij, (N_det_ref,N_det_non_ref,N_states) ] +&BEGIN_PROVIDER [ double precision, delta_sub_ii, (N_det_ref, N_states) ] + use bitmasks + implicit none + + integer :: i_state, i, i_I, J, k, degree, degree2, l, deg, ni + integer :: p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_ + logical :: ok + double precision :: phase_Ji, phase_Ik, phase_Ii + double precision :: contrib, contrib2, delta_IJk, HJk, HIk, HIl + integer, dimension(0:2,2,2) :: exc_Ik, exc_Ji, exc_Ii + integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2) + integer, allocatable :: idx_sorted_bit(:) + integer, external :: get_index_in_psi_det_sorted_bit + + integer :: II, blok + + provide delta_cas lambda_mrcc + allocate(idx_sorted_bit(N_det)) + idx_sorted_bit(:) = -1 + do i=1,N_det_non_ref + idx_sorted_bit(get_index_in_psi_det_sorted_bit(psi_non_ref(1,1,i), N_int)) = i + enddo + + do i_state = 1, N_states + delta_sub_ij(:,:,:) = 0d0 + delta_sub_ii(:,:) = 0d0 + + provide mo_bielec_integrals_in_map + + + !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_sub_ij, delta_sub_ii) & + !$OMP private(i, J, k, degree, degree2, l, deg, ni) & + !$OMP private(p1,p2,h1,h2,s1,s2, p1_,p2_,h1_,h2_,s1_,s2_) & + !$OMP private(ok, phase_Ji, phase_Ik, phase_Ii, contrib2, contrib, delta_IJk, HJk, HIk, HIl, exc_Ik, exc_Ji, exc_Ii) & + !$OMP private(det_tmp, det_tmp2, II, blok) & + !$OMP shared(idx_sorted_bit, N_det_non_ref, N_det_ref, N_int, psi_non_ref, psi_non_ref_coef, psi_ref, psi_ref_coef) & + !$OMP shared(i_state,lambda_mrcc, hf_bitmask, active_sorb) + do i=1,N_det_non_ref + if(mod(i,1000) == 0) print *, i, "/", N_det_non_ref + do J=1,N_det_ref + call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_Ji,degree,phase_Ji,N_int) + if(degree == -1) cycle + + + do II=1,N_det_ref + call apply_excitation(psi_ref(1,1,II),exc_Ji,det_tmp,ok,N_int) + + if(.not. ok) cycle + l = get_index_in_psi_det_sorted_bit(det_tmp, N_int) + if(l == 0) cycle + l = idx_sorted_bit(l) + + call i_h_j(psi_ref(1,1,II), det_tmp, N_int, HIl) + + do k=1,N_det_non_ref + if(lambda_mrcc(i_state, k) == 0d0) cycle + call get_excitation(psi_ref(1,1,II),psi_non_ref(1,1,k),exc_Ik,degree2,phase_Ik,N_int) + + det_tmp(:,:) = 0_bit_kind + det_tmp2(:,:) = 0_bit_kind + + ok = .true. + do ni=1,N_int + det_tmp(ni,1) = iand(xor(HF_bitmask(ni,1), psi_non_ref(ni,1,k)), not(active_sorb(ni,1))) + det_tmp(ni,2) = iand(xor(HF_bitmask(ni,1), psi_non_ref(ni,1,i)), not(active_sorb(ni,1))) + ok = ok .and. (popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) == popcnt(xor(det_tmp(ni,1), det_tmp(ni,2)))) + + det_tmp(ni,1) = iand(xor(HF_bitmask(ni,2), psi_non_ref(ni,2,k)), not(active_sorb(ni,2))) + det_tmp(ni,2) = iand(xor(HF_bitmask(ni,2), psi_non_ref(ni,2,i)), not(active_sorb(ni,2))) + ok = ok .and. (popcnt(det_tmp(ni,1)) + popcnt(det_tmp(ni,2)) == popcnt(xor(det_tmp(ni,1), det_tmp(ni,2)))) + end do + + if(ok) cycle + + + call i_h_j(psi_ref(1,1,J), psi_non_ref(1,1,k), N_int, HJk) + call i_h_j(psi_ref(1,1,II), psi_non_ref(1,1,k), N_int, HIk) + if(HJk == 0) cycle + !assert HIk == 0 + delta_IJk = HJk * HIk * lambda_mrcc(i_state, k) + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + if(ok) cycle + contrib = delta_IJk * HIl * lambda_mrcc(i_state,l) + if(dabs(psi_ref_coef(II,i_state)).ge.1.d-3) then + contrib2 = contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(l,i_state) + !$OMP ATOMIC + delta_sub_ii(II,i_state) -= contrib2 + else + contrib = contrib * 0.5d0 + endif + !$OMP ATOMIC + delta_sub_ij(II, i, i_state) += contrib + end do + end do + end do + end do + !$OMP END PARALLEL DO + end do + deallocate(idx_sorted_bit) +END_PROVIDER + + +subroutine set_det_bit(det, p, s) + implicit none + integer(bit_kind),intent(inout) :: det(N_int, 2) + integer, intent(in) :: p, s + integer :: ni, pos + + ni = (p-1)/bit_kind_size + 1 + pos = mod(p-1, bit_kind_size) + det(ni,s) = ibset(det(ni,s), pos) +end subroutine + + + BEGIN_PROVIDER [ double precision, h_cache, (N_det_ref,N_det_non_ref) ] +&BEGIN_PROVIDER [ double precision, s2_cache, (N_det_ref,N_det_non_ref) ] + implicit none + integer :: i,j + do i=1,N_det_ref + do j=1,N_det_non_ref + call i_h_j(psi_ref(1,1,i), psi_non_ref(1,1,j), N_int, h_cache(i,j)) + call get_s2(psi_ref(1,1,i), psi_non_ref(1,1,j), N_int, s2_cache(i,j)) + end do + end do +END_PROVIDER + + + +subroutine filter_tq(i_generator,n_selected,det_buffer,Nint,tq,N_tq,miniList,N_miniList) + + use bitmasks + implicit none + + integer, intent(in) :: i_generator,n_selected, Nint + + integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) + integer :: i,j,k,m + logical :: is_in_wavefunction + integer,allocatable :: degree(:) + integer,allocatable :: idx(:) + logical :: good + + integer(bit_kind), intent(inout) :: tq(Nint,2,n_selected) !! intent(out) + integer, intent(out) :: N_tq + + integer :: nt,ni + logical, external :: is_connected_to, is_generable + + integer(bit_kind),intent(in) :: miniList(Nint,2,N_det_generators) + integer,intent(in) :: N_miniList + + allocate(degree(psi_det_size)) + allocate(idx(0:psi_det_size)) + N_tq = 0 + + i_loop : do i=1,N_selected + do k=1, N_minilist + if(is_generable(miniList(1,1,k), det_buffer(1,1,i), Nint)) cycle i_loop + end do + + ! Select determinants that are triple or quadruple excitations + ! from the ref + good = .True. + call get_excitation_degree_vector(psi_ref,det_buffer(1,1,i),degree,Nint,N_det_ref,idx) + !good=(idx(0) == 0) tant que degree > 2 pas retourné par get_excitation_degree_vector + do k=1,idx(0) + if (degree(k) < 3) then + good = .False. + exit + endif + enddo + if (good) then + if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint)) then + N_tq += 1 + do k=1,N_int + tq(k,1,N_tq) = det_buffer(k,1,i) + tq(k,2,N_tq) = det_buffer(k,2,i) + enddo + endif + endif + enddo i_loop +end + + +subroutine filter_tq_micro(i_generator,n_selected,det_buffer,Nint,tq,N_tq,microlist,ptr_microlist,N_microlist,key_mask) + + use bitmasks + implicit none + + integer, intent(in) :: i_generator,n_selected, Nint + + integer(bit_kind), intent(in) :: det_buffer(Nint,2,n_selected) + integer :: i,j,k,m + logical :: is_in_wavefunction + integer,allocatable :: degree(:) + integer,allocatable :: idx(:) + logical :: good + + integer(bit_kind), intent(inout) :: tq(Nint,2,n_selected) !! intent(out) + integer, intent(out) :: N_tq + + integer :: nt,ni + logical, external :: is_connected_to, is_generable + + integer(bit_kind),intent(in) :: microlist(Nint,2,*) + integer,intent(in) :: ptr_microlist(0:*) + integer,intent(in) :: N_microlist(0:*) + integer(bit_kind),intent(in) :: key_mask(Nint, 2) + + integer :: mobiles(2), smallerlist + + + allocate(degree(psi_det_size)) + allocate(idx(0:psi_det_size)) + N_tq = 0 + + i_loop : do i=1,N_selected + call getMobiles(det_buffer(1,1,i), key_mask, mobiles, Nint) + if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then + smallerlist = mobiles(1) + else + smallerlist = mobiles(2) + end if + + if(N_microlist(smallerlist) > 0) then + do k=ptr_microlist(smallerlist), ptr_microlist(smallerlist)+N_microlist(smallerlist)-1 + if(is_generable(microlist(1,1,k), det_buffer(1,1,i), Nint)) cycle i_loop + end do + end if + + if(N_microlist(0) > 0) then + do k=1, N_microlist(0) + if(is_generable(microlist(1,1,k), det_buffer(1,1,i), Nint)) cycle i_loop + end do + end if + + ! Select determinants that are triple or quadruple excitations + ! from the ref + good = .True. + call get_excitation_degree_vector(psi_ref,det_buffer(1,1,i),degree,Nint,N_det_ref,idx) + !good=(idx(0) == 0) tant que degree > 2 pas retourné par get_excitation_degree_vector + do k=1,idx(0) + if (degree(k) < 3) then + good = .False. + exit + endif + enddo + if (good) then + if (.not. is_in_wavefunction(det_buffer(1,1,i),Nint)) then + N_tq += 1 + do k=1,N_int + tq(k,1,N_tq) = det_buffer(k,1,i) + tq(k,2,N_tq) = det_buffer(k,2,i) + enddo + endif + endif + enddo i_loop +end + + + + diff --git a/plugins/mrcc_selected/dressing_slave.irp.f b/plugins/mrcc_selected/dressing_slave.irp.f new file mode 100644 index 00000000..c2e5dd55 --- /dev/null +++ b/plugins/mrcc_selected/dressing_slave.irp.f @@ -0,0 +1,601 @@ +subroutine mrsc2_dressing_slave_tcp(i) + implicit none + integer, intent(in) :: i + BEGIN_DOC +! Task for parallel MR-SC2 + END_DOC + call mrsc2_dressing_slave(0,i) +end + + +subroutine mrsc2_dressing_slave_inproc(i) + implicit none + integer, intent(in) :: i + BEGIN_DOC +! Task for parallel MR-SC2 + END_DOC + call mrsc2_dressing_slave(1,i) +end + +subroutine mrsc2_dressing_slave(thread,iproc) + use f77_zmq + + implicit none + BEGIN_DOC +! Task for parallel MR-SC2 + END_DOC + integer, intent(in) :: thread, iproc +! integer :: j,l + integer :: rc + + integer :: worker_id, task_id + character*(512) :: task + + integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + integer(ZMQ_PTR), external :: new_zmq_push_socket + integer(ZMQ_PTR) :: zmq_socket_push + + double precision, allocatable :: delta(:,:,:), delta_s2(:,:,:) + + + + integer :: i_state, i, i_I, J, k, k2, k1, kk, ll, degree, degree2, m, l, deg, ni, m2 + integer :: n(2) + integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s, kn + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al + double precision :: diI, hIi, hJi, delta_JI, dkI, HkI, ci_inv(N_states), cj_inv(N_states) + double precision :: contrib, contrib_s2, wall, iwall + double precision, allocatable :: dleat(:,:,:), dleat_s2(:,:,:) + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt + integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp + logical, external :: is_in_wavefunction, isInCassd, detEq + integer,allocatable :: komon(:) + logical :: komoned + !double precision, external :: get_dij + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + zmq_socket_push = new_zmq_push_socket(thread) + + call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) + + allocate (dleat(N_states, N_det_non_ref, 2), delta(N_states,0:N_det_non_ref, 2)) + allocate (dleat_s2(N_states, N_det_non_ref, 2), delta_s2(N_states,0:N_det_non_ref, 2)) + allocate(komon(0:N_det_non_ref)) + + do + call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) + if (task_id == 0) exit + read (task,*) i_I, J, k1, k2 + do i_state=1, N_states + ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) + cj_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) + end do + n = 0 + delta(:,0,:) = 0d0 + delta(:,:nlink(J),1) = 0d0 + delta(:,:nlink(i_I),2) = 0d0 + delta_s2(:,0,:) = 0d0 + delta_s2(:,:nlink(J),1) = 0d0 + delta_s2(:,:nlink(i_I),2) = 0d0 + komon(0) = 0 + komoned = .false. + + + + + do kk = k1, k2 + k = det_cepa0_idx(linked(kk, i_I)) + blok = blokMwen(kk, i_I) + + call get_excitation(psi_ref(1,1,i_I),psi_non_ref(1,1,k),exc_Ik,degree,phase_Ik,N_int) + + if(J /= i_I) then + call apply_excitation(psi_ref(1,1,J),exc_Ik,det_tmp2,ok,N_int) + if(.not. ok) cycle + + l = searchDet(det_cepa0(1,1,cepa0_shortcut(blok)), det_tmp2, cepa0_shortcut(blok+1)-cepa0_shortcut(blok), N_int) + if(l == -1) cycle + ll = cepa0_shortcut(blok)-1+l + l = det_cepa0_idx(ll) + ll = child_num(ll, J) + else + l = k + ll = kk + end if + + + if(.not. komoned) then + m = 0 + m2 = 0 + + do while(m < nlink(i_I) .and. m2 < nlink(J)) + m += 1 + m2 += 1 + if(linked(m, i_I) < linked(m2, J)) then + m2 -= 1 + cycle + else if(linked(m, i_I) > linked(m2, J)) then + m -= 1 + cycle + end if + i = det_cepa0_idx(linked(m, i_I)) + + if(h_cache(J,i) == 0.d0) cycle + if(h_cache(i_I,i) == 0.d0) cycle + + komon(0) += 1 + kn = komon(0) + komon(kn) = i + + do i_state = 1,N_states + dkI = h_cache(J,i) * dij(i_I, i, i_state) + dleat(i_state, kn, 1) = dkI + dleat(i_state, kn, 2) = dkI + + dkI = s2_cache(J,i) * dij(i_I, i, i_state) + dleat_s2(i_state, kn, 1) = dkI + dleat_s2(i_state, kn, 2) = dkI + end do + + end do + + komoned = .true. + end if + + integer :: hpmin(2) + hpmin(1) = 2 - HP(1,k) + hpmin(2) = 2 - HP(2,k) + + do m = 1, komon(0) + + i = komon(m) + if(HP(1,i) <= hpmin(1) .and. HP(2,i) <= hpmin(2) ) then + cycle + end if + + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + if(.not. ok) cycle + + do i_state = 1, N_states + contrib = dij(i_I, k, i_state) * dleat(i_state, m, 2) + contrib_s2 = dij(i_I, k, i_state) * dleat_s2(i_state, m, 2) + delta(i_state,ll,1) += contrib + delta_s2(i_state,ll,1) += contrib_s2 + if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5) then + delta(i_state,0,1) -= contrib * ci_inv(i_state) * psi_non_ref_coef(l,i_state) + delta_s2(i_state,0,1) -= contrib_s2 * ci_inv(i_state) * psi_non_ref_coef(l,i_state) + endif + + if(I_i == J) cycle + contrib = dij(J, l, i_state) * dleat(i_state, m, 1) + contrib_s2 = dij(J, l, i_state) * dleat_s2(i_state, m, 1) + delta(i_state,kk,2) += contrib + delta_s2(i_state,kk,2) += contrib_s2 + if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then + delta(i_state,0,2) -= contrib * cj_inv(i_state) * psi_non_ref_coef(k,i_state) + delta_s2(i_state,0,2) -= contrib_s2 * cj_inv(i_state) * psi_non_ref_coef(k,i_state) + end if + enddo !i_state + end do ! while + end do ! kk + + + call push_mrsc2_results(zmq_socket_push, I_i, J, delta, delta_s2, task_id) + call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) + +! end if + + enddo + + deallocate(delta) + + call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + call end_zmq_push_socket(zmq_socket_push,thread) + +end + + +subroutine push_mrsc2_results(zmq_socket_push, I_i, J, delta, delta_s2, task_id) + use f77_zmq + implicit none + BEGIN_DOC +! Push integrals in the push socket + END_DOC + + integer, intent(in) :: i_I, J + integer(ZMQ_PTR), intent(in) :: zmq_socket_push + double precision,intent(inout) :: delta(N_states, 0:N_det_non_ref, 2) + double precision,intent(inout) :: delta_s2(N_states, 0:N_det_non_ref, 2) + integer, intent(in) :: task_id + integer :: rc , i_state, i, kk, li + integer,allocatable :: idx(:,:) + integer :: n(2) + logical :: ok + + allocate(idx(N_det_non_ref,2)) + rc = f77_zmq_send( zmq_socket_push, i_I, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, i_I, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_send( zmq_socket_push, J, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, J, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + + do kk=1,2 + n(kk)=0 + if(kk == 1) li = nlink(j) + if(kk == 2) li = nlink(i_I) + do i=1, li + ok = .false. + do i_state=1,N_states + if(delta(i_state, i, kk) /= 0d0) then + ok = .true. + exit + end if + end do + + if(ok) then + n(kk) += 1 +! idx(n,kk) = i + if(kk == 1) then + idx(n(1),1) = det_cepa0_idx(linked(i, J)) + else + idx(n(2),2) = det_cepa0_idx(linked(i, i_I)) + end if + + do i_state=1, N_states + delta(i_state, n(kk), kk) = delta(i_state, i, kk) + end do + end if + end do + + rc = f77_zmq_send( zmq_socket_push, n(kk), 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, n, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + if(n(kk) /= 0) then + rc = f77_zmq_send( zmq_socket_push, delta(1,0,kk), (n(kk)+1)*8*N_states, ZMQ_SNDMORE) ! delta(1,0,1) = delta_I delta(1,0,2) = delta_J + if (rc /= (n(kk)+1)*8*N_states) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, delta, (n(kk)+1)*8*N_states, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_send( zmq_socket_push, delta_s2(1,0,kk), (n(kk)+1)*8*N_states, ZMQ_SNDMORE) ! delta_s2(1,0,1) = delta_I delta_s2(1,0,2) = delta_J + if (rc /= (n(kk)+1)*8*N_states) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, delta_s2, (n(kk)+1)*8*N_states, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_send( zmq_socket_push, idx(1,kk), n(kk)*4, ZMQ_SNDMORE) + if (rc /= n(kk)*4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, delta, 8*n(kk), ZMQ_SNDMORE)' + stop 'error' + endif + end if + end do + + + rc = f77_zmq_send( zmq_socket_push, task_id, 4, 0) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_send( zmq_socket_push, task_id, 4, 0)' + stop 'error' + endif + +! ! Activate is zmq_socket_push is a REQ +! integer :: idummy +! rc = f77_zmq_recv( zmq_socket_push, idummy, 4, 0) +! if (rc /= 4) then +! print *, irp_here, 'f77_zmq_send( zmq_socket_push, idummy, 4, 0)' +! stop 'error' +! endif +end + + + +subroutine pull_mrsc2_results(zmq_socket_pull, I_i, J, n, idx, delta, delta_s2, task_id) + use f77_zmq + implicit none + BEGIN_DOC +! Push integrals in the push socket + END_DOC + + integer(ZMQ_PTR), intent(in) :: zmq_socket_pull + integer, intent(out) :: i_I, J, n(2) + double precision, intent(inout) :: delta(N_states, 0:N_det_non_ref, 2) + double precision, intent(inout) :: delta_s2(N_states, 0:N_det_non_ref, 2) + integer, intent(out) :: task_id + integer :: rc , i, kk + integer,intent(inout) :: idx(N_det_non_ref,2) + logical :: ok + + rc = f77_zmq_recv( zmq_socket_pull, i_I, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, i_I, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_recv( zmq_socket_pull, J, 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, J, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + do kk = 1, 2 + rc = f77_zmq_recv( zmq_socket_pull, n(kk), 4, ZMQ_SNDMORE) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, n, 4, ZMQ_SNDMORE)' + stop 'error' + endif + + if(n(kk) /= 0) then + rc = f77_zmq_recv( zmq_socket_pull, delta(1,0,kk), (n(kk)+1)*8*N_states, ZMQ_SNDMORE) + if (rc /= (n(kk)+1)*8*N_states) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, delta, (n(kk)+1)*8*N_states, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_recv( zmq_socket_pull, delta_s2(1,0,kk), (n(kk)+1)*8*N_states, ZMQ_SNDMORE) + if (rc /= (n(kk)+1)*8*N_states) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, delta_s2, (n(kk)+1)*8*N_states, ZMQ_SNDMORE)' + stop 'error' + endif + + rc = f77_zmq_recv( zmq_socket_pull, idx(1,kk), n(kk)*4, ZMQ_SNDMORE) + if (rc /= n(kk)*4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, idx(1,kk), n(kk)*4, ZMQ_SNDMORE)' + stop 'error' + endif + end if + end do + + rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0) + if (rc /= 4) then + print *, irp_here, 'f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)' + stop 'error' + endif + + +! ! Activate is zmq_socket_pull is a REP +! integer :: idummy +! rc = f77_zmq_send( zmq_socket_pull, idummy, 4, 0) +! if (rc /= 4) then +! print *, irp_here, 'f77_zmq_send( zmq_socket_pull, idummy, 4, 0)' +! stop 'error' +! endif +end + + + +subroutine mrsc2_dressing_collector(delta_ii_,delta_ij_,delta_ii_s2_,delta_ij_s2_) + use f77_zmq + implicit none + BEGIN_DOC +! Collects results from the AO integral calculation + END_DOC + + double precision,intent(inout) :: delta_ij_(N_states,N_det_non_ref,N_det_ref) + double precision,intent(inout) :: delta_ii_(N_states,N_det_ref) + double precision,intent(inout) :: delta_ij_s2_(N_states,N_det_non_ref,N_det_ref) + double precision,intent(inout) :: delta_ii_s2_(N_states,N_det_ref) + +! integer :: j,l + integer :: rc + + double precision, allocatable :: delta(:,:,:), delta_s2(:,:,:) + + 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(ZMQ_PTR) :: zmq_socket_pull + + integer*8 :: control, accu + integer :: task_id, more + + integer :: I_i, J, l, i_state, n(2), kk + integer,allocatable :: idx(:,:) + + delta_ii_(:,:) = 0d0 + delta_ij_(:,:,:) = 0d0 + delta_ii_s2_(:,:) = 0d0 + delta_ij_s2_(:,:,:) = 0d0 + + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() + zmq_socket_pull = new_zmq_pull_socket() + + allocate ( delta(N_states,0:N_det_non_ref,2), delta_s2(N_states,0:N_det_non_ref,2) ) + + allocate(idx(N_det_non_ref,2)) + more = 1 + do while (more == 1) + + call pull_mrsc2_results(zmq_socket_pull, I_i, J, n, idx, delta, delta_s2, task_id) + + + do l=1, n(1) + do i_state=1,N_states + delta_ij_(i_state,idx(l,1),i_I) += delta(i_state,l,1) + delta_ij_s2_(i_state,idx(l,1),i_I) += delta_s2(i_state,l,1) + end do + end do + + do l=1, n(2) + do i_state=1,N_states + delta_ij_(i_state,idx(l,2),J) += delta(i_state,l,2) + delta_ij_s2_(i_state,idx(l,2),J) += delta_s2(i_state,l,2) + end do + end do + + + if(n(1) /= 0) then + do i_state=1,N_states + delta_ii_(i_state,i_I) += delta(i_state,0,1) + delta_ii_s2_(i_state,i_I) += delta_s2(i_state,0,1) + end do + end if + + if(n(2) /= 0) then + do i_state=1,N_states + delta_ii_(i_state,J) += delta(i_state,0,2) + delta_ii_s2_(i_state,J) += delta_s2(i_state,0,2) + end do + end if + + + if (task_id /= 0) then + call zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) + endif + + + enddo + deallocate( delta, delta_s2 ) + + call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + call end_zmq_pull_socket(zmq_socket_pull) + +end + + + + + BEGIN_PROVIDER [ double precision, delta_ij_old, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii_old, (N_states,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ij_s2_old, (N_states,N_det_non_ref,N_det_ref) ] +&BEGIN_PROVIDER [ double precision, delta_ii_s2_old, (N_states,N_det_ref) ] + implicit none + + integer :: i_state, i, i_I, J, k, kk, degree, degree2, m, l, deg, ni, m2 + integer :: p1,p2,h1,h2,s1,s2, blok, I_s, J_s, nex, nzer, ntot +! integer, allocatable :: linked(:,:), blokMwen(:, :), nlink(:) + logical :: ok + double precision :: phase_iI, phase_Ik, phase_Jl, phase_Ji, phase_al, diI, hIi, hJi, delta_JI, dkI(N_states), HkI, ci_inv(N_states), dia_hla(N_states) + double precision :: contrib, wall, iwall ! , searchance(N_det_ref) + integer, dimension(0:2,2,2) :: exc_iI, exc_Ik, exc_IJ + integer(bit_kind) :: det_tmp(N_int, 2), det_tmp2(N_int, 2), inac, virt + integer, external :: get_index_in_psi_det_sorted_bit, searchDet, detCmp + logical, external :: is_in_wavefunction, isInCassd, detEq + character*(512) :: task + integer(ZMQ_PTR) :: zmq_to_qp_run_socket + + integer :: KKsize = 1000000 + + + call new_parallel_job(zmq_to_qp_run_socket,'mrsc2') + + + call wall_time(iwall) +! allocate(linked(N_det_non_ref, N_det_ref), blokMwen(N_det_non_ref, N_det_ref), nlink(N_det_ref)) + + +! searchance = 0d0 +! do J = 1, N_det_ref +! nlink(J) = 0 +! do blok=1,cepa0_shortcut(0) +! do k=cepa0_shortcut(blok), cepa0_shortcut(blok+1)-1 +! call get_excitation_degree(psi_ref(1,1,J),det_cepa0(1,1,k),degree,N_int) +! if(degree <= 2) then +! nlink(J) += 1 +! linked(nlink(J),J) = k +! blokMwen(nlink(J),J) = blok +! searchance(J) += 1d0 + log(dfloat(cepa0_shortcut(blok+1) - cepa0_shortcut(blok))) +! end if +! end do +! end do +! end do + + + +! stop + nzer = 0 + ntot = 0 + do nex = 3, 0, -1 + print *, "los ",nex + do I_s = N_det_ref, 1, -1 +! if(mod(I_s,1) == 0) then +! call wall_time(wall) +! wall = wall-iwall +! print *, I_s, "/", N_det_ref, wall * (dfloat(N_det_ref) / dfloat(I_s)), wall, wall * (dfloat(N_det_ref) / dfloat(I_s))-wall +! end if + + + do J_s = 1, I_s + + call get_excitation_degree(psi_ref(1,1,J_s), psi_ref(1,1,I_s), degree, N_int) + if(degree /= nex) cycle + if(nex == 3) nzer = nzer + 1 + ntot += 1 +! if(degree > 3) then +! deg += 1 +! cycle +! else if(degree == -10) then +! KKsize = 100000 +! else +! KKsize = 1000000 +! end if + + + + if(searchance(I_s) < searchance(J_s)) then + i_I = I_s + J = J_s + else + i_I = J_s + J = I_s + end if + + KKsize = nlink(1) + if(nex == 0) KKsize = int(float(nlink(1)) / float(nlink(i_I)) * (float(nlink(1)) / 64d0)) + + !if(KKsize == 0) stop "ZZEO" + + do kk = 1 , nlink(i_I), KKsize + write(task,*) I_i, J, kk, int(min(kk+KKsize-1, nlink(i_I))) + call add_task_to_taskserver(zmq_to_qp_run_socket,task) + end do + + ! do kk = 1 , nlink(i_I) + ! k = linked(kk,i_I) + ! blok = blokMwen(kk,i_I) + ! write(task,*) I_i, J, k, blok + ! call add_task_to_taskserver(zmq_to_qp_run_socket,task) + ! + ! enddo !kk + enddo !J + + enddo !I + end do ! nex + print *, "tasked" +! integer(ZMQ_PTR) ∷ collector_thread +! external ∷ ao_bielec_integrals_in_map_collector +! rc = pthread_create(collector_thread, mrsc2_dressing_collector) + print *, nzer, ntot, float(nzer) / float(ntot) + provide nproc + !$OMP PARALLEL DEFAULT(none) SHARED(delta_ii_old,delta_ij_old,delta_ii_s2_old,delta_ij_s2_old) PRIVATE(i) NUM_THREADS(nproc+1) + i = omp_get_thread_num() + if (i==0) then + call mrsc2_dressing_collector(delta_ii_old,delta_ij_old,delta_ii_s2_old,delta_ij_s2_old) + else + call mrsc2_dressing_slave_inproc(i) + endif + !$OMP END PARALLEL + +! rc = pthread_join(collector_thread) + call end_parallel_job(zmq_to_qp_run_socket, 'mrsc2') + + +END_PROVIDER + + + diff --git a/plugins/mrcc_selected/ezfio_interface.irp.f b/plugins/mrcc_selected/ezfio_interface.irp.f new file mode 100644 index 00000000..062af449 --- /dev/null +++ b/plugins/mrcc_selected/ezfio_interface.irp.f @@ -0,0 +1,61 @@ +! DO NOT MODIFY BY HAND +! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py +! from file /home/scemama/quantum_package/src/mrcc_selected/EZFIO.cfg + + +BEGIN_PROVIDER [ double precision, thresh_dressed_ci ] + implicit none + BEGIN_DOC +! Threshold on the convergence of the dressed CI energy + END_DOC + + logical :: has + PROVIDE ezfio_filename + + call ezfio_has_mrcc_selected_thresh_dressed_ci(has) + if (has) then + call ezfio_get_mrcc_selected_thresh_dressed_ci(thresh_dressed_ci) + else + print *, 'mrcc_selected/thresh_dressed_ci not found in EZFIO file' + stop 1 + endif + +END_PROVIDER + +BEGIN_PROVIDER [ integer, n_it_max_dressed_ci ] + implicit none + BEGIN_DOC +! Maximum number of dressed CI iterations + END_DOC + + logical :: has + PROVIDE ezfio_filename + + call ezfio_has_mrcc_selected_n_it_max_dressed_ci(has) + if (has) then + call ezfio_get_mrcc_selected_n_it_max_dressed_ci(n_it_max_dressed_ci) + else + print *, 'mrcc_selected/n_it_max_dressed_ci not found in EZFIO file' + stop 1 + endif + +END_PROVIDER + +BEGIN_PROVIDER [ integer, lambda_type ] + implicit none + BEGIN_DOC +! lambda type + END_DOC + + logical :: has + PROVIDE ezfio_filename + + call ezfio_has_mrcc_selected_lambda_type(has) + if (has) then + call ezfio_get_mrcc_selected_lambda_type(lambda_type) + else + print *, 'mrcc_selected/lambda_type not found in EZFIO file' + stop 1 + endif + +END_PROVIDER diff --git a/plugins/mrcc_selected/mrcc_selected.irp.f b/plugins/mrcc_selected/mrcc_selected.irp.f new file mode 100644 index 00000000..91592e62 --- /dev/null +++ b/plugins/mrcc_selected/mrcc_selected.irp.f @@ -0,0 +1,19 @@ +program mrsc2sub + implicit none + double precision, allocatable :: energy(:) + allocate (energy(N_states)) + + !mrmode : 1=mrcepa0, 2=mrsc2 add, 3=mrcc + mrmode = 3 + + read_wf = .True. + SOFT_TOUCH read_wf + call print_cas_coefs + call set_generators_bitmasks_as_holes_and_particles + call run(N_states,energy) + if(do_pt2_end)then + call run_pt2(N_states,energy) + endif + deallocate(energy) +end + diff --git a/plugins/mrcc_selected/mrcepa0_general.irp.f b/plugins/mrcc_selected/mrcepa0_general.irp.f new file mode 100644 index 00000000..e3a2d1f5 --- /dev/null +++ b/plugins/mrcc_selected/mrcepa0_general.irp.f @@ -0,0 +1,245 @@ + + +subroutine run(N_st,energy) + implicit none + + integer, intent(in) :: N_st + double precision, intent(out) :: energy(N_st) + + integer :: i,j + + double precision :: E_new, E_old, delta_e + integer :: iteration + double precision :: E_past(4) + + integer :: n_it_mrcc_max + double precision :: thresh_mrcc + double precision, allocatable :: lambda(:) + allocate (lambda(N_states)) + + + thresh_mrcc = thresh_dressed_ci + n_it_mrcc_max = n_it_max_dressed_ci + + if(n_it_mrcc_max == 1) then + do j=1,N_states_diag + do i=1,N_det + psi_coef(i,j) = CI_eigenvectors_dressed(i,j) + enddo + enddo + SOFT_TOUCH psi_coef ci_energy_dressed + call write_double(6,ci_energy_dressed(1),"Final MRCC energy") + call ezfio_set_mrcepa0_energy(ci_energy_dressed(1)) + call save_wavefunction + energy(:) = ci_energy_dressed(:) + else + E_new = 0.d0 + delta_E = 1.d0 + iteration = 0 + lambda = 1.d0 + do while (delta_E > thresh_mrcc) + iteration += 1 + print *, '===========================' + print *, 'MRCEPA0 Iteration', iteration + print *, '===========================' + print *, '' + E_old = sum(ci_energy_dressed) + call write_double(6,ci_energy_dressed(1),"MRCEPA0 energy") + call diagonalize_ci_dressed(lambda) + E_new = sum(ci_energy_dressed) + delta_E = dabs(E_new - E_old) + call save_wavefunction + call ezfio_set_mrcepa0_energy(ci_energy_dressed(1)) + if (iteration >= n_it_mrcc_max) then + exit + endif + enddo + call write_double(6,ci_energy_dressed(1),"Final MRCEPA0 energy") + energy(:) = ci_energy_dressed(:) + endif +end + + +subroutine print_cas_coefs + implicit none + + integer :: i,j + print *, 'CAS' + print *, '===' + do i=1,N_det_cas + print *, (psi_cas_coef(i,j), j=1,N_states) + call debug_det(psi_cas(1,1,i),N_int) + enddo + call write_double(6,ci_energy(1),"Initial CI energy") + +end + + + + +subroutine run_pt2_old(N_st,energy) + implicit none + integer :: i,j,k + integer, intent(in) :: N_st + double precision, intent(in) :: energy(N_st) + double precision :: pt2_redundant(N_st), pt2(N_st) + double precision :: norm_pert(N_st),H_pert_diag(N_st) + + pt2_redundant = 0.d0 + pt2 = 0d0 + !if(lambda_mrcc_pt2(0) == 0) return + + print*,'Last iteration only to compute the PT2' + + print * ,'Computing the redundant PT2 contribution' + + if (mrmode == 1) then + + N_det_generators = lambda_mrcc_kept(0) + N_det_selectors = lambda_mrcc_kept(0) + + do i=1,N_det_generators + j = lambda_mrcc_kept(i) + do k=1,N_int + psi_det_generators(k,1,i) = psi_non_ref(k,1,j) + psi_det_generators(k,2,i) = psi_non_ref(k,2,j) + psi_selectors(k,1,i) = psi_non_ref(k,1,j) + psi_selectors(k,2,i) = psi_non_ref(k,2,j) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_non_ref_coef(j,k) + psi_selectors_coef(i,k) = psi_non_ref_coef(j,k) + enddo + enddo + + else + + N_det_generators = N_det_non_ref + N_det_selectors = N_det_non_ref + + do i=1,N_det_generators + j = i + do k=1,N_int + psi_det_generators(k,1,i) = psi_non_ref(k,1,j) + psi_det_generators(k,2,i) = psi_non_ref(k,2,j) + psi_selectors(k,1,i) = psi_non_ref(k,1,j) + psi_selectors(k,2,i) = psi_non_ref(k,2,j) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_non_ref_coef(j,k) + psi_selectors_coef(i,k) = psi_non_ref_coef(j,k) + enddo + enddo + + endif + + SOFT_TOUCH N_det_selectors psi_selectors_coef psi_selectors N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + SOFT_TOUCH psi_ref_coef_diagonalized psi_ref_energy_diagonalized + + call H_apply_mrcepa_PT2(pt2_redundant, norm_pert, H_pert_diag, N_st) + + print * ,'Computing the remaining contribution' + + threshold_selectors = max(threshold_selectors,threshold_selectors_pt2) + threshold_generators = max(threshold_generators,threshold_generators_pt2) + + N_det_generators = N_det_non_ref + N_det_ref + N_det_selectors = N_det_non_ref + N_det_ref + + psi_det_generators(:,:,:N_det_ref) = psi_ref(:,:,:N_det_ref) + psi_selectors(:,:,:N_det_ref) = psi_ref(:,:,:N_det_ref) + psi_coef_generators(:N_det_ref,:) = psi_ref_coef(:N_det_ref,:) + psi_selectors_coef(:N_det_ref,:) = psi_ref_coef(:N_det_ref,:) + + do i=N_det_ref+1,N_det_generators + j = i-N_det_ref + do k=1,N_int + psi_det_generators(k,1,i) = psi_non_ref(k,1,j) + psi_det_generators(k,2,i) = psi_non_ref(k,2,j) + psi_selectors(k,1,i) = psi_non_ref(k,1,j) + psi_selectors(k,2,i) = psi_non_ref(k,2,j) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_non_ref_coef(j,k) + psi_selectors_coef(i,k) = psi_non_ref_coef(j,k) + enddo + enddo + + SOFT_TOUCH N_det_selectors psi_selectors_coef psi_selectors N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + SOFT_TOUCH psi_ref_coef_diagonalized psi_ref_energy_diagonalized + + call H_apply_mrcepa_PT2(pt2, norm_pert, H_pert_diag, N_st) + + + print *, "Redundant PT2 :",pt2_redundant + print *, "Full PT2 :",pt2 + print *, lambda_mrcc_kept(0), N_det, N_det_ref, psi_coef(1,1), psi_ref_coef(1,1) + pt2 = pt2 - pt2_redundant + + print *, 'Final step' + print *, 'N_det = ', N_det + print *, 'N_states = ', N_states + print *, 'PT2 = ', pt2 + print *, 'E = ', energy + print *, 'E+PT2 = ', energy+pt2 + print *, '-----' + + + call ezfio_set_mrcepa0_energy_pt2(energy(1)+pt2(1)) + +end + +subroutine run_pt2(N_st,energy) + implicit none + integer :: i,j,k + integer, intent(in) :: N_st + double precision, intent(in) :: energy(N_st) + double precision :: pt2(N_st) + double precision :: norm_pert(N_st),H_pert_diag(N_st) + + pt2 = 0d0 + !if(lambda_mrcc_pt2(0) == 0) return + + print*,'Last iteration only to compute the PT2' + + N_det_generators = N_det_cas + N_det_selectors = N_det_non_ref + + do i=1,N_det_generators + do k=1,N_int + psi_det_generators(k,1,i) = psi_ref(k,1,i) + psi_det_generators(k,2,i) = psi_ref(k,2,i) + enddo + do k=1,N_st + psi_coef_generators(i,k) = psi_ref_coef(i,k) + enddo + enddo + do i=1,N_det + do k=1,N_int + psi_selectors(k,1,i) = psi_det_sorted(k,1,i) + psi_selectors(k,2,i) = psi_det_sorted(k,2,i) + enddo + do k=1,N_st + psi_selectors_coef(i,k) = psi_coef_sorted(i,k) + enddo + enddo + + SOFT_TOUCH N_det_selectors psi_selectors_coef psi_selectors N_det_generators psi_det_generators psi_coef_generators ci_eigenvectors_dressed ci_eigenvectors_s2_dressed ci_electronic_energy_dressed + SOFT_TOUCH psi_ref_coef_diagonalized psi_ref_energy_diagonalized + + call H_apply_mrcepa_PT2(pt2, norm_pert, H_pert_diag, N_st) + +! call ezfio_set_full_ci_energy_pt2(energy+pt2) + + print *, 'Final step' + print *, 'N_det = ', N_det + print *, 'N_states = ', N_states + print *, 'PT2 = ', pt2 + print *, 'E = ', energy + print *, 'E+PT2 = ', energy+pt2 + print *, '-----' + + call ezfio_set_mrcepa0_energy_pt2(energy(1)+pt2(1)) + +end + diff --git a/plugins/mrcepa0/.gitignore b/plugins/mrcepa0/.gitignore new file mode 100644 index 00000000..7ac9fbf6 --- /dev/null +++ b/plugins/mrcepa0/.gitignore @@ -0,0 +1,5 @@ +IRPF90_temp/ +IRPF90_man/ +irpf90.make +irpf90_entities +tags \ No newline at end of file diff --git a/plugins/mrcepa0/README.rst b/plugins/mrcepa0/README.rst index 997d005e..9e66ca0d 100644 --- a/plugins/mrcepa0/README.rst +++ b/plugins/mrcepa0/README.rst @@ -6,7 +6,203 @@ Needed Modules ============== .. Do not edit this section It was auto-generated .. by the `update_README.py` script. + + +.. image:: tree_dependency.png + +* `Perturbation `_ +* `Selectors_full `_ +* `Generators_full `_ +* `Psiref_CAS `_ +* `MRCC_Utils `_ +* `ZMQ `_ + Documentation ============= .. Do not edit this section It was auto-generated .. by the `update_README.py` script. + + +`active_sorb `_ + Undocumented + + +`blokmwen `_ + Undocumented + + +`cepa0_shortcut `_ + Undocumented + + +`child_num `_ + Undocumented + + +`delta_cas `_ + Undocumented + + +`delta_ii `_ + Undocumented + + +`delta_ii_mrcc `_ + Undocumented + + +`delta_ii_old `_ + Undocumented + + +`delta_ij `_ + Undocumented + + +`delta_ij_mrcc `_ + Undocumented + + +`delta_ij_old `_ + Undocumented + + +`delta_mrcepa0_ii `_ + Undocumented + + +`delta_mrcepa0_ij `_ + Undocumented + + +`delta_sub_ii `_ + Undocumented + + +`delta_sub_ij `_ + Undocumented + + +`det_cepa0 `_ + Undocumented + + +`det_cepa0_active `_ + Undocumented + + +`det_cepa0_idx `_ + Undocumented + + +`det_ref_active `_ + Undocumented + + +`filter_tq `_ + Undocumented + + +`filter_tq_micro `_ + Undocumented + + +`gethp `_ + Undocumented + + +`h_ `_ + Undocumented + + +`hp `_ + Undocumented + + +`isincassd `_ + Undocumented + + +`lambda_type `_ + lambda type + + +`linked `_ + Undocumented + + +`mrcc_part_dress `_ + Undocumented + + +`mrcepa0 `_ + Undocumented + + +`mrsc2 `_ + Undocumented + + +`mrsc2_dressing_collector `_ + Collects results from the AO integral calculation + + +`mrsc2_dressing_slave `_ + Task for parallel MR-SC2 + + +`mrsc2_dressing_slave_inproc `_ + Task for parallel MR-SC2 + + +`mrsc2_dressing_slave_tcp `_ + Task for parallel MR-SC2 + + +`mrsc2sub `_ + Undocumented + + +`n_it_max_dressed_ci `_ + Maximum number of dressed CI iterations + + +`nlink `_ + Undocumented + + +`print_cas_coefs `_ + Undocumented + + +`pull_mrsc2_results `_ + Push integrals in the push socket + + +`push_mrsc2_results `_ + Push integrals in the push socket + + +`run `_ + Undocumented + + +`run_pt2 `_ + Undocumented + + +`run_pt2_old `_ + Undocumented + + +`searchance `_ + Undocumented + + +`set_det_bit `_ + Undocumented + + +`thresh_dressed_ci `_ + Threshold on the convergence of the dressed CI energy + diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 0c67ab99..3579e3c8 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -300,22 +300,22 @@ subroutine mrcc_part_dress(delta_ij_, delta_ii_,delta_ij_s2_, delta_ii_s2_,i_gen enddo call omp_set_lock( psi_ref_lock(i_I) ) do i_state=1,N_states -! if(dabs(psi_ref_coef(i_I,i_state)).ge.5.d-5)then -! do l_sd=1,idx_alpha(0) -! k_sd = idx_alpha(l_sd) -! delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd) -! delta_ii_(i_state,i_I) = delta_ii_(i_state,i_I) - dIa_hla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) -! delta_ij_s2_(i_state,k_sd,i_I) = delta_ij_s2_(i_state,k_sd,i_I) + dIa_sla(i_state,k_sd) -! delta_ii_s2_(i_state,i_I) = delta_ii_s2_(i_state,i_I) - dIa_sla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) -! enddo -! else + if(dabs(psi_ref_coef(i_I,i_state)).ge.1.d-3)then + do l_sd=1,idx_alpha(0) + k_sd = idx_alpha(l_sd) + delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + dIa_hla(i_state,k_sd) + delta_ii_(i_state,i_I) = delta_ii_(i_state,i_I) - dIa_hla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) + delta_ij_s2_(i_state,k_sd,i_I) = delta_ij_s2_(i_state,k_sd,i_I) + dIa_sla(i_state,k_sd) + delta_ii_s2_(i_state,i_I) = delta_ii_s2_(i_state,i_I) - dIa_sla(i_state,k_sd) * ci_inv(i_state) * psi_non_ref_coef_transp(i_state,k_sd) + enddo + else delta_ii_(i_state,i_I) = 0.d0 do l_sd=1,idx_alpha(0) k_sd = idx_alpha(l_sd) delta_ij_(i_state,k_sd,i_I) = delta_ij_(i_state,k_sd,i_I) + 0.5d0*dIa_hla(i_state,k_sd) delta_ij_s2_(i_state,k_sd,i_I) = delta_ij_s2_(i_state,k_sd,i_I) + 0.5d0*dIa_sla(i_state,k_sd) enddo -! endif + endif enddo call omp_unset_lock( psi_ref_lock(i_I) ) enddo @@ -691,7 +691,7 @@ subroutine getHP(a,h,p,Nint) end do lh h = deg !isInCassd = .true. -end function +end subroutine BEGIN_PROVIDER [ double precision, delta_mrcepa0_ij, (N_det_ref,N_det_non_ref,N_states) ] @@ -716,6 +716,9 @@ end function integer :: II, blok integer*8, save :: notf = 0 + + PROVIDE psi_ref_coef psi_non_ref_coef + call wall_time(wall) allocate(idx_sorted_bit(N_det), sortRef(N_int,2,N_det_ref)) @@ -784,7 +787,7 @@ end function contrib = delta_cas(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state) contrib_s2 = delta_cas_s2(II, J, i_state) * dij(J, det_cepa0_idx(k), i_state) - if(dabs(psi_ref_coef(J,i_state)).ge.5.d-5) then + if(dabs(psi_ref_coef(J,i_state)).ge.1.d-3) then contrib2 = contrib / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state) contrib2_s2 = contrib_s2 / psi_ref_coef(J, i_state) * psi_non_ref_coef(det_cepa0_idx(i),i_state) !$OMP ATOMIC @@ -839,8 +842,7 @@ END_PROVIDER delta_sub_ij(:,:,:) = 0d0 delta_sub_ii(:,:) = 0d0 - provide mo_bielec_integrals_in_map - + provide mo_bielec_integrals_in_map N_det_non_ref psi_ref_coef psi_non_ref_coef !$OMP PARALLEL DO default(none) schedule(dynamic,10) shared(delta_sub_ij, delta_sub_ii) & !$OMP private(i, J, k, degree, degree2, l, deg, ni) & @@ -895,7 +897,7 @@ END_PROVIDER call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) if(ok) cycle contrib = delta_IJk * HIl * lambda_mrcc(i_state,l) - if(dabs(psi_ref_coef(II,i_state)).ge.5.d-5) then + if(dabs(psi_ref_coef(II,i_state)).ge.1.d-3) then contrib2 = contrib / psi_ref_coef(II, i_state) * psi_non_ref_coef(l,i_state) !$OMP ATOMIC delta_sub_ii(II,i_state) -= contrib2 diff --git a/plugins/mrcepa0/tree_dependency.png b/plugins/mrcepa0/tree_dependency.png new file mode 100644 index 00000000..e69de29b diff --git a/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py b/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py index e911af28..a1f47ccd 100755 --- a/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py +++ b/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py @@ -364,10 +364,6 @@ for line_raw in det_without_header.split("\n"): try: float(line) except ValueError: - - print line_raw.strip(), len(line_raw.strip()) - print l_order_mo, len(l_order_mo) - line_order = [line_raw[i] for i in l_order_mo] line= "".join([d_rep[x] if x in d_rep else x for x in line_raw]) diff --git a/scripts/compilation/qp_create_ninja.py b/scripts/compilation/qp_create_ninja.py index b495019a..780a7a91 100755 --- a/scripts/compilation/qp_create_ninja.py +++ b/scripts/compilation/qp_create_ninja.py @@ -476,7 +476,7 @@ def ninja_irpf90_make_build(path_module, l_needed_molule, d_irp): # ~#~#~#~#~#~ # l_creation = [join(path_module.abs, i) - for i in ["irpf90.make", "irpf90_entities", "tags", + for i in ["irpf90_entities", "tags", "IRPF90_temp/build.ninja"]] str_creation = " ".join(l_creation) diff --git a/scripts/ezfio_interface/qp_convert_output_to_ezfio.py b/scripts/ezfio_interface/qp_convert_output_to_ezfio.py index ff7ad225..6823df81 100755 --- a/scripts/ezfio_interface/qp_convert_output_to_ezfio.py +++ b/scripts/ezfio_interface/qp_convert_output_to_ezfio.py @@ -12,26 +12,25 @@ Option: """ - import sys import os from functools import reduce - # ~#~#~#~#~#~#~#~ # # Add to the path # # ~#~#~#~#~#~#~#~ # - try: QP_ROOT = os.environ["QP_ROOT"] except: print "Error: QP_ROOT environment variable not found." sys.exit(1) else: - sys.path = [QP_ROOT + "/install/EZFIO/Python", - QP_ROOT + "/resultsFile", - QP_ROOT + "/scripts"] + sys.path + + sys.path = [ QP_ROOT + "/install/EZFIO/Python", + QP_ROOT + "/resultsFile", + QP_ROOT + "/scripts"] + sys.path + # ~#~#~#~#~#~ # # I m p o r t # @@ -39,7 +38,6 @@ else: from ezfio import ezfio - try: from resultsFile import * except: @@ -254,7 +252,7 @@ def write_ezfio(res, filename): for coef in m.vector: MoMatrix.append(coef) - while len(MoMatrix) < len(MOs[0].vector) ** 2: + while len(MoMatrix) < len(MOs[0].vector)**2: MoMatrix.append(0.) # ~#~#~#~#~ # @@ -273,7 +271,129 @@ def write_ezfio(res, filename): # \_| |___/\___|\__,_|\__,_|\___/ # - ezfio.set_pseudo_do_pseudo(False) + # INPUT + # {% for lanel,zcore, l_block in l_atom $} + # #local l_block l=0} + # {label} GEN {zcore} {len(l_block)-1 #lmax_block} + # {% for l_param in l_block%} + # {len(l_param) # list of parameter aka n_max_bock_max(n)} + # {% for coef,n,zeta for l_param} + # {coef,n, zeta} + + # OUTPUT + + # Local are 1 array padded by max(n_max_block) when l == 0 (output:k_loc_max) + # v_k[n-2][atom] = value + + #No Local are 2 array padded with max of lmax_block when l!=0 (output:lmax+1) and max(n_max_block)whem l !=0 (kmax) + # v_kl[l][n-2][atom] = value + + def pad(array, size, value=0): + new_array = array + for add in xrange(len(array), size): + new_array.append(value) + + return new_array + + def parse_str(pseudo_str): + '''Return 4d array atom,l,n, attribute (attribute is coef, n, zeta)''' + matrix = [] + array_l_max_block = [] + array_z_remove = [] + + for block in [b for b in pseudo_str.split('\n\n') if b]: + #First element is header, the rest are l_param + array_party = [i for i in re.split(r"\n\d+\n", block) if i] + + z_remove, l_max_block = map(int, array_party[0].split()[-2:]) + array_l_max_block.append(l_max_block) + array_z_remove.append(z_remove) + + matrix.append([[coef_n_zeta.split()[1:] for coef_n_zeta in l.split('\n')] for l in array_party[1:]]) + + return (matrix, array_l_max_block, array_z_remove) + + def get_local_stuff(matrix): + + matrix_local_unpad = [atom[0] for atom in matrix] + k_loc_max = max(len(i) for i in matrix_local_unpad) + + matrix_local = [ pad(ll, k_loc_max, [0., 2, 0.]) for ll in matrix_local_unpad] + + m_coef = [[float(i[0]) for i in atom] for atom in matrix_local] + m_n = [[int(i[1]) - 2 for i in atom] for atom in matrix_local] + m_zeta = [[float(i[2]) for i in atom] for atom in matrix_local] + return (k_loc_max, m_coef, m_n, m_zeta) + + def get_non_local_stuff(matrix): + + matrix_unlocal_unpad = [atom[1:] for atom in matrix] + l_max_block = max(len(i) for i in matrix_unlocal_unpad) + k_max = max([len(item) for row in matrix_unlocal_unpad for item in row]) + + matrix_unlocal_semipaded = [[pad(item, k_max, [0., 2, 0.]) for item in row] for row in matrix_unlocal_unpad] + + empty_row = [[0., 2, 0.] for k in range(l_max_block)] + matrix_unlocal = [ pad(ll, l_max_block, empty_row) for ll in matrix_unlocal_semipaded ] + + m_coef_noloc = [[[float(k[0]) for k in j] for j in i] for i in matrix_unlocal] + m_n_noloc = [[[int(k[1]) - 2 for k in j] for j in i] for i in matrix_unlocal] + m_zeta_noloc = [[[float(k[2]) for k in j] for j in i] for i in matrix_unlocal] + + return (l_max_block, k_max, m_coef_noloc, m_n_noloc, m_zeta_noloc) + + try: + pseudo_str = res_file.get_pseudo() + matrix, array_l_max_block, array_z_remove = parse_str(pseudo_str) + + except: + ezfio.set_pseudo_do_pseudo(False) + else: + ezfio.set_pseudo_do_pseudo(True) + + # ~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~ # + # Z _ e f f , a l p h a / b e t a _ e l e c # + # ~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~ # + + ezfio.pseudo_charge_remove = array_z_remove + ezfio.nuclei_nucl_charge = [i - j for i, j in zip(ezfio.nuclei_nucl_charge, array_z_remove)] + + import math + num_elec = sum(ezfio.nuclei_nucl_charge) + + ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) + ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + + # Change all the array 'cause EZFIO + # v_kl (v, l) => v_kl(l,v) + # v_kl => zip(*_v_kl) + # [[7.0, 79.74474797, -49.45159098], [1.0, 5.41040609, -4.60151975]] + # [(7.0, 1.0), (79.74474797, 5.41040609), (-49.45159098, -4.60151975)] + + # ~#~#~#~#~ # + # L o c a l # + # ~#~#~#~#~ # + + klocmax, m_coef, m_n, m_zeta = get_local_stuff(matrix) + ezfio.pseudo_pseudo_klocmax = klocmax + + ezfio.pseudo_pseudo_v_k = zip(*m_coef) + ezfio.pseudo_pseudo_n_k = zip(*m_n) + ezfio.pseudo_pseudo_dz_k = zip(*m_zeta) + + # ~#~#~#~#~#~#~#~#~ # + # N o n _ L o c a l # + # ~#~#~#~#~#~#~#~#~ # + + l_max_block, k_max, m_coef_noloc, m_n_noloc, m_zeta_noloc = get_non_local_stuff( + matrix) + + ezfio.pseudo_pseudo_lmax = l_max_block - 1 + ezfio.pseudo_pseudo_kmax = k_max + + ezfio.pseudo_pseudo_v_kl = zip(*m_coef_noloc) + ezfio.pseudo_pseudo_n_kl = zip(*m_n_noloc) + ezfio.pseudo_pseudo_dz_kl = zip(*m_zeta_noloc) def get_full_path(file_path): @@ -282,6 +402,7 @@ def get_full_path(file_path): file_path = os.path.abspath(file_path) return file_path + if __name__ == '__main__': arguments = docopt(__doc__) diff --git a/scripts/module/module_handler.py b/scripts/module/module_handler.py index 0667c376..b49609b3 100755 --- a/scripts/module/module_handler.py +++ b/scripts/module/module_handler.py @@ -298,6 +298,7 @@ if __name__ == '__main__': # Don't update if we are not in the main repository from is_master_repository import is_master_repository if not is_master_repository: + print >> sys.stderr, 'Not in the master repo' sys.exit() path = os.path.join(module_abs, ".gitignore") diff --git a/src/AO_Basis/README.rst b/src/AO_Basis/README.rst index ae9acdf0..d67a3a63 100644 --- a/src/AO_Basis/README.rst +++ b/src/AO_Basis/README.rst @@ -133,7 +133,7 @@ Documentation :math:`\int \chi_i(r) \chi_j(r) dr)` -`ao_overlap_abs `_ +`ao_overlap_abs `_ Overlap between absolute value of atomic basis functions: :math:`\int |\chi_i(r)| |\chi_j(r)| dr)` diff --git a/src/Davidson/README.rst b/src/Davidson/README.rst new file mode 100644 index 00000000..15e9b46a --- /dev/null +++ b/src/Davidson/README.rst @@ -0,0 +1,322 @@ +Needed Modules +============== +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. + + +.. image:: tree_dependency.png + +* `Determinants `_ + +Documentation +============= +.. Do not edit this section It was auto-generated +.. by the `update_README.py` script. + + +`ci_eigenvectors `_ + Eigenvectors/values of the CI matrix + + +`ci_eigenvectors_mono `_ + Eigenvectors/values of the CI matrix + + +`ci_eigenvectors_s2 `_ + Eigenvectors/values of the CI matrix + + +`ci_eigenvectors_s2_mono `_ + Eigenvectors/values of the CI matrix + + +`ci_electronic_energy `_ + Eigenvectors/values of the CI matrix + + +`ci_electronic_energy_mono `_ + Eigenvectors/values of the CI matrix + + +`ci_energy `_ + N_states lowest eigenvalues of the CI matrix + + +`dav_det `_ + Temporary arrays for parallel davidson + .br + Touched in davidson_miniserver_get + + +`dav_size `_ + Size of the arrays for Davidson + .br + Touched in davidson_miniserver_get + + +`dav_ut `_ + Temporary arrays for parallel davidson + .br + Touched in davidson_miniserver_get + + +`davidson_add_task `_ + Undocumented + + +`davidson_collect `_ + Undocumented + + +`davidson_collector `_ + Undocumented + + +`davidson_converged `_ + True if the Davidson algorithm is converged + + +`davidson_criterion `_ + Can be : [ energy | residual | both | wall_time | cpu_time | iterations ] + + +`davidson_diag `_ + Davidson diagonalization. + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + iunit : Unit number for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hjj `_ + Davidson diagonalization with specific diagonal elements of the H matrix + .br + H_jj : specific diagonal H matrix elements to diagonalize de Davidson + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + N_st_diag : Number of states in which H is diagonalized + .br + iunit : Unit for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hjj_sjj `_ + Davidson diagonalization with specific diagonal elements of the H matrix + .br + H_jj : specific diagonal H matrix elements to diagonalize de Davidson + .br + S2_jj : specific diagonal S^2 matrix elements + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + N_st_diag : Number of states in which H is diagonalized. Assumed > sze + .br + iunit : Unit for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_diag_hs2 `_ + Davidson diagonalization. + .br + dets_in : bitmasks corresponding to determinants + .br + u_in : guess coefficients on the various states. Overwritten + on exit + .br + dim_in : leftmost dimension of u_in + .br + sze : Number of determinants + .br + N_st : Number of eigenstates + .br + iunit : Unit number for the I/O + .br + Initial guess vectors are not necessarily orthonormal + + +`davidson_init `_ + Undocumented + + +`davidson_iter_max `_ + Max number of Davidson iterations + + +`davidson_miniserver_end `_ + Undocumented + + +`davidson_miniserver_get `_ + Undocumented + + +`davidson_miniserver_run `_ + Undocumented + + +`davidson_process `_ + Undocumented + + +`davidson_pull_results `_ + Undocumented + + +`davidson_push_results `_ + Undocumented + + +`davidson_run `_ + Undocumented + + +`davidson_run_slave `_ + Undocumented + + +`davidson_slave `_ + Undocumented + + +`davidson_slave_inproc `_ + Undocumented + + +`davidson_slave_tcp `_ + Undocumented + + +`davidson_slave_work `_ + Undocumented + + +`davidson_sze_max `_ + Max number of Davidson sizes + + +`det_inf `_ + Ordering function for determinants + + +`diagonalize_ci `_ + Replace the coefficients of the CI states by the coefficients of the + eigenstates of the CI matrix + + +`diagonalize_ci_mono `_ + Replace the coefficients of the CI states by the coefficients of the + eigenstates of the CI matrix + + +`first_guess `_ + Select all the determinants with the lowest energy as a starting point. + + +`h_s2_u_0_nstates `_ + Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + .br + n : number of determinants + .br + H_jj : array of + .br + S2_jj : array of + + +`h_u_0_nstates `_ + Computes v_0 = H|u_0> + .br + n : number of determinants + .br + H_jj : array of + + +`max_blocksize `_ + Undocumented + + +`n_states_diag `_ + n_states_diag + + +`provide_everything `_ + Undocumented + + +`psi_energy `_ + Energy of the current wave function + + +`shortcut_ `_ + Undocumented + + +`sort_dets_ab `_ + Uncodumented : TODO + + +`sort_dets_ab_v `_ + Uncodumented : TODO + + +`sort_dets_ba_v `_ + Uncodumented : TODO + + +`sort_idx_ `_ + Undocumented + + +`sorted_ `_ + Undocumented + + +`tamiser `_ + Uncodumented : TODO + + +`threshold_davidson `_ + Thresholds of Davidson's algorithm + + +`u_0_h_u_0 `_ + Computes e_0 = / + .br + n : number of determinants + .br + + +`version_ `_ + Undocumented + diff --git a/src/Davidson/diagonalization_hs2.irp.f b/src/Davidson/diagonalization_hs2.irp.f index 7cba0f60..dccc8ee5 100644 --- a/src/Davidson/diagonalization_hs2.irp.f +++ b/src/Davidson/diagonalization_hs2.irp.f @@ -154,7 +154,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s integer, external :: align_double sze_8 = align_double(sze) - itermax = min(davidson_sze_max, sze/N_st_diag) + itermax = max(3,min(davidson_sze_max, sze/N_st_diag)) allocate( & W(sze_8,N_st_diag*itermax), & U(sze_8,N_st_diag*itermax), & @@ -306,7 +306,9 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0) enddo else - state_ok(k) = .True. + do k=1,size(state_ok) + state_ok(k) = .True. + enddo endif do k=1,shift2 @@ -383,30 +385,12 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s ! ----------------------------------------- do k=1,N_st_diag - if (state_ok(k)) then - do i=1,sze - U(i,shift2+k) = (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & - * (1.d0 + s2(k) * U(i,shift2+k) - S(i,shift2+k) - S_z2_Sz & - )/max(H_jj(i) - lambda (k),1.d-2) - enddo - else - ! Randomize components with bad - do i=1,sze-2,2 - call random_number(r1) - call random_number(r2) - r1 = dsqrt(-2.d0*dlog(r1)) - r2 = dtwo_pi*r2 - U(i,shift2+k) = r1*dcos(r2) - U(i+1,shift2+k) = r1*dsin(r2) - enddo - do i=sze-2+1,sze - call random_number(r1) - call random_number(r2) - r1 = dsqrt(-2.d0*dlog(r1)) - r2 = dtwo_pi*r2 - U(i,shift2+k) = r1*dcos(r2) - enddo - endif + do i=1,sze + U(i,shift2+k) = & + (lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) & + * (1.d0 + s2(k) * U(i,shift2+k) - S(i,shift2+k) - S_z2_Sz & + )/max(H_jj(i) - lambda (k),1.d-2) + enddo if (k <= N_st) then residual_norm(k) = u_dot_u(U(1,shift2+k),sze) diff --git a/src/Davidson/diagonalize_CI.irp.f b/src/Davidson/diagonalize_CI.irp.f index 3b2c9ed0..e1b67438 100644 --- a/src/Davidson/diagonalize_CI.irp.f +++ b/src/Davidson/diagonalize_CI.irp.f @@ -40,6 +40,7 @@ END_PROVIDER double precision, allocatable :: e_array(:) integer, allocatable :: iorder(:) + PROVIDE threshold_davidson ! Guess values for the "N_states" states of the CI_eigenvectors do j=1,min(N_states,N_det) do i=1,N_det diff --git a/src/Davidson/tree_dependency.png b/src/Davidson/tree_dependency.png new file mode 100644 index 00000000..e69de29b diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index dd5ab1ab..117e704e 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -88,9 +88,12 @@ subroutine H_u_0_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,N_st,sze_8) !$OMP DO SCHEDULE(dynamic) do sh=1,shortcut(0,1) - do sh2=sh,shortcut(0,1) - exa = 0 - do ni=1,Nint + do sh2=1,shortcut(0,1) + exa = popcnt(xor(version(1,sh,1), version(1,sh2,1))) + if(exa > 2) then + cycle + end if + do ni=2,Nint exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) end do if(exa > 2) then @@ -99,29 +102,27 @@ subroutine H_u_0_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,N_st,sze_8) do i=shortcut(sh,1),shortcut(sh+1,1)-1 org_i = sort_idx(i,1) - if(sh==sh2) then - endi = i-1 - else - endi = shortcut(sh2+1,1)-1 - end if do ni=1,Nint sorted_i(ni) = sorted(ni,i,1) enddo - do j=shortcut(sh2,1),endi + jloop: do j=shortcut(sh2,1),shortcut(sh2+1,1)-1 org_j = sort_idx(j,1) - ext = exa - do ni=1,Nint - ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) - end do - if(ext <= 4) then - call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) - do istate=1,N_st - vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j) - vt (istate,org_j) = vt (istate,org_j) + hij*ut(istate,org_i) - enddo + ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1))) + if(ext > 4) then + cycle jloop endif - enddo + do ni=2,Nint + ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) + if(ext > 4) then + cycle jloop + endif + end do + call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) + do istate=1,N_st + vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j) + enddo + enddo jloop enddo enddo enddo @@ -131,19 +132,19 @@ subroutine H_u_0_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,N_st,sze_8) do sh=1,shortcut(0,2) do i=shortcut(sh,2),shortcut(sh+1,2)-1 org_i = sort_idx(i,2) - do j=shortcut(sh,2),i-1 + do j=shortcut(sh,2),shortcut(sh+1,2)-1 org_j = sort_idx(j,2) - ext = 0 - do ni=1,Nint + ext = popcnt(xor(sorted(1,i,2), sorted(1,j,2))) + do ni=2,Nint ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) end do - if(ext == 4) then - call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) - do istate=1,N_st - vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j) - vt (istate,org_j) = vt (istate,org_j) + hij*ut(istate,org_i) - enddo - end if + if(ext /= 4) then + cycle + endif + call i_H_j(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),Nint,hij) + do istate=1,N_st + vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j) + enddo end do end do enddo @@ -313,7 +314,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) integer :: blockb, blockb2, istep double precision :: ave_workload, workload, target_workload_inv - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: vt, ut + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: vt, ut, st N_st_8 = align_double(N_st) @@ -328,49 +329,62 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) v_0 = 0.d0 s_0 = 0.d0 - do i=1,n - do istate=1,N_st - ut(istate,i) = u_0(i,istate) - enddo - enddo - call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint) call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint) !$OMP PARALLEL DEFAULT(NONE) & !$OMP PRIVATE(i,hij,s2,j,k,jj,vt,st,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)& - !$OMP SHARED(n,keys_tmp,ut,Nint,v_0,s_0,sorted,shortcut,sort_idx,version,N_st,N_st_8) + !$OMP SHARED(n,keys_tmp,ut,Nint,u_0,v_0,s_0,sorted,shortcut,sort_idx,version,N_st,N_st_8) allocate(vt(N_st_8,n),st(N_st_8,n)) Vt = 0.d0 St = 0.d0 - !$OMP DO SCHEDULE(static,1) + !$OMP DO + do i=1,n + do istate=1,N_st + ut(istate,i) = u_0(sort_idx(i,2),istate) + enddo + enddo + !$OMP END DO + + !$OMP DO SCHEDULE(dynamic) do sh=1,shortcut(0,2) do i=shortcut(sh,2),shortcut(sh+1,2)-1 org_i = sort_idx(i,2) - do j=shortcut(sh,2),i-1 + do j=shortcut(sh,2),shortcut(sh+1,2)-1 org_j = sort_idx(j,2) - ext = 0 - do ni=1,Nint + ext = popcnt(xor(sorted(1,i,2), sorted(1,j,2))) + if (ext > 4) cycle + do ni=2,Nint ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2))) + if (ext > 4) exit end do if(ext == 4) then call i_h_j (keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,hij) call get_s2(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,s2) do istate=1,n_st - vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j) - vt (istate,org_j) = vt (istate,org_j) + hij*ut(istate,org_i) - st (istate,org_i) = st (istate,org_i) + s2*ut(istate,org_j) - st (istate,org_j) = st (istate,org_j) + s2*ut(istate,org_i) + vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,j) + st (istate,org_i) = st (istate,org_i) + s2*ut(istate,j) enddo end if end do end do enddo - !$OMP END DO NOWAIT + !$OMP END DO + + !$OMP DO + do i=1,n + do istate=1,N_st + ut(istate,i) = u_0(sort_idx(i,1),istate) + enddo + enddo + !$OMP END DO + + !$OMP DO SCHEDULE(dynamic) do sh=1,shortcut(0,1) - !$OMP DO SCHEDULE(static,1) - do sh2=sh,shortcut(0,1) + do sh2=1,shortcut(0,1) + if (sh==sh2) cycle + exa = 0 do ni=1,Nint exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1))) @@ -381,44 +395,102 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) do i=shortcut(sh,1),shortcut(sh+1,1)-1 org_i = sort_idx(i,1) - if(sh==sh2) then - endi = i-1 - else - endi = shortcut(sh2+1,1)-1 - end if do ni=1,Nint sorted_i(ni) = sorted(ni,i,1) enddo - do j=shortcut(sh2,1),endi - ext = exa - do ni=1,Nint + do j=shortcut(sh2,1),shortcut(sh2+1,1)-1 + ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1))) + if (ext > 4) cycle + do ni=2,Nint ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) + if (ext > 4) exit end do if(ext <= 4) then org_j = sort_idx(j,1) call i_h_j (keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,hij) if (hij /= 0.d0) then do istate=1,n_st - vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,org_j) - vt (istate,org_j) = vt (istate,org_j) + hij*ut(istate,org_i) + vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,j) enddo endif if (ext /= 2) then call get_s2(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,s2) if (s2 /= 0.d0) then do istate=1,n_st - st (istate,org_i) = st (istate,org_i) + s2*ut(istate,org_j) - st (istate,org_j) = st (istate,org_j) + s2*ut(istate,org_i) + st (istate,org_i) = st (istate,org_i) + s2*ut(istate,j) enddo endif endif endif enddo + + enddo + enddo + + exa = 0 + + do i=shortcut(sh,1),shortcut(sh+1,1)-1 + org_i = sort_idx(i,1) + do ni=1,Nint + sorted_i(ni) = sorted(ni,i,1) + enddo + + do j=shortcut(sh,1),i-1 + ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1))) + if (ext > 4) cycle + do ni=2,Nint + ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) + if (ext > 4) exit + end do + if(ext <= 4) then + org_j = sort_idx(j,1) + call i_h_j (keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,hij) + if (hij /= 0.d0) then + do istate=1,n_st + vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,j) + enddo + endif + if (ext /= 2) then + call get_s2(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,s2) + if (s2 /= 0.d0) then + do istate=1,n_st + st (istate,org_i) = st (istate,org_i) + s2*ut(istate,j) + enddo + endif + endif + endif + enddo + + do j=i+1,shortcut(sh+1,1)-1 + if (i==j) cycle + ext = exa + popcnt(xor(sorted_i(1), sorted(1,j,1))) + if (ext > 4) cycle + do ni=2,Nint + ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1))) + if (ext > 4) exit + end do + if(ext <= 4) then + org_j = sort_idx(j,1) + call i_h_j (keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,hij) + if (hij /= 0.d0) then + do istate=1,n_st + vt (istate,org_i) = vt (istate,org_i) + hij*ut(istate,j) + enddo + endif + if (ext /= 2) then + call get_s2(keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,s2) + if (s2 /= 0.d0) then + do istate=1,n_st + st (istate,org_i) = st (istate,org_i) + s2*ut(istate,j) + enddo + endif + endif + endif enddo enddo - !$OMP END DO NOWAIT enddo + !$OMP END DO !$OMP CRITICAL (u0Hu0) do istate=1,N_st diff --git a/src/Determinants/README.rst b/src/Determinants/README.rst index c6685945..9ad0f1a3 100644 --- a/src/Determinants/README.rst +++ b/src/Determinants/README.rst @@ -15,23 +15,31 @@ Documentation .. by the `update_README.py` script. -`a_operator `_ +`a_operator `_ Needed for diag_H_mat_elem -`abs_psi_coef_max `_ +`abs_psi_coef_max `_ Max and min values of the coefficients -`abs_psi_coef_min `_ +`abs_psi_coef_min `_ Max and min values of the coefficients -`ac_operator `_ +`ac_operator `_ Needed for diag_H_mat_elem -`apply_excitation `_ +`apply_excitation `_ + Undocumented + + +`apply_hole `_ + Undocumented + + +`apply_holes `_ Undocumented @@ -39,16 +47,24 @@ Documentation Undocumented +`apply_particle `_ + Undocumented + + +`apply_particles `_ + Undocumented + + `bi_elec_ref_bitmask_energy `_ Energy of the reference bitmask used in Slater rules -`bitstring_to_list_ab `_ +`bitstring_to_list_ab `_ Gives the inidices(+1) of the bits set to 1 in the bit string For alpha/beta determinants -`bitstring_to_list_ab_old `_ +`bitstring_to_list_ab_old `_ Gives the inidices(+1) of the bits set to 1 in the bit string For alpha/beta determinants @@ -58,72 +74,15 @@ Documentation determinant. F_00 is = E0. -`ci_eigenvectors `_ - Eigenvectors/values of the CI matrix - - -`ci_eigenvectors_mono `_ - Eigenvectors/values of the CI matrix - - -`ci_eigenvectors_s2 `_ - Eigenvectors/values of the CI matrix - - -`ci_eigenvectors_s2_mono `_ - Eigenvectors/values of the CI matrix - - -`ci_electronic_energy `_ - Eigenvectors/values of the CI matrix - - -`ci_electronic_energy_mono `_ - Eigenvectors/values of the CI matrix - - -`ci_energy `_ - N_states lowest eigenvalues of the CI matrix - - -`ci_sc2_eigenvectors `_ - Eigenvectors/values of the CI matrix - - -`ci_sc2_electronic_energy `_ - Eigenvectors/values of the CI matrix - - -`ci_sc2_energy `_ - N_states_diag lowest eigenvalues of the CI matrix - - `cisd `_ Undocumented -`cisd_sc2 `_ - CISD+SC2 method :: take off all the disconnected terms of a CISD (selected or not) - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - Initial guess vectors are not necessarily orthonormal - - -`connected_to_ref `_ +`connected_to_ref `_ Undocumented -`connected_to_ref_by_mono `_ +`connected_to_ref_by_mono `_ Undocumented @@ -136,11 +95,11 @@ Documentation Undocumented -`create_minilist `_ +`create_minilist `_ Undocumented -`create_minilist_find_previous `_ +`create_minilist_find_previous `_ Undocumented @@ -149,62 +108,6 @@ Documentation of alpha and beta determinants -`davidson_converged `_ - True if the Davidson algorithm is converged - - -`davidson_criterion `_ - Can be : [ energy | residual | both | wall_time | cpu_time | iterations ] - - -`davidson_diag `_ - Davidson diagonalization. - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - iunit : Unit number for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_diag_hjj `_ - Davidson diagonalization with specific diagonal elements of the H matrix - .br - H_jj : specific diagonal H matrix elements to diagonalize de Davidson - .br - dets_in : bitmasks corresponding to determinants - .br - u_in : guess coefficients on the various states. Overwritten - on exit - .br - dim_in : leftmost dimension of u_in - .br - sze : Number of determinants - .br - N_st : Number of eigenstates - .br - iunit : Unit for the I/O - .br - Initial guess vectors are not necessarily orthonormal - - -`davidson_iter_max `_ - Max number of Davidson iterations - - -`davidson_sze_max `_ - Max number of Davidson sizes - - `decode_exc `_ Decodes the exc arrays returned by get_excitation. h1,h2 : Holes @@ -213,6 +116,14 @@ Documentation degree : Degree of excitation +`decode_exc_int2 `_ + Decodes the exc arrays returned by get_excitation. + h1,h2 : Holes + p1,p2 : Particles + s1,s2 : Spins (1:alpha, 2:beta) + degree : Degree of excitation + + `det_alpha_norm `_ Norm of the alpha and beta spin determinants in the wave function: .br @@ -225,15 +136,11 @@ Documentation ||Da||_i \sum_j C_{ij}**2 -`det_coef `_ +`det_coef `_ det_coef -`det_inf `_ - Undocumented - - -`det_occ `_ +`det_occ `_ det_occ @@ -245,44 +152,29 @@ Documentation Transform a determinant to an occupation pattern -`diag_algorithm `_ +`detcmp `_ + Undocumented + + +`deteq `_ + Undocumented + + +`diag_algorithm `_ Diagonalization algorithm (Davidson or Lapack) -`diag_h_elements_sc2 `_ - Eigenvectors/values of the CI matrix - - -`diag_h_mat_elem `_ +`diag_h_mat_elem `_ Computes -`diag_h_mat_elem_fock `_ +`diag_h_mat_elem_fock `_ Computes when i is at most a double excitation from a reference. -`diagonalize_ci `_ - Replace the coefficients of the CI states by the coefficients of the - eigenstates of the CI matrix - - -`diagonalize_ci_mono `_ - Replace the coefficients of the CI states by the coefficients of the - eigenstates of the CI matrix - - -`diagonalize_ci_sc2 `_ - Replace the coefficients of the CI states_diag by the coefficients of the - eigenstates of the CI matrix - - -`diagonalize_s2 `_ - Diagonalize the S^2 operator within the n_states_diag states required. Notice : the vectors are sorted by increasing S^2 values. - - -`diagonalize_s2_betweenstates `_ - You enter with nstates vectors in psi_coefs_inout that may be coupled by S^2 +`diagonalize_s2_betweenstates `_ + You enter with nstates vectors in u_0 that may be coupled by S^2 The subroutine diagonalize the S^2 operator in the basis of these states. The vectors that you obtain in output are no more coupled by S^2, which does not necessary mean that they are eigenfunction of S^2. @@ -349,7 +241,7 @@ Documentation idx(0) is the number of determinants that interact with key1 -`filter_connected_i_h_psi0 `_ +`filter_connected_i_h_psi0 `_ returns the array idx which contains the index of the .br determinants in the array key1 that interact @@ -359,7 +251,7 @@ Documentation idx(0) is the number of determinants that interact with key1 -`filter_connected_i_h_psi0_sc2 `_ +`filter_connected_i_h_psi0_sc2 `_ standard filter_connected_i_H_psi but returns in addition .br the array of the index of the non connected determinants to key1 @@ -371,18 +263,22 @@ Documentation to repeat the excitations -`first_guess `_ - Select all the determinants with the lowest energy as a starting point. +`flip_generators `_ + Undocumented `generate_all_alpha_beta_det_products `_ Create a wave function from all possible alpha x beta determinants -`get_double_excitation `_ +`get_double_excitation `_ Returns the two excitation operators between two doubly excited determinants and the phase +`get_double_excitation_phase `_ + Undocumented + + `get_excitation `_ Returns the excitation operators between two determinants and the phase @@ -391,7 +287,7 @@ Documentation Returns the excitation degree between two determinants -`get_excitation_degree_vector `_ +`get_excitation_degree_vector `_ Applies get_excitation_degree to an array of determinants @@ -407,27 +303,23 @@ Documentation Returns the index of the determinant in the ``psi_det_sorted_bit`` array -`get_mono_excitation `_ +`get_mono_excitation `_ Returns the excitation operator between two singly excited determinants and the phase -`get_occ_from_key `_ +`get_occ_from_key `_ Returns a list of occupation numbers from a bitstring +`get_phase `_ + Returns the phase between key1 and key2 + + `get_s2 `_ Returns -`get_s2_u0 `_ - Undocumented - - -`get_s2_u0_old `_ - Undocumented - - -`get_uj_s2_ui `_ +`get_uj_s2_ui `_ returns the matrix elements of S^2 "s2(i,j)" between the "nstates" states psi_coefs_tmp(:,i) and psi_coefs_tmp(:,j) @@ -458,27 +350,19 @@ Documentation Undocumented -`h_u_0 `_ - Computes v_0 = H|u_0> - .br - n : number of determinants - .br - H_jj : array of - - -`i_h_j `_ +`i_h_j `_ Returns where i and j are determinants -`i_h_j_phase_out `_ +`i_h_j_phase_out `_ Returns where i and j are determinants -`i_h_j_verbose `_ +`i_h_j_verbose `_ Returns where i and j are determinants -`i_h_psi `_ +`i_h_psi `_ Computes = \sum_J c_J . .br Uses filter_connected_i_H_psi0 to get all the |J> to which |i> @@ -487,14 +371,14 @@ Documentation minilists -`i_h_psi_minilist `_ +`i_h_psi_minilist `_ Computes = \sum_J c_J . .br Uses filter_connected_i_H_psi0 to get all the |J> to which |i> is connected. The |J> are searched in short pre-computed lists. -`i_h_psi_sc2 `_ +`i_h_psi_sc2 `_ for the various Nstate .br returns in addition @@ -508,7 +392,7 @@ Documentation to repeat the excitations -`i_h_psi_sc2_verbose `_ +`i_h_psi_sc2_verbose `_ for the various Nstate .br returns in addition @@ -522,10 +406,17 @@ Documentation to repeat the excitations -`i_h_psi_sec_ord `_ +`i_h_psi_sec_ord `_ for the various Nstates +`i_s2_psi_minilist `_ + Computes = \sum_J c_J . + .br + Uses filter_connected_i_H_psi0 to get all the |J> to which |i> + is connected. The |J> are searched in short pre-computed lists. + + `idx_cas `_ CAS wave function, defined from the application of the CAS bitmask on the determinants. idx_cas gives the indice of the CAS determinant in psi_det. @@ -537,11 +428,15 @@ Documentation idx_non_cas gives the indice of the determinant in psi_det. -`is_connected_to `_ +`is_connected_to `_ Undocumented -`is_connected_to_by_mono `_ +`is_connected_to_by_mono `_ + Undocumented + + +`is_generable_cassd `_ Undocumented @@ -557,7 +452,7 @@ Documentation Undocumented -`max_degree_exc `_ +`max_degree_exc `_ Maximum degree of excitation in the wf @@ -573,7 +468,7 @@ Documentation Undocumented -`n_det `_ +`n_det `_ Number of determinants in the wave function @@ -598,7 +493,7 @@ Documentation Maximum number of determinants diagonalized by Jacobi -`n_det_max_property `_ +`n_det_max_property `_ Max number of determinants in the wave function when you select for a given property @@ -630,10 +525,6 @@ Documentation Number of states to consider -`n_states_diag `_ - Number of states to consider for the diagonalization - - `neutral_no_hund_in_couple `_ n_couples is the number of couples of orbitals to be checked couples(i,1) = first orbital of the ith couple @@ -696,15 +587,15 @@ Documentation rho(alpha) - rho(beta) -`only_single_double_dm `_ +`only_single_double_dm `_ If true, The One body DM is calculated with ignoring the Double<->Doubles extra diag elements -`psi_average_norm_contrib `_ +`psi_average_norm_contrib `_ Contribution of determinants to the state-averaged density -`psi_average_norm_contrib_sorted `_ +`psi_average_norm_contrib_sorted `_ Wave function sorted by determinants contribution to the norm (state-averaged) @@ -756,7 +647,7 @@ Documentation function. -`psi_coef `_ +`psi_coef `_ The wave function coefficients. Initialized with Hartree-Fock if the EZFIO file is empty @@ -765,26 +656,26 @@ Documentation Undocumented -`psi_coef_max `_ +`psi_coef_max `_ Max and min values of the coefficients -`psi_coef_min `_ +`psi_coef_min `_ Max and min values of the coefficients -`psi_coef_sorted `_ +`psi_coef_sorted `_ Wave function sorted by determinants contribution to the norm (state-averaged) -`psi_coef_sorted_bit `_ +`psi_coef_sorted_bit `_ Determinants on which we apply for perturbation. They are sorted by determinants interpreted as integers. Useful to accelerate the search of a random determinant in the wave function. -`psi_det `_ +`psi_det `_ The wave function determinants. Initialized with Hartree-Fock if the EZFIO file is empty @@ -805,15 +696,15 @@ Documentation Unique beta determinants -`psi_det_size `_ +`psi_det_size `_ Size of the psi_det/psi_coef arrays -`psi_det_sorted `_ +`psi_det_sorted `_ Wave function sorted by determinants contribution to the norm (state-averaged) -`psi_det_sorted_bit `_ +`psi_det_sorted_bit `_ Determinants on which we apply for perturbation. They are sorted by determinants interpreted as integers. Useful to accelerate the search of a random determinant in the wave @@ -860,7 +751,7 @@ Documentation Undocumented -`read_dets `_ +`read_dets `_ Reads the determinants from the EZFIO file @@ -885,11 +776,25 @@ Documentation be set before calling this function. -`s2_eig `_ +`s2_eig `_ Force the wave function to be an eigenfunction of S^2 -`s2_values `_ +`s2_u_0 `_ + Computes v_0 = S^2|u_0> + .br + n : number of determinants + .br + + +`s2_u_0_nstates `_ + Computes v_0 = S^2|u_0> + .br + n : number of determinants + .br + + +`s2_values `_ array of the averaged values of the S^2 operator on the various states @@ -913,23 +818,23 @@ Documentation Save natural orbitals, obtained by diagonalization of the one-body density matrix in the MO basis -`save_ref_determinant `_ +`save_ref_determinant `_ Undocumented -`save_wavefunction `_ +`save_wavefunction `_ Save the wave function into the EZFIO file -`save_wavefunction_general `_ +`save_wavefunction_general `_ Save the wave function into the EZFIO file -`save_wavefunction_specified `_ +`save_wavefunction_specified `_ Save the wave function into the EZFIO file -`save_wavefunction_unsorted `_ +`save_wavefunction_unsorted `_ Save the wave function into the EZFIO file @@ -947,49 +852,25 @@ Documentation for a given couple of hole/particle excitations i. -`sort_dets_ab `_ - Uncodumented : TODO - - -`sort_dets_ab_v `_ - Uncodumented : TODO - - -`sort_dets_ba_v `_ - Uncodumented : TODO - - -`sort_dets_by_det_search_key `_ +`sort_dets_by_det_search_key `_ Determinants are sorted are sorted according to their det_search_key. Useful to accelerate the search of a random determinant in the wave function. `spin_det_search_key `_ - Return an integer*8 corresponding to a determinant index for searching + Return an integer(8) corresponding to a determinant index for searching `state_average_weight `_ Weights in the state-average calculation of the density matrix -`tamiser `_ - Uncodumented : TODO - - -`target_energy `_ +`target_energy `_ Energy that should be obtained when truncating the wave function (optional) -`threshold_convergence_sc2 `_ - convergence of the correlation energy of SC2 iterations - - -`threshold_davidson `_ - Thresholds of Davidson's algorithm - - -`threshold_generators `_ +`threshold_generators `_ Thresholds on generators (fraction of the norm) @@ -997,8 +878,8 @@ Documentation Thresholds on selectors (fraction of the norm) -`u0_h_u_0 `_ - Computes e_0 = / +`u_0_s2_u_0 `_ + Computes e_0 = / .br n : number of determinants .br diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index 39b0f58e..bed3327d 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -438,8 +438,12 @@ end do i=1,N_states psi_coef_min(i) = minval(psi_coef(:,i)) psi_coef_max(i) = maxval(psi_coef(:,i)) - abs_psi_coef_min(i) = dabs(psi_coef_min(i)) - abs_psi_coef_max(i) = dabs(psi_coef_max(i)) + abs_psi_coef_min(i) = minval( dabs(psi_coef(:,i)) ) + abs_psi_coef_max(i) = maxval( dabs(psi_coef(:,i)) ) + call write_double(6,psi_coef_max(i), 'Max coef') + call write_double(6,psi_coef_min(i), 'Min coef') + call write_double(6,abs_psi_coef_max(i), 'Max abs coef') + call write_double(6,abs_psi_coef_min(i), 'Min abs coef') enddo END_PROVIDER @@ -760,37 +764,85 @@ subroutine apply_excitation(det, exc, res, ok, Nint) ok = .false. degree = exc(0,1,1) + exc(0,1,2) - if(.not. (degree > 0 .and. degree <= 2)) then - print *, degree - print *, "apply ex" - STOP - endif - - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) +! call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) +! INLINE + select case(degree) + case(2) + if (exc(0,1,1) == 2) then + h1 = exc(1,1,1) + h2 = exc(2,1,1) + p1 = exc(1,2,1) + p2 = exc(2,2,1) + s1 = 1 + s2 = 1 + else if (exc(0,1,2) == 2) then + h1 = exc(1,1,2) + h2 = exc(2,1,2) + p1 = exc(1,2,2) + p2 = exc(2,2,2) + s1 = 2 + s2 = 2 + else + h1 = exc(1,1,1) + h2 = exc(1,1,2) + p1 = exc(1,2,1) + p2 = exc(1,2,2) + s1 = 1 + s2 = 2 + endif + case(1) + if (exc(0,1,1) == 1) then + h1 = exc(1,1,1) + h2 = 0 + p1 = exc(1,2,1) + p2 = 0 + s1 = 1 + s2 = 0 + else + h1 = exc(1,1,2) + h2 = 0 + p1 = exc(1,2,2) + p2 = 0 + s1 = 2 + s2 = 0 + endif + case(0) + h1 = 0 + p1 = 0 + h2 = 0 + p2 = 0 + s1 = 0 + s2 = 0 + case default + print *, degree + print *, "apply ex" + STOP + end select +! END INLINE + res = det - ii = (h1-1)/bit_kind_size + 1 - pos = mod(h1-1, 64)!iand(h1-1,bit_kind_size-1) ! mod 64 - if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return + ii = ishft(h1-1,-bit_kind_shift) + 1 + pos = h1-1-ishft(ii-1,bit_kind_shift) + if(iand(det(ii, s1), ibset(0_bit_kind, pos)) == 0_8) return res(ii, s1) = ibclr(res(ii, s1), pos) - ii = (p1-1)/bit_kind_size + 1 - pos = mod(p1-1, 64)!iand(p1-1,bit_kind_size-1) + ii = ishft(p1-1,-bit_kind_shift) + 1 + pos = p1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return res(ii, s1) = ibset(res(ii, s1), pos) if(degree == 2) then - ii = (h2-1)/bit_kind_size + 1 - pos = mod(h2-1, 64)!iand(h2-1,bit_kind_size-1) + ii = ishft(h2-1,-bit_kind_shift) + 1 + pos = h2-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return res(ii, s2) = ibclr(res(ii, s2), pos) - ii = (p2-1)/bit_kind_size + 1 - pos = mod(p2-1, 64)!iand(p2-1,bit_kind_size-1) + ii = ishft(p2-1,-bit_kind_shift) + 1 + pos = p2-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return res(ii, s2) = ibset(res(ii, s2), pos) endif - ok = .true. end subroutine @@ -809,14 +861,14 @@ subroutine apply_particles(det, s1, p1, s2, p2, res, ok, Nint) res = det if(p1 /= 0) then - ii = (p1-1)/bit_kind_size + 1 - pos = mod(p1-1, 64)!iand(p1-1,bit_kind_size-1) + ii = ishft(p1-1,-bit_kind_shift) + 1 + pos = p1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return res(ii, s1) = ibset(res(ii, s1), pos) end if - ii = (p2-1)/bit_kind_size + 1 - pos = mod(p2-1, 64)!iand(p2-1,bit_kind_size-1) + ii = ishft(p2-1,-bit_kind_shift) + 1 + pos = p2-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return res(ii, s2) = ibset(res(ii, s2), pos) @@ -838,14 +890,14 @@ subroutine apply_holes(det, s1, h1, s2, h2, res, ok, Nint) res = det if(h1 /= 0) then - ii = (h1-1)/bit_kind_size + 1 - pos = mod(h1-1, 64)!iand(h1-1,bit_kind_size-1) + ii = ishft(h1-1,-bit_kind_shift) + 1 + pos = h1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return res(ii, s1) = ibclr(res(ii, s1), pos) end if - ii = (h2-1)/bit_kind_size + 1 - pos = mod(h2-1, 64)!iand(h2-1,bit_kind_size-1) + ii = ishft(h2-1,-bit_kind_shift) + 1 + pos = h2-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return res(ii, s2) = ibclr(res(ii, s2), pos) @@ -865,8 +917,8 @@ subroutine apply_particle(det, s1, p1, res, ok, Nint) ok = .false. res = det - ii = (p1-1)/bit_kind_size + 1 - pos = mod(p1-1, 64)!iand(p1-1,bit_kind_size-1) + ii = ishft(p1-1,-bit_kind_shift) + 1 + pos = p1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return res(ii, s1) = ibset(res(ii, s1), pos) @@ -887,8 +939,8 @@ subroutine apply_hole(det, s1, h1, res, ok, Nint) ok = .false. res = det - ii = (h1-1)/bit_kind_size + 1 - pos = mod(h1-1, 64)!iand(h1-1,bit_kind_size-1) + ii = ishft(h1-1,-bit_kind_shift) + 1 + pos = h1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return res(ii, s1) = ibclr(res(ii, s1), pos) diff --git a/src/Electrons/README.rst b/src/Electrons/README.rst index d1c342b5..484617bb 100644 --- a/src/Electrons/README.rst +++ b/src/Electrons/README.rst @@ -44,7 +44,7 @@ Documentation .. by the `update_README.py` script. -`elec_alpha_num `_ +`elec_alpha_num `_ Numbers of electrons alpha ("up") diff --git a/src/Ezfio_files/README.rst b/src/Ezfio_files/README.rst index 6b494339..ad87e7f5 100644 --- a/src/Ezfio_files/README.rst +++ b/src/Ezfio_files/README.rst @@ -219,6 +219,10 @@ output_cas_sd Initial CPU and wall times when printing in the output files +output_davidson + Output file for Davidson + + output_determinants Output file for Determinants @@ -235,6 +239,10 @@ output_full_ci Output file for Full_CI +output_full_ci_zmq + Output file for Full_CI_ZMQ + + output_generators_cas Output file for Generators_CAS @@ -267,14 +275,14 @@ output_moguess Output file for MOGuess -output_mrcc_cassd - Output file for MRCC_CASSD - - output_mrcc_utils Output file for MRCC_Utils +output_mrcepa0 + Output file for mrcepa0 + + output_nuclei Output file for Nuclei diff --git a/src/Integrals_Bielec/README.rst b/src/Integrals_Bielec/README.rst index 98fbbb92..f6644db4 100644 --- a/src/Integrals_Bielec/README.rst +++ b/src/Integrals_Bielec/README.rst @@ -45,7 +45,7 @@ Documentation .. by the `update_README.py` script. -`add_integrals_to_map `_ +`add_integrals_to_map `_ Adds integrals to tha MO map according to some bitmask @@ -54,7 +54,7 @@ Documentation i(r1) j(r1) 1/r12 k(r2) l(r2) -`ao_bielec_integral_schwartz `_ +`ao_bielec_integral_schwartz `_ Needed to compute Schwartz inequalities @@ -68,7 +68,7 @@ Documentation i(r1) j(r2) 1/r12 k(r1) l(r2) -`ao_bielec_integrals_in_map_collector `_ +`ao_bielec_integrals_in_map_collector `_ Collects results from the AO integral calculation @@ -84,11 +84,23 @@ Documentation Computes a buffer of integrals. i is the ID of the current thread. +`ao_integrals_cache `_ + Cache of AO integrals for fast access + + +`ao_integrals_cache_max `_ + Min and max values of the AOs for which the integrals are in the cache + + +`ao_integrals_cache_min `_ + Min and max values of the AOs for which the integrals are in the cache + + `ao_integrals_map `_ AO integrals -`ao_integrals_threshold `_ +`ao_integrals_threshold `_ If || < ao_integrals_threshold then is zero @@ -108,11 +120,11 @@ Documentation Undocumented -`clear_ao_map `_ +`clear_ao_map `_ Frees the memory of the AO map -`clear_mo_map `_ +`clear_mo_map `_ Frees the memory of the MO map @@ -120,15 +132,15 @@ Documentation Compute AO 1/r12 integrals for all i and fixed j,k,l -`compute_ao_integrals_jl `_ +`compute_ao_integrals_jl `_ Parallel client for AO integrals -`disk_access_ao_integrals `_ +`disk_access_ao_integrals `_ Read/Write AO integrals from/to disk [ Write | Read | None ] -`disk_access_mo_integrals `_ +`disk_access_mo_integrals `_ Read/Write MO integrals from/to disk [ Write | Read | None ] @@ -136,15 +148,15 @@ Documentation Compute integrals on the fly -`dump_ao_integrals `_ +`dump_ao_integrals `_ Save to disk the $ao integrals -`dump_mo_integrals `_ +`dump_mo_integrals `_ Save to disk the $ao integrals -`eri `_ +`eri `_ ATOMIC PRIMTIVE bielectronic integral between the 4 primitives :: primitive_1 = x1**(a_x) y1**(a_y) z1**(a_z) exp(-alpha * r1**2) primitive_2 = x1**(b_x) y1**(b_y) z1**(b_z) exp(- beta * r1**2) @@ -166,148 +178,156 @@ Documentation t_w(i,2,k) = t(i) -`general_primitive_integral `_ +`general_primitive_integral `_ Computes the integral where p,q,r,s are Gaussian primitives -`get_ao_bielec_integral `_ +`get_ao_bielec_integral `_ Gets one AO bi-electronic integral from the AO map -`get_ao_bielec_integrals `_ +`get_ao_bielec_integrals `_ Gets multiple AO bi-electronic integral from the AO map . All i are retrieved for j,k,l fixed. -`get_ao_bielec_integrals_non_zero `_ +`get_ao_bielec_integrals_non_zero `_ Gets multiple AO bi-electronic integral from the AO map . All non-zero i are retrieved for j,k,l fixed. -`get_ao_map_size `_ +`get_ao_map_size `_ Returns the number of elements in the AO map -`get_mo_bielec_integral `_ +`get_mo_bielec_integral `_ Returns one integral in the MO basis -`get_mo_bielec_integral_schwartz `_ +`get_mo_bielec_integral_schwartz `_ Returns one integral in the MO basis -`get_mo_bielec_integrals `_ +`get_mo_bielec_integrals `_ Returns multiple integrals in the MO basis, all i for j,k,l fixed. -`get_mo_bielec_integrals_ij `_ +`get_mo_bielec_integrals_ij `_ Returns multiple integrals in the MO basis, all i(1)j(2) 1/r12 k(1)l(2) i, j for k,l fixed. -`get_mo_map_size `_ +`get_mo_map_size `_ Return the number of elements in the MO map -`give_polynom_mult_center_x `_ +`give_polynom_mult_center_x `_ subroutine that returns the explicit polynom in term of the "t" variable of the following polynomw : I_x1(a_x, d_x,p,q) * I_x1(a_y, d_y,p,q) * I_x1(a_z, d_z,p,q) -`i_x1_new `_ +`i_x1_new `_ recursive function involved in the bielectronic integral -`i_x1_pol_mult `_ +`i_x1_pol_mult `_ recursive function involved in the bielectronic integral -`i_x1_pol_mult_a1 `_ +`i_x1_pol_mult_a1 `_ recursive function involved in the bielectronic integral -`i_x1_pol_mult_a2 `_ +`i_x1_pol_mult_a2 `_ recursive function involved in the bielectronic integral -`i_x1_pol_mult_recurs `_ +`i_x1_pol_mult_recurs `_ recursive function involved in the bielectronic integral -`i_x2_new `_ +`i_x2_new `_ recursive function involved in the bielectronic integral -`i_x2_pol_mult `_ +`i_x2_pol_mult `_ recursive function involved in the bielectronic integral -`insert_into_ao_integrals_map `_ +`insert_into_ao_integrals_map `_ Create new entry into AO map -`insert_into_mo_integrals_map `_ +`insert_into_mo_integrals_map `_ Create new entry into MO map, or accumulate in an existing entry -`integrale_new `_ +`integrale_new `_ calculate the integral of the polynom :: I_x1(a_x+b_x, c_x+d_x,p,q) * I_x1(a_y+b_y, c_y+d_y,p,q) * I_x1(a_z+b_z, c_z+d_z,p,q) between ( 0 ; 1) -`load_ao_integrals `_ +`load_ao_integrals `_ Read from disk the $ao integrals -`load_mo_integrals `_ +`load_mo_integrals `_ Read from disk the $ao integrals -`mo_bielec_integral `_ +`mo_bielec_integral `_ Returns one integral in the MO basis -`mo_bielec_integral_jj `_ +`mo_bielec_integral_jj `_ mo_bielec_integral_jj(i,j) = J_ij mo_bielec_integral_jj_exchange(i,j) = K_ij mo_bielec_integral_jj_anti(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_anti `_ +`mo_bielec_integral_jj_anti `_ mo_bielec_integral_jj(i,j) = J_ij mo_bielec_integral_jj_exchange(i,j) = K_ij mo_bielec_integral_jj_anti(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_anti_from_ao `_ +`mo_bielec_integral_jj_anti_from_ao `_ mo_bielec_integral_jj_from_ao(i,j) = J_ij mo_bielec_integral_jj_exchange_from_ao(i,j) = J_ij mo_bielec_integral_jj_anti_from_ao(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_exchange `_ +`mo_bielec_integral_jj_exchange `_ mo_bielec_integral_jj(i,j) = J_ij mo_bielec_integral_jj_exchange(i,j) = K_ij mo_bielec_integral_jj_anti(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_exchange_from_ao `_ +`mo_bielec_integral_jj_exchange_from_ao `_ mo_bielec_integral_jj_from_ao(i,j) = J_ij mo_bielec_integral_jj_exchange_from_ao(i,j) = J_ij mo_bielec_integral_jj_anti_from_ao(i,j) = J_ij - K_ij -`mo_bielec_integral_jj_from_ao `_ +`mo_bielec_integral_jj_from_ao `_ mo_bielec_integral_jj_from_ao(i,j) = J_ij mo_bielec_integral_jj_exchange_from_ao(i,j) = J_ij mo_bielec_integral_jj_anti_from_ao(i,j) = J_ij - K_ij -`mo_bielec_integral_schwartz `_ +`mo_bielec_integral_mipi `_ + and - . Indices are (i,m,p) + + +`mo_bielec_integral_mipi_anti `_ + and - . Indices are (i,m,p) + + +`mo_bielec_integral_schwartz `_ Needed to compute Schwartz inequalities @@ -319,11 +339,23 @@ Documentation Computes an unique index for i,j,k,l integrals -`mo_integrals_map `_ +`mo_integrals_cache `_ + Cache of MO integrals for fast access + + +`mo_integrals_cache_max `_ + Min and max values of the MOs for which the integrals are in the cache + + +`mo_integrals_cache_min `_ + Min and max values of the MOs for which the integrals are in the cache + + +`mo_integrals_map `_ MO integrals -`mo_integrals_threshold `_ +`mo_integrals_threshold `_ If || < ao_integrals_threshold then is zero @@ -331,20 +363,16 @@ Documentation Aligned n_pt_max_integrals -`n_pt_sup `_ +`n_pt_sup `_ Returns the upper boundary of the degree of the polynomial involved in the bielctronic integral : Ix(a_x,b_x,c_x,d_x) * Iy(a_y,b_y,c_y,d_y) * Iz(a_z,b_z,c_z,d_z) -`provide_all_mo_integrals `_ +`provide_all_mo_integrals `_ Undocumented -`pull_integrals `_ - How the collector pulls the computed integrals - - `push_integrals `_ Push integrals in the push socket diff --git a/src/Integrals_Monoelec/README.rst b/src/Integrals_Monoelec/README.rst index d92cea0a..7e926fd5 100644 --- a/src/Integrals_Monoelec/README.rst +++ b/src/Integrals_Monoelec/README.rst @@ -102,7 +102,7 @@ Documentation interaction nuclear electron -`ao_nucl_elec_integral_per_atom `_ +`ao_nucl_elec_integral_per_atom `_ ao_nucl_elec_integral_per_atom(i,j,k) = - where Rk is the geometry of the kth atom @@ -115,7 +115,7 @@ Documentation Local pseudo-potential -`ao_pseudo_integral_non_local `_ +`ao_pseudo_integral_non_local `_ Local pseudo-potential @@ -153,19 +153,19 @@ Documentation Undocumented -`give_polynom_mult_center_mono_elec `_ +`give_polynom_mult_center_mono_elec `_ Undocumented -`i_x1_pol_mult_mono_elec `_ +`i_x1_pol_mult_mono_elec `_ Undocumented -`i_x2_pol_mult_mono_elec `_ +`i_x2_pol_mult_mono_elec `_ Undocumented -`int_gaus_pol `_ +`int_gaus_pol `_ Undocumented @@ -200,7 +200,7 @@ Documentation interaction nuclear electron on the MO basis -`mo_nucl_elec_integral_per_atom `_ +`mo_nucl_elec_integral_per_atom `_ mo_nucl_elec_integral_per_atom(i,j,k) = - where Rk is the geometry of the kth atom @@ -227,7 +227,7 @@ Documentation array of the integrals of MO_i * z^2 MO_j -`nai_pol_mult `_ +`nai_pol_mult `_ Undocumented @@ -259,27 +259,27 @@ Documentation Undocumented -`pseudo_dz_k_transp `_ +`pseudo_dz_k_transp `_ Transposed arrays for pseudopotentials -`pseudo_dz_kl_transp `_ +`pseudo_dz_kl_transp `_ Transposed arrays for pseudopotentials -`pseudo_n_k_transp `_ +`pseudo_n_k_transp `_ Transposed arrays for pseudopotentials -`pseudo_n_kl_transp `_ +`pseudo_n_kl_transp `_ Transposed arrays for pseudopotentials -`pseudo_v_k_transp `_ +`pseudo_v_k_transp `_ Transposed arrays for pseudopotentials -`pseudo_v_kl_transp `_ +`pseudo_v_kl_transp `_ Transposed arrays for pseudopotentials @@ -299,23 +299,23 @@ Documentation Undocumented -`v_e_n `_ +`v_e_n `_ Undocumented -`v_phi `_ +`v_phi `_ Undocumented -`v_r `_ +`v_r `_ Undocumented -`v_theta `_ +`v_theta `_ Undocumented -`wallis `_ +`wallis `_ Undocumented diff --git a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f index b34b201e..6f1fd905 100644 --- a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f @@ -3,7 +3,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral, (ao_num_align,ao_num)] BEGIN_DOC ! Pseudo-potential integrals END_DOC - + if (read_ao_one_integrals) then call read_one_e_integrals('ao_pseudo_integral', ao_pseudo_integral,& size(ao_pseudo_integral,1), size(ao_pseudo_integral,2)) @@ -53,13 +53,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu call wall_time(wall_1) call cpu_time(cpu_1) -!write(33,*) 'xxxLOCxxx' -!write(33,*) 'pseudo_klocmax', pseudo_klocmax -!write(33,*) 'pseudo_v_k_transp ', pseudo_v_k_transp -!write(33,*) 'pseudo_n_k_transp ', pseudo_n_k_transp -!write(33,*) 'pseudo_dz_k_transp', pseudo_dz_k_transp -!write(33,*) 'xxxLOCxxx' - thread_num = 0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -109,14 +102,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu pseudo_n_k_transp (1,k), & pseudo_dz_k_transp(1,k), & A_center,power_A,alpha,B_center,power_B,beta,C_center) -! write(33,*) i,j,k -! write(33,*) A_center,power_A,alpha,B_center,power_B,beta,C_center, & -! Vloc(pseudo_klocmax, & -! pseudo_v_k_transp (1,k), & -! pseudo_n_k_transp (1,k), & -! pseudo_dz_k_transp(1,k), & -! A_center,power_A,alpha,B_center,power_B,beta,C_center) -! write(33,*) enddo ao_pseudo_integral_local(i,j) = ao_pseudo_integral_local(i,j) +& diff --git a/src/Nuclei/README.rst b/src/Nuclei/README.rst index bf7e6f52..356b8e9e 100644 --- a/src/Nuclei/README.rst +++ b/src/Nuclei/README.rst @@ -38,7 +38,7 @@ Documentation Array of the name of element, sorted by nuclear charge (integer) -`nucl_charge `_ +`nucl_charge `_ Nuclear charges diff --git a/src/Pseudo/EZFIO.cfg b/src/Pseudo/EZFIO.cfg index fc23b678..04eea7c6 100644 --- a/src/Pseudo/EZFIO.cfg +++ b/src/Pseudo/EZFIO.cfg @@ -86,4 +86,16 @@ doc: QMC grid interface: ezfio size: (ao_basis.ao_num,-pseudo.pseudo_lmax:pseudo.pseudo_lmax,0:pseudo.pseudo_lmax,nuclei.nucl_num,pseudo.pseudo_grid_size) +[disk_access_pseudo_local_integrals] +type: Disk_access +doc: Read/Write the local ntegrals from/to disk [ Write | Read | None ] +interface: ezfio,provider,ocaml +default: None + +[disk_access_pseudo_no_local_integrals] +type: Disk_access +doc: Read/Write the no-local ntegrals from/to disk [ Write | Read | None ] +interface: ezfio,provider,ocaml +default: None + diff --git a/src/Utils/README.rst b/src/Utils/README.rst index 03ec80f5..902a5250 100644 --- a/src/Utils/README.rst +++ b/src/Utils/README.rst @@ -28,11 +28,11 @@ Documentation Compute 1st dimension such that it is aligned for vectorization. -`apply_rotation `_ +`apply_rotation `_ Apply the rotation found by find_rotation -`approx_dble `_ +`approx_dble `_ Undocumented @@ -55,19 +55,19 @@ Documentation Binomial coefficients -`dble_fact `_ +`dble_fact `_ Undocumented -`dble_fact_even `_ +`dble_fact_even `_ n!! -`dble_fact_odd `_ +`dble_fact_odd `_ n!! -`dble_logfact `_ +`dble_logfact `_ n!! @@ -93,6 +93,10 @@ Documentation contains the new order of the elements. +`dtranspose `_ + Transpose input matrix A into output matrix B + + `erf0 `_ Undocumented @@ -106,11 +110,11 @@ Documentation n! -`fact_inv `_ +`fact_inv `_ 1/n! -`find_rotation `_ +`find_rotation `_ Find A.C = B @@ -136,7 +140,7 @@ Documentation Undocumented -`get_pseudo_inverse `_ +`get_pseudo_inverse `_ Find C = A^-1 @@ -372,7 +376,7 @@ Documentation to be in integer*8 format -`inv_int `_ +`inv_int `_ 1/i @@ -408,7 +412,7 @@ Documentation contains the new order of the elements. -`lapack_diag `_ +`lapack_diag `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -419,7 +423,7 @@ Documentation .br -`lapack_diag_s2 `_ +`lapack_diag_s2 `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -430,7 +434,7 @@ Documentation .br -`lapack_diagd `_ +`lapack_diagd `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -441,7 +445,7 @@ Documentation .br -`lapack_partial_diag `_ +`lapack_partial_diag `_ Diagonalize matrix H .br H is untouched between input and ouptut @@ -452,25 +456,33 @@ Documentation .br -`logfact `_ +`logfact `_ n! -`lowercase `_ +`lowercase `_ Transform to lower case +`map_load_from_disk `_ + Undocumented + + +`map_save_to_disk `_ + Undocumented + + `multiply_poly `_ Multiply two polynomials D(t) =! D(t) +( B(t)*C(t)) -`normalize `_ +`normalize `_ Normalizes vector u u is expected to be aligned in memory. -`nproc `_ +`nproc `_ Number of current OpenMP threads @@ -492,7 +504,7 @@ Documentation .br -`ortho_lowdin `_ +`ortho_lowdin `_ Compute C_new=C_old.S^-1/2 orthogonalization. .br overlap : overlap matrix @@ -510,6 +522,19 @@ Documentation .br +`ortho_qr `_ + Orthogonalization using Q.R factorization + .br + A : matrix to orthogonalize + .br + LDA : leftmost dimension of A + .br + n : Number of rows of A + .br + m : Number of columns of A + .br + + `overlap_a_b_c `_ Undocumented @@ -607,7 +632,7 @@ Documentation to be in integer*8 format -`set_zero_extra_diag `_ +`set_zero_extra_diag `_ Undocumented @@ -634,18 +659,22 @@ Documentation .br -`u_dot_u `_ +`transpose `_ + Transpose input matrix A into output matrix B + + +`u_dot_u `_ Compute -`u_dot_v `_ +`u_dot_v `_ Compute -`wall_time `_ +`wall_time `_ The equivalent of cpu_time, but for the wall time. -`write_git_log `_ +`write_git_log `_ Write the last git commit in file iunit. diff --git a/src/Utils/sort.irp.f b/src/Utils/sort.irp.f index b0decc33..dd7fbc33 100644 --- a/src/Utils/sort.irp.f +++ b/src/Utils/sort.irp.f @@ -156,7 +156,7 @@ BEGIN_TEMPLATE iorder(i) = i0 enddo - end subroutine heap_$Xsort$big + end subroutine heap_$Xsort_big subroutine $Xsort(x,iorder,isize) implicit none @@ -248,7 +248,7 @@ BEGIN_TEMPLATE iorder(j+1_8) = i0 enddo - end subroutine insertion_$Xsort + end subroutine insertion_$Xsort_big subroutine $Xset_order_big(x,iorder,isize) implicit none diff --git a/src/ZMQ/README.rst b/src/ZMQ/README.rst index 187af23e..b73dc42d 100644 --- a/src/ZMQ/README.rst +++ b/src/ZMQ/README.rst @@ -21,59 +21,67 @@ Documentation .. by the `update_README.py` script. -`add_task_to_taskserver `_ +`add_task_to_taskserver `_ Get a task from the task server -`connect_to_taskserver `_ +`connect_to_taskserver `_ Connect to the task server and obtain the worker ID -`disconnect_from_taskserver `_ +`disconnect_from_taskserver `_ Disconnect from the task server -`end_parallel_job `_ +`end_parallel_job `_ End a new parallel job with name 'name'. The slave tasks execute subroutine 'slave' -`end_zmq_pair_socket `_ +`end_zmq_pair_socket `_ Terminate socket on which the results are sent. -`end_zmq_pull_socket `_ +`end_zmq_pull_socket `_ Terminate socket on which the results are sent. -`end_zmq_push_socket `_ +`end_zmq_push_socket `_ Terminate socket on which the results are sent. -`end_zmq_to_qp_run_socket `_ +`end_zmq_sub_socket `_ + Terminate socket on which the results are sent. + + +`end_zmq_to_qp_run_socket `_ Terminate the socket from the application to qp_run -`get_task_from_taskserver `_ +`get_task_from_taskserver `_ Get a task from the task server -`new_parallel_job `_ +`new_parallel_job `_ Start a new parallel job with name 'name'. The slave tasks execute subroutine 'slave' -`new_zmq_pair_socket `_ +`new_zmq_pair_socket `_ Socket on which the collector and the main communicate -`new_zmq_pull_socket `_ +`new_zmq_pull_socket `_ Socket on which the results are sent. If thread is 1, use inproc -`new_zmq_push_socket `_ +`new_zmq_push_socket `_ Socket on which the results are sent. If thread is 1, use inproc -`new_zmq_to_qp_run_socket `_ +`new_zmq_sub_socket `_ + Socket to read the state published by the Task server + + +`new_zmq_to_qp_run_socket `_ Socket on which the qp_run process replies @@ -82,29 +90,41 @@ Documentation Example : tcp://130.120.229.139:12345 -`reset_zmq_addresses `_ - Undocumented +`reset_zmq_addresses `_ + Socket which pulls the results (2) -`switch_qp_run_to_master `_ +`switch_qp_run_to_master `_ Address of the master qp_run socket Example : tcp://130.120.229.139:12345 -`task_done_to_taskserver `_ +`task_done_to_taskserver `_ Get a task from the task server +`wait_for_next_state `_ + Undocumented + + +`wait_for_state `_ + Wait for the ZMQ state to be ready + + +`wait_for_states `_ + Wait for the ZMQ state to be ready + + `zmq_context `_ Context for the ZeroMQ library -`zmq_delete_task `_ +`zmq_delete_task `_ When a task is done, it has to be removed from the list of tasks on the qp_run queue. This guarantees that the results have been received in the pull. -`zmq_port `_ +`zmq_port `_ Return the value of the ZMQ port from the corresponding integer @@ -113,6 +133,10 @@ Documentation Example : tcp://130.120.229.139:12345 +`zmq_set_running `_ + Set the job to Running in QP-run + + `zmq_socket_pair_inproc_address `_ Socket which pulls the results (2) @@ -133,6 +157,10 @@ Documentation Socket which pulls the results (2) -`zmq_state `_ +`zmq_socket_sub_tcp_address `_ + Socket which pulls the results (2) + + +`zmq_state `_ Threads executing work through the ZeroMQ interface diff --git a/src/ZMQ/tree_dependency.png b/src/ZMQ/tree_dependency.png new file mode 100644 index 00000000..e69de29b diff --git a/tests/bats/cassd.bats b/tests/bats/cassd.bats index f43ffaaa..2a8fabc2 100644 --- a/tests/bats/cassd.bats +++ b/tests/bats/cassd.bats @@ -13,7 +13,7 @@ source $QP_ROOT/tests/bats/common.bats.sh qp_set_mo_class $INPUT -core "[1]" -inact "[2,5]" -act "[3,4,6,7]" -virt "[8-24]" qp_run cassd_zmq $INPUT energy="$(ezfio get cas_sd_zmq energy_pt2)" - eq $energy -76.23109 2.E-5 + eq $energy -76.231084536315 5.E-5 ezfio set determinants n_det_max 2048 ezfio set determinants read_wf True @@ -21,6 +21,6 @@ source $QP_ROOT/tests/bats/common.bats.sh qp_run cassd_zmq $INPUT ezfio set determinants read_wf False energy="$(ezfio get cas_sd_zmq energy)" - eq $energy -76.2300888408526 2.E-5 + eq $energy -76.2300887947446 2.E-5 } diff --git a/tests/bats/mrcepa0.bats b/tests/bats/mrcepa0.bats index ed69681f..dc9e0bb4 100644 --- a/tests/bats/mrcepa0.bats +++ b/tests/bats/mrcepa0.bats @@ -16,7 +16,7 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set mrcepa0 n_it_max_dressed_ci 3 qp_run $EXE $INPUT energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.238562120457431 1.e-4 + eq $energy -76.23752746236 1.e-4 } @test "MRCC H2O cc-pVDZ" { @@ -28,12 +28,11 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set determinants threshold_generators 1. ezfio set determinants threshold_selectors 1. ezfio set determinants read_wf True - ezfio set determinants read_wf True ezfio set mrcepa0 lambda_type 0 ezfio set mrcepa0 n_it_max_dressed_ci 3 qp_run $EXE $INPUT energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.238527498388962 1.e-4 + eq $energy -76.237469267705 2.e-4 } @test "MRSC2 H2O cc-pVDZ" { @@ -45,11 +44,11 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set determinants threshold_generators 1. ezfio set determinants threshold_selectors 1. ezfio set determinants read_wf True - ezfio set mrcepa0 lambda_type 0 + ezfio set mrcepa0 lambda_type 1 ezfio set mrcepa0 n_it_max_dressed_ci 3 qp_run $EXE $INPUT energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.235833732594187 1.e-4 + eq $energy -76.2347764009137 2.e-4 } @test "MRCEPA0 H2O cc-pVDZ" { @@ -61,10 +60,10 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set determinants threshold_generators 1. ezfio set determinants threshold_selectors 1. ezfio set determinants read_wf True - ezfio set mrcepa0 lambda_type 0 + ezfio set mrcepa0 lambda_type 1 ezfio set mrcepa0 n_it_max_dressed_ci 3 qp_run $EXE $INPUT energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.2418799284763 1.e-4 + eq $energy -76.2406942855164 2.e-4 } diff --git a/tests/bats/pseudo.bats b/tests/bats/pseudo.bats index a20b0842..4b374d76 100644 --- a/tests/bats/pseudo.bats +++ b/tests/bats/pseudo.bats @@ -48,6 +48,6 @@ function run_FCI_ZMQ() { @test "FCI H2O VDZ pseudo" { qp_set_mo_class h2o_pseudo.ezfio -core "[1]" -act "[2-12]" -del "[13-23]" - run_FCI_ZMQ h2o_pseudo.ezfio 2000 -0.170399597228904E+02 -0.170400168816800E+02 + run_FCI_ZMQ h2o_pseudo.ezfio 2000 -17.0399584106077 -17.0400170044515 } diff --git a/tests/input/h2o.xyz b/tests/input/h2o.xyz index e8cd039b..99268e5d 100644 --- a/tests/input/h2o.xyz +++ b/tests/input/h2o.xyz @@ -1,6 +1,6 @@ 3 XYZ file: coordinates in Angstrom -H 0.7510000000 0.1940000000 0.0000000000 O 0.0000000000 -0.3880000000 0.0000000000 +H 0.7510000000 0.1940000000 0.0000000000 H -0.7510000000 0.1940000000 0.0000000000 diff --git a/tests/run_tests.sh b/tests/run_tests.sh index 9e560d38..3ac452ad 100755 --- a/tests/run_tests.sh +++ b/tests/run_tests.sh @@ -1,19 +1,17 @@ -#!/bin/bash +#!/bin/bash -e LIST=" - convert.bats hf.bats -foboci.bats pseudo.bats fci.bats cassd.bats mrcepa0.bats - " +#foboci.bats -export QP_PREFIX="timeout -s 9 300" +export QP_PREFIX="timeout -s 9 600" #export QP_TASK_DEBUG=1 rm -rf work output @@ -30,10 +28,9 @@ do if [[ "$1" == "-v" ]] then echo "Verbose mode" - ./bats_to_sh.py $BATS_FILE | bash + ./bats_to_sh.py $BATS_FILE | bash else bats $BATS_FILE fi done -