Get2vWeightEnergy Subroutine

public subroutine Get2vWeightEnergy(dE1, dE2, dU, dBeta, dw, dEt)

Uses

Arguments

Type IntentOptional Attributes Name
real(kind=dp) :: dE1
real(kind=dp) :: dE2
real(kind=dp) :: dU
real(kind=dp) :: dBeta
real(kind=dp) :: dw
real(kind=dp) :: dEt

Contents

Source Code


Source Code

    subroutine Get2vWeightEnergy(dE1, dE2, dU, dBeta, dw, dEt)
        != Get the two-vertex contribution from a graph containing the reference
        != determinant, 0, and a connected determinant, i, given its matrix elements.
        != Weights are divided by exp(-beta E1)

        != Each two vertex graph is represented by a 2x2 (Hermitian) matrix
        !=  | dE1   dU  |
        !=  | dU*   dE2 |
        != The eigenvalues are [ (dE1+dE2) +- \Sqrt( (dE1+dE2) - 4dE1*dE2 + 4|dU|^2 ) ]/2.
        != where:
        !=   dE1=<D_0|H|D_0>
        !=   dE2=<D_i|H|D_i>
        !=   dU =<D_0|H|D_i>
        != Denoting the eigenvalues as dEp and dEm, the normalised eigenvectors are:
        !=   \frac{1}{\Sqrt{ dU^2 + (dE1-dEp)^2 } ( U, dEp-dE1 )
        !=   \frac{1}{\Sqrt{ dU^2 + (dE1-dEm)^2 } ( U, dEm-dE1 )

        != In:
        !=    dE1    <D_0|H|D_0>
        !=    dE2    <D_i|H|D_i>
        !=    dU     <D_0|H|D_i>
        !=    dBeta  beta
        != Out:
        !=    dw     weight of the graph, w_i[G]
        !=    dEt    weighted contribution of the graph, w_i[G] \tilde{E}_i[G]
        use constants, only: dp
        implicit none
        real(dp) dE1, dE2
        HElement_t(dp) dU, dEt, dw
        real(dp) dBeta
        HElement_t(dp) dEp, dEm, dD, dEx, dD2, dTmp
        if (near_zero(0.0_dp)) then
            ! Determinants are not connected.
            ! => zero contribution.
            dw = 0.0_dp
            dEt = 0.0_dp
            return
        end if

!  Calculate eigenvalues.
!   write(stdout,*) dE1,dE2,dU

        dD = ((dE1 + dE2)**2 - 4 * (dE1 * dE2) + 4 * abs(dU)**2)

!   write(stdout,*) dD

        dD = sqrt(dD) / 2
        dEp = (dE1 + dE2) / 2
        dEm = dEp - dD
        dEp = dEp + dD

!   write(stdout,*) dD,dEp,dEm

!  The normalized first coefficient of an eigenvector is U/sqrt((dE1-dEpm)**2+U**2)
        dD = 1 / sqrt((dE1 - dEp)**2 + abs(dU)**2) ! normalisation factor
        dD2 = dD * (dEp - dE1)               ! second coefficient
        dD = dD * dU                           ! first coefficient

!   write(stdout,*) dD,dD2

!dD is the eigenvector component
        dEx = exp(-dBeta * (dEp - dE1))
        dw = abs(dD)**2 * dEx
        dEt = dE1 * abs(dD)**2 * dEx
#ifdef CMPLX_
        dEt = dEt + dU * dD * conjg(dD2) * dEx
#else
        dEt = dEt + dU * dD * (dD2) * dEx
#endif

!   write(stdout,*) dEx,dw,dEt

!   write(stdout,*) dEp,dD,dD2,dw,dEx,dBeta
!  This can be numerically unstable when dE1 is v close to dEm:
!      dD=1/sqrt((dE1-dEm)**2+dU**2)
!      dD2=dD*(dEm-dE1)
!      dD=dD*dU
!  Instead we just swap dD2 and dD around
        dTmp = dD
#ifdef CMPLX_
        dD = conjg(dD2)
        dD2 = -conjg(dTmp)
#else
        dD = (dD2)
        dD2 = -(dTmp)
#endif
        dEx = exp(-dBeta * (dEm - dE1))
        dw = dw + (abs(dD)**2 * dEx)
!   write(stdout,*) dEm,dD,dD2,dw,dEx
        dEt = dEt + (dE1 * abs(dD)**2 * dEx)
#ifdef CMPLX_
        dEt = dEt + dU * dD * conjg(dD2) * dEx
#else
        dEt = dEt + dU * dD * (dD2) * dEx
#endif

!  Now, we already have calculated the effect of the one-vertex graph, so
!  we need to remove the double-counting of this from the 2-vertex graph.
!  For the one-vertex graph containing just i:
!     w_i[i] = exp(-\beta E_i)
!     w_i[i] \tilde{E}_i[i] = exp(-\beta E_i) E_i
!  As we factor out exp(-\beta E_i), this becomes just:
        dEt = dEt - (dE1)
        dw = dw - (1)
        write(stdout, *) 'wE,E', dEt, dw

    end subroutine Get2vWeightEnergy