1c $Id$
2*
3C> \ingroup nwint
4C>
5C> \brief Generate labels for general 2 index 1 electron integrals
6C>
7C> This routine generates labels for general 2 index one
8C> electron integrals.  This is mostly unused since the other
9C> integral type specific label routines are now used.  This
10C> routine requires that the integral block be computed prior
11C> to the label call.  Other routines now integrate label
12C> generation with computation.
13C>
14c:tex-% this is part of the API Standard Integral routines
15c:tex-\subsection{int\_l1gen1e}
16c:tex-This routine generates labels for general 2 index one
17c:tex-electron integrals.  This is mostly unused since the other
18c:tex-integral type specific label routines are now used.  This
19c:tex-routine requires that the integral block be computed prior
20c:tex-to the label call.  Other routines now integrate label
21c:tex-generation with computation.
22c:tex-
23c:tex-{\it Syntax:}
24c:tex-\begin{verbatim}
25      subroutine int_lgen1e(i_basis, ish, j_basis, jsh, zerotol,
26     &       ilab, jlab, l1e, Gen1e, lscr, scr, numgen)
27c:tex-\end{verbatim}
28      implicit none
29#include "nwc_const.fh"
30#include "errquit.fh"
31#include "basP.fh"
32#include "geobasmapP.fh"
33#include "mafdecls.fh"
34#include "bas_ibs_dec.fh"
35#include "util.fh"
36c
37c::external subroutines used
38c dcopy
39c errquit
40c::function
41      logical int_chk_sh
42      external int_chk_sh
43c::passed
44c:tex-\begin{verbatim}
45      integer i_basis !< [input] bra basis set handle
46      integer ish     !< [input] bra shell lexical index
47      integer j_basis !< [input] ket basis set handle
48      integer jsh     !< [input] ket shell lexical index
49      double precision zerotol !< [input] zero threshold
50      integer l1e       !< [input] length of buffers for integrals
51      integer ilab(l1e) !< [output] i bas func labels array
52      integer jlab(l1e) !< [output] j bas func labels array
53      double precision Gen1e(l1e) !< [input/output] 1e integrals
54      integer lscr !< [input] length of scratch array
55      double precision scr(lscr) !< [scratch] array
56      integer numgen !< [output] number of integrals
57                     !< saved and returned
58c:tex-\end{verbatim}
59c::local
60      integer ibas, jbas, icount, i, j
61      logical ijbas
62      logical shells_ok
63      logical nonzero
64c
65#include "bas_ibs_sfn.fh"
66c
67      shells_ok = int_chk_sh(i_basis,ish)
68      shells_ok = shells_ok .and. int_chk_sh(j_basis,jsh)
69      if (.not.shells_ok)
70     &       call errquit('int_lgen1e: invalid contraction/shell',0,
71     &            BASIS_ERR)
72c
73      ibas  = i_basis + BASIS_HANDLE_OFFSET
74      jbas  = j_basis + BASIS_HANDLE_OFFSET
75      ijbas = ibas .eq. jbas
76c
77c copy Gen1e vector to scratch array
78c
79      if (l1e.gt.lscr)
80     & call errquit('int_lgen1e: scratch array too small. need:',l1e,
81     &        INT_ERR)
82
83      call dcopy(l1e,Gen1e,1,scr,1)
84c
85      numgen = 0
86      icount = 0
87      do 00100 i = (sf_ibs_cn2bfr(1,ish,ibas)),
88     &      (sf_ibs_cn2bfr(2,ish,ibas))
89        do 00200 j = (sf_ibs_cn2bfr(1,jsh,jbas)),
90     &        (sf_ibs_cn2bfr(2,jsh,jbas))
91          icount = icount + 1
92          nonzero = abs(scr(icount)).ge.zerotol
93          if (nonzero) then
94            if ((.not.ijbas).or.i.ge.j) then
95              numgen = numgen + 1
96              Gen1e(numgen) = scr(icount)
97              ilab(numgen) = i
98              jlab(numgen) = j
99            endif
100          endif
101c
10200200   continue
10300100 continue
104c
105      end
106C> @}
107