doswt.f 2.43 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 68 69 70 71 72 73 74 75 76 `````` MODULE m_doswt c c calculates the weights for each k-point for integrating functions c of k. the array w has beeen cleared before entering. c CONTAINS SUBROUTINE doswt( > ei,nemax,jspins,ntria,itria,atr,eig, < w) USE m_trisrt IMPLICIT NONE C .. C .. Scalar Arguments .. INTEGER, INTENT (IN) :: jspins INTEGER, INTENT (IN) :: ntria REAL, INTENT (IN) :: ei 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) REAL, INTENT (OUT):: w(:,:,:) !(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 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) CALL trisrt(e1,e2,e3,k1,k2,k3) IF (e1.LE.-9999.0) CYCLE IF (ei.LE.e1) CYCLE IF (ei.GE.e3) THEN c---> e3 e2 e1