!{\src2tex{textfont=tt}}
!!****m* ABINIT/m_numeric_tools
!! NAME
!!  m_numeric_tools
!!
!! FUNCTION
!!  This module contains basic tools for numeric computations.
!!
!! COPYRIGHT
!! Copyright (C) 2008-2016 ABINIT group (MG, GMR, MJV, XG, MVeithen)
!! This file is distributed under the terms of the
!! GNU General Public License, see ~abinit/COPYING
!! or http://www.gnu.org/copyleft/gpl.txt .
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

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

#include "abi_common.h"

MODULE m_numeric_tools

 use defs_basis
 use m_errors
 use m_profiling_abi
 use m_linalg_interfaces

 implicit none

 private 

 public :: arth                  ! Return an arithmetic progression
 public :: geop                  ! Return a geometric progression
 public :: reverse               ! Reverse a 1D array *IN PLACE*
 public :: set2unit              ! Set the matrix to be a unit matrix (if it is square)
 public :: get_trace             ! Calculate the trace of a square matrix
 public :: get_diag              ! Return the diagonal of a matrix as a vector
 public :: isdiagmat             ! True if matrix is diagonal
 public :: r2c,c2r               ! Transfer complex data stored in a real array to a complex array and vice versa
 public :: iseven                ! Return .TRUE. if int is even
 public :: isinteger             ! Return .TRUE. if all elements of rr differ from an integer by less than tol
 public :: is_zero               ! Return .TRUE. if all elements of rr differ from zero by less than tol
 public :: bisect                ! Given a monotonic array A and x find j such that A(j)>x>A(j+1) using bisection
 public :: imax_loc              ! Index of maxloc on an array returned as scalar instead of array-valued quantity
 public :: imin_loc              ! Index of minloc on an array returned as scalar instead of array-valued quantity 
 public :: lfind                 ! Find the index of the first occurrence of .True. in a logical array.
 public :: list2blocks           ! Given a list of integers, find the number of contiguos groups of values.
 public :: mask2blocks           ! Find groups of .TRUE. elements in a logical mask.
 public :: linfit                ! Perform a linear fit, y=ax+b, of data
 public :: llsfit_svd            ! Linear least squares fit with SVD of an user-defined set of functions
 public :: polyn_interp          ! Polynomial interpolation with Nevilles"s algorithms, error estimate is reported 
 public :: quadrature            ! Driver routine for performing quadratures in finite domains using different algorithms
 public :: simpson_cplx          ! Integrate a complex function via extended Simpson's rule.
 public :: hermitianize          ! Force a square matrix to be hermitian
 public :: mkherm                ! Make the complex array(2,ndim,ndim) hermitian, by adding half of it to its hermitian conjugate.
 public :: symmetrize            ! Force a square matrix to be symmetric
 public :: print_arr             ! Print a vector/array
 public :: pade,dpade            ! Functions for Pade approximation (complex case)
 public :: newrap_step           ! Apply single step Newton-Raphson method to find root of a complex function
 public :: OPERATOR(.x.)         ! Cross product of two 3D vectors 
 public :: l2norm                ! Return the length (ordinary L2 norm) of a vector
 public :: remove_copies         ! Find the subset of inequivalent items in a list.
 public :: denominator           ! Return the denominator of a rational number.
 public :: mincm                 ! Return the minimum common multiple of two integers.
 public :: continued_fract       ! Routine to calculate the continued fraction (see description).
 public :: cmplx_sphcart         ! Convert an array of cplx numbers from spherical to Cartesian coordinates or vice versa.
 public :: pfactorize            ! Factorize a number in terms of an user-specified set of prime factors.
 public :: isordered             ! Check the ordering of a sequence.
 public :: wrap2_zero_one        ! Transforms a real number in a reduced number in the interval [0,1[ where 1 is not included (tol12)
 public :: wrap2_pmhalf          ! Transforms a real number in areduced number in the interval ]-1/2,1/2] where -1/2 is not included (tol12)
 public :: interpol3d            ! Linear interpolation in 3D
 public :: interpol3d_indices    ! Computes the indices in a cube which are neighbors to the point to be ! interpolated in interpol3d
 public :: simpson_int           ! Simpson integral of a tabulated function. Returns arrays with integrated values
 public :: simpson               ! Simpson integral of a tabulated function. Returns scalar with the integral on the full mesh.
 public :: rhophi                ! Compute the phase and the module of a complex number.

 interface arth
   module procedure arth_int 
   module procedure arth_rdp
 end interface arth

 interface reverse
   module procedure arth_int 
   module procedure arth_rdp
 end interface reverse

 interface set2unit
   module procedure unit_matrix_int 
   module procedure unit_matrix_rdp
   module procedure unit_matrix_cdp
 end interface set2unit

 interface get_trace
   module procedure get_trace_int
   module procedure get_trace_rdp
   module procedure get_trace_cdp
 end interface get_trace

 interface get_diag
   module procedure get_diag_rdp
   module procedure get_diag_cdp
 end interface get_diag

 interface isdiagmat
   module procedure isdiagmat_int
   module procedure isdiagmat_rdp
   !module procedure isdiagmat_cdp
 end interface isdiagmat

 interface r2c 
   module procedure rdp2cdp_1D 
   module procedure rdp2cdp_2D 
   module procedure rdp2cdp_3D 
   module procedure rdp2cdp_4D 
   module procedure rdp2cdp_5D 
   module procedure rdp2cdp_6D 
 end interface r2c

 interface c2r 
   module procedure cdp2rdp_1D
   module procedure cdp2rdp_2D
   module procedure cdp2rdp_3D
   module procedure cdp2rdp_4D
   module procedure cdp2rdp_5D
 end interface c2r

 interface isinteger
   module procedure is_integer_0d 
   module procedure is_integer_1d
 end interface isinteger

 interface is_zero
   module procedure is_zero_rdp_0d 
   module procedure is_zero_rdp_1d
 end interface is_zero

 interface bisect
   module procedure bisect_rdp
   module procedure bisect_int
 end interface bisect

 interface imax_loc 
   module procedure imax_loc_int
   module procedure imax_loc_rdp
 end interface imax_loc

 interface imin_loc 
   module procedure imin_loc_int
   module procedure imin_loc_rdp
 end interface imin_loc

 interface linfit
   module procedure linfit_rdp  
   module procedure linfit_spc 
   module procedure linfit_dpc 
 end interface linfit

 interface hermitianize
   module procedure hermitianize_spc 
   module procedure hermitianize_dpc 
 end interface hermitianize

 interface symmetrize 
   module procedure symmetrize_spc 
   module procedure symmetrize_dpc 
 end interface symmetrize 

 interface print_arr  !TODO add prtm
   module procedure print_arr1d_spc
   module procedure print_arr1d_dpc
   module procedure print_arr2d_spc
   module procedure print_arr2d_dpc
 end interface print_arr

 interface operator (.x.)           
   module procedure cross_product_int
   module procedure cross_product_rdp
 end interface

 interface l2norm
   module procedure l2norm_rdp
 end interface l2norm

 interface isordered
   module procedure isordered_rdp
 end interface isordered
!!***

!----------------------------------------------------------------------

!!****t* m_numeric_tools/stats_t
!! NAME
!! stats_t
!! 
!! FUNCTION
!!  Statistical parameters of a data distribution.
!! 
!! SOURCE

 type,public :: stats_t
   real(dp) :: mean
   real(dp) :: stdev
   real(dp) :: min
   real(dp) :: max
 end type stats_t
 
 public :: stats_eval  ! Calculate the statistical parameters of a data distribution.
!!***

!----------------------------------------------------------------------

!!****t* m_numeric_tools/vdiff_t
!! NAME
!! vdiff_t
!! 
!! FUNCTION
!!  Estimate the "distance" between two functions tabulated on a homogeneous grid.
!!  Use `vidff` function to construct the object.
!! 
!! SOURCE

 type,public :: vdiff_t

   real(dp) :: int_adiff      ! \int |f1-f2| dr
   real(dp) :: mean_adiff     ! Mean {|f1-f2|}
   real(dp) :: stdev_adiff    ! Standard deviation of {|f1-f2|}
   real(dp) :: min_adiff      ! Min {|f1-f2|}
   real(dp) :: max_adiff      ! Max {|f1-f2|}
   real(dp) :: l1_rerr        ! (\int |f1-f2| dr) / (\int |f2| dr)

 end type vdiff_t
 
 public :: vdiff_eval         ! Estimate the "distance" between two functions tabulated on a homogeneous grid.
 public :: vdiff_print        ! Print vdiff_t to formatted file.
!!***


CONTAINS  !===========================================================
!!***

!!****f* m_numeric_tools/arth_int
!! NAME
!!  arth_int
!!
!! FUNCTION
!!  Returns an array of length nn containing an arithmetic progression whose
!!  starting value is start and whose step is step. 
!!
!! INPUTS
!!  start=initial point
!!  step=the increment
!!  nn=the number of points
!!
!! OUTPUT
!!  arth(nn)=the progression
!!
!! SOURCE

pure function arth_int(start,step,nn)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'arth_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn
 integer,intent(in) :: start,step
 integer :: arth_int(nn)

!Local variables-------------------------------
 integer :: ii
! *********************************************************************

 select case (nn)

 case (1:)
   arth_int(1)=start
   do ii=2,nn
    arth_int(ii)=arth_int(ii-1)+step
   end do

 case (0) 
   RETURN
 end select

end function arth_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/arth_rdp
!! NAME
!!  arth_rdp
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function arth_rdp(start,step,nn)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'arth_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn
 real(dp),intent(in) :: start,step
 real(dp) :: arth_rdp(nn)

!Local variables-------------------------------
 integer :: ii
! *********************************************************************

 select case (nn)

 case (1:)
  arth_rdp(1)=start
  do ii=2,nn
   arth_rdp(ii)=arth_rdp(ii-1)+step
  end do

 case (0) 
  RETURN

 end select

end function arth_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/geop
!! NAME
!!  geop
!!
!! FUNCTION
!!  Returns an array of length nn containing a geometric progression whose
!!  starting value is start and whose factor is factor!
!!
!! INPUTS
!!  start=initial point
!!  factor=the factor of the geometric progression
!!  nn=the number of points
!!
!! OUTPUT
!!  geop(nn)=the progression
!!
!! SOURCE


pure function geop(start,factor,nn) result(res)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'geop'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: start,factor
 integer,intent(in) :: nn
 real(dp) :: res(nn)

!Local variables-------------------------------
 integer :: ii
! *********************************************************************

 if (nn>0) res(1)=start
 do ii=2,nn
   res(ii)=res(ii-1)*factor
 end do

end function geop
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/reverse_int
!! NAME
!!  reverse_int
!!
!! FUNCTION
!!   Reverse a 1D array *IN PLACE*. Target: INT arrays
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine reverse_int(arr) 


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'reverse_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(inout) :: arr(:)
!arrays
 integer :: ii,nn,swap
! *************************************************************************

 nn = SIZE(arr)
 if (nn <= 1) return

 do ii=1,nn/2
   swap = arr(ii) 
   arr(ii) = arr(nn-ii+1)
   arr(nn-ii+1) = swap
 end do

end subroutine reverse_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/reverse_rdp
!! NAME
!!  reverse_rdp
!!
!! FUNCTION
!!   Reverse a 1D array *IN PLACE*. Target: DP arrays
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine reverse_rdp(arr) 


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'reverse_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(inout) :: arr(:)
!arrays
 integer :: ii,nn
 real(dp) :: swap
! *************************************************************************

 nn = SIZE(arr)
 if (nn <= 1) return

 do ii=1,nn/2
   swap = arr(ii) 
   arr(ii) = arr(nn-ii+1)
   arr(nn-ii+1) = swap
 end do

end subroutine reverse_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/unit_matrix_int
!! NAME
!!  unit_matrix_int
!!
!! FUNCTION
!!  Set the matrix matrix to be a unit matrix (if it is square).
!!
!! SIDE EFFECTS
!!  matrix(:,:)=set to unit on exit
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

pure subroutine unit_matrix_int(matrix)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'unit_matrix_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 integer,intent(inout) :: matrix(:,:)

!Local variables-------------------------------
!scalars
 integer :: ii,nn
! *********************************************************************

 nn=MIN(SIZE(matrix,DIM=1),SIZE(matrix,DIM=2))
 matrix(:,:)=0
 do ii=1,nn
  matrix(ii,ii)=1
 end do

end subroutine unit_matrix_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/unit_matrix_rdp
!! NAME
!!  unit_matrix_rdp
!!
!! FUNCTION
!!  Set the matrix matrix to be a unit matrix (if it is square).
!!
!! SIDE EFFECTS
!!  matrix(:,:)=set to unit on exit
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

pure subroutine unit_matrix_rdp(matrix)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'unit_matrix_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 real(dp),intent(inout) :: matrix(:,:)

!Local variables-------------------------------
!scalars
 integer :: ii,nn
! *********************************************************************

 nn=MIN(SIZE(matrix,DIM=1),SIZE(matrix,DIM=2))
 matrix(:,:)=zero
 do ii=1,nn
   matrix(ii,ii)=one
 end do

end subroutine unit_matrix_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/unit_matrix_cdp
!! NAME
!!  unit_matrix_cdp
!!
!! FUNCTION
!!  Set the matrix matrix to be a unit matrix (if it is square).
!!
!! SIDE EFFECTS
!!  matrix(:,:)=set to unit on exit
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

pure subroutine unit_matrix_cdp(matrix)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'unit_matrix_cdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 complex(dpc),intent(inout) :: matrix(:,:)

!Local variables-------------------------------
!scalars
 integer :: ii,nn
! *********************************************************************

 nn=MIN(SIZE(matrix,DIM=1),SIZE(matrix,DIM=2))
 matrix=czero
 do ii=1,nn
   matrix(ii,ii)=cone
 end do

end subroutine unit_matrix_cdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/get_trace_int
!! NAME
!!  get_trace_int
!!
!! FUNCTION
!!  Calculate the trace of a square matrix 
!!
!! INPUTS 
!!  matrix(:,:) 
!! 
!! OUTPUT 
!!  trace=the trace 
!!
!! SOURCE

pure function get_trace_int(matrix) result(trace)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_trace_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 integer :: trace
 integer,intent(in) :: matrix(:,:)

!Local variables-------------------------------
!scalars
 integer :: ii
! *********************************************************************

 trace=0
 do ii=1,size(matrix,dim=1)
   trace=trace+matrix(ii,ii)
 end do

end function get_trace_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/get_trace_rdp
!! NAME
!!  get_trace_int
!!
!! FUNCTION
!!  Calculate the trace of a square matrix (real(dp) version)
!!
!! INPUTS 
!!  matrix(:,:) 
!! 
!! OUTPUT 
!!  trace=the trace 
!!
!! SOURCE

pure function get_trace_rdp(matrix) result(trace)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_trace_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 real(dp) :: trace
 real(dp),intent(in) :: matrix(:,:)

!Local variables-------------------------------
!scalars
 integer :: ii
! *********************************************************************

 trace=zero
 do ii=1,size(matrix,dim=1)
    trace=trace+matrix(ii,ii)
 end do

end function get_trace_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/get_trace_cdp
!! NAME
!!  get_trace_cdp
!!
!! FUNCTION
!!  Calculate the trace of a square matrix (complex(dpc) version)
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function get_trace_cdp(matrix) result(trace)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_trace_cdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 complex(dpc) :: trace
 complex(dpc),intent(in) :: matrix(:,:)

!Local variables-------------------------------
!scalars
 integer :: ii
! *********************************************************************

 trace=czero
 do ii=1,size(matrix,dim=1)
    trace=trace+matrix(ii,ii)
 end do

end function get_trace_cdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/get_diag_rdp
!! NAME
!!  get_diag_rdp
!!
!! FUNCTION
!!  Return the trace of a square matrix as a vector
!!
!! INPUTS 
!!  matrix(:,:) 
!! 
!! OUTPUT 
!!  diag(:)=the diagonalr
!!
!! SOURCE
function get_diag_rdp(mat) result(diag)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_diag_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: mat(:,:)
 real(dp) :: diag(SIZE(mat,1))

!Local variables-------------------------------
 integer :: ii
! *************************************************************************

 ii=assert_eq(SIZE(mat,1),SIZE(mat,2),'Matrix not square',&
& __FILE__,__LINE__)

 do ii=1,SIZE(mat,1)
  diag(ii)=mat(ii,ii)
 end do

end function get_diag_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/get_diag_cdp
!! NAME
!!  get_diag_cdp
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

function get_diag_cdp(cmat) result(cdiag)

!Arguments ------------------------------------
!scalars

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'get_diag_cdp'
!End of the abilint section

 complex(dpc),intent(in) :: cmat(:,:)
 complex(dpc) :: cdiag(SIZE(cmat,1))

!Local variables-------------------------------
 integer :: ii
! *************************************************************************

 ii=assert_eq(SIZE(cmat,1),SIZE(cmat,2),'Matrix not square',&
& __FILE__,__LINE__)

 do ii=1,SIZE(cmat,1)
  cdiag(ii)=cmat(ii,ii)
 end do

end function get_diag_cdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/isdiagmat_int
!! NAME
!!  isdiagmat_int
!!
!! FUNCTION
!!  True if matrix mat is diagonal
!!
!! SOURCE

pure logical function isdiagmat_int(mat) result(ans)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'isdiagmat_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: mat(:,:)

!Local variables-------------------------------
 integer :: ii,jj
! *************************************************************************

 ans = .True.
 do jj=1,size(mat,dim=2)
   do ii=1,size(mat,dim=1)
     if (ii == jj) cycle
     if (mat(ii,jj) /= 0) then
       ans = .False.; return
     end if
   end do
 end do

end function isdiagmat_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/isdiagmat_rdp
!! NAME
!!  isdiagmat_rdp
!!
!! FUNCTION
!!  True if matrix mat is diagonal withing the given absolute tolerance (default: tol12)
!!
!! SOURCE

pure logical function isdiagmat_rdp(mat, atol) result(ans)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'isdiagmat_rdp'
!End of the abilint section

 implicit none

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'isdiagmat_rdp'
!End of the abilint section

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: mat(:,:)
 real(dp),optional,intent(in) :: atol

!Local variables-------------------------------
 integer :: ii,jj
 real(dp) :: my_atol
! *************************************************************************

 my_atol = tol12; if (present(atol)) my_atol = atol

 ans = .True.
 do jj=1,size(mat,dim=2)
   do ii=1,size(mat,dim=1)
     if (ii == jj) cycle
     if (abs(mat(ii,jj)) > my_atol) then
       ans = .False.; return
     end if
   end do
 end do

end function isdiagmat_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/rdp2cdp_1D
!! NAME
!!  rdp2cdp_1D
!!
!! FUNCTION
!!  Create a complex array starting from a real array containing real and imaginary part
!! 
!! INPUTS
!!  rr(:)=the real array
!!
!! OUTPUT
!!  cc(:)=the complex array
!!
!! SOURCE

pure function rdp2cdp_1D(rr) result(cc)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'rdp2cdp_1D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: rr(:,:)
 complex(dpc) :: cc(SIZE(rr,2))

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

 cc(:)=CMPLX(rr(1,:),rr(2,:),kind=dpc)

end function rdp2cdp_1D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/rdp2cdp_2D
!! NAME
!!  rdp2cdp_2D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function rdp2cdp_2D(rr) result(cc)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'rdp2cdp_2D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: rr(:,:,:)
 complex(dpc) :: cc(SIZE(rr,2),SIZE(rr,3))

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

 cc(:,:)=CMPLX(rr(1,:,:),rr(2,:,:), kind=dpc)

end function rdp2cdp_2D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/rdp2cdp_3D
!! NAME
!!  rdp2cdp_3D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function rdp2cdp_3D(rr) result(cc)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'rdp2cdp_3D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: rr(:,:,:,:)
 complex(dpc) :: cc(SIZE(rr,2),SIZE(rr,3),SIZE(rr,4))

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

 cc(:,:,:)=CMPLX(rr(1,:,:,:),rr(2,:,:,:), kind=dpc)

end function rdp2cdp_3D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/rdp2cdp_4D
!! NAME
!!  rdp2cdp_4D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function rdp2cdp_4D(rr) result(cc)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'rdp2cdp_4D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: rr(:,:,:,:,:)
 complex(dpc) :: cc(SIZE(rr,2),SIZE(rr,3),SIZE(rr,4),SIZE(rr,5))

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

 cc(:,:,:,:)=CMPLX(rr(1,:,:,:,:),rr(2,:,:,:,:), kind=dpc)

end function rdp2cdp_4D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/rdp2cdp_5D
!! NAME
!!  rdp2cdp_5D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function rdp2cdp_5D(rr) result(cc)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'rdp2cdp_5D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: rr(:,:,:,:,:,:)
 complex(dpc) :: cc(SIZE(rr,2),SIZE(rr,3),SIZE(rr,4),SIZE(rr,5),SIZE(rr,6))

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

 cc(:,:,:,:,:)=CMPLX(rr(1,:,:,:,:,:),rr(2,:,:,:,:,:), kind=dpc)

end function rdp2cdp_5D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/rdp2cdp_6D
!! NAME
!!  rdp2cdp_6D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function rdp2cdp_6D(rr) result(cc)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'rdp2cdp_6D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: rr(:,:,:,:,:,:,:)
 complex(dpc) :: cc(SIZE(rr,2),SIZE(rr,3),SIZE(rr,4),SIZE(rr,5),SIZE(rr,6),SIZE(rr,7))

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

 cc(:,:,:,:,:,:)=CMPLX(rr(1,:,:,:,:,:,:),rr(2,:,:,:,:,:,:), kind=dpc)

end function rdp2cdp_6D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/cdp2rdp_1D
!! NAME
!!  cdp2rdp_1D
!!
!! FUNCTION
!!  Create a real array containing real and imaginary part starting from a complex array 
!! 
!! INPUTS
!!  cc(:)=the input complex array
!!
!! OUTPUT
!!  rr(2,:)=the real array
!!
!! SOURCE

pure function cdp2rdp_1D(cc) result(rr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'cdp2rdp_1D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 complex(dpc),intent(in) :: cc(:)
 real(dp) :: rr(2,SIZE(cc))

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

 rr(1,:)=REAL (cc(:))
 rr(2,:)=AIMAG(cc(:))

end function cdp2rdp_1D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/cdp2rdp_2D
!! NAME
!!  cdp2rdp_2D
!!
!! FUNCTION
!! 
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function cdp2rdp_2D(cc) result(rr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'cdp2rdp_2D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 complex(dpc),intent(in) :: cc(:,:)
 real(dp) :: rr(2,SIZE(cc,1),SIZE(cc,2))
! *********************************************************************

 rr(1,:,:)=REAL (cc(:,:))
 rr(2,:,:)=AIMAG(cc(:,:))

end function cdp2rdp_2D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/cdp2rdp_3D
!! NAME
!!  cdp2rdp_3D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function cdp2rdp_3D(cc) result(rr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'cdp2rdp_3D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 complex(dpc),intent(in) :: cc(:,:,:)
 real(dp) :: rr(2,SIZE(cc,1),SIZE(cc,2),SIZE(cc,3))

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

 rr(1,:,:,:)=REAL (cc(:,:,:))
 rr(2,:,:,:)=AIMAG(cc(:,:,:))

end function cdp2rdp_3D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/cdp2rdp_4D
!! NAME
!!  cdp2rdp_4D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function cdp2rdp_4D(cc) result(rr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'cdp2rdp_4D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 complex(dpc),intent(in) :: cc(:,:,:,:)
 real(dp) :: rr(2,SIZE(cc,1),SIZE(cc,2),SIZE(cc,3),SIZE(cc,4))
! *********************************************************************

 rr(1,:,:,:,:)=REAL (cc(:,:,:,:))
 rr(2,:,:,:,:)=AIMAG(cc(:,:,:,:))

end function cdp2rdp_4D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/cdp2rdp_5D
!! NAME
!!  cdp2rdp_5D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function cdp2rdp_5D(cc) result(rr)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'cdp2rdp_5D'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 complex(dpc),intent(in) :: cc(:,:,:,:,:)
 real(dp) :: rr(2,SIZE(cc,1),SIZE(cc,2),SIZE(cc,3),SIZE(cc,4),SIZE(cc,5))

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

 rr(1,:,:,:,:,:)=REAL (cc(:,:,:,:,:))
 rr(2,:,:,:,:,:)=AIMAG(cc(:,:,:,:,:))

end function cdp2rdp_5D
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/iseven
!! NAME
!!  iseven
!!
!! FUNCTION
!!  Return .TRUE. if the given integer is even 
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

elemental function iseven(nn)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'iseven'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn
 logical :: iseven
! *********************************************************************

 iseven=.FALSE.; if ((nn/2)*2==nn) iseven=.TRUE.

end function iseven
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/is_integer_0D
!! NAME
!!  is_integer_0D
!!
!! FUNCTION
!!  Return .TRUE. if all elements differ from an integer by less that tol 
!!
!! INPUTS
!!  rr=the set of real values to be checked
!!  tol=tolerance on the difference between real and integer
!!
!! SOURCE

pure function is_integer_0d(rr,tol) result(ans)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'is_integer_0d'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: tol
 logical :: ans
!arrays
 real(dp),intent(in) :: rr

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

 ans=(ABS(rr-NINT(rr))<tol) 

end function is_integer_0d
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/is_integer_1D
!! NAME
!!  is_integer_1D
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function is_integer_1d(rr,tol) result(ans)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'is_integer_1d'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: tol
 logical :: ans
!arrays
 real(dp),intent(in) :: rr(:)

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

 ans=ALL((ABS(rr-NINT(rr))<tol))

end function is_integer_1d
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/is_zero_rdp_0D
!! NAME
!!  is_zero_rdp_0D
!!
!! FUNCTION
!!  Return .TRUE. if all elements differ from zero by less that tol 
!!
!! INPUTS
!!  rr=the set of real values to be checked
!!  tol=tolerance
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

function is_zero_rdp_0d(rr,tol) result(ans)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'is_zero_rdp_0d'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: tol
 logical :: ans
!arrays
 real(dp),intent(in) :: rr
! *************************************************************************

 ans=(ABS(rr)<tol) 

end function is_zero_rdp_0d
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/is_zero_rdp_1d
!! NAME
!!  is_zero_rdp_1d
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

function is_zero_rdp_1d(rr,tol) result(ans)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'is_zero_rdp_1d'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: tol
 logical :: ans
!arrays
 real(dp),intent(in) :: rr(:)
! *************************************************************************

 ans=ALL(ABS(rr(:))<tol)

end function is_zero_rdp_1d
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/bisect_rdp
!! NAME
!!  bisect_rdp
!!
!! FUNCTION
!!  Given an array AA(1:N), and a value x, returns the index j such that AA(j)<=x<= AA(j + 1). 
!!  AA must be monotonic, either increasing or decreasing. j=0 or
!!  j=N is returned to indicate that x is out of range.
!!
!! SOURCE

pure function bisect_rdp(AA,xx) result(loc)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'bisect_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: AA(:)
 real(dp),intent(in) :: xx
 integer :: loc

!Local variables-------------------------------
 integer :: nn,jl,jm,ju
 logical :: ascnd
! *********************************************************************

 nn=SIZE(AA); ascnd=(AA(nn)>=AA(1)) 
 !
 ! === Initialize lower and upper limits ===
 jl=0; ju=nn+1
 do
   if (ju-jl<=1) EXIT
   jm=(ju+jl)/2  ! Compute a midpoint,
   if (ascnd.EQV.(xx>=AA(jm))) then
     jl=jm ! Replace lower limit
   else
     ju=jm ! Replace upper limit
   end if
 end do
 !
 ! === Set the output, being careful with the endpoints ===
 if (xx==AA(1)) then
   loc=1
 else if (xx==AA(nn)) then
   loc=nn-1
 else
   loc=jl
 end if

end function bisect_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/bisect_int
!! NAME
!!  bisect_int
!!
!! FUNCTION
!!  Given an array AA(1:N), and a value x, returns the index j such that AA(j)<=x<= AA(j + 1). 
!!  AA must be monotonic, either increasing or decreasing. j=0 or
!!  j=N is returned to indicate that x is out of range.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE
pure function bisect_int(AA,xx) result(loc)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'bisect_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: AA(:)
 integer,intent(in) :: xx
 integer :: loc

!Local variables-------------------------------
 integer :: nn,jl,jm,ju
 logical :: ascnd
! *********************************************************************

 nn=SIZE(AA) ; ascnd=(AA(nn)>=AA(1)) 
 !
 ! === Initialize lower and upper limits ===
 jl=0 ; ju=nn+1
 do
  if (ju-jl<=1) EXIT
  jm=(ju+jl)/2  ! Compute a midpoint,
  if (ascnd.EQV.(xx>=AA(jm))) then
   jl=jm ! Replace lower limit
  else
   ju=jm ! Replace upper limit
  end if
 end do
 !
 ! === Set the output, being careful with the endpoints ===
 if (xx==AA(1)) then
  loc=1
 else if (xx==AA(nn)) then
  loc=nn-1
 else
  loc=jl
 end if

end function bisect_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/imax_loc_int
!! NAME
!!  imax_loc_int
!!
!! FUNCTION
!!  Index of maxloc on an array returned as scalar instead of array-valued
!!
!! SOURCE

pure function imax_loc_int(iarr,mask)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'imax_loc_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer :: imax_loc_int
!arrays
 integer,intent(in) :: iarr(:)
 logical,optional,intent(in) :: mask(:)

!Local variables-------------------------------
 integer :: imax(1)
! *************************************************************************

 if (PRESENT(mask)) then
  imax=MAXLOC(iarr,MASK=mask) 
 else 
  imax=MAXLOC(iarr) 
 end if
 imax_loc_int=imax(1)

end function imax_loc_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/imax_loc_rdp
!! NAME
!!  imax_loc_rdp
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE
pure function imax_loc_rdp(arr,mask)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'imax_loc_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer :: imax_loc_rdp
!arrays
 real(dp),intent(in) :: arr(:)
 logical,optional,intent(in) :: mask(:)

!Local variables-------------------------------
 integer :: imax(1)
! *************************************************************************

 if (PRESENT(mask)) then
  imax=MAXLOC(arr,MASK=mask) 
 else
  imax=MAXLOC(arr) 
 end if
 imax_loc_rdp=imax(1)

end function imax_loc_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/imin_loc_int
!! NAME
!!  imin_loc_int
!!
!! FUNCTION
!!  Index of minloc on an array returned as scalar instead of array-valued
!!
!! SOURCE

pure function imin_loc_int(arr,mask)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'imin_loc_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer :: imin_loc_int
!arrays
 integer,intent(in) :: arr(:)
 logical,optional,intent(in) :: mask(:)

!Local variables-------------------------------
 integer :: imin(1)
! *************************************************************************

 if (PRESENT(mask)) then
  imin=MINLOC(arr,MASK=mask) 
 else 
  imin=MINLOC(arr) 
 end if
 imin_loc_int=imin(1)

end function imin_loc_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/imin_loc_rdp
!! NAME
!!  imin_loc_rdp
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

pure function imin_loc_rdp(arr,mask)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'imin_loc_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer :: imin_loc_rdp
!arrays
 real(dp),intent(in) :: arr(:)
 logical,optional,intent(in) :: mask(:)

!Local variables-------------------------------
 integer :: imin(1)
! *************************************************************************

 if (PRESENT(mask)) then
  imin=MINLOC(arr,MASK=mask) 
 else 
  imin=MINLOC(arr) 
 end if
 
 imin_loc_rdp=imin(1)

end function imin_loc_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/lfind
!! NAME
!!  lfind
!!
!! FUNCTION
!!  Find the index of the first occurrence of .True. in a logical array.
!!  Return -1 if not found. If back is True, the search starts from the 
!!  last element of the array (default: False).
!!
!! INPUTS
!!  mask(:)=Input logical mask
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

integer pure function lfind(mask, back)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'lfind'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 logical,intent(in) :: mask(:)
 logical,optional,intent(in) :: back
!arrays

!Local variables-------------------------------
!scalars
 integer :: ii,nitems
 logical :: do_back

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

 do_back = .False.; if (present(back)) do_back = back
 lfind = -1; nitems = size(mask); if (nitems == 0) return

 if (do_back) then
   ! Backward search
   do ii=nitems,1,-1
     if (mask(ii)) then
       lfind = ii; return
     end if
   end do
 else
   ! Forward search.
   do ii=1,nitems
     if (mask(ii)) then
       lfind = ii; return
     end if
   end do
 end if

end function lfind
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/list2blocks
!! NAME
!!  list2blocks
!!
!! FUNCTION
!!  Given a list of integers, find the number of contiguos groups of values.
!!  and returns the set of indices that can be used to loop over these groups
!!  Example list = [1,2,3,5,6] --> blocks = [[1,3], [4,5]]
!!
!! INPUTS
!!  list(:)=List of integers
!!
!! OUTPUTS
!! nblocks=Number of blocks
!! blocks(2,nblocks)= 
!!    allocatable array in input 
!!    in output:
!!       blocks(1,i) gives the start of the i-th block
!!       blocks(2,i) gives the end of the i-th block
!!
!! PARENTS
!!      m_wfd
!!
!! CHILDREN
!!
!! SOURCE

subroutine list2blocks(list,nblocks,blocks)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'list2blocks'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(out) :: nblocks
 integer,intent(in) :: list(:)
!arrays
 integer,intent(out),allocatable :: blocks(:,:)

!Local variables-------------------------------
!scalars
 integer :: ii,nitems
!arrays
 integer :: work(2,size(list))

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

 nitems = size(list)

 ! Handle nitems == 1 case
 if (nitems == 1) then 
   ABI_MALLOC(blocks, (2,1))
   blocks = 1
   return
 end if

 nblocks = 1; work(1,1) = 1

 do ii=2,nitems
   if (list(ii) /= (list(ii-1) + 1)) then
     work(2,nblocks) = ii - 1
     nblocks = nblocks + 1
     work(1,nblocks) = ii
   end if
 end do

 work(2,nblocks) = nitems

 ABI_MALLOC(blocks, (2,nblocks))
 blocks = work(:,1:nblocks)

end subroutine list2blocks
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/mask2blocks
!! NAME
!!  mask2blocks
!!
!! FUNCTION
!!  Give a logical mask, find the number of contiguos groups of .TRUE. values.
!!  and return the set of indices that can be used to loop over these groups
!!
!! INPUTS
!!  mask(:)=Input logical mask
!!
!! OUTPUTS
!! nblocks=Number of blocks
!!
!! SIDE EFFECTS
!! blocks(:,:)= Null pointer in input. blocks(2,nblocks) in output where
!!   blocks(1,i) gives the start of the i-th block
!!   blocks(2,i) gives the end of the i-th block
!!
!! PARENTS
!!      m_wfk
!!
!! CHILDREN
!!
!! SOURCE

subroutine mask2blocks(mask,nblocks,blocks)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'mask2blocks'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(out) :: nblocks
 logical,intent(in) :: mask(:)
!arrays
 integer,allocatable :: blocks(:,:)

!Local variables-------------------------------
!scalars
 integer :: ii,nitems,start
 logical :: inblock
!arrays
 integer :: work(2,SIZE(mask))

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

 ! Find first element.
 nitems = size(mask); start = 0
 do ii=1,nitems
   if (mask(ii)) then
     start = ii
     exit
   end if
 end do

 ! Handle no true element or just one.
 if (start == 0) then
   nblocks = 0
   ABI_MALLOC(blocks, (0,0))
   return
 end if
 if (start /= 0 .and. nitems == 1) then
   nblocks = 1
   ABI_MALLOC(blocks, (2,1))
   blocks(:,1) = [1,1] 
 end if

 nblocks = 1; work(1,1) = start; inblock = .True.

 do ii=start+1,nitems
   if (.not.mask(ii)) then
     if (inblock) then
       inblock = .False.
       work(2,nblocks) = ii - 1
     end if
   else
     if (.not. inblock) then
       inblock = .True.
       nblocks = nblocks + 1
       work(1,nblocks) = ii
     end if
   end if
 end do

 if (mask(nitems) .and. inblock) work(2,nblocks) = nitems

 ABI_MALLOC(blocks, (2,nblocks))
 blocks = work(:,1:nblocks)

end subroutine mask2blocks
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/linfit_rdp
!! NAME
!!  linfit_rdp
!!
!! FUNCTION
!!  Perform a linear fit, y=ax+b, of data
!!
!! INPUTS
!!  xx(nn)=xx coordinates
!!  yy(nn)=yy coordinates
!!
!! OUTPUT
!!  aa=coefficient of linear term of fit
!!  bb=coefficient of constant term of fit
!!  function linfit=root mean square of differences between data and fit
!!
!! SOURCE

function linfit_rdp(nn,xx,yy,aa,bb) result(res) 


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'linfit_rdp'
!End of the abilint section

 implicit none

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'linfit_rdp'
!End of the abilint section

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn
 real(dp) :: res
 real(dp),intent(out) :: aa,bb
!arrays
 real(dp),intent(in) :: xx(nn),yy(nn) 
 
!Local variables-------------------------------
!scalars
 integer :: ii
 real(dp) :: msrt,sx2,sx,sxy,sy,tx,ty 
! *************************************************************************

 sx=zero ; sy=zero ; sxy=zero ; sx2=zero
 do ii=1,nn
  tx=xx(ii)
  ty=yy(ii)
  sx=sx+tx
  sy=sy+ty
  sxy=sxy+tx*ty
  sx2=sx2+tx*tx
 end do

 aa=(nn*sxy-sx*sy)/(nn*sx2-sx*sx)
 bb=sy/nn-sx*aa/nn

 msrt=zero
 do ii=1,nn
  tx=xx(ii)
  ty=yy(ii)
  msrt=msrt+(ty-aa*tx-bb)**2
 end do
 msrt=SQRT(msrt/nn) ; res=msrt

end function linfit_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/linfit_spc
!! NAME
!!  linfit_spc
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

function linfit_spc(nn,xx,zz,aa,bb) result(res)

!Arguments ------------------------------------
!scalars

!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'linfit_spc'
!End of the abilint section

 integer,intent(in) :: nn
 real(dp) :: res
 real(dp),intent(in) :: xx(nn)
 complex(spc),intent(in) :: zz(nn)
 complex(spc),intent(out) :: aa,bb
!arrays

!Local variables-------------------------------
!scalars
 integer :: ii
 real(dp) :: sx,sx2,msrt
 complex(dpc) :: sz,sxz
! *************************************************************************

 sx=zero ; sx2=zero ; msrt=zero 
 sz=czero ; sxz=czero
 do ii=1,nn
  sx=sx+xx(ii)
  sz=sz+zz(ii)
  sxz=sxz+xx(ii)*zz(ii)
  sx2=sx2+xx(ii)*xx(ii)
 end do

 aa=(nn*sxz-sx*sz)/(nn*sx2-sx*sx)
 bb=sz/nn-sx*aa/nn

 do ii=1,nn
  msrt=msrt+ABS(zz(ii)-aa*xx(ii)-bb)**2
 end do
 msrt=SQRT(msrt) ; res=msrt

end function linfit_spc
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/linfit_dpc
!! NAME
!!  linfit_dpc
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! SOURCE

function linfit_dpc(nn,xx,zz,aa,bb) result(res)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'linfit_dpc'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn
 real(dp) :: res
 real(dp),intent(in) :: xx(nn)
 complex(dpc),intent(in) :: zz(nn)
 complex(dpc),intent(out) :: aa,bb
!arrays

!Local variables-------------------------------
!scalars
 integer :: ii
 real(dp) :: sx,sx2,msrt
 complex(dpc) :: sz,sxz
! *************************************************************************

 sx=zero  ; sx2=zero ; msrt=zero 
 sz=czero ; sxz=czero
 do ii=1,nn
  sx=sx+xx(ii)
  sz=sz+zz(ii)
  sxz=sxz+xx(ii)*zz(ii)
  sx2=sx2+xx(ii)*xx(ii)
 end do

 aa=(nn*sxz-sx*sz)/(nn*sx2-sx*sx)
 bb=sz/nn-sx*aa/nn

 do ii=1,nn
  msrt=msrt+ABS(zz(ii)-aa*xx(ii)-bb)**2
 end do
 msrt=SQRT(msrt) ; res=msrt

end function linfit_dpc
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/llsfit_svd
!! NAME
!!  llsfit_svd
!!
!! FUNCTION
!!  Given a set of N data points (x,y) with individual standard deviations sigma_i, 
!!  use chi-square minimization to determine the M coefficients, par, of a function that 
!!  depends linearly on nfuncs functions, i.e f(x) = \sum_i^{nfuncs} par_i * func_i(x). 
!!  Solve the fitting equations using singular value decomposition of the design matrix as in Eq 14.3.17
!!  of Numerical Recipes. The program returns values for the M fit parameters par, and chi-square. 
!!  The user supplies a subroutine funcs(x,nfuncs) that returns the M basis functions evaluated at xx.
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine llsfit_svd(xx,yy,sigma,nfuncs,funcs,chisq,par,var,cov,info)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'llsfit_svd'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nfuncs
 integer,intent(out) :: info
 real(dp),intent(out) :: chisq
!arrays
 real(dp),intent(in) :: xx(:),yy(:),sigma(:)
 real(dp),intent(out) :: par(:),var(:),cov(:,:)

 interface
  function funcs(xx,nf)
  use defs_basis
  implicit none
  real(dp),intent(in) :: xx
  integer,intent(in) :: nf
  real(dp) :: funcs(nf)
  end function funcs
 end interface

!Local variables-------------------------------
 integer,parameter :: PAD_=50
 integer :: ii,npts,lwork
 real(dp),parameter :: TOL_=1.0e-5_dp
!arrays
 real(dp),dimension(SIZE(xx)) :: bb,sigm1
 real(dp),dimension(SIZE(xx),nfuncs) :: dmat,dmat_save
 real(dp) :: tmp(nfuncs)
 real(dp),allocatable :: work(:),Vt(:,:),U(:,:),S(:)
! *************************************************************************

 npts=assert_eq(SIZE(xx),SIZE(yy),SIZE(sigma),'Wrong size in xx,yy,sigma',&
& __FILE__,__LINE__)
 call assert((npts>=nfuncs),'No. of functions must greater than no. of points',&
& __FILE__,__LINE__)
 ii=assert_eq(nfuncs,SIZE(cov,1),SIZE(cov,2),SIZE(var),'Wrong size in covariance',&
& __FILE__,__LINE__)

 !
 ! === Calculate design matrix and b vector ===
 ! * dmat_ij=f_j(x_i)/sigma_i, b_i=y_i/sigma_i
 sigm1(:)=one/sigma(:) ; bb(:)=yy(:)*sigm1(:)
 do ii=1,npts
  dmat_save(ii,:)=funcs(xx(ii),nfuncs) 
 end do
 dmat=dmat_save*SPREAD(sigm1,DIM=2,ncopies=nfuncs)
 dmat_save(:,:)=dmat(:,:)
 !
 ! === Singular value decomposition ===
 lwork=MAX(3*MIN(npts,nfuncs)+MAX(npts,nfuncs),5*MIN(npts,nfuncs)-4)+PAD_
 ABI_MALLOC(work,(lwork))
 ABI_MALLOC(U,(npts,npts))
 ABI_MALLOC(S,(nfuncs))
 ABI_MALLOC(Vt,(nfuncs,nfuncs))

 !call DGESVD('A','A',npts,nfuncs,dmat,npts,S,U,npts,Vt,nfuncs,work,lwork,info)
 ABI_FREE(work)
 GOTO 10
 !
 ! === Set to zero small singular values according to TOL_ and find coefficients ===
 WHERE (S>TOL_*MAXVAL(S)) 
  tmp=MATMUL(bb,U)/S
 ELSEWHERE
  S  =zero
  tmp=zero
 END WHERE
 par(:)=MATMUL(tmp,Vt)
 !
 ! === Evaluate chi-square ===
 chisq=l2norm(MATMUL(dmat_save,par)-bb)**2
 !
 ! === Calculate covariance and variance ===
 ! C_jk = V_ji V_ki / S_i^2
 WHERE (S/=zero) S=one/(S*S)

 ! check this but should be correct
 cov(:,:)=Vt*SPREAD(S,DIM=2,ncopies=nfuncs)
 cov(:,:)=MATMUL(TRANSPOSE(Vt),cov)
 var(:)=SQRT(get_diag(cov))

10 continue  
 ABI_FREE(U)
 ABI_FREE(S)
 ABI_FREE(Vt)

end subroutine llsfit_svd
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/polyn_interp
!! NAME
!!  polyn_interp
!!
!! FUNCTION
!!  Given arrays xa and ya of length N, and given a value x, return a value y, and an error estimate dy. 
!!  If P(x) is the polynomial of degree N-1 such that P(xai)=yai, i=1,...,N, then the returned value y=P(x).
!!
!! INPUTS
!!  xa(:)=abscissas in ascending order
!!  ya(:)=ordinates
!!  x=the point where the set of data has to be interpolated
!!
!! OUTPUT
!!  y=the interpolated value
!!  dy=error estimate
!!
!! NOTES
!!  Based on the polint routine reported in Numerical Recipies
!!
!! PARENTS
!!      m_numeric_tools
!!
!! CHILDREN
!!
!! SOURCE

subroutine polyn_interp(xa,ya,x,y,dy)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'polyn_interp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: xa(:),ya(:)
 real(dp),intent(in) :: x
 real(dp),intent(out) :: y,dy
!Local variables-------------------------------
!scalars
 integer :: m,n,ns
!arrays
 real(dp),dimension(SIZE(xa)) :: c,d,den,ho
! *************************************************************************

 n=assert_eq(SIZE(xa),SIZE(ya),'Different size in xa and ya',&
& __FILE__,__LINE__)

 ! === Initialize the tables of c and d ===
 c(:)=ya(:) ; d(:)=ya(:) ; ho(:)=xa(:)-x
 ! === Find closest table entry and initial approximation to y ===
 ns=imin_loc(ABS(x-xa)) ; y=ya(ns)
 ns=ns-1
 !
 ! === For each column of the tableau loop over current c and d and up-date them ===
 do m=1,n-1
  den(1:n-m)=ho(1:n-m)-ho(1+m:n)
  if (ANY(den(1:n-m)==zero)) then 
   MSG_ERROR('Two input xa are identical')
  end if

  den(1:n-m)=(c(2:n-m+1)-d(1:n-m))/den(1:n-m)
  d(1:n-m)=ho(1+m:n)*den(1:n-m) ! Update c and d 
  c(1:n-m)=ho(1:n-m)*den(1:n-m)

  if (2*ns<n-m) then  ! Now decide which correction, c or d, we want to add to the 
   dy=c(ns+1)         ! accumulating value of y, The last dy added is the error indication.
  else
   dy=d(ns)
   ns=ns-1
  end if

  y=y+dy
 end do

end subroutine polyn_interp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/trapezoidal_
!! NAME
!!  trapezoidal_ (PRIVATE)
!!
!! FUNCTION
!!  Compute the n-th stage of refinement of an extended trapezoidal rule
!!  adding 2^(n-2) additional interior point in the finite range of integration
!!
!! INPUTS
!!  func(external)=the name of the function to be integrated
!!  xmin,xmax=the limits of integration
!!  nn=integer defining the refinement of the mesh, each call adds 2^(n-2) additional interior points 
!!
!! OUTPUT
!!  See SIDE EFFECTS
!!
!! SIDE EFFECTS
!!  quad=the integral at the n-th stage. 
!!
!! PARENTS
!!
!! CHILDREN
!!
!! NOTES
!!  When called with nn=1, the routine returns the crudest estimate of the integral
!!  Subsequent calls with nn=2,3,... (in that sequential order) will improve the accuracy
!!  by adding 2^(n-2) additional interior points. Note that quad should not be modified between sequential calls.
!!  Subroutine is defined as recursive to allow multi-dimensional integrations
!!
!! SOURCE

recursive subroutine trapezoidal_(func,nn,xmin,xmax,quad)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'trapezoidal_'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn
 !real(dp),external :: func
 real(dp),intent(in) :: xmin,xmax
 real(dp),intent(inout) :: quad

 interface
   function func(x)
     use defs_basis
     real(dp),intent(in) :: x
     real(dp) :: func
   end function func
 end interface

 !interface
 ! function func(x)
 !  use defs_basis
 !  real(dp),intent(in) :: x(:)
 !  real(dp) :: func(SIZE(x))
 ! end function func
 !end interface

!Local variables-------------------------------
!scalars
 integer :: npt,ix
 real(dp) :: space,new,yy
 character(len=500) :: msg
!arrays
 !real(dp),allocatable :: xx(:)
!************************************************************************

 select case (nn)

 case (1)
   ! === Initial crude estimate (xmax-xmin)(f1+f2)/2 ===
   !quad=half*(xmax-xmin)*SUM(func((/xmin,xmax/)))
   quad=half*(xmax-xmin)*(func(xmin)+func(xmax))

 case (2:)
   ! === Add npt interior points of spacing space ===
   npt=2**(nn-2) ; space=(xmax-xmin)/npt 
   ! === The new sum is combined with the old integral to give a refined integral ===
   !new=SUM(func(arth(xmin+half*space,space,npt))) !PARALLEL version
   !allocate(xx(npt)) 
   !xx(:)=arth(xmin+half*space,space,npt)
   !xx(1)=xmin+half*space
   !do ii=2,nn
   ! xx(ii)=xx(ii-1)+space
   !end do
   new=zero
   yy=xmin+half*space
   do ix=1,npt
    !new=new+func(xx(ix))
    new=new+func(yy)
    yy=yy+space
   end do
   !deallocate(xx)
   quad=half*(quad+space*new) 
   !write(std_out,*) 'trapezoidal',quad

 case (:0)
   write(msg,'(a,i3)')'Wrong value for nn ',nn
   MSG_BUG(msg)
 end select

end subroutine trapezoidal_
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/midpoint_
!! NAME
!!  midpoint_ (PRIVATE)
!!
!! FUNCTION
!!  This routine computes the n-th stage of refinement of an extended midpoint rule.
!!
!! INPUTS
!!  func(external)=the name of the function to be integrated
!!  xmin,xmax=the limits of integration
!!  nn=integer defining the refinement of the mesh, each call adds (2/3)*3n-1 additional 
!!   interior points between xmin ans xmax
!!
!! OUTPUT
!!  See SIDE EFFECTS
!!
!! SIDE EFFECTS
!!  quad=the integral at the n-th stage. 
!!
!! PARENTS
!!
!! CHILDREN
!!
!! NOTES
!!  When called with nn=1, the routine returns as quad the crudest estimate of the integral
!!  Subsequent calls with nn=2,3,... (in that sequential order) will improve the accuracy of quad by adding
!!  (2/3)*3n-1 additional interior points. quad should not be modified between sequential calls.
!!  Subroutine is defined as recursive to allow multi-dimensional integrations
!!
!! SOURCE

 recursive subroutine midpoint_(func,nn,xmin,xmax,quad)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'midpoint_'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn
 !real(dp),external :: func
 real(dp),intent(in) :: xmin,xmax
 real(dp),intent(inout) :: quad

 interface
   function func(x)
     use defs_basis
     real(dp),intent(in) :: x
     real(dp) :: func
   end function func
 end interface

 !interface
 ! function func(x)
 !  use defs_basis
 !  real(dp),intent(in) :: x(:)
 !  real(dp) :: func(SIZE(x))
 ! end function func
 !end interface

!Local variables-------------------------------
!scalars
 integer  :: npt,ix
 real(dp) :: space
 character(len=500) :: msg
!arrays
 real(dp),allocatable :: xx(:)

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

 select case (nn)

 case (1)
   ! === Initial crude estimate done at the middle of the interval
   !quad=(xmax-xmin)*SUM(func((/half*(xmin+xmax)/))) !PARALLEL version
   quad=(xmax-xmin)*func(half*(xmin+xmax))

 case (2:)
   ! === Add npt interior points, they alternate in spacing between space and 2*space ===
   ABI_MALLOC(xx,(2*3**(nn-2)))
   npt=3**(nn-2) ; space=(xmax-xmin)/(three*npt) 
   xx(1:2*npt-1:2)=arth(xmin+half*space,three*space,npt) 
   xx(2:2*npt:2)=xx(1:2*npt-1:2)+two*space
   ! === The new sum is combined with the old integral to give a refined integral ===
   !quad=quad/three+space*SUM(func(xx))  !PARALLEL version
   quad=quad/three
   do ix=1,SIZE(xx)
     quad=quad+space*func(xx(ix)) 
   end do
   ABI_FREE(xx)

 case (:0)
   write(msg,'(a,i3)')' wrong value for nn ',nn
   MSG_BUG('Wrong value for nn')
 end select

end subroutine midpoint_
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/quadrature 
!! NAME
!!  quadrature
!!
!! FUNCTION
!!  Driver routine to perform quadratures in finite domains using different techniques.
!!  The routine improves the resolution of the grid until a given accuracy is reached
!!
!! INPUTS
!!  func(external)=the name of the function to be integrated
!!  xmin,xmax=the limits of integration
!!  npts=Initial number of points, only for Gauss-Legendre. At each step this number is doubled
!!  accuracy=fractional accuracy required
!!  ntrial=Max number of attempts
!!  qopt=integer flag defining the algorithm for the quadrature:
!!    1 for Trapezoidal rule, closed, O(1/N^2) 
!!    2 for Simpson based on trapezoidal,closed, O(1/N^4)
!!    3 for Midpoint rule, open, O(1/N^2)
!!    4 for midpoint rule with cancellation of leading error, open, O(1/N^4)
!!    5 for Romberg integration (closed form) and extrapolation for h-->0 (order 10 is hard-coded)
!!    6 for Romberg integration with midpoint rule and extrapolation for h-->0 (order 10 is hard-coded)
!!    7 for Gauss-Legendre
!!
!! OUTPUT
!!  quad=the integral
!!  ierr=0 if quadrature converged. 
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

recursive subroutine quadrature(func,xmin,xmax,qopt,quad,ierr,ntrial,accuracy,npts)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'quadrature'
 use interfaces_28_numeric_noabirule
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: qopt
 integer,intent(out) :: ierr
 integer,optional,intent(in) :: ntrial,npts
 real(dp),intent(in) :: xmin,xmax
 real(dp),optional,intent(in) :: accuracy
 real(dp),intent(out) :: quad

 interface
   function func(x)
     use defs_basis
     real(dp),intent(in) :: x
     real(dp) :: func
   end function func
 end interface

 !interface
 ! function func(x)
 !  use defs_basis
 !  real(dp),intent(in) :: x(:)
 !  real(dp) :: func(SIZE(x))
 ! end function func
 !end interface

!Local variables-------------------------------
!scalars
 integer :: K,KM,NT,NX,NX0,it,ix
 real(dp) :: EPS,old_st,st,old_quad,dqromb
 real(dp) :: TOL
 character(len=500) :: msg      
!arrays
 real(dp),allocatable :: h(:),s(:)
 real(dp),allocatable :: wx(:),xx(:)
! *************************************************************************

 ierr = 0
 TOL  =tol12
 EPS  =tol6  ; if (PRESENT(accuracy)) EPS=accuracy
 NT   =20    ; if (PRESENT(ntrial  )) NT=ntrial
 quad =zero
                                          
 select case (qopt)

 case (1)
   ! === Trapezoidal, closed form, O(1/N^2) 
   do it=1,NT
     call trapezoidal_(func,it,xmin,xmax,quad)
     if (it>5) then ! Avoid spurious early convergence
       if (ABS(quad-old_quad)<EPS*ABS(old_quad).or.(ABS(quad)<TOL.and.ABS(old_quad)<TOL)) RETURN
     end if
     old_quad=quad
   end do

 case (2)
  ! === Extended Simpson rule based on trapezoidal O(1/N^4) ===
   do it=1,NT
     call trapezoidal_(func,it,xmin,xmax,st)
     if (it==1) then 
       quad=st
     else
       quad=(four*st-old_st)/three
     end if
     if (it>5) then ! Avoid spurious early convergence
       if (ABS(quad-old_quad)<EPS*ABS(old_quad).or.(ABS(quad)<TOL.and.ABS(old_quad)<TOL)) RETURN
     end if
     old_quad=quad
     old_st=st
   end do

 case (3) 
  ! === Midpoint rule, open form, O(1/N^2) ===
  do it=1,NT
    call midpoint_(func,it,xmin,xmax,quad)
    if (it>4) then ! Avoid spurious early convergence
      if (ABS(quad-old_quad)<EPS*ABS(old_quad).or.(ABS(quad)<TOL.and.ABS(old_quad)<TOL)) RETURN
    end if
    old_quad=quad
  end do

 case (4) 
   ! === Midpoint rule with cancellation of leading 1/N^2 term, open form, O(1/N^4) ===
   do it=1,NT
     call midpoint_(func,it,xmin,xmax,st)
     if (it==1) then 
       quad=st
     else
       quad=(nine*st-old_st)/eight
     end if
     if (it>4) then ! Avoid spurious early convergence
       if (ABS(quad-old_quad)<EPS*ABS(old_quad).or.(ABS(quad)<TOL.and.ABS(old_quad)<TOL)) RETURN
     end if
     old_quad=quad
     old_st=st
   end do

 case (5) 
   ! === Romberg Integration, closed form ===
   K=5 ; KM=K-1 ! Order 10
   ABI_MALLOC(h,(NT+1))
   ABI_MALLOC(s,(NT+1))
   h=zero 
   s=zero
   h(1)=one
   do it=1,NT
     call trapezoidal_(func,it,xmin,xmax,s(it))
     !write(std_out,*) ' romberg-trap at ',ncall,it,s(it)
     if (it>=K) then 
       call polyn_interp(h(it-KM:it),s(it-KM:it),zero,quad,dqromb)
       if (ABS(dqromb)<EPS*ABS(quad)) then 
         ABI_FREE(h)
         ABI_FREE(s)
         RETURN
       end if
     end if
     s(it+1)=s(it)
     h(it+1)=quarter*h(it) ! Quarter makes the extrapolation a polynomial in h^2, 
   end do                 ! This is required to use the Euler-Maclaurin formula 
   ABI_FREE(h)
   ABI_FREE(s)

 case (6) 
   ! === Romberg Integration, closed form ===
   K=5 ; KM=K-1 ! Order 10
   ABI_MALLOC(h,(NT+1))
   ABI_MALLOC(s,(NT+1))
   h=zero 
   s=zero
   h(1)=one
   do it=1,NT
     call midpoint_(func,it,xmin,xmax,s(it))
     if (it>=K) then 
       call polyn_interp(h(it-KM:it),s(it-KM:it),zero,quad,dqromb)
       !write(std_out,*) quad,dqromb
       if (ABS(dqromb)<EPS*ABS(quad)) then 
         ABI_FREE(h)
         ABI_FREE(s)
         RETURN
       end if
     end if
     s(it+1)=s(it)
     h(it+1)=ninth*h(it) ! factor is due to step tripling in midpoint and even error series
   end do                 
   ABI_FREE(h)
   ABI_FREE(s)

 case (7) 
   ! === Gauss-Legendre ===
   NX0=5 ; if (PRESENT(npts)) NX0=npts 
   NX=NX0
   do it=1,NT
     ABI_MALLOC(wx,(NX))
     ABI_MALLOC(xx,(NX))
     call coeffs_gausslegint(xmin,xmax,xx,wx,NX)
     quad=zero 
     do ix=1,NX 
       quad=quad+wx(ix)*func(xx(ix))
     end do
     ABI_FREE(wx)
     ABI_FREE(xx)
     if (it>1) then 
       !write(std_out,*) quad
       if (ABS(quad-old_quad)<EPS*ABS(old_quad).or.(ABS(quad)<TOL.and.ABS(old_quad)<TOL)) RETURN
     end if
     old_quad=quad
     NX=NX+NX0
     !NX=2*NX
   end do

 case default 
   write(msg,'(a,i3)')'Wrong value for qopt',qopt
   MSG_BUG(msg)
 end select

 write(msg,'(a,i0,2(a,es14.6))')&
&  "Results are not converged within the given accuracy. ntrial= ",NT,"; EPS= ",EPS,"; TOL= ",TOL
 MSG_WARNING(msg)
 ierr = -1

end subroutine quadrature
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/simpson_cplx
!! NAME
!!  simpson_cplx
!!
!! FUNCTION
!!  Integrate a complex function using extended Simpson's rule.
!!
!! INPUTS
!!  npts=Number of points. 
!!  step=Step of the mesh.
!!  ff(npts)=Values of the integrand.
!!
!! OUTPUT
!!  simpson_cplx=Integral of ff.
!!
!! NOTES
!!  If npts is odd, the integration is done with the extended Simpson's rule (error = O^(step^4))
!!  If npts is even, the last 4 four points are integrated separately via Simpson's 3/8 rule. Error = O(step^5)
!!  while the first npts-3 points are integrared with the extended Simpson's rule.
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

function simpson_cplx(npts,step,ff)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'simpson_cplx'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: npts
 real(dp),intent(in)  :: step
 complex(dpc),intent(in) :: ff(npts)
 complex(dpc) :: simpson_cplx
      
!Local variables ------------------------------
!scalars
 integer :: ii,my_n
 complex(dpc) :: sum_even, sum_odd

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

 my_n=npts; if ((npts/2)*2 == npts) my_n=npts-3

 if (my_n<2) then
   MSG_ERROR("Too few points")
 end if

 sum_odd=czero
 do ii=2,my_n-1,2
   sum_odd = sum_odd + ff(ii)
 end do
      
 sum_even=zero
 do ii=3,my_n-2,2
   sum_even = sum_even + ff(ii)
 end do
      
 ! Eq 25.4.6 Abramowitz. Error is O(step^4)
 simpson_cplx = step/three * (ff(1) + four*sum_odd + two*sum_even + ff(my_n))

 if (my_n/=npts) then ! Simpson's 3/8 rule. Eq 25.4.13 Abramowitz. Error is O(step^5)
  simpson_cplx = simpson_cplx + three*step/eight * (ff(npts-3) + 3*ff(npts-2) + 3*ff(npts-1) + ff(npts)) 
 end if
      
end function simpson_cplx
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/hermitianize_spc
!! NAME
!!  hermitianize_spc
!!
!! FUNCTION
!!  Force a square matrix to be hermitian
!!
!! INPUTS
!!  uplo=String describing which part of the matrix has been calculated.
!!    Only the first character is tested (no case sensitive). Possible values are:
!!    "All"= Full matrix is supplied in input
!!    "Upper"=Upper triangle is in input. Lower triangle is reconstructed by symmetry.
!!    "Lower"=Lower triangle is in input. Upper triangle is reconstructed by symmetry.
!!
!! OUTPUT
!!  (see side effects)
!!
!! SIDE EFFECTS
!!  mat(:,:)=complex input matrix, hermitianized at output
!!
!! CHILDREN
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine hermitianize_spc(mat,uplo)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'hermitianize_spc'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=*),intent(in) :: uplo
!arrays
 complex(spc),intent(inout) :: mat(:,:)

!Local variables-------------------------------
!scalars
 integer :: nn,ii,jj
!arrays
 complex(spc),allocatable :: tmp(:)
! *************************************************************************
 
 nn=assert_eq(SIZE(mat,1),SIZE(mat,2),'Matrix not square',&
& __FILE__,__LINE__)

 select case (uplo(1:1))

 case ("A","a") ! Full matrix has been calculated.
   ABI_MALLOC(tmp,(nn))
   do ii=1,nn
     do jj=ii,nn
       tmp(jj)=half*(mat(ii,jj)+CONJG(mat(jj,ii)))
     end do
     mat(ii,ii:nn)=tmp(ii:nn)
     mat(ii:nn,ii)=CONJG(tmp(ii:nn))
   end do
   ABI_FREE(tmp)

 case ("U","u") ! Only the upper triangle is used.
   do jj=1,nn
     do ii=1,jj
       if (ii/=jj) then
         mat(jj,ii) = CONJG(mat(ii,jj)) 
       else
         mat(ii,ii) = CMPLX(REAL(mat(ii,ii)),0.0_sp)
       end if
     end do
   end do
                                                      
 case ("L","l") ! Only the lower triangle is used.
  do jj=1,nn
    do ii=1,jj
      if (ii/=jj) then
        mat(ii,jj) = CONJG(mat(jj,ii)) 
      else
        mat(ii,ii) = CMPLX(REAL(mat(ii,ii)),0.0_sp)
      end if
    end do
  end do
                                                      
 case default
   MSG_ERROR("Wrong uplo"//TRIM(uplo))
 end select

end subroutine hermitianize_spc 
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/hermitianize_dpc
!! NAME
!!  hermitianize_dpc
!!
!! FUNCTION
!!  Force a square matrix to be hermitian
!!
!! INPUTS
!!  uplo=String describing which part of the matrix has been calculated.
!!    Only the first character is tested (no case sensitive). Possible values are:
!!    "All"= Full matrix is supplied in input
!!    "Upper"=Upper triangle is in input. Lower triangle is reconstructed by symmetry.
!!    "Lower"=Lower triangle is in input. Upper triangle is reconstructed by symmetry.
!!
!! OUTPUT
!!  (see side effects)
!!
!! SIDE EFFECTS
!!  mat(:,:)=complex input matrix, hermitianized in output
!!
!! CHILDREN
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine hermitianize_dpc(mat,uplo)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'hermitianize_dpc'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=*),intent(in) :: uplo
!arrays
 complex(dpc),intent(inout) :: mat(:,:)

!Local variables-------------------------------
!scalars
 integer :: nn,ii,jj
!arrays
 complex(dpc),allocatable :: tmp(:)
! *************************************************************************
 
 nn=assert_eq(SIZE(mat,1),SIZE(mat,2),'Matrix not square',&
& __FILE__,__LINE__)

 select case (uplo(1:1))

 case ("A","a") ! Full matrix has been calculated.
   ABI_MALLOC(tmp,(nn))
   do ii=1,nn
     do jj=ii,nn
       tmp(jj)=half*(mat(ii,jj)+DCONJG(mat(jj,ii)))
     end do
     mat(ii,ii:nn)=tmp(ii:nn)
     mat(ii:nn,ii)=DCONJG(tmp(ii:nn))
   end do
   ABI_FREE(tmp)

 case ("U","u") ! Only the upper triangle is used.
   do jj=1,nn
     do ii=1,jj
       if (ii/=jj) then
         mat(jj,ii) = DCONJG(mat(ii,jj)) 
       else
         mat(ii,ii) = DCMPLX(DBLE(mat(ii,ii)),zero)
       end if
     end do
   end do

 case ("L","l") ! Only the lower triangle is used.
  do jj=1,nn
    do ii=1,jj
      if (ii/=jj) then
        mat(ii,jj) = DCONJG(mat(jj,ii)) 
      else
        mat(ii,ii) = DCMPLX(REAL(mat(ii,ii)),zero)
      end if
    end do
  end do

 case default
   MSG_ERROR("Wrong uplo"//TRIM(uplo))
 end select

end subroutine hermitianize_dpc 
!!***

!----------------------------------------------------------------------

!!****f* ABINIT/mkherm
!! NAME
!! mkherm
!!
!! FUNCTION
!! Make the complex array(ndim,ndim) hermitian,
!! by adding half of it to its hermitian conjugate.
!!
!! INPUTS
!! ndim=dimension of the matrix
!! array= complex matrix
!!
!! SIDE EFFECTS
!! array= hermitian matrix made by adding half of array to its hermitian conjugate
!!
!! PARENTS
!!      anaddb,dfpt_phfrq,m_ddb,m_phgamma
!!
!! CHILDREN
!!
!! SOURCE

pure subroutine mkherm(array,ndim)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'mkherm'
!End of the abilint section

 implicit none

!Arguments -------------------------------
!scalars
 integer,intent(in) :: ndim
!arrays
 real(dp),intent(inout) :: array(2,ndim,ndim)

!Local variables -------------------------
!scalars
 integer :: i1,i2

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

 do i1=1,ndim
   do i2=1,i1
     array(1,i1,i2)=(array(1,i1,i2)+array(1,i2,i1))*half
     array(2,i1,i2)=(array(2,i1,i2)-array(2,i2,i1))*half
     array(1,i2,i1)=array(1,i1,i2)
     array(2,i2,i1)=-array(2,i1,i2)
   end do
 end do

end subroutine mkherm
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/symmetrize_spc
!! NAME
!!  symmetrize_spc
!!
!! FUNCTION
!!  Force a square matrix to be symmetric.
!!
!! INPUTS
!!  uplo=String describing which part of the matrix has been calculated.
!!    Only the first character is tested (no case sensitive). Possible values are:
!!    "All"= Full matrix is supplied in input
!!    "Upper"=Upper triangle is in input. Lower triangle is reconstructed by symmetry.
!!    "Lower"=Lower triangle is in input. Upper triangle is reconstructed by symmetry.
!!
!! OUTPUT
!!  (see side effects)
!!
!! SIDE EFFECTS
!!  mat(:,:)=complex input matrix, symmetrized at output
!!
!! CHILDREN
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine symmetrize_spc(mat,uplo)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'symmetrize_spc'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=*),intent(in) :: uplo
!arrays
 complex(spc),intent(inout) :: mat(:,:)

!Local variables-------------------------------
!scalars
 integer :: nn,ii,jj
!arrays
 complex(spc),allocatable :: tmp(:)
! *************************************************************************
 
 nn=assert_eq(SIZE(mat,1),SIZE(mat,2),'Matrix not square',&
& __FILE__,__LINE__)

 select case (uplo(1:1))

 case ("A","a") ! Full matrix has been calculated.
   ABI_MALLOC(tmp,(nn))
   do ii=1,nn
     do jj=ii,nn
       tmp(jj)=half*(mat(ii,jj)+mat(jj,ii))
     end do
     mat(ii,ii:nn)=tmp(ii:nn)
     mat(ii:nn,ii)=tmp(ii:nn)
   end do
   ABI_FREE(tmp)

 case ("U","u") ! Only the upper triangle is used.
   do jj=1,nn
     do ii=1,jj-1
       mat(jj,ii) = mat(ii,jj)
     end do
   end do
                                                      
 case ("L","l") ! Only the lower triangle is used.
  do jj=1,nn
    do ii=1,jj-1
      mat(ii,jj) = mat(jj,ii)
    end do
  end do
                                                      
 case default
   MSG_ERROR("Wrong uplo"//TRIM(uplo))
 end select

end subroutine symmetrize_spc 
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/symmetrize_dpc
!! NAME
!!  symmetrize_dpc
!!
!! FUNCTION
!!  Force a square matrix to be symmetric.
!!
!! INPUTS
!!  uplo=String describing which part of the matrix has been calculated.
!!    Only the first character is tested (no case sensitive). Possible values are:
!!    "All"= Full matrix is supplied in input
!!    "Upper"=Upper triangle is in input. Lower triangle is reconstructed by symmetry.
!!    "Lower"=Lower triangle is in input. Upper triangle is reconstructed by symmetry.
!!
!! OUTPUT
!!  (see side effects)
!!
!! SIDE EFFECTS
!!  mat(:,:)=complex input matrix, symmetrized in output
!!
!! CHILDREN
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine symmetrize_dpc(mat,uplo)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'symmetrize_dpc'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=*),intent(in) :: uplo
!arrays
 complex(dpc),intent(inout) :: mat(:,:)

!Local variables-------------------------------
!scalars
 integer :: nn,ii,jj
!arrays
 complex(dpc),allocatable :: tmp(:)
! *************************************************************************
 
 nn=assert_eq(SIZE(mat,1),SIZE(mat,2),'Matrix not square',&
& __FILE__,__LINE__)

 select case (uplo(1:1))

 case ("A","a") ! Full matrix has been calculated.
   ABI_MALLOC(tmp,(nn))
   do ii=1,nn
     do jj=ii,nn
       tmp(jj)=half*(mat(ii,jj)+mat(jj,ii))
     end do
     mat(ii,ii:nn)=tmp(ii:nn)
     mat(ii:nn,ii)=tmp(ii:nn)
   end do
   ABI_FREE(tmp)

 case ("U","u") ! Only the upper triangle is used.
   do jj=1,nn
     do ii=1,jj-1
       mat(jj,ii) = mat(ii,jj)
     end do
   end do

 case ("L","l") ! Only the lower triangle is used.
  do jj=1,nn
    do ii=1,jj-1
      mat(ii,jj) = mat(jj,ii)
    end do
  end do

 case default
   MSG_ERROR("Wrong uplo"//TRIM(uplo))
 end select

end subroutine symmetrize_dpc 
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/print_arr1d_spc
!! NAME
!!  print_arr1d_spc
!!
!! FUNCTION
!! Print an array using a nice (?) format
!!
!! INPUTS
!!  arr(:)=vector/matrix to be printed
!!  mode_paral(optional)=parallel mode, DEFAULT is "COLL"
!!   "COLL" if all procs are calling the routine with the same message to be written only once
!!   "PERS" if the procs are calling the routine with different mesgs each to be written, 
!!          or if one proc is calling the routine
!!  unit(optional)=the unit number of the file, DEFAULT=std_out
!!  max_r,max_c(optional)=Max number of rows and columns to be printed 
!!   (DEFAULT is 9, output format assumes to be less that 99, but there might be 
!!    problems with wrtout if message size exceeds 500 thus max number of elements should be ~60)
!!
!! OUTPUT
!!  (only printing)
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine print_arr1d_spc(arr,max_r,unit,mode_paral)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'print_arr1d_spc'
 use interfaces_14_hidewrite
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,optional,intent(in) :: unit,max_r
 character(len=4),optional,intent(in) :: mode_paral
!arrays
 complex(spc),intent(in) :: arr(:)

!Local variables-------------------------------
!scalars
 integer :: unt,ii,nr,mr
 character(len=4) :: mode
 character(len=500) :: msg
 character(len=100) :: fmth,fmt1
! *************************************************************************

 unt=std_out ; if (PRESENT(unit      )) unt=unit
 mode='COLL' ; if (PRESENT(mode_paral)) mode=mode_paral
 mr=15       ; if (PRESENT(max_r     )) mr=max_r
 
 if (mode/='COLL'.and.mode/='PERS') then 
  write(msg,'(2a)')' Wrong value of mode_paral ',mode
  MSG_BUG(msg)
 end if 
 !
 ! === Print out matrix ===
 nr=SIZE(arr,DIM=1) ; if (mr>nr) mr=nr

 write(fmth,*)'(6x,',mr,'(i2,6x))'
 write(fmt1,*)'(3x,',mr,'f8.3)'

 write(msg,fmth)(ii,ii=1,mr)     
 call wrtout(unt,msg,mode) !header
 write(msg,fmt1)REAL (arr(1:mr)) 
 call wrtout(unt,msg,mode) !real part
 write(msg,fmt1)AIMAG(arr(1:mr)) 
 call wrtout(unt,msg,mode) !imag part

end subroutine print_arr1d_spc
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/print_arr1d_dpc
!! NAME
!!  print_arr1d_dpc
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine print_arr1d_dpc(arr,max_r,unit,mode_paral)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'print_arr1d_dpc'
 use interfaces_14_hidewrite
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,optional,intent(in) :: unit,max_r
 character(len=4),optional,intent(in) :: mode_paral
!arrays
 complex(dpc),intent(in) :: arr(:)

!Local variables-------------------------------
!scalars
 integer :: unt,ii,nr,mr
 character(len=4) :: mode
 character(len=500) :: msg
 character(len=100) :: fmth,fmt1
! *************************************************************************

 unt=std_out ; if (PRESENT(unit      )) unt=unit
 mode='COLL' ; if (PRESENT(mode_paral)) mode=mode_paral
 mr=15       ; if (PRESENT(max_r     )) mr=max_r
 
 if (mode/='COLL'.and.mode/='PERS') then 
  write(msg,'(2a)')' Wrong value of mode_paral ',mode
  MSG_BUG(msg)
 end if 
 !
 ! === Print out matrix ===
 nr=SIZE(arr,DIM=1) ; if (mr>nr) mr=nr

 write(fmth,*)'(6x,',mr,'(i2,6x))'
 write(fmt1,*)'(3x,',mr,'f8.3)'

 write(msg,fmth)(ii,ii=1,mr)     
 call wrtout(unt,msg,mode) !header
 write(msg,fmt1)REAL (arr(1:mr)) 
 call wrtout(unt,msg,mode) !real part
 write(msg,fmt1)AIMAG(arr(1:mr)) 
 call wrtout(unt,msg,mode) !imag part

end subroutine print_arr1d_dpc
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/print_arr2d_spc
!! NAME
!!  print_arr2d_spc
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine print_arr2d_spc(arr,max_r,max_c,unit,mode_paral)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'print_arr2d_spc'
 use interfaces_14_hidewrite
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,optional,intent(in) :: unit,max_r,max_c
 character(len=4),optional,intent(in) :: mode_paral
!arrays
 complex(spc),intent(in) :: arr(:,:)

!Local variables-------------------------------
!scalars
 integer :: unt,ii,jj,nc,nr,mc,mr
 character(len=4) :: mode
 character(len=500) :: msg
 character(len=100) :: fmth,fmt1,fmt2
! *************************************************************************

 unt =std_out; if (PRESENT(unit      )) unt =unit
 mode='COLL' ; if (PRESENT(mode_paral)) mode=mode_paral
 mc  =9      ; if (PRESENT(max_c     )) mc  =max_c
 mr  =9      ; if (PRESENT(max_r     )) mr  =max_r
 
 if (mode/='COLL'.and.mode/='PERS') then 
   write(msg,'(2a)')'Wrong value of mode_paral ',mode
   MSG_BUG(msg)
 end if 
 !
 ! === Print out matrix ===
 nr=SIZE(arr,DIM=1); if (mr>nr) mr=nr
 nc=SIZE(arr,DIM=2); if (mc>nc) mc=nc

 write(fmth,*)'(6x,',mc,'(i2,6x))'
 write(fmt1,*)'(3x,i2,',mc,'f8.3)'
 write(fmt2,*)'(5x   ,',mc,'f8.3,a)'

 write(msg,fmth)(jj,jj=1,mc) 
 call wrtout(unt,msg,mode) !header
 do ii=1,mr
   write(msg,fmt1)ii,REAL(arr(ii,1:mc))      
   call wrtout(unt,msg,mode) !real part
   write(msg,fmt2)  AIMAG(arr(ii,1:mc)),ch10 
   call wrtout(unt,msg,mode) !imag part
 end do

end subroutine print_arr2d_spc
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/print_arr2d_dpc
!! NAME
!!  print_arr2d_dpc
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine print_arr2d_dpc(arr,max_r,max_c,unit,mode_paral)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'print_arr2d_dpc'
 use interfaces_14_hidewrite
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,optional,intent(in) :: unit,max_r,max_c
 character(len=4),optional,intent(in) :: mode_paral
!arrays
 complex(dpc),intent(in) :: arr(:,:)

!Local variables-------------------------------
!scalars
 integer :: unt,ii,jj,nc,nr,mc,mr
 character(len=4) :: mode
 character(len=500) :: msg
 character(len=100) :: fmth,fmt1,fmt2
! *************************************************************************

 unt =std_out; if (PRESENT(unit      )) unt =unit
 mode='COLL' ; if (PRESENT(mode_paral)) mode=mode_paral
 mc  =9      ; if (PRESENT(max_c     )) mc  =max_c
 mr  =9      ; if (PRESENT(max_r     )) mr  =max_r
 
 if (mode/='COLL'.and.mode/='PERS') then 
   write(msg,'(2a)')'Wrong value of mode_paral ',mode
   MSG_BUG(msg)
 end if 
 !
 ! === Print out matrix ===
 nr=SIZE(arr,DIM=1); if (mr>nr) mr=nr
 nc=SIZE(arr,DIM=2); if (mc>nc) mc=nc

 write(fmth,*)'(6x,',mc,'(i2,6x))'
 write(fmt1,*)'(3x,i2,',mc,'f8.3)'
 write(fmt2,*)'(5x   ,',mc,'f8.3,a)'

 write(msg,fmth)(jj,jj=1,mc) 
 call wrtout(unt,msg,mode) !header
 do ii=1,mr
   write(msg,fmt1)ii,REAL(arr(ii,1:mc))      
   call wrtout(unt,msg,mode) !real part
   write(msg,fmt2)  AIMAG(arr(ii,1:mc)),ch10 
   call wrtout(unt,msg,mode) !imag part
 end do

end subroutine print_arr2d_dpc
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/pade
!! NAME
!!  pade
!!
!! FUNCTION
!!  Calculate the pade approximant in zz of the function f calculated at the n points z
!!
!! SOURCE

function pade(n,z,f,zz)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'pade'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: n
 complex(dpc),intent(in) :: zz
 complex(dpc) :: pade
!arrays
 complex(dpc),intent(in) :: z(n),f(n)

!Local variables-------------------------------
!scalars
 complex(dpc) :: a(n)
 complex(dpc) :: Az(0:n), Bz(0:n)
 integer :: i
! *************************************************************************

 call calculate_pade_a(a,n,z,f)

 Az(0)=czero
 Az(1)=a(1)
 Bz(0)=cone
 Bz(1)=cone

 do i=1,n-1
   Az(i+1)=Az(i)+(zz-z(i))*a(i+1)*Az(i-1)
   Bz(i+1)=Bz(i)+(zz-z(i))*a(i+1)*Bz(i-1)
 end do
 !write(std_out,*) 'Bz(n)',Bz(n)
 if (REAL(Bz(n))==zero.and.AIMAG(Bz(n))==zero) write(std_out,*) ' Bz(n) ',Bz(n)
 pade=Az(n)/Bz(n)
 !write(std_out,*) 'pade_approx ', pade_approx

end function pade
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/dpade
!! NAME
!!  dpade
!!
!! FUNCTION
!!  Calculate the derivative of the pade approximant in zz of the function f calculated at the n points z
!!
!! SOURCE

function dpade(n,z,f,zz)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'dpade'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: n
 complex(dpc),intent(in) :: zz
 complex(dpc) :: dpade
!arrays
 complex(dpc),intent(in) :: z(n),f(n)

!Local variables-------------------------------
!scalars
 integer :: i
!arrays
 complex(dpc) :: a(n)
 complex(dpc) :: Az(0:n), Bz(0:n)
 complex(dpc) :: dAz(0:n), dBz(0:n)
! *************************************************************************

 call calculate_pade_a(a,n,z,f)

 Az(0)=czero
 Az(1)=a(1)
 Bz(0)=cone
 Bz(1)=cone
 dAz(0)=czero
 dAz(1)=czero
 dBz(0)=czero
 dBz(1)=czero

 do i=1,n-1
   Az(i+1)=Az(i)+(zz-z(i))*a(i+1)*Az(i-1)
   Bz(i+1)=Bz(i)+(zz-z(i))*a(i+1)*Bz(i-1)
   dAz(i+1)=dAz(i)+a(i+1)*Az(i-1)+(zz-z(i))*a(i+1)*dAz(i-1)
   dBz(i+1)=dBz(i)+a(i+1)*Bz(i-1)+(zz-z(i))*a(i+1)*dBz(i-1)
 end do
 !write(std_out,*) 'Bz(n)', Bz(n)
 if (REAL(Bz(n))==zero.and.AIMAG(Bz(n))==zero) write(std_out,*) 'Bz(n)',Bz(n)
 !pade_approx = Az(n) / Bz(n)
 dpade=dAz(n)/Bz(n) -Az(n)*dBz(n)/(Bz(n)*Bz(n))
 !write(std_out,*) 'pade_approx ', pade_approx

end function dpade
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/calculate_pade_a
!! NAME
!!  calculate_pade_a
!!
!! FUNCTION
!!
!! INPUTS
!!
!! OUTPUT
!!
!! PARENTS
!!      m_numeric_tools
!!
!! CHILDREN
!!
!! SOURCE

subroutine calculate_pade_a(a,n,z,f)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'calculate_pade_a'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: n
 complex(dpc),intent(in) :: z(n),f(n)
 complex(dpc),intent(out) :: a(n)

!Local variables-------------------------------
!scalars
 integer :: i,j
!arrays
 complex(dpc) :: g(n,n)
! *************************************************************************

 g(1,1:n)=f(1:n)
  
 do i=2,n
   do j=i,n
     if (REAL(g(i-1,j))==zero.and.AIMAG(g(i-1,j))==zero) write(std_out,*) 'g_i(z_j)',i,j,g(i,j)
     g(i,j)=(g(i-1,i-1)-g(i-1,j)) / ((z(j)-z(i-1))*g(i-1,j))
     !write(std_out,*) 'g_i(z_j)',i,j,g(i,j)
   end do
 end do
 do i=1,n
   a(i)=g(i,i)
 end do
 !write(std_out,*) 'a ',a(:)

end subroutine calculate_pade_a
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/newrap_step 
!! NAME
!!  newrap_step
!!
!! FUNCTION
!!  Apply single step newton-raphson method to find the root of a complex function 
!!   z_k+1=z_k-f(z_k)/(df/dz(z_k)) 
!!
!! SOURCE

function newrap_step(z,f,df)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'newrap_step'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 complex(dpc),intent(in) :: z,f,df
 complex(dpc) :: newrap_step

!Local variables-------------------------------
!scalars
 real(dp) :: dfm2
! *************************************************************************

 dfm2=ABS(df)*ABS(df)

 newrap_step= z - (f*CONJG(df))/dfm2
 !& z-one/(ABS(df)*ABS(df)) * CMPLX( REAL(f)*REAL(df)+AIMAG(f)*AIMAG(df), -REAL(f)*AIMAG(df)+AIMAG(f)*EAL(df) )

end function newrap_step 
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/cross_product_int
!! NAME
!!  cross_product_int
!!
!! FUNCTION
!!  Return the cross product of two vectors with integer components.
!!
pure function cross_product_int(vec1,vec2) result(res)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'cross_product_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 integer,intent(in) :: vec1(3),vec2(3)
 integer :: res(3)
! *************************************************************************

 res(1)=vec1(2)*vec2(3)-vec1(3)*vec2(2)
 res(2)=vec1(3)*vec2(1)-vec1(1)*vec2(3)
 res(3)=vec1(1)*vec2(2)-vec1(2)*vec2(1)

end function cross_product_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/cross_product_rdp
!! NAME
!!  cross_product_rdp
!!
!! FUNCTION
!!  Return the cross product of two vectors with real double precision components.
!!
pure function cross_product_rdp(vec1,vec2) result(res)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'cross_product_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 real(dp),intent(in) :: vec1(3),vec2(3)
 real(dp) :: res(3)
! *************************************************************************

 res(1)=vec1(2)*vec2(3)-vec1(3)*vec2(2)
 res(2)=vec1(3)*vec2(1)-vec1(1)*vec2(3)
 res(3)=vec1(1)*vec2(2)-vec1(2)*vec2(1)

end function cross_product_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/l2norm_rdp
!! NAME
!!  l2norm_rdp
!!
!! FUNCTION
!!  Return the length (ordinary L2 norm) of a vector.
!!

pure function l2norm_rdp(vec) result(res)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'l2norm_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
 real(dp),intent(in) :: vec(:)
 real(dp) :: res
! *************************************************************************

 res=SQRT(DOT_PRODUCT(vec,vec))

end function l2norm_rdp
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/remove_copies
!! NAME
!!  remove_copies
!!
!! FUNCTION
!!  Given an initial set of elements, set_in, return the subset of inequivalent items
!!  packed in the firt n_out positions of set_in. Use the logical function is_equal 
!!  to define whether two items are equivalent.
!!
!! INPUTS
!! n_in=Initial number of elements.
!! is_equal=logical function used to discern if two items are equal.
!!
!! OUTPUT
!! n_out=Number of inequivalent items found.
!!
!! SIDE EFFECTS
!! set_in(3,n_in)=
!!  In input the initial set of n_in elements
!!  In output set_in(3,1:n_out) contains the inequivalent elements found.
!!
!! NOTES
!! The routines only deals with arrays of 3D-vectors although generalizing the 
!! algorithm to nD-space is straightforward. 
!!
!! PARENTS
!!      m_io_screening
!!
!! CHILDREN
!!
!! SOURCE

subroutine remove_copies(n_in,set_in,n_out,is_equal)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'remove_copies'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: n_in
 integer,intent(out) :: n_out

!arrays 
 real(dp),target,intent(inout) :: set_in(3,n_in)

 interface
   function is_equal(k1,k2)
     use defs_basis
     real(dp),intent(in) :: k1(3),k2(3)
     logical :: is_equal
   end function is_equal
 end interface

!Local variables-------------------------------
!scalars
 integer :: ii,jj
 logical :: isnew
!arrays
 type rdp1d_pt
  integer :: idx
  real(dp),pointer :: rpt(:) 
 end type rdp1d_pt
 type(rdp1d_pt),allocatable :: Ap(:)

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

 ABI_DATATYPE_ALLOCATE(Ap,(n_in))
 Ap(1)%idx = 1
 Ap(1)%rpt => set_in(:,1)

 n_out=1
 do ii=2,n_in

   isnew=.TRUE.
   do jj=1,n_out
     if (is_equal(set_in(:,ii),Ap(jj)%rpt(:))) then 
       isnew=.FALSE.
       exit
     end if
   end do

   if (isnew) then
     n_out=n_out+1
     Ap(n_out)%rpt => set_in(:,ii)
     Ap(n_out)%idx = ii
   end if
 end do

 ! The n_out inequivalent items are packed first.
 if (n_out/=n_in) then
   do ii=1,n_out
     jj=Ap(ii)%idx
     set_in(:,ii) = set_in(:,jj)
     !write(std_out,*) Ap(ii)%idx,Ap(ii)%rpt(:) 
   end do
 end if

 ABI_DATATYPE_DEALLOCATE(Ap)

end subroutine remove_copies
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/denominator
!! NAME
!!   denominator
!!
!! FUNCTION
!!  Return the denominator of the rational number dd, sign is not considered.
!!
!! INPUTS
!!  dd=The rational number
!!  tolerance=Absolute tolerance
!! 
!! OUTPUT 
!!  ierr=If /=0  the input number is not rational within the given tolerance.
!!
!! SOURCE

integer function denominator(dd,ierr,tolerance)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'denominator'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(out) :: ierr
 real(dp),intent(in) :: dd
 real(dp),optional,intent(in) :: tolerance

!Local variables ------------------------------
!scalars
 integer,parameter :: largest_integer = HUGE(1)
 integer :: ii
 real(dp) :: my_tol

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

 ii=1
 my_tol=0.0001 ; if (PRESENT(tolerance)) my_tol=ABS(tolerance)
 do
   if (ABS(dd*ii-NINT(dd*ii))<my_tol) then
     denominator=ii
     ierr=0
     RETURN
   end if
   ! Handle the case in which dd is not rational within my_tol.
   if (ii==largest_integer) then
     denominator=ii
     ierr=-1
     RETURN
   end if
   ii=ii+1
 end do

end function denominator 
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/mincm
!! NAME
!!  mincm
!!
!! FUNCTION
!!  Return the minimum common multiple of ii and jj.
!!
!! SOURCE

integer function mincm(ii,jj)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'mincm'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: ii,jj

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

 if (ii==0.or.jj==0) then 
   MSG_BUG('ii==0 or jj==0')
 end if
 
 mincm=MAX(ii,jj)
 do
   if ( ((mincm/ii)*ii)==mincm .and. ((mincm/jj)*jj)==mincm ) RETURN
   mincm=mincm+1
 end do

end function mincm
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/continued_fract
!! NAME
!!  continued_fract
!!
!! FUNCTION
!!  This routine calculates the continued fraction:
!!  
!!                        1
!! f(z) =  _______________________________
!!           z - a1 -        b1^2
!!                   _____________________
!!                     z - a2 -    b2^2
!!                             ___________
!!                                z -a3 -    ........
!!
!! INPUTS
!!  nlev=Number of "levels" in the continued fraction.
!!  term_type=Type of the terminator.
!!    0 --> No terminator.
!!   -1 --> Assume constant coefficients for a_i and b_i for i>nlev with a_inf = a(nlev) and b_inf = b(nleb) 
!!    1 --> Same as above but a_inf and b_inf are obtained by averaging over the nlev values.
!!  aa(nlev)=Set of a_i coefficients.
!!  bb(nlev)=Set of b_i coefficients.
!!  nz=Number of points on the z-mesh.
!!  zpts(nz)=z-mesh.
!!
!! OUTPUT
!!  spectrum(nz)=Contains f(z) on the input mesh.
!!
!! PARENTS
!!      bsepostproc,m_haydock
!!
!! CHILDREN
!!
!! SOURCE

subroutine continued_fract(nlev,term_type,aa,bb,nz,zpts,spectrum)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'continued_fract'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nlev,term_type,nz
!arrays
 real(dp),intent(in) ::  bb(nlev)
 complex(dpc),intent(in) :: aa(nlev)
 complex(dpc),intent(in) :: zpts(nz)
 complex(dpc),intent(out) :: spectrum(nz)

!Local variables ------------------------------
!scalars
 integer :: it
 real(dp) ::  bb_inf,bg,bu,swap
 complex(dpc) :: aa_inf
 character(len=500) :: msg
!arrays
 complex(dpc),allocatable :: div(:),den(:)

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

 ABI_MALLOC(div,(nz))
 ABI_MALLOC(den,(nz))

 select case (term_type)
 case (0) ! No terminator.
   div=czero
 case (-1,1) 
   if (term_type==-1) then
     bb_inf=bb(nlev)
     aa_inf=aa(nlev)
   else
     bb_inf=SUM(bb)/nlev
     aa_inf=SUM(aa)/nlev
   end if
   ! Be careful with the sign of the SQRT.
   div(:) = half*(bb(nlev)/(bb_inf))**2 * ( zpts-aa_inf - SQRT((zpts-aa_inf)**2 - four*bb_inf**2) )
 case (2) 
   MSG_ERROR("To be tested")
   div = zero
   if (nlev>4) then
     bg=zero; bu=zero
     do it=1,nlev,2  
       if (it+2<nlev) bg = bg + bb(it+2)
       bu = bu + bb(it)
     end do
     bg = bg/(nlev/2+MOD(nlev,2))
     bu = bg/((nlev+1)/2)
     !if (iseven(nlev)) then
     if (.not.iseven(nlev)) then
       swap = bg
       bg = bu 
       bu = bg
     end if
     !write(std_out,*)nlev,bg,bu
     !Here be careful with the sign of SQRT
     do it=1,nz
       div(it) = half/zpts(it) * (bb(nlev)/bu)**2 * &
&        ( (zpts(it)**2 +bu**2 -bg**2) - SQRT( (zpts(it)**2+bu**2-bg**2)**2 -four*(zpts(it)*bu)**2) )
     end do
   end if

 case default
   write(msg,'(a,i0)')" Wrong value for term_type : ",term_type
   MSG_ERROR(msg)
 end select

 do it=nlev,2,-1
   den(:) = zpts(:) - aa(it) - div(:)
   div(:) = (bb(it-1)**2 )/ den(:)
 end do
                                                                  
 den = zpts(:) - aa(1) - div(:)
 div = one/den(:)

 spectrum = div
 ABI_FREE(div)
 ABI_FREE(den)

end subroutine continued_fract
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/cmplx_sphcart
!! NAME
!! cmplx_sphcart
!!
!! FUNCTION
!! Convert an array of complex values stored in spherical coordinates
!! to Cartesian coordinates with real and imaginary part or vice versa.
!!
!! INPUTS
!!  from=Option specifying the format used to store the complex values. See below.
!!  [units]=Option to specify if angles are given in  "Radians" (default) or "Degrees". 
!!
!! SIDE EFFECTS 
!!  carr(:,:):
!!    input:  array with complex values in Cartesian form if from="C" or spherical form if from="S"
!!    output: array with values converted to the new representation.
!!
!! PARENTS
!!      m_ptgroups
!!
!! CHILDREN
!!
!! SOURCE

subroutine cmplx_sphcart(carr, from, units)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'cmplx_sphcart'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 character(len=*),intent(in) :: from
 character(len=*),optional,intent(in) :: units
!arrays
 complex(dpc),intent(inout) :: carr(:,:)

!Local variables-------------------------------
!scalars
 integer :: jj,ii
 real(dp) :: rho,theta,fact
 character(len=500) :: msg

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

 select case (from(1:1))

 case ("S","s") ! Spherical --> Cartesian

   fact = one
   if (PRESENT(units)) then
     if (units(1:1) == "D" .or. units(1:1) == "d") fact = two_pi/360_dp
   end if

   do jj=1,SIZE(carr,DIM=2)
     do ii=1,SIZE(carr,DIM=1)
        rho  = DBLE(carr(ii,jj))
        theta= AIMAG(carr(ii,jj)) * fact
        carr(ii,jj) = DCMPLX(rho*DCOS(theta), rho*DSIN(theta))
     end do
   end do

 case ("C","c") ! Cartesian --> Spherical \theta = 2 arctan(y/(rho+x))

   fact = one
   if (PRESENT(units)) then
     if (units(1:1) == "D" .or. units(1:1) == "d") fact = 360_dp/two_pi
   end if

   do jj=1,SIZE(carr,DIM=2)
     do ii=1,SIZE(carr,DIM=1)
        rho  = SQRT(ABS(carr(ii,jj)))
        if (rho > tol16) then
          theta= two * ATAN( AIMAG(carr(ii,jj)) / (DBLE(carr(ii,jj)) + rho) )
        else
          theta= zero
        end if
        carr(ii,jj) = DCMPLX(rho, theta*fact)
     end do
   end do

 case default
   msg = " Wrong value for from: "//TRIM(from)
   MSG_BUG(msg)
 end select

end subroutine cmplx_sphcart
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/pfactorize
!! NAME
!!  pfactorize
!!
!! FUNCTION
!!  Factorize a number in terms of an user-specified set of prime factors
!!  nn = alpha * Prod_i p^i   1)
!!
!! INPUTS
!!  nn=The number to be factorized.
!!  nfactors=The number of factors
!!  pfactors(nfactors)=The list of prime number e.g. (/ 2, 3, 5, 7, 11 /)
!!
!! OUTPUT
!!  powers(nfactors+1)=
!!   The first nfactors entries are the powers i in Eq.1. powers(nfactors+1) is alpha.
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

subroutine pfactorize(nn,nfactors,pfactors,powers)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'pfactorize'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn,nfactors
 integer,intent(in) :: pfactors(nfactors) 
 integer,intent(out) :: powers (nfactors+1)

!Local variables ------------------------------
!scalars
 integer :: tnn,ifc,fact,ipow,maxpwr

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

 powers=0; tnn=nn

 fact_loop: do ifc=1,nfactors
   fact = pfactors (ifc)
   maxpwr = NINT ( LOG(DBLE(tnn))/LOG(DBLE(fact) ) ) + 1
   do ipow=1,maxpwr
     if (tnn==1) EXIT fact_loop
     if ( MOD(tnn,fact)==0 ) then
       tnn=tnn/fact
       powers(ifc)=powers(ifc) + 1
     end if
   end do
 end do fact_loop

 if ( nn /= tnn * PRODUCT( pfactors**powers(1:nfactors)) ) then
   MSG_BUG('nn/=tnn!')
 end if

 powers(nfactors+1) = tnn

end subroutine pfactorize
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/isordered
!! NAME
!!  isordered
!!
!! FUNCTION
!!  Return .TRUE. if values in array arr are ordered.
!!  Consider that two double precision numbers within tolerance tol are equal.
!!
!! INPUTS
!!  nn=Size of arr.
!!  arr(nn)=The array with real values to be tested.
!!  direction= ">" for ascending numerical order.
!!             ">" for decreasing numerical order.
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

function isordered_rdp(nn,arr,direction,tol) result(isord)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'isordered_rdp'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: nn
 real(dp),intent(in) :: tol
 logical :: isord
 character(len=*),intent(in) :: direction
!arrays
 real(dp),intent(in) :: arr(nn)

!Local variables ------------------------------
!scalars
 integer :: ii
 real(dp) :: prev
 character(len=500) :: msg

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

 prev = arr(1); isord =.TRUE.

 SELECT CASE (direction(1:1))
 CASE(">")
 ii=2; 
 do while (ii<=nn .and. isord)
   if (ABS(arr(ii)-prev) > tol) isord = (arr(ii) >= prev)
   prev = arr(ii)
   ii = ii +1
 end do

 CASE("<")
 ii=2; 
 do while (ii<=nn .and. isord)
   if (ABS(arr(ii)-prev) > tol) isord = (arr(ii) <= prev)
   prev = arr(ii)
   ii = ii +1
 end do

 CASE DEFAULT
   msg = "Wrong direction: "//TRIM(direction)
   MSG_ERROR(msg)
 END SELECT


end function isordered_rdp
!!***

!----------------------------------------------------------------------


!!****f* m_numeric_tools/stats_eval
!! NAME
!!  stats_eval
!!
!! FUNCTION
!!  Helper function used to calculate the statistical parameters of a data set.
!!
!! INPUT
!!  arr(:)=Array with the values.
!!
!! OUTPUT
!!  stats<stats_t>=Data type storing the parameters of the data set.
!!
!! PARENTS
!!      m_shirley
!!
!! CHILDREN
!!
!! SOURCE

pure function stats_eval(arr) result(stats)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'stats_eval'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 type(stats_t) :: stats
!arrays
 real(dp),intent(in) :: arr(:)

!Local variables ------------------------------
!scalars
 integer :: ii,nn
 real(dp) :: xx,x2_sum

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

 !@stats_t
 stats%min   = +HUGE(one)
 stats%max   = -HUGE(one)
 stats%mean  = zero

 nn = SIZE(arr)

 do ii=1,nn
   xx = arr(ii)
   stats%max  = MAX(stats%max, xx)
   stats%min  = MIN(stats%min, xx)
   stats%mean = stats%mean + xx
 end do

 stats%mean  = stats%mean/nn

 ! Two-pass algorithm for the variance (more stable than the single-pass one).
 x2_sum = zero
 do ii=1,nn
   xx     = arr(ii)
   x2_sum = x2_sum + (xx - stats%mean)*(xx - stats%mean)
 end do

 if (nn>1) then 
   stats%stdev  = x2_sum/(nn-1)
   stats%stdev = SQRT(ABS(stats%stdev))
 else 
   stats%stdev = zero
 end if

end function stats_eval
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/wrap2_zero_one
!! NAME
!! wrap2_zero_one
!!
!! FUNCTION
!! Transforms a real number (num) in its corresponding reduced number
!! (red) in the interval [0,1[ where 1 is not included (tol12)
!! num=red+shift
!!
!! INPUTS
!!  num=real number
!!
!! OUTPUT
!! red=reduced number of num in the interval [0,1[ where 1 is not included
!! shift=num-red
!!
!! PARENTS
!!      exc_plot,k_neighbors,lin_interpq_gam,m_nesting,m_paw_pwaves_lmn
!!      pawmkaewf
!!
!! CHILDREN
!!
!! SOURCE

elemental subroutine wrap2_zero_one(num,red,shift)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'wrap2_zero_one'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: num
 real(dp),intent(out) :: red,shift

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

 if (num>zero) then
   red=mod((num+tol12),one)-tol12
 else
   red=-mod(-(num-one+tol12),one)+one-tol12
 end if
 if(abs(red)<tol12)red=0.0_dp
 shift=num-red

end subroutine wrap2_zero_one
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/wrap2_pmhalf
!! NAME
!! wrap2_pmhalf
!!
!! FUNCTION
!! Transforms a real number (num) in its corresponding reduced number
!! (red) in the interval ]-1/2,1/2] where -1/2 is not included (tol12)
!! num=red+shift
!!
!! INPUTS
!! num=real number
!!
!! OUTPUT
!! red=reduced number of num in the interval ]-1/2,1/2] where -1/2 is not included
!! shift=num-red
!!
!! PARENTS
!!      canat9,dist2,elphon,ep_setupqpt,get_full_kgrid,interpolate_gkk
!!      m_bz_mesh,m_cprj_bspline,m_gamma,m_io_gkk,m_optic_tools,m_shirley
!!      mkfskgrid,mkfsqgrid,mkph_linwid,mkphbs,order_fs_kpts,printvtk,read_gkk
!!      smpbz,littlegroup_q
!!
!! CHILDREN
!!
!! SOURCE

elemental subroutine wrap2_pmhalf(num,red,shift)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'wrap2_pmhalf'
!End of the abilint section

 implicit none

!Arguments -------------------------------
!scalars
 real(dp),intent(in) :: num
 real(dp),intent(out) :: red,shift

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

 if (num>zero) then
   red=mod((num+half-tol12),one)-half+tol12
 else
   red=-mod(-(num-half-tol12),one)+half+tol12
 end if
 if(abs(red)<tol12)red=0.0d0
 shift=num-red

end subroutine wrap2_pmhalf
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/interpol3d
!! NAME
!! interpol3d
!!
!! FUNCTION
!! Computes the value at any point r by linear interpolation
!! inside the eight vertices of the surrounding cube
!! r is presumed to be normalized, in a unit cube for the full grid
!!
!! INPUTS
!! r(3)=point coordinate
!! nr1=grid size along x
!! nr2=grid size along y
!! nr3=grid size along z
!! grid(nr1,nr2,nr3)=grid matrix
!!
!! OUTPUT
!! res=Interpolated value
!!
!! PARENTS
!!      integrate_gamma_alt,lin_interpq_gam,lineint,m_nesting,m_qparticles
!!      planeint,pointint,volumeint
!!
!! CHILDREN
!!
!! SOURCE

pure function interpol3d(r,nr1,nr2,nr3,grid) result(res)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'interpol3d'
!End of the abilint section

 implicit none

!Arguments-------------------------------------------------------------
!scalars
 integer,intent(in) :: nr1,nr2,nr3
 real(dp) :: res
!arrays
 real(dp),intent(in) :: grid(nr1,nr2,nr3),r(3)

!Local variables--------------------------------------------------------
!scalars
 integer :: ir1,ir2,ir3,pr1,pr2,pr3
 real(dp) :: x1,x2,x3

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

 call interpol3d_indices (r,nr1,nr2,nr3,ir1,ir2,ir3, pr1,pr2,pr3)

!weight 
 x1=one+r(1)*nr1-real(ir1)
 x2=one+r(2)*nr2-real(ir2)
 x3=one+r(3)*nr3-real(ir3)

!calculation of the density value
 res=zero
 res=res + grid(ir1,ir2,ir3)*(one-x1)*(one-x2)*(one-x3)
 res=res + grid(pr1,ir2,ir3)*x1*(one-x2)*(one-x3)
 res=res + grid(ir1,pr2,ir3)*(one-x1)*x2*(one-x3)
 res=res + grid(ir1,ir2,pr3)*(one-x1)*(one-x2)*x3
 res=res + grid(pr1,pr2,ir3)*x1*x2*(one-x3)
 res=res + grid(ir1,pr2,pr3)*(one-x1)*x2*x3
 res=res + grid(pr1,ir2,pr3)*x1*(one-x2)*x3
 res=res + grid(pr1,pr2,pr3)*x1*x2*x3

end function interpol3d
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/interpol3d_indices
!! NAME
!! interpol3d_indices
!!
!! FUNCTION
!! Computes the indices in a cube which are neighbors to the point to be
!!  interpolated in interpol3d
!!
!! INPUTS
!! r(3)=point coordinate
!! nr1=grid size along x
!! nr2=grid size along y
!! nr3=grid size along z
!!
!! OUTPUT
!! ir1,ir2,ir3 = bottom left neighbor
!! pr1,pr2,pr3 = top right neighbor
!!
!! PARENTS
!!      interpol3d,k_neighbors
!!
!! CHILDREN
!!
!! SOURCE

pure subroutine interpol3d_indices (r,nr1,nr2,nr3,ir1,ir2,ir3,pr1,pr2,pr3)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'interpol3d_indices'
!End of the abilint section

 implicit none

!Arguments-------------------------------------------------------------
!scalars
 integer,intent(in) :: nr1,nr2,nr3
 integer,intent(out) :: ir1,ir2,ir3
 integer,intent(out) :: pr1,pr2,pr3
!arrays
 real(dp),intent(in) :: r(3)

!Local variables-------------------------------
 real(dp) :: d1,d2,d3

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

!grid density
 d1=one/nr1
 d2=one/nr2
 d3=one/nr3

!lower left
 ir1=int(r(1)/d1)+1
 ir2=int(r(2)/d2)+1
 ir3=int(r(3)/d3)+1

!upper right
 pr1=mod(ir1+1,nr1)
 pr2=mod(ir2+1,nr2)
 pr3=mod(ir3+1,nr3)

 if(ir1==0) ir1=nr1
 if(ir2==0) ir2=nr2
 if(ir3==0) ir3=nr3 

 if(ir1>nr1) ir1=ir1-nr1
 if(ir2>nr2) ir2=ir2-nr2
 if(ir3>nr3) ir3=ir3-nr3

 if(pr1==0) pr1=nr1
 if(pr2==0) pr2=nr2
 if(pr3==0) pr3=nr3

end subroutine interpol3d_indices
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/simpson_int
!! NAME
!! simpson_int
!!
!! FUNCTION
!!   Simpson integral of input function
!!
!! INPUTS
!!  npts=max number of points on grid for integral
!!  step = space between integral arguments
!!  values(npts)=integrand function.
!!
!! OUTPUT
!!  int_values(npts)=integral of values.
!!
!! PARENTS
!!      eliashberg_1d,evdw_wannier,kramerskronig,m_ebands,m_exc_spectra
!!      m_numeric_tools,m_phgamma,m_phonons,m_xc_vdw,mka2f,mka2fQgrid,mka2f_tr
!!      mka2f_tr_lova,mlwfovlp_projpaw,mlwfovlp_radial,outscfcv,radsintr
!!
!! CHILDREN
!!
!! SOURCE

subroutine simpson_int(npts,step,values,int_values)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'simpson_int'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: npts
 real(dp),intent(in) :: step
!arrays
 real(dp),intent(in) :: values(npts)
 real(dp),intent(out) :: int_values(npts)

!Local variables -------------------------
!scalars
 integer :: ii
 real(dp),parameter :: coef1 = 0.375_dp                          !9.0_dp  / 24.0_dp
 real(dp),parameter :: coef2 = 1.166666666666666666666666667_dp  !28.0_dp / 24.0_dp
 real(dp),parameter :: coef3 = 0.958333333333333333333333333_dp  !23.0_dp / 24.0_dp
 character(len=500) :: msg

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

 if (npts < 6) then
   write(msg,"(a,i0)")"Number of points in integrand function must be >=6 while it is: ",npts
   MSG_ERROR(msg)
 end if

!-----------------------------------------------------------------
!Simpson integral of input function
!-----------------------------------------------------------------

!first point is 0: don t store it
!do integration equivalent to Simpson O(1/N^4) from NumRec in C p 134  NumRec in Fortran p 128
 int_values(1) =               coef1*values(1)
 int_values(2) = int_values(1) + coef2*values(2)
 int_values(3) = int_values(2) + coef3*values(3)

 do ii=4,npts-3
   int_values(ii) = int_values(ii-1) + values(ii)
 end do

 int_values(npts-2) = int_values(npts-3) + coef3*values(npts-2)
 int_values(npts-1) = int_values(npts-2) + coef2*values(npts-1)
 int_values(npts  ) = int_values(npts-1) + coef1*values(npts  )

 int_values(:) = int_values(:) * step

end subroutine simpson_int
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/simpson
!! NAME
!! simpson
!!
!! FUNCTION
!!   Simpson integral of input function
!!
!! INPUTS
!!  step = space between integral arguments
!!  values(npts)=integrand function.
!!
!! OUTPUT
!!  integral of values on the full mesh.
!!
!! PARENTS
!!
!! CHILDREN
!!
!! SOURCE

function simpson(step,values) result(res)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'simpson'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(in) :: step
 real(dp) :: res
!arrays
 real(dp),intent(in) :: values(:)

!Local variables -------------------------
!scalars
 real(dp) :: int_values(size(values))

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

 call simpson_int(size(values),step,values,int_values)
 res = int_values(size(values))

end function simpson
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/rhophi
!! NAME
!! rhophi
!!
!! FUNCTION
!! Compute the phase and the module of a complex number.
!! The phase angle is fold into the interval [-pi,pi]
!!
!! INPUTS
!!  cx(2) = complex number
!!
!! OUTPUT
!!  phi = phase of cx fold into [-pi,pi]
!!  rho = modul of cx
!!
!! PARENTS
!!      berryphase_new,etheta,linemin
!!
!! SOURCE

pure subroutine rhophi(cx,phi,rho)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'rhophi'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 real(dp),intent(out) :: phi,rho
!arrays
 real(dp),intent(in) :: cx(2)


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

 rho = sqrt(cx(1)*cx(1) + cx(2)*cx(2))

 if (abs(cx(1)) > tol8) then

   phi = atan(cx(2)/cx(1))

!  phi is an element of [-pi,pi]
   if (cx(1) < zero) then
     if (phi < zero) then
       phi = phi + pi
     else
       phi = phi - pi
     end if
   end if

 else

   if (cx(2) > tol8) then
     phi = pi*half
   else if (cx(2) < tol8) then
     phi = -0.5_dp*pi
   else
     phi = 0
   end if

 end if

end subroutine rhophi
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/vdiff_eval
!! NAME
!! vdiff_eval
!!
!! FUNCTION
!!  Estimate the "distance" between two functions tabulated on a homogeneous grid.
!!  See vdiff_t
!!
!! INPUTS
!!  cplex=1 if f1 and f2 are real, 2 for complex.
!!  nr=Number of points in the mesh.
!!  f1(cplex,nr), f2(cplex,nr)=Vectors with values
!!
!! OUTPUT
!!  vdiff_t object 
!!
!! PARENTS
!!
!! SOURCE

pure function vdiff_eval(cplex,nr,f1,f2,volume) result(vd)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'vdiff_eval'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,intent(in) :: cplex,nr
 real(dp),intent(in) :: volume
 type(vdiff_t) :: vd
!arrays
 real(dp),intent(in) :: f1(cplex,nr),f2(cplex,nr)

!Local variables-------------------------------
!scalars
 integer :: ir
 real(dp) :: num,den,dr
 type(stats_t) :: stats
!arrays
 real(dp) :: abs_diff(nr)
! *********************************************************************

 dr = volume / nr

 if (cplex == 1) then
   abs_diff = abs(f1(1,:) - f2(1,:))
   num = sum(abs_diff)
   den = sum(abs(f2(1,:)))

 else if (cplex == 2) then
   do ir=1,nr
     abs_diff(ir) = sqrt((f1(1,ir) - f2(1,ir))**2 + (f1(2,ir) - f2(2,ir))**2)
   end do
   num = sum(abs_diff)
   den = zero
   do ir=1,nr
     den = den + sqrt(f2(1,ir)**2 + f2(2,ir)**2)
   end do
 end if

 vd%int_adiff = num * dr
 vd%l1_rerr = num / den 

 stats = stats_eval(abs_diff)
 vd%mean_adiff = stats%mean
 vd%stdev_adiff = stats%stdev
 vd%min_adiff = stats%min
 vd%max_adiff = stats%max

end function vdiff_eval
!!***

!----------------------------------------------------------------------

!!****f* m_numeric_tools/vdiff_print
!! NAME
!! vdiff_print
!!
!! FUNCTION
!!  Print vdiff_t to unit
!!
!! PARENTS
!!      m_dvdb,mrgdv
!!
!! CHILDREN
!!
!! SOURCE

subroutine vdiff_print(vd,unit)


!This section has been created automatically by the script Abilint (TD).
!Do not modify the following lines by hand.
#undef ABI_FUNC
#define ABI_FUNC 'vdiff_print'
!End of the abilint section

 implicit none

!Arguments ------------------------------------
!scalars
 integer,optional,intent(in) :: unit
 type(vdiff_t),intent(in) :: vd

!Local variables-------------------------------
!scalars
 integer :: unt
! *********************************************************************

 unt = std_out; if (present(unit)) unt = unit
 write(unt,"(2(a,es10.3))")" l1_rerr=",vd%l1_rerr,", \int|f1-f2|dr=",vd%int_adiff
 write(unt,"(4(a,es10.3))")" Max{|f1-f2|}=",vd%max_adiff,", min{|f1-f2|}=",vd%min_adiff,&
                           ", Mean{|f1-f2|}=",vd%mean_adiff,", stdev{|f1-f2|}=",vd%stdev_adiff

end subroutine vdiff_print
!!***

!----------------------------------------------------------------------

END MODULE m_numeric_tools
!!***
