dosint.f 1.87 KB
 Markus Betzinger committed Apr 26, 2016 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 `````` MODULE m_dosint c c integrated dos to ei c CONTAINS SUBROUTINE dosint( > ei,nemax,jspins,sfac,ntria,itria,atr,eig, < ct) USE m_trisrt IMPLICIT NONE C .. C .. Scalar Arguments .. INTEGER, INTENT (IN) :: jspins INTEGER, INTENT (IN) :: ntria REAL, INTENT (IN) :: ei,sfac REAL, INTENT (OUT):: ct C .. C .. Array Arguments .. INTEGER, INTENT (IN) :: nemax(2) INTEGER, INTENT (IN) :: itria(:,:) !(3,ntriad) REAL, INTENT (IN) :: atr(:) !(ntriad) REAL, INTENT (IN) :: eig(:,:,:) !(neigd,nkptd,jspd) C .. C .. Local Scalars .. INTEGER jsp,i,n INTEGER k1,k2,k3 INTEGER neig REAL e1,e2,e3 REAl ee,e32,e31,e21,s c s = 0.0 DO jsp = 1,jspins neig = nemax(jsp) DO i = 1,neig DO n = 1,ntria k1 = itria(1,n) k2 = itria(2,n) k3 = itria(3,n) e1 = eig(i,k1,jsp) e2 = eig(i,k2,jsp) e3 = eig(i,k3,jsp) c write(16,*) 'eig=',i,', ntria=',n,', e1,e2,e3=',e1,e2,e3 CALL trisrt(e1,e2,e3,k1,k2,k3) IF (e1.LE.-9999.0) CYCLE IF (ei.LE.e1) CYCLE IF (ei.GE.e3) THEN s = s + atr(n) ELSEIF (ei.GT.e2) THEN e31 = e3 - e1 e32 = e3 - e2 ee = e3 - ei s = s + atr(n)* (1.-ee*ee/ (e31*e32)) ELSE e21 = e2 - e1 e31 = e3 - e1 ee = ei - e1 s = s + atr(n)*ee*ee/ (e21*e31) ENDIF ENDDO ENDDO ENDDO cjr ct=2.*s !gb ct = (2./jspins)*s ct = sfac * s END SUBROUTINE dosint END MODULE m_dosint``````