test_ctrper Subroutine

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