Skip to content
This repository has been archived by the owner on Sep 30, 2021. It is now read-only.

Commit

Permalink
D_ev bug fixed
Browse files Browse the repository at this point in the history
  • Loading branch information
Y. Choe committed May 9, 2016
1 parent 912c066 commit 44e6665
Show file tree
Hide file tree
Showing 5 changed files with 29 additions and 30 deletions.
4 changes: 2 additions & 2 deletions arch.make
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,8 @@ FFLAGS = -traceback -fast -no-ipo -xSSE4.2 \

MKL_FFTW_PATH = $(MKLROOT)/interfaces/fftw3xf
FFTW = $(MKL_FFTW_PATH)/libfftw3xf_intel.a
ARPACK = ./lib/ARPACK/libarpack_OSX.a
PARPACK = ./lib/ARPACK/parpack_MPI-OSX.a
ARPACK = ./lib/ARPACK/libarpack_LINUX.a
PARPACK = ./lib/ARPACK/parpack_MPI-LINUX.a
LIBS = -mkl=sequential $(PARPACK) $(ARPACK) $(FFTW)

################################################################
Expand Down
1 change: 0 additions & 1 deletion ed_green.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -259,7 +259,6 @@ end subroutine n_from_gksum
!################################################################################
subroutine calc_dev
integer ::i,korb,iorb,k
double complex ::D_ev(Norb,nwloc)

do i = 1,nwloc
do korb = 1, Norb
Expand Down
20 changes: 10 additions & 10 deletions frprmn.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,16 +32,16 @@ subroutine frprmn(p,n,ftol,iter,nxsize,nwloc,Ns,omega,D_ev,Nbath,&
zero=0.D0

fp = func(p,Ns,nwloc,nxsize,omega,D_ev,Nbath,Norb,comm) ! initialization
! if(taskid.eq.master) write(6,'("Initial difference :",e)') fp
if(taskid.eq.master) write(6,'("Initial difference :",e)') fp
call dfunc(p,xi,nwloc,Ns,nxsize,omega,D_ev,Nbath,Norb,comm)

! if(taskid.eq.0) then
! write(6,*) " x df/dx "
! do i = 1, n
! write(6,*) p(i),xi(i)
! enddo
! write(6,*)
! endif
if(taskid.eq.0) then
write(6,*) " x df/dx "
do i = 1, n
write(6,*) p(i),xi(i)
enddo
write(6,*)
endif

do j = 1, n
g(j) = -xi(j)
Expand All @@ -54,8 +54,8 @@ subroutine frprmn(p,n,ftol,iter,nxsize,nwloc,Ns,omega,D_ev,Nbath,&
call linmin(p,xi,n,fret,Ns,nwloc,nxsize,omega,&
D_ev,Nbath,Norb,comm)
if(2.D0*abs(fret-fp).le.ftol*(abs(fret)+abs(fp)+eps)) then
! if(taskid.eq.master) &
! write(6,*) "After",its,"iteration converged."
if(taskid.eq.master) &
write(6,*) "After",its,"iteration converged."
return
endif
fp=fret
Expand Down
33 changes: 16 additions & 17 deletions func.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,27 +16,26 @@ FUNCTION FUNC(x,Ns,nwloc,nxsize,omega,D_ev,Nbath,Norb,comm)
call mpi_comm_rank(comm,taskid,ierr)

call x_to_ev(x,nxsize,Ns,Nbath,Norb,ef,ek,vk)

do iw = 1, nwloc
do korb = 1, Norb
delta(korb,iw) = dcmplx(0.D0,0.D0)
delta(korb,iw) = cmplx(0.D0,0.D0)
do ksite = Norb+1, Ns
delta(korb,iw) = delta(korb,iw) + &
vk(korb,ksite)*vk(korb,ksite) &
/(dcmplx(0.D0,omega(iw))-ek(ksite))
/(cmplx(0.D0,omega(iw))-ek(ksite))
enddo
delta(korb,iw) = delta(korb,iw) + ef(korb)
enddo
enddo

func_loc = 0.D0
do iw = 1, nwloc
do korb = 1, Norb
cpx_temp = delta(korb,iw) - D_ev(korb,iw)

func_loc = func_loc + abs(cpx_temp)*abs(cpx_temp)/omega(iw)
enddo
enddo

call mpi_allreduce(nwloc,nw,1,mpi_integer,mpi_sum,comm,ierr)
call mpi_allreduce(func_loc,func,1,mpi_double_precision,mpi_sum,comm,ierr)

Expand Down Expand Up @@ -74,11 +73,11 @@ subroutine dfunc(x,p,nwloc,Ns,nxsize,omega,D_ev,Nbath,Norb,comm)

do iw = 1,nwloc
do korb = 1, Norb
delta(korb,iw) = dcmplx(0.D0,0.D0)
delta(korb,iw) = cmplx(0.D0,0.D0)
do ksite = Norb+1, Ns
delta(korb,iw) = delta(korb,iw) + &
vk(korb,ksite)*vk(korb,ksite) &
/(dcmplx(0.D0,omega(iw))-ek(ksite))
/(cmplx(0.D0,omega(iw))-ek(ksite))
enddo
delta(korb,iw) = delta(korb,iw) + ef(korb)
enddo
Expand All @@ -92,10 +91,10 @@ subroutine dfunc(x,p,nwloc,Ns,nxsize,omega,D_ev,Nbath,Norb,comm)
do korb = 1, Norb
do iw = 1, nwloc
p_loc(ibath) = p_loc(ibath) + 2.D0*real( &
dconjg(delta(korb,iw)-D_ev(korb,iw)) &
conjg(delta(korb,iw)-D_ev(korb,iw)) &
*vk(korb,Norb+ibath)*vk(korb,Norb+ibath) &
/(dcmplx(0.D0,omega(iw))-ek(Norb+ibath)) &
/(dcmplx(0.D0,omega(iw))-ek(Norb+ibath)) &
/(cmplx(0.D0,omega(iw))-ek(Norb+ibath)) &
/(cmplx(0.D0,omega(iw))-ek(Norb+ibath)) &
)/omega(iw)
enddo
enddo
Expand All @@ -107,10 +106,10 @@ subroutine dfunc(x,p,nwloc,Ns,nxsize,omega,D_ev,Nbath,Norb,comm)
p_loc(i) = 0.D0
do iw = 1, nwloc
p_loc(i) = p_loc(i)+2.D0*real( &
dconjg(delta(iorb,iw)-D_ev(iorb,iw)) &
*vk(iorb,ksite)/(dcmplx(0.D0,omega(iw))-ek(ksite)) &
+ dconjg(delta(iorb,iw)-D_ev(iorb,iw)) &
*vk(iorb,ksite)/(dcmplx(0.D0,omega(iw))-ek(ksite)) &
conjg(delta(iorb,iw)-D_ev(iorb,iw)) &
*vk(iorb,ksite)/(cmplx(0.D0,omega(iw))-ek(ksite)) &
+ conjg(delta(iorb,iw)-D_ev(iorb,iw)) &
*vk(iorb,ksite)/(cmplx(0.D0,omega(iw))-ek(ksite)) &
)/omega(iw)
enddo
enddo
Expand Down Expand Up @@ -386,13 +385,13 @@ subroutine find_gtau(Gr,norb,nw,displ_w,nlocal_w,beta,ncpu,comm)
! endif

allocate(cin_fft(nwtot*4),cout_fft(nwtot*4))
cin_fft(:) = dcmplx(0.D0,0.D0)
cin_fft(:) = cmplx(0.D0,0.D0)

do j = 1, nwtot
cin_fft(2*j) = Gr_tot(j) - 1.D0/dcmplx(0.D0,(2*j-1)*pi/beta)
cin_fft(2*j) = Gr_tot(j) - 1.D0/cmplx(0.D0,(2*j-1)*pi/beta)
enddo
do j = 2*nwtot+2,4*nwtot
cin_fft(j) = dconjg(cin_fft(4*nwtot-j+2))
cin_fft(j) = conjg(cin_fft(4*nwtot-j+2))
enddo
call cfft_1d_bk(4*nwtot,cin_fft,cout_fft)
cout_fft(:) = cout_fft(:)/beta
Expand Down
1 change: 1 addition & 0 deletions main.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,7 @@ program MO_DMFT_ED
endif
call ev_to_x(ek,vk,ef,Nsite,Nbath,nxsize,x)

call mpi_barrier(comm,ierr)
call minimization(x,nwloc,Nsite,nxsize,omega,D_ev,Nbath,Norb,comm,xmin)
if(node.eq.0) then
call x_to_ev(x,nxsize,Nsite,Nbath,Norb,ef,ek,vk)
Expand Down

0 comments on commit 44e6665

Please sign in to comment.