TABLE OF CONTENTS


ABINIT/m_Ctqmcoffdiag [ Modules ]

[ Top ] [ Modules ]

NAME

  m_Ctqmcoffdiag

FUNCTION

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

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

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

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_allocateAll [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_allocateAll

FUNCTION

  Allocate all non option variables

COPYRIGHT

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

INPUTS

  op=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

702 SUBROUTINE Ctqmcoffdiag_allocateAll(op)
703 
704 !Arguments ------------------------------------
705 
706 !This section has been created automatically by the script Abilint (TD).
707 !Do not modify the following lines by hand.
708 #undef ABI_FUNC
709 #define ABI_FUNC 'Ctqmcoffdiag_allocateAll'
710 !End of the abilint section
711 
712   implicit none
713 
714   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
715 !Local variables ------------------------------
716   INTEGER                  :: flavors
717 
718   IF ( .NOT. op%para ) &
719     CALL ERROR("Ctqmcoffdiag_allocateAll : Ctqmcoffdiag_setParameters never called  ")
720 
721   flavors = op%flavors
722 
723 
724 !  number of electrons
725   FREEIF(op%measN)
726   MALLOC(op%measN,(1:4,1:flavors))
727   op%measN = 0.d0
728 
729 !  double occupancies 
730   FREEIF(op%measDE)
731   MALLOC(op%measDE,(1:flavors,1:flavors) )
732   op%measDE = 0.d0
733 
734   FREEIF(op%mu)
735   MALLOC(op%mu,(1:flavors) )
736   op%mu = 0.d0
737   FREEIF(op%hybri_limit)
738   MALLOC(op%hybri_limit,(flavors,flavors) )
739   op%hybri_limit = czero
740 END SUBROUTINE Ctqmcoffdiag_allocateAll

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_allocateOpt [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_allocateOpt

FUNCTION

  allocate all option variables 

COPYRIGHT

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

INPUTS

  op=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

774 SUBROUTINE Ctqmcoffdiag_allocateOpt(op)
775 
776 !Arguments ------------------------------------
777 
778 !This section has been created automatically by the script Abilint (TD).
779 !Do not modify the following lines by hand.
780 #undef ABI_FUNC
781 #define ABI_FUNC 'Ctqmcoffdiag_allocateOpt'
782 !End of the abilint section
783 
784   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
785 !Local variables ------------------------------
786   INTEGER :: i
787   INTEGER :: j
788   INTEGER :: k
789 
790   IF ( .NOT. op%para ) &
791     CALL ERROR("Ctqmcoffdiag_allocateOpt : Ctqmcoffdiag_setParameters never called  ")
792 
793   IF ( op%opt_analysis .EQ. 1 ) THEN
794     FREEIF(op%measCorrelation)
795     MALLOC(op%measCorrelation,(1:op%samples+1,1:3,1:op%flavors))
796     op%measCorrelation = 0.d0
797   END IF
798 
799   IF ( op%opt_order .GT. 0 ) THEN
800     FREEIF(op%measPerturbation)
801     MALLOC(op%measPerturbation,(1:op%opt_order,1:op%flavors))
802     op%measPerturbation = 0.d0
803     FREEIF(op%meas_fullemptylines)
804     MALLOC(op%meas_fullemptylines,(2,1:op%flavors))
805     op%meas_fullemptylines = 0.d0
806   END IF
807 
808   IF ( op%opt_noise .EQ. 1 ) THEN
809     IF ( ALLOCATED(op%measNoiseG) ) THEN
810       DO i=1,2
811         DO j = 1, op%flavors
812           DO k= 1, op%samples+1
813             CALL Vector_destroy(op%measNoiseG(k,j,i))
814           END DO
815         END DO
816       END DO
817       DT_FREE(op%measNoiseG)
818     END IF
819     DT_MALLOC(op%measNoiseG,(1:op%samples+1,1:op%flavors,1:2))
820     !DO i=1,2
821       DO j = 1, op%flavors
822         DO k= 1, op%samples+1
823           CALL Vector_init(op%measNoiseG(k,j,1),CTQMC_SLICE1)
824         END DO
825       END DO
826       DO j = 1, op%flavors
827         DO k= 1, op%samples+1
828           CALL Vector_init(op%measNoiseG(k,j,2),CTQMC_SLICE1*CTQMC_SLICE2+1) ! +1 pour etre remplacer ceil
829         END DO
830       END DO
831     !END DO
832     FREEIF(op%abNoiseG)
833     MALLOC(op%aBNoiseG,(1:2,1:op%samples+1,op%flavors))
834     op%abNoiseG = 0.d0
835   END IF
836 
837   IF (op%opt_spectra .GE. 1 ) THEN
838     FREEIF(op%density)
839     !MALLOC(op%density,(1:op%thermalization,1:op%flavors))
840     i = CEILING(DBLE(op%thermalization+op%sweeps)/DBLE(op%measurements*op%opt_spectra))
841     MALLOC(op%density,(1:op%flavors+1,1:i))
842     op%density = 0.d0
843   END IF
844 !#endif
845 END SUBROUTINE Ctqmcoffdiag_allocateOpt

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_clear [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_clear

FUNCTION

  clear a ctqmc run

COPYRIGHT

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

INPUTS

  op=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1086 SUBROUTINE Ctqmcoffdiag_clear(op)
1087 
1088 !Arguments ------------------------------------
1089 
1090 !This section has been created automatically by the script Abilint (TD).
1091 !Do not modify the following lines by hand.
1092 #undef ABI_FUNC
1093 #define ABI_FUNC 'Ctqmcoffdiag_clear'
1094 !End of the abilint section
1095 
1096   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
1097 !Local variables ------------------------------
1098   INTEGER :: i
1099   INTEGER :: j
1100   INTEGER :: k
1101 
1102   op%measN(1,:) = 0.d0
1103   op%measN(2,:) = 0.d0
1104   !Do not set measN(3,:) to 0 to avoid erasing N between therm and ctqmc
1105   op%measN(4,:) = 0.d0
1106   op%measDE = 0.d0
1107 !  op%seg_added    = 0.d0
1108 !  op%anti_added   = 0.d0
1109 !  op%seg_removed  = 0.d0
1110 !  op%anti_removed = 0.d0
1111 !  op%seg_sign     = 0.d0
1112 !  op%anti_sign    = 0.d0
1113   op%stats(:)     = 0.d0
1114 !  op%signvaluecurrent    = 0.d0
1115 !  op%signvaluemeas    = 0.d0
1116   op%swap         = 0.d0
1117   op%runTime      = 0.d0
1118   op%modGlobalMove(2) = 0 
1119   CALL Vector_clear(op%measNoise(1))
1120   CALL Vector_clear(op%measNoise(2))
1121 !#ifdef CTCtqmcoffdiag_CHECK
1122   op%errorImpurity = 0.d0
1123   op%errorBath     = 0.d0
1124 !#endif
1125   CALL GreenHyboffdiag_clear(op%Greens)
1126 !#ifdef CTCtqmcoffdiag_ANALYSIS
1127   IF ( op%opt_analysis .EQ. 1 .AND. ALLOCATED(op%measCorrelation) ) &    
1128     op%measCorrelation = 0.d0 
1129   IF ( op%opt_order .GT. 0 .AND. ALLOCATED(op%measPerturbation) ) &
1130     op%measPerturbation = 0.d0
1131   IF ( op%opt_order .GT. 0 .AND. ALLOCATED(op%meas_fullemptylines) ) &
1132     op%meas_fullemptylines = 0.d0
1133   IF ( op%opt_noise .EQ. 1 .AND. ALLOCATED(op%measNoiseG) ) THEN
1134     DO i=1,2
1135       DO j = 1, op%flavors
1136         DO k= 1, op%samples+1
1137           CALL Vector_clear(op%measNoiseG(k,j,i))
1138         END DO
1139       END DO
1140     END DO
1141     !DO j = 1, op%flavors
1142     !  CALL GreenHyboffdiag_clear(op%Greens(j))
1143     !END DO
1144   END IF
1145 !#endif
1146 END SUBROUTINE Ctqmcoffdiag_clear

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_computeF [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_computeF

FUNCTION

  Compute the hybridization function

COPYRIGHT

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

INPUTS

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

OUTPUT

  F=hybridization function

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1360 SUBROUTINE Ctqmcoffdiag_computeF(op, Gomega, F, opt_fk)
1361 
1362  use m_hide_lapack,  only : xginv
1363 !Arguments ------------------------------------
1364 
1365 !This section has been created automatically by the script Abilint (TD).
1366 !Do not modify the following lines by hand.
1367 #undef ABI_FUNC
1368 #define ABI_FUNC 'Ctqmcoffdiag_computeF'
1369 !End of the abilint section
1370 
1371   TYPE(Ctqmcoffdiag)                       , INTENT(INOUT) :: op
1372   COMPLEX(KIND=8), DIMENSION(:,:,:), INTENT(IN   ) :: Gomega
1373   !INTEGER                         , INTENT(IN   ) :: Wmax
1374   DOUBLE PRECISION, DIMENSION(:,:,:), INTENT(INOUT) :: F
1375   INTEGER                         , INTENT(IN   ) :: opt_fk
1376 !Local variables ------------------------------
1377   INTEGER                                         :: flavors
1378   INTEGER                                         :: samples
1379   INTEGER                                         :: iflavor,ifl
1380   INTEGER                                         :: iflavor2
1381   INTEGER                                         :: iomega
1382   INTEGER                                         :: itau
1383   DOUBLE PRECISION                                :: pi_invBeta
1384   DOUBLE PRECISION                                :: K
1385   DOUBLE PRECISION                                :: re
1386   DOUBLE PRECISION                                :: im
1387   DOUBLE PRECISION                                :: det
1388   COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE   :: F_omega
1389   COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE   :: F_omega_inv
1390   COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE   :: Gomega_tmp
1391   TYPE(GreenHyboffdiag)                                     :: F_tmp
1392   character(len=4) :: tag_proc
1393   character(len=30) :: tmpfil
1394   INTEGER :: unitnb
1395 
1396   flavors    = op%flavors
1397 
1398   samples    = op%samples
1399   pi_invBeta = ACOS(-1.d0) / op%beta
1400   op%Wmax=SIZE(Gomega,1)
1401 !sui!write(6,*) "op%Wmax",op%Wmax
1402   !=================================
1403   ! --- Initialize F_tmp 
1404   !=================================
1405   IF ( op%have_MPI .EQV. .TRUE. ) THEN
1406     CALL GreenHyboffdiag_init(F_tmp,samples,op%beta,flavors,MY_COMM=op%MY_COMM)
1407   ELSE
1408     CALL GreenHyboffdiag_init(F_tmp,samples,op%beta,flavors)
1409   END IF
1410 !  K = op%mu
1411 
1412   !=================================
1413   ! --- Allocate F_omega
1414   !=================================
1415   MALLOC(F_omega,(1:op%Wmax,1:flavors,1:flavors))
1416   MALLOC(F_omega_inv,(1:flavors,1:flavors))
1417   MALLOC(Gomega_tmp,(1:op%Wmax,1:flavors,1:flavors))
1418   !op%hybri_limit(2,2)=op%hybri_limit(1,1)
1419   !op%mu(1)=op%mu(1)/10
1420   !op%mu(2)=op%mu(1)
1421   DO iomega=1,op%Wmax
1422     do iflavor=1,flavors
1423       do iflavor2=1,flavors
1424        ! Gomega_tmp(iomega,iflavor,iflavor2)=op%hybri_limit(iflavor,iflavor2)/(cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta))/3.d0
1425       enddo
1426     enddo
1427   END DO
1428   Gomega_tmp=Gomega
1429 
1430   !IF ( op%rank .EQ. 0 ) &
1431     !OPEN(UNIT=9876,FILE="K.dat",POSITION="APPEND")
1432   
1433   !=============================================================================================
1434   ! --- Compute Bath Green's function from Hybridization function in imaginary time
1435   !=============================================================================================
1436   !IF ( opt_fk .EQ. 0 ) THEN
1437    IF ( op%rank .EQ. 0 ) THEN
1438    !  DO iflavor = 1, flavors
1439    !    DO iflavor2 = 1, flavors
1440    !        write(330,*) "#",iflavor,iflavor2
1441    !        write(331,*) "#",iflavor,iflavor2
1442    !      do  iomega=1,op%Wmax
1443    !        write(330,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(Gomega_tmp(iomega,iflavor,iflavor2))
1444    !        write(331,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(Gomega_tmp(iomega,iflavor,iflavor2))
1445    !      enddo
1446    !        write(330,*) 
1447    !        write(331,*) 
1448    !    END DO
1449    !  END DO
1450    ENDIF
1451      DO iomega=1,op%Wmax
1452      !  be careful...here 
1453      ! Gomega in input is Fomega and 
1454      ! F_omega is   Gomega.
1455      ! COMPUTE G0 FROM F
1456        do iflavor=1,flavors
1457          do iflavor2=1,flavors
1458            if (iflavor==iflavor2) then
1459              F_omega_inv(iflavor,iflavor2)= (cmplx(0.d0,(2.d0*DBLE(iomega)-1.d0) * pi_invBeta,kind=8) &
1460 &             + op%mu(iflavor)- Gomega_tmp(iomega,iflavor,iflavor2))
1461            else
1462              F_omega_inv(iflavor,iflavor2)= (- Gomega_tmp(iomega,iflavor,iflavor2))
1463            endif
1464          enddo
1465        enddo
1466   !   END DO
1467   ! IF ( op%rank .EQ. 0 ) THEN
1468   !   DO iflavor = 1, flavors
1469   !     DO iflavor2 = 1, flavors
1470   !         write(334,*) "#",iflavor,iflavor2
1471   !         write(335,*) "#",iflavor,iflavor2
1472   !       do  iomega=1,op%Wmax
1473   !         write(334,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,iflavor,iflavor2))
1474   !         write(335,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_omega(iomega,iflavor,iflavor2))
1475   !       enddo
1476   !         write(334,*) 
1477   !         write(335,*) 
1478   !     END DO
1479   !   END DO
1480   ! ENDIF
1481 
1482   !   DO iomega=1,op%Wmax
1483        call xginv(F_omega_inv,flavors)
1484        do iflavor=1,flavors
1485          do iflavor2=1,flavors
1486            F_omega(iomega,iflavor,iflavor2) = F_omega_inv(iflavor,iflavor2)
1487          enddo
1488        enddo
1489      END DO
1490 
1491    !IF ( op%rank .EQ. 0 ) THEN
1492    !  DO iflavor = 1, flavors
1493    !    DO iflavor2 = 1, flavors
1494    !        write(332,*) "#",iflavor,iflavor2
1495    !        write(333,*) "#",iflavor,iflavor2
1496    !      do  iomega=1,op%Wmax
1497    !        write(332,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,iflavor,iflavor2))
1498    !        write(333,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_omega(iomega,iflavor,iflavor2))
1499    !      enddo
1500    !        write(332,*) 
1501    !        write(333,*) 
1502    !    END DO
1503    !  END DO
1504    !ENDIF
1505      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1506      !  for test: Fourier of G0(iwn)
1507      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1508    !sui!write(6,*) "opt_fk=0"
1509      CALL GreenHyboffdiag_setOperW(F_tmp,F_omega)
1510   ! IF ( op%rank .EQ. 0 ) THEN
1511   !    DO iflavor = 1, flavors
1512   !      DO iflavor2 = 1, flavors
1513   !          write(336,*) "#",iflavor,iflavor2
1514   !          write(337,*) "#",iflavor,iflavor2
1515   !        do  iomega=1,op%Wmax
1516   !          write(336,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2))
1517   !          write(337,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_tmp%oper_w(iomega,iflavor,iflavor2))
1518   !        enddo
1519   !          write(336,*) 
1520   !          write(337,*) 
1521   !      END DO
1522   !    END DO
1523   !  ENDIF
1524      CALL GreenHyboffdiag_backFourier(F_tmp,func="green")
1525      ! --- Put the result in F
1526      DO iflavor = 1, flavors
1527        DO iflavor2 = 1, flavors
1528          DO itau=1,samples+1
1529          F(itau,iflavor,iflavor2) = F_tmp%oper(itau,iflavor,iflavor2)
1530          END DO
1531        END DO
1532      END DO
1533      !IF ( op%rank .EQ. 0 ) THEN
1534      !  DO iflavor = 1, flavors
1535      !    DO iflavor2 = 1, flavors
1536      !        write(346,*) "#",iflavor,iflavor2
1537      !      do  itau=1,op%samples+1
1538      !        write(346,*) (itau-1)*op%beta/(op%samples),real(F(itau,iflavor,iflavor2))
1539      !      enddo
1540      !        write(346,*) 
1541      !    END DO
1542      !  END DO
1543      !ENDIF
1544      DO iflavor = 1, flavors
1545        DO iflavor2 = 1, flavors
1546          DO itau=1,samples+1
1547 !         This symetrization is general and valid even with SOC
1548 !         Without SOC, it leads to zero.
1549          F(itau,iflavor,iflavor2) = (F_tmp%oper(itau,iflavor,iflavor2)+F_tmp%oper(itau,iflavor2,iflavor))/2.d0
1550          END DO
1551        END DO
1552      END DO
1553      open (unit=436,file='G0tau_fromF',status='unknown',form='formatted')
1554      rewind(436)
1555      !IF ( op%rank .EQ. 0 ) THEN
1556      !  DO iflavor = 1, flavors
1557      !    DO iflavor2 = 1, flavors
1558      !        write(436,*) "#",iflavor,iflavor2
1559      !      do  itau=1,op%samples+1
1560      !        write(436,*) (itau-1)*op%beta/(op%samples),real(F(itau,iflavor,iflavor2))
1561      !      enddo
1562      !        write(436,*) 
1563      !    END DO
1564      !  !sui!write(6,'(5x,14(2f9.5,2x))') (F(op%samples+1,iflavor,iflavor2),iflavor2=1,flavors)
1565      !  END DO
1566      !ENDIF
1567      !call flush(436)
1568      !call flush(437)
1569      close(436)
1570      !call flush(6)
1571      
1572      call xmpi_barrier(op%MY_COMM)
1573      !CALL ERROR("END OF CALCULATION")
1574      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1575      !  END OF TEST
1576      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1577 
1578      !DO iomega=1,op%Wmax
1579      !  call xginv(F_omega(iomega,:,:),flavors)
1580      !END DO
1581     !F_omega = CMPLX(-1.d0,0,8)/Gomega_tmp
1582   !ELSE
1583   !=============================================================================================
1584   ! --- Restore Hybridization in F_omega
1585   !=============================================================================================
1586 
1587 !   Restore Hybridization in F_omega for the following operations
1588   F_omega = Gomega_tmp
1589   !END IF
1590 
1591   !==================================================================
1592   ! --- Full double loop on flavors to compute F (remove levels)
1593   !==================================================================
1594   DO iflavor = 1, flavors
1595     DO iflavor2 = 1, flavors
1596 
1597   ! --- Compute or use the levels for the diagonal hybridization (else K=0)
1598       IF(iflavor==iflavor2) THEN
1599         IF ( op%opt_levels .EQ. 1 ) THEN
1600           K = op%mu(iflavor)
1601         ELSE
1602           K = -REAL(F_omega(op%Wmax, iflavor,iflavor))
1603 !        op%mu = K
1604           op%mu(iflavor) = K 
1605         END IF
1606       ELSE
1607         K=0.d0
1608       ENDIF
1609       !IF ( op%rank .EQ. 0 ) &
1610       !WRITE(9876,'(I4,2E22.14)') iflavor, K, REAL(-F_omega(op%Wmax, iflavor))
1611      ! IF(op%rank .EQ.0) &
1612      ! WRITE(op%ostream,*) "CTQMC K, op%mu = ",K,op%mu(iflavor)
1613       !WRITE(op%ostream,*) "CTQMC beta     = ",op%beta
1614 
1615   ! --- Compute F (by removing the levels) if opt_fk==0
1616     !  IF ( opt_fk .EQ. 0 ) THEN
1617     !   ! DO iomega = 1, op%Wmax
1618     !   !   re = REAL(F_omega(iomega,iflavor,iflavor2))
1619     !   !   im = AIMAG(F_omega(iomega,iflavor,iflavor2))
1620     !   !   if (iflavor==iflavor2) then
1621     !   !     F_omega(iomega,iflavor,iflavor) = CMPLX(re + K, im + (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, 8)
1622     !   !   else
1623     !   !     F_omega(iomega,iflavor,iflavor2) = CMPLX(re , im  , 8)
1624     !   !   endif
1625     !   !   !if(iflavor==1.and.op%rank==0) then
1626     !   !     !write(224,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(F_omega(iomega,iflavor)),imag(F_omega(iomega,iflavor))
1627     !   !     !write(225,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(Gomega_tmp(iomega, iflavor)),imag(Gomega_tmp(iomega, iflavor))
1628     !   !   !end if 
1629     !   ! END DO
1630     !  ELSE
1631     !    DO iomega = 1, op%Wmax
1632     !      !F_omega(iomega,iflavor,iflavor2) = F_omega(iomega,iflavor,iflavor2) + CMPLX(K, 0.d0, 8)
1633 
1634 
1635     !      !if(iflavor==1.and.op%rank==0) then
1636     !        !write(224,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(F_omega(iomega,iflavor)),imag(F_omega(iomega,iflavor))
1637     !        !write(225,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta, real(Gomega_tmp(iomega, iflavor)),imag(Gomega_tmp(iomega, iflavor))
1638     !      !end if 
1639     !    END DO
1640     !  END IF
1641   ! --- compute residual K (?)
1642       K = REAL(CMPLX(0,(2.d0*DBLE(op%Wmax)-1.d0)*pi_invBeta,8)*F_omega(op%Wmax,iflavor,iflavor2))
1643       CALL GreenHyboffdiag_setMuD1(op%Greens,iflavor,iflavor2,op%mu(iflavor),K)
1644     END DO
1645   END DO
1646 
1647   do  iomega=1,op%Wmax
1648    ! write(336,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_omega(iomega,1,1)),imag(F_omega(iomega,1,1))
1649   enddo
1650 
1651   ! --- Creates F_tmp%oper_w
1652   CALL GreenHyboffdiag_setOperW(F_tmp,F_omega)
1653  ! do  iflavor=1, flavors ; do  iflavor2=1, flavors ; write(337,*) "#",iflavor,iflavor2 ; do  iomega=1,op%Wmax
1654  !   write(337,*) (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2)),&
1655  !&   imag(F_tmp%oper_w(iomega,iflavor,iflavor2))
1656  ! enddo ; write(337,*) ; enddo ; enddo
1657 !  IF ( op%rank .EQ. 0 ) THEN
1658 !    DO iflavor = 1, flavors
1659 !      DO iflavor2 = 1, flavors
1660 !        write(336,*) "#",iflavor,iflavor2
1661 !        write(337,*) "#",iflavor,iflavor2
1662 !        do  iomega=1,op%Wmax
1663 !          write(336,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2))
1664 !          write(337,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,imag(F_tmp%oper_w(iomega,iflavor,iflavor2))
1665 !        enddo
1666 !        write(336,*) 
1667 !        write(337,*) 
1668 !        write(136,*) "#",iflavor,iflavor2
1669 !        write(137,*) "#",iflavor,iflavor2
1670 !        do  iomega=1,op%Wmax
1671 !        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)))
1672 !        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)))
1673 !        enddo
1674 !        write(136,*) 
1675 !        write(137,*) 
1676 !        write(836,*) "#",iflavor,iflavor2
1677 !        write(837,*) "#",iflavor,iflavor2
1678 !        do  iomega=1,op%Wmax
1679 !        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)))
1680 !        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)))
1681 !        enddo
1682 !        write(836,*) 
1683 !        write(837,*) 
1684 !      END DO
1685 !    END DO
1686 !  ENDIF
1687   !CALL GreenHyboffdiag_backFourier(F_tmp,F_omega(:,iflavor))
1688    ! DO iflavor = 1, flavors
1689    !   DO iflavor2 = 1, flavors
1690    !   unitnb=80000+F_tmp%rank
1691    !   call int2char4(F_tmp%rank,tag_proc)
1692    !   tmpfil = 'oper_wavantFOURIER'//tag_proc
1693    !   open (unit=unitnb,file=trim(tmpfil),status='unknown',form='formatted')
1694    !   write(unitnb,*) "#",iflavor,iflavor2
1695    !   ! C_omega et oper_w differents Domega identique. Est ce du a des
1696    !   ! diago differentes   pour chaque procs dans qmc_prep_ctqmc
1697    !   do  iomega=1,F_tmp%Wmax
1698    !   write(unitnb,*)  (2.d0*DBLE(iomega)-1.d0) * pi_invBeta,real(F_tmp%oper_w(iomega,iflavor,iflavor2))
1699    !   enddo
1700    !   write(unitnb,*) 
1701    !   END DO
1702    ! END DO
1703 
1704   ! --- For all iflavor and iflavor2, do the Fourier transformation to
1705   ! --- have (F(\tau))
1706   !CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=op%opt_hybri_limit)
1707    write(6,*) "WARNING opt_hybri_limit==1"
1708  ! CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=0)
1709   CALL GreenHyboffdiag_backFourier(F_tmp,hybri_limit=op%hybri_limit,opt_hybri_limit=1)
1710  ! CALL GreenHyboffdiag_backFourier(F_tmp)
1711 
1712   ! --- Put the result in F
1713   DO iflavor = 1, flavors
1714     DO iflavor2 = 1, flavors
1715       DO itau=1,samples+1
1716       F(itau,iflavor,iflavor2) = -F_tmp%oper(samples+2-itau,iflavor,iflavor2)
1717       END DO
1718     END DO
1719   END DO
1720   IF ( op%rank .EQ. 0 ) THEN
1721     ifl=0
1722     DO iflavor = 1, flavors
1723       DO iflavor2 = 1, flavors
1724         ifl=ifl+1
1725         write(346,*) "#",iflavor,iflavor2,ifl
1726         do  itau=1,op%samples+1
1727           write(346,*) itau,real(F(itau,iflavor,iflavor2))
1728         enddo
1729         write(346,*) 
1730       END DO
1731     END DO
1732   ENDIF
1733   close(346)
1734   DO iflavor = 1, flavors
1735     DO iflavor2 = 1, flavors
1736       DO itau=1,samples+1
1737 !      This symetrization is general and valid even with SOC
1738 !      Without SOC, it leads to zero.
1739       F(itau,iflavor,iflavor2) = -(F_tmp%oper(samples+2-itau,iflavor,iflavor2)+F_tmp%oper(samples+2-itau,iflavor2,iflavor))/2.d0
1740       END DO
1741     END DO
1742   END DO
1743   !DO iflavor = 1, flavors
1744   !  DO iflavor2 = 1, flavors
1745   !    DO itau=1,samples+1
1746   !    F(itau,iflavor,iflavor2) = F(samples/2,iflavor,iflavor2)
1747   !    END DO
1748   !  END DO
1749   !END DO
1750 
1751  !  SOME TRY TO ADJUST F
1752   !DO iflavor = 1, flavors
1753   !  DO iflavor2 = 1, flavors
1754   !    do  itau=1,op%samples+1
1755   !    !if(iflavor/=iflavor2) F(itau,iflavor,iflavor2)=F((op%samples+1)/2,iflavor,iflavor2)
1756   !    !if(iflavor==iflavor2) F(itau,iflavor,iflavor2)=F((op%samples+1)/2,iflavor,iflavor2)
1757   !    enddo
1758   !  END DO
1759   !END DO
1760 
1761   IF ( op%rank .EQ. 0 ) THEN
1762     open (unit=436,file='Hybridization.dat',status='unknown',form='formatted')
1763     rewind(436)
1764     ifl=0
1765     DO iflavor = 1, flavors
1766       DO iflavor2 = 1, flavors
1767         ifl=ifl+1
1768           write(436,*) "#",iflavor,iflavor2,ifl,op%hybri_limit(iflavor,iflavor2)
1769         do  itau=1,op%samples+1
1770           write(436,*) itau,real(F(itau,iflavor,iflavor2))
1771         enddo
1772           write(436,*) 
1773       END DO
1774     END DO
1775     close(436)
1776   ENDIF
1777   FREE(Gomega_tmp)
1778   FREE(F_omega)
1779   FREE(F_omega_inv)
1780   CALL GreenHyboffdiag_destroy(F_tmp)
1781 
1782 
1783 END SUBROUTINE Ctqmcoffdiag_computeF

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_destroy [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_destroy

FUNCTION

  destroy and deallocate all variables

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4926 SUBROUTINE Ctqmcoffdiag_destroy(op)
4927 
4928 !Arguments ------------------------------------
4929 
4930 !This section has been created automatically by the script Abilint (TD).
4931 !Do not modify the following lines by hand.
4932 #undef ABI_FUNC
4933 #define ABI_FUNC 'Ctqmcoffdiag_destroy'
4934 !End of the abilint section
4935 
4936   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
4937 !Local variables ------------------------------
4938   INTEGER                  :: iflavor
4939   INTEGER                  :: flavors
4940   INTEGER                  :: i
4941   INTEGER                  :: j
4942   INTEGER                  :: k
4943 
4944   flavors = op%flavors
4945 
4946   CALL ImpurityOperator_destroy(op%Impurity)
4947   CALL BathOperatoroffdiag_destroy(op%Bath)
4948   CALL Vector_destroy(op%measNoise(1))
4949   CALL Vector_destroy(op%measNoise(2))
4950 
4951 !sui!write(6,*) "before greenhyb_destroy in ctmqc_destroy"
4952   CALL GreenHyboffdiag_destroy(op%Greens)
4953 !#ifdef CTCtqmcoffdiag_ANALYSIS
4954   FREEIF(op%measCorrelation)
4955   FREEIF(op%measPerturbation)
4956   FREEIF(op%meas_fullemptylines)
4957   FREEIF(op%measN)
4958   FREEIF(op%measDE)
4959   FREEIF(op%mu)
4960   FREEIF(op%hybri_limit)
4961   FREEIF(op%abNoiseG)
4962   IF ( ALLOCATED(op%measNoiseG) ) THEN
4963     DO i=1,2
4964       DO j = 1, op%flavors
4965         DO k= 1, op%samples+1
4966           CALL Vector_destroy(op%measNoiseG(k,j,i))
4967         END DO
4968       END DO
4969     END DO
4970     DT_FREE(op%measNoiseG)
4971   END IF
4972   FREEIF(op%density)
4973 !#endif
4974   op%ostream        = 0
4975   op%istream        = 0
4976  
4977   op%sweeps         = 0
4978   op%thermalization = 0
4979   op%flavors        = 0
4980   op%samples        = 0
4981   op%beta           = 0.d0
4982 !  op%seg_added      = 0.d0
4983 !  op%anti_added     = 0.d0
4984 !  op%seg_removed    = 0.d0
4985 !  op%anti_removed   = 0.d0
4986 !  op%seg_sign       = 0.d0
4987 !  op%anti_sign      = 0.d0
4988   op%stats          = 0.d0
4989   op%swap           = 0.d0
4990 
4991 
4992   op%set  = .FALSE.
4993   op%done = .FALSE.
4994   op%init = .FALSE.
4995 END SUBROUTINE Ctqmcoffdiag_destroy

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getD [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_getD

FUNCTION

  get double occupation

COPYRIGHT

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

INPUTS

  op=ctqmc

OUTPUT

  D=full double occupation

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4060 SUBROUTINE Ctqmcoffdiag_getD(op, D)
4061 
4062 !Arguments ------------------------------------
4063 
4064 !This section has been created automatically by the script Abilint (TD).
4065 !Do not modify the following lines by hand.
4066 #undef ABI_FUNC
4067 #define ABI_FUNC 'Ctqmcoffdiag_getD'
4068 !End of the abilint section
4069 
4070   TYPE(Ctqmcoffdiag)       , INTENT(IN ) :: op
4071   DOUBLE PRECISION, INTENT(OUT) :: D
4072 !Local variables ------------------------------
4073   INTEGER                       :: iflavor1
4074   INTEGER                       :: iflavor2
4075 
4076   D = 0.d0
4077 
4078   DO iflavor1 = 1, op%flavors
4079     DO iflavor2 = iflavor1+1, op%flavors
4080       D = D + op%measDE(iflavor2,iflavor1)
4081     END DO
4082   END DO
4083   !IF ( op%rank .EQ. 0 ) THEN
4084   !  DO iflavor1 = 1, op%flavors
4085   !    DO iflavor2 = iflavor1+1, op%flavors
4086   !     write(4533,*) op%measDE(iflavor2,iflavor1)k
4087   !     write(4534,*) op%Impurity%mat_U(iflavor2,iflavor1)k
4088   !    END DO
4089   !  END DO
4090 
4091   !ENDIF
4092 
4093 END SUBROUTINE Ctqmcoffdiag_getD

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getE [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_getE

FUNCTION

  get interaction energy and noise on it

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4128 SUBROUTINE Ctqmcoffdiag_getE(op,E,noise)
4129 
4130 !Arguments ------------------------------------
4131 
4132 !This section has been created automatically by the script Abilint (TD).
4133 !Do not modify the following lines by hand.
4134 #undef ABI_FUNC
4135 #define ABI_FUNC 'Ctqmcoffdiag_getE'
4136 !End of the abilint section
4137 
4138   TYPE(Ctqmcoffdiag)       , INTENT(IN ) :: op
4139   DOUBLE PRECISION, INTENT(OUT) :: E
4140   DOUBLE PRECISION, INTENT(OUT) :: Noise
4141 
4142   E = op%measDE(1,1)  
4143   Noise = op%a_Noise*(DBLE(op%sweeps)*DBLE(op%size))**op%b_Noise
4144 END SUBROUTINE Ctqmcoffdiag_getE

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_getGreen

FUNCTION

  Get the full green functions in time and/or frequency

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3776 SUBROUTINE Ctqmcoffdiag_getGreen(op, Gtau, Gw)
3777 
3778 !Arguments ------------------------------------
3779  USE m_GreenHyboffdiag
3780 
3781 !This section has been created automatically by the script Abilint (TD).
3782 !Do not modify the following lines by hand.
3783 #undef ABI_FUNC
3784 #define ABI_FUNC 'Ctqmcoffdiag_getGreen'
3785 !End of the abilint section
3786 
3787   TYPE(Ctqmcoffdiag)          , INTENT(INOUT)    :: op
3788   DOUBLE PRECISION, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: Gtau
3789   COMPLEX(KIND=8), DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: Gw
3790 !Local variables ------------------------------
3791   !INTEGER                            :: itime
3792   INTEGER                            :: iflavor1
3793   INTEGER                            :: iflavor1b,iflavor,iflavorbis
3794   INTEGER                            :: iflavor2
3795   INTEGER                            :: iflavor3
3796   INTEGER                            :: flavors,tail
3797   INTEGER                            :: ifreq,itime
3798   DOUBLE PRECISION :: u1 
3799   DOUBLE PRECISION :: u2
3800   DOUBLE PRECISION :: u3
3801   DOUBLE PRECISION :: Un
3802   DOUBLE PRECISION :: UUnn,omega,iw
3803   CHARACTER(LEN=4)                   :: cflavors
3804   CHARACTER(LEN=50)                  :: string
3805   TYPE(GreenHyboffdiag)                     :: F_tmp
3806 
3807   flavors = op%flavors
3808   DO iflavor1 = 1, flavors
3809     u1 = 0.d0
3810     u2 = 0.d0
3811     u3 = 0.d0
3812     DO iflavor2 = 1, flavors
3813       IF ( iflavor2 .EQ. iflavor1 ) CYCLE
3814       Un = op%Impurity%mat_U(iflavor2,iflavor1) * op%measN(1,iflavor2)
3815 !      Un = op%Impurity%mat_U(iflavor2,iflavor1) * (op%Greens%oper(1,iflavor2,iflavor2) + 1.d0)
3816       !write(6,*) "forsetmoments",iflavor1,iflavor2,(op%Greens%oper(1,iflavor2,iflavor2) + 1.d0), Un
3817       u1 = u1 + Un 
3818       u2 = u2 + Un*op%Impurity%mat_U(iflavor2,iflavor1) 
3819       DO iflavor3 = 1, flavors
3820         IF ( iflavor3 .EQ. iflavor2 .OR. iflavor3 .EQ. iflavor1 ) CYCLE
3821         UUnn = (op%Impurity%mat_U(iflavor2,iflavor1)*op%Impurity%mat_U(iflavor3,iflavor1)) * &
3822 &                                                    op%measDE(iflavor2,iflavor3) 
3823         u2 = u2 + UUnn 
3824       END DO
3825     END DO  
3826      ! write(6,*) "u1,u2",u1,u2
3827 
3828     DO iflavor1b = 1, flavors
3829       u3 =-(op%Impurity%mat_U(iflavor1,iflavor1b))*op%Greens%oper(1,iflavor1,iflavor1b)
3830       ! u3=U_{1,1b}*G_{1,1b}
3831       CALL GreenHyboffdiag_setMoments(op%Greens,iflavor1,iflavor1b,u1,u2,u3)
3832     END DO ! iflavor1b
3833 
3834   END DO ! iflavor1
3835 
3836   IF ( PRESENT( Gtau ) ) THEN
3837     DO iflavor1 = 1, flavors
3838       DO iflavor2 = 1, flavors
3839         Gtau(1:op%samples,iflavor1,iflavor2) = op%Greens%oper(1:op%samples,iflavor1,iflavor2)
3840       END DO  
3841     END DO ! iflavor1
3842   END IF
3843 ! !--------- Write Occupation matrix before Gtau
3844 !  write(ostream,'(17x,a)') "Occupation matrix"
3845 !  write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
3846 !  write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
3847 !  do iflavor=1, op%flavors
3848 !    write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(-op%Greens%oper(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors)
3849 !  enddo
3850 !  write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
3851 ! !------------------------------------------------------------------------------------------
3852 ! !--------- Write Occupation matrix Gtau
3853 !  write(ostream,'(17x,a)') "Occupation matrix"
3854 !  write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
3855 !  write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
3856 !  do iflavor=1, op%flavors
3857 !    write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(Gtau(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors)
3858 !  enddo
3859 !  write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
3860 ! !------------------------------------------------------------------------------------------
3861 
3862 !================================================
3863   if(3==4) then
3864 !================================================
3865     DO iflavor1 = 1, flavors
3866       DO iflavor1b = 1, flavors
3867        !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))
3868       END DO  
3869     END DO ! iflavor1
3870 !    ============== write Gomega_nd.dat
3871     if(op%rank==0) then
3872     OPEN(UNIT=44, FILE="Gomega_nd_nfourier2.dat")
3873     WRITE(cflavors,'(I4)') 2*(flavors*flavors+1)
3874     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'E15.5)'
3875     !write(6,*) " op%Greens%Wmax", op%Greens%Wmax
3876     do  iflavor1=1, flavors 
3877       do  iflavor1b=1, flavors 
3878     write(44,*) "#op%Greens%Mk(iflavor1,iflavor2,1",op%Greens%Mk(iflavor1,iflavor1b,:)
3879         DO ifreq = 1, op%samples
3880 !      !write(6,string) (DBLE(ifreq)*2-1)*3.1415/op%Greens%beta, &
3881 !      (/ ((real(Gw(ifreq,iflavor1,iflavor1b)),imag(Gw(ifreq,iflavor1,iflavor1b)), iflavor1=1, flavors),iflavor1b=1,flavors) /)
3882 !      WRITE(44,string) (DBLE(ifreq)*2.d0-1.d0)*3.1415926/op%Greens%beta, &
3883         iw=aimag(Gw(ifreq,op%flavors,op%flavors+1))
3884          WRITE(44,string) aimag(Gw(ifreq,op%flavors,op%flavors+1)),&
3885          real(Gw(ifreq,iflavor1,iflavor1b)),aimag(Gw(ifreq,iflavor1,iflavor1b)),&
3886             ( -op%Greens%Mk(iflavor1,iflavor1b,2) )/(iw*iw) , (op%Greens%Mk(iflavor1,iflavor1b,1))/iw!-op%Greens%Mk(iflavor1,iflavor1b,3)/(iw*iw))/iw 
3887       !   WRITE(102,*) aimag(Gw(ifreq,op%flavors,op%flavors+1)), (op%Greens%Mk(iflavor1,iflavor1b,1))/iw,op%Greens%Mk(iflavor1,iflavor1b,1),iw
3888         END DO
3889          WRITE(44,*) 
3890       END DO
3891     END DO
3892     close(44)
3893     endif
3894 !================================================
3895   endif
3896 !================================================
3897        !!write(6,*) "present gw", present(gw)
3898   IF ( PRESENT( Gw ) ) THEN
3899      !!write(6,*) "size gw",SIZE(Gw,DIM=2) ,flavors+1 
3900     IF ( SIZE(Gw,DIM=3) .EQ. flavors+1 ) THEN
3901      ! CALL GreenHyboffdiag_forFourier(op%Greens, Gomega=Gw, omega=Gw(:,op%flavors,op%flavors+1))
3902       CALL GreenHyboffdiag_forFourier(op%Greens, Gomega=Gw, omega=Gw(:,op%flavors,op%flavors+1))
3903       !write(6,*) "1"
3904       !IF ( op%rank .EQ. 0 ) write(20,*) Gw(:,iflavor1)
3905     ELSE IF ( SIZE(Gw,DIM=3) .EQ. flavors ) THEN  
3906       CALL GreenHyboffdiag_forFourier(op%Greens,Gomega=Gw)
3907       !write(6,*) "2"
3908     ELSE
3909       CALL WARNALL("Ctqmcoffdiag_getGreen : Gw is not valid                    ")
3910       CALL GreenHyboffdiag_forFourier(op%Greens,Wmax=op%Wmax)
3911       !write(6,*) "3"
3912     END IF
3913   ELSE
3914     CALL GreenHyboffdiag_forFourier(op%Greens,Wmax=op%Wmax)
3915   END IF
3916 !  ============== write Gomega_nd.dat
3917 !================================================
3918 !  if(3==4) then
3919 !================================================
3920   if(op%rank==0.and.3==4) then
3921   OPEN(UNIT=44, FILE="Gomega_nd.dat")
3922   WRITE(cflavors,'(I4)') 2*(flavors*flavors+1)
3923   string = '(1x,'//TRIM(ADJUSTL(cflavors))//'E15.5)'
3924   !write(6,*) " op%Greens%Wmax", op%Greens%Wmax
3925   do  iflavor1=1, flavors 
3926     do  iflavor1b=1, flavors 
3927   write(44,*) "#op%Greens%Mk(iflavor1,iflavor2,1",op%Greens%Mk(iflavor1,iflavor1b,:)
3928       DO ifreq = 1, SIZE(Gw,1)    
3929 !    !write(6,string) (DBLE(ifreq)*2-1)*3.1415/op%Greens%beta, &
3930 !    (/ ((real(Gw(ifreq,iflavor1,iflavor1b)),imag(Gw(ifreq,iflavor1,iflavor1b)), iflavor1=1, flavors),iflavor1b=1,flavors) /)
3931 !    WRITE(44,string) (DBLE(ifreq)*2.d0-1.d0)*3.1415926/op%Greens%beta, &
3932       iw=aimag(Gw(ifreq,op%flavors,op%flavors+1))
3933        WRITE(44,string) aimag(Gw(ifreq,op%flavors,op%flavors+1)),&
3934        real(Gw(ifreq,iflavor1,iflavor1b)),aimag(Gw(ifreq,iflavor1,iflavor1b)),&
3935           ( -op%Greens%Mk(iflavor1,iflavor1b,2) )/(iw*iw) , &
3936 &          (op%Greens%Mk(iflavor1,iflavor1b,1)-op%Greens%Mk(iflavor1,iflavor1b,3)/(iw*iw))/iw 
3937       END DO
3938        WRITE(44,*) 
3939     END DO
3940   END DO
3941   endif
3942 !================================================
3943 !  endif
3944 !================================================
3945 
3946 
3947 !  ==============================
3948   ! --- Initialize F_tmp 
3949   !write(6,*) "10"
3950 
3951   IF ( op%have_MPI .EQV. .TRUE. ) THEN
3952     !CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,op%flavors,MY_COMM=op%MY_COMM)
3953     CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,flavors)
3954     !write(6,*) "10a"
3955   ELSE
3956     CALL GreenHyboffdiag_init(F_tmp,op%samples,op%beta,flavors)
3957     !write(6,*) "10b"
3958   END IF
3959 
3960   !write(6,*) "11"
3961 !  CALL GreenHyboffdiag_setOperW(F_tmp,Gw)
3962 
3963   tail = op%samples 
3964   F_tmp%Wmax=op%samples ! backFourier only works for linear freq: calculation of A and etc..
3965   MALLOC(F_tmp%oper_w,(1:tail,op%flavors,op%flavors))
3966   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)
3967   !write(6,*) "example",F_tmp%oper_w(1,1,1)
3968   !write(6,*) "example",Gw(1,1,1)
3969   F_tmp%setW = .TRUE.
3970   !write(6,*) size(F_tmp%oper_w,1)
3971   !write(6,*) size(F_tmp%oper_w,2)
3972   !write(6,*) size(F_tmp%oper_w,3)
3973   !write(6,*) size(Gw,1)
3974   !write(6,*) size(Gw,2)
3975   !write(6,*) size(Gw,3)
3976 
3977   !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))
3978 !================================================
3979   if(3==4) then
3980 !================================================
3981     OPEN(UNIT=3337, FILE="Gomega_nd2.dat")
3982     do  iflavor1=1, flavors 
3983       do  iflavor1b=1, flavors 
3984         do  ifreq=1, tail
3985 !         write(3337,*) (2.d0*DBLE(ifreq)-1.d0) * 3.1415/op%beta,real(F_tmp%oper_w(ifreq,iflavor1,iflavor1b)),&
3986 !   &     imag(F_tmp%oper_w(ifreq,iflavor1,iflavor1b))
3987           write(3337,*) aimag(Gw(ifreq,op%flavors,op%flavors+1)), real(F_tmp%oper_w(ifreq,iflavor1,iflavor1b)),&
3988  &        aimag(F_tmp%oper_w(ifreq,iflavor1,iflavor1b))
3989 
3990       !    omega=(2.d0*DBLE(ifreq)-1.d0) * 3.1415/op%beta
3991  !        F_tmp%oper_w(ifreq,iflavor1,iflavor1b)=0.1**2/Gw(ifreq,op%flavors,op%flavors+1)
3992         enddo 
3993         write(3337,*)
3994       enddo 
3995     enddo
3996     close(3337)
3997 !================================================
3998   endif
3999 !================================================
4000 
4001   !write(6,*) "12",F_tmp%Wmax
4002 
4003 !  CALL GreenHyboffdiag_backFourier(F_tmp,func="green")
4004 
4005   !write(6,*) "13"
4006 
4007 !================================================
4008   if(3==4) then
4009 !================================================
4010     OPEN(UNIT=48, FILE="Gtau_nd_2.dat")
4011 !    --- Print full non diagonal Gtau in Gtau_nd.dat
4012     WRITE(cflavors,'(I4)') flavors*flavors+1
4013     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
4014     DO itime = 1, op%samples+1
4015       WRITE(48,string) DBLE(itime-1)*op%beta/DBLE(op%samples), &
4016  &    ((F_tmp%oper(itime,iflavor1,iflavor1b), iflavor1=1, flavors),iflavor1b=1,flavors)
4017     END DO
4018 !================================================
4019   endif
4020 !================================================
4021 
4022   CALL GreenHyboffdiag_destroy(F_tmp)
4023 
4024   !FREE(F_tmp%oper_w)
4025 !  ==============================
4026 END SUBROUTINE Ctqmcoffdiag_getGreen

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_getResult [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_getResult

FUNCTION

  reduce everything to get the result of the simulation

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3177 SUBROUTINE Ctqmcoffdiag_getResult(op)
3178 
3179 
3180 !This section has been created automatically by the script Abilint (TD).
3181 !Do not modify the following lines by hand.
3182 #undef ABI_FUNC
3183 #define ABI_FUNC 'Ctqmcoffdiag_getResult'
3184 !End of the abilint section
3185 
3186 
3187 #ifdef HAVE_MPI1
3188 include 'mpif.h'
3189 #endif
3190 !Arguments ------------------------------------
3191   TYPE(Ctqmcoffdiag)  , INTENT(INOUT)                    :: op
3192 !Local variables ------------------------------
3193   INTEGER                                       :: iflavor
3194   INTEGER                                       :: flavors
3195   INTEGER                                       :: itau
3196   INTEGER                                       :: endDensity
3197   DOUBLE PRECISION                              :: inv_flavors
3198   DOUBLE PRECISION                              :: a
3199   DOUBLE PRECISION                              :: b
3200   DOUBLE PRECISION                              :: r
3201   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: alpha
3202   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: beta
3203   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:)   :: measN_1
3204   DOUBLE PRECISION,              DIMENSION(1:2) :: TabX
3205   DOUBLE PRECISION,              DIMENSION(1:2) :: TabY
3206   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:)   :: freqs
3207   INTEGER, ALLOCATABLE, DIMENSION(:)   :: counts
3208   INTEGER, ALLOCATABLE, DIMENSION(:)   :: displs
3209   INTEGER                                       :: sp1
3210   INTEGER                                       :: spAll
3211   INTEGER                                       :: last
3212   INTEGER                                       :: n1
3213   INTEGER                                       :: n2
3214   INTEGER                                       :: debut
3215   DOUBLE PRECISION                                       :: signvaluemeassum
3216 !  INTEGER                                       :: fin
3217 #ifdef HAVE_MPI
3218   INTEGER                                       :: ierr
3219 #endif
3220   INTEGER                                       :: sizeoper,nbprocs,myrank
3221   DOUBLE PRECISION                              :: inv_size
3222   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: buffer 
3223   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: buffer2,buffer2s
3224   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: fullempty
3225   TYPE(FFTHyb) :: FFTmrka
3226 
3227   IF ( .NOT. op%done ) &
3228     CALL ERROR("Ctqmcoffdiag_getResult : Simulation not run                ")
3229 
3230   flavors     =  op%flavors
3231   inv_flavors = 1.d0 / DBLE(flavors)
3232 
3233 
3234   inv_size = 1.d0 / DBLE(op%size)
3235   sp1 = 0
3236   spAll = 0
3237 
3238 !#ifdef CTCtqmcoffdiag_CHECK
3239   IF ( op%opt_check .GT. 0 ) THEN
3240     op%errorImpurity = ImpurityOperator_getError(op%Impurity) * inv_flavors 
3241     op%errorBath     = BathOperatoroffdiag_getError    (op%Bath    ) * inv_flavors 
3242   END IF
3243 !#endif
3244 
3245   MALLOC(alpha,(1,1))
3246   MALLOC(beta,(1,1))
3247   MALLOC(buffer,(1,1))
3248   IF ( op%opt_noise .EQ. 1) THEN
3249     FREEIF(alpha)
3250     MALLOC(alpha,(1:op%samples+1,1:flavors))
3251     FREEIF(beta)
3252     MALLOC(beta,(1:op%samples+1,1:flavors))
3253   END IF
3254 
3255   IF ( op%have_MPI .EQV. .TRUE.) THEN 
3256     sp1   = 0
3257     spAll = sp1 + flavors + 6 
3258 
3259 !#ifdef CTCtqmcoffdiag_ANALYSIS
3260     IF ( op%opt_analysis .EQ. 1 ) &
3261       spAll = spAll + 3*sp1 
3262     IF ( op%opt_order .GT. 0 ) &
3263       spAll = spAll + op%opt_order 
3264     IF ( op%opt_noise .EQ. 1 ) &
3265       spAll = spAll + 2*(op%samples + 1)
3266 !#endif
3267 
3268     FREEIF(buffer)
3269     MALLOC(buffer,(1:spAll,1:MAX(2,flavors)))
3270   END IF
3271 
3272 !  op%seg_added    = op%seg_added    * inv_flavors 
3273 !  op%seg_removed  = op%seg_removed  * inv_flavors
3274 !  op%seg_sign     = op%seg_sign     * inv_flavors
3275 !  op%anti_added   = op%anti_added   * inv_flavors
3276 !  op%anti_removed = op%anti_removed * inv_flavors
3277 !  op%anti_sign    = op%anti_sign    * inv_flavors
3278   op%stats(:) = op%stats(:) * inv_flavors
3279 
3280   DO iflavor = 1, flavors
3281     ! Accumulate last values of  N (see also ctqmc_measn)
3282     op%measN(1,iflavor) = op%measN(1,iflavor) + op%measN(3,iflavor)*op%measN(4,iflavor)
3283     op%measN(2,iflavor) = op%measN(2,iflavor) + op%measN(4,iflavor)
3284     ! Reduction
3285     op%measN(1,iflavor)  = op%measN(1,iflavor) / ( op%measN(2,iflavor) * op%beta )
3286     ! Correction
3287 !#ifdef CTCtqmcoffdiag_ANALYSIS
3288     IF ( op%opt_order .GT. 0 ) &
3289       op%measPerturbation(:   ,iflavor) = op%measPerturbation(:,iflavor) &
3290                                     / SUM(op%measPerturbation(:,iflavor))
3291     IF ( op%opt_order .GT. 0 ) &
3292       op%meas_fullemptylines(:   ,iflavor) = op%meas_fullemptylines(:,iflavor) &
3293                                     / SUM(op%meas_fullemptylines(:,iflavor))
3294     !write(6,*) "sum fullempty",iflavor,op%meas_fullemptylines(:,iflavor)
3295 
3296     IF ( op%opt_analysis .EQ. 1 ) THEN
3297       op%measCorrelation (:,1,iflavor) = op%measCorrelation  (:,1,iflavor) &
3298                                     / SUM(op%measCorrelation (:,1,iflavor)) &
3299                                     * op%inv_dt 
3300       op%measCorrelation (:,2,iflavor) = op%measCorrelation  (:,2,iflavor) &
3301                                     / SUM(op%measCorrelation (:,2,iflavor)) &
3302                                     * op%inv_dt 
3303       op%measCorrelation (:,3,iflavor) = op%measCorrelation  (:,3,iflavor) &
3304                                     / SUM(op%measCorrelation (:,3,iflavor)) &
3305                                     * op%inv_dt 
3306     END IF
3307 !#endif
3308     IF ( op%opt_noise .EQ. 1 ) THEN
3309       TabX(1) = DBLE(op%modNoise2)
3310       TabX(2) = DBLE(op%modNoise1)
3311       DO itau = 1, op%samples+1
3312         op%measNoiseG(itau,iflavor,2)%vec = -op%measNoiseG(itau,iflavor,2)%vec*op%inv_dt &  
3313                                            /(op%beta*DBLE(op%modNoise2))
3314         op%measNoiseG(itau,iflavor,1)%vec = -op%measNoiseG(itau,iflavor,1)%vec*op%inv_dt &  
3315                                            /(op%beta*DBLE(op%modNoise1))
3316         n2 = op%measNoiseG(itau,iflavor,2)%tail
3317         TabY(1) = Stat_deviation(op%measNoiseG(itau,iflavor,2)%vec(1:n2))!*SQRT(n2/(n2-1))
3318         n1 = op%measNoiseG(itau,iflavor,1)%tail
3319         TabY(2) = Stat_deviation(op%measNoiseG(itau,iflavor,1)%vec(1:n1))!*SQRT(n1/(n1-1))
3320         CALL Stat_powerReg(TabX,SQRT(2.d0*LOG(2.d0))*TabY,alpha(itau,iflavor),beta(itau,iflavor),r)
3321         ! ecart type -> 60%
3322         ! largeur a mi-hauteur d'une gaussienne -> sqrt(2*ln(2))*sigma
3323       END DO
3324     END IF
3325 
3326   END DO
3327 !sui!write(6,*) "getresults"
3328   CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, .TRUE.,op%signvalue)
3329   CALL GreenHyboffdiag_getHybrid(op%Greens)
3330  ! write(6,*) "op%measN",op%measN(1,:)
3331   MALLOC(measN_1,(flavors))
3332   do iflavor=1,flavors
3333     measN_1(iflavor)=op%measN(1,iflavor)
3334   enddo
3335   CALL GreenHyboffdiag_setN(op%Greens, measN_1(:))
3336   FREE(measN_1)
3337 
3338 ! todoab case _nd and _d are not completely described.
3339   FREEIF(buffer2)
3340   FREEIF(buffer2s)
3341   sizeoper=size(op%Greens%oper,1)
3342   !write(6,*) "sss",size(op%Greens%oper,1),sizeoper
3343   !write(6,*) "sss",size(op%Greens%oper,2),flavors
3344   !write(6,*) "sss",size(op%Greens%oper,3),flavors
3345   MALLOC(buffer2,(1:sizeoper,flavors,flavors))
3346   MALLOC(buffer2s,(1:sizeoper,flavors,flavors))
3347   MALLOC(fullempty,(2,flavors))
3348       !sui!write(6,*) "greens1"
3349   IF ( op%have_MPI .EQV. .TRUE. ) THEN 
3350       !sui!write(6,*) "greens2"
3351     fullempty=0.d0
3352     buffer2 = op%Greens%oper
3353     !write(6,*) "buffer2",(op%Greens%oper(1,n1,n1),n1=1,flavors)
3354     buffer2s= 0.d0
3355     do iflavor=1,flavors
3356       do itau=1,sizeoper
3357     !sui!write(6,*) "greens",iflavor,itau,op%Greens%oper(itau,iflavor,iflavor)
3358       enddo
3359     enddo
3360    !write(6,*) "beforempi",op%Greens%oper(1,1,1) ,buffer2(1,1,1)
3361 #ifdef HAVE_MPI
3362    CALL MPI_COMM_SIZE(op%MY_COMM,nbprocs,ierr)
3363    CALL MPI_COMM_RANK(op%MY_COMM,myrank,ierr)
3364 #endif
3365   !write(6,*) "procs",nbprocs,myrank
3366   END IF
3367   last = sp1
3368 
3369   op%measDE(:,:) = op%measDE(:,:) * DBLE(op%measurements) /(DBLE(op%sweeps)*op%beta)
3370 
3371   n1 = op%measNoise(1)%tail
3372   n2 = op%measNoise(2)%tail
3373 
3374   ! On utilise freqs comme tableau de regroupement
3375   ! Gather de Noise1
3376   IF ( op%have_MPI .EQV. .TRUE. ) THEN
3377     MALLOC(counts,(1:op%size))
3378     MALLOC(displs,(1:op%size))
3379     FREEIF(freqs)
3380     MALLOC(freqs,(1:op%size*n1))
3381     freqs = 0.d0
3382     freqs(n1*op%rank+1:n1*(op%rank+1)) = op%measNoise(1)%vec(1:n1) 
3383     counts(:) = n1
3384     displs(:) = (/ ( iflavor*n1, iflavor=0, op%size-1 ) /)
3385 #ifdef HAVE_MPI
3386     CALL MPI_ALLGATHERV(MPI_IN_PLACE, 0, MPI_DOUBLE_PRECISION, &
3387                         freqs, counts, displs, &
3388                         MPI_DOUBLE_PRECISION, op%MY_COMM, ierr)
3389 #endif
3390     n1 = op%size*n1
3391     CALL Vector_setSize(op%measNoise(1),n1)
3392     op%measNoise(1)%vec(1:n1) = freqs(:)
3393     ! Gather de Noise2
3394     FREE(freqs)
3395     MALLOC(freqs,(1:op%size*n2))
3396     freqs = 0.d0
3397     freqs(n2*op%rank+1:n2*(op%rank+1)) = op%measNoise(2)%vec(1:n2) 
3398     counts(:) = n2
3399     displs(:) = (/ ( iflavor*n2, iflavor=0, op%size-1 ) /)
3400 #ifdef HAVE_MPI
3401     CALL MPI_ALLGATHERV(MPI_IN_PLACE, 0, MPI_DATATYPE_NULL, &
3402                         freqs, counts, displs, &
3403                         MPI_DOUBLE_PRECISION, op%MY_COMM, ierr)
3404 #endif
3405     n2 = op%size*n2
3406     CALL Vector_setSize(op%measNoise(2),n2)
3407     op%measNoise(2)%vec(1:n2) = freqs(:)
3408     FREE(counts)
3409     FREE(displs)
3410     FREE(freqs)
3411   END IF
3412   !n1 = op%measNoise(1)%tail
3413   !n2 = op%measNoise(2)%tail
3414 
3415   ! Transformation des paquets pour que ca fit a CTQMC_SLICE(1|2)
3416   IF ( n1 .GT. CTQMC_SLICE1 ) THEN
3417     itau = n1/CTQMC_SLICE1
3418     MALLOC(freqs,(1:n1/itau))
3419     DO debut=1, n1/itau
3420       freqs(debut)=SUM(op%measNoise(1)%vec((debut-1)*itau+1:itau*debut))
3421     END DO
3422     freqs(:) = freqs(:)/DBLE(itau)
3423     op%modNoise1 = op%modNoise1*itau
3424     n1 = n1/itau
3425     CALL Vector_setSize(op%measNoise(1),n1)
3426     op%measNoise(1)%vec(1:n1) = freqs(:)
3427     FREE(freqs)
3428   END IF
3429   IF ( n2 .GT. CTQMC_SLICE1*CTQMC_SLICE2 ) THEN
3430     itau = n2/(CTQMC_SLICE1*CTQMC_SLICE2)
3431     MALLOC(freqs,(1:n2/itau))
3432     DO debut=1, n2/itau
3433       freqs(debut)=SUM(op%measNoise(2)%vec((debut-1)*itau+1:itau*debut))
3434     END DO
3435     freqs(:) = freqs(:)/DBLE(itau)
3436     op%modNoise2 = op%modNoise2*itau
3437     n2 = n2/itau
3438     CALL Vector_setSize(op%measNoise(2),n2)
3439     op%measNoise(2)%vec(1:n2) = freqs(:)
3440     FREE(freqs)
3441   END IF
3442   ! On peut s'amuser avec nos valeur d'energies
3443   !MALLOC(TabX,(1:20))
3444   !MALLOC(TabY,(1:20))
3445 
3446   TabX(1) = DBLE(op%modNoise2)
3447   TabX(2) = DBLE(op%modNoise1)
3448 
3449   ! Il faut calculer pour chaque modulo 10 ecarts type sur les donnes acquises
3450   op%measNoise(1)%vec(1:n1) = op%measNoise(1)%vec(1:n1)/(op%beta*DBLE(op%modNoise1))*DBLE(op%measurements)
3451   op%measNoise(2)%vec(1:n2) = op%measNoise(2)%vec(1:n2)/(op%beta*DBLE(op%modNoise2))*DBLE(op%measurements)
3452 !  CALL Vector_print(op%measNoise(1),op%rank+70)
3453 !  CALL Vector_print(op%measNoise(2),op%rank+50)
3454 !  DO iflavor=1,10
3455 !    debut = (iflavor-1)*n2/10+1
3456 !    fin   = iflavor*n2/10
3457 !    TabY(iflavor) = Stat_deviation(op%measNoise(2)%vec(debut:fin))
3458 !    debut = (iflavor-1)*n1/10+1
3459 !    fin   = iflavor*n1/10
3460 !    TabY(10+iflavor) = Stat_deviation(op%measNoise(1)%vec(debut:fin))
3461 !  END DO
3462 !!  TabY(1:n) = (op%measNoise(2)%vec(1:n)   &
3463 !!              )
3464 !!             !/(op%beta*DBLE(op%modNoise2))*DBLE(op%measurements) &
3465 !!             !- op%measDE(1,1))
3466 !!  TabY(op%measNoise(2)%tail+1:n+op%measNoise(2)%tail) = (op%measNoise(1)%vec(1:n)   &
3467 !!               )
3468 !!             ! /(op%beta*DBLE(op%modNoise1))*DBLE(op%measurements) &
3469 !!             ! - op%measDE(1,1))
3470 !  IF ( op%rank .EQ. 0 ) THEN
3471 !    DO iflavor=1,20
3472 !      write(45,*) TabX(iflavor), TabY(iflavor)
3473 !    END DO
3474 !  END IF
3475 !
3476 
3477 
3478   TabY(1) = Stat_deviation(op%measNoise(2)%vec(1:n2))!*SQRT(n2/(n2-1))
3479 !!  write(op%rank+10,*) TabX(2)
3480 !!  write(op%rank+40,*) TabX(1)
3481 !!  CALL Vector_print(op%measNoise(1),op%rank+10)
3482 !!  CALL Vector_print(op%measNoise(2),op%rank+40)
3483 !!  CLOSE(op%rank+10)
3484 !!  CLOSE(op%rank+40)
3485   TabY(2) = Stat_deviation(op%measNoise(1)%vec(1:n1))!*SQRT(n1/(n1-1))
3486 !!  ! Ecart carre moyen ~ ecart type mais non biaise. Serait moins precis. Aucun
3487   ! impact sur la pente, juste sur l'ordonnee a l'origine.
3488 
3489   CALL Stat_powerReg(TabX,SQRT(2.d0*LOG(2.d0))*TabY,a,b,r)
3490 !  FREE(TabX)
3491 !  FREE(TabY)
3492   ! ecart type -> 60%
3493   ! largeur a mi-hauteur d'une gaussienne -> sqrt(2*ln(2))*sigma
3494 
3495   !op%measDE(1,1) = SUM(op%measNoise(1)%vec(1:op%measNoise(1)%tail))/(DBLE(op%measNoise(1)%tail*op%modNoise1)*op%beta)
3496   !op%measDE(2:flavors,1:flavors) = op%measDE(2:flavors,1:flavors) /(DBLE(op%sweeps)*op%beta)
3497   CALL ImpurityOperator_getErrorOverlap(op%Impurity,op%measDE)
3498   ! Add the difference between true calculation and quick calculation of the
3499   ! last sweep overlap to measDE(2,2)
3500   !op%measDE = op%measDE * DBLE(op%measurements) 
3501   IF ( op%have_MPI .EQV. .TRUE. ) THEN 
3502     IF ( op%opt_analysis .EQ. 1 ) THEN
3503       buffer(last+1:last+sp1,:) = op%measCorrelation(:,1,:)
3504       last = last + sp1
3505       buffer(last+1:last+sp1,:) = op%measCorrelation(:,2,:)
3506       last = last + sp1
3507       buffer(last+1:last+sp1,:) = op%measCorrelation(:,3,:)
3508       last = last + sp1
3509     END IF
3510     IF ( op%opt_order .GT. 0 ) THEN
3511       buffer(last+1:last+op%opt_order, :) = op%measPerturbation(:,:)
3512       last = last + op%opt_order
3513     END IF
3514     IF ( op%opt_noise .EQ. 1 ) THEN
3515       buffer(last+1:last+op%samples+1,:) = alpha(:,:)
3516       last = last + op%samples + 1
3517       buffer(last+1:last+op%samples+1,:) = beta(:,:)
3518       last = last + op%samples + 1
3519     END IF
3520 !  op%measDE(2,2) = a*EXP(b*LOG(DBLE(op%sweeps*op%size)))
3521     buffer(spall-(flavors+5):spAll-6,:) = op%measDE(:,:)
3522 !    buffer(spAll  ,1) = op%seg_added   
3523 !    buffer(spAll-1,1) = op%seg_removed 
3524 !    buffer(spAll-2,1) = op%seg_sign    
3525 !    buffer(spAll  ,2) = op%anti_added  
3526 !    buffer(spAll-1,2) = op%anti_removed
3527 !    buffer(spAll-2,2) = op%anti_sign   
3528     buffer(spAll  ,1) = op%stats(1)
3529     buffer(spAll-1,1) = op%stats(2)
3530     buffer(spAll-2,1) = op%stats(3)
3531     buffer(spAll  ,2) = op%stats(4)
3532     buffer(spAll-1,2) = op%stats(5)
3533     buffer(spAll-2,2) = op%stats(6)
3534     buffer(spAll-3,1) = op%swap
3535     buffer(spAll-3,2) = DBLE(op%modGlobalMove(2))
3536     buffer(spAll-4,1) = a
3537     buffer(spAll-4,2) = b
3538 !#ifdef CTCtqmcoffdiag_CHECK
3539     buffer(spAll-5,1) = op%errorImpurity
3540     buffer(spAll-5,2) = op%errorBath 
3541     signvaluemeassum = 0
3542 !#endif
3543 
3544 #ifdef HAVE_MPI
3545    !write(6,*) "bufferbefore",buffer(1,1)
3546     CALL MPI_ALLREDUCE(MPI_IN_PLACE, buffer, spAll*flavors, &
3547                      MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr)
3548    !write(6,*) "bufferafter",buffer(1,1)
3549    ! CALL MPI_ALLREDUCE(MPI_IN_PLACE, buffer2, sp1*flavors*flavors, &
3550    !                  MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr)
3551     CALL MPI_ALLREDUCE( buffer2, buffer2s, sizeoper*flavors*flavors, &
3552                      MPI_DOUBLE_PRECISION, MPI_SUM, op%MY_COMM, ierr)
3553    !write(6,*) "justaftermpi",op%Greens%oper(1,1,1) ,buffer2s(1,1,1)
3554     CALL MPI_ALLREDUCE(MPI_IN_PLACE, op%runTime, 1, MPI_DOUBLE_PRECISION, MPI_MAX, &
3555              op%MY_COMM, ierr)
3556     CALL MPI_ALLREDUCE(op%Greens%signvaluemeas, signvaluemeassum , 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
3557              op%MY_COMM, ierr)
3558     IF ( op%opt_order .GT. 0 ) THEN
3559       CALL MPI_ALLREDUCE(op%meas_fullemptylines, fullempty, 2*flavors, MPI_DOUBLE_PRECISION, MPI_SUM, &
3560                op%MY_COMM, ierr)
3561     ENDIF
3562 #endif
3563 
3564   
3565     buffer          = buffer * inv_size
3566     op%measDE(:,:)  = buffer(spall-(flavors+5):spAll-6,:)
3567 !    op%seg_added    = buffer(spAll  ,1)
3568 !    op%seg_removed  = buffer(spAll-1,1)
3569 !    op%seg_sign     = buffer(spAll-2,1)
3570 !    op%anti_added   = buffer(spAll  ,2)
3571 !    op%anti_removed = buffer(spAll-1,2)
3572 !    op%anti_sign    = buffer(spAll-2,2)
3573     op%stats(1)    = buffer(spAll  ,1)
3574     op%stats(2)    = buffer(spAll-1,1)
3575     op%stats(3)    = buffer(spAll-2,1)
3576     op%stats(4)    = buffer(spAll  ,2)
3577     op%stats(5)    = buffer(spAll-1,2)
3578     op%stats(6)    = buffer(spAll-2,2)
3579     op%swap         = buffer(spAll-3,1)
3580     op%modGlobalMove(2) = NINT(buffer(spAll-3,2))
3581     a               = buffer(spAll-4,1) 
3582     b               = buffer(spAll-4,2)
3583 !!#ifdef CTCtqmcoffdiag_CHECK
3584     op%errorImpurity= buffer(spAll-5,1) 
3585     op%errorBath    = buffer(spAll-5,2)   
3586 !#endif
3587 
3588    ! DO iflavor = 1, flavors
3589    !   op%Greens(iflavor)%oper          = buffer(1:sp1          , iflavor)
3590    ! END DO
3591     op%Greens%oper = buffer2s/float(nbprocs)
3592    ! write(6,*) "buffer2s",(op%Greens%oper(1,n1,n1),n1=1,flavors)
3593     op%Greens%signvaluemeas = signvaluemeassum/float(nbprocs)
3594     !sui!write(6,*) "nbprocs",nbprocs,op%Greens%signvaluemeas
3595     op%Greens%oper = op%Greens%oper / op%Greens%signvaluemeas
3596    ! write(6,*) "buffer3s",(op%Greens%oper(1,n1,n1),n1=1,flavors)
3597     IF ( op%opt_order .GT. 0 ) THEN
3598       op%meas_fullemptylines= fullempty/float(nbprocs)
3599     ENDIF
3600     do iflavor=1,flavors
3601       do itau=1,sizeoper
3602     !sui!write(6,*) "greens_av",iflavor,itau,op%Greens%oper(itau,iflavor,iflavor)
3603       enddo
3604     enddo
3605    !write(6,*) "aftermpi",op%Greens%oper(1,1,1) ,buffer2s(1,1,1)
3606     last = sp1
3607     IF ( op%opt_analysis .EQ. 1 ) THEN
3608       op%measCorrelation(:,1,:) = buffer(last+1:last+sp1,:) 
3609       last = last + sp1
3610       op%measCorrelation(:,2,:) = buffer(last+1:last+sp1,:) 
3611       last = last + sp1
3612       op%measCorrelation(:,3,:) = buffer(last+1:last+sp1,:) 
3613       last = last + sp1
3614     END IF
3615     IF ( op%opt_order .GT. 0 ) THEN
3616       op%measPerturbation(:,:) = buffer(last+1:last+op%opt_order, :)
3617       last = last + op%opt_order
3618     END IF
3619     IF ( op%opt_noise .EQ. 1 ) THEN
3620       alpha(:,:) = buffer(last+1:last+op%samples+1,:)
3621       last = last + op%samples + 1
3622       beta(:,:) = buffer(last+1:last+op%samples+1,:)
3623       last = last + op%samples + 1
3624     END IF
3625   END IF
3626   DO iflavor = 1, flavors
3627     ! complete DE matrix
3628     op%measDE(iflavor, iflavor+1:flavors) = op%measDE(iflavor+1:flavors,iflavor)
3629   END DO
3630   FREE(buffer)
3631   FREE(buffer2)
3632   FREE(buffer2s)
3633   FREE(fullempty)
3634 
3635   IF ( op%opt_spectra .GE. 1 ) THEN
3636     endDensity = SIZE(op%density,2)
3637     IF ( op%density(1,endDensity) .EQ. -1.d0 ) &
3638       endDensity = endDensity - 1
3639     CALL FFTHyb_init(FFTmrka,endDensity,DBLE(op%thermalization)/DBLE(op%measurements*op%opt_spectra))
3640     ! Not very Beauty 
3641     MALLOC(freqs,(1:FFTmrka%size/2))
3642     DO iflavor = 1, flavors
3643       ! mean value is removed to supress the continue composent 
3644       CALL FFTHyb_setData(FFTmrka,op%density(iflavor,1:endDensity)/op%beta+op%Greens%oper(op%samples+1,iflavor,iflavor))
3645       CALL FFTHyb_run(FFTmrka,1)
3646       CALL FFTHyb_getData(FFTmrka,endDensity,op%density(iflavor,:),freqs)
3647     END DO
3648     op%density(flavors+1,:) = -1.d0
3649     op%density(flavors+1,1:FFTmrka%size/2) = freqs
3650     CALL FFTHyb_destroy(FFTmrka)
3651     FREE(freqs)
3652   END IF
3653 
3654   op%a_Noise = a
3655   op%b_Noise = b
3656   IF ( op%opt_noise .EQ. 1 ) THEN
3657     op%abNoiseG(1,:,:) = alpha
3658     op%abNoiseG(2,:,:) = beta
3659   END IF
3660   FREE(alpha)
3661   FREE(beta)
3662 
3663 END SUBROUTINE Ctqmcoffdiag_getResult

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_init [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_init

FUNCTION

  Initialize the type Ctqmcoffdiag
  Allocate all the non optional variables

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

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

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_loop [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_loop

FUNCTION

  Definition the main loop of the CT-QMC

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2050 SUBROUTINE Ctqmcoffdiag_loop(op,itotal,ilatex)
2051 
2052 !Arguments ------------------------------------
2053 
2054 !This section has been created automatically by the script Abilint (TD).
2055 !Do not modify the following lines by hand.
2056 #undef ABI_FUNC
2057 #define ABI_FUNC 'Ctqmcoffdiag_loop'
2058 !End of the abilint section
2059 
2060   TYPE(Ctqmcoffdiag), INTENT(INOUT)         :: op
2061   INTEGER    , INTENT(IN   )         :: itotal
2062   INTEGER    , INTENT(IN   )         :: ilatex
2063 !Local variables ------------------------------
2064   LOGICAL                            :: updated 
2065   LOGICAL                            :: updated_seg
2066   LOGICAL, DIMENSION(:), ALLOCATABLE :: updated_swap
2067 
2068   INTEGER                            :: flavors
2069   INTEGER                            :: measurements
2070   INTEGER                            :: modNoise1
2071   INTEGER                            :: modNoise2
2072   INTEGER                            :: modGlobalMove
2073   INTEGER                            :: sp1
2074   INTEGER                            :: itau   
2075   INTEGER                            :: ind
2076   INTEGER                            :: endDensity
2077   INTEGER                            :: indDensity
2078   INTEGER                            :: swapUpdate1
2079   INTEGER                            :: swapUpdate2
2080   INTEGER                            :: old_percent
2081   INTEGER                            :: new_percent
2082   INTEGER                            :: ipercent,ii
2083   INTEGER                            :: iflavor,ifl1,iflavor_d
2084   INTEGER                            :: isweep
2085 
2086   DOUBLE PRECISION                   :: cpu_time1
2087   DOUBLE PRECISION                   :: cpu_time2
2088   DOUBLE PRECISION                   :: NRJ_old1
2089   DOUBLE PRECISION                   :: NRJ_old2
2090   DOUBLE PRECISION                   :: NRJ_new
2091   DOUBLE PRECISION                   :: total
2092   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_old1
2093   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_old2
2094   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: gtmp_new
2095 
2096   CALL CPU_TIME(cpu_time1)
2097 
2098   flavors        = op%flavors
2099   measurements   = op%measurements
2100   modNoise1      = op%modNoise1
2101   modNoise2      = op%modNoise2
2102   modGlobalMove  = op%modGlobalMove(1)
2103   sp1            = op%samples+1
2104 
2105   old_percent    = 0
2106 
2107   MALLOC(updated_swap,(1:flavors))
2108   updated_swap(:) = .FALSE.
2109 
2110   NRJ_old1  = 0.d0
2111   NRJ_old2  = 0.d0
2112   NRJ_new   = 0.d0
2113 
2114   MALLOC(gtmp_new,(1,1))
2115   gtmp_new  = 0.d0
2116   MALLOC(gtmp_old1,(1,1))
2117   gtmp_old1 = 0.d0
2118   MALLOC(gtmp_old2,(1,1))
2119   gtmp_old2 = 0.d0
2120 
2121   endDensity = SIZE(op%density,2)
2122 
2123   IF ( op%opt_noise .GT. 0 ) THEN
2124     FREEIF(gtmp_new)
2125     MALLOC(gtmp_new,(1:sp1,1:flavors))
2126     FREEIF(gtmp_old1)
2127     MALLOC(gtmp_old1,(1:sp1,1:flavors))
2128     FREEIF(gtmp_old2)
2129     MALLOC(gtmp_old2,(1:sp1,1:flavors))
2130   END IF
2131 
2132   IF ( op%rank .EQ. 0 ) THEN
2133     WRITE(op%ostream, '(1x,103A)') &
2134     "|----------------------------------------------------------------------------------------------------|"
2135     WRITE(op%ostream,'(1x,A)', ADVANCE="NO") "|"
2136   END IF
2137 
2138   total = DBLE(itotal)
2139   !write(6,*) "itotal",itotal
2140   indDensity = 1
2141   !write(6,*) "op%stats",op%stats
2142   DO isweep = 1, itotal
2143   !ii if(op%prtopt==1) write(6,*) "======== Isweep = ",isweep
2144     !updated_seg=.FALSE.
2145     DO iflavor = 1, flavors
2146      ! if(isweep==itotal) write(6,*) "    Iflavor = ",iflavor,op%Impurity%Particles(iflavor)%tail
2147    !ii if(op%prtopt==1)  write(6,*) "      ===Iflavor = ",iflavor
2148       op%Impurity%activeFlavor=iflavor
2149       op%Bath%activeFlavor=iflavor ; op%Bath%MAddFlag= .FALSE. ; op%Bath%MRemoveFlag = .FALSE.
2150 
2151       !write(6,*) "before tryaddremove"
2152 
2153       ! For iflavor, Try a move
2154       !==========================
2155       CALL Ctqmcoffdiag_tryAddRemove(op,updated_seg)
2156     !sui!write(6,*) "after tryaddremove",updated_seg
2157 
2158       updated = updated_seg .OR.  updated_swap(iflavor).OR.(isweep==1)
2159       updated_swap(iflavor) = .FALSE.
2160       if ( op%opt_nondiag >0 )  iflavor_d=0
2161       if ( op%opt_nondiag==0 )  iflavor_d=iflavor
2162       CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, updated,op%signvalue,iflavor_d) 
2163 
2164       CALL Ctqmcoffdiag_measN        (op, iflavor, updated)
2165       IF ( op%opt_analysis .EQ. 1 ) &
2166         CALL Ctqmcoffdiag_measCorrelation (op, iflavor)
2167       IF ( op%opt_order .GT. 0 ) &
2168         CALL Ctqmcoffdiag_measPerturbation(op, iflavor)
2169     END DO
2170     !CALL GreenHyboffdiag_measHybrid(op%Greens, op%Bath%M, op%Impurity%Particles, updated,op%signvalue,iflavor_d) 
2171     !DO iflavor = 1,flavors
2172     !  CALL Ctqmcoffdiag_measN        (op, iflavor, updated)
2173     !END DO
2174 
2175     IF ( MOD(isweep,modGlobalMove) .EQ. 0 ) THEN
2176   ! !sui!write(6,*) "isweep,modGlobalMove,inside",isweep,modGlobalMove
2177       CALL Ctqmcoffdiag_trySwap(op,swapUpdate1, swapUpdate2)
2178      ! !write(6,*) "no global move yet for non diag hybridization"
2179       IF ( swapUpdate1 .NE. 0 .AND. swapUpdate2 .NE. 0 ) THEN
2180         updated_swap(swapUpdate1) = .TRUE.
2181         updated_swap(swapUpdate2) = .TRUE.
2182       END IF
2183     END IF
2184     
2185     IF ( MOD(isweep,measurements) .EQ. 0 ) THEN ! default is always 
2186       CALL ImpurityOperator_measDE(op%Impurity,op%measDE)
2187       IF ( op%opt_spectra .GE. 1 .AND. MOD(isweep,measurements*op%opt_spectra) .EQ. 0 ) THEN
2188         op%density(1:flavors,indDensity) = op%measN(3,1:flavors)
2189         indDensity = indDensity+1
2190       END IF
2191     END IF
2192 
2193     IF ( MOD(isweep, modNoise1) .EQ. 0 ) THEN
2194       !modNext = isweep + modNoise2
2195       NRJ_new = op%measDE(1,1)
2196       CALL Vector_pushBack(op%measNoise(1),NRJ_new - NRJ_old1)
2197       NRJ_old1 = NRJ_new
2198 
2199       !! Try to limit accumulation error
2200       CALL ImpurityOperator_cleanOverlaps(op%Impurity)
2201 
2202       IF ( op%opt_noise .EQ. 1 ) THEN
2203         DO ifl1 = 1, flavors
2204           DO ind = 1, op%Greens%map(ifl1,ifl1)%tail
2205             itau = op%Greens%map(ifl1,ifl1)%listINT(ind)
2206             gtmp_new(itau,ifl1) = op%Greens%oper(itau,ifl1,ifl1) & 
2207                      +op%Greens%map(ifl1,ifl1)%listDBLE(ind)*DBLE(op%Greens%factor)
2208           END DO
2209           DO itau = 1, sp1
2210            CALL Vector_pushBack(op%measNoiseG(itau,ifl1,1), gtmp_new(itau,ifl1) - gtmp_old1(itau,ifl1))
2211            gtmp_old1(itau,ifl1) = gtmp_new(itau,ifl1)
2212           END DO
2213         END DO
2214       END IF
2215     END IF
2216 
2217     IF ( MOD(isweep,modNoise2) .EQ. 0 ) THEN
2218       NRJ_new = op%measDE(1,1)
2219       CALL Vector_pushBack(op%measNoise(2),NRJ_new - NRJ_old2)
2220       NRJ_old2 = NRJ_new
2221       IF ( op%opt_noise .EQ. 1 ) THEN
2222         DO ifl1 = 1, flavors
2223           DO ind = 1, op%Greens%map(ifl1,ifl1)%tail
2224             itau = op%Greens%map(ifl1,ifl1)%listINT(ind)
2225             gtmp_new(itau,ifl1) = op%Greens%oper(itau,ifl1,ifl1) & 
2226                   +op%Greens%map(ifl1,ifl1)%listDBLE(ind)*op%Greens%factor
2227           END DO
2228           DO itau = 1, sp1
2229             CALL Vector_pushBack(op%measNoiseG(itau,ifl1,2), gtmp_new(itau,ifl1) - gtmp_old2(itau,ifl1))
2230             gtmp_old2(itau,ifl1) = gtmp_new(itau,ifl1)
2231           END DO
2232         END DO 
2233       END IF
2234 
2235       IF ( op%rank .EQ. 0 ) THEN 
2236         new_percent = CEILING(DBLE(isweep)*100.d0/DBLE(itotal))
2237         DO ipercent = old_percent+1, new_percent 
2238           WRITE(op%ostream,'(A)',ADVANCE="NO") "-"
2239         END DO
2240         old_percent = new_percent
2241       END IF
2242     END IF
2243 
2244     IF ( op%opt_movie .EQ. 1 ) THEN
2245       WRITE(ilatex,'(A11,I9)') "%iteration ", isweep
2246       CALL ImpurityOperator_printLatex(op%Impurity,ilatex,isweep)
2247     END IF
2248 
2249   END DO
2250 
2251   IF ( op%rank .EQ. 0 ) THEN
2252     DO ipercent = old_percent+1, 100
2253       WRITE(op%ostream,'(A)',ADVANCE="NO") "-"
2254     END DO
2255     WRITE(op%ostream,'(A)') "|"
2256   END IF
2257  
2258   FREE(gtmp_new)
2259   FREE(gtmp_old1)
2260   FREE(gtmp_old2)
2261   FREE(updated_swap)
2262 
2263   IF ( op%opt_spectra .GE. 1 .AND. itotal .EQ. op%sweeps ) THEN
2264     IF ( endDensity .NE. indDensity-1 ) THEN
2265       op%density(:,endDensity) = -1.d0
2266     END IF
2267   END IF
2268 
2269   CALL CPU_TIME(cpu_time2)
2270 
2271   op%runTime = (cpu_time2 - cpu_time1)*1.05d0 ! facteur arbitraire de correction
2272 END SUBROUTINE Ctqmcoffdiag_loop

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measCorrelation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_measCorrelation

FUNCTION

  measure all correlations in times for a flavor

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3014 SUBROUTINE Ctqmcoffdiag_measCorrelation(op, iflavor)
3015 
3016 !Arguments ------------------------------------
3017 
3018 !This section has been created automatically by the script Abilint (TD).
3019 !Do not modify the following lines by hand.
3020 #undef ABI_FUNC
3021 #define ABI_FUNC 'Ctqmcoffdiag_measCorrelation'
3022 !End of the abilint section
3023 
3024   TYPE(Ctqmcoffdiag)             , INTENT(INOUT)       :: op
3025   !TYPE(ImpurityOperator), INTENT(IN   )       :: impurity
3026   INTEGER               , INTENT(IN   )       :: iflavor
3027 !Local variables ------------------------------
3028   INTEGER                                     :: iCdag
3029   INTEGER                                     :: iCdagBeta
3030   INTEGER                                     :: iC
3031   INTEGER                                     :: index
3032   INTEGER                                     :: size
3033   DOUBLE PRECISION                            :: tC
3034   DOUBLE PRECISION                            :: tCdag
3035   !DOUBLE PRECISION                            :: time
3036   DOUBLE PRECISION                            :: inv_dt
3037   DOUBLE PRECISION                            :: beta
3038 
3039   IF ( .NOT. op%set ) &
3040     CALL ERROR("Ctqmcoffdiag_measCorrelation : QMC not set                 ")
3041     !write(6,*) "not available"
3042     stop
3043 
3044   size = op%impurity%particles(op%impurity%activeFlavor)%tail
3045   beta = op%beta
3046 
3047   IF ( size .EQ. 0 ) RETURN
3048   
3049   inv_dt = op%inv_dt
3050 
3051   DO iCdag = 1, size ! first segments
3052     tCdag  = op%impurity%particles(op%impurity%activeFlavor)%list(iCdag,Cdag_)
3053     tC     = op%impurity%particles(op%impurity%activeFlavor)%list(iCdag,C_   )
3054     index = INT( ( (tC - tCdag)  * inv_dt ) + .5d0 ) + 1
3055     op%measCorrelation(index,1,iflavor) = op%measCorrelation(index,1,iflavor) + 1.d0
3056     MODCYCLE(iCdag+1,size,iCdagBeta)
3057     index = INT( ( ( &
3058                     op%impurity%particles(op%impurity%activeFlavor)%list(iCdagBeta,Cdag_) - tC &
3059                     + AINT(DBLE(iCdag)/DBLE(size))*beta &
3060                    )  * inv_dt ) + .5d0 ) + 1
3061     IF ( index .LT. 1 .OR. index .GT. op%samples+1 ) THEN
3062       CALL WARN("Ctqmcoffdiag_measCorrelation : bad index line 1095         ")
3063     ELSE
3064       op%measCorrelation(index,2,iflavor) = op%measCorrelation(index,2,iflavor) + 1.d0
3065     END IF
3066 !    DO iC = 1, size
3067 !      tC = impurity%particles(impurity%activeFlavor)%list(C_,iC)
3068 !      time = tC - tCdag
3069 !      IF ( time .LT. 0.d0 ) time = time + beta
3070 !      index = INT( ( time * inv_dt ) + .5d0 ) + 1
3071 !      op%measCorrelation(index,3,iflavor) = op%measCorrelation(index,3,iflavor) + 1.d0
3072 !    END DO
3073     DO iC = 1, size!  op%Greens(iflavor)%index_old%tail 
3074 !todoba        op%measCorrelation(op%Greens(iflavor)%map%listINT(iC+(iCdag-1)*size),3,iflavor) = &
3075 !todoba        op%measCorrelation(op%Greens(iflavor)%map%listINT(iC+(iCdag-1)*size),3,iflavor) + 1.d0
3076     END DO
3077   END DO
3078 
3079 END SUBROUTINE Ctqmcoffdiag_measCorrelation

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measN [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_measN

FUNCTION

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

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2940 SUBROUTINE Ctqmcoffdiag_measN(op, iflavor, updated)
2941 
2942 !Arguments ------------------------------------
2943 
2944 !This section has been created automatically by the script Abilint (TD).
2945 !Do not modify the following lines by hand.
2946 #undef ABI_FUNC
2947 #define ABI_FUNC 'Ctqmcoffdiag_measN'
2948 !End of the abilint section
2949 
2950   TYPE(Ctqmcoffdiag)             , INTENT(INOUT)     :: op
2951   !TYPE(ImpurityOperator), INTENT(IN   )     :: impurity
2952   INTEGER               , INTENT(IN   )     :: iflavor
2953   LOGICAL               , INTENT(IN   )     :: updated
2954 
2955 !  IF ( .NOT. op%set ) &
2956 !    CALL ERROR("Ctqmcoffdiag_measN : QMC not set                           ")
2957 
2958   
2959   IF ( updated .EQV. .TRUE. ) THEN
2960 !  --- accumulate occupations with values op%measN(3,iflavor) from the last measurements with the corresponding weight
2961 !  ---  op*measN(4,iflavor)
2962     op%measN(1,iflavor) = op%measN(1,iflavor) + op%measN(3,iflavor)*op%measN(4,iflavor)
2963 
2964 !  --- Compute total number of new measurements 
2965     op%measN(2,iflavor) = op%measN(2,iflavor) + op%measN(4,iflavor)
2966 
2967 !  --- Compute the occupation for this configuration (will be put in
2968 !  --- op%measN(1,iflavor) at the next occurence of updated=.true.), with
2969 !  --- the corresponding weight  op%measN(4,iflavor) (we do not now it yet)
2970     op%measN(3,iflavor) = ImpurityOperator_measN(op%impurity)
2971 
2972 !  --- set weight: as update=true, it is a new measurement , so put it to one
2973     op%measN(4,iflavor) = 1.d0
2974 
2975   ELSE
2976 !  --- increased the count so that at new move, we will be able to update measN(1) correctly.
2977     op%measN(4,iflavor) = op%measN(4,iflavor) + 1.d0
2978   END IF
2979 END SUBROUTINE Ctqmcoffdiag_measN

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_measPerturbation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_measPerturbation

FUNCTION

  measure perturbation order

COPYRIGHT

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

INPUTS

  op=ctqmc
  iflavor=the flavor to measure

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3113 SUBROUTINE Ctqmcoffdiag_measPerturbation(op, iflavor)
3114 
3115 !Arguments ------------------------------------
3116 
3117 !This section has been created automatically by the script Abilint (TD).
3118 !Do not modify the following lines by hand.
3119 #undef ABI_FUNC
3120 #define ABI_FUNC 'Ctqmcoffdiag_measPerturbation'
3121 !End of the abilint section
3122 
3123   TYPE(Ctqmcoffdiag)             , INTENT(INOUT)     :: op
3124   !TYPE(ImpurityOperator), INTENT(IN   )     :: impurity
3125   INTEGER               , INTENT(IN   )     :: iflavor
3126 !Local variables ------------------------------
3127   INTEGER                                   :: index
3128 
3129   IF ( .NOT. op%set ) &
3130     CALL ERROR("Ctqmcoffdiag_measiPerturbation : QMC not set               ")
3131 
3132   index = op%impurity%particles(op%impurity%activeFlavor)%tail + 1
3133   IF ( index .LE. op%opt_order ) &
3134     op%measPerturbation(index,iflavor) = op%measPerturbation(index,iflavor) + 1.d0
3135   IF ( index == 1 ) THEN
3136     IF (op%impurity%particles(iflavor)%list(0,C_) < op%impurity%particles(iflavor)%list(0,Cdag_) ) THEN
3137       op%meas_fullemptylines(1,iflavor) = op%meas_fullemptylines(1,iflavor) + 1.d0
3138     ELSE
3139       op%meas_fullemptylines(2,iflavor) = op%meas_fullemptylines(2,iflavor) + 1.d0
3140     ENDIF
3141   ENDIF
3142 
3143 END SUBROUTINE Ctqmcoffdiag_measPerturbation

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printAll [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printAll

FUNCTION

  print different functions computed during the simulation

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4177 SUBROUTINE Ctqmcoffdiag_printAll(op)
4178 
4179 !Arguments ------------------------------------
4180 
4181 !This section has been created automatically by the script Abilint (TD).
4182 !Do not modify the following lines by hand.
4183 #undef ABI_FUNC
4184 #define ABI_FUNC 'Ctqmcoffdiag_printAll'
4185 !End of the abilint section
4186 
4187   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
4188 
4189   IF ( .NOT. op%done ) &
4190     CALL WARNALL("Ctqmcoffdiag_printAll : Simulation not run                 ")
4191 
4192 !sui!write(6,*) "op%stats",op%stats
4193   CALL Ctqmcoffdiag_printQMC(op)
4194 
4195   CALL Ctqmcoffdiag_printGreen(op)
4196 
4197   CALL Ctqmcoffdiag_printD(op)
4198 
4199 !  CALL Ctqmcoffdiag_printE(op)
4200 
4201 !#ifdef CTCtqmcoffdiag_ANALYSIS
4202   CALL Ctqmcoffdiag_printPerturbation(op)
4203 
4204   CALL Ctqmcoffdiag_printCorrelation(op)
4205 !#endif
4206 
4207   CALL Ctqmcoffdiag_printSpectra(op)
4208 
4209 END SUBROUTINE Ctqmcoffdiag_printAll

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printCorrelation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printCorrelation

FUNCTION

  print correlation fonctions

COPYRIGHT

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

INPUTS

  op=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4758 SUBROUTINE Ctqmcoffdiag_printCorrelation(op, oFileIn)
4759 
4760 !Arguments ------------------------------------
4761 
4762 !This section has been created automatically by the script Abilint (TD).
4763 !Do not modify the following lines by hand.
4764 #undef ABI_FUNC
4765 #define ABI_FUNC 'Ctqmcoffdiag_printCorrelation'
4766 !End of the abilint section
4767 
4768   TYPE(Ctqmcoffdiag)          , INTENT(IN)             :: op
4769   INTEGER  , OPTIONAL, INTENT(IN)             :: oFileIn
4770 !Local variables ------------------------------
4771   INTEGER                                     :: oFile
4772   INTEGER                                     :: itime
4773   INTEGER                                     :: sp1
4774   INTEGER                                     :: iflavor
4775   INTEGER                                     :: i
4776   INTEGER                                     :: flavors
4777   CHARACTER(LEN=2)                            :: a
4778   CHARACTER(LEN=50)                           :: string
4779   DOUBLE PRECISION                            :: dt
4780 
4781   !IF ( op%rank .NE. MOD(5,op%size)) RETURN
4782   IF ( op%rank .NE. MOD(op%size+5,op%size)) RETURN
4783   IF ( op%opt_analysis .NE. 1 ) RETURN
4784 
4785   oFile = 44
4786   IF ( PRESENT(oFileIn) ) THEN
4787     oFile = oFileIn
4788   ELSE
4789     OPEN(UNIT=oFile, FILE="Correlation.dat")
4790   END IF
4791 
4792   sp1         =  op%samples
4793   dt          =  op%beta / sp1
4794   sp1         =  sp1 + 1
4795   flavors     =  op%flavors
4796 
4797   i = 3*flavors + 1
4798   WRITE(a,'(I2)') i
4799   WRITE(oFile,*) "# time  (/ (segement, antiseg, correl), i=1, flavor/)"
4800   string = '(1x,'//TRIM(ADJUSTL(a))//'F19.15)'
4801   DO itime = 1, sp1
4802     WRITE(oFile,string) DBLE(itime-1)*dt, &
4803                    (/ ( &
4804                    (/ ( op%measCorrelation(itime, i, iflavor), i=1,3) /) &
4805                    , iflavor=1, flavors) /)
4806   END DO
4807 
4808   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4809 
4810 END SUBROUTINE Ctqmcoffdiag_printCorrelation

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printD [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printD

FUNCTION

  print individual double occupancy

COPYRIGHT

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

INPUTS

  op=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4543 SUBROUTINE Ctqmcoffdiag_printD(op,oFileIn)
4544 
4545 !Arguments ------------------------------------
4546 
4547 !This section has been created automatically by the script Abilint (TD).
4548 !Do not modify the following lines by hand.
4549 #undef ABI_FUNC
4550 #define ABI_FUNC 'Ctqmcoffdiag_printD'
4551 !End of the abilint section
4552 
4553   TYPE(Ctqmcoffdiag)          , INTENT(IN)    :: op
4554   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
4555 !Local variables ------------------------------
4556   INTEGER                            :: oFile
4557   INTEGER                            :: iflavor1
4558   INTEGER                            :: iflavor2
4559 
4560   !IF ( op%rank .NE. MOD(2,op%size)) RETURN
4561   IF ( op%rank .NE. MOD(op%size+2,op%size)) RETURN
4562 
4563   oFile = 41
4564   IF ( PRESENT(oFileIn) ) THEN
4565     oFile = oFileIn
4566   ELSE
4567     OPEN(UNIT=oFile, FILE="D.dat")
4568   END IF
4569 
4570   DO iflavor1 = 1, op%flavors
4571     DO iflavor2 = iflavor1+1, op%flavors
4572       WRITE(oFile,'(1x,A8,I4,A1,I4,A3,ES21.14)') "Orbitals", iflavor1, "-", iflavor2, " : ", op%measDE(iflavor2,iflavor1)
4573     END DO
4574   END DO
4575 
4576   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4577 
4578 END SUBROUTINE Ctqmcoffdiag_printD

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printE [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printE

FUNCTION

  print energy and noise 

COPYRIGHT

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

INPUTS

  op=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4612 SUBROUTINE Ctqmcoffdiag_printE(op,oFileIn)
4613 
4614 !Arguments ------------------------------------
4615 
4616 !This section has been created automatically by the script Abilint (TD).
4617 !Do not modify the following lines by hand.
4618 #undef ABI_FUNC
4619 #define ABI_FUNC 'Ctqmcoffdiag_printE'
4620 !End of the abilint section
4621 
4622   TYPE(Ctqmcoffdiag)          , INTENT(IN)    :: op
4623   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
4624 !Local variables ------------------------------
4625   INTEGER                            :: oFile
4626   DOUBLE PRECISION                   :: E
4627   DOUBLE PRECISION                   :: Noise
4628 
4629   !IF ( op%rank .NE. MOD(3,op%size)) RETURN
4630   IF ( op%rank .NE. MOD(op%size+3,op%size)) RETURN
4631 
4632   oFile = 42
4633   IF ( PRESENT(oFileIn) ) THEN
4634     oFile = oFileIn
4635   ELSE
4636     OPEN(UNIT=oFile, FILE="BetaENoise.dat")
4637   END IF
4638 
4639   CALL Ctqmcoffdiag_getE(op,E,Noise)
4640 
4641   WRITE(oFile,'(1x,F3.2,A2,ES21.14,A2,ES21.14)') op%beta, "  ", E, "  ",  Noise
4642 
4643   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4644 
4645 END SUBROUTINE Ctqmcoffdiag_printE

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printGreen

FUNCTION

  print green functions

COPYRIGHT

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

INPUTS

  op=ctqmc
  oFileIn=file stream

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4411 SUBROUTINE Ctqmcoffdiag_printGreen(op, oFileIn)
4412 
4413 !Arguments ------------------------------------
4414   use m_io_tools, only : flush_unit
4415 
4416 !This section has been created automatically by the script Abilint (TD).
4417 !Do not modify the following lines by hand.
4418 #undef ABI_FUNC
4419 #define ABI_FUNC 'Ctqmcoffdiag_printGreen'
4420 !End of the abilint section
4421 
4422   TYPE(Ctqmcoffdiag)        , INTENT(IN)    :: op
4423   INTEGER  , OPTIONAL, INTENT(IN)    :: oFileIn
4424 !Local variables ------------------------------
4425   INTEGER                            :: oFile
4426   INTEGER                            :: itime
4427   INTEGER                            :: sp1
4428   INTEGER                            :: iflavor,iflavorb
4429   INTEGER                            :: flavors,iflavor1,iflavor2
4430   CHARACTER(LEN=4)                   :: cflavors
4431   CHARACTER(LEN=50)                  :: string
4432   DOUBLE PRECISION                   :: dt
4433   DOUBLE PRECISION                   :: sweeps
4434 
4435   !IF ( op%rank .NE. MOD(1,op%size)) RETURN
4436   IF ( op%rank .NE. MOD(op%size+1,op%size)) RETURN
4437 
4438   oFile = 40
4439   IF ( PRESENT(oFileIn) ) THEN
4440     oFile = oFileIn
4441   ELSE
4442     OPEN(UNIT=oFile, FILE="Gtau.dat")
4443   END IF
4444   OPEN(UNIT=43, FILE="Gtau_nd.dat")
4445   rewind(43)
4446   sp1     =  op%samples
4447   dt      =  op%beta / DBLE(sp1)
4448   sp1     =  sp1 + 1
4449   flavors =  op%flavors
4450   sweeps = DBLE(op%sweeps)*DBLE(op%size)
4451 
4452   IF ( op%opt_noise .EQ. 1) THEN
4453     WRITE(cflavors,'(I4)') (2*flavors+1)*2
4454     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
4455     DO itime = 1, sp1
4456       WRITE(oFile,string) DBLE(itime-1)*dt, &
4457       (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /), &
4458       (/ (op%abNoiseG(1,itime,iflavor)*(sweeps)**op%abNoiseG(2,itime,iflavor), iflavor=1, flavors) /)
4459     END DO
4460   ELSE
4461     WRITE(cflavors,'(I4)') (flavors+1)*2
4462     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
4463     DO itime = 1, sp1
4464       WRITE(45,string) DBLE(itime-1)*dt, &
4465       (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /)
4466       WRITE(oFile,string) DBLE(itime-1)*dt, &
4467       (/ (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors) /)
4468       WRITE(46,*) DBLE(itime-1)*dt, &
4469       & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavor=1, flavors),iflavorb=1,flavors) /)
4470     END DO
4471     DO itime = 1, sp1
4472       WRITE(47,*) DBLE(itime-1)*dt, &
4473       & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavor=1, flavors),iflavorb=1,flavors) /)
4474     END DO
4475 !  --- Print full non diagonal Gtau in Gtau_nd.dat
4476     WRITE(cflavors,'(I4)') (flavors*flavors+1)
4477     write(47,*) "cflavors",cflavors
4478     string = '(1x,'//TRIM(ADJUSTL(cflavors))//'ES22.14)'
4479     write(47,*) string
4480     DO itime = 1, sp1
4481       WRITE(43,string) DBLE(itime-1)*dt, &
4482       & (/ ((op%Greens%oper(itime,iflavor,iflavorb), iflavorb=1, flavors),iflavor=1,flavors) /)
4483       WRITE(44,*) DBLE(itime-1)*dt, &
4484       & (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors)
4485       WRITE(44,string) DBLE(itime-1)*dt, &
4486       & (op%Greens%oper(itime,iflavor,iflavor), iflavor=1, flavors)
4487     END DO
4488       WRITE(43,*) 
4489   END IF
4490      DO iflavor = 1, flavors
4491        DO iflavor2 = 1, flavors
4492            write(4436,*) "#",iflavor,iflavor2
4493          do  itime=1,sp1
4494            write(4436,*) DBLE(itime-1)*dt,real(op%Greens%oper(itime,iflavor,iflavor2))
4495          enddo
4496            write(4436,*) 
4497        END DO
4498      END DO
4499      close(4436)
4500 
4501   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4502   CLOSE(43)
4503   CLOSE(44)
4504   CLOSE(45)
4505   CLOSE(46)
4506   CLOSE(47)
4507   !call flush_unit(43)
4508 
4509 END SUBROUTINE Ctqmcoffdiag_printGreen

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printPerturbation [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printPerturbation

FUNCTION

  print perturbation order

COPYRIGHT

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

INPUTS

  op=ctqmc
  oFileIn=file stream

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4681 SUBROUTINE Ctqmcoffdiag_printPerturbation(op, oFileIn)
4682 
4683 !Arguments ------------------------------------
4684 
4685 !This section has been created automatically by the script Abilint (TD).
4686 !Do not modify the following lines by hand.
4687 #undef ABI_FUNC
4688 #define ABI_FUNC 'Ctqmcoffdiag_printPerturbation'
4689 !End of the abilint section
4690 
4691   TYPE(Ctqmcoffdiag)          , INTENT(IN)           :: op
4692   INTEGER  , OPTIONAL,  INTENT(IN)          :: oFileIn
4693 !Local variables-------------------------------
4694   INTEGER                                   :: oFile
4695   INTEGER                                   :: iorder
4696   INTEGER                                   :: order
4697   INTEGER                                   :: iflavor
4698   INTEGER                                   :: flavors
4699   CHARACTER(LEN=2)                          :: a
4700   CHARACTER(LEN=50)                         :: string
4701 
4702   !IF ( op%rank .NE. MOD(4,op%size)) RETURN
4703   IF ( op%rank .NE. MOD(op%size+4,op%size)) RETURN
4704   IF ( op%opt_order .LE. 0 ) RETURN
4705 
4706   oFile = 43
4707   IF ( PRESENT(oFileIn) ) THEN
4708     oFile = oFileIn
4709   ELSE
4710     OPEN(UNIT=oFile, FILE="Perturbation.dat")
4711   END IF
4712     
4713   order        =  op%opt_order
4714   flavors      =  op%flavors
4715 
4716   WRITE(a,'(I2)') flavors
4717   string = '(I5,'//TRIM(ADJUSTL(a))//'F19.15)'
4718   DO iorder = 1, order
4719     WRITE(oFile,string) iorder-1, &
4720                 (/ (op%measPerturbation(iorder, iflavor), iflavor=1, flavors) /)
4721   END DO
4722 
4723   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4724 END SUBROUTINE Ctqmcoffdiag_printPerturbation

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printQMC [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printQMC

FUNCTION

  print ctqmc statistics

COPYRIGHT

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

INPUTS

  op=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4242 SUBROUTINE Ctqmcoffdiag_printQMC(op)
4243 
4244 !Arguments ------------------------------------
4245 
4246 !This section has been created automatically by the script Abilint (TD).
4247 !Do not modify the following lines by hand.
4248 #undef ABI_FUNC
4249 #define ABI_FUNC 'Ctqmcoffdiag_printQMC'
4250 !End of the abilint section
4251 
4252   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
4253 !Local variables ------------------------------
4254   INTEGER                  :: ostream
4255   INTEGER                  :: iflavor,iflavorbis,iorder
4256   DOUBLE PRECISION         :: sweeps
4257   DOUBLE PRECISION         :: invSweeps
4258   CHARACTER(LEN=2)         :: a
4259   CHARACTER(LEN=15)        :: string
4260 
4261   !IF ( op%rank .NE. 0) RETURN
4262   IF ( op%rank .NE. MOD(op%size,op%size)) RETURN
4263 
4264   ostream   = op%ostream
4265   sweeps    = DBLE(op%sweeps)
4266   invSweeps = 1.d0/sweeps
4267 
4268   WRITE(ostream,'(1x,F13.0,A11,F10.2,A12,I5,A5)') sweeps*DBLE(op%size), " sweeps in ", op%runTime, &
4269                  " seconds on ", op%size, " CPUs"
4270   WRITE(ostream,'(A28,F6.2)') "Segments added        [%] : ", op%stats(4)*invSweeps*100.d0
4271   WRITE(ostream,'(A28,F6.2)') "Segments removed      [%] : ", op%stats(5)*invSweeps*100.d0
4272   WRITE(ostream,'(A28,F6.2)') "Segments <0 sign      [%] : ", op%stats(6)*invSweeps*100.d0
4273   !WRITE(ostream,'(A28,F12.2)') "Number of meas        [%] : ", op%stats(6)
4274   WRITE(ostream,'(A28,F6.2)') "Anti-segments added   [%] : ", op%stats(1)*invSweeps*100.d0
4275   WRITE(ostream,'(A28,F6.2)') "Anti-segments removed [%] : ", op%stats(2)*invSweeps*100.d0
4276   WRITE(ostream,'(A28,F6.2)') "Anti-segments <0 sign [%] : ", op%stats(3)*invSweeps*100.d0
4277   !WRITE(ostream,'(A28,F12.2)') "Sum of sign       [%] : ", op%stats(3)
4278   WRITE(ostream,'(A28,F13.2)') "Signe value               : ", op%Greens%signvaluemeas
4279   IF ( op%modGlobalMove(1) .LT. op%sweeps + 1 ) THEN
4280     WRITE(ostream,'(A28,F6.2)') "Global Move           [%] : ", op%swap         *invSweeps*100.d0*op%modGlobalMove(1)
4281     WRITE(ostream,'(A28,F6.2)') "Global Move Reduced   [%] : ", op%swap         / DBLE(op%modGlobalMove(2))*100.d0
4282   END IF
4283 !#ifdef CTCtqmcoffdiag_CHECK
4284   IF ( op%opt_check .EQ. 1 .OR. op%opt_check .EQ. 3 ) &
4285     WRITE(ostream,'(A28,E22.14)') "Impurity test         [%] : ", op%errorImpurity*100.d0
4286   IF ( op%opt_check .GE. 2 ) &
4287       WRITE(ostream,'(A28,E22.14)') "Bath     test         [%] : ", op%errorBath    *100.d0
4288 !#endif
4289   WRITE(ostream,'(A28,ES22.14,A5,ES21.14)') "<Epot>                [U] : ", op%measDE(1,1), " +/- ",&
4290 !#ifdef HAVE_MPI
4291                                                               op%a_Noise*(sweeps*DBLE(op%size))**op%b_Noise
4292 !#else
4293 !                                                              op%a_Noise*(sweeps)**op%b_Noise
4294 !#endif
4295  !--------- Write double occupation between all pairs of orbitals --------------------------
4296   write(ostream,'(17x,a)') "Double occupation between pairs of orbitals"
4297   write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4298   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4299   do iflavor=1, op%flavors
4300     write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%measDE(iflavor,iflavorbis),iflavorbis=1,op%flavors)
4301   enddo
4302   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
4303  !------------------------------------------------------------------------------------------
4304 
4305  !--------- Write number of segments for each orbitals
4306  ! write(ostream,'(a)') "Number of segments for each orbitals"
4307  ! write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4308  ! write(ostream,'(17x,30a)') ("----------",iflavorbis=1,op%flavors)
4309  ! do iflavor=1, op%flavors
4310  !   write(ostream,'(i17,a,30f10.4)') iflavor,"|",(op%Impurity%particles(IT)%tail
4311  ! enddo
4312  ! write(ostream,'(17x,30a)') ("----------",iflavorbis=1,op%flavors)
4313  !------------------------------------------------------------------------------------------
4314  !--------- Write G(L)
4315   write(ostream,'(17x,a)') "G(L)"
4316   write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4317   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4318   do iflavor=1, op%flavors
4319     write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%Greens%oper(op%samples,iflavor,iflavorbis),iflavorbis=1,op%flavors)
4320   enddo
4321   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
4322  !------------------------------------------------------------------------------------------
4323  !--------- Write G(1)
4324   write(ostream,'(17x,a)') "G(1)"
4325   write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4326   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4327   do iflavor=1, op%flavors
4328     write(ostream,'(7x,i10,a,30f10.4)') iflavor,"|",(op%Greens%oper(1,iflavor,iflavorbis),iflavorbis=1,op%flavors)
4329   enddo
4330   write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors),ch10
4331  !------------------------------------------------------------------------------------------
4332 
4333   WRITE(ostream,'(A28,F8.4,A3,F7.4)') "Noise                 [U] : ", op%a_Noise, " x^", op%b_Noise
4334   WRITE(ostream,'(A28,E10.2)')  "Niquist puls.     [/beta] : ", ACOS(-1.d0)*op%inv_dt
4335   WRITE(ostream,'(A28,E22.14)') "Max Acc. Epot Error   [U] : ", op%measDE(2,2)/(op%beta*op%modNoise1*2.d0)*sweeps
4336   
4337   !WRITE(ostream,'(A28,F7.4,A3,F7.4,A4,E20.14)') "Noise            [G(tau)] : ", op%a_Noise(2), "x^", op%b_Noise(2), " -> ", &
4338                                                               !op%a_Noise(2)*(sweeps*DBLE(op%size))**op%b_Noise(2)
4339  !----- PERTURBATION ORDER------------------------------------------------------------------
4340   IF ( op%opt_order .GT. 0 ) THEN 
4341     write(ostream,*) 
4342     WRITE(a,'(I2)') op%flavors
4343     string = '(A28,'//TRIM(ADJUSTL(a))//'(1x,I3))'
4344     WRITE(ostream,string) "Perturbation orders       : ",(/ (MAXLOC(op%measPerturbation(:, iflavor))-1, iflavor=1, op%flavors) /)
4345     write(ostream,'(17x,a)') "order of Perturbation for flavors"
4346     write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4347     write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4348     write(ostream,'(12x,a,30i10)') " max ",(/ (MAXLOC(op%measPerturbation(:, iflavor))-1, iflavor=1, op%flavors) /)
4349     write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4350     do iorder=0, op%opt_order-1
4351       write(ostream,'(7x,i10,a,30f10.4)') iorder,"|",(op%measPerturbation(iorder+1,iflavor),iflavor=1,op%flavors)
4352     enddo
4353   END IF
4354  !------------------------------------------------------------------------------------------
4355  !----- PERTURBATION ORDER------------------------------------------------------------------
4356   IF ( op%opt_order .GT. 0 ) THEN 
4357     write(ostream,*) 
4358     write(ostream,'(17x,a)') "Proportion of full and empty orbital for order 0"
4359     write(ostream,'(17x,30i10)') (iflavorbis,iflavorbis=1,op%flavors)
4360     write(ostream,'(18x,30a)') ("----------",iflavorbis=1,op%flavors)
4361     write(ostream,'(2x,a,30f10.4)') " full  orbital |",(op%meas_fullemptylines(1,iflavor),iflavor=1,op%flavors)
4362     write(ostream,'(2x,a,30f10.4)') " empty orbital |",(op%meas_fullemptylines(2,iflavor),iflavor=1,op%flavors)
4363   END IF
4364  !------------------------------------------------------------------------------------------
4365   !CALL FLUSH(op%ostream)
4366   IF ( ABS(((op%stats(4) *invSweeps*100.d0) / (op%stats(5) *invSweeps*100.d0) - 1.d0)) .GE. 0.02d0 &
4367    .OR. ABS(((op%stats(1)*invSweeps*100.d0) / (op%stats(2)*invSweeps*100.d0) - 1.d0)) .GE. 0.02d0 ) &
4368     THEN 
4369     CALL WARNALL("Ctqmcoffdiag_printQMC : bad statistic according to moves. Increase sweeps")
4370   END IF
4371   IF ( ABS(op%b_Noise+0.5)/0.5d0 .GE. 0.05d0 ) &
4372     CALL WARNALL("Ctqmcoffdiag_printQMC : bad statistic according to Noise. Increase sweeps")
4373 !  IF ( ISNAN(op%a_Noise) .OR. ISNAN(op%a_Noise) ) &
4374 !    CALL WARNALL("Ctqmcoffdiag_printQMC : NaN appeared. Increase sweeps    ")
4375 
4376 
4377 END SUBROUTINE Ctqmcoffdiag_printQMC

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_printSpectra [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_printSpectra

FUNCTION

  print fourier transform of time evolution of number of electrons

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

4845 SUBROUTINE Ctqmcoffdiag_printSpectra(op, oFileIn)
4846 
4847 !Arguments ------------------------------------
4848 
4849 !This section has been created automatically by the script Abilint (TD).
4850 !Do not modify the following lines by hand.
4851 #undef ABI_FUNC
4852 #define ABI_FUNC 'Ctqmcoffdiag_printSpectra'
4853 !End of the abilint section
4854 
4855   TYPE(Ctqmcoffdiag)          , INTENT(IN)             :: op
4856   INTEGER  , OPTIONAL, INTENT(IN)             :: oFileIn
4857 !Local variables ------------------------------
4858   INTEGER                                     :: oFile
4859   INTEGER                                     :: flavors
4860   INTEGER                                     :: indDensity
4861   INTEGER                                     :: endDensity
4862   CHARACTER(LEN=4)                            :: a
4863   CHARACTER(LEN=16)                           :: formatSpectra
4864 
4865   !IF ( op%rank .NE. MOD(6,op%size)) RETURN
4866   IF ( op%opt_spectra .LT. 1 ) RETURN
4867 
4868   oFile = 45+op%rank
4869   a ="0000"
4870   WRITE(a,'(I4)') op%rank
4871   IF ( PRESENT(oFileIn) ) THEN
4872     oFile = oFileIn
4873   ELSE
4874     OPEN(UNIT=oFile, FILE="Markov_"//TRIM(ADJUSTL(a))//".dat")
4875   END IF
4876 
4877   flavors     =  op%flavors
4878   WRITE(a,'(I4)') flavors+1
4879   formatSpectra ='(1x,'//TRIM(ADJUSTL(a))//'ES22.14)'
4880   WRITE(oFile,*) "# freq[/hermalization] FFT"
4881 
4882   endDensity = SIZE(op%density,2)
4883   DO WHILE ( op%density(flavors+1,endDensity) .EQ. -1 )
4884     endDensity = endDensity -1
4885   END DO
4886 
4887   DO indDensity = 1, endDensity
4888     WRITE(oFile,formatSpectra) op%density(flavors+1,indDensity), op%density(1:flavors,indDensity)
4889   END DO
4890 
4891   IF ( .NOT. PRESENT(oFileIn) ) CLOSE(oFile)
4892 
4893 END SUBROUTINE Ctqmcoffdiag_printSpectra

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_reset [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_reset

FUNCTION

  reset a ctqmc simulation

COPYRIGHT

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

INPUTS

  op=ctqmc

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1179 SUBROUTINE Ctqmcoffdiag_reset(op)
1180 
1181 !Arguments ------------------------------------
1182 
1183 !This section has been created automatically by the script Abilint (TD).
1184 !Do not modify the following lines by hand.
1185 #undef ABI_FUNC
1186 #define ABI_FUNC 'Ctqmcoffdiag_reset'
1187 !End of the abilint section
1188 
1189   TYPE(Ctqmcoffdiag), INTENT(INOUT) :: op
1190 !Local variables ------------------------------
1191   INTEGER                  :: iflavor
1192   DOUBLE PRECISION         :: sweeps
1193 
1194   CALL GreenHyboffdiag_reset(op%Greens)
1195   CALL Ctqmcoffdiag_clear(op)
1196   CALL ImpurityOperator_reset(op%Impurity)
1197   CALL BathOperatoroffdiag_reset    (op%Bath)
1198   op%measN(3,:) = 0.d0
1199   !complete restart -> measN=0
1200   op%done = .FALSE.
1201   op%set  = .FALSE.
1202   op%inF  = .FALSE.
1203   op%opt_movie = 0
1204   op%opt_analysis = 0
1205   op%opt_order = 0
1206   op%opt_check = 0
1207   op%opt_noise = 0
1208   op%opt_spectra = 0
1209   op%opt_levels = 0
1210   sweeps = DBLE(op%sweeps)*DBLE(op%size)
1211   CALL Ctqmcoffdiag_setSweeps(op, sweeps)
1212 !#ifdef HAVE_MPI
1213 !  CALL MPI_BARRIER(op%MY_COMM,iflavor)
1214 !  IF ( op%rank .EQ. 0 ) &
1215 !#endif
1216 !  WRITE(op%ostream,'(A9)') "QMC reset"
1217 !  CALL FLUSH(op%ostream)
1218 END SUBROUTINE Ctqmcoffdiag_reset

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_run [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_run

FUNCTION

  set all options and run a simulation

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1872 SUBROUTINE Ctqmcoffdiag_run(op,opt_order,opt_movie,opt_analysis,opt_check,opt_noise,opt_spectra,opt_gMove)
1873 
1874 
1875 !This section has been created automatically by the script Abilint (TD).
1876 !Do not modify the following lines by hand.
1877 #undef ABI_FUNC
1878 #define ABI_FUNC 'Ctqmcoffdiag_run'
1879 !End of the abilint section
1880 
1881 
1882 #ifdef HAVE_MPI1
1883 include 'mpif.h'
1884 #endif
1885 !Arguments ------------------------------------
1886   TYPE(Ctqmcoffdiag), INTENT(INOUT)           :: op
1887   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_order
1888   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_movie
1889   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_analysis
1890   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_check
1891   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_noise
1892   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_spectra
1893   INTEGER, OPTIONAL, INTENT(IN   )  :: opt_gMove
1894 !Local variables ------------------------------
1895 #ifdef HAVE_MPI
1896   INTEGER                            :: ierr
1897 #endif
1898 !#ifdef CTCtqmcoffdiag_MOVIE
1899   INTEGER                            :: ilatex
1900   CHARACTER(LEN=4)                   :: Cchar
1901 !#endif
1902   DOUBLE PRECISION                   :: estimatedTime
1903 
1904   IF ( .NOT. op%set  ) &
1905     CALL ERROR("Ctqmcoffdiag_run : QMC not set up                          ")
1906   IF ( .NOT. op%setU ) &
1907     CALL ERROR("Ctqmcoffdiag_run : QMC does not have a U matrix            ")
1908 
1909 
1910 ! OPTIONS of the run
1911   IF ( PRESENT( opt_check ) ) THEN
1912     op%opt_check = opt_check
1913     CALL ImpurityOperator_doCheck(op%Impurity,opt_check)
1914     CALL BathOperatoroffdiag_doCheck(op%Bath,opt_check)
1915   END IF
1916   IF ( PRESENT( opt_movie ) ) &
1917     op%opt_movie = opt_movie
1918   IF ( PRESENT( opt_analysis ) ) &
1919     op%opt_analysis = opt_analysis
1920   IF ( PRESENT ( opt_order ) ) &
1921     op%opt_order = opt_order 
1922   IF ( PRESENT ( opt_noise ) ) THEN
1923     op%opt_noise = opt_noise 
1924   END IF
1925   IF ( PRESENT ( opt_spectra ) ) &
1926     op%opt_spectra = opt_spectra
1927 
1928   op%modGlobalMove(1) = max(op%sweeps,op%thermalization)+1 ! No Global Move
1929 !!sui!write(6,*) "op%sweeps",op%thermalization,op%sweeps,opt_gMove
1930   op%modGlobalMove(2) = 0
1931   IF ( PRESENT ( opt_gMove ) ) THEN
1932     IF ( opt_gMove .LE. 0 .OR. opt_gMove .GT. op%sweeps ) THEN
1933      ! op%modGlobalMove(1) = op%sweeps+1
1934       op%modGlobalMove(1) = max(op%sweeps,op%thermalization)+1 ! No Global Move
1935       !write(6,*) "op%sweeps",op%sweeps, op%modGlobalMove(1)
1936       CALL WARNALL("Ctqmcoffdiag_run : global moves option is <= 0 or > sweeps/cpu -> No global Moves")
1937     ELSE 
1938       op%modGlobalMove(1) = opt_gMove 
1939     END IF
1940   END IF
1941 !sui!write(6,*) "op%sweeps",op%thermalization,op%sweeps
1942 
1943   CALL Ctqmcoffdiag_allocateOpt(op)
1944   
1945 !#ifdef CTCtqmcoffdiag_MOVIE  
1946   ilatex = 0
1947   IF ( op%opt_movie .EQ. 1 ) THEN
1948     Cchar ="0000"
1949     WRITE(Cchar,'(I4)') op%rank 
1950     ilatex = 87+op%rank
1951     OPEN(UNIT=ilatex, FILE="Movie_"//TRIM(ADJUSTL(Cchar))//".tex")
1952     WRITE(ilatex,'(A)') "\documentclass{beamer}"
1953     WRITE(ilatex,'(A)') "\usepackage{color}"
1954     WRITE(ilatex,'(A)') "\setbeamersize{sidebar width left=0pt}"
1955     WRITE(ilatex,'(A)') "\setbeamersize{sidebar width right=0pt}"
1956     WRITE(ilatex,'(A)') "\setbeamersize{text width left=0pt}"
1957     WRITE(ilatex,'(A)') "\setbeamersize{text width right=0pt}"
1958     WRITE(ilatex,*) 
1959     WRITE(ilatex,'(A)') "\begin{document}"
1960     WRITE(ilatex,*) 
1961   END IF
1962 !#endif
1963 
1964   IF ( op%rank .EQ. 0 ) THEN
1965     WRITE(op%ostream,'(A29)') "Starting QMC (Thermalization)"
1966   END IF
1967   
1968   !=================================
1969   ! STARTING THERMALIZATION 
1970   !=================================
1971   !write(6,*) "sweeps before thermalization",op%sweeps
1972   !write(6,*) "op%stats",op%stats
1973   CALL Ctqmcoffdiag_loop(op,op%thermalization,ilatex)
1974   !=================================
1975   ! ENDING   THERMALIZATION 
1976   !=================================
1977 
1978   estimatedTime = op%runTime
1979 #ifdef HAVE_MPI
1980   CALL MPI_REDUCE(op%runTime, estimatedTime, 1, MPI_DOUBLE_PRECISION, MPI_MAX, &
1981              0, op%MY_COMM, ierr)
1982 #endif
1983 
1984   IF ( op%rank .EQ. 0 ) THEN
1985     WRITE(op%ostream,'(A26,I6,A11)') "Thermalization done in    ", CEILING(estimatedTime), "    seconds"
1986     WRITE(op%ostream,'(A25,I7,A15,I5,A5)') "The QMC should run in    ", &
1987            CEILING(estimatedTime*DBLE(op%sweeps)/DBLE(op%thermalization)),&
1988                         "    seconds on ", op%size, " CPUs"
1989   END IF
1990 
1991   !=================================
1992   ! CLEANING CTQMC          
1993   !=================================
1994   CALL Ctqmcoffdiag_clear(op)
1995 
1996   !=================================
1997   ! STARTING CTQMC          
1998   !=================================
1999   !write(6,*) "sweeps before loop",op%sweeps
2000   !write(6,*) "op%stats",op%stats
2001   CALL Ctqmcoffdiag_loop(op,op%sweeps,ilatex)
2002   !=================================
2003   ! ENDING   CTQMC          
2004   !=================================
2005 
2006   IF ( op%opt_movie .EQ. 1 ) THEN
2007     WRITE(ilatex,*) ""
2008     WRITE(ilatex,'(A14)') "\end{document}"
2009     CLOSE(ilatex)
2010   END IF
2011 
2012   op%done     = .TRUE.
2013 !sui!write(6,*) "op%stats en of ctqmc_run",op%stats
2014 
2015 END SUBROUTINE Ctqmcoffdiag_run

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setG0wTab [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setG0wTab

FUNCTION

  Set Gow from input array

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

941 SUBROUTINE Ctqmcoffdiag_setG0wTab(op,Gomega,opt_fk)
942 
943 !Arguments ------------------------------------
944 
945 !This section has been created automatically by the script Abilint (TD).
946 !Do not modify the following lines by hand.
947 #undef ABI_FUNC
948 #define ABI_FUNC 'Ctqmcoffdiag_setG0wTab'
949 !End of the abilint section
950 
951   TYPE(Ctqmcoffdiag), INTENT(INOUT)                      :: op
952   COMPLEX(KIND=8), DIMENSION(:,:,:), INTENT(IN ) :: Gomega
953   INTEGER                         , INTENT(IN ) :: opt_fk
954 !Local variable -------------------------------
955   DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: F
956 
957   IF ( .NOT. op%para ) &
958     CALL ERROR("Ctqmcoffdiag_setG0wTab : Ctqmcoffdiag_setParameters never called    ") 
959 
960   MALLOC(F,(1:op%samples+1,1:op%flavors,1:op%flavors))
961   CALL Ctqmcoffdiag_computeF(op,Gomega, F, opt_fk)  ! mu is changed
962   CALL BathOperatoroffdiag_setF(op%Bath, F)
963  ! CALL BathOperatoroffdiag_printF(op%Bath,333)
964   FREE(F)
965 
966   op%inF = .TRUE.
967   op%set = .TRUE. 
968 
969 END SUBROUTINE Ctqmcoffdiag_setG0wTab

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_sethybri_limit [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_sethybri_limit

FUNCTION

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

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1307 SUBROUTINE Ctqmcoffdiag_sethybri_limit(op, hybri_limit)
1308 
1309 !Arguments ------------------------------------
1310 
1311 !This section has been created automatically by the script Abilint (TD).
1312 !Do not modify the following lines by hand.
1313 #undef ABI_FUNC
1314 #define ABI_FUNC 'Ctqmcoffdiag_sethybri_limit'
1315 !End of the abilint section
1316 
1317   TYPE(Ctqmcoffdiag)                     , INTENT(INOUT) :: op
1318   COMPLEX(KIND=8) , DIMENSION(:,:),  INTENT(IN ) :: hybri_limit
1319 
1320   IF ( op%flavors .NE. SIZE(hybri_limit,1) ) &
1321     CALL ERROR("Error in sethybri_limit")
1322 
1323   op%hybri_limit(:,:)=hybri_limit(:,:)  
1324   op%opt_hybri_limit = 1
1325 END SUBROUTINE Ctqmcoffdiag_sethybri_limit

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setMu [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setMu

FUNCTION

  impose energy levels

COPYRIGHT

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

INPUTS

  op=ctqmc
  levels=energy levels vector

OUTPUT

  argout(sizeout)=description

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1253 SUBROUTINE Ctqmcoffdiag_setMu(op, levels)
1254 
1255 !Arguments ------------------------------------
1256 
1257 !This section has been created automatically by the script Abilint (TD).
1258 !Do not modify the following lines by hand.
1259 #undef ABI_FUNC
1260 #define ABI_FUNC 'Ctqmcoffdiag_setMu'
1261 !End of the abilint section
1262 
1263   TYPE(Ctqmcoffdiag)                     , INTENT(INOUT) :: op
1264   DOUBLE PRECISION, DIMENSION(:), INTENT(IN   ) :: levels
1265 
1266   IF ( op%flavors .NE. SIZE(levels,1) ) &
1267     CALL WARNALL("Ctqmcoffdiag_setMu : Taking energy levels from weiss G(iw)")
1268 
1269   op%mu(:)=-levels(:)  ! levels = \epsilon_j - \mu
1270   !op%mu =\tilde{\mu} = \mu -\epsilon_j
1271   op%opt_levels = 1
1272 END SUBROUTINE Ctqmcoffdiag_setMu

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setParameters [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setParameters

FUNCTION

  set all parameters and operators

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

496 SUBROUTINE Ctqmcoffdiag_setParameters(op,buffer)
497 
498 !Arguments ------------------------------------
499 
500 !This section has been created automatically by the script Abilint (TD).
501 !Do not modify the following lines by hand.
502 #undef ABI_FUNC
503 #define ABI_FUNC 'Ctqmcoffdiag_setParameters'
504 !End of the abilint section
505 
506   TYPE(Ctqmcoffdiag), INTENT(INOUT)                         :: op
507   DOUBLE PRECISION, DIMENSION(1:10), INTENT(IN   ) :: buffer
508 
509 
510   op%thermalization = INT(buffer(3)) !op%thermalization
511   CALL Ctqmcoffdiag_setSeed(op,INT(buffer(1)))
512   CALL Ctqmcoffdiag_setSweeps(op,buffer(2))
513 
514   op%measurements   = INT(buffer(4)) !op%measurements
515   op%flavors        = INT(buffer(5))
516   op%samples        = INT(buffer(6)) !op%samples
517   op%beta           = buffer(7)      !op%beta
518   op%U              = buffer(8)      !U
519   op%opt_nondiag    = INT(buffer(10))
520 !  op%mu             = buffer(9)      !op%mu
521   !op%Wmax           = INT(buffer(9)) !Freq
522 !#ifdef CTCtqmcoffdiag_ANALYSIS
523 !  op%order          = INT(buffer(10)) ! order
524   op%inv_dt         = op%samples / op%beta
525 !#endif
526 
527   !CALL ImpurityOperator_init(op%Impurity,op%flavors,op%beta, op%samples)
528   CALL ImpurityOperator_init(op%Impurity,op%flavors,op%beta)
529   IF ( op%U .GE. 0.d0 ) THEN
530     CALL ImpurityOperator_computeU(op%Impurity,op%U,0.d0)
531     op%setU = .TRUE.
532   END IF
533 !  op%mu = op%mu + op%Impurity%shift_mu
534 !sui!write(6,*) "op%opt_nondiag",op%opt_nondiag
535   CALL BathOperatoroffdiag_init(op%Bath, op%flavors, op%samples, op%beta, INT(buffer(9)), op%opt_nondiag)
536 
537   op%para = .TRUE.
538 
539 END SUBROUTINE Ctqmcoffdiag_setParameters

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setSeed [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setSeed

FUNCTION

  initialize random number generator

COPYRIGHT

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

INPUTS

  op=ctqmc
  iseed=seed from imput

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

641 SUBROUTINE Ctqmcoffdiag_setSeed(op,iseed)
642 
643 !Arguments ------------------------------------
644 
645 !This section has been created automatically by the script Abilint (TD).
646 !Do not modify the following lines by hand.
647 #undef ABI_FUNC
648 #define ABI_FUNC 'Ctqmcoffdiag_setSeed'
649 !End of the abilint section
650 
651   TYPE(Ctqmcoffdiag), INTENT(INOUT)           :: op
652   INTEGER  , INTENT(IN   )           :: iseed
653 !Local variables ------------------------------
654   !INTEGER                            :: n
655   !INTEGER                            :: i
656   !INTEGER, DIMENSION(:), ALLOCATABLE :: seed
657 
658 
659   !CALL RANDOM_SEED(size = n)
660   !MALLOC(seed,(n))
661   !seed =  iseed + (/ (i - 1, i = 1, n) /)
662 
663   !CALL RANDOM_SEED(PUT = seed+op%rank)
664 
665   !FREE(seed)
666 
667   op%seed=INT(iseed+op%rank,8)
668 
669 END SUBROUTINE Ctqmcoffdiag_setSeed

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setSweeps [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setSweeps

FUNCTION

  set the number of sweeps

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

573 SUBROUTINE Ctqmcoffdiag_setSweeps(op,sweeps)
574 
575 !Arguments ------------------------------------
576 
577 !This section has been created automatically by the script Abilint (TD).
578 !Do not modify the following lines by hand.
579 #undef ABI_FUNC
580 #define ABI_FUNC 'Ctqmcoffdiag_setSweeps'
581 !End of the abilint section
582 
583   TYPE(Ctqmcoffdiag)         , INTENT(INOUT) :: op
584   DOUBLE PRECISION  , INTENT(IN   ) :: sweeps
585 
586   op%sweeps = NINT(sweeps / DBLE(op%size))
587 !  !write(6,*) op%sweeps,NINT(sweeps / DBLE(op%size)),ANINT(sweeps/DBLE(op%size))
588   IF ( DBLE(op%sweeps) .NE. ANINT(sweeps/DBLE(op%size)) ) &
589     CALL ERROR("Ctqmcoffdiag_setSweeps : sweeps is negative or too big     ")
590   IF ( op%sweeps .LT. 2*CTQMC_SLICE1 ) THEN  !202
591     CALL WARNALL("Ctqmcoffdiag_setSweeps : # sweeps automtically changed     ")
592     op%sweeps = 2*CTQMC_SLICE1
593 !  ELSE IF ( op%sweeps .LT. op%thermalization ) THEN
594 !    CALL WARNALL("Ctqmcoffdiag_setSweeps : Thermalization > sweeps / cpu -> auto fix")
595 !    op%sweeps = op%thermalization
596   END IF
597   IF ( DBLE(NINT(DBLE(op%sweeps)*DBLE(op%size)/DBLE(CTQMC_SLICE1))) .NE.  &
598   ANINT(DBLE(op%sweeps)*DBLE(op%size)/DBLE(CTQMC_SLICE1)) ) THEN
599     op%modNoise1 = op%sweeps
600   ELSE
601     op%modNoise1    = MIN(op%sweeps,INT(DBLE(op%sweeps)*DBLE(op%size) / DBLE(CTQMC_SLICE1))) !101
602   END IF
603   op%modNoise2    = MAX(op%modNoise1 / CTQMC_SLICE2, 1)   ! 100
604 !  op%modGlobalMove(1) = op%thermalization / 10 + 1
605 !  op%modGlobalMove(2) = 0
606 
607 END SUBROUTINE Ctqmcoffdiag_setSweeps

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_setU [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_setU

FUNCTION

  set the interaction matrix

COPYRIGHT

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

INPUTS

  op=ctqmc
  matU=interaction matrix

OUTPUT

SIDE EFFECTS

NOTES

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

1034 SUBROUTINE Ctqmcoffdiag_setU(op,matU)
1035 
1036 !Arguments ------------------------------------
1037 
1038 !This section has been created automatically by the script Abilint (TD).
1039 !Do not modify the following lines by hand.
1040 #undef ABI_FUNC
1041 #define ABI_FUNC 'Ctqmcoffdiag_setU'
1042 !End of the abilint section
1043 
1044   TYPE(Ctqmcoffdiag), INTENT(INOUT) ::op
1045 !Local variables ------------------------------
1046   DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN) :: matU
1047 
1048   IF ( SIZE(matU) .NE. op%flavors*op%flavors ) &
1049     CALL ERROR("Ctqmcoffdiag_setU : Wrong interaction matrix (size)        ")
1050 
1051   CALL ImpurityOperator_setUmat(op%Impurity, matU)
1052   op%setU = .TRUE.
1053 END SUBROUTINE Ctqmcoffdiag_setU

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_symmetrizeGreen [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_symmetrizeGreen

FUNCTION

  optionnaly symmetrize the green functions

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

3698 SUBROUTINE Ctqmcoffdiag_symmetrizeGreen(op, syms)
3699 
3700 !Arguments ------------------------------------
3701 
3702 !This section has been created automatically by the script Abilint (TD).
3703 !Do not modify the following lines by hand.
3704 #undef ABI_FUNC
3705 #define ABI_FUNC 'Ctqmcoffdiag_symmetrizeGreen'
3706 !End of the abilint section
3707 
3708   TYPE(Ctqmcoffdiag)                     , INTENT(INOUT) :: op
3709   DOUBLE PRECISION, DIMENSION(:,:), INTENT(IN   ) :: syms
3710 !Local variables ------------------------------
3711   INTEGER :: iflavor1
3712   INTEGER :: iflavor2
3713   INTEGER :: flavors
3714   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: green_tmp
3715   DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:  ) :: n_tmp
3716 
3717 !  flavors = op%flavors
3718 !  IF ( SIZE(syms,1) .NE. flavors .OR. SIZE(syms,2) .NE. flavors ) THEN
3719 !    CALL WARNALL("Ctqmcoffdiag_symmetrizeGreen : wrong opt_sym -> not symmetrizing")
3720 !    RETURN
3721 !  END IF
3722 ! 
3723 !  MALLOC(green_tmp,(1:op%samples+1,flavors))
3724 !  green_tmp(:,:) = 0.d0
3725 !  MALLOC(n_tmp,(1:flavors))
3726 !  n_tmp(:) = 0.d0
3727 !  DO iflavor1=1, flavors
3728 !    DO iflavor2=1,flavors
3729 !      green_tmp(:,iflavor1) = green_tmp(:,iflavor1) &
3730 !                             + syms(iflavor2,iflavor1) * op%Greens(iflavor2)%oper(:)
3731 !      n_tmp(iflavor1) = n_tmp(iflavor1) &
3732 !                             + syms(iflavor2,iflavor1) * op%measN(1,iflavor2)
3733 !    END DO
3734 !  END DO
3735 !  DO iflavor1=1, flavors
3736 !    op%Greens(iflavor1)%oper(:) = green_tmp(:,iflavor1)
3737 !    op%measN(1,iflavor1)          = n_tmp(iflavor1)
3738 !  END DO
3739 !  FREE(green_tmp)
3740 !  FREE(n_tmp)
3741 END SUBROUTINE Ctqmcoffdiag_symmetrizeGreen

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_tryAddRemove [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_tryAddRemove

FUNCTION

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

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2308 SUBROUTINE Ctqmcoffdiag_tryAddRemove(op,updated)
2309 
2310 !Arguments ------------------------------------
2311 
2312 !This section has been created automatically by the script Abilint (TD).
2313 !Do not modify the following lines by hand.
2314 #undef ABI_FUNC
2315 #define ABI_FUNC 'Ctqmcoffdiag_tryAddRemove'
2316 !End of the abilint section
2317 
2318   TYPE(Ctqmcoffdiag)             , INTENT(INOUT) :: op
2319 !  TYPE(BathOperatoroffdiag)    , INTENT(INOUT) :: Bath 
2320 !  TYPE(ImpurityOperator), INTENT(INOUT) :: Impurity 
2321   LOGICAL               , INTENT(  OUT) :: updated
2322 !Local variables ------------------------------
2323   INTEGER                               :: position
2324   INTEGER         , DIMENSION(1:2)     :: nature ! -2 for antiseg and 1 for seg
2325   INTEGER                               :: i! -2 for antiseg and 1 for seg
2326   INTEGER                               :: ii,it,it1
2327   DOUBLE PRECISION                      :: action
2328   DOUBLE PRECISION                      :: beta
2329   DOUBLE PRECISION                      :: time1
2330   DOUBLE PRECISION                      :: time2
2331   DOUBLE PRECISION                      :: time_avail
2332   DOUBLE PRECISION                      :: det_ratio,sign_det_ratio
2333   DOUBLE PRECISION                      :: overlap
2334   DOUBLE PRECISION                      :: length
2335   DOUBLE PRECISION                      :: signe
2336   DOUBLE PRECISION                      :: tail
2337   INTEGER                      :: tailint
2338   DOUBLE PRECISION                      :: signdet, signdetprev
2339   DOUBLE PRECISION, DIMENSION(1:2)      :: CdagC_1
2340 
2341   IF ( .NOT. op%set ) &
2342     CALL ERROR("Ctqmcoffdiag_trySegment : QMC not set                       ")
2343 
2344         !write(6,*) "      TryAddRemove start"
2345   nature(1) = CTQMC_SEGME
2346   nature(2) = CTQMC_ANTIS
2347   beta      = op%beta
2348 
2349   updated = .FALSE.
2350   tailint  = (op%Impurity%particles(op%Impurity%activeFlavor)%tail)
2351   tail  = DBLE(tailint)
2352   !write(6,*) "op%Impurity%particles(op%Impurity%activeFlavor)%tail",op%Impurity%activeFlavor,tail
2353 
2354 
2355   !=====================================
2356   ! First choose segment or antisegment
2357   !=====================================
2358   DO i = 1, 2
2359     signe = SIGN(1.d0,DBLE(nature(i))) 
2360 !      -----  1: segment        signe= 1  ( CTQMC_SEGME =  1 )
2361 !      -----  2: antisegment    signe=-1  ( CTQMC_ANTIS = -2 )
2362 !    NB: Sign(a,b) = sign(b) * a
2363 
2364  !prt!if(op%prtopt==1) write(6,*) "       ==Starting configuration",i
2365  !prt!if(op%prtopt==1) write(6,*) "        = Segments:"
2366     tailint  = (op%Impurity%particles(op%Impurity%activeFlavor)%tail)
2367 !prt!    do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail
2368  !prt!if(op%prtopt==1)  write(6,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1), &
2369 !prt!&                    op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2)
2370 !prt!    enddo
2371   !sui!write(6,*) "        = M Matrix",op%Bath%sumtails
2372 !prt!    do it=1,op%Bath%sumtails
2373     !sui!write(6,'(a,3x,500e10.3)') "        M start",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2374 !prt!    enddo
2375     CALL OurRng(op%seed,action)
2376 
2377     !==========================
2378     ! Add segment/antisegment
2379     !==========================
2380     IF ( action .LT. .5d0 ) THEN ! Add a segment or antisegment
2381      !ii  write(6,*) "        =try: Segment added of type",i,op%prtopt
2382 
2383       ! Select time1 (>0) in [0,beta]
2384       !==============================
2385       CALL OurRng(op%seed,time1)
2386       time1 = time1 * beta
2387 
2388       ! time_avail is the distance between between time1 and 
2389       !   - the next start of a segment for a segment addition
2390       !   - the next end of a segment for an antisegment addition
2391       ! ImpurityOperator_getAvailableTime > 0 for a segment      (signe>0) -> time_avail>0
2392       ! ImpurityOperator_getAvailableTime < 0 for an antisegment (signe<0) -> time_avail>0
2393       !====================================================================
2394       time_avail = ImpurityOperator_getAvailableTime(op%Impurity,time1,position) * signe
2395      !ii  write(6,*) "        =try: time_avail",time_avail,time1
2396       IF ( time_avail .GT. 0.d0 ) THEN
2397 
2398         ! Time2 is  the length of the proposed new (anti)segment
2399         !=======================================================
2400         CALL OurRng(op%seed,time2)
2401         IF ( time2 .EQ. 0.d0 ) CALL OurRng(op%seed,time2) ! Prevent null segment
2402 
2403         ! Now time2 is the time at the end of the proposed new (anti) segment
2404         ! time2 > time1 
2405         !====================================================================
2406         time2     = time1 + time2 * time_avail
2407       !sui!write(6,*) tailint+1,time1,time2,position
2408 !        CALL CdagC_init(CdagC_1,time1,time2)
2409 
2410         ! CdagC_1 gives the stard/end times for the proposed new segment/antisegment
2411         ! CdagC1(C_) can  be above beta.
2412         !  For a      segment CdagC_1(Cdag_) = time1 < CdagC_1(C_) = time2, l=time2-time1 > 0
2413         !  For a anti segment CdagC_1(Cdag_) = time2 > CdagC_1(C_) = time1, l=time1-time2 < 0
2414         !  time2 can be above beta and thus for a      segment CdagC_1(C_   ) > beta
2415         !  time2 can be above beta and thus for an antisegment CdagC_1(Cdag_) > beta
2416         !  length > 0 for     segment
2417         !  length < 0 for antisegment
2418         !====================================================================================
2419         CdagC_1(Cdag_) = ((1.d0+signe)*time1+(1.d0-signe)*time2)*0.5d0
2420         CdagC_1(C_   ) = ((1.d0+signe)*time2+(1.d0-signe)*time1)*0.5d0
2421 !        length    = CdagC_length(CdagC_1)
2422         length    = CdagC_1(C_   ) - CdagC_1(Cdag_)
2423         !write(6,*) "      try : times", CdagC_1(C_   ),CdagC_1(Cdag_)
2424         !write(6,*) "      length", length
2425 
2426 !      -----  Computes the determinant ratio
2427         det_ratio = BathOperatoroffdiag_getDetAdd(op%Bath,CdagC_1,position,op%Impurity%particles) 
2428 
2429 !      -----  Computes the overlap
2430         overlap   = ImpurityOperator_getNewOverlap(op%Impurity,CdagC_1)
2431         signdetprev  = ImpurityOperator_getsign(op%Impurity, time2, i, action, position)
2432 
2433         !write(6,*) "      overlap   ", overlap
2434         CALL OurRng(op%seed,time1)
2435         !write(6,*) "      Rnd", time1
2436         signdet=1.d0
2437         det_ratio=det_ratio*signdetprev
2438                  
2439         IF ( det_ratio .LT. 0.d0 ) THEN
2440         !sui!write(6,*) "         NEGATIVE DET",det_ratio,signdetprev
2441           det_ratio   = - det_ratio
2442           sign_det_ratio=-1
2443           op%stats(nature(i)+CTQMC_DETSI) = op%stats(nature(i)+CTQMC_DETSI) + 1.d0
2444        !  op%signvaluecurrent=-1.d0
2445         ELSE
2446           sign_det_ratio=1
2447        !  op%signvaluecurrent=+1.d0
2448          ! signdet=-1.d0
2449         !sui!write(6,*) "                  DET",det_ratio,signdetprev
2450         END IF
2451       !ii  write(6,*) "                  DET",det_ratio
2452        ! op%signvaluemeas=op%signvaluemeas+1.d0
2453         !write(6,*) "        .................",(time1 * (tail + 1.d0 )),beta * time_avail * det_ratio * DEXP(op%mu(op%Impurity%activeFlavor)*length + overlap)
2454         !write(6,*) "        .................",beta , time_avail , op%mu(op%Impurity%activeFlavor),op%Impurity%activeFlavor
2455 
2456         IF ( (time1 * (tail + 1.d0 )) &
2457              .LT. (beta * time_avail * det_ratio * DEXP(op%mu(op%Impurity%activeFlavor)*length + overlap) ) ) THEN
2458 !          write(*,*) "before"
2459 !          CALL ListCdagCoffdiag_print(op%Impurity%particles(op%Impurity%activeFlavor),6)
2460           CALL ImpurityOperator_add(op%Impurity,CdagC_1,position)
2461 !          write(*,*) "after "
2462 !          CALL ListCdagCoffdiag_print(op%Impurity%particles(op%Impurity%activeFlavor),6)
2463           CALL BathOperatoroffdiag_setMAdd(op%bath,op%Impurity%particles) 
2464           op%stats(nature(i)+CTQMC_ADDED) = op%stats(nature(i)+CTQMC_ADDED)  + 1.d0
2465           updated = .TRUE. .OR. updated
2466           tail = tail + 1.d0
2467           tailint = tailint + 1
2468 !          read(*,*) time1
2469           !ii  write(6,*) "        Accepted addition, new conf is",time1
2470          !prt! do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail
2471           !prt!if(op%prtopt==1)  write(6,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1),&
2472 !prt!&                          op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2)
2473          !prt! enddo
2474         !sui!write(6,*) "        = M Matrix"
2475          !prt! do it=1,op%Bath%sumtails
2476           !sui!write(6,*) "        M new",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2477          !prt! enddo
2478 
2479           IF ( sign_det_ratio .LT. 0.d0 ) op%signvalue=-op%signvalue
2480         !sui!write(6,*) "                  signvalue",op%signvalue
2481         ELSE
2482      !ii  write(6,*) "        Refused      addition: proba",time1
2483         END IF 
2484       ELSE
2485     !sui!write(6,*) "        Refused      addition: time_avail <0"
2486       END IF 
2487 
2488     !========================================
2489     ! Remove segment/antisegment
2490     !========================================
2491     ELSE ! Remove a segment among the segment of the flavor activeflavor
2492       !ii if(op%prtopt==1)  write(6,*) "        =try: Segment removed of type",i
2493       IF ( tail .GT. 0.d0 ) THEN
2494         CALL OurRng(op%seed,time1)
2495         position = INT(((time1 * tail) + 1.d0) * signe )
2496         !prt!if(op%prtopt==1)  write(6,*) "         position",position 
2497         time_avail = ImpurityOperator_getAvailedTime(op%Impurity,position)
2498         det_ratio  = BathOperatoroffdiag_getDetRemove(op%Bath,position)
2499         !write(6,*) "        det_ratio", det_ratio
2500         CdagC_1    = ImpurityOperator_getSegment(op%Impurity,position)
2501 !        length     = CdagC_length(CdagC_1)
2502         length     = CdagC_1(C_) - CdagC_1(Cdag_)
2503         !write(6,*) "        length   ", length
2504         overlap    = ImpurityOperator_getNewOverlap(op%Impurity,CdagC_1)
2505         !write(6,*) "        overlap  ", overlap
2506         CALL OurRng(op%seed,time1)
2507         !write(6,*) "        Random   ",time1
2508         signdetprev = ImpurityOperator_getsign(op%Impurity, time2, i, action, position)
2509         det_ratio=det_ratio*signdetprev
2510         signdet=1.d0
2511         IF ( det_ratio .LT. 0.d0 ) THEN
2512         !sui!write(6,*) "         NEGATIVE DET",det_ratio,signdetprev
2513           det_ratio   = -det_ratio
2514           sign_det_ratio=-1
2515 !          op%seg_sign = op%seg_sign + 1.d0
2516           op%stats(nature(i)+CTQMC_DETSI) = op%stats(nature(i)+CTQMC_DETSI) + 1.d0
2517           signdet=-1.d0
2518         ELSE 
2519           sign_det_ratio=1
2520         !sui!write(6,*) "                  DET",det_ratio,signdetprev
2521         END IF
2522        !ii  write(6,*) "                  DET",det_ratio
2523         IF ( (time1 * beta * time_avail * DEXP(op%mu(op%Impurity%activeFlavor)*length+overlap)) &
2524              .LT. (tail * det_ratio ) ) THEN
2525           CALL ImpurityOperator_remove(op%Impurity,position)
2526           CALL BathOperatoroffdiag_setMRemove(op%Bath,op%Impurity%particles) 
2527           !op%seg_removed = op%seg_removed  + 1.d0
2528           op%stats(nature(i)+CTQMC_REMOV) = op%stats(nature(i)+CTQMC_REMOV)  + 1.d0
2529           updated = .TRUE. .OR. updated
2530           tail = tail -1.d0
2531           tailint = tailint -1
2532           !ii  write(6,*) "        Accepted removal, new conf is:",time1
2533       !prt!    do ii=0, op%Impurity%Particles(op%Impurity%activeFlavor)%tail
2534           !prt!if(op%prtopt==1)  write(6,*) ii, op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,1),&
2535 !prt!&                          op%Impurity%Particles(op%Impurity%activeFlavor)%list(ii,2)
2536       !prt!    enddo
2537         !sui!write(6,*) "        = M Matrix"
2538        !prt!   do it=1,op%Bath%sumtails
2539           !sui!write(6,*) "        M new",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2540         !prt!  enddo
2541           IF ( sign_det_ratio .LT. 0.d0 ) op%signvalue=-op%signvalue
2542         !sui!write(6,*) "                  signvalue",op%signvalue
2543         ELSE
2544      !ii  write(6,*) "        Refused      removal",time1
2545         END IF
2546       ELSE
2547       !sui!write(6,*) "        Refused      removal: no segment available"
2548       END IF
2549     END IF
2550     !========================================
2551     ! End Add/Remove Antisegment
2552     !========================================
2553   END DO
2554 END SUBROUTINE Ctqmcoffdiag_tryAddRemove

ABINIT/m_Ctqmcoffdiag/Ctqmcoffdiag_trySwap [ Functions ]

[ Top ] [ Functions ]

NAME

  Ctqmcoffdiag_trySwap

FUNCTION

  try a global move (swap to flavors)

COPYRIGHT

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

PARENTS

  Will be filled automatically by the parent script

CHILDREN

  Will be filled automatically by the parent script

SOURCE

2760 SUBROUTINE Ctqmcoffdiag_trySwap(op,flav_i,flav_j)
2761 
2762 !Arguments ------------------------------------
2763 
2764 !This section has been created automatically by the script Abilint (TD).
2765 !Do not modify the following lines by hand.
2766 #undef ABI_FUNC
2767 #define ABI_FUNC 'Ctqmcoffdiag_trySwap'
2768 !End of the abilint section
2769 
2770   TYPE(Ctqmcoffdiag)           , INTENT(INOUT) :: op
2771 !  TYPE(BathOperatoroffdiag)    , INTENT(INOUT) :: Bath 
2772 !  TYPE(ImpurityOperator), INTENT(INOUT) :: Impurity 
2773   INTEGER               , INTENT(  OUT) :: flav_i
2774   INTEGER               , INTENT(  OUT) :: flav_j
2775 !Local variables ------------------------------
2776   INTEGER :: flavor_i
2777   INTEGER :: flavor_j,ii,it,it1,iflavor
2778   DOUBLE PRECISION :: rnd
2779   DOUBLE PRECISION :: lengthi
2780   DOUBLE PRECISION :: lengthj
2781   DOUBLE PRECISION :: overlapic1
2782   DOUBLE PRECISION :: overlapjc1
2783   DOUBLE PRECISION :: overlapic2
2784   DOUBLE PRECISION :: overlapjc2
2785   DOUBLE PRECISION :: detic1
2786   DOUBLE PRECISION :: detjc1
2787   DOUBLE PRECISION :: detic2
2788   DOUBLE PRECISION :: detjc2
2789   DOUBLE PRECISION :: det_ratio,detnew,detold
2790   DOUBLE PRECISION :: local_ratio
2791  ! TYPE(BathOperatoroffdiag)  :: Bathnew
2792 
2793 
2794   !CALL RANDOM_NUMBER(rnd)
2795   CALL OurRng(op%seed,rnd)
2796   flavor_i = NINT(rnd*DBLE(op%flavors-1.d0))+1
2797   !CALL RANDOM_NUMBER(rnd)
2798   CALL OurRng(op%seed,rnd)
2799   flavor_j = NINT(rnd*DBLE(op%flavors-1.d0))+1
2800   !ii write(6,'(a,2i4)') "--------------- new swap --------------------------------",flavor_i,flavor_j
2801   
2802   flav_i = 0
2803   flav_j = 0
2804   !ii   do iflavor=1,op%flavors
2805   !ii     write(6,*) "BEFORE  GMOVE For flavor", iflavor,"size is",op%Impurity%particles(iflavor)%tail," and  Conf is :"
2806   !ii     do ii=1, op%Impurity%Particles(iflavor)%tail
2807   !ii       write(6,'(i4,100f12.3)') ii, op%Impurity%Particles(iflavor)%list(ii,1),&
2808   !ii  &                   op%Impurity%Particles(iflavor)%list(ii,2)
2809   !ii     enddo
2810   !ii   enddo
2811   !ii   write(6,*) "        = M Matrix"
2812   !ii   write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2813   !ii   write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2814   !ii   do it=1,op%Bath%sumtails
2815   !ii     write(6,'(a,100f12.3)') "        M before",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2816   !ii   enddo
2817 
2818   ! todoba this part
2819   IF ( flavor_i .NE. flavor_j ) THEN
2820     !CALL BathOperatoroffdiag_init(Bathnew, op%flavors, op%samples, op%beta, 0, op%opt_nondiag)
2821     ! On tente d'intervertir i et j
2822     ! Configuration actuelle :
2823 
2824     op%modGlobalMove(2) = op%modGlobalMove(2)+1
2825     ! ===========================================
2826     ! First use M matrix to compute determinant
2827     ! ===========================================
2828     detold     = BathOperatoroffdiag_getDetF(op%Bath) ! use op%Bath%M
2829 
2830     ! ===========================================
2831     ! Second build M_update matrix to compute determinant after.
2832     ! ===========================================
2833     !CALL ListCdagCoffdiag_print(particle)
2834     call BathOperatoroffdiag_recomputeM(op%Bath,op%impurity%particles,flavor_i,flavor_j) ! compute op%Bath%M_update
2835     detnew     = BathOperatoroffdiag_getDetF(op%Bath,option=1) ! use op%Bath%M_update
2836 
2837     lengthi    = ImpurityOperator_measN(op%Impurity,flavor_i)
2838     lengthj    = ImpurityOperator_measN(op%Impurity,flavor_j)
2839     overlapic1 = ImpurityOperator_overlapFlavor(op%Impurity,flavor_i)
2840     overlapjc1 = ImpurityOperator_overlapFlavor(op%Impurity,flavor_j)
2841     ! lengths unchanged
2842     overlapic2 = ImpurityOperator_overlapSwap(op%Impurity,flavor_i,flavor_j)
2843     overlapjc2 = ImpurityOperator_overlapSwap(op%Impurity,flavor_j,flavor_i)
2844 
2845 !    IF ( detic1*detjc1 .EQ. detic2*detjc2 ) THEN
2846 !      det_ratio = 1.d0
2847 !    ELSE IF ( detic1*detjc1 .EQ. 0.d0 ) THEN
2848 !      det_ratio = detic2*detjc2 ! evite de diviser par 0 si pas de segment
2849 !    ELSE
2850 
2851     det_ratio = detnew/detold ! because the determinant is the determinant of F
2852    !ii  write(6,*) "det_ratio, detold,detnew",det_ratio, detold,detnew, detold/detnew
2853 
2854 !    END IF
2855     local_ratio = DEXP(-overlapic2*overlapjc2+overlapic1*overlapjc1 &
2856                       +(lengthj-lengthi)*(op%mu(flavor_i)-op%mu(flavor_j)))
2857    !ii  write(6,*) "local_ratio",local_ratio
2858 
2859     ! Wloc = exp(muN-Uo)
2860     !CALL RANDOM_NUMBER(rnd)
2861     CALL OurRng(op%seed,rnd)
2862     IF ( rnd .LT. local_ratio*det_ratio ) THEN ! swap accepted
2863    !ii    write(6,*) "        = M Matrix before swap"
2864    !ii    write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2865    !ii    write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2866    !ii    do it=1,op%Bath%sumtails
2867    !ii      write(6,'(a,100f12.3)') "        M after ",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2868    !ii    enddo
2869    !ii    do it=1,op%Bath%sumtails
2870    !ii      write(6,'(a,100f12.3)') " update M after ",(op%Bath%M_update%mat(it,it1),it1=1,op%Bath%sumtails)
2871    !ii    enddo
2872    !ii    write(6,*) "Gmove accepted",rnd,local_ratio*det_ratio
2873       CALL ImpurityOperator_swap(op%Impurity, flavor_i,flavor_j)
2874       CALL BathOperatoroffdiag_swap    (op%Bath    , flavor_i,flavor_j) !  use op%Bath%M_update to built new op%Bath%M
2875       
2876       op%swap = op%swap + 1.d0
2877       flav_i = flavor_i
2878       flav_j = flavor_j
2879     ELSE
2880    !ii   write(6,*) "Gmove refused",rnd,local_ratio*det_ratio
2881 !      CALL WARN("Swap refused")
2882 !      WRITE(op%ostream,'(6E24.14)') local_ratio, det_ratio, detic1, detjc1, detic2, detjc2
2883     END IF
2884    ! CALL BathOperatoroffdiag_destroy(Bathnew)
2885   END IF
2886  !ii  do iflavor=1,op%flavors
2887  !ii    write(6,*) "AFTER   GMOVE For flavor", iflavor,"size is",op%Impurity%particles(iflavor)%tail," and  Conf is :"
2888  !ii    do ii=1, op%Impurity%Particles(iflavor)%tail
2889  !ii      write(6,'(15x,i4,100f12.3)') ii, op%Impurity%Particles(iflavor)%list(ii,1),&
2890  !ii &                   op%Impurity%Particles(iflavor)%list(ii,2)
2891  !ii    enddo
2892  !ii  enddo
2893  !ii  write(6,*) "        = M Matrix"
2894  !ii  write(6,'(a,2x,100(i12))') "Flavor=",((iflavor,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2895  !ii  write(6,'(i21,100i12)') ((it,it=1,op%Impurity%particles(iflavor)%tail),iflavor=1,op%flavors)
2896  !ii  do it=1,op%Bath%sumtails
2897  !ii    write(6,'(a,100f12.3)') "        M after ",(op%Bath%M%mat(it,it1),it1=1,op%Bath%sumtails)
2898  !ii  enddo
2899  !ii  do it=1,op%Bath%sumtails
2900  !ii    write(6,'(a,100f12.3)') " update M after ",(op%Bath%M_update%mat(it,it1),it1=1,op%Bath%sumtails)
2901  !ii  enddo
2902 
2903 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 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

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