if(ipieda.ne.0) then
c
edimdi=edimij1-edimij1u
if(.not.(gcorrel.or.dodc)) edimdi=zero
edimct=detot-edimes-edimex-edimdi
if(dopleda.and.memon1.ne.3) then
epl0ij=epl0ds(ifg,1)+epl0ds(ifg,2)+
* epl0ds(jfg,1)+epl0ds(jfg,2)
edimct=edimct-epl0ij
c In PL0 runs polarisation is double counted.
else
epl0ij=zero
endif
edimij1b=edimij1
if(n0bda.ne.0) then
e0bda(1,i0bda,1)=edimes
e0bda(2,i0bda,1)=edimex
e0bda(3,i0bda,1)=edimct
e0bda(4,i0bda,1)=edimdi
else if(nbdfg.ne.0) then
ebdaes=ebdaes+edimes
ebdaex=ebdaex+edimex
ebdact=ebdact+edimct
ebdadi=ebdadi+edimdi
call bdasub(ifg,jfg,gcorrel.or.dodc,edimij1b,detot,
* detotu,edimes,edimex,edimct,edimdi,e0mon,
* e0monu,indat,iabdfg,jabdfg,e0bda(1,1,ijlay),
* ires)
ebdaes=ebdaes-edimes
ebdaex=ebdaex-edimex
ebdact=ebdact-edimct
ebdadi=ebdadi-edimdi
if(ires.eq.0) then
eesbda=eesbda+edimes
eexbda=eexbda+edimex
ectbda=ectbda+edimct
edibda=edibda+edimdi
endif
endif
ees=ees+edimes
eex=eex+edimex
ect=ect+edimct
edi=edi+edimdi
if(dopleda) then
write(iw,9132) ifg,jfg,corri,ijlay,ijcharge,rij,ctij,
* edimij1b*tokcal,edimij2*tokcal,
* detot*tokcal,epl0ij*tokcal,
* edimes*tokcal,edimex*tokcal,edimct*tokcal
* ,edimdi*tokcal
else
write(iw,9134) ifg,jfg,corri,ijlay,ijcharge,rij,ctij,
* edimij1b*tokcal,edimij2*tokcal,
* detot*tokcal+esolvij,edimes*tokcal,
* edimex*tokcal,edimct*tokcal,
* edimdi*tokcal,esolvij
c write(6,*) 'epsIJ',ifg,jfg,detot*tokcal/
c * (detot*tokcal+esolvij),edimes*tokcal
endif
else
if(prtdst(4).eq.0.or.abs(detot)*tokcal.gt.prtdst(4)) then
if(dolat) then
if(.not.(gcorrel.or.dodc)) then
write(iw,9161) ifg,jfg,iu,nsymeq(iu),corri,ijlay,
* ijcharge,rij,ctij,edim(ijfg,1),edimij1,
* edimij2,detot*tokcal
else
write(iw,9163) ifg,jfg,iu,nsymeq(iu),corri,ijlay,
* ijcharge,rij,ctij,edim(ijfg,1),
* edim(ijfg,3),edimij1,edimij1u,
* edimij2,detot*tokcal
endif
else
if(.not.(gcorrel.or.dodc)) then
write(iw,9131) ifg,jfg,corri,ijlay,ijcharge,rij,ctij,
* edim(ijfg,1),edimij1,edimij2,
* esolvij,detot*tokcal+esolvij
c * edim(ijfg,1),edimij1,edimij2,edimijq,
else
write(iw,9133) ifg,jfg,corri,ijlay,ijcharge,rij,ctij,
* edim(ijfg,1),edim(ijfg,3),edimij1,
* edimij1u,edimij2,esolvij,
* detot*tokcal+esolvij
c * edimij1u,edimij2,edimijq,detot*tokcal
endif
endif
endif
endif
debsseij=zero
Robot Devil: Punishing you since 2275
