mirror of https://gitlab.com/QEF/q-e.git
350 lines
9.4 KiB
Fortran
350 lines
9.4 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 .
|
|
!
|
|
!
|
|
|
|
|
|
!this is the main part of the GWW program
|
|
|
|
PROGRAM gww
|
|
|
|
USE input_gw, ONLY : input_options, read_input_gww
|
|
USE io_global, ONLY : stdout, ionode
|
|
USE self_energy_storage
|
|
USE expansion
|
|
USE energies_gww
|
|
USE start_end
|
|
USE mp_world, ONLY : mpime, world_comm
|
|
USE para_gww
|
|
USE times_gw
|
|
USE w_divergence
|
|
USE mp, ONLY : mp_barrier
|
|
USE contour
|
|
USE io_files, ONLY : prefix, tmp_dir
|
|
|
|
implicit none
|
|
|
|
TYPE(input_options) :: options
|
|
TYPE(self_storage) :: ss
|
|
TYPE(self_expansion) :: se
|
|
TYPE(self_on_real) :: sr
|
|
TYPE(quasi_particles) :: qp
|
|
TYPE(times_freqs) :: tf
|
|
TYPE(gv_time) :: gt
|
|
TYPE(w_expectation) :: we
|
|
TYPE(w_poles) :: wp
|
|
|
|
INTEGER :: ispin
|
|
CHARACTER(5) :: name_proc
|
|
INTEGER :: ie
|
|
REAL(kind=DP) :: energy
|
|
|
|
#ifdef __OPENMP
|
|
INTEGER :: omp_get_num_threads, omp_get_max_threads
|
|
EXTERNAL omp_set_num_threads, omp_get_num_threads, omp_get_max_threads
|
|
#endif
|
|
|
|
tmp_dir=''
|
|
|
|
!setup MPI environment
|
|
|
|
call startup
|
|
|
|
!CALL remove_stack_limit ( )
|
|
|
|
#ifdef __OPENMP
|
|
ntids=omp_get_max_threads()
|
|
! call omp_set_num_threads(1)
|
|
#endif
|
|
|
|
|
|
|
|
#ifdef __OPENMP
|
|
write(stdout,*) 'ntids = ', ntids
|
|
#endif
|
|
|
|
|
|
|
|
!initialize arrays
|
|
call initialize_quasi_particle(qp)
|
|
|
|
|
|
! read in input structure
|
|
|
|
call read_input_gww(options)
|
|
#ifdef __MPI
|
|
if(options%l_verbose) then
|
|
write(name_proc,'(5i1)') &
|
|
& (mpime+1)/10000,mod(mpime+1,10000)/1000,mod(mpime+1,1000)/100,mod(mpime+1,100)/10,mod(mpime+1,10)
|
|
OPEN( UNIT = stdout, FILE = trim(tmp_dir)//trim(prefix)//'-out_'//name_proc, STATUS = 'UNKNOWN' )
|
|
endif
|
|
#endif
|
|
|
|
FLUSH(stdout)
|
|
if(options%grid_freq/=5.and.options%grid_freq/=6) then
|
|
call setup_para_gww(options%n, options%max_i, options%i_min, options%i_max)
|
|
else
|
|
call setup_para_gww(options%n+(1+2*options%second_grid_i)*options%second_grid_n, options%max_i, options%i_min, options%i_max)
|
|
endif
|
|
FLUSH(stdout)
|
|
! setup time/frequency grid if required
|
|
call setup_timefreq(tf,options)
|
|
|
|
!Step 0
|
|
!calculates the exchange energies
|
|
|
|
|
|
|
|
if(options%starting_point <=1) then
|
|
call go_exchange_main( options, qp)
|
|
call write_quasi_particles(qp, options,.false.)
|
|
else
|
|
call read_quasi_particles(qp,options,.false.)
|
|
endif
|
|
|
|
|
|
!Step 1
|
|
!create the Green function G_0 in imaginary time and save on file
|
|
!it also calculates here the exchage energies
|
|
|
|
|
|
if(options%starting_point <= 1 .and. options%ending_point >= 1) then
|
|
if(.not.options%lpola_file .and. .not. options%lvcprim_file) then
|
|
call go_green(tf,options, qp)
|
|
endif
|
|
endif
|
|
|
|
|
|
|
|
!Step 2
|
|
!create the polarization in imaginary time and save on file
|
|
|
|
|
|
!loop on spin
|
|
|
|
do ispin=1,options%nspin
|
|
|
|
if(options%starting_point <= 2 .and. options%ending_point >=2 ) then
|
|
if(options%l_t_wannier) then
|
|
call calculate_compact_pola_lanczos(options,ispin)
|
|
endif
|
|
|
|
endif
|
|
|
|
if(options%starting_point <= 3 .and. options%ending_point >= 3 ) then
|
|
write(stdout,*) "*******************************"
|
|
write(stdout,*) " RESTART FROM POINT 3"
|
|
write(stdout,*) "*******************************"
|
|
!Step 3
|
|
!FFT of polarization to imaginary frequency and save on file
|
|
|
|
|
|
call do_polarization_lanczos(tf,options,ispin)
|
|
|
|
endif
|
|
enddo
|
|
|
|
if(options%starting_point<=4 .and. options%ending_point >= 4) then
|
|
|
|
|
|
!Step 3.1
|
|
!calculate dresses interaction W, and save on file
|
|
|
|
|
|
|
|
write(stdout,*) 'Call go_dressed_w'
|
|
|
|
|
|
call go_dressed_w(options)
|
|
|
|
|
|
|
|
call write_quasi_particles(qp,options,.false.)
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
|
!Step 3.2
|
|
!FFT of W to imaginary time and save on file
|
|
if(options%starting_point<=5 .and. options%ending_point >= 5) then
|
|
|
|
|
|
|
|
call read_quasi_particles(qp,options,.false.)
|
|
|
|
if(.not. options%l_self_lanczos) then
|
|
write(stdout,*) 'Call FFT'
|
|
call go_fft_para2(tf, options)
|
|
!if required do fft of gt structure
|
|
if(options%w_divergence==2) then
|
|
write(stdout,*) 'Go fft gt'
|
|
call initialize_gv_time(gt)
|
|
write(stdout,*) 'Go fft gt 1'
|
|
call read_gv_time(gt)
|
|
write(stdout,*) 'Go fft gt 1.5'
|
|
call fft_gv_time(gt,tf)
|
|
write(stdout,*) 'Go fft gt2'
|
|
call write_gv_time(gt)
|
|
write(stdout,*) 'Go fft gt3'
|
|
call free_memory_gv_time(gt)
|
|
endif
|
|
else
|
|
call do_reducible_pola(tf ,options)
|
|
|
|
endif
|
|
endif
|
|
|
|
|
|
if(options%starting_point <= 6 .and. options%ending_point >= 6) then
|
|
!Step 4
|
|
write(stdout,*) '*******************************'
|
|
write(stdout,*) ' RESTART FROM POINT 6'
|
|
write(stdout,*) '*******************************'
|
|
|
|
|
|
if(options%n_real_axis>0) then
|
|
call initialize_w_expectation(we)
|
|
call create_w_expectation(we, tf, options)
|
|
call write_w_expectation(we)
|
|
call free_memory_w_expectation(we)
|
|
endif
|
|
|
|
|
|
if(.not. options%l_self_lanczos) then
|
|
!calculate the expectation value of Sigma in imaginary time and save on file
|
|
call create_self_ontime(tf, ss,options,qp)
|
|
|
|
if(options%lconduction.and. .not.options%lvcprim_file .and. .not.options%l_self_beta) then
|
|
if(.not.options%lcprim_file) then
|
|
call addconduction_self_ontime(ss, options)
|
|
else
|
|
call addconduction_self_ontime_file(ss, tf, options)
|
|
endif
|
|
endif
|
|
if(options%l_self_upper) then
|
|
call selfenergy_ontime_upper(ss, tf ,options)
|
|
endif
|
|
|
|
if(options%debug) call write_storage(tf,ss)
|
|
|
|
if(options%l_fft_timefreq) then
|
|
call fft_storage(ss)
|
|
else
|
|
if(tf%grid_fit==0) then
|
|
call fft_storage_grid(tf,ss)
|
|
else
|
|
call fft_storage_grid_fit(tf, ss)
|
|
endif
|
|
endif
|
|
if(options%debug) call write_storage(tf,ss)
|
|
call write_self_storage_ondisk(ss, options)
|
|
else
|
|
!lanczos calculation of self-energy
|
|
if(options%n_real_axis==0) then
|
|
if(.not.options%l_self_time) then
|
|
call do_self_lanczos(ss, tf ,options)
|
|
else
|
|
if(.not.options%l_full) then
|
|
call do_self_lanczos_time(ss, tf ,options,.false.,0.d0)
|
|
else
|
|
call do_self_lanczos_full(ss, tf ,options,.false.,0.d0)
|
|
endif
|
|
call fft_storage_grid_fit(tf, ss)
|
|
endif
|
|
call write_self_storage_ondisk(ss, options)
|
|
else
|
|
call do_self_on_real(options,tf,ss,sr)
|
|
call write_self_on_real(sr,0)
|
|
call free_memory_self_on_real(sr)
|
|
endif
|
|
call write_self_storage_ondisk(ss, options)
|
|
endif
|
|
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
|
|
if(options%starting_point <= 7 .and. options%ending_point >= 7) then
|
|
!Step 7
|
|
! fit self_energy with a multipole expansion
|
|
call read_self_storage_ondisk(ss, options)
|
|
call create_self_energy_fit( tf, se, ss, options,sr,.false.)
|
|
call mp_barrier( world_comm )
|
|
call print_fit_onfile(tf, se,ss)
|
|
call mp_barrier( world_comm )
|
|
call free_memory_self_storage(ss)
|
|
call mp_barrier( world_comm )
|
|
call create_quasi_particles(options,qp,se)
|
|
call mp_barrier( world_comm )
|
|
call write_self_expansion(se)
|
|
call free_memory_self_expansion(se)
|
|
call mp_barrier( world_comm )
|
|
call printout_quasi_particles(qp)
|
|
endif
|
|
|
|
|
|
if(options%starting_point <= 8 .and. options%ending_point >= 8) then
|
|
!if the whole self_energy matrix has been calculate do use it for obtaining QPEs and QPAs
|
|
if(options%whole_s) then
|
|
call initialize_self_expansion(se)
|
|
call read_self_expansion(se)
|
|
|
|
call create_quasi_particles_off(options,qp,se)
|
|
|
|
call printout_quasi_particles_off(qp)
|
|
call free_memory_self_expansion(se)
|
|
endif
|
|
endif
|
|
|
|
if(options%starting_point <= 9 .and. options%ending_point >= 9) then
|
|
!here does analytic continuation for contour integration
|
|
call initialize_w_expectation(we)
|
|
call initialize_w_poles(wp)
|
|
call read_w_expectation(we)
|
|
call create_w_poles(we,wp,options)
|
|
call write_w_poles(wp)
|
|
call free_memory_w_expectation(we)
|
|
call free_memory_w_poles(wp)
|
|
endif
|
|
|
|
if(options%starting_point <= 10 .and. options%ending_point >= 10) then
|
|
!adds poles
|
|
call initialize_w_poles(wp)
|
|
call initialize_self_on_real(sr)
|
|
call read_w_poles(wp)
|
|
call read_self_on_real(sr,0)
|
|
!call self_on_real_print(sr)
|
|
!NOT_TO_BE_INCLUDED_START
|
|
call do_contour(sr,wp,options)
|
|
!NOT_TO_BE_INCLUDED_END
|
|
call write_self_on_real(sr,1)
|
|
call self_on_real_print(sr)
|
|
call free_memory_w_poles(wp)
|
|
call free_memory_self_on_real(sr)
|
|
endif
|
|
if(options%starting_point <= 11 .and. options%ending_point >= 11) then
|
|
call initialize_self_on_real(sr)
|
|
call read_self_on_real(sr,1)
|
|
call create_quasi_particle_on_real(options,qp,sr)
|
|
call printout_quasi_particles(qp)
|
|
call free_memory_self_on_real(sr)
|
|
endif
|
|
!stops MPI
|
|
call free_memory_times_freqs(tf)
|
|
call free_memory_para_gww
|
|
|
|
call stop_run
|
|
|
|
stop
|
|
END PROGRAM gww
|
|
|