1C> \ingroup nwint 2C> @{ 3C> 4C> \brief Compute 1-electron Gaussian periodic overlap 5C> integral derivatives 6C> 7C> See [1] for details. 8C> 9C> [1] JE Jaffe, AC Hess, 10C> <i>"Gaussian basis density functional theory for systems 11C> periodic in two or three dimensions: Energy and forces"</i>, 12C> J.Chem.Phys. <b>105</b>, 10983-10998 (1996), DOI: 13C> <a href="https://doi.org/10.1063/1.472866"> 14C> 10.1063/1.472866</a> 15C> 16 subroutine intpd_1eov(i_basis,ish,j_basis,jsh,R,lscr,scr, 17 & lOva,Ova,idatom) 18* 19* $Id$ 20* 21 implicit none 22#include "stdio.fh" 23#include "errquit.fh" 24#include "nwc_const.fh" 25#include "basP.fh" 26#include "basdeclsP.fh" 27#include "geomP.fh" 28#include "geobasmapP.fh" 29#include "mafdecls.fh" 30#include "bas_exndcf_dec.fh" 31#include "bas_ibs_dec.fh" 32#include "int_nbf.fh" 33c::external subroutines used 34c... errquit 35c::functions 36 logical cando_nw_1e 37 logical cando_nw 38 logical int_chk_init 39 logical int_chk_sh 40 external int_chk_init 41 external int_chk_sh 42 external cando_nw_1e 43 external cando_nw 44 integer int_nint_cart 45 external int_nint_cart 46c::passed 47 integer i_basis !< [Input] basis set handle for ish functions 48 integer j_basis !< [Input] basis set handle for jsh functions 49 integer ish !< [Input] lexical contraction/shell index 50 integer jsh !< [Input] lexical contraction/shell index 51 integer lscr !< [Input] length of the scratch array 52 integer lOva !< [Input] length of the overlap integral array 53 double precision Ova(lOva) !< [Output] overlap integral array 54 double precision scr(lscr) !< [Scratch] scratch array 55 double precision R(3) !< [Input] translational vector fractional coordinates 56 integer idatom(*) !< [Output] array identifying centers for derivatives 57c ! e.g., the first nint*3 derivatives go to center idatom(1) 58c ! the second nint*3 derivatives go to center idatom(2) 59c::local 60 logical shells_ok 61 integer i_geom, j_geom, ibas, jbas, ucont, mynint 62 integer Li, i_prim, i_gen, i_iexp, i_icfp, i_cent 63 integer Lj, j_prim, j_gen, j_iexp, j_icfp, j_cent 64 double precision xyz_new(3) ! new coordinates for jsh function center 65*rak: integer jjj 66c 67 logical inline_chk_sh 68 integer WarnP 69 save WarnP 70 data WarnP /0/ 71c 72#include "bas_exndcf_sfn.fh" 73#include "bas_ibs_sfn.fh" 74c... statement function for int_chk_sh 75 inline_chk_sh(ibas,ish) = 76 $ ((ish.gt.0) .and. (ish.le.ncont_tot_gb(ibas))) 77c 78c check initialization and shells 79c 80 if (.not.int_chk_init('intpd_1eov')) 81 & call errquit('intpd_1eov: int_init was not called' ,0, 82 & INT_ERR) 83c 84 ibas = i_basis + BASIS_HANDLE_OFFSET 85 jbas = j_basis + BASIS_HANDLE_OFFSET 86c 87 shells_ok = inline_chk_sh(ibas,ish) 88 shells_ok = shells_ok .and. inline_chk_sh(jbas,jsh) 89 if (.not.shells_ok) 90 & call errquit('intpd_1eov: invalid contraction/shell',0, 91 & BASIS_ERR) 92c 93 ucont = (sf_ibs_cn2ucn(ish,ibas)) 94 Li = infbs_cont(CONT_TYPE ,ucont,ibas) 95 i_prim = infbs_cont(CONT_NPRIM,ucont,ibas) 96 i_gen = infbs_cont(CONT_NGEN ,ucont,ibas) 97 i_iexp = infbs_cont(CONT_IEXP ,ucont,ibas) 98 i_icfp = infbs_cont(CONT_ICFP ,ucont,ibas) 99 i_cent = (sf_ibs_cn2ce(ish,ibas)) 100 i_geom = ibs_geom(ibas) 101c 102 ucont = (sf_ibs_cn2ucn(jsh,jbas)) 103 Lj = infbs_cont(CONT_TYPE ,ucont,jbas) 104 j_prim = infbs_cont(CONT_NPRIM,ucont,jbas) 105 j_gen = infbs_cont(CONT_NGEN ,ucont,jbas) 106 j_iexp = infbs_cont(CONT_IEXP ,ucont,jbas) 107 j_icfp = infbs_cont(CONT_ICFP ,ucont,jbas) 108 j_cent = (sf_ibs_cn2ce(jsh,jbas)) 109 j_geom = ibs_geom(jbas) 110c 111 mynint = int_nint_cart(i_basis,ish,j_basis,jsh,0,0,0,0) 112 if (i_cent.eq.j_cent) then 113* write(luout,*)' automatic zero ' 114 call ifill(2,0,idatom,1) 115 call dcopy((mynint*3*2),0.0d00,0,Ova,1) 116 return 117 endif 118 idatom(1) = i_cent 119 idatom(2) = j_cent 120c 121 if (i_geom.ne.j_geom.and.WarnP.eq.0) then 122 write(luout,*) 123 & 'intpd_1eov: WARNING: possible geometry inconsistency' 124 write(luout,*)'i_basis geometry handle:',i_geom 125 write(luout,*)'j_basis geometry handle:',j_geom 126 WarnP = 1 127 endif 128c 129c.. translate coordinates based on R 130 call intp_txyz(j_cent,j_geom,R,xyz_new) 131c 132 if (cando_nw(i_basis,ish,0).and.cando_nw(j_basis,jsh,0)) then 133 call hf1d( 134 & coords(1,i_cent,i_geom),dbl_mb(mb_exndcf(i_iexp,ibas)), 135 & dbl_mb(mb_exndcf(i_icfp,ibas)), i_prim, i_gen, Li, i_cent, 136 & xyz_new,dbl_mb(mb_exndcf(j_iexp,jbas)), 137 & dbl_mb(mb_exndcf(j_icfp,jbas)), j_prim, j_gen, Lj, j_cent, 138 & coords(1,1,i_geom),charge(1,i_geom), 139 & geom_invnucexp(1,i_geom),ncenter(i_geom), 140c.............................. doS doT doV canonical 141 & Ova,scr,scr,mynint,.true.,.false.,.false.,.false., 142c........... dryrun 143 & .false.,scr,lscr) 144 if (bas_spherical(ibas).or.bas_spherical(jbas)) then 145 if (Li.eq.-1) i_gen = 1 146 if (Lj.eq.-1) j_gen = 1 147 call spcart_2cBtran(Ova,scr,lscr, 148 & int_nbf_x(Li),int_nbf_s(Li),Li,i_gen,bas_spherical(ibas), 149 & int_nbf_x(Lj),int_nbf_s(Lj),Lj,j_gen,bas_spherical(jbas), 150 & (3*2),.false.) 151 endif 152 else 153 call errquit('intpd_1eov: could not do sp or nw integrals',0, 154 & INT_ERR) 155 endif 156c 157 end 158C> @} 159