1c $Id$
2*
3C> \ingroup nwint
4C> @{
5C>
6C> \brief Computes the angular momentum integrals
7C>
8C> Computes the angular momentum integrals. The integrals are stored
9C> in the order:
10C>
11C> - h11(*,1) = \f$ \int g_i(r) \left(y\frac{\partial}{\partial z} - z\frac{\partial}{\partial y}\right) g_j(r) dr \f$
12C>
13C> - h11(*,2) = \f$ \int g_i(r) \left(z\frac{\partial}{\partial x} - x\frac{\partial}{\partial z}\right) g_j(r) dr \f$
14C>
15C> - h11(*,3) = \f$ \int g_i(r) \left(x\frac{\partial}{\partial y} - y\frac{\partial}{\partial x}\right) g_j(r) dr \f$
16C>
17C> where the "*" represents any basis function pairs.
18C>
19c:tex-% this is part of the API Standard Integral routines.
20c:tex-\subsection{int\_angmom}
21c:tex-This routine computes the angular momentum integrals
22c:tex-{\it Syntax:}
23c:tex-\begin{verbatim}
24      subroutine int_angmom(i_basis,ish,j_basis,jsh,lscr,scr,lh11,h11)
25c:tex-\end{verbatim}
26      implicit none
27#include "nwc_const.fh"
28#include "errquit.fh"
29#include "basP.fh"
30#include "basdeclsP.fh"
31#include "geomP.fh"
32#include "geobasmapP.fh"
33#include "mafdecls.fh"
34#include "bas_exndcf_dec.fh"
35#include "bas_ibs_dec.fh"
36#include "int_nbf.fh"
37#include "stdio.fh"
38#include "apiP.fh"
39#include "util.fh"
40c::external subroutines used
41c... errquit
42c::functions
43      logical cando_hnd_1e_prp
44      logical int_chk_init
45      logical int_chk_sh
46      external int_chk_init
47      external int_chk_sh
48      external cando_hnd_1e_prp
49c::passed
50c:tex-\begin{verbatim}
51      integer i_basis !< [Input] basis set handle for ish
52      integer ish     !< [Input] i shell/contraction
53      integer j_basis !< [Input] basis set handle for jsh
54      integer jsh     !< [Input] j shell/contraction
55      integer lscr    !< [Input] length of scratch array
56      double precision scr(lscr) !< [Scratch] scratch array
57      integer lh11               !< [Input] length of h11 buffer
58      double precision h11(lh11) !< [Output] h11 integrals
59c:tex-\end{verbatim}
60c::local
61      integer igeom, jgeom, ibas, jbas, ucont
62      integer itype, inp, igen, iexp, icent, icf, iatom
63      integer jtype, jnp, jgen, jexp, jcent, jcf, jatom
64c
65      logical any_spherical, trani, tranj, shells_ok
66      integer i_nbf_x, j_nbf_x
67      integer i_nbf_s, j_nbf_s
68      integer ipts, ncartint ,i,j
69c
70#include "bas_exndcf_sfn.fh"
71#include "bas_ibs_sfn.fh"
72c
73c check initialization and shells
74c
75      if (.not.int_chk_init('int_angmom'))
76     &       call errquit('int_angmom: int_init was not called' ,0,
77     &       INT_ERR)
78c
79      shells_ok = int_chk_sh(i_basis,ish)
80      shells_ok = shells_ok .and. int_chk_sh(j_basis,jsh)
81      if (.not.shells_ok)
82     &       call errquit('int_angmom: invalid contraction/shell',0,
83     &       INT_ERR)
84c
85c  check if gencont
86c
87      call int_nogencont_check(i_basis,'int_angmom:i_basis')
88      call int_nogencont_check(j_basis,'int_angmom:j_basis')
89c
90      ibas = i_basis + basis_handle_offset
91      jbas = j_basis + basis_handle_offset
92c
93      ucont = (sf_ibs_cn2ucn(ish,ibas))
94      itype = infbs_cont(CONT_TYPE ,ucont,ibas)
95      inp   = infbs_cont(CONT_NPRIM,ucont,ibas)
96      igen  = infbs_cont(CONT_NGEN ,ucont,ibas)
97      iexp  = infbs_cont(CONT_IEXP ,ucont,ibas)
98      icf   = infbs_cont(CONT_ICFP ,ucont,ibas)
99      iatom = (sf_ibs_cn2ce(ish,ibas))
100      igeom = ibs_geom(ibas)
101c
102      ucont = (sf_ibs_cn2ucn(jsh,jbas))
103      jtype = infbs_cont(CONT_TYPE ,ucont,jbas)
104      jnp   = infbs_cont(CONT_NPRIM,ucont,jbas)
105      jgen  = infbs_cont(CONT_NGEN ,ucont,jbas)
106      jexp  = infbs_cont(CONT_IEXP ,ucont,jbas)
107      jcf   = infbs_cont(CONT_ICFP ,ucont,jbas)
108      jatom = (sf_ibs_cn2ce(jsh,jbas))
109      jgeom = ibs_geom(jbas)
110c
111      if (igeom.ne.jgeom) then
112        write(luout,*)'int_angmom: two different geometries for',
113     &         ' properties?'
114        call errquit('int_angmom: geom error ',911, GEOM_ERR)
115      endif
116c
117c     Determine # of cartesian integrals in block
118c
119      ncartint = int_nbf_x(itype)*int_nbf_x(jtype)
120c
121      call hnd_angmom(
122     &       coords(1,iatom,igeom),
123     &       dbl_mb(mb_exndcf(iexp,ibas)),
124     &       dbl_mb(mb_exndcf(icf,ibas)),
125     &       inp,igen,itype,
126c
127     &       coords(1,jatom,jgeom),
128     &       dbl_mb(mb_exndcf(jexp,jbas)),
129     &       dbl_mb(mb_exndcf(jcf,jbas)),
130     &       jnp,jgen,jtype,
131c
132     &       ncartint,h11,scr,lscr)
133c
134c     h11 now has three blocks
135c
136      any_spherical = bas_spherical(ibas).or.bas_spherical(jbas)
137      if (.not.any_spherical) return
138c
139      i_nbf_x = int_nbf_x(itype)
140      j_nbf_x = int_nbf_x(jtype)
141c
142c... assume we need to transform both i and j integrals
143c
144      trani = .true.
145      tranj = .true.
146*.. do not tranform i component
147      if (.not.bas_spherical(ibas)) trani = .false.
148*.. do not tranform j component
149      if (.not.bas_spherical(jbas)) tranj = .false.
150c
151c ... reset general contractions for sp shells to 1 since they are handled
152c     as a block of 4.
153c
154      if (itype.eq.-1) igen = 1
155      if (jtype.eq.-1) jgen = 1
156      call spcart_2cBtran(h11,scr,lscr,
157     &    j_nbf_x,int_nbf_s(jtype),jtype,jgen,tranj,
158     &    i_nbf_x,int_nbf_s(itype),itype,igen,trani,
159     &    3,.false.)
160c
161c     We now have the integrals in array (nsph_ints,3)
162c
163      return
164      end
165C> @}
166