quantum-espresso/GWW/gww/green_function.f90

481 lines
16 KiB
Fortran

!
! Copyright (C) 2001-2013 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
MODULE green_function
!this module descibes the green function in imaginary time/frequency
!and contains subroutine to read/write from disk and to create
USE kinds, ONLY : DP
TYPE green
!this structure describe a generic green function
!usually in the space of wanniers
INTEGER :: label!label to read/write to disk
LOGICAL :: ontime!if .true. is on imaginary time, otherwise frequency
REAL(kind=DP) :: time!imaginary time or frequency
INTEGER :: nums!number of states
LOGICAL :: zero_time_neg!if .true. the green function at t=0 is calculated as a negative time one
COMPLEX(kind=DP), DIMENSION(:,:,:), POINTER :: gf!green function
LOGICAL :: l_part!if true the matrix is written as a real matrix times a sign
REAL(kind=DP), DIMENSION(:,:,:), POINTER :: gf_p!green function
COMPLEX(kind=DP) :: factor !complex factor for gf_p
INTEGER ::nspin!spin multiplicity
END TYPE green
CONTAINS
SUBROUTINE initialize_green(gr)
implicit none
TYPE(green) gr
nullify(gr%gf)
nullify(gr%gf_p)
return
END SUBROUTINE
SUBROUTINE free_memory_green(gr)
!this subroutine deallocates the green descriptor
implicit none
TYPE(green) gr
if(associated(gr%gf)) deallocate(gr%gf)
nullify(gr%gf)
if(associated(gr%gf_p)) deallocate(gr%gf_p)
nullify(gr%gf_p)
return
END SUBROUTINE
SUBROUTINE create_green(gr,wu,time,debug,zero_time_neg,l_hf_energies,ene_hf)
!this subroutine creates a green function on imagynary time
!on the basis of wanniers:
!the KS energies are fixed so that the fermi level is at 0
! G_{i,j}=i*\sum_v U^{+}_{v,i}*U_{j,v}*exp(e_v*t) t>=0
! =-i*\sum_c U^{+}_{c,i}*U_{j,c}*exp(e_c*t) t<0
!if required uses HF energies
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE basic_structures, ONLY : wannier_u
implicit none
TYPE(green) :: gr!the green function on output
TYPE(wannier_u) :: wu!data on U and e_i
REAL(kind=DP) :: time!imaginary time
LOGICAL :: debug!if true print debug informations on stdout
LOGICAL :: zero_time_neg!if true and time==0, the negative form is forced
LOGICAL, INTENT(in) :: l_hf_energies!if true uses HF energies
REAL(kind=DP), INTENT(in) :: ene_hf(:)
INTEGER iw,jw,kw
REAL(kind=DP) :: offset
!calculates energy offset
gr%nspin=wu%nspin
if(gr%nspin==1) then
if(.not.l_hf_energies) then
if(wu%nums > wu%nums_occ(1)) then
offset=-(wu%ene(wu%nums_occ(1)+1,1)+wu%ene(wu%nums_occ(1),1))/2.d0
else
offset=-wu%ene(wu%nums_occ(1),1)
endif
else
if(wu%nums > wu%nums_occ(1)) then
offset=-(ene_hf(wu%nums_occ(1)+1)+ene_hf(wu%nums_occ(1)))/2.d0
else
offset=-ene_hf(wu%nums_occ(1))
endif
endif
else
if(wu%nums > max(wu%nums_occ(1),wu%nums_occ(2))) then
offset=-(min(wu%ene(wu%nums_occ(1)+1,1),wu%ene(wu%nums_occ(2)+1,2))+&
&max(wu%ene(wu%nums_occ(1),1), wu%ene(wu%nums_occ(2),2)))/2.d0
else
offset=-max(wu%ene(wu%nums_occ(1),1), wu%ene(wu%nums_occ(2),2))
endif
endif
!sets data and allocate
! call free_memory_green(gr)
gr%nums=wu%nums
allocate(gr%gf(gr%nums,gr%nums,gr%nspin))
gr%gf(:,:,:)=(0.d0,0.d0)
gr%ontime=.TRUE.
gr%time=time
gr%zero_time_neg = zero_time_neg
if((time < 0.d0).or. (time==0.d0 .and. zero_time_neg )) then
! only conduction states
do iw=1,gr%nums
do jw=iw,gr%nums
do kw=wu%nums_occ(1)+1,wu%nums
if(.not.l_hf_energies) then
gr%gf(iw,jw,1)=gr%gf(iw,jw,1)+wu%umat(kw,iw,1)*conjg(wu%umat(kw,jw,1))* &
& exp((wu%ene(kw,1)+offset)*time)
else
gr%gf(iw,jw,1)=gr%gf(iw,jw,1)+wu%umat(kw,iw,1)*conjg(wu%umat(kw,jw,1))* &
& exp((ene_hf(kw)+offset)*time)
endif
if(debug) then
write(stdout,*) 'Create green:' ,time,iw,jw,wu%ene(kw,1),wu%nums_occ(1)+1,wu%umat(jw,kw,1)
endif
enddo
gr%gf(jw,iw,1)=conjg(gr%gf(iw,jw,1))
gr%gf(iw,jw,1)=(0.d0,-1.d0)*gr%gf(iw,jw,1)
if(iw /= jw) gr%gf(jw,iw,1)=(0.d0,-1.d0)*gr%gf(jw,iw,1)
enddo
enddo
else
! only valence states
do iw=1,gr%nums
do jw=iw,gr%nums
do kw=1,wu%nums_occ(1)
if(.not. l_hf_energies) then
gr%gf(iw,jw,1)=gr%gf(iw,jw,1)+wu%umat(kw,iw,1)*conjg(wu%umat(kw,jw,1))* &
& exp((wu%ene(kw,1)+offset)*time)
else
gr%gf(iw,jw,1)=gr%gf(iw,jw,1)+wu%umat(kw,iw,1)*conjg(wu%umat(kw,jw,1))* &
& exp((ene_hf(kw)+offset)*time)
endif
if(debug) then
write(stdout,*) 'Create green:' ,time,iw,jw,wu%ene(kw,1),wu%umat(kw,iw,1),wu%umat(kw,jw,1)
endif
enddo
gr%gf(jw,iw,1)=conjg(gr%gf(iw,jw,1))
gr%gf(iw,jw,1)=(0.d0,1.d0)*gr%gf(iw,jw,1)
if(iw /= jw) gr%gf(jw,iw,1)=(0.d0,1.d0)*gr%gf(jw,iw,1)
if(debug) write(stdout,*) 'Create green2:', iw,jw, gr%gf(iw,jw,1), offset
enddo
enddo
endif
return
END SUBROUTINE
SUBROUTINE create_green_part(gr,wu,time,debug,zero_time_neg,l_hf_energies,ene_hf)
!this subroutine creates a green function on imagynary time
!on the basis of wanniers:
!the KS energies are fixed so that the fermi level is at 0
! G_{i,j}=i*\sum_v U^{+}_{v,i}*U_{j,v}*exp(e_v*t) t>=0
! =-i*\sum_c U^{+}_{c,i}*U_{j,c}*exp(e_c*t) t<0
!if required uses HF energies
!it uses consider a real part plus a factor
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE basic_structures, ONLY : wannier_u
implicit none
TYPE(green) :: gr!the green function on output
TYPE(wannier_u) :: wu!data on U and e_i
REAL(kind=DP) :: time!imaginary time
LOGICAL :: debug!if true print debug informations on stdout
LOGICAL :: zero_time_neg!if true and time==0, the negative form is forced
LOGICAL, INTENT(in) :: l_hf_energies!if true uses HF energies
REAL(kind=DP), INTENT(in) :: ene_hf(:)
INTEGER iw,jw,kw
REAL(kind=DP) :: offset
call free_memory_green(gr)
gr%nspin=wu%nspin
gr%l_part=.true.
!calculates energy offset
if(gr%nspin==1) then
if(.not.l_hf_energies) then
if(wu%nums > wu%nums_occ(1)) then
offset=-(wu%ene(wu%nums_occ(1)+1,1)+wu%ene(wu%nums_occ(1),1))/2.d0
else
offset=-wu%ene(wu%nums_occ(1),1)
endif
else
if(wu%nums > wu%nums_occ(1)) then
offset=-(ene_hf(wu%nums_occ(1)+1)+ene_hf(wu%nums_occ(1)))/2.d0
else
offset=-ene_hf(wu%nums_occ(1))
endif
endif
else
if(wu%nums > max(wu%nums_occ(1),wu%nums_occ(2))) then
offset=-(min(wu%ene(wu%nums_occ(1)+1,1),wu%ene(wu%nums_occ(2)+1,2))+&
&max(wu%ene(wu%nums_occ(1),1), wu%ene(wu%nums_occ(2),2)))/2.d0
else
offset=-max(wu%ene(wu%nums_occ(1),1), wu%ene(wu%nums_occ(2),2))
endif
endif
!sets data and allocate
! call free_memory_green(gr)
gr%nums=wu%nums
allocate(gr%gf_p(gr%nums,gr%nums,gr%nspin))
gr%gf_p(:,:,:)=0.d0
gr%ontime=.TRUE.
gr%time=time
gr%zero_time_neg = zero_time_neg
if((time < 0.d0).or. (time==0.d0 .and. zero_time_neg )) then
! only conduction states
do iw=1,gr%nums
do jw=iw,gr%nums
do kw=wu%nums_occ(1)+1,wu%nums
if(.not.l_hf_energies) then
gr%gf_p(iw,jw,1)=gr%gf_p(iw,jw,1)+dble(wu%umat(kw,iw,1))*dble(wu%umat(kw,jw,1))* &
& exp((wu%ene(kw,1)+offset)*time)
! if(abs(aimag(wu%umat(kw,iw)) >=1.d-6)) write(stdout,*) 'PROBLEMA'
else
gr%gf_p(iw,jw,1)=gr%gf_p(iw,jw,1)+dble(wu%umat(kw,iw,1))*dble(wu%umat(kw,jw,1))* &
& exp((ene_hf(kw)+offset)*time)
endif
if(debug) then
write(stdout,*) 'Create green:' ,time,iw,jw,wu%ene(kw,1),wu%nums_occ+1,wu%umat(jw,kw,1)
endif
enddo
gr%gf_p(jw,iw,1)=gr%gf_p(iw,jw,1)
gr%factor=(0.d0,-1.d0)
enddo
enddo
else
! only valence states
do iw=1,gr%nums
do jw=iw,gr%nums
do kw=1,wu%nums_occ(1)
if(.not. l_hf_energies) then
gr%gf_p(iw,jw,1)=gr%gf_p(iw,jw,1)+dble(wu%umat(kw,iw,1))*dble(wu%umat(kw,jw,1))* &
& exp((wu%ene(kw,1)+offset)*time)
else
gr%gf_p(iw,jw,1)=gr%gf_p(iw,jw,1)+dble(wu%umat(kw,iw,1))*dble(wu%umat(kw,jw,1))* &
& exp((ene_hf(kw)+offset)*time)
endif
if(debug) then
write(stdout,*) 'Create green:' ,time,iw,jw,wu%ene(kw,1),wu%umat(kw,iw,1),wu%umat(kw,jw,1)
endif
enddo
gr%gf_p(jw,iw,1)=gr%gf_p(iw,jw,1)
gr%factor=(0.d0,1.d0)
if(debug) write(stdout,*) 'Create green2:', iw,jw, gr%gf_p(iw,jw,1), offset
enddo
enddo
endif
return
END SUBROUTINE create_green_part
SUBROUTINE write_green(gr, debug)
!this subroutine writes the green function on disk
!the file name is taken from the label
USE io_files, ONLY : prefix,tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(green) :: gr!the green function to be written
LOGICAL :: debug!if true print formatted file
INTEGER :: iw, jw, iung,is
CHARACTER(5) :: nfile
if(gr%label > 0 .or. (gr%label == 0 .and. .not.gr%zero_time_neg)) then
write(nfile,'(5i1)') &
& gr%label/10000,mod(gr%label,10000)/1000,mod(gr%label,1000)/100,mod(gr%label,100)/10,mod(gr%label,10)
iung = find_free_unit()
if(.not. debug) then
open( unit=iung, file=trim(tmp_dir)//trim(prefix)//'-'//'green.'// nfile, status='unknown',form='unformatted')
else
open( unit=iung, file=trim(tmp_dir)//trim(prefix)//'-'//'green.'// nfile, status='unknown',form='formatted')
endif
else
write(nfile,'(5i1)') &
& -gr%label/10000,mod(-gr%label,10000)/1000,mod(-gr%label,1000)/100,mod(-gr%label,100)/10,mod(-gr%label,10)
iung = find_free_unit()
if(.not.debug) then
open( unit=iung, file=trim(tmp_dir)//trim(prefix)//'-'//'green.-'// nfile, status='unknown',form='unformatted')
else
open( unit=iung, file=trim(tmp_dir)//trim(prefix)//'-'//'green.-'// nfile, status='unknown',form='formatted')
endif
endif
if(.not.debug) then
write(iung) gr%label
write(iung) gr%ontime
write(iung) gr%time
write(iung) gr%nspin
write(iung) gr%nums
write(iung) gr%zero_time_neg
write(iung) gr%l_part
write(iung) gr%factor
do is=1,gr%nspin
if(.not.gr%l_part) then
do iw=1,gr%nums
write(iung) gr%gf(1:gr%nums,iw,is)
enddo
else
do iw=1,gr%nums
write(iung) gr%gf_p(1:gr%nums,iw,is)
enddo
endif
enddo
else
write(iung,*) gr%label
write(iung,*) gr%ontime
write(iung,*) gr%time
write(iung,*) gr%nspin
write(iung,*) gr%nums
write(iung,*) gr%zero_time_neg
write(iung,*) gr%l_part
write(iung,*) gr%factor
do is=1,gr%nspin
if(.not.gr%l_part) then
do iw=1,gr%nums
do jw=1,gr%nums
write(iung,*) gr%gf(jw,iw,is)
enddo
enddo
else
do iw=1,gr%nums
do jw=1,gr%nums
write(iung,*) gr%gf_p(jw,iw,is)
enddo
enddo
endif
enddo
endif
close(iung)
return
END SUBROUTINE write_green
SUBROUTINE read_green(label, gr, debug,zero_time_neg)
!this subroutine reads the green function from disk
!the file name is taken from the label
USE io_files, ONLY : prefix,tmp_dir
implicit none
INTEGER, EXTERNAL :: find_free_unit
TYPE(green) :: gr!the green function to be read
INTEGER :: label! the label identifing the required green function
LOGICAL :: debug!if true print formatted file
LOGICAL :: zero_time_neg !if true and time == 0, a negative kind of green function is considered
INTEGER :: iw, jw, iung,is
CHARACTER(5) :: nfile
!first deallocate
call free_memory_green(gr)
if(label > 0 .or. (label == 0 .and. .not.zero_time_neg)) then
write(nfile,'(5i1)') label/10000,mod(label,10000)/1000,mod(label,1000)/100,mod(label,100)/10,mod(label,10)
iung = find_free_unit()
if(.not.debug) then
open( unit=iung, file=trim(tmp_dir)//trim(prefix)//'-'//'green.'// nfile, status='old',form='unformatted')
else
open( unit=iung, file=trim(tmp_dir)//trim(prefix)//'-'//'green.'// nfile, status='old',form='formatted')
endif
else
write(nfile,'(5i1)') -label/10000,mod(-label,10000)/1000,mod(-label,1000)/100,mod(-label,100)/10,mod(-label,10)
iung = find_free_unit()
if(.not.debug) then
open( unit=iung, file=trim(tmp_dir)//trim(prefix)//'-'//'green.-'// nfile, status='old',form='unformatted')
else
open( unit=iung, file=trim(tmp_dir)//trim(prefix)//'-'//'green.-'// nfile, status='old',form='formatted')
endif
endif
if(.not.debug) then
read(iung) gr%label
read(iung) gr%ontime
read(iung) gr%time
read(iung) gr%nspin
read(iung) gr%nums
read(iung) gr%zero_time_neg
read(iung) gr%l_part
read(iung) gr%factor
!now allocate
if(.not. gr%l_part) then
allocate(gr%gf(gr%nums,gr%nums,gr%nspin))
nullify(gr%gf_p)
else
allocate(gr%gf_p(gr%nums,gr%nums,gr%nspin))
nullify(gr%gf)
endif
do is=1,gr%nspin
if(.not. gr%l_part) then
do iw=1,gr%nums
read(iung) gr%gf(1:gr%nums,iw,is)
enddo
else
do iw=1,gr%nums
read(iung) gr%gf_p(1:gr%nums,iw,is)
enddo
endif
enddo
else
read(iung,*) gr%label
read(iung,*) gr%ontime
read(iung,*) gr%time
read(iung,*) gr%nspin
read(iung,*) gr%nums
read(iung,*) gr%zero_time_neg
read(iung,*) gr%l_part
read(iung,*) gr%factor
!now allocate
if(.not. gr%l_part) then
allocate(gr%gf(gr%nums,gr%nums,gr%nspin))
nullify(gr%gf_p)
else
allocate(gr%gf_p(gr%nums,gr%nums,gr%nspin))
nullify(gr%gf)
endif
do is=1,gr%nspin
if(.not. gr%l_part) then
do iw=1,gr%nums
do jw=1,gr%nums
read(iung,*) gr%gf(jw,iw,is)
enddo
enddo
else
do iw=1,gr%nums
do jw=1,gr%nums
read(iung,*) gr%gf_p(jw,iw,is)
enddo
enddo
endif
enddo
endif
close(iung)
return
END SUBROUTINE read_green
END MODULE green_function