TABLE OF CONTENTS
- ABINIT/m_BathOperatoroffdiag
- ABINIT/m_BathOperatoroffdiag/ BathOperatoroffdiag_destroy
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_activateParticle
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_checkM
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_doCheck
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_getDetAdd
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_getDetF
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_getDetRemove
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_getError
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_init
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_initF
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_printF
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_printM
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_printM_matrix
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_recomputeM
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_reset
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_setF
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_setMAdd
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_setMRemove
- ABINIT/m_BathOperatoroffdiag/BathOperatoroffdiag_swap
- m_BathOperatoroffdiag/BathOperatoroffdiag
ABINIT/m_BathOperatoroffdiag [ 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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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 ]
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