sort_array_real_with_order Subroutine

private recursive subroutine sort_array_real_with_order(g, d, rtabref, order)

Sort a vector of reals and store the order

Arguments

Type IntentOptional Attributes Name
integer(kind=I4), intent(in) :: g

left index
integer(kind=I4), intent(in) :: d

right index
real(kind=R8), intent(inout), dimension(:) :: rtabref

vector to sort
integer(kind=I4), intent(inout), dimension(:) :: order

sort order

Called by

proc~~sort_array_real_with_order~~CalledByGraph proc~sort_array_real_with_order sort_array_real_with_order proc~sort_array_real_with_order->proc~sort_array_real_with_order proc~sort_array2 sort_array2 proc~sort_array2->proc~sort_array_real_with_order proc~from_elemental_to_assembled from_elemental_to_assembled proc~from_elemental_to_assembled->proc~sort_array2 proc~melange melange proc~melange->proc~sort_array2 proc~read_surf~2 read_surf proc~read_surf~2->proc~sort_array2 program~main main program~main->proc~sort_array2 proc~convert_matrice_format convert_matrice_format proc~convert_matrice_format->proc~from_elemental_to_assembled program~test_algen test_algen program~test_algen->proc~melange program~test_surfile test_surfile program~test_surfile->proc~read_surf~2 program~test_solvers test_solvers program~test_solvers->proc~convert_matrice_format

Source Code

   recursive subroutine sort_array_real_with_order(g, d, rtabref, order)
   !! Sort a vector of reals and store the order
   implicit none
   integer(kind=I4), intent(in)                  :: g          !! *left index*
   integer(kind=I4), intent(in)                  :: d          !! *right index*
   real(kind=R8),    intent(inout), dimension(:) :: rtabref    !! *vector to sort*
   integer(kind=I4), intent(inout), dimension(:) :: order      !! *sort order*

      integer(kind=I4) :: i, j, mil, itmp
      real(kind=R8)    :: tmp, cle

      i = g
      j = d
      mil = (g+d)/2
      cle = rtabref(mil)

      if (g>=d) return

      do while (i<=j)
         do while (rtabref(i)<cle)
            i = i + 1
         enddo
         do while (rtabref(j)>cle)
            j = j - 1
         enddo
         if (i<=j) then
            ! échange des éléments du tableau
            tmp = rtabref(i)
            rtabref(i) = rtabref(j)
            rtabref(j) = tmp

            ! échange des éléments du tableau
            itmp     = order(i)
            order(i) = order(j)
            order(j) = itmp

            ! échange des éléments du vecteur position
            i = i + 1
            j = j - 1
         endif
      enddo

      if (g<j) call sort_array_real_with_order(g, j, rtabref, order)
      if (d>i) call sort_array_real_with_order(i, d, rtabref, order)

   return
   endsubroutine sort_array_real_with_order