mrgref Interface

rank_basic(3f) - [M_orderpack:RANK] create an INDEX that defines the
                 order of array sorted in ascending order (basic
                 merge-sort)

 Subroutine Rank_Basic (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=*)

Ranks array INVALS, filling array IRNGT with sorted indices.

It uses a basic merge-sort.

This version is not optimized for performance, and is thus
not as difficult to read as some other ones.

It uses Merge-sort.

 INVALS      input array to rank
 IRNGT      returned rank array

program demo_rank_basic
! create an index that can order an array in ascending order
use M_orderpack, only : rank_basic
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_basic(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_basic(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_basic

sorted  10000 values
from -.3393216923767161E+308 to .4341912370205701E+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 - April 2000

John Urban, 2022.04.16

CC0-1.0