Commit ebc3d86f authored by Gregor Michalicek's avatar Gregor Michalicek

Beautify Julia

parent 426dfe3d
...@@ -3,13 +3,13 @@ ...@@ -3,13 +3,13 @@
! This file is part of FLEUR and available as free software under the conditions ! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail. ! of the MIT license as expressed in the LICENSE file in more detail.
!-------------------------------------------------------------------------------- !--------------------------------------------------------------------------------
MODULE m_julia
MODULE m_julia USE m_juDFT
use m_juDFT
CONTAINS CONTAINS
SUBROUTINE julia(&
& sym,cell,input,noco,banddos,& SUBROUTINE julia(sym,cell,input,noco,banddos,kpts,l_q,l_fillArrays)
& kpts,l_q,l_fillArrays)
!----------------------------------------------------------------------+ !----------------------------------------------------------------------+
! Generate a k-point file with approx. nkpt k-pts or a Monkhorst-Pack | ! Generate a k-point file with approx. nkpt k-pts or a Monkhorst-Pack |
! set with nmod(i) divisions in i=x,y,z direction. Interface to kptmop | ! set with nmod(i) divisions in i=x,y,z direction. Interface to kptmop |
...@@ -25,14 +25,16 @@ ...@@ -25,14 +25,16 @@
USE m_kptmop USE m_kptmop
USE m_kpttet USE m_kpttet
USE m_bandstr1 USE m_bandstr1
use m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_input),INTENT(IN) :: input TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_input), INTENT(IN) :: input
TYPE(t_banddos),INTENT(IN) :: banddos TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_kpts),INTENT(INOUT) :: kpts TYPE(t_banddos), INTENT(IN) :: banddos
TYPE(t_kpts), INTENT(INOUT) :: kpts
LOGICAL, INTENT (IN) :: l_q, l_fillArrays LOGICAL, INTENT (IN) :: l_q, l_fillArrays
...@@ -45,11 +47,12 @@ ...@@ -45,11 +47,12 @@
INTEGER ndiv3 ! max. number of tetrahedrons (< 6*(kpts%nkpt+1) INTEGER ndiv3 ! max. number of tetrahedrons (< 6*(kpts%nkpt+1)
INTEGER ntet ! actual number of tetrahedrons INTEGER ntet ! actual number of tetrahedrons
REAL, ALLOCATABLE :: vkxyz(:,:) ! vector of kpoint generated; in cartesian representation REAL, ALLOCATABLE :: vkxyz(:,:) ! vector of kpoint generated; in cartesian representation
REAL, ALLOCATABLE :: wghtkp(:) ! associated with k-points for BZ integration REAL, ALLOCATABLE :: wghtkp(:) ! associated with k-points for BZ integration
INTEGER, ALLOCATABLE :: ntetra(:,:) ! corners of the tetrahedrons INTEGER, ALLOCATABLE :: ntetra(:,:) ! corners of the tetrahedrons
REAL, ALLOCATABLE :: voltet(:) ! voulmes of the tetrahedrons REAL, ALLOCATABLE :: voltet(:) ! voulmes of the tetrahedrons
REAL, ALLOCATABLE :: vktet(:,:) ! REAL, ALLOCATABLE :: vktet(:,:)
REAL divis(4) ! Used to find more accurate representation of k-points REAL divis(4) ! Used to find more accurate representation of k-points
! vklmn(i,kpt)/divis(i) and weights as wght(kpt)/divis(4) ! vklmn(i,kpt)/divis(i) and weights as wght(kpt)/divis(4)
...@@ -88,28 +91,28 @@ ...@@ -88,28 +91,28 @@
random = .false. ! do not use random tetra-points random = .false. ! do not use random tetra-points
!------------------------------------------------------------ !------------------------------------------------------------
! !
! idsyst idtype ! idsyst idtype
! !
! 1 cubic primitive ! 1 cubic primitive
! 2 tetragonal body centered ! 2 tetragonal body centered
! 3 orthorhombic face centered ! 3 orthorhombic face centered
! 4 hexagonal A-face centered ! 4 hexagonal A-face centered
! 5 trigonal B-face centered ! 5 trigonal B-face centered
! 6 monoclinic C-face centered ! 6 monoclinic C-face centered
! 7 triclinic ! 7 triclinic
! !
! ---> for 2 dimensions only the following Bravais lattices exist: ! ---> for 2 dimensions only the following Bravais lattices exist:
! !
! TYPE EQUIVALENT 3-DIM idsyst/idtype ! TYPE EQUIVALENT 3-DIM idsyst/idtype
! square = p-tetragonal ( 1+2 axis ) 2/1 ! square = p-tetragonal ( 1+2 axis ) 2/1
! rectangular = p-orthorhomb ( 1+2 axis ) 3/1 ! rectangular = p-orthorhomb ( 1+2 axis ) 3/1
! centered rectangular = c-face-orthorhomb( 1+2 axis) 3/6 ! centered rectangular = c-face-orthorhomb( 1+2 axis) 3/6
! hexagonal = p-hexagonal ( 1+2 axis ) 4/1 ! hexagonal = p-hexagonal ( 1+2 axis ) 4/1
! oblique = p-monoclinic ( 1+2 axis ) 6/1 ! oblique = p-monoclinic ( 1+2 axis ) 6/1
! !
!------------------------------------------------------------ !------------------------------------------------------------
IF(l_q) THEN IF(l_q) THEN
trias=input%tria trias=input%tria
...@@ -124,8 +127,8 @@ ...@@ -124,8 +127,8 @@
IF (abs(cell%amat(1,1)-cell%amat(3,3)) < 0.0000001) THEN IF (abs(cell%amat(1,1)-cell%amat(3,3)) < 0.0000001) THEN
idsyst = 1 idsyst = 1
idtype = 1 idtype = 1
ENDIF END IF
ENDIF END IF
END IF END IF
IF (cell%latnam.EQ.'p-r') THEN IF (cell%latnam.EQ.'p-r') THEN
idsyst = 3 idsyst = 3
...@@ -144,22 +147,19 @@ ...@@ -144,22 +147,19 @@
idtype = 1 idtype = 1
END IF END IF
IF (cell%latnam.EQ.'any') THEN IF (cell%latnam.EQ.'any') THEN
CALL bravais(& CALL bravais(cell%amat,idsyst,idtype)
& cell%amat,& END IF
& idsyst,idtype)
ENDIF
nsym = sym%nop nsym = sym%nop
IF (input%film) nsym = sym%nop2 IF (input%film) nsym = sym%nop2
!
!-------------------- Want to make a Bandstructure ? -------- ! Want to make a Bandstructure?
!
IF (banddos%ndir == -4) THEN IF (banddos%ndir == -4) THEN
CALL bandstr1(idsyst,idtype,cell%bmat,kpts,input,l_fillArrays,banddos) CALL bandstr1(idsyst,idtype,cell%bmat,kpts,input,l_fillArrays,banddos)
RETURN RETURN
ENDIF END IF
!
!-------------------- Some variables we do not use ---------- ! Some variables we do not use
!
iofile = 6 iofile = 6
iokpt = 6 iokpt = 6
kpri = 0 ! 3 kpri = 0 ! 3
...@@ -168,69 +168,67 @@ ...@@ -168,69 +168,67 @@
nreg = 0 nreg = 0
nfulst = 0 nfulst = 0
ikzero = 0 ikzero = 0
kzero(1) = 0.0 ; kzero(2) = 0.0 ; kzero(3) = 0.0 kzero(1) = 0.0
kzero(2) = 0.0
kzero(3) = 0.0
nbound = 0 nbound = 0
IF (input%tria) THEN IF (input%tria) THEN
IF (input%film) nbound = 1 IF (input%film) nbound = 1
! IF ((idsyst==1).AND.(idtype==1)) nbound = 1 ! IF ((idsyst==1).AND.(idtype==1)) nbound = 1
! IF ((idsyst==2).AND.(idtype==1)) nbound = 1 ! IF ((idsyst==2).AND.(idtype==1)) nbound = 1
! IF ((idsyst==3).AND.(idtype==1)) nbound = 1 ! IF ((idsyst==3).AND.(idtype==1)) nbound = 1
! IF ((idsyst==3).AND.(idtype==6)) nbound = 1 ! IF ((idsyst==3).AND.(idtype==6)) nbound = 1
! IF ((idsyst==4).AND.(idtype==1)) nbound = 1 ! IF ((idsyst==4).AND.(idtype==1)) nbound = 1
IF (nbound == 0) random = .true. IF (nbound == 0) random = .true.
ENDIF END IF
idimens = 3 idimens = 3
IF (input%film) idimens = 2 IF (input%film) idimens = 2
!
!--------------------- Lattice information ------------------
DO j = 1,3 ! Lattice information
DO k = 1,3
DO j = 1, 3
DO k = 1, 3
bltv(j,k) = cell%amat(k,j) bltv(j,k) = cell%amat(k,j)
binv(j,k) = cell%bmat(k,j)/tpi_const binv(j,k) = cell%bmat(k,j) / tpi_const
rltv(j,k) = cell%bmat(k,j) rltv(j,k) = cell%bmat(k,j)
DO i = 1,nsym DO i = 1,nsym
rlsymr(k,j,i) = real( sym%mrot(j,k,i) ) rlsymr(k,j,i) = real(sym%mrot(j,k,i))
ENDDO END DO
ENDDO END DO
ENDDO END DO
ccr = 0.0 ccr = 0.0
DO i = 1,nsym DO i = 1, nsym
DO j = 1,3 DO j = 1, 3
talfa(j,i) = 0.0 talfa(j,i) = 0.0
DO k = 1,3 DO k = 1, 3
talfa(j,i) = bltv(j,k) * sym%tau(k,i) talfa(j,i) = bltv(j,k) * sym%tau(k,i)
help(k) = 0.0 help(k) = 0.0
DO l = 1,3 DO l = 1, 3
help(k) = help(k) + rlsymr(l,k,i) * binv(j,l) help(k) = help(k) + rlsymr(l,k,i) * binv(j,l)
ENDDO END DO
ENDDO END DO
DO k = 1,3 DO k = 1, 3
ccr(j,k,i) = 0.0 ccr(j,k,i) = 0.0
DO l = 1,3 DO l = 1, 3
ccr(j,k,i) = ccr(j,k,i) + bltv(l,k) * help(l) ccr(j,k,i) = ccr(j,k,i) + bltv(l,k) * help(l)
ENDDO END DO
ENDDO END DO
ENDDO END DO
! write (*,'(3f12.6)') ((ccr(j,k,i),j=1,3),k=1,3) END DO
! write (*,*) DO i = 1, nsym
ENDDO
DO i = 1,nsym
rlsymr1(:,:) = rlsymr(:,:,i) rlsymr1(:,:) = rlsymr(:,:,i)
ccr1(:,:) = ccr(:,:,i) ccr1(:,:) = ccr(:,:,i)
DO j = 1,3 DO j = 1, 3
DO k = 1,3 DO k = 1, 3
rlsymr(k,j,i) = rlsymr1(j,k) rlsymr(k,j,i) = rlsymr1(j,k)
ccr(k,j,i) = ccr1(j,k) ccr(k,j,i) = ccr1(j,k)
ENDDO END DO
ENDDO END DO
ENDDO END DO
IF ((.not.noco%l_ss).AND.(.not.noco%l_soc).AND.(2*nsym<nop48)) THEN IF ((.not.noco%l_ss).AND.(.not.noco%l_soc).AND.(2*nsym<nop48)) THEN
IF ((input%film.AND.(.not.sym%invs2)).OR.((.not.input%film).AND.(.not.sym%invs))) THEN
IF ( (input%film.AND.(.not.sym%invs2)).OR.&
& ((.not.input%film).AND.(.not.sym%invs)) ) THEN
addSym = 0 addSym = 0
! Note: We have to add the negative of each symmetry operation ! Note: We have to add the negative of each symmetry operation
! to exploit time reversal symmetry. However, if the new ! to exploit time reversal symmetry. However, if the new
...@@ -245,66 +243,46 @@ ...@@ -245,66 +243,46 @@
END IF END IF
END DO END DO
nsym = nsym + addSym nsym = nsym + addSym
ENDIF END IF
END IF
ENDIF ! brzone and brzone2 find the corner-points, the edges, and the
! faces of the irreducible wedge of the brillouin zone (IBZ).
! In these subroutines many special cases can occur. Due to this the very
! sophisticated old routine brzone had a few bugs. The new routine
! brzone2 was written with a different algorithm that is slightly slower
! but should be more stable. To make comparisons possible the old
! routine is only commented out. Both routines are directly
! interchangable. GM, 2016.
! CALL brzone(rltv,nsym,ccr,mface,nbsz,nv48,cpoint,xvec,ncorn,nedge,nface,fnorm,fdist)
CALL brzone2(rltv,nsym,ccr,mface,nbsz,nv48,cpoint,xvec,ncorn,nedge,nface,fnorm,fdist)
! brzone and brzone2 find the corner-points, the edges, and the IF (input%tria.AND.random) THEN
! faces of the irreducible wedge of the brillouin zone (IBZ). ! Calculate the points for tetrahedron method
! In these subroutines many special cases can occur. Due to this the very
! sophisticated old routine brzone had a few bugs. The new routine
! brzone2 was written with a different algorithm that is slightly slower
! but should be more stable. To make comparisons possible the old
! routine is only commented out. Both routines are directly
! interchangable. GM, 2016.
! CALL brzone(&
! & rltv,nsym,ccr,mface,nbsz,nv48,&
! & cpoint,&
! & xvec,ncorn,nedge,nface,fnorm,fdist)
CALL brzone2(&
& rltv,nsym,ccr,mface,nbsz,nv48,&
& cpoint,&
& xvec,ncorn,nedge,nface,fnorm,fdist)
IF ( input%tria.AND.random ) THEN
!
! Calculate the points for tetrahedron method
!
mkpt = kpts%nkpt mkpt = kpts%nkpt
ndiv3 = 6*(mkpt+1) ndiv3 = 6*(mkpt+1)
ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt) ) ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt))
ALLOCATE ( voltet(ndiv3),vktet(3,mkpt),ntetra(4,ndiv3) ) ALLOCATE (voltet(ndiv3),vktet(3,mkpt),ntetra(4,ndiv3))
vkxyz = 0.0 vkxyz = 0.0
CALL kpttet(& CALL kpttet(iofile,ibfile,iokpt,kpri,ktest,kmidtet,mkpt,ndiv3,&
& iofile,ibfile,iokpt,& nreg,nfulst,rltv,cell%omtil,nsym,ccr,mdir,mface,&
& kpri,ktest,kmidtet,mkpt,ndiv3,& ncorn,nface,fdist,fnorm,cpoint,voltet,ntetra,ntet,vktet,&
& nreg,nfulst,rltv,cell%omtil,& kpts%nkpt,divis,vkxyz,wghtkp)
& nsym,ccr,mdir,mface,&
& ncorn,nface,fdist,fnorm,cpoint,&
& voltet,ntetra,ntet,vktet,&
& kpts%nkpt,&
& divis,vkxyz,wghtkp)
ELSE ELSE
! ! If just the total number of k-points is given, determine
! If just the total number of k-points is given, determine ! the divisions in each direction (nkpt3):
! the divisions in each direction (nkpt3):
! ! IF (tria) THEN
! IF (tria) THEN ! nkpt = nkpt/4
! nkpt = nkpt/4 ! nkpt3(:) = nkpt3(:) / 2
! nkpt3(:) = nkpt3(:) / 2 ! END IF
! ENDIF
IF (sum(kpts%nkpt3).EQ.0) THEN IF (sum(kpts%nkpt3).EQ.0) THEN
CALL divi(& CALL divi(kpts%nkpt,cell%bmat,input%film,sym%nop,sym%nop2,kpts%nkpt3)
& kpts%nkpt,cell%bmat,input%film,sym%nop,sym%nop2,& END IF
& kpts%nkpt3)
ENDIF
! ! Now calculate Monkhorst-Pack k-points:
! Now calculate Monkhorst-Pack k-points:
!
IF (kpts%nkpt3(2).EQ.0) kpts%nkpt3(2) = kpts%nkpt3(1) IF (kpts%nkpt3(2).EQ.0) kpts%nkpt3(2) = kpts%nkpt3(1)
IF ((.not.input%film).AND.(kpts%nkpt3(3).EQ.0)) kpts%nkpt3(3) = kpts%nkpt3(2) IF ((.not.input%film).AND.(kpts%nkpt3(3).EQ.0)) kpts%nkpt3(3) = kpts%nkpt3(2)
IF (nbound.EQ.1) THEN IF (nbound.EQ.1) THEN
...@@ -313,63 +291,53 @@ ...@@ -313,63 +291,53 @@
ELSE ELSE
mkpt = kpts%nkpt3(1)*kpts%nkpt3(2) mkpt = kpts%nkpt3(1)*kpts%nkpt3(2)
IF (.not.input%film) mkpt = mkpt*kpts%nkpt3(3) IF (.not.input%film) mkpt = mkpt*kpts%nkpt3(3)
ENDIF END IF
ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt) ) ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt) )
vkxyz = 0.0 vkxyz = 0.0
CALL kptmop(& CALL kptmop(iofile,iokpt,kpri,ktest,idsyst,idtype,kpts%nkpt3,ikzero,kzero,&
& iofile,iokpt,kpri,ktest,& rltv,bltv,nreg,nfulst,nbound,idimens,xvec,fnorm,fdist,ncorn,nface,&
& idsyst,idtype,kpts%nkpt3,ikzero,kzero,& nedge,cpoint,nsym,ccr,rlsymr,talfa,mkpt,mface,mdir,&
& rltv,bltv,nreg,nfulst,nbound,idimens,& kpts%nkpt,divis,vkxyz,nkstar,wghtkp)
& xvec,fnorm,fdist,ncorn,nface,nedge,cpoint,& END IF
& nsym,ccr,rlsymr,talfa,mkpt,mface,mdir,&
& kpts%nkpt,divis,vkxyz,nkstar,wghtkp)
ENDIF
!
idivis(1) = int(divis(1)) idivis(1) = int(divis(1))
idivis(2) = int(divis(2)) idivis(2) = int(divis(2))
idivis(3) = int(divis(3)) idivis(3) = int(divis(3))
idiv = lcm(3,idivis) idiv = lcm(3,idivis)
! WRITE (*,'(2i5)') nkpt,idiv
IF (idiv.GE.200) idiv = 1 IF (idiv.GE.200) idiv = 1
DO j=1,kpts%nkpt DO j=1,kpts%nkpt
! WRITE (*,'(4f10.5)') (vkxyz(i,j),i=1,3),wghtkp(j)
wghtkp(j) = wghtkp(j) * divis(4) wghtkp(j) = wghtkp(j) * divis(4)
DO k = 1,3 DO k = 1,3
help(k) = 0.0 help(k) = 0.0
DO l = 1,3 DO l = 1,3
help(k) = help(k) + cell%amat(l,k) * vkxyz(l,j) help(k) = help(k) + cell%amat(l,k) * vkxyz(l,j)
ENDDO END DO
ENDDO END DO
DO i=1,3 DO i=1,3
vkxyz(i,j) = help(i) * idiv / tpi_const vkxyz(i,j) = help(i) * idiv / tpi_const
ENDDO END DO
ENDDO END DO
!
! if (l_q) write qpts file: ! if (l_q) write qpts file:
!
IF(l_q)THEN IF(l_q)THEN
IF(input%film) CALL juDFT_error("For the case of input%film q-points "//& IF(input%film) THEN
& "generator not implemented!",calledby ="julia") CALL juDFT_error("For the case of input%film q-points generator not implemented!", calledby = "julia")
END IF
OPEN(113,file='qpts',form='formatted',status='new') OPEN(113,file='qpts',form='formatted',status='new')
WRITE(113,'(i5)') kpts%nkpt+1 WRITE(113,'(i5)') kpts%nkpt+1
WRITE(113,8050) 0.,0.,0. WRITE(113,8050) 0.,0.,0.
DO j = 1, kpts%nkpt DO j = 1, kpts%nkpt
WRITE (113,FMT=8050) (vkxyz(i,j)/real(idiv),i=1,3) WRITE (113,FMT=8050) (vkxyz(i,j)/real(idiv),i=1,3)
ENDDO END DO
CLOSE(113) CLOSE(113)
!input%tria=trias !input%tria=trias
RETURN RETURN
ENDIF END IF
8050 FORMAT (2(f14.10,1x),f14.10) 8050 FORMAT (2(f14.10,1x),f14.10)
! ! write k-points file or write data into arrays
! write k-points file or write data into arrays
!
IF (l_fillArrays) THEN IF (l_fillArrays) THEN
IF (ALLOCATED(kpts%bk)) THEN IF (ALLOCATED(kpts%bk)) THEN
DEALLOCATE(kpts%bk) DEALLOCATE(kpts%bk)
...@@ -406,7 +374,7 @@ ...@@ -406,7 +374,7 @@
OPEN (41,file='kpts',form='formatted',status='new') OPEN (41,file='kpts',form='formatted',status='new')
IF (input%film) THEN IF (input%film) THEN
WRITE (41,FMT=8110) kpts%nkpt,real(idiv),.false. WRITE (41,FMT=8110) kpts%nkpt,real(idiv),.false.
DO j=kpts%nkpt,1,-1 DO j = kpts%nkpt, 1, -1
WRITE (41,FMT=8040) (vkxyz(i,j),i=1,2),wghtkp(j) WRITE (41,FMT=8040) (vkxyz(i,j),i=1,2),wghtkp(j)
END DO END DO
ELSE ELSE
...@@ -424,43 +392,36 @@ ...@@ -424,43 +392,36 @@
8110 FORMAT (i5,f20.10,3x,l1) 8110 FORMAT (i5,f20.10,3x,l1)
8040 FORMAT (4f10.5) 8040 FORMAT (4f10.5)
CLOSE (41) CLOSE (41)
END IF END IF
DEALLOCATE ( vkxyz,wghtkp ) DEALLOCATE (vkxyz,wghtkp)
IF (input%tria.AND..not.input%film) DEALLOCATE ( voltet,vktet,ntetra ) IF (input%tria.AND..not.input%film) DEALLOCATE (voltet,vktet,ntetra)
RETURN RETURN
CONTAINS CONTAINS
INTEGER FUNCTION lcm( n, ints ) INTEGER FUNCTION lcm( n, ints )
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! Compute least common multiple (lcm) of n positive integers.
! Compute least common multiple (lcm) of n positive integers. INTEGER, INTENT(IN) :: n
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - INTEGER, INTENT(IN) :: ints(n)
!===> Arguments
INTEGER :: n
INTEGER :: ints(n)
!===> Variables
INTEGER :: i,j,m INTEGER :: i,j,m
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
IF ( any( ints(1:n)<= 0 ) ) THEN IF (any(ints(1:n) <= 0)) THEN
m = 0 m = 0
ELSE ELSE
m = maxval( ints(1:n) ) m = maxval( ints(1:n) )
DO i = 1, n DO i = 1, n
DO j = 1, ints(i)/2 DO j = 1, ints(i) / 2
IF ( mod( m*j,ints(i) ) == 0 ) EXIT IF (mod(m*j,ints(i)) == 0) EXIT
END DO END DO
m = m*j m = m*j
ENDDO END DO
ENDIF END IF
lcm = m lcm = m
RETURN RETURN
END FUNCTION lcm END FUNCTION lcm
END SUBROUTINE julia END SUBROUTINE julia
END MODULE m_julia
END MODULE m_julia
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