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