TABLE OF CONTENTS
- ABINIT/m_BathOperator
- ABINIT/m_BathOperator/ BathOperator_destroy
- ABINIT/m_BathOperator/BathOperator_activateParticle
- ABINIT/m_BathOperator/BathOperator_checkM
- ABINIT/m_BathOperator/BathOperator_doCheck
- ABINIT/m_BathOperator/BathOperator_getDetAdd
- ABINIT/m_BathOperator/BathOperator_getDetF
- ABINIT/m_BathOperator/BathOperator_getDetRemove
- ABINIT/m_BathOperator/BathOperator_getError
- ABINIT/m_BathOperator/BathOperator_hybrid
- ABINIT/m_BathOperator/BathOperator_init
- ABINIT/m_BathOperator/BathOperator_initF
- ABINIT/m_BathOperator/BathOperator_printF
- ABINIT/m_BathOperator/BathOperator_printM
- ABINIT/m_BathOperator/BathOperator_reset
- ABINIT/m_BathOperator/BathOperator_setF
- ABINIT/m_BathOperator/BathOperator_setMAdd
- ABINIT/m_BathOperator/BathOperator_setMRemove
- ABINIT/m_BathOperator/BathOperator_swap
- m_BathOperator/BathOperator
ABINIT/m_BathOperator [ Modules ]
NAME
m_BathOperator
FUNCTION
Manage all stuff related to the bath for the simgle Anderson Impurity Model
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
23 #include "defs.h" 24 MODULE m_BathOperator 25 USE m_MatrixHyb 26 USE m_Vector 27 USE m_VectorInt 28 USE m_Global 29 USE m_ListCdagC 30 31 IMPLICIT NONE
ABINIT/m_BathOperator/ BathOperator_destroy [ Functions ]
NAME
BathOperator_destroy
FUNCTION
Deallocate and reset every thing
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=bath operator
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1342 SUBROUTINE BathOperator_destroy(this) 1343 1344 TYPE(BathOperator), INTENT(INOUT) :: this 1345 INTEGER :: it 1346 1347 DO it = 1, this%flavors 1348 CALL MatrixHyb_destroy(this%M(it)) 1349 CALL MatrixHyb_destroy(this%M_update(it)) 1350 END DO 1351 1352 CALL Vector_destroy(this%R) 1353 CALL Vector_destroy(this%Q) 1354 CALL Vector_destroy(this%Rtau) 1355 CALL Vector_destroy(this%Qtau) 1356 FREEIF(this%F) 1357 DT_FREEIF(this%M) 1358 DT_FREEIF(this%M_update) 1359 1360 this%MAddFlag = .FALSE. 1361 this%MRemoveFlag = .FALSE. 1362 this%flavors = 0 1363 this%beta = 0.d0 1364 this%dt = 0.d0 1365 this%inv_dt = 0.d0 1366 this%samples = 0 1367 this%sizeHybrid = 0 1368 this%activeFlavor = 0 1369 this%updatePosRow = 0 1370 this%updatePosCol = 0 1371 1372 END SUBROUTINE BathOperator_destroy
ABINIT/m_BathOperator/BathOperator_activateParticle [ Functions ]
NAME
BathOperator_activateParticle
FUNCTION
Just save on wicht flavor we are working It is better to use the macro defined in defs.h
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=bath operator flavor=the flavor to activate
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
264 SUBROUTINE BathOperator_activateParticle(this,flavor) 265 266 !Arguments ------------------------------------ 267 TYPE(BathOperator), INTENT(INOUT) :: this 268 !Local variables ------------------------------ 269 INTEGER , INTENT(IN ) :: flavor 270 271 IF ( flavor .GT. this%flavors ) & 272 CALL ERROR("BathOperator_activateParticle : out of range ") 273 IF ( this%set .EQV. .TRUE. .AND. ALLOCATED(this%M) ) THEN 274 this%activeFlavor = flavor 275 this%MAddFlag = .FALSE. 276 this%MRemoveFlag = .FALSE. 277 ELSE 278 CALL ERROR("BathOperator_activateParticle : not allocated ") 279 END IF 280 END SUBROUTINE BathOperator_activateParticle
ABINIT/m_BathOperator/BathOperator_checkM [ Functions ]
NAME
BathOperator_checkM
FUNCTION
compute from scratch the M this and compar it with the already computed M 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=bath operator particle=list of all segments of the active flavor
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1437 SUBROUTINE BathOperator_checkM(this,particle) 1438 1439 !Arguments ------------------------------------ 1440 TYPE(BathOperator) , INTENT(INOUT) :: this 1441 TYPE(ListCdagC) , INTENT(IN ) :: particle 1442 !Local variables ------------------------------ 1443 ! TYPE(MatrixHyb) :: checkMatrix 1444 LOGICAL :: checkTau 1445 INTEGER :: tail 1446 INTEGER :: iC 1447 INTEGER :: iCdag 1448 INTEGER :: aF 1449 CHARACTER(LEN=4) :: a 1450 DOUBLE PRECISION :: time 1451 DOUBLE PRECISION :: beta 1452 DOUBLE PRECISION :: mbeta_two 1453 DOUBLE PRECISION :: erreur 1454 DOUBLE PRECISION :: tc 1455 DOUBLE PRECISION :: tCdag 1456 DOUBLE PRECISION :: sumMmat 1457 DOUBLE PRECISION :: sumCheck 1458 #include "BathOperator_hybrid.h" 1459 1460 aF = this%activeFlavor 1461 !Construction de la this 1462 tail = particle%tail 1463 ! CALL MatrixHyb_init(checkMatrix,this%iTech,size=tail,Wmax=this%samples) 1464 ! CALL MatrixHyb_setSize(checkMatrix,tail) 1465 CALL MatrixHyb_setSize(this%M_update(aF),tail) 1466 beta = this%beta 1467 mbeta_two = -beta*0.5d0 1468 this%checkNumber = this%checkNumber + 1 1469 IF ( tail .NE. this%M(aF)%tail ) THEN 1470 CALL WARN("BathOperator_checkM : tails are different ") 1471 RETURN 1472 END IF 1473 1474 !CALL ListCdagC_print(particle) 1475 DO iCdag = 1, tail 1476 tCdag = particle%list(iCdag,Cdag_) 1477 DO iC = 1, tail 1478 !tC = particle%list(C_,iC).MOD.beta 1479 MODCYCLE(particle%list(iC,C_),beta,tC) 1480 time = tC - tCdag 1481 #include "BathOperator_hybrid" 1482 this%M_update(aF)%mat(iC,iCdag) = hybrid 1483 1484 time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 1485 this%M_update(aF)%mat_tau(iCdag,iC) = INT ( (time*this%inv_dt) +1.5d0 ) 1486 END DO 1487 END DO 1488 1489 ! CALL MatrixHyb_Print(checkMatrix) 1490 !Inversion de la this 1491 CALL MatrixHyb_inverse(this%M_update(aF)) 1492 ! CALL MatrixHyb_Print(checkMatrix) 1493 1494 !Comparaison 1495 sumMmat =0.d0 1496 sumCheck=0.d0 1497 erreur = 0.d0 1498 checkTau = .FALSE. 1499 DO iCdag = 1, tail 1500 Do iC =1, tail 1501 this%M_update(aF)%mat(iC,iCdag) = ABS((this%M_update(aF)%mat(iC, iCdag) - this%M(aF)%mat(iC,iCdag))/this%M(aF)%mat(iC,iCdag)) 1502 IF ( this%M_update(aF)%mat(iC,iCdag) .GT. erreur ) erreur = this%M_update(aF)%mat(ic,iCdag) 1503 IF ( this%M_update(aF)%mat_tau(iC,iCdag) .NE. this%M(aF)%mat_tau(iC,iCdag) ) checkTau = .TRUE. 1504 END DO 1505 END DO 1506 1507 IF ( checkTau .EQV. .TRUE. ) THEN 1508 CALL WARN("BathOperator_checkM : mat_tau differs should be") 1509 CALL MatrixHyb_print(this%M_update(aF),opt_print=1) 1510 CALL WARN("BathOperator_checkM : whereas it is") 1511 CALL MatrixHyb_print(this%M(aF),opt_print=1) 1512 END IF 1513 this%meanError = this%meanError + erreur 1514 IF ( erreur .GT. 1.d0 ) THEN 1515 WRITE(a,'(I4)') INT(erreur*100.d0) 1516 ! CALL MatrixHyb_Print(this%M(aF) 1517 CALL WARN("BathOperator_checkM : "//a//"% ") 1518 END IF 1519 ! CALL MatrixHyb_destroy(checkMatrix) 1520 END SUBROUTINE BathOperator_checkM
ABINIT/m_BathOperator/BathOperator_doCheck [ Functions ]
NAME
BathOperator_doCheck
FUNCTION
Just store if we perfom check for updates of M
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=bath operator opt_check=second bit should be one
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1400 SUBROUTINE BathOperator_doCheck(this,opt_check) 1401 1402 !Arguments ------------------------------------ 1403 TYPE(BathOperator) , INTENT(INOUT) :: this 1404 INTEGER , INTENT(IN ) :: opt_check 1405 1406 IF ( opt_check .GE. 2 ) & 1407 this%doCheck = .TRUE. 1408 END SUBROUTINE BathOperator_doCheck
ABINIT/m_BathOperator/BathOperator_getDetAdd [ Functions ]
NAME
BathOperator_getDetAdd
FUNCTION
Compute the determinant ratio when a (anti)segment is trying to be added and store some array for setMadd
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=bath operator CdagC_1=segment to be added position=ordered position of the Cdag time particle=full list of CdagC for activeFlavor
OUTPUT
BathOperator_getDetAdd=the det
SIDE EFFECTS
NOTES
SOURCE
351 DOUBLE PRECISION FUNCTION BathOperator_getDetAdd(this,CdagC_1, position, particle) 352 353 !Arguments ------------------------------------ 354 TYPE(BathOperator) , INTENT(INOUT) :: this 355 DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN ) :: CdagC_1 356 INTEGER , INTENT(IN ) :: position 357 TYPE(ListCdagC), INTENT(IN ) :: particle 358 !Local variables------------------------------- 359 INTEGER :: it1 360 INTEGER :: it2 361 INTEGER :: it3 362 INTEGER :: tail 363 INTEGER :: new_tail 364 DOUBLE PRECISION :: C 365 DOUBLE PRECISION :: Cbeta 366 DOUBLE PRECISION :: Cibeta 367 DOUBLE PRECISION :: Cdag 368 DOUBLE PRECISION :: Cdagbeta 369 DOUBLE PRECISION :: beta 370 DOUBLE PRECISION :: ratio 371 DOUBLE PRECISION :: time 372 ! TYPE(CdagC) , POINTER, DIMENSION(:) :: list => NULL() 373 #include "BathOperator_hybrid.h" 374 375 this%antiShift = .FALSE. 376 beta = this%beta 377 C = CdagC_1(C_) 378 ! Cbeta = C.MOD.beta 379 MODCYCLE(C,beta,Cbeta) 380 Cdag = CdagC_1(Cdag_) 381 ! cdagbeta = Cdag.MOD.beta 382 MODCYCLE(Cdag,beta,CdagBeta) 383 ! IF ( Cdag .GE. beta ) & 384 ! CALL ERROR("BathOperator_getDetAdd : bad case ... ") 385 IF ( this%activeFlavor .LE. 0 ) & 386 CALL ERROR("BathOperator_getDetAdd : no active hybrid function ") 387 388 tail = particle%tail 389 new_tail = tail+1 390 ! list => particle%list 391 392 IF ( ((C .GT. Cdag) .AND. (position .EQ. -1)) & 393 .OR. ((C .LT. Cdag) .AND. (tail .EQ. 0))) THEN ! Possible only if it is a segment 394 this%updatePosRow = tail + 1 395 this%updatePosCol = tail + 1 396 ELSE 397 this%updatePosRow = ABS(position) 398 this%updatePosCol = ABS(position) 399 END IF 400 401 ! If antisegment, the det ratio has to be by -1 ( sign of the signature of one 402 ! permutation line in the this 403 IF ( C .LT. Cdag .AND. tail .GT. 0) THEN ! if antiseg 404 ! ratio = -ratio 405 this%updatePosRow = (this%updatePosRow + 1) !position in [1;tail] 406 IF ( CdagBeta .LT. particle%list(this%updatePosCol,Cdag_) ) this%antiShift = .TRUE. 407 END IF 408 409 ! CALL Vector_setSize(this%R,tail) 410 ! CALL Vector_setSize(this%Q,tail) 411 Vector_QuickResize(this%R,new_tail) 412 Vector_QuickResize(this%Q,new_tail) 413 Vector_QuickResize(this%Rtau,new_tail) 414 Vector_QuickResize(this%Qtau,new_tail) 415 416 DO it1 = 1, tail 417 it2 = it1 + ( 1+SIGN(1,it1-this%updatePosRow) )/2 418 it3 = it1 + ( 1+SIGN(1,it1-this%updatePoscol) )/2 419 420 this%Rtau%vec(it2)= C - particle%list(it1,Cdag_) 421 !this%Rtau%vec(it1)= C - particle%list(it1,Cdag_) 422 time = Cbeta - particle%list(it1,Cdag_) 423 #include "BathOperator_hybrid" 424 this%R%vec(it1) = hybrid 425 ! this%R%vec(it) = BathOperator_hybrid(this, Cbeta - list(it)%Cdag) 426 ! Cibeta = list(it)%C.MOD.beta 427 MODCYCLE(particle%list(it1,C_),beta,Cibeta) 428 time = Cibeta - Cdagbeta 429 this%Qtau%vec(it3)= time 430 !this%Qtau%vec(it1)= time 431 #include "BathOperator_hybrid" 432 this%Q%vec(it1) = hybrid 433 !this%Q%vec(it3) = hybrid 434 ! Q(it) = BathOperator_hybrid(this, Cibeta - Cdagbeta) 435 END DO 436 ! Compute S 437 this%Stau = C - Cdagbeta 438 this%Rtau%vec(this%updatePosRow) = this%Stau 439 this%Qtau%vec(this%updatePosCol) = this%Rtau%vec(this%updatePosRow) 440 441 time = Cbeta-Cdagbeta 442 #include "BathOperator_hybrid" 443 this%S = hybrid 444 445 !ratio = this%S - DOT_PRODUCT(MATMUL(this%R%vec(1:tail),this%M(this%activeFlavor)%mat(1:tail,1:tail)),this%Q%vec(1:tail)) 446 ratio = 0.d0 447 DO it1 = 1, tail 448 time = 0.d0 449 DO it2 = 1, tail 450 time = time + this%R%vec(it2) * this%M(this%activeFlavor)%mat(it2,it1) 451 END DO 452 ratio = ratio + this%Q%vec(it1) * time 453 END DO 454 ratio = this%S - ratio 455 456 this%Stilde = 1.d0 / ratio 457 458 ! This IF is the LAST "NON CORRECTION" in my opinion this should not appears. 459 ! IF ( MAX(C,Cdag) .GT. this%beta ) THEN 460 ! WRITE(*,*) this%Stilde 461 ! this%Stilde = - ABS(this%Stilde) 462 ! END IF 463 464 ! If antisegment, the det ratio has to be by -1 ( sign of the signature of one 465 ! permutation line in the this) 466 IF ( C .LT. Cdag .AND. tail .GT. 0) THEN ! if antiseg 467 ratio = -ratio 468 ENDIF 469 470 BathOperator_getDetAdd = ratio 471 this%MAddFlag = .TRUE. 472 !#ifdef CTQMC_CHECK 473 ! this%ListCdagC = particle 474 !!write(*,*) this%Stilde 475 !!write(*,*) this%antishift 476 !!write(*,*) this%updatePosRow 477 !!write(*,*) this%updatePosCol 478 !#endif 479 480 END FUNCTION BathOperator_getDetAdd
ABINIT/m_BathOperator/BathOperator_getDetF [ Functions ]
NAME
BathOperator_getDetF
FUNCTION
Compute the determinant of the F this using the hybridization of flavor and the segments of particle
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=bath operator flavor=hybridization function to take particles=segments to use
OUTPUT
BathOperator_getDetF=the det
SIDE EFFECTS
NOTES
SOURCE
585 DOUBLE PRECISION FUNCTION BathOperator_getDetF(this,flavor,particle) 586 587 !Arguments ------------------------------------ 588 TYPE(BathOperator) , INTENT(INOUT) :: this 589 INTEGER , INTENT(IN ) :: flavor 590 TYPE(ListCdagC), OPTIONAL, INTENT(IN ) :: particle 591 !Local arguments------------------------------- 592 INTEGER :: iCdag 593 INTEGER :: iC 594 INTEGER :: tail 595 DOUBLE PRECISION :: time 596 DOUBLE PRECISION :: tC 597 DOUBLE PRECISION :: tCdag 598 DOUBLE PRECISION :: beta 599 DOUBLE PRECISION :: mbeta_two 600 DOUBLE PRECISION :: signe 601 DOUBLE PRECISION :: inv_dt 602 #include "BathOperator_hybrid.h" 603 604 BathOperator_getDetF = 1.d0 ! pour eviter des divisions par 0 605 IF ( PRESENT( particle ) ) THEN 606 tail = particle%tail 607 activeF = flavor 608 beta = this%beta 609 mbeta_two = -beta*0.5d0 610 inv_dt = this%inv_dt 611 CALL MatrixHyb_setSize(this%M_update(flavor),tail) 612 DO iCdag = 1, tail 613 tCdag = particle%list(iCdag,Cdag_) 614 DO iC = 1, tail 615 !tC = particle%list(C_,iC).MOD.beta 616 MODCYCLE(particle%list(iC,C_),beta,tC) 617 time = tC - tCdag 618 #include "BathOperator_hybrid" 619 this%M_update(flavor)%mat(iC,iCdag) = hybrid 620 END DO 621 END DO 622 ! mat_tau needs to be transpose of ordered time mat (way of measuring 623 ! G(tau)) 624 DO iC = 1, tail 625 tC = particle%list(iC,C_) 626 DO iCdag = 1, tail 627 tCdag = particle%list(iCdag,Cdag_) 628 time = tC - tCdag 629 signe = SIGN(1.d0,time) 630 time = time + (signe-1.d0)*mbeta_two 631 this%M_update(flavor)%mat_tau(iCdag,iC) = INT( ( time * inv_dt ) + 1.5d0 ) 632 END DO 633 END DO 634 CALL MatrixHyb_inverse(this%M_update(flavor),BathOperator_getDetF) ! calcul le det de la matrice et l'inverse 635 ELSE 636 CALL MatrixHyb_getDet(this%M(flavor),BathOperator_getDetF) ! det M = 1/detF ! 637 BathOperator_getDetF = 1.d0 / BathOperator_getDetF 638 ENDIF 639 END FUNCTION BathOperator_getDetF
ABINIT/m_BathOperator/BathOperator_getDetRemove [ Functions ]
NAME
BathOperator_getDetRemove
FUNCTION
Compute the determinant ratio when a (anti)segment is trying to be removed
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=bath operator position=position of segment to be removed
OUTPUT
BathOperator_getDetRemove=the det
SIDE EFFECTS
NOTES
SOURCE
510 DOUBLE PRECISION FUNCTION BathOperator_getDetRemove(this,position) 511 512 !Arguments ------------------------------------ 513 TYPE(BathOperator), INTENT(INOUT) :: this 514 !Local arguments------------------------------- 515 INTEGER , INTENT(IN ) :: position 516 INTEGER :: ABSposition 517 INTEGER :: tail 518 519 IF ( this%activeFlavor .LE. 0 ) & 520 CALL ERROR("BathOperator_getDetRemove : no active hybrid fun ") 521 522 this%antiShift = .FALSE. 523 tail = this%M(this%activeFlavor)%tail 524 ABSposition = ABS(position) 525 IF ( ABSposition .GT. tail ) & 526 CALL ERROR("BathOperator_getDetRemove : position > M size ") 527 this%updatePosCol = ABSposition 528 this%antiShift = .FALSE. 529 IF ( position .GT. 0 ) THEN 530 this%updatePosRow = ABSposition 531 ELSE 532 this%updatePosRow = ABSposition+1 533 IF ( ABSposition .EQ. tail ) THEN 534 this%antiShift = .TRUE. 535 this%updatePosRow = 1 !ABSposition - 1 536 ! this%updatePosRow = ABSposition 537 ! IF ( this%updatePosCol .EQ. 0) this%updatePosCol = tail 538 END IF 539 ENDIF 540 this%Stilde = this%M(this%activeflavor)%mat(this%updatePosRow,this%updatePosCol) 541 this%MRemoveFlag = .TRUE. 542 BathOperator_getDetRemove = this%Stilde 543 544 ! If remove an antiseg , the det ratio has to be multiplied by -1 545 IF ( position .LT. 0 .AND. tail .GT. 1 ) & 546 BathOperator_getDetRemove = - BathOperator_getDetRemove 547 !#ifdef CTQMC_CHECK 548 ! this%ListCdagC = particle 549 !!write(*,*) this%updatePosRow, this%updatePosCol, position 550 !!CALL ListCdagC_print(particle) 551 !#endif 552 553 END FUNCTION BathOperator_getDetRemove
ABINIT/m_BathOperator/BathOperator_getError [ Functions ]
NAME
BathOperator_getError
FUNCTION
compute a percentage error / checkM
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=bath operator
OUTPUT
BathOperator_getError=Error in percent
SIDE EFFECTS
NOTES
SOURCE
1548 DOUBLE PRECISION FUNCTION BathOperator_getError(this) 1549 1550 TYPE(BathOperator), INTENT(IN) :: this 1551 1552 IF ( this%doCheck .EQV. .TRUE. ) THEN 1553 BathOperator_getError = this%meanError / DBLE(this%checkNumber) 1554 ELSE 1555 BathOperator_getError = 0.d0 1556 END IF 1557 END FUNCTION BathOperator_getError
ABINIT/m_BathOperator/BathOperator_hybrid [ Functions ]
NAME
BathOperator_hybrid
FUNCTION
Compute the hybridization for the active flavor at time time
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=bath operator time=time F(time)
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
309 DOUBLE PRECISION FUNCTION BathOperator_hybrid(this,time) 310 311 TYPE(BathOperator), INTENT(IN) :: this 312 DOUBLE PRECISION , INTENT(IN) :: time 313 #include "BathOperator_hybrid.h" 314 315 IF ( this%activeFlavor .LE. 0 ) & 316 CALL ERROR("BathOperator_hybrid : no active hybrid func ") 317 #include "BathOperator_hybrid" 318 BathOperator_hybrid = hybrid 319 320 END FUNCTION BathOperator_hybrid
ABINIT/m_BathOperator/BathOperator_init [ Functions ]
NAME
BathOperator_init
FUNCTION
Initialize and allocate 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 .
INPUTS
this=bath object flavors=numbers of flavors we have (including spin) samples=Time slices in the input file beta=inverse temperature iTech=imaginary time or frequencies It is imposes to imaginary time
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
134 SUBROUTINE BathOperator_init(this, flavors, samples, beta, iTech) 135 136 !Arguments ------------------------------------ 137 TYPE(BathOperator), INTENT(INOUT) :: this 138 INTEGER , INTENT(IN ) :: flavors 139 INTEGER , INTENT(IN ) :: samples 140 DOUBLE PRECISION , INTENT(IN ) :: beta 141 !Local variables ------------------------------ 142 INTEGER , INTENT(IN ) :: iTech 143 INTEGER :: it 144 145 this%MAddFlag = .FALSE. 146 this%MRemoveFlag = .FALSE. 147 this%flavors = flavors 148 this%beta = beta 149 this%samples = samples 150 this%sizeHybrid = samples + 1 151 this%dt = beta / DBLE(samples) 152 this%inv_dt = DBLE(samples) / beta 153 this%activeFlavor= 0 154 this%updatePosRow = 0 155 this%updatePosCol = 0 156 this%iTech = iTech 157 !#ifdef CTQMC_CHECK 158 this%checkNumber = 0 159 this%meanError = 0.d0 160 this%doCheck = .FALSE. 161 !#endif 162 163 FREEIF(this%F) 164 MALLOC(this%F,(1:this%sizeHybrid+1,1:flavors)) 165 DT_FREEIF(this%M) 166 DT_MALLOC(this%M,(1:flavors)) 167 DT_FREEIF(this%M_update) 168 DT_MALLOC(this%M_update,(1:flavors)) 169 170 CALL Vector_init(this%R,100) 171 CALL Vector_init(this%Q,100) 172 CALL Vector_init(this%Rtau,100) 173 CALL Vector_init(this%Qtau,100) 174 175 DO it = 1, flavors 176 CALL MatrixHyb_init(this%M(it),this%iTech,size=Global_SIZE,Wmax=samples) !FIXME Should be consistent with ListCagC 177 CALL MatrixHyb_init(this%M_update(it),this%iTech,size=Global_SIZE,Wmax=samples) !FIXME Should be consistent with ListCagC 178 END DO 179 this%F = 0.d0 180 this%set = .TRUE. 181 182 END SUBROUTINE BathOperator_init
ABINIT/m_BathOperator/BathOperator_initF [ Functions ]
NAME
BathOperator_initF
FUNCTION
Copy input hybridization functions from a file
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=bath operator ifstream=file stream to read F
OUTPUT
argout(sizeout)=description
SIDE EFFECTS
NOTES
SOURCE
1149 SUBROUTINE BathOperator_initF(this,ifstream) 1150 1151 !Arguments ---------------------- 1152 TYPE(BathOperator), INTENT(INOUT) :: this 1153 INTEGER , INTENT(IN ) :: ifstream 1154 !Local variables ---------------- 1155 INTEGER :: flavor 1156 INTEGER :: sample 1157 1158 IF ( this%set .EQV. .FALSE. ) & 1159 CALL ERROR("BathOperator_initF : BathOperator not set ") 1160 1161 DO flavor=1,this%flavors 1162 DO sample = 1, this%sizeHybrid 1163 READ(ifstream,*) this%F(sample,flavor) 1164 END DO 1165 END DO 1166 END SUBROUTINE BathOperator_initF
ABINIT/m_BathOperator/BathOperator_printF [ Functions ]
NAME
BathOperator_printF
FUNCTION
print F function
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=bath operator ostream=file stream to write in
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1244 SUBROUTINE BathOperator_printF(this,ostream) 1245 1246 !Arguments ------------------------------------ 1247 TYPE(BathOperator), INTENT(INOUT) :: this 1248 INTEGER,OPTIONAL , INTENT(IN ) :: ostream 1249 !Local variables ------------------------------ 1250 CHARACTER(LEN=4) :: aflavor 1251 CHARACTER(LEN=50) :: string 1252 INTEGER :: flavor 1253 INTEGER :: sample 1254 INTEGER :: ostream_val 1255 1256 IF ( PRESENT(ostream) ) THEN 1257 ostream_val = ostream 1258 ELSE 1259 ostream_val = 65 1260 OPEN(UNIT=ostream_val, FILE="F.dat") 1261 END IF 1262 1263 WRITE(aflavor,'(I4)') this%flavors+1 1264 string = '(1x,'//TRIM(ADJUSTL(aflavor))//'E22.14)' 1265 DO sample = 1, this%sizeHybrid 1266 WRITE(ostream_val,string) (sample-1)*this%dt, (this%F(sample,flavor), flavor=1,this%flavors) 1267 END DO 1268 !CALL FLUSH(ostream_val) 1269 1270 IF ( .NOT. PRESENT(ostream) ) & 1271 CLOSE(ostream_val) 1272 1273 END SUBROUTINE BathOperator_printF
ABINIT/m_BathOperator/BathOperator_printM [ Functions ]
NAME
BathOperator_printM
FUNCTION
print M =F^{-1} 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=bath operator ostream=file stream to write in
OUTPUT
argout(sizeout)=description
SIDE EFFECTS
NOTES
SOURCE
1302 SUBROUTINE BathOperator_printM(this,ostream) 1303 1304 !Arguments ------------------------------------ 1305 TYPE(BathOperator), INTENT(IN) :: this 1306 INTEGER, OPTIONAL , INTENT(IN) :: ostream 1307 !Local variables ------------------------------ 1308 INTEGER :: ostream_val 1309 1310 IF ( this%activeFlavor .LE. 0 ) & 1311 CALL ERROR("BathOperator_printM : no active hybrid function ") 1312 ostream_val = 6 1313 IF ( PRESENT(ostream) ) ostream_val = ostream 1314 CALL MatrixHyb_print(this%M(this%activeFlavor),ostream_val) 1315 END SUBROUTINE BathOperator_printM
ABINIT/m_BathOperator/BathOperator_reset [ Functions ]
NAME
BathOperator_reset
FUNCTION
Reset all internal variables
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=bath operator to reset
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
209 SUBROUTINE BathOperator_reset(this) 210 211 !Arguments ------------------------------------ 212 TYPE(BathOperator), INTENT(INOUT) :: this 213 !Local variables ------------------------------ 214 INTEGER :: it 215 this%MAddFlag = .FALSE. 216 this%MRemoveFlag = .FALSE. 217 this%activeFlavor = 0 218 this%updatePosRow = 0 219 this%updatePosCol = 0 220 !#ifdef CTQMC_CHECK 221 this%checkNumber = 0 222 this%meanError = 0.d0 223 !#endif 224 this%doCheck = .FALSE. 225 CALL Vector_clear(this%R) 226 CALL Vector_clear(this%Q) 227 CALL Vector_clear(this%Rtau) 228 CALL Vector_clear(this%Qtau) 229 230 DO it = 1, this%flavors 231 CALL MatrixHyb_clear(this%M(it)) !FIXME Should be consistent with ListCagC 232 END DO 233 this%F = 0.d0 234 235 END SUBROUTINE BathOperator_reset
ABINIT/m_BathOperator/BathOperator_setF [ Functions ]
NAME
BathOperator_setF
FUNCTION
Copy F from input array
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=bath operator F=array of the hybridization function
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1194 SUBROUTINE BathOperator_setF(this,F) 1195 1196 !Arguments ------------------------------------ 1197 TYPE(BathOperator) , INTENT(INOUT) :: this 1198 DOUBLE PRECISION, DIMENSION(:,:) , INTENT(IN ) :: F 1199 !Arguments ------------------------------------ 1200 INTEGER :: flavor 1201 INTEGER :: sample 1202 INTEGER :: length 1203 1204 IF ( this%set .EQV. .FALSE. ) & 1205 CALL ERROR("BathOperator_setF : BathOperator not set ") 1206 1207 length = SIZE(F) 1208 IF ( length .NE. (this%flavors * this%sizeHybrid) ) & 1209 CALL ERROR("BathOperator_setF : wrong input F ") 1210 1211 DO flavor=1,this%flavors 1212 DO sample = 1, this%sizeHybrid 1213 this%F(sample,flavor) = F(sample,flavor) 1214 END DO 1215 END DO 1216 END SUBROUTINE BathOperator_setF
ABINIT/m_BathOperator/BathOperator_setMAdd [ Functions ]
NAME
BathOperator_setMAdd
FUNCTION
Update de M this inserting a row and a column
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=bath operator particle=segments of active flavor
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
667 SUBROUTINE BathOperator_setMAdd(this,particle) 668 669 !Arguments ------------------------------------ 670 TYPE(BathOperator), INTENT(INOUT) :: this 671 TYPE(ListCdagC) , INTENT(IN ) :: particle 672 !Local variables ------------------------------ 673 INTEGER :: tail 674 INTEGER :: new_tail 675 INTEGER :: col 676 INTEGER :: col_move 677 INTEGER :: row_move 678 INTEGER :: row 679 INTEGER :: positionRow 680 INTEGER :: positionCol 681 INTEGER :: aF 682 DOUBLE PRECISION :: Stilde 683 DOUBLE PRECISION :: time 684 DOUBLE PRECISION :: mbeta_two 685 DOUBLE PRECISION :: inv_dt 686 TYPE(Vector) :: vec_tmp 687 TYPE(VectorInt) :: vecI_tmp 688 INTEGER :: m 689 INTEGER :: count 690 INTEGER :: i 691 INTEGER :: j 692 INTEGER :: p 693 694 IF ( this%MAddFlag .EQV. .FALSE. ) & 695 CALL ERROR("BathOperator_setMAdd : MAddFlag turn off ") 696 af = this%activeFlavor 697 IF ( aF .LE. 0 ) & 698 CALL ERROR("BathOperator_setMAdd : no active hybrid function ") 699 tail = this%M(aF)%tail 700 new_tail = tail + 1 701 !CALL this_print(M) 702 703 positionRow = this%updatePosRow 704 positionCol = this%updatePosCol 705 Stilde = this%Stilde 706 ! write(6,*) "before", positionRow, positionCol 707 !CALL MatrixHyb_print(this%M(aF),opt_print=1) 708 CALL MatrixHyb_setSize(this%M(aF),new_tail) 709 710 ! Compute Qtilde with Q 711 !this%Q%vec(1:tail) = (-1.d0) * MATMUL(this%M(aF)%mat(1:tail,1:tail),this%Q%vec(1:tail)) * Stilde 712 this%Q%vec(1:tail) = MATMUL(this%M(aF)%mat(1:tail,1:tail),this%Q%vec(1:tail)) 713 !this%Q%vec(PositionRow:new_tail) = EOSHIFT(this%Q%vec(PositionRow:new_tail), SHIFT=-1, BOUNDARY=-1.d0, DIM=1) 714 ! this%Qtau%vec(PositionCol:new_tail) = EOSHIFT(this%Qtau%vec(PositionCol:new_tail), SHIFT=-1, BOUNDARY=1.d0, DIM=1) 715 ! this%Qtau%vec(PositionCol) = this%Stau 716 717 !Compute Rtilde with R and without multiplying by Stilde 718 !this%R%vec(1:tail) = (-1.d0) * MATMUL(this%R%vec(1:tail),this%M(aF)%mat(1:tail,1:tail)) 719 this%R%vec(1:tail) = MATMUL(this%R%vec(1:tail),this%M(aF)%mat(1:tail,1:tail)) 720 !this%R%vec(PositionCol:new_tail) = EOSHIFT(this%R%vec(PositionCol:new_tail), SHIFT=-1, BOUNDARY=-1.d0, DIM=1) 721 ! this%Rtau%vec(PositionRow:new_tail) = EOSHIFT(this%Rtau%vec(PositionRow:new_tail), SHIFT=-1, BOUNDARY=1.d0, DIM=1) 722 ! this%Rtau%vec(PositionRow) = this%Stau 723 724 !Compute the new M this 725 !this%M(aF)%mat(PositionRow:new_tail,1:new_tail) = & 726 ! EOSHIFT(this%M(aF)%mat(PositionRow:new_tail,1:new_tail),SHIFT=-1, BOUNDARY=0.d0, DIM=1) 727 !this%M(aF)%mat(1:new_tail,PositionCol:new_tail) = & 728 ! EOSHIFT(this%M(aF)%mat(1:new_tail,PositionCol:new_tail),SHIFT=-1, BOUNDARY=0.d0, DIM=2) 729 ! ! this%M(aF)%mat(1:new_tail,1:new_tail) = this%M(aF)%mat(1:new_tail,1:new_tail) + & 730 ! ! Stilde * MATMUL(RESHAPE(this%Q%vec(1:new_tail),(/ new_tail,1 /)),RESHAPE(this%R%vec(1:new_tail),(/ 1,new_tail /))) 731 732 !this%M(aF)%mat_tau(PositionRow:new_tail,1:new_tail) = & 733 ! EOSHIFT(this%M(aF)%mat_tau(PositionRow:new_tail,1:new_tail),SHIFT=-1, BOUNDARY=0, DIM=1) 734 !this%M(aF)%mat_tau(1:new_tail,PositionCol:new_tail) = & 735 ! EOSHIFT(this%M(aF)%mat_tau(1:new_tail,PositionCol:new_tail),SHIFT=-1, BOUNDARY=0, DIM=2) 736 737 mbeta_two = -this%beta*0.5d0 738 inv_dt = this%inv_dt 739 !Shift mat_tau 740 !update old m 741 DO col=tail,1,-1 742 col_move = col + ( 1+SIGN(1,col-PositionCol) )/2 743 DO row=tail,1,-1 744 row_move = row + ( 1+SIGN(1,row-PositionRow) )/2 745 this%M(aF)%mat_tau(row_move,col_move) = this%M(aF)%mat_tau(row,col) 746 this%M(aF)%mat(row_move,col_move) = this%M(aF)%mat(row,col) + this%Q%vec(row)*this%R%vec(col) * Stilde 747 END DO 748 END DO 749 ! Add new stuff for new row 750 DO row = 1, tail 751 row_move = row + ( 1+SIGN(1,row-PositionRow) )/2 752 this%M(aF)%mat(row_move,PositionCol) = -this%Q%vec(row)*Stilde 753 time = this%Rtau%vec(row) 754 time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 755 this%M(aF)%mat_tau(row,PositionCol) = INT ( (time*inv_dt) +1.5d0 ) 756 END DO 757 ! Add last time missing in the loops 758 time = this%Rtau%vec(new_tail) 759 time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 760 this%M(aF)%mat_tau(new_tail,PositionCol) = INT ( (time*inv_dt) +1.5d0 ) 761 ! Add new stuff for new col 762 DO col = 1, tail 763 col_move = col + ( 1+SIGN(1,col-PositionCol) )/2 764 this%M(aF)%mat(PositionRow,col_move) = -this%R%vec(col)*Stilde 765 time = this%Qtau%vec(col) 766 time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 767 this%M(aF)%mat_tau(PositionRow,col) = INT ( (time*inv_dt) +1.5d0 ) 768 END DO 769 ! Add last time missing in the loops 770 time = this%Qtau%vec(new_tail) 771 time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 772 this%M(aF)%mat_tau(PositionRow,new_tail) = INT ( (time*inv_dt) +1.5d0 ) 773 774 this%M(aF)%mat(PositionRow,PositionCol) = Stilde 775 776 !CALL MatrixHyb_print(this%M(aF),opt_print=1) 777 778 ! DO col = 1, new_tail 779 ! time = this%Rtau%vec(col) 780 ! time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 781 ! this%M(aF)%mat_tau(col,PositionCol) = INT ( (time*inv_dt) +1.5d0 ) 782 ! time = this%Qtau%vec(col) 783 ! time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 784 ! this%M(aF)%mat_tau(PositionRow,Col) = INT ( (time*inv_dt) +1.5d0 ) 785 ! time = this%R%vec(col)*Stilde 786 ! DO row = 1, new_tail 787 ! this%M(aF)%mat(row,col) = this%M(aF)%mat(row,col) + this%Q%vec(row)*time 788 ! END DO 789 ! END DO 790 791 !col_move = new_tail 792 !col = tail 793 !DO col_move = new_tail, 1, -1 794 ! IF ( col_move .EQ. positionCol ) THEN 795 ! ! on calcule rajoute Q tilde 796 ! !row_move = new_tail 797 ! row = tail 798 ! DO row_move = new_tail, 1, -1 799 ! ! calcul itau 800 ! IF ( row_move .EQ. positionRow ) THEN 801 ! this%M(aF)%mat(row_move,col_move) = Stilde 802 ! !time = this%Stau 803 ! ELSE 804 ! this%M(aF)%mat(row_move,col_move) = -this%Q%vec(row)*Stilde 805 ! !time = this%Rtau%vec(row_move) 806 ! row = row - 1 807 ! END IF 808 ! !time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 809 ! !this%M(aF)%mat_tau(row_move,col_move) = INT ( (time*inv_dt) +1.5d0 ) 810 ! END DO 811 ! ! realignement des indices 812 ! ELSE 813 ! ! on calcule Ptilde 814 ! !row_move = new_tail 815 ! row = tail 816 ! DO row_move = new_tail, 1, -1 817 ! IF ( row_move .EQ. positionRow ) THEN 818 ! this%M(aF)%mat(row_move,col_move) = -this%R%vec(col) * Stilde 819 ! ! calcul itau 820 ! !time = this%Qtau%vec(col_move) 821 ! !time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two 822 ! !this%M(aF)%mat_tau(row_move,col_move) = INT ( (time*inv_dt) +1.5d0 ) 823 ! ELSE 824 ! this%M(aF)%mat(row_move,col_move) = this%M(aF)%mat(row,col) + this%Q%vec(row)*this%R%vec(col)*Stilde 825 ! ! copy itau 826 ! !this%M(aF)%mat_tau(row_move,col_move) = this%M(aF)%mat_tau(row,col) 827 ! row = row - 1 828 ! END IF 829 ! END DO 830 ! col = col - 1 831 ! END IF 832 !END DO 833 ! write(6,*) "after" 834 ! CALL MatrixHyb_print(this%M(aF),opt_print=1) 835 !CALL this_inverse(M) 836 !CALL MatrixHyb_print(M) 837 !CALL this_inverse(M) 838 839 IF ( this%antiShift .EQV. .TRUE. ) THEN ! antisegment 840 CALL Vector_init(vec_tmp,new_tail) 841 CALL VectorInt_init(vecI_tmp,new_tail) 842 ! Shift if necessary according to this%antishift 843 ! shift DIM=2 (col) 844 p = new_tail - 1 845 m = 1 846 count = 0 847 DO WHILE ( count .NE. new_tail ) 848 vec_tmp%vec(1:new_tail) = this%M(aF)%mat(1:new_tail,m) 849 vecI_tmp%vec(1:new_tail) = this%M(aF)%mat_tau(1:new_tail,m) 850 i = m 851 !j = m+p 852 MODCYCLE(m+p, new_tail, j) 853 DO WHILE (j .NE. m) 854 this%M(aF)%mat(1:new_tail,i) = this%M(aF)%mat(1:new_tail,j) 855 this%M(aF)%mat_tau(1:new_tail,i) = this%M(aF)%mat_tau(1:new_tail,j) 856 i = j 857 MODCYCLE(j+p, new_tail, j) 858 count = count+1 859 END DO 860 this%M(aF)%mat(1:new_tail,i) = vec_tmp%vec(1:new_tail) 861 this%M(aF)%mat_tau(1:new_tail,i) = vecI_tmp%vec(1:new_tail) 862 count = count+1 863 m = m+1 864 END DO 865 ! shift DIM=1 (row) 866 p = new_tail - 1 867 m = 1 868 count = 0 869 DO WHILE ( count .NE. new_tail) 870 vec_tmp%vec(1:new_tail) = this%M(aF)%mat(m,1:new_tail) 871 vecI_tmp%vec(1:new_tail) = this%M(aF)%mat_tau(m,1:new_tail) 872 i = m 873 !j = m+p 874 MODCYCLE(m+p, new_tail, j) 875 DO WHILE ( j .NE. m ) 876 this%M(aF)%mat(i,1:new_tail) = this%M(aF)%mat(j,1:new_tail) 877 this%M(aF)%mat_tau(i,1:new_tail) = this%M(aF)%mat_tau(j,1:new_tail) 878 i = j 879 MODCYCLE(j+p, new_tail, j) 880 count = count+1 881 END DO 882 this%M(aF)%mat(i,1:new_tail) = vec_tmp%vec(1:new_tail) 883 this%M(aF)%mat_tau(i,1:new_tail) = vecI_tmp%vec(1:new_tail) 884 count = count+1 885 m = m+1 886 END DO 887 CALL Vector_destroy(vec_tmp) 888 CALL VectorInt_destroy(vecI_tmp) 889 !this%M(aF)%mat(1:new_tail,1:new_tail) = CSHIFT(this%M(aF)%mat(1:new_tail,1:new_tail), SHIFT=-1, DIM=1) ! Shift to the bottom 890 !this%M(aF)%mat(1:new_tail,1:new_tail) = CSHIFT(this%M(aF)%mat(1:new_tail,1:new_tail), SHIFT=-1, DIM=2) ! Shift to the right 891 !this%M(aF)%mat_tau(1:new_tail,1:new_tail) = CSHIFT(this%M(aF)%mat_tau(1:new_tail,1:new_tail), SHIFT=-1, DIM=1) ! Shift to the bottom 892 !this%M(aF)%mat_tau(1:new_tail,1:new_tail) = CSHIFT(this%M(aF)%mat_tau(1:new_tail,1:new_tail), SHIFT=-1, DIM=2) ! Shift to the right 893 !CALL this_print(M) 894 END IF 895 896 IF ( this%doCheck .EQV. .TRUE.) THEN 897 !#ifdef CTQMC_CHECK 898 CALL BathOperator_checkM(this,particle) 899 !#endif 900 END IF 901 902 this%MAddFlag = .FALSE. 903 904 END SUBROUTINE BathOperator_setMAdd
ABINIT/m_BathOperator/BathOperator_setMRemove [ Functions ]
NAME
BathOperator_setMRemove
FUNCTION
delete one row and one column of the M 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=bath operator particle=segments of the active flavor
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
932 SUBROUTINE BathOperator_setMRemove(this,particle) 933 934 !Arguments ------------------------------------ 935 TYPE(BathOperator), INTENT(INOUT) :: this 936 TYPE(ListCdagC) , INTENT(IN ) :: particle 937 !Local variables ------------------------------ 938 INTEGER :: tail 939 INTEGER :: new_tail 940 INTEGER :: col 941 INTEGER :: col_move 942 INTEGER :: row_move 943 INTEGER :: row 944 INTEGER :: positionCol 945 INTEGER :: positionRow 946 INTEGER :: aF 947 INTEGER :: m 948 INTEGER :: count 949 INTEGER :: i 950 INTEGER :: j 951 INTEGER :: p 952 DOUBLE PRECISION :: invStilde 953 DOUBLE PRECISION :: invStilde2 954 TYPE(VectorInt) :: vecI_tmp 955 TYPE(Vector) :: vec_tmp 956 957 IF ( this%MRemoveFlag .EQV. .FALSE. ) & 958 CALL ERROR("BathOperator_setMRemove : MRemoveFlag turn off ") 959 af = this%activeFlavor 960 IF ( aF .LE. 0 ) & 961 CALL ERROR("BathOperator_setMRemove : no active hybrid func ") 962 tail = this%M(aF)%tail 963 new_tail = tail - 1 964 positionCol = this%updatePosCol 965 positionRow = this%updatePosRow 966 invStilde = 1.d0 / this%Stilde 967 968 ! write(6,*) "before", positionRow, positionCol 969 ! CALL MatrixHyb_print(this%M(aF),opt_print=1) 970 971 ! IF ( new_tail .EQ. 0 ) THEN 972 !! IF ( this%antiShift .EQV. .TRUE. ) THEN 973 !! this%M(aF)%mat(1,1) = 1.d0/BathOperator_Hybrid(this, this%beta) 974 !! this%MRemoveFlag = .FALSE. 975 !! RETURN 976 !! END IF 977 ! CALL MatrixHyb_clear(this%M(aF)) 978 ! this%MRemoveFlag = .FALSE. 979 ! RETURN 980 ! END IF 981 982 ! CALL Vector_setSize(this%Q,new_tail) 983 ! CALL Vector_setSize(this%R,new_tail) 984 Vector_QuickResize(this%Q,new_tail) 985 Vector_QuickResize(this%R,new_tail) 986 987 ! We use R and Q as this%R%vec and this%Q%vec 988 ! this%R%vec => this%R 989 ! this%Q%vec => this%Q 990 991 !row = 1 992 !row_move = 1 993 !col = 1 994 !col_move = 1 995 DO row_move = 1, new_tail 996 !IF ( row .EQ. positionRow ) row = row + 1 997 !IF ( col .EQ. positionCol ) col = col + 1 998 col = row_move + (1+SIGN(1,row_move-positionCol))/2 999 row = row_move + (1+SIGN(1,row_move-positionRow))/2 1000 this%R%vec(row_move) = this%M(aF)%mat(positionRow,col) 1001 this%Q%vec(row_move) = this%M(aF)%mat(row,positionCol) 1002 !row = row + 1 1003 !col = col + 1 1004 END DO 1005 !! this%R%vec(1:positionCol-1) = this%M(aF)%mat(positionRow,1:positionCol-1) 1006 !! this%R%vec(positionCol:new_tail) = this%M(aF)%mat(positionRow,positionCol+1:tail) 1007 !! this%Q%vec(1:positionRow-1) = this%M(aF)%mat(1:positionRow-1,positionCol) 1008 !! this%Q%vec(positionRow:new_tail) = this%M(aF)%mat(positionRow+1:tail,positionCol) 1009 !write(*,*) positionRow, positionCol 1010 !CALL MatrixHyb_print(M) 1011 !CALL Vector_print(this%R) 1012 !CALL Vector_print(this%Q) 1013 !CALL ListCdagC_print(this%ListCdagC) 1014 1015 !col = 1 1016 DO col_move = 1, new_tail 1017 !IF ( col_move .EQ. positionCol ) col = col + 1 1018 col = col_move + (1+SIGN(1,col_move-positionCol))/2 1019 !row = 1 1020 invStilde2 = invStilde * this%R%vec(col_move) 1021 DO row_move = 1, new_tail 1022 !IF ( row_move .EQ. positionRow ) row = row + 1 1023 row = row_move + (1+SIGN(1,row_move-positionRow))/2 1024 this%M(aF)%mat(row_move,col_move) = this%M(aF)%mat(row,col) & 1025 - this%Q%vec(row_move)*invStilde2 1026 this%M(aF)%mat_tau(row_move,col_move) = this%M(aF)%mat_tau(row,col) 1027 !row = row + 1 1028 END DO 1029 !col = col + 1 1030 END DO 1031 CALL MatrixHyb_setSize(this%M(aF),new_tail) 1032 1033 IF ( this%antiShift .EQV. .TRUE. ) THEN ! antisegment 1034 ! Shift if necessary according to this%antishift 1035 ! shift DIM=2 (col) 1036 CALL Vector_init(vec_tmp,new_tail) 1037 CALL VectorInt_init(vecI_tmp,new_tail) 1038 p = 1 1039 m = 1 1040 count = 0 1041 DO WHILE ( count .NE. new_tail ) 1042 vec_tmp%vec(1:new_tail) = this%M(aF)%mat(1:new_tail,m) 1043 vecI_tmp%vec(1:new_tail) = this%M(aF)%mat_tau(1:new_tail,m) 1044 i = m 1045 !j = m+p 1046 MODCYCLE(m+p, new_tail, j) 1047 DO WHILE (j .NE. m) 1048 this%M(aF)%mat(1:new_tail,i) = this%M(aF)%mat(1:new_tail,j) 1049 this%M(aF)%mat_tau(1:new_tail,i) = this%M(aF)%mat_tau(1:new_tail,j) 1050 i = j 1051 MODCYCLE(j+p, new_tail, j) 1052 count = count+1 1053 END DO 1054 this%M(aF)%mat(1:new_tail,i) = vec_tmp%vec(1:new_tail) 1055 this%M(aF)%mat_tau(1:new_tail,i) = vecI_tmp%vec(1:new_tail) 1056 count = count+1 1057 m = m+1 1058 END DO 1059 CALL Vector_destroy(vec_tmp) 1060 CALL VectorInt_destroy(vecI_tmp) 1061 !this%M(aF)%mat(1:new_tail,1:new_tail) = & 1062 ! CSHIFT(this%M(aF)%mat(1:new_tail,1:new_tail), SHIFT=1, DIM=2) ! Shift to the top 1063 !this%M(aF)%mat_tau(1:new_tail,1:new_tail) = & 1064 ! CSHIFT(this%M(aF)%mat_tau(1:new_tail,1:new_tail), SHIFT=1, DIM=2) ! Shift to the top 1065 END IF 1066 ! write(6,*) "after " 1067 ! CALL MatrixHyb_print(this%M(aF),opt_print=1) 1068 1069 IF ( this%doCheck .EQV. .TRUE. ) THEN 1070 !#ifdef CTQMC_CHECK 1071 CALL BathOperator_checkM(this,particle) 1072 !#endif 1073 END IF 1074 1075 this%MRemoveFlag = .FALSE. 1076 1077 END SUBROUTINE BathOperator_setMRemove
ABINIT/m_BathOperator/BathOperator_swap [ Functions ]
NAME
BathOperator_swap
FUNCTION
Recompute 2 M this swaping the segments
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=bath operator iflavor1=flavor to swap with the next one iflavor2=favor to swap with the previous one
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1106 SUBROUTINE BathOperator_swap(this, flavor1, flavor2) 1107 1108 !Arguments ------------------------------------ 1109 TYPE(BathOperator), INTENT(INOUT) :: this 1110 INTEGER , INTENT(IN ) :: flavor1 1111 INTEGER , INTENT(IN ) :: flavor2 1112 1113 !CALL MatrixHyb_print(this%M(flavor1),234) 1114 this%M(flavor1) = this%M_update(flavor1) 1115 !CALL MatrixHyb_print(this%M(flavor1),234) 1116 !CALL MatrixHyb_print(this%M(flavor2),234) 1117 this%M(flavor2) = this%M_update(flavor2) 1118 !CALL MatrixHyb_print(this%M(flavor2),234) 1119 1120 END SUBROUTINE BathOperator_swap
m_BathOperator/BathOperator [ Types ]
[ Top ] [ m_BathOperator ] [ Types ]
NAME
BathOperator
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
52 TYPE, PUBLIC :: BathOperator 53 LOGICAL _PRIVATE :: set = .FALSE. 54 LOGICAL :: MAddFlag = .FALSE. ! Set to true if we can compute a new M (see updateDetXX) 55 LOGICAL :: MRemoveFlag = .FALSE. ! Set to true if we can compute a new M (see updateDetXX) 56 LOGICAL _PRIVATE :: antiShift = .FALSE. ! shift when M is updated with antiseg 57 LOGICAL _PRIVATE :: doCheck = .FALSE. 58 INTEGER _PRIVATE :: flavors 59 INTEGER :: activeFlavor 60 INTEGER _PRIVATE :: samples 61 INTEGER _PRIVATE :: sizeHybrid 62 INTEGER _PRIVATE :: updatePosRow 63 INTEGER _PRIVATE :: updatePosCol 64 INTEGER _PRIVATE :: iTech 65 INTEGER _PRIVATE :: checkNumber 66 DOUBLE PRECISION _PRIVATE :: beta 67 DOUBLE PRECISION _PRIVATE :: dt 68 DOUBLE PRECISION _PRIVATE :: inv_dt 69 DOUBLE PRECISION _PRIVATE :: meanError 70 DOUBLE PRECISION _PRIVATE :: S 71 DOUBLE PRECISION _PRIVATE :: Stau 72 DOUBLE PRECISION _PRIVATE :: Stilde 73 TYPE(Vector) _PRIVATE :: R 74 TYPE(Vector) _PRIVATE :: Q 75 TYPE(Vector) _PRIVATE :: Rtau 76 TYPE(Vector) _PRIVATE :: Qtau 77 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) _PRIVATE :: F ! sample,Flavors 78 TYPE(MatrixHyb) , ALLOCATABLE, DIMENSION(:) :: M ! Flavors 79 TYPE(MatrixHyb) , ALLOCATABLE, DIMENSION(:) _PRIVATE :: M_update ! Flavors 80 END TYPE BathOperator