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

Functions/Subroutines

subroutine, public libtetrabz_dblstep (ltetra, bvec, nb, nge, eig1, eig2, ngw, wght, comm)
 
subroutine libtetrabz_dblstep_main (wlsm, nt_local, ik_global, ik_local, nb, nkBZ, eig1, eig2, nk_local, dblstep)
 
subroutine libtetrabz_dblstep2 (nb, ei1, ej1, w1)
 

Function/Subroutine Documentation

◆ libtetrabz_dblstep()

subroutine, public libtetrabz_dblstep_mod::libtetrabz_dblstep ( 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)  eig1,
real(c_double), dimension(nb,product(nge(1:3))), intent(in)  eig2,
integer(c_int), dimension(3), intent(in)  ngw,
real(c_double), dimension(nb*nb,product(ngw(1:3))), intent(out)  wght,
integer(c_int), intent(in), optional  comm 
)

Definition at line 35 of file libtetrabz_dblstep_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)
41  REAL(C_DOUBLE),INTENT(IN) :: bvec(9), eig1(nb,PRODUCT(nge(1:3))), eig2(nb,PRODUCT(nge(1:3)))
42  REAL(C_DOUBLE),INTENT(OUT) :: wght(nb*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(nb*nb,1,nk_local))
62  CALL libtetrabz_dblstep_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig1,eig2,nk_local,wghtd)
63  !
64  ! Interpolation
65  !
66  wght(1:nb*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:nb*nb,kintp(1:8)) = wght(1:nb*nb, kintp(1:8)) &
70  & + matmul(wghtd(1:nb*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, nb*nb*product(ngw(1:3)), wght)
75  !
76  ELSE
77  CALL libtetrabz_dblstep_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig1,eig2,nk_local,wght)
78  END IF
79  !
80  DEALLOCATE(ik_global, ik_local)
81  !

References libtetrabz_dblstep_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_dblstep_main()

subroutine libtetrabz_dblstep_mod::libtetrabz_dblstep_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)  eig1,
real(8), dimension(nb,nkbz), intent(in)  eig2,
integer, intent(in)  nk_local,
real(8), dimension(nb,nb,nk_local), intent(out)  dblstep 
)

Definition at line 87 of file libtetrabz_dblstep_mod.F90.

87  !
88  USE libtetrabz_common, ONLY : libtetrabz_sort, &
89  & libtetrabz_tsmall_a1, libtetrabz_tsmall_b1, &
90  & libtetrabz_tsmall_b2, libtetrabz_tsmall_b3, &
91  & libtetrabz_tsmall_c1, libtetrabz_tsmall_c2, &
92  & libtetrabz_tsmall_c3
93  IMPLICIT NONE
94  !
95  INTEGER,INTENT(IN) :: nt_local, nb, nkBZ, nk_local, &
96  & ik_global(20,nt_local), ik_local(20,nt_local)
97  REAL(8),INTENT(IN) :: wlsm(4,20), eig1(nb,nkBZ), eig2(nb,nkBZ)
98  REAL(8),INTENT(OUT) :: dblstep(nb,nb,nk_local)
99  !
100  INTEGER :: ib, indx(4), it
101  REAL(8) :: e(4), ei1(4,nb), ei2(4), ej1(4,nb), ej2(4,nb), thr = 1d-10, &
102  & tsmall(4,4), v, w1(nb,4), w2(nb,4)
103  !
104  dblstep(1:nb,1:nb,1:nk_local) = 0d0
105  !
106  !$OMP PARALLEL DEFAULT(NONE) &
107  !$OMP & SHARED(dblstep,eig1,eig2,ik_global,ik_local,nb,nt_local,thr,wlsm) &
108  !$OMP & PRIVATE(e,ei1,ei2,ej1,ej2,ib,indx,it,tsmall,V,w1,w2)
109  !
110  DO it = 1, nt_local
111  !
112  DO ib = 1, nb
113  ei1(1:4, ib) = matmul(wlsm(1:4,1:20), eig1(ib, ik_global(1:20,it)))
114  ej1(1:4, ib) = matmul(wlsm(1:4,1:20), eig2(ib, ik_global(1:20,it)))
115  END DO
116  !
117  !$OMP DO
118  DO ib = 1, nb
119  !
120  w1(1:nb,1:4) = 0d0
121  e(1:4) = ei1(1:4, ib)
122  CALL libtetrabz_sort(4,e,indx)
123  !
124  IF(e(1) <= 0d0 .AND. 0d0 < e(2) ) THEN
125  !
126  CALL libtetrabz_tsmall_a1(e,v,tsmall)
127  !
128  IF(v > thr) THEN
129  !
130  ei2(1:4 ) = matmul(tsmall(1:4,1:4), ei1(indx(1:4), ib))
131  ej2(1:4,1:nb) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),1:nb))
132  CALL libtetrabz_dblstep2(nb,ei2,ej2,w2)
133  w1(1:nb,indx(1:4)) = w1(1:nb, indx(1:4)) &
134  & + v * matmul(w2(1:nb, 1:4 ), tsmall(1:4,1:4))
135  !
136  END IF
137  !
138  ELSE IF(e(2) <= 0d0 .AND. 0d0 < e(3)) THEN
139  !
140  CALL libtetrabz_tsmall_b1(e,v,tsmall)
141  !
142  IF(v > thr) THEN
143  !
144  ei2(1:4 ) = matmul(tsmall(1:4,1:4), ei1(indx(1:4), ib))
145  ej2(1:4,1:nb) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),1:nb))
146  CALL libtetrabz_dblstep2(nb,ei2,ej2,w2)
147  w1(1:nb,indx(1:4)) = w1(1:nb, indx(1:4)) &
148  & + v * matmul(w2(1:nb,1:4), tsmall(1:4,1:4))
149  !
150  END IF
151  !
152  CALL libtetrabz_tsmall_b2(e,v,tsmall)
153  !
154  IF(v > thr) THEN
155  !
156  ei2(1:4 ) = matmul(tsmall(1:4,1:4), ei1(indx(1:4), ib))
157  ej2(1:4,1:nb) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),1:nb))
158  CALL libtetrabz_dblstep2(nb,ei2,ej2,w2)
159  w1(1:nb,indx(1:4)) = w1(1:nb, indx(1:4)) &
160  & + v * matmul(w2(1:nb,1:4), tsmall(1:4,1:4))
161  !
162  END IF
163  !
164  CALL libtetrabz_tsmall_b3(e,v,tsmall)
165  !
166  IF(v > thr) THEN
167  !
168  ei2(1:4 ) = matmul(tsmall(1:4,1:4), ei1(indx(1:4), ib))
169  ej2(1:4,1:nb) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),1:nb))
170  CALL libtetrabz_dblstep2(nb,ei2,ej2,w2)
171  w1(1:nb,indx(1:4)) = w1(1:nb, indx(1:4)) &
172  & + v * matmul(w2(1:nb,1:4), tsmall(1:4,1:4))
173  !
174  END IF
175  !
176  ELSE IF( e(3) <= 0d0 .AND. 0d0 < e(4)) THEN
177  !
178  CALL libtetrabz_tsmall_c1(e,v,tsmall)
179  !
180  IF(v > thr) THEN
181  !
182  ei2(1:4 ) = matmul(tsmall(1:4,1:4), ei1(indx(1:4), ib))
183  ej2(1:4,1:nb) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),1:nb))
184  CALL libtetrabz_dblstep2(nb,ei2,ej2,w2)
185  w1(1:nb,indx(1:4)) = w1(1:nb, indx(1:4)) &
186  & + v * matmul(w2(1:nb,1:4), tsmall(1:4,1:4))
187  !
188  END IF
189  !
190  CALL libtetrabz_tsmall_c2(e,v,tsmall)
191  !
192  IF(v > thr) THEN
193  !
194  ei2(1:4 ) = matmul(tsmall(1:4,1:4), ei1(indx(1:4), ib))
195  ej2(1:4,1:nb) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),1:nb))
196  CALL libtetrabz_dblstep2(nb,ei2,ej2,w2)
197  w1(1:nb,indx(1:4)) = w1(1:nb, indx(1:4)) &
198  & + v * matmul(w2(1:nb,1:4), tsmall(1:4,1:4))
199  !
200  END IF
201  !
202  CALL libtetrabz_tsmall_c3(e,v,tsmall)
203  !
204  IF(v > thr) THEN
205  !
206  ei2(1:4 ) = matmul(tsmall(1:4,1:4), ei1(indx(1:4), ib))
207  ej2(1:4,1:nb) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),1:nb))
208  CALL libtetrabz_dblstep2(nb,ei2,ej2,w2)
209  w1(1:nb,indx(1:4)) = w1(1:nb, indx(1:4)) &
210  & + v * matmul(w2(1:nb,1:4), tsmall(1:4,1:4))
211  !
212  END IF
213  !
214  ELSE IF(e(4) <= 0d0) THEN
215  !
216  ei2(1:4 ) = ei1(1:4, ib)
217  ej2(1:4,1:nb) = ej1(1:4,1:nb)
218  CALL libtetrabz_dblstep2(nb,ei2,ej2,w2)
219  w1(1:nb,1:4) = w1(1:nb,1:4) + w2(1:nb,1:4)
220  !
221  ELSE
222  !
223  cycle
224  !
225  END IF
226  !
227  dblstep(1:nb,ib,ik_local(1:20,it)) = dblstep(1:nb,ib, ik_local(1:20,it)) &
228  & + matmul(w1(1:nb, 1:4), wlsm(1:4,1:20))
229  !
230  END DO ! ib
231  !$OMP END DO NOWAIT
232  !
233  END DO ! it
234  !
235  !$OMP END PARALLEL
236  !
237  dblstep(1:nb,1:nb,1:nk_local) = dblstep(1:nb,1:nb,1:nk_local) / dble(6 * nkbz)
238  !

References libtetrabz_dblstep2(), 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_dblstep().

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

◆ libtetrabz_dblstep2()

subroutine libtetrabz_dblstep_mod::libtetrabz_dblstep2 ( integer, intent(in)  nb,
real(8), dimension(4), intent(in)  ei1,
real(8), dimension(4,nb), intent(in)  ej1,
real(8), dimension(nb,4), intent(out)  w1 
)

Definition at line 244 of file libtetrabz_dblstep_mod.F90.

244  !
245  USE libtetrabz_common, ONLY : libtetrabz_sort, &
246  & libtetrabz_tsmall_a1, libtetrabz_tsmall_b1, &
247  & libtetrabz_tsmall_b2, libtetrabz_tsmall_b3, &
248  & libtetrabz_tsmall_c1, libtetrabz_tsmall_c2, &
249  & libtetrabz_tsmall_c3
250  IMPLICIT NONE
251  !
252  INTEGER,INTENT(IN) :: nb
253  REAL(8),INTENT(IN) :: ei1(4), ej1(4,nb)
254  REAL(8),INTENT(OUT) :: w1(nb,4)
255  !
256  INTEGER :: ib, indx(4)
257  REAL(8) :: e(4), thr = 1d-8, tsmall(4,4), v
258  !
259  DO ib = 1, nb
260  !
261  w1(ib,1:4) = 0d0
262  e(1:4) = - ei1(1:4) + ej1(1:4,ib)
263  CALL libtetrabz_sort(4,e,indx)
264  !
265  IF(abs(e(1)) < thr .AND. abs(e(4)) < thr) THEN
266  !
267  ! Theta(0) = 0.5
268  !
269  v = 0.5d0
270  w1(ib,1:4) = w1(ib,1:4) + v * 0.25d0
271  !
272  ELSE IF((e(1) <= 0d0 .AND. 0d0 < e(2)) .OR. (e(1) < 0d0 .AND. 0d0 <= e(2))) THEN
273  !
274  CALL libtetrabz_tsmall_a1(e,v,tsmall)
275  w1(ib,indx(1:4)) = w1(ib,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
276  !
277  ELSE IF((e(2) <= 0d0 .AND. 0d0 < e(3)) .OR. (e(2) < 0d0 .AND. 0d0 <= e(3))) THEN
278  !
279  CALL libtetrabz_tsmall_b1(e,v,tsmall)
280  w1(ib,indx(1:4)) = w1(ib,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
281  !
282  CALL libtetrabz_tsmall_b2(e,v,tsmall)
283  w1(ib,indx(1:4)) = w1(ib,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
284  !
285  CALL libtetrabz_tsmall_b3(e,v,tsmall)
286  w1(ib,indx(1:4)) = w1(ib,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
287  !
288  ELSE IF((e(3) <= 0d0 .AND. 0d0 < e(4)) .OR. (e(3) < 0d0 .AND. 0d0 <= e(4))) THEN
289  !
290  CALL libtetrabz_tsmall_c1(e,v,tsmall)
291  w1(ib,indx(1:4)) = w1(ib,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
292  !
293  CALL libtetrabz_tsmall_c2(e,v,tsmall)
294  w1(ib,indx(1:4)) = w1(ib,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
295  !
296  CALL libtetrabz_tsmall_c3(e,v,tsmall)
297  w1(ib,indx(1:4)) = w1(ib,indx(1:4)) + v * sum(tsmall(1:4,1:4), 1) * 0.25d0
298  !
299  ELSE IF(e(4) <= 0d0) THEN
300  !
301  w1(ib,1:4) = w1(ib,1:4) + 0.25d0
302  !
303  END IF
304  !
305  END DO ! ib = 1, nb
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_dblstep_main().

Here is the call graph for this function:
Here is the caller graph for this function:
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_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_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