Dear Wien2k users,
Unfortunately there is a severe bug for DFT+U (or EECE) in WIEN2k_16.
It concerns all cases, where you have for your correlated atom(s) (eg.
Fe in Fe3O4)
MULT > 1
Calculations with MULT=1 (eg. the standard AFM-NiO case) are not
affected. Also calculations with spin-orbit coupling are not affected.
The error is in the new SRC_lapw2 code, which calculates in WIEN2k_16
the case.dmatup/dn files (instead of lapwdm in previous versions).
A corrected version of lapw2 is on the web and I include also the 3
corrected subroutines, which can be put into SRC_lapw2, replacing the
old versions. Recomile with make all; and copy the lapw2, lapw2c
(lapw2_mpi, lapw2c_mpi) files down (cp lapw2 ..), ...
Sorry for the inconvenience.
Peter Blaha
--
P.Blaha
--------------------------------------------------------------------------
Peter BLAHA, Inst.f. Materials Chemistry, TU Vienna, A-1060 Vienna
Phone: +43-1-58801-165300 FAX: +43-1-58801-165982
Email: bl...@theochem.tuwien.ac.at WIEN2k: http://www.wien2k.at
WWW: http://www.imc.tuwien.ac.at/TC_Blaha
--------------------------------------------------------------------------
SUBROUTINE P3SPLT (ALM,BLM,clm,MULT,UENORM,num,coord,dmat)
!
! DECOMPOSITION OF P CHARGE IN PX,PY,PZ
!
use param
USE charp
use lo
IMPLICIT REAL*8 (A-H,O-Z)
COMPLEX*16 ALM,BLM,clm,CSUMa,csumb,csumc
DIMENSION ALM((lmax2+1)*(lmax2+1)),BLM((lmax2+1)*(lmax2+1))
!old DIMENSION cLM((lmax2+1)*(lmax2+1))
DIMENSION cLM((LMAX2+1)*(LMAX2+1),NUME,nloat)
complex*16 dmat(2:4,2:4,nume)
CHARACTER*5 COORD
integer jlo,jlop,i,j
!---------------------------------------------------------------------
! new (and reversed) definitions for p-x and p-y (6.2.89, Blaha)
!
!old ipip=max(ilo(1),1)
SQRT2=SQRT(2.D0)
CSUMa=(ALM(4)-ALM(2))/SQRT2
CSUMb=(bLM(4)-bLM(2))/SQRT2
APX(num)=APX(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BPX(num)=BPX(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(1)
CSUMc=(cLM(4,num,jlo)-cLM(2,num,jlo))/SQRT2
do jlop=1,ilo(1)
cPX(num)=cPX(num)+((cLM(4,num,jlop)-cLM(2,num,jlop))/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
caPX(num)=caPX(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,1)*100.D0/MULT
acPX(num)=acPX(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,1)*100.D0/MULT
cbPX(num)=cbPX(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,1)*100.D0/MULT
bcPX(num)=bcPX(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,1)*100.D0/MULT
enddo
!
CSUMa=(ALM(4)+ALM(2))/SQRT2
CSUMb=(bLM(4)+bLM(2))/SQRT2
APy(num)=APy(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BPy(num)=BPy(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(1)
CSUMc=(cLM(4,num,jlo)+cLM(2,num,jlo))/SQRT2
do jlop=1,ilo(1)
cPy(num)=cPy(num)+((cLM(4,num,jlop)+cLM(2,num,jlop))/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
caPy(num)=caPy(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,1)*100.D0/MULT
acPy(num)=acPy(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,1)*100.D0/MULT
cbPy(num)=cbPy(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,1)*100.D0/MULT
bcPy(num)=bcPy(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,1)*100.D0/MULT
enddo
!
APZ(num)=APZ(num)+ALM(3)*CONJG(ALM(3))*100.D0/MULT
BPZ(num)=BPZ(num)+BLM(3)*CONJG(BLM(3))*UENORM*100.D0/MULT
do jlo=1,ilo(1)
do jlop=1,ilo(1)
cPZ(num)=cPZ(num)+cLM(3,num,jlop)*CONJG(cLM(3,num,jlo))*100.D0/MULT
enddo
caPz(num)=caPz(num)+Clm(3,num,jlo)*CONJG(alm(3))*pi12lo(jlo,1)*100.D0/MULT
acPz(num)=acPz(num)+alm(3)*CONJG(Clm(3,num,jlo))*pi12lo(jlo,1)*100.D0/MULT
cbPz(num)=cbPz(num)+Clm(3,num,jlo)*CONJG(blm(3))*pe12lo(jlo,1)*100.D0/MULT
bcPz(num)=bcPz(num)+blm(3)*CONJG(Clm(3,num,jlo))*pe12lo(jlo,1)*100.D0/MULT
enddo
do i=2,4
do j=2,4
dmat(i,j,num)=dmat(i,j,num) + (alm(j)*conjg(alm(i))+ &
blm(j)*conjg(blm(i))*uenorm)/mult
do jlo=1,ilo(1)
dmat(i,j,num)=dmat(i,j,num) + &
(alm(j)*conjg(clm(i,num,jlo))*pi12lo(jlo,1)+clm(j,num,jlo)*conjg(alm(i))*pi12lo(jlo,1)+ &
blm(j)*conjg(clm(i,num,jlo))*pe12lo(jlo,1)+clm(j,num,jlo)*conjg(blm(i))*pe12lo(jlo,1))/mult
do jlop=1,ilo(1)
dmat(i,j,num)=dmat(i,j,num) + (clm(j,num,jlop)*conjg(clm(i,num,jlo)))/mult
enddo
enddo
dmat(i,j,num)=dmat(i,j,num) ! /mult
enddo
enddo
RETURN
END
SUBROUTINE F7SPLT (ALM,BLM,clm,MULT,UENORM,num,coord,dmat)
!
! DECOMPOSITION OF F CHARGE
!
USE param
USE charf
use lo
IMPLICIT REAL*8 (A-H,O-Z)
COMPLEX*16 ALM,BLM,clm,CSUM
DIMENSION ALM((lmax2+1)*(lmax2+1)),bLM((lmax2+1)*(lmax2+1))
!old DIMENSION cLM((lmax2+1)*(lmax2+1))
DIMENSION cLM((LMAX2+1)*(LMAX2+1),NUME,nloat)
complex*16 dmat(10:16,10:16,nume)
CHARACTER*5 COORD
integer jlo,jlop
!---------------------------------------------------------------------
!
!old ipip=max(ilo(3),1)
SQRT2=SQRT(2.D0)
Af00(num)=Af00(num)+ALM(13)*CONJG(ALM(13))*100.D0/MULT
Bf00(num)=Bf00(num)+BLM(13)*CONJG(BLM(13))*UENORM*100.D0/MULT
!
CSUM=(ALM(14)+ALM(12))/SQRT2
Af11(num)=Af11(num)+CSUM*CONJG(CSUM)*100.D0/MULT
CSUM=(BLM(14)+BLM(12))/SQRT2
Bf11(num)=Bf11(num)+CSUM*CONJG(CSUM)*UENORM*100.D0/MULT
!
CSUM=(ALM(14)-ALM(12))/SQRT2
Af1m(num)=Af1m(num)+CSUM*CONJG(CSUM)*100.D0/MULT
CSUM=(BLM(14)-BLM(12))/SQRT2
Bf1m(num)=Bf1m(num)+CSUM*CONJG(CSUM)*UENORM*100.D0/MULT
!
CSUM=(ALM(15)-ALM(11))/SQRT2
Af2m(num)=Af2m(num)+CSUM*CONJG(CSUM)*100.D0/MULT
CSUM=(BLM(15)-BLM(11))/SQRT2
Bf2m(num)=Bf2m(num)+CSUM*CONJG(CSUM)*UENORM*100.D0/MULT
!
CSUM=(ALM(15)+ALM(11))/SQRT2
Af22(num)=Af22(num)+CSUM*CONJG(CSUM)*100.D0/MULT
CSUM=(BLM(15)+BLM(11))/SQRT2
Bf22(num)=Bf22(num)+CSUM*CONJG(CSUM)*UENORM*100.D0/MULT
!
CSUM=(ALM(16)-ALM(10))/SQRT2
Af3m(num)=Af3m(num)+CSUM*CONJG(CSUM)*100.D0/MULT
CSUM=(BLM(16)-BLM(10))/SQRT2
Bf3m(num)=Bf3m(num)+CSUM*CONJG(CSUM)*UENORM*100.D0/MULT
!
CSUM=(ALM(16)+ALM(10))/SQRT2
Af33(num)=Af33(num)+CSUM*CONJG(CSUM)*100.D0/MULT
CSUM=(BLM(16)+BLM(10))/SQRT2
Bf33(num)=Bf33(num)+CSUM*CONJG(CSUM)*UENORM*100.D0/MULT
do i=10,16
do j=10,16
dmat(i,j,num)=dmat(i,j,num) + (alm(j)*conjg(alm(i))+ &
blm(j)*conjg(blm(i))*uenorm)/mult
do jlo=1,ilo(3)
dmat(i,j,num)=dmat(i,j,num) + &
(alm(j)*conjg(clm(i,num,jlo))*pi12lo(jlo,3)+clm(j,num,jlo)*conjg(alm(i))*pi12lo(jlo,3)+ &
blm(j)*conjg(clm(i,num,jlo))*pe12lo(jlo,3)+clm(j,num,jlo)*conjg(blm(i))*pe12lo(jlo,3))/mult
do jlop=1,ilo(3)
dmat(i,j,num)=dmat(i,j,num)+(clm(j,num,jlop)*conjg(clm(i,num,jlo)))/mult
enddo
enddo
dmat(i,j,num)=dmat(i,j,num) !/mult
enddo
enddo
RETURN
END
SUBROUTINE D5SPLT (ALM,BLM,clm,MULT,UENORM,num,coord,jatom,dmat) !,mu)
!
! DECOMPOSITION OF D CHARGE IN DZ2,DX2-Y2,DXY,DXZ,DYZ
! new (and reversed) definitions for dxz, dyz (6.2.89., Blaha)
!
use param
USE chard
use lo
IMPLICIT REAL*8 (A-H,O-Z)
COMPLEX*16 ALM,BLM,clm,CSUMa,csumb,csumc
DIMENSION ALM((lmax2+1)*(lmax2+1)),BLM((lmax2+1)*(lmax2+1))
!old DIMENSION cLM((lmax2+1)*(lmax2+1))
DIMENSION cLM((LMAX2+1)*(LMAX2+1),NUME,nloat)
complex*16 dmat(5:9,5:9,nume)
! complex*16 dmat(48,5:9,5:9,nume)
CHARACTER*5 COORD
integer jlo,jlop
!---------------------------------------------------------------------
!
!old ipip=max(ilo(2),1)
SQRT2=SQRT(2.D0)
SQRT3=SQRT(3.D0)
IF (COORD.EQ.'OCTAH') THEN
!
! non standard dsplit
! classical octahedral coordinates
!
IF (JATOM.EQ.1) THEN
! ===========================
! 1. METALLATOM
!
!
CSUMa=( SQRT3*(ALM(9)+ALM(5))/SQRT2 - ALM(7) )*0.5
CSUMb=( SQRT3*(bLM(9)+bLM(5))/SQRT2 - bLM(7) )*0.5
ADz2(num)=ADz2(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDz2(num)=BDz2(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=( SQRT3*(cLM(9,num,jlo)+cLM(5,num,jlo))/SQRT2 - cLM(7,num,jlo) )*0.5
do jlop=1,ilo(2)
cdz2(num)=cdz2(num)+(( SQRT3*(cLM(9,num,jlop)+cLM(5,num,jlop))/SQRT2 - cLM(7,num,jlop) )*0.5)*CONJG(CSUMc)*100.D0/MULT
enddo
cadz2(num)=cadz2(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdz2(num)=acdz2(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdz2(num)=cbdz2(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdz2(num)=bcdz2(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(-1)*(ALM(8)+ALM(6))/SQRT2
CSUMb=(-1)*(BLM(8)+BLM(6))/SQRT2
ADX2Y2(num)=ADX2Y2(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDX2Y2(num)=BDX2Y2(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(-1)*(cLM(8,num,jlo)+cLM(6,num,jlo))/SQRT2
do jlop=1,ilo(2)
cdx2y2(num)=cdx2y2(num)+((-1)*(cLM(8,num,jlop)+cLM(6,num,jlop))/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadx2y2(num)=cadx2y2(num)+ &
CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdx2y2(num)=acdx2y2(num)+ &
CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdx2y2(num)=cbdx2y2(num)+ &
CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdx2y2(num)=bcdx2y2(num)+ &
CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=( (ALM(9)+ALM(5))/SQRT2 + SQRT3*ALM(7) )*0.5
CSUMb=( (BLM(9)+BLM(5))/SQRT2 + SQRT3*BLM(7) )*0.5
ADXY(num)=ADXY(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDXY(num)=BDXY(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=( (cLM(9,num,jlo)+cLM(5,num,jlo))/SQRT2 + SQRT3*cLM(7,num,jlo) )*0.5
do jlop=1,ilo(2)
cdxy(num)=cdxy(num)+(( (cLM(9,num,jlop)+cLM(5,num,jlop))/SQRT2 + SQRT3*cLM(7,num,jlop) )*0.5)*CONJG(CSUMc)*100.D0/MULT
enddo
cadxy(num)=cadxy(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdxy(num)=acdxy(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdxy(num)=cbdxy(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdxy(num)=bcdxy(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=((ALM(9)-ALM(5))/SQRT2-(ALM(8)-ALM(6))/SQRT2)/SQRT2
CSUMb=((BLM(9)-BLM(5))/SQRT2-(BLM(8)-BLM(6))/SQRT2)/SQRT2
ADXz(num)=ADXz(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDXz(num)=BDXz(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=((cLM(9,num,jlo)-cLM(5,num,jlo))/SQRT2-(cLM(8,num,jlo)-cLM(6,num,jlo))/SQRT2)/SQRT2
do jlop=1,ilo(2)
cdxz(num)=cdxz(num)+(((cLM(9,num,jlop)-cLM(5,num,jlop))/SQRT2-(cLM(8,num,jlop) - &
cLM(6,num,jlop))/SQRT2)/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadxz(num)=cadxz(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdxz(num)=acdxz(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdxz(num)=cbdxz(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdxz(num)=bcdxz(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=((-1.)*(ALM(9)-ALM(5))/SQRT2-(ALM(8)-ALM(6))/SQRT2)/SQRT2
CSUMb=((-1.)*(BLM(9)-BLM(5))/SQRT2-(BLM(8)-BLM(6))/SQRT2)/SQRT2
ADYz(num)=ADYz(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDYz(num)=BDYz(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=((-1.)*(cLM(9,num,jlo)-cLM(5,num,jlo))/SQRT2-(cLM(8,num,jlo)-cLM(6,num,jlo))/SQRT2)/SQRT2
do jlop=1,ilo(2)
cdyz(num)=cdyz(num)+(((-1.)*(cLM(9,num,jlop)-cLM(5,num,jlop))/SQRT2-(cLM(8,num,jlop) - &
cLM(6,num,jlop))/SQRT2)/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadyz(num)=cadyz(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdyz(num)=acdyz(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdyz(num)=cbdyz(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdyz(num)=bcdyz(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
ELSE
! ===========================
! 2.METALLATOM
!
CSUMa=(-SQRT3*(ALM(9)+ALM(5))/SQRT2-ALM(7) )*0.5
CSUMb=(-SQRT3*(BLM(9)+BLM(5))/SQRT2-BLM(7) )*0.5
ADz2(num)=ADz2(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDz2(num)=BDz2(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(-SQRT3*(cLM(9,num,jlo)+cLM(5,num,jlo))/SQRT2-cLM(7,num,jlo) )*0.5
do jlop=1,ilo(2)
cdz2(num)=cdz2(num)+((-SQRT3*(cLM(9,num,jlop)+cLM(5,num,jlop))/SQRT2-cLM(7,num,jlop) )*0.5)*CONJG(CSUMc)*100.D0/MULT
enddo
cadz2(num)=cadz2(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdz2(num)=acdz2(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdz2(num)=cbdz2(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdz2(num)=bcdz2(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(-1.)*(ALM(8)-ALM(6))/SQRT2
CSUMb=(-1.)*(BLM(8)-BLM(6))/SQRT2
ADX2Y2(num)=ADX2Y2(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDX2Y2(num)=BDX2Y2(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(-1.)*(cLM(8,num,jlo)-cLM(6,num,jlo))/SQRT2
do jlop=1,ilo(2)
cdx2y2(num)=cdx2y2(num)+((-1.)*(cLM(8,num,jlop)-cLM(6,num,jlop))/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadx2y2(num)=cadx2y2(num)+ &
CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdx2y2(num)=acdx2y2(num)+ &
CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdx2y2(num)=cbdx2y2(num)+ &
CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdx2y2(num)=bcdx2y2(num)+ &
CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=( (-1.)*(ALM(9)+ALM(5))/SQRT2 + SQRT3*ALM(7) )*0.5
CSUMb=( (-1.)*(BLM(9)+BLM(5))/SQRT2 + SQRT3*BLM(7) )*0.5
ADXY(num)=ADXY(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDXY(num)=BDXY(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=( (-1.)*(cLM(9,num,jlo)+cLM(5,num,jlo))/SQRT2 + SQRT3*cLM(7,num,jlo) )*0.5
do jlop=1,ilo(2)
cdxy(num)=cdxy(num)+(( (-1.)*(cLM(9,num,jlop)+cLM(5,num,jlop))/SQRT2 + &
SQRT3*cLM(7,num,jlop) )*0.5)*CONJG(CSUMc)*100.D0/MULT
enddo
cadxy(num)=cadxy(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdxy(num)=acdxy(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdxy(num)=cbdxy(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdxy(num)=bcdxy(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=((ALM(9)-ALM(5))/SQRT2-(ALM(8)+ALM(6))/SQRT2 )/SQRT2
CSUMb=((BLM(9)-BLM(5))/SQRT2-(BLM(8)+BLM(6))/SQRT2 )/SQRT2
ADXz(num)=ADXz(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDXz(num)=BDXz(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=((cLM(9,num,jlo)-cLM(5,num,jlo))/SQRT2-(cLM(8,num,jlo)+cLM(6,num,jlo))/SQRT2 )/SQRT2
do jlop=1,ilo(2)
cdxz(num)=cdxz(num)+(((cLM(9,num,jlop)-cLM(5,num,jlop))/SQRT2-(cLM(8,num,jlop) + &
cLM(6,num,jlop))/SQRT2 )/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadxz(num)=cadxz(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdxz(num)=acdxz(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdxz(num)=cbdxz(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdxz(num)=bcdxz(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=((-1.)*(ALM(9)-ALM(5))/SQRT2-(ALM(8)+ALM(6))/SQRT2)/SQRT2
CSUMb=((-1.)*(BLM(9)-BLM(5))/SQRT2-(BLM(8)+BLM(6))/SQRT2)/SQRT2
ADYz(num)=ADYz(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDYz(num)=BDYz(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=((-1.)*(cLM(9,num,jlo)-cLM(5,num,jlo))/SQRT2-(cLM(8,num,jlo)+cLM(6,num,jlo))/SQRT2)/SQRT2
do jlop=1,ilo(2)
cdyz(num)=cdyz(num)+(((-1.)*(cLM(9,num,jlop)-cLM(5,num,jlop))/SQRT2-(cLM(8,num,jlop) + &
cLM(6,num,jlop))/SQRT2)/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadyz(num)=cadyz(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdyz(num)=acdyz(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdyz(num)=cbdyz(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdyz(num)=bcdyz(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
END IF
!
ELSE if (COORD.EQ.'TRIGO') THEN
!
CSUMa=(1/SQRT3)*((ALM(8)-ALM(6))+(ALM(9)+ALM(5))/SQRT2)
CSUMb=(1/SQRT3)*((bLM(8)-bLM(6))+(bLM(9)+bLM(5))/SQRT2)
ADz2(num)=ADz2(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDz2(num)=BDz2(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(1/SQRT3)*((cLM(8,num,jlo)-cLM(6,num,jlo))+(cLM(9,num,jlo)+cLM(5,num,jlo))/SQRT2)
do jlop=1,ilo(2)
cdz2(num)=cdz2(num)+((1/SQRT3)*((cLM(8,num,jlop)-cLM(6,num,jlop))+(cLM(9,num,jlop) + &
cLM(5,num,jlop))/SQRT2))*CONJG(CSUMc)*100.D0/MULT
enddo
cadz2(num)=cadz2(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdz2(num)=acdz2(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdz2(num)=cbdz2(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdz2(num)=bcdz2(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(1/SQRT3)*((aLM(8)+aLM(6))-(aLM(9)-aLM(5))/SQRT2)
CSUMb=(1/SQRT3)*((bLM(8)+bLM(6))-(bLM(9)-bLM(5))/SQRT2)
ADX2Y2(num)=ADX2Y2(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDX2Y2(num)=BDX2Y2(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(1/SQRT3)*((cLM(8,num,jlo)+cLM(6,num,jlo))-(cLM(9,num,jlo)-cLM(5,num,jlo))/SQRT2)
do jlop=1,ilo(2)
cdx2y2(num)=cdx2y2(num)+((1/SQRT3)*((cLM(8,num,jlop)+cLM(6,num,jlop))-(cLM(9,num,jlop)- &
cLM(5,num,jlop))/SQRT2))*CONJG(CSUMc)*100.D0/MULT
enddo
cadx2y2(num)=cadx2y2(num)+ &
CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdx2y2(num)=acdx2y2(num)+ &
CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdx2y2(num)=cbdx2y2(num)+ &
CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdx2y2(num)=bcdx2y2(num)+ &
CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=ALM(7)
CSUMb=BLM(7)
ADXY(num)=ADXY(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDXY(num)=BDXY(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=cLM(7,num,jlo)
do jlop=1,ilo(2)
cdxy(num)=cdxy(num)+(cLM(7,num,jlop))*CONJG(CSUMc)*100.D0/MULT
enddo
cadxy(num)=cadxy(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdxy(num)=acdxy(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdxy(num)=cbdxy(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdxy(num)=bcdxy(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(1/SQRT3)*((ALM(8)+ALM(6))/SQRT2+(ALM(9)-ALM(5)))
CSUMb=(1/SQRT3)*((bLM(8)+bLM(6))/SQRT2+(bLM(9)-bLM(5)))
ADXz(num)=ADXz(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDXz(num)=BDXz(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(1/SQRT3)*((cLM(8,num,jlo)+cLM(6,num,jlo))/SQRT2+(cLM(9,num,jlo)-cLM(5,num,jlo)))
do jlop=1,ilo(2)
cdxz(num)=cdxz(num)+((1/SQRT3)*((cLM(8,num,jlop)+cLM(6,num,jlop))/SQRT2+(cLM(9,num,jlop)- &
cLM(5,num,jlop))))*CONJG(CSUMc)*100.D0/MULT
enddo
cadxz(num)=cadxz(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdxz(num)=acdxz(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdxz(num)=cbdxz(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdxz(num)=bcdxz(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(1/SQRT3)*((ALM(8)-ALM(6))/SQRT2-(ALM(9)+ALM(5)))
CSUMb=(1/SQRT3)*((bLM(8)-bLM(6))/SQRT2-(bLM(9)+bLM(5)))
ADYz(num)=ADYz(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDYz(num)=BDYz(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(1/SQRT3)*((cLM(8,num,jlo)-cLM(6,num,jlo))/SQRT2-(cLM(9,num,jlo)+cLM(5,num,jlo)))
do jlop=1,ilo(2)
cdyz(num)=cdyz(num)+((1/SQRT3)*((cLM(8,num,jlop)-cLM(6,num,jlop))/SQRT2-(cLM(9,num,jlop)+ &
cLM(5,num,jlop))))*CONJG(CSUMc)*100.D0/MULT
enddo
cadyz(num)=cadyz(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdyz(num)=acdyz(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdyz(num)=cbdyz(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdyz(num)=bcdyz(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
ELSE
!
! standard-split
!
!if(num.eq.1) print*,num,ADZ2(num)
!if(num.eq.2) print*,num,ADZ2(num)
!if(num.eq.161) print*,num,ADZ2(num)
ADZ2(num)=ADZ2(num)+ALM(7)*CONJG(ALM(7))*100.D0/MULT
BDZ2(num)=BDZ2(num)+BLM(7)*CONJG(BLM(7))*UENORM*100.D0/MULT
do jlo=1,ilo(2)
do jlop=1,ilo(2)
cdz2(num)=cdz2(num)+cLM(7,num,jlop)*CONJG(cLM(7,num,jlo))*100.D0/MULT
enddo
cadz2(num)=cadz2(num)+Clm(7,num,jlo)*CONJG(alm(7))*pi12lo(jlo,2)*100.D0/MULT
acdz2(num)=acdz2(num)+alm(7)*CONJG(Clm(7,num,jlo))*pi12lo(jlo,2)*100.D0/MULT
cbdz2(num)=cbdz2(num)+Clm(7,num,jlo)*CONJG(blm(7))*pe12lo(jlo,2)*100.D0/MULT
bcdz2(num)=bcdz2(num)+blm(7)*CONJG(Clm(7,num,jlo))*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(ALM(9)+ALM(5))/SQRT2
CSUMb=(BLM(9)+BLM(5))/SQRT2
ADX2Y2(num)=ADX2Y2(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDX2Y2(num)=BDX2Y2(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(cLM(9,num,jlo)+cLM(5,num,jlo))/SQRT2
do jlop=1,ilo(2)
cdx2y2(num)=cdx2y2(num)+((cLM(9,num,jlop)+cLM(5,num,jlop))/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadx2y2(num)=cadx2y2(num)+ &
CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdx2y2(num)=acdx2y2(num)+ &
CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdx2y2(num)=cbdx2y2(num)+ &
CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdx2y2(num)=bcdx2y2(num)+ &
CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(ALM(9)-ALM(5))/SQRT2
CSUMb=(BLM(9)-BLM(5))/SQRT2
ADXY(num)=ADXY(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDXY(num)=BDXY(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(cLM(9,num,jlo)-cLM(5,num,jlo))/SQRT2
do jlop=1,ilo(2)
cdxy(num)=cdxy(num)+((cLM(9,num,jlop)-cLM(5,num,jlop))/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadxy(num)=cadxy(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdxy(num)=acdxy(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdxy(num)=cbdxy(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdxy(num)=bcdxy(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(ALM(8)-ALM(6))/SQRT2
CSUMb=(BLM(8)-BLM(6))/SQRT2
ADXz(num)=ADXz(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDXz(num)=BDXz(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(cLM(8,num,jlo)-cLM(6,num,jlo))/SQRT2
do jlop=1,ilo(2)
cdxz(num)=cdxz(num)+((cLM(8,num,jlop)-cLM(6,num,jlop))/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadxz(num)=cadxz(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdxz(num)=acdxz(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdxz(num)=cbdxz(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdxz(num)=bcdxz(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!
CSUMa=(ALM(8)+ALM(6))/SQRT2
CSUMb=(BLM(8)+BLM(6))/SQRT2
ADYz(num)=ADYz(num)+CSUMa*CONJG(CSUMa)*100.D0/MULT
BDYz(num)=BDYz(num)+CSUMb*CONJG(CSUMb)*UENORM*100.D0/MULT
do jlo=1,ilo(2)
CSUMc=(cLM(8,num,jlo)+cLM(6,num,jlo))/SQRT2
do jlop=1,ilo(2)
cdyz(num)=cdyz(num)+((cLM(8,num,jlop)+cLM(6,num,jlop))/SQRT2)*CONJG(CSUMc)*100.D0/MULT
enddo
cadyz(num)=cadyz(num)+CSUMc*CONJG(CSUMa)*pi12lo(jlo,2)*100.D0/MULT
acdyz(num)=acdyz(num)+CSUMa*CONJG(CSUMc)*pi12lo(jlo,2)*100.D0/MULT
cbdyz(num)=cbdyz(num)+CSUMc*CONJG(CSUMb)*pe12lo(jlo,2)*100.D0/MULT
bcdyz(num)=bcdyz(num)+CSUMb*CONJG(CSUMc)*pe12lo(jlo,2)*100.D0/MULT
enddo
!print*,num,ADZ2(num)+BDZ2(num)+cdz2(num)+cadz2(num)+acdz2(num)+cbdz2(num)+bcdz2(num),real(dmat(7,7,num))*100.d0,mult,' before'
do i=5,9
do j=5,9
dmat(i,j,num)=dmat(i,j,num) + (alm(j)*conjg(alm(i)) + blm(j)*conjg(blm(i))*uenorm)/mult
do jlo=1,ilo(2)
dmat(i,j,num)=dmat(i,j,num) + &
(alm(j)*conjg(clm(i,num,jlo))*pi12lo(jlo,2)+clm(j,num,jlo)*conjg(alm(i))*pi12lo(jlo,2)+ &
blm(j)*conjg(clm(i,num,jlo))*pe12lo(jlo,2)+clm(j,num,jlo)*conjg(blm(i))*pe12lo(jlo,2))/mult
do jlop=1,ilo(2)
dmat(i,j,num)=dmat(i,j,num) + (clm(j,num,jlop)*conjg(clm(i,num,jlo)))/mult
enddo
dmat(i,j,num)=dmat(i,j,num) ! /mult
!if(num.gt.40) then
!write(6,200) mu,num,i,j,dconjg(alm(i)),alm(j)
! 200 format('mu=',i1,' num=',i3,' m=',i1,' mp=',i1,2f10.4,3x,2f10.4,3x,f10.4)
!endif
enddo
enddo
enddo
!if(num.eq.1) print*,num,ADZ2(num)+BDZ2(num)+cdz2(num)+cadz2(num)+acdz2(num)+cbdz2(num)+bcdz2(num),real(dmat(7,7,num))*100.d0,mult
!if(num.eq.2) print*,num,ADZ2(num)+BDZ2(num)+cdz2(num)+cadz2(num)+acdz2(num)+cbdz2(num)+bcdz2(num),real(dmat(7,7,num))*100.d0
!if(num.eq.161) print*,num,ADZ2(num)+BDZ2(num)+cdz2(num)+cadz2(num)+acdz2(num)+cbdz2(num)+bcdz2(num),real(dmat(7,7,num))*100.d0
endif
RETURN
END SUBROUTINE D5SPLT
_______________________________________________
Wien mailing list
Wien@zeus.theochem.tuwien.ac.at
http://zeus.theochem.tuwien.ac.at/mailman/listinfo/wien
SEARCH the MAILING-LIST at:
http://www.mail-archive.com/wien@zeus.theochem.tuwien.ac.at/index.html
