TABLE OF CONTENTS


ABINIT/m_Ctqmc [ Modules ]

[ Top ] [ Modules ]

NAME

  m_Ctqmc

FUNCTION

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

COPYRIGHT

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

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

31 #include "defs.h"
32 
33 MODULE m_Ctqmc
34 
35 USE m_Global
36 USE m_GreenHyb
37 USE m_BathOperator
38 USE m_ImpurityOperator
39 USE m_Stat
40 USE m_FFTHyb
41 USE m_OurRng
42 USE m_Vector
43 #ifdef HAVE_MPI2
44 USE mpi
45 #endif
46 
47 IMPLICIT NONE

ABINIT/m_Ctqmc/Ctqmc_allocateAll [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_allocateAll

FUNCTION

  Allocate all non option varibales

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

680 SUBROUTINE Ctqmc_allocateAll(this)
681 
682 !Arguments ------------------------------------
683 
684 !This section has been created automatically by the script Abilint (TD).
685 !Do not modify the following lines by hand.
686 #undef ABI_FUNC
687 #define ABI_FUNC 'Ctqmc_allocateAll'
688 !End of the abilint section
689 
690   TYPE(Ctqmc), INTENT(INOUT) :: this
691 !Local variables ------------------------------
692   INTEGER                  :: flavors
693 
694   IF ( .NOT. this%para ) &
695     CALL ERROR("Ctqmc_allocateAll : Ctqmc_setParameters never called  ")
696 
697   flavors = this%flavors
698 
699   DT_FREEIF(this%Greens)
700   DT_MALLOC(this%Greens,(1:flavors))
701 
702   FREEIF(this%measN)
703   MALLOC(this%measN,(1:4,1:flavors))
704   this%measN = 0.d0
705 
706   FREEIF(this%measDE)
707   MALLOC(this%measDE,(1:flavors,1:flavors) )
708   this%measDE = 0.d0
709 
710   FREEIF(this%mu)
711   MALLOC(this%mu,(1:flavors) )
712   this%mu = 0.d0
713 END SUBROUTINE Ctqmc_allocateAll

ABINIT/m_Ctqmc/Ctqmc_allocateOpt [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_allocateOpt

FUNCTION

  allocate all option variables 

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

747 SUBROUTINE Ctqmc_allocateOpt(this)
748 
749 !Arguments ------------------------------------
750 
751 !This section has been created automatically by the script Abilint (TD).
752 !Do not modify the following lines by hand.
753 #undef ABI_FUNC
754 #define ABI_FUNC 'Ctqmc_allocateOpt'
755 !End of the abilint section
756 
757   TYPE(Ctqmc), INTENT(INOUT) :: this
758 !Local variables ------------------------------
759   INTEGER :: i
760   INTEGER :: j
761   INTEGER :: k
762 
763   IF ( .NOT. this%para ) &
764     CALL ERROR("Ctqmc_allocateOpt : Ctqmc_setParameters never called  ")
765 
766   IF ( this%opt_analysis .EQ. 1 ) THEN
767     FREEIF(this%measCorrelation)
768     MALLOC(this%measCorrelation,(1:this%samples+1,1:3,1:this%flavors))
769     this%measCorrelation = 0.d0
770   END IF
771 
772   IF ( this%opt_order .GT. 0 ) THEN
773     FREEIF(this%measPerturbation)
774     MALLOC(this%measPerturbation,(1:this%opt_order,1:this%flavors))
775     this%measPerturbation = 0.d0
776   END IF
777 
778   IF ( this%opt_noise .EQ. 1 ) THEN
779     IF ( ALLOCATED(this%measNoiseG) ) THEN
780       DO i=1,2
781         DO j = 1, this%flavors
782           DO k= 1, this%samples+1
783             CALL Vector_destroy(this%measNoiseG(k,j,i))
784           END DO
785         END DO
786       END DO
787       DT_FREE(this%measNoiseG)
788     END IF
789     DT_MALLOC(this%measNoiseG,(1:this%samples+1,1:this%flavors,1:2))
790     !DO i=1,2
791       DO j = 1, this%flavors
792         DO k= 1, this%samples+1
793           CALL Vector_init(this%measNoiseG(k,j,1),CTQMC_SLICE1)
794         END DO
795       END DO
796       DO j = 1, this%flavors
797         DO k= 1, this%samples+1
798           CALL Vector_init(this%measNoiseG(k,j,2),CTQMC_SLICE1*CTQMC_SLICE2+1) ! +1 pour etre remplacer ceil
799         END DO
800       END DO
801     !END DO
802     FREEIF(this%abNoiseG)
803     MALLOC(this%aBNoiseG,(1:2,1:this%samples+1,this%flavors))
804     this%abNoiseG = 0.d0
805   END IF
806 
807   IF (this%opt_spectra .GE. 1 ) THEN
808     FREEIF(this%density)
809     !MALLOC(this%density,(1:this%thermalization,1:this%flavors))
810     i = CEILING(DBLE(this%thermalization+this%sweeps)/DBLE(this%measurements*this%opt_spectra))
811     MALLOC(this%density,(1:this%flavors+1,1:i))
812     this%density = 0.d0
813   END IF
814 !#endif
815 END SUBROUTINE Ctqmc_allocateOpt

ABINIT/m_Ctqmc/Ctqmc_clear [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_clear

FUNCTION

  clear a ctqmc run

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1048 SUBROUTINE Ctqmc_clear(this)
1049 
1050 !Arguments ------------------------------------
1051 
1052 !This section has been created automatically by the script Abilint (TD).
1053 !Do not modify the following lines by hand.
1054 #undef ABI_FUNC
1055 #define ABI_FUNC 'Ctqmc_clear'
1056 !End of the abilint section
1057 
1058   TYPE(Ctqmc), INTENT(INOUT) :: this
1059 !Local variables ------------------------------
1060   INTEGER :: i
1061   INTEGER :: j
1062   INTEGER :: k
1063 
1064   this%measN(1,:) = 0.d0
1065   this%measN(2,:) = 0.d0
1066   !Do not set measN(3,:) to 0 to avoid erasing N between therm and ctqmc
1067   this%measN(4,:) = 0.d0
1068   this%measDE = 0.d0
1069 !  this%seg_added    = 0.d0
1070 !  this%anti_added   = 0.d0
1071 !  this%seg_removed  = 0.d0
1072 !  this%anti_removed = 0.d0
1073 !  this%seg_sign     = 0.d0
1074 !  this%anti_sign    = 0.d0
1075   this%stats(:)     = 0.d0
1076   this%swap         = 0.d0
1077   this%runTime      = 0.d0
1078   this%modGlobalMove(2) = 0 
1079   CALL Vector_clear(this%measNoise(1))
1080   CALL Vector_clear(this%measNoise(2))
1081 !#ifdef CTCtqmc_CHECK
1082   this%errorImpurity = 0.d0
1083   this%errorBath     = 0.d0
1084 !#endif
1085   DO j = 1, this%flavors
1086     CALL GreenHyb_clear(this%Greens(j))
1087   END DO
1088 !#ifdef CTCtqmc_ANALYSIS
1089   IF ( this%opt_analysis .EQ. 1 .AND. ALLOCATED(this%measCorrelation) ) &    
1090     this%measCorrelation = 0.d0 
1091   IF ( this%opt_order .GT. 0 .AND. ALLOCATED(this%measPerturbation) ) &
1092     this%measPerturbation = 0.d0
1093   IF ( this%opt_noise .EQ. 1 .AND. ALLOCATED(this%measNoiseG) ) THEN
1094     DO i=1,2
1095       DO j = 1, this%flavors
1096         DO k= 1, this%samples+1
1097           CALL Vector_clear(this%measNoiseG(k,j,i))
1098         END DO
1099       END DO
1100     END DO
1101   END IF
1102 !#endif
1103 END SUBROUTINE Ctqmc_clear

ABINIT/m_Ctqmc/Ctqmc_computeF [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_computeF

FUNCTION

  Compute the hybridization function

COPYRIGHT

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

INPUTS

  this=ctqmc
  Gomega=G0 to compute F
  opt_fk=What is Gomega

OUTPUT

  F=hybridization function

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1268 SUBROUTINE Ctqmc_computeF(this, Gomega, F, opt_fk)
1269 
1270 !Arguments ------------------------------------
1271 
1272 !This section has been created automatically by the script Abilint (TD).
1273 !Do not modify the following lines by hand.
1274 #undef ABI_FUNC
1275 #define ABI_FUNC 'Ctqmc_computeF'
1276 !End of the abilint section
1277 
1278   TYPE(Ctqmc)                       , INTENT(INOUT) :: this
1279   COMPLEX(KIND=8), DIMENSION(:,:), INTENT(IN   ) :: Gomega
1280   !INTEGER                         , INTENT(IN   ) :: Wmax
1281   DOUBLE PRECISION, DIMENSION(:,:), INTENT(INOUT) :: F
1282   INTEGER                         , INTENT(IN   ) :: opt_fk
1283 !Local variables ------------------------------
1284   INTEGER                                         :: flavors
1285   INTEGER                                         :: samples
1286   INTEGER                                         :: iflavor
1287   INTEGER                                         :: iomega
1288   INTEGER                                         :: itau
1289   DOUBLE PRECISION                                :: pi_invBeta
1290   DOUBLE PRECISION                                :: K
1291   DOUBLE PRECISION                                :: re
1292   DOUBLE PRECISION                                :: im
1293   COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE   :: F_omega
1294   TYPE(GreenHyb)                                     :: F_tmp
1295 
1296   flavors    = this%flavors
1297 
1298   samples    = this%samples
1299   pi_invBeta = ACOS(-1.d0) / this%beta
1300   this%Wmax=SIZE(Gomega,1)
1301 
1302   IF ( this%have_MPI .EQV. .TRUE. ) THEN
1303     CALL GreenHyb_init(F_tmp,samples,this%beta,MY_COMM=this%MY_COMM)
1304   ELSE
1305     CALL GreenHyb_init(F_tmp,samples,this%beta)
1306   END IF
1307 !  K = this%mu
1308 
1309   MALLOC(F_omega,(1:this%Wmax,1:flavors))
1310 
1311   !IF ( this%rank .EQ. 0 ) &
1312     !OPEN(UNIT=9876,FILE="K.dat",POSITION="APPEND")
1313   IF ( opt_fk .EQ. 0 ) THEN
1314     DO iflavor = 1, flavors
1315       DO iomega=1,this%Wmax
1316         re = REAL(Gomega(iomega,iflavor))
1317         im = AIMAG(Gomega(iomega,iflavor))
1318         F_omega(iomega,iflavor) = CMPLX(-re/(re*re+im*im),im/(re*re+im*im),8)
1319       END DO
1320     END DO
1321     !F_omega = CMPLX(-1.d0,0,8)/Gomega
1322   ELSE
1323     F_omega = Gomega
1324   END IF
1325 
1326   DO iflavor = 1, flavors
1327     IF ( this%opt_levels .EQ. 1 ) THEN
1328       K = this%mu(iflavor)
1329     ELSE
1330       K = -REAL(F_omega(this%Wmax, iflavor))
1331 !    this%mu = K
1332       this%mu(iflavor) = K 
1333     END IF
1334     !IF ( this%rank .EQ. 0 ) &
1335     !WRITE(9876,'(I4,2E22.14)') iflavor, K, REAL(-F_omega(this%Wmax, iflavor))
1336     !IF(this%rank .EQ.0) &
1337     !WRITE(this%ostream,*) "CTQMC K, this%mu = ",K,this%mu(iflavor)
1338     !WRITE(this%ostream,*) "CTQMC beta     = ",this%beta
1339     IF ( opt_fk .EQ. 0 ) THEN
1340       DO iomega = 1, this%Wmax
1341         re = REAL(F_omega(iomega,iflavor))
1342         im = AIMAG(F_omega(iomega,iflavor))
1343         F_omega(iomega,iflavor) = CMPLX(re + K, im + (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, 8)
1344         !if(iflavor==1.and.this%rank==0) then
1345           !write(224,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(F_omega(iomega,iflavor)),imag(F_omega(iomega,iflavor))
1346           !write(225,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(Gomega(iomega, iflavor)),imag(Gomega(iomega, iflavor))
1347         !end if 
1348       END DO
1349     ELSE
1350       DO iomega = 1, this%Wmax
1351         F_omega(iomega,iflavor) = F_omega(iomega,iflavor) &
1352                     + CMPLX(K, 0.d0, 8)
1353         !if(iflavor==1.and.this%rank==0) then
1354           !write(224,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(F_omega(iomega,iflavor)),imag(F_omega(iomega,iflavor))
1355           !write(225,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(Gomega(iomega, iflavor)),imag(Gomega(iomega, iflavor))
1356         !end if 
1357       END DO
1358     END IF
1359     K = REAL(CMPLX(0,(2.d0*DBLE(this%Wmax)-1.d0)*pi_invBeta,8)*F_omega(this%Wmax,iflavor))
1360     CALL GreenHyb_setMuD1(this%Greens(iflavor),this%mu(iflavor),K)
1361     CALL GreenHyb_setOperW(F_tmp,F_omega(:,iflavor))
1362     !CALL GreenHyb_backFourier(F_tmp,F_omega(:,iflavor))
1363     CALL GreenHyb_backFourier(F_tmp)
1364     F(1:samples+1,iflavor) = (/ (-F_tmp%oper(samples+1-itau),itau=0,samples) /)
1365   END DO
1366   FREE(F_omega)
1367   CALL GreenHyb_destroy(F_tmp)
1368 END SUBROUTINE Ctqmc_computeF

ABINIT/m_Ctqmc/Ctqmc_destroy [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_destroy

FUNCTION

  destroy and deallocate all variables

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3719 SUBROUTINE Ctqmc_destroy(this)
3720 
3721 !Arguments ------------------------------------
3722 
3723 !This section has been created automatically by the script Abilint (TD).
3724 !Do not modify the following lines by hand.
3725 #undef ABI_FUNC
3726 #define ABI_FUNC 'Ctqmc_destroy'
3727 !End of the abilint section
3728 
3729   TYPE(Ctqmc), INTENT(INOUT) :: this
3730 !Local variables ------------------------------
3731   INTEGER                  :: iflavor
3732   INTEGER                  :: flavors
3733   INTEGER                  :: i
3734   INTEGER                  :: j
3735   INTEGER                  :: k
3736 
3737   if ( this%init .EQV. .FALSE. ) RETURN
3738 
3739   flavors = this%flavors
3740 
3741   CALL ImpurityOperator_destroy(this%Impurity)
3742   CALL BathOperator_destroy(this%Bath)
3743   CALL Vector_destroy(this%measNoise(1))
3744   CALL Vector_destroy(this%measNoise(2))
3745 
3746   IF ( ALLOCATED(this%Greens) ) THEN
3747     DO iflavor = 1, flavors
3748      CALL GreenHyb_destroy(this%Greens(iflavor))
3749     END DO
3750     DT_FREE( this%Greens )
3751   END IF
3752 !#ifdef CTCtqmc_ANALYSIS
3753   FREEIF(this%measCorrelation)
3754   FREEIF(this%measPerturbation)
3755   FREEIF(this%measN)
3756   FREEIF(this%measDE)
3757   FREEIF(this%mu)
3758   FREEIF(this%abNoiseG)
3759   IF ( ALLOCATED(this%measNoiseG) ) THEN
3760     DO i=1,2
3761       DO j = 1, this%flavors
3762         DO k= 1, this%samples+1
3763           CALL Vector_destroy(this%measNoiseG(k,j,i))
3764         END DO
3765       END DO
3766     END DO
3767     DT_FREE(this%measNoiseG)
3768   END IF
3769   FREEIF(this%density)
3770 !#endif
3771   this%ostream        = 0
3772   this%istream        = 0
3773  
3774   this%sweeps         = 0
3775   this%thermalization = 0
3776   this%flavors        = 0
3777   this%samples        = 0
3778   this%beta           = 0.d0
3779 !  this%seg_added      = 0.d0
3780 !  this%anti_added     = 0.d0
3781 !  this%seg_removed    = 0.d0
3782 !  this%anti_removed   = 0.d0
3783 !  this%seg_sign       = 0.d0
3784 !  this%anti_sign      = 0.d0
3785   this%stats          = 0.d0
3786   this%swap           = 0.d0
3787 
3788 
3789   this%set  = .FALSE.
3790   this%done = .FALSE.
3791   this%init = .FALSE.
3792 END SUBROUTINE Ctqmc_destroy

ABINIT/m_Ctqmc/Ctqmc_getD [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_getD

FUNCTION

  get double occupation

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

  D=full double occupation

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2950 SUBROUTINE Ctqmc_getD(this, D)
2951 
2952 !Arguments ------------------------------------
2953 
2954 !This section has been created automatically by the script Abilint (TD).
2955 !Do not modify the following lines by hand.
2956 #undef ABI_FUNC
2957 #define ABI_FUNC 'Ctqmc_getD'
2958 !End of the abilint section
2959 
2960   TYPE(Ctqmc)       , INTENT(IN ) :: this
2961   DOUBLE PRECISION, DIMENSION(:,:), INTENT(OUT) :: D
2962 !Local variables ------------------------------
2963   INTEGER                       :: iflavor1
2964   INTEGER                       :: iflavor2
2965 
2966   IF ( SIZE(D,1) .LT. this%flavors .OR. SIZE(D,2) .LT. this%flavors ) &
2967     CALL ERROR("Ctqmc_getD : Dimensions of array D are too small")
2968 
2969   D = 0.d0
2970 
2971   DO iflavor1 = 1, this%flavors
2972     DO iflavor2 = 1, this%flavors
2973       D(iflavor2,iflavor1) =  this%measDE(iflavor2,iflavor1)
2974     END DO
2975     D(iflavor1,iflavor1) = 0.d0
2976   END DO
2977 
2978 END SUBROUTINE Ctqmc_getD

ABINIT/m_Ctqmc/Ctqmc_getE [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_getE

FUNCTION

  get interaction energy and noise on it

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

  E=interaction energy
  noise=noise on this value

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3013 SUBROUTINE Ctqmc_getE(this,E,noise)
3014 
3015 !Arguments ------------------------------------
3016 
3017 !This section has been created automatically by the script Abilint (TD).
3018 !Do not modify the following lines by hand.
3019 #undef ABI_FUNC
3020 #define ABI_FUNC 'Ctqmc_getE'
3021 !End of the abilint section
3022 
3023   TYPE(Ctqmc)       , INTENT(IN ) :: this
3024   DOUBLE PRECISION, OPTIONAL, INTENT(OUT) :: E
3025   DOUBLE PRECISION, OPTIONAL, INTENT(OUT) :: Noise
3026 
3027   IF ( PRESENT(E) ) &
3028     E = this%measDE(1,1)  
3029   IF ( PRESENT(Noise) ) &
3030     Noise = SUM(this%Impurity%mat_U)/(this%flavors*(this%flavors-1)) &
3031             * this%a_Noise*(DBLE(this%sweeps)*DBLE(this%size))**this%b_Noise
3032 END SUBROUTINE Ctqmc_getE

ABINIT/m_Ctqmc/Ctqmc_getGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_getGreen

FUNCTION

  Get the full green functions in time and/or frequency

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

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

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2856 SUBROUTINE Ctqmc_getGreen(this, Gtau, Gw)
2857 
2858 !Arguments ------------------------------------
2859 
2860 !This section has been created automatically by the script Abilint (TD).
2861 !Do not modify the following lines by hand.
2862 #undef ABI_FUNC
2863 #define ABI_FUNC 'Ctqmc_getGreen'
2864 !End of the abilint section
2865 
2866   TYPE(Ctqmc)          , INTENT(INOUT)    :: this
2867   DOUBLE PRECISION, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: Gtau
2868   COMPLEX(KIND=8), DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: Gw
2869 !Local variables ------------------------------
2870   !INTEGER                            :: itime
2871   INTEGER                            :: iflavor1
2872   INTEGER                            :: iflavor2
2873   INTEGER                            :: iflavor3
2874   INTEGER                            :: flavors
2875   DOUBLE PRECISION :: u1 
2876   DOUBLE PRECISION :: u2
2877   DOUBLE PRECISION :: Un
2878   DOUBLE PRECISION :: UUnn
2879 
2880   flavors = this%flavors
2881   DO iflavor1 = 1, flavors
2882     u1 = 0.d0
2883     u2 = 0.d0
2884     DO iflavor2 = 1, flavors
2885       IF ( iflavor2 .EQ. iflavor1 ) CYCLE
2886       Un = this%Impurity%mat_U(iflavor2,iflavor1) * this%measN(1,iflavor2)
2887       u1 = u1 + Un 
2888       u2 = u2 + Un*this%Impurity%mat_U(iflavor2,iflavor1) 
2889       DO iflavor3 = 1, flavors
2890         IF ( iflavor3 .EQ. iflavor2 .OR. iflavor3 .EQ. iflavor1 ) CYCLE
2891         UUnn = (this%Impurity%mat_U(iflavor2,iflavor1)*this%Impurity%mat_U(iflavor3,iflavor1)) * this%measDE(iflavor2,iflavor3) 
2892         u2 = u2 + UUnn 
2893       END DO
2894     END DO  
2895 
2896     CALL GreenHyb_setMoments(this%Greens(iflavor1),u1,u2)
2897     IF ( PRESENT( Gtau ) ) THEN
2898       Gtau(1:this%samples,iflavor1) = this%Greens(iflavor1)%oper(1:this%samples)
2899     END IF
2900        !write(6,*) "present gw", present(gw)
2901     IF ( PRESENT( Gw ) ) THEN
2902        !write(6,*) "size gw",SIZE(Gw,DIM=2) ,flavors+1 
2903       IF ( SIZE(Gw,DIM=2) .EQ. flavors+1 ) THEN
2904         CALL GreenHyb_forFourier(this%Greens(iflavor1), Gomega=Gw(:,iflavor1), omega=Gw(:,this%flavors+1))
2905         !IF ( this%rank .EQ. 0 ) write(20,*) Gw(:,iflavor1)
2906       ELSE IF ( SIZE(Gw,DIM=2) .EQ. flavors ) THEN  
2907         CALL GreenHyb_forFourier(this%Greens(iflavor1),Gomega=Gw(:,iflavor1))
2908       ELSE
2909         CALL WARNALL("Ctqmc_getGreen : Gw is not valid                    ")
2910         CALL GreenHyb_forFourier(this%Greens(iflavor1),Wmax=this%Wmax)
2911       END IF
2912     ELSE
2913       CALL GreenHyb_forFourier(this%Greens(iflavor1),Wmax=this%Wmax)
2914     END IF
2915   END DO
2916 END SUBROUTINE Ctqmc_getGreen

ABINIT/m_Ctqmc/Ctqmc_getResult [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_getResult

FUNCTION

  reduce everything to get the result of the simulation

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2333 SUBROUTINE Ctqmc_getResult(this)
2334 
2335 
2336 !This section has been created automatically by the script Abilint (TD).
2337 !Do not modify the following lines by hand.
2338 #undef ABI_FUNC
2339 #define ABI_FUNC 'Ctqmc_getResult'
2340 !End of the abilint section
2341 
2342 
2343 #ifdef HAVE_MPI1
2344 include 'mpif.h'
2345 #endif
2346 !Arguments ------------------------------------
2347   TYPE(Ctqmc)  , INTENT(INOUT)                    :: this
2348 !Local variables ------------------------------
2349   INTEGER                                       :: iflavor
2350   INTEGER                                       :: flavors
2351   INTEGER                                       :: itau
2352   INTEGER                                       :: endDensity
2353   DOUBLE PRECISION                              :: inv_flavors
2354   DOUBLE PRECISION                              :: a
2355   DOUBLE PRECISION                              :: b
2356   DOUBLE PRECISION                              :: r
2357   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: alpha
2358   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: beta
2359   DOUBLE PRECISION,              DIMENSION(1:2) :: TabX
2360   DOUBLE PRECISION,              DIMENSION(1:2) :: TabY
2361   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:)   :: freqs
2362   INTEGER, ALLOCATABLE, DIMENSION(:)   :: counts
2363   INTEGER, ALLOCATABLE, DIMENSION(:)   :: displs
2364   INTEGER                                       :: sp1
2365   INTEGER                                       :: spAll
2366   INTEGER                                       :: last
2367   INTEGER                                       :: n1
2368   INTEGER                                       :: n2
2369   INTEGER                                       :: debut
2370 !  INTEGER                                       :: fin
2371 #ifdef HAVE_MPI
2372   INTEGER                                       :: ierr
2373 #endif
2374   DOUBLE PRECISION                              :: inv_size
2375   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: buffer 
2376   TYPE(FFTHyb) :: FFTmrka
2377 
2378   IF ( .NOT. this%done ) &
2379     CALL ERROR("Ctqmc_getResult : Simulation not run                ")
2380 
2381   flavors     =  this%flavors
2382   inv_flavors = 1.d0 / DBLE(flavors)
2383 
2384 
2385   inv_size = 1.d0 / DBLE(this%size)
2386   sp1 = 0
2387   spAll = 0
2388 
2389 !#ifdef CTCtqmc_CHECK
2390   IF ( this%opt_check .GT. 0 ) THEN
2391     this%errorImpurity = ImpurityOperator_getError(this%Impurity) * inv_flavors 
2392     this%errorBath     = BathOperator_getError    (this%Bath    ) * inv_flavors 
2393   END IF
2394 !#endif
2395 
2396   MALLOC(alpha,(1,1))
2397   MALLOC(beta,(1,1))
2398   MALLOC(buffer,(1,1))
2399   IF ( this%opt_noise .EQ. 1) THEN
2400     FREEIF(alpha)
2401     MALLOC(alpha,(1:this%samples+1,1:flavors))
2402     FREEIF(beta)
2403     MALLOC(beta,(1:this%samples+1,1:flavors))
2404   END IF
2405 
2406   IF ( this%have_MPI .EQV. .TRUE.) THEN 
2407     sp1   = this%samples+1
2408     spALL = sp1 + flavors + 6 
2409 
2410 !#ifdef CTCtqmc_ANALYSIS
2411     IF ( this%opt_analysis .EQ. 1 ) &
2412       spAll = spAll + 3*sp1 
2413     IF ( this%opt_order .GT. 0 ) &
2414       spAll = spAll + this%opt_order 
2415     IF ( this%opt_noise .EQ. 1 ) &
2416       spAll = spAll + 2*(this%samples + 1)
2417 !#endif
2418 
2419     FREEIF(buffer)
2420     MALLOC(buffer,(1:spAll,1:MAX(2,flavors)))
2421   END IF
2422 
2423 !  this%seg_added    = this%seg_added    * inv_flavors 
2424 !  this%seg_removed  = this%seg_removed  * inv_flavors
2425 !  this%seg_sign     = this%seg_sign     * inv_flavors
2426 !  this%anti_added   = this%anti_added   * inv_flavors
2427 !  this%anti_removed = this%anti_removed * inv_flavors
2428 !  this%anti_sign    = this%anti_sign    * inv_flavors
2429   this%stats(:) = this%stats(:) * inv_flavors
2430 
2431   DO iflavor = 1, flavors
2432     CALL GreenHyb_measHybrid(this%Greens(iflavor), this%Bath%M(iflavor), this%Impurity%Particles(iflavor), .TRUE.)
2433     CALL GreenHyb_getHybrid(this%Greens(iflavor))
2434     ! Accumule les dernieres mesure de N
2435     this%measN(1,iflavor) = this%measN(1,iflavor) + this%measN(3,iflavor)*this%measN(4,iflavor)
2436     this%measN(2,iflavor) = this%measN(2,iflavor) + this%measN(4,iflavor)
2437     ! Reduction
2438     this%measN(1,iflavor)  = this%measN(1,iflavor) / ( this%measN(2,iflavor) * this%beta )
2439     ! Correction
2440     CALL GreenHyb_setN(this%Greens(iflavor), this%measN(1,iflavor))
2441 !#ifdef CTCtqmc_ANALYSIS
2442     IF ( this%opt_order .GT. 0 ) &
2443       this%measPerturbation(:   ,iflavor) = this%measPerturbation(:,iflavor) &
2444                                     / SUM(this%measPerturbation(:,iflavor))
2445     IF ( this%opt_analysis .EQ. 1 ) THEN
2446       this%measCorrelation (:,1,iflavor) = this%measCorrelation  (:,1,iflavor) &
2447                                     / SUM(this%measCorrelation (:,1,iflavor)) &
2448                                     * this%inv_dt 
2449       this%measCorrelation (:,2,iflavor) = this%measCorrelation  (:,2,iflavor) &
2450                                     / SUM(this%measCorrelation (:,2,iflavor)) &
2451                                     * this%inv_dt 
2452       this%measCorrelation (:,3,iflavor) = this%measCorrelation  (:,3,iflavor) &
2453                                     / SUM(this%measCorrelation (:,3,iflavor)) &
2454                                     * this%inv_dt 
2455     END IF
2456 !#endif
2457     IF ( this%opt_noise .EQ. 1 ) THEN
2458       TabX(1) = DBLE(this%modNoise2)
2459       TabX(2) = DBLE(this%modNoise1)
2460       DO itau = 1, this%samples+1
2461         this%measNoiseG(itau,iflavor,2)%vec = -this%measNoiseG(itau,iflavor,2)%vec*this%inv_dt &  
2462                                            /(this%beta*DBLE(this%modNoise2))
2463         this%measNoiseG(itau,iflavor,1)%vec = -this%measNoiseG(itau,iflavor,1)%vec*this%inv_dt &  
2464                                            /(this%beta*DBLE(this%modNoise1))
2465         n2 = this%measNoiseG(itau,iflavor,2)%tail
2466         TabY(1) = Stat_deviation(this%measNoiseG(itau,iflavor,2)%vec(1:n2))!*SQRT(n2/(n2-1))
2467         n1 = this%measNoiseG(itau,iflavor,1)%tail
2468         TabY(2) = Stat_deviation(this%measNoiseG(itau,iflavor,1)%vec(1:n1))!*SQRT(n1/(n1-1))
2469         CALL Stat_powerReg(TabX,SQRT(2.d0*LOG(2.d0))*TabY,alpha(itau,iflavor),beta(itau,iflavor),r)
2470         ! ecart type -> 60%
2471         ! largeur a mi-hauteur d'une gaussienne -> sqrt(2*ln(2))*sigma
2472       END DO
2473     END IF
2474 
2475     IF ( this%have_MPI .EQV. .TRUE. ) THEN 
2476       buffer(1:sp1, iflavor) = this%Greens(iflavor)%oper(1:sp1)
2477     END IF
2478   END DO
2479   last = sp1
2480 
2481   this%measDE(:,:) = this%measDE(:,:) * DBLE(this%measurements) /(DBLE(this%sweeps)*this%beta)
2482 
2483   n1 = this%measNoise(1)%tail
2484   n2 = this%measNoise(2)%tail
2485 
2486   ! On utilise freqs comme tableau de regroupement
2487   ! Gather de Noise1
2488   IF ( this%have_MPI .EQV. .TRUE. ) THEN
2489     MALLOC(counts,(1:this%size))
2490     MALLOC(displs,(1:this%size))
2491     FREEIF(freqs)
2492     MALLOC(freqs,(1:this%size*n1))
2493     freqs = 0.d0
2494     freqs(n1*this%rank+1:n1*(this%rank+1)) = this%measNoise(1)%vec(1:n1) 
2495     counts(:) = n1
2496     displs(:) = (/ ( iflavor*n1, iflavor=0, this%size-1 ) /)
2497 #ifdef HAVE_MPI
2498     CALL MPI_ALLGATHERV(MPI_IN_PLACE, 0, MPI_DOUBLE_PRECISION, &
2499                         freqs, counts, displs, &
2500                         MPI_DOUBLE_PRECISION, this%MY_COMM, ierr)
2501 #endif
2502     n1 = this%size*n1
2503     CALL Vector_setSize(this%measNoise(1),n1)
2504     this%measNoise(1)%vec(1:n1) = freqs(:)
2505     ! Gather de Noise2
2506     FREE(freqs)
2507     MALLOC(freqs,(1:this%size*n2))
2508     freqs = 0.d0
2509     freqs(n2*this%rank+1:n2*(this%rank+1)) = this%measNoise(2)%vec(1:n2) 
2510     counts(:) = n2
2511     displs(:) = (/ ( iflavor*n2, iflavor=0, this%size-1 ) /)
2512 #ifdef HAVE_MPI
2513     CALL MPI_ALLGATHERV(MPI_IN_PLACE, 0, MPI_DATATYPE_NULL, &
2514                         freqs, counts, displs, &
2515                         MPI_DOUBLE_PRECISION, this%MY_COMM, ierr)
2516 #endif
2517     n2 = this%size*n2
2518     CALL Vector_setSize(this%measNoise(2),n2)
2519     this%measNoise(2)%vec(1:n2) = freqs(:)
2520     FREE(counts)
2521     FREE(displs)
2522     FREE(freqs)
2523   END IF
2524   !n1 = this%measNoise(1)%tail
2525   !n2 = this%measNoise(2)%tail
2526 
2527   ! Transformation des paquets pour que ca fit a CTQMC_SLICE(1|2)
2528   IF ( n1 .GT. CTQMC_SLICE1 ) THEN
2529     itau = n1/CTQMC_SLICE1
2530     MALLOC(freqs,(1:n1/itau))
2531     DO debut=1, n1/itau
2532       freqs(debut)=SUM(this%measNoise(1)%vec((debut-1)*itau+1:itau*debut))
2533     END DO
2534     freqs(:) = freqs(:)/DBLE(itau)
2535     this%modNoise1 = this%modNoise1*itau
2536     n1 = n1/itau
2537     CALL Vector_setSize(this%measNoise(1),n1)
2538     this%measNoise(1)%vec(1:n1) = freqs(:)
2539     FREE(freqs)
2540   END IF
2541   IF ( n2 .GT. CTQMC_SLICE1*CTQMC_SLICE2 ) THEN
2542     itau = n2/(CTQMC_SLICE1*CTQMC_SLICE2)
2543     MALLOC(freqs,(1:n2/itau))
2544     DO debut=1, n2/itau
2545       freqs(debut)=SUM(this%measNoise(2)%vec((debut-1)*itau+1:itau*debut))
2546     END DO
2547     freqs(:) = freqs(:)/DBLE(itau)
2548     this%modNoise2 = this%modNoise2*itau
2549     n2 = n2/itau
2550     CALL Vector_setSize(this%measNoise(2),n2)
2551     this%measNoise(2)%vec(1:n2) = freqs(:)
2552     FREE(freqs)
2553   END IF
2554   ! On peut s'amuser avec nos valeur d'energies
2555   !MALLOC(TabX,(1:20))
2556   !MALLOC(TabY,(1:20))
2557 
2558   TabX(1) = DBLE(this%modNoise2)
2559   TabX(2) = DBLE(this%modNoise1)
2560 
2561   ! Il faut calculer pour chaque modulo 10 ecarts type sur les donnes acquises
2562   this%measNoise(1)%vec(1:n1) = this%measNoise(1)%vec(1:n1)/(this%beta*DBLE(this%modNoise1))*DBLE(this%measurements)
2563   this%measNoise(2)%vec(1:n2) = this%measNoise(2)%vec(1:n2)/(this%beta*DBLE(this%modNoise2))*DBLE(this%measurements)
2564 !  CALL Vector_print(this%measNoise(1),this%rank+70)
2565 !  CALL Vector_print(this%measNoise(2),this%rank+50)
2566 !  DO iflavor=1,10
2567 !    debut = (iflavor-1)*n2/10+1
2568 !    fin   = iflavor*n2/10
2569 !    TabY(iflavor) = Stat_deviation(this%measNoise(2)%vec(debut:fin))
2570 !    debut = (iflavor-1)*n1/10+1
2571 !    fin   = iflavor*n1/10
2572 !    TabY(10+iflavor) = Stat_deviation(this%measNoise(1)%vec(debut:fin))
2573 !  END DO
2574 !!  TabY(1:n) = (this%measNoise(2)%vec(1:n)   &
2575 !!              )
2576 !!             !/(this%beta*DBLE(this%modNoise2))*DBLE(this%measurements) &
2577 !!             !- this%measDE(1,1))
2578 !!  TabY(this%measNoise(2)%tail+1:n+this%measNoise(2)%tail) = (this%measNoise(1)%vec(1:n)   &
2579 !!               )
2580 !!             ! /(this%beta*DBLE(this%modNoise1))*DBLE(this%measurements) &
2581 !!             ! - this%measDE(1,1))
2582 !  IF ( this%rank .EQ. 0 ) THEN
2583 !    DO iflavor=1,20
2584 !      write(45,*) TabX(iflavor), TabY(iflavor)
2585 !    END DO
2586 !  END IF
2587 !
2588 
2589 
2590   TabY(1) = Stat_deviation(this%measNoise(2)%vec(1:n2))!*SQRT(n2/(n2-1))
2591 !!  write(this%rank+10,*) TabX(2)
2592 !!  write(this%rank+40,*) TabX(1)
2593 !!  CALL Vector_print(this%measNoise(1),this%rank+10)
2594 !!  CALL Vector_print(this%measNoise(2),this%rank+40)
2595 !!  CLOSE(this%rank+10)
2596 !!  CLOSE(this%rank+40)
2597   TabY(2) = Stat_deviation(this%measNoise(1)%vec(1:n1))!*SQRT(n1/(n1-1))
2598 !!  ! Ecart carre moyen ~ ecart type mais non biaise. Serait moins precis. Aucun
2599   ! impact sur la pente, juste sur l'ordonnee a l'origine.
2600 
2601   CALL Stat_powerReg(TabX,SQRT(2.d0*LOG(2.d0))*TabY,a,b,r)
2602 !  FREE(TabX)
2603 !  FREE(TabY)
2604   ! ecart type -> 60%
2605   ! largeur a mi-hauteur d'une gaussienne -> sqrt(2*ln(2))*sigma
2606 
2607   !this%measDE(1,1) = SUM(this%measNoise(1)%vec(1:this%measNoise(1)%tail))/(DBLE(this%measNoise(1)%tail*this%modNoise1)*this%beta)
2608   !this%measDE(2:flavors,1:flavors) = this%measDE(2:flavors,1:flavors) /(DBLE(this%sweeps)*this%beta)
2609   CALL ImpurityOperator_getErrorOverlap(this%Impurity,this%measDE)
2610   ! Add the difference between true calculation and quick calculation of the
2611   ! last sweep overlap to measDE(2,2)
2612   !this%measDE = this%measDE * DBLE(this%measurements) 
2613   IF ( this%have_MPI .EQV. .TRUE. ) THEN 
2614     IF ( this%opt_analysis .EQ. 1 ) THEN
2615       buffer(last+1:last+sp1,:) = this%measCorrelation(:,1,:)
2616       last = last + sp1
2617       buffer(last+1:last+sp1,:) = this%measCorrelation(:,2,:)
2618       last = last + sp1
2619       buffer(last+1:last+sp1,:) = this%measCorrelation(:,3,:)
2620       last = last + sp1
2621     END IF
2622     IF ( this%opt_order .GT. 0 ) THEN
2623       buffer(last+1:last+this%opt_order, :) = this%measPerturbation(:,:)
2624       last = last + this%opt_order
2625     END IF
2626     IF ( this%opt_noise .EQ. 1 ) THEN
2627       buffer(last+1:last+this%samples+1,:) = alpha(:,:)
2628       last = last + this%samples + 1
2629       buffer(last+1:last+this%samples+1,:) = beta(:,:)
2630       last = last + this%samples + 1
2631     END IF
2632 !  this%measDE(2,2) = a*EXP(b*LOG(DBLE(this%sweeps*this%size)))
2633     buffer(spall-(flavors+5):spAll-6,:) = this%measDE(:,:)
2634 !    buffer(spAll  ,1) = this%seg_added   
2635 !    buffer(spAll-1,1) = this%seg_removed 
2636 !    buffer(spAll-2,1) = this%seg_sign    
2637 !    buffer(spAll  ,2) = this%anti_added  
2638 !    buffer(spAll-1,2) = this%anti_removed
2639 !    buffer(spAll-2,2) = this%anti_sign   
2640     buffer(spAll  ,1) = this%stats(1)
2641     buffer(spAll-1,1) = this%stats(2)
2642     buffer(spAll-2,1) = this%stats(3)
2643     buffer(spAll  ,2) = this%stats(4)
2644     buffer(spAll-1,2) = this%stats(5)
2645     buffer(spAll-2,2) = this%stats(6)
2646     buffer(spAll-3,1) = this%swap
2647     buffer(spAll-3,2) = DBLE(this%modGlobalMove(2))
2648     buffer(spAll-4,1) = a
2649     buffer(spAll-4,2) = b
2650 !#ifdef CTCtqmc_CHECK
2651     buffer(spAll-5,1) = this%errorImpurity
2652     buffer(spAll-5,2) = this%errorBath 
2653 !#endif
2654 
2655 #ifdef HAVE_MPI
2656     CALL MPI_ALLREDUCE(MPI_IN_PLACE, buffer, spAll*flavors, &
2657                      MPI_DOUBLE_PRECISION, MPI_SUM, this%MY_COMM, ierr)
2658     CALL MPI_ALLREDUCE(MPI_IN_PLACE, this%runTime, 1, MPI_DOUBLE_PRECISION, MPI_MAX, &
2659              this%MY_COMM, ierr)
2660 #endif
2661 
2662   
2663     buffer          = buffer * inv_size
2664     this%measDE(:,:)  = buffer(spall-(flavors+5):spAll-6,:)
2665 !    this%seg_added    = buffer(spAll  ,1)
2666 !    this%seg_removed  = buffer(spAll-1,1)
2667 !    this%seg_sign     = buffer(spAll-2,1)
2668 !    this%anti_added   = buffer(spAll  ,2)
2669 !    this%anti_removed = buffer(spAll-1,2)
2670 !    this%anti_sign    = buffer(spAll-2,2)
2671     this%stats(1)    = buffer(spAll  ,1)
2672     this%stats(2)    = buffer(spAll-1,1)
2673     this%stats(3)    = buffer(spAll-2,1)
2674     this%stats(4)    = buffer(spAll  ,2)
2675     this%stats(5)    = buffer(spAll-1,2)
2676     this%stats(6)    = buffer(spAll-2,2)
2677     this%swap         = buffer(spAll-3,1)
2678     this%modGlobalMove(2) = NINT(buffer(spAll-3,2))
2679     a               = buffer(spAll-4,1) 
2680     b               = buffer(spAll-4,2)
2681 !!#ifdef CTCtqmc_CHECK
2682     this%errorImpurity= buffer(spAll-5,1) 
2683     this%errorBath    = buffer(spAll-5,2)   
2684 !#endif
2685 
2686     DO iflavor = 1, flavors
2687       this%Greens(iflavor)%oper          = buffer(1:sp1          , iflavor)
2688     END DO
2689     last = sp1
2690     IF ( this%opt_analysis .EQ. 1 ) THEN
2691       this%measCorrelation(:,1,:) = buffer(last+1:last+sp1,:) 
2692       last = last + sp1
2693       this%measCorrelation(:,2,:) = buffer(last+1:last+sp1,:) 
2694       last = last + sp1
2695       this%measCorrelation(:,3,:) = buffer(last+1:last+sp1,:) 
2696       last = last + sp1
2697     END IF
2698     IF ( this%opt_order .GT. 0 ) THEN
2699       this%measPerturbation(:,:) = buffer(last+1:last+this%opt_order, :)
2700       last = last + this%opt_order
2701     END IF
2702     IF ( this%opt_noise .EQ. 1 ) THEN
2703       alpha(:,:) = buffer(last+1:last+this%samples+1,:)
2704       last = last + this%samples + 1
2705       beta(:,:) = buffer(last+1:last+this%samples+1,:)
2706       last = last + this%samples + 1
2707     END IF
2708   END IF
2709   DO iflavor = 1, flavors
2710     ! complete DE this
2711     this%measDE(iflavor, iflavor+1:flavors) = this%measDE(iflavor+1:flavors,iflavor)
2712   END DO
2713   FREE(buffer)
2714 
2715   IF ( this%opt_spectra .GE. 1 ) THEN
2716     endDensity = SIZE(this%density,2)
2717     IF ( this%density(1,endDensity) .EQ. -1.d0 ) &
2718       endDensity = endDensity - 1
2719     CALL FFTHyb_init(FFTmrka,endDensity,DBLE(this%thermalization)/DBLE(this%measurements*this%opt_spectra))
2720     ! Not very Beauty 
2721     MALLOC(freqs,(1:FFTmrka%size/2))
2722     DO iflavor = 1, flavors
2723       ! mean value is removed to supress the continue composent 
2724       CALL FFTHyb_setData(FFTmrka,this%density(iflavor,1:endDensity)/this%beta+this%Greens(iflavor)%oper(this%samples+1))
2725       CALL FFTHyb_run(FFTmrka,1)
2726       CALL FFTHyb_getData(FFTmrka,endDensity,this%density(iflavor,:),freqs)
2727     END DO
2728     this%density(flavors+1,:) = -1.d0
2729     this%density(flavors+1,1:FFTmrka%size/2) = freqs
2730     CALL FFTHyb_destroy(FFTmrka)
2731     FREE(freqs)
2732   END IF
2733 
2734   this%a_Noise = a
2735   this%b_Noise = b
2736   IF ( this%opt_noise .EQ. 1 ) THEN
2737     this%abNoiseG(1,:,:) = alpha
2738     this%abNoiseG(2,:,:) = beta
2739   END IF
2740   FREE(alpha)
2741   FREE(beta)
2742 
2743 END SUBROUTINE Ctqmc_getResult

ABINIT/m_Ctqmc/Ctqmc_init [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_init

FUNCTION

  Initialize the type Ctqmc
  Allocate all the non optional variables

COPYRIGHT

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

INPUTS

  this=ctqmc
  ostream=where to write
  istream=where to read the input parameters if so
  bFile=do we read in istream ?
  MY_COMM=mpi communicator for the CTQMC
  iBuffer=input parameters if bFile is false

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

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

ABINIT/m_Ctqmc/Ctqmc_loop [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_loop

FUNCTION

  Definition the main loop of the CT-QMC

COPYRIGHT

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

INPUTS

  this=ctqmc
  itotal=number of sweeps to perform : thermalization or sweeps
  ilatex=unit of file to write movie if so

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1626 SUBROUTINE Ctqmc_loop(this,itotal,ilatex)
1627 
1628 !Arguments ------------------------------------
1629 
1630 !This section has been created automatically by the script Abilint (TD).
1631 !Do not modify the following lines by hand.
1632 #undef ABI_FUNC
1633 #define ABI_FUNC 'Ctqmc_loop'
1634 !End of the abilint section
1635 
1636   TYPE(Ctqmc), INTENT(INOUT)         :: this
1637   INTEGER    , INTENT(IN   )         :: itotal
1638   INTEGER    , INTENT(IN   )         :: ilatex
1639 !Local variables ------------------------------
1640   LOGICAL                            :: updated 
1641   LOGICAL                            :: updated_seg
1642   LOGICAL, DIMENSION(:), ALLOCATABLE :: updated_swap
1643 
1644   INTEGER                            :: flavors
1645   INTEGER                            :: measurements
1646   INTEGER                            :: modNoise1
1647   INTEGER                            :: modNoise2
1648   INTEGER                            :: modGlobalMove
1649   INTEGER                            :: sp1
1650   INTEGER                            :: itau   
1651   INTEGER                            :: ind
1652   INTEGER                            :: endDensity
1653   INTEGER                            :: indDensity
1654   INTEGER                            :: swapUpdate1
1655   INTEGER                            :: swapUpdate2
1656   INTEGER                            :: old_percent
1657   INTEGER                            :: new_percent
1658   INTEGER                            :: ipercent
1659   INTEGER                            :: iflavor
1660   INTEGER                            :: isweep
1661 
1662   DOUBLE PRECISION                   :: cpu_time1
1663   DOUBLE PRECISION                   :: cpu_time2
1664   DOUBLE PRECISION                   :: NRJ_old1
1665   DOUBLE PRECISION                   :: NRJ_old2
1666   DOUBLE PRECISION                   :: NRJ_new
1667   DOUBLE PRECISION                   :: total
1668   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_old1
1669   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_old2
1670   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_new
1671 
1672   CALL CPU_TIME(cpu_time1)
1673 
1674   flavors        = this%flavors
1675   measurements   = this%measurements
1676   modNoise1      = this%modNoise1
1677   modNoise2      = this%modNoise2
1678   modGlobalMove  = this%modGlobalMove(1)
1679   sp1            = this%samples+1
1680 
1681   old_percent    = 0
1682 
1683   MALLOC(updated_swap,(1:flavors))
1684   updated_swap(:) = .FALSE.
1685 
1686   NRJ_old1  = 0.d0
1687   NRJ_old2  = 0.d0
1688   NRJ_new   = 0.d0
1689 
1690   MALLOC(gtmp_new,(1,1))
1691   gtmp_new  = 0.d0
1692   MALLOC(gtmp_old1,(1,1))
1693   gtmp_old1 = 0.d0
1694   MALLOC(gtmp_old2,(1,1))
1695   gtmp_old2 = 0.d0
1696 
1697   endDensity = SIZE(this%density,2)
1698 
1699   IF ( this%opt_noise .GT. 0 ) THEN
1700     FREEIF(gtmp_new)
1701     MALLOC(gtmp_new,(1:sp1,1:flavors))
1702     FREEIF(gtmp_old1)
1703     MALLOC(gtmp_old1,(1:sp1,1:flavors))
1704     FREEIF(gtmp_old2)
1705     MALLOC(gtmp_old2,(1:sp1,1:flavors))
1706   END IF
1707 
1708   IF ( this%rank .EQ. 0 ) THEN
1709     WRITE(this%ostream, '(1x,103A)') &
1710     "|----------------------------------------------------------------------------------------------------|"
1711     WRITE(this%ostream,'(1x,A)', ADVANCE="NO") "|"
1712   END IF
1713 
1714   total = DBLE(itotal)
1715 
1716   indDensity = 1
1717   DO isweep = 1, itotal
1718     DO iflavor = 1, flavors
1719       ImpurityOperator_QuickActivation(this%Impurity,iflavor)
1720       BathOperator_QuickActivation(this%Bath,iflavor)
1721 
1722       CALL Ctqmc_tryAddRemove(this,updated_seg)
1723       updated = updated_seg .OR.  updated_swap(iflavor)
1724       updated_swap(iflavor) = .FALSE.
1725 
1726       CALL GreenHyb_measHybrid(this%Greens(iflavor), this%Bath%M(iflavor), this%Impurity%Particles(iflavor), updated)
1727       CALL Ctqmc_measN        (this, iflavor, updated)
1728       IF ( this%opt_analysis .EQ. 1 ) &
1729         CALL Ctqmc_measCorrelation (this, iflavor)
1730       IF ( this%opt_order .GT. 0 ) &
1731         CALL Ctqmc_measPerturbation(this, iflavor)
1732     END DO
1733 
1734     IF ( MOD(isweep,modGlobalMove) .EQ. 0 ) THEN
1735       CALL Ctqmc_trySwap(this,swapUpdate1, swapUpdate2)
1736       IF ( swapUpdate1 .NE. 0 .AND. swapUpdate2 .NE. 0 ) THEN
1737         updated_swap(swapUpdate1) = .TRUE.
1738         updated_swap(swapUpdate2) = .TRUE.
1739       END IF
1740     END IF
1741     
1742     IF ( MOD(isweep,measurements) .EQ. 0 ) THEN
1743       CALL ImpurityOperator_measDE(this%Impurity,this%measDE)
1744       IF ( this%opt_spectra .GE. 1 .AND. MOD(isweep,measurements*this%opt_spectra) .EQ. 0 ) THEN
1745         this%density(1:flavors,indDensity) = this%measN(3,1:flavors)
1746         indDensity = indDensity+1
1747       END IF
1748     END IF
1749 
1750     IF ( MOD(isweep, modNoise1) .EQ. 0 ) THEN
1751       !modNext = isweep + modNoise2
1752       NRJ_new = (SUM(this%measDE(:,:))-this%measDE(1,1))*0.5d0 ! double occupation, avoid stat with 0 for U=J=0
1753       CALL Vector_pushBack(this%measNoise(1),NRJ_new - NRJ_old1)
1754       NRJ_old1 = NRJ_new
1755 
1756       !! Try to limit accumulation error
1757       CALL ImpurityOperator_cleanOverlaps(this%Impurity)
1758 
1759       IF ( this%opt_noise .EQ. 1 ) THEN
1760         DO iflavor = 1, flavors
1761           DO ind = 1, this%Greens(iflavor)%this%tail
1762             itau = this%Greens(iflavor)%this%listINT(ind)
1763             gtmp_new(itau,iflavor) = this%Greens(iflavor)%oper(itau) & 
1764                         +this%Greens(iflavor)%this%listDBLE(ind)*DBLE(this%Greens(iflavor)%factor)
1765           END DO
1766           DO itau = 1, sp1
1767             CALL Vector_pushBack(this%measNoiseG(itau,iflavor,1), gtmp_new(itau,iflavor) - gtmp_old1(itau,iflavor))
1768             gtmp_old1(itau,iflavor) = gtmp_new(itau,iflavor)
1769           END DO
1770         END DO
1771       END IF
1772     END IF
1773 
1774     IF ( MOD(isweep,modNoise2) .EQ. 0 ) THEN
1775       NRJ_new = (SUM(this%measDE(:,:))-this%measDE(1,1))*0.5d0 ! double occupation, avoid stat with 0 for U=J=0
1776       CALL Vector_pushBack(this%measNoise(2),NRJ_new - NRJ_old2)
1777       NRJ_old2 = NRJ_new
1778       IF ( this%opt_noise .EQ. 1 ) THEN
1779         DO iflavor = 1, flavors
1780           DO ind = 1, this%Greens(iflavor)%this%tail
1781             itau = this%Greens(iflavor)%this%listINT(ind)
1782             gtmp_new(itau,iflavor) = this%Greens(iflavor)%oper(itau) & 
1783                         +this%Greens(iflavor)%this%listDBLE(ind)*this%Greens(iflavor)%factor
1784           END DO
1785           DO itau = 1, sp1
1786             CALL Vector_pushBack(this%measNoiseG(itau,iflavor,2), gtmp_new(itau,iflavor) - gtmp_old2(itau,iflavor))
1787             gtmp_old2(itau,iflavor) = gtmp_new(itau,iflavor)
1788           END DO
1789         END DO 
1790       END IF
1791 
1792       IF ( this%rank .EQ. 0 ) THEN 
1793         new_percent = CEILING(DBLE(isweep)*100.d0/DBLE(itotal))
1794         DO ipercent = old_percent+1, new_percent 
1795           WRITE(this%ostream,'(A)',ADVANCE="NO") "-"
1796         END DO
1797         old_percent = new_percent
1798       END IF
1799     END IF
1800 
1801     IF ( this%opt_movie .EQ. 1 ) THEN
1802       WRITE(ilatex,'(A11,I9)') "%iteration ", isweep
1803       CALL ImpurityOperator_printLatex(this%Impurity,ilatex,isweep)
1804     END IF
1805 
1806   END DO
1807 
1808   IF ( this%rank .EQ. 0 ) THEN
1809     DO ipercent = old_percent+1, 100
1810       WRITE(this%ostream,'(A)',ADVANCE="NO") "-"
1811     END DO
1812     WRITE(this%ostream,'(A)') "|"
1813   END IF
1814  
1815   FREE(gtmp_new)
1816   FREE(gtmp_old1)
1817   FREE(gtmp_old2)
1818   FREE(updated_swap)
1819 
1820   IF ( this%opt_spectra .GE. 1 .AND. itotal .EQ. this%sweeps ) THEN
1821     IF ( endDensity .NE. indDensity-1 ) THEN
1822       this%density(:,endDensity) = -1.d0
1823     END IF
1824   END IF
1825 
1826   CALL CPU_TIME(cpu_time2)
1827 
1828   this%runTime = (cpu_time2 - cpu_time1)*1.05d0 ! facteur arbitraire de correction
1829 END SUBROUTINE Ctqmc_loop

ABINIT/m_Ctqmc/Ctqmc_measCorrelation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_measCorrelation

FUNCTION

  measure all correlations in times for a flavor

COPYRIGHT

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

INPUTS

  this=ctqmc
  iflavor=the flavor to measure

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2179 SUBROUTINE Ctqmc_measCorrelation(this, iflavor)
2180 
2181 !Arguments ------------------------------------
2182 
2183 !This section has been created automatically by the script Abilint (TD).
2184 !Do not modify the following lines by hand.
2185 #undef ABI_FUNC
2186 #define ABI_FUNC 'Ctqmc_measCorrelation'
2187 !End of the abilint section
2188 
2189   TYPE(Ctqmc)             , INTENT(INOUT)       :: this
2190   !TYPE(ImpurityOperator), INTENT(IN   )       :: impurity
2191   INTEGER               , INTENT(IN   )       :: iflavor
2192 !Local variables ------------------------------
2193   INTEGER                                     :: iCdag
2194   INTEGER                                     :: iCdagBeta
2195   INTEGER                                     :: iC
2196   INTEGER                                     :: index
2197   INTEGER                                     :: size
2198   DOUBLE PRECISION                            :: tC
2199   DOUBLE PRECISION                            :: tCdag
2200   !DOUBLE PRECISION                            :: time
2201   DOUBLE PRECISION                            :: inv_dt
2202   DOUBLE PRECISION                            :: beta
2203 
2204   IF ( .NOT. this%set ) &
2205     CALL ERROR("Ctqmc_measCorrelation : QMC not set                 ")
2206 
2207   size = this%impurity%particles(this%impurity%activeFlavor)%tail
2208   beta = this%beta
2209 
2210   IF ( size .EQ. 0 ) RETURN
2211   
2212   inv_dt = this%inv_dt
2213 
2214   DO iCdag = 1, size ! first segments
2215     tCdag  = this%impurity%particles(this%impurity%activeFlavor)%list(iCdag,Cdag_)
2216     tC     = this%impurity%particles(this%impurity%activeFlavor)%list(iCdag,C_   )
2217     index = INT( ( (tC - tCdag)  * inv_dt ) + .5d0 ) + 1
2218     this%measCorrelation(index,1,iflavor) = this%measCorrelation(index,1,iflavor) + 1.d0
2219     MODCYCLE(iCdag+1,size,iCdagBeta)
2220     index = INT( ( ( &
2221                     this%impurity%particles(this%impurity%activeFlavor)%list(iCdagBeta,Cdag_) - tC &
2222                     + AINT(DBLE(iCdag)/DBLE(size))*beta &
2223                    )  * inv_dt ) + .5d0 ) + 1
2224     IF ( index .LT. 1 .OR. index .GT. this%samples+1 ) THEN
2225       CALL WARN("Ctqmc_measCorrelation : bad index line 1095         ")
2226     ELSE
2227       this%measCorrelation(index,2,iflavor) = this%measCorrelation(index,2,iflavor) + 1.d0
2228     END IF
2229 !    DO iC = 1, size
2230 !      tC = impurity%particles(impurity%activeFlavor)%list(C_,iC)
2231 !      time = tC - tCdag
2232 !      IF ( time .LT. 0.d0 ) time = time + beta
2233 !      index = INT( ( time * inv_dt ) + .5d0 ) + 1
2234 !      this%measCorrelation(index,3,iflavor) = this%measCorrelation(index,3,iflavor) + 1.d0
2235 !    END DO
2236     DO iC = 1, size!  this%Greens(iflavor)%index_old%tail 
2237         this%measCorrelation(this%Greens(iflavor)%this%listINT(iC+(iCdag-1)*size),3,iflavor) = &
2238         this%measCorrelation(this%Greens(iflavor)%this%listINT(iC+(iCdag-1)*size),3,iflavor) + 1.d0
2239     END DO
2240   END DO
2241 
2242 END SUBROUTINE Ctqmc_measCorrelation

ABINIT/m_Ctqmc/Ctqmc_measN [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_measN

FUNCTION

  measure the number of electron

COPYRIGHT

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

INPUTS

  this=ctqmc
  iflavor=which flavor to measure
  updated=something has changed since last time

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2117 SUBROUTINE Ctqmc_measN(this, iflavor, updated)
2118 
2119 !Arguments ------------------------------------
2120 
2121 !This section has been created automatically by the script Abilint (TD).
2122 !Do not modify the following lines by hand.
2123 #undef ABI_FUNC
2124 #define ABI_FUNC 'Ctqmc_measN'
2125 !End of the abilint section
2126 
2127   TYPE(Ctqmc)             , INTENT(INOUT)     :: this
2128   !TYPE(ImpurityOperator), INTENT(IN   )     :: impurity
2129   INTEGER               , INTENT(IN   )     :: iflavor
2130   LOGICAL               , INTENT(IN   )     :: updated
2131 
2132 !  IF ( .NOT. this%set ) &
2133 !    CALL ERROR("Ctqmc_measN : QMC not set                           ")
2134 
2135   
2136   IF ( updated .EQV. .TRUE. ) THEN
2137     this%measN(1,iflavor) = this%measN(1,iflavor) + this%measN(3,iflavor)*this%measN(4,iflavor)
2138     this%measN(2,iflavor) = this%measN(2,iflavor) + this%measN(4,iflavor)
2139     this%measN(3,iflavor) = ImpurityOperator_measN(this%impurity)
2140     this%measN(4,iflavor) = 1.d0
2141   ELSE
2142     this%measN(4,iflavor) = this%measN(4,iflavor) + 1.d0
2143   END IF
2144 END SUBROUTINE Ctqmc_measN

ABINIT/m_Ctqmc/Ctqmc_measPerturbation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_measPerturbation

FUNCTION

  measure perturbation order

COPYRIGHT

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

INPUTS

  this=ctqmc
  iflavor=the flavor to measure

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2276 SUBROUTINE Ctqmc_measPerturbation(this, iflavor)
2277 
2278 !Arguments ------------------------------------
2279 
2280 !This section has been created automatically by the script Abilint (TD).
2281 !Do not modify the following lines by hand.
2282 #undef ABI_FUNC
2283 #define ABI_FUNC 'Ctqmc_measPerturbation'
2284 !End of the abilint section
2285 
2286   TYPE(Ctqmc)             , INTENT(INOUT)     :: this
2287   !TYPE(ImpurityOperator), INTENT(IN   )     :: impurity
2288   INTEGER               , INTENT(IN   )     :: iflavor
2289 !Local variables ------------------------------
2290   INTEGER                                   :: index
2291 
2292   IF ( .NOT. this%set ) &
2293     CALL ERROR("Ctqmc_measiPerturbation : QMC not set               ")
2294 
2295   index = this%impurity%particles(this%impurity%activeFlavor)%tail + 1
2296   IF ( index .LE. this%opt_order ) &
2297     this%measPerturbation(index,iflavor) = this%measPerturbation(index,iflavor) + 1.d0
2298 
2299 END SUBROUTINE Ctqmc_measPerturbation

ABINIT/m_Ctqmc/Ctqmc_printAll [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_printAll

FUNCTION

  print different functions computed during the simulation

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3065 SUBROUTINE Ctqmc_printAll(this)
3066 
3067 !Arguments ------------------------------------
3068 
3069 !This section has been created automatically by the script Abilint (TD).
3070 !Do not modify the following lines by hand.
3071 #undef ABI_FUNC
3072 #define ABI_FUNC 'Ctqmc_printAll'
3073 !End of the abilint section
3074 
3075   TYPE(Ctqmc), INTENT(INOUT) :: this
3076 
3077   IF ( .NOT. this%done ) &
3078     CALL WARNALL("Ctqmc_printAll : Simulation not run                 ")
3079 
3080   CALL Ctqmc_printQMC(this)
3081 
3082   CALL Ctqmc_printGreen(this)
3083 
3084   CALL Ctqmc_printD(this)
3085 
3086 !  CALL Ctqmc_printE(this)
3087 
3088 !#ifdef CTCtqmc_ANALYSIS
3089   CALL Ctqmc_printPerturbation(this)
3090 
3091   CALL Ctqmc_printCorrelation(this)
3092 !#endif
3093 
3094   CALL Ctqmc_printSpectra(this)
3095 
3096 END SUBROUTINE Ctqmc_printAll

ABINIT/m_Ctqmc/Ctqmc_printCorrelation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_printCorrelation

FUNCTION

  print correlation fonctions

COPYRIGHT

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

INPUTS

  this=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3551 SUBROUTINE Ctqmc_printCorrelation(this, oFileIn)
3552 
3553 !Arguments ------------------------------------
3554 
3555 !This section has been created automatically by the script Abilint (TD).
3556 !Do not modify the following lines by hand.
3557 #undef ABI_FUNC
3558 #define ABI_FUNC 'Ctqmc_printCorrelation'
3559 !End of the abilint section
3560 
3561   TYPE(Ctqmc)          , INTENT(IN)             :: this
3562   INTEGER  , OPTIONAL, INTENT(IN)             :: oFileIn
3563 !Local variables ------------------------------
3564   INTEGER                                     :: oFile
3565   INTEGER                                     :: itime
3566   INTEGER                                     :: sp1
3567   INTEGER                                     :: iflavor
3568   INTEGER                                     :: i
3569   INTEGER                                     :: flavors
3570   CHARACTER(LEN=2)                            :: a
3571   CHARACTER(LEN=50)                           :: string
3572   DOUBLE PRECISION                            :: dt
3573 
3574   !IF ( this%rank .NE. MOD(5,this%size)) RETURN
3575   IF ( this%rank .NE. MOD(this%size+5,this%size)) RETURN
3576   IF ( this%opt_analysis .NE. 1 ) RETURN
3577 
3578   oFile = 44
3579   IF ( PRESENT(oFileIn) ) THEN
3580     oFile = oFileIn
3581   ELSE
3582     OPEN(UNIT=oFile, FILE="Correlation.dat")
3583   END IF
3584 
3585   sp1         =  this%samples
3586   dt          =  this%beta / sp1
3587   sp1         =  sp1 + 1
3588   flavors     =  this%flavors
3589 
3590   i = 3*flavors + 1
3591   WRITE(a,'(I2)') i
3592   WRITE(oFile,*) "# time  (/ (segement, antiseg, correl), i=1, flavor/)"
3593   string = '(1x,'//TRIM(ADJUSTL(a))//'F19.15)'
3594   DO itime = 1, sp1
3595     WRITE(oFile,string) DBLE(itime-1)*dt, &
3596                    (/ ( &
3597                    (/ ( this%measCorrelation(itime, i, iflavor), i=1,3) /) &
3598                    , iflavor=1, flavors) /)
3599   END DO
3600 
3601   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
3602 
3603 END SUBROUTINE Ctqmc_printCorrelation

ABINIT/m_Ctqmc/Ctqmc_printD [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_printD

FUNCTION

  print individual double occupancy

COPYRIGHT

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

INPUTS

  this=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3336 SUBROUTINE Ctqmc_printD(this,oFileIn)
3337 
3338 !Arguments ------------------------------------
3339 
3340 !This section has been created automatically by the script Abilint (TD).
3341 !Do not modify the following lines by hand.
3342 #undef ABI_FUNC
3343 #define ABI_FUNC 'Ctqmc_printD'
3344 !End of the abilint section
3345 
3346   TYPE(Ctqmc)          , INTENT(IN)    :: this
3347   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
3348 !Local variables ------------------------------
3349   INTEGER                            :: oFile
3350   INTEGER                            :: iflavor1
3351   INTEGER                            :: iflavor2
3352 
3353   !IF ( this%rank .NE. MOD(2,this%size)) RETURN
3354   IF ( this%rank .NE. MOD(this%size+2,this%size)) RETURN
3355 
3356   oFile = 41
3357   IF ( PRESENT(oFileIn) ) THEN
3358     oFile = oFileIn
3359   ELSE
3360     OPEN(UNIT=oFile, FILE="D.dat")
3361   END IF
3362 
3363   DO iflavor1 = 1, this%flavors
3364     DO iflavor2 = iflavor1+1, this%flavors
3365       WRITE(oFile,'(1x,A8,I4,A1,I4,A3,ES21.14)') "Orbitals", iflavor1, "-", iflavor2, " : ", this%measDE(iflavor2,iflavor1)
3366     END DO
3367   END DO
3368 
3369   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
3370 
3371 END SUBROUTINE Ctqmc_printD

ABINIT/m_Ctqmc/Ctqmc_printE [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_printE

FUNCTION

  print energy and noise 

COPYRIGHT

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

INPUTS

  this=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3405 SUBROUTINE Ctqmc_printE(this,oFileIn)
3406 
3407 !Arguments ------------------------------------
3408 
3409 !This section has been created automatically by the script Abilint (TD).
3410 !Do not modify the following lines by hand.
3411 #undef ABI_FUNC
3412 #define ABI_FUNC 'Ctqmc_printE'
3413 !End of the abilint section
3414 
3415   TYPE(Ctqmc)          , INTENT(IN)    :: this
3416   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
3417 !Local variables ------------------------------
3418   INTEGER                            :: oFile
3419   DOUBLE PRECISION                   :: E
3420   DOUBLE PRECISION                   :: Noise
3421 
3422   !IF ( this%rank .NE. MOD(3,this%size)) RETURN
3423   IF ( this%rank .NE. MOD(this%size+3,this%size)) RETURN
3424 
3425   oFile = 42
3426   IF ( PRESENT(oFileIn) ) THEN
3427     oFile = oFileIn
3428   ELSE
3429     OPEN(UNIT=oFile, FILE="BetaENoise.dat")
3430   END IF
3431 
3432   CALL Ctqmc_getE(this,E,Noise)
3433 
3434   WRITE(oFile,'(1x,F5.2,A2,ES21.14,A2,ES21.14)') this%beta, "  ", E, "  ",  Noise
3435 
3436   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
3437 
3438 END SUBROUTINE Ctqmc_printE

ABINIT/m_Ctqmc/Ctqmc_printGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_printGreen

FUNCTION

  print green functions

COPYRIGHT

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

INPUTS

  this=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3244 SUBROUTINE Ctqmc_printGreen(this, oFileIn)
3245 
3246 !Arguments ------------------------------------
3247 
3248 !This section has been created automatically by the script Abilint (TD).
3249 !Do not modify the following lines by hand.
3250 #undef ABI_FUNC
3251 #define ABI_FUNC 'Ctqmc_printGreen'
3252 !End of the abilint section
3253 
3254   TYPE(Ctqmc)        , INTENT(IN)    :: this
3255   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
3256 !Local variables ------------------------------
3257   INTEGER                            :: oFile
3258   INTEGER                            :: itime
3259   INTEGER                            :: sp1
3260   INTEGER                            :: iflavor
3261   INTEGER                            :: flavors
3262   CHARACTER(LEN=4)                   :: cflavors
3263   CHARACTER(LEN=50)                  :: string
3264   DOUBLE PRECISION                   :: dt
3265   DOUBLE PRECISION                   :: sweeps
3266 
3267   !IF ( this%rank .NE. MOD(1,this%size)) RETURN
3268   IF ( this%rank .NE. MOD(this%size+1,this%size)) RETURN
3269 
3270   oFile = 40
3271   IF ( PRESENT(oFileIn) ) THEN
3272     oFile = oFileIn
3273   ELSE
3274     OPEN(UNIT=oFile, FILE="Gtau.dat")
3275   END IF
3276 
3277   sp1     =  this%samples
3278   dt      =  this%beta / DBLE(sp1)
3279   sp1     =  sp1 + 1
3280   flavors =  this%flavors
3281   sweeps = DBLE(this%sweeps)*DBLE(this%size)
3282 
3283   IF ( this%opt_noise .EQ. 1) THEN
3284     WRITE(cflavors,'(I4)') 2*flavors+1
3285     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
3286     DO itime = 1, sp1
3287       WRITE(oFile,string) DBLE(itime-1)*dt, &
3288       (/ (this%Greens(iflavor)%oper(itime), iflavor=1, flavors) /), &
3289       (/ (this%abNoiseG(1,itime,iflavor)*(sweeps)**this%abNoiseG(2,itime,iflavor), iflavor=1, flavors) /)
3290     END DO
3291   ELSE
3292     WRITE(cflavors,'(I4)') flavors+1
3293     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
3294     DO itime = 1, sp1
3295       WRITE(oFile,string) DBLE(itime-1)*dt, &
3296       (/ (this%Greens(iflavor)%oper(itime), iflavor=1, flavors) /)
3297     END DO
3298   END IF
3299 
3300   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
3301 
3302 END SUBROUTINE Ctqmc_printGreen

ABINIT/m_Ctqmc/Ctqmc_printPerturbation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_printPerturbation

FUNCTION

  print perturbation order

COPYRIGHT

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

INPUTS

  this=ctqmc
  oFileIn=file stream

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3474 SUBROUTINE Ctqmc_printPerturbation(this, oFileIn)
3475 
3476 !Arguments ------------------------------------
3477 
3478 !This section has been created automatically by the script Abilint (TD).
3479 !Do not modify the following lines by hand.
3480 #undef ABI_FUNC
3481 #define ABI_FUNC 'Ctqmc_printPerturbation'
3482 !End of the abilint section
3483 
3484   TYPE(Ctqmc)          , INTENT(IN)           :: this
3485   INTEGER  , OPTIONAL,  INTENT(IN)          :: oFileIn
3486 !Local variables-------------------------------
3487   INTEGER                                   :: oFile
3488   INTEGER                                   :: iorder
3489   INTEGER                                   :: order
3490   INTEGER                                   :: iflavor
3491   INTEGER                                   :: flavors
3492   CHARACTER(LEN=2)                          :: a
3493   CHARACTER(LEN=50)                         :: string
3494 
3495   !IF ( this%rank .NE. MOD(4,this%size)) RETURN
3496   IF ( this%rank .NE. MOD(this%size+4,this%size)) RETURN
3497   IF ( this%opt_order .LE. 0 ) RETURN
3498 
3499   oFile = 43
3500   IF ( PRESENT(oFileIn) ) THEN
3501     oFile = oFileIn
3502   ELSE
3503     OPEN(UNIT=oFile, FILE="Perturbation.dat")
3504   END IF
3505     
3506   order        =  this%opt_order
3507   flavors      =  this%flavors
3508 
3509   WRITE(a,'(I2)') flavors
3510   string = '(I5,'//TRIM(ADJUSTL(a))//'F19.15)'
3511   DO iorder = 1, order
3512     WRITE(oFile,string) iorder-1, &
3513                 (/ (this%measPerturbation(iorder, iflavor), iflavor=1, flavors) /)
3514   END DO
3515 
3516   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
3517 END SUBROUTINE Ctqmc_printPerturbation

ABINIT/m_Ctqmc/Ctqmc_printQMC [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_printQMC

FUNCTION

  print ctqmc statistics

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3129 SUBROUTINE Ctqmc_printQMC(this)
3130 
3131 !Arguments ------------------------------------
3132 
3133 !This section has been created automatically by the script Abilint (TD).
3134 !Do not modify the following lines by hand.
3135 #undef ABI_FUNC
3136 #define ABI_FUNC 'Ctqmc_printQMC'
3137 !End of the abilint section
3138 
3139   TYPE(Ctqmc), INTENT(INOUT) :: this
3140 !Local variables ------------------------------
3141   INTEGER                  :: ostream
3142   INTEGER                  :: iflavor
3143   DOUBLE PRECISION         :: sweeps
3144   DOUBLE PRECISION         :: invSweeps
3145   CHARACTER(LEN=2)         :: a
3146   CHARACTER(LEN=15)        :: string
3147 
3148   !IF ( this%rank .NE. 0) RETURN
3149   IF ( this%rank .NE. MOD(this%size,this%size)) RETURN
3150 
3151   ostream   = this%ostream
3152   sweeps    = DBLE(this%sweeps)
3153   invSweeps = 1.d0/sweeps
3154 
3155   WRITE(ostream,'(1x,F13.0,A11,F10.2,A12,I5,A5)') sweeps*DBLE(this%size), " sweeps in ", this%runTime, &
3156                  " seconds on ", this%size, " CPUs"
3157   WRITE(ostream,'(A28,F6.2)') "Segments added        [%] : ", this%stats(CTQMC_SEGME+CTQMC_ADDED)*invSweeps*100.d0
3158   WRITE(ostream,'(A28,F6.2)') "Segments removed      [%] : ", this%stats(CTQMC_SEGME+CTQMC_REMOV)*invSweeps*100.d0
3159   WRITE(ostream,'(A28,F6.2)') "Segments sign         [%] : ", this%stats(CTQMC_SEGME+CTQMC_DETSI)*invSweeps*100.d0
3160   WRITE(ostream,'(A28,F6.2)') "Anti-segments added   [%] : ", this%stats(CTQMC_ANTIS+CTQMC_ADDED)*invSweeps*100.d0
3161   WRITE(ostream,'(A28,F6.2)') "Anti-segments removed [%] : ", this%stats(CTQMC_ANTIS+CTQMC_REMOV)*invSweeps*100.d0
3162   WRITE(ostream,'(A28,F6.2)') "Anti-segments sign    [%] : ", this%stats(CTQMC_ANTIS+CTQMC_DETSI)*invSweeps*100.d0
3163   IF ( this%modGlobalMove(1) .LT. this%sweeps + 1 ) THEN
3164     WRITE(ostream,'(A28,F6.2)') "Global Move           [%] : ", this%swap         *invSweeps*100.d0*this%modGlobalMove(1)
3165     WRITE(ostream,'(A28,F6.2)') "Global Move Reduced   [%] : ", this%swap         / DBLE(this%modGlobalMove(2))*100.d0
3166   END IF
3167 !#ifdef CTCtqmc_CHECK
3168   IF ( this%opt_check .EQ. 1 .OR. this%opt_check .EQ. 3 ) &
3169     WRITE(ostream,'(A28,E22.14)') "Impurity test         [%] : ", this%errorImpurity*100.d0
3170   IF ( this%opt_check .GE. 2 ) &
3171       WRITE(ostream,'(A28,E22.14)') "Bath     test         [%] : ", this%errorBath    *100.d0
3172 !#endif
3173   WRITE(ostream,'(A28,ES22.14,A5,ES21.14)') "<Epot>                [U] : ", this%measDE(1,1), " +/- ",&
3174 !#ifdef HAVE_MPI
3175          SUM(this%Impurity%mat_U)/(this%flavors*(this%flavors-1)) * this%a_Noise*(sweeps*DBLE(this%size))**this%b_Noise
3176 !#else
3177 !                                                              this%a_Noise*(sweeps)**this%b_Noise
3178 !#endif
3179   WRITE(ostream,'(A28,F8.4,A3,F7.4)') "Noise                [/U] : ", this%a_Noise, " x^", this%b_Noise
3180   WRITE(ostream,'(A28,E10.2)')  "Niquist puls.     [/beta] : ", ACOS(-1.d0)*this%inv_dt
3181   WRITE(ostream,'(A28,E22.14)') "Max Acc. Epot Error   [U] : ", this%measDE(2,2)/(this%beta*this%modNoise1*2.d0)*sweeps
3182   
3183   !WRITE(ostream,'(A28,F7.4,A3,F7.4,A4,E20.14)') "Noise            [G(tau)] : ", this%a_Noise(2), "x^", this%b_Noise(2), " -> ", &
3184                                                               !this%a_Noise(2)*(sweeps*DBLE(this%size))**this%b_Noise(2)
3185   IF ( this%opt_order .GT. 0 ) THEN 
3186     WRITE(a,'(I2)') this%flavors
3187     string = '(A28,'//TRIM(ADJUSTL(a))//'(1x,I3))'
3188     WRITE(ostream,string) "Perturbation orders       : ", &
3189       (/ (MAXLOC(this%measPerturbation(:, iflavor))-1, iflavor=1, this%flavors) /)
3190   END IF
3191   !CALL FLUSH(this%ostream)
3192   IF ( ABS(((this%stats(CTQMC_SEGME+CTQMC_ADDED) *invSweeps*100.d0) / &
3193             (this%stats(CTQMC_SEGME+CTQMC_REMOV) *invSweeps*100.d0) - 1.d0)) .GE. 0.02d0 &
3194    .OR. ABS(((this%stats(CTQMC_ANTIS+CTQMC_ADDED)*invSweeps*100.d0) / &
3195              (this%stats(CTQMC_ANTIS+CTQMC_REMOV)*invSweeps*100.d0) - 1.d0)) .GE. 0.02d0 ) &
3196     THEN 
3197     CALL WARNALL("Ctqmc_printQMC : bad statistic according to moves. Increase sweeps")
3198   END IF
3199   ! Check sign problem for diagonal hybridization.
3200   IF ( (this%stats(CTQMC_SEGME+CTQMC_DETSI) + this%stats(CTQMC_ANTIS+CTQMC_DETSI)) .GT. 1.d-10 ) THEN
3201     CALL WARNALL("Ctqmc_printQMC : at least one negative sign occured. There might be a bug in the CT-QMC")
3202   END IF
3203 
3204   IF ( ABS(this%b_Noise+0.5)/0.5d0 .GE. 0.05d0 ) &
3205     CALL WARNALL("Ctqmc_printQMC : bad statistic according to Noise. Increase sweeps")
3206 !  IF ( ISNAN(this%a_Noise) .OR. ISNAN(this%a_Noise) ) &
3207 !    CALL WARNALL("Ctqmc_printQMC : NaN appeared. Increase sweeps    ")
3208 
3209 
3210 END SUBROUTINE Ctqmc_printQMC

ABINIT/m_Ctqmc/Ctqmc_printSpectra [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_printSpectra

FUNCTION

  print fourier transform of time evolution of number of electrons

COPYRIGHT

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

INPUTS

  this=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3638 SUBROUTINE Ctqmc_printSpectra(this, oFileIn)
3639 
3640 !Arguments ------------------------------------
3641 
3642 !This section has been created automatically by the script Abilint (TD).
3643 !Do not modify the following lines by hand.
3644 #undef ABI_FUNC
3645 #define ABI_FUNC 'Ctqmc_printSpectra'
3646 !End of the abilint section
3647 
3648   TYPE(Ctqmc)          , INTENT(IN)             :: this
3649   INTEGER  , OPTIONAL, INTENT(IN)             :: oFileIn
3650 !Local variables ------------------------------
3651   INTEGER                                     :: oFile
3652   INTEGER                                     :: flavors
3653   INTEGER                                     :: indDensity
3654   INTEGER                                     :: endDensity
3655   CHARACTER(LEN=4)                            :: a
3656   CHARACTER(LEN=16)                           :: formatSpectra
3657 
3658   !IF ( this%rank .NE. MOD(6,this%size)) RETURN
3659   IF ( this%opt_spectra .LT. 1 ) RETURN
3660 
3661   oFile = 45+this%rank
3662   a ="0000"
3663   WRITE(a,'(I4)') this%rank
3664   IF ( PRESENT(oFileIn) ) THEN
3665     oFile = oFileIn
3666   ELSE
3667     OPEN(UNIT=oFile, FILE="Markov_"//TRIM(ADJUSTL(a))//".dat")
3668   END IF
3669 
3670   flavors     =  this%flavors
3671   WRITE(a,'(I4)') flavors+1
3672   formatSpectra ='(1x,'//TRIM(ADJUSTL(a))//'ES22.14)'
3673   WRITE(oFile,*) "# freq[/hermalization] FFT"
3674 
3675   endDensity = SIZE(this%density,2)
3676   DO WHILE ( this%density(flavors+1,endDensity) .EQ. -1 )
3677     endDensity = endDensity -1
3678   END DO
3679 
3680   DO indDensity = 1, endDensity
3681     WRITE(oFile,formatSpectra) this%density(flavors+1,indDensity), this%density(1:flavors,indDensity)
3682   END DO
3683 
3684   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
3685 
3686 END SUBROUTINE Ctqmc_printSpectra

ABINIT/m_Ctqmc/Ctqmc_reset [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_reset

FUNCTION

  reset a ctqmc simulation

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1136 SUBROUTINE Ctqmc_reset(this)
1137 
1138 !Arguments ------------------------------------
1139 
1140 !This section has been created automatically by the script Abilint (TD).
1141 !Do not modify the following lines by hand.
1142 #undef ABI_FUNC
1143 #define ABI_FUNC 'Ctqmc_reset'
1144 !End of the abilint section
1145 
1146   TYPE(Ctqmc), INTENT(INOUT) :: this
1147 !Local variables ------------------------------
1148   INTEGER                  :: iflavor
1149   DOUBLE PRECISION         :: sweeps
1150 
1151   DO iflavor = 1, this%flavors
1152     CALL GreenHyb_reset(this%Greens(iflavor))
1153   END DO
1154   CALL Ctqmc_clear(this)
1155   CALL ImpurityOperator_reset(this%Impurity)
1156   CALL BathOperator_reset    (this%Bath)
1157   this%measN(3,:) = 0.d0
1158   !complete restart -> measN=0
1159   this%done = .FALSE.
1160   this%set  = .FALSE.
1161   this%inF  = .FALSE.
1162   this%opt_movie = 0
1163   this%opt_analysis = 0
1164   this%opt_order = 0
1165   this%opt_check = 0
1166   this%opt_noise = 0
1167   this%opt_spectra = 0
1168   this%opt_levels = 0
1169   sweeps = DBLE(this%sweeps)*DBLE(this%size)
1170   CALL Ctqmc_setSweeps(this, sweeps)
1171 !#ifdef HAVE_MPI
1172 !  CALL MPI_BARRIER(this%MY_COMM,iflavor)
1173 !  IF ( this%rank .EQ. 0 ) &
1174 !#endif
1175 !  WRITE(this%ostream,'(A9)') "QMC reset"
1176 !  CALL FLUSH(this%ostream)
1177 END SUBROUTINE Ctqmc_reset

ABINIT/m_Ctqmc/Ctqmc_run [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_run

FUNCTION

  set all options and run a simulation

COPYRIGHT

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

INPUTS

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1457 SUBROUTINE Ctqmc_run(this,opt_order,opt_movie,opt_analysis,opt_check,opt_noise,opt_spectra,opt_gMove)
1458 
1459 
1460 !This section has been created automatically by the script Abilint (TD).
1461 !Do not modify the following lines by hand.
1462 #undef ABI_FUNC
1463 #define ABI_FUNC 'Ctqmc_run'
1464 !End of the abilint section
1465 
1466 
1467 #ifdef HAVE_MPI1
1468 include 'mpif.h'
1469 #endif
1470 !Arguments ------------------------------------
1471   TYPE(Ctqmc), INTENT(INOUT)           :: this
1472   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_order
1473   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_movie
1474   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_analysis
1475   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_check
1476   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_noise
1477   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_spectra
1478   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_gMove
1479 !Local variables ------------------------------
1480 #ifdef HAVE_MPI
1481   INTEGER                            :: ierr
1482 #endif
1483 !#ifdef CTCtqmc_MOVIE
1484   INTEGER                            :: ilatex
1485   CHARACTER(LEN=4)                   :: Cchar
1486 !#endif
1487   DOUBLE PRECISION                   :: estimatedTime
1488 
1489   IF ( .NOT. this%set  ) &
1490     CALL ERROR("Ctqmc_run : QMC not set up                          ")
1491   IF ( .NOT. this%setU ) &
1492     CALL ERROR("Ctqmc_run : QMC does not have a U this            ")
1493 
1494 
1495 ! OPTIONS of the run
1496   IF ( PRESENT( opt_check ) ) THEN
1497     this%opt_check = opt_check
1498     CALL ImpurityOperator_doCheck(this%Impurity,opt_check)
1499     CALL BathOperator_doCheck(this%Bath,opt_check)
1500   END IF
1501   IF ( PRESENT( opt_movie ) ) &
1502     this%opt_movie = opt_movie
1503   IF ( PRESENT( opt_analysis ) ) &
1504     this%opt_analysis = opt_analysis
1505   IF ( PRESENT ( opt_order ) ) &
1506     this%opt_order = opt_order 
1507   IF ( PRESENT ( opt_noise ) ) THEN
1508     this%opt_noise = opt_noise 
1509   END IF
1510   IF ( PRESENT ( opt_spectra ) ) &
1511     this%opt_spectra = opt_spectra
1512 
1513   this%modGlobalMove(1) = this%sweeps+1 ! No Global Move
1514   this%modGlobalMove(2) = 0
1515   IF ( PRESENT ( opt_gMove ) ) THEN
1516     IF ( opt_gMove .LE. 0 .OR. opt_gMove .GT. this%sweeps ) THEN
1517       this%modGlobalMove(1) = this%sweeps+1
1518       CALL WARNALL("Ctqmc_run : global moves option is <= 0 or > sweeps/cpu -> No global Moves")
1519     ELSE 
1520       this%modGlobalMove(1) = opt_gMove 
1521     END IF
1522   END IF
1523 
1524   CALL Ctqmc_allocateOpt(this)
1525   
1526 !#ifdef CTCtqmc_MOVIE  
1527   ilatex = 0
1528   IF ( this%opt_movie .EQ. 1 ) THEN
1529     Cchar ="0000"
1530     WRITE(Cchar,'(I4)') this%rank 
1531     ilatex = 87+this%rank
1532     OPEN(UNIT=ilatex, FILE="Movie_"//TRIM(ADJUSTL(Cchar))//".tex")
1533     WRITE(ilatex,'(A)') "\documentclass{beamer}"
1534     WRITE(ilatex,'(A)') "\usepackage{color}"
1535     WRITE(ilatex,'(A)') "\setbeamersize{sidebar width left=0pt}"
1536     WRITE(ilatex,'(A)') "\setbeamersize{sidebar width right=0pt}"
1537     WRITE(ilatex,'(A)') "\setbeamersize{text width left=0pt}"
1538     WRITE(ilatex,'(A)') "\setbeamersize{text width right=0pt}"
1539     WRITE(ilatex,*) 
1540     WRITE(ilatex,'(A)') "\begin{document}"
1541     WRITE(ilatex,*) 
1542   END IF
1543 !#endif
1544 
1545   IF ( this%rank .EQ. 0 ) THEN
1546     WRITE(this%ostream,'(A29)') "Starting QMC (Thermalization)"
1547   END IF
1548   
1549   !=================================
1550   ! STARTING THERMALIZATION 
1551   !=================================
1552   CALL Ctqmc_loop(this,this%thermalization,ilatex)
1553   !=================================
1554   ! ENDING   THERMALIZATION 
1555   !=================================
1556 
1557   estimatedTime = this%runTime
1558 #ifdef HAVE_MPI
1559   CALL MPI_REDUCE(this%runTime, estimatedTime, 1, MPI_DOUBLE_PRECISION, MPI_MAX, &
1560              0, this%MY_COMM, ierr)
1561 #endif
1562 
1563   IF ( this%rank .EQ. 0 ) THEN
1564     WRITE(this%ostream,'(A26,I6,A11)') "Thermalization done in    ", CEILING(estimatedTime), "    seconds"
1565     WRITE(this%ostream,'(A25,I7,A15,I5,A5)') "The QMC should run in    ", &
1566            CEILING(estimatedTime*DBLE(this%sweeps)/DBLE(this%thermalization)),&
1567                         "    seconds on ", this%size, " CPUs"
1568   END IF
1569 
1570   !=================================
1571   ! CLEANING CTQMC          
1572   !=================================
1573   CALL Ctqmc_clear(this)
1574 
1575   !=================================
1576   ! STARTING CTQMC          
1577   !=================================
1578   CALL Ctqmc_loop(this,this%sweeps,ilatex)
1579   !=================================
1580   ! ENDING   CTQMC          
1581   !=================================
1582 
1583   IF ( this%opt_movie .EQ. 1 ) THEN
1584     WRITE(ilatex,*) ""
1585     WRITE(ilatex,'(A14)') "\end{document}"
1586     CLOSE(ilatex)
1587   END IF
1588 
1589   this%done     = .TRUE.
1590 
1591 END SUBROUTINE Ctqmc_run

ABINIT/m_Ctqmc/Ctqmc_setG0wTab [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_setG0wTab

FUNCTION

  Set Gow from input array

COPYRIGHT

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

INPUTS

  this=ctqmc
  Gomega=G0w
  opt_fk=F is already inversed with out iwn

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

899 SUBROUTINE Ctqmc_setG0wTab(this,Gomega,opt_fk)
900 
901 !Arguments ------------------------------------
902 
903 !This section has been created automatically by the script Abilint (TD).
904 !Do not modify the following lines by hand.
905 #undef ABI_FUNC
906 #define ABI_FUNC 'Ctqmc_setG0wTab'
907 !End of the abilint section
908 
909   TYPE(Ctqmc), INTENT(INOUT)                      :: this
910   COMPLEX(KIND=8), DIMENSION(:,:), INTENT(IN ) :: Gomega
911   INTEGER                         , INTENT(IN ) :: opt_fk
912 !Local variable -------------------------------
913   DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: F
914 
915   IF ( .NOT. this%para ) &
916     CALL ERROR("Ctqmc_setG0wTab : Ctqmc_setParameters never called    ") 
917 
918   MALLOC(F,(1:this%samples+1,1:this%flavors))
919   CALL Ctqmc_computeF(this,Gomega, F, opt_fk)  ! mu is changed
920   CALL BathOperator_setF(this%Bath, F)
921   !CALL BathOperator_printF(this%Bath)
922   FREE(F)
923 
924   IF ( this%opt_levels .NE. 1 ) THEN ! We compute the mu by hand in computeF
925     CALL ImpurityOperator_setMu(this%Impurity,this%mu)
926   END IF
927 
928   this%inF = .TRUE.
929   this%set = .TRUE. 
930 
931 END SUBROUTINE Ctqmc_setG0wTab

ABINIT/m_Ctqmc/Ctqmc_setMu [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_setMu

FUNCTION

  impose energy levels

COPYRIGHT

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

INPUTS

  this=ctqmc
  levels=energy levels vector

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1212 SUBROUTINE Ctqmc_setMu(this, levels)
1213 
1214 !Arguments ------------------------------------
1215 
1216 !This section has been created automatically by the script Abilint (TD).
1217 !Do not modify the following lines by hand.
1218 #undef ABI_FUNC
1219 #define ABI_FUNC 'Ctqmc_setMu'
1220 !End of the abilint section
1221 
1222   TYPE(Ctqmc)                   , INTENT(INOUT) :: this
1223   DOUBLE PRECISION, DIMENSION(:), INTENT(IN   ) :: levels
1224 
1225   IF ( this%flavors .NE. SIZE(levels,1) ) &
1226     CALL WARNALL("Ctqmc_setMu : Taking energy levels from weiss G(iw)")
1227 
1228   this%mu(:)=-levels  ! levels = \epsilon_j - \mu
1229   !this%mu =\tilde{\mu} = \mu -\epsilon_j
1230   CALL ImpurityOperator_setMu(this%Impurity,this%mu)
1231   this%opt_levels = 1
1232 END SUBROUTINE Ctqmc_setMu

ABINIT/m_Ctqmc/Ctqmc_setParameters [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_setParameters

FUNCTION

  set all parameters and operators

COPYRIGHT

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

INPUTS

  this=ctqmc
  buffer=input parameters

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

475 SUBROUTINE Ctqmc_setParameters(this,buffer)
476 
477 !Arguments ------------------------------------
478 
479 !This section has been created automatically by the script Abilint (TD).
480 !Do not modify the following lines by hand.
481 #undef ABI_FUNC
482 #define ABI_FUNC 'Ctqmc_setParameters'
483 !End of the abilint section
484 
485   TYPE(Ctqmc), INTENT(INOUT)                         :: this
486   DOUBLE PRECISION, DIMENSION(1:9), INTENT(IN   ) :: buffer
487 
488 
489   this%thermalization = INT(buffer(3)) !this%thermalization
490   CALL Ctqmc_setSeed(this,INT(buffer(1)))
491   CALL Ctqmc_setSweeps(this,buffer(2))
492 
493   this%measurements   = INT(buffer(4)) !this%measurements
494   this%flavors        = INT(buffer(5)) !this%flavors
495   this%samples        = INT(buffer(6)) !this%samples
496   this%beta           = buffer(7)      !this%beta
497   this%U              = buffer(8)      !U
498 !  this%mu             = buffer(9)      !this%mu
499   !this%Wmax           = INT(buffer(9)) !Freq
500 !#ifdef CTCtqmc_ANALYSIS
501 !  this%order          = INT(buffer(10)) ! order
502   this%inv_dt         = this%samples / this%beta
503 !#endif
504 
505   !CALL ImpurityOperator_init(this%Impurity,this%flavors,this%beta, this%samples)
506   CALL ImpurityOperator_init(this%Impurity,this%flavors,this%beta)
507   IF ( this%U .GE. 0.d0 ) THEN
508     CALL ImpurityOperator_computeU(this%Impurity,this%U,0.d0)
509     this%setU = .TRUE.
510   END IF
511 !  this%mu = this%mu + this%Impurity%shift_mu
512 
513   CALL BathOperator_init(this%Bath, this%flavors, this%samples, this%beta, INT(buffer(9)))
514 
515   this%para = .TRUE.
516 
517 END SUBROUTINE Ctqmc_setParameters

ABINIT/m_Ctqmc/Ctqmc_setSeed [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_setSeed

FUNCTION

  initialize random number generator

COPYRIGHT

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

INPUTS

  this=ctqmc
  iseed=seed from imput

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

619 SUBROUTINE Ctqmc_setSeed(this,iseed)
620 
621 !Arguments ------------------------------------
622 
623 !This section has been created automatically by the script Abilint (TD).
624 !Do not modify the following lines by hand.
625 #undef ABI_FUNC
626 #define ABI_FUNC 'Ctqmc_setSeed'
627 !End of the abilint section
628 
629   TYPE(Ctqmc), INTENT(INOUT)           :: this
630   INTEGER  , INTENT(IN   )           :: iseed
631 !Local variables ------------------------------
632   !INTEGER                            :: n
633   !INTEGER                            :: i
634   !INTEGER, DIMENSION(:), ALLOCATABLE :: seed
635 
636 
637   !CALL RANDOM_SEED(size = n)
638   !MALLOC(seed,(n))
639   !seed =  iseed + (/ (i - 1, i = 1, n) /)
640 
641   !CALL RANDOM_SEED(PUT = seed+this%rank)
642 
643   !FREE(seed)
644 
645   this%seed=INT(iseed+this%rank,8)
646 
647 END SUBROUTINE Ctqmc_setSeed

ABINIT/m_Ctqmc/Ctqmc_setSweeps [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_setSweeps

FUNCTION

  set the number of sweeps

COPYRIGHT

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

INPUTS

  this=ctqmc
  sweeps=asked sweeps

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

551 SUBROUTINE Ctqmc_setSweeps(this,sweeps)
552 
553 !Arguments ------------------------------------
554 
555 !This section has been created automatically by the script Abilint (TD).
556 !Do not modify the following lines by hand.
557 #undef ABI_FUNC
558 #define ABI_FUNC 'Ctqmc_setSweeps'
559 !End of the abilint section
560 
561   TYPE(Ctqmc)         , INTENT(INOUT) :: this
562   DOUBLE PRECISION  , INTENT(IN   ) :: sweeps
563 
564   this%sweeps = NINT(sweeps / DBLE(this%size))
565 !  write(6,*) this%sweeps,NINT(sweeps / DBLE(this%size)),ANINT(sweeps/DBLE(this%size))
566   IF ( DBLE(this%sweeps) .NE. ANINT(sweeps/DBLE(this%size)) ) &
567     CALL ERROR("Ctqmc_setSweeps : sweeps is negative or too big     ")
568   IF ( this%sweeps .LT. 2*CTQMC_SLICE1 ) THEN  !202
569     CALL WARNALL("Ctqmc_setSweeps : # sweeps automtically changed     ")
570     this%sweeps = 2*CTQMC_SLICE1
571 !  ELSE IF ( this%sweeps .LT. this%thermalization ) THEN
572 !    CALL WARNALL("Ctqmc_setSweeps : Thermalization > sweeps / cpu -> auto fix")
573 !    this%sweeps = this%thermalization
574   END IF
575   IF ( DBLE(NINT(DBLE(this%sweeps)*DBLE(this%size)/DBLE(CTQMC_SLICE1))) .NE.  &
576   ANINT(DBLE(this%sweeps)*DBLE(this%size)/DBLE(CTQMC_SLICE1)) ) THEN
577     this%modNoise1 = this%sweeps
578   ELSE
579     this%modNoise1    = MIN(this%sweeps,INT(DBLE(this%sweeps)*DBLE(this%size) / DBLE(CTQMC_SLICE1))) !101
580   END IF
581   this%modNoise2    = MAX(this%modNoise1 / CTQMC_SLICE2, 1)   ! 100
582 !  this%modGlobalMove(1) = this%thermalization / 10 + 1
583 !  this%modGlobalMove(2) = 0
584 
585 END SUBROUTINE Ctqmc_setSweeps

ABINIT/m_Ctqmc/Ctqmc_setU [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_setU

FUNCTION

  set the interaction this

COPYRIGHT

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

INPUTS

  this=ctqmc
  matU=interaction this

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

 996 SUBROUTINE Ctqmc_setU(this,matU)
 997 
 998 !Arguments ------------------------------------
 999 
1000 !This section has been created automatically by the script Abilint (TD).
1001 !Do not modify the following lines by hand.
1002 #undef ABI_FUNC
1003 #define ABI_FUNC 'Ctqmc_setU'
1004 !End of the abilint section
1005 
1006   TYPE(Ctqmc), INTENT(INOUT) :: this
1007 !Local variables ------------------------------
1008   DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN) :: matU
1009 
1010   IF ( SIZE(matU) .NE. this%flavors*this%flavors ) &
1011     CALL ERROR("Ctqmc_setU : Wrong interaction this (size)        ")
1012 
1013   CALL ImpurityOperator_setUmat(this%Impurity, matU)
1014   this%setU = .TRUE.
1015 END SUBROUTINE Ctqmc_setU

ABINIT/m_Ctqmc/Ctqmc_symmetrizeGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_symmetrizeGreen

FUNCTION

  optionnaly symmetrize the green functions

COPYRIGHT

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

INPUTS

  this=ctqmc
  syms=weight factors

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2778 SUBROUTINE Ctqmc_symmetrizeGreen(this, syms)
2779 
2780 !Arguments ------------------------------------
2781 
2782 !This section has been created automatically by the script Abilint (TD).
2783 !Do not modify the following lines by hand.
2784 #undef ABI_FUNC
2785 #define ABI_FUNC 'Ctqmc_symmetrizeGreen'
2786 !End of the abilint section
2787 
2788   TYPE(Ctqmc)                     , INTENT(INOUT) :: this
2789   DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN   ) :: syms
2790 !Local variables ------------------------------
2791   INTEGER :: iflavor1
2792   INTEGER :: iflavor2
2793   INTEGER :: flavors
2794   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: green_tmp
2795   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:  ) :: n_tmp
2796 
2797   flavors = this%flavors
2798   IF ( SIZE(syms,1) .NE. flavors .OR. SIZE(syms,2) .NE. flavors ) THEN
2799     CALL WARNALL("Ctqmc_symmetrizeGreen : wrong opt_sym -> not symmetrizing")
2800     RETURN
2801   END IF
2802  
2803   MALLOC(green_tmp,(1:this%samples+1,flavors))
2804   green_tmp(:,:) = 0.d0
2805   MALLOC(n_tmp,(1:flavors))
2806   n_tmp(:) = 0.d0
2807   DO iflavor1=1, flavors
2808     DO iflavor2=1,flavors
2809       green_tmp(:,iflavor1) = green_tmp(:,iflavor1) &
2810                              + syms(iflavor2,iflavor1) * this%Greens(iflavor2)%oper(:)
2811       n_tmp(iflavor1) = n_tmp(iflavor1) &
2812                              + syms(iflavor2,iflavor1) * this%measN(1,iflavor2)
2813     END DO
2814   END DO
2815   DO iflavor1=1, flavors
2816     this%Greens(iflavor1)%oper(:) = green_tmp(:,iflavor1)
2817     this%measN(1,iflavor1)          = n_tmp(iflavor1)
2818   END DO
2819   FREE(green_tmp)
2820   FREE(n_tmp)
2821 END SUBROUTINE Ctqmc_symmetrizeGreen

ABINIT/m_Ctqmc/Ctqmc_tryAddRemove [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_tryAddRemove

FUNCTION

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

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

  updated=something changed

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1863 SUBROUTINE Ctqmc_tryAddRemove(this,updated)
1864 
1865 !Arguments ------------------------------------
1866 
1867 !This section has been created automatically by the script Abilint (TD).
1868 !Do not modify the following lines by hand.
1869 #undef ABI_FUNC
1870 #define ABI_FUNC 'Ctqmc_tryAddRemove'
1871 !End of the abilint section
1872 
1873   TYPE(Ctqmc)             , INTENT(INOUT) :: this
1874 !  TYPE(BathOperator)    , INTENT(INOUT) :: Bath 
1875 !  TYPE(ImpurityOperator), INTENT(INOUT) :: Impurity 
1876   LOGICAL               , INTENT(  OUT) :: updated
1877 !Local variables ------------------------------
1878   INTEGER                               :: position
1879   INTEGER         , DIMENSION(1:2)     :: nature ! -2 for antiseg and 1 for seg
1880   INTEGER                               :: i! -2 for antiseg and 1 for seg
1881   DOUBLE PRECISION                      :: action
1882   DOUBLE PRECISION                      :: beta
1883   DOUBLE PRECISION                      :: time1
1884   DOUBLE PRECISION                      :: time2
1885   DOUBLE PRECISION                      :: time_avail
1886   DOUBLE PRECISION                      :: det_ratio
1887   DOUBLE PRECISION                      :: imp_trace
1888   DOUBLE PRECISION                      :: signe
1889   DOUBLE PRECISION                      :: tail
1890   DOUBLE PRECISION, DIMENSION(1:2)      :: CdagC_1
1891 
1892   IF ( .NOT. this%set ) &
1893     CALL ERROR("Ctqmc_trySegment : QMC not set                       ")
1894 
1895   nature(1) = CTQMC_SEGME
1896   nature(2) = CTQMC_ANTIS
1897   beta      = this%beta
1898 
1899   updated = .FALSE.
1900   tail  = DBLE(this%Impurity%particles(this%Impurity%activeFlavor)%tail)
1901 
1902 
1903   DO i = 1, 2
1904     signe = SIGN(1.d0,DBLE(nature(i))) 
1905 
1906     !CALL RANDOM_NUMBER(action)
1907     CALL OurRng(this%seed,action)
1908 
1909     IF ( action .LT. .5d0 ) THEN ! Ajout de segment
1910       !CALL RANDOM_NUMBER(time1)
1911       CALL OurRng(this%seed,time1)
1912       time1 = time1 * beta
1913       time_avail = ImpurityOperator_getAvailableTime(this%Impurity,time1,position) * signe
1914       IF ( time_avail .GT. 0.d0 ) THEN
1915         !CALL RANDOM_NUMBER(time2)
1916         CALL OurRng(this%seed,time2)
1917         IF ( time2 .EQ. 0.d0 ) THEN
1918           CALL OurRng(this%seed,time2) ! Prevent null segment
1919         END IF
1920         time2     = time1 + time2 * time_avail
1921         CdagC_1(Cdag_) = ((1.d0+signe)*time1+(1.d0-signe)*time2)*0.5d0
1922         CdagC_1(C_   ) = ((1.d0+signe)*time2+(1.d0-signe)*time1)*0.5d0
1923         det_ratio = BathOperator_getDetAdd(this%Bath,CdagC_1,position,this%Impurity%particles(this%Impurity%activeFlavor))
1924         imp_trace = ImpurityOperator_getTraceAdd(this%Impurity,CdagC_1)
1925         !CALL RANDOM_NUMBER(time1)
1926         CALL OurRng(this%seed,time1)
1927         IF ( det_ratio*imp_trace .LT. 0.d0 ) THEN
1928           this%stats(nature(i)+CTQMC_DETSI) = this%stats(nature(i)+CTQMC_DETSI) + 1.d0
1929         END IF
1930         IF ( (time1 * (tail + 1.d0 )) &
1931              .LT. (beta * time_avail * det_ratio * imp_trace ) ) THEN
1932           CALL ImpurityOperator_add(this%Impurity,CdagC_1,position)
1933           CALL BathOperator_setMAdd(this%bath,this%Impurity%particles(this%Impurity%activeFlavor))
1934           this%stats(nature(i)+CTQMC_ADDED) = this%stats(nature(i)+CTQMC_ADDED)  + 1.d0
1935           updated = .TRUE. .OR. updated
1936           tail = tail + 1.d0
1937         END IF 
1938       END IF 
1939 
1940     ELSE ! Supprimer un segment
1941       IF ( tail .GT. 0.d0 ) THEN
1942         !CALL RANDOM_NUMBER(time1)
1943         CALL OurRng(this%seed,time1)
1944         position = INT(((time1 * tail) + 1.d0) * signe )
1945         time_avail = ImpurityOperator_getAvailedTime(this%Impurity,position)
1946         det_ratio  = BathOperator_getDetRemove(this%Bath,position)
1947         imp_trace  = ImpurityOperator_getTraceRemove(this%Impurity,position)
1948         !CALL RANDOM_NUMBER(time1)
1949         CALL OurRng(this%seed,time1)
1950         IF ( det_ratio * imp_trace .LT. 0.d0 ) THEN
1951           this%stats(nature(i)+CTQMC_DETSI) = this%stats(nature(i)+CTQMC_DETSI) + 1.d0
1952         END IF
1953         IF ( (time1 * beta * time_avail ) &
1954              .LT. (tail * det_ratio * imp_trace) ) THEN
1955           CALL ImpurityOperator_remove(this%Impurity,position)
1956           CALL BathOperator_setMRemove(this%Bath,this%Impurity%particles(this%Impurity%activeFlavor))
1957           this%stats(nature(i)+CTQMC_REMOV) = this%stats(nature(i)+CTQMC_REMOV)  + 1.d0
1958           updated = .TRUE. .OR. updated
1959           tail = tail -1.d0
1960         END IF
1961       END IF
1962     END IF
1963   END DO
1964 END SUBROUTINE Ctqmc_tryAddRemove

ABINIT/m_Ctqmc/Ctqmc_trySwap [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmc_trySwap

FUNCTION

  try a global move (swap to flavors)

COPYRIGHT

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

INPUTS

  this=ctqmc

OUTPUT

  flav_i=first flavor swaped
  flav_j=second flavor swaped

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1999 SUBROUTINE Ctqmc_trySwap(this,flav_i,flav_j)
2000 
2001 !Arguments ------------------------------------
2002 
2003 !This section has been created automatically by the script Abilint (TD).
2004 !Do not modify the following lines by hand.
2005 #undef ABI_FUNC
2006 #define ABI_FUNC 'Ctqmc_trySwap'
2007 !End of the abilint section
2008 
2009   TYPE(Ctqmc)           , INTENT(INOUT) :: this
2010 !  TYPE(BathOperator)    , INTENT(INOUT) :: Bath 
2011 !  TYPE(ImpurityOperator), INTENT(INOUT) :: Impurity 
2012   INTEGER               , INTENT(  OUT) :: flav_i
2013   INTEGER               , INTENT(  OUT) :: flav_j
2014 !Local variables ------------------------------
2015   INTEGER :: flavor_i
2016   INTEGER :: flavor_j
2017   DOUBLE PRECISION :: rnd
2018   DOUBLE PRECISION :: lengthi
2019   DOUBLE PRECISION :: lengthj
2020   DOUBLE PRECISION :: overlapic1
2021   DOUBLE PRECISION :: overlapjc1
2022   DOUBLE PRECISION :: overlapic2
2023   DOUBLE PRECISION :: overlapjc2
2024   DOUBLE PRECISION :: detic1
2025   DOUBLE PRECISION :: detjc1
2026   DOUBLE PRECISION :: detic2
2027   DOUBLE PRECISION :: detjc2
2028   DOUBLE PRECISION :: det_ratio
2029   DOUBLE PRECISION :: local_ratio
2030 
2031   !CALL RANDOM_NUMBER(rnd)
2032   CALL OurRng(this%seed,rnd)
2033   flavor_i = NINT(rnd*DBLE(this%flavors-1.d0))+1
2034   !CALL RANDOM_NUMBER(rnd)
2035   CALL OurRng(this%seed,rnd)
2036   flavor_j = NINT(rnd*DBLE(this%flavors-1.d0))+1
2037   
2038   flav_i = 0
2039   flav_j = 0
2040 
2041   IF ( flavor_i .NE. flavor_j ) THEN
2042     ! On tente d'intervertir i et j
2043     ! Configuration actuelle :
2044     this%modGlobalMove(2) = this%modGlobalMove(2)+1
2045     detic1     = BathOperator_getDetF(this%Bath,flavor_i)
2046     detjc1     = BathOperator_getDetF(this%Bath,flavor_j)
2047     lengthi    = ImpurityOperator_measN(this%Impurity,flavor_i)
2048     lengthj    = ImpurityOperator_measN(this%Impurity,flavor_j)
2049     overlapic1 = ImpurityOperator_overlapFlavor(this%Impurity,flavor_i)
2050     overlapjc1 = ImpurityOperator_overlapFlavor(this%Impurity,flavor_j)
2051     ! Configuration nouvelle :
2052     detic2     = BathOperator_getDetF(this%Bath,flavor_i,this%Impurity%particles(flavor_j))
2053     detjc2     = BathOperator_getDetF(this%Bath,flavor_j,this%Impurity%particles(flavor_i))
2054     ! lengths unchanged
2055     overlapic2 = ImpurityOperator_overlapSwap(this%Impurity,flavor_i,flavor_j)
2056     overlapjc2 = ImpurityOperator_overlapSwap(this%Impurity,flavor_j,flavor_i)
2057 
2058 !    IF ( detic1*detjc1 .EQ. detic2*detjc2 ) THEN
2059 !      det_ratio = 1.d0
2060 !    ELSE IF ( detic1*detjc1 .EQ. 0.d0 ) THEN
2061 !      det_ratio = detic2*detjc2 ! evite de diviser par 0 si pas de segment
2062 !    ELSE
2063       det_ratio = detic2*detjc2/(detic1*detjc1)
2064 !    END IF
2065     local_ratio = DEXP(-overlapic2*overlapjc2+overlapic1*overlapjc1 &
2066                       +(lengthj-lengthi)*(this%mu(flavor_i)-this%mu(flavor_j)))
2067     ! Wloc = exp(muN-Uo)
2068     !CALL RANDOM_NUMBER(rnd)
2069     CALL OurRng(this%seed,rnd)
2070     IF ( rnd .LT. local_ratio*det_ratio ) THEN ! swap accepted
2071       CALL ImpurityOperator_swap(this%Impurity, flavor_i,flavor_j)
2072       CALL BathOperator_swap    (this%Bath    , flavor_i,flavor_j)
2073       this%swap = this%swap + 1.d0
2074       flav_i = flavor_i
2075       flav_j = flavor_j
2076 !    ELSE
2077 !      CALL WARN("Swap refused")
2078 !      WRITE(this%ostream,'(6E24.14)') local_ratio, det_ratio, detic1, detjc1, detic2, detjc2
2079     END IF
2080   END IF
2081 
2082 END SUBROUTINE Ctqmc_trySwap

m_Ctqmc/Ctqmc [ Types ]

[ Top ] [ m_Ctqmc ] [ Types ]

NAME

  Ctqmc

FUNCTION

  This structured datatype contains the necessary data

COPYRIGHT

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

SOURCE

 79 TYPE, PUBLIC :: Ctqmc
 80 
 81   LOGICAL _PRIVATE :: init = .FALSE.
 82 ! Flag: is MC initialized
 83 
 84   LOGICAL _PRIVATE :: set  = .FALSE.
 85 ! Flag: ??
 86 
 87   LOGICAL _PRIVATE :: setU = .FALSE.
 88 ! Flag: is U Set ?
 89 
 90   LOGICAL _PRIVATE :: inF  = .FALSE.
 91 ! Flag: is hybridization fct in input ?
 92 
 93   LOGICAL _PRIVATE :: done = .FALSE.
 94 ! Flag: is MC terminated ?
 95 
 96   LOGICAL _PRIVATE :: para = .FALSE.
 97 ! Flag:  do we have parameters in input
 98 
 99   LOGICAL _PRIVATE :: have_MPI = .FALSE.
100 ! Flag: 
101 
102   INTEGER _PRIVATE :: opt_movie = 0
103 !
104 
105   INTEGER _PRIVATE :: opt_analysis = 0
106 ! correlations 
107 
108   INTEGER _PRIVATE :: opt_check = 0
109 ! various check 0
110 ! various check 1 impurity
111 ! various check 2 bath
112 ! various check 3 both
113 
114   INTEGER _PRIVATE :: opt_order = 0
115 ! nb of segments max for analysis
116 
117   INTEGER _PRIVATE :: opt_noise = 0
118 ! compute noise
119 
120   INTEGER _PRIVATE :: opt_spectra = 0
121 ! markov chain FT (correlation time)
122 
123   INTEGER _PRIVATE :: opt_levels = 0
124 ! do we have energy levels
125 
126   INTEGER _PRIVATE :: flavors
127 !
128 
129   INTEGER _PRIVATE :: measurements
130 ! nb of measure in the MC
131 
132   INTEGER _PRIVATE :: samples
133 ! nb of L points
134 
135   INTEGER(8) _PRIVATE :: seed
136 !
137 
138   INTEGER _PRIVATE :: sweeps
139 !
140 
141   INTEGER _PRIVATE :: thermalization
142 !
143 
144   INTEGER _PRIVATE :: ostream
145 ! output file
146 
147   INTEGER _PRIVATE :: istream
148 ! input file
149 
150   INTEGER _PRIVATE :: modNoise1
151 ! measure the noise each modNoise1
152 
153   INTEGER _PRIVATE :: modNoise2
154 ! measure the noise each modNoise2
155 
156   INTEGER _PRIVATE :: activeFlavor
157 ! orbital on which one do sth now
158 
159   INTEGER, DIMENSION(1:2) _PRIVATE :: modGlobalMove
160 ! 1: gloabl move each modglobalmove(1)
161 ! 2: we have done modglobalmove(2) for two different orbitals.
162 
163   INTEGER _PRIVATE :: Wmax
164 ! Max freq for FT
165 
166   DOUBLE PRECISION, DIMENSION(1:6) _PRIVATE :: stats
167 ! to now how many negative determinant, antisegments,seeme.e.twfs...j
168 
169   DOUBLE PRECISION _PRIVATE :: swap
170 ! nb of successfull GM
171 
172   INTEGER _PRIVATE :: MY_COMM
173 ! 
174 
175   INTEGER _PRIVATE :: rank
176 !
177 
178   INTEGER _PRIVATE :: size
179 ! size of MY_COMM
180 
181   DOUBLE PRECISION _PRIVATE :: runTime ! time for the run routine
182 !  
183 
184   DOUBLE PRECISION _PRIVATE :: beta
185 !
186 
187   DOUBLE PRECISION _PRIVATE :: U
188 
189   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) _PRIVATE :: mu
190 ! levels
191 
192   TYPE(GreenHyb)  , ALLOCATABLE, DIMENSION(:    ) _PRIVATE :: Greens 
193 
194   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:  ) _PRIVATE :: measN 
195 ! measure of occupations (3or4,flavor) 
196 
197   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:  ) _PRIVATE :: measDE
198 !  (flavor,flavor) double occupancies
199 !  (1,1): total energy of correlation.
200 
201   DOUBLE PRECISION _PRIVATE :: a_Noise
202 ! Noise a exp (-bx) for the  noise
203 
204   DOUBLE PRECISION _PRIVATE :: b_Noise
205 ! Noise a exp (-bx) for the  noise
206 
207   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) _PRIVATE :: abNoiseG   !(ab,tau,flavor)
208 ! Noise but for G
209 
210   TYPE(Vector)             , DIMENSION(1:2) _PRIVATE :: measNoise 
211   TYPE(Vector), ALLOCATABLE, DIMENSION(:,:,:) _PRIVATE :: measNoiseG       !(tau,flavor,mod) 
212 ! accumulate each value relataed to measurenoise 1 2
213 
214   DOUBLE PRECISION _PRIVATE                            :: inv_dt
215 ! 1/(beta/L)
216 
217   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:  ) _PRIVATE :: measPerturbation 
218 ! opt_order,nflavor
219 
220   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) _PRIVATE :: measCorrelation 
221 ! segment,antisegment,nflavor,nflavor
222 
223   DOUBLE PRECISION _PRIVATE :: errorImpurity
224 ! check 
225 
226   DOUBLE PRECISION _PRIVATE :: errorBath
227 ! for check
228 
229   TYPE(BathOperator) _PRIVATE              :: Bath
230 
231   TYPE(ImpurityOperator) _PRIVATE          :: Impurity
232 
233   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) _PRIVATE :: density
234 
235 END TYPE Ctqmc