TABLE OF CONTENTS


ABINIT/m_BathOperatoroffdiag [ Modules ]

[ Top ] [ Modules ]

NAME

  m_BathOperatoroffdiag

FUNCTION

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

COPYRIGHT

  Copyright (C) 2013-2018 ABINIT group (J. Bieder, J. Denier, B. Amadon)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

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_BathOperatoroffdiag
31 USE m_MatrixHyb
32 USE m_Vector
33 USE m_VectorInt
34 USE m_Global
35 USE m_ListCdagC
36 IMPLICIT NONE
37 
38 ! subroutines
39  public :: BathOperatoroffdiag_init
40  public :: BathOperatoroffdiag_reset
41  public :: BathOperatoroffdiag_activateParticle
42  public :: BathOperatoroffdiag_setMAdd
43  public :: BathOperatoroffdiag_setMRemove
44  public :: BathOperatoroffdiag_swap
45  public :: BathOperatoroffdiag_initF
46  public :: BathOperatoroffdiag_setF
47  public :: BathOperatoroffdiag_printF
48  public :: BathOperatoroffdiag_printM
49  public :: BathOperatoroffdiag_destroy
50  public :: BathOperatoroffdiag_doCheck
51  public :: BathOperatoroffdiag_checkM
52 
53 ! functions
54 ! public :: BathOperatoroffdiag_hybrid
55  public :: BathOperatoroffdiag_getDetAdd
56  public :: BathOperatoroffdiag_getDetRemove
57  public :: BathOperatoroffdiag_getDetF
58  public :: BathOperatoroffdiag_getError

ABINIT/m_BathOperatoroffdiag/ BathOperatoroffdiag_destroy [ Functions ]

[ Top ] [ Functions ]

NAME

   BathOperatoroffdiag_destroy

FUNCTION

  Deallocate and reset every thing

COPYRIGHT

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

  op=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

2030 SUBROUTINE  BathOperatoroffdiag_destroy(op)
2031 
2032 
2033 !This section has been created automatically by the script Abilint (TD).
2034 !Do not modify the following lines by hand.
2035 #undef ABI_FUNC
2036 #define ABI_FUNC 'BathOperatoroffdiag_destroy'
2037 !End of the abilint section
2038 
2039   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
2040 
2041   CALL MatrixHyb_destroy(op%M)
2042   CALL MatrixHyb_destroy(op%M_update)
2043 
2044   CALL Vector_destroy(op%R)
2045   CALL Vector_destroy(op%Q)
2046   CALL Vector_destroy(op%Rtau)
2047   CALL Vector_destroy(op%Qtau)
2048   FREEIF(op%F)
2049   FREEIF(op%Fshift)
2050   FREEIF(op%tails)
2051 
2052   op%MAddFlag     = .FALSE.
2053   op%MRemoveFlag  = .FALSE.
2054   op%flavors      = 0 
2055   op%beta         = 0.d0
2056   op%dt      = 0.d0
2057   op%inv_dt  = 0.d0
2058   op%samples      = 0
2059   op%sizeHybrid   = 0
2060   op%activeFlavor = 0 
2061   op%updatePosRow = 0
2062   op%updatePosCol = 0
2063 
2064 END SUBROUTINE BathOperatoroffdiag_destroy

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_activateParticle [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_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 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

  op=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

400 SUBROUTINE BathOperatoroffdiag_activateParticle(op,flavor)
401 
402 !Arguments ------------------------------------
403 
404 !This section has been created automatically by the script Abilint (TD).
405 !Do not modify the following lines by hand.
406 #undef ABI_FUNC
407 #define ABI_FUNC 'BathOperatoroffdiag_activateParticle'
408 !End of the abilint section
409 
410   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
411 !Local variables ------------------------------
412   INTEGER           , INTENT(IN   ) :: flavor
413 
414   IF ( flavor .GT. op%flavors ) &
415     CALL ERROR("BathOperatoroffdiag_activateParticle : out of range      ")
416   IF ( op%set .EQV. .TRUE. ) THEN 
417     op%activeFlavor =  flavor
418     op%MAddFlag     = .FALSE.
419     op%MRemoveFlag  = .FALSE.
420   ELSE
421     CALL ERROR("BathOperatoroffdiag_activateParticle : not allocated      ")
422   END IF
423 END SUBROUTINE BathOperatoroffdiag_activateParticle

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_checkM [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_checkM

FUNCTION

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

COPYRIGHT

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

  op=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

2148 SUBROUTINE BathOperatoroffdiag_checkM(op,particle)
2149 
2150 !Arguments ------------------------------------
2151 
2152 !This section has been created automatically by the script Abilint (TD).
2153 !Do not modify the following lines by hand.
2154 #undef ABI_FUNC
2155 #define ABI_FUNC 'BathOperatoroffdiag_checkM'
2156 !End of the abilint section
2157 
2158   TYPE(BathOperatoroffdiag) , INTENT(INOUT) :: op
2159   TYPE(ListCdagC)    , INTENT(IN   ) :: particle(:)
2160 !Local variables ------------------------------
2161 !  TYPE(MatrixHyb)                    :: checkMatrix
2162   LOGICAL :: checkTau
2163   INTEGER :: tail
2164   INTEGER :: iC
2165   INTEGER :: iCdag
2166   INTEGER :: aF
2167   INTEGER :: iflavora
2168   INTEGER :: iflavorb,it,it1
2169   CHARACTER(LEN=6) :: a
2170   DOUBLE PRECISION :: time
2171   DOUBLE PRECISION :: beta
2172   DOUBLE PRECISION :: mbeta_two
2173   DOUBLE PRECISION :: errorabs
2174   DOUBLE PRECISION :: errormax
2175   DOUBLE PRECISION :: error1
2176   DOUBLE PRECISION :: errorrel
2177   DOUBLE PRECISION :: tc
2178   DOUBLE PRECISION :: tCdag
2179   DOUBLE PRECISION :: sumMmat
2180   DOUBLE PRECISION :: sumCheck
2181 #include "BathOperatoroffdiag_hybrid.h"
2182 
2183   aF = op%activeFlavor
2184   !Construction de la matrix
2185   tail = op%sumtails
2186 !  CALL MatrixHyb_init(checkMatrix,op%iTech,size=tail,Wmax=op%samples)
2187 !  CALL MatrixHyb_setSize(checkMatrix,tail)
2188 
2189   ! --- set size of the matrix
2190   CALL MatrixHyb_setSize(op%M_update,tail)
2191 
2192   ! --- compute useful quantities
2193   beta   =  op%beta
2194   mbeta_two = -beta*0.5d0
2195   op%checkNumber = op%checkNumber + 1
2196   IF ( tail .NE. op%M%tail ) THEN
2197     CALL WARN("BathOperatoroffdiag_checkM : tails are different          ")
2198     RETURN
2199   END IF
2200 
2201   do it=1,op%sumtails
2202     !write(6,*) "        checkM begin M_update%mat_tau",(op%M_update%mat_tau(it,it1),it1=1,op%sumtails)
2203   enddo
2204   ! --- build matrix
2205 !CALL ListCdagC_print(particle)
2206   DO iflavora = 1, op%flavors
2207   DO iCdag = 1, op%tails(iflavora)
2208     tCdag  = particle(iflavora)%list(iCdag,Cdag_)
2209       !write(6,*) "         checkM a",iflavora,tCdag
2210     DO iflavorb = 1, op%flavors
2211     DO iC  = 1, op%tails(iflavorb)
2212       !tC   = particle%list(C_,iC).MOD.beta
2213       MODCYCLE(particle(iflavorb)%list(iC,C_),beta,tC) ! tC is tC, or Tc-Beta if tc>beta
2214       !write(6,*) "         checkM b",iflavorb,tC
2215       time = tC - tCdag  ! time is positive or negative but lower than beta
2216       !write(6,*) "         checkM time",time
2217 
2218 #include "BathOperatoroffdiag_hybrid"
2219 
2220       op%M_update%mat(op%Fshift(iflavorb)+iC,op%Fshift(iflavora)+iCdag) = hybrid
2221 
2222       time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
2223       op%M_update%mat_tau(op%Fshift(iflavora)+iCdag,op%Fshift(iflavorb)+iC) = INT ( (time*op%inv_dt) +1.5d0 ) 
2224       !write(6,*) "         checkM mat_tau",INT ( (time*op%inv_dt) +1.5d0 )
2225       !write(6,*) "         checkM shifts",op%Fshift(iflavorb),iCdag,op%Fshift(iflavora),iC
2226     END DO ! iC
2227     END DO ! iflavorb
2228   END DO ! iCdag
2229   END DO ! iflavora
2230 
2231 !    CALL MatrixHyb_Print(checkMatrix)
2232   ! --- Inverse matrix
2233   CALL MatrixHyb_inverse(op%M_update)
2234 
2235 !    CALL MatrixHyb_Print(checkMatrix)
2236   do it=1,op%sumtails
2237     !write(6,*) "        checkM end M_update%mat_tau",(op%M_update%mat_tau(it,it1),it1=1,op%sumtails)
2238   enddo
2239   do it=1,op%sumtails
2240     !write(6,*) "        checkM end M_update",(op%M%mat(it,it1),it1=1,op%sumtails)
2241   enddo
2242 
2243   ! --- Compare M_update and M to check if calculation of M is correct
2244   sumMmat =0.d0
2245   sumCheck=0.d0
2246   error1 = 0.d0
2247   errormax = 0.d0
2248   checkTau = .FALSE.
2249   DO iCdag = 1, tail
2250     Do iC =1, tail
2251         errorrel= ABS((op%M_update%mat(iC, iCdag) - & 
2252                   op%M%mat(iC,iCdag))/op%M_update%mat(iC,iCdag))
2253         errorabs= ABS(op%M_update%mat(iC, iCdag) - & 
2254                   op%M%mat(iC,iCdag))
2255         IF ( errorrel .gt. errormax .and. errorabs .gt. 0.001d0 ) errormax = errorrel
2256                  ! write(6,*) "     checkM ", errorrel,errorabs
2257         IF ( op%M_update%mat_tau(iC,iCdag) .NE. op%M%mat_tau(iC,iCdag) ) then
2258                 checkTau = .TRUE.
2259                 !write(6,*) "op%M_update%mat_tau(iC,iCdag), op%M%mat_tau(iC,iCdag)",op%M_update%mat_tau(iC,iCdag), op%M%mat_tau(iC,iCdag)
2260                 !call flush(6)
2261          CALL ERROR("BathOperatoroffdiag_checkM : "//a//"%                        ") 
2262         ENDIF
2263   
2264     END DO
2265   END DO
2266 
2267   IF ( checkTau .EQV. .TRUE. ) THEN
2268     CALL WARN("BathOperatoroffdiag_checkM : mat_tau differs should be")
2269     CALL MatrixHyb_print(op%M_update,opt_print=1)
2270     CALL WARN("BathOperatoroffdiag_checkM : whereas it is")
2271     CALL MatrixHyb_print(op%M,opt_print=1)
2272   END IF
2273   op%meanError = op%meanError + errormax
2274   IF ( errormax .GT. 1.d0 ) THEN 
2275     WRITE(a,'(I4)') INT(error1*100.d0)
2276     !write(6,'(I4)') INT(error1*100.d0)
2277 !    CALL MatrixHyb_Print(op%M)
2278     CALL WARN("BathOperatoroffdiag_checkM") 
2279   END IF
2280 !  CALL MatrixHyb_destroy(checkMatrix)
2281 END SUBROUTINE BathOperatoroffdiag_checkM

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_doCheck [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_doCheck

FUNCTION

  Just store if we perfom check for updates of M

COPYRIGHT

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

  op=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

2098 SUBROUTINE BathOperatoroffdiag_doCheck(op,opt_check)
2099 
2100 !Arguments ------------------------------------
2101 
2102 !This section has been created automatically by the script Abilint (TD).
2103 !Do not modify the following lines by hand.
2104 #undef ABI_FUNC
2105 #define ABI_FUNC 'BathOperatoroffdiag_doCheck'
2106 !End of the abilint section
2107 
2108   TYPE(BathOperatoroffdiag) , INTENT(INOUT) :: op
2109   INTEGER            , INTENT(IN   ) :: opt_check
2110   
2111   IF ( opt_check .GE. 2 ) &
2112     op%doCheck = .TRUE.
2113 END SUBROUTINE BathOperatoroffdiag_doCheck

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_getDetAdd [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_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 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

  op=bath operator
  CdagC_1=segment to be added
  position=ordered position of the Cdag time
  particle=full list of CdagC for activeFlavor

OUTPUT

  BathOperatoroffdiag_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

460 DOUBLE PRECISION  FUNCTION BathOperatoroffdiag_getDetAdd(op,CdagC_1, position, particle)
461 
462 !Arguments ------------------------------------
463 
464 !This section has been created automatically by the script Abilint (TD).
465 !Do not modify the following lines by hand.
466 #undef ABI_FUNC
467 #define ABI_FUNC 'BathOperatoroffdiag_getDetAdd'
468 !End of the abilint section
469 
470   TYPE(BathOperatoroffdiag)      , INTENT(INOUT) :: op
471   DOUBLE PRECISION, DIMENSION(1:2), INTENT(IN   ) :: CdagC_1
472   INTEGER                 , INTENT(IN   ) :: position  
473   TYPE(ListCdagC), INTENT(IN   ) :: particle(:)
474 !Local variables-------------------------------
475   INTEGER                                 :: it1
476   INTEGER                                 :: it2
477   INTEGER                                 :: it3,iflavor,iflavora,iflavorb
478   INTEGER                                 :: iflavorbegin,iflavorend
479   INTEGER                                 :: tail,tailbegin,tailend
480   INTEGER                                 :: tcheck
481   INTEGER                                 :: new_tail
482   DOUBLE PRECISION                        :: C
483   DOUBLE PRECISION                        :: Cbeta
484   DOUBLE PRECISION                        :: Cibeta
485   DOUBLE PRECISION                        :: Cdag
486   DOUBLE PRECISION                        :: Cdagbeta
487   DOUBLE PRECISION                        :: beta
488   DOUBLE PRECISION                        :: ratio
489   DOUBLE PRECISION                        :: time
490 !  TYPE(CdagC)    , POINTER, DIMENSION(:)  :: list => NULL()
491 #include "BathOperatoroffdiag_hybrid.h"
492 
493   op%antiShift = .FALSE.
494   beta     = op%beta
495   C        =  CdagC_1(C_)
496 !  Cbeta    = C.MOD.beta
497   MODCYCLE(C,beta,Cbeta)
498   Cdag     =  CdagC_1(Cdag_)
499 !  cdagbeta = Cdag.MOD.beta
500   MODCYCLE(Cdag,beta,Cdagbeta)
501 !  IF ( Cdag .GE. beta ) &
502 !    CALL ERROR("BathOperatoroffdiag_getDetAdd : bad case ...              ")
503   IF ( op%activeFlavor .LE. 0 ) &
504     CALL ERROR("BathOperatoroffdiag_getDetAdd : no active hybrid function ")
505 
506   IF ( size(particle)/=op%flavors ) &
507     CALL ERROR("BathOperatoroffdiag_getDetAdd : size of particle is erroneous ")
508  
509  ! tail is now the complete size of the F matrix Fshift(nflavors+1)
510   tail =  op%sumtails
511   new_tail = tail+1
512 !  list => particle%list
513 
514   if(op%opt_nondiag==1) then
515     iflavorbegin = 1
516     iflavorend   = op%flavors
517     tailbegin    = 1
518     tailend      = tail
519   else
520   !sui!write(6,*) "Bathoperator opt_nondiag=0"
521     iflavorbegin = op%activeflavor
522     iflavorend   = op%activeflavor
523     tailbegin    = op%Fshift(op%activeflavor)+1
524     tailend      = op%Fshift(op%activeflavor)+op%tails(op%activeflavor)
525   endif
526   
527   IF ( ((C .GT. Cdag) .AND. (position .EQ. -1)) &  ! Segment added at the end of the segment
528        .OR. ((C .LT. Cdag) .AND. (tail .EQ. 0))) THEN ! empty orbital case: only adding a segment is possible
529    ! If ones add a segment to an empty orbital or a segment at the end
530    ! of a segment, then:
531     op%updatePosRow = op%tails(op%activeFlavor) + 1
532     op%updatePosCol = op%tails(op%activeFlavor) + 1
533   ELSE
534    ! For all the other cases, ABS(position) is the true position.
535     op%updatePosRow  = ABS(position)
536     op%updatePosCol  = ABS(position)
537   END IF
538     !write(6,*) "       BathOperatoroffdiag_getDetAdd : op%updatePosRow",op%updatePosRow
539     !write(6,*) "       BathOperatoroffdiag_getDetAdd : op%updatePosCol",op%updatePosCol
540     !write(6,*) "       BathOperatoroffdiag_getDetAdd : C,Cdag",C,Cdag
541   
542   IF ( C .LT. Cdag .AND. op%tails(op%activeFlavor) .GT. 0) THEN ! only if an antisegment is added
543   !  ratio = -ratio 
544     op%updatePosRow  = (op%updatePosRow + 1) !position in [1;tail]
545   ! If the antisegment created is such that a segment with tcdagger> tc
546   ! is suppressed
547     !write(6,*) "       BathOperatoroffdiag_getDetAdd : op%updatePosRow",op%updatePosRow
548     !write(6,*) "       BathOperatoroffdiag_getDetAdd : op%updatePosCol",op%updatePosCol
549     IF ( Cdagbeta .LT. particle(op%activeFlavor)%list(op%updatePosCol,Cdag_) ) op%antiShift = .TRUE.
550   END IF
551 
552 !  CALL Vector_setSize(op%R,tail)
553 !  CALL Vector_setSize(op%Q,tail)
554   Vector_QuickResize(op%R,new_tail)
555   Vector_QuickResize(op%Q,new_tail)
556   Vector_QuickResize(op%Rtau,new_tail)
557   Vector_QuickResize(op%Qtau,new_tail)
558 
559 !  This loop compute all Row and Col except op%updatePosRow
560   tcheck=0
561   DO iflavor = iflavorbegin,iflavorend
562     !write(6,*) "       BathOperatoroffdiag_getDetAdd : tails(iflavor)",iflavor,op%tails(iflavor)
563   DO it1 = 1, op%tails(iflavor)
564     tcheck=tcheck+1
565     it2 = it1
566     it3 = it1
567     IF ( iflavor .GE. op%activeFlavor ) THEN
568       it2 = it1 + 1
569       it3 = it1 + 1
570       IF ( iflavor .EQ. op%activeFlavor .AND. it1 .LT. op%updatePosRow ) it2 = it1
571       IF ( iflavor .EQ. op%activeFlavor .AND. it1 .LT. op%updatePosCol ) it3 = it1
572     !it2 = it1 + ( 1+SIGN(1,it1-op%updatePosRow) )/2
573     !it3 = it1 + ( 1+SIGN(1,it1-op%updatePoscol) )/2
574     ! if it1>=op%updatePosRow and iflavor> activeflavor, then it2=it1+1
575     ! if it1< op%updatePosRow and iflavor> activeflavor, then it2=it1
576     END IF
577 
578     !!write(6,*) size(op%Rtau%vec)
579     !!write(6,*) size(particle(iflavor)%list,1)
580     !!write(6,*) size(particle(iflavor)%list,2)
581     !!write(6,*) size(op%Fshift)
582     !!write(6,*) it1,Cdag_,op%Fshift(iflavor)+it2
583     op%Rtau%vec(op%Fshift(iflavor)+it2)= C - particle(iflavor)%list(it1,Cdag_)
584     !   the following line happend only for nondiag case
585     IF(op%Rtau%vec(op%Fshift(iflavor)+it2) .GT. beta) op%Rtau%vec(op%Fshift(iflavor)+it2)=op%Rtau%vec(op%Fshift(iflavor)+it2)-beta
586     !op%Rtau%vec(it1)= C - particle%list(it1,Cdag_)
587     time = Cbeta - particle(iflavor)%list(it1,Cdag_)
588     if(op%Rtau%vec(op%Fshift(iflavor)+it2)>beta) then
589     !write(6,*) "Rtau sup beta",op%Rtau%vec(op%Fshift(iflavor)+it2),C,particle(iflavor)%list(it1,Cdag_)
590     !write(6,*) time
591     stop
592     endif
593 
594 ! "BathOperatoroffdiag_hybrid" interpolates between known values of F for the
595 !  selected time.
596     iflavora=iflavor
597     iflavorb=op%activeFlavor
598 #include "BathOperatoroffdiag_hybrid"
599 
600     op%R%vec(op%Fshift(iflavor)+it1) = hybrid
601 !    op%R%vec(it) = BathOperatoroffdiag_hybrid(op, Cbeta - list(it)%Cdag)
602 !    Cibeta = list(it)%C.MOD.beta
603     MODCYCLE(particle(iflavor)%list(it1,C_),beta,Cibeta)
604     time = Cibeta - Cdagbeta
605     op%Qtau%vec(op%Fshift(iflavor)+it3)= time
606     !op%Qtau%vec(it1)= time
607 
608     iflavora=op%activeFlavor
609     iflavorb=iflavor
610 #include "BathOperatoroffdiag_hybrid"
611     op%Q%vec(op%Fshift(iflavor)+it1) = hybrid
612 
613     !op%Q%vec(it3) = hybrid
614 !    Q(it) = BathOperatoroffdiag_hybrid(op, Cibeta - Cdagbeta)
615   END DO
616   END DO
617   if(tcheck.ne.tail) then
618     !write(6,*) " PRB in the loop tail tcheck",tail,tcheck
619     stop
620   endif
621 
622   ! Compute S
623   op%Stau = C - Cdagbeta 
624   op%Rtau%vec(op%Fshift(op%activeFlavor)+op%updatePosRow) = op%Stau
625     if(op%Rtau%vec(op%Fshift(op%activeFlavor)+op%updatePosRow)>beta) then
626     !write(6,*) "Rtau sup beta", op%Stau,C,Cdagbeta
627     stop
628     endif
629   op%Qtau%vec(op%Fshift(op%activeFlavor)+op%updatePosCol) = op%Rtau%vec(op%Fshift(op%activeFlavor)+op%updatePosRow)
630   !write(6,*) "              getdetAdd op%Stau",op%Stau
631 
632   time = Cbeta-Cdagbeta
633   !write(6,*) "              getdetAdd time",time
634   iflavora=op%activeFlavor
635   iflavorb=op%activeFlavor
636   !write(6,*) "time",time
637 #include "BathOperatoroffdiag_hybrid"
638   !write(6,*) "hybrid",hybrid
639   op%S = hybrid
640   !write(6,*) "              getdetAdd hybrid=op%S",hybrid
641 
642   !ratio = op%S - DOT_PRODUCT(MATMUL(op%R%vec(1:tail),op%M(op%activeFlavor)%mat(1:tail,1:tail)),op%Q%vec(1:tail))
643 
644   ! product of matrix R and M(k) is computed now:
645   ratio = 0.d0
646   DO it1 = tailbegin, tailend
647     time = 0.d0
648     DO it2 = tailbegin, tailend
649       time = time + op%R%vec(it2) * op%M%mat(it2,it1)
650     END DO
651     ratio = ratio + op%Q%vec(it1) * time
652   END DO
653   !sui!write(6,*) "        = R Matrix",tail
654   !sui!write(6,*) "        R      ",(op%R%vec(it1),it1=1,tail)
655   !sui!write(6,*) "        = Q Matrix",tail
656   !sui!do it1=1,tail
657   !sui!write(6,*) "        Q      ",op%Q%vec(it1)
658   !sui!enddo
659   !sui!write(6,*) "        = M Matrix",tail
660   !sui!do it2=1,tail
661   !sui!write(6,*) "        M      ",(op%M%mat(it2,it1),it1=1,tail)
662   !sui!enddo
663   !sui!write(6,*) "        RMQ    =", ratio
664   !sui!write(6,*) "         S     =", op%S
665  ratio = op%S - ratio
666  !sui!write(6,*) "         S-RMQ =", ratio
667  !sui!write(6,*) "              getdetAdd ratio",ratio
668 
669   op%Stilde = 1.d0 / ratio
670   ! If antisegment, the det ratio has to be multiplied by -1 ( sign of the signature of one
671   ! permutation line in the matrix)
672   IF ( C .LT. Cdag .AND. op%tails(op%activeFlavor) .GT. 0) THEN ! only if an antisegment is added
673     ratio=-ratio
674   ENDIF
675 
676   ! This IF is the LAST "NON CORRECTION" in my opinion this should not appears.
677 !  IF ( MAX(C,Cdag) .GT. op%beta ) THEN
678 !    WRITE(*,*) op%Stilde
679 !    op%Stilde = - ABS(op%Stilde)
680 !  END IF
681   BathOperatoroffdiag_getDetAdd = ratio
682       !write(6,*) " getdetAdd",ratio,BathOperatoroffdiag_getDetAdd
683   op%MAddFlag   = .TRUE.
684 !#ifdef CTQMC_CHECK
685 !  op%ListCdagC = particle
686 !!write(*,*) op%Stilde
687 !!write(*,*) op%antishift
688 !!write(*,*)    op%updatePosRow 
689 !!write(*,*)    op%updatePosCol 
690 !#endif
691 
692 END FUNCTION BathOperatoroffdiag_getDetAdd

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_getDetF [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_getDetF

FUNCTION

  Compute the determinant of the F matrix
  using the hybridization of flavor and the 
  segments of particle
  used for Gloval moves only

COPYRIGHT

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

  op=bath operator
  flavor=hybridization function to take
  particles=segments to use

OUTPUT

  BathOperatoroffdiag_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

825 DOUBLE PRECISION FUNCTION BathOperatoroffdiag_getDetF(op,particle,option)
826 
827 !Arguments ------------------------------------
828 
829 !This section has been created automatically by the script Abilint (TD).
830 !Do not modify the following lines by hand.
831 #undef ABI_FUNC
832 #define ABI_FUNC 'BathOperatoroffdiag_getDetF'
833 !End of the abilint section
834 
835   TYPE(BathOperatoroffdiag)       , INTENT(INOUT)      :: op
836   TYPE(ListCdagC), OPTIONAL, INTENT(IN   )  :: particle(:)
837   INTEGER , optional :: option
838 !Local arguments-------------------------------
839   INTEGER :: iCdag
840   INTEGER :: iC
841   INTEGER :: tail
842   DOUBLE PRECISION :: time
843   DOUBLE PRECISION :: tC
844   DOUBLE PRECISION :: tCdag
845   DOUBLE PRECISION :: beta
846   DOUBLE PRECISION :: mbeta_two
847   DOUBLE PRECISION :: signe
848   DOUBLE PRECISION :: inv_dt
849   INTEGER :: iflavor,iflavora
850   INTEGER :: iflavordag,iflavorb
851 #include "BathOperatoroffdiag_hybrid.h"
852 
853   BathOperatoroffdiag_getDetF = 1.d0 ! pour eviter des divisions par 0
854   IF ( PRESENT( particle ) ) THEN
855     tail = op%sumtails
856     beta = op%beta
857     mbeta_two = -beta*0.5d0
858     inv_dt =  op%inv_dt
859     CALL MatrixHyb_setSize(op%M_update,tail)
860     DO iflavordag=1,op%flavors
861     DO iCdag = 1, op%tails(iflavordag)
862       tCdag  = particle(iflavordag)%list(iCdag,Cdag_)
863       DO iflavor=1,op%flavors
864       DO iC  = 1, op%tails(iflavor)
865         !tC   = particle%list(C_,iC).MOD.beta
866         MODCYCLE(particle(iflavor)%list(iC,C_),beta,tC)
867         time = tC - tCdag
868         iflavora=iflavordag
869         iflavorb=iflavor
870 #include "BathOperatoroffdiag_hybrid"
871         op%M_update%mat(op%Fshift(iflavor)+iC,op%Fshift(iflavordag)+iCdag) = hybrid 
872       END DO
873       END DO
874     END DO
875     END DO
876     ! mat_tau needs to be transpose of ordered time mat (way of measuring
877     ! G(tau))
878     DO iflavor=1,op%flavors
879     DO iC  = 1, tail
880       tC   = particle(iflavor)%list(iC,C_)
881       DO iflavordag=1,op%flavors
882       DO iCdag = 1, tail
883     !sui!write(6,*) iCdag,Cdag_,size(particle(iflavordag)%list,1) 
884       !stop 
885         tCdag  = particle(iflavordag)%list(iCdag,Cdag_)
886         time = tC - tCdag
887         signe = SIGN(1.d0,time)
888         time = time + (signe-1.d0)*mbeta_two
889         op%M_update%mat_tau(op%Fshift(iflavordag)+iCdag,op%Fshift(iflavor)+iC) = INT( ( time * inv_dt ) + 1.5d0 )
890       END DO
891       END DO
892     END DO
893     END DO
894     CALL MatrixHyb_inverse(op%M_update,BathOperatoroffdiag_getDetF) ! calcul le det de la matrice et l'inverse
895   ELSE
896     if(present(option)) then
897       CALL MatrixHyb_getDet(op%M_update,BathOperatoroffdiag_getDetF) ! det M = 1/detF !
898     else
899       CALL MatrixHyb_getDet(op%M,BathOperatoroffdiag_getDetF) ! det M = 1/detF !
900     endif
901     BathOperatoroffdiag_getDetF = 1.d0 / BathOperatoroffdiag_getDetF
902   ENDIF
903 END FUNCTION BathOperatoroffdiag_getDetF

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_getDetRemove [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_getDetRemove

FUNCTION

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

COPYRIGHT

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

  op=bath operator
  position=position of segment to be removed

OUTPUT

  BathOperatoroffdiag_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

728 DOUBLE PRECISION FUNCTION BathOperatoroffdiag_getDetRemove(op,position)
729 
730 !Arguments ------------------------------------
731 
732 !This section has been created automatically by the script Abilint (TD).
733 !Do not modify the following lines by hand.
734 #undef ABI_FUNC
735 #define ABI_FUNC 'BathOperatoroffdiag_getDetRemove'
736 !End of the abilint section
737 
738   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
739 !Local arguments-------------------------------
740   INTEGER           , INTENT(IN   ) :: position  
741   INTEGER                           :: ABSposition  
742   INTEGER                           :: tail,it,it1
743 
744   IF ( op%activeFlavor .LE. 0 ) &
745     CALL ERROR("BathOperatoroffdiag_getDetRemove : no active hybrid fun  ")
746 
747   op%antiShift = .FALSE.
748   tail         = op%sumtails
749   ABSposition  = ABS(position)
750   IF ( ABSposition .GT. op%tails(op%activeFlavor) ) &
751     CALL ERROR("BathOperatoroffdiag_getDetRemove : position > M size     ")
752   op%updatePosCol = ABSposition
753   op%antiShift    = .FALSE.
754   IF ( position .GT. 0 ) THEN
755     op%updatePosRow = ABSposition
756   ELSE
757     op%updatePosRow = ABSposition+1
758     IF ( ABSposition .EQ. op%tails(op%activeFlavor) ) THEN 
759       op%antiShift = .TRUE.
760       op%updatePosRow = 1 !ABSposition - 1
761 !      op%updatePosRow = ABSposition    
762 !      IF ( op%updatePosCol .EQ. 0) op%updatePosCol = tail
763     END IF
764   ENDIF
765   op%Stilde                 = op%M%mat(op%Fshift(op%activeFlavor)+&
766 &                     op%updatePosRow,op%Fshift(op%activeFlavor)+op%updatePosCol) 
767 !sui!write(6,*) "Fshift",op%Fshift(op%activeFlavor)
768 !sui!write(6,*) "updatepos",op%updatePosRow,op%updatePosCol
769   
770  
771   op%MRemoveFlag            = .TRUE.
772        !write(6,*) "        getdetRemove",op%Stilde
773   BathOperatoroffdiag_getDetRemove = op%Stilde
774   if(position<0.and.op%tails(op%activeFlavor)>1) then
775     BathOperatoroffdiag_getDetRemove = -op%Stilde
776   endif
777   !do it=1,op%sumtails
778   !!sui!write(6,*) "        getdetRemove M",(op%M%mat(it,it1),it1=1,op%sumtails)
779   !enddo
780 !#ifdef CTQMC_CHECK
781 !  op%ListCdagC = particle
782 !!write(*,*) op%updatePosRow, op%updatePosCol, position
783 !!CALL ListCdagC_print(particle)
784 !#endif
785 
786 END FUNCTION BathOperatoroffdiag_getDetRemove

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_getError [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_getError

FUNCTION

  compute a percentage error / checkM

COPYRIGHT

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

  op=bath operator

OUTPUT

  BathOperatoroffdiag_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

2454 DOUBLE PRECISION FUNCTION BathOperatoroffdiag_getError(op)
2455 
2456 
2457 !This section has been created automatically by the script Abilint (TD).
2458 !Do not modify the following lines by hand.
2459 #undef ABI_FUNC
2460 #define ABI_FUNC 'BathOperatoroffdiag_getError'
2461 !End of the abilint section
2462 
2463   TYPE(BathOperatoroffdiag), INTENT(IN) :: op
2464 
2465   IF ( op%doCheck .EQV. .TRUE. ) THEN
2466     BathOperatoroffdiag_getError = op%meanError / DBLE(op%checkNumber)
2467   ELSE
2468     BathOperatoroffdiag_getError = 0.d0
2469   END IF
2470 END FUNCTION BathOperatoroffdiag_getError

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_init [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_init

FUNCTION

  Initialize and allocate data

COPYRIGHT

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

  op=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

239 SUBROUTINE BathOperatoroffdiag_init(op, flavors, samples, beta, iTech,opt_nondiag)
240 
241 !Arguments ------------------------------------
242 
243 !This section has been created automatically by the script Abilint (TD).
244 !Do not modify the following lines by hand.
245 #undef ABI_FUNC
246 #define ABI_FUNC 'BathOperatoroffdiag_init'
247 !End of the abilint section
248 
249   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
250   INTEGER           , INTENT(IN   ) :: flavors
251   INTEGER           , INTENT(IN   ) :: samples
252   INTEGER           , INTENT(IN   ) :: opt_nondiag
253   DOUBLE PRECISION  , INTENT(IN   ) :: beta
254 !Local variables ------------------------------
255   INTEGER           , INTENT(IN   ) :: iTech
256   INTEGER                           :: it
257 
258   op%MAddFlag     = .FALSE.
259   op%MRemoveFlag  = .FALSE.
260   op%flavors      = flavors
261   op%opt_nondiag  = opt_nondiag
262   op%beta         = beta
263   op%samples      = samples
264   op%sizeHybrid   = samples + 1
265   op%dt      = beta / DBLE(samples)
266   op%inv_dt  = DBLE(samples) / beta
267   op%activeFlavor= 0 
268   op%updatePosRow = 0
269   op%updatePosCol = 0
270   op%iTech        = iTech
271 !#ifdef CTQMC_CHECK
272   op%checkNumber  = 0
273   op%meanError    = 0.d0
274   op%doCheck = .FALSE.
275 !#endif
276 
277   FREEIF(op%F)
278   MALLOC(op%F,(1:op%sizeHybrid+1,1:flavors,1:flavors))
279   DT_FREEIF(op%tails)
280   DT_MALLOC(op%tails,(1:op%flavors))
281   op%tails=0
282   DT_FREEIF(op%Fshift)
283   DT_MALLOC(op%Fshift,(1:op%flavors+1))
284   op%Fshift=0
285   
286   CALL Vector_init(op%R,100*op%flavors)
287   CALL Vector_init(op%Q,100*op%flavors)
288   CALL Vector_init(op%Rtau,100*op%flavors)
289   CALL Vector_init(op%Qtau,100*op%flavors)
290 
291   CALL MatrixHyb_init(op%M,op%iTech,size=Global_SIZE*op%flavors,Wmax=samples) !FIXME Should be consistent with ListCagC
292   CALL MatrixHyb_init(op%M_update,op%iTech,size=Global_SIZE*op%flavors,Wmax=samples) !FIXME Should be consistent with ListCagC
293   op%F       = 0.d0
294   op%set     = .TRUE.
295   
296 END SUBROUTINE BathOperatoroffdiag_init

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_initF [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_initF

FUNCTION

  Copy input hybridization functions from a file

COPYRIGHT

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

  op=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

1707 SUBROUTINE BathOperatoroffdiag_initF(op,ifstream)
1708 
1709 !Arguments ----------------------
1710 
1711 !This section has been created automatically by the script Abilint (TD).
1712 !Do not modify the following lines by hand.
1713 #undef ABI_FUNC
1714 #define ABI_FUNC 'BathOperatoroffdiag_initF'
1715 !End of the abilint section
1716 
1717   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
1718   INTEGER           , INTENT(IN   ) :: ifstream
1719 !Local variables ----------------
1720   INTEGER                           :: iflavor1
1721   INTEGER                           :: iflavor2                  
1722   INTEGER                           :: sample
1723 
1724   IF ( op%set .EQV. .FALSE. ) &
1725     CALL ERROR("BathOperatoroffdiag_initF : BathOperatoroffdiag not set         ")
1726 
1727   DO iflavor1=1,op%flavors
1728     DO iflavor2=2,op%flavors
1729       DO sample = 1, op%sizeHybrid
1730         READ(ifstream,*) op%F(sample,iflavor1,iflavor2)
1731       END DO
1732     END DO
1733   END DO
1734 END SUBROUTINE BathOperatoroffdiag_initF

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_printF [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_printF

FUNCTION

  print F function

COPYRIGHT

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

  op=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

1834 SUBROUTINE BathOperatoroffdiag_printF(op,ostream)
1835 
1836 !Arguments ------------------------------------
1837 
1838 !This section has been created automatically by the script Abilint (TD).
1839 !Do not modify the following lines by hand.
1840 #undef ABI_FUNC
1841 #define ABI_FUNC 'BathOperatoroffdiag_printF'
1842 !End of the abilint section
1843 
1844   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
1845   INTEGER,OPTIONAL  , INTENT(IN   ) :: ostream
1846 !Local variables ------------------------------
1847   CHARACTER(LEN=4)                  :: aflavor
1848   CHARACTER(LEN=50)                  :: string
1849   INTEGER                           :: iflavor1
1850   INTEGER                           :: iflavor2
1851   INTEGER                           :: sample
1852   INTEGER                           :: ostream_val
1853 
1854   IF ( PRESENT(ostream) ) THEN 
1855     ostream_val = ostream
1856   ELSE  
1857     ostream_val = 65
1858     OPEN(UNIT=ostream_val, FILE="F.dat")
1859   END IF
1860 
1861   WRITE(aflavor,'(I4)') (op%flavors*op%flavors+1)
1862   string = '(1x,'//TRIM(ADJUSTL(aflavor))//'E22.14)'
1863   DO sample = 1, op%sizeHybrid
1864     WRITE(ostream_val,string) (sample-1)*op%dt, ((op%F(sample,iflavor1,iflavor2),&
1865                                                  iflavor1=1,op%flavors),iflavor2=1,op%flavors)
1866   END DO
1867   !CALL FLUSH(ostream_val)
1868 
1869   IF ( .NOT. PRESENT(ostream) ) &
1870     CLOSE(ostream_val)
1871 
1872 END SUBROUTINE BathOperatoroffdiag_printF

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_printM [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_printM

FUNCTION

  print M =F^{-1} matrix

COPYRIGHT

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

  op=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

1907 SUBROUTINE BathOperatoroffdiag_printM(op,ostream)
1908 
1909 !Arguments ------------------------------------
1910 
1911 !This section has been created automatically by the script Abilint (TD).
1912 !Do not modify the following lines by hand.
1913 #undef ABI_FUNC
1914 #define ABI_FUNC 'BathOperatoroffdiag_printM'
1915 !End of the abilint section
1916 
1917   TYPE(BathOperatoroffdiag), INTENT(IN) :: op
1918   INTEGER, OPTIONAL , INTENT(IN) :: ostream
1919 !Local variables ------------------------------
1920   INTEGER                        :: ostream_val
1921 
1922   IF ( op%activeFlavor .LE. 0 ) &
1923     CALL ERROR("BathOperatoroffdiag_printM : no active hybrid function    ")
1924   ostream_val = 6
1925   IF ( PRESENT(ostream) ) ostream_val = ostream
1926   CALL MatrixHyb_print(op%M,ostream_val)
1927 END SUBROUTINE BathOperatoroffdiag_printM

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_printM_matrix [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_printM_matrix

FUNCTION

  print M =F^{-1} matrix

COPYRIGHT

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

  op=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

1962 SUBROUTINE BathOperatoroffdiag_printM_matrix(op,ostream)
1963 
1964 !Arguments ------------------------------------
1965 
1966 !This section has been created automatically by the script Abilint (TD).
1967 !Do not modify the following lines by hand.
1968 #undef ABI_FUNC
1969 #define ABI_FUNC 'BathOperatoroffdiag_printM_matrix'
1970 !End of the abilint section
1971 
1972   TYPE(BathOperatoroffdiag), INTENT(IN) :: op
1973   INTEGER, OPTIONAL , INTENT(IN) :: ostream
1974 !Local variables ------------------------------
1975   INTEGER                        :: ostream_val
1976   INTEGER                        :: iflavor1
1977   INTEGER                        :: i1,it1,it2
1978   CHARACTER(LEN=22)              :: string
1979   CHARACTER(LEN=22)              :: string2
1980   CHARACTER(LEN=4 )              :: size
1981 
1982   WRITE(size,'(I4)') op%sumtails
1983   string ='(i2,x,i3,a,'//TRIM(ADJUSTL(size))//'(E5.2,1x))'
1984   string2 ='(6x,'//TRIM(ADJUSTL(size))//'(i6))'
1985   open(unit=222, file="M_matrix.dat")
1986   open(unit=223, file="M_matrix_tau.dat")
1987   it1=0
1988   write(222,string2) ((i1,i1=1,op%tails(iflavor1)),iflavor1=1,op%flavors)
1989   do iflavor1=1, op%flavors
1990     do i1=1, op%tails(iflavor1)
1991       it1=it1+1
1992       write(222,string) iflavor1,i1,'|',(op%M%mat(it1,it2),it2=1,op%sumtails)
1993     enddo
1994   enddo
1995 
1996 
1997 END SUBROUTINE BathOperatoroffdiag_printM_matrix

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_recomputeM [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_recomputeM

FUNCTION

  compute from scratch the M matrix 

COPYRIGHT

  Copyright (C) 2013 ABINIT group (B. Amadon)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  op=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

2315 SUBROUTINE BathOperatoroffdiag_recomputeM(op,particle,flav_i,flav_j)
2316 
2317 !Arguments ------------------------------------
2318 
2319 !This section has been created automatically by the script Abilint (TD).
2320 !Do not modify the following lines by hand.
2321 #undef ABI_FUNC
2322 #define ABI_FUNC 'BathOperatoroffdiag_recomputeM'
2323 !End of the abilint section
2324 
2325   TYPE(BathOperatoroffdiag) , INTENT(INOUT) :: op
2326   TYPE(ListCdagC)    , INTENT(IN   ) :: particle(:)
2327   INTEGER :: flav_i,flav_j
2328 !Local variables ------------------------------
2329 !  TYPE(MatrixHyb)                    :: checkMatrix
2330   LOGICAL :: checkTau
2331   INTEGER :: tail
2332   INTEGER :: iC
2333   INTEGER :: iCdag
2334   INTEGER :: aF
2335   INTEGER :: iflavora
2336   INTEGER :: iflavorb,it,it1
2337   INTEGER :: iflavora_imp
2338   INTEGER :: iflavorb_imp
2339   CHARACTER(LEN=6) :: a
2340   DOUBLE PRECISION :: time
2341   DOUBLE PRECISION :: beta
2342   DOUBLE PRECISION :: mbeta_two
2343   DOUBLE PRECISION :: errorabs
2344   DOUBLE PRECISION :: errormax
2345   DOUBLE PRECISION :: error1
2346   DOUBLE PRECISION :: errorrel
2347   DOUBLE PRECISION :: tc
2348   DOUBLE PRECISION :: tCdag
2349   DOUBLE PRECISION :: sumMmat
2350   DOUBLE PRECISION :: sumCheck
2351 #include "BathOperatoroffdiag_hybrid.h"
2352 
2353   aF = op%activeFlavor
2354   !Construction de la matrix
2355   tail = op%sumtails
2356 !  CALL MatrixHyb_init(checkMatrix,op%iTech,size=tail,Wmax=op%samples)
2357 !  CALL MatrixHyb_setSize(checkMatrix,tail)
2358 
2359   ! --- set size of the matrix
2360   CALL MatrixHyb_setSize(op%M_update,tail)
2361 
2362   ! --- compute useful quantities
2363   beta   =  op%beta
2364   mbeta_two = -beta*0.5d0
2365   op%checkNumber = op%checkNumber + 1
2366   IF ( tail .NE. op%M%tail ) THEN
2367     CALL WARN("BathOperatoroffdiag_checkM : tails are different          ")
2368     RETURN
2369   END IF
2370 
2371   do it=1,op%sumtails
2372     !write(6,*) "        checkM begin M_update%mat_tau",(op%M_update%mat_tau(it,it1),it1=1,op%sumtails)
2373   enddo
2374   ! --- build matrix
2375 !CALL ListCdagC_print(particle)
2376   DO iflavora = 1, op%flavors
2377     iflavora_imp=iflavora
2378     if(iflavora==flav_i) iflavora_imp=flav_j
2379     if(iflavora==flav_j) iflavora_imp=flav_i
2380     DO iCdag = 1, op%tails(iflavora_imp)
2381       tCdag  = particle(iflavora_imp)%list(iCdag,Cdag_)
2382         !write(6,*) "         checkM a",iflavora,tCdag
2383       DO iflavorb = 1, op%flavors
2384         iflavorb_imp=iflavorb
2385         if(iflavorb==flav_j) iflavorb_imp=flav_i
2386         if(iflavorb==flav_i) iflavorb_imp=flav_j
2387         DO iC  = 1, op%tails(iflavorb_imp)
2388           !tC   = particle%list(C_,iC).MOD.beta
2389           MODCYCLE(particle(iflavorb_imp)%list(iC,C_),beta,tC) ! tC is tC, or Tc-Beta if tc>beta
2390           !write(6,*) "         checkM b",iflavorb,tC
2391           time = tC - tCdag  ! time is positive or negative but lower than beta
2392           !write(6,*) "         checkM time",time
2393 
2394 #include "BathOperatoroffdiag_hybrid"
2395 
2396           op%M_update%mat(op%Fshift(iflavorb_imp)+iC,op%Fshift(iflavora_imp)+iCdag) = hybrid
2397 
2398           time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
2399           op%M_update%mat_tau(op%Fshift(iflavora_imp)+iCdag,op%Fshift(iflavorb_imp)+iC) = INT ( (time*op%inv_dt) +1.5d0 ) 
2400           !write(6,*) "         checkM mat_tau",INT ( (time*op%inv_dt) +1.5d0 )
2401           !write(6,*) "         checkM shifts",op%Fshift(iflavorb),iCdag,op%Fshift(iflavora),iC
2402         END DO ! iC
2403       END DO ! iflavorb
2404     END DO ! iCdag
2405   END DO ! iflavora
2406 
2407 !    CALL MatrixHyb_Print(checkMatrix)
2408   ! --- Inverse matrix
2409   CALL MatrixHyb_inverse(op%M_update)
2410 
2411 !    CALL MatrixHyb_Print(checkMatrix)
2412   do it=1,op%sumtails
2413     !write(6,*) "        checkM end M_update%mat_tau",(op%M_update%mat_tau(it,it1),it1=1,op%sumtails)
2414   enddo
2415   do it=1,op%sumtails
2416     !write(6,*) "        checkM end M_update",(op%M%mat(it,it1),it1=1,op%sumtails)
2417   enddo
2418 
2419   ! --- Compare M_update and M to check if calculation of M is correct
2420 END SUBROUTINE BathOperatoroffdiag_recomputeM

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_reset [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_reset

FUNCTION

  Reset all internal variables

COPYRIGHT

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

  op=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

329 SUBROUTINE BathOperatoroffdiag_reset(op)
330 
331 !Arguments ------------------------------------
332 
333 !This section has been created automatically by the script Abilint (TD).
334 !Do not modify the following lines by hand.
335 #undef ABI_FUNC
336 #define ABI_FUNC 'BathOperatoroffdiag_reset'
337 !End of the abilint section
338 
339   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
340 !Local variables ------------------------------
341   INTEGER                           :: iflavor
342   op%MAddFlag     = .FALSE.
343   op%MRemoveFlag  = .FALSE.
344   op%activeFlavor = 0 
345   op%updatePosRow = 0
346   op%updatePosCol = 0
347 !#ifdef CTQMC_CHECK
348   op%checkNumber  = 0
349   op%meanError    = 0.d0
350   op%sumtails    = 0
351 !#endif
352   op%doCheck = .FALSE.
353   CALL Vector_clear(op%R)
354   CALL Vector_clear(op%Q)
355   CALL Vector_clear(op%Rtau)
356   CALL Vector_clear(op%Qtau)
357 
358   CALL MatrixHyb_clear(op%M) !FIXME Should be consistent with ListCagC
359   op%F       = 0.d0
360   do iflavor=1,op%flavors
361     op%tails(iflavor)=0
362     op%Fshift(iflavor)=0
363   enddo
364 
365 END SUBROUTINE BathOperatoroffdiag_reset

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_setF [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_setF

FUNCTION

  Copy F from input array

COPYRIGHT

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

  op=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

1768 SUBROUTINE BathOperatoroffdiag_setF(op,F)
1769 
1770 !Arguments ------------------------------------
1771 
1772 !This section has been created automatically by the script Abilint (TD).
1773 !Do not modify the following lines by hand.
1774 #undef ABI_FUNC
1775 #define ABI_FUNC 'BathOperatoroffdiag_setF'
1776 !End of the abilint section
1777 
1778   TYPE(BathOperatoroffdiag)               , INTENT(INOUT) :: op
1779   DOUBLE PRECISION, DIMENSION(:,:,:) , INTENT(IN   ) :: F
1780 !Arguments ------------------------------------
1781   INTEGER                                          :: iflavor1
1782   INTEGER                                          :: iflavor2
1783   INTEGER                                          :: sample
1784   INTEGER                                          :: length
1785 
1786   IF ( op%set .EQV. .FALSE. ) &
1787     CALL ERROR("BathOperatoroffdiag_setF : BathOperatoroffdiag not set          ")
1788 
1789  length  = SIZE(F)
1790   IF ( length .NE. (op%flavors * op%flavors * op%sizeHybrid) ) &
1791     CALL ERROR("BathOperatoroffdiag_setF : wrong input F                 ")
1792 
1793   DO iflavor1=1,op%flavors
1794     DO iflavor2=1,op%flavors
1795       DO sample = 1, op%sizeHybrid
1796       op%F(sample,iflavor1,iflavor2) = F(sample,iflavor1,iflavor2)
1797       END DO
1798     END DO
1799   END DO
1800 END SUBROUTINE BathOperatoroffdiag_setF

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_setMAdd [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_setMAdd

FUNCTION

  Update de M matrix inserting a row and a column

COPYRIGHT

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

  op=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

 937 SUBROUTINE BathOperatoroffdiag_setMAdd(op,particle) 
 938 
 939 !Arguments ------------------------------------
 940 
 941 !This section has been created automatically by the script Abilint (TD).
 942 !Do not modify the following lines by hand.
 943 #undef ABI_FUNC
 944 #define ABI_FUNC 'BathOperatoroffdiag_setMAdd'
 945 !End of the abilint section
 946 
 947   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
 948   TYPE(ListCdagC)   , INTENT(IN   ) :: particle(:)
 949 !Local variables ------------------------------
 950   INTEGER                           :: tail
 951   INTEGER                           :: new_tail
 952   INTEGER                           :: col
 953   INTEGER                           :: col_move
 954   INTEGER                           :: row_move
 955   INTEGER                           :: row
 956   INTEGER                           :: positionRow
 957   INTEGER                           :: positionCol
 958   INTEGER                           :: aF,indice
 959   INTEGER                           :: tailb,taile
 960   DOUBLE PRECISION                  :: Stilde
 961   DOUBLE PRECISION                  :: time
 962   DOUBLE PRECISION                  :: mbeta_two
 963   DOUBLE PRECISION                  :: inv_dt
 964   TYPE(Vector) :: vec_tmp
 965   TYPE(VectorInt) :: vecI_tmp
 966   INTEGER :: m
 967   INTEGER :: count
 968   INTEGER :: i
 969   INTEGER :: j
 970   INTEGER :: p,it,it1
 971 
 972 
 973 
 974 ! ---  op%MAddFlag is put to .TRUE. in BathOperatoroffdiag_getDetAdd.
 975   IF ( op%MAddFlag .EQV. .FALSE. ) &
 976     CALL ERROR("BathOperatoroffdiag_setMAdd : MAddFlag turn off           ")
 977 
 978 ! ---  op%activeFlavor is put in ctqmc_loop
 979   aF = op%activeFlavor
 980   IF ( aF .LE. 0 ) &
 981     CALL ERROR("BathOperatoroffdiag_setMAdd : no active hybrid function   ")
 982 
 983 !!  do it=1,op%sumtails
 984     !write(6,*) "        setMAdd begin M",(op%M%mat(it,it1),it1=1,op%sumtails)
 985 !!  enddo
 986 !!  do it=1,op%sumtails
 987     !write(6,*) "        setMAdd begin M%mat_tau",(op%M%mat_tau(it,it1),it1=1,op%sumtails)
 988 !!  enddo
 989 !  old tail
 990   !write(6,*) "       BathOperatoroffdiag_setMAdd op%sumtails",op%sumtails
 991   tail = op%sumtails
 992   new_tail =  tail + 1
 993   op%tails(aF)= op%tails(aF) + 1
 994   DO indice = aF +1, op%flavors+1
 995     op%Fshift(indice) = op%Fshift(indice) + 1
 996   END DO
 997   op%sumtails = op%Fshift(op%flavors) + op%tails(op%flavors) !last slot of Fshift is the tail of full matrix
 998   !write(6,*) "       BathOperatoroffdiag_setMAdd op%sumtails",op%sumtails
 999   !write(6,*) "        setMAdd actualized Fshift",(op%Fshift(it),it=1,op%flavors+1)
1000   !write(6,*) "        setMAdd actualized tails",(op%tails(it),it=1,op%flavors)
1001   !CALL matrix_print(M)
1002 
1003   if(op%opt_nondiag==1) then
1004     tailb        = 1
1005     taile        = tail
1006   else
1007   !sui!write(6,*) "Bathoperator a opt_nondiag=0"
1008     tailb        = op%Fshift(aF)+1
1009     taile        = op%Fshift(aF)+op%tails(aF)
1010   endif
1011 
1012 ! ---  data obtained from BathOperatoroffdiag_getDetAdd
1013   PositionRow =  op%updatePosRow + op%Fshift(aF) ! position in the full matrix
1014   PositionCol =  op%updatePosCol + op%Fshift(aF) ! position in the full matrix
1015   Stilde      =  op%Stilde
1016 
1017 !  !write(6,*) "before", positionRow, positionCol
1018   !CALL MatrixHyb_print(op%M(aF),opt_print=1)
1019 ! ---  MatrixHyb_setSize
1020   !write(6,*) "       BathOperatoroffdiag_setMAdd before setsize",size(op%M%mat,1)
1021   CALL MatrixHyb_setSize(op%M,new_tail)
1022   !write(6,*) "       BathOperatoroffdiag_setMAdd after setsize",size(op%M%mat,1)
1023 
1024   ! Compute Qtilde with Q
1025   !op%Q%vec(1:tail) = (-1.d0) * MATMUL(op%M(aF)%mat(1:tail,1:tail),op%Q%vec(1:tail)) * Stilde
1026 
1027 ! ---  M*Q => Q
1028   op%Q%vec(tailb:taile) = MATMUL(op%M%mat(tailb:taile,tailb:taile),op%Q%vec(tailb:taile))
1029 
1030   !op%Q%vec(PositionRow:new_tail) = EOSHIFT(op%Q%vec(PositionRow:new_tail), SHIFT=-1, BOUNDARY=-1.d0, DIM=1)
1031 !  op%Qtau%vec(PositionCol:new_tail) = EOSHIFT(op%Qtau%vec(PositionCol:new_tail), SHIFT=-1, BOUNDARY=1.d0, DIM=1)
1032 !  op%Qtau%vec(PositionCol) = op%Stau
1033 
1034   !Compute Rtilde with R and without multiplying by Stilde
1035   !op%R%vec(1:tail) = (-1.d0) * MATMUL(op%R%vec(1:tail),op%M(aF)%mat(1:tail,1:tail))
1036 
1037 ! ---  R*M => R
1038   op%R%vec(tailb:taile) = MATMUL(op%R%vec(tailb:taile),op%M%mat(tailb:taile,tailb:taile))
1039 
1040   !op%R%vec(PositionCol:new_tail) = EOSHIFT(op%R%vec(PositionCol:new_tail), SHIFT=-1, BOUNDARY=-1.d0, DIM=1)
1041 !  op%Rtau%vec(PositionRow:new_tail) = EOSHIFT(op%Rtau%vec(PositionRow:new_tail), SHIFT=-1, BOUNDARY=1.d0, DIM=1)
1042 !  op%Rtau%vec(PositionRow) = op%Stau
1043 
1044   !Compute the new M matrix
1045   !op%M(aF)%mat(PositionRow:new_tail,1:new_tail) = &
1046   !                   EOSHIFT(op%M(aF)%mat(PositionRow:new_tail,1:new_tail),SHIFT=-1, BOUNDARY=0.d0, DIM=1)
1047   !op%M(aF)%mat(1:n12 characters (ABI_ALLOCATE) instead of 4 (FREE)ew_tail,PositionCol:new_tail) = &
1048   !                   EOSHIFT(op%M(aF)%mat(1:new_tail,PositionCol:new_tail),SHIFT=-1, BOUNDARY=0.d0, DIM=2)
1049 ! ! op%M(aF)%mat(1:new_tail,1:new_tail) =  op%M(aF)%mat(1:new_tail,1:new_tail) + &
1050 ! ! Stilde * MATMUL(RESHAPE(op%Q%vec(1:new_tail),(/ new_tail,1 /)),RESHAPE(op%R%vec(1:new_tail),(/ 1,new_tail /)))
1051 
1052   !op%M(aF)%mat_tau(PositionRow:new_tail,1:new_tail) = &
1053   !                   EOSHIFT(op%M(aF)%mat_tau(PositionRow:new_tail,1:new_tail),SHIFT=-1, BOUNDARY=0, DIM=1)
1054   !op%M(aF)%mat_tau(1:new_tail,PositionCol:new_tail) = &
1055   !                   EOSHIFT(op%M(aF)%mat_tau(1:new_tail,PositionCol:new_tail),SHIFT=-1, BOUNDARY=0, DIM=2)
1056 
1057   mbeta_two = -op%beta*0.5d0
1058   inv_dt = op%inv_dt
1059 
1060 ! ------ Shift mat_tau and update old M=Ptilde
1061   DO col=tail,1,-1  ! decreasing order to avoid overwrite of data
1062     col_move = col +  ( 1+SIGN(1,col-PositionCol) )/2
1063     ! if col>= PositionCol col_move=col+1
1064     ! if col<  PositionCol col_move=col
1065     DO row=tail,1,-1
1066       row_move = row +  ( 1+SIGN(1,row-PositionRow) )/2
1067 ! ---  times for Ptilde are kept unchanged. But we have to copy it at the right place
1068       op%M%mat_tau(row_move,col_move) =  &
1069       op%M%mat_tau(row,col)
1070 ! ---  Update Ptilde with the same indices as mat_tau
1071 ! ---  M + M*Q Stilde R*M => Ptilde => M
1072       !if(row>=tailb.and.row<=taile.and.col>=tailb.and.col<=taile) then
1073         op%M%mat(row_move,col_move) =  &
1074         op%M%mat(row,col) + op%Q%vec(row)*op%R%vec(col) * Stilde
1075       !else
1076       !  op%M%mat(row_move,col_move) = op%M%mat(row,col) 
1077       !endif
1078     END DO
1079   END DO
1080 
1081 ! ------ Add new stuff for new row
1082   DO row = 1, tail
1083     row_move = row +  ( 1+SIGN(1,row-PositionRow) )/2
1084 ! ---  M*Q Stilde => Qtilde => M with the good indices
1085     !if(row>=tailb.and.row<=taile) then
1086       op%M%mat(row_move,PositionCol) = -op%Q%vec(row)*Stilde
1087     !else
1088     !  op%M%mat(row_move,PositionCol) = op%M%mat(row,PositionCol) 
1089     !endif
1090 
1091     time = op%Rtau%vec(row) !  pourquoi Rtau et pas Qtau ici ?
1092     time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1093     ! if time>=0 time=time
1094     ! if time< 0 time=time + beta
1095 ! ---  mat_tau=int(time*L/beta+1.5)
1096     op%M%mat_tau(row,PositionCol) = INT ( (time*inv_dt) +1.5d0 )
1097     !write(6,*) "     setMadd new row", op%Rtau%vec(row),op%M%mat_tau(row,PositionCol)
1098 !    if(op%M%mat_tau(row,PositionCol)>301) then
1099 !      !write(6,*) ">301 a", time,inv_dt, op%M%mat_tau(row,PositionCol)
1100 !    time = op%Rtau%vec(row) !  pourquoi Rtau et pas Qtau ici ?
1101 !      !write(6,*) time,mbeta_two
1102 !    time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1103 !      !write(6,*) time
1104 !      !write(6,*) INT ( (time*inv_dt) +1.5d0 )
1105 !      stop
1106 !    endif
1107   END DO
1108   ! Add last time missing in the loops
1109   time = op%Rtau%vec(new_tail)
1110   time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1111   op%M%mat_tau(new_tail,PositionCol) = INT ( (time*inv_dt) +1.5d0 )
1112     !write(6,*) "     setMadd last time", op%Rtau%vec(new_tail),op%M%mat_tau(new_tail,PositionCol)
1113 !    if(op%M%mat_tau(new_tail,PositionCol)>301) then
1114 !      !write(6,*) ">301 b", time,inv_dt, op%M%mat_tau(new_tail,PositionCol)
1115 !    time = op%Rtau%vec(new_tail) !  pourquoi Rtau et pas Qtau ici ?
1116 !      !write(6,*) time,mbeta_two
1117 !    time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1118 !      !write(6,*) time
1119 !      !write(6,*) INT ( (time*inv_dt) +1.5d0 )
1120 !      stop
1121 !    endif
1122 
1123   ! Add new stuff for new col
1124   DO col = 1, tail 
1125     col_move = col +  ( 1+SIGN(1,col-PositionCol) )/2
1126 ! ---   Stilde RN => Rtilde => M
1127     !if(col>=tailb.and.col<=taile) then
1128       op%M%mat(PositionRow,col_move) = -op%R%vec(col)*Stilde
1129     !else
1130     !  op%M%mat(PositionRow,col_move) = op%M%mat(PositionRow,col) 
1131     !endif
1132     time = op%Qtau%vec(col)
1133     time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1134     op%M%mat_tau(PositionRow,col) = INT ( (time*inv_dt) +1.5d0 )
1135     !write(6,*) "     setMadd new col", op%Qtau%vec(col),op%M%mat_tau(PositionRow,col)
1136 !    if(op%M%mat_tau(PositionRow,col)>301) then
1137 !      !write(6,*) ">301 c", time,inv_dt, op%M%mat_tau(PositionRow,col)
1138 !    time = op%Qtau%vec(col) !  pourquoi Rtau et pas Qtau ici ?
1139 !      !write(6,*) time,mbeta_two
1140 !    time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1141 !      !write(6,*) time
1142 !      !write(6,*) INT ( (time*inv_dt) +1.5d0 )
1143 !      stop
1144 !    endif
1145   END DO
1146   ! Add last time missing in the loops
1147   time = op%Qtau%vec(new_tail)
1148   time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1149   op%M%mat_tau(PositionRow,new_tail) = INT ( (time*inv_dt) +1.5d0 )
1150     !write(6,*) "     setMadd last time", op%Qtau%vec(new_tail),op%M%mat_tau(PositionRow,new_tail) 
1151 !    if(op%M%mat_tau(PositionRow,new_tail)>301) then
1152 !      !write(6,*) ">301 d", time,inv_dt, op%M%mat_tau(PositionRow,new_tail)
1153 !    time = op%Qtau%vec(new_tail) !  pourquoi Rtau et pas Qtau ici ?
1154 !      !write(6,*) time,mbeta_two
1155 !    time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1156 !      !write(6,*) time
1157 !      !write(6,*) INT ( (time*inv_dt) +1.5d0 )
1158 !      stop
1159 !    endif
1160 
1161   op%M%mat(PositionRow,PositionCol) = Stilde
1162 
1163   !CALL MatrixHyb_print(op%M,opt_print=1)
1164 
1165 !  DO col = 1, new_tail
1166 !    time = op%Rtau%vec(col)
1167 !    time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1168 !    op%M(aF)%mat_tau(col,PositionCol) = INT ( (time*inv_dt) +1.5d0 )
1169 !    time = op%Qtau%vec(col)
1170 !    time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1171 !    op%M(aF)%mat_tau(PositionRow,Col) = INT ( (time*inv_dt) +1.5d0 )
1172 !    time = op%R%vec(col)*Stilde
1173 !    DO row = 1, new_tail
1174 !      op%M(aF)%mat(row,col) = op%M(aF)%mat(row,col) + op%Q%vec(row)*time
1175 !    END DO
1176 !  END DO
1177 
1178   !col_move = new_tail
1179   !col      = tail
1180   !DO col_move = new_tail, 1, -1
1181   !  IF ( col_move .EQ. positionCol ) THEN
1182   !    ! on calcule rajoute Q tilde
1183   !    !row_move = new_tail
1184   !    row      = tail 
1185   !    DO row_move = new_tail, 1, -1
1186   !      ! calcul itau
1187   !      IF ( row_move .EQ. positionRow ) THEN
1188   !        op%M(aF)%mat(row_move,col_move) = Stilde
1189   !        !time = op%Stau
1190   !      ELSE
1191   !        op%M(aF)%mat(row_move,col_move) = -op%Q%vec(row)*Stilde
1192   !        !time = op%Rtau%vec(row_move)
1193   !        row      = row      - 1 
1194   !      END IF
1195   !      !time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1196   !      !op%M(aF)%mat_tau(row_move,col_move) = INT ( (time*inv_dt) +1.5d0 )
1197   !    END DO
1198   !    ! realignement des indices
1199   !  ELSE
1200   !    ! on calcule Ptilde
1201   !    !row_move = new_tail
1202   !    row      = tail 
1203   !    DO row_move = new_tail, 1, -1
1204   !      IF ( row_move .EQ. positionRow ) THEN
1205   !        op%M(aF)%mat(row_move,col_move) = -op%R%vec(col) * Stilde
1206   !        ! calcul itau
1207   !        !time = op%Qtau%vec(col_move)
1208   !        !time = time + ( SIGN(1.d0,time) - 1.d0 )*mbeta_two
1209   !        !op%M(aF)%mat_tau(row_move,col_move) = INT ( (time*inv_dt) +1.5d0 )
1210   !      ELSE
1211   !        op%M(aF)%mat(row_move,col_move) = op%M(aF)%mat(row,col) + op%Q%vec(row)*op%R%vec(col)*Stilde
1212   !        ! copy itau
1213   !        !op%M(aF)%mat_tau(row_move,col_move) = op%M(aF)%mat_tau(row,col)
1214   !        row      = row      - 1 
1215   !      END IF
1216   !    END DO
1217   !    col      = col      - 1
1218   !  END IF
1219   !END DO
1220 !  !write(6,*) "after"
1221 !  CALL MatrixHyb_print(op%M(aF),opt_print=1)
1222 !CALL matrix_inverse(M)
1223 !CALL MatrixHyb_print(M)
1224 !CALL matrix_inverse(M)
1225 
1226   IF ( op%antiShift .EQV. .TRUE. ) THEN ! antisegment
1227   if(3==4) then
1228     CALL Vector_init(vec_tmp,new_tail)
1229     CALL VectorInt_init(vecI_tmp,new_tail)
1230   ! Shift if necessary according to op%antishift
1231   ! shift DIM=2 (col)
1232 
1233 ! For new_tail=4, the following lines transform
1234 ! M=(a,b,c,d) vith a,b,c,d column vectors into
1235 ! M=(d,a,b,c)
1236     p = new_tail - 1  ! = tail
1237     m = 1
1238 !   count increases in the loop from 0 to new_tail-1
1239     count = 0
1240     DO WHILE ( count .NE. new_tail )
1241       ! put column b in vec_tmp
1242       vec_tmp%vec(1:new_tail) = op%M%mat(1:new_tail,m)
1243       vecI_tmp%vec(1:new_tail) = op%M%mat_tau(1:new_tail,m)
1244       i = m
1245       !j = m+p
1246       MODCYCLE(m+p, new_tail, j)   ! j=m+p modulo new_tail
1247       DO WHILE (j .NE. m)
1248         op%M%mat(1:new_tail,i) = op%M%mat(1:new_tail,j)
1249         op%M%mat_tau(1:new_tail,i) = op%M%mat_tau(1:new_tail,j)
1250         i = j
1251         MODCYCLE(j+p, new_tail, j)
1252         count = count+1
1253       END DO
1254       op%M%mat(1:new_tail,i) = vec_tmp%vec(1:new_tail)
1255       op%M%mat_tau(1:new_tail,i) = vecI_tmp%vec(1:new_tail)
1256       count = count+1
1257       m = m+1
1258     END DO
1259     ! shift DIM=1 (row)
1260 
1261 !   below is similar to above but for rows instead of columns.
1262     p = new_tail - 1
1263     m = 1
1264     count = 0
1265     DO WHILE ( count .NE. new_tail)
1266       vec_tmp%vec(1:new_tail) = op%M%mat(m,1:new_tail)
1267       vecI_tmp%vec(1:new_tail) = op%M%mat_tau(m,1:new_tail)
1268       i = m
1269       !j = m+p
1270       MODCYCLE(m+p, new_tail, j)
1271       DO WHILE ( j .NE. m )
1272         op%M%mat(i,1:new_tail) = op%M%mat(j,1:new_tail)
1273         op%M%mat_tau(i,1:new_tail) = op%M%mat_tau(j,1:new_tail)
1274         i = j
1275         MODCYCLE(j+p, new_tail, j)
1276         count = count+1
1277       END DO
1278       op%M%mat(i,1:new_tail) = vec_tmp%vec(1:new_tail)
1279       op%M%mat_tau(i,1:new_tail) = vecI_tmp%vec(1:new_tail)
1280       count = count+1
1281       m = m+1
1282     END DO
1283     CALL Vector_destroy(vec_tmp)
1284     CALL VectorInt_destroy(vecI_tmp)
1285   endif
1286     !op%M(aF)%mat(1:new_tail,1:new_tail) = CSHIFT(op%M(aF)%mat(1:new_tail,1:new_tail), SHIFT=-1, DIM=1) ! Shift to the bottom
1287     !op%M(aF)%mat(1:new_tail,1:new_tail) = CSHIFT(op%M(aF)%mat(1:new_tail,1:new_tail), SHIFT=-1, DIM=2) ! Shift to the right
1288     !op%M(aF)%mat_tau(1:new_tail,1:new_tail) = CSHIFT(op%M(aF)%mat_tau(1:new_tail,1:new_tail), SHIFT=-1, DIM=1) ! Shift to the bottom
1289     !op%M(aF)%mat_tau(1:new_tail,1:new_tail) = CSHIFT(op%M(aF)%mat_tau(1:new_tail,1:new_tail), SHIFT=-1, DIM=2) ! Shift to the right
1290   !write(6,*) "        setMAdd size M%mat",size(op%M%mat,1),size(op%M%mat,2),new_tail
1291   !write(6,*) "        setMAdd arguement M%mat",aF,op%Fshift(aF)
1292   !write(6,*) "        setMAdd arguement M%mat",aF,op%Fshift(aF),op%Fshift(aF+1)
1293   do it=1,op%sumtails
1294     !write(6,*) "        setMAdd before antishift M%mat_tau",(op%M%mat_tau(it,it1),it1=1,op%sumtails)
1295   enddo
1296     op%M%mat(op%Fshift(aF)+1:op%Fshift(aF+1) , 1:new_tail) = & 
1297         CSHIFT( op%M%mat(op%Fshift(aF)+1:op%Fshift(aF+1) , 1:new_tail) , SHIFT=-1 , DIM=1) ! Shift to the bottom
1298 
1299     op%M%mat(1:new_tail , op%Fshift(aF)+1:op%Fshift(aF+1)) = &
1300         CSHIFT( op%M%mat(1:new_tail , op%Fshift(aF)+1:op%Fshift(aF+1)) , SHIFT=-1 , DIM=2) ! Shift to the right
1301 
1302     op%M%mat_tau(op%Fshift(aF)+1:op%Fshift(aF+1) , 1:new_tail) = &
1303         CSHIFT( op%M%mat_tau(op%Fshift(aF)+1:op%Fshift(aF+1) , 1:new_tail) , SHIFT=-1 , DIM=1) ! Shift to the bottom
1304 
1305     op%M%mat_tau(1:new_tail , op%Fshift(aF)+1:op%Fshift(aF+1)) = &
1306         CSHIFT( op%M%mat_tau(1:new_tail , op%Fshift(aF)+1:op%Fshift(aF+1)) , SHIFT=-1 , DIM=2) ! Shift to the right
1307   !CALL matrix_print(M)
1308   END IF
1309 
1310 !!  do it=1,op%sumtails
1311     !write(6,*) "        setMAdd end M",(op%M%mat(it,it1),it1=1,op%sumtails)
1312 !!  enddo
1313  !! do it=1,op%sumtails
1314 !!    !write(6,*) "        setMAdd end M%mat_tau",(op%M%mat_tau(it,it1),it1=1,op%sumtails)
1315  !! enddo
1316   IF ( op%doCheck .EQV. .TRUE.) THEN
1317 !#ifdef CTQMC_CHECK
1318     CALL BathOperatoroffdiag_checkM(op,particle)
1319 !#endif
1320   END IF
1321 
1322   op%MAddFlag = .FALSE.
1323 
1324 END SUBROUTINE BathOperatoroffdiag_setMAdd

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_setMRemove [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_setMRemove

FUNCTION

  delete one row and one column of the M matrix

COPYRIGHT

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

  op=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

1358 SUBROUTINE BathOperatoroffdiag_setMRemove(op,particle) 
1359 
1360 !Arguments ------------------------------------
1361 
1362 !This section has been created automatically by the script Abilint (TD).
1363 !Do not modify the following lines by hand.
1364 #undef ABI_FUNC
1365 #define ABI_FUNC 'BathOperatoroffdiag_setMRemove'
1366 !End of the abilint section
1367 
1368   TYPE(BathOperatoroffdiag), INTENT(INOUT)  :: op
1369   TYPE(ListCdagC)   , INTENT(IN   )  :: particle(:)
1370 !Local variables ------------------------------
1371   INTEGER                            :: tail,tailb,taile
1372   INTEGER                            :: new_tail
1373   INTEGER                            :: col
1374   INTEGER                            :: col_move
1375   INTEGER                            :: row_move
1376   INTEGER                            :: row
1377   INTEGER                            :: positionCol
1378   INTEGER                            :: positionRow
1379   INTEGER                            :: aF,iaf
1380   INTEGER                              :: m
1381   INTEGER                              :: count
1382   INTEGER                              :: i
1383   INTEGER                              :: j,it,it1
1384   INTEGER                              :: p
1385   DOUBLE PRECISION                   :: invStilde
1386   DOUBLE PRECISION                   :: invStilde2
1387   TYPE(VectorInt) :: vecI_tmp
1388   TYPE(Vector)    :: vec_tmp
1389 
1390   IF ( op%MRemoveFlag .EQV. .FALSE. ) &
1391     CALL ERROR("BathOperatoroffdiag_setMRemove : MRemoveFlag turn off     ")
1392   aF = op%activeFlavor
1393   IF ( aF .LE. 0 ) &
1394     CALL ERROR("BathOperatoroffdiag_setMRemove : no active hybrid func    ")
1395   do it=1,op%sumtails
1396     !write(6,*) "        setMRemove begin M",(op%M%mat(it,it1),it1=1,op%sumtails)
1397   enddo
1398   tail        =  op%sumtails
1399   new_tail    =  tail - 1
1400   op%tails(af)= op%tails(af) - 1
1401   DO iaf=af+1 , op%flavors+1
1402     op%Fshift(iaf) = op%Fshift(iaf) - 1
1403   END DO
1404   op%sumtails = op%Fshift(op%flavors) + op%tails(op%flavors)
1405   positionCol =  op%updatePosCol + op%Fshift(af)
1406   positionRow =  op%updatePosRow + op%Fshift(af)
1407   invStilde   = 1.d0 / op%Stilde
1408   if(op%opt_nondiag==1) then
1409     tailb        = 1
1410     taile        = new_tail
1411   else
1412   !sui!write(6,*) "Bathoperator c opt_nondiag=0"
1413     tailb        = op%Fshift(aF)+1
1414     taile        = op%Fshift(aF)+op%tails(aF)
1415   endif
1416 
1417 !  !write(6,*) "before", positionRow, positionCol
1418 !  CALL MatrixHyb_print(op%M(aF),opt_print=1)
1419 
1420 !  IF ( new_tail .EQ. 0 ) THEN
1421 !!    IF ( op%antiShift .EQV. .TRUE.  ) THEN
1422 !!      op%M(aF)%mat(1,1) = 1.d0/BathOperatoroffdiag_Hybrid(op, op%beta)
1423 !!      op%MRemoveFlag = .FALSE.
1424 !!      RETURN
1425 !!    END IF
1426 !    CALL MatrixHyb_clear(op%M(aF))
1427 !    op%MRemoveFlag = .FALSE.
1428 !    RETURN
1429 !  END IF
1430 
1431 !  CALL Vector_setSize(op%Q,new_tail)
1432 !  CALL Vector_setSize(op%R,new_tail)
1433   Vector_QuickResize(op%Q,new_tail)
1434   Vector_QuickResize(op%R,new_tail)
1435 
1436 !  We use R and Q as op%R%vec and op%Q%vec
1437 !  op%R%vec => op%R
1438 !  op%Q%vec => op%Q
1439 
1440   row      = 1
1441   !row_move = 1
1442   col      = 1
1443   !col_move = 1
1444   DO row_move = 1, new_tail
1445     IF ( row .EQ. positionRow ) row = row + 1
1446     IF ( col .EQ. positionCol ) col = col + 1
1447     !col = row_move + (1+SIGN(1,row_move-positionCol))/2
1448     !row = row_move + (1+SIGN(1,row_move-positionRow))/2
1449     op%R%vec(row_move) = op%M%mat(positionRow,col)
1450     op%Q%vec(row_move) = op%M%mat(row,positionCol)
1451     row      = row + 1 
1452     col      = col + 1
1453   END DO
1454 !!    op%R%vec(1:positionCol-1) = op%M(aF)%mat(positionRow,1:positionCol-1)
1455 !!    op%R%vec(positionCol:new_tail) = op%M(aF)%mat(positionRow,positionCol+1:tail)
1456 !!    op%Q%vec(1:positionRow-1) = op%M(aF)%mat(1:positionRow-1,positionCol)
1457 !!    op%Q%vec(positionRow:new_tail) = op%M(aF)%mat(positionRow+1:tail,positionCol)
1458 !write(*,*) positionRow, positionCol
1459 !CALL MatrixHyb_print(M)
1460 !CALL Vector_print(op%R)
1461 !CALL Vector_print(op%Q)
1462 !CALL ListCdagC_print(op%ListCdagC)
1463 
1464   col      = 1
1465   DO col_move = 1, new_tail 
1466     IF ( col_move .EQ. positionCol ) col = col + 1
1467     !col = col_move + (1+SIGN(1,col_move-positionCol))/2
1468     row      = 1
1469     invStilde2 = invStilde * op%R%vec(col_move)
1470     DO row_move = 1, new_tail
1471       IF ( row_move .EQ. positionRow ) row = row + 1
1472       !row = row_move + (1+SIGN(1,row_move-positionRow))/2
1473 !    Compute for all rows and cols M <= M - Q 1/S R
1474       !if(row_move>=tailb.and.row_move<=taile.and.col_move>=tailb.and.col_move<=taile) then
1475         op%M%mat(row_move,col_move) = op%M%mat(row,col) &
1476                                         - op%Q%vec(row_move)*invStilde2
1477       !else
1478       !  op%M%mat(row_move,col_move) = op%M%mat(row,col) 
1479       !endif
1480       op%M%mat_tau(row_move,col_move) = op%M%mat_tau(row,col)
1481       row      = row      + 1
1482     END DO
1483     col      = col      + 1 
1484   END DO
1485   CALL MatrixHyb_setSize(op%M,new_tail)
1486 
1487   IF ( op%antiShift .EQV. .TRUE. ) THEN ! antisegment
1488    if(3==4) then
1489     ! Shift if necessary according to op%antishift
1490     ! shift DIM=2 (col)
1491     CALL Vector_init(vec_tmp,new_tail)
1492     CALL VectorInt_init(vecI_tmp,new_tail)
1493     p = 1
1494     m = 1
1495     count = 0
1496     DO WHILE ( count .NE. new_tail )
1497       vec_tmp%vec(1:new_tail) = op%M%mat(1:new_tail,m)
1498       vecI_tmp%vec(1:new_tail) = op%M%mat_tau(1:new_tail,m)
1499       i = m
1500       !j = m+p
1501       MODCYCLE(m+p, new_tail, j)
1502       DO WHILE (j .NE. m)
1503         op%M%mat(1:new_tail,i) = op%M%mat(1:new_tail,j)
1504         op%M%mat_tau(1:new_tail,i) = op%M%mat_tau(1:new_tail,j)
1505         i = j
1506         MODCYCLE(j+p, new_tail, j)
1507         count = count+1
1508       END DO
1509       op%M%mat(1:new_tail,i) = vec_tmp%vec(1:new_tail)
1510       op%M%mat_tau(1:new_tail,i) = vecI_tmp%vec(1:new_tail)
1511       count = count+1
1512       m = m+1
1513     END DO
1514     CALL Vector_destroy(vec_tmp)
1515     CALL VectorInt_destroy(vecI_tmp)
1516     !op%M(aF)%mat(1:new_tail,1:new_tail) = &
1517     !           CSHIFT(op%M(aF)%mat(1:new_tail,1:new_tail), SHIFT=1, DIM=2) ! Shift to the top
1518     !op%M(aF)%mat_tau(1:new_tail,1:new_tail) = &
1519     !           CSHIFT(op%M(aF)%mat_tau(1:new_tail,1:new_tail), SHIFT=1, DIM=2) ! Shift to the top
1520    endif
1521     op%M%mat(1:new_tail,op%Fshift(af)+1:op%Fshift(af+1)) = &
1522                CSHIFT(op%M%mat(1:new_tail,op%Fshift(af)+1:op%Fshift(af+1)), SHIFT=1, DIM=2) ! Shift to the top
1523     op%M%mat_tau(1:new_tail,op%Fshift(af)+1:op%Fshift(af+1)) = &
1524                CSHIFT(op%M%mat_tau(1:new_tail,op%Fshift(af)+1:op%Fshift(af+1)), SHIFT=1, DIM=2) ! Shift to the top
1525   END IF
1526 !  !write(6,*) "after "
1527 !  CALL MatrixHyb_print(op%M(aF),opt_print=1)
1528 
1529   IF ( op%doCheck .EQV. .TRUE. ) THEN
1530 !#ifdef CTQMC_CHECK
1531   CALL BathOperatoroffdiag_checkM(op,particle)
1532 !#endif
1533   END IF
1534   do it=1,op%sumtails
1535     !write(6,*) "        setMRemove end M",(op%M%mat(it,it1),it1=1,op%sumtails)
1536   enddo
1537 
1538   op%MRemoveFlag = .FALSE.
1539 
1540 END SUBROUTINE BathOperatoroffdiag_setMRemove

ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_swap [ Functions ]

[ Top ] [ Functions ]

NAME

  BathOperatoroffdiag_swap

FUNCTION

  Recompute 2 M matrix swaping the segments (used for Global moves)

COPYRIGHT

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

  op=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

1575 SUBROUTINE BathOperatoroffdiag_swap(op, flavor1, flavor2)
1576 
1577 !Arguments ------------------------------------
1578 
1579 !This section has been created automatically by the script Abilint (TD).
1580 !Do not modify the following lines by hand.
1581 #undef ABI_FUNC
1582 #define ABI_FUNC 'BathOperatoroffdiag_swap'
1583 !End of the abilint section
1584 
1585   TYPE(BathOperatoroffdiag), INTENT(INOUT) :: op
1586   INTEGER           , INTENT(IN   ) :: flavor1
1587   INTEGER           , INTENT(IN   ) :: flavor2
1588   INTEGER            :: ii,iflavort,itmptail,flavora,flavorb
1589   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: mat_temp
1590   INTEGER         , ALLOCATABLE, DIMENSION(:,:) :: mat_tau_temp
1591 
1592   if(flavor1>flavor2) then
1593     flavora=flavor2
1594     flavorb=flavor1
1595   else
1596     flavora=flavor1
1597     flavorb=flavor2
1598   endif
1599   MALLOC(mat_temp,(1:op%sumtails,1:op%sumtails))
1600   MALLOC(mat_tau_temp,(1:op%sumtails,1:op%sumtails))
1601   !mat_temp= op%M%mat
1602   !mat_tau_temp= op%M%mat_tau
1603   !it1=0
1604   !do iflav1=1,op%flavors
1605   !  do ii1=1,op%tails(iflav1)
1606   !    it1=it1+1
1607   !    it2=0
1608   !    do iflav2=1,op%flavors
1609   !      do ii2=1,op%tails(iflav1)
1610   !        it2=it2+1
1611   !        op%M%mat(it1,it2)=
1612   !      enddo
1613   !    enddo
1614   !  enddo
1615   !enddo
1616   if(3==3) then
1617     op%M=op%M_update
1618 !     shift block flavorb at the place of flavora (column)
1619     do ii=1, op%tails(flavorb)
1620       op%M%mat(op%Fshift(flavora)+1:op%Fshift(flavorb+1) , 1:op%sumtails) = & 
1621           CSHIFT( op%M%mat(op%Fshift(flavora)+1:op%Fshift(flavorb+1) , 1:op%sumtails) , SHIFT=-1 , DIM=1) 
1622       op%M%mat_tau(op%Fshift(flavora)+1:op%Fshift(flavorb+1) , 1:op%sumtails) = &
1623           CSHIFT( op%M%mat_tau(op%Fshift(flavora)+1:op%Fshift(flavorb+1) , 1:op%sumtails) , SHIFT=-1 , DIM=1) 
1624     enddo
1625 
1626 !     shift block flavora at the place of flavorb (column)
1627     do ii=1, op%tails(flavora)
1628       op%M%mat(op%Fshift(flavora)+op%tails(flavorb)+&
1629 &      1:op%Fshift(flavorb)+op%tails(flavorb) , 1:op%sumtails) = & 
1630           CSHIFT( op%M%mat( op%Fshift(flavora)+op%tails(flavorb)&
1631 &          +1:op%Fshift(flavorb)+op%tails(flavorb) , 1:op%sumtails) , SHIFT=1 , DIM=1) 
1632       op%M%mat_tau(op%Fshift(flavora)+op%tails(flavorb)+1:op%Fshift(flavorb)+&
1633 &      op%tails(flavorb) , 1:op%sumtails) = & 
1634           CSHIFT( op%M%mat_tau( op%Fshift(flavora)+op%tails(flavorb)+&
1635 &          1:op%Fshift(flavorb)+op%tails(flavorb) , 1:op%sumtails) , SHIFT=1 , DIM=1) 
1636     enddo
1637 
1638 !     shift block flavorb at the place of flavora (row)
1639     do ii=1, op%tails(flavorb)
1640       op%M%mat(1:op%sumtails , op%Fshift(flavora)+1:op%Fshift(flavorb+1)) = &
1641           CSHIFT( op%M%mat(1:op%sumtails , op%Fshift(flavora)+1:op%Fshift(flavorb+1)) , SHIFT=-1 , DIM=2) 
1642       op%M%mat_tau(1:op%sumtails , op%Fshift(flavora)+1:op%Fshift(flavorb+1)) = &
1643           CSHIFT( op%M%mat_tau(1:op%sumtails , op%Fshift(flavora)+1:op%Fshift(flavorb+1)) , SHIFT=-1 , DIM=2) 
1644     enddo
1645 
1646 !     shift block flavora at the place of flavorb (row)
1647     do ii=1, op%tails(flavora)
1648       op%M%mat(1:op%sumtails , op%Fshift(flavora)+op%tails(flavorb)+1:op%Fshift(flavorb)+op%tails(flavorb)) = &
1649           CSHIFT( op%M%mat(1:op%sumtails ,op%Fshift(flavora)+op%tails(flavorb)&
1650 &          +1:op%Fshift(flavorb)+op%tails(flavorb)) , SHIFT=1 , DIM=2) 
1651       op%M%mat_tau(1:op%sumtails ,op%Fshift(flavora)+op%tails(flavorb)+&
1652 &      1:op%Fshift(flavorb)+op%tails(flavorb) ) = &
1653           CSHIFT( op%M%mat_tau(1:op%sumtails ,op%Fshift(flavora)+&
1654 &          op%tails(flavorb)+1:op%Fshift(flavorb)+op%tails(flavorb) ) , SHIFT=1 , DIM=2) 
1655     enddo
1656   endif
1657   if(3==4) then
1658     op%M=op%M_update
1659   endif
1660 
1661 
1662   do iflavort=flavora+1,flavorb
1663     op%Fshift(iflavort)=op%Fshift(iflavort)+op%tails(flavorb)-op%tails(flavora)
1664   enddo
1665 
1666   itmptail=op%tails(flavora)
1667   op%tails(flavora)=op%tails(flavorb)
1668   op%tails(flavorb)=itmptail
1669   FREE(mat_temp)
1670   FREE(mat_tau_temp)
1671 
1672 END SUBROUTINE BathOperatoroffdiag_swap

m_BathOperatoroffdiag/BathOperatoroffdiag [ Types ]

[ Top ] [ m_BathOperatoroffdiag ] [ Types ]

NAME

  BathOperatoroffdiag

FUNCTION

  This structured datatype contains the necessary data

COPYRIGHT

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

 78 TYPE BathOperatoroffdiag
 79   LOGICAL :: set         = .FALSE.
 80   ! True if the BathOperatoroffdiag is initialized in BathOperatoroffdiag_init
 81 
 82   LOGICAL :: MAddFlag    = .FALSE.
 83   ! Set to true if we can compute a new M (see updateDetXX) (ie in
 84   ! BathOperatoroffdiag_getDetAdd)
 85 
 86   LOGICAL :: MRemoveFlag = .FALSE. 
 87   ! Set to true if we can compute a new M (see updateDetXX) (ie in
 88   ! BathOperatoroffdiag_getDetRemove)
 89 
 90   LOGICAL :: antiShift   = .FALSE. 
 91   ! shift when M is updated with antiseg
 92 
 93   LOGICAL :: doCheck     = .FALSE.
 94   ! TRUE is checks are activated
 95 
 96   INTEGER :: opt_nondiag = 0
 97 ! if opt_nondiag = 1 F is non diagonal.
 98 
 99   INTEGER :: flavors
100 ! number of flavors
101 ! if opt_nondiag = 0 , flavors= number of flavor
102 ! if opt_nondiag = 1 , flavors= 1
103 
104   INTEGER :: activeFlavor
105   ! Active flavor on which a segment is added/suppressed...
106 
107   INTEGER :: samples
108   ! Number of time slices (given in the input file)
109 
110   INTEGER :: sizeHybrid
111   ! Number of time slices (given in the input file) + 1 (=qmc_l+1)
112 
113   INTEGER :: updatePosRow
114   ! Gives the position of new Row to add
115   ! Modified in  BathOperatoroffdiag_getDetAdd and  BathOperatoroffdiag_getDetRemove
116   ! could be the Row in the Full matrix for the non diag implementation
117 
118   INTEGER :: updatePosCol
119   ! Gives the position of new Col to add
120   ! Modified in  BathOperatoroffdiag_getDetAdd and  BathOperatoroffdiag_getDetRemove
121 
122   INTEGER :: iTech
123   ! iTech is an integer which precise the technics used to compute the
124   ! Green's function (in time or frequency)
125 
126   INTEGER :: sumtails
127   !  size of the full F matrix (sums of tails(iflavor) over iflavor)
128 
129   INTEGER,          ALLOCATABLE, DIMENSION(:) :: tails
130   ! tails(iflavor) is the current number of segments for the flavor iflavor
131 
132   INTEGER,          ALLOCATABLE, DIMENSION(:) :: Fshift
133   ! Fshift(iflavor) is the sum of number of segments for all flavors iflavor2
134   ! such that iflavor< iflavor
135   ! It is thus the shift in the F matrix to have the first segment of the flavor
136   ! iflavor
137   ! Fshift(nflavor+1) is the total nb of tails (=sumtails) 
138 
139   DOUBLE PRECISION                            :: beta
140   ! Inverse of Temperature
141   ! 
142 
143   DOUBLE PRECISION                            :: dt
144   ! dt=beta/samples
145 
146   DOUBLE PRECISION                            :: inv_dt
147   ! inv_dt=1/dt
148 
149   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:)   :: F ! qmc_l+2,Flavors
150   ! Hybridization function F(1:op%sizeHybrid+1,1:flavors,1:flavors)
151 
152   DOUBLE PRECISION                            :: S
153   ! Sherman Morrison notations 
154 
155   DOUBLE PRECISION                            :: Stau
156   ! Sherman Morrison notations 
157 
158   DOUBLE PRECISION                            :: Stilde
159   ! Sherman Morrison notations 
160 
161   TYPE(Vector)                                :: R 
162   ! Sherman Morrison notations R%vec(size).
163   ! computed for each flavor (As matrices are made of Blocks for each
164   ! flavor because the code is restricted to diagonal F matrices)
165 
166   TYPE(Vector)                                :: Q 
167   ! Sherman Morrison notations 
168   ! computed for each flavor (As matrices are made of Blocks for each
169   ! flavor because the code is restricted to diagonal F matrices)
170 
171   TYPE(Vector)                                :: Rtau
172   ! Sherman Morrison notations 
173   ! Rtau gives the time length for each elements of R
174   ! computed for each flavor (As matrices are made of Blocks for each
175   ! flavor because the code is restricted to diagonal F matrices)
176 
177   TYPE(Vector)                                :: Qtau
178   ! Sherman Morrison notations 
179   ! Qtau gives the time length for each elements of Q
180   ! computed for each flavor (As matrices are made of Blocks for each
181   ! flavor because the code is restricted to diagonal F matrices)
182 
183   TYPE(MatrixHyb)                             :: M  ! Flavors
184   ! inverse of  Hybridization matrix  M%mat(global_size,global_size)
185   ! contains the value of the hybridization for all flavor and segments times, 
186   ! the times (mat_tau), and possibly the
187   ! frequency
188 
189   TYPE(MatrixHyb)                             :: M_update  ! Flavors
190   !  used in BathOperatoroffdiag_getdetF and in BathOperatoroffdiag_checkM
191   ! for checks 
192 
193 !#ifdef CTQMC_CHECK
194   INTEGER                                     :: checkNumber
195   DOUBLE PRECISION                            :: meanError
196 !  TYPE(ListCdagC)                             :: ListCdagC 
197 !#endif
198 END TYPE BathOperatoroffdiag