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

          Line data    Source code
       1             :       MODULE m_ptdos
       2             : !-------------------------------------------------------------------------
       3             : ! Density of states calculated by linear triangular method
       4             : !-------------------------------------------------------------------------
       5             :       CONTAINS
       6           0 :       SUBROUTINE ptdos(
       7           0 :      >                 emin,emax,jspins,ne,ndos,ntb,ntria,as,atr,ntriad,
       8           0 :      >                 itria,nkpt,ev,qal,e,
       9           0 :      <                 g)
      10             :       IMPLICIT NONE
      11             : c
      12             : c .. Arguments
      13             :       INTEGER, INTENT (IN) :: ne,ntria,jspins,ntriad,ndos,ntb,nkpt
      14             :       INTEGER, INTENT (IN) :: itria(3,ntriad)
      15             :       REAL,    INTENT (IN) :: emax,emin,as
      16             :       REAL,    INTENT (IN) :: atr(ntriad),qal(ndos,ntb,nkpt)
      17             :       REAL,    INTENT (IN) :: e(ne),ev(ntb,nkpt)
      18             :       REAL,    INTENT (OUT):: g(ne,ndos)
      19             : c
      20             : c .. Locals
      21             :       INTEGER :: i, j, nl, nb, n, nt(3), nc(4)
      22             :       REAL    :: f, fa, ec(4)
      23             : c
      24             : c     calculate partial densities of states
      25             : c
      26           0 :       f = 2*(3-jspins)/as
      27             : c
      28           0 :       g = 0.
      29             : c
      30           0 :       DO n = 1 , ntria
      31           0 :          fa = f*atr(n)
      32           0 :          nt(:) = itria(:,n)
      33           0 :          DO nb = 1 , ntb
      34           0 :             ec(1:3) = ev(nb,nt(:))
      35           0 :             nc(1:3) = nt(:)
      36           0 :             DO i = 1, 2
      37           0 :               DO j = i+1, 3
      38           0 :                 IF ( ec(i).GT.ec(j) ) THEN
      39           0 :                   ec(4) = ec(i) ; ec(i) = ec(j) ; ec(j) = ec(4)
      40           0 :                   nc(4) = nc(i) ; nc(i) = nc(j) ; nc(j) = nc(4)
      41             :                 ENDIF
      42             :               ENDDO
      43             :             ENDDO
      44             : 
      45           0 :             DO nl = 1 , ndos
      46           0 :               DO i = 1 , ne
      47             :                 g(i,nl) = g(i,nl) + fa* dostet( e(i),ec(1),ec(2),ec(3),
      48           0 :      +             qal(nl,nb,nc(1)),qal(nl,nb,nc(2)),qal(nl,nb,nc(3)) )
      49             :               ENDDO
      50             :             ENDDO
      51             : 
      52             :          ENDDO
      53             :       ENDDO
      54             :       
      55           0 :       END SUBROUTINE ptdos
      56             : !-------------------------------------------------------------------------
      57           0 :       REAL FUNCTION dostet(e,e1,e2,e3,q1,q2,q3)
      58             : !
      59             : !     partial density of states for one tetrahedron
      60             : !     note that e1.le.e2.le.e3 is assumed
      61             : !
      62             :       IMPLICIT NONE
      63             : 
      64             :       REAL, INTENT(IN) :: e , e1 , e2 , e3 , q1 , q2 , q3
      65             : 
      66             :       REAL :: e21 , e31 , e32 , ee
      67             :       REAL, PARAMETER :: tol = 1.e-6
      68             :  
      69           0 :       dostet = 0.
      70           0 :       IF ( e.LT.e1 ) RETURN
      71           0 :       IF ( e.LE.e2 ) THEN
      72             : c
      73             : c     case 1: e between e1 and e2
      74             : c
      75           0 :          ee = e - e1
      76           0 :          e21 = e2 - e1
      77           0 :          IF ( e21.LT.tol ) RETURN
      78           0 :          e31 = e3 - e1
      79           0 :          IF ( e31.LT.tol ) RETURN
      80           0 :          dostet = ee/(e21*e31)*(q1+0.5*(ee/e21*(q2-q1)+ee/e31*(q3-q1)))
      81           0 :          RETURN
      82             :       ELSE
      83           0 :          IF ( e.GT.e3 ) RETURN
      84             : c
      85             : c     case 2: e between e2 and e3
      86             : c
      87           0 :          e31 = e3 - e1
      88           0 :          IF ( e31.LT.tol ) RETURN
      89           0 :          e32 = e3 - e2
      90           0 :          IF ( e32.LT.tol ) RETURN
      91             :          dostet = (e3-e)/(e31*e32)
      92           0 :      &            *0.5*(q1+q2+(e-e1)/e31*(q3-q1)+(e-e2)/e32*(q3-q2))
      93           0 :          RETURN
      94             :       ENDIF
      95             :       END FUNCTION dostet
      96             : !
      97             : !-------------------------------------------------------------------------
      98             :       END MODULE m_ptdos

Generated by: LCOV version 1.13