TABLE OF CONTENTS


ABINIT/bsepostproc [ Programs ]

[ Top ] [ Programs ]

NAME

 bsepostproc

FUNCTION

  Utility for post-processing Bethe-Salpeter results

COPYRIGHT

 Copyright (C) 2013-2018 ABINIT group (YG)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  (main program)

OUTPUT

PARENTS

CHILDREN

      abi_io_redirect,close_haydock,continued_fract,destroy_mpi_enreg
      flush_unit,herald,initmpi_seq,open_haydock,read_dim_haydock
      read_haydock,timein,wrtout,xmpi_end,xmpi_init

SOURCE

 29 #if defined HAVE_CONFIG_H
 30 #include "config.h"
 31 #endif
 32 
 33 #include "abi_common.h"
 34 
 35  program bsepostproc
 36 
 37  use defs_basis
 38  use defs_abitypes
 39  use m_build_info
 40  use m_xmpi
 41  use m_haydock_io
 42  use m_numeric_tools
 43 
 44  use m_time,      only : timein
 45  use m_specialmsg,only : specialmsg_getcount, herald
 46  use m_io_tools,  only : get_unit, flush_unit
 47  use m_mpinfo,    only : destroy_mpi_enreg, nullify_mpi_enreg, initmpi_seq
 48 
 49 !This section has been created automatically by the script Abilint (TD).
 50 !Do not modify the following lines by hand.
 51 #undef ABI_FUNC
 52 #define ABI_FUNC 'bsepostproc'
 53 !End of the abilint section
 54 
 55  implicit none
 56 
 57 !Arguments ----------------------------
 58 !Local variables-----------------------
 59 !scalars
 60  integer :: funt
 61  integer :: ios
 62  integer :: niter_file, io, iq
 63  integer :: n_all_omegas, nomega
 64  integer :: term
 65  real(dp) :: broad_in
 66  real(dp) :: omega_min,omega_max,delta_omega
 67  real(dp) :: omegaev
 68  real(dp) :: tcpui,twalli
 69  complex(dpc) :: factor
 70  character(len=50) :: restart_file
 71  character(len=500) :: frm
 72  character(len=24) :: codename
 73  character(len=50) :: output_file
 74  type(haydock_type) :: haydock_file
 75  type(MPI_type) :: mpi_enreg
 76 !arrays
 77  real(dp),allocatable :: tmp_eps(:,:)
 78  real(dp),allocatable :: bb_file(:)
 79  complex(dpc),allocatable :: omega(:),green_temp(:),green(:,:)
 80  complex(dpc),allocatable :: aa_file(:),phi_n_file(:),phi_nm1_file(:)
 81  complex(dpc),allocatable :: all_omegas(:)
 82 
 83 !*******************************************************
 84 
 85 !Change communicator for I/O (mandatory!)
 86  call abi_io_redirect(new_io_comm=xmpi_world)
 87 
 88 !Initialize MPI
 89  call xmpi_init()
 90 
 91  call timein(tcpui,twalli)
 92 
 93 !Default for sequential use
 94  call initmpi_seq(mpi_enreg)
 95 
 96  codename='BSEPOSTPROC'//REPEAT(' ',13)
 97  call herald(codename,abinit_version,std_out)
 98 
 99  write(std_out,'(a)') "Broad_in (eV) ?"
100  read(std_in,*) broad_in
101 
102  write(std_out,'(a)') "Range of frequencies (eV)"
103  read(std_in,*) omega_min, omega_max, delta_omega
104 
105  write(std_out,'(a)') "Terminator ?"
106  read(std_in,*) term
107 
108  write(std_out,'(a)') "Input file ?"
109  read(std_in,*) restart_file
110 
111  write(std_out,'(a)') "Output file ?"
112  read(std_in,*) output_file
113 
114  omega_min = omega_min/Ha_eV
115  omega_max = omega_max/Ha_eV
116  delta_omega = delta_omega/Ha_eV
117 
118  broad_in = broad_in/Ha_eV
119 
120  nomega = (omega_max - omega_min)/delta_omega + 1
121  ABI_MALLOC(omega,(nomega))
122  do io=1,nomega
123    omega(io) = (omega_min + (io-1)*delta_omega)  + j_dpc*broad_in
124  end do
125 
126 !Create new frequencies "mirror" in negative range to add
127 !their contributions. Can be improved by computing only once
128 !zero frequency, but loosing clearness
129  n_all_omegas = 2*nomega
130 
131  ABI_MALLOC(all_omegas,(n_all_omegas))
132 !Put all omegas with frequency > 0 in table
133  all_omegas(nomega+1:n_all_omegas) = omega
134 !Put all omegas with frequency < 0
135 !Warning, the broadening must be kept positive
136  all_omegas(1:nomega) = -DBLE(omega(nomega:1:-1)) &
137 & + j_dpc*AIMAG(omega(nomega:1:-1))
138 
139  ABI_MALLOC(green_temp,(n_all_omegas))
140 
141  call open_haydock(restart_file,haydock_file)
142 
143  call read_dim_haydock(haydock_file)
144 
145  ABI_MALLOC(green,(nomega,haydock_file%nq))
146 
147  do iq = 1, haydock_file%nq
148    call read_haydock(haydock_file,haydock_file%qpoints(:,iq),aa_file,bb_file,phi_nm1_file,phi_n_file, niter_file,factor)
149 
150    call continued_fract(niter_file,term,aa_file,bb_file,n_all_omegas,all_omegas,green_temp)
151 
152 !  Computing result from two ranges of frequencies
153 !  The real part is added, the imaginary part is substracted
154    green(:,iq) = green_temp(nomega+1:n_all_omegas)+CONJG(green_temp(nomega:1:-1))
155 
156    green(:,iq) = cone+factor*green(:,iq)
157 
158  end do
159 
160  call close_haydock(haydock_file)
161 
162  ABI_MALLOC(tmp_eps,(2,haydock_file%nq))
163 
164  funt = get_unit()
165  open(unit=funt,file=output_file,form="formatted",iostat=ios)
166 
167  write(funt,'(a)')"# omega [eV]    RE(eps(q=1)) IM(eps(q=1) RE(eps(q=2) ) ... "
168 !write(frm,*)'(f7.3,',2*BSp%nq,'es12.4)'
169  write(frm,*)'(f7.3,',2*haydock_file%nq,'(1x,f9.4))'
170  do io=1,nomega
171    omegaev = DBLE(omega(io))*Ha_eV
172    tmp_eps(1,:) = REAL (green(io,:))
173    tmp_eps(2,:) = AIMAG(green(io,:))
174 !  where (ABS(tmp_eps) < SMALL) ! this to improve the portability of the automatic tests.
175 !  tmp_eps = zero
176 !  end where
177    write(funt,frm) omegaev,(tmp_eps(:,iq), iq=1,haydock_file%nq)
178  end do
179 
180  ABI_FREE(tmp_eps)
181 
182  close(funt)
183 
184  ABI_FREE(omega)
185  ABI_FREE(all_omegas)
186  ABI_FREE(green_temp)
187 
188  call wrtout(std_out,ch10//" Analysis completed.","COLL")
189 
190  call flush_unit(std_out)
191 
192  call destroy_mpi_enreg(mpi_enreg)
193  call xmpi_end()
194 
195  end program bsepostproc