bs_comfort.F 1.88 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2017 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! 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.
!--------------------------------------------------------------------------------

7 8 9 10
      MODULE m_bs_comfort

      CONTAINS

11
      SUBROUTINE bs_comfort(eig_id,DIMENSION,input,noco,nkpt,param)
12

13 14
      USE m_types
      USE m_eig66_io, ONLY : read_eig
15 16

      IMPLICIT NONE
17

18
      TYPE(t_dimension), INTENT(IN)   :: DIMENSION
19 20 21
      TYPE(t_input),     INTENT(IN)   :: input
      TYPE(t_noco),      INTENT(IN)   :: noco

22
C     .. Scalar Arguments ..
23 24 25
      INTEGER, INTENT (IN) :: eig_id
      INTEGER, INTENT (IN) :: nkpt
      INTEGER, INTENT (IN) :: param
26 27

C     .. Local Scalars ..
28
      INTEGER              :: i, jsp, k, nspins
29

30 31
C     .. Local Arrays ..
      REAL,    ALLOCATABLE :: eig(:,:,:)
32
      INTEGER, ALLOCATABLE :: ne(:,:)
33 34

c---> pk non-collinear
35
      IF (noco%l_noco) THEN
36 37
         nspins = 1
      ELSE
38
         nspins = input%jspins
39 40 41
      ENDIF
c---> pk non-collinear

42 43
      ALLOCATE (eig(DIMENSION%neigd,nkpt,nspins))
      ALLOCATE (ne(nkpt,nspins))
44

45 46 47 48
      DO jsp = 1, nspins
         DO k = 1, nkpt
            CALL read_eig(eig_id,k,jsp,neig=ne(k,jsp),eig=eig(:,k,jsp))
         END DO ! k = 1,nkpt
49

50 51 52 53 54 55
         DO i = 1, DIMENSION%neigd
            DO k = 1, nkpt
               WRITE(776+jsp,*) param,k,eig(i,k,jsp)
            END DO
            WRITE(776+jsp,*)
         END DO
56

57 58 59 60 61 62 63
         DO i = 1, DIMENSION%neigd
            DO k = 1, nkpt
               IF (k.eq.param) WRITE(778+jsp,*) param,k,eig(i,k,jsp)
            END DO
            WRITE(778+jsp,*)
         END DO
      END DO ! jsp = 1,nspins
64

65
      DEALLOCATE (ne,eig)
66 67 68

      END SUBROUTINE bs_comfort
      END MODULE m_bs_comfort