program runtest
use M_framework__msg
use M_framework__msg, only : str
use M_framework__verify
use M_framework__verify, only : unit_check_start, unit_check, unit_check_done, unit_check_msg
use M_framework__verify, only : unit_check_stop
! full ranking
use M_orderpack__mrgref, only : mrgref
use M_orderpack__mrgrnk, only : mrgrnk
! full sorting
use M_orderpack__inssor, only : inssor
use M_orderpack__refsor, only : refsor
! pertubation
use M_orderpack__ctrper, only : ctrper
! fractile (nth value)
use M_orderpack__fndnth, only : fndnth
use M_orderpack__indnth, only : indnth
use M_orderpack__valnth, only : valnth
! median
use M_orderpack__indmed, only : indmed
use M_orderpack__valmed, only : valmed
use M_orderpack__median, only : median
!
use M_orderpack__refpar, only : refpar
use M_orderpack__rinpar, only : rinpar
use M_orderpack__rnkpar, only : rnkpar
use M_orderpack__inspar, only : inspar
use M_orderpack__rapknr, only : rapknr
use M_orderpack__unipar, only : unipar
use M_orderpack__mulcnt, only : mulcnt
use M_orderpack__unirnk, only : unirnk
use M_orderpack__unista, only : unista
use M_orderpack__uniinv, only : uniinv
implicit none
character(len=*),parameter :: g='(*(g0,1x))'
integer,parameter :: dp=kind(0.0d0)
unit_check_level=0
call test_gen('mrgref')
call test_gen('mrgrnk')
call test_gen('inssor')
call test_gen('refsor')
call test_ctrper()
call test_fndnth()
call test_indnth()
call test_valnth()
call test_indmed()
call test_valmed()
call test_median()
call test_refpar()
call test_rinpar()
call test_rnkpar()
call test_rapknr()
call test_inspar()
call test_unipar()
call test_mulcnt()
call test_unirnk()
call test_unista()
call test_uniinv()
call unit_check_stop()
contains
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_gen(name)
character(len=*),intent(in) :: name
integer,parameter :: isz=1000
real :: rr(isz)
real(kind=dp) :: dd(isz)
integer :: ii(isz)
character(len=10) :: cc(isz)
integer :: indx(isz)
integer :: i
call unit_check_start(name, '-library orderpack') ! start tests
CALL RANDOM_NUMBER(RR)
rr = rr*huge(0.0)
select case(name)
case('inssor');call inssor(rr)
case('refsor');call refsor(rr)
case('mrgrnk');call mrgrnk(rr,indx); rr=rr(indx)
case('mrgref');call mrgref(rr,indx); rr=rr(indx)
endselect
call unit_check(name,all(rr(1:isz-1) .le. rr(2:isz)),'real test',isz,'values')
CALL RANDOM_NUMBER(RR)
ii = rr*huge(0)
select case(name)
case('inssor');call inssor(ii)
case('refsor');call refsor(ii)
case('mrgrnk');call mrgrnk(ii,indx); ii=ii(indx)
case('mrgref');call mrgref(ii,indx); ii=ii(indx)
endselect
call unit_check(name,all(ii(1:isz-1) .le. ii(2:isz)),'integer test',isz,'values')
CALL RANDOM_NUMBER(DD)
dd = dd*huge(0.0_dp)
select case(name)
case('inssor');call inssor(dd)
case('refsor');call refsor(dd)
case('mrgrnk');call mrgrnk(dd,indx); dd=dd(indx)
case('mrgref');call mrgref(dd,indx); dd=dd(indx)
endselect
call unit_check(name,all(dd(1:isz-1) .le. dd(2:isz)),'double test',isz,'values')
do i=1,isz
cc(i) = random_string('abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ',10)
enddo
select case(name)
case('inssor');call inssor(cc)
case('refsor');call refsor(cc)
case('mrgrnk');call mrgrnk(cc,indx); cc=cc(indx)
case('mrgref');call mrgref(cc,indx); cc=cc(indx)
endselect
call unit_check(name,all(cc(1:isz-1) .le. cc(2:isz)),'string test, random',isz,'values')
call unit_check_done(name,msg='test completed')
end subroutine test_gen
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_ctrper
implicit none
integer,allocatable :: row(:)
integer,allocatable :: xout(:,:)
integer :: isz, i, j, jsz
real,allocatable :: perturb(:)
call unit_check_start('ctrper', '-library orderpack') ! start tests
perturb=[0.0,0.1,1.0]
jsz=size(perturb)
isz=200
if(allocated(xout))deallocate(xout)
allocate(xout(3,isz))
allocate(row(isz))
! make each row the same initially
row=[(i,i=1,isz)]*10
do j=1,3
xout(j,:)=row
call ctrper(xout(j,:),perturb(j))
enddo
!write(*,'(a)')'count unchanged perturbed random'
!do i=1,size(row)
! write(*,'(*(i8,1x))')i,xout(:,i)
!enddo
call unit_check('ctrper',all(xout(1,:) .eq. row),'perturb 0 should not change')
call unit_check('ctrper',.not.(all(xout(3,:) .eq. row)),'perturb 1 should be random,unlikely not changed')
char: block
character(len=:),allocatable :: xdont(:)
xdont=[character(len=20) :: 'a','be','car','dam','fan','gas','egg']
isz=size(xdont)
!write(*,g)'Original.................:',(trim(xdont(i)),i=1,isz)
call ctrper(xdont,1.0)
!write(*,g)'Perturbed ...............:',(trim(xdont(i)),i=1,isz)
!write(*,g)
endblock char
call unit_check_done('ctrper',msg='test completed')
end subroutine test_ctrper
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_valnth
use M_orderpack__valnth, only : valnth
implicit none
integer,allocatable :: iarr(:)
integer :: i
integer :: imiddle
call unit_check_start('valnth', '-library orderpack') ! start tests
! find Nth lowest value in an array without sorting entire array
iarr=[80,70,30,40,50,60,20,10]
! can return the same values as intrinsics minval() and maxval()
call unit_check('valnth',valnth(iarr,1).eq.minval(iarr),'like minval()')
call unit_check('valnth',valnth(iarr,size(iarr)).eq.maxval(iarr),'like maxval()')
! but more generally it can return the Nth lowest value.
call unit_check('valnth',valnth(iarr,8).eq.80,'Nth value')
! so a value at the middle would be
imiddle=(size(iarr)+1)/2
call unit_check('valnth',valnth(iarr,imiddle).eq.40,'find median')
! sort the hard way, one value at a time
call unit_check('valnth', all([(valnth(iarr,i),i=1,size(iarr))].eq.[10,20,30,40,50,60,70,80]),'sort hard way')
call unit_check_done('valnth',msg='test completed')
if(allocated(iarr))deallocate(iarr)
end subroutine test_valnth
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_indnth
use M_orderpack__indnth, only : indnth
implicit none
integer,allocatable :: iarr(:)
integer :: i
integer :: imiddle
call unit_check_start('indnth', '-library orderpack') ! start tests
! find Nth lowest value in an array without sorting entire array
iarr=[80,70,30,40,50,60,20,10]
! can return the same values as intrinsics minloc() and maxloc()
call unit_check('indnth',all(indnth(iarr,1 ).eq.minloc(iarr)),'like minloc()')
call unit_check('indnth',all(indnth(iarr,size(iarr)).eq.maxloc(iarr)),'like maxloc()')
! but more generally it can return the Nth lowest value.
call unit_check('indnth',iarr(indnth(iarr,8)).eq.80,'Nth value')
! so a value at the middle would be
imiddle=(size(iarr)+1)/2
call unit_check('indnth',iarr(indnth(iarr,imiddle)).eq.40,'find median')
! sort the hard way, one value at a time
call unit_check('indnth', all([(iarr(indnth(iarr,i)),i=1,size(iarr))].eq.[10,20,30,40,50,60,70,80]),'sort hard way')
call unit_check_done('indnth',msg='test completed')
end subroutine test_indnth
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_fndnth
use M_orderpack__fndnth, only : fndnth
implicit none
integer,allocatable :: iarr(:)
integer :: i
integer :: imiddle
call unit_check_start('fndnth', '-library orderpack') ! start tests
! find Nth lowest value in an array without sorting entire array
iarr=[80,70,30,40,50,60,20,10]
! can return the same values as intrinsics minval() and maxval()
call unit_check('fndnth',fndnth(iarr,1).eq.minval(iarr),'like minval()')
call unit_check('fndnth',fndnth(iarr,size(iarr)).eq.maxval(iarr),'like maxval()')
! but more generally it can return the Nth lowest value.
call unit_check('fndnth',fndnth(iarr,8).eq.80,'Nth value')
! so a value at the middle would be
imiddle=(size(iarr)+1)/2
call unit_check('fndnth',fndnth(iarr,imiddle).eq.40,'find median')
! sort the hard way, one value at a time
call unit_check('fndnth', all([(fndnth(iarr,i),i=1,size(iarr))].eq.[10,20,30,40,50,60,70,80]),'sort hard way')
call unit_check_done('fndnth',msg='test completed')
end subroutine test_fndnth
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_indmed
use M_orderpack__indmed, only : indmed
implicit none
real,allocatable :: xdont(:)
real(kind=dp),allocatable :: ddont(:)
integer,allocatable :: idont(:)
character(len=:),allocatable :: cdont(:)
integer :: ii
call unit_check_start('indmed', '-library orderpack') ! start tests
xdont=[80.0,70.0,20.0,10.0,1000.0]
call indmed(xdont,ii)
call unit_check('indmed', ii.eq.2.and.xdont(ii).eq.70.0, 'real median',ii,xdont(ii))
!
idont=[11, 22, 33, 44, 55, 66, 77, 88]
call indmed(idont,ii)
call unit_check('indmed', ii.eq.4.and.idont(ii).eq.44, 'integer median',ii,idont(ii))
!
ddont=[11.0d0,77.0d0,22.0d0,66.0d0,33.0d0,88.0d0]
call indmed(ddont,ii)
call unit_check('indmed', ii.eq.5.and.ddont(ii).eq.33.0d0, 'doubleprecision median',ii,ddont(ii))
!
cdont=[character(len=20) :: 'apple','bee','cherry','duck','elephant','finger','goose','h','insect','j']
call indmed(cdont,ii)
call unit_check('indmed', ii.eq.5.and.cdont(ii).eq.'elephant', 'character median',ii,cdont(ii))
!
call unit_check_done('indmed',msg='test completed')
end subroutine test_indmed
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_valmed
use M_orderpack__valmed, only : valmed
implicit none
real,allocatable :: xdont(:)
real(kind=dp),allocatable :: ddont(:)
integer,allocatable :: idont(:)
call unit_check_start('valmed', '-library orderpack') ! start tests
xdont=[80.0,70.0,20.0,10.0,1000.0]
call unit_check('valmed', valmed(xdont).eq.70.0, 'real valmed',valmed(xdont),70.0)
!
idont=[11, 22, 33, 44, 55, 66, 77, 88]
call unit_check('valmed', valmed(idont).eq.44, 'integer valmed',valmed(idont),44)
!
ddont=[11.0d0, 77.0d0, 22.0d0, 66.0d0, 33.0d0, 88.0d0]
call unit_check('valmed', valmed(ddont).eq.33.0d0, 'doubleprecision valmed',valmed(ddont),33.0)
!
call unit_check_done('valmed',msg='test completed')
end subroutine test_valmed
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_median
use M_orderpack__median, only : median
implicit none
real,allocatable :: xdont(:)
real(kind=dp),allocatable :: ddont(:)
integer,allocatable :: idont(:)
call unit_check_start('median', '-library orderpack') ! start tests
xdont=[80.0,70.0,20.0,10.0,1000.0]
call unit_check('median', median(xdont).eq.70.0, 'real median',median(xdont),70.0)
!
idont=[11, 22, 33, 44, 55, 66, 77, 88]
call unit_check('median', median(idont).eq.49, 'integer median',median(idont),49)
!
ddont=[11.0d0,77.0d0,22.0d0,66.0d0,33.0d0,88.0d0]
call unit_check('median', median(ddont).eq.49.5d0, 'doubleprecision median',median(ddont),49.5)
!
call unit_check_done('median',msg='test completed')
end subroutine test_median
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_inspar()
implicit none
integer,parameter :: big=2000, little=300
real :: valsr(big)
call unit_check_start('inspar', '-library orderpack') ! start tests
call random_seed()
call random_number(valsr)
valsr=valsr*1000000.0-500000.0
call inspar(valsr,little)
call unit_check('inspar',all(valsr(1:little-1) .le. valsr(2:little)),'real test',little,'out of',big,'values')
call unit_check_done('inspar',msg='test completed')
end subroutine test_inspar
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_rapknr()
implicit none
integer,parameter :: big=2000, little=300
real :: valsr(big)
integer :: indx(little)
call unit_check_start('rapknr', '-library orderpack') ! start tests
call random_seed()
call random_number(valsr)
valsr=valsr*1000000.0-500000.0
call rapknr(valsr,indx,little)
valsr(:300)=valsr(indx(:little))
call unit_check('rapknr',all(valsr(1:little-1) .ge. valsr(2:little)),'real test',little,'out of',big,'values')
call unit_check_done('rapknr',msg='test completed')
end subroutine test_rapknr
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_rnkpar()
implicit none
integer,parameter :: big=2000, little=300
real :: valsr(big)
integer :: indx(little)
call unit_check_start('rnkpar', '-library orderpack') ! start tests
call random_seed()
call random_number(valsr)
valsr=valsr*1000000.0-500000.0
call rnkpar(valsr,indx,little)
valsr(:300)=valsr(indx(:little))
call unit_check('rnkpar',all(valsr(1:little-1) .le. valsr(2:little)),'real test',little,'out of',big,'values')
call unit_check_done('rnkpar',msg='test completed')
end subroutine test_rnkpar
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_rinpar()
implicit none
integer,parameter :: big=2000, little=300
real :: valsr(big)
integer :: indx(little)
call unit_check_start('rinpar', '-library orderpack') ! start tests
call random_seed()
call random_number(valsr)
valsr=valsr*1000000.0-500000.0
call rinpar(valsr,indx,little)
valsr(:300)=valsr(indx(:little))
call unit_check('rinpar',all(valsr(1:little-1) .le. valsr(2:little)),'real test',little,'out of',big,'values')
call unit_check_done('rinpar',msg='test completed')
end subroutine test_rinpar
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_refpar()
implicit none
integer,parameter :: big=2000, little=300
real :: valsr(big)
integer :: indx(little)
call unit_check_start('refpar', '-library orderpack') ! start tests
call random_seed()
call random_number(valsr)
valsr=valsr*1000000.0-500000.0
call refpar(valsr,indx,little)
valsr(:300)=valsr(indx(:little))
call unit_check('refpar',all(valsr(1:little-1) .le. valsr(2:little)),'real test',little,'out of',big,'values')
call unit_check_done('refpar',msg='test completed')
end subroutine test_refpar
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_unipar()
use M_orderpack__unipar, only : unipar
implicit none
integer,allocatable :: xdont(:)
integer,allocatable :: irngt(:)
integer :: nord
call unit_check_start('unipar', '-library orderpack') ! start tests
!
xdont=[10,5,7,1,4,5,6,8,9,10,1]
nord=5
if(allocated(irngt))deallocate(irngt)
allocate(irngt(nord))
!
call unipar(xdont,irngt,nord)
call unit_check('unipar',nord.eq.5,'number of unique values found',nord,5)
call unit_check('unipar',all(irngt(1:nord) .eq. [11,5,2,7,3]) ,'returned indices')
call unit_check('unipar',all(xdont(irngt(1:nord)) .eq.[1,4,5,6,7]) ,'returned values')
call unit_check_done('unipar',msg='test completed')
end subroutine test_unipar
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_mulcnt()
character(len=20),allocatable :: strings(:)
integer,allocatable :: cindx(:)
integer :: csz
call unit_check_start('mulcnt', '-library orderpack') ! start tests
!
strings= [ character(len=20) :: &
& 'two ', 'four ', 'three', 'five', 'five', &
& 'two ', 'four ', 'three', 'five', 'five', &
& 'four ', 'four ', 'three', 'one ', 'five']
csz=size(strings)
if(allocated(cindx))deallocate(cindx)
allocate(cindx(csz))
call mulcnt(strings,cindx)
call unit_check('mulcnt',all(cindx .eq. [2,4,3,5,5,2,4,3,5,5,4,4,3,1,5]) ,'returned values')
call unit_check_done('mulcnt',msg='test completed')
end subroutine test_mulcnt
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_unirnk()
integer,allocatable :: xvalt(:)
integer,allocatable :: irngt(:)
integer :: nuni
call unit_check_start('unirnk', '-library orderpack') ! start tests
xvalt=[10,5,7,1,4,5,6,8,9,10,1]
if(allocated(irngt))deallocate(irngt)
allocate(irngt(size(xvalt)))
call unirnk(xvalt,irngt,nuni)
call unit_check('unirnk',nuni.eq.8,'number of indices. got',nuni,'expected',8)
call unit_check('unirnk',all(irngt(:nuni) .eq. [ 4,5,2,7,3,8,9,1 ]) ,'returned indices')
call unit_check('unirnk',all(xvalt(irngt(:nuni)) .eq. [ 1,4,5,6,7,8,9,10 ]) ,'sorted data')
call unit_check_done('unirnk',msg='test completed')
end subroutine test_unirnk
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_unista()
integer,allocatable :: xdont(:)
integer :: nuni
call unit_check_start('unista', '-library orderpack') ! start tests
xdont=[44,33,33,33,22,11,33,44,55,33]
call unista(xdont,nuni)
call unit_check('unista',nuni.eq.5,'number of indices. got',nuni,'expected',5)
call unit_check('unista',all(xdont(:nuni) .eq. [ 44,33,22,11,55 ]) ,'unique values')
call unit_check_done('unista',msg='test completed')
end subroutine test_unista
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_uniinv()
integer,allocatable :: xdont(:)
integer,allocatable :: igoest(:)
integer,allocatable :: out(:)
integer :: imx
integer :: i
xdont=[10,20,30,10,20,30,10,20,30]
if(allocated(igoest))deallocate(igoest)
allocate(igoest(size(xdont)))
call uniinv(xdont,igoest)
call unit_check('uniinv',all(igoest .eq. [ 1,2,3,1,2,3,1,2,3 ]) ,'returned indices')
imx=maxval(igoest)
call unit_check('unista',imx.eq.3,'unique indices. got',imx,'expected',3)
if(allocated(out))deallocate(out)
allocate(out(imx))
do i=1,imx
out(igoest(i))=xdont(i)
enddo
call unit_check('uniinv',all(out .eq. [ 10,20,30 ]) ,'sorted unique values')
call unit_check_done('uniinv',msg='test completed')
end subroutine test_uniinv
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
function random_string(chars,length) result(out)
!$@(#) M_random::random_string(3f): create random string composed of provided characters of specified length
character(len=*),intent(in) :: chars
integer,intent(in) :: length
character(len=:),allocatable :: out
real :: x
integer :: ilen ! length of list of characters
integer :: which
integer :: i
ilen=len(chars)
out=''
if(ilen.gt.0)then
do i=1,length
call random_number(x)
which=nint(real(ilen-1)*x)+1
out=out//chars(which:which)
enddo
endif
end function random_string
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
end program runtest