hsort_array Subroutine

private subroutine hsort_array(ia, ra)

Arguments

Type IntentOptional Attributes Name
integer :: ia(:,:)
real(kind=ESMF_KIND_R8) :: ra(:)

Called by

proc~~hsort_array~~CalledByGraph proc~hsort_array hsort_array proc~compactmatrix compactMatrix proc~compactmatrix->proc~hsort_array

Source Code

subroutine hsort_array(ia,ra)
   integer :: ia(:,:)
   real(ESMF_KIND_R8)    :: ra(:)
   integer :: num_a
   integer :: i,ir,j,l
   integer :: tia(size(ia,1))
   real(ESMF_KIND_R8)    :: tra

   ! get size of array
   num_a=size(ia,2)

   ! Leave if list is too small to sort
   if (num_a <2) return

   l=num_a/2+1
   ir=num_a

10 continue
   if (l .gt. 1) then
      l=l-1
      tia(:)=ia(:,l)
      tra=ra(l)
   else
      tia(:)=ia(:,ir)
      tra=ra(ir)
      ia(:,ir)=ia(:,1)
      ra(ir)=ra(1)
      ir=ir-1
      if (ir .eq. 1) then
         ia(:,1)=tia(:)
         ra(1)=tra
         return
      endif
   endif
   i=l
   j=l+l
20 if (j .le. ir) then
      if (j .lt. ir) then
         if (ia(1,j) .lt. ia(1,j+1)) j=j+1
      endif
      if (tia(1) .lt. ia(1,j)) then
         ia(:,i)=ia(:,j)
         ra(i)=ra(j)
         i=j
         j=j+j
      else
         j=ir+1
      endif
      goto 20
   endif
   ia(:,i)=tia(:)
   ra(i)=tra
   goto 10
 end subroutine hsort_array