LCOV - code coverage report
Current view: top level - init - bandstr1.F (source / functions) Hit Total Coverage
Test: combined.info Lines: 86 294 29.3 %
Date: 2019-09-08 04:53:50 Functions: 3 3 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       MODULE m_bandstr1
       8             :       use m_juDFT
       9             :       USE m_types
      10             :       use m_unfold_band_kpts
      11             : !----------------------------------------------------------------------
      12             : !----------------------------------------------------------------------
      13             :       CONTAINS
      14           1 :       SUBROUTINE bandstr1(
      15             :      >               idsyst,idtype,bmat,kpts,input,l_fillArrays,banddos)
      16             :       IMPLICIT NONE
      17             : 
      18             :       TYPE(t_input),INTENT(IN) :: input
      19             :       TYPE(t_kpts),INTENT(INOUT)  :: kpts
      20             : 
      21             :       INTEGER, INTENT (IN)  :: idsyst,idtype
      22             :       REAL,    INTENT (IN)  :: bmat(3,3)
      23             :       LOGICAL, INTENT (IN)  :: l_fillArrays
      24             :       TYPE(t_banddos),INTENT(IN)  :: banddos
      25             : 
      26             :       REAL, POINTER             :: syp(:,:) 
      27             :       CHARACTER(len=1), POINTER :: ssy(:)
      28           2 :       REAL,    ALLOCATABLE      :: rsyp(:,:),del(:),d(:)
      29           1 :       REAL,    ALLOCATABLE      :: bkTemp(:,:)
      30           1 :       INTEGER, ALLOCATABLE      :: nk(:)
      31             :       INTEGER nosyp,i,j,n,ntot
      32             :       REAL dk(3),syp1(3),rsyp1(3)
      33             : 
      34             :       CALL get_points(
      35             :      >                input%film,idsyst,idtype,bmat,kpts,
      36           1 :      <                nosyp,syp,ssy)
      37             : !
      38             : ! --> transform to cartesian units
      39             : !
      40           1 :       ALLOCATE ( rsyp(3,nosyp),del(nosyp),d(nosyp),nk(nosyp) ) 
      41           5 :       DO i = 1,nosyp
      42           2 :         syp1(:) = syp(:,i)
      43             :         !CALL cotra3(syp1,rsyp1,bmat)
      44           2 :         rsyp1=matmul(syp1,bmat)
      45           3 :         rsyp(:,i) = rsyp1(:)
      46             :       ENDDO
      47             : !
      48             : ! --> calculate length between points
      49             : !
      50           1 :       d(1) = 0.0
      51           2 :       DO i = 2,nosyp
      52             :         del(i) = ( rsyp(1,i) - rsyp(1,i-1) )**2 +
      53             :      +           ( rsyp(2,i) - rsyp(2,i-1) )**2 +
      54           1 :      +           ( rsyp(3,i) - rsyp(3,i-1) )**2
      55           1 :         del(i) = sqrt(del(i))
      56           2 :         d(i) = d(i-1) + del(i)
      57             :       ENDDO
      58             : !
      59             : ! --> distibute points evenly
      60             : !
      61             :       ntot = nosyp
      62           3 :       DO i = 2,nosyp
      63           1 :         nk(i) = NINT ( (kpts%nkpt-nosyp)*( del(i) / d(nosyp) ) )
      64           2 :         ntot = ntot + nk(i)
      65             :       ENDDO
      66           1 :       kpts%nkpt = ntot
      67             : 
      68           1 :       ALLOCATE (bkTemp(3,kpts%nkpt))
      69           1 :       ALLOCATE (kpts%specialPointIndices(kpts%numSpecialPoints))
      70             : !
      71             : ! --> generate k-points mesh 
      72             : !
      73           1 :       n = 1
      74           2 :       DO i = 2,nosyp
      75           1 :          dk(1) = ( syp(1,i) - syp(1,i-1) ) / (nk(i)+1)
      76           1 :          dk(2) = ( syp(2,i) - syp(2,i-1) ) / (nk(i)+1)
      77           1 :          dk(3) = ( syp(3,i) - syp(3,i-1) ) / (nk(i)+1)
      78           1 :          bkTemp(:,n) = syp(:,i-1)
      79           1 :          kpts%specialPointIndices(i-1) = n
      80           1 :          n = n + 1
      81          20 :          DO j = 1, nk(i)
      82          18 :             bkTemp(:,n) = bkTemp(:,n-1) + dk(:)
      83          19 :             n = n + 1
      84             :          ENDDO
      85             :       ENDDO
      86           1 :       bkTemp(:,n) = syp(:,nosyp)
      87           1 :       kpts%specialPointIndices(nosyp) = n
      88             :       kpts%nkpt = kpts%nkpt
      89           1 :       kpts%posScale = 1.0
      90             : 
      91           1 :       IF(l_fillArrays) THEN
      92           1 :          IF(ALLOCATED(kpts%bk)) THEN
      93           1 :             DEALLOCATE(kpts%bk)
      94             :          END IF
      95           1 :          IF(ALLOCATED(kpts%wtkpt)) THEN
      96           1 :             DEALLOCATE(kpts%wtkpt)
      97             :          END IF
      98           1 :          ALLOCATE (kpts%bk(3,kpts%nkpt), kpts%wtkpt(kpts%nkpt))
      99          21 :          kpts%bk(:,:) = bkTemp(:,:)
     100          21 :          kpts%wtkpt = 1.0
     101             :       ELSE
     102           0 :          OPEN (41,file='kpts',form='formatted',status='new')
     103           0 :          IF (.NOT.input%film) THEN
     104           0 :             WRITE(41,'(i5,f20.10)') kpts%nkpt,kpts%posScale
     105           0 :             DO n = 1, kpts%nkpt
     106           0 :                WRITE (41,'(4f10.5)') bkTemp(:,n),1.0
     107             :             ENDDO
     108             :          ELSE
     109           0 :            WRITE(41,'(i5,f20.10,3x,l1)') kpts%nkpt,kpts%posScale,.false.
     110           0 :            DO n = 1, kpts%nkpt
     111           0 :               WRITE (41,'(3f10.5)') bkTemp(1:2,n),1.0
     112             :            ENDDO
     113             :          END IF
     114           0 :          CLOSE (41)
     115             :       END IF
     116             : 
     117           1 :       IF (banddos%unfoldband) THEN
     118             :           CALL write_gnu_sc(
     119           0 :      >               nosyp,d,ssy,input)  
     120             :       ELSE
     121             :           CALL write_gnu(
     122           1 :      >               nosyp,d,ssy,input)
     123             :       END IF
     124           1 :       DEALLOCATE ( rsyp,syp,del,nk,ssy,d,bkTemp )
     125             : 
     126           1 :       END SUBROUTINE bandstr1
     127             : !----------------------------------------------------------------------
     128             : ! once the file "bands.1" and "bands.2" are created, activate with:
     129             : ! gnuplot < band.gnu > band.ps
     130             : !----------------------------------------------------------------------
     131           1 :       SUBROUTINE write_gnu(
     132           1 :      >                     nosyp,d,ssy,input)
     133             : !
     134             :       IMPLICIT NONE
     135             : 
     136             :       TYPE(t_input),INTENT(IN) :: input
     137             :       INTEGER, INTENT (IN) :: nosyp
     138             :       REAL,    INTENT (IN) :: d(nosyp)
     139             :       CHARACTER(len=1), INTENT (IN) :: ssy(nosyp)
     140             :       
     141             :       INTEGER n,aoff,adel
     142             :       CHARACTER(LEN=200) tempTitle
     143           1 :       aoff = iachar('a')-1
     144           1 :       adel = iachar('a')-iachar('A')
     145             :       !write(*,*) aoff,adel 
     146             : 
     147           1 :       OPEN (27,file='band.gnu',status='unknown')
     148           1 :       WRITE (27,900)
     149           1 :       WRITE (27,901)
     150           1 :       WRITE (27,902)
     151           1 :       WRITE (27,903)
     152           1 :       WRITE(tempTitle,'(10a)') input%comment
     153           1 :       IF(TRIM(ADJUSTL(tempTitle)).EQ.'') THEN
     154           0 :          tempTitle = "Fleur Bandstructure"
     155             :       END IF
     156           1 :       WRITE (27,904) TRIM(ADJUSTL(tempTitle))
     157           3 :       DO n = 1, nosyp
     158           3 :         WRITE (27,905) d(n),d(n)
     159             :       ENDDO
     160           1 :       WRITE (27,906) d(1),d(nosyp)
     161             : !
     162             : ! nomal labels
     163             : !
     164           1 :       IF (iachar(ssy(1)) < aoff ) THEN
     165           1 :         WRITE (27,907) ssy(1),d(1),achar(92)
     166             :       ELSE
     167           0 :         WRITE (27,907) " ",d(1),achar(92)
     168             :       ENDIF
     169           1 :       DO n = 2, nosyp-1
     170           1 :         IF (iachar(ssy(n)) < aoff ) THEN 
     171           0 :           WRITE (27,908) ssy(n),d(n),achar(92)
     172             :         ELSE
     173           0 :           WRITE (27,908) " ",d(n),achar(92)
     174             :         ENDIF
     175             :       ENDDO
     176           1 :       IF (iachar(ssy(nosyp)) < aoff ) THEN
     177           1 :         WRITE (27,909) ssy(nosyp),d(nosyp)
     178             :       ELSE
     179           0 :         WRITE (27,909) " ",d(nosyp)
     180             :       ENDIF
     181             : !
     182             : ! greek labels
     183             : !
     184           3 :       DO n = 1, nosyp
     185           3 :         IF (iachar(ssy(n)) > aoff ) THEN
     186           0 :           WRITE (27,914) achar(iachar(ssy(n))-adel),d(n)
     187             :         ENDIF
     188             :       ENDDO
     189             : !
     190             : ! now write the rest
     191             : !
     192           1 :       WRITE (27,910) 
     193           1 :       WRITE (27,911) d(nosyp)+0.00001,achar(92)
     194           1 :       IF (input%jspins == 2) WRITE (27,912) achar(92)
     195           1 :       WRITE (27,913)
     196           1 :       CLOSE (27)
     197             : 
     198             :  900  FORMAT ('set terminal postscript enhanced color "Times-Roman" 20')
     199             :  901  FORMAT ('set xlabel ""')
     200             :  902  FORMAT ('set ylabel "E - E_F (eV)"')
     201             :  903  FORMAT ('set nokey')
     202             :  904  FORMAT ('set title "',a,'"')
     203             :  905  FORMAT ('set arrow from',f9.5,', -9.0 to',f9.5,',  5.0 nohead')
     204             :  906  FORMAT ('set arrow from',f9.5,', 0.0 to',f9.5,', 0.0 nohead lt 3')
     205             :  907  FORMAT ('set xtics ("',a1,'"',f9.5,', ',a)
     206             :  908  FORMAT ('           "',a1,'"',f9.5,', ',a)
     207             :  909  FORMAT ('           "',a1,'"',f9.5,'  )')
     208             :  910  FORMAT ('set ytics -8,2,4')
     209             :  911  FORMAT ('plot [0:',f9.5,'] [-9:5] ',a)
     210             :  912  FORMAT ('"bands.2" using 1:($2+0.00) w p pt 12 ps 0.5,',a)
     211             :  913  FORMAT ('"bands.1" using 1:($2+0.00)  w p pt  7 ps 0.5')
     212             :  914  FORMAT ('set label "',a1,'" at ',f9.5,
     213             :      +        ', -9.65 center font "Symbol,20"')
     214             : 
     215           1 :       END SUBROUTINE write_gnu
     216             : !----------------------------------------------------------------------
     217             : ! given a bravais-lattice, determine <nosyp> symmetry points (syp)
     218             : ! and their names (lowercase = greek)
     219             : !----------------------------------------------------------------------
     220           1 :       SUBROUTINE get_points(
     221             :      >                      l_film,idsyst,idtype,bmat,kpts,
     222             :      <                      nosyp,syp,ssy)
     223             : 
     224             :       IMPLICIT NONE
     225             : 
     226             :       TYPE(t_kpts),INTENT (INOUT)  :: kpts
     227             :       LOGICAL,     INTENT (IN)     :: l_film
     228             :       INTEGER,     INTENT (IN)     :: idsyst,idtype
     229             :       REAL,        INTENT (IN)     :: bmat(3,3)
     230             :       INTEGER,     INTENT (OUT)    :: nosyp
     231             :       REAL,             POINTER    :: syp(:,:)  ! actually intent out
     232             :       CHARACTER(len=1), POINTER    :: ssy(:)
     233             : 
     234             :       LOGICAL         :: band_inp_file
     235             :       INTEGER         :: n
     236             :       REAL, PARAMETER :: f12 = 1./2., f14 = 1./4., zro = 0.0
     237             :       REAL, PARAMETER :: f34 = 3./4., f38 = 3./8., one = 1.0
     238             :       REAL, PARAMETER :: f13 = 1./3., f23 = 2./3.
     239             : 
     240             :       !Check if band_inp file exists for lines
     241           1 :       INQUIRE(file ="band_inp",exist= band_inp_file)
     242           1 :       IF (band_inp_file) THEN
     243           0 :          OPEN(99,file ="band_inp",status ="old")
     244           0 :          nosyp=0
     245             :          !count the lines
     246             :          DO
     247           0 :             READ(99,*,END = 100)
     248           0 :             nosyp=nosyp+1
     249             :          ENDDO
     250           0 :  100     REWIND 99
     251           0 :          ALLOCATE(syp(3,nosyp),ssy(nosyp) )
     252           0 :          DO n = 1,nosyp
     253           0 :             READ(99,*,err = 110,END=110) ssy(n),syp(:,n)
     254             :          ENDDO
     255           0 :          CLOSE(99)
     256             : 
     257           0 :          IF(nosyp.GE.2) THEN
     258           0 :             kpts%numSpecialPoints = nosyp
     259           0 :             IF (ALLOCATED(kpts%specialPoints)) THEN
     260           0 :                DEALLOCATE (kpts%specialPoints)
     261             :             END IF
     262           0 :             IF (ALLOCATED(kpts%specialPointNames)) THEN
     263           0 :                DEALLOCATE (kpts%specialPointNames)
     264             :             END IF
     265           0 :             ALLOCATE (kpts%specialPoints(3,kpts%numSpecialPoints))
     266           0 :             ALLOCATE (kpts%specialPointNames(kpts%numSpecialPoints))
     267           0 :             DO n = 1, kpts%numSpecialPoints
     268           0 :                kpts%specialPointNames(n) = TRIM(ADJUSTL(ssy(n)))
     269           0 :                kpts%specialPoints(:,n) = syp(:,n)
     270             :             END DO
     271             :          END IF
     272             : 
     273           1 :          RETURN
     274           0 :  110     WRITE(*,*) "Error reading band_inp file"
     275           0 :           CALL juDFT_error("Bandstr1",calledby="bandstr1")
     276             :       ENDIF
     277             : 
     278           1 :       IF(kpts%numSpecialPoints.GE.2) THEN
     279           1 :          nosyp = kpts%numSpecialPoints
     280           1 :          ALLOCATE(syp(3,nosyp),ssy(nosyp) )
     281           3 :          DO n = 1, nosyp
     282           2 :             ssy(n) = TRIM(ADJUSTL(kpts%specialPointNames(n)))
     283           3 :             syp(:,n) = kpts%specialPoints(:,n)
     284             :          END DO
     285             :          RETURN
     286             :       END IF
     287             : 
     288             :       !No band_inp file -> determine default lines for bandstructure
     289             :       !write(*,*) idsyst,idtype
     290           0 :       nosyp = -1
     291           0 :       IF (.NOT.l_film) THEN
     292           0 :          IF ( (idsyst == 1).AND.(idtype ==  3) ) THEN       ! fcc
     293           0 :             nosyp = 7
     294           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     295           0 :             syp(:,1) = (/f12,f12,one/)  ; ssy(1) = "X"
     296           0 :             syp(:,2) = (/f38,f38,f34/)  ; ssy(2) = "K"
     297           0 :             syp(:,3) = (/zro,zro,zro/)  ; ssy(3) = "g"
     298           0 :             syp(:,4) = (/f12,f12,f12/)  ; ssy(4) = "L"
     299           0 :             syp(:,5) = (/f12,f14,f34/)  ; ssy(5) = "W"
     300           0 :             syp(:,6) = (/f12,zro,f12/)  ; ssy(6) = "X"
     301           0 :             syp(:,7) = (/zro,zro,zro/)  ; ssy(7) = "g"
     302             :          ENDIF
     303           0 :          IF ( (idsyst == 5).AND.(idtype ==  1) ) THEN       ! rhombohedric (trigonal)
     304           0 :             nosyp = 8
     305           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     306           0 :             syp(:,1) = (/f12,f12, f12/)  ; ssy(1) = "Z"
     307           0 :             syp(:,2) = (/zro,zro, zro/)  ; ssy(2) = "g"
     308           0 :             syp(:,3) = (/f14,f14,-f14/)  ; ssy(3) = "K"
     309           0 :             syp(:,4) = (/f12,f12,-f12/)  ; ssy(4) = "Z"
     310           0 :             syp(:,5) = (/f14,f12,-f14/)  ; ssy(5) = "W"
     311           0 :             syp(:,6) = (/zro,f12, zro/)  ; ssy(6) = "L"
     312           0 :             syp(:,7) = (/zro,zro, zro/)  ; ssy(7) = "g"
     313           0 :             syp(:,8) = (/f12,f12, zro/)  ; ssy(8) = "F"
     314             :          ENDIF
     315           0 :          IF ( (idsyst == 4).AND.(idtype ==  1) ) THEN       ! hexagonal
     316           0 :             nosyp = 8
     317           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     318           0 :             IF (bmat(1,1)*bmat(2,1)+bmat(1,2)*bmat(2,2) > 0.0) THEN
     319           0 :                syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"
     320           0 :                syp(:,2) = (/zro,f12, zro/)  ; ssy(2) = "M"
     321           0 :                syp(:,3) = (/f13,f13, zro/)  ; ssy(3) = "K"
     322           0 :                syp(:,4) = (/zro,zro, zro/)  ; ssy(4) = "g"
     323           0 :                syp(:,5) = (/zro,zro, f12/)  ; ssy(5) = "A"
     324           0 :                syp(:,6) = (/zro,f12, f12/)  ; ssy(6) = "L"
     325           0 :                syp(:,7) = (/f13,f13, f12/)  ; ssy(7) = "H"
     326           0 :                syp(:,8) = (/zro,zro, f12/)  ; ssy(8) = "A"
     327             :             ELSE                                             ! hexagonal (angle = 60)
     328           0 :                syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"
     329           0 :                syp(:,2) = (/f12,f12, zro/)  ; ssy(2) = "M"
     330           0 :                syp(:,3) = (/f13,f23, zro/)  ; ssy(3) = "K"
     331           0 :                syp(:,4) = (/zro,zro, zro/)  ; ssy(4) = "g"
     332           0 :                syp(:,5) = (/zro,zro, f12/)  ; ssy(5) = "A"
     333           0 :                syp(:,6) = (/f12,f12, f12/)  ; ssy(6) = "L"
     334           0 :                syp(:,7) = (/f13,f23, f12/)  ; ssy(7) = "H"
     335           0 :                syp(:,8) = (/zro,zro, f12/)  ; ssy(8) = "A"
     336             :             ENDIF
     337             :          ENDIF
     338           0 :          IF ( (idsyst == 1).AND.(idtype ==  1) ) THEN       ! simple cubic
     339           0 :             nosyp = 8
     340           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     341           0 :             syp(:,1) = (/f12,f12, zro/)  ; ssy(1) = "M"
     342           0 :             syp(:,2) = (/zro,zro, zro/)  ; ssy(2) = "g"
     343           0 :             syp(:,3) = (/f12,zro, zro/)  ; ssy(3) = "X"
     344           0 :             syp(:,4) = (/f12,f12, zro/)  ; ssy(4) = "M"
     345           0 :             syp(:,5) = (/f12,f12, f12/)  ; ssy(5) = "R"
     346           0 :             syp(:,6) = (/f12,zro, zro/)  ; ssy(6) = "X"
     347           0 :             syp(:,7) = (/zro,zro, zro/)  ; ssy(7) = "g"
     348           0 :             syp(:,8) = (/f12,f12, f12/)  ; ssy(8) = "R"
     349             :          ENDIF
     350           0 :          IF ( (idsyst == 1).AND.(idtype ==  2) ) THEN       ! body centered cubic
     351           0 :             nosyp = 6
     352           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     353           0 :             syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"
     354           0 :             syp(:,2) = (/f12,-f12,f12/)  ; ssy(2) = "H"
     355           0 :             syp(:,3) = (/zro,zro, f12/)  ; ssy(3) = "N"
     356           0 :             syp(:,4) = (/f14,f14, f14/)  ; ssy(4) = "P"
     357           0 :             syp(:,5) = (/zro,zro, zro/)  ; ssy(5) = "g"
     358           0 :             syp(:,6) = (/zro,zro, f12/)  ; ssy(6) = "N"
     359             :          ENDIF
     360           0 :          IF ( (idsyst == 2).AND.(idtype ==  2) ) THEN       ! body centered tetragonal (a > c)
     361           0 :             nosyp = 8
     362           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     363           0 :             syp(:,1) = (/f12,f12,-f12/)  ; ssy(1) = "Z"    ! via Lambda and V
     364           0 :             syp(:,2) = (/zro,zro, zro/)  ; ssy(2) = "g"    ! via Sigma
     365           0 :             syp(:,3) = (/-f12,f12,f12/)  ; ssy(3) = "Z"    ! via Y
     366           0 :             syp(:,4) = (/zro,zro, f12/)  ; ssy(4) = "X"    ! via Delta
     367           0 :             syp(:,5) = (/zro,zro, zro/)  ; ssy(5) = "g"    
     368           0 :             syp(:,6) = (/zro,f12, zro/)  ; ssy(6) = "N"    ! via Q
     369           0 :             syp(:,7) = (/f14,f14, f14/)  ; ssy(7) = "P"    ! via W
     370           0 :             syp(:,8) = (/zro,zro, f12/)  ; ssy(8) = "X"
     371             :          ENDIF
     372           0 :          IF ( (idsyst == 2).AND.(idtype ==  2) ) THEN       ! body centered tetragonal (a < c)
     373           0 :             nosyp = 9
     374           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     375           0 :             syp(:,1) = (/-f12,f12,f12/)  ; ssy(1) = "Z"    ! via F and Sigma
     376           0 :             syp(:,2) = (/zro,zro, zro/)  ; ssy(2) = "g"    ! via Delta
     377           0 :             syp(:,3) = (/zro,zro, f12/)  ; ssy(3) = "X"    ! via W
     378           0 :             syp(:,4) = (/f14,f14, f14/)  ; ssy(4) = "P"    ! via Q
     379           0 :             syp(:,5) = (/zro,f12, zro/)  ; ssy(5) = "N"     
     380           0 :             syp(:,6) = (/zro,zro, zro/)  ; ssy(6) = "g"    ! via Lambda
     381           0 :             syp(:,7) = (/f12,f12,-f12/)  ; ssy(7) = "Z"    ! via U and Y
     382           0 :             syp(:,8) = (/f12,f12, zro/)  ; ssy(8) = "X"
     383           0 :             syp(:,9) = (/f14,f14, f14/)  ; ssy(9) = "P"
     384             :          ENDIF
     385           0 :          IF ( (idsyst == 2).AND.(idtype ==  1) ) THEN       ! primitive tetragonal (a < c)
     386           0 :             nosyp = 8
     387           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     388           0 :             syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"    ! via Delta
     389           0 :             syp(:,2) = (/f12,zro, zro/)  ; ssy(2) = "X"    ! via Y
     390           0 :             syp(:,3) = (/f12,f12, zro/)  ; ssy(3) = "M"    ! via Sigma
     391           0 :             syp(:,4) = (/zro,zro, zro/)  ; ssy(4) = "g"    ! via Lambda
     392           0 :             syp(:,5) = (/zro,zro, f12/)  ; ssy(5) = "Z"    ! via U
     393           0 :             syp(:,6) = (/f12,zro, f12/)  ; ssy(6) = "R"    ! via T
     394           0 :             syp(:,7) = (/f12,f12, f12/)  ; ssy(7) = "A"    ! via S
     395           0 :             syp(:,8) = (/zro,zro, f12/)  ; ssy(8) = "Z"
     396             :          ENDIF
     397           0 :          IF ( (idsyst == 3).AND.(idtype ==  1) ) THEN       ! primitive tetragonal (a < c)
     398           0 :             nosyp = 10
     399           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     400           0 :             syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"    ! via Sigma
     401           0 :             syp(:,2) = (/f12,zro, zro/)  ; ssy(2) = "X"    ! via D
     402           0 :             syp(:,3) = (/f12,f12, zro/)  ; ssy(3) = "S"    ! via C
     403           0 :             syp(:,4) = (/zro,f12, zro/)  ; ssy(4) = "Y"    ! via Delta
     404           0 :             syp(:,5) = (/zro,zro, zro/)  ; ssy(5) = "g"    ! via Lambda
     405           0 :             syp(:,6) = (/zro,zro, f12/)  ; ssy(6) = "Z"    ! via A
     406           0 :             syp(:,7) = (/f12,zro, f12/)  ; ssy(7) = "U"    ! via P
     407           0 :             syp(:,8) = (/f12,f12, f12/)  ; ssy(8) = "R"    ! via E
     408           0 :             syp(:,9) = (/zro,f12, f12/)  ; ssy(8) = "T"    ! via B
     409           0 :             syp(:,10)= (/zro,zro, f12/)  ; ssy(8) = "Z"
     410             :          ENDIF
     411             :       ELSE
     412           0 :          WRITE(*,*) 'Note:'
     413           0 :          WRITE(*,*) 'Default k point paths for film band structures'
     414           0 :          WRITE(*,*) 'are experimental. If the generated k point path'
     415           0 :          WRITE(*,*) 'is not correct please specify it directly.'
     416           0 :          IF ( (idsyst == 5).AND.(idtype ==  1) ) THEN       ! rhombohedric (trigonal)
     417           0 :             nosyp = 3
     418           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     419           0 :             syp(:,6) = (/zro,f12, zro/)  ; ssy(6) = "L"
     420           0 :             syp(:,7) = (/zro,zro, zro/)  ; ssy(7) = "g"
     421           0 :             syp(:,8) = (/f12,f12, zro/)  ; ssy(8) = "F"
     422             :          ENDIF
     423           0 :          IF ( (idsyst == 4).AND.(idtype ==  1) ) THEN       ! hexagonal
     424           0 :             nosyp = 4
     425           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     426           0 :             IF (bmat(1,1)*bmat(2,1)+bmat(1,2)*bmat(2,2) > 0.0) THEN
     427           0 :                syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"
     428           0 :                syp(:,2) = (/zro,f12, zro/)  ; ssy(2) = "M"
     429           0 :                syp(:,3) = (/f13,f13, zro/)  ; ssy(3) = "K"
     430           0 :                syp(:,4) = (/zro,zro, zro/)  ; ssy(4) = "g"
     431             : 
     432             :             ELSE                                             ! hexagonal (angle = 60)
     433           0 :                syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"
     434           0 :                syp(:,2) = (/f12,f12, zro/)  ; ssy(2) = "M"
     435           0 :                syp(:,3) = (/f13,f23, zro/)  ; ssy(3) = "K"
     436           0 :                syp(:,4) = (/zro,zro, zro/)  ; ssy(4) = "g"
     437             :             ENDIF
     438             :          ENDIF
     439           0 :          IF ( (idsyst == 1).AND.(idtype ==  1) ) THEN       ! simple cubic
     440           0 :             nosyp = 4
     441           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     442           0 :             syp(:,1) = (/f12,f12, zro/)  ; ssy(1) = "M"
     443           0 :             syp(:,2) = (/zro,zro, zro/)  ; ssy(2) = "g"
     444           0 :             syp(:,3) = (/f12,zro, zro/)  ; ssy(3) = "X"
     445           0 :             syp(:,4) = (/f12,f12, zro/)  ; ssy(4) = "M"
     446             :          ENDIF
     447           0 :          IF ( (idsyst == 2).AND.(idtype ==  1) ) THEN       ! primitive tetragonal (a < c)
     448           0 :             nosyp = 4
     449           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     450           0 :             syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"    ! via Delta
     451           0 :             syp(:,2) = (/f12,zro, zro/)  ; ssy(2) = "X"    ! via Y
     452           0 :             syp(:,3) = (/f12,f12, zro/)  ; ssy(3) = "M"    ! via Sigma
     453           0 :             syp(:,4) = (/zro,zro, zro/)  ; ssy(4) = "g"    ! via Lambda
     454             :          ENDIF
     455           0 :          IF ( (idsyst == 3).AND.(idtype ==  1) ) THEN       ! primitive tetragonal (a < c)
     456           0 :             nosyp = 5
     457           0 :             ALLOCATE ( syp(3,nosyp),ssy(nosyp) )
     458           0 :             syp(:,1) = (/zro,zro, zro/)  ; ssy(1) = "g"    ! via Sigma
     459           0 :             syp(:,2) = (/f12,zro, zro/)  ; ssy(2) = "X"    ! via D
     460           0 :             syp(:,3) = (/f12,f12, zro/)  ; ssy(3) = "S"    ! via C
     461           0 :             syp(:,4) = (/zro,f12, zro/)  ; ssy(4) = "Y"    ! via Delta
     462           0 :             syp(:,5) = (/zro,zro, zro/)  ; ssy(5) = "g"    ! via Lambda
     463             :          ENDIF
     464             :       END IF
     465             : 
     466           0 :       IF(nosyp.GE.2) THEN
     467           0 :          kpts%numSpecialPoints = nosyp
     468           0 :          IF (ALLOCATED(kpts%specialPoints)) THEN
     469           0 :             DEALLOCATE (kpts%specialPoints)
     470             :          END IF
     471           0 :          IF (ALLOCATED(kpts%specialPointNames)) THEN
     472           0 :             DEALLOCATE (kpts%specialPointNames)
     473             :          END IF
     474           0 :          ALLOCATE (kpts%specialPoints(3,kpts%numSpecialPoints))
     475           0 :          ALLOCATE (kpts%specialPointNames(kpts%numSpecialPoints))
     476           0 :          DO n = 1, kpts%numSpecialPoints
     477           0 :             kpts%specialPointNames(n) = TRIM(ADJUSTL(ssy(n)))
     478           0 :             kpts%specialPoints(:,n) = syp(:,n)
     479             :          END DO
     480             :       END IF
     481             : 
     482           0 :       IF (nosyp == -1) THEN
     483           0 :          WRITE(*,*) 'l_film = ', l_film
     484           0 :          WRITE(*,*) 'idsyst = ', idsyst
     485           0 :          WRITE(*,*) 'idtype = ', idtype
     486             :          CALL juDFT_error
     487             :      +   ("band structure path for lattice not implemented",
     488           0 :      +   calledby ="bandstr1")
     489             :       END IF
     490             : 
     491             :       END SUBROUTINE get_points
     492             : !----------------------------------------------------------------------
     493             :       END MODULE m_bandstr1

Generated by: LCOV version 1.13