34 SUBROUTINE libtetrabz_dos(ltetra,bvec,nb,nge,eig,ngw,wght,ne,e0,comm)
BIND(C)
40 INTEGER(C_INT),
INTENT(IN) :: ltetra, nb, nge(3), ngw(3), ne
41 REAL(c_double),
INTENT(IN) :: bvec(9), eig(nb,product(nge(1:3))), e0(ne)
42 REAL(c_double),
INTENT(OUT) :: wght(ne*nb,product(ngw(1:3)))
43 INTEGER(C_INT),
INTENT(IN),
OPTIONAL :: comm
46 INTEGER :: nt_local, nk_local, nkbz, ik, kintp(8)
47 INTEGER,
ALLOCATABLE :: ik_global(:,:), ik_local(:,:)
48 REAL(8) :: wlsm(4,20), wintp(1,8)
49 REAL(8),
ALLOCATABLE :: wghtd(:,:,:), kvec(:,:)
51 IF(
PRESENT(comm))
THEN
53 & nt_local,nkbz,ik_global,ik_local,kvec,comm)
56 & nt_local,nkbz,ik_global,ik_local,kvec)
61 ALLOCATE(wghtd(ne*nb,1,nk_local))
62 CALL libtetrabz_dos_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,ne,e0,nk_local,wghtd)
66 wght(1:ne*nb,1:product(ngw(1:3))) = 0d0
69 wght(1:ne*nb,kintp(1:8)) = wght(1:ne*nb, kintp(1:8)) &
70 & + matmul(wghtd(1:ne*nb,1:1,ik), wintp(1:1,1:8))
72 DEALLOCATE(wghtd, kvec)
77 CALL libtetrabz_dos_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,ne,e0,nk_local,wght)
80 DEALLOCATE(ik_global, ik_local)
92 INTEGER(C_INT),
INTENT(IN) :: ltetra, nb, nge(3), ngw(3), ne
93 REAL(c_double),
INTENT(IN) :: bvec(9), eig(nb,product(nge(1:3))), e0(ne)
94 REAL(c_double),
INTENT(OUT) :: wght(ne*nb,product(ngw(1:3)))
95 INTEGER(C_INT),
INTENT(IN),
OPTIONAL :: comm
98 INTEGER :: nt_local, nk_local, nkbz, ik, kintp(8)
99 INTEGER,
ALLOCATABLE :: ik_global(:,:), ik_local(:,:)
100 REAL(8) :: wlsm(4,20), wintp(1,8)
101 REAL(8),
ALLOCATABLE :: wghtd(:,:,:), kvec(:,:)
103 IF(
PRESENT(comm))
THEN
105 & nt_local,nkbz,ik_global,ik_local,kvec,comm)
108 & nt_local,nkbz,ik_global,ik_local,kvec)
113 ALLOCATE(wghtd(ne*nb,1,nk_local))
114 CALL libtetrabz_intdos_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,ne,e0,nk_local,wghtd)
118 wght(1:ne*nb,1:product(ngw(1:3))) = 0d0
121 wght(1:ne*nb,kintp(1:8)) = wght(1:ne*nb, kintp(1:8)) &
122 & + matmul(wghtd(1:ne*nb,1:1,ik), wintp(1:1,1:8))
124 DEALLOCATE(wghtd, kvec)
129 CALL libtetrabz_intdos_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,ne,e0,nk_local,wght)
132 DEALLOCATE(ik_global, ik_local)
138 SUBROUTINE libtetrabz_dos_main(wlsm,nt_local,ik_global,ik_local,nb,nkBZ,eig,ne,e0,nk_local,dos)
145 INTEGER,
INTENT(IN) :: nt_local, nb, nkBZ, nk_local, ne, &
146 & ik_global(20,nt_local), ik_local(20,nt_local)
147 REAL(8),
INTENT(IN) :: wlsm(4,20), eig(nb,nkBZ), e0(ne)
148 REAL(8),
INTENT(OUT) :: dos(ne,nb,nk_local)
150 INTEGER :: ib, it, ie, indx(4)
151 REAL(8) :: e(4), ei1(4,nb), tsmall(3,4), V, w1(ne,4)
153 dos(1:ne, 1:nb, 1:nk_local) = 0d0
162 ei1(1:4,ib) = matmul(wlsm(1:4,1:20), eig(ib,ik_global(1:20,it)))
169 e(1:4) = ei1(1:4, ib)
174 IF((e(1) < e0(ie) .AND. e0(ie) <= e(2)) .OR. &
175 & (e(1) <= e0(ie) .AND. e0(ie) < e(2)))
THEN
178 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:3,1:4), 1) / 3d0
180 ELSE IF((e(2) < e0(ie) .AND. e0(ie) <= e(3)) .OR. &
181 & (e(2) <= e0(ie) .AND. e0(ie) < e(3)))
THEN
184 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:3,1:4), 1) / 3d0
187 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:3,1:4), 1) / 3d0
189 ELSE IF((e(3) < e0(ie) .AND. e0(ie) <= e(4)) .OR. &
190 & (e(3) <= e0(ie) .AND. e0(ie) < e(4)))
THEN
193 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:3,1:4), 1) / 3d0
199 dos(1:ne,ib,ik_local(1:20,it)) = dos(1:ne,ib, ik_local(1:20,it)) &
200 & + matmul(w1(1:ne, 1:4), wlsm(1:4,1:20))
209 dos(1:ne,1:nb,1:nk_local) = dos(1:ne,1:nb,1:nk_local) / dble(6 * nkbz)
215 SUBROUTINE libtetrabz_intdos_main(wlsm,nt_local,ik_global,ik_local,nb,nkBZ,eig,ne,e0,nk_local,intdos)
224 INTEGER,
INTENT(IN) :: nt_local, nb, nkBZ, nk_local, ne, &
225 & ik_global(20,nt_local), ik_local(20,nt_local)
226 REAL(8),
INTENT(IN) :: wlsm(4,20), eig(nb,nkBZ), e0(ne)
227 REAL(8),
INTENT(OUT) :: intdos(ne,nb,nk_local)
229 INTEGER :: ib, it, ie, indx(4)
230 REAL(8) :: e(4), ei1(4,nb), tsmall(4,4), V, w1(ne,4)
232 intdos(1:ne, 1:nb, 1:nk_local) = 0d0
241 ei1(1:4,ib) = matmul(wlsm(1:4,1:20), eig(ib,ik_global(1:20,it)))
248 e(1:4) = ei1(1:4, ib)
253 IF((e(1) <= e0(ie) .AND. e0(ie) < e(2)) .OR. &
254 & (e(1) < e0(ie) .AND. e0(ie) <= e(2)))
THEN
257 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
259 ELSE IF((e(2) <= e0(ie) .AND. e0(ie) < e(3)) .OR. &
260 & (e(2) < e0(ie) .AND. e0(ie) <= e(3)))
THEN
263 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
266 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
269 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
271 ELSE IF((e(3) <= e0(ie) .AND. e0(ie) < e(4)) .OR. &
272 & (e(3) < e0(ie) .AND. e0(ie) <= e(4)))
THEN
275 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
278 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
281 w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
283 ELSE IF(e(4) <= e0(ie))
THEN
295 intdos(1:ne,ib,ik_local(1:20,it)) = intdos(1:ne,ib, ik_local(1:20,it)) &
296 & + matmul(w1(1:ne, 1:4), wlsm(1:4,1:20))
305 intdos(1:ne,1:nb,1:nk_local) = intdos(1:ne,1:nb,1:nk_local) / dble(6 * nkbz)