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************************************************************ ...@@ -53,14 +53,18 @@ c************************************************************
complex :: suma,sumb,sumc,sumd complex :: suma,sumb,sumc,sumd
complex :: suma12(2,2),sumb12(2,2) complex :: suma12(2,2),sumb12(2,2)
complex :: sumc12(2,2),sumd12(2,2) complex :: sumc12(2,2),sumd12(2,2)
real, allocatable :: qlo(:,:,:,:,:) complex, allocatable :: qlo(:,:,:,:,:)
real, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:) complex, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
complex, allocatable :: qcloa(:,:,:,:),qclob(:,:,:,:)
COMPLEX :: ccchi(2,2),ci COMPLEX :: ccchi(2,2),ci
ci = cmplx(0.0,1.0) ci = cmplx(0.0,1.0)
allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd), allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd),
+ qaclo(noccbd,noccbd,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 c---> performs summations of the overlaps of the wavefunctions
do i = 1,noccbd do i = 1,noccbd
do j = 1,noccbd do j = 1,noccbd
...@@ -152,6 +156,9 @@ c---> initialize qlo arrays ...@@ -152,6 +156,9 @@ c---> initialize qlo arrays
qlo(:,:,:,:,:) = 0.0 qlo(:,:,:,:,:) = 0.0
qaclo(:,:,:,:) = 0.0 qaclo(:,:,:,:) = 0.0
qbclo(:,:,:,:) = 0.0 qbclo(:,:,:,:) = 0.0
qcloa(:,:,:,:) = 0.0
qclob(:,:,:,:) = 0.0
c---> prepare the coefficients c---> prepare the coefficients
natom = 0 natom = 0
do ntyp = 1,ntype do ntyp = 1,ntype
...@@ -162,14 +169,21 @@ c---> prepare the coefficients ...@@ -162,14 +169,21 @@ c---> prepare the coefficients
ll1 = l* (l+1) ll1 = l* (l+1)
do m = -l,l do m = -l,l
lm = ll1 + m lm = ll1 + m
do i = 1,noccbd do j = 1,noccbd
do j = 1,noccbd do i = 1,noccbd
qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) + real( qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) +
+ bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) + + bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))
+ ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,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) + real( qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) +
+ acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) + + acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))
+ ccof(m,i,lo,natom,1)*conjg(acof(j,lm,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 enddo
enddo enddo
...@@ -178,9 +192,9 @@ c---> prepare the coefficients ...@@ -178,9 +192,9 @@ c---> prepare the coefficients
do m = -l,l do m = -l,l
do i = 1,noccbd do i = 1,noccbd
do j = 1,noccbd do j = 1,noccbd
qlo(i,j,lop,lo,ntyp) = qlo(i,j,lop,lo,ntyp) + qlo(i,j,lo,lop,ntyp) = qlo(i,j,lo,lop,ntyp) +
+ real(conjg(ccof(m,j,lop,natom,2)) + conjg(ccof(m,j,lop,natom,2))
* *ccof(m,i,lo,natom,1)) * *ccof(m,i,lo,natom,1)
enddo enddo
enddo enddo
enddo enddo
...@@ -193,28 +207,33 @@ c---> perform summation of the coefficients with the integrals ...@@ -193,28 +207,33 @@ c---> perform summation of the coefficients with the integrals
c---> of the radial basis functions c---> of the radial basis functions
do ntyp = 1,ntype do ntyp = 1,ntype
do lo = 1,nlo(ntyp) do lo = 1,nlo(ntyp)
stop 'not yet finished'
l = llo(lo,ntyp) 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) + mmn(i,j)= mmn(i,j) +
+ ( qaclo(i,j,lo,ntyp)*uulon(lo,ntyp,2) + + qaclo(i,j,lo,ntyp)*radial1_flo(1,2,l,lo,ntyp)
+ qbclo(i,j,lo,ntyp)*dulon(lo,ntyp,2) ) + +
+ 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
enddo enddo
do lop = 1,nlo(ntyp) do lop = 1,nlo(ntyp)
if (llo(lop,ntyp).eq.l) then 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) + 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
enddo enddo
endif endif
enddo enddo
enddo enddo
enddo enddo
deallocate ( qlo,qaclo,qbclo ) deallocate ( qlo,qaclo,qbclo,qcloa,qclob )
END SUBROUTINE wann_mmk0_updown_sph END SUBROUTINE wann_mmk0_updown_sph
END MODULE m_wann_mmk0_updown_sph END MODULE m_wann_mmk0_updown_sph
...@@ -717,10 +717,12 @@ c**************************************************************** ...@@ -717,10 +717,12 @@ c****************************************************************
zzMat(jspin)%nbasfcn = nbasfcn zzMat(jspin)%nbasfcn = nbasfcn
zzMat(jspin)%nbands = neigd zzMat(jspin)%nbands = neigd
IF(l_real) THEN 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)) + zzMat(jspin)%nbands))
ELSE 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)) + zzMat(jspin)%nbands))
END IF END IF
...@@ -746,11 +748,13 @@ c...we work only within the energy window ...@@ -746,11 +748,13 @@ c...we work only within the energy window
zMat(jspin)%nbasfcn = zzMat(jspin)%nbasfcn zMat(jspin)%nbasfcn = zzMat(jspin)%nbasfcn
zMat(jspin)%nbands = zzMat(jspin)%nbands zMat(jspin)%nbands = zzMat(jspin)%nbands
IF (zzMat(jspin)%l_real) THEN 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)%nbands))
zMat(jspin)%z_r = 0.0 zMat(jspin)%z_r = 0.0
ELSE 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)%nbands))
zMat(jspin)%z_c = CMPLX(0.0,0.0) zMat(jspin)%z_c = CMPLX(0.0,0.0)
END IF 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