easyconfigs-it4i/m/MRCC/mrcc_files/dfint_end_kc_IN_der.f
2024-07-25 10:27:17 +02:00

108 lines
3.4 KiB
Fortran
Executable File

! do aa=0,nc12/2-1
! if(dabs(dcore(ij+aa)).gt.ssa.and.dabs(dcore(ij+aa)).gt.1d-30
! $)then
c $.and.ip(iprim).ne.0.and.jp(jprim).ne.0) then ! A der
! print*,"A der",ctrip
! print*,iat,jat,kat
! print*,iprim,jprim,kprim
! print*,ip(iprim),jp(jprim)
! print*,dabs(dcore(ij+aa)),ssa,aa+1
! print*,adpre(jprim,iprim),ketpre
! print*,"ptolj:",ptolj
! print*
! print*
! stop
! endif
! if(dabs(dcore(ij+aa+nc12/2)).gt.ssb.and.
! $dabs(dcore(ij+aa+nc12/2)).gt.1d-30
! $)then
c $.and.ip(iprim).ne.0.and.jp(jprim).ne.0) then ! B der
! print*,"B der",ctrip
! print*,iat,jat,kat
! print*,iprim,jprim,kprim
! print*,ip(iprim),jp(jprim)
! print*,dabs(dcore(ij+aa+nc12/2)),ssb,aa+1
! print*,bdpre(jprim,iprim),ketpre
! print*,"ptolj:",ptolj
! print*
! print*
! stop
! endif
! if(dabs(dcore(ij+aa)+dcore(ij+aa+nc12/2)).gt.ssc.and.
! $dabs(dcore(ij+aa)+dcore(ij+aa+nc12/2)).gt.1d-30
! $)then
c $.and.ip(iprim).ne.0.and.jp(jprim).ne.0) then ! C der
! print*,"C der",ctrip
! print*,iat,jat,kat
! print*,iprim,jprim,kprim
! print*,ip(iprim),jp(jprim)
! print*,dabs(dcore(ij+aa)+dcore(ij+aa+nc12/2)),ssc,aa+1
! print*,brapre(jprim,iprim),kdpre
! print*,"ptolj:",ptolj
! print*
! stop
! endif
! enddo
c do aa=0,nc121
c if(dabs(dcore(ij+aa))
c $.gt.max(ssa,ssb,ssc))
c $then
c print*,aa+1
c print*,ptolj
c print*,dcore(ij+aa),max(ssa,ssb,ssc)
c print*,ssa,ssb,ssc
c print*,"IN"
c print*,ip(iprim),jp(jprim)
c print*,maxval(gcj(jprim,:))
c print*
c endif
c enddo
enddo! kprim
nzjp=nzjp+1
nzjpr(nzjp)=jprim
C END PRE
endif! Primitive prescreening
! Contraction of the integrals into the contracted basis starts here
enddo! jprim
! Multiply with contrcation coefficients for j
! it3(nc12,kcontr,jprim) ->it4(nc12,kcontr,jcontr,iprim)
if(nzjp.gt.0) then
iplace=jlength-nckl
do jcontr=1,njcontr
gc1=gcnj(1,jcontr)
gc2=gcnj(2,jcontr)
ilo=1
iplace=iplace+nckl
iplace1=iplace+nckl1
if(nzjpr(1).lt.gc1) then
do aa=2,nzjp
ilo=ilo+1
if(nzjpr(ilo).ge.gc1) exit
enddo
endif
if(nzjpr(ilo).lt.gc1.or.nzjpr(ilo).gt.gc2) then
dcore(iplace:iplace1)=0.d0
elseif(gc1.ne.gc2) then
iup=nzjp
if(nzjpr(nzjp).gt.gc2) then
do aa=2,nzjp
iup=iup-1
if(nzjpr(iup).le.gc2) exit
enddo
endif
! enddo
call jao_sub__(dcore(jbuff)
$,dcore(it3),nzjpr,nckl,nckl1,ilo,iup,
$gcj(1,jcontr),njprim,jp,ncklp,nclkj,niprim,jlength-it3)
dcore(iplace:iplace1)=dcore(jbuff:jbuff1)
endif
enddo
nzip=nzip+1
nzipr(nzip)=iprim
endif
enddo! iprim
c stop
! Multiply with contrcation coefficients for i
! it4(nc12,kcontr,jcontr,iprim) -> it5(nc12,kcontr,jcontr,icontr)