M_orderpack__mrgrnk Module

rank(3f) - [M_orderpack:RANK] produces an INDEX that sorts an input
           array (optimized merge-sort)

 Subroutine Rank (INVALS, IRNGT)

   ${TYPE} (kind=${KIND}), Intent (In) :: INVALS(:)
   Integer, Intent (Out)               :: IRNGT(:)

Where ${TYPE}(kind=${KIND}) may be

   o Real(kind=real32)
   o Real(kind=real64)
   o Integer(kind=int32)
   o Character(kind=selected_char_kind("DEFAULT"),len=*)

 RANK(3f) ranks an input array; i.e. it produces an index of the input
 array elements that can order the input array in ascending order.

 The ranks can be used to sort the input array, or other associated
 arrays or components of user types.

 Internally, it uses an optimized and modified version of merge-sort.
 For performance reasons, the first two passes are taken out of the
 standard loop, and use dedicated coding.

 INVALS      The array to sort
 IRNGT      The rank index returned

program demo_rank
! create an index that can order an array in ascending order
use M_orderpack, only : rank
implicit none
character(len=*),parameter :: g='(*(g0,1x))'
integer,parameter             :: dp=kind(0.0d0)
integer,parameter             :: isz=10000
real(kind=dp)                 :: dd(isz)
real(kind=dp)                 :: pp
integer                       :: indx(isz)
integer                       :: i,j,k
character(len=:),allocatable  :: strings(:)
integer,allocatable           :: cindx(:)
   ! make some random numbers
   call random_seed()
   call random_number(dd)
   dd=dd-0.50_dp
   k=int(log(huge(0.0_dp))/log(2.0_dp))-1
   do i=1,isz
      call random_number(pp)
      j=floor((k+1)*pp)
      dd(i)=dd(i)*(2.0_dp**j)
   enddo
   ! rank the numeric data
   call rank(dd,indx)
   ! check order
   do i=1,isz-1
      if(dd(indx(i)).gt.dd(indx(i+1)))then
         write(*,g)'ERROR: data not sorted i=',i,'index=',indx(i), &
         & 'values ',dd(indx(i)),dd(indx(i+1))
         stop 1
      endif
   enddo
   ! sort data using rank values
   dd=dd(indx)
   write(*,g)'sorted ',isz,'values'
   write(*,g)'from',dd(1),'to',dd(isz)
   write(*,*)minval(dd).eq.dd(1)
   write(*,*)maxval(dd).eq.dd(isz)
   write(*,*)minloc(dd).eq.1
   write(*,*)maxloc(dd).eq.isz
   ! do a character sort
   strings= [ character(len=20) ::                               &
   & 'red',    'green', 'blue', 'yellow', 'orange',   'black', &
   & 'white',  'brown', 'gray', 'cyan',   'magenta',           &
   & 'purple']
   if(allocated(cindx))deallocate(cindx);allocate(cindx(size(strings)))

   write(*,'(a,8(a:,","))')'BEFORE ',&
           & (trim(strings(i)),i=1,size(strings))

   call rank(strings,cindx)

   write(*,'(a,8(a:,","))')'SORTED ',&
           & (trim(strings(cindx(i))),i=1,size(strings))

   strings=strings(cindx) ! sort the array using the rank index

   do i=1,size(strings)-1
      if(strings(i).gt.strings(i+1))then
         write(*,*)'Error in sorting strings a-z'
      endif
   enddo
end program demo_rank

sorted  10000 values
from -.4206770472235745E+308 to .3500810518521505E+308
 T
 T
 T
 T
BEFORE red,green,blue,yellow,orange,black,white,brown,
gray,cyan,magenta,purple
SORTED black,blue,brown,cyan,gray,green,magenta,orange,
purple,red,white,yellow

Michel Olagnon, 2000-2012

John Urban, 2022.04.16

CC0-1.0