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

Functions/Subroutines

subroutine, public libtetrabz_polcmplx (ltetra, bvec, nb, nge, eig1, eig2, ngw, wght, ne, e0, comm)
 
subroutine libtetrabz_polcmplx_main (wlsm, nt_local, ik_global, ik_local, nb, nkBZ, eig1, eig2, ne, e0, nk_local, polcmplx)
 
subroutine libtetrabz_polcmplx2 (nb, ne, e0, ei1, ej1, w1)
 
subroutine libtetrabz_polcmplx3 (ne, e0, de, w1)
 
real(8) function, dimension(2) libtetrabz_polcmplx_1234 (g1, g2, g3, g4)
 

Function/Subroutine Documentation

◆ libtetrabz_polcmplx()

subroutine, public libtetrabz_polcmplx_mod::libtetrabz_polcmplx ( 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,
complex(c_double_complex), dimension(ne*nb*nb,product(ngw(1:3))), intent(out)  wght,
integer(c_int), intent(in)  ne,
complex(c_double_complex), dimension(ne), intent(in)  e0,
integer(c_int), intent(in), optional  comm 
)

Definition at line 35 of file libtetrabz_polcmplx_mod.F90.

35  !
36  USE iso_c_binding
37  USE libtetrabz_common, ONLY : libtetrabz_initialize, libtetrabz_interpol_indx, libtetrabz_mpisum_zv
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), eig1(nb,PRODUCT(nge(1:3))), eig2(nb,PRODUCT(nge(1:3)))
42  COMPLEX(C_DOUBLE_COMPLEX),INTENT(IN) :: e0(ne)
43  COMPLEX(C_DOUBLE_COMPLEX),INTENT(OUT) :: wght(ne*nb*nb,PRODUCT(ngw(1:3)))
44  INTEGER(C_INT),INTENT(IN),OPTIONAL :: comm
45  !
46  LOGICAL :: linterpol
47  INTEGER :: nt_local, nk_local, nkBZ, ik, kintp(8)
48  INTEGER,ALLOCATABLE :: ik_global(:,:), ik_local(:,:)
49  REAL(8) :: wlsm(4,20), wintp(1,8)
50  REAL(8),ALLOCATABLE :: kvec(:,:)
51  COMPLEX(8),ALLOCATABLE :: wghtd(:,:,:)
52  !
53  IF(PRESENT(comm)) THEN
54  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
55  & nt_local,nkbz,ik_global,ik_local,kvec,comm)
56  ELSE
57  CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
58  & nt_local,nkbz,ik_global,ik_local,kvec)
59  END IF
60  !
61  IF(linterpol) THEN
62  !
63  ALLOCATE(wghtd(ne*nb*nb,1,nk_local))
64  CALL libtetrabz_polcmplx_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig1,eig2,ne,e0,nk_local,wghtd)
65  !
66  ! Interpolation
67  !
68  wght(1:ne*nb*nb,1:product(ngw(1:3))) = 0d0
69  DO ik = 1, nk_local
70  CALL libtetrabz_interpol_indx(ngw,kvec(1:3,ik),kintp,wintp)
71  wght(1:ne*nb*nb,kintp(1:8)) = wght(1:ne*nb*nb, kintp(1:8)) &
72  & + matmul(wghtd(1:ne*nb*nb,1:1,ik), wintp(1:1,1:8))
73  END DO ! ik = 1, nk_local
74  DEALLOCATE(wghtd, kvec)
75  !
76  IF(PRESENT(comm)) CALL libtetrabz_mpisum_zv(comm, ne*nb*nb*product(ngw(1:3)), wght)
77  !
78  ELSE
79  CALL libtetrabz_polcmplx_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig1,eig2,ne,e0,nk_local,wght)
80  END IF
81  !
82  DEALLOCATE(ik_global, ik_local)
83  !

References libtetrabz_common::libtetrabz_initialize(), libtetrabz_common::libtetrabz_interpol_indx(), libtetrabz_common::libtetrabz_mpisum_zv(), and libtetrabz_polcmplx_main().

Here is the call graph for this function:

◆ libtetrabz_polcmplx_main()

subroutine libtetrabz_polcmplx_mod::libtetrabz_polcmplx_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)  ne,
complex(8), dimension(ne), intent(in)  e0,
integer, intent(in)  nk_local,
complex(8), dimension(ne*nb,nb,nk_local), intent(out)  polcmplx 
)

Definition at line 89 of file libtetrabz_polcmplx_mod.F90.

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

References libtetrabz_polcmplx2(), 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_polcmplx().

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

◆ libtetrabz_polcmplx2()

subroutine libtetrabz_polcmplx_mod::libtetrabz_polcmplx2 ( integer, intent(in)  nb,
integer, intent(in)  ne,
complex(8), dimension(ne), intent(in)  e0,
real(8), dimension(4), intent(in)  ei1,
real(8), dimension(4,nb), intent(in)  ej1,
complex(8), dimension(ne,nb,4), intent(out)  w1 
)

Definition at line 247 of file libtetrabz_polcmplx_mod.F90.

247  !
248  USE libtetrabz_common, ONLY : libtetrabz_sort, &
249  & libtetrabz_tsmall_a1, libtetrabz_tsmall_b1, &
250  & libtetrabz_tsmall_b2, libtetrabz_tsmall_b3, &
251  & libtetrabz_tsmall_c1, libtetrabz_tsmall_c2, &
252  & libtetrabz_tsmall_c3
253  IMPLICIT NONE
254  !
255  INTEGER,INTENT(IN) :: nb, ne
256  COMPLEX(8),INTENT(IN) :: e0(ne)
257  REAL(8),INTENT(IN) :: ei1(4), ej1(4,nb)
258  COMPLEX(8),INTENT(OUT) :: w1(ne,nb,4)
259  !
260  INTEGER :: ib, indx(4)
261  REAL(8) :: de(4), e(4), thr = 1d-8, tsmall(4,4), v
262  COMPLEX(8) :: w2(ne,4)
263  !
264  DO ib = 1, nb
265  !
266  w1(1:ne,ib,1:4) = 0d0
267  e(1:4) = - ej1(1:4, ib)
268  CALL libtetrabz_sort(4,e,indx)
269  !
270  IF((e(1) <= 0d0 .AND. 0d0 < e(2)) .OR. (e(1) < 0d0 .AND. 0d0 <= e(2))) THEN
271  !
272  CALL libtetrabz_tsmall_a1(e,v,tsmall)
273  !
274  IF(v > thr) THEN
275  !
276  de(1:4) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),ib) - ei1(indx(1:4)))
277  CALL libtetrabz_polcmplx3(ne,e0,de,w2)
278  w1(1:ne,ib,indx(1:4)) = w1(1:ne,ib, indx(1:4)) &
279  & + v * matmul(w2(1:ne,1:4), tsmall(1:4,1:4))
280  !
281  END IF
282  !
283  ELSE IF((e(2) <= 0d0 .AND. 0d0 < e(3)) .OR. (e(2) < 0d0 .AND. 0d0 <= e(3))) THEN
284  !
285  CALL libtetrabz_tsmall_b1(e,v,tsmall)
286  !
287  IF(v > thr) THEN
288  !
289  de(1:4) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),ib) - ei1(indx(1:4)))
290  CALL libtetrabz_polcmplx3(ne,e0,de,w2)
291  w1(1:ne,ib,indx(1:4)) = w1(1:ne,ib, indx(1:4)) &
292  & + v * matmul(w2(1:ne,1:4), tsmall(1:4,1:4))
293  !
294  END IF
295  !
296  CALL libtetrabz_tsmall_b2(e,v,tsmall)
297  !
298  IF(v > thr) THEN
299  !
300  de(1:4) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),ib) - ei1(indx(1:4)))
301  CALL libtetrabz_polcmplx3(ne,e0,de,w2)
302  w1(1:ne,ib,indx(1:4)) = w1(1:ne,ib, indx(1:4)) &
303  & + v * matmul(w2(1:ne,1:4), tsmall(1:4,1:4))
304  !
305  END IF
306  !
307  CALL libtetrabz_tsmall_b3(e,v,tsmall)
308  !
309  IF(v > thr) THEN
310  !
311  de(1:4) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),ib) - ei1(indx(1:4)))
312  CALL libtetrabz_polcmplx3(ne,e0,de,w2)
313  w1(1:ne,ib,indx(1:4)) = w1(1:ne,ib, indx(1:4)) &
314  & + v * matmul(w2(1:ne,1:4), tsmall(1:4,1:4))
315  !
316  END IF
317  !
318  ELSE IF((e(3) <= 0d0 .AND. 0d0 < e(4)) .OR. (e(3) < 0d0 .AND. 0d0 <= e(4))) THEN
319  !
320  CALL libtetrabz_tsmall_c1(e,v,tsmall)
321  !
322  IF(v > thr) THEN
323  !
324  de(1:4) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),ib) - ei1(indx(1:4)))
325  CALL libtetrabz_polcmplx3(ne,e0,de,w2)
326  w1(1:ne,ib,indx(1:4)) = w1(1:ne,ib, indx(1:4)) &
327  & + v * matmul(w2(1:ne,1:4), tsmall(1:4,1:4))
328  !
329  END IF
330  !
331  CALL libtetrabz_tsmall_c2(e,v,tsmall)
332  !
333  IF(v > thr) THEN
334  !
335  de(1:4) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),ib) - ei1(indx(1:4)))
336  CALL libtetrabz_polcmplx3(ne,e0,de,w2)
337  w1(1:ne,ib,indx(1:4)) = w1(1:ne,ib, indx(1:4)) &
338  & + v * matmul(w2(1:ne,1:4), tsmall(1:4,1:4))
339  !
340  END IF
341  !
342  CALL libtetrabz_tsmall_c3(e,v,tsmall)
343  !
344  IF(v > thr) THEN
345  !
346  de(1:4) = matmul(tsmall(1:4,1:4), ej1(indx(1:4),ib) - ei1(indx(1:4)))
347  CALL libtetrabz_polcmplx3(ne,e0,de,w2)
348  w1(1:ne,ib,indx(1:4)) = w1(1:ne,ib, indx(1:4)) &
349  & + v * matmul(w2(1:ne,1:4), tsmall(1:4,1:4))
350  !
351  END IF
352  !
353  ELSE IF(e(4) <= 0d0) THEN
354  !
355  de(1:4) = ej1(1:4,ib) - ei1(1:4)
356  CALL libtetrabz_polcmplx3(ne,e0,de,w2)
357  w1(1:ne,ib,1:4) = w1(1:ne,ib,1:4) + w2(1:ne,1:4)
358  !
359  END IF
360  !
361  END DO
362  !

References libtetrabz_polcmplx3(), 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_polcmplx_main().

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

◆ libtetrabz_polcmplx3()

subroutine libtetrabz_polcmplx_mod::libtetrabz_polcmplx3 ( integer, intent(in)  ne,
complex(8), dimension(ne), intent(in)  e0,
real(8), dimension(4), intent(in)  de,
complex(8), dimension(ne,4), intent(out)  w1 
)

Definition at line 368 of file libtetrabz_polcmplx_mod.F90.

368  !
369  USE libtetrabz_common, ONLY : libtetrabz_sort
370  IMPLICIT NONE
371  !
372  INTEGER,INTENT(IN) :: ne
373  COMPLEX(8),INTENT(IN) :: e0(ne)
374  REAL(8),INTENT(IN) :: de(4)
375  COMPLEX(8),INTENT(OUT) :: w1(ne,4)
376  !
377  INTEGER :: ie, indx(4)
378  REAL(8) :: e(4), thr, w2(2,4), x(4)
379  !
380  e(1:4) = de(1:4)
381  CALL libtetrabz_sort(4,e,indx)
382  !
383  DO ie = 1, ne
384  !
385  ! I don't know which one is better.
386  ! The former is more stable.
387  ! The latter is more accurate ?
388  !
389  w1(ie,1:4) = 0.25d0 / (de(1:4) + e0(ie))
390  !
391  cycle
392  !
393  x(1:4) = (e(1:4) + dble(e0(ie))) / aimag(e0(ie))
394  !thr = maxval(de(1:4)) * 1d-3
395  thr = max(1d-3, maxval(x(1:4)) * 1d-2)
396  !
397  IF(abs(x(4) - x(3)) < thr) THEN
398  IF(abs(x(4) - x(2)) < thr) THEN
399  IF(abs(x(4) - x(1)) < thr) THEN
400  !
401  ! e(4) = e(3) = e(2) = e(1)
402  !
403  w2(1,4) = 0.25d0 * x(4) / ((1d0 + x(4)**2))
404  w2(2,4) = 0.25d0 / ((1d0 + x(4)**2))
405  w2(1:2,3) = w2(1:2,4)
406  w2(1:2,2) = w2(1:2,4)
407  w2(1:2,1) = w2(1:2,4)
408  !
409  ELSE
410  !
411  ! e(4) = e(3) = e(2)
412  !
413  w2(1:2,4) = libtetrabz_polcmplx_1211(x(4),x(1))
414  w2(1:2,3) = w2(1:2,4)
415  w2(1:2,2) = w2(1:2,4)
416  w2(1:2,1) = libtetrabz_polcmplx_1222(x(1),x(4))
417  !
418  !IF(ANY(w2(1:2,1:4) < 0d0)) THEN
419  ! WRITE(*,*) ie
420  ! WRITE(*,'(100e15.5)') x(1:4)
421  ! WRITE(*,'(2e15.5)') w2(1:2,1:4)
422  ! STOP "weighting 4=3=2"
423  !END IF
424  !
425  END IF
426  ELSE IF(abs(x(2) - x(1)) < thr ) THEN
427  !
428  ! e(4) = e(3), e(2) = e(1)
429  !
430  w2(1:2,4) = libtetrabz_polcmplx_1221(x(4),x(2))
431  w2(1:2,3) = w2(1:2,4)
432  w2(1:2,2) = libtetrabz_polcmplx_1221(x(2),x(4))
433  w2(1:2,1) = w2(1:2,2)
434  !
435  !IF(ANY(w2(1:2,1:4) < 0d0)) THEN
436  ! WRITE(*,*) ie
437  ! WRITE(*,'(100e15.5)') x(1:4)
438  ! WRITE(*,'(2e15.5)') w2(1:2,1:4)
439  ! STOP "weighting 4=3 2=1"
440  !END IF
441  !
442  ELSE
443  !
444  ! e(4) = e(3)
445  !
446  w2(1:2,4) = libtetrabz_polcmplx_1231(x(4),x(1),x(2))
447  w2(1:2,3) = w2(1:2,4)
448  w2(1:2,2) = libtetrabz_polcmplx_1233(x(2),x(1),x(4))
449  w2(1:2,1) = libtetrabz_polcmplx_1233(x(1),x(2),x(4))
450  !
451  !IF(ANY(w2(1:2,1:4) < 0d0)) THEN
452  ! WRITE(*,*) ie
453  ! WRITE(*,'(100e15.5)') x(1:4)
454  ! WRITE(*,'(2e15.5)') w2(1:2,1:4)
455  ! STOP "weighting 4=3"
456  !END IF
457  !
458  END IF
459  ELSE IF(abs(x(3) - x(2)) < thr) THEN
460  IF(abs(x(3) - x(1)) < thr) THEN
461  !
462  ! e(3) = e(2) = e(1)
463  !
464  w2(1:2,4) = libtetrabz_polcmplx_1222(x(4),x(3))
465  w2(1:2,3) = libtetrabz_polcmplx_1211(x(3),x(4))
466  w2(1:2,2) = w2(1:2,3)
467  w2(1:2,1) = w2(1:2,3)
468  !
469  !IF(ANY(w2(1:2,1:4) < 0d0)) THEN
470  ! WRITE(*,*) ie
471  ! WRITE(*,'(100e15.5)') x(1:4)
472  ! WRITE(*,'(2e15.5)') w2(1:2,1:4)
473  ! STOP "weighting 3=2=1"
474  !END IF
475  !
476  ELSE
477  !
478  ! e(3) = e(2)
479  !
480  w2(1:2,4) = libtetrabz_polcmplx_1233(x(4),x(1),x(3))
481  w2(1:2,3) = libtetrabz_polcmplx_1231(x(3),x(1),x(4))
482  w2(1:2,2) = w2(1:2,3)
483  w2(1:2,1) = libtetrabz_polcmplx_1233(x(1),x(4),x(3))
484  !
485  !IF(ANY(w2(1:2,1:4) < 0d0)) THEN
486  ! WRITE(*,*) ie
487  ! WRITE(*,'(100e15.5)') x(1:4)
488  ! WRITE(*,'(2e15.5)') w2(1:2,1:4)
489  ! STOP "weighting 3=2"
490  !END IF
491  !
492  END IF
493  ELSE IF(abs(x(2) - x(1)) < thr) THEN
494  !
495  ! e(2) = e(1)
496  !
497  w2(1:2,4) = libtetrabz_polcmplx_1233(x(4),x(3),x(2))
498  w2(1:2,3) = libtetrabz_polcmplx_1233(x(3),x(4),x(2))
499  w2(1:2,2) = libtetrabz_polcmplx_1231(x(2),x(3),x(4))
500  w2(1:2,1) = w2(1:2,2)
501  !
502  !IF(ANY(w2(1:2,1:4) < 0d0)) THEN
503  ! WRITE(*,*) ie
504  ! WRITE(*,'(100e15.5)') x(1:4)
505  ! WRITE(*,'(2e15.5)') w2(1:2,1:4)
506  ! STOP "weighting 2=1"
507  !END IF
508  !
509  ELSE
510  !
511  ! Different each other.
512  !
513  w2(1:2,4) = libtetrabz_polcmplx_1234(x(4),x(1),x(2),x(3))
514  w2(1:2,3) = libtetrabz_polcmplx_1234(x(3),x(1),x(2),x(4))
515  w2(1:2,2) = libtetrabz_polcmplx_1234(x(2),x(1),x(3),x(4))
516  w2(1:2,1) = libtetrabz_polcmplx_1234(x(1),x(2),x(3),x(4))
517  !
518  !IF(ANY(w2(1:2,1:4) < 0d0)) THEN
519  ! WRITE(*,*) ie
520  ! WRITE(*,'(100e15.5)') x(1:4)
521  ! WRITE(*,'(2e15.5)') w2(1:2,1:4)
522  ! STOP "weighting"
523  !END IF
524  !
525  END IF
526  !
527  w1(ie,indx(1:4)) = cmplx(w2(1,1:4) / aimag(e0(ie)), &
528  & w2(2,1:4) / (- aimag(e0(ie))), kind(0d0))
529  !
530  END DO ! ie
531  !

References libtetrabz_polcmplx_1234(), and libtetrabz_common::libtetrabz_sort().

Referenced by libtetrabz_polcmplx2().

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

◆ libtetrabz_polcmplx_1234()

real(8) function, dimension(2) libtetrabz_polcmplx_mod::libtetrabz_polcmplx_1234 ( real(8), intent(in)  g1,
real(8), intent(in)  g2,
real(8), intent(in)  g3,
real(8), intent(in)  g4 
)

Definition at line 540 of file libtetrabz_polcmplx_mod.F90.

540  !
541  IMPLICIT NONE
542  !
543  REAL(8),INTENT(IN) :: g1, g2, g3, g4
544  REAL(8) :: w(2)
545  !
546  REAL(8) :: w2, w3, w4
547  !
548  ! Real
549  !
550  w2 = 2d0*(3d0*g2**2 - 1d0)*(atan(g2) - atan(g1)) + (g2**2 - &
551  & 3d0)*g2*log((1d0 + g2**2)/( 1d0 + g1**2))
552  w2 = -2d0*(g2**2 - 1d0) + w2/(g2 - g1 )
553  w2 = w2/(g2 - g1 )
554  w3 = 2d0*(3d0*g3**2 - 1d0)*(atan(g3) - atan(g1)) + (g3**2 - &
555  & 3d0)*g3*log((1d0 + g3**2)/( 1d0 + g1**2))
556  w3 = -2d0*(g3**2 - 1d0) + w3/(g3 - g1 )
557  w3 = w3/(g3 - g1 )
558  w4 = 2d0*(3d0*g4**2 - 1d0)*(atan(g4) - atan(g1)) + (g4**2 - &
559  & 3d0)*g4*log((1d0 + g4**2)/( 1d0 + g1**2))
560  w4 = -2d0*(g4**2 - 1d0) + w4/(g4 - g1 )
561  w4 = w4/(g4 - g1 )
562  w2 = (w2 - w3)/(g2 - g3)
563  w4 = (w4 - w3)/(g4 - g3)
564  w(1) = (w4 - w2)/(2d0*(g4 - g2))
565  !
566  ! Imaginal
567  !
568  w2 = 2d0*(3d0 - g2**2)* &
569  & g2*(atan(g2) - atan(g1)) + (3d0*g2**2 - 1d0)* &
570  & log((1d0 + g2**2)/(1d0 + g1**2))
571  w2 = 4d0*g2 - w2/(g2 - g1)
572  w2 = w2/(g2 - g1)
573  w3 = 2d0*(3d0 - g3**2)* &
574  & g3*(atan(g3) - atan(g1)) + (3d0*g3**2 - 1d0)* &
575  & log((1d0 + g3**2)/(1d0 + g1**2))
576  w3 = 4d0*g3 - w3/(g3 - g1)
577  w3 = w3/(g3 - g1)
578  w4 = 2d0*(3d0 - g4**2)* &
579  & g4*(atan(g4) - atan(g1)) + (3d0*g4**2 - 1d0)* &
580  & log((1d0 + g4**2)/(1d0 + g1**2))
581  w4 = 4d0*g4 - w4/(g4 - g1)
582  w4 = w4/(g4 - g1)
583  w2 = (w2 - w3)/(g2 - g3)
584  w4 = (w4 - w3)/(g4 - g3)
585  w(2) = (w4 - w2)/(2d0*(g4 - g2))
586  !

Referenced by libtetrabz_polcmplx3().

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_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_mpisum_zv
subroutine, public libtetrabz_mpisum_zv(comm, ndim, vector)
Definition: libtetrabz_common.F90:708
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