INTEGER FUNCTION vecmaxloc(N, V)
!
!  This function returns the element index (starting from 1) where the
!  maximum element of the vector N-length V was found
!
   IMPLICIT NONE
   INTEGER, INTENT(IN) :: N     ! vector length
   REAL, INTENT(IN) :: V(*)     ! vector
   INTEGER :: maxloc, i
   REAL :: mymax

   maxloc = 1
   mymax = V(1)

   DO i = 1, N
      IF (V(i) .GT. mymax) THEN
         mymax = V(i)
         maxloc = i
      END IF
   END DO

   vecmaxloc = maxloc
END FUNCTION vecmaxloc

SUBROUTINE vecsort(N, V)
!
! This subroutine sorts the N-length vector V into greatest-to-least order
!
   IMPLICIT NONE
   INTEGER, INTENT(IN) :: N     ! vector length
   REAL, INTENT(INOUT) :: V(*)  ! vector to be sorted
   INTEGER :: i, j
   REAL :: rtmp
   INTEGER, EXTERNAL :: vecmaxloc

   DO I = 1, N-1          ! loop over each position in array except last
!
!     Find the index of the largest value left in the unsorted array.
!     * The unsorted array is initially N long (N-1+1 = N), and finally 2
!       elts long: N-(N-1)+1) = N-N+1+1 = 2
!     * We pass only the unsorted portion of V, so we get an index
!       starting from V(i), so therefore we add i-1 to get an index
!       that starts from 1 again
!
      j = vecmaxloc(N-i+1, V(i))-1 + i
!
!     If the maximum value wasn't already in the right (i) place, swap them
!
      IF (i .NE. j) THEN
         rtmp = V(i)
         V(i) = V(j)
         V(j) = rtmp
      END IF
   END DO
END SUBROUTINE vecsort

PROGRAM testsort
!
!  This program prompts the user for a vector length N, and error checks
!  N > 0.  It then allocates an N-length array which it fills with
!  random values and prints.  It then sorts the array, and prints the
!  sorted array
!
   IMPLICIT NONE
   REAL, ALLOCATABLE :: A(:)
   INTEGER :: N
   EXTERNAL :: vecsort

   PRINT *, 'Enter N:'
   READ *, N
   IF (N .lt. 1) THEN
      PRINT *, 'FATAL ERROR: N must be greater than 0, but is', N
      STOP
   END IF

   ALLOCATE(A(N))

   CALL RANDOM_NUMBER(A)
   PRINT *, 'Unsorted = ', A
   CALL VECSORT(N, A)
   PRINT *, 'Sorted   = ', A

   DEALLOCATE(A)

END PROGRAM testsort