1c $Id$ 2* 3C> \ingroup nwint 4C> @{ 5C> 6C> \brief Compute non-zero 3 center 2-electron integrals 7C> 8C> Computes 3 center 2-electron integrals of the following kind: 9C> \f{eqnarray*}{ 10C> ({\mu}|{\nu}{\lambda}) = \int_{-\infty}^{\infty} g_{\mu}(X_{\mu},r_{1})\frac{1}{r_{12}} 11C> g_{\nu}(X_{\nu},r_{2})g_{\lambda}(X_{\lambda},r_{2})dr_{1}dr_{2} 12C> \f} 13C> All zero valued integrals are removed and the remaining integrals 14C> identified with appropriate labels. 15C> 16c:tex-% this is part of the API Standard Integral routines. 17c:tex-\subsection{int\_l2e3c} 18c:tex-this routine computes the 3 center 2 electron integrals 19c:tex-with labels and ``zero'' integrals removed: 20c:tex-\begin{eqnarray*} 21c:tex-({\mu}|{\nu}{\lambda}) = \int_{-\infty}^{\infty} g_{\mu}(X_{\mu},r_{1})\frac{1}{r_{12}} 22c:tex-g_{\nu}(X_{\nu},r_{2})g_{\lambda}(X_{\lambda},r_{2})dr_{1}dr_{2} 23c:tex-\end{eqnarray*} 24c:tex- 25c:tex-{\it Syntax:} 26c:tex-\begin{verbatim} 27 subroutine int_l2e3c(brain, ish, ketin, jsh, ksh, 28 & zerotol, canket, leri, eri, nint, ilab, jlab, klab, 29 & lscr, scr) 30c:tex-\end{verbatim} 31 implicit none 32#include "bas.fh" 33#include "errquit.fh" 34#include "nwc_const.fh" 35#include "basP.fh" 36#include "basdeclsP.fh" 37#include "geomP.fh" 38#include "geobasmapP.fh" 39#include "mafdecls.fh" 40#include "bas_ibs_dec.fh" 41#include "stdio.fh" 42#include "util.fh" 43c 44c::external subroutines used 45c errquit 46c::functions 47 integer int_nint_cart 48 external int_nint_cart 49 logical int_chk_sh 50 external int_chk_sh 51c::passed 52c:tex-\begin{verbatim} 53 integer brain !< [Input] bra basis set handle 54 integer ish !< [Input] shell/contraction index 55 integer ketin !< [Input] ket basis set handle 56 integer jsh !< [Input] shell/contraction index 57 integer ksh !< [Input] shell/contraction index 58 integer lscr !< [Input] length of scratch array 59 double precision scr(lscr) !< [Scratch] array 60 double precision zerotol !< [Input] zero threshold 61 integer leri !< [Input] length of integral array 62 integer nint !< [Output] number of integrals computed 63 integer ilab(leri) !< [Output] i bas fun labels array 64 integer jlab(leri) !< [Output] j bas fun labels array 65 integer klab(leri) !< [Output] k bas fun labels array 66 double precision eri(leri) !< [Output] 2e3c integrals 67 logical canket !< [Input] canonicalize ket bas. fun. label pairs 68c:tex-\end{verbatim} 69c::local 70 logical shells_ok 71 integer i,j,k,bra,ket,icount 72 integer numint, newlscr 73c 74#include "bas_ibs_sfn.fh" 75c 76c check shells 77c 78 shells_ok = int_chk_sh(brain,ish) 79 shells_ok = shells_ok .and. int_chk_sh(ketin,jsh) 80 shells_ok = shells_ok .and. int_chk_sh(ketin,ksh) 81 if (.not.shells_ok) 82 & call errquit('int_l2e3c: invalid contraction/shell',0, 83 & BASIS_ERR) 84c 85c check canonicalizations of input shells for canket 86c 87 shells_ok = jsh.ge.ksh 88 if (.not.shells_ok) then 89 write(luout,*)'int_2e3c: shells not canonical on input ' 90 write(luout,*)'bra basis set handle:',brain 91 write(luout,*)'ket basis set handle:',ketin 92 write(luout,*)' ish:',ish 93 write(luout,*)' jsh:',jsh 94 write(luout,*)' ksh:',ksh 95 call errquit('int_l2e3c: shells not in canonical order',0, 96 & BASIS_ERR) 97 endif 98c 99 bra = brain + BASIS_HANDLE_OFFSET 100 ket = ketin + BASIS_HANDLE_OFFSET 101c 102c 103c compute eri (instead of copy) in front of scr() 104c 105 numint = int_nint_cart(brain,ish,ketin,jsh,ketin,ksh,0,0) 106 newlscr = lscr - numint 107 call int_2e3c(brain,ish,ketin,jsh,ksh, 108 & newlscr,scr(numint+1),numint,scr) 109c 110 nint = 0 111 icount = 0 112 do 00100 i = (sf_ibs_cn2bfr(1,ish,bra)), 113 & (sf_ibs_cn2bfr(2,ish,bra)) 114 do 00200 j = (sf_ibs_cn2bfr(1,jsh,ket)), 115 & (sf_ibs_cn2bfr(2,jsh,ket)) 116 do 00300 k = (sf_ibs_cn2bfr(1,ksh,ket)), 117 & (sf_ibs_cn2bfr(2,ksh,ket)) 118 icount = icount + 1 119 if (abs(scr(icount)).ge.zerotol) then 120 if (canket)then 121 if(j.ge.k) then 122 nint = nint + 1 123 eri(nint) = scr(icount) 124 ilab(nint) = i 125 jlab(nint) = j 126 klab(nint) = k 127 endif 128 else 129 nint = nint + 1 130 eri(nint) = scr(icount) 131 ilab(nint) = i 132 jlab(nint) = j 133 klab(nint) = k 134 endif 135 endif 13600300 continue 13700200 continue 13800100 continue 139c 140 end 141C> @} 142