1c 2c $Id$ 3c 4c Taken and modified from HONDO 5c 6 subroutine hnd_stvintdd(xyzi,expi,coefi,i_nprim,i_ngen, Li, 7 1 i_cent,xyzj,expj,coefj, j_nprim, j_ngen, Lj, j_cent, 8 2 xyz,zan,nat,sder,tder,vder,nint,doS,doT,doV,scr,lscr) 9c 10 implicit none 11#include "stdio.fh" 12 integer i_nprim ! [input] num. prims on function i 13 integer i_ngen ! [input] num general conts on func. i 14 integer Li ! [input] angular momentum of func. i 15 integer j_nprim ! [input] num. prims on function j 16 integer j_ngen ! [input] num general conts on func. j 17 integer Lj ! [input] angular momentum of func. j 18 integer nat ! [input] number of atoms 19 integer lscr ! [input] size of scratch array 20 integer nint ! [input] size of any integral buffer 21 integer i_cent ! [input] lexical number of center i 22 integer j_cent ! [input] lexical number of center j 23 double precision xyzi(3) ! [input] position of center i 24 double precision expi(i_nprim) ! [input] exponents on i 25 double precision coefi(i_nprim,i_ngen) ! [input] i coeffs 26 double precision xyzj(3) ! [input] position of center j 27 double precision expj(j_nprim) ! [input] exponents on j 28 double precision coefj(j_nprim,j_ngen) ! [input] j coeffs 29 double precision xyz(3,nat) ! [input] all atom positions 30 double precision zan(nat) ! [input] charges on all atoms 31 double precision scr(lscr) ! [scratch] scratch buffers 32 double precision sder(*) ! [output] overlap integrals 33 double precision tder(*) ! [output] kinetic energy integrals 34 double precision vder(*) ! [output] potential integrals 35 logical doS ! [input] compute overlap (True/False) 36 logical doT ! [input] compute kinetic (True/False) 37 logical doV ! [input] compute potential (True/False) 38 logical some 39 integer nder, maxi, maxj 40 integer i, index 41 double precision zero 42 data zero /0.0d+00/ 43c 44 nder = 2 45c 46c ----- calculate -s-, -t-, and -v- derivative integrals ----- 47c 48 some = .false. 49 if(some) write(luout,9999) 50c 51 if (doS) then 52 call dcopy(nint*3*3*4,zero,0,sder,1) 53 call hnd_sd_ij2(xyzi,expi,coefi,i_nprim,i_ngen, Li, 54 1 xyzj,expj,coefj, j_nprim, j_ngen, Lj, scr, scr, sder, 55 2 sder(nint*3*3+1),sder(nint*3*3*3+1),nder,nint,scr,lscr) 56c 57c to get the djdi term which is equal to the didj term which is calculated 58c 59 call dcopy(nint*3*3,sder(nint*3*3+1),1,sder(nint*3*3*2+1),1) 60 endif 61c 62c write(luout,*) 'before the call to doV' 63c call flush(luout) 64c 65 if (doV) then 66 call dcopy(nint*3*3*nat*3,zero,0,vder,1) 67c 68c Do the Helman-Feynman part (i|d2/dxcdxcV|j) 69c The first nat*nint*3*3 holds these terms 70c 71 do i=1,nat 72c write(luout,*) 'number of calls to hnd_hlf_ij2 ',i 73 call hnd_hlf_ij2(xyzi,expi,coefi,i_nprim,i_ngen,Li, 74 1 xyzj,expj,coefj,j_nprim,j_ngen,Lj,i,scr, 75 2 vder((i-1)*3*3*nint+1),zan,xyz,nder,nint,scr,lscr) 76 enddo 77c write(6,*) 'Hel-Fey part' 78c do i=1,nat*3*3*3*nint 79c write(6,*) vder(i) 80c enddo 81c 82c Do the mixed part (di|d/dxcV|j) and (i|d/dxcV|dj) 83c These are held in the rest of vder 84c 85 do i=1,nat 86c write(luout,*) 'number of calls to hnd_hlfd_ij ',i 87 call hnd_hlfd_ij2(xyzi,expi,coefi,i_nprim,i_ngen,Li, 88 1 xyzj,expj,coefj,j_nprim,j_ngen,Lj,i, 89 2 vder((i-1)*3*3*nint+nint*3*3*nat+1), 90 3 vder((i-1)*3*3*nint+nint*3*3*nat*2+1), 91 4 zan,xyz,nder,nint,scr,lscr) 92 enddo 93c 94c write(6,*) 'before the second doV, vder is' 95c do i=1,nat*3*3*3*nint 96c write(6,*) vder(i) 97c enddo 98 endif 99 100c write(luout,*) 'before the doT call' 101c call flush(luout) 102 if (doT.or.doV) then 103 call dcopy(nint*3*3*3,zero,0,tder,1) 104c note that scr is used as a dummy and tder also holds the vder terms 105c if (doV) call dcopy(nint*3*3,zero,0,scr,1) 106 call hnd_tvd_ij2(xyzi,expi,coefi,i_nprim,i_ngen,Li, 107 1 xyzj,expj,coefj,j_nprim,j_ngen,Lj,xyz,scr,scr,tder, 108 2 tder(nint*3*3+1),tder(nint*3*3*2+1),scr,scr, 109 3 tder,tder(nint*3*3+1), 110 4 tder(nint*3*3*2+1),nder,nint, 111 5 zan,nat,doT,doV,i_cent,j_cent,scr,lscr) 112c write(6,*) 'after the second doV, vder is' 113c do i=1,nat*3*3*3*nint 114c write(6,*) vder(i) 115c enddo 116 endif 117c 118 if(some) write(luout,9998) 119 return 120 9999 format(/,10x,20(1h-),/,10x,'1 electron derivative integrals', 121 2 /,10x,20(1h-)) 122 9998 format(' ...... end of one-electron integrals ......') 123 end 124