Commit e3d91ca3 by 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!