From 6513358da3907d80c863c45a45a85e4f732a4116 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Tue, 11 Oct 2022 11:03:10 +0200 Subject: [PATCH] merged with dev-tc --- src/ao_tc_eff_map/EZFIO.cfg | 12 +- src/ao_tc_eff_map/compute_ints_eff_pot.irp.f | 22 +- src/ao_tc_eff_map/j1b_1eInteg.py | 299 ------ src/ao_tc_eff_map/j1b_pen.irp.f | 71 +- src/ao_tc_eff_map/map_integrals_eff_pot.irp.f | 84 +- src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f | 332 +++++++ src/ao_tc_eff_map/one_e_1bgauss_hermit.irp.f | 519 ----------- src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f | 303 +++++++ src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f | 142 ++- src/ao_tc_eff_map/two_e_1bgauss_coul.irp.f | 800 ---------------- .../two_e_1bgauss_coul_acc.irp.f | 433 --------- .../two_e_1bgauss_coul_debug.irp.f | 397 -------- .../two_e_1bgauss_coul_modifdebug.irp.f | 324 ------- src/ao_tc_eff_map/two_e_1bgauss_coulerf.irp.f | 102 --- src/ao_tc_eff_map/two_e_1bgauss_erf.irp.f | 854 ------------------ src/ao_tc_eff_map/two_e_1bgauss_erf_acc.irp.f | 433 --------- ..._schwartz.irp.f => two_e_1bgauss_j1.irp.f} | 148 ++- src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f | 729 +++++++++++++++ src/ao_tc_eff_map/useful_sub.irp.f | 364 ++++++++ src/bi_ort_ints/one_e_bi_ort.irp.f | 4 +- 20 files changed, 2089 insertions(+), 4283 deletions(-) delete mode 100644 src/ao_tc_eff_map/j1b_1eInteg.py create mode 100644 src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f delete mode 100644 src/ao_tc_eff_map/one_e_1bgauss_hermit.irp.f create mode 100644 src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f delete mode 100644 src/ao_tc_eff_map/two_e_1bgauss_coul.irp.f delete mode 100644 src/ao_tc_eff_map/two_e_1bgauss_coul_acc.irp.f delete mode 100644 src/ao_tc_eff_map/two_e_1bgauss_coul_debug.irp.f delete mode 100644 src/ao_tc_eff_map/two_e_1bgauss_coul_modifdebug.irp.f delete mode 100644 src/ao_tc_eff_map/two_e_1bgauss_coulerf.irp.f delete mode 100644 src/ao_tc_eff_map/two_e_1bgauss_erf.irp.f delete mode 100644 src/ao_tc_eff_map/two_e_1bgauss_erf_acc.irp.f rename src/ao_tc_eff_map/{two_e_1bgauss_coulerf_schwartz.irp.f => two_e_1bgauss_j1.irp.f} (86%) create mode 100644 src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f create mode 100644 src/ao_tc_eff_map/useful_sub.irp.f diff --git a/src/ao_tc_eff_map/EZFIO.cfg b/src/ao_tc_eff_map/EZFIO.cfg index 1c72e2f5..1df2a130 100644 --- a/src/ao_tc_eff_map/EZFIO.cfg +++ b/src/ao_tc_eff_map/EZFIO.cfg @@ -1,12 +1,18 @@ -[j1b_gauss_pen] +[j1b_pen] type: double precision doc: exponents of the 1-body Jastrow interface: ezfio size: (nuclei.nucl_num) -[j1b_gauss] +[j1b_coeff] +type: double precision +doc: coeff of the 1-body Jastrow +interface: ezfio +size: (nuclei.nucl_num) + +[j1b_type] type: integer -doc: Use 1-body Gaussian Jastrow +doc: type of 1-body Jastrow interface: ezfio, provider, ocaml default: 0 diff --git a/src/ao_tc_eff_map/compute_ints_eff_pot.irp.f b/src/ao_tc_eff_map/compute_ints_eff_pot.irp.f index 6196f56e..2e7e21c0 100644 --- a/src/ao_tc_eff_map/compute_ints_eff_pot.irp.f +++ b/src/ao_tc_eff_map/compute_ints_eff_pot.irp.f @@ -1,9 +1,11 @@ + + subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_value) use map_module BEGIN_DOC - ! Parallel client for AO integrals of the TC integrals involving purely hermitian operators + ! Parallel client for AO integrals END_DOC implicit none @@ -21,13 +23,10 @@ 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_erf, j1b_gauss_coul - double precision :: j1b_gauss_coul_debug - double precision :: j1b_gauss_coul_modifdebug - double precision :: j1b_gauss_coulerf + double precision :: j1b_gauss_2e_j1, j1b_gauss_2e_j2 - PROVIDE j1b_gauss + PROVIDE j1b_type thr = ao_integrals_threshold @@ -45,7 +44,7 @@ subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_va exit endif - if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr ) then + if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr) then cycle endif @@ -54,9 +53,12 @@ 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_gauss .eq. 1 ) then - integral = integral & - + j1b_gauss_coulerf(i, k, j, l) + 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 diff --git a/src/ao_tc_eff_map/j1b_1eInteg.py b/src/ao_tc_eff_map/j1b_1eInteg.py deleted file mode 100644 index 53fb1a41..00000000 --- a/src/ao_tc_eff_map/j1b_1eInteg.py +++ /dev/null @@ -1,299 +0,0 @@ -import sys, os -QP_PATH=os.environ["QP_EZFIO"] -sys.path.insert(0,QP_PATH+"/Python/") -from ezfio import ezfio -from datetime import datetime -import time -from math import exp, sqrt, pi -import numpy as np -import subprocess -from scipy.integrate import tplquad -import multiprocessing -from multiprocessing import Pool - - -# _____________________________________________________________________________ -# -def read_ao(): - - with open('ao_data') as f: - lines = f.readlines() - - ao_prim_num = np.zeros((ao_num), dtype=int) - ao_nucl = np.zeros((ao_num), dtype=int) - ao_power = np.zeros((ao_num, 3)) - nucl_coord = np.zeros((ao_num, 3)) - ao_expo = np.zeros((ao_num, ao_num)) - ao_coef = np.zeros((ao_num, ao_num)) - - iline = 0 - for j in range(ao_num): - - line = lines[iline] - iline += 1 - ao_nucl[j] = int(line) - 1 - - line = lines[iline].split() - iline += 1 - ao_power[j, 0] = float(line[0]) - ao_power[j, 1] = float(line[1]) - ao_power[j, 2] = float(line[2]) - - line = lines[iline].split() - iline += 1 - nucl_coord[ao_nucl[j], 0] = float(line[0]) - nucl_coord[ao_nucl[j], 1] = float(line[1]) - nucl_coord[ao_nucl[j], 2] = float(line[2]) - - line = lines[iline] - iline += 1 - ao_prim_num[j] = int(line) - - for l in range(ao_prim_num[j]): - - line = lines[iline].split() - iline += 1 - ao_expo[l, j] = float(line[0]) - ao_coef[l, j] = float(line[1]) - - return( ao_prim_num - , ao_nucl - , ao_power - , nucl_coord - , ao_expo - , ao_coef ) -# _____________________________________________________________________________ - - -# _____________________________________________________________________________ -# -def Gao(X, i_ao): - - ii = ao_nucl[i_ao] - C = np.array([nucl_coord[ii,0], nucl_coord[ii,1], nucl_coord[ii,2]]) - Y = X - C - dis = np.dot(Y,Y) - - ip = np.array([ao_power[i_ao,0], ao_power[i_ao,1], ao_power[i_ao,2]]) - pol = np.prod(Y**ip) - - xi = np.sum( ao_coef[:,i_ao] * np.exp(-dis*ao_expo[:,i_ao]) ) - - return(xi*pol) -# _____________________________________________________________________________ - - -# _____________________________________________________________________________ -# -def grad_Gao(X, i_ao): - - ii = ao_nucl[i_ao] - C = np.array([nucl_coord[ii,0], nucl_coord[ii,1], nucl_coord[ii,2]]) - - ix = ao_power[i_ao,0] - iy = ao_power[i_ao,1] - iz = ao_power[i_ao,2] - - Y = X - C - dis = np.dot(Y,Y) - - xm = np.sum( ao_coef[:,i_ao]*np.exp(-dis*ao_expo[:,i_ao])) - xp = np.sum(ao_expo[:,i_ao]*ao_coef[:,i_ao]*np.exp(-dis*ao_expo[:,i_ao])) - - ip = np.array([ix+1, iy, iz]) - dx = -2. * np.prod(Y**ip) * xp - if(ix > 0): - ip = np.array([ix-1, iy, iz]) - dx += ix * np.prod(Y**ip) * xm - - ip = np.array([ix, iy+1, iz]) - dy = -2. * np.prod(Y**ip) * xp - if(iy > 0): - ip = np.array([ix, iy-1, iz]) - dy += iy * np.prod(Y**ip) * xm - - ip = np.array([ix, iy, iz+1]) - dz = -2. * np.prod(Y**ip) * xp - if(iz > 0): - ip = np.array([ix, iy, iz-1]) - dz += iz * np.prod(Y**ip) * xm - - return(np.array([dx, dy, dz])) -# _____________________________________________________________________________ - - -# _____________________________________________________________________________ -# -# 3 x < XA | exp[-gama r_C^2] | XB > -# - 2 x < XA | r_A^2 exp[-gama r_C^2] | XB > -# -def integ_lap(z, y, x, i_ao, j_ao): - - X = np.array([x, y, z]) - - Gi = Gao(X, i_ao) - Gj = Gao(X, j_ao) - - c = 0. - for k in range(nucl_num): - gama = j1b_gauss_pen[k] - C = nucl_coord[k,:] - Y = X - C - dis = np.dot(Y, Y) - arg = exp(-gama*dis) - arg = exp(-gama*dis) - c += ( 3. - 2. * dis * gama ) * arg * gama * Gi * Gj - - return(c) -# _____________________________________________________________________________ - - -# _____________________________________________________________________________ -# -# -def integ_grad2(z, y, x, i_ao, j_ao): - - X = np.array([x, y, z]) - - Gi = Gao(X, i_ao) - Gj = Gao(X, j_ao) - - c = np.zeros((3)) - for k in range(nucl_num): - gama = j1b_gauss_pen[k] - C = nucl_coord[k,:] - Y = X - C - c += gama * exp(-gama*np.dot(Y, Y)) * Y - - return(-2*np.dot(c,c)*Gi*Gj) -# _____________________________________________________________________________ - - -# _____________________________________________________________________________ -# -# -def integ_nonh(z, y, x, i_ao, j_ao): - - X = np.array([x, y, z]) - - Gi = Gao(X, i_ao) - - c = 0. - for k in range(nucl_num): - gama = j1b_gauss_pen[k] - C = nucl_coord[k,:] - Y = X - C - grad = grad_Gao(X, j_ao) - c += gama * exp(-gama*np.dot(Y,Y)) * np.dot(Y,grad) - - return(2*c*Gi) -# _____________________________________________________________________________ - - -# _____________________________________________________________________________ -# -def perform_integ( ind_ao ): - - i_ao = ind_ao[0] - j_ao = ind_ao[1] - - a = -15. #-np.Inf - b = +15. #+np.Inf - epsrel = 1e-5 - - res_lap, err_lap = tplquad( integ_lap - , a, b - , lambda x : a, lambda x : b - , lambda x,y: a, lambda x,y: b - , (i_ao, j_ao) - , epsrel=epsrel ) - - res_grd, err_grd = tplquad( integ_grad2 - , a, b - , lambda x : a, lambda x : b - , lambda x,y: a, lambda x,y: b - , (i_ao, j_ao) - , epsrel=epsrel ) - - res_nnh, err_nnh = tplquad( integ_nonh - , a, b - , lambda x : a, lambda x : b - , lambda x,y: a, lambda x,y: b - , (i_ao, j_ao) - , epsrel=epsrel ) - - return( [ res_lap, err_lap - , res_grd, err_grd - , res_nnh, err_nnh ]) -# _____________________________________________________________________________ - - -# _____________________________________________________________________________ -# -def integ_eval(): - - list_ind = [] - for i_ao in range(ao_num): - for j_ao in range(ao_num): - list_ind.append( [i_ao, j_ao] ) - - nb_proc = multiprocessing.cpu_count() - print(" --- Excexution with {} processors ---\n".format(nb_proc)) - - p = Pool(nb_proc) - res = np.array( p.map( perform_integ, list_ind ) ) - - ii = 0 - for i_ao in range(ao_num): - for j_ao in range(ao_num): - print(" {} {} {:+e} {:+e} {:+e} {:+e}".format( i_ao, j_ao - , res[ii][0], res[ii][1], res[ii][2], res[ii][3]) ) - ii += 1 - - p.close() -# _____________________________________________________________________________ - - - -# _____________________________________________________________________________ -# -if __name__=="__main__": - - t0 = time.time() - - EZFIO_file = sys.argv[1] - ezfio.set_file(EZFIO_file) - - print(" Today's date:", datetime.now() ) - print(" EZFIO file = {}".format(EZFIO_file)) - - nucl_num = ezfio.get_nuclei_nucl_num() - ao_num = ezfio.get_ao_basis_ao_num() - j1b_gauss_pen = ezfio.get_ao_tc_eff_map_j1b_gauss_pen() - - ao_prim_num, ao_nucl, ao_power, nucl_coord, ao_expo, ao_coef = read_ao() - - #integ_eval() - - i_ao = 0 - j_ao = 0 - - a = -5. - b = +5. - epsrel = 1e-1 - res_grd, err_grd = tplquad( integ_nonh - , a, b - , lambda x : a, lambda x : b - , lambda x,y: a, lambda x,y: b - , (i_ao, j_ao) - , epsrel=epsrel ) - - print(res_grd, err_grd) - - - tf = time.time() - t0 - print(' end after {} min'.format(tf/60.)) -# _____________________________________________________________________________ - - - diff --git a/src/ao_tc_eff_map/j1b_pen.irp.f b/src/ao_tc_eff_map/j1b_pen.irp.f index 9587cfe2..f829108b 100644 --- a/src/ao_tc_eff_map/j1b_pen.irp.f +++ b/src/ao_tc_eff_map/j1b_pen.irp.f @@ -1,7 +1,7 @@ ! --- -BEGIN_PROVIDER [ double precision, j1b_gauss_pen, (nucl_num) ] +BEGIN_PROVIDER [ double precision, j1b_pen, (nucl_num) ] BEGIN_DOC ! exponents of the 1-body Jastrow @@ -13,7 +13,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_pen, (nucl_num) ] PROVIDE ezfio_filename if (mpi_master) then - call ezfio_has_ao_tc_eff_map_j1b_gauss_pen(exists) + call ezfio_has_ao_tc_eff_map_j1b_pen(exists) endif IRP_IF MPI_DEBUG @@ -24,21 +24,21 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_pen, (nucl_num) ] IRP_IF MPI include 'mpif.h' integer :: ierr - call MPI_BCAST(j1b_gauss_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + 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_gauss_pen with MPI' + stop 'Unable to read j1b_pen with MPI' endif IRP_ENDIF if (exists) then if (mpi_master) then - write(6,'(A)') '.. >>>>> [ IO READ: j1b_gauss_pen ] <<<<< ..' - call ezfio_get_ao_tc_eff_map_j1b_gauss_pen(j1b_gauss_pen) + write(6,'(A)') '.. >>>>> [ IO READ: j1b_pen ] <<<<< ..' + call ezfio_get_ao_tc_eff_map_j1b_pen(j1b_pen) IRP_IF MPI - call MPI_BCAST(j1b_gauss_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + 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_gauss_pen with MPI' + stop 'Unable to read j1b_pen with MPI' endif IRP_ENDIF endif @@ -47,7 +47,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_pen, (nucl_num) ] integer :: i do i = 1, nucl_num - j1b_gauss_pen(i) = 1d5 + j1b_pen(i) = 1d5 enddo endif @@ -56,4 +56,57 @@ 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_ao_tc_eff_map_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_ao_tc_eff_map_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/ao_tc_eff_map/map_integrals_eff_pot.irp.f b/src/ao_tc_eff_map/map_integrals_eff_pot.irp.f index 4a6128b9..95dc664d 100644 --- a/src/ao_tc_eff_map/map_integrals_eff_pot.irp.f +++ b/src/ao_tc_eff_map/map_integrals_eff_pot.irp.f @@ -27,42 +27,52 @@ END_PROVIDER END_PROVIDER +! --- + BEGIN_PROVIDER [ double precision, ao_tc_sym_two_e_pot_cache, (0:64*64*64*64) ] + use map_module - implicit none - BEGIN_DOC - ! Cache of |AO| integrals for fast access - END_DOC - PROVIDE ao_tc_sym_two_e_pot_in_map - integer :: i,j,k,l,ii - integer(key_kind) :: idx - real(integral_kind) :: integral + implicit none + + BEGIN_DOC + ! Cache of |AO| integrals for fast access + END_DOC + + integer :: i,j,k,l,ii + integer(key_kind) :: idx + real(integral_kind) :: integral + + PROVIDE ao_tc_sym_two_e_pot_in_map + !$OMP PARALLEL DO PRIVATE (i,j,k,l,idx,ii,integral) - do l=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max - do k=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max - do j=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max - do i=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max - !DIR$ FORCEINLINE - call two_e_integrals_index(i,j,k,l,idx) - !DIR$ FORCEINLINE - call map_get(ao_tc_sym_two_e_pot_map,idx,integral) - ii = l-ao_tc_sym_two_e_pot_cache_min - ii = ior( ishft(ii,6), k-ao_tc_sym_two_e_pot_cache_min) - ii = ior( ishft(ii,6), j-ao_tc_sym_two_e_pot_cache_min) - ii = ior( ishft(ii,6), i-ao_tc_sym_two_e_pot_cache_min) - ao_tc_sym_two_e_pot_cache(ii) = integral - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO + do l = ao_tc_sym_two_e_pot_cache_min, ao_tc_sym_two_e_pot_cache_max + do k = ao_tc_sym_two_e_pot_cache_min, ao_tc_sym_two_e_pot_cache_max + do j = ao_tc_sym_two_e_pot_cache_min, ao_tc_sym_two_e_pot_cache_max + do i = ao_tc_sym_two_e_pot_cache_min, ao_tc_sym_two_e_pot_cache_max + !DIR$ FORCEINLINE + call two_e_integrals_index(i, j, k, l, idx) + !DIR$ FORCEINLINE + call map_get(ao_tc_sym_two_e_pot_map, idx, integral) + ii = l-ao_tc_sym_two_e_pot_cache_min + ii = ior( ishft(ii,6), k-ao_tc_sym_two_e_pot_cache_min) + ii = ior( ishft(ii,6), j-ao_tc_sym_two_e_pot_cache_min) + ii = ior( ishft(ii,6), i-ao_tc_sym_two_e_pot_cache_min) + ao_tc_sym_two_e_pot_cache(ii) = integral + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO END_PROVIDER +! --- + +subroutine insert_into_ao_tc_sym_two_e_pot_map(n_integrals, buffer_i, buffer_values) -subroutine insert_into_ao_tc_sym_two_e_pot_map(n_integrals,buffer_i, buffer_values) use map_module implicit none + BEGIN_DOC ! Create new entry into |AO| map END_DOC @@ -72,21 +82,30 @@ subroutine insert_into_ao_tc_sym_two_e_pot_map(n_integrals,buffer_i, buffer_valu real(integral_kind), intent(inout) :: buffer_values(n_integrals) call map_append(ao_tc_sym_two_e_pot_map, buffer_i, buffer_values, n_integrals) + end -double precision function get_ao_tc_sym_two_e_pot(i,j,k,l,map) result(result) +! --- + +double precision function get_ao_tc_sym_two_e_pot(i, j, k, l, map) result(result) + use map_module + implicit none + BEGIN_DOC - ! Gets one |AO| two-electron integral from the |AO| map in PHYSICIST NOTATION + ! Gets one |AO| two-electron integral from the |AO| map END_DOC + integer, intent(in) :: i,j,k,l integer(key_kind) :: idx type(map_type), intent(inout) :: map integer :: ii real(integral_kind) :: tmp logical, external :: ao_two_e_integral_zero + PROVIDE ao_tc_sym_two_e_pot_in_map ao_tc_sym_two_e_pot_cache ao_tc_sym_two_e_pot_cache_min + !DIR$ FORCEINLINE ! if (ao_two_e_integral_zero(i,j,k,l)) then if (.False.) then @@ -100,9 +119,9 @@ double precision function get_ao_tc_sym_two_e_pot(i,j,k,l,map) result(result) ii = ior(ii, i-ao_tc_sym_two_e_pot_cache_min) if (iand(ii, -64) /= 0) then !DIR$ FORCEINLINE - call two_e_integrals_index(i,j,k,l,idx) + call two_e_integrals_index(i, j, k, l, idx) !DIR$ FORCEINLINE - call map_get(map,idx,tmp) + call map_get(map, idx, tmp) tmp = tmp else ii = l-ao_tc_sym_two_e_pot_cache_min @@ -112,9 +131,12 @@ double precision function get_ao_tc_sym_two_e_pot(i,j,k,l,map) result(result) tmp = ao_tc_sym_two_e_pot_cache(ii) endif endif + result = tmp + end +! --- subroutine get_many_ao_tc_sym_two_e_pot(j,k,l,sze,out_val) use map_module diff --git a/src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f b/src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f new file mode 100644 index 00000000..50c396de --- /dev/null +++ b/src/ao_tc_eff_map/one_e_1bgauss_grad2.irp.f @@ -0,0 +1,332 @@ +! --- + +BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] + + BEGIN_DOC + ! + ! :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle` + ! + END_DOC + + implicit none + + integer :: num_A, num_B + integer :: power_A(3), power_B(3) + integer :: i, j, k1, k2, l, m + double precision :: alpha, beta, gama1, gama2, coef1, coef2 + double precision :: A_center(3), B_center(3), C_center1(3), C_center2(3) + double precision :: c1, c + + integer :: dim1 + double precision :: overlap_y, d_a_2, overlap_z, overlap + + double precision :: int_gauss_4G + + PROVIDE j1b_type j1b_pen j1b_coeff + + ! -------------------------------------------------------------------------------- + ! -- 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_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)] + + !$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 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 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 + 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 + + 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 + + + + + +!_____________________________________________________________________________________________________________ +! +! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB > +! +double precision function int_gauss_4G( A_center, B_center, C_center1, C_center2, power_A, power_B & + , alpha, beta, gama1, gama2 ) + + ! for max_dim + include 'constants.include.F' + + implicit none + + integer , intent(in) :: power_A(3), power_B(3) + double precision, intent(in) :: A_center(3), B_center(3), C_center1(3), C_center2(3) + double precision, intent(in) :: alpha, beta, gama1, gama2 + + integer :: i, dim1, power_C + integer :: iorder(3) + double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3) + double precision :: gama, fact_C, C_center(3) + double precision :: cx0, cy0, cz0, c_tmp1, c_tmp2, cx, cy, cz + double precision :: int_tmp + + double precision :: overlap_gaussian_x + + dim1 = 100 + + ! P_AB(0:max_dim,3) polynomial + ! AB_center(3) new center + ! AB_expo new exponent + ! fact_AB constant factor + ! iorder(3) i_order(i) = order of the polynomials + call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB & + , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1) + + call gaussian_product(gama1, C_center1, gama2, C_center2, fact_C, gama, C_center) + + ! <<< + ! to avoid multi-evaluation + power_C = 0 + + cx0 = 0.d0 + do i = 0, iorder(1) + cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) + enddo + cy0 = 0.d0 + do i = 0, iorder(2) + cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) + enddo + cz0 = 0.d0 + do i = 0, iorder(3) + cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) + enddo + ! >>> + + int_tmp = 0.d0 + + ! ----------------------------------------------------------------------------------------------- + ! + ! x term: + ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (x - x_C1) (x - x_C2) | XB > + ! + + c_tmp1 = 2.d0 * C_center(1) - C_center1(1) - C_center2(1) + c_tmp2 = ( C_center(1) - C_center1(1) ) * ( C_center(1) - C_center2(1) ) + + cx = 0.d0 + do i = 0, iorder(1) + + ! < XA | exp[-gama r_C^2] (x - x_C)^2 | XB > + power_C = 2 + cx = cx + P_AB(i,1) & + * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) + + ! < XA | exp[-gama r_C^2] (x - x_C) | XB > + power_C = 1 + cx = cx + P_AB(i,1) * c_tmp1 & + * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) + + ! < XA | exp[-gama r_C^2] | XB > + power_C = 0 + cx = cx + P_AB(i,1) * c_tmp2 & + * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) + + enddo + + int_tmp += cx * cy0 * cz0 + + ! ----------------------------------------------------------------------------------------------- + + + ! ----------------------------------------------------------------------------------------------- + ! + ! y term: + ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (y - y_C1) (y - y_C2) | XB > + ! + + c_tmp1 = 2.d0 * C_center(2) - C_center1(2) - C_center2(2) + c_tmp2 = ( C_center(2) - C_center1(2) ) * ( C_center(2) - C_center2(2) ) + + cy = 0.d0 + do i = 0, iorder(2) + + ! < XA | exp[-gama r_C^2] (y - y_C)^2 | XB > + power_C = 2 + cy = cy + P_AB(i,2) & + * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) + + ! < XA | exp[-gama r_C^2] (y - y_C) | XB > + power_C = 1 + cy = cy + P_AB(i,2) * c_tmp1 & + * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) + + ! < XA | exp[-gama r_C^2] | XB > + power_C = 0 + cy = cy + P_AB(i,2) * c_tmp2 & + * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) + + enddo + + int_tmp += cx0 * cy * cz0 + + ! ----------------------------------------------------------------------------------------------- + + + ! ----------------------------------------------------------------------------------------------- + ! + ! z term: + ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (z - z_C1) (z - z_C2) | XB > + ! + + c_tmp1 = 2.d0 * C_center(3) - C_center1(3) - C_center2(3) + c_tmp2 = ( C_center(3) - C_center1(3) ) * ( C_center(3) - C_center2(3) ) + + cz = 0.d0 + do i = 0, iorder(3) + + ! < XA | exp[-gama r_C^2] (z - z_C)^2 | XB > + power_C = 2 + cz = cz + P_AB(i,3) & + * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) + + ! < XA | exp[-gama r_C^2] (z - z_C) | XB > + power_C = 1 + cz = cz + P_AB(i,3) * c_tmp1 & + * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) + + ! < XA | exp[-gama r_C^2] | XB > + power_C = 0 + cz = cz + P_AB(i,3) * c_tmp2 & + * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) + + enddo + + int_tmp += cx0 * cy0 * cz + + ! ----------------------------------------------------------------------------------------------- + + int_gauss_4G = fact_AB * fact_C * int_tmp + + return +end function int_gauss_4G +!_____________________________________________________________________________________________________________ +!_____________________________________________________________________________________________________________ + + diff --git a/src/ao_tc_eff_map/one_e_1bgauss_hermit.irp.f b/src/ao_tc_eff_map/one_e_1bgauss_hermit.irp.f deleted file mode 100644 index 21b6ed83..00000000 --- a/src/ao_tc_eff_map/one_e_1bgauss_hermit.irp.f +++ /dev/null @@ -1,519 +0,0 @@ - -BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)] - - BEGIN_DOC - ! - ! Hermitian part of 1-body Jastrow factow in the |AO| basis set. - ! - ! :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle` - ! - END_DOC - - implicit none - - integer :: num_A, num_B - integer :: power_A(3), power_B(3) - integer :: i, j, k1, k2, l, m - double precision :: alpha, beta, gama1, gama2 - double precision :: A_center(3), B_center(3), C_center1(3), C_center2(3) - double precision :: c1, c - - integer :: dim1 - double precision :: overlap_y, d_a_2, overlap_z, overlap - - double precision :: int_gauss_4G - - 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_hermII(1:ao_num,1:ao_num) = 0.d0 - - !$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 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_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_gauss_pen(k1) - C_center1(1:3) = nucl_coord(k1,1:3) - - do k2 = 1, nucl_num - gama2 = j1b_gauss_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 - 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 - -END_PROVIDER - - - - - -!_____________________________________________________________________________________________________________ -! -! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB > -! -double precision function int_gauss_4G( A_center, B_center, C_center1, C_center2, power_A, power_B & - , alpha, beta, gama1, gama2 ) - - ! for max_dim - include 'constants.include.F' - - implicit none - - integer , intent(in) :: power_A(3), power_B(3) - double precision, intent(in) :: A_center(3), B_center(3), C_center1(3), C_center2(3) - double precision, intent(in) :: alpha, beta, gama1, gama2 - - integer :: i, dim1, power_C - integer :: iorder(3) - double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3) - double precision :: gama, fact_C, C_center(3) - double precision :: cx0, cy0, cz0, c_tmp1, c_tmp2, cx, cy, cz - double precision :: int_tmp - - double precision :: overlap_gaussian_x - - dim1 = 100 - - ! P_AB(0:max_dim,3) polynomial - ! AB_center(3) new center - ! AB_expo new exponent - ! fact_AB constant factor - ! iorder(3) i_order(i) = order of the polynomials - call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB & - , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1) - - call gaussian_product(gama1, C_center1, gama2, C_center2, fact_C, gama, C_center) - - ! <<< - ! to avoid multi-evaluation - power_C = 0 - - cx0 = 0.d0 - do i = 0, iorder(1) - cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) - enddo - cy0 = 0.d0 - do i = 0, iorder(2) - cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) - enddo - cz0 = 0.d0 - do i = 0, iorder(3) - cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) - enddo - ! >>> - - int_tmp = 0.d0 - - ! ----------------------------------------------------------------------------------------------- - ! - ! x term: - ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (x - x_C1) (x - x_C2) | XB > - ! - - c_tmp1 = 2.d0 * C_center(1) - C_center1(1) - C_center2(1) - c_tmp2 = ( C_center(1) - C_center1(1) ) * ( C_center(1) - C_center2(1) ) - - cx = 0.d0 - do i = 0, iorder(1) - - ! < XA | exp[-gama r_C^2] (x - x_C)^2 | XB > - power_C = 2 - cx = cx + P_AB(i,1) & - * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) - - ! < XA | exp[-gama r_C^2] (x - x_C) | XB > - power_C = 1 - cx = cx + P_AB(i,1) * c_tmp1 & - * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) - - ! < XA | exp[-gama r_C^2] | XB > - power_C = 0 - cx = cx + P_AB(i,1) * c_tmp2 & - * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) - - enddo - - int_tmp += cx * cy0 * cz0 - - ! ----------------------------------------------------------------------------------------------- - - - ! ----------------------------------------------------------------------------------------------- - ! - ! y term: - ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (y - y_C1) (y - y_C2) | XB > - ! - - c_tmp1 = 2.d0 * C_center(2) - C_center1(2) - C_center2(2) - c_tmp2 = ( C_center(2) - C_center1(2) ) * ( C_center(2) - C_center2(2) ) - - cy = 0.d0 - do i = 0, iorder(2) - - ! < XA | exp[-gama r_C^2] (y - y_C)^2 | XB > - power_C = 2 - cy = cy + P_AB(i,2) & - * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) - - ! < XA | exp[-gama r_C^2] (y - y_C) | XB > - power_C = 1 - cy = cy + P_AB(i,2) * c_tmp1 & - * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) - - ! < XA | exp[-gama r_C^2] | XB > - power_C = 0 - cy = cy + P_AB(i,2) * c_tmp2 & - * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) - - enddo - - int_tmp += cx0 * cy * cz0 - - ! ----------------------------------------------------------------------------------------------- - - - ! ----------------------------------------------------------------------------------------------- - ! - ! z term: - ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (z - z_C1) (z - z_C2) | XB > - ! - - c_tmp1 = 2.d0 * C_center(3) - C_center1(3) - C_center2(3) - c_tmp2 = ( C_center(3) - C_center1(3) ) * ( C_center(3) - C_center2(3) ) - - cz = 0.d0 - do i = 0, iorder(3) - - ! < XA | exp[-gama r_C^2] (z - z_C)^2 | XB > - power_C = 2 - cz = cz + P_AB(i,3) & - * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) - - ! < XA | exp[-gama r_C^2] (z - z_C) | XB > - power_C = 1 - cz = cz + P_AB(i,3) * c_tmp1 & - * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) - - ! < XA | exp[-gama r_C^2] | XB > - power_C = 0 - cz = cz + P_AB(i,3) * c_tmp2 & - * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) - - enddo - - int_tmp += cx0 * cy0 * cz - - ! ----------------------------------------------------------------------------------------------- - - int_gauss_4G = fact_AB * fact_C * int_tmp - - return -end function int_gauss_4G -!_____________________________________________________________________________________________________________ -!_____________________________________________________________________________________________________________ - -BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] - - BEGIN_DOC - ! - ! Hermitian part of 1-body Jastrow factow in the |AO| basis set. - ! - ! :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \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, c2, c - - integer :: dim1 - double precision :: overlap_y, d_a_2, overlap_z, overlap - - double precision :: int_gauss_r0, int_gauss_r2 - - 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_hermI(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, 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_gauss_pen, j1b_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_gauss_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 - - enddo - enddo - enddo - enddo - - !$OMP END DO - !$OMP END PARALLEL - -END_PROVIDER - - -!_____________________________________________________________________________________________________________ -! -! < XA | exp[-gama r_C^2] | XB > -! -double precision function int_gauss_r0(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama) - - ! for max_dim - include 'constants.include.F' - - implicit none - - integer , intent(in) :: power_A(3), power_B(3) - double precision, intent(in) :: A_center(3), B_center(3), C_center(3) - double precision, intent(in) :: alpha, beta, gama - - integer :: i, power_C, dim1 - integer :: iorder(3) - integer :: nmax - double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3) - double precision :: cx, cy, cz - - double precision :: overlap_gaussian_x - - dim1 = 100 - - ! P_AB(0:max_dim,3) polynomial - ! AB_center(3) new center - ! AB_expo new exponent - ! fact_AB constant factor - ! iorder(3) i_order(i) = order of the polynomials - call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB & - , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1) - - if( fact_AB .lt. 1d-20 ) then - int_gauss_r0 = 0.d0 - return - endif - - power_C = 0 - cx = 0.d0 - do i = 0, iorder(1) - cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) - enddo - cy = 0.d0 - do i = 0, iorder(2) - cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) - enddo - cz = 0.d0 - do i = 0, iorder(3) - cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) - enddo - - int_gauss_r0 = fact_AB * cx * cy * cz - - return -end function int_gauss_r0 -!_____________________________________________________________________________________________________________ -!_____________________________________________________________________________________________________________ - - - -!_____________________________________________________________________________________________________________ -! -! < XA | r_C^2 exp[-gama r_C^2] | XB > -! -double precision function int_gauss_r2(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama) - - ! for max_dim - include 'constants.include.F' - - implicit none - - integer, intent(in) :: power_A(3), power_B(3) - double precision, intent(in) :: A_center(3), B_center(3), C_center(3) - double precision, intent(in) :: alpha, beta, gama - - integer :: i, power_C, dim1 - integer :: iorder(3) - double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3) - double precision :: cx0, cy0, cz0, cx, cy, cz - double precision :: int_tmp - - double precision :: overlap_gaussian_x - - dim1 = 100 - - ! P_AB(0:max_dim,3) polynomial centered on AB_center - ! AB_center(3) new center - ! AB_expo new exponent - ! fact_AB constant factor - ! iorder(3) i_order(i) = order of the polynomials - call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB & - , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1) - - ! <<< - ! to avoid multi-evaluation - power_C = 0 - - cx0 = 0.d0 - do i = 0, iorder(1) - cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) - enddo - cy0 = 0.d0 - do i = 0, iorder(2) - cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) - enddo - cz0 = 0.d0 - do i = 0, iorder(3) - cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) - enddo - ! >>> - - int_tmp = 0.d0 - - power_C = 2 - - ! ( x - XC)^2 - cx = 0.d0 - do i = 0, iorder(1) - cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) - enddo - int_tmp += cx * cy0 * cz0 - - ! ( y - YC)^2 - cy = 0.d0 - do i = 0, iorder(2) - cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) - enddo - int_tmp += cx0 * cy * cz0 - - ! ( z - ZC)^2 - cz = 0.d0 - do i = 0, iorder(3) - cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) - enddo - int_tmp += cx0 * cy0 * cz - - int_gauss_r2 = fact_AB * int_tmp - - return -end function int_gauss_r2 -!_____________________________________________________________________________________________________________ -!_____________________________________________________________________________________________________________ diff --git a/src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f b/src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f new file mode 100644 index 00000000..0a0b7610 --- /dev/null +++ b/src/ao_tc_eff_map/one_e_1bgauss_lap.irp.f @@ -0,0 +1,303 @@ +! --- + +BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)] + + BEGIN_DOC + ! + ! :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \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, coef + double precision :: A_center(3), B_center(3), C_center(3) + double precision :: c1, c2, c + + integer :: dim1 + double precision :: overlap_y, d_a_2, overlap_z, overlap + + double precision :: int_gauss_r0, int_gauss_r2 + + PROVIDE j1b_type j1b_pen j1b_coeff + + ! -------------------------------------------------------------------------------- + ! -- 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_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)] + + !$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, 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 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 + 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 + + +!_____________________________________________________________________________________________________________ +! +! < XA | exp[-gama r_C^2] | XB > +! +double precision function int_gauss_r0(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama) + + ! for max_dim + include 'constants.include.F' + + implicit none + + integer , intent(in) :: power_A(3), power_B(3) + double precision, intent(in) :: A_center(3), B_center(3), C_center(3) + double precision, intent(in) :: alpha, beta, gama + + integer :: i, power_C, dim1 + integer :: iorder(3) + integer :: nmax + double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3) + double precision :: cx, cy, cz + + double precision :: overlap_gaussian_x + + dim1 = 100 + + ! P_AB(0:max_dim,3) polynomial + ! AB_center(3) new center + ! AB_expo new exponent + ! fact_AB constant factor + ! iorder(3) i_order(i) = order of the polynomials + call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB & + , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1) + + if( fact_AB .lt. 1d-20 ) then + int_gauss_r0 = 0.d0 + return + endif + + power_C = 0 + cx = 0.d0 + do i = 0, iorder(1) + cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) + enddo + cy = 0.d0 + do i = 0, iorder(2) + cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) + enddo + cz = 0.d0 + do i = 0, iorder(3) + cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) + enddo + + int_gauss_r0 = fact_AB * cx * cy * cz + + return +end function int_gauss_r0 +!_____________________________________________________________________________________________________________ +!_____________________________________________________________________________________________________________ + + + +!_____________________________________________________________________________________________________________ +! +! < XA | r_C^2 exp[-gama r_C^2] | XB > +! +double precision function int_gauss_r2(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama) + + ! for max_dim + include 'constants.include.F' + + implicit none + + integer, intent(in) :: power_A(3), power_B(3) + double precision, intent(in) :: A_center(3), B_center(3), C_center(3) + double precision, intent(in) :: alpha, beta, gama + + integer :: i, power_C, dim1 + integer :: iorder(3) + double precision :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3) + double precision :: cx0, cy0, cz0, cx, cy, cz + double precision :: int_tmp + + double precision :: overlap_gaussian_x + + dim1 = 100 + + ! P_AB(0:max_dim,3) polynomial centered on AB_center + ! AB_center(3) new center + ! AB_expo new exponent + ! fact_AB constant factor + ! iorder(3) i_order(i) = order of the polynomials + call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB & + , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1) + + ! <<< + ! to avoid multi-evaluation + power_C = 0 + + cx0 = 0.d0 + do i = 0, iorder(1) + cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) + enddo + cy0 = 0.d0 + do i = 0, iorder(2) + cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) + enddo + cz0 = 0.d0 + do i = 0, iorder(3) + cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) + enddo + ! >>> + + int_tmp = 0.d0 + + power_C = 2 + + ! ( x - XC)^2 + cx = 0.d0 + do i = 0, iorder(1) + cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1) + enddo + int_tmp += cx * cy0 * cz0 + + ! ( y - YC)^2 + cy = 0.d0 + do i = 0, iorder(2) + cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1) + enddo + int_tmp += cx0 * cy * cz0 + + ! ( z - ZC)^2 + cz = 0.d0 + do i = 0, iorder(3) + cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1) + enddo + int_tmp += cx0 * cy0 * cz + + int_gauss_r2 = fact_AB * int_tmp + + return +end function int_gauss_r2 +!_____________________________________________________________________________________________________________ +!_____________________________________________________________________________________________________________ + + diff --git a/src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f b/src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f index 3ae3e019..bd881d32 100644 --- a/src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f +++ b/src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f @@ -1,11 +1,10 @@ +! --- + 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 + ! j1b_gauss_nonherm(i,j) = \langle \chi_j | - grad \tau_{1b} \cdot grad | \chi_i \rangle ! END_DOC @@ -14,7 +13,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] 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 :: alpha, beta, gama, coef double precision :: A_center(3), B_center(3), C_center(3) double precision :: c1, c @@ -23,7 +22,7 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] double precision :: int_gauss_deriv - PROVIDE j1b_gauss_pen + PROVIDE j1b_type j1b_pen j1b_coeff ! -------------------------------------------------------------------------------- ! -- Dummy call to provide everything @@ -41,6 +40,9 @@ BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)] j1b_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) & !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama, & @@ -49,53 +51,101 @@ 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_gauss_pen, j1b_gauss_nonherm) - + !$OMP nucl_num, j1b_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 + 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 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 + 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 @@ -317,3 +367,5 @@ double precision function int_gauss_deriv(A_center, B_center, C_center, power_A, end function int_gauss_deriv !_____________________________________________________________________________________________________________ !_____________________________________________________________________________________________________________ + + diff --git a/src/ao_tc_eff_map/two_e_1bgauss_coul.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_coul.irp.f deleted file mode 100644 index 8d819711..00000000 --- a/src/ao_tc_eff_map/two_e_1bgauss_coul.irp.f +++ /dev/null @@ -1,800 +0,0 @@ -double precision function j1b_gauss_coul(i, j, k, l) - - BEGIN_DOC - ! - ! integral in the AO basis: - ! i(r1) j(r1) f(r12) k(r2) l(r2) - ! - ! with: - ! f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] - ! = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! + (r2-RA)^2 exp(-aA r2A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! - END_DOC - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: i, j, k, l - - integer :: p, q, r, s, ii - integer :: num_i, num_j, num_k, num_l, num_ii - integer :: I_power(3), J_power(3), K_power(3), L_power(3) - integer :: iorder_p(3), iorder_q(3) - integer :: shift_P(3), shift_Q(3) - integer :: dim1 - - double precision :: coef1, coef2, coef3, coef4 - double precision :: expo1, expo2, expo3, expo4 - double precision :: p_inv, q_inv - double precision :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp - double precision :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp - double precision :: P_new(0:max_dim,3), P_center(3), fact_p, pp - double precision :: Q_new(0:max_dim,3), Q_center(3), fact_q, qq - double precision :: I_center(3), J_center(3), K_center(3), L_center(3) - double precision :: expoii, factii, Centerii(3) - double precision :: ff, gg, cx, cy, cz - - double precision :: general_primitive_integral_coul_shifted - - PROVIDE j1b_gauss_pen - - dim1 = n_pt_max_integrals - - num_i = ao_nucl(i) - num_j = ao_nucl(j) - num_k = ao_nucl(k) - num_l = ao_nucl(l) - - do p = 1, 3 - I_power(p) = ao_power(i,p) - J_power(p) = ao_power(j,p) - K_power(p) = ao_power(k,p) - L_power(p) = ao_power(l,p) - I_center(p) = nucl_coord(num_i,p) - J_center(p) = nucl_coord(num_j,p) - K_center(p) = nucl_coord(num_k,p) - L_center(p) = nucl_coord(num_l,p) - enddo - - j1b_gauss_coul = 0.d0 - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! - ! ------------------------------------------------------------------------------------------------------------------- - - shift_Q = (/ 0, 0, 0 /) - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q_inv = 1.d0 / qq - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center) - - fact_p = fact_p_tmp * factii - p_inv = 1.d0 / pp - - ! pol centerd on P_center_tmp ==> centerd on P_center - call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - ff = P_center(1) - Centerii(1) - - shift_P = (/ 2, 0, 0 /) - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 1, 0, 0 /) - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! y term: - - ff = P_center(2) - Centerii(2) - - shift_P = (/ 0, 2, 0 /) - cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 1, 0 /) - cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! z term: - - ff = P_center(3) - Centerii(3) - - shift_P = (/ 0, 0, 2 /) - cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 1 /) - cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul = j1b_gauss_coul + coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2) - ! - ! ------------------------------------------------------------------------------------------------------------------- - - shift_P = (/ 0, 0, 0 /) - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - p_inv = 1.d0 / pp - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center) - - fact_q = fact_q_tmp * factii - q_inv = 1.d0 / qq - - ! pol centerd on Q_center_tmp ==> centerd on Q_center - call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - ff = Q_center(1) - Centerii(1) - - shift_Q = (/ 2, 0, 0 /) - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! y term: - - ff = Q_center(2) - Centerii(2) - - shift_Q = (/ 0, 2, 0 /) - cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 1, 0 /) - cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! z term: - - ff = Q_center(3) - Centerii(3) - - shift_Q = (/ 0, 0, 2 /) - cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 1 /) - cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul = j1b_gauss_coul + coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ] - ! - ! ------------------------------------------------------------------------------------------------------------------- - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q_inv = 1.d0 / qq - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center) - - fact_p = fact_p_tmp * factii - p_inv = 1.d0 / pp - - ! pol centerd on P_center_tmp ==> centerd on P_center - call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - ff = P_center(1) - Centerii(1) - gg = Q_center(1) - Centerii(1) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! y term: - - ff = P_center(2) - Centerii(2) - gg = Q_center(2) - Centerii(2) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy + expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy + expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! z term: - - ff = P_center(3) - Centerii(3) - gg = Q_center(3) - Centerii(3) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz + expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz + expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul = j1b_gauss_coul - coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! - ! ------------------------------------------------------------------------------------------------------------------- - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - p_inv = 1.d0 / pp - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center) - - fact_q = fact_q_tmp * factii - q_inv = 1.d0 / qq - - ! pol centerd on Q_center_tmp ==> centerd on Q_center - call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - ff = P_center(1) - Centerii(1) - gg = Q_center(1) - Centerii(1) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! y term: - - ff = P_center(2) - Centerii(2) - gg = Q_center(2) - Centerii(2) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy + expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy + expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! z term: - - ff = P_center(3) - Centerii(3) - gg = Q_center(3) - Centerii(3) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz + expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz + expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul = j1b_gauss_coul - coef4 * ( cx + cy + cz ) - - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - return -end function j1b_gauss_coul - - - - -!______________________________________________________________________________________________________________________ -!______________________________________________________________________________________________________________________ - -double precision function general_primitive_integral_coul_shifted( dim & - , P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q ) - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: dim - integer, intent(in) :: iorder_p(3), shift_P(3) - integer, intent(in) :: iorder_q(3), shift_Q(3) - double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv - double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv - - integer :: n_Ix, n_Iy, n_Iz, nx, ny, nz - integer :: ix, iy, iz, jx, jy, jz, i - integer :: n_pt_tmp, n_pt_out, iorder - integer :: ii, jj - double precision :: rho, dist - double precision :: dx(0:max_dim), Ix_pol(0:max_dim) - double precision :: dy(0:max_dim), Iy_pol(0:max_dim) - double precision :: dz(0:max_dim), Iz_pol(0:max_dim) - double precision :: a, b, c, d, e, f, accu, pq, const - double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2 - double precision :: d1(0:max_dim), d_poly(0:max_dim) - double precision :: p_plus_q - - double precision :: rint_sum - - general_primitive_integral_coul_shifted = 0.d0 - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly - - ! Gaussian Product - ! ---------------- - p_plus_q = (p+q) - pq = p_inv * 0.5d0 * q_inv - pq_inv = 0.5d0 / p_plus_q - p10_1 = q * pq ! 1/(2p) - p01_1 = p * pq ! 1/(2q) - pq_inv_2 = pq_inv + pq_inv - p10_2 = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p) - p01_2 = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq) - - accu = 0.d0 - - iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1) - iorder = iorder + shift_P(1) + shift_Q(1) - iorder = iorder + shift_P(1) + shift_Q(1) - !DIR$ VECTOR ALIGNED - do ix = 0, iorder - Ix_pol(ix) = 0.d0 - enddo - n_Ix = 0 - do ix = 0, iorder_p(1) - - ii = ix + shift_P(1) - a = P_new(ix,1) - if(abs(a) < thresh) cycle - - do jx = 0, iorder_q(1) - - jj = jx + shift_Q(1) - d = a * Q_new(jx,1) - if(abs(d) < thresh) cycle - - !DEC$ FORCEINLINE - call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj & - , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx ) - !DEC$ FORCEINLINE - call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix) - enddo - enddo - if(n_Ix == -1) then - return - endif - - iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2) - iorder = iorder + shift_P(2) + shift_Q(2) - iorder = iorder + shift_P(2) + shift_Q(2) - !DIR$ VECTOR ALIGNED - do ix = 0, iorder - Iy_pol(ix) = 0.d0 - enddo - n_Iy = 0 - do iy = 0, iorder_p(2) - - if(abs(P_new(iy,2)) > thresh) then - - ii = iy + shift_P(2) - b = P_new(iy,2) - - do jy = 0, iorder_q(2) - - jj = jy + shift_Q(2) - e = b * Q_new(jy,2) - if(abs(e) < thresh) cycle - - !DEC$ FORCEINLINE - call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj & - , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny ) - !DEC$ FORCEINLINE - call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy) - enddo - endif - enddo - if(n_Iy == -1) then - return - endif - - iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3) - iorder = iorder + shift_P(3) + shift_Q(3) - iorder = iorder + shift_P(3) + shift_Q(3) - do ix = 0, iorder - Iz_pol(ix) = 0.d0 - enddo - n_Iz = 0 - do iz = 0, iorder_p(3) - - if( abs(P_new(iz,3)) > thresh ) then - - ii = iz + shift_P(3) - c = P_new(iz,3) - - do jz = 0, iorder_q(3) - - jj = jz + shift_Q(3) - f = c * Q_new(jz,3) - if(abs(f) < thresh) cycle - - !DEC$ FORCEINLINE - call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj & - , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz ) - !DEC$ FORCEINLINE - call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz) - enddo - endif - enddo - if(n_Iz == -1) then - return - endif - - rho = p * q * pq_inv_2 - dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) & - + (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) & - + (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3)) - const = dist*rho - - n_pt_tmp = n_Ix + n_Iy - do i = 0, n_pt_tmp - d_poly(i) = 0.d0 - enddo - - !DEC$ FORCEINLINE - call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp) - if(n_pt_tmp == -1) then - return - endif - n_pt_out = n_pt_tmp + n_Iz - do i = 0, n_pt_out - d1(i) = 0.d0 - enddo - - !DEC$ FORCEINLINE - call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out) - accu = accu + rint_sum(n_pt_out, const, d1) - - 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 -!______________________________________________________________________________________________________________________ -!______________________________________________________________________________________________________________________ diff --git a/src/ao_tc_eff_map/two_e_1bgauss_coul_acc.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_coul_acc.irp.f deleted file mode 100644 index cee9183c..00000000 --- a/src/ao_tc_eff_map/two_e_1bgauss_coul_acc.irp.f +++ /dev/null @@ -1,433 +0,0 @@ -double precision function j1b_gauss_coul_acc(i, j, k, l) - - BEGIN_DOC - ! - ! integral in the AO basis: - ! i(r1) j(r1) f(r12) k(r2) l(r2) - ! - ! with: - ! f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] - ! = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! + (r2-RA)^2 exp(-aA r2A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! - END_DOC - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: i, j, k, l - - integer :: p, q, r, s, ii - integer :: num_i, num_j, num_k, num_l, num_ii - integer :: I_power(3), J_power(3), K_power(3), L_power(3) - integer :: iorder_p(3), iorder_q(3) - integer :: shift_P(3), shift_Q(3) - integer :: dim1 - - double precision :: coef1, coef2, coef3, coef4 - double precision :: expo1, expo2, expo3, expo4 - double precision :: p1_inv, q1_inv, p2_inv, q2_inv - double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1 - double precision :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2 - double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1 - double precision :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2 - double precision :: I_center(3), J_center(3), K_center(3), L_center(3) - double precision :: expoii, factii, Centerii(3) - double precision :: ff, gg, cx, cy, cz - - double precision :: general_primitive_integral_coul_shifted - !double precision :: j1b_gauss_coul_schwartz_accel - - PROVIDE j1b_gauss_pen - - dim1 = n_pt_max_integrals - - ! TODO - !if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then - ! j1b_gauss_coul_schwartz_accel = j1b_gauss_coul_schwartz_accel(i, j, k, l) - ! return - !endif - - num_i = ao_nucl(i) - num_j = ao_nucl(j) - num_k = ao_nucl(k) - num_l = ao_nucl(l) - - do p = 1, 3 - I_power(p) = ao_power(i,p) - J_power(p) = ao_power(j,p) - K_power(p) = ao_power(k,p) - L_power(p) = ao_power(l,p) - I_center(p) = nucl_coord(num_i,p) - J_center(p) = nucl_coord(num_j,p) - K_center(p) = nucl_coord(num_k,p) - L_center(p) = nucl_coord(num_l,p) - enddo - - j1b_gauss_coul_acc = 0.d0 - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - p1_inv = 1.d0 / pp1 - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q1_inv = 1.d0 / qq1 - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center) - fact_p2 = fact_p1 * factii - p2_inv = 1.d0 / pp2 - call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new) - - call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center) - fact_q2 = fact_q1 * factii - q2_inv = 1.d0 / qq2 - call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new) - - - ! ---------------------------------------------------------------------------------------------------- - ! [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! ---------------------------------------------------------------------------------------------------- - - shift_Q = (/ 0, 0, 0 /) - - ! x term: - ff = P2_center(1) - Centerii(1) - - shift_P = (/ 2, 0, 0 /) - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 1, 0, 0 /) - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! y term: - ff = P2_center(2) - Centerii(2) - - shift_P = (/ 0, 2, 0 /) - cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 1, 0 /) - cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! z term: - ff = P2_center(3) - Centerii(3) - - shift_P = (/ 0, 0, 2 /) - cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 1 /) - cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - - - ! ---------------------------------------------------------------------------------------------------- - ! [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2) - ! ---------------------------------------------------------------------------------------------------- - - shift_P = (/ 0, 0, 0 /) - - ! x term: - ff = Q2_center(1) - Centerii(1) - - shift_Q = (/ 2, 0, 0 /) - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! y term: - ff = Q2_center(2) - Centerii(2) - - shift_Q = (/ 0, 2, 0 /) - cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 1, 0 /) - cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! z term: - ff = Q2_center(3) - Centerii(3) - - shift_Q = (/ 0, 0, 2 /) - cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 1 /) - cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - - - ! ---------------------------------------------------------------------------------------------------- - ! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ] - ! ---------------------------------------------------------------------------------------------------- - - ! x term: - ff = P2_center(1) - Centerii(1) - gg = Q1_center(1) - Centerii(1) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx - expoii * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! y term: - ff = P2_center(2) - Centerii(2) - gg = Q1_center(2) - Centerii(2) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy - expoii * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! z term: - ff = P2_center(3) - Centerii(3) - gg = Q1_center(3) - Centerii(3) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz - expoii * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - - - ! ---------------------------------------------------------------------------------------------------- - ! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! ---------------------------------------------------------------------------------------------------- - - ! x term: - ff = P1_center(1) - Centerii(1) - gg = Q2_center(1) - Centerii(1) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx - expoii * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! y term: - ff = P1_center(2) - Centerii(2) - gg = Q2_center(2) - Centerii(2) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy - expoii * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! z term: - ff = P1_center(3) - Centerii(3) - gg = Q2_center(3) - Centerii(3) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz - expoii * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul_acc = j1b_gauss_coul_acc + coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - return -end function j1b_gauss_coul_acc diff --git a/src/ao_tc_eff_map/two_e_1bgauss_coul_debug.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_coul_debug.irp.f deleted file mode 100644 index 8ced59e4..00000000 --- a/src/ao_tc_eff_map/two_e_1bgauss_coul_debug.irp.f +++ /dev/null @@ -1,397 +0,0 @@ -double precision function j1b_gauss_coul_debug(i, j, k, l) - - BEGIN_DOC - ! - ! integral in the AO basis: - ! i(r1) j(r1) f(r12) k(r2) l(r2) - ! - ! with: - ! f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] - ! = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! + (r2-RA)^2 exp(-aA r2A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! - END_DOC - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: i, j, k, l - - integer :: p, q, r, s, ii - integer :: num_i, num_j, num_k, num_l, num_ii - integer :: I_power(3), J_power(3), K_power(3), L_power(3) - integer :: iorder_p(3), iorder_q(3) - integer :: shift_P(3), shift_Q(3) - integer :: dim1 - - double precision :: coef1, coef2, coef3, coef4 - double precision :: expo1, expo2, expo3, expo4 - double precision :: p_inv, q_inv - double precision :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp - double precision :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp - double precision :: P_new(0:max_dim,3), P_center(3), fact_p, pp - double precision :: Q_new(0:max_dim,3), Q_center(3), fact_q, qq - double precision :: I_center(3), J_center(3), K_center(3), L_center(3) - double precision :: expoii, factii, Centerii(3) - double precision :: ff, gg, cx, cy, cz - - double precision :: general_primitive_integral_coul_shifted - - PROVIDE j1b_gauss_pen - - dim1 = n_pt_max_integrals - - num_i = ao_nucl(i) - num_j = ao_nucl(j) - num_k = ao_nucl(k) - num_l = ao_nucl(l) - - do p = 1, 3 - I_power(p) = ao_power(i,p) - J_power(p) = ao_power(j,p) - K_power(p) = ao_power(k,p) - L_power(p) = ao_power(l,p) - I_center(p) = nucl_coord(num_i,p) - J_center(p) = nucl_coord(num_j,p) - K_center(p) = nucl_coord(num_k,p) - L_center(p) = nucl_coord(num_l,p) - enddo - - j1b_gauss_coul_debug = 0.d0 - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! - ! ------------------------------------------------------------------------------------------------------------------- - - shift_Q = (/ 0, 0, 0 /) - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q_inv = 1.d0 / qq - - cx = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center) - - fact_p = fact_p_tmp * factii - p_inv = 1.d0 / pp - - ! pol centerd on P_center_tmp ==> centerd on P_center - call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - ff = P_center(1) - Centerii(1) - - shift_P = (/ 2, 0, 0 /) - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 1, 0, 0 /) - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul_debug = j1b_gauss_coul_debug + coef4 * cx - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - -! ! ------------------------------------------------------------------------------------------------------------------- -! ! -! ! [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2) -! ! -! ! ------------------------------------------------------------------------------------------------------------------- -! -! shift_P = (/ 0, 0, 0 /) -! -! do p = 1, ao_prim_num(i) -! coef1 = ao_coef_normalized_ordered_transp(p, i) -! expo1 = ao_expo_ordered_transp(p, i) -! -! do q = 1, ao_prim_num(j) -! coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) -! expo2 = ao_expo_ordered_transp(q, j) -! -! call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 & -! , I_power, J_power, I_center, J_center, dim1 ) -! p_inv = 1.d0 / pp -! -! do r = 1, ao_prim_num(k) -! coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) -! expo3 = ao_expo_ordered_transp(r, k) -! -! do s = 1, ao_prim_num(l) -! coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) -! expo4 = ao_expo_ordered_transp(s, l) -! -! call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 & -! , K_power, L_power, K_center, L_center, dim1 ) -! -! cx = 0.d0 -! do ii = 1, nucl_num -! expoii = j1b_gauss_pen(ii) -! Centerii(1:3) = nucl_coord(ii, 1:3) -! -! call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center) -! -! fact_q = fact_q_tmp * factii -! q_inv = 1.d0 / qq -! -! ! pol centerd on Q_center_tmp ==> centerd on Q_center -! call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new) -! -! ! ---------------------------------------------------------------------------------------------------- -! ! x term: -! -! ff = Q_center(1) - Centerii(1) -! -! shift_Q = (/ 2, 0, 0 /) -! cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & -! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & -! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) -! -! shift_Q = (/ 1, 0, 0 /) -! cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & -! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & -! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) -! -! shift_Q = (/ 0, 0, 0 /) -! cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 & -! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & -! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) -! -! ! ---------------------------------------------------------------------------------------------------- -! -! enddo -! -! j1b_gauss_coul_debug = j1b_gauss_coul_debug + coef4 * cx -! enddo ! s -! enddo ! r -! enddo ! q -! enddo ! p -! -! ! ------------------------------------------------------------------------------------------------------------------- -! ! ------------------------------------------------------------------------------------------------------------------- - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ] - ! - ! ------------------------------------------------------------------------------------------------------------------- - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q_inv = 1.d0 / qq - - cx = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center) - - fact_p = fact_p_tmp * factii - p_inv = 1.d0 / pp - - ! pol centerd on P_center_tmp ==> centerd on P_center - call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - ff = P_center(1) - Centerii(1) - gg = Q_center(1) - Centerii(1) - - shift_P = (/ 1, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 1, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul_debug = j1b_gauss_coul_debug - coef4 * cx - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - -! ! ------------------------------------------------------------------------------------------------------------------- -! ! -! ! - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] -! ! -! ! ------------------------------------------------------------------------------------------------------------------- -! -! do p = 1, ao_prim_num(i) -! coef1 = ao_coef_normalized_ordered_transp(p, i) -! expo1 = ao_expo_ordered_transp(p, i) -! -! do q = 1, ao_prim_num(j) -! coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) -! expo2 = ao_expo_ordered_transp(q, j) -! -! call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 & -! , I_power, J_power, I_center, J_center, dim1 ) -! p_inv = 1.d0 / pp -! -! do r = 1, ao_prim_num(k) -! coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) -! expo3 = ao_expo_ordered_transp(r, k) -! -! do s = 1, ao_prim_num(l) -! coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) -! expo4 = ao_expo_ordered_transp(s, l) -! -! call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 & -! , K_power, L_power, K_center, L_center, dim1 ) -! -! cx = 0.d0 -! do ii = 1, nucl_num -! expoii = j1b_gauss_pen(ii) -! Centerii(1:3) = nucl_coord(ii, 1:3) -! -! call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center) -! -! fact_q = fact_q_tmp * factii -! q_inv = 1.d0 / qq -! -! ! pol centerd on Q_center_tmp ==> centerd on Q_center -! call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new) -! -! ! ---------------------------------------------------------------------------------------------------- -! ! x term: -! -! ff = P_center(1) - Centerii(1) -! gg = Q_center(1) - Centerii(1) -! -! shift_P = (/ 1, 0, 0 /) -! shift_Q = (/ 1, 0, 0 /) -! cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & -! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & -! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) -! -! shift_P = (/ 1, 0, 0 /) -! shift_Q = (/ 0, 0, 0 /) -! cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 & -! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & -! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) -! -! shift_P = (/ 0, 0, 0 /) -! shift_Q = (/ 1, 0, 0 /) -! cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 & -! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & -! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) -! -! shift_P = (/ 0, 0, 0 /) -! shift_Q = (/ 0, 0, 0 /) -! cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 & -! , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & -! , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) -! -! ! ---------------------------------------------------------------------------------------------------- -! -! enddo -! -! j1b_gauss_coul_debug = j1b_gauss_coul_debug - coef4 * cx -! -! enddo ! s -! enddo ! r -! enddo ! q -! enddo ! p -! -! ! ------------------------------------------------------------------------------------------------------------------- -! ! ------------------------------------------------------------------------------------------------------------------- - - return -end function j1b_gauss_coul_debug - diff --git a/src/ao_tc_eff_map/two_e_1bgauss_coul_modifdebug.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_coul_modifdebug.irp.f deleted file mode 100644 index 753fff8f..00000000 --- a/src/ao_tc_eff_map/two_e_1bgauss_coul_modifdebug.irp.f +++ /dev/null @@ -1,324 +0,0 @@ -double precision function j1b_gauss_coul_modifdebug(i, j, k, l) - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: i, j, k, l - - integer :: p, q, r, s, ii - integer :: num_i, num_j, num_k, num_l, num_ii - integer :: I_power(3), J_power(3), K_power(3), L_power(3) - integer :: iorder_p(3), iorder_q(3) - integer :: shift_P(3), shift_Q(3) - integer :: dim1 - - double precision :: coef1, coef2, coef3, coef4 - double precision :: expo1, expo2, expo3, expo4 - double precision :: p_inv, q_inv - double precision :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp - double precision :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp - double precision :: P_new(0:max_dim,3), P_center(3), fact_p, pp - double precision :: Q_new(0:max_dim,3), Q_center(3), fact_q, qq - double precision :: I_center(3), J_center(3), K_center(3), L_center(3) - double precision :: expoii, factii, Centerii(3) - double precision :: ff, gg, cx, cy, cz - - double precision :: general_primitive_integral_coul - double precision :: general_primitive_integral_coul_shifted - double precision :: ao_two_e_integral - - PROVIDE j1b_gauss_pen - - dim1 = n_pt_max_integrals - - num_i = ao_nucl(i) - num_j = ao_nucl(j) - num_k = ao_nucl(k) - num_l = ao_nucl(l) - - do p = 1, 3 - I_power(p) = ao_power(i,p) - J_power(p) = ao_power(j,p) - K_power(p) = ao_power(k,p) - L_power(p) = ao_power(l,p) - I_center(p) = nucl_coord(num_i,p) - J_center(p) = nucl_coord(num_j,p) - K_center(p) = nucl_coord(num_k,p) - L_center(p) = nucl_coord(num_l,p) - enddo - - j1b_gauss_coul_modifdebug = 0.d0 - -! do ii = 1, nucl_num -! expoii = j1b_gauss_pen(ii) -! j1b_gauss_coul_modifdebug += expoii * ao_two_e_integral(i, j, k, l) -! enddo - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! [ 1 / r12 ] \sum_A a_A exp(-aA r1A^2) - ! - ! ------------------------------------------------------------------------------------------------------------------- - - shift_P = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q_inv = 1.d0 / qq - - cx = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center) - fact_p = fact_p_tmp * factii - p_inv = 1.d0 / pp - P_new(:,:) = 0.d0 - call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul_modifdebug = j1b_gauss_coul_modifdebug + coef4 * cx - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! [ 1 / r12 ] \sum_A a_A exp(-aA r2A^2) - ! - ! ------------------------------------------------------------------------------------------------------------------- - - shift_P = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - p_inv = 1.d0 / pp - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - - cx = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center) - fact_q = fact_q_tmp * factii - Q_inv = 1.d0 / qq - call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_coul_modifdebug = j1b_gauss_coul_modifdebug + coef4 * cx - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - return -end function j1b_gauss_coul_modifdebug - - - - -double precision function general_primitive_integral_coul(dim, & - P_new,P_center,fact_p,p,p_inv,iorder_p, & - Q_new,Q_center,fact_q,q,q_inv,iorder_q) - implicit none - BEGIN_DOC - ! Computes the integral where p,q,r,s are Gaussian primitives - END_DOC - integer,intent(in) :: dim - include 'utils/constants.include.F' - double precision, intent(in) :: P_new(0:max_dim,3),P_center(3),fact_p,p,p_inv - double precision, intent(in) :: Q_new(0:max_dim,3),Q_center(3),fact_q,q,q_inv - integer, intent(in) :: iorder_p(3) - integer, intent(in) :: iorder_q(3) - - double precision :: r_cut,gama_r_cut,rho,dist - double precision :: dx(0:max_dim),Ix_pol(0:max_dim),dy(0:max_dim),Iy_pol(0:max_dim),dz(0:max_dim),Iz_pol(0:max_dim) - integer :: n_Ix,n_Iy,n_Iz,nx,ny,nz - double precision :: bla - integer :: ix,iy,iz,jx,jy,jz,i - double precision :: a,b,c,d,e,f,accu,pq,const - double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2,pq_inv_2 - integer :: n_pt_tmp,n_pt_out, iorder - double precision :: d1(0:max_dim),d_poly(0:max_dim),rint,d1_screened(0:max_dim) - - general_primitive_integral_coul = 0.d0 - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx,Ix_pol,dy,Iy_pol,dz,Iz_pol - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly - - ! Gaussian Product - ! ---------------- - - pq = p_inv*0.5d0*q_inv - pq_inv = 0.5d0/(p+q) - p10_1 = q*pq ! 1/(2p) - p01_1 = p*pq ! 1/(2q) - pq_inv_2 = pq_inv+pq_inv - p10_2 = pq_inv_2 * p10_1*q !0.5d0*q/(pq + p*p) - p01_2 = pq_inv_2 * p01_1*p !0.5d0*p/(q*q + pq) - - - accu = 0.d0 - iorder = iorder_p(1)+iorder_q(1)+iorder_p(1)+iorder_q(1) - do ix=0,iorder - Ix_pol(ix) = 0.d0 - enddo - n_Ix = 0 - do ix = 0, iorder_p(1) - if (abs(P_new(ix,1)) < thresh) cycle - a = P_new(ix,1) - do jx = 0, iorder_q(1) - d = a*Q_new(jx,1) - if (abs(d) < thresh) cycle - !DIR$ FORCEINLINE - call give_polynom_mult_center_x(P_center(1),Q_center(1),ix,jx,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dx,nx) - !DIR$ FORCEINLINE - call add_poly_multiply(dx,nx,d,Ix_pol,n_Ix) - enddo - enddo - if (n_Ix == -1) then - return - endif - iorder = iorder_p(2)+iorder_q(2)+iorder_p(2)+iorder_q(2) - do ix=0, iorder - Iy_pol(ix) = 0.d0 - enddo - n_Iy = 0 - do iy = 0, iorder_p(2) - if (abs(P_new(iy,2)) > thresh) then - b = P_new(iy,2) - do jy = 0, iorder_q(2) - e = b*Q_new(jy,2) - if (abs(e) < thresh) cycle - !DIR$ FORCEINLINE - call give_polynom_mult_center_x(P_center(2),Q_center(2),iy,jy,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dy,ny) - !DIR$ FORCEINLINE - call add_poly_multiply(dy,ny,e,Iy_pol,n_Iy) - enddo - endif - enddo - if (n_Iy == -1) then - return - endif - - iorder = iorder_p(3)+iorder_q(3)+iorder_p(3)+iorder_q(3) - do ix=0,iorder - Iz_pol(ix) = 0.d0 - enddo - n_Iz = 0 - do iz = 0, iorder_p(3) - if (abs(P_new(iz,3)) > thresh) then - c = P_new(iz,3) - do jz = 0, iorder_q(3) - f = c*Q_new(jz,3) - if (abs(f) < thresh) cycle - !DIR$ FORCEINLINE - call give_polynom_mult_center_x(P_center(3),Q_center(3),iz,jz,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dz,nz) - !DIR$ FORCEINLINE - call add_poly_multiply(dz,nz,f,Iz_pol,n_Iz) - enddo - endif - enddo - if (n_Iz == -1) then - return - endif - - rho = p*q *pq_inv_2 - dist = (P_center(1) - Q_center(1))*(P_center(1) - Q_center(1)) + & - (P_center(2) - Q_center(2))*(P_center(2) - Q_center(2)) + & - (P_center(3) - Q_center(3))*(P_center(3) - Q_center(3)) - const = dist*rho - - n_pt_tmp = n_Ix+n_Iy - do i=0,n_pt_tmp - d_poly(i)=0.d0 - enddo - - !DIR$ FORCEINLINE - call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp) - if (n_pt_tmp == -1) then - return - endif - n_pt_out = n_pt_tmp+n_Iz - do i=0,n_pt_out - d1(i)=0.d0 - enddo - - !DIR$ FORCEINLINE - call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out) - double precision :: rint_sum - accu = accu + rint_sum(n_pt_out,const,d1) - - general_primitive_integral_coul = fact_p * fact_q * accu *pi_5_2*p_inv*q_inv/dsqrt(p+q) -end function general_primitive_integral_coul diff --git a/src/ao_tc_eff_map/two_e_1bgauss_coulerf.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_coulerf.irp.f deleted file mode 100644 index 92512bd7..00000000 --- a/src/ao_tc_eff_map/two_e_1bgauss_coulerf.irp.f +++ /dev/null @@ -1,102 +0,0 @@ -double precision function j1b_gauss_coulerf(i, j, k, l) - - BEGIN_DOC - ! - ! integral in the AO basis: - ! i(r1) j(r1) f(r12) k(r2) l(r2) - ! - ! with: - ! f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] - ! = [ (1 - erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! + (r2-RA)^2 exp(-aA r2A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! - END_DOC - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: i, j, k, l - - integer :: p, q, r, s - integer :: num_i, num_j, num_k, num_l, num_ii - integer :: I_power(3), J_power(3), K_power(3), L_power(3) - integer :: iorder_p(3), iorder_q(3) - integer :: shift_P(3), shift_Q(3) - integer :: dim1 - - double precision :: coef1, coef2, coef3, coef4 - double precision :: expo1, expo2, expo3, expo4 - double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv - double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv - 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_coulerf_schwartz - - PROVIDE j1b_gauss_pen - - 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_coulerf = j1b_gauss_coulerf_schwartz(i, j, k, l) - return - endif - - num_i = ao_nucl(i) - num_j = ao_nucl(j) - num_k = ao_nucl(k) - num_l = ao_nucl(l) - - do p = 1, 3 - I_power(p) = ao_power(i,p) - J_power(p) = ao_power(j,p) - K_power(p) = ao_power(k,p) - L_power(p) = ao_power(l,p) - I_center(p) = nucl_coord(num_i,p) - J_center(p) = nucl_coord(num_j,p) - K_center(p) = nucl_coord(num_k,p) - L_center(p) = nucl_coord(num_l,p) - enddo - - j1b_gauss_coulerf = 0.d0 - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - p1_inv = 1.d0 / pp1 - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q1_inv = 1.d0 / qq1 - - call get_cxcycz( dim1, cx, cy, cz & - , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & - , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - - j1b_gauss_coulerf = j1b_gauss_coulerf + coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - return -end function j1b_gauss_coulerf - diff --git a/src/ao_tc_eff_map/two_e_1bgauss_erf.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_erf.irp.f deleted file mode 100644 index f5ff5499..00000000 --- a/src/ao_tc_eff_map/two_e_1bgauss_erf.irp.f +++ /dev/null @@ -1,854 +0,0 @@ -double precision function j1b_gauss_erf(i, j, k, l) - - BEGIN_DOC - ! - ! integral in the AO basis: - ! i(r1) j(r1) f(r12) k(r2) l(r2) - ! - ! with: - ! f(r12) = - [ -0.5 erf(mu r12) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] - ! = - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! + (r2-RA)^2 exp(-aA r2A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! - END_DOC - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: i, j, k, l - - integer :: p, q, r, s, ii - integer :: num_i, num_j, num_k, num_l, num_ii - integer :: I_power(3), J_power(3), K_power(3), L_power(3) - integer :: iorder_p(3), iorder_q(3) - integer :: shift_P(3), shift_Q(3) - integer :: dim1 - - double precision :: coef1, coef2, coef3, coef4 - double precision :: expo1, expo2, expo3, expo4 - double precision :: p_inv, q_inv - double precision :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp - double precision :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp - double precision :: P_new(0:max_dim,3), P_center(3), fact_p, pp - double precision :: Q_new(0:max_dim,3), Q_center(3), fact_q, qq - double precision :: I_center(3), J_center(3), K_center(3), L_center(3) - double precision :: expoii, factii, Centerii(3) - double precision :: ff, gg, cx, cy, cz - - double precision :: general_primitive_integral_erf_shifted - - PROVIDE mu_erf - PROVIDE j1b_gauss_pen - - dim1 = n_pt_max_integrals - - num_i = ao_nucl(i) - num_j = ao_nucl(j) - num_k = ao_nucl(k) - num_l = ao_nucl(l) - - do p = 1, 3 - I_power(p) = ao_power(i,p) - J_power(p) = ao_power(j,p) - K_power(p) = ao_power(k,p) - L_power(p) = ao_power(l,p) - I_center(p) = nucl_coord(num_i,p) - J_center(p) = nucl_coord(num_j,p) - K_center(p) = nucl_coord(num_k,p) - L_center(p) = nucl_coord(num_l,p) - enddo - - j1b_gauss_erf = 0.d0 - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! - ! ------------------------------------------------------------------------------------------------------------------- - - shift_Q(1) = 0 - shift_Q(2) = 0 - shift_Q(3) = 0 - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q_inv = 1.d0 / qq - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center) - - fact_p = fact_p_tmp * factii - p_inv = 1.d0 / pp - - ! pol centerd on P_center_tmp ==> centerd on P_center - call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - shift_P(2) = 0 - shift_P(3) = 0 - - ff = P_center(1) - Centerii(1) - - shift_P(1) = 2 - cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(1) = 1 - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(1) = 0 - cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! y term: - - shift_P(1) = 0 - shift_P(3) = 0 - - ff = P_center(2) - Centerii(2) - - shift_P(2) = 2 - cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(2) = 1 - cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(2) = 0 - cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! z term: - - shift_P(1) = 0 - shift_P(2) = 0 - - ff = P_center(3) - Centerii(3) - - shift_P(3) = 2 - cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(3) = 1 - cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(3) = 0 - cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_erf = j1b_gauss_erf - coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! - [ erf(mu r12) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2) - ! - ! ------------------------------------------------------------------------------------------------------------------- - - shift_P(1) = 0 - shift_P(2) = 0 - shift_P(3) = 0 - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - p_inv = 1.d0 / pp - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center) - - fact_q = fact_q_tmp * factii - q_inv = 1.d0 / qq - - ! pol centerd on Q_center_tmp ==> centerd on Q_center - call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - shift_Q(2) = 0 - shift_Q(3) = 0 - - ff = Q_center(1) - Centerii(1) - - shift_Q(1) = 2 - cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q(1) = 1 - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q(1) = 0 - cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! y term: - - shift_Q(1) = 0 - shift_Q(3) = 0 - - ff = Q_center(2) - Centerii(2) - - shift_Q(2) = 2 - cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q(2) = 1 - cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q(2) = 0 - cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! z term: - - shift_Q(1) = 0 - shift_Q(2) = 0 - - ff = Q_center(3) - Centerii(3) - - shift_Q(3) = 2 - cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q(3) = 1 - cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_Q(3) = 0 - cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_erf = j1b_gauss_erf - coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ] - ! - ! ------------------------------------------------------------------------------------------------------------------- - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q_inv = 1.d0 / qq - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center) - - fact_p = fact_p_tmp * factii - p_inv = 1.d0 / pp - - ! pol centerd on P_center_tmp ==> centerd on P_center - call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - shift_P(2) = 0 - shift_P(3) = 0 - shift_Q(2) = 0 - shift_Q(3) = 0 - - ff = P_center(1) - Centerii(1) - gg = Q_center(1) - Centerii(1) - - shift_P(1) = 1 - shift_Q(1) = 1 - cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(1) = 1 - shift_Q(1) = 0 - cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(1) = 0 - shift_Q(1) = 1 - cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(1) = 0 - shift_Q(1) = 0 - cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! y term: - - shift_P(1) = 0 - shift_P(3) = 0 - shift_Q(1) = 0 - shift_Q(3) = 0 - - ff = P_center(2) - Centerii(2) - gg = Q_center(2) - Centerii(2) - - shift_P(2) = 1 - shift_Q(2) = 1 - cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(2) = 1 - shift_Q(2) = 0 - cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(2) = 0 - shift_Q(2) = 1 - cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(2) = 0 - shift_Q(2) = 0 - cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! z term: - - shift_P(1) = 0 - shift_P(2) = 0 - shift_Q(1) = 0 - shift_Q(2) = 0 - - ff = P_center(3) - Centerii(3) - gg = Q_center(3) - Centerii(3) - - shift_P(3) = 1 - shift_Q(3) = 1 - cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(3) = 1 - shift_Q(3) = 0 - cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(3) = 0 - shift_Q(3) = 1 - cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(3) = 0 - shift_Q(3) = 0 - cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_erf = j1b_gauss_erf + coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - - ! ------------------------------------------------------------------------------------------------------------------- - ! - ! [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! - ! ------------------------------------------------------------------------------------------------------------------- - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - p_inv = 1.d0 / pp - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center) - - fact_q = fact_q_tmp * factii - q_inv = 1.d0 / qq - - ! pol centerd on Q_center_tmp ==> centerd on Q_center - call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new) - - ! ---------------------------------------------------------------------------------------------------- - ! x term: - - shift_P(2) = 0 - shift_P(3) = 0 - shift_Q(2) = 0 - shift_Q(3) = 0 - - ff = P_center(1) - Centerii(1) - gg = Q_center(1) - Centerii(1) - - shift_P(1) = 1 - shift_Q(1) = 1 - cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(1) = 1 - shift_Q(1) = 0 - cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(1) = 0 - shift_Q(1) = 1 - cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(1) = 0 - shift_Q(1) = 0 - cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! y term: - - shift_P(1) = 0 - shift_P(3) = 0 - shift_Q(1) = 0 - shift_Q(3) = 0 - - ff = P_center(2) - Centerii(2) - gg = Q_center(2) - Centerii(2) - - shift_P(2) = 1 - shift_Q(2) = 1 - cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(2) = 1 - shift_Q(2) = 0 - cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(2) = 0 - shift_Q(2) = 1 - cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(2) = 0 - shift_Q(2) = 0 - cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - ! ---------------------------------------------------------------------------------------------------- - ! z term: - - shift_P(1) = 0 - shift_P(2) = 0 - shift_Q(1) = 0 - shift_Q(2) = 0 - - ff = P_center(3) - Centerii(3) - gg = Q_center(3) - Centerii(3) - - shift_P(3) = 1 - shift_Q(3) = 1 - cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(3) = 1 - shift_Q(3) = 0 - cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(3) = 0 - shift_Q(3) = 1 - cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - shift_P(3) = 0 - shift_Q(3) = 0 - cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_erf = j1b_gauss_erf + coef4 * ( cx + cy + cz ) - - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - ! ------------------------------------------------------------------------------------------------------------------- - ! ------------------------------------------------------------------------------------------------------------------- - - - return -end function j1b_gauss_erf - - - - -!______________________________________________________________________________________________________________________ -!______________________________________________________________________________________________________________________ - -double precision function general_primitive_integral_erf_shifted( dim & - , P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P & - , Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q ) - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: dim - integer, intent(in) :: iorder_p(3), shift_P(3) - integer, intent(in) :: iorder_q(3), shift_Q(3) - double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv - double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv - - integer :: n_Ix, n_Iy, n_Iz, nx, ny, nz - integer :: ix, iy, iz, jx, jy, jz, i - integer :: n_pt_tmp, n_pt_out, iorder - integer :: ii, jj - double precision :: rho, dist - double precision :: dx(0:max_dim), Ix_pol(0:max_dim) - double precision :: dy(0:max_dim), Iy_pol(0:max_dim) - double precision :: dz(0:max_dim), Iz_pol(0:max_dim) - double precision :: a, b, c, d, e, f, accu, pq, const - double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2 - double precision :: d1(0:max_dim), d_poly(0:max_dim) - double precision :: p_plus_q - - double precision :: rint_sum - - general_primitive_integral_erf_shifted = 0.d0 - - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly - - ! Gaussian Product - ! ---------------- - p_plus_q = (p+q) * ( (p*q)/(p+q) + mu_erf*mu_erf ) / (mu_erf*mu_erf) - pq = p_inv * 0.5d0 * q_inv - pq_inv = 0.5d0 / p_plus_q - p10_1 = q * pq ! 1/(2p) - p01_1 = p * pq ! 1/(2q) - pq_inv_2 = pq_inv + pq_inv - p10_2 = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p) - p01_2 = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq) - - accu = 0.d0 - - iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1) - iorder = iorder + shift_P(1) + shift_Q(1) - iorder = iorder + shift_P(1) + shift_Q(1) - !DIR$ VECTOR ALIGNED - do ix = 0, iorder - Ix_pol(ix) = 0.d0 - enddo - n_Ix = 0 - do ix = 0, iorder_p(1) - - ii = ix + shift_P(1) - a = P_new(ix,1) - if(abs(a) < thresh) cycle - - do jx = 0, iorder_q(1) - - jj = jx + shift_Q(1) - d = a * Q_new(jx,1) - if(abs(d) < thresh) cycle - - !DEC$ FORCEINLINE - call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj & - , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx ) - !DEC$ FORCEINLINE - call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix) - enddo - enddo - if(n_Ix == -1) then - return - endif - - iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2) - iorder = iorder + shift_P(2) + shift_Q(2) - iorder = iorder + shift_P(2) + shift_Q(2) - !DIR$ VECTOR ALIGNED - do ix = 0, iorder - Iy_pol(ix) = 0.d0 - enddo - n_Iy = 0 - do iy = 0, iorder_p(2) - - if(abs(P_new(iy,2)) > thresh) then - - ii = iy + shift_P(2) - b = P_new(iy,2) - - do jy = 0, iorder_q(2) - - jj = jy + shift_Q(2) - e = b * Q_new(jy,2) - if(abs(e) < thresh) cycle - - !DEC$ FORCEINLINE - call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj & - , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny ) - !DEC$ FORCEINLINE - call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy) - enddo - endif - enddo - if(n_Iy == -1) then - return - endif - - iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3) - iorder = iorder + shift_P(3) + shift_Q(3) - iorder = iorder + shift_P(3) + shift_Q(3) - do ix = 0, iorder - Iz_pol(ix) = 0.d0 - enddo - n_Iz = 0 - do iz = 0, iorder_p(3) - - if( abs(P_new(iz,3)) > thresh ) then - - ii = iz + shift_P(3) - c = P_new(iz,3) - - do jz = 0, iorder_q(3) - - jj = jz + shift_Q(3) - f = c * Q_new(jz,3) - if(abs(f) < thresh) cycle - - !DEC$ FORCEINLINE - call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj & - , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz ) - !DEC$ FORCEINLINE - call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz) - enddo - endif - enddo - if(n_Iz == -1) then - return - endif - - rho = p * q * pq_inv_2 - dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) & - + (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) & - + (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3)) - const = dist*rho - - n_pt_tmp = n_Ix + n_Iy - do i = 0, n_pt_tmp - d_poly(i) = 0.d0 - enddo - - !DEC$ FORCEINLINE - call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp) - if(n_pt_tmp == -1) then - return - endif - n_pt_out = n_pt_tmp + n_Iz - do i = 0, n_pt_out - d1(i) = 0.d0 - enddo - - !DEC$ FORCEINLINE - call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out) - accu = accu + rint_sum(n_pt_out, const, d1) - - 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 -!______________________________________________________________________________________________________________________ -!______________________________________________________________________________________________________________________ diff --git a/src/ao_tc_eff_map/two_e_1bgauss_erf_acc.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_erf_acc.irp.f deleted file mode 100644 index 54210c44..00000000 --- a/src/ao_tc_eff_map/two_e_1bgauss_erf_acc.irp.f +++ /dev/null @@ -1,433 +0,0 @@ -double precision function j1b_gauss_erf_acc(i, j, k, l) - - BEGIN_DOC - ! - ! integral in the AO basis: - ! i(r1) j(r1) f(r12) k(r2) l(r2) - ! - ! with: - ! f(r12) = - [ -0.5 erf(mu r12) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] - ! = - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! + (r2-RA)^2 exp(-aA r2A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) - ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! - END_DOC - - include 'utils/constants.include.F' - - implicit none - - integer, intent(in) :: i, j, k, l - - integer :: p, q, r, s, ii - integer :: num_i, num_j, num_k, num_l, num_ii - integer :: I_power(3), J_power(3), K_power(3), L_power(3) - integer :: iorder_p(3), iorder_q(3) - integer :: shift_P(3), shift_Q(3) - integer :: dim1 - - double precision :: coef1, coef2, coef3, coef4 - double precision :: expo1, expo2, expo3, expo4 - double precision :: p1_inv, q1_inv, p2_inv, q2_inv - double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1 - double precision :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2 - double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1 - double precision :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2 - double precision :: I_center(3), J_center(3), K_center(3), L_center(3) - double precision :: expoii, factii, Centerii(3) - double precision :: ff, gg, cx, cy, cz - - double precision :: general_primitive_integral_erf_shifted - !double precision :: j1b_gauss_erf_schwartz_accel - - PROVIDE j1b_gauss_pen - - dim1 = n_pt_max_integrals - - ! TODO - !if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then - ! j1b_gauss_erf_schwartz_accel = j1b_gauss_erf_schwartz_accel(i, j, k, l) - ! return - !endif - - num_i = ao_nucl(i) - num_j = ao_nucl(j) - num_k = ao_nucl(k) - num_l = ao_nucl(l) - - do p = 1, 3 - I_power(p) = ao_power(i,p) - J_power(p) = ao_power(j,p) - K_power(p) = ao_power(k,p) - L_power(p) = ao_power(l,p) - I_center(p) = nucl_coord(num_i,p) - J_center(p) = nucl_coord(num_j,p) - K_center(p) = nucl_coord(num_k,p) - L_center(p) = nucl_coord(num_l,p) - enddo - - j1b_gauss_erf_acc = 0.d0 - - do p = 1, ao_prim_num(i) - coef1 = ao_coef_normalized_ordered_transp(p, i) - expo1 = ao_expo_ordered_transp(p, i) - - do q = 1, ao_prim_num(j) - coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) - expo2 = ao_expo_ordered_transp(q, j) - - call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 & - , I_power, J_power, I_center, J_center, dim1 ) - p1_inv = 1.d0 / pp1 - - do r = 1, ao_prim_num(k) - coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) - expo3 = ao_expo_ordered_transp(r, k) - - do s = 1, ao_prim_num(l) - coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) - expo4 = ao_expo_ordered_transp(s, l) - - call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 & - , K_power, L_power, K_center, L_center, dim1 ) - q1_inv = 1.d0 / qq1 - - cx = 0.d0 - cy = 0.d0 - cz = 0.d0 - do ii = 1, nucl_num - expoii = j1b_gauss_pen(ii) - Centerii(1:3) = nucl_coord(ii, 1:3) - - call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center) - fact_p2 = fact_p1 * factii - p2_inv = 1.d0 / pp2 - call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new) - - call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center) - fact_q2 = fact_q1 * factii - q2_inv = 1.d0 / qq2 - call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new) - - - ! ---------------------------------------------------------------------------------------------------- - ! [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) - ! ---------------------------------------------------------------------------------------------------- - - shift_Q = (/ 0, 0, 0 /) - - ! x term: - ff = P2_center(1) - Centerii(1) - - shift_P = (/ 2, 0, 0 /) - cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 1, 0, 0 /) - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! y term: - ff = P2_center(2) - Centerii(2) - - shift_P = (/ 0, 2, 0 /) - cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 1, 0 /) - cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! z term: - ff = P2_center(3) - Centerii(3) - - shift_P = (/ 0, 0, 2 /) - cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 1 /) - cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_P = (/ 0, 0, 0 /) - cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - - - ! ---------------------------------------------------------------------------------------------------- - ! [ erf(mu r12) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2) - ! ---------------------------------------------------------------------------------------------------- - - shift_P = (/ 0, 0, 0 /) - - ! x term: - ff = Q2_center(1) - Centerii(1) - - shift_Q = (/ 2, 0, 0 /) - cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 1, 0, 0 /) - cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! y term: - ff = Q2_center(2) - Centerii(2) - - shift_Q = (/ 0, 2, 0 /) - cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 1, 0 /) - cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! z term: - ff = Q2_center(3) - Centerii(3) - - shift_Q = (/ 0, 0, 2 /) - cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 1 /) - cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_Q = (/ 0, 0, 0 /) - cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - - - ! ---------------------------------------------------------------------------------------------------- - ! - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ] - ! ---------------------------------------------------------------------------------------------------- - - ! x term: - ff = P2_center(1) - Centerii(1) - gg = Q1_center(1) - Centerii(1) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx - expoii * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx - expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx - expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! y term: - ff = P2_center(2) - Centerii(2) - gg = Q1_center(2) - Centerii(2) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy - expoii * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy - expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy - expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! z term: - ff = P2_center(3) - Centerii(3) - gg = Q1_center(3) - Centerii(3) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz - expoii * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz - expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz - expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & - , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - - - ! ---------------------------------------------------------------------------------------------------- - ! - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] - ! ---------------------------------------------------------------------------------------------------- - - ! x term: - ff = P1_center(1) - Centerii(1) - gg = Q2_center(1) - Centerii(1) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx - expoii * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 1, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx - expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 1, 0, 0 /) - cx = cx - expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cx = cx - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! y term: - ff = P1_center(2) - Centerii(2) - gg = Q2_center(2) - Centerii(2) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy - expoii * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 1, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy - expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 1, 0 /) - cy = cy - expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cy = cy - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! z term: - ff = P1_center(3) - Centerii(3) - gg = Q2_center(3) - Centerii(3) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz - expoii * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 1 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz - expoii * gg * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 1 /) - cz = cz - expoii * ff * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - shift_p = (/ 0, 0, 0 /) - shift_Q = (/ 0, 0, 0 /) - cz = cz - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 & - , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & - , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) - - ! ---------------------------------------------------------------------------------------------------- - - enddo - - j1b_gauss_erf_acc = j1b_gauss_erf_acc - coef4 * ( cx + cy + cz ) - enddo ! s - enddo ! r - enddo ! q - enddo ! p - - return -end function j1b_gauss_erf_acc diff --git a/src/ao_tc_eff_map/two_e_1bgauss_coulerf_schwartz.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f similarity index 86% rename from src/ao_tc_eff_map/two_e_1bgauss_coulerf_schwartz.irp.f rename to src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f index f2ba8276..c36ee9b4 100644 --- a/src/ao_tc_eff_map/two_e_1bgauss_coulerf_schwartz.irp.f +++ b/src/ao_tc_eff_map/two_e_1bgauss_j1.irp.f @@ -1,4 +1,106 @@ -double precision function j1b_gauss_coulerf_schwartz(i, j, k, l) +! --- + +double precision function j1b_gauss_2e_j1(i, j, k, l) + + BEGIN_DOC + ! + ! integral in the AO basis: + ! i(r1) j(r1) f(r12) k(r2) l(r2) + ! + ! with: + ! f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] + ! = [ (1 - erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2) + ! + (r2-RA)^2 exp(-aA r2A^2) + ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) + ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] + ! + END_DOC + + include 'utils/constants.include.F' + + implicit none + + integer, intent(in) :: i, j, k, l + + integer :: p, q, r, s + integer :: num_i, num_j, num_k, num_l, num_ii + integer :: I_power(3), J_power(3), K_power(3), L_power(3) + integer :: iorder_p(3), iorder_q(3) + integer :: shift_P(3), shift_Q(3) + integer :: dim1 + + double precision :: coef1, coef2, coef3, coef4 + double precision :: expo1, expo2, expo3, expo4 + double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv + double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv + 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 + + 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) + return + endif + + num_i = ao_nucl(i) + num_j = ao_nucl(j) + num_k = ao_nucl(k) + num_l = ao_nucl(l) + + do p = 1, 3 + I_power(p) = ao_power(i,p) + J_power(p) = ao_power(j,p) + K_power(p) = ao_power(k,p) + L_power(p) = ao_power(l,p) + I_center(p) = nucl_coord(num_i,p) + J_center(p) = nucl_coord(num_j,p) + K_center(p) = nucl_coord(num_k,p) + L_center(p) = nucl_coord(num_l,p) + enddo + + j1b_gauss_2e_j1 = 0.d0 + + do p = 1, ao_prim_num(i) + coef1 = ao_coef_normalized_ordered_transp(p, i) + expo1 = ao_expo_ordered_transp(p, i) + + do q = 1, ao_prim_num(j) + coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) + expo2 = ao_expo_ordered_transp(q, j) + + call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 & + , I_power, J_power, I_center, J_center, dim1 ) + p1_inv = 1.d0 / pp1 + + do r = 1, ao_prim_num(k) + coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) + expo3 = ao_expo_ordered_transp(r, k) + + do s = 1, ao_prim_num(l) + coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) + expo4 = ao_expo_ordered_transp(s, l) + + call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 & + , K_power, L_power, K_center, L_center, dim1 ) + q1_inv = 1.d0 / qq1 + + call get_cxcycz_j1( dim1, cx, cy, cz & + , 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 ) + enddo ! s + enddo ! r + enddo ! q + enddo ! p + + return +end function j1b_gauss_2e_j1 + +! --- + +double precision function j1b_gauss_2e_j1_schwartz(i, j, k, l) BEGIN_DOC ! @@ -35,7 +137,7 @@ double precision function j1b_gauss_coulerf_schwartz(i, j, k, l) double precision :: schwartz_ij, thr double precision, allocatable :: schwartz_kl(:,:) - PROVIDE j1b_gauss_pen + PROVIDE j1b_pen dim1 = n_pt_max_integrals thr = ao_integrals_threshold * ao_integrals_threshold @@ -73,9 +175,9 @@ double precision function j1b_gauss_coulerf_schwartz(i, j, k, l) , K_power, L_power, K_center, L_center, dim1 ) q1_inv = 1.d0 / qq1 - call get_cxcycz( dim1, cx, cy, cz & - , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q & - , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) + call get_cxcycz_j1( dim1, cx, cy, cz & + , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q & + , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) schwartz_kl(s,r) = coef4 * dabs( cx + cy + cz ) schwartz_kl(0,r) = max( schwartz_kl(0,r) , schwartz_kl(s,r) ) @@ -85,7 +187,7 @@ double precision function j1b_gauss_coulerf_schwartz(i, j, k, l) enddo - j1b_gauss_coulerf_schwartz = 0.d0 + j1b_gauss_2e_j1_schwartz = 0.d0 do p = 1, ao_prim_num(i) expo1 = ao_expo_ordered_transp(p, i) @@ -99,9 +201,9 @@ double precision function j1b_gauss_coulerf_schwartz(i, j, k, l) , I_power, J_power, I_center, J_center, dim1 ) p1_inv = 1.d0 / pp1 - call get_cxcycz( dim1, cx, cy, cz & - , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & - , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p ) + call get_cxcycz_j1( dim1, cx, cy, cz & + , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & + , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p ) schwartz_ij = coef2 * coef2 * dabs( cx + cy + cz ) if( schwartz_kl(0,0) * schwartz_ij < thr ) cycle @@ -120,11 +222,11 @@ double precision function j1b_gauss_coulerf_schwartz(i, j, k, l) , K_power, L_power, K_center, L_center, dim1 ) q1_inv = 1.d0 / qq1 - call get_cxcycz( dim1, cx, cy, cz & - , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & - , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) + call get_cxcycz_j1( dim1, cx, cy, cz & + , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & + , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) - j1b_gauss_coulerf_schwartz = j1b_gauss_coulerf_schwartz + coef4 * ( cx + cy + cz ) + j1b_gauss_2e_j1_schwartz = j1b_gauss_2e_j1_schwartz + coef4 * ( cx + cy + cz ) enddo ! s enddo ! r enddo ! q @@ -133,15 +235,13 @@ double precision function j1b_gauss_coulerf_schwartz(i, j, k, l) deallocate( schwartz_kl ) return -end function j1b_gauss_coulerf_schwartz +end function j1b_gauss_2e_j1_schwartz +! --- - - - -subroutine get_cxcycz( dim1, cx, cy, cz & - , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & - , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) +subroutine get_cxcycz_j1( dim1, cx, cy, cz & + , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & + , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) include 'utils/constants.include.F' @@ -163,12 +263,14 @@ subroutine get_cxcycz( 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_gauss_pen(ii) + expoii = j1b_pen(ii) Centerii(1:3) = nucl_coord(ii, 1:3) call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center) @@ -620,5 +722,7 @@ subroutine get_cxcycz( dim1, cx, cy, cz & enddo return -end subroutine get_cxcycz +end subroutine get_cxcycz_j1 + +! --- diff --git a/src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f b/src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f new file mode 100644 index 00000000..a61b5336 --- /dev/null +++ b/src/ao_tc_eff_map/two_e_1bgauss_j2.irp.f @@ -0,0 +1,729 @@ +! --- + +double precision function j1b_gauss_2e_j2(i, j, k, l) + + BEGIN_DOC + ! + ! integral in the AO basis: + ! i(r1) j(r1) f(r12) k(r2) l(r2) + ! + ! with: + ! f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A c_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] + ! = [ (1 - erf(mu r12) / r12 ] \sum_A a_A c_A [ (r1-RA)^2 exp(-aA r1A^2) + ! + (r2-RA)^2 exp(-aA r2A^2) + ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) + ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] + ! + END_DOC + + include 'utils/constants.include.F' + + implicit none + + integer, intent(in) :: i, j, k, l + + integer :: p, q, r, s + integer :: num_i, num_j, num_k, num_l, num_ii + integer :: I_power(3), J_power(3), K_power(3), L_power(3) + integer :: iorder_p(3), iorder_q(3) + integer :: shift_P(3), shift_Q(3) + integer :: dim1 + + double precision :: coef1, coef2, coef3, coef4 + double precision :: expo1, expo2, expo3, expo4 + double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv + double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv + 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 + + 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) + return + endif + + num_i = ao_nucl(i) + num_j = ao_nucl(j) + num_k = ao_nucl(k) + num_l = ao_nucl(l) + + do p = 1, 3 + I_power(p) = ao_power(i,p) + J_power(p) = ao_power(j,p) + K_power(p) = ao_power(k,p) + L_power(p) = ao_power(l,p) + I_center(p) = nucl_coord(num_i,p) + J_center(p) = nucl_coord(num_j,p) + K_center(p) = nucl_coord(num_k,p) + L_center(p) = nucl_coord(num_l,p) + enddo + + j1b_gauss_2e_j2 = 0.d0 + + do p = 1, ao_prim_num(i) + coef1 = ao_coef_normalized_ordered_transp(p, i) + expo1 = ao_expo_ordered_transp(p, i) + + do q = 1, ao_prim_num(j) + coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) + expo2 = ao_expo_ordered_transp(q, j) + + call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 & + , I_power, J_power, I_center, J_center, dim1 ) + p1_inv = 1.d0 / pp1 + + do r = 1, ao_prim_num(k) + coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) + expo3 = ao_expo_ordered_transp(r, k) + + do s = 1, ao_prim_num(l) + coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) + expo4 = ao_expo_ordered_transp(s, l) + + call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 & + , K_power, L_power, K_center, L_center, dim1 ) + q1_inv = 1.d0 / qq1 + + call get_cxcycz_j2( dim1, cx, cy, cz & + , 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 ) + enddo ! s + enddo ! r + enddo ! q + enddo ! p + + return +end function j1b_gauss_2e_j2 + +! --- + +double precision function j1b_gauss_2e_j2_schwartz(i, j, k, l) + + BEGIN_DOC + ! + ! integral in the AO basis: + ! i(r1) j(r1) f(r12) k(r2) l(r2) + ! + ! with: + ! f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A c_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ] + ! = [ (1 - erf(mu r12) / r12 ] \sum_A a_A c_A [ (r1-RA)^2 exp(-aA r1A^2) + ! + (r2-RA)^2 exp(-aA r2A^2) + ! - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) + ! - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] + ! + END_DOC + + include 'utils/constants.include.F' + + implicit none + + integer, intent(in) :: i, j, k, l + + integer :: p, q, r, s + integer :: num_i, num_j, num_k, num_l, num_ii + integer :: I_power(3), J_power(3), K_power(3), L_power(3) + integer :: iorder_p(3), iorder_q(3) + integer :: dim1 + + double precision :: coef1, coef2, coef3, coef4 + double precision :: expo1, expo2, expo3, expo4 + double precision :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv + double precision :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv + double precision :: I_center(3), J_center(3), K_center(3), L_center(3) + double precision :: cx, cy, cz + double precision :: schwartz_ij, thr + double precision, allocatable :: schwartz_kl(:,:) + + dim1 = n_pt_max_integrals + thr = ao_integrals_threshold * ao_integrals_threshold + + num_i = ao_nucl(i) + num_j = ao_nucl(j) + num_k = ao_nucl(k) + num_l = ao_nucl(l) + + do p = 1, 3 + I_power(p) = ao_power(i,p) + J_power(p) = ao_power(j,p) + K_power(p) = ao_power(k,p) + L_power(p) = ao_power(l,p) + I_center(p) = nucl_coord(num_i,p) + J_center(p) = nucl_coord(num_j,p) + K_center(p) = nucl_coord(num_k,p) + L_center(p) = nucl_coord(num_l,p) + enddo + + + allocate( schwartz_kl(0:ao_prim_num(l) , 0:ao_prim_num(k)) ) + + schwartz_kl(0,0) = 0.d0 + do r = 1, ao_prim_num(k) + expo3 = ao_expo_ordered_transp(r,k) + coef3 = ao_coef_normalized_ordered_transp(r,k) * ao_coef_normalized_ordered_transp(r,k) + + schwartz_kl(0,r) = 0.d0 + do s = 1, ao_prim_num(l) + expo4 = ao_expo_ordered_transp(s,l) + coef4 = coef3 * ao_coef_normalized_ordered_transp(s,l) * ao_coef_normalized_ordered_transp(s,l) + + call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 & + , K_power, L_power, K_center, L_center, dim1 ) + q1_inv = 1.d0 / qq1 + + call get_cxcycz_j2( dim1, cx, cy, cz & + , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q & + , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) + + schwartz_kl(s,r) = coef4 * dabs( cx + cy + cz ) + schwartz_kl(0,r) = max( schwartz_kl(0,r) , schwartz_kl(s,r) ) + enddo + + schwartz_kl(0,0) = max( schwartz_kl(0,r) , schwartz_kl(0,0) ) + enddo + + + j1b_gauss_2e_j2_schwartz = 0.d0 + + do p = 1, ao_prim_num(i) + expo1 = ao_expo_ordered_transp(p, i) + coef1 = ao_coef_normalized_ordered_transp(p, i) + + do q = 1, ao_prim_num(j) + expo2 = ao_expo_ordered_transp(q, j) + coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j) + + call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 & + , I_power, J_power, I_center, J_center, dim1 ) + p1_inv = 1.d0 / pp1 + + call get_cxcycz_j2( dim1, cx, cy, cz & + , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & + , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p ) + + schwartz_ij = coef2 * coef2 * dabs( cx + cy + cz ) + if( schwartz_kl(0,0) * schwartz_ij < thr ) cycle + + do r = 1, ao_prim_num(k) + if( schwartz_kl(0,r) * schwartz_ij < thr ) cycle + coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k) + expo3 = ao_expo_ordered_transp(r, k) + + do s = 1, ao_prim_num(l) + if( schwartz_kl(s,r) * schwartz_ij < thr ) cycle + coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l) + expo4 = ao_expo_ordered_transp(s, l) + + call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 & + , K_power, L_power, K_center, L_center, dim1 ) + q1_inv = 1.d0 / qq1 + + call get_cxcycz_j2( dim1, cx, cy, cz & + , 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 ) + enddo ! s + enddo ! r + enddo ! q + enddo ! p + + deallocate( schwartz_kl ) + + return +end function j1b_gauss_2e_j2_schwartz + +! --- + +subroutine get_cxcycz_j2( dim1, cx, cy, cz & + , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p & + , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q ) + + include 'utils/constants.include.F' + + implicit none + + integer, intent(in) :: dim1 + integer, intent(in) :: iorder_p(3), iorder_q(3) + double precision, intent(in) :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv + double precision, intent(in) :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv + double precision, intent(out) :: cx, cy, cz + + integer :: ii + integer :: shift_P(3), shift_Q(3) + double precision :: coefii, expoii, factii, Centerii(3) + double precision :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2, p2_inv + double precision :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2, q2_inv + double precision :: ff, gg + + 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) + Centerii(1:3) = nucl_coord(ii, 1:3) + + call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center) + fact_p2 = fact_p1 * factii + p2_inv = 1.d0 / pp2 + call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new ) + + call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center) + fact_q2 = fact_q1 * factii + q2_inv = 1.d0 / qq2 + call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new ) + + + ! ---------------------------------------------------------------------------------------------------- + ! [ (1-erf(mu r12)) / r12 ] \sum_A a_A c_A [ (r1-RA)^2 exp(-aA r1A^2) + ! ---------------------------------------------------------------------------------------------------- + + shift_Q = (/ 0, 0, 0 /) + + ! x term: + ff = P2_center(1) - Centerii(1) + + shift_P = (/ 2, 0, 0 /) + cx = cx + expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cx = cx - expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_P = (/ 1, 0, 0 /) + cx = cx + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cx = cx - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_P = (/ 0, 0, 0 /) + cx = cx + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cx = cx - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + ! y term: + ff = P2_center(2) - Centerii(2) + + shift_P = (/ 0, 2, 0 /) + cy = cy + expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cy = cy - expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_P = (/ 0, 1, 0 /) + cy = cy + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cy = cy - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_P = (/ 0, 0, 0 /) + cy = cy + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cy = cy - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + ! z term: + ff = P2_center(3) - Centerii(3) + + shift_P = (/ 0, 0, 2 /) + cz = cz + expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cz = cz - expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_P = (/ 0, 0, 1 /) + cz = cz + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cz = cz - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_P = (/ 0, 0, 0 /) + cz = cz + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cz = cz - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + ! ---------------------------------------------------------------------------------------------------- + + + + ! ---------------------------------------------------------------------------------------------------- + ! [ (1-erf(mu r12)) / r12 ] \sum_A a_A c_A [ (r2-RA)^2 exp(-aA r2A^2) + ! ---------------------------------------------------------------------------------------------------- + + shift_P = (/ 0, 0, 0 /) + + ! x term: + ff = Q2_center(1) - Centerii(1) + + shift_Q = (/ 2, 0, 0 /) + cx = cx + expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cx = cx - expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_Q = (/ 1, 0, 0 /) + cx = cx + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cx = cx - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_Q = (/ 0, 0, 0 /) + cx = cx + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cx = cx - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + ! y term: + ff = Q2_center(2) - Centerii(2) + + shift_Q = (/ 0, 2, 0 /) + cy = cy + expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cy = cy - expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_Q = (/ 0, 1, 0 /) + cy = cy + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cy = cy - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_Q = (/ 0, 0, 0 /) + cy = cy + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cy = cy - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + ! z term: + ff = Q2_center(3) - Centerii(3) + + shift_Q = (/ 0, 0, 2 /) + cz = cz + expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cz = cz - expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_Q = (/ 0, 0, 1 /) + cz = cz + expoii * coefii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cz = cz - expoii * coefii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_Q = (/ 0, 0, 0 /) + cz = cz + expoii * coefii * ff * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cz = cz - expoii * coefii * ff * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + ! ---------------------------------------------------------------------------------------------------- + + + + ! ---------------------------------------------------------------------------------------------------- + ! - [ (1-erf(mu r12)) / r12 ] \sum_A a_A c_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ] + ! ---------------------------------------------------------------------------------------------------- + + ! x term: + ff = P2_center(1) - Centerii(1) + gg = Q1_center(1) - Centerii(1) + + shift_p = (/ 1, 0, 0 /) + shift_Q = (/ 1, 0, 0 /) + cx = cx - expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cx = cx + expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 1, 0, 0 /) + shift_Q = (/ 0, 0, 0 /) + cx = cx - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cx = cx + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 1, 0, 0 /) + cx = cx - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cx = cx + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 0, 0 /) + cx = cx - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cx = cx + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + ! y term: + ff = P2_center(2) - Centerii(2) + gg = Q1_center(2) - Centerii(2) + + shift_p = (/ 0, 1, 0 /) + shift_Q = (/ 0, 1, 0 /) + cy = cy - expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cy = cy + expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 1, 0 /) + shift_Q = (/ 0, 0, 0 /) + cy = cy - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cy = cy + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 1, 0 /) + cy = cy - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cy = cy + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 0, 0 /) + cy = cy - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cy = cy + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + ! z term: + ff = P2_center(3) - Centerii(3) + gg = Q1_center(3) - Centerii(3) + + shift_p = (/ 0, 0, 1 /) + shift_Q = (/ 0, 0, 1 /) + cz = cz - expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cz = cz + expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 1 /) + shift_Q = (/ 0, 0, 0 /) + cz = cz - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cz = cz + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 0, 1 /) + cz = cz - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cz = cz + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 0, 0 /) + cz = cz - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + cz = cz + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 & + , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P & + , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q ) + + ! ---------------------------------------------------------------------------------------------------- + + + + ! ---------------------------------------------------------------------------------------------------- + ! - [ (1-erf(mu r12)) / r12 ] \sum_A a_A c_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ] + ! ---------------------------------------------------------------------------------------------------- + + ! x term: + ff = P1_center(1) - Centerii(1) + gg = Q2_center(1) - Centerii(1) + + shift_p = (/ 1, 0, 0 /) + shift_Q = (/ 1, 0, 0 /) + cx = cx - expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cx = cx + expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 1, 0, 0 /) + shift_Q = (/ 0, 0, 0 /) + cx = cx - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cx = cx + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 1, 0, 0 /) + cx = cx - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cx = cx + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 0, 0 /) + cx = cx - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cx = cx + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + ! y term: + ff = P1_center(2) - Centerii(2) + gg = Q2_center(2) - Centerii(2) + + shift_p = (/ 0, 1, 0 /) + shift_Q = (/ 0, 1, 0 /) + cy = cy - expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cy = cy + expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 1, 0 /) + shift_Q = (/ 0, 0, 0 /) + cy = cy - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cy = cy + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 1, 0 /) + cy = cy - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cy = cy + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 0, 0 /) + cy = cy - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cy = cy + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + ! z term: + ff = P1_center(3) - Centerii(3) + gg = Q2_center(3) - Centerii(3) + + shift_p = (/ 0, 0, 1 /) + shift_Q = (/ 0, 0, 1 /) + cz = cz - expoii * coefii * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cz = cz + expoii * coefii * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 1 /) + shift_Q = (/ 0, 0, 0 /) + cz = cz - expoii * coefii * gg * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cz = cz + expoii * coefii * gg * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 0, 1 /) + cz = cz - expoii * coefii * ff * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cz = cz + expoii * coefii * ff * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + shift_p = (/ 0, 0, 0 /) + shift_Q = (/ 0, 0, 0 /) + cz = cz - expoii * coefii * ff * gg * general_primitive_integral_coul_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + cz = cz + expoii * coefii * ff * gg * general_primitive_integral_erf_shifted( dim1 & + , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P & + , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q ) + + ! ---------------------------------------------------------------------------------------------------- + + enddo + + return +end subroutine get_cxcycz_j2 + +! --- + diff --git a/src/ao_tc_eff_map/useful_sub.irp.f b/src/ao_tc_eff_map/useful_sub.irp.f new file mode 100644 index 00000000..4cfdcad2 --- /dev/null +++ b/src/ao_tc_eff_map/useful_sub.irp.f @@ -0,0 +1,364 @@ +! --- + +!______________________________________________________________________________________________________________________ +!______________________________________________________________________________________________________________________ + +double precision function general_primitive_integral_coul_shifted( dim & + , P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P & + , Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q ) + + include 'utils/constants.include.F' + + implicit none + + integer, intent(in) :: dim + integer, intent(in) :: iorder_p(3), shift_P(3) + integer, intent(in) :: iorder_q(3), shift_Q(3) + double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv + double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv + + integer :: n_Ix, n_Iy, n_Iz, nx, ny, nz + integer :: ix, iy, iz, jx, jy, jz, i + integer :: n_pt_tmp, n_pt_out, iorder + integer :: ii, jj + double precision :: rho, dist + double precision :: dx(0:max_dim), Ix_pol(0:max_dim) + double precision :: dy(0:max_dim), Iy_pol(0:max_dim) + double precision :: dz(0:max_dim), Iz_pol(0:max_dim) + double precision :: a, b, c, d, e, f, accu, pq, const + double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2 + double precision :: d1(0:max_dim), d_poly(0:max_dim) + double precision :: p_plus_q + + double precision :: rint_sum + + general_primitive_integral_coul_shifted = 0.d0 + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly + + ! Gaussian Product + ! ---------------- + p_plus_q = (p+q) + pq = p_inv * 0.5d0 * q_inv + pq_inv = 0.5d0 / p_plus_q + p10_1 = q * pq ! 1/(2p) + p01_1 = p * pq ! 1/(2q) + pq_inv_2 = pq_inv + pq_inv + p10_2 = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p) + p01_2 = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq) + + accu = 0.d0 + + iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1) + iorder = iorder + shift_P(1) + shift_Q(1) + iorder = iorder + shift_P(1) + shift_Q(1) + !DIR$ VECTOR ALIGNED + do ix = 0, iorder + Ix_pol(ix) = 0.d0 + enddo + n_Ix = 0 + do ix = 0, iorder_p(1) + + ii = ix + shift_P(1) + a = P_new(ix,1) + if(abs(a) < thresh) cycle + + do jx = 0, iorder_q(1) + + jj = jx + shift_Q(1) + d = a * Q_new(jx,1) + if(abs(d) < thresh) cycle + + !DEC$ FORCEINLINE + call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj & + , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx ) + !DEC$ FORCEINLINE + call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix) + enddo + enddo + if(n_Ix == -1) then + return + endif + + iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2) + iorder = iorder + shift_P(2) + shift_Q(2) + iorder = iorder + shift_P(2) + shift_Q(2) + !DIR$ VECTOR ALIGNED + do ix = 0, iorder + Iy_pol(ix) = 0.d0 + enddo + n_Iy = 0 + do iy = 0, iorder_p(2) + + if(abs(P_new(iy,2)) > thresh) then + + ii = iy + shift_P(2) + b = P_new(iy,2) + + do jy = 0, iorder_q(2) + + jj = jy + shift_Q(2) + e = b * Q_new(jy,2) + if(abs(e) < thresh) cycle + + !DEC$ FORCEINLINE + call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj & + , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny ) + !DEC$ FORCEINLINE + call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy) + enddo + endif + enddo + if(n_Iy == -1) then + return + endif + + iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3) + iorder = iorder + shift_P(3) + shift_Q(3) + iorder = iorder + shift_P(3) + shift_Q(3) + do ix = 0, iorder + Iz_pol(ix) = 0.d0 + enddo + n_Iz = 0 + do iz = 0, iorder_p(3) + + if( abs(P_new(iz,3)) > thresh ) then + + ii = iz + shift_P(3) + c = P_new(iz,3) + + do jz = 0, iorder_q(3) + + jj = jz + shift_Q(3) + f = c * Q_new(jz,3) + if(abs(f) < thresh) cycle + + !DEC$ FORCEINLINE + call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj & + , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz ) + !DEC$ FORCEINLINE + call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz) + enddo + endif + enddo + if(n_Iz == -1) then + return + endif + + rho = p * q * pq_inv_2 + dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) & + + (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) & + + (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3)) + const = dist*rho + + n_pt_tmp = n_Ix + n_Iy + do i = 0, n_pt_tmp + d_poly(i) = 0.d0 + enddo + + !DEC$ FORCEINLINE + call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp) + if(n_pt_tmp == -1) then + return + endif + n_pt_out = n_pt_tmp + n_Iz + do i = 0, n_pt_out + d1(i) = 0.d0 + enddo + + !DEC$ FORCEINLINE + call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out) + accu = accu + rint_sum(n_pt_out, const, d1) + + 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 +!______________________________________________________________________________________________________________________ +!______________________________________________________________________________________________________________________ + + + +!______________________________________________________________________________________________________________________ +!______________________________________________________________________________________________________________________ + +double precision function general_primitive_integral_erf_shifted( dim & + , P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P & + , Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q ) + + include 'utils/constants.include.F' + + implicit none + + integer, intent(in) :: dim + integer, intent(in) :: iorder_p(3), shift_P(3) + integer, intent(in) :: iorder_q(3), shift_Q(3) + double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv + double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv + + integer :: n_Ix, n_Iy, n_Iz, nx, ny, nz + integer :: ix, iy, iz, jx, jy, jz, i + integer :: n_pt_tmp, n_pt_out, iorder + integer :: ii, jj + double precision :: rho, dist + double precision :: dx(0:max_dim), Ix_pol(0:max_dim) + double precision :: dy(0:max_dim), Iy_pol(0:max_dim) + double precision :: dz(0:max_dim), Iz_pol(0:max_dim) + double precision :: a, b, c, d, e, f, accu, pq, const + double precision :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2 + double precision :: d1(0:max_dim), d_poly(0:max_dim) + double precision :: p_plus_q + + double precision :: rint_sum + + general_primitive_integral_erf_shifted = 0.d0 + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly + + ! Gaussian Product + ! ---------------- + p_plus_q = (p+q) * ( (p*q)/(p+q) + mu_erf*mu_erf ) / (mu_erf*mu_erf) + pq = p_inv * 0.5d0 * q_inv + pq_inv = 0.5d0 / p_plus_q + p10_1 = q * pq ! 1/(2p) + p01_1 = p * pq ! 1/(2q) + pq_inv_2 = pq_inv + pq_inv + p10_2 = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p) + p01_2 = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq) + + accu = 0.d0 + + iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1) + iorder = iorder + shift_P(1) + shift_Q(1) + iorder = iorder + shift_P(1) + shift_Q(1) + !DIR$ VECTOR ALIGNED + do ix = 0, iorder + Ix_pol(ix) = 0.d0 + enddo + n_Ix = 0 + do ix = 0, iorder_p(1) + + ii = ix + shift_P(1) + a = P_new(ix,1) + if(abs(a) < thresh) cycle + + do jx = 0, iorder_q(1) + + jj = jx + shift_Q(1) + d = a * Q_new(jx,1) + if(abs(d) < thresh) cycle + + !DEC$ FORCEINLINE + call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj & + , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx ) + !DEC$ FORCEINLINE + call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix) + enddo + enddo + if(n_Ix == -1) then + return + endif + + iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2) + iorder = iorder + shift_P(2) + shift_Q(2) + iorder = iorder + shift_P(2) + shift_Q(2) + !DIR$ VECTOR ALIGNED + do ix = 0, iorder + Iy_pol(ix) = 0.d0 + enddo + n_Iy = 0 + do iy = 0, iorder_p(2) + + if(abs(P_new(iy,2)) > thresh) then + + ii = iy + shift_P(2) + b = P_new(iy,2) + + do jy = 0, iorder_q(2) + + jj = jy + shift_Q(2) + e = b * Q_new(jy,2) + if(abs(e) < thresh) cycle + + !DEC$ FORCEINLINE + call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj & + , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny ) + !DEC$ FORCEINLINE + call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy) + enddo + endif + enddo + if(n_Iy == -1) then + return + endif + + iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3) + iorder = iorder + shift_P(3) + shift_Q(3) + iorder = iorder + shift_P(3) + shift_Q(3) + do ix = 0, iorder + Iz_pol(ix) = 0.d0 + enddo + n_Iz = 0 + do iz = 0, iorder_p(3) + + if( abs(P_new(iz,3)) > thresh ) then + + ii = iz + shift_P(3) + c = P_new(iz,3) + + do jz = 0, iorder_q(3) + + jj = jz + shift_Q(3) + f = c * Q_new(jz,3) + if(abs(f) < thresh) cycle + + !DEC$ FORCEINLINE + call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj & + , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz ) + !DEC$ FORCEINLINE + call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz) + enddo + endif + enddo + if(n_Iz == -1) then + return + endif + + rho = p * q * pq_inv_2 + dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) & + + (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) & + + (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3)) + const = dist*rho + + n_pt_tmp = n_Ix + n_Iy + do i = 0, n_pt_tmp + d_poly(i) = 0.d0 + enddo + + !DEC$ FORCEINLINE + call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp) + if(n_pt_tmp == -1) then + return + endif + n_pt_out = n_pt_tmp + n_Iz + do i = 0, n_pt_out + d1(i) = 0.d0 + enddo + + !DEC$ FORCEINLINE + call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out) + accu = accu + rint_sum(n_pt_out, const, d1) + + 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 +!______________________________________________________________________________________________________________________ +!______________________________________________________________________________________________________________________ + + + + + diff --git a/src/bi_ort_ints/one_e_bi_ort.irp.f b/src/bi_ort_ints/one_e_bi_ort.irp.f index b7b87463..a995a364 100644 --- a/src/bi_ort_ints/one_e_bi_ort.irp.f +++ b/src/bi_ort_ints/one_e_bi_ort.irp.f @@ -8,9 +8,9 @@ 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_gauss + provide j1b_type - if(j1b_gauss .eq. 1) then + if(j1b_type .ne. 0) then do i = 1, ao_num do j = 1, ao_num