LCOV - code coverage report
Current view: top level - fermi - make_tetra.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 33 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             :       MODULE m_maketetra
       2             :       CONTAINS
       3           0 :       SUBROUTINE make_tetra(
       4           0 :      >     nkpt,bk,ntria,itria,atr,
       5           0 :      <     ntetra,itetra,voltet)
       6             : C----------------------------------------------------------------
       7             : c     
       8             : c     Make tetrahedrons out of triangles; assume that layers of
       9             : c     k-points exist, that have been grouped to triangles in
      10             : c     subroutine fertri. Build prisms from them and cut each into
      11             : c     three tetrahedrons.
      12             : c     
      13             : c     bk(1-3,nk)    ... coordinates of k-point nk , nk = 1,nkpt
      14             : c     ntria         ... number of triangles per layer
      15             : c     itria(1-3,nt) ... index of k-points forming triangle nt
      16             : c     atr(nt)       ... area of triangle nt
      17             : c     
      18             : c     ntetra)       ... number of tetrahedrons
      19             : c     itetra(1-4,nt)... index of k-points forming tetrahedron nt
      20             : c     voltet(nt)    ... volume of tetrahedron nt
      21             : c     omega_bz      ... volume of irreducible part of BZ
      22             : c     
      23             : c     Note that the following assumes layers of equally distributed k-points !
      24             : c     
      25             : C----------------------------------------------------------------
      26             :       IMPLICIT NONE
      27             : 
      28             :       INTEGER, INTENT (IN)  :: nkpt,ntria
      29             :       INTEGER, INTENT (OUT) :: ntetra
      30             : 
      31             :       INTEGER, INTENT (IN)  :: itria(:,:) !(3,2*nkptd)
      32             :       REAL,    INTENT (IN)  :: atr(:) !(2*nkptd)
      33             :       REAL,    INTENT (IN)  :: bk(:,:) !(3,nkptd)
      34             :       INTEGER, INTENT (OUT) :: itetra(:,:) !(4,6*nkptd)
      35             :       REAL,    INTENT (OUT) :: voltet(:) !(6*nkpt)
      36             : 
      37             : 
      38             :       INTEGER ikpt,nkpp,itri,itet,ip1,ip2,ip3,ip4,ip5,ip6,i,ilay
      39             :       REAL h,h_thrd,tol,omega_bz
      40             : c     
      41             : c     determine distance between planes (h) and number of k-points per plane (nkpp)
      42             : c     
      43           0 :       tol = 1.0e-15
      44           0 :       DO ikpt = 2,nkpt
      45           0 :          h = abs(bk(3,ikpt)-bk(3,1))
      46           0 :          IF (h.GT.tol) EXIT
      47             :       ENDDO
      48           0 :       nkpp = ikpt - 1
      49           0 :       h_thrd = h / 3.0
      50             : c     
      51             : c     make tetrahedrons
      52             : c     
      53           0 :       ntetra = 0
      54           0 :       DO ilay = 0, (nkpt/nkpp)-2
      55           0 :          DO itri = 1,ntria
      56           0 :             ip1 = itria(1,itri) + nkpp*ilay ; ip4 = ip1 + nkpp
      57           0 :             ip2 = itria(2,itri) + nkpp*ilay ; ip5 = ip2 + nkpp
      58           0 :             ip3 = itria(3,itri) + nkpp*ilay ; ip6 = ip3 + nkpp
      59             : c     
      60           0 :             ntetra = ntetra + 1
      61           0 :             itetra(1,ntetra) = ip1 ; itetra(2,ntetra) = ip2
      62           0 :             itetra(3,ntetra) = ip3 ; itetra(4,ntetra) = ip4
      63           0 :             voltet(ntetra) = h_thrd * atr(itri)
      64             : c     
      65           0 :             ntetra = ntetra + 1
      66           0 :             itetra(1,ntetra) = ip4 ; itetra(2,ntetra) = ip5
      67           0 :             itetra(3,ntetra) = ip6 ; itetra(4,ntetra) = ip2
      68           0 :             voltet(ntetra) = h_thrd * atr(itri)
      69             : c     
      70           0 :             ntetra = ntetra + 1
      71           0 :             itetra(1,ntetra) = ip2 ; itetra(2,ntetra) = ip3
      72           0 :             itetra(3,ntetra) = ip4 ; itetra(4,ntetra) = ip6
      73           0 :             voltet(ntetra) = h_thrd * atr(itri)
      74             : c     
      75             :          ENDDO
      76             :       ENDDO
      77             : 
      78           0 :       omega_bz = 0.0
      79           0 :       DO itet = 1,ntetra
      80           0 :          omega_bz = omega_bz + voltet(itet)
      81             :       ENDDO
      82           0 :       DO itet = 1,ntetra
      83           0 :          voltet(itet) =  voltet(itet) /omega_bz
      84             :       ENDDO
      85             : 
      86           0 :       RETURN
      87             :       END SUBROUTINE make_tetra
      88             :       END MODULE m_maketetra

Generated by: LCOV version 1.13