BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] BEGIN_DOC ! ! Hermitian part of 1-body Jastrow factow in the |AO| basis set. ! ! \langle \chi_i | - grad \tau_{1b} \cdot grad | \chi_j \rangle = ! 2 \sum_A aA \langle \chi_i | exp[-aA riA^2] (ri-rA) \cdot grad | \chi_j \rangle ! END_DOC implicit none integer :: num_A, num_B integer :: power_A(3), power_B(3) integer :: i, j, k, l, m double precision :: alpha, beta, gama double precision :: A_center(3), B_center(3), C_center(3) double precision :: c1, c integer :: dim1 double precision :: overlap_y, d_a_2, overlap_z, overlap double precision :: int_gauss_deriv PROVIDE j1b_gauss_pen ! -------------------------------------------------------------------------------- ! -- Dummy call to provide everything dim1 = 100 A_center(:) = 0.d0 B_center(:) = 1.d0 alpha = 1.d0 beta = 0.1d0 power_A(:) = 1 power_B(:) = 0 call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B & , overlap_y, d_a_2, overlap_z, overlap, dim1 ) ! -------------------------------------------------------------------------------- j1b_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0 !$OMP PARALLEL & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, & !$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_gauss_pen, j1b_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_gauss_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 enddo enddo enddo enddo !$OMP END DO !$OMP END PARALLEL END_PROVIDER !_____________________________________________________________________________________________________________ ! ! < XA | exp[-gama r_C^2] r_C \cdot grad | XB > ! double precision function int_gauss_deriv(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama) ! for max_dim include 'constants.include.F' implicit none double precision, intent(in) :: A_center(3), B_center(3), C_center(3) integer , intent(in) :: power_A(3), power_B(3) double precision, intent(in) :: alpha, beta, gama integer :: i, power_C, dim1 integer :: iorder(3), power_D(3) double precision :: AB_expo double precision :: fact_AB, center_AB(3), pol_AB(0:max_dim,3) double precision :: cx, cy, cz double precision :: overlap_gaussian_x dim1 = 100 int_gauss_deriv = 0.d0 ! =============== ! term I: ! \partial_x ! =============== if( power_B(1) .ge. 1 ) then power_D(1) = power_B(1) - 1 power_D(2) = power_B(2) power_D(3) = power_B(3) call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB & , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1) power_C = 1 cx = 0.d0 do i = 0, iorder(1) cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1) enddo power_C = 0 cy = 0.d0 do i = 0, iorder(2) cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1) enddo power_C = 0 cz = 0.d0 do i = 0, iorder(3) cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1) enddo int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(1)) * cx * cy * cz endif ! =============== power_D(1) = power_B(1) + 1 power_D(2) = power_B(2) power_D(3) = power_B(3) call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB & , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1) power_C = 1 cx = 0.d0 do i = 0, iorder(1) cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1) enddo power_C = 0 cy = 0.d0 do i = 0, iorder(2) cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1) enddo power_C = 0 cz = 0.d0 do i = 0, iorder(3) cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1) enddo int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz ! =============== ! =============== ! =============== ! term II: ! \partial_y ! =============== if( power_B(2) .ge. 1 ) then power_D(1) = power_B(1) power_D(2) = power_B(2) - 1 power_D(3) = power_B(3) call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB & , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1) power_C = 0 cx = 0.d0 do i = 0, iorder(1) cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1) enddo power_C = 1 cy = 0.d0 do i = 0, iorder(2) cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1) enddo power_C = 0 cz = 0.d0 do i = 0, iorder(3) cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1) enddo int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(2)) * cx * cy * cz endif ! =============== power_D(1) = power_B(1) power_D(2) = power_B(2) + 1 power_D(3) = power_B(3) call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB & , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1) power_C = 0 cx = 0.d0 do i = 0, iorder(1) cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1) enddo power_C = 1 cy = 0.d0 do i = 0, iorder(2) cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1) enddo power_C = 0 cz = 0.d0 do i = 0, iorder(3) cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1) enddo int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz ! =============== ! =============== ! =============== ! term III: ! \partial_z ! =============== if( power_B(3) .ge. 1 ) then power_D(1) = power_B(1) power_D(2) = power_B(2) power_D(3) = power_B(3) - 1 call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB & , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1) power_C = 0 cx = 0.d0 do i = 0, iorder(1) cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1) enddo power_C = 0 cy = 0.d0 do i = 0, iorder(2) cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1) enddo power_C = 1 cz = 0.d0 do i = 0, iorder(3) cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1) enddo int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(3)) * cx * cy * cz endif ! =============== power_D(1) = power_B(1) power_D(2) = power_B(2) power_D(3) = power_B(3) + 1 call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB & , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1) power_C = 0 cx = 0.d0 do i = 0, iorder(1) cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1) enddo power_C = 0 cy = 0.d0 do i = 0, iorder(2) cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1) enddo power_C = 1 cz = 0.d0 do i = 0, iorder(3) cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1) enddo int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz ! =============== ! =============== return end function int_gauss_deriv !_____________________________________________________________________________________________________________ !_____________________________________________________________________________________________________________