TABLE OF CONTENTS
- ABINIT/m_ImpurityOperator
- ABINIT/m_ImpurityOperator/ImpurityOperator_activateParticle
- ABINIT/m_ImpurityOperator/ImpurityOperator_add
- ABINIT/m_ImpurityOperator/ImpurityOperator_checkOverlap
- ABINIT/m_ImpurityOperator/ImpurityOperator_cleanOverlaps
- ABINIT/m_ImpurityOperator/ImpurityOperator_computeU
- ABINIT/m_ImpurityOperator/ImpurityOperator_destroy
- ABINIT/m_ImpurityOperator/ImpurityOperator_doCheck
- ABINIT/m_ImpurityOperator/ImpurityOperator_getAvailableTime
- ABINIT/m_ImpurityOperator/ImpurityOperator_getAvailedTime
- ABINIT/m_ImpurityOperator/ImpurityOperator_getError
- ABINIT/m_ImpurityOperator/ImpurityOperator_getErrorOverlap
- ABINIT/m_ImpurityOperator/ImpurityOperator_getNewOverlap
- ABINIT/m_ImpurityOperator/ImpurityOperator_getSegment
- ABINIT/m_ImpurityOperator/ImpurityOperator_getsign
- ABINIT/m_ImpurityOperator/ImpurityOperator_getTraceAdd
- ABINIT/m_ImpurityOperator/ImpurityOperator_getTraceRemove
- ABINIT/m_ImpurityOperator/ImpurityOperator_init
- ABINIT/m_ImpurityOperator/ImpurityOperator_measDE
- ABINIT/m_ImpurityOperator/ImpurityOperator_measN
- ABINIT/m_ImpurityOperator/ImpurityOperator_occup_histo_time
- ABINIT/m_ImpurityOperator/ImpurityOperator_overlapFlavor
- ABINIT/m_ImpurityOperator/ImpurityOperator_overlapIJ
- ABINIT/m_ImpurityOperator/ImpurityOperator_overlapSegFlav
- ABINIT/m_ImpurityOperator/ImpurityOperator_overlapSwap
- ABINIT/m_ImpurityOperator/ImpurityOperator_printLatex
- ABINIT/m_ImpurityOperator/ImpurityOperator_remove
- ABINIT/m_ImpurityOperator/ImpurityOperator_reset
- ABINIT/m_ImpurityOperator/ImpurityOperator_setMagmommat
- ABINIT/m_ImpurityOperator/ImpurityOperator_setMu
- ABINIT/m_ImpurityOperator/ImpurityOperator_setUmat
- ABINIT/m_ImpurityOperator/ImpurityOperator_swap
- m_ImpurityOperator/ImpurityOperator
ABINIT/m_ImpurityOperator [ Modules ]
NAME
m_ImpurityOperator
FUNCTION
manage all related to Impurity
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
NOTES
SOURCE
22 #include "defs.h" 23 MODULE m_ImpurityOperator 24 USE m_ListCdagC 25 USE m_Global 26 IMPLICIT NONE
ABINIT/m_ImpurityOperator/ImpurityOperator_activateParticle [ Functions ]
NAME
ImpurityOperator_activateParticle
FUNCTION
active a flavor
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator flavor=the flavor
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
446 SUBROUTINE ImpurityOperator_activateParticle(this,flavor) 447 448 !Arguments ------------------------------------ 449 TYPE(ImpurityOperator), INTENT(INOUT) :: this 450 INTEGER , INTENT(IN ) :: flavor 451 452 IF ( flavor .GT. this%flavors ) & 453 CALL ERROR("ImpurityOperator_activateParticle : out of range ") 454 IF ( ALLOCATED(this%particles) ) THEN 455 this%activeFlavor = flavor 456 ELSE 457 CALL ERROR("ImpurityOperator_activateParticle : not allocated ") 458 END IF 459 END SUBROUTINE ImpurityOperator_activateParticle
ABINIT/m_ImpurityOperator/ImpurityOperator_add [ Functions ]
NAME
ImpurityOperator_add
FUNCTION
add a segment to the active flavor
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator CdagC_1=couple of times position_val=position of the CdagC_1 couple in the list
OUTPUT
SIDE EFFECTS
this=ImpurityOperatoroffdiag this%particles(aF)%list is updated this%overlaps is updated
NOTES
SOURCE
623 SUBROUTINE ImpurityOperator_add(this, CdagC_1, position_val) 624 625 !Arguments ------------------------------------ 626 TYPE(ImpurityOperator), INTENT(INOUT) :: this 627 DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN ) :: CdagC_1 628 INTEGER , INTENT(IN ) :: position_val 629 !Local variables ------------------------------ 630 INTEGER :: position 631 INTEGER :: aF 632 INTEGER :: i 633 DOUBLE PRECISION, DIMENSION(1:2) :: C2modify 634 DOUBLE PRECISION, DIMENSION(1:2) :: C2add 635 DOUBLE PRECISION :: TCdag 636 DOUBLE PRECISION :: TC 637 638 aF = this%activeFlavor 639 IF ( aF .LE. 0 ) & 640 CALL ERROR("ImpurityOperator_add : no active flavor ") 641 642 position = position_val 643 644 IF ( CdagC_1(C_) .GT. CdagC_1(Cdag_) ) THEN ! Ajout d'un segment 645 C2add = CdagC_1 646 ELSE ! Ajout d'un antisegment 647 IF ( (this%particles(aF)%tail .EQ. 0) .AND. (this%particles(aF)%list(0,C_) .EQ. 0d0)) THEN ! should be full orbital 648 IF ( CdagC_1(Cdag_) .GT. this%beta ) THEN 649 ! CALL CdagC_init(C2add,CdagC_1%Cdag-this%beta,CdagC_1%C) 650 ! From the IF condition and the creation of CdagC in TryAddRemove, we have 651 ! CdagC_1(Cdag_) > beta 652 ! CdagC_1(C_) < beta 653 C2add(Cdag_) = CdagC_1(Cdag_)-this%beta 654 C2add(C_ ) = CdagC_1(C_) 655 ! Now C2add(Cdag_) < beta 656 ! still C2add(C_) < beta 657 ELSE 658 ! CALL CdagC_init(C2add,CdagC_1%Cdag,CdagC_1%C+this%beta) 659 ! CdagC_1(Cdag_) < beta 660 ! CdagC_1(C_) < beta 661 C2add(Cdag_) = CdagC_1(Cdag_) 662 C2add(C_ ) = CdagC_1(C_)+this%beta 663 ! C2add(Cdag_) < beta 664 ! C2ass(C_) > beta 665 END IF 666 position = 0 667 ! See impurityoperator_init to understand this. This is due to the 668 ! convention for the full orbital case. 669 this%particles(aF)%list(0,C_ ) = this%beta 670 this%particles(aF)%list(0,Cdag_) = 0.d0 671 ELSE IF ( this%particles(aF)%tail .GT. 0 ) THEN 672 position = ABS(position) 673 TCdag = this%particles(aF)%list(position,Cdag_) 674 TC = CdagC_1(C_) 675 IF ( TCdag .GT. TC ) TC = TC + this%beta 676 ! CALL CdagC_init(C2modify,TCdag,TC) 677 C2modify(Cdag_) = TCdag 678 C2modify(C_ ) = TC 679 680 ! TCdag = CdagC_1%Cdag.MOD.this%beta 681 MODCYCLE(CdagC_1(Cdag_),this%beta,TCdag) 682 TC = this%particles(aF)%list(position,C_) 683 ! CALL CdagC_init(C2add,TCdag,TC) 684 C2add(Cdag_) = TCdag 685 C2add(C_ ) = TC 686 687 this%particles(aF)%list(position,:) = C2modify 688 IF ( C2modify(Cdag_) .GT. C2add(Cdag_) ) THEN 689 position = 0 690 ! C2add%C = C2add%C.MOD.this%beta 691 MODCYCLE(C2add(C_),this%beta,C2add(C_)) 692 END IF 693 ELSE 694 CALL ERROR("ImpurityOperator_add : try to add an antisegment to an empty orbital") 695 END IF 696 position = position + 1 697 END IF 698 CALL ListCdagC_insert(this%particles(aF), c2add, position) 699 DO i = 1, this%flavors 700 this%overlaps(i,aF) = this%overlaps(i,aF) + this%updates(i) 701 this%overlaps(aF,i) = this%overlaps(i,aF) 702 END DO 703 704 END SUBROUTINE ImpurityOperator_add
ABINIT/m_ImpurityOperator/ImpurityOperator_checkOverlap [ Functions ]
NAME
ImpurityOperator_checkOverlap
FUNCTION
check the calculation of the overlap (very very slow routine) between Tmin and Tmax (c+ and c)
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator Tmin=c+ Tmax=c iOverlap=input overlap (fast calculation) iflavor=active flavor
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1892 SUBROUTINE ImpurityOperator_checkOverlap(this, Tmin, Tmax, iOverlap, iflavor) 1893 1894 !Arguments ------------------------------------ 1895 TYPE(ImpurityOperator), INTENT(INOUT) :: this 1896 DOUBLE PRECISION , INTENT(IN ) :: Tmin 1897 DOUBLE PRECISION , INTENT(IN ) :: Tmax 1898 DOUBLE PRECISION , INTENT(IN ) :: iOverlap 1899 INTEGER , INTENT(IN ) :: iflavor 1900 !Local variables ------------------------------ 1901 INTEGER, PARAMETER :: size=10000000 1902 INTEGER :: imin 1903 INTEGER :: imax 1904 INTEGER :: imaxbeta 1905 INTEGER :: isegment 1906 INTEGER :: tail 1907 INTEGER(1), DIMENSION(1:size,1:2) :: checktab 1908 CHARACTER(LEN=4) :: a 1909 DOUBLE PRECISION :: dt 1910 DOUBLE PRECISION :: inv_dt 1911 DOUBLE PRECISION :: overlap 1912 DOUBLE PRECISION :: erreur 1913 DOUBLE PRECISION :: weight 1914 INTEGER :: try 1915 1916 checktab = INT(0,1) 1917 overlap = 0.d0 1918 1919 dt = this%beta / DBLE((size-1)) 1920 inv_dt = 1.d0 / dt 1921 imin = INT(Tmin / dt + 0.5d0) + 1 1922 imax = INT(Tmax / dt + 0.5d0) + 1 1923 MODCYCLE(imax, size, imaxbeta) 1924 1925 tail = this%particles(iflavor)%tail 1926 1927 DO try = imin, MIN(imax,size) 1928 checktab(try,1)=INT(1,1)!IBSET(checktab(try,1),0) 1929 END DO 1930 1931 IF ( imax .NE. imaxbeta ) THEN 1932 DO try = 1, imaxbeta 1933 checktab(try,1)=INT(1,1)!IBSET(checktab(try,1),0) 1934 END DO 1935 END IF 1936 1937 IF ( tail .NE. 0 ) THEN 1938 DO isegment=1, tail 1939 imin = INT(this%particles(iflavor)%list(isegment,Cdag_)* inv_dt + 0.5d0) + 1 1940 imax = INT(this%particles(iflavor)%list(isegment,C_ )* inv_dt + 0.5d0) + 1 1941 MODCYCLE(imax, size, imaxbeta) 1942 DO try = imin, MIN(imax,size) 1943 checktab(try,2)=INT(1,1)!IBSET(checktab(try,2),0) 1944 END DO 1945 IF ( imax .NE. imaxbeta ) THEN 1946 DO try = 1, imaxbeta 1947 checktab(try,2)=INT(1,1)!IBSET(checktab(try,2),0) 1948 END DO 1949 END IF 1950 END DO 1951 ELSE IF ( this%particles(iflavor)%list(0,C_) .EQ. 0.d0 ) THEN 1952 DO try = 1, size 1953 checktab(try,2)=INT(1,1)!IBSET(checktab(try,2),0) 1954 END DO 1955 END IF 1956 1957 DO isegment = 1, size 1958 IF ( IAND(checktab(isegment,1),checktab(isegment,2)) .EQ. INT(1,1) ) & 1959 overlap = overlap + 1.d0 1960 END DO 1961 1962 overlap = overlap * dt 1963 1964 IF ( iOverlap .EQ. 0.d0 ) THEN 1965 erreur = ABS(overlap) 1966 ELSE 1967 erreur = ABS(overlap - iOverlap) 1968 END IF 1969 weight = ABS(2.d0 * DBLE(tail) * dt - iOverlap) 1970 IF ( erreur .GT. weight ) THEN 1971 WRITE(a,'(I4)') INT(erreur*100.d0) 1972 CALL WARN("ImpurityOperator_checkOverlap : "//a//"% ") 1973 END IF 1974 IF ( iOverlap .LE. (2.d0 * DBLE(tail) * dt) ) & 1975 this%meanError = this%meanError + 1.d0 1976 this%checkNumber = this%checkNumber + 1.d0 !weight 1977 1978 END SUBROUTINE ImpurityOperator_checkOverlap
ABINIT/m_ImpurityOperator/ImpurityOperator_cleanOverlaps [ Functions ]
NAME
ImpurityOperator_cleanOverlaps
FUNCTION
Compute from scratch all overlaps
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1637 SUBROUTINE ImpurityOperator_cleanOverlaps(this) 1638 1639 !Arguments ------------------------------------ 1640 TYPE(ImpurityOperator), INTENT(INOUT) :: this 1641 !Local variables ------------------------------ 1642 INTEGER :: iflavor1 1643 INTEGER :: iflavor2 1644 INTEGER :: flavors 1645 1646 IF ( .NOT. ALLOCATED(this%particles) ) & 1647 CALL ERROR("ImpurityOperator_cleanOverlap : no particle set ") 1648 1649 flavors = this%flavors 1650 DO iflavor1 = 1, flavors 1651 DO iflavor2 = iflavor1+1, flavors 1652 this%overlaps(iflavor2,iflavor1) = ImpurityOperator_overlapIJ(this,iflavor1,iflavor2) 1653 END DO 1654 END DO 1655 1656 END SUBROUTINE ImpurityOperator_cleanOverlaps
ABINIT/m_ImpurityOperator/ImpurityOperator_computeU [ Functions ]
NAME
ImpurityOperator_computeU
FUNCTION
Compute an interaction this for t2g like interaction
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator U=Coulomb scrren interaction J=Hund couplage
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
293 SUBROUTINE ImpurityOperator_computeU(this, U, J) 294 295 !Arguments ------------------------------------ 296 TYPE(ImpurityOperator), INTENT(INOUT) :: this 297 DOUBLE PRECISION , INTENT(IN ) :: U 298 DOUBLE PRECISION , INTENT(IN ) :: J 299 !Local variables ------------------------------ 300 INTEGER :: flavor11 301 INTEGER :: flavor12 302 INTEGER :: flavor21 303 INTEGER :: flavor22 304 INTEGER :: flavors 305 INTEGER :: flavors_2 306 DOUBLE PRECISION :: Uprime 307 308 Uprime = U - 2.d0 * J 309 flavors = this%flavors 310 flavors_2 = flavors / 2 311 DO flavor11 = 1, flavors_2 312 flavor12 = flavors - flavor11 + 1 313 this%mat_U(flavor11, flavor11) = 0.d0 314 this%mat_U(flavor12, flavor12) = 0.d0 315 this%mat_U(flavor11+flavors_2, flavor11) = U 316 this%mat_U(flavor12-flavors_2, flavor12) = U 317 DO flavor21 = flavor11+1, flavors_2 318 flavor22 = flavors - flavor21 + 1 319 this%mat_U(flavor21, flavor11) = Uprime 320 this%mat_U(flavor22-flavors_2, flavor12-flavors_2) = Uprime 321 this%mat_U(flavor21+flavors_2, flavor11+flavors_2) = Uprime 322 this%mat_U(flavor22, flavor12) = Uprime 323 END DO 324 DO flavor21 = flavor11+flavors_2+1, flavors 325 flavor22 = flavors - flavor21 + 1 326 this%mat_U(flavor21, flavor11) = Uprime - J 327 this%mat_U(flavor22+flavors_2, flavor12-flavors_2) = Uprime - J 328 this%mat_U(flavor21-flavors_2, flavor11+flavors_2) = Uprime - J 329 this%mat_U(flavor22, flavor12) = Uprime - J 330 END DO 331 END DO 332 END SUBROUTINE ImpurityOperator_computeU
ABINIT/m_ImpurityOperator/ImpurityOperator_destroy [ Functions ]
NAME
ImpurityOperator_destroy
FUNCTION
destroy and deallocate
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1742 SUBROUTINE ImpurityOperator_destroy(this) 1743 1744 !Arguments ------------------------------------ 1745 TYPE(ImpurityOperator), INTENT(INOUT) :: this 1746 !Local variables ------------------------------ 1747 INTEGER :: IT 1748 1749 IF ( ALLOCATED(this%particles) ) THEN 1750 DO IT = 1, this%flavors 1751 CALL ListCdagC_destroy(this%particles(IT)) 1752 END DO 1753 DT_FREE(this%particles) 1754 ENDIF 1755 CALL ListCdagC_destroy(this%list_swap) 1756 FREEIF(this%mat_U) 1757 FREEIF(this%Magmommat_orb) 1758 FREEIF(this%Magmommat_spin) 1759 FREEIF(this%Magmommat_tot) 1760 FREEIF(this%overlaps) 1761 FREEIF(this%updates) 1762 this%activeFlavor = 0 1763 this%flavors = 0 1764 this%beta = 0.d0 1765 END SUBROUTINE ImpurityOperator_destroy
ABINIT/m_ImpurityOperator/ImpurityOperator_doCheck [ Functions ]
NAME
ImpurityOperator_doCheck
FUNCTION
set the check mechanism
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator opt_check=1||3 do check
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1852 SUBROUTINE ImpurityOperator_doCheck(this,opt_check) 1853 1854 !Arguments ------------------------------------ 1855 TYPE(ImpurityOperator) , INTENT(INOUT) :: this 1856 INTEGER , INTENT(IN ) :: opt_check 1857 1858 IF ( opt_check .EQ. 1 .OR. opt_check .EQ. 3 ) & 1859 this%doCheck = .TRUE. 1860 END SUBROUTINE ImpurityOperator_doCheck
ABINIT/m_ImpurityOperator/ImpurityOperator_getAvailableTime [ Functions ]
NAME
ImpurityOperator_getAvailableTime
FUNCTION
get the time available and the position of the segment to consider negative if on a segment positive if outside a segment
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator time=time to look for
OUTPUT
ImpurityOperator_getAvailableTime=Time available position=position of the next segment
SIDE EFFECTS
NOTES
SOURCE
491 DOUBLE PRECISION FUNCTION ImpurityOperator_getAvailableTime(this, time, position) 492 493 !Arguments ------------------------------------ 494 TYPE(ImpurityOperator), INTENT(IN ) :: this 495 DOUBLE PRECISION , INTENT(IN ) :: time 496 INTEGER , INTENT(OUT ) :: position 497 !Local variables ------------------------------ 498 DOUBLE PRECISION :: t_avail 499 INTEGER :: position_dwn 500 INTEGER :: aF 501 #include "ListCdagC_firstHigher.h" 502 aF = this%activeFlavor 503 IF ( aF .LE. 0 ) & 504 CALL ERROR("ImpurityOperator_getAvailableTime : no active flav") 505 506 IF ( this%particles(aF)%tail .EQ. 0 ) THEN 507 t_avail = this%particles(aF)%list(0,C_) - this%particles(aF)%list(0,Cdag_) 508 position = SIGN(1,INT(t_avail)) 509 ELSE 510 ! position = ListCdagC_firstHigher( this%particles(aF), time ) 511 #define list_1 this%particles(aF) 512 #include "ListCdagC_firstHigher" 513 #undef list_1 514 position = firstHigher 515 position_dwn = position - 1 516 IF ( position_dwn .LE. 0) position_dwn = this%particles(aF)%tail 517 518 ! t_avail = (time - this%particles(aF)%list(position_dwn)) .MOD. this%beta 519 t_avail = time - this%particles(aF)%list(position_dwn,C_) 520 IF ( this%particles(aF)%list(position_dwn,Cdag_) .GT. time ) & 521 t_avail = t_avail + this%beta 522 523 IF ( t_avail .GT. 0.d0 ) THEN !! We are outside the position_dwn segment 524 ! t_avail = (this%particles(aF)%list(ABS(position)) - time ) .MOD. this%beta 525 t_avail = this%particles(aF)%list(ABS(position),Cdag_) - time 526 IF ( this%particles(aF)%list(ABS(position),Cdag_) .LT. time ) & 527 t_avail = t_avail + this%beta 528 ! ABS is used to prevent position to be -1 which is HERE the same as 1 529 ELSE 530 position = - position_dwn 531 END IF 532 END IF 533 534 ImpurityOperator_getAvailableTime = t_avail 535 536 END FUNCTION ImpurityOperator_getAvailableTime
ABINIT/m_ImpurityOperator/ImpurityOperator_getAvailedTime [ Functions ]
NAME
ImpurityOperator_getAvailedTime
FUNCTION
get the time available without the segment "position"
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator position=position of the segment
OUTPUT
ImpurityOperator_getAvailedTime=time available before ...
SIDE EFFECTS
NOTES
SOURCE
565 DOUBLE PRECISION FUNCTION ImpurityOperator_getAvailedTime(this, position) 566 567 !Arguments ------------------------------------ 568 TYPE(ImpurityOperator), INTENT(IN ) :: this 569 INTEGER , INTENT(IN ) :: position 570 DOUBLE PRECISION :: T_avail 571 INTEGER :: Pup 572 INTEGER :: ABSp 573 INTEGER :: tail 574 INTEGER :: aF 575 576 aF = this%activeFlavor 577 IF ( aF .LE. 0 ) & 578 CALL ERROR("ImpurityOperator_getAvailedTime : no active flavor") 579 ABSp = ABS(position) 580 ! position_up = (ABSposition+1).MOD.this%particles(aF)%tail 581 tail = this%particles(aF)%tail 582 MODCYCLE(ABSp+1,tail,Pup) 583 IF ( position .GT. 0 ) THEN 584 t_avail = this%particles(aF)%list(Pup, Cdag_) & 585 - this%particles(aF)%list(ABSp,Cdag_) 586 ELSE 587 t_avail = this%particles(aF)%list(Pup ,C_) & 588 - this%particles(aF)%list(ABSp,C_) 589 END IF 590 IF ( t_avail .LE. 0.d0 ) t_avail = t_avail + this%beta 591 ImpurityOperator_getAvailedTime = t_avail 592 END FUNCTION ImpurityOperator_getAvailedTime
ABINIT/m_ImpurityOperator/ImpurityOperator_getError [ Functions ]
NAME
ImpurityOperator_getErro
FUNCTION
get error on computing the overlap
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator
OUTPUT
ImpurityOperator_getError=percentage error
SIDE EFFECTS
NOTES
SOURCE
2006 DOUBLE PRECISION FUNCTION ImpurityOperator_getError(this) 2007 2008 !Arguments ------------------------------------ 2009 TYPE(ImpurityOperator), INTENT(IN) :: this 2010 !Local variables ------------------------------ 2011 ! DOUBLE PRECISION :: tolerance 2012 DOUBLE PRECISION :: error 2013 2014 IF ( this%doCheck .EQV. .TRUE. ) THEN 2015 error = ABS(this%meanError/this%checkNumber) 2016 ! tolerance = ABS(this%tolerance/this%checkNumber) 2017 ImpurityOperator_getError = error 2018 ELSE 2019 ImpurityOperator_getError = 0.d0 2020 END IF 2021 END FUNCTION ImpurityOperator_getError
ABINIT/m_ImpurityOperator/ImpurityOperator_getErrorOverlap [ Functions ]
NAME
ImpurityOperator_getErrorOverlap
FUNCTION
compute error on the overlap (numerical accumulation)
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator
OUTPUT
DE=save the error
SIDE EFFECTS
NOTES
SOURCE
1793 SUBROUTINE ImpurityOperator_getErrorOverlap(this,DE) 1794 1795 !Arguments ------------------------------------ 1796 TYPE(ImpurityOperator), INTENT(INOUT) :: this 1797 DOUBLE PRECISION, DIMENSION(:,:), INTENT(INOUT) :: DE 1798 !Local variables ------------------------------ 1799 DOUBLE PRECISION :: localD1 1800 DOUBLE PRECISION :: localD2 1801 DOUBLE PRECISION :: totalE1 1802 DOUBLE PRECISION :: totalE2 1803 INTEGER :: iflavor1 1804 INTEGER :: iflavor2 1805 INTEGER :: flavors 1806 1807 IF ( .NOT. ALLOCATED(this%particles) ) & 1808 CALL ERROR("ImpurityOperator_getErrorOverlap : no particle set ") 1809 1810 totalE1 = 0.d0 1811 totalE2 = 0.d0 1812 flavors = this%flavors 1813 DO iflavor1 = 1, flavors 1814 DO iflavor2 = iflavor1+1, flavors 1815 localD1 = ImpurityOperator_overlapIJ(this,iflavor1,iflavor2) 1816 localD2 = this%overlaps(iflavor2,iflavor1) 1817 totalE1 = totalE1 + localD1 * this%mat_U(iflavor1,iflavor2) 1818 totalE2 = totalE2 + localD2 * this%mat_U(iflavor1,iflavor2) 1819 END DO 1820 END DO 1821 1822 DE(2,2) = ABS(totalE1 - totalE2) 1823 1824 END SUBROUTINE ImpurityOperator_getErrorOverlap
ABINIT/m_ImpurityOperator/ImpurityOperator_getNewOverlap [ Functions ]
NAME
ImpurityOperator_getNewOverlap
FUNCTION
Get the overlap induced by CdagC_1 in the current configuration
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator CdagC_1=the segment
OUTPUT
ImpurityOperator_getNewOverlap=overlap..
SIDE EFFECTS
NOTES
SOURCE
875 DOUBLE PRECISION FUNCTION ImpurityOperator_getNewOverlap(this, CdagC_1) 876 877 !Arguments ------------------------------------ 878 TYPE(ImpurityOperator), INTENT(INOUT) :: this 879 DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN) :: CdagC_1 880 !Local variables ------------------------------ 881 DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_2 882 DOUBLE PRECISION :: overlap 883 DOUBLE PRECISION :: totalOverlap 884 DOUBLE PRECISION :: sign 885 INTEGER :: flavor 886 INTEGER :: otherFlavor 887 888 flavor = this%activeFlavor 889 IF ( flavor .LE. 0 ) & 890 CALL ERROR("ImpurityOperator_getNewOverlap : no active flavor ") 891 IF ( CdagC_1(Cdag_) .LT. CdagC_1(C_) ) THEN ! segment C*C 892 CdagC_2 = CdagC_1 893 sign = -1.d0 894 ELSE 895 CdagC_2(C_) = CdagC_1(Cdag_) 896 CdagC_2(Cdag_) = CdagC_1(C_) 897 sign = 1.d0 898 END IF 899 900 totalOverlap = 0.d0 901 902 DO otherFlavor = 1, this%flavors 903 IF ( otherFlavor .EQ. flavor ) CYCLE 904 overlap = ImpurityOperator_overlapSegFlav(this,CdagC_2(1:2),otherflavor) 905 totalOverlap = totalOverlap & 906 + overlap * this%mat_U(otherFlavor,flavor) 907 this%updates(otherFlavor) = -sign * overlap 908 END DO 909 910 totalOverlap = totalOverlap * sign 911 ImpurityOperator_getNewOverlap = totalOverlap 912 913 END FUNCTION ImpurityOperator_getNewOverlap
ABINIT/m_ImpurityOperator/ImpurityOperator_getSegment [ Functions ]
NAME
ImpurityOperator_getSegment
FUNCTION
Return the segment at position_val
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator position_val=position of the asked segment
OUTPUT
ImpurityOperator_getSegment(2)=the couple of time
SIDE EFFECTS
NOTES
SOURCE
733 FUNCTION ImpurityOperator_getSegment(this,position_val) 734 735 !Arguments ------------------------------------ 736 TYPE(ImpurityOperator), INTENT(INOUT) :: this 737 INTEGER , INTENT(IN ) :: position_val 738 !Local variables ------------------------------ 739 INTEGER :: position 740 INTEGER :: tail 741 INTEGER :: aF 742 DOUBLE PRECISION :: beta 743 DOUBLE PRECISION :: ImpurityOperator_getSegment(1:2) 744 745 aF = this%activeFlavor 746 IF ( aF .LE. 0 ) & 747 CALL ERROR("ImpurityOperator_getSegment : no active flavor ") 748 749 IF ( position_val .GT. 0 ) THEN 750 ImpurityOperator_getSegment = this%particles(aF)%list(position_val,1:2) 751 ELSE 752 position = ABS(position_val) 753 tail = this%particles(aF)%tail 754 beta = this%beta 755 ImpurityOperator_getSegment(C_) = this%particles(aF)%list(position,C_) 756 position = position + 1 757 IF ( position .GT. tail ) THEN 758 IF ( ImpurityOperator_getSegment(C_) .LT. beta ) THEN 759 ImpurityOperator_getSegment(Cdag_) = this%particles(aF)%list(1,Cdag_) + beta 760 ELSE 761 ImpurityOperator_getSegment(Cdag_) = this%particles(aF)%list(1,Cdag_) 762 ImpurityOperator_getSegment(C_) = ImpurityOperator_getSegment(C_) -beta 763 END IF 764 ELSE 765 ImpurityOperator_getSegment(Cdag_) = this%particles(aF)%list(position,Cdag_) 766 END IF 767 768 END IF 769 END FUNCTION ImpurityOperator_getSegment
ABINIT/m_ImpurityOperator/ImpurityOperator_getsign [ Functions ]
NAME
ImpurityOperator_getsign
FUNCTION
Get the sign of the ratio of impurity traces
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (B. Amadon) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this = ImpurityOperator time2 = for segment/antisegment addition, end of segment position = for segment/antisegment removal, position of segment/antisegment removed action = > 0.5 addition < 0.5 removal
OUTPUT
ImpurityOperator_getsign = sign of ratio of impurity traces
SIDE EFFECTS
NOTES
SOURCE
945 DOUBLE PRECISION FUNCTION ImpurityOperator_getsign(this, time2, i, action, position) 946 947 !Arguments ------------------------------------ 948 TYPE(ImpurityOperator), INTENT(IN) :: this 949 DOUBLE PRECISION, INTENT(IN) :: time2, action 950 INTEGER , INTENT(IN) :: i,position 951 !Local variables ------------------------------ 952 INTEGER :: tailint 953 DOUBLE PRECISION :: sign_imp 954 ! ************************************************************************ 955 tailint=this%particles(this%activeflavor)%tail 956 if(action < 0.5d0) then 957 if(tailint>=1) then 958 if ( this%particles(this%activeFlavor)%list(tailint,2)>this%beta ) then ! segment winds around 959 if (i==1) then ! add segment do not change winding 960 sign_imp = 1 961 else if (i==2) then ! antisegment 962 if(time2>this%beta) then ! suppress winding around 963 sign_imp = -1 964 else ! winding around still here 965 sign_imp = 1 966 endif 967 endif 968 else ! segment do not wind around 969 if (i==1) then ! segment 970 if(time2>this%beta) then ! create winding 971 sign_imp = -1 972 else ! do not create winding 973 sign_imp = 1 974 endif 975 else if (i==2) then ! no winding in any case 976 sign_imp = 1 977 endif 978 endif 979 else if (tailint==0) then 980 if (i==1) then ! segment 981 if(time2>this%beta) then ! create winding 982 sign_imp = -1 983 else ! do not create winding 984 sign_imp = 1 985 endif 986 else if (i==2) then ! antisegment 987 if(time2>this%beta) then ! do not create winding 988 sign_imp = 1 989 else ! create winding 990 sign_imp = -1 991 endif 992 endif 993 endif 994 else 995 if ( this%particles(this%activeFlavor)%list(tailint,2)>this%beta ) then ! segment winds around 996 if (i==1) then ! remove segment 997 if(position==tailint) then ! suppress winding around 998 sign_imp = -1 999 else ! winding around still here 1000 sign_imp = 1 1001 endif 1002 else if (i==2) then ! remove antisegment 1003 if(tailint==1) then ! if tailint=1, create full orbital 1004 sign_imp = -1 1005 else ! if tailint >1 preserve winding 1006 sign_imp = 1 1007 endif 1008 endif 1009 else ! segments do not wind around 1010 if (i==1) then ! suppress segment do not change winding 1011 sign_imp = 1 1012 else if (i==2) then ! antisegment 1013 if(abs(position)==tailint) then ! create winding around only tailint >=1 1014 if(tailint==1) then 1015 sign_imp = 1 1016 else 1017 sign_imp = -1 1018 endif 1019 else !do not create winding around 1020 sign_imp = 1 1021 endif 1022 endif 1023 endif 1024 endif 1025 1026 ImpurityOperator_getsign=sign_imp 1027 1028 1029 END FUNCTION ImpurityOperator_getsign
ABINIT/m_ImpurityOperator/ImpurityOperator_getTraceAdd [ Functions ]
NAME
ImpurityOperator_getTraceAdd
FUNCTION
Get the ratio of the traces of the impurity hamiltonien with and without the new (anti-)segment.
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator CdagC_1=the segment
OUTPUT
ImpurityOperator_getTraceAdd = Tr[exp(-beta !H_impurity)c(t1)cd(t1)c(t2)cd(t2)...]/Tr[..]
SIDE EFFECTS
NOTES
SOURCE
1059 FUNCTION ImpurityOperator_getTraceAdd(this, CdagC_1) RESULT(trace) 1060 1061 TYPE(ImpurityOperator) , INTENT(INOUT) :: this 1062 DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN ) :: CdagC_1 1063 LOGICAL :: antiseg 1064 DOUBLE PRECISION :: trace 1065 DOUBLE PRECISION :: overlap 1066 DOUBLE PRECISION :: length 1067 DOUBLE PRECISION :: antisym_sign 1068 DOUBLE PRECISION :: beta 1069 1070 beta = this%beta 1071 antisym_sign = 1.0d0 1072 overlap = ImpurityOperator_getNewOverlap(this,CdagC_1) 1073 length = CdagC_1(C_ ) - CdagC_1(Cdag_) 1074 antiseg = length .LT. 0.d0 1075 ! length > 0 if segment; < 0 if antisegment 1076 if ( this%particles(this%activeFlavor)%tail .GT. 0 .AND. & 1077 ( ( (.NOT. antiseg) .AND. CdagC_1(C_) .GT. beta ) .OR. &! for seg only 1078 ( antiseg .AND. CdagC_1(C_) .LT. beta .AND. CdagC_1(Cdag_) .GT. beta ) & ! SIGN > 0 for antiseg only 1079 ) & 1080 ) THEN 1081 antisym_sign = -1.d0 1082 ELSE IF ( this%particles(this%activeFlavor)%tail .EQ. 0 .AND. & 1083 ( ( (.NOT. antiseg) .AND. CdagC_1(C_) .GT. beta ) .OR. & ! >beta only possible for seg 1084 ( antiseg .AND. CdagC_1(Cdag_) .LT. beta ) & ! antiseg cdag < beta 1085 ) & 1086 ) THEN 1087 antisym_sign = -1.d0 1088 END IF 1089 1090 trace = antisym_sign * DEXP(this%mat_U(this%activeFlavor,this%activeFlavor)*length + overlap) 1091 1092 END FUNCTION ImpurityOperator_getTraceAdd
ABINIT/m_ImpurityOperator/ImpurityOperator_getTraceRemove [ Functions ]
NAME
ImpurityOperator_getTraceRemove
FUNCTION
Get the ratio of the traces of the impurity hamiltonien without and with the (anti-)segment.
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator position=position of the segment
OUTPUT
ImpurityOperator_getTraceRemove = Tr[exp(-beta !H_impurity)c(t1)cd(t1)c(t2)cd(t2)...]/Tr[..]
SIDE EFFECTS
NOTES
SOURCE
1122 FUNCTION ImpurityOperator_getTraceRemove(this, position) RESULT(trace) 1123 1124 TYPE(ImpurityOperator), INTENT(INOUT) :: this 1125 INTEGER , INTENT(IN ) :: position 1126 INTEGER :: tail 1127 DOUBLE PRECISION :: trace 1128 DOUBLE PRECISION :: overlap 1129 DOUBLE PRECISION :: length 1130 DOUBLE PRECISION :: antisym_sign 1131 DOUBLE PRECISION :: last_C 1132 DOUBLE PRECISION :: beta 1133 DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_1 1134 1135 beta = this%beta 1136 antisym_sign = 1.0d0 1137 1138 CdagC_1 = ImpurityOperator_getSegment(this,position) 1139 length = CdagC_1(C_) - CdagC_1(Cdag_) 1140 ! length > 0 if segment; < 0 if antisegment 1141 overlap = ImpurityOperator_getNewOverlap(this,CdagC_1) 1142 1143 tail = this%particles(this%activeFlavor)%tail 1144 last_C = this%particles(this%activeFlavor)%list(tail,C_) 1145 IF ( last_C .GT. beta ) THEN ! tail > 0 since if tail == 0 {0,beta} 1146 IF ( ( position .EQ. tail ) .OR. & ! only possible for segment (<0 if antiseg) 1147 ( length .LT. 0.d0 .AND. tail .EQ. 1 ) ) THEN 1148 antisym_sign = -1.d0 1149 END IF 1150 ELSE 1151 IF ( tail .GT. 1 .AND. position .EQ. -tail ) & !tail>1 and last antisegment 1152 antisym_sign = -1.d0 1153 END IF 1154 1155 trace = antisym_sign * DEXP(-this%mat_U(this%activeFlavor,this%activeFlavor)*length-overlap) 1156 1157 END FUNCTION ImpurityOperator_getTraceRemove
ABINIT/m_ImpurityOperator/ImpurityOperator_init [ Functions ]
NAME
ImpurityOperator_init
FUNCTION
Initialize and allocate
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurtiyOperator flavors=number of flavors beta=inverse temperature opt_histo=opt_histo
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
157 SUBROUTINE ImpurityOperator_init(this, flavors, beta) 158 159 !Arguments ------------------------------------ 160 TYPE(ImpurityOperator), INTENT(INOUT) :: this 161 INTEGER , INTENT(IN ) :: flavors 162 !DOUBLE PRECISION , INTENT(IN ) :: U 163 !DOUBLE PRECISION , INTENT(IN ) :: J 164 DOUBLE PRECISION , INTENT(IN ) :: beta 165 !INTEGER , INTENT(IN ) :: N 166 !Local variables ------------------------------ 167 INTEGER :: IT 168 169 this%flavors = flavors 170 this%activeFlavor = 0 171 this%beta = beta 172 173 IF ( MOD(flavors,2) .NE. 0 ) & 174 CALL ERROR("ImpurityOperator_init : flavors is not even ") 175 176 !#ifdef CTQMC_CHECK 177 this%meanError = 0.d0 178 this%checkNumber = 0.d0 179 this%tolerance = 0.d0 180 this%doCheck = .FALSE. 181 !#endif 182 DT_FREEIF(this%particles) 183 DT_MALLOC(this%particles,(1:flavors)) 184 FREEIF(this%mat_U) 185 MALLOC(this%mat_U,(1:flavors,1:flavors)) 186 FREEIF(this%overlaps) 187 MALLOC(this%overlaps,(1:flavors,1:flavors)) 188 this%overlaps = 0.d0 189 FREEIF(this%updates) 190 MALLOC(this%updates,(1:flavors)) 191 this%updates = 0.d0 192 FREEIF(this%Magmommat_orb) 193 MALLOC(this%Magmommat_orb,(1:flavors,1:flavors)) 194 FREEIF(this%Magmommat_spin) 195 MALLOC(this%Magmommat_spin,(1:flavors,1:flavors)) 196 FREEIF(this%Magmommat_tot) 197 MALLOC(this%Magmommat_tot,(1:flavors,1:flavors)) 198 !CALL ImpurityOperator_computeU(this, U, J) 199 !this%mat_U = U 200 !IF ( ASSOCIATED(this%mu) ) FREE(this%mu) 201 !MALLOC(this%mu,(1:flavors)) 202 203 !this%shift_mu = SUM(this%mat_U(:,1)) * .5d0 204 DO IT = 1,flavors 205 !CALL ListCdagC_init(this%particles(IT), DBLE(N)/beta,100) !FIXME size of the List 206 CALL ListCdagC_init(this%particles(IT),100) !FIXME size of the List 207 this%particles(IT)%list(0,C_ ) = beta ! Empty orbital 208 this%particles(IT)%list(0,Cdag_) = 0.d0 209 ! this%particles(IT)%list(0)%Cdag = beta ! Full orbital 210 ! this%particles(IT)%list(0)%C = 0.d0 211 END DO 212 this%activeFlavor = 0 213 END SUBROUTINE ImpurityOperator_init
ABINIT/m_ImpurityOperator/ImpurityOperator_measDE [ Functions ]
NAME
ImpurityOperator_measDE
FUNCTION
measure double occupancy and interaction energy
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator
OUTPUT
DE=array accumulating duoble occupancy and energy
SIDE EFFECTS
NOTES
SOURCE
1582 SUBROUTINE ImpurityOperator_measDE(this,DE) 1583 1584 !Arguments ------------------------------------ 1585 TYPE(ImpurityOperator), INTENT(IN) :: this 1586 DOUBLE PRECISION, DIMENSION(:,:), INTENT(INOUT) :: DE 1587 !Local variables ------------------------------ 1588 DOUBLE PRECISION :: localD 1589 DOUBLE PRECISION :: totalE 1590 INTEGER :: iflavor1 1591 INTEGER :: iflavor2 1592 INTEGER :: flavors 1593 1594 IF ( .NOT. ALLOCATED(this%particles) ) & 1595 CALL ERROR("ImpurityOperator_measD : no particle set ") 1596 1597 totalE = 0.d0 1598 flavors = this%flavors 1599 DO iflavor1 = 1, flavors 1600 DO iflavor2 = iflavor1+1, flavors 1601 !localD = ImpurityOperator_overlapIJ(this,iflavor1,iflavor2) 1602 localD = this%overlaps(iflavor2,iflavor1) 1603 DE(iflavor2,iflavor1) = DE(iflavor2,iflavor1) + localD 1604 totalE = totalE + localD * this%mat_U(iflavor1,iflavor2) 1605 END DO 1606 END DO 1607 1608 DE(1,1) = DE(1,1) + totalE 1609 1610 END SUBROUTINE ImpurityOperator_measDE
ABINIT/m_ImpurityOperator/ImpurityOperator_measN [ Functions ]
NAME
ImpurityOperator_measN
FUNCTION
measure the number of electrons on flavor flavor
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator flavor=the flavor
OUTPUT
ImpurityOperator_measN=number of electrons
SIDE EFFECTS
NOTES
SOURCE
1685 DOUBLE PRECISION FUNCTION ImpurityOperator_measN(this,flavor) 1686 1687 !Arguments ------------------------------------ 1688 TYPE(ImpurityOperator), INTENT(IN) :: this 1689 INTEGER, OPTIONAL, INTENT(IN) :: flavor 1690 !Local variables ------------------------------ 1691 DOUBLE PRECISION :: totalCdag 1692 DOUBLE PRECISION :: totalC 1693 INTEGER :: scanning 1694 INTEGER :: aF 1695 1696 IF ( PRESENT(flavor) ) THEN 1697 aF = flavor 1698 ELSE 1699 aF = this%activeFlavor 1700 END IF 1701 1702 IF ( aF .LE. 0 ) & 1703 CALL ERROR("ImpurityOperator_measN : no active flavor ") 1704 1705 totalC = (this%particles(aF)%list(0,Cdag_) - this%particles(aF)%list(0,C_) + this%beta) * .5d0 1706 totalCdag = 0.d0 1707 1708 DO scanning = 1, this%particles(aF)%tail 1709 totalCdag = totalCdag + this%particles(aF)%list(scanning,Cdag_) 1710 totalC = totalC + this%particles(aF)%list(scanning,C_ ) 1711 END DO 1712 1713 ImpurityOperator_measN = totalC - totalCdag 1714 1715 END FUNCTION ImpurityOperator_measN
ABINIT/m_ImpurityOperator/ImpurityOperator_occup_histo_time [ Functions ]
NAME
ImpurityOperator_occup_histo_time SUBROUTINE Compute histogrammes of occupations.
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (B. Amadon, F. Gendron) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator histo=histogramme of occupations
OUTPUT
ImpurityOperator_occup_histo_time=number of electrons
SIDE EFFECTS
NOTES
SOURCE
2154 SUBROUTINE ImpurityOperator_occup_histo_time(this,histo,occupconfig,suscep,ntau,chi,chicharge,ntot,opt_histo,nspinor) 2155 2156 !Arguments ------------------------------------ 2157 TYPE(ImpurityOperator), INTENT(IN) :: this 2158 DOUBLE PRECISION, DIMENSION(:), INTENT(OUT) :: histo 2159 DOUBLE PRECISION, DIMENSION(:), INTENT(OUT) :: occupconfig 2160 DOUBLE PRECISION, DIMENSION(:,:), INTENT(OUT) :: suscep 2161 INTEGER, INTENT(IN) :: ntau 2162 DOUBLE PRECISION, DIMENSION(:,:), INTENT(OUT) :: chi 2163 DOUBLE PRECISION, DIMENSION(:,:), INTENT(OUT) :: chicharge 2164 DOUBLE PRECISION, DIMENSION(:), INTENT(OUT) :: ntot 2165 !Local variables ------------------------------ 2166 DOUBLE PRECISION :: tau 2167 INTEGER :: scanning, opt_histo,nspinor 2168 INTEGER :: iflavor, itau,jtau,kdeltatau,noccup,iconfig,sumh,nmeas 2169 INTEGER :: iflavor1, iflavor2 2170 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: occup 2171 INTEGER, ALLOCATABLE, DIMENSION(:) :: occuptot 2172 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: spinup,spindn 2173 INTEGER, ALLOCATABLE, DIMENSION(:) :: occupconfig_loc 2174 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: histo_loc 2175 ! DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: histo_loc_config 2176 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: magmommat_orb 2177 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: magmommat_spin 2178 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: magmommat_tot 2179 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: mu_tmp 2180 !------------------------------------------------------------- 2181 2182 2183 MALLOC(occuptot,(1:ntau)) 2184 MALLOC(spinup,(1:3,1:ntau)) 2185 MALLOC(spindn,(1:3,1:ntau)) 2186 MALLOC(occup,(1:this%flavors,1:ntau)) 2187 MALLOC(occupconfig_loc,(2**this%flavors)) 2188 MALLOC(histo_loc,(1:this%flavors+1)) 2189 occupconfig_loc=0 2190 nmeas=0 2191 2192 do itau=1,ntau 2193 tau=float(itau-1)/float(ntau)*this%beta 2194 occuptot(itau)=0 2195 spinup(:,itau)=0 2196 spindn(:,itau)=0 2197 ! write(6,*) "tau",tau 2198 iconfig=0 2199 do iflavor = 1, this%flavors 2200 occup(iflavor,itau)=0 2201 do scanning = 1, this%particles(iflavor)%tail 2202 ! write(6,*) itau,iflavor,scanning 2203 ! write(6,*) "tau",tau,this%particles(iflavor)%list(scanning,Cdag_),this%particles(iflavor)%list(scanning,C_) 2204 ! write(6,*) "Hello Fred 2",tau,iflavor,this%particles(iflavor)%list(scanning,C_)-this%particles(iflavor)%list(scanning,Cdag_),this%beta 2205 2206 if(this%particles(iflavor)%list(scanning,C_)>this%beta.and.tau<this%particles(iflavor)%list(scanning,Cdag_)) then 2207 2208 if(tau<(this%particles(iflavor)%list(scanning,C_)-this%beta).and.& 2209 & tau>(this%particles(iflavor)%list(scanning,Cdag_)-this%beta)) then 2210 occup(iflavor,itau)=occup(iflavor,itau)+1 2211 endif 2212 2213 else 2214 2215 if(tau<this%particles(iflavor)%list(scanning,C_).and.tau>this%particles(iflavor)%list(scanning,Cdag_)) then 2216 occup(iflavor,itau)=occup(iflavor,itau)+1 2217 endif 2218 2219 endif 2220 2221 enddo 2222 2223 !full orbital 2224 if ( this%particles(iflavor)%list(0,C_) .eq. 0.d0 ) then 2225 !write(6,*) "Yes",this%particles(iflavor)%list(0,C_) 2226 occup(iflavor,itau)=occup(iflavor,itau)+1 2227 endif 2228 2229 occuptot(itau)= occuptot(itau) + occup(iflavor,itau) 2230 if(iflavor<this%flavors/2+1) THEN 2231 spinup(1,itau)= spinup(1,itau) + occup(iflavor,itau) 2232 if(iflavor==1.or.iflavor==2.or.iflavor==4.or.iflavor==6.or.iflavor==7.or.iflavor==9) THEN 2233 spinup(2,itau)= spinup(2,itau) + occup(iflavor,itau) 2234 else 2235 spinup(3,itau)= spinup(3,itau) + occup(iflavor,itau) 2236 !if(spinup(3,itau)>4) THEN 2237 ! write(6,*) "Error",spinup(:,itau),occup(:,itau) 2238 ! if(iflavor==1.or.iflavor==2.or.iflavor==4) THEN 2239 ! write(6,*) iflavor,occup(iflavor,itau) 2240 ! endif 2241 ! stop 2242 !endif 2243 endif 2244 else 2245 spindn(1,itau)= spindn(1,itau) + occup(iflavor,itau) 2246 if(iflavor==1.or.iflavor==2.or.iflavor==4.or.iflavor==6.or.iflavor==7.or.iflavor==9) THEN 2247 spindn(2,itau)= spindn(2,itau) + occup(iflavor,itau) 2248 else 2249 spindn(3,itau)= spindn(3,itau) + occup(iflavor,itau) 2250 !if(spindn(3,itau)>4) THEN 2251 ! write(6,*) "Error spin",spindn(:,itau),occup(:,itau) 2252 ! write(6,*) "Error occup",occup(:,itau) 2253 ! if(iflavor==1.or.iflavor==2.or.iflavor==4) THEN 2254 ! write(6,*) iflavor,occup(iflavor,itau) 2255 ! endif 2256 ! stop 2257 !endif 2258 endif 2259 endif 2260 2261 ! === Construct index of configuration in base 10 2262 iconfig=iconfig+2**(iflavor-1)*occup(iflavor,itau) 2263 2264 enddo 2265 2266 ! === After the loop over flavor, iconfig has a meaning and can be used 2267 occupconfig_loc(iconfig+1)= occupconfig_loc(iconfig+1)+1 2268 nmeas=nmeas+1 2269 2270 enddo 2271 2272 histo_loc=0 2273 do itau=1,ntau 2274 histo_loc(occuptot(itau)+1)=histo_loc(occuptot(itau)+1)+1 2275 enddo 2276 2277 ! write(6,*) 2278 ! write(6,*) "=== Histogram of occupations ====" 2279 do noccup=1,this%flavors+1 2280 histo_loc(noccup)=histo_loc(noccup)/float(ntau)*100.0 2281 ! write(6,*) noccup-1, histo_loc(noccup) 2282 histo(noccup)= histo(noccup) + histo_loc(noccup) 2283 enddo 2284 ! write(6,*) "=================================" 2285 ! write(6,*) 2286 2287 ! write(6,*) "=================================" 2288 sumh=zero 2289 do iconfig=1,2**(this%flavors) 2290 ! occupconfig_loc(iconfig)=occupconfig_loc(iconfig)/float(ntau)*100.0 2291 occupconfig(iconfig)=occupconfig(iconfig)+float(occupconfig_loc(iconfig))/float(ntau)*100.0 2292 ! write(6,*) "one step",float(occupconfig_loc(iconfig))/float(ntau)*100.0 2293 sumh=sumh+occupconfig_loc(iconfig) 2294 enddo 2295 ! write(6,*) "sumh",sumh,ntau,nmeas 2296 2297 !============================================================ 2298 ! Susceptibility Section 2299 !============================================================ 2300 if(opt_histo .gt. 1) then 2301 if(nspinor .eq. 1) then 2302 ! == Scalar Spin Susceptibility 2303 do itau=1,ntau 2304 !tau=float(itau-1)/float(ntau)*this%beta 2305 ! write(7735,*) float(itau-1)/float(ntau)*this%beta,spinup(itau),spindn(itau),(spinup(itau)-spindn(itau))**2 2306 ! 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)) 2307 do jtau=1,ntau 2308 !tauj=float(jtau-1)/float(ntau)*this%beta 2309 kdeltatau=jtau-itau+1 2310 if(jtau<itau) kdeltatau=kdeltatau+ntau 2311 if(kdeltatau> ntau) write(std_out,*) "Warning kdeltatau" 2312 suscep(1,kdeltatau)=suscep(1,kdeltatau)+float((spinup(1,jtau)-spindn(1,jtau)))*float((spinup(1,itau)-spindn(1,itau))) 2313 suscep(2,kdeltatau)=suscep(2,kdeltatau)+float((spinup(2,jtau)-spindn(2,jtau)))*float((spinup(2,itau)-spindn(2,itau))) 2314 suscep(3,kdeltatau)=suscep(3,kdeltatau)+float((spinup(3,jtau)-spindn(3,jtau)))*float((spinup(3,itau)-spindn(3,itau))) 2315 ! write(6,*) "Su",suscep(kdeltatau),spinup(tau)-spindn(jtau),spinup(itau)-spindn(itau) 2316 ! write(6,*) "Su",itau,jtau,kdeltatau 2317 enddo 2318 !write(7735,*) float(itau-1)/float(ntau)*this%beta,spinup(itau),spindn(itau),(spinup(itau)-spindn(itau))**2 2319 !write(7736,*) float(itau-1)/float(ntau)*this%beta,(spinup(itau)-spindn(itau))**2 2320 !write(7737,*) float(itau-1)/float(ntau)*this%beta,suscep(1) 2321 enddo 2322 2323 else 2324 ! == Spin Orbit Susceptibility 2325 MALLOC(magmommat_orb,(1:this%flavors,1:this%flavors)) 2326 magmommat_orb=this%Magmommat_orb 2327 MALLOC(magmommat_spin,(1:this%flavors,1:this%flavors)) 2328 magmommat_spin=this%Magmommat_spin 2329 MALLOC(magmommat_tot,(1:this%flavors,1:this%flavors)) 2330 magmommat_tot=this%Magmommat_tot 2331 MALLOC(mu_tmp,(1:3,1:ntau)) 2332 2333 ! == Product of occupation matrix with magnetic moment matrix 2334 do itau=1,ntau 2335 mu_tmp(:,itau)=0 2336 do iflavor1=1,this%flavors 2337 do iflavor2=1,this%flavors 2338 if(iflavor1==iflavor2) then 2339 mu_tmp(1,itau) = mu_tmp(1,itau) + magmommat_tot(iflavor1,iflavor2)*occup(iflavor1,itau) 2340 mu_tmp(2,itau) = mu_tmp(2,itau) + magmommat_orb(iflavor1,iflavor2)*occup(iflavor1,itau) 2341 mu_tmp(3,itau) = mu_tmp(3,itau) + magmommat_spin(iflavor1,iflavor2)*occup(iflavor1,itau) 2342 !write(6,*) itau, magmommat(iflavor1,iflavor2), mu_tmp(:,itau)/ntau 2343 end if 2344 end do 2345 end do 2346 end do 2347 2348 ! == Correlation function of mu_tmp for magnetic susceptibility with SOC (Approach 1) 2349 do itau=1,ntau 2350 do jtau=1,ntau 2351 kdeltatau=jtau-itau+1 2352 if(jtau<itau) kdeltatau=kdeltatau+ntau 2353 if(kdeltatau> ntau) write(std_out,*) "Warning kdeltatau" 2354 chi(1,kdeltatau) = chi(1,kdeltatau) + (mu_tmp(1,itau))*(mu_tmp(1,jtau)) 2355 chi(2,kdeltatau) = chi(2,kdeltatau) + (mu_tmp(2,itau))*(mu_tmp(2,jtau)) 2356 chi(3,kdeltatau) = chi(3,kdeltatau) + (mu_tmp(3,itau))*(mu_tmp(3,jtau)) 2357 end do 2358 end do 2359 2360 FREE(mu_tmp) 2361 FREE(magmommat_orb) 2362 FREE(magmommat_spin) 2363 FREE(magmommat_tot) 2364 endif 2365 endif 2366 2367 if(opt_histo .gt. 2) then 2368 ! == Scalar Charge Susceptibility 2369 2370 do itau = 1,ntau 2371 ntot(1) = ntot(1) + occuptot(itau) 2372 ntot(2) = ntot(2) + float(spinup(2,itau)+spindn(2,itau)) 2373 ntot(3) = ntot(3) + float(spinup(3,itau)+spindn(3,itau)) 2374 enddo 2375 2376 do itau=1,ntau 2377 do jtau=1,ntau 2378 kdeltatau=jtau-itau+1 2379 if(jtau<itau) kdeltatau=kdeltatau+ntau 2380 if(kdeltatau> ntau) write(std_out,*) "Warning kdeltatau" 2381 chicharge(1,kdeltatau)=chicharge(1,kdeltatau)+float((spinup(1,jtau)+spindn(1,jtau)))*float((spinup(1,itau)+spindn(1,itau))) 2382 chicharge(2,kdeltatau)=chicharge(2,kdeltatau)+float((spinup(2,jtau)+spindn(2,jtau)))*float((spinup(2,itau)+spindn(2,itau))) 2383 chicharge(3,kdeltatau)=chicharge(3,kdeltatau)+float((spinup(3,jtau)+spindn(3,jtau)))*float((spinup(3,itau)+spindn(3,itau))) 2384 enddo 2385 enddo 2386 2387 ! == Spin-orbit Charge Susceptibility 2388 ! Rotation of occupation matrix ... to be done 2389 endif 2390 2391 FREE(occup) 2392 FREE(occupconfig_loc) 2393 FREE(histo_loc) 2394 FREE(occuptot) 2395 FREE(spinup) 2396 FREE(spindn) 2397 2398 2399 END SUBROUTINE ImpurityOperator_occup_histo_time
ABINIT/m_ImpurityOperator/ImpurityOperator_overlapFlavor [ Functions ]
NAME
ImpurityOperator_overlapFlavor
FUNCTION
Returns the overlap of flavor with the others
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator flavor=the one we want
OUTPUT
ImpurityOperator_overlapFlavor=result
SIDE EFFECTS
NOTES
SOURCE
1354 DOUBLE PRECISION FUNCTION ImpurityOperator_overlapFlavor(this,flavor) 1355 1356 !Arguments ------------------------------------ 1357 TYPE(ImpurityOperator), INTENT(IN) :: this 1358 INTEGER, OPTIONAL, INTENT(IN) :: flavor 1359 !Local variables ------------------------------ 1360 INTEGER :: otherFlavor 1361 DOUBLE PRECISION :: overlap 1362 DOUBLE PRECISION :: totalOverlap 1363 1364 totalOverlap = 0.d0 1365 DO otherFlavor = 1, this%flavors 1366 IF ( otherFlavor .EQ. flavor ) CYCLE 1367 overlap = this%overlaps(otherFlavor,flavor) 1368 totalOverlap = totalOverlap & 1369 + overlap * this%mat_U(otherFlavor,flavor) 1370 END DO 1371 1372 ImpurityOperator_overlapFlavor = totalOverlap 1373 1374 END FUNCTION ImpurityOperator_overlapflavor
ABINIT/m_ImpurityOperator/ImpurityOperator_overlapIJ [ Functions ]
NAME
ImpurityOperator_overlapIJ
FUNCTION
Compute overlap between two flavors
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator i=first flavor j=second flavor
OUTPUT
ImpurityOperator_overlapIJ=result
SIDE EFFECTS
NOTES
SOURCE
1521 DOUBLE PRECISION FUNCTION ImpurityOperator_overlapIJ(this,i,j) 1522 1523 !Arguments ------------------------------------ 1524 TYPE(ImpurityOperator), INTENT(INOUT) :: this 1525 INTEGER , INTENT(IN) :: i 1526 INTEGER , INTENT(IN) :: j 1527 !Local variables ------------------------------ 1528 ! TYPE(ListCdagC) , POINTER :: particle1 => NULL() 1529 ! DOUBLE PRECISION, DIMENSION(:,:), POINTER :: list1 => NULL() 1530 INTEGER :: tail1 1531 DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_1 1532 INTEGER :: isegment 1533 1534 ! particle1 => this%particles(i) 1535 ! list1 => particle1%list 1536 tail1 = this%particles(i)%tail 1537 1538 ImpurityOperator_overlapIJ = 0.d0 1539 IF ( tail1 .EQ. 0 .AND. this%particles(i)%list(0,C_) .EQ. 0.d0 ) THEN ! FULL 1540 ! CALL CdagC_init(CdagC_1,0.d0,this%beta) 1541 CdagC_1(Cdag_) = 0.d0 1542 CdagC_1(C_ ) = this%beta 1543 1544 ImpurityOperator_overlapIJ = ImpurityOperator_overlapSegFlav(this,CdagC_1,j) 1545 ELSE IF ( tail1 .GT. 0) THEN 1546 this%activeFlavor = i 1547 DO isegment = 1, tail1 1548 CdagC_1(:) = this%particles(i)%list(isegment,1:2) 1549 ImpurityOperator_overlapIJ = ImpurityOperator_overlapIJ & 1550 + ImpurityOperator_overlapSegFlav(this,CdagC_1,j) 1551 END DO 1552 END IF 1553 1554 END FUNCTION ImpurityOperator_overlapIJ
ABINIT/m_ImpurityOperator/ImpurityOperator_overlapSegFlav [ Functions ]
NAME
ImpurityOperator_overlapSegFlav
FUNCTION
Compute the overlap of a segment with a flavor
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator CdagC_1=segment flavor=flavor to use
OUTPUT
ImpurityOperator_overlapSegFlav=overlap between CdagC_1 and flavor
SIDE EFFECTS
NOTES
SOURCE
1187 DOUBLE PRECISION FUNCTION ImpurityOperator_overlapSegFlav(this,CdagC_1,flavor) 1188 1189 !Arguments ------------------------------------ 1190 TYPE(ImpurityOperator), INTENT(INOUT) :: this 1191 ! TYPE(CdagC) , INTENT(IN) :: CdagC_1 1192 DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN) :: CdagC_1 1193 INTEGER , INTENT(IN) :: flavor 1194 !Local variables ------------------------------ 1195 ! TYPE(CdagC), DIMENSION(:), POINTER :: list => NULL() 1196 DOUBLE PRECISION :: totalCdag 1197 DOUBLE PRECISION :: totalC 1198 DOUBLE PRECISION :: beta 1199 DOUBLE PRECISION :: Time 1200 DOUBLE PRECISION :: Tmin 1201 DOUBLE PRECISION :: Tmax 1202 DOUBLE PRECISION :: TmaxBeta 1203 DOUBLE PRECISION :: TscanMin 1204 DOUBLE PRECISION :: TscanMax 1205 ! DOUBLE PRECISION :: sign 1206 DOUBLE PRECISION :: C 1207 DOUBLE PRECISION :: Cdag 1208 DOUBLE PRECISION :: loop 1209 DOUBLE PRECISION :: itmin 1210 DOUBLE PRECISION :: itmax 1211 INTEGER :: tail 1212 INTEGER :: tp1 1213 INTEGER :: scanning 1214 INTEGER :: imin 1215 INTEGER :: imax 1216 INTEGER :: loops 1217 INTEGER :: iloop 1218 #include "ListCdagC_firstHigher.h" 1219 1220 beta = this%beta 1221 Tmin = CdagC_1(Cdag_) 1222 Tmax = CdagC_1(C_) 1223 itmin= 0.d0 1224 1225 ! TmaxBeta = Tmax.MOD.beta 1226 MODCYCLE(Tmax,beta,TmaxBeta) 1227 1228 tail = this%particles(flavor)%tail 1229 1230 totalC = 0.d0 1231 totalCdag = 0.d0 1232 IF ( tail .NE. 0 ) THEN 1233 tp1 = tail + 1 1234 loop = 0.d0 1235 ! imin = ListCdagC_firstHigher( this%particles(flavor), Tmin ) - 1 1236 Time = Tmin 1237 #define list_1 this%particles(flavor) 1238 #include "ListCdagC_firstHigher" 1239 imin = firstHigher - 1 1240 1241 SELECT CASE ( imin ) 1242 CASE(0) 1243 scanning = tail 1244 loop = -1.d0 1245 CASE(-2) 1246 scanning = tail 1247 CASE DEFAULT 1248 scanning = imin 1249 END SELECT 1250 ! imax = ListCdagC_firstHigher( this%particles(flavor), TmaxBeta ) !- 1 Jamais atteint 1251 Time = TmaxBeta 1252 #include "ListCdagC_firstHigher" 1253 #undef list_1 1254 imax = firstHigher 1255 1256 TscanMin = Tmin 1257 TscanMax = Tmax 1258 1259 ! Regarder avant 1260 IF ( (imin .EQ. 0) ) THEN 1261 C = this%particles(flavor)%list(scanning,C_) +loop* beta 1262 Cdag = this%particles(flavor)%list(scanning,Cdag_) +loop* beta 1263 itmax = MAX(TscanMin, Cdag) 1264 itmin = MIN(TscanMax, C ) 1265 1266 IF ( itmin .GT. itmax ) THEN ! si egal alors overlap de 0 1267 totalC = totalC + itmin 1268 totalCdag = totalCdag + itmax 1269 END IF 1270 scanning = scanning+1 1271 IF ( scanning .EQ. tp1 ) THEN 1272 scanning = 1 1273 END IF 1274 END IF 1275 1276 loops = imax - scanning 1277 IF ( TmaxBeta .NE. Tmax ) THEN 1278 loops = tail - loops 1279 ELSE IF ( imax .EQ. -1 ) THEN 1280 loops = tail - imin 1281 END IF 1282 1283 !Comparer betement 2 segments 1284 DO iloop =0, loops 1285 C = this%particles(flavor)%list(scanning,C_) 1286 Cdag = this%particles(flavor)%list(scanning,Cdag_) 1287 itmax = MAX(TscanMin, Cdag) 1288 itmin = MIN(TscanMax,C) 1289 1290 IF ( itmin .GT. itmax ) THEN ! si egal alors overla de 0 1291 totalC = totalC + itmin 1292 totalCdag = totalCdag + itmax 1293 END IF 1294 scanning = scanning + 1 1295 IF ( scanning .EQ. tp1 ) THEN 1296 scanning = 1 1297 IF ( itmin .EQ. TScanMax ) EXIT 1298 TscanMin = TscanMin - beta 1299 TscanMax = TscanMax - beta 1300 END IF 1301 END DO 1302 1303 ! Regarder apres le segment 1304 IF ( (itmin .NE. TscanMax) ) THEN 1305 C = this%particles(flavor)%list(scanning,C_) 1306 Cdag = this%particles(flavor)%list(scanning,Cdag_) 1307 itmax = MAX(TscanMin, Cdag) 1308 itmin = MIN(TscanMax,C) 1309 1310 IF ( itmin .GT. itmax ) THEN ! si egal alors overla de 0 1311 totalC = totalC + itmin 1312 totalCdag = totalCdag + itmax 1313 END IF 1314 END IF 1315 ELSE IF ( this%particles(flavor)%list(0,C_) .EQ. 0.d0 ) THEN ! full orbital 1316 totalC = Tmax 1317 totalCdag = Tmin 1318 END IF 1319 !#ifdef CTQMC_CHECK 1320 IF ( this%doCheck .EQV. .TRUE. ) & 1321 CALL ImpurityOperator_checkOverlap(this, Tmin, Tmax,totalC-totalCdag,flavor) 1322 !#endif 1323 ImpurityOperator_overlapSegFlav = totalC - totalCdag 1324 1325 END FUNCTION ImpurityOperator_overlapSegFlav
ABINIT/m_ImpurityOperator/ImpurityOperator_overlapSwap [ Functions ]
NAME
ImpurityOperator_overlapSwap
FUNCTION
compute the overlap of flavor1 with the configuration of flavor2
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator flavor1=interaction value flavor2=configuration
OUTPUT
ImpurityOperator_overlapSwap=new overlap
SIDE EFFECTS
NOTES
SOURCE
1404 DOUBLE PRECISION FUNCTION ImpurityOperator_overlapSwap(this,flavor1,flavor2) 1405 1406 !Arguments ------------------------------------ 1407 TYPE(ImpurityOperator), INTENT(IN) :: this 1408 INTEGER , INTENT(IN) :: flavor1 1409 INTEGER , INTENT(IN) :: flavor2 1410 !Local variables ------------------------------ 1411 INTEGER :: otherFlavor 1412 DOUBLE PRECISION :: overlap 1413 DOUBLE PRECISION :: totalOverlap 1414 1415 totalOverlap = 0.d0 1416 ! Calcul l'overlap de flavor1 en utilisant la configuration de flavor2 1417 DO otherFlavor = 1, this%flavors 1418 IF ( otherFlavor .EQ. flavor2 ) THEN 1419 CYCLE 1420 ELSE IF ( otherFlavor .EQ. flavor1 ) THEN 1421 overlap = this%overlaps(otherFlavor,flavor2) 1422 totalOverlap = totalOverlap & 1423 + overlap * this%mat_U(otherFlavor,flavor2) 1424 ELSE 1425 overlap = this%overlaps(otherFlavor,flavor2) 1426 totalOverlap = totalOverlap & 1427 + overlap * this%mat_U(otherFlavor,flavor1) 1428 END IF 1429 END DO 1430 1431 ImpurityOperator_overlapSwap = totalOverlap 1432 1433 END FUNCTION ImpurityOperator_overlapSwap
ABINIT/m_ImpurityOperator/ImpurityOperator_printLatex [ Functions ]
NAME
ImpurityOperator_printLatex
FUNCTION
print in a latex format all the configuration
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator ostream=file stream isweep=current sweep number
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
2051 SUBROUTINE ImpurityOperator_printLatex(this, ostream, isweep) 2052 2053 !Arguments ------------------------------------ 2054 TYPE(ImpurityOperator), INTENT(IN) :: this 2055 INTEGER , INTENT(IN) :: ostream 2056 INTEGER , INTENT(IN) :: isweep 2057 !Local variables ------------------------------ 2058 INTEGER :: flavors 2059 INTEGER :: iflavor 2060 INTEGER :: tail 2061 INTEGER :: it 2062 DOUBLE PRECISION :: C 2063 DOUBLE PRECISION :: Cdag 2064 INTEGER :: ordo 2065 INTEGER :: y 2066 INTEGER :: lines 2067 INTEGER :: letters 2068 DOUBLE PRECISION :: length 2069 2070 flavors = this%flavors 2071 2072 WRITE(ostream,'(A13)') "\begin{frame}" 2073 WRITE(ostream,'(2x,A14)') "\begin{figure}" 2074 WRITE(ostream,'(4x,A28)') "\setlength{\unitlength}{1mm}" 2075 WRITE(ostream,'(4x,A23)') "\begin{picture}(104,90)" 2076 WRITE(ostream,'(6x,A29,I6,A2)') "\put(52,00){\makebox(0,0)[c]{",isweep,"}}" 2077 y = INT(90.d0/DBLE(flavors+1)) 2078 DO iflavor = 1, flavors 2079 tail = this%particles(iflavor)%tail 2080 ordo = iflavor * y 2081 lines = ordo - 1 2082 letters = ordo - 5 2083 WRITE(ostream,'(6x,A6,I2)') "%ligne", iflavor 2084 WRITE(ostream,'(6x,A41,I2,A16)') "\linethickness{0.5pt}\color{black}\put(2,",lines,"){\line(0,1){2}}" 2085 WRITE(ostream,'(6x,A7,I2,A24)') "\put(2,",letters,"){\makebox(0,0)[c]{$0$}}" 2086 WRITE(ostream,'(6x,A7,I2,A18)') "\put(2,",ordo,"){\line(1,0){100}}" 2087 WRITE(ostream,'(6x,A9,I2,A16)') "\put(102,",lines,"){\line(0,1){2}}" 2088 WRITE(ostream,'(6x,A9,I2,A28)') "\put(102,",letters,"){\makebox(0,0)[c]{$\beta$}}" 2089 DO it = 1, tail 2090 Cdag = 2.d0+(this%particles(iflavor)%list(it,Cdag_)/this%beta*100.d0) 2091 C = 2.d0+(this%particles(iflavor)%list(it,C_ )/this%beta*100.d0) 2092 length = C - Cdag 2093 IF ( this%particles(iflavor)%list(it,C_) .LE. this%beta ) THEN 2094 WRITE(ostream,'(8x,A9,I2)') "%segments", it 2095 WRITE(ostream,'(8x,A37,F5.1,A1,I2,A13,F5.1,A2)') & 2096 "\linethickness{2pt}\color{black}\put(",Cdag,",",ordo,"){\line(1,0){",length,"}}" 2097 WRITE(ostream,'(8x,A5)') "%Cdag" 2098 WRITE(ostream,'(8x,A12)') "\color{blue}" 2099 WRITE(ostream,'(8x,A5,F5.1,A1,I2,A14)') "\put(",Cdag,",",ordo,"){\circle*{1}}" 2100 WRITE(ostream,'(8x,A2)') "%C" 2101 WRITE(ostream,'(8x,A11)') "\color{red}" 2102 WRITE(ostream,'(8x,A5,F5.1,A1,I2,A14)') "\put(",C,",",ordo,"){\circle*{1}}" 2103 ELSE 2104 WRITE(ostream,'(8x,A9,I2)') "%segments", it 2105 WRITE(ostream,'(8x,A37,F5.1,A1,I2,A13,F5.1,A2)') & 2106 "\linethickness{2pt}\color{black}\put(",Cdag,",",ordo,"){\line(1,0){",102.d0-Cdag,"}}" 2107 WRITE(ostream,'(8x,A7,I2,A13,F5.1,A2)') "\put(2,",ordo,"){\line(1,0){",C-102.d0,"}}" 2108 WRITE(ostream,'(8x,A5)') "%Cdag" 2109 WRITE(ostream,'(8x,A12)') "\color{blue}" 2110 WRITE(ostream,'(8x,A5,F5.1,A1,I2,A14)') "\put(",Cdag,",",ordo,"){\circle*{1}}" 2111 WRITE(ostream,'(8x,A2)') "%C" 2112 WRITE(ostream,'(8x,A11)') "\color{red}" 2113 WRITE(ostream,'(8x,A5,F5.1,A1,I2,A14)') "\put(",C-100.d0,",",ordo,"){\circle*{1}}" 2114 END IF 2115 END DO 2116 IF ( tail .EQ. 0 .AND. this%particles(iflavor)%list(0,C_) .EQ. 0.d0 ) THEN 2117 WRITE(ostream,'(8x,A9,I2)') "%segments", it 2118 WRITE(ostream,'(8x,A39,I2,A18)') "\linethickness{2pt}\color{black}\put(2,",ordo,"){\line(1,0){100}}" 2119 END IF 2120 END DO 2121 WRITE(ostream,'(4x,A13)') "\end{picture}" 2122 WRITE(ostream,'(2x,A12)') "\end{figure}" 2123 WRITE(ostream,'(2x,A17)') "\transduration{0}" 2124 WRITE(ostream,'(A11)') "\end{frame}" 2125 END SUBROUTINE ImpurityOperator_printLatex
ABINIT/m_ImpurityOperator/ImpurityOperator_remove [ Functions ]
NAME
ImpurityOperator_remove
FUNCTION
Remove a segment for the active flavor
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurityOperator ieme=segment to remove
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
797 SUBROUTINE ImpurityOperator_remove(this,ieme) 798 799 !Arguments ------------------------------------ 800 TYPE(ImpurityOperator), INTENT(INOUT) :: this 801 INTEGER , INTENT(IN ) :: ieme 802 !Local variables ------------------------------ 803 DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_1 804 INTEGER :: position 805 INTEGER :: position_dwn 806 INTEGER :: i 807 INTEGER :: tail 808 INTEGER :: aF 809 ! DOUBLE PRECISION :: toRemove 810 811 aF = this%activeFlavor 812 IF ( aF .LE. 0 ) & 813 CALL ERROR("ImpurityOperator_removeIeme : no active flavor ") 814 position = ABS(ieme) 815 IF ( position .GT. this%particles(aF)%tail ) & 816 CALL ERROR("ImpurityOperator_removeIeme : out of range ") 817 818 IF ( (ieme .LT. 0) .AND. (this%particles(aF)%tail .GT. 1) ) THEN 819 position_dwn = position 820 ! position = (position+1).MOD.this%particles(aF)%tail 821 tail = this%particles(aF)%tail 822 MODCYCLE((position+1),tail,position) 823 CdagC_1(Cdag_) = this%particles(aF)%list(position_dwn,Cdag_) 824 CdagC_1(C_ ) = this%particles(aF)%list(position,C_) 825 IF (position_dwn .GT. position) CdagC_1(C_) = CdagC_1(C_) + this%beta 826 ! toRemove = this%particles(aF)%list(position)%C - (CdagC_1%C.MOD.this%beta) 827 ! CdagC_1%C = CdagC_1%C + toRemove 828 this%particles(aF)%list(position_dwn,:) = CdagC_1 829 END IF 830 831 IF ( position .EQ. 1 ) THEN 832 SELECT CASE (ieme) 833 CASE (1) 834 this%particles(aF)%list(0,C_ ) = this%beta 835 this%particles(aF)%list(0,Cdag_) = 0.d0 836 CASE (-1) 837 this%particles(aF)%list(0,C_ ) = 0.d0 838 this%particles(aF)%list(0,Cdag_) = this%beta 839 END SELECT 840 END IF 841 CALL ListCdagC_erase(this%particles(aF),position) 842 DO i = 1, this%flavors 843 this%overlaps(i,aF) = this%overlaps(i,aF) - this%updates(i) 844 this%overlaps(aF,i) = this%overlaps(i,aF) 845 END DO 846 END SUBROUTINE ImpurityOperator_remove
ABINIT/m_ImpurityOperator/ImpurityOperator_reset [ Functions ]
NAME
ImpurityOperator_reset
FUNCTION
reset operator
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurtiyOperator
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
240 SUBROUTINE ImpurityOperator_reset(this) 241 242 !Arguments ------------------------------------ 243 TYPE(ImpurityOperator), INTENT(INOUT) :: this 244 !Local variables ------------------------------ 245 INTEGER :: IT 246 247 this%activeFlavor = 0 248 this%overlaps = 0.d0 249 this%updates = 0.d0 250 !#ifdef CTQMC_CHECK 251 this%meanError = 0.d0 252 this%checkNumber = 0.d0 253 this%tolerance = 0.d0 254 this%doCheck = .FALSE. 255 !#endif 256 DO IT = 1,this%flavors 257 CALL ListCdagC_clear(this%particles(IT)) 258 this%particles(IT)%list(0,C_ ) = this%beta ! Empty orbital 259 this%particles(IT)%list(0,Cdag_) = 0.d0 260 ! this%particles(IT)%list(0)%Cdag = beta ! Full orbital 261 ! this%particles(IT)%list(0)%C = 0.d0 262 END DO 263 264 END SUBROUTINE ImpurityOperator_reset
ABINIT/m_ImpurityOperator/ImpurityOperator_setMagmommat [ Functions ]
NAME
ImpurityOperator_setMagmommat
FUNCTION
Set directly the Magnetic moment this
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (F. Gendron) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurtityOperator matU=interaction this
OUTPUT
SIDE EFFECTS
NOTES
PARENTS
Will be filled automatically by the parent script
CHILDREN
Will be filled automatically by the parent script
SOURCE
2433 SUBROUTINE ImpurityOperator_setMagmommat(this, Magmom_orb, Magmom_spin, Magmom_tot) 2434 2435 !Arguments ------------------------------------ 2436 TYPE(ImpurityOperator), INTENT(INOUT) :: this 2437 DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: Magmom_orb 2438 DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: Magmom_spin 2439 DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: Magmom_tot 2440 !Local----------------------------------------- 2441 INTEGER :: iflavor1 2442 INTEGER :: iflavor2 2443 2444 !debug 2445 ! write(6,*) "Inside Impurity_set Magmommat" 2446 ! 2447 ! do iflavor1=1,10 2448 ! do iflavor2=1,10 2449 ! if(iflavor1==iflavor2) THEN 2450 ! write(6,*) iflavor1, iflavor2, Magmom(iflavor1,iflavor2) 2451 ! end if 2452 ! end do 2453 ! end do 2454 2455 DO iflavor1 = 1, this%flavors 2456 DO iflavor2 = 1, this%flavors 2457 this%Magmommat_orb(iflavor1,iflavor2) = Magmom_orb(iflavor1,iflavor2) 2458 this%Magmommat_spin(iflavor1,iflavor2) = Magmom_spin(iflavor1,iflavor2) 2459 this%Magmommat_tot(iflavor1,iflavor2) = Magmom_tot(iflavor1,iflavor2) 2460 END DO 2461 END DO 2462 2463 END SUBROUTINE ImpurityOperator_setMagmommat
ABINIT/m_ImpurityOperator/ImpurityOperator_setMu [ Functions ]
NAME
ImpurityOperator_setMu
FUNCTION
Set directly the chemical potential
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurtityOperator mu=chimical potential
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
405 SUBROUTINE ImpurityOperator_setMu(this, mu) 406 407 !Arguments ------------------------------------ 408 TYPE(ImpurityOperator), INTENT(INOUT) :: this 409 DOUBLE PRECISION, DIMENSION(:), INTENT(IN ) :: mu 410 INTEGER :: iflavor 411 412 IF ( SIZE(mu) .NE. this%flavors ) & 413 CALL ERROR("ImpurityOperator_setMu : Wrong chimical potentials") 414 415 DO iflavor = 1, this%flavors 416 this%mat_U(iflavor,iflavor) = mu(iflavor) 417 END DO 418 END SUBROUTINE ImpurityOperator_setMu
ABINIT/m_ImpurityOperator/ImpurityOperator_setUmat [ Functions ]
NAME
ImpurityOperator_setUmat
FUNCTION
Set directly the U interaction this
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurtityOperator matU=interaction this
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
360 SUBROUTINE ImpurityOperator_setUmat(this, matU) 361 362 !Arguments ------------------------------------ 363 TYPE(ImpurityOperator), INTENT(INOUT) :: this 364 DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: matU 365 INTEGER :: iflavor1 366 INTEGER :: iflavor2 367 368 IF ( SIZE(matU) .NE. this%flavors*this%flavors ) & 369 CALL ERROR("ImpurityOperator_setUmat : Wrong interaction this") 370 371 DO iflavor1 = 1, this%flavors 372 DO iflavor2 = iflavor1+1, this%flavors 373 this%mat_U(iflavor1,iflavor2) = matU(iflavor1,iflavor2) 374 this%mat_U(iflavor2,iflavor1) = matU(iflavor2,iflavor1) 375 END DO 376 END DO 377 END SUBROUTINE ImpurityOperator_setUmat
ABINIT/m_ImpurityOperator/ImpurityOperator_swap [ Functions ]
NAME
ImpurityOperator_swap
FUNCTION
Swap to flavors
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
this=ImpurtiyOperator flavor1=to swap flavor2=to swap
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1462 SUBROUTINE ImpurityOperator_swap(this,flavor1, flavor2) 1463 1464 !Arguments ------------------------------------ 1465 TYPE(ImpurityOperator), INTENT(INOUT) :: this 1466 INTEGER , INTENT(IN ) :: flavor1 1467 INTEGER , INTENT(IN ) :: flavor2 1468 !Local variables ------------------------------ 1469 INTEGER :: iflavor 1470 DOUBLE PRECISION :: overlap_tmp 1471 1472 DO iflavor = 1, this%flavors 1473 IF ( iflavor .NE. flavor1 .AND. iflavor .NE. flavor2) THEN 1474 overlap_tmp = this%overlaps(iflavor,flavor1) 1475 this%overlaps(iflavor,flavor1) = this%overlaps(iflavor,flavor2) 1476 this%overlaps(flavor1,iflavor) = this%overlaps(iflavor,flavor2) 1477 this%overlaps(iflavor,flavor2) = overlap_tmp 1478 this%overlaps(flavor2,iflavor) = overlap_tmp 1479 END IF 1480 END DO 1481 1482 !CALL ListCdagC_print(this%particles(flavor1),233) 1483 !CALL ListCdagC_print(this%particles(flavor2),233) 1484 CALL ListCdagC_assign(this%list_swap, this%particles(flavor1)) !list_swap = particle 1485 this%particles(flavor1) = this%particles(flavor2) 1486 this%particles(flavor2) = this%list_swap 1487 !CALL ListCdagC_swap(this%particles(flavor1),this%particles(flavor2)) 1488 !CALL ListCdagC_print(this%particles(flavor1),233) 1489 !CALL ListCdagC_print(this%particles(flavor2),233) 1490 1491 END SUBROUTINE ImpurityOperator_swap
m_ImpurityOperator/ImpurityOperator [ Types ]
[ Top ] [ m_ImpurityOperator ] [ Types ]
NAME
ImpurityOperator
FUNCTION
This structured datatype contains the necessary data
COPYRIGHT
Copyright (C) 2013-2024 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
SOURCE
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 63 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) _PRIVATE :: overlaps ! total overlaps 64 ! for iflavor1 and iflavor2 overlaps(iflavor1,iflavor2) is the total 65 ! overlap between segments of iflavor1 and segments of iflavor2. 66 67 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(: ) _PRIVATE :: updates ! new_(anti)seg 68 ! For a given flavor (activeflavor), gives for each other flavors, the 69 ! supplementary overlaps, called updates(otherflavor). 70 71 TYPE(ListCdagC) _PRIVATE :: list_swap 72 TYPE(ListCdagC) , ALLOCATABLE, DIMENSION(: ) :: particles 73 ! for each flavor, particles(iflavor)%list(2,maxnbofsegment) 74 ! gives the beginning and end of each segment. 75 76 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: Magmommat_orb 77 ! for iflavor1 and iflavor2, Magmommat(iflavor1,iflavor2) is the 78 ! orbital magnetic moments 79 80 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: Magmommat_spin 81 ! for iflavor1 and iflavor2, Magmommat(iflavor1,iflavor2) is the 82 ! spin magnetic moments 83 84 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: Magmommat_tot 85 ! for iflavor1 and iflavor2, Magmommat(iflavor1,iflavor2) is the 86 ! total magnetic moments 87 88 DOUBLE PRECISION _PRIVATE :: checkNumber 89 DOUBLE PRECISION _PRIVATE :: tolerance 90 DOUBLE PRECISION _PRIVATE :: meanError 91 END TYPE ImpurityOperator