** Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
** See https://llvm.org/LICENSE.txt for license information.
** SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception

*   Miscellaneous intrinsics which may appear in parameter statements
*   used in non-parameter context

	program ff01
	complex c1, c2
	double complex cd1, cd2
	double precision d1, d2, d3, d4, d5, d6, d7, d8, d9
	character ch
	logical l1, l2, l3, l4

	parameter (N=40)

	integer result(N)
	integer expect(N)
	common result, expect

	i1 = abs(2.5)	! tests 1 - 2
	i2 = abs(-2.5)

	x1 = abs(2.5)	! tests 3 - 6
	x2 = abs(-4.5e+3)
	d1 = abs(2.5)
	d2 = abs(-5.4999d+4)
	i3 = nint(x1)
	i4 = nint(-x2)
	i5 = idnint(d1)
	i6 = idnint(-d2)

	c1 = (2.54, -4.89)	! tests 7-9
	c2 = conjg(c1)
	x3 = aimag(c2)

	cd1 = (4.49, -10.2)	! tests 10-12
	cd2 = conjg(c2)
	d3 = dimag(cd2)

	d4 = dprod(x1, x2)	! test 13

	i7 = max(i1, i2, i3, i4, i5, i6)	! tests 14-15
	i8 = min(i1, i2, i3, i4, i5, i6, i7)

	x4 = max(x1, x2, x3)			! tests 16-17
	x5 = min(x1, x2, x3, x4)

	d5 = max(d1, d2, d3, d4)		! tests 18-19
	d6 = min(d1, d2, d3, d4, d5)

	i9 = iand('aaaaaaaa'x, '84848484'x)	! tests 20-23
	i10 = ior('78787878'x, '87878787'x)
	i11 = not('f0f0f0f0'x)
	i12 = ieor('bbbbbbbb'x, '8af8afcd'x)

	i13 = mod(13, -3)			! tests 24-26
	x6 = mod(-13.3, 5.0)
	d7 = mod(15.3d+2, 1.53d+2)

	i14 = ichar('a')			! test 27

	i15 = dim(20,15)			! tests 28-33
	i16 = dim(1,1)
	x7 = dim(20.0,15.0)
	x8 = dim(1.0,1.0)
	d8 = dim(20.0d+1, 15.0d+1)
	d9 = dim(1.0d+1, 1.0d+1)

	i17 = ishft('a0000000'x, 1)		! tests 34-35
	i18 = ishft('80000001'x, -1)

	ch = char(32)			! test 36

	l1 = lge('abcd', 'abcd')		! tests 37-40
	l2 = lgt('abcd', 'abc')
	l3 = lle('abc', 'abc')
	l4 = llt('abc', 'abcd')

	result(1) = i1
	result(2) = i2

	result(3) = i3
	result(4) = i4
	result(5) = i5
	result(6) = i6

	result(7) = c1
	result(8) = x3
	result(9) = cd1

	result(10) = cd1
	result(11) = d3
	result(12) = cd2

	result(13) = d4

	result(14) = i7
	result(15) = i8

	result(16) = x4
	result(17) = x5

	result(18) = d5
	result(19) = d6

	result(20) = i9
	result(21) = i10
	result(22) = i11
	result(23) = i12

	result(24) = i13
	result(25) = x6
	result(26) = d7

	result(27) = i14

	result(28) = i15
	result(29) = i16
	result(30) = x7
	result(31) = x8
	result(32) = d8
	result(33) = d9

	result(34) = i17
	result(35) = i18

	result(36) = ichar(ch)

	result(37) = iand(l1, 1)
	result(38) = iand(l2, 1)
	result(39) = iand(l3, 1)
	result(40) = iand(l4, 1)

	call check(result, expect, N)
	data result/N*-1/
	data expect/
     + 2, 2,					! tests 1 - 2
     + 3, -4500, 3, -54999,			! tests 3 - 6
     + 2, 4, 4,					! tests 7-9
     + 4, -4, 2,				! tests 10-12
     + 11250,					! test 13
     + 3, -54999,				! tests 14-15
     + 4500, 2,					! tests 16-17
     + 54999, -4,				! tests 18-19
     + -2139062144, -1, 252645135, 826479734,	! tests 20-23
     + 1, -3, 0,				! tests 24-26
     + 97,					! test 27
     + 5, 0, 5, 0, 50, 0,			! tests 28-33
     + 1073741824, 1073741824,			! tests 34-35
     + 32,					! test 36
     + 1, 1, 1, 1 /				! tests 37-40
	end


C
      PROGRAM SPLINETEST
C
      IMPLICIT NONE
      INCLUDE 'knd_params.inc'
      INCLUDE 'usr_params.inc'
      INCLUDE 'spl_params.inc'
      INCLUDE 'rle_params.inc'
C
      INTEGER(KIND=IK) BC (2)
      INTEGER(KIND=IK) N
      INTEGER(KIND=IK) M
      INTEGER(KIND=IK) LD
      PARAMETER (N  = 17)
      PARAMETER (M  = 2)
      PARAMETER (LD = M * (M + 1))
C
      REAL   (KIND=RK) F (M, M + 1, N)
      INTEGER(KIND=IK) I
      REAL   (KIND=RK) X, H

      H = 1.0D0 / DBLE (N - 1)

      WRITE (USR_O, *) 'SPL_NOT_A_KNOT SPL_FIRST_DERIV:'
      BC (1) = SPL_NOT_A_KNOT
      BC (2) = SPL_FIRST_DERIV
      DO I = 1, N
        X = H * DBLE (I - 1)
        F (1, 1, I) = X * X * X
        F (2, 1, I) = SIN (TWO_PI * X)
        F (1, 3, I) = 3.0 * H * X * X
        F (2, 3, I) = TWO_PI * H * COS (TWO_PI * X)
      END DO
      DO I = N, N
        X = H * DBLE (I - 1)
        F (1, 2, I) = 3.0 * H * X * X
        F (2, 2, I) = TWO_PI * H * COS (TWO_PI * X)
      END DO

      CALL SPLINE (BC, N, M, LD, F (1, 1, 1), F (1, 2, 1))
      F (1, 3, :) = F (1, 2, :) - F (1, 3, :)
      F (2, 3, :) = F (2, 2, :) - F (2, 3, :)
      WRITE (USR_O, 101) F
      WRITE (USR_O, *)

      WRITE (USR_O, *) 'SPL_PERIODIC:'
      BC (1) = SPL_PERIODIC
      BC (2) = SPL_PERIODIC
      DO I = 1, N
        X = H * DBLE (I - 1)
        F (1, 1, I) = COS (TWO_PI * X - H)
        F (2, 1, I) = SIN (TWO_PI * X - H)
        F (1, 3, I) = -TWO_PI * H * F (2, 1, I)
        F (2, 3, I) =  TWO_PI * H * F (1, 1, I)
      END DO
      CALL SPLINE (BC, N, M, LD, F (1, 1, 1), F (1, 2, 1))
      F (1, 3, :) = F (1, 2, :) - F (1, 3, :)
      F (2, 3, :) = F (2, 2, :) - F (2, 3, :)
      WRITE (USR_O, 101) F
      WRITE (USR_O, *)
C
  101 FORMAT (1X, 6E14.6)
      END


function integral(func, a, b, step)
     real(8), external:: func         !external不写也可以,不过还是标明一下这是函数
     real(8):: a, b, step, integral
     real(8):: x
     x = a
     integral = 0.
     do while(x < b)
          integral = integral+func(x)
          x = x+step
     end do
     integral = integral*step
end function integral


PROGRAM HeapSorter
!--
!This program uses heap sort to create a sorted array from the data contained in Q2_Data.txt
!For reading to work correctly, a space must be used to start the array of data in the file Q2_Data.txt
!Once sorted, the data is stored back into the file
!--
IMPLICIT NONE

CHARACTER*10 :: B, C
INTEGER, DIMENSION(:), ALLOCATABLE :: A, Anew
INTEGER :: s, check

!- Firstly we need to determine the size of A (the value of n)
OPEN(unit=10, file= "Data\\Q2_Data.txt")
READ(10, *) B, C, s
PRINT *, s
!- Allocate the Array to be read, and the array for the output
ALLOCATE(A(s), Anew(s), STAT=check)
IF (check .eq. 0) THEN
  	!- Read the array
  	READ(10, *) A
	PRINT *, A
    PRINT *, "Sorting..."
	Anew = HeapSort(A, s)
    PRINT *, "Done!"
    PRINT *, "HeapSorted Array:"
    PRINT *, Anew
    WRITE(10, *) "Sorted Data:"
    WRITE (10, *) Anew
    DEALLOCATE(A, Anew)
ELSE
  	PRINT *, "The array could not be allocated, Please try again."
END IF

CONTAINS
!- HeapSort
FUNCTION HeapSort(A, s)
INTEGER, INTENT(IN) :: s
INTEGER, DIMENSION(s), INTENT(IN) :: A
INTEGER, DIMENSION(s) :: HeapSort
INTEGER :: i, n, tmp

n = s
HeapSort = A
!- Build the max heap
DO i = n, 1, -1
	CALL Heapify(HeapSort, n, i, s)
END DO
!- Now sort by the largest elements
DO i = n, 1, -1
  	tmp = HeapSort(i)
    HeapSort(i) = HeapSort(1)
    HeapSort(1) = tmp
	CALL Heapify(HeapSort, i, 1, s)
END DO

END FUNCTION HeapSort
!- Heapify
RECURSIVE SUBROUTINE Heapify(Arr, n, i, s)
INTEGER, INTENT(IN) :: n, i, s
INTEGER, DIMENSION(s), INTENT(INOUT) :: Arr
INTEGER :: l, r, max, tmp

l = 2 * i
r = 2 * i + 1
max = i
IF (l < n .and. Arr(max) < Arr(l)) THEN
  	max = l
END IF
IF (r < n .and. Arr(max) < Arr(r)) THEN
	max = r
END IF
IF (max .ne. i) THEN
 	tmp = Arr(i)
    Arr(i) = Arr(max)
    Arr(max) = tmp

    CALL Heapify(Arr, n, max, s)
END IF

END SUBROUTINE Heapify
END PROGRAM HeapSorter


module constants
implicit none
save
! Definition of the constants
real, parameter :: c1=0.04184
real, parameter :: C6=1.8836518D-3
real, parameter :: pi=3.1415927
real, parameter :: vf=1.d6
real, parameter :: planck=6.62607004d-34
real, parameter :: boltz=1.38064852d-23
real, parameter :: r=1.987d-3
real, parameter :: avog=6.022d23
real, parameter :: ratm=0.08205746
end module constants


*DECK DVINDY
      SUBROUTINE DVINDY (T, K, YH, LDYH, DKY, IFLAG)
      DOUBLE PRECISION T, YH, DKY
      INTEGER K, LDYH, IFLAG
      DIMENSION YH(LDYH,*), DKY(*)
C-----------------------------------------------------------------------
C Call sequence input -- T, K, YH, LDYH
C Call sequence output -- DKY, IFLAG
C COMMON block variables accessed:
C     /DVOD01/ --  H, TN, UROUND, L, N, NQ
C     /DVOD02/ --  HU
C
C Subroutines called by DVINDY: DSCAL, XERRWD
C Function routines called by DVINDY: None
C-----------------------------------------------------------------------
C DVINDY computes interpolated values of the K-th derivative of the
C dependent variable vector y, and stores it in DKY.  This routine
C is called within the package with K = 0 and T = TOUT, but may
C also be called by the user for any K up to the current order.
C (See detailed instructions in the usage documentation.)
C-----------------------------------------------------------------------
C The computed values in DKY are gotten by interpolation using the
C Nordsieck history array YH.  This array corresponds uniquely to a
C vector-valued polynomial of degree NQCUR or less, and DKY is set
C to the K-th derivative of this polynomial at T.
C The formula for DKY is:
C              q
C  DKY(i)  =  sum  c(j,K) * (T - TN)**(j-K) * H**(-j) * YH(i,j+1)
C             j=K
C where  c(j,K) = j*(j-1)*...*(j-K+1), q = NQCUR, TN = TCUR, H = HCUR.
C The quantities  NQ = NQCUR, L = NQ+1, N, TN, and H are
C communicated by COMMON.  The above sum is done in reverse order.
C IFLAG is returned negative if either K or T is out of bounds.
C
C Discussion above and comments in driver explain all variables.
C-----------------------------------------------------------------------
C
      include "vode.H"
C
C Type declarations for local variables --------------------------------
C
      DOUBLE PRECISION C, HUN, R, S, TFUZZ, TN1, TP, ZERO
      INTEGER I, IC, J, JB, JB2, JJ, JJ1, JP1
      CHARACTER*80 MSG
      PARAMETER(HUN = 100.0D0, ZERO = 0.0D0)
C
      IFLAG = 0
      IF (K .LT. 0 .OR. K .GT. NQ) GO TO 80
      TFUZZ = HUN*UROUND*(TN + HU)
      TP = TN - HU - TFUZZ
      TN1 = TN + TFUZZ
      IF ((T-TP)*(T-TN1) .GT. ZERO) GO TO 90
C
      S = (T - TN)/H
      IC = 1
      IF (K .EQ. 0) GO TO 15
      JJ1 = L - K
      DO 10 JJ = JJ1, NQ
 10     IC = IC*JJ
 15   C = REAL(IC)
      DO 20 I = 1, N
 20     DKY(I) = C*YH(I,L)
      IF (K .EQ. NQ) GO TO 55
      JB2 = NQ - K
      DO 50 JB = 1, JB2
        J = NQ - JB
        JP1 = J + 1
        IC = 1
        IF (K .EQ. 0) GO TO 35
        JJ1 = JP1 - K
        DO 30 JJ = JJ1, J
 30       IC = IC*JJ
 35     C = REAL(IC)
        DO 40 I = 1, N
 40       DKY(I) = C*YH(I,JP1) + S*DKY(I)
 50     CONTINUE
      IF (K .EQ. 0) RETURN
 55   R = H**(-K)
      CALL DSCAL (N, R, DKY, 1)
      RETURN
C
 80   MSG = 'DVINDY-- K (=I1) illegal      '
      CALL XERRWD (MSG, 30, 51, 1, 1, K, 0, 0, ZERO, ZERO)
      IFLAG = -1
      RETURN
 90   MSG = 'DVINDY-- T (=R1) illegal      '
      CALL XERRWD (MSG, 30, 52, 1, 0, 0, 0, 1, T, ZERO)
      MSG='      T not in interval TCUR - HU (= R1) to TCUR (=R2)      '
      CALL XERRWD (MSG, 60, 52, 1, 0, 0, 0, 2, TP, TN)
      IFLAG = -2
      RETURN
C----------------------- End of Subroutine DVINDY ----------------------
      END


! a simple code to check the analytic Jacobian via numerical
! differencing

program testjacobian

  use bl_types
  use bl_constants_module
  use bl_error_module
  use network
  use eos_module, only: eos_input_rt, eos, eos_init
  use eos_type_module
  use burner_module
  use rpar_indices

  implicit none

  real(kind=dp_t) :: dens, temp
  real(kind=dp_t), dimension(nspec) :: Xin
  real(kind=dp_t), dimension(nspec_advance+1) :: y, ydot
  real(kind=dp_t), dimension(nspec_advance+1) :: yp, ym
  real(kind=dp_t), dimension(nspec_advance+1) :: ydotp, ydotm
  real(kind=dp_t), dimension(nspec_advance+1,nspec_advance+1) :: pd
  real(kind=dp_t) :: enucdot

  real(kind=dp_t), allocatable :: rpar(:)
  integer :: ipar

  integer :: ic12, io16, img24
  integer :: i, j, n

  real(kind=dp_t), parameter :: delta = 0.001d0
  real(kind=dp_t) :: num_jac

  type (eos_t) :: eos_state

  !External functions defined in f_rhs.f90
  !Assumed-shape arrays (like rpar here) for external functions require an interface,
  !can't just do EXTERNAL without getting errors.
  interface
    subroutine f_rhs(n, t, y, ydot, rpar, ipar)
      import dp_t
      integer,         intent(in   ) :: n, ipar
      real(kind=dp_t), intent(in   ) :: y(n), t
      real(kind=dp_t), intent(  out) :: ydot(n)
      real(kind=dp_t), intent(inout) :: rpar(:)
    end subroutine
    subroutine jac(neq, t, y, ml, mu, pd, nrpd, rpar, ipar)
      import dp_t
      integer        , intent(IN   ) :: neq, ml, mu, nrpd, ipar
      real(kind=dp_t), intent(IN   ) :: y(neq), rpar(:), t
      real(kind=dp_t), intent(  OUT) :: pd(neq,neq)
    end subroutine
  end interface

  call network_init()
  call eos_init()
  allocate(rpar(n_rpar_comps))

  ic12 = network_species_index("carbon-12")
  io16 = network_species_index("oxygen-16")
  img24 = network_species_index("magnesium-24")

  if (ic12 < 0 .or. io16 < 0 .or. img24 < 0) then
     call bl_error("ERROR: species index not defined")
  endif

  dens = 2.6e9_dp_t
  temp = 7.e8_dp_t

  Xin(ic12) = 0.5_dp_t
  Xin(io16) = 0.5_dp_t
  Xin(img24) = 0.0_dp_t

  eos_state%rho   = dens
  eos_state%T     = temp
  eos_state%xn(:) = Xin(:)

  call eos(eos_input_rt, eos_state, .false.)

  print *, 'evaluating the RHS...'

  ! load the state
  y(1) = Xin(ic12)
  y(nspec_advance+1) = temp

  ! set the rpar variables
  rpar(irp_dens) = dens
  rpar(irp_cp) = eos_state%cp
  rpar(irp_dhdX:irp_dhdX-1+nspec) = eos_state%dhdX(:)
  rpar(irp_o16)  = Xin(io16)

  print *, 'rpar(irp_dens): ', rpar(irp_dens)
  print *, 'size(rpar):     ', size(rpar)

  call f_rhs(nspec_advance+1, ZERO, y, ydot, rpar, ipar)

  call jac(nspec_advance+1, ZERO, y, 0, 0, pd, nspec_advance+1, rpar, ipar)

999 format(1x, "df(",i1,")/dy(",i1,")", g20.10, g20.10)

  do j = 1, nspec_advance+1

     yp(:) = y(:)
     ym(:) = y(:)

     yp(j) = (1.d0 + delta)*y(j)
     call f_rhs(nspec_advance+1, ZERO, yp, ydotp, rpar, ipar)

     ym(j) = (1.d0 - delta)*y(j)
     call f_rhs(nspec_advance+1, ZERO, ym, ydotm, rpar, ipar)

     do i = 1, nspec_advance+1

        num_jac = (ydotp(i) - ydotm(i))/(yp(j) - ym(j))

        write (*,999) i, j, num_jac, pd(i,j)

     enddo
  enddo

end program testjacobian


!< Jiang-Shu (Lagrange) interpolations object for function interpolation.
module wenoof_interpolations_int_js
!< Jiang-Shu (Lagrange) interpolations object for function interpolation.
!<
!< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially
!< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126,
!< doi:10.1137/070679065.

use penf, only : I_P, R_P, str
use wenoof_base_object, only : base_object, base_object_constructor
use wenoof_interpolations_object, only : interpolations_object, interpolations_object_constructor

implicit none
private
public :: interpolations_int_js
public :: interpolations_int_js_constructor

type, extends(interpolations_object_constructor) :: interpolations_int_js_constructor
  !< Jiang-Shu (Lagrange) interpolations object for function interpolation constructor.
  real(R_P)              :: x_target   !< Coordinate of the interpolation point.
  contains
    ! public deferred methods
    procedure, pass(lhs) :: constr_assign_constr !< `=` operator.
endtype interpolations_int_js_constructor

type, extends(interpolations_object) :: interpolations_int_js
  !< Jiang-Shu (Lagrange) interpolations object for function interpolation.
  !<
  !< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially
  !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126,
  !< doi:10.1137/070679065.
  real(R_P), allocatable :: coef(:,:) !< Polynomial coefficients [0:S-1,0:S-1].
  contains
    ! public deferred methods
    procedure, pass(self) :: create               !< Create interpolations.
    procedure, pass(self) :: compute_int          !< Compute interpolations (interpolate).
    procedure, pass(self) :: compute_rec          !< Compute interpolations (reconstruct).
    procedure, pass(self) :: description          !< Return object string-description.
    procedure, pass(self) :: destroy              !< Destroy interpolations.
    procedure, pass(lhs)  :: object_assign_object !< `=` operator.
endtype interpolations_int_js

contains
  ! constructor

  ! deferred public methods
  subroutine constr_assign_constr(lhs, rhs)
  !< `=` operator.
  class(interpolations_int_js_constructor), intent(inout) :: lhs !< Left hand side.
  class(base_object_constructor),           intent(in)    :: rhs !< Right hand side.

  call lhs%assign_(rhs=rhs)
  select type(rhs)
  type is(interpolations_int_js_constructor)
     lhs%x_target = rhs%x_target
  endselect
  endsubroutine constr_assign_constr

  ! public deferred methods
  subroutine create(self, constructor)
  !< Create interpolations.
  class(interpolations_int_js),   intent(inout) :: self        !< Interpolations.
  class(base_object_constructor), intent(in)    :: constructor !< Interpolations constructor.
  real(R_P)                                     :: prod        !< Temporary variable.
  real(R_P)                                     :: c_sum       !< Temporary variable.
  integer(I_P)                                  :: i, j, k     !< Counters.

  call self%destroy
  call self%create_(constructor=constructor)
  allocate(self%coef(0:self%S - 1, 0:self%S - 1))
  select type(constructor)
  type is(interpolations_int_js_constructor)
    associate(S => self%S, c => self%coef, x_target => constructor%x_target)
      if(x_target==-0.5_R_P) then
        ! left interface (i-1/2)
        select case(S)
          case(2) ! 3rd order
            !  cell  1      ;    cell  0
            c(1,0)=  0.5_R_P; c(0,0)=  0.5_R_P ! stencil 0
            c(1,1)=  1.5_R_P; c(0,1)= -0.5_R_P ! stencil 1
          case(3) ! 5th order
            !  cell  2            ;    cell  1            ;    cell  0
            c(2,0)= -1._R_P/8._R_P; c(1,0)=  3._R_P/4._R_P; c(0,0)=  3._R_P/8._R_P ! stencil 0
            c(2,1)=  3._R_P/8._R_P; c(1,1)=  3._R_P/4._R_P; c(0,1)= -1._R_P/8._R_P ! stencil 1
            c(2,2)= 15._R_P/8._R_P; c(1,2)= -5._R_P/4._R_P; c(0,2)=  3._R_P/8._R_P ! stencil 2
          case(4) ! 7th order
            !  cell  3             ;    cell  2             ;    cell  1             ;    cell  0
            c(3,0)=  1._R_P/16._R_P; c(2,0)= -5._R_P/16._R_P; c(1,0)= 15._R_P/16._R_P; c(0,0)=  5._R_P/16._R_P ! stencil 0
            c(3,1)= -1._R_P/16._R_P; c(2,1)=  9._R_P/16._R_P; c(1,1)=  9._R_P/16._R_P; c(0,1)= -1._R_P/16._R_P ! stencil 1
            c(3,2)=  5._R_P/16._R_P; c(2,2)= 15._R_P/16._R_P; c(1,2)= -5._R_P/16._R_P; c(0,2)=  1._R_P/16._R_P ! stencil 2
            c(3,3)= 35._R_P/16._R_P; c(2,3)=-35._R_P/16._R_P; c(1,3)= 21._R_P/16._R_P; c(0,3)= -5._R_P/16._R_P ! stencil 3
          case(5) ! 9th order
            !  cell  4               ;    cell  3               ;    cell  2               ;    cell  1
            c(4,0)=  -5._R_P/128._R_P; c(3,0)=   7._R_P/32._R_P ; c(2,0)= -35._R_P/64._R_P ; c(1,0)=  35._R_P/32._R_P  ! stencil 0
            c(4,1)=   3._R_P/128._R_P; c(3,1)=  -5._R_P/32._R_P ; c(2,1)=  45._R_P/64._R_P ; c(1,1)=  15._R_P/32._R_P  ! stencil 1
            c(4,2)=  -5._R_P/128._R_P; c(3,2)=  15._R_P/32._R_P ; c(2,2)=  45._R_P/64._R_P ; c(1,2)=  -5._R_P/32._R_P  ! stencil 2
            c(4,3)=  35._R_P/128._R_P; c(3,3)=  35._R_P/32._R_P ; c(2,3)= -35._R_P/64._R_P ; c(1,3)=   7._R_P/32._R_P  ! stencil 3
            c(4,4)= 315._R_P/128._R_P; c(3,4)=-105._R_P/32._R_P ; c(2,4)= 189._R_P/64._R_P ; c(1,4)= -45._R_P/32._R_P  ! stencil 4
            !  cell  0
            c(0,0)=  35._R_P/128._R_P  ! stencil 0
            c(0,1)=  -5._R_P/128._R_P  ! stencil 1
            c(0,2)=   3._R_P/128._R_P  ! stencil 2
            c(0,3)=  -5._R_P/128._R_P  ! stencil 3
            c(0,4)=  35._R_P/128._R_P  ! stencil 4
          case(6) ! 11th order
            !  cell  5                ;    cell  4                ;    cell  3
            c(5,0)=    7._R_P/256._R_P; c(4,0)=  -45._R_P/256._R_P; c(3,0)=   63._R_P/128._R_P  ! stencil 0
            c(5,1)=   -3._R_P/256._R_P; c(4,1)=   21._R_P/256._R_P; c(3,1)=  -35._R_P/128._R_P  ! stencil 1
            c(5,2)=    3._R_P/256._R_P; c(4,2)=  -25._R_P/256._R_P; c(3,2)=   75._R_P/128._R_P  ! stencil 2
            c(5,3)=   -7._R_P/256._R_P; c(4,3)=  105._R_P/256._R_P; c(3,3)=  105._R_P/128._R_P  ! stencil 3
            c(5,4)=   63._R_P/256._R_P; c(4,4)=  315._R_P/256._R_P; c(3,4)= -105._R_P/128._R_P  ! stencil 4
            c(5,5)=  693._R_P/256._R_P; c(4,5)=-1155._R_P/256._R_P; c(3,5)=  693._R_P/128._R_P  ! stencil 5
            !   cell  2               ;    cell  1                ;    cell  0
            c(2,0)= -105._R_P/128._R_P; c(1,0)=  315._R_P/256._R_P; c(0,0)=   63._R_P/256._R_P  ! stencil 0
            c(2,1)=  105._R_P/128._R_P; c(1,1)=  105._R_P/256._R_P; c(0,1)=   -7._R_P/256._R_P  ! stencil 1
            c(2,2)=   75._R_P/128._R_P; c(1,2)=  -25._R_P/256._R_P; c(0,2)=    3._R_P/256._R_P  ! stencil 2
            c(2,3)=  -35._R_P/128._R_P; c(1,3)=   21._R_P/256._R_P; c(0,3)=   -3._R_P/256._R_P  ! stencil 3
            c(2,4)=   63._R_P/128._R_P; c(1,4)=  -45._R_P/256._R_P; c(0,4)=    7._R_P/256._R_P  ! stencil 4
            c(2,5)= -495._R_P/128._R_P; c(1,5)=  385._R_P/256._R_P; c(0,5)=  -63._R_P/256._R_P  ! stencil 5
          case(7) ! 13th order
            !  cell  6                ;    cell  5                ;    cell  4
            c(6,0)=  -21._R_P/1024._R_P; c(5,0)=   77._R_P/512._R_P ; c(4,0)= -495._R_P/1024._R_P  ! stencil 0
            c(6,1)=    7._R_P/1024._R_P; c(5,1)=  -27._R_P/512._R_P ; c(4,1)=  189._R_P/1024._R_P  ! stencil 1
            c(6,2)=   -5._R_P/1024._R_P; c(5,2)=   21._R_P/512._R_P ; c(4,2)= -175._R_P/1024._R_P  ! stencil 2
            c(6,3)=    7._R_P/1024._R_P; c(5,3)=  -35._R_P/512._R_P ; c(4,3)=  525._R_P/1024._R_P  ! stencil 3
            c(6,4)=  -21._R_P/1024._R_P; c(5,4)=  189._R_P/512._R_P ; c(4,4)=  945._R_P/1024._R_P  ! stencil 4
            c(6,5)=  231._R_P/1024._R_P; c(5,5)=  693._R_P/512._R_P ; c(4,5)=-1155._R_P/1024._R_P  ! stencil 5
            c(6,6)= 3003._R_P/1024._R_P; c(5,6)=-3003._R_P/512._R_P ; c(4,6)= 9009._R_P/1024._R_P  ! stencil 6
            !  cell  3                 ;   cell  2                ;    cell  1
            c(3,0)=  231._R_P/256._R_P ; c(2,0)=-1155._R_P/1024._R_P; c(1,0)=  693._R_P/512._R_P   ! stencil 0
            c(3,1)= -105._R_P/256._R_P ; c(2,1)=  945._R_P/1024._R_P; c(1,1)=  189._R_P/512._R_P   ! stencil 1
            c(3,2)=  175._R_P/256._R_P ; c(2,2)=  525._R_P/1024._R_P; c(1,2)=  -35._R_P/512._R_P   ! stencil 2
            c(3,3)=  175._R_P/256._R_P ; c(2,3)= -175._R_P/1024._R_P; c(1,3)=   21._R_P/512._R_P   ! stencil 3
            c(3,4)= -105._R_P/256._R_P ; c(2,4)=  189._R_P/1024._R_P; c(1,4)=  -27._R_P/512._R_P   ! stencil 4
            c(3,5)=  231._R_P/256._R_P ; c(2,5)= -495._R_P/1024._R_P; c(1,5)=   77._R_P/512._R_P   ! stencil 5
            c(3,6)=-2145._R_P/256._R_P ; c(2,6)= 5005._R_P/1024._R_P; c(1,6)= -819._R_P/512._R_P   ! stencil 6
            !  cell  0
            c(0,0)=  231._R_P/1024._R_P  ! stencil 0
            c(0,1)=  -21._R_P/1024._R_P  ! stencil 1
            c(0,2)=    7._R_P/1024._R_P  ! stencil 2
            c(0,3)=   -5._R_P/1024._R_P  ! stencil 3
            c(0,4)=    7._R_P/1024._R_P  ! stencil 4
            c(0,5)=  -21._R_P/1024._R_P  ! stencil 5
            c(0,6)=  231._R_P/1024._R_P  ! stencil 6
          case(8) ! 15th order
            !  cell  7                ;    cell  6                ;    cell  5
            c(7,0)=    33._R_P/2048._R_P; c(6,0)=  -273._R_P/2048._R_P; c(5,0)=  1001._R_P/2048._R_P  ! stencil 0
            c(7,1)=    -9._R_P/2048._R_P; c(6,1)=    77._R_P/2048._R_P; c(5,1)=  -297._R_P/2048._R_P  ! stencil 1
            c(7,2)=     5._R_P/2048._R_P; c(6,2)=   -45._R_P/2048._R_P; c(5,2)=   189._R_P/2048._R_P  ! stencil 2
            c(7,3)=    -5._R_P/2048._R_P; c(6,3)=    49._R_P/2048._R_P; c(5,3)=  -245._R_P/2048._R_P  ! stencil 3
            c(7,4)=     9._R_P/2048._R_P; c(6,4)=  -105._R_P/2048._R_P; c(5,4)=   945._R_P/2048._R_P  ! stencil 4
            c(7,5)=   -33._R_P/2048._R_P; c(6,5)=   693._R_P/2048._R_P; c(5,5)=  2079._R_P/2048._R_P  ! stencil 5
            c(7,6)=   429._R_P/2048._R_P; c(6,6)=  3003._R_P/2048._R_P; c(5,6)= -3003._R_P/2048._R_P  ! stencil 6
            c(7,7)=  6435._R_P/2048._R_P; c(6,7)=-15015._R_P/2048._R_P; c(5,7)= 27027._R_P/2048._R_P  ! stencil 7
            !  cell  4                ;    cell  3                ;    cell  2
            c(4,0)= -2145._R_P/2048._R_P; c(3,0)=  3003._R_P/2048._R_P; c(2,0)= -3003._R_P/2048._R_P  ! stencil 0
            c(4,1)=   693._R_P/2048._R_P; c(3,1)= -1155._R_P/2048._R_P; c(2,1)=  2079._R_P/2048._R_P  ! stencil 1
            c(4,2)=  -525._R_P/2048._R_P; c(3,2)=  1575._R_P/2048._R_P; c(2,2)=   945._R_P/2048._R_P  ! stencil 2
            c(4,3)=  1225._R_P/2048._R_P; c(3,3)=  1225._R_P/2048._R_P; c(2,3)=  -245._R_P/2048._R_P  ! stencil 3
            c(4,4)=  1575._R_P/2048._R_P; c(3,4)=  -525._R_P/2048._R_P; c(2,4)=   189._R_P/2048._R_P  ! stencil 4
            c(4,5)= -1155._R_P/2048._R_P; c(3,5)=   693._R_P/2048._R_P; c(2,5)=  -297._R_P/2048._R_P  ! stencil 5
            c(4,6)=  3003._R_P/2048._R_P; c(3,6)= -2145._R_P/2048._R_P; c(2,6)=  1001._R_P/2048._R_P  ! stencil 6
            c(4,7)=-32175._R_P/2048._R_P; c(3,7)= 25025._R_P/2048._R_P; c(2,7)=-12285._R_P/2048._R_P  ! stencil 7
            !  cell  1                ;    cell  0
            c(1,0)=  3003._R_P/2048._R_P; c(0,0)=   429._R_P/2048._R_P  ! stencil 0
            c(1,1)=   693._R_P/2048._R_P; c(0,1)=   -33._R_P/2048._R_P  ! stencil 1
            c(1,2)=  -105._R_P/2048._R_P; c(0,2)=     9._R_P/2048._R_P  ! stencil 2
            c(1,3)=    49._R_P/2048._R_P; c(0,3)=    -5._R_P/2048._R_P  ! stencil 3
            c(1,4)=   -45._R_P/2048._R_P; c(0,4)=     5._R_P/2048._R_P  ! stencil 4
            c(1,5)=    77._R_P/2048._R_P; c(0,5)=    -9._R_P/2048._R_P  ! stencil 5
            c(1,6)=  -273._R_P/2048._R_P; c(0,6)=    33._R_P/2048._R_P  ! stencil 6
            c(1,7)=  3465._R_P/2048._R_P; c(0,7)=  -429._R_P/2048._R_P  ! stencil 7
          case(9) ! 17th order
            !  cell  8                    ;     cell  7                   ;     cell  6
            c(8,0)=   -429._R_P/32768._R_P; c(7,0)=    495._R_P/4096._R_P ; c(6,0)=  -4095._R_P/8192._R_P   ! stencil 0
            c(8,1)=     99._R_P/32768._R_P; c(7,1)=   -117._R_P/4096._R_P ; c(6,1)=   1001._R_P/8192._R_P   ! stencil 1
            c(8,2)=    -45._R_P/32768._R_P; c(7,2)=     55._R_P/4096._R_P ; c(6,2)=   -495._R_P/8192._R_P   ! stencil 2
            c(8,3)=     35._R_P/32768._R_P; c(7,3)=    -45._R_P/4096._R_P ; c(6,3)=    441._R_P/8192._R_P   ! stencil 3
            c(8,4)=    -45._R_P/32768._R_P; c(7,4)=     63._R_P/4096._R_P ; c(6,4)=   -735._R_P/8192._R_P   ! stencil 4
            c(8,5)=     99._R_P/32768._R_P; c(7,5)=   -165._R_P/4096._R_P ; c(6,5)=   3465._R_P/8192._R_P   ! stencil 5
            c(8,6)=   -429._R_P/32768._R_P; c(7,6)=   1287._R_P/4096._R_P ; c(6,6)=   9009._R_P/8192._R_P   ! stencil 6
            c(8,7)=   6435._R_P/32768._R_P; c(7,7)=   6435._R_P/4096._R_P ; c(6,7)= -15015._R_P/8192._R_P   ! stencil 7
            c(8,8)= 109395._R_P/32768._R_P; c(7,8)= -36465._R_P/4096._R_P ; c(6,8)= 153153._R_P/8192._R_P   ! stencil 8
            !  cell  5                    ;    cell  4                    ;     cell  3
            c(5,0)=   5005._R_P/4096._R_P ; c(4,0)= -32175._R_P/16384._R_P; c(3,0)=   9009._R_P/4096._R_P   ! stencil 0
            c(5,1)=  -1287._R_P/4096._R_P ; c(4,1)=   9009._R_P/16384._R_P; c(3,1)=  -3003._R_P/4096._R_P   ! stencil 1
            c(5,2)=    693._R_P/4096._R_P ; c(4,2)=  -5775._R_P/16384._R_P; c(3,2)=   3465._R_P/4096._R_P   ! stencil 2
            c(5,3)=   -735._R_P/4096._R_P ; c(4,3)=  11025._R_P/16384._R_P; c(3,3)=   2205._R_P/4096._R_P   ! stencil 3
            c(5,4)=   2205._R_P/4096._R_P ; c(4,4)=  11025._R_P/16384._R_P; c(3,4)=   -735._R_P/4096._R_P   ! stencil 4
            c(5,5)=   3465._R_P/4096._R_P ; c(4,5)=  -5775._R_P/16384._R_P; c(3,5)=    693._R_P/4096._R_P   ! stencil 5
            c(5,6)=  -3003._R_P/4096._R_P ; c(4,6)=   9009._R_P/16384._R_P; c(3,6)=  -1287._R_P/4096._R_P   ! stencil 6
            c(5,7)=   9009._R_P/4096._R_P ; c(4,7)= -32175._R_P/16384._R_P; c(3,7)=   5005._R_P/4096._R_P   ! stencil 7
            c(5,8)=-109395._R_P/4096._R_P ; c(4,8)= 425425._R_P/16384._R_P; c(3,8)= -69615._R_P/4096._R_P   ! stencil 8
            !   cell  2                   ;     cell  1                   ;     cell  0
            c(2,0)= -15015._R_P/8192._R_P ; c(1,0)=   6435._R_P/4096._R_P ; c(0,0)=   6435._R_P/32768._R_P  ! stencil 0
            c(2,1)=   9009._R_P/8192._R_P ; c(1,1)=   1287._R_P/4096._R_P ; c(0,1)=   -429._R_P/32768._R_P  ! stencil 1
            c(2,2)=   3465._R_P/8192._R_P ; c(1,2)=   -165._R_P/4096._R_P ; c(0,2)=     99._R_P/32768._R_P  ! stencil 2
            c(2,3)=   -735._R_P/8192._R_P ; c(1,3)=     63._R_P/4096._R_P ; c(0,3)=    -45._R_P/32768._R_P  ! stencil 3
            c(2,4)=    441._R_P/8192._R_P ; c(1,4)=    -45._R_P/4096._R_P ; c(0,4)=     35._R_P/32768._R_P  ! stencil 4
            c(2,5)=   -495._R_P/8192._R_P ; c(1,5)=     55._R_P/4096._R_P ; c(0,5)=    -45._R_P/32768._R_P  ! stencil 5
            c(2,6)=   1001._R_P/8192._R_P ; c(1,6)=   -117._R_P/4096._R_P ; c(0,6)=     99._R_P/32768._R_P  ! stencil 6
            c(2,7)=  -4095._R_P/8192._R_P ; c(1,7)=    495._R_P/4096._R_P ; c(0,7)=   -429._R_P/32768._R_P  ! stencil 7
            c(2,8)=  58905._R_P/8192._R_P ; c(1,8)=  -7293._R_P/4096._R_P ; c(0,8)=   6435._R_P/32768._R_P  ! stencil 8
        endselect
      elseif(x_target==0.5_R_P) then
        ! right interface (i+1/2)
        select case(S)
          case(2) ! 3rd order
            !  cell  1      ;    cell  0
            c(1,0)= -0.5_R_P; c(0,0)=  1.5_R_P ! stencil 0
            c(1,1)=  0.5_R_P; c(0,1)=  0.5_R_P ! stencil 1
          case(3) ! 5th order
            !  cell  2            ;    cell  1            ;    cell  0
            c(2,0)=  3._R_P/8._R_P; c(1,0)= -5._R_P/4._R_P; c(0,0)= 15._R_P/8._R_P ! stencil 0
            c(2,1)= -1._R_P/8._R_P; c(1,1)=  3._R_P/4._R_P; c(0,1)=  3._R_P/8._R_P ! stencil 1
            c(2,2)=  3._R_P/8._R_P; c(1,2)=  3._R_P/4._R_P; c(0,2)= -1._R_P/8._R_P ! stencil 2
          case(4) ! 7th order
            !  cell  3             ;    cell  2             ;   cell  1              ;    cell  0
            c(3,0)= -5._R_P/16._R_P; c(2,0)= 21._R_P/16._R_P; c(1,0)=-35._R_P/16._R_P; c(0,0)= 35._R_P/16._R_P ! stencil 0
            c(3,1)=  1._R_P/16._R_P; c(2,1)= -5._R_P/16._R_P; c(1,1)= 15._R_P/16._R_P; c(0,1)=  5._R_P/16._R_P ! stencil 1
            c(3,2)= -1._R_P/16._R_P; c(2,2)=  9._R_P/16._R_P; c(1,2)=  9._R_P/16._R_P; c(0,2)= -1._R_P/16._R_P ! stencil 2
            c(3,3)=  5._R_P/16._R_P; c(2,3)= 15._R_P/16._R_P; c(1,3)= -5._R_P/16._R_P; c(0,3)=  1._R_P/16._R_P ! stencil 3
          case(5) ! 9th order
            !  cell  4               ;    cell  3               ;   cell  2                ;    cell  1
            c(4,0)=  35._R_P/128._R_P; c(3,0)= -45._R_P/32._R_P ; c(2,0)= 189._R_P/64._R_P ; c(1,0)=-105._R_P/32._R_P  ! stencil 0
            c(4,1)=  -5._R_P/128._R_P; c(3,1)=   7._R_P/32._R_P ; c(2,1)= -35._R_P/64._R_P ; c(1,1)=  35._R_P/32._R_P  ! stencil 1
            c(4,2)=   3._R_P/128._R_P; c(3,2)=  -5._R_P/32._R_P ; c(2,2)=  45._R_P/64._R_P ; c(1,2)=  15._R_P/32._R_P  ! stencil 2
            c(4,3)=  -5._R_P/128._R_P; c(3,3)=  15._R_P/32._R_P ; c(2,3)=  45._R_P/64._R_P ; c(1,3)=  -5._R_P/32._R_P  ! stencil 3
            c(4,4)=  35._R_P/128._R_P; c(3,4)=  35._R_P/32._R_P ; c(2,4)= -35._R_P/64._R_P ; c(1,4)=   7._R_P/32._R_P  ! stencil 4
            !  cell  0
            c(0,0)= 315._R_P/128._R_P ! stencil 0
            c(0,1)=  35._R_P/128._R_P ! stencil 1
            c(0,2)=  -5._R_P/128._R_P ! stencil 2
            c(0,3)=   3._R_P/128._R_P ! stencil 3
            c(0,4)=  -5._R_P/128._R_P ! stencil 4
          case(6) ! 11th order
            !  cell  5                ;    cell  4                ;   cell  3
            c(5,0)=  -63._R_P/256._R_P; c(4,0)=  385._R_P/256._R_P; c(3,0)= -495._R_P/128._R_P  ! stencil 0
            c(5,1)=    7._R_P/256._R_P; c(4,1)=  -45._R_P/256._R_P; c(3,1)=   63._R_P/128._R_P  ! stencil 1
            c(5,2)=   -3._R_P/256._R_P; c(4,2)=   21._R_P/256._R_P; c(3,2)=  -35._R_P/128._R_P  ! stencil 2
            c(5,3)=    3._R_P/256._R_P; c(4,3)=  -25._R_P/256._R_P; c(3,3)=   75._R_P/128._R_P  ! stencil 3
            c(5,4)=   -7._R_P/256._R_P; c(4,4)=  105._R_P/256._R_P; c(3,4)=  105._R_P/128._R_P  ! stencil 4
            c(5,5)=   63._R_P/256._R_P; c(4,5)=  315._R_P/256._R_P; c(3,5)= -105._R_P/128._R_P  ! stencil 5
            !  cell  2                ;    cell  1                ;   cell  0
            c(2,0)=  693._R_P/128._R_P; c(1,0)=-1155._R_P/256._R_P; c(0,0)=  693._R_P/256._R_P  ! stencil 0
            c(2,1)= -105._R_P/128._R_P; c(1,1)=  315._R_P/256._R_P; c(0,1)=   63._R_P/256._R_P  ! stencil 1
            c(2,2)=  105._R_P/128._R_P; c(1,2)=  105._R_P/256._R_P; c(0,2)=   -7._R_P/256._R_P  ! stencil 2
            c(2,3)=   75._R_P/128._R_P; c(1,3)=  -25._R_P/256._R_P; c(0,3)=    3._R_P/256._R_P  ! stencil 3
            c(2,4)=  -35._R_P/128._R_P; c(1,4)=   21._R_P/256._R_P; c(0,4)=   -3._R_P/256._R_P  ! stencil 4
            c(2,5)=   63._R_P/128._R_P; c(1,5)=  -45._R_P/256._R_P; c(0,5)=    7._R_P/256._R_P  ! stencil 5
          case(7) ! 13th order
            !  cell  6                ;    cell  5                ;    cell  4
            c(6,0)=  231._R_P/1024._R_P; c(5,0)= -819._R_P/512._R_P ; c(4,0)= 5005._R_P/1024._R_P  ! stencil 0
            c(6,1)=  -21._R_P/1024._R_P; c(5,1)=   77._R_P/512._R_P ; c(4,1)= -495._R_P/1024._R_P  ! stencil 1
            c(6,2)=    7._R_P/1024._R_P; c(5,2)=  -27._R_P/512._R_P ; c(4,2)=  189._R_P/1024._R_P  ! stencil 2
            c(6,3)=   -5._R_P/1024._R_P; c(5,3)=   21._R_P/512._R_P ; c(4,3)= -175._R_P/1024._R_P  ! stencil 3
            c(6,4)=    7._R_P/1024._R_P; c(5,4)=  -35._R_P/512._R_P ; c(4,4)=  525._R_P/1024._R_P  ! stencil 4
            c(6,5)=  -21._R_P/1024._R_P; c(5,5)=  189._R_P/512._R_P ; c(4,5)=  945._R_P/1024._R_P  ! stencil 5
            c(6,6)=  231._R_P/1024._R_P; c(5,6)=  693._R_P/512._R_P ; c(4,6)=-1155._R_P/1024._R_P  ! stencil 6
            !  cell  3                ;    cell  2                ;    cell  1
            c(3,0)=-2145._R_P/256._R_P ; c(2,0)= 9009._R_P/1024._R_P; c(1,0)=-3003._R_P/512._R_P   ! stencil 0
            c(3,1)=  231._R_P/256._R_P ; c(2,1)=-1155._R_P/1024._R_P; c(1,1)=  693._R_P/512._R_P   ! stencil 1
            c(3,2)= -105._R_P/256._R_P ; c(2,2)=  945._R_P/1024._R_P; c(1,2)=  189._R_P/512._R_P   ! stencil 2
            c(3,3)=  175._R_P/256._R_P ; c(2,3)=  525._R_P/1024._R_P; c(1,3)=  -35._R_P/512._R_P   ! stencil 3
            c(3,4)=  175._R_P/256._R_P ; c(2,4)= -175._R_P/1024._R_P; c(1,4)=   21._R_P/512._R_P   ! stencil 4
            c(3,5)= -105._R_P/256._R_P ; c(2,5)=  189._R_P/1024._R_P; c(1,5)=  -27._R_P/512._R_P   ! stencil 5
            c(3,6)=  231._R_P/256._R_P ; c(2,6)= -495._R_P/1024._R_P; c(1,6)=   77._R_P/512._R_P   ! stencil 6
            !  cell  0
            c(0,0)= 3003._R_P/1024._R_P  ! stencil 0
            c(0,1)=  231._R_P/1024._R_P  ! stencil 1
            c(0,2)=  -21._R_P/1024._R_P  ! stencil 2
            c(0,3)=    7._R_P/1024._R_P  ! stencil 3
            c(0,4)=   -5._R_P/1024._R_P  ! stencil 4
            c(0,5)=    7._R_P/1024._R_P  ! stencil 5
            c(0,6)=  -21._R_P/1024._R_P  ! stencil 6
          case(8) ! 15th order
            !  cell  7                ;    cell  6                ;    cell  5
            c(7,0)=  -429._R_P/2048._R_P; c(6,0)=  3465._R_P/2048._R_P; c(5,0)=-12285._R_P/2048._R_P  ! stencil 0
            c(7,1)=    33._R_P/2048._R_P; c(6,1)=  -273._R_P/2048._R_P; c(5,1)=  1001._R_P/2048._R_P  ! stencil 1
            c(7,2)=    -9._R_P/2048._R_P; c(6,2)=    77._R_P/2048._R_P; c(5,2)=  -297._R_P/2048._R_P  ! stencil 2
            c(7,3)=     5._R_P/2048._R_P; c(6,3)=   -45._R_P/2048._R_P; c(5,3)=   189._R_P/2048._R_P  ! stencil 3
            c(7,4)=    -5._R_P/2048._R_P; c(6,4)=    49._R_P/2048._R_P; c(5,4)=  -245._R_P/2048._R_P  ! stencil 4
            c(7,5)=     9._R_P/2048._R_P; c(6,5)=  -105._R_P/2048._R_P; c(5,5)=   945._R_P/2048._R_P  ! stencil 5
            c(7,6)=   -33._R_P/2048._R_P; c(6,6)=   693._R_P/2048._R_P; c(5,6)=  2079._R_P/2048._R_P  ! stencil 6
            c(7,7)=   429._R_P/2048._R_P; c(6,7)=  3003._R_P/2048._R_P; c(5,7)= -3003._R_P/2048._R_P  ! stencil 7
            !  cell  4                ;    cell  3                ;    cell  2
            c(4,0)= 25025._R_P/2048._R_P; c(3,0)=-32175._R_P/2048._R_P; c(2,0)= 27027._R_P/2048._R_P  ! stencil 0
            c(4,1)= -2145._R_P/2048._R_P; c(3,1)=  3003._R_P/2048._R_P; c(2,1)= -3003._R_P/2048._R_P  ! stencil 1
            c(4,2)=   693._R_P/2048._R_P; c(3,2)= -1155._R_P/2048._R_P; c(2,2)=  2079._R_P/2048._R_P  ! stencil 2
            c(4,3)=  -525._R_P/2048._R_P; c(3,3)=  1575._R_P/2048._R_P; c(2,3)=   945._R_P/2048._R_P  ! stencil 3
            c(4,4)=  1225._R_P/2048._R_P; c(3,4)=  1225._R_P/2048._R_P; c(2,4)=  -245._R_P/2048._R_P  ! stencil 4
            c(4,5)=  1575._R_P/2048._R_P; c(3,5)=  -525._R_P/2048._R_P; c(2,5)=   189._R_P/2048._R_P  ! stencil 5
            c(4,6)= -1155._R_P/2048._R_P; c(3,6)=   693._R_P/2048._R_P; c(2,6)=  -297._R_P/2048._R_P  ! stencil 6
            c(4,7)=  3003._R_P/2048._R_P; c(3,7)= -2145._R_P/2048._R_P; c(2,7)=  1001._R_P/2048._R_P  ! stencil 7
            !  cell  1                  ;    cell  0
            c(1,0)=-15015._R_P/2048._R_P; c(0,0)=  6435._R_P/2048._R_P  ! stencil 0
            c(1,1)=  3003._R_P/2048._R_P; c(0,1)=   429._R_P/2048._R_P  ! stencil 1
            c(1,2)=   693._R_P/2048._R_P; c(0,2)=   -33._R_P/2048._R_P  ! stencil 2
            c(1,3)=  -105._R_P/2048._R_P; c(0,3)=     9._R_P/2048._R_P  ! stencil 3
            c(1,4)=    49._R_P/2048._R_P; c(0,4)=    -5._R_P/2048._R_P  ! stencil 4
            c(1,5)=   -45._R_P/2048._R_P; c(0,5)=     5._R_P/2048._R_P  ! stencil 5
            c(1,6)=    77._R_P/2048._R_P; c(0,6)=    -9._R_P/2048._R_P  ! stencil 6
            c(1,7)=  -273._R_P/2048._R_P; c(0,7)=    33._R_P/2048._R_P  ! stencil 7
          case(9) ! 17th order
            !  cell  8                  ;     cell  7                 ;     cell  6
            c(8,0)=   6435._R_P/32768._R_P; c(7,0)=  -7293._R_P/ 4096._R_P; c(6,0)=  58905._R_P/ 8192._R_P  ! stencil 0
            c(8,1)=   -429._R_P/32768._R_P; c(7,1)=    495._R_P/ 4096._R_P; c(6,1)=  -4095._R_P/ 8192._R_P  ! stencil 1
            c(8,2)=     99._R_P/32768._R_P; c(7,2)=   -117._R_P/ 4096._R_P; c(6,2)=   1001._R_P/ 8192._R_P  ! stencil 2
            c(8,3)=    -45._R_P/32768._R_P; c(7,3)=     55._R_P/ 4096._R_P; c(6,3)=   -495._R_P/ 8192._R_P  ! stencil 3
            c(8,4)=     35._R_P/32768._R_P; c(7,4)=    -45._R_P/ 4096._R_P; c(6,4)=    441._R_P/ 8192._R_P  ! stencil 4
            c(8,5)=    -45._R_P/32768._R_P; c(7,5)=     63._R_P/ 4096._R_P; c(6,5)=   -735._R_P/ 8192._R_P  ! stencil 5
            c(8,6)=     99._R_P/32768._R_P; c(7,6)=   -165._R_P/ 4096._R_P; c(6,6)=   3465._R_P/ 8192._R_P  ! stencil 6
            c(8,7)=   -429._R_P/32768._R_P; c(7,7)=   1287._R_P/ 4096._R_P; c(6,7)=   9009._R_P/ 8192._R_P  ! stencil 7
            c(8,8)=   6435._R_P/32768._R_P; c(7,8)=   6435._R_P/ 4096._R_P; c(6,8)= -15015._R_P/ 8192._R_P  ! stencil 8
            !   cell  5                 ; !  cell  4                  ;     cell  3
            c(5,0)= -69615._R_P/ 4096._R_P; c(4,0)= 425425._R_P/16384._R_P; c(3,0)=-109395._R_P/ 4096._R_P  ! stencil 0
            c(5,1)=   5005._R_P/ 4096._R_P; c(4,1)= -32175._R_P/16384._R_P; c(3,1)=   9009._R_P/ 4096._R_P  ! stencil 1
            c(5,2)=  -1287._R_P/ 4096._R_P; c(4,2)=   9009._R_P/16384._R_P; c(3,2)=  -3003._R_P/ 4096._R_P  ! stencil 2
            c(5,3)=    693._R_P/ 4096._R_P; c(4,3)=  -5775._R_P/16384._R_P; c(3,3)=   3465._R_P/ 4096._R_P  ! stencil 3
            c(5,4)=   -735._R_P/ 4096._R_P; c(4,4)=  11025._R_P/16384._R_P; c(3,4)=   2205._R_P/ 4096._R_P  ! stencil 4
            c(5,5)=   2205._R_P/ 4096._R_P; c(4,5)=  11025._R_P/16384._R_P; c(3,5)=   -735._R_P/ 4096._R_P  ! stencil 5
            c(5,6)=   3465._R_P/ 4096._R_P; c(4,6)=  -5775._R_P/16384._R_P; c(3,6)=    693._R_P/ 4096._R_P  ! stencil 6
            c(5,7)=  -3003._R_P/ 4096._R_P; c(4,7)=   9009._R_P/16384._R_P; c(3,7)=  -1287._R_P/ 4096._R_P  ! stencil 7
            c(5,8)=   9009._R_P/ 4096._R_P; c(4,8)= -32175._R_P/16384._R_P; c(3,8)=   5005._R_P/ 4096._R_P  ! stencil 8
            !   cell  2                 ;     cell  1                 ;     cell  0
            c(2,0)= 153153._R_P/ 8192._R_P; c(1,0)= -36465._R_P/ 4096._R_P; c(0,0)= 109395._R_P/32768._R_P  ! stencil 0
            c(2,1)= -15015._R_P/ 8192._R_P; c(1,1)=   6435._R_P/ 4096._R_P; c(0,1)=   6435._R_P/32768._R_P  ! stencil 1
            c(2,2)=   9009._R_P/ 8192._R_P; c(1,2)=   1287._R_P/ 4096._R_P; c(0,2)=   -429._R_P/32768._R_P  ! stencil 2
            c(2,3)=   3465._R_P/ 8192._R_P; c(1,3)=   -165._R_P/ 4096._R_P; c(0,3)=     99._R_P/32768._R_P  ! stencil 3
            c(2,4)=   -735._R_P/ 8192._R_P; c(1,4)=     63._R_P/ 4096._R_P; c(0,4)=    -45._R_P/32768._R_P  ! stencil 4
            c(2,5)=    441._R_P/ 8192._R_P; c(1,5)=    -45._R_P/ 4096._R_P; c(0,5)=     35._R_P/32768._R_P  ! stencil 5
            c(2,6)=   -495._R_P/ 8192._R_P; c(1,6)=     55._R_P/ 4096._R_P; c(0,6)=    -45._R_P/32768._R_P  ! stencil 6
            c(2,7)=   1001._R_P/ 8192._R_P; c(1,7)=   -117._R_P/ 4096._R_P; c(0,7)=     99._R_P/32768._R_P  ! stencil 7
            c(2,8)=  -4095._R_P/ 8192._R_P; c(1,8)=    495._R_P/ 4096._R_P; c(0,8)=   -429._R_P/32768._R_P  ! stencil 8
        endselect
      else
        ! internal point
        do k=0,S-1  !stencils loop
          c_sum = 0._R_P
          do j=0,S-2  !values loop
            prod = 1._R_P
            do i=0,S-1
              if (i==j) cycle
              prod = prod * ((x_target - (-S+k+i+1)) / ((-S+k+j+1) - (-S+k+i+1)))
            enddo
            c(S-1-j,k) = prod
            c_sum = c_sum + prod
          enddo
          c(0,k) = 1._R_P - c_sum
        enddo
      endif
    endassociate
  endselect
  endsubroutine create

  pure subroutine compute_int(self, stencil, values)
  !< Compute interpolations (interpolation).
  class(interpolations_int_js), intent(in)  :: self               !< Interpolations.
  real(R_P),                    intent(in)  :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S].
  real(R_P),                    intent(out) :: values(0:)         !< Interpolations values.
  integer(I_P)                              :: s1                 !< Counter.
  integer(I_P)                              :: s2                 !< Counter.

  values = 0._R_P
  do s1=0, self%S - 1 ! stencils loop
    do s2=0, self%S - 1 ! values loop
      values(s1) = values(s1) + self%coef(s2, s1) * stencil(-s2 + s1)
    enddo
  enddo
  endsubroutine compute_int

  pure subroutine compute_rec(self, stencil, values)
  !< Compute interpolations (reconstruct).
  class(interpolations_int_js), intent(in)  :: self                  !< Interpolations.
  real(R_P),                    intent(in)  :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S].
  real(R_P),                    intent(out) :: values(1:, 0:)        !< Interpolations values.
  ! empty procedure
  endsubroutine compute_rec

  pure function description(self, prefix) result(string)
  !< Return object string-descripition.
  class(interpolations_int_js), intent(in)           :: self             !< Interpolations.
  character(len=*),             intent(in), optional :: prefix           !< Prefixing string.
  character(len=:), allocatable                      :: string           !< String-description.
  character(len=:), allocatable                      :: prefix_          !< Prefixing string, local variable.
  character(len=1), parameter                        :: NL=new_line('a') !< New line char.

  prefix_ = '' ; if (present(prefix)) prefix_ = prefix
  string = prefix_//'Jiang-Shu beta interpolations object for interpolation:'//NL
  string = string//prefix_//'  - S   = '//trim(str(self%S))
  endfunction description

  elemental subroutine destroy(self)
  !< Destroy interpolations.
  class(interpolations_int_js), intent(inout) :: self !< Interpolations.

  call self%destroy_
  if (allocated(self%coef)) deallocate(self%coef)
  endsubroutine destroy

  pure subroutine object_assign_object(lhs, rhs)
  !< `=` operator.
  class(interpolations_int_js), intent(inout) :: lhs !< Left hand side.
  class(base_object),           intent(in)    :: rhs !< Right hand side.

  call lhs%assign_(rhs=rhs)
  select type(rhs)
  type is(interpolations_int_js)
     if (allocated(rhs%coef)) then
        lhs%coef = rhs%coef
     else
        if (allocated(lhs%coef)) deallocate(lhs%coef)
     endif
  endselect
  endsubroutine object_assign_object
endmodule wenoof_interpolations_int_js


      subroutine compute_gvarimage_resolution(rp_div,rl_div,
     &rpix,rline,start_pix,start_line,r_img_res_m,istatus)
c
c
      implicit none

      Real*8        rlat8_1,rlat8_2,rlat8_3
      Real*8        rlon8_1,rlon8_2,rlon8_3
      Real*8        elev1,elev2,scan1,scan2
      Real*8        scpx,evln
      Real*8        RL
      Real*8        RP

      Real        rlat1,rlat2,rlat3,rlon1,rlon2,rlon3
      Real        grid_spacing_scan,grid_spacing_elev
      Real        rpix,rline
      Real*8        radtodeg
      Real*8        pi
      Real        r_img_res_m
      Real*8        rl_div
      Real*8        rp_div

      Integer     instr
      Integer     istatus
      Integer     ierr
      Integer     start_line
      Integer     start_pix
      real        cosd
c --------------------------------------------
c start
c
      istatus=0

      pi=acos(-1.)
      radtodeg=180.d0/pi
      instr = 1  !imager=1, sounder = 2.
c
c compute image resolution in meters
c
      RP=float(int( ( (rpix -1.) *rp_div ) +start_pix) )
      RL=float(int( ( (rline-1.) *rl_div ) +start_line))

      elev1 = evln(instr,RL)
      scan1 = scpx(instr,RP)
      call lpoint(elev1,scan1,rlat8_1,rlon8_1,ierr)

      elev2 = evln(instr,RL+rl_div)
      scan2 = scpx(instr,RP+rp_div)
      call lpoint(elev1,scan2,rlat8_2,rlon8_2,ierr)
      call lpoint(elev2,scan1,rlat8_3,rlon8_3,ierr)

      rlat1=rlat8_1*radtodeg
      rlat2=rlat8_2*radtodeg
      rlon1=rlon8_1*radtodeg
      rlon2=rlon8_2*radtodeg
      rlat3=rlat8_3*radtodeg
      rlon3=rlon8_3*radtodeg

      grid_spacing_scan = sqrt( (rlat1-rlat2)**2 +
     1             ((rlon1-rlon2)*cosd(rlat1))**2)
      grid_spacing_scan = grid_spacing_scan*111.1*1000.0   !result in meters

      grid_spacing_elev=sqrt( (rlat1-rlat3)**2 +
     1             ((rlon1-rlon3)*cosd(rlat1))**2)
      grid_spacing_elev=grid_spacing_elev*111.1*1000.0   !result in meters

      r_img_res_m=(grid_spacing_scan+grid_spacing_elev)/2.0

      write(6,*)'Image Resolution (m): ',r_img_res_m

      if(ierr.ne.0)istatus=-1
      return
      end