Commit 8586f3fe authored by P.Buhl's avatar P.Buhl

get updown working with updated wann_mmk0_updown_sph file from frank and...

get updown working with updated wann_mmk0_updown_sph file from frank and avoiding some double allocations
parent dbee6795
......@@ -53,14 +53,18 @@ c************************************************************
complex :: suma,sumb,sumc,sumd
complex :: suma12(2,2),sumb12(2,2)
complex :: sumc12(2,2),sumd12(2,2)
real, allocatable :: qlo(:,:,:,:,:)
real, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
complex, allocatable :: qlo(:,:,:,:,:)
complex, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
complex, allocatable :: qcloa(:,:,:,:),qclob(:,:,:,:)
COMPLEX :: ccchi(2,2),ci
ci = cmplx(0.0,1.0)
allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd),
+ qaclo(noccbd,noccbd,nlod,ntypd),
+ qbclo(noccbd,noccbd,nlod,ntypd) )
+ qbclo(noccbd,noccbd,nlod,ntypd),
+ qcloa(noccbd,noccbd,nlod,ntypd),
+ qclob(noccbd,noccbd,nlod,ntypd))
c---> performs summations of the overlaps of the wavefunctions
do i = 1,noccbd
do j = 1,noccbd
......@@ -152,6 +156,9 @@ c---> initialize qlo arrays
qlo(:,:,:,:,:) = 0.0
qaclo(:,:,:,:) = 0.0
qbclo(:,:,:,:) = 0.0
qcloa(:,:,:,:) = 0.0
qclob(:,:,:,:) = 0.0
c---> prepare the coefficients
natom = 0
do ntyp = 1,ntype
......@@ -162,14 +169,21 @@ c---> prepare the coefficients
ll1 = l* (l+1)
do m = -l,l
lm = ll1 + m
do i = 1,noccbd
do j = 1,noccbd
qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) + real(
+ bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) +
+ ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2)) )
qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) + real(
+ acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) +
+ ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2)) )
do j = 1,noccbd
do i = 1,noccbd
qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) +
+ bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))
c + +ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2))
qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) +
+ acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))
c + +ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2))
qclob(i,j,lo,ntyp) = qclob(i,j,lo,ntyp)
c + bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))
+ +ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2))
qcloa(i,j,lo,ntyp) = qcloa(i,j,lo,ntyp)
c + acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))+
+ +ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2))
enddo
enddo
enddo
......@@ -178,9 +192,9 @@ c---> prepare the coefficients
do m = -l,l
do i = 1,noccbd
do j = 1,noccbd
qlo(i,j,lop,lo,ntyp) = qlo(i,j,lop,lo,ntyp) +
+ real(conjg(ccof(m,j,lop,natom,2))
* *ccof(m,i,lo,natom,1))
qlo(i,j,lo,lop,ntyp) = qlo(i,j,lo,lop,ntyp) +
+ conjg(ccof(m,j,lop,natom,2))
* *ccof(m,i,lo,natom,1)
enddo
enddo
enddo
......@@ -193,28 +207,33 @@ c---> perform summation of the coefficients with the integrals
c---> of the radial basis functions
do ntyp = 1,ntype
do lo = 1,nlo(ntyp)
stop 'not yet finished'
l = llo(lo,ntyp)
do i = 1,noccbd
do j = 1,noccbd
do j = 1,noccbd
do i = 1,noccbd
mmn(i,j)= mmn(i,j) +
+ ( qaclo(i,j,lo,ntyp)*uulon(lo,ntyp,2) +
+ qbclo(i,j,lo,ntyp)*dulon(lo,ntyp,2) )
+ qaclo(i,j,lo,ntyp)*radial1_flo(1,2,l,lo,ntyp)
+ +
+ qbclo(i,j,lo,ntyp)*radial1_glo(1,2,l,lo,ntyp)
+ +
+ qcloa(i,j,lo,ntyp)*radial1_lof(1,2,lo,l,ntyp)
+ +
+ qclob(i,j,lo,ntyp)*radial1_log(1,2,lo,l,ntyp)
enddo
enddo
do lop = 1,nlo(ntyp)
if (llo(lop,ntyp).eq.l) then
do i = 1,noccbd
do j = 1,noccbd
do j = 1,noccbd
do i = 1,noccbd
mmn(i,j) = mmn(i,j) +
+ qlo(i,j,lop,lo,ntyp)*uloulopn(lop,lo,ntyp,2)
+ qlo(i,j,lop,lo,ntyp)*radial1_lolo(1,2,lop,lo,ntyp)
enddo
enddo
endif
enddo
enddo
enddo
deallocate ( qlo,qaclo,qbclo )
deallocate ( qlo,qaclo,qbclo,qcloa,qclob )
END SUBROUTINE wann_mmk0_updown_sph
END MODULE m_wann_mmk0_updown_sph
......@@ -717,10 +717,12 @@ c****************************************************************
zzMat(jspin)%nbasfcn = nbasfcn
zzMat(jspin)%nbands = neigd
IF(l_real) THEN
ALLOCATE (zzMat(jspin)%z_r(zzMat(jspin)%nbasfcn,
IF(.not.allocated(zzmat(jspin)%z_r))
+ ALLOCATE (zzMat(jspin)%z_r(zzMat(jspin)%nbasfcn,
+ zzMat(jspin)%nbands))
ELSE
ALLOCATE (zzMat(jspin)%z_c(zzMat(jspin)%nbasfcn,
IF(.not.allocated(zzmat(jspin)%z_c))
+ ALLOCATE (zzMat(jspin)%z_c(zzMat(jspin)%nbasfcn,
+ zzMat(jspin)%nbands))
END IF
......@@ -746,11 +748,13 @@ c...we work only within the energy window
zMat(jspin)%nbasfcn = zzMat(jspin)%nbasfcn
zMat(jspin)%nbands = zzMat(jspin)%nbands
IF (zzMat(jspin)%l_real) THEN
ALLOCATE (zMat(jspin)%z_r(zMat(jspin)%nbasfcn,
IF(.not.allocated(zmat(jspin)%z_r))
+ ALLOCATE (zMat(jspin)%z_r(zMat(jspin)%nbasfcn,
+ zMat(jspin)%nbands))
zMat(jspin)%z_r = 0.0
ELSE
ALLOCATE (zMat(jspin)%z_c(zMat(jspin)%nbasfcn,
IF(.not.allocated(zMat(jspin)%z_c))
+ ALLOCATE (zMat(jspin)%z_c(zMat(jspin)%nbasfcn,
+ zMat(jspin)%nbands))
zMat(jspin)%z_c = CMPLX(0.0,0.0)
END IF
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment