2024-07-25 10:27:17 +02:00

91 lines
2.8 KiB
Fortran
Executable File

endif! Primitive prescreening
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)
if(nzkp.gt.0) then
jplace=jlength-nc12
do kcontr=1,nkcontr
gc1=gcnk(1,kcontr)
gc2=gcnk(2,kcontr)
ilo=1
jplace=jplace+nc12
jplace1=jplace+nc121
if(nzkpr(1).lt.gc1) then
do aa=2,nzkp
ilo=ilo+1
if(nzkpr(ilo).ge.gc1) exit
enddo
endif
if(nzkpr(ilo).lt.gc1.or.nzkpr(ilo).gt.gc2) then
dcore(jplace:jplace1)=0.d0
else
iup=nzkp
if(nzkpr(nzkp).gt.gc2) then
do aa=2,nzkp
iup=iup-1
if(nzkpr(iup).le.gc2) exit
enddo
endif
ii=it2+nc12*(nzkpr(ilo)-1)
dkc=
$dcore(ii:ii+nc121)*gcoefk(nzkpr(ilo),kcontr)
do kpr=ilo+1,iup
ii=it2+nc12*(nzkpr(kpr)-1)
dkc=
$ dkc+
$dcore(ii:ii+nc121)*gcoefk(nzkpr(kpr),kcontr)
enddo
dcore(jplace:jplace1)=dkc
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
ijcr=it5-nckl
do icontr=1,nicontr
gc1=gcni(1,icontr)
gc2=gcni(2,icontr)
ilo=1
ijcr=ijcr+nckl
ijcr1=ijcr+nckl1
if(nzipr(1).lt.gc1) then
do aa=2,nzip
ilo=ilo+1
if(nzipr(ilo).ge.gc1) exit
enddo
endif
if(nzipr(ilo).lt.gc1.or.nzipr(ilo).gt.gc2) then
dcore(ijcr:ijcr1)=0.d0
else
iup=nzip
if(nzipr(nzip).gt.gc2) then
do aa=2,nzip
iup=iup-1
if(nzipr(iup).le.gc2) exit
enddo
endif
ii=it4+nckl*(nzipr(ilo)-1)
dic=
$dcore(ii:ii+nckl1)*gcoefi(nzipr(ilo),icontr)
do ipr=ilo+1,iup
ii=it4+nckl*(nzipr(ipr)-1)
dic=
$ dic+
$dcore(ii:ii+nckl1)*gcoefi(nzipr(ipr),icontr)
enddo
dcore(ijcr:ijcr1)=dic
endif
enddo
! Contraction of the integrals into the contracted basis ends here
endif! nzip.gt.0
imem=it5
return
end