sort_real_2real Subroutine

public recursive subroutine sort_real_2real(g, d, rtabref, rtab1, rtab2)


Arguments

Type IntentOptional AttributesName
integer(kind=I4), intent(in) :: g
integer(kind=I4), intent(in) :: d
real(kind=R8), intent(inout), dimension(:):: rtabref
real(kind=R8), intent(inout), dimension(:):: rtab1
real(kind=R8), intent(inout), dimension(:):: rtab2

Contents

Source Code


Source Code

   recursive subroutine sort_real_2real(g, d, rtabref, rtab1, rtab2)
   implicit none
   integer(kind=I4), intent(in) :: g, d
   real(kind=R8), dimension(:), intent(inout) :: rtabref
   real(kind=R8), dimension(:), intent(inout) :: rtab1
   real(kind=R8), dimension(:), intent(inout) :: rtab2
      integer(kind=I4) :: i, j, mil
      real(kind=R8)    :: rtmp, 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
            rtmp       = rtabref(i)
            rtabref(i) = rtabref(j)
            rtabref(j) = rtmp
            ! échange des éléments du vecteur 2
            rtmp     = rtab1(i)
            rtab1(i) = rtab1(j)
            rtab1(j) = rtmp
            ! échange des éléments du vecteur 3
            rtmp     = rtab2(i)
            rtab2(i) = rtab2(j)
            rtab2(j) = rtmp

            i = i + 1
            j = j - 1
         endif
      enddo

      if (g<j) call sort_real_2real(g, j, rtabref, rtab1, rtab2)
      if (d>i) call sort_real_2real(i, d, rtabref, rtab1, rtab2)

   return
   endsubroutine sort_real_2real