Branch data Line data Source code
1 : :
2 : : #if defined HAVE_CONFIG_H
3 : : #include "config.h"
4 : : #endif
5 : : !!****m* ABINIT/m_ImpurityOperator
6 : : !! NAME
7 : : !! m_ImpurityOperator
8 : : !!
9 : : !! FUNCTION
10 : : !! manage all related to Impurity
11 : : !!
12 : : !! COPYRIGHT
13 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
14 : : !! This file is distributed under the terms of the
15 : : !! GNU General Public License, see ~abinit/COPYING
16 : : !! or http://www.gnu.org/copyleft/gpl.txt .
17 : : !!
18 : : !! NOTES
19 : : !!
20 : : !! SOURCE
21 : :
22 : : #include "defs.h"
23 : : MODULE m_ImpurityOperator
24 : : USE m_ListCdagC
25 : : USE m_Global
26 : : IMPLICIT NONE
27 : :
28 : : !!***
29 : :
30 : : PRIVATE
31 : :
32 : : !!****t* m_ImpurityOperator/ImpurityOperator
33 : : !! NAME
34 : : !! ImpurityOperator
35 : : !!
36 : : !! FUNCTION
37 : : !! This structured datatype contains the necessary data
38 : : !!
39 : : !! COPYRIGHT
40 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
41 : : !! This file is distributed under the terms of the
42 : : !! GNU General Public License, see ~abinit/COPYING
43 : : !! or http://www.gnu.org/copyleft/gpl.txt .
44 : : !!
45 : : !! SOURCE
46 : :
47 : : TYPE, PUBLIC :: ImpurityOperator
48 : : LOGICAL _PRIVATE :: doCheck = .FALSE.
49 : : INTEGER _PRIVATE :: flavors
50 : : ! Number of flavors
51 : : INTEGER :: activeFlavor
52 : : ! Flavor considered e.g when a segment is added
53 : :
54 : :
55 : : DOUBLE PRECISION _PRIVATE :: beta
56 : : ! Inverse of temperature.
57 : :
58 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: mat_U
59 : : ! for iflavor1 and iflavor2, mat_U(iflavor1,iflavor2) is the
60 : : ! coulomb interaction between iflavor1 and iflavor2.
61 : :
62 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) _PRIVATE :: overlaps ! total overlaps
63 : : ! for iflavor1 and iflavor2 overlaps(iflavor1,iflavor2) is the total
64 : : ! overlap between segments of iflavor1 and segments of iflavor2.
65 : :
66 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(: ) _PRIVATE :: updates ! new_(anti)seg
67 : : ! For a given flavor (activeflavor), gives for each other flavors, the
68 : : ! supplementary overlaps, called updates(otherflavor).
69 : :
70 : : TYPE(ListCdagC) _PRIVATE :: list_swap
71 : : TYPE(ListCdagC) , ALLOCATABLE, DIMENSION(: ) :: particles
72 : : ! for each flavor, particles(iflavor)%list(2,maxnbofsegment)
73 : : ! gives the beginning and end of each segment.
74 : :
75 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: Magmommat_orb
76 : : ! for iflavor1 and iflavor2, Magmommat(iflavor1,iflavor2) is the
77 : : ! orbital magnetic moments
78 : :
79 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: Magmommat_spin
80 : : ! for iflavor1 and iflavor2, Magmommat(iflavor1,iflavor2) is the
81 : : ! spin magnetic moments
82 : :
83 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: Magmommat_tot
84 : : ! for iflavor1 and iflavor2, Magmommat(iflavor1,iflavor2) is the
85 : : ! total magnetic moments
86 : :
87 : : DOUBLE PRECISION _PRIVATE :: checkNumber
88 : : DOUBLE PRECISION _PRIVATE :: tolerance
89 : : DOUBLE PRECISION _PRIVATE :: meanError
90 : : END TYPE ImpurityOperator
91 : : !!***
92 : :
93 : : PUBLIC :: ImpurityOperator_init
94 : : PUBLIC :: ImpurityOperator_reset
95 : : PUBLIC :: ImpurityOperator_computeU
96 : : PUBLIC :: ImpurityOperator_setUmat
97 : : PUBLIC :: ImpurityOperator_setUmatComplex
98 : : PUBLIC :: ImpurityOperator_setMu
99 : : PUBLIC :: ImpurityOperator_activateParticle
100 : : PUBLIC :: ImpurityOperator_getAvailableTime
101 : : PUBLIC :: ImpurityOperator_getAvailedTime
102 : : PUBLIC :: ImpurityOperator_add
103 : : PUBLIC :: ImpurityOperator_getSegment
104 : : PUBLIC :: ImpurityOperator_getsign
105 : : PUBLIC :: ImpurityOperator_remove
106 : : PUBLIC :: ImpurityOperator_getNewOverlap
107 : : PUBLIC :: ImpurityOperator_getTraceAdd
108 : : PUBLIC :: ImpurityOperator_getTraceRemove
109 : : PRIVATE :: ImpurityOperator_overlapSegFlav
110 : : PUBLIC :: ImpurityOperator_overlapflavor
111 : : PUBLIC :: ImpurityOperator_overlapSwap
112 : : PUBLIC :: ImpurityOperator_swap
113 : : PRIVATE :: ImpurityOperator_overlapIJ
114 : : PUBLIC :: ImpurityOperator_measDE
115 : : PUBLIC :: ImpurityOperator_measDEComplex
116 : : PUBLIC :: ImpurityOperator_cleanOverlaps
117 : : PUBLIC :: ImpurityOperator_measN
118 : : PUBLIC :: ImpurityOperator_destroy
119 : : PUBLIC :: ImpurityOperator_getErrorOverlap
120 : : PUBLIC :: ImpurityOperator_doCheck
121 : : PRIVATE :: ImpurityOperator_checkOverlap
122 : : PUBLIC :: ImpurityOperator_getError
123 : : PUBLIC :: ImpurityOperator_printLatex
124 : : PUBLIC :: ImpurityOperator_occup_histo_time
125 : : PUBLIC :: ImpurityOperator_setMagmommat
126 : :
127 : : CONTAINS
128 : : !!***
129 : :
130 : : !SUBROUTINE ImpurityOperator_init(this, flavors, beta, N)
131 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_init
132 : : !! NAME
133 : : !! ImpurityOperator_init
134 : : !!
135 : : !! FUNCTION
136 : : !! Initialize and allocate
137 : : !!
138 : : !! COPYRIGHT
139 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
140 : : !! This file is distributed under the terms of the
141 : : !! GNU General Public License, see ~abinit/COPYING
142 : : !! or http://www.gnu.org/copyleft/gpl.txt .
143 : : !!
144 : : !! INPUTS
145 : : !! this=ImpurtiyOperator
146 : : !! flavors=number of flavors
147 : : !! beta=inverse temperature
148 : : !! opt_histo=opt_histo
149 : : !!
150 : : !! OUTPUT
151 : : !!
152 : : !! SIDE EFFECTS
153 : : !!
154 : : !! NOTES
155 : : !!
156 : : !! SOURCE
157 : :
158 : 102 : SUBROUTINE ImpurityOperator_init(this, flavors, beta)
159 : :
160 : : !Arguments ------------------------------------
161 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
162 : : INTEGER , INTENT(IN ) :: flavors
163 : : !DOUBLE PRECISION , INTENT(IN ) :: U
164 : : !DOUBLE PRECISION , INTENT(IN ) :: J
165 : : DOUBLE PRECISION , INTENT(IN ) :: beta
166 : : !INTEGER , INTENT(IN ) :: N
167 : : !Local variables ------------------------------
168 : : INTEGER :: IT
169 : :
170 : 102 : this%flavors = flavors
171 : 102 : this%activeFlavor = 0
172 : 102 : this%beta = beta
173 : :
174 [ - + ]: 102 : IF ( MOD(flavors,2) .NE. 0 ) &
175 : 0 : CALL ERROR("ImpurityOperator_init : flavors is not even ")
176 : :
177 : : !#ifdef CTQMC_CHECK
178 : 102 : this%meanError = 0.d0
179 : 102 : this%checkNumber = 0.d0
180 : 102 : this%tolerance = 0.d0
181 : 102 : this%doCheck = .FALSE.
182 : : !#endif
183 [ - + - - : 102 : DT_FREEIF(this%particles)
- - - - ]
184 [ - + + - : 1382 : DT_MALLOC(this%particles,(1:flavors))
+ - + - -
+ - + - +
+ + + - ]
185 [ - + ]: 102 : FREEIF(this%mat_U)
186 [ - + + - : 408 : MALLOC(this%mat_U,(1:flavors,1:flavors))
- + + - +
- + - - +
- + - + ]
187 [ - + ]: 102 : FREEIF(this%overlaps)
188 [ - + + - : 306 : MALLOC(this%overlaps,(1:flavors,1:flavors))
- + + - -
+ - + -
+ ]
189 [ + + + + ]: 13170 : this%overlaps = 0.d0
190 [ - + ]: 102 : FREEIF(this%updates)
191 [ - + + - : 306 : MALLOC(this%updates,(1:flavors))
+ - + - -
+ - + -
+ ]
192 [ + + ]: 1178 : this%updates = 0.d0
193 [ - + ]: 102 : FREEIF(this%Magmommat_orb)
194 [ - + + - : 306 : MALLOC(this%Magmommat_orb,(1:flavors,1:flavors))
- + + - -
+ - + -
+ ]
195 [ - + ]: 102 : FREEIF(this%Magmommat_spin)
196 [ - + + - : 306 : MALLOC(this%Magmommat_spin,(1:flavors,1:flavors))
- + + - -
+ - + -
+ ]
197 [ - + ]: 102 : FREEIF(this%Magmommat_tot)
198 [ - + + - : 306 : MALLOC(this%Magmommat_tot,(1:flavors,1:flavors))
- + + - -
+ - + -
+ ]
199 : : !CALL ImpurityOperator_computeU(this, U, J)
200 : : !this%mat_U = U
201 : : !IF ( ASSOCIATED(this%mu) ) FREE(this%mu)
202 : : !MALLOC(this%mu,(1:flavors))
203 : :
204 : : !this%shift_mu = SUM(this%mat_U(:,1)) * .5d0
205 [ + + ]: 1178 : DO IT = 1,flavors
206 : : !CALL ListCdagC_init(this%particles(IT), DBLE(N)/beta,100) !FIXME size of the List
207 : 1076 : CALL ListCdagC_init(this%particles(IT),100) !FIXME size of the List
208 : 1076 : this%particles(IT)%list(0,C_ ) = beta ! Empty orbital
209 : 1178 : this%particles(IT)%list(0,Cdag_) = 0.d0
210 : : ! this%particles(IT)%list(0)%Cdag = beta ! Full orbital
211 : : ! this%particles(IT)%list(0)%C = 0.d0
212 : : END DO
213 : 102 : this%activeFlavor = 0
214 : 102 : END SUBROUTINE ImpurityOperator_init
215 : : !!***
216 : :
217 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_reset
218 : : !! NAME
219 : : !! ImpurityOperator_reset
220 : : !!
221 : : !! FUNCTION
222 : : !! reset operator
223 : : !!
224 : : !! COPYRIGHT
225 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
226 : : !! This file is distributed under the terms of the
227 : : !! GNU General Public License, see ~abinit/COPYING
228 : : !! or http://www.gnu.org/copyleft/gpl.txt .
229 : : !!
230 : : !! INPUTS
231 : : !! this=ImpurtiyOperator
232 : : !!
233 : : !! OUTPUT
234 : : !!
235 : : !! SIDE EFFECTS
236 : : !!
237 : : !! NOTES
238 : : !!
239 : : !! SOURCE
240 : :
241 : 49 : SUBROUTINE ImpurityOperator_reset(this)
242 : :
243 : : !Arguments ------------------------------------
244 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
245 : : !Local variables ------------------------------
246 : : INTEGER :: IT
247 : :
248 : 49 : this%activeFlavor = 0
249 [ + + + + ]: 6363 : this%overlaps = 0.d0
250 [ + + ]: 567 : this%updates = 0.d0
251 : : !#ifdef CTQMC_CHECK
252 : 49 : this%meanError = 0.d0
253 : 49 : this%checkNumber = 0.d0
254 : 49 : this%tolerance = 0.d0
255 : 49 : this%doCheck = .FALSE.
256 : : !#endif
257 [ + + ]: 567 : DO IT = 1,this%flavors
258 : 518 : CALL ListCdagC_clear(this%particles(IT))
259 : 518 : this%particles(IT)%list(0,C_ ) = this%beta ! Empty orbital
260 : 567 : this%particles(IT)%list(0,Cdag_) = 0.d0
261 : : ! this%particles(IT)%list(0)%Cdag = beta ! Full orbital
262 : : ! this%particles(IT)%list(0)%C = 0.d0
263 : : END DO
264 : :
265 : 49 : END SUBROUTINE ImpurityOperator_reset
266 : : !!***
267 : :
268 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_computeU
269 : : !! NAME
270 : : !! ImpurityOperator_computeU
271 : : !!
272 : : !! FUNCTION
273 : : !! Compute an interaction this for t2g like interaction
274 : : !!
275 : : !! COPYRIGHT
276 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
277 : : !! This file is distributed under the terms of the
278 : : !! GNU General Public License, see ~abinit/COPYING
279 : : !! or http://www.gnu.org/copyleft/gpl.txt .
280 : : !!
281 : : !! INPUTS
282 : : !! this=ImpurityOperator
283 : : !! U=Coulomb scrren interaction
284 : : !! J=Hund couplage
285 : : !!
286 : : !! OUTPUT
287 : : !!
288 : : !! SIDE EFFECTS
289 : : !!
290 : : !! NOTES
291 : : !!
292 : : !! SOURCE
293 : :
294 : 102 : SUBROUTINE ImpurityOperator_computeU(this, U, J)
295 : :
296 : : !Arguments ------------------------------------
297 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
298 : : DOUBLE PRECISION , INTENT(IN ) :: U
299 : : DOUBLE PRECISION , INTENT(IN ) :: J
300 : : !Local variables ------------------------------
301 : : INTEGER :: flavor11
302 : : INTEGER :: flavor12
303 : : INTEGER :: flavor21
304 : : INTEGER :: flavor22
305 : : INTEGER :: flavors
306 : : INTEGER :: flavors_2
307 : : DOUBLE PRECISION :: Uprime
308 : :
309 : 102 : Uprime = U - 2.d0 * J
310 : 102 : flavors = this%flavors
311 : 102 : flavors_2 = flavors / 2
312 [ + + ]: 640 : DO flavor11 = 1, flavors_2
313 : 538 : flavor12 = flavors - flavor11 + 1
314 : 538 : this%mat_U(flavor11, flavor11) = 0.d0
315 : 538 : this%mat_U(flavor12, flavor12) = 0.d0
316 : 538 : this%mat_U(flavor11+flavors_2, flavor11) = U
317 : 538 : this%mat_U(flavor12-flavors_2, flavor12) = U
318 [ + + ]: 1768 : DO flavor21 = flavor11+1, flavors_2
319 : 1230 : flavor22 = flavors - flavor21 + 1
320 : 1230 : this%mat_U(flavor21, flavor11) = Uprime
321 : 1230 : this%mat_U(flavor22-flavors_2, flavor12-flavors_2) = Uprime
322 : 1230 : this%mat_U(flavor21+flavors_2, flavor11+flavors_2) = Uprime
323 : 1768 : this%mat_U(flavor22, flavor12) = Uprime
324 : : END DO
325 [ + + ]: 1870 : DO flavor21 = flavor11+flavors_2+1, flavors
326 : 1230 : flavor22 = flavors - flavor21 + 1
327 : 1230 : this%mat_U(flavor21, flavor11) = Uprime - J
328 : 1230 : this%mat_U(flavor22+flavors_2, flavor12-flavors_2) = Uprime - J
329 : 1230 : this%mat_U(flavor21-flavors_2, flavor11+flavors_2) = Uprime - J
330 : 1768 : this%mat_U(flavor22, flavor12) = Uprime - J
331 : : END DO
332 : : END DO
333 : 102 : END SUBROUTINE ImpurityOperator_computeU
334 : : !!***
335 : :
336 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_setUmat
337 : : !! NAME
338 : : !! ImpurityOperator_setUmat
339 : : !!
340 : : !! FUNCTION
341 : : !! Set directly the U interaction this
342 : : !!
343 : : !! COPYRIGHT
344 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
345 : : !! This file is distributed under the terms of the
346 : : !! GNU General Public License, see ~abinit/COPYING
347 : : !! or http://www.gnu.org/copyleft/gpl.txt .
348 : : !!
349 : : !! INPUTS
350 : : !! this=ImpurtityOperator
351 : : !! matU=interaction this
352 : : !!
353 : : !! OUTPUT
354 : : !!
355 : : !! SIDE EFFECTS
356 : : !!
357 : : !! NOTES
358 : : !!
359 : : !! SOURCE
360 : :
361 [ - + ]: 49 : SUBROUTINE ImpurityOperator_setUmat(this, matU)
362 : :
363 : : !Arguments ------------------------------------
364 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
365 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: matU
366 : :
367 : : INTEGER :: iflavor1
368 : : INTEGER :: iflavor2
369 : :
370 [ + + - + ]: 147 : IF ( SIZE(matU) .NE. this%flavors*this%flavors ) &
371 : 0 : CALL ERROR("ImpurityOperator_setUmat : Wrong interaction this")
372 : :
373 [ + + ]: 567 : DO iflavor1 = 1, this%flavors
374 [ + + ]: 3206 : DO iflavor2 = iflavor1+1, this%flavors
375 : 2639 : this%mat_U(iflavor1,iflavor2) = matU(iflavor1,iflavor2)
376 : 3157 : this%mat_U(iflavor2,iflavor1) = matU(iflavor2,iflavor1)
377 : : END DO
378 : : END DO
379 : 49 : END SUBROUTINE ImpurityOperator_setUmat
380 : : !!***
381 : :
382 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_setUmatComplex
383 : : !! NAME
384 : : !! ImpurityOperator_setUmatComplex
385 : : !!
386 : : !! FUNCTION
387 : : !! Set directly the complex U interaction
388 : : !!
389 : : !! COPYRIGHT
390 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
391 : : !! This file is distributed under the terms of the
392 : : !! GNU General Public License, see ~abinit/COPYING
393 : : !! or http://www.gnu.org/copyleft/gpl.txt .
394 : : !!
395 : : !! INPUTS
396 : : !! this=ImpurtityOperator
397 : : !! matU=interaction this
398 : : !!
399 : : !! OUTPUT
400 : : !!
401 : : !! SIDE EFFECTS
402 : : !!
403 : : !! NOTES
404 : : !!
405 : : !! SOURCE
406 : :
407 [ # # ]: 0 : SUBROUTINE ImpurityOperator_setUmatComplex(this, matU)
408 : :
409 : : !Arguments ------------------------------------
410 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
411 : : COMPLEX(KIND=8), DIMENSION(:,:), INTENT(IN ) :: matU
412 : :
413 : : INTEGER :: iflavor1
414 : : INTEGER :: iflavor2
415 : :
416 [ # # # # ]: 0 : IF ( SIZE(matU) .NE. this%flavors*this%flavors ) &
417 : 0 : CALL ERROR("ImpurityOperator_setUmatComplex : Wrong interaction this")
418 : :
419 [ # # ]: 0 : DO iflavor1 = 1, this%flavors
420 [ # # ]: 0 : DO iflavor2 = iflavor1+1, this%flavors
421 : 0 : this%mat_U(iflavor1,iflavor2) = matU(iflavor1,iflavor2)
422 : 0 : this%mat_U(iflavor2,iflavor1) = matU(iflavor2,iflavor1)
423 : : END DO
424 : : END DO
425 : 0 : END SUBROUTINE ImpurityOperator_setUmatComplex
426 : : !!***
427 : :
428 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_setMu
429 : : !! NAME
430 : : !! ImpurityOperator_setMu
431 : : !!
432 : : !! FUNCTION
433 : : !! Set directly the chemical potential
434 : : !!
435 : : !! COPYRIGHT
436 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
437 : : !! This file is distributed under the terms of the
438 : : !! GNU General Public License, see ~abinit/COPYING
439 : : !! or http://www.gnu.org/copyleft/gpl.txt .
440 : : !!
441 : : !! INPUTS
442 : : !! this=ImpurtityOperator
443 : : !! mu=chimical potential
444 : : !!
445 : : !! OUTPUT
446 : : !!
447 : : !! SIDE EFFECTS
448 : : !!
449 : : !! NOTES
450 : : !!
451 : : !! SOURCE
452 : :
453 [ - + ]: 49 : SUBROUTINE ImpurityOperator_setMu(this, mu)
454 : :
455 : : !Arguments ------------------------------------
456 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
457 : : DOUBLE PRECISION, DIMENSION(:), INTENT(IN ) :: mu
458 : : INTEGER :: iflavor
459 : :
460 [ - + ]: 49 : IF ( SIZE(mu) .NE. this%flavors ) &
461 : 0 : CALL ERROR("ImpurityOperator_setMu : Wrong chimical potentials")
462 : :
463 [ + + ]: 567 : DO iflavor = 1, this%flavors
464 : 567 : this%mat_U(iflavor,iflavor) = mu(iflavor)
465 : : END DO
466 : 49 : END SUBROUTINE ImpurityOperator_setMu
467 : : !!***
468 : :
469 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_activateParticle
470 : : !! NAME
471 : : !! ImpurityOperator_activateParticle
472 : : !!
473 : : !! FUNCTION
474 : : !! active a flavor
475 : : !!
476 : : !! COPYRIGHT
477 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
478 : : !! This file is distributed under the terms of the
479 : : !! GNU General Public License, see ~abinit/COPYING
480 : : !! or http://www.gnu.org/copyleft/gpl.txt .
481 : : !!
482 : : !! INPUTS
483 : : !! this=ImpurityOperator
484 : : !! flavor=the flavor
485 : : !!
486 : : !! OUTPUT
487 : : !!
488 : : !! SIDE EFFECTS
489 : : !!
490 : : !! NOTES
491 : : !!
492 : : !! SOURCE
493 : :
494 : 0 : SUBROUTINE ImpurityOperator_activateParticle(this,flavor)
495 : :
496 : : !Arguments ------------------------------------
497 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
498 : : INTEGER , INTENT(IN ) :: flavor
499 : :
500 [ # # ]: 0 : IF ( flavor .GT. this%flavors ) &
501 : 0 : CALL ERROR("ImpurityOperator_activateParticle : out of range ")
502 [ # # ]: 0 : IF ( ALLOCATED(this%particles) ) THEN
503 : 0 : this%activeFlavor = flavor
504 : : ELSE
505 : 0 : CALL ERROR("ImpurityOperator_activateParticle : not allocated ")
506 : : END IF
507 : 0 : END SUBROUTINE ImpurityOperator_activateParticle
508 : : !!***
509 : :
510 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getAvailableTime
511 : : !! NAME
512 : : !! ImpurityOperator_getAvailableTime
513 : : !!
514 : : !! FUNCTION
515 : : !! get the time available and the position of the segment to consider
516 : : !! negative if on a segment
517 : : !! positive if outside a segment
518 : : !!
519 : : !! COPYRIGHT
520 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
521 : : !! This file is distributed under the terms of the
522 : : !! GNU General Public License, see ~abinit/COPYING
523 : : !! or http://www.gnu.org/copyleft/gpl.txt .
524 : : !!
525 : : !! INPUTS
526 : : !! this=ImpurityOperator
527 : : !! time=time to look for
528 : : !!
529 : : !! OUTPUT
530 : : !! ImpurityOperator_getAvailableTime=Time available
531 : : !! position=position of the next segment
532 : : !!
533 : : !! SIDE EFFECTS
534 : : !!
535 : : !! NOTES
536 : : !!
537 : : !! SOURCE
538 : :
539 : 1022389057 : DOUBLE PRECISION FUNCTION ImpurityOperator_getAvailableTime(this, time, position)
540 : :
541 : : !Arguments ------------------------------------
542 : : TYPE(ImpurityOperator), INTENT(IN ) :: this
543 : : DOUBLE PRECISION , INTENT(IN ) :: time
544 : : INTEGER , INTENT(OUT ) :: position
545 : : !Local variables ------------------------------
546 : : DOUBLE PRECISION :: t_avail
547 : : INTEGER :: position_dwn
548 : : INTEGER :: aF
549 : : #include "ListCdagC_firstHigher.h"
550 : 1022389057 : aF = this%activeFlavor
551 [ - + ]: 1022389057 : IF ( aF .LE. 0 ) &
552 : 0 : CALL ERROR("ImpurityOperator_getAvailableTime : no active flav")
553 : :
554 [ + + ]: 1022389057 : IF ( this%particles(aF)%tail .EQ. 0 ) THEN
555 : 448384430 : t_avail = this%particles(aF)%list(0,C_) - this%particles(aF)%list(0,Cdag_)
556 : 448384430 : position = SIGN(1,INT(t_avail))
557 : : ELSE
558 : : ! position = ListCdagC_firstHigher( this%particles(aF), time )
559 : : #define list_1 this%particles(aF)
560 : : #include "ListCdagC_firstHigher"
561 : : #undef list_1
562 : 574004627 : position = firstHigher
563 : 574004627 : position_dwn = position - 1
564 [ + + ]: 574004627 : IF ( position_dwn .LE. 0) position_dwn = this%particles(aF)%tail
565 : :
566 : : ! t_avail = (time - this%particles(aF)%list(position_dwn)) .MOD. this%beta
567 : 574004627 : t_avail = time - this%particles(aF)%list(position_dwn,C_)
568 [ + + ]: 574004627 : IF ( this%particles(aF)%list(position_dwn,Cdag_) .GT. time ) &
569 : 208166099 : t_avail = t_avail + this%beta
570 : :
571 [ + + ]: 574004627 : IF ( t_avail .GT. 0.d0 ) THEN !! We are outside the position_dwn segment
572 : : ! t_avail = (this%particles(aF)%list(ABS(position)) - time ) .MOD. this%beta
573 : 483417801 : t_avail = this%particles(aF)%list(ABS(position),Cdag_) - time
574 [ + + ]: 483417801 : IF ( this%particles(aF)%list(ABS(position),Cdag_) .LT. time ) &
575 : 177302137 : t_avail = t_avail + this%beta
576 : : ! ABS is used to prevent position to be -1 which is HERE the same as 1
577 : : ELSE
578 : 90586826 : position = - position_dwn
579 : : END IF
580 : : END IF
581 : :
582 : 1022389057 : ImpurityOperator_getAvailableTime = t_avail
583 : :
584 : 1022389057 : END FUNCTION ImpurityOperator_getAvailableTime
585 : : !!***
586 : :
587 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getAvailedTime
588 : : !! NAME
589 : : !! ImpurityOperator_getAvailedTime
590 : : !!
591 : : !! FUNCTION
592 : : !! get the time available without the segment "position"
593 : : !!
594 : : !! COPYRIGHT
595 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
596 : : !! This file is distributed under the terms of the
597 : : !! GNU General Public License, see ~abinit/COPYING
598 : : !! or http://www.gnu.org/copyleft/gpl.txt .
599 : : !!
600 : : !! INPUTS
601 : : !! this=ImpurityOperator
602 : : !! position=position of the segment
603 : : !!
604 : : !! OUTPUT
605 : : !! ImpurityOperator_getAvailedTime=time available before ...
606 : : !!
607 : : !! SIDE EFFECTS
608 : : !!
609 : : !! NOTES
610 : : !!
611 : : !! SOURCE
612 : :
613 : 573945019 : DOUBLE PRECISION FUNCTION ImpurityOperator_getAvailedTime(this, position)
614 : :
615 : : !Arguments ------------------------------------
616 : : TYPE(ImpurityOperator), INTENT(IN ) :: this
617 : : INTEGER , INTENT(IN ) :: position
618 : : DOUBLE PRECISION :: T_avail
619 : : INTEGER :: Pup
620 : : INTEGER :: ABSp
621 : : INTEGER :: tail
622 : : INTEGER :: aF
623 : :
624 : 573945019 : aF = this%activeFlavor
625 [ - + ]: 573945019 : IF ( aF .LE. 0 ) &
626 : 0 : CALL ERROR("ImpurityOperator_getAvailedTime : no active flavor")
627 : 573945019 : ABSp = ABS(position)
628 : : ! position_up = (ABSposition+1).MOD.this%particles(aF)%tail
629 : 573945019 : tail = this%particles(aF)%tail
630 [ + + ]: 573945019 : MODCYCLE(ABSp+1,tail,Pup)
631 [ + + ]: 573945019 : IF ( position .GT. 0 ) THEN
632 : : t_avail = this%particles(aF)%list(Pup, Cdag_) &
633 : 286970080 : - this%particles(aF)%list(ABSp,Cdag_)
634 : : ELSE
635 : : t_avail = this%particles(aF)%list(Pup ,C_) &
636 : 286974939 : - this%particles(aF)%list(ABSp,C_)
637 : : END IF
638 [ + + ]: 573945019 : IF ( t_avail .LE. 0.d0 ) t_avail = t_avail + this%beta
639 : 573945019 : ImpurityOperator_getAvailedTime = t_avail
640 : 573945019 : END FUNCTION ImpurityOperator_getAvailedTime
641 : : !!***
642 : :
643 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_add
644 : : !! NAME
645 : : !! ImpurityOperator_add
646 : : !!
647 : : !! FUNCTION
648 : : !! add a segment to the active flavor
649 : : !!
650 : : !! COPYRIGHT
651 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
652 : : !! This file is distributed under the terms of the
653 : : !! GNU General Public License, see ~abinit/COPYING
654 : : !! or http://www.gnu.org/copyleft/gpl.txt .
655 : : !!
656 : : !! INPUTS
657 : : !! this=ImpurityOperator
658 : : !! CdagC_1=couple of times
659 : : !! position_val=position of the CdagC_1 couple in the list
660 : : !!
661 : : !! OUTPUT
662 : : !!
663 : : !! SIDE EFFECTS
664 : : !! this=ImpurityOperatoroffdiag
665 : : !! this%particles(aF)%list is updated
666 : : !! this%overlaps is updated
667 : : !! NOTES
668 : : !!
669 : : !! SOURCE
670 : :
671 : 85920850 : SUBROUTINE ImpurityOperator_add(this, CdagC_1, position_val)
672 : :
673 : : !Arguments ------------------------------------
674 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
675 : : DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN ) :: CdagC_1
676 : : INTEGER , INTENT(IN ) :: position_val
677 : : !Local variables ------------------------------
678 : : INTEGER :: position
679 : : INTEGER :: aF
680 : : INTEGER :: i
681 : : DOUBLE PRECISION, DIMENSION(1:2) :: C2modify
682 : : DOUBLE PRECISION, DIMENSION(1:2) :: C2add
683 : : DOUBLE PRECISION :: TCdag
684 : : DOUBLE PRECISION :: TC
685 : :
686 : 85920850 : aF = this%activeFlavor
687 [ - + ]: 85920850 : IF ( aF .LE. 0 ) &
688 : 0 : CALL ERROR("ImpurityOperator_add : no active flavor ")
689 : :
690 : 85920850 : position = position_val
691 : :
692 [ + + ]: 85920850 : IF ( CdagC_1(C_) .GT. CdagC_1(Cdag_) ) THEN ! Ajout d'un segment
693 : 62352885 : C2add = CdagC_1
694 : : ELSE ! Ajout d'un antisegment
695 [ + + + - ]: 23567965 : IF ( (this%particles(aF)%tail .EQ. 0) .AND. (this%particles(aF)%list(0,C_) .EQ. 0d0)) THEN ! should be full orbital
696 [ + + ]: 36539 : IF ( CdagC_1(Cdag_) .GT. this%beta ) THEN
697 : : ! CALL CdagC_init(C2add,CdagC_1%Cdag-this%beta,CdagC_1%C)
698 : : ! From the IF condition and the creation of CdagC in TryAddRemove, we have
699 : : ! CdagC_1(Cdag_) > beta
700 : : ! CdagC_1(C_) < beta
701 : 5786 : C2add(Cdag_) = CdagC_1(Cdag_)-this%beta
702 : 5786 : C2add(C_ ) = CdagC_1(C_)
703 : : ! Now C2add(Cdag_) < beta
704 : : ! still C2add(C_) < beta
705 : : ELSE
706 : : ! CALL CdagC_init(C2add,CdagC_1%Cdag,CdagC_1%C+this%beta)
707 : : ! CdagC_1(Cdag_) < beta
708 : : ! CdagC_1(C_) < beta
709 : 30753 : C2add(Cdag_) = CdagC_1(Cdag_)
710 : 30753 : C2add(C_ ) = CdagC_1(C_)+this%beta
711 : : ! C2add(Cdag_) < beta
712 : : ! C2ass(C_) > beta
713 : : END IF
714 : 36539 : position = 0
715 : : ! See impurityoperator_init to understand this. This is due to the
716 : : ! convention for the full orbital case.
717 : 36539 : this%particles(aF)%list(0,C_ ) = this%beta
718 : 36539 : this%particles(aF)%list(0,Cdag_) = 0.d0
719 [ + - ]: 23531426 : ELSE IF ( this%particles(aF)%tail .GT. 0 ) THEN
720 : 23531426 : position = ABS(position)
721 : 23531426 : TCdag = this%particles(aF)%list(position,Cdag_)
722 : 23531426 : TC = CdagC_1(C_)
723 [ + + ]: 23531426 : IF ( TCdag .GT. TC ) TC = TC + this%beta
724 : : ! CALL CdagC_init(C2modify,TCdag,TC)
725 : 23531426 : C2modify(Cdag_) = TCdag
726 : 23531426 : C2modify(C_ ) = TC
727 : :
728 : : ! TCdag = CdagC_1%Cdag.MOD.this%beta
729 [ + + ]: 23531426 : MODCYCLE(CdagC_1(Cdag_),this%beta,TCdag)
730 : 23531426 : TC = this%particles(aF)%list(position,C_)
731 : : ! CALL CdagC_init(C2add,TCdag,TC)
732 : 23531426 : C2add(Cdag_) = TCdag
733 : 23531426 : C2add(C_ ) = TC
734 : :
735 [ + + ]: 70594278 : this%particles(aF)%list(position,:) = C2modify
736 [ + + ]: 23531426 : IF ( C2modify(Cdag_) .GT. C2add(Cdag_) ) THEN
737 : 2859166 : position = 0
738 : : ! C2add%C = C2add%C.MOD.this%beta
739 [ + - ]: 2859166 : MODCYCLE(C2add(C_),this%beta,C2add(C_))
740 : : END IF
741 : : ELSE
742 : 0 : CALL ERROR("ImpurityOperator_add : try to add an antisegment to an empty orbital")
743 : : END IF
744 : 23567965 : position = position + 1
745 : : END IF
746 : 85920850 : CALL ListCdagC_insert(this%particles(aF), c2add, position)
747 [ + + ]: 1141261694 : DO i = 1, this%flavors
748 : 1055340844 : this%overlaps(i,aF) = this%overlaps(i,aF) + this%updates(i)
749 : 1141261694 : this%overlaps(aF,i) = this%overlaps(i,aF)
750 : : END DO
751 : :
752 : 85920850 : END SUBROUTINE ImpurityOperator_add
753 : : !!***
754 : :
755 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getSegment
756 : : !! NAME
757 : : !! ImpurityOperator_getSegment
758 : : !!
759 : : !! FUNCTION
760 : : !! Return the segment at position_val
761 : : !!
762 : : !! COPYRIGHT
763 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
764 : : !! This file is distributed under the terms of the
765 : : !! GNU General Public License, see ~abinit/COPYING
766 : : !! or http://www.gnu.org/copyleft/gpl.txt .
767 : : !!
768 : : !! INPUTS
769 : : !! this=ImpurityOperator
770 : : !! position_val=position of the asked segment
771 : : !!
772 : : !! OUTPUT
773 : : !! ImpurityOperator_getSegment(2)=the couple of time
774 : : !!
775 : : !! SIDE EFFECTS
776 : : !!
777 : : !! NOTES
778 : : !!
779 : : !! SOURCE
780 : :
781 [ - + ]: 573945019 : FUNCTION ImpurityOperator_getSegment(this,position_val)
782 : :
783 : : !Arguments ------------------------------------
784 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
785 : : INTEGER , INTENT(IN ) :: position_val
786 : : !Local variables ------------------------------
787 : : INTEGER :: position
788 : : INTEGER :: tail
789 : : INTEGER :: aF
790 : : DOUBLE PRECISION :: beta
791 : : DOUBLE PRECISION :: ImpurityOperator_getSegment(1:2)
792 : :
793 : 573945019 : aF = this%activeFlavor
794 [ - + ]: 573945019 : IF ( aF .LE. 0 ) &
795 : 0 : CALL ERROR("ImpurityOperator_getSegment : no active flavor ")
796 : :
797 [ + + ]: 573945019 : IF ( position_val .GT. 0 ) THEN
798 [ + + ]: 860910240 : ImpurityOperator_getSegment = this%particles(aF)%list(position_val,1:2)
799 : : ELSE
800 : 286974939 : position = ABS(position_val)
801 : 286974939 : tail = this%particles(aF)%tail
802 : 286974939 : beta = this%beta
803 : 286974939 : ImpurityOperator_getSegment(C_) = this%particles(aF)%list(position,C_)
804 : 286974939 : position = position + 1
805 [ + + ]: 286974939 : IF ( position .GT. tail ) THEN
806 [ + + ]: 182719745 : IF ( ImpurityOperator_getSegment(C_) .LT. beta ) THEN
807 : 165235495 : ImpurityOperator_getSegment(Cdag_) = this%particles(aF)%list(1,Cdag_) + beta
808 : : ELSE
809 : 17484250 : ImpurityOperator_getSegment(Cdag_) = this%particles(aF)%list(1,Cdag_)
810 : 17484250 : ImpurityOperator_getSegment(C_) = ImpurityOperator_getSegment(C_) -beta
811 : : END IF
812 : : ELSE
813 : 104255194 : ImpurityOperator_getSegment(Cdag_) = this%particles(aF)%list(position,Cdag_)
814 : : END IF
815 : :
816 : : END IF
817 : : END FUNCTION ImpurityOperator_getSegment
818 : : !!***
819 : :
820 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_remove
821 : : !! NAME
822 : : !! ImpurityOperator_remove
823 : : !!
824 : : !! FUNCTION
825 : : !! Remove a segment for the active flavor
826 : : !!
827 : : !! COPYRIGHT
828 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
829 : : !! This file is distributed under the terms of the
830 : : !! GNU General Public License, see ~abinit/COPYING
831 : : !! or http://www.gnu.org/copyleft/gpl.txt .
832 : : !!
833 : : !! INPUTS
834 : : !! this=ImpurityOperator
835 : : !! ieme=segment to remove
836 : : !!
837 : : !! OUTPUT
838 : : !!
839 : : !! SIDE EFFECTS
840 : : !!
841 : : !! NOTES
842 : : !!
843 : : !! SOURCE
844 : :
845 : 85918401 : SUBROUTINE ImpurityOperator_remove(this,ieme)
846 : :
847 : : !Arguments ------------------------------------
848 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
849 : : INTEGER , INTENT(IN ) :: ieme
850 : : !Local variables ------------------------------
851 : : DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_1
852 : : INTEGER :: position
853 : : INTEGER :: position_dwn
854 : : INTEGER :: i
855 : : INTEGER :: tail
856 : : INTEGER :: aF
857 : : ! DOUBLE PRECISION :: toRemove
858 : :
859 : 85918401 : aF = this%activeFlavor
860 [ - + ]: 85918401 : IF ( aF .LE. 0 ) &
861 : 0 : CALL ERROR("ImpurityOperator_removeIeme : no active flavor ")
862 : 85918401 : position = ABS(ieme)
863 [ - + ]: 85918401 : IF ( position .GT. this%particles(aF)%tail ) &
864 : 0 : CALL ERROR("ImpurityOperator_removeIeme : out of range ")
865 : :
866 [ + + + + ]: 85918401 : IF ( (ieme .LT. 0) .AND. (this%particles(aF)%tail .GT. 1) ) THEN
867 : 23532317 : position_dwn = position
868 : : ! position = (position+1).MOD.this%particles(aF)%tail
869 : 23532317 : tail = this%particles(aF)%tail
870 [ + + ]: 23532317 : MODCYCLE((position+1),tail,position)
871 : 23532317 : CdagC_1(Cdag_) = this%particles(aF)%list(position_dwn,Cdag_)
872 : 23532317 : CdagC_1(C_ ) = this%particles(aF)%list(position,C_)
873 [ + + ]: 23532317 : IF (position_dwn .GT. position) CdagC_1(C_) = CdagC_1(C_) + this%beta
874 : : ! toRemove = this%particles(aF)%list(position)%C - (CdagC_1%C.MOD.this%beta)
875 : : ! CdagC_1%C = CdagC_1%C + toRemove
876 [ + + ]: 70596951 : this%particles(aF)%list(position_dwn,:) = CdagC_1
877 : : END IF
878 : :
879 [ + + ]: 85918401 : IF ( position .EQ. 1 ) THEN
880 : 33087724 : SELECT CASE (ieme)
881 : : CASE (1)
882 : 33087724 : this%particles(aF)%list(0,C_ ) = this%beta
883 : 33087724 : this%particles(aF)%list(0,Cdag_) = 0.d0
884 : : CASE (-1)
885 : 36539 : this%particles(aF)%list(0,C_ ) = 0.d0
886 [ + + + ]: 35984060 : this%particles(aF)%list(0,Cdag_) = this%beta
887 : : END SELECT
888 : : END IF
889 : 85918401 : CALL ListCdagC_erase(this%particles(aF),position)
890 [ + + ]: 1141234195 : DO i = 1, this%flavors
891 : 1055315794 : this%overlaps(i,aF) = this%overlaps(i,aF) - this%updates(i)
892 : 1141234195 : this%overlaps(aF,i) = this%overlaps(i,aF)
893 : : END DO
894 : 85918401 : END SUBROUTINE ImpurityOperator_remove
895 : : !!***
896 : :
897 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getNewOverlap
898 : : !! NAME
899 : : !! ImpurityOperator_getNewOverlap
900 : : !!
901 : : !! FUNCTION
902 : : !! Get the overlap induced by CdagC_1 in the current configuration
903 : : !!
904 : : !! COPYRIGHT
905 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
906 : : !! This file is distributed under the terms of the
907 : : !! GNU General Public License, see ~abinit/COPYING
908 : : !! or http://www.gnu.org/copyleft/gpl.txt .
909 : : !!
910 : : !! INPUTS
911 : : !! this=ImpurityOperator
912 : : !! CdagC_1=the segment
913 : : !!
914 : : !! OUTPUT
915 : : !! ImpurityOperator_getNewOverlap=overlap..
916 : : !!
917 : : !! SIDE EFFECTS
918 : : !!
919 : : !! NOTES
920 : : !!
921 : : !! SOURCE
922 : :
923 : 1085148433 : DOUBLE PRECISION FUNCTION ImpurityOperator_getNewOverlap(this, CdagC_1)
924 : :
925 : : !Arguments ------------------------------------
926 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
927 : : DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN) :: CdagC_1
928 : : !Local variables ------------------------------
929 : : DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_2
930 : : DOUBLE PRECISION :: overlap
931 : : DOUBLE PRECISION :: totalOverlap
932 : : DOUBLE PRECISION :: sign
933 : : INTEGER :: flavor
934 : : INTEGER :: otherFlavor
935 : :
936 : 1085148433 : flavor = this%activeFlavor
937 [ - + ]: 1085148433 : IF ( flavor .LE. 0 ) &
938 : 0 : CALL ERROR("ImpurityOperator_getNewOverlap : no active flavor ")
939 [ + + ]: 1085148433 : IF ( CdagC_1(Cdag_) .LT. CdagC_1(C_) ) THEN ! segment C*C
940 : 752590856 : CdagC_2 = CdagC_1
941 : 752590856 : sign = -1.d0
942 : : ELSE
943 : 332557577 : CdagC_2(C_) = CdagC_1(Cdag_)
944 : 332557577 : CdagC_2(Cdag_) = CdagC_1(C_)
945 : 332557577 : sign = 1.d0
946 : : END IF
947 : :
948 : 1085148433 : totalOverlap = 0.d0
949 : :
950 [ + + ]: 15549099615 : DO otherFlavor = 1, this%flavors
951 [ + + ]: 14463951182 : IF ( otherFlavor .EQ. flavor ) CYCLE
952 : 13378802749 : overlap = ImpurityOperator_overlapSegFlav(this,CdagC_2(1:2),otherflavor)
953 : : totalOverlap = totalOverlap &
954 : 13378802749 : + overlap * this%mat_U(otherFlavor,flavor)
955 : 15549099615 : this%updates(otherFlavor) = -sign * overlap
956 : : END DO
957 : :
958 : 1085148433 : totalOverlap = totalOverlap * sign
959 : 1085148433 : ImpurityOperator_getNewOverlap = totalOverlap
960 : :
961 : 1085148433 : END FUNCTION ImpurityOperator_getNewOverlap
962 : : !!***
963 : :
964 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getsign
965 : : !! NAME
966 : : !! ImpurityOperator_getsign
967 : : !!
968 : : !! FUNCTION
969 : : !! Get the sign of the ratio of impurity traces
970 : : !!
971 : : !! COPYRIGHT
972 : : !! Copyright (C) 2013-2026 ABINIT group (B. Amadon)
973 : : !! This file is distributed under the terms of the
974 : : !! GNU General Public License, see ~abinit/COPYING
975 : : !! or http://www.gnu.org/copyleft/gpl.txt .
976 : : !!
977 : : !! INPUTS
978 : : !! this = ImpurityOperator
979 : : !! time2 = for segment/antisegment addition, end of segment
980 : : !! position = for segment/antisegment removal, position of segment/antisegment removed
981 : : !! action = > 0.5 addition
982 : : !! < 0.5 removal
983 : : !!
984 : : !! OUTPUT
985 : : !! ImpurityOperator_getsign = sign of ratio of impurity traces
986 : : !!
987 : : !! SIDE EFFECTS
988 : : !!
989 : : !! NOTES
990 : : !!
991 : : !! SOURCE
992 : :
993 : 0 : DOUBLE PRECISION FUNCTION ImpurityOperator_getsign(this, time2, i, action, position)
994 : :
995 : : !Arguments ------------------------------------
996 : : TYPE(ImpurityOperator), INTENT(IN) :: this
997 : : DOUBLE PRECISION, INTENT(IN) :: time2, action
998 : : INTEGER , INTENT(IN) :: i,position
999 : : !Local variables ------------------------------
1000 : : INTEGER :: tailint
1001 : : DOUBLE PRECISION :: sign_imp
1002 : : ! ************************************************************************
1003 : 0 : tailint=this%particles(this%activeflavor)%tail
1004 [ # # ]: 0 : if(action < 0.5d0) then
1005 [ # # ]: 0 : if(tailint>=1) then
1006 [ # # ]: 0 : if ( this%particles(this%activeFlavor)%list(tailint,2)>this%beta ) then ! segment winds around
1007 [ # # ]: 0 : if (i==1) then ! add segment do not change winding
1008 : : sign_imp = 1
1009 [ # # ]: 0 : else if (i==2) then ! antisegment
1010 [ # # ]: 0 : if(time2>this%beta) then ! suppress winding around
1011 : : sign_imp = -1
1012 : : else ! winding around still here
1013 : 0 : sign_imp = 1
1014 : : endif
1015 : : endif
1016 : : else ! segment do not wind around
1017 [ # # ]: 0 : if (i==1) then ! segment
1018 [ # # ]: 0 : if(time2>this%beta) then ! create winding
1019 : : sign_imp = -1
1020 : : else ! do not create winding
1021 : 0 : sign_imp = 1
1022 : : endif
1023 [ # # ]: 0 : else if (i==2) then ! no winding in any case
1024 : 0 : sign_imp = 1
1025 : : endif
1026 : : endif
1027 [ # # ]: 0 : else if (tailint==0) then
1028 [ # # ]: 0 : if (i==1) then ! segment
1029 [ # # ]: 0 : if(time2>this%beta) then ! create winding
1030 : : sign_imp = -1
1031 : : else ! do not create winding
1032 : 0 : sign_imp = 1
1033 : : endif
1034 [ # # ]: 0 : else if (i==2) then ! antisegment
1035 [ # # ]: 0 : if(time2>this%beta) then ! do not create winding
1036 : : sign_imp = 1
1037 : : else ! create winding
1038 : 0 : sign_imp = -1
1039 : : endif
1040 : : endif
1041 : : endif
1042 : : else
1043 [ # # ]: 0 : if ( this%particles(this%activeFlavor)%list(tailint,2)>this%beta ) then ! segment winds around
1044 [ # # ]: 0 : if (i==1) then ! remove segment
1045 [ # # ]: 0 : if(position==tailint) then ! suppress winding around
1046 : : sign_imp = -1
1047 : : else ! winding around still here
1048 : 0 : sign_imp = 1
1049 : : endif
1050 [ # # ]: 0 : else if (i==2) then ! remove antisegment
1051 [ # # ]: 0 : if(tailint==1) then ! if tailint=1, create full orbital
1052 : : sign_imp = -1
1053 : : else ! if tailint >1 preserve winding
1054 : 0 : sign_imp = 1
1055 : : endif
1056 : : endif
1057 : : else ! segments do not wind around
1058 [ # # ]: 0 : if (i==1) then ! suppress segment do not change winding
1059 : : sign_imp = 1
1060 [ # # ]: 0 : else if (i==2) then ! antisegment
1061 [ # # ]: 0 : if(abs(position)==tailint) then ! create winding around only tailint >=1
1062 [ # # ]: 0 : if(tailint==1) then
1063 : : sign_imp = 1
1064 : : else
1065 : 0 : sign_imp = -1
1066 : : endif
1067 : : else !do not create winding around
1068 : : sign_imp = 1
1069 : : endif
1070 : : endif
1071 : : endif
1072 : : endif
1073 : :
1074 : 0 : ImpurityOperator_getsign=sign_imp
1075 : :
1076 : :
1077 : 0 : END FUNCTION ImpurityOperator_getsign
1078 : : !!***
1079 : :
1080 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getTraceAdd
1081 : : !! NAME
1082 : : !! ImpurityOperator_getTraceAdd
1083 : : !!
1084 : : !! FUNCTION
1085 : : !! Get the ratio of the traces of the impurity hamiltonien with and without the
1086 : : !! new (anti-)segment.
1087 : : !!
1088 : : !! COPYRIGHT
1089 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1090 : : !! This file is distributed under the terms of the
1091 : : !! GNU General Public License, see ~abinit/COPYING
1092 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1093 : : !!
1094 : : !! INPUTS
1095 : : !! this=ImpurityOperator
1096 : : !! CdagC_1=the segment
1097 : : !!
1098 : : !! OUTPUT
1099 : : !! ImpurityOperator_getTraceAdd = Tr[exp(-beta !H_impurity)c(t1)cd(t1)c(t2)cd(t2)...]/Tr[..]
1100 : : !!
1101 : : !! SIDE EFFECTS
1102 : : !!
1103 : : !! NOTES
1104 : : !!
1105 : : !! SOURCE
1106 : :
1107 : 511203414 : FUNCTION ImpurityOperator_getTraceAdd(this, CdagC_1) RESULT(trace)
1108 : :
1109 : : TYPE(ImpurityOperator) , INTENT(INOUT) :: this
1110 : : DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN ) :: CdagC_1
1111 : : LOGICAL :: antiseg
1112 : : DOUBLE PRECISION :: trace
1113 : : DOUBLE PRECISION :: overlap
1114 : : DOUBLE PRECISION :: length
1115 : : DOUBLE PRECISION :: antisym_sign
1116 : : DOUBLE PRECISION :: beta
1117 : :
1118 : 511203414 : beta = this%beta
1119 : 511203414 : antisym_sign = 1.0d0
1120 : 511203414 : overlap = ImpurityOperator_getNewOverlap(this,CdagC_1)
1121 : 511203414 : length = CdagC_1(C_ ) - CdagC_1(Cdag_)
1122 : 511203414 : antiseg = length .LT. 0.d0
1123 : : ! length > 0 if segment; < 0 if antisegment
1124 [ + + + + : 511203414 : if ( this%particles(this%activeFlavor)%tail .GT. 0 .AND. &
+ + + - +
+ ]
1125 : : ( ( (.NOT. antiseg) .AND. CdagC_1(C_) .GT. beta ) .OR. &! for seg only
1126 : : ( antiseg .AND. CdagC_1(C_) .LT. beta .AND. CdagC_1(Cdag_) .GT. beta ) & ! SIGN > 0 for antiseg only
1127 : : ) &
1128 : : ) THEN
1129 : : antisym_sign = -1.d0
1130 [ + + + + : 464337415 : ELSE IF ( this%particles(this%activeFlavor)%tail .EQ. 0 .AND. &
+ + + + ]
1131 : : ( ( (.NOT. antiseg) .AND. CdagC_1(C_) .GT. beta ) .OR. & ! >beta only possible for seg
1132 : : ( antiseg .AND. CdagC_1(Cdag_) .LT. beta ) & ! antiseg cdag < beta
1133 : : ) &
1134 : : ) THEN
1135 : 511203414 : antisym_sign = -1.d0
1136 : : END IF
1137 : :
1138 : 511203414 : trace = antisym_sign * DEXP(this%mat_U(this%activeFlavor,this%activeFlavor)*length + overlap)
1139 : :
1140 : 511203414 : END FUNCTION ImpurityOperator_getTraceAdd
1141 : : !!***
1142 : :
1143 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getTraceRemove
1144 : : !! NAME
1145 : : !! ImpurityOperator_getTraceRemove
1146 : : !!
1147 : : !! FUNCTION
1148 : : !! Get the ratio of the traces of the impurity hamiltonien without and with the
1149 : : !! (anti-)segment.
1150 : : !!
1151 : : !! COPYRIGHT
1152 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1153 : : !! This file is distributed under the terms of the
1154 : : !! GNU General Public License, see ~abinit/COPYING
1155 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1156 : : !!
1157 : : !! INPUTS
1158 : : !! this=ImpurityOperator
1159 : : !! position=position of the segment
1160 : : !!
1161 : : !! OUTPUT
1162 : : !! ImpurityOperator_getTraceRemove = Tr[exp(-beta !H_impurity)c(t1)cd(t1)c(t2)cd(t2)...]/Tr[..]
1163 : : !!
1164 : : !! SIDE EFFECTS
1165 : : !!
1166 : : !! NOTES
1167 : : !!
1168 : : !! SOURCE
1169 : :
1170 : 573945019 : FUNCTION ImpurityOperator_getTraceRemove(this, position) RESULT(trace)
1171 : :
1172 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
1173 : : INTEGER , INTENT(IN ) :: position
1174 : : INTEGER :: tail
1175 : : DOUBLE PRECISION :: trace
1176 : : DOUBLE PRECISION :: overlap
1177 : : DOUBLE PRECISION :: length
1178 : : DOUBLE PRECISION :: antisym_sign
1179 : : DOUBLE PRECISION :: last_C
1180 : : DOUBLE PRECISION :: beta
1181 : : DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_1
1182 : :
1183 : 573945019 : beta = this%beta
1184 : 573945019 : antisym_sign = 1.0d0
1185 : :
1186 : 573945019 : CdagC_1 = ImpurityOperator_getSegment(this,position)
1187 : 573945019 : length = CdagC_1(C_) - CdagC_1(Cdag_)
1188 : : ! length > 0 if segment; < 0 if antisegment
1189 : 573945019 : overlap = ImpurityOperator_getNewOverlap(this,CdagC_1)
1190 : :
1191 : 573945019 : tail = this%particles(this%activeFlavor)%tail
1192 : 573945019 : last_C = this%particles(this%activeFlavor)%list(tail,C_)
1193 [ + + ]: 573945019 : IF ( last_C .GT. beta ) THEN ! tail > 0 since if tail == 0 {0,beta}
1194 [ + + + + : 90558972 : IF ( ( position .EQ. tail ) .OR. & ! only possible for segment (<0 if antiseg)
+ + ]
1195 : : ( length .LT. 0.d0 .AND. tail .EQ. 1 ) ) THEN
1196 : 573945019 : antisym_sign = -1.d0
1197 : : END IF
1198 : : ELSE
1199 [ + + + + ]: 483386047 : IF ( tail .GT. 1 .AND. position .EQ. -tail ) & !tail>1 and last antisegment
1200 : 573945019 : antisym_sign = -1.d0
1201 : : END IF
1202 : :
1203 : 573945019 : trace = antisym_sign * DEXP(-this%mat_U(this%activeFlavor,this%activeFlavor)*length-overlap)
1204 : :
1205 : 573945019 : END FUNCTION ImpurityOperator_getTraceRemove
1206 : : !!***
1207 : :
1208 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_overlapSegFlav
1209 : : !! NAME
1210 : : !! ImpurityOperator_overlapSegFlav
1211 : : !!
1212 : : !! FUNCTION
1213 : : !! Compute the overlap of a segment with a flavor
1214 : : !!
1215 : : !! COPYRIGHT
1216 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1217 : : !! This file is distributed under the terms of the
1218 : : !! GNU General Public License, see ~abinit/COPYING
1219 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1220 : : !!
1221 : : !! INPUTS
1222 : : !! this=ImpurityOperator
1223 : : !! CdagC_1=segment
1224 : : !! flavor=flavor to use
1225 : : !!
1226 : : !! OUTPUT
1227 : : !! ImpurityOperator_overlapSegFlav=overlap between CdagC_1 and flavor
1228 : : !!
1229 : : !! SIDE EFFECTS
1230 : : !!
1231 : : !! NOTES
1232 : : !!
1233 : : !! SOURCE
1234 : :
1235 : 13379075945 : DOUBLE PRECISION FUNCTION ImpurityOperator_overlapSegFlav(this,CdagC_1,flavor)
1236 : :
1237 : : !Arguments ------------------------------------
1238 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
1239 : : ! TYPE(CdagC) , INTENT(IN) :: CdagC_1
1240 : : DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN) :: CdagC_1
1241 : : INTEGER , INTENT(IN) :: flavor
1242 : : !Local variables ------------------------------
1243 : : ! TYPE(CdagC), DIMENSION(:), POINTER :: list => NULL()
1244 : : DOUBLE PRECISION :: totalCdag
1245 : : DOUBLE PRECISION :: totalC
1246 : : DOUBLE PRECISION :: beta
1247 : : DOUBLE PRECISION :: Time
1248 : : DOUBLE PRECISION :: Tmin
1249 : : DOUBLE PRECISION :: Tmax
1250 : : DOUBLE PRECISION :: TmaxBeta
1251 : : DOUBLE PRECISION :: TscanMin
1252 : : DOUBLE PRECISION :: TscanMax
1253 : : ! DOUBLE PRECISION :: sign
1254 : : DOUBLE PRECISION :: C
1255 : : DOUBLE PRECISION :: Cdag
1256 : : DOUBLE PRECISION :: loop
1257 : : DOUBLE PRECISION :: itmin
1258 : : DOUBLE PRECISION :: itmax
1259 : : INTEGER :: tail
1260 : : INTEGER :: tp1
1261 : : INTEGER :: scanning
1262 : : INTEGER :: imin
1263 : : INTEGER :: imax
1264 : : INTEGER :: loops
1265 : : INTEGER :: iloop
1266 : : #include "ListCdagC_firstHigher.h"
1267 : :
1268 : 13379075945 : beta = this%beta
1269 : 13379075945 : Tmin = CdagC_1(Cdag_)
1270 : 13379075945 : Tmax = CdagC_1(C_)
1271 : 13379075945 : itmin= 0.d0
1272 : :
1273 : : ! TmaxBeta = Tmax.MOD.beta
1274 [ + + ]: 13379075945 : MODCYCLE(Tmax,beta,TmaxBeta)
1275 : :
1276 : 13379075945 : tail = this%particles(flavor)%tail
1277 : :
1278 : 13379075945 : totalC = 0.d0
1279 : 13379075945 : totalCdag = 0.d0
1280 [ + + ]: 13379075945 : IF ( tail .NE. 0 ) THEN
1281 : 7496007418 : tp1 = tail + 1
1282 : 7496007418 : loop = 0.d0
1283 : : ! imin = ListCdagC_firstHigher( this%particles(flavor), Tmin ) - 1
1284 [ + + ]: 7496007418 : Time = Tmin
1285 : : #define list_1 this%particles(flavor)
1286 : : #include "ListCdagC_firstHigher"
1287 : 7496007418 : imin = firstHigher - 1
1288 : :
1289 : : SELECT CASE ( imin )
1290 : : CASE(0)
1291 : : scanning = tail
1292 : 2695371299 : loop = -1.d0
1293 : : CASE(-2)
1294 : 2695371299 : scanning = tail
1295 : : CASE DEFAULT
1296 [ - + + ]: 4800636119 : scanning = imin
1297 : : END SELECT
1298 : : ! imax = ListCdagC_firstHigher( this%particles(flavor), TmaxBeta ) !- 1 Jamais atteint
1299 [ + + ]: 7496007418 : Time = TmaxBeta
1300 : : #include "ListCdagC_firstHigher"
1301 : : #undef list_1
1302 : 7496007418 : imax = firstHigher
1303 : :
1304 : 7496007418 : TscanMin = Tmin
1305 : 7496007418 : TscanMax = Tmax
1306 : :
1307 : : ! Regarder avant
1308 [ + + ]: 7496007418 : IF ( (imin .EQ. 0) ) THEN
1309 : 2739387399 : C = this%particles(flavor)%list(scanning,C_) +loop* beta
1310 : 2739387399 : Cdag = this%particles(flavor)%list(scanning,Cdag_) +loop* beta
1311 : 2739387399 : itmax = MAX(TscanMin, Cdag)
1312 : 2739387399 : itmin = MIN(TscanMax, C )
1313 : :
1314 [ + + ]: 2739387399 : IF ( itmin .GT. itmax ) THEN ! si egal alors overlap de 0
1315 : 110426425 : totalC = totalC + itmin
1316 : 110426425 : totalCdag = totalCdag + itmax
1317 : : END IF
1318 : 2739387399 : scanning = scanning+1
1319 [ + - ]: 2739387399 : IF ( scanning .EQ. tp1 ) THEN
1320 : 2739387399 : scanning = 1
1321 : : END IF
1322 : : END IF
1323 : :
1324 : 7496007418 : loops = imax - scanning
1325 [ + + ]: 7496007418 : IF ( TmaxBeta .NE. Tmax ) THEN
1326 : 2318179831 : loops = tail - loops
1327 [ + + ]: 5177827587 : ELSE IF ( imax .EQ. -1 ) THEN
1328 : 2122240439 : loops = tail - imin
1329 : : END IF
1330 : :
1331 : : !Comparer betement 2 segments
1332 [ + + ]: 19895265686 : DO iloop =0, loops
1333 : 17705437139 : C = this%particles(flavor)%list(scanning,C_)
1334 : 17705437139 : Cdag = this%particles(flavor)%list(scanning,Cdag_)
1335 : 17705437139 : itmax = MAX(TscanMin, Cdag)
1336 : 17705437139 : itmin = MIN(TscanMax,C)
1337 : :
1338 [ + + ]: 17705437139 : IF ( itmin .GT. itmax ) THEN ! si egal alors overla de 0
1339 : 5492571781 : totalC = totalC + itmin
1340 : 5492571781 : totalCdag = totalCdag + itmax
1341 : : END IF
1342 : 17705437139 : scanning = scanning + 1
1343 [ + + ]: 25201444557 : IF ( scanning .EQ. tp1 ) THEN
1344 : 9903763964 : scanning = 1
1345 [ + + ]: 9903763964 : IF ( itmin .EQ. TScanMax ) EXIT
1346 : 4597585093 : TscanMin = TscanMin - beta
1347 : 4597585093 : TscanMax = TscanMax - beta
1348 : : END IF
1349 : : END DO
1350 : :
1351 : : ! Regarder apres le segment
1352 [ + + ]: 7496007418 : IF ( (itmin .NE. TscanMax) ) THEN
1353 : 410163046 : C = this%particles(flavor)%list(scanning,C_)
1354 : 410163046 : Cdag = this%particles(flavor)%list(scanning,Cdag_)
1355 : 410163046 : itmax = MAX(TscanMin, Cdag)
1356 : 410163046 : itmin = MIN(TscanMax,C)
1357 : :
1358 [ + + ]: 410163046 : IF ( itmin .GT. itmax ) THEN ! si egal alors overla de 0
1359 : 268889390 : totalC = totalC + itmin
1360 : 268889390 : totalCdag = totalCdag + itmax
1361 : : END IF
1362 : : END IF
1363 [ + + ]: 5883068527 : ELSE IF ( this%particles(flavor)%list(0,C_) .EQ. 0.d0 ) THEN ! full orbital
1364 : 6336333 : totalC = Tmax
1365 : 6336333 : totalCdag = Tmin
1366 : : END IF
1367 : : !#ifdef CTQMC_CHECK
1368 [ - + ]: 13379075945 : IF ( this%doCheck .EQV. .TRUE. ) &
1369 : 0 : CALL ImpurityOperator_checkOverlap(this, Tmin, Tmax,totalC-totalCdag,flavor)
1370 : : !#endif
1371 : 13379075945 : ImpurityOperator_overlapSegFlav = totalC - totalCdag
1372 : :
1373 : 13379075945 : END FUNCTION ImpurityOperator_overlapSegFlav
1374 : : !!***
1375 : :
1376 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_overlapFlavor
1377 : : !! NAME
1378 : : !! ImpurityOperator_overlapFlavor
1379 : : !!
1380 : : !! FUNCTION
1381 : : !! Returns the overlap of flavor with the others
1382 : : !!
1383 : : !! COPYRIGHT
1384 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1385 : : !! This file is distributed under the terms of the
1386 : : !! GNU General Public License, see ~abinit/COPYING
1387 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1388 : : !!
1389 : : !! INPUTS
1390 : : !! this=ImpurityOperator
1391 : : !! flavor=the one we want
1392 : : !!
1393 : : !! OUTPUT
1394 : : !! ImpurityOperator_overlapFlavor=result
1395 : : !!
1396 : : !! SIDE EFFECTS
1397 : : !!
1398 : : !! NOTES
1399 : : !!
1400 : : !! SOURCE
1401 : :
1402 : 228580 : DOUBLE PRECISION FUNCTION ImpurityOperator_overlapFlavor(this,flavor)
1403 : :
1404 : : !Arguments ------------------------------------
1405 : : TYPE(ImpurityOperator), INTENT(IN) :: this
1406 : : INTEGER, OPTIONAL, INTENT(IN) :: flavor
1407 : : !Local variables ------------------------------
1408 : : INTEGER :: otherFlavor
1409 : : DOUBLE PRECISION :: overlap
1410 : : DOUBLE PRECISION :: totalOverlap
1411 : :
1412 : 228580 : totalOverlap = 0.d0
1413 [ + + ]: 2498940 : DO otherFlavor = 1, this%flavors
1414 [ + + ]: 2270360 : IF ( otherFlavor .EQ. flavor ) CYCLE
1415 : 2041780 : overlap = this%overlaps(otherFlavor,flavor)
1416 : : totalOverlap = totalOverlap &
1417 : 2498940 : + overlap * this%mat_U(otherFlavor,flavor)
1418 : : END DO
1419 : :
1420 : 228580 : ImpurityOperator_overlapFlavor = totalOverlap
1421 : :
1422 : 228580 : END FUNCTION ImpurityOperator_overlapflavor
1423 : : !!***
1424 : :
1425 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_overlapSwap
1426 : : !! NAME
1427 : : !! ImpurityOperator_overlapSwap
1428 : : !!
1429 : : !! FUNCTION
1430 : : !! compute the overlap of flavor1 with the configuration of flavor2
1431 : : !!
1432 : : !! COPYRIGHT
1433 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1434 : : !! This file is distributed under the terms of the
1435 : : !! GNU General Public License, see ~abinit/COPYING
1436 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1437 : : !!
1438 : : !! INPUTS
1439 : : !! this=ImpurityOperator
1440 : : !! flavor1=interaction value
1441 : : !! flavor2=configuration
1442 : : !!
1443 : : !! OUTPUT
1444 : : !! ImpurityOperator_overlapSwap=new overlap
1445 : : !!
1446 : : !! SIDE EFFECTS
1447 : : !!
1448 : : !! NOTES
1449 : : !!
1450 : : !! SOURCE
1451 : :
1452 : 228580 : DOUBLE PRECISION FUNCTION ImpurityOperator_overlapSwap(this,flavor1,flavor2)
1453 : :
1454 : : !Arguments ------------------------------------
1455 : : TYPE(ImpurityOperator), INTENT(IN) :: this
1456 : : INTEGER , INTENT(IN) :: flavor1
1457 : : INTEGER , INTENT(IN) :: flavor2
1458 : : !Local variables ------------------------------
1459 : : INTEGER :: otherFlavor
1460 : : DOUBLE PRECISION :: overlap
1461 : : DOUBLE PRECISION :: totalOverlap
1462 : :
1463 : 228580 : totalOverlap = 0.d0
1464 : : ! Calcul l'overlap de flavor1 en utilisant la configuration de flavor2
1465 [ + + ]: 2498940 : DO otherFlavor = 1, this%flavors
1466 [ + + ]: 2498940 : IF ( otherFlavor .EQ. flavor2 ) THEN
1467 : : CYCLE
1468 [ + + ]: 2041780 : ELSE IF ( otherFlavor .EQ. flavor1 ) THEN
1469 : 228580 : overlap = this%overlaps(otherFlavor,flavor2)
1470 : : totalOverlap = totalOverlap &
1471 : 228580 : + overlap * this%mat_U(otherFlavor,flavor2)
1472 : : ELSE
1473 : 1813200 : overlap = this%overlaps(otherFlavor,flavor2)
1474 : : totalOverlap = totalOverlap &
1475 : 1813200 : + overlap * this%mat_U(otherFlavor,flavor1)
1476 : : END IF
1477 : : END DO
1478 : :
1479 : 228580 : ImpurityOperator_overlapSwap = totalOverlap
1480 : :
1481 : 228580 : END FUNCTION ImpurityOperator_overlapSwap
1482 : : !!***
1483 : :
1484 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_swap
1485 : : !! NAME
1486 : : !! ImpurityOperator_swap
1487 : : !!
1488 : : !! FUNCTION
1489 : : !! Swap to flavors
1490 : : !!
1491 : : !! COPYRIGHT
1492 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1493 : : !! This file is distributed under the terms of the
1494 : : !! GNU General Public License, see ~abinit/COPYING
1495 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1496 : : !!
1497 : : !! INPUTS
1498 : : !! this=ImpurtiyOperator
1499 : : !! flavor1=to swap
1500 : : !! flavor2=to swap
1501 : : !!
1502 : : !! OUTPUT
1503 : : !!
1504 : : !! SIDE EFFECTS
1505 : : !!
1506 : : !! NOTES
1507 : : !!
1508 : : !! SOURCE
1509 : :
1510 : 95797 : SUBROUTINE ImpurityOperator_swap(this,flavor1, flavor2)
1511 : :
1512 : : !Arguments ------------------------------------
1513 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
1514 : : INTEGER , INTENT(IN ) :: flavor1
1515 : : INTEGER , INTENT(IN ) :: flavor2
1516 : : !Local variables ------------------------------
1517 : : INTEGER :: iflavor
1518 : : DOUBLE PRECISION :: overlap_tmp
1519 : :
1520 [ + + ]: 986059 : DO iflavor = 1, this%flavors
1521 [ + + + + ]: 986059 : IF ( iflavor .NE. flavor1 .AND. iflavor .NE. flavor2) THEN
1522 : 698668 : overlap_tmp = this%overlaps(iflavor,flavor1)
1523 : 698668 : this%overlaps(iflavor,flavor1) = this%overlaps(iflavor,flavor2)
1524 : 698668 : this%overlaps(flavor1,iflavor) = this%overlaps(iflavor,flavor2)
1525 : 698668 : this%overlaps(iflavor,flavor2) = overlap_tmp
1526 : 698668 : this%overlaps(flavor2,iflavor) = overlap_tmp
1527 : : END IF
1528 : : END DO
1529 : :
1530 : : !CALL ListCdagC_print(this%particles(flavor1),233)
1531 : : !CALL ListCdagC_print(this%particles(flavor2),233)
1532 : 95797 : CALL ListCdagC_assign(this%list_swap, this%particles(flavor1)) !list_swap = particle
1533 [ + - + - : 95797 : this%particles(flavor1) = this%particles(flavor2)
+ - + - ]
1534 [ + - + - : 95797 : this%particles(flavor2) = this%list_swap
+ - + - ]
1535 : : !CALL ListCdagC_swap(this%particles(flavor1),this%particles(flavor2))
1536 : : !CALL ListCdagC_print(this%particles(flavor1),233)
1537 : : !CALL ListCdagC_print(this%particles(flavor2),233)
1538 : :
1539 : 95797 : END SUBROUTINE ImpurityOperator_swap
1540 : : !!***
1541 : :
1542 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_overlapIJ
1543 : : !! NAME
1544 : : !! ImpurityOperator_overlapIJ
1545 : : !!
1546 : : !! FUNCTION
1547 : : !! Compute overlap between two flavors
1548 : : !!
1549 : : !! COPYRIGHT
1550 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1551 : : !! This file is distributed under the terms of the
1552 : : !! GNU General Public License, see ~abinit/COPYING
1553 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1554 : : !!
1555 : : !! INPUTS
1556 : : !! this=ImpurityOperator
1557 : : !! i=first flavor
1558 : : !! j=second flavor
1559 : : !!
1560 : : !! OUTPUT
1561 : : !! ImpurityOperator_overlapIJ=result
1562 : : !!
1563 : : !! SIDE EFFECTS
1564 : : !!
1565 : : !! NOTES
1566 : : !!
1567 : : !! SOURCE
1568 : :
1569 : 108071 : DOUBLE PRECISION FUNCTION ImpurityOperator_overlapIJ(this,i,j)
1570 : :
1571 : : !Arguments ------------------------------------
1572 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
1573 : : INTEGER , INTENT(IN) :: i
1574 : : INTEGER , INTENT(IN) :: j
1575 : : !Local variables ------------------------------
1576 : : ! TYPE(ListCdagC) , POINTER :: particle1 => NULL()
1577 : : ! DOUBLE PRECISION, DIMENSION(:,:), POINTER :: list1 => NULL()
1578 : : INTEGER :: tail1
1579 : : DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_1
1580 : : INTEGER :: isegment
1581 : :
1582 : : ! particle1 => this%particles(i)
1583 : : ! list1 => particle1%list
1584 : 108071 : tail1 = this%particles(i)%tail
1585 : :
1586 : 108071 : ImpurityOperator_overlapIJ = 0.d0
1587 [ + + + + ]: 108071 : IF ( tail1 .EQ. 0 .AND. this%particles(i)%list(0,C_) .EQ. 0.d0 ) THEN ! FULL
1588 : : ! CALL CdagC_init(CdagC_1,0.d0,this%beta)
1589 : 36 : CdagC_1(Cdag_) = 0.d0
1590 : 36 : CdagC_1(C_ ) = this%beta
1591 : :
1592 : 36 : ImpurityOperator_overlapIJ = ImpurityOperator_overlapSegFlav(this,CdagC_1,j)
1593 [ + + ]: 108035 : ELSE IF ( tail1 .GT. 0) THEN
1594 : 61242 : this%activeFlavor = i
1595 [ + + ]: 334402 : DO isegment = 1, tail1
1596 [ + + ]: 819480 : CdagC_1(:) = this%particles(i)%list(isegment,1:2)
1597 : : ImpurityOperator_overlapIJ = ImpurityOperator_overlapIJ &
1598 : 334402 : + ImpurityOperator_overlapSegFlav(this,CdagC_1,j)
1599 : : END DO
1600 : : END IF
1601 : :
1602 : 108071 : END FUNCTION ImpurityOperator_overlapIJ
1603 : : !!***
1604 : :
1605 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_measDE
1606 : : !! NAME
1607 : : !! ImpurityOperator_measDE
1608 : : !!
1609 : : !! FUNCTION
1610 : : !! measure double occupancy and interaction energy
1611 : : !!
1612 : : !! COPYRIGHT
1613 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1614 : : !! This file is distributed under the terms of the
1615 : : !! GNU General Public License, see ~abinit/COPYING
1616 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1617 : : !!
1618 : : !! INPUTS
1619 : : !! this=ImpurityOperator
1620 : : !!
1621 : : !! OUTPUT
1622 : : !! DE=array accumulating duoble occupancy and energy
1623 : : !!
1624 : : !! SIDE EFFECTS
1625 : : !!
1626 : : !! NOTES
1627 : : !!
1628 : : !! SOURCE
1629 : :
1630 [ - + ]: 78610000 : SUBROUTINE ImpurityOperator_measDE(this,DE)
1631 : :
1632 : : !Arguments ------------------------------------
1633 : : TYPE(ImpurityOperator), INTENT(IN) :: this
1634 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(INOUT) :: DE
1635 : : !Local variables ------------------------------
1636 : : DOUBLE PRECISION :: localD
1637 : : DOUBLE PRECISION :: totalE
1638 : : INTEGER :: iflavor1
1639 : : INTEGER :: iflavor2
1640 : : INTEGER :: flavors
1641 : :
1642 [ - + ]: 78610000 : IF ( .NOT. ALLOCATED(this%particles) ) &
1643 : 0 : CALL ERROR("ImpurityOperator_measD : no particle set ")
1644 : :
1645 : 78610000 : totalE = 0.d0
1646 : 78610000 : flavors = this%flavors
1647 [ + + ]: 1100990000 : DO iflavor1 = 1, flavors
1648 [ + + ]: 7468780000 : DO iflavor2 = iflavor1+1, flavors
1649 : : !localD = ImpurityOperator_overlapIJ(this,iflavor1,iflavor2)
1650 : 6367790000 : localD = this%overlaps(iflavor2,iflavor1)
1651 : 6367790000 : DE(iflavor2,iflavor1) = DE(iflavor2,iflavor1) + localD
1652 : 7390170000 : totalE = totalE + localD * real(this%mat_U(iflavor1,iflavor2))
1653 : : END DO
1654 : : END DO
1655 : :
1656 : 78610000 : DE(1,1) = DE(1,1) + totalE
1657 : :
1658 : 78610000 : END SUBROUTINE ImpurityOperator_measDE
1659 : : !!***
1660 : :
1661 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_measDEComplex
1662 : : !! NAME
1663 : : !! ImpurityOperator_measDEComplex
1664 : : !!
1665 : : !! FUNCTION
1666 : : !! measure double occupancy and interaction energy
1667 : : !!
1668 : : !! COPYRIGHT
1669 : : !! Copyright (C) 2013-2025 ABINIT group (J. Bieder)
1670 : : !! This file is distributed under the terms of the
1671 : : !! GNU General Public License, see ~abinit/COPYING
1672 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1673 : : !!
1674 : : !! INPUTS
1675 : : !! this=ImpurityOperator
1676 : : !!
1677 : : !! OUTPUT
1678 : : !! DE=array accumulating duoble occupancy and energy
1679 : : !!
1680 : : !! SIDE EFFECTS
1681 : : !!
1682 : : !! NOTES
1683 : : !!
1684 : : !! SOURCE
1685 : :
1686 [ # # ]: 0 : SUBROUTINE ImpurityOperator_measDEComplex(this,DE)
1687 : :
1688 : : !Arguments ------------------------------------
1689 : : TYPE(ImpurityOperator), INTENT(IN) :: this
1690 : : COMPLEX(KIND=8), DIMENSION(:,:), INTENT(INOUT) :: DE
1691 : : !Local variables ------------------------------
1692 : : COMPLEX(KIND=8) :: localD
1693 : : COMPLEX(KIND=8) :: totalE
1694 : : INTEGER :: iflavor1
1695 : : INTEGER :: iflavor2
1696 : : INTEGER :: flavors
1697 : :
1698 [ # # ]: 0 : IF ( .NOT. ALLOCATED(this%particles) ) &
1699 : 0 : CALL ERROR("ImpurityOperator_measD : no particle set ")
1700 : :
1701 : 0 : totalE = 0.d0
1702 : 0 : flavors = this%flavors
1703 [ # # ]: 0 : DO iflavor1 = 1, flavors
1704 [ # # ]: 0 : DO iflavor2 = iflavor1+1, flavors
1705 : : !localD = ImpurityOperator_overlapIJ(this,iflavor1,iflavor2)
1706 : 0 : localD = cmplx(this%overlaps(iflavor2,iflavor1),0.d0,kind=8)
1707 : 0 : DE(iflavor2,iflavor1) = DE(iflavor2,iflavor1) + localD
1708 : 0 : totalE = totalE + localD * this%mat_U(iflavor1,iflavor2)
1709 : : END DO
1710 : : END DO
1711 : :
1712 : 0 : DE(1,1) = DE(1,1) + totalE
1713 : :
1714 : 0 : END SUBROUTINE ImpurityOperator_measDEComplex
1715 : : !!***
1716 : :
1717 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_cleanOverlaps
1718 : : !! NAME
1719 : : !! ImpurityOperator_cleanOverlaps
1720 : : !!
1721 : : !! FUNCTION
1722 : : !! Compute from scratch all overlaps
1723 : : !!
1724 : : !! COPYRIGHT
1725 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1726 : : !! This file is distributed under the terms of the
1727 : : !! GNU General Public License, see ~abinit/COPYING
1728 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1729 : : !!
1730 : : !! INPUTS
1731 : : !! this=ImpurityOperator
1732 : : !!
1733 : : !! OUTPUT
1734 : : !!
1735 : : !! SIDE EFFECTS
1736 : : !!
1737 : : !! NOTES
1738 : : !!
1739 : : !! SOURCE
1740 : :
1741 : 2049 : SUBROUTINE ImpurityOperator_cleanOverlaps(this)
1742 : :
1743 : : !Arguments ------------------------------------
1744 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
1745 : : !Local variables ------------------------------
1746 : : INTEGER :: iflavor1
1747 : : INTEGER :: iflavor2
1748 : : INTEGER :: flavors
1749 : :
1750 [ - + ]: 2049 : IF ( .NOT. ALLOCATED(this%particles) ) &
1751 : 0 : CALL ERROR("ImpurityOperator_cleanOverlap : no particle set ")
1752 : :
1753 : 2049 : flavors = this%flavors
1754 [ + + ]: 22935 : DO iflavor1 = 1, flavors
1755 [ + + ]: 131006 : DO iflavor2 = iflavor1+1, flavors
1756 : 128957 : this%overlaps(iflavor2,iflavor1) = ImpurityOperator_overlapIJ(this,iflavor1,iflavor2)
1757 : : END DO
1758 : : END DO
1759 : :
1760 : 2049 : END SUBROUTINE ImpurityOperator_cleanOverlaps
1761 : : !!***
1762 : :
1763 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_measN
1764 : : !! NAME
1765 : : !! ImpurityOperator_measN
1766 : : !!
1767 : : !! FUNCTION
1768 : : !! measure the number of electrons on flavor flavor
1769 : : !!
1770 : : !! COPYRIGHT
1771 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1772 : : !! This file is distributed under the terms of the
1773 : : !! GNU General Public License, see ~abinit/COPYING
1774 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1775 : : !!
1776 : : !! INPUTS
1777 : : !! this=ImpurityOperator
1778 : : !! flavor=the flavor
1779 : : !!
1780 : : !! OUTPUT
1781 : : !! ImpurityOperator_measN=number of electrons
1782 : : !!
1783 : : !! SIDE EFFECTS
1784 : : !!
1785 : : !! NOTES
1786 : : !!
1787 : : !! SOURCE
1788 : :
1789 : 159198506 : DOUBLE PRECISION FUNCTION ImpurityOperator_measN(this,flavor)
1790 : :
1791 : : !Arguments ------------------------------------
1792 : : TYPE(ImpurityOperator), INTENT(IN) :: this
1793 : : INTEGER, OPTIONAL, INTENT(IN) :: flavor
1794 : : !Local variables ------------------------------
1795 : : DOUBLE PRECISION :: totalCdag
1796 : : DOUBLE PRECISION :: totalC
1797 : : INTEGER :: scanning
1798 : : INTEGER :: aF
1799 : :
1800 [ + + ]: 159198506 : IF ( PRESENT(flavor) ) THEN
1801 : 228580 : aF = flavor
1802 : : ELSE
1803 : 158969926 : aF = this%activeFlavor
1804 : : END IF
1805 : :
1806 [ - + ]: 159198506 : IF ( aF .LE. 0 ) &
1807 : 0 : CALL ERROR("ImpurityOperator_measN : no active flavor ")
1808 : :
1809 : 159198506 : totalC = (this%particles(aF)%list(0,Cdag_) - this%particles(aF)%list(0,C_) + this%beta) * .5d0
1810 : 159198506 : totalCdag = 0.d0
1811 : :
1812 [ + + ]: 715683726 : DO scanning = 1, this%particles(aF)%tail
1813 : 556485220 : totalCdag = totalCdag + this%particles(aF)%list(scanning,Cdag_)
1814 : 715683726 : totalC = totalC + this%particles(aF)%list(scanning,C_ )
1815 : : END DO
1816 : :
1817 : 159198506 : ImpurityOperator_measN = totalC - totalCdag
1818 : :
1819 : 159198506 : END FUNCTION ImpurityOperator_measN
1820 : : !!***
1821 : :
1822 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_destroy
1823 : : !! NAME
1824 : : !! ImpurityOperator_destroy
1825 : : !!
1826 : : !! FUNCTION
1827 : : !! destroy and deallocate
1828 : : !!
1829 : : !! COPYRIGHT
1830 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1831 : : !! This file is distributed under the terms of the
1832 : : !! GNU General Public License, see ~abinit/COPYING
1833 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1834 : : !!
1835 : : !! INPUTS
1836 : : !! this=ImpurityOperator
1837 : : !!
1838 : : !! OUTPUT
1839 : : !!
1840 : : !! SIDE EFFECTS
1841 : : !!
1842 : : !! NOTES
1843 : : !!
1844 : : !! SOURCE
1845 : :
1846 : 102 : SUBROUTINE ImpurityOperator_destroy(this)
1847 : :
1848 : : !Arguments ------------------------------------
1849 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
1850 : : !Local variables ------------------------------
1851 : : INTEGER :: IT
1852 : :
1853 [ + - ]: 102 : IF ( ALLOCATED(this%particles) ) THEN
1854 [ + + ]: 1178 : DO IT = 1, this%flavors
1855 : 1178 : CALL ListCdagC_destroy(this%particles(IT))
1856 : : END DO
1857 [ + - + + : 1178 : DT_FREE(this%particles)
- + - + ]
1858 : : ENDIF
1859 : 102 : CALL ListCdagC_destroy(this%list_swap)
1860 [ + - ]: 102 : FREEIF(this%mat_U)
1861 [ + - ]: 102 : FREEIF(this%Magmommat_orb)
1862 [ + - ]: 102 : FREEIF(this%Magmommat_spin)
1863 [ + - ]: 102 : FREEIF(this%Magmommat_tot)
1864 [ + - ]: 102 : FREEIF(this%overlaps)
1865 [ + - ]: 102 : FREEIF(this%updates)
1866 : 102 : this%activeFlavor = 0
1867 : 102 : this%flavors = 0
1868 : 102 : this%beta = 0.d0
1869 : 102 : END SUBROUTINE ImpurityOperator_destroy
1870 : : !!***
1871 : :
1872 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getErrorOverlap
1873 : : !! NAME
1874 : : !! ImpurityOperator_getErrorOverlap
1875 : : !!
1876 : : !! FUNCTION
1877 : : !! compute error on the overlap (numerical accumulation)
1878 : : !!
1879 : : !! COPYRIGHT
1880 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1881 : : !! This file is distributed under the terms of the
1882 : : !! GNU General Public License, see ~abinit/COPYING
1883 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1884 : : !!
1885 : : !! INPUTS
1886 : : !! this=ImpurityOperator
1887 : : !!
1888 : : !! OUTPUT
1889 : : !! DE=save the error
1890 : : !!
1891 : : !! SIDE EFFECTS
1892 : : !!
1893 : : !! NOTES
1894 : : !!
1895 : : !! SOURCE
1896 : :
1897 [ # # ]: 0 : SUBROUTINE ImpurityOperator_getErrorOverlap(this,DE)
1898 : :
1899 : : !Arguments ------------------------------------
1900 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
1901 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(INOUT) :: DE
1902 : : !Local variables ------------------------------
1903 : : DOUBLE PRECISION :: localD1
1904 : : DOUBLE PRECISION :: localD2
1905 : : DOUBLE PRECISION :: totalE1
1906 : : DOUBLE PRECISION :: totalE2
1907 : : INTEGER :: iflavor1
1908 : : INTEGER :: iflavor2
1909 : : INTEGER :: flavors
1910 : :
1911 [ # # ]: 0 : IF ( .NOT. ALLOCATED(this%particles) ) &
1912 : 0 : CALL ERROR("ImpurityOperator_getErrorOverlap : no particle set ")
1913 : :
1914 : 0 : totalE1 = 0.d0
1915 : 0 : totalE2 = 0.d0
1916 : 0 : flavors = this%flavors
1917 [ # # ]: 0 : DO iflavor1 = 1, flavors
1918 [ # # ]: 0 : DO iflavor2 = iflavor1+1, flavors
1919 : 0 : localD1 = ImpurityOperator_overlapIJ(this,iflavor1,iflavor2)
1920 : 0 : localD2 = this%overlaps(iflavor2,iflavor1)
1921 : 0 : totalE1 = totalE1 + localD1 * this%mat_U(iflavor1,iflavor2)
1922 : 0 : totalE2 = totalE2 + localD2 * this%mat_U(iflavor1,iflavor2)
1923 : : END DO
1924 : : END DO
1925 : :
1926 : 0 : DE(2,2) = ABS(totalE1 - totalE2)
1927 : :
1928 : 0 : END SUBROUTINE ImpurityOperator_getErrorOverlap
1929 : :
1930 : : !!***
1931 : : !#ifdef CTQMC_CHECK
1932 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_doCheck
1933 : : !! NAME
1934 : : !! ImpurityOperator_doCheck
1935 : : !!
1936 : : !! FUNCTION
1937 : : !! set the check mechanism
1938 : : !!
1939 : : !! COPYRIGHT
1940 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1941 : : !! This file is distributed under the terms of the
1942 : : !! GNU General Public License, see ~abinit/COPYING
1943 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1944 : : !!
1945 : : !! INPUTS
1946 : : !! this=ImpurityOperator
1947 : : !! opt_check=1||3 do check
1948 : : !!
1949 : : !! OUTPUT
1950 : : !!
1951 : : !! SIDE EFFECTS
1952 : : !!
1953 : : !! NOTES
1954 : : !!
1955 : : !! SOURCE
1956 : :
1957 : 49 : SUBROUTINE ImpurityOperator_doCheck(this,opt_check)
1958 : :
1959 : : !Arguments ------------------------------------
1960 : : TYPE(ImpurityOperator) , INTENT(INOUT) :: this
1961 : : INTEGER , INTENT(IN ) :: opt_check
1962 : :
1963 [ - + ]: 49 : IF ( opt_check .EQ. 1 .OR. opt_check .EQ. 3 ) &
1964 : 0 : this%doCheck = .TRUE.
1965 : 49 : END SUBROUTINE ImpurityOperator_doCheck
1966 : : !!***
1967 : :
1968 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_checkOverlap
1969 : : !! NAME
1970 : : !! ImpurityOperator_checkOverlap
1971 : : !!
1972 : : !! FUNCTION
1973 : : !! check the calculation of the overlap (very very slow routine)
1974 : : !! between Tmin and Tmax (c+ and c)
1975 : : !!
1976 : : !! COPYRIGHT
1977 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
1978 : : !! This file is distributed under the terms of the
1979 : : !! GNU General Public License, see ~abinit/COPYING
1980 : : !! or http://www.gnu.org/copyleft/gpl.txt .
1981 : : !!
1982 : : !! INPUTS
1983 : : !! this=ImpurityOperator
1984 : : !! Tmin=c+
1985 : : !! Tmax=c
1986 : : !! iOverlap=input overlap (fast calculation)
1987 : : !! iflavor=active flavor
1988 : : !!
1989 : : !! OUTPUT
1990 : : !!
1991 : : !! SIDE EFFECTS
1992 : : !!
1993 : : !! NOTES
1994 : : !!
1995 : : !! SOURCE
1996 : :
1997 : 0 : SUBROUTINE ImpurityOperator_checkOverlap(this, Tmin, Tmax, iOverlap, iflavor)
1998 : :
1999 : : !Arguments ------------------------------------
2000 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
2001 : : DOUBLE PRECISION , INTENT(IN ) :: Tmin
2002 : : DOUBLE PRECISION , INTENT(IN ) :: Tmax
2003 : : DOUBLE PRECISION , INTENT(IN ) :: iOverlap
2004 : : INTEGER , INTENT(IN ) :: iflavor
2005 : : !Local variables ------------------------------
2006 : : INTEGER, PARAMETER :: size=10000000
2007 : : INTEGER :: imin
2008 : : INTEGER :: imax
2009 : : INTEGER :: imaxbeta
2010 : : INTEGER :: isegment
2011 : : INTEGER :: tail
2012 : : INTEGER(1), DIMENSION(1:size,1:2) :: checktab
2013 : : CHARACTER(LEN=4) :: a
2014 : : DOUBLE PRECISION :: dt
2015 : : DOUBLE PRECISION :: inv_dt
2016 : : DOUBLE PRECISION :: overlap
2017 : : DOUBLE PRECISION :: erreur
2018 : : DOUBLE PRECISION :: weight
2019 : : INTEGER :: try
2020 : :
2021 : 0 : checktab = INT(0,1)
2022 : 0 : overlap = 0.d0
2023 : :
2024 : 0 : dt = this%beta / DBLE((size-1))
2025 : 0 : inv_dt = 1.d0 / dt
2026 : 0 : imin = INT(Tmin / dt + 0.5d0) + 1
2027 : 0 : imax = INT(Tmax / dt + 0.5d0) + 1
2028 [ # # ]: 0 : MODCYCLE(imax, size, imaxbeta)
2029 : :
2030 : 0 : tail = this%particles(iflavor)%tail
2031 : :
2032 [ # # ]: 0 : DO try = imin, MIN(imax,size)
2033 : 0 : checktab(try,1)=INT(1,1)!IBSET(checktab(try,1),0)
2034 : : END DO
2035 : :
2036 [ # # ]: 0 : IF ( imax .NE. imaxbeta ) THEN
2037 [ # # ]: 0 : DO try = 1, imaxbeta
2038 : 0 : checktab(try,1)=INT(1,1)!IBSET(checktab(try,1),0)
2039 : : END DO
2040 : : END IF
2041 : :
2042 [ # # ]: 0 : IF ( tail .NE. 0 ) THEN
2043 [ # # ]: 0 : DO isegment=1, tail
2044 : 0 : imin = INT(this%particles(iflavor)%list(isegment,Cdag_)* inv_dt + 0.5d0) + 1
2045 : 0 : imax = INT(this%particles(iflavor)%list(isegment,C_ )* inv_dt + 0.5d0) + 1
2046 [ # # ]: 0 : MODCYCLE(imax, size, imaxbeta)
2047 [ # # ]: 0 : DO try = imin, MIN(imax,size)
2048 : 0 : checktab(try,2)=INT(1,1)!IBSET(checktab(try,2),0)
2049 : : END DO
2050 [ # # ]: 0 : IF ( imax .NE. imaxbeta ) THEN
2051 [ # # ]: 0 : DO try = 1, imaxbeta
2052 : 0 : checktab(try,2)=INT(1,1)!IBSET(checktab(try,2),0)
2053 : : END DO
2054 : : END IF
2055 : : END DO
2056 [ # # ]: 0 : ELSE IF ( this%particles(iflavor)%list(0,C_) .EQ. 0.d0 ) THEN
2057 [ # # ]: 0 : DO try = 1, size
2058 : 0 : checktab(try,2)=INT(1,1)!IBSET(checktab(try,2),0)
2059 : : END DO
2060 : : END IF
2061 : :
2062 [ # # ]: 0 : DO isegment = 1, size
2063 [ # # ]: 0 : IF ( IAND(checktab(isegment,1),checktab(isegment,2)) .EQ. INT(1,1) ) &
2064 : 0 : overlap = overlap + 1.d0
2065 : : END DO
2066 : :
2067 : 0 : overlap = overlap * dt
2068 : :
2069 [ # # ]: 0 : IF ( iOverlap .EQ. 0.d0 ) THEN
2070 : 0 : erreur = ABS(overlap)
2071 : : ELSE
2072 : 0 : erreur = ABS(overlap - iOverlap)
2073 : : END IF
2074 : 0 : weight = ABS(2.d0 * DBLE(tail) * dt - iOverlap)
2075 [ # # ]: 0 : IF ( erreur .GT. weight ) THEN
2076 : 0 : WRITE(a,'(I4)') INT(erreur*100.d0)
2077 : 0 : CALL WARN("ImpurityOperator_checkOverlap : "//a//"% ")
2078 : : END IF
2079 [ # # ]: 0 : IF ( iOverlap .LE. (2.d0 * DBLE(tail) * dt) ) &
2080 : 0 : this%meanError = this%meanError + 1.d0
2081 : 0 : this%checkNumber = this%checkNumber + 1.d0 !weight
2082 : :
2083 : 0 : END SUBROUTINE ImpurityOperator_checkOverlap
2084 : : !!***
2085 : :
2086 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_getError
2087 : : !! NAME
2088 : : !! ImpurityOperator_getErro
2089 : : !!
2090 : : !! FUNCTION
2091 : : !! get error on computing the overlap
2092 : : !!
2093 : : !! COPYRIGHT
2094 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
2095 : : !! This file is distributed under the terms of the
2096 : : !! GNU General Public License, see ~abinit/COPYING
2097 : : !! or http://www.gnu.org/copyleft/gpl.txt .
2098 : : !!
2099 : : !! INPUTS
2100 : : !! this=ImpurityOperator
2101 : : !!
2102 : : !! OUTPUT
2103 : : !! ImpurityOperator_getError=percentage error
2104 : : !!
2105 : : !! SIDE EFFECTS
2106 : : !!
2107 : : !! NOTES
2108 : : !!
2109 : : !! SOURCE
2110 : :
2111 : 0 : DOUBLE PRECISION FUNCTION ImpurityOperator_getError(this)
2112 : :
2113 : : !Arguments ------------------------------------
2114 : : TYPE(ImpurityOperator), INTENT(IN) :: this
2115 : : !Local variables ------------------------------
2116 : : ! DOUBLE PRECISION :: tolerance
2117 : : DOUBLE PRECISION :: error
2118 : :
2119 [ # # ]: 0 : IF ( this%doCheck .EQV. .TRUE. ) THEN
2120 : 0 : error = ABS(this%meanError/this%checkNumber)
2121 : : ! tolerance = ABS(this%tolerance/this%checkNumber)
2122 : 0 : ImpurityOperator_getError = error
2123 : : ELSE
2124 : : ImpurityOperator_getError = 0.d0
2125 : : END IF
2126 : 0 : END FUNCTION ImpurityOperator_getError
2127 : : !!***
2128 : : !#endif
2129 : :
2130 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_printLatex
2131 : : !! NAME
2132 : : !! ImpurityOperator_printLatex
2133 : : !!
2134 : : !! FUNCTION
2135 : : !! print in a latex format all the configuration
2136 : : !!
2137 : : !! COPYRIGHT
2138 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
2139 : : !! This file is distributed under the terms of the
2140 : : !! GNU General Public License, see ~abinit/COPYING
2141 : : !! or http://www.gnu.org/copyleft/gpl.txt .
2142 : : !!
2143 : : !! INPUTS
2144 : : !! this=ImpurityOperator
2145 : : !! ostream=file stream
2146 : : !! isweep=current sweep number
2147 : : !!
2148 : : !! OUTPUT
2149 : : !!
2150 : : !! SIDE EFFECTS
2151 : : !!
2152 : : !! NOTES
2153 : : !!
2154 : : !! SOURCE
2155 : :
2156 : 0 : SUBROUTINE ImpurityOperator_printLatex(this, ostream, isweep)
2157 : :
2158 : : !Arguments ------------------------------------
2159 : : TYPE(ImpurityOperator), INTENT(IN) :: this
2160 : : INTEGER , INTENT(IN) :: ostream
2161 : : INTEGER , INTENT(IN) :: isweep
2162 : : !Local variables ------------------------------
2163 : : INTEGER :: flavors
2164 : : INTEGER :: iflavor
2165 : : INTEGER :: tail
2166 : : INTEGER :: it
2167 : : DOUBLE PRECISION :: C
2168 : : DOUBLE PRECISION :: Cdag
2169 : : INTEGER :: ordo
2170 : : INTEGER :: y
2171 : : INTEGER :: lines
2172 : : INTEGER :: letters
2173 : : DOUBLE PRECISION :: length
2174 : :
2175 : 0 : flavors = this%flavors
2176 : :
2177 : 0 : WRITE(ostream,'(A13)') "\begin{frame}"
2178 : 0 : WRITE(ostream,'(2x,A14)') "\begin{figure}"
2179 : 0 : WRITE(ostream,'(4x,A28)') "\setlength{\unitlength}{1mm}"
2180 : 0 : WRITE(ostream,'(4x,A23)') "\begin{picture}(104,90)"
2181 : 0 : WRITE(ostream,'(6x,A29,I6,A2)') "\put(52,00){\makebox(0,0)[c]{",isweep,"}}"
2182 : 0 : y = INT(90.d0/DBLE(flavors+1))
2183 [ # # ]: 0 : DO iflavor = 1, flavors
2184 : 0 : tail = this%particles(iflavor)%tail
2185 : 0 : ordo = iflavor * y
2186 : 0 : lines = ordo - 1
2187 : 0 : letters = ordo - 5
2188 : 0 : WRITE(ostream,'(6x,A6,I2)') "%ligne", iflavor
2189 : 0 : WRITE(ostream,'(6x,A41,I2,A16)') "\linethickness{0.5pt}\color{black}\put(2,",lines,"){\line(0,1){2}}"
2190 : 0 : WRITE(ostream,'(6x,A7,I2,A24)') "\put(2,",letters,"){\makebox(0,0)[c]{$0$}}"
2191 : 0 : WRITE(ostream,'(6x,A7,I2,A18)') "\put(2,",ordo,"){\line(1,0){100}}"
2192 : 0 : WRITE(ostream,'(6x,A9,I2,A16)') "\put(102,",lines,"){\line(0,1){2}}"
2193 : 0 : WRITE(ostream,'(6x,A9,I2,A28)') "\put(102,",letters,"){\makebox(0,0)[c]{$\beta$}}"
2194 [ # # ]: 0 : DO it = 1, tail
2195 : 0 : Cdag = 2.d0+(this%particles(iflavor)%list(it,Cdag_)/this%beta*100.d0)
2196 : 0 : C = 2.d0+(this%particles(iflavor)%list(it,C_ )/this%beta*100.d0)
2197 : 0 : length = C - Cdag
2198 [ # # ]: 0 : IF ( this%particles(iflavor)%list(it,C_) .LE. this%beta ) THEN
2199 : 0 : WRITE(ostream,'(8x,A9,I2)') "%segments", it
2200 : : WRITE(ostream,'(8x,A37,F5.1,A1,I2,A13,F5.1,A2)') &
2201 : 0 : "\linethickness{2pt}\color{black}\put(",Cdag,",",ordo,"){\line(1,0){",length,"}}"
2202 : 0 : WRITE(ostream,'(8x,A5)') "%Cdag"
2203 : 0 : WRITE(ostream,'(8x,A12)') "\color{blue}"
2204 : 0 : WRITE(ostream,'(8x,A5,F5.1,A1,I2,A14)') "\put(",Cdag,",",ordo,"){\circle*{1}}"
2205 : 0 : WRITE(ostream,'(8x,A2)') "%C"
2206 : 0 : WRITE(ostream,'(8x,A11)') "\color{red}"
2207 : 0 : WRITE(ostream,'(8x,A5,F5.1,A1,I2,A14)') "\put(",C,",",ordo,"){\circle*{1}}"
2208 : : ELSE
2209 : 0 : WRITE(ostream,'(8x,A9,I2)') "%segments", it
2210 : : WRITE(ostream,'(8x,A37,F5.1,A1,I2,A13,F5.1,A2)') &
2211 : 0 : "\linethickness{2pt}\color{black}\put(",Cdag,",",ordo,"){\line(1,0){",102.d0-Cdag,"}}"
2212 : 0 : WRITE(ostream,'(8x,A7,I2,A13,F5.1,A2)') "\put(2,",ordo,"){\line(1,0){",C-102.d0,"}}"
2213 : 0 : WRITE(ostream,'(8x,A5)') "%Cdag"
2214 : 0 : WRITE(ostream,'(8x,A12)') "\color{blue}"
2215 : 0 : WRITE(ostream,'(8x,A5,F5.1,A1,I2,A14)') "\put(",Cdag,",",ordo,"){\circle*{1}}"
2216 : 0 : WRITE(ostream,'(8x,A2)') "%C"
2217 : 0 : WRITE(ostream,'(8x,A11)') "\color{red}"
2218 : 0 : WRITE(ostream,'(8x,A5,F5.1,A1,I2,A14)') "\put(",C-100.d0,",",ordo,"){\circle*{1}}"
2219 : : END IF
2220 : : END DO
2221 [ # # # # ]: 0 : IF ( tail .EQ. 0 .AND. this%particles(iflavor)%list(0,C_) .EQ. 0.d0 ) THEN
2222 : 0 : WRITE(ostream,'(8x,A9,I2)') "%segments", it
2223 : 0 : WRITE(ostream,'(8x,A39,I2,A18)') "\linethickness{2pt}\color{black}\put(2,",ordo,"){\line(1,0){100}}"
2224 : : END IF
2225 : : END DO
2226 : 0 : WRITE(ostream,'(4x,A13)') "\end{picture}"
2227 : 0 : WRITE(ostream,'(2x,A12)') "\end{figure}"
2228 : 0 : WRITE(ostream,'(2x,A17)') "\transduration{0}"
2229 : 0 : WRITE(ostream,'(A11)') "\end{frame}"
2230 : 0 : END SUBROUTINE ImpurityOperator_printLatex
2231 : : !!***
2232 : :
2233 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_occup_histo_time
2234 : : !! NAME
2235 : : !! ImpurityOperator_occup_histo_time
2236 : : !!
2237 : : !! SUBROUTINE
2238 : : !! Compute histogrammes of occupations.
2239 : : !!
2240 : : !! COPYRIGHT
2241 : : !! Copyright (C) 2013-2026 ABINIT group (B. Amadon, F. Gendron)
2242 : : !! This file is distributed under the terms of the
2243 : : !! GNU General Public License, see ~abinit/COPYING
2244 : : !! or http://www.gnu.org/copyleft/gpl.txt .
2245 : : !!
2246 : : !! INPUTS
2247 : : !! this=ImpurityOperator
2248 : : !! histo=histogramme of occupations
2249 : : !!
2250 : : !! OUTPUT
2251 : : !! ImpurityOperator_occup_histo_time=number of electrons
2252 : : !!
2253 : : !! SIDE EFFECTS
2254 : : !!
2255 : : !! NOTES
2256 : : !!
2257 : : !! SOURCE
2258 : :
2259 [ - + - + : 3030000 : SUBROUTINE ImpurityOperator_occup_histo_time(this,histo,occupconfig,suscep,ntau,chi,chicharge,ntot,opt_histo,nspinor)
- + - + -
+ - + ]
2260 : :
2261 : : !Arguments ------------------------------------
2262 : : TYPE(ImpurityOperator), INTENT(IN) :: this
2263 : : DOUBLE PRECISION, DIMENSION(:), INTENT(OUT) :: histo
2264 : : DOUBLE PRECISION, DIMENSION(:), INTENT(OUT) :: occupconfig
2265 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(OUT) :: suscep
2266 : : INTEGER, INTENT(IN) :: ntau
2267 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(OUT) :: chi
2268 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(OUT) :: chicharge
2269 : : DOUBLE PRECISION, DIMENSION(:), INTENT(OUT) :: ntot
2270 : : !Local variables ------------------------------
2271 : : DOUBLE PRECISION :: tau
2272 : : INTEGER :: scanning, opt_histo,nspinor
2273 : : INTEGER :: iflavor, itau,jtau,kdeltatau,noccup,iconfig,sumh,nmeas
2274 : : INTEGER :: iflavor1, iflavor2
2275 : 3030000 : INTEGER, ALLOCATABLE, DIMENSION(:,:) :: occup
2276 : 3030000 : INTEGER, ALLOCATABLE, DIMENSION(:) :: occuptot
2277 : 3030000 : INTEGER, ALLOCATABLE, DIMENSION(:,:) :: spinup,spindn
2278 : 3030000 : INTEGER, ALLOCATABLE, DIMENSION(:) :: occupconfig_loc
2279 : 3030000 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: histo_loc
2280 : : ! DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: histo_loc_config
2281 : 3030000 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: magmommat_orb
2282 : 3030000 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: magmommat_spin
2283 : 3030000 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: magmommat_tot
2284 : 3030000 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: mu_tmp
2285 : : !-------------------------------------------------------------
2286 : :
2287 : :
2288 [ - + + - : 9090000 : MALLOC(occuptot,(1:ntau))
+ - + - -
+ - + ]
2289 [ - + + - : 9090000 : MALLOC(spinup,(1:3,1:ntau))
+ - + - -
+ - + ]
2290 [ - + + - : 6060000 : MALLOC(spindn,(1:3,1:ntau))
- + - + ]
2291 [ - + + - : 12120000 : MALLOC(occup,(1:this%flavors,1:ntau))
- + + - +
- + - - +
- + ]
2292 [ + - + - : 9090000 : MALLOC(occupconfig_loc,(2**this%flavors))
+ - - + +
- + - + -
+ - + - -
+ - + + -
+ - ]
2293 [ - + + - : 9090000 : MALLOC(histo_loc,(1:this%flavors+1))
+ - + - -
+ + - ]
2294 [ + + ]: 49646550000 : occupconfig_loc=0
2295 : : nmeas=0
2296 : :
2297 [ + + ]: 154530000 : do itau=1,ntau
2298 : 151500000 : tau=float(itau-1)/float(ntau)*this%beta
2299 : 151500000 : occuptot(itau)=0
2300 [ + + ]: 606000000 : spinup(:,itau)=0
2301 [ + + ]: 606000000 : spindn(:,itau)=0
2302 : : ! write(6,*) "tau",tau
2303 : : iconfig=0
2304 [ + + ]: 2272500000 : do iflavor = 1, this%flavors
2305 : 2121000000 : occup(iflavor,itau)=0
2306 [ + + ]: 3809123900 : do scanning = 1, this%particles(iflavor)%tail
2307 : : ! write(6,*) itau,iflavor,scanning
2308 : : ! write(6,*) "tau",tau,this%particles(iflavor)%list(scanning,Cdag_),this%particles(iflavor)%list(scanning,C_)
2309 : : ! write(6,*) "Hello Fred 2",tau,iflavor,this%particles(iflavor)%list(scanning,C_)-this%particles(iflavor)%list(scanning,Cdag_),this%beta
2310 : :
2311 [ + + + + ]: 3809123900 : if(this%particles(iflavor)%list(scanning,C_)>this%beta.and.tau<this%particles(iflavor)%list(scanning,Cdag_)) then
2312 : :
2313 [ + + + - ]: 129001423 : if(tau<(this%particles(iflavor)%list(scanning,C_)-this%beta).and.&
2314 : : & tau>(this%particles(iflavor)%list(scanning,Cdag_)-this%beta)) then
2315 : 25001657 : occup(iflavor,itau)=occup(iflavor,itau)+1
2316 : : endif
2317 : :
2318 : : else
2319 : :
2320 [ + + + + ]: 1559122477 : if(tau<this%particles(iflavor)%list(scanning,C_).and.tau>this%particles(iflavor)%list(scanning,Cdag_)) then
2321 : 125750275 : occup(iflavor,itau)=occup(iflavor,itau)+1
2322 : : endif
2323 : :
2324 : : endif
2325 : :
2326 : : enddo
2327 : :
2328 : : !full orbital
2329 [ + + ]: 2121000000 : if ( this%particles(iflavor)%list(0,C_) .eq. 0.d0 ) then
2330 : : !write(6,*) "Yes",this%particles(iflavor)%list(0,C_)
2331 : 690500 : occup(iflavor,itau)=occup(iflavor,itau)+1
2332 : : endif
2333 : :
2334 : 2121000000 : occuptot(itau)= occuptot(itau) + occup(iflavor,itau)
2335 [ + - ]: 2121000000 : if(nspinor .eq. 1) then
2336 [ + + ]: 2121000000 : if(iflavor<this%flavors/2+1) THEN
2337 : 1060500000 : spinup(1,itau)= spinup(1,itau) + occup(iflavor,itau)
2338 [ + + ]: 1060500000 : if(iflavor==1.or.iflavor==2.or.iflavor==4.or.iflavor==6.or.iflavor==7.or.iflavor==9) THEN
2339 : 757500000 : spinup(2,itau)= spinup(2,itau) + occup(iflavor,itau)
2340 : : else
2341 : 303000000 : spinup(3,itau)= spinup(3,itau) + occup(iflavor,itau)
2342 : : !if(spinup(3,itau)>4) THEN
2343 : : ! write(6,*) "Error",spinup(:,itau),occup(:,itau)
2344 : : ! if(iflavor==1.or.iflavor==2.or.iflavor==4) THEN
2345 : : ! write(6,*) iflavor,occup(iflavor,itau)
2346 : : ! endif
2347 : : ! stop
2348 : : !endif
2349 : : endif
2350 : : else
2351 : 1060500000 : spindn(1,itau)= spindn(1,itau) + occup(iflavor,itau)
2352 [ + + ]: 1060500000 : if(iflavor==1.or.iflavor==2.or.iflavor==4.or.iflavor==6.or.iflavor==7.or.iflavor==9) THEN
2353 : 151500000 : spindn(2,itau)= spindn(2,itau) + occup(iflavor,itau)
2354 : : else
2355 : 909000000 : spindn(3,itau)= spindn(3,itau) + occup(iflavor,itau)
2356 : : !if(spindn(3,itau)>4) THEN
2357 : : ! write(6,*) "Error spin",spindn(:,itau),occup(:,itau)
2358 : : ! write(6,*) "Error occup",occup(:,itau)
2359 : : ! if(iflavor==1.or.iflavor==2.or.iflavor==4) THEN
2360 : : ! write(6,*) iflavor,occup(iflavor,itau)
2361 : : ! endif
2362 : : ! stop
2363 : : !endif
2364 : : endif
2365 : : endif
2366 : : else
2367 : : !spin-orbit case (here only useful for chi_charge and f-elements)
2368 [ # # ]: 0 : if(iflavor < 7) then
2369 : : !mj=5/2
2370 : 0 : spinup(2,itau) = spinup(2,itau) + occup(iflavor,itau)
2371 : : !if(iflavor ==1.or.iflavor==2.or.iflavor==3.or.iflavor==4) then
2372 : : ! spinup(2,itau) = spinup(2,itau) + occup(iflavor,itau)
2373 : : !else
2374 : : ! spinup(3,itau) = spinup(3,itau) + occup(iflavor,itau)
2375 : : !end if
2376 : : else
2377 : : !mj=7/2
2378 : 0 : spinup(3,itau) = spindn(3,itau) + occup(iflavor,itau)
2379 : : end if
2380 : : end if
2381 : :
2382 : : ! === Construct index of configuration in base 10
2383 [ + - ]: 2272500000 : iconfig=iconfig+2**(iflavor-1)*occup(iflavor,itau)
2384 : :
2385 : : enddo
2386 : :
2387 : : ! === After the loop over flavor, iconfig has a meaning and can be used
2388 : 151500000 : occupconfig_loc(iconfig+1)= occupconfig_loc(iconfig+1)+1
2389 : 3030000 : nmeas=nmeas+1
2390 : :
2391 : : enddo
2392 : :
2393 [ + + ]: 48480000 : histo_loc=0
2394 [ + + ]: 154530000 : do itau=1,ntau
2395 : 154530000 : histo_loc(occuptot(itau)+1)=histo_loc(occuptot(itau)+1)+1
2396 : : enddo
2397 : :
2398 : : ! write(6,*)
2399 : : ! write(6,*) "=== Histogram of occupations ===="
2400 [ + + ]: 48480000 : do noccup=1,this%flavors+1
2401 : 45450000 : histo_loc(noccup)=histo_loc(noccup)/float(ntau)*100.0
2402 : : ! write(6,*) noccup-1, histo_loc(noccup)
2403 : 48480000 : histo(noccup)= histo(noccup) + histo_loc(noccup)
2404 : : enddo
2405 : : ! write(6,*) "================================="
2406 : : ! write(6,*)
2407 : :
2408 : : ! write(6,*) "================================="
2409 : 3030000 : sumh=zero
2410 [ + - + - : 49646550000 : do iconfig=1,2**(this%flavors)
+ + ]
2411 : : ! occupconfig_loc(iconfig)=occupconfig_loc(iconfig)/float(ntau)*100.0
2412 : 49643520000 : occupconfig(iconfig)=occupconfig(iconfig)+float(occupconfig_loc(iconfig))/float(ntau)*100.0
2413 : : ! write(6,*) "one step",float(occupconfig_loc(iconfig))/float(ntau)*100.0
2414 : 49646550000 : sumh=sumh+occupconfig_loc(iconfig)
2415 : : enddo
2416 : : ! write(6,*) "sumh",sumh,ntau,nmeas
2417 : :
2418 : : !============================================================
2419 : : ! Susceptibility Section
2420 : : !============================================================
2421 [ - + ]: 3030000 : if(opt_histo .gt. 1) then
2422 [ # # ]: 0 : if(nspinor .eq. 1) then
2423 : : ! == Scalar Spin Susceptibility
2424 [ # # ]: 0 : do itau=1,ntau
2425 : : !tau=float(itau-1)/float(ntau)*this%beta
2426 : : ! write(7735,*) float(itau-1)/float(ntau)*this%beta,spinup(itau),spindn(itau),(spinup(itau)-spindn(itau))**2
2427 : : ! write(7736,*) float(itau-1)/float(ntau)*this%beta,(spinup(1,itau)-spindn(1,itau)),(spinup(2,itau)-spindn(2,itau)),(spinup(3,itau)-spindn(3,itau))
2428 [ # # ]: 0 : do jtau=1,ntau
2429 : : !tauj=float(jtau-1)/float(ntau)*this%beta
2430 : 0 : kdeltatau=jtau-itau+1
2431 [ # # ]: 0 : if(jtau<itau) kdeltatau=kdeltatau+ntau
2432 [ # # ]: 0 : if(kdeltatau> ntau) write(std_out,*) "Warning kdeltatau"
2433 : 0 : suscep(1,kdeltatau)=suscep(1,kdeltatau)+float((spinup(1,jtau)-spindn(1,jtau)))*float((spinup(1,itau)-spindn(1,itau)))
2434 : 0 : suscep(2,kdeltatau)=suscep(2,kdeltatau)+float((spinup(2,jtau)-spindn(2,jtau)))*float((spinup(2,itau)-spindn(2,itau)))
2435 : 0 : suscep(3,kdeltatau)=suscep(3,kdeltatau)+float((spinup(3,jtau)-spindn(3,jtau)))*float((spinup(3,itau)-spindn(3,itau)))
2436 : : ! write(6,*) "Su",suscep(kdeltatau),spinup(tau)-spindn(jtau),spinup(itau)-spindn(itau)
2437 : : ! write(6,*) "Su",itau,jtau,kdeltatau
2438 : : enddo
2439 : : !write(7735,*) float(itau-1)/float(ntau)*this%beta,spinup(itau),spindn(itau),(spinup(itau)-spindn(itau))**2
2440 : : !write(7736,*) float(itau-1)/float(ntau)*this%beta,(spinup(itau)-spindn(itau))**2
2441 : : !write(7737,*) float(itau-1)/float(ntau)*this%beta,suscep(1)
2442 : : enddo
2443 : :
2444 : : else
2445 : : ! == Spin Orbit Susceptibility
2446 [ # # # # : 0 : MALLOC(magmommat_orb,(1:this%flavors,1:this%flavors))
# # # # #
# # # # #
# # ]
2447 [ # # # # : 0 : magmommat_orb=this%Magmommat_orb
# # # # #
# # # # #
# # ]
2448 [ # # # # : 0 : MALLOC(magmommat_spin,(1:this%flavors,1:this%flavors))
# # # # #
# # # ]
2449 [ # # # # : 0 : magmommat_spin=this%Magmommat_spin
# # # # #
# # # # #
# # ]
2450 [ # # # # : 0 : MALLOC(magmommat_tot,(1:this%flavors,1:this%flavors))
# # # # #
# # # ]
2451 [ # # # # : 0 : magmommat_tot=this%Magmommat_tot
# # # # #
# # # # #
# # ]
2452 [ # # # # : 0 : MALLOC(mu_tmp,(1:3,1:ntau))
# # # # #
# # # ]
2453 : :
2454 : : ! == Product of occupation matrix with magnetic moment matrix
2455 [ # # ]: 0 : do itau=1,ntau
2456 [ # # ]: 0 : mu_tmp(:,itau)=0
2457 [ # # ]: 0 : do iflavor1=1,this%flavors
2458 [ # # ]: 0 : do iflavor2=1,this%flavors
2459 [ # # ]: 0 : if(iflavor1==iflavor2) then
2460 : 0 : mu_tmp(1,itau) = mu_tmp(1,itau) + magmommat_tot(iflavor1,iflavor2)*occup(iflavor1,itau)
2461 : 0 : mu_tmp(2,itau) = mu_tmp(2,itau) + magmommat_orb(iflavor1,iflavor2)*occup(iflavor1,itau)
2462 : 0 : mu_tmp(3,itau) = mu_tmp(3,itau) + magmommat_spin(iflavor1,iflavor2)*occup(iflavor1,itau)
2463 : : !write(6,*) itau, magmommat(iflavor1,iflavor2), mu_tmp(:,itau)/ntau
2464 : : end if
2465 : : end do
2466 : : end do
2467 : : end do
2468 : :
2469 : : ! == Correlation function of mu_tmp for magnetic susceptibility with SOC (Approach 1)
2470 [ # # ]: 0 : do itau=1,ntau
2471 [ # # ]: 0 : do jtau=1,ntau
2472 : 0 : kdeltatau=jtau-itau+1
2473 [ # # ]: 0 : if(jtau<itau) kdeltatau=kdeltatau+ntau
2474 [ # # ]: 0 : if(kdeltatau> ntau) write(std_out,*) "Warning kdeltatau"
2475 : 0 : chi(1,kdeltatau) = chi(1,kdeltatau) + (mu_tmp(1,itau))*(mu_tmp(1,jtau))
2476 : 0 : chi(2,kdeltatau) = chi(2,kdeltatau) + (mu_tmp(2,itau))*(mu_tmp(2,jtau))
2477 : 0 : chi(3,kdeltatau) = chi(3,kdeltatau) + (mu_tmp(3,itau))*(mu_tmp(3,jtau))
2478 : : end do
2479 : : end do
2480 : :
2481 [ # # ]: 0 : FREE(mu_tmp)
2482 [ # # ]: 0 : FREE(magmommat_orb)
2483 [ # # ]: 0 : FREE(magmommat_spin)
2484 [ # # ]: 0 : FREE(magmommat_tot)
2485 : : endif
2486 : : endif
2487 : :
2488 [ - + ]: 3030000 : if(opt_histo .gt. 2) then
2489 [ # # ]: 0 : if(nspinor .eq. 1) then
2490 : : ! == Scalar Charge Susceptibility
2491 : :
2492 [ # # ]: 0 : do itau = 1,ntau
2493 : 0 : ntot(1) = ntot(1) + occuptot(itau)
2494 : 0 : ntot(2) = ntot(2) + float(spinup(2,itau)+spindn(2,itau))
2495 : 0 : ntot(3) = ntot(3) + float(spinup(3,itau)+spindn(3,itau))
2496 : : enddo
2497 : :
2498 [ # # ]: 0 : do itau=1,ntau
2499 [ # # ]: 0 : do jtau=1,ntau
2500 : 0 : kdeltatau=jtau-itau+1
2501 [ # # ]: 0 : if(jtau<itau) kdeltatau=kdeltatau+ntau
2502 [ # # ]: 0 : if(kdeltatau> ntau) write(std_out,*) "Warning kdeltatau"
2503 : 0 : chicharge(1,kdeltatau)=chicharge(1,kdeltatau)+float((spinup(1,jtau)+spindn(1,jtau)))*float((spinup(1,itau)+spindn(1,itau)))
2504 : 0 : chicharge(2,kdeltatau)=chicharge(2,kdeltatau)+float((spinup(2,jtau)+spindn(2,jtau)))*float((spinup(2,itau)+spindn(2,itau)))
2505 : 0 : chicharge(3,kdeltatau)=chicharge(3,kdeltatau)+float((spinup(3,jtau)+spindn(3,jtau)))*float((spinup(3,itau)+spindn(3,itau)))
2506 : : enddo
2507 : : enddo
2508 : :
2509 : : else
2510 : : ! == Spin-orbit Charge Susceptibility
2511 : : ! ntot(1) = Full occuptation, ntot(2) = mj_5/2, ntot(3) = mj_7/2
2512 [ # # ]: 0 : do itau = 1,ntau
2513 : 0 : ntot(1) = ntot(1) + occuptot(itau)
2514 : 0 : ntot(2) = ntot(2) + float(spinup(2,itau))
2515 : 0 : ntot(3) = ntot(3) + float(spinup(3,itau))
2516 : : enddo
2517 : :
2518 [ # # ]: 0 : do itau=1,ntau
2519 [ # # ]: 0 : do jtau=1,ntau
2520 : 0 : kdeltatau=jtau-itau+1
2521 [ # # ]: 0 : if(jtau<itau) kdeltatau=kdeltatau+ntau
2522 [ # # ]: 0 : if(kdeltatau> ntau) write(std_out,*) "Warning kdeltatau"
2523 : 0 : chicharge(1,kdeltatau)=chicharge(1,kdeltatau)+float(occuptot(jtau))*float(occuptot(itau))
2524 : 0 : chicharge(2,kdeltatau)=chicharge(2,kdeltatau)+float(spinup(2,jtau))*float(spindn(2,itau))
2525 : 0 : chicharge(3,kdeltatau)=chicharge(3,kdeltatau)+float(spinup(3,jtau))*float(spinup(3,itau))
2526 : : enddo
2527 : : enddo
2528 : : end if
2529 : : endif
2530 : :
2531 [ - + ]: 3030000 : FREE(occup)
2532 [ - + ]: 3030000 : FREE(occupconfig_loc)
2533 [ - + ]: 3030000 : FREE(histo_loc)
2534 [ - + ]: 3030000 : FREE(occuptot)
2535 [ - + ]: 3030000 : FREE(spinup)
2536 [ - + ]: 3030000 : FREE(spindn)
2537 : :
2538 : :
2539 : 3030000 : END SUBROUTINE ImpurityOperator_occup_histo_time
2540 : : !!***
2541 : :
2542 : : !!****f* ABINIT/m_ImpurityOperator/ImpurityOperator_setMagmommat
2543 : : !! NAME
2544 : : !! ImpurityOperator_setMagmommat
2545 : : !!
2546 : : !! FUNCTION
2547 : : !! Set directly the Magnetic moment this
2548 : : !!
2549 : : !! COPYRIGHT
2550 : : !! Copyright (C) 2013-2026 ABINIT group (F. Gendron)
2551 : : !! This file is distributed under the terms of the
2552 : : !! GNU General Public License, see ~abinit/COPYING
2553 : : !! or http://www.gnu.org/copyleft/gpl.txt .
2554 : : !!
2555 : : !! INPUTS
2556 : : !! this=ImpurtityOperator
2557 : : !! matU=interaction this
2558 : : !!
2559 : : !! OUTPUT
2560 : : !!
2561 : : !! SIDE EFFECTS
2562 : : !!
2563 : : !! NOTES
2564 : : !!
2565 : : !! SOURCE
2566 : :
2567 [ - + - + : 49 : SUBROUTINE ImpurityOperator_setMagmommat(this, Magmom_orb, Magmom_spin, Magmom_tot)
- + ]
2568 : :
2569 : : !Arguments ------------------------------------
2570 : : TYPE(ImpurityOperator), INTENT(INOUT) :: this
2571 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: Magmom_orb
2572 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: Magmom_spin
2573 : : DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: Magmom_tot
2574 : : !Local-----------------------------------------
2575 : : INTEGER :: iflavor1
2576 : : INTEGER :: iflavor2
2577 : :
2578 : : !debug
2579 : : ! write(6,*) "Inside Impurity_set Magmommat"
2580 : : !
2581 : : ! do iflavor1=1,10
2582 : : ! do iflavor2=1,10
2583 : : ! if(iflavor1==iflavor2) THEN
2584 : : ! write(6,*) iflavor1, iflavor2, Magmom(iflavor1,iflavor2)
2585 : : ! end if
2586 : : ! end do
2587 : : ! end do
2588 : :
2589 [ + + ]: 567 : DO iflavor1 = 1, this%flavors
2590 [ + + ]: 6363 : DO iflavor2 = 1, this%flavors
2591 : 5796 : this%Magmommat_orb(iflavor1,iflavor2) = Magmom_orb(iflavor1,iflavor2)
2592 : 5796 : this%Magmommat_spin(iflavor1,iflavor2) = Magmom_spin(iflavor1,iflavor2)
2593 : 6314 : this%Magmommat_tot(iflavor1,iflavor2) = Magmom_tot(iflavor1,iflavor2)
2594 : : END DO
2595 : : END DO
2596 : :
2597 : 49 : END SUBROUTINE ImpurityOperator_setMagmommat
2598 : : !!***
2599 [ # # # # : 0 : END MODULE m_ImpurityOperator
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
2600 : : !!***
|
