TABLE OF CONTENTS


ABINIT/m_BathOperator [ Modules ]

[ Top ] [ Modules ]

NAME

  m_BathOperator

FUNCTION

  Manage all stuff related to the bath for the 
  simgle Anderson Impurity Model

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

29 #include "defs.h"
30 MODULE m_BathOperator
31 USE m_MatrixHyb
32 USE m_Vector
33 USE m_VectorInt
34 USE m_Global
35 USE m_ListCdagC
36 
37 IMPLICIT NONE

ABINIT/m_BathOperator/ BathOperator_destroy [ Functions ]

[ Top ] [ Functions ]

NAME

   BathOperator_destroy

FUNCTION

  Deallocate and reset every thing

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1536 SUBROUTINE  BathOperator_destroy(this)
1537 
1538 
1539 !This section has been created automatically by the script Abilint (TD).
1540 !Do not modify the following lines by hand.
1541 #undef ABI_FUNC
1542 #define ABI_FUNC 'BathOperator_destroy'
1543 !End of the abilint section
1544 
1545   TYPE(BathOperator), INTENT(INOUT) :: this
1546   INTEGER  :: it
1547 
1548   DO it = 1, this%flavors
1549     CALL MatrixHyb_destroy(this%M(it))
1550     CALL MatrixHyb_destroy(this%M_update(it))
1551   END DO
1552 
1553   CALL Vector_destroy(this%R)
1554   CALL Vector_destroy(this%Q)
1555   CALL Vector_destroy(this%Rtau)
1556   CALL Vector_destroy(this%Qtau)
1557   FREEIF(this%F)
1558   DT_FREEIF(this%M)
1559   DT_FREEIF(this%M_update)
1560 
1561   this%MAddFlag     = .FALSE.
1562   this%MRemoveFlag  = .FALSE.
1563   this%flavors      = 0 
1564   this%beta         = 0.d0
1565   this%dt      = 0.d0
1566   this%inv_dt  = 0.d0
1567   this%samples      = 0
1568   this%sizeHybrid   = 0
1569   this%activeFlavor = 0 
1570   this%updatePosRow = 0
1571   this%updatePosCol = 0
1572 
1573 END SUBROUTINE BathOperator_destroy

ABINIT/m_BathOperator/BathOperator_activateParticle [ Functions ]

[ Top ] [ 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-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

302 SUBROUTINE BathOperator_activateParticle(this,flavor)
303 
304 !Arguments ------------------------------------
305 
306 !This section has been created automatically by the script Abilint (TD).
307 !Do not modify the following lines by hand.
308 #undef ABI_FUNC
309 #define ABI_FUNC 'BathOperator_activateParticle'
310 !End of the abilint section
311 
312   TYPE(BathOperator), INTENT(INOUT) :: this
313 !Local variables ------------------------------
314   INTEGER           , INTENT(IN   ) :: flavor
315 
316   IF ( flavor .GT. this%flavors ) &
317     CALL ERROR("BathOperator_activateParticle : out of range      ")
318   IF ( this%set .EQV. .TRUE. .AND. ALLOCATED(this%M) ) THEN 
319     this%activeFlavor =  flavor
320     this%MAddFlag     = .FALSE.
321     this%MRemoveFlag  = .FALSE.
322   ELSE
323     CALL ERROR("BathOperator_activateParticle : not allocated      ")
324   END IF
325 END SUBROUTINE BathOperator_activateParticle

ABINIT/m_BathOperator/BathOperator_checkM [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_checkM

FUNCTION

  compute from scratch the M this and compar it
  with the already computed M this

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1657 SUBROUTINE BathOperator_checkM(this,particle)
1658 
1659 !Arguments ------------------------------------
1660 
1661 !This section has been created automatically by the script Abilint (TD).
1662 !Do not modify the following lines by hand.
1663 #undef ABI_FUNC
1664 #define ABI_FUNC 'BathOperator_checkM'
1665 !End of the abilint section
1666 
1667   TYPE(BathOperator) , INTENT(INOUT) :: this
1668   TYPE(ListCdagC)    , INTENT(IN   ) :: particle
1669 !Local variables ------------------------------
1670 !  TYPE(MatrixHyb)                    :: checkMatrix
1671   LOGICAL :: checkTau
1672   INTEGER :: tail
1673   INTEGER :: iC
1674   INTEGER :: iCdag
1675   INTEGER :: aF
1676   CHARACTER(LEN=4) :: a
1677   DOUBLE PRECISION :: time
1678   DOUBLE PRECISION :: beta
1679   DOUBLE PRECISION :: mbeta_two
1680   DOUBLE PRECISION :: erreur
1681   DOUBLE PRECISION :: tc
1682   DOUBLE PRECISION :: tCdag
1683   DOUBLE PRECISION :: sumMmat
1684   DOUBLE PRECISION :: sumCheck
1685 #include "BathOperator_hybrid.h"
1686 
1687   aF = this%activeFlavor
1688   !Construction de la this
1689   tail = particle%tail
1690 !  CALL MatrixHyb_init(checkMatrix,this%iTech,size=tail,Wmax=this%samples)
1691 !  CALL MatrixHyb_setSize(checkMatrix,tail)
1692   CALL MatrixHyb_setSize(this%M_update(aF),tail)
1693   beta   =  this%beta
1694   mbeta_two = -beta*0.5d0
1695   this%checkNumber = this%checkNumber + 1
1696   IF ( tail .NE. this%M(aF)%tail ) THEN
1697     CALL WARN("BathOperator_checkM : tails are different          ")
1698     RETURN
1699   END IF
1700 
1701 !CALL ListCdagC_print(particle)
1702   DO iCdag = 1, tail
1703     tCdag  = particle%list(iCdag,Cdag_)
1704     DO iC  = 1, tail
1705       !tC   = particle%list(C_,iC).MOD.beta
1706       MODCYCLE(particle%list(iC,C_),beta,tC)
1707       time = tC - tCdag
1708 #include "BathOperator_hybrid"
1709       this%M_update(aF)%mat(iC,iCdag) = hybrid
1710 
1711       time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1712       this%M_update(aF)%mat_tau(iCdag,iC) = INT ( (time*this%inv_dt) +1.5d0 ) 
1713     END DO
1714   END DO
1715 
1716 !    CALL MatrixHyb_Print(checkMatrix)
1717   !Inversion de la this
1718   CALL MatrixHyb_inverse(this%M_update(aF))
1719 !    CALL MatrixHyb_Print(checkMatrix)
1720 
1721   !Comparaison
1722   sumMmat =0.d0
1723   sumCheck=0.d0
1724   erreur = 0.d0
1725   checkTau = .FALSE.
1726   DO iCdag = 1, tail
1727     Do iC =1, tail
1728       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))
1729       IF ( this%M_update(aF)%mat(iC,iCdag) .GT. erreur ) erreur = this%M_update(aF)%mat(ic,iCdag)
1730       IF ( this%M_update(aF)%mat_tau(iC,iCdag) .NE. this%M(aF)%mat_tau(iC,iCdag) ) checkTau = .TRUE.
1731     END DO
1732   END DO
1733 
1734   IF ( checkTau .EQV. .TRUE. ) THEN
1735     CALL WARN("BathOperator_checkM : mat_tau differs should be")
1736     CALL MatrixHyb_print(this%M_update(aF),opt_print=1)
1737     CALL WARN("BathOperator_checkM : whereas it is")
1738     CALL MatrixHyb_print(this%M(aF),opt_print=1)
1739   END IF
1740   this%meanError = this%meanError + erreur
1741   IF ( erreur .GT. 1.d0 ) THEN 
1742     WRITE(a,'(I4)') INT(erreur*100.d0)
1743 !    CALL MatrixHyb_Print(this%M(aF)
1744     CALL WARN("BathOperator_checkM : "//a//"%                        ") 
1745   END IF
1746 !  CALL MatrixHyb_destroy(checkMatrix)
1747 END SUBROUTINE BathOperator_checkM

ABINIT/m_BathOperator/BathOperator_doCheck [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_doCheck

FUNCTION

  Just store if we perfom check for updates of M

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1607 SUBROUTINE BathOperator_doCheck(this,opt_check)
1608 
1609 !Arguments ------------------------------------
1610 
1611 !This section has been created automatically by the script Abilint (TD).
1612 !Do not modify the following lines by hand.
1613 #undef ABI_FUNC
1614 #define ABI_FUNC 'BathOperator_doCheck'
1615 !End of the abilint section
1616 
1617   TYPE(BathOperator) , INTENT(INOUT) :: this
1618   INTEGER            , INTENT(IN   ) :: opt_check
1619   
1620   IF ( opt_check .GE. 2 ) &
1621     this%doCheck = .TRUE.
1622 END SUBROUTINE BathOperator_doCheck

ABINIT/m_BathOperator/BathOperator_getDetAdd [ Functions ]

[ Top ] [ 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-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

415 DOUBLE PRECISION  FUNCTION BathOperator_getDetAdd(this,CdagC_1, position, particle)
416 
417 !Arguments ------------------------------------
418 
419 !This section has been created automatically by the script Abilint (TD).
420 !Do not modify the following lines by hand.
421 #undef ABI_FUNC
422 #define ABI_FUNC 'BathOperator_getDetAdd'
423 !End of the abilint section
424 
425   TYPE(BathOperator)      , INTENT(INOUT) :: this
426   DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN   ) :: CdagC_1
427   INTEGER                 , INTENT(IN   ) :: position  
428   TYPE(ListCdagC), INTENT(IN   ) :: particle   
429 !Local variables-------------------------------
430   INTEGER                                 :: it1
431   INTEGER                                 :: it2
432   INTEGER                                 :: it3
433   INTEGER                                 :: tail
434   INTEGER                                 :: new_tail
435   DOUBLE PRECISION                        :: C
436   DOUBLE PRECISION                        :: Cbeta
437   DOUBLE PRECISION                        :: Cibeta
438   DOUBLE PRECISION                        :: Cdag
439   DOUBLE PRECISION                        :: Cdagbeta
440   DOUBLE PRECISION                        :: beta
441   DOUBLE PRECISION                        :: ratio
442   DOUBLE PRECISION                        :: time
443 !  TYPE(CdagC)    , POINTER, DIMENSION(:)  :: list => NULL()
444 #include "BathOperator_hybrid.h"
445 
446   this%antiShift = .FALSE.
447   beta     = this%beta
448   C        =  CdagC_1(C_)
449 !  Cbeta    = C.MOD.beta
450   MODCYCLE(C,beta,Cbeta)
451   Cdag     =  CdagC_1(Cdag_)
452 !  cdagbeta = Cdag.MOD.beta
453   MODCYCLE(Cdag,beta,CdagBeta)
454 !  IF ( Cdag .GE. beta ) &
455 !    CALL ERROR("BathOperator_getDetAdd : bad case ...              ")
456   IF ( this%activeFlavor .LE. 0 ) &
457     CALL ERROR("BathOperator_getDetAdd : no active hybrid function ")
458 
459   tail =  particle%tail
460   new_tail = tail+1
461 !  list => particle%list
462   
463   IF ( ((C .GT. Cdag) .AND. (position .EQ. -1)) &
464        .OR. ((C .LT. Cdag) .AND. (tail .EQ. 0))) THEN ! Possible only if it is a segment
465     this%updatePosRow = tail + 1
466     this%updatePosCol = tail + 1
467   ELSE
468     this%updatePosRow  = ABS(position)
469     this%updatePosCol  = ABS(position)
470   END IF
471   
472   ! If antisegment, the det ratio has to be by -1 ( sign of the signature of one
473   ! permutation line in the this
474   IF ( C .LT. Cdag .AND. tail .GT. 0) THEN ! if antiseg
475   !  ratio = -ratio 
476     this%updatePosRow  = (this%updatePosRow + 1) !position in [1;tail]
477     IF ( CdagBeta .LT. particle%list(this%updatePosCol,Cdag_) ) this%antiShift = .TRUE.
478   END IF
479 
480 !  CALL Vector_setSize(this%R,tail)
481 !  CALL Vector_setSize(this%Q,tail)
482   Vector_QuickResize(this%R,new_tail)
483   Vector_QuickResize(this%Q,new_tail)
484   Vector_QuickResize(this%Rtau,new_tail)
485   Vector_QuickResize(this%Qtau,new_tail)
486 
487   DO it1 = 1, tail
488     it2 = it1 + ( 1+SIGN(1,it1-this%updatePosRow) )/2
489     it3 = it1 + ( 1+SIGN(1,it1-this%updatePoscol) )/2
490 
491     this%Rtau%vec(it2)= C - particle%list(it1,Cdag_)
492     !this%Rtau%vec(it1)= C - particle%list(it1,Cdag_)
493     time = Cbeta - particle%list(it1,Cdag_)
494 #include "BathOperator_hybrid"
495     this%R%vec(it1) = hybrid
496 !    this%R%vec(it) = BathOperator_hybrid(this, Cbeta - list(it)%Cdag)
497 !    Cibeta = list(it)%C.MOD.beta
498     MODCYCLE(particle%list(it1,C_),beta,Cibeta)
499     time = Cibeta - Cdagbeta
500     this%Qtau%vec(it3)= time
501     !this%Qtau%vec(it1)= time
502 #include "BathOperator_hybrid"
503     this%Q%vec(it1) = hybrid
504     !this%Q%vec(it3) = hybrid
505 !    Q(it) = BathOperator_hybrid(this, Cibeta - Cdagbeta)
506   END DO
507   ! Compute S
508   this%Stau = C - Cdagbeta 
509   this%Rtau%vec(this%updatePosRow) = this%Stau
510   this%Qtau%vec(this%updatePosCol) = this%Rtau%vec(this%updatePosRow)
511 
512   time = Cbeta-Cdagbeta
513 #include "BathOperator_hybrid"
514   this%S = hybrid
515 
516   !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))
517   ratio = 0.d0
518   DO it1 = 1, tail
519     time = 0.d0
520     DO it2 = 1, tail
521       time = time + this%R%vec(it2) * this%M(this%activeFlavor)%mat(it2,it1)
522     END DO
523     ratio = ratio + this%Q%vec(it1) * time
524   END DO
525   ratio = this%S - ratio
526 
527   this%Stilde = 1.d0 / ratio
528 
529   ! This IF is the LAST "NON CORRECTION" in my opinion this should not appears.
530 !  IF ( MAX(C,Cdag) .GT. this%beta ) THEN
531 !    WRITE(*,*) this%Stilde
532 !    this%Stilde = - ABS(this%Stilde)
533 !  END IF
534 
535   ! If antisegment, the det ratio has to be by -1 ( sign of the signature of one
536   ! permutation line in the this)
537   IF ( C .LT. Cdag .AND. tail .GT. 0) THEN ! if antiseg
538     ratio = -ratio 
539   ENDIF
540 
541   BathOperator_getDetAdd = ratio
542   this%MAddFlag   = .TRUE.
543 !#ifdef CTQMC_CHECK
544 !  this%ListCdagC = particle
545 !!write(*,*) this%Stilde
546 !!write(*,*) this%antishift
547 !!write(*,*)    this%updatePosRow 
548 !!write(*,*)    this%updatePosCol 
549 !#endif
550 
551 END FUNCTION BathOperator_getDetAdd

ABINIT/m_BathOperator/BathOperator_getDetF [ Functions ]

[ Top ] [ 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-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

675 DOUBLE PRECISION FUNCTION BathOperator_getDetF(this,flavor,particle)
676 
677 !Arguments ------------------------------------
678 
679 !This section has been created automatically by the script Abilint (TD).
680 !Do not modify the following lines by hand.
681 #undef ABI_FUNC
682 #define ABI_FUNC 'BathOperator_getDetF'
683 !End of the abilint section
684 
685   TYPE(BathOperator)       , INTENT(INOUT)      :: this
686   INTEGER                  , INTENT(IN   )  :: flavor
687   TYPE(ListCdagC), OPTIONAL, INTENT(IN   )  :: particle
688 !Local arguments-------------------------------
689   INTEGER :: iCdag
690   INTEGER :: iC
691   INTEGER :: tail
692   DOUBLE PRECISION :: time
693   DOUBLE PRECISION :: tC
694   DOUBLE PRECISION :: tCdag
695   DOUBLE PRECISION :: beta
696   DOUBLE PRECISION :: mbeta_two
697   DOUBLE PRECISION :: signe
698   DOUBLE PRECISION :: inv_dt
699 #include "BathOperator_hybrid.h"
700 
701   BathOperator_getDetF = 1.d0 ! pour eviter des divisions par 0
702   IF ( PRESENT( particle ) ) THEN
703     tail = particle%tail
704     activeF = flavor
705     beta = this%beta
706     mbeta_two = -beta*0.5d0
707     inv_dt =  this%inv_dt
708     CALL MatrixHyb_setSize(this%M_update(flavor),tail)
709     DO iCdag = 1, tail
710       tCdag  = particle%list(iCdag,Cdag_)
711       DO iC  = 1, tail
712         !tC   = particle%list(C_,iC).MOD.beta
713         MODCYCLE(particle%list(iC,C_),beta,tC)
714         time = tC - tCdag
715 #include "BathOperator_hybrid"
716         this%M_update(flavor)%mat(iC,iCdag) = hybrid 
717       END DO
718     END DO
719     ! mat_tau needs to be transpose of ordered time mat (way of measuring
720     ! G(tau))
721     DO iC  = 1, tail
722       tC   = particle%list(iC,C_)
723       DO iCdag = 1, tail
724         tCdag  = particle%list(iCdag,Cdag_)
725         time = tC - tCdag
726         signe = SIGN(1.d0,time)
727         time = time + (signe-1.d0)*mbeta_two
728         this%M_update(flavor)%mat_tau(iCdag,iC) = INT( ( time * inv_dt ) + 1.5d0 )
729       END DO
730     END DO
731     CALL MatrixHyb_inverse(this%M_update(flavor),BathOperator_getDetF) ! calcul le det de la matrice et l'inverse
732   ELSE
733     CALL MatrixHyb_getDet(this%M(flavor),BathOperator_getDetF) ! det M = 1/detF !
734     BathOperator_getDetF = 1.d0 / BathOperator_getDetF
735   ENDIF
736 END FUNCTION BathOperator_getDetF

ABINIT/m_BathOperator/BathOperator_getDetRemove [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_getDetRemove

FUNCTION

  Compute the determinant ratio when a (anti)segment
  is trying to be removed 

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

587 DOUBLE PRECISION FUNCTION BathOperator_getDetRemove(this,position)
588 
589 !Arguments ------------------------------------
590 
591 !This section has been created automatically by the script Abilint (TD).
592 !Do not modify the following lines by hand.
593 #undef ABI_FUNC
594 #define ABI_FUNC 'BathOperator_getDetRemove'
595 !End of the abilint section
596 
597   TYPE(BathOperator), INTENT(INOUT) :: this
598 !Local arguments-------------------------------
599   INTEGER           , INTENT(IN   ) :: position  
600   INTEGER                           :: ABSposition  
601   INTEGER                           :: tail
602 
603   IF ( this%activeFlavor .LE. 0 ) &
604     CALL ERROR("BathOperator_getDetRemove : no active hybrid fun  ")
605 
606   this%antiShift = .FALSE.
607   tail         = this%M(this%activeFlavor)%tail
608   ABSposition  = ABS(position)
609   IF ( ABSposition .GT. tail ) &
610     CALL ERROR("BathOperator_getDetRemove : position > M size     ")
611   this%updatePosCol = ABSposition
612   this%antiShift    = .FALSE.
613   IF ( position .GT. 0 ) THEN
614     this%updatePosRow = ABSposition
615   ELSE
616     this%updatePosRow = ABSposition+1
617     IF ( ABSposition .EQ. tail ) THEN 
618       this%antiShift = .TRUE.
619       this%updatePosRow = 1 !ABSposition - 1
620 !      this%updatePosRow = ABSposition    
621 !      IF ( this%updatePosCol .EQ. 0) this%updatePosCol = tail
622     END IF
623   ENDIF
624   this%Stilde                 = this%M(this%activeflavor)%mat(this%updatePosRow,this%updatePosCol) 
625   this%MRemoveFlag            = .TRUE.
626   BathOperator_getDetRemove = this%Stilde
627 
628   ! If remove an antiseg , the det ratio has to be multiplied by -1
629   IF ( position .LT. 0 .AND. tail .GT. 1 ) &
630     BathOperator_getDetRemove = - BathOperator_getDetRemove
631 !#ifdef CTQMC_CHECK
632 !  this%ListCdagC = particle
633 !!write(*,*) this%updatePosRow, this%updatePosCol, position
634 !!CALL ListCdagC_print(particle)
635 !#endif
636 
637 END FUNCTION BathOperator_getDetRemove

ABINIT/m_BathOperator/BathOperator_getError [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_getError

FUNCTION

  compute a percentage error / checkM

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1781 DOUBLE PRECISION FUNCTION BathOperator_getError(this)
1782 
1783 
1784 !This section has been created automatically by the script Abilint (TD).
1785 !Do not modify the following lines by hand.
1786 #undef ABI_FUNC
1787 #define ABI_FUNC 'BathOperator_getError'
1788 !End of the abilint section
1789 
1790   TYPE(BathOperator), INTENT(IN) :: this
1791 
1792   IF ( this%doCheck .EQV. .TRUE. ) THEN
1793     BathOperator_getError = this%meanError / DBLE(this%checkNumber)
1794   ELSE
1795     BathOperator_getError = 0.d0
1796   END IF
1797 END FUNCTION BathOperator_getError

ABINIT/m_BathOperator/BathOperator_hybrid [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_hybrid

FUNCTION

  Compute the hybridization for the active flavor
  at time time

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

360 DOUBLE PRECISION FUNCTION BathOperator_hybrid(this,time)
361 
362 
363 !This section has been created automatically by the script Abilint (TD).
364 !Do not modify the following lines by hand.
365 #undef ABI_FUNC
366 #define ABI_FUNC 'BathOperator_hybrid'
367 !End of the abilint section
368 
369   TYPE(BathOperator), INTENT(IN) :: this
370   DOUBLE PRECISION  , INTENT(IN) :: time
371 #include "BathOperator_hybrid.h"
372 
373   IF ( this%activeFlavor .LE. 0 ) &
374     CALL ERROR("BathOperator_hybrid : no active hybrid func        ")
375 #include "BathOperator_hybrid"
376   BathOperator_hybrid = hybrid
377 
378 END FUNCTION BathOperator_hybrid

ABINIT/m_BathOperator/BathOperator_init [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_init

FUNCTION

  Initialize and allocate data

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

146 SUBROUTINE BathOperator_init(this, flavors, samples, beta, iTech)
147 
148 !Arguments ------------------------------------
149 
150 !This section has been created automatically by the script Abilint (TD).
151 !Do not modify the following lines by hand.
152 #undef ABI_FUNC
153 #define ABI_FUNC 'BathOperator_init'
154 !End of the abilint section
155 
156   TYPE(BathOperator), INTENT(INOUT) :: this
157   INTEGER           , INTENT(IN   ) :: flavors
158   INTEGER           , INTENT(IN   ) :: samples
159   DOUBLE PRECISION  , INTENT(IN   ) :: beta
160 !Local variables ------------------------------
161   INTEGER           , INTENT(IN   ) :: iTech
162   INTEGER                           :: it
163 
164   this%MAddFlag     = .FALSE.
165   this%MRemoveFlag  = .FALSE.
166   this%flavors      = flavors
167   this%beta         = beta
168   this%samples      = samples
169   this%sizeHybrid   = samples + 1
170   this%dt      = beta / DBLE(samples)
171   this%inv_dt  = DBLE(samples) / beta
172   this%activeFlavor= 0 
173   this%updatePosRow = 0
174   this%updatePosCol = 0
175   this%iTech        = iTech
176 !#ifdef CTQMC_CHECK
177   this%checkNumber  = 0
178   this%meanError    = 0.d0
179   this%doCheck = .FALSE.
180 !#endif
181 
182   FREEIF(this%F)
183   MALLOC(this%F,(1:this%sizeHybrid+1,1:flavors))
184   DT_FREEIF(this%M)
185   DT_MALLOC(this%M,(1:flavors))
186   DT_FREEIF(this%M_update)
187   DT_MALLOC(this%M_update,(1:flavors))
188   
189   CALL Vector_init(this%R,100)
190   CALL Vector_init(this%Q,100)
191   CALL Vector_init(this%Rtau,100)
192   CALL Vector_init(this%Qtau,100)
193 
194   DO it = 1, flavors
195     CALL MatrixHyb_init(this%M(it),this%iTech,size=Global_SIZE,Wmax=samples) !FIXME Should be consistent with ListCagC
196     CALL MatrixHyb_init(this%M_update(it),this%iTech,size=Global_SIZE,Wmax=samples) !FIXME Should be consistent with ListCagC
197   END DO
198   this%F       = 0.d0
199   this%set     = .TRUE.
200   
201 END SUBROUTINE BathOperator_init

ABINIT/m_BathOperator/BathOperator_initF [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_initF

FUNCTION

  Copy input hybridization functions from a file

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1291 SUBROUTINE BathOperator_initF(this,ifstream)
1292 
1293 !Arguments ----------------------
1294 
1295 !This section has been created automatically by the script Abilint (TD).
1296 !Do not modify the following lines by hand.
1297 #undef ABI_FUNC
1298 #define ABI_FUNC 'BathOperator_initF'
1299 !End of the abilint section
1300 
1301   TYPE(BathOperator), INTENT(INOUT) :: this
1302   INTEGER           , INTENT(IN   ) :: ifstream
1303 !Local variables ----------------
1304   INTEGER                           :: flavor
1305   INTEGER                           :: sample
1306 
1307   IF ( this%set .EQV. .FALSE. ) &
1308     CALL ERROR("BathOperator_initF : BathOperator not set         ")
1309 
1310   DO flavor=1,this%flavors
1311     DO sample = 1, this%sizeHybrid
1312       READ(ifstream,*) this%F(sample,flavor)
1313     END DO
1314   END DO
1315 END SUBROUTINE BathOperator_initF

ABINIT/m_BathOperator/BathOperator_printF [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_printF

FUNCTION

  print F function

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1412 SUBROUTINE BathOperator_printF(this,ostream)
1413 
1414 !Arguments ------------------------------------
1415 
1416 !This section has been created automatically by the script Abilint (TD).
1417 !Do not modify the following lines by hand.
1418 #undef ABI_FUNC
1419 #define ABI_FUNC 'BathOperator_printF'
1420 !End of the abilint section
1421 
1422   TYPE(BathOperator), INTENT(INOUT) :: this
1423   INTEGER,OPTIONAL  , INTENT(IN   ) :: ostream
1424 !Local variables ------------------------------
1425   CHARACTER(LEN=4)                  :: aflavor
1426   CHARACTER(LEN=50)                  :: string
1427   INTEGER                           :: flavor
1428   INTEGER                           :: sample
1429   INTEGER                           :: ostream_val
1430 
1431   IF ( PRESENT(ostream) ) THEN 
1432     ostream_val = ostream
1433   ELSE  
1434     ostream_val = 65
1435     OPEN(UNIT=ostream_val, FILE="F.dat")
1436   END IF
1437 
1438   WRITE(aflavor,'(I4)') this%flavors+1
1439   string = '(1x,'//TRIM(ADJUSTL(aflavor))//'E22.14)'
1440   DO sample = 1, this%sizeHybrid
1441     WRITE(ostream_val,string) (sample-1)*this%dt, (this%F(sample,flavor), flavor=1,this%flavors)
1442   END DO
1443   !CALL FLUSH(ostream_val)
1444 
1445   IF ( .NOT. PRESENT(ostream) ) &
1446     CLOSE(ostream_val)
1447 
1448 END SUBROUTINE BathOperator_printF

ABINIT/m_BathOperator/BathOperator_printM [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_printM

FUNCTION

  print M =F^{-1} this

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1483 SUBROUTINE BathOperator_printM(this,ostream)
1484 
1485 !Arguments ------------------------------------
1486 
1487 !This section has been created automatically by the script Abilint (TD).
1488 !Do not modify the following lines by hand.
1489 #undef ABI_FUNC
1490 #define ABI_FUNC 'BathOperator_printM'
1491 !End of the abilint section
1492 
1493   TYPE(BathOperator), INTENT(IN) :: this
1494   INTEGER, OPTIONAL , INTENT(IN) :: ostream
1495 !Local variables ------------------------------
1496   INTEGER                        :: ostream_val
1497 
1498   IF ( this%activeFlavor .LE. 0 ) &
1499     CALL ERROR("BathOperator_printM : no active hybrid function    ")
1500   ostream_val = 6
1501   IF ( PRESENT(ostream) ) ostream_val = ostream
1502   CALL MatrixHyb_print(this%M(this%activeFlavor),ostream_val)
1503 END SUBROUTINE BathOperator_printM

ABINIT/m_BathOperator/BathOperator_reset [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_reset

FUNCTION

  Reset all internal variables

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

234 SUBROUTINE BathOperator_reset(this)
235 
236 !Arguments ------------------------------------
237 
238 !This section has been created automatically by the script Abilint (TD).
239 !Do not modify the following lines by hand.
240 #undef ABI_FUNC
241 #define ABI_FUNC 'BathOperator_reset'
242 !End of the abilint section
243 
244   TYPE(BathOperator), INTENT(INOUT) :: this
245 !Local variables ------------------------------
246   INTEGER                           :: it
247   this%MAddFlag     = .FALSE.
248   this%MRemoveFlag  = .FALSE.
249   this%activeFlavor = 0 
250   this%updatePosRow = 0
251   this%updatePosCol = 0
252 !#ifdef CTQMC_CHECK
253   this%checkNumber  = 0
254   this%meanError    = 0.d0
255 !#endif
256   this%doCheck = .FALSE.
257   CALL Vector_clear(this%R)
258   CALL Vector_clear(this%Q)
259   CALL Vector_clear(this%Rtau)
260   CALL Vector_clear(this%Qtau)
261 
262   DO it = 1, this%flavors
263     CALL MatrixHyb_clear(this%M(it)) !FIXME Should be consistent with ListCagC
264   END DO
265   this%F       = 0.d0
266 
267 END SUBROUTINE BathOperator_reset

ABINIT/m_BathOperator/BathOperator_setF [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_setF

FUNCTION

  Copy F from input array

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1349 SUBROUTINE BathOperator_setF(this,F)
1350 
1351 !Arguments ------------------------------------
1352 
1353 !This section has been created automatically by the script Abilint (TD).
1354 !Do not modify the following lines by hand.
1355 #undef ABI_FUNC
1356 #define ABI_FUNC 'BathOperator_setF'
1357 !End of the abilint section
1358 
1359   TYPE(BathOperator)               , INTENT(INOUT) :: this
1360   DOUBLE PRECISION, DIMENSION(:,:) , INTENT(IN   ) :: F
1361 !Arguments ------------------------------------
1362   INTEGER                                          :: flavor
1363   INTEGER                                          :: sample
1364   INTEGER                                          :: length
1365 
1366   IF ( this%set .EQV. .FALSE. ) &
1367     CALL ERROR("BathOperator_setF : BathOperator not set          ")
1368 
1369  length  = SIZE(F)
1370   IF ( length .NE. (this%flavors * this%sizeHybrid) ) &
1371     CALL ERROR("BathOperator_setF : wrong input F                 ")
1372 
1373   DO flavor=1,this%flavors
1374     DO sample = 1, this%sizeHybrid
1375     this%F(sample,flavor) = F(sample,flavor)
1376     END DO
1377   END DO
1378 END SUBROUTINE BathOperator_setF

ABINIT/m_BathOperator/BathOperator_setMAdd [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_setMAdd

FUNCTION

  Update de M this inserting a row and a column

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

 770 SUBROUTINE BathOperator_setMAdd(this,particle) 
 771 
 772 !Arguments ------------------------------------
 773 
 774 !This section has been created automatically by the script Abilint (TD).
 775 !Do not modify the following lines by hand.
 776 #undef ABI_FUNC
 777 #define ABI_FUNC 'BathOperator_setMAdd'
 778 !End of the abilint section
 779 
 780   TYPE(BathOperator), INTENT(INOUT) :: this
 781   TYPE(ListCdagC)   , INTENT(IN   ) :: particle
 782 !Local variables ------------------------------
 783   INTEGER                           :: tail
 784   INTEGER                           :: new_tail
 785   INTEGER                           :: col
 786   INTEGER                           :: col_move
 787   INTEGER                           :: row_move
 788   INTEGER                           :: row
 789   INTEGER                           :: positionRow
 790   INTEGER                           :: positionCol
 791   INTEGER                           :: aF
 792   DOUBLE PRECISION                  :: Stilde
 793   DOUBLE PRECISION                  :: time
 794   DOUBLE PRECISION                  :: mbeta_two
 795   DOUBLE PRECISION                  :: inv_dt
 796   TYPE(Vector) :: vec_tmp
 797   TYPE(VectorInt) :: vecI_tmp
 798   INTEGER :: m
 799   INTEGER :: count
 800   INTEGER :: i
 801   INTEGER :: j
 802   INTEGER :: p
 803 
 804   IF ( this%MAddFlag .EQV. .FALSE. ) &
 805     CALL ERROR("BathOperator_setMAdd : MAddFlag turn off           ")
 806   af = this%activeFlavor
 807   IF ( aF .LE. 0 ) &
 808     CALL ERROR("BathOperator_setMAdd : no active hybrid function   ")
 809   tail     =  this%M(aF)%tail
 810   new_tail =  tail + 1
 811 !CALL this_print(M)
 812 
 813   positionRow =  this%updatePosRow
 814   positionCol =  this%updatePosCol
 815   Stilde      =  this%Stilde
 816 !  write(6,*) "before", positionRow, positionCol
 817   !CALL MatrixHyb_print(this%M(aF),opt_print=1)
 818   CALL MatrixHyb_setSize(this%M(aF),new_tail)
 819 
 820   ! Compute Qtilde with Q
 821   !this%Q%vec(1:tail) = (-1.d0) * MATMUL(this%M(aF)%mat(1:tail,1:tail),this%Q%vec(1:tail)) * Stilde
 822   this%Q%vec(1:tail) = MATMUL(this%M(aF)%mat(1:tail,1:tail),this%Q%vec(1:tail))
 823   !this%Q%vec(PositionRow:new_tail) = EOSHIFT(this%Q%vec(PositionRow:new_tail), SHIFT=-1, BOUNDARY=-1.d0, DIM=1)
 824 !  this%Qtau%vec(PositionCol:new_tail) = EOSHIFT(this%Qtau%vec(PositionCol:new_tail), SHIFT=-1, BOUNDARY=1.d0, DIM=1)
 825 !  this%Qtau%vec(PositionCol) = this%Stau
 826 
 827   !Compute Rtilde with R and without multiplying by Stilde
 828   !this%R%vec(1:tail) = (-1.d0) * MATMUL(this%R%vec(1:tail),this%M(aF)%mat(1:tail,1:tail))
 829   this%R%vec(1:tail) = MATMUL(this%R%vec(1:tail),this%M(aF)%mat(1:tail,1:tail))
 830   !this%R%vec(PositionCol:new_tail) = EOSHIFT(this%R%vec(PositionCol:new_tail), SHIFT=-1, BOUNDARY=-1.d0, DIM=1)
 831 !  this%Rtau%vec(PositionRow:new_tail) = EOSHIFT(this%Rtau%vec(PositionRow:new_tail), SHIFT=-1, BOUNDARY=1.d0, DIM=1)
 832 !  this%Rtau%vec(PositionRow) = this%Stau
 833 
 834   !Compute the new M this
 835   !this%M(aF)%mat(PositionRow:new_tail,1:new_tail) = &
 836   !                   EOSHIFT(this%M(aF)%mat(PositionRow:new_tail,1:new_tail),SHIFT=-1, BOUNDARY=0.d0, DIM=1)
 837   !this%M(aF)%mat(1:new_tail,PositionCol:new_tail) = &
 838   !                   EOSHIFT(this%M(aF)%mat(1:new_tail,PositionCol:new_tail),SHIFT=-1, BOUNDARY=0.d0, DIM=2)
 839 ! ! this%M(aF)%mat(1:new_tail,1:new_tail) =  this%M(aF)%mat(1:new_tail,1:new_tail) + &
 840 ! ! Stilde * MATMUL(RESHAPE(this%Q%vec(1:new_tail),(/ new_tail,1 /)),RESHAPE(this%R%vec(1:new_tail),(/ 1,new_tail /)))
 841 
 842   !this%M(aF)%mat_tau(PositionRow:new_tail,1:new_tail) = &
 843   !                   EOSHIFT(this%M(aF)%mat_tau(PositionRow:new_tail,1:new_tail),SHIFT=-1, BOUNDARY=0, DIM=1)
 844   !this%M(aF)%mat_tau(1:new_tail,PositionCol:new_tail) = &
 845   !                   EOSHIFT(this%M(aF)%mat_tau(1:new_tail,PositionCol:new_tail),SHIFT=-1, BOUNDARY=0, DIM=2)
 846 
 847   mbeta_two = -this%beta*0.5d0
 848   inv_dt = this%inv_dt
 849   !Shift mat_tau
 850   !update old m
 851   DO col=tail,1,-1
 852     col_move = col +  ( 1+SIGN(1,col-PositionCol) )/2
 853     DO row=tail,1,-1
 854       row_move = row +  ( 1+SIGN(1,row-PositionRow) )/2
 855       this%M(aF)%mat_tau(row_move,col_move) = this%M(aF)%mat_tau(row,col)
 856       this%M(aF)%mat(row_move,col_move) = this%M(aF)%mat(row,col) + this%Q%vec(row)*this%R%vec(col) * Stilde
 857     END DO
 858   END DO
 859   ! Add new stuff for new row
 860   DO row = 1, tail
 861     row_move = row +  ( 1+SIGN(1,row-PositionRow) )/2
 862     this%M(aF)%mat(row_move,PositionCol) = -this%Q%vec(row)*Stilde
 863     time = this%Rtau%vec(row)
 864     time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
 865     this%M(aF)%mat_tau(row,PositionCol) = INT ( (time*inv_dt) +1.5d0 )
 866   END DO
 867   ! Add last time missing in the loops
 868   time = this%Rtau%vec(new_tail)
 869   time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
 870   this%M(aF)%mat_tau(new_tail,PositionCol) = INT ( (time*inv_dt) +1.5d0 )
 871   ! Add new stuff for new col
 872   DO col = 1, tail 
 873     col_move = col +  ( 1+SIGN(1,col-PositionCol) )/2
 874     this%M(aF)%mat(PositionRow,col_move) = -this%R%vec(col)*Stilde
 875     time = this%Qtau%vec(col)
 876     time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
 877     this%M(aF)%mat_tau(PositionRow,col) = INT ( (time*inv_dt) +1.5d0 )
 878   END DO
 879   ! Add last time missing in the loops
 880   time = this%Qtau%vec(new_tail)
 881   time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
 882   this%M(aF)%mat_tau(PositionRow,new_tail) = INT ( (time*inv_dt) +1.5d0 )
 883 
 884   this%M(aF)%mat(PositionRow,PositionCol) = Stilde
 885 
 886   !CALL MatrixHyb_print(this%M(aF),opt_print=1)
 887 
 888 !  DO col = 1, new_tail
 889 !    time = this%Rtau%vec(col)
 890 !    time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
 891 !    this%M(aF)%mat_tau(col,PositionCol) = INT ( (time*inv_dt) +1.5d0 )
 892 !    time = this%Qtau%vec(col)
 893 !    time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
 894 !    this%M(aF)%mat_tau(PositionRow,Col) = INT ( (time*inv_dt) +1.5d0 )
 895 !    time = this%R%vec(col)*Stilde
 896 !    DO row = 1, new_tail
 897 !      this%M(aF)%mat(row,col) = this%M(aF)%mat(row,col) + this%Q%vec(row)*time
 898 !    END DO
 899 !  END DO
 900 
 901   !col_move = new_tail
 902   !col      = tail
 903   !DO col_move = new_tail, 1, -1
 904   !  IF ( col_move .EQ. positionCol ) THEN
 905   !    ! on calcule rajoute Q tilde
 906   !    !row_move = new_tail
 907   !    row      = tail 
 908   !    DO row_move = new_tail, 1, -1
 909   !      ! calcul itau
 910   !      IF ( row_move .EQ. positionRow ) THEN
 911   !        this%M(aF)%mat(row_move,col_move) = Stilde
 912   !        !time = this%Stau
 913   !      ELSE
 914   !        this%M(aF)%mat(row_move,col_move) = -this%Q%vec(row)*Stilde
 915   !        !time = this%Rtau%vec(row_move)
 916   !        row      = row      - 1 
 917   !      END IF
 918   !      !time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
 919   !      !this%M(aF)%mat_tau(row_move,col_move) = INT ( (time*inv_dt) +1.5d0 )
 920   !    END DO
 921   !    ! realignement des indices
 922   !  ELSE
 923   !    ! on calcule Ptilde
 924   !    !row_move = new_tail
 925   !    row      = tail 
 926   !    DO row_move = new_tail, 1, -1
 927   !      IF ( row_move .EQ. positionRow ) THEN
 928   !        this%M(aF)%mat(row_move,col_move) = -this%R%vec(col) * Stilde
 929   !        ! calcul itau
 930   !        !time = this%Qtau%vec(col_move)
 931   !        !time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
 932   !        !this%M(aF)%mat_tau(row_move,col_move) = INT ( (time*inv_dt) +1.5d0 )
 933   !      ELSE
 934   !        this%M(aF)%mat(row_move,col_move) = this%M(aF)%mat(row,col) + this%Q%vec(row)*this%R%vec(col)*Stilde
 935   !        ! copy itau
 936   !        !this%M(aF)%mat_tau(row_move,col_move) = this%M(aF)%mat_tau(row,col)
 937   !        row      = row      - 1 
 938   !      END IF
 939   !    END DO
 940   !    col      = col      - 1
 941   !  END IF
 942   !END DO
 943 !  write(6,*) "after"
 944 !  CALL MatrixHyb_print(this%M(aF),opt_print=1)
 945 !CALL this_inverse(M)
 946 !CALL MatrixHyb_print(M)
 947 !CALL this_inverse(M)
 948 
 949   IF ( this%antiShift .EQV. .TRUE. ) THEN ! antisegment
 950     CALL Vector_init(vec_tmp,new_tail)
 951     CALL VectorInt_init(vecI_tmp,new_tail)
 952   ! Shift if necessary according to this%antishift
 953   ! shift DIM=2 (col)
 954     p = new_tail - 1
 955     m = 1
 956     count = 0
 957     DO WHILE ( count .NE. new_tail )
 958       vec_tmp%vec(1:new_tail) = this%M(aF)%mat(1:new_tail,m)
 959       vecI_tmp%vec(1:new_tail) = this%M(aF)%mat_tau(1:new_tail,m)
 960       i = m
 961       !j = m+p
 962       MODCYCLE(m+p, new_tail, j)
 963       DO WHILE (j .NE. m)
 964         this%M(aF)%mat(1:new_tail,i) = this%M(aF)%mat(1:new_tail,j)
 965         this%M(aF)%mat_tau(1:new_tail,i) = this%M(aF)%mat_tau(1:new_tail,j)
 966         i = j
 967         MODCYCLE(j+p, new_tail, j)
 968         count = count+1
 969       END DO
 970       this%M(aF)%mat(1:new_tail,i) = vec_tmp%vec(1:new_tail)
 971       this%M(aF)%mat_tau(1:new_tail,i) = vecI_tmp%vec(1:new_tail)
 972       count = count+1
 973       m = m+1
 974     END DO
 975     ! shift DIM=1 (row)
 976     p = new_tail - 1
 977     m = 1
 978     count = 0
 979     DO WHILE ( count .NE. new_tail)
 980       vec_tmp%vec(1:new_tail) = this%M(aF)%mat(m,1:new_tail)
 981       vecI_tmp%vec(1:new_tail) = this%M(aF)%mat_tau(m,1:new_tail)
 982       i = m
 983       !j = m+p
 984       MODCYCLE(m+p, new_tail, j)
 985       DO WHILE ( j .NE. m )
 986         this%M(aF)%mat(i,1:new_tail) = this%M(aF)%mat(j,1:new_tail)
 987         this%M(aF)%mat_tau(i,1:new_tail) = this%M(aF)%mat_tau(j,1:new_tail)
 988         i = j
 989         MODCYCLE(j+p, new_tail, j)
 990         count = count+1
 991       END DO
 992       this%M(aF)%mat(i,1:new_tail) = vec_tmp%vec(1:new_tail)
 993       this%M(aF)%mat_tau(i,1:new_tail) = vecI_tmp%vec(1:new_tail)
 994       count = count+1
 995       m = m+1
 996     END DO
 997     CALL Vector_destroy(vec_tmp)
 998     CALL VectorInt_destroy(vecI_tmp)
 999     !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
1000     !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
1001     !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
1002     !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
1003 !CALL this_print(M)
1004   END IF
1005 
1006   IF ( this%doCheck .EQV. .TRUE.) THEN
1007 !#ifdef CTQMC_CHECK
1008   CALL BathOperator_checkM(this,particle)
1009 !#endif
1010   END IF
1011 
1012   this%MAddFlag = .FALSE.
1013 
1014 END SUBROUTINE BathOperator_setMAdd

ABINIT/m_BathOperator/BathOperator_setMRemove [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_setMRemove

FUNCTION

  delete one row and one column of the M this

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1048 SUBROUTINE BathOperator_setMRemove(this,particle) 
1049 
1050 !Arguments ------------------------------------
1051 
1052 !This section has been created automatically by the script Abilint (TD).
1053 !Do not modify the following lines by hand.
1054 #undef ABI_FUNC
1055 #define ABI_FUNC 'BathOperator_setMRemove'
1056 !End of the abilint section
1057 
1058   TYPE(BathOperator), INTENT(INOUT)  :: this
1059   TYPE(ListCdagC)   , INTENT(IN   )  :: particle
1060 !Local variables ------------------------------
1061   INTEGER                            :: tail
1062   INTEGER                            :: new_tail
1063   INTEGER                            :: col
1064   INTEGER                            :: col_move
1065   INTEGER                            :: row_move
1066   INTEGER                            :: row
1067   INTEGER                            :: positionCol
1068   INTEGER                            :: positionRow
1069   INTEGER                            :: aF
1070   INTEGER                              :: m
1071   INTEGER                              :: count
1072   INTEGER                              :: i
1073   INTEGER                              :: j
1074   INTEGER                              :: p
1075   DOUBLE PRECISION                   :: invStilde
1076   DOUBLE PRECISION                   :: invStilde2
1077   TYPE(VectorInt) :: vecI_tmp
1078   TYPE(Vector)    :: vec_tmp
1079 
1080   IF ( this%MRemoveFlag .EQV. .FALSE. ) &
1081     CALL ERROR("BathOperator_setMRemove : MRemoveFlag turn off     ")
1082   af = this%activeFlavor
1083   IF ( aF .LE. 0 ) &
1084     CALL ERROR("BathOperator_setMRemove : no active hybrid func    ")
1085   tail        =  this%M(aF)%tail
1086   new_tail    =  tail - 1
1087   positionCol =  this%updatePosCol
1088   positionRow =  this%updatePosRow
1089   invStilde   = 1.d0 / this%Stilde
1090 
1091 !  write(6,*) "before", positionRow, positionCol
1092 !  CALL MatrixHyb_print(this%M(aF),opt_print=1)
1093 
1094 !  IF ( new_tail .EQ. 0 ) THEN
1095 !!    IF ( this%antiShift .EQV. .TRUE.  ) THEN
1096 !!      this%M(aF)%mat(1,1) = 1.d0/BathOperator_Hybrid(this, this%beta)
1097 !!      this%MRemoveFlag = .FALSE.
1098 !!      RETURN
1099 !!    END IF
1100 !    CALL MatrixHyb_clear(this%M(aF))
1101 !    this%MRemoveFlag = .FALSE.
1102 !    RETURN
1103 !  END IF
1104 
1105 !  CALL Vector_setSize(this%Q,new_tail)
1106 !  CALL Vector_setSize(this%R,new_tail)
1107   Vector_QuickResize(this%Q,new_tail)
1108   Vector_QuickResize(this%R,new_tail)
1109 
1110 !  We use R and Q as this%R%vec and this%Q%vec
1111 !  this%R%vec => this%R
1112 !  this%Q%vec => this%Q
1113 
1114   !row      = 1
1115   !row_move = 1
1116   !col      = 1
1117   !col_move = 1
1118   DO row_move = 1, new_tail
1119     !IF ( row .EQ. positionRow ) row = row + 1
1120     !IF ( col .EQ. positionCol ) col = col + 1
1121     col = row_move + (1+SIGN(1,row_move-positionCol))/2
1122     row = row_move + (1+SIGN(1,row_move-positionRow))/2
1123     this%R%vec(row_move) = this%M(aF)%mat(positionRow,col)
1124     this%Q%vec(row_move) = this%M(aF)%mat(row,positionCol)
1125     !row      = row + 1 
1126     !col      = col + 1
1127   END DO
1128 !!    this%R%vec(1:positionCol-1) = this%M(aF)%mat(positionRow,1:positionCol-1)
1129 !!    this%R%vec(positionCol:new_tail) = this%M(aF)%mat(positionRow,positionCol+1:tail)
1130 !!    this%Q%vec(1:positionRow-1) = this%M(aF)%mat(1:positionRow-1,positionCol)
1131 !!    this%Q%vec(positionRow:new_tail) = this%M(aF)%mat(positionRow+1:tail,positionCol)
1132 !write(*,*) positionRow, positionCol
1133 !CALL MatrixHyb_print(M)
1134 !CALL Vector_print(this%R)
1135 !CALL Vector_print(this%Q)
1136 !CALL ListCdagC_print(this%ListCdagC)
1137 
1138   !col      = 1
1139   DO col_move = 1, new_tail 
1140     !IF ( col_move .EQ. positionCol ) col = col + 1
1141     col = col_move + (1+SIGN(1,col_move-positionCol))/2
1142     !row      = 1
1143     invStilde2 = invStilde * this%R%vec(col_move)
1144     DO row_move = 1, new_tail
1145       !IF ( row_move .EQ. positionRow ) row = row + 1
1146       row = row_move + (1+SIGN(1,row_move-positionRow))/2
1147       this%M(aF)%mat(row_move,col_move) = this%M(aF)%mat(row,col) &
1148                                       - this%Q%vec(row_move)*invStilde2
1149       this%M(aF)%mat_tau(row_move,col_move) = this%M(aF)%mat_tau(row,col)
1150       !row      = row      + 1
1151     END DO
1152     !col      = col      + 1 
1153   END DO
1154   CALL MatrixHyb_setSize(this%M(aF),new_tail)
1155 
1156   IF ( this%antiShift .EQV. .TRUE. ) THEN ! antisegment
1157     ! Shift if necessary according to this%antishift
1158     ! shift DIM=2 (col)
1159     CALL Vector_init(vec_tmp,new_tail)
1160     CALL VectorInt_init(vecI_tmp,new_tail)
1161     p = 1
1162     m = 1
1163     count = 0
1164     DO WHILE ( count .NE. new_tail )
1165       vec_tmp%vec(1:new_tail) = this%M(aF)%mat(1:new_tail,m)
1166       vecI_tmp%vec(1:new_tail) = this%M(aF)%mat_tau(1:new_tail,m)
1167       i = m
1168       !j = m+p
1169       MODCYCLE(m+p, new_tail, j)
1170       DO WHILE (j .NE. m)
1171         this%M(aF)%mat(1:new_tail,i) = this%M(aF)%mat(1:new_tail,j)
1172         this%M(aF)%mat_tau(1:new_tail,i) = this%M(aF)%mat_tau(1:new_tail,j)
1173         i = j
1174         MODCYCLE(j+p, new_tail, j)
1175         count = count+1
1176       END DO
1177       this%M(aF)%mat(1:new_tail,i) = vec_tmp%vec(1:new_tail)
1178       this%M(aF)%mat_tau(1:new_tail,i) = vecI_tmp%vec(1:new_tail)
1179       count = count+1
1180       m = m+1
1181     END DO
1182     CALL Vector_destroy(vec_tmp)
1183     CALL VectorInt_destroy(vecI_tmp)
1184     !this%M(aF)%mat(1:new_tail,1:new_tail) = &
1185     !           CSHIFT(this%M(aF)%mat(1:new_tail,1:new_tail), SHIFT=1, DIM=2) ! Shift to the top
1186     !this%M(aF)%mat_tau(1:new_tail,1:new_tail) = &
1187     !           CSHIFT(this%M(aF)%mat_tau(1:new_tail,1:new_tail), SHIFT=1, DIM=2) ! Shift to the top
1188   END IF
1189 !  write(6,*) "after "
1190 !  CALL MatrixHyb_print(this%M(aF),opt_print=1)
1191 
1192   IF ( this%doCheck .EQV. .TRUE. ) THEN
1193 !#ifdef CTQMC_CHECK
1194   CALL BathOperator_checkM(this,particle)
1195 !#endif
1196   END IF
1197 
1198   this%MRemoveFlag = .FALSE.
1199 
1200 END SUBROUTINE BathOperator_setMRemove

ABINIT/m_BathOperator/BathOperator_swap [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperator_swap

FUNCTION

  Recompute 2 M this swaping the segments

COPYRIGHT

  Copyright (C) 2013-2018 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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1235 SUBROUTINE BathOperator_swap(this, flavor1, flavor2)
1236 
1237 !Arguments ------------------------------------
1238 
1239 !This section has been created automatically by the script Abilint (TD).
1240 !Do not modify the following lines by hand.
1241 #undef ABI_FUNC
1242 #define ABI_FUNC 'BathOperator_swap'
1243 !End of the abilint section
1244 
1245   TYPE(BathOperator), INTENT(INOUT) :: this
1246   INTEGER           , INTENT(IN   ) :: flavor1
1247   INTEGER           , INTENT(IN   ) :: flavor2
1248 
1249   !CALL MatrixHyb_print(this%M(flavor1),234)
1250   this%M(flavor1) = this%M_update(flavor1)
1251   !CALL MatrixHyb_print(this%M(flavor1),234)
1252   !CALL MatrixHyb_print(this%M(flavor2),234)
1253   this%M(flavor2) = this%M_update(flavor2)
1254   !CALL MatrixHyb_print(this%M(flavor2),234)
1255 
1256 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-2018 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

58 TYPE, PUBLIC :: BathOperator
59   LOGICAL _PRIVATE :: set         = .FALSE.
60   LOGICAL          :: MAddFlag    = .FALSE. ! Set to true if we can compute a new M (see updateDetXX)
61   LOGICAL          :: MRemoveFlag = .FALSE. ! Set to true if we can compute a new M (see updateDetXX)
62   LOGICAL _PRIVATE :: antiShift   = .FALSE. ! shift when M is updated with antiseg
63   LOGICAL _PRIVATE :: doCheck     = .FALSE.
64   INTEGER _PRIVATE :: flavors
65   INTEGER          :: activeFlavor
66   INTEGER _PRIVATE :: samples
67   INTEGER _PRIVATE :: sizeHybrid
68   INTEGER _PRIVATE :: updatePosRow
69   INTEGER _PRIVATE :: updatePosCol
70   INTEGER _PRIVATE :: iTech
71   INTEGER _PRIVATE :: checkNumber
72   DOUBLE PRECISION _PRIVATE                   :: beta
73   DOUBLE PRECISION _PRIVATE                   :: dt
74   DOUBLE PRECISION _PRIVATE                   :: inv_dt
75   DOUBLE PRECISION _PRIVATE                   :: meanError
76   DOUBLE PRECISION _PRIVATE                   :: S
77   DOUBLE PRECISION _PRIVATE                   :: Stau
78   DOUBLE PRECISION _PRIVATE                   :: Stilde
79   TYPE(Vector)     _PRIVATE                   :: R 
80   TYPE(Vector)     _PRIVATE                   :: Q 
81   TYPE(Vector)     _PRIVATE                   :: Rtau
82   TYPE(Vector)     _PRIVATE                   :: Qtau
83   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) _PRIVATE :: F ! sample,Flavors
84   TYPE(MatrixHyb) , ALLOCATABLE, DIMENSION(:)            :: M  ! Flavors
85   TYPE(MatrixHyb) , ALLOCATABLE, DIMENSION(:)   _PRIVATE :: M_update  ! Flavors
86 END TYPE BathOperator