From 8586f3fe6f645a1469256c2553f69a93e6a23508 Mon Sep 17 00:00:00 2001 From: "P.Buhl" Date: Thu, 23 Nov 2017 17:09:52 +0100 Subject: [PATCH] get updown working with updated wann_mmk0_updown_sph file from frank and avoiding some double allocations --- wannier/wann_mmk0_updown_sph.f | 65 ++++++++++++++++++++++------------ wannier/wann_updown.F | 12 ++++--- 2 files changed, 50 insertions(+), 27 deletions(-) diff --git a/wannier/wann_mmk0_updown_sph.f b/wannier/wann_mmk0_updown_sph.f index ed2e58d1..030ae43f 100644 --- a/wannier/wann_mmk0_updown_sph.f +++ b/wannier/wann_mmk0_updown_sph.f @@ -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 + diff --git a/wannier/wann_updown.F b/wannier/wann_updown.F index fce3c59a..9e780ce7 100644 --- a/wannier/wann_updown.F +++ b/wannier/wann_updown.F @@ -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 -- GitLab