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