Subroutine to sort 2 vectors of reals, according a vector of realq
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
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 |
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