numerics_mod.F90

!! MODULE NUMERICS
!   The module numerics contains a set of routines that are called only once at
! the beginng of a run. These routines do not need to be optimzed
MODULE numerics
  USE prec_const, ONLY: xp
  IMPLICIT NONE
  PUBLIC :: build_dnjs_table, evaluate_kernels, evaluate_EM_op
  PUBLIC :: compute_lin_coeff, build_dv4Hp_table

CONTAINS

!******************************************************************************!
!!!!!!! Build the Laguerre-Laguerre coupling coefficient table for nonlin
!******************************************************************************!
SUBROUTINE build_dnjs_table
  USE array, ONLY : dnjs
  USE FMZM,  ONLY : TO_DP
  USE coeff, ONLY : ALL2L
  USE grid,  ONLY : jmax
  IMPLICIT NONE

  INTEGER :: in, ij, is, J
  INTEGER :: n_, j_, s_

  J = jmax

  DO in = 1,J+1 ! Nested dependent loops to make benefit from dnjs symmetrys
    n_ = in - 1
    DO ij = in,J+1
      j_ = ij - 1
      DO is = ij,J+1
        s_ = is - 1

        dnjs(in,ij,is) = TO_DP(ALL2L(n_,j_,s_,0))
        ! By symmetry
        dnjs(in,is,ij) = dnjs(in,ij,is)
        dnjs(ij,in,is) = dnjs(in,ij,is)
        dnjs(ij,is,in) = dnjs(in,ij,is)
        dnjs(is,ij,in) = dnjs(in,ij,is)
        dnjs(is,in,ij) = dnjs(in,ij,is)
      ENDDO
    ENDDO
  ENDDO
END SUBROUTINE build_dnjs_table

!******************************************************************************!
!!!!!!! Build the fourth derivative Hermite coefficient table
!******************************************************************************!
SUBROUTINE build_dv4Hp_table
  USE array,      ONLY: dv4_Hp_coeff
  USE grid,       ONLY: pmax
  USE prec_const, ONLY: xp, PI
  IMPLICIT NONE
  INTEGER :: p_
  DO p_ = -2,pmax
    if (p_ < 4) THEN
      dv4_Hp_coeff(p_) = 0._xp
    ELSE
      dv4_Hp_coeff(p_) = 4_xp*SQRT(REAL((p_-3)*(p_-2)*(p_-1)*p_,xp))
    ENDIF
  ENDDO
   !we scale it w.r.t. to the max degree since
   !D_4^{v}\sim (\Delta v/2)^4 and \Delta v \sim 2pi/kvpar = pi/\sqrt{2P}
   ! dv4_Hp_coeff = dv4_Hp_coeff*(1._xp/2._xp/SQRT(REAL(pmax,xp)))**4
  IF(pmax .GT. 0) &
   dv4_Hp_coeff = dv4_Hp_coeff*(PI/2._xp/SQRT(2._xp*REAL(pmax,xp)))**4
END SUBROUTINE build_dv4Hp_table
!******************************************************************************!

!******************************************************************************!
!!!!!!! Evaluate the kernels once for all
!******************************************************************************!
SUBROUTINE evaluate_kernels
  USE basic
  USE prec_const, ONLY: xp
  USE array,   ONLY : kernel!, HF_phi_correction_operator
  USE grid,    ONLY : local_na, local_nj,ngj, local_nkx, local_nky, local_nz, ngz, jarray, kp2array,&
                      nzgrid
  USE species, ONLY : sigma2_tau_o2
  USE model,    ONLY : KN_MODEL, ORDER
#ifdef LAPACK
  USE model,    ONLY : ORDER_NUM, ORDER_DEN
#endif
  IMPLICIT NONE
  INTEGER    :: j_int, ia, eo, ikx, iky, iz, ij
  REAL(xp)   :: j_xp, y_, factj, sigma_i
  sigma_i = 1._xp ! trivial singe sigma_a = sqrt(m_a/m_i)

  SELECT CASE (KN_MODEL)
  CASE('taylor') ! developped with Leonhard Driever
    ! Kernels based on the ORDER_NUM order Taylor series of J0
    WRITE (*,*) 'Kernel approximation uses Taylor series with ', ORDER, ' powers of k'
    DO ia  = 1,local_na
      DO eo  = 1,nzgrid
        DO ikx = 1,local_nkx
          DO iky = 1,local_nky
            DO iz  = 1,local_nz + ngz
              DO ij = 1,local_nj + ngj
                y_    =  sigma2_tau_o2(ia) * kp2array(iky,ikx,iz,eo)
                j_int = jarray(ij)
                IF (j_int > ORDER .OR. j_int < 0) THEN
                  kernel(ia,ij,ikx,iky,iz,eo) = 0._xp
                ELSE
                  kernel(ia,ij,ikx,iky,iz,eo) = taylor_kernel_n(ORDER, j_int, y_)
                ENDIF
              ENDDO
            ENDDO
          ENDDO
        ENDDO
      ENDDO
    ENDDO
  CASE ('pade')
#ifdef LAPACK
    ! Kernels based on the ORDER_NUM / ORDER_DEN Pade approximation of the kernels
    WRITE (*,*) 'Kernel approximation uses ', ORDER_NUM ,'/', ORDER_DEN, ' Pade approximation'
    DO ia  = 1,local_na
      DO eo  = 1,nzgrid
        DO ikx = 1,local_nkx
          DO iky = 1,local_nky
            DO iz  = 1,local_nz + ngz
              DO ij = 1,local_nj + ngj
                y_    =  sigma2_tau_o2(ia) * kp2array(iky,ikx,iz,eo)
                j_int = jarray(ij)
                IF (j_int > ORDER_NUM .OR. j_int < 0) THEN
                  kernel(ia,ij,ikx,iky,iz,eo) = 0._xp
                ELSE
                  kernel(ia,ij,ikx,iky,iz,eo) = pade_kernel_n(j_int, y_,ORDER_NUM,ORDER_DEN)
                ENDIF
              ENDDO
            ENDDO
          ENDDO
        ENDDO
      ENDDO
    ENDDO
#else
    error stop "ERROR STOP: Pade kernels cannot be used when LAPACK is not included (marconi?)"
#endif
  CASE DEFAULT
    DO ia  = 1,local_na
      DO eo  = 1,nzgrid
        DO ikx = 1,local_nkx
          DO iky = 1,local_nky
            DO iz  = 1,local_nz + ngz
              DO ij = 1,local_nj + ngj
                j_int = jarray(ij)
                j_xp  = REAL(j_int,xp)
                y_    =  sigma2_tau_o2(ia) * kp2array(iky,ikx,iz,eo)
                IF(j_int .LT. 0) THEN !ghosts values
                  kernel(ia,ij,iky,ikx,iz,eo) = 0._xp
                ELSE
                  factj = REAL(GAMMA(j_xp+1._xp),xp)
                  kernel(ia,ij,iky,ikx,iz,eo) = y_**j_int*EXP(-y_)/factj
                ENDIF
              ENDDO
            ENDDO
          ENDDO
        ENDDO
      ENDDO
    ENDDO
  END SELECT

  ! !! Correction term for the evaluation of the heat flux
  ! HF_phi_correction_operator(:,:,:) = &
  !        2._xp * Kernel(ia,1,:,:,:,1) &
  !       -1._xp * Kernel(ia,2,:,:,:,1)
  !
  ! DO ij = 1,local_Nj
  !   j_int = jarray(ij)
  !   j_xp  = REAL(j_int,xp)
  !   HF_phi_correction_operator(:,:,:) = HF_phi_correction_operator(:,:,:) &
  !   - Kernel(ia,ij,:,:,:,1) * (&
  !       2._xp*(j_xp+1.5_xp) * Kernel(ia,ij  ,:,:,:,1) &
  !       -     (j_xp+1.0_xp) * Kernel(ia,ij+1,:,:,:,1) &
  !       -              j_xp * Kernel(ia,ij-1,:,:,:,1))
  ! ENDDO
END SUBROUTINE evaluate_kernels
!******************************************************************************!

!******************************************************************************!
SUBROUTINE evaluate_EM_op
  IMPLICIT NONE

  CALL evaluate_poisson_op
  CALL evaluate_ampere_op

END SUBROUTINE evaluate_EM_op
!!!!!!! Evaluate inverse polarisation operator for Poisson equation
!******************************************************************************!
SUBROUTINE evaluate_poisson_op
  USE basic
  USE array,   ONLY : kernel, inv_poisson_op, inv_pol_ion
  USE grid,    ONLY : local_na, local_nkx, local_nky, local_nz,&
                      kxarray, kyarray, local_nj, ngj, ngz, ieven
  USE species, ONLY : q2_tau
  USE model,   ONLY : ADIAB_E, ADIAB_I, tau_i, q_i
  USE prec_const, ONLY: xp
  IMPLICIT NONE
  REAL(xp)    :: pol_tot, operator_ion
  INTEGER     :: in,ikx,iky,iz,ia
  REAL(xp)    :: sumker
  ! This term has no staggered grid dependence. It is evalued for the
  ! even z grid since poisson uses p=0 moments and phi only.
  kxloop: DO ikx = 1,local_nkx
  kyloop: DO iky = 1,local_nky
  zloop:  DO iz  = 1,local_nz
  IF( (kxarray(iky,ikx).EQ.0._xp) .AND. (kyarray(iky).EQ.0._xp) ) THEN
      inv_poisson_op(iky, ikx, iz) =  0._xp
      inv_pol_ion   (iky, ikx, iz) =  0._xp
  ELSE
    ! loop over n only up to the max polynomial degree
    pol_tot = 0._xp  ! total polarisation term
    a:DO ia = 1,local_na ! sum over species
    ! ia = 1
      sumker  = 0._xp  ! sum of ion polarisation term (Z_a^2/tau_a (1-sum_n kernel_na^2))
      DO in=1,local_nj
        sumker = sumker + q2_tau(ia)*kernel(ia,in+ngj/2,iky,ikx,iz+ngz/2,ieven)**2 ! ... sum recursively ...
      END DO
      pol_tot = pol_tot + q2_tau(ia) - sumker
    ENDDO a
    operator_ion = pol_tot

    IF(ADIAB_E) & ! Adiabatic electron model
      pol_tot = pol_tot + 1._xp

    IF(ADIAB_I) & ! adiabatic ions model, kernel_i = 0 and -q_i/tau_i*phi = rho_i
      pol_tot = pol_tot + q_i**2/tau_i
      
    inv_poisson_op(iky, ikx, iz) =  1._xp/pol_tot
    inv_pol_ion   (iky, ikx, iz) =  1._xp/operator_ion
  ENDIF
  END DO zloop
  END DO kyloop
  END DO kxloop
END SUBROUTINE evaluate_poisson_op
!******************************************************************************!

!******************************************************************************!
!!!!!!! Evaluate inverse polarisation operator for Poisson equation
!******************************************************************************!
SUBROUTINE evaluate_ampere_op
  USE prec_const,   ONLY : xp
  USE array,    ONLY : kernel, inv_ampere_op
  USE grid,     ONLY : local_na, local_nkx, local_nky, local_nz, ngz, total_nj, ngj,&
                       kp2array, kxarray, kyarray, SOLVE_AMPERE, iodd
  USE model,    ONLY : beta, ADIAB_I
  USE species,  ONLY : q, sigma
  USE geometry, ONLY : hatB
  USE prec_const, ONLY: xp
  IMPLICIT NONE
  REAL(xp)    :: sum_jpol, kperp2, operator, q_i, sigma_i
  INTEGER     :: in,ikx,iky,iz,ia
  q_i     = 1._xp ! single charge ion
  sigma_i = 1._xp ! trivial singe sigma_a = sqrt(m_a/m_i)
  ! We do not solve Ampere if beta = 0 to spare waste of ressources
  IF(SOLVE_AMPERE) THEN
    x:DO ikx = 1,local_nkx
    y:DO iky = 1,local_nky
    z:DO iz  = 1,local_nz
    kperp2 = kp2array(iky,ikx,iz+ngz/2,iodd)
    IF( (kxarray(iky,ikx).EQ.0._xp) .AND. (kyarray(iky).EQ.0._xp) ) THEN
        inv_ampere_op(iky, ikx, iz) =  0._xp
    ELSE
      sum_jpol = 0._xp
      a:DO ia  = 1,local_na
        ! loop over n only up to the max polynomial degree
        DO in=1,total_nj
          sum_jpol = sum_jpol  + q(ia)**2/(sigma(ia)**2)*kernel(ia,in+ngj/2,iky,ikx,iz+ngz/2,iodd)**2 ! ... sum recursively ...
        END DO 
      END DO a
      IF(ADIAB_I) THEN 
        ! no ion contribution
      ENDIF
      operator = 2._xp*kperp2*hatB(iz+ngz/2,iodd)**2 + beta*sum_jpol
      inv_ampere_op(iky, ikx, iz) =  1._xp/operator
    ENDIF
    END DO z
    END DO y
    END DO x
  ENDIF
END SUBROUTINE evaluate_ampere_op
!******************************************************************************!

SUBROUTINE compute_lin_coeff

  USE array, ONLY:  xnapj, &
                    ynapp1j, ynapm1j, ynapp1jm1, ynapm1jm1,&
                    zNapm1j, zNapm1jp1, zNapm1jm1,&
                    xnapj, xnapjp1, xnapjm1,&
                    xnapp1j, xnapm1j, xnapp2j, xnapm2j,&
                    xphij, xphijp1, xphijm1,&
                    xpsij, xpsijp1, xpsijm1
  USE species, ONLY: k_T, k_N, tau, q, sqrt_tau_o_sigma
  USE model,   ONLY: k_cB, k_gB, k_mB, k_tB, k_ldB
  USE prec_const, ONLY: xp, SQRT2, SQRT3
  USE grid,  ONLY: parray, jarray, local_na, local_np, local_nj, ngj_o2,ngp_o2
  INTEGER     :: ia,ip,ij,p_int, j_int ! polynom. dagrees
  REAL(xp)    :: p_xp, j_xp

  !! linear coefficients for moment RHS !!!!!!!!!!
  DO ia = 1,local_na
    DO ip = 1,local_np
      p_int= parray(ip+ngp_o2)   ! Hermite degree
      p_xp = REAL(p_int,xp) ! REAL of Hermite degree
      DO ij = 1,local_nj
        j_int= jarray(ij+ngj_o2)   ! Laguerre degree
        j_xp = REAL(j_int,xp) ! REAL of Laguerre degree
        ! All Napj terms related to magn. curvature and perp. gradient
        xnapj(ia,ip,ij) = tau(ia)/q(ia)*(k_cB*(2._xp*p_xp + 1._xp) &
                                        +k_gB*(2._xp*j_xp + 1._xp))
        ! Mirror force terms
        ynapp1j  (ia,ip,ij) = -sqrt_tau_o_sigma(ia) *      (j_xp+1._xp)*SQRT(p_xp+1._xp) * k_mB
        ynapm1j  (ia,ip,ij) = -sqrt_tau_o_sigma(ia) *      (j_xp+1._xp)*SQRT(p_xp)       * k_mB
        ynapp1jm1(ia,ip,ij) = +sqrt_tau_o_sigma(ia) *              j_xp*SQRT(p_xp+1._xp) * k_mB
        ynapm1jm1(ia,ip,ij) = +sqrt_tau_o_sigma(ia) *              j_xp*SQRT(p_xp)       * k_mB
        ! Trapping terms
        zNapm1j  (ia,ip,ij) = +sqrt_tau_o_sigma(ia) *(2._xp*j_xp+1._xp)*SQRT(p_xp) * k_tB
        zNapm1jp1(ia,ip,ij) = -sqrt_tau_o_sigma(ia) *      (j_xp+1._xp)*SQRT(p_xp) * k_tB
        zNapm1jm1(ia,ip,ij) = -sqrt_tau_o_sigma(ia) *              j_xp*SQRT(p_xp) * k_tB
      ENDDO
    ENDDO
    DO ip = 1,local_np
      p_int= parray(ip+ngp_o2)   ! Hermite degree
      p_xp = REAL(p_int,xp) ! REAL of Hermite degree
      ! Landau damping coefficients (ddz napj term)
      xnapp1j(ia,ip) = sqrt_tau_o_sigma(ia) * SQRT(p_xp+1._xp) * k_ldB
      xnapm1j(ia,ip) = sqrt_tau_o_sigma(ia) * SQRT(p_xp)       * k_ldB
      ! Magnetic curvature term
      xnapp2j(ia,ip) = tau(ia)/q(ia) * SQRT((p_xp+1._xp)*(p_xp + 2._xp)) * k_cB
      xnapm2j(ia,ip) = tau(ia)/q(ia) * SQRT( p_xp       *(p_xp - 1._xp)) * k_cB
    ENDDO
    DO ij = 1,local_nj
      j_int= jarray(ij+ngj_o2)   ! Laguerre degree
      j_xp = REAL(j_int,xp) ! REAL of Laguerre degree
      ! Magnetic perp. gradient term
      xnapjp1(ia,ij) = -tau(ia)/q(ia) * (j_xp + 1._xp) * k_gB
      xnapjm1(ia,ij) = -tau(ia)/q(ia) *  j_xp          * k_gB
    ENDDO
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !! ES linear coefficients for moment RHS !!!!!!!!!!
    DO ip = 1,local_np
      p_int= parray(ip+ngp_o2)   ! Hermite degree
      DO ij = 1,local_nj
        j_int= jarray(ij+ngj_o2)   ! REALof Laguerre degree
        j_xp = REAL(j_int,xp) ! REALof Laguerre degree
        !! Electrostatic potential pj terms
        IF (p_int .EQ. 0) THEN ! kronecker p0
          xphij  (ia,ip,ij)  = +k_N(ia) + 2._xp*j_xp*k_T(ia)
          xphijp1(ia,ip,ij)  = -k_T(ia)*(j_xp+1._xp)
          xphijm1(ia,ip,ij)  = -k_T(ia)* j_xp
        ELSE IF (p_int .EQ. 2) THEN ! kronecker p2
          xphij(ia,ip,ij)    = +k_T(ia)/SQRT2
          xphijp1(ia,ip,ij)  = 0._xp; xphijm1(ia,ip,ij)  = 0._xp;
        ELSE
          xphij  (ia,ip,ij)  = 0._xp; xphijp1(ia,ip,ij)  = 0._xp
          xphijm1(ia,ip,ij)  = 0._xp;
        ENDIF
      ENDDO
    ENDDO
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !! Electromagnatic linear coefficients for moment RHS !!!!!!!!!!
    DO ip = 1,local_np
      p_int= parray(ip+ngp_o2)   ! Hermite degree
      DO ij = 1,local_nj
        j_int= jarray(ij+ngj_o2)   ! REALof Laguerre degree
        j_xp = REAL(j_int,xp) ! REALof Laguerre degree
        IF (p_int .EQ. 1) THEN ! kronecker p1
          xpsij  (ia,ip,ij)  = +(k_N(ia) + (2._xp*j_xp+1._xp)*k_T(ia))* sqrt_tau_o_sigma(ia)
          xpsijp1(ia,ip,ij)  = - k_T(ia)*(j_xp+1._xp)                 * sqrt_tau_o_sigma(ia)
          xpsijm1(ia,ip,ij)  = - k_T(ia)* j_xp                        * sqrt_tau_o_sigma(ia)
        ELSE IF (p_int .EQ. 3) THEN ! kronecker p3
          xpsij  (ia,ip,ij)  = + k_T(ia)*SQRT3/SQRT2                  * sqrt_tau_o_sigma(ia)
          xpsijp1(ia,ip,ij)  = 0._xp; xpsijm1(ia,ip,ij)  = 0._xp;
        ELSE
          xpsij  (ia,ip,ij)  = 0._xp; xpsijp1(ia,ip,ij)  = 0._xp
          xpsijm1(ia,ip,ij)  = 0._xp;
        ENDIF
      ENDDO
    ENDDO
  ENDDO
END SUBROUTINE compute_lin_coeff


!******************************************************************************!
!!!!!!! Auxilliary kernel functions/subroutines (developped with Leonhard Driever)
!******************************************************************************!
REAL(xp) FUNCTION taylor_kernel_n(order, n, y)
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: order
  INTEGER, INTENT(IN) :: n
  REAL(xp), INTENT(IN) :: y
  REAL(xp) :: sum_variable
  INTEGER  ::  m
  REAL(xp) :: m_dp, n_dp

  n_dp = REAL(n, xp)
  sum_variable = 0._xp

  DO m = n, order
      m_dp = REAL(m, xp)
      sum_variable = sum_variable + (-1._xp)**(m - n) * y**m / (GAMMA(n_dp + 1._xp) * GAMMA(m_dp - n_dp + 1._xp)) ! Denominator of m C n
    END DO
  taylor_kernel_n = sum_variable
END FUNCTION taylor_kernel_n

#ifdef LAPACK
REAL(xp) FUNCTION pade_kernel_n(n, y, N_NUM, N_DEN)
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: n, N_NUM, N_DEN
  REAL(xp), INTENT(IN) :: y
  REAL(xp) :: pade_numerator_coeffs(N_NUM + 1), pade_denominator_coeffs(N_NUM + 1)
  REAL(xp) :: numerator_sum
  REAL(xp) :: denominator_sum
  INTEGER  :: m
  ! If N_NUM == 0, then the approximation should be the same as the Taylor approx. of N_NUM:
  IF (N_NUM == 0) THEN
      pade_kernel_n = taylor_kernel_n(N_NUM, n, y)
  ELSE
    CALL find_pade_coefficients(pade_numerator_coeffs, pade_denominator_coeffs, n, N_NUM, N_DEN)
    numerator_sum = 0
    denominator_sum = 0
    DO m = 0, N_NUM
      numerator_sum = numerator_sum + pade_numerator_coeffs(m + 1) * y ** m
    END DO
    DO m = 0, N_NUM
      denominator_sum = denominator_sum + pade_denominator_coeffs(m + 1) * y ** m
    END DO
    pade_kernel_n = numerator_sum / denominator_sum
  END IF
END FUNCTION pade_kernel_n


SUBROUTINE find_pade_coefficients(pade_num_coeffs, pade_denom_coeffs, n, N_NUM, N_DEN)
  IMPLICIT NONE
#ifdef SINGLE_PRECISION
  EXTERNAL :: SGESV ! Use DGESV rather than SGESV for double precision
#else
  EXTERNAL :: DGESV ! Use DGESV rather than SGESV for double precision
#endif
  INTEGER, INTENT (IN) ::  n, N_NUM, N_DEN ! index of the considered Kernel
	REAL(xp), INTENT(OUT) :: pade_num_coeffs(N_NUM + 1), pade_denom_coeffs(N_NUM + 1) ! OUT rather than INOUT to make sure no information is retained from previous Kernel computations
	
	REAL(xp) :: taylor_kernel_coeffs(N_NUM + N_NUM + 1), denom_matrix(N_NUM, N_NUM)
	INTEGER  :: m, j
	REAL(xp) :: m_dp, n_dp
	INTEGER  :: return_code  ! for DGESV
	REAL(xp) :: pivot(N_NUM) ! for DGESV

	n_dp = REAL(n, xp)
	
	! First find the kernel Taylor expansion coefficients
	DO m = 0, N_NUM + N_NUM ! m here counts the order of the derivatives
	   m_dp = REAL(m, xp)

	   IF (m < n) THEN
	      taylor_kernel_coeffs(m + 1) = 0
	   ELSE   
	      taylor_kernel_coeffs(m + 1) = (-1)**(n + m) / (GAMMA(n_dp + 1._xp) * GAMMA(m_dp - n_dp + 1._xp))
	   END IF
	END DO

	! Next construct the denominator solving matrix
	DO m = 1, N_NUM
	   DO j = 1, N_NUM
	      IF (N_NUM + m - j < 0) THEN
		denom_matrix(m, j) = 0
	      ELSE
	      	denom_matrix(m, j) = taylor_kernel_coeffs(N_NUM + m - j + 1)
	      END IF
	   END DO
	END DO

	! Then solve for the denominator coefficients, setting the first one to 1
	!!!! SOLVER NOT YET IMPLEMENTED!!!!
	pade_denom_coeffs(1) = 1
	pade_denom_coeffs(2:) = - taylor_kernel_coeffs(N_NUM + 2 : N_NUM + N_NUM + 1) ! First acts as RHS vector for equation, is then transformed to solution by DGESV
#ifdef SINGLE_PRECISION
  CALL SGESV(N_NUM, 1, denom_matrix, N_NUM, pivot, pade_denom_coeffs(2:), N_NUM, return_code) ! LAPACK solver for matrix equation. Note that denom_matrix is now no longer as expected
#else
  CALL DGESV(N_NUM, 1, denom_matrix, N_NUM, pivot, pade_denom_coeffs(2:), N_NUM, return_code) ! LAPACK solver for matrix equation. Note that denom_matrix is now no longer as expected
#endif


	! Print an error message in case there was a problem with the solver
	IF (return_code /= 0) THEN
	   WRITE (*,*) 'An error occurred in the solving for the Pade denominator coefficients. The error code is: ', return_code
	END IF

	! Finally compute the numerator coefficients
	DO m = 1, N_NUM + 1
	   pade_num_coeffs(m) = 0 ! As the array is not automatically filled with zeros
	   DO j = 1, m	
      	      !num_matrix(m, j) = taylor_kernel_coeffs(m - j + 1)
	      pade_num_coeffs(m) = pade_num_coeffs(m) + pade_denom_coeffs(j) * taylor_kernel_coeffs(m - j + 1)
	   END DO
	END DO

END SUBROUTINE find_pade_coefficients
#endif
!******************************************************************************!


END MODULE numerics