Module M_orderpack__unirnk use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64, real32, real64, real128 implicit none Private integer,parameter :: f_char=selected_char_kind("DEFAULT") public :: unirnk !> !!##NAME !! Rank_Unique(3f) - [M_orderpack:RANK:UNIQUE] ranks an array, with removal !! of duplicate entries (Merge-Sort) !! !!##SYNOPSIS !! !! Subroutine rank_unique (INVALS, IRNGT, NUNI) !! !! ${TYPE} (Kind=${KIND}), Intent (In) :: INVALS(:) !! Integer, Intent (Out) :: IRNGT(:) !! Integer, Intent (Out) :: NUNI !! !! Where ${TYPE}(kind=${KIND}) may be !! !! o Real(kind=real32) !! o Real(kind=real64) !! o Integer(kind=int32) !! !!##DESCRIPTION !! !! Ranks an array, removing duplicate entries. !! !! Internally, RANK_UNIQUE(3f) performs a Merge-sort ranking of an array, !! with removal of duplicate entries. !! !! The routine is similar to pure merge-sort ranking, but on the last !! pass, it discards indices that correspond to duplicate entries. !! !! For performance reasons, the first two passes are taken out of the !! standard loop, and use dedicated coding. !! !!##OPTIONS !! INVALS array to index !! IRNGT rank index returned pointing to unique values !! NUNI the number of unique values found !! !!##EXAMPLES !! !! Sample program: !! !! program demo_rank_unique !! ! rank an array, with removal of duplicate entries. !! use M_orderpack, only : rank_unique !! implicit none !! character(len=*),parameter :: g='(*(g0,1x))' !! integer,allocatable :: INVALS(:) !! ! !! INVALS=[10,5,7,1,4,5,6,8,9,10,1] !! call printme() !! INVALS=[-1,0,-2,0,-3,0,-4] !! call printme() !! contains !! subroutine printme() !! integer,allocatable :: irngt(:) !! integer :: nuni !! if(allocated(irngt))deallocate(irngt) !! allocate(irngt(size(INVALS))) !! write(*,g)'ORIGINAL:',INVALS !! call rank_unique(INVALS,irngt,nuni) !! write(*,g)'NUMBER OF UNIQUE INDICES:',nuni !! write(*,g)'RETURNED INDICES:',irngt(:nuni) !! write(*,g)'SORTED DATA:',INVALS(irngt(:nuni)) !! end subroutine !! end program demo_rank_unique !! !! Results: !! !! ORIGINAL: 10 5 7 1 4 5 6 8 9 10 1 !! NUMBER OF UNIQUE INDICES: 8 !! RETURNED INDICES: 4 5 2 7 3 8 9 1 !! SORTED DATA: 1 4 5 6 7 8 9 10 !! ORIGINAL: -1 0 -2 0 -3 0 -4 !! NUMBER OF UNIQUE INDICES: 5 !! RETURNED INDICES: 7 5 3 1 2 !! SORTED DATA: -4 -3 -2 -1 0 !! !!##AUTHOR !! Michel Olagnon, 2000-2012 !!##MAINTAINER !! John Urban, 2022.04.16 !!##LICENSE !! CC0-1.0 interface unirnk module procedure real64_unirnk, real32_unirnk, int32_unirnk !, f_char_unirnk end interface unirnk interface nearless module procedure real64_nearless, real32_nearless, int32_nearless !, f_char_nearless end interface nearless contains Subroutine real64_unirnk (INVALS, IRNGT, NUNI) Real (Kind=real64), Dimension (:), Intent (In) :: INVALS Integer, Dimension (:), Intent (Out) :: IRNGT Integer, Intent (Out) :: NUNI ! __________________________________________________________ Integer, Dimension (SIZE(IRNGT)) :: JWRKT Integer :: LMTNA, LMTNC, IRNG, IRNG1, IRNG2 Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB Real (Kind=real64) :: XTST, XVALA, XVALB ! ! NVAL = Min (SIZE(INVALS), SIZE(IRNGT)) NUNI = NVAL ! Select Case (NVAL) Case (:0) Return Case (1) IRNGT (1) = 1 Return Case Default Continue End Select ! ! Fill-in the index array, creating ordered couples ! Do IIND = 2, NVAL, 2 If (INVALS(IIND-1) < INVALS(IIND)) Then IRNGT (IIND-1) = IIND - 1 IRNGT (IIND) = IIND Else IRNGT (IIND-1) = IIND IRNGT (IIND) = IIND - 1 End If End Do If (Modulo(NVAL, 2) /= 0) Then IRNGT (NVAL) = NVAL End If ! ! We will now have ordered subsets A - B - A - B - ... ! and merge A and B couples into C - C - ... ! LMTNA = 2 LMTNC = 4 ! ! First iteration. The length of the ordered subsets goes from 2 to 4 ! Do If (NVAL <= 4) Exit ! ! Loop on merges of A and B into C ! Do IWRKD = 0, NVAL - 1, 4 If ((IWRKD+4) > NVAL) Then If ((IWRKD+2) >= NVAL) Exit ! ! 1 2 3 ! If (INVALS(IRNGT(IWRKD+2)) <= INVALS(IRNGT(IWRKD+3))) Exit ! ! 1 3 2 ! If (INVALS(IRNGT(IWRKD+1)) <= INVALS(IRNGT(IWRKD+3))) Then IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNGT (IWRKD+3) IRNGT (IWRKD+3) = IRNG2 ! ! 3 1 2 ! Else IRNG1 = IRNGT (IWRKD+1) IRNGT (IWRKD+1) = IRNGT (IWRKD+3) IRNGT (IWRKD+3) = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNG1 End If Exit End If ! ! 1 2 3 4 ! If (INVALS(IRNGT(IWRKD+2)) <= INVALS(IRNGT(IWRKD+3))) Cycle ! ! 1 3 x x ! If (INVALS(IRNGT(IWRKD+1)) <= INVALS(IRNGT(IWRKD+3))) Then IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNGT (IWRKD+3) If (INVALS(IRNG2) <= INVALS(IRNGT(IWRKD+4))) Then ! 1 3 2 4 IRNGT (IWRKD+3) = IRNG2 Else ! 1 3 4 2 IRNGT (IWRKD+3) = IRNGT (IWRKD+4) IRNGT (IWRKD+4) = IRNG2 End If ! ! 3 x x x ! Else IRNG1 = IRNGT (IWRKD+1) IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+1) = IRNGT (IWRKD+3) If (INVALS(IRNG1) <= INVALS(IRNGT(IWRKD+4))) Then IRNGT (IWRKD+2) = IRNG1 If (INVALS(IRNG2) <= INVALS(IRNGT(IWRKD+4))) Then ! 3 1 2 4 IRNGT (IWRKD+3) = IRNG2 Else ! 3 1 4 2 IRNGT (IWRKD+3) = IRNGT (IWRKD+4) IRNGT (IWRKD+4) = IRNG2 End If Else ! 3 4 1 2 IRNGT (IWRKD+2) = IRNGT (IWRKD+4) IRNGT (IWRKD+3) = IRNG1 IRNGT (IWRKD+4) = IRNG2 End If End If End Do ! ! The Cs become As and Bs ! LMTNA = 4 Exit End Do ! ! Iteration loop. Each time, the length of the ordered subsets ! is doubled. ! Do If (2*LMTNA >= NVAL) Exit IWRKF = 0 LMTNC = 2 * LMTNC ! ! Loop on merges of A and B into C ! Do IWRK = IWRKF IWRKD = IWRKF + 1 JINDA = IWRKF + LMTNA IWRKF = IWRKF + LMTNC If (IWRKF >= NVAL) Then If (JINDA >= NVAL) Exit IWRKF = NVAL End If IINDA = 1 IINDB = JINDA + 1 ! ! One steps in the C subset, that we create in the final rank array ! ! Make a copy of the rank array for the iteration ! JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA) XVALA = INVALS (JWRKT(IINDA)) XVALB = INVALS (IRNGT(IINDB)) ! Do IWRK = IWRK + 1 ! ! We still have unprocessed values in both A and B ! If (XVALA > XVALB) Then IRNGT (IWRK) = IRNGT (IINDB) IINDB = IINDB + 1 If (IINDB > IWRKF) Then ! Only A still with unprocessed values IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA) Exit End If XVALB = INVALS (IRNGT(IINDB)) Else IRNGT (IWRK) = JWRKT (IINDA) IINDA = IINDA + 1 If (IINDA > LMTNA) Exit! Only B still with unprocessed values XVALA = INVALS (JWRKT(IINDA)) End If ! End Do End Do ! ! The Cs become As and Bs ! LMTNA = 2 * LMTNA End Do ! ! Last merge of A and B into C, with removal of duplicates. ! IINDA = 1 IINDB = LMTNA + 1 NUNI = 0 ! ! One steps in the C subset, that we create in the final rank array ! JWRKT (1:LMTNA) = IRNGT (1:LMTNA) If (IINDB <= NVAL) Then XTST = NEARLESS (Min(INVALS(JWRKT(1)), INVALS(IRNGT(IINDB)))) Else XTST = NEARLESS (INVALS(JWRKT(1))) Endif Do IWRK = 1, NVAL ! ! We still have unprocessed values in both A and B ! If (IINDA <= LMTNA) Then If (IINDB <= NVAL) Then If (INVALS(JWRKT(IINDA)) > INVALS(IRNGT(IINDB))) Then IRNG = IRNGT (IINDB) IINDB = IINDB + 1 Else IRNG = JWRKT (IINDA) IINDA = IINDA + 1 End If Else ! ! Only A still with unprocessed values ! IRNG = JWRKT (IINDA) IINDA = IINDA + 1 End If Else ! ! Only B still with unprocessed values ! IRNG = IRNGT (IWRK) End If If (INVALS(IRNG) > XTST) Then XTST = INVALS (IRNG) NUNI = NUNI + 1 IRNGT (NUNI) = IRNG End If ! End Do ! Return ! End Subroutine real64_unirnk Function real64_nearless (XVAL) result (real64_nl) !! Nearest value less than given value ! __________________________________________________________ Real (kind=real64), Intent (In) :: XVAL Real (kind=real64) :: real64_nl ! __________________________________________________________ real64_nl = nearest (XVAL, -1.0_real64) ! End Function real64_nearless Subroutine real32_unirnk (INVALS, IRNGT, NUNI) Real (Kind=real32), Dimension (:), Intent (In) :: INVALS Integer, Dimension (:), Intent (Out) :: IRNGT Integer, Intent (Out) :: NUNI ! __________________________________________________________ Integer, Dimension (SIZE(IRNGT)) :: JWRKT Integer :: LMTNA, LMTNC, IRNG, IRNG1, IRNG2 Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB Real (Kind=real32) :: XTST, XVALA, XVALB ! ! NVAL = Min (SIZE(INVALS), SIZE(IRNGT)) NUNI = NVAL ! Select Case (NVAL) Case (:0) Return Case (1) IRNGT (1) = 1 Return Case Default Continue End Select ! ! Fill-in the index array, creating ordered couples ! Do IIND = 2, NVAL, 2 If (INVALS(IIND-1) < INVALS(IIND)) Then IRNGT (IIND-1) = IIND - 1 IRNGT (IIND) = IIND Else IRNGT (IIND-1) = IIND IRNGT (IIND) = IIND - 1 End If End Do If (Modulo(NVAL, 2) /= 0) Then IRNGT (NVAL) = NVAL End If ! ! We will now have ordered subsets A - B - A - B - ... ! and merge A and B couples into C - C - ... ! LMTNA = 2 LMTNC = 4 ! ! First iteration. The length of the ordered subsets goes from 2 to 4 ! Do If (NVAL <= 4) Exit ! ! Loop on merges of A and B into C ! Do IWRKD = 0, NVAL - 1, 4 If ((IWRKD+4) > NVAL) Then If ((IWRKD+2) >= NVAL) Exit ! ! 1 2 3 ! If (INVALS(IRNGT(IWRKD+2)) <= INVALS(IRNGT(IWRKD+3))) Exit ! ! 1 3 2 ! If (INVALS(IRNGT(IWRKD+1)) <= INVALS(IRNGT(IWRKD+3))) Then IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNGT (IWRKD+3) IRNGT (IWRKD+3) = IRNG2 ! ! 3 1 2 ! Else IRNG1 = IRNGT (IWRKD+1) IRNGT (IWRKD+1) = IRNGT (IWRKD+3) IRNGT (IWRKD+3) = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNG1 End If Exit End If ! ! 1 2 3 4 ! If (INVALS(IRNGT(IWRKD+2)) <= INVALS(IRNGT(IWRKD+3))) Cycle ! ! 1 3 x x ! If (INVALS(IRNGT(IWRKD+1)) <= INVALS(IRNGT(IWRKD+3))) Then IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNGT (IWRKD+3) If (INVALS(IRNG2) <= INVALS(IRNGT(IWRKD+4))) Then ! 1 3 2 4 IRNGT (IWRKD+3) = IRNG2 Else ! 1 3 4 2 IRNGT (IWRKD+3) = IRNGT (IWRKD+4) IRNGT (IWRKD+4) = IRNG2 End If ! ! 3 x x x ! Else IRNG1 = IRNGT (IWRKD+1) IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+1) = IRNGT (IWRKD+3) If (INVALS(IRNG1) <= INVALS(IRNGT(IWRKD+4))) Then IRNGT (IWRKD+2) = IRNG1 If (INVALS(IRNG2) <= INVALS(IRNGT(IWRKD+4))) Then ! 3 1 2 4 IRNGT (IWRKD+3) = IRNG2 Else ! 3 1 4 2 IRNGT (IWRKD+3) = IRNGT (IWRKD+4) IRNGT (IWRKD+4) = IRNG2 End If Else ! 3 4 1 2 IRNGT (IWRKD+2) = IRNGT (IWRKD+4) IRNGT (IWRKD+3) = IRNG1 IRNGT (IWRKD+4) = IRNG2 End If End If End Do ! ! The Cs become As and Bs ! LMTNA = 4 Exit End Do ! ! Iteration loop. Each time, the length of the ordered subsets ! is doubled. ! Do If (2*LMTNA >= NVAL) Exit IWRKF = 0 LMTNC = 2 * LMTNC ! ! Loop on merges of A and B into C ! Do IWRK = IWRKF IWRKD = IWRKF + 1 JINDA = IWRKF + LMTNA IWRKF = IWRKF + LMTNC If (IWRKF >= NVAL) Then If (JINDA >= NVAL) Exit IWRKF = NVAL End If IINDA = 1 IINDB = JINDA + 1 ! ! One steps in the C subset, that we create in the final rank array ! ! Make a copy of the rank array for the iteration ! JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA) XVALA = INVALS (JWRKT(IINDA)) XVALB = INVALS (IRNGT(IINDB)) ! Do IWRK = IWRK + 1 ! ! We still have unprocessed values in both A and B ! If (XVALA > XVALB) Then IRNGT (IWRK) = IRNGT (IINDB) IINDB = IINDB + 1 If (IINDB > IWRKF) Then ! Only A still with unprocessed values IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA) Exit End If XVALB = INVALS (IRNGT(IINDB)) Else IRNGT (IWRK) = JWRKT (IINDA) IINDA = IINDA + 1 If (IINDA > LMTNA) Exit! Only B still with unprocessed values XVALA = INVALS (JWRKT(IINDA)) End If ! End Do End Do ! ! The Cs become As and Bs ! LMTNA = 2 * LMTNA End Do ! ! Last merge of A and B into C, with removal of duplicates. ! IINDA = 1 IINDB = LMTNA + 1 NUNI = 0 ! ! One steps in the C subset, that we create in the final rank array ! JWRKT (1:LMTNA) = IRNGT (1:LMTNA) If (IINDB <= NVAL) Then XTST = NEARLESS (Min(INVALS(JWRKT(1)), INVALS(IRNGT(IINDB)))) Else XTST = NEARLESS (INVALS(JWRKT(1))) Endif Do IWRK = 1, NVAL ! ! We still have unprocessed values in both A and B ! If (IINDA <= LMTNA) Then If (IINDB <= NVAL) Then If (INVALS(JWRKT(IINDA)) > INVALS(IRNGT(IINDB))) Then IRNG = IRNGT (IINDB) IINDB = IINDB + 1 Else IRNG = JWRKT (IINDA) IINDA = IINDA + 1 End If Else ! ! Only A still with unprocessed values ! IRNG = JWRKT (IINDA) IINDA = IINDA + 1 End If Else ! ! Only B still with unprocessed values ! IRNG = IRNGT (IWRK) End If If (INVALS(IRNG) > XTST) Then XTST = INVALS (IRNG) NUNI = NUNI + 1 IRNGT (NUNI) = IRNG End If ! End Do ! Return ! End Subroutine real32_unirnk Function real32_nearless (XVAL) result (real32_nl) !! Nearest value less than given value ! __________________________________________________________ Real (kind=real32), Intent (In) :: XVAL Real (kind=real32) :: real32_nl ! __________________________________________________________ real32_nl = nearest (XVAL, -1.0_real32) ! End Function real32_nearless Subroutine int32_unirnk (INVALS, IRNGT, NUNI) Integer (Kind=int32), Dimension (:), Intent (In) :: INVALS Integer, Dimension (:), Intent (Out) :: IRNGT Integer, Intent (Out) :: NUNI ! __________________________________________________________ Integer, Dimension (SIZE(IRNGT)) :: JWRKT Integer :: LMTNA, LMTNC, IRNG, IRNG1, IRNG2 Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB Integer (Kind=int32) :: XTST, XVALA, XVALB ! ! NVAL = Min (SIZE(INVALS), SIZE(IRNGT)) NUNI = NVAL ! Select Case (NVAL) Case (:0) Return Case (1) IRNGT (1) = 1 Return Case Default Continue End Select ! ! Fill-in the index array, creating ordered couples ! Do IIND = 2, NVAL, 2 If (INVALS(IIND-1) < INVALS(IIND)) Then IRNGT (IIND-1) = IIND - 1 IRNGT (IIND) = IIND Else IRNGT (IIND-1) = IIND IRNGT (IIND) = IIND - 1 End If End Do If (Modulo(NVAL, 2) /= 0) Then IRNGT (NVAL) = NVAL End If ! ! We will now have ordered subsets A - B - A - B - ... ! and merge A and B couples into C - C - ... ! LMTNA = 2 LMTNC = 4 ! ! First iteration. The length of the ordered subsets goes from 2 to 4 ! Do If (NVAL <= 4) Exit ! ! Loop on merges of A and B into C ! Do IWRKD = 0, NVAL - 1, 4 If ((IWRKD+4) > NVAL) Then If ((IWRKD+2) >= NVAL) Exit ! ! 1 2 3 ! If (INVALS(IRNGT(IWRKD+2)) <= INVALS(IRNGT(IWRKD+3))) Exit ! ! 1 3 2 ! If (INVALS(IRNGT(IWRKD+1)) <= INVALS(IRNGT(IWRKD+3))) Then IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNGT (IWRKD+3) IRNGT (IWRKD+3) = IRNG2 ! ! 3 1 2 ! Else IRNG1 = IRNGT (IWRKD+1) IRNGT (IWRKD+1) = IRNGT (IWRKD+3) IRNGT (IWRKD+3) = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNG1 End If Exit End If ! ! 1 2 3 4 ! If (INVALS(IRNGT(IWRKD+2)) <= INVALS(IRNGT(IWRKD+3))) Cycle ! ! 1 3 x x ! If (INVALS(IRNGT(IWRKD+1)) <= INVALS(IRNGT(IWRKD+3))) Then IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+2) = IRNGT (IWRKD+3) If (INVALS(IRNG2) <= INVALS(IRNGT(IWRKD+4))) Then ! 1 3 2 4 IRNGT (IWRKD+3) = IRNG2 Else ! 1 3 4 2 IRNGT (IWRKD+3) = IRNGT (IWRKD+4) IRNGT (IWRKD+4) = IRNG2 End If ! ! 3 x x x ! Else IRNG1 = IRNGT (IWRKD+1) IRNG2 = IRNGT (IWRKD+2) IRNGT (IWRKD+1) = IRNGT (IWRKD+3) If (INVALS(IRNG1) <= INVALS(IRNGT(IWRKD+4))) Then IRNGT (IWRKD+2) = IRNG1 If (INVALS(IRNG2) <= INVALS(IRNGT(IWRKD+4))) Then ! 3 1 2 4 IRNGT (IWRKD+3) = IRNG2 Else ! 3 1 4 2 IRNGT (IWRKD+3) = IRNGT (IWRKD+4) IRNGT (IWRKD+4) = IRNG2 End If Else ! 3 4 1 2 IRNGT (IWRKD+2) = IRNGT (IWRKD+4) IRNGT (IWRKD+3) = IRNG1 IRNGT (IWRKD+4) = IRNG2 End If End If End Do ! ! The Cs become As and Bs ! LMTNA = 4 Exit End Do ! ! Iteration loop. Each time, the length of the ordered subsets ! is doubled. ! Do If (2*LMTNA >= NVAL) Exit IWRKF = 0 LMTNC = 2 * LMTNC ! ! Loop on merges of A and B into C ! Do IWRK = IWRKF IWRKD = IWRKF + 1 JINDA = IWRKF + LMTNA IWRKF = IWRKF + LMTNC If (IWRKF >= NVAL) Then If (JINDA >= NVAL) Exit IWRKF = NVAL End If IINDA = 1 IINDB = JINDA + 1 ! ! One steps in the C subset, that we create in the final rank array ! ! Make a copy of the rank array for the iteration ! JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA) XVALA = INVALS (JWRKT(IINDA)) XVALB = INVALS (IRNGT(IINDB)) ! Do IWRK = IWRK + 1 ! ! We still have unprocessed values in both A and B ! If (XVALA > XVALB) Then IRNGT (IWRK) = IRNGT (IINDB) IINDB = IINDB + 1 If (IINDB > IWRKF) Then ! Only A still with unprocessed values IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA) Exit End If XVALB = INVALS (IRNGT(IINDB)) Else IRNGT (IWRK) = JWRKT (IINDA) IINDA = IINDA + 1 If (IINDA > LMTNA) Exit! Only B still with unprocessed values XVALA = INVALS (JWRKT(IINDA)) End If ! End Do End Do ! ! The Cs become As and Bs ! LMTNA = 2 * LMTNA End Do ! ! Last merge of A and B into C, with removal of duplicates. ! IINDA = 1 IINDB = LMTNA + 1 NUNI = 0 ! ! One steps in the C subset, that we create in the final rank array ! JWRKT (1:LMTNA) = IRNGT (1:LMTNA) If (IINDB <= NVAL) Then XTST = NEARLESS (Min(INVALS(JWRKT(1)), INVALS(IRNGT(IINDB)))) Else XTST = NEARLESS (INVALS(JWRKT(1))) Endif Do IWRK = 1, NVAL ! ! We still have unprocessed values in both A and B ! If (IINDA <= LMTNA) Then If (IINDB <= NVAL) Then If (INVALS(JWRKT(IINDA)) > INVALS(IRNGT(IINDB))) Then IRNG = IRNGT (IINDB) IINDB = IINDB + 1 Else IRNG = JWRKT (IINDA) IINDA = IINDA + 1 End If Else ! ! Only A still with unprocessed values ! IRNG = JWRKT (IINDA) IINDA = IINDA + 1 End If Else ! ! Only B still with unprocessed values ! IRNG = IRNGT (IWRK) End If If (INVALS(IRNG) > XTST) Then XTST = INVALS (IRNG) NUNI = NUNI + 1 IRNGT (NUNI) = IRNG End If ! End Do ! Return ! End Subroutine int32_unirnk Function int32_nearless (XVAL) result (int32_nl) !! Nearest value less than given value ! __________________________________________________________ Integer (kind=int32), Intent (In) :: XVAL Integer (kind=int32) :: int32_nl ! __________________________________________________________ int32_nl = XVAL -1_int32 ! End Function int32_nearless end module M_orderpack__unirnk