mirror of https://gitlab.com/QEF/q-e.git
235 lines
8.4 KiB
Fortran
235 lines
8.4 KiB
Fortran
!
|
|
! Copyright (C) 2002-2005 FPMD-CPV groups
|
|
! This file is distributed under the terms of the
|
|
! GNU General Public License. See the file `License'
|
|
! in the root directory of the present distribution,
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
!
|
|
|
|
!------------------------------------------------------------------------------!
|
|
!
|
|
MODULE brillouin
|
|
!
|
|
!------------------------------------------------------------------------------!
|
|
USE kinds, ONLY : dbl
|
|
USE mp, ONLY : mp_bcast
|
|
! ...
|
|
!
|
|
IMPLICIT NONE
|
|
SAVE
|
|
!
|
|
PRIVATE
|
|
!
|
|
! ... CP2K Type ...
|
|
TYPE kpoints
|
|
CHARACTER (len=20) :: scheme
|
|
LOGICAL :: gamma_only
|
|
INTEGER :: nk1, nk2, nk3
|
|
INTEGER :: k1, k2, k3
|
|
REAL (dbl) :: shift(3)
|
|
LOGICAL :: symmetry
|
|
INTEGER :: wfn_type
|
|
INTEGER :: nkpt
|
|
REAL (dbl), DIMENSION (:), POINTER :: weight
|
|
REAL (dbl), DIMENSION (:,:), POINTER :: xk
|
|
END TYPE kpoints
|
|
!------------------------------------------------------------------------------!
|
|
|
|
TYPE (kpoints) :: kp
|
|
REAL (dbl), ALLOCATABLE , TARGET :: weight(:)
|
|
REAL (dbl), ALLOCATABLE , TARGET :: xk(:,:)
|
|
|
|
|
|
PUBLIC :: kpoints, kpoint_info, kpoint_setup, kp
|
|
PUBLIC :: get_kpoints_number
|
|
!
|
|
!
|
|
CONTAINS
|
|
!
|
|
! CP2K input section
|
|
!!>----------------------------------------------------------------------------!
|
|
!! SECTION: &kpoint... &end !
|
|
!! !
|
|
!! scheme [Gamma, Monkhorst-Pack, MacDonald, General] !
|
|
!! { nx ny nz } !
|
|
!! { nx ny nz sx sy sz } !
|
|
!! { nkpt x1 y1 z1 w1 ... xn yn zn wn } !
|
|
!! symmetry [on, off] !
|
|
!! wavefunction [real, complex] !
|
|
!! !
|
|
!!<----------------------------------------------------------------------------!
|
|
|
|
SUBROUTINE kpoint_setup(k_points, nkpt_in, nk1, nk2, nk3, k1, k2, k3, xk_in, weight_in)
|
|
IMPLICIT NONE
|
|
CHARACTER (len=80) :: k_points
|
|
INTEGER :: nk1, nk2, nk3
|
|
INTEGER :: k1, k2, k3
|
|
INTEGER :: nkpt_in
|
|
REAL (dbl) :: weight_in(:)
|
|
REAL (dbl) :: xk_in(:,:)
|
|
REAL (dbl) :: weight_sum
|
|
|
|
kp%scheme = 'gamma'
|
|
kp%symmetry = .FALSE.
|
|
kp%wfn_type = 0
|
|
|
|
IF( ALLOCATED( xk ) ) DEALLOCATE( xk )
|
|
IF( ALLOCATED( weight ) ) DEALLOCATE( weight )
|
|
|
|
IF( TRIM( k_points ) /= 'gamma' ) &
|
|
CALL errore( ' kpoint_setup ', ' only gamma is allowed for CP MD, use PW instead ', 1 )
|
|
|
|
! ... Kpoint type
|
|
SELECT CASE ( TRIM(k_points) )
|
|
CASE ( 'gamma', 'default' )
|
|
CASE ( 'automatic' )
|
|
CALL errore(' kpoint_setup ',' k_points = '//TRIM(k_points)//' not yet implemented ', 1 )
|
|
CASE ( 'tpiba' )
|
|
kp%scheme = 'general'
|
|
kp%symmetry = .FALSE.
|
|
kp%wfn_type = 1
|
|
CASE ( 'crystal' )
|
|
CALL errore(' kpoint_setup ',' k_points = '//TRIM(k_points)//' not yet implemented ', 1 )
|
|
CASE DEFAULT
|
|
CALL errore(' kpoint_setup ',' unknown k_points '//TRIM(k_points), 1 )
|
|
END SELECT
|
|
|
|
kp%nkpt = nkpt_in
|
|
kp%nk1 = nk1
|
|
kp%nk2 = nk2
|
|
kp%nk3 = nk3
|
|
kp%nk1 = k1
|
|
kp%nk2 = k2
|
|
kp%nk3 = k3
|
|
kp%shift = 0.0d0
|
|
kp%gamma_only = .FALSE.
|
|
|
|
SELECT CASE (kp%scheme)
|
|
CASE DEFAULT
|
|
CALL errore(' kpoint_setup ',' unknown Scheme '//TRIM(kp%scheme), 1)
|
|
CASE ('gamma')
|
|
kp%nkpt = 1
|
|
ALLOCATE( xk(3,1), weight(1) )
|
|
kp%xk => xk
|
|
kp%weight => weight
|
|
kp%xk = 0.0_dbl
|
|
kp%weight = 1.0_dbl
|
|
kp%gamma_only = .TRUE.
|
|
CASE ('monkhorst-pack')
|
|
kp%nk1 = nk1
|
|
kp%nk2 = nk2
|
|
kp%nk3 = nk3
|
|
CASE ('macdonald')
|
|
kp%nk1 = nk1
|
|
kp%nk2 = nk2
|
|
kp%nk3 = nk3
|
|
kp%shift = 0.0d0
|
|
CASE ('general')
|
|
kp%nkpt = nkpt_in
|
|
ALLOCATE( xk(3,SIZE(xk_in,2)), weight(SIZE(xk_in,2)) )
|
|
kp%xk => xk
|
|
kp%weight => weight
|
|
kp%xk = xk_in
|
|
! ... normalize and set k points weights
|
|
kp%weight = weight_in
|
|
weight_sum = sum(kp%weight)
|
|
kp%weight = kp%weight / weight_sum
|
|
END SELECT
|
|
RETURN
|
|
END SUBROUTINE kpoint_setup
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
SUBROUTINE kpoint_info(punit)
|
|
IMPLICIT NONE
|
|
INTEGER, INTENT (IN) :: punit
|
|
INTEGER :: i
|
|
|
|
WRITE (punit,*)
|
|
WRITE (punit,'(3X,A)') 'K points'
|
|
WRITE (punit,'(3X,A)') '--------'
|
|
IF (kp%scheme=='gamma') THEN
|
|
WRITE (punit,'(3X,A)') 'Gamma-point calculation'
|
|
WRITE (punit,'(3X,A)') 'Wavefunction type: REAL'
|
|
ELSE
|
|
WRITE (punit,'(3X,A,1X,A)') 'K-point scheme: ', adjustr(kp%scheme)
|
|
IF (kp%scheme=='monkhorst-pack') THEN
|
|
WRITE (punit,'(3X,A,3I5)') 'K-Point grid : ', kp%nk1, kp%nk2, kp%nk3
|
|
ELSE IF (kp%scheme=='macdonald') THEN
|
|
WRITE (punit,'(3X,A,3I5)') 'K-Point grid : ', kp%nk1, kp%nk2, kp%nk3
|
|
WRITE (punit,'(3X,A,3F10.4)') 'K-Point shift : ', kp%shift
|
|
END IF
|
|
IF (kp%symmetry) THEN
|
|
WRITE (punit,'(3X,A)') 'K-Point symmetry: ON'
|
|
ELSE
|
|
WRITE (punit,'(3X,A)') 'K-Point symmetry: OFF'
|
|
END IF
|
|
IF (kp%wfn_type==0) THEN
|
|
WRITE (punit,'(3X,A)') 'Wavefunction type: REAL'
|
|
ELSE
|
|
WRITE (punit,'(3X,A)') 'Wavefunction type: COMPLEX'
|
|
END IF
|
|
WRITE (punit,'(3X,A,I3)') 'Number of K-points: ', kp%nkpt
|
|
WRITE (punit,'(3X,A,T19,A,T37,A,T52,A,T67,A)') &
|
|
' Number ', 'Weight', 'X', 'Y', 'Z'
|
|
DO i = 1, kp%nkpt
|
|
WRITE (punit,'(3X,A,I5,3X,4F15.5)') &
|
|
' ', i, kp%weight(i), kp%xk(1,i), kp%xk(2,i), kp%xk(3,i)
|
|
END DO
|
|
END IF
|
|
END SUBROUTINE kpoint_info
|
|
|
|
!------------------------------------------------------------------------------!
|
|
|
|
SUBROUTINE brillouin_info(kp,punit)
|
|
IMPLICIT NONE
|
|
TYPE (kpoints), INTENT (IN) :: kp
|
|
INTEGER, INTENT (IN) :: punit
|
|
INTEGER :: i
|
|
|
|
IF (kp%scheme=='gamma') THEN
|
|
WRITE (punit,*)
|
|
WRITE (punit,'(A,T57,A)') ' BRILLOUIN|', ' Gamma-point calculation'
|
|
WRITE (punit,'(A,T76,A)') ' BRILLOUIN| Wavefunction type', ' REAL'
|
|
ELSE
|
|
WRITE (punit,*)
|
|
WRITE (punit,'(A,T61,A)') ' BRILLOUIN| K-point scheme ', &
|
|
adjustr(kp%scheme)
|
|
IF (kp%scheme=='monkhorst-pack') THEN
|
|
WRITE (punit,'(A,T66,3I5)') ' BRILLOUIN| K-Point grid', kp%nk1, kp%nk2, kp%nk3
|
|
ELSE IF (kp%scheme=='macdonald') THEN
|
|
WRITE (punit,'(A,T66,3I5)') ' BRILLOUIN| K-Point grid', kp%nk1, kp%nk2, kp%nk3
|
|
WRITE (punit,'(A,T51,3F10.4)') ' BRILLOUIN| K-Point shift', &
|
|
kp%shift
|
|
END IF
|
|
IF (kp%symmetry) THEN
|
|
WRITE (punit,'(A,T76,A)') ' BRILLOUIN| K-Point symmetry', ' ON'
|
|
ELSE
|
|
WRITE (punit,'(A,T76,A)') ' BRILLOUIN| K-Point symmetry', ' OFF'
|
|
END IF
|
|
IF (kp%wfn_type==0) THEN
|
|
WRITE (punit,'(A,T76,A)') ' BRILLOUIN| Wavefunction type', ' REAL'
|
|
ELSE
|
|
WRITE (punit,'(A,T73,A)') ' BRILLOUIN| Wavefunction type', &
|
|
' COMPLEX'
|
|
END IF
|
|
WRITE (punit,'(A,T71,I10)') ' BRILLOUIN| Number of K-points ', &
|
|
kp%nkpt
|
|
WRITE (punit,'(A,T30,A,T48,A,T63,A,T78,A)') ' BRILLOUIN| Number ', &
|
|
'Weight', 'X', 'Y', 'Z'
|
|
DO i = 1, kp%nkpt
|
|
WRITE (punit,'(A,I5,3X,4F15.5)') ' BRILLOUIN| ', i, kp%weight(i), &
|
|
kp%xk(1,i), kp%xk(2,i), kp%xk(3,i)
|
|
END DO
|
|
END IF
|
|
END SUBROUTINE brillouin_info
|
|
|
|
INTEGER FUNCTION get_kpoints_number()
|
|
get_kpoints_number = kp%nkpt
|
|
RETURN
|
|
END FUNCTION get_kpoints_number
|
|
|
|
!------------------------------------------------------------------------------!
|
|
END MODULE brillouin
|
|
!------------------------------------------------------------------------------!
|