!=================================================================================
!
! Module read_matrix
!
! (1) read_matrix_d()           Originally by JRD       Last Modified 5/1/2008 (JRD)
!
! This program reads a distributed matrix like chimat or epsmat to file.
!
! (2) read_matrix_f()           Originally by JRD       Last Modified 9/10/2010 (gsm)
!
! Modification of read_matrix_d for full-frequency.
!
!=================================================================================

#include "f_defs.h"

module read_matrix_m

  use global_m
  use scalapack_m
  use epsread_hdf5_m
#ifdef HDF5
  use hdf5
#endif

  implicit none
  
  private

  public :: &
    read_matrix_d, &
    read_matrix_d_hdf5, &
    read_matrix_f, &
    read_matrix_f_hdf5


contains

subroutine read_matrix_d(scal,matrix,nmtx,iunit)
  type (scalapack), intent(in) :: scal
  SCALAR, intent(out) :: matrix(:,:) !< (scal%npr,scal%npc)
  integer, intent(in) :: nmtx
  integer, intent(in) :: iunit

  PUSH_SUB(read_matrix_d)

  call read_matrix_d_(scal,matrix,nmtx,iunit=iunit)

  POP_SUB(read_matrix_d)

end subroutine read_matrix_d


subroutine read_matrix_d_hdf5(scal,matrix,nmtx,fname,iq,is)
  type (scalapack), intent(in) :: scal
  SCALAR, intent(out) :: matrix(:,:) !< (scal%npr,scal%npc)
  integer, intent(in) :: nmtx
  character(len=*), intent(in) :: fname
  integer, intent(in) :: iq
  integer, intent(in) :: is

  PUSH_SUB(read_matrix_d_hdf5)

  call read_matrix_d_(scal,matrix,nmtx,fname=fname,iq=iq,is=is)

  POP_SUB(read_matrix_d_hdf5)

end subroutine read_matrix_d_hdf5


subroutine read_matrix_d_(scal,matrix,nmtx,iunit,fname,iq,is)
  type (scalapack), intent(in) :: scal
  SCALAR, intent(out) :: matrix(:,:) !< (scal%npr,scal%npc)
  integer, intent(in) :: nmtx
  integer, intent(in), optional :: iunit
  character(len=*), intent(in), optional :: fname
  integer, intent(in), optional :: iq
  integer, intent(in), optional :: is
  
  integer :: ii, jj
  
#ifdef USESCALAPACK
  SCALAR, allocatable :: tempcol(:)
  integer :: irow, icol, irowm, icolm
  integer :: icurr
#endif
  logical :: use_hdf5
  
  PUSH_SUB(read_matrix_d_)

  if (.not.present(iunit).and..not.(present(fname).and.present(iq))) then
    call die("Not enough arguments to read_matrix_d_", only_root_writes=.true.)
  endif
  if (present(iunit).and.(present(fname).or.present(iq))) then
    call die("Too many arguments to read_matrix_d_", only_root_writes=.true.)
  endif
  if ((present(fname).or.present(iq)).and..not.(present(fname).and.present(iq))) then
    call die("Inconsistent arguments to read_matrix_d_", only_root_writes=.true.)
  endif
  use_hdf5 = present(fname).and.present(iq)
#ifndef HDF5
  if (use_hdf5) then
    call die("read_matrix_d_ was not compiled with HDF5 support.", only_root_writes=.true.)
  endif
#endif

#ifdef VERBOSE
  if(peinf%inode .eq. 0) then
    if (use_hdf5) then
      write(6,*) ' Reading matrix: ', nmtx, fname
    else
      write(6,*) ' Reading matrix: ', nmtx, iunit
    endif
    write(6,*)
  endif
#endif
  
#ifdef USESCALAPACK
  
  SAFE_ALLOCATE(tempcol, (nmtx))
  
  icurr=0
  
  do jj = 1, nmtx

!        if (peinf%inode .eq. 0) then
!          write(6,*) ' In loop: ', ii
!        endif

    if (peinf%inode .eq. 0) then
      if (use_hdf5) then
#ifdef HDF5
        call read_eps_matrix_col_hdf5(tempcol,jj,nmtx,iq,is,fname)
#endif
      else
        read(iunit) (tempcol(ii),ii=1,nmtx)
      endif

    endif
    
    call MPI_BCAST(tempcol,nmtx,MPI_SCALAR,0, &
      MPI_COMM_WORLD,mpierr)
    
    icol=MOD(INT(((jj-1)/scal%nbl)+TOL_SMALL),scal%npcol)
    if (icol .eq. scal%mypcol) then
      do ii = 1, nmtx
        irow=MOD(INT(((ii-1)/scal%nbl)+TOL_SMALL),scal%nprow)
        if (irow .eq. scal%myprow) then
          icurr=icurr+1
          icolm=INT((icurr-1)/scal%npr+TOL_SMALL)+1
          irowm=MOD((icurr-1),scal%npr)+1
          matrix(irowm,icolm)=tempcol(ii)
        endif
      enddo
    endif
    
    call MPI_barrier(MPI_COMM_WORLD,mpierr)
    
  enddo
  
  SAFE_DEALLOCATE(tempcol)
  
#else
  
  if(peinf%inode .eq. 0) then
    do jj = 1, nmtx
      if (use_hdf5) then
#ifdef HDF5
        call read_eps_matrix_col_hdf5(matrix(:,jj),jj,nmtx,iq,is,fname)
#endif
      else
        read(iunit) (matrix(ii, jj), ii = 1, nmtx)
      endif
    enddo
  endif
  
#endif
  
  POP_SUB(read_matrix_d_)
  
  return
end subroutine read_matrix_d_


!=================================================================================


subroutine read_matrix_f(scal,nfreq,nfreq_para,retarded,advanced,nmtx,para_freqs,iunit)
  type(scalapack), intent(in) :: scal
  integer, intent(in) :: nfreq
  integer, intent(in) :: nfreq_para
  complex(DPC), intent(out) :: retarded(:,:,:) !< (nfreq_para,scal%npr,scal%npc)
#ifdef CPLX
  complex(DPC), intent(out) &
#else
  complex(DPC), intent(in)  &  ! no value is assigned if not CPLX
#endif
    :: advanced(nfreq_para,scal%npr,scal%npc)
  integer, intent(in) :: nmtx
  integer, intent(in) :: para_freqs
  integer, intent(in) :: iunit

  PUSH_SUB(read_matrix_f)

  call read_matrix_f_(scal,nfreq,nfreq_para,retarded,advanced,nmtx,para_freqs,iunit=iunit)

  POP_SUB(read_matrix_f)

end subroutine read_matrix_f


subroutine read_matrix_f_hdf5(scal,nfreq,nfreq_para,retarded,advanced,nmtx,para_freqs,fname,iq,is)
  type(scalapack), intent(in) :: scal
  integer, intent(in) :: nfreq
  integer, intent(in) :: nfreq_para
  complex(DPC), intent(out) :: retarded(:,:,:) !< (nfreq_para,scal%npr,scal%npc)
#ifdef CPLX
  complex(DPC), intent(out) &
#else
  complex(DPC), intent(in)  &  ! no value is assigned if not CPLX
#endif
    :: advanced(nfreq_para,scal%npr,scal%npc)
  integer, intent(in) :: nmtx
  integer, intent(in) :: para_freqs
  character(len=*), intent(in) :: fname
  integer, intent(in) :: iq
  integer, intent(in) :: is

  PUSH_SUB(read_matrix_f_hdf5)

  call read_matrix_f_(scal,nfreq,nfreq_para,retarded,advanced,nmtx,para_freqs,fname=fname,iq=iq,is=is)

  POP_SUB(read_matrix_f_hdf5)

end subroutine read_matrix_f_hdf5


subroutine read_matrix_f_(scal,nfreq,nfreq_para,retarded,advanced,nmtx,para_freqs,iunit,fname,iq,is)
  type(scalapack), intent(in) :: scal
  integer, intent(in) :: nfreq
  integer, intent(in) :: nfreq_para
  complex(DPC), intent(out) :: retarded(:,:,:) !< (nfreq_para,scal%npr,scal%npc)
#ifdef CPLX
  complex(DPC), intent(out) &
#else
  complex(DPC), intent(in)  &  ! no value is assigned if not CPLX
#endif
    :: advanced(nfreq_para,scal%npr,scal%npc)
  integer, intent(in) :: nmtx
  integer, intent(in) :: para_freqs
  integer, intent(in), optional :: iunit
  character(len=*), intent(in), optional :: fname
  integer, intent(in), optional :: iq
  integer, intent(in), optional :: is

  integer :: ii, jj, ifreq,ifreq_para,freq_grp_ind
#ifdef USESCALAPACK
  complex(DPC), allocatable :: tempcolR(:,:)
  complex(DPC), allocatable :: tempcolA(:,:)
  integer :: irow, icol, irowm, icolm
  integer :: icurr
#endif
  logical :: use_hdf5

  PUSH_SUB(read_matrix_f_)

  if (.not.present(iunit).and..not.(present(fname).and.present(iq))) then
    call die("Not enough arguments to read_matrix_f_", only_root_writes=.true.)
  endif
  if (present(iunit).and.(present(fname).or.present(iq))) then
    call die("Too many arguments to read_matrix_f_", only_root_writes=.true.)
  endif
  if ((present(fname).or.present(iq)).and..not.(present(fname).and.present(iq))) then
    call die("Inconsistent arguments to read_matrix_f_", only_root_writes=.true.)
  endif
  use_hdf5 = present(fname).and.present(iq)
#ifndef HDF5
  if (use_hdf5) then
    call die("read_matrix_f_ was not compiled with HDF5 support.", only_root_writes=.true.)
  endif
#endif
  
#ifdef VERBOSE
  if(peinf%inode .eq. 0) then
    if (use_hdf5) then
      write(6,*) ' Reading matrix: ', nmtx, fname
    else
      write(6,*) ' Reading matrix: ', nmtx, iunit
    endif
    write(6,*)
  endif
#endif
  
#ifdef USESCALAPACK
  
  SAFE_ALLOCATE(tempcolR, (nfreq,nmtx))
#ifdef CPLX
  SAFE_ALLOCATE(tempcolA, (nfreq,nmtx))
#endif
  
  icurr=0
  
  do jj = 1, nmtx

!        if (peinf%inode .eq. 0) then
!          write(6,*) ' In loop: ', i
!        endif

    if (peinf%inode .eq. 0) then
      if (use_hdf5) then
#ifdef HDF5
        call read_eps_matrix_col_f_hdf5(tempcolR,&
#ifdef CPLX
          tempcolA,&
#endif
          nfreq,jj,nmtx,iq,is,fname)
#endif
      else
        do ii = 1, nmtx
          read(iunit) (tempcolR(ifreq,ii),ifreq=1,nfreq)
        enddo
#ifdef CPLX
        do ii = 1, nmtx
          read(iunit) (tempcolA(ifreq,ii),ifreq=1,nfreq)
        enddo
#endif
      endif
    endif
    
    call MPI_BCAST(tempcolR,nfreq*nmtx,MPI_COMPLEX_DPC,0, &
      MPI_COMM_WORLD,mpierr)
#ifdef CPLX
    call MPI_BCAST(tempcolA,nfreq*nmtx,MPI_COMPLEX_DPC,0, &
      MPI_COMM_WORLD,mpierr)
#endif
    
    icol=MOD(INT(((jj-1)/scal%nbl)+TOL_SMALL),scal%npcol)
    if (icol .eq. scal%mypcol) then
      do ii = 1, nmtx
        irow=MOD(INT(((ii-1)/scal%nbl)+TOL_SMALL),scal%nprow)
        if (irow .eq. scal%myprow) then
          icurr=icurr+1
          icolm=INT((icurr-1)/scal%npr+TOL_SMALL)+1
          irowm=MOD((icurr-1),scal%npr)+1
          retarded(:,irowm,icolm)=tempcolR(:,ii)
#ifdef CPLX
          advanced(:,irowm,icolm)=tempcolA(:,ii)
#endif
          do ifreq=1,nfreq
            freq_grp_ind=mod(ifreq-1,para_freqs)
            ifreq_para=1+floor(-TOL_Small+dble(ifreq)/para_freqs)
            if(freq_grp_ind .eq. peinf%rank_mtxel) then
              retarded(ifreq_para,irowm,icolm)=tempcolR(ifreq,ii)
#ifdef CPLX
              advanced(ifreq_para,irowm,icolm)=tempcolA(ifreq,ii)
#endif
            endif
          enddo

        endif
      enddo
    endif
    
    call MPI_barrier(MPI_COMM_WORLD,mpierr)
    
  enddo
  
  SAFE_DEALLOCATE(tempcolR)
#ifdef CPLX
  SAFE_DEALLOCATE(tempcolA)
#endif
  
#else
  
  if(peinf%inode .eq. 0) then
    do jj = 1, nmtx
      if (use_hdf5) then
#ifdef HDF5
        call read_eps_matrix_col_f_hdf5(retarded(:,:,jj),&
#ifdef CPLX
          advanced(:,:,jj),&
#endif
          nfreq,jj,nmtx,iq,is,fname)
#endif
      else
        do ii = 1, nmtx
          read(iunit) (retarded(ifreq, ii, jj), ifreq = 1, nfreq)
        enddo
#ifdef CPLX
        do ii = 1, nmtx
          read(iunit) (advanced(ifreq, ii, jj), ifreq = 1, nfreq)
        enddo
#endif
      endif
    enddo
  endif
  
#endif
  
  POP_SUB(read_matrix_f_)
  
  return
end subroutine read_matrix_f_

end module read_matrix_m
