pwdft  0.1
PW-DFT code for education
Functions/Subroutines
libtetrabz_dos_mod Module Reference

Functions/Subroutines

subroutine, public libtetrabz_dos (ltetra, bvec, nb, nge, eig, ngw, wght, ne, e0, comm)
 
subroutine, public libtetrabz_intdos (ltetra, bvec, nb, nge, eig, ngw, wght, ne, e0, comm)
 
subroutine libtetrabz_dos_main (wlsm, nt_local, ik_global, ik_local, nb, nkBZ, eig, ne, e0, nk_local, dos)
 
subroutine libtetrabz_intdos_main (wlsm, nt_local, ik_global, ik_local, nb, nkBZ, eig, ne, e0, nk_local, intdos)
 

Function/Subroutine Documentation

◆ libtetrabz_dos()

subroutine, public libtetrabz_dos_mod::libtetrabz_dos ( integer(c_int), intent(in)  ltetra,
real(c_double), dimension(9), intent(in)  bvec,
integer(c_int), intent(in)  nb,
integer(c_int), dimension(3), intent(in)  nge,
real(c_double), dimension(nb,product(nge(1:3))), intent(in)  eig,
integer(c_int), dimension(3), intent(in)  ngw,
real(c_double), dimension(ne*nb,product(ngw(1:3))), intent(out)  wght,
integer(c_int), intent(in)  ne,
real(c_double), dimension(ne), intent(in)  e0,
integer(c_int), intent(in), optional  comm 
)

Definition at line 35 of file libtetrabz_dos_mod.F90.

35  !
36  USE iso_c_binding
37  USE libtetrabz_common, ONLY : libtetrabz_initialize, libtetrabz_interpol_indx, libtetrabz_mpisum_dv
38  IMPLICIT NONE
39  !
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
44  !
45  LOGICAL :: linterpol
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(:,:)
50  !
51  IF(PRESENT(comm)) THEN
52  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
53  & nt_local,nkbz,ik_global,ik_local,kvec,comm)
54  ELSE
55  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
56  & nt_local,nkbz,ik_global,ik_local,kvec)
57  END IF
58  !
59  IF(linterpol) THEN
60  !
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)
63  !
64  ! Interpolation
65  !
66  wght(1:ne*nb,1:product(ngw(1:3))) = 0d0
67  DO ik = 1, nk_local
68  CALL libtetrabz_interpol_indx(ngw,kvec(1:3,ik),kintp,wintp)
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))
71  END DO ! ik = 1, nk_local
72  DEALLOCATE(wghtd, kvec)
73  !
74  IF(PRESENT(comm)) CALL libtetrabz_mpisum_dv(comm, ne*nb*product(ngw(1:3)), wght)
75  !
76  ELSE
77  CALL libtetrabz_dos_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,ne,e0,nk_local,wght)
78  END IF
79  !
80  DEALLOCATE(ik_global, ik_local)
81  !

References libtetrabz_dos_main(), libtetrabz_common::libtetrabz_initialize(), libtetrabz_common::libtetrabz_interpol_indx(), and libtetrabz_common::libtetrabz_mpisum_dv().

Here is the call graph for this function:

◆ libtetrabz_intdos()

subroutine, public libtetrabz_dos_mod::libtetrabz_intdos ( integer(c_int), intent(in)  ltetra,
real(c_double), dimension(9), intent(in)  bvec,
integer(c_int), intent(in)  nb,
integer(c_int), dimension(3), intent(in)  nge,
real(c_double), dimension(nb,product(nge(1:3))), intent(in)  eig,
integer(c_int), dimension(3), intent(in)  ngw,
real(c_double), dimension(ne*nb,product(ngw(1:3))), intent(out)  wght,
integer(c_int), intent(in)  ne,
real(c_double), dimension(ne), intent(in)  e0,
integer(c_int), intent(in), optional  comm 
)

Definition at line 87 of file libtetrabz_dos_mod.F90.

87  !
88  USE iso_c_binding
89  USE libtetrabz_common, ONLY : libtetrabz_initialize, libtetrabz_interpol_indx, libtetrabz_mpisum_dv
90  IMPLICIT NONE
91  !
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
96  !
97  LOGICAL :: linterpol
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(:,:)
102  !
103  IF(PRESENT(comm)) THEN
104  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
105  & nt_local,nkbz,ik_global,ik_local,kvec,comm)
106  ELSE
107  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
108  & nt_local,nkbz,ik_global,ik_local,kvec)
109  END IF
110  !
111  IF(linterpol) THEN
112  !
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)
115  !
116  ! Interpolation
117  !
118  wght(1:ne*nb,1:product(ngw(1:3))) = 0d0
119  DO ik = 1, nk_local
120  CALL libtetrabz_interpol_indx(ngw,kvec(1:3,ik),kintp,wintp)
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))
123  END DO ! ik = 1, nk_local
124  DEALLOCATE(wghtd, kvec)
125  !
126  IF(PRESENT(comm)) CALL libtetrabz_mpisum_dv(comm, ne*nb*product(ngw(1:3)), wght)
127  !
128  ELSE
129  CALL libtetrabz_intdos_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig,ne,e0,nk_local,wght)
130  END IF
131  !
132  DEALLOCATE(ik_global, ik_local)
133  !

References libtetrabz_common::libtetrabz_initialize(), libtetrabz_intdos_main(), libtetrabz_common::libtetrabz_interpol_indx(), and libtetrabz_common::libtetrabz_mpisum_dv().

Here is the call graph for this function:

◆ libtetrabz_dos_main()

subroutine libtetrabz_dos_mod::libtetrabz_dos_main ( real(8), dimension(4,20), intent(in)  wlsm,
integer, intent(in)  nt_local,
integer, dimension(20,nt_local), intent(in)  ik_global,
integer, dimension(20,nt_local), intent(in)  ik_local,
integer, intent(in)  nb,
integer, intent(in)  nkBZ,
real(8), dimension(nb,nkbz), intent(in)  eig,
integer, intent(in)  ne,
real(8), dimension(ne), intent(in)  e0,
integer, intent(in)  nk_local,
real(8), dimension(ne,nb,nk_local), intent(out)  dos 
)

Definition at line 139 of file libtetrabz_dos_mod.F90.

139  !
140  USE libtetrabz_common, ONLY : libtetrabz_sort, &
141  & libtetrabz_triangle_a1, libtetrabz_triangle_b1, &
142  & libtetrabz_triangle_b2, libtetrabz_triangle_c1
143  IMPLICIT NONE
144  !
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)
149  !
150  INTEGER :: ib, it, ie, indx(4)
151  REAL(8) :: e(4), ei1(4,nb), tsmall(3,4), V, w1(ne,4)
152  !
153  dos(1:ne, 1:nb, 1:nk_local) = 0d0
154  !
155  !$OMP PARALLEL DEFAULT(NONE) &
156  !$OMP & SHARED(dos,eig,e0,ik_global,ik_local,nb,ne,nt_local,wlsm) &
157  !$OMP & PRIVATE(e,ei1,ib,ie,indx,it,tsmall,V,w1)
158  !
159  DO it = 1, nt_local
160  !
161  DO ib = 1, nb
162  ei1(1:4,ib) = matmul(wlsm(1:4,1:20), eig(ib,ik_global(1:20,it)))
163  END DO
164  !
165  !$OMP DO
166  DO ib = 1, nb
167  !
168  w1(1:ne,1:4) = 0d0
169  e(1:4) = ei1(1:4, ib)
170  CALL libtetrabz_sort(4,e,indx)
171  !
172  DO ie = 1, ne
173  !
174  IF((e(1) < e0(ie) .AND. e0(ie) <= e(2)) .OR. &
175  & (e(1) <= e0(ie) .AND. e0(ie) < e(2))) THEN
176  !
177  CALL libtetrabz_triangle_a1(e(1:4) - e0(ie),v,tsmall)
178  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:3,1:4), 1) / 3d0
179  !
180  ELSE IF((e(2) < e0(ie) .AND. e0(ie) <= e(3)) .OR. &
181  & (e(2) <= e0(ie) .AND. e0(ie) < e(3))) THEN
182  !
183  CALL libtetrabz_triangle_b1(e(1:4) - e0(ie),v,tsmall)
184  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:3,1:4), 1) / 3d0
185  !
186  CALL libtetrabz_triangle_b2(e(1:4) - e0(ie),v,tsmall)
187  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:3,1:4), 1) / 3d0
188  !
189  ELSE IF((e(3) < e0(ie) .AND. e0(ie) <= e(4)) .OR. &
190  & (e(3) <= e0(ie) .AND. e0(ie) < e(4))) THEN
191  !
192  CALL libtetrabz_triangle_c1(e(1:4) - e0(ie),v,tsmall)
193  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:3,1:4), 1) / 3d0
194  !
195  END IF
196  !
197  END DO ! ie
198  !
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))
201  !
202  END DO ! ib
203  !$OMP END DO NOWAIT
204  !
205  END DO ! it
206  !
207  !$OMP END PARALLEL
208  !
209  dos(1:ne,1:nb,1:nk_local) = dos(1:ne,1:nb,1:nk_local) / dble(6 * nkbz)
210  !

References libtetrabz_common::libtetrabz_sort(), libtetrabz_common::libtetrabz_triangle_a1(), libtetrabz_common::libtetrabz_triangle_b1(), libtetrabz_common::libtetrabz_triangle_b2(), and libtetrabz_common::libtetrabz_triangle_c1().

Referenced by libtetrabz_dos().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ libtetrabz_intdos_main()

subroutine libtetrabz_dos_mod::libtetrabz_intdos_main ( real(8), dimension(4,20), intent(in)  wlsm,
integer, intent(in)  nt_local,
integer, dimension(20,nt_local), intent(in)  ik_global,
integer, dimension(20,nt_local), intent(in)  ik_local,
integer, intent(in)  nb,
integer, intent(in)  nkBZ,
real(8), dimension(nb,nkbz), intent(in)  eig,
integer, intent(in)  ne,
real(8), dimension(ne), intent(in)  e0,
integer, intent(in)  nk_local,
real(8), dimension(ne,nb,nk_local), intent(out)  intdos 
)

Definition at line 216 of file libtetrabz_dos_mod.F90.

216  !
217  USE libtetrabz_common, ONLY : libtetrabz_sort, &
218  & libtetrabz_tsmall_a1, libtetrabz_tsmall_b1, &
219  & libtetrabz_tsmall_b2, libtetrabz_tsmall_b3, &
220  & libtetrabz_tsmall_c1, libtetrabz_tsmall_c2, &
221  & libtetrabz_tsmall_c3
222  IMPLICIT NONE
223  !
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)
228  !
229  INTEGER :: ib, it, ie, indx(4)
230  REAL(8) :: e(4), ei1(4,nb), tsmall(4,4), V, w1(ne,4)
231  !
232  intdos(1:ne, 1:nb, 1:nk_local) = 0d0
233  !
234  !$OMP PARALLEL DEFAULT(NONE) &
235  !$OMP & SHARED(eig,e0,ik_global,ik_local,intdos,nb,ne,nt_local,wlsm) &
236  !$OMP & PRIVATE(e,ei1,ib,ie,indx,it,tsmall,V,w1)
237  !
238  DO it = 1, nt_local
239  !
240  DO ib = 1, nb
241  ei1(1:4,ib) = matmul(wlsm(1:4,1:20), eig(ib,ik_global(1:20,it)))
242  END DO
243  !
244  !$OMP DO
245  DO ib = 1, nb
246  !
247  w1(1:ne,1:4) = 0d0
248  e(1:4) = ei1(1:4, ib)
249  CALL libtetrabz_sort(4,e,indx)
250  !
251  DO ie = 1, ne
252  !
253  IF((e(1) <= e0(ie) .AND. e0(ie) < e(2)) .OR. &
254  & (e(1) < e0(ie) .AND. e0(ie) <= e(2))) THEN
255  !
256  CALL libtetrabz_tsmall_a1(e - e0(ie),v,tsmall)
257  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
258  !
259  ELSE IF((e(2) <= e0(ie) .AND. e0(ie) < e(3)) .OR. &
260  & (e(2) < e0(ie) .AND. e0(ie) <= e(3))) THEN
261  !
262  CALL libtetrabz_tsmall_b1(e - e0(ie),v,tsmall)
263  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
264  !
265  CALL libtetrabz_tsmall_b2(e - e0(ie),v,tsmall)
266  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
267  !
268  CALL libtetrabz_tsmall_b3(e - e0(ie),v,tsmall)
269  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
270  !
271  ELSE IF((e(3) <= e0(ie) .AND. e0(ie) < e(4)) .OR. &
272  & (e(3) < e0(ie) .AND. e0(ie) <= e(4))) THEN
273  !
274  CALL libtetrabz_tsmall_c1(e - e0(ie),v,tsmall)
275  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
276  !
277  CALL libtetrabz_tsmall_c2(e - e0(ie),v,tsmall)
278  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
279  !
280  CALL libtetrabz_tsmall_c3(e - e0(ie),v,tsmall)
281  w1(ie,indx(1:4)) = w1(ie,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
282  !
283  ELSE IF(e(4) <= e0(ie)) THEN
284  !
285  w1(ie,1:4) = 0.25d0
286  !
287  ELSE
288  !
289  cycle
290  !
291  END IF
292  !
293  END DO ! ie
294  !
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))
297  !
298  END DO ! ib
299  !$OMP END DO NOWAIT
300  !
301  END DO ! it
302  !
303  !$OMP END PARALLEL
304  !
305  intdos(1:ne,1:nb,1:nk_local) = intdos(1:ne,1:nb,1:nk_local) / dble(6 * nkbz)
306  !

References libtetrabz_common::libtetrabz_sort(), libtetrabz_common::libtetrabz_tsmall_a1(), libtetrabz_common::libtetrabz_tsmall_b1(), libtetrabz_common::libtetrabz_tsmall_b2(), libtetrabz_common::libtetrabz_tsmall_b3(), libtetrabz_common::libtetrabz_tsmall_c1(), libtetrabz_common::libtetrabz_tsmall_c2(), and libtetrabz_common::libtetrabz_tsmall_c3().

Referenced by libtetrabz_intdos().

Here is the call graph for this function:
Here is the caller graph for this function:
libtetrabz_common::libtetrabz_triangle_b2
subroutine, public libtetrabz_triangle_b2(e, V, tsmall)
Definition: libtetrabz_common.F90:614
libtetrabz_common::libtetrabz_tsmall_b2
subroutine, public libtetrabz_tsmall_b2(e, V, tsmall)
Definition: libtetrabz_common.F90:432
libtetrabz_common::libtetrabz_tsmall_c1
subroutine, public libtetrabz_tsmall_c1(e, V, tsmall)
Definition: libtetrabz_common.F90:484
libtetrabz_common::libtetrabz_mpisum_dv
subroutine, public libtetrabz_mpisum_dv(comm, ndim, vector)
Definition: libtetrabz_common.F90:687
libtetrabz_common::libtetrabz_triangle_c1
subroutine, public libtetrabz_triangle_c1(e, V, tsmall)
Definition: libtetrabz_common.F90:640
libtetrabz_common::libtetrabz_tsmall_a1
subroutine, public libtetrabz_tsmall_a1(e, V, tsmall)
Definition: libtetrabz_common.F90:380
libtetrabz_common::libtetrabz_tsmall_b1
subroutine, public libtetrabz_tsmall_b1(e, V, tsmall)
Definition: libtetrabz_common.F90:406
libtetrabz_common::libtetrabz_initialize
subroutine, public libtetrabz_initialize(ltetra, nge, ngw, bvec, linterpol, wlsm, nk_local, nt_local, nkBZ, ik_global, ik_local, kvec, comm)
Definition: libtetrabz_common.F90:40
libtetrabz_common::libtetrabz_interpol_indx
subroutine, public libtetrabz_interpol_indx(ng, kvec, kintp, wintp)
Definition: libtetrabz_common.F90:340
libtetrabz_common::libtetrabz_triangle_a1
subroutine, public libtetrabz_triangle_a1(e, V, tsmall)
Definition: libtetrabz_common.F90:562
libtetrabz_common::libtetrabz_tsmall_c3
subroutine, public libtetrabz_tsmall_c3(e, V, tsmall)
Definition: libtetrabz_common.F90:536
libtetrabz_common::libtetrabz_tsmall_c2
subroutine, public libtetrabz_tsmall_c2(e, V, tsmall)
Definition: libtetrabz_common.F90:510
libtetrabz_common
Definition: libtetrabz_common.F90:23
libtetrabz_common::libtetrabz_tsmall_b3
subroutine, public libtetrabz_tsmall_b3(e, V, tsmall)
Definition: libtetrabz_common.F90:458
libtetrabz_common::libtetrabz_sort
subroutine, public libtetrabz_sort(n, key, indx)
Definition: libtetrabz_common.F90:308
libtetrabz_common::libtetrabz_triangle_b1
subroutine, public libtetrabz_triangle_b1(e, V, tsmall)
Definition: libtetrabz_common.F90:588