jsort.F

Go to the documentation of this file.

#ifdef RS6K

!-- Thanks to John Hague (IBM) and Deborah Salmond (ECMWF) -- 2002
!   real --> real*8 by Sami Saarinen, ECMWF, 16-Jan-2004

      SUBROUTINE jdsort(N, ISTRIDE, IPTR, C, INDEX)
!
!**C* *JDSORT* - interface to IBM essl dsorts
!
!**C  INTERFACE.
!     ----------
!
!          *CALL* *JDSORT(N,ISTRIDE, IPTR, C, INDEX)
!           N = number of elements to be sorted
!           ISTRIDE = stride
!           IPTR = start address
!           C = array to be sorted
!           INDEX = index into array
!
      USE parkind1, ONLY : jprb

      IMPLICIT NONE
      INTEGER N,ISTRIDE, IPTR
      REAL(KIND=JPRB) :: C(*)
      INTEGER INDEX(n)

! local variables

      INTEGER I,J,IXX(n),IX(n)
      REAL(KIND=JPRB) :: CC(n)
      REAL(KIND=JPRB) :: W(n/2+1)

      DO i=1,n
        j=(i-1)*istride+1
        cc(i)=c(iptr+(index(i)-1)*istride)
        ixx(i)=index(i)
      ENDDO
      CALL dsorts(cc,1,n,ix,w,SIZE(w))
      DO i=1,n
        index(i)=ixx(ix(i))
      ENDDO
      RETURN
      END SUBROUTINE jdsort


      SUBROUTINE jisort(N, ISTRIDE, IPTR, C, INDEX)
!
!**** *JISORT* - interface to IBM essl isorts
!
!**   INTERFACE.
!     ----------
!
!          *CALL* *JISORT(N,ISTRIDE, IPTR, C, INDEX)
!           N = number of elements to be sorted
!           ISTRIDE = stride
!           IPTR = start address
!           C = array to be sorted
!           INDEX = index into array
!
      IMPLICIT NONE
      INTEGER N,ISTRIDE, IPTR
      INTEGER C(*),INDEX(n)

! local variables

      INTEGER CC(n)
      INTEGER I,J,IXX(n),IX(n)
      INTEGER W(n/2+1)

      DO i=1,n
        j=(i-1)*istride+1
        cc(i)=c(iptr+(index(i)-1)*istride)
        ixx(i)=index(i)
      ENDDO
      CALL isorts(cc,1,n,ix,w,SIZE(w))
      DO i=1,n
        index(i)=ixx(ix(i))
      ENDDO
      RETURN
      END SUBROUTINE jisort
#else
!-- other machines --
      SUBROUTINE jsort_dummy()
      END SUBROUTINE jsort_dummy
#endif