test_sortc Subroutine

subroutine test_sortc()

Arguments

None

Variables

Type Visibility Attributes Name Initial
real, public :: aa(isz)
real, public :: bb(isz)
real, public :: cc(isz)
real, public :: cc2(isz)
real, public :: dd(isz)
real, public :: dd2(isz)
integer, public :: i
integer, public :: ibad
integer, public, parameter :: isz = 2000

Source Code

subroutine test_sortc()
integer,parameter            :: isz=2000
real                         :: aa(isz)
real                         :: bb(isz)
real                         :: cc(isz)
real                         :: dd(isz)
real                         :: cc2(isz)
real                         :: dd2(isz)
integer                      :: i
integer                      :: ibad
   ibad=0
   call unit_check_start('sortc',msg='')
   call random_seed()
   CALL RANDOM_NUMBER(aa)
   aa=aa*450000.0
   bb=real([(i,i=1,isz)])
   call sortc(aa,bb,size(aa),cc,dd)
   do i=1,isz-1 ! checking if real values are sorted
      if(cc(i).gt.cc(i+1))then
         write(*,*)'Error in sorting reals small to large ',i,cc(i),cc(i+1)
         ibad=ibad+1
      endif
   enddo
   call unit_check('sortc', ibad.eq.0, 'checking ascending')
   call sortc(dd,cc,isz,dd2,cc2) ! put dd and cc back in original order
   call unit_check('sortc', all(cc2.eq.aa), 'checking reversed')
   call unit_check('sortc', all(dd2.eq.bb), 'checking reversed')
   call unit_check_done('sortc',msg='')
end subroutine test_sortc