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