TABLE OF CONTENTS
- ABINIT/m_Ctqmcoffdiag
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_allocateAll
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_allocateOpt
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_clear
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_computeF
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_destroy
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getD
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getE
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getGreen
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getResult
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_init
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_loop
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measCorrelation
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measN
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measPerturbation
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printAll
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printCorrelation
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printD
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printE
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printGreen
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printPerturbation
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printQMC
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printSpectra
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_reset
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_run
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setG0wTab
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_sethybri_limit
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setMu
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setParameters
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setSeed
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setSweeps
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setU
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_symmetrizeGreen
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_tryAddRemove
- ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_trySwap
- m_Ctqmcoffdiag/Ctqmcoffdiag
ABINIT/m_Ctqmcoffdiag [ Modules ]
NAME
m_Ctqmcoffdiag
FUNCTION
Manage and drive all the CTQMC Should not be used if you don't know what you do Please use CtqmcoffdiagInterface
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder, B. Amadon, J. Denier) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
NOTES
SOURCE
24 #include "defs.h" 25 #define CTQMC_SLICE1 100 26 ! Coupe Sweeps en 100 27 #define CTQMC_SLICE2 100 28 ! Coupe modNoise1 en 2000 29 #define CTQMC_SEGME 1 30 #define CTQMC_ANTIS -2 31 #define CTQMC_ADDED 3 32 #define CTQMC_REMOV 4 33 #define CTQMC_DETSI 5 34 MODULE m_Ctqmcoffdiag 35 36 USE m_Global 37 USE m_GreenHyboffdiag 38 USE m_BathOperatoroffdiag 39 USE m_ImpurityOperator 40 USE m_Stat 41 USE m_FFTHyb 42 USE m_OurRng 43 #ifdef HAVE_MPI2 44 USE mpi 45 #endif 46 IMPLICIT NONE 47 48 public :: Ctqmcoffdiag_init 49 public :: Ctqmcoffdiag_setParameters 50 public :: Ctqmcoffdiag_setSweeps 51 public :: Ctqmcoffdiag_setSeed 52 public :: Ctqmcoffdiag_allocateAll 53 public :: Ctqmcoffdiag_allocateOpt 54 public :: Ctqmcoffdiag_setG0wTab 55 public :: Ctqmcoffdiag_setU 56 public :: Ctqmcoffdiag_clear 57 public :: Ctqmcoffdiag_reset 58 public :: Ctqmcoffdiag_setMu 59 public :: Ctqmcoffdiag_computeF 60 public :: Ctqmcoffdiag_run 61 public :: Ctqmcoffdiag_tryAddRemove 62 public :: Ctqmcoffdiag_trySwap 63 public :: Ctqmcoffdiag_measN 64 public :: Ctqmcoffdiag_measCorrelation 65 public :: Ctqmcoffdiag_measPerturbation 66 public :: Ctqmcoffdiag_getResult 67 public :: Ctqmcoffdiag_symmetrizeGreen 68 public :: Ctqmcoffdiag_getGreen 69 public :: Ctqmcoffdiag_getD 70 public :: Ctqmcoffdiag_getE 71 public :: Ctqmcoffdiag_printAll 72 public :: Ctqmcoffdiag_printQMC 73 public :: Ctqmcoffdiag_printGreen 74 public :: Ctqmcoffdiag_printD 75 public :: Ctqmcoffdiag_printE 76 public :: Ctqmcoffdiag_printPerturbation 77 public :: Ctqmcoffdiag_printCorrelation 78 public :: Ctqmcoffdiag_printSpectra 79 public :: Ctqmcoffdiag_destroy
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_allocateAll [ Functions ]
NAME
Ctqmcoffdiag_allocateAll
FUNCTION
Allocate all non option variables
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
644 SUBROUTINE Ctqmcoffdiag_allocateAll(op) 645 646 !Arguments ------------------------------------ 647 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 648 !Local variables ------------------------------ 649 INTEGER :: flavors 650 651 IF ( .NOT. op%para ) & 652 CALL ERROR("Ctqmcoffdiag_allocateAll : Ctqmcoffdiag_setParameters never called ") 653 654 flavors = op%flavors 655 656 657 ! number of electrons 658 FREEIF(op%measN) 659 MALLOC(op%measN,(1:4,1:flavors)) 660 op%measN = 0.d0 661 662 ! double occupancies 663 FREEIF(op%measDE) 664 MALLOC(op%measDE,(1:flavors,1:flavors) ) 665 op%measDE = 0.d0 666 667 FREEIF(op%mu) 668 MALLOC(op%mu,(1:flavors) ) 669 op%mu = 0.d0 670 FREEIF(op%hybri_limit) 671 MALLOC(op%hybri_limit,(flavors,flavors) ) 672 op%hybri_limit = czero 673 END SUBROUTINE Ctqmcoffdiag_allocateAll
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_allocateOpt [ Functions ]
NAME
Ctqmcoffdiag_allocateOpt
FUNCTION
allocate all option variables
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
701 SUBROUTINE Ctqmcoffdiag_allocateOpt(op) 702 703 !Arguments ------------------------------------ 704 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 705 !Local variables ------------------------------ 706 INTEGER :: i 707 INTEGER :: j 708 INTEGER :: k 709 710 IF ( .NOT. op%para ) & 711 CALL ERROR("Ctqmcoffdiag_allocateOpt : Ctqmcoffdiag_setParameters never called ") 712 713 IF ( op%opt_analysis .EQ. 1 ) THEN 714 FREEIF(op%measCorrelation) 715 MALLOC(op%measCorrelation,(1:op%samples+1,1:3,1:op%flavors)) 716 op%measCorrelation = 0.d0 717 END IF 718 719 IF ( op%opt_order .GT. 0 ) THEN 720 FREEIF(op%measPerturbation) 721 MALLOC(op%measPerturbation,(1:op%opt_order,1:op%flavors)) 722 op%measPerturbation = 0.d0 723 FREEIF(op%meas_fullemptylines) 724 MALLOC(op%meas_fullemptylines,(2,1:op%flavors)) 725 op%meas_fullemptylines = 0.d0 726 END IF 727 728 IF ( op%opt_histo .GT. 0 ) THEN 729 FREEIF(op%occup_histo_time) 730 MALLOC(op%occup_histo_time,(1:op%flavors+1)) 731 op%occup_histo_time= 0.d0 732 END IF 733 734 IF ( op%opt_noise .EQ. 1 ) THEN 735 IF ( ALLOCATED(op%measNoiseG) ) THEN 736 DO i=1,2 737 DO j = 1, op%flavors 738 DO k= 1, op%samples+1 739 CALL Vector_destroy(op%measNoiseG(k,j,i)) 740 END DO 741 END DO 742 END DO 743 DT_FREE(op%measNoiseG) 744 END IF 745 DT_MALLOC(op%measNoiseG,(1:op%samples+1,1:op%flavors,1:2)) 746 !DO i=1,2 747 DO j = 1, op%flavors 748 DO k= 1, op%samples+1 749 CALL Vector_init(op%measNoiseG(k,j,1),CTQMC_SLICE1) 750 END DO 751 END DO 752 DO j = 1, op%flavors 753 DO k= 1, op%samples+1 754 CALL Vector_init(op%measNoiseG(k,j,2),CTQMC_SLICE1*CTQMC_SLICE2+1) ! +1 pour etre remplacer ceil 755 END DO 756 END DO 757 !END DO 758 FREEIF(op%abNoiseG) 759 MALLOC(op%aBNoiseG,(1:2,1:op%samples+1,op%flavors)) 760 op%abNoiseG = 0.d0 761 END IF 762 763 IF (op%opt_spectra .GE. 1 ) THEN 764 FREEIF(op%density) 765 !MALLOC(op%density,(1:op%thermalization,1:op%flavors)) 766 i = CEILING(DBLE(op%thermalization+op%sweeps)/DBLE(op%measurements*op%opt_spectra)) 767 MALLOC(op%density,(1:op%flavors+1,1:i)) 768 op%density = 0.d0 769 END IF 770 !#endif 771 END SUBROUTINE Ctqmcoffdiag_allocateOpt
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_clear [ Functions ]
NAME
Ctqmcoffdiag_clear
FUNCTION
clear a ctqmc run
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
982 SUBROUTINE Ctqmcoffdiag_clear(op) 983 984 !Arguments ------------------------------------ 985 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 986 !Local variables ------------------------------ 987 INTEGER :: i 988 INTEGER :: j 989 INTEGER :: k 990 991 op%measN(1,:) = 0.d0 992 op%measN(2,:) = 0.d0 993 !Do not set measN(3,:) to 0 to avoid erasing N between therm and ctqmc 994 op%measN(4,:) = 0.d0 995 op%measDE = 0.d0 996 ! op%seg_added = 0.d0 997 ! op%anti_added = 0.d0 998 ! op%seg_removed = 0.d0 999 ! op%anti_removed = 0.d0 1000 ! op%seg_sign = 0.d0 1001 ! op%anti_sign = 0.d0 1002 op%stats(:) = 0.d0 1003 ! op%signvaluecurrent = 0.d0 1004 ! op%signvaluemeas = 0.d0 1005 op%swap = 0.d0 1006 op%runTime = 0.d0 1007 op%modGlobalMove(2) = 0 1008 CALL Vector_clear(op%measNoise(1)) 1009 CALL Vector_clear(op%measNoise(2)) 1010 !#ifdef CTCtqmcoffdiag_CHECK 1011 op%errorImpurity = 0.d0 1012 op%errorBath = 0.d0 1013 !#endif 1014 CALL GreenHyboffdiag_clear(op%Greens) 1015 !#ifdef CTCtqmcoffdiag_ANALYSIS 1016 IF ( op%opt_analysis .EQ. 1 .AND. ALLOCATED(op%measCorrelation) ) & 1017 op%measCorrelation = 0.d0 1018 IF ( op%opt_order .GT. 0 .AND. ALLOCATED(op%measPerturbation) ) & 1019 op%measPerturbation = 0.d0 1020 IF ( op%opt_order .GT. 0 .AND. ALLOCATED(op%meas_fullemptylines) ) & 1021 op%meas_fullemptylines = 0.d0 1022 IF ( op%opt_noise .EQ. 1 .AND. ALLOCATED(op%measNoiseG) ) THEN 1023 DO i=1,2 1024 DO j = 1, op%flavors 1025 DO k= 1, op%samples+1 1026 CALL Vector_clear(op%measNoiseG(k,j,i)) 1027 END DO 1028 END DO 1029 END DO 1030 !DO j = 1, op%flavors 1031 ! CALL GreenHyboffdiag_clear(op%Greens(j)) 1032 !END DO 1033 END IF 1034 !#endif 1035 END SUBROUTINE Ctqmcoffdiag_clear
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_computeF [ Functions ]
NAME
Ctqmcoffdiag_computeF
FUNCTION
Compute the hybridization function
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc Gomega=G0 to compute F opt_fk=What is Gomega
OUTPUT
F=hybridization function
SIDE EFFECTS
NOTES
SOURCE
1204 SUBROUTINE Ctqmcoffdiag_computeF(op, Gomega, F, opt_fk) 1205 1206 use m_hide_lapack, only : xginv 1207 !Arguments ------------------------------------ 1208 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 1209 COMPLEX(KIND=8), DIMENSION(:,:,:), INTENT(IN ) :: Gomega 1210 !INTEGER , INTENT(IN ) :: Wmax 1211 DOUBLE PRECISION, DIMENSION(:,:,:), INTENT(INOUT) :: F 1212 INTEGER , INTENT(IN ) :: opt_fk 1213 !Local variables ------------------------------ 1214 INTEGER :: flavors 1215 INTEGER :: samples 1216 INTEGER :: iflavor,ifl 1217 INTEGER :: iflavor2 1218 INTEGER :: iomega 1219 INTEGER :: itau 1220 DOUBLE PRECISION :: pi_invBeta 1221 DOUBLE PRECISION :: K 1222 !DOUBLE PRECISION :: re 1223 !DOUBLE PRECISION :: im 1224 !DOUBLE PRECISION :: det 1225 COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: F_omega 1226 COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: F_omega_inv 1227 COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: Gomega_tmp 1228 TYPE(GreenHyboffdiag) :: F_tmp 1229 !character(len=4) :: tag_proc 1230 !character(len=30) :: tmpfil 1231 !INTEGER :: unitnb 1232 1233 ABI_UNUSED((/opt_fk/)) 1234 1235 flavors = op%flavors 1236 1237 samples = op%samples 1238 pi_invBeta = ACOS(-1.d0) / op%beta 1239 op%Wmax=SIZE(Gomega,1) 1240 !sui!write(std_out,*) "op%Wmax",op%Wmax 1241 !================================= 1242 ! --- Initialize F_tmp 1243 !================================= 1244 IF ( op%have_MPI .EQV. .TRUE. ) THEN 1245 CALL GreenHyboffdiag_init(F_tmp,samples,op%beta,flavors,MY_COMM=op%MY_COMM) 1246 ELSE 1247 CALL GreenHyboffdiag_init(F_tmp,samples,op%beta,flavors) 1248 END IF 1249 ! K = op%mu 1250 1251 !================================= 1252 ! --- Allocate F_omega 1253 !================================= 1254 MALLOC(F_omega,(1:op%Wmax,1:flavors,1:flavors)) 1255 MALLOC(F_omega_inv,(1:flavors,1:flavors)) 1256 MALLOC(Gomega_tmp,(1:op%Wmax,1:flavors,1:flavors)) 1257 !op%hybri_limit(2,2)=op%hybri_limit(1,1) 1258 !op%mu(1)=op%mu(1)/10 1259 !op%mu(2)=op%mu(1) 1260 DO iomega=1,op%Wmax 1261 do iflavor=1,flavors 1262 do iflavor2=1,flavors 1263 ! Gomega_tmp(iomega,iflavor,iflavor2)=op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta))/3.d0 1264 enddo 1265 enddo 1266 END DO 1267 Gomega_tmp=Gomega 1268 1269 !IF ( op%rank .EQ. 0 ) & 1270 !OPEN(UNIT=9876,FILE="K.dat",POSITION="APPEND") 1271 1272 !============================================================================================= 1273 ! --- Compute Bath Green's function from Hybridization function in imaginary time 1274 !============================================================================================= 1275 !IF ( opt_fk .EQ. 0 ) THEN 1276 IF ( op%rank .EQ. 0 ) THEN 1277 ! DO iflavor = 1, flavors 1278 ! DO iflavor2 = 1, flavors 1279 ! write(330,*) "#",iflavor,iflavor2 1280 ! write(331,*) "#",iflavor,iflavor2 1281 ! do iomega=1,op%Wmax 1282 ! write(330,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(Gomega_tmp(iomega,iflavor,iflavor2)) 1283 ! write(331,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(Gomega_tmp(iomega,iflavor,iflavor2)) 1284 ! enddo 1285 ! write(330,*) 1286 ! write(331,*) 1287 ! END DO 1288 ! END DO 1289 ENDIF 1290 DO iomega=1,op%Wmax 1291 ! be careful...here 1292 ! Gomega in input is Fomega and 1293 ! F_omega is Gomega. 1294 ! COMPUTE G0 FROM F 1295 do iflavor=1,flavors 1296 do iflavor2=1,flavors 1297 if (iflavor==iflavor2) then 1298 F_omega_inv(iflavor,iflavor2)= (cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta,kind=8) & 1299 & + op%mu(iflavor)- Gomega_tmp(iomega,iflavor,iflavor2)) 1300 else 1301 F_omega_inv(iflavor,iflavor2)= (- Gomega_tmp(iomega,iflavor,iflavor2)) 1302 endif 1303 enddo 1304 enddo 1305 ! END DO 1306 ! IF ( op%rank .EQ. 0 ) THEN 1307 ! DO iflavor = 1, flavors 1308 ! DO iflavor2 = 1, flavors 1309 ! write(334,*) "#",iflavor,iflavor2 1310 ! write(335,*) "#",iflavor,iflavor2 1311 ! do iomega=1,op%Wmax 1312 ! write(334,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,iflavor,iflavor2)) 1313 ! write(335,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_omega(iomega,iflavor,iflavor2)) 1314 ! enddo 1315 ! write(334,*) 1316 ! write(335,*) 1317 ! END DO 1318 ! END DO 1319 ! ENDIF 1320 1321 ! DO iomega=1,op%Wmax 1322 call xginv(F_omega_inv,flavors) 1323 do iflavor=1,flavors 1324 do iflavor2=1,flavors 1325 F_omega(iomega,iflavor,iflavor2) = F_omega_inv(iflavor,iflavor2) 1326 enddo 1327 enddo 1328 END DO 1329 1330 !IF ( op%rank .EQ. 0 ) THEN 1331 ! DO iflavor = 1, flavors 1332 ! DO iflavor2 = 1, flavors 1333 ! write(332,*) "#",iflavor,iflavor2 1334 ! write(333,*) "#",iflavor,iflavor2 1335 ! do iomega=1,op%Wmax 1336 ! write(332,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,iflavor,iflavor2)) 1337 ! write(333,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_omega(iomega,iflavor,iflavor2)) 1338 ! enddo 1339 ! write(332,*) 1340 ! write(333,*) 1341 ! END DO 1342 ! END DO 1343 !ENDIF 1344 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1345 ! for test: Fourier of G0(iwn) 1346 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1347 !sui!write(std_out,*) "opt_fk=0" 1348 CALL GreenHyboffdiag_setOperW(F_tmp,F_omega) 1349 ! IF ( op%rank .EQ. 0 ) THEN 1350 ! DO iflavor = 1, flavors 1351 ! DO iflavor2 = 1, flavors 1352 ! write(336,*) "#",iflavor,iflavor2 1353 ! write(337,*) "#",iflavor,iflavor2 1354 ! do iomega=1,op%Wmax 1355 ! write(336,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2)) 1356 ! write(337,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_tmp%oper_w(iomega,iflavor,iflavor2)) 1357 ! enddo 1358 ! write(336,*) 1359 ! write(337,*) 1360 ! END DO 1361 ! END DO 1362 ! ENDIF 1363 CALL GreenHyboffdiag_backFourier(F_tmp,func="green") 1364 ! --- Put the result in F 1365 DO iflavor = 1, flavors 1366 DO iflavor2 = 1, flavors 1367 DO itau=1,samples+1 1368 F(itau,iflavor,iflavor2) = F_tmp%oper(itau,iflavor,iflavor2) 1369 END DO 1370 END DO 1371 END DO 1372 !IF ( op%rank .EQ. 0 ) THEN 1373 ! DO iflavor = 1, flavors 1374 ! DO iflavor2 = 1, flavors 1375 ! write(346,*) "#",iflavor,iflavor2 1376 ! do itau=1,op%samples+1 1377 ! write(346,*) (itau-1)*op%beta/(op%samples),real(F(itau,iflavor,iflavor2)) 1378 ! enddo 1379 ! write(346,*) 1380 ! END DO 1381 ! END DO 1382 !ENDIF 1383 DO iflavor = 1, flavors 1384 DO iflavor2 = 1, flavors 1385 DO itau=1,samples+1 1386 ! This symetrization is general and valid even with SOC 1387 ! Without SOC, it leads to zero. 1388 F(itau,iflavor,iflavor2) = (F_tmp%oper(itau,iflavor,iflavor2)+F_tmp%oper(itau,iflavor2,iflavor))/2.d0 1389 END DO 1390 END DO 1391 END DO 1392 open (unit=4367,file='G0tau_fromF',status='unknown',form='formatted') 1393 rewind(4367) 1394 IF ( op%rank .EQ. 0 ) THEN 1395 DO iflavor = 1, flavors 1396 DO iflavor2 = 1, flavors 1397 write(4367,*) "#",iflavor,iflavor2 1398 do itau=1,op%samples+1 1399 write(4367,*) (itau-1)*op%beta/(op%samples),F(itau,iflavor,iflavor2) 1400 enddo 1401 write(4367,*) 1402 END DO 1403 !sui!write(std_out,'(5x,14(2f9.5,2x))') (F(op%samples+1,iflavor,iflavor2),iflavor2=1,flavors) 1404 END DO 1405 ENDIF 1406 !call flush(437) 1407 close(4367) 1408 !call flush(6) 1409 1410 call xmpi_barrier(op%MY_COMM) 1411 !CALL ERROR("END OF CALCULATION") 1412 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1413 ! END OF TEST 1414 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1415 1416 !DO iomega=1,op%Wmax 1417 ! call xginv(F_omega(iomega,:,:),flavors) 1418 !END DO 1419 !F_omega = CMPLX(-1.d0,0,8)/Gomega_tmp 1420 !ELSE 1421 !============================================================================================= 1422 ! --- Restore Hybridization in F_omega 1423 !============================================================================================= 1424 1425 ! Restore Hybridization in F_omega for the following operations 1426 F_omega = Gomega_tmp 1427 !END IF 1428 1429 !================================================================== 1430 ! --- Full double loop on flavors to compute F (remove levels) 1431 !================================================================== 1432 DO iflavor = 1, flavors 1433 DO iflavor2 = 1, flavors 1434 1435 ! --- Compute or use the levels for the diagonal hybridization (else K=0) 1436 IF(iflavor==iflavor2) THEN 1437 IF ( op%opt_levels .EQ. 1 ) THEN 1438 K = op%mu(iflavor) 1439 ELSE 1440 K = -REAL(F_omega(op%Wmax, iflavor,iflavor)) 1441 ! op%mu = K 1442 op%mu(iflavor) = K 1443 END IF 1444 ELSE 1445 K=0.d0 1446 ENDIF 1447 !IF ( op%rank .EQ. 0 ) & 1448 !WRITE(9876,'(I4,2E22.14)') iflavor, K, REAL(-F_omega(op%Wmax, iflavor)) 1449 ! IF(op%rank .EQ.0) & 1450 ! WRITE(op%ostream,*) "CTQMC K, op%mu = ",K,op%mu(iflavor) 1451 !WRITE(op%ostream,*) "CTQMC beta = ",op%beta 1452 1453 ! --- Compute F (by removing the levels) if opt_fk==0 1454 ! IF ( opt_fk .EQ. 0 ) THEN 1455 ! ! DO iomega = 1, op%Wmax 1456 ! ! re = REAL(F_omega(iomega,iflavor,iflavor2)) 1457 ! ! im = AIMAG(F_omega(iomega,iflavor,iflavor2)) 1458 ! ! if (iflavor==iflavor2) then 1459 ! ! F_omega(iomega,iflavor,iflavor) = CMPLX(re + K, im + (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, 8) 1460 ! ! else 1461 ! ! F_omega(iomega,iflavor,iflavor2) = CMPLX(re , im , 8) 1462 ! ! endif 1463 ! ! !if(iflavor==1.and.op%rank==0) then 1464 ! ! !write(224,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(F_omega(iomega,iflavor)),imag(F_omega(iomega,iflavor)) 1465 ! ! !write(225,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(Gomega_tmp(iomega, iflavor)),imag(Gomega_tmp(iomega, iflavor)) 1466 ! ! !end if 1467 ! ! END DO 1468 ! ELSE 1469 ! DO iomega = 1, op%Wmax 1470 ! !F_omega(iomega,iflavor,iflavor2) = F_omega(iomega,iflavor,iflavor2) + CMPLX(K, 0.d0, 8) 1471 1472 1473 ! !if(iflavor==1.and.op%rank==0) then 1474 ! !write(224,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(F_omega(iomega,iflavor)),imag(F_omega(iomega,iflavor)) 1475 ! !write(225,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(Gomega_tmp(iomega, iflavor)),imag(Gomega_tmp(iomega, iflavor)) 1476 ! !end if 1477 ! END DO 1478 ! END IF 1479 ! --- compute residual K (?) 1480 K = REAL(CMPLX(0,(2.d0*DBLE(op%Wmax)-1.d0)*pi_invBeta,8)*F_omega(op%Wmax,iflavor,iflavor2)) 1481 CALL GreenHyboffdiag_setMuD1(op%Greens,iflavor,iflavor2,op%mu(iflavor),K) 1482 END DO 1483 END DO 1484 1485 do iomega=1,op%Wmax 1486 ! write(336,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,1,1)),imag(F_omega(iomega,1,1)) 1487 enddo 1488 1489 ! --- Creates F_tmp%oper_w 1490 CALL GreenHyboffdiag_setOperW(F_tmp,F_omega) 1491 ! do iflavor=1, flavors ; do iflavor2=1, flavors ; write(337,*) "#",iflavor,iflavor2 ; do iomega=1,op%Wmax 1492 ! write(337,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2)),& 1493 !& imag(F_tmp%oper_w(iomega,iflavor,iflavor2)) 1494 ! enddo ; write(337,*) ; enddo ; enddo 1495 ! IF ( op%rank .EQ. 0 ) THEN 1496 ! DO iflavor = 1, flavors 1497 ! DO iflavor2 = 1, flavors 1498 ! write(336,*) "#",iflavor,iflavor2 1499 ! write(337,*) "#",iflavor,iflavor2 1500 ! do iomega=1,op%Wmax 1501 ! write(336,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2)) 1502 ! write(337,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_tmp%oper_w(iomega,iflavor,iflavor2)) 1503 ! enddo 1504 ! write(336,*) 1505 ! write(337,*) 1506 ! write(136,*) "#",iflavor,iflavor2 1507 ! write(137,*) "#",iflavor,iflavor2 1508 ! do iomega=1,op%Wmax 1509 ! write(136,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2)-op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta,kind=8))) 1510 ! write(137,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_tmp%oper_w(iomega,iflavor,iflavor2)-op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta,kind=8))) 1511 ! enddo 1512 ! write(136,*) 1513 ! write(137,*) 1514 ! write(836,*) "#",iflavor,iflavor2 1515 ! write(837,*) "#",iflavor,iflavor2 1516 ! do iomega=1,op%Wmax 1517 ! write(836,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta))) 1518 ! write(837,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta))) 1519 ! enddo 1520 ! write(836,*) 1521 ! write(837,*) 1522 ! END DO 1523 ! END DO 1524 ! ENDIF 1525 !CALL GreenHyboffdiag_backFourier(F_tmp,F_omega(:,iflavor)) 1526 ! DO iflavor = 1, flavors 1527 ! DO iflavor2 = 1, flavors 1528 ! unitnb=80000+F_tmp%rank 1529 ! call int2char4(F_tmp%rank,tag_proc) 1530 ! tmpfil = 'oper_wavantFOURIER'//tag_proc 1531 ! open (unit=unitnb,file=trim(tmpfil),status='unknown',form='formatted') 1532 ! write(unitnb,*) "#",iflavor,iflavor2 1533 ! ! C_omega et oper_w differents Domega identique. Est ce du a des 1534 ! ! diago differentes pour chaque procs dans qmc_prep_ctqmc 1535 ! do iomega=1,F_tmp%Wmax 1536 ! write(unitnb,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2)) 1537 ! enddo 1538 ! write(unitnb,*) 1539 ! END DO 1540 ! END DO 1541 1542 ! --- For all iflavor and iflavor2, do the Fourier transformation to 1543 ! --- have (F(\tau)) 1544 !CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=op%opt_hybri_limit) 1545 write(std_out,*) "WARNING opt_hybri_limit==0" 1546 CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=0) 1547 ! CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=1) 1548 ! CALL GreenHyboffdiag_backFourier(F_tmp) 1549 1550 ! --- Put the result in F 1551 DO iflavor = 1, flavors 1552 DO iflavor2 = 1, flavors 1553 DO itau=1,samples+1 1554 F(itau,iflavor,iflavor2) = -F_tmp%oper(samples+2-itau,iflavor,iflavor2) 1555 END DO 1556 END DO 1557 END DO 1558 ! IF ( op%rank .EQ. 0 ) THEN 1559 ! ifl=0 1560 ! DO iflavor = 1, flavors 1561 ! DO iflavor2 = 1, flavors 1562 ! ifl=ifl+1 1563 ! write(346,*) "#",iflavor,iflavor2,ifl 1564 ! do itau=1,op%samples+1 1565 ! write(346,*) itau,real(F(itau,iflavor,iflavor2)) 1566 ! enddo 1567 ! write(346,*) 1568 ! END DO 1569 ! END DO 1570 ! ENDIF 1571 ! close(346) 1572 DO iflavor = 1, flavors 1573 DO iflavor2 = 1, flavors 1574 DO itau=1,samples+1 1575 ! This symetrization is general and valid even with SOC 1576 ! Without SOC, it leads to zero. 1577 F(itau,iflavor,iflavor2) = -(F_tmp%oper(samples+2-itau,iflavor,iflavor2)+F_tmp%oper(samples+2-itau,iflavor2,iflavor))/2.d0 1578 END DO 1579 END DO 1580 END DO 1581 !DO iflavor = 1, flavors 1582 ! DO iflavor2 = 1, flavors 1583 ! DO itau=1,samples+1 1584 ! F(itau,iflavor,iflavor2) = F(samples/2,iflavor,iflavor2) 1585 ! END DO 1586 ! END DO 1587 !END DO 1588 1589 ! SOME TRY TO ADJUST F 1590 !DO iflavor = 1, flavors 1591 ! DO iflavor2 = 1, flavors 1592 ! do itau=1,op%samples+1 1593 ! !if(iflavor/=iflavor2) F(itau,iflavor,iflavor2)=F((op%samples+1)/2,iflavor,iflavor2) 1594 ! !if(iflavor==iflavor2) F(itau,iflavor,iflavor2)=F((op%samples+1)/2,iflavor,iflavor2) 1595 ! enddo 1596 ! END DO 1597 !END DO 1598 !write(6,*) "QQQQ1",op%rank 1599 1600 open (unit=436,file='Hybridization.dat',status='unknown',form='formatted') 1601 rewind(436) 1602 IF ( op%rank .EQ. 0 ) THEN 1603 ifl=0 1604 DO iflavor = 1, flavors 1605 DO iflavor2 = 1, flavors 1606 ifl=ifl+1 1607 write(436,*) "#",iflavor,iflavor2 !,ifl,op%hybri_limit(iflavor,iflavor2) 1608 do itau=1,op%samples+1 1609 write(436,*) itau,F(itau,iflavor,iflavor2) 1610 enddo 1611 write(436,*) 1612 END DO 1613 END DO 1614 ENDIF 1615 close(436) 1616 ! call xmpi_barrier(op%MY_COMM) 1617 !write(6,*) "QQQQ3" 1618 FREE(Gomega_tmp) 1619 FREE(F_omega) 1620 FREE(F_omega_inv) 1621 !write(6,*) "QQQQ4" 1622 CALL GreenHyboffdiag_destroy(F_tmp) 1623 !write(6,*) "QQQQ2" 1624 1625 1626 END SUBROUTINE Ctqmcoffdiag_computeF
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_destroy [ Functions ]
NAME
Ctqmcoffdiag_destroy
FUNCTION
destroy and deallocate all variables
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
4549 SUBROUTINE Ctqmcoffdiag_destroy(op) 4550 4551 !Arguments ------------------------------------ 4552 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 4553 !Local variables ------------------------------ 4554 !INTEGER :: iflavor 4555 INTEGER :: flavors 4556 INTEGER :: i 4557 INTEGER :: j 4558 INTEGER :: k 4559 4560 flavors = op%flavors 4561 4562 CALL ImpurityOperator_destroy(op%Impurity) 4563 CALL BathOperatoroffdiag_destroy(op%Bath) 4564 CALL Vector_destroy(op%measNoise(1)) 4565 CALL Vector_destroy(op%measNoise(2)) 4566 4567 !sui!write(6,*) "before greenhyb_destroy in ctmqc_destroy" 4568 CALL GreenHyboffdiag_destroy(op%Greens) 4569 !#ifdef CTCtqmcoffdiag_ANALYSIS 4570 FREEIF(op%measCorrelation) 4571 FREEIF(op%measPerturbation) 4572 FREEIF(op%meas_fullemptylines) 4573 FREEIF(op%measN) 4574 IF ( op%opt_histo .GT. 0 ) THEN 4575 FREEIF(op%occup_histo_time) 4576 END IF 4577 FREEIF(op%measDE) 4578 FREEIF(op%mu) 4579 FREEIF(op%hybri_limit) 4580 FREEIF(op%abNoiseG) 4581 IF ( ALLOCATED(op%measNoiseG) ) THEN 4582 DO i=1,2 4583 DO j = 1, op%flavors 4584 DO k= 1, op%samples+1 4585 CALL Vector_destroy(op%measNoiseG(k,j,i)) 4586 END DO 4587 END DO 4588 END DO 4589 DT_FREE(op%measNoiseG) 4590 END IF 4591 FREEIF(op%density) 4592 !#endif 4593 op%ostream = 0 4594 op%istream = 0 4595 4596 op%sweeps = 0 4597 op%thermalization = 0 4598 op%flavors = 0 4599 op%samples = 0 4600 op%beta = 0.d0 4601 ! op%seg_added = 0.d0 4602 ! op%anti_added = 0.d0 4603 ! op%seg_removed = 0.d0 4604 ! op%anti_removed = 0.d0 4605 ! op%seg_sign = 0.d0 4606 ! op%anti_sign = 0.d0 4607 op%stats = 0.d0 4608 op%swap = 0.d0 4609 4610 4611 op%set = .FALSE. 4612 op%done = .FALSE. 4613 op%init = .FALSE. 4614 END SUBROUTINE Ctqmcoffdiag_destroy
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getD [ Functions ]
NAME
Ctqmcoffdiag_getD
FUNCTION
get double occupation
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
D=full double occupation
SIDE EFFECTS
NOTES
SOURCE
3813 SUBROUTINE Ctqmcoffdiag_getD(op, D) 3814 3815 !Arguments ------------------------------------ 3816 TYPE(Ctqmcoffdiag) , INTENT(IN ) :: op 3817 DOUBLE PRECISION, INTENT(OUT) :: D 3818 !Local variables ------------------------------ 3819 INTEGER :: iflavor1 3820 INTEGER :: iflavor2 3821 3822 D = 0.d0 3823 3824 DO iflavor1 = 1, op%flavors 3825 DO iflavor2 = iflavor1+1, op%flavors 3826 D = D + op%measDE(iflavor2,iflavor1) 3827 END DO 3828 END DO 3829 !IF ( op%rank .EQ. 0 ) THEN 3830 ! DO iflavor1 = 1, op%flavors 3831 ! DO iflavor2 = iflavor1+1, op%flavors 3832 ! write(4533,*) op%measDE(iflavor2,iflavor1)k 3833 ! write(4534,*) op%Impurity%mat_U(iflavor2,iflavor1)k 3834 ! END DO 3835 ! END DO 3836 3837 !ENDIF 3838 3839 END SUBROUTINE Ctqmcoffdiag_getD
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getE [ Functions ]
NAME
Ctqmcoffdiag_getE
FUNCTION
get interaction energy and noise on it
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
E=interaction energy noise=noise on this value
SIDE EFFECTS
NOTES
SOURCE
3868 SUBROUTINE Ctqmcoffdiag_getE(op,E,noise) 3869 3870 !Arguments ------------------------------------ 3871 TYPE(Ctqmcoffdiag) , INTENT(IN ) :: op 3872 DOUBLE PRECISION, INTENT(OUT) :: E 3873 DOUBLE PRECISION, INTENT(OUT) :: Noise 3874 3875 E = op%measDE(1,1) 3876 Noise = op%a_Noise*(DBLE(op%sweeps)*DBLE(op%size))**op%b_Noise 3877 END SUBROUTINE Ctqmcoffdiag_getE
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getGreen [ Functions ]
NAME
Ctqmcoffdiag_getGreen
FUNCTION
Get the full green functions in time and/or frequency
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
Gtau=green function in time Gw=green function in frequency
SIDE EFFECTS
NOTES
SOURCE
3542 SUBROUTINE Ctqmcoffdiag_getGreen(op, Gtau, Gw) 3543 3544 !Arguments ------------------------------------ 3545 USE m_GreenHyboffdiag 3546 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 3547 DOUBLE PRECISION, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: Gtau 3548 COMPLEX(KIND=8), DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: Gw 3549 !Local variables ------------------------------ 3550 !INTEGER :: itime 3551 INTEGER :: iflavor1 3552 INTEGER :: iflavor1b !,iflavor,iflavorbis 3553 INTEGER :: iflavor2 3554 INTEGER :: iflavor3 3555 INTEGER :: flavors,tail 3556 INTEGER :: ifreq,itime 3557 DOUBLE PRECISION :: u1 3558 DOUBLE PRECISION :: u2 3559 DOUBLE PRECISION :: u3 3560 DOUBLE PRECISION :: Un 3561 DOUBLE PRECISION :: UUnn,iw !omega, 3562 CHARACTER(LEN=4) :: cflavors 3563 CHARACTER(LEN=50) :: string 3564 TYPE(GreenHyboffdiag) :: F_tmp 3565 3566 flavors = op%flavors 3567 DO iflavor1 = 1, flavors 3568 u1 = 0.d0 3569 u2 = 0.d0 3570 u3 = 0.d0 3571 DO iflavor2 = 1, flavors 3572 IF ( iflavor2 .EQ. iflavor1 ) CYCLE 3573 Un = op%Impurity%mat_U(iflavor2,iflavor1) * op%measN(1,iflavor2) 3574 ! Un = op%Impurity%mat_U(iflavor2,iflavor1) * (op%Greens%oper(1,iflavor2,iflavor2) + 1.d0) 3575 !write(6,*) "forsetmoments",iflavor1,iflavor2,(op%Greens%oper(1,iflavor2,iflavor2) + 1.d0), Un 3576 u1 = u1 + Un 3577 u2 = u2 + Un*op%Impurity%mat_U(iflavor2,iflavor1) 3578 DO iflavor3 = 1, flavors 3579 IF ( iflavor3 .EQ. iflavor2 .OR. iflavor3 .EQ. iflavor1 ) CYCLE 3580 UUnn = (op%Impurity%mat_U(iflavor2,iflavor1)*op%Impurity%mat_U(iflavor3,iflavor1)) * & 3581 & op%measDE(iflavor2,iflavor3) 3582 u2 = u2 + UUnn 3583 END DO 3584 END DO 3585 ! write(6,*) "u1,u2",u1,u2 3586 3587 DO iflavor1b = 1, flavors 3588 u3 =-(op%Impurity%mat_U(iflavor1,iflavor1b))*op%Greens%oper(1,iflavor1,iflavor1b) 3589 ! u3=U_{1,1b}*G_{1,1b} 3590 CALL GreenHyboffdiag_setMoments(op%Greens,iflavor1,iflavor1b,u1,u2,u3) 3591 END DO ! iflavor1b 3592 3593 END DO ! iflavor1 3594 3595 IF ( PRESENT( Gtau ) ) THEN 3596 DO iflavor1 = 1, flavors 3597 DO iflavor2 = 1, flavors 3598 Gtau(1:op%samples,iflavor1,iflavor2) = op%Greens%oper(1:op%samples,iflavor1,iflavor2) 3599 END DO 3600 END DO ! iflavor1 3601 END IF 3602 ! !--------- Write Occupation matrix before Gtau 3603 ! write(ostream,'(17x,a)') "Occupation matrix" 3604 ! write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors) 3605 ! write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors) 3606 ! do iflavor=1, op%flavors 3607 ! write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(-op%Greens%oper(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors) 3608 ! enddo 3609 ! write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10 3610 ! !------------------------------------------------------------------------------------------ 3611 ! !--------- Write Occupation matrix Gtau 3612 ! write(ostream,'(17x,a)') "Occupation matrix" 3613 ! write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors) 3614 ! write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors) 3615 ! do iflavor=1, op%flavors 3616 ! write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(Gtau(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors) 3617 ! enddo 3618 ! write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10 3619 ! !------------------------------------------------------------------------------------------ 3620 3621 !================================================ 3622 if(3==4) then 3623 !================================================ 3624 DO iflavor1 = 1, flavors 3625 DO iflavor1b = 1, flavors 3626 !call nfourier3(op%Greens%oper(1:op%samples,iflavor1,iflavor1b),Gw(1:op%samples,iflavor1,iflavor1b),iflavor1==iflavor1b,op%Greens%samples,op%Greens%samples-1,op%Greens%beta,1.d0,op%Greens%Mk(iflavor1,iflavor1b,1),op%Greens%Mk(iflavor1,iflavor1b,2),op%Greens%Mk(iflavor1,iflavor1b,3)) 3627 END DO 3628 END DO ! iflavor1 3629 ! ============== write Gomega_nd.dat 3630 if(op%rank==0) then 3631 OPEN(UNIT=44, FILE="Gomega_nd_nfourier2.dat") 3632 WRITE(cflavors,'(I4)') 2*(flavors*flavors+1) 3633 string = '(1x,'//TRIM(ADJUSTL(cflavors))//'E15.5)' 3634 !write(6,*) " op%Greens%Wmax", op%Greens%Wmax 3635 do iflavor1=1, flavors 3636 do iflavor1b=1, flavors 3637 write(44,*) "#op%Greens%Mk(iflavor1,iflavor2,1",op%Greens%Mk(iflavor1,iflavor1b,:) 3638 DO ifreq = 1, op%samples 3639 ! !write(6,string) (DBLE(ifreq)*2-1)*3.1415/op%Greens%beta, & 3640 ! (/ ((real(Gw(ifreq,iflavor1,iflavor1b)),imag(Gw(ifreq,iflavor1,iflavor1b)), iflavor1=1, flavors),iflavor1b=1,flavors) /) 3641 ! WRITE(44,string) (DBLE(ifreq)*2.d0-1.d0)*3.1415926/op%Greens%beta, & 3642 iw=aimag(Gw(ifreq,op%flavors,op%flavors+1)) 3643 WRITE(44,string) aimag(Gw(ifreq,op%flavors,op%flavors+1)),& 3644 real(Gw(ifreq,iflavor1,iflavor1b)),aimag(Gw(ifreq,iflavor1,iflavor1b)),& 3645 ( -op%Greens%Mk(iflavor1,iflavor1b,2) )/(iw*iw) , (op%Greens%Mk(iflavor1,iflavor1b,1))/iw!-op%Greens%Mk(iflavor1,iflavor1b,3)/(iw*iw))/iw 3646 ! WRITE(102,*) aimag(Gw(ifreq,op%flavors,op%flavors+1)), (op%Greens%Mk(iflavor1,iflavor1b,1))/iw,op%Greens%Mk(iflavor1,iflavor1b,1),iw 3647 END DO 3648 WRITE(44,*) 3649 END DO 3650 END DO 3651 close(44) 3652 endif 3653 !================================================ 3654 endif 3655 !================================================ 3656 !!write(6,*) "present gw", present(gw) 3657 IF ( PRESENT( Gw ) ) THEN 3658 !!write(6,*) "size gw",SIZE(Gw,DIM=2) ,flavors+1 3659 IF ( SIZE(Gw,DIM=3) .EQ. flavors+1 ) THEN 3660 ! CALL GreenHyboffdiag_forFourier(op%Greens, Gomega=Gw, omega=Gw(:,op%flavors,op%flavors+1)) 3661 CALL GreenHyboffdiag_forFourier(op%Greens, Gomega=Gw, omega=Gw(:,op%flavors,op%flavors+1)) 3662 !write(6,*) "1" 3663 !IF ( op%rank .EQ. 0 ) write(20,*) Gw(:,iflavor1) 3664 ELSE IF ( SIZE(Gw,DIM=3) .EQ. flavors ) THEN 3665 CALL GreenHyboffdiag_forFourier(op%Greens,Gomega=Gw) 3666 !write(6,*) "2" 3667 ELSE 3668 CALL WARNALL("Ctqmcoffdiag_getGreen : Gw is not valid ") 3669 CALL GreenHyboffdiag_forFourier(op%Greens,Wmax=op%Wmax) 3670 !write(6,*) "3" 3671 END IF 3672 ELSE 3673 CALL GreenHyboffdiag_forFourier(op%Greens,Wmax=op%Wmax) 3674 END IF 3675 ! ============== write Gomega_nd.dat 3676 !================================================ 3677 ! if(3==4) then 3678 !================================================ 3679 if(op%rank==0.and.3==4) then 3680 OPEN(UNIT=44, FILE="Gomega_nd.dat") 3681 WRITE(cflavors,'(I4)') 2*(flavors*flavors+1) 3682 string = '(1x,'//TRIM(ADJUSTL(cflavors))//'E15.5)' 3683 !write(6,*) " op%Greens%Wmax", op%Greens%Wmax 3684 do iflavor1=1, flavors 3685 do iflavor1b=1, flavors 3686 write(44,*) "#op%Greens%Mk(iflavor1,iflavor2,1",op%Greens%Mk(iflavor1,iflavor1b,:) 3687 DO ifreq = 1, SIZE(Gw,1) 3688 ! !write(6,string) (DBLE(ifreq)*2-1)*3.1415/op%Greens%beta, & 3689 ! (/ ((real(Gw(ifreq,iflavor1,iflavor1b)),imag(Gw(ifreq,iflavor1,iflavor1b)), iflavor1=1, flavors),iflavor1b=1,flavors) /) 3690 ! WRITE(44,string) (DBLE(ifreq)*2.d0-1.d0)*3.1415926/op%Greens%beta, & 3691 iw=aimag(Gw(ifreq,op%flavors,op%flavors+1)) 3692 WRITE(44,string) aimag(Gw(ifreq,op%flavors,op%flavors+1)),& 3693 real(Gw(ifreq,iflavor1,iflavor1b)),aimag(Gw(ifreq,iflavor1,iflavor1b)),& 3694 ( -op%Greens%Mk(iflavor1,iflavor1b,2) )/(iw*iw) , & 3695 & (op%Greens%Mk(iflavor1,iflavor1b,1)-op%Greens%Mk(iflavor1,iflavor1b,3)/(iw*iw))/iw 3696 END DO 3697 WRITE(44,*) 3698 END DO 3699 END DO 3700 endif 3701 !================================================ 3702 ! endif 3703 !================================================ 3704 3705 3706 ! ============================== 3707 ! --- Initialize F_tmp 3708 !write(6,*) "10" 3709 3710 IF ( op%have_MPI .EQV. .TRUE. ) THEN 3711 !CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,op%flavors,MY_COMM=op%MY_COMM) 3712 CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,flavors) 3713 !write(6,*) "10a" 3714 ELSE 3715 CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,flavors) 3716 !write(6,*) "10b" 3717 END IF 3718 3719 !write(6,*) "11" 3720 ! CALL GreenHyboffdiag_setOperW(F_tmp,Gw) 3721 3722 tail = op%samples 3723 F_tmp%Wmax=op%samples ! backFourier only works for linear freq: calculation of A and etc.. 3724 MALLOC(F_tmp%oper_w,(1:tail,op%flavors,op%flavors)) 3725 F_tmp%oper_w(1:tail,1:F_tmp%nflavors,1:F_tmp%nflavors) = Gw(1:tail,1:F_tmp%nflavors,1:F_tmp%nflavors) 3726 !write(6,*) "example",F_tmp%oper_w(1,1,1) 3727 !write(6,*) "example",Gw(1,1,1) 3728 F_tmp%setW = .TRUE. 3729 !write(6,*) size(F_tmp%oper_w,1) 3730 !write(6,*) size(F_tmp%oper_w,2) 3731 !write(6,*) size(F_tmp%oper_w,3) 3732 !write(6,*) size(Gw,1) 3733 !write(6,*) size(Gw,2) 3734 !write(6,*) size(Gw,3) 3735 3736 !write(6,*) "eee", (2.d0*DBLE(ifreq)-1.d0) * 3.1415/op%beta,real(F_tmp%oper_w(1,1,1)),imag(F_tmp%oper_w(1,1,1)) 3737 !================================================ 3738 if(3==4) then 3739 !================================================ 3740 OPEN(UNIT=3337, FILE="Gomega_nd2.dat") 3741 do iflavor1=1, flavors 3742 do iflavor1b=1, flavors 3743 do ifreq=1, tail 3744 ! write(3337,*) (2.d0*DBLE(ifreq)-1.d0) * 3.1415/op%beta,real(F_tmp%oper_w(ifreq,iflavor1,iflavor1b)),& 3745 ! & imag(F_tmp%oper_w(ifreq,iflavor1,iflavor1b)) 3746 write(3337,*) aimag(Gw(ifreq,op%flavors,op%flavors+1)), real(F_tmp%oper_w(ifreq,iflavor1,iflavor1b)),& 3747 & aimag(F_tmp%oper_w(ifreq,iflavor1,iflavor1b)) 3748 3749 ! omega=(2.d0*DBLE(ifreq)-1.d0) * 3.1415/op%beta 3750 ! F_tmp%oper_w(ifreq,iflavor1,iflavor1b)=0.1**2/Gw(ifreq,op%flavors,op%flavors+1) 3751 enddo 3752 write(3337,*) 3753 enddo 3754 enddo 3755 close(3337) 3756 !================================================ 3757 endif 3758 !================================================ 3759 3760 !write(6,*) "12",F_tmp%Wmax 3761 3762 ! CALL GreenHyboffdiag_backFourier(F_tmp,func="green") 3763 3764 !write(6,*) "13" 3765 3766 !================================================ 3767 if(3==4) then 3768 !================================================ 3769 OPEN(UNIT=48, FILE="Gtau_nd_2.dat") 3770 ! --- Print full non diagonal Gtau in Gtau_nd.dat 3771 WRITE(cflavors,'(I4)') flavors*flavors+1 3772 string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)' 3773 DO itime = 1, op%samples+1 3774 WRITE(48,string) DBLE(itime-1)*op%beta/DBLE(op%samples), & 3775 & ((F_tmp%oper(itime,iflavor1,iflavor1b), iflavor1=1, flavors),iflavor1b=1,flavors) 3776 END DO 3777 !================================================ 3778 endif 3779 !================================================ 3780 3781 CALL GreenHyboffdiag_destroy(F_tmp) 3782 3783 !FREE(F_tmp%oper_w) 3784 ! ============================== 3785 END SUBROUTINE Ctqmcoffdiag_getGreen
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getResult [ Functions ]
NAME
Ctqmcoffdiag_getResult
FUNCTION
reduce everything to get the result of the simulation
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
2938 SUBROUTINE Ctqmcoffdiag_getResult(op) 2939 2940 2941 #ifdef HAVE_MPI1 2942 include 'mpif.h' 2943 #endif 2944 !Arguments ------------------------------------ 2945 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 2946 !Local variables ------------------------------ 2947 INTEGER :: iflavor 2948 INTEGER :: flavors 2949 INTEGER :: itau 2950 INTEGER :: endDensity 2951 DOUBLE PRECISION :: inv_flavors 2952 DOUBLE PRECISION :: a 2953 DOUBLE PRECISION :: b 2954 DOUBLE PRECISION :: r 2955 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: alpha 2956 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: beta 2957 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: measN_1 2958 DOUBLE PRECISION, DIMENSION(1:2) :: TabX 2959 DOUBLE PRECISION, DIMENSION(1:2) :: TabY 2960 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: freqs 2961 INTEGER, ALLOCATABLE, DIMENSION(:) :: counts 2962 INTEGER, ALLOCATABLE, DIMENSION(:) :: displs 2963 INTEGER :: sp1 2964 INTEGER :: spAll 2965 INTEGER :: last 2966 INTEGER :: n1 2967 INTEGER :: n2 2968 INTEGER :: debut 2969 DOUBLE PRECISION :: signvaluemeassum 2970 ! INTEGER :: fin 2971 #ifdef HAVE_MPI 2972 INTEGER :: ierr 2973 #endif 2974 INTEGER :: sizeoper,nbprocs,myrank 2975 DOUBLE PRECISION :: inv_size,sumh 2976 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: buffer 2977 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: buffer2,buffer2s 2978 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: fullempty 2979 TYPE(FFTHyb) :: FFTmrka 2980 2981 IF ( .NOT. op%done ) & 2982 CALL ERROR("Ctqmcoffdiag_getResult : Simulation not run ") 2983 2984 flavors = op%flavors 2985 inv_flavors = 1.d0 / DBLE(flavors) 2986 2987 2988 inv_size = 1.d0 / DBLE(op%size) 2989 sp1 = 0 2990 spAll = 0 2991 2992 !#ifdef CTCtqmcoffdiag_CHECK 2993 IF ( op%opt_check .GT. 0 ) THEN 2994 op%errorImpurity = ImpurityOperator_getError(op%Impurity) * inv_flavors 2995 op%errorBath = BathOperatoroffdiag_getError (op%Bath ) * inv_flavors 2996 END IF 2997 !#endif 2998 2999 MALLOC(alpha,(1,1)) 3000 MALLOC(beta,(1,1)) 3001 MALLOC(buffer,(1,1)) 3002 IF ( op%opt_noise .EQ. 1) THEN 3003 FREEIF(alpha) 3004 MALLOC(alpha,(1:op%samples+1,1:flavors)) 3005 FREEIF(beta) 3006 MALLOC(beta,(1:op%samples+1,1:flavors)) 3007 END IF 3008 3009 IF ( op%have_MPI .EQV. .TRUE.) THEN 3010 sp1 = 0 3011 spAll = sp1 + flavors + 6 3012 3013 !#ifdef CTCtqmcoffdiag_ANALYSIS 3014 IF ( op%opt_analysis .EQ. 1 ) & 3015 spAll = spAll + 3*sp1 3016 IF ( op%opt_order .GT. 0 ) & 3017 spAll = spAll + op%opt_order 3018 IF ( op%opt_noise .EQ. 1 ) & 3019 spAll = spAll + 2*(op%samples + 1) 3020 !#endif 3021 3022 FREEIF(buffer) 3023 MALLOC(buffer,(1:spAll,1:MAX(2,flavors))) 3024 END IF 3025 3026 ! op%seg_added = op%seg_added * inv_flavors 3027 ! op%seg_removed = op%seg_removed * inv_flavors 3028 ! op%seg_sign = op%seg_sign * inv_flavors 3029 ! op%anti_added = op%anti_added * inv_flavors 3030 ! op%anti_removed = op%anti_removed * inv_flavors 3031 ! op%anti_sign = op%anti_sign * inv_flavors 3032 op%stats(:) = op%stats(:) * inv_flavors 3033 3034 DO iflavor = 1, flavors 3035 ! Accumulate last values of N (see also ctqmc_measn) 3036 op%measN(1,iflavor) = op%measN(1,iflavor) + op%measN(3,iflavor)*op%measN(4,iflavor) 3037 op%measN(2,iflavor) = op%measN(2,iflavor) + op%measN(4,iflavor) 3038 ! Reduction 3039 op%measN(1,iflavor) = op%measN(1,iflavor) / ( op%measN(2,iflavor) * op%beta ) 3040 ! Correction 3041 !#ifdef CTCtqmcoffdiag_ANALYSIS 3042 IF ( op%opt_order .GT. 0 ) & 3043 op%measPerturbation(: ,iflavor) = op%measPerturbation(:,iflavor) & 3044 / SUM(op%measPerturbation(:,iflavor)) 3045 IF ( op%opt_order .GT. 0 ) & 3046 op%meas_fullemptylines(: ,iflavor) = op%meas_fullemptylines(:,iflavor) & 3047 / SUM(op%meas_fullemptylines(:,iflavor)) 3048 !write(6,*) "sum fullempty",iflavor,op%meas_fullemptylines(:,iflavor) 3049 3050 IF ( op%opt_analysis .EQ. 1 ) THEN 3051 op%measCorrelation (:,1,iflavor) = op%measCorrelation (:,1,iflavor) & 3052 / SUM(op%measCorrelation (:,1,iflavor)) & 3053 * op%inv_dt 3054 op%measCorrelation (:,2,iflavor) = op%measCorrelation (:,2,iflavor) & 3055 / SUM(op%measCorrelation (:,2,iflavor)) & 3056 * op%inv_dt 3057 op%measCorrelation (:,3,iflavor) = op%measCorrelation (:,3,iflavor) & 3058 / SUM(op%measCorrelation (:,3,iflavor)) & 3059 * op%inv_dt 3060 END IF 3061 !#endif 3062 IF ( op%opt_noise .EQ. 1 ) THEN 3063 TabX(1) = DBLE(op%modNoise2) 3064 TabX(2) = DBLE(op%modNoise1) 3065 DO itau = 1, op%samples+1 3066 op%measNoiseG(itau,iflavor,2)%vec = -op%measNoiseG(itau,iflavor,2)%vec*op%inv_dt & 3067 /(op%beta*DBLE(op%modNoise2)) 3068 op%measNoiseG(itau,iflavor,1)%vec = -op%measNoiseG(itau,iflavor,1)%vec*op%inv_dt & 3069 /(op%beta*DBLE(op%modNoise1)) 3070 n2 = op%measNoiseG(itau,iflavor,2)%tail 3071 TabY(1) = Stat_deviation(op%measNoiseG(itau,iflavor,2)%vec(1:n2))!*SQRT(n2/(n2-1)) 3072 n1 = op%measNoiseG(itau,iflavor,1)%tail 3073 TabY(2) = Stat_deviation(op%measNoiseG(itau,iflavor,1)%vec(1:n1))!*SQRT(n1/(n1-1)) 3074 CALL Stat_powerReg(TabX,SQRT(2.d0*LOG(2.d0))*TabY,alpha(itau,iflavor),beta(itau,iflavor),r) 3075 ! ecart type -> 60% 3076 ! largeur a mi-hauteur d'une gaussienne -> sqrt(2*ln(2))*sigma 3077 END DO 3078 END IF 3079 3080 END DO 3081 !sui!write(6,*) "getresults" 3082 CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, .TRUE.,op%signvalue) 3083 CALL GreenHyboffdiag_getHybrid(op%Greens) 3084 ! write(6,*) "op%measN",op%measN(1,:) 3085 MALLOC(measN_1,(flavors)) 3086 do iflavor=1,flavors 3087 measN_1(iflavor)=op%measN(1,iflavor) 3088 enddo 3089 CALL GreenHyboffdiag_setN(op%Greens, measN_1(:)) 3090 FREE(measN_1) 3091 3092 ! todoab case _nd and _d are not completely described. 3093 FREEIF(buffer2) 3094 FREEIF(buffer2s) 3095 sizeoper=size(op%Greens%oper,1) 3096 !write(6,*) "sss",size(op%Greens%oper,1),sizeoper 3097 !write(6,*) "sss",size(op%Greens%oper,2),flavors 3098 !write(6,*) "sss",size(op%Greens%oper,3),flavors 3099 MALLOC(buffer2,(1:sizeoper,flavors,flavors)) 3100 MALLOC(buffer2s,(1:sizeoper,flavors,flavors)) 3101 MALLOC(fullempty,(2,flavors)) 3102 !sui!write(6,*) "greens1" 3103 IF ( op%have_MPI .EQV. .TRUE. ) THEN 3104 !sui!write(6,*) "greens2" 3105 fullempty=0.d0 3106 buffer2 = op%Greens%oper 3107 !write(6,*) "buffer2",(op%Greens%oper(1,n1,n1),n1=1,flavors) 3108 buffer2s= 0.d0 3109 do iflavor=1,flavors 3110 do itau=1,sizeoper 3111 !sui!write(6,*) "greens",iflavor,itau,op%Greens%oper(itau,iflavor,iflavor) 3112 enddo 3113 enddo 3114 !write(6,*) "beforempi",op%Greens%oper(1,1,1) ,buffer2(1,1,1) 3115 #ifdef HAVE_MPI 3116 CALL MPI_COMM_SIZE(op%MY_COMM,nbprocs,ierr) 3117 CALL MPI_COMM_RANK(op%MY_COMM,myrank,ierr) 3118 #endif 3119 !write(6,*) "procs",nbprocs,myrank 3120 END IF 3121 last = sp1 3122 3123 op%measDE(:,:) = op%measDE(:,:) * DBLE(op%measurements) /(DBLE(op%sweeps)*op%beta) 3124 3125 IF ( op%opt_histo .GT. 0 ) THEN 3126 op%occup_histo_time(:) = op%occup_histo_time(:) / INT(op%sweeps/op%measurements) 3127 END IF 3128 ! HISTO before MPI_SUM 3129 ! write(6,*) "=== Histogram of occupations for complete simulation 3 ====",INT(op%sweeps/op%measurements) 3130 ! sumh=0 3131 ! do n1=1,op%flavors+1 3132 ! write(6,'(i4,f10.4)') n1-1, op%occup_histo_time(n1) 3133 ! sumh=sumh+op%occup_histo_time(n1) 3134 ! enddo 3135 ! write(6,*) "=================================",sumh 3136 3137 n1 = op%measNoise(1)%tail 3138 n2 = op%measNoise(2)%tail 3139 3140 ! On utilise freqs comme tableau de regroupement 3141 ! Gather de Noise1 3142 IF ( op%have_MPI .EQV. .TRUE. ) THEN 3143 MALLOC(counts,(1:op%size)) 3144 MALLOC(displs,(1:op%size)) 3145 FREEIF(freqs) 3146 MALLOC(freqs,(1:op%size*n1)) 3147 freqs = 0.d0 3148 freqs(n1*op%rank+1:n1*(op%rank+1)) = op%measNoise(1)%vec(1:n1) 3149 counts(:) = n1 3150 displs(:) = (/ ( iflavor*n1, iflavor=0, op%size-1 ) /) 3151 #ifdef HAVE_MPI 3152 CALL MPI_ALLGATHERV(MPI_IN_PLACE, 0, MPI_DOUBLE_PRECISION, & 3153 freqs, counts, displs, & 3154 MPI_DOUBLE_PRECISION, op%MY_COMM, ierr) 3155 #endif 3156 n1 = op%size*n1 3157 CALL Vector_setSize(op%measNoise(1),n1) 3158 op%measNoise(1)%vec(1:n1) = freqs(:) 3159 ! Gather de Noise2 3160 FREE(freqs) 3161 MALLOC(freqs,(1:op%size*n2)) 3162 freqs = 0.d0 3163 freqs(n2*op%rank+1:n2*(op%rank+1)) = op%measNoise(2)%vec(1:n2) 3164 counts(:) = n2 3165 displs(:) = (/ ( iflavor*n2, iflavor=0, op%size-1 ) /) 3166 #ifdef HAVE_MPI 3167 CALL MPI_ALLGATHERV(MPI_IN_PLACE, 0, MPI_DATATYPE_NULL, & 3168 freqs, counts, displs, & 3169 MPI_DOUBLE_PRECISION, op%MY_COMM, ierr) 3170 #endif 3171 n2 = op%size*n2 3172 CALL Vector_setSize(op%measNoise(2),n2) 3173 op%measNoise(2)%vec(1:n2) = freqs(:) 3174 FREE(counts) 3175 FREE(displs) 3176 FREE(freqs) 3177 END IF 3178 !n1 = op%measNoise(1)%tail 3179 !n2 = op%measNoise(2)%tail 3180 3181 ! Transformation des paquets pour que ca fit a CTQMC_SLICE(1|2) 3182 IF ( n1 .GT. CTQMC_SLICE1 ) THEN 3183 itau = n1/CTQMC_SLICE1 3184 MALLOC(freqs,(1:n1/itau)) 3185 DO debut=1, n1/itau 3186 freqs(debut)=SUM(op%measNoise(1)%vec((debut-1)*itau+1:itau*debut)) 3187 END DO 3188 freqs(:) = freqs(:)/DBLE(itau) 3189 op%modNoise1 = op%modNoise1*itau 3190 n1 = n1/itau 3191 CALL Vector_setSize(op%measNoise(1),n1) 3192 op%measNoise(1)%vec(1:n1) = freqs(:) 3193 FREE(freqs) 3194 END IF 3195 IF ( n2 .GT. CTQMC_SLICE1*CTQMC_SLICE2 ) THEN 3196 itau = n2/(CTQMC_SLICE1*CTQMC_SLICE2) 3197 MALLOC(freqs,(1:n2/itau)) 3198 DO debut=1, n2/itau 3199 freqs(debut)=SUM(op%measNoise(2)%vec((debut-1)*itau+1:itau*debut)) 3200 END DO 3201 freqs(:) = freqs(:)/DBLE(itau) 3202 op%modNoise2 = op%modNoise2*itau 3203 n2 = n2/itau 3204 CALL Vector_setSize(op%measNoise(2),n2) 3205 op%measNoise(2)%vec(1:n2) = freqs(:) 3206 FREE(freqs) 3207 END IF 3208 ! On peut s'amuser avec nos valeur d'energies 3209 !MALLOC(TabX,(1:20)) 3210 !MALLOC(TabY,(1:20)) 3211 3212 TabX(1) = DBLE(op%modNoise2) 3213 TabX(2) = DBLE(op%modNoise1) 3214 3215 ! Il faut calculer pour chaque modulo 10 ecarts type sur les donnes acquises 3216 op%measNoise(1)%vec(1:n1) = op%measNoise(1)%vec(1:n1)/(op%beta*DBLE(op%modNoise1))*DBLE(op%measurements) 3217 op%measNoise(2)%vec(1:n2) = op%measNoise(2)%vec(1:n2)/(op%beta*DBLE(op%modNoise2))*DBLE(op%measurements) 3218 ! CALL Vector_print(op%measNoise(1),op%rank+70) 3219 ! CALL Vector_print(op%measNoise(2),op%rank+50) 3220 ! DO iflavor=1,10 3221 ! debut = (iflavor-1)*n2/10+1 3222 ! fin = iflavor*n2/10 3223 ! TabY(iflavor) = Stat_deviation(op%measNoise(2)%vec(debut:fin)) 3224 ! debut = (iflavor-1)*n1/10+1 3225 ! fin = iflavor*n1/10 3226 ! TabY(10+iflavor) = Stat_deviation(op%measNoise(1)%vec(debut:fin)) 3227 ! END DO 3228 !! TabY(1:n) = (op%measNoise(2)%vec(1:n) & 3229 !! ) 3230 !! !/(op%beta*DBLE(op%modNoise2))*DBLE(op%measurements) & 3231 !! !- op%measDE(1,1)) 3232 !! TabY(op%measNoise(2)%tail+1:n+op%measNoise(2)%tail) = (op%measNoise(1)%vec(1:n) & 3233 !! ) 3234 !! ! /(op%beta*DBLE(op%modNoise1))*DBLE(op%measurements) & 3235 !! ! - op%measDE(1,1)) 3236 ! IF ( op%rank .EQ. 0 ) THEN 3237 ! DO iflavor=1,20 3238 ! write(45,*) TabX(iflavor), TabY(iflavor) 3239 ! END DO 3240 ! END IF 3241 ! 3242 3243 3244 TabY(1) = Stat_deviation(op%measNoise(2)%vec(1:n2))!*SQRT(n2/(n2-1)) 3245 !! write(op%rank+10,*) TabX(2) 3246 !! write(op%rank+40,*) TabX(1) 3247 !! CALL Vector_print(op%measNoise(1),op%rank+10) 3248 !! CALL Vector_print(op%measNoise(2),op%rank+40) 3249 !! CLOSE(op%rank+10) 3250 !! CLOSE(op%rank+40) 3251 TabY(2) = Stat_deviation(op%measNoise(1)%vec(1:n1))!*SQRT(n1/(n1-1)) 3252 !! ! Ecart carre moyen ~ ecart type mais non biaise. Serait moins precis. Aucun 3253 ! impact sur la pente, juste sur l'ordonnee a l'origine. 3254 3255 CALL Stat_powerReg(TabX,SQRT(2.d0*LOG(2.d0))*TabY,a,b,r) 3256 ! FREE(TabX) 3257 ! FREE(TabY) 3258 ! ecart type -> 60% 3259 ! largeur a mi-hauteur d'une gaussienne -> sqrt(2*ln(2))*sigma 3260 3261 !op%measDE(1,1) = SUM(op%measNoise(1)%vec(1:op%measNoise(1)%tail))/(DBLE(op%measNoise(1)%tail*op%modNoise1)*op%beta) 3262 !op%measDE(2:flavors,1:flavors) = op%measDE(2:flavors,1:flavors) /(DBLE(op%sweeps)*op%beta) 3263 CALL ImpurityOperator_getErrorOverlap(op%Impurity,op%measDE) 3264 ! Add the difference between true calculation and quick calculation of the 3265 ! last sweep overlap to measDE(2,2) 3266 !op%measDE = op%measDE * DBLE(op%measurements) 3267 IF ( op%have_MPI .EQV. .TRUE. ) THEN 3268 IF ( op%opt_analysis .EQ. 1 ) THEN 3269 buffer(last+1:last+sp1,:) = op%measCorrelation(:,1,:) 3270 last = last + sp1 3271 buffer(last+1:last+sp1,:) = op%measCorrelation(:,2,:) 3272 last = last + sp1 3273 buffer(last+1:last+sp1,:) = op%measCorrelation(:,3,:) 3274 last = last + sp1 3275 END IF 3276 IF ( op%opt_order .GT. 0 ) THEN 3277 buffer(last+1:last+op%opt_order, :) = op%measPerturbation(:,:) 3278 last = last + op%opt_order 3279 END IF 3280 IF ( op%opt_noise .EQ. 1 ) THEN 3281 buffer(last+1:last+op%samples+1,:) = alpha(:,:) 3282 last = last + op%samples + 1 3283 buffer(last+1:last+op%samples+1,:) = beta(:,:) 3284 last = last + op%samples + 1 3285 END IF 3286 ! op%measDE(2,2) = a*EXP(b*LOG(DBLE(op%sweeps*op%size))) 3287 buffer(spall-(flavors+5):spAll-6,:) = op%measDE(:,:) 3288 ! buffer(spAll ,1) = op%seg_added 3289 ! buffer(spAll-1,1) = op%seg_removed 3290 ! buffer(spAll-2,1) = op%seg_sign 3291 ! buffer(spAll ,2) = op%anti_added 3292 ! buffer(spAll-1,2) = op%anti_removed 3293 ! buffer(spAll-2,2) = op%anti_sign 3294 buffer(spAll ,1) = op%stats(1) 3295 buffer(spAll-1,1) = op%stats(2) 3296 buffer(spAll-2,1) = op%stats(3) 3297 buffer(spAll ,2) = op%stats(4) 3298 buffer(spAll-1,2) = op%stats(5) 3299 buffer(spAll-2,2) = op%stats(6) 3300 buffer(spAll-3,1) = op%swap 3301 buffer(spAll-3,2) = DBLE(op%modGlobalMove(2)) 3302 buffer(spAll-4,1) = a 3303 buffer(spAll-4,2) = b 3304 !#ifdef CTCtqmcoffdiag_CHECK 3305 buffer(spAll-5,1) = op%errorImpurity 3306 buffer(spAll-5,2) = op%errorBath 3307 signvaluemeassum = 0 3308 !#endif 3309 3310 #ifdef HAVE_MPI 3311 !write(6,*) "bufferbefore",buffer(1,1) 3312 CALL MPI_ALLREDUCE(MPI_IN_PLACE, buffer, spAll*flavors, & 3313 MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr) 3314 !write(6,*) "bufferafter",buffer(1,1) 3315 ! CALL MPI_ALLREDUCE(MPI_IN_PLACE, buffer2, sp1*flavors*flavors, & 3316 ! MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr) 3317 CALL MPI_ALLREDUCE( buffer2, buffer2s, sizeoper*flavors*flavors, & 3318 MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr) 3319 !write(6,*) "justaftermpi",op%Greens%oper(1,1,1) ,buffer2s(1,1,1) 3320 CALL MPI_ALLREDUCE(MPI_IN_PLACE, op%runTime, 1, MPI_DOUBLE_PRECISION, MPI_MAX, & 3321 op%MY_COMM, ierr) 3322 CALL MPI_ALLREDUCE(op%Greens%signvaluemeas, signvaluemeassum , 1, MPI_DOUBLE_PRECISION, MPI_SUM, & 3323 op%MY_COMM, ierr) 3324 IF ( op%opt_histo .GT. 0 ) THEN 3325 CALL MPI_ALLREDUCE(MPI_IN_PLACE, op%occup_histo_time, flavors+1, MPI_DOUBLE_PRECISION, MPI_SUM, & 3326 op%MY_COMM, ierr) 3327 END IF 3328 CALL MPI_ALLREDUCE(MPI_IN_PLACE, sumh, 1, MPI_DOUBLE_PRECISION, MPI_SUM, & 3329 op%MY_COMM, ierr) 3330 IF ( op%opt_order .GT. 0 ) THEN 3331 CALL MPI_ALLREDUCE(op%meas_fullemptylines, fullempty, 2*flavors, MPI_DOUBLE_PRECISION, MPI_SUM, & 3332 op%MY_COMM, ierr) 3333 ENDIF 3334 #endif 3335 3336 3337 buffer = buffer * inv_size 3338 op%measDE(:,:) = buffer(spall-(flavors+5):spAll-6,:) 3339 ! op%seg_added = buffer(spAll ,1) 3340 ! op%seg_removed = buffer(spAll-1,1) 3341 ! op%seg_sign = buffer(spAll-2,1) 3342 ! op%anti_added = buffer(spAll ,2) 3343 ! op%anti_removed = buffer(spAll-1,2) 3344 ! op%anti_sign = buffer(spAll-2,2) 3345 op%stats(1) = buffer(spAll ,1) 3346 op%stats(2) = buffer(spAll-1,1) 3347 op%stats(3) = buffer(spAll-2,1) 3348 op%stats(4) = buffer(spAll ,2) 3349 op%stats(5) = buffer(spAll-1,2) 3350 op%stats(6) = buffer(spAll-2,2) 3351 op%swap = buffer(spAll-3,1) 3352 op%modGlobalMove(2) = NINT(buffer(spAll-3,2)) 3353 a = buffer(spAll-4,1) 3354 b = buffer(spAll-4,2) 3355 !!#ifdef CTCtqmcoffdiag_CHECK 3356 op%errorImpurity= buffer(spAll-5,1) 3357 op%errorBath = buffer(spAll-5,2) 3358 !#endif 3359 3360 ! DO iflavor = 1, flavors 3361 ! op%Greens(iflavor)%oper = buffer(1:sp1 , iflavor) 3362 ! END DO 3363 op%Greens%oper = buffer2s/float(nbprocs) 3364 ! write(6,*) "buffer2s",(op%Greens%oper(1,n1,n1),n1=1,flavors) 3365 op%Greens%signvaluemeas = signvaluemeassum/float(nbprocs) 3366 !sui!write(6,*) "nbprocs",nbprocs,op%Greens%signvaluemeas 3367 op%Greens%oper = op%Greens%oper / op%Greens%signvaluemeas 3368 ! write(6,*) "buffer3s",(op%Greens%oper(1,n1,n1),n1=1,flavors) 3369 IF ( op%opt_order .GT. 0 ) THEN 3370 op%meas_fullemptylines= fullempty/float(nbprocs) 3371 ENDIF 3372 do iflavor=1,flavors 3373 do itau=1,sizeoper 3374 !sui!write(6,*) "greens_av",iflavor,itau,op%Greens%oper(itau,iflavor,iflavor) 3375 enddo 3376 enddo 3377 !write(6,*) "aftermpi",op%Greens%oper(1,1,1) ,buffer2s(1,1,1) 3378 last = sp1 3379 IF ( op%opt_analysis .EQ. 1 ) THEN 3380 op%measCorrelation(:,1,:) = buffer(last+1:last+sp1,:) 3381 last = last + sp1 3382 op%measCorrelation(:,2,:) = buffer(last+1:last+sp1,:) 3383 last = last + sp1 3384 op%measCorrelation(:,3,:) = buffer(last+1:last+sp1,:) 3385 last = last + sp1 3386 END IF 3387 IF ( op%opt_order .GT. 0 ) THEN 3388 op%measPerturbation(:,:) = buffer(last+1:last+op%opt_order, :) 3389 last = last + op%opt_order 3390 END IF 3391 IF ( op%opt_noise .EQ. 1 ) THEN 3392 alpha(:,:) = buffer(last+1:last+op%samples+1,:) 3393 last = last + op%samples + 1 3394 beta(:,:) = buffer(last+1:last+op%samples+1,:) 3395 last = last + op%samples + 1 3396 END IF 3397 END IF 3398 DO iflavor = 1, flavors 3399 ! complete DE matrix 3400 op%measDE(iflavor, iflavor+1:flavors) = op%measDE(iflavor+1:flavors,iflavor) 3401 END DO 3402 FREE(buffer) 3403 FREE(buffer2) 3404 FREE(buffer2s) 3405 FREE(fullempty) 3406 3407 IF ( op%opt_spectra .GE. 1 ) THEN 3408 endDensity = SIZE(op%density,2) 3409 IF ( op%density(1,endDensity) .EQ. -1.d0 ) & 3410 endDensity = endDensity - 1 3411 CALL FFTHyb_init(FFTmrka,endDensity,DBLE(op%thermalization)/DBLE(op%measurements*op%opt_spectra)) 3412 ! Not very Beauty 3413 MALLOC(freqs,(1:FFTmrka%size/2)) 3414 DO iflavor = 1, flavors 3415 ! mean value is removed to supress the continue composent 3416 CALL FFTHyb_setData(FFTmrka,op%density(iflavor,1:endDensity)/op%beta+op%Greens%oper(op%samples+1,iflavor,iflavor)) 3417 CALL FFTHyb_run(FFTmrka,1) 3418 CALL FFTHyb_getData(FFTmrka,endDensity,op%density(iflavor,:),freqs) 3419 END DO 3420 op%density(flavors+1,:) = -1.d0 3421 op%density(flavors+1,1:FFTmrka%size/2) = freqs 3422 CALL FFTHyb_destroy(FFTmrka) 3423 FREE(freqs) 3424 END IF 3425 3426 op%a_Noise = a 3427 op%b_Noise = b 3428 IF ( op%opt_noise .EQ. 1 ) THEN 3429 op%abNoiseG(1,:,:) = alpha 3430 op%abNoiseG(2,:,:) = beta 3431 END IF 3432 FREE(alpha) 3433 FREE(beta) 3434 IF ( op%opt_histo .GT. 0 ) THEN 3435 write(op%ostream,*) "=== Histogram of occupations for complete simulation ====" 3436 ! write(6,*) "sumh over procs", sumh 3437 sumh=0 3438 do n1=1,op%flavors+1 3439 write(op%ostream,'(i4,f10.4)') n1-1, op%occup_histo_time(n1)/float(nbprocs) 3440 sumh=sumh+op%occup_histo_time(n1)/float(nbprocs) 3441 enddo 3442 write(op%ostream,'(a,f10.4)') " all" , sumh 3443 write(op%ostream,*) "=================================" 3444 END IF 3445 3446 END SUBROUTINE Ctqmcoffdiag_getResult
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_init [ Functions ]
NAME
Ctqmcoffdiag_init
FUNCTION
Initialize the type Ctqmcoffdiag Allocate all the non optional variables
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc ostream=where to write istream=where to read the input parameters if so bFile=logical argument True if input is read from istream MY_COMM=mpi communicator for the CTQMC iBuffer=input parameters if bFile is false
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
324 SUBROUTINE Ctqmcoffdiag_init(op, ostream, istream, bFile, MY_COMM, iBuffer) 325 326 327 #ifdef HAVE_MPI1 328 include 'mpif.h' 329 #endif 330 !Arguments ------------------------------------ 331 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 332 INTEGER , INTENT(IN ) :: ostream 333 INTEGER , INTENT(IN ) :: istream 334 LOGICAL , INTENT(IN ) :: bFile 335 DOUBLE PRECISION, DIMENSION(1:10), OPTIONAL, INTENT(IN) :: iBuffer 336 INTEGER , OPTIONAL, INTENT(IN ) :: MY_COMM 337 !Local variables ------------------------------ 338 #ifdef HAVE_MPI 339 INTEGER :: ierr 340 #endif 341 !INTEGER :: iflavor 342 #ifdef __GFORTRAN__ 343 ! INTEGER :: pid 344 ! CHARACTER(LEN=5) :: Cpid 345 ! 346 #endif 347 DOUBLE PRECISION, DIMENSION(1:10) :: buffer 348 349 op%ostream = ostream 350 op%istream = istream 351 352 ! --- RENICE --- 353 !#ifdef __GFORTRAN__ 354 ! pid = GetPid() 355 ! WRITE(Cpid,'(I5)') pid 356 ! CALL SYSTEM('renice +19 '//TRIM(ADJUSTL(Cpid))//' > /dev/null') 357 !#endif 358 !! --- RENICE --- 359 360 IF ( PRESENT(MY_COMM)) THEN 361 #ifdef HAVE_MPI 362 op%have_MPI = .TRUE. 363 op%MY_COMM = MY_COMM 364 CALL MPI_Comm_rank(op%MY_COMM, op%rank, ierr) 365 CALL MPI_Comm_size(op%MY_COMM, op%size, ierr) 366 #else 367 CALL WARN("MPI is not used ") 368 op%have_MPI = .FALSE. 369 op%MY_COMM = -1 370 op%rank = 0 371 op%size = 1 372 #endif 373 ELSE 374 op%have_MPI = .FALSE. 375 op%MY_COMM = -1 376 op%rank = 0 377 op%size = 1 378 END IF 379 380 !IF ( op%rank .EQ. 0 ) THEN 381 ! WRITE(ostream,'(A20)') 'Job reniced with +19' 382 !CALL FLUSH(ostream) 383 !END IF 384 385 IF ( bFile .EQV. .TRUE. ) THEN 386 IF ( op%rank .EQ. 0 ) THEN 387 388 READ(istream,*) buffer(1) !iseed 389 READ(istream,*) buffer(2) !op%sweeps 390 READ(istream,*) buffer(3) !op%thermalization 391 READ(istream,*) buffer(4) !op%measurements 392 READ(istream,*) buffer(5) !op%flavors 393 READ(istream,*) buffer(6) !op%samples 394 READ(istream,*) buffer(7) !op%beta 395 READ(istream,*) buffer(8) !U 396 READ(istream,*) buffer(9) !iTech 397 !READ(istream,*) buffer(9) !Wmax 398 !#ifdef CTCtqmcoffdiag_ANALYSIS 399 !READ(istream,*) buffer(10) !order 400 !#endif 401 END IF 402 403 #ifdef HAVE_MPI 404 IF ( op%have_MPI .EQV. .TRUE. ) & 405 CALL MPI_Bcast(buffer, 10, MPI_DOUBLE_PRECISION, 0, & 406 op%MY_COMM, ierr) 407 #endif 408 ELSE IF ( PRESENT(iBuffer) ) THEN 409 buffer(1:10) = iBuffer(1:10) 410 ELSE 411 CALL ERROR("Ctqmcoffdiag_init : No input parameters ") 412 END IF 413 414 CALL Ctqmcoffdiag_setParameters(op, buffer) 415 416 CALL Ctqmcoffdiag_allocateAll(op) 417 418 CALL GreenHyboffdiag_init(op%Greens,op%samples, op%beta,INT(buffer(5)), & 419 iTech=INT(buffer(9)),MY_COMM=op%MY_COMM) 420 421 422 ! op%seg_added = 0.d0 423 ! op%anti_added = 0.d0 424 ! op%seg_removed = 0.d0 425 ! op%anti_removed = 0.d0 426 ! op%seg_sign = 0.d0 427 ! op%anti_sign = 0.d0 428 op%stats(:) = 0.d0 429 ! write(std_out,*) "op%stats",op%stats 430 op%signvalue = 1.d0 431 ! op%signvaluecurrent = 0.d0 432 ! op%signvaluemeas = 0.d0 433 op%swap = 0.d0 434 op%runTime = 0.d0 435 436 CALL Vector_init(op%measNoise(1),op%sweeps/op%modNoise1) 437 CALL Vector_init(op%measNoise(2),(op%sweeps/op%modNoise1+1)*CTQMC_SLICE2) 438 !CALL Vector_init(op%measNoise(3),101) 439 !CALL Vector_init(op%measNoise(4),101) 440 441 op%set = op%para .AND. op%inF 442 op%done = .FALSE. 443 op%init = .TRUE. 444 445 !#ifdef CTCtqmcoffdiag_CHECK 446 op%errorImpurity = 0.d0 447 op%errorBath = 0.d0 448 !#endif 449 END SUBROUTINE Ctqmcoffdiag_init
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_loop [ Functions ]
NAME
Ctqmcoffdiag_loop
FUNCTION
Definition the main loop of the CT-QMC
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc itotal=number of sweeps to perform : thermalization or sweeps ilatex=unit of file to write movie if so
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1877 SUBROUTINE Ctqmcoffdiag_loop(op,itotal,ilatex) 1878 1879 !Arguments ------------------------------------ 1880 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 1881 INTEGER , INTENT(IN ) :: itotal 1882 INTEGER , INTENT(IN ) :: ilatex 1883 !Local variables ------------------------------ 1884 LOGICAL :: updated 1885 LOGICAL :: updated_seg 1886 LOGICAL, DIMENSION(:), ALLOCATABLE :: updated_swap 1887 1888 INTEGER :: flavors 1889 INTEGER :: measurements 1890 INTEGER :: modNoise1 1891 INTEGER :: modNoise2 1892 INTEGER :: modGlobalMove 1893 INTEGER :: sp1 1894 INTEGER :: itau 1895 INTEGER :: ind 1896 INTEGER :: endDensity 1897 INTEGER :: indDensity 1898 INTEGER :: swapUpdate1 1899 INTEGER :: swapUpdate2 1900 INTEGER :: old_percent 1901 INTEGER :: new_percent 1902 INTEGER :: ipercent !,ii 1903 INTEGER :: iflavor,ifl1,iflavor_d 1904 INTEGER :: isweep 1905 1906 DOUBLE PRECISION :: cpu_time1 1907 DOUBLE PRECISION :: cpu_time2 1908 DOUBLE PRECISION :: NRJ_old1 1909 DOUBLE PRECISION :: NRJ_old2 1910 DOUBLE PRECISION :: NRJ_new 1911 DOUBLE PRECISION :: total 1912 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_old1 1913 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_old2 1914 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_new 1915 1916 CALL CPU_TIME(cpu_time1) 1917 1918 flavors = op%flavors 1919 measurements = op%measurements 1920 modNoise1 = op%modNoise1 1921 modNoise2 = op%modNoise2 1922 modGlobalMove = op%modGlobalMove(1) 1923 sp1 = op%samples+1 1924 IF ( op%opt_histo .GT. 0 ) THEN 1925 op%occup_histo_time= 0.d0 1926 END IF 1927 1928 old_percent = 0 1929 1930 MALLOC(updated_swap,(1:flavors)) 1931 updated_swap(:) = .FALSE. 1932 1933 NRJ_old1 = 0.d0 1934 NRJ_old2 = 0.d0 1935 NRJ_new = 0.d0 1936 1937 MALLOC(gtmp_new,(1,1)) 1938 gtmp_new = 0.d0 1939 MALLOC(gtmp_old1,(1,1)) 1940 gtmp_old1 = 0.d0 1941 MALLOC(gtmp_old2,(1,1)) 1942 gtmp_old2 = 0.d0 1943 1944 endDensity = SIZE(op%density,2) 1945 1946 IF ( op%opt_noise .GT. 0 ) THEN 1947 FREEIF(gtmp_new) 1948 MALLOC(gtmp_new,(1:sp1,1:flavors)) 1949 FREEIF(gtmp_old1) 1950 MALLOC(gtmp_old1,(1:sp1,1:flavors)) 1951 FREEIF(gtmp_old2) 1952 MALLOC(gtmp_old2,(1:sp1,1:flavors)) 1953 END IF 1954 1955 IF ( op%rank .EQ. 0 ) THEN 1956 WRITE(op%ostream, '(1x,103A)') & 1957 "|----------------------------------------------------------------------------------------------------|" 1958 WRITE(op%ostream,'(1x,A)', ADVANCE="NO") "|" 1959 END IF 1960 1961 total = DBLE(itotal) 1962 !write(std_out,*) "itotal",itotal 1963 indDensity = 1 1964 !write(std_out,*) "op%stats",op%stats 1965 DO isweep = 1, itotal 1966 !ii if(op%prtopt==1) write(std_out,*) "======== Isweep = ",isweep 1967 !updated_seg=.FALSE. 1968 DO iflavor = 1, flavors 1969 ! if(isweep==itotal) write(std_out,*) " Iflavor = ",iflavor,op%Impurity%Particles(iflavor)%tail 1970 !ii if(op%prtopt==1) write(std_out,*) " ===Iflavor = ",iflavor 1971 op%Impurity%activeFlavor=iflavor 1972 op%Bath%activeFlavor=iflavor ; op%Bath%MAddFlag= .FALSE. ; op%Bath%MRemoveFlag = .FALSE. 1973 1974 !write(std_out,*) "before tryaddremove" 1975 1976 ! For iflavor, Try a move 1977 !========================== 1978 CALL Ctqmcoffdiag_tryAddRemove(op,updated_seg) 1979 !sui!write(std_out,*) "after tryaddremove",updated_seg 1980 1981 updated = updated_seg .OR. updated_swap(iflavor).OR.(isweep==1) 1982 updated_swap(iflavor) = .FALSE. 1983 if ( op%opt_nondiag >0 ) iflavor_d=0 1984 if ( op%opt_nondiag==0 ) iflavor_d=iflavor 1985 CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, updated,op%signvalue,iflavor_d) 1986 1987 CALL Ctqmcoffdiag_measN (op, iflavor, updated) 1988 IF ( op%opt_analysis .EQ. 1 ) & 1989 CALL Ctqmcoffdiag_measCorrelation (op, iflavor) 1990 IF ( op%opt_order .GT. 0 ) & 1991 CALL Ctqmcoffdiag_measPerturbation(op, iflavor) 1992 END DO 1993 !CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, updated,op%signvalue,iflavor_d) 1994 !DO iflavor = 1,flavors 1995 ! CALL Ctqmcoffdiag_measN (op, iflavor, updated) 1996 !END DO 1997 1998 IF ( MOD(isweep,modGlobalMove) .EQ. 0 ) THEN 1999 ! !sui!write(std_out,*) "isweep,modGlobalMove,inside",isweep,modGlobalMove 2000 CALL Ctqmcoffdiag_trySwap(op,swapUpdate1, swapUpdate2) 2001 ! !write(std_out,*) "no global move yet for non diag hybridization" 2002 IF ( swapUpdate1 .NE. 0 .AND. swapUpdate2 .NE. 0 ) THEN 2003 updated_swap(swapUpdate1) = .TRUE. 2004 updated_swap(swapUpdate2) = .TRUE. 2005 END IF 2006 END IF 2007 2008 IF ( MOD(isweep,measurements) .EQ. 0 ) THEN ! default is always 2009 CALL ImpurityOperator_measDE(op%Impurity,op%measDE) 2010 IF ( op%opt_spectra .GE. 1 .AND. MOD(isweep,measurements*op%opt_spectra) .EQ. 0 ) THEN 2011 op%density(1:flavors,indDensity) = op%measN(3,1:flavors) 2012 indDensity = indDensity+1 2013 END IF 2014 END IF 2015 2016 IF ( MOD(isweep,measurements) .EQ. 0 ) THEN 2017 IF ( op%opt_histo .GT. 0 ) THEN 2018 CALL ImpurityOperator_occup_histo_time(op%Impurity,op%occup_histo_time) 2019 END IF 2020 ENDIF 2021 2022 IF ( MOD(isweep, modNoise1) .EQ. 0 ) THEN 2023 !modNext = isweep + modNoise2 2024 NRJ_new = op%measDE(1,1) 2025 CALL Vector_pushBack(op%measNoise(1),NRJ_new - NRJ_old1) 2026 NRJ_old1 = NRJ_new 2027 2028 !! Try to limit accumulation error 2029 CALL ImpurityOperator_cleanOverlaps(op%Impurity) 2030 2031 IF ( op%opt_noise .EQ. 1 ) THEN 2032 DO ifl1 = 1, flavors 2033 DO ind = 1, op%Greens%map(ifl1,ifl1)%tail 2034 itau = op%Greens%map(ifl1,ifl1)%listINT(ind) 2035 gtmp_new(itau,ifl1) = op%Greens%oper(itau,ifl1,ifl1) & 2036 +op%Greens%map(ifl1,ifl1)%listDBLE(ind)*DBLE(op%Greens%factor) 2037 END DO 2038 DO itau = 1, sp1 2039 CALL Vector_pushBack(op%measNoiseG(itau,ifl1,1), gtmp_new(itau,ifl1) - gtmp_old1(itau,ifl1)) 2040 gtmp_old1(itau,ifl1) = gtmp_new(itau,ifl1) 2041 END DO 2042 END DO 2043 END IF 2044 END IF 2045 2046 IF ( MOD(isweep,modNoise2) .EQ. 0 ) THEN 2047 NRJ_new = op%measDE(1,1) 2048 CALL Vector_pushBack(op%measNoise(2),NRJ_new - NRJ_old2) 2049 NRJ_old2 = NRJ_new 2050 IF ( op%opt_noise .EQ. 1 ) THEN 2051 DO ifl1 = 1, flavors 2052 DO ind = 1, op%Greens%map(ifl1,ifl1)%tail 2053 itau = op%Greens%map(ifl1,ifl1)%listINT(ind) 2054 gtmp_new(itau,ifl1) = op%Greens%oper(itau,ifl1,ifl1) & 2055 +op%Greens%map(ifl1,ifl1)%listDBLE(ind)*op%Greens%factor 2056 END DO 2057 DO itau = 1, sp1 2058 CALL Vector_pushBack(op%measNoiseG(itau,ifl1,2), gtmp_new(itau,ifl1) - gtmp_old2(itau,ifl1)) 2059 gtmp_old2(itau,ifl1) = gtmp_new(itau,ifl1) 2060 END DO 2061 END DO 2062 END IF 2063 2064 IF ( op%rank .EQ. 0 ) THEN 2065 new_percent = CEILING(DBLE(isweep)*100.d0/DBLE(itotal)) 2066 DO ipercent = old_percent+1, new_percent 2067 WRITE(op%ostream,'(A)',ADVANCE="NO") "-" 2068 END DO 2069 old_percent = new_percent 2070 END IF 2071 END IF 2072 2073 IF ( op%opt_movie .EQ. 1 ) THEN 2074 WRITE(ilatex,'(A11,I9)') "%iteration ", isweep 2075 CALL ImpurityOperator_printLatex(op%Impurity,ilatex,isweep) 2076 END IF 2077 2078 END DO 2079 2080 IF ( op%rank .EQ. 0 ) THEN 2081 DO ipercent = old_percent+1, 100 2082 WRITE(op%ostream,'(A)',ADVANCE="NO") "-" 2083 END DO 2084 WRITE(op%ostream,'(A)') "|" 2085 END IF 2086 2087 FREE(gtmp_new) 2088 FREE(gtmp_old1) 2089 FREE(gtmp_old2) 2090 FREE(updated_swap) 2091 2092 IF ( op%opt_spectra .GE. 1 .AND. itotal .EQ. op%sweeps ) THEN 2093 IF ( endDensity .NE. indDensity-1 ) THEN 2094 op%density(:,endDensity) = -1.d0 2095 END IF 2096 END IF 2097 2098 CALL CPU_TIME(cpu_time2) 2099 2100 op%runTime = (cpu_time2 - cpu_time1)*1.05d0 ! facteur arbitraire de correction 2101 END SUBROUTINE Ctqmcoffdiag_loop
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measCorrelation [ Functions ]
NAME
Ctqmcoffdiag_measCorrelation
FUNCTION
measure all correlations in times for a flavor
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc iflavor=the flavor to measure
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
2801 SUBROUTINE Ctqmcoffdiag_measCorrelation(op, iflavor) 2802 2803 !Arguments ------------------------------------ 2804 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 2805 !TYPE(ImpurityOperator), INTENT(IN ) :: impurity 2806 INTEGER , INTENT(IN ) :: iflavor 2807 !Local variables ------------------------------ 2808 INTEGER :: iCdag 2809 INTEGER :: iCdagBeta 2810 INTEGER :: iC 2811 INTEGER :: index 2812 INTEGER :: size 2813 DOUBLE PRECISION :: tC 2814 DOUBLE PRECISION :: tCdag 2815 !DOUBLE PRECISION :: time 2816 DOUBLE PRECISION :: inv_dt 2817 DOUBLE PRECISION :: beta 2818 2819 IF ( .NOT. op%set ) & 2820 CALL ERROR("Ctqmcoffdiag_measCorrelation : QMC not set ") 2821 !write(6,*) "not available" 2822 stop 2823 2824 size = op%impurity%particles(op%impurity%activeFlavor)%tail 2825 beta = op%beta 2826 2827 IF ( size .EQ. 0 ) RETURN 2828 2829 inv_dt = op%inv_dt 2830 2831 DO iCdag = 1, size ! first segments 2832 tCdag = op%impurity%particles(op%impurity%activeFlavor)%list(iCdag,Cdag_) 2833 tC = op%impurity%particles(op%impurity%activeFlavor)%list(iCdag,C_ ) 2834 index = INT( ( (tC - tCdag) * inv_dt ) + .5d0 ) + 1 2835 op%measCorrelation(index,1,iflavor) = op%measCorrelation(index,1,iflavor) + 1.d0 2836 MODCYCLE(iCdag+1,size,iCdagBeta) 2837 index = INT( ( ( & 2838 op%impurity%particles(op%impurity%activeFlavor)%list(iCdagBeta,Cdag_) - tC & 2839 + AINT(DBLE(iCdag)/DBLE(size))*beta & 2840 ) * inv_dt ) + .5d0 ) + 1 2841 IF ( index .LT. 1 .OR. index .GT. op%samples+1 ) THEN 2842 CALL WARN("Ctqmcoffdiag_measCorrelation : bad index line 1095 ") 2843 ELSE 2844 op%measCorrelation(index,2,iflavor) = op%measCorrelation(index,2,iflavor) + 1.d0 2845 END IF 2846 ! DO iC = 1, size 2847 ! tC = impurity%particles(impurity%activeFlavor)%list(C_,iC) 2848 ! time = tC - tCdag 2849 ! IF ( time .LT. 0.d0 ) time = time + beta 2850 ! index = INT( ( time * inv_dt ) + .5d0 ) + 1 2851 ! op%measCorrelation(index,3,iflavor) = op%measCorrelation(index,3,iflavor) + 1.d0 2852 ! END DO 2853 DO iC = 1, size! op%Greens(iflavor)%index_old%tail 2854 !todoba op%measCorrelation(op%Greens(iflavor)%map%listINT(iC+(iCdag-1)*size),3,iflavor) = & 2855 !todoba op%measCorrelation(op%Greens(iflavor)%map%listINT(iC+(iCdag-1)*size),3,iflavor) + 1.d0 2856 END DO 2857 END DO 2858 2859 END SUBROUTINE Ctqmcoffdiag_measCorrelation
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measN [ Functions ]
NAME
Ctqmcoffdiag_measN
FUNCTION
measures the number of electron by taking into account the value for the move before before this one with the correct weight.
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc iflavor=which flavor to measure updated=something has changed since last time
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
2737 SUBROUTINE Ctqmcoffdiag_measN(op, iflavor, updated) 2738 2739 !Arguments ------------------------------------ 2740 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 2741 !TYPE(ImpurityOperator), INTENT(IN ) :: impurity 2742 INTEGER , INTENT(IN ) :: iflavor 2743 LOGICAL , INTENT(IN ) :: updated 2744 2745 ! IF ( .NOT. op%set ) & 2746 ! CALL ERROR("Ctqmcoffdiag_measN : QMC not set ") 2747 2748 2749 IF ( updated .EQV. .TRUE. ) THEN 2750 ! --- accumulate occupations with values op%measN(3,iflavor) from the last measurements with the corresponding weight 2751 ! --- op*measN(4,iflavor) 2752 op%measN(1,iflavor) = op%measN(1,iflavor) + op%measN(3,iflavor)*op%measN(4,iflavor) 2753 ! write(6,*) "Cllll42" 2754 2755 ! --- Compute total number of new measurements 2756 op%measN(2,iflavor) = op%measN(2,iflavor) + op%measN(4,iflavor) 2757 2758 ! write(6,*) "Allll42" 2759 ! --- Compute the occupation for this configuration (will be put in 2760 ! --- op%measN(1,iflavor) at the next occurence of updated=.true.), with 2761 ! --- the corresponding weight op%measN(4,iflavor) (we do not now it yet) 2762 op%measN(3,iflavor) = ImpurityOperator_measN(op%impurity) 2763 2764 ! --- set weight: as update=true, it is a new measurement , so put it to one 2765 op%measN(4,iflavor) = 1.d0 2766 2767 ELSE 2768 ! --- increased the count so that at new move, we will be able to update measN(1) correctly. 2769 op%measN(4,iflavor) = op%measN(4,iflavor) + 1.d0 2770 ! write(6,*) "Bllll42" 2771 END IF 2772 END SUBROUTINE Ctqmcoffdiag_measN
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measPerturbation [ Functions ]
NAME
Ctqmcoffdiag_measPerturbation
FUNCTION
measure perturbation order
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc iflavor=the flavor to measure
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
2887 SUBROUTINE Ctqmcoffdiag_measPerturbation(op, iflavor) 2888 2889 !Arguments ------------------------------------ 2890 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 2891 !TYPE(ImpurityOperator), INTENT(IN ) :: impurity 2892 INTEGER , INTENT(IN ) :: iflavor 2893 !Local variables ------------------------------ 2894 INTEGER :: index 2895 2896 IF ( .NOT. op%set ) & 2897 CALL ERROR("Ctqmcoffdiag_measiPerturbation : QMC not set ") 2898 2899 index = op%impurity%particles(op%impurity%activeFlavor)%tail + 1 2900 IF ( index .LE. op%opt_order ) & 2901 op%measPerturbation(index,iflavor) = op%measPerturbation(index,iflavor) + 1.d0 2902 IF ( index == 1 ) THEN 2903 IF (op%impurity%particles(iflavor)%list(0,C_) < op%impurity%particles(iflavor)%list(0,Cdag_) ) THEN 2904 op%meas_fullemptylines(1,iflavor) = op%meas_fullemptylines(1,iflavor) + 1.d0 2905 ELSE 2906 op%meas_fullemptylines(2,iflavor) = op%meas_fullemptylines(2,iflavor) + 1.d0 2907 ENDIF 2908 ENDIF 2909 2910 END SUBROUTINE Ctqmcoffdiag_measPerturbation
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printAll [ Functions ]
NAME
Ctqmcoffdiag_printAll
FUNCTION
print different functions computed during the simulation
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
3904 SUBROUTINE Ctqmcoffdiag_printAll(op) 3905 3906 !Arguments ------------------------------------ 3907 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 3908 3909 IF ( .NOT. op%done ) & 3910 CALL WARNALL("Ctqmcoffdiag_printAll : Simulation not run ") 3911 3912 !sui!write(6,*) "op%stats",op%stats 3913 CALL Ctqmcoffdiag_printQMC(op) 3914 3915 CALL Ctqmcoffdiag_printGreen(op) 3916 3917 CALL Ctqmcoffdiag_printD(op) 3918 3919 ! CALL Ctqmcoffdiag_printE(op) 3920 3921 !#ifdef CTCtqmcoffdiag_ANALYSIS 3922 CALL Ctqmcoffdiag_printPerturbation(op) 3923 3924 CALL Ctqmcoffdiag_printCorrelation(op) 3925 !#endif 3926 3927 CALL Ctqmcoffdiag_printSpectra(op) 3928 3929 END SUBROUTINE Ctqmcoffdiag_printAll
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printCorrelation [ Functions ]
NAME
Ctqmcoffdiag_printCorrelation
FUNCTION
print correlation fonctions
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc oFileIn=file stream
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
4407 SUBROUTINE Ctqmcoffdiag_printCorrelation(op, oFileIn) 4408 4409 !Arguments ------------------------------------ 4410 TYPE(Ctqmcoffdiag) , INTENT(IN) :: op 4411 INTEGER , OPTIONAL, INTENT(IN) :: oFileIn 4412 !Local variables ------------------------------ 4413 INTEGER :: oFile 4414 INTEGER :: itime 4415 INTEGER :: sp1 4416 INTEGER :: iflavor 4417 INTEGER :: i 4418 INTEGER :: flavors 4419 CHARACTER(LEN=2) :: a 4420 CHARACTER(LEN=50) :: string 4421 DOUBLE PRECISION :: dt 4422 4423 !IF ( op%rank .NE. MOD(5,op%size)) RETURN 4424 IF ( op%rank .NE. MOD(op%size+5,op%size)) RETURN 4425 IF ( op%opt_analysis .NE. 1 ) RETURN 4426 4427 oFile = 44 4428 IF ( PRESENT(oFileIn) ) THEN 4429 oFile = oFileIn 4430 ELSE 4431 OPEN(UNIT=oFile, FILE="Correlation.dat") 4432 END IF 4433 4434 sp1 = op%samples 4435 dt = op%beta / sp1 4436 sp1 = sp1 + 1 4437 flavors = op%flavors 4438 4439 i = 3*flavors + 1 4440 WRITE(a,'(I2)') i 4441 WRITE(oFile,*) "# time (/ (segement, antiseg, correl), i=1, flavor/)" 4442 string = '(1x,'//TRIM(ADJUSTL(a))//'F19.15)' 4443 DO itime = 1, sp1 4444 WRITE(oFile,string) DBLE(itime-1)*dt, & 4445 (/ ( & 4446 (/ ( op%measCorrelation(itime, i, iflavor), i=1,3) /) & 4447 , iflavor=1, flavors) /) 4448 END DO 4449 4450 IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile) 4451 4452 END SUBROUTINE Ctqmcoffdiag_printCorrelation
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printD [ Functions ]
NAME
Ctqmcoffdiag_printD
FUNCTION
print individual double occupancy
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc oFileIn=file stream
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
4231 SUBROUTINE Ctqmcoffdiag_printD(op,oFileIn) 4232 4233 !Arguments ------------------------------------ 4234 TYPE(Ctqmcoffdiag) , INTENT(IN) :: op 4235 INTEGER , OPTIONAL, INTENT(IN) :: oFileIn 4236 !Local variables ------------------------------ 4237 INTEGER :: oFile 4238 INTEGER :: iflavor1 4239 INTEGER :: iflavor2 4240 4241 !IF ( op%rank .NE. MOD(2,op%size)) RETURN 4242 IF ( op%rank .NE. MOD(op%size+2,op%size)) RETURN 4243 4244 oFile = 41 4245 IF ( PRESENT(oFileIn) ) THEN 4246 oFile = oFileIn 4247 ELSE 4248 OPEN(UNIT=oFile, FILE="D.dat") 4249 END IF 4250 4251 DO iflavor1 = 1, op%flavors 4252 DO iflavor2 = iflavor1+1, op%flavors 4253 WRITE(oFile,'(1x,A8,I4,A1,I4,A3,ES21.14)') "Orbitals", iflavor1, "-", iflavor2, " : ", op%measDE(iflavor2,iflavor1) 4254 END DO 4255 END DO 4256 4257 IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile) 4258 4259 END SUBROUTINE Ctqmcoffdiag_printD
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printE [ Functions ]
NAME
Ctqmcoffdiag_printE
FUNCTION
print energy and noise
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc oFileIn=file stream
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
4287 SUBROUTINE Ctqmcoffdiag_printE(op,oFileIn) 4288 4289 !Arguments ------------------------------------ 4290 TYPE(Ctqmcoffdiag) , INTENT(IN) :: op 4291 INTEGER , OPTIONAL, INTENT(IN) :: oFileIn 4292 !Local variables ------------------------------ 4293 INTEGER :: oFile 4294 DOUBLE PRECISION :: E 4295 DOUBLE PRECISION :: Noise 4296 4297 !IF ( op%rank .NE. MOD(3,op%size)) RETURN 4298 IF ( op%rank .NE. MOD(op%size+3,op%size)) RETURN 4299 4300 oFile = 42 4301 IF ( PRESENT(oFileIn) ) THEN 4302 oFile = oFileIn 4303 ELSE 4304 OPEN(UNIT=oFile, FILE="BetaENoise.dat") 4305 END IF 4306 4307 CALL Ctqmcoffdiag_getE(op,E,Noise) 4308 4309 WRITE(oFile,'(1x,F3.2,A2,ES21.14,A2,ES21.14)') op%beta, " ", E, " ", Noise 4310 4311 IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile) 4312 4313 END SUBROUTINE Ctqmcoffdiag_printE
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printGreen [ Functions ]
NAME
Ctqmcoffdiag_printGreen
FUNCTION
print green functions
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc oFileIn=file stream
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
4112 SUBROUTINE Ctqmcoffdiag_printGreen(op, oFileIn) 4113 4114 !Arguments ------------------------------------ 4115 use m_io_tools, only : flush_unit 4116 TYPE(Ctqmcoffdiag) , INTENT(IN) :: op 4117 INTEGER , OPTIONAL, INTENT(IN) :: oFileIn 4118 !Local variables ------------------------------ 4119 INTEGER :: oFile 4120 INTEGER :: itime 4121 INTEGER :: sp1 4122 INTEGER :: iflavor,iflavorb 4123 INTEGER :: flavors !, iflavor2 !,iflavor1, 4124 CHARACTER(LEN=4) :: cflavors 4125 CHARACTER(LEN=50) :: string 4126 DOUBLE PRECISION :: dt 4127 DOUBLE PRECISION :: sweeps 4128 4129 !IF ( op%rank .NE. MOD(1,op%size)) RETURN 4130 IF ( op%rank .NE. MOD(op%size+1,op%size)) RETURN 4131 4132 oFile = 40 4133 IF ( PRESENT(oFileIn) ) THEN 4134 oFile = oFileIn 4135 ELSE 4136 OPEN(UNIT=oFile, FILE="Gtau.dat") 4137 END IF 4138 OPEN(UNIT=43, FILE="Gtau_nd.dat") 4139 rewind(43) 4140 sp1 = op%samples 4141 dt = op%beta / DBLE(sp1) 4142 sp1 = sp1 + 1 4143 flavors = op%flavors 4144 sweeps = DBLE(op%sweeps)*DBLE(op%size) 4145 4146 IF ( op%opt_noise .EQ. 1) THEN 4147 WRITE(cflavors,'(I4)') (2*flavors+1)*2 4148 string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)' 4149 DO itime = 1, sp1 4150 WRITE(oFile,string) DBLE(itime-1)*dt, & 4151 (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /), & 4152 (/ (op%abNoiseG(1,itime,iflavor)*(sweeps)**op%abNoiseG(2,itime,iflavor), iflavor=1, flavors) /) 4153 END DO 4154 ELSE 4155 WRITE(cflavors,'(I4)') (flavors+1)*2 4156 string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)' 4157 DO itime = 1, sp1 4158 ! WRITE(45,string) DBLE(itime-1)*dt, & 4159 ! (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /) 4160 WRITE(oFile,string) DBLE(itime-1)*dt, & 4161 (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /) 4162 ! WRITE(46,*) DBLE(itime-1)*dt, & 4163 ! & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavor=1, flavors),iflavorb=1,flavors) /) 4164 END DO 4165 ! DO itime = 1, sp1 4166 ! WRITE(47,*) DBLE(itime-1)*dt, & 4167 ! & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavor=1, flavors),iflavorb=1,flavors) /) 4168 ! END DO 4169 ! --- Print full non diagonal Gtau in Gtau_nd.dat 4170 WRITE(cflavors,'(I4)') (flavors*flavors+1) 4171 ! write(47,*) "cflavors",cflavors 4172 string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)' 4173 ! write(47,*) string 4174 DO itime = 1, sp1 4175 WRITE(43,string) DBLE(itime-1)*dt, & 4176 & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavorb=1, flavors),iflavor=1,flavors) /) 4177 ! WRITE(44,*) DBLE(itime-1)*dt, & 4178 ! & (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) 4179 ! WRITE(44,string) DBLE(itime-1)*dt, & 4180 ! & (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) 4181 END DO 4182 WRITE(43,*) 4183 END IF 4184 ! DO iflavor = 1, flavors 4185 ! DO iflavor2 = 1, flavors 4186 ! write(4436,*) "#",iflavor,iflavor2 4187 ! do itime=1,sp1 4188 ! write(4436,*) DBLE(itime-1)*dt,real(op%Greens%oper(itime,iflavor,iflavor2)) 4189 ! enddo 4190 ! write(4436,*) 4191 ! END DO 4192 ! END DO 4193 ! close(4436) 4194 4195 IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile) 4196 CLOSE(43) 4197 ! CLOSE(44) 4198 ! CLOSE(45) 4199 ! CLOSE(46) 4200 ! CLOSE(47) 4201 !call flush_unit(43) 4202 4203 END SUBROUTINE Ctqmcoffdiag_printGreen
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printPerturbation [ Functions ]
NAME
Ctqmcoffdiag_printPerturbation
FUNCTION
print perturbation order
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc oFileIn=file stream
OUTPUT
argout(sizeout)=description
SIDE EFFECTS
NOTES
SOURCE
4343 SUBROUTINE Ctqmcoffdiag_printPerturbation(op, oFileIn) 4344 4345 !Arguments ------------------------------------ 4346 TYPE(Ctqmcoffdiag) , INTENT(IN) :: op 4347 INTEGER , OPTIONAL, INTENT(IN) :: oFileIn 4348 !Local variables------------------------------- 4349 INTEGER :: oFile 4350 INTEGER :: iorder 4351 INTEGER :: order 4352 INTEGER :: iflavor 4353 INTEGER :: flavors 4354 CHARACTER(LEN=2) :: a 4355 CHARACTER(LEN=50) :: string 4356 4357 !IF ( op%rank .NE. MOD(4,op%size)) RETURN 4358 IF ( op%rank .NE. MOD(op%size+4,op%size)) RETURN 4359 IF ( op%opt_order .LE. 0 ) RETURN 4360 4361 oFile = 43 4362 IF ( PRESENT(oFileIn) ) THEN 4363 oFile = oFileIn 4364 ELSE 4365 OPEN(UNIT=oFile, FILE="Perturbation.dat") 4366 END IF 4367 4368 order = op%opt_order 4369 flavors = op%flavors 4370 4371 WRITE(a,'(I2)') flavors 4372 string = '(I5,'//TRIM(ADJUSTL(a))//'F19.15)' 4373 DO iorder = 1, order 4374 WRITE(oFile,string) iorder-1, & 4375 (/ (op%measPerturbation(iorder, iflavor), iflavor=1, flavors) /) 4376 END DO 4377 4378 IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile) 4379 END SUBROUTINE Ctqmcoffdiag_printPerturbation
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printQMC [ Functions ]
NAME
Ctqmcoffdiag_printQMC
FUNCTION
print ctqmc statistics
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
3956 SUBROUTINE Ctqmcoffdiag_printQMC(op) 3957 3958 !Arguments ------------------------------------ 3959 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 3960 !Local variables ------------------------------ 3961 INTEGER :: ostream 3962 INTEGER :: iflavor,iflavorbis,iorder 3963 DOUBLE PRECISION :: sweeps 3964 DOUBLE PRECISION :: invSweeps 3965 CHARACTER(LEN=2) :: a 3966 CHARACTER(LEN=15) :: string 3967 3968 !IF ( op%rank .NE. 0) RETURN 3969 IF ( op%rank .NE. MOD(op%size,op%size)) RETURN 3970 3971 ostream = op%ostream 3972 sweeps = DBLE(op%sweeps) 3973 invSweeps = 1.d0/sweeps 3974 3975 WRITE(ostream,'(1x,F13.0,A11,F10.2,A12,I5,A5)') sweeps*DBLE(op%size), " sweeps in ", op%runTime, & 3976 " seconds on ", op%size, " CPUs" 3977 WRITE(ostream,'(A28,F6.2)') "Segments added [%] : ", op%stats(4)*invSweeps*100.d0 3978 WRITE(ostream,'(A28,F6.2)') "Segments removed [%] : ", op%stats(5)*invSweeps*100.d0 3979 WRITE(ostream,'(A28,F6.2)') "Segments <0 sign [%] : ", op%stats(6)*invSweeps*100.d0 3980 !WRITE(ostream,'(A28,F12.2)') "Number of meas [%] : ", op%stats(6) 3981 WRITE(ostream,'(A28,F6.2)') "Anti-segments added [%] : ", op%stats(1)*invSweeps*100.d0 3982 WRITE(ostream,'(A28,F6.2)') "Anti-segments removed [%] : ", op%stats(2)*invSweeps*100.d0 3983 WRITE(ostream,'(A28,F6.2)') "Anti-segments <0 sign [%] : ", op%stats(3)*invSweeps*100.d0 3984 !WRITE(ostream,'(A28,F12.2)') "Sum of sign [%] : ", op%stats(3) 3985 WRITE(ostream,'(A28,F13.2)') "Signe value : ", op%Greens%signvaluemeas 3986 IF ( op%modGlobalMove(1) .LT. op%sweeps + 1 ) THEN 3987 WRITE(ostream,'(A28,F6.2)') "Global Move [%] : ", op%swap *invSweeps*100.d0*op%modGlobalMove(1) 3988 WRITE(ostream,'(A28,F6.2)') "Global Move Reduced [%] : ", op%swap / DBLE(op%modGlobalMove(2))*100.d0 3989 END IF 3990 !#ifdef CTCtqmcoffdiag_CHECK 3991 IF ( op%opt_check .EQ. 1 .OR. op%opt_check .EQ. 3 ) & 3992 WRITE(ostream,'(A28,E22.14)') "Impurity test [%] : ", op%errorImpurity*100.d0 3993 IF ( op%opt_check .GE. 2 ) & 3994 WRITE(ostream,'(A28,E22.14)') "Bath test [%] : ", op%errorBath *100.d0 3995 !#endif 3996 WRITE(ostream,'(A28,ES22.14,A5,ES21.14)') "<Epot> [U] : ", op%measDE(1,1), " +/- ",& 3997 !#ifdef HAVE_MPI 3998 op%a_Noise*(sweeps*DBLE(op%size))**op%b_Noise 3999 !#else 4000 ! op%a_Noise*(sweeps)**op%b_Noise 4001 !#endif 4002 !--------- Write double occupation between all pairs of orbitals -------------------------- 4003 write(ostream,'(17x,a)') "Double occupation between pairs of orbitals" 4004 write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors) 4005 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors) 4006 do iflavor=1, op%flavors 4007 write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%measDE(iflavor,iflavorbis),iflavorbis=1,op%flavors) 4008 enddo 4009 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10 4010 !------------------------------------------------------------------------------------------ 4011 4012 !--------- Write number of segments for each orbitals 4013 ! write(ostream,'(a)') "Number of segments for each orbitals" 4014 ! write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors) 4015 ! write(ostream,'(17x,30a)') ("----------",iflavorbis=1,op%flavors) 4016 ! do iflavor=1, op%flavors 4017 ! write(ostream,'(i17,a,30f10.4)') iflavor,"|",(op%Impurity%particles(IT)%tail 4018 ! enddo 4019 ! write(ostream,'(17x,30a)') ("----------",iflavorbis=1,op%flavors) 4020 !------------------------------------------------------------------------------------------ 4021 !--------- Write G(L) 4022 write(ostream,'(17x,a)') "G(L)" 4023 write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors) 4024 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors) 4025 do iflavor=1, op%flavors 4026 write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%Greens%oper(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors) 4027 enddo 4028 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10 4029 !------------------------------------------------------------------------------------------ 4030 !--------- Write G(1) 4031 write(ostream,'(17x,a)') "G(1)" 4032 write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors) 4033 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors) 4034 do iflavor=1, op%flavors 4035 write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%Greens%oper(1,iflavor,iflavorbis),iflavorbis=1,op%flavors) 4036 enddo 4037 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10 4038 !------------------------------------------------------------------------------------------ 4039 4040 WRITE(ostream,'(A28,F8.4,A3,F7.4)') "Noise [U] : ", op%a_Noise, " x^", op%b_Noise 4041 WRITE(ostream,'(A28,E10.2)') "Niquist puls. [/beta] : ", ACOS(-1.d0)*op%inv_dt 4042 WRITE(ostream,'(A28,E22.14)') "Max Acc. Epot Error [U] : ", op%measDE(2,2)/(op%beta*op%modNoise1*2.d0)*sweeps 4043 4044 !WRITE(ostream,'(A28,F7.4,A3,F7.4,A4,E20.14)') "Noise [G(tau)] : ", op%a_Noise(2), "x^", op%b_Noise(2), " -> ", & 4045 !op%a_Noise(2)*(sweeps*DBLE(op%size))**op%b_Noise(2) 4046 !----- PERTURBATION ORDER------------------------------------------------------------------ 4047 IF ( op%opt_order .GT. 0 ) THEN 4048 write(ostream,*) 4049 WRITE(a,'(I2)') op%flavors 4050 string = '(A28,'//TRIM(ADJUSTL(a))//'(1x,I3))' 4051 WRITE(ostream,string) "Perturbation orders : ",(/ (MAXLOC(op%measPerturbation(:, iflavor))-1, iflavor=1, op%flavors) /) 4052 write(ostream,'(17x,a)') "order of Perturbation for flavors" 4053 write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors) 4054 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors) 4055 write(ostream,'(12x,a,30i10)') " max ",(/ (MAXLOC(op%measPerturbation(:, iflavor))-1, iflavor=1, op%flavors) /) 4056 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors) 4057 do iorder=0, op%opt_order-1 4058 write(ostream,'(7x,i10,a,30f10.4)') iorder,"|",(op%measPerturbation(iorder+1,iflavor),iflavor=1,op%flavors) 4059 enddo 4060 END IF 4061 !------------------------------------------------------------------------------------------ 4062 !----- PERTURBATION ORDER------------------------------------------------------------------ 4063 IF ( op%opt_order .GT. 0 ) THEN 4064 write(ostream,*) 4065 write(ostream,'(17x,a)') "Proportion of full and empty orbital for order 0" 4066 write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors) 4067 write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors) 4068 write(ostream,'(2x,a,30f10.4)') " full orbital |",(op%meas_fullemptylines(1,iflavor),iflavor=1,op%flavors) 4069 write(ostream,'(2x,a,30f10.4)') " empty orbital |",(op%meas_fullemptylines(2,iflavor),iflavor=1,op%flavors) 4070 END IF 4071 !------------------------------------------------------------------------------------------ 4072 !CALL FLUSH(op%ostream) 4073 IF ( ABS(((op%stats(4) *invSweeps*100.d0) / (op%stats(5) *invSweeps*100.d0) - 1.d0)) .GE. 0.02d0 & 4074 .OR. ABS(((op%stats(1)*invSweeps*100.d0) / (op%stats(2)*invSweeps*100.d0) - 1.d0)) .GE. 0.02d0 ) & 4075 THEN 4076 CALL WARNALL("Ctqmcoffdiag_printQMC : bad statistic according to moves. Increase sweeps") 4077 END IF 4078 IF ( ABS(op%b_Noise+0.5)/0.5d0 .GE. 0.05d0 ) & 4079 CALL WARNALL("Ctqmcoffdiag_printQMC : bad statistic according to Noise. Increase sweeps") 4080 ! IF ( ISNAN(op%a_Noise) .OR. ISNAN(op%a_Noise) ) & 4081 ! CALL WARNALL("Ctqmcoffdiag_printQMC : NaN appeared. Increase sweeps ") 4082 4083 4084 END SUBROUTINE Ctqmcoffdiag_printQMC
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printSpectra [ Functions ]
NAME
Ctqmcoffdiag_printSpectra
FUNCTION
print fourier transform of time evolution of number of electrons
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc oFileIn=file stream
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
4481 SUBROUTINE Ctqmcoffdiag_printSpectra(op, oFileIn) 4482 4483 !Arguments ------------------------------------ 4484 TYPE(Ctqmcoffdiag) , INTENT(IN) :: op 4485 INTEGER , OPTIONAL, INTENT(IN) :: oFileIn 4486 !Local variables ------------------------------ 4487 INTEGER :: oFile 4488 INTEGER :: flavors 4489 INTEGER :: indDensity 4490 INTEGER :: endDensity 4491 CHARACTER(LEN=4) :: a 4492 CHARACTER(LEN=16) :: formatSpectra 4493 4494 !IF ( op%rank .NE. MOD(6,op%size)) RETURN 4495 IF ( op%opt_spectra .LT. 1 ) RETURN 4496 4497 oFile = 45+op%rank 4498 a ="0000" 4499 WRITE(a,'(I4)') op%rank 4500 IF ( PRESENT(oFileIn) ) THEN 4501 oFile = oFileIn 4502 ELSE 4503 OPEN(UNIT=oFile, FILE="Markov_"//TRIM(ADJUSTL(a))//".dat") 4504 END IF 4505 4506 flavors = op%flavors 4507 WRITE(a,'(I4)') flavors+1 4508 formatSpectra ='(1x,'//TRIM(ADJUSTL(a))//'ES22.14)' 4509 WRITE(oFile,*) "# freq[/hermalization] FFT" 4510 4511 endDensity = SIZE(op%density,2) 4512 DO WHILE ( op%density(flavors+1,endDensity) .EQ. -1 ) 4513 endDensity = endDensity -1 4514 END DO 4515 4516 DO indDensity = 1, endDensity 4517 WRITE(oFile,formatSpectra) op%density(flavors+1,indDensity), op%density(1:flavors,indDensity) 4518 END DO 4519 4520 IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile) 4521 4522 END SUBROUTINE Ctqmcoffdiag_printSpectra
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_reset [ Functions ]
NAME
Ctqmcoffdiag_reset
FUNCTION
reset a ctqmc simulation
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1062 SUBROUTINE Ctqmcoffdiag_reset(op) 1063 1064 !Arguments ------------------------------------ 1065 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 1066 !Local variables ------------------------------ 1067 !INTEGER :: iflavor 1068 DOUBLE PRECISION :: sweeps 1069 1070 CALL GreenHyboffdiag_reset(op%Greens) 1071 CALL Ctqmcoffdiag_clear(op) 1072 CALL ImpurityOperator_reset(op%Impurity) 1073 CALL BathOperatoroffdiag_reset (op%Bath) 1074 op%measN(3,:) = 0.d0 1075 !complete restart -> measN=0 1076 op%done = .FALSE. 1077 op%set = .FALSE. 1078 op%inF = .FALSE. 1079 op%opt_movie = 0 1080 op%opt_analysis = 0 1081 op%opt_order = 0 1082 op%opt_check = 0 1083 op%opt_noise = 0 1084 op%opt_spectra = 0 1085 op%opt_levels = 0 1086 sweeps = DBLE(op%sweeps)*DBLE(op%size) 1087 CALL Ctqmcoffdiag_setSweeps(op, sweeps) 1088 !#ifdef HAVE_MPI 1089 ! CALL MPI_BARRIER(op%MY_COMM,iflavor) 1090 ! IF ( op%rank .EQ. 0 ) & 1091 !#endif 1092 ! WRITE(op%ostream,'(A9)') "QMC reset" 1093 ! CALL FLUSH(op%ostream) 1094 END SUBROUTINE Ctqmcoffdiag_reset
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_run [ Functions ]
NAME
Ctqmcoffdiag_run
FUNCTION
set all options and run a simulation
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc opt_order=maximal perturbation order to scope opt_movie=draw a movie of the simulation opt_analysis=compute correlation functions opt_check=check fast calculations opt_noise=compute noise for green function opt_spectra=fourier transform of the time evolution of the number of electrons opt_gMove=steps without global move
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
1709 SUBROUTINE Ctqmcoffdiag_run(op,opt_order,opt_histo,opt_movie,opt_analysis,opt_check,opt_noise,opt_spectra,opt_gMove) 1710 1711 1712 #ifdef HAVE_MPI1 1713 include 'mpif.h' 1714 #endif 1715 !Arguments ------------------------------------ 1716 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 1717 INTEGER, OPTIONAL, INTENT(IN ) :: opt_order 1718 INTEGER, OPTIONAL, INTENT(IN ) :: opt_histo 1719 INTEGER, OPTIONAL, INTENT(IN ) :: opt_movie 1720 INTEGER, OPTIONAL, INTENT(IN ) :: opt_analysis 1721 INTEGER, OPTIONAL, INTENT(IN ) :: opt_check 1722 INTEGER, OPTIONAL, INTENT(IN ) :: opt_noise 1723 INTEGER, OPTIONAL, INTENT(IN ) :: opt_spectra 1724 INTEGER, OPTIONAL, INTENT(IN ) :: opt_gMove 1725 !Local variables ------------------------------ 1726 #ifdef HAVE_MPI 1727 INTEGER :: ierr 1728 #endif 1729 !#ifdef CTCtqmcoffdiag_MOVIE 1730 INTEGER :: ilatex 1731 CHARACTER(LEN=4) :: Cchar 1732 !#endif 1733 DOUBLE PRECISION :: estimatedTime 1734 1735 IF ( .NOT. op%set ) & 1736 CALL ERROR("Ctqmcoffdiag_run : QMC not set up ") 1737 IF ( .NOT. op%setU ) & 1738 CALL ERROR("Ctqmcoffdiag_run : QMC does not have a U matrix ") 1739 1740 1741 ! OPTIONS of the run 1742 IF ( PRESENT( opt_check ) ) THEN 1743 op%opt_check = opt_check 1744 CALL ImpurityOperator_doCheck(op%Impurity,opt_check) 1745 CALL BathOperatoroffdiag_doCheck(op%Bath,opt_check) 1746 END IF 1747 IF ( PRESENT( opt_movie ) ) & 1748 op%opt_movie = opt_movie 1749 IF ( PRESENT( opt_analysis ) ) & 1750 op%opt_analysis = opt_analysis 1751 IF ( PRESENT ( opt_order ) ) & 1752 op%opt_order = opt_order 1753 IF ( PRESENT ( opt_histo ) ) & 1754 op%opt_histo = opt_histo 1755 IF ( PRESENT ( opt_noise ) ) THEN 1756 op%opt_noise = opt_noise 1757 END IF 1758 IF ( PRESENT ( opt_spectra ) ) & 1759 op%opt_spectra = opt_spectra 1760 1761 op%modGlobalMove(1) = max(op%sweeps,op%thermalization)+1 ! No Global Move 1762 !!sui!write(std_out,*) "op%sweeps",op%thermalization,op%sweeps,opt_gMove 1763 op%modGlobalMove(2) = 0 1764 IF ( PRESENT ( opt_gMove ) ) THEN 1765 IF ( opt_gMove .LE. 0 .OR. opt_gMove .GT. op%sweeps ) THEN 1766 ! op%modGlobalMove(1) = op%sweeps+1 1767 op%modGlobalMove(1) = max(op%sweeps,op%thermalization)+1 ! No Global Move 1768 !write(std_out,*) "op%sweeps",op%sweeps, op%modGlobalMove(1) 1769 CALL WARNALL("Ctqmcoffdiag_run : global moves option is <= 0 or > sweeps/cpu -> No global Moves") 1770 ELSE 1771 op%modGlobalMove(1) = opt_gMove 1772 END IF 1773 END IF 1774 !sui!write(std_out,*) "op%sweeps",op%thermalization,op%sweeps 1775 1776 CALL Ctqmcoffdiag_allocateOpt(op) 1777 1778 !#ifdef CTCtqmcoffdiag_MOVIE 1779 ilatex = 0 1780 IF ( op%opt_movie .EQ. 1 ) THEN 1781 Cchar ="0000" 1782 WRITE(Cchar,'(I4)') op%rank 1783 ilatex = 87+op%rank 1784 OPEN(UNIT=ilatex, FILE="Movie_"//TRIM(ADJUSTL(Cchar))//".tex") 1785 WRITE(ilatex,'(A)') "\documentclass{beamer}" 1786 WRITE(ilatex,'(A)') "\usepackage{color}" 1787 WRITE(ilatex,'(A)') "\setbeamersize{sidebar width left=0pt}" 1788 WRITE(ilatex,'(A)') "\setbeamersize{sidebar width right=0pt}" 1789 WRITE(ilatex,'(A)') "\setbeamersize{text width left=0pt}" 1790 WRITE(ilatex,'(A)') "\setbeamersize{text width right=0pt}" 1791 WRITE(ilatex,*) 1792 WRITE(ilatex,'(A)') "\begin{document}" 1793 WRITE(ilatex,*) 1794 END IF 1795 !#endif 1796 1797 IF ( op%rank .EQ. 0 ) THEN 1798 WRITE(op%ostream,'(A29)') "Starting QMC (Thermalization)" 1799 END IF 1800 1801 !================================= 1802 ! STARTING THERMALIZATION 1803 !================================= 1804 !write(std_out,*) "sweeps before thermalization",op%sweeps 1805 !write(std_out,*) "op%stats",op%stats 1806 CALL Ctqmcoffdiag_loop(op,op%thermalization,ilatex) 1807 !================================= 1808 ! ENDING THERMALIZATION 1809 !================================= 1810 1811 estimatedTime = op%runTime 1812 #ifdef HAVE_MPI 1813 CALL MPI_REDUCE(op%runTime, estimatedTime, 1, MPI_DOUBLE_PRECISION, MPI_MAX, & 1814 0, op%MY_COMM, ierr) 1815 #endif 1816 1817 IF ( op%rank .EQ. 0 ) THEN 1818 WRITE(op%ostream,'(A26,I6,A11)') "Thermalization done in ", CEILING(estimatedTime), " seconds" 1819 WRITE(op%ostream,'(A25,I7,A15,I5,A5)') "The QMC should run in ", & 1820 CEILING(estimatedTime*DBLE(op%sweeps)/DBLE(op%thermalization)),& 1821 " seconds on ", op%size, " CPUs" 1822 END IF 1823 1824 !================================= 1825 ! CLEANING CTQMC 1826 !================================= 1827 CALL Ctqmcoffdiag_clear(op) 1828 1829 !================================= 1830 ! STARTING CTQMC 1831 !================================= 1832 !write(std_out,*) "sweeps before loop",op%sweeps 1833 !write(std_out,*) "op%stats",op%stats 1834 CALL Ctqmcoffdiag_loop(op,op%sweeps,ilatex) 1835 !================================= 1836 ! ENDING CTQMC 1837 !================================= 1838 1839 IF ( op%opt_movie .EQ. 1 ) THEN 1840 WRITE(ilatex,*) "" 1841 WRITE(ilatex,'(A14)') "\end{document}" 1842 CLOSE(ilatex) 1843 END IF 1844 1845 op%done = .TRUE. 1846 !sui!write(std_out,*) "op%stats en of ctqmc_run",op%stats 1847 1848 END SUBROUTINE Ctqmcoffdiag_run
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setG0wTab [ Functions ]
NAME
Ctqmcoffdiag_setG0wTab
FUNCTION
Set Gow from input array
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc Gomega=G0w opt_fk=F is already inversed with out iwn
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
861 SUBROUTINE Ctqmcoffdiag_setG0wTab(op,Gomega,opt_fk) 862 863 !Arguments ------------------------------------ 864 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 865 COMPLEX(KIND=8), DIMENSION(:,:,:), INTENT(IN ) :: Gomega 866 INTEGER , INTENT(IN ) :: opt_fk 867 !Local variable ------------------------------- 868 DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: F 869 870 IF ( .NOT. op%para ) & 871 CALL ERROR("Ctqmcoffdiag_setG0wTab : Ctqmcoffdiag_setParameters never called ") 872 873 MALLOC(F,(1:op%samples+1,1:op%flavors,1:op%flavors)) 874 CALL Ctqmcoffdiag_computeF(op,Gomega, F, opt_fk) ! mu is changed 875 !write(6,*) "eee111" 876 CALL BathOperatoroffdiag_setF(op%Bath, F) 877 ! CALL BathOperatoroffdiag_printF(op%Bath,333) 878 !write(6,*) "eee" 879 FREE(F) 880 881 op%inF = .TRUE. 882 op%set = .TRUE. 883 884 END SUBROUTINE Ctqmcoffdiag_setG0wTab
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_sethybri_limit [ Functions ]
NAME
Ctqmcoffdiag_sethybri_limit
FUNCTION
use coefficient A such that F=-A/(iwn) given by DMFT code.
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
hybri_limit(nflavor,nflavor)=contains the limit for each couple of flavors
OUTPUT
argout(sizeout)=description
SIDE EFFECTS
op(Ctqmcoffdiag_type) = is the ctqmc main variable op&limit is now filled
NOTES
SOURCE
1164 SUBROUTINE Ctqmcoffdiag_sethybri_limit(op, hybri_limit) 1165 1166 !Arguments ------------------------------------ 1167 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 1168 COMPLEX(KIND=8) , DIMENSION(:,:), INTENT(IN ) :: hybri_limit 1169 1170 IF ( op%flavors .NE. SIZE(hybri_limit,1) ) & 1171 CALL ERROR("Error in sethybri_limit") 1172 1173 op%hybri_limit(:,:)=hybri_limit(:,:) 1174 op%opt_hybri_limit = 1 1175 END SUBROUTINE Ctqmcoffdiag_sethybri_limit
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setMu [ Functions ]
NAME
Ctqmcoffdiag_setMu
FUNCTION
impose energy levels
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc levels=energy levels vector
OUTPUT
argout(sizeout)=description
SIDE EFFECTS
NOTES
SOURCE
1123 SUBROUTINE Ctqmcoffdiag_setMu(op, levels) 1124 1125 !Arguments ------------------------------------ 1126 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 1127 DOUBLE PRECISION, DIMENSION(:), INTENT(IN ) :: levels 1128 1129 IF ( op%flavors .NE. SIZE(levels,1) ) & 1130 CALL WARNALL("Ctqmcoffdiag_setMu : Taking energy levels from weiss G(iw)") 1131 1132 op%mu(:)=-levels(:) ! levels = \epsilon_j - \mu 1133 !op%mu =\tilde{\mu} = \mu -\epsilon_j 1134 op%opt_levels = 1 1135 END SUBROUTINE Ctqmcoffdiag_setMu
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setParameters [ Functions ]
NAME
Ctqmcoffdiag_setParameters
FUNCTION
set all parameters and operators
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc buffer=input parameters
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
477 SUBROUTINE Ctqmcoffdiag_setParameters(op,buffer) 478 479 !Arguments ------------------------------------ 480 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 481 DOUBLE PRECISION, DIMENSION(1:10), INTENT(IN ) :: buffer 482 483 484 op%thermalization = INT(buffer(3)) !op%thermalization 485 CALL Ctqmcoffdiag_setSeed(op,INT(buffer(1))) 486 CALL Ctqmcoffdiag_setSweeps(op,buffer(2)) 487 488 op%measurements = INT(buffer(4)) !op%measurements 489 op%flavors = INT(buffer(5)) 490 op%samples = INT(buffer(6)) !op%samples 491 op%beta = buffer(7) !op%beta 492 op%U = buffer(8) !U 493 op%opt_nondiag = INT(buffer(10)) 494 ! op%mu = buffer(9) !op%mu 495 !op%Wmax = INT(buffer(9)) !Freq 496 !#ifdef CTCtqmcoffdiag_ANALYSIS 497 ! op%order = INT(buffer(10)) ! order 498 op%inv_dt = op%samples / op%beta 499 !#endif 500 501 !CALL ImpurityOperator_init(op%Impurity,op%flavors,op%beta, op%samples) 502 CALL ImpurityOperator_init(op%Impurity,op%flavors,op%beta) 503 IF ( op%U .GE. 0.d0 ) THEN 504 CALL ImpurityOperator_computeU(op%Impurity,op%U,0.d0) 505 op%setU = .TRUE. 506 END IF 507 ! op%mu = op%mu + op%Impurity%shift_mu 508 !sui!write(std_out,*) "op%opt_nondiag",op%opt_nondiag 509 CALL BathOperatoroffdiag_init(op%Bath, op%flavors, op%samples, op%beta, INT(buffer(9)), op%opt_nondiag) 510 511 op%para = .TRUE. 512 513 END SUBROUTINE Ctqmcoffdiag_setParameters
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setSeed [ Functions ]
NAME
Ctqmcoffdiag_setSeed
FUNCTION
initialize random number generator
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc iseed=seed from imput
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
596 SUBROUTINE Ctqmcoffdiag_setSeed(op,iseed) 597 598 !Arguments ------------------------------------ 599 TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op 600 INTEGER , INTENT(IN ) :: iseed 601 !Local variables ------------------------------ 602 !INTEGER :: n 603 !INTEGER :: i 604 !INTEGER, DIMENSION(:), ALLOCATABLE :: seed 605 606 607 !CALL RANDOM_SEED(size = n) 608 !MALLOC(seed,(n)) 609 !seed = iseed + (/ (i - 1, i = 1, n) /) 610 611 !CALL RANDOM_SEED(PUT = seed+op%rank) 612 613 !FREE(seed) 614 615 op%seed=INT(iseed+op%rank,8) 616 617 END SUBROUTINE Ctqmcoffdiag_setSeed
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setSweeps [ Functions ]
NAME
Ctqmcoffdiag_setSweeps
FUNCTION
set the number of sweeps
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc sweeps=asked sweeps
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
541 SUBROUTINE Ctqmcoffdiag_setSweeps(op,sweeps) 542 543 !Arguments ------------------------------------ 544 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 545 DOUBLE PRECISION , INTENT(IN ) :: sweeps 546 547 op%sweeps = NINT(sweeps / DBLE(op%size)) 548 ! !write(std_out,*) op%sweeps,NINT(sweeps / DBLE(op%size)),ANINT(sweeps/DBLE(op%size)) 549 IF ( DBLE(op%sweeps) .NE. ANINT(sweeps/DBLE(op%size)) ) & 550 CALL ERROR("Ctqmcoffdiag_setSweeps : sweeps is negative or too big ") 551 IF ( op%sweeps .LT. 2*CTQMC_SLICE1 ) THEN !202 552 CALL WARNALL("Ctqmcoffdiag_setSweeps : # sweeps automtically changed ") 553 op%sweeps = 2*CTQMC_SLICE1 554 ! ELSE IF ( op%sweeps .LT. op%thermalization ) THEN 555 ! CALL WARNALL("Ctqmcoffdiag_setSweeps : Thermalization > sweeps / cpu -> auto fix") 556 ! op%sweeps = op%thermalization 557 END IF 558 IF ( DBLE(NINT(DBLE(op%sweeps)*DBLE(op%size)/DBLE(CTQMC_SLICE1))) .NE. & 559 ANINT(DBLE(op%sweeps)*DBLE(op%size)/DBLE(CTQMC_SLICE1)) ) THEN 560 op%modNoise1 = op%sweeps 561 ELSE 562 op%modNoise1 = MIN(op%sweeps,INT(DBLE(op%sweeps)*DBLE(op%size) / DBLE(CTQMC_SLICE1))) !101 563 END IF 564 op%modNoise2 = MAX(op%modNoise1 / CTQMC_SLICE2, 1) ! 100 565 ! op%modGlobalMove(1) = op%thermalization / 10 + 1 566 ! op%modGlobalMove(2) = 0 567 568 END SUBROUTINE Ctqmcoffdiag_setSweeps
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setU [ Functions ]
NAME
Ctqmcoffdiag_setU
FUNCTION
set the interaction matrix
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc matU=interaction matrix
OUTPUT
SIDE EFFECTS
NOTES
SOURCE
943 SUBROUTINE Ctqmcoffdiag_setU(op,matU) 944 945 !Arguments ------------------------------------ 946 TYPE(Ctqmcoffdiag), INTENT(INOUT) ::op 947 !Local variables ------------------------------ 948 DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN) :: matU 949 950 IF ( SIZE(matU) .NE. op%flavors*op%flavors ) & 951 CALL ERROR("Ctqmcoffdiag_setU : Wrong interaction matrix (size) ") 952 953 CALL ImpurityOperator_setUmat(op%Impurity, matU) 954 op%setU = .TRUE. 955 END SUBROUTINE Ctqmcoffdiag_setU
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_symmetrizeGreen [ Functions ]
NAME
Ctqmcoffdiag_symmetrizeGreen
FUNCTION
optionnaly symmetrize the green functions
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc syms=weight factors
OUTPUT
argout(sizeout)=description
SIDE EFFECTS
NOTES
SOURCE
3475 SUBROUTINE Ctqmcoffdiag_symmetrizeGreen(op, syms) 3476 3477 !Arguments ------------------------------------ 3478 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 3479 DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN ) :: syms 3480 !Local variables ------------------------------ 3481 !INTEGER :: iflavor1 3482 !INTEGER :: iflavor2 3483 !INTEGER :: flavors 3484 !DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: green_tmp 3485 !DOUBLE PRECISION, ALLOCATABLE, DIMENSION(: ) :: n_tmp 3486 3487 ABI_UNUSED((/syms(1,1), op%swap/)) 3488 3489 ! flavors = op%flavors 3490 ! IF ( SIZE(syms,1) .NE. flavors .OR. SIZE(syms,2) .NE. flavors ) THEN 3491 ! CALL WARNALL("Ctqmcoffdiag_symmetrizeGreen : wrong opt_sym -> not symmetrizing") 3492 ! RETURN 3493 ! END IF 3494 ! 3495 ! MALLOC(green_tmp,(1:op%samples+1,flavors)) 3496 ! green_tmp(:,:) = 0.d0 3497 ! MALLOC(n_tmp,(1:flavors)) 3498 ! n_tmp(:) = 0.d0 3499 ! DO iflavor1=1, flavors 3500 ! DO iflavor2=1,flavors 3501 ! green_tmp(:,iflavor1) = green_tmp(:,iflavor1) & 3502 ! + syms(iflavor2,iflavor1) * op%Greens(iflavor2)%oper(:) 3503 ! n_tmp(iflavor1) = n_tmp(iflavor1) & 3504 ! + syms(iflavor2,iflavor1) * op%measN(1,iflavor2) 3505 ! END DO 3506 ! END DO 3507 ! DO iflavor1=1, flavors 3508 ! op%Greens(iflavor1)%oper(:) = green_tmp(:,iflavor1) 3509 ! op%measN(1,iflavor1) = n_tmp(iflavor1) 3510 ! END DO 3511 ! FREE(green_tmp) 3512 ! FREE(n_tmp) 3513 END SUBROUTINE Ctqmcoffdiag_symmetrizeGreen
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_tryAddRemove [ Functions ]
NAME
Ctqmcoffdiag_tryAddRemove
FUNCTION
Try to add or remove a segment and an anti-segment
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
updated=something changed
SIDE EFFECTS
NOTES
SOURCE
2131 SUBROUTINE Ctqmcoffdiag_tryAddRemove(op,updated) 2132 2133 !Arguments ------------------------------------ 2134 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 2135 ! TYPE(BathOperatoroffdiag) , INTENT(INOUT) :: Bath 2136 ! TYPE(ImpurityOperator), INTENT(INOUT) :: Impurity 2137 LOGICAL , INTENT( OUT) :: updated 2138 !Local variables ------------------------------ 2139 INTEGER :: position 2140 INTEGER , DIMENSION(1:2) :: nature ! -2 for antiseg and 1 for seg 2141 INTEGER :: i! -2 for antiseg and 1 for seg 2142 !INTEGER :: it,it1 !ii, 2143 DOUBLE PRECISION :: action 2144 DOUBLE PRECISION :: beta 2145 DOUBLE PRECISION :: time1 2146 DOUBLE PRECISION :: time2 2147 DOUBLE PRECISION :: time_avail 2148 DOUBLE PRECISION :: det_ratio,sign_det_ratio 2149 DOUBLE PRECISION :: overlap 2150 DOUBLE PRECISION :: length 2151 DOUBLE PRECISION :: signe 2152 DOUBLE PRECISION :: tail 2153 INTEGER :: tailint 2154 DOUBLE PRECISION :: signdet, signdetprev 2155 DOUBLE PRECISION, DIMENSION(1:2) :: CdagC_1 2156 2157 IF ( .NOT. op%set ) & 2158 CALL ERROR("Ctqmcoffdiag_trySegment : QMC not set ") 2159 2160 !write(std_out,*) " TryAddRemove start" 2161 nature(1) = CTQMC_SEGME 2162 nature(2) = CTQMC_ANTIS 2163 beta = op%beta 2164 2165 updated = .FALSE. 2166 tailint = (op%Impurity%particles(op%Impurity%activeFlavor)%tail) 2167 tail = DBLE(tailint) 2168 !write(std_out,*) "op%Impurity%particles(op%Impurity%activeFlavor)%tail",op%Impurity%activeFlavor,tail 2169 2170 2171 !===================================== 2172 ! First choose segment or antisegment 2173 !===================================== 2174 DO i = 1, 2 2175 signe = SIGN(1.d0,DBLE(nature(i))) 2176 ! ----- 1: segment signe= 1 ( CTQMC_SEGME = 1 ) 2177 ! ----- 2: antisegment signe=-1 ( CTQMC_ANTIS = -2 ) 2178 ! NB: Sign(a,b) = sign(b) * a 2179 2180 !prt!if(op%prtopt==1) write(std_out,*) " ==Starting configuration",i 2181 !prt!if(op%prtopt==1) write(std_out,*) " = Segments:" 2182 tailint = (op%Impurity%particles(op%Impurity%activeFlavor)%tail) 2183 !prt! do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail 2184 !prt!if(op%prtopt==1) write(std_out,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1), & 2185 !prt!& op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2) 2186 !prt! enddo 2187 !sui!write(std_out,*) " = M Matrix",op%Bath%sumtails 2188 !prt! do it=1,op%Bath%sumtails 2189 !sui!write(std_out,'(a,3x,500e10.3)') " M start",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails) 2190 !prt! enddo 2191 CALL OurRng(op%seed,action) 2192 2193 !========================== 2194 ! Add segment/antisegment 2195 !========================== 2196 IF ( action .LT. .5d0 ) THEN ! Add a segment or antisegment 2197 !ii write(std_out,*) " =try: Segment added of type",i,op%prtopt 2198 2199 ! Select time1 (>0) in [0,beta] 2200 !============================== 2201 CALL OurRng(op%seed,time1) 2202 time1 = time1 * beta 2203 2204 ! time_avail is the distance between between time1 and 2205 ! - the next start of a segment for a segment addition 2206 ! - the next end of a segment for an antisegment addition 2207 ! ImpurityOperator_getAvailableTime > 0 for a segment (signe>0) -> time_avail>0 2208 ! ImpurityOperator_getAvailableTime < 0 for an antisegment (signe<0) -> time_avail>0 2209 !==================================================================== 2210 time_avail = ImpurityOperator_getAvailableTime(op%Impurity,time1,position) * signe 2211 !ii write(std_out,*) " =try: time_avail",time_avail,time1 2212 IF ( time_avail .GT. 0.d0 ) THEN 2213 2214 ! Time2 is the length of the proposed new (anti)segment 2215 !======================================================= 2216 CALL OurRng(op%seed,time2) 2217 IF ( time2 .EQ. 0.d0 ) CALL OurRng(op%seed,time2) ! Prevent null segment 2218 2219 ! Now time2 is the time at the end of the proposed new (anti) segment 2220 ! time2 > time1 2221 !==================================================================== 2222 time2 = time1 + time2 * time_avail 2223 !sui!write(std_out,*) tailint+1,time1,time2,position 2224 ! CALL CdagC_init(CdagC_1,time1,time2) 2225 2226 ! CdagC_1 gives the stard/end times for the proposed new segment/antisegment 2227 ! CdagC1(C_) can be above beta. 2228 ! For a segment CdagC_1(Cdag_) = time1 < CdagC_1(C_) = time2, l=time2-time1 > 0 2229 ! For a anti segment CdagC_1(Cdag_) = time2 > CdagC_1(C_) = time1, l=time1-time2 < 0 2230 ! time2 can be above beta and thus for a segment CdagC_1(C_ ) > beta 2231 ! time2 can be above beta and thus for an antisegment CdagC_1(Cdag_) > beta 2232 ! length > 0 for segment 2233 ! length < 0 for antisegment 2234 !==================================================================================== 2235 CdagC_1(Cdag_) = ((1.d0+signe)*time1+(1.d0-signe)*time2)*0.5d0 2236 CdagC_1(C_ ) = ((1.d0+signe)*time2+(1.d0-signe)*time1)*0.5d0 2237 ! length = CdagC_length(CdagC_1) 2238 length = CdagC_1(C_ ) - CdagC_1(Cdag_) 2239 !write(std_out,*) " try : times", CdagC_1(C_ ),CdagC_1(Cdag_) 2240 !write(std_out,*) " length", length 2241 2242 ! ----- Computes the determinant ratio 2243 det_ratio = BathOperatoroffdiag_getDetAdd(op%Bath,CdagC_1,position,op%Impurity%particles) 2244 2245 ! ----- Computes the overlap 2246 overlap = ImpurityOperator_getNewOverlap(op%Impurity,CdagC_1) 2247 signdetprev = ImpurityOperator_getsign(op%Impurity, time2, i, action, position) 2248 2249 !write(std_out,*) " overlap ", overlap 2250 CALL OurRng(op%seed,time1) 2251 !write(std_out,*) " Rnd", time1 2252 signdet=1.d0 2253 det_ratio=det_ratio*signdetprev 2254 2255 IF ( det_ratio .LT. 0.d0 ) THEN 2256 !sui!write(std_out,*) " NEGATIVE DET",det_ratio,signdetprev 2257 det_ratio = - det_ratio 2258 sign_det_ratio=-1 2259 op%stats(nature(i)+CTQMC_DETSI) = op%stats(nature(i)+CTQMC_DETSI) + 1.d0 2260 ! op%signvaluecurrent=-1.d0 2261 ELSE 2262 sign_det_ratio=1 2263 ! op%signvaluecurrent=+1.d0 2264 ! signdet=-1.d0 2265 !sui!write(std_out,*) " DET",det_ratio,signdetprev 2266 END IF 2267 !ii write(std_out,*) " DET",det_ratio 2268 ! op%signvaluemeas=op%signvaluemeas+1.d0 2269 !write(std_out,*) " .................",(time1 * (tail + 1.d0 )),beta * time_avail * det_ratio * DEXP(op%mu(op%Impurity%activeFlavor)*length + overlap) 2270 !write(std_out,*) " .................",beta , time_avail , op%mu(op%Impurity%activeFlavor),op%Impurity%activeFlavor 2271 2272 IF ( (time1 * (tail + 1.d0 )) & 2273 .LT. (beta * time_avail * det_ratio * DEXP(op%mu(op%Impurity%activeFlavor)*length + overlap) ) ) THEN 2274 ! write(*,*) "before" 2275 ! CALL ListCdagCoffdiag_print(op%Impurity%particles(op%Impurity%activeFlavor),6) 2276 CALL ImpurityOperator_add(op%Impurity,CdagC_1,position) 2277 ! write(*,*) "after " 2278 ! CALL ListCdagCoffdiag_print(op%Impurity%particles(op%Impurity%activeFlavor),6) 2279 CALL BathOperatoroffdiag_setMAdd(op%bath,op%Impurity%particles) 2280 op%stats(nature(i)+CTQMC_ADDED) = op%stats(nature(i)+CTQMC_ADDED) + 1.d0 2281 updated = .TRUE. .OR. updated 2282 tail = tail + 1.d0 2283 tailint = tailint + 1 2284 ! read(*,*) time1 2285 !ii write(6,*) " Accepted addition, new conf is",time1 2286 !prt! do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail 2287 !prt!if(op%prtopt==1) write(6,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1),& 2288 !prt!& op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2) 2289 !prt! enddo 2290 !sui!write(6,*) " = M Matrix" 2291 !prt! do it=1,op%Bath%sumtails 2292 !sui!write(6,*) " M new",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails) 2293 !prt! enddo 2294 2295 IF ( sign_det_ratio .LT. 0.d0 ) op%signvalue=-op%signvalue 2296 !sui!write(6,*) " signvalue",op%signvalue 2297 ELSE 2298 !ii write(6,*) " Refused addition: proba",time1 2299 END IF 2300 ELSE 2301 !sui!write(6,*) " Refused addition: time_avail <0" 2302 END IF 2303 2304 !======================================== 2305 ! Remove segment/antisegment 2306 !======================================== 2307 ELSE ! Remove a segment among the segment of the flavor activeflavor 2308 !ii if(op%prtopt==1) write(6,*) " =try: Segment removed of type",i 2309 IF ( tail .GT. 0.d0 ) THEN 2310 CALL OurRng(op%seed,time1) 2311 position = INT(((time1 * tail) + 1.d0) * signe ) 2312 !prt!if(op%prtopt==1) write(6,*) " position",position 2313 time_avail = ImpurityOperator_getAvailedTime(op%Impurity,position) 2314 det_ratio = BathOperatoroffdiag_getDetRemove(op%Bath,position) 2315 !write(6,*) " det_ratio", det_ratio 2316 CdagC_1 = ImpurityOperator_getSegment(op%Impurity,position) 2317 ! length = CdagC_length(CdagC_1) 2318 length = CdagC_1(C_) - CdagC_1(Cdag_) 2319 !write(6,*) " length ", length 2320 overlap = ImpurityOperator_getNewOverlap(op%Impurity,CdagC_1) 2321 !write(6,*) " overlap ", overlap 2322 CALL OurRng(op%seed,time1) 2323 !write(6,*) " Random ",time1 2324 signdetprev = ImpurityOperator_getsign(op%Impurity, time2, i, action, position) 2325 det_ratio=det_ratio*signdetprev 2326 signdet=1.d0 2327 IF ( det_ratio .LT. 0.d0 ) THEN 2328 !sui!write(6,*) " NEGATIVE DET",det_ratio,signdetprev 2329 det_ratio = -det_ratio 2330 sign_det_ratio=-1 2331 ! op%seg_sign = op%seg_sign + 1.d0 2332 op%stats(nature(i)+CTQMC_DETSI) = op%stats(nature(i)+CTQMC_DETSI) + 1.d0 2333 signdet=-1.d0 2334 ELSE 2335 sign_det_ratio=1 2336 !sui!write(6,*) " DET",det_ratio,signdetprev 2337 END IF 2338 !ii write(6,*) " DET",det_ratio 2339 IF ( (time1 * beta * time_avail * DEXP(op%mu(op%Impurity%activeFlavor)*length+overlap)) & 2340 .LT. (tail * det_ratio ) ) THEN 2341 CALL ImpurityOperator_remove(op%Impurity,position) 2342 CALL BathOperatoroffdiag_setMRemove(op%Bath,op%Impurity%particles) 2343 !op%seg_removed = op%seg_removed + 1.d0 2344 op%stats(nature(i)+CTQMC_REMOV) = op%stats(nature(i)+CTQMC_REMOV) + 1.d0 2345 updated = .TRUE. .OR. updated 2346 tail = tail -1.d0 2347 tailint = tailint -1 2348 !ii write(6,*) " Accepted removal, new conf is:",time1 2349 !prt! do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail 2350 !prt!if(op%prtopt==1) write(6,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1),& 2351 !prt!& op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2) 2352 !prt! enddo 2353 !sui!write(6,*) " = M Matrix" 2354 !prt! do it=1,op%Bath%sumtails 2355 !sui!write(6,*) " M new",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails) 2356 !prt! enddo 2357 IF ( sign_det_ratio .LT. 0.d0 ) op%signvalue=-op%signvalue 2358 !sui!write(6,*) " signvalue",op%signvalue 2359 ELSE 2360 !ii write(6,*) " Refused removal",time1 2361 END IF 2362 ELSE 2363 !sui!write(6,*) " Refused removal: no segment available" 2364 END IF 2365 END IF 2366 !======================================== 2367 ! End Add/Remove Antisegment 2368 !======================================== 2369 END DO 2370 END SUBROUTINE Ctqmcoffdiag_tryAddRemove
ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_trySwap [ Functions ]
NAME
Ctqmcoffdiag_trySwap
FUNCTION
try a global move (swap to flavors)
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
INPUTS
op=ctqmc
OUTPUT
flav_i=first flavor swaped flav_j=second flavor swaped
SIDE EFFECTS
NOTES
SOURCE
2570 SUBROUTINE Ctqmcoffdiag_trySwap(op,flav_i,flav_j) 2571 2572 !Arguments ------------------------------------ 2573 TYPE(Ctqmcoffdiag) , INTENT(INOUT) :: op 2574 ! TYPE(BathOperatoroffdiag) , INTENT(INOUT) :: Bath 2575 ! TYPE(ImpurityOperator), INTENT(INOUT) :: Impurity 2576 INTEGER , INTENT( OUT) :: flav_i 2577 INTEGER , INTENT( OUT) :: flav_j 2578 !Local variables ------------------------------ 2579 INTEGER :: flavor_i 2580 INTEGER :: flavor_j !,ii,it,it1 !,iflavor 2581 DOUBLE PRECISION :: rnd 2582 DOUBLE PRECISION :: lengthi 2583 DOUBLE PRECISION :: lengthj 2584 DOUBLE PRECISION :: overlapic1 2585 DOUBLE PRECISION :: overlapjc1 2586 DOUBLE PRECISION :: overlapic2 2587 DOUBLE PRECISION :: overlapjc2 2588 !DOUBLE PRECISION :: detic1 2589 !DOUBLE PRECISION :: detjc1 2590 !DOUBLE PRECISION :: detic2 2591 !DOUBLE PRECISION :: detjc2 2592 DOUBLE PRECISION :: det_ratio,detnew,detold 2593 DOUBLE PRECISION :: local_ratio 2594 ! TYPE(BathOperatoroffdiag) :: Bathnew 2595 2596 2597 !CALL RANDOM_NUMBER(rnd) 2598 CALL OurRng(op%seed,rnd) 2599 flavor_i = NINT(rnd*DBLE(op%flavors-1.d0))+1 2600 !CALL RANDOM_NUMBER(rnd) 2601 CALL OurRng(op%seed,rnd) 2602 flavor_j = NINT(rnd*DBLE(op%flavors-1.d0))+1 2603 !ii write(6,'(a,2i4)') "--------------- new swap --------------------------------",flavor_i,flavor_j 2604 2605 flav_i = 0 2606 flav_j = 0 2607 !ii do iflavor=1,op%flavors 2608 !ii write(6,*) "BEFORE GMOVE For flavor", iflavor,"size is",op%Impurity%particles(iflavor)%tail," and Conf is :" 2609 !ii do ii=1, op%Impurity%Particles(iflavor)%tail 2610 !ii write(6,'(i4,100f12.3)') ii, op%Impurity%Particles(iflavor)%list(ii,1),& 2611 !ii & op%Impurity%Particles(iflavor)%list(ii,2) 2612 !ii enddo 2613 !ii enddo 2614 !ii write(6,*) " = M Matrix" 2615 !ii write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors) 2616 !ii write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors) 2617 !ii do it=1,op%Bath%sumtails 2618 !ii write(6,'(a,100f12.3)') " M before",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails) 2619 !ii enddo 2620 2621 ! todoba this part 2622 IF ( flavor_i .NE. flavor_j ) THEN 2623 !CALL BathOperatoroffdiag_init(Bathnew, op%flavors, op%samples, op%beta, 0, op%opt_nondiag) 2624 ! On tente d'intervertir i et j 2625 ! Configuration actuelle : 2626 2627 op%modGlobalMove(2) = op%modGlobalMove(2)+1 2628 ! =========================================== 2629 ! First use M matrix to compute determinant 2630 ! =========================================== 2631 detold = BathOperatoroffdiag_getDetF(op%Bath) ! use op%Bath%M 2632 2633 ! =========================================== 2634 ! Second build M_update matrix to compute determinant after. 2635 ! =========================================== 2636 !CALL ListCdagCoffdiag_print(particle) 2637 call BathOperatoroffdiag_recomputeM(op%Bath,op%impurity%particles,flavor_i,flavor_j) ! compute op%Bath%M_update 2638 detnew = BathOperatoroffdiag_getDetF(op%Bath,option=1) ! use op%Bath%M_update 2639 2640 lengthi = ImpurityOperator_measN(op%Impurity,flavor_i) 2641 lengthj = ImpurityOperator_measN(op%Impurity,flavor_j) 2642 overlapic1 = ImpurityOperator_overlapFlavor(op%Impurity,flavor_i) 2643 overlapjc1 = ImpurityOperator_overlapFlavor(op%Impurity,flavor_j) 2644 ! lengths unchanged 2645 overlapic2 = ImpurityOperator_overlapSwap(op%Impurity,flavor_i,flavor_j) 2646 overlapjc2 = ImpurityOperator_overlapSwap(op%Impurity,flavor_j,flavor_i) 2647 2648 ! IF ( detic1*detjc1 .EQ. detic2*detjc2 ) THEN 2649 ! det_ratio = 1.d0 2650 ! ELSE IF ( detic1*detjc1 .EQ. 0.d0 ) THEN 2651 ! det_ratio = detic2*detjc2 ! evite de diviser par 0 si pas de segment 2652 ! ELSE 2653 2654 det_ratio = detnew/detold ! because the determinant is the determinant of F 2655 !ii write(6,*) "det_ratio, detold,detnew",det_ratio, detold,detnew, detold/detnew 2656 2657 ! END IF 2658 local_ratio = DEXP(-overlapic2*overlapjc2+overlapic1*overlapjc1 & 2659 +(lengthj-lengthi)*(op%mu(flavor_i)-op%mu(flavor_j))) 2660 !ii write(6,*) "local_ratio",local_ratio 2661 2662 ! Wloc = exp(muN-Uo) 2663 !CALL RANDOM_NUMBER(rnd) 2664 CALL OurRng(op%seed,rnd) 2665 IF ( rnd .LT. local_ratio*det_ratio ) THEN ! swap accepted 2666 !ii write(6,*) " = M Matrix before swap" 2667 !ii write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors) 2668 !ii write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors) 2669 !ii do it=1,op%Bath%sumtails 2670 !ii write(6,'(a,100f12.3)') " M after ",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails) 2671 !ii enddo 2672 !ii do it=1,op%Bath%sumtails 2673 !ii write(6,'(a,100f12.3)') " update M after ",(op%Bath%M_update%mat(it,it1),it1=1,op%Bath%sumtails) 2674 !ii enddo 2675 !ii write(6,*) "Gmove accepted",rnd,local_ratio*det_ratio 2676 CALL ImpurityOperator_swap(op%Impurity, flavor_i,flavor_j) 2677 CALL BathOperatoroffdiag_swap (op%Bath , flavor_i,flavor_j) ! use op%Bath%M_update to built new op%Bath%M 2678 2679 op%swap = op%swap + 1.d0 2680 flav_i = flavor_i 2681 flav_j = flavor_j 2682 ELSE 2683 !ii write(6,*) "Gmove refused",rnd,local_ratio*det_ratio 2684 ! CALL WARN("Swap refused") 2685 ! WRITE(op%ostream,'(6E24.14)') local_ratio, det_ratio, detic1, detjc1, detic2, detjc2 2686 END IF 2687 ! CALL BathOperatoroffdiag_destroy(Bathnew) 2688 END IF 2689 !ii do iflavor=1,op%flavors 2690 !ii write(6,*) "AFTER GMOVE For flavor", iflavor,"size is",op%Impurity%particles(iflavor)%tail," and Conf is :" 2691 !ii do ii=1, op%Impurity%Particles(iflavor)%tail 2692 !ii write(6,'(15x,i4,100f12.3)') ii, op%Impurity%Particles(iflavor)%list(ii,1),& 2693 !ii & op%Impurity%Particles(iflavor)%list(ii,2) 2694 !ii enddo 2695 !ii enddo 2696 !ii write(6,*) " = M Matrix" 2697 !ii write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors) 2698 !ii write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors) 2699 !ii do it=1,op%Bath%sumtails 2700 !ii write(6,'(a,100f12.3)') " M after ",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails) 2701 !ii enddo 2702 !ii do it=1,op%Bath%sumtails 2703 !ii write(6,'(a,100f12.3)') " update M after ",(op%Bath%M_update%mat(it,it1),it1=1,op%Bath%sumtails) 2704 !ii enddo 2705 2706 END SUBROUTINE Ctqmcoffdiag_trySwap
m_Ctqmcoffdiag/Ctqmcoffdiag [ Types ]
[ Top ] [ m_Ctqmcoffdiag ] [ Types ]
NAME
Ctqmcoffdiag
FUNCTION
This structured datatype contains the necessary data
COPYRIGHT
Copyright (C) 2013-2022 ABINIT group (J. Bieder) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
SOURCE
98 TYPE Ctqmcoffdiag 99 100 LOGICAL :: init = .FALSE. 101 ! Flag: is MC initialized 102 103 LOGICAL :: set = .FALSE. 104 ! Flag: ?? 105 106 LOGICAL :: setU = .FALSE. 107 ! Flag: is U Set ? 108 109 LOGICAL :: inF = .FALSE. 110 ! Flag: is hybridization fct in input ? 111 112 LOGICAL :: done = .FALSE. 113 ! Flag: is MC terminated ? 114 115 LOGICAL :: para = .FALSE. 116 ! Flag: do we have parameters in input 117 118 LOGICAL :: have_MPI = .FALSE. 119 ! Flag: 120 121 INTEGER :: opt_movie = 0 122 ! 123 124 INTEGER :: opt_analysis = 0 125 ! correlations 126 127 INTEGER :: opt_check = 0 128 ! various check 0 129 ! various check 1 impurity 130 ! various check 2 bath 131 ! various check 3 both 132 133 INTEGER :: opt_order = 0 134 ! nb of segments max for analysis 135 136 INTEGER :: opt_histo = 0 137 ! Enable histo calc. 138 139 INTEGER :: opt_noise = 0 140 ! compute noise 141 142 INTEGER :: opt_spectra = 0 143 ! markov chain FT (correlation time) 144 145 INTEGER :: opt_levels = 0 146 ! do we have energy levels 147 148 INTEGER :: opt_hybri_limit = 0 149 ! do we have limit of hybridization (yes=1) 150 151 INTEGER :: opt_nondiag = 0 152 ! if opt_nondiag = 1 F is non diagonal. 153 154 INTEGER :: prtopt = 1 155 ! printing 156 157 INTEGER :: flavors 158 ! number of flavors 159 160 INTEGER :: measurements 161 ! The modulo used to measure the interaction energy and the number of electrons. Example : 2 means the measure is perform every two sweeps. 162 163 INTEGER :: samples 164 ! nb of L points (dmftqmc_l) 165 166 INTEGER(8) :: seed 167 ! 168 169 INTEGER :: sweeps 170 ! 171 172 INTEGER :: thermalization 173 ! 174 175 INTEGER :: ostream 176 ! output file 177 178 INTEGER :: istream 179 ! input file 180 181 INTEGER :: modNoise1 182 ! measure the noise each modNoise1 183 184 INTEGER :: modNoise2 185 ! measure the noise each modNoise2 186 187 INTEGER :: activeFlavor 188 ! orbital on which one do sth now 189 190 INTEGER, DIMENSION(1:2) :: modGlobalMove 191 ! 1: global move each modglobalmove(1) 192 ! 2: we have done modglobalmove(2) for two different orbitals. 193 194 INTEGER :: Wmax 195 ! Max freq for FT 196 197 DOUBLE PRECISION, DIMENSION(1:6) :: stats 198 ! to now how many negative determinant, antisegments,seeme.e.twfs...j 199 200 DOUBLE PRECISION :: swap 201 ! nb of successfull GM 202 203 DOUBLE PRECISION :: signvalue 204 205 INTEGER :: MY_COMM 206 ! 207 208 INTEGER :: rank 209 ! 210 211 INTEGER :: size 212 ! size of MY_COMM 213 214 DOUBLE PRECISION :: runTime ! time for the run routine 215 ! 216 217 DOUBLE PRECISION :: beta 218 ! 219 220 DOUBLE PRECISION :: U 221 222 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: mu 223 ! levels 224 225 COMPLEX(KIND=8), ALLOCATABLE, DIMENSION(:,:) :: hybri_limit 226 ! coeff A such that F=-A/(iwn) 227 228 TYPE(GreenHyboffdiag) :: Greens 229 ! Green's function 230 231 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: measN 232 ! measure of occupations (3or4,flavor) 233 234 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,: ) :: measDE 235 ! (flavor,flavor) double occupancies 236 ! (1,1): total energy of correlation. 237 238 DOUBLE PRECISION :: a_Noise 239 ! Noise a exp (-bx) for the noise 240 241 DOUBLE PRECISION :: b_Noise 242 ! Noise a exp (-bx) for the noise 243 244 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: abNoiseG !(ab,tau,flavor) 245 ! Noise but for G 246 247 TYPE(Vector) , DIMENSION(1:2) :: measNoise 248 TYPE(Vector), ALLOCATABLE, DIMENSION(:,:,:) :: measNoiseG !(tau,flavor,mod) 249 ! accumulate each value relataed to measurenoise 1 2 250 251 !#ifdef CTCtqmcoffdiag_ANALYSIS 252 ! INTEGER :: order 253 DOUBLE PRECISION :: inv_dt 254 ! 1/(beta/L) 255 256 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,: ) :: measPerturbation 257 ! opt_order,nflavor 258 259 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: occup_histo_time 260 ! nflavor 261 262 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,: ) :: meas_fullemptylines 263 ! opt_order,nflavor 264 265 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: measCorrelation 266 ! segment,antisegment,nflavor,nflavor 267 268 !#endif 269 !#ifdef CTCtqmcoffdiag_CHECK 270 DOUBLE PRECISION :: errorImpurity 271 ! check 272 273 DOUBLE PRECISION :: errorBath 274 ! for check 275 276 !#endif 277 TYPE(BathOperatoroffdiag) :: Bath 278 279 280 TYPE(ImpurityOperator) :: Impurity 281 282 DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: density 283 284 END TYPE Ctqmcoffdiag