Skip to content

GitLab

Commit 06987d4d authored by Jefferson Stafusa E. Portela's avatar Jefferson Stafusa E. Portela
Browse files
Options

New unsuccessful attempt at Exercise 2 of part 2 (tv model).

parent 605795f6
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1091 additions and 208 deletions
Tutorial/Solutions/Exercise_2/ALF/Prog/Hamiltonians/Hamiltonian_Hubbard_Plain_Vanilla_mod-Exercise_2.F90
View file @ 06987d4d
! Copyright (C) 2016 - 2020 The ALF project
!
!
! The ALF project is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
......@@ -19,7 +19,7 @@
! part of that community we feel that it is reasonable to require you to give an attribution
! back to the original authors if you have benefitted from this program.
! Guidelines for a proper citation can be found on the project's homepage
! http://alf.physik.uni-wuerzburg.de
! http://alf.physik.uni-wuerzburg.de
!
! - We require the preservation of the above copyright notice and this license in all original files.
!
......@@ -31,10 +31,10 @@
!--------------------------------------------------------------------
!> @author
!> @author
!> ALF-project
!>
!> @brief
!> @brief
!> This module defines the Hamiltonian and observables. Here, we have included a
!> set of predefined Hamiltonians. They include the Hubbard and SU(N) tV models
!> on honeycomb, pi-flux and square lattices.
......@@ -42,16 +42,16 @@
!> @details
!> The public variables of this module are the following
!>
!>
!>
!> @param [public] OP_V
!> \verbatim
!> Type (Operator), dimension(:,:), allocatable
!> Type (Operator), dimension(:,:), allocatable
!> List of operators of type=1,2 and 3 describing the sequence of interactions on a time slice.
!> The first index runs over this sequence. The second corresponds to the flavor index. \endverbatim
!>
!>
!> @param [public] OP_T
!> \verbatim
!> Type (Operator), dimension(:,:), allocatable
!> Type (Operator), dimension(:,:), allocatable
!> Sequence of operators accounting for the hopping on a time slice. This can include various
!> checkerboard decompositions. The first index runs over this sequence. The second corresponds to
!> the flavor index. \endverbatim
......@@ -59,7 +59,7 @@
!> \f$ \prod_{\tau} \; \; \prod_{n=1}^{N_V}e^{V_n(\tau)} \prod_{n=1}^{N_T}e^{T_n} \f$. That is
!> first the hopping and then the potential energy.
!>
!>@param [public] WF_L
!>@param [public] WF_L
!> \verbatim Type (WaveFunction), dimension(:), allocatable
!> Left trial wave function. \endverbatim
!>
......@@ -83,20 +83,20 @@
!> @param [public] N_SUN
!> \verbatim Integer
!> # of colors. Propagation is color independent. \endverbatim
!>
!>
!> @param [public] Ltrot
!> \verbatim Integer
!> Available measurment interval in units of Delta Tau. \endverbatim
!>
!> @param [public] Thtrot
!> @param [public] Thtrot
!> \verbatim Integer
!> Effective projection parameter in units of Delta Tau. (Only relevant if projective option is turned on) \endverbatim
!>
!> @param [public] Projector
!> \verbatim Logical
!> Flag for projector. If true then the total number of time slices will correspond to Ltrot + 2*Thtrot \endverbatim
!>
!> @param [public] Group_Comm
!>
!> @param [public] Group_Comm
!> \verbatim Integer
!> Defines MPI communicator \endverbatim
!
......@@ -110,8 +110,8 @@
!> symmetrically. If Symm is true, the propagation reads:
!> \f$ \prod_{\tau} \; \; \prod_{n=N_T}^{1}e^{T_n/2} \prod_{n=1}^{N_V}e^{V_n(\tau)} \prod_{n=1}^{N_T}e^{T_n/2} \f$
!>
!>
!> You still have to add some docu for the other private variables in this module.
!>
!> You still have to add some docu for the other private variables in this module.
!>
!--------------------------------------------------------------------
......@@ -119,8 +119,8 @@
Use Operator_mod
Use WaveFunction_mod
Use Lattices_v3
Use MyMats
Use Lattices_v3
Use MyMats
Use Random_Wrap
Use Files_mod
Use Matrix
......@@ -129,11 +129,11 @@
Use Predefined_Hoppings
Use LRC_Mod
Implicit none
Type (Operator), dimension(:,:), allocatable :: Op_V
Type (Operator), dimension(:,:), allocatable :: Op_V
Type (Operator), dimension(:,:), allocatable :: Op_T
Type (WaveFunction), dimension(:), allocatable :: WF_L
Type (WaveFunction), dimension(:), allocatable :: WF_R
......@@ -142,7 +142,7 @@
Integer :: N_FL
Integer :: N_SUN
Integer :: Ltrot
Integer :: Thtrot
Integer :: Thtrot
Logical :: Projector
Integer :: Group_Comm
Logical :: Symm
......@@ -158,25 +158,25 @@
real (Kind=Kind(0.d0)), private :: Dtau, Beta, Theta
Integer , private :: N_part
Character (len=64), private :: Model, Lattice_type
!> Privat Observables
Type (Obser_Vec ), private, dimension(:), allocatable :: Obs_scal
Type (Obser_Latt), private, dimension(:), allocatable :: Obs_eq
Type (Obser_Latt), private, dimension(:), allocatable :: Obs_tau
contains
contains
!--------------------------------------------------------------------
!> @author
!> @author
!> ALF Collaboration
!>
!> @brief
!> Sets the Hamiltonian
!--------------------------------------------------------------------
Subroutine Ham_Set
#if defined (MPI) || defined(TEMPERING)
Use mpi
#endif
......@@ -184,9 +184,9 @@
integer :: ierr, nf
Character (len=64) :: file_info, file_para
NAMELIST /VAR_Lattice/ L1, L2, Lattice_type, Model
......@@ -203,7 +203,7 @@
#endif
! Global "Default" values.
#ifdef MPI
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,ISIZE,IERR)
CALL MPI_COMM_RANK(MPI_COMM_WORLD,IRANK,IERR)
......@@ -213,9 +213,9 @@
#endif
File_Para = "parameters"
File_info = "info"
#if defined(TEMPERING)
#if defined(TEMPERING)
write(File_para,'(A,I0,A)') "Temp_",igroup,"/parameters"
write(File_info,'(A,I0,A)') "Temp_",igroup,"/info"
write(File_info,'(A,I0,A)') "Temp_",igroup,"/info"
#endif
#ifdef MPI
......@@ -239,6 +239,7 @@
CLOSE(5)
Ltrot = nint(beta/dtau)
Thtrot = 0
if (Projector) Thtrot = nint(theta/dtau)
Ltrot = Ltrot+2*Thtrot
N_SUN = 1
......@@ -250,7 +251,7 @@
Stop
Endif
!!!!!
#ifdef MPI
Endif
CALL MPI_BCAST(L1 ,1 ,MPI_INTEGER, 0,Group_Comm,ierr)
......@@ -276,11 +277,11 @@
! Setup the Bravais lattice
Call Ham_Latt
! Setup the hopping / single-particle part
Call Ham_Hop
! Setup the interaction.
call Ham_V
......@@ -289,7 +290,7 @@
#endif
OPEN(Unit = 50,file=file_info,status="unknown",position="append")
Write(50,*) '====================================='
Write(50,*) 'Model is : ', Model
Write(50,*) 'Model is : ', Model
Write(50,*) 'Lattice is : ', Lattice_type
Write(50,*) 'L1 : ', L1
Write(50,*) 'L2 : ', L2
......@@ -317,12 +318,12 @@
#endif
! Setup the trival wave function, in case of a projector approach
if (Projector) Call Ham_Trial(File_info)
end Subroutine Ham_Set
!--------------------------------------------------------------------
!> @author
!> @author
!> ALF Collaboration
!>
!> @brief
......@@ -330,32 +331,35 @@
!--------------------------------------------------------------------
Subroutine Ham_Latt
Implicit none
Real (Kind=Kind(0.d0)) :: a1_p(2), a2_p(2), L1_p(2), L2_p(2)
If (Lattice_Type /= "Square") then
Write(6,*) 'The plain vanilla Hubbard model is only defined for the square lattice'
stop
Endif
Latt_Unit%Norb = 1
Allocate (Latt_unit%Orb_pos_p(1,2))
Latt_Unit%Orb_pos_p(1,:) = 0.d0
a1_p(1) = 1.0 ; a1_p(2) = 0.d0
a2_p(1) = 0.0 ; a2_p(2) = 1.d0
L1_p = dble(L1)*a1_p
L2_p = dble(L2)*a2_p
Call Make_Lattice( L1_p, L2_p, a1_p, a2_p, Latt )
Ndim = Latt%N
end Subroutine Ham_Latt
!--------------------------------------------------------------------
!> @author
!> @author
!> ALF Collaboration
!>
!> @brief
!> Sets the Hopping
!--------------------------------------------------------------------
Subroutine Ham_Hop
Implicit none
Integer :: nf , I, Ix, Iy
......@@ -372,17 +376,17 @@
Op_T(1,nf)%O(Iy, I ) = cmplx(-Ham_T, 0.d0, kind(0.D0))
endif
Op_T(1,nf)%O(I, I ) = cmplx(-Ham_chem, 0.d0, kind(0.D0))
Op_T(1,nf)%P(i) = i
Op_T(1,nf)%P(i) = i
Enddo
Op_T(1,nf)%g = -Dtau
Op_T(1,nf)%alpha = cmplx(0.d0,0.d0, kind(0.D0))
Call Op_set(Op_T(1,nf))
enddo
end Subroutine Ham_Hop
!--------------------------------------------------------------------
!> @author
!> @author
!> ALF Collaboration
!>
!> @brief
......@@ -396,9 +400,9 @@
#endif
Use Predefined_Trial
Implicit none
Implicit none
Character (len=64), intent(in) :: file_info
Integer :: nf, Ix, Iy, I, n
Real (Kind=Kind(0.d0)), allocatable :: H0(:,:), U0(:,:), E0(:)
Real (Kind=Kind(0.d0)) :: Pi = acos(-1.d0), Delta = 0.01d0
......@@ -412,14 +416,14 @@
call MPI_Comm_size(Group_Comm, isize_g, ierr)
igroup = irank/isize_g
#endif
Allocate(WF_L(N_FL),WF_R(N_FL))
do nf=1,N_FL
Call WF_alloc(WF_L(nf),Ndim,N_part)
Call WF_alloc(WF_R(nf),Ndim,N_part)
enddo
Allocate(H0(Ndim,Ndim), U0(Ndim, Ndim), E0(Ndim) )
H0 = 0.d0; U0 = 0.d0; E0=0.d0
Do I = 1,Latt%N
......@@ -446,8 +450,8 @@
WF_L(nf)%Degen = E0(N_part+1) - E0(N_part)
WF_R(nf)%Degen = E0(N_part+1) - E0(N_part)
enddo
#ifdef MPI
If (Irank_g == 0) then
#endif
......@@ -466,7 +470,7 @@
end Subroutine Ham_Trial
!--------------------------------------------------------------------
!> @author
!> @author
!> ALF Collaboration
!>
!> @brief
......@@ -476,7 +480,7 @@
Use Predefined_Int
Implicit none
Integer :: nf, I
Real (Kind=Kind(0.d0)) :: X
!!!!! Modifications for Exercise 2
......@@ -493,7 +497,7 @@
!!!!!
enddo
enddo
Do nf = 1,N_FL
X = 1.d0
if (nf == 2) X = -1.d0
......@@ -516,13 +520,13 @@
Call Op_set( Op_V(i,nf) )
Enddo
Enddo
end Subroutine Ham_V
!--------------------------------------------------------------------
!> @author
!> @author
!> ALF Collaboration
!>
!> @brief
......@@ -551,11 +555,11 @@
case (4)
N = 1; Filename ="Ener"
case default
Write(6,*) ' Error in Alloc_obs '
Write(6,*) ' Error in Alloc_obs '
end select
Call Obser_Vec_make(Obs_scal(I),N,Filename)
enddo
! Equal time correlators
!!!!! Modifications for Exercise 2
!Allocate ( Obs_eq(5) )
......@@ -613,36 +617,36 @@
End Subroutine Alloc_obs
!--------------------------------------------------------------------
!> @author
!> @author
!> ALF Collaboration
!>
!> @brief
!> @brief
!> Computes equal time observables
!> @details
!> @param [IN] Gr Complex(:,:,:)
!> @param [IN] Gr Complex(:,:,:)
!> \verbatim
!> Green function: Gr(I,J,nf) = <c_{I,nf } c^{dagger}_{J,nf } > on time slice ntau
!> \endverbatim
!> @param [IN] Phase Complex
!> \verbatim
!> Phase
!> Phase
!> \endverbatim
!> @param [IN] Ntau Integer
!> \verbatim
!> Time slice
!> Time slice
!> \endverbatim
!-------------------------------------------------------------------
subroutine Obser(GR,Phase,Ntau)
Use Predefined_Obs
Implicit none
Complex (Kind=Kind(0.d0)), INTENT(IN) :: GR(Ndim,Ndim,N_FL)
Complex (Kind=Kind(0.d0)), Intent(IN) :: PHASE
Integer, INTENT(IN) :: Ntau
!Local
!Local
Complex (Kind=Kind(0.d0)) :: GRC(Ndim,Ndim,N_FL), ZK
Complex (Kind=Kind(0.d0)) :: Zrho, Zkin, ZPot, Z, ZP,ZS, ZZ, ZXY, ZDen
Integer :: I,J, imj, nf, Ix, Iy
......@@ -650,11 +654,11 @@
!!!!! Modifications for Exercise 2
Integer ::I1, J1, no_I, no_J
!!!!!
ZP = PHASE/Real(Phase, kind(0.D0))
ZS = Real(Phase, kind(0.D0))/Abs(Real(Phase, kind(0.D0)))
Do nf = 1,N_FL
Do I = 1,Ndim
Do J = 1,Ndim
......@@ -665,12 +669,12 @@
Enddo
! GRC(i,j,nf) = < c^{dagger}_{j,nf } c_{j,nf } >
! Compute scalar observables.
! Compute scalar observables.
Do I = 1,Size(Obs_scal,1)
Obs_scal(I)%N = Obs_scal(I)%N + 1
Obs_scal(I)%Ave_sign = Obs_scal(I)%Ave_sign + Real(ZS,kind(0.d0))
Enddo
Zkin = cmplx(0.d0, 0.d0, kind(0.D0))
Zkin = Zkin* dble(N_SUN)
......@@ -687,10 +691,10 @@
Do I = 1,Latt%N
Iy = Latt%nnlist(I,0,1)
Zkin = Zkin + GRC(I,Iy,2