Commit e3d91ca3 authored by Henning Janssen's avatar Henning Janssen

Move ptdos to f90

parent fac8bc49
set(fleur_F77 ${fleur_F77}
dos/dos_bin.f
dos/ptdos.f
dos/smooth.f
)
set(fleur_F90 ${fleur_F90}
......@@ -13,4 +12,5 @@ dos/nstm3.f90
dos/sympsi.F90
dos/dostetra.f90
dos/tetra_dos.f90
dos/ptdos.f90
)
......@@ -3,30 +3,28 @@
! Density of states calculated by linear triangular method
!-------------------------------------------------------------------------
CONTAINS
SUBROUTINE ptdos(
> emin,emax,jspins,ne,ndos,ntb,ntria,as,atr,ntriad,
> itria,nkpt,ev,qal,e,
< g)
SUBROUTINE ptdos(emin,emax,jspins,ne,ndos,ntb,ntria,as,atr,ntriad,&
itria,nkpt,ev,qal,e,g)
IMPLICIT NONE
c
c .. Arguments
!
! .. Arguments
INTEGER, INTENT (IN) :: ne,ntria,jspins,ntriad,ndos,ntb,nkpt
INTEGER, INTENT (IN) :: itria(3,ntriad)
REAL, INTENT (IN) :: emax,emin,as
REAL, INTENT (IN) :: atr(ntriad),qal(ndos,ntb,nkpt)
REAL, INTENT (IN) :: e(ne),ev(ntb,nkpt)
REAL, INTENT (OUT):: g(ne,ndos)
c
c .. Locals
!
! .. Locals
INTEGER :: i, j, nl, nb, n, nt(3), nc(4)
REAL :: f, fa, ec(4)
c
c calculate partial densities of states
c
!
! calculate partial densities of states
!
f = 2*(3-jspins)/as
c
!
g = 0.
c
!
DO n = 1 , ntria
fa = f*atr(n)
nt(:) = itria(:,n)
......@@ -44,8 +42,8 @@ c
DO nl = 1 , ndos
DO i = 1 , ne
g(i,nl) = g(i,nl) + fa* dostet( e(i),ec(1),ec(2),ec(3),
+ qal(nl,nb,nc(1)),qal(nl,nb,nc(2)),qal(nl,nb,nc(3)) )
g(i,nl) = g(i,nl) + fa* dostet( e(i),ec(1),ec(2),ec(3),&
qal(nl,nb,nc(1)),qal(nl,nb,nc(2)),qal(nl,nb,nc(3)) )
ENDDO
ENDDO
......@@ -69,9 +67,9 @@ c
dostet = 0.
IF ( e.LT.e1 ) RETURN
IF ( e.LE.e2 ) THEN
c
c case 1: e between e1 and e2
c
!
! case 1: e between e1 and e2
!
ee = e - e1
e21 = e2 - e1
IF ( e21.LT.tol ) RETURN
......@@ -81,15 +79,15 @@ c
RETURN
ELSE
IF ( e.GT.e3 ) RETURN
c
c case 2: e between e2 and e3
c
!
! case 2: e between e2 and e3
!
e31 = e3 - e1
IF ( e31.LT.tol ) RETURN
e32 = e3 - e2
IF ( e32.LT.tol ) RETURN
dostet = (e3-e)/(e31*e32)
& *0.5*(q1+q2+(e-e1)/e31*(q3-q1)+(e-e2)/e32*(q3-q2))
dostet = (e3-e)/(e31*e32)&
*0.5*(q1+q2+(e-e1)/e31*(q3-q1)+(e-e2)/e32*(q3-q2))
RETURN
ENDIF
END FUNCTION dostet
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment