TABLE OF CONTENTS


ABINIT/m_Ctqmcoffdiag [ Modules ]

[ Top ] [ Modules ]

NAME

  m_Ctqmcoffdiag

FUNCTION

  Manage and drive all the CTQMC
  Should not be used if you don't know what you do
  Please use CtqmcoffdiagInterface

COPYRIGHT

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

NOTES

SOURCE

24 #include "defs.h"
25 #define CTQMC_SLICE1 100
26 ! Coupe Sweeps en 100
27 #define CTQMC_SLICE2 100
28 ! Coupe modNoise1 en 2000
29 #define CTQMC_SEGME  1
30 #define CTQMC_ANTIS -2
31 #define CTQMC_ADDED  3  
32 #define CTQMC_REMOV  4
33 #define CTQMC_DETSI  5
34 MODULE m_Ctqmcoffdiag
35 
36  USE m_Global
37  USE m_GreenHyboffdiag
38  USE m_BathOperatoroffdiag
39  USE m_ImpurityOperator
40  USE m_Stat
41  USE m_FFTHyb
42  USE m_OurRng
43 #ifdef HAVE_MPI2
44  USE mpi
45 #endif
46  IMPLICIT NONE
47 
48  public :: Ctqmcoffdiag_init
49  public :: Ctqmcoffdiag_setParameters
50  public :: Ctqmcoffdiag_setSweeps
51  public :: Ctqmcoffdiag_setSeed
52  public :: Ctqmcoffdiag_allocateAll
53  public :: Ctqmcoffdiag_allocateOpt
54  public :: Ctqmcoffdiag_setG0wTab
55  public :: Ctqmcoffdiag_setU
56  public :: Ctqmcoffdiag_clear
57  public :: Ctqmcoffdiag_reset
58  public :: Ctqmcoffdiag_setMu
59  public :: Ctqmcoffdiag_computeF
60  public :: Ctqmcoffdiag_run
61  public :: Ctqmcoffdiag_tryAddRemove
62  public :: Ctqmcoffdiag_trySwap
63  public :: Ctqmcoffdiag_measN
64  public :: Ctqmcoffdiag_measCorrelation
65  public :: Ctqmcoffdiag_measPerturbation
66  public :: Ctqmcoffdiag_getResult
67  public :: Ctqmcoffdiag_symmetrizeGreen
68  public :: Ctqmcoffdiag_getGreen
69  public :: Ctqmcoffdiag_getD
70  public :: Ctqmcoffdiag_getE
71  public :: Ctqmcoffdiag_printAll
72  public :: Ctqmcoffdiag_printQMC
73  public :: Ctqmcoffdiag_printGreen
74  public :: Ctqmcoffdiag_printD
75  public :: Ctqmcoffdiag_printE
76  public :: Ctqmcoffdiag_printPerturbation
77  public :: Ctqmcoffdiag_printCorrelation
78  public :: Ctqmcoffdiag_printSpectra
79  public :: Ctqmcoffdiag_destroy

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_allocateAll [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_allocateAll

FUNCTION

  Allocate all non option variables

COPYRIGHT

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

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

644 SUBROUTINE Ctqmcoffdiag_allocateAll(op)
645 
646 !Arguments ------------------------------------
647   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
648 !Local variables ------------------------------
649   INTEGER                  :: flavors
650 
651   IF ( .NOT. op%para ) &
652     CALL ERROR("Ctqmcoffdiag_allocateAll : Ctqmcoffdiag_setParameters never called  ")
653 
654   flavors = op%flavors
655 
656 
657 !  number of electrons
658   FREEIF(op%measN)
659   MALLOC(op%measN,(1:4,1:flavors))
660   op%measN = 0.d0
661 
662 !  double occupancies 
663   FREEIF(op%measDE)
664   MALLOC(op%measDE,(1:flavors,1:flavors) )
665   op%measDE = 0.d0
666 
667   FREEIF(op%mu)
668   MALLOC(op%mu,(1:flavors) )
669   op%mu = 0.d0
670   FREEIF(op%hybri_limit)
671   MALLOC(op%hybri_limit,(flavors,flavors) )
672   op%hybri_limit = czero
673 END SUBROUTINE Ctqmcoffdiag_allocateAll

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_allocateOpt [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_allocateOpt

FUNCTION

  allocate all option variables 

COPYRIGHT

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

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

701 SUBROUTINE Ctqmcoffdiag_allocateOpt(op)
702 
703 !Arguments ------------------------------------
704   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
705 !Local variables ------------------------------
706   INTEGER :: i
707   INTEGER :: j
708   INTEGER :: k
709 
710   IF ( .NOT. op%para ) &
711     CALL ERROR("Ctqmcoffdiag_allocateOpt : Ctqmcoffdiag_setParameters never called  ")
712 
713   IF ( op%opt_analysis .EQ. 1 ) THEN
714     FREEIF(op%measCorrelation)
715     MALLOC(op%measCorrelation,(1:op%samples+1,1:3,1:op%flavors))
716     op%measCorrelation = 0.d0
717   END IF
718 
719   IF ( op%opt_order .GT. 0 ) THEN
720     FREEIF(op%measPerturbation)
721     MALLOC(op%measPerturbation,(1:op%opt_order,1:op%flavors))
722     op%measPerturbation = 0.d0
723     FREEIF(op%meas_fullemptylines)
724     MALLOC(op%meas_fullemptylines,(2,1:op%flavors))
725     op%meas_fullemptylines = 0.d0
726   END IF
727 
728   IF ( op%opt_histo .GT. 0 ) THEN
729     FREEIF(op%occup_histo_time)
730     MALLOC(op%occup_histo_time,(1:op%flavors+1))
731     op%occup_histo_time= 0.d0
732   END IF
733 
734   IF ( op%opt_noise .EQ. 1 ) THEN
735     IF ( ALLOCATED(op%measNoiseG) ) THEN
736       DO i=1,2
737         DO j = 1, op%flavors
738           DO k= 1, op%samples+1
739             CALL Vector_destroy(op%measNoiseG(k,j,i))
740           END DO
741         END DO
742       END DO
743       DT_FREE(op%measNoiseG)
744     END IF
745     DT_MALLOC(op%measNoiseG,(1:op%samples+1,1:op%flavors,1:2))
746     !DO i=1,2
747       DO j = 1, op%flavors
748         DO k= 1, op%samples+1
749           CALL Vector_init(op%measNoiseG(k,j,1),CTQMC_SLICE1)
750         END DO
751       END DO
752       DO j = 1, op%flavors
753         DO k= 1, op%samples+1
754           CALL Vector_init(op%measNoiseG(k,j,2),CTQMC_SLICE1*CTQMC_SLICE2+1) ! +1 pour etre remplacer ceil
755         END DO
756       END DO
757     !END DO
758     FREEIF(op%abNoiseG)
759     MALLOC(op%aBNoiseG,(1:2,1:op%samples+1,op%flavors))
760     op%abNoiseG = 0.d0
761   END IF
762 
763   IF (op%opt_spectra .GE. 1 ) THEN
764     FREEIF(op%density)
765     !MALLOC(op%density,(1:op%thermalization,1:op%flavors))
766     i = CEILING(DBLE(op%thermalization+op%sweeps)/DBLE(op%measurements*op%opt_spectra))
767     MALLOC(op%density,(1:op%flavors+1,1:i))
768     op%density = 0.d0
769   END IF
770 !#endif
771 END SUBROUTINE Ctqmcoffdiag_allocateOpt

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_clear [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_clear

FUNCTION

  clear a ctqmc run

COPYRIGHT

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

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

 982 SUBROUTINE Ctqmcoffdiag_clear(op)
 983 
 984 !Arguments ------------------------------------
 985   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
 986 !Local variables ------------------------------
 987   INTEGER :: i
 988   INTEGER :: j
 989   INTEGER :: k
 990 
 991   op%measN(1,:) = 0.d0
 992   op%measN(2,:) = 0.d0
 993   !Do not set measN(3,:) to 0 to avoid erasing N between therm and ctqmc
 994   op%measN(4,:) = 0.d0
 995   op%measDE = 0.d0
 996 !  op%seg_added    = 0.d0
 997 !  op%anti_added   = 0.d0
 998 !  op%seg_removed  = 0.d0
 999 !  op%anti_removed = 0.d0
1000 !  op%seg_sign     = 0.d0
1001 !  op%anti_sign    = 0.d0
1002   op%stats(:)     = 0.d0
1003 !  op%signvaluecurrent    = 0.d0
1004 !  op%signvaluemeas    = 0.d0
1005   op%swap         = 0.d0
1006   op%runTime      = 0.d0
1007   op%modGlobalMove(2) = 0 
1008   CALL Vector_clear(op%measNoise(1))
1009   CALL Vector_clear(op%measNoise(2))
1010 !#ifdef CTCtqmcoffdiag_CHECK
1011   op%errorImpurity = 0.d0
1012   op%errorBath     = 0.d0
1013 !#endif
1014   CALL GreenHyboffdiag_clear(op%Greens)
1015 !#ifdef CTCtqmcoffdiag_ANALYSIS
1016   IF ( op%opt_analysis .EQ. 1 .AND. ALLOCATED(op%measCorrelation) ) &    
1017     op%measCorrelation = 0.d0 
1018   IF ( op%opt_order .GT. 0 .AND. ALLOCATED(op%measPerturbation) ) &
1019     op%measPerturbation = 0.d0
1020   IF ( op%opt_order .GT. 0 .AND. ALLOCATED(op%meas_fullemptylines) ) &
1021     op%meas_fullemptylines = 0.d0
1022   IF ( op%opt_noise .EQ. 1 .AND. ALLOCATED(op%measNoiseG) ) THEN
1023     DO i=1,2
1024       DO j = 1, op%flavors
1025         DO k= 1, op%samples+1
1026           CALL Vector_clear(op%measNoiseG(k,j,i))
1027         END DO
1028       END DO
1029     END DO
1030     !DO j = 1, op%flavors
1031     !  CALL GreenHyboffdiag_clear(op%Greens(j))
1032     !END DO
1033   END IF
1034 !#endif
1035 END SUBROUTINE Ctqmcoffdiag_clear

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_computeF [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_computeF

FUNCTION

  Compute the hybridization function

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  Gomega=G0 to compute F
  opt_fk=What is Gomega

OUTPUT

  F=hybridization function

SIDE EFFECTS

NOTES

SOURCE

1204 SUBROUTINE Ctqmcoffdiag_computeF(op, Gomega, F, opt_fk)
1205 
1206  use m_hide_lapack,  only : xginv
1207 !Arguments ------------------------------------
1208   TYPE(Ctqmcoffdiag)                       , INTENT(INOUT) :: op
1209   COMPLEX(KIND=8), DIMENSION(:,:,:), INTENT(IN   ) :: Gomega
1210   !INTEGER                         , INTENT(IN   ) :: Wmax
1211   DOUBLE PRECISION, DIMENSION(:,:,:), INTENT(INOUT) :: F
1212   INTEGER                         , INTENT(IN   ) :: opt_fk
1213 !Local variables ------------------------------
1214   INTEGER                                         :: flavors
1215   INTEGER                                         :: samples
1216   INTEGER                                         :: iflavor,ifl
1217   INTEGER                                         :: iflavor2
1218   INTEGER                                         :: iomega
1219   INTEGER                                         :: itau
1220   DOUBLE PRECISION                                :: pi_invBeta
1221   DOUBLE PRECISION                                :: K
1222   !DOUBLE PRECISION                                :: re
1223   !DOUBLE PRECISION                                :: im
1224   !DOUBLE PRECISION                                :: det
1225   COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE   :: F_omega
1226   COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE   :: F_omega_inv
1227   COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE   :: Gomega_tmp
1228   TYPE(GreenHyboffdiag)                                     :: F_tmp
1229   !character(len=4) :: tag_proc
1230   !character(len=30) :: tmpfil
1231   !INTEGER :: unitnb
1232 
1233   ABI_UNUSED((/opt_fk/))
1234 
1235   flavors    = op%flavors
1236 
1237   samples    = op%samples
1238   pi_invBeta = ACOS(-1.d0) / op%beta
1239   op%Wmax=SIZE(Gomega,1)
1240 !sui!write(std_out,*) "op%Wmax",op%Wmax
1241   !=================================
1242   ! --- Initialize F_tmp 
1243   !=================================
1244   IF ( op%have_MPI .EQV. .TRUE. ) THEN
1245     CALL GreenHyboffdiag_init(F_tmp,samples,op%beta,flavors,MY_COMM=op%MY_COMM)
1246   ELSE
1247     CALL GreenHyboffdiag_init(F_tmp,samples,op%beta,flavors)
1248   END IF
1249 !  K = op%mu
1250 
1251   !=================================
1252   ! --- Allocate F_omega
1253   !=================================
1254   MALLOC(F_omega,(1:op%Wmax,1:flavors,1:flavors))
1255   MALLOC(F_omega_inv,(1:flavors,1:flavors))
1256   MALLOC(Gomega_tmp,(1:op%Wmax,1:flavors,1:flavors))
1257   !op%hybri_limit(2,2)=op%hybri_limit(1,1)
1258   !op%mu(1)=op%mu(1)/10
1259   !op%mu(2)=op%mu(1)
1260   DO iomega=1,op%Wmax
1261     do iflavor=1,flavors
1262       do iflavor2=1,flavors
1263        ! Gomega_tmp(iomega,iflavor,iflavor2)=op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta))/3.d0
1264       enddo
1265     enddo
1266   END DO
1267   Gomega_tmp=Gomega
1268 
1269   !IF ( op%rank .EQ. 0 ) &
1270     !OPEN(UNIT=9876,FILE="K.dat",POSITION="APPEND")
1271   
1272   !=============================================================================================
1273   ! --- Compute Bath Green's function from Hybridization function in imaginary time
1274   !=============================================================================================
1275   !IF ( opt_fk .EQ. 0 ) THEN
1276    IF ( op%rank .EQ. 0 ) THEN
1277    !  DO iflavor = 1, flavors
1278    !    DO iflavor2 = 1, flavors
1279    !        write(330,*) "#",iflavor,iflavor2
1280    !        write(331,*) "#",iflavor,iflavor2
1281    !      do  iomega=1,op%Wmax
1282    !        write(330,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(Gomega_tmp(iomega,iflavor,iflavor2))
1283    !        write(331,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(Gomega_tmp(iomega,iflavor,iflavor2))
1284    !      enddo
1285    !        write(330,*) 
1286    !        write(331,*) 
1287    !    END DO
1288    !  END DO
1289    ENDIF
1290      DO iomega=1,op%Wmax
1291      !  be careful...here 
1292      ! Gomega in input is Fomega and 
1293      ! F_omega is   Gomega.
1294      ! COMPUTE G0 FROM F
1295        do iflavor=1,flavors
1296          do iflavor2=1,flavors
1297            if (iflavor==iflavor2) then
1298              F_omega_inv(iflavor,iflavor2)= (cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta,kind=8) &
1299 &             + op%mu(iflavor)- Gomega_tmp(iomega,iflavor,iflavor2))
1300            else
1301              F_omega_inv(iflavor,iflavor2)= (- Gomega_tmp(iomega,iflavor,iflavor2))
1302            endif
1303          enddo
1304        enddo
1305   !   END DO
1306   ! IF ( op%rank .EQ. 0 ) THEN
1307   !   DO iflavor = 1, flavors
1308   !     DO iflavor2 = 1, flavors
1309   !         write(334,*) "#",iflavor,iflavor2
1310   !         write(335,*) "#",iflavor,iflavor2
1311   !       do  iomega=1,op%Wmax
1312   !         write(334,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,iflavor,iflavor2))
1313   !         write(335,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_omega(iomega,iflavor,iflavor2))
1314   !       enddo
1315   !         write(334,*) 
1316   !         write(335,*) 
1317   !     END DO
1318   !   END DO
1319   ! ENDIF
1320 
1321   !   DO iomega=1,op%Wmax
1322        call xginv(F_omega_inv,flavors)
1323        do iflavor=1,flavors
1324          do iflavor2=1,flavors
1325            F_omega(iomega,iflavor,iflavor2) = F_omega_inv(iflavor,iflavor2)
1326          enddo
1327        enddo
1328      END DO
1329 
1330    !IF ( op%rank .EQ. 0 ) THEN
1331    !  DO iflavor = 1, flavors
1332    !    DO iflavor2 = 1, flavors
1333    !        write(332,*) "#",iflavor,iflavor2
1334    !        write(333,*) "#",iflavor,iflavor2
1335    !      do  iomega=1,op%Wmax
1336    !        write(332,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,iflavor,iflavor2))
1337    !        write(333,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_omega(iomega,iflavor,iflavor2))
1338    !      enddo
1339    !        write(332,*) 
1340    !        write(333,*) 
1341    !    END DO
1342    !  END DO
1343    !ENDIF
1344      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1345      !  for test: Fourier of G0(iwn)
1346      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1347    !sui!write(std_out,*) "opt_fk=0"
1348      CALL GreenHyboffdiag_setOperW(F_tmp,F_omega)
1349   ! IF ( op%rank .EQ. 0 ) THEN
1350   !    DO iflavor = 1, flavors
1351   !      DO iflavor2 = 1, flavors
1352   !          write(336,*) "#",iflavor,iflavor2
1353   !          write(337,*) "#",iflavor,iflavor2
1354   !        do  iomega=1,op%Wmax
1355   !          write(336,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2))
1356   !          write(337,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_tmp%oper_w(iomega,iflavor,iflavor2))
1357   !        enddo
1358   !          write(336,*) 
1359   !          write(337,*) 
1360   !      END DO
1361   !    END DO
1362   !  ENDIF
1363      CALL GreenHyboffdiag_backFourier(F_tmp,func="green")
1364      ! --- Put the result in F
1365      DO iflavor = 1, flavors
1366        DO iflavor2 = 1, flavors
1367          DO itau=1,samples+1
1368          F(itau,iflavor,iflavor2) = F_tmp%oper(itau,iflavor,iflavor2)
1369          END DO
1370        END DO
1371      END DO
1372      !IF ( op%rank .EQ. 0 ) THEN
1373      !  DO iflavor = 1, flavors
1374      !    DO iflavor2 = 1, flavors
1375      !        write(346,*) "#",iflavor,iflavor2
1376      !      do  itau=1,op%samples+1
1377      !        write(346,*) (itau-1)*op%beta/(op%samples),real(F(itau,iflavor,iflavor2))
1378      !      enddo
1379      !        write(346,*) 
1380      !    END DO
1381      !  END DO
1382      !ENDIF
1383      DO iflavor = 1, flavors
1384        DO iflavor2 = 1, flavors
1385          DO itau=1,samples+1
1386 !         This symetrization is general and valid even with SOC
1387 !         Without SOC, it leads to zero.
1388          F(itau,iflavor,iflavor2) = (F_tmp%oper(itau,iflavor,iflavor2)+F_tmp%oper(itau,iflavor2,iflavor))/2.d0
1389          END DO
1390        END DO
1391      END DO
1392      open (unit=4367,file='G0tau_fromF',status='unknown',form='formatted')
1393      rewind(4367)
1394      IF ( op%rank .EQ. 0 ) THEN
1395        DO iflavor = 1, flavors
1396          DO iflavor2 = 1, flavors
1397              write(4367,*) "#",iflavor,iflavor2
1398            do  itau=1,op%samples+1
1399              write(4367,*) (itau-1)*op%beta/(op%samples),F(itau,iflavor,iflavor2)
1400            enddo
1401              write(4367,*) 
1402          END DO
1403        !sui!write(std_out,'(5x,14(2f9.5,2x))') (F(op%samples+1,iflavor,iflavor2),iflavor2=1,flavors)
1404        END DO
1405      ENDIF
1406      !call flush(437)
1407      close(4367)
1408      !call flush(6)
1409      
1410      call xmpi_barrier(op%MY_COMM)
1411      !CALL ERROR("END OF CALCULATION")
1412      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1413      !  END OF TEST
1414      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1415 
1416      !DO iomega=1,op%Wmax
1417      !  call xginv(F_omega(iomega,:,:),flavors)
1418      !END DO
1419     !F_omega = CMPLX(-1.d0,0,8)/Gomega_tmp
1420   !ELSE
1421   !=============================================================================================
1422   ! --- Restore Hybridization in F_omega
1423   !=============================================================================================
1424 
1425 !   Restore Hybridization in F_omega for the following operations
1426   F_omega = Gomega_tmp
1427   !END IF
1428 
1429   !==================================================================
1430   ! --- Full double loop on flavors to compute F (remove levels)
1431   !==================================================================
1432   DO iflavor = 1, flavors
1433     DO iflavor2 = 1, flavors
1434 
1435   ! --- Compute or use the levels for the diagonal hybridization (else K=0)
1436       IF(iflavor==iflavor2) THEN
1437         IF ( op%opt_levels .EQ. 1 ) THEN
1438           K = op%mu(iflavor)
1439         ELSE
1440           K = -REAL(F_omega(op%Wmax, iflavor,iflavor))
1441 !        op%mu = K
1442           op%mu(iflavor) = K 
1443         END IF
1444       ELSE
1445         K=0.d0
1446       ENDIF
1447       !IF ( op%rank .EQ. 0 ) &
1448       !WRITE(9876,'(I4,2E22.14)') iflavor, K, REAL(-F_omega(op%Wmax, iflavor))
1449      ! IF(op%rank .EQ.0) &
1450      ! WRITE(op%ostream,*) "CTQMC K, op%mu = ",K,op%mu(iflavor)
1451       !WRITE(op%ostream,*) "CTQMC beta     = ",op%beta
1452 
1453   ! --- Compute F (by removing the levels) if opt_fk==0
1454     !  IF ( opt_fk .EQ. 0 ) THEN
1455     !   ! DO iomega = 1, op%Wmax
1456     !   !   re = REAL(F_omega(iomega,iflavor,iflavor2))
1457     !   !   im = AIMAG(F_omega(iomega,iflavor,iflavor2))
1458     !   !   if (iflavor==iflavor2) then
1459     !   !     F_omega(iomega,iflavor,iflavor) = CMPLX(re + K, im + (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, 8)
1460     !   !   else
1461     !   !     F_omega(iomega,iflavor,iflavor2) = CMPLX(re , im  , 8)
1462     !   !   endif
1463     !   !   !if(iflavor==1.and.op%rank==0) then
1464     !   !     !write(224,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(F_omega(iomega,iflavor)),imag(F_omega(iomega,iflavor))
1465     !   !     !write(225,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(Gomega_tmp(iomega, iflavor)),imag(Gomega_tmp(iomega, iflavor))
1466     !   !   !end if 
1467     !   ! END DO
1468     !  ELSE
1469     !    DO iomega = 1, op%Wmax
1470     !      !F_omega(iomega,iflavor,iflavor2) = F_omega(iomega,iflavor,iflavor2) + CMPLX(K, 0.d0, 8)
1471 
1472 
1473     !      !if(iflavor==1.and.op%rank==0) then
1474     !        !write(224,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(F_omega(iomega,iflavor)),imag(F_omega(iomega,iflavor))
1475     !        !write(225,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(Gomega_tmp(iomega, iflavor)),imag(Gomega_tmp(iomega, iflavor))
1476     !      !end if 
1477     !    END DO
1478     !  END IF
1479   ! --- compute residual K (?)
1480       K = REAL(CMPLX(0,(2.d0*DBLE(op%Wmax)-1.d0)*pi_invBeta,8)*F_omega(op%Wmax,iflavor,iflavor2))
1481       CALL GreenHyboffdiag_setMuD1(op%Greens,iflavor,iflavor2,op%mu(iflavor),K)
1482     END DO
1483   END DO
1484 
1485   do  iomega=1,op%Wmax
1486    ! write(336,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,1,1)),imag(F_omega(iomega,1,1))
1487   enddo
1488 
1489   ! --- Creates F_tmp%oper_w
1490   CALL GreenHyboffdiag_setOperW(F_tmp,F_omega)
1491  ! do  iflavor=1, flavors ; do  iflavor2=1, flavors ; write(337,*) "#",iflavor,iflavor2 ; do  iomega=1,op%Wmax
1492  !   write(337,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2)),&
1493  !&   imag(F_tmp%oper_w(iomega,iflavor,iflavor2))
1494  ! enddo ; write(337,*) ; enddo ; enddo
1495 !  IF ( op%rank .EQ. 0 ) THEN
1496 !    DO iflavor = 1, flavors
1497 !      DO iflavor2 = 1, flavors
1498 !        write(336,*) "#",iflavor,iflavor2
1499 !        write(337,*) "#",iflavor,iflavor2
1500 !        do  iomega=1,op%Wmax
1501 !          write(336,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2))
1502 !          write(337,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_tmp%oper_w(iomega,iflavor,iflavor2))
1503 !        enddo
1504 !        write(336,*) 
1505 !        write(337,*) 
1506 !        write(136,*) "#",iflavor,iflavor2
1507 !        write(137,*) "#",iflavor,iflavor2
1508 !        do  iomega=1,op%Wmax
1509 !        write(136,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2)-op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta,kind=8)))
1510 !        write(137,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_tmp%oper_w(iomega,iflavor,iflavor2)-op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta,kind=8)))
1511 !        enddo
1512 !        write(136,*) 
1513 !        write(137,*) 
1514 !        write(836,*) "#",iflavor,iflavor2
1515 !        write(837,*) "#",iflavor,iflavor2
1516 !        do  iomega=1,op%Wmax
1517 !        write(836,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta)))
1518 !        write(837,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta)))
1519 !        enddo
1520 !        write(836,*) 
1521 !        write(837,*) 
1522 !      END DO
1523 !    END DO
1524 !  ENDIF
1525   !CALL GreenHyboffdiag_backFourier(F_tmp,F_omega(:,iflavor))
1526    ! DO iflavor = 1, flavors
1527    !   DO iflavor2 = 1, flavors
1528    !   unitnb=80000+F_tmp%rank
1529    !   call int2char4(F_tmp%rank,tag_proc)
1530    !   tmpfil = 'oper_wavantFOURIER'//tag_proc
1531    !   open (unit=unitnb,file=trim(tmpfil),status='unknown',form='formatted')
1532    !   write(unitnb,*) "#",iflavor,iflavor2
1533    !   ! C_omega et oper_w differents Domega identique. Est ce du a des
1534    !   ! diago differentes   pour chaque procs dans qmc_prep_ctqmc
1535    !   do  iomega=1,F_tmp%Wmax
1536    !   write(unitnb,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2))
1537    !   enddo
1538    !   write(unitnb,*) 
1539    !   END DO
1540    ! END DO
1541 
1542   ! --- For all iflavor and iflavor2, do the Fourier transformation to
1543   ! --- have (F(\tau))
1544   !CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=op%opt_hybri_limit)
1545    write(std_out,*) "WARNING opt_hybri_limit==0"
1546   CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=0)
1547 !  CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=1)
1548  ! CALL GreenHyboffdiag_backFourier(F_tmp)
1549 
1550   ! --- Put the result in F
1551   DO iflavor = 1, flavors
1552     DO iflavor2 = 1, flavors
1553       DO itau=1,samples+1
1554       F(itau,iflavor,iflavor2) = -F_tmp%oper(samples+2-itau,iflavor,iflavor2)
1555       END DO
1556     END DO
1557   END DO
1558 ! IF ( op%rank .EQ. 0 ) THEN
1559 !   ifl=0
1560 !   DO iflavor = 1, flavors
1561 !     DO iflavor2 = 1, flavors
1562 !       ifl=ifl+1
1563 !       write(346,*) "#",iflavor,iflavor2,ifl
1564 !       do  itau=1,op%samples+1
1565 !         write(346,*) itau,real(F(itau,iflavor,iflavor2))
1566 !       enddo
1567 !       write(346,*) 
1568 !     END DO
1569 !   END DO
1570 ! ENDIF
1571 ! close(346)
1572   DO iflavor = 1, flavors
1573     DO iflavor2 = 1, flavors
1574       DO itau=1,samples+1
1575 !      This symetrization is general and valid even with SOC
1576 !      Without SOC, it leads to zero.
1577       F(itau,iflavor,iflavor2) = -(F_tmp%oper(samples+2-itau,iflavor,iflavor2)+F_tmp%oper(samples+2-itau,iflavor2,iflavor))/2.d0
1578       END DO
1579     END DO
1580   END DO
1581   !DO iflavor = 1, flavors
1582   !  DO iflavor2 = 1, flavors
1583   !    DO itau=1,samples+1
1584   !    F(itau,iflavor,iflavor2) = F(samples/2,iflavor,iflavor2)
1585   !    END DO
1586   !  END DO
1587   !END DO
1588 
1589  !  SOME TRY TO ADJUST F
1590   !DO iflavor = 1, flavors
1591   !  DO iflavor2 = 1, flavors
1592   !    do  itau=1,op%samples+1
1593   !    !if(iflavor/=iflavor2) F(itau,iflavor,iflavor2)=F((op%samples+1)/2,iflavor,iflavor2)
1594   !    !if(iflavor==iflavor2) F(itau,iflavor,iflavor2)=F((op%samples+1)/2,iflavor,iflavor2)
1595   !    enddo
1596   !  END DO
1597   !END DO
1598   !write(6,*) "QQQQ1",op%rank
1599 
1600   open (unit=436,file='Hybridization.dat',status='unknown',form='formatted')
1601   rewind(436)
1602   IF ( op%rank .EQ. 0 ) THEN
1603     ifl=0
1604     DO iflavor = 1, flavors
1605       DO iflavor2 = 1, flavors
1606         ifl=ifl+1
1607           write(436,*) "#",iflavor,iflavor2 !,ifl,op%hybri_limit(iflavor,iflavor2)
1608         do  itau=1,op%samples+1
1609           write(436,*) itau,F(itau,iflavor,iflavor2)
1610         enddo
1611           write(436,*) 
1612       END DO
1613     END DO
1614   ENDIF
1615   close(436)
1616   !   call xmpi_barrier(op%MY_COMM)
1617   !write(6,*) "QQQQ3"
1618   FREE(Gomega_tmp)
1619   FREE(F_omega)
1620   FREE(F_omega_inv)
1621   !write(6,*) "QQQQ4"
1622   CALL GreenHyboffdiag_destroy(F_tmp)
1623   !write(6,*) "QQQQ2"
1624 
1625 
1626 END SUBROUTINE Ctqmcoffdiag_computeF

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_destroy [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_destroy

FUNCTION

  destroy and deallocate all variables

COPYRIGHT

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

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

4549 SUBROUTINE Ctqmcoffdiag_destroy(op)
4550 
4551 !Arguments ------------------------------------
4552   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
4553 !Local variables ------------------------------
4554   !INTEGER                  :: iflavor
4555   INTEGER                  :: flavors
4556   INTEGER                  :: i
4557   INTEGER                  :: j
4558   INTEGER                  :: k
4559 
4560   flavors = op%flavors
4561 
4562   CALL ImpurityOperator_destroy(op%Impurity)
4563   CALL BathOperatoroffdiag_destroy(op%Bath)
4564   CALL Vector_destroy(op%measNoise(1))
4565   CALL Vector_destroy(op%measNoise(2))
4566 
4567 !sui!write(6,*) "before greenhyb_destroy in ctmqc_destroy"
4568   CALL GreenHyboffdiag_destroy(op%Greens)
4569 !#ifdef CTCtqmcoffdiag_ANALYSIS
4570   FREEIF(op%measCorrelation)
4571   FREEIF(op%measPerturbation)
4572   FREEIF(op%meas_fullemptylines)
4573   FREEIF(op%measN)
4574   IF ( op%opt_histo .GT. 0 ) THEN
4575     FREEIF(op%occup_histo_time)
4576   END IF
4577   FREEIF(op%measDE)
4578   FREEIF(op%mu)
4579   FREEIF(op%hybri_limit)
4580   FREEIF(op%abNoiseG)
4581   IF ( ALLOCATED(op%measNoiseG) ) THEN
4582     DO i=1,2
4583       DO j = 1, op%flavors
4584         DO k= 1, op%samples+1
4585           CALL Vector_destroy(op%measNoiseG(k,j,i))
4586         END DO
4587       END DO
4588     END DO
4589     DT_FREE(op%measNoiseG)
4590   END IF
4591   FREEIF(op%density)
4592 !#endif
4593   op%ostream        = 0
4594   op%istream        = 0
4595  
4596   op%sweeps         = 0
4597   op%thermalization = 0
4598   op%flavors        = 0
4599   op%samples        = 0
4600   op%beta           = 0.d0
4601 !  op%seg_added      = 0.d0
4602 !  op%anti_added     = 0.d0
4603 !  op%seg_removed    = 0.d0
4604 !  op%anti_removed   = 0.d0
4605 !  op%seg_sign       = 0.d0
4606 !  op%anti_sign      = 0.d0
4607   op%stats          = 0.d0
4608   op%swap           = 0.d0
4609 
4610 
4611   op%set  = .FALSE.
4612   op%done = .FALSE.
4613   op%init = .FALSE.
4614 END SUBROUTINE Ctqmcoffdiag_destroy

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getD [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_getD

FUNCTION

  get double occupation

COPYRIGHT

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

OUTPUT

  D=full double occupation

SIDE EFFECTS

NOTES

SOURCE

3813 SUBROUTINE Ctqmcoffdiag_getD(op, D)
3814 
3815 !Arguments ------------------------------------
3816   TYPE(Ctqmcoffdiag)       , INTENT(IN ) :: op
3817   DOUBLE PRECISION, INTENT(OUT) :: D
3818 !Local variables ------------------------------
3819   INTEGER                       :: iflavor1
3820   INTEGER                       :: iflavor2
3821 
3822   D = 0.d0
3823 
3824   DO iflavor1 = 1, op%flavors
3825     DO iflavor2 = iflavor1+1, op%flavors
3826       D = D + op%measDE(iflavor2,iflavor1)
3827     END DO
3828   END DO
3829   !IF ( op%rank .EQ. 0 ) THEN
3830   !  DO iflavor1 = 1, op%flavors
3831   !    DO iflavor2 = iflavor1+1, op%flavors
3832   !     write(4533,*) op%measDE(iflavor2,iflavor1)k
3833   !     write(4534,*) op%Impurity%mat_U(iflavor2,iflavor1)k
3834   !    END DO
3835   !  END DO
3836 
3837   !ENDIF
3838 
3839 END SUBROUTINE Ctqmcoffdiag_getD

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getE [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_getE

FUNCTION

  get interaction energy and noise on it

COPYRIGHT

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

OUTPUT

  E=interaction energy
  noise=noise on this value

SIDE EFFECTS

NOTES

SOURCE

3868 SUBROUTINE Ctqmcoffdiag_getE(op,E,noise)
3869 
3870 !Arguments ------------------------------------
3871   TYPE(Ctqmcoffdiag)       , INTENT(IN ) :: op
3872   DOUBLE PRECISION, INTENT(OUT) :: E
3873   DOUBLE PRECISION, INTENT(OUT) :: Noise
3874 
3875   E = op%measDE(1,1)  
3876   Noise = op%a_Noise*(DBLE(op%sweeps)*DBLE(op%size))**op%b_Noise
3877 END SUBROUTINE Ctqmcoffdiag_getE

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_getGreen

FUNCTION

  Get the full green functions in time and/or frequency

COPYRIGHT

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

OUTPUT

  Gtau=green function in time
  Gw=green function in frequency

SIDE EFFECTS

NOTES

SOURCE

3542 SUBROUTINE Ctqmcoffdiag_getGreen(op, Gtau, Gw)
3543 
3544 !Arguments ------------------------------------
3545  USE m_GreenHyboffdiag
3546   TYPE(Ctqmcoffdiag)          , INTENT(INOUT)    :: op
3547   DOUBLE PRECISION, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: Gtau
3548   COMPLEX(KIND=8), DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: Gw
3549 !Local variables ------------------------------
3550   !INTEGER                            :: itime
3551   INTEGER                            :: iflavor1
3552   INTEGER                            :: iflavor1b !,iflavor,iflavorbis
3553   INTEGER                            :: iflavor2
3554   INTEGER                            :: iflavor3
3555   INTEGER                            :: flavors,tail
3556   INTEGER                            :: ifreq,itime
3557   DOUBLE PRECISION :: u1 
3558   DOUBLE PRECISION :: u2
3559   DOUBLE PRECISION :: u3
3560   DOUBLE PRECISION :: Un
3561   DOUBLE PRECISION :: UUnn,iw !omega,
3562   CHARACTER(LEN=4)                   :: cflavors
3563   CHARACTER(LEN=50)                  :: string
3564   TYPE(GreenHyboffdiag)                     :: F_tmp
3565 
3566   flavors = op%flavors
3567   DO iflavor1 = 1, flavors
3568     u1 = 0.d0
3569     u2 = 0.d0
3570     u3 = 0.d0
3571     DO iflavor2 = 1, flavors
3572       IF ( iflavor2 .EQ. iflavor1 ) CYCLE
3573       Un = op%Impurity%mat_U(iflavor2,iflavor1) * op%measN(1,iflavor2)
3574 !      Un = op%Impurity%mat_U(iflavor2,iflavor1) * (op%Greens%oper(1,iflavor2,iflavor2) + 1.d0)
3575       !write(6,*) "forsetmoments",iflavor1,iflavor2,(op%Greens%oper(1,iflavor2,iflavor2) + 1.d0), Un
3576       u1 = u1 + Un 
3577       u2 = u2 + Un*op%Impurity%mat_U(iflavor2,iflavor1) 
3578       DO iflavor3 = 1, flavors
3579         IF ( iflavor3 .EQ. iflavor2 .OR. iflavor3 .EQ. iflavor1 ) CYCLE
3580         UUnn = (op%Impurity%mat_U(iflavor2,iflavor1)*op%Impurity%mat_U(iflavor3,iflavor1)) * &
3581 &                                                    op%measDE(iflavor2,iflavor3) 
3582         u2 = u2 + UUnn 
3583       END DO
3584     END DO  
3585      ! write(6,*) "u1,u2",u1,u2
3586 
3587     DO iflavor1b = 1, flavors
3588       u3 =-(op%Impurity%mat_U(iflavor1,iflavor1b))*op%Greens%oper(1,iflavor1,iflavor1b)
3589       ! u3=U_{1,1b}*G_{1,1b}
3590       CALL GreenHyboffdiag_setMoments(op%Greens,iflavor1,iflavor1b,u1,u2,u3)
3591     END DO ! iflavor1b
3592 
3593   END DO ! iflavor1
3594 
3595   IF ( PRESENT( Gtau ) ) THEN
3596     DO iflavor1 = 1, flavors
3597       DO iflavor2 = 1, flavors
3598         Gtau(1:op%samples,iflavor1,iflavor2) = op%Greens%oper(1:op%samples,iflavor1,iflavor2)
3599       END DO  
3600     END DO ! iflavor1
3601   END IF
3602 ! !--------- Write Occupation matrix before Gtau
3603 !  write(ostream,'(17x,a)') "Occupation matrix"
3604 !  write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
3605 !  write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
3606 !  do iflavor=1, op%flavors
3607 !    write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(-op%Greens%oper(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors)
3608 !  enddo
3609 !  write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
3610 ! !------------------------------------------------------------------------------------------
3611 ! !--------- Write Occupation matrix Gtau
3612 !  write(ostream,'(17x,a)') "Occupation matrix"
3613 !  write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
3614 !  write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
3615 !  do iflavor=1, op%flavors
3616 !    write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(Gtau(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors)
3617 !  enddo
3618 !  write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
3619 ! !------------------------------------------------------------------------------------------
3620 
3621 !================================================
3622   if(3==4) then
3623 !================================================
3624     DO iflavor1 = 1, flavors
3625       DO iflavor1b = 1, flavors
3626        !call nfourier3(op%Greens%oper(1:op%samples,iflavor1,iflavor1b),Gw(1:op%samples,iflavor1,iflavor1b),iflavor1==iflavor1b,op%Greens%samples,op%Greens%samples-1,op%Greens%beta,1.d0,op%Greens%Mk(iflavor1,iflavor1b,1),op%Greens%Mk(iflavor1,iflavor1b,2),op%Greens%Mk(iflavor1,iflavor1b,3))
3627       END DO  
3628     END DO ! iflavor1
3629 !    ============== write Gomega_nd.dat
3630     if(op%rank==0) then
3631     OPEN(UNIT=44, FILE="Gomega_nd_nfourier2.dat")
3632     WRITE(cflavors,'(I4)') 2*(flavors*flavors+1)
3633     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'E15.5)'
3634     !write(6,*) " op%Greens%Wmax", op%Greens%Wmax
3635     do  iflavor1=1, flavors 
3636       do  iflavor1b=1, flavors 
3637     write(44,*) "#op%Greens%Mk(iflavor1,iflavor2,1",op%Greens%Mk(iflavor1,iflavor1b,:)
3638         DO ifreq = 1, op%samples
3639 !      !write(6,string) (DBLE(ifreq)*2-1)*3.1415/op%Greens%beta, &
3640 !      (/ ((real(Gw(ifreq,iflavor1,iflavor1b)),imag(Gw(ifreq,iflavor1,iflavor1b)), iflavor1=1, flavors),iflavor1b=1,flavors) /)
3641 !      WRITE(44,string) (DBLE(ifreq)*2.d0-1.d0)*3.1415926/op%Greens%beta, &
3642         iw=aimag(Gw(ifreq,op%flavors,op%flavors+1))
3643          WRITE(44,string) aimag(Gw(ifreq,op%flavors,op%flavors+1)),&
3644          real(Gw(ifreq,iflavor1,iflavor1b)),aimag(Gw(ifreq,iflavor1,iflavor1b)),&
3645             ( -op%Greens%Mk(iflavor1,iflavor1b,2) )/(iw*iw) , (op%Greens%Mk(iflavor1,iflavor1b,1))/iw!-op%Greens%Mk(iflavor1,iflavor1b,3)/(iw*iw))/iw 
3646       !   WRITE(102,*) aimag(Gw(ifreq,op%flavors,op%flavors+1)), (op%Greens%Mk(iflavor1,iflavor1b,1))/iw,op%Greens%Mk(iflavor1,iflavor1b,1),iw
3647         END DO
3648          WRITE(44,*) 
3649       END DO
3650     END DO
3651     close(44)
3652     endif
3653 !================================================
3654   endif
3655 !================================================
3656        !!write(6,*) "present gw", present(gw)
3657   IF ( PRESENT( Gw ) ) THEN
3658      !!write(6,*) "size gw",SIZE(Gw,DIM=2) ,flavors+1 
3659     IF ( SIZE(Gw,DIM=3) .EQ. flavors+1 ) THEN
3660      ! CALL GreenHyboffdiag_forFourier(op%Greens, Gomega=Gw, omega=Gw(:,op%flavors,op%flavors+1))
3661       CALL GreenHyboffdiag_forFourier(op%Greens, Gomega=Gw, omega=Gw(:,op%flavors,op%flavors+1))
3662       !write(6,*) "1"
3663       !IF ( op%rank .EQ. 0 ) write(20,*) Gw(:,iflavor1)
3664     ELSE IF ( SIZE(Gw,DIM=3) .EQ. flavors ) THEN  
3665       CALL GreenHyboffdiag_forFourier(op%Greens,Gomega=Gw)
3666       !write(6,*) "2"
3667     ELSE
3668       CALL WARNALL("Ctqmcoffdiag_getGreen : Gw is not valid                    ")
3669       CALL GreenHyboffdiag_forFourier(op%Greens,Wmax=op%Wmax)
3670       !write(6,*) "3"
3671     END IF
3672   ELSE
3673     CALL GreenHyboffdiag_forFourier(op%Greens,Wmax=op%Wmax)
3674   END IF
3675 !  ============== write Gomega_nd.dat
3676 !================================================
3677 !  if(3==4) then
3678 !================================================
3679   if(op%rank==0.and.3==4) then
3680   OPEN(UNIT=44, FILE="Gomega_nd.dat")
3681   WRITE(cflavors,'(I4)') 2*(flavors*flavors+1)
3682   string = '(1x,'//TRIM(ADJUSTL(cflavors))//'E15.5)'
3683   !write(6,*) " op%Greens%Wmax", op%Greens%Wmax
3684   do  iflavor1=1, flavors 
3685     do  iflavor1b=1, flavors 
3686   write(44,*) "#op%Greens%Mk(iflavor1,iflavor2,1",op%Greens%Mk(iflavor1,iflavor1b,:)
3687       DO ifreq = 1, SIZE(Gw,1)    
3688 !    !write(6,string) (DBLE(ifreq)*2-1)*3.1415/op%Greens%beta, &
3689 !    (/ ((real(Gw(ifreq,iflavor1,iflavor1b)),imag(Gw(ifreq,iflavor1,iflavor1b)), iflavor1=1, flavors),iflavor1b=1,flavors) /)
3690 !    WRITE(44,string) (DBLE(ifreq)*2.d0-1.d0)*3.1415926/op%Greens%beta, &
3691       iw=aimag(Gw(ifreq,op%flavors,op%flavors+1))
3692        WRITE(44,string) aimag(Gw(ifreq,op%flavors,op%flavors+1)),&
3693        real(Gw(ifreq,iflavor1,iflavor1b)),aimag(Gw(ifreq,iflavor1,iflavor1b)),&
3694           ( -op%Greens%Mk(iflavor1,iflavor1b,2) )/(iw*iw) , &
3695 &          (op%Greens%Mk(iflavor1,iflavor1b,1)-op%Greens%Mk(iflavor1,iflavor1b,3)/(iw*iw))/iw 
3696       END DO
3697        WRITE(44,*) 
3698     END DO
3699   END DO
3700   endif
3701 !================================================
3702 !  endif
3703 !================================================
3704 
3705 
3706 !  ==============================
3707   ! --- Initialize F_tmp 
3708   !write(6,*) "10"
3709 
3710   IF ( op%have_MPI .EQV. .TRUE. ) THEN
3711     !CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,op%flavors,MY_COMM=op%MY_COMM)
3712     CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,flavors)
3713     !write(6,*) "10a"
3714   ELSE
3715     CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,flavors)
3716     !write(6,*) "10b"
3717   END IF
3718 
3719   !write(6,*) "11"
3720 !  CALL GreenHyboffdiag_setOperW(F_tmp,Gw)
3721 
3722   tail = op%samples 
3723   F_tmp%Wmax=op%samples ! backFourier only works for linear freq: calculation of A and etc..
3724   MALLOC(F_tmp%oper_w,(1:tail,op%flavors,op%flavors))
3725   F_tmp%oper_w(1:tail,1:F_tmp%nflavors,1:F_tmp%nflavors) = Gw(1:tail,1:F_tmp%nflavors,1:F_tmp%nflavors)
3726   !write(6,*) "example",F_tmp%oper_w(1,1,1)
3727   !write(6,*) "example",Gw(1,1,1)
3728   F_tmp%setW = .TRUE.
3729   !write(6,*) size(F_tmp%oper_w,1)
3730   !write(6,*) size(F_tmp%oper_w,2)
3731   !write(6,*) size(F_tmp%oper_w,3)
3732   !write(6,*) size(Gw,1)
3733   !write(6,*) size(Gw,2)
3734   !write(6,*) size(Gw,3)
3735 
3736   !write(6,*) "eee", (2.d0*DBLE(ifreq)-1.d0) * 3.1415/op%beta,real(F_tmp%oper_w(1,1,1)),imag(F_tmp%oper_w(1,1,1))
3737 !================================================
3738   if(3==4) then
3739 !================================================
3740     OPEN(UNIT=3337, FILE="Gomega_nd2.dat")
3741     do  iflavor1=1, flavors 
3742       do  iflavor1b=1, flavors 
3743         do  ifreq=1, tail
3744 !         write(3337,*) (2.d0*DBLE(ifreq)-1.d0) * 3.1415/op%beta,real(F_tmp%oper_w(ifreq,iflavor1,iflavor1b)),&
3745 !   &     imag(F_tmp%oper_w(ifreq,iflavor1,iflavor1b))
3746           write(3337,*) aimag(Gw(ifreq,op%flavors,op%flavors+1)), real(F_tmp%oper_w(ifreq,iflavor1,iflavor1b)),&
3747  &        aimag(F_tmp%oper_w(ifreq,iflavor1,iflavor1b))
3748 
3749       !    omega=(2.d0*DBLE(ifreq)-1.d0) * 3.1415/op%beta
3750  !        F_tmp%oper_w(ifreq,iflavor1,iflavor1b)=0.1**2/Gw(ifreq,op%flavors,op%flavors+1)
3751         enddo 
3752         write(3337,*)
3753       enddo 
3754     enddo
3755     close(3337)
3756 !================================================
3757   endif
3758 !================================================
3759 
3760   !write(6,*) "12",F_tmp%Wmax
3761 
3762 !  CALL GreenHyboffdiag_backFourier(F_tmp,func="green")
3763 
3764   !write(6,*) "13"
3765 
3766 !================================================
3767   if(3==4) then
3768 !================================================
3769     OPEN(UNIT=48, FILE="Gtau_nd_2.dat")
3770 !    --- Print full non diagonal Gtau in Gtau_nd.dat
3771     WRITE(cflavors,'(I4)') flavors*flavors+1
3772     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
3773     DO itime = 1, op%samples+1
3774       WRITE(48,string) DBLE(itime-1)*op%beta/DBLE(op%samples), &
3775  &    ((F_tmp%oper(itime,iflavor1,iflavor1b), iflavor1=1, flavors),iflavor1b=1,flavors)
3776     END DO
3777 !================================================
3778   endif
3779 !================================================
3780 
3781   CALL GreenHyboffdiag_destroy(F_tmp)
3782 
3783   !FREE(F_tmp%oper_w)
3784 !  ==============================
3785 END SUBROUTINE Ctqmcoffdiag_getGreen

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getResult [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_getResult

FUNCTION

  reduce everything to get the result of the simulation

COPYRIGHT

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

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

2938 SUBROUTINE Ctqmcoffdiag_getResult(op)
2939 
2940 
2941 #ifdef HAVE_MPI1
2942 include 'mpif.h'
2943 #endif
2944 !Arguments ------------------------------------
2945   TYPE(Ctqmcoffdiag)  , INTENT(INOUT)                    :: op
2946 !Local variables ------------------------------
2947   INTEGER                                       :: iflavor
2948   INTEGER                                       :: flavors
2949   INTEGER                                       :: itau
2950   INTEGER                                       :: endDensity
2951   DOUBLE PRECISION                              :: inv_flavors
2952   DOUBLE PRECISION                              :: a
2953   DOUBLE PRECISION                              :: b
2954   DOUBLE PRECISION                              :: r
2955   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: alpha
2956   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: beta
2957   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:)   :: measN_1
2958   DOUBLE PRECISION,              DIMENSION(1:2) :: TabX
2959   DOUBLE PRECISION,              DIMENSION(1:2) :: TabY
2960   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:)   :: freqs
2961   INTEGER, ALLOCATABLE, DIMENSION(:)   :: counts
2962   INTEGER, ALLOCATABLE, DIMENSION(:)   :: displs
2963   INTEGER                                       :: sp1
2964   INTEGER                                       :: spAll
2965   INTEGER                                       :: last
2966   INTEGER                                       :: n1
2967   INTEGER                                       :: n2
2968   INTEGER                                       :: debut
2969   DOUBLE PRECISION                                       :: signvaluemeassum
2970 !  INTEGER                                       :: fin
2971 #ifdef HAVE_MPI
2972   INTEGER                                       :: ierr
2973 #endif
2974   INTEGER                                       :: sizeoper,nbprocs,myrank
2975   DOUBLE PRECISION                              :: inv_size,sumh
2976   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: buffer 
2977   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: buffer2,buffer2s
2978   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: fullempty
2979   TYPE(FFTHyb) :: FFTmrka
2980 
2981   IF ( .NOT. op%done ) &
2982     CALL ERROR("Ctqmcoffdiag_getResult : Simulation not run                ")
2983 
2984   flavors     =  op%flavors
2985   inv_flavors = 1.d0 / DBLE(flavors)
2986 
2987 
2988   inv_size = 1.d0 / DBLE(op%size)
2989   sp1 = 0
2990   spAll = 0
2991 
2992 !#ifdef CTCtqmcoffdiag_CHECK
2993   IF ( op%opt_check .GT. 0 ) THEN
2994     op%errorImpurity = ImpurityOperator_getError(op%Impurity) * inv_flavors 
2995     op%errorBath     = BathOperatoroffdiag_getError    (op%Bath    ) * inv_flavors 
2996   END IF
2997 !#endif
2998 
2999   MALLOC(alpha,(1,1))
3000   MALLOC(beta,(1,1))
3001   MALLOC(buffer,(1,1))
3002   IF ( op%opt_noise .EQ. 1) THEN
3003     FREEIF(alpha)
3004     MALLOC(alpha,(1:op%samples+1,1:flavors))
3005     FREEIF(beta)
3006     MALLOC(beta,(1:op%samples+1,1:flavors))
3007   END IF
3008 
3009   IF ( op%have_MPI .EQV. .TRUE.) THEN 
3010     sp1   = 0
3011     spAll = sp1 + flavors + 6 
3012 
3013 !#ifdef CTCtqmcoffdiag_ANALYSIS
3014     IF ( op%opt_analysis .EQ. 1 ) &
3015       spAll = spAll + 3*sp1 
3016     IF ( op%opt_order .GT. 0 ) &
3017       spAll = spAll + op%opt_order 
3018     IF ( op%opt_noise .EQ. 1 ) &
3019       spAll = spAll + 2*(op%samples + 1)
3020 !#endif
3021 
3022     FREEIF(buffer)
3023     MALLOC(buffer,(1:spAll,1:MAX(2,flavors)))
3024   END IF
3025 
3026 !  op%seg_added    = op%seg_added    * inv_flavors 
3027 !  op%seg_removed  = op%seg_removed  * inv_flavors
3028 !  op%seg_sign     = op%seg_sign     * inv_flavors
3029 !  op%anti_added   = op%anti_added   * inv_flavors
3030 !  op%anti_removed = op%anti_removed * inv_flavors
3031 !  op%anti_sign    = op%anti_sign    * inv_flavors
3032   op%stats(:) = op%stats(:) * inv_flavors
3033 
3034   DO iflavor = 1, flavors
3035     ! Accumulate last values of  N (see also ctqmc_measn)
3036     op%measN(1,iflavor) = op%measN(1,iflavor) + op%measN(3,iflavor)*op%measN(4,iflavor)
3037     op%measN(2,iflavor) = op%measN(2,iflavor) + op%measN(4,iflavor)
3038     ! Reduction
3039     op%measN(1,iflavor)  = op%measN(1,iflavor) / ( op%measN(2,iflavor) * op%beta )
3040     ! Correction
3041 !#ifdef CTCtqmcoffdiag_ANALYSIS
3042     IF ( op%opt_order .GT. 0 ) &
3043       op%measPerturbation(:   ,iflavor) = op%measPerturbation(:,iflavor) &
3044                                     / SUM(op%measPerturbation(:,iflavor))
3045     IF ( op%opt_order .GT. 0 ) &
3046       op%meas_fullemptylines(:   ,iflavor) = op%meas_fullemptylines(:,iflavor) &
3047                                     / SUM(op%meas_fullemptylines(:,iflavor))
3048     !write(6,*) "sum fullempty",iflavor,op%meas_fullemptylines(:,iflavor)
3049 
3050     IF ( op%opt_analysis .EQ. 1 ) THEN
3051       op%measCorrelation (:,1,iflavor) = op%measCorrelation  (:,1,iflavor) &
3052                                     / SUM(op%measCorrelation (:,1,iflavor)) &
3053                                     * op%inv_dt 
3054       op%measCorrelation (:,2,iflavor) = op%measCorrelation  (:,2,iflavor) &
3055                                     / SUM(op%measCorrelation (:,2,iflavor)) &
3056                                     * op%inv_dt 
3057       op%measCorrelation (:,3,iflavor) = op%measCorrelation  (:,3,iflavor) &
3058                                     / SUM(op%measCorrelation (:,3,iflavor)) &
3059                                     * op%inv_dt 
3060     END IF
3061 !#endif
3062     IF ( op%opt_noise .EQ. 1 ) THEN
3063       TabX(1) = DBLE(op%modNoise2)
3064       TabX(2) = DBLE(op%modNoise1)
3065       DO itau = 1, op%samples+1
3066         op%measNoiseG(itau,iflavor,2)%vec = -op%measNoiseG(itau,iflavor,2)%vec*op%inv_dt &  
3067                                            /(op%beta*DBLE(op%modNoise2))
3068         op%measNoiseG(itau,iflavor,1)%vec = -op%measNoiseG(itau,iflavor,1)%vec*op%inv_dt &  
3069                                            /(op%beta*DBLE(op%modNoise1))
3070         n2 = op%measNoiseG(itau,iflavor,2)%tail
3071         TabY(1) = Stat_deviation(op%measNoiseG(itau,iflavor,2)%vec(1:n2))!*SQRT(n2/(n2-1))
3072         n1 = op%measNoiseG(itau,iflavor,1)%tail
3073         TabY(2) = Stat_deviation(op%measNoiseG(itau,iflavor,1)%vec(1:n1))!*SQRT(n1/(n1-1))
3074         CALL Stat_powerReg(TabX,SQRT(2.d0*LOG(2.d0))*TabY,alpha(itau,iflavor),beta(itau,iflavor),r)
3075         ! ecart type -> 60%
3076         ! largeur a mi-hauteur d'une gaussienne -> sqrt(2*ln(2))*sigma
3077       END DO
3078     END IF
3079 
3080   END DO
3081 !sui!write(6,*) "getresults"
3082   CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, .TRUE.,op%signvalue)
3083   CALL GreenHyboffdiag_getHybrid(op%Greens)
3084  ! write(6,*) "op%measN",op%measN(1,:)
3085   MALLOC(measN_1,(flavors))
3086   do iflavor=1,flavors
3087     measN_1(iflavor)=op%measN(1,iflavor)
3088   enddo
3089   CALL GreenHyboffdiag_setN(op%Greens, measN_1(:))
3090   FREE(measN_1)
3091 
3092 ! todoab case _nd and _d are not completely described.
3093   FREEIF(buffer2)
3094   FREEIF(buffer2s)
3095   sizeoper=size(op%Greens%oper,1)
3096   !write(6,*) "sss",size(op%Greens%oper,1),sizeoper
3097   !write(6,*) "sss",size(op%Greens%oper,2),flavors
3098   !write(6,*) "sss",size(op%Greens%oper,3),flavors
3099   MALLOC(buffer2,(1:sizeoper,flavors,flavors))
3100   MALLOC(buffer2s,(1:sizeoper,flavors,flavors))
3101   MALLOC(fullempty,(2,flavors))
3102       !sui!write(6,*) "greens1"
3103   IF ( op%have_MPI .EQV. .TRUE. ) THEN 
3104       !sui!write(6,*) "greens2"
3105     fullempty=0.d0
3106     buffer2 = op%Greens%oper
3107     !write(6,*) "buffer2",(op%Greens%oper(1,n1,n1),n1=1,flavors)
3108     buffer2s= 0.d0
3109     do iflavor=1,flavors
3110       do itau=1,sizeoper
3111     !sui!write(6,*) "greens",iflavor,itau,op%Greens%oper(itau,iflavor,iflavor)
3112       enddo
3113     enddo
3114    !write(6,*) "beforempi",op%Greens%oper(1,1,1) ,buffer2(1,1,1)
3115 #ifdef HAVE_MPI
3116    CALL MPI_COMM_SIZE(op%MY_COMM,nbprocs,ierr)
3117    CALL MPI_COMM_RANK(op%MY_COMM,myrank,ierr)
3118 #endif
3119   !write(6,*) "procs",nbprocs,myrank
3120   END IF
3121   last = sp1
3122 
3123   op%measDE(:,:) = op%measDE(:,:) * DBLE(op%measurements) /(DBLE(op%sweeps)*op%beta)
3124 
3125   IF ( op%opt_histo .GT. 0 ) THEN
3126     op%occup_histo_time(:) = op%occup_histo_time(:) / INT(op%sweeps/op%measurements)
3127   END IF
3128 ! HISTO before MPI_SUM
3129 !  write(6,*) "=== Histogram of occupations for complete simulation 3 ====",INT(op%sweeps/op%measurements)
3130 !  sumh=0
3131 !  do n1=1,op%flavors+1
3132 !     write(6,'(i4,f10.4)')  n1-1, op%occup_histo_time(n1)
3133 !     sumh=sumh+op%occup_histo_time(n1)
3134 !  enddo
3135 !  write(6,*) "=================================",sumh
3136 
3137   n1 = op%measNoise(1)%tail
3138   n2 = op%measNoise(2)%tail
3139 
3140   ! On utilise freqs comme tableau de regroupement
3141   ! Gather de Noise1
3142   IF ( op%have_MPI .EQV. .TRUE. ) THEN
3143     MALLOC(counts,(1:op%size))
3144     MALLOC(displs,(1:op%size))
3145     FREEIF(freqs)
3146     MALLOC(freqs,(1:op%size*n1))
3147     freqs = 0.d0
3148     freqs(n1*op%rank+1:n1*(op%rank+1)) = op%measNoise(1)%vec(1:n1) 
3149     counts(:) = n1
3150     displs(:) = (/ ( iflavor*n1, iflavor=0, op%size-1 ) /)
3151 #ifdef HAVE_MPI
3152     CALL MPI_ALLGATHERV(MPI_IN_PLACE, 0, MPI_DOUBLE_PRECISION, &
3153                         freqs, counts, displs, &
3154                         MPI_DOUBLE_PRECISION, op%MY_COMM, ierr)
3155 #endif
3156     n1 = op%size*n1
3157     CALL Vector_setSize(op%measNoise(1),n1)
3158     op%measNoise(1)%vec(1:n1) = freqs(:)
3159     ! Gather de Noise2
3160     FREE(freqs)
3161     MALLOC(freqs,(1:op%size*n2))
3162     freqs = 0.d0
3163     freqs(n2*op%rank+1:n2*(op%rank+1)) = op%measNoise(2)%vec(1:n2) 
3164     counts(:) = n2
3165     displs(:) = (/ ( iflavor*n2, iflavor=0, op%size-1 ) /)
3166 #ifdef HAVE_MPI
3167     CALL MPI_ALLGATHERV(MPI_IN_PLACE, 0, MPI_DATATYPE_NULL, &
3168                         freqs, counts, displs, &
3169                         MPI_DOUBLE_PRECISION, op%MY_COMM, ierr)
3170 #endif
3171     n2 = op%size*n2
3172     CALL Vector_setSize(op%measNoise(2),n2)
3173     op%measNoise(2)%vec(1:n2) = freqs(:)
3174     FREE(counts)
3175     FREE(displs)
3176     FREE(freqs)
3177   END IF
3178   !n1 = op%measNoise(1)%tail
3179   !n2 = op%measNoise(2)%tail
3180 
3181   ! Transformation des paquets pour que ca fit a CTQMC_SLICE(1|2)
3182   IF ( n1 .GT. CTQMC_SLICE1 ) THEN
3183     itau = n1/CTQMC_SLICE1
3184     MALLOC(freqs,(1:n1/itau))
3185     DO debut=1, n1/itau
3186       freqs(debut)=SUM(op%measNoise(1)%vec((debut-1)*itau+1:itau*debut))
3187     END DO
3188     freqs(:) = freqs(:)/DBLE(itau)
3189     op%modNoise1 = op%modNoise1*itau
3190     n1 = n1/itau
3191     CALL Vector_setSize(op%measNoise(1),n1)
3192     op%measNoise(1)%vec(1:n1) = freqs(:)
3193     FREE(freqs)
3194   END IF
3195   IF ( n2 .GT. CTQMC_SLICE1*CTQMC_SLICE2 ) THEN
3196     itau = n2/(CTQMC_SLICE1*CTQMC_SLICE2)
3197     MALLOC(freqs,(1:n2/itau))
3198     DO debut=1, n2/itau
3199       freqs(debut)=SUM(op%measNoise(2)%vec((debut-1)*itau+1:itau*debut))
3200     END DO
3201     freqs(:) = freqs(:)/DBLE(itau)
3202     op%modNoise2 = op%modNoise2*itau
3203     n2 = n2/itau
3204     CALL Vector_setSize(op%measNoise(2),n2)
3205     op%measNoise(2)%vec(1:n2) = freqs(:)
3206     FREE(freqs)
3207   END IF
3208   ! On peut s'amuser avec nos valeur d'energies
3209   !MALLOC(TabX,(1:20))
3210   !MALLOC(TabY,(1:20))
3211 
3212   TabX(1) = DBLE(op%modNoise2)
3213   TabX(2) = DBLE(op%modNoise1)
3214 
3215   ! Il faut calculer pour chaque modulo 10 ecarts type sur les donnes acquises
3216   op%measNoise(1)%vec(1:n1) = op%measNoise(1)%vec(1:n1)/(op%beta*DBLE(op%modNoise1))*DBLE(op%measurements)
3217   op%measNoise(2)%vec(1:n2) = op%measNoise(2)%vec(1:n2)/(op%beta*DBLE(op%modNoise2))*DBLE(op%measurements)
3218 !  CALL Vector_print(op%measNoise(1),op%rank+70)
3219 !  CALL Vector_print(op%measNoise(2),op%rank+50)
3220 !  DO iflavor=1,10
3221 !    debut = (iflavor-1)*n2/10+1
3222 !    fin   = iflavor*n2/10
3223 !    TabY(iflavor) = Stat_deviation(op%measNoise(2)%vec(debut:fin))
3224 !    debut = (iflavor-1)*n1/10+1
3225 !    fin   = iflavor*n1/10
3226 !    TabY(10+iflavor) = Stat_deviation(op%measNoise(1)%vec(debut:fin))
3227 !  END DO
3228 !!  TabY(1:n) = (op%measNoise(2)%vec(1:n)   &
3229 !!              )
3230 !!             !/(op%beta*DBLE(op%modNoise2))*DBLE(op%measurements) &
3231 !!             !- op%measDE(1,1))
3232 !!  TabY(op%measNoise(2)%tail+1:n+op%measNoise(2)%tail) = (op%measNoise(1)%vec(1:n)   &
3233 !!               )
3234 !!             ! /(op%beta*DBLE(op%modNoise1))*DBLE(op%measurements) &
3235 !!             ! - op%measDE(1,1))
3236 !  IF ( op%rank .EQ. 0 ) THEN
3237 !    DO iflavor=1,20
3238 !      write(45,*) TabX(iflavor), TabY(iflavor)
3239 !    END DO
3240 !  END IF
3241 !
3242 
3243 
3244   TabY(1) = Stat_deviation(op%measNoise(2)%vec(1:n2))!*SQRT(n2/(n2-1))
3245 !!  write(op%rank+10,*) TabX(2)
3246 !!  write(op%rank+40,*) TabX(1)
3247 !!  CALL Vector_print(op%measNoise(1),op%rank+10)
3248 !!  CALL Vector_print(op%measNoise(2),op%rank+40)
3249 !!  CLOSE(op%rank+10)
3250 !!  CLOSE(op%rank+40)
3251   TabY(2) = Stat_deviation(op%measNoise(1)%vec(1:n1))!*SQRT(n1/(n1-1))
3252 !!  ! Ecart carre moyen ~ ecart type mais non biaise. Serait moins precis. Aucun
3253   ! impact sur la pente, juste sur l'ordonnee a l'origine.
3254 
3255   CALL Stat_powerReg(TabX,SQRT(2.d0*LOG(2.d0))*TabY,a,b,r)
3256 !  FREE(TabX)
3257 !  FREE(TabY)
3258   ! ecart type -> 60%
3259   ! largeur a mi-hauteur d'une gaussienne -> sqrt(2*ln(2))*sigma
3260 
3261   !op%measDE(1,1) = SUM(op%measNoise(1)%vec(1:op%measNoise(1)%tail))/(DBLE(op%measNoise(1)%tail*op%modNoise1)*op%beta)
3262   !op%measDE(2:flavors,1:flavors) = op%measDE(2:flavors,1:flavors) /(DBLE(op%sweeps)*op%beta)
3263   CALL ImpurityOperator_getErrorOverlap(op%Impurity,op%measDE)
3264   ! Add the difference between true calculation and quick calculation of the
3265   ! last sweep overlap to measDE(2,2)
3266   !op%measDE = op%measDE * DBLE(op%measurements) 
3267   IF ( op%have_MPI .EQV. .TRUE. ) THEN 
3268     IF ( op%opt_analysis .EQ. 1 ) THEN
3269       buffer(last+1:last+sp1,:) = op%measCorrelation(:,1,:)
3270       last = last + sp1
3271       buffer(last+1:last+sp1,:) = op%measCorrelation(:,2,:)
3272       last = last + sp1
3273       buffer(last+1:last+sp1,:) = op%measCorrelation(:,3,:)
3274       last = last + sp1
3275     END IF
3276     IF ( op%opt_order .GT. 0 ) THEN
3277       buffer(last+1:last+op%opt_order, :) = op%measPerturbation(:,:)
3278       last = last + op%opt_order
3279     END IF
3280     IF ( op%opt_noise .EQ. 1 ) THEN
3281       buffer(last+1:last+op%samples+1,:) = alpha(:,:)
3282       last = last + op%samples + 1
3283       buffer(last+1:last+op%samples+1,:) = beta(:,:)
3284       last = last + op%samples + 1
3285     END IF
3286 !  op%measDE(2,2) = a*EXP(b*LOG(DBLE(op%sweeps*op%size)))
3287     buffer(spall-(flavors+5):spAll-6,:) = op%measDE(:,:)
3288 !    buffer(spAll  ,1) = op%seg_added   
3289 !    buffer(spAll-1,1) = op%seg_removed 
3290 !    buffer(spAll-2,1) = op%seg_sign    
3291 !    buffer(spAll  ,2) = op%anti_added  
3292 !    buffer(spAll-1,2) = op%anti_removed
3293 !    buffer(spAll-2,2) = op%anti_sign   
3294     buffer(spAll  ,1) = op%stats(1)
3295     buffer(spAll-1,1) = op%stats(2)
3296     buffer(spAll-2,1) = op%stats(3)
3297     buffer(spAll  ,2) = op%stats(4)
3298     buffer(spAll-1,2) = op%stats(5)
3299     buffer(spAll-2,2) = op%stats(6)
3300     buffer(spAll-3,1) = op%swap
3301     buffer(spAll-3,2) = DBLE(op%modGlobalMove(2))
3302     buffer(spAll-4,1) = a
3303     buffer(spAll-4,2) = b
3304 !#ifdef CTCtqmcoffdiag_CHECK
3305     buffer(spAll-5,1) = op%errorImpurity
3306     buffer(spAll-5,2) = op%errorBath 
3307     signvaluemeassum = 0
3308 !#endif
3309 
3310 #ifdef HAVE_MPI
3311    !write(6,*) "bufferbefore",buffer(1,1)
3312     CALL MPI_ALLREDUCE(MPI_IN_PLACE, buffer, spAll*flavors, &
3313                      MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr)
3314    !write(6,*) "bufferafter",buffer(1,1)
3315    ! CALL MPI_ALLREDUCE(MPI_IN_PLACE, buffer2, sp1*flavors*flavors, &
3316    !                  MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr)
3317     CALL MPI_ALLREDUCE( buffer2, buffer2s, sizeoper*flavors*flavors, &
3318                      MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr)
3319    !write(6,*) "justaftermpi",op%Greens%oper(1,1,1) ,buffer2s(1,1,1)
3320     CALL MPI_ALLREDUCE(MPI_IN_PLACE, op%runTime, 1, MPI_DOUBLE_PRECISION, MPI_MAX, &
3321              op%MY_COMM, ierr)
3322     CALL MPI_ALLREDUCE(op%Greens%signvaluemeas, signvaluemeassum , 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
3323              op%MY_COMM, ierr)
3324     IF ( op%opt_histo .GT. 0 ) THEN
3325       CALL MPI_ALLREDUCE(MPI_IN_PLACE, op%occup_histo_time, flavors+1, MPI_DOUBLE_PRECISION, MPI_SUM, &
3326              op%MY_COMM, ierr)
3327     END IF
3328     CALL MPI_ALLREDUCE(MPI_IN_PLACE, sumh, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
3329              op%MY_COMM, ierr)
3330     IF ( op%opt_order .GT. 0 ) THEN
3331       CALL MPI_ALLREDUCE(op%meas_fullemptylines, fullempty, 2*flavors, MPI_DOUBLE_PRECISION, MPI_SUM, &
3332                op%MY_COMM, ierr)
3333     ENDIF
3334 #endif
3335 
3336   
3337     buffer          = buffer * inv_size
3338     op%measDE(:,:)  = buffer(spall-(flavors+5):spAll-6,:)
3339 !    op%seg_added    = buffer(spAll  ,1)
3340 !    op%seg_removed  = buffer(spAll-1,1)
3341 !    op%seg_sign     = buffer(spAll-2,1)
3342 !    op%anti_added   = buffer(spAll  ,2)
3343 !    op%anti_removed = buffer(spAll-1,2)
3344 !    op%anti_sign    = buffer(spAll-2,2)
3345     op%stats(1)    = buffer(spAll  ,1)
3346     op%stats(2)    = buffer(spAll-1,1)
3347     op%stats(3)    = buffer(spAll-2,1)
3348     op%stats(4)    = buffer(spAll  ,2)
3349     op%stats(5)    = buffer(spAll-1,2)
3350     op%stats(6)    = buffer(spAll-2,2)
3351     op%swap         = buffer(spAll-3,1)
3352     op%modGlobalMove(2) = NINT(buffer(spAll-3,2))
3353     a               = buffer(spAll-4,1) 
3354     b               = buffer(spAll-4,2)
3355 !!#ifdef CTCtqmcoffdiag_CHECK
3356     op%errorImpurity= buffer(spAll-5,1) 
3357     op%errorBath    = buffer(spAll-5,2)   
3358 !#endif
3359 
3360    ! DO iflavor = 1, flavors
3361    !   op%Greens(iflavor)%oper          = buffer(1:sp1          , iflavor)
3362    ! END DO
3363     op%Greens%oper = buffer2s/float(nbprocs)
3364    ! write(6,*) "buffer2s",(op%Greens%oper(1,n1,n1),n1=1,flavors)
3365     op%Greens%signvaluemeas = signvaluemeassum/float(nbprocs)
3366     !sui!write(6,*) "nbprocs",nbprocs,op%Greens%signvaluemeas
3367     op%Greens%oper = op%Greens%oper / op%Greens%signvaluemeas
3368    ! write(6,*) "buffer3s",(op%Greens%oper(1,n1,n1),n1=1,flavors)
3369     IF ( op%opt_order .GT. 0 ) THEN
3370       op%meas_fullemptylines= fullempty/float(nbprocs)
3371     ENDIF
3372     do iflavor=1,flavors
3373       do itau=1,sizeoper
3374     !sui!write(6,*) "greens_av",iflavor,itau,op%Greens%oper(itau,iflavor,iflavor)
3375       enddo
3376     enddo
3377    !write(6,*) "aftermpi",op%Greens%oper(1,1,1) ,buffer2s(1,1,1)
3378     last = sp1
3379     IF ( op%opt_analysis .EQ. 1 ) THEN
3380       op%measCorrelation(:,1,:) = buffer(last+1:last+sp1,:) 
3381       last = last + sp1
3382       op%measCorrelation(:,2,:) = buffer(last+1:last+sp1,:) 
3383       last = last + sp1
3384       op%measCorrelation(:,3,:) = buffer(last+1:last+sp1,:) 
3385       last = last + sp1
3386     END IF
3387     IF ( op%opt_order .GT. 0 ) THEN
3388       op%measPerturbation(:,:) = buffer(last+1:last+op%opt_order, :)
3389       last = last + op%opt_order
3390     END IF
3391     IF ( op%opt_noise .EQ. 1 ) THEN
3392       alpha(:,:) = buffer(last+1:last+op%samples+1,:)
3393       last = last + op%samples + 1
3394       beta(:,:) = buffer(last+1:last+op%samples+1,:)
3395       last = last + op%samples + 1
3396     END IF
3397   END IF
3398   DO iflavor = 1, flavors
3399     ! complete DE matrix
3400     op%measDE(iflavor, iflavor+1:flavors) = op%measDE(iflavor+1:flavors,iflavor)
3401   END DO
3402   FREE(buffer)
3403   FREE(buffer2)
3404   FREE(buffer2s)
3405   FREE(fullempty)
3406 
3407   IF ( op%opt_spectra .GE. 1 ) THEN
3408     endDensity = SIZE(op%density,2)
3409     IF ( op%density(1,endDensity) .EQ. -1.d0 ) &
3410       endDensity = endDensity - 1
3411     CALL FFTHyb_init(FFTmrka,endDensity,DBLE(op%thermalization)/DBLE(op%measurements*op%opt_spectra))
3412     ! Not very Beauty 
3413     MALLOC(freqs,(1:FFTmrka%size/2))
3414     DO iflavor = 1, flavors
3415       ! mean value is removed to supress the continue composent 
3416       CALL FFTHyb_setData(FFTmrka,op%density(iflavor,1:endDensity)/op%beta+op%Greens%oper(op%samples+1,iflavor,iflavor))
3417       CALL FFTHyb_run(FFTmrka,1)
3418       CALL FFTHyb_getData(FFTmrka,endDensity,op%density(iflavor,:),freqs)
3419     END DO
3420     op%density(flavors+1,:) = -1.d0
3421     op%density(flavors+1,1:FFTmrka%size/2) = freqs
3422     CALL FFTHyb_destroy(FFTmrka)
3423     FREE(freqs)
3424   END IF
3425 
3426   op%a_Noise = a
3427   op%b_Noise = b
3428   IF ( op%opt_noise .EQ. 1 ) THEN
3429     op%abNoiseG(1,:,:) = alpha
3430     op%abNoiseG(2,:,:) = beta
3431   END IF
3432   FREE(alpha)
3433   FREE(beta)
3434   IF ( op%opt_histo .GT. 0 ) THEN
3435     write(op%ostream,*) "=== Histogram of occupations for complete simulation  ===="
3436  !   write(6,*) "sumh over procs", sumh
3437     sumh=0
3438     do n1=1,op%flavors+1
3439        write(op%ostream,'(i4,f10.4)')  n1-1, op%occup_histo_time(n1)/float(nbprocs)
3440        sumh=sumh+op%occup_histo_time(n1)/float(nbprocs)
3441     enddo
3442        write(op%ostream,'(a,f10.4)') " all" , sumh
3443     write(op%ostream,*) "================================="
3444   END IF
3445 
3446 END SUBROUTINE Ctqmcoffdiag_getResult

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_init [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_init

FUNCTION

  Initialize the type Ctqmcoffdiag
  Allocate all the non optional variables

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  ostream=where to write
  istream=where to read the input parameters if so
  bFile=logical argument True if input is read from istream
  MY_COMM=mpi communicator for the CTQMC
  iBuffer=input parameters if bFile is false

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

324 SUBROUTINE Ctqmcoffdiag_init(op, ostream, istream, bFile, MY_COMM, iBuffer)
325 
326 
327 #ifdef HAVE_MPI1
328 include 'mpif.h'
329 #endif
330 !Arguments ------------------------------------
331   TYPE(Ctqmcoffdiag), INTENT(INOUT)                      :: op
332   INTEGER  , INTENT(IN   )                      :: ostream
333   INTEGER  , INTENT(IN   )                      :: istream
334   LOGICAL  , INTENT(IN   )                      :: bFile
335   DOUBLE PRECISION, DIMENSION(1:10), OPTIONAL, INTENT(IN) :: iBuffer
336   INTEGER  , OPTIONAL, INTENT(IN   )                      :: MY_COMM
337 !Local variables ------------------------------
338 #ifdef HAVE_MPI
339   INTEGER                                       :: ierr
340 #endif
341   !INTEGER                                       :: iflavor
342 #ifdef __GFORTRAN__
343 !  INTEGER                                       :: pid
344 !  CHARACTER(LEN=5)                              :: Cpid
345 !
346 #endif
347   DOUBLE PRECISION, DIMENSION(1:10)             :: buffer
348 
349   op%ostream = ostream
350   op%istream = istream
351   
352 ! --- RENICE ---
353 !#ifdef __GFORTRAN__
354 !  pid = GetPid()
355 !  WRITE(Cpid,'(I5)') pid
356 !  CALL SYSTEM('renice +19 '//TRIM(ADJUSTL(Cpid))//' > /dev/null')
357 !#endif
358 !! --- RENICE ---
359 
360   IF ( PRESENT(MY_COMM)) THEN
361 #ifdef HAVE_MPI
362     op%have_MPI = .TRUE.
363     op%MY_COMM = MY_COMM
364     CALL MPI_Comm_rank(op%MY_COMM, op%rank, ierr)
365     CALL MPI_Comm_size(op%MY_COMM, op%size, ierr)
366 #else
367     CALL WARN("MPI is not used                                    ")
368     op%have_MPI = .FALSE.
369     op%MY_COMM = -1
370     op%rank = 0
371     op%size = 1
372 #endif
373   ELSE
374     op%have_MPI = .FALSE.
375     op%MY_COMM = -1
376     op%rank = 0
377     op%size = 1
378   END IF
379 
380   !IF ( op%rank .EQ. 0 ) THEN
381 !  WRITE(ostream,'(A20)') 'Job reniced with +19'
382     !CALL FLUSH(ostream)
383   !END IF
384 
385   IF ( bFile .EQV. .TRUE. ) THEN
386     IF ( op%rank .EQ. 0 ) THEN
387 
388       READ(istream,*) buffer(1) !iseed
389       READ(istream,*) buffer(2) !op%sweeps
390       READ(istream,*) buffer(3) !op%thermalization
391       READ(istream,*) buffer(4) !op%measurements
392       READ(istream,*) buffer(5) !op%flavors
393       READ(istream,*) buffer(6) !op%samples
394       READ(istream,*) buffer(7) !op%beta
395       READ(istream,*) buffer(8) !U
396       READ(istream,*) buffer(9) !iTech
397       !READ(istream,*) buffer(9) !Wmax
398 !#ifdef CTCtqmcoffdiag_ANALYSIS
399       !READ(istream,*) buffer(10) !order
400 !#endif
401     END IF
402 
403 #ifdef HAVE_MPI
404     IF ( op%have_MPI .EQV. .TRUE. ) &
405       CALL MPI_Bcast(buffer, 10, MPI_DOUBLE_PRECISION, 0,    &
406                    op%MY_COMM, ierr)
407 #endif
408   ELSE IF ( PRESENT(iBuffer) ) THEN
409     buffer(1:10) = iBuffer(1:10)
410   ELSE
411     CALL ERROR("Ctqmcoffdiag_init : No input parameters                    ")
412   END IF
413 
414   CALL Ctqmcoffdiag_setParameters(op, buffer)
415 
416   CALL Ctqmcoffdiag_allocateAll(op)
417 
418   CALL GreenHyboffdiag_init(op%Greens,op%samples, op%beta,INT(buffer(5)), &
419   iTech=INT(buffer(9)),MY_COMM=op%MY_COMM)
420 
421 
422 !  op%seg_added    = 0.d0
423 !  op%anti_added   = 0.d0
424 !  op%seg_removed  = 0.d0
425 !  op%anti_removed = 0.d0
426 !  op%seg_sign     = 0.d0
427 !  op%anti_sign    = 0.d0
428   op%stats(:)     = 0.d0
429  ! write(std_out,*) "op%stats",op%stats
430   op%signvalue    = 1.d0
431 !  op%signvaluecurrent    = 0.d0
432 !  op%signvaluemeas = 0.d0
433   op%swap         = 0.d0
434   op%runTime      = 0.d0
435 
436   CALL Vector_init(op%measNoise(1),op%sweeps/op%modNoise1)
437   CALL Vector_init(op%measNoise(2),(op%sweeps/op%modNoise1+1)*CTQMC_SLICE2)
438   !CALL Vector_init(op%measNoise(3),101)
439   !CALL Vector_init(op%measNoise(4),101)
440 
441   op%set  = op%para .AND. op%inF
442   op%done = .FALSE.
443   op%init = .TRUE.
444 
445 !#ifdef CTCtqmcoffdiag_CHECK
446   op%errorImpurity = 0.d0
447   op%errorBath     = 0.d0
448 !#endif
449 END SUBROUTINE Ctqmcoffdiag_init

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_loop [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_loop

FUNCTION

  Definition the main loop of the CT-QMC

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  itotal=number of sweeps to perform : thermalization or sweeps
  ilatex=unit of file to write movie if so

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

1877 SUBROUTINE Ctqmcoffdiag_loop(op,itotal,ilatex)
1878 
1879 !Arguments ------------------------------------
1880   TYPE(Ctqmcoffdiag), INTENT(INOUT)         :: op
1881   INTEGER    , INTENT(IN   )         :: itotal
1882   INTEGER    , INTENT(IN   )         :: ilatex
1883 !Local variables ------------------------------
1884   LOGICAL                            :: updated 
1885   LOGICAL                            :: updated_seg
1886   LOGICAL, DIMENSION(:), ALLOCATABLE :: updated_swap
1887 
1888   INTEGER                            :: flavors
1889   INTEGER                            :: measurements
1890   INTEGER                            :: modNoise1
1891   INTEGER                            :: modNoise2
1892   INTEGER                            :: modGlobalMove
1893   INTEGER                            :: sp1
1894   INTEGER                            :: itau   
1895   INTEGER                            :: ind
1896   INTEGER                            :: endDensity
1897   INTEGER                            :: indDensity
1898   INTEGER                            :: swapUpdate1
1899   INTEGER                            :: swapUpdate2
1900   INTEGER                            :: old_percent
1901   INTEGER                            :: new_percent
1902   INTEGER                            :: ipercent !,ii
1903   INTEGER                            :: iflavor,ifl1,iflavor_d
1904   INTEGER                            :: isweep
1905 
1906   DOUBLE PRECISION                   :: cpu_time1
1907   DOUBLE PRECISION                   :: cpu_time2
1908   DOUBLE PRECISION                   :: NRJ_old1
1909   DOUBLE PRECISION                   :: NRJ_old2
1910   DOUBLE PRECISION                   :: NRJ_new
1911   DOUBLE PRECISION                   :: total
1912   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_old1
1913   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_old2
1914   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_new
1915 
1916   CALL CPU_TIME(cpu_time1)
1917 
1918   flavors        = op%flavors
1919   measurements   = op%measurements
1920   modNoise1      = op%modNoise1
1921   modNoise2      = op%modNoise2
1922   modGlobalMove  = op%modGlobalMove(1)
1923   sp1            = op%samples+1
1924   IF ( op%opt_histo .GT. 0 ) THEN
1925     op%occup_histo_time= 0.d0
1926   END IF
1927 
1928   old_percent    = 0
1929 
1930   MALLOC(updated_swap,(1:flavors))
1931   updated_swap(:) = .FALSE.
1932 
1933   NRJ_old1  = 0.d0
1934   NRJ_old2  = 0.d0
1935   NRJ_new   = 0.d0
1936 
1937   MALLOC(gtmp_new,(1,1))
1938   gtmp_new  = 0.d0
1939   MALLOC(gtmp_old1,(1,1))
1940   gtmp_old1 = 0.d0
1941   MALLOC(gtmp_old2,(1,1))
1942   gtmp_old2 = 0.d0
1943 
1944   endDensity = SIZE(op%density,2)
1945 
1946   IF ( op%opt_noise .GT. 0 ) THEN
1947     FREEIF(gtmp_new)
1948     MALLOC(gtmp_new,(1:sp1,1:flavors))
1949     FREEIF(gtmp_old1)
1950     MALLOC(gtmp_old1,(1:sp1,1:flavors))
1951     FREEIF(gtmp_old2)
1952     MALLOC(gtmp_old2,(1:sp1,1:flavors))
1953   END IF
1954 
1955   IF ( op%rank .EQ. 0 ) THEN
1956     WRITE(op%ostream, '(1x,103A)') &
1957     "|----------------------------------------------------------------------------------------------------|"
1958     WRITE(op%ostream,'(1x,A)', ADVANCE="NO") "|"
1959   END IF
1960 
1961   total = DBLE(itotal)
1962   !write(std_out,*) "itotal",itotal
1963   indDensity = 1
1964   !write(std_out,*) "op%stats",op%stats
1965   DO isweep = 1, itotal
1966   !ii if(op%prtopt==1) write(std_out,*) "======== Isweep = ",isweep
1967     !updated_seg=.FALSE.
1968     DO iflavor = 1, flavors
1969      ! if(isweep==itotal) write(std_out,*) "    Iflavor = ",iflavor,op%Impurity%Particles(iflavor)%tail
1970    !ii if(op%prtopt==1)  write(std_out,*) "      ===Iflavor = ",iflavor
1971       op%Impurity%activeFlavor=iflavor
1972       op%Bath%activeFlavor=iflavor ; op%Bath%MAddFlag= .FALSE. ; op%Bath%MRemoveFlag = .FALSE.
1973 
1974       !write(std_out,*) "before tryaddremove"
1975 
1976       ! For iflavor, Try a move
1977       !==========================
1978       CALL Ctqmcoffdiag_tryAddRemove(op,updated_seg)
1979     !sui!write(std_out,*) "after tryaddremove",updated_seg
1980 
1981       updated = updated_seg .OR.  updated_swap(iflavor).OR.(isweep==1)
1982       updated_swap(iflavor) = .FALSE.
1983       if ( op%opt_nondiag >0 )  iflavor_d=0
1984       if ( op%opt_nondiag==0 )  iflavor_d=iflavor
1985       CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, updated,op%signvalue,iflavor_d) 
1986 
1987       CALL Ctqmcoffdiag_measN        (op, iflavor, updated)
1988       IF ( op%opt_analysis .EQ. 1 ) &
1989         CALL Ctqmcoffdiag_measCorrelation (op, iflavor)
1990       IF ( op%opt_order .GT. 0 ) &
1991         CALL Ctqmcoffdiag_measPerturbation(op, iflavor)
1992     END DO
1993     !CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, updated,op%signvalue,iflavor_d) 
1994     !DO iflavor = 1,flavors
1995     !  CALL Ctqmcoffdiag_measN        (op, iflavor, updated)
1996     !END DO
1997 
1998     IF ( MOD(isweep,modGlobalMove) .EQ. 0 ) THEN
1999   ! !sui!write(std_out,*) "isweep,modGlobalMove,inside",isweep,modGlobalMove
2000       CALL Ctqmcoffdiag_trySwap(op,swapUpdate1, swapUpdate2)
2001      ! !write(std_out,*) "no global move yet for non diag hybridization"
2002       IF ( swapUpdate1 .NE. 0 .AND. swapUpdate2 .NE. 0 ) THEN
2003         updated_swap(swapUpdate1) = .TRUE.
2004         updated_swap(swapUpdate2) = .TRUE.
2005       END IF
2006     END IF
2007     
2008     IF ( MOD(isweep,measurements) .EQ. 0 ) THEN ! default is always 
2009       CALL ImpurityOperator_measDE(op%Impurity,op%measDE)
2010       IF ( op%opt_spectra .GE. 1 .AND. MOD(isweep,measurements*op%opt_spectra) .EQ. 0 ) THEN
2011         op%density(1:flavors,indDensity) = op%measN(3,1:flavors)
2012         indDensity = indDensity+1
2013       END IF
2014     END IF
2015 
2016     IF ( MOD(isweep,measurements) .EQ. 0 ) THEN
2017       IF ( op%opt_histo .GT. 0 ) THEN
2018         CALL ImpurityOperator_occup_histo_time(op%Impurity,op%occup_histo_time)
2019       END IF
2020     ENDIF
2021 
2022     IF ( MOD(isweep, modNoise1) .EQ. 0 ) THEN
2023       !modNext = isweep + modNoise2
2024       NRJ_new = op%measDE(1,1)
2025       CALL Vector_pushBack(op%measNoise(1),NRJ_new - NRJ_old1)
2026       NRJ_old1 = NRJ_new
2027 
2028       !! Try to limit accumulation error
2029       CALL ImpurityOperator_cleanOverlaps(op%Impurity)
2030 
2031       IF ( op%opt_noise .EQ. 1 ) THEN
2032         DO ifl1 = 1, flavors
2033           DO ind = 1, op%Greens%map(ifl1,ifl1)%tail
2034             itau = op%Greens%map(ifl1,ifl1)%listINT(ind)
2035             gtmp_new(itau,ifl1) = op%Greens%oper(itau,ifl1,ifl1) & 
2036                      +op%Greens%map(ifl1,ifl1)%listDBLE(ind)*DBLE(op%Greens%factor)
2037           END DO
2038           DO itau = 1, sp1
2039            CALL Vector_pushBack(op%measNoiseG(itau,ifl1,1), gtmp_new(itau,ifl1) - gtmp_old1(itau,ifl1))
2040            gtmp_old1(itau,ifl1) = gtmp_new(itau,ifl1)
2041           END DO
2042         END DO
2043       END IF
2044     END IF
2045 
2046     IF ( MOD(isweep,modNoise2) .EQ. 0 ) THEN
2047       NRJ_new = op%measDE(1,1)
2048       CALL Vector_pushBack(op%measNoise(2),NRJ_new - NRJ_old2)
2049       NRJ_old2 = NRJ_new
2050       IF ( op%opt_noise .EQ. 1 ) THEN
2051         DO ifl1 = 1, flavors
2052           DO ind = 1, op%Greens%map(ifl1,ifl1)%tail
2053             itau = op%Greens%map(ifl1,ifl1)%listINT(ind)
2054             gtmp_new(itau,ifl1) = op%Greens%oper(itau,ifl1,ifl1) & 
2055                   +op%Greens%map(ifl1,ifl1)%listDBLE(ind)*op%Greens%factor
2056           END DO
2057           DO itau = 1, sp1
2058             CALL Vector_pushBack(op%measNoiseG(itau,ifl1,2), gtmp_new(itau,ifl1) - gtmp_old2(itau,ifl1))
2059             gtmp_old2(itau,ifl1) = gtmp_new(itau,ifl1)
2060           END DO
2061         END DO 
2062       END IF
2063 
2064       IF ( op%rank .EQ. 0 ) THEN 
2065         new_percent = CEILING(DBLE(isweep)*100.d0/DBLE(itotal))
2066         DO ipercent = old_percent+1, new_percent 
2067           WRITE(op%ostream,'(A)',ADVANCE="NO") "-"
2068         END DO
2069         old_percent = new_percent
2070       END IF
2071     END IF
2072 
2073     IF ( op%opt_movie .EQ. 1 ) THEN
2074       WRITE(ilatex,'(A11,I9)') "%iteration ", isweep
2075       CALL ImpurityOperator_printLatex(op%Impurity,ilatex,isweep)
2076     END IF
2077 
2078   END DO
2079 
2080   IF ( op%rank .EQ. 0 ) THEN
2081     DO ipercent = old_percent+1, 100
2082       WRITE(op%ostream,'(A)',ADVANCE="NO") "-"
2083     END DO
2084     WRITE(op%ostream,'(A)') "|"
2085   END IF
2086  
2087   FREE(gtmp_new)
2088   FREE(gtmp_old1)
2089   FREE(gtmp_old2)
2090   FREE(updated_swap)
2091 
2092   IF ( op%opt_spectra .GE. 1 .AND. itotal .EQ. op%sweeps ) THEN
2093     IF ( endDensity .NE. indDensity-1 ) THEN
2094       op%density(:,endDensity) = -1.d0
2095     END IF
2096   END IF
2097 
2098   CALL CPU_TIME(cpu_time2)
2099 
2100   op%runTime = (cpu_time2 - cpu_time1)*1.05d0 ! facteur arbitraire de correction
2101 END SUBROUTINE Ctqmcoffdiag_loop

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measCorrelation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_measCorrelation

FUNCTION

  measure all correlations in times for a flavor

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  iflavor=the flavor to measure

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

2801 SUBROUTINE Ctqmcoffdiag_measCorrelation(op, iflavor)
2802 
2803 !Arguments ------------------------------------
2804   TYPE(Ctqmcoffdiag)             , INTENT(INOUT)       :: op
2805   !TYPE(ImpurityOperator), INTENT(IN   )       :: impurity
2806   INTEGER               , INTENT(IN   )       :: iflavor
2807 !Local variables ------------------------------
2808   INTEGER                                     :: iCdag
2809   INTEGER                                     :: iCdagBeta
2810   INTEGER                                     :: iC
2811   INTEGER                                     :: index
2812   INTEGER                                     :: size
2813   DOUBLE PRECISION                            :: tC
2814   DOUBLE PRECISION                            :: tCdag
2815   !DOUBLE PRECISION                            :: time
2816   DOUBLE PRECISION                            :: inv_dt
2817   DOUBLE PRECISION                            :: beta
2818 
2819   IF ( .NOT. op%set ) &
2820     CALL ERROR("Ctqmcoffdiag_measCorrelation : QMC not set                 ")
2821     !write(6,*) "not available"
2822     stop
2823 
2824   size = op%impurity%particles(op%impurity%activeFlavor)%tail
2825   beta = op%beta
2826 
2827   IF ( size .EQ. 0 ) RETURN
2828   
2829   inv_dt = op%inv_dt
2830 
2831   DO iCdag = 1, size ! first segments
2832     tCdag  = op%impurity%particles(op%impurity%activeFlavor)%list(iCdag,Cdag_)
2833     tC     = op%impurity%particles(op%impurity%activeFlavor)%list(iCdag,C_   )
2834     index = INT( ( (tC - tCdag)  * inv_dt ) + .5d0 ) + 1
2835     op%measCorrelation(index,1,iflavor) = op%measCorrelation(index,1,iflavor) + 1.d0
2836     MODCYCLE(iCdag+1,size,iCdagBeta)
2837     index = INT( ( ( &
2838                     op%impurity%particles(op%impurity%activeFlavor)%list(iCdagBeta,Cdag_) - tC &
2839                     + AINT(DBLE(iCdag)/DBLE(size))*beta &
2840                    )  * inv_dt ) + .5d0 ) + 1
2841     IF ( index .LT. 1 .OR. index .GT. op%samples+1 ) THEN
2842       CALL WARN("Ctqmcoffdiag_measCorrelation : bad index line 1095         ")
2843     ELSE
2844       op%measCorrelation(index,2,iflavor) = op%measCorrelation(index,2,iflavor) + 1.d0
2845     END IF
2846 !    DO iC = 1, size
2847 !      tC = impurity%particles(impurity%activeFlavor)%list(C_,iC)
2848 !      time = tC - tCdag
2849 !      IF ( time .LT. 0.d0 ) time = time + beta
2850 !      index = INT( ( time * inv_dt ) + .5d0 ) + 1
2851 !      op%measCorrelation(index,3,iflavor) = op%measCorrelation(index,3,iflavor) + 1.d0
2852 !    END DO
2853     DO iC = 1, size!  op%Greens(iflavor)%index_old%tail 
2854 !todoba        op%measCorrelation(op%Greens(iflavor)%map%listINT(iC+(iCdag-1)*size),3,iflavor) = &
2855 !todoba        op%measCorrelation(op%Greens(iflavor)%map%listINT(iC+(iCdag-1)*size),3,iflavor) + 1.d0
2856     END DO
2857   END DO
2858 
2859 END SUBROUTINE Ctqmcoffdiag_measCorrelation

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measN [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_measN

FUNCTION

  measures the number of electron
  by taking into account the value for the move before before this one
  with the correct weight.

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  iflavor=which flavor to measure
  updated=something has changed since last time

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

2737 SUBROUTINE Ctqmcoffdiag_measN(op, iflavor, updated)
2738 
2739 !Arguments ------------------------------------
2740   TYPE(Ctqmcoffdiag)             , INTENT(INOUT)     :: op
2741   !TYPE(ImpurityOperator), INTENT(IN   )     :: impurity
2742   INTEGER               , INTENT(IN   )     :: iflavor
2743   LOGICAL               , INTENT(IN   )     :: updated
2744 
2745 !  IF ( .NOT. op%set ) &
2746 !    CALL ERROR("Ctqmcoffdiag_measN : QMC not set                           ")
2747 
2748   
2749   IF ( updated .EQV. .TRUE. ) THEN
2750 !  --- accumulate occupations with values op%measN(3,iflavor) from the last measurements with the corresponding weight
2751 !  ---  op*measN(4,iflavor)
2752     op%measN(1,iflavor) = op%measN(1,iflavor) + op%measN(3,iflavor)*op%measN(4,iflavor)
2753    ! write(6,*) "Cllll42"
2754 
2755 !  --- Compute total number of new measurements 
2756     op%measN(2,iflavor) = op%measN(2,iflavor) + op%measN(4,iflavor)
2757 
2758    ! write(6,*) "Allll42"
2759 !  --- Compute the occupation for this configuration (will be put in
2760 !  --- op%measN(1,iflavor) at the next occurence of updated=.true.), with
2761 !  --- the corresponding weight  op%measN(4,iflavor) (we do not now it yet)
2762     op%measN(3,iflavor) = ImpurityOperator_measN(op%impurity)
2763 
2764 !  --- set weight: as update=true, it is a new measurement , so put it to one
2765     op%measN(4,iflavor) = 1.d0
2766 
2767   ELSE
2768 !  --- increased the count so that at new move, we will be able to update measN(1) correctly.
2769     op%measN(4,iflavor) = op%measN(4,iflavor) + 1.d0
2770    ! write(6,*) "Bllll42"
2771   END IF
2772 END SUBROUTINE Ctqmcoffdiag_measN

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measPerturbation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_measPerturbation

FUNCTION

  measure perturbation order

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  iflavor=the flavor to measure

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

2887 SUBROUTINE Ctqmcoffdiag_measPerturbation(op, iflavor)
2888 
2889 !Arguments ------------------------------------
2890   TYPE(Ctqmcoffdiag)             , INTENT(INOUT)     :: op
2891   !TYPE(ImpurityOperator), INTENT(IN   )     :: impurity
2892   INTEGER               , INTENT(IN   )     :: iflavor
2893 !Local variables ------------------------------
2894   INTEGER                                   :: index
2895 
2896   IF ( .NOT. op%set ) &
2897     CALL ERROR("Ctqmcoffdiag_measiPerturbation : QMC not set               ")
2898 
2899   index = op%impurity%particles(op%impurity%activeFlavor)%tail + 1
2900   IF ( index .LE. op%opt_order ) &
2901     op%measPerturbation(index,iflavor) = op%measPerturbation(index,iflavor) + 1.d0
2902   IF ( index == 1 ) THEN
2903     IF (op%impurity%particles(iflavor)%list(0,C_) < op%impurity%particles(iflavor)%list(0,Cdag_) ) THEN
2904       op%meas_fullemptylines(1,iflavor) = op%meas_fullemptylines(1,iflavor) + 1.d0
2905     ELSE
2906       op%meas_fullemptylines(2,iflavor) = op%meas_fullemptylines(2,iflavor) + 1.d0
2907     ENDIF
2908   ENDIF
2909 
2910 END SUBROUTINE Ctqmcoffdiag_measPerturbation

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printAll [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printAll

FUNCTION

  print different functions computed during the simulation

COPYRIGHT

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

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

3904 SUBROUTINE Ctqmcoffdiag_printAll(op)
3905 
3906 !Arguments ------------------------------------
3907   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
3908 
3909   IF ( .NOT. op%done ) &
3910     CALL WARNALL("Ctqmcoffdiag_printAll : Simulation not run                 ")
3911 
3912 !sui!write(6,*) "op%stats",op%stats
3913   CALL Ctqmcoffdiag_printQMC(op)
3914 
3915   CALL Ctqmcoffdiag_printGreen(op)
3916 
3917   CALL Ctqmcoffdiag_printD(op)
3918 
3919 !  CALL Ctqmcoffdiag_printE(op)
3920 
3921 !#ifdef CTCtqmcoffdiag_ANALYSIS
3922   CALL Ctqmcoffdiag_printPerturbation(op)
3923 
3924   CALL Ctqmcoffdiag_printCorrelation(op)
3925 !#endif
3926 
3927   CALL Ctqmcoffdiag_printSpectra(op)
3928 
3929 END SUBROUTINE Ctqmcoffdiag_printAll

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printCorrelation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printCorrelation

FUNCTION

  print correlation fonctions

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

4407 SUBROUTINE Ctqmcoffdiag_printCorrelation(op, oFileIn)
4408 
4409 !Arguments ------------------------------------
4410   TYPE(Ctqmcoffdiag)          , INTENT(IN)             :: op
4411   INTEGER  , OPTIONAL, INTENT(IN)             :: oFileIn
4412 !Local variables ------------------------------
4413   INTEGER                                     :: oFile
4414   INTEGER                                     :: itime
4415   INTEGER                                     :: sp1
4416   INTEGER                                     :: iflavor
4417   INTEGER                                     :: i
4418   INTEGER                                     :: flavors
4419   CHARACTER(LEN=2)                            :: a
4420   CHARACTER(LEN=50)                           :: string
4421   DOUBLE PRECISION                            :: dt
4422 
4423   !IF ( op%rank .NE. MOD(5,op%size)) RETURN
4424   IF ( op%rank .NE. MOD(op%size+5,op%size)) RETURN
4425   IF ( op%opt_analysis .NE. 1 ) RETURN
4426 
4427   oFile = 44
4428   IF ( PRESENT(oFileIn) ) THEN
4429     oFile = oFileIn
4430   ELSE
4431     OPEN(UNIT=oFile, FILE="Correlation.dat")
4432   END IF
4433 
4434   sp1         =  op%samples
4435   dt          =  op%beta / sp1
4436   sp1         =  sp1 + 1
4437   flavors     =  op%flavors
4438 
4439   i = 3*flavors + 1
4440   WRITE(a,'(I2)') i
4441   WRITE(oFile,*) "# time  (/ (segement, antiseg, correl), i=1, flavor/)"
4442   string = '(1x,'//TRIM(ADJUSTL(a))//'F19.15)'
4443   DO itime = 1, sp1
4444     WRITE(oFile,string) DBLE(itime-1)*dt, &
4445                    (/ ( &
4446                    (/ ( op%measCorrelation(itime, i, iflavor), i=1,3) /) &
4447                    , iflavor=1, flavors) /)
4448   END DO
4449 
4450   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4451 
4452 END SUBROUTINE Ctqmcoffdiag_printCorrelation

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printD [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printD

FUNCTION

  print individual double occupancy

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

4231 SUBROUTINE Ctqmcoffdiag_printD(op,oFileIn)
4232 
4233 !Arguments ------------------------------------
4234   TYPE(Ctqmcoffdiag)          , INTENT(IN)    :: op
4235   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
4236 !Local variables ------------------------------
4237   INTEGER                            :: oFile
4238   INTEGER                            :: iflavor1
4239   INTEGER                            :: iflavor2
4240 
4241   !IF ( op%rank .NE. MOD(2,op%size)) RETURN
4242   IF ( op%rank .NE. MOD(op%size+2,op%size)) RETURN
4243 
4244   oFile = 41
4245   IF ( PRESENT(oFileIn) ) THEN
4246     oFile = oFileIn
4247   ELSE
4248     OPEN(UNIT=oFile, FILE="D.dat")
4249   END IF
4250 
4251   DO iflavor1 = 1, op%flavors
4252     DO iflavor2 = iflavor1+1, op%flavors
4253       WRITE(oFile,'(1x,A8,I4,A1,I4,A3,ES21.14)') "Orbitals", iflavor1, "-", iflavor2, " : ", op%measDE(iflavor2,iflavor1)
4254     END DO
4255   END DO
4256 
4257   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4258 
4259 END SUBROUTINE Ctqmcoffdiag_printD

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printE [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printE

FUNCTION

  print energy and noise 

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

4287 SUBROUTINE Ctqmcoffdiag_printE(op,oFileIn)
4288 
4289 !Arguments ------------------------------------
4290   TYPE(Ctqmcoffdiag)          , INTENT(IN)    :: op
4291   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
4292 !Local variables ------------------------------
4293   INTEGER                            :: oFile
4294   DOUBLE PRECISION                   :: E
4295   DOUBLE PRECISION                   :: Noise
4296 
4297   !IF ( op%rank .NE. MOD(3,op%size)) RETURN
4298   IF ( op%rank .NE. MOD(op%size+3,op%size)) RETURN
4299 
4300   oFile = 42
4301   IF ( PRESENT(oFileIn) ) THEN
4302     oFile = oFileIn
4303   ELSE
4304     OPEN(UNIT=oFile, FILE="BetaENoise.dat")
4305   END IF
4306 
4307   CALL Ctqmcoffdiag_getE(op,E,Noise)
4308 
4309   WRITE(oFile,'(1x,F3.2,A2,ES21.14,A2,ES21.14)') op%beta, "  ", E, "  ",  Noise
4310 
4311   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4312 
4313 END SUBROUTINE Ctqmcoffdiag_printE

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printGreen

FUNCTION

  print green functions

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

4112 SUBROUTINE Ctqmcoffdiag_printGreen(op, oFileIn)
4113 
4114 !Arguments ------------------------------------
4115   use m_io_tools, only : flush_unit
4116   TYPE(Ctqmcoffdiag)        , INTENT(IN)    :: op
4117   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
4118 !Local variables ------------------------------
4119   INTEGER                            :: oFile
4120   INTEGER                            :: itime
4121   INTEGER                            :: sp1
4122   INTEGER                            :: iflavor,iflavorb
4123   INTEGER                            :: flavors !, iflavor2 !,iflavor1,
4124   CHARACTER(LEN=4)                   :: cflavors
4125   CHARACTER(LEN=50)                  :: string
4126   DOUBLE PRECISION                   :: dt
4127   DOUBLE PRECISION                   :: sweeps
4128 
4129   !IF ( op%rank .NE. MOD(1,op%size)) RETURN
4130   IF ( op%rank .NE. MOD(op%size+1,op%size)) RETURN
4131 
4132   oFile = 40
4133   IF ( PRESENT(oFileIn) ) THEN
4134     oFile = oFileIn
4135   ELSE
4136     OPEN(UNIT=oFile, FILE="Gtau.dat")
4137   END IF
4138   OPEN(UNIT=43, FILE="Gtau_nd.dat")
4139   rewind(43)
4140   sp1     =  op%samples
4141   dt      =  op%beta / DBLE(sp1)
4142   sp1     =  sp1 + 1
4143   flavors =  op%flavors
4144   sweeps = DBLE(op%sweeps)*DBLE(op%size)
4145 
4146   IF ( op%opt_noise .EQ. 1) THEN
4147     WRITE(cflavors,'(I4)') (2*flavors+1)*2
4148     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
4149     DO itime = 1, sp1
4150       WRITE(oFile,string) DBLE(itime-1)*dt, &
4151       (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /), &
4152       (/ (op%abNoiseG(1,itime,iflavor)*(sweeps)**op%abNoiseG(2,itime,iflavor), iflavor=1, flavors) /)
4153     END DO
4154   ELSE
4155     WRITE(cflavors,'(I4)') (flavors+1)*2
4156     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
4157     DO itime = 1, sp1
4158 !     WRITE(45,string) DBLE(itime-1)*dt, &
4159 !     (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /)
4160       WRITE(oFile,string) DBLE(itime-1)*dt, &
4161       (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /)
4162 !     WRITE(46,*) DBLE(itime-1)*dt, &
4163 !     & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavor=1, flavors),iflavorb=1,flavors) /)
4164     END DO
4165 !   DO itime = 1, sp1
4166 !     WRITE(47,*) DBLE(itime-1)*dt, &
4167 !     & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavor=1, flavors),iflavorb=1,flavors) /)
4168 !   END DO
4169 !  --- Print full non diagonal Gtau in Gtau_nd.dat
4170     WRITE(cflavors,'(I4)') (flavors*flavors+1)
4171 !   write(47,*) "cflavors",cflavors
4172     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
4173 !   write(47,*) string
4174     DO itime = 1, sp1
4175       WRITE(43,string) DBLE(itime-1)*dt, &
4176       & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavorb=1, flavors),iflavor=1,flavors) /)
4177 !     WRITE(44,*) DBLE(itime-1)*dt, &
4178 !     & (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors)
4179 !     WRITE(44,string) DBLE(itime-1)*dt, &
4180 !     & (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors)
4181     END DO
4182       WRITE(43,*) 
4183   END IF
4184 !    DO iflavor = 1, flavors
4185 !      DO iflavor2 = 1, flavors
4186 !          write(4436,*) "#",iflavor,iflavor2
4187 !        do  itime=1,sp1
4188 !          write(4436,*) DBLE(itime-1)*dt,real(op%Greens%oper(itime,iflavor,iflavor2))
4189 !        enddo
4190 !          write(4436,*) 
4191 !      END DO
4192 !    END DO
4193 !    close(4436)
4194 
4195   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4196   CLOSE(43)
4197 ! CLOSE(44)
4198 ! CLOSE(45)
4199 ! CLOSE(46)
4200 ! CLOSE(47)
4201   !call flush_unit(43)
4202 
4203 END SUBROUTINE Ctqmcoffdiag_printGreen

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printPerturbation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printPerturbation

FUNCTION

  print perturbation order

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  oFileIn=file stream

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

NOTES

SOURCE

4343 SUBROUTINE Ctqmcoffdiag_printPerturbation(op, oFileIn)
4344 
4345 !Arguments ------------------------------------
4346   TYPE(Ctqmcoffdiag)          , INTENT(IN)           :: op
4347   INTEGER  , OPTIONAL,  INTENT(IN)          :: oFileIn
4348 !Local variables-------------------------------
4349   INTEGER                                   :: oFile
4350   INTEGER                                   :: iorder
4351   INTEGER                                   :: order
4352   INTEGER                                   :: iflavor
4353   INTEGER                                   :: flavors
4354   CHARACTER(LEN=2)                          :: a
4355   CHARACTER(LEN=50)                         :: string
4356 
4357   !IF ( op%rank .NE. MOD(4,op%size)) RETURN
4358   IF ( op%rank .NE. MOD(op%size+4,op%size)) RETURN
4359   IF ( op%opt_order .LE. 0 ) RETURN
4360 
4361   oFile = 43
4362   IF ( PRESENT(oFileIn) ) THEN
4363     oFile = oFileIn
4364   ELSE
4365     OPEN(UNIT=oFile, FILE="Perturbation.dat")
4366   END IF
4367     
4368   order        =  op%opt_order
4369   flavors      =  op%flavors
4370 
4371   WRITE(a,'(I2)') flavors
4372   string = '(I5,'//TRIM(ADJUSTL(a))//'F19.15)'
4373   DO iorder = 1, order
4374     WRITE(oFile,string) iorder-1, &
4375                 (/ (op%measPerturbation(iorder, iflavor), iflavor=1, flavors) /)
4376   END DO
4377 
4378   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4379 END SUBROUTINE Ctqmcoffdiag_printPerturbation

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printQMC [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printQMC

FUNCTION

  print ctqmc statistics

COPYRIGHT

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

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

3956 SUBROUTINE Ctqmcoffdiag_printQMC(op)
3957 
3958 !Arguments ------------------------------------
3959   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
3960 !Local variables ------------------------------
3961   INTEGER                  :: ostream
3962   INTEGER                  :: iflavor,iflavorbis,iorder
3963   DOUBLE PRECISION         :: sweeps
3964   DOUBLE PRECISION         :: invSweeps
3965   CHARACTER(LEN=2)         :: a
3966   CHARACTER(LEN=15)        :: string
3967 
3968   !IF ( op%rank .NE. 0) RETURN
3969   IF ( op%rank .NE. MOD(op%size,op%size)) RETURN
3970 
3971   ostream   = op%ostream
3972   sweeps    = DBLE(op%sweeps)
3973   invSweeps = 1.d0/sweeps
3974 
3975   WRITE(ostream,'(1x,F13.0,A11,F10.2,A12,I5,A5)') sweeps*DBLE(op%size), " sweeps in ", op%runTime, &
3976                  " seconds on ", op%size, " CPUs"
3977   WRITE(ostream,'(A28,F6.2)') "Segments added        [%] : ", op%stats(4)*invSweeps*100.d0
3978   WRITE(ostream,'(A28,F6.2)') "Segments removed      [%] : ", op%stats(5)*invSweeps*100.d0
3979   WRITE(ostream,'(A28,F6.2)') "Segments <0 sign      [%] : ", op%stats(6)*invSweeps*100.d0
3980   !WRITE(ostream,'(A28,F12.2)') "Number of meas        [%] : ", op%stats(6)
3981   WRITE(ostream,'(A28,F6.2)') "Anti-segments added   [%] : ", op%stats(1)*invSweeps*100.d0
3982   WRITE(ostream,'(A28,F6.2)') "Anti-segments removed [%] : ", op%stats(2)*invSweeps*100.d0
3983   WRITE(ostream,'(A28,F6.2)') "Anti-segments <0 sign [%] : ", op%stats(3)*invSweeps*100.d0
3984   !WRITE(ostream,'(A28,F12.2)') "Sum of sign       [%] : ", op%stats(3)
3985   WRITE(ostream,'(A28,F13.2)') "Signe value               : ", op%Greens%signvaluemeas
3986   IF ( op%modGlobalMove(1) .LT. op%sweeps + 1 ) THEN
3987     WRITE(ostream,'(A28,F6.2)') "Global Move           [%] : ", op%swap         *invSweeps*100.d0*op%modGlobalMove(1)
3988     WRITE(ostream,'(A28,F6.2)') "Global Move Reduced   [%] : ", op%swap         / DBLE(op%modGlobalMove(2))*100.d0
3989   END IF
3990 !#ifdef CTCtqmcoffdiag_CHECK
3991   IF ( op%opt_check .EQ. 1 .OR. op%opt_check .EQ. 3 ) &
3992     WRITE(ostream,'(A28,E22.14)') "Impurity test         [%] : ", op%errorImpurity*100.d0
3993   IF ( op%opt_check .GE. 2 ) &
3994       WRITE(ostream,'(A28,E22.14)') "Bath     test         [%] : ", op%errorBath    *100.d0
3995 !#endif
3996   WRITE(ostream,'(A28,ES22.14,A5,ES21.14)') "<Epot>                [U] : ", op%measDE(1,1), " +/- ",&
3997 !#ifdef HAVE_MPI
3998                                                               op%a_Noise*(sweeps*DBLE(op%size))**op%b_Noise
3999 !#else
4000 !                                                              op%a_Noise*(sweeps)**op%b_Noise
4001 !#endif
4002  !--------- Write double occupation between all pairs of orbitals --------------------------
4003   write(ostream,'(17x,a)') "Double occupation between pairs of orbitals"
4004   write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4005   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4006   do iflavor=1, op%flavors
4007     write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%measDE(iflavor,iflavorbis),iflavorbis=1,op%flavors)
4008   enddo
4009   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
4010  !------------------------------------------------------------------------------------------
4011 
4012  !--------- Write number of segments for each orbitals
4013  ! write(ostream,'(a)') "Number of segments for each orbitals"
4014  ! write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4015  ! write(ostream,'(17x,30a)') ("----------",iflavorbis=1,op%flavors)
4016  ! do iflavor=1, op%flavors
4017  !   write(ostream,'(i17,a,30f10.4)') iflavor,"|",(op%Impurity%particles(IT)%tail
4018  ! enddo
4019  ! write(ostream,'(17x,30a)') ("----------",iflavorbis=1,op%flavors)
4020  !------------------------------------------------------------------------------------------
4021  !--------- Write G(L)
4022   write(ostream,'(17x,a)') "G(L)"
4023   write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4024   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4025   do iflavor=1, op%flavors
4026     write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%Greens%oper(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors)
4027   enddo
4028   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
4029  !------------------------------------------------------------------------------------------
4030  !--------- Write G(1)
4031   write(ostream,'(17x,a)') "G(1)"
4032   write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4033   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4034   do iflavor=1, op%flavors
4035     write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%Greens%oper(1,iflavor,iflavorbis),iflavorbis=1,op%flavors)
4036   enddo
4037   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
4038  !------------------------------------------------------------------------------------------
4039 
4040   WRITE(ostream,'(A28,F8.4,A3,F7.4)') "Noise                 [U] : ", op%a_Noise, " x^", op%b_Noise
4041   WRITE(ostream,'(A28,E10.2)')  "Niquist puls.     [/beta] : ", ACOS(-1.d0)*op%inv_dt
4042   WRITE(ostream,'(A28,E22.14)') "Max Acc. Epot Error   [U] : ", op%measDE(2,2)/(op%beta*op%modNoise1*2.d0)*sweeps
4043   
4044   !WRITE(ostream,'(A28,F7.4,A3,F7.4,A4,E20.14)') "Noise            [G(tau)] : ", op%a_Noise(2), "x^", op%b_Noise(2), " -> ", &
4045                                                               !op%a_Noise(2)*(sweeps*DBLE(op%size))**op%b_Noise(2)
4046  !----- PERTURBATION ORDER------------------------------------------------------------------
4047   IF ( op%opt_order .GT. 0 ) THEN 
4048     write(ostream,*) 
4049     WRITE(a,'(I2)') op%flavors
4050     string = '(A28,'//TRIM(ADJUSTL(a))//'(1x,I3))'
4051     WRITE(ostream,string) "Perturbation orders       : ",(/ (MAXLOC(op%measPerturbation(:, iflavor))-1, iflavor=1, op%flavors) /)
4052     write(ostream,'(17x,a)') "order of Perturbation for flavors"
4053     write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4054     write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4055     write(ostream,'(12x,a,30i10)') " max ",(/ (MAXLOC(op%measPerturbation(:, iflavor))-1, iflavor=1, op%flavors) /)
4056     write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4057     do iorder=0, op%opt_order-1
4058       write(ostream,'(7x,i10,a,30f10.4)') iorder,"|",(op%measPerturbation(iorder+1,iflavor),iflavor=1,op%flavors)
4059     enddo
4060   END IF
4061  !------------------------------------------------------------------------------------------
4062  !----- PERTURBATION ORDER------------------------------------------------------------------
4063   IF ( op%opt_order .GT. 0 ) THEN 
4064     write(ostream,*) 
4065     write(ostream,'(17x,a)') "Proportion of full and empty orbital for order 0"
4066     write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4067     write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4068     write(ostream,'(2x,a,30f10.4)') " full  orbital |",(op%meas_fullemptylines(1,iflavor),iflavor=1,op%flavors)
4069     write(ostream,'(2x,a,30f10.4)') " empty orbital |",(op%meas_fullemptylines(2,iflavor),iflavor=1,op%flavors)
4070   END IF
4071  !------------------------------------------------------------------------------------------
4072   !CALL FLUSH(op%ostream)
4073   IF ( ABS(((op%stats(4) *invSweeps*100.d0) / (op%stats(5) *invSweeps*100.d0) - 1.d0)) .GE. 0.02d0 &
4074    .OR. ABS(((op%stats(1)*invSweeps*100.d0) / (op%stats(2)*invSweeps*100.d0) - 1.d0)) .GE. 0.02d0 ) &
4075     THEN 
4076     CALL WARNALL("Ctqmcoffdiag_printQMC : bad statistic according to moves. Increase sweeps")
4077   END IF
4078   IF ( ABS(op%b_Noise+0.5)/0.5d0 .GE. 0.05d0 ) &
4079     CALL WARNALL("Ctqmcoffdiag_printQMC : bad statistic according to Noise. Increase sweeps")
4080 !  IF ( ISNAN(op%a_Noise) .OR. ISNAN(op%a_Noise) ) &
4081 !    CALL WARNALL("Ctqmcoffdiag_printQMC : NaN appeared. Increase sweeps    ")
4082 
4083 
4084 END SUBROUTINE Ctqmcoffdiag_printQMC

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printSpectra [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printSpectra

FUNCTION

  print fourier transform of time evolution of number of electrons

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

4481 SUBROUTINE Ctqmcoffdiag_printSpectra(op, oFileIn)
4482 
4483 !Arguments ------------------------------------
4484   TYPE(Ctqmcoffdiag)          , INTENT(IN)             :: op
4485   INTEGER  , OPTIONAL, INTENT(IN)             :: oFileIn
4486 !Local variables ------------------------------
4487   INTEGER                                     :: oFile
4488   INTEGER                                     :: flavors
4489   INTEGER                                     :: indDensity
4490   INTEGER                                     :: endDensity
4491   CHARACTER(LEN=4)                            :: a
4492   CHARACTER(LEN=16)                           :: formatSpectra
4493 
4494   !IF ( op%rank .NE. MOD(6,op%size)) RETURN
4495   IF ( op%opt_spectra .LT. 1 ) RETURN
4496 
4497   oFile = 45+op%rank
4498   a ="0000"
4499   WRITE(a,'(I4)') op%rank
4500   IF ( PRESENT(oFileIn) ) THEN
4501     oFile = oFileIn
4502   ELSE
4503     OPEN(UNIT=oFile, FILE="Markov_"//TRIM(ADJUSTL(a))//".dat")
4504   END IF
4505 
4506   flavors     =  op%flavors
4507   WRITE(a,'(I4)') flavors+1
4508   formatSpectra ='(1x,'//TRIM(ADJUSTL(a))//'ES22.14)'
4509   WRITE(oFile,*) "# freq[/hermalization] FFT"
4510 
4511   endDensity = SIZE(op%density,2)
4512   DO WHILE ( op%density(flavors+1,endDensity) .EQ. -1 )
4513     endDensity = endDensity -1
4514   END DO
4515 
4516   DO indDensity = 1, endDensity
4517     WRITE(oFile,formatSpectra) op%density(flavors+1,indDensity), op%density(1:flavors,indDensity)
4518   END DO
4519 
4520   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4521 
4522 END SUBROUTINE Ctqmcoffdiag_printSpectra

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_reset [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_reset

FUNCTION

  reset a ctqmc simulation

COPYRIGHT

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

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

1062 SUBROUTINE Ctqmcoffdiag_reset(op)
1063 
1064 !Arguments ------------------------------------
1065   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
1066 !Local variables ------------------------------
1067   !INTEGER                  :: iflavor
1068   DOUBLE PRECISION         :: sweeps
1069 
1070   CALL GreenHyboffdiag_reset(op%Greens)
1071   CALL Ctqmcoffdiag_clear(op)
1072   CALL ImpurityOperator_reset(op%Impurity)
1073   CALL BathOperatoroffdiag_reset    (op%Bath)
1074   op%measN(3,:) = 0.d0
1075   !complete restart -> measN=0
1076   op%done = .FALSE.
1077   op%set  = .FALSE.
1078   op%inF  = .FALSE.
1079   op%opt_movie = 0
1080   op%opt_analysis = 0
1081   op%opt_order = 0
1082   op%opt_check = 0
1083   op%opt_noise = 0
1084   op%opt_spectra = 0
1085   op%opt_levels = 0
1086   sweeps = DBLE(op%sweeps)*DBLE(op%size)
1087   CALL Ctqmcoffdiag_setSweeps(op, sweeps)
1088 !#ifdef HAVE_MPI
1089 !  CALL MPI_BARRIER(op%MY_COMM,iflavor)
1090 !  IF ( op%rank .EQ. 0 ) &
1091 !#endif
1092 !  WRITE(op%ostream,'(A9)') "QMC reset"
1093 !  CALL FLUSH(op%ostream)
1094 END SUBROUTINE Ctqmcoffdiag_reset

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_run [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_run

FUNCTION

  set all options and run a simulation

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  opt_order=maximal perturbation order to scope
  opt_movie=draw a movie of the simulation
  opt_analysis=compute correlation functions
  opt_check=check fast calculations
  opt_noise=compute noise for green function
  opt_spectra=fourier transform of the time evolution of the number of electrons
  opt_gMove=steps without global move

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

1709 SUBROUTINE Ctqmcoffdiag_run(op,opt_order,opt_histo,opt_movie,opt_analysis,opt_check,opt_noise,opt_spectra,opt_gMove)
1710 
1711 
1712 #ifdef HAVE_MPI1
1713 include 'mpif.h'
1714 #endif
1715 !Arguments ------------------------------------
1716   TYPE(Ctqmcoffdiag), INTENT(INOUT)           :: op
1717   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_order
1718   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_histo
1719   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_movie
1720   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_analysis
1721   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_check
1722   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_noise
1723   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_spectra
1724   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_gMove
1725 !Local variables ------------------------------
1726 #ifdef HAVE_MPI
1727   INTEGER                            :: ierr
1728 #endif
1729 !#ifdef CTCtqmcoffdiag_MOVIE
1730   INTEGER                            :: ilatex
1731   CHARACTER(LEN=4)                   :: Cchar
1732 !#endif
1733   DOUBLE PRECISION                   :: estimatedTime
1734 
1735   IF ( .NOT. op%set  ) &
1736     CALL ERROR("Ctqmcoffdiag_run : QMC not set up                          ")
1737   IF ( .NOT. op%setU ) &
1738     CALL ERROR("Ctqmcoffdiag_run : QMC does not have a U matrix            ")
1739 
1740 
1741 ! OPTIONS of the run
1742   IF ( PRESENT( opt_check ) ) THEN
1743     op%opt_check = opt_check
1744     CALL ImpurityOperator_doCheck(op%Impurity,opt_check)
1745     CALL BathOperatoroffdiag_doCheck(op%Bath,opt_check)
1746   END IF
1747   IF ( PRESENT( opt_movie ) ) &
1748     op%opt_movie = opt_movie
1749   IF ( PRESENT( opt_analysis ) ) &
1750     op%opt_analysis = opt_analysis
1751   IF ( PRESENT ( opt_order ) ) &
1752     op%opt_order = opt_order 
1753   IF ( PRESENT ( opt_histo ) ) &
1754     op%opt_histo = opt_histo 
1755   IF ( PRESENT ( opt_noise ) ) THEN
1756     op%opt_noise = opt_noise 
1757   END IF
1758   IF ( PRESENT ( opt_spectra ) ) &
1759     op%opt_spectra = opt_spectra
1760 
1761   op%modGlobalMove(1) = max(op%sweeps,op%thermalization)+1 ! No Global Move
1762 !!sui!write(std_out,*) "op%sweeps",op%thermalization,op%sweeps,opt_gMove
1763   op%modGlobalMove(2) = 0
1764   IF ( PRESENT ( opt_gMove ) ) THEN
1765     IF ( opt_gMove .LE. 0 .OR. opt_gMove .GT. op%sweeps ) THEN
1766      ! op%modGlobalMove(1) = op%sweeps+1
1767       op%modGlobalMove(1) = max(op%sweeps,op%thermalization)+1 ! No Global Move
1768       !write(std_out,*) "op%sweeps",op%sweeps, op%modGlobalMove(1)
1769       CALL WARNALL("Ctqmcoffdiag_run : global moves option is <= 0 or > sweeps/cpu -> No global Moves")
1770     ELSE 
1771       op%modGlobalMove(1) = opt_gMove 
1772     END IF
1773   END IF
1774 !sui!write(std_out,*) "op%sweeps",op%thermalization,op%sweeps
1775 
1776   CALL Ctqmcoffdiag_allocateOpt(op)
1777   
1778 !#ifdef CTCtqmcoffdiag_MOVIE  
1779   ilatex = 0
1780   IF ( op%opt_movie .EQ. 1 ) THEN
1781     Cchar ="0000"
1782     WRITE(Cchar,'(I4)') op%rank 
1783     ilatex = 87+op%rank
1784     OPEN(UNIT=ilatex, FILE="Movie_"//TRIM(ADJUSTL(Cchar))//".tex")
1785     WRITE(ilatex,'(A)') "\documentclass{beamer}"
1786     WRITE(ilatex,'(A)') "\usepackage{color}"
1787     WRITE(ilatex,'(A)') "\setbeamersize{sidebar width left=0pt}"
1788     WRITE(ilatex,'(A)') "\setbeamersize{sidebar width right=0pt}"
1789     WRITE(ilatex,'(A)') "\setbeamersize{text width left=0pt}"
1790     WRITE(ilatex,'(A)') "\setbeamersize{text width right=0pt}"
1791     WRITE(ilatex,*) 
1792     WRITE(ilatex,'(A)') "\begin{document}"
1793     WRITE(ilatex,*) 
1794   END IF
1795 !#endif
1796 
1797   IF ( op%rank .EQ. 0 ) THEN
1798     WRITE(op%ostream,'(A29)') "Starting QMC (Thermalization)"
1799   END IF
1800   
1801   !=================================
1802   ! STARTING THERMALIZATION 
1803   !=================================
1804   !write(std_out,*) "sweeps before thermalization",op%sweeps
1805   !write(std_out,*) "op%stats",op%stats
1806   CALL Ctqmcoffdiag_loop(op,op%thermalization,ilatex)
1807   !=================================
1808   ! ENDING   THERMALIZATION 
1809   !=================================
1810 
1811   estimatedTime = op%runTime
1812 #ifdef HAVE_MPI
1813   CALL MPI_REDUCE(op%runTime, estimatedTime, 1, MPI_DOUBLE_PRECISION, MPI_MAX, &
1814              0, op%MY_COMM, ierr)
1815 #endif
1816 
1817   IF ( op%rank .EQ. 0 ) THEN
1818     WRITE(op%ostream,'(A26,I6,A11)') "Thermalization done in    ", CEILING(estimatedTime), "    seconds"
1819     WRITE(op%ostream,'(A25,I7,A15,I5,A5)') "The QMC should run in    ", &
1820            CEILING(estimatedTime*DBLE(op%sweeps)/DBLE(op%thermalization)),&
1821                         "    seconds on ", op%size, " CPUs"
1822   END IF
1823 
1824   !=================================
1825   ! CLEANING CTQMC          
1826   !=================================
1827   CALL Ctqmcoffdiag_clear(op)
1828 
1829   !=================================
1830   ! STARTING CTQMC          
1831   !=================================
1832   !write(std_out,*) "sweeps before loop",op%sweeps
1833   !write(std_out,*) "op%stats",op%stats
1834   CALL Ctqmcoffdiag_loop(op,op%sweeps,ilatex)
1835   !=================================
1836   ! ENDING   CTQMC          
1837   !=================================
1838 
1839   IF ( op%opt_movie .EQ. 1 ) THEN
1840     WRITE(ilatex,*) ""
1841     WRITE(ilatex,'(A14)') "\end{document}"
1842     CLOSE(ilatex)
1843   END IF
1844 
1845   op%done     = .TRUE.
1846 !sui!write(std_out,*) "op%stats en of ctqmc_run",op%stats
1847 
1848 END SUBROUTINE Ctqmcoffdiag_run

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setG0wTab [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setG0wTab

FUNCTION

  Set Gow from input array

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  Gomega=G0w
  opt_fk=F is already inversed with out iwn

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

861 SUBROUTINE Ctqmcoffdiag_setG0wTab(op,Gomega,opt_fk)
862 
863 !Arguments ------------------------------------
864   TYPE(Ctqmcoffdiag), INTENT(INOUT)                      :: op
865   COMPLEX(KIND=8), DIMENSION(:,:,:), INTENT(IN ) :: Gomega
866   INTEGER                         , INTENT(IN ) :: opt_fk
867 !Local variable -------------------------------
868   DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: F
869 
870   IF ( .NOT. op%para ) &
871     CALL ERROR("Ctqmcoffdiag_setG0wTab : Ctqmcoffdiag_setParameters never called    ") 
872 
873   MALLOC(F,(1:op%samples+1,1:op%flavors,1:op%flavors))
874   CALL Ctqmcoffdiag_computeF(op,Gomega, F, opt_fk)  ! mu is changed
875  !write(6,*) "eee111"
876   CALL BathOperatoroffdiag_setF(op%Bath, F)
877  ! CALL BathOperatoroffdiag_printF(op%Bath,333)
878  !write(6,*) "eee"
879   FREE(F)
880 
881   op%inF = .TRUE.
882   op%set = .TRUE. 
883 
884 END SUBROUTINE Ctqmcoffdiag_setG0wTab

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_sethybri_limit [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_sethybri_limit

FUNCTION

  use coefficient A such that F=-A/(iwn) given by DMFT code.

COPYRIGHT

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

  hybri_limit(nflavor,nflavor)=contains the limit for each couple of flavors

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

  op(Ctqmcoffdiag_type) = is the ctqmc main variable
           op&limit is now filled

NOTES

SOURCE

1164 SUBROUTINE Ctqmcoffdiag_sethybri_limit(op, hybri_limit)
1165 
1166 !Arguments ------------------------------------
1167   TYPE(Ctqmcoffdiag)                     , INTENT(INOUT) :: op
1168   COMPLEX(KIND=8) , DIMENSION(:,:),  INTENT(IN ) :: hybri_limit
1169 
1170   IF ( op%flavors .NE. SIZE(hybri_limit,1) ) &
1171     CALL ERROR("Error in sethybri_limit")
1172 
1173   op%hybri_limit(:,:)=hybri_limit(:,:)  
1174   op%opt_hybri_limit = 1
1175 END SUBROUTINE Ctqmcoffdiag_sethybri_limit

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setMu [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setMu

FUNCTION

  impose energy levels

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  levels=energy levels vector

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

NOTES

SOURCE

1123 SUBROUTINE Ctqmcoffdiag_setMu(op, levels)
1124 
1125 !Arguments ------------------------------------
1126   TYPE(Ctqmcoffdiag)                     , INTENT(INOUT) :: op
1127   DOUBLE PRECISION, DIMENSION(:), INTENT(IN   ) :: levels
1128 
1129   IF ( op%flavors .NE. SIZE(levels,1) ) &
1130     CALL WARNALL("Ctqmcoffdiag_setMu : Taking energy levels from weiss G(iw)")
1131 
1132   op%mu(:)=-levels(:)  ! levels = \epsilon_j - \mu
1133   !op%mu =\tilde{\mu} = \mu -\epsilon_j
1134   op%opt_levels = 1
1135 END SUBROUTINE Ctqmcoffdiag_setMu

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setParameters [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setParameters

FUNCTION

  set all parameters and operators

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  buffer=input parameters

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

477 SUBROUTINE Ctqmcoffdiag_setParameters(op,buffer)
478 
479 !Arguments ------------------------------------
480   TYPE(Ctqmcoffdiag), INTENT(INOUT)                         :: op
481   DOUBLE PRECISION, DIMENSION(1:10), INTENT(IN   ) :: buffer
482 
483 
484   op%thermalization = INT(buffer(3)) !op%thermalization
485   CALL Ctqmcoffdiag_setSeed(op,INT(buffer(1)))
486   CALL Ctqmcoffdiag_setSweeps(op,buffer(2))
487 
488   op%measurements   = INT(buffer(4)) !op%measurements
489   op%flavors        = INT(buffer(5))
490   op%samples        = INT(buffer(6)) !op%samples
491   op%beta           = buffer(7)      !op%beta
492   op%U              = buffer(8)      !U
493   op%opt_nondiag    = INT(buffer(10))
494 !  op%mu             = buffer(9)      !op%mu
495   !op%Wmax           = INT(buffer(9)) !Freq
496 !#ifdef CTCtqmcoffdiag_ANALYSIS
497 !  op%order          = INT(buffer(10)) ! order
498   op%inv_dt         = op%samples / op%beta
499 !#endif
500 
501   !CALL ImpurityOperator_init(op%Impurity,op%flavors,op%beta, op%samples)
502   CALL ImpurityOperator_init(op%Impurity,op%flavors,op%beta)
503   IF ( op%U .GE. 0.d0 ) THEN
504     CALL ImpurityOperator_computeU(op%Impurity,op%U,0.d0)
505     op%setU = .TRUE.
506   END IF
507 !  op%mu = op%mu + op%Impurity%shift_mu
508 !sui!write(std_out,*) "op%opt_nondiag",op%opt_nondiag
509   CALL BathOperatoroffdiag_init(op%Bath, op%flavors, op%samples, op%beta, INT(buffer(9)), op%opt_nondiag)
510 
511   op%para = .TRUE.
512 
513 END SUBROUTINE Ctqmcoffdiag_setParameters

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setSeed [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setSeed

FUNCTION

  initialize random number generator

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  iseed=seed from imput

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

596 SUBROUTINE Ctqmcoffdiag_setSeed(op,iseed)
597 
598 !Arguments ------------------------------------
599   TYPE(Ctqmcoffdiag), INTENT(INOUT)           :: op
600   INTEGER  , INTENT(IN   )           :: iseed
601 !Local variables ------------------------------
602   !INTEGER                            :: n
603   !INTEGER                            :: i
604   !INTEGER, DIMENSION(:), ALLOCATABLE :: seed
605 
606 
607   !CALL RANDOM_SEED(size = n)
608   !MALLOC(seed,(n))
609   !seed =  iseed + (/ (i - 1, i = 1, n) /)
610 
611   !CALL RANDOM_SEED(PUT = seed+op%rank)
612 
613   !FREE(seed)
614 
615   op%seed=INT(iseed+op%rank,8)
616 
617 END SUBROUTINE Ctqmcoffdiag_setSeed

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setSweeps [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setSweeps

FUNCTION

  set the number of sweeps

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  sweeps=asked sweeps

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

541 SUBROUTINE Ctqmcoffdiag_setSweeps(op,sweeps)
542 
543 !Arguments ------------------------------------
544   TYPE(Ctqmcoffdiag)         , INTENT(INOUT) :: op
545   DOUBLE PRECISION  , INTENT(IN   ) :: sweeps
546 
547   op%sweeps = NINT(sweeps / DBLE(op%size))
548 !  !write(std_out,*) op%sweeps,NINT(sweeps / DBLE(op%size)),ANINT(sweeps/DBLE(op%size))
549   IF ( DBLE(op%sweeps) .NE. ANINT(sweeps/DBLE(op%size)) ) &
550     CALL ERROR("Ctqmcoffdiag_setSweeps : sweeps is negative or too big     ")
551   IF ( op%sweeps .LT. 2*CTQMC_SLICE1 ) THEN  !202
552     CALL WARNALL("Ctqmcoffdiag_setSweeps : # sweeps automtically changed     ")
553     op%sweeps = 2*CTQMC_SLICE1
554 !  ELSE IF ( op%sweeps .LT. op%thermalization ) THEN
555 !    CALL WARNALL("Ctqmcoffdiag_setSweeps : Thermalization > sweeps / cpu -> auto fix")
556 !    op%sweeps = op%thermalization
557   END IF
558   IF ( DBLE(NINT(DBLE(op%sweeps)*DBLE(op%size)/DBLE(CTQMC_SLICE1))) .NE.  &
559   ANINT(DBLE(op%sweeps)*DBLE(op%size)/DBLE(CTQMC_SLICE1)) ) THEN
560     op%modNoise1 = op%sweeps
561   ELSE
562     op%modNoise1    = MIN(op%sweeps,INT(DBLE(op%sweeps)*DBLE(op%size) / DBLE(CTQMC_SLICE1))) !101
563   END IF
564   op%modNoise2    = MAX(op%modNoise1 / CTQMC_SLICE2, 1)   ! 100
565 !  op%modGlobalMove(1) = op%thermalization / 10 + 1
566 !  op%modGlobalMove(2) = 0
567 
568 END SUBROUTINE Ctqmcoffdiag_setSweeps

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setU [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setU

FUNCTION

  set the interaction matrix

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  matU=interaction matrix

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

943 SUBROUTINE Ctqmcoffdiag_setU(op,matU)
944 
945 !Arguments ------------------------------------
946   TYPE(Ctqmcoffdiag), INTENT(INOUT) ::op
947 !Local variables ------------------------------
948   DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN) :: matU
949 
950   IF ( SIZE(matU) .NE. op%flavors*op%flavors ) &
951     CALL ERROR("Ctqmcoffdiag_setU : Wrong interaction matrix (size)        ")
952 
953   CALL ImpurityOperator_setUmat(op%Impurity, matU)
954   op%setU = .TRUE.
955 END SUBROUTINE Ctqmcoffdiag_setU

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_symmetrizeGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_symmetrizeGreen

FUNCTION

  optionnaly symmetrize the green functions

COPYRIGHT

  Copyright (C) 2013-2022 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=ctqmc
  syms=weight factors

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

NOTES

SOURCE

3475 SUBROUTINE Ctqmcoffdiag_symmetrizeGreen(op, syms)
3476 
3477 !Arguments ------------------------------------
3478   TYPE(Ctqmcoffdiag)                     , INTENT(INOUT) :: op
3479   DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN   ) :: syms
3480 !Local variables ------------------------------
3481   !INTEGER :: iflavor1
3482   !INTEGER :: iflavor2
3483   !INTEGER :: flavors
3484   !DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: green_tmp
3485   !DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:  ) :: n_tmp
3486 
3487   ABI_UNUSED((/syms(1,1), op%swap/))
3488 
3489 !  flavors = op%flavors
3490 !  IF ( SIZE(syms,1) .NE. flavors .OR. SIZE(syms,2) .NE. flavors ) THEN
3491 !    CALL WARNALL("Ctqmcoffdiag_symmetrizeGreen : wrong opt_sym -> not symmetrizing")
3492 !    RETURN
3493 !  END IF
3494 ! 
3495 !  MALLOC(green_tmp,(1:op%samples+1,flavors))
3496 !  green_tmp(:,:) = 0.d0
3497 !  MALLOC(n_tmp,(1:flavors))
3498 !  n_tmp(:) = 0.d0
3499 !  DO iflavor1=1, flavors
3500 !    DO iflavor2=1,flavors
3501 !      green_tmp(:,iflavor1) = green_tmp(:,iflavor1) &
3502 !                             + syms(iflavor2,iflavor1) * op%Greens(iflavor2)%oper(:)
3503 !      n_tmp(iflavor1) = n_tmp(iflavor1) &
3504 !                             + syms(iflavor2,iflavor1) * op%measN(1,iflavor2)
3505 !    END DO
3506 !  END DO
3507 !  DO iflavor1=1, flavors
3508 !    op%Greens(iflavor1)%oper(:) = green_tmp(:,iflavor1)
3509 !    op%measN(1,iflavor1)          = n_tmp(iflavor1)
3510 !  END DO
3511 !  FREE(green_tmp)
3512 !  FREE(n_tmp)
3513 END SUBROUTINE Ctqmcoffdiag_symmetrizeGreen

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_tryAddRemove [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_tryAddRemove

FUNCTION

  Try to add or remove a segment and an anti-segment

COPYRIGHT

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

OUTPUT

  updated=something changed

SIDE EFFECTS

NOTES

SOURCE

2131 SUBROUTINE Ctqmcoffdiag_tryAddRemove(op,updated)
2132 
2133 !Arguments ------------------------------------
2134   TYPE(Ctqmcoffdiag)             , INTENT(INOUT) :: op
2135 !  TYPE(BathOperatoroffdiag)    , INTENT(INOUT) :: Bath 
2136 !  TYPE(ImpurityOperator), INTENT(INOUT) :: Impurity 
2137   LOGICAL               , INTENT(  OUT) :: updated
2138 !Local variables ------------------------------
2139   INTEGER                               :: position
2140   INTEGER         , DIMENSION(1:2)     :: nature ! -2 for antiseg and 1 for seg
2141   INTEGER                               :: i! -2 for antiseg and 1 for seg
2142   !INTEGER                               :: it,it1 !ii,
2143   DOUBLE PRECISION                      :: action
2144   DOUBLE PRECISION                      :: beta
2145   DOUBLE PRECISION                      :: time1
2146   DOUBLE PRECISION                      :: time2
2147   DOUBLE PRECISION                      :: time_avail
2148   DOUBLE PRECISION                      :: det_ratio,sign_det_ratio
2149   DOUBLE PRECISION                      :: overlap
2150   DOUBLE PRECISION                      :: length
2151   DOUBLE PRECISION                      :: signe
2152   DOUBLE PRECISION                      :: tail
2153   INTEGER                      :: tailint
2154   DOUBLE PRECISION                      :: signdet, signdetprev
2155   DOUBLE PRECISION, DIMENSION(1:2)      :: CdagC_1
2156 
2157   IF ( .NOT. op%set ) &
2158     CALL ERROR("Ctqmcoffdiag_trySegment : QMC not set                       ")
2159 
2160         !write(std_out,*) "      TryAddRemove start"
2161   nature(1) = CTQMC_SEGME
2162   nature(2) = CTQMC_ANTIS
2163   beta      = op%beta
2164 
2165   updated = .FALSE.
2166   tailint  = (op%Impurity%particles(op%Impurity%activeFlavor)%tail)
2167   tail  = DBLE(tailint)
2168   !write(std_out,*) "op%Impurity%particles(op%Impurity%activeFlavor)%tail",op%Impurity%activeFlavor,tail
2169 
2170 
2171   !=====================================
2172   ! First choose segment or antisegment
2173   !=====================================
2174   DO i = 1, 2
2175     signe = SIGN(1.d0,DBLE(nature(i))) 
2176 !      -----  1: segment        signe= 1  ( CTQMC_SEGME =  1 )
2177 !      -----  2: antisegment    signe=-1  ( CTQMC_ANTIS = -2 )
2178 !    NB: Sign(a,b) = sign(b) * a
2179 
2180  !prt!if(op%prtopt==1) write(std_out,*) "       ==Starting configuration",i
2181  !prt!if(op%prtopt==1) write(std_out,*) "        = Segments:"
2182     tailint  = (op%Impurity%particles(op%Impurity%activeFlavor)%tail)
2183 !prt!    do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail
2184  !prt!if(op%prtopt==1)  write(std_out,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1), &
2185 !prt!&                    op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2)
2186 !prt!    enddo
2187   !sui!write(std_out,*) "        = M Matrix",op%Bath%sumtails
2188 !prt!    do it=1,op%Bath%sumtails
2189     !sui!write(std_out,'(a,3x,500e10.3)') "        M start",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2190 !prt!    enddo
2191     CALL OurRng(op%seed,action)
2192 
2193     !==========================
2194     ! Add segment/antisegment
2195     !==========================
2196     IF ( action .LT. .5d0 ) THEN ! Add a segment or antisegment
2197      !ii  write(std_out,*) "        =try: Segment added of type",i,op%prtopt
2198 
2199       ! Select time1 (>0) in [0,beta]
2200       !==============================
2201       CALL OurRng(op%seed,time1)
2202       time1 = time1 * beta
2203 
2204       ! time_avail is the distance between between time1 and 
2205       !   - the next start of a segment for a segment addition
2206       !   - the next end of a segment for an antisegment addition
2207       ! ImpurityOperator_getAvailableTime > 0 for a segment      (signe>0) -> time_avail>0
2208       ! ImpurityOperator_getAvailableTime < 0 for an antisegment (signe<0) -> time_avail>0
2209       !====================================================================
2210       time_avail = ImpurityOperator_getAvailableTime(op%Impurity,time1,position) * signe
2211      !ii  write(std_out,*) "        =try: time_avail",time_avail,time1
2212       IF ( time_avail .GT. 0.d0 ) THEN
2213 
2214         ! Time2 is  the length of the proposed new (anti)segment
2215         !=======================================================
2216         CALL OurRng(op%seed,time2)
2217         IF ( time2 .EQ. 0.d0 ) CALL OurRng(op%seed,time2) ! Prevent null segment
2218 
2219         ! Now time2 is the time at the end of the proposed new (anti) segment
2220         ! time2 > time1 
2221         !====================================================================
2222         time2     = time1 + time2 * time_avail
2223       !sui!write(std_out,*) tailint+1,time1,time2,position
2224 !        CALL CdagC_init(CdagC_1,time1,time2)
2225 
2226         ! CdagC_1 gives the stard/end times for the proposed new segment/antisegment
2227         ! CdagC1(C_) can  be above beta.
2228         !  For a      segment CdagC_1(Cdag_) = time1 < CdagC_1(C_) = time2, l=time2-time1 > 0
2229         !  For a anti segment CdagC_1(Cdag_) = time2 > CdagC_1(C_) = time1, l=time1-time2 < 0
2230         !  time2 can be above beta and thus for a      segment CdagC_1(C_   ) > beta
2231         !  time2 can be above beta and thus for an antisegment CdagC_1(Cdag_) > beta
2232         !  length > 0 for     segment
2233         !  length < 0 for antisegment
2234         !====================================================================================
2235         CdagC_1(Cdag_) = ((1.d0+signe)*time1+(1.d0-signe)*time2)*0.5d0
2236         CdagC_1(C_   ) = ((1.d0+signe)*time2+(1.d0-signe)*time1)*0.5d0
2237 !        length    = CdagC_length(CdagC_1)
2238         length    = CdagC_1(C_   ) - CdagC_1(Cdag_)
2239         !write(std_out,*) "      try : times", CdagC_1(C_   ),CdagC_1(Cdag_)
2240         !write(std_out,*) "      length", length
2241 
2242 !      -----  Computes the determinant ratio
2243         det_ratio = BathOperatoroffdiag_getDetAdd(op%Bath,CdagC_1,position,op%Impurity%particles) 
2244 
2245 !      -----  Computes the overlap
2246         overlap   = ImpurityOperator_getNewOverlap(op%Impurity,CdagC_1)
2247         signdetprev  = ImpurityOperator_getsign(op%Impurity, time2, i, action, position)
2248 
2249         !write(std_out,*) "      overlap   ", overlap
2250         CALL OurRng(op%seed,time1)
2251         !write(std_out,*) "      Rnd", time1
2252         signdet=1.d0
2253         det_ratio=det_ratio*signdetprev
2254                  
2255         IF ( det_ratio .LT. 0.d0 ) THEN
2256         !sui!write(std_out,*) "         NEGATIVE DET",det_ratio,signdetprev
2257           det_ratio   = - det_ratio
2258           sign_det_ratio=-1
2259           op%stats(nature(i)+CTQMC_DETSI) = op%stats(nature(i)+CTQMC_DETSI) + 1.d0
2260        !  op%signvaluecurrent=-1.d0
2261         ELSE
2262           sign_det_ratio=1
2263        !  op%signvaluecurrent=+1.d0
2264          ! signdet=-1.d0
2265         !sui!write(std_out,*) "                  DET",det_ratio,signdetprev
2266         END IF
2267       !ii  write(std_out,*) "                  DET",det_ratio
2268        ! op%signvaluemeas=op%signvaluemeas+1.d0
2269         !write(std_out,*) "        .................",(time1 * (tail + 1.d0 )),beta * time_avail * det_ratio * DEXP(op%mu(op%Impurity%activeFlavor)*length + overlap)
2270         !write(std_out,*) "        .................",beta , time_avail , op%mu(op%Impurity%activeFlavor),op%Impurity%activeFlavor
2271 
2272         IF ( (time1 * (tail + 1.d0 )) &
2273              .LT. (beta * time_avail * det_ratio * DEXP(op%mu(op%Impurity%activeFlavor)*length + overlap) ) ) THEN
2274 !          write(*,*) "before"
2275 !          CALL ListCdagCoffdiag_print(op%Impurity%particles(op%Impurity%activeFlavor),6)
2276           CALL ImpurityOperator_add(op%Impurity,CdagC_1,position)
2277 !          write(*,*) "after "
2278 !          CALL ListCdagCoffdiag_print(op%Impurity%particles(op%Impurity%activeFlavor),6)
2279           CALL BathOperatoroffdiag_setMAdd(op%bath,op%Impurity%particles) 
2280           op%stats(nature(i)+CTQMC_ADDED) = op%stats(nature(i)+CTQMC_ADDED)  + 1.d0
2281           updated = .TRUE. .OR. updated
2282           tail = tail + 1.d0
2283           tailint = tailint + 1
2284 !          read(*,*) time1
2285           !ii  write(6,*) "        Accepted addition, new conf is",time1
2286          !prt! do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail
2287           !prt!if(op%prtopt==1)  write(6,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1),&
2288 !prt!&                          op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2)
2289          !prt! enddo
2290         !sui!write(6,*) "        = M Matrix"
2291          !prt! do it=1,op%Bath%sumtails
2292           !sui!write(6,*) "        M new",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2293          !prt! enddo
2294 
2295           IF ( sign_det_ratio .LT. 0.d0 ) op%signvalue=-op%signvalue
2296         !sui!write(6,*) "                  signvalue",op%signvalue
2297         ELSE
2298      !ii  write(6,*) "        Refused      addition: proba",time1
2299         END IF 
2300       ELSE
2301     !sui!write(6,*) "        Refused      addition: time_avail <0"
2302       END IF 
2303 
2304     !========================================
2305     ! Remove segment/antisegment
2306     !========================================
2307     ELSE ! Remove a segment among the segment of the flavor activeflavor
2308       !ii if(op%prtopt==1)  write(6,*) "        =try: Segment removed of type",i
2309       IF ( tail .GT. 0.d0 ) THEN
2310         CALL OurRng(op%seed,time1)
2311         position = INT(((time1 * tail) + 1.d0) * signe )
2312         !prt!if(op%prtopt==1)  write(6,*) "         position",position 
2313         time_avail = ImpurityOperator_getAvailedTime(op%Impurity,position)
2314         det_ratio  = BathOperatoroffdiag_getDetRemove(op%Bath,position)
2315         !write(6,*) "        det_ratio", det_ratio
2316         CdagC_1    = ImpurityOperator_getSegment(op%Impurity,position)
2317 !        length     = CdagC_length(CdagC_1)
2318         length     = CdagC_1(C_) - CdagC_1(Cdag_)
2319         !write(6,*) "        length   ", length
2320         overlap    = ImpurityOperator_getNewOverlap(op%Impurity,CdagC_1)
2321         !write(6,*) "        overlap  ", overlap
2322         CALL OurRng(op%seed,time1)
2323         !write(6,*) "        Random   ",time1
2324         signdetprev = ImpurityOperator_getsign(op%Impurity, time2, i, action, position)
2325         det_ratio=det_ratio*signdetprev
2326         signdet=1.d0
2327         IF ( det_ratio .LT. 0.d0 ) THEN
2328         !sui!write(6,*) "         NEGATIVE DET",det_ratio,signdetprev
2329           det_ratio   = -det_ratio
2330           sign_det_ratio=-1
2331 !          op%seg_sign = op%seg_sign + 1.d0
2332           op%stats(nature(i)+CTQMC_DETSI) = op%stats(nature(i)+CTQMC_DETSI) + 1.d0
2333           signdet=-1.d0
2334         ELSE 
2335           sign_det_ratio=1
2336         !sui!write(6,*) "                  DET",det_ratio,signdetprev
2337         END IF
2338        !ii  write(6,*) "                  DET",det_ratio
2339         IF ( (time1 * beta * time_avail * DEXP(op%mu(op%Impurity%activeFlavor)*length+overlap)) &
2340              .LT. (tail * det_ratio ) ) THEN
2341           CALL ImpurityOperator_remove(op%Impurity,position)
2342           CALL BathOperatoroffdiag_setMRemove(op%Bath,op%Impurity%particles) 
2343           !op%seg_removed = op%seg_removed  + 1.d0
2344           op%stats(nature(i)+CTQMC_REMOV) = op%stats(nature(i)+CTQMC_REMOV)  + 1.d0
2345           updated = .TRUE. .OR. updated
2346           tail = tail -1.d0
2347           tailint = tailint -1
2348           !ii  write(6,*) "        Accepted removal, new conf is:",time1
2349       !prt!    do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail
2350           !prt!if(op%prtopt==1)  write(6,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1),&
2351 !prt!&                          op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2)
2352       !prt!    enddo
2353         !sui!write(6,*) "        = M Matrix"
2354        !prt!   do it=1,op%Bath%sumtails
2355           !sui!write(6,*) "        M new",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2356         !prt!  enddo
2357           IF ( sign_det_ratio .LT. 0.d0 ) op%signvalue=-op%signvalue
2358         !sui!write(6,*) "                  signvalue",op%signvalue
2359         ELSE
2360      !ii  write(6,*) "        Refused      removal",time1
2361         END IF
2362       ELSE
2363       !sui!write(6,*) "        Refused      removal: no segment available"
2364       END IF
2365     END IF
2366     !========================================
2367     ! End Add/Remove Antisegment
2368     !========================================
2369   END DO
2370 END SUBROUTINE Ctqmcoffdiag_tryAddRemove

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_trySwap [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_trySwap

FUNCTION

  try a global move (swap to flavors)

COPYRIGHT

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

OUTPUT

  flav_i=first flavor swaped
  flav_j=second flavor swaped

SIDE EFFECTS

NOTES

SOURCE

2570 SUBROUTINE Ctqmcoffdiag_trySwap(op,flav_i,flav_j)
2571 
2572 !Arguments ------------------------------------
2573   TYPE(Ctqmcoffdiag)           , INTENT(INOUT) :: op
2574 !  TYPE(BathOperatoroffdiag)    , INTENT(INOUT) :: Bath 
2575 !  TYPE(ImpurityOperator), INTENT(INOUT) :: Impurity 
2576   INTEGER               , INTENT(  OUT) :: flav_i
2577   INTEGER               , INTENT(  OUT) :: flav_j
2578 !Local variables ------------------------------
2579   INTEGER :: flavor_i
2580   INTEGER :: flavor_j !,ii,it,it1 !,iflavor
2581   DOUBLE PRECISION :: rnd
2582   DOUBLE PRECISION :: lengthi
2583   DOUBLE PRECISION :: lengthj
2584   DOUBLE PRECISION :: overlapic1
2585   DOUBLE PRECISION :: overlapjc1
2586   DOUBLE PRECISION :: overlapic2
2587   DOUBLE PRECISION :: overlapjc2
2588   !DOUBLE PRECISION :: detic1
2589   !DOUBLE PRECISION :: detjc1
2590   !DOUBLE PRECISION :: detic2
2591   !DOUBLE PRECISION :: detjc2
2592   DOUBLE PRECISION :: det_ratio,detnew,detold
2593   DOUBLE PRECISION :: local_ratio
2594  ! TYPE(BathOperatoroffdiag)  :: Bathnew
2595 
2596 
2597   !CALL RANDOM_NUMBER(rnd)
2598   CALL OurRng(op%seed,rnd)
2599   flavor_i = NINT(rnd*DBLE(op%flavors-1.d0))+1
2600   !CALL RANDOM_NUMBER(rnd)
2601   CALL OurRng(op%seed,rnd)
2602   flavor_j = NINT(rnd*DBLE(op%flavors-1.d0))+1
2603   !ii write(6,'(a,2i4)') "--------------- new swap --------------------------------",flavor_i,flavor_j
2604   
2605   flav_i = 0
2606   flav_j = 0
2607   !ii   do iflavor=1,op%flavors
2608   !ii     write(6,*) "BEFORE  GMOVE For flavor", iflavor,"size is",op%Impurity%particles(iflavor)%tail," and  Conf is :"
2609   !ii     do ii=1, op%Impurity%Particles(iflavor)%tail
2610   !ii       write(6,'(i4,100f12.3)') ii, op%Impurity%Particles(iflavor)%list(ii,1),&
2611   !ii  &                   op%Impurity%Particles(iflavor)%list(ii,2)
2612   !ii     enddo
2613   !ii   enddo
2614   !ii   write(6,*) "        = M Matrix"
2615   !ii   write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2616   !ii   write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2617   !ii   do it=1,op%Bath%sumtails
2618   !ii     write(6,'(a,100f12.3)') "        M before",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2619   !ii   enddo
2620 
2621   ! todoba this part
2622   IF ( flavor_i .NE. flavor_j ) THEN
2623     !CALL BathOperatoroffdiag_init(Bathnew, op%flavors, op%samples, op%beta, 0, op%opt_nondiag)
2624     ! On tente d'intervertir i et j
2625     ! Configuration actuelle :
2626 
2627     op%modGlobalMove(2) = op%modGlobalMove(2)+1
2628     ! ===========================================
2629     ! First use M matrix to compute determinant
2630     ! ===========================================
2631     detold     = BathOperatoroffdiag_getDetF(op%Bath) ! use op%Bath%M
2632 
2633     ! ===========================================
2634     ! Second build M_update matrix to compute determinant after.
2635     ! ===========================================
2636     !CALL ListCdagCoffdiag_print(particle)
2637     call BathOperatoroffdiag_recomputeM(op%Bath,op%impurity%particles,flavor_i,flavor_j) ! compute op%Bath%M_update
2638     detnew     = BathOperatoroffdiag_getDetF(op%Bath,option=1) ! use op%Bath%M_update
2639 
2640     lengthi    = ImpurityOperator_measN(op%Impurity,flavor_i)
2641     lengthj    = ImpurityOperator_measN(op%Impurity,flavor_j)
2642     overlapic1 = ImpurityOperator_overlapFlavor(op%Impurity,flavor_i)
2643     overlapjc1 = ImpurityOperator_overlapFlavor(op%Impurity,flavor_j)
2644     ! lengths unchanged
2645     overlapic2 = ImpurityOperator_overlapSwap(op%Impurity,flavor_i,flavor_j)
2646     overlapjc2 = ImpurityOperator_overlapSwap(op%Impurity,flavor_j,flavor_i)
2647 
2648 !    IF ( detic1*detjc1 .EQ. detic2*detjc2 ) THEN
2649 !      det_ratio = 1.d0
2650 !    ELSE IF ( detic1*detjc1 .EQ. 0.d0 ) THEN
2651 !      det_ratio = detic2*detjc2 ! evite de diviser par 0 si pas de segment
2652 !    ELSE
2653 
2654     det_ratio = detnew/detold ! because the determinant is the determinant of F
2655    !ii  write(6,*) "det_ratio, detold,detnew",det_ratio, detold,detnew, detold/detnew
2656 
2657 !    END IF
2658     local_ratio = DEXP(-overlapic2*overlapjc2+overlapic1*overlapjc1 &
2659                       +(lengthj-lengthi)*(op%mu(flavor_i)-op%mu(flavor_j)))
2660    !ii  write(6,*) "local_ratio",local_ratio
2661 
2662     ! Wloc = exp(muN-Uo)
2663     !CALL RANDOM_NUMBER(rnd)
2664     CALL OurRng(op%seed,rnd)
2665     IF ( rnd .LT. local_ratio*det_ratio ) THEN ! swap accepted
2666    !ii    write(6,*) "        = M Matrix before swap"
2667    !ii    write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2668    !ii    write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2669    !ii    do it=1,op%Bath%sumtails
2670    !ii      write(6,'(a,100f12.3)') "        M after ",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2671    !ii    enddo
2672    !ii    do it=1,op%Bath%sumtails
2673    !ii      write(6,'(a,100f12.3)') " update M after ",(op%Bath%M_update%mat(it,it1),it1=1,op%Bath%sumtails)
2674    !ii    enddo
2675    !ii    write(6,*) "Gmove accepted",rnd,local_ratio*det_ratio
2676       CALL ImpurityOperator_swap(op%Impurity, flavor_i,flavor_j)
2677       CALL BathOperatoroffdiag_swap    (op%Bath    , flavor_i,flavor_j) !  use op%Bath%M_update to built new op%Bath%M
2678       
2679       op%swap = op%swap + 1.d0
2680       flav_i = flavor_i
2681       flav_j = flavor_j
2682     ELSE
2683    !ii   write(6,*) "Gmove refused",rnd,local_ratio*det_ratio
2684 !      CALL WARN("Swap refused")
2685 !      WRITE(op%ostream,'(6E24.14)') local_ratio, det_ratio, detic1, detjc1, detic2, detjc2
2686     END IF
2687    ! CALL BathOperatoroffdiag_destroy(Bathnew)
2688   END IF
2689  !ii  do iflavor=1,op%flavors
2690  !ii    write(6,*) "AFTER   GMOVE For flavor", iflavor,"size is",op%Impurity%particles(iflavor)%tail," and  Conf is :"
2691  !ii    do ii=1, op%Impurity%Particles(iflavor)%tail
2692  !ii      write(6,'(15x,i4,100f12.3)') ii, op%Impurity%Particles(iflavor)%list(ii,1),&
2693  !ii &                   op%Impurity%Particles(iflavor)%list(ii,2)
2694  !ii    enddo
2695  !ii  enddo
2696  !ii  write(6,*) "        = M Matrix"
2697  !ii  write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2698  !ii  write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2699  !ii  do it=1,op%Bath%sumtails
2700  !ii    write(6,'(a,100f12.3)') "        M after ",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2701  !ii  enddo
2702  !ii  do it=1,op%Bath%sumtails
2703  !ii    write(6,'(a,100f12.3)') " update M after ",(op%Bath%M_update%mat(it,it1),it1=1,op%Bath%sumtails)
2704  !ii  enddo
2705 
2706 END SUBROUTINE Ctqmcoffdiag_trySwap

m_Ctqmcoffdiag/Ctqmcoffdiag [ Types ]

[ Top ] [ m_Ctqmcoffdiag ] [ Types ]

NAME

  Ctqmcoffdiag

FUNCTION

  This structured datatype contains the necessary data

COPYRIGHT

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

 98 TYPE Ctqmcoffdiag
 99 
100   LOGICAL :: init = .FALSE.
101 ! Flag: is MC initialized
102 
103   LOGICAL :: set  = .FALSE.
104 ! Flag: ??
105 
106   LOGICAL :: setU = .FALSE.
107 ! Flag: is U Set ?
108 
109   LOGICAL :: inF  = .FALSE.
110 ! Flag: is hybridization fct in input ?
111 
112   LOGICAL :: done = .FALSE.
113 ! Flag: is MC terminated ?
114 
115   LOGICAL :: para = .FALSE.
116 ! Flag:  do we have parameters in input
117 
118   LOGICAL :: have_MPI = .FALSE.
119 ! Flag: 
120 
121   INTEGER :: opt_movie = 0
122 !
123 
124   INTEGER :: opt_analysis = 0
125 ! correlations 
126 
127   INTEGER :: opt_check = 0
128 ! various check 0
129 ! various check 1 impurity
130 ! various check 2 bath
131 ! various check 3 both
132 
133   INTEGER :: opt_order = 0
134 ! nb of segments max for analysis
135 
136   INTEGER :: opt_histo = 0
137 ! Enable histo calc.
138 
139   INTEGER :: opt_noise = 0
140 ! compute noise
141 
142   INTEGER :: opt_spectra = 0
143 ! markov chain FT (correlation time)
144 
145   INTEGER :: opt_levels = 0
146 ! do we have energy levels
147 
148   INTEGER :: opt_hybri_limit = 0
149 ! do we have limit of hybridization (yes=1)
150 
151   INTEGER :: opt_nondiag = 0
152 ! if opt_nondiag = 1 F is non diagonal.
153 
154   INTEGER :: prtopt = 1
155 ! printing
156 
157   INTEGER :: flavors
158 ! number of flavors 
159 
160   INTEGER :: measurements
161 !  The modulo used to measure the interaction energy and the number of electrons. Example : 2 means the measure is perform every two sweeps. 
162 
163   INTEGER :: samples
164 ! nb of L points (dmftqmc_l)
165 
166   INTEGER(8) :: seed
167 !
168 
169   INTEGER :: sweeps
170 !
171 
172   INTEGER :: thermalization
173 !
174 
175   INTEGER :: ostream
176 ! output file
177 
178   INTEGER :: istream
179 ! input file
180 
181   INTEGER :: modNoise1
182 ! measure the noise each modNoise1
183 
184   INTEGER :: modNoise2
185 ! measure the noise each modNoise2
186 
187   INTEGER :: activeFlavor
188 ! orbital on which one do sth now
189 
190   INTEGER, DIMENSION(1:2) :: modGlobalMove
191 ! 1: global move each modglobalmove(1)
192 ! 2: we have done modglobalmove(2) for two different orbitals.
193 
194   INTEGER :: Wmax
195 ! Max freq for FT
196 
197   DOUBLE PRECISION, DIMENSION(1:6) :: stats
198 ! to now how many negative determinant, antisegments,seeme.e.twfs...j
199 
200   DOUBLE PRECISION :: swap
201 ! nb of successfull GM
202 
203   DOUBLE PRECISION :: signvalue
204 
205   INTEGER :: MY_COMM
206 ! 
207 
208   INTEGER :: rank
209 !
210 
211   INTEGER :: size
212 ! size of MY_COMM
213 
214   DOUBLE PRECISION :: runTime ! time for the run routine
215 !  
216 
217   DOUBLE PRECISION :: beta
218 !
219 
220   DOUBLE PRECISION :: U
221 
222   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: mu
223 ! levels
224 
225   COMPLEX(KIND=8), ALLOCATABLE, DIMENSION(:,:) :: hybri_limit
226 ! coeff A such that F=-A/(iwn)
227 
228   TYPE(GreenHyboffdiag)                        :: Greens 
229 ! Green's function
230 
231   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: measN 
232 ! measure of occupations (3or4,flavor) 
233 
234   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:  ) :: measDE
235 !  (flavor,flavor) double occupancies
236 !  (1,1): total energy of correlation.
237 
238   DOUBLE PRECISION :: a_Noise
239 ! Noise a exp (-bx) for the  noise
240 
241   DOUBLE PRECISION :: b_Noise
242 ! Noise a exp (-bx) for the  noise
243 
244   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: abNoiseG   !(ab,tau,flavor)
245 ! Noise but for G
246 
247   TYPE(Vector)             , DIMENSION(1:2) :: measNoise 
248   TYPE(Vector), ALLOCATABLE, DIMENSION(:,:,:) :: measNoiseG       !(tau,flavor,mod) 
249 ! accumulate each value relataed to measurenoise 1 2
250 
251 !#ifdef CTCtqmcoffdiag_ANALYSIS
252 !  INTEGER                                     :: order
253   DOUBLE PRECISION                            :: inv_dt
254 ! 1/(beta/L)
255 
256   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:  ) :: measPerturbation 
257 ! opt_order,nflavor
258 
259   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: occup_histo_time
260 ! nflavor
261 
262   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:  ) :: meas_fullemptylines
263 ! opt_order,nflavor
264 
265   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: measCorrelation 
266 ! segment,antisegment,nflavor,nflavor
267 
268 !#endif
269 !#ifdef CTCtqmcoffdiag_CHECK
270   DOUBLE PRECISION :: errorImpurity
271 ! check 
272 
273   DOUBLE PRECISION :: errorBath
274 ! for check
275 
276 !#endif
277   TYPE(BathOperatoroffdiag)              :: Bath
278 
279 
280   TYPE(ImpurityOperator)          :: Impurity
281 
282   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: density
283 
284 END TYPE Ctqmcoffdiag