Commit 24653086 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of fleur-git:fleur into develop

parents 0b148632 518f3002
......@@ -54,6 +54,7 @@ SUBROUTINE brzone2(rcmt,nsym,idrot,mface,nbsz,nv48,&
REAL :: edgeDirec(3), edgeDistVec(3), distVec(3)
INTEGER, ALLOCATABLE :: cornerPlaneList(:,:)
INTEGER, ALLOCATABLE :: planeCorners(:,:)
! Subroutine plan:
! 0. Initializations
......@@ -387,12 +388,14 @@ SUBROUTINE brzone2(rcmt,nsym,idrot,mface,nbsz,nv48,&
nCorners = nUniqueCorners
! Add origin to corner points
nCorners = nCorners + 1
corners(:,nCorners) = 0.0
DO i = nOuterPlanes + 1, nPlanes
cornerPlaneList(i-nOuterPlanes,nCorners) = i
END DO
numCornerPlanes(nCorners) = nPlanes - nOuterPlanes
IF ((nPlanes-nOuterPlanes).GE.3) THEN ! The origin is only a corner if at least 3 planes feature this point
nCorners = nCorners + 1
corners(:,nCorners) = 0.0
DO i = nOuterPlanes + 1, nPlanes
cornerPlaneList(i-nOuterPlanes,nCorners) = i
END DO
numCornerPlanes(nCorners) = nPlanes - nOuterPlanes
END IF
! Filter out "corners" found for sets of planes that do not meet in a single
! point but have a common intersection edge.
......@@ -433,9 +436,12 @@ SUBROUTINE brzone2(rcmt,nsym,idrot,mface,nbsz,nv48,&
! Count the number of corners for each plane
nPlaneCorners = 0
ALLOCATE(planeCorners(nPlanes,nCorners))
planeCorners = 0
DO i = 1, nCorners
DO j = 1, numCornerPlanes(i)
nPlaneCorners(cornerPlaneList(j,i)) = nPlaneCorners(cornerPlaneList(j,i)) + 1
planeCorners(cornerPlaneList(j,i),nPlaneCorners(cornerPlaneList(j,i))) = i
END DO
END DO
......@@ -447,12 +453,19 @@ SUBROUTINE brzone2(rcmt,nsym,idrot,mface,nbsz,nv48,&
isIBZPlane(n1) = .FALSE.
CYCLE
END IF
! WRITE(*,*) 'plane ', n1
! WRITE(*,'(4f20.13)') dvec(:,n1), ddist(n1)
! WRITE(*,*) 'corners:'
! DO i = 1, nPlaneCorners(n1)
! WRITE(*,'(i5,3f20.13)') planeCorners(n1,i), corners(:,planeCorners(n1,i))
! END DO
nface = nface + 1
END DO
! Remove irrelevant corners:
ncorn = 0
isIBZCorner(:) = .TRUE.
! WRITE(*,*) 'IBZ corners:'
DO i = 1, nCorners
numIBZPlanes = 0
DO j = 1, numCornerPlanes(i)
......@@ -463,6 +476,7 @@ SUBROUTINE brzone2(rcmt,nsym,idrot,mface,nbsz,nv48,&
IF(numIBZPlanes.LE.2) isIBZCorner(i) = .FALSE.
IF(.NOT.isIBZCorner(i)) CYCLE
ncorn = ncorn + 1
! WRITE(*,'(i5,3f20.13)') i, corners(:,i)
END DO
DEALLOCATE(cornerPlaneList)
......@@ -527,9 +541,19 @@ SUBROUTINE brzone2(rcmt,nsym,idrot,mface,nbsz,nv48,&
WRITE(*,*) "ncorn: ", ncorn
WRITE(*,*) "nface: ", nface
WRITE(*,*) "nedge: ", nedge
WRITE(*,*) "corners: "
DO i = 1, ncorn
WRITE(*,'(3f20.13)') cpoint(:,i)
END DO
WRITE(*,*) "faces: "
DO i = 1, nface
WRITE(*,'(4f20.13)') fnorm(:,i), fdist(i)
END DO
CALL juDFT_error("Brillouin zone does not fulfill Euler characterisic.",calledby ="brzone2")
END IF
DEALLOCATE (planeCorners)
END SUBROUTINE brzone2
END MODULE m_brzone2
......@@ -64,10 +64,9 @@ CONTAINS
IF (l_noco) length=1
ALLOCATE(d%eig_eig(neig,jspins*nkpts))
!d%eig_vec
if (l_real) THEN
if (l_real.and..not.l_soc) THEN
print *, "Allocate real in eig66_mem"
ALLOCATE(d%eig_vecr(nmat*neig,length*nkpts))
if (l_soc) CALL judft_error("SOC+INVERSION can not be used with eigenvalues stored in memory")
else
print *, "Allocate complex in eig66_mem"
ALLOCATE(d%eig_vecc(nmat*neig,length*nkpts))
......@@ -281,8 +280,12 @@ CONTAINS
IF (PRESENT(z)) THEN
SELECT TYPE(z)
TYPE is (REAL)
IF (.NOT.ALLOCATED(d%eig_vecr)) CALL juDFT_error("BUG: can not read real vectors from memory")
z=RESHAPE(d%eig_vecr(:SIZE(z),nrec),SHAPE(z))
IF (.NOT.ALLOCATED(d%eig_vecr)) THEN
IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read complex vectors from memory")
z=REAL(RESHAPE(d%eig_vecc(:SIZE(z),nrec),SHAPE(z)))
ELSE
z=RESHAPE(d%eig_vecr(:SIZE(z),nrec),SHAPE(z))
ENDIF
TYPE is (COMPLEX)
IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read complex vectors from memory")
z=RESHAPE(d%eig_vecc(:SIZE(z),nrec),SHAPE(z))
......@@ -341,11 +344,14 @@ CONTAINS
ENDIF
!data from d%eig_vec
IF (PRESENT(z)) THEN
SELECT TYPE(z)
TYPE IS (REAL)
IF (.NOT.ALLOCATED(d%eig_vecr)) CALL juDFT_error("BUG: can not write real vectors to memory")
d%eig_vecr(:SIZE(z),nrec)=RESHAPE(REAL(z),(/SIZE(z)/))
IF (.NOT.ALLOCATED(d%eig_vecr)) THEN
IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
d%eig_vecc(:SIZE(z),nrec)=RESHAPE(CMPLX(z),(/SIZE(z)/)) !Type cast here
ELSE
d%eig_vecr(:SIZE(z),nrec)=RESHAPE(REAL(z),(/SIZE(z)/))
ENDIF
TYPE IS(COMPLEX)
IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
d%eig_vecc(:SIZE(z),nrec)=RESHAPE(CMPLX(z),(/SIZE(z)/))
......
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