!!****p* ABINIT/mrgscr
!! NAME
!! mrgscr
!!
!! FUNCTION
!! This code reads partial (SCR|SUSC) files for different q points creating a single file that
!! can be used to perform a sigma calculation.
!!
!! COPYRIGHT
!! Copyright (C) 2005-2022 ABINIT group (RS, MG, MS)
!! This file is distributed under the terms of the
!! GNU General Public License, see ~abinit/COPYING
!! or http://www.gnu.org/copyleft/gpl.txt .
!! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
!!
!! NOTES
!! If the number of SCR files to be merged is equal to 1, the program checks
!! the integrity of the file reporting the list of missing q-points.
!! Note that the list of required q-points depends on the k-mesh
!! used during the calculation of the KSS file. We assume indeed that the same k-mesh
!! is used during the calculation of the matrix elements of sigma.
!!
!! INPUTS
!!  (Main program)
!!
!! OUTPUT
!!  Only checking and writing
!!
!! SOURCE

#if defined HAVE_CONFIG_H
#include "config.h"
#endif

#include "abi_common.h"

program mrgscr

 use defs_basis
 use m_xmpi
 use m_abicore
 use m_build_info
 use m_errors
 use m_nctk
 use netcdf
 use m_hdr
 use m_crystal
 use m_pawrhoij
 use m_dtset

 use defs_abitypes,         only : MPI_type
 use m_specialmsg,          only : herald
 use m_time,                only : timein
 use m_gwdefs,              only : GW_TOLQ, GW_TOLQ0, GW_Q0_DEFAULT
 use m_io_tools,            only : prompt, flush_unit, open_file
 use m_fstrings,            only : int2char4, endswith, itoa, sjoin
 use m_fft_mesh,            only : g2ifft
 use m_fftcore,             only : get_cache_kb, getng
 use m_fft,                 only : fourdp
 use m_numeric_tools,       only : iseven, cspint
 use m_mpinfo,              only : destroy_mpi_enreg, initmpi_seq
 use m_geometry,            only : normv, metric
 use m_gsphere,             only : gsphere_t
 use m_bz_mesh,             only : kmesh_t, find_qmesh
 use m_vcoul,               only : vcoul_t
 use m_ioarr,               only : read_rhor
 use m_io_screening,        only : read_screening, hscr_t, ioscr_qmerge, ioscr_qrecover, ioscr_wmerge, ioscr_wremove
 use m_ppmodel,             only : ppm_init, ppm_free, setup_ppmodel, getem1_from_PPm_one_ggp, &
                                   get_PPm_eigenvalues, ppmodel_t, cqratio
 use m_model_screening,     only : remove_phase
 use m_screening,           only : mkdump_er, em1results_free, em1results_print, decompose_epsm1, &
                                   init_er_from_file, Epsilonm1_results
 use m_wfd,                 only : test_charge

 implicit none

!Local variables-------------------------------
!scalars
 integer,parameter :: master=0,paral_kgb0=0,rdwr2=2,prtvol=0,cplex1=1
 integer :: iomode,fform1,ifile,ierr,ii,ios,iqibz,iqf,nfiles
 integer :: unt_dump,idx,ig1,ig2,iomega,ppmodel,npwe_asked,mqmem,io,unt_dump2
 integer :: id_required,ikxc,approx_type,option_test,dim_kxcg,usexcnhat,usefinegrid
 integer :: mgfft,nqlwl,nfft,igmax,comm,nq_selected,kptopt
 integer :: choice,nfreq_tot,nfreqre,nfreqim,nfreqc,ifrq,imax
 integer :: ig1_start,ig1_end,ig2_start,ig2_end,gmgp_idx,orig_npwe
 real(dp) :: ucvol,boxcutmin,ecut,drude_plsmf,compch_fft,compch_sph
 real(dp) :: nelectron_exp,freqremax,eps_diff,eps_norm,eps_ppm_norm
 real(dp) :: value1,value2,factor,GN_drude_plsmf
 real(dp) :: tcpu,tcpui,twall,twalli
 real(gwp) :: phase
 logical :: is_sus,is_scr,same_freqs,calc_epsilon,only_diag
 character(len=1) :: ans
 character(len=10) :: tagq
 character(len=24) :: codename
 character(len=500) :: msg
 character(len=nctk_slen) :: varname
 character(len=fnlen) :: fname_out,fname,fname_dump,fname_rho,prefix,fname_eigen,fname_dump2
 type(hdr_type) :: hdr_rhor
 type(abifile_t) :: abifile
 type(hscr_t),pointer :: Hscr0
 type(hscr_t),target :: Hscr_merge
 type(MPI_type) :: MPI_enreg
 type(kmesh_t) :: Kmesh,Qmesh
 type(crystal_t) :: Cryst
 type(gsphere_t) :: Gsphere
 type(ppmodel_t) :: PPm
 type(Epsilonm1_results) :: Er
 type(vcoul_t), target :: Vcp
 type(Dataset_type) :: Dtset
!arrays
 integer :: ngfft(18)
 integer,allocatable :: foundq(:),freq_indx(:,:)
 real(dp),parameter :: k0(3) = [zero,zero,zero]
 real(dp) :: gmet(3,3),gprimd(3,3),qdiff(3),rmet(3,3),qtmp(3),tsec(2)
 real(dp),allocatable :: qlwl(:,:),real_omega(:),rhor(:,:),rhog(:,:),nhat(:,:)
 real(dp),allocatable :: work(:),ftab(:),ysp(:,:),eint(:),qratio(:,:)
 complex(gwpc),pointer :: vc_sqrt(:)
 complex(gwpc),allocatable :: epsm1(:,:,:,:),kxcg(:,:)
 complex(dpc),allocatable :: omega(:),em1_ppm(:),epsm1_eigen(:,:),ppm_eigen(:,:),rhoggp(:,:)
 character(len=fnlen),allocatable :: filenames(:)
 type(pawrhoij_type),allocatable :: pawrhoij(:)
 type(hscr_t),target,allocatable :: Hscr_file(:) ! Cannot use allocatable as pathscale5 miscompiles the code

! *************************************************************************

 ! Change communicator for I/O (mandatory!)
 call abi_io_redirect(new_io_comm=xmpi_world)

 ! Initialize MPI
 call xmpi_init()

 ! Initialize memory profiling if it is activated
 ! if a full abimem.mocc report is desired, set the argument of abimem_init to "2" instead of "0"
 ! note that abimem.mocc files can easily be multiple GB in size so don't use this option normally
#ifdef HAVE_MEM_PROFILING
 call abimem_init(0)
#endif

 call timein(tcpui,twalli)

 ! Default for sequential use
 call initmpi_seq(MPI_enreg); comm = MPI_enreg%comm_world

 is_sus=.FALSE.; is_scr=.FALSE.

 ! Write greetings, and read the number of files ===
 codename='MRGSCR'//REPEAT(' ',18)
 call herald(codename,abinit_version,std_out)

 call prompt(' Enter the number of files to merge: ',nfiles)
 ABI_CHECK(nfiles > 0, 'nfiles must be >0')

 ABI_MALLOC(filenames,(nfiles))
 ABI_MALLOC(Hscr_file,(nfiles))

 if (nfiles == 1) then
   call prompt(' Enter the name of the file to be analyzed: ',filenames(1))
   write(msg,'(7a)')ch10,&
    ' Running single-file mode:',ch10,&
    ' Checking the integrity of file: ',TRIM(filenames(1)),ch10,&
    ' reporting the list of q-points that are missing. '
   call wrtout(std_out, msg)

   if (nctk_try_fort_or_ncfile(filenames(1), msg) /= 0) then
     ABI_ERROR(msg)
   end if

 else if (nfiles > 1) then
   ! Read name of files to be merged and check for existence.
   call prompt(' Enter the prefix for the final output file: ',fname_out)

   do ifile=1,nfiles
     write(msg,'(a,i4)')' Enter the name for the partial screening file no.',ifile
     call prompt(msg,filenames(ifile))

     if (nctk_try_fort_or_ncfile(filenames(ifile), msg) /= 0) then
       ABI_ERROR(msg)
     end if

   end do
 end if

 ! Read the header of each file.
 do ifile=1,nfiles
   iomode = IO_MODE_FORTRAN; if (endswith(filenames(ifile), ".nc")) iomode = IO_MODE_ETSF

   call Hscr_file(ifile)%from_file(filenames(ifile), fform1, comm)
   ABI_CHECK(fform1 /= 0, sjoin("fform == 0 in", filenames(ifile)))

   abifile = abifile_from_fform(fform1)
   if (abifile%fform == 0) then
     ABI_ERROR(sjoin("Cannot find any abifile object associated to fform1:", itoa(fform1)))
   end if
   if (abifile%class /= "polariz" .and. abifile%class /= "epsm1") then
     ABI_ERROR(sjoin('Error while reading header, fform= ',itoa(fform1)))
   end if
   is_scr = abifile%class == "epsm1"
   is_sus = abifile%class == "polariz"

   call Hscr_file(ifile)%print(unit=std_out,prtvol=1)

   if (ifile == 1) call metric(gmet,gprimd,-1,rmet,Hscr_file(ifile)%Hdr%rprimd,ucvol)
 end do !ifile

 if (nfiles > 1) then
   ! Put the correct ending on the output file
   if (is_scr) fname_out=TRIM(fname_out)//'_SCR'
   if (is_sus) fname_out=TRIM(fname_out)//'_SUS'
 end if

 ! Produce output file in netcdf format we are merging netcdf files.
 if (iomode == IO_MODE_ETSF .and. .not. endswith(fname_out, ".nc")) fname_out = nctk_ncify(fname_out)

 !============================
 !=== Merge multiple files ===
 !============================
 if (nfiles > 1) then

   ! Check what kind of merging is to be performed
   write(std_out,'(2(a))') ch10,' Do you want to merge q-points        (= 1) ?'
   write(std_out,'(a)')         '  or do you want to merge frequencies (= 2) ?'
   read(std_in,*)choice

   select case(choice)
   case(1)
     write(std_out,'(3a)') ch10,' 1 => merging q-points',ch10
     call ioscr_qmerge(nfiles, filenames, hscr_file, fname_out, hscr_merge)

   case (2)
     ! Merge frequencies
     write(std_out,'(3a)') ch10,' 2 => merging frequency grids',ch10
     !ABI_WARNING("Advanced user option, consistency in fform etc. will not be checked.")

     write(std_out,'(2a)') ch10,' Enter freqremax [eV] for the merged file (Enter 0 to use all freq. found):'
     read(std_in,*)freqremax

     freqremax = freqremax/Ha_eV; if (freqremax<tol16) freqremax = HUGE(freqremax)
     call ioscr_wmerge(nfiles, filenames, hscr_file, freqremax, fname_out, hscr_merge)

   case default
     ABI_ERROR("Invalid choice!")
   end select

 end if ! nfiles>1

 ! Now check if the list of q-points is complete
 ! Here we assume that the k-mesh reported in the header is the same as that used during the sigma calculation.
 write(msg,'(3a)') ch10,' Checking if the list of q-points is complete. ',ch10
 call wrtout(std_out, msg)

 !call hscr_check_qpoints(hscr0)

 Hscr0 => Hscr_file(1)
 fname =filenames(1)
 if (nfiles>1) then
   Hscr0 => Hscr_merge
   fname = fname_out
 end if

 cryst = HScr0%Hdr%get_crystal(remove_inv=.FALSE.)

 kptopt=1
 call Kmesh%init(Cryst,HScr0%Hdr%nkpt,Hscr0%Hdr%kptns,kptopt)
 call Kmesh%print("K-mesh for the wavefunctions",prtvol=prtvol)

 call find_qmesh(Qmesh,Cryst,Kmesh)
 call qmesh%print("Q-mesh for the screening function",prtvol=prtvol)

 ABI_MALLOC(foundq,(Qmesh%nibz))
 foundq(:)=0
 do iqibz=1,Qmesh%nibz
   do iqf=1,Hscr0%nqibz
     qdiff(:)=Qmesh%ibz(:,iqibz)-Hscr0%qibz(:,iqf)
     if (normv(qdiff,gmet,'G')<GW_TOLQ) foundq(iqibz)=foundq(iqibz)+1
   end do
 end do

 if (ANY(foundq==0)) then
   write(msg,'(6a)')ch10,&
    ' File ',TRIM(fname),' is not complete ',ch10,&
    ' The following q-points are missing:'
   call wrtout(std_out, msg)
   ii=0
   do iqibz=1,Qmesh%nibz
     if (foundq(iqibz)==0) then
       ii=ii+1
       write(msg,'(i3,a,3f12.6)')ii,') ',Qmesh%ibz(:,iqibz)
       call wrtout(std_out, msg)
     end if
   end do
 end if

 if (ANY(foundq>1)) then
   write(msg,'(6a)')ch10,&
    ' File ',TRIM(fname),' is overcomplete ',ch10,&
    ' The following q-points are present more than once:'
   call wrtout(std_out, msg)
   ii=0
   do iqibz=1,Qmesh%nibz
     if (foundq(iqibz)>1) then
       ii=ii+1
       write(msg,'(i3,a,3f12.6)')ii,') ',Qmesh%ibz(:,iqibz)
       call wrtout(std_out, msg)
     end if
   end do
 end if

 if (ALL(foundq==1)) then
   write(msg,'(5a)')ch10,&
    '.File ',TRIM(fname),' contains a complete list of q-points ',ch10
   call wrtout(std_out, msg)
 end if

 !=====================
 !=== Recovery mode ===
 !=====================
 if (nfiles==1) then

   write(std_out,'(2(a))') ch10,' Do you want to recover a subset of q-points    (= 1) ?'
   write(std_out,'(a)')         '  or extract the contents of the file           (= 2) ?'
   write(std_out,'(a)')         '  or create dielectric function (SCR file)'
   write(std_out,'(a)')         '    and/or extract plasmon-pole parameters      (= 3) ?'
   write(std_out,'(a)')         '  or remove real frequencies                    (= 4) ?'
   write(std_out,'(a)')         '  or remove imaginary frequencies               (= 5) ?'
   write(std_out,'(a)')         '  or calculate a model screening                (= 6) ?'
   !write(std_out,'(a)')         '  or interpolate the screening in k-space       (= 8) ?'
   !write(std_out,'(a)')         '  or convert a netcd file to Fortran            (= 9) ?'
   read(std_in,*)choice

   select case(choice)
   case(1)
       ! Recover subset of q-points --------------------------------------------------
     write(std_out,'(a)') ' 1 => Recovering subset of q-points'
     call prompt(' Enter the number of q-points to be extracted: ',nq_selected)
     call prompt(' Enter the name of the final output file: ',fname_out)

     if (endswith(filenames(1), ".nc") .and. .not. endswith(fname_out, ".nc")) then
       fname_out = nctk_ncify(fname_out)
       call wrtout(std_out,"- Added .nc extension to output file as input data is in netcdf format.")
     end if

     call ioscr_qrecover(filenames(1), nq_selected, fname_out)

   case(2)
     ! Analyse file ----------------------------------------------------------------
     ABI_CHECK(iomode==IO_MODE_FORTRAN, "netcdf output not coded")

     write(std_out,'(a)') ' 2 => Extraction of file contents'

     ! Initialize the G-sphere.
     call Gsphere%init(Cryst,Hscr0%npwe,gvec=Hscr0%gvec)

     ABI_MALLOC_OR_DIE(epsm1,(Hscr0%npwe,Hscr0%npwe,Hscr0%nomega,1), ierr)

     ! Give option to output epsilon instead of chi0
     calc_epsilon = .FALSE.
     if (is_sus) then
       write(std_out,'(2a)') ch10,' You have provided a chi_0 file for analysis. Would you like to output'
       write(std_out,'(2a)',advance='no') ' the dielectric function epsilon_GG'' ', '= delta_GG'' - v_G*chi0_GG''[Y/N] ? '
       read(std_in,*)ans

       if (ans=='Y'.or.ans=='y') then
         ! Initialise Coulomb terms
         if (Er%Hscr%nqlwl==0) then
           nqlwl=1
           ABI_MALLOC(qlwl,(3,nqlwl))
           qlwl(:,1)= GW_Q0_DEFAULT
         else
           nqlwl=Er%Hscr%nqlwl
           ABI_MALLOC(qlwl,(3,nqlwl))
           qlwl(:,:)=Er%Hscr%qlwl(:,1:nqlwl)
         end if

         Dtset%gw_icutcoul=3; Dtset%rcut=zero
         Dtset%vcutgeo=(/zero,zero,zero/);
         Dtset%boxcenter=(/zero,zero,zero/)

         write(std_out,'(2a)',advance='no') ch10,' Was a Coulomb cutoff technique used [Y/N] ? '
         read(std_in,*)ans
         if (ans=='Y'.or.ans=='y') then
           write(std_out,'(2a)',advance='no') ' Enter gw_icutcoul: '
           read(std_in,*)Dtset%gw_icutcoul
           write(std_out,'(2a)',advance='no') ' Enter vcutgeo: '
           read(std_in,*)Dtset%vcutgeo
           write(std_out,'(2a)',advance='no') ' Enter boxcenter: '
           read(std_in,*)Dtset%boxcenter
         end if
         dtset%ecutsigx = -one

         call Vcp%init(Gsphere,Cryst,Qmesh,Kmesh,Dtset%rcut,Dtset%gw_icutcoul,&
                        Dtset%vcutgeo,Dtset%ecutsigx,Hscr0%npwe,nqlwl,qlwl,comm)
         ABI_FREE(qlwl)

         calc_epsilon = .TRUE.
       end if
     end if

     ig1 = 0; ig2 = 0
     write(std_out,'(2(a),I0,a)',advance='NO') ch10,' Enter the starting index for G (1 - ',Hscr0%npwe,' ): '
     read(std_in,*)ig1_start
     if (ig1_start<1.OR.ig1_start>Hscr0%npwe) then
       ABI_ERROR(' Starting index out of bounds')
     end if
     write(std_out,'(a,I0,a,I0,a)',advance='NO')    ' Enter the ending index for G ( ',ig1_start,' - ',Hscr0%npwe,' ): '
     read(std_in,*)ig1_end
     if (ig1_end<ig1_start.OR.ig1_end>Hscr0%npwe) then
       ABI_ERROR(' Ending index out of bounds')
     end if
     write(std_out,'(a,I0,a)',advance='NO')         ' Enter the starting index for G'' (1 - ',Hscr0%npwe,' ): '
     read(std_in,*)ig2_start
     if (ig2_start<1.OR.ig2_start>Hscr0%npwe) then
       ABI_ERROR(' Starting index out of bounds')
     end if
     write(std_out,'(a,I0,a,I0,a)',advance='NO')    ' Enter the ending index for G'' ( ',ig2_start,' - ',Hscr0%npwe,' ): '
     read(std_in,*)ig2_end
     if (ig2_end<ig2_start.OR.ig2_end>Hscr0%npwe) then
       ABI_ERROR(' Ending index out of bounds')
     end if

     only_diag = .FALSE.
     write(std_out,'(a)',advance='no') ' Would you like to output only the diagonal [Y/N] ? '
     read(std_in,*)ans
     if (ans=='Y'.or.ans=='y') only_diag = .TRUE.

     do iqibz=1,Hscr0%nqibz
       ! In the long wavelength limit we set q==0, because we still can use symmetries for the Body.
       qtmp(:)=Hscr0%qibz(:,iqibz); if (normv(qtmp,Cryst%gmet,'G')<GW_TOLQ0) qtmp(:)=zero

       ! FIXME
       varname = "none"
       call read_screening(varname,fname,Hscr0%npwe,1,Hscr0%nomega,epsm1,iomode,comm,iqiA=iqibz)

       if (calc_epsilon) then ! Calculate epsilon
         do iomega=1,Hscr0%nomega
           if (iqibz==1) then
             if (nqlwl>1) then
               ABI_ERROR('nqlwl>1 not coded yet!')
             end if
             vc_sqrt => Vcp%vcqlwl_sqrt(:,iqibz)  ! Use Coulomb term for q-->0
           else
             vc_sqrt => Vcp%vc_sqrt(:,iqibz)
           end if
           do ig2=ig2_start,ig2_end
             do ig1=ig1_start,ig1_end
               epsm1(ig1,ig2,iomega,1) = -(vc_sqrt(ig1)**2)*epsm1(ig1,ig2,iomega,1)
             end do ! ig1
             epsm1(ig2,ig2,iomega,1) = one + epsm1(ig2,ig2,iomega,1)
           end do ! ig2
         end do ! iomega
       end if ! Do we calculate epsilon

       ! Find out the total number of frequencies along real/imaginary axes
       ! and possibly in the z-plane
       nfreqre=0; nfreqim=0; nfreqc=0;
       do iomega=1,Hscr0%nomega
         if (ABS(REAL(Hscr0%omega(iomega)))<tol8.AND. ABS(AIMAG(Hscr0%omega(iomega)))<tol8) nfreqre = nfreqre + 1
         if (ABS(REAL(Hscr0%omega(iomega)))>tol8.AND. ABS(AIMAG(Hscr0%omega(iomega)))<tol8) nfreqre = nfreqre + 1
         if (ABS(REAL(Hscr0%omega(iomega)))<tol8.AND. ABS(AIMAG(Hscr0%omega(iomega)))>tol8) nfreqim = nfreqim + 1
       end do
       if (Hscr0%nomega-nfreqre-nfreqim/=0) then
         write(std_out,'(/,a)') ' WARNING: There are frequencies in the full complex plane.'
         write(std_out,'(a)')   '          The _SCR or _SUS file might not be suitable'
         write(std_out,'(a,/)') '          for self-energy calculations.'
         nfreqc = Hscr0%nomega-nfreqre-nfreqim
       end if
       write(std_out,'(2a,I0,a)') ch10,' Found ',Hscr0%nomega,' frequencies.'
       write(std_out,'(2(a,I0),2a)') ' ',nfreqre,' real, and ',nfreqim,' imaginary.',ch10
       if (nfreqc>0) then
         write(std_out,'(a,I0)') ' There is a grid in the complex plane with ',nfreqc
         write(std_out,'(2a)')   '  extra frequencies in the list.',ch10
       end if

       ! Get Q index for name
       call int2char4(iqibz,tagq)
       ABI_CHECK((tagq(1:1)/='#'),'Bug: string length too short!')

       if (nfreqre>0) then ! Output real frequency axis
         if (calc_epsilon) then
           fname_dump=TRIM(fname)//'_EPS_Q'//TRIM(tagq)
         else
           fname_dump=TRIM(fname)//'_Q'//TRIM(tagq)
         end if

         if (open_file(fname_dump, msg, newunit=unt_dump, status='replace', form='formatted') /= 0) then
           ABI_ERROR(msg)
         end if

         do ig1=ig1_start,ig1_end
           do ig2=ig2_start,ig2_end
             if (only_diag.AND.ig1/=ig2) CYCLE
             write(unt_dump,'(2(a,i8),/,a,3f12.6,/,a,3i6,a,3i6,/,a,/)')&
             '# ig1= ',ig1,'    ig2= ',ig2,&
             '# q = ',Hscr0%qibz(:,iqibz),&
             '# G = ',Hscr0%gvec(:,ig1),'  G''= ',Hscr0%gvec(:,ig2),&
             '#   omega [eV]           Re             Im '
             do iomega=1,nfreqre
               write(unt_dump,'(f8.2,4x,2es16.8)') REAL(Hscr0%omega(iomega))*Ha_eV,&
                 REAL(epsm1(ig1,ig2,iomega,1)),AIMAG(epsm1(ig1,ig2,iomega,1))
             end do
             write(unt_dump,*)
             write(unt_dump,*)
           end do !ig2
         end do !ig1
         close(unt_dump)
       end if ! Output real frequency axis

       if (nfreqim>0) then ! output imaginary frequency axis
         if (calc_epsilon) then
           fname_dump=TRIM(fname)//'_EPS_Imfrq_Q'//TRIM(tagq)
         else
           fname_dump=TRIM(fname)//'_Imfrq_Q'//TRIM(tagq)
         end if
         if (open_file(fname_dump,msg,newunit=unt_dump,status='replace',form='formatted') /= 0) then
           ABI_ERROR(msg)
         end if
         do ig1=ig1_start,ig1_end
           do ig2=ig2_start,ig2_end
             if (only_diag.AND.ig1/=ig2) CYCLE
             write(unt_dump,'(a,i4,2(a,i8),/,a,3f12.6,/,a,3i6,a,3i6,/,a,/)')&
               '# index= ',idx,'    ig1= ',ig1,'    ig2= ',ig2,&
               '# q = ',Hscr0%qibz(:,iqibz),&
               '# G = ',Hscr0%gvec(:,ig1),'  G''= ',Hscr0%gvec(:,ig2),&
               '#   omega [eV]           Re             Im '
             do iomega=nfreqre+1,nfreqre+nfreqim
               write(unt_dump,'(f8.2,4x,2es16.8)') AIMAG(Hscr0%omega(iomega))*Ha_eV,epsm1(ig1,ig2,iomega,1)
             end do
             write(unt_dump,*)
             write(unt_dump,*)
           end do !ig2
         end do !ig1
         close(unt_dump)
       end if ! Check for imaginary frequencies

       ! Check for complex plane values
       if (nfreqc>0) then
         if (calc_epsilon) then
           fname_dump=TRIM(fname)//'_EPS_ZPLANE_Q'//TRIM(tagq)
         else
           fname_dump=TRIM(fname)//'_ZPLANE_Q'//TRIM(tagq)
         end if

         if (open_file(fname_dump,msg,newunit=unt_dump,status='replace',form='formatted') /= 0) then
           ABI_ERROR(msg)
         end if

         do ig1=ig1_start,ig1_end
           do ig2=ig2_start,ig2_end
             if (only_diag.AND.ig1/=ig2) CYCLE
             write(unt_dump,'(a,i4,2(a,i8),/,a,3f12.6,/,a,3i6,a,3i6,/,a,/)')&
              '# index= ',idx,'    ig1= ',ig1,'    ig2= ',ig2,&
              '# q = ',Hscr0%qibz(:,iqibz),&
              '# G = ',Hscr0%gvec(:,ig1),'  G''= ',Hscr0%gvec(:,ig2),&
              '#   omega [eV]           Re             Im '
             do iomega=1,nfreqre
               write(unt_dump,'(2(f8.2),4x,2es16.8)') REAL(Hscr0%omega(iomega))*Ha_eV,&
                 AIMAG(Hscr0%omega(iomega))*Ha_eV,epsm1(ig1,ig2,iomega,1)
             end do
             write(unt_dump,*)
             do ios=1,nfreqim
               do iomega=1,nfreqre
                 if (iomega==1) then
                   io = nfreqre + ios
                 else
                   io = nfreqre + nfreqim + (ios-1)*(nfreqre-1) + (iomega-1)
                 end if
                 write(unt_dump,'(2(f8.2),4x,2es16.8)') REAL(Hscr0%omega(io))*Ha_eV,&
                   AIMAG(Hscr0%omega(io))*Ha_eV,epsm1(ig1,ig2,io,1)
               end do
               write(unt_dump,*)
             end do
             write(unt_dump,*)
             write(unt_dump,*)
           end do !ig2
         end do !ig1
         close(unt_dump)
       end if ! Check for complex plane freqs

     end do !iqibz

     ABI_FREE(epsm1)
     call Gsphere%free()

   case(3)
       ! Extract dielectric function and plasmon-pole stuff --------------------------
     ABI_CHECK(iomode==IO_MODE_FORTRAN, "netcdf output not coded")
     write(std_out,'(a)') ' 3 => Calculation of dielectric function and plasmon-pole model'

     npwe_asked=Hscr0%npwe; mqmem=Hscr0%nqibz
     call init_Er_from_file(Er,fname,mqmem,npwe_asked,comm)

     ! Initialize the G-sphere ===
     call Gsphere%init(Cryst,Hscr0%npwe,gvec=Hscr0%gvec)

     boxcutmin=two; igmax=Gsphere%shlim(Gsphere%nsh)
     ecut=Er%Hscr%Hdr%ecutdg

     call getng(boxcutmin,1,ecut,Gsphere%gmet,k0,MPI_enreg%me_fft,&
       mgfft,nfft,ngfft,MPI_enreg%nproc_fft,Cryst%nsym,paral_kgb0,Cryst%symrel,Cryst%tnons)

     ! I am using standard valued, it would be better to call indefo
     ! ngfft(1:3)=Er%Hscr%Hdr%ngfft(1:3)
     ngfft(7)=112
     ngfft(8)=get_cache_kb()
     nfft = PRODUCT(ngfft(1:3))

     Dtset%gw_icutcoul=3; Dtset%rcut=zero
     Dtset%vcutgeo=(/zero,zero,zero/); Dtset%boxcenter=(/zero,zero,zero/)
     Dtset%ecutsigx = -1

     if (Er%Hscr%nqlwl==0) then
       nqlwl=1
       ABI_MALLOC(qlwl,(3,nqlwl))
       qlwl(:,1)= GW_Q0_DEFAULT
     else
       nqlwl=Er%Hscr%nqlwl
       ABI_MALLOC(qlwl,(3,nqlwl))
       qlwl(:,:)=Er%Hscr%qlwl(:,1:nqlwl)
     end if

     call Vcp%init(Gsphere,Cryst,Qmesh,Kmesh,Dtset%rcut,Dtset%gw_icutcoul,Dtset%vcutgeo,Dtset%ecutsigx,&
                  Hscr0%npwe,nqlwl,qlwl,comm)
     ABI_FREE(qlwl)

     ! Get the density from an external file ===
     ! If meshes are not the same, do an FFT interpolation to have rhor on ngfft.
     call prompt(' Enter name for external DEN (or PAWDEN) file: ', fname_rho)

     ABI_MALLOC(rhor,(nfft,Hscr0%Hdr%nspden))
     ABI_MALLOC(pawrhoij,(Hscr0%Hdr%natom*Hscr0%Hdr%usepaw))

     call read_rhor(fname_rho, cplex1, nfft, Hscr0%Hdr%nspden, ngfft, 1, MPI_enreg, rhor, hdr_rhor, pawrhoij, comm)

     call hdr_rhor%free()
     call pawrhoij_free(pawrhoij)
     ABI_FREE(pawrhoij)

     ABI_MALLOC(rhog,(2,nfft))
     call fourdp(1,rhog,rhor(:,1),-1,MPI_enreg,nfft,1,ngfft,0)

     ABI_MALLOC(nhat,(nfft,Hscr0%Hdr%nspden*Hscr0%Hdr%usepaw))
     compch_sph=greatest_real; compch_fft=greatest_real
     usexcnhat=0; usefinegrid=0

     nelectron_exp = Hscr0%Hdr%nelect

     call test_charge(nfft,nelectron_exp,Hscr0%Hdr%nspden,rhor,Cryst%ucvol,&
       Hscr0%Hdr%usepaw,usexcnhat,usefinegrid,compch_sph,compch_fft,drude_plsmf)
     GN_drude_plsmf = drude_plsmf

     ! Read and in case make Epsilon^{-1} according the the options specified
     id_required=4; ikxc=0; approx_type=0; option_test=0; dim_kxcg=0
     ABI_MALLOC(kxcg,(nfft,dim_kxcg))

     call prompt(' Enter prefix for output files: ',prefix)
     fname_dump=TRIM(prefix)//'_SCR'

     orig_npwe = Er%npwe
     write(std_out,'(2a,I0)') ch10,' Number of plane waves is: ',Er%npwe
     write(std_out,'(a)',advance='no') ' Would you like to change it [Y/N] ?'
     read(std_in,*) ans
     if (ans=='Y'.or.ans=='y') then
       write(std_out,'(a)',advance='no') ' Enter new no. of plane waves (0 means use old value): '
       read(std_in,*) ii
       if (ii>0.or.ii<=Er%npwe) Er%npwe = ii
       if (ii<0.or.ii>Er%npwe) then
         ABI_ERROR(' Wrong value for no. of plane waves!')
       end if
     end if

     if (is_scr) Er%mqmem=1
     if (is_sus) Er%mqmem=0
     call mkdump_Er(Er,Vcp,Er%npwe,Gsphere%gvec,dim_kxcg,kxcg,id_required,approx_type,ikxc,option_test,&
       fname_dump,iomode,nfft,ngfft,comm)
     Er%mqmem=1

     call em1results_print(Er)

     write(std_out,'(2a)',advance='no') ch10,&
     ' Would you like to calculate the eigenvalues of eps^{-1}_GG''(omega) [Y/N] ? '
     read(std_in,*) ans

     if (ans=='Y'.or.ans=='y') then
       ABI_MALLOC(epsm1_eigen,(Er%npwe,Er%nomega))
       imax = 10
       if (Er%npwe < imax) imax = Er%npwe
       do iqibz=1,Er%nqibz
         call int2char4(iqibz,tagq)
         ABI_CHECK((tagq(1:1)/='#'),'Bug: string length too short!')
         fname_eigen=TRIM(prefix)//'_EM1_EIG_Q'//TRIM(tagq)
         if (open_file(fname_eigen,msg,newunit=unt_dump,status='replace',form='formatted') /= 0) then
           ABI_ERROR(msg)
         end if
         call decompose_epsm1(Er,iqibz,epsm1_eigen)
         write(unt_dump,'(a)')       '# First (max 10) eigenvalues of eps^{-1}(omega)'
         write(unt_dump,'(a,3f12.6)')'# q = ',Hscr0%qibz(:,iqibz)
         write(unt_dump,'(a)')       '# REAL omega [eV]  REAL(eigen(esp^-1(1,w)))  AIMAG(eigen(esp^-1(1,w))  ...'
         do iomega=1,Er%nomega_r
           write(unt_dump,'(21(es16.8))')REAL(Er%omega(iomega))*Ha_eV,&
             (REAL(epsm1_eigen(ii,iomega)),ii=1,imax),(AIMAG(epsm1_eigen(ii,iomega)),ii=1,imax)
         end do
         close(unt_dump)
       end do
       ABI_FREE(epsm1_eigen)
       ABI_FREE(kxcg)
     end if ! Calculate eigenvalues

     ! Analyze the PPmodel.
     write(std_out,'(2a)') ch10,' Would you like to analyse plasmon-pole models [Y/N] ? '
     read(std_in,*)ans

     if (ans=='Y'.or.ans=='y') then
       write(std_out,'(2a,f6.2,a)') ch10,' Plasma frequency for GN PPM is: ',GN_drude_plsmf*Ha_eV, ' eV'
       write(std_out,'(a)',advance='no') ' Would you like to change it [Y/N] ?'
       read(std_in,*) ans
       if (ans=='Y'.or.ans=='y') then
         write(std_out,'(2a)',advance='no') ch10,' Enter plasma frequency [eV]: '
         read(std_in,*) GN_drude_plsmf
         GN_drude_plsmf = GN_drude_plsmf/Ha_eV
       end if

       write(std_out,'(2a)') ch10,' Would you like to calculate the plasmon-pole model'
       write(std_out,'(a)',advance='no')       '        eigenvalues of eps^{-1}_GG''(omega) [Y/N] ? '
       read(std_in,*) ans

       if (ans=='Y'.or.ans=='y') then
         ABI_MALLOC(ppm_eigen,(PPm%npwc,Er%nomega))
         imax = 10; if (Er%npwe < imax) imax = Er%npwe
         do iqibz=1,Er%nqibz
           do ppmodel=1,2

             call int2char4(iqibz,tagq)
             ABI_CHECK((tagq(1:1)/='#'),'Bug: string length too short!')
             if (ppmodel==1) fname_dump=TRIM(prefix)//'_PPM_GN_EM1_EIG_Q'//TRIM(tagq)
             if (ppmodel==2) fname_dump=TRIM(prefix)//'_PPM_HL_EM1_EIG_Q'//TRIM(tagq)
             if (ppmodel==3) fname_dump=TRIM(prefix)//'_PPM_vdLH_EM1_EIG_Q'//TRIM(tagq)
             if (ppmodel==4) fname_dump=TRIM(prefix)//'_PPM_EF_EM1_EIG_Q'//TRIM(tagq)

             if (open_file(fname_eigen,msg,newunit=unt_dump,status='new',form='formatted') /= 0) then
               ABI_ERROR(msg)
             end if

             call ppm_free(PPm)
             if (ppmodel==1) then
               call ppm_init(PPm,Er%mqmem,Er%nqibz,Er%npwe,ppmodel,GN_drude_plsmf,Dtset%gw_invalid_freq)
             else
               call ppm_init(PPm,Er%mqmem,Er%nqibz,Er%npwe,ppmodel,drude_plsmf,Dtset%gw_invalid_freq)
             end if
             call setup_ppmodel(PPm,Cryst,Qmesh,Er%npwe,Er%nomega,Er%omega,Er%epsm1,nfft,Gsphere%gvec,ngfft,rhor(:,1),iqibz)

             call get_PPm_eigenvalues(PPm,iqibz,Er%Hscr%zcut,Er%nomega,Er%omega,Vcp,ppm_eigen)

             write(unt_dump,'(a)')       '# First (max 10) eigenvalues of eps^{-1}(omega) from Plasmon-pole model'
             write(unt_dump,'(a,3f12.6)')'# q = ',Hscr0%qibz(:,iqibz)
             select case(ppmodel)
             case(1)
               write(unt_dump,'(a)')     '# ppmodel = 1 : Godby - Needs'
             case(2)
               write(unt_dump,'(a)')     '# ppmodel = 2 : Hybertsen - Louie'
             case(3)
               write(unt_dump,'(a)')     '# ppmodel = 3 : von der Linden - Horsch'
             case(4)
               write(unt_dump,'(a)')     '# ppmodel = 4 : Engel - Farid'
             end select
             write(unt_dump,'(a)')       '# REAL omega [eV]  REAL(eigen(ppm_eps^-1(1,w)))  AIMAG(eigen(ppm_eps^-1(1,w))  ...'
             do iomega=1,Er%nomega_r
               write(unt_dump,'(21(es16.8))')REAL(Er%omega(iomega))*Ha_eV,&
                 (REAL(ppm_eigen(ii,iomega)),ii=1,imax),(AIMAG(ppm_eigen(ii,iomega)),ii=1,imax)
             end do
             close(unt_dump)

           end do !ppmodel
         end do ! iqibz
         ABI_FREE(ppm_eigen)
       end if ! Calculate PPM eigenvalues

       ! Optionally output eps^{-1}_GG''(w) for a given set of GG' and gridpoints
       write(std_out,'(2a)',advance='no') ch10,' Would you like to extract eps^{-1}_GG''(omega) for the PPM [Y/N] ?'
       read(std_in,*) ans

       if (ans=='Y'.or.ans=='y') then
         ! Reconstruct e^{-1}_GG'(w) according to PPmodel for statistical analysis.
         write(std_out,'(a)') ' Enter the number of frequency points in the'
         write(std_out,'(a)') '  interval 0 - freqremax (0 means same as input file ): '
         read(std_in,*) nfreqre
         if (nfreqre==0) then
           nfreqre   = Er%nomega_r
           nfreqim   = Er%nomega_i
           nfreq_tot = Er%nomega
           freqremax = REAL(Er%omega(Er%nomega_r))
           ABI_MALLOC(omega,(nfreq_tot))
           omega(:) = Er%omega(:)
           same_freqs = .TRUE.
         else
           write(std_out,'(a)') ' Enter the value of freqremax (in eV): '
           read(std_in,*) freqremax
           nfreqim   = Er%nomega_i
           nfreq_tot = nfreqre+nfreqim
           ABI_MALLOC(omega,(nfreqre+Er%nomega_i))
           do iomega=1,nfreqre
             omega(iomega) =  CMPLX((freqremax/REAL((nfreqre-1)))*(iomega-1),zero)
           end do
           omega(nfreqre+1:nfreq_tot) = Er%omega(Er%nomega_r+1:Er%nomega)
           same_freqs = .FALSE.
         end if ! frequencies

         do iqibz=1,Er%nqibz
           qtmp(:)=Er%qibz(:,iqibz); if (normv(qtmp,Cryst%gmet,'G')<GW_TOLQ0) qtmp(:)=zero
           call int2char4(iqibz,tagq)
           ABI_CHECK((tagq(1:1)/='#'),'Bug: string length too short!')

           ! At this time only the Godby-Needs and Hybertsen-Louie models
           ! TODO: Check the results from the others
           do ppmodel=1,2

             call ppm_free(PPm)
             if (ppmodel==1) then
               call ppm_init(PPm,Er%mqmem,Er%nqibz,Er%npwe,ppmodel,GN_drude_plsmf,Dtset%gw_invalid_freq)
             else
               call ppm_init(PPm,Er%mqmem,Er%nqibz,Er%npwe,ppmodel,drude_plsmf,Dtset%gw_invalid_freq)
             end if
             call setup_ppmodel(PPm,Cryst,Qmesh,Er%npwe,Er%nomega,Er%omega,Er%epsm1,&
               nfft,Gsphere%gvec,ngfft,rhor(:,1),iqibz)

             ! Prepare file for data on real omega axis
             if (ppmodel==1) fname_dump=TRIM(prefix)//'_PPM_w_GN_Q'//TRIM(tagq)
             if (ppmodel==2) fname_dump=TRIM(prefix)//'_PPM_w_HL_Q'//TRIM(tagq)
             if (ppmodel==3) fname_dump=TRIM(prefix)//'_PPM_w_vdLH_Q'//TRIM(tagq)
             if (ppmodel==4) fname_dump=TRIM(prefix)//'_PPM_w_EF_Q'//TRIM(tagq)

             if (open_file(fname_dump,msg,newunit=unt_dump,status='replace',form='formatted') /= 0) then
               ABI_ERROR(msg)
             end if

             ! Prepare file for data on imaginary omega axis
             if (ppmodel==1) fname_dump2=TRIM(prefix)//'_PPM_iw_GN_Q'//TRIM(tagq)
             if (ppmodel==2) fname_dump2=TRIM(prefix)//'_PPM_iw_HL_Q'//TRIM(tagq)
             if (ppmodel==3) fname_dump2=TRIM(prefix)//'_PPM_iw_vdLH_Q'//TRIM(tagq)
             if (ppmodel==4) fname_dump2=TRIM(prefix)//'_PPM_iw_EF_Q'//TRIM(tagq)

             if (open_file(fname_dump2,msg,newunit=unt_dump2,status='replace',form='formatted') /= 0) then
               ABI_ERROR(msg)
             end if

             ABI_MALLOC(em1_ppm,(nfreq_tot))

             ig1 = 0; ig2 = 0
             write(std_out,'(3a,I0,a,I0)') ch10,' Enter indices for G and G''.',&
               'Entering 0 exits the loop. iqibz = ',iqibz,' ppmodel = ',ppmodel

             do
               write(std_out,'(2(a),I0,a)',advance='NO') ch10,' Enter index for G (1 - ',Er%npwe,' ): '
               read(std_in,*)ig1
               if (ig1==0) EXIT
               if (ig1<0.OR.ig1>Er%npwe) ABI_ERROR(' index out of bounds')
               write(std_out,'(2(a),I0,a)',advance='NO') ch10,' Enter index for G'' (1 - ',Er%npwe,' ): '
               read(std_in,*)ig2
               if (ig2==0) EXIT
               if (ig2<0.OR.ig2>Er%npwe) ABI_ERROR(' index out of bounds')

               ! Generate the PPM representation of epsilon^-1
               call getem1_from_PPm_one_ggp(PPm,iqibz,Er%Hscr%zcut,nfreq_tot,omega,Vcp,em1_ppm,ig1,ig2)

               write(unt_dump,'(a,I1)') '# epsilon^-1_GG''(omega) from ppmodel = ',ppmodel
               write(unt_dump,'(2(a,i8),/,a,3f12.6,/,a,3i6,a,3i6,/,a,3F9.4,a,3F9.4,a,/a,f9.4,a,f9.4,a,/,a,/)')&
                 '# ig1= ',ig1,'    ig2= ',ig2,&
                 '# q = ',Er%qibz(:,iqibz),&
                 '# G = ',Er%gvec(:,ig1),'  G''= ',Er%gvec(:,ig2),&
                 '# G = (',MATMUL(two_pi*Cryst%gmet,Er%gvec(:,ig1)),&
                 ')  G''= (',MATMUL(two_pi*Cryst%gmet,Er%gvec(:,ig2)),')',&
                 '# 1/2|G|^2 =',half*normv(Er%gvec(:,ig1),Cryst%gmet,'G')**2,&
                 ' Ha 1/2|G''|^2 =',half*normv(Er%gvec(:,ig2),Cryst%gmet,'G')**2,' Ha',&
                 '#   omega [eV]           Re             Im '
               write(unt_dump2,'(a,I1)') '# epsilon^-1_GG''(iomega) from ppmodel = ',ppmodel
               write(unt_dump2,'(2(a,i8),/,a,3f12.6,/,a,3i6,a,3i6,/,a,3F9.4,a,3F9.4,a,/a,f9.4,a,f9.4,a,/,a,/)')&
                 '# ig1= ',ig1,'    ig2= ',ig2,&
                 '# q = ',Er%qibz(:,iqibz),&
                 '# G = ',Er%gvec(:,ig1),'  G''= ',Er%gvec(:,ig2),&
                 '# G = (',MATMUL(two_pi*Cryst%gmet,Er%gvec(:,ig1)),&
                 ')  G''= (',MATMUL(two_pi*Cryst%gmet,Er%gvec(:,ig2)),')',&
                 '# 1/2|G|^2 =',half*normv(Er%gvec(:,ig1),Cryst%gmet,'G')**2,&
                 ' Ha 1/2|G''|^2 =',half*normv(Er%gvec(:,ig2),Cryst%gmet,'G')**2,' Ha',&
                 '#   iomega [eV]           Re             Im '

               do iomega=1,nfreqre
                 if (same_freqs) then
                   write(unt_dump,'(f8.2,4x,4es16.8)') REAL(omega(iomega))*Ha_eV,em1_ppm(iomega),&
                     Er%epsm1(ig1,ig2,iomega,iqibz)
                 else
                   write(unt_dump,'(f8.2,4x,2es16.8)') REAL(omega(iomega))*Ha_eV,em1_ppm(iomega)
                 end if
               end do
               ! First output the iomega = 0 point
               write(unt_dump2,'(f8.2,4x,4es16.8)') AIMAG(omega(1))*Ha_eV,em1_ppm(1),&
                 Er%epsm1(ig1,ig2,1,iqibz)
               ! Then the rest
               do iomega=nfreqre+1,nfreq_tot
                 write(unt_dump2,'(f8.2,4x,4es16.8)') AIMAG(omega(iomega))*Ha_eV,em1_ppm(iomega),&
                   Er%epsm1(ig1,ig2,iomega,iqibz)
               end do
               write(unt_dump,*)
               write(unt_dump,*)
               write(unt_dump2,*)
               write(unt_dump2,*)
             end do ! Empty
             ABI_FREE(em1_ppm)
             close(unt_dump)
             close(unt_dump2)

           end do ! ppmodel
         end do ! iqibz
         ABI_FREE(omega)
       end if ! Output epsilon for PPM

       ! Optionally statistics for all PPMs
       write(std_out,'(2a)',advance='no') ch10,' Would you like to output statistics for all PPMs [Y/N] ?'
       read(std_in,*) ans

       if (ans=='Y'.or.ans=='y') then
         nfreqre   = Er%nomega_r
         nfreq_tot = Er%nomega
         freqremax = REAL(Er%omega(Er%nomega_r))
         ABI_MALLOC(real_omega,(nfreqre))
         real_omega(:) = REAL(Er%omega(1:nfreqre))

         do iqibz=1,Er%nqibz
           do ppmodel=1,2

             qtmp(:)=Er%qibz(:,iqibz)
             if (normv(qtmp,Cryst%gmet,'G')<GW_TOLQ0) qtmp(:)=zero

             call ppm_free(PPm)
             if (ppmodel==1) then
               call ppm_init(PPm,Er%mqmem,Er%nqibz,Er%npwe,ppmodel,GN_drude_plsmf,Dtset%gw_invalid_freq)
             else
               call ppm_init(PPm,Er%mqmem,Er%nqibz,Er%npwe,ppmodel,drude_plsmf,Dtset%gw_invalid_freq)
             end if
             call setup_ppmodel(PPm,Cryst,Qmesh,Er%npwe,Er%nomega,Er%omega,Er%epsm1,&
             nfft,Gsphere%gvec,ngfft,rhor(:,1),iqibz)

             ! Prepare ratios and density for the f-sum rule
             ABI_MALLOC_OR_DIE(qratio,(orig_npwe,orig_npwe), ierr)
             ABI_MALLOC_OR_DIE(rhoggp,(Er%npwe,Er%npwe), ierr)

             call cqratio(orig_npwe,Gsphere%gvec,qtmp,Cryst%gmet,Cryst%gprimd,qratio)
             ! Arrange n(G-G')->n(G,G')
             ierr=0
             do ig1=1,Er%npwe
               do ig2=1,Er%npwe
                 gmgp_idx = g2ifft(Gsphere%gvec(:,ig1)-Gsphere%gvec(:,ig2),ngfft)
                 if (gmgp_idx/=0) then
                   rhoggp(ig1,ig2)=CMPLX(rhog(1,gmgp_idx),rhog(2,gmgp_idx))
                 else
                   ierr=ierr+1
                   rhoggp(ig1,ig2)=czero
                 end if
               end do
             end do
             if (ierr/=0) then
               write(std_out,'(a,i0,a)')' Found ',ierr,' G1-G2 vectors falling outside the FFT box. '
             end if

             ! Prepare files
             call int2char4(iqibz,tagq)
             ABI_CHECK((tagq(1:1)/='#'),'Bug: string length too short!')
             if (ppmodel==1) fname_dump=TRIM(prefix)//'_norms_GN_Q'//TRIM(tagq)
             if (ppmodel==2) fname_dump=TRIM(prefix)//'_norms_HL_Q'//TRIM(tagq)
             if (open_file(fname_dump,msg, newunit=unt_dump, status='replace',form='formatted') /= 0) then
               ABI_ERROR(msg)
             end if
             write(unt_dump,'(a)') '# Various norms integrated through spline interpolation'
             write(unt_dump,'(a)') '# over all frequencies in the input file,'
             write(unt_dump,'(a)') '# for all G and G'' vectors.'
             write(unt_dump,'(a,I0)') '#               ppmodel: ',ppmodel
             write(unt_dump,'(a,I0)') '# Number of frequencies: ',nfreqre
             write(unt_dump,'(a,f12.6)') '# Maximum frequency    : ',freqremax
             write(unt_dump,'(a)') '# Columns:'
             write(unt_dump,'(2a)') '#  ig1      ig2   |eps-eps_PPM|/|eps|',&
               '   |eps-eps_PPM|    |eps|     |eps_PPM|            G                  G'''
             if (ppmodel==1) fname_dump2=TRIM(prefix)//'_f_sumrule_GN_Q'//TRIM(tagq)
             if (ppmodel==2) fname_dump2=TRIM(prefix)//'_f_sumrule_HL_Q'//TRIM(tagq)

             if (open_file(fname_dump2,msg,newunit=unt_dump2,status='replace',form='formatted') /= 0) then
               ABI_ERROR(msg)
             end if

             write(unt_dump2,'(a)') '# The fulfillment of the f-sum rule: I(epsilon) ='
             write(unt_dump2,'(a)') '#   int_0^{inf}{omega*Im[epsilon_G,G''(omega)]}/C_qGG'''
             write(unt_dump2,'(a)') '# C_qGG'' = '
             write(unt_dump2,'(a)') '#   -Pi/2*omega_p^2*(q+G)*(q+G'')/|q+G|^2*n(G-G'')/n(0)'
             write(unt_dump2,'(a)') '# for all G and G'' vectors.'
             write(unt_dump2,'(a,I0)') '#               ppmodel: ',ppmodel
             write(unt_dump2,'(a,I0)') '# Number of frequencies: ',nfreqre
             write(unt_dump2,'(a,f12.6)') '# Maximum frequency    : ',freqremax
             write(unt_dump2,'(a)') '# Columns:'
             write(unt_dump2,'(3a)') '#  ig1      ig2   I(epsilon)',&
               '   I(eps_PPM)   Re[n(G-G'')]    Im[n(G-G'')]    qratio      I1*C_qGG''',&
               ' Re[Omegatwsq] Im[Omegatwsq]   Re[omegatw]   Im[omegatw]    |G|    1/2|G|^2'

             ABI_MALLOC(em1_ppm,(nfreq_tot))
             ABI_MALLOC(ftab,(nfreqre))
             ABI_MALLOC(ysp,(3,nfreqre))
             ABI_MALLOC(work,(nfreqre))
             ABI_MALLOC(eint,(nfreqre))

             do ig1=1,Er%npwe
               write(std_out,'(2(a,I0))') ' ig1= ',ig1, ' of ',Er%npwe
               do ig2=1,Er%npwe
                 !ig2 = ig1
                 call getem1_from_PPm_one_ggp(PPm,iqibz,Er%Hscr%zcut,nfreq_tot,Er%omega,Vcp,em1_ppm,ig1,ig2)

                 ! Calculate norms in real
                 eps_diff=0; eps_norm=0; eps_ppm_norm=0
                 ftab(1:nfreqre) = ABS(Er%epsm1(ig1,ig2,1:nfreqre,iqibz)-em1_ppm(1:nfreqre))
                 call cspint(ftab,real_omega,nfreqre,real_omega(1),real_omega(nfreqre),ysp,eint,work,eps_diff)
                 ftab(1:nfreqre) = ABS(Er%epsm1(ig1,ig2,1:nfreqre,iqibz))
                 call cspint(ftab,real_omega,nfreqre,real_omega(1),real_omega(nfreqre),ysp,eint,work,eps_norm)
                 ftab(1:nfreqre) = ABS(em1_ppm(1:nfreqre))
                 call cspint(ftab,real_omega,nfreqre,real_omega(1),real_omega(nfreqre),ysp,eint,work,eps_ppm_norm)
                 write(unt_dump,'(2i6,f12.4,3es14.4,6i4)') ig1,ig2,eps_diff/eps_norm,eps_diff,&
                   eps_norm,eps_ppm_norm,Er%gvec(:,ig1),Er%gvec(:,ig2)

                 ! Evaluate the f-sum rule
                 if (ig1==ig2) then
                   ftab(1:nfreqre) = real_omega(1:nfreqre)*AIMAG(Er%epsm1(ig1,ig2,1:nfreqre,iqibz))
                 else
                   ! Dephase first - HERE epsm1 is changed!
                   call remove_phase(epsm1(ig1,ig2,:,1),Hscr_file(1)%nomega,phase)
                   ftab(1:nfreqre) = real_omega(1:nfreqre)*AIMAG(Er%epsm1(ig1,ig2,1:nfreqre,iqibz))
                 end if

                 call cspint(ftab,real_omega,nfreqre,real_omega(1),&
                   real_omega(nfreqre),ysp,eint,work,eps_diff)

                 if (ig1==ig2) then
                   factor = -two*pi*pi*REAL(rhoggp(ig1,ig2))*qratio(ig1,ig2)
                 else
                   rhoggp(ig1,ig2) = CMPLX(COS(phase),-SIN(phase))*rhoggp(ig1,ig2)
                   factor = -two*pi*pi*REAL(rhoggp(ig1,ig2))*qratio(ig1,ig2)
                 end if

                 if (ABS(qratio(ig1,ig2))>zero) then
                   value1 = eps_diff/factor
                   if (ppmodel==1) then
                     value2 = -pi*half*(REAL(PPm%bigomegatwsq(iqibz)%vals(ig1,ig2))&
                       /(REAL(PPm%omegatw(iqibz)%vals(ig1,ig2))))&
                       /factor*(2*sqrt(pi*rhoggp(1,1)))
                   else
                     value2 = -pi*half*(SQRT(REAL(PPm%bigomegatwsq(iqibz)%vals(ig1,ig2))))&
                      /factor*(2*sqrt(pi*rhoggp(1,1)))
                   end if
                 else
                   value1 = zero
                   value2 = zero
                 end if

                 write(unt_dump2,'(2i6,12es14.4)') ig1,ig2,value1,value2,&
                   REAL(rhoggp(ig1,ig2)),AIMAG(rhoggp(ig1,ig2)),qratio(ig1,ig2),&
                   eps_diff,REAL(PPm%bigomegatwsq(iqibz)%vals(ig1,ig2)),&
                   AIMAG(PPm%bigomegatwsq(iqibz)%vals(ig1,ig2)),&
                   REAL(PPm%omegatw(iqibz)%vals(ig1,ig2)),&
                   AIMAG(PPm%omegatw(iqibz)%vals(ig1,ig2)),&
                   normv(Er%gvec(:,ig1),Cryst%gmet,'G'),&
                   half*normv(Er%gvec(:,ig1),Cryst%gmet,'G')**2

               end do !ig2
             end do !ig1

             ABI_FREE(em1_ppm)
             ABI_FREE(ftab)
             ABI_FREE(ysp)
             ABI_FREE(work)
             ABI_FREE(eint)
             ABI_FREE(qratio)
             ABI_FREE(rhoggp)
             close(unt_dump); close(unt_dump2)

           end do ! ppmodel
         end do ! iqibz

         ABI_FREE(real_omega)
       end if ! Output statistics

       call ppm_free(PPm)
     end if ! If ppmodel>0

     ABI_FREE(rhor)
     ABI_FREE(rhog)
     ABI_FREE(nhat)

     call Vcp%free()
     call em1results_free(Er)
     call Gsphere%free()

   case(4)
     ! Remove real frequencies ----------------------------------------------------------
     write(std_out,'(2(a))') ch10,' Do you want to remove every other real frequency  (= 1) ?'
     write(std_out,'(a)')         '  or specify for each real frequency individually  (= 2) ?'
     write(std_out,'(a)')         '  or remove ALL real frequencies                   (= 3) ?'
     read(std_in,*)choice

     ! Calculate the total number of real freq
     nfreqre = 0; nfreqim = 0
     do ifrq=1,Hscr_file(1)%nomega
       ! If frequency is not imaginary, count.
       if (AIMAG(Hscr_file(1)%omega(ifrq)) < tol8) nfreqre = nfreqre + 1
       if (REAL(Hscr_file(1)%omega(ifrq)) < tol8 .and. AIMAG(Hscr_file(1)%omega(ifrq))>tol8)  nfreqim = nfreqim + 1
     end do

     nfreq_tot = nfreqre + nfreqim ! Here nfreq_tot becomes the *true* number of freq
     write(std_out,'(2a,I0,a)') ch10,' Found ',nfreq_tot,' frequencies.'
     write(std_out,'(2(a,I0),2a)') ' ',nfreqre,' real, and ',nfreqim,' imaginary.',ch10

     ! Array with the index of frequencies to be kept.
     ABI_MALLOC(freq_indx,(nfreq_tot,1))
     freq_indx = 0

     select case(choice)
     case(1)
       ! Remove every other frequency
       write(std_out,'(2(a))') ch10,' Removing every other real frequency, i.e. every even one.'
       write(std_out,'(a)')         ' If the total number of frequencies is odd, the first and last one will be kept.'
       write(std_out,'(a)')         ' If the total number is even, the first one will still be in the final set.'

       ! Test for no real frequencies
       ABI_CHECK(nfreqre /= 0, "No real frequencies in file!")

       ii=nfreqre; nfreqre = 0
       do ifrq=1,ii
         if (.not. iseven(ifrq)) then
           nfreqre = nfreqre + 1; freq_indx(nfreqre,1) = ifrq
         end if
       end do
       write(std_out,'(2a,I0,a)') ch10,' ',nfreqre,' real frequencies will be kept.'

     case(2)
       ! Specify freq. individually
       ii = nfreqre; nfreqre = 0
       do ifrq=1,ii
         write(std_out,'(a,f12.6,a)') ' Would you like to keep freq. at: ',REAL(Hscr_file(1)%omega(ifrq))*Ha_eV,' eV? [y/n]'
         read(std_in,*) ans
         if (ans=='Y'.or.ans=='y') then
           nfreqre = nfreqre + 1; freq_indx(nfreqre,1) = ifrq
         end if
       end do
       write(std_out,'(2a,I0,a)') ch10,' ',nfreqre,' real frequencies will be kept.'

     case(3)
       ! Remove all real freq.
       nfreqre = 0

     case default
       ABI_ERROR("Invalid choice!")
     end select

     ! Add imaginary frequencies if any
     if (nfreqim > 0) then
       nfreqim = 0
       do ifrq=1,Hscr_file(1)%nomega
         if (AIMAG(Hscr_file(1)%omega(ifrq)) > tol8) then
           nfreqim = nfreqim + 1; freq_indx(nfreqre+nfreqim,1) = ifrq
         end if
       end do
     end if

     nfreq_tot = nfreqre + nfreqim ! Here nfreq_tot becomes the *true* number of freq
     write(std_out,'(3(a,i0),a)')' Finally, we have ',nfreq_tot,' frequencies. ',nfreqre,' real, and ',nfreqim,' imaginary.'

     call prompt(' Enter the full name of the final output file: ', fname_out)

     if (endswith(filenames(1), ".nc") .and. .not. endswith(fname_out, ".nc")) then
       fname_out = nctk_ncify(fname_out)
       call wrtout(std_out,"- Added .nc extension to output file as input data is in netcdf format.")
     end if

     call ioscr_wremove(filenames(1), hscr_file(1), fname_out, nfreq_tot, freq_indx, hscr_merge)
     ABI_FREE(freq_indx)

   case(5)
     ! Remove imaginary frequencies ------------------------------------------------

     ! Calculate the total number of freq
     nfreqre = 0; nfreqim = 0
     do ifrq=1,Hscr_file(1)%nomega
         ! If frequency is not imaginary, count.
       if (AIMAG(Hscr_file(1)%omega(ifrq))<tol8) nfreqre = nfreqre + 1
       if (REAL(Hscr_file(1)%omega(ifrq))<tol8.and.AIMAG(Hscr_file(1)%omega(ifrq))>tol8)  nfreqim = nfreqim + 1
     end do ! ifrq

     ! Test for no real frequencies
     if (nfreqim == 0) then
       ABI_ERROR("No imaginary frequencies in file!")
     end if

     nfreq_tot = nfreqre + nfreqim ! Here nfreq_tot becomes the *true* number of freq
     write(std_out,'(2a,I0,a)') ch10,' Found ',nfreq_tot,' frequencies.'
     write(std_out,'(2(a,I0),2a)') ' ',nfreqre,' real, and ',nfreqim,' imaginary.',ch10

     ABI_MALLOC(freq_indx,(nfreq_tot,1))
     freq_indx = 0

     ! Specify freq. individually
     ii=nfreq_tot; nfreqim = 0
     do ifrq=nfreqre+1,ii
       write(std_out,'(a,f12.6,a)')&
        ' Would you like to keep imaginary freq. at: ',AIMAG(Hscr_file(1)%omega(ifrq))*Ha_eV,' eV? [y/n]'
       read(std_in,*) ans
       if (ans=='Y'.or.ans=='y') then
         nfreqim = nfreqim + 1; freq_indx(nfreqre+nfreqim,1) = ifrq
       end if
     end do ! ifrq
     write(std_out,'(2a,I0,a)') ch10,' ',nfreqim,' imaginary frequencies will be kept.'

     ! Add real frequencies if any
     if (nfreqre > 0) then
       nfreqre = 0
       do ifrq=1,Hscr_file(1)%nomega
         if (AIMAG(Hscr_file(1)%omega(ifrq)) < tol8) then
           nfreqre = nfreqre + 1; freq_indx(nfreqre,1) = ifrq
         end if
       end do
     end if

     nfreq_tot = nfreqre + nfreqim ! Here nfreq_tot becomes the *true* number of freq
     write(std_out,'(2a,I0,a)') ch10,' Finally, we have ',nfreq_tot,' frequencies.'
     write(std_out,'(2(a,I0),2a)') ' ',nfreqre,' real, and ',nfreqim,' imaginary.',ch10

     call prompt(' Enter the full name of the final output file: ',fname_out)

     if (endswith(filenames(1), ".nc") .and. .not. endswith(fname_out, ".nc")) then
       fname_out = nctk_ncify(fname_out)
       call wrtout(std_out,"- Added .nc extension to output file as input data is in netcdf format.")
     end if

     call ioscr_wremove(filenames(1), hscr_file(1), fname_out, nfreq_tot, freq_indx, hscr_merge)

     ABI_FREE(freq_indx)

   case(6)
     ! Model screening -------------------------------------------------------------
     ABI_ERROR("Model screening has been removed")

   !case(9)
   !  TODO
   !  ! netcdf --> Fortran converter -------------------------------------------------------------
   !  call prompt(' Enter the name of the final output Fortran file: ',fname_out)
   !  ! fname_out extension should be consistent with filenames(1)
   !  call ioscr_nc2fort(filenames(1), fname_out)

   case default
     ! Bail if choice is wrong
     write(std_out,*) ' Invalid choice! Exiting...'
     goto 100
   end select

 end if ! Single file mode

 call timein(tcpu,twall)

 tsec(1)=tcpu-tcpui
 tsec(2)=twall-twalli

 write(std_out, '(a,a,a,f13.1,a,f13.1)' )  '-',ch10,'- Proc.   0 individual time (sec): cpu=',tsec(1),'  wall=',tsec(2)

 ! =====================
 ! ==== Free memory ====
 ! =====================
 ABI_FREE(filenames)
 ABI_SFREE(kxcg)
 ABI_SFREE(foundq)

 call cryst%free()
 call Kmesh%free()
 call Qmesh%free()
 call destroy_mpi_enreg(MPI_enreg)

 nullify(Hscr0)
 call Hscr_merge%free()

 do ifile=1,nfiles
   call Hscr_file(ifile)%free()
 end do
 ABI_FREE(Hscr_file)

 call flush_unit(std_out)

 call abinit_doctor("__mrgscr")

 100 call xmpi_end()

 end program mrgscr
!!***
