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