Module m_rinpar
Integer, Parameter :: kdp = selected_real_kind(15)
public :: rinpar
private :: kdp
private :: R_rinpar, I_rinpar, D_rinpar
interface rinpar
  module procedure d_rinpar, r_rinpar, i_rinpar
end interface rinpar
contains

Subroutine D_rinpar (XDONT, IRNGT, NORD)
!  Ranks partially XDONT by IRNGT, up to order NORD = size (IRNGT)
! __________________________________________________________
!  This subroutine uses insertion sort, limiting insertion
!  to the first NORD values. It does not use any work array
!  and is faster when NORD is very small (2-5), but worst case
!  behavior can happen fairly probably (initially inverse sorted)
!  In many cases, the refined quicksort method is faster.
!  Michel Olagnon - Feb. 2000
! __________________________________________________________
! __________________________________________________________
      Real (kind=kdp), Dimension (:), Intent (In) :: XDONT
      Integer, Dimension (:), Intent (Out) :: IRNGT
      Integer, Intent (In) :: NORD
! __________________________________________________________
      Real (kind=kdp) :: XWRK, XWRK1
!
      Integer :: ICRS, IDCR
!
      IRNGT (1) = 1
      Do ICRS = 2, NORD
         XWRK = XDONT (ICRS)
         Do IDCR = ICRS - 1, 1, - 1
            If (XWRK >= XDONT(IRNGT(IDCR))) Exit
            IRNGT (IDCR+1) = IRNGT (IDCR)
         End Do
         IRNGT (IDCR+1) = ICRS
      End Do
!
      XWRK1 = XDONT (IRNGT(NORD))
      Do ICRS = NORD + 1, SIZE (XDONT)
         If (XDONT(ICRS) < XWRK1) Then
            XWRK = XDONT (ICRS)
            Do IDCR = NORD - 1, 1, - 1
               If (XWRK >= XDONT(IRNGT(IDCR))) Exit
               IRNGT (IDCR+1) = IRNGT (IDCR)
            End Do
            IRNGT (IDCR+1) = ICRS
            XWRK1 = XDONT (IRNGT(NORD))
         End If
      End Do
!
!
End Subroutine D_rinpar

Subroutine R_rinpar (XDONT, IRNGT, NORD)
!  Ranks partially XDONT by IRNGT, up to order NORD = size (IRNGT)
! __________________________________________________________
!  This subroutine uses insertion sort, limiting insertion
!  to the first NORD values. It does not use any work array
!  and is faster when NORD is very small (2-5), but worst case
!  behavior can happen fairly probably (initially inverse sorted)
!  In many cases, the refined quicksort method is faster.
!  Michel Olagnon - Feb. 2000
! __________________________________________________________
! _________________________________________________________
      Real, Dimension (:), Intent (In) :: XDONT
      Integer, Dimension (:), Intent (Out) :: IRNGT
      Integer, Intent (In) :: NORD
! __________________________________________________________
      Real    :: XWRK, XWRK1
!
      Integer :: ICRS, IDCR
!
      IRNGT (1) = 1
      Do ICRS = 2, NORD
         XWRK = XDONT (ICRS)
         Do IDCR = ICRS - 1, 1, - 1
            If (XWRK >= XDONT(IRNGT(IDCR))) Exit
            IRNGT (IDCR+1) = IRNGT (IDCR)
         End Do
         IRNGT (IDCR+1) = ICRS
      End Do
!
      XWRK1 = XDONT (IRNGT(NORD))
      Do ICRS = NORD + 1, SIZE (XDONT)
         If (XDONT(ICRS) < XWRK1) Then
            XWRK = XDONT (ICRS)
            Do IDCR = NORD - 1, 1, - 1
               If (XWRK >= XDONT(IRNGT(IDCR))) Exit
               IRNGT (IDCR+1) = IRNGT (IDCR)
            End Do
            IRNGT (IDCR+1) = ICRS
            XWRK1 = XDONT (IRNGT(NORD))
         End If
      End Do
!
!
End Subroutine R_rinpar
Subroutine I_rinpar (XDONT, IRNGT, NORD)
!  Ranks partially XDONT by IRNGT, up to order NORD = size (IRNGT)
! __________________________________________________________
!  This subroutine uses insertion sort, limiting insertion
!  to the first NORD values. It does not use any work array
!  and is faster when NORD is very small (2-5), but worst case
!  behavior can happen fairly probably (initially inverse sorted)
!  In many cases, the refined quicksort method is faster.
!  Michel Olagnon - Feb. 2000
! __________________________________________________________
! __________________________________________________________
      Integer, Dimension (:), Intent (In)  :: XDONT
      Integer, Dimension (:), Intent (Out) :: IRNGT
      Integer, Intent (In) :: NORD
! __________________________________________________________
      Integer :: XWRK, XWRK1
!
      Integer :: ICRS, IDCR
!
      IRNGT (1) = 1
      Do ICRS = 2, NORD
         XWRK = XDONT (ICRS)
         Do IDCR = ICRS - 1, 1, - 1
            If (XWRK >= XDONT(IRNGT(IDCR))) Exit
            IRNGT (IDCR+1) = IRNGT (IDCR)
         End Do
         IRNGT (IDCR+1) = ICRS
      End Do
!
      XWRK1 = XDONT (IRNGT(NORD))
      Do ICRS = NORD + 1, SIZE (XDONT)
         If (XDONT(ICRS) < XWRK1) Then
            XWRK = XDONT (ICRS)
            Do IDCR = NORD - 1, 1, - 1
               If (XWRK >= XDONT(IRNGT(IDCR))) Exit
               IRNGT (IDCR+1) = IRNGT (IDCR)
            End Do
            IRNGT (IDCR+1) = ICRS
            XWRK1 = XDONT (IRNGT(NORD))
         End If
      End Do
!
!
End Subroutine I_rinpar
end module m_rinpar