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

62 lines
2.1 KiB
Fortran
Executable File

enddo! kprim
! Contraction of the integrals into the contracted basis starts here
! Multiply with contrcation coefficients for k
! it2(nc12,kprim) -> it3(nc12,kcontr,jprim)
jplace=ncklj-nc12
do kcontr=1,nkcontr
gc1=gcnk(1,kcontr)
gc2=gcnk(2,kcontr)
jplace=jplace+nc12
jplace1=jplace+nc121
if(gc1.ne.gc2) then
call kao_sub__(dcore(kbuff),dcore(it2),nc12,nc121,gc1,gc2,
$gck(1,kcontr),nkprim,kp,nc12p,nckl,njprim,ncklj-it2,jlength-it2,
$jprim,jp)
dcore(jplace:jplace1)=dcore(kbuff:kbuff1)
endif
enddo
nzjp=nzjp+1
nzjpr(nzjp)=jprim
endif! Primitive prescreening
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
! Multiply with contrcation coefficients for i
! it4(nc12,kcontr,jcontr,iprim) -> it5(nc12,kcontr,jcontr,icontr)
if(nzip.gt.0) then