mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-18 20:50:49 +01:00
102 lines
3.1 KiB
Fortran
102 lines
3.1 KiB
Fortran
! Multiply with contrcation coefficients for j
|
|
! it3(nc12,kcontr,jprim) ->it4(nc12,kcontr,jcontr,iprim)
|
|
! Skip uncontracted ERIs (already in jlength)
|
|
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
|
|
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)
|
|
! Skip uncontracted ERIs (already in it4)
|
|
if(nzip.gt.0) then
|
|
do icontr=1,nicontr
|
|
itd=0
|
|
scr=scr+scrc(1)
|
|
gc1=gcni(1,icontr)
|
|
gc2=gcni(2,icontr)
|
|
ilo=1
|
|
if(nzipr(1).lt.gc1) then
|
|
do aa=2,nzip
|
|
ilo=ilo+1
|
|
if(nzipr(ilo).ge.gc1) exit
|
|
enddo
|
|
endif
|
|
if(gc1.ne.gc2) then ! contracted
|
|
if(.not.(nzipr(ilo).lt.gc1.or.nzipr(ilo).gt.gc2)) then
|
|
iup=nzip
|
|
if(nzipr(nzip).gt.gc2) then
|
|
do aa=2,nzip
|
|
iup=iup-1
|
|
if(nzipr(iup).le.gc2) exit
|
|
enddo
|
|
endif
|
|
call iao_sub(dcore(ibuff),dcore(it4),nzipr,nclkj,
|
|
$ nclkj1,ilo,iup,gci(1,icontr),niprim)
|
|
itd=ibuff
|
|
endif
|
|
elseif(.not.(nzipr(ilo).lt.gc1.or.nzipr(ilo).gt.gc2)) then
|
|
itd=it4+(gc1-1)*nclkj
|
|
endif
|
|
if(itd.ne.0) then
|
|
aa=0
|
|
if(lrearr) then
|
|
do jcontr=1,njcontr
|
|
scr=scr+scrc(2)
|
|
do kcontr=1,nkcontr
|
|
scr=scr+scrc(3)
|
|
call rearr(dcore(irearr),dcore(itd+aa))
|
|
call derspher(dfscr,dcore(irearr),scr,scrn,scrn0)
|
|
aa=aa+nc12
|
|
enddo! kcontr
|
|
scr=scr-scrc0(3)
|
|
enddo! jcontr
|
|
scr=scr-scrc0(2)
|
|
else
|
|
do jcontr=1,njcontr
|
|
scr=scr+scrc(2)
|
|
do kcontr=1,nkcontr
|
|
scr=scr+scrc(3)
|
|
call derspher(dfscr,dcore(itd+aa),scr,scrn,scrn0)
|
|
aa=aa+nc12
|
|
enddo! kcontr
|
|
scr=scr-scrc0(3)
|
|
enddo! jcontr
|
|
scr=scr-scrc0(2)
|
|
endif
|
|
endif
|
|
enddo ! icontr
|
|
endif ! nzip
|
|
|
|
return
|
|
end
|