1C> \ingroup nwint 2C> @{ 3C> 4C> \brief Compute 2-electron 2-center Gaussian periodic electron 5C> repulsion integrals 6C> 7C> The code in question always uses density fitting approaches for 8C> the 2-center 2-electron integrals are needed. See [1] for details. 9C> 10C> [1] JE Jaffe, AC Hess, 11C> <i>"Gaussian basis density functional theory for systems 12C> periodic in two or three dimensions: Energy and forces"</i>, 13C> J.Chem.Phys. <b>105</b>, 10983-10998 (1996), DOI: 14C> <a href="https://doi.org/10.1063/1.472866"> 15C> 10.1063/1.472866</a> 16C> 17 subroutine intp_2e2c(brain, ish, ketin, jsh, Rj, 18 & lscr, scr, leri, eri) 19c $Id$ 20 implicit none 21c 22c basic api routine to generate a block of 2 center two electron integrals 23c eri = <bra_g(ish)|ket_g(jsh)> 24c 25#include "apiP.fh" 26#include "errquit.fh" 27#include "bas.fh" 28#include "nwc_const.fh" 29#include "basP.fh" 30#include "basdeclsP.fh" 31#include "geomP.fh" 32#include "geobasmapP.fh" 33#include "stdio.fh" 34#include "mafdecls.fh" 35#include "bas_exndcf_dec.fh" 36#include "bas_ibs_dec.fh" 37#include "int_nbf.fh" 38c 39c::external subroutines used 40c errquit 41c::functions 42 logical cando_nw 43 logical int_chk_sh 44 logical int_chk_init 45 external cando_nw 46 external int_chk_sh 47 external int_chk_init 48c:: passed 49 integer brain !< [Input] basis set handle for bra function 50 integer ketin !< [Input] basis set handle for ket function 51 integer ish !< [Input] lexical contraction/shell index 52 integer jsh !< [Input] lexical contraction/shell index 53 integer lscr !< [Input] length of scratch array 54 integer leri !< [Input] length of ERI array 55 double precision scr(lscr) !< [Scratch] scratch array 56 double precision eri(leri) !< [Output] ERI array 57 double precision Rj(3) !< [Input] translation vector for jsh center (fractional coordinates) 58c:: local 59 logical shells_ok 60 integer bra, ket 61 integer p_geom, q_geom, ucont 62 integer Lp, p_prim, p_gen, p_iexp, p_icfp, p_cent 63 integer Lq, q_prim, q_gen, q_iexp, q_icfp, q_cent 64 double precision xyz_new_j(3) ! new coordinates for jsh function center 65c 66 integer WarnP 67 save WarnP 68 data WarnP /0/ 69c 70#include "bas_exndcf_sfn.fh" 71#include "bas_ibs_sfn.fh" 72c 73c check initialization 74c 75 if (.not.int_chk_init('intp_2e2c')) 76 & call errquit('intp_2e2c: int_init was not called' ,0, 77 & INT_ERR) 78c 79c check input shell ranges 80c 81 shells_ok = int_chk_sh(brain,ish) 82 shells_ok = shells_ok .and. int_chk_sh(ketin,jsh) 83c 84 if (.not.shells_ok) 85 & call errquit('intp_2e2c: invalid contraction/shell',0, 86 & BASIS_ERR) 87c 88c check if gencon/sp shell 89c 90 call int_nogencont_check(brain,'intp_2e2c:bra') 91 call int_nogencont_check(ketin,'intp_2e2c:ket') 92 call int_nospshell_check(brain,'intp_2e2c:bra') 93 call int_nospshell_check(ketin,'intp_2e2c:ket') 94c 95c define center information required 96c 97 bra = brain + BASIS_HANDLE_OFFSET 98 ket = ketin + BASIS_HANDLE_OFFSET 99 p_geom = ibs_geom(bra) 100 q_geom = ibs_geom(ket) 101c 102 if (p_geom.ne.q_geom.and.WarnP.eq.0) then 103 write(luout,*) 104 & 'intp_2e2c: WARNING: possible geometry inconsistency' 105 write(luout,*)'bra geometry handle:',p_geom 106 write(luout,*)'ket geometry handle:',q_geom 107 WarnP = 1 108 endif 109c 110 p_cent = (sf_ibs_cn2ce(ish,bra)) 111 q_cent = (sf_ibs_cn2ce(jsh,ket)) 112c 113c.. translate jsh center coordinates based on Rj 114 call intp_txyz(q_cent,q_geom,Rj,xyz_new_j) 115 if(cando_nw(brain,ish,0).and.cando_nw(ketin,jsh,0)) then 116c 117 ucont = (sf_ibs_cn2ucn(ish,bra)) 118 Lp = infbs_cont(CONT_TYPE ,ucont,bra) 119 p_prim = infbs_cont(CONT_NPRIM,ucont,bra) 120 p_gen = infbs_cont(CONT_NGEN ,ucont,bra) 121 p_iexp = infbs_cont(CONT_IEXP ,ucont,bra) 122 p_icfp = infbs_cont(CONT_ICFP ,ucont,bra) 123c 124 ucont = (sf_ibs_cn2ucn(jsh,ket)) 125 Lq = infbs_cont(CONT_TYPE ,ucont,ket) 126 q_prim = infbs_cont(CONT_NPRIM,ucont,ket) 127 q_gen = infbs_cont(CONT_NGEN ,ucont,ket) 128 q_iexp = infbs_cont(CONT_IEXP ,ucont,ket) 129 q_icfp = infbs_cont(CONT_ICFP ,ucont,ket) 130c 131 call hf2( 132 & coords(1,p_cent,p_geom), dbl_mb(mb_exndcf(p_iexp,bra)), 133 & dbl_mb(mb_exndcf(p_icfp,bra)), p_prim, p_gen, Lp, 134 & coords(1,p_cent,p_geom), DCexp, 135 & DCcoeff , 1, 1, 0, 136 & xyz_new_j, dbl_mb(mb_exndcf(q_iexp,ket)), 137 & dbl_mb(mb_exndcf(q_icfp,ket)), q_prim, q_gen, Lq, 138 & xyz_new_j, DCexp, 139 & DCcoeff , 1, 1, 0, 140c......................... canAB canCD canPQ 141 & eri, leri, .false., .false., .false., 142c............. dryrun 143 & .false., scr, lscr) 144 if (bas_spherical(bra).or.bas_spherical(ket)) then 145c ... reset general contractions for sp shells to 1 since they are handled 146c as a block of 4. Since int_nbf_* arrays are set to the appropriate size. 147 if (Lp.eq.-1) p_gen = 1 148 if (Lq.eq.-1) q_gen = 1 149 call spcart_2ctran(eri,scr,lscr, 150 & int_nbf_x(Lp),int_nbf_s(Lp),Lp,p_gen,bas_spherical(bra), 151 & int_nbf_x(Lq),int_nbf_s(Lq),Lq,q_gen,bas_spherical(ket), 152 & .false.) 153 endif 154c 155 else 156 write(luout,*)'intp_2e2c: could not do nw integrals' 157 write(luout,*)' brain :',brain 158 write(luout,*)' ketin :',ketin 159 write(luout,*)' ish :',ish 160 write(luout,*)' jsh :',jsh 161 call errquit('intp_2e2c: fatal error ',0, INT_ERR) 162 endif 163 end 164C> @} 165