diff --git a/bin/qp_convert_output_to_ezfio b/bin/qp_convert_output_to_ezfio index 091423e4..0523b6a7 100755 --- a/bin/qp_convert_output_to_ezfio +++ b/bin/qp_convert_output_to_ezfio @@ -256,6 +256,7 @@ def write_ezfio(res, filename): MoTag = res.determinants_mo_type ezfio.set_mo_basis_mo_label('Orthonormalized') + ezfio.set_determinants_mo_label('Orthonormalized') MO_type = MoTag allMOs = res.mo_sets[MO_type] diff --git a/bin/zcat b/bin/zcat index 715d4842..7ccecf07 100755 --- a/bin/zcat +++ b/bin/zcat @@ -16,7 +16,8 @@ with gzip.open("$1", "rt") as f: EOF fi else - command=$(which -a zcat | grep -v 'qp2/bin/' | head -1) + SCRIPTPATH="$( cd -- "$(dirname "$0")" >/dev/null 2>&1 ; pwd -P )" + command=$(which -a zcat | grep -v "$SCRIPTPATH/" | head -1) exec $command $@ fi diff --git a/configure b/configure index 7fd73839..e211cfd7 100755 --- a/configure +++ b/configure @@ -195,7 +195,7 @@ if [[ "${PACKAGES}.x" != ".x" ]] ; then fi if [[ ${PACKAGES} = all ]] ; then - PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats trexio qmckl" + PACKAGES="zlib ninja zeromq f77zmq gmp ocaml docopt resultsFile bats trexio" fi @@ -402,11 +402,11 @@ if [[ ${TREXIO} = $(not_found) ]] ; then fail fi -QMCKL=$(find_lib -lqmckl) -if [[ ${QMCKL} = $(not_found) ]] ; then - error "QMCkl (qmckl | qmckl-intel) is not installed." - fail -fi +#QMCKL=$(find_lib -lqmckl) +#if [[ ${QMCKL} = $(not_found) ]] ; then +# error "QMCkl (qmckl | qmckl-intel) is not installed." +# fail +#fi F77ZMQ=$(find_lib -lzmq -lf77zmq -lpthread) if [[ ${F77ZMQ} = $(not_found) ]] ; then diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index fb0aef7f..0cc47f63 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -13,6 +13,7 @@ module Determinants_by_hand : sig psi_coef : Det_coef.t array; psi_det : Determinant.t array; state_average_weight : Positive_float.t array; + mo_label : MO_label.t; } [@@deriving sexp] val read : ?full:bool -> unit -> t option val write : ?force:bool -> t -> unit @@ -34,11 +35,21 @@ end = struct psi_coef : Det_coef.t array; psi_det : Determinant.t array; state_average_weight : Positive_float.t array; + mo_label : MO_label.t; } [@@deriving sexp] ;; let get_default = Qpackage.get_ezfio_default "determinants";; + let read_mo_label () = + if not (Ezfio.has_determinants_mo_label ()) then + if Ezfio.has_mo_basis_mo_label () then ( + let label = Ezfio.get_mo_basis_mo_label () in + Ezfio.set_determinants_mo_label label) ; + Ezfio.get_determinants_mo_label () + |> MO_label.of_string + ;; + let read_n_int () = if not (Ezfio.has_determinants_n_int()) then Ezfio.get_mo_basis_mo_num () @@ -222,7 +233,7 @@ end = struct and n_states = States_number.to_int n_states in - let r = + let r = Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c in Ezfio.set_determinants_psi_coef r; @@ -283,19 +294,23 @@ end = struct |> Array.concat |> Array.to_list in - let r = + let r = Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| N_int_number.to_int n_int ; 2 ; Det_number.to_int n_det |] ~data:data in Ezfio.set_determinants_psi_det r; Ezfio.set_determinants_psi_det_qp_edit r ;; + let write_mo_label a = + MO_label.to_string a + |> Ezfio.set_determinants_mo_label + let read ?(full=true) () = let n_det_qp_edit = read_n_det_qp_edit () in let n_det = read_n_det () in - let read_only = + let read_only = if full then false else n_det_qp_edit <> n_det in @@ -311,6 +326,7 @@ end = struct psi_det = read_psi_det ~read_only () ; n_states = read_n_states () ; state_average_weight = read_state_average_weight () ; + mo_label = read_mo_label () ; } with _ -> None else @@ -328,6 +344,7 @@ end = struct psi_det ; n_states ; state_average_weight ; + mo_label ; } = write_n_int n_int ; write_bit_kind bit_kind; @@ -340,7 +357,9 @@ end = struct write_psi_coef ~n_det:n_det ~n_states:n_states psi_coef ; write_psi_det ~n_int:n_int ~n_det:n_det psi_det end; - write_state_average_weight state_average_weight + write_state_average_weight state_average_weight ; + write_mo_label mo_label ; + () ;; @@ -439,7 +458,7 @@ psi_det = %s in (* Split into header and determinants data *) - let idx = + let idx = match String_ext.substr_index r ~pos:0 ~pattern:"\nDeterminants" with | Some x -> x | None -> assert false @@ -545,6 +564,8 @@ psi_det = %s let bitkind = Printf.sprintf "(bit_kind %d)" (Lazy.force Qpackage.bit_kind |> Bit_kind.to_int) + and mo_label = + Printf.sprintf "(mo_label %s)" (MO_label.to_string @@ read_mo_label ()) and n_int = Printf.sprintf "(n_int %d)" (N_int_number.get_max ()) and n_states = @@ -553,7 +574,7 @@ psi_det = %s Printf.sprintf "(n_det_qp_edit %d)" (Det_number.to_int @@ read_n_det_qp_edit ()) in let s = - String.concat "" [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ] + String.concat "" [ header ; mo_label ; bitkind ; n_int ; n_states ; psi_coef ; psi_det ; n_det_qp_edit ] in diff --git a/ocaml/qptypes_generator.ml b/ocaml/qptypes_generator.ml index a5ac22f2..32506650 100644 --- a/ocaml/qptypes_generator.ml +++ b/ocaml/qptypes_generator.ml @@ -154,8 +154,8 @@ let input_ezfio = " * N_int_number : int determinants_n_int - 1 : 30 - N_int > 30 + 1 : 128 + N_int > 128 * Det_number : int determinants_n_det diff --git a/plugins/.gitignore b/plugins/.gitignore index 241e560d..8b137891 100644 --- a/plugins/.gitignore +++ b/plugins/.gitignore @@ -1,2 +1 @@ -* diff --git a/src/ao_many_one_e_ints/NEED b/plugins/local/ao_many_one_e_ints/NEED similarity index 88% rename from src/ao_many_one_e_ints/NEED rename to plugins/local/ao_many_one_e_ints/NEED index c57219cd..6e16c74a 100644 --- a/src/ao_many_one_e_ints/NEED +++ b/plugins/local/ao_many_one_e_ints/NEED @@ -4,3 +4,4 @@ becke_numerical_grid mo_one_e_ints dft_utils_in_r tc_keywords +hamiltonian diff --git a/src/ao_many_one_e_ints/README.rst b/plugins/local/ao_many_one_e_ints/README.rst similarity index 100% rename from src/ao_many_one_e_ints/README.rst rename to plugins/local/ao_many_one_e_ints/README.rst diff --git a/src/ao_many_one_e_ints/ao_erf_gauss.irp.f b/plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f similarity index 98% rename from src/ao_many_one_e_ints/ao_erf_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f index 823536cc..46124c44 100644 --- a/src/ao_many_one_e_ints/ao_erf_gauss.irp.f +++ b/plugins/local/ao_many_one_e_ints/ao_erf_gauss.irp.f @@ -98,7 +98,7 @@ double precision function phi_j_erf_mu_r_phi(i, j, mu_in, C_center) enddo enddo -end function phi_j_erf_mu_r_phi +end ! --- @@ -201,7 +201,7 @@ subroutine erf_mu_gauss_ij_ao(i, j, mu, C_center, delta, gauss_ints) enddo enddo -end subroutine erf_mu_gauss_ij_ao +end ! --- @@ -266,7 +266,7 @@ subroutine NAI_pol_x_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints) enddo enddo -end subroutine NAI_pol_x_mult_erf_ao +end ! --- @@ -340,7 +340,7 @@ subroutine NAI_pol_x_mult_erf_ao_v0(i_ao, j_ao, mu_in, C_center, LD_C, ints, LD_ deallocate(integral) -end subroutine NAI_pol_x_mult_erf_ao_v0 +end ! --- @@ -420,7 +420,7 @@ subroutine NAI_pol_x_mult_erf_ao_v(i_ao, j_ao, mu_in, C_center, LD_C, ints, LD_i deallocate(integral) -end subroutine NAI_pol_x_mult_erf_ao_v +end ! --- @@ -479,7 +479,7 @@ double precision function NAI_pol_x_mult_erf_ao_x(i_ao, j_ao, mu_in, C_center) enddo enddo -end function NAI_pol_x_mult_erf_ao_x +end ! --- @@ -538,7 +538,7 @@ double precision function NAI_pol_x_mult_erf_ao_y(i_ao, j_ao, mu_in, C_center) enddo enddo -end function NAI_pol_x_mult_erf_ao_y +end ! --- @@ -597,7 +597,7 @@ double precision function NAI_pol_x_mult_erf_ao_z(i_ao, j_ao, mu_in, C_center) enddo enddo -end function NAI_pol_x_mult_erf_ao_z +end ! --- @@ -667,7 +667,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_x(i_ao, j_ao, beta, B_cen enddo enddo -end function NAI_pol_x_mult_erf_ao_with1s_x +end ! --- @@ -737,7 +737,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_y(i_ao, j_ao, beta, B_cen enddo enddo -end function NAI_pol_x_mult_erf_ao_with1s_y +end ! --- @@ -807,7 +807,7 @@ double precision function NAI_pol_x_mult_erf_ao_with1s_z(i_ao, j_ao, beta, B_cen enddo enddo -end function NAI_pol_x_mult_erf_ao_with1s_z +end ! --- @@ -880,7 +880,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_cen enddo enddo -end subroutine NAI_pol_x_mult_erf_ao_with1s +end ! --- @@ -967,7 +967,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s_v0(i_ao, j_ao, beta, B_center, LD_B, mu_ deallocate(integral) -end subroutine NAI_pol_x_mult_erf_ao_with1s_v0 +end ! --- @@ -1057,7 +1057,7 @@ subroutine NAI_pol_x_mult_erf_ao_with1s_v(i_ao, j_ao, beta, B_center, LD_B, mu_i deallocate(integral) -end subroutine NAI_pol_x_mult_erf_ao_with1s_v +end ! --- @@ -1175,7 +1175,7 @@ subroutine NAI_pol_x2_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_ce enddo enddo -end subroutine NAI_pol_x2_mult_erf_ao_with1s +end ! --- @@ -1241,7 +1241,7 @@ subroutine NAI_pol_x2_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints) enddo enddo -end subroutine NAI_pol_x2_mult_erf_ao +end ! --- @@ -1320,7 +1320,7 @@ subroutine NAI_pol_012_mult_erf_ao_with1s(i_ao, j_ao, beta, B_center, mu_in, C_c enddo enddo -end subroutine NAI_pol_012_mult_erf_ao_with1s +end ! --- @@ -1328,7 +1328,7 @@ subroutine NAI_pol_012_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints) BEGIN_DOC ! - ! Computes the following integral : + ! Computes the following integrals : ! ! int(1) = $\int_{-\infty}^{infty} dr x^0 * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$. ! @@ -1395,7 +1395,7 @@ subroutine NAI_pol_012_mult_erf_ao(i_ao, j_ao, mu_in, C_center, ints) enddo enddo -end subroutine NAI_pol_012_mult_erf_ao +end ! --- diff --git a/src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f b/plugins/local/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f similarity index 100% rename from src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f rename to plugins/local/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f diff --git a/src/ao_many_one_e_ints/ao_gaus_gauss.irp.f b/plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f similarity index 83% rename from src/ao_many_one_e_ints/ao_gaus_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f index d2115d9e..1e4f340c 100644 --- a/src/ao_many_one_e_ints/ao_gaus_gauss.irp.f +++ b/plugins/local/ao_many_one_e_ints/ao_gaus_gauss.irp.f @@ -152,7 +152,7 @@ double precision function overlap_gauss_r12_ao(D_center, delta, i, j) enddo enddo -end function overlap_gauss_r12_ao +end ! -- @@ -199,7 +199,7 @@ double precision function overlap_abs_gauss_r12_ao(D_center, delta, i, j) enddo enddo -end function overlap_gauss_r12_ao +end ! -- @@ -257,7 +257,7 @@ subroutine overlap_gauss_r12_ao_v(D_center, LD_D, delta, i, j, resv, LD_resv, n_ deallocate(analytical_j) -end subroutine overlap_gauss_r12_ao_v +end ! --- @@ -327,7 +327,7 @@ double precision function overlap_gauss_r12_ao_with1s(B_center, beta, D_center, enddo enddo -end function overlap_gauss_r12_ao_with1s +end ! --- @@ -420,7 +420,86 @@ subroutine overlap_gauss_r12_ao_with1s_v(B_center, beta, D_center, LD_D, delta, deallocate(fact_g, G_center, analytical_j) -end subroutine overlap_gauss_r12_ao_with1s_v +end + +! --- + +subroutine overlap_gauss_r12_ao_012(D_center, delta, i, j, ints) + + BEGIN_DOC + ! + ! Computes the following integrals : + ! + ! ints(1) = $\int_{-\infty}^{infty} dr x^0 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! + ! ints(2) = $\int_{-\infty}^{infty} dr x^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! ints(3) = $\int_{-\infty}^{infty} dr y^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! ints(4) = $\int_{-\infty}^{infty} dr z^1 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! + ! ints(5) = $\int_{-\infty}^{infty} dr x^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! ints(6) = $\int_{-\infty}^{infty} dr y^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! ints(7) = $\int_{-\infty}^{infty} dr z^2 * \chi_i(r) \chi_j(r) e^{-\delta (r - D_center)^2} + ! + END_DOC + + include 'utils/constants.include.F' + + implicit none + + integer, intent(in) :: i, j + double precision, intent(in) :: delta, D_center(3) + double precision, intent(out) :: ints(7) + + integer :: k, l, m + integer :: power_A(3), power_B(3), power_A1(3), power_A2(3) + double precision :: A_center(3), B_center(3), alpha, beta, coef1, coef + double precision :: integral0, integral1, integral2 + + double precision, external :: overlap_gauss_r12 + + ints = 0.d0 + + if(ao_overlap_abs(j,i).lt.1.d-12) then + return + endif + + power_A(1:3) = ao_power(i,1:3) + power_B(1:3) = ao_power(j,1:3) + + A_center(1:3) = nucl_coord(ao_nucl(i),1:3) + B_center(1:3) = nucl_coord(ao_nucl(j),1:3) + + do l = 1, ao_prim_num(i) + alpha = ao_expo_ordered_transp (l,i) + coef1 = ao_coef_normalized_ordered_transp(l,i) + + do k = 1, ao_prim_num(j) + beta = ao_expo_ordered_transp(k,j) + coef = coef1 * ao_coef_normalized_ordered_transp(k,j) + + if(dabs(coef) .lt. 1d-12) cycle + + integral0 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A, power_B, alpha, beta) + + ints(1) += coef * integral0 + + do m = 1, 3 + power_A1 = power_A + power_A1(m) += 1 + integral1 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A1, power_B, alpha, beta) + ints(1+m) += coef * (integral1 + A_center(m)*integral0) + + power_A2 = power_A + power_A2(m) += 2 + integral2 = overlap_gauss_r12(D_center, delta, A_center, B_center, power_A2, power_B, alpha, beta) + ints(4+m) += coef * (integral2 + A_center(m) * (2.d0*integral1 + A_center(m)*integral0)) + enddo + + enddo ! k + enddo ! l + + return +end ! --- diff --git a/src/ao_many_one_e_ints/grad2_jmu_manu.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f similarity index 68% rename from src/ao_many_one_e_ints/grad2_jmu_manu.irp.f rename to plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f index 14170ede..5879d83f 100644 --- a/src/ao_many_one_e_ints/grad2_jmu_manu.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad2_jmu_manu.irp.f @@ -1,11 +1,11 @@ ! --- -BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2 + ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2 ! END_DOC @@ -15,30 +15,30 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n double precision :: coef, beta, B_center(3) double precision :: tmp double precision :: wall0, wall1 - double precision :: int_gauss, dsqpi_3_2, int_j1b + double precision :: int_gauss, dsqpi_3_2, int_env double precision :: factor_ij_1s, beta_ij, center_ij_1s(3), sq_pi_3_2 double precision, allocatable :: int_fit_v(:) double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing int2_grad1u2_grad2u2_j1b2_test ...' + print*, ' providing int2_grad1u2_grad2u2_env2_test ...' sq_pi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points_transp j1b_pen List_comb_thr_b3_coef + provide mu_erf final_grid_points_transp List_comb_thr_b3_coef call wall_time(wall0) - int2_grad1u2_grad2u2_j1b2_test(:,:,:) = 0.d0 + int2_grad1u2_grad2u2_env2_test(:,:,:) = 0.d0 - !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & - !$OMP coef_fit, expo_fit, int_fit_v, tmp,int_gauss,int_j1b,factor_ij_1s,beta_ij,center_ij_1s) & - !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size, & - !$OMP final_grid_points_transp, ng_fit_jast, & - !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & - !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & - !$OMP List_comb_thr_b3_cent, int2_grad1u2_grad2u2_j1b2_test, ao_abs_comb_b3_j1b, & - !$OMP ao_overlap_abs,sq_pi_3_2,thrsh_cycle_tc) + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & + !$OMP coef_fit, expo_fit, int_fit_v, tmp,int_gauss,int_env,factor_ij_1s,beta_ij,center_ij_1s) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points,List_comb_thr_b3_size, & + !$OMP final_grid_points_transp, ng_fit_jast, & + !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & + !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & + !$OMP List_comb_thr_b3_cent, int2_grad1u2_grad2u2_env2_test, ao_abs_comb_b3_env, & + !$OMP ao_overlap_abs,sq_pi_3_2,thrsh_cycle_tc) !$OMP DO SCHEDULE(dynamic) do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -54,13 +54,13 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b3_j1b(1,j,i) + int_env = ao_abs_comb_b3_env(1,j,i) do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_1_erf_x_2(i_fit) coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) -! if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle +! if(dabs(coef_fit*int_env*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle int_gauss = overlap_gauss_r12_ao(r, expo_fit, i, j) - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss + int2_grad1u2_grad2u2_env2_test(j,i,ipoint) += coef_fit * int_gauss enddo ! --- --- --- @@ -71,7 +71,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) + int_env = ao_abs_comb_b3_env(i_1s,j,i) B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -81,11 +81,11 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n !DIR$ FORCEINLINE call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s) coef_fit = -0.25d0 * coef_gauss_1_erf_x_2(i_fit) * coef -! if(dabs(coef_fit*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle +! if(dabs(coef_fit*factor_ij_1s*int_env*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle ! call overlap_gauss_r12_ao_with1s_v(B_center, beta, final_grid_points_transp, & ! expo_fit, i, j, int_fit_v, n_points_final_grid) int_gauss = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) += coef_fit * int_gauss + int2_grad1u2_grad2u2_env2_test(j,i,ipoint) += coef_fit * int_gauss enddo enddo @@ -98,26 +98,26 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test, (ao_num, ao_n do ipoint = 1, n_points_final_grid do i = 1, ao_num do j = 1, i-1 - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint) + int2_grad1u2_grad2u2_env2_test(j,i,ipoint) = int2_grad1u2_grad2u2_env2_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test', wall1 - wall0 + print*, ' wall time for int2_grad1u2_grad2u2_env2_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao_num, n_points_final_grid)] -! -! BEGIN_DOC -! ! -! ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2 -! ! -! END_DOC -! +BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2_test_v, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2 + ! + END_DOC + implicit none integer :: i, j, ipoint, i_1s, i_fit double precision :: r(3), expo_fit, coef_fit @@ -128,24 +128,24 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao double precision, allocatable :: int_fit_v(:),big_array(:,:,:) double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing int2_grad1u2_grad2u2_j1b2_test_v ...' + print*, ' providing int2_grad1u2_grad2u2_env2_test_v ...' - provide mu_erf final_grid_points_transp j1b_pen + provide mu_erf final_grid_points_transp call wall_time(wall0) - double precision :: int_j1b + double precision :: int_env big_array(:,:,:) = 0.d0 allocate(big_array(n_points_final_grid,ao_num, ao_num)) !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,& - !$OMP coef_fit, expo_fit, int_fit_v, tmp,int_j1b) & - !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size,& - !$OMP final_grid_points_transp, ng_fit_jast, & - !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & - !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & - !$OMP List_comb_thr_b3_cent, big_array,& - !$OMP ao_abs_comb_b3_j1b,ao_overlap_abs,thrsh_cycle_tc) -! + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,& + !$OMP coef_fit, expo_fit, int_fit_v, tmp,int_env) & + !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size,& + !$OMP final_grid_points_transp, ng_fit_jast, & + !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & + !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & + !$OMP List_comb_thr_b3_cent, big_array,& + !$OMP ao_abs_comb_b3_env,ao_overlap_abs,thrsh_cycle_tc) + ! allocate(int_fit_v(n_points_final_grid)) !$OMP DO SCHEDULE(dynamic) do i = 1, ao_num @@ -159,7 +159,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) + int_env = ao_abs_comb_b3_env(i_1s,j,i) B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -187,7 +187,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao do i = 1, ao_num do j = i, ao_num do ipoint = 1, n_points_final_grid - int2_grad1u2_grad2u2_j1b2_test_v(j,i,ipoint) = big_array(ipoint,j,i) + int2_grad1u2_grad2u2_env2_test_v(j,i,ipoint) = big_array(ipoint,j,i) enddo enddo enddo @@ -195,23 +195,23 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2_test_v, (ao_num, ao do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_grad1u2_grad2u2_j1b2_test_v(j,i,ipoint) = big_array(ipoint,i,j) + int2_grad1u2_grad2u2_env2_test_v(j,i,ipoint) = big_array(ipoint,i,j) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_grad1u2_grad2u2_j1b2_test_v', wall1 - wall0 + print*, ' wall time for int2_grad1u2_grad2u2_env2_test_v (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_u2_env2_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2 + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [u_12^mu]^2 ! END_DOC @@ -219,29 +219,29 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ integer :: i, j, ipoint, i_1s, i_fit double precision :: r(3), int_fit, expo_fit, coef_fit double precision :: coef, beta, B_center(3), tmp - double precision :: wall0, wall1,int_j1b + double precision :: wall0, wall1,int_env double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s double precision :: factor_ij_1s,beta_ij,center_ij_1s(3),sq_pi_3_2 - print*, ' providing int2_u2_j1b2_test ...' + print*, ' providing int2_u2_env2_test ...' sq_pi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf final_grid_points call wall_time(wall0) - int2_u2_j1b2_test = 0.d0 + int2_u2_env2_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & - !$OMP coef_fit, expo_fit, int_fit, tmp, int_j1b,factor_ij_1s,beta_ij,center_ij_1s) & + !$OMP coef_fit, expo_fit, int_fit, tmp, int_env,factor_ij_1s,beta_ij,center_ij_1s) & !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, & !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo,sq_pi_3_2, & - !$OMP List_comb_thr_b3_cent, int2_u2_j1b2_test,ao_abs_comb_b3_j1b,thrsh_cycle_tc) + !$OMP List_comb_thr_b3_cent, int2_u2_env2_test,ao_abs_comb_b3_env,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -257,12 +257,12 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b3_j1b(1,j,i) - if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle + int_env = ao_abs_comb_b3_env(1,j,i) + if(dabs(int_env).lt.thrsh_cycle_tc) cycle do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_j_mu_x_2(i_fit) coef_fit = coef_gauss_j_mu_x_2(i_fit) -! if(dabs(coef_fit*int_j1b*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle +! if(dabs(coef_fit*int_env*sq_pi_3_2*(expo_fit)**(-1.5d0)).lt.thrsh_cycle_tc)cycle int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j) tmp += coef_fit * int_fit enddo @@ -275,8 +275,8 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b3_env(i_1s,j,i) +! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -286,13 +286,13 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ coef_fit = coef_gauss_j_mu_x_2(i_fit) !DIR$ FORCEINLINE call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s) -! if(dabs(coef_fit*coef*factor_ij_1s*int_j1b*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle +! if(dabs(coef_fit*coef*factor_ij_1s*int_env*sq_pi_3_2*(beta_ij)**(-1.5d0)).lt.thrsh_cycle_tc)cycle int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) tmp += coef * coef_fit * int_fit enddo enddo - int2_u2_j1b2_test(j,i,ipoint) = tmp + int2_u2_env2_test(j,i,ipoint) = tmp enddo enddo enddo @@ -302,23 +302,23 @@ BEGIN_PROVIDER [ double precision, int2_u2_j1b2_test, (ao_num, ao_num, n_points_ do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u2_j1b2_test(j,i,ipoint) = int2_u2_j1b2_test(i,j,ipoint) + int2_u2_env2_test(j,i,ipoint) = int2_u2_env2_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u2_j1b2_test', wall1 - wall0 + print*, ' wall time for int2_u2_env2_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2_test, (ao_num,ao_num,n_points_final_grid,3)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 ! END_DOC @@ -327,27 +327,27 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n double precision :: r(3), int_fit(3), expo_fit, coef_fit double precision :: coef, beta, B_center(3), dist double precision :: alpha_1s, alpha_1s_inv, centr_1s(3), expo_coef_1s, coef_tmp - double precision :: tmp_x, tmp_y, tmp_z, int_j1b + double precision :: tmp_x, tmp_y, tmp_z, int_env double precision :: wall0, wall1, sq_pi_3_2,sq_alpha - print*, ' providing int2_u_grad1u_x_j1b2_test ...' + print*, ' providing int2_u_grad1u_x_env2_test ...' sq_pi_3_2 = dacos(-1.D0)**(1.d0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf final_grid_points call wall_time(wall0) - int2_u_grad1u_x_j1b2_test = 0.d0 + int2_u_grad1u_x_env2_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, alpha_1s, dist, & !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, & - !$OMP tmp_x, tmp_y, tmp_z,int_j1b,sq_alpha) & + !$OMP tmp_x, tmp_y, tmp_z,int_env,sq_alpha) & !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, & - !$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_j1b2_test,ao_abs_comb_b3_j1b,sq_pi_3_2,thrsh_cycle_tc) + !$OMP List_comb_thr_b3_cent, int2_u_grad1u_x_env2_test,ao_abs_comb_b3_env,sq_pi_3_2,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid @@ -365,8 +365,8 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) - if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b3_env(i_1s,j,i) + if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -389,7 +389,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n expo_coef_1s = beta * expo_fit * alpha_1s_inv * dist coef_tmp = coef * coef_fit * dexp(-expo_coef_1s) sq_alpha = alpha_1s_inv * dsqrt(alpha_1s_inv) -! if(dabs(coef_tmp*int_j1b*sq_pi_3_2*sq_alpha) .lt. thrsh_cycle_tc) cycle +! if(dabs(coef_tmp*int_env*sq_pi_3_2*sq_alpha) .lt. thrsh_cycle_tc) cycle call NAI_pol_x_mult_erf_ao_with1s(i, j, alpha_1s, centr_1s, 1.d+9, r, int_fit) @@ -402,9 +402,9 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n enddo - int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = tmp_x - int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = tmp_y - int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = tmp_z + int2_u_grad1u_x_env2_test(j,i,ipoint,1) = tmp_x + int2_u_grad1u_x_env2_test(j,i,ipoint,2) = tmp_y + int2_u_grad1u_x_env2_test(j,i,ipoint,3) = tmp_z enddo enddo enddo @@ -414,24 +414,25 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2_test, (ao_num, ao_num, n do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u_grad1u_x_j1b2_test(j,i,ipoint,1) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,1) - int2_u_grad1u_x_j1b2_test(j,i,ipoint,2) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,2) - int2_u_grad1u_x_j1b2_test(j,i,ipoint,3) = int2_u_grad1u_x_j1b2_test(i,j,ipoint,3) + int2_u_grad1u_x_env2_test(j,i,ipoint,1) = int2_u_grad1u_x_env2_test(i,j,ipoint,1) + int2_u_grad1u_x_env2_test(j,i,ipoint,2) = int2_u_grad1u_x_env2_test(i,j,ipoint,2) + int2_u_grad1u_x_env2_test(j,i,ipoint,3) = int2_u_grad1u_x_env2_test(i,j,ipoint,3) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u_grad1u_x_j1b2_test', wall1 - wall0 + print*, ' wall time for int2_u_grad1u_x_env2_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER +! --- -BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_u_grad1u_env2_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] ! END_DOC @@ -442,31 +443,31 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p double precision :: alpha_1s, alpha_1s_inv, centr_1s(3), expo_coef_1s, tmp double precision :: wall0, wall1 double precision, external :: NAI_pol_mult_erf_ao_with1s - double precision :: j12_mu_r12,int_j1b + double precision :: j12_mu_r12,int_env double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2 double precision :: beta_ij,center_ij_1s(3),factor_ij_1s - print*, ' providing int2_u_grad1u_j1b2_test ...' + print*, ' providing int2_u_grad1u_env2_test ...' dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen ao_overlap_abs List_comb_thr_b3_cent + provide mu_erf final_grid_points ao_overlap_abs List_comb_thr_b3_cent call wall_time(wall0) - int2_u_grad1u_j1b2_test = 0.d0 + int2_u_grad1u_env2_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist, & !$OMP beta_ij,center_ij_1s,factor_ij_1s, & - !$OMP int_j1b,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) & + !$OMP int_env,alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) & !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b3_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & !$OMP ao_prod_dist_grid, ao_prod_sigma, ao_overlap_abs_grid,ao_prod_center,dsqpi_3_2, & - !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, ao_abs_comb_b3_j1b, & - !$OMP List_comb_thr_b3_cent, int2_u_grad1u_j1b2_test,thrsh_cycle_tc) + !$OMP List_comb_thr_b3_coef, List_comb_thr_b3_expo, ao_abs_comb_b3_env, & + !$OMP List_comb_thr_b3_cent, int2_u_grad1u_env2_test,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid do i = 1, ao_num @@ -484,11 +485,9 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b3_j1b(1,j,i) -! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle + int_env = ao_abs_comb_b3_env(1,j,i) do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_j_mu_1_erf(i_fit) -! if(dabs(int_j1b)*dsqpi_3_2*expo_fit**(-1.5d0).lt.thrsh_cycle_tc) cycle coef_fit = coef_gauss_j_mu_1_erf(i_fit) int_fit = NAI_pol_mult_erf_ao_with1s(i, j, expo_fit, r, 1.d+9, r) tmp += coef_fit * int_fit @@ -502,8 +501,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p coef = List_comb_thr_b3_coef (i_1s,j,i) beta = List_comb_thr_b3_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b3_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b3_env(i_1s,j,i) B_center(1) = List_comb_thr_b3_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b3_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b3_cent(3,i_1s,j,i) @@ -513,7 +511,6 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_j_mu_1_erf(i_fit) call gaussian_product(expo_fit,r,beta,B_center,factor_ij_1s,beta_ij,center_ij_1s) -! if(factor_ij_1s*dabs(coef*int_j1b)*dsqpi_3_2*beta_ij**(-1.5d0).lt.thrsh_cycle_tc)cycle coef_fit = coef_gauss_j_mu_1_erf(i_fit) alpha_1s = beta + expo_fit @@ -533,7 +530,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p enddo enddo - int2_u_grad1u_j1b2_test(j,i,ipoint) = tmp + int2_u_grad1u_env2_test(j,i,ipoint) = tmp enddo enddo enddo @@ -543,14 +540,15 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2_test, (ao_num, ao_num, n_p do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u_grad1u_j1b2_test(j,i,ipoint) = int2_u_grad1u_j1b2_test(i,j,ipoint) + int2_u_grad1u_env2_test(j,i,ipoint) = int2_u_grad1u_env2_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u_grad1u_j1b2_test', wall1 - wall0 + print*, ' wall time for int2_u_grad1u_env2_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- + diff --git a/src/ao_many_one_e_ints/grad2_jmu_modif.irp.f b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f similarity index 72% rename from src/ao_many_one_e_ints/grad2_jmu_modif.irp.f rename to plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f index fda2db82..b1fc6134 100644 --- a/src/ao_many_one_e_ints/grad2_jmu_modif.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad2_jmu_modif.irp.f @@ -21,7 +21,8 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin print*, ' providing int2_grad1u2_grad2u2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points int2_grad1u2_grad2u2 = 0.d0 @@ -63,17 +64,17 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2, (ao_num, ao_num, n_poin enddo call wall_time(wall1) - print*, ' wall time for int2_grad1u2_grad2u2 =', wall1 - wall0 + print*, ' wall time for int2_grad1u2_grad2u2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_grad1u2_grad2u2_env2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2 + ! -\frac{1}{4} x int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [1 - erf(mu r12)]^2 ! END_DOC @@ -87,21 +88,22 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing int2_grad1u2_grad2u2_j1b2 ...' + print*, ' providing int2_grad1u2_grad2u2_env2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points - int2_grad1u2_grad2u2_j1b2 = 0.d0 + int2_grad1u2_grad2u2_env2 = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, tmp) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & - !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & - !$OMP List_all_comb_b3_cent, int2_grad1u2_grad2u2_j1b2) + !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP List_env1s_square_cent, int2_grad1u2_grad2u2_env2) !$OMP DO do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -125,14 +127,14 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n ! --- - do i_1s = 2, List_all_comb_b3_size + do i_1s = 2, List_env1s_square_size - coef = List_all_comb_b3_coef (i_1s) + coef = List_env1s_square_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b3_expo (i_1s) - B_center(1) = List_all_comb_b3_cent(1,i_1s) - B_center(2) = List_all_comb_b3_cent(2,i_1s) - B_center(3) = List_all_comb_b3_cent(3,i_1s) + beta = List_env1s_square_expo (i_1s) + B_center(1) = List_env1s_square_cent(1,i_1s) + B_center(2) = List_env1s_square_cent(2,i_1s) + B_center(3) = List_env1s_square_cent(3,i_1s) int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) @@ -143,7 +145,7 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n enddo - int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = tmp + int2_grad1u2_grad2u2_env2(j,i,ipoint) = tmp enddo enddo enddo @@ -153,23 +155,23 @@ BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2(i,j,ipoint) + int2_grad1u2_grad2u2_env2(j,i,ipoint) = int2_grad1u2_grad2u2_env2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_grad1u2_grad2u2_j1b2 =', wall1 - wall0 + print*, ' wall time for int2_grad1u2_grad2u2_env2 (min) =', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, int2_u2_env2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2 + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 [u_12^mu]^2 ! END_DOC @@ -182,21 +184,22 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_ double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing int2_u2_j1b2 ...' + print*, ' providing int2_u2_env2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points - int2_u2_j1b2 = 0.d0 + int2_u2_env2 = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, tmp) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, & - !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & - !$OMP List_all_comb_b3_cent, int2_u2_j1b2) + !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP List_env1s_square_cent, int2_u2_env2) !$OMP DO do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -220,14 +223,14 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_ ! --- - do i_1s = 2, List_all_comb_b3_size + do i_1s = 2, List_env1s_square_size - coef = List_all_comb_b3_coef (i_1s) + coef = List_env1s_square_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b3_expo (i_1s) - B_center(1) = List_all_comb_b3_cent(1,i_1s) - B_center(2) = List_all_comb_b3_cent(2,i_1s) - B_center(3) = List_all_comb_b3_cent(3,i_1s) + beta = List_env1s_square_expo (i_1s) + B_center(1) = List_env1s_square_cent(1,i_1s) + B_center(2) = List_env1s_square_cent(2,i_1s) + B_center(3) = List_env1s_square_cent(3,i_1s) int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) @@ -238,7 +241,7 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_ enddo - int2_u2_j1b2(j,i,ipoint) = tmp + int2_u2_env2(j,i,ipoint) = tmp enddo enddo enddo @@ -248,23 +251,23 @@ BEGIN_PROVIDER [double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_ do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u2_j1b2(j,i,ipoint) = int2_u2_j1b2(i,j,ipoint) + int2_u2_env2(j,i,ipoint) = int2_u2_env2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u2_j1b2', wall1 - wall0 + print*, ' wall time for int2_u2_env2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, int2_u_grad1u_x_env2, (ao_num, ao_num, n_points_final_grid, 3)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 ! END_DOC @@ -276,23 +279,24 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin double precision :: tmp_x, tmp_y, tmp_z double precision :: wall0, wall1 - print*, ' providing int2_u_grad1u_x_j1b2 ...' + print*, ' providing int2_u_grad1u_x_env2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points - int2_u_grad1u_x_j1b2 = 0.d0 + int2_u_grad1u_x_env2 = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, alpha_1s, dist, & !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp, & !$OMP tmp_x, tmp_y, tmp_z) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & - !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & - !$OMP List_all_comb_b3_cent, int2_u_grad1u_x_j1b2) + !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP List_env1s_square_cent, int2_u_grad1u_x_env2) !$OMP DO do ipoint = 1, n_points_final_grid @@ -321,14 +325,14 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin ! --- - do i_1s = 2, List_all_comb_b3_size + do i_1s = 2, List_env1s_square_size - coef = List_all_comb_b3_coef (i_1s) + coef = List_env1s_square_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b3_expo (i_1s) - B_center(1) = List_all_comb_b3_cent(1,i_1s) - B_center(2) = List_all_comb_b3_cent(2,i_1s) - B_center(3) = List_all_comb_b3_cent(3,i_1s) + beta = List_env1s_square_expo (i_1s) + B_center(1) = List_env1s_square_cent(1,i_1s) + B_center(2) = List_env1s_square_cent(2,i_1s) + B_center(3) = List_env1s_square_cent(3,i_1s) dist = (B_center(1) - r(1)) * (B_center(1) - r(1)) & + (B_center(2) - r(2)) * (B_center(2) - r(2)) & + (B_center(3) - r(3)) * (B_center(3) - r(3)) @@ -355,9 +359,9 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin enddo - int2_u_grad1u_x_j1b2(j,i,ipoint,1) = tmp_x - int2_u_grad1u_x_j1b2(j,i,ipoint,2) = tmp_y - int2_u_grad1u_x_j1b2(j,i,ipoint,3) = tmp_z + int2_u_grad1u_x_env2(j,i,ipoint,1) = tmp_x + int2_u_grad1u_x_env2(j,i,ipoint,2) = tmp_y + int2_u_grad1u_x_env2(j,i,ipoint,3) = tmp_z enddo enddo enddo @@ -367,25 +371,25 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_poin do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u_grad1u_x_j1b2(j,i,ipoint,1) = int2_u_grad1u_x_j1b2(i,j,ipoint,1) - int2_u_grad1u_x_j1b2(j,i,ipoint,2) = int2_u_grad1u_x_j1b2(i,j,ipoint,2) - int2_u_grad1u_x_j1b2(j,i,ipoint,3) = int2_u_grad1u_x_j1b2(i,j,ipoint,3) + int2_u_grad1u_x_env2(j,i,ipoint,1) = int2_u_grad1u_x_env2(i,j,ipoint,1) + int2_u_grad1u_x_env2(j,i,ipoint,2) = int2_u_grad1u_x_env2(i,j,ipoint,2) + int2_u_grad1u_x_env2(j,i,ipoint,3) = int2_u_grad1u_x_env2(i,j,ipoint,3) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u_grad1u_x_j1b2 = ', wall1 - wall0 + print*, ' wall time for int2_u_grad1u_x_env2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [ double precision, int2_u_grad1u_env2, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2)^2 u_12^mu [\grad_1 u_12^mu] ! END_DOC @@ -397,22 +401,23 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points double precision :: wall0, wall1 double precision, external :: NAI_pol_mult_erf_ao_with1s - print*, ' providing int2_u_grad1u_j1b2 ...' + print*, ' providing int2_u_grad1u_env2 ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf + provide final_grid_points - int2_u_grad1u_j1b2 = 0.d0 + int2_u_grad1u_env2 = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, tmp, alpha_1s, dist, & !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, coef_tmp) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_square_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & - !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & - !$OMP List_all_comb_b3_cent, int2_u_grad1u_j1b2) + !$OMP List_env1s_square_coef, List_env1s_square_expo, & + !$OMP List_env1s_square_cent, int2_u_grad1u_env2) !$OMP DO do ipoint = 1, n_points_final_grid do i = 1, ao_num @@ -436,14 +441,14 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points ! --- - do i_1s = 2, List_all_comb_b3_size + do i_1s = 2, List_env1s_square_size - coef = List_all_comb_b3_coef (i_1s) + coef = List_env1s_square_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b3_expo (i_1s) - B_center(1) = List_all_comb_b3_cent(1,i_1s) - B_center(2) = List_all_comb_b3_cent(2,i_1s) - B_center(3) = List_all_comb_b3_cent(3,i_1s) + beta = List_env1s_square_expo (i_1s) + B_center(1) = List_env1s_square_cent(1,i_1s) + B_center(2) = List_env1s_square_cent(2,i_1s) + B_center(3) = List_env1s_square_cent(3,i_1s) dist = (B_center(1) - r(1)) * (B_center(1) - r(1)) & + (B_center(2) - r(2)) * (B_center(2) - r(2)) & + (B_center(3) - r(3)) * (B_center(3) - r(3)) @@ -468,7 +473,7 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points enddo - int2_u_grad1u_j1b2(j,i,ipoint) = tmp + int2_u_grad1u_env2(j,i,ipoint) = tmp enddo enddo enddo @@ -478,13 +483,13 @@ BEGIN_PROVIDER [ double precision, int2_u_grad1u_j1b2, (ao_num, ao_num, n_points do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - int2_u_grad1u_j1b2(j,i,ipoint) = int2_u_grad1u_j1b2(i,j,ipoint) + int2_u_grad1u_env2(j,i,ipoint) = int2_u_grad1u_env2(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for int2_u_grad1u_j1b2', wall1 - wall0 + print*, ' wall time for int2_u_grad1u_env2 (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER diff --git a/src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f similarity index 74% rename from src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f rename to plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f index 66a2b961..6c163df6 100644 --- a/src/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_manu.irp.f @@ -1,11 +1,11 @@ ! --- -BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R| + ! int dr phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R| - 1) / |r - R| ! END_DOC @@ -13,24 +13,23 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, integer :: i, j, ipoint, i_1s double precision :: r(3), int_mu, int_coulomb double precision :: coef, beta, B_center(3) - double precision :: tmp,int_j1b + double precision :: tmp,int_env double precision :: wall0, wall1 double precision, external :: NAI_pol_mult_erf_ao_with1s double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2 - print*, ' providing v_ij_erf_rk_cst_mu_j1b_test ...' + print*, ' providing v_ij_erf_rk_cst_mu_env_test ...' dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen call wall_time(wall0) - v_ij_erf_rk_cst_mu_j1b_test = 0.d0 + v_ij_erf_rk_cst_mu_env_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp, int_j1b)& + !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp, int_env)& !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points, & - !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_j1b, & - !$OMP v_ij_erf_rk_cst_mu_j1b_test, mu_erf, & + !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent,ao_abs_comb_b2_env, & + !$OMP v_ij_erf_rk_cst_mu_env_test, mu_erf, & !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc) !$OMP DO !do ipoint = 1, 10 @@ -48,8 +47,8 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, coef = List_comb_thr_b2_coef (i_1s,j,i) beta = List_comb_thr_b2_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b2_env(i_1s,j,i) +! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i) @@ -60,7 +59,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, tmp += coef * (int_mu - int_coulomb) enddo - v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = tmp + v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) = tmp enddo enddo enddo @@ -70,22 +69,22 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint) + v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) = v_ij_erf_rk_cst_mu_env_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0 + print*, ' wall time for v_ij_erf_rk_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid, 3)] BEGIN_DOC - ! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R| + ! int dr x phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R|) - 1)/|r - R| END_DOC implicit none @@ -93,23 +92,23 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu double precision :: coef, beta, B_center(3), r(3), ints(3), ints_coulomb(3) double precision :: tmp_x, tmp_y, tmp_z double precision :: wall0, wall1 - double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2,int_j1b,factor_ij_1s,beta_ij,center_ij_1s + double precision :: sigma_ij,dist_ij_ipoint,dsqpi_3_2,int_env,factor_ij_1s,beta_ij,center_ij_1s - print*, ' providing x_v_ij_erf_rk_cst_mu_j1b_test ...' + print*, ' providing x_v_ij_erf_rk_cst_mu_env_test ...' dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) provide expo_erfc_mu_gauss ao_prod_sigma ao_prod_center call wall_time(wall0) - x_v_ij_erf_rk_cst_mu_j1b_test = 0.d0 + x_v_ij_erf_rk_cst_mu_env_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb, & - !$OMP int_j1b, tmp_x, tmp_y, tmp_z,factor_ij_1s,beta_ij,center_ij_1s) & + !$OMP int_env, tmp_x, tmp_y, tmp_z,factor_ij_1s,beta_ij,center_ij_1s) & !$OMP SHARED (n_points_final_grid, ao_num, List_comb_thr_b2_size, final_grid_points,& !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo, List_comb_thr_b2_cent, & - !$OMP x_v_ij_erf_rk_cst_mu_j1b_test, mu_erf,ao_abs_comb_b2_j1b, & + !$OMP x_v_ij_erf_rk_cst_mu_env_test, mu_erf,ao_abs_comb_b2_env, & !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,thrsh_cycle_tc) ! !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,expo_erfc_mu_gauss) !$OMP DO @@ -129,8 +128,8 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu coef = List_comb_thr_b2_coef (i_1s,j,i) beta = List_comb_thr_b2_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i) - ! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b2_env(i_1s,j,i) + ! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i) @@ -143,9 +142,9 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu tmp_z += coef * (ints(3) - ints_coulomb(3)) enddo - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = tmp_x - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,2) = tmp_y - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = tmp_z + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,1) = tmp_x + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,2) = tmp_y + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,3) = tmp_z enddo enddo enddo @@ -155,26 +154,26 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b_test, (ao_num, ao_nu do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,1) - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,2) - x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,3) + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,1) + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,2) + x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,3) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b_test', wall1 - wall0 + print*, ' wall time for x_v_ij_erf_rk_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- ! TODO analytically -BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) ! END_DOC @@ -185,29 +184,28 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po double precision :: tmp double precision :: wall0, wall1 double precision :: beta_ij_u, factor_ij_1s_u, center_ij_1s_u(3), coeftot - double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_j1b + double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_env double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing v_ij_u_cst_mu_j1b_test ...' + print*, ' providing v_ij_u_cst_mu_env_test ...' dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen call wall_time(wall0) - v_ij_u_cst_mu_j1b_test = 0.d0 + v_ij_u_cst_mu_env_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP beta_ij_u, factor_ij_1s_u, center_ij_1s_u, & - !$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_j1b) & + !$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_env) & !$OMP SHARED (n_points_final_grid, ao_num, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, & !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, & - !$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_test,ao_abs_comb_b2_j1b, & + !$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_env_test,ao_abs_comb_b2_env, & !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid @@ -225,8 +223,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b2_j1b(1,j,i) - ! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle + int_env = ao_abs_comb_b2_env(1,j,i) + ! if(dabs(int_env).lt.thrsh_cycle_tc) cycle do i_fit = 1, ng_fit_jast expo_fit = expo_gauss_j_mu_x(i_fit) coef_fit = coef_gauss_j_mu_x(i_fit) @@ -242,8 +240,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po do i_1s = 2, List_comb_thr_b2_size(j,i) coef = List_comb_thr_b2_coef (i_1s,j,i) beta = List_comb_thr_b2_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b2_env(i_1s,j,i) +! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i) @@ -259,7 +257,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po enddo enddo - v_ij_u_cst_mu_j1b_test(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_test(j,i,ipoint) = tmp enddo enddo enddo @@ -269,23 +267,23 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_test, (ao_num, ao_num, n_po do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_test(i,j,ipoint) + v_ij_u_cst_mu_env_test(j,i,ipoint) = v_ij_u_cst_mu_env_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_test', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_ng_1_test, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) with u(mu,r12) \approx 1/2 mu e^{-2.5 * mu (r12)^2} + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) with u(mu,r12) \approx 1/2 mu e^{-2.5 * mu (r12)^2} ! END_DOC @@ -296,27 +294,26 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, double precision :: tmp double precision :: wall0, wall1 double precision :: beta_ij_u, factor_ij_1s_u, center_ij_1s_u(3), coeftot - double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_j1b + double precision :: sigma_ij, dist_ij_ipoint, dsqpi_3_2, int_env double precision, external :: overlap_gauss_r12_ao double precision, external :: overlap_gauss_r12_ao_with1s dsqpi_3_2 = (dacos(-1.d0))**(1.5d0) - provide mu_erf final_grid_points j1b_pen call wall_time(wall0) - v_ij_u_cst_mu_j1b_ng_1_test = 0.d0 + v_ij_u_cst_mu_env_ng_1_test = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, & !$OMP beta_ij_u, factor_ij_1s_u, center_ij_1s_u, & - !$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_j1b) & + !$OMP coef_fit, expo_fit, int_fit, tmp,coeftot,int_env) & !$OMP SHARED (n_points_final_grid, ao_num, & !$OMP final_grid_points, expo_good_j_mu_1gauss,coef_good_j_mu_1gauss, & !$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, & !$OMP List_comb_thr_b2_coef, List_comb_thr_b2_expo,List_comb_thr_b2_size, & - !$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_j1b_ng_1_test,ao_abs_comb_b2_j1b, & + !$OMP List_comb_thr_b2_cent, v_ij_u_cst_mu_env_ng_1_test,ao_abs_comb_b2_env, & !$OMP ao_overlap_abs_grid,ao_prod_center,ao_prod_sigma,dsqpi_3_2,thrsh_cycle_tc) !$OMP DO do ipoint = 1, n_points_final_grid @@ -334,8 +331,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, ! i_1s = 1 ! --- --- --- - int_j1b = ao_abs_comb_b2_j1b(1,j,i) -! if(dabs(int_j1b).lt.thrsh_cycle_tc) cycle + int_env = ao_abs_comb_b2_env(1,j,i) +! if(dabs(int_env).lt.thrsh_cycle_tc) cycle expo_fit = expo_good_j_mu_1gauss int_fit = overlap_gauss_r12_ao(r, expo_fit, i, j) tmp += int_fit @@ -347,8 +344,8 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, do i_1s = 2, List_comb_thr_b2_size(j,i) coef = List_comb_thr_b2_coef (i_1s,j,i) beta = List_comb_thr_b2_expo (i_1s,j,i) - int_j1b = ao_abs_comb_b2_j1b(i_1s,j,i) -! if(dabs(coef)*dabs(int_j1b).lt.thrsh_cycle_tc)cycle + int_env = ao_abs_comb_b2_env(i_1s,j,i) +! if(dabs(coef)*dabs(int_env).lt.thrsh_cycle_tc)cycle B_center(1) = List_comb_thr_b2_cent(1,i_1s,j,i) B_center(2) = List_comb_thr_b2_cent(2,i_1s,j,i) B_center(3) = List_comb_thr_b2_cent(3,i_1s,j,i) @@ -364,7 +361,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, ! enddo enddo - v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint) = tmp enddo enddo enddo @@ -374,13 +371,13 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_ng_1_test, (ao_num, ao_num, do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_j1b_ng_1_test(i,j,ipoint) + v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint) = v_ij_u_cst_mu_env_ng_1_test(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_ng_1_test', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_ng_1_test (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER diff --git a/src/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f similarity index 65% rename from src/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f rename to plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f index 24b33eb5..00e2d5fc 100644 --- a/src/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f +++ b/plugins/local/ao_many_one_e_ints/grad_lapl_jmu_modif.irp.f @@ -1,11 +1,11 @@ ! --- -BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R| - 1) / |r - R| + ! int dr phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R| - 1) / |r - R| ! END_DOC @@ -17,18 +17,20 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po double precision :: wall0, wall1 double precision, external :: NAI_pol_mult_erf_ao_with1s - print *, ' providing v_ij_erf_rk_cst_mu_j1b ...' + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE env_expo + + print *, ' providing v_ij_erf_rk_cst_mu_env ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen - - v_ij_erf_rk_cst_mu_j1b = 0.d0 + v_ij_erf_rk_cst_mu_env = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, int_mu, int_coulomb, tmp) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, final_grid_points, & - !$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, List_all_comb_b2_cent, & - !$OMP v_ij_erf_rk_cst_mu_j1b, mu_erf) + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, final_grid_points, & + !$OMP List_env1s_coef, List_env1s_expo, List_env1s_cent, & + !$OMP v_ij_erf_rk_cst_mu_env, mu_erf) !$OMP DO !do ipoint = 1, 10 do ipoint = 1, n_points_final_grid @@ -43,28 +45,27 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po ! --- - coef = List_all_comb_b2_coef (1) - beta = List_all_comb_b2_expo (1) - B_center(1) = List_all_comb_b2_cent(1,1) - B_center(2) = List_all_comb_b2_cent(2,1) - B_center(3) = List_all_comb_b2_cent(3,1) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) int_mu = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r) int_coulomb = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r) -! if(dabs(coef)*dabs(int_mu - int_coulomb) .lt. 1d-12) cycle tmp += coef * (int_mu - int_coulomb) ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - B_center(1) = List_all_comb_b2_cent(1,i_1s) - B_center(2) = List_all_comb_b2_cent(2,i_1s) - B_center(3) = List_all_comb_b2_cent(3,i_1s) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) int_mu = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r) int_coulomb = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r) @@ -74,7 +75,7 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po ! --- - v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) = tmp + v_ij_erf_rk_cst_mu_env(j,i,ipoint) = tmp enddo enddo enddo @@ -84,22 +85,22 @@ BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_po do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) = v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) + v_ij_erf_rk_cst_mu_env(j,i,ipoint) = v_ij_erf_rk_cst_mu_env(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_erf_rk_cst_mu_j1b', wall1 - wall0 + print*, ' wall time for v_ij_erf_rk_cst_mu_env (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_points_final_grid, 3)] +BEGIN_PROVIDER [double precision, x_v_ij_erf_rk_cst_mu_env, (ao_num, ao_num, n_points_final_grid, 3)] BEGIN_DOC - ! int dr x phi_i(r) phi_j(r) 1s_j1b(r) (erf(mu(R) |r - R|) - 1)/|r - R| + ! int dr x phi_i(r) phi_j(r) 1s_env(r) (erf(mu(R) |r - R|) - 1)/|r - R| END_DOC implicit none @@ -108,17 +109,17 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ double precision :: tmp_x, tmp_y, tmp_z double precision :: wall0, wall1 - print*, ' providing x_v_ij_erf_rk_cst_mu_j1b ...' + print*, ' providing x_v_ij_erf_rk_cst_mu_env ...' call wall_time(wall0) - x_v_ij_erf_rk_cst_mu_j1b = 0.d0 + x_v_ij_erf_rk_cst_mu_env = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, ints, ints_coulomb, & !$OMP tmp_x, tmp_y, tmp_z) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, final_grid_points,& - !$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, List_all_comb_b2_cent, & - !$OMP x_v_ij_erf_rk_cst_mu_j1b, mu_erf) + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, final_grid_points,& + !$OMP List_env1s_coef, List_env1s_expo, List_env1s_cent, & + !$OMP x_v_ij_erf_rk_cst_mu_env, mu_erf) !$OMP DO !do ipoint = 1, 10 do ipoint = 1, n_points_final_grid @@ -135,11 +136,11 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ ! --- - coef = List_all_comb_b2_coef (1) - beta = List_all_comb_b2_expo (1) - B_center(1) = List_all_comb_b2_cent(1,1) - B_center(2) = List_all_comb_b2_cent(2,1) - B_center(3) = List_all_comb_b2_cent(3,1) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints ) call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, ints_coulomb) @@ -152,14 +153,14 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - B_center(1) = List_all_comb_b2_cent(1,i_1s) - B_center(2) = List_all_comb_b2_cent(2,i_1s) - B_center(3) = List_all_comb_b2_cent(3,i_1s) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, ints ) call NAI_pol_x_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, ints_coulomb) @@ -171,9 +172,9 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ ! --- - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,1) = tmp_x - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,2) = tmp_y - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,3) = tmp_z + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,1) = tmp_x + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,2) = tmp_y + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,3) = tmp_z enddo enddo enddo @@ -183,25 +184,25 @@ BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_j1b, (ao_num, ao_num, n_ do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1) - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2) - x_v_ij_erf_rk_cst_mu_j1b(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3) + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,1) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,2) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) + x_v_ij_erf_rk_cst_mu_env(j,i,ipoint,3) = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for x_v_ij_erf_rk_cst_mu_j1b =', wall1 - wall0 + print*, ' wall time for x_v_ij_erf_rk_cst_mu_env (min) =', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_fit, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) ! END_DOC @@ -214,23 +215,23 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi double precision, external :: overlap_gauss_r12_ao_with1s - print*, ' providing v_ij_u_cst_mu_j1b_fit ...' + print*, ' providing v_ij_u_cst_mu_env_fit ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen + provide mu_erf final_grid_points env_expo PROVIDE ng_fit_jast expo_gauss_j_mu_x coef_gauss_j_mu_x - PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent + PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent - v_ij_u_cst_mu_j1b_fit = 0.d0 + v_ij_u_cst_mu_env_fit = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & !$OMP coef_fit, expo_fit, int_fit, tmp) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, & !$OMP final_grid_points, ng_fit_jast, & !$OMP expo_gauss_j_mu_x, coef_gauss_j_mu_x, & - !$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, & - !$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_fit) + !$OMP List_env1s_coef, List_env1s_expo, & + !$OMP List_env1s_cent, v_ij_u_cst_mu_env_fit) !$OMP DO do ipoint = 1, n_points_final_grid r(1) = final_grid_points(1,ipoint) @@ -247,11 +248,11 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi ! --- - coef = List_all_comb_b2_coef (1) - beta = List_all_comb_b2_expo (1) - B_center(1) = List_all_comb_b2_cent(1,1) - B_center(2) = List_all_comb_b2_cent(2,1) - B_center(3) = List_all_comb_b2_cent(3,1) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) @@ -259,14 +260,14 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - B_center(1) = List_all_comb_b2_cent(1,i_1s) - B_center(2) = List_all_comb_b2_cent(2,i_1s) - B_center(3) = List_all_comb_b2_cent(3,i_1s) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) int_fit = overlap_gauss_r12_ao_with1s(B_center, beta, r, expo_fit, i, j) @@ -277,7 +278,7 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi enddo - v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_fit(j,i,ipoint) = tmp enddo enddo enddo @@ -287,23 +288,23 @@ BEGIN_PROVIDER [ double precision, v_ij_u_cst_mu_j1b_fit, (ao_num, ao_num, n_poi do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_fit(j,i,ipoint) = v_ij_u_cst_mu_j1b_fit(i,j,ipoint) + v_ij_u_cst_mu_env_fit(j,i,ipoint) = v_ij_u_cst_mu_env_fit(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_fit', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_fit (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an_old, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) ! END_DOC @@ -322,24 +323,24 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p double precision, external :: overlap_gauss_r12_ao_with1s double precision, external :: NAI_pol_mult_erf_ao_with1s - print*, ' providing v_ij_u_cst_mu_j1b_an_old ...' + print*, ' providing v_ij_u_cst_mu_env_an_old ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen - PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent + provide mu_erf final_grid_points env_expo + PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent ct = inv_sq_pi_2 / mu_erf - v_ij_u_cst_mu_j1b_an_old = 0.d0 + v_ij_u_cst_mu_env_an_old = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, & !$OMP r1_2, tmp, int_c1, int_e1, int_o, int_c2, & !$OMP int_e2, int_c3, int_e3) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, & !$OMP final_grid_points, mu_erf, ct, & - !$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, & - !$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an_old) + !$OMP List_env1s_coef, List_env1s_expo, & + !$OMP List_env1s_cent, v_ij_u_cst_mu_env_an_old) !$OMP DO do ipoint = 1, n_points_final_grid @@ -353,11 +354,11 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p ! --- - coef = List_all_comb_b2_coef (1) - beta = List_all_comb_b2_expo (1) - B_center(1) = List_all_comb_b2_cent(1,1) - B_center(2) = List_all_comb_b2_cent(2,1) - B_center(3) = List_all_comb_b2_cent(3,1) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r) int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r) @@ -379,14 +380,14 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - B_center(1) = List_all_comb_b2_cent(1,i_1s) - B_center(2) = List_all_comb_b2_cent(2,i_1s) - B_center(3) = List_all_comb_b2_cent(3,i_1s) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) int_c1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r) int_e1 = NAI_pol_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r) @@ -410,7 +411,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p ! --- - v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_an_old(j,i,ipoint) = tmp enddo enddo enddo @@ -420,23 +421,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an_old, (ao_num, ao_num, n_p do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) = v_ij_u_cst_mu_j1b_an_old(i,j,ipoint) + v_ij_u_cst_mu_env_an_old(j,i,ipoint) = v_ij_u_cst_mu_env_an_old(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_an_old', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_an_old (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_points_final_grid)] +BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_env_an, (ao_num, ao_num, n_points_final_grid)] BEGIN_DOC ! - ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2) u(mu, r12) + ! int dr2 phi_i(r2) phi_j(r2) 1s_env(r2) u(mu, r12) ! END_DOC @@ -454,23 +455,23 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point double precision, external :: overlap_gauss_r12_ao_with1s double precision, external :: NAI_pol_mult_erf_ao_with1s - print*, ' providing v_ij_u_cst_mu_j1b_an ...' + print*, ' providing v_ij_u_cst_mu_env_an ...' call wall_time(wall0) - provide mu_erf final_grid_points j1b_pen - PROVIDE List_all_comb_b2_size List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent + provide mu_erf final_grid_points env_expo + PROVIDE List_env1s_size List_env1s_coef List_env1s_expo List_env1s_cent ct = inv_sq_pi_2 / mu_erf - v_ij_u_cst_mu_j1b_an = 0.d0 + v_ij_u_cst_mu_env_an = 0.d0 !$OMP PARALLEL DEFAULT (NONE) & !$OMP PRIVATE (ipoint, i, j, i_1s, r, coef, beta, B_center, & !$OMP r1_2, tmp, int_c, int_e, int_o) & - !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b2_size, & + !$OMP SHARED (n_points_final_grid, ao_num, List_env1s_size, & !$OMP final_grid_points, mu_erf, ct, & - !$OMP List_all_comb_b2_coef, List_all_comb_b2_expo, & - !$OMP List_all_comb_b2_cent, v_ij_u_cst_mu_j1b_an) + !$OMP List_env1s_coef, List_env1s_expo, & + !$OMP List_env1s_cent, v_ij_u_cst_mu_env_an) !$OMP DO do ipoint = 1, n_points_final_grid @@ -484,11 +485,11 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point ! --- - coef = List_all_comb_b2_coef (1) - beta = List_all_comb_b2_expo (1) - B_center(1) = List_all_comb_b2_cent(1,1) - B_center(2) = List_all_comb_b2_cent(2,1) - B_center(3) = List_all_comb_b2_cent(3,1) + coef = List_env1s_coef (1) + beta = List_env1s_expo (1) + B_center(1) = List_env1s_cent(1,1) + B_center(2) = List_env1s_cent(2,1) + B_center(3) = List_env1s_cent(3,1) call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c) call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e) @@ -504,14 +505,14 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point ! --- - do i_1s = 2, List_all_comb_b2_size + do i_1s = 2, List_env1s_size - coef = List_all_comb_b2_coef (i_1s) + coef = List_env1s_coef (i_1s) if(dabs(coef) .lt. 1d-15) cycle ! beta = 0.0 - beta = List_all_comb_b2_expo (i_1s) - B_center(1) = List_all_comb_b2_cent(1,i_1s) - B_center(2) = List_all_comb_b2_cent(2,i_1s) - B_center(3) = List_all_comb_b2_cent(3,i_1s) + beta = List_env1s_expo (i_1s) + B_center(1) = List_env1s_cent(1,i_1s) + B_center(2) = List_env1s_cent(2,i_1s) + B_center(3) = List_env1s_cent(3,i_1s) call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_c) call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_e) @@ -529,7 +530,7 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point ! --- - v_ij_u_cst_mu_j1b_an(j,i,ipoint) = tmp + v_ij_u_cst_mu_env_an(j,i,ipoint) = tmp enddo enddo enddo @@ -539,13 +540,13 @@ BEGIN_PROVIDER [double precision, v_ij_u_cst_mu_j1b_an, (ao_num, ao_num, n_point do ipoint = 1, n_points_final_grid do i = 2, ao_num do j = 1, i-1 - v_ij_u_cst_mu_j1b_an(j,i,ipoint) = v_ij_u_cst_mu_j1b_an(i,j,ipoint) + v_ij_u_cst_mu_env_an(j,i,ipoint) = v_ij_u_cst_mu_env_an(i,j,ipoint) enddo enddo enddo call wall_time(wall1) - print*, ' wall time for v_ij_u_cst_mu_j1b_an', wall1 - wall0 + print*, ' wall time for v_ij_u_cst_mu_env_an (min) = ', (wall1 - wall0) / 60.d0 END_PROVIDER diff --git a/src/ao_many_one_e_ints/grad_related_ints.irp.f b/plugins/local/ao_many_one_e_ints/grad_related_ints.irp.f similarity index 100% rename from src/ao_many_one_e_ints/grad_related_ints.irp.f rename to plugins/local/ao_many_one_e_ints/grad_related_ints.irp.f diff --git a/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f b/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f new file mode 100644 index 00000000..3483872b --- /dev/null +++ b/plugins/local/ao_many_one_e_ints/lin_fc_rsdft.irp.f @@ -0,0 +1,574 @@ + +! --- + + BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du_2, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_Mu_long_Du_0 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] + ! + ! Ir2_Mu_long_Du_x = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * x2 + ! Ir2_Mu_long_Du_y = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * y2 + ! Ir2_Mu_long_Du_z = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * z2 + ! + ! Ir2_Mu_long_Du_2 = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) [(1 - erf(mu r_12) / r_12] * r2^2 + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s + double precision :: r(3), int_clb(7), int_erf(7) + double precision :: c_1s, e_1s, R_1s(3) + double precision :: tmp_Du_0, tmp_Du_x, tmp_Du_y, tmp_Du_z, tmp_Du_2 + double precision :: wall0, wall1 + + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent + + + print *, ' providing Ir2_Mu_long_Du ...' + call wall_time(wall0) + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, r, c_1s, e_1s, R_1s, int_erf, int_clb, & + !$OMP tmp_Du_0, tmp_Du_x, tmp_Du_y, tmp_Du_z, tmp_Du_2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_erf, & + !$OMP List_env1s_size, List_env1s_expo, & + !$OMP List_env1s_coef, List_env1s_cent, & + !$OMP Ir2_Mu_long_Du_0, Ir2_Mu_long_Du_x, & + !$OMP Ir2_Mu_long_Du_y, Ir2_Mu_long_Du_z, & + !$OMP Ir2_Mu_long_Du_2) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + do i = 1, ao_num + do j = i, ao_num + + call NAI_pol_012_mult_erf_ao(i, j, 1.d+9, r, int_clb) + call NAI_pol_012_mult_erf_ao(i, j, mu_erf, r, int_erf) + + tmp_Du_0 = int_clb(1) - int_erf(1) + tmp_Du_x = int_clb(2) - int_erf(2) + tmp_Du_y = int_clb(3) - int_erf(3) + tmp_Du_z = int_clb(4) - int_erf(4) + tmp_Du_2 = int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7) + + do i_1s = 2, List_env1s_size + + e_1s = List_env1s_expo(i_1s) + c_1s = List_env1s_coef(i_1s) + R_1s(1) = List_env1s_cent(1,i_1s) + R_1s(2) = List_env1s_cent(2,i_1s) + R_1s(3) = List_env1s_cent(3,i_1s) + + call NAI_pol_012_mult_erf_ao_with1s(i, j, e_1s, R_1s, 1.d+9, r, int_clb) + call NAI_pol_012_mult_erf_ao_with1s(i, j, e_1s, R_1s, mu_erf, r, int_erf) + + tmp_Du_0 = tmp_Du_0 + c_1s * (int_clb(1) - int_erf(1)) + tmp_Du_x = tmp_Du_x + c_1s * (int_clb(2) - int_erf(2)) + tmp_Du_y = tmp_Du_y + c_1s * (int_clb(3) - int_erf(3)) + tmp_Du_z = tmp_Du_z + c_1s * (int_clb(4) - int_erf(4)) + tmp_Du_2 = tmp_Du_2 + c_1s * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)) + enddo + + Ir2_Mu_long_Du_0(j,i,ipoint) = tmp_Du_0 + Ir2_Mu_long_Du_x(j,i,ipoint) = tmp_Du_x + Ir2_Mu_long_Du_y(j,i,ipoint) = tmp_Du_y + Ir2_Mu_long_Du_z(j,i,ipoint) = tmp_Du_z + Ir2_Mu_long_Du_2(j,i,ipoint) = tmp_Du_2 + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + Ir2_Mu_long_Du_0(j,i,ipoint) = Ir2_Mu_long_Du_0(i,j,ipoint) + Ir2_Mu_long_Du_x(j,i,ipoint) = Ir2_Mu_long_Du_x(i,j,ipoint) + Ir2_Mu_long_Du_y(j,i,ipoint) = Ir2_Mu_long_Du_y(i,j,ipoint) + Ir2_Mu_long_Du_z(j,i,ipoint) = Ir2_Mu_long_Du_z(i,j,ipoint) + Ir2_Mu_long_Du_2(j,i,ipoint) = Ir2_Mu_long_Du_2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_Mu_long_Du (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, Ir2_Mu_gauss_Du, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_Mu_gauss_Du = int dr2 phi_i(r2) phi_j(r2) fc_env(r2) e^{-(mu r_12)^2} + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s + double precision :: r(3) + double precision :: coef, beta, B_center(3) + double precision :: tmp_Du + double precision :: mu_sq, dx, dy, dz, tmp_arg, rmu_sq(3) + double precision :: e_1s, c_1s, R_1s(3) + double precision :: wall0, wall1 + + double precision, external :: overlap_gauss_r12_ao + + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE List_env1s_size List_env1s_expo List_env1s_coef List_env1s_cent + + + print *, ' providing Ir2_Mu_gauss_Du ...' + call wall_time(wall0) + + mu_sq = mu_erf * mu_erf + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, dx, dy, dz, r, tmp_arg, coef, & + !$OMP rmu_sq, e_1s, c_1s, R_1s, beta, B_center, tmp_Du) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & + !$OMP List_env1s_size, List_env1s_expo, & + !$OMP List_env1s_coef, List_env1s_cent, & + !$OMP Ir2_Mu_gauss_Du) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + rmu_sq(1) = mu_sq * r(1) + rmu_sq(2) = mu_sq * r(2) + rmu_sq(3) = mu_sq * r(3) + + do i = 1, ao_num + do j = i, ao_num + + tmp_Du = overlap_gauss_r12_ao(r, mu_sq, j, i) + + do i_1s = 2, List_env1s_size + + e_1s = List_env1s_expo(i_1s) + c_1s = List_env1s_coef(i_1s) + R_1s(1) = List_env1s_cent(1,i_1s) + R_1s(2) = List_env1s_cent(2,i_1s) + R_1s(3) = List_env1s_cent(3,i_1s) + + dx = r(1) - R_1s(1) + dy = r(2) - R_1s(2) + dz = r(3) - R_1s(3) + + beta = mu_sq + e_1s + tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta + coef = c_1s * dexp(-tmp_arg) + B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta + B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta + B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta + + tmp_Du += coef * overlap_gauss_r12_ao(B_center, beta, j, i) + enddo + + Ir2_Mu_gauss_Du(j,i,ipoint) = tmp_Du + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + + Ir2_Mu_gauss_Du(j,i,ipoint) = Ir2_Mu_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_Mu_gauss_Du (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_long_Du2_2, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_Mu_long_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] + ! + ! Ir2_Mu_long_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * x2 + ! Ir2_Mu_long_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * y2 + ! Ir2_Mu_long_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * z2 + ! + ! Ir2_Mu_long_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12) / r_12] * r2^2 + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s + double precision :: r(3), int_clb(7), int_erf(7) + double precision :: coef, beta, B_center(3) + double precision :: tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2 + double precision :: mu_sq, tmp_arg, dx, dy, dz, rmu_sq(3) + double precision :: e_1s, c_1s, R_1s(3) + double precision :: wall0, wall1 + + + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent + + print *, ' providing Ir2_Mu_long_Du2 ...' + call wall_time(wall0) + + mu_sq = mu_erf * mu_erf + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, r, rmu_sq, dx, dy, dz, & + !$OMP e_1s, c_1s, R_1s, tmp_arg, coef, beta, B_center, & + !$OMP int_erf, int_clb, & + !$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & + !$OMP mu_erf, List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_Mu_long_Du2_0, Ir2_Mu_long_Du2_x, & + !$OMP Ir2_Mu_long_Du2_y, Ir2_Mu_long_Du2_z, & + !$OMP Ir2_Mu_long_Du2_2) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + rmu_sq(1) = mu_sq * r(1) + rmu_sq(2) = mu_sq * r(2) + rmu_sq(3) = mu_sq * r(3) + + do i = 1, ao_num + do j = i, ao_num + + call NAI_pol_012_mult_erf_ao_with1s(i, j, mu_sq, r, 1.d+9, r, int_clb) + call NAI_pol_012_mult_erf_ao_with1s(i, j, mu_sq, r, mu_erf, r, int_erf) + + tmp_Du2_0 = int_clb(1) - int_erf(1) + tmp_Du2_x = int_clb(2) - int_erf(2) + tmp_Du2_y = int_clb(3) - int_erf(3) + tmp_Du2_z = int_clb(4) - int_erf(4) + tmp_Du2_2 = int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7) + + do i_1s = 2, List_env1s_square_size + + e_1s = List_env1s_square_expo(i_1s) + c_1s = List_env1s_square_coef(i_1s) + R_1s(1) = List_env1s_square_cent(1,i_1s) + R_1s(2) = List_env1s_square_cent(2,i_1s) + R_1s(3) = List_env1s_square_cent(3,i_1s) + + dx = r(1) - R_1s(1) + dy = r(2) - R_1s(2) + dz = r(3) - R_1s(3) + + beta = mu_sq + e_1s + tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta + coef = c_1s * dexp(-tmp_arg) + B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta + B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta + B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta + + call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, 1.d+9, r, int_clb) + call NAI_pol_012_mult_erf_ao_with1s(i, j, beta, B_center, mu_erf, r, int_erf) + + tmp_Du2_0 = tmp_Du2_0 + coef * (int_clb(1) - int_erf(1)) + tmp_Du2_x = tmp_Du2_x + coef * (int_clb(2) - int_erf(2)) + tmp_Du2_y = tmp_Du2_y + coef * (int_clb(3) - int_erf(3)) + tmp_Du2_z = tmp_Du2_z + coef * (int_clb(4) - int_erf(4)) + tmp_Du2_2 = tmp_Du2_2 + coef * (int_clb(5) + int_clb(6) + int_clb(7) - int_erf(5) - int_erf(6) - int_erf(7)) + enddo + + Ir2_Mu_long_Du2_0(j,i,ipoint) = tmp_Du2_0 + Ir2_Mu_long_Du2_x(j,i,ipoint) = tmp_Du2_x + Ir2_Mu_long_Du2_y(j,i,ipoint) = tmp_Du2_y + Ir2_Mu_long_Du2_z(j,i,ipoint) = tmp_Du2_z + Ir2_Mu_long_Du2_2(j,i,ipoint) = tmp_Du2_2 + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + Ir2_Mu_long_Du2_0(j,i,ipoint) = Ir2_Mu_long_Du2_0(i,j,ipoint) + Ir2_Mu_long_Du2_x(j,i,ipoint) = Ir2_Mu_long_Du2_x(i,j,ipoint) + Ir2_Mu_long_Du2_y(j,i,ipoint) = Ir2_Mu_long_Du2_y(i,j,ipoint) + Ir2_Mu_long_Du2_z(j,i,ipoint) = Ir2_Mu_long_Du2_z(i,j,ipoint) + Ir2_Mu_long_Du2_2(j,i,ipoint) = Ir2_Mu_long_Du2_2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_Mu_long_Du2 (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, Ir2_Mu_gauss_Du2, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_Mu_gauss_Du2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 e^{-(mu r_12)^2} + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s + double precision :: r(3) + double precision :: coef, beta, B_center(3) + double precision :: tmp_Du2 + double precision :: mu_sq, dx, dy, dz, tmp_arg, rmu_sq(3) + double precision :: e_1s, c_1s, R_1s(3) + double precision :: wall0, wall1 + + double precision, external :: overlap_gauss_r12_ao + + PROVIDE mu_erf + PROVIDE final_grid_points + PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent + + + print *, ' providing Ir2_Mu_gauss_Du2 ...' + call wall_time(wall0) + + mu_sq = 2.d0 * mu_erf * mu_erf + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, dx, dy, dz, r, tmp_arg, coef, & + !$OMP rmu_sq, e_1s, c_1s, R_1s, beta, B_center, tmp_Du2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, mu_sq, & + !$OMP List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_Mu_gauss_Du2) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + rmu_sq(1) = mu_sq * r(1) + rmu_sq(2) = mu_sq * r(2) + rmu_sq(3) = mu_sq * r(3) + + do i = 1, ao_num + do j = i, ao_num + + tmp_Du2 = overlap_gauss_r12_ao(r, mu_sq, j, i) + + do i_1s = 2, List_env1s_square_size + + e_1s = List_env1s_square_expo(i_1s) + c_1s = List_env1s_square_coef(i_1s) + R_1s(1) = List_env1s_square_cent(1,i_1s) + R_1s(2) = List_env1s_square_cent(2,i_1s) + R_1s(3) = List_env1s_square_cent(3,i_1s) + + dx = r(1) - R_1s(1) + dy = r(2) - R_1s(2) + dz = r(3) - R_1s(3) + + beta = mu_sq + e_1s + tmp_arg = mu_sq * e_1s * (dx*dx + dy*dy + dz*dz) / beta + coef = c_1s * dexp(-tmp_arg) + B_center(1) = (rmu_sq(1) + e_1s * R_1s(1)) / beta + B_center(2) = (rmu_sq(2) + e_1s * R_1s(2)) / beta + B_center(3) = (rmu_sq(3) + e_1s * R_1s(3)) / beta + + tmp_Du2 += coef * overlap_gauss_r12_ao(B_center, beta, j, i) + enddo + + Ir2_Mu_gauss_Du2(j,i,ipoint) = tmp_Du2 + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + + Ir2_Mu_gauss_Du2(j,i,ipoint) = Ir2_Mu_gauss_Du2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_Mu_gauss_Du2 (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_0, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_x, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_y, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_z, (ao_num, ao_num, n_points_final_grid)] +&BEGIN_PROVIDER [double precision, Ir2_Mu_short_Du2_2, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! Ir2_Mu_short_Du2_0 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 + ! + ! Ir2_Mu_short_Du2_x = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * x2 + ! Ir2_Mu_short_Du2_y = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * y2 + ! Ir2_Mu_short_Du2_z = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * z2 + ! + ! Ir2_Mu_short_Du2_2 = int dr2 phi_i(r2) phi_j(r2) [fc_env(r2)]^2 [(1 - erf(mu r_12)]^2 * r2^2 + ! + END_DOC + + implicit none + + integer :: i, j, ipoint, i_1s, i_fit + double precision :: r(3), ints(7) + double precision :: coef, beta, B_center(3) + double precision :: tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2 + double precision :: tmp_arg, dx, dy, dz + double precision :: expo_fit, coef_fit, e_1s, c_1s, R_1s(3) + double precision :: wall0, wall1 + + PROVIDE final_grid_points + PROVIDE List_env1s_square_size List_env1s_square_expo List_env1s_square_coef List_env1s_square_cent + PROVIDE ng_fit_jast expo_gauss_1_erf_x_2 coef_gauss_1_erf_x_2 + + print *, ' providing Ir2_Mu_short_Du2 ...' + call wall_time(wall0) + + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, dx, dy, dz, & + !$OMP expo_fit, coef_fit, e_1s, c_1s, R_1s, & + !$OMP tmp_arg, coef, beta, B_center, ints, & + !$OMP tmp_Du2_0, tmp_Du2_x, tmp_Du2_y, tmp_Du2_z, tmp_Du2_2) & + !$OMP SHARED (n_points_final_grid, ao_num, final_grid_points, & + !$OMP ng_fit_jast, expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & + !$OMP List_env1s_square_size, List_env1s_square_expo, & + !$OMP List_env1s_square_coef, List_env1s_square_cent, & + !$OMP Ir2_Mu_short_Du2_0, Ir2_Mu_short_Du2_x, & + !$OMP Ir2_Mu_short_Du2_y, Ir2_Mu_short_Du2_z, & + !$OMP Ir2_Mu_short_Du2_2) + !$OMP DO + do ipoint = 1, n_points_final_grid + + r(1) = final_grid_points(1,ipoint) + r(2) = final_grid_points(2,ipoint) + r(3) = final_grid_points(3,ipoint) + + do i = 1, ao_num + do j = i, ao_num + + tmp_Du2_0 = 0.d0 + tmp_Du2_x = 0.d0 + tmp_Du2_y = 0.d0 + tmp_Du2_z = 0.d0 + tmp_Du2_2 = 0.d0 + do i_fit = 1, ng_fit_jast + + expo_fit = expo_gauss_1_erf_x_2(i_fit) + coef_fit = coef_gauss_1_erf_x_2(i_fit) + + call overlap_gauss_r12_ao_012(r, expo_fit, i, j, ints) + + tmp_Du2_0 += coef_fit * ints(1) + tmp_Du2_x += coef_fit * ints(2) + tmp_Du2_y += coef_fit * ints(3) + tmp_Du2_z += coef_fit * ints(4) + tmp_Du2_2 += coef_fit * (ints(5) + ints(6) + ints(7)) + + do i_1s = 2, List_env1s_square_size + + e_1s = List_env1s_square_expo(i_1s) + c_1s = List_env1s_square_coef(i_1s) + R_1s(1) = List_env1s_square_cent(1,i_1s) + R_1s(2) = List_env1s_square_cent(2,i_1s) + R_1s(3) = List_env1s_square_cent(3,i_1s) + + dx = r(1) - R_1s(1) + dy = r(2) - R_1s(2) + dz = r(3) - R_1s(3) + + beta = expo_fit + e_1s + tmp_arg = expo_fit * e_1s * (dx*dx + dy*dy + dz*dz) / beta + coef = coef_fit * c_1s * dexp(-tmp_arg) + B_center(1) = (expo_fit * r(1) + e_1s * R_1s(1)) / beta + B_center(2) = (expo_fit * r(2) + e_1s * R_1s(2)) / beta + B_center(3) = (expo_fit * r(3) + e_1s * R_1s(3)) / beta + + call overlap_gauss_r12_ao_012(B_center, beta, i, j, ints) + + tmp_Du2_0 += coef * ints(1) + tmp_Du2_x += coef * ints(2) + tmp_Du2_y += coef * ints(3) + tmp_Du2_z += coef * ints(4) + tmp_Du2_2 += coef * (ints(5) + ints(6) + ints(7)) + enddo ! i_1s + enddo ! i_fit + + Ir2_Mu_short_Du2_0(j,i,ipoint) = tmp_Du2_0 + Ir2_Mu_short_Du2_x(j,i,ipoint) = tmp_Du2_x + Ir2_Mu_short_Du2_y(j,i,ipoint) = tmp_Du2_y + Ir2_Mu_short_Du2_z(j,i,ipoint) = tmp_Du2_z + Ir2_Mu_short_Du2_2(j,i,ipoint) = tmp_Du2_2 + enddo ! j + enddo ! i + enddo ! ipoint + !$OMP END DO + !$OMP END PARALLEL + + do ipoint = 1, n_points_final_grid + do i = 2, ao_num + do j = 1, i-1 + Ir2_Mu_short_Du2_0(j,i,ipoint) = Ir2_Mu_short_Du2_0(i,j,ipoint) + Ir2_Mu_short_Du2_x(j,i,ipoint) = Ir2_Mu_short_Du2_x(i,j,ipoint) + Ir2_Mu_short_Du2_y(j,i,ipoint) = Ir2_Mu_short_Du2_y(i,j,ipoint) + Ir2_Mu_short_Du2_z(j,i,ipoint) = Ir2_Mu_short_Du2_z(i,j,ipoint) + Ir2_Mu_short_Du2_2(j,i,ipoint) = Ir2_Mu_short_Du2_2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(wall1) + print*, ' wall time for Ir2_Mu_short_Du2 (min) = ', (wall1 - wall0) / 60.d0 + +END_PROVIDER + +! --- + diff --git a/src/ao_many_one_e_ints/list_grid.irp.f b/plugins/local/ao_many_one_e_ints/list_grid.irp.f similarity index 100% rename from src/ao_many_one_e_ints/list_grid.irp.f rename to plugins/local/ao_many_one_e_ints/list_grid.irp.f diff --git a/plugins/local/ao_many_one_e_ints/listj1b.irp.f b/plugins/local/ao_many_one_e_ints/listj1b.irp.f new file mode 100644 index 00000000..2b049943 --- /dev/null +++ b/plugins/local/ao_many_one_e_ints/listj1b.irp.f @@ -0,0 +1,351 @@ + +! --- + +BEGIN_PROVIDER [integer, List_env1s_size] + + implicit none + + PROVIDE env_type + + if(env_type .eq. "Prod_Gauss") then + + List_env1s_size = 2**nucl_num + + elseif(env_type .eq. "Sum_Gauss") then + + List_env1s_size = nucl_num + 1 + + else + + print *, ' Error in List_env1s_size: Unknown env_type = ', env_type + stop + + endif + + print *, ' nb of 1s-Gaussian in the envelope = ', List_env1s_size + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [integer, List_env1s, (nucl_num, List_env1s_size)] + + implicit none + integer :: i, j + + if(nucl_num .gt. 32) then + print *, ' nucl_num = ', nucl_num, '> 32' + stop + endif + + List_env1s = 0 + + do i = 0, List_env1s_size-1 + do j = 0, nucl_num-1 + if (btest(i,j)) then + List_env1s(j+1,i+1) = 1 + endif + enddo + enddo + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [ double precision, List_env1s_coef, ( List_env1s_size)] +&BEGIN_PROVIDER [ double precision, List_env1s_expo, ( List_env1s_size)] +&BEGIN_PROVIDER [ double precision, List_env1s_cent, (3, List_env1s_size)] + + implicit none + integer :: i, j, k, phase + double precision :: tmp_alphaj, tmp_alphak + double precision :: tmp_cent_x, tmp_cent_y, tmp_cent_z + + provide env_type env_expo env_coef + + List_env1s_coef = 0.d0 + List_env1s_expo = 0.d0 + List_env1s_cent = 0.d0 + + if(env_type .eq. "Prod_Gauss") then + + do i = 1, List_env1s_size + + tmp_cent_x = 0.d0 + tmp_cent_y = 0.d0 + tmp_cent_z = 0.d0 + do j = 1, nucl_num + tmp_alphaj = dble(List_env1s(j,i)) * env_expo(j) + List_env1s_expo(i) += tmp_alphaj + tmp_cent_x += tmp_alphaj * nucl_coord(j,1) + tmp_cent_y += tmp_alphaj * nucl_coord(j,2) + tmp_cent_z += tmp_alphaj * nucl_coord(j,3) + enddo + + if(List_env1s_expo(i) .lt. 1d-10) cycle + + List_env1s_cent(1,i) = tmp_cent_x / List_env1s_expo(i) + List_env1s_cent(2,i) = tmp_cent_y / List_env1s_expo(i) + List_env1s_cent(3,i) = tmp_cent_z / List_env1s_expo(i) + enddo + + ! --- + + do i = 1, List_env1s_size + + do j = 2, nucl_num, 1 + tmp_alphaj = dble(List_env1s(j,i)) * env_expo(j) + do k = 1, j-1, 1 + tmp_alphak = dble(List_env1s(k,i)) * env_expo(k) + + List_env1s_coef(i) += tmp_alphaj * tmp_alphak * ( (nucl_coord(j,1) - nucl_coord(k,1)) * (nucl_coord(j,1) - nucl_coord(k,1)) & + + (nucl_coord(j,2) - nucl_coord(k,2)) * (nucl_coord(j,2) - nucl_coord(k,2)) & + + (nucl_coord(j,3) - nucl_coord(k,3)) * (nucl_coord(j,3) - nucl_coord(k,3)) ) + enddo + enddo + + if(List_env1s_expo(i) .lt. 1d-10) cycle + + List_env1s_coef(i) = List_env1s_coef(i) / List_env1s_expo(i) + enddo + + ! --- + + do i = 1, List_env1s_size + + phase = 0 + do j = 1, nucl_num + phase += List_env1s(j,i) + enddo + + List_env1s_coef(i) = (-1.d0)**dble(phase) * dexp(-List_env1s_coef(i)) + enddo + + elseif(env_type .eq. "Sum_Gauss") then + + List_env1s_coef( 1) = 1.d0 + List_env1s_expo( 1) = 0.d0 + List_env1s_cent(1:3,1) = 0.d0 + do i = 1, nucl_num + List_env1s_coef( i+1) = -1.d0 * env_coef(i) + List_env1s_expo( i+1) = env_expo(i) + List_env1s_cent(1,i+1) = nucl_coord(i,1) + List_env1s_cent(2,i+1) = nucl_coord(i,2) + List_env1s_cent(3,i+1) = nucl_coord(i,3) + enddo + + else + + print *, ' Error in List_env1s: Unknown env_type = ', env_type + stop + + endif + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [integer, List_env1s_square_size] + + implicit none + double precision :: tmp + + if(env_type .eq. "Prod_Gauss") then + + List_env1s_square_size = 3**nucl_num + + elseif(env_type .eq. "Sum_Gauss") then + + tmp = 0.5d0 * dble(nucl_num) * (dble(nucl_num) + 3.d0) + List_env1s_square_size = int(tmp) + 1 + + else + + print *, ' Error in List_env1s_square_size: Unknown env_type = ', env_type + stop + + endif + + print *, ' nb of 1s-Gaussian in the square of envelope = ', List_env1s_square_size + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [integer, List_env1s_square, (nucl_num, List_env1s_square_size)] + + implicit none + integer :: i, j, ii, jj + integer, allocatable :: M(:,:), p(:) + + if(nucl_num .gt. 32) then + print *, ' nucl_num = ', nucl_num, '> 32' + stop + endif + + List_env1s_square(:,:) = 0 + List_env1s_square(:,List_env1s_square_size) = 2 + + allocate(p(nucl_num)) + p = 0 + + do i = 2, List_env1s_square_size-1 + do j = 1, nucl_num + + ii = 0 + do jj = 1, j-1, 1 + ii = ii + p(jj) * 3**(jj-1) + enddo + p(j) = modulo(i-1-ii, 3**j) / 3**(j-1) + + List_env1s_square(j,i) = p(j) + enddo + enddo + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [ double precision, List_env1s_square_coef, ( List_env1s_square_size)] +&BEGIN_PROVIDER [ double precision, List_env1s_square_expo, ( List_env1s_square_size)] +&BEGIN_PROVIDER [ double precision, List_env1s_square_cent, (3, List_env1s_square_size)] + + implicit none + integer :: i, j, k, phase + integer :: ii + double precision :: tmp_alphaj, tmp_alphak, facto + double precision :: tmp1, tmp2, tmp3, tmp4 + double precision :: xi, yi, zi, xj, yj, zj + double precision :: dx, dy, dz, r2 + + provide env_type env_expo env_coef + + List_env1s_square_coef = 0.d0 + List_env1s_square_expo = 0.d0 + List_env1s_square_cent = 0.d0 + + if(env_type .eq. "Prod_Gauss") then + + do i = 1, List_env1s_square_size + + do j = 1, nucl_num + tmp_alphaj = dble(List_env1s_square(j,i)) * env_expo(j) + List_env1s_square_expo(i) += tmp_alphaj + List_env1s_square_cent(1,i) += tmp_alphaj * nucl_coord(j,1) + List_env1s_square_cent(2,i) += tmp_alphaj * nucl_coord(j,2) + List_env1s_square_cent(3,i) += tmp_alphaj * nucl_coord(j,3) + + enddo + + if(List_env1s_square_expo(i) .lt. 1d-10) cycle + + List_env1s_square_cent(1,i) = List_env1s_square_cent(1,i) / List_env1s_square_expo(i) + List_env1s_square_cent(2,i) = List_env1s_square_cent(2,i) / List_env1s_square_expo(i) + List_env1s_square_cent(3,i) = List_env1s_square_cent(3,i) / List_env1s_square_expo(i) + enddo + + ! --- + + do i = 1, List_env1s_square_size + + do j = 2, nucl_num, 1 + tmp_alphaj = dble(List_env1s_square(j,i)) * env_expo(j) + do k = 1, j-1, 1 + tmp_alphak = dble(List_env1s_square(k,i)) * env_expo(k) + + List_env1s_square_coef(i) += tmp_alphaj * tmp_alphak * ( (nucl_coord(j,1) - nucl_coord(k,1)) * (nucl_coord(j,1) - nucl_coord(k,1)) & + + (nucl_coord(j,2) - nucl_coord(k,2)) * (nucl_coord(j,2) - nucl_coord(k,2)) & + + (nucl_coord(j,3) - nucl_coord(k,3)) * (nucl_coord(j,3) - nucl_coord(k,3)) ) + enddo + enddo + + if(List_env1s_square_expo(i) .lt. 1d-10) cycle + + List_env1s_square_coef(i) = List_env1s_square_coef(i) / List_env1s_square_expo(i) + enddo + + ! --- + + do i = 1, List_env1s_square_size + + facto = 1.d0 + phase = 0 + do j = 1, nucl_num + tmp_alphaj = dble(List_env1s_square(j,i)) + + facto *= 2.d0 / (gamma(tmp_alphaj+1.d0) * gamma(3.d0-tmp_alphaj)) + phase += List_env1s_square(j,i) + enddo + + List_env1s_square_coef(i) = (-1.d0)**dble(phase) * facto * dexp(-List_env1s_square_coef(i)) + enddo + + elseif(env_type .eq. "Sum_Gauss") then + + ii = 1 + List_env1s_square_coef( ii) = 1.d0 + List_env1s_square_expo( ii) = 0.d0 + List_env1s_square_cent(1:3,ii) = 0.d0 + + do i = 1, nucl_num + ii = ii + 1 + List_env1s_square_coef( ii) = -2.d0 * env_coef(i) + List_env1s_square_expo( ii) = env_expo(i) + List_env1s_square_cent(1,ii) = nucl_coord(i,1) + List_env1s_square_cent(2,ii) = nucl_coord(i,2) + List_env1s_square_cent(3,ii) = nucl_coord(i,3) + enddo + + do i = 1, nucl_num + ii = ii + 1 + List_env1s_square_coef( ii) = 1.d0 * env_coef(i) * env_coef(i) + List_env1s_square_expo( ii) = 2.d0 * env_expo(i) + List_env1s_square_cent(1,ii) = nucl_coord(i,1) + List_env1s_square_cent(2,ii) = nucl_coord(i,2) + List_env1s_square_cent(3,ii) = nucl_coord(i,3) + enddo + + do i = 1, nucl_num-1 + + tmp1 = env_expo(i) + + xi = nucl_coord(i,1) + yi = nucl_coord(i,2) + zi = nucl_coord(i,3) + + do j = i+1, nucl_num + + tmp2 = env_expo(j) + tmp3 = tmp1 + tmp2 + tmp4 = 1.d0 / tmp3 + + xj = nucl_coord(j,1) + yj = nucl_coord(j,2) + zj = nucl_coord(j,3) + + dx = xi - xj + dy = yi - yj + dz = zi - zj + r2 = dx*dx + dy*dy + dz*dz + + ii = ii + 1 + ! x 2 to avoid doing integrals twice + List_env1s_square_coef( ii) = 2.d0 * dexp(-tmp1*tmp2*tmp4*r2) * env_coef(i) * env_coef(j) + List_env1s_square_expo( ii) = tmp3 + List_env1s_square_cent(1,ii) = tmp4 * (tmp1 * xi + tmp2 * xj) + List_env1s_square_cent(2,ii) = tmp4 * (tmp1 * yi + tmp2 * yj) + List_env1s_square_cent(3,ii) = tmp4 * (tmp1 * zi + tmp2 * zj) + enddo + enddo + + else + + print *, ' Error in List_env1s_square: Unknown env_type = ', env_type + stop + + endif + +END_PROVIDER + +! --- + diff --git a/plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f b/plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f new file mode 100644 index 00000000..ad57739b --- /dev/null +++ b/plugins/local/ao_many_one_e_ints/listj1b_sorted.irp.f @@ -0,0 +1,197 @@ + +! --- + + BEGIN_PROVIDER [integer, List_comb_thr_b2_size, (ao_num, ao_num)] +&BEGIN_PROVIDER [integer, max_List_comb_thr_b2_size] + + implicit none + integer :: i_1s, i, j, ipoint + integer :: list(ao_num) + double precision :: coef,beta,center(3),int_env + double precision :: r(3),weight,dist + + List_comb_thr_b2_size = 0 + print*,'List_env1s_size = ',List_env1s_size + + do i = 1, ao_num + do j = i, ao_num + do i_1s = 1, List_env1s_size + coef = List_env1s_coef(i_1s) + if(dabs(coef).lt.thrsh_cycle_tc) cycle + beta = List_env1s_expo(i_1s) + beta = max(beta,1.d-12) + center(1:3) = List_env1s_cent(1:3,i_1s) + int_env = 0.d0 + do ipoint = 1, n_points_extra_final_grid + r(1:3) = final_grid_points_extra(1:3,ipoint) + weight = final_weight_at_r_vector_extra(ipoint) + dist = ( center(1) - r(1) )*( center(1) - r(1) ) + dist += ( center(2) - r(2) )*( center(2) - r(2) ) + dist += ( center(3) - r(3) )*( center(3) - r(3) ) + int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight + enddo + if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then + List_comb_thr_b2_size(j,i) += 1 + endif + enddo + enddo + enddo + + do i = 1, ao_num + do j = 1, i-1 + List_comb_thr_b2_size(j,i) = List_comb_thr_b2_size(i,j) + enddo + enddo + do i = 1, ao_num + list(i) = maxval(List_comb_thr_b2_size(:,i)) + enddo + + max_List_comb_thr_b2_size = maxval(list) + print*, ' max_List_comb_thr_b2_size = ',max_List_comb_thr_b2_size + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [ double precision, List_comb_thr_b2_coef, ( max_List_comb_thr_b2_size,ao_num,ao_num)] +&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_expo, ( max_List_comb_thr_b2_size,ao_num,ao_num)] +&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_cent, (3,max_List_comb_thr_b2_size,ao_num,ao_num)] +&BEGIN_PROVIDER [ double precision, ao_abs_comb_b2_env , ( max_List_comb_thr_b2_size,ao_num,ao_num)] + + implicit none + integer :: i_1s,i,j,ipoint,icount + double precision :: coef,beta,center(3),int_env + double precision :: r(3),weight,dist + + ao_abs_comb_b2_env = 10000000.d0 + do i = 1, ao_num + do j = i, ao_num + icount = 0 + do i_1s = 1, List_env1s_size + coef = List_env1s_coef (i_1s) + if(dabs(coef).lt.thrsh_cycle_tc)cycle + beta = List_env1s_expo (i_1s) + center(1:3) = List_env1s_cent(1:3,i_1s) + int_env = 0.d0 + do ipoint = 1, n_points_extra_final_grid + r(1:3) = final_grid_points_extra(1:3,ipoint) + weight = final_weight_at_r_vector_extra(ipoint) + dist = ( center(1) - r(1) )*( center(1) - r(1) ) + dist += ( center(2) - r(2) )*( center(2) - r(2) ) + dist += ( center(3) - r(3) )*( center(3) - r(3) ) + int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight + enddo + if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then + icount += 1 + List_comb_thr_b2_coef(icount,j,i) = coef + List_comb_thr_b2_expo(icount,j,i) = beta + List_comb_thr_b2_cent(1:3,icount,j,i) = center(1:3) + ao_abs_comb_b2_env(icount,j,i) = int_env + endif + enddo + enddo + enddo + + do i = 1, ao_num + do j = 1, i-1 + do icount = 1, List_comb_thr_b2_size(j,i) + List_comb_thr_b2_coef(icount,j,i) = List_comb_thr_b2_coef(icount,i,j) + List_comb_thr_b2_expo(icount,j,i) = List_comb_thr_b2_expo(icount,i,j) + List_comb_thr_b2_cent(1:3,icount,j,i) = List_comb_thr_b2_cent(1:3,icount,i,j) + enddo + enddo + enddo + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [integer, List_comb_thr_b3_size, (ao_num,ao_num)] +&BEGIN_PROVIDER [integer, max_List_comb_thr_b3_size] + + implicit none + integer :: i_1s,i,j,ipoint + integer :: list(ao_num) + double precision :: coef,beta,center(3),int_env + double precision :: r(3),weight,dist + + List_comb_thr_b3_size = 0 + print*,'List_env1s_square_size = ',List_env1s_square_size + do i = 1, ao_num + do j = 1, ao_num + do i_1s = 1, List_env1s_square_size + coef = List_env1s_square_coef (i_1s) + beta = List_env1s_square_expo (i_1s) + center(1:3) = List_env1s_square_cent(1:3,i_1s) + if(dabs(coef).lt.thrsh_cycle_tc)cycle + int_env = 0.d0 + do ipoint = 1, n_points_extra_final_grid + r(1:3) = final_grid_points_extra(1:3,ipoint) + weight = final_weight_at_r_vector_extra(ipoint) + dist = ( center(1) - r(1) )*( center(1) - r(1) ) + dist += ( center(2) - r(2) )*( center(2) - r(2) ) + dist += ( center(3) - r(3) )*( center(3) - r(3) ) + int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight + enddo + if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc) then + List_comb_thr_b3_size(j,i) += 1 + endif + enddo + enddo + enddo + + do i = 1, ao_num + list(i) = maxval(List_comb_thr_b3_size(:,i)) + enddo + + max_List_comb_thr_b3_size = maxval(list) + print*, ' max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, List_comb_thr_b3_coef, ( max_List_comb_thr_b3_size,ao_num,ao_num)] +&BEGIN_PROVIDER [double precision, List_comb_thr_b3_expo, ( max_List_comb_thr_b3_size,ao_num,ao_num)] +&BEGIN_PROVIDER [double precision, List_comb_thr_b3_cent, (3, max_List_comb_thr_b3_size,ao_num,ao_num)] +&BEGIN_PROVIDER [double precision, ao_abs_comb_b3_env , ( max_List_comb_thr_b3_size,ao_num,ao_num)] + + implicit none + integer :: i_1s,i,j,ipoint,icount + double precision :: coef,beta,center(3),int_env + double precision :: r(3),weight,dist + + ao_abs_comb_b3_env = 10000000.d0 + do i = 1, ao_num + do j = 1, ao_num + icount = 0 + do i_1s = 1, List_env1s_square_size + coef = List_env1s_square_coef (i_1s) + beta = List_env1s_square_expo (i_1s) + beta = max(beta,1.d-12) + center(1:3) = List_env1s_square_cent(1:3,i_1s) + if(dabs(coef).lt.thrsh_cycle_tc)cycle + int_env = 0.d0 + do ipoint = 1, n_points_extra_final_grid + r(1:3) = final_grid_points_extra(1:3,ipoint) + weight = final_weight_at_r_vector_extra(ipoint) + dist = ( center(1) - r(1) )*( center(1) - r(1) ) + dist += ( center(2) - r(2) )*( center(2) - r(2) ) + dist += ( center(3) - r(3) )*( center(3) - r(3) ) + int_env += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight + enddo + if(dabs(coef)*dabs(int_env).gt.thrsh_cycle_tc)then + icount += 1 + List_comb_thr_b3_coef(icount,j,i) = coef + List_comb_thr_b3_expo(icount,j,i) = beta + List_comb_thr_b3_cent(1:3,icount,j,i) = center(1:3) + ao_abs_comb_b3_env(icount,j,i) = int_env + endif + enddo + enddo + enddo + +END_PROVIDER + +! --- + diff --git a/src/ao_many_one_e_ints/prim_int_erf_gauss.irp.f b/plugins/local/ao_many_one_e_ints/prim_int_erf_gauss.irp.f similarity index 100% rename from src/ao_many_one_e_ints/prim_int_erf_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/prim_int_erf_gauss.irp.f diff --git a/src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f b/plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f similarity index 99% rename from src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f rename to plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f index 54c2d95b..0eaad715 100644 --- a/src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f +++ b/plugins/local/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f @@ -200,7 +200,7 @@ subroutine overlap_gauss_r12_v(D_center, LD_D, delta, A_center, B_center, power_ deallocate(A_new, A_center_new, fact_a_new, iorder_a_new, overlap) -end subroutine overlap_gauss_r12_v +end !--- diff --git a/src/ao_many_one_e_ints/stg_gauss_int.irp.f b/plugins/local/ao_many_one_e_ints/stg_gauss_int.irp.f similarity index 100% rename from src/ao_many_one_e_ints/stg_gauss_int.irp.f rename to plugins/local/ao_many_one_e_ints/stg_gauss_int.irp.f diff --git a/src/ao_many_one_e_ints/taylor_exp.irp.f b/plugins/local/ao_many_one_e_ints/taylor_exp.irp.f similarity index 100% rename from src/ao_many_one_e_ints/taylor_exp.irp.f rename to plugins/local/ao_many_one_e_ints/taylor_exp.irp.f diff --git a/src/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f b/plugins/local/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f similarity index 100% rename from src/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f rename to plugins/local/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f diff --git a/src/ao_tc_eff_map/NEED b/plugins/local/ao_tc_eff_map/NEED similarity index 78% rename from src/ao_tc_eff_map/NEED rename to plugins/local/ao_tc_eff_map/NEED index f768b75f..b12b0999 100644 --- a/src/ao_tc_eff_map/NEED +++ b/plugins/local/ao_tc_eff_map/NEED @@ -3,3 +3,5 @@ mo_one_e_ints ao_many_one_e_ints dft_utils_in_r tc_keywords +hamiltonian +jastrow diff --git a/src/ao_tc_eff_map/README.rst b/plugins/local/ao_tc_eff_map/README.rst similarity index 100% rename from src/ao_tc_eff_map/README.rst rename to plugins/local/ao_tc_eff_map/README.rst diff --git a/src/ao_tc_eff_map/compute_ints_eff_pot.irp.f b/plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f similarity index 82% rename from src/ao_tc_eff_map/compute_ints_eff_pot.irp.f rename to plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f index 963a49a6..8097cbc2 100644 --- a/src/ao_tc_eff_map/compute_ints_eff_pot.irp.f +++ b/plugins/local/ao_tc_eff_map/compute_ints_eff_pot.irp.f @@ -23,10 +23,9 @@ subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_va logical, external :: ao_two_e_integral_zero double precision :: ao_tc_sym_two_e_pot, ao_two_e_integral_erf - double precision :: j1b_gauss_2e_j1, j1b_gauss_2e_j2 + double precision :: env_gauss_2e_j1, env_gauss_2e_j2 - PROVIDE j1b_type thr = ao_integrals_threshold @@ -53,14 +52,6 @@ subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_va integral_erf = ao_two_e_integral_erf(i, k, j, l) integral = integral_erf + integral_pot - !if( j1b_type .eq. 1 ) then - ! !print *, ' j1b type 1 is added' - ! integral = integral + j1b_gauss_2e_j1(i, k, j, l) - !elseif( j1b_type .eq. 2 ) then - ! !print *, ' j1b type 2 is added' - ! integral = integral + j1b_gauss_2e_j2(i, k, j, l) - !endif - if(abs(integral) < thr) then cycle endif diff --git a/src/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f b/plugins/local/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f similarity index 100% rename from src/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f rename to plugins/local/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f diff --git a/src/ao_tc_eff_map/map_integrals_eff_pot.irp.f b/plugins/local/ao_tc_eff_map/map_integrals_eff_pot.irp.f similarity index 100% rename from src/ao_tc_eff_map/map_integrals_eff_pot.irp.f rename to plugins/local/ao_tc_eff_map/map_integrals_eff_pot.irp.f diff --git a/src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f similarity index 65% rename from src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f rename to plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f index 50c396de..bcd2a9a5 100644 --- a/src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f +++ b/plugins/local/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f @@ -1,10 +1,10 @@ ! --- -BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] +BEGIN_PROVIDER [double precision, env_gauss_hermII, (ao_num,ao_num)] BEGIN_DOC ! - ! :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle` + ! :math:`\langle \chi_A | -0.5 \grad \tau_{env} \cdot \grad \tau_{env} | \chi_B \rangle` ! END_DOC @@ -22,8 +22,6 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] double precision :: int_gauss_4G - PROVIDE j1b_type j1b_pen j1b_coeff - ! -------------------------------------------------------------------------------- ! -- Dummy call to provide everything dim1 = 100 @@ -38,10 +36,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] ! -------------------------------------------------------------------------------- - j1b_gauss_hermII(1:ao_num,1:ao_num) = 0.d0 - - if(j1b_type .eq. 1) then - ! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)] + env_gauss_hermII(1:ao_num,1:ao_num) = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -51,113 +46,51 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & !$OMP ao_power, ao_nucl, nucl_coord, & !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_hermII) + !$OMP nucl_num, env_expo, env_gauss_hermII) !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k1 = 1, nucl_num - gama1 = j1b_pen(k1) - C_center1(1:3) = nucl_coord(k1,1:3) - - do k2 = 1, nucl_num - gama2 = j1b_pen(k2) - C_center2(1:3) = nucl_coord(k2,1:3) - - ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB > - c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2 & - , power_A, power_B, alpha, beta, gama1, gama2 ) - - c = c - 2.d0 * gama1 * gama2 * c1 - enddo + do j = 1, ao_num + num_A = ao_nucl(j) + power_A(1:3) = ao_power(j,1:3) + A_center(1:3) = nucl_coord(num_A,1:3) + + do i = 1, ao_num + num_B = ao_nucl(i) + power_B(1:3) = ao_power(i,1:3) + B_center(1:3) = nucl_coord(num_B,1:3) + + do l = 1, ao_prim_num(j) + alpha = ao_expo_ordered_transp(l,j) + + do m = 1, ao_prim_num(i) + beta = ao_expo_ordered_transp(m,i) + + c = 0.d0 + do k1 = 1, nucl_num + gama1 = env_expo(k1) + C_center1(1:3) = nucl_coord(k1,1:3) + + do k2 = 1, nucl_num + gama2 = env_expo(k2) + C_center2(1:3) = nucl_coord(k2,1:3) + + ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB > + c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2 & + , power_A, power_B, alpha, beta, gama1, gama2 ) + + c = c - 2.d0 * gama1 * gama2 * c1 enddo - - j1b_gauss_hermII(i,j) = j1b_gauss_hermII(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c enddo + + env_gauss_hermII(i,j) = env_gauss_hermII(i,j) & + + ao_coef_normalized_ordered_transp(l,j) & + * ao_coef_normalized_ordered_transp(m,i) * c enddo enddo enddo + enddo !$OMP END DO !$OMP END PARALLEL - elseif(j1b_type .eq. 2) then - ! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)] - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, k1, k2, l, m, alpha, beta, gama1, gama2, & - !$OMP A_center, B_center, C_center1, C_center2, & - !$OMP power_A, power_B, num_A, num_B, c1, c, & - !$OMP coef1, coef2) & - !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & - !$OMP ao_power, ao_nucl, nucl_coord, & - !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_hermII, & - !$OMP j1b_coeff) - !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k1 = 1, nucl_num - gama1 = j1b_pen (k1) - coef1 = j1b_coeff(k1) - C_center1(1:3) = nucl_coord(k1,1:3) - - do k2 = 1, nucl_num - gama2 = j1b_pen (k2) - coef2 = j1b_coeff(k2) - C_center2(1:3) = nucl_coord(k2,1:3) - - ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB > - c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2 & - , power_A, power_B, alpha, beta, gama1, gama2 ) - - c = c - 2.d0 * gama1 * gama2 * coef1 * coef2 * c1 - enddo - enddo - - j1b_gauss_hermII(i,j) = j1b_gauss_hermII(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c - enddo - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - endif - END_PROVIDER diff --git a/src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f similarity index 62% rename from src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f rename to plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f index 0a0b7610..6c9365c9 100644 --- a/src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f +++ b/plugins/local/ao_tc_eff_map/one_e_1bgauss_lap.irp.f @@ -1,10 +1,10 @@ ! --- -BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] +BEGIN_PROVIDER [double precision, env_gauss_hermI, (ao_num,ao_num)] BEGIN_DOC ! - ! :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \rangle` + ! :math:`\langle \chi_A | -0.5 \Delta \tau_{env} | \chi_B \rangle` ! END_DOC @@ -22,8 +22,6 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] double precision :: int_gauss_r0, int_gauss_r2 - PROVIDE j1b_type j1b_pen j1b_coeff - ! -------------------------------------------------------------------------------- ! -- Dummy call to provide everything dim1 = 100 @@ -37,10 +35,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] , overlap_y, d_a_2, overlap_z, overlap, dim1 ) ! -------------------------------------------------------------------------------- - j1b_gauss_hermI(1:ao_num,1:ao_num) = 0.d0 - - if(j1b_type .eq. 1) then - ! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)] + env_gauss_hermI(1:ao_num,1:ao_num) = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -50,109 +45,50 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & !$OMP ao_power, ao_nucl, nucl_coord, & !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_hermI) + !$OMP nucl_num, env_expo, env_gauss_hermI) !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k = 1, nucl_num - gama = j1b_pen(k) - C_center(1:3) = nucl_coord(k,1:3) - - ! < XA | exp[-gama r_C^2] | XB > - c1 = int_gauss_r0( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - ! < XA | r_A^2 exp[-gama r_C^2] | XB > - c2 = int_gauss_r2( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - c = c + 3.d0 * gama * c1 - 2.d0 * gama * gama * c2 - enddo - - j1b_gauss_hermI(i,j) = j1b_gauss_hermI(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c + do j = 1, ao_num + num_A = ao_nucl(j) + power_A(1:3) = ao_power(j,1:3) + A_center(1:3) = nucl_coord(num_A,1:3) + + do i = 1, ao_num + num_B = ao_nucl(i) + power_B(1:3) = ao_power(i,1:3) + B_center(1:3) = nucl_coord(num_B,1:3) + + do l = 1, ao_prim_num(j) + alpha = ao_expo_ordered_transp(l,j) + + do m = 1, ao_prim_num(i) + beta = ao_expo_ordered_transp(m,i) + + c = 0.d0 + do k = 1, nucl_num + gama = env_expo(k) + C_center(1:3) = nucl_coord(k,1:3) + + ! < XA | exp[-gama r_C^2] | XB > + c1 = int_gauss_r0( A_center, B_center, C_center & + , power_A, power_B, alpha, beta, gama ) + + ! < XA | r_A^2 exp[-gama r_C^2] | XB > + c2 = int_gauss_r2( A_center, B_center, C_center & + , power_A, power_B, alpha, beta, gama ) + + c = c + 3.d0 * gama * c1 - 2.d0 * gama * gama * c2 enddo + + env_gauss_hermI(i,j) = env_gauss_hermI(i,j) & + + ao_coef_normalized_ordered_transp(l,j) & + * ao_coef_normalized_ordered_transp(m,i) * c enddo enddo enddo + enddo !$OMP END DO !$OMP END PARALLEL - elseif(j1b_type .eq. 2) then - ! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)] - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, coef, & - !$OMP A_center, B_center, C_center, power_A, power_B, & - !$OMP num_A, num_B, c1, c2, c) & - !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & - !$OMP ao_power, ao_nucl, nucl_coord, & - !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_hermI, & - !$OMP j1b_coeff) - !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k = 1, nucl_num - gama = j1b_pen (k) - coef = j1b_coeff(k) - C_center(1:3) = nucl_coord(k,1:3) - - ! < XA | exp[-gama r_C^2] | XB > - c1 = int_gauss_r0( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - ! < XA | r_A^2 exp[-gama r_C^2] | XB > - c2 = int_gauss_r2( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - c = c + 3.d0 * gama * coef * c1 - 2.d0 * gama * gama * coef * c2 - enddo - - j1b_gauss_hermI(i,j) = j1b_gauss_hermI(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c - enddo - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - endif - END_PROVIDER diff --git a/src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f b/plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f similarity index 71% rename from src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f rename to plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f index bd881d32..0ff23716 100644 --- a/src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f +++ b/plugins/local/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f @@ -1,10 +1,11 @@ + ! --- -BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] +BEGIN_PROVIDER [double precision, env_gauss_nonherm, (ao_num,ao_num)] BEGIN_DOC ! - ! j1b_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{1b} \cdot grad | \chi_i \rangle + ! env_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{env} \cdot grad | \chi_i \rangle ! END_DOC @@ -22,8 +23,6 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] double precision :: int_gauss_deriv - PROVIDE j1b_type j1b_pen j1b_coeff - ! -------------------------------------------------------------------------------- ! -- Dummy call to provide everything dim1 = 100 @@ -38,10 +37,8 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] ! -------------------------------------------------------------------------------- - j1b_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0 + env_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0 - if(j1b_type .eq. 1) then - ! \tau_1b = \sum_iA -[1 - exp(-alpha_A r_iA^2)] !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -51,101 +48,46 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & !$OMP ao_power, ao_nucl, nucl_coord, & !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_nonherm) + !$OMP nucl_num, env_expo, env_gauss_nonherm) !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k = 1, nucl_num - gama = j1b_pen(k) - C_center(1:3) = nucl_coord(k,1:3) - - ! \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle - c1 = int_gauss_deriv( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - c = c + 2.d0 * gama * c1 - enddo - - j1b_gauss_nonherm(i,j) = j1b_gauss_nonherm(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c + do j = 1, ao_num + num_A = ao_nucl(j) + power_A(1:3) = ao_power(j,1:3) + A_center(1:3) = nucl_coord(num_A,1:3) + + do i = 1, ao_num + num_B = ao_nucl(i) + power_B(1:3) = ao_power(i,1:3) + B_center(1:3) = nucl_coord(num_B,1:3) + + do l = 1, ao_prim_num(j) + alpha = ao_expo_ordered_transp(l,j) + + do m = 1, ao_prim_num(i) + beta = ao_expo_ordered_transp(m,i) + + c = 0.d0 + do k = 1, nucl_num + gama = env_expo(k) + C_center(1:3) = nucl_coord(k,1:3) + + ! \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle + c1 = int_gauss_deriv( A_center, B_center, C_center & + , power_A, power_B, alpha, beta, gama ) + + c = c + 2.d0 * gama * c1 enddo + + env_gauss_nonherm(i,j) = env_gauss_nonherm(i,j) & + + ao_coef_normalized_ordered_transp(l,j) & + * ao_coef_normalized_ordered_transp(m,i) * c enddo enddo enddo + enddo !$OMP END DO !$OMP END PARALLEL - elseif(j1b_type .eq. 2) then - ! \tau_1b = \sum_iA [c_A exp(-alpha_A r_iA^2)] - - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, coef, & - !$OMP A_center, B_center, C_center, power_A, power_B, & - !$OMP num_A, num_B, c1, c) & - !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp, & - !$OMP ao_power, ao_nucl, nucl_coord, & - !$OMP ao_coef_normalized_ordered_transp, & - !$OMP nucl_num, j1b_pen, j1b_gauss_nonherm, & - !$OMP j1b_coeff) - !$OMP DO SCHEDULE (dynamic) - do j = 1, ao_num - num_A = ao_nucl(j) - power_A(1:3) = ao_power(j,1:3) - A_center(1:3) = nucl_coord(num_A,1:3) - - do i = 1, ao_num - num_B = ao_nucl(i) - power_B(1:3) = ao_power(i,1:3) - B_center(1:3) = nucl_coord(num_B,1:3) - - do l = 1, ao_prim_num(j) - alpha = ao_expo_ordered_transp(l,j) - - do m = 1, ao_prim_num(i) - beta = ao_expo_ordered_transp(m,i) - - c = 0.d0 - do k = 1, nucl_num - gama = j1b_pen (k) - coef = j1b_coeff(k) - C_center(1:3) = nucl_coord(k,1:3) - - ! \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle - c1 = int_gauss_deriv( A_center, B_center, C_center & - , power_A, power_B, alpha, beta, gama ) - - c = c + 2.d0 * gama * coef * c1 - enddo - - j1b_gauss_nonherm(i,j) = j1b_gauss_nonherm(i,j) & - + ao_coef_normalized_ordered_transp(l,j) & - * ao_coef_normalized_ordered_transp(m,i) * c - enddo - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - endif - END_PROVIDER diff --git a/src/ao_tc_eff_map/providers_ao_eff_pot.irp.f b/plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f similarity index 96% rename from src/ao_tc_eff_map/providers_ao_eff_pot.irp.f rename to plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f index 055bf323..1c454e40 100644 --- a/src/ao_tc_eff_map/providers_ao_eff_pot.irp.f +++ b/plugins/local/ao_tc_eff_map/providers_ao_eff_pot.irp.f @@ -22,9 +22,6 @@ BEGIN_PROVIDER [ logical, ao_tc_sym_two_e_pot_in_map ] integer :: kk, m, j1, i1, lmax character*(64) :: fmt - !double precision :: j1b_gauss_coul_debug - !integral = j1b_gauss_coul_debug(1,1,1,1) - integral = ao_tc_sym_two_e_pot(1,1,1,1) double precision :: map_mb diff --git a/src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f similarity index 98% rename from src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f rename to plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f index c36ee9b4..572406e2 100644 --- a/src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f +++ b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j1.irp.f @@ -1,6 +1,6 @@ ! --- -double precision function j1b_gauss_2e_j1(i, j, k, l) +double precision function env_gauss_2e_j1(i, j, k, l) BEGIN_DOC ! @@ -36,10 +36,10 @@ double precision function j1b_gauss_2e_j1(i, j, k, l) double precision :: I_center(3), J_center(3), K_center(3), L_center(3) double precision :: ff, gg, cx, cy, cz - double precision :: j1b_gauss_2e_j1_schwartz + double precision :: env_gauss_2e_j1_schwartz if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then - j1b_gauss_2e_j1 = j1b_gauss_2e_j1_schwartz(i, j, k, l) + env_gauss_2e_j1 = env_gauss_2e_j1_schwartz(i, j, k, l) return endif @@ -59,7 +59,7 @@ double precision function j1b_gauss_2e_j1(i, j, k, l) L_center(p) = nucl_coord(num_l,p) enddo - j1b_gauss_2e_j1 = 0.d0 + env_gauss_2e_j1 = 0.d0 do p = 1, ao_prim_num(i) coef1 = ao_coef_normalized_ordered_transp(p, i) @@ -89,18 +89,18 @@ double precision function j1b_gauss_2e_j1(i, j, k, l) , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_2e_j1 = j1b_gauss_2e_j1 + coef4 * ( cx + cy + cz ) + env_gauss_2e_j1 = env_gauss_2e_j1 + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q enddo ! p return -end function j1b_gauss_2e_j1 +end ! --- -double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) +double precision function env_gauss_2e_j1_schwartz(i, j, k, l) BEGIN_DOC ! @@ -137,8 +137,6 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) double precision :: schwartz_ij, thr double precision, allocatable :: schwartz_kl(:,:) - PROVIDE j1b_pen - dim1 = n_pt_max_integrals thr = ao_integrals_threshold * ao_integrals_threshold @@ -186,8 +184,7 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) schwartz_kl(0,0) = max( schwartz_kl(0,r) , schwartz_kl(0,0) ) enddo - - j1b_gauss_2e_j1_schwartz = 0.d0 + env_gauss_2e_j1_schwartz = 0.d0 do p = 1, ao_prim_num(i) expo1 = ao_expo_ordered_transp(p, i) @@ -226,7 +223,7 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_2e_j1_schwartz = j1b_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz ) + env_gauss_2e_j1_schwartz = env_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q @@ -235,7 +232,7 @@ double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) deallocate( schwartz_kl ) return -end function j1b_gauss_2e_j1_schwartz +end ! --- @@ -263,14 +260,12 @@ subroutine get_cxcycz_j1( dim1, cx, cy, cz & double precision :: general_primitive_integral_erf_shifted double precision :: general_primitive_integral_coul_shifted - PROVIDE j1b_pen - cx = 0.d0 cy = 0.d0 cz = 0.d0 do ii = 1, nucl_num - expoii = j1b_pen(ii) + expoii = env_expo(ii) Centerii(1:3) = nucl_coord(ii, 1:3) call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center) diff --git a/src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f similarity index 98% rename from src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f rename to plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f index a61b5336..a04656c3 100644 --- a/src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f +++ b/plugins/local/ao_tc_eff_map/two_e_1bgauss_j2.irp.f @@ -1,6 +1,6 @@ ! --- -double precision function j1b_gauss_2e_j2(i, j, k, l) +double precision function env_gauss_2e_j2(i, j, k, l) BEGIN_DOC ! @@ -36,12 +36,12 @@ double precision function j1b_gauss_2e_j2(i, j, k, l) double precision :: I_center(3), J_center(3), K_center(3), L_center(3) double precision :: ff, gg, cx, cy, cz - double precision :: j1b_gauss_2e_j2_schwartz + double precision :: env_gauss_2e_j2_schwartz dim1 = n_pt_max_integrals if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then - j1b_gauss_2e_j2 = j1b_gauss_2e_j2_schwartz(i, j, k, l) + env_gauss_2e_j2 = env_gauss_2e_j2_schwartz(i, j, k, l) return endif @@ -61,7 +61,7 @@ double precision function j1b_gauss_2e_j2(i, j, k, l) L_center(p) = nucl_coord(num_l,p) enddo - j1b_gauss_2e_j2 = 0.d0 + env_gauss_2e_j2 = 0.d0 do p = 1, ao_prim_num(i) coef1 = ao_coef_normalized_ordered_transp(p, i) @@ -91,18 +91,18 @@ double precision function j1b_gauss_2e_j2(i, j, k, l) , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_2e_j2 = j1b_gauss_2e_j2 + coef4 * ( cx + cy + cz ) + env_gauss_2e_j2 = env_gauss_2e_j2 + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q enddo ! p return -end function j1b_gauss_2e_j2 +end ! --- -double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) +double precision function env_gauss_2e_j2_schwartz(i, j, k, l) BEGIN_DOC ! @@ -187,7 +187,7 @@ double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) enddo - j1b_gauss_2e_j2_schwartz = 0.d0 + env_gauss_2e_j2_schwartz = 0.d0 do p = 1, ao_prim_num(i) expo1 = ao_expo_ordered_transp(p, i) @@ -226,7 +226,7 @@ double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_2e_j2_schwartz = j1b_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz ) + env_gauss_2e_j2_schwartz = env_gauss_2e_j2_schwartz + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q @@ -235,7 +235,7 @@ double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) deallocate( schwartz_kl ) return -end function j1b_gauss_2e_j2_schwartz +end ! --- @@ -263,15 +263,13 @@ subroutine get_cxcycz_j2( dim1, cx, cy, cz & double precision :: general_primitive_integral_erf_shifted double precision :: general_primitive_integral_coul_shifted - PROVIDE j1b_pen j1b_coeff - cx = 0.d0 cy = 0.d0 cz = 0.d0 do ii = 1, nucl_num - expoii = j1b_pen (ii) - coefii = j1b_coeff(ii) + expoii = env_expo(ii) + coefii = env_coef(ii) Centerii(1:3) = nucl_coord(ii, 1:3) call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center) diff --git a/src/ao_tc_eff_map/two_e_ints_gauss.irp.f b/plugins/local/ao_tc_eff_map/two_e_ints_gauss.irp.f similarity index 100% rename from src/ao_tc_eff_map/two_e_ints_gauss.irp.f rename to plugins/local/ao_tc_eff_map/two_e_ints_gauss.irp.f diff --git a/src/ao_tc_eff_map/useful_sub.irp.f b/plugins/local/ao_tc_eff_map/useful_sub.irp.f similarity index 92% rename from src/ao_tc_eff_map/useful_sub.irp.f rename to plugins/local/ao_tc_eff_map/useful_sub.irp.f index 4cfdcad2..4c5efac1 100644 --- a/src/ao_tc_eff_map/useful_sub.irp.f +++ b/plugins/local/ao_tc_eff_map/useful_sub.irp.f @@ -174,7 +174,7 @@ double precision function general_primitive_integral_coul_shifted( dim general_primitive_integral_coul_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q) return -end function general_primitive_integral_coul_shifted +end !______________________________________________________________________________________________________________________ !______________________________________________________________________________________________________________________ @@ -354,7 +354,7 @@ double precision function general_primitive_integral_erf_shifted( dim general_primitive_integral_erf_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q) return -end function general_primitive_integral_erf_shifted +end !______________________________________________________________________________________________________________________ !______________________________________________________________________________________________________________________ @@ -362,3 +362,48 @@ end function general_primitive_integral_erf_shifted + +! --- + +subroutine inv_r_times_poly(r, dist_r, dist_vec, poly) + + BEGIN_DOC + ! + ! returns + ! + ! poly(1) = x / sqrt(x^2+y^2+z^2), poly(2) = y / sqrt(x^2+y^2+z^2), poly(3) = z / sqrt(x^2+y^2+z^2) + ! + ! with the arguments + ! + ! r(1) = x, r(2) = y, r(3) = z, dist_r = sqrt(x^2+y^2+z^2) + ! + ! dist_vec(1) = sqrt(y^2+z^2), dist_vec(2) = sqrt(x^2+z^2), dist_vec(3) = sqrt(x^2+y^2) + ! + END_DOC + + implicit none + double precision, intent(in) :: r(3), dist_r, dist_vec(3) + double precision, intent(out) :: poly(3) + integer :: i + double precision :: inv_dist + + if (dist_r .gt. 1.d-8)then + inv_dist = 1.d0/dist_r + do i = 1, 3 + poly(i) = r(i) * inv_dist + enddo + else + do i = 1, 3 + if(dabs(r(i)).lt.dist_vec(i)) then + inv_dist = 1.d0/dist_r + poly(i) = r(i) * inv_dist + else + poly(i) = 1.d0 + endif + enddo + endif + +end + +! --- + diff --git a/src/basis_correction/51.basis_c.bats b/plugins/local/basis_correction/51.basis_c.bats similarity index 100% rename from src/basis_correction/51.basis_c.bats rename to plugins/local/basis_correction/51.basis_c.bats diff --git a/src/basis_correction/NEED b/plugins/local/basis_correction/NEED similarity index 100% rename from src/basis_correction/NEED rename to plugins/local/basis_correction/NEED diff --git a/src/basis_correction/README.rst b/plugins/local/basis_correction/README.rst similarity index 94% rename from src/basis_correction/README.rst rename to plugins/local/basis_correction/README.rst index 311fec1c..7669a9b2 100644 --- a/src/basis_correction/README.rst +++ b/plugins/local/basis_correction/README.rst @@ -12,7 +12,7 @@ This basis set correction relies mainy on : When HF is a qualitative representation of the electron pairs (i.e. weakly correlated systems), such an approach for \mu(r) is OK. See for instance JPCL, 10, 2931-2937 (2019) for typical flavours of the results. Thanks to the trivial nature of such a two-body rdm, the equation (22) of J. Chem. Phys. 149, 194301 (2018) can be rewritten in a very efficient way, and therefore the limiting factor of such an approach is the AO->MO four-index transformation of the two-electron integrals. - b) "mu_of_r_potential = cas_ful" uses the two-body rdm of CAS-like wave function (i.e. linear combination of Slater determinants developped in an active space with the MOs stored in the EZFIO folder). + b) "mu_of_r_potential = cas_full" uses the two-body rdm of CAS-like wave function (i.e. linear combination of Slater determinants developped in an active space with the MOs stored in the EZFIO folder). If the CAS is properly chosen (i.e. the CAS-like wave function qualitatively represents the wave function of the systems), then such an approach is OK for \mu(r) even in the case of strong correlation. +) The use of DFT correlation functionals with multi-determinant reference (Ecmd). These functionals are originally defined in the RS-DFT framework (see for instance Theor. Chem. Acc.114, 305(2005)) and design to capture short-range correlation effects. A important quantity arising in the Ecmd is the exact on-top pair density of the system, and the main differences of approximated Ecmd relies on different approximations for the exact on-top pair density. diff --git a/src/basis_correction/TODO b/plugins/local/basis_correction/TODO similarity index 100% rename from src/basis_correction/TODO rename to plugins/local/basis_correction/TODO diff --git a/src/basis_correction/basis_correction.irp.f b/plugins/local/basis_correction/basis_correction.irp.f similarity index 100% rename from src/basis_correction/basis_correction.irp.f rename to plugins/local/basis_correction/basis_correction.irp.f diff --git a/src/basis_correction/eff_xi_based_func.irp.f b/plugins/local/basis_correction/eff_xi_based_func.irp.f similarity index 100% rename from src/basis_correction/eff_xi_based_func.irp.f rename to plugins/local/basis_correction/eff_xi_based_func.irp.f diff --git a/src/basis_correction/pbe_on_top.irp.f b/plugins/local/basis_correction/pbe_on_top.irp.f similarity index 98% rename from src/basis_correction/pbe_on_top.irp.f rename to plugins/local/basis_correction/pbe_on_top.irp.f index 9167f459..be3a23d7 100644 --- a/src/basis_correction/pbe_on_top.irp.f +++ b/plugins/local/basis_correction/pbe_on_top.irp.f @@ -39,7 +39,7 @@ grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate) grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate) - if(mu_of_r_potential == "cas_ful")then + if(mu_of_r_potential == "cas_full")then ! You take the on-top of the CAS wave function which is computed with mu(r) on_top = on_top_cas_mu_r(ipoint,istate) else @@ -101,7 +101,7 @@ grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate) grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate) - if(mu_of_r_potential == "cas_ful")then + if(mu_of_r_potential == "cas_full")then ! You take the on-top of the CAS wave function which is computed with mu(r) on_top = on_top_cas_mu_r(ipoint,istate) else @@ -163,7 +163,7 @@ grad_rho_a(1:3) = one_e_dm_and_grad_alpha_in_r(1:3,ipoint,istate) grad_rho_b(1:3) = one_e_dm_and_grad_beta_in_r(1:3,ipoint,istate) - if(mu_of_r_potential == "cas_ful")then + if(mu_of_r_potential == "cas_full")then ! You take the on-top of the CAS wave function which is computed with mu(r) on_top = on_top_cas_mu_r(ipoint,istate) else diff --git a/src/basis_correction/print_routine.irp.f b/plugins/local/basis_correction/print_routine.irp.f similarity index 91% rename from src/basis_correction/print_routine.irp.f rename to plugins/local/basis_correction/print_routine.irp.f index c2558d22..96faba30 100644 --- a/src/basis_correction/print_routine.irp.f +++ b/plugins/local/basis_correction/print_routine.irp.f @@ -4,8 +4,8 @@ subroutine print_basis_correction provide mu_average_prov if(mu_of_r_potential.EQ."hf")then provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r - else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated")then - provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r + else if(mu_of_r_potential.EQ."cas_full".or.mu_of_r_potential.EQ."cas_truncated")then + provide ecmd_lda_mu_of_r ecmd_pbe_ueg_mu_of_r provide ecmd_pbe_on_top_mu_of_r ecmd_pbe_on_top_su_mu_of_r endif @@ -25,7 +25,7 @@ subroutine print_basis_correction if(mu_of_r_potential.EQ."hf")then print*, '' print*,'Using a HF-like two-body density to define mu(r)' - print*,'This assumes that HF is a qualitative representation of the wave function ' + print*,'This assumes that HF is a qualitative representation of the wave function ' print*,'********************************************' print*,'Functionals more suited for weak correlation' print*,'********************************************' @@ -38,10 +38,10 @@ subroutine print_basis_correction write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-UEG , state ',istate,' = ',ecmd_pbe_ueg_mu_of_r(istate) enddo - else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then + else if(mu_of_r_potential.EQ."cas_full".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then print*, '' print*,'Using a CAS-like two-body density to define mu(r)' - print*,'This assumes that the CAS is a qualitative representation of the wave function ' + print*,'This assumes that the CAS is a qualitative representation of the wave function ' print*,'********************************************' print*,'Functionals more suited for weak correlation' print*,'********************************************' @@ -56,14 +56,14 @@ subroutine print_basis_correction print*,'' print*,'********************************************' print*,'********************************************' - print*,'+) PBE-on-top Ecmd functional : JCP, 152, 174104 (2020) ' + print*,'+) PBE-on-top Ecmd functional : JCP, 152, 174104 (2020) ' print*,'PBE at mu=0, extrapolated ontop pair density at large mu, usual spin-polarization' do istate = 1, N_states write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD PBE-OT , state ',istate,' = ',ecmd_pbe_on_top_mu_of_r(istate) enddo print*,'' print*,'********************************************' - print*,'+) PBE-on-top no spin polarization Ecmd functional : JCP, 152, 174104 (2020)' + print*,'+) PBE-on-top no spin polarization Ecmd functional : JCP, 152, 174104 (2020)' print*,'PBE at mu=0, extrapolated ontop pair density at large mu, and ZERO SPIN POLARIZATION' do istate = 1, N_states write(*, '(A29,X,I3,X,A3,X,F16.10)') ' ECMD SU-PBE-OT , state ',istate,' = ',ecmd_pbe_on_top_su_mu_of_r(istate) diff --git a/src/basis_correction/print_su_pbe_ot.irp.f b/plugins/local/basis_correction/print_su_pbe_ot.irp.f similarity index 100% rename from src/basis_correction/print_su_pbe_ot.irp.f rename to plugins/local/basis_correction/print_su_pbe_ot.irp.f diff --git a/src/basis_correction/weak_corr_func.irp.f b/plugins/local/basis_correction/weak_corr_func.irp.f similarity index 100% rename from src/basis_correction/weak_corr_func.irp.f rename to plugins/local/basis_correction/weak_corr_func.irp.f diff --git a/src/bi_ort_ints/NEED b/plugins/local/bi_ort_ints/NEED similarity index 100% rename from src/bi_ort_ints/NEED rename to plugins/local/bi_ort_ints/NEED diff --git a/src/bi_ort_ints/README.rst b/plugins/local/bi_ort_ints/README.rst similarity index 100% rename from src/bi_ort_ints/README.rst rename to plugins/local/bi_ort_ints/README.rst diff --git a/src/bi_ort_ints/bi_ort_ints.irp.f b/plugins/local/bi_ort_ints/bi_ort_ints.irp.f similarity index 100% rename from src/bi_ort_ints/bi_ort_ints.irp.f rename to plugins/local/bi_ort_ints/bi_ort_ints.irp.f diff --git a/src/bi_ort_ints/biorthog_mo_for_h.irp.f b/plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f similarity index 80% rename from src/bi_ort_ints/biorthog_mo_for_h.irp.f rename to plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f index 452c13f1..613a684f 100644 --- a/src/bi_ort_ints/biorthog_mo_for_h.irp.f +++ b/plugins/local/bi_ort_ints/biorthog_mo_for_h.irp.f @@ -1,4 +1,39 @@ + +! --- + +BEGIN_PROVIDER [double precision, ao_two_e_coul, (ao_num, ao_num, ao_num, ao_num) ] + + BEGIN_DOC + ! + ! ao_two_e_coul(k,i,l,j) = ( k i | 1/r12 | l j ) = < l k | 1/r12 | j i > + ! + END_DOC + + integer :: i, j, k, l + double precision, external :: get_ao_two_e_integral + + PROVIDE ao_integrals_map + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(ao_num, ao_two_e_coul, ao_integrals_map) & + !$OMP PRIVATE(i, j, k, l) + !$OMP DO + do j = 1, ao_num + do l = 1, ao_num + do i = 1, ao_num + do k = 1, ao_num + ! < 1:k, 2:l | 1:i, 2:j > + ao_two_e_coul(k,i,l,j) = get_ao_two_e_integral(i, j, k, l, ao_integrals_map) + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + +END_PROVIDER + ! --- double precision function bi_ortho_mo_coul_ints(l, k, j, i) @@ -25,7 +60,7 @@ double precision function bi_ortho_mo_coul_ints(l, k, j, i) enddo enddo -end function bi_ortho_mo_coul_ints +end ! --- diff --git a/src/bi_ort_ints/no_dressing.irp.f b/plugins/local/bi_ort_ints/no_dressing.irp.f similarity index 100% rename from src/bi_ort_ints/no_dressing.irp.f rename to plugins/local/bi_ort_ints/no_dressing.irp.f diff --git a/src/bi_ort_ints/no_dressing_energy.irp.f b/plugins/local/bi_ort_ints/no_dressing_energy.irp.f similarity index 100% rename from src/bi_ort_ints/no_dressing_energy.irp.f rename to plugins/local/bi_ort_ints/no_dressing_energy.irp.f diff --git a/src/bi_ort_ints/no_dressing_naive.irp.f b/plugins/local/bi_ort_ints/no_dressing_naive.irp.f similarity index 100% rename from src/bi_ort_ints/no_dressing_naive.irp.f rename to plugins/local/bi_ort_ints/no_dressing_naive.irp.f diff --git a/src/bi_ort_ints/one_e_bi_ort.irp.f b/plugins/local/bi_ort_ints/one_e_bi_ort.irp.f similarity index 83% rename from src/bi_ort_ints/one_e_bi_ort.irp.f rename to plugins/local/bi_ort_ints/one_e_bi_ort.irp.f index 0ecc2a84..85cae273 100644 --- a/src/bi_ort_ints/one_e_bi_ort.irp.f +++ b/plugins/local/bi_ort_ints/one_e_bi_ort.irp.f @@ -8,23 +8,6 @@ BEGIN_PROVIDER [double precision, ao_one_e_integrals_tc_tot, (ao_num,ao_num)] ao_one_e_integrals_tc_tot = ao_one_e_integrals - !provide j1b_type - - !if( (j1b_type .eq. 1) .or. (j1b_type .eq. 2) ) then - ! - ! print *, ' do things properly !' - ! stop - - ! !do i = 1, ao_num - ! ! do j = 1, ao_num - ! ! ao_one_e_integrals_tc_tot(j,i) += ( j1b_gauss_hermI (j,i) & - ! ! + j1b_gauss_hermII (j,i) & - ! ! + j1b_gauss_nonherm(j,i) ) - ! ! enddo - ! !enddo - - !endif - END_PROVIDER ! --- diff --git a/src/bi_ort_ints/semi_num_ints_mo.irp.f b/plugins/local/bi_ort_ints/semi_num_ints_mo.irp.f similarity index 100% rename from src/bi_ort_ints/semi_num_ints_mo.irp.f rename to plugins/local/bi_ort_ints/semi_num_ints_mo.irp.f diff --git a/src/bi_ort_ints/three_body_ijm.irp.f b/plugins/local/bi_ort_ints/three_body_ijm.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijm.irp.f rename to plugins/local/bi_ort_ints/three_body_ijm.irp.f diff --git a/src/bi_ort_ints/three_body_ijmk.irp.f b/plugins/local/bi_ort_ints/three_body_ijmk.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmk.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmk.irp.f diff --git a/src/bi_ort_ints/three_body_ijmk_n4.irp.f b/plugins/local/bi_ort_ints/three_body_ijmk_n4.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmk_n4.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmk_n4.irp.f diff --git a/src/bi_ort_ints/three_body_ijmk_old.irp.f b/plugins/local/bi_ort_ints/three_body_ijmk_old.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmk_old.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmk_old.irp.f diff --git a/src/bi_ort_ints/three_body_ijmkl.irp.f b/plugins/local/bi_ort_ints/three_body_ijmkl.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmkl.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmkl.irp.f diff --git a/src/bi_ort_ints/three_body_ijmkl_old.irp.f b/plugins/local/bi_ort_ints/three_body_ijmkl_old.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ijmkl_old.irp.f rename to plugins/local/bi_ort_ints/three_body_ijmkl_old.irp.f diff --git a/src/bi_ort_ints/three_body_ints_bi_ort.irp.f b/plugins/local/bi_ort_ints/three_body_ints_bi_ort.irp.f similarity index 100% rename from src/bi_ort_ints/three_body_ints_bi_ort.irp.f rename to plugins/local/bi_ort_ints/three_body_ints_bi_ort.irp.f diff --git a/src/bi_ort_ints/total_twoe_pot.irp.f b/plugins/local/bi_ort_ints/total_twoe_pot.irp.f similarity index 74% rename from src/bi_ort_ints/total_twoe_pot.irp.f rename to plugins/local/bi_ort_ints/total_twoe_pot.irp.f index 37a31a51..5e6a24e9 100644 --- a/src/bi_ort_ints/total_twoe_pot.irp.f +++ b/plugins/local/bi_ort_ints/total_twoe_pot.irp.f @@ -1,91 +1,4 @@ - -! --- - -BEGIN_PROVIDER [double precision, ao_two_e_vartc_tot, (ao_num, ao_num, ao_num, ao_num) ] - - integer :: i, j, k, l - - provide j1b_type - provide mo_r_coef mo_l_coef - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_two_e_vartc_tot(k,i,l,j) = ao_vartc_int_chemist(k,i,l,j) - enddo - enddo - enddo - enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num) ] - - BEGIN_DOC - ! - ! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) = where V^TC(r_12) is the total TC operator - ! - ! including both hermitian and non hermitian parts. THIS IS IN CHEMIST NOTATION. - ! - ! WARNING :: non hermitian ! acts on "the right functions" (i,j) - ! - END_DOC - - integer :: i, j, k, l - double precision :: integral_sym, integral_nsym - double precision, external :: get_ao_tc_sym_two_e_pot - - provide j1b_type - - if(j1b_type .eq. 0) then - - PROVIDE ao_tc_sym_two_e_pot_in_map - - !!! TODO :: OPENMP - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - - integral_sym = get_ao_tc_sym_two_e_pot(i, j, k, l, ao_tc_sym_two_e_pot_map) - ! ao_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the AO basis - integral_nsym = ao_non_hermit_term_chemist(k,i,l,j) - - !print *, ' sym integ = ', integral_sym - !print *, ' non-sym integ = ', integral_nsym - - ao_two_e_tc_tot(k,i,l,j) = integral_sym + integral_nsym - !write(111,*) ao_two_e_tc_tot(k,i,l,j) - enddo - enddo - enddo - enddo - - else - - PROVIDE ao_tc_int_chemist - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_two_e_tc_tot(k,i,l,j) = ao_tc_int_chemist(k,i,l,j) - !write(222,*) ao_two_e_tc_tot(k,i,l,j) - enddo - enddo - enddo - enddo - - FREE ao_tc_int_chemist - - endif - -END_PROVIDER - ! --- double precision function bi_ortho_mo_ints(l, k, j, i) @@ -118,8 +31,6 @@ end function bi_ortho_mo_ints ! --- -! TODO :: transform into DEGEMM - BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num, mo_num, mo_num)] BEGIN_DOC @@ -267,7 +178,6 @@ END_PROVIDER ! --- - BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj, (mo_num,mo_num)] &BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_exchange, (mo_num,mo_num)] &BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_two_e_jj_anti, (mo_num,mo_num)] diff --git a/src/bi_ortho_mos/EZFIO.cfg b/plugins/local/bi_ortho_mos/EZFIO.cfg similarity index 100% rename from src/bi_ortho_mos/EZFIO.cfg rename to plugins/local/bi_ortho_mos/EZFIO.cfg diff --git a/src/bi_ortho_mos/NEED b/plugins/local/bi_ortho_mos/NEED similarity index 100% rename from src/bi_ortho_mos/NEED rename to plugins/local/bi_ortho_mos/NEED diff --git a/src/bi_ortho_mos/bi_density.irp.f b/plugins/local/bi_ortho_mos/bi_density.irp.f similarity index 100% rename from src/bi_ortho_mos/bi_density.irp.f rename to plugins/local/bi_ortho_mos/bi_density.irp.f diff --git a/src/bi_ortho_mos/bi_ort_mos_in_r.irp.f b/plugins/local/bi_ortho_mos/bi_ort_mos_in_r.irp.f similarity index 100% rename from src/bi_ortho_mos/bi_ort_mos_in_r.irp.f rename to plugins/local/bi_ortho_mos/bi_ort_mos_in_r.irp.f diff --git a/src/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f b/plugins/local/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f similarity index 100% rename from src/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f rename to plugins/local/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f diff --git a/src/bi_ortho_mos/mos_rl.irp.f b/plugins/local/bi_ortho_mos/mos_rl.irp.f similarity index 100% rename from src/bi_ortho_mos/mos_rl.irp.f rename to plugins/local/bi_ortho_mos/mos_rl.irp.f diff --git a/src/bi_ortho_mos/overlap.irp.f b/plugins/local/bi_ortho_mos/overlap.irp.f similarity index 100% rename from src/bi_ortho_mos/overlap.irp.f rename to plugins/local/bi_ortho_mos/overlap.irp.f diff --git a/src/casscf_tc_bi/NEED b/plugins/local/casscf_tc_bi/NEED similarity index 100% rename from src/casscf_tc_bi/NEED rename to plugins/local/casscf_tc_bi/NEED diff --git a/src/casscf_tc_bi/det_manip.irp.f b/plugins/local/casscf_tc_bi/det_manip.irp.f similarity index 100% rename from src/casscf_tc_bi/det_manip.irp.f rename to plugins/local/casscf_tc_bi/det_manip.irp.f diff --git a/src/casscf_tc_bi/grad_dm.irp.f b/plugins/local/casscf_tc_bi/grad_dm.irp.f similarity index 100% rename from src/casscf_tc_bi/grad_dm.irp.f rename to plugins/local/casscf_tc_bi/grad_dm.irp.f diff --git a/src/casscf_tc_bi/grad_old.irp.f b/plugins/local/casscf_tc_bi/grad_old.irp.f similarity index 100% rename from src/casscf_tc_bi/grad_old.irp.f rename to plugins/local/casscf_tc_bi/grad_old.irp.f diff --git a/src/casscf_tc_bi/gradient.irp.f b/plugins/local/casscf_tc_bi/gradient.irp.f similarity index 100% rename from src/casscf_tc_bi/gradient.irp.f rename to plugins/local/casscf_tc_bi/gradient.irp.f diff --git a/src/casscf_tc_bi/test_tc_casscf.irp.f b/plugins/local/casscf_tc_bi/test_tc_casscf.irp.f similarity index 100% rename from src/casscf_tc_bi/test_tc_casscf.irp.f rename to plugins/local/casscf_tc_bi/test_tc_casscf.irp.f diff --git a/src/cipsi_tc_bi_ortho/EZFIO.cfg b/plugins/local/cipsi_tc_bi_ortho/EZFIO.cfg similarity index 100% rename from src/cipsi_tc_bi_ortho/EZFIO.cfg rename to plugins/local/cipsi_tc_bi_ortho/EZFIO.cfg diff --git a/src/cipsi_tc_bi_ortho/NEED b/plugins/local/cipsi_tc_bi_ortho/NEED similarity index 100% rename from src/cipsi_tc_bi_ortho/NEED rename to plugins/local/cipsi_tc_bi_ortho/NEED diff --git a/src/cipsi_tc_bi_ortho/cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/cipsi.irp.f rename to plugins/local/cipsi_tc_bi_ortho/cipsi.irp.f diff --git a/src/cipsi_tc_bi_ortho/energy.irp.f b/plugins/local/cipsi_tc_bi_ortho/energy.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/energy.irp.f rename to plugins/local/cipsi_tc_bi_ortho/energy.irp.f diff --git a/src/cipsi_tc_bi_ortho/environment.irp.f b/plugins/local/cipsi_tc_bi_ortho/environment.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/environment.irp.f rename to plugins/local/cipsi_tc_bi_ortho/environment.irp.f diff --git a/src/cipsi_tc_bi_ortho/fock_diag.irp.f b/plugins/local/cipsi_tc_bi_ortho/fock_diag.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/fock_diag.irp.f rename to plugins/local/cipsi_tc_bi_ortho/fock_diag.irp.f diff --git a/src/cipsi_tc_bi_ortho/get_d.irp.f b/plugins/local/cipsi_tc_bi_ortho/get_d.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/get_d.irp.f rename to plugins/local/cipsi_tc_bi_ortho/get_d.irp.f diff --git a/src/cipsi_tc_bi_ortho/get_d0_good.irp.f b/plugins/local/cipsi_tc_bi_ortho/get_d0_good.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/get_d0_good.irp.f rename to plugins/local/cipsi_tc_bi_ortho/get_d0_good.irp.f diff --git a/src/cipsi_tc_bi_ortho/get_d1_good.irp.f b/plugins/local/cipsi_tc_bi_ortho/get_d1_good.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/get_d1_good.irp.f rename to plugins/local/cipsi_tc_bi_ortho/get_d1_good.irp.f diff --git a/src/cipsi_tc_bi_ortho/get_d2_good.irp.f b/plugins/local/cipsi_tc_bi_ortho/get_d2_good.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/get_d2_good.irp.f rename to plugins/local/cipsi_tc_bi_ortho/get_d2_good.irp.f diff --git a/src/cipsi_tc_bi_ortho/lock_2rdm.irp.f b/plugins/local/cipsi_tc_bi_ortho/lock_2rdm.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/lock_2rdm.irp.f rename to plugins/local/cipsi_tc_bi_ortho/lock_2rdm.irp.f diff --git a/src/cipsi_tc_bi_ortho/pouet b/plugins/local/cipsi_tc_bi_ortho/pouet similarity index 100% rename from src/cipsi_tc_bi_ortho/pouet rename to plugins/local/cipsi_tc_bi_ortho/pouet diff --git a/src/cipsi_tc_bi_ortho/pt2.irp.f b/plugins/local/cipsi_tc_bi_ortho/pt2.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/pt2.irp.f rename to plugins/local/cipsi_tc_bi_ortho/pt2.irp.f diff --git a/src/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f b/plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f rename to plugins/local/cipsi_tc_bi_ortho/pt2_stoch_routines.irp.f diff --git a/src/cipsi_tc_bi_ortho/pt2_type.irp.f b/plugins/local/cipsi_tc_bi_ortho/pt2_type.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/pt2_type.irp.f rename to plugins/local/cipsi_tc_bi_ortho/pt2_type.irp.f diff --git a/src/cipsi_tc_bi_ortho/run_pt2_slave.irp.f b/plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/run_pt2_slave.irp.f rename to plugins/local/cipsi_tc_bi_ortho/run_pt2_slave.irp.f diff --git a/src/cipsi_tc_bi_ortho/run_selection_slave.irp.f b/plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/run_selection_slave.irp.f rename to plugins/local/cipsi_tc_bi_ortho/run_selection_slave.irp.f diff --git a/src/cipsi_tc_bi_ortho/selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/selection.irp.f rename to plugins/local/cipsi_tc_bi_ortho/selection.irp.f diff --git a/src/cipsi_tc_bi_ortho/selection_buffer.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/selection_buffer.irp.f rename to plugins/local/cipsi_tc_bi_ortho/selection_buffer.irp.f diff --git a/src/cipsi_tc_bi_ortho/selection_types.f90 b/plugins/local/cipsi_tc_bi_ortho/selection_types.f90 similarity index 100% rename from src/cipsi_tc_bi_ortho/selection_types.f90 rename to plugins/local/cipsi_tc_bi_ortho/selection_types.f90 diff --git a/src/cipsi_tc_bi_ortho/selection_weight.irp.f b/plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/selection_weight.irp.f rename to plugins/local/cipsi_tc_bi_ortho/selection_weight.irp.f diff --git a/src/cipsi_tc_bi_ortho/slave_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/slave_cipsi.irp.f rename to plugins/local/cipsi_tc_bi_ortho/slave_cipsi.irp.f diff --git a/src/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f b/plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f rename to plugins/local/cipsi_tc_bi_ortho/stochastic_cipsi.irp.f diff --git a/src/cipsi_tc_bi_ortho/write_cipsi_json.irp.f b/plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/write_cipsi_json.irp.f rename to plugins/local/cipsi_tc_bi_ortho/write_cipsi_json.irp.f diff --git a/src/cipsi_tc_bi_ortho/zmq_selection.irp.f b/plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f similarity index 100% rename from src/cipsi_tc_bi_ortho/zmq_selection.irp.f rename to plugins/local/cipsi_tc_bi_ortho/zmq_selection.irp.f diff --git a/src/fci_tc_bi/13.fci_tc_bi_ortho.bats b/plugins/local/fci_tc_bi/13.fci_tc_bi_ortho.bats similarity index 100% rename from src/fci_tc_bi/13.fci_tc_bi_ortho.bats rename to plugins/local/fci_tc_bi/13.fci_tc_bi_ortho.bats diff --git a/src/fci_tc_bi/EZFIO.cfg b/plugins/local/fci_tc_bi/EZFIO.cfg similarity index 100% rename from src/fci_tc_bi/EZFIO.cfg rename to plugins/local/fci_tc_bi/EZFIO.cfg diff --git a/src/fci_tc_bi/NEED b/plugins/local/fci_tc_bi/NEED similarity index 100% rename from src/fci_tc_bi/NEED rename to plugins/local/fci_tc_bi/NEED diff --git a/src/fci_tc_bi/class.irp.f b/plugins/local/fci_tc_bi/class.irp.f similarity index 100% rename from src/fci_tc_bi/class.irp.f rename to plugins/local/fci_tc_bi/class.irp.f diff --git a/src/fci_tc_bi/copy_wf.irp.f b/plugins/local/fci_tc_bi/copy_wf.irp.f similarity index 100% rename from src/fci_tc_bi/copy_wf.irp.f rename to plugins/local/fci_tc_bi/copy_wf.irp.f diff --git a/src/fci_tc_bi/diagonalize_ci.irp.f b/plugins/local/fci_tc_bi/diagonalize_ci.irp.f similarity index 100% rename from src/fci_tc_bi/diagonalize_ci.irp.f rename to plugins/local/fci_tc_bi/diagonalize_ci.irp.f diff --git a/src/fci_tc_bi/fci_tc_bi_ortho.irp.f b/plugins/local/fci_tc_bi/fci_tc_bi_ortho.irp.f similarity index 100% rename from src/fci_tc_bi/fci_tc_bi_ortho.irp.f rename to plugins/local/fci_tc_bi/fci_tc_bi_ortho.irp.f diff --git a/src/fci_tc_bi/generators.irp.f b/plugins/local/fci_tc_bi/generators.irp.f similarity index 100% rename from src/fci_tc_bi/generators.irp.f rename to plugins/local/fci_tc_bi/generators.irp.f diff --git a/src/fci_tc_bi/pt2_tc.irp.f b/plugins/local/fci_tc_bi/pt2_tc.irp.f similarity index 100% rename from src/fci_tc_bi/pt2_tc.irp.f rename to plugins/local/fci_tc_bi/pt2_tc.irp.f diff --git a/src/fci_tc_bi/save_energy.irp.f b/plugins/local/fci_tc_bi/save_energy.irp.f similarity index 100% rename from src/fci_tc_bi/save_energy.irp.f rename to plugins/local/fci_tc_bi/save_energy.irp.f diff --git a/src/fci_tc_bi/scripts_fci_tc/CH2.xyz b/plugins/local/fci_tc_bi/scripts_fci_tc/CH2.xyz similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/CH2.xyz rename to plugins/local/fci_tc_bi/scripts_fci_tc/CH2.xyz diff --git a/src/fci_tc_bi/scripts_fci_tc/FH.xyz b/plugins/local/fci_tc_bi/scripts_fci_tc/FH.xyz similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/FH.xyz rename to plugins/local/fci_tc_bi/scripts_fci_tc/FH.xyz diff --git a/src/fci_tc_bi/scripts_fci_tc/extract_tables.sh b/plugins/local/fci_tc_bi/scripts_fci_tc/extract_tables.sh similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/extract_tables.sh rename to plugins/local/fci_tc_bi/scripts_fci_tc/extract_tables.sh diff --git a/src/fci_tc_bi/scripts_fci_tc/h2o.sh b/plugins/local/fci_tc_bi/scripts_fci_tc/h2o.sh similarity index 92% rename from src/fci_tc_bi/scripts_fci_tc/h2o.sh rename to plugins/local/fci_tc_bi/scripts_fci_tc/h2o.sh index d0afca30..697beeb5 100644 --- a/src/fci_tc_bi/scripts_fci_tc/h2o.sh +++ b/plugins/local/fci_tc_bi/scripts_fci_tc/h2o.sh @@ -23,10 +23,10 @@ cd $StartDir ############################################################################ #### EXAMPLE OF SCRIPT TO RUN A CIPSI CALCULATION ON 5 STATES ON THE Ne^+ CATION -#### USING NATURAL ORBITALS OF A SMALL CIPSI AS MOS +#### USING NATURAL ORBITALS OF A SMALL CIPSI AS MOS #### ALL STATES WILL HAVE THE SAME SPIN SIMETRY : A DOUBLET -####### YOU PUT THE PATH TO YOUR +####### YOU PUT THE PATH TO YOUR QP_ROOT=/home_lct/eginer/programs/qp2 source ${QP_ROOT}/quantum_package.rc ####### YOU LOAD SOME LIBRARIES diff --git a/src/fci_tc_bi/scripts_fci_tc/h2o.xyz b/plugins/local/fci_tc_bi/scripts_fci_tc/h2o.xyz similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/h2o.xyz rename to plugins/local/fci_tc_bi/scripts_fci_tc/h2o.xyz diff --git a/src/fci_tc_bi/scripts_fci_tc/script.sh b/plugins/local/fci_tc_bi/scripts_fci_tc/script.sh similarity index 100% rename from src/fci_tc_bi/scripts_fci_tc/script.sh rename to plugins/local/fci_tc_bi/scripts_fci_tc/script.sh diff --git a/src/fci_tc_bi/selectors.irp.f b/plugins/local/fci_tc_bi/selectors.irp.f similarity index 100% rename from src/fci_tc_bi/selectors.irp.f rename to plugins/local/fci_tc_bi/selectors.irp.f diff --git a/src/fci_tc_bi/zmq.irp.f b/plugins/local/fci_tc_bi/zmq.irp.f similarity index 100% rename from src/fci_tc_bi/zmq.irp.f rename to plugins/local/fci_tc_bi/zmq.irp.f diff --git a/src/jastrow/EZFIO.cfg b/plugins/local/jastrow/EZFIO.cfg similarity index 57% rename from src/jastrow/EZFIO.cfg rename to plugins/local/jastrow/EZFIO.cfg index b41185a3..2eac6aa2 100644 --- a/src/jastrow/EZFIO.cfg +++ b/plugins/local/jastrow/EZFIO.cfg @@ -1,9 +1,22 @@ -[jast_type] -doc: Type of Jastrow [None| Mu | Qmckl] + +[j2e_type] type: character*(32) -interface: ezfio, provider, ocaml +doc: type of the 2e-Jastrow: [ None | Mu | Mur | Qmckl ] +interface: ezfio,provider,ocaml +default: Mu + +[j1e_type] +type: character*(32) +doc: type of the 1e-Jastrow: [ None | Gauss | Charge_Harmonizer ] +interface: ezfio,provider,ocaml default: None +[env_type] +type: character*(32) +doc: type of 1-body Jastrow: [ None | Prod_Gauss | Sum_Gauss | Sum_Slat | Sum_Quartic ] +interface: ezfio, provider, ocaml +default: Sum_Gauss + [jast_qmckl_type_nucl_num] doc: Number of different nuclei types in QMCkl jastrow type: integer @@ -64,6 +77,46 @@ type: double precision size: (jastrow.jast_qmckl_c_vector_size) interface: ezfio, provider - +[j1e_size] +type: integer +doc: number of functions per atom in 1e-Jastrow +interface: ezfio,provider,ocaml +default: 1 + +[j1e_coef] +type: double precision +doc: linear coef of functions in 1e-Jastrow +interface: ezfio +size: (jastrow.j1e_size,nuclei.nucl_num) + +[j1e_expo] +type: double precision +doc: exponenets of functions in 1e-Jastrow +interface: ezfio +size: (jastrow.j1e_size,nuclei.nucl_num) + +[env_expo] +type: double precision +doc: exponents of the 1-body Jastrow +interface: ezfio +size: (nuclei.nucl_num) + +[env_coef] +type: double precision +doc: coefficients of the 1-body Jastrow +interface: ezfio +size: (nuclei.nucl_num) + +[murho_type] +type: integer +doc: type of mu(rho) Jastrow +interface: ezfio, provider, ocaml +default: 0 + +[ng_fit_jast] +type: integer +doc: nb of Gaussians used to fit Jastrow fcts +interface: ezfio,provider,ocaml +default: 20 diff --git a/src/jastrow/NEED b/plugins/local/jastrow/NEED similarity index 100% rename from src/jastrow/NEED rename to plugins/local/jastrow/NEED diff --git a/plugins/local/jastrow/README.md b/plugins/local/jastrow/README.md new file mode 100644 index 00000000..f7ea8e02 --- /dev/null +++ b/plugins/local/jastrow/README.md @@ -0,0 +1,68 @@ +# Jastrow + +Information related to the Jastrow factor in trans-correlated calculations. + +The main keywords are: +- `j2e_type` +- `j1e_type` +- `env_type` + +## j2e_type Options + +1. **none:** No 2e-Jastrow is used. + +2. **Mu:** 2e-Jastrow inspired by Range Separated Density Functional Theory. It has the following shape: +

+ +

+ with, +

+ +

+ + +## env_type Options + +The 2-electron Jastrow is multiplied by an envelope \(v\): +

+ +

+ +- if `env_type` is **none**: No envelope is used. + +- if `env_type` is **Prod_Gauss**: +

+ +

+ +- if `env_type` is **Sum_Gauss**: +

+ +

+ +Here, \(A\) designates the nuclei, and the coefficients and exponents are defined in the tables `env_coef` and `env_expo` respectively. + + +## j1e_type Options + +The 1-electron Jastrow used is: +

+ +

+ +- if `j1e_type` is **none**: No one-electron Jastrow is used. + +- if `j1e_type` is **Gauss**: We use +

+ +

+ + +are defined by the tables `j1e_coef` and `j1e_expo`, respectively. + +- if `j1e_type` is **Charge_Harmonizer**: The one-electron Jastrow factor aims to offset the adverse impact of modifying the charge density induced by the two-electron factor +

+ +

+ + diff --git a/plugins/local/jastrow/env_param.irp.f b/plugins/local/jastrow/env_param.irp.f new file mode 100644 index 00000000..8102a484 --- /dev/null +++ b/plugins/local/jastrow/env_param.irp.f @@ -0,0 +1,100 @@ + +! --- + + BEGIN_PROVIDER [ double precision, env_expo , (nucl_num) ] +&BEGIN_PROVIDER [ double precision, env_coef, (nucl_num) ] + + BEGIN_DOC + ! parameters of the 1-body Jastrow + END_DOC + + implicit none + logical :: exists + integer :: i + integer :: ierr + + PROVIDE ezfio_filename + + ! --- + + if (mpi_master) then + call ezfio_has_jastrow_env_expo(exists) + endif + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + + IRP_IF MPI + include 'mpif.h' + call MPI_BCAST(env_expo, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read env_expo with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: env_expo ] <<<<< ..' + call ezfio_get_jastrow_env_expo(env_expo) + IRP_IF MPI + call MPI_BCAST(env_expo, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read env_expo with MPI' + endif + IRP_ENDIF + endif + else + do i = 1, nucl_num + env_expo(i) = 1d5 + enddo + endif + + ! --- + + if (mpi_master) then + call ezfio_has_jastrow_env_coef(exists) + endif + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + + IRP_IF MPI + call MPI_BCAST(env_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read env_coef with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: env_coef ] <<<<< ..' + call ezfio_get_jastrow_env_coef(env_coef) + IRP_IF MPI + call MPI_BCAST(env_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read env_coef with MPI' + endif + IRP_ENDIF + endif + else + do i = 1, nucl_num + env_coef(i) = 1d0 + enddo + endif + + ! --- + + print *, ' parameters for nuclei jastrow' + print *, ' i, Z, env_expo, env_coef' + do i = 1, nucl_num + write(*,'(I4, 2x, 3(E15.7, 2X))') i, nucl_charge(i), env_expo(i), env_coef(i) + enddo + +END_PROVIDER + +! --- + diff --git a/src/ao_tc_eff_map/fit_j.irp.f b/plugins/local/jastrow/fit_j.irp.f similarity index 83% rename from src/ao_tc_eff_map/fit_j.irp.f rename to plugins/local/jastrow/fit_j.irp.f index 0fc3da2f..8a2d0036 100644 --- a/src/ao_tc_eff_map/fit_j.irp.f +++ b/plugins/local/jastrow/fit_j.irp.f @@ -1,41 +1,67 @@ - BEGIN_PROVIDER [ double precision, expo_j_xmu_1gauss ] -&BEGIN_PROVIDER [ double precision, coef_j_xmu_1gauss ] - implicit none - BEGIN_DOC - ! Upper bound long range fit of F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) - ! - ! with a single gaussian. - ! - ! Such a function can be used to screen integrals with F(x). - END_DOC - expo_j_xmu_1gauss = 0.5d0 - coef_j_xmu_1gauss = 1.d0 -END_PROVIDER + ! --- -BEGIN_PROVIDER [ double precision, expo_erfc_gauss ] - implicit none - expo_erfc_gauss = 1.41211d0 + BEGIN_PROVIDER [double precision, expo_j_xmu_1gauss] +&BEGIN_PROVIDER [double precision, coef_j_xmu_1gauss] + + implicit none + + BEGIN_DOC + ! Upper bound long range fit of F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) + ! + ! with a single gaussian. + ! + ! Such a function can be used to screen integrals with F(x). + END_DOC + + expo_j_xmu_1gauss = 0.5d0 + coef_j_xmu_1gauss = 1.d0 + END_PROVIDER -BEGIN_PROVIDER [ double precision, expo_erfc_mu_gauss ] - implicit none - expo_erfc_mu_gauss = expo_erfc_gauss * mu_erf * mu_erf +! --- + +BEGIN_PROVIDER [double precision, expo_erfc_gauss] + + implicit none + + expo_erfc_gauss = 1.41211d0 + END_PROVIDER - BEGIN_PROVIDER [ double precision, expo_good_j_mu_1gauss ] -&BEGIN_PROVIDER [ double precision, coef_good_j_mu_1gauss ] - implicit none - BEGIN_DOC - ! exponent of Gaussian in order to obtain an upper bound of J(r12,mu) - ! - ! Can be used to scree integrals with J(r12,mu) - END_DOC - expo_good_j_mu_1gauss = 2.D0 * mu_erf * expo_j_xmu_1gauss - coef_good_j_mu_1gauss = 0.5d0/mu_erf * coef_j_xmu_1gauss - END_PROVIDER +! --- -BEGIN_PROVIDER [ double precision, expo_j_xmu, (n_fit_1_erf_x) ] +BEGIN_PROVIDER [double precision, expo_erfc_mu_gauss] + + implicit none + + expo_erfc_mu_gauss = expo_erfc_gauss * mu_erf * mu_erf + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, expo_good_j_mu_1gauss] +&BEGIN_PROVIDER [double precision, coef_good_j_mu_1gauss] + + BEGIN_DOC + ! + ! exponent of Gaussian in order to obtain an upper bound of J(r12,mu) + ! + ! Can be used to scree integrals with J(r12,mu) + ! + END_DOC + + implicit none + + expo_good_j_mu_1gauss = 2.d0 * mu_erf * expo_j_xmu_1gauss + coef_good_j_mu_1gauss = 0.5d0/mu_erf * coef_j_xmu_1gauss + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, expo_j_xmu, (n_fit_1_erf_x)] BEGIN_DOC ! F(x) = x * (1 - erf(x)) - 1/sqrt(pi) * exp(-x**2) is fitted with a gaussian and a Slater @@ -465,53 +491,86 @@ END_PROVIDER ! --- double precision function F_x_j(x) - implicit none - BEGIN_DOC - ! F_x_j(x) = dimension-less correlation factor = x (1 - erf(x)) - 1/sqrt(pi) exp(-x^2) - END_DOC - double precision, intent(in) :: x - F_x_j = x * (1.d0 - derf(x)) - 1/dsqrt(dacos(-1.d0)) * dexp(-x**2) + + BEGIN_DOC + ! + ! dimension-less correlation factor: + ! + ! F_x_j(x) = x (1 - erf(x)) - 1/sqrt(pi) exp(-x^2) + ! + END_DOC + + implicit none + double precision, intent(in) :: x + + F_x_j = x * (1.d0 - derf(x)) - 1/dsqrt(dacos(-1.d0)) * dexp(-x**2) end +! --- + double precision function j_mu_F_x_j(x) - implicit none - BEGIN_DOC - ! j_mu_F_x_j(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) - ! - ! = 1/(2*mu) * F_x_j(mu*x) - END_DOC - double precision :: F_x_j - double precision, intent(in) :: x - j_mu_F_x_j = 0.5d0/mu_erf * F_x_j(x*mu_erf) + + BEGIN_DOC + ! + ! correlation factor: + ! + ! j_mu_F_x_j(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) + ! = 1/(2*mu) * F_x_j(mu*x) + ! + END_DOC + + implicit none + double precision, intent(in) :: x + double precision :: F_x_j + + j_mu_F_x_j = 0.5d0/mu_erf * F_x_j(x*mu_erf) + end +! --- + double precision function j_mu(x) - implicit none - double precision, intent(in) :: x - BEGIN_DOC - ! j_mu(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) - END_DOC - j_mu = 0.5d0* x * (1.d0 - derf(mu_erf*x)) - 0.5d0/( dsqrt(dacos(-1.d0))*mu_erf) * dexp(-(mu_erf*x)*(mu_erf*x)) - -end -double precision function j_mu_fit_gauss(x) - implicit none - BEGIN_DOC - ! j_mu_fit_gauss(x) = correlation factor = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) - ! - ! but fitted with gaussians - END_DOC - double precision, intent(in) :: x - integer :: i - double precision :: alpha,coef - j_mu_fit_gauss = 0.d0 - do i = 1, n_max_fit_slat - alpha = expo_gauss_j_mu_x(i) - coef = coef_gauss_j_mu_x(i) - j_mu_fit_gauss += coef * dexp(-alpha*x*x) - enddo + BEGIN_DOC + ! + ! correlation factor: + ! + ! j_mu(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) + ! + END_DOC + + implicit none + double precision, intent(in) :: x + + j_mu = 0.5d0* x * (1.d0 - derf(mu_erf*x)) - 0.5d0/( dsqrt(dacos(-1.d0))*mu_erf) * dexp(-(mu_erf*x)*(mu_erf*x)) + +end + +! --- + +double precision function j_mu_fit_gauss(x) + + BEGIN_DOC + ! + ! correlation factor fitted with gaussians: + ! + ! j_mu_fit_gauss(x) = 1/2 r12 * (1 - erf(mu*r12)) - 1/(2 sqrt(pi)*mu) exp(-(mu*r12)^2) + ! + ! + END_DOC + + implicit none + double precision, intent(in) :: x + integer :: i + double precision :: alpha, coef + + j_mu_fit_gauss = 0.d0 + do i = 1, n_max_fit_slat + alpha = expo_gauss_j_mu_x(i) + coef = coef_gauss_j_mu_x(i) + j_mu_fit_gauss += coef * dexp(-alpha*x*x) + enddo end diff --git a/src/ao_tc_eff_map/potential.irp.f b/plugins/local/jastrow/fit_potential.irp.f similarity index 78% rename from src/ao_tc_eff_map/potential.irp.f rename to plugins/local/jastrow/fit_potential.irp.f index 5b72b567..0bdf9c5b 100644 --- a/src/ao_tc_eff_map/potential.irp.f +++ b/plugins/local/jastrow/fit_potential.irp.f @@ -1,13 +1,16 @@ + ! --- BEGIN_PROVIDER [integer, n_gauss_eff_pot] BEGIN_DOC + ! ! number of gaussians to represent the effective potential : ! ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) ! ! Here (1 - erf(mu*r12))^2 is expanded in Gaussians as Eqs A11-A20 in JCP 154, 084119 (2021) + ! END_DOC implicit none @@ -21,10 +24,13 @@ END_PROVIDER BEGIN_PROVIDER [integer, n_gauss_eff_pot_deriv] BEGIN_DOC + ! ! V(r12) = -(1 - erf(mu*r12))^2 is expanded in Gaussians as Eqs A11-A20 in JCP 154, 084119 (2021) + ! END_DOC implicit none + n_gauss_eff_pot_deriv = ng_fit_jast END_PROVIDER @@ -35,11 +41,13 @@ END_PROVIDER &BEGIN_PROVIDER [double precision, coef_gauss_eff_pot, (n_gauss_eff_pot)] BEGIN_DOC + ! ! Coefficients and exponents of the Fit on Gaussians of V(X) = -(1 - erf(mu*X))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*X)^2) ! ! V(X) = \sum_{i=1,n_gauss_eff_pot} coef_gauss_eff_pot(i) * exp(-expo_gauss_eff_pot(i) * X^2) ! ! Relies on the fit proposed in Eqs A11-A20 in JCP 154, 084119 (2021) + ! END_DOC include 'constants.include.F' @@ -64,7 +72,9 @@ END_PROVIDER double precision function eff_pot_gauss(x, mu) BEGIN_DOC + ! ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) + ! END_DOC implicit none @@ -74,44 +84,58 @@ double precision function eff_pot_gauss(x, mu) end -! ------------------------------------------------------------------------------------------------- ! --- double precision function eff_pot_fit_gauss(x) - implicit none - BEGIN_DOC - ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) - ! - ! but fitted with gaussians - END_DOC - double precision, intent(in) :: x - integer :: i - double precision :: alpha - eff_pot_fit_gauss = derf(mu_erf*x)/x - do i = 1, n_gauss_eff_pot - alpha = expo_gauss_eff_pot(i) - eff_pot_fit_gauss += coef_gauss_eff_pot(i) * dexp(-alpha*x*x) - enddo + + BEGIN_DOC + ! + ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) + ! + ! but fitted with gaussians + ! + END_DOC + + implicit none + double precision, intent(in) :: x + integer :: i + double precision :: alpha + + eff_pot_fit_gauss = derf(mu_erf*x)/x + do i = 1, n_gauss_eff_pot + alpha = expo_gauss_eff_pot(i) + eff_pot_fit_gauss += coef_gauss_eff_pot(i) * dexp(-alpha*x*x) + enddo + end +! --- + BEGIN_PROVIDER [integer, n_fit_1_erf_x] - implicit none - BEGIN_DOC -! - END_DOC - n_fit_1_erf_x = 2 + + implicit none + + n_fit_1_erf_x = 2 END_PROVIDER +! --- + BEGIN_PROVIDER [double precision, expos_slat_gauss_1_erf_x, (n_fit_1_erf_x)] - implicit none - BEGIN_DOC -! 1 - erf(mu*x) is fitted with a Slater and gaussian as in Eq.A15 of JCP 154, 084119 (2021) -! -! 1 - erf(mu*x) = e^{-expos_slat_gauss_1_erf_x(1) * mu *x} * e^{-expos_slat_gauss_1_erf_x(2) * mu^2 * x^2} - END_DOC - expos_slat_gauss_1_erf_x(1) = 1.09529d0 - expos_slat_gauss_1_erf_x(2) = 0.756023d0 + + BEGIN_DOC + ! + ! 1 - erf(mu*x) is fitted with a Slater and gaussian as in Eq.A15 of JCP 154, 084119 (2021) + ! + ! 1 - erf(mu*x) = e^{-expos_slat_gauss_1_erf_x(1) * mu *x} * e^{-expos_slat_gauss_1_erf_x(2) * mu^2 * x^2} + ! + END_DOC + + implicit none + + expos_slat_gauss_1_erf_x(1) = 1.09529d0 + expos_slat_gauss_1_erf_x(2) = 0.756023d0 + END_PROVIDER ! --- @@ -151,12 +175,14 @@ END_PROVIDER double precision function fit_1_erf_x(x) BEGIN_DOC + ! ! fit_1_erf_x(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x)) + ! END_DOC implicit none - integer :: i double precision, intent(in) :: x + integer :: i fit_1_erf_x = 0.d0 do i = 1, n_max_fit_slat @@ -171,11 +197,13 @@ end &BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x_2, (ng_fit_jast)] BEGIN_DOC + ! ! (1 - erf(mu*x))^2 = \sum_i coef_gauss_1_erf_x_2(i) * exp(-expo_gauss_1_erf_x_2(i) * x^2) ! ! This is based on a fit of (1 - erf(mu*x)) by exp(-alpha * x) exp(-beta*mu^2x^2) ! ! and the slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians + ! END_DOC implicit none @@ -286,50 +314,22 @@ END_PROVIDER ! --- double precision function fit_1_erf_x_2(x) - implicit none - double precision, intent(in) :: x - BEGIN_DOC -! fit_1_erf_x_2(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))^2 - END_DOC - integer :: i - fit_1_erf_x_2 = 0.d0 - do i = 1, n_max_fit_slat - fit_1_erf_x_2 += dexp(-expo_gauss_1_erf_x_2(i) *x*x) * coef_gauss_1_erf_x_2(i) - enddo + + BEGIN_DOC + ! + ! fit_1_erf_x_2(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))^2 + ! + END_DOC + + implicit none + double precision, intent(in) :: x + integer :: i + + fit_1_erf_x_2 = 0.d0 + do i = 1, n_max_fit_slat + fit_1_erf_x_2 += dexp(-expo_gauss_1_erf_x_2(i) *x*x) * coef_gauss_1_erf_x_2(i) + enddo end -subroutine inv_r_times_poly(r, dist_r, dist_vec, poly) - implicit none - BEGIN_DOC -! returns -! -! poly(1) = x / sqrt(x^2+y^2+z^2), poly(2) = y / sqrt(x^2+y^2+z^2), poly(3) = z / sqrt(x^2+y^2+z^2) -! -! with the arguments -! -! r(1) = x, r(2) = y, r(3) = z, dist_r = sqrt(x^2+y^2+z^2) -! -! dist_vec(1) = sqrt(y^2+z^2), dist_vec(2) = sqrt(x^2+z^2), dist_vec(3) = sqrt(x^2+y^2) - END_DOC - double precision, intent(in) :: r(3), dist_r, dist_vec(3) - double precision, intent(out):: poly(3) - double precision :: inv_dist - integer :: i - if (dist_r.gt. 1.d-8)then - inv_dist = 1.d0/dist_r - do i = 1, 3 - poly(i) = r(i) * inv_dist - enddo - else - do i = 1, 3 - if(dabs(r(i)).lt.dist_vec(i))then - inv_dist = 1.d0/dist_r - poly(i) = r(i) * inv_dist - else !if(dabs(r(i)))then - poly(i) = 1.d0 -! poly(i) = 0.d0 - endif - enddo - endif -end +! --- diff --git a/src/ao_many_one_e_ints/fit_slat_gauss.irp.f b/plugins/local/jastrow/fit_slat_gauss.irp.f similarity index 100% rename from src/ao_many_one_e_ints/fit_slat_gauss.irp.f rename to plugins/local/jastrow/fit_slat_gauss.irp.f diff --git a/plugins/local/jastrow/jast_1e_param.irp.f b/plugins/local/jastrow/jast_1e_param.irp.f new file mode 100644 index 00000000..16c8cedc --- /dev/null +++ b/plugins/local/jastrow/jast_1e_param.irp.f @@ -0,0 +1,100 @@ + +! --- + + BEGIN_PROVIDER [double precision, j1e_expo, (j1e_size, nucl_num)] +&BEGIN_PROVIDER [double precision, j1e_coef, (j1e_size, nucl_num)] + + BEGIN_DOC + ! + ! parameters of the 1e-Jastrow + ! + END_DOC + + implicit none + logical :: exists + integer :: i, j + integer :: ierr + + PROVIDE ezfio_filename + + ! --- + + if (mpi_master) then + call ezfio_has_jastrow_j1e_expo(exists) + endif + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + + IRP_IF MPI + include 'mpif.h' + call MPI_BCAST(j1e_expo, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_expo with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: j1e_expo ] <<<<< ..' + call ezfio_get_jastrow_j1e_expo(j1e_expo) + IRP_IF MPI + call MPI_BCAST(j1e_expo, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_expo with MPI' + endif + IRP_ENDIF + endif + else + j1e_expo = 1.d0 + endif + + ! --- + + if (mpi_master) then + call ezfio_has_jastrow_j1e_coef(exists) + endif + + IRP_IF MPI_DEBUG + print *, irp_here, mpi_rank + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + IRP_ENDIF + + IRP_IF MPI + call MPI_BCAST(j1e_coef, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_coef with MPI' + endif + IRP_ENDIF + + if (exists) then + if (mpi_master) then + write(6,'(A)') '.. >>>>> [ IO READ: j1e_coef ] <<<<< ..' + call ezfio_get_jastrow_j1e_coef(j1e_coef) + IRP_IF MPI + call MPI_BCAST(j1e_coef, (j1e_size*nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + if (ierr /= MPI_SUCCESS) then + stop 'Unable to read j1e_coef with MPI' + endif + IRP_ENDIF + endif + else + j1e_coef = 0.d0 + endif + + ! --- + + print *, ' parameters of the 1e-Jastrow' + do i = 1, nucl_num + print*, ' for Z = ', nucl_charge(i) + do j = 1, j1e_size + write(*,'(I4, 2x, 2(E15.7, 2X))') j, j1e_coef(j,i), j1e_expo(j,i) + enddo + enddo + +END_PROVIDER + +! --- + diff --git a/src/mo_localization/84.mo_localization.bats b/plugins/local/mo_localization/84.mo_localization.bats similarity index 100% rename from src/mo_localization/84.mo_localization.bats rename to plugins/local/mo_localization/84.mo_localization.bats diff --git a/src/mo_localization/EZFIO.cfg b/plugins/local/mo_localization/EZFIO.cfg similarity index 100% rename from src/mo_localization/EZFIO.cfg rename to plugins/local/mo_localization/EZFIO.cfg diff --git a/src/mo_localization/NEED b/plugins/local/mo_localization/NEED similarity index 100% rename from src/mo_localization/NEED rename to plugins/local/mo_localization/NEED diff --git a/src/mo_localization/README.md b/plugins/local/mo_localization/README.md similarity index 100% rename from src/mo_localization/README.md rename to plugins/local/mo_localization/README.md diff --git a/src/mo_localization/break_spatial_sym.irp.f b/plugins/local/mo_localization/break_spatial_sym.irp.f similarity index 100% rename from src/mo_localization/break_spatial_sym.irp.f rename to plugins/local/mo_localization/break_spatial_sym.irp.f diff --git a/src/mo_localization/debug_gradient_loc.irp.f b/plugins/local/mo_localization/debug_gradient_loc.irp.f similarity index 100% rename from src/mo_localization/debug_gradient_loc.irp.f rename to plugins/local/mo_localization/debug_gradient_loc.irp.f diff --git a/src/mo_localization/debug_hessian_loc.irp.f b/plugins/local/mo_localization/debug_hessian_loc.irp.f similarity index 100% rename from src/mo_localization/debug_hessian_loc.irp.f rename to plugins/local/mo_localization/debug_hessian_loc.irp.f diff --git a/src/mo_localization/kick_the_mos.irp.f b/plugins/local/mo_localization/kick_the_mos.irp.f similarity index 100% rename from src/mo_localization/kick_the_mos.irp.f rename to plugins/local/mo_localization/kick_the_mos.irp.f diff --git a/src/mo_localization/localization.irp.f b/plugins/local/mo_localization/localization.irp.f similarity index 100% rename from src/mo_localization/localization.irp.f rename to plugins/local/mo_localization/localization.irp.f diff --git a/src/mo_localization/localization_sub.irp.f b/plugins/local/mo_localization/localization_sub.irp.f similarity index 100% rename from src/mo_localization/localization_sub.irp.f rename to plugins/local/mo_localization/localization_sub.irp.f diff --git a/src/ccsd/org/TANGLE_org_mode.sh b/plugins/local/mo_localization/org/TANGLE_org_mode.sh similarity index 100% rename from src/ccsd/org/TANGLE_org_mode.sh rename to plugins/local/mo_localization/org/TANGLE_org_mode.sh diff --git a/src/mo_localization/org/break_spatial_sym.org b/plugins/local/mo_localization/org/break_spatial_sym.org similarity index 100% rename from src/mo_localization/org/break_spatial_sym.org rename to plugins/local/mo_localization/org/break_spatial_sym.org diff --git a/src/mo_localization/org/debug_gradient_loc.org b/plugins/local/mo_localization/org/debug_gradient_loc.org similarity index 100% rename from src/mo_localization/org/debug_gradient_loc.org rename to plugins/local/mo_localization/org/debug_gradient_loc.org diff --git a/src/mo_localization/org/debug_hessian_loc.org b/plugins/local/mo_localization/org/debug_hessian_loc.org similarity index 100% rename from src/mo_localization/org/debug_hessian_loc.org rename to plugins/local/mo_localization/org/debug_hessian_loc.org diff --git a/src/mo_localization/org/kick_the_mos.org b/plugins/local/mo_localization/org/kick_the_mos.org similarity index 100% rename from src/mo_localization/org/kick_the_mos.org rename to plugins/local/mo_localization/org/kick_the_mos.org diff --git a/src/mo_localization/org/localization.org b/plugins/local/mo_localization/org/localization.org similarity index 100% rename from src/mo_localization/org/localization.org rename to plugins/local/mo_localization/org/localization.org diff --git a/src/non_h_ints_mu/NEED b/plugins/local/non_h_ints_mu/NEED similarity index 77% rename from src/non_h_ints_mu/NEED rename to plugins/local/non_h_ints_mu/NEED index c44c65af..48c1c24b 100644 --- a/src/non_h_ints_mu/NEED +++ b/plugins/local/non_h_ints_mu/NEED @@ -1,4 +1,5 @@ qmckl +hamiltonian jastrow ao_tc_eff_map bi_ortho_mos diff --git a/src/non_h_ints_mu/README.rst b/plugins/local/non_h_ints_mu/README.rst similarity index 100% rename from src/non_h_ints_mu/README.rst rename to plugins/local/non_h_ints_mu/README.rst diff --git a/src/non_h_ints_mu/debug_fit.irp.f b/plugins/local/non_h_ints_mu/debug_fit.irp.f similarity index 56% rename from src/non_h_ints_mu/debug_fit.irp.f rename to plugins/local/non_h_ints_mu/debug_fit.irp.f index d3152836..3934bb06 100644 --- a/src/non_h_ints_mu/debug_fit.irp.f +++ b/plugins/local/non_h_ints_mu/debug_fit.irp.f @@ -11,9 +11,12 @@ program debug_fit my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - PROVIDE mu_erf j1b_pen + PROVIDE j2e_type mu_erf + PROVIDE j1e_type j1e_coef j1e_expo + PROVIDE env_type env_coef env_expo + provide tc_integ_type - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r @@ -21,12 +24,8 @@ program debug_fit touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid endif - !call test_j1b_nucl() - !call test_grad_j1b_nucl() - !call test_lapl_j1b_nucl() - - !call test_list_b2() - !call test_list_b3() + !call test_env_nucl() + !call test_grad_env_nucl() !call test_fit_u() !call test_fit_u2() @@ -38,17 +37,17 @@ end ! --- -subroutine test_j1b_nucl() +subroutine test_env_nucl() implicit none integer :: ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz double precision :: r(3) - double precision, external :: j1b_nucl + double precision, external :: env_nucl - print*, ' test_j1b_nucl ...' + print*, ' test_env_nucl ...' - PROVIDE v_1b + PROVIDE env_val eps_ij = 1d-7 acc_tot = 0.d0 @@ -60,11 +59,11 @@ subroutine test_j1b_nucl() r(2) = final_grid_points(2,ipoint) r(3) = final_grid_points(3,ipoint) - i_exc = v_1b(ipoint) - i_num = j1b_nucl(r) + i_exc = env_val(ipoint) + i_num = env_nucl(r) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in v_1b on', ipoint + print *, ' problem in env_val on', ipoint print *, ' analyt = ', i_exc print *, ' numeri = ', i_num print *, ' diff = ', acc_ij @@ -78,23 +77,23 @@ subroutine test_j1b_nucl() print*, ' normalz = ', normalz return -end subroutine test_j1b_nucl +end ! --- -subroutine test_grad_j1b_nucl() +subroutine test_grad_env_nucl() implicit none integer :: ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz double precision :: r(3) - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num - print*, ' test_grad_j1b_nucl ...' + PROVIDE env_grad - PROVIDE v_1b_grad + print*, ' test_grad_env_nucl ...' eps_ij = 1d-7 acc_tot = 0.d0 @@ -106,31 +105,31 @@ subroutine test_grad_j1b_nucl() r(2) = final_grid_points(2,ipoint) r(3) = final_grid_points(3,ipoint) - i_exc = v_1b_grad(1,ipoint) - i_num = grad_x_j1b_nucl_num(r) + i_exc = env_grad(1,ipoint) + i_num = grad_x_env_nucl_num(r) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in x of v_1b_grad on', ipoint + print *, ' problem in x of env_grad on', ipoint print *, ' analyt = ', i_exc print *, ' numeri = ', i_num print *, ' diff = ', acc_ij endif - i_exc = v_1b_grad(2,ipoint) - i_num = grad_y_j1b_nucl_num(r) + i_exc = env_grad(2,ipoint) + i_num = grad_y_env_nucl_num(r) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in y of v_1b_grad on', ipoint + print *, ' problem in y of env_grad on', ipoint print *, ' analyt = ', i_exc print *, ' numeri = ', i_num print *, ' diff = ', acc_ij endif - i_exc = v_1b_grad(3,ipoint) - i_num = grad_z_j1b_nucl_num(r) + i_exc = env_grad(3,ipoint) + i_num = grad_z_env_nucl_num(r) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in z of v_1b_grad on', ipoint + print *, ' problem in z of env_grad on', ipoint print *, ' analyt = ', i_exc print *, ' numeri = ', i_num print *, ' diff = ', acc_ij @@ -144,278 +143,7 @@ subroutine test_grad_j1b_nucl() print*, ' normalz = ', normalz return -end subroutine test_grad_j1b_nucl - -! --- - -subroutine test_lapl_j1b_nucl() - - implicit none - integer :: ipoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision :: r(3) - double precision, external :: lapl_j1b_nucl - - print*, ' test_lapl_j1b_nucl ...' - - PROVIDE v_1b_lapl - - eps_ij = 1d-5 - acc_tot = 0.d0 - normalz = 0.d0 - - do ipoint = 1, n_points_final_grid - - r(1) = final_grid_points(1,ipoint) - r(2) = final_grid_points(2,ipoint) - r(3) = final_grid_points(3,ipoint) - - i_exc = v_1b_lapl(ipoint) - i_num = lapl_j1b_nucl(r) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in v_1b_lapl on', ipoint - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz - - return -end subroutine test_lapl_j1b_nucl - -! --- - -subroutine test_list_b2() - - implicit none - integer :: ipoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision :: r(3) - double precision, external :: j1b_nucl - - print*, ' test_list_b2 ...' - - PROVIDE v_1b_list_b2 - - eps_ij = 1d-7 - acc_tot = 0.d0 - normalz = 0.d0 - - do ipoint = 1, n_points_final_grid - - r(1) = final_grid_points(1,ipoint) - r(2) = final_grid_points(2,ipoint) - r(3) = final_grid_points(3,ipoint) - - i_exc = v_1b_list_b2(ipoint) - i_num = j1b_nucl(r) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in list_b2 on', ipoint - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz - - return -end subroutine test_list_b2 - -! --- - -subroutine test_list_b3() - - implicit none - integer :: ipoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_tmp, i_num, normalz - double precision :: r(3) - double precision :: grad_num(3), eps_der, eps_lap, tmp_der, tmp_lap, i0, ip, im - double precision, external :: j1b_nucl_square - - print*, ' test_list_b3 ...' - - eps_ij = 1d-7 - - eps_der = 1d-5 - tmp_der = 0.5d0 / eps_der - - eps_lap = 1d-4 - tmp_lap = 1.d0 / (eps_lap*eps_lap) - - ! --- - - PROVIDE v_1b_list_b3 - - acc_tot = 0.d0 - normalz = 0.d0 - do ipoint = 1, n_points_final_grid - - r(1) = final_grid_points(1,ipoint) - r(2) = final_grid_points(2,ipoint) - r(3) = final_grid_points(3,ipoint) - - i_exc = v_1b_list_b3(ipoint) - i_num = j1b_nucl_square(r) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot on val = ', acc_tot - print*, ' normalz on val = ', normalz - - ! --- - - PROVIDE v_1b_square_grad - - acc_tot = 0.d0 - normalz = 0.d0 - do ipoint = 1, n_points_final_grid - - r(1) = final_grid_points(1,ipoint) - r(2) = final_grid_points(2,ipoint) - r(3) = final_grid_points(3,ipoint) - - i_exc = v_1b_square_grad(ipoint,1) - r(1) = r(1) + eps_der - ip = j1b_nucl_square(r) - r(1) = r(1) - 2.d0 * eps_der - im = j1b_nucl_square(r) - r(1) = r(1) + eps_der - i_num = tmp_der * (ip - im) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in grad_x list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - acc_tot += acc_ij - normalz += dabs(i_num) - - i_exc = v_1b_square_grad(ipoint,2) - r(2) = r(2) + eps_der - ip = j1b_nucl_square(r) - r(2) = r(2) - 2.d0 * eps_der - im = j1b_nucl_square(r) - r(2) = r(2) + eps_der - i_num = tmp_der * (ip - im) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in grad_y list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - acc_tot += acc_ij - normalz += dabs(i_num) - - i_exc = v_1b_square_grad(ipoint,3) - r(3) = r(3) + eps_der - ip = j1b_nucl_square(r) - r(3) = r(3) - 2.d0 * eps_der - im = j1b_nucl_square(r) - r(3) = r(3) + eps_der - i_num = tmp_der * (ip - im) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in grad_z list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot on grad = ', acc_tot - print*, ' normalz on grad = ', normalz - - ! --- - - PROVIDE v_1b_square_lapl - - acc_tot = 0.d0 - normalz = 0.d0 - do ipoint = 1, n_points_final_grid - - r(1) = final_grid_points(1,ipoint) - r(2) = final_grid_points(2,ipoint) - r(3) = final_grid_points(3,ipoint) - i0 = j1b_nucl_square(r) - - i_exc = v_1b_square_lapl(ipoint) - - r(1) = r(1) + eps_lap - ip = j1b_nucl_square(r) - r(1) = r(1) - 2.d0 * eps_lap - im = j1b_nucl_square(r) - r(1) = r(1) + eps_lap - i_num = tmp_lap * (ip - 2.d0 * i0 + im) - - r(2) = r(2) + eps_lap - ip = j1b_nucl_square(r) - r(2) = r(2) - 2.d0 * eps_lap - im = j1b_nucl_square(r) - r(2) = r(2) + eps_lap - i_num = i_num + tmp_lap * (ip - 2.d0 * i0 + im) - - r(3) = r(3) + eps_lap - ip = j1b_nucl_square(r) - r(3) = r(3) - 2.d0 * eps_lap - im = j1b_nucl_square(r) - r(3) = r(3) + eps_lap - i_num = i_num + tmp_lap * (ip - 2.d0 * i0 + im) - - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in lapl list_b3 on', ipoint - print *, ' r = ', r - print *, ' r2 = ', r(1)*r(1) + r(2)*r(2) + r(3)*r(3) - print *, ' analyt = ', i_exc - print *, ' numeri = ', i_num - print *, ' diff = ', acc_ij - endif - - acc_tot += acc_ij - normalz += dabs(i_num) - enddo - - print*, ' acc_tot on lapl = ', acc_tot - print*, ' normalz on lapl = ', normalz - - ! --- - - return -end subroutine test_list_b3 +end ! --- @@ -516,7 +244,7 @@ subroutine test_fit_ugradu() enddo return -end subroutine test_fit_ugradu +end ! --- @@ -582,7 +310,7 @@ subroutine test_fit_u() enddo return -end subroutine test_fit_u +end ! --- @@ -649,7 +377,7 @@ subroutine test_fit_u2() enddo return -end subroutine test_fit_u2 +end ! --- @@ -714,7 +442,7 @@ subroutine test_grad1_u12_withsq_num() print*, ' accuracy (%) = ', 100.d0 * acc_tot / normalz return -end subroutine test_grad1_u12_withsq_num +end ! --- diff --git a/src/non_h_ints_mu/debug_integ_jmu_modif.irp.f b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f similarity index 67% rename from src/non_h_ints_mu/debug_integ_jmu_modif.irp.f rename to plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f index b9e8df25..8d3a163c 100644 --- a/src/non_h_ints_mu/debug_integ_jmu_modif.irp.f +++ b/plugins/local/non_h_ints_mu/debug_integ_jmu_modif.irp.f @@ -11,40 +11,40 @@ program debug_integ_jmu_modif my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - PROVIDE mu_erf j1b_pen + PROVIDE mu_erf -! call test_v_ij_u_cst_mu_j1b() -! call test_v_ij_erf_rk_cst_mu_j1b() -! call test_x_v_ij_erf_rk_cst_mu_j1b() -! call test_int2_u2_j1b2() -! call test_int2_grad1u2_grad2u2_j1b2() -! call test_int2_u_grad1u_total_j1b2() +! call test_v_ij_u_cst_mu_env() +! call test_v_ij_erf_rk_cst_mu_env() +! call test_x_v_ij_erf_rk_cst_mu_env() +! call test_int2_u2_env2() +! call test_int2_grad1u2_grad2u2_env2() +! call test_int2_u_grad1u_total_env2() ! -! call test_int2_grad1_u12_ao() +! call test_int2_grad1_u12_ao_num() ! ! call test_grad12_j12() - call test_tchint_rsdft() -! call test_u12sq_j1bsq() -! call test_u12_grad1_u12_j1b_grad1_j1b() -! !call test_gradu_squared_u_ij_mu() +! call test_u12sq_envsq() +! call test_u12_grad1_u12_env_grad1_env() !call test_vect_overlap_gauss_r12_ao() !call test_vect_overlap_gauss_r12_ao_with1s() + !call test_Ir2_Mu_long_Du_0() + end ! --- -subroutine test_v_ij_u_cst_mu_j1b() +subroutine test_v_ij_u_cst_mu_env() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_v_ij_u_cst_mu_j1b + double precision, external :: num_v_ij_u_cst_mu_env - print*, ' test_v_ij_u_cst_mu_j1b ...' + print*, ' test_v_ij_u_cst_mu_env ...' - PROVIDE v_ij_u_cst_mu_j1b_fit + PROVIDE v_ij_u_cst_mu_env_fit eps_ij = 1d-3 acc_tot = 0.d0 @@ -54,11 +54,11 @@ subroutine test_v_ij_u_cst_mu_j1b() do j = 1, ao_num do i = 1, ao_num - i_exc = v_ij_u_cst_mu_j1b_fit(i,j,ipoint) - i_num = num_v_ij_u_cst_mu_j1b (i,j,ipoint) + i_exc = v_ij_u_cst_mu_env_fit(i,j,ipoint) + i_num = num_v_ij_u_cst_mu_env (i,j,ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in v_ij_u_cst_mu_j1b_fit on', i, j, ipoint + print *, ' problem in v_ij_u_cst_mu_env_fit on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -70,24 +70,23 @@ subroutine test_v_ij_u_cst_mu_j1b() enddo enddo - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz + print*, ' acc_tot (%) = ', 100.d0 * acc_tot / normalz return -end subroutine test_v_ij_u_cst_mu_j1b +end ! --- -subroutine test_v_ij_erf_rk_cst_mu_j1b() +subroutine test_v_ij_erf_rk_cst_mu_env() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_v_ij_erf_rk_cst_mu_j1b + double precision, external :: num_v_ij_erf_rk_cst_mu_env - print*, ' test_v_ij_erf_rk_cst_mu_j1b ...' + print*, ' test_v_ij_erf_rk_cst_mu_env ...' - PROVIDE v_ij_erf_rk_cst_mu_j1b + PROVIDE v_ij_erf_rk_cst_mu_env eps_ij = 1d-3 acc_tot = 0.d0 @@ -98,11 +97,11 @@ subroutine test_v_ij_erf_rk_cst_mu_j1b() do j = 1, ao_num do i = 1, ao_num - i_exc = v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) - i_num = num_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) + i_exc = v_ij_erf_rk_cst_mu_env(i,j,ipoint) + i_num = num_v_ij_erf_rk_cst_mu_env(i,j,ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in v_ij_erf_rk_cst_mu_j1b on', i, j, ipoint + print *, ' problem in v_ij_erf_rk_cst_mu_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -118,20 +117,20 @@ subroutine test_v_ij_erf_rk_cst_mu_j1b() print*, ' normalz = ', normalz return -end subroutine test_v_ij_erf_rk_cst_mu_j1b +end ! --- -subroutine test_x_v_ij_erf_rk_cst_mu_j1b() +subroutine test_x_v_ij_erf_rk_cst_mu_env() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz double precision :: integ(3) - print*, ' test_x_v_ij_erf_rk_cst_mu_j1b ...' + print*, ' test_x_v_ij_erf_rk_cst_mu_env ...' - PROVIDE x_v_ij_erf_rk_cst_mu_j1b + PROVIDE x_v_ij_erf_rk_cst_mu_env eps_ij = 1d-3 acc_tot = 0.d0 @@ -142,13 +141,13 @@ subroutine test_x_v_ij_erf_rk_cst_mu_j1b() do j = 1, ao_num do i = 1, ao_num - call num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) + call num_x_v_ij_erf_rk_cst_mu_env(i, j, ipoint, integ) - i_exc = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1) + i_exc = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) i_num = integ(1) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in x part of x_v_ij_erf_rk_cst_mu_j1b on', i, j, ipoint + print *, ' problem in x part of x_v_ij_erf_rk_cst_mu_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -156,11 +155,11 @@ subroutine test_x_v_ij_erf_rk_cst_mu_j1b() acc_tot += acc_ij normalz += dabs(i_num) - i_exc = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2) + i_exc = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) i_num = integ(2) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in y part of x_v_ij_erf_rk_cst_mu_j1b on', i, j, ipoint + print *, ' problem in y part of x_v_ij_erf_rk_cst_mu_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -168,11 +167,11 @@ subroutine test_x_v_ij_erf_rk_cst_mu_j1b() acc_tot += acc_ij normalz += dabs(i_num) - i_exc = x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3) + i_exc = x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) i_num = integ(3) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in z part of x_v_ij_erf_rk_cst_mu_j1b on', i, j, ipoint + print *, ' problem in z part of x_v_ij_erf_rk_cst_mu_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -188,35 +187,34 @@ subroutine test_x_v_ij_erf_rk_cst_mu_j1b() print*, ' normalz = ', normalz return -end subroutine test_x_v_ij_erf_rk_cst_mu_j1b +end ! --- -subroutine test_int2_u2_j1b2() +subroutine test_int2_u2_env2() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_int2_u2_j1b2 + double precision, external :: num_int2_u2_env2 - print*, ' test_int2_u2_j1b2 ...' + print*, ' test_int2_u2_env2 ...' - PROVIDE int2_u2_j1b2 + PROVIDE int2_u2_env2 eps_ij = 1d-3 acc_tot = 0.d0 normalz = 0.d0 - !do ipoint = 1, 10 do ipoint = 1, n_points_final_grid do j = 1, ao_num do i = 1, ao_num - i_exc = int2_u2_j1b2(i,j,ipoint) - i_num = num_int2_u2_j1b2(i,j,ipoint) + i_exc = int2_u2_env2(i,j,ipoint) + i_num = num_int2_u2_env2(i,j,ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in int2_u2_j1b2 on', i, j, ipoint + print *, ' problem in int2_u2_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -233,20 +231,20 @@ subroutine test_int2_u2_j1b2() print*, ' normalz = ', normalz return -end subroutine test_int2_u2_j1b2 +end ! --- -subroutine test_int2_grad1u2_grad2u2_j1b2() +subroutine test_int2_grad1u2_grad2u2_env2() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_int2_grad1u2_grad2u2_j1b2 + double precision, external :: num_int2_grad1u2_grad2u2_env2 - print*, ' test_int2_grad1u2_grad2u2_j1b2 ...' + print*, ' test_int2_grad1u2_grad2u2_env2 ...' - PROVIDE int2_grad1u2_grad2u2_j1b2 + PROVIDE int2_grad1u2_grad2u2_env2 eps_ij = 1d-3 acc_tot = 0.d0 @@ -257,11 +255,11 @@ subroutine test_int2_grad1u2_grad2u2_j1b2() do j = 1, ao_num do i = 1, ao_num - i_exc = int2_grad1u2_grad2u2_j1b2(i,j,ipoint) - i_num = num_int2_grad1u2_grad2u2_j1b2(i,j,ipoint) + i_exc = int2_grad1u2_grad2u2_env2(i,j,ipoint) + i_num = num_int2_grad1u2_grad2u2_env2(i,j,ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in int2_grad1u2_grad2u2_j1b2 on', i, j, ipoint + print *, ' problem in int2_grad1u2_grad2u2_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -277,18 +275,18 @@ subroutine test_int2_grad1u2_grad2u2_j1b2() print*, ' normalz = ', normalz return -end subroutine test_int2_grad1u2_grad2u2_j1b2 +end ! --- -subroutine test_int2_grad1_u12_ao() +subroutine test_int2_grad1_u12_ao_num() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz double precision :: integ(3) - print*, ' test_int2_grad1_u12_ao ...' + print*, ' test_int2_grad1_u12_ao_num ...' PROVIDE int2_grad1_u12_ao @@ -346,11 +344,11 @@ subroutine test_int2_grad1_u12_ao() print*, ' normalz = ', normalz return -end subroutine test_int2_grad1_u12_ao +end ! --- -subroutine test_int2_u_grad1u_total_j1b2() +subroutine test_int2_u_grad1u_total_env2() implicit none integer :: i, j, ipoint @@ -358,10 +356,10 @@ subroutine test_int2_u_grad1u_total_j1b2() double precision :: x, y, z double precision :: integ(3) - print*, ' test_int2_u_grad1u_total_j1b2 ...' + print*, ' test_int2_u_grad1u_total_env2 ...' - PROVIDE int2_u_grad1u_j1b2 - PROVIDE int2_u_grad1u_x_j1b2 + PROVIDE int2_u_grad1u_env2 + PROVIDE int2_u_grad1u_x_env2 eps_ij = 1d-3 acc_tot = 0.d0 @@ -376,13 +374,13 @@ subroutine test_int2_u_grad1u_total_j1b2() do j = 1, ao_num do i = 1, ao_num - call num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) + call num_int2_u_grad1u_total_env2(i, j, ipoint, integ) - i_exc = x * int2_u_grad1u_j1b2(i,j,ipoint) - int2_u_grad1u_x_j1b2(i,j,ipoint,1) + i_exc = x * int2_u_grad1u_env2(i,j,ipoint) - int2_u_grad1u_x_env2(i,j,ipoint,1) i_num = integ(1) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in x part of int2_u_grad1u_total_j1b2 on', i, j, ipoint + print *, ' problem in x part of int2_u_grad1u_total_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -390,11 +388,11 @@ subroutine test_int2_u_grad1u_total_j1b2() acc_tot += acc_ij normalz += dabs(i_num) - i_exc = y * int2_u_grad1u_j1b2(i,j,ipoint) - int2_u_grad1u_x_j1b2(i,j,ipoint,2) + i_exc = y * int2_u_grad1u_env2(i,j,ipoint) - int2_u_grad1u_x_env2(i,j,ipoint,2) i_num = integ(2) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in y part of int2_u_grad1u_total_j1b2 on', i, j, ipoint + print *, ' problem in y part of int2_u_grad1u_total_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -402,11 +400,11 @@ subroutine test_int2_u_grad1u_total_j1b2() acc_tot += acc_ij normalz += dabs(i_num) - i_exc = z * int2_u_grad1u_j1b2(i,j,ipoint) - int2_u_grad1u_x_j1b2(i,j,ipoint,3) + i_exc = z * int2_u_grad1u_env2(i,j,ipoint) - int2_u_grad1u_x_env2(i,j,ipoint,3) i_num = integ(3) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in z part of int2_u_grad1u_total_j1b2 on', i, j, ipoint + print *, ' problem in z part of int2_u_grad1u_total_env2 on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -422,109 +420,7 @@ subroutine test_int2_u_grad1u_total_j1b2() print*, ' normalz = ', normalz return -end subroutine test_int2_u_grad1u_total_j1b2 - -! --- - -subroutine test_gradu_squared_u_ij_mu() - - implicit none - integer :: i, j, ipoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_gradu_squared_u_ij_mu - - print*, ' test_gradu_squared_u_ij_mu ...' - - PROVIDE gradu_squared_u_ij_mu - - eps_ij = 1d-3 - acc_tot = 0.d0 - normalz = 0.d0 - - do ipoint = 1, n_points_final_grid - do j = 1, ao_num - do i = 1, ao_num - - i_exc = gradu_squared_u_ij_mu(i,j,ipoint) - i_num = num_gradu_squared_u_ij_mu(i, j, ipoint) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem in gradu_squared_u_ij_mu on', i, j, ipoint - print *, ' analyt integ = ', i_exc - print *, ' numeri integ = ', i_num - print *, ' diff = ', acc_ij - endif - acc_tot += acc_ij - normalz += dabs(i_num) - - enddo - enddo - enddo - - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz - - return -end subroutine test_gradu_squared_u_ij_mu - -! --- - -subroutine test_tchint_rsdft() - - implicit none - integer :: i, j, m, ipoint, jpoint - double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision :: x(3), y(3), dj_1(3), dj_2(3), dj_3(3) - - print*, ' test rsdft_jastrow ...' - - PROVIDE grad1_u12_num - - eps_ij = 1d-4 - acc_tot = 0.d0 - normalz = 0.d0 - - do ipoint = 1, n_points_final_grid - x(1) = final_grid_points(1,ipoint) - x(2) = final_grid_points(2,ipoint) - x(3) = final_grid_points(3,ipoint) - - do jpoint = 1, n_points_extra_final_grid - y(1) = final_grid_points_extra(1,jpoint) - y(2) = final_grid_points_extra(2,jpoint) - y(3) = final_grid_points_extra(3,jpoint) - - dj_1(1) = grad1_u12_num(jpoint,ipoint,1) - dj_1(2) = grad1_u12_num(jpoint,ipoint,2) - dj_1(3) = grad1_u12_num(jpoint,ipoint,3) - - call get_tchint_rsdft_jastrow(x, y, dj_2) - - do m = 1, 3 - i_exc = dj_1(m) - i_num = dj_2(m) - acc_ij = dabs(i_exc - i_num) - if(acc_ij .gt. eps_ij) then - print *, ' problem on', ipoint, jpoint, m - print *, ' x = ', x - print *, ' y = ', y - print *, ' exc, num, diff = ', i_exc, i_num, acc_ij - call grad1_jmu_modif_num(x, y, dj_3) - print *, ' check = ', dj_3(m) - stop - endif - - acc_tot += acc_ij - normalz += dabs(i_exc) - enddo - enddo - enddo - - print*, ' acc_tot = ', acc_tot - print*, ' normalz = ', normalz - - return -end subroutine test_tchint_rsdft +end ! --- @@ -567,20 +463,20 @@ subroutine test_grad12_j12() print*, ' normalz = ', normalz return -end subroutine test_grad12_j12 +end ! --- -subroutine test_u12sq_j1bsq() +subroutine test_u12sq_envsq() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_u12sq_j1bsq + double precision, external :: num_u12sq_envsq - print*, ' test_u12sq_j1bsq ...' + print*, ' test_u12sq_envsq ...' - PROVIDE u12sq_j1bsq + PROVIDE u12sq_envsq eps_ij = 1d-3 acc_tot = 0.d0 @@ -590,11 +486,11 @@ subroutine test_u12sq_j1bsq() do j = 1, ao_num do i = 1, ao_num - i_exc = u12sq_j1bsq(i,j,ipoint) - i_num = num_u12sq_j1bsq(i, j, ipoint) + i_exc = u12sq_envsq(i,j,ipoint) + i_num = num_u12sq_envsq(i, j, ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in u12sq_j1bsq on', i, j, ipoint + print *, ' problem in u12sq_envsq on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -610,20 +506,20 @@ subroutine test_u12sq_j1bsq() print*, ' normalz = ', normalz return -end subroutine test_u12sq_j1bsq +end ! --- -subroutine test_u12_grad1_u12_j1b_grad1_j1b() +subroutine test_u12_grad1_u12_env_grad1_env() implicit none integer :: i, j, ipoint double precision :: acc_ij, acc_tot, eps_ij, i_exc, i_num, normalz - double precision, external :: num_u12_grad1_u12_j1b_grad1_j1b + double precision, external :: num_u12_grad1_u12_env_grad1_env - print*, ' test_u12_grad1_u12_j1b_grad1_j1b ...' + print*, ' test_u12_grad1_u12_env_grad1_env ...' - PROVIDE u12_grad1_u12_j1b_grad1_j1b + PROVIDE u12_grad1_u12_env_grad1_env eps_ij = 1d-3 acc_tot = 0.d0 @@ -633,11 +529,11 @@ subroutine test_u12_grad1_u12_j1b_grad1_j1b() do j = 1, ao_num do i = 1, ao_num - i_exc = u12_grad1_u12_j1b_grad1_j1b(i,j,ipoint) - i_num = num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint) + i_exc = u12_grad1_u12_env_grad1_env(i,j,ipoint) + i_num = num_u12_grad1_u12_env_grad1_env(i, j, ipoint) acc_ij = dabs(i_exc - i_num) if(acc_ij .gt. eps_ij) then - print *, ' problem in u12_grad1_u12_j1b_grad1_j1b on', i, j, ipoint + print *, ' problem in u12_grad1_u12_env_grad1_env on', i, j, ipoint print *, ' analyt integ = ', i_exc print *, ' numeri integ = ', i_num print *, ' diff = ', acc_ij @@ -653,7 +549,7 @@ subroutine test_u12_grad1_u12_j1b_grad1_j1b() print*, ' normalz = ', normalz return -end subroutine test_u12_grad1_u12_j1b_grad1_j1b +end ! --- @@ -670,7 +566,7 @@ subroutine test_vect_overlap_gauss_r12_ao() print *, ' test_vect_overlap_gauss_r12_ao ...' - provide mu_erf final_grid_points_transp j1b_pen + provide mu_erf final_grid_points_transp expo_fit = expo_gauss_j_mu_x_2(1) @@ -740,7 +636,7 @@ subroutine test_vect_overlap_gauss_r12_ao() print*, ' normalz = ', normalz return -end subroutine test_vect_overlap_gauss_r12_ao +end ! --- @@ -757,13 +653,13 @@ subroutine test_vect_overlap_gauss_r12_ao_with1s() print *, ' test_vect_overlap_gauss_r12_ao_with1s ...' - provide mu_erf final_grid_points_transp j1b_pen + provide mu_erf final_grid_points_transp expo_fit = expo_gauss_j_mu_x_2(1) - beta = List_all_comb_b3_expo (2) - B_center(1) = List_all_comb_b3_cent(1,2) - B_center(2) = List_all_comb_b3_cent(2,2) - B_center(3) = List_all_comb_b3_cent(3,2) + beta = List_env1s_square_expo (2) + B_center(1) = List_env1s_square_cent(1,2) + B_center(2) = List_env1s_square_cent(2,2) + B_center(3) = List_env1s_square_cent(3,2) ! --- @@ -831,5 +727,52 @@ subroutine test_vect_overlap_gauss_r12_ao_with1s() print*, ' normalz = ', normalz return -end subroutine test_vect_overlap_gauss_r12_ao +end + +! --- + +subroutine test_Ir2_Mu_long_Du_0() + + implicit none + integer :: i, j, ipoint + double precision :: i_old, i_new + double precision :: acc_ij, acc_tot, eps_ij, normalz + + print*, ' test_Ir2_Mu_long_Du_0 ...' + + PROVIDE v_ij_erf_rk_cst_mu_env + PROVIDE Ir2_Mu_long_Du_0 + + eps_ij = 1d-10 + acc_tot = 0.d0 + normalz = 0.d0 + + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + + i_old = v_ij_erf_rk_cst_mu_env(i,j,ipoint) + i_new = Ir2_Mu_long_Du_0 (i,j,ipoint) + + acc_ij = dabs(i_old - i_new) + if(acc_ij .gt. eps_ij) then + print *, ' problem in Ir2_Mu_long_Du_0 on', i, j, ipoint + print *, ' old integ = ', i_old + print *, ' new integ = ', i_new + print *, ' diff = ', acc_ij + stop + endif + + acc_tot += acc_ij + normalz += dabs(i_old) + enddo + enddo + enddo + + print*, ' acc_tot (%) = ', 100.d0 * acc_tot / normalz + + return +end + +! --- diff --git a/plugins/local/non_h_ints_mu/grad_squared.irp.f b/plugins/local/non_h_ints_mu/grad_squared.irp.f new file mode 100644 index 00000000..342e1fe7 --- /dev/null +++ b/plugins/local/non_h_ints_mu/grad_squared.irp.f @@ -0,0 +1,125 @@ + +! --- + +BEGIN_PROVIDER [double precision, grad12_j12, (ao_num, ao_num, n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, m, igauss + double precision :: r(3), delta, coef + double precision :: tmp1 + double precision :: time0, time1 + double precision, external :: overlap_gauss_r12_ao + + print*, ' providing grad12_j12 ...' + call wall_time(time0) + + PROVIDE int2_grad1u2_grad2u2_env2 + + do ipoint = 1, n_points_final_grid + tmp1 = env_val(ipoint) + tmp1 = tmp1 * tmp1 + do j = 1, ao_num + do i = 1, ao_num + grad12_j12(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_env2(i,j,ipoint) + enddo + enddo + enddo + + FREE int2_grad1u2_grad2u2_env2 + + call wall_time(time1) + print*, ' Wall time for grad12_j12 (min) = ', (time1 - time0) / 60.d0 + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, u12sq_envsq, (ao_num, ao_num, n_points_final_grid)] + + implicit none + integer :: ipoint, i, j + double precision :: tmp_x, tmp_y, tmp_z + double precision :: tmp1 + double precision :: time0, time1 + + print*, ' providing u12sq_envsq ...' + call wall_time(time0) + + ! do not free here + PROVIDE int2_u2_env2 + + do ipoint = 1, n_points_final_grid + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) + tmp1 = -0.5d0 * (tmp_x * tmp_x + tmp_y * tmp_y + tmp_z * tmp_z) + do j = 1, ao_num + do i = 1, ao_num + u12sq_envsq(i,j,ipoint) = tmp1 * int2_u2_env2(i,j,ipoint) + enddo + enddo + enddo + + call wall_time(time1) + print*, ' Wall time for u12sq_envsq (min) = ', (time1 - time0) / 60.d0 + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, u12_grad1_u12_env_grad1_env, (ao_num, ao_num, n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, m, igauss + double precision :: x, y, z + double precision :: tmp_v, tmp_x, tmp_y, tmp_z + double precision :: tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9 + double precision :: time0, time1 + double precision, external :: overlap_gauss_r12_ao + + print*, ' providing u12_grad1_u12_env_grad1_env ...' + call wall_time(time0) + + PROVIDE int2_u_grad1u_env2 + PROVIDE int2_u_grad1u_x_env2 + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + tmp_v = env_val (ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) + + tmp3 = tmp_v * tmp_x + tmp4 = tmp_v * tmp_y + tmp5 = tmp_v * tmp_z + + tmp6 = -x * tmp3 + tmp7 = -y * tmp4 + tmp8 = -z * tmp5 + + do j = 1, ao_num + do i = 1, ao_num + + tmp9 = int2_u_grad1u_env2(i,j,ipoint) + + u12_grad1_u12_env_grad1_env(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_env2(i,j,ipoint,1) & + + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_env2(i,j,ipoint,2) & + + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_env2(i,j,ipoint,3) + enddo + enddo + enddo + + FREE int2_u_grad1u_env2 + FREE int2_u_grad1u_x_env2 + + call wall_time(time1) + print*, ' Wall time for u12_grad1_u12_env_grad1_env (min) = ', (time1 - time0) / 60.d0 + +END_PROVIDER + +! --- + diff --git a/src/non_h_ints_mu/grad_squared_manu.irp.f b/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f similarity index 73% rename from src/non_h_ints_mu/grad_squared_manu.irp.f rename to plugins/local/non_h_ints_mu/grad_squared_manu.irp.f index dcfeff47..8bfddf7e 100644 --- a/src/non_h_ints_mu/grad_squared_manu.irp.f +++ b/plugins/local/non_h_ints_mu/grad_squared_manu.irp.f @@ -1,4 +1,6 @@ +! --- + BEGIN_PROVIDER [double precision, tc_grad_square_ao_test, (ao_num, ao_num, ao_num, ao_num)] BEGIN_DOC @@ -24,7 +26,7 @@ BEGIN_PROVIDER [double precision, tc_grad_square_ao_test, (ao_num, ao_num, ao_nu else - provide u12sq_j1bsq_test u12_grad1_u12_j1b_grad1_j1b_test grad12_j12_test + provide u12sq_envsq_test u12_grad1_u12_env_grad1_env_test grad12_j12_test allocate(b_mat(n_points_final_grid,ao_num,ao_num), tmp(ao_num,ao_num,n_points_final_grid)) @@ -48,12 +50,12 @@ BEGIN_PROVIDER [double precision, tc_grad_square_ao_test, (ao_num, ao_num, ao_nu !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (j, l, ipoint) & - !$OMP SHARED (tmp, ao_num, n_points_final_grid, u12sq_j1bsq_test, u12_grad1_u12_j1b_grad1_j1b_test, grad12_j12_test) + !$OMP SHARED (tmp, ao_num, n_points_final_grid, u12sq_envsq_test, u12_grad1_u12_env_grad1_env_test, grad12_j12_test) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid do j = 1, ao_num do l = 1, ao_num - tmp(l,j,ipoint) = u12sq_j1bsq_test(l,j,ipoint) + u12_grad1_u12_j1b_grad1_j1b_test(l,j,ipoint) + 0.5d0 * grad12_j12_test(l,j,ipoint) + tmp(l,j,ipoint) = u12sq_envsq_test(l,j,ipoint) + u12_grad1_u12_env_grad1_env_test(l,j,ipoint) + 0.5d0 * grad12_j12_test(l,j,ipoint) enddo enddo enddo @@ -102,7 +104,7 @@ BEGIN_PROVIDER [double precision, tc_grad_square_ao_test_ref, (ao_num, ao_num, a print*, ' providing tc_grad_square_ao_test_ref ...' call wall_time(time0) - provide u12sq_j1bsq_test u12_grad1_u12_j1b_grad1_j1b_test grad12_j12_test + provide u12sq_envsq_test u12_grad1_u12_env_grad1_env_test grad12_j12_test allocate(ac_mat(ao_num,ao_num,ao_num,ao_num), b_mat(n_points_final_grid,ao_num,ao_num), tmp(ao_num,ao_num,n_points_final_grid)) @@ -126,12 +128,12 @@ BEGIN_PROVIDER [double precision, tc_grad_square_ao_test_ref, (ao_num, ao_num, a !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (j, l, ipoint) & - !$OMP SHARED (tmp, ao_num, n_points_final_grid, u12sq_j1bsq_test, u12_grad1_u12_j1b_grad1_j1b_test, grad12_j12_test) + !$OMP SHARED (tmp, ao_num, n_points_final_grid, u12sq_envsq_test, u12_grad1_u12_env_grad1_env_test, grad12_j12_test) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid do j = 1, ao_num do l = 1, ao_num - tmp(l,j,ipoint) = u12sq_j1bsq_test(l,j,ipoint) + u12_grad1_u12_j1b_grad1_j1b_test(l,j,ipoint) + 0.5d0 * grad12_j12_test(l,j,ipoint) + tmp(l,j,ipoint) = u12sq_envsq_test(l,j,ipoint) + u12_grad1_u12_env_grad1_env_test(l,j,ipoint) + 0.5d0 * grad12_j12_test(l,j,ipoint) enddo enddo enddo @@ -170,7 +172,7 @@ END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, u12sq_j1bsq_test, (ao_num, ao_num, n_points_final_grid) ] +BEGIN_PROVIDER [ double precision, u12sq_envsq_test, (ao_num, ao_num, n_points_final_grid) ] implicit none integer :: ipoint, i, j @@ -178,29 +180,29 @@ BEGIN_PROVIDER [ double precision, u12sq_j1bsq_test, (ao_num, ao_num, n_points_f double precision :: tmp1 double precision :: time0, time1 - print*, ' providing u12sq_j1bsq_test ...' + print*, ' providing u12sq_envsq_test ...' call wall_time(time0) do ipoint = 1, n_points_final_grid - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) tmp1 = -0.5d0 * (tmp_x * tmp_x + tmp_y * tmp_y + tmp_z * tmp_z) do j = 1, ao_num do i = 1, ao_num - u12sq_j1bsq_test(i,j,ipoint) = tmp1 * int2_u2_j1b2_test(i,j,ipoint) + u12sq_envsq_test(i,j,ipoint) = tmp1 * int2_u2_env2_test(i,j,ipoint) enddo enddo enddo call wall_time(time1) - print*, ' Wall time for u12sq_j1bsq_test = ', time1 - time0 + print*, ' Wall time for u12sq_envsq_test (min) = ', (time1 - time0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao_num, n_points_final_grid) ] +BEGIN_PROVIDER [double precision, u12_grad1_u12_env_grad1_env_test, (ao_num, ao_num, n_points_final_grid)] implicit none integer :: ipoint, i, j, m, igauss @@ -210,9 +212,9 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao double precision :: time0, time1 double precision, external :: overlap_gauss_r12_ao - print*, ' providing u12_grad1_u12_j1b_grad1_j1b_test ...' + print*, ' providing u12_grad1_u12_env_grad1_env_test ...' - provide int2_u_grad1u_x_j1b2_test + provide int2_u_grad1u_x_env2_test call wall_time(time0) do ipoint = 1, n_points_final_grid @@ -220,10 +222,10 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao x = final_grid_points(1,ipoint) y = final_grid_points(2,ipoint) z = final_grid_points(3,ipoint) - tmp_v = v_1b (ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) + tmp_v = env_val (ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) tmp3 = tmp_v * tmp_x tmp4 = tmp_v * tmp_y @@ -236,23 +238,23 @@ BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b_test, (ao_num, ao do j = 1, ao_num do i = 1, ao_num - tmp9 = int2_u_grad1u_j1b2_test(i,j,ipoint) + tmp9 = int2_u_grad1u_env2_test(i,j,ipoint) - u12_grad1_u12_j1b_grad1_j1b_test(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_j1b2_test(i,j,ipoint,1) & - + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_j1b2_test(i,j,ipoint,2) & - + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_j1b2_test(i,j,ipoint,3) + u12_grad1_u12_env_grad1_env_test(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_env2_test(i,j,ipoint,1) & + + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_env2_test(i,j,ipoint,2) & + + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_env2_test(i,j,ipoint,3) enddo enddo enddo call wall_time(time1) - print*, ' Wall time for u12_grad1_u12_j1b_grad1_j1b_test = ', time1 - time0 + print*, ' Wall time for u12_grad1_u12_env_grad1_env_test (min) = ', (time1 - time0) / 60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, grad12_j12_test, (ao_num, ao_num, n_points_final_grid) ] +BEGIN_PROVIDER [double precision, grad12_j12_test, (ao_num, ao_num, n_points_final_grid)] implicit none integer :: ipoint, i, j, m, igauss @@ -260,46 +262,32 @@ BEGIN_PROVIDER [ double precision, grad12_j12_test, (ao_num, ao_num, n_points_fi double precision :: tmp1 double precision :: time0, time1 double precision, external :: overlap_gauss_r12_ao - provide int2_grad1u2_grad2u2_j1b2_test + + provide int2_grad1u2_grad2u2_env2_test print*, ' providing grad12_j12_test ...' call wall_time(time0) - PROVIDE j1b_type - - if(j1b_type .eq. 3) then + if((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then do ipoint = 1, n_points_final_grid - tmp1 = v_1b(ipoint) + tmp1 = env_val(ipoint) tmp1 = tmp1 * tmp1 do j = 1, ao_num do i = 1, ao_num - grad12_j12_test(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint) + grad12_j12_test(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_env2_test(i,j,ipoint) enddo enddo enddo else - grad12_j12_test = 0.d0 - do ipoint = 1, n_points_final_grid - r(1) = final_grid_points(1,ipoint) - r(2) = final_grid_points(2,ipoint) - r(3) = final_grid_points(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - do igauss = 1, n_max_fit_slat - delta = expo_gauss_1_erf_x_2(igauss) - coef = coef_gauss_1_erf_x_2(igauss) - grad12_j12_test(i,j,ipoint) += -0.25d0 * coef * overlap_gauss_r12_ao(r, delta, i, j) - enddo - enddo - enddo - enddo + print *, ' Error in grad12_j12_test: Unknown Jastrow' + stop endif call wall_time(time1) - print*, ' Wall time for grad12_j12_test = ', time1 - time0 + print*, ' Wall time for grad12_j12_test (min) = ', (time1 - time0) / 60.d0 END_PROVIDER diff --git a/src/non_h_ints_mu/grad_tc_int.irp.f b/plugins/local/non_h_ints_mu/grad_tc_int.irp.f similarity index 100% rename from src/non_h_ints_mu/grad_tc_int.irp.f rename to plugins/local/non_h_ints_mu/grad_tc_int.irp.f diff --git a/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f new file mode 100644 index 00000000..40b55ee0 --- /dev/null +++ b/plugins/local/non_h_ints_mu/j12_nucl_utils.irp.f @@ -0,0 +1,584 @@ + +! --- + +BEGIN_PROVIDER [double precision, env_val, (n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, phase + double precision :: x, y, z, dx, dy, dz + double precision :: a, d, e, fact_r + + if(env_type .eq. "Prod_Gauss") then + + ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + fact_r = 1.d0 + do j = 1, nucl_num + a = env_expo(j) + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + d = dx*dx + dy*dy + dz*dz + e = 1.d0 - dexp(-a*d) + + fact_r = fact_r * e + enddo + + env_val(ipoint) = fact_r + enddo + + elseif(env_type .eq. "Sum_Gauss") then + + ! v(r) = 1 - \sum_{a} \beta_a \exp(-\alpha_a (r - r_a)^2) + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + fact_r = 1.d0 + do j = 1, nucl_num + a = env_expo(j) + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + d = dx*dx + dy*dy + dz*dz + + fact_r = fact_r - env_coef(j) * dexp(-a*d) + enddo + + env_val(ipoint) = fact_r + enddo + + else + + print *, ' Error in env_val: Unknown env_type = ', env_type + stop + + endif + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, env_grad, (3, n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, phase + double precision :: x, y, z, dx, dy, dz, r2 + double precision :: a, d, e + double precision :: fact_x, fact_y, fact_z + double precision :: ax_der, ay_der, az_der, a_expo + + if(env_type .eq. "Prod_Gauss") then + + ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + fact_x = 0.d0 + fact_y = 0.d0 + fact_z = 0.d0 + do i = 1, List_env1s_size + + phase = 0 + a_expo = 0.d0 + ax_der = 0.d0 + ay_der = 0.d0 + az_der = 0.d0 + do j = 1, nucl_num + a = dble(List_env1s(j,i)) * env_expo(j) + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + + phase += List_env1s(j,i) + a_expo += a * (dx*dx + dy*dy + dz*dz) + ax_der += a * dx + ay_der += a * dy + az_der += a * dz + enddo + e = -2.d0 * (-1.d0)**dble(phase) * dexp(-a_expo) + + fact_x += e * ax_der + fact_y += e * ay_der + fact_z += e * az_der + enddo + + env_grad(1,ipoint) = fact_x + env_grad(2,ipoint) = fact_y + env_grad(3,ipoint) = fact_z + enddo + + elseif(env_type .eq. "Sum_Gauss") then + + ! v(r) = 1 - \sum_{a} \beta_a \exp(-\alpha_a (r - r_a)^2) + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + ax_der = 0.d0 + ay_der = 0.d0 + az_der = 0.d0 + do j = 1, nucl_num + + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + r2 = dx*dx + dy*dy + dz*dz + + a = env_expo(j) + e = a * env_coef(j) * dexp(-a * r2) + + ax_der += e * dx + ay_der += e * dy + az_der += e * dz + enddo + + env_grad(1,ipoint) = 2.d0 * ax_der + env_grad(2,ipoint) = 2.d0 * ay_der + env_grad(3,ipoint) = 2.d0 * az_der + enddo + + else + + print *, ' Error in env_grad: Unknown env_type = ', env_type + stop + + endif + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, env_square_grad, (n_points_final_grid,3)] +&BEGIN_PROVIDER [double precision, env_square_lapl, (n_points_final_grid) ] + + implicit none + integer :: ipoint, i + double precision :: x, y, z, dx, dy, dz, r2 + double precision :: coef, expo, a_expo, tmp + double precision :: fact_x, fact_y, fact_z, fact_r + + PROVIDE List_env1s_square_coef List_env1s_square_expo List_env1s_square_cent + + if((env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss")) then + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + fact_x = 0.d0 + fact_y = 0.d0 + fact_z = 0.d0 + fact_r = 0.d0 + do i = 1, List_env1s_square_size + + coef = List_env1s_square_coef(i) + expo = List_env1s_square_expo(i) + + dx = x - List_env1s_square_cent(1,i) + dy = y - List_env1s_square_cent(2,i) + dz = z - List_env1s_square_cent(3,i) + r2 = dx * dx + dy * dy + dz * dz + + a_expo = expo * r2 + tmp = coef * expo * dexp(-a_expo) + + fact_x += tmp * dx + fact_y += tmp * dy + fact_z += tmp * dz + fact_r += tmp * (3.d0 - 2.d0 * a_expo) + enddo + + env_square_grad(ipoint,1) = -2.d0 * fact_x + env_square_grad(ipoint,2) = -2.d0 * fact_y + env_square_grad(ipoint,3) = -2.d0 * fact_z + env_square_lapl(ipoint) = -2.d0 * fact_r + enddo + + else + + print *, ' Error in env_val_square_grad & env_val_square_lapl: Unknown env_type = ', env_type + stop + + endif + +END_PROVIDER + +! --- + +double precision function j12_mu_r12(r12) + + include 'constants.include.F' + + implicit none + double precision, intent(in) :: r12 + double precision :: mu_r12 + + mu_r12 = mu_erf * r12 + + j12_mu_r12 = 0.5d0 * r12 * (1.d0 - derf(mu_r12)) - inv_sq_pi_2 * dexp(-mu_r12*mu_r12) / mu_erf + + return +end + +! --- + +double precision function jmu_modif(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision, external :: j12_mu, j12_nucl + + jmu_modif = j12_mu(r1, r2) * j12_nucl(r1, r2) + + return +end + +! --- + +double precision function j12_mu_gauss(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + integer :: i + double precision :: r12, coef, expo + + r12 = (r1(1) - r2(1)) * (r1(1) - r2(1)) & + + (r1(2) - r2(2)) * (r1(2) - r2(2)) & + + (r1(3) - r2(3)) * (r1(3) - r2(3)) + + j12_mu_gauss = 0.d0 + do i = 1, n_max_fit_slat + expo = expo_gauss_j_mu_x(i) + coef = coef_gauss_j_mu_x(i) + + j12_mu_gauss += coef * dexp(-expo*r12) + enddo + + return +end + +! --- + +double precision function j12_nucl(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision, external :: env_nucl + + j12_nucl = env_nucl(r1) * env_nucl(r2) + + return +end + +! --- + +double precision function grad_x_env_nucl_num(r) + + implicit none + double precision, intent(in) :: r(3) + double precision :: r_eps(3), eps, fp, fm, delta + double precision, external :: env_nucl + + eps = 1d-6 + r_eps = r + delta = max(eps, dabs(eps*r(1))) + + r_eps(1) = r_eps(1) + delta + fp = env_nucl(r_eps) + r_eps(1) = r_eps(1) - 2.d0 * delta + fm = env_nucl(r_eps) + + grad_x_env_nucl_num = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +double precision function grad_y_env_nucl_num(r) + + implicit none + double precision, intent(in) :: r(3) + double precision :: r_eps(3), eps, fp, fm, delta + double precision, external :: env_nucl + + eps = 1d-6 + r_eps = r + delta = max(eps, dabs(eps*r(2))) + + r_eps(2) = r_eps(2) + delta + fp = env_nucl(r_eps) + r_eps(2) = r_eps(2) - 2.d0 * delta + fm = env_nucl(r_eps) + + grad_y_env_nucl_num = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +double precision function grad_z_env_nucl_num(r) + + implicit none + double precision, intent(in) :: r(3) + double precision :: r_eps(3), eps, fp, fm, delta + double precision, external :: env_nucl + + eps = 1d-6 + r_eps = r + delta = max(eps, dabs(eps*r(3))) + + r_eps(3) = r_eps(3) + delta + fp = env_nucl(r_eps) + r_eps(3) = r_eps(3) - 2.d0 * delta + fm = env_nucl(r_eps) + + grad_z_env_nucl_num = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +double precision function lapl_env_nucl(r) + + implicit none + double precision, intent(in) :: r(3) + double precision :: r_eps(3), eps, fp, fm, delta + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num + + eps = 1d-5 + r_eps = r + + lapl_env_nucl = 0.d0 + + ! --- + + delta = max(eps, dabs(eps*r(1))) + r_eps(1) = r_eps(1) + delta + fp = grad_x_env_nucl_num(r_eps) + r_eps(1) = r_eps(1) - 2.d0 * delta + fm = grad_x_env_nucl_num(r_eps) + r_eps(1) = r_eps(1) + delta + + lapl_env_nucl += 0.5d0 * (fp - fm) / delta + + ! --- + + delta = max(eps, dabs(eps*r(2))) + r_eps(2) = r_eps(2) + delta + fp = grad_y_env_nucl_num(r_eps) + r_eps(2) = r_eps(2) - 2.d0 * delta + fm = grad_y_env_nucl_num(r_eps) + r_eps(2) = r_eps(2) + delta + + lapl_env_nucl += 0.5d0 * (fp - fm) / delta + + ! --- + + delta = max(eps, dabs(eps*r(3))) + r_eps(3) = r_eps(3) + delta + fp = grad_z_env_nucl_num(r_eps) + r_eps(3) = r_eps(3) - 2.d0 * delta + fm = grad_z_env_nucl_num(r_eps) + r_eps(3) = r_eps(3) + delta + + lapl_env_nucl += 0.5d0 * (fp - fm) / delta + + ! --- + + return +end + +! --- + +double precision function grad1_x_jmu_modif(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision :: r1_eps(3), eps, fp, fm, delta + double precision, external :: jmu_modif + + eps = 1d-7 + r1_eps = r1 + delta = max(eps, dabs(eps*r1(1))) + + r1_eps(1) = r1_eps(1) + delta + fp = jmu_modif(r1_eps, r2) + r1_eps(1) = r1_eps(1) - 2.d0 * delta + fm = jmu_modif(r1_eps, r2) + + grad1_x_jmu_modif = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +double precision function grad1_y_jmu_modif(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision :: r1_eps(3), eps, fp, fm, delta + double precision, external :: jmu_modif + + eps = 1d-7 + r1_eps = r1 + delta = max(eps, dabs(eps*r1(2))) + + r1_eps(2) = r1_eps(2) + delta + fp = jmu_modif(r1_eps, r2) + r1_eps(2) = r1_eps(2) - 2.d0 * delta + fm = jmu_modif(r1_eps, r2) + + grad1_y_jmu_modif = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +double precision function grad1_z_jmu_modif(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision :: r1_eps(3), eps, fp, fm, delta + double precision, external :: jmu_modif + + eps = 1d-7 + r1_eps = r1 + delta = max(eps, dabs(eps*r1(3))) + + r1_eps(3) = r1_eps(3) + delta + fp = jmu_modif(r1_eps, r2) + r1_eps(3) = r1_eps(3) - 2.d0 * delta + fm = jmu_modif(r1_eps, r2) + + grad1_z_jmu_modif = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +double precision function grad1_x_j12_mu_num(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision :: r1_eps(3), eps, fp, fm, delta + double precision, external :: j12_mu + + eps = 1d-7 + r1_eps = r1 + delta = max(eps, dabs(eps*r1(1))) + + r1_eps(1) = r1_eps(1) + delta + fp = j12_mu(r1_eps, r2) + r1_eps(1) = r1_eps(1) - 2.d0 * delta + fm = j12_mu(r1_eps, r2) + + grad1_x_j12_mu_num = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +double precision function grad1_y_j12_mu_num(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision :: r1_eps(3), eps, fp, fm, delta + double precision, external :: j12_mu + + eps = 1d-7 + r1_eps = r1 + delta = max(eps, dabs(eps*r1(2))) + + r1_eps(2) = r1_eps(2) + delta + fp = j12_mu(r1_eps, r2) + r1_eps(2) = r1_eps(2) - 2.d0 * delta + fm = j12_mu(r1_eps, r2) + + grad1_y_j12_mu_num = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +double precision function grad1_z_j12_mu_num(r1, r2) + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision :: r1_eps(3), eps, fp, fm, delta + double precision, external :: j12_mu + + eps = 1d-7 + r1_eps = r1 + delta = max(eps, dabs(eps*r1(3))) + + r1_eps(3) = r1_eps(3) + delta + fp = j12_mu(r1_eps, r2) + r1_eps(3) = r1_eps(3) - 2.d0 * delta + fm = j12_mu(r1_eps, r2) + + grad1_z_j12_mu_num = 0.5d0 * (fp - fm) / delta + + return +end + +! --- + +subroutine grad1_jmu_modif_num(r1, r2, grad) + + implicit none + + double precision, intent(in) :: r1(3), r2(3) + double precision, intent(out) :: grad(3) + + double precision :: tmp0, tmp1, tmp2, grad_u12(3) + + double precision, external :: j12_mu + double precision, external :: env_nucl + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num + + call grad1_j12_mu(r1, r2, grad_u12) + + tmp0 = env_nucl(r1) + tmp1 = env_nucl(r2) + tmp2 = j12_mu(r1, r2) + + grad(1) = (tmp0 * grad_u12(1) + tmp2 * grad_x_env_nucl_num(r1)) * tmp1 + grad(2) = (tmp0 * grad_u12(2) + tmp2 * grad_y_env_nucl_num(r1)) * tmp1 + grad(3) = (tmp0 * grad_u12(3) + tmp2 * grad_z_env_nucl_num(r1)) * tmp1 + + return +end + +! --- + diff --git a/plugins/local/non_h_ints_mu/jast_1e.irp.f b/plugins/local/non_h_ints_mu/jast_1e.irp.f new file mode 100644 index 00000000..96275887 --- /dev/null +++ b/plugins/local/non_h_ints_mu/jast_1e.irp.f @@ -0,0 +1,230 @@ + +! --- + +BEGIN_PROVIDER [double precision, j1e_val, (n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, p + double precision :: x, y, z, dx, dy, dz, d2 + double precision :: a, c, tmp + double precision :: time0, time1 + + PROVIDE j1e_type + + call wall_time(time0) + print*, ' providing j1e_val ...' + + if(j1e_type .eq. "None") then + + j1e_val = 0.d0 + + elseif(j1e_type .eq. "Gauss") then + + ! \sum_{A} \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) + + PROVIDE j1e_size j1e_coef j1e_expo + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + tmp = 0.d0 + do j = 1, nucl_num + + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + d2 = dx*dx + dy*dy + dz*dz + + do p = 1, j1e_size + + c = j1e_coef(p,j) + a = j1e_expo(p,j) + + tmp = tmp + c * dexp(-a*d2) + enddo + enddo + + j1e_val(ipoint) = tmp + enddo + + else + + print *, ' Error in j1e_val: Unknown j1e_type = ', j1e_type + stop + + endif + + call wall_time(time1) + print*, ' Wall time for j1e_val (min) = ', (time1 - time0) / 60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + + BEGIN_PROVIDER [double precision, j1e_gradx, (n_points_final_grid)] +&BEGIN_PROVIDER [double precision, j1e_grady, (n_points_final_grid)] +&BEGIN_PROVIDER [double precision, j1e_gradz, (n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, p + double precision :: x, y, z, dx, dy, dz, d2 + double precision :: a, c, g, tmp_x, tmp_y, tmp_z + double precision :: time0, time1 + double precision, allocatable :: Pa(:,:), Pb(:,:), Pt(:,:) + + PROVIDE j1e_type + + call wall_time(time0) + print*, ' providing j1e_grad ...' + + if(j1e_type .eq. "None") then + + j1e_gradx = 0.d0 + j1e_grady = 0.d0 + j1e_gradz = 0.d0 + + elseif(j1e_type .eq. "Gauss") then + + ! - \sum_{A} (r - R_A) \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) + + PROVIDE j1e_size j1e_coef j1e_expo + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + tmp_x = 0.d0 + tmp_y = 0.d0 + tmp_z = 0.d0 + do j = 1, nucl_num + + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + d2 = dx*dx + dy*dy + dz*dz + + do p = 1, j1e_size + + c = j1e_coef(p,j) + a = j1e_expo(p,j) + g = c * a * dexp(-a*d2) + + tmp_x = tmp_x - g * dx + tmp_y = tmp_y - g * dy + tmp_z = tmp_z - g * dz + enddo + enddo + + j1e_gradx(ipoint) = 2.d0 * tmp_x + j1e_grady(ipoint) = 2.d0 * tmp_y + j1e_gradz(ipoint) = 2.d0 * tmp_z + enddo + + elseif(j1e_type .eq. "Charge_Harmonizer") then + + ! The - sign is in the integral over r2 + ! [(N-1)/2N] x \sum_{\mu,\nu} P_{\mu,\nu} \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_\mu(r2) \phi_nu(r2) + + PROVIDE elec_alpha_num elec_beta_num elec_num + PROVIDE mo_coef + PROVIDE int2_grad1_u2b_ao + + allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) + + call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pa, size(Pa, 1)) + + if(elec_alpha_num .eq. elec_beta_num) then + Pb = Pa + else + call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pb, size(Pb, 1)) + endif + Pt = Pa + Pb + + g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,1), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradx, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,2), ao_num*ao_num, Pt, 1, 0.d0, j1e_grady, 1) + call dgemv("T", ao_num*ao_num, n_points_final_grid, g, int2_grad1_u2b_ao(1,1,1,3), ao_num*ao_num, Pt, 1, 0.d0, j1e_gradz, 1) + + deallocate(Pa, Pb, Pt) + + else + + print *, ' Error in j1e_grad: Unknown j1e_type = ', j1e_type + stop + + endif + + call wall_time(time1) + print*, ' Wall time for j1e_grad (min) = ', (time1 - time0) / 60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, j1e_lapl, (n_points_final_grid)] + + implicit none + integer :: ipoint, i, j, p + double precision :: x, y, z, dx, dy, dz, d2 + double precision :: a, c, g, tmp + + if(j1e_type .eq. "None") then + + j1e_lapl = 0.d0 + + elseif(j1e_type .eq. "Gauss") then + + ! - \sum_{A} (r - R_A) \sum_p c_{p_A} \exp(-\alpha_{p_A} (r - R_A)^2) + + PROVIDE j1e_size j1e_coef j1e_expo + + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + + tmp = 0.d0 + do j = 1, nucl_num + + dx = x - nucl_coord(j,1) + dy = y - nucl_coord(j,2) + dz = z - nucl_coord(j,3) + d2 = dx*dx + dy*dy + dz*dz + + do p = 1, j1e_size + + c = j1e_coef(p,j) + a = j1e_expo(p,j) + g = c * a * dexp(-a*d2) + + tmp = tmp + (2.d0 * a * d2 - 3.d0) * g + enddo + enddo + + j1e_lapl(ipoint) = tmp + enddo + + else + + print *, ' Error in j1e_lapl: Unknown j1e_type = ', j1e_type + stop + + endif + +END_PROVIDER + +! --- + diff --git a/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f new file mode 100644 index 00000000..1e95f80a --- /dev/null +++ b/plugins/local/non_h_ints_mu/jast_1e_utils.irp.f @@ -0,0 +1,181 @@ + +! --- + +BEGIN_PROVIDER [double precision, int2_grad1_u2b_ao, (ao_num, ao_num, n_points_final_grid, 3)] + + BEGIN_DOC + ! + ! int2_grad1_u2b_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J_2b(r1,r2)] \phi_i(r2) \phi_j(r2) + ! + ! where r1 = r(ipoint) + ! + END_DOC + + implicit none + integer :: ipoint, i, j, m, jpoint + double precision :: time0, time1 + double precision :: x, y, z, r2 + double precision :: dx, dy, dz + double precision :: tmp_ct + double precision :: tmp0, tmp1, tmp2 + double precision :: tmp0_x, tmp0_y, tmp0_z + double precision :: tmp1_x, tmp1_y, tmp1_z + + PROVIDE j2e_type + + call wall_time(time0) + + print*, ' providing int2_grad1_u2b_ao ...' + + if(tc_integ_type .eq. "numeric") then + + ! TODO combine 1shot & int2_grad1_u12_ao_num + + PROVIDE int2_grad1_u12_ao_num + int2_grad1_u2b_ao = int2_grad1_u12_ao_num + + !PROVIDE int2_grad1_u12_ao_num_1shot + !int2_grad1_u2b_ao = int2_grad1_u12_ao_num_1shot + + elseif(tc_integ_type .eq. "semi-analytic") then + + ! --- + + if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then + + PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu + + int2_grad1_u2b_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & + !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & + !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u2b_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + do j = 1, ao_num + do i = 1, ao_num + tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) + int2_grad1_u2b_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) + int2_grad1_u2b_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then + + PROVIDE env_type env_val env_grad + PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + + int2_grad1_u2b_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & + !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u2b_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + tmp0 = 0.5d0 * env_val(ipoint) + tmp0_x = env_grad(1,ipoint) + tmp0_y = env_grad(2,ipoint) + tmp0_z = env_grad(3,ipoint) + do j = 1, ao_num + do i = 1, ao_num + tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) + tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x + int2_grad1_u2b_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y + int2_grad1_u2b_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + + PROVIDE mu_erf + PROVIDE env_type env_val env_grad + PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 + PROVIDE Ir2_Mu_gauss_Du + + tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + + int2_grad1_u2b_ao = 0.d0 + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & + !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct, env_val, env_grad, Ir2_Mu_long_Du_0, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & + !$OMP Ir2_Mu_long_Du_2, int2_grad1_u2b_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx = env_grad(1,ipoint) + dy = env_grad(2,ipoint) + dz = env_grad(3,ipoint) + + tmp0_x = 0.5d0 * (env_val(ipoint) * x + r2 * dx) + tmp0_y = 0.5d0 * (env_val(ipoint) * y + r2 * dy) + tmp0_z = 0.5d0 * (env_val(ipoint) * z + r2 * dz) + + tmp1 = 0.5d0 * env_val(ipoint) + + tmp1_x = tmp_ct * dx + tmp1_y = tmp_ct * dy + tmp1_z = tmp_ct * dz + + do j = 1, ao_num + do i = 1, ao_num + + tmp2 = 0.5d0 * Ir2_Mu_long_Du_2(i,j,ipoint) - x * Ir2_Mu_long_Du_x(i,j,ipoint) - y * Ir2_Mu_long_Du_y(i,j,ipoint) - z * Ir2_Mu_long_Du_z(i,j,ipoint) + + int2_grad1_u2b_ao(i,j,ipoint,1) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,2) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u2b_ao(i,j,ipoint,3) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + else + + print *, ' Error in int2_grad1_u2b_ao: Unknown Jastrow' + stop + + endif ! j2e_type + + else + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' + stop + + endif ! tc_integ_type + + call wall_time(time1) + print*, ' wall time for int2_grad1_u2b_ao (min) =', (time1-time0)/60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + diff --git a/src/non_h_ints_mu/jast_deriv.irp.f b/plugins/local/non_h_ints_mu/jast_deriv.irp.f similarity index 78% rename from src/non_h_ints_mu/jast_deriv.irp.f rename to plugins/local/non_h_ints_mu/jast_deriv.irp.f index f8d04e9f..9a430135 100644 --- a/src/non_h_ints_mu/jast_deriv.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv.irp.f @@ -1,33 +1,27 @@ ! --- - BEGIN_PROVIDER [ double precision, grad1_u12_num, (n_points_extra_final_grid, n_points_final_grid, 3)] -&BEGIN_PROVIDER [ double precision, grad1_u12_squared_num, (n_points_extra_final_grid, n_points_final_grid)] + BEGIN_PROVIDER [double precision, grad1_u12_num, (n_points_extra_final_grid, n_points_final_grid, 3)] +&BEGIN_PROVIDER [double precision, grad1_u12_squared_num, (n_points_extra_final_grid, n_points_final_grid)] BEGIN_DOC ! + ! ! grad_1 u(r1,r2) - ! - ! this will be integrated numerically over r2: - ! we use grid for r1 and extra_grid for r2 - ! - ! for 99 < j1b_type < 199 - ! - ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) - ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) + ! numerical integration over r1 & r2 ! END_DOC implicit none integer :: ipoint, jpoint double precision :: r1(3), r2(3) - double precision :: v1b_r1, v1b_r2, u2b_r12 - double precision :: grad1_v1b(3), grad1_u2b(3) + double precision :: v_r1, v_r2, u2b_r12 + double precision :: grad1_v(3), grad1_u2b(3) double precision :: dx, dy, dz double precision :: time0, time1 - double precision, external :: j12_mu, j1b_nucl + double precision, external :: j12_mu, env_nucl - PROVIDE j1b_type + PROVIDE env_type PROVIDE final_grid_points_extra print*, ' providing grad1_u12_num & grad1_u12_squared_num ...' @@ -36,12 +30,12 @@ grad1_u12_num = 0.d0 grad1_u12_squared_num = 0.d0 - if( (j1b_type .eq. 100) .or. & - (j1b_type .ge. 200) .and. (j1b_type .lt. 300) ) then + if( ((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) .or. & + (j2e_type .eq. "Mur") ) then !$OMP PARALLEL & !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, jpoint, r1, r2, v1b_r1, v1b_r2, u2b_r12, grad1_v1b, grad1_u2b, dx, dy, dz) & + !$OMP PRIVATE (ipoint, jpoint, r1, r2, v_r1, v_r2, u2b_r12, grad1_v, grad1_u2b, dx, dy, dz) & !$OMP SHARED (n_points_final_grid, n_points_extra_final_grid, final_grid_points, & !$OMP final_grid_points_extra, grad1_u12_num, grad1_u12_squared_num) !$OMP DO SCHEDULE (static) @@ -73,14 +67,14 @@ !$OMP END DO !$OMP END PARALLEL - elseif((j1b_type .gt. 100) .and. (j1b_type .lt. 200)) then + elseif((j2e_type .eq. "Mu") .and. (env_type .ne. "None")) then PROVIDE final_grid_points - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, jpoint, r1, r2, v1b_r1, v1b_r2, u2b_r12, grad1_v1b, grad1_u2b, dx, dy, dz) & - !$OMP SHARED (n_points_final_grid, n_points_extra_final_grid, final_grid_points, & + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, jpoint, r1, r2, v_r1, v_r2, u2b_r12, grad1_v, grad1_u2b, dx, dy, dz) & + !$OMP SHARED (n_points_final_grid, n_points_extra_final_grid, final_grid_points, & !$OMP final_grid_points_extra, grad1_u12_num, grad1_u12_squared_num) !$OMP DO SCHEDULE (static) do ipoint = 1, n_points_final_grid ! r1 @@ -89,8 +83,8 @@ r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - v1b_r1 = j1b_nucl(r1) - call grad1_j1b_nucl(r1, grad1_v1b) + v_r1 = env_nucl(r1) + call grad1_env_nucl(r1, grad1_v) do jpoint = 1, n_points_extra_final_grid ! r2 @@ -98,13 +92,13 @@ r2(2) = final_grid_points_extra(2,jpoint) r2(3) = final_grid_points_extra(3,jpoint) - v1b_r2 = j1b_nucl(r2) + v_r2 = env_nucl(r2) u2b_r12 = j12_mu(r1, r2) call grad1_j12_mu(r2, r1, grad1_u2b) - dx = (grad1_u2b(1) * v1b_r1 + u2b_r12 * grad1_v1b(1)) * v1b_r2 - dy = (grad1_u2b(2) * v1b_r1 + u2b_r12 * grad1_v1b(2)) * v1b_r2 - dz = (grad1_u2b(3) * v1b_r1 + u2b_r12 * grad1_v1b(3)) * v1b_r2 + dx = (grad1_u2b(1) * v_r1 + u2b_r12 * grad1_v(1)) * v_r2 + dy = (grad1_u2b(2) * v_r1 + u2b_r12 * grad1_v(2)) * v_r2 + dz = (grad1_u2b(3) * v_r1 + u2b_r12 * grad1_v(3)) * v_r2 grad1_u12_num(jpoint,ipoint,1) = dx grad1_u12_num(jpoint,ipoint,2) = dy @@ -116,7 +110,7 @@ !$OMP END DO !$OMP END PARALLEL - elseif (j1b_type .eq. 1000) then + elseif(j2e_type .eq. "Qmckl") then double precision :: f f = 1.d0 / dble(elec_num - 1) @@ -138,7 +132,7 @@ allocate( gl(2,4,n_points) ) do ipoint_block = 1, n_points_final_grid, 100 ! r1 - ipoint_end = min(n_points_final_grid, ipoint_block+100) + ipoint_end = min(n_points_final_grid, ipoint_block+99) k=0 do ipoint = ipoint_block, ipoint_end @@ -223,19 +217,17 @@ enddo !ipoint_block - - deallocate(gl, rij) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + print *, ' Error in grad1_u12_num & grad1_u12_squared_num: Unknown Jastrow' stop - endif + endif ! j2e_type call wall_time(time1) - print*, ' Wall time for grad1_u12_num & grad1_u12_squared_num (min) =', (time1-time0)/60.d0 + print*, ' Wall time for grad1_u12_num & grad1_u12_squared_num (min) = ', (time1-time0)/60.d0 END_PROVIDER diff --git a/src/non_h_ints_mu/jast_deriv_utils.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f similarity index 65% rename from src/non_h_ints_mu/jast_deriv_utils.irp.f rename to plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f index 745d00ad..79822508 100644 --- a/src/non_h_ints_mu/jast_deriv_utils.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils.irp.f @@ -9,7 +9,7 @@ double precision function j12_mu(r1, r2) double precision, intent(in) :: r1(3), r2(3) double precision :: mu_tmp, r12 - if((j1b_type .ge. 0) .and. (j1b_type .lt. 200)) then + if(j2e_type .eq. "Mu") then r12 = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & + (r1(2) - r2(2)) * (r1(2) - r2(2)) & @@ -20,13 +20,13 @@ double precision function j12_mu(r1, r2) else - print *, ' j1b_type = ', j1b_type, 'not implemented for j12_mu' + print *, ' Error in j12_mu: Unknown j2e_type = ', j2e_type stop - endif + endif ! j2e_type return -end function j12_mu +end ! --- @@ -36,11 +36,11 @@ subroutine grad1_j12_mu(r1, r2, grad) ! ! gradient of j(mu(r1,r2),r12) form of jastrow. ! - ! if mu(r1,r2) = cst ---> j1b_type < 200 and + ! if mu(r1,r2) = cst ---> ! ! d/dx1 j(mu,r12) = 0.5 * (1 - erf(mu *r12))/r12 * (x1 - x2) ! - ! if mu(r1,r2) /= cst ---> 200 < j1b_type < 300 and + ! if mu(r1,r2) /= cst ---> ! ! d/dx1 j(mu(r1,r2),r12) = exp(-(mu(r1,r2)*r12)**2) /(2 *sqrt(pi) * mu(r1,r2)**2 ) d/dx1 mu(r1,r2) ! + 0.5 * (1 - erf(mu(r1,r2) *r12))/r12 * (x1 - x2) @@ -53,10 +53,11 @@ subroutine grad1_j12_mu(r1, r2, grad) double precision, intent(in) :: r1(3), r2(3) double precision, intent(out) :: grad(3) double precision :: dx, dy, dz, r12, tmp + double precision :: mu_val, mu_tmp, mu_der(3) grad = 0.d0 - if((j1b_type .ge. 0) .and. (j1b_type .lt. 200)) then + if(j2e_type .eq. "Mu") then dx = r1(1) - r2(1) dy = r1(2) - r2(2) @@ -71,9 +72,7 @@ subroutine grad1_j12_mu(r1, r2, grad) grad(2) = tmp * dy grad(3) = tmp * dz - elseif((j1b_type .ge. 200) .and. (j1b_type .lt. 300)) then - - double precision :: mu_val, mu_tmp, mu_der(3) + elseif(j2e_type .eq. "Mur") then dx = r1(1) - r2(1) dy = r1(2) - r2(2) @@ -95,152 +94,153 @@ subroutine grad1_j12_mu(r1, r2, grad) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + print *, ' Error in grad1_j12_mu: Unknown j2e_type = ', j2e_type stop - endif + endif ! j2e_type + grad = -grad return -end subroutine grad1_j12_mu +end ! --- -double precision function j1b_nucl(r) +double precision function env_nucl(r) implicit none double precision, intent(in) :: r(3) integer :: i double precision :: a, d, e, x, y, z - if((j1b_type .eq. 2) .or. (j1b_type .eq. 102)) then + if(env_type .eq. "Sum_Slat") then - j1b_nucl = 1.d0 + env_nucl = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - j1b_nucl = j1b_nucl - dexp(-a*dsqrt(d)) + env_nucl = env_nucl - env_coef(i) * dexp(-a*dsqrt(d)) enddo - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + elseif(env_type .eq. "Prod_Gauss") then - j1b_nucl = 1.d0 + env_nucl = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) e = 1.d0 - dexp(-a*d) - j1b_nucl = j1b_nucl * e + env_nucl = env_nucl * e enddo - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "Sum_Gauss") then - j1b_nucl = 1.d0 + env_nucl = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - j1b_nucl = j1b_nucl - j1b_pen_coef(i) * dexp(-a*d) + env_nucl = env_nucl - env_coef(i) * dexp(-a*d) enddo - elseif((j1b_type .eq. 5) .or. (j1b_type .eq. 105)) then + elseif(env_type .eq. "Sum_Quartic") then - j1b_nucl = 1.d0 + env_nucl = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - j1b_nucl = j1b_nucl - dexp(-a*d*d) + env_nucl = env_nucl - env_coef(i) * dexp(-a*d*d) enddo else - print *, ' j1b_type = ', j1b_type, 'not implemented for j1b_nucl' + print *, ' Error in env_nucl: Unknown env_type = ', env_type stop endif return -end function j1b_nucl +end ! --- -double precision function j1b_nucl_square(r) +double precision function env_nucl_square(r) implicit none double precision, intent(in) :: r(3) integer :: i double precision :: a, d, e, x, y, z - if((j1b_type .eq. 2) .or. (j1b_type .eq. 102)) then + if(env_type .eq. "Sum_Slat") then - j1b_nucl_square = 1.d0 + env_nucl_square = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - j1b_nucl_square = j1b_nucl_square - dexp(-a*dsqrt(d)) + env_nucl_square = env_nucl_square - env_coef(i) * dexp(-a*dsqrt(d)) enddo - j1b_nucl_square = j1b_nucl_square * j1b_nucl_square + env_nucl_square = env_nucl_square * env_nucl_square - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + elseif(env_type .eq. "Prod_Gauss") then - j1b_nucl_square = 1.d0 + env_nucl_square = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) e = 1.d0 - dexp(-a*d) - j1b_nucl_square = j1b_nucl_square * e + env_nucl_square = env_nucl_square * e enddo - j1b_nucl_square = j1b_nucl_square * j1b_nucl_square + env_nucl_square = env_nucl_square * env_nucl_square - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "Sum_Gauss") then - j1b_nucl_square = 1.d0 + env_nucl_square = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - j1b_nucl_square = j1b_nucl_square - j1b_pen_coef(i) * dexp(-a*d) + env_nucl_square = env_nucl_square - env_coef(i) * dexp(-a*d) enddo - j1b_nucl_square = j1b_nucl_square * j1b_nucl_square + env_nucl_square = env_nucl_square * env_nucl_square - elseif((j1b_type .eq. 5) .or. (j1b_type .eq. 105)) then + elseif(env_type .eq. "Sum_Quartic") then - j1b_nucl_square = 1.d0 + env_nucl_square = 1.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - j1b_nucl_square = j1b_nucl_square - dexp(-a*d*d) + env_nucl_square = env_nucl_square - env_coef(i) * dexp(-a*d*d) enddo - j1b_nucl_square = j1b_nucl_square * j1b_nucl_square + env_nucl_square = env_nucl_square * env_nucl_square else - print *, ' j1b_type = ', j1b_type, 'not implemented for j1b_nucl_square' + print *, ' Error in env_nucl_square: Unknown env_type = ', env_type stop endif return -end function j1b_nucl_square +end ! --- -subroutine grad1_j1b_nucl(r, grad) +subroutine grad1_env_nucl(r, grad) implicit none double precision, intent(in) :: r(3) @@ -251,18 +251,18 @@ subroutine grad1_j1b_nucl(r, grad) double precision :: fact_x, fact_y, fact_z double precision :: ax_der, ay_der, az_der, a_expo - if((j1b_type .eq. 2) .or. (j1b_type .eq. 102)) then + if(env_type .eq. "Sum_Slat") then fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = dsqrt(x*x + y*y + z*z) - e = a * dexp(-a*d) / d + e = a * env_coef(i) * dexp(-a*d) / d fact_x += e * x fact_y += e * y @@ -273,7 +273,7 @@ subroutine grad1_j1b_nucl(r, grad) grad(2) = fact_y grad(3) = fact_z - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + elseif(env_type .eq. "Prod_Gauss") then x = r(1) y = r(2) @@ -282,7 +282,7 @@ subroutine grad1_j1b_nucl(r, grad) fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 - do i = 1, List_all_comb_b2_size + do i = 1, List_env1s_size phase = 0 a_expo = 0.d0 @@ -290,12 +290,12 @@ subroutine grad1_j1b_nucl(r, grad) ay_der = 0.d0 az_der = 0.d0 do j = 1, nucl_num - a = dble(List_all_comb_b2(j,i)) * j1b_pen(j) + a = dble(List_env1s(j,i)) * env_expo(j) dx = x - nucl_coord(j,1) dy = y - nucl_coord(j,2) dz = z - nucl_coord(j,3) - phase += List_all_comb_b2(j,i) + phase += List_env1s(j,i) a_expo += a * (dx*dx + dy*dy + dz*dz) ax_der += a * dx ay_der += a * dy @@ -312,18 +312,18 @@ subroutine grad1_j1b_nucl(r, grad) grad(2) = fact_y grad(3) = fact_z - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "Sum_Gauss") then fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - e = a * j1b_pen_coef(i) * dexp(-a*d) + e = a * env_coef(i) * dexp(-a*d) fact_x += e * x fact_y += e * y @@ -334,18 +334,18 @@ subroutine grad1_j1b_nucl(r, grad) grad(2) = 2.d0 * fact_y grad(3) = 2.d0 * fact_z - elseif((j1b_type .eq. 5) .or. (j1b_type .eq. 105)) then + elseif(env_type .eq. "Sum_Quartic") then fact_x = 0.d0 fact_y = 0.d0 fact_z = 0.d0 do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - e = a * d * dexp(-a*d*d) + e = a * env_coef(i) * d * dexp(-a*d*d) fact_x += e * x fact_y += e * y @@ -358,13 +358,13 @@ subroutine grad1_j1b_nucl(r, grad) else - print *, ' j1b_type = ', j1b_type, 'not implemented for grad1_j1b_nucl' + print *, ' Error in grad1_env_nucl: Unknown env_type = ', env_type stop endif return -end subroutine grad1_j1b_nucl +end ! --- @@ -380,7 +380,10 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) double precision :: f_rho1, f_rho2, d_drho_f_rho1 double precision :: d_dx1_f_rho1(3),d_dx_rho_f_rho(3),nume - if(j1b_type .eq. 200) then + PROVIDE murho_type + PROVIDE mu_r_ct mu_erf + + if(murho_type .eq. 1) then ! ! r = 0.5 (r1 + r2) @@ -391,8 +394,6 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) ! d mu[rho(r)] / dx = [0.5 alpha / sqrt(rho) - mu0 exp(-rho)] (d rho(r) / dx) ! - PROVIDE mu_r_ct mu_erf - r(1) = 0.5d0 * (r1(1) + r2(1)) r(2) = 0.5d0 * (r1(2) + r2(2)) r(3) = 0.5d0 * (r1(3) + r2(3)) @@ -413,7 +414,7 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) mu_der(2) = tmp3 * (grad_dm_a(2,1) + grad_dm_b(2,1)) mu_der(3) = tmp3 * (grad_dm_a(3,1) + grad_dm_b(3,1)) - elseif(j1b_type .eq. 201) then + elseif(murho_type .eq. 2) then ! ! r = 0.5 (r1 + r2) @@ -424,8 +425,6 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) ! d mu[rho(r)] / dx = [0.5 alpha / sqrt(rho) - mu0 exp(-rho)] (d rho(r) / dx) ! - PROVIDE mu_r_ct mu_erf - r(1) = 0.5d0 * (r1(1) + r2(1)) r(2) = 0.5d0 * (r1(2) + r2(2)) r(3) = 0.5d0 * (r1(3) + r2(3)) @@ -442,7 +441,7 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) mu_der(2) = tmp3 * (grad_dm_a(2,1) + grad_dm_b(2,1)) mu_der(3) = tmp3 * (grad_dm_a(3,1) + grad_dm_b(3,1)) - elseif(j1b_type .eq. 202) then + elseif(murho_type .eq. 3) then ! mu(r1,r2) = {rho(r1) f[rho(r1)] + rho(r2) f[rho(r2)]} / RHO ! @@ -469,7 +468,8 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) nume = rho1 * f_rho1 + rho2 * f_rho2 mu_val = nume * inv_rho_tot mu_der(1:3) = inv_rho_tot*inv_rho_tot * (rho_tot * d_dx_rho_f_rho(1:3) - grad_rho1(1:3) * nume) - elseif(j1b_type .eq. 203) then + + elseif(murho_type .eq. 4) then ! mu(r1,r2) = {rho(r1) f[rho(r1)] + rho(r2) f[rho(r2)]} / RHO ! @@ -503,7 +503,8 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) nume = rho1 * f_rho1 + rho2 * f_rho2 mu_val = nume * inv_rho_tot mu_der(1:3) = inv_rho_tot*inv_rho_tot * (rho_tot * d_dx_rho_f_rho(1:3) - grad_rho1(1:3) * nume) - elseif(j1b_type .eq. 204) then + + elseif(murho_type .eq. 5) then ! mu(r1,r2) = 1/2 * (f[rho(r1)] + f[rho(r2)]} ! @@ -535,23 +536,24 @@ subroutine mu_r_val_and_grad(r1, r2, mu_val, mu_der) mu_der(1:3) = inv_rho_tot*inv_rho_tot * (rho_tot * d_dx_rho_f_rho(1:3) - grad_rho1(1:3) * nume) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + + print *, ' Error in mu_r_val_and_grad: Unknown env_type = ', env_type stop endif return -end subroutine mu_r_val_and_grad +end ! --- -subroutine grad1_j1b_nucl_square_num(r1, grad) +subroutine grad1_env_nucl_square_num(r1, grad) implicit none double precision, intent(in) :: r1(3) double precision, intent(out) :: grad(3) double precision :: r(3), eps, tmp_eps, vp, vm - double precision, external :: j1b_nucl_square + double precision, external :: env_nucl_square eps = 1d-5 tmp_eps = 0.5d0 / eps @@ -559,28 +561,28 @@ subroutine grad1_j1b_nucl_square_num(r1, grad) r(1:3) = r1(1:3) r(1) = r(1) + eps - vp = j1b_nucl_square(r) + vp = env_nucl_square(r) r(1) = r(1) - 2.d0 * eps - vm = j1b_nucl_square(r) + vm = env_nucl_square(r) r(1) = r(1) + eps grad(1) = tmp_eps * (vp - vm) r(2) = r(2) + eps - vp = j1b_nucl_square(r) + vp = env_nucl_square(r) r(2) = r(2) - 2.d0 * eps - vm = j1b_nucl_square(r) + vm = env_nucl_square(r) r(2) = r(2) + eps grad(2) = tmp_eps * (vp - vm) r(3) = r(3) + eps - vp = j1b_nucl_square(r) + vp = env_nucl_square(r) r(3) = r(3) - 2.d0 * eps - vm = j1b_nucl_square(r) + vm = env_nucl_square(r) r(3) = r(3) + eps grad(3) = tmp_eps * (vp - vm) return -end subroutine grad1_j1b_nucl_square_num +end ! --- @@ -622,7 +624,7 @@ subroutine grad1_j12_mu_square_num(r1, r2, grad) grad(3) = tmp_eps * (vp - vm) return -end subroutine grad1_j12_mu_square_num +end ! --- @@ -635,134 +637,172 @@ double precision function j12_mu_square(r1, r2) j12_mu_square = j12_mu(r1, r2) * j12_mu(r1, r2) return -end function j12_mu_square +end ! --- -subroutine f_mu_and_deriv_mu(rho,alpha,mu0,beta,f_mu,d_drho_f_mu) - implicit none - BEGIN_DOC -! function giving mu as a function of rho -! -! f_mu = alpha * rho**beta + mu0 * exp(-rho) -! -! and its derivative with respect to rho d_drho_f_mu - END_DOC - double precision, intent(in) :: rho,alpha,mu0,beta - double precision, intent(out) :: f_mu,d_drho_f_mu - f_mu = alpha * (rho)**beta + mu0 * dexp(-rho) - d_drho_f_mu = alpha * beta * rho**(beta-1.d0) - mu0 * dexp(-rho) +subroutine f_mu_and_deriv_mu(rho, alpha, mu0, beta, f_mu, d_drho_f_mu) + + BEGIN_DOC + ! function giving mu as a function of rho + ! + ! f_mu = alpha * rho**beta + mu0 * exp(-rho) + ! + ! and its derivative with respect to rho d_drho_f_mu + END_DOC + + implicit none + double precision, intent(in) :: rho, alpha, mu0, beta + double precision, intent(out) :: f_mu, d_drho_f_mu + + f_mu = alpha * (rho)**beta + mu0 * dexp(-rho) + d_drho_f_mu = alpha * beta * rho**(beta-1.d0) - mu0 * dexp(-rho) end +! --- + +subroutine get_all_rho_grad_rho(r1, r2, rho1, rho2, grad_rho1) + + BEGIN_DOC + ! returns the density in r1,r2 and grad_rho at r1 + END_DOC + + implicit none + double precision, intent(in) :: r1(3), r2(3) + double precision, intent(out) :: grad_rho1(3), rho1, rho2 + double precision :: dm_a(1), dm_b(1), grad_dm_a(3,1), grad_dm_b(3,1) + + call density_and_grad_alpha_beta(r1, dm_a, dm_b, grad_dm_a, grad_dm_b) + rho1 = dm_a(1) + dm_b(1) + grad_rho1(1:3) = grad_dm_a(1:3,1) + grad_dm_b(1:3,1) + call density_and_grad_alpha_beta(r2, dm_a, dm_b, grad_dm_a, grad_dm_b) + rho2 = dm_a(1) + dm_b(1) -subroutine get_all_rho_grad_rho(r1,r2,rho1,rho2,grad_rho1) - implicit none - BEGIN_DOC -! returns the density in r1,r2 and grad_rho at r1 - END_DOC - double precision, intent(in) :: r1(3),r2(3) - double precision, intent(out):: grad_rho1(3),rho1,rho2 - double precision :: dm_a(1), dm_b(1), grad_dm_a(3,1), grad_dm_b(3,1) - call density_and_grad_alpha_beta(r1, dm_a, dm_b, grad_dm_a, grad_dm_b) - rho1 = dm_a(1) + dm_b(1) - grad_rho1(1:3) = grad_dm_a(1:3,1) + grad_dm_b(1:3,1) - call density_and_grad_alpha_beta(r2, dm_a, dm_b, grad_dm_a, grad_dm_b) - rho2 = dm_a(1) + dm_b(1) end -subroutine get_all_f_rho(rho1,rho2,alpha,mu0,beta,f_rho1,d_drho_f_rho1,f_rho2) - implicit none - BEGIN_DOC -! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) - END_DOC - double precision, intent(in) :: rho1,rho2,alpha,mu0,beta - double precision, intent(out):: f_rho1,d_drho_f_rho1,f_rho2 - double precision :: tmp - call f_mu_and_deriv_mu(rho1,alpha,mu0,beta,f_rho1,d_drho_f_rho1) - call f_mu_and_deriv_mu(rho2,alpha,mu0,beta,f_rho2,tmp) +! --- + +subroutine get_all_f_rho(rho1, rho2, alpha, mu0, beta, f_rho1, d_drho_f_rho1, f_rho2) + + BEGIN_DOC + ! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) + END_DOC + + implicit none + double precision, intent(in) :: rho1, rho2, alpha, mu0, beta + double precision, intent(out) :: f_rho1, d_drho_f_rho1, f_rho2 + double precision :: tmp + + call f_mu_and_deriv_mu(rho1, alpha, mu0, beta, f_rho1, d_drho_f_rho1) + call f_mu_and_deriv_mu(rho2, alpha, mu0, beta, f_rho2, tmp) + end +! --- subroutine get_all_f_rho_simple(rho1,rho2,alpha,mu0,beta,f_rho1,d_drho_f_rho1,f_rho2) - implicit none - BEGIN_DOC -! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) - END_DOC - double precision, intent(in) :: rho1,rho2,alpha,mu0,beta - double precision, intent(out):: f_rho1,d_drho_f_rho1,f_rho2 - double precision :: tmp - if(rho1.lt.1.d-10)then - f_rho1 = 0.d0 - d_drho_f_rho1 = 0.d0 - else - call f_mu_and_deriv_mu_simple(rho1,alpha,mu0,beta,f_rho1,d_drho_f_rho1) - endif - if(rho2.lt.1.d-10)then - f_rho2 = 0.d0 - else - call f_mu_and_deriv_mu_simple(rho2,alpha,mu0,beta,f_rho2,tmp) - endif + + BEGIN_DOC + ! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) + END_DOC + + implicit none + double precision, intent(in) :: rho1, rho2, alpha, mu0, beta + double precision, intent(out) :: f_rho1, d_drho_f_rho1, f_rho2 + double precision :: tmp + + if(rho1.lt.1.d-10) then + f_rho1 = 0.d0 + d_drho_f_rho1 = 0.d0 + else + call f_mu_and_deriv_mu_simple(rho1, alpha, mu0, beta, f_rho1, d_drho_f_rho1) + endif + + if(rho2.lt.1.d-10)then + f_rho2 = 0.d0 + else + call f_mu_and_deriv_mu_simple(rho2, alpha, mu0, beta, f_rho2, tmp) + endif + end -subroutine f_mu_and_deriv_mu_simple(rho,alpha,mu0,beta,f_mu,d_drho_f_mu) - implicit none - BEGIN_DOC -! function giving mu as a function of rho -! -! f_mu = alpha * rho**beta + mu0 -! -! and its derivative with respect to rho d_drho_f_mu - END_DOC - double precision, intent(in) :: rho,alpha,mu0,beta - double precision, intent(out) :: f_mu,d_drho_f_mu - f_mu = alpha**beta * (rho)**beta + mu0 - d_drho_f_mu = alpha**beta * beta * rho**(beta-1.d0) +! --- + +subroutine f_mu_and_deriv_mu_simple(rho, alpha, mu0, beta, f_mu, d_drho_f_mu) + + BEGIN_DOC + ! function giving mu as a function of rho + ! + ! f_mu = alpha * rho**beta + mu0 + ! + ! and its derivative with respect to rho d_drho_f_mu + END_DOC + + implicit none + double precision, intent(in) :: rho, alpha, mu0, beta + double precision, intent(out) :: f_mu, d_drho_f_mu + + f_mu = alpha**beta * (rho)**beta + mu0 + d_drho_f_mu = alpha**beta * beta * rho**(beta-1.d0) end ! --- subroutine f_mu_and_deriv_mu_erf(rho,alpha,zeta,mu0,beta,f_mu,d_drho_f_mu) - implicit none + include 'constants.include.F' - BEGIN_DOC -! function giving mu as a function of rho -! -! f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) -! -! and its derivative with respect to rho d_drho_f_mu -! -! d_drho_f_mu = 2 beta/sqrt(pi) * exp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) -! + alpha * zeta * (alpha *rho)**(zeta-1) * erf(beta*rho) - END_DOC - double precision, intent(in) :: rho,alpha,mu0,beta,zeta - double precision, intent(out) :: f_mu,d_drho_f_mu - f_mu = (alpha * rho)**zeta * derf(beta * rho) + mu0 * (1.d0 - derf(beta*rho)) - d_drho_f_mu = 2.d0 * beta * inv_sq_pi * dexp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) & - + alpha * zeta * (alpha *rho)**(zeta-1) * derf(beta*rho) + + BEGIN_DOC + ! function giving mu as a function of rho + ! + ! f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) + ! + ! and its derivative with respect to rho d_drho_f_mu + ! + ! d_drho_f_mu = 2 beta/sqrt(pi) * exp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) + ! + alpha * zeta * (alpha *rho)**(zeta-1) * erf(beta*rho) + END_DOC + + implicit none + double precision, intent(in) :: rho, alpha, mu0, beta, zeta + double precision, intent(out) :: f_mu, d_drho_f_mu + + f_mu = (alpha * rho)**zeta * derf(beta * rho) + mu0 * (1.d0 - derf(beta*rho)) + d_drho_f_mu = 2.d0 * beta * inv_sq_pi * dexp(-(beta*rho)**2) * ( (alpha*rho)**zeta - mu0) & + + alpha * zeta * (alpha *rho)**(zeta-1) * derf(beta*rho) end +! --- + +subroutine get_all_f_rho_erf(rho1, rho2, alpha, zeta, mu0, beta, f_rho1, d_drho_f_rho1, f_rho2) + + BEGIN_DOC + ! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) + ! with f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) + END_DOC + + implicit none + double precision, intent(in) :: rho1, rho2, alpha, mu0, beta, zeta + double precision, intent(out) :: f_rho1, d_drho_f_rho1, f_rho2 + double precision :: tmp + + if(rho1 .lt. 1.d-10) then + f_rho1 = mu_erf + d_drho_f_rho1 = 0.d0 + else + call f_mu_and_deriv_mu_erf(rho1, alpha, zeta, mu0, beta, f_rho1, d_drho_f_rho1) + endif + + if(rho2 .lt. 1.d-10)then + f_rho2 = mu_erf + else + call f_mu_and_deriv_mu_erf(rho2, alpha, zeta, mu0, beta, f_rho2, tmp) + endif -subroutine get_all_f_rho_erf(rho1,rho2,alpha,zeta,mu0,beta,f_rho1,d_drho_f_rho1,f_rho2) - implicit none - BEGIN_DOC -! returns the values f(mu(r1)), f(mu(r2)) and d/drho(1) f(mu(r1)) -! with f_mu = (alpha * rho)**zeta * erf(beta * rho) + mu0 * (1 - erf(beta*rho)) - END_DOC - double precision, intent(in) :: rho1,rho2,alpha,mu0,beta,zeta - double precision, intent(out):: f_rho1,d_drho_f_rho1,f_rho2 - double precision :: tmp - if(rho1.lt.1.d-10)then - f_rho1 = mu_erf - d_drho_f_rho1 = 0.d0 - else - call f_mu_and_deriv_mu_erf(rho1,alpha,zeta,mu0,beta,f_rho1,d_drho_f_rho1) - endif - if(rho2.lt.1.d-10)then - f_rho2 = mu_erf - else - call f_mu_and_deriv_mu_erf(rho2,alpha,zeta,mu0,beta,f_rho2,tmp) - endif end + +! --- + diff --git a/src/non_h_ints_mu/jast_deriv_utils_vect.irp.f b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f similarity index 65% rename from src/non_h_ints_mu/jast_deriv_utils_vect.irp.f rename to plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f index f9512827..bd7db497 100644 --- a/src/non_h_ints_mu/jast_deriv_utils_vect.irp.f +++ b/plugins/local/non_h_ints_mu/jast_deriv_utils_vect.irp.f @@ -7,13 +7,7 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) ! ! grad_1 u(r1,r2) ! - ! this will be integrated numerically over r2: - ! we use grid for r1 and extra_grid for r2 - ! - ! for 99 < j1b_type < 199 - ! - ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) - ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) + ! we use grid for r1 and extra_grid for r2 ! END_DOC @@ -23,61 +17,60 @@ subroutine get_grad1_u12_withsq_r1_seq(r1, n_grid2, resx, resy, resz, res) double precision, intent(out) :: resx(n_grid2), resy(n_grid2), resz(n_grid2), res(n_grid2) integer :: jpoint - double precision :: v1b_r1 - double precision :: grad1_v1b(3) - double precision, allocatable :: v1b_r2(:) + double precision :: env_r1 + double precision :: grad1_env(3) + double precision, allocatable :: env_r2(:) double precision, allocatable :: u2b_r12(:) double precision, allocatable :: gradx1_u2b(:), grady1_u2b(:), gradz1_u2b(:) - double precision, external :: j1b_nucl + double precision, external :: env_nucl - PROVIDE j1b_type + PROVIDE j1e_type j2e_type env_type PROVIDE final_grid_points_extra - if( (j1b_type .eq. 100) .or. & - (j1b_type .ge. 200) .and. (j1b_type .lt. 300) ) then + if( ((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) .or. & + (j2e_type .eq. "Mur") ) then call grad1_j12_mu_r1_seq(r1, n_grid2, resx, resy, resz) do jpoint = 1, n_points_extra_final_grid - res(jpoint) = resx(jpoint) * resx(jpoint) & - + resy(jpoint) * resy(jpoint) & - + resz(jpoint) * resz(jpoint) + res(jpoint) = resx(jpoint) * resx(jpoint) + resy(jpoint) * resy(jpoint) + resz(jpoint) * resz(jpoint) enddo - elseif((j1b_type .gt. 100) .and. (j1b_type .lt. 200)) then + elseif((j2e_type .eq. "Mu") .and. (env_type .ne. "None")) then - allocate(v1b_r2(n_grid2)) + ! u(r1,r2) = j12_mu(r12) x v(r1) x v(r2) + ! grad1 u(r1, r2) = [(grad1 j12_mu) v(r1) + j12_mu grad1 v(r1)] v(r2) + + allocate(env_r2(n_grid2)) allocate(u2b_r12(n_grid2)) allocate(gradx1_u2b(n_grid2)) allocate(grady1_u2b(n_grid2)) allocate(gradz1_u2b(n_grid2)) - v1b_r1 = j1b_nucl(r1) - call grad1_j1b_nucl(r1, grad1_v1b) + env_r1 = env_nucl(r1) + call grad1_env_nucl(r1, grad1_env) - call j1b_nucl_r1_seq(n_grid2, v1b_r2) + call env_nucl_r1_seq(n_grid2, env_r2) call j12_mu_r1_seq(r1, n_grid2, u2b_r12) call grad1_j12_mu_r1_seq(r1, n_grid2, gradx1_u2b, grady1_u2b, gradz1_u2b) do jpoint = 1, n_points_extra_final_grid - resx(jpoint) = (gradx1_u2b(jpoint) * v1b_r1 + u2b_r12(jpoint) * grad1_v1b(1)) * v1b_r2(jpoint) - resy(jpoint) = (grady1_u2b(jpoint) * v1b_r1 + u2b_r12(jpoint) * grad1_v1b(2)) * v1b_r2(jpoint) - resz(jpoint) = (gradz1_u2b(jpoint) * v1b_r1 + u2b_r12(jpoint) * grad1_v1b(3)) * v1b_r2(jpoint) - res (jpoint) = resx(jpoint) * resx(jpoint) & - + resy(jpoint) * resy(jpoint) & - + resz(jpoint) * resz(jpoint) + resx(jpoint) = (gradx1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(1)) * env_r2(jpoint) + resy(jpoint) = (grady1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(2)) * env_r2(jpoint) + resz(jpoint) = (gradz1_u2b(jpoint) * env_r1 + u2b_r12(jpoint) * grad1_env(3)) * env_r2(jpoint) + res (jpoint) = resx(jpoint) * resx(jpoint) + resy(jpoint) * resy(jpoint) + resz(jpoint) * resz(jpoint) enddo - deallocate(v1b_r2, u2b_r12, gradx1_u2b, grady1_u2b, gradz1_u2b) + deallocate(env_r2, u2b_r12, gradx1_u2b, grady1_u2b, gradz1_u2b) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + print *, ' Error in get_grad1_u12_withsq_r1_seq: Unknown Jastrow' stop endif return -end subroutine get_grad1_u12_withsq_r1_seq +end ! --- @@ -87,11 +80,11 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) ! ! gradient of j(mu(r1,r2),r12) form of jastrow. ! - ! if mu(r1,r2) = cst ---> j1b_type < 200 and + ! if mu(r1,r2) = cst ---> ! ! d/dx1 j(mu,r12) = 0.5 * (1 - erf(mu *r12))/r12 * (x1 - x2) ! - ! if mu(r1,r2) /= cst ---> 200 < j1b_type < 300 and + ! if mu(r1,r2) /= cst ---> ! ! d/dx1 j(mu(r1,r2),r12) = exp(-(mu(r1,r2)*r12)**2) /(2 *sqrt(pi) * mu(r1,r2)**2 ) d/dx1 mu(r1,r2) ! + 0.5 * (1 - erf(mu(r1,r2) *r12))/r12 * (x1 - x2) @@ -110,8 +103,9 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) integer :: jpoint double precision :: r2(3) double precision :: dx, dy, dz, r12, tmp + double precision :: mu_val, mu_tmp, mu_der(3) - if((j1b_type .ge. 0) .and. (j1b_type .lt. 200)) then + if(j2e_type .eq. "Mu") then do jpoint = 1, n_points_extra_final_grid ! r2 @@ -138,9 +132,7 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) gradz(jpoint) = tmp * dz enddo - elseif((j1b_type .ge. 200) .and. (j1b_type .lt. 300)) then - - double precision :: mu_val, mu_tmp, mu_der(3) + elseif(j2e_type .eq. "Mur") then do jpoint = 1, n_points_extra_final_grid ! r2 @@ -176,13 +168,13 @@ subroutine grad1_j12_mu_r1_seq(r1, n_grid2, gradx, grady, gradz) else - print *, ' j1b_type = ', j1b_type, 'not implemented yet' + print *, ' Error in grad1_j12_mu_r1_seq: Unknown j2e_type = ', j2e_type stop - endif + endif ! j2e_type return -end subroutine grad1_j12_mu_r1_seq +end ! --- @@ -201,35 +193,26 @@ subroutine j12_mu_r1_seq(r1, n_grid2, res) PROVIDE final_grid_points_extra - if((j1b_type .ge. 0) .and. (j1b_type .lt. 200)) then + do jpoint = 1, n_points_extra_final_grid ! r2 - do jpoint = 1, n_points_extra_final_grid ! r2 + r2(1) = final_grid_points_extra(1,jpoint) + r2(2) = final_grid_points_extra(2,jpoint) + r2(3) = final_grid_points_extra(3,jpoint) - r2(1) = final_grid_points_extra(1,jpoint) - r2(2) = final_grid_points_extra(2,jpoint) - r2(3) = final_grid_points_extra(3,jpoint) + r12 = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & + + (r1(2) - r2(2)) * (r1(2) - r2(2)) & + + (r1(3) - r2(3)) * (r1(3) - r2(3)) ) + mu_tmp = mu_erf * r12 - r12 = dsqrt( (r1(1) - r2(1)) * (r1(1) - r2(1)) & - + (r1(2) - r2(2)) * (r1(2) - r2(2)) & - + (r1(3) - r2(3)) * (r1(3) - r2(3)) ) - mu_tmp = mu_erf * r12 - - res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf - enddo - - else - - print *, ' j1b_type = ', j1b_type, 'not implemented for j12_mu_r1_seq' - stop - - endif + res(jpoint) = 0.5d0 * r12 * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf + enddo return -end subroutine j12_mu_r1_seq +end ! --- -subroutine j1b_nucl_r1_seq(n_grid2, res) +subroutine env_nucl_r1_seq(n_grid2, res) ! TODO ! change loops order @@ -242,7 +225,7 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) integer :: i, jpoint double precision :: a, d, e, x, y, z - if((j1b_type .eq. 2) .or. (j1b_type .eq. 102)) then + if(env_type .eq. "Sum_Slat") then res = 1.d0 @@ -252,16 +235,16 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) r(3) = final_grid_points_extra(3,jpoint) do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - res(jpoint) -= dexp(-a*dsqrt(d)) + res(jpoint) -= env_coef(i) * dexp(-a*dsqrt(d)) enddo enddo - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then + elseif(env_type .eq. "Prod_Gauss") then res = 1.d0 @@ -271,7 +254,7 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) r(3) = final_grid_points_extra(3,jpoint) do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) @@ -281,7 +264,7 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) enddo enddo - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then + elseif(env_type .eq. "Sum_Gauss") then res = 1.d0 @@ -291,15 +274,15 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) r(3) = final_grid_points_extra(3,jpoint) do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) d = ( (r(1) - nucl_coord(i,1)) * (r(1) - nucl_coord(i,1)) & + (r(2) - nucl_coord(i,2)) * (r(2) - nucl_coord(i,2)) & + (r(3) - nucl_coord(i,3)) * (r(3) - nucl_coord(i,3)) ) - res(jpoint) -= j1b_pen_coef(i) * dexp(-a*d) + res(jpoint) -= env_coef(i) * dexp(-a*d) enddo enddo - elseif((j1b_type .eq. 5) .or. (j1b_type .eq. 105)) then + elseif(env_type .eq. "Sum_Quartic") then res = 1.d0 @@ -309,24 +292,24 @@ subroutine j1b_nucl_r1_seq(n_grid2, res) r(3) = final_grid_points_extra(3,jpoint) do i = 1, nucl_num - a = j1b_pen(i) + a = env_expo(i) x = r(1) - nucl_coord(i,1) y = r(2) - nucl_coord(i,2) z = r(3) - nucl_coord(i,3) d = x*x + y*y + z*z - res(jpoint) -= dexp(-a*d*d) + res(jpoint) -= env_coef(i) * dexp(-a*d*d) enddo enddo else - print *, ' j1b_type = ', j1b_type, 'not implemented for j1b_nucl_r1_seq' + print *, ' Error in env_nucl_r1_seq: Unknown env_type = ', env_type stop endif return -end subroutine j1b_nucl_r1_seq +end ! --- diff --git a/src/non_h_ints_mu/new_grad_tc_manu.irp.f b/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f similarity index 78% rename from src/non_h_ints_mu/new_grad_tc_manu.irp.f rename to plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f index 7ab5b327..5df80a0e 100644 --- a/src/non_h_ints_mu/new_grad_tc_manu.irp.f +++ b/plugins/local/non_h_ints_mu/new_grad_tc_manu.irp.f @@ -3,6 +3,15 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po BEGIN_DOC ! + ! !!!!!! WARNING !!!!!!!!! + ! + ! DEFINED WITH - SIGN + ! + ! FOR 3e-iontegrals this doesn't matter + ! + ! !!!!!! WARNING !!!!!!!!! + ! + ! ! int2_grad1_u12_ao_test(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) ! ! where r1 = r(ipoint) @@ -16,9 +25,9 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po ! ! int2_grad1_u12_ao_test(i,j,ipoint,:) = v1 x [ 0.5 x \int dr2 [(r1 - r2) (erf(mu * r12)-1)r_12] v2 \phi_i(r2) \phi_j(r2) ] ! - \grad_1 v1 x [ \int dr2 u12 v2 \phi_i(r2) \phi_j(r2) ] - ! = 0.5 v_1b(ipoint) * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) * r(:) - ! - 0.5 v_1b(ipoint) * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,:) - ! - v_1b_grad[:,ipoint] * v_ij_u_cst_mu_j1b(i,j,ipoint) + ! = 0.5 env_val(ipoint) * v_ij_erf_rk_cst_mu_env(i,j,ipoint) * r(:) + ! - 0.5 env_val(ipoint) * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,:) + ! - env_grad[:,ipoint] * v_ij_u_cst_mu_env(i,j,ipoint) ! ! END_DOC @@ -31,8 +40,6 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po print*, ' providing int2_grad1_u12_ao_test ...' call wall_time(time0) - PROVIDE j1b_type - if(read_tc_integ) then open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao_test', action="read") @@ -41,41 +48,33 @@ BEGIN_PROVIDER [ double precision, int2_grad1_u12_ao_test, (ao_num, ao_num, n_po else - if(j1b_type .eq. 3) then + if((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then + do ipoint = 1, n_points_final_grid x = final_grid_points(1,ipoint) y = final_grid_points(2,ipoint) z = final_grid_points(3,ipoint) - tmp0 = 0.5d0 * v_1b(ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) + tmp0 = 0.5d0 * env_val(ipoint) + tmp_x = env_grad(1,ipoint) + tmp_y = env_grad(2,ipoint) + tmp_z = env_grad(3,ipoint) do j = 1, ao_num do i = 1, ao_num - tmp1 = tmp0 * v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint) - tmp2 = v_ij_u_cst_mu_j1b_test(i,j,ipoint) - int2_grad1_u12_ao_test(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,1) - tmp2 * tmp_x - int2_grad1_u12_ao_test(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,2) - tmp2 * tmp_y - int2_grad1_u12_ao_test(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_j1b_test(i,j,ipoint,3) - tmp2 * tmp_z + tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env_test(i,j,ipoint) + tmp2 = v_ij_u_cst_mu_env_test(i,j,ipoint) + int2_grad1_u12_ao_test(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,1) - tmp2 * tmp_x + int2_grad1_u12_ao_test(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,2) - tmp2 * tmp_y + int2_grad1_u12_ao_test(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env_test(i,j,ipoint,3) - tmp2 * tmp_z enddo enddo enddo + else - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) - int2_grad1_u12_ao_test(i,j,ipoint,1) = tmp1 * x - x_v_ij_erf_rk_cst_mu_tmp(i,j,ipoint,1) - int2_grad1_u12_ao_test(i,j,ipoint,2) = tmp1 * y - x_v_ij_erf_rk_cst_mu_tmp(i,j,ipoint,2) - int2_grad1_u12_ao_test(i,j,ipoint,3) = tmp1 * z - x_v_ij_erf_rk_cst_mu_tmp(i,j,ipoint,3) - enddo - enddo - enddo - int2_grad1_u12_ao_test *= 0.5d0 - endif + + print *, ' Error in int2_grad1_u12_ao_test: Unknown j2e_type = ', j2e_type + stop + + endif ! j2e_type endif @@ -191,7 +190,7 @@ BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao_test, (ao_num, ao_num, ao_ endif call wall_time(time1) - print*, ' Wall time for tc_grad_and_lapl_ao_test = ', time1 - time0 + print*, ' Wall time for tc_grad_and_lapl_ao_test (min) = ', (time1 - time0) / 60.d0 END_PROVIDER diff --git a/src/non_h_ints_mu/numerical_integ.irp.f b/plugins/local/non_h_ints_mu/numerical_integ.irp.f similarity index 67% rename from src/non_h_ints_mu/numerical_integ.irp.f rename to plugins/local/non_h_ints_mu/numerical_integ.irp.f index f9457247..5436b857 100644 --- a/src/non_h_ints_mu/numerical_integ.irp.f +++ b/plugins/local/non_h_ints_mu/numerical_integ.irp.f @@ -1,11 +1,11 @@ ! --- -double precision function num_v_ij_u_cst_mu_j1b(i, j, ipoint) +double precision function num_v_ij_u_cst_mu_env(i, j, ipoint) BEGIN_DOC ! - ! \int dr2 u12 \phi_i(r2) \phi_j(r2) x v_1b(r2) + ! \int dr2 u12 \phi_i(r2) \phi_j(r2) x v_env(r2) ! END_DOC @@ -17,31 +17,31 @@ double precision function num_v_ij_u_cst_mu_j1b(i, j, ipoint) double precision :: r1(3), r2(3) double precision, external :: ao_value - double precision, external :: j12_mu, j1b_nucl, j12_mu_gauss + double precision, external :: j12_mu, env_nucl, j12_mu_gauss r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_v_ij_u_cst_mu_j1b = 0.d0 + num_v_ij_u_cst_mu_env = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) r2(2) = final_grid_points(2,jpoint) r2(3) = final_grid_points(3,jpoint) - num_v_ij_u_cst_mu_j1b += ao_value(i, r2) * ao_value(j, r2) * j12_mu_gauss(r1, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint) + num_v_ij_u_cst_mu_env += ao_value(i, r2) * ao_value(j, r2) * j12_mu_gauss(r1, r2) * env_nucl(r2) * final_weight_at_r_vector(jpoint) enddo return -end function num_v_ij_u_cst_mu_j1b +end ! --- -double precision function num_int2_u2_j1b2(i, j, ipoint) +double precision function num_int2_u2_env2(i, j, ipoint) BEGIN_DOC ! - ! \int dr2 u12^2 \phi_i(r2) \phi_j(r2) x v_1b(r2)^2 + ! \int dr2 u12^2 \phi_i(r2) \phi_j(r2) x v_env(r2)^2 ! END_DOC @@ -54,14 +54,14 @@ double precision function num_int2_u2_j1b2(i, j, ipoint) double precision :: dx, dy, dz, r12, x2, tmp1, tmp2, tmp3, coef, expo double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_int2_u2_j1b2 = 0.d0 + num_int2_u2_env2 = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) r2(2) = final_grid_points(2,jpoint) @@ -72,7 +72,7 @@ double precision function num_int2_u2_j1b2(i, j, ipoint) x2 = dx * dx + dy * dy + dz * dz r12 = dsqrt(x2) - tmp1 = j1b_nucl(r2) + tmp1 = env_nucl(r2) tmp2 = tmp1 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) !tmp3 = 0.d0 @@ -84,19 +84,19 @@ double precision function num_int2_u2_j1b2(i, j, ipoint) tmp3 = j12_mu(r1, r2) tmp3 = tmp3 * tmp3 - num_int2_u2_j1b2 += tmp2 * tmp3 + num_int2_u2_env2 += tmp2 * tmp3 enddo return -end function num_int2_u2_j1b2 +end ! --- -double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint) +double precision function num_int2_grad1u2_grad2u2_env2(i, j, ipoint) BEGIN_DOC ! - ! \int dr2 \frac{-[erf(mu r12) -1]^2}{4} \phi_i(r2) \phi_j(r2) x v_1b(r2)^2 + ! \int dr2 \frac{-[erf(mu r12) -1]^2}{4} \phi_i(r2) \phi_j(r2) x v_env(r2)^2 ! END_DOC @@ -109,13 +109,13 @@ double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint) double precision :: dx, dy, dz, r12, x2, tmp1, tmp2, tmp3, coef, expo double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_int2_grad1u2_grad2u2_j1b2 = 0.d0 + num_int2_grad1u2_grad2u2_env2 = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) r2(2) = final_grid_points(2,jpoint) @@ -126,7 +126,7 @@ double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint) x2 = dx * dx + dy * dy + dz * dz r12 = dsqrt(x2) - tmp1 = j1b_nucl(r2) + tmp1 = env_nucl(r2) tmp2 = tmp1 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) !tmp3 = 0.d0 @@ -140,19 +140,19 @@ double precision function num_int2_grad1u2_grad2u2_j1b2(i, j, ipoint) tmp3 = -0.25d0 * tmp3 - num_int2_grad1u2_grad2u2_j1b2 += tmp2 * tmp3 + num_int2_grad1u2_grad2u2_env2 += tmp2 * tmp3 enddo return -end function num_int2_grad1u2_grad2u2_j1b2 +end ! --- -double precision function num_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint) +double precision function num_v_ij_erf_rk_cst_mu_env(i, j, ipoint) BEGIN_DOC ! - ! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_1b(r2) + ! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_env(r2) ! END_DOC @@ -165,13 +165,13 @@ double precision function num_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint) double precision :: dx, dy, dz, r12, tmp1, tmp2 double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_v_ij_erf_rk_cst_mu_j1b = 0.d0 + num_v_ij_erf_rk_cst_mu_env = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) r2(2) = final_grid_points(2,jpoint) @@ -183,21 +183,21 @@ double precision function num_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint) if(r12 .lt. 1d-10) cycle tmp1 = (derf(mu_erf * r12) - 1.d0) / r12 - tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint) + tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * env_nucl(r2) * final_weight_at_r_vector(jpoint) - num_v_ij_erf_rk_cst_mu_j1b += tmp2 + num_v_ij_erf_rk_cst_mu_env += tmp2 enddo return -end function num_v_ij_erf_rk_cst_mu_j1b +end ! --- -subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) +subroutine num_x_v_ij_erf_rk_cst_mu_env(i, j, ipoint, integ) BEGIN_DOC ! - ! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_1b(r2) x r2 + ! \int dr2 [erf(mu r12) -1]/r12 \phi_i(r2) \phi_j(r2) x v_env(r2) x r2 ! END_DOC @@ -212,7 +212,7 @@ subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) double precision :: tmp_x, tmp_y, tmp_z double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) @@ -232,7 +232,7 @@ subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) if(r12 .lt. 1d-10) cycle tmp1 = (derf(mu_erf * r12) - 1.d0) / r12 - tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * j1b_nucl(r2) * final_weight_at_r_vector(jpoint) + tmp2 = tmp1 * ao_value(i, r2) * ao_value(j, r2) * env_nucl(r2) * final_weight_at_r_vector(jpoint) tmp_x += tmp2 * r2(1) tmp_y += tmp2 * r2(2) @@ -244,7 +244,7 @@ subroutine num_x_v_ij_erf_rk_cst_mu_j1b(i, j, ipoint, integ) integ(3) = tmp_z return -end subroutine num_x_v_ij_erf_rk_cst_mu_j1b +end ! --- @@ -252,7 +252,7 @@ subroutine num_int2_grad1_u12_ao(i, j, ipoint, integ) BEGIN_DOC ! - ! \int dr2 [-grad_1 u12] \phi_i(r2) \phi_j(r2) x v12_1b(r1, r2) + ! \int dr2 [-grad_1 u12] \phi_i(r2) \phi_j(r2) x v12_env(r1, r2) ! END_DOC @@ -292,78 +292,7 @@ subroutine num_int2_grad1_u12_ao(i, j, ipoint, integ) integ(3) = tmp_z return -end subroutine num_int2_grad1_u12_ao - -! --- - -double precision function num_gradu_squared_u_ij_mu(i, j, ipoint) - - BEGIN_DOC - ! - ! -0.50 x \int r2 \phi_i(2) \phi_j(2) x v2^2 - ! [ v1^2 ((grad_1 u12)^2 + (grad_2 u12^2)]) - ! + u12^2 (grad_1 v1)^2 - ! + 2 u12 v1 (grad_1 u12) . (grad_1 v1) - ! - END_DOC - - - implicit none - - integer, intent(in) :: i, j, ipoint - - integer :: jpoint - double precision :: r1(3), r2(3) - double precision :: tmp_x, tmp_y, tmp_z, r12 - double precision :: dx1_v1, dy1_v1, dz1_v1, grad_u12(3) - double precision :: tmp1, v1_tmp, v2_tmp, u12_tmp - double precision :: fst_term, scd_term, thd_term, tmp - - double precision, external :: ao_value - double precision, external :: j1b_nucl - double precision, external :: j12_mu - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num - - r1(1) = final_grid_points(1,ipoint) - r1(2) = final_grid_points(2,ipoint) - r1(3) = final_grid_points(3,ipoint) - - num_gradu_squared_u_ij_mu = 0.d0 - do jpoint = 1, n_points_final_grid - - r2(1) = final_grid_points(1,jpoint) - r2(2) = final_grid_points(2,jpoint) - r2(3) = final_grid_points(3,jpoint) - - tmp_x = r1(1) - r2(1) - tmp_y = r1(2) - r2(2) - tmp_z = r1(3) - r2(3) - r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z) - - dx1_v1 = grad_x_j1b_nucl_num(r1) - dy1_v1 = grad_y_j1b_nucl_num(r1) - dz1_v1 = grad_z_j1b_nucl_num(r1) - - call grad1_j12_mu(r1, r2, grad_u12) - - tmp1 = 1.d0 - derf(mu_erf * r12) - v1_tmp = j1b_nucl(r1) - v2_tmp = j1b_nucl(r2) - u12_tmp = j12_mu(r1, r2) - - fst_term = 0.5d0 * tmp1 * tmp1 * v1_tmp * v1_tmp - scd_term = u12_tmp * u12_tmp * (dx1_v1*dx1_v1 + dy1_v1*dy1_v1 + dz1_v1*dz1_v1) - thd_term = 2.d0 * v1_tmp * u12_tmp * (dx1_v1*grad_u12(1) + dy1_v1*grad_u12(2) + dz1_v1*grad_u12(3)) - - tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * (fst_term + scd_term + thd_term) * v2_tmp * v2_tmp - - num_gradu_squared_u_ij_mu += tmp - enddo - - return -end function num_gradu_squared_u_ij_mu +end ! --- @@ -388,11 +317,11 @@ double precision function num_grad12_j12(i, j, ipoint) double precision :: fst_term, scd_term, thd_term, tmp double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) @@ -410,15 +339,15 @@ double precision function num_grad12_j12(i, j, ipoint) tmp_z = r1(3) - r2(3) r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z) - dx1_v1 = grad_x_j1b_nucl_num(r1) - dy1_v1 = grad_y_j1b_nucl_num(r1) - dz1_v1 = grad_z_j1b_nucl_num(r1) + dx1_v1 = grad_x_env_nucl_num(r1) + dy1_v1 = grad_y_env_nucl_num(r1) + dz1_v1 = grad_z_env_nucl_num(r1) call grad1_j12_mu(r1, r2, grad_u12) tmp1 = 1.d0 - derf(mu_erf * r12) - v1_tmp = j1b_nucl(r1) - v2_tmp = j1b_nucl(r2) + v1_tmp = env_nucl(r1) + v2_tmp = env_nucl(r2) u12_tmp = j12_mu(r1, r2) fst_term = 0.5d0 * tmp1 * tmp1 * v1_tmp * v1_tmp @@ -429,11 +358,11 @@ double precision function num_grad12_j12(i, j, ipoint) enddo return -end function num_grad12_j12 +end ! --- -double precision function num_u12sq_j1bsq(i, j, ipoint) +double precision function num_u12sq_envsq(i, j, ipoint) BEGIN_DOC ! @@ -454,17 +383,17 @@ double precision function num_u12sq_j1bsq(i, j, ipoint) double precision :: fst_term, scd_term, thd_term, tmp double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_u12sq_j1bsq = 0.d0 + num_u12sq_envsq = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) @@ -476,30 +405,30 @@ double precision function num_u12sq_j1bsq(i, j, ipoint) tmp_z = r1(3) - r2(3) r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z) - dx1_v1 = grad_x_j1b_nucl_num(r1) - dy1_v1 = grad_y_j1b_nucl_num(r1) - dz1_v1 = grad_z_j1b_nucl_num(r1) + dx1_v1 = grad_x_env_nucl_num(r1) + dy1_v1 = grad_y_env_nucl_num(r1) + dz1_v1 = grad_z_env_nucl_num(r1) call grad1_j12_mu(r1, r2, grad_u12) tmp1 = 1.d0 - derf(mu_erf * r12) - v1_tmp = j1b_nucl(r1) - v2_tmp = j1b_nucl(r2) + v1_tmp = env_nucl(r1) + v2_tmp = env_nucl(r2) u12_tmp = j12_mu(r1, r2) scd_term = u12_tmp * u12_tmp * (dx1_v1*dx1_v1 + dy1_v1*dy1_v1 + dz1_v1*dz1_v1) tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * scd_term * v2_tmp * v2_tmp - num_u12sq_j1bsq += tmp + num_u12sq_envsq += tmp enddo return -end function num_u12sq_j1bsq +end ! --- -double precision function num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint) +double precision function num_u12_grad1_u12_env_grad1_env(i, j, ipoint) BEGIN_DOC ! @@ -520,17 +449,17 @@ double precision function num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint) double precision :: fst_term, scd_term, thd_term, tmp double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num + double precision, external :: grad_x_env_nucl_num + double precision, external :: grad_y_env_nucl_num + double precision, external :: grad_z_env_nucl_num r1(1) = final_grid_points(1,ipoint) r1(2) = final_grid_points(2,ipoint) r1(3) = final_grid_points(3,ipoint) - num_u12_grad1_u12_j1b_grad1_j1b = 0.d0 + num_u12_grad1_u12_env_grad1_env = 0.d0 do jpoint = 1, n_points_final_grid r2(1) = final_grid_points(1,jpoint) @@ -542,34 +471,34 @@ double precision function num_u12_grad1_u12_j1b_grad1_j1b(i, j, ipoint) tmp_z = r1(3) - r2(3) r12 = dsqrt(tmp_x*tmp_x + tmp_y*tmp_y + tmp_z*tmp_z) - dx1_v1 = grad_x_j1b_nucl_num(r1) - dy1_v1 = grad_y_j1b_nucl_num(r1) - dz1_v1 = grad_z_j1b_nucl_num(r1) + dx1_v1 = grad_x_env_nucl_num(r1) + dy1_v1 = grad_y_env_nucl_num(r1) + dz1_v1 = grad_z_env_nucl_num(r1) call grad1_j12_mu(r1, r2, grad_u12) tmp1 = 1.d0 - derf(mu_erf * r12) - v1_tmp = j1b_nucl(r1) - v2_tmp = j1b_nucl(r2) + v1_tmp = env_nucl(r1) + v2_tmp = env_nucl(r2) u12_tmp = j12_mu(r1, r2) thd_term = 2.d0 * v1_tmp * u12_tmp * (dx1_v1*grad_u12(1) + dy1_v1*grad_u12(2) + dz1_v1*grad_u12(3)) tmp = -0.5d0 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) * thd_term * v2_tmp * v2_tmp - num_u12_grad1_u12_j1b_grad1_j1b += tmp + num_u12_grad1_u12_env_grad1_env += tmp enddo return -end function num_u12_grad1_u12_j1b_grad1_j1b +end ! --- -subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) +subroutine num_int2_u_grad1u_total_env2(i, j, ipoint, integ) BEGIN_DOC ! - ! \int dr2 u12 (grad_1 u12) \phi_i(r2) \phi_j(r2) x v_1b(r2)^2 + ! \int dr2 u12 (grad_1 u12) \phi_i(r2) \phi_j(r2) x v_env(r2)^2 ! END_DOC @@ -584,7 +513,7 @@ subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) double precision :: tmp_x, tmp_y, tmp_z double precision, external :: ao_value - double precision, external :: j1b_nucl + double precision, external :: env_nucl double precision, external :: j12_mu r1(1) = final_grid_points(1,ipoint) @@ -604,7 +533,7 @@ subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) r12 = dsqrt( dx * dx + dy * dy + dz * dz ) if(r12 .lt. 1d-10) cycle - tmp0 = j1b_nucl(r2) + tmp0 = env_nucl(r2) tmp1 = 0.5d0 * j12_mu(r1, r2) * (1.d0 - derf(mu_erf * r12)) / r12 tmp2 = tmp0 * tmp0 * tmp1 * ao_value(i, r2) * ao_value(j, r2) * final_weight_at_r_vector(jpoint) @@ -618,6 +547,6 @@ subroutine num_int2_u_grad1u_total_j1b2(i, j, ipoint, integ) integ(3) = tmp_z return -end subroutine num_int2_u_grad1u_total_j1b2 +end ! --- diff --git a/src/non_h_ints_mu/plot_mu_of_r.irp.f b/plugins/local/non_h_ints_mu/plot_mu_of_r.irp.f similarity index 100% rename from src/non_h_ints_mu/plot_mu_of_r.irp.f rename to plugins/local/non_h_ints_mu/plot_mu_of_r.irp.f diff --git a/src/non_h_ints_mu/qmckl.irp.f b/plugins/local/non_h_ints_mu/qmckl.irp.f similarity index 100% rename from src/non_h_ints_mu/qmckl.irp.f rename to plugins/local/non_h_ints_mu/qmckl.irp.f diff --git a/plugins/local/non_h_ints_mu/tc_integ.irp.f b/plugins/local/non_h_ints_mu/tc_integ.irp.f new file mode 100644 index 00000000..88336485 --- /dev/null +++ b/plugins/local/non_h_ints_mu/tc_integ.irp.f @@ -0,0 +1,614 @@ + +BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_final_grid, 3)] + + BEGIN_DOC + ! + ! int2_grad1_u12_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) + ! + ! where r1 = r(ipoint) + ! + END_DOC + + implicit none + integer :: ipoint, i, j, m, jpoint + double precision :: time0, time1 + double precision :: x, y, z, r2 + double precision :: dx, dy, dz + double precision :: tmp_ct + double precision :: tmp0, tmp1, tmp2 + double precision :: tmp0_x, tmp0_y, tmp0_z + double precision :: tmp1_x, tmp1_y, tmp1_z + + PROVIDE j2e_type + PROVIDE j1e_type + + call wall_time(time0) + + print*, ' providing int2_grad1_u12_ao ...' + + if(read_tc_integ) then + + print*, ' Reading int2_grad1_u12_ao from ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") + read(11) int2_grad1_u12_ao + close(11) + + else + + if(tc_integ_type .eq. "analytic") then + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet.' + stop + + elseif(tc_integ_type .eq. "numeric") then + + print *, ' Numerical integration over r1 and r2 will be performed' + + ! TODO combine 1shot & int2_grad1_u12_ao_num + + PROVIDE int2_grad1_u12_ao_num + int2_grad1_u12_ao = int2_grad1_u12_ao_num + + !PROVIDE int2_grad1_u12_ao_num_1shot + !int2_grad1_u12_ao = int2_grad1_u12_ao_num_1shot + + elseif(tc_integ_type .eq. "semi-analytic") then + + print*, ' Numerical integration over r1, with analytical integration over r2' + + ! --- + + if(j2e_type .eq. "None") then + + int2_grad1_u12_ao = 0.d0 + + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then + + PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu + + int2_grad1_u12_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & + !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & + !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u12_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + do j = 1, ao_num + do i = 1, ao_num + tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) + int2_grad1_u12_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) + int2_grad1_u12_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then + + PROVIDE env_type env_val env_grad + PROVIDE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + + int2_grad1_u12_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, env_val, env_grad, & + !$OMP v_ij_erf_rk_cst_mu_env, v_ij_u_cst_mu_env_an, x_v_ij_erf_rk_cst_mu_env, int2_grad1_u12_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + tmp0 = 0.5d0 * env_val(ipoint) + tmp0_x = env_grad(1,ipoint) + tmp0_y = env_grad(2,ipoint) + tmp0_z = env_grad(3,ipoint) + do j = 1, ao_num + do i = 1, ao_num + tmp1 = tmp0 * v_ij_erf_rk_cst_mu_env(i,j,ipoint) + tmp2 = v_ij_u_cst_mu_env_an(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,1) - tmp2 * tmp0_x + int2_grad1_u12_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,2) - tmp2 * tmp0_y + int2_grad1_u12_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_env(i,j,ipoint,3) - tmp2 * tmp0_z + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + + PROVIDE mu_erf + PROVIDE env_type env_val env_grad + PROVIDE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_long_Du_2 + PROVIDE Ir2_Mu_gauss_Du + + tmp_ct = 0.5d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + + int2_grad1_u12_ao = 0.d0 + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, tmp1, tmp2, & + !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct, env_val, env_grad, Ir2_Mu_long_Du_0, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & + !$OMP Ir2_Mu_long_Du_2, int2_grad1_u12_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx = env_grad(1,ipoint) + dy = env_grad(2,ipoint) + dz = env_grad(3,ipoint) + + tmp0_x = 0.5d0 * (env_val(ipoint) * x + r2 * dx) + tmp0_y = 0.5d0 * (env_val(ipoint) * y + r2 * dy) + tmp0_z = 0.5d0 * (env_val(ipoint) * z + r2 * dz) + + tmp1 = 0.5d0 * env_val(ipoint) + + tmp1_x = tmp_ct * dx + tmp1_y = tmp_ct * dy + tmp1_z = tmp_ct * dz + + do j = 1, ao_num + do i = 1, ao_num + + tmp2 = 0.5d0 * Ir2_Mu_long_Du_2(i,j,ipoint) - x * Ir2_Mu_long_Du_x(i,j,ipoint) - y * Ir2_Mu_long_Du_y(i,j,ipoint) - z * Ir2_Mu_long_Du_z(i,j,ipoint) + + int2_grad1_u12_ao(i,j,ipoint,1) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_x + tmp1 * Ir2_Mu_long_Du_x(i,j,ipoint) - dx * tmp2 + tmp1_x * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,2) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_y + tmp1 * Ir2_Mu_long_Du_y(i,j,ipoint) - dy * tmp2 + tmp1_y * Ir2_Mu_gauss_Du(i,j,ipoint) + int2_grad1_u12_ao(i,j,ipoint,3) = -Ir2_Mu_long_Du_0(i,j,ipoint) * tmp0_z + tmp1 * Ir2_Mu_long_Du_z(i,j,ipoint) - dz * tmp2 + tmp1_z * Ir2_Mu_gauss_Du(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + else + + print *, ' Error in int2_grad1_u12_ao: Unknown Jastrow' + stop + + endif ! j2e_type + + ! --- + + if(j1e_type .ne. "None") then + + PROVIDE elec_num + PROVIDE ao_overlap + PROVIDE j1e_gradx j1e_grady j1e_gradz + + ! minus because we calculate \int [-\grad_1 u(1,2)] + tmp_ct = -1.d0 / (dble(elec_num) - 1.d0) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, tmp_ct, & + !$OMP j1e_gradx, j1e_grady, j1e_gradz, ao_overlap, int2_grad1_u12_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + tmp0_x = tmp_ct * j1e_gradx(ipoint) + tmp0_y = tmp_ct * j1e_grady(ipoint) + tmp0_z = tmp_ct * j1e_gradz(ipoint) + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_ao(i,j,ipoint,1) = int2_grad1_u12_ao(i,j,ipoint,1) + tmp0_x * ao_overlap(i,j) + int2_grad1_u12_ao(i,j,ipoint,2) = int2_grad1_u12_ao(i,j,ipoint,2) + tmp0_y * ao_overlap(i,j) + int2_grad1_u12_ao(i,j,ipoint,3) = int2_grad1_u12_ao(i,j,ipoint,3) + tmp0_z * ao_overlap(i,j) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + else + + if((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then + FREE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then + FREE v_ij_erf_rk_cst_mu_env v_ij_u_cst_mu_env_an x_v_ij_erf_rk_cst_mu_env + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_gauss_Du Ir2_Mu_long_Du_2 + endif + + endif ! j1e_type + + ! --- + + else + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' + stop + + endif ! tc_integ_type + + endif ! read_tc_integ + + + if(write_tc_integ .and. mpi_master) then + + print*, ' Writing int2_grad1_u12_ao in ', trim(ezfio_filename) // '/work/int2_grad1_u12_ao' + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="write") + call ezfio_set_work_empty(.False.) + write(11) int2_grad1_u12_ao + close(11) + call ezfio_set_tc_keywords_io_tc_integ('Read') + endif + + call wall_time(time1) + print*, ' wall time for int2_grad1_u12_ao (min) =', (time1-time0)/60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + +BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_points_final_grid)] + + BEGIN_DOC + ! + ! int2_grad1_u12_square_ao = -(1/2) x int dr2 chi_l(r2) chi_j(r2) [grad_1 u(r1,r2)]^2 + ! + END_DOC + + implicit none + integer :: ipoint, i, j, m, jpoint + double precision :: x, y, z, r2 + double precision :: dx, dy, dz, dr2 + double precision :: dx1, dy1, dz1, dx2, dy2, dz2, dr12 + double precision :: tmp_ct, tmp_ct1, tmp_ct2 + double precision :: tmp0, tmp1, tmp2 + double precision :: tmp3, tmp4, tmp5, tmp6 + double precision :: tmp0_x, tmp0_y, tmp0_z + double precision :: tmp1_x, tmp1_y, tmp1_z + double precision :: time0, time1 + + PROVIDE j2e_type + PROVIDE j1e_type + PROVIDE tc_integ_type + + call wall_time(time0) + + print*, ' providing int2_grad1_u12_square_ao ...' + + if(tc_integ_type .eq. "analytic") then + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet.' + stop + + elseif(tc_integ_type .eq. "numeric") then + + print *, ' Numerical integration over r1 and r2 will be performed' + + ! TODO combine 1shot & int2_grad1_u12_square_ao_num + + PROVIDE int2_grad1_u12_square_ao_num + int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num + + !PROVIDE int2_grad1_u12_square_ao_num_1shot + !int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num_1shot + + elseif(tc_integ_type .eq. "semi-analytic") then + + print*, ' Numerical integration over r1, with analytical integration over r2' + + ! --- + + if(j2e_type .eq. "None") then + + int2_grad1_u12_square_ao = 0.d0 + + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "None")) then + + PROVIDE int2_grad1u2_grad2u2 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, int2_grad1u2_grad2u2) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1u2_grad2u2(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE int2_grad1u2_grad2u2 + + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Prod_Gauss")) then + + PROVIDE mu_erf + PROVIDE env_val env_grad + + if(use_ipp) then + + ! the term u12_grad1_u12_env_grad1_env is added directly for performance + PROVIDE u12sq_envsq grad12_j12 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_envsq, grad12_j12) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_envsq(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE u12sq_envsq grad12_j12 + + else + + PROVIDE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_envsq, grad12_j12, u12_grad1_u12_env_grad1_env) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_envsq(i,j,ipoint) + u12_grad1_u12_env_grad1_env(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 + + endif ! use_ipp + + elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then + + PROVIDE mu_erf + PROVIDE env_type env_val env_grad + + if(use_ipp) then + + ! do not free int2_u2_env2 here + PROVIDE int2_u2_env2 + PROVIDE int2_grad1u2_grad2u2_env2 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint, tmp0_x, tmp0_y, tmp0_z, tmp1, tmp2) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, & + !$OMP env_val, env_grad, int2_u2_env2, int2_grad1u2_grad2u2_env2) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + tmp0_x = env_grad(1,ipoint) + tmp0_y = env_grad(2,ipoint) + tmp0_z = env_grad(3,ipoint) + tmp1 = -0.5d0 * (tmp0_x * tmp0_x + tmp0_y * tmp0_y + tmp0_z * tmp0_z) + tmp2 = 0.5d0 * env_val(ipoint) * env_val(ipoint) + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * int2_u2_env2(i,j,ipoint) + tmp2 * int2_grad1u2_grad2u2_env2(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE int2_grad1u2_grad2u2_env2 + + else + + PROVIDE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 + + int2_grad1_u12_square_ao = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, j, ipoint) & + !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_envsq, grad12_j12, u12_grad1_u12_env_grad1_env) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + do j = 1, ao_num + do i = 1, ao_num + int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_envsq(i,j,ipoint) + u12_grad1_u12_env_grad1_env(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE u12sq_envsq u12_grad1_u12_env_grad1_env grad12_j12 + + endif ! use_ipp + +! elseif((j2e_type .eq. "Mu") .and. (env_type .eq. "Sum_Gauss")) then +! +! PROVIDE mu_erf +! PROVIDE env_val env_grad +! PROVIDE Ir2_Mu_short_Du2_0 Ir2_Mu_short_Du2_x Ir2_Mu_short_Du2_y Ir2_Mu_short_Du2_z Ir2_Mu_short_Du2_2 +! PROVIDE Ir2_Mu_long_Du2_0 Ir2_Mu_long_Du2_x Ir2_Mu_long_Du2_y Ir2_Mu_long_Du2_z Ir2_Mu_long_Du2_2 +! PROVIDE Ir2_Mu_gauss_Du2 +! +! tmp_ct = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) +! tmp_ct2 = tmp_ct * tmp_ct +! +! int2_grad1_u12_square_ao = 0.d0 +! +! !$OMP PARALLEL & +! !$OMP DEFAULT (NONE) & +! !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx, dy, dz, dr2, & +! !$OMP tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, & +! !$OMP tmp0_x, tmp0_y, tmp0_z, tmp1_x, tmp1_y, tmp1_z) & +! !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & +! !$OMP tmp_ct, tmp_ct2, env_val, env_grad, & +! !$OMP Ir2_Mu_long_Du2_0, Ir2_Mu_long_Du2_x, & +! !$OMP Ir2_Mu_long_Du2_y, Ir2_Mu_long_Du2_z, & +! !$OMP Ir2_Mu_gauss_Du2, Ir2_Mu_long_Du2_2, & +! !$OMP Ir2_Mu_short_Du2_0, Ir2_Mu_short_Du2_x, & +! !$OMP Ir2_Mu_short_Du2_y, Ir2_Mu_short_Du2_z, & +! !$OMP Ir2_Mu_short_Du2_2, int2_grad1_u12_square_ao) +! !$OMP DO SCHEDULE (static) +! do ipoint = 1, n_points_final_grid +! +! x = final_grid_points(1,ipoint) +! y = final_grid_points(2,ipoint) +! z = final_grid_points(3,ipoint) +! r2 = x*x + y*y + z*z +! +! dx = env_grad(1,ipoint) +! dy = env_grad(2,ipoint) +! dz = env_grad(3,ipoint) +! dr2 = dx*dx + dy*dy + dz*dz +! +! tmp0_x = 0.5d0 * (dr2 * x + env_val(ipoint) * dx) +! tmp0_y = 0.5d0 * (dr2 * y + env_val(ipoint) * dy) +! tmp0_z = 0.5d0 * (dr2 * z + env_val(ipoint) * dz) +! +! tmp1 = 0.25d0 * (env_val(ipoint)*env_val(ipoint) + r2*dr2 + 2.d0*env_val(ipoint)*(x*dx+y*dy+z*dz)) +! tmp3 = 0.25d0 * dr2 +! tmp4 = tmp3 * tmp_ct2 +! tmp5 = 0.50d0 * tmp_ct * (r2*dr2 + env_val(ipoint)*(x*dx+y*dy+z*dz)) +! tmp6 = 0.50d0 * tmp_ct * dr2 +! +! tmp1_x = 0.5d0 * tmp_ct * (2.d0*dr2*x + env_val(ipoint)*dx) +! tmp1_y = 0.5d0 * tmp_ct * (2.d0*dr2*y + env_val(ipoint)*dy) +! tmp1_z = 0.5d0 * tmp_ct * (2.d0*dr2*z + env_val(ipoint)*dz) +! +! do j = 1, ao_num +! do i = 1, ao_num +! +! tmp2 = tmp1_x * Ir2_Mu_long_Du2_x (i,j,ipoint) + tmp1_y * Ir2_Mu_long_Du2_y (i,j,ipoint) + tmp1_z * Ir2_Mu_long_Du2_z (i,j,ipoint) & +! - tmp0_x * Ir2_Mu_short_Du2_x(i,j,ipoint) - tmp0_y * Ir2_Mu_short_Du2_y(i,j,ipoint) - tmp0_z * Ir2_Mu_short_Du2_z(i,j,ipoint) +! +! int2_grad1_u12_square_ao(i,j,ipoint) = tmp1 * Ir2_Mu_short_Du2_0(i,j,ipoint) + tmp2 + tmp3 * Ir2_Mu_short_Du2_2(i,j,ipoint) & +! + tmp4 * Ir2_Mu_gauss_Du2(i,j,ipoint) - tmp5 * Ir2_Mu_long_Du2_0(i,j,ipoint) & +! - tmp6 * Ir2_Mu_long_Du2_2(i,j,ipoint) +! enddo +! enddo +! enddo +! !$OMP END DO +! !$OMP END PARALLEL +! +! int2_grad1_u12_square_ao = -0.5d0 * int2_grad1_u12_square_ao + + else + + print *, ' Error in int2_grad1_u12_square_ao: Unknown Jhastrow' + stop + + endif ! j2e_type + + ! --- + + if(j1e_type .ne. "None") then + + PROVIDE elec_num + PROVIDE ao_overlap + PROVIDE j1e_gradx j1e_grady j1e_gradz + + tmp_ct1 = 1.d0 / (dsqrt(dacos(-1.d0)) * mu_erf) + tmp_ct2 = 1.d0 / (dble(elec_num) - 1.d0) + + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (ipoint, i, j, x, y, z, r2, dx1, dy1, dz1, & + !$OMP dx2, dy2, dz2, dr12, tmp0, tmp1, tmp2, tmp3, tmp4, & + !$OMP tmp0_x, tmp0_y, tmp0_z) & + !$OMP SHARED (ao_num, n_points_final_grid, final_grid_points, & + !$OMP tmp_ct1, tmp_ct2, env_val, env_grad, & + !$OMP j1e_gradx, j1e_grady, j1e_gradz, & + !$OMP Ir2_Mu_long_Du_0, Ir2_Mu_long_Du_2, & + !$OMP Ir2_Mu_long_Du_x, Ir2_Mu_long_Du_y, & + !$OMP Ir2_Mu_long_Du_z, Ir2_Mu_gauss_Du, & + !$OMP ao_overlap, int2_grad1_u12_square_ao) + !$OMP DO SCHEDULE (static) + do ipoint = 1, n_points_final_grid + + x = final_grid_points(1,ipoint) + y = final_grid_points(2,ipoint) + z = final_grid_points(3,ipoint) + r2 = x*x + y*y + z*z + + dx1 = env_grad(1,ipoint) + dy1 = env_grad(2,ipoint) + dz1 = env_grad(3,ipoint) + + dx2 = j1e_gradx(ipoint) + dy2 = j1e_grady(ipoint) + dz2 = j1e_gradz(ipoint) + + dr12 = dx1*dx2 + dy1*dy2 + dz1*dz2 + + tmp0 = tmp_ct2 * (env_val(ipoint) * (dx2*x + dy2*y + dz2*z) + r2*dr12) + tmp1 = tmp_ct2 * dr12 + tmp2 = tmp_ct1 * tmp_ct2 * dr12 + tmp3 = tmp_ct2 * tmp_ct2 * (dx2*dx2 + dy2*dy2 + dz2*dz2) + + tmp0_x = tmp_ct2 * (env_val(ipoint) * dx2 + 2.d0 * dr12 * x) + tmp0_y = tmp_ct2 * (env_val(ipoint) * dy2 + 2.d0 * dr12 * y) + tmp0_z = tmp_ct2 * (env_val(ipoint) * dz2 + 2.d0 * dr12 * z) + + do j = 1, ao_num + do i = 1, ao_num + + tmp4 = tmp0_x * Ir2_Mu_long_Du_x(i,j,ipoint) + tmp0_y * Ir2_Mu_long_Du_y(i,j,ipoint) + tmp0_z * Ir2_Mu_long_Du_z(i,j,ipoint) + + int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1_u12_square_ao(i,j,ipoint) & + + tmp0 * Ir2_Mu_long_Du_0(i,j,ipoint) - tmp4 + tmp1 * Ir2_Mu_long_Du_2(i,j,ipoint) & + - tmp2 * Ir2_Mu_gauss_Du(i,j,ipoint) & + + tmp3 * ao_overlap(i,j) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + FREE Ir2_Mu_long_Du_0 Ir2_Mu_long_Du_x Ir2_Mu_long_Du_y Ir2_Mu_long_Du_z Ir2_Mu_gauss_Du Ir2_Mu_long_Du_2 + + endif ! j1e_type + + ! --- + + else + + write(*, '(A, A, A)') ' Error: The integration type ', trim(tc_integ_type), ' has not been implemented yet' + stop + + endif ! tc_integ_type + + call wall_time(time1) + print*, ' wall time for int2_grad1_u12_square_ao (min) = ', (time1-time0) / 60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + diff --git a/src/non_h_ints_mu/tc_integ_num.irp.f b/plugins/local/non_h_ints_mu/tc_integ_num.irp.f similarity index 99% rename from src/non_h_ints_mu/tc_integ_num.irp.f rename to plugins/local/non_h_ints_mu/tc_integ_num.irp.f index 5a088331..bc31ee91 100644 --- a/src/non_h_ints_mu/tc_integ_num.irp.f +++ b/plugins/local/non_h_ints_mu/tc_integ_num.irp.f @@ -1,4 +1,6 @@ +! --- + BEGIN_PROVIDER [double precision, int2_grad1_u12_ao_num , (ao_num,ao_num,n_points_final_grid,3)] &BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao_num, (ao_num,ao_num,n_points_final_grid) ] diff --git a/src/non_h_ints_mu/test_non_h_ints.irp.f b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f similarity index 75% rename from src/non_h_ints_mu/test_non_h_ints.irp.f rename to plugins/local/non_h_ints_mu/test_non_h_ints.irp.f index 84674fa0..6a30d909 100644 --- a/src/non_h_ints_mu/test_non_h_ints.irp.f +++ b/plugins/local/non_h_ints_mu/test_non_h_ints.irp.f @@ -11,7 +11,7 @@ program test_non_h my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r @@ -20,110 +20,39 @@ program test_non_h endif - !call routine_grad_squared() !call routine_fit() !call test_ipp() - !call test_v_ij_u_cst_mu_j1b_an() + !call test_v_ij_u_cst_mu_env_an() - call test_int2_grad1_u12_square_ao() - call test_int2_grad1_u12_ao() + !call test_int2_grad1_u12_square_ao() + !call test_int2_grad1_u12_ao() + + call test_j1e_grad() end ! --- -subroutine routine_lapl_grad - implicit none - integer :: i,j,k,l - double precision :: grad_lapl, get_ao_tc_sym_two_e_pot,new,accu,contrib - double precision :: ao_two_e_integral_erf,get_ao_two_e_integral,count_n,accu_relat -! !!!!!!!!!!!!!!!!!!!!! WARNING -! THIS ROUTINE MAKES SENSE ONLY IF HAND MODIFIED coef_gauss_eff_pot(1:n_max_fit_slat) = 0. to cancel (1-erf(mu*r12))^2 - accu = 0.d0 - accu_relat = 0.d0 - count_n = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - grad_lapl = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map) ! pure gaussian part : comes from Lapl - grad_lapl += ao_two_e_integral_erf(i, k, j, l) ! erf(mu r12)/r12 : comes from Lapl - grad_lapl += ao_non_hermit_term_chemist(k,i,l,j) ! \grad u(r12) . grad - new = tc_grad_and_lapl_ao(k,i,l,j) - new += get_ao_two_e_integral(i,j,k,l,ao_integrals_map) - contrib = dabs(new - grad_lapl) - if(dabs(grad_lapl).gt.1.d-12)then - count_n += 1.d0 - accu_relat += 2.0d0 * contrib/dabs(grad_lapl+new) - endif - if(contrib.gt.1.d-10)then - print*,i,j,k,l - print*,grad_lapl,new,contrib - print*,2.0d0*contrib/dabs(grad_lapl+new+1.d-12) - endif - accu += contrib - enddo - enddo - enddo - enddo - print*,'accu = ',accu/count_n - print*,'accu/rel = ',accu_relat/count_n - -end - -subroutine routine_grad_squared - implicit none - integer :: i,j,k,l - double precision :: grad_squared, get_ao_tc_sym_two_e_pot,new,accu,contrib - double precision :: count_n,accu_relat -! !!!!!!!!!!!!!!!!!!!!! WARNING -! THIS ROUTINE MAKES SENSE ONLY IF HAND MODIFIED coef_gauss_eff_pot(n_max_fit_slat:n_max_fit_slat+1) = 0. to cancel exp(-'mu*r12)^2) - accu = 0.d0 - accu_relat = 0.d0 - count_n = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - grad_squared = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map) ! pure gaussian part : comes from Lapl - new = tc_grad_square_ao(k,i,l,j) - contrib = dabs(new - grad_squared) - if(dabs(grad_squared).gt.1.d-12)then - count_n += 1.d0 - accu_relat += 2.0d0 * contrib/dabs(grad_squared+new) - endif - if(contrib.gt.1.d-10)then - print*,i,j,k,l - print*,grad_squared,new,contrib - print*,2.0d0*contrib/dabs(grad_squared+new+1.d-12) - endif - accu += contrib - enddo - enddo - enddo - enddo - print*,'accu = ',accu/count_n - print*,'accu/rel = ',accu_relat/count_n - -end - subroutine routine_fit - implicit none - integer :: i,nx - double precision :: dx,xmax,x,j_mu,j_mu_F_x_j,j_mu_fit_gauss - nx = 500 - xmax = 5.d0 - dx = xmax/dble(nx) - x = 0.d0 - print*,'coucou',mu_erf - do i = 1, nx - write(33,'(100(F16.10,X))') x,j_mu(x),j_mu_F_x_j(x),j_mu_fit_gauss(x) - x += dx - enddo + + implicit none + integer :: i,nx + double precision :: dx,xmax,x,j_mu,j_mu_F_x_j,j_mu_fit_gauss + + nx = 500 + xmax = 5.d0 + dx = xmax/dble(nx) + x = 0.d0 + print*,'coucou',mu_erf + do i = 1, nx + write(33,'(100(F16.10,X))') x,j_mu(x),j_mu_F_x_j(x),j_mu_fit_gauss(x) + x += dx + enddo end +! --- subroutine test_ipp() @@ -145,7 +74,7 @@ subroutine test_ipp() allocate(I1(ao_num,ao_num,ao_num,ao_num)) I1 = 0.d0 - PROVIDE u12_grad1_u12_j1b_grad1_j1b + PROVIDE u12_grad1_u12_env_grad1_env !$OMP PARALLEL & !$OMP DEFAULT (NONE) & @@ -163,7 +92,7 @@ subroutine test_ipp() !$OMP END PARALLEL call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , u12_grad1_u12_j1b_grad1_j1b(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & + , u12_grad1_u12_env_grad1_env(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & , 0.d0, I1, ao_num*ao_num) ! --- @@ -173,14 +102,14 @@ subroutine test_ipp() allocate(I2(ao_num,ao_num,ao_num,ao_num)) I2 = 0.d0 - PROVIDE int2_u2_j1b2 + PROVIDE int2_u2_env2 b_mat = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & !$OMP SHARED (aos_in_r_array_transp, b_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & - !$OMP v_1b_square_grad, v_1b_square_lapl, aos_grad_in_r_array_transp_bis) + !$OMP env_square_grad, env_square_lapl, aos_grad_in_r_array_transp_bis) !$OMP DO SCHEDULE (static) do i = 1, ao_num do k = 1, ao_num @@ -191,10 +120,10 @@ subroutine test_ipp() ao_i_r = aos_in_r_array_transp(ipoint,i) ao_k_r = aos_in_r_array_transp(ipoint,k) - b_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * v_1b_square_lapl(ipoint) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * v_1b_square_grad(ipoint,1) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * v_1b_square_grad(ipoint,2) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * v_1b_square_grad(ipoint,3) ) + b_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * env_square_lapl(ipoint) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) enddo enddo enddo @@ -202,7 +131,7 @@ subroutine test_ipp() !$OMP END PARALLEL call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_u2_j1b2(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & + , int2_u2_env2(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & , 0.d0, I2, ao_num*ao_num) ! --- @@ -268,7 +197,7 @@ subroutine I_grade_gradu_naive1(i, j, k, l, int) double precision :: weight2_x, weight2_y, weight2_z double precision :: aor_i, aor_j, aor_k, aor_l double precision :: e1_val, e2_val, e1_der(3), u12_val, u12_der(3) - double precision, external :: j1b_nucl, j12_mu + double precision, external :: env_nucl, j12_mu int = 0.d0 @@ -281,8 +210,8 @@ subroutine I_grade_gradu_naive1(i, j, k, l, int) aor_i = aos_in_r_array_transp(ipoint,i) aor_k = aos_in_r_array_transp(ipoint,k) - e1_val = j1b_nucl(r1) - call grad1_j1b_nucl(r1, e1_der) + e1_val = env_nucl(r1) + call grad1_env_nucl(r1, e1_der) weight1_x = aor_i * aor_k * e1_val * final_weight_at_r_vector(ipoint) * e1_der(1) weight1_y = aor_i * aor_k * e1_val * final_weight_at_r_vector(ipoint) * e1_der(2) @@ -297,7 +226,7 @@ subroutine I_grade_gradu_naive1(i, j, k, l, int) aor_j = aos_in_r_array_extra_transp(jpoint,j) aor_l = aos_in_r_array_extra_transp(jpoint,l) - e2_val = j1b_nucl(r2) + e2_val = env_nucl(r2) u12_val = j12_mu(r1, r2) call grad1_j12_mu(r1, r2, u12_der) @@ -326,7 +255,7 @@ subroutine I_grade_gradu_naive2(i, j, k, l, int) double precision :: weight2_x, weight2_y, weight2_z double precision :: aor_i, aor_j, aor_k, aor_l double precision :: e1_square_der(3), e2_val, u12_square_der(3) - double precision, external :: j1b_nucl + double precision, external :: env_nucl int = 0.d0 @@ -339,7 +268,7 @@ subroutine I_grade_gradu_naive2(i, j, k, l, int) aor_i = aos_in_r_array_transp(ipoint,i) aor_k = aos_in_r_array_transp(ipoint,k) - call grad1_j1b_nucl_square_num(r1, e1_square_der) + call grad1_env_nucl_square_num(r1, e1_square_der) weight1_x = aor_i * aor_k * final_weight_at_r_vector(ipoint) * e1_square_der(1) weight1_y = aor_i * aor_k * final_weight_at_r_vector(ipoint) * e1_square_der(2) @@ -354,7 +283,7 @@ subroutine I_grade_gradu_naive2(i, j, k, l, int) aor_j = aos_in_r_array_extra_transp(jpoint,j) aor_l = aos_in_r_array_extra_transp(jpoint,l) - e2_val = j1b_nucl(r2) + e2_val = env_nucl(r2) call grad1_j12_mu_square_num(r1, r2, u12_square_der) weight2_x = aor_j * aor_l * e2_val * e2_val * final_weight_at_r_vector_extra(jpoint) * u12_square_der(1) @@ -380,7 +309,7 @@ subroutine I_grade_gradu_naive3(i, j, k, l, int) double precision :: weight1, weight2 double precision :: aor_j, aor_l double precision :: grad(3), e2_val, u12_val - double precision, external :: j1b_nucl, j12_mu + double precision, external :: env_nucl, j12_mu int = 0.d0 @@ -403,7 +332,7 @@ subroutine I_grade_gradu_naive3(i, j, k, l, int) aor_j = aos_in_r_array_extra_transp(jpoint,j) aor_l = aos_in_r_array_extra_transp(jpoint,l) - e2_val = j1b_nucl(r2) + e2_val = env_nucl(r2) u12_val = j12_mu(r1, r2) weight2 = aor_j * aor_l * e2_val * e2_val * u12_val * u12_val * final_weight_at_r_vector_extra(jpoint) @@ -427,7 +356,7 @@ subroutine I_grade_gradu_naive4(i, j, k, l, int) double precision :: weight1, weight2 double precision :: aor_j, aor_l, aor_k, aor_i double precision :: grad(3), e2_val, u12_val - double precision, external :: j1b_nucl, j12_mu + double precision, external :: env_nucl, j12_mu int = 0.d0 @@ -440,10 +369,10 @@ subroutine I_grade_gradu_naive4(i, j, k, l, int) aor_i = aos_in_r_array_transp(ipoint,i) aor_k = aos_in_r_array_transp(ipoint,k) - weight1 = final_weight_at_r_vector(ipoint) * ( aor_k * aor_i * v_1b_square_lapl(ipoint) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,1) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * v_1b_square_grad(ipoint,1) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,2) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * v_1b_square_grad(ipoint,2) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,3) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * v_1b_square_grad(ipoint,3) ) + weight1 = final_weight_at_r_vector(ipoint) * ( aor_k * aor_i * env_square_lapl(ipoint) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,1) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,2) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,3) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) do jpoint = 1, n_points_extra_final_grid ! r2 @@ -454,7 +383,7 @@ subroutine I_grade_gradu_naive4(i, j, k, l, int) aor_j = aos_in_r_array_extra_transp(jpoint,j) aor_l = aos_in_r_array_extra_transp(jpoint,l) - e2_val = j1b_nucl(r2) + e2_val = env_nucl(r2) u12_val = j12_mu(r1, r2) weight2 = aor_j * aor_l * e2_val * e2_val * u12_val * u12_val * final_weight_at_r_vector_extra(jpoint) @@ -464,7 +393,7 @@ subroutine I_grade_gradu_naive4(i, j, k, l, int) enddo return -end subroutine I_grade_gradu_naive4 +end ! --- @@ -485,16 +414,16 @@ subroutine I_grade_gradu_seminaive(i, j, k, l, int) aor_i = aos_in_r_array_transp(ipoint,i) aor_k = aos_in_r_array_transp(ipoint,k) - weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) * ( aor_k * aor_i * v_1b_square_lapl(ipoint) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,1) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * v_1b_square_grad(ipoint,1) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,2) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * v_1b_square_grad(ipoint,2) & - + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,3) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * v_1b_square_grad(ipoint,3) ) + weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) * ( aor_k * aor_i * env_square_lapl(ipoint) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,1) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,2) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (aor_k * aos_grad_in_r_array_transp_bis(ipoint,i,3) + aor_i * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) - int = int + weight1 * int2_u2_j1b2(j,l,ipoint) + int = int + weight1 * int2_u2_env2(j,l,ipoint) enddo return -end subroutine I_grade_gradu_seminaive +end ! --- @@ -508,7 +437,7 @@ subroutine aos_ik_grad1_esquare(i, k, r1, val) double precision :: der(3), aos_array(ao_num), aos_grad_array(3,ao_num) call give_all_aos_and_grad_at_r(r1, aos_array, aos_grad_array) - call grad1_j1b_nucl_square_num(r1, der) + call grad1_env_nucl_square_num(r1, der) tmp = aos_array(i) * aos_array(k) val(1) = tmp * der(1) @@ -559,14 +488,14 @@ end subroutine grad1_aos_ik_grad1_esquare ! --- -subroutine test_v_ij_u_cst_mu_j1b_an() +subroutine test_v_ij_u_cst_mu_env_an() implicit none integer :: i, j, ipoint double precision :: I_old, I_new double precision :: norm, accu, thr, diff - PROVIDE v_ij_u_cst_mu_j1b_an_old v_ij_u_cst_mu_j1b_an + PROVIDE v_ij_u_cst_mu_env_an_old v_ij_u_cst_mu_env_an thr = 1d-12 norm = 0.d0 @@ -575,8 +504,8 @@ subroutine test_v_ij_u_cst_mu_j1b_an() do i = 1, ao_num do j = 1, ao_num - I_old = v_ij_u_cst_mu_j1b_an_old(j,i,ipoint) - I_new = v_ij_u_cst_mu_j1b_an (j,i,ipoint) + I_old = v_ij_u_cst_mu_env_an_old(j,i,ipoint) + I_new = v_ij_u_cst_mu_env_an (j,i,ipoint) diff = dabs(I_new-I_old) if(diff .gt. thr) then @@ -595,7 +524,7 @@ subroutine test_v_ij_u_cst_mu_j1b_an() print*, ' accuracy(%) = ', 100.d0 * accu / norm return -end subroutine test_v_ij_u_cst_mu_j1b_an +end ! --- @@ -637,7 +566,7 @@ subroutine test_int2_grad1_u12_square_ao() print*, ' accuracy(%) = ', 100.d0 * accu / norm return -end subroutine test_int2_grad1_u12_square_ao +end ! --- @@ -681,7 +610,108 @@ subroutine test_int2_grad1_u12_ao() print*, ' accuracy(%) = ', 100.d0 * accu / norm return -end subroutine test_int2_grad1_u12_ao +end + +! --- + +subroutine test_j1e_grad() + + implicit none + integer :: i, j, ipoint + double precision :: g + double precision :: x_loops, x_dgemm, diff, thr, accu, norm + double precision, allocatable :: pa(:,:), Pb(:,:), Pt(:,:) + double precision, allocatable :: x(:), y(:), z(:) + + PROVIDE int2_grad1_u2b_ao + PROVIDE mo_coef + + allocate(Pa(ao_num,ao_num), Pb(ao_num,ao_num), Pt(ao_num,ao_num)) + + call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pa, size(Pa, 1)) + + if(elec_alpha_num .eq. elec_beta_num) then + Pb = Pa + else + call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0 & + , mo_coef, size(mo_coef, 1), mo_coef, size(mo_coef, 1) & + , 0.d0, Pb, size(Pb, 1)) + endif + Pt = Pa + Pa + + + g = 0.5d0 * (dble(elec_num) - 1.d0) / dble(elec_num) + + allocate(x(n_points_final_grid), y(n_points_final_grid), z(n_points_final_grid)) + + do ipoint = 1, n_points_final_grid + x(ipoint) = 0.d0 + y(ipoint) = 0.d0 + z(ipoint) = 0.d0 + do i = 1, ao_num + do j = 1, ao_num + x(ipoint) = x(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,1) + y(ipoint) = y(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,2) + z(ipoint) = z(ipoint) + g * Pt(i,j) * int2_grad1_u2b_ao(i,j,ipoint,3) + enddo + enddo + enddo + + deallocate(Pa, Pb, Pt) + + ! --- + + thr = 1d-10 + norm = 0.d0 + accu = 0.d0 + do ipoint = 1, n_points_final_grid + + x_loops = x (ipoint) + x_dgemm = j1e_gradx(ipoint) + diff = dabs(x_loops - x_dgemm) + if(diff .gt. thr) then + print *, ' problem in j1e_gradx on:', ipoint + print *, ' loops :', x_loops + print *, ' dgemm :', x_dgemm + stop + endif + accu += diff + norm += dabs(x_loops) + + x_loops = y (ipoint) + x_dgemm = j1e_grady(ipoint) + diff = dabs(x_loops - x_dgemm) + if(diff .gt. thr) then + print *, ' problem in j1e_grady on:', ipoint + print *, ' loops :', x_loops + print *, ' dgemm :', x_dgemm + stop + endif + accu += diff + norm += dabs(x_loops) + + x_loops = z (ipoint) + x_dgemm = j1e_gradz(ipoint) + diff = dabs(x_loops - x_dgemm) + if(diff .gt. thr) then + print *, ' problem in j1e_gradz on:', ipoint + print *, ' loops :', x_loops + print *, ' dgemm :', x_dgemm + stop + endif + accu += diff + norm += dabs(x_loops) + + enddo + + deallocate(x, y, z) + + print*, ' accuracy(%) = ', 100.d0 * accu / norm + + return +end ! --- diff --git a/plugins/local/non_h_ints_mu/total_tc_int.irp.f b/plugins/local/non_h_ints_mu/total_tc_int.irp.f new file mode 100644 index 00000000..59f5174b --- /dev/null +++ b/plugins/local/non_h_ints_mu/total_tc_int.irp.f @@ -0,0 +1,223 @@ + +! --- + +BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num)] + + BEGIN_DOC + ! + ! CHEMIST NOTATION IS USED + ! + ! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) + ! = where V^TC(r_12) is the total TC operator + ! = tc_grad_and_lapl_ao(k,i,l,j) + tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) + ! AND IF(var_tc): + ! + ! ao_two_e_tot(k,i,l,j) = (ki|V^TC(r_12) + [(V^TC)(r_12)]^\dagger|lj) / 2.0 + ! = tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) + ! + ! + ! where: + ! + ! tc_grad_and_lapl_ao(k,i,l,j) = < k l | -1/2 \Delta_1 u(r1,r2) - \grad_1 u(r1,r2) . \grad_1 | ij > + ! = -1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) + ! = 1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 (-1) \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) + ! + ! tc_grad_square_ao(k,i,l,j) = -1/2 + ! + ! ao_two_e_coul(k,i,l,j) = < l k | 1/r12 | j i > = ( k i | 1/r12 | l j ) + ! + END_DOC + + implicit none + integer :: i, j, k, l, m, ipoint + double precision :: weight1, ao_k_r, ao_i_r + double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq + double precision :: time0, time1 + double precision, allocatable :: b_mat(:,:,:,:), c_mat(:,:,:) + double precision, external :: get_ao_two_e_integral + + PROVIDe tc_integ_type + PROVIDE env_type + PROVIDE j2e_type + PROVIDE j1e_type + + call wall_time(time0) + + print *, ' providing ao_two_e_tc_tot ...' + print*, ' j2e_type: ', j2e_type + print*, ' j1e_type: ', j1e_type + print*, ' env_type: ', env_type + + if(read_tc_integ) then + + print*, ' Reading ao_two_e_tc_tot from ', trim(ezfio_filename) // '/work/ao_two_e_tc_tot' + + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/ao_two_e_tc_tot', action="read") + read(11) ao_two_e_tc_tot + close(11) + + else + + PROVIDE tc_integ_type + print*, ' approach for integrals: ', tc_integ_type + + ! --- + + PROVIDE int2_grad1_u12_square_ao + + allocate(c_mat(n_points_final_grid,ao_num,ao_num)) + + c_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + c_mat(ipoint,k,i) = final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,k) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_grad1_u12_square_ao(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 0.d0, ao_two_e_tc_tot, ao_num*ao_num) + + FREE int2_grad1_u12_square_ao + + if( (tc_integ_type .eq. "semi-analytic") .and. & + (j2e_type .eq. "Mu") .and. & + ((env_type .eq. "Prod_Gauss") .or. (env_type .eq. "Sum_Gauss")) .and. & + use_ipp ) then + + ! an additional term is added here directly instead of + ! being added in int2_grad1_u12_square_ao for performance + + PROVIDE int2_u2_env2 + + c_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, c_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & + !$OMP env_square_grad, env_square_lapl, aos_grad_in_r_array_transp_bis) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) + + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + c_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * env_square_lapl(ipoint) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * env_square_grad(ipoint,1) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * env_square_grad(ipoint,2) & + + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * env_square_grad(ipoint,3) ) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_u2_env2(1,1,1), ao_num*ao_num, c_mat(1,1,1), n_points_final_grid & + , 1.d0, ao_two_e_tc_tot, ao_num*ao_num) + + FREE int2_u2_env2 + endif ! use_ipp + + deallocate(c_mat) + + ! --- + + if(.not. var_tc) then + + PROVIDE int2_grad1_u12_ao + + allocate(b_mat(n_points_final_grid,ao_num,ao_num,3)) + + b_mat = 0.d0 + !$OMP PARALLEL & + !$OMP DEFAULT (NONE) & + !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & + !$OMP SHARED (aos_in_r_array_transp, aos_grad_in_r_array_transp_bis, b_mat, & + !$OMP ao_num, n_points_final_grid, final_weight_at_r_vector) + !$OMP DO SCHEDULE (static) + do i = 1, ao_num + do k = 1, ao_num + do ipoint = 1, n_points_final_grid + + weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) + ao_i_r = aos_in_r_array_transp(ipoint,i) + ao_k_r = aos_in_r_array_transp(ipoint,k) + + b_mat(ipoint,k,i,1) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) + b_mat(ipoint,k,i,2) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) + b_mat(ipoint,k,i,3) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + do m = 1, 3 + call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & + , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, b_mat(1,1,1,m), n_points_final_grid & + , 1.d0, ao_two_e_tc_tot, ao_num*ao_num) + enddo + deallocate(b_mat) + + endif ! var_tc + + ! --- + + call sum_A_At(ao_two_e_tc_tot(1,1,1,1), ao_num*ao_num) + + PROVIDE ao_integrals_map + + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP SHARED(ao_num, ao_two_e_tc_tot, ao_integrals_map) & + !$OMP PRIVATE(i, j, k, l) + !$OMP DO + do j = 1, ao_num + do l = 1, ao_num + do i = 1, ao_num + do k = 1, ao_num + ! < 1:i, 2:j | 1:k, 2:l > + ao_two_e_tc_tot(k,i,l,j) = ao_two_e_tc_tot(k,i,l,j) + get_ao_two_e_integral(i, j, k, l, ao_integrals_map) + enddo + enddo + enddo + enddo + !$OMP END DO + !$OMP END PARALLEL + + if(tc_integ_type .eq. "numeric") then + FREE int2_grad1_u12_ao_num int2_grad1_u12_square_ao_num + endif + + endif ! read_tc_integ + + if(write_tc_integ .and. mpi_master) then + print*, ' Saving ao_two_e_tc_tot in ', trim(ezfio_filename) // '/work/ao_two_e_tc_tot' + open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/ao_two_e_tc_tot', action="write") + call ezfio_set_work_empty(.False.) + write(11) ao_two_e_tc_tot + close(11) + call ezfio_set_tc_keywords_io_tc_integ('Read') + endif + + call wall_time(time1) + print*, ' Wall time for ao_two_e_tc_tot (min) = ', (time1 - time0) / 60.d0 + call print_memory_usage() + +END_PROVIDER + +! --- + diff --git a/src/non_hermit_dav/NEED b/plugins/local/non_hermit_dav/NEED similarity index 100% rename from src/non_hermit_dav/NEED rename to plugins/local/non_hermit_dav/NEED diff --git a/src/non_hermit_dav/biorthog.irp.f b/plugins/local/non_hermit_dav/biorthog.irp.f similarity index 96% rename from src/non_hermit_dav/biorthog.irp.f rename to plugins/local/non_hermit_dav/biorthog.irp.f index 13917c5a..ab12150f 100644 --- a/src/non_hermit_dav/biorthog.irp.f +++ b/plugins/local/non_hermit_dav/biorthog.irp.f @@ -275,10 +275,11 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei double precision :: thr, thr_cut, thr_diag, thr_norm double precision :: accu_d, accu_nd - integer, allocatable :: list_good(:), iorder(:) + integer, allocatable :: list_good(:), iorder(:), deg_num(:) double precision, allocatable :: WR(:), WI(:), VL(:,:), VR(:,:) double precision, allocatable :: S(:,:) double precision, allocatable :: phi_1_tilde(:),phi_2_tilde(:),chi_1_tilde(:),chi_2_tilde(:) + allocate(phi_1_tilde(n),phi_2_tilde(n),chi_1_tilde(n),chi_2_tilde(n)) @@ -305,11 +306,11 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei - print *, ' ' - print *, ' eigenvalues' + !print *, ' ' + !print *, ' eigenvalues' i = 1 do while(i .le. n) - write(*, '(I3,X,1000(F16.10,X))')i, WR(i), WI(i) + !write(*, '(I3,X,1000(F16.10,X))')i, WR(i), WI(i) if(.false.)then if(WI(i).ne.0.d0)then print*,'*****************' @@ -386,7 +387,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei thr_diag = 1d-06 thr_norm = 1d+10 - call check_EIGVEC(n, n, A, WR, VL, VR, thr_diag, thr_norm, .false.) + !call check_EIGVEC(n, n, A, WR, VL, VR, thr_diag, thr_norm, .false.) ! ! ------------------------------------------------------------------------------------- @@ -400,7 +401,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei !thr = 100d0 thr = Im_thresh_tcscf do i = 1, n - print*, 'Re(i) + Im(i)', WR(i), WI(i) + !print*, 'Re(i) + Im(i)', WR(i), WI(i) if(dabs(WI(i)) .lt. thr) then n_good += 1 else @@ -479,15 +480,16 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei return ! accu_nd is modified after adding the normalization - !elseif( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .gt. thr_d) ) then + elseif( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .gt. thr_d) ) then - ! print *, ' lapack vectors are not normalized but bi-orthogonalized' - ! call check_biorthog_binormalize(n, n_real_eigv, leigvec, reigvec, thr_d, thr_nd, .true.) + print *, ' lapack vectors are not normalized but bi-orthogonalized' + call check_biorthog_binormalize(n, n_real_eigv, leigvec, reigvec, thr_d, thr_nd, .true.) - ! call check_EIGVEC(n, n, A, eigval, leigvec, reigvec, thr_diag, thr_norm, .true.) + call check_biorthog(n, n_real_eigv, leigvec, reigvec, accu_d, accu_nd, S, thr_d, thr_nd, .true.) + call check_EIGVEC(n, n, A, eigval, leigvec, reigvec, thr_diag, thr_norm, .true.) - ! deallocate(S) - ! return + deallocate(S) + return else @@ -495,18 +497,10 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei ! --- -! call impose_orthog_degen_eigvec(n, eigval, reigvec) -! call impose_orthog_degen_eigvec(n, eigval, leigvec) - - call reorder_degen_eigvec(n, eigval, leigvec, reigvec) - call impose_biorthog_degen_eigvec(n, eigval, leigvec, reigvec) - - - !call impose_orthog_biorthog_degen_eigvec(n, thr_d, thr_nd, eigval, leigvec, reigvec) - - !call impose_unique_biorthog_degen_eigvec(n, eigval, mo_coef, ao_overlap, leigvec, reigvec) - - ! --- + allocate(deg_num(n)) + call reorder_degen_eigvec(n, deg_num, eigval, leigvec, reigvec) + call impose_biorthog_degen_eigvec(n, deg_num, eigval, leigvec, reigvec) + deallocate(deg_num) call check_biorthog(n, n_real_eigv, leigvec, reigvec, accu_d, accu_nd, S, thr_d, thr_nd, .false.) if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv)) .gt. thr_d) ) then @@ -514,12 +508,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei endif call check_biorthog(n, n_real_eigv, leigvec, reigvec, accu_d, accu_nd, S, thr_d, thr_nd, .true.) - !call impose_biorthog_qr(n, n_real_eigv, thr_d, thr_nd, leigvec, reigvec) - !call impose_biorthog_lu(n, n_real_eigv, thr_d, thr_nd, leigvec, reigvec) - - ! --- - - call check_EIGVEC(n, n, A, eigval, leigvec, reigvec, thr_diag, thr_norm, .true.) + !call check_EIGVEC(n, n, A, eigval, leigvec, reigvec, thr_diag, thr_norm, .true.) deallocate(S) diff --git a/src/non_hermit_dav/gram_schmit.irp.f b/plugins/local/non_hermit_dav/gram_schmit.irp.f similarity index 100% rename from src/non_hermit_dav/gram_schmit.irp.f rename to plugins/local/non_hermit_dav/gram_schmit.irp.f diff --git a/src/non_hermit_dav/htilde_mat.irp.f b/plugins/local/non_hermit_dav/htilde_mat.irp.f similarity index 100% rename from src/non_hermit_dav/htilde_mat.irp.f rename to plugins/local/non_hermit_dav/htilde_mat.irp.f diff --git a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f similarity index 94% rename from src/non_hermit_dav/lapack_diag_non_hermit.irp.f rename to plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f index 836bf707..4d51b79e 100644 --- a/src/non_hermit_dav/lapack_diag_non_hermit.irp.f +++ b/plugins/local/non_hermit_dav/lapack_diag_non_hermit.irp.f @@ -1865,10 +1865,11 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ , Vl, size(Vl, 1), Vr, size(Vr, 1) & , 0.d0, S, size(S, 1) ) - print *, ' overlap matrix:' - do i = 1, m - write(*,'(1000(F16.10,X))') S(i,:) - enddo + ! print S s'il y a besoin + !print *, ' overlap matrix:' + !do i = 1, m + ! write(*,'(1000(F16.10,X))') S(i,:) + !enddo accu_d = 0.d0 accu_nd = 0.d0 @@ -1876,15 +1877,22 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_ do j = 1, m if(i==j) then accu_d = accu_d + dabs(S(i,i)) + !print*, i, S(i,i) else accu_nd = accu_nd + S(j,i) * S(j,i) endif enddo enddo + !accu_nd = dsqrt(accu_nd) / dble(m*m) accu_nd = dsqrt(accu_nd) / dble(m) - print *, ' accu_nd = ', accu_nd - print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m) + if((accu_nd .gt. thr_nd) .or. dabs(accu_d-dble(m))/dble(m) .gt. thr_d) then + print *, ' non bi-orthogonal vectors !' + print *, ' accu_nd = ', accu_nd + print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m) + else + print *, ' vectors are bi-orthogonals' + endif ! --- @@ -1944,24 +1952,22 @@ subroutine check_orthog(n, m, V, accu_d, accu_nd, S) end subroutine check_orthog ! --- -subroutine reorder_degen_eigvec(n, e0, L0, R0) + +subroutine reorder_degen_eigvec(n, deg_num, e0, L0, R0) implicit none integer, intent(in) :: n - double precision, intent(in) :: e0(n) - double precision, intent(inout) :: L0(n,n), R0(n,n) + double precision, intent(inout) :: e0(n), L0(n,n), R0(n,n) + integer, intent(out) :: deg_num(n) logical :: complex_root - integer :: i, j, k, m + integer :: i, j, k, m, ii, j_tmp double precision :: ei, ej, de, de_thr double precision :: accu_d, accu_nd - integer, allocatable :: deg_num(:) + double precision :: e0_tmp, L0_tmp(n), R0_tmp(n) double precision, allocatable :: L(:,:), R(:,:), S(:,:), S_inv_half(:,:) - ! --- - - allocate( deg_num(n) ) do i = 1, n deg_num(i) = 1 enddo @@ -1972,74 +1978,104 @@ subroutine reorder_degen_eigvec(n, e0, L0, R0) ei = e0(i) ! already considered in degen vectors - if(deg_num(i).eq.0) cycle + if(deg_num(i) .eq. 0) cycle + ii = 0 do j = i+1, n ej = e0(j) de = dabs(ei - ej) if(de .lt. de_thr) then - deg_num(i) = deg_num(i) + 1 - deg_num(j) = 0 - endif + ii = ii + 1 + + j_tmp = i + ii + deg_num(j_tmp) = 0 + + e0_tmp = e0(j_tmp) + e0(j_tmp) = e0(j) + e0(j) = e0_tmp + + L0_tmp(1:n) = L0(1:n,j_tmp) + L0(1:n,j_tmp) = L0(1:n,j) + L0(1:n,j) = L0_tmp(1:n) + + R0_tmp(1:n) = R0(1:n,j_tmp) + R0(1:n,j_tmp) = R0(1:n,j) + R0(1:n,j) = R0_tmp(1:n) + endif enddo + + deg_num(i) = ii + 1 enddo + ii = 0 do i = 1, n if(deg_num(i) .gt. 1) then - print *, ' degen on', i, deg_num(i), e0(i) + !print *, ' degen on', i, deg_num(i), e0(i) + ii = ii + 1 endif enddo + if(ii .eq. 0) then + print*, ' WARNING: bi-orthogonality is lost but there is no degeneracies' + print*, ' rotations may change energy' + stop + endif + + print *, ii, ' type of degeneracies' + ! --- - do i = 1, n - m = deg_num(i) - - if(m .gt. 1) then - - allocate(L(n,m)) - allocate(R(n,m),S(m,m)) - - do j = 1, m - L(1:n,j) = L0(1:n,i+j-1) - R(1:n,j) = R0(1:n,i+j-1) - enddo - - call dgemm( 'T', 'N', m, m, n, 1.d0 & - , L, size(L, 1), R, size(R, 1) & - , 0.d0, S, size(S, 1) ) - print*,'Overlap matrix ' - accu_nd = 0.D0 - do j = 1, m - write(*,'(100(F16.10,X))')S(1:m,j) - do k = 1, m - if(j==k)cycle - accu_nd += dabs(S(j,k)) - enddo - enddo - print*,'accu_nd = ',accu_nd -! if(accu_nd .gt.1.d-10)then -! stop -! endif - do j = 1, m - L0(1:n,i+j-1) = L(1:n,j) - R0(1:n,i+j-1) = R(1:n,j) - enddo - - deallocate(L, R,S) - - endif - enddo - +! do i = 1, n +! m = deg_num(i) +! +! if(m .gt. 1) then +! +! allocate(L(n,m)) +! allocate(R(n,m),S(m,m)) +! +! do j = 1, m +! L(1:n,j) = L0(1:n,i+j-1) +! R(1:n,j) = R0(1:n,i+j-1) +! enddo +! +! !call dgemm( 'T', 'N', m, m, n, 1.d0 & +! ! , L, size(L, 1), R, size(R, 1) & +! ! , 0.d0, S, size(S, 1) ) +! !print*, 'Overlap matrix ' +! !accu_nd = 0.d0 +! !do j = 1, m +! ! write(*,'(100(F16.10,X))') S(1:m,j) +! ! do k = 1, m +! ! if(j==k) cycle +! ! accu_nd += dabs(S(j,k)) +! ! enddo +! !enddo +! !print*,'accu_nd = ',accu_nd +!! if(accu_nd .gt.1.d-10) then +!! stop +!! endif +! +! do j = 1, m +! L0(1:n,i+j-1) = L(1:n,j) +! R0(1:n,i+j-1) = R(1:n,j) +! enddo +! +! deallocate(L, R, S) +! +! endif +! enddo +! end subroutine reorder_degen_eigvec -subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) +! --- + +subroutine impose_biorthog_degen_eigvec(n, deg_num, e0, L0, R0) implicit none - integer, intent(in) :: n + integer, intent(in) :: n, deg_num(n) double precision, intent(in) :: e0(n) double precision, intent(inout) :: L0(n,n), R0(n,n) @@ -2047,41 +2083,13 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) integer :: i, j, k, m double precision :: ei, ej, de, de_thr double precision :: accu_d, accu_nd - integer, allocatable :: deg_num(:) double precision, allocatable :: L(:,:), R(:,:), S(:,:), S_inv_half(:,:) - ! --- - - allocate( deg_num(n) ) - do i = 1, n - deg_num(i) = 1 - enddo - - de_thr = thr_degen_tc - - do i = 1, n-1 - ei = e0(i) - - ! already considered in degen vectors - if(deg_num(i).eq.0) cycle - - do j = i+1, n - ej = e0(j) - de = dabs(ei - ej) - - if(de .lt. de_thr) then - deg_num(i) = deg_num(i) + 1 - deg_num(j) = 0 - endif - - enddo - enddo - - do i = 1, n - if(deg_num(i) .gt. 1) then - print *, ' degen on', i, deg_num(i), e0(i) - endif - enddo + !do i = 1, n + ! if(deg_num(i) .gt. 1) then + ! print *, ' degen on', i, deg_num(i), e0(i) + ! endif + !enddo ! --- @@ -2090,8 +2098,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) if(m .gt. 1) then - allocate(L(n,m)) - allocate(R(n,m)) + allocate(L(n,m), R(n,m), S(m,m)) do j = 1, m L(1:n,j) = L0(1:n,i+j-1) @@ -2100,8 +2107,53 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) ! --- -! call impose_orthog_svd(n, m, L) - call impose_orthog_svd(n, m, R) + !print*, 'Overlap matrix before' + call dgemm( 'T', 'N', m, m, n, 1.d0 & + , L, size(L, 1), R, size(R, 1) & + , 0.d0, S, size(S, 1) ) + + accu_nd = 0.d0 + do j = 1, m + !write(*,'(100(F16.10,X))') S(1:m,j) + do k = 1, m + if(j==k) cycle + accu_nd += dabs(S(j,k)) + enddo + enddo + + if(accu_nd .lt. 1d-12) then + deallocate(S, L, R) + cycle + endif + + !print*, ' accu_nd before = ', accu_nd + + call impose_biorthog_svd(n, m, L, R) + + !print*, 'Overlap matrix after' + call dgemm( 'T', 'N', m, m, n, 1.d0 & + , L, size(L, 1), R, size(R, 1) & + , 0.d0, S, size(S, 1) ) + accu_nd = 0.d0 + do j = 1, m + !write(*,'(100(F16.10,X))') S(1:m,j) + do k = 1, m + if(j==k) cycle + accu_nd += dabs(S(j,k)) + enddo + enddo + !print*,' accu_nd after = ', accu_nd + if(accu_nd .gt. 1d-12) then + print*, ' your strategy for degenerates orbitals failed !' + print*, m, 'deg on', i + stop + endif + + deallocate(S) + + ! --- + + !call impose_orthog_svd(n, m, L) !call impose_orthog_GramSchmidt(n, m, L) !call impose_orthog_GramSchmidt(n, m, R) @@ -2120,8 +2172,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) !call bi_ortho_s_inv_half(m, L, R, S_inv_half) !deallocate(S, S_inv_half) - call impose_biorthog_svd(n, m, L, R) -! call impose_biorthog_inverse(n, m, L, R) + !call impose_biorthog_inverse(n, m, L, R) !call impose_biorthog_qr(n, m, thr_d, thr_nd, L, R) @@ -2136,7 +2187,6 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0) endif enddo -! call impose_biorthog_inverse(n, n, L0, R0) end subroutine impose_biorthog_degen_eigvec @@ -2504,18 +2554,16 @@ subroutine impose_biorthog_svd(n, m, L, R) double precision, allocatable :: S(:,:), tmp(:,:) double precision, allocatable :: U(:,:), V(:,:), Vt(:,:), D(:) - ! --- - allocate(S(m,m)) call dgemm( 'T', 'N', m, m, n, 1.d0 & , L, size(L, 1), R, size(R, 1) & , 0.d0, S, size(S, 1) ) - print *, ' overlap bef SVD: ' - do i = 1, m - write(*, '(1000(F16.10,X))') S(i,:) - enddo + !print *, ' overlap bef SVD: ' + !do i = 1, m + ! write(*, '(1000(F16.10,X))') S(i,:) + !enddo ! --- @@ -2552,52 +2600,33 @@ subroutine impose_biorthog_svd(n, m, L, R) ! --- - allocate(tmp(n,m)) + ! R <-- R x V x D^{-0.5} + ! L <-- L x U x D^{-0.5} - ! tmp <-- R x V - call dgemm( 'N', 'N', n, m, m, 1.d0 & - , R, size(R, 1), V, size(V, 1) & - , 0.d0, tmp, size(tmp, 1) ) - deallocate(V) - ! R <-- tmp x sigma^-0.5 - do j = 1, m - do i = 1, n - R(i,j) = tmp(i,j) * D(j) - enddo - enddo - - ! tmp <-- L x U - call dgemm( 'N', 'N', n, m, m, 1.d0 & - , L, size(L, 1), U, size(U, 1) & - , 0.d0, tmp, size(tmp, 1) ) - deallocate(U) - ! L <-- tmp x sigma^-0.5 - do j = 1, m - do i = 1, n - L(i,j) = tmp(i,j) * D(j) - enddo - enddo - - deallocate(D, tmp) - - ! --- - - allocate(S(m,m)) - call dgemm( 'T', 'N', m, m, n, 1.d0 & - , L, size(L, 1), R, size(R, 1) & - , 0.d0, S, size(S, 1) ) - - print *, ' overlap aft SVD: ' do i = 1, m - write(*, '(1000(F16.10,X))') S(i,:) + do j = 1, m + V(j,i) = V(j,i) * D(i) + U(j,i) = U(j,i) * D(i) + enddo enddo - deallocate(S) + allocate(tmp(n,m)) + tmp(:,:) = R(:,:) + call dgemm( 'N', 'N', n, m, m, 1.d0 & + , tmp, size(tmp, 1), V, size(V, 1) & + , 0.d0, R, size(R, 1)) - ! --- + tmp(:,:) = L(:,:) + call dgemm( 'N', 'N', n, m, m, 1.d0 & + , tmp, size(tmp, 1), U, size(U, 1) & + , 0.d0, L, size(L, 1)) + + deallocate(tmp, U, V, D) end subroutine impose_biorthog_svd +! --- + subroutine impose_biorthog_inverse(n, m, L, R) implicit none @@ -2639,7 +2668,7 @@ subroutine impose_biorthog_inverse(n, m, L, R) deallocate(S,Lt) -end subroutine impose_biorthog_svd +end subroutine impose_biorthog_inverse ! --- diff --git a/src/non_hermit_dav/new_routines.irp.f b/plugins/local/non_hermit_dav/new_routines.irp.f similarity index 100% rename from src/non_hermit_dav/new_routines.irp.f rename to plugins/local/non_hermit_dav/new_routines.irp.f diff --git a/src/non_hermit_dav/project.irp.f b/plugins/local/non_hermit_dav/project.irp.f similarity index 100% rename from src/non_hermit_dav/project.irp.f rename to plugins/local/non_hermit_dav/project.irp.f diff --git a/src/non_hermit_dav/utils.irp.f b/plugins/local/non_hermit_dav/utils.irp.f similarity index 100% rename from src/non_hermit_dav/utils.irp.f rename to plugins/local/non_hermit_dav/utils.irp.f diff --git a/src/ortho_three_e_ints/NEED b/plugins/local/ortho_three_e_ints/NEED similarity index 100% rename from src/ortho_three_e_ints/NEED rename to plugins/local/ortho_three_e_ints/NEED diff --git a/src/ortho_three_e_ints/io_6_index_tensor.irp.f b/plugins/local/ortho_three_e_ints/io_6_index_tensor.irp.f similarity index 100% rename from src/ortho_three_e_ints/io_6_index_tensor.irp.f rename to plugins/local/ortho_three_e_ints/io_6_index_tensor.irp.f diff --git a/src/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f b/plugins/local/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f similarity index 100% rename from src/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f rename to plugins/local/ortho_three_e_ints/mu_j_ints_usual_mos.irp.f diff --git a/src/qmckl/LIB b/plugins/local/qmckl/LIB similarity index 100% rename from src/qmckl/LIB rename to plugins/local/qmckl/LIB diff --git a/src/qmckl/NEED b/plugins/local/qmckl/NEED similarity index 100% rename from src/qmckl/NEED rename to plugins/local/qmckl/NEED diff --git a/src/qmckl/README.md b/plugins/local/qmckl/README.md similarity index 100% rename from src/qmckl/README.md rename to plugins/local/qmckl/README.md diff --git a/src/qmckl/qmckl.F90 b/plugins/local/qmckl/qmckl.F90 similarity index 100% rename from src/qmckl/qmckl.F90 rename to plugins/local/qmckl/qmckl.F90 diff --git a/src/tc_bi_ortho/31.tc_bi_ortho.bats b/plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats similarity index 100% rename from src/tc_bi_ortho/31.tc_bi_ortho.bats rename to plugins/local/tc_bi_ortho/31.tc_bi_ortho.bats diff --git a/src/tc_bi_ortho/EZFIO.cfg b/plugins/local/tc_bi_ortho/EZFIO.cfg similarity index 100% rename from src/tc_bi_ortho/EZFIO.cfg rename to plugins/local/tc_bi_ortho/EZFIO.cfg diff --git a/src/tc_bi_ortho/NEED b/plugins/local/tc_bi_ortho/NEED similarity index 100% rename from src/tc_bi_ortho/NEED rename to plugins/local/tc_bi_ortho/NEED diff --git a/src/tc_bi_ortho/compute_deltamu_right.irp.f b/plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f similarity index 91% rename from src/tc_bi_ortho/compute_deltamu_right.irp.f rename to plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f index ab9dc093..1142658d 100644 --- a/src/tc_bi_ortho/compute_deltamu_right.irp.f +++ b/plugins/local/tc_bi_ortho/compute_deltamu_right.irp.f @@ -24,10 +24,6 @@ subroutine delta_right() integer :: k double precision, allocatable :: delta(:,:) - print *, j1b_type - print *, j1b_pen - print *, mu_erf - allocate( delta(N_det,N_states) ) delta = 0.d0 @@ -48,7 +44,7 @@ subroutine delta_right() deallocate(delta) return -end subroutine delta_right +end ! --- diff --git a/src/tc_bi_ortho/dav_h_tc_s2.irp.f b/plugins/local/tc_bi_ortho/dav_h_tc_s2.irp.f similarity index 100% rename from src/tc_bi_ortho/dav_h_tc_s2.irp.f rename to plugins/local/tc_bi_ortho/dav_h_tc_s2.irp.f diff --git a/src/tc_bi_ortho/dressing_vectors_lr.irp.f b/plugins/local/tc_bi_ortho/dressing_vectors_lr.irp.f similarity index 100% rename from src/tc_bi_ortho/dressing_vectors_lr.irp.f rename to plugins/local/tc_bi_ortho/dressing_vectors_lr.irp.f diff --git a/src/tc_bi_ortho/e_corr_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/e_corr_bi_ortho.irp.f similarity index 100% rename from src/tc_bi_ortho/e_corr_bi_ortho.irp.f rename to plugins/local/tc_bi_ortho/e_corr_bi_ortho.irp.f diff --git a/src/tc_bi_ortho/h_biortho.irp.f b/plugins/local/tc_bi_ortho/h_biortho.irp.f similarity index 100% rename from src/tc_bi_ortho/h_biortho.irp.f rename to plugins/local/tc_bi_ortho/h_biortho.irp.f diff --git a/src/tc_bi_ortho/h_mat_triple.irp.f b/plugins/local/tc_bi_ortho/h_mat_triple.irp.f similarity index 99% rename from src/tc_bi_ortho/h_mat_triple.irp.f rename to plugins/local/tc_bi_ortho/h_mat_triple.irp.f index 4c8c107a..6f5697a2 100644 --- a/src/tc_bi_ortho/h_mat_triple.irp.f +++ b/plugins/local/tc_bi_ortho/h_mat_triple.irp.f @@ -325,7 +325,7 @@ end subroutine triple_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe, hthree, htot) use bitmasks BEGIN_DOC -! for triple excitation +! for triple excitation !! !! WARNING !! ! diff --git a/src/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f b/plugins/local/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f similarity index 100% rename from src/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f rename to plugins/local/tc_bi_ortho/h_tc_bi_ortho_psi.irp.f diff --git a/src/tc_bi_ortho/h_tc_s2_u0.irp.f b/plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f similarity index 100% rename from src/tc_bi_ortho/h_tc_s2_u0.irp.f rename to plugins/local/tc_bi_ortho/h_tc_s2_u0.irp.f diff --git a/src/tc_bi_ortho/h_tc_u0.irp.f b/plugins/local/tc_bi_ortho/h_tc_u0.irp.f similarity index 100% rename from src/tc_bi_ortho/h_tc_u0.irp.f rename to plugins/local/tc_bi_ortho/h_tc_u0.irp.f diff --git a/src/tc_bi_ortho/normal_ordered.irp.f b/plugins/local/tc_bi_ortho/normal_ordered.irp.f similarity index 100% rename from src/tc_bi_ortho/normal_ordered.irp.f rename to plugins/local/tc_bi_ortho/normal_ordered.irp.f diff --git a/src/tc_bi_ortho/normal_ordered_contractions.irp.f b/plugins/local/tc_bi_ortho/normal_ordered_contractions.irp.f similarity index 100% rename from src/tc_bi_ortho/normal_ordered_contractions.irp.f rename to plugins/local/tc_bi_ortho/normal_ordered_contractions.irp.f diff --git a/src/tc_bi_ortho/normal_ordered_old.irp.f b/plugins/local/tc_bi_ortho/normal_ordered_old.irp.f similarity index 100% rename from src/tc_bi_ortho/normal_ordered_old.irp.f rename to plugins/local/tc_bi_ortho/normal_ordered_old.irp.f diff --git a/src/tc_bi_ortho/normal_ordered_v0.irp.f b/plugins/local/tc_bi_ortho/normal_ordered_v0.irp.f similarity index 100% rename from src/tc_bi_ortho/normal_ordered_v0.irp.f rename to plugins/local/tc_bi_ortho/normal_ordered_v0.irp.f diff --git a/src/tc_bi_ortho/print_he_tc_energy.irp.f b/plugins/local/tc_bi_ortho/print_he_tc_energy.irp.f similarity index 100% rename from src/tc_bi_ortho/print_he_tc_energy.irp.f rename to plugins/local/tc_bi_ortho/print_he_tc_energy.irp.f diff --git a/src/tc_bi_ortho/print_tc_dump.irp.f b/plugins/local/tc_bi_ortho/print_tc_dump.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_dump.irp.f rename to plugins/local/tc_bi_ortho/print_tc_dump.irp.f diff --git a/src/tc_bi_ortho/print_tc_energy.irp.f b/plugins/local/tc_bi_ortho/print_tc_energy.irp.f similarity index 87% rename from src/tc_bi_ortho/print_tc_energy.irp.f rename to plugins/local/tc_bi_ortho/print_tc_energy.irp.f index 7bca72a1..fe7c2d10 100644 --- a/src/tc_bi_ortho/print_tc_energy.irp.f +++ b/plugins/local/tc_bi_ortho/print_tc_energy.irp.f @@ -17,9 +17,6 @@ program print_tc_energy read_wf = .True. touch read_wf - PROVIDE j1b_type - print*, 'j1b_type = ', j1b_type - call write_tc_energy() end diff --git a/src/tc_bi_ortho/print_tc_spin_dens.irp.f b/plugins/local/tc_bi_ortho/print_tc_spin_dens.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_spin_dens.irp.f rename to plugins/local/tc_bi_ortho/print_tc_spin_dens.irp.f diff --git a/src/tc_bi_ortho/print_tc_var.irp.f b/plugins/local/tc_bi_ortho/print_tc_var.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_var.irp.f rename to plugins/local/tc_bi_ortho/print_tc_var.irp.f diff --git a/src/tc_bi_ortho/print_tc_wf.irp.f b/plugins/local/tc_bi_ortho/print_tc_wf.irp.f similarity index 100% rename from src/tc_bi_ortho/print_tc_wf.irp.f rename to plugins/local/tc_bi_ortho/print_tc_wf.irp.f diff --git a/src/tc_bi_ortho/psi_det_tc_sorted.irp.f b/plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f similarity index 100% rename from src/tc_bi_ortho/psi_det_tc_sorted.irp.f rename to plugins/local/tc_bi_ortho/psi_det_tc_sorted.irp.f diff --git a/src/tc_bi_ortho/psi_left_qmc.irp.f b/plugins/local/tc_bi_ortho/psi_left_qmc.irp.f similarity index 100% rename from src/tc_bi_ortho/psi_left_qmc.irp.f rename to plugins/local/tc_bi_ortho/psi_left_qmc.irp.f diff --git a/src/tc_bi_ortho/psi_r_l_prov.irp.f b/plugins/local/tc_bi_ortho/psi_r_l_prov.irp.f similarity index 100% rename from src/tc_bi_ortho/psi_r_l_prov.irp.f rename to plugins/local/tc_bi_ortho/psi_r_l_prov.irp.f diff --git a/src/tc_bi_ortho/pt2_tc_cisd.irp.f b/plugins/local/tc_bi_ortho/pt2_tc_cisd.irp.f similarity index 100% rename from src/tc_bi_ortho/pt2_tc_cisd.irp.f rename to plugins/local/tc_bi_ortho/pt2_tc_cisd.irp.f diff --git a/src/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f b/plugins/local/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f similarity index 100% rename from src/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f rename to plugins/local/tc_bi_ortho/save_bitcpsileft_for_qmcchem.irp.f diff --git a/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f b/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f similarity index 97% rename from src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f rename to plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f index ffcd9b22..6b3acce6 100644 --- a/src/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f +++ b/plugins/local/tc_bi_ortho/save_tc_bi_ortho_nat.irp.f @@ -17,7 +17,7 @@ program tc_natorb_bi_ortho my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r diff --git a/src/tc_bi_ortho/select_dets_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/select_dets_bi_ortho.irp.f similarity index 100% rename from src/tc_bi_ortho/select_dets_bi_ortho.irp.f rename to plugins/local/tc_bi_ortho/select_dets_bi_ortho.irp.f diff --git a/src/tc_bi_ortho/slater_tc_3e_slow.irp.f b/plugins/local/tc_bi_ortho/slater_tc_3e_slow.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_3e_slow.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_3e_slow.irp.f diff --git a/src/tc_bi_ortho/slater_tc_opt.irp.f b/plugins/local/tc_bi_ortho/slater_tc_opt.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_opt.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_opt.irp.f diff --git a/src/tc_bi_ortho/slater_tc_opt_diag.irp.f b/plugins/local/tc_bi_ortho/slater_tc_opt_diag.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_opt_diag.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_opt_diag.irp.f diff --git a/src/tc_bi_ortho/slater_tc_opt_double.irp.f b/plugins/local/tc_bi_ortho/slater_tc_opt_double.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_opt_double.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_opt_double.irp.f diff --git a/src/tc_bi_ortho/slater_tc_opt_single.irp.f b/plugins/local/tc_bi_ortho/slater_tc_opt_single.irp.f similarity index 100% rename from src/tc_bi_ortho/slater_tc_opt_single.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_opt_single.irp.f diff --git a/src/tc_bi_ortho/slater_tc_slow.irp.f b/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f similarity index 96% rename from src/tc_bi_ortho/slater_tc_slow.irp.f rename to plugins/local/tc_bi_ortho/slater_tc_slow.irp.f index b1751069..02352a32 100644 --- a/src/tc_bi_ortho/slater_tc_slow.irp.f +++ b/plugins/local/tc_bi_ortho/slater_tc_slow.irp.f @@ -260,7 +260,6 @@ subroutine single_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, ! ! PROVIDE core_bitmask core_fock_operator mo_integrals_erf_map -! PROVIDE j1b_gauss other_spin(1) = 2 other_spin(2) = 1 @@ -295,15 +294,6 @@ subroutine single_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, hmono = mo_bi_ortho_tc_one_e(p1,h1) * phase -! if(j1b_gauss .eq. 1) then -! print*,'j1b not implemented for bi ortho TC' -! print*,'stopping ....' -! stop -! !hmono += ( mo_j1b_gauss_hermI (h1,p1) & -! ! + mo_j1b_gauss_hermII (h1,p1) & -! ! + mo_j1b_gauss_nonherm(h1,p1) ) * phase -! endif - ! if(core_tc_op)then ! print*,'core_tc_op not already taken into account for bi ortho' ! print*,'stopping ...' diff --git a/src/tc_bi_ortho/spin_mulliken.irp.f b/plugins/local/tc_bi_ortho/spin_mulliken.irp.f similarity index 100% rename from src/tc_bi_ortho/spin_mulliken.irp.f rename to plugins/local/tc_bi_ortho/spin_mulliken.irp.f diff --git a/src/tc_bi_ortho/symmetrized_3_e_int.irp.f b/plugins/local/tc_bi_ortho/symmetrized_3_e_int.irp.f similarity index 100% rename from src/tc_bi_ortho/symmetrized_3_e_int.irp.f rename to plugins/local/tc_bi_ortho/symmetrized_3_e_int.irp.f diff --git a/src/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f b/plugins/local/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f similarity index 100% rename from src/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f rename to plugins/local/tc_bi_ortho/symmetrized_3_e_int_prov.irp.f diff --git a/src/tc_bi_ortho/tc_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f similarity index 98% rename from src/tc_bi_ortho/tc_bi_ortho.irp.f rename to plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f index e27672a2..64982ab6 100644 --- a/src/tc_bi_ortho/tc_bi_ortho.irp.f +++ b/plugins/local/tc_bi_ortho/tc_bi_ortho.irp.f @@ -13,7 +13,7 @@ program tc_bi_ortho my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r diff --git a/src/tc_bi_ortho/tc_bi_ortho_prop.irp.f b/plugins/local/tc_bi_ortho/tc_bi_ortho_prop.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_bi_ortho_prop.irp.f rename to plugins/local/tc_bi_ortho/tc_bi_ortho_prop.irp.f diff --git a/src/tc_bi_ortho/tc_cisd_sc2.irp.f b/plugins/local/tc_bi_ortho/tc_cisd_sc2.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_cisd_sc2.irp.f rename to plugins/local/tc_bi_ortho/tc_cisd_sc2.irp.f diff --git a/src/tc_bi_ortho/tc_cisd_sc2_utils.irp.f b/plugins/local/tc_bi_ortho/tc_cisd_sc2_utils.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_cisd_sc2_utils.irp.f rename to plugins/local/tc_bi_ortho/tc_cisd_sc2_utils.irp.f diff --git a/src/tc_bi_ortho/tc_h_eigvectors.irp.f b/plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_h_eigvectors.irp.f rename to plugins/local/tc_bi_ortho/tc_h_eigvectors.irp.f diff --git a/src/tc_bi_ortho/tc_hmat.irp.f b/plugins/local/tc_bi_ortho/tc_hmat.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_hmat.irp.f rename to plugins/local/tc_bi_ortho/tc_hmat.irp.f diff --git a/src/tc_bi_ortho/tc_natorb.irp.f b/plugins/local/tc_bi_ortho/tc_natorb.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_natorb.irp.f rename to plugins/local/tc_bi_ortho/tc_natorb.irp.f diff --git a/src/tc_bi_ortho/tc_prop.irp.f b/plugins/local/tc_bi_ortho/tc_prop.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_prop.irp.f rename to plugins/local/tc_bi_ortho/tc_prop.irp.f diff --git a/src/tc_bi_ortho/tc_som.irp.f b/plugins/local/tc_bi_ortho/tc_som.irp.f similarity index 91% rename from src/tc_bi_ortho/tc_som.irp.f rename to plugins/local/tc_bi_ortho/tc_som.irp.f index 427508d2..1d11c81b 100644 --- a/src/tc_bi_ortho/tc_som.irp.f +++ b/plugins/local/tc_bi_ortho/tc_som.irp.f @@ -17,12 +17,6 @@ program tc_som my_n_pt_a_grid = tc_grid1_a touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid - PROVIDE mu_erf - print *, ' mu = ', mu_erf - PROVIDE j1b_type - print *, ' j1b_type = ', j1b_type - print *, j1b_pen - read_wf = .true. touch read_wf diff --git a/src/tc_bi_ortho/tc_utils.irp.f b/plugins/local/tc_bi_ortho/tc_utils.irp.f similarity index 100% rename from src/tc_bi_ortho/tc_utils.irp.f rename to plugins/local/tc_bi_ortho/tc_utils.irp.f diff --git a/src/tc_bi_ortho/test_natorb.irp.f b/plugins/local/tc_bi_ortho/test_natorb.irp.f similarity index 100% rename from src/tc_bi_ortho/test_natorb.irp.f rename to plugins/local/tc_bi_ortho/test_natorb.irp.f diff --git a/src/tc_bi_ortho/test_normal_order.irp.f b/plugins/local/tc_bi_ortho/test_normal_order.irp.f similarity index 100% rename from src/tc_bi_ortho/test_normal_order.irp.f rename to plugins/local/tc_bi_ortho/test_normal_order.irp.f diff --git a/src/tc_bi_ortho/test_s2_tc.irp.f b/plugins/local/tc_bi_ortho/test_s2_tc.irp.f similarity index 100% rename from src/tc_bi_ortho/test_s2_tc.irp.f rename to plugins/local/tc_bi_ortho/test_s2_tc.irp.f diff --git a/src/tc_bi_ortho/test_spin_dens.irp.f b/plugins/local/tc_bi_ortho/test_spin_dens.irp.f similarity index 100% rename from src/tc_bi_ortho/test_spin_dens.irp.f rename to plugins/local/tc_bi_ortho/test_spin_dens.irp.f diff --git a/src/tc_bi_ortho/test_tc_bi_ortho.irp.f b/plugins/local/tc_bi_ortho/test_tc_bi_ortho.irp.f similarity index 100% rename from src/tc_bi_ortho/test_tc_bi_ortho.irp.f rename to plugins/local/tc_bi_ortho/test_tc_bi_ortho.irp.f diff --git a/src/tc_bi_ortho/test_tc_fock.irp.f b/plugins/local/tc_bi_ortho/test_tc_fock.irp.f similarity index 100% rename from src/tc_bi_ortho/test_tc_fock.irp.f rename to plugins/local/tc_bi_ortho/test_tc_fock.irp.f diff --git a/src/tc_bi_ortho/test_tc_two_rdm.irp.f b/plugins/local/tc_bi_ortho/test_tc_two_rdm.irp.f similarity index 100% rename from src/tc_bi_ortho/test_tc_two_rdm.irp.f rename to plugins/local/tc_bi_ortho/test_tc_two_rdm.irp.f diff --git a/src/tc_bi_ortho/two_rdm_naive.irp.f b/plugins/local/tc_bi_ortho/two_rdm_naive.irp.f similarity index 100% rename from src/tc_bi_ortho/two_rdm_naive.irp.f rename to plugins/local/tc_bi_ortho/two_rdm_naive.irp.f diff --git a/src/tc_keywords/EZFIO.cfg b/plugins/local/tc_keywords/EZFIO.cfg similarity index 91% rename from src/tc_keywords/EZFIO.cfg rename to plugins/local/tc_keywords/EZFIO.cfg index ac2cfda2..93ff790f 100644 --- a/src/tc_keywords/EZFIO.cfg +++ b/plugins/local/tc_keywords/EZFIO.cfg @@ -130,30 +130,6 @@ doc: if +1: only positive is selected, -1: only negative is selected, :0 both po interface: ezfio,provider,ocaml default: 0 -[j1b_pen] -type: double precision -doc: exponents of the 1-body Jastrow -interface: ezfio -size: (nuclei.nucl_num) - -[j1b_pen_coef] -type: double precision -doc: coefficients of the 1-body Jastrow -interface: ezfio -size: (nuclei.nucl_num) - -[j1b_coeff] -type: double precision -doc: coeff of the 1-body Jastrow -interface: ezfio -size: (nuclei.nucl_num) - -[j1b_type] -type: integer -doc: type of 1-body Jastrow -interface: ezfio, provider, ocaml -default: 0 - [mu_r_ct] type: double precision doc: a parameter used to define mu(r) @@ -184,12 +160,6 @@ doc: If |true|, maximize the overlap between orthogonalized left- and right eige interface: ezfio,provider,ocaml default: False -[ng_fit_jast] -type: integer -doc: nb of Gaussians used to fit Jastrow fcts -interface: ezfio,provider,ocaml -default: 20 - [max_dim_diis_tcscf] type: integer doc: Maximum size of the DIIS extrapolation procedure @@ -282,7 +252,7 @@ default: True [tc_grid1_a] type: integer -doc: size of angular grid over r1 +doc: size of angular grid over r1: [ 6 | 14 | 26 | 38 | 50 | 74 | 86 | 110 | 146 | 170 | 194 | 230 | 266 | 302 | 350 | 434 | 590 | 770 | 974 | 1202 | 1454 | 1730 | 2030 | 2354 | 2702 | 3074 | 3470 | 3890 | 4334 | 4802 | 5294 | 5810 ] interface: ezfio,provider,ocaml default: 50 @@ -294,13 +264,19 @@ default: 30 [tc_grid2_a] type: integer -doc: size of angular grid over r2 +doc: size of angular grid over r2: [ 6 | 14 | 26 | 38 | 50 | 74 | 86 | 110 | 146 | 170 | 194 | 230 | 266 | 302 | 350 | 434 | 590 | 770 | 974 | 1202 | 1454 | 1730 | 2030 | 2354 | 2702 | 3074 | 3470 | 3890 | 4334 | 4802 | 5294 | 5810 ] interface: ezfio,provider,ocaml -default: 194 +default: 266 [tc_grid2_r] type: integer doc: size of radial grid over r2 interface: ezfio,provider,ocaml -default: 50 +default: 70 + +[tc_integ_type] +type: character*(32) +doc: approach used to evaluate TC integrals [ analytic | numeric | semi-analytic ] +interface: ezfio,ocaml,provider +default: semi-analytic diff --git a/src/tc_keywords/NEED b/plugins/local/tc_keywords/NEED similarity index 100% rename from src/tc_keywords/NEED rename to plugins/local/tc_keywords/NEED diff --git a/src/tc_keywords/tc_keywords.irp.f b/plugins/local/tc_keywords/tc_keywords.irp.f similarity index 100% rename from src/tc_keywords/tc_keywords.irp.f rename to plugins/local/tc_keywords/tc_keywords.irp.f diff --git a/src/tc_scf/11.tc_scf.bats b/plugins/local/tc_scf/11.tc_scf.bats similarity index 100% rename from src/tc_scf/11.tc_scf.bats rename to plugins/local/tc_scf/11.tc_scf.bats diff --git a/src/tc_scf/EZFIO.cfg b/plugins/local/tc_scf/EZFIO.cfg similarity index 100% rename from src/tc_scf/EZFIO.cfg rename to plugins/local/tc_scf/EZFIO.cfg diff --git a/src/tc_scf/NEED b/plugins/local/tc_scf/NEED similarity index 100% rename from src/tc_scf/NEED rename to plugins/local/tc_scf/NEED diff --git a/src/tc_scf/combine_lr_tcscf.irp.f b/plugins/local/tc_scf/combine_lr_tcscf.irp.f similarity index 100% rename from src/tc_scf/combine_lr_tcscf.irp.f rename to plugins/local/tc_scf/combine_lr_tcscf.irp.f diff --git a/src/tc_scf/diago_bi_ort_tcfock.irp.f b/plugins/local/tc_scf/diago_bi_ort_tcfock.irp.f similarity index 100% rename from src/tc_scf/diago_bi_ort_tcfock.irp.f rename to plugins/local/tc_scf/diago_bi_ort_tcfock.irp.f diff --git a/src/tc_scf/diago_vartcfock.irp.f b/plugins/local/tc_scf/diago_vartcfock.irp.f similarity index 100% rename from src/tc_scf/diago_vartcfock.irp.f rename to plugins/local/tc_scf/diago_vartcfock.irp.f diff --git a/src/tc_scf/diis_tcscf.irp.f b/plugins/local/tc_scf/diis_tcscf.irp.f similarity index 100% rename from src/tc_scf/diis_tcscf.irp.f rename to plugins/local/tc_scf/diis_tcscf.irp.f diff --git a/src/tc_scf/fock_3e_bi_ortho_cs.irp.f b/plugins/local/tc_scf/fock_3e_bi_ortho_cs.irp.f similarity index 100% rename from src/tc_scf/fock_3e_bi_ortho_cs.irp.f rename to plugins/local/tc_scf/fock_3e_bi_ortho_cs.irp.f diff --git a/src/tc_scf/fock_3e_bi_ortho_os.irp.f b/plugins/local/tc_scf/fock_3e_bi_ortho_os.irp.f similarity index 100% rename from src/tc_scf/fock_3e_bi_ortho_os.irp.f rename to plugins/local/tc_scf/fock_3e_bi_ortho_os.irp.f diff --git a/src/tc_scf/fock_3e_bi_ortho_uhf.irp.f b/plugins/local/tc_scf/fock_3e_bi_ortho_uhf.irp.f similarity index 100% rename from src/tc_scf/fock_3e_bi_ortho_uhf.irp.f rename to plugins/local/tc_scf/fock_3e_bi_ortho_uhf.irp.f diff --git a/src/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f b/plugins/local/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f similarity index 100% rename from src/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f rename to plugins/local/tc_scf/fock_3e_bi_ortho_uhf_old.irp.f diff --git a/src/tc_scf/fock_hermit.irp.f b/plugins/local/tc_scf/fock_hermit.irp.f similarity index 100% rename from src/tc_scf/fock_hermit.irp.f rename to plugins/local/tc_scf/fock_hermit.irp.f diff --git a/src/tc_scf/fock_tc.irp.f b/plugins/local/tc_scf/fock_tc.irp.f similarity index 100% rename from src/tc_scf/fock_tc.irp.f rename to plugins/local/tc_scf/fock_tc.irp.f diff --git a/src/tc_scf/fock_tc_mo_tot.irp.f b/plugins/local/tc_scf/fock_tc_mo_tot.irp.f similarity index 100% rename from src/tc_scf/fock_tc_mo_tot.irp.f rename to plugins/local/tc_scf/fock_tc_mo_tot.irp.f diff --git a/src/tc_scf/fock_three_bi_ortho.irp.f b/plugins/local/tc_scf/fock_three_bi_ortho.irp.f similarity index 100% rename from src/tc_scf/fock_three_bi_ortho.irp.f rename to plugins/local/tc_scf/fock_three_bi_ortho.irp.f diff --git a/src/tc_scf/fock_three_hermit.irp.f b/plugins/local/tc_scf/fock_three_hermit.irp.f similarity index 100% rename from src/tc_scf/fock_three_hermit.irp.f rename to plugins/local/tc_scf/fock_three_hermit.irp.f diff --git a/src/tc_scf/fock_vartc.irp.f b/plugins/local/tc_scf/fock_vartc.irp.f similarity index 97% rename from src/tc_scf/fock_vartc.irp.f rename to plugins/local/tc_scf/fock_vartc.irp.f index 03899b07..2b4a57e5 100644 --- a/src/tc_scf/fock_vartc.irp.f +++ b/plugins/local/tc_scf/fock_vartc.irp.f @@ -13,9 +13,9 @@ two_e_vartc_integral_alpha = 0.d0 two_e_vartc_integral_beta = 0.d0 - !$OMP PARALLEL DEFAULT (NONE) & - !$OMP PRIVATE (i, j, k, l, density_a, density_b, density, tmp_a, tmp_b, I_coul, I_kjli) & - !$OMP SHARED (ao_num, TCSCF_density_matrix_ao_alpha, TCSCF_density_matrix_ao_beta, ao_two_e_vartc_tot, & + !$OMP PARALLEL DEFAULT (NONE) & + !$OMP PRIVATE (i, j, k, l, density_a, density_b, density, tmp_a, tmp_b, I_coul, I_kjli) & + !$OMP SHARED (ao_num, TCSCF_density_matrix_ao_alpha, TCSCF_density_matrix_ao_beta, ao_two_e_tc_tot, & !$OMP two_e_vartc_integral_alpha, two_e_vartc_integral_beta) allocate(tmp_a(ao_num,ao_num), tmp_b(ao_num,ao_num)) @@ -31,8 +31,8 @@ do i = 1, ao_num do k = 1, ao_num - I_coul = density * ao_two_e_vartc_tot(k,i,l,j) - I_kjli = ao_two_e_vartc_tot(k,j,l,i) + I_coul = density * ao_two_e_tc_tot(k,i,l,j) + I_kjli = ao_two_e_tc_tot(k,j,l,i) tmp_a(k,i) += I_coul - density_a * I_kjli tmp_b(k,i) += I_coul - density_b * I_kjli diff --git a/src/tc_scf/integrals_in_r_stuff.irp.f b/plugins/local/tc_scf/integrals_in_r_stuff.irp.f similarity index 100% rename from src/tc_scf/integrals_in_r_stuff.irp.f rename to plugins/local/tc_scf/integrals_in_r_stuff.irp.f diff --git a/src/tc_scf/minimize_tc_angles.irp.f b/plugins/local/tc_scf/minimize_tc_angles.irp.f similarity index 100% rename from src/tc_scf/minimize_tc_angles.irp.f rename to plugins/local/tc_scf/minimize_tc_angles.irp.f diff --git a/src/tc_scf/molden_lr_mos.irp.f b/plugins/local/tc_scf/molden_lr_mos.irp.f similarity index 100% rename from src/tc_scf/molden_lr_mos.irp.f rename to plugins/local/tc_scf/molden_lr_mos.irp.f diff --git a/src/tc_scf/print_fit_param.irp.f b/plugins/local/tc_scf/print_fit_param.irp.f similarity index 100% rename from src/tc_scf/print_fit_param.irp.f rename to plugins/local/tc_scf/print_fit_param.irp.f diff --git a/src/tc_scf/print_tcscf_energy.irp.f b/plugins/local/tc_scf/print_tcscf_energy.irp.f similarity index 80% rename from src/tc_scf/print_tcscf_energy.irp.f rename to plugins/local/tc_scf/print_tcscf_energy.irp.f index 05b8df23..6f9afd9a 100644 --- a/src/tc_scf/print_tcscf_energy.irp.f +++ b/plugins/local/tc_scf/print_tcscf_energy.irp.f @@ -24,11 +24,15 @@ subroutine main() implicit none double precision :: etc_tot, etc_1e, etc_2e, etc_3e - PROVIDE mu_erf - PROVIDE j1b_type + PROVIDE j2e_type mu_erf + PROVIDE j1e_type j1e_coef j1e_expo + PROVIDE env_type env_coef env_expo + + print*, ' j2e_type = ', j2e_type + print*, ' j1e_type = ', j1e_type + print*, ' env_type = ', env_type print*, ' mu_erf = ', mu_erf - print*, ' j1b_type = ', j1b_type etc_tot = TC_HF_energy etc_1e = TC_HF_one_e_energy diff --git a/src/tc_scf/rh_tcscf_diis.irp.f b/plugins/local/tc_scf/rh_tcscf_diis.irp.f similarity index 100% rename from src/tc_scf/rh_tcscf_diis.irp.f rename to plugins/local/tc_scf/rh_tcscf_diis.irp.f diff --git a/src/tc_scf/rh_tcscf_simple.irp.f b/plugins/local/tc_scf/rh_tcscf_simple.irp.f similarity index 100% rename from src/tc_scf/rh_tcscf_simple.irp.f rename to plugins/local/tc_scf/rh_tcscf_simple.irp.f diff --git a/src/tc_scf/rh_vartcscf_simple.irp.f b/plugins/local/tc_scf/rh_vartcscf_simple.irp.f similarity index 100% rename from src/tc_scf/rh_vartcscf_simple.irp.f rename to plugins/local/tc_scf/rh_vartcscf_simple.irp.f diff --git a/src/tc_scf/rotate_tcscf_orbitals.irp.f b/plugins/local/tc_scf/rotate_tcscf_orbitals.irp.f similarity index 100% rename from src/tc_scf/rotate_tcscf_orbitals.irp.f rename to plugins/local/tc_scf/rotate_tcscf_orbitals.irp.f diff --git a/src/tc_scf/routines_rotates.irp.f b/plugins/local/tc_scf/routines_rotates.irp.f similarity index 100% rename from src/tc_scf/routines_rotates.irp.f rename to plugins/local/tc_scf/routines_rotates.irp.f diff --git a/src/tc_scf/tc_petermann_factor.irp.f b/plugins/local/tc_scf/tc_petermann_factor.irp.f similarity index 100% rename from src/tc_scf/tc_petermann_factor.irp.f rename to plugins/local/tc_scf/tc_petermann_factor.irp.f diff --git a/src/tc_scf/tc_scf.irp.f b/plugins/local/tc_scf/tc_scf.irp.f similarity index 82% rename from src/tc_scf/tc_scf.irp.f rename to plugins/local/tc_scf/tc_scf.irp.f index 22f66484..d8c5ab66 100644 --- a/src/tc_scf/tc_scf.irp.f +++ b/plugins/local/tc_scf/tc_scf.irp.f @@ -7,11 +7,20 @@ program tc_scf END_DOC implicit none + integer :: i + logical :: good_angles + + PROVIDE j1e_type + PROVIDE j2e_type + PROVIDE tcscf_algorithm + PROVIDE var_tc + + print *, ' TC-SCF with:' + print *, ' j1e_type = ', j1e_type + print *, ' j2e_type = ', j2e_type write(json_unit,json_array_open_fmt) 'tc-scf' - print *, ' starting ...' - my_grid_becke = .True. PROVIDE tc_grid1_a tc_grid1_r my_n_pt_r_grid = tc_grid1_r @@ -22,13 +31,7 @@ program tc_scf call write_int(6, my_n_pt_a_grid, 'angular external grid over') - PROVIDE mu_erf - print *, ' mu = ', mu_erf - PROVIDE j1b_type - print *, ' j1b_type = ', j1b_type - print *, j1b_pen - - if(j1b_type .ge. 100) then + if(tc_integ_type .eq. "numeric") then my_extra_grid_becke = .True. PROVIDE tc_grid2_a tc_grid2_r my_n_pt_r_extra_grid = tc_grid2_r @@ -42,8 +45,6 @@ program tc_scf !call create_guess() !call orthonormalize_mos() - PROVIDE tcscf_algorithm - PROVIDE var_tc if(var_tc) then @@ -69,7 +70,16 @@ program tc_scf stop endif - call minimize_tc_orb_angles() + PROVIDE Fock_matrix_tc_diag_mo_tot + print*, ' Eigenvalues:' + do i = 1, mo_num + print*, i, Fock_matrix_tc_diag_mo_tot(i) + enddo + + ! TODO + ! rotate angles in separate code only if necessary + !call minimize_tc_orb_angles() + call print_energy_and_mos(good_angles) endif diff --git a/src/tc_scf/tc_scf_dm.irp.f b/plugins/local/tc_scf/tc_scf_dm.irp.f similarity index 100% rename from src/tc_scf/tc_scf_dm.irp.f rename to plugins/local/tc_scf/tc_scf_dm.irp.f diff --git a/src/tc_scf/tc_scf_energy.irp.f b/plugins/local/tc_scf/tc_scf_energy.irp.f similarity index 100% rename from src/tc_scf/tc_scf_energy.irp.f rename to plugins/local/tc_scf/tc_scf_energy.irp.f diff --git a/src/tc_scf/tcscf_energy_naive.irp.f b/plugins/local/tc_scf/tcscf_energy_naive.irp.f similarity index 100% rename from src/tc_scf/tcscf_energy_naive.irp.f rename to plugins/local/tc_scf/tcscf_energy_naive.irp.f diff --git a/src/tc_scf/test_int.irp.f b/plugins/local/tc_scf/test_int.irp.f similarity index 69% rename from src/tc_scf/test_int.irp.f rename to plugins/local/tc_scf/test_int.irp.f index 4aa67d04..e135fcd8 100644 --- a/src/tc_scf/test_int.irp.f +++ b/plugins/local/tc_scf/test_int.irp.f @@ -1,7 +1,7 @@ program test_ints BEGIN_DOC -! TODO : Put the documentation of the program here + ! TODO : Put the documentation of the program here END_DOC implicit none @@ -20,41 +20,31 @@ program test_ints touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid !! OK -! call routine_int2_u_grad1u_j1b2 +! call routine_int2_u_grad1u_env2 ! OK -! call routine_v_ij_erf_rk_cst_mu_j1b +! call routine_v_ij_erf_rk_cst_mu_env ! OK -! call routine_x_v_ij_erf_rk_cst_mu_j1b +! call routine_x_v_ij_erf_rk_cst_mu_env ! OK -! call routine_int2_u2_j1b2 +! call routine_int2_u2_env2 ! OK -! call routine_int2_u_grad1u_x_j1b2 +! call routine_int2_u_grad1u_x_env2 ! OK -! call routine_int2_grad1u2_grad2u2_j1b2 -! call routine_int2_u_grad1u_j1b2 -! call test_total_grad_lapl -! call test_total_grad_square +! call routine_int2_grad1u2_grad2u2_env2 +! call routine_int2_u_grad1u_env2 ! call test_int2_grad1_u12_ao_test -! call routine_v_ij_u_cst_mu_j1b_test -! call test_ao_tc_int_chemist +! call routine_v_ij_u_cst_mu_env_test ! call test_grid_points_ao -! call test_tc_scf !call test_int_gauss !call test_fock_3e_uhf_ao() !call test_fock_3e_uhf_mo() - !call test_tc_grad_and_lapl_ao() - !call test_tc_grad_square_ao() - !call test_two_e_tc_non_hermit_integral() -! call test_tc_grad_square_ao_test() - !!PROVIDE TC_HF_energy VARTC_HF_energy !!print *, ' TC_HF_energy = ', TC_HF_energy !!print *, ' VARTC_HF_energy = ', VARTC_HF_energy -! call test_old_ints call test_fock_3e_uhf_mo_cs() call test_fock_3e_uhf_mo_a() @@ -64,47 +54,21 @@ end ! --- -subroutine test_tc_scf - implicit none - integer :: i -! provide int2_u_grad1u_x_j1b2_test - provide x_v_ij_erf_rk_cst_mu_j1b_test -! do i = 1, ng_fit_jast -! print*,expo_gauss_1_erf_x_2(i),coef_gauss_1_erf_x_2(i) -! enddo -! provide tc_grad_square_ao_test -! provide tc_grad_and_lapl_ao_test -! provide int2_u_grad1u_x_j1b2_test -! provide x_v_ij_erf_rk_cst_mu_j1b_test -! print*,'TC_HF_energy = ',TC_HF_energy -! print*,'grad_non_hermit = ',grad_non_hermit -end - -subroutine test_ao_tc_int_chemist - implicit none - provide ao_tc_int_chemist -! provide ao_tc_int_chemist_test -! provide tc_grad_square_ao_test -! provide tc_grad_and_lapl_ao_test -end - -! --- - -subroutine routine_test_j1b +subroutine routine_test_env implicit none integer :: i,icount,j icount = 0 - do i = 1, List_all_comb_b3_size - if(dabs(List_all_comb_b3_coef(i)).gt.1.d-10)then + do i = 1, List_env1s_square_size + if(dabs(List_env1s_square_coef(i)).gt.1.d-10)then print*,'' - print*,List_all_comb_b3_expo(i),List_all_comb_b3_coef(i) - print*,List_all_comb_b3_cent(1:3,i) + print*,List_env1s_square_expo(i),List_env1s_square_coef(i) + print*,List_env1s_square_cent(1:3,i) print*,'' icount += 1 endif enddo - print*,'List_all_comb_b3_coef,icount = ',List_all_comb_b3_size,icount + print*,'List_env1s_square_coef,icount = ',List_env1s_square_size,icount do i = 1, ao_num do j = 1, ao_num do icount = 1, List_comb_thr_b3_size(j,i) @@ -116,11 +80,11 @@ subroutine routine_test_j1b ! enddo enddo enddo - print*,'max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size,List_all_comb_b3_size + print*,'max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size,List_env1s_square_size end -subroutine routine_int2_u_grad1u_j1b2 +subroutine routine_int2_u_grad1u_env2 implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -136,8 +100,8 @@ subroutine routine_int2_u_grad1u_j1b2 do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += int2_u_grad1u_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += int2_u_grad1u_j1b2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += int2_u_grad1u_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += int2_u_grad1u_env2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -160,7 +124,7 @@ subroutine routine_int2_u_grad1u_j1b2 enddo print*,'******' print*,'******' - print*,'routine_int2_u_grad1u_j1b2' + print*,'routine_int2_u_grad1u_env2' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -168,7 +132,7 @@ subroutine routine_int2_u_grad1u_j1b2 end -subroutine routine_v_ij_erf_rk_cst_mu_j1b +subroutine routine_v_ij_erf_rk_cst_mu_env implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -183,8 +147,8 @@ subroutine routine_v_ij_erf_rk_cst_mu_j1b do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += v_ij_erf_rk_cst_mu_j1b(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += v_ij_erf_rk_cst_mu_env_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += v_ij_erf_rk_cst_mu_env(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -207,7 +171,7 @@ subroutine routine_v_ij_erf_rk_cst_mu_j1b enddo print*,'******' print*,'******' - print*,'routine_v_ij_erf_rk_cst_mu_j1b' + print*,'routine_v_ij_erf_rk_cst_mu_env' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -216,7 +180,7 @@ subroutine routine_v_ij_erf_rk_cst_mu_j1b end -subroutine routine_x_v_ij_erf_rk_cst_mu_j1b +subroutine routine_x_v_ij_erf_rk_cst_mu_env implicit none integer :: i,j,ipoint,k,l,m double precision :: weight,accu_relat, accu_abs, contrib @@ -232,8 +196,8 @@ subroutine routine_x_v_ij_erf_rk_cst_mu_j1b do i = 1, ao_num do j = 1, ao_num do m = 1, 3 - array(j,i,l,k) += x_v_ij_erf_rk_cst_mu_j1b_test(j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += x_v_ij_erf_rk_cst_mu_j1b (j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += x_v_ij_erf_rk_cst_mu_env_test(j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += x_v_ij_erf_rk_cst_mu_env (j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -258,7 +222,7 @@ subroutine routine_x_v_ij_erf_rk_cst_mu_j1b print*,'******' print*,'******' - print*,'routine_x_v_ij_erf_rk_cst_mu_j1b' + print*,'routine_x_v_ij_erf_rk_cst_mu_env' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -268,7 +232,7 @@ end -subroutine routine_v_ij_u_cst_mu_j1b_test +subroutine routine_v_ij_u_cst_mu_env_test implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -283,8 +247,8 @@ subroutine routine_v_ij_u_cst_mu_j1b_test do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += v_ij_u_cst_mu_j1b_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += v_ij_u_cst_mu_j1b_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += v_ij_u_cst_mu_env_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += v_ij_u_cst_mu_env_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -307,15 +271,13 @@ subroutine routine_v_ij_u_cst_mu_j1b_test enddo print*,'******' print*,'******' - print*,'routine_v_ij_u_cst_mu_j1b_test' + print*,'routine_v_ij_u_cst_mu_env_test' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 - - end -subroutine routine_int2_grad1u2_grad2u2_j1b2 +subroutine routine_int2_grad1u2_grad2u2_env2 implicit none integer :: i,j,ipoint,k,l integer :: ii , jj @@ -341,17 +303,17 @@ subroutine routine_int2_grad1u2_grad2u2_j1b2 do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight -! !array(j,i,l,k) += int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight -! array_ref(j,i,l,k) += int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += int2_grad1u2_grad2u2_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight +! !array(j,i,l,k) += int2_grad1u2_grad2u2_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight +! array_ref(j,i,l,k) += int2_grad1u2_grad2u2_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight ! !array(j,i,l,k) += ints(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight -! array_ref(j,i,l,k) += int2_grad1u2_grad2u2_j1b2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight +! array_ref(j,i,l,k) += int2_grad1u2_grad2u2_env2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight array_ref(j,i,l,k) += ints(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight -! if(dabs(int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint)).gt.1.d-6)then -! if(dabs(int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint)).gt.1.d-6)then +! if(dabs(int2_grad1u2_grad2u2_env2_test(j,i,ipoint)).gt.1.d-6)then +! if(dabs(int2_grad1u2_grad2u2_env2_test(j,i,ipoint) - int2_grad1u2_grad2u2_env2_test(j,i,ipoint)).gt.1.d-6)then ! print*,j,i,ipoint -! print*,int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) , int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint), dabs(int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint) - int2_grad1u2_grad2u2_j1b2_test(j,i,ipoint)) -! print*,int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint) , int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint), dabs(int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint) - int2_grad1u2_grad2u2_j1b2_test(i,j,ipoint)) +! print*,int2_grad1u2_grad2u2_env2_test(j,i,ipoint) , int2_grad1u2_grad2u2_env2_test(j,i,ipoint), dabs(int2_grad1u2_grad2u2_env2_test(j,i,ipoint) - int2_grad1u2_grad2u2_env2_test(j,i,ipoint)) +! print*,int2_grad1u2_grad2u2_env2_test(i,j,ipoint) , int2_grad1u2_grad2u2_env2_test(i,j,ipoint), dabs(int2_grad1u2_grad2u2_env2_test(i,j,ipoint) - int2_grad1u2_grad2u2_env2_test(i,j,ipoint)) ! stop ! endif ! endif @@ -394,7 +356,7 @@ subroutine routine_int2_grad1u2_grad2u2_j1b2 end -subroutine routine_int2_u2_j1b2 +subroutine routine_int2_u2_env2 implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -410,8 +372,8 @@ subroutine routine_int2_u2_j1b2 do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += int2_u2_j1b2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += int2_u2_j1b2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += int2_u2_env2_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += int2_u2_env2(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -434,7 +396,7 @@ subroutine routine_int2_u2_j1b2 enddo print*,'******' print*,'******' - print*,'routine_int2_u2_j1b2' + print*,'routine_int2_u2_env2' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -443,7 +405,7 @@ subroutine routine_int2_u2_j1b2 end -subroutine routine_int2_u_grad1u_x_j1b2 +subroutine routine_int2_u_grad1u_x_env2 implicit none integer :: i,j,ipoint,k,l,m double precision :: weight,accu_relat, accu_abs, contrib @@ -460,8 +422,8 @@ subroutine routine_int2_u_grad1u_x_j1b2 do i = 1, ao_num do j = 1, ao_num do m = 1, 3 - array(j,i,l,k) += int2_u_grad1u_x_j1b2_test(j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += int2_u_grad1u_x_j1b2 (j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += int2_u_grad1u_x_env2_test(j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += int2_u_grad1u_x_env2 (j,i,ipoint,m) * aos_grad_in_r_array_transp(m,k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -485,7 +447,7 @@ subroutine routine_int2_u_grad1u_x_j1b2 enddo print*,'******' print*,'******' - print*,'routine_int2_u_grad1u_x_j1b2' + print*,'routine_int2_u_grad1u_x_env2' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -493,7 +455,7 @@ subroutine routine_int2_u_grad1u_x_j1b2 end -subroutine routine_v_ij_u_cst_mu_j1b +subroutine routine_v_ij_u_cst_mu_env implicit none integer :: i,j,ipoint,k,l double precision :: weight,accu_relat, accu_abs, contrib @@ -509,8 +471,8 @@ subroutine routine_v_ij_u_cst_mu_j1b do l = 1, ao_num do i = 1, ao_num do j = 1, ao_num - array(j,i,l,k) += v_ij_u_cst_mu_j1b_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight - array_ref(j,i,l,k) += v_ij_u_cst_mu_j1b_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array(j,i,l,k) += v_ij_u_cst_mu_env_test(j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight + array_ref(j,i,l,k) += v_ij_u_cst_mu_env_fit (j,i,ipoint) * aos_in_r_array(k,ipoint) * aos_in_r_array(l,ipoint) * weight enddo enddo enddo @@ -533,7 +495,7 @@ subroutine routine_v_ij_u_cst_mu_j1b enddo print*,'******' print*,'******' - print*,'routine_v_ij_u_cst_mu_j1b' + print*,'routine_v_ij_u_cst_mu_env' print*,'accu_abs = ',accu_abs/dble(ao_num)**4 print*,'accu_relat = ',accu_relat/dble(ao_num)**4 @@ -674,66 +636,10 @@ subroutine test_fock_3e_uhf_mo() ! --- -end subroutine test_fock_3e_uhf_mo +end ! --- -subroutine test_total_grad_lapl - implicit none - integer :: i,j,ipoint,k,l - double precision :: weight,accu_relat, accu_abs, contrib - accu_relat = 0.d0 - accu_abs = 0.d0 - do k = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do j = 1, ao_num - contrib = dabs(tc_grad_and_lapl_ao_test(j,i,l,k) - tc_grad_and_lapl_ao(j,i,l,k)) - accu_abs += contrib - if(dabs(tc_grad_and_lapl_ao(j,i,l,k)).gt.1.d-10)then - accu_relat += contrib/dabs(tc_grad_and_lapl_ao(j,i,l,k)) - endif - enddo - enddo - enddo - enddo - print*,'******' - print*,'******' - print*,' test_total_grad_lapl' - print*,'accu_abs = ',accu_abs/dble(ao_num)**4 - print*,'accu_relat = ',accu_relat/dble(ao_num)**4 - - -end - -subroutine test_total_grad_square - implicit none - integer :: i,j,ipoint,k,l - double precision :: weight,accu_relat, accu_abs, contrib - accu_relat = 0.d0 - accu_abs = 0.d0 - do k = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do j = 1, ao_num - contrib = dabs(tc_grad_square_ao_test(j,i,l,k) - tc_grad_square_ao(j,i,l,k)) - accu_abs += contrib - if(dabs(tc_grad_square_ao(j,i,l,k)).gt.1.d-10)then - accu_relat += contrib/dabs(tc_grad_square_ao(j,i,l,k)) - endif - enddo - enddo - enddo - enddo - print*,'******' - print*,'******' - print*,'test_total_grad_square' - print*,'accu_abs = ',accu_abs/dble(ao_num)**4 - print*,'accu_relat = ',accu_relat/dble(ao_num)**4 - - -end - subroutine test_grid_points_ao implicit none integer :: i,j,ipoint,icount,icount_good, icount_bad,icount_full @@ -748,26 +654,26 @@ subroutine test_grid_points_ao icount_bad = 0 icount_full = 0 do ipoint = 1, n_points_final_grid -! if(dabs(int2_u_grad1u_x_j1b2_test(j,i,ipoint,1)) & -! + dabs(int2_u_grad1u_x_j1b2_test(j,i,ipoint,2)) & -! + dabs(int2_u_grad1u_x_j1b2_test(j,i,ipoint,3)) ) -! if(dabs(int2_u2_j1b2_test(j,i,ipoint)).gt.thr)then +! if(dabs(int2_u_grad1u_x_env2_test(j,i,ipoint,1)) & +! + dabs(int2_u_grad1u_x_env2_test(j,i,ipoint,2)) & +! + dabs(int2_u_grad1u_x_env2_test(j,i,ipoint,3)) ) +! if(dabs(int2_u2_env2_test(j,i,ipoint)).gt.thr)then ! icount += 1 ! endif - if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then + if(dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then icount_full += 1 endif - if(dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint)).gt.thr)then + if(dabs(v_ij_u_cst_mu_env_test(j,i,ipoint)).gt.thr)then icount += 1 - if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then + if(dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint)).gt.thr*0.1d0)then icount_good += 1 else print*,j,i,ipoint - print*,dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint)),dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)),dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint))/dabs(v_ij_u_cst_mu_j1b_test(j,i,ipoint)) + print*,dabs(v_ij_u_cst_mu_env_test(j,i,ipoint)), dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint)),dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint))/dabs(v_ij_u_cst_mu_env_test(j,i,ipoint)) icount_bad += 1 endif endif -! if(dabs(v_ij_u_cst_mu_j1b_ng_1_test(j,i,ipoint)).gt.thr)then +! if(dabs(v_ij_u_cst_mu_env_ng_1_test(j,i,ipoint)).gt.thr)then ! endif enddo print*,'' @@ -822,90 +728,6 @@ end ! --- -subroutine test_tc_grad_and_lapl_ao() - - implicit none - integer :: i, j, k, l - double precision :: diff_tot, diff, thr_ih, norm - - thr_ih = 1d-10 - - PROVIDE tc_grad_and_lapl_ao tc_grad_and_lapl_ao_loop - - norm = 0.d0 - diff_tot = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - - diff = dabs(tc_grad_and_lapl_ao_loop(l,k,j,i) - tc_grad_and_lapl_ao(l,k,j,i)) - if(diff .gt. thr_ih) then - print *, ' difference on ', l, k, j, i - print *, ' loops : ', tc_grad_and_lapl_ao_loop(l,k,j,i) - print *, ' lapack: ', tc_grad_and_lapl_ao (l,k,j,i) - !stop - endif - - norm += dabs(tc_grad_and_lapl_ao_loop(l,k,j,i)) - diff_tot += diff - enddo - enddo - enddo - enddo - - print *, ' diff tot = ', diff_tot / norm - print *, ' norm = ', norm - print *, ' ' - - return - -end - -! --- - -subroutine test_tc_grad_square_ao() - - implicit none - integer :: i, j, k, l - double precision :: diff_tot, diff, thr_ih, norm - - thr_ih = 1d-10 - - PROVIDE tc_grad_square_ao tc_grad_square_ao_loop - - norm = 0.d0 - diff_tot = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - - diff = dabs(tc_grad_square_ao_loop(l,k,j,i) - tc_grad_square_ao(l,k,j,i)) - if(diff .gt. thr_ih) then - print *, ' difference on ', l, k, j, i - print *, ' loops : ', tc_grad_square_ao_loop(l,k,j,i) - print *, ' lapack: ', tc_grad_square_ao (l,k,j,i) - !stop - endif - - norm += dabs(tc_grad_square_ao_loop(l,k,j,i)) - diff_tot += diff - enddo - enddo - enddo - enddo - - print *, ' diff tot = ', diff_tot / norm - print *, ' norm = ', norm - print *, ' ' - - return - -end - -! --- - subroutine test_two_e_tc_non_hermit_integral() implicit none @@ -973,88 +795,6 @@ end ! --- -subroutine test_tc_grad_square_ao_test() - - implicit none - integer :: i, j, k, l - double precision :: diff_tot, diff, thr_ih, norm - - print*, ' test_tc_grad_square_ao_test ' - - thr_ih = 1d-7 - - PROVIDE tc_grad_square_ao_test tc_grad_square_ao_test_ref - - norm = 0.d0 - diff_tot = 0.d0 - do i = 1, ao_num - do j = 1, ao_num - do k = 1, ao_num - do l = 1, ao_num - - - diff = dabs(tc_grad_square_ao_test(l,k,j,i) - tc_grad_square_ao_test_ref(l,k,j,i)) - if(diff .gt. thr_ih) then - print *, ' difference on ', l, k, j, i - print *, ' new : ', tc_grad_square_ao_test (l,k,j,i) - print *, ' ref : ', tc_grad_square_ao_test_ref(l,k,j,i) - !stop - endif - - norm += dabs(tc_grad_square_ao_test_ref(l,k,j,i)) - diff_tot += diff - enddo - enddo - enddo - enddo - - print *, ' diff tot = ', diff_tot / norm - print *, ' norm = ', norm - print *, ' ' - - return -end - -! --- - - - -subroutine test_old_ints - implicit none - integer :: i,j,k,l - double precision :: old, new, contrib, get_ao_tc_sym_two_e_pot - double precision :: integral_sym , integral_nsym,accu - PROVIDE ao_tc_sym_two_e_pot_in_map - accu = 0.d0 - do j = 1, ao_num - do l= 1, ao_num - do i = 1, ao_num - do k = 1, ao_num -! integral_sym = get_ao_tc_sym_two_e_pot(i, j, k, l, ao_tc_sym_two_e_pot_map) - ! ao_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the AO basis -! integral_nsym = ao_non_hermit_term_chemist(k,i,l,j) -! old = integral_sym + integral_nsym -! old = tc_grad_square_ao(k,i,l,j) + tc_grad_and_lapl_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) - new = ao_tc_int_chemist_test(k,i,l,j) - old = ao_tc_int_chemist_no_cycle(k,i,l,j) - contrib = dabs(old - new) - if(contrib.gt.1.d-6)then - print*,'problem !!' - print*,i,j,k,l - print*,old, new, contrib - endif - accu += contrib - enddo - enddo - enddo - enddo - print*,'******' - print*,'******' - print*,'in test_old_ints' - print*,'accu = ',accu/dble(ao_num**4) - -end - subroutine test_int2_grad1_u12_ao_test implicit none integer :: i,j,ipoint,m,k,l @@ -1146,7 +886,7 @@ subroutine test_fock_3e_uhf_mo_cs() print *, ' diff tot (%) = ', 100.d0 * diff_tot / norm return -end subroutine test_fock_3e_uhf_mo_cs +end ! --- @@ -1185,7 +925,7 @@ subroutine test_fock_3e_uhf_mo_a() print *, ' diff tot (%) = ', 100.d0 * diff_tot / norm return -end subroutine test_fock_3e_uhf_mo_a +end ! --- @@ -1224,7 +964,7 @@ subroutine test_fock_3e_uhf_mo_b() print *, ' diff tot (%) = ', 100.d0 * diff_tot / norm return -end subroutine test_fock_3e_uhf_mo_b +end ! --- diff --git a/src/tc_scf/three_e_energy_bi_ortho.irp.f b/plugins/local/tc_scf/three_e_energy_bi_ortho.irp.f similarity index 100% rename from src/tc_scf/three_e_energy_bi_ortho.irp.f rename to plugins/local/tc_scf/three_e_energy_bi_ortho.irp.f diff --git a/src/mo_localization/org/TANGLE_org_mode.sh b/scripts/TANGLE_org_mode.sh similarity index 100% rename from src/mo_localization/org/TANGLE_org_mode.sh rename to scripts/TANGLE_org_mode.sh diff --git a/scripts/qp_import_trexio.py b/scripts/qp_import_trexio.py index b3222601..9251a1b0 100755 --- a/scripts/qp_import_trexio.py +++ b/scripts/qp_import_trexio.py @@ -142,6 +142,7 @@ def write_ezfio(trexio_filename, filename): try: basis_type = trexio.read_basis_type(trexio_file) + print ("BASIS TYPE: ", basis_type.lower()) if basis_type.lower() in ["gaussian", "slater"]: shell_num = trexio.read_basis_shell_num(trexio_file) prim_num = trexio.read_basis_prim_num(trexio_file) diff --git a/src/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f b/src/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f deleted file mode 100644 index 21927371..00000000 --- a/src/ao_many_one_e_ints/grad2_jmu_modif_vect.irp.f +++ /dev/null @@ -1,453 +0,0 @@ -! -!! --- -! -!BEGIN_PROVIDER [ double precision, int2_grad1u2_grad2u2_j1b2, (ao_num, ao_num, n_points_final_grid)] -! -! BEGIN_DOC -! ! -! ! -\frac{1}{4} int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [1 - erf(mu r12)]^2 -! ! -! END_DOC -! -! implicit none -! integer :: i, j, ipoint, i_1s, i_fit -! integer :: i_mask_grid -! double precision :: r(3), expo_fit, coef_fit -! double precision :: coef, beta, B_center(3) -! double precision :: wall0, wall1 -! -! integer, allocatable :: n_mask_grid(:) -! double precision, allocatable :: r_mask_grid(:,:) -! double precision, allocatable :: int_fit_v(:) -! -! print*, ' providing int2_grad1u2_grad2u2_j1b2' -! -! provide mu_erf final_grid_points_transp j1b_pen -! call wall_time(wall0) -! -! int2_grad1u2_grad2u2_j1b2(:,:,:) = 0.d0 -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center,& -! !$OMP coef_fit, expo_fit, int_fit_v, n_mask_grid, & -! !$OMP i_mask_grid, r_mask_grid) & -! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size,& -! !$OMP final_grid_points_transp, n_max_fit_slat, & -! !$OMP expo_gauss_1_erf_x_2, coef_gauss_1_erf_x_2, & -! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & -! !$OMP List_all_comb_b3_cent, int2_grad1u2_grad2u2_j1b2, & -! !$OMP ao_overlap_abs) -! -! allocate(int_fit_v(n_points_final_grid)) -! allocate(n_mask_grid(n_points_final_grid)) -! allocate(r_mask_grid(n_points_final_grid,3)) -! -! !$OMP DO SCHEDULE(dynamic) -! do i = 1, ao_num -! do j = i, ao_num -! -! if(ao_overlap_abs(j,i) .lt. 1.d-12) then -! cycle -! endif -! -! do i_fit = 1, n_max_fit_slat -! -! expo_fit = expo_gauss_1_erf_x_2(i_fit) -! coef_fit = coef_gauss_1_erf_x_2(i_fit) * (-0.25d0) -! -! ! --- -! -! call overlap_gauss_r12_ao_v(final_grid_points_transp, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, n_points_final_grid) -! -! i_mask_grid = 0 ! dim -! n_mask_grid = 0 ! ind -! r_mask_grid = 0.d0 ! val -! do ipoint = 1, n_points_final_grid -! -! int2_grad1u2_grad2u2_j1b2(j,i,ipoint) += coef_fit * int_fit_v(ipoint) -! -! if(dabs(int_fit_v(ipoint)) .gt. 1d-10) then -! i_mask_grid += 1 -! n_mask_grid(i_mask_grid ) = ipoint -! r_mask_grid(i_mask_grid,1) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid,2) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid,3) = final_grid_points_transp(ipoint,3) -! endif -! -! enddo -! -! if(i_mask_grid .eq. 0) cycle -! -! ! --- -! -! do i_1s = 2, List_all_comb_b3_size -! -! coef = List_all_comb_b3_coef (i_1s) * coef_fit -! beta = List_all_comb_b3_expo (i_1s) -! B_center(1) = List_all_comb_b3_cent(1,i_1s) -! B_center(2) = List_all_comb_b3_cent(2,i_1s) -! B_center(3) = List_all_comb_b3_cent(3,i_1s) -! -! call overlap_gauss_r12_ao_with1s_v(B_center, beta, r_mask_grid, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, i_mask_grid) -! -! do ipoint = 1, i_mask_grid -! int2_grad1u2_grad2u2_j1b2(j,i,n_mask_grid(ipoint)) += coef * int_fit_v(ipoint) -! enddo -! -! enddo -! -! ! --- -! -! enddo -! enddo -! enddo -! !$OMP END DO -! -! deallocate(n_mask_grid) -! deallocate(r_mask_grid) -! deallocate(int_fit_v) -! -! !$OMP END PARALLEL -! -! do ipoint = 1, n_points_final_grid -! do i = 2, ao_num -! do j = 1, i-1 -! int2_grad1u2_grad2u2_j1b2(j,i,ipoint) = int2_grad1u2_grad2u2_j1b2(i,j,ipoint) -! enddo -! enddo -! enddo -! -! call wall_time(wall1) -! print*, ' wall time for int2_grad1u2_grad2u2_j1b2', wall1 - wall0 -! -!END_PROVIDER -! -!! --- -! -!BEGIN_PROVIDER [ double precision, int2_u2_j1b2, (ao_num, ao_num, n_points_final_grid)] -! -! BEGIN_DOC -! ! -! ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 [u_12^mu]^2 -! ! -! END_DOC -! -! implicit none -! integer :: i, j, ipoint, i_1s, i_fit -! integer :: i_mask_grid -! double precision :: r(3), expo_fit, coef_fit -! double precision :: coef, beta, B_center(3), tmp -! double precision :: wall0, wall1 -! -! integer, allocatable :: n_mask_grid(:) -! double precision, allocatable :: r_mask_grid(:,:) -! double precision, allocatable :: int_fit_v(:) -! -! print*, ' providing int2_u2_j1b2' -! -! provide mu_erf final_grid_points_transp j1b_pen -! call wall_time(wall0) -! -! int2_u2_j1b2(:,:,:) = 0.d0 -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, r, coef, beta, B_center, & -! !$OMP coef_fit, expo_fit, int_fit_v, & -! !$OMP i_mask_grid, n_mask_grid, r_mask_grid ) & -! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, & -! !$OMP final_grid_points_transp, n_max_fit_slat, & -! !$OMP expo_gauss_j_mu_x_2, coef_gauss_j_mu_x_2, & -! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & -! !$OMP List_all_comb_b3_cent, int2_u2_j1b2) -! -! allocate(n_mask_grid(n_points_final_grid)) -! allocate(r_mask_grid(n_points_final_grid,3)) -! allocate(int_fit_v(n_points_final_grid)) -! -! !$OMP DO SCHEDULE(dynamic) -! do i = 1, ao_num -! do j = i, ao_num -! -! do i_fit = 1, n_max_fit_slat -! -! expo_fit = expo_gauss_j_mu_x_2(i_fit) -! coef_fit = coef_gauss_j_mu_x_2(i_fit) -! -! ! --- -! -! call overlap_gauss_r12_ao_v(final_grid_points_transp, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, n_points_final_grid) -! -! i_mask_grid = 0 ! dim -! n_mask_grid = 0 ! ind -! r_mask_grid = 0.d0 ! val -! -! do ipoint = 1, n_points_final_grid -! int2_u2_j1b2(j,i,ipoint) += coef_fit * int_fit_v(ipoint) -! -! if(dabs(int_fit_v(ipoint)) .gt. 1d-10) then -! i_mask_grid += 1 -! n_mask_grid(i_mask_grid ) = ipoint -! r_mask_grid(i_mask_grid,1) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid,2) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid,3) = final_grid_points_transp(ipoint,3) -! endif -! enddo -! -! if(i_mask_grid .eq. 0) cycle -! -! ! --- -! -! do i_1s = 2, List_all_comb_b3_size -! -! coef = List_all_comb_b3_coef (i_1s) * coef_fit -! beta = List_all_comb_b3_expo (i_1s) -! B_center(1) = List_all_comb_b3_cent(1,i_1s) -! B_center(2) = List_all_comb_b3_cent(2,i_1s) -! B_center(3) = List_all_comb_b3_cent(3,i_1s) -! -! call overlap_gauss_r12_ao_with1s_v(B_center, beta, r_mask_grid, n_points_final_grid, expo_fit, i, j, int_fit_v, n_points_final_grid, i_mask_grid) -! -! do ipoint = 1, i_mask_grid -! int2_u2_j1b2(j,i,n_mask_grid(ipoint)) += coef * int_fit_v(ipoint) -! enddo -! -! enddo -! -! ! --- -! -! enddo -! enddo -! enddo -! !$OMP END DO -! -! deallocate(n_mask_grid) -! deallocate(r_mask_grid) -! deallocate(int_fit_v) -! -! !$OMP END PARALLEL -! -! do ipoint = 1, n_points_final_grid -! do i = 2, ao_num -! do j = 1, i-1 -! int2_u2_j1b2(j,i,ipoint) = int2_u2_j1b2(i,j,ipoint) -! enddo -! enddo -! enddo -! -! call wall_time(wall1) -! print*, ' wall time for int2_u2_j1b2', wall1 - wall0 -! -!END_PROVIDER -! -!! --- -! -!BEGIN_PROVIDER [ double precision, int2_u_grad1u_x_j1b2, (ao_num, ao_num, n_points_final_grid, 3)] -! -! BEGIN_DOC -! ! -! ! int dr2 phi_i(r2) phi_j(r2) 1s_j1b(r2)^2 u_12^mu [\grad_1 u_12^mu] r2 -! ! -! END_DOC -! -! implicit none -! -! integer :: i, j, ipoint, i_1s, i_fit -! integer :: i_mask_grid1, i_mask_grid2, i_mask_grid3, i_mask_grid(3) -! double precision :: x, y, z, expo_fit, coef_fit -! double precision :: coef, beta, B_center(3) -! double precision :: alpha_1s, alpha_1s_inv, expo_coef_1s -! double precision :: wall0, wall1 -! -! integer, allocatable :: n_mask_grid(:,:) -! double precision, allocatable :: r_mask_grid(:,:,:) -! double precision, allocatable :: int_fit_v(:,:), dist(:,:), centr_1s(:,:,:) -! -! print*, ' providing int2_u_grad1u_x_j1b2' -! -! provide mu_erf final_grid_points_transp j1b_pen -! call wall_time(wall0) -! -! int2_u_grad1u_x_j1b2(:,:,:,:) = 0.d0 -! -! !$OMP PARALLEL DEFAULT (NONE) & -! !$OMP PRIVATE (ipoint, i, j, i_1s, i_fit, x, y, z, coef, beta, & -! !$OMP coef_fit, expo_fit, int_fit_v, alpha_1s, dist, B_center,& -! !$OMP alpha_1s_inv, centr_1s, expo_coef_1s, & -! !$OMP i_mask_grid1, i_mask_grid2, i_mask_grid3, i_mask_grid, & -! !$OMP n_mask_grid, r_mask_grid) & -! !$OMP SHARED (n_points_final_grid, ao_num, List_all_comb_b3_size, & -! !$OMP final_grid_points_transp, n_max_fit_slat, & -! !$OMP expo_gauss_j_mu_1_erf, coef_gauss_j_mu_1_erf, & -! !$OMP List_all_comb_b3_coef, List_all_comb_b3_expo, & -! !$OMP List_all_comb_b3_cent, int2_u_grad1u_x_j1b2) -! -! allocate(dist(n_points_final_grid,3)) -! allocate(centr_1s(n_points_final_grid,3,3)) -! allocate(n_mask_grid(n_points_final_grid,3)) -! allocate(r_mask_grid(n_points_final_grid,3,3)) -! allocate(int_fit_v(n_points_final_grid,3)) -! -! !$OMP DO SCHEDULE(dynamic) -! do i = 1, ao_num -! do j = i, ao_num -! do i_fit = 1, n_max_fit_slat -! -! expo_fit = expo_gauss_j_mu_1_erf(i_fit) -! coef_fit = coef_gauss_j_mu_1_erf(i_fit) -! -! ! --- -! -! call NAI_pol_x_mult_erf_ao_with1s_v0(i, j, expo_fit, final_grid_points_transp, n_points_final_grid, 1.d+9, final_grid_points_transp, n_points_final_grid, int_fit_v, n_points_final_grid, n_points_final_grid) -! -! i_mask_grid1 = 0 ! dim -! i_mask_grid2 = 0 ! dim -! i_mask_grid3 = 0 ! dim -! n_mask_grid = 0 ! ind -! r_mask_grid = 0.d0 ! val -! do ipoint = 1, n_points_final_grid -! -! ! --- -! -! int2_u_grad1u_x_j1b2(j,i,ipoint,1) += coef_fit * int_fit_v(ipoint,1) -! -! if(dabs(int_fit_v(ipoint,1)) .gt. 1d-10) then -! i_mask_grid1 += 1 -! n_mask_grid(i_mask_grid1, 1) = ipoint -! r_mask_grid(i_mask_grid1,1,1) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid1,2,1) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid1,3,1) = final_grid_points_transp(ipoint,3) -! endif -! -! ! --- -! -! int2_u_grad1u_x_j1b2(j,i,ipoint,2) += coef_fit * int_fit_v(ipoint,2) -! -! if(dabs(int_fit_v(ipoint,2)) .gt. 1d-10) then -! i_mask_grid2 += 1 -! n_mask_grid(i_mask_grid2, 2) = ipoint -! r_mask_grid(i_mask_grid2,1,2) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid2,2,2) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid2,3,2) = final_grid_points_transp(ipoint,3) -! endif -! -! ! --- -! -! int2_u_grad1u_x_j1b2(j,i,ipoint,3) += coef_fit * int_fit_v(ipoint,3) -! -! if(dabs(int_fit_v(ipoint,3)) .gt. 1d-10) then -! i_mask_grid3 += 1 -! n_mask_grid(i_mask_grid3, 3) = ipoint -! r_mask_grid(i_mask_grid3,1,3) = final_grid_points_transp(ipoint,1) -! r_mask_grid(i_mask_grid3,2,3) = final_grid_points_transp(ipoint,2) -! r_mask_grid(i_mask_grid3,3,3) = final_grid_points_transp(ipoint,3) -! endif -! -! ! --- -! -! enddo -! -! if((i_mask_grid1+i_mask_grid2+i_mask_grid3) .eq. 0) cycle -! -! i_mask_grid(1) = i_mask_grid1 -! i_mask_grid(2) = i_mask_grid2 -! i_mask_grid(3) = i_mask_grid3 -! -! ! --- -! -! do i_1s = 2, List_all_comb_b3_size -! -! coef = List_all_comb_b3_coef (i_1s) * coef_fit -! beta = List_all_comb_b3_expo (i_1s) -! B_center(1) = List_all_comb_b3_cent(1,i_1s) -! B_center(2) = List_all_comb_b3_cent(2,i_1s) -! B_center(3) = List_all_comb_b3_cent(3,i_1s) -! -! alpha_1s = beta + expo_fit -! alpha_1s_inv = 1.d0 / alpha_1s -! expo_coef_1s = beta * expo_fit * alpha_1s_inv -! -! do ipoint = 1, i_mask_grid1 -! -! x = r_mask_grid(ipoint,1,1) -! y = r_mask_grid(ipoint,2,1) -! z = r_mask_grid(ipoint,3,1) -! -! centr_1s(ipoint,1,1) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x) -! centr_1s(ipoint,2,1) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y) -! centr_1s(ipoint,3,1) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z) -! -! dist(ipoint,1) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z) -! enddo -! -! do ipoint = 1, i_mask_grid2 -! -! x = r_mask_grid(ipoint,1,2) -! y = r_mask_grid(ipoint,2,2) -! z = r_mask_grid(ipoint,3,2) -! -! centr_1s(ipoint,1,2) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x) -! centr_1s(ipoint,2,2) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y) -! centr_1s(ipoint,3,2) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z) -! -! dist(ipoint,2) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z) -! enddo -! -! do ipoint = 1, i_mask_grid3 -! -! x = r_mask_grid(ipoint,1,3) -! y = r_mask_grid(ipoint,2,3) -! z = r_mask_grid(ipoint,3,3) -! -! centr_1s(ipoint,1,3) = alpha_1s_inv * (beta * B_center(1) + expo_fit * x) -! centr_1s(ipoint,2,3) = alpha_1s_inv * (beta * B_center(2) + expo_fit * y) -! centr_1s(ipoint,3,3) = alpha_1s_inv * (beta * B_center(3) + expo_fit * z) -! -! dist(ipoint,3) = (B_center(1) - x) * (B_center(1) - x) + (B_center(2) - y) * (B_center(2) - y) + (B_center(3) - z) * (B_center(3) - z) -! enddo -! -! call NAI_pol_x_mult_erf_ao_with1s_v(i, j, alpha_1s, centr_1s, n_points_final_grid, 1.d+9, r_mask_grid, n_points_final_grid, int_fit_v, n_points_final_grid, i_mask_grid) -! -! do ipoint = 1, i_mask_grid1 -! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,1),1) += coef * dexp(-expo_coef_1s * dist(ipoint,1)) * int_fit_v(ipoint,1) -! enddo -! -! do ipoint = 1, i_mask_grid2 -! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,2),2) += coef * dexp(-expo_coef_1s * dist(ipoint,2)) * int_fit_v(ipoint,2) -! enddo -! -! do ipoint = 1, i_mask_grid3 -! int2_u_grad1u_x_j1b2(j,i,n_mask_grid(ipoint,3),3) += coef * dexp(-expo_coef_1s * dist(ipoint,3)) * int_fit_v(ipoint,3) -! enddo -! -! enddo -! -! ! --- -! -! enddo -! enddo -! enddo -! !$OMP END DO -! -! deallocate(dist) -! deallocate(centr_1s) -! deallocate(n_mask_grid) -! deallocate(r_mask_grid) -! deallocate(int_fit_v) -! -! !$OMP END PARALLEL -! -! do ipoint = 1, n_points_final_grid -! do i = 2, ao_num -! do j = 1, i-1 -! int2_u_grad1u_x_j1b2(j,i,ipoint,1) = int2_u_grad1u_x_j1b2(i,j,ipoint,1) -! int2_u_grad1u_x_j1b2(j,i,ipoint,2) = int2_u_grad1u_x_j1b2(i,j,ipoint,2) -! int2_u_grad1u_x_j1b2(j,i,ipoint,3) = int2_u_grad1u_x_j1b2(i,j,ipoint,3) -! enddo -! enddo -! enddo -! -! call wall_time(wall1) -! print*, ' wall time for int2_u_grad1u_x_j1b2 =', wall1 - wall0 -! -!END_PROVIDER -! diff --git a/src/ao_many_one_e_ints/listj1b.irp.f b/src/ao_many_one_e_ints/listj1b.irp.f deleted file mode 100644 index 33ca8085..00000000 --- a/src/ao_many_one_e_ints/listj1b.irp.f +++ /dev/null @@ -1,366 +0,0 @@ - -! --- - -BEGIN_PROVIDER [integer, List_all_comb_b2_size] - - implicit none - - PROVIDE j1b_type - - if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then - - List_all_comb_b2_size = 2**nucl_num - - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then - - List_all_comb_b2_size = nucl_num + 1 - - else - - print *, 'j1b_type = ', j1b_type, 'is not implemented' - stop - - endif - - print *, ' nb of linear terms in the envelope is ', List_all_comb_b2_size - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [integer, List_all_comb_b2, (nucl_num, List_all_comb_b2_size)] - - implicit none - integer :: i, j - - if(nucl_num .gt. 32) then - print *, ' nucl_num = ', nucl_num, '> 32' - stop - endif - - List_all_comb_b2 = 0 - - do i = 0, List_all_comb_b2_size-1 - do j = 0, nucl_num-1 - if (btest(i,j)) then - List_all_comb_b2(j+1,i+1) = 1 - endif - enddo - enddo - -END_PROVIDER - -! --- - - BEGIN_PROVIDER [ double precision, List_all_comb_b2_coef, ( List_all_comb_b2_size)] -&BEGIN_PROVIDER [ double precision, List_all_comb_b2_expo, ( List_all_comb_b2_size)] -&BEGIN_PROVIDER [ double precision, List_all_comb_b2_cent, (3, List_all_comb_b2_size)] - - implicit none - integer :: i, j, k, phase - double precision :: tmp_alphaj, tmp_alphak - double precision :: tmp_cent_x, tmp_cent_y, tmp_cent_z - - provide j1b_pen - provide j1b_pen_coef - - List_all_comb_b2_coef = 0.d0 - List_all_comb_b2_expo = 0.d0 - List_all_comb_b2_cent = 0.d0 - - if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then - - do i = 1, List_all_comb_b2_size - - tmp_cent_x = 0.d0 - tmp_cent_y = 0.d0 - tmp_cent_z = 0.d0 - do j = 1, nucl_num - tmp_alphaj = dble(List_all_comb_b2(j,i)) * j1b_pen(j) - List_all_comb_b2_expo(i) += tmp_alphaj - tmp_cent_x += tmp_alphaj * nucl_coord(j,1) - tmp_cent_y += tmp_alphaj * nucl_coord(j,2) - tmp_cent_z += tmp_alphaj * nucl_coord(j,3) - enddo - - if(List_all_comb_b2_expo(i) .lt. 1d-10) cycle - - List_all_comb_b2_cent(1,i) = tmp_cent_x / List_all_comb_b2_expo(i) - List_all_comb_b2_cent(2,i) = tmp_cent_y / List_all_comb_b2_expo(i) - List_all_comb_b2_cent(3,i) = tmp_cent_z / List_all_comb_b2_expo(i) - enddo - - ! --- - - do i = 1, List_all_comb_b2_size - - do j = 2, nucl_num, 1 - tmp_alphaj = dble(List_all_comb_b2(j,i)) * j1b_pen(j) - do k = 1, j-1, 1 - tmp_alphak = dble(List_all_comb_b2(k,i)) * j1b_pen(k) - - List_all_comb_b2_coef(i) += tmp_alphaj * tmp_alphak * ( (nucl_coord(j,1) - nucl_coord(k,1)) * (nucl_coord(j,1) - nucl_coord(k,1)) & - + (nucl_coord(j,2) - nucl_coord(k,2)) * (nucl_coord(j,2) - nucl_coord(k,2)) & - + (nucl_coord(j,3) - nucl_coord(k,3)) * (nucl_coord(j,3) - nucl_coord(k,3)) ) - enddo - enddo - - if(List_all_comb_b2_expo(i) .lt. 1d-10) cycle - - List_all_comb_b2_coef(i) = List_all_comb_b2_coef(i) / List_all_comb_b2_expo(i) - enddo - - ! --- - - do i = 1, List_all_comb_b2_size - - phase = 0 - do j = 1, nucl_num - phase += List_all_comb_b2(j,i) - enddo - - List_all_comb_b2_coef(i) = (-1.d0)**dble(phase) * dexp(-List_all_comb_b2_coef(i)) - enddo - - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then - - List_all_comb_b2_coef( 1) = 1.d0 - List_all_comb_b2_expo( 1) = 0.d0 - List_all_comb_b2_cent(1:3,1) = 0.d0 - do i = 1, nucl_num - List_all_comb_b2_coef( i+1) = -1.d0 * j1b_pen_coef(i) - List_all_comb_b2_expo( i+1) = j1b_pen(i) - List_all_comb_b2_cent(1,i+1) = nucl_coord(i,1) - List_all_comb_b2_cent(2,i+1) = nucl_coord(i,2) - List_all_comb_b2_cent(3,i+1) = nucl_coord(i,3) - enddo - - else - - print *, 'j1b_type = ', j1b_type, 'is not implemented' - stop - - endif - - !print *, ' coeff, expo & cent of list b2' - !do i = 1, List_all_comb_b2_size - ! print*, i, List_all_comb_b2_coef(i), List_all_comb_b2_expo(i) - ! print*, List_all_comb_b2_cent(1,i), List_all_comb_b2_cent(2,i), List_all_comb_b2_cent(3,i) - !enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ integer, List_all_comb_b3_size] - - implicit none - double precision :: tmp - - if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then - - List_all_comb_b3_size = 3**nucl_num - - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then - - tmp = 0.5d0 * dble(nucl_num) * (dble(nucl_num) + 3.d0) - List_all_comb_b3_size = int(tmp) + 1 - - else - - print *, 'j1b_type = ', j1b_type, 'is not implemented' - stop - - endif - - print *, ' nb of linear terms in the square of the envelope is ', List_all_comb_b3_size - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [integer, List_all_comb_b3, (nucl_num, List_all_comb_b3_size)] - - implicit none - integer :: i, j, ii, jj - integer, allocatable :: M(:,:), p(:) - - if(nucl_num .gt. 32) then - print *, ' nucl_num = ', nucl_num, '> 32' - stop - endif - - List_all_comb_b3(:,:) = 0 - List_all_comb_b3(:,List_all_comb_b3_size) = 2 - - allocate(p(nucl_num)) - p = 0 - - do i = 2, List_all_comb_b3_size-1 - do j = 1, nucl_num - - ii = 0 - do jj = 1, j-1, 1 - ii = ii + p(jj) * 3**(jj-1) - enddo - p(j) = modulo(i-1-ii, 3**j) / 3**(j-1) - - List_all_comb_b3(j,i) = p(j) - enddo - enddo - -END_PROVIDER - -! --- - - BEGIN_PROVIDER [ double precision, List_all_comb_b3_coef, ( List_all_comb_b3_size)] -&BEGIN_PROVIDER [ double precision, List_all_comb_b3_expo, ( List_all_comb_b3_size)] -&BEGIN_PROVIDER [ double precision, List_all_comb_b3_cent, (3, List_all_comb_b3_size)] - - implicit none - integer :: i, j, k, phase - integer :: ii - double precision :: tmp_alphaj, tmp_alphak, facto - double precision :: tmp1, tmp2, tmp3, tmp4 - double precision :: xi, yi, zi, xj, yj, zj - double precision :: dx, dy, dz, r2 - - provide j1b_pen - provide j1b_pen_coef - - List_all_comb_b3_coef = 0.d0 - List_all_comb_b3_expo = 0.d0 - List_all_comb_b3_cent = 0.d0 - - if((j1b_type .eq. 3) .or. (j1b_type .eq. 103)) then - - do i = 1, List_all_comb_b3_size - - do j = 1, nucl_num - tmp_alphaj = dble(List_all_comb_b3(j,i)) * j1b_pen(j) - List_all_comb_b3_expo(i) += tmp_alphaj - List_all_comb_b3_cent(1,i) += tmp_alphaj * nucl_coord(j,1) - List_all_comb_b3_cent(2,i) += tmp_alphaj * nucl_coord(j,2) - List_all_comb_b3_cent(3,i) += tmp_alphaj * nucl_coord(j,3) - - enddo - - if(List_all_comb_b3_expo(i) .lt. 1d-10) cycle - ASSERT(List_all_comb_b3_expo(i) .gt. 0d0) - - List_all_comb_b3_cent(1,i) = List_all_comb_b3_cent(1,i) / List_all_comb_b3_expo(i) - List_all_comb_b3_cent(2,i) = List_all_comb_b3_cent(2,i) / List_all_comb_b3_expo(i) - List_all_comb_b3_cent(3,i) = List_all_comb_b3_cent(3,i) / List_all_comb_b3_expo(i) - enddo - - ! --- - - do i = 1, List_all_comb_b3_size - - do j = 2, nucl_num, 1 - tmp_alphaj = dble(List_all_comb_b3(j,i)) * j1b_pen(j) - do k = 1, j-1, 1 - tmp_alphak = dble(List_all_comb_b3(k,i)) * j1b_pen(k) - - List_all_comb_b3_coef(i) += tmp_alphaj * tmp_alphak * ( (nucl_coord(j,1) - nucl_coord(k,1)) * (nucl_coord(j,1) - nucl_coord(k,1)) & - + (nucl_coord(j,2) - nucl_coord(k,2)) * (nucl_coord(j,2) - nucl_coord(k,2)) & - + (nucl_coord(j,3) - nucl_coord(k,3)) * (nucl_coord(j,3) - nucl_coord(k,3)) ) - enddo - enddo - - if(List_all_comb_b3_expo(i) .lt. 1d-10) cycle - - List_all_comb_b3_coef(i) = List_all_comb_b3_coef(i) / List_all_comb_b3_expo(i) - enddo - - ! --- - - do i = 1, List_all_comb_b3_size - - facto = 1.d0 - phase = 0 - do j = 1, nucl_num - tmp_alphaj = dble(List_all_comb_b3(j,i)) - - facto *= 2.d0 / (gamma(tmp_alphaj+1.d0) * gamma(3.d0-tmp_alphaj)) - phase += List_all_comb_b3(j,i) - enddo - - List_all_comb_b3_coef(i) = (-1.d0)**dble(phase) * facto * dexp(-List_all_comb_b3_coef(i)) - enddo - - elseif((j1b_type .eq. 4) .or. (j1b_type .eq. 104)) then - - ii = 1 - List_all_comb_b3_coef( ii) = 1.d0 - List_all_comb_b3_expo( ii) = 0.d0 - List_all_comb_b3_cent(1:3,ii) = 0.d0 - - do i = 1, nucl_num - ii = ii + 1 - List_all_comb_b3_coef( ii) = -2.d0 * j1b_pen_coef(i) - List_all_comb_b3_expo( ii) = j1b_pen(i) - List_all_comb_b3_cent(1,ii) = nucl_coord(i,1) - List_all_comb_b3_cent(2,ii) = nucl_coord(i,2) - List_all_comb_b3_cent(3,ii) = nucl_coord(i,3) - enddo - - do i = 1, nucl_num - ii = ii + 1 - List_all_comb_b3_coef( ii) = 1.d0 * j1b_pen_coef(i) * j1b_pen_coef(i) - List_all_comb_b3_expo( ii) = 2.d0 * j1b_pen(i) - List_all_comb_b3_cent(1,ii) = nucl_coord(i,1) - List_all_comb_b3_cent(2,ii) = nucl_coord(i,2) - List_all_comb_b3_cent(3,ii) = nucl_coord(i,3) - enddo - - do i = 1, nucl_num-1 - - tmp1 = j1b_pen(i) - - xi = nucl_coord(i,1) - yi = nucl_coord(i,2) - zi = nucl_coord(i,3) - - do j = i+1, nucl_num - - tmp2 = j1b_pen(j) - tmp3 = tmp1 + tmp2 - tmp4 = 1.d0 / tmp3 - - xj = nucl_coord(j,1) - yj = nucl_coord(j,2) - zj = nucl_coord(j,3) - - dx = xi - xj - dy = yi - yj - dz = zi - zj - r2 = dx*dx + dy*dy + dz*dz - - ii = ii + 1 - ! x 2 to avoid doing integrals twice - List_all_comb_b3_coef( ii) = 2.d0 * dexp(-tmp1*tmp2*tmp4*r2) * j1b_pen_coef(i) * j1b_pen_coef(j) - List_all_comb_b3_expo( ii) = tmp3 - List_all_comb_b3_cent(1,ii) = tmp4 * (tmp1 * xi + tmp2 * xj) - List_all_comb_b3_cent(2,ii) = tmp4 * (tmp1 * yi + tmp2 * yj) - List_all_comb_b3_cent(3,ii) = tmp4 * (tmp1 * zi + tmp2 * zj) - enddo - enddo - - else - - print *, 'j1b_type = ', j1b_type, 'is not implemented' - stop - - endif - - !print *, ' coeff, expo & cent of list b3' - !do i = 1, List_all_comb_b3_size - ! print*, i, List_all_comb_b3_coef(i), List_all_comb_b3_expo(i) - ! print*, List_all_comb_b3_cent(1,i), List_all_comb_b3_cent(2,i), List_all_comb_b3_cent(3,i) - !enddo - -END_PROVIDER - -! --- - diff --git a/src/ao_many_one_e_ints/listj1b_sorted.irp.f b/src/ao_many_one_e_ints/listj1b_sorted.irp.f deleted file mode 100644 index 9bcce449..00000000 --- a/src/ao_many_one_e_ints/listj1b_sorted.irp.f +++ /dev/null @@ -1,181 +0,0 @@ - - BEGIN_PROVIDER [ integer, List_comb_thr_b2_size, (ao_num, ao_num)] -&BEGIN_PROVIDER [ integer, max_List_comb_thr_b2_size] - implicit none - integer :: i_1s,i,j,ipoint - double precision :: coef,beta,center(3),int_j1b - double precision :: r(3),weight,dist - List_comb_thr_b2_size = 0 - print*,'List_all_comb_b2_size = ',List_all_comb_b2_size -! pause - do i = 1, ao_num - do j = i, ao_num - do i_1s = 1, List_all_comb_b2_size - coef = List_all_comb_b2_coef (i_1s) - if(dabs(coef).lt.thrsh_cycle_tc)cycle - beta = List_all_comb_b2_expo (i_1s) - beta = max(beta,1.d-12) - center(1:3) = List_all_comb_b2_cent(1:3,i_1s) - int_j1b = 0.d0 - do ipoint = 1, n_points_extra_final_grid - r(1:3) = final_grid_points_extra(1:3,ipoint) - weight = final_weight_at_r_vector_extra(ipoint) - dist = ( center(1) - r(1) )*( center(1) - r(1) ) - dist += ( center(2) - r(2) )*( center(2) - r(2) ) - dist += ( center(3) - r(3) )*( center(3) - r(3) ) - int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight - enddo - if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then - List_comb_thr_b2_size(j,i) += 1 - endif - enddo - enddo - enddo - do i = 1, ao_num - do j = 1, i-1 - List_comb_thr_b2_size(j,i) = List_comb_thr_b2_size(i,j) - enddo - enddo - integer :: list(ao_num) - do i = 1, ao_num - list(i) = maxval(List_comb_thr_b2_size(:,i)) - enddo - max_List_comb_thr_b2_size = maxval(list) - print*,'max_List_comb_thr_b2_size = ',max_List_comb_thr_b2_size - -END_PROVIDER - - BEGIN_PROVIDER [ double precision, List_comb_thr_b2_coef, ( max_List_comb_thr_b2_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_expo, ( max_List_comb_thr_b2_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, List_comb_thr_b2_cent, (3, max_List_comb_thr_b2_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, ao_abs_comb_b2_j1b, ( max_List_comb_thr_b2_size ,ao_num, ao_num)] - implicit none - integer :: i_1s,i,j,ipoint,icount - double precision :: coef,beta,center(3),int_j1b - double precision :: r(3),weight,dist - ao_abs_comb_b2_j1b = 10000000.d0 - do i = 1, ao_num - do j = i, ao_num - icount = 0 - do i_1s = 1, List_all_comb_b2_size - coef = List_all_comb_b2_coef (i_1s) - if(dabs(coef).lt.thrsh_cycle_tc)cycle - beta = List_all_comb_b2_expo (i_1s) - center(1:3) = List_all_comb_b2_cent(1:3,i_1s) - int_j1b = 0.d0 - do ipoint = 1, n_points_extra_final_grid - r(1:3) = final_grid_points_extra(1:3,ipoint) - weight = final_weight_at_r_vector_extra(ipoint) - dist = ( center(1) - r(1) )*( center(1) - r(1) ) - dist += ( center(2) - r(2) )*( center(2) - r(2) ) - dist += ( center(3) - r(3) )*( center(3) - r(3) ) - int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight - enddo - if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then - icount += 1 - List_comb_thr_b2_coef(icount,j,i) = coef - List_comb_thr_b2_expo(icount,j,i) = beta - List_comb_thr_b2_cent(1:3,icount,j,i) = center(1:3) - ao_abs_comb_b2_j1b(icount,j,i) = int_j1b - endif - enddo - enddo - enddo - - do i = 1, ao_num - do j = 1, i-1 - do icount = 1, List_comb_thr_b2_size(j,i) - List_comb_thr_b2_coef(icount,j,i) = List_comb_thr_b2_coef(icount,i,j) - List_comb_thr_b2_expo(icount,j,i) = List_comb_thr_b2_expo(icount,i,j) - List_comb_thr_b2_cent(1:3,icount,j,i) = List_comb_thr_b2_cent(1:3,icount,i,j) - enddo - enddo - enddo - -END_PROVIDER - - - BEGIN_PROVIDER [ integer, List_comb_thr_b3_size, (ao_num, ao_num)] -&BEGIN_PROVIDER [ integer, max_List_comb_thr_b3_size] - implicit none - integer :: i_1s,i,j,ipoint - double precision :: coef,beta,center(3),int_j1b - double precision :: r(3),weight,dist - List_comb_thr_b3_size = 0 - print*,'List_all_comb_b3_size = ',List_all_comb_b3_size - do i = 1, ao_num - do j = 1, ao_num - do i_1s = 1, List_all_comb_b3_size - coef = List_all_comb_b3_coef (i_1s) - beta = List_all_comb_b3_expo (i_1s) - center(1:3) = List_all_comb_b3_cent(1:3,i_1s) - if(dabs(coef).lt.thrsh_cycle_tc)cycle - int_j1b = 0.d0 - do ipoint = 1, n_points_extra_final_grid - r(1:3) = final_grid_points_extra(1:3,ipoint) - weight = final_weight_at_r_vector_extra(ipoint) - dist = ( center(1) - r(1) )*( center(1) - r(1) ) - dist += ( center(2) - r(2) )*( center(2) - r(2) ) - dist += ( center(3) - r(3) )*( center(3) - r(3) ) - int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight - enddo - if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then - List_comb_thr_b3_size(j,i) += 1 - endif - enddo - enddo - enddo -! do i = 1, ao_num -! do j = 1, i-1 -! List_comb_thr_b3_size(j,i) = List_comb_thr_b3_size(i,j) -! enddo -! enddo - integer :: list(ao_num) - do i = 1, ao_num - list(i) = maxval(List_comb_thr_b3_size(:,i)) - enddo - max_List_comb_thr_b3_size = maxval(list) - print*,'max_List_comb_thr_b3_size = ',max_List_comb_thr_b3_size - -END_PROVIDER - - BEGIN_PROVIDER [ double precision, List_comb_thr_b3_coef, ( max_List_comb_thr_b3_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, List_comb_thr_b3_expo, ( max_List_comb_thr_b3_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, List_comb_thr_b3_cent, (3, max_List_comb_thr_b3_size,ao_num, ao_num )] -&BEGIN_PROVIDER [ double precision, ao_abs_comb_b3_j1b, ( max_List_comb_thr_b3_size ,ao_num, ao_num)] - implicit none - integer :: i_1s,i,j,ipoint,icount - double precision :: coef,beta,center(3),int_j1b - double precision :: r(3),weight,dist - ao_abs_comb_b3_j1b = 10000000.d0 - do i = 1, ao_num - do j = 1, ao_num - icount = 0 - do i_1s = 1, List_all_comb_b3_size - coef = List_all_comb_b3_coef (i_1s) - beta = List_all_comb_b3_expo (i_1s) - beta = max(beta,1.d-12) - center(1:3) = List_all_comb_b3_cent(1:3,i_1s) - if(dabs(coef).lt.thrsh_cycle_tc)cycle - int_j1b = 0.d0 - do ipoint = 1, n_points_extra_final_grid - r(1:3) = final_grid_points_extra(1:3,ipoint) - weight = final_weight_at_r_vector_extra(ipoint) - dist = ( center(1) - r(1) )*( center(1) - r(1) ) - dist += ( center(2) - r(2) )*( center(2) - r(2) ) - dist += ( center(3) - r(3) )*( center(3) - r(3) ) - int_j1b += dabs(aos_in_r_array_extra_transp(ipoint,i) * aos_in_r_array_extra_transp(ipoint,j))*dexp(-beta*dist) * weight - enddo - if(dabs(coef)*dabs(int_j1b).gt.thrsh_cycle_tc)then - icount += 1 - List_comb_thr_b3_coef(icount,j,i) = coef - List_comb_thr_b3_expo(icount,j,i) = beta - List_comb_thr_b3_cent(1:3,icount,j,i) = center(1:3) - ao_abs_comb_b3_j1b(icount,j,i) = int_j1b - endif - enddo - enddo - enddo - -END_PROVIDER - diff --git a/src/casscf_cipsi/casscf.irp.f b/src/casscf_cipsi/casscf.irp.f index ba4d8eea..addca236 100644 --- a/src/casscf_cipsi/casscf.irp.f +++ b/src/casscf_cipsi/casscf.irp.f @@ -58,8 +58,10 @@ subroutine run ! if(n_states == 1)then ! call ezfio_get_casscf_cipsi_energy_pt2(E_PT2) ! call ezfio_get_casscf_cipsi_energy(PT2) - call write_double(6,E_PT2(1:N_states),'E + PT2 energy = ') - call write_double(6,PT2(1:N_states),' PT2 = ') + do istate=1,N_states + call write_double(6,E_PT2(istate),'E + PT2 energy = ') + call write_double(6,PT2(istate),' PT2 = ') + enddo call write_double(6,pt2_max,' PT2_MAX = ') ! endif diff --git a/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f b/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f index 4b7b9cc9..d89aaadb 100644 --- a/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f +++ b/src/dav_general_mat/dav_ext_rout_nonsym_B1space.irp.f @@ -346,7 +346,7 @@ subroutine davidson_general_ext_rout_nonsym_b1space(u_in, H_jj, energies, sze, N endif if(i_omax(l) .ne. l) then - print *, ' !!! WARNONG !!!' + print *, ' !!! WARNING !!!' print *, ' index of state', l, i_omax(l) endif enddo diff --git a/src/determinants/density_matrix.irp.f b/src/determinants/density_matrix.irp.f index 46726df0..6ea6b051 100644 --- a/src/determinants/density_matrix.irp.f +++ b/src/determinants/density_matrix.irp.f @@ -445,7 +445,7 @@ END_PROVIDER mo_beta = one_e_dm_mo_beta_average(j,i) ! if(dabs(dm_mo).le.1.d-10)cycle one_e_dm_ao_alpha(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_alpha - one_e_dm_ao_beta(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_beta + one_e_dm_ao_beta(l,k) += mo_coef(k,i) * mo_coef(l,j) * mo_beta enddo enddo enddo @@ -453,6 +453,36 @@ END_PROVIDER END_PROVIDER + BEGIN_PROVIDER [ double precision, one_e_dm_ao_alpha_nstates, (ao_num,ao_num,N_states) ] +&BEGIN_PROVIDER [ double precision, one_e_dm_ao_beta_nstates, (ao_num,ao_num,N_states) ] + BEGIN_DOC + ! One body density matrix on the |AO| basis : $\rho_{AO}(\alpha), \rho_{AO}(\beta)$. + END_DOC + implicit none + integer :: i,j,k,l,istate + double precision :: mo_alpha,mo_beta + + one_e_dm_ao_alpha_nstates = 0.d0 + one_e_dm_ao_beta_nstates = 0.d0 + do istate = 1, N_states + do k = 1, ao_num + do l = 1, ao_num + do i = 1, mo_num + do j = 1, mo_num + mo_alpha = one_e_dm_mo_alpha(j,i,istate) + mo_beta = one_e_dm_mo_beta(j,i,istate) + ! if(dabs(dm_mo).le.1.d-10)cycle + one_e_dm_ao_alpha_nstates(l,k,istate) += mo_coef(k,i) * mo_coef(l,j) * mo_alpha + one_e_dm_ao_beta_nstates(l,k,istate) += mo_coef(k,i) * mo_coef(l,j) * mo_beta + enddo + enddo + enddo + enddo + enddo + +END_PROVIDER + + BEGIN_PROVIDER [ double precision, one_e_dm_ao, (ao_num, ao_num)] implicit none BEGIN_DOC diff --git a/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f b/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f index 39ea0cdf..dac7c1cc 100644 --- a/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f +++ b/src/dft_utils_in_r/ao_prod_mlti_pl.irp.f @@ -149,7 +149,3 @@ BEGIN_PROVIDER [ double precision, ao_prod_dist_grid, (ao_num, ao_num, n_points_ END_PROVIDER -!BEGIN_PROVIDER [ double precision, ao_abs_prod_j1b, (ao_num, ao_num)] -! implicit none -! -!END_PROVIDER diff --git a/src/hamiltonian/EZFIO.cfg b/src/hamiltonian/EZFIO.cfg index 672bfdfa..9b51c560 100644 --- a/src/hamiltonian/EZFIO.cfg +++ b/src/hamiltonian/EZFIO.cfg @@ -5,4 +5,3 @@ interface: ezfio,provider,ocaml default: 0.5 ezfio_name: mu_erf - diff --git a/src/hamiltonian/NEED b/src/hamiltonian/NEED index e69de29b..f1c051ff 100644 --- a/src/hamiltonian/NEED +++ b/src/hamiltonian/NEED @@ -0,0 +1,2 @@ +ezfio_files +nuclei diff --git a/src/hartree_fock/fock_matrix_hf.irp.f b/src/hartree_fock/fock_matrix_hf.irp.f index a5ab6a60..65b3d63c 100644 --- a/src/hartree_fock/fock_matrix_hf.irp.f +++ b/src/hartree_fock/fock_matrix_hf.irp.f @@ -174,7 +174,6 @@ END_PROVIDER allocate (X(cholesky_ao_num)) - ! X(j) = \sum_{mn} SCF_density_matrix_ao(m,n) * cholesky_ao(m,n,j) call dgemm('T','N',cholesky_ao_num,1,ao_num*ao_num,1.d0, & cholesky_ao, ao_num*ao_num, & diff --git a/src/hartree_fock/print_scf_int.irp.f b/src/hartree_fock/print_scf_int.irp.f new file mode 100644 index 00000000..ee7590f6 --- /dev/null +++ b/src/hartree_fock/print_scf_int.irp.f @@ -0,0 +1,114 @@ + +program print_scf_int + + call main() + +end + +subroutine main() + + implicit none + integer :: i, j, k, l + + print *, " Hcore:" + do j = 1, ao_num + do i = 1, ao_num + print *, i, j, ao_one_e_integrals(i,j) + enddo + enddo + + print *, " P:" + do j = 1, ao_num + do i = 1, ao_num + print *, i, j, SCF_density_matrix_ao_alpha(i,j) + enddo + enddo + + + double precision :: integ, density_a, density_b, density + double precision :: J_scf(ao_num, ao_num) + double precision :: K_scf(ao_num, ao_num) + + + double precision, external :: get_ao_two_e_integral + PROVIDE ao_integrals_map + + print *, " J:" + !do j = 1, ao_num + ! do l = 1, ao_num + ! do i = 1, ao_num + ! do k = 1, ao_num + ! ! < 1:k, 2:l | 1:i, 2:j > + ! print *, '< k l | i j >', k, l, i, j + ! print *, get_ao_two_e_integral(i, j, k, l, ao_integrals_map) + ! enddo + ! enddo + ! enddo + !enddo + + !do k = 1, ao_num + ! do i = 1, ao_num + ! do j = 1, ao_num + ! do l = 1, ao_num + ! ! ( 1:k, 1:i | 2:l, 2:j ) + ! print *, '(k i | l j)', k, i, l, j + ! print *, get_ao_two_e_integral(l, j, k, i, ao_integrals_map) + ! enddo + ! enddo + ! print *, '' + ! enddo + !enddo + + J_scf = 0.d0 + K_scf = 0.d0 + do i = 1, ao_num + do k = 1, ao_num + do j = 1, ao_num + do l = 1, ao_num + + density_a = SCF_density_matrix_ao_alpha(l,j) + density_b = SCF_density_matrix_ao_beta (l,j) + density = density_a + density_b + + integ = get_ao_two_e_integral(l, j, k, i, ao_integrals_map) + J_scf(k,i) += density * integ + integ = get_ao_two_e_integral(l, i, k, j, ao_integrals_map) + K_scf(k,i) -= density_a * integ + enddo + enddo + enddo + enddo + + print *, 'J x P' + do i = 1, ao_num + do k = 1, ao_num + print *, k, i, J_scf(k,i) + enddo + enddo + + print *, '' + print *, 'K x P' + do i = 1, ao_num + do k = 1, ao_num + print *, k, i, K_scf(k,i) + enddo + enddo + + print *, '' + print *, 'F in AO' + do i = 1, ao_num + do k = 1, ao_num + print *, k, i, Fock_matrix_ao(k,i) + enddo + enddo + + print *, '' + print *, 'F in MO' + do i = 1, ao_num + do k = 1, ao_num + print *, k, i, 2.d0 * Fock_matrix_mo_alpha(k,i) + enddo + enddo + +end + diff --git a/src/jastrow/README.md b/src/jastrow/README.md deleted file mode 100644 index aefb6ad5..00000000 --- a/src/jastrow/README.md +++ /dev/null @@ -1,3 +0,0 @@ -# Jastrow - -Information relative to the Jastrow factor in trans-correlated calculations. diff --git a/src/mo_optimization/org/TANGLE_org_mode.sh b/src/mo_optimization/org/TANGLE_org_mode.sh deleted file mode 100755 index 059cbe7d..00000000 --- a/src/mo_optimization/org/TANGLE_org_mode.sh +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh - -list='ls *.org' -for element in $list -do - emacs --batch $element -f org-babel-tangle -done diff --git a/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f index 1afc1f3c..a1910fd4 100644 --- a/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f +++ b/src/mo_two_e_ints/mo_bi_integrals_erf.irp.f @@ -31,37 +31,144 @@ BEGIN_PROVIDER [ logical, mo_two_e_integrals_erf_in_map ] PROVIDE mo_class - real :: map_mb - mo_two_e_integrals_erf_in_map = .True. if (read_mo_two_e_integrals_erf) then print*,'Reading the MO integrals_erf' call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints_erf',mo_integrals_erf_map) print*, 'MO integrals_erf provided' return - else - PROVIDE ao_two_e_integrals_erf_in_map endif - ! call four_index_transform_block(ao_integrals_erf_map,mo_integrals_erf_map, & - ! mo_coef, size(mo_coef,1), & - ! 1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, & - ! 1, 1, 1, 1, mo_num, mo_num, mo_num, mo_num) - call add_integrals_to_map_erf(full_ijkl_bitmask_4) - integer*8 :: get_mo_erf_map_size, mo_erf_map_size - mo_erf_map_size = get_mo_erf_map_size() + PROVIDE ao_two_e_integrals_erf_in_map -! print*,'Molecular integrals ERF provided:' -! print*,' Size of MO ERF map ', map_mb(mo_integrals_erf_map) ,'MB' -! print*,' Number of MO ERF integrals: ', mo_erf_map_size - if (write_mo_two_e_integrals_erf) then + print *, '' + print *, 'AO -> MO ERF integrals transformation' + print *, '-------------------------------------' + print *, '' + + call wall_time(wall_1) + call cpu_time(cpu_1) + + if (dble(ao_num)**4 * 32.d-9 < dble(qp_max_mem)) then + call four_idx_dgemm_erf + else + call add_integrals_to_map_erf(full_ijkl_bitmask_4) + endif + + call wall_time(wall_2) + call cpu_time(cpu_2) + + integer*8 :: get_mo_erf_map_size, mo_erf_map_size + mo_erf_map_size = get_mo_erf_map_size() + + double precision, external :: map_mb + print*,'Molecular integrals provided:' + print*,' Size of MO map ', map_mb(mo_integrals_erf_map) ,'MB' + print*,' Number of MO integrals: ', mo_erf_map_size + print*,' cpu time :',cpu_2 - cpu_1, 's' + print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')' + + if (write_mo_two_e_integrals_erf.and.mpi_master) then call ezfio_set_work_empty(.False.) call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_erf',mo_integrals_erf_map) - call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals_erf("Read") + call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals_erf('Read') endif END_PROVIDER +subroutine four_idx_dgemm_erf + implicit none + integer :: p,q,r,s,i,j,k,l + double precision, allocatable :: a1(:,:,:,:) + double precision, allocatable :: a2(:,:,:,:) + + if (ao_num > 1289) then + print *, irp_here, ': Integer overflow in ao_num**3' + endif + + allocate (a1(ao_num,ao_num,ao_num,ao_num)) + + print *, 'Getting AOs' + !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(q,r,s) + do s=1,ao_num + do r=1,ao_num + do q=1,ao_num + call get_ao_two_e_integrals_erf(q,r,s,ao_num,a1(1,q,r,s)) + enddo + enddo + enddo + !$OMP END PARALLEL DO + + + print *, '1st transformation' + ! 1st transformation + allocate (a2(ao_num,ao_num,ao_num,mo_num)) + call dgemm('T','N', (ao_num*ao_num*ao_num), mo_num, ao_num, 1.d0, a1, ao_num, mo_coef, ao_num, 0.d0, a2, (ao_num*ao_num*ao_num)) + + ! 2nd transformation + print *, '2nd transformation' + deallocate (a1) + allocate (a1(ao_num,ao_num,mo_num,mo_num)) + call dgemm('T','N', (ao_num*ao_num*mo_num), mo_num, ao_num, 1.d0, a2, ao_num, mo_coef, ao_num, 0.d0, a1, (ao_num*ao_num*mo_num)) + + ! 3rd transformation + print *, '3rd transformation' + deallocate (a2) + allocate (a2(ao_num,mo_num,mo_num,mo_num)) + call dgemm('T','N', (ao_num*mo_num*mo_num), mo_num, ao_num, 1.d0, a1, ao_num, mo_coef, ao_num, 0.d0, a2, (ao_num*mo_num*mo_num)) + + ! 4th transformation + print *, '4th transformation' + deallocate (a1) + allocate (a1(mo_num,mo_num,mo_num,mo_num)) + call dgemm('T','N', (mo_num*mo_num*mo_num), mo_num, ao_num, 1.d0, a2, ao_num, mo_coef, ao_num, 0.d0, a1, (mo_num*mo_num*mo_num)) + + deallocate (a2) + + integer :: n_integrals, size_buffer + integer(key_kind) , allocatable :: buffer_i(:) + real(integral_kind), allocatable :: buffer_value(:) + size_buffer = min(ao_num*ao_num*ao_num,16000000) + + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l,buffer_value,buffer_i,n_integrals) + allocate ( buffer_i(size_buffer), buffer_value(size_buffer) ) + + n_integrals = 0 + !$OMP DO + do l=1,mo_num + do k=1,mo_num + do j=1,l + do i=1,k + if (abs(a1(i,j,k,l)) < mo_integrals_threshold) then + cycle + endif + n_integrals += 1 + buffer_value(n_integrals) = a1(i,j,k,l) + !DIR$ FORCEINLINE + call mo_two_e_integrals_index(i,j,k,l,buffer_i(n_integrals)) + if (n_integrals == size_buffer) then + call map_append(mo_integrals_erf_map, buffer_i, buffer_value, n_integrals) + n_integrals = 0 + endif + enddo + enddo + enddo + enddo + !$OMP END DO + + call map_append(mo_integrals_erf_map, buffer_i, buffer_value, n_integrals) + + deallocate(buffer_i, buffer_value) + !$OMP END PARALLEL + + deallocate (a1) + + call map_sort(mo_integrals_erf_map) + call map_unique(mo_integrals_erf_map) + +end subroutine + + BEGIN_PROVIDER [ double precision, mo_two_e_int_erf_jj_from_ao, (mo_num,mo_num) ] &BEGIN_PROVIDER [ double precision, mo_two_e_int_erf_jj_exchange_from_ao, (mo_num,mo_num) ] diff --git a/src/mu_of_r/EZFIO.cfg b/src/mu_of_r/EZFIO.cfg index c774ec82..a66b00ef 100644 --- a/src/mu_of_r/EZFIO.cfg +++ b/src/mu_of_r/EZFIO.cfg @@ -6,7 +6,7 @@ size: (becke_numerical_grid.n_points_final_grid,determinants.n_states) [mu_of_r_potential] type: character*(32) -doc: type of potential for the mu(r) interaction: can be [ hf| cas_ful | cas_truncated | pure_act] +doc: type of potential for the mu(r) interaction: can be [ hf| cas_full | cas_truncated | pure_act] interface: ezfio, provider, ocaml default: hf diff --git a/src/mu_of_r/mu_of_r_conditions.irp.f b/src/mu_of_r/mu_of_r_conditions.irp.f index 959950a6..6b49b9df 100644 --- a/src/mu_of_r/mu_of_r_conditions.irp.f +++ b/src/mu_of_r/mu_of_r_conditions.irp.f @@ -26,7 +26,7 @@ do ipoint = 1, n_points_final_grid if(mu_of_r_potential.EQ."hf")then mu_of_r_prov(ipoint,istate) = mu_of_r_hf(ipoint) - else if(mu_of_r_potential.EQ."cas_ful".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then + else if(mu_of_r_potential.EQ."cas_full".or.mu_of_r_potential.EQ."cas_truncated".or.mu_of_r_potential.EQ."pure_act")then mu_of_r_prov(ipoint,istate) = mu_of_r_psi_cas(ipoint,istate) else print*,'you requested the following mu_of_r_potential' diff --git a/src/mu_of_r/test_proj_op.irp.f b/src/mu_of_r/test_proj_op.irp.f index 1d46da5e..f9aba094 100644 --- a/src/mu_of_r/test_proj_op.irp.f +++ b/src/mu_of_r/test_proj_op.irp.f @@ -9,7 +9,7 @@ program projected_operators ! orbitals coming from core no_core_density = .True. touch no_core_density - mu_of_r_potential = "cas_ful" + mu_of_r_potential = "cas_full" touch mu_of_r_potential print*,'Using Valence Only functions' ! call test_f_HF_valence_ab diff --git a/src/non_h_ints_mu/grad_squared.irp.f b/src/non_h_ints_mu/grad_squared.irp.f deleted file mode 100644 index 8c6d35dc..00000000 --- a/src/non_h_ints_mu/grad_squared.irp.f +++ /dev/null @@ -1,486 +0,0 @@ - -! --- - -! TODO : strong optmization : write the loops in a different way -! : for each couple of AO, the gaussian product are done once for all - -BEGIN_PROVIDER [ double precision, gradu_squared_u_ij_mu, (ao_num, ao_num, n_points_final_grid) ] - - BEGIN_DOC - ! - ! if J(r1,r2) = u12: - ! - ! gradu_squared_u_ij_mu = -0.50 x \int r2 [ (grad_1 u12)^2 + (grad_2 u12^2)] \phi_i(2) \phi_j(2) - ! = -0.25 x \int r2 (1 - erf(mu*r12))^2 \phi_i(2) \phi_j(2) - ! and - ! (1 - erf(mu*r12))^2 = \sum_i coef_gauss_1_erf_x_2(i) * exp(-expo_gauss_1_erf_x_2(i) * r12^2) - ! - ! if J(r1,r2) = u12 x v1 x v2 - ! - ! gradu_squared_u_ij_mu = -0.50 x \int r2 \phi_i(2) \phi_j(2) [ v1^2 v2^2 ((grad_1 u12)^2 + (grad_2 u12^2)) + u12^2 v2^2 (grad_1 v1)^2 + 2 u12 v1 v2^2 (grad_1 u12) . (grad_1 v1) ] - ! = -0.25 x v1^2 \int r2 \phi_i(2) \phi_j(2) [1 - erf(mu r12)]^2 v2^2 - ! + -0.50 x (grad_1 v1)^2 \int r2 \phi_i(2) \phi_j(2) u12^2 v2^2 - ! + -1.00 x v1 (grad_1 v1) \int r2 \phi_i(2) \phi_j(2) (grad_1 u12) v2^2 - ! = v1^2 x int2_grad1u2_grad2u2_j1b2 - ! + -0.5 x (grad_1 v1)^2 x int2_u2_j1b2 - ! + -1.0 X V1 x (grad_1 v1) \cdot [ int2_u_grad1u_j1b2 x r - int2_u_grad1u_x_j1b ] - ! - ! - END_DOC - - implicit none - integer :: ipoint, i, j, m, igauss - double precision :: x, y, z, r(3), delta, coef - double precision :: tmp_v, tmp_x, tmp_y, tmp_z - double precision :: tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9 - double precision :: time0, time1 - double precision, external :: overlap_gauss_r12_ao - - print*, ' providing gradu_squared_u_ij_mu ...' - call wall_time(time0) - - PROVIDE j1b_type - - if(j1b_type .eq. 3) then - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - tmp_v = v_1b (ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) - - tmp1 = tmp_v * tmp_v - tmp2 = -0.5d0 * (tmp_x * tmp_x + tmp_y * tmp_y + tmp_z * tmp_z) - tmp3 = tmp_v * tmp_x - tmp4 = tmp_v * tmp_y - tmp5 = tmp_v * tmp_z - - tmp6 = -x * tmp3 - tmp7 = -y * tmp4 - tmp8 = -z * tmp5 - - do j = 1, ao_num - do i = 1, ao_num - - tmp9 = int2_u_grad1u_j1b2(i,j,ipoint) - - gradu_squared_u_ij_mu(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_j1b2(i,j,ipoint) & - + tmp2 * int2_u2_j1b2 (i,j,ipoint) & - + tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_j1b2(i,j,ipoint,1) & - + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_j1b2(i,j,ipoint,2) & - + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_j1b2(i,j,ipoint,3) - enddo - enddo - enddo - - else - - gradu_squared_u_ij_mu = 0.d0 - do ipoint = 1, n_points_final_grid - r(1) = final_grid_points(1,ipoint) - r(2) = final_grid_points(2,ipoint) - r(3) = final_grid_points(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - do igauss = 1, n_max_fit_slat - delta = expo_gauss_1_erf_x_2(igauss) - coef = coef_gauss_1_erf_x_2(igauss) - gradu_squared_u_ij_mu(i,j,ipoint) += -0.25d0 * coef * overlap_gauss_r12_ao(r, delta, i, j) - enddo - enddo - enddo - enddo - - endif - - call wall_time(time1) - print*, ' Wall time for gradu_squared_u_ij_mu = ', time1 - time0 - -END_PROVIDER - -! --- - -!BEGIN_PROVIDER [double precision, tc_grad_square_ao_loop, (ao_num, ao_num, ao_num, ao_num)] -! -! BEGIN_DOC -! ! -! ! tc_grad_square_ao_loop(k,i,l,j) = -1/2 -! ! -! END_DOC -! -! implicit none -! integer :: ipoint, i, j, k, l -! double precision :: weight1, ao_ik_r, ao_i_r -! double precision, allocatable :: ac_mat(:,:,:,:) -! -! allocate(ac_mat(ao_num,ao_num,ao_num,ao_num)) -! ac_mat = 0.d0 -! -! do ipoint = 1, n_points_final_grid -! weight1 = final_weight_at_r_vector(ipoint) -! -! do i = 1, ao_num -! ao_i_r = weight1 * aos_in_r_array_transp(ipoint,i) -! -! do k = 1, ao_num -! ao_ik_r = ao_i_r * aos_in_r_array_transp(ipoint,k) -! -! do j = 1, ao_num -! do l = 1, ao_num -! ac_mat(k,i,l,j) += ao_ik_r * gradu_squared_u_ij_mu(l,j,ipoint) -! enddo -! enddo -! enddo -! enddo -! enddo -! -! do j = 1, ao_num -! do l = 1, ao_num -! do i = 1, ao_num -! do k = 1, ao_num -! tc_grad_square_ao_loop(k,i,l,j) = ac_mat(k,i,l,j) + ac_mat(l,j,k,i) -! !write(11,*) tc_grad_square_ao_loop(k,i,l,j) -! enddo -! enddo -! enddo -! enddo -! -! deallocate(ac_mat) -! -!END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, tc_grad_square_ao_loop, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! tc_grad_square_ao_loop(k,i,l,j) = 1/2 - ! - END_DOC - - implicit none - integer :: ipoint, i, j, k, l - double precision :: weight1, ao_ik_r, ao_i_r - double precision :: time0, time1 - double precision, allocatable :: ac_mat(:,:,:,:), bc_mat(:,:,:,:) - - print*, ' providing tc_grad_square_ao_loop ...' - call wall_time(time0) - - allocate(ac_mat(ao_num,ao_num,ao_num,ao_num)) - ac_mat = 0.d0 - allocate(bc_mat(ao_num,ao_num,ao_num,ao_num)) - bc_mat = 0.d0 - - do ipoint = 1, n_points_final_grid - weight1 = final_weight_at_r_vector(ipoint) - - do i = 1, ao_num - !ao_i_r = weight1 * aos_in_r_array_transp(ipoint,i) - ao_i_r = weight1 * aos_in_r_array(i,ipoint) - - do k = 1, ao_num - !ao_ik_r = ao_i_r * aos_in_r_array_transp(ipoint,k) - ao_ik_r = ao_i_r * aos_in_r_array(k,ipoint) - - do j = 1, ao_num - do l = 1, ao_num - ac_mat(k,i,l,j) += ao_ik_r * ( u12sq_j1bsq(l,j,ipoint) + u12_grad1_u12_j1b_grad1_j1b(l,j,ipoint) ) - bc_mat(k,i,l,j) += ao_ik_r * grad12_j12(l,j,ipoint) - enddo - enddo - enddo - enddo - enddo - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - tc_grad_square_ao_loop(k,i,l,j) = ac_mat(k,i,l,j) + ac_mat(l,j,k,i) + bc_mat(k,i,l,j) - enddo - enddo - enddo - enddo - - deallocate(ac_mat) - deallocate(bc_mat) - - call wall_time(time1) - print*, ' Wall time for tc_grad_square_ao_loop = ', time1 - time0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, grad12_j12, (ao_num, ao_num, n_points_final_grid) ] - - implicit none - integer :: ipoint, i, j, m, igauss - double precision :: r(3), delta, coef - double precision :: tmp1 - double precision :: time0, time1 - double precision, external :: overlap_gauss_r12_ao - - print*, ' providing grad12_j12 ...' - call wall_time(time0) - - PROVIDE j1b_type - PROVIDE int2_grad1u2_grad2u2_j1b2 - - do ipoint = 1, n_points_final_grid - tmp1 = v_1b(ipoint) - tmp1 = tmp1 * tmp1 - do j = 1, ao_num - do i = 1, ao_num - grad12_j12(i,j,ipoint) = tmp1 * int2_grad1u2_grad2u2_j1b2(i,j,ipoint) - enddo - enddo - enddo - - FREE int2_grad1u2_grad2u2_j1b2 - - !if(j1b_type .eq. 0) then - ! grad12_j12 = 0.d0 - ! do ipoint = 1, n_points_final_grid - ! r(1) = final_grid_points(1,ipoint) - ! r(2) = final_grid_points(2,ipoint) - ! r(3) = final_grid_points(3,ipoint) - ! do j = 1, ao_num - ! do i = 1, ao_num - ! do igauss = 1, n_max_fit_slat - ! delta = expo_gauss_1_erf_x_2(igauss) - ! coef = coef_gauss_1_erf_x_2(igauss) - ! grad12_j12(i,j,ipoint) += -0.25d0 * coef * overlap_gauss_r12_ao(r, delta, i, j) - ! enddo - ! enddo - ! enddo - ! enddo - !endif - - call wall_time(time1) - print*, ' Wall time for grad12_j12 = ', time1 - time0 - call print_memory_usage() - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, u12sq_j1bsq, (ao_num, ao_num, n_points_final_grid)] - - implicit none - integer :: ipoint, i, j - double precision :: tmp_x, tmp_y, tmp_z - double precision :: tmp1 - double precision :: time0, time1 - - print*, ' providing u12sq_j1bsq ...' - call wall_time(time0) - - ! do not free here - PROVIDE int2_u2_j1b2 - - do ipoint = 1, n_points_final_grid - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) - tmp1 = -0.5d0 * (tmp_x * tmp_x + tmp_y * tmp_y + tmp_z * tmp_z) - do j = 1, ao_num - do i = 1, ao_num - u12sq_j1bsq(i,j,ipoint) = tmp1 * int2_u2_j1b2(i,j,ipoint) - enddo - enddo - enddo - - call wall_time(time1) - print*, ' Wall time for u12sq_j1bsq = ', time1 - time0 - call print_memory_usage() - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, u12_grad1_u12_j1b_grad1_j1b, (ao_num, ao_num, n_points_final_grid) ] - - implicit none - integer :: ipoint, i, j, m, igauss - double precision :: x, y, z - double precision :: tmp_v, tmp_x, tmp_y, tmp_z - double precision :: tmp3, tmp4, tmp5, tmp6, tmp7, tmp8, tmp9 - double precision :: time0, time1 - double precision, external :: overlap_gauss_r12_ao - - print*, ' providing u12_grad1_u12_j1b_grad1_j1b ...' - call wall_time(time0) - - PROVIDE int2_u_grad1u_j1b2 - PROVIDE int2_u_grad1u_x_j1b2 - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - tmp_v = v_1b (ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) - - tmp3 = tmp_v * tmp_x - tmp4 = tmp_v * tmp_y - tmp5 = tmp_v * tmp_z - - tmp6 = -x * tmp3 - tmp7 = -y * tmp4 - tmp8 = -z * tmp5 - - do j = 1, ao_num - do i = 1, ao_num - - tmp9 = int2_u_grad1u_j1b2(i,j,ipoint) - - u12_grad1_u12_j1b_grad1_j1b(i,j,ipoint) = tmp6 * tmp9 + tmp3 * int2_u_grad1u_x_j1b2(i,j,ipoint,1) & - + tmp7 * tmp9 + tmp4 * int2_u_grad1u_x_j1b2(i,j,ipoint,2) & - + tmp8 * tmp9 + tmp5 * int2_u_grad1u_x_j1b2(i,j,ipoint,3) - enddo - enddo - enddo - - FREE int2_u_grad1u_j1b2 - FREE int2_u_grad1u_x_j1b2 - - call wall_time(time1) - print*, ' Wall time for u12_grad1_u12_j1b_grad1_j1b = ', time1 - time0 - call print_memory_usage() - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, tc_grad_square_ao, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! tc_grad_square_ao(k,i,l,j) = -1/2 - ! - END_DOC - - implicit none - integer :: ipoint, i, j, k, l - double precision :: weight1, ao_k_r, ao_i_r - double precision :: der_envsq_x, der_envsq_y, der_envsq_z, lap_envsq - double precision :: time0, time1 - double precision, allocatable :: b_mat(:,:,:), tmp(:,:,:) - - print*, ' providing tc_grad_square_ao ...' - call wall_time(time0) - - if(read_tc_integ) then - - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_square_ao', action="read") - read(11) tc_grad_square_ao - close(11) - - else - - ! --- - - PROVIDE int2_grad1_u12_square_ao - - allocate(b_mat(n_points_final_grid,ao_num,ao_num)) - - b_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint) & - !$OMP SHARED (aos_in_r_array_transp, b_mat, ao_num, n_points_final_grid, final_weight_at_r_vector) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - b_mat(ipoint,k,i) = final_weight_at_r_vector(ipoint) * aos_in_r_array_transp(ipoint,i) * aos_in_r_array_transp(ipoint,k) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - tc_grad_square_ao = 0.d0 - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_grad1_u12_square_ao(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & - , 0.d0, tc_grad_square_ao, ao_num*ao_num) - - FREE int2_grad1_u12_square_ao - - ! --- - - if(((j1b_type .eq. 3) .or. (j1b_type .eq. 4)) .and. use_ipp) then - - print*, " going through Manu's IPP" - - ! an additional term is added here directly instead of - ! being added in int2_grad1_u12_square_ao for performance - - PROVIDE int2_u2_j1b2 - - b_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & - !$OMP SHARED (aos_in_r_array_transp, b_mat, ao_num, n_points_final_grid, final_weight_at_r_vector, & - !$OMP v_1b_square_grad, v_1b_square_lapl, aos_grad_in_r_array_transp_bis) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - - weight1 = 0.25d0 * final_weight_at_r_vector(ipoint) - - ao_i_r = aos_in_r_array_transp(ipoint,i) - ao_k_r = aos_in_r_array_transp(ipoint,k) - - b_mat(ipoint,k,i) = weight1 * ( ao_k_r * ao_i_r * v_1b_square_lapl(ipoint) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) * v_1b_square_grad(ipoint,1) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) * v_1b_square_grad(ipoint,2) & - + (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) + ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) * v_1b_square_grad(ipoint,3) ) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_u2_j1b2(1,1,1), ao_num*ao_num, b_mat(1,1,1), n_points_final_grid & - , 1.d0, tc_grad_square_ao, ao_num*ao_num) - - FREE int2_u2_j1b2 - endif - - ! --- - - deallocate(b_mat) - call sum_A_At(tc_grad_square_ao(1,1,1,1), ao_num*ao_num) - - endif - - if(write_tc_integ.and.mpi_master) then - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_square_ao', action="write") - call ezfio_set_work_empty(.False.) - write(11) tc_grad_square_ao - close(11) - call ezfio_set_tc_keywords_io_tc_integ('Read') - endif - - call wall_time(time1) - print*, ' Wall time for tc_grad_square_ao = ', time1 - time0 - call print_memory_usage() - -END_PROVIDER - -! --- - diff --git a/src/non_h_ints_mu/j12_nucl_utils.irp.f b/src/non_h_ints_mu/j12_nucl_utils.irp.f deleted file mode 100644 index 7dd13f14..00000000 --- a/src/non_h_ints_mu/j12_nucl_utils.irp.f +++ /dev/null @@ -1,773 +0,0 @@ - -! --- - -BEGIN_PROVIDER [ double precision, v_1b, (n_points_final_grid)] - - implicit none - integer :: ipoint, i, j, phase - double precision :: x, y, z, dx, dy, dz - double precision :: a, d, e, fact_r - - if(j1b_type .eq. 3) then - - ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_r = 1.d0 - do j = 1, nucl_num - a = j1b_pen(j) - dx = x - nucl_coord(j,1) - dy = y - nucl_coord(j,2) - dz = z - nucl_coord(j,3) - d = dx*dx + dy*dy + dz*dz - e = 1.d0 - dexp(-a*d) - - fact_r = fact_r * e - enddo - - v_1b(ipoint) = fact_r - enddo - - elseif(j1b_type .eq. 4) then - - ! v(r) = 1 - \sum_{a} \beta_a \exp(-\alpha_a (r - r_a)^2) - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_r = 1.d0 - do j = 1, nucl_num - a = j1b_pen(j) - dx = x - nucl_coord(j,1) - dy = y - nucl_coord(j,2) - dz = z - nucl_coord(j,3) - d = dx*dx + dy*dy + dz*dz - - fact_r = fact_r - j1b_pen_coef(j) * dexp(-a*d) - enddo - - v_1b(ipoint) = fact_r - enddo - - else - - print*, 'j1b_type = ', j1b_type, 'is not implemented for v_1b' - stop - - endif - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, v_1b_grad, (3, n_points_final_grid)] - - implicit none - integer :: ipoint, i, j, phase - double precision :: x, y, z, dx, dy, dz, r2 - double precision :: a, d, e - double precision :: fact_x, fact_y, fact_z - double precision :: ax_der, ay_der, az_der, a_expo - - PROVIDE j1b_type - - if(j1b_type .eq. 3) then - - ! v(r) = \Pi_{a} [1 - \exp(-\alpha_a (r - r_a)^2)] - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_x = 0.d0 - fact_y = 0.d0 - fact_z = 0.d0 - do i = 1, List_all_comb_b2_size - - phase = 0 - a_expo = 0.d0 - ax_der = 0.d0 - ay_der = 0.d0 - az_der = 0.d0 - do j = 1, nucl_num - a = dble(List_all_comb_b2(j,i)) * j1b_pen(j) - dx = x - nucl_coord(j,1) - dy = y - nucl_coord(j,2) - dz = z - nucl_coord(j,3) - - phase += List_all_comb_b2(j,i) - a_expo += a * (dx*dx + dy*dy + dz*dz) - ax_der += a * dx - ay_der += a * dy - az_der += a * dz - enddo - e = -2.d0 * (-1.d0)**dble(phase) * dexp(-a_expo) - - fact_x += e * ax_der - fact_y += e * ay_der - fact_z += e * az_der - enddo - - v_1b_grad(1,ipoint) = fact_x - v_1b_grad(2,ipoint) = fact_y - v_1b_grad(3,ipoint) = fact_z - enddo - - elseif(j1b_type .eq. 4) then - - ! v(r) = 1 - \sum_{a} \beta_a \exp(-\alpha_a (r - r_a)^2) - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - ax_der = 0.d0 - ay_der = 0.d0 - az_der = 0.d0 - do j = 1, nucl_num - - dx = x - nucl_coord(j,1) - dy = y - nucl_coord(j,2) - dz = z - nucl_coord(j,3) - r2 = dx*dx + dy*dy + dz*dz - - a = j1b_pen(j) - e = a * j1b_pen_coef(j) * dexp(-a * r2) - - ax_der += e * dx - ay_der += e * dy - az_der += e * dz - enddo - - v_1b_grad(1,ipoint) = 2.d0 * ax_der - v_1b_grad(2,ipoint) = 2.d0 * ay_der - v_1b_grad(3,ipoint) = 2.d0 * az_der - enddo - - else - - print*, 'j1b_type = ', j1b_type, 'is not implemented' - stop - - endif - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, v_1b_lapl, (n_points_final_grid)] - - implicit none - integer :: ipoint, i, j, phase - double precision :: x, y, z, dx, dy, dz - double precision :: a, e, b - double precision :: fact_r - double precision :: ax_der, ay_der, az_der, a_expo - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_r = 0.d0 - do i = 1, List_all_comb_b2_size - - phase = 0 - b = 0.d0 - a_expo = 0.d0 - ax_der = 0.d0 - ay_der = 0.d0 - az_der = 0.d0 - do j = 1, nucl_num - a = dble(List_all_comb_b2(j,i)) * j1b_pen(j) - dx = x - nucl_coord(j,1) - dy = y - nucl_coord(j,2) - dz = z - nucl_coord(j,3) - - phase += List_all_comb_b2(j,i) - b += a - a_expo += a * (dx*dx + dy*dy + dz*dz) - ax_der += a * dx - ay_der += a * dy - az_der += a * dz - enddo - - fact_r += (-1.d0)**dble(phase) * (-6.d0*b + 4.d0*(ax_der*ax_der + ay_der*ay_der + az_der*az_der) ) * dexp(-a_expo) - enddo - - v_1b_lapl(ipoint) = fact_r - enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, v_1b_list_b2, (n_points_final_grid)] - - implicit none - integer :: i, ipoint - double precision :: x, y, z, coef, expo, dx, dy, dz - double precision :: fact_r - - PROVIDE List_all_comb_b2_coef List_all_comb_b2_expo List_all_comb_b2_cent - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_r = 0.d0 - do i = 1, List_all_comb_b2_size - - coef = List_all_comb_b2_coef(i) - expo = List_all_comb_b2_expo(i) - - dx = x - List_all_comb_b2_cent(1,i) - dy = y - List_all_comb_b2_cent(2,i) - dz = z - List_all_comb_b2_cent(3,i) - - fact_r += coef * dexp(-expo * (dx*dx + dy*dy + dz*dz)) - enddo - - v_1b_list_b2(ipoint) = fact_r - enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, v_1b_list_b3, (n_points_final_grid)] - - implicit none - integer :: i, ipoint - double precision :: x, y, z, coef, expo, dx, dy, dz - double precision :: fact_r - - PROVIDE List_all_comb_b3_coef List_all_comb_b3_expo List_all_comb_b3_cent - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_r = 0.d0 - do i = 1, List_all_comb_b3_size - - coef = List_all_comb_b3_coef(i) - expo = List_all_comb_b3_expo(i) - - dx = x - List_all_comb_b3_cent(1,i) - dy = y - List_all_comb_b3_cent(2,i) - dz = z - List_all_comb_b3_cent(3,i) - - fact_r += coef * dexp(-expo * (dx*dx + dy*dy + dz*dz)) - enddo - - v_1b_list_b3(ipoint) = fact_r - enddo - -END_PROVIDER - -! --- - - BEGIN_PROVIDER [double precision, v_1b_square_grad, (n_points_final_grid,3)] -&BEGIN_PROVIDER [double precision, v_1b_square_lapl, (n_points_final_grid) ] - - implicit none - integer :: ipoint, i - double precision :: x, y, z, dx, dy, dz, r2 - double precision :: coef, expo, a_expo, tmp - double precision :: fact_x, fact_y, fact_z, fact_r - - PROVIDE List_all_comb_b3_coef List_all_comb_b3_expo List_all_comb_b3_cent - - do ipoint = 1, n_points_final_grid - - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - - fact_x = 0.d0 - fact_y = 0.d0 - fact_z = 0.d0 - fact_r = 0.d0 - do i = 1, List_all_comb_b3_size - - coef = List_all_comb_b3_coef(i) - expo = List_all_comb_b3_expo(i) - - dx = x - List_all_comb_b3_cent(1,i) - dy = y - List_all_comb_b3_cent(2,i) - dz = z - List_all_comb_b3_cent(3,i) - r2 = dx * dx + dy * dy + dz * dz - - a_expo = expo * r2 - tmp = coef * expo * dexp(-a_expo) - - fact_x += tmp * dx - fact_y += tmp * dy - fact_z += tmp * dz - fact_r += tmp * (3.d0 - 2.d0 * a_expo) - enddo - - v_1b_square_grad(ipoint,1) = -2.d0 * fact_x - v_1b_square_grad(ipoint,2) = -2.d0 * fact_y - v_1b_square_grad(ipoint,3) = -2.d0 * fact_z - v_1b_square_lapl(ipoint) = -2.d0 * fact_r - enddo - -END_PROVIDER - -! --- - -double precision function j12_mu_r12(r12) - - include 'constants.include.F' - - implicit none - double precision, intent(in) :: r12 - double precision :: mu_r12 - - mu_r12 = mu_erf * r12 - - j12_mu_r12 = 0.5d0 * r12 * (1.d0 - derf(mu_r12)) - inv_sq_pi_2 * dexp(-mu_r12*mu_r12) / mu_erf - - return -end function j12_mu_r12 - -! --- - -double precision function jmu_modif(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - double precision, external :: j12_mu, j12_nucl - - jmu_modif = j12_mu(r1, r2) * j12_nucl(r1, r2) - - return -end function jmu_modif - -! --- - -double precision function j12_mu_gauss(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - integer :: i - double precision :: r12, coef, expo - - r12 = (r1(1) - r2(1)) * (r1(1) - r2(1)) & - + (r1(2) - r2(2)) * (r1(2) - r2(2)) & - + (r1(3) - r2(3)) * (r1(3) - r2(3)) - - j12_mu_gauss = 0.d0 - do i = 1, n_max_fit_slat - expo = expo_gauss_j_mu_x(i) - coef = coef_gauss_j_mu_x(i) - - j12_mu_gauss += coef * dexp(-expo*r12) - enddo - - return -end function j12_mu_gauss - -! --- - -double precision function j12_nucl(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - double precision, external :: j1b_nucl - - j12_nucl = j1b_nucl(r1) * j1b_nucl(r2) - - return -end function j12_nucl - -! --- - -! --------------------------------------------------------------------------------------- - -double precision function grad_x_j1b_nucl_num(r) - - implicit none - double precision, intent(in) :: r(3) - double precision :: r_eps(3), eps, fp, fm, delta - double precision, external :: j1b_nucl - - eps = 1d-6 - r_eps = r - delta = max(eps, dabs(eps*r(1))) - - r_eps(1) = r_eps(1) + delta - fp = j1b_nucl(r_eps) - r_eps(1) = r_eps(1) - 2.d0 * delta - fm = j1b_nucl(r_eps) - - grad_x_j1b_nucl_num = 0.5d0 * (fp - fm) / delta - - return -end function grad_x_j1b_nucl_num - -double precision function grad_y_j1b_nucl_num(r) - - implicit none - double precision, intent(in) :: r(3) - double precision :: r_eps(3), eps, fp, fm, delta - double precision, external :: j1b_nucl - - eps = 1d-6 - r_eps = r - delta = max(eps, dabs(eps*r(2))) - - r_eps(2) = r_eps(2) + delta - fp = j1b_nucl(r_eps) - r_eps(2) = r_eps(2) - 2.d0 * delta - fm = j1b_nucl(r_eps) - - grad_y_j1b_nucl_num = 0.5d0 * (fp - fm) / delta - - return -end function grad_y_j1b_nucl_num - -double precision function grad_z_j1b_nucl_num(r) - - implicit none - double precision, intent(in) :: r(3) - double precision :: r_eps(3), eps, fp, fm, delta - double precision, external :: j1b_nucl - - eps = 1d-6 - r_eps = r - delta = max(eps, dabs(eps*r(3))) - - r_eps(3) = r_eps(3) + delta - fp = j1b_nucl(r_eps) - r_eps(3) = r_eps(3) - 2.d0 * delta - fm = j1b_nucl(r_eps) - - grad_z_j1b_nucl_num = 0.5d0 * (fp - fm) / delta - - return -end function grad_z_j1b_nucl_num - -! --------------------------------------------------------------------------------------- - -! --- - -double precision function lapl_j1b_nucl(r) - - implicit none - double precision, intent(in) :: r(3) - double precision :: r_eps(3), eps, fp, fm, delta - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num - - eps = 1d-5 - r_eps = r - - lapl_j1b_nucl = 0.d0 - - ! --- - - delta = max(eps, dabs(eps*r(1))) - r_eps(1) = r_eps(1) + delta - fp = grad_x_j1b_nucl_num(r_eps) - r_eps(1) = r_eps(1) - 2.d0 * delta - fm = grad_x_j1b_nucl_num(r_eps) - r_eps(1) = r_eps(1) + delta - - lapl_j1b_nucl += 0.5d0 * (fp - fm) / delta - - ! --- - - delta = max(eps, dabs(eps*r(2))) - r_eps(2) = r_eps(2) + delta - fp = grad_y_j1b_nucl_num(r_eps) - r_eps(2) = r_eps(2) - 2.d0 * delta - fm = grad_y_j1b_nucl_num(r_eps) - r_eps(2) = r_eps(2) + delta - - lapl_j1b_nucl += 0.5d0 * (fp - fm) / delta - - ! --- - - delta = max(eps, dabs(eps*r(3))) - r_eps(3) = r_eps(3) + delta - fp = grad_z_j1b_nucl_num(r_eps) - r_eps(3) = r_eps(3) - 2.d0 * delta - fm = grad_z_j1b_nucl_num(r_eps) - r_eps(3) = r_eps(3) + delta - - lapl_j1b_nucl += 0.5d0 * (fp - fm) / delta - - ! --- - - return -end function lapl_j1b_nucl - -! --- - -! --------------------------------------------------------------------------------------- - -double precision function grad1_x_jmu_modif(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - double precision :: r1_eps(3), eps, fp, fm, delta - double precision, external :: jmu_modif - - eps = 1d-7 - r1_eps = r1 - delta = max(eps, dabs(eps*r1(1))) - - r1_eps(1) = r1_eps(1) + delta - fp = jmu_modif(r1_eps, r2) - r1_eps(1) = r1_eps(1) - 2.d0 * delta - fm = jmu_modif(r1_eps, r2) - - grad1_x_jmu_modif = 0.5d0 * (fp - fm) / delta - - return -end function grad1_x_jmu_modif - -double precision function grad1_y_jmu_modif(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - double precision :: r1_eps(3), eps, fp, fm, delta - double precision, external :: jmu_modif - - eps = 1d-7 - r1_eps = r1 - delta = max(eps, dabs(eps*r1(2))) - - r1_eps(2) = r1_eps(2) + delta - fp = jmu_modif(r1_eps, r2) - r1_eps(2) = r1_eps(2) - 2.d0 * delta - fm = jmu_modif(r1_eps, r2) - - grad1_y_jmu_modif = 0.5d0 * (fp - fm) / delta - - return -end function grad1_y_jmu_modif - -double precision function grad1_z_jmu_modif(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - double precision :: r1_eps(3), eps, fp, fm, delta - double precision, external :: jmu_modif - - eps = 1d-7 - r1_eps = r1 - delta = max(eps, dabs(eps*r1(3))) - - r1_eps(3) = r1_eps(3) + delta - fp = jmu_modif(r1_eps, r2) - r1_eps(3) = r1_eps(3) - 2.d0 * delta - fm = jmu_modif(r1_eps, r2) - - grad1_z_jmu_modif = 0.5d0 * (fp - fm) / delta - - return -end function grad1_z_jmu_modif - -! --------------------------------------------------------------------------------------- - -! --- - -! --------------------------------------------------------------------------------------- - -double precision function grad1_x_j12_mu_num(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - double precision :: r1_eps(3), eps, fp, fm, delta - double precision, external :: j12_mu - - eps = 1d-7 - r1_eps = r1 - delta = max(eps, dabs(eps*r1(1))) - - r1_eps(1) = r1_eps(1) + delta - fp = j12_mu(r1_eps, r2) - r1_eps(1) = r1_eps(1) - 2.d0 * delta - fm = j12_mu(r1_eps, r2) - - grad1_x_j12_mu_num = 0.5d0 * (fp - fm) / delta - - return -end function grad1_x_j12_mu_num - -double precision function grad1_y_j12_mu_num(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - double precision :: r1_eps(3), eps, fp, fm, delta - double precision, external :: j12_mu - - eps = 1d-7 - r1_eps = r1 - delta = max(eps, dabs(eps*r1(2))) - - r1_eps(2) = r1_eps(2) + delta - fp = j12_mu(r1_eps, r2) - r1_eps(2) = r1_eps(2) - 2.d0 * delta - fm = j12_mu(r1_eps, r2) - - grad1_y_j12_mu_num = 0.5d0 * (fp - fm) / delta - - return -end function grad1_y_j12_mu_num - -double precision function grad1_z_j12_mu_num(r1, r2) - - implicit none - double precision, intent(in) :: r1(3), r2(3) - double precision :: r1_eps(3), eps, fp, fm, delta - double precision, external :: j12_mu - - eps = 1d-7 - r1_eps = r1 - delta = max(eps, dabs(eps*r1(3))) - - r1_eps(3) = r1_eps(3) + delta - fp = j12_mu(r1_eps, r2) - r1_eps(3) = r1_eps(3) - 2.d0 * delta - fm = j12_mu(r1_eps, r2) - - grad1_z_j12_mu_num = 0.5d0 * (fp - fm) / delta - - return -end function grad1_z_j12_mu_num - -! --------------------------------------------------------------------------------------- - -subroutine grad1_jmu_modif_num(r1, r2, grad) - - implicit none - - double precision, intent(in) :: r1(3), r2(3) - double precision, intent(out) :: grad(3) - - double precision :: tmp0, tmp1, tmp2, grad_u12(3) - - double precision, external :: j12_mu - double precision, external :: j1b_nucl - double precision, external :: grad_x_j1b_nucl_num - double precision, external :: grad_y_j1b_nucl_num - double precision, external :: grad_z_j1b_nucl_num - - call grad1_j12_mu(r1, r2, grad_u12) - - tmp0 = j1b_nucl(r1) - tmp1 = j1b_nucl(r2) - tmp2 = j12_mu(r1, r2) - - grad(1) = (tmp0 * grad_u12(1) + tmp2 * grad_x_j1b_nucl_num(r1)) * tmp1 - grad(2) = (tmp0 * grad_u12(2) + tmp2 * grad_y_j1b_nucl_num(r1)) * tmp1 - grad(3) = (tmp0 * grad_u12(3) + tmp2 * grad_z_j1b_nucl_num(r1)) * tmp1 - - return -end subroutine grad1_jmu_modif_num - -! --- - -subroutine get_tchint_rsdft_jastrow(x, y, dj) - - implicit none - double precision, intent(in) :: x(3), y(3) - double precision, intent(out) :: dj(3) - integer :: at - double precision :: a, mu_tmp, inv_sq_pi_2 - double precision :: tmp_x, tmp_y, tmp_z, tmp - double precision :: dx2, dy2, pos(3), dxy, dxy2 - double precision :: v1b_x, v1b_y - double precision :: u2b, grad1_u2b(3), grad1_v1b(3) - - PROVIDE mu_erf - - inv_sq_pi_2 = 0.5d0 / dsqrt(dacos(-1.d0)) - - dj = 0.d0 - -! double precision, external :: j12_mu, j1b_nucl -! v1b_x = j1b_nucl(x) -! v1b_y = j1b_nucl(y) -! call grad1_j1b_nucl(x, grad1_v1b) -! u2b = j12_mu(x, y) -! call grad1_j12_mu(x, y, grad1_u2b) - - ! 1b terms - v1b_x = 1.d0 - v1b_y = 1.d0 - tmp_x = 0.d0 - tmp_y = 0.d0 - tmp_z = 0.d0 - do at = 1, nucl_num - - a = j1b_pen(at) - pos(1) = nucl_coord(at,1) - pos(2) = nucl_coord(at,2) - pos(3) = nucl_coord(at,3) - - dx2 = sum((x-pos)**2) - dy2 = sum((y-pos)**2) - tmp = dexp(-a*dx2) * a - - v1b_x = v1b_x - dexp(-a*dx2) - v1b_y = v1b_y - dexp(-a*dy2) - - tmp_x = tmp_x + tmp * (x(1) - pos(1)) - tmp_y = tmp_y + tmp * (x(2) - pos(2)) - tmp_z = tmp_z + tmp * (x(3) - pos(3)) - end do - grad1_v1b(1) = 2.d0 * tmp_x - grad1_v1b(2) = 2.d0 * tmp_y - grad1_v1b(3) = 2.d0 * tmp_z - - ! 2b terms - dxy2 = sum((x-y)**2) - dxy = dsqrt(dxy2) - mu_tmp = mu_erf * dxy - u2b = 0.5d0 * dxy * (1.d0 - derf(mu_tmp)) - inv_sq_pi_2 * dexp(-mu_tmp*mu_tmp) / mu_erf - - if(dxy .lt. 1d-8) then - grad1_u2b(1) = 0.d0 - grad1_u2b(2) = 0.d0 - grad1_u2b(3) = 0.d0 - else - tmp = 0.5d0 * (1.d0 - derf(mu_tmp)) / dxy - grad1_u2b(1) = tmp * (x(1) - y(1)) - grad1_u2b(2) = tmp * (x(2) - y(2)) - grad1_u2b(3) = tmp * (x(3) - y(3)) - endif - - dj(1) = (grad1_u2b(1) * v1b_x + u2b * grad1_v1b(1)) * v1b_y - dj(2) = (grad1_u2b(2) * v1b_x + u2b * grad1_v1b(2)) * v1b_y - dj(3) = (grad1_u2b(3) * v1b_x + u2b * grad1_v1b(3)) * v1b_y - - return -end subroutine get_tchint_rsdft_jastrow - -! --- - - diff --git a/src/non_h_ints_mu/new_grad_tc.irp.f b/src/non_h_ints_mu/new_grad_tc.irp.f deleted file mode 100644 index ab3cc3be..00000000 --- a/src/non_h_ints_mu/new_grad_tc.irp.f +++ /dev/null @@ -1,171 +0,0 @@ - -! --- - -BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao_loop, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! tc_grad_and_lapl_ao_loop(k,i,l,j) = < k l | -1/2 \Delta_1 u(r1,r2) - \grad_1 u(r1,r2) . \grad_1 | ij > - ! - ! = 1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) - ! - ! This is obtained by integration by parts. - ! - END_DOC - - implicit none - integer :: ipoint, i, j, k, l - double precision :: weight1, contrib_x, contrib_y, contrib_z, tmp_x, tmp_y, tmp_z - double precision :: ao_k_r, ao_i_r, ao_i_dx, ao_i_dy, ao_i_dz - double precision :: ao_j_r, ao_l_r, ao_l_dx, ao_l_dy, ao_l_dz - double precision :: time0, time1 - double precision, allocatable :: ac_mat(:,:,:,:) - - print*, ' providing tc_grad_and_lapl_ao_loop ...' - call wall_time(time0) - - allocate(ac_mat(ao_num,ao_num,ao_num,ao_num)) - ac_mat = 0.d0 - - ! --- - - do ipoint = 1, n_points_final_grid - weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) - - do i = 1, ao_num - ao_i_r = weight1 * aos_in_r_array (i,ipoint) - ao_i_dx = weight1 * aos_grad_in_r_array(i,ipoint,1) - ao_i_dy = weight1 * aos_grad_in_r_array(i,ipoint,2) - ao_i_dz = weight1 * aos_grad_in_r_array(i,ipoint,3) - - do k = 1, ao_num - ao_k_r = aos_in_r_array(k,ipoint) - - tmp_x = ao_k_r * ao_i_dx - ao_i_r * aos_grad_in_r_array(k,ipoint,1) - tmp_y = ao_k_r * ao_i_dy - ao_i_r * aos_grad_in_r_array(k,ipoint,2) - tmp_z = ao_k_r * ao_i_dz - ao_i_r * aos_grad_in_r_array(k,ipoint,3) - - do j = 1, ao_num - do l = 1, ao_num - - contrib_x = int2_grad1_u12_ao(l,j,ipoint,1) * tmp_x - contrib_y = int2_grad1_u12_ao(l,j,ipoint,2) * tmp_y - contrib_z = int2_grad1_u12_ao(l,j,ipoint,3) * tmp_z - - ac_mat(k,i,l,j) += contrib_x + contrib_y + contrib_z - enddo - enddo - enddo - enddo - enddo - - ! --- - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - tc_grad_and_lapl_ao_loop(k,i,l,j) = ac_mat(k,i,l,j) + ac_mat(l,j,k,i) - enddo - enddo - enddo - enddo - - deallocate(ac_mat) - - call wall_time(time1) - print*, ' Wall time for tc_grad_and_lapl_ao_loop = ', time1 - time0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, tc_grad_and_lapl_ao, (ao_num, ao_num, ao_num, ao_num)] - - BEGIN_DOC - ! - ! tc_grad_and_lapl_ao(k,i,l,j) = < k l | -1/2 \Delta_1 u(r1,r2) - \grad_1 u(r1,r2) . \grad_1 | ij > - ! - ! = -1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) - ! = 1/2 \int dr1 (phi_k(r1) \grad_r1 phi_i(r1) - phi_i(r1) \grad_r1 phi_k(r1)) . \int dr2 (-1) \grad_r1 u(r1,r2) \phi_l(r2) \phi_j(r2) - ! - ! -1 in \int dr2 - ! - ! This is obtained by integration by parts. - ! - END_DOC - - implicit none - integer :: ipoint, i, j, k, l, m - double precision :: weight1, ao_k_r, ao_i_r - double precision :: time0, time1 - double precision, allocatable :: b_mat(:,:,:,:) - - print*, ' providing tc_grad_and_lapl_ao ...' - call wall_time(time0) - - if(read_tc_integ) then - - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_and_lapl_ao', action="read") - read(11) tc_grad_and_lapl_ao - close(11) - - else - - PROVIDE int2_grad1_u12_ao - - allocate(b_mat(n_points_final_grid,ao_num,ao_num,3)) - - b_mat = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, k, ipoint, weight1, ao_i_r, ao_k_r) & - !$OMP SHARED (aos_in_r_array_transp, aos_grad_in_r_array_transp_bis, b_mat, & - !$OMP ao_num, n_points_final_grid, final_weight_at_r_vector) - !$OMP DO SCHEDULE (static) - do i = 1, ao_num - do k = 1, ao_num - do ipoint = 1, n_points_final_grid - - weight1 = 0.5d0 * final_weight_at_r_vector(ipoint) - ao_i_r = aos_in_r_array_transp(ipoint,i) - ao_k_r = aos_in_r_array_transp(ipoint,k) - - b_mat(ipoint,k,i,1) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,1) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,1)) - b_mat(ipoint,k,i,2) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,2) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,2)) - b_mat(ipoint,k,i,3) = weight1 * (ao_k_r * aos_grad_in_r_array_transp_bis(ipoint,i,3) - ao_i_r * aos_grad_in_r_array_transp_bis(ipoint,k,3)) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - tc_grad_and_lapl_ao = 0.d0 - do m = 1, 3 - call dgemm( "N", "N", ao_num*ao_num, ao_num*ao_num, n_points_final_grid, 1.d0 & - , int2_grad1_u12_ao(1,1,1,m), ao_num*ao_num, b_mat(1,1,1,m), n_points_final_grid & - , 1.d0, tc_grad_and_lapl_ao, ao_num*ao_num) - enddo - deallocate(b_mat) - - call sum_A_At(tc_grad_and_lapl_ao(1,1,1,1), ao_num*ao_num) - - endif - - if(write_tc_integ.and.mpi_master) then - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/tc_grad_and_lapl_ao', action="write") - call ezfio_set_work_empty(.False.) - write(11) tc_grad_and_lapl_ao - close(11) - call ezfio_set_tc_keywords_io_tc_integ('Read') - endif - - call wall_time(time1) - print*, ' Wall time for tc_grad_and_lapl_ao = ', time1 - time0 - call print_memory_usage() - -END_PROVIDER - -! --- - - diff --git a/src/non_h_ints_mu/tc_integ_an.irp.f b/src/non_h_ints_mu/tc_integ_an.irp.f deleted file mode 100644 index a6459761..00000000 --- a/src/non_h_ints_mu/tc_integ_an.irp.f +++ /dev/null @@ -1,248 +0,0 @@ - -BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_final_grid, 3)] - - BEGIN_DOC - ! - ! TODO - ! combine with int2_grad1_u12_square_ao to avoid repeated calculation ? - ! - ! int2_grad1_u12_ao(i,j,ipoint,:) = \int dr2 [-1 * \grad_r1 J(r1,r2)] \phi_i(r2) \phi_j(r2) - ! - ! where r1 = r(ipoint) - ! - ! if J(r1,r2) = u12 (j1b_type .eq. 1) - ! - ! int2_grad1_u12_ao(i,j,ipoint,:) = 0.5 x \int dr2 [(r1 - r2) (erf(mu * r12)-1)r_12] \phi_i(r2) \phi_j(r2) - ! = 0.5 * [ v_ij_erf_rk_cst_mu(i,j,ipoint) * r(:) - x_v_ij_erf_rk_cst_mu(i,j,ipoint,:) ] - ! - ! if J(r1,r2) = u12 x v1 x v2 (j1b_type .eq. 3) - ! - ! int2_grad1_u12_ao(i,j,ipoint,:) = v1 x [ 0.5 x \int dr2 [(r1 - r2) (erf(mu * r12)-1)r_12] v2 \phi_i(r2) \phi_j(r2) ] - ! - \grad_1 v1 x [ \int dr2 u12 v2 \phi_i(r2) \phi_j(r2) ] - ! = 0.5 v_1b(ipoint) * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) * r(:) - ! - 0.5 v_1b(ipoint) * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,:) - ! - v_1b_grad[:,ipoint] * v_ij_u_cst_mu_j1b(i,j,ipoint) - ! - END_DOC - - implicit none - integer :: ipoint, i, j, m, jpoint - double precision :: time0, time1 - double precision :: x, y, z, w, tmp_x, tmp_y, tmp_z, tmp0, tmp1, tmp2 - - print*, ' providing int2_grad1_u12_ao ...' - call wall_time(time0) - - PROVIDE j1b_type - - if(read_tc_integ) then - - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="read") - read(11) int2_grad1_u12_ao - - else - - if(j1b_type .eq. 0) then - - PROVIDE v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu - - int2_grad1_u12_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp1) & - !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points & - !$OMP , v_ij_erf_rk_cst_mu, x_v_ij_erf_rk_cst_mu, int2_grad1_u12_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = v_ij_erf_rk_cst_mu(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,1) = 0.5d0 * (tmp1 * x - x_v_ij_erf_rk_cst_mu(i,j,ipoint,1)) - int2_grad1_u12_ao(i,j,ipoint,2) = 0.5d0 * (tmp1 * y - x_v_ij_erf_rk_cst_mu(i,j,ipoint,2)) - int2_grad1_u12_ao(i,j,ipoint,3) = 0.5d0 * (tmp1 * z - x_v_ij_erf_rk_cst_mu(i,j,ipoint,3)) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 4)) then - - PROVIDE v_1b_grad - PROVIDE v_ij_erf_rk_cst_mu_j1b v_ij_u_cst_mu_j1b_an x_v_ij_erf_rk_cst_mu_j1b - - int2_grad1_u12_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (ipoint, i, j, x, y, z, tmp0, tmp1, tmp2, tmp_x, tmp_y, tmp_z) & - !$OMP SHARED ( ao_num, n_points_final_grid, final_grid_points, v_1b, v_1b_grad & - !$OMP , v_ij_erf_rk_cst_mu_j1b, v_ij_u_cst_mu_j1b_an, x_v_ij_erf_rk_cst_mu_j1b, int2_grad1_u12_ao) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - x = final_grid_points(1,ipoint) - y = final_grid_points(2,ipoint) - z = final_grid_points(3,ipoint) - tmp0 = 0.5d0 * v_1b(ipoint) - tmp_x = v_1b_grad(1,ipoint) - tmp_y = v_1b_grad(2,ipoint) - tmp_z = v_1b_grad(3,ipoint) - do j = 1, ao_num - do i = 1, ao_num - tmp1 = tmp0 * v_ij_erf_rk_cst_mu_j1b(i,j,ipoint) - tmp2 = v_ij_u_cst_mu_j1b_an(i,j,ipoint) - int2_grad1_u12_ao(i,j,ipoint,1) = tmp1 * x - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,1) - tmp2 * tmp_x - int2_grad1_u12_ao(i,j,ipoint,2) = tmp1 * y - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,2) - tmp2 * tmp_y - int2_grad1_u12_ao(i,j,ipoint,3) = tmp1 * z - tmp0 * x_v_ij_erf_rk_cst_mu_j1b(i,j,ipoint,3) - tmp2 * tmp_z - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - FREE v_ij_erf_rk_cst_mu_j1b v_ij_u_cst_mu_j1b_an x_v_ij_erf_rk_cst_mu_j1b - - elseif(j1b_type .ge. 100) then - -! PROVIDE int2_grad1_u12_ao_num -! int2_grad1_u12_ao = int2_grad1_u12_ao_num - - PROVIDE int2_grad1_u12_ao_num_1shot - int2_grad1_u12_ao = int2_grad1_u12_ao_num_1shot - - else - - print *, ' j1b_type = ', j1b_type, 'not implemented yet' - stop - - endif - endif - - if(write_tc_integ.and.mpi_master) then - open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/int2_grad1_u12_ao', action="write") - call ezfio_set_work_empty(.False.) - write(11) int2_grad1_u12_ao - close(11) - call ezfio_set_tc_keywords_io_tc_integ('Read') - endif - - call wall_time(time1) - print*, ' wall time for int2_grad1_u12_ao =', time1-time0 - call print_memory_usage() - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_points_final_grid)] - - BEGIN_DOC - ! - ! int2_grad1_u12_square_ao = -(1/2) x int dr2 chi_l(r2) chi_j(r2) [grad_1 u(r1,r2)]^2 - ! - END_DOC - - implicit none - integer :: ipoint, i, j, m, jpoint - double precision :: time0, time1 - double precision :: x, y, z, w, tmp_x, tmp_y, tmp_z, tmp0, tmp1, tmp2 - - print*, ' providing int2_grad1_u12_square_ao ...' - call wall_time(time0) - - PROVIDE j1b_type - - if(j1b_type .eq. 0) then - - PROVIDE int2_grad1u2_grad2u2 - - int2_grad1_u12_square_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, int2_grad1u2_grad2u2) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - do j = 1, ao_num - do i = 1, ao_num - int2_grad1_u12_square_ao(i,j,ipoint) = int2_grad1u2_grad2u2(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - elseif((j1b_type .eq. 3) .or. (j1b_type .eq. 4)) then - - if(use_ipp) then - - ! the term u12_grad1_u12_j1b_grad1_j1b is added directly for performance - PROVIDE u12sq_j1bsq grad12_j12 - - int2_grad1_u12_square_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_j1bsq, grad12_j12) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - do j = 1, ao_num - do i = 1, ao_num - int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_j1bsq(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - FREE u12sq_j1bsq grad12_j12 - - else - - PROVIDE u12sq_j1bsq u12_grad1_u12_j1b_grad1_j1b grad12_j12 - - int2_grad1_u12_square_ao = 0.d0 - !$OMP PARALLEL & - !$OMP DEFAULT (NONE) & - !$OMP PRIVATE (i, j, ipoint) & - !$OMP SHARED (int2_grad1_u12_square_ao, ao_num, n_points_final_grid, u12sq_j1bsq, grad12_j12, u12_grad1_u12_j1b_grad1_j1b) - !$OMP DO SCHEDULE (static) - do ipoint = 1, n_points_final_grid - do j = 1, ao_num - do i = 1, ao_num - int2_grad1_u12_square_ao(i,j,ipoint) = u12sq_j1bsq(i,j,ipoint) + u12_grad1_u12_j1b_grad1_j1b(i,j,ipoint) + 0.5d0 * grad12_j12(i,j,ipoint) - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - - FREE u12sq_j1bsq u12_grad1_u12_j1b_grad1_j1b grad12_j12 - - endif - - elseif(j1b_type .ge. 100) then - - ! PROVIDE int2_grad1_u12_square_ao_num - ! int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num - - PROVIDE int2_grad1_u12_square_ao_num_1shot - int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num_1shot - - else - - print *, ' j1b_type = ', j1b_type, 'not implemented yet' - stop - - endif - - call wall_time(time1) - print*, ' wall time for int2_grad1_u12_square_ao =', time1-time0 - call print_memory_usage() - -END_PROVIDER - -! --- - diff --git a/src/non_h_ints_mu/total_tc_int.irp.f b/src/non_h_ints_mu/total_tc_int.irp.f deleted file mode 100644 index 9c19e0ac..00000000 --- a/src/non_h_ints_mu/total_tc_int.irp.f +++ /dev/null @@ -1,190 +0,0 @@ - -! --- - -BEGIN_PROVIDER [double precision, ao_vartc_int_chemist, (ao_num, ao_num, ao_num, ao_num)] - - implicit none - integer :: i, j, k, l - double precision :: wall1, wall0 - - print *, ' providing ao_vartc_int_chemist ...' - call wall_time(wall0) - - if(test_cycle_tc) then - - PROVIDE j1b_type - if(j1b_type .ne. 3) then - print*, ' TC integrals with cycle can not be used for j1b_type =', j1b_type - stop - endif - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_vartc_int_chemist(k,i,l,j) = tc_grad_square_ao_test(k,i,l,j) + ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo - - else - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_vartc_int_chemist(k,i,l,j) = tc_grad_square_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo - - endif - - call wall_time(wall1) - print *, ' wall time for ao_vartc_int_chemist ', wall1 - wall0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_tc_int_chemist, (ao_num, ao_num, ao_num, ao_num)] - - implicit none - integer :: i, j, k, l - double precision :: wall1, wall0 - - PROVIDE j1b_type - - print *, ' providing ao_tc_int_chemist ...' - call wall_time(wall0) - - if(test_cycle_tc) then - - if(j1b_type .ne. 3) then - print*, ' TC integrals with cycle can not be used for j1b_type =', j1b_type - stop - endif - - ao_tc_int_chemist = ao_tc_int_chemist_test - - else - - PROVIDE tc_grad_square_ao tc_grad_and_lapl_ao ao_two_e_coul - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_tc_int_chemist(k,i,l,j) = tc_grad_square_ao(k,i,l,j) + tc_grad_and_lapl_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) -! ao_tc_int_chemist(k,i,l,j) = ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo - endif - - FREE tc_grad_square_ao tc_grad_and_lapl_ao ao_two_e_coul - - if(j1b_type .ge. 100) then - FREE int2_grad1_u12_ao_num int2_grad1_u12_square_ao_num - endif - - - call wall_time(wall1) - print *, ' wall time for ao_tc_int_chemist ', wall1 - wall0 - call print_memory_usage() - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_tc_int_chemist_no_cycle, (ao_num, ao_num, ao_num, ao_num)] - - implicit none - integer :: i, j, k, l - double precision :: wall1, wall0 - - print *, ' providing ao_tc_int_chemist_no_cycle ...' - call wall_time(wall0) - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_tc_int_chemist_no_cycle(k,i,l,j) = tc_grad_square_ao(k,i,l,j) + tc_grad_and_lapl_ao(k,i,l,j) + ao_two_e_coul(k,i,l,j) - !ao_tc_int_chemist(k,i,l,j) = ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo - - call wall_time(wall1) - print *, ' wall time for ao_tc_int_chemist_no_cycle ', wall1 - wall0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_tc_int_chemist_test, (ao_num, ao_num, ao_num, ao_num)] - - implicit none - integer :: i, j, k, l - double precision :: wall1, wall0 - - print *, ' providing ao_tc_int_chemist_test ...' - call wall_time(wall0) - - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ao_tc_int_chemist_test(k,i,l,j) = tc_grad_square_ao_test(k,i,l,j) + tc_grad_and_lapl_ao_test(k,i,l,j) + ao_two_e_coul(k,i,l,j) -! ao_tc_int_chemist_test(k,i,l,j) = ao_two_e_coul(k,i,l,j) - enddo - enddo - enddo - enddo - - call wall_time(wall1) - print *, ' wall time for ao_tc_int_chemist_test ', wall1 - wall0 - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [double precision, ao_two_e_coul, (ao_num, ao_num, ao_num, ao_num) ] - - BEGIN_DOC - ! - ! ao_two_e_coul(k,i,l,j) = ( k i | 1/r12 | l j ) = < l k | 1/r12 | j i > - ! - END_DOC - - integer :: i, j, k, l - double precision, external :: get_ao_two_e_integral - - PROVIDE ao_integrals_map - - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP SHARED(ao_num, ao_two_e_coul, ao_integrals_map) & - !$OMP PRIVATE(i, j, k, l) - !$OMP DO - do j = 1, ao_num - do l = 1, ao_num - do i = 1, ao_num - do k = 1, ao_num - ! < 1:k, 2:l | 1:i, 2:j > - ao_two_e_coul(k,i,l,j) = get_ao_two_e_integral(i, j, k, l, ao_integrals_map) - enddo - enddo - enddo - enddo - !$OMP END DO - !$OMP END PARALLEL - -END_PROVIDER - -! --- - diff --git a/src/tc_keywords/j1b_pen.irp.f b/src/tc_keywords/j1b_pen.irp.f deleted file mode 100644 index d509fc7e..00000000 --- a/src/tc_keywords/j1b_pen.irp.f +++ /dev/null @@ -1,155 +0,0 @@ - -! --- - - BEGIN_PROVIDER [ double precision, j1b_pen , (nucl_num) ] -&BEGIN_PROVIDER [ double precision, j1b_pen_coef, (nucl_num) ] - - BEGIN_DOC - ! parameters of the 1-body Jastrow - END_DOC - - implicit none - logical :: exists - integer :: i - integer :: ierr - - PROVIDE ezfio_filename - - ! --- - - if (mpi_master) then - call ezfio_has_tc_keywords_j1b_pen(exists) - endif - - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - - IRP_IF MPI - include 'mpif.h' - call MPI_BCAST(j1b_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_pen with MPI' - endif - IRP_ENDIF - - if (exists) then - if (mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1b_pen ] <<<<< ..' - call ezfio_get_tc_keywords_j1b_pen(j1b_pen) - IRP_IF MPI - call MPI_BCAST(j1b_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_pen with MPI' - endif - IRP_ENDIF - endif - else - do i = 1, nucl_num - j1b_pen(i) = 1d5 - enddo - endif - - ! --- - - if (mpi_master) then - call ezfio_has_tc_keywords_j1b_pen_coef(exists) - endif - - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - - IRP_IF MPI - call MPI_BCAST(j1b_pen_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_pen_coef with MPI' - endif - IRP_ENDIF - - if (exists) then - if (mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1b_pen_coef ] <<<<< ..' - call ezfio_get_tc_keywords_j1b_pen_coef(j1b_pen_coef) - IRP_IF MPI - call MPI_BCAST(j1b_pen_coef, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_pen_coef with MPI' - endif - IRP_ENDIF - endif - else - do i = 1, nucl_num - j1b_pen_coef(i) = 1d0 - enddo - endif - - ! --- - - print *, ' parameters for nuclei jastrow' - print *, ' i, Z, j1b_pen, j1b_pen_coef' - do i = 1, nucl_num - write(*,'(I4, 2x, 3(E15.7, 2X))') i, nucl_charge(i), j1b_pen(i), j1b_pen_coef(i) - enddo - -END_PROVIDER - -! --- - -BEGIN_PROVIDER [ double precision, j1b_coeff, (nucl_num) ] - - BEGIN_DOC - ! coefficients of the 1-body Jastrow - END_DOC - - implicit none - logical :: exists - - PROVIDE ezfio_filename - - if (mpi_master) then - call ezfio_has_tc_keywords_j1b_coeff(exists) - endif - - IRP_IF MPI_DEBUG - print *, irp_here, mpi_rank - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - IRP_ENDIF - - IRP_IF MPI - include 'mpif.h' - integer :: ierr - call MPI_BCAST(j1b_coeff, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_coeff with MPI' - endif - IRP_ENDIF - - if (exists) then - - if (mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1b_coeff ] <<<<< ..' - call ezfio_get_tc_keywords_j1b_coeff(j1b_coeff) - IRP_IF MPI - call MPI_BCAST(j1b_coeff, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - if (ierr /= MPI_SUCCESS) then - stop 'Unable to read j1b_coeff with MPI' - endif - IRP_ENDIF - endif - - else - - integer :: i - do i = 1, nucl_num - j1b_coeff(i) = 0d5 - enddo - - endif - -END_PROVIDER - -! --- - diff --git a/src/trexio/EZFIO.cfg b/src/trexio/EZFIO.cfg index 8c11478e..88828520 100644 --- a/src/trexio/EZFIO.cfg +++ b/src/trexio/EZFIO.cfg @@ -18,7 +18,7 @@ default: True [export_mos] type: logical -doc: If True, export basis set and AOs +doc: If True, export MO coefficients interface: ezfio, ocaml, provider default: True diff --git a/src/two_body_rdm/state_av_full_orb_2_rdm.irp.f b/src/two_body_rdm/state_av_full_orb_2_rdm.irp.f index 5fb9e475..851e6b24 100644 --- a/src/two_body_rdm/state_av_full_orb_2_rdm.irp.f +++ b/src/two_body_rdm/state_av_full_orb_2_rdm.irp.f @@ -8,7 +8,7 @@ ! ! = \sum_{istate} w(istate) * ! -! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active +! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active ! ! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\alpha} * N_{\beta} * 2 ! @@ -149,7 +149,7 @@ ! ! = \sum_{istate} w(istate) * ! -! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active +! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active ! ! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\alpha} * (N_{\alpha} - 1) ! @@ -262,7 +262,7 @@ ! ! = \sum_{istate} w(istate) * ! -! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active +! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active ! ! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{\beta} * (N_{\beta} - 1) ! @@ -376,7 +376,7 @@ ! = \sum_{istate} w(istate) * \sum_{sigma,sigma'} ! ! -! WHERE ALL ORBITALS (i,j,k,l) BELONGS TO ALL OCCUPIED ORBITALS : core, inactive and active +! WHERE ALL ORBITALS (i,j,k,l) BELONG TO ALL OCCUPIED ORBITALS : core, inactive and active ! ! THE NORMALIZATION (i.e. sum of diagonal elements) IS SET TO N_{elec} * (N_{elec} - 1) ! @@ -619,3 +619,4 @@ !$OMP END PARALLEL END_PROVIDER + diff --git a/src/utils/constants.include.F b/src/utils/constants.include.F index d1727701..422eff95 100644 --- a/src/utils/constants.include.F +++ b/src/utils/constants.include.F @@ -1,6 +1,6 @@ integer, parameter :: max_dim = 511 integer, parameter :: SIMD_vector = 32 -integer, parameter :: N_int_max = 32 +integer, parameter :: N_int_max = 128 double precision, parameter :: pi = dacos(-1.d0) double precision, parameter :: inv_pi = 1.d0/dacos(-1.d0) diff --git a/src/utils/util.irp.f b/src/utils/util.irp.f index ebb13781..97cbde67 100644 --- a/src/utils/util.irp.f +++ b/src/utils/util.irp.f @@ -579,5 +579,64 @@ logical function is_same_spin(sigma_1, sigma_2) end function is_same_spin ! --- + +function Kronecker_delta(i, j) result(delta) + + BEGIN_DOC + ! Kronecker Delta + END_DOC + + implicit none + integer, intent(in) :: i, j + double precision :: delta + + if(i == j) then + delta = 1.d0 + else + delta = 0.d0 + endif + +end function Kronecker_delta + +! --- + +subroutine diagonalize_sym_matrix(N, A, e) + + BEGIN_DOC + ! + ! Diagonalize a symmetric matrix + ! + END_DOC + + implicit none + + integer, intent(in) :: N + double precision, intent(inout) :: A(N,N) + double precision, intent(out) :: e(N) + + integer :: lwork, info + double precision, allocatable :: work(:) + + allocate(work(1)) + + lwork = -1 + call dsyev('V', 'U', N, A, N, e, work, lwork, info) + lwork = int(work(1)) + + deallocate(work) + + allocate(work(lwork)) + + call dsyev('V', 'U', N, A, N, e, work, lwork, info) + deallocate(work) + + if(info /= 0) then + print*,'Problem in diagonalize_sym_matrix (dsyev)!!' + endif + +end subroutine diagonalize_sym_matrix + +! --- + diff --git a/src/utils_cc/org/TANGLE_org_mode.sh b/src/utils_cc/org/TANGLE_org_mode.sh deleted file mode 100755 index 059cbe7d..00000000 --- a/src/utils_cc/org/TANGLE_org_mode.sh +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh - -list='ls *.org' -for element in $list -do - emacs --batch $element -f org-babel-tangle -done diff --git a/src/utils_trust_region/org/TANGLE_org_mode.sh b/src/utils_trust_region/org/TANGLE_org_mode.sh deleted file mode 100755 index 059cbe7d..00000000 --- a/src/utils_trust_region/org/TANGLE_org_mode.sh +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh - -list='ls *.org' -for element in $list -do - emacs --batch $element -f org-babel-tangle -done