! --------------------------------------------------------------------
! MODULE  Sorting:
!    This module can sort a set of numbers.  The method used is 
! usually referred to as "selection" method.
! --------------------------------------------------------------------

MODULE  Sorting
   IMPLICIT  NONE
   PRIVATE   :: FindMinimum, Swap

CONTAINS

! --------------------------------------------------------------------
! INTEGER FUNCTION  FindMinimum():
!    This function returns the location of the minimum in the section
! between Start and End.
! --------------------------------------------------------------------

   INTEGER FUNCTION  FindMinimum(x, Start, End)
      IMPLICIT  NONE
      REAL, DIMENSION(0:), INTENT(IN) :: x
      REAL, INTENT(IN)                :: Start, End
      INTEGER                            :: Minimum
      INTEGER                            :: Location
      INTEGER                            :: i

      Minimum  = x(Start)          ! assume the first is the min
      Location = Start             ! record its position
      DO i = Start+1, End          ! start with next elements
         IF (x(i) < Minimum) THEN  !   if x(i) less than the min?
            Minimum  = x(i)        !      Yes, a new minimum found
            Location = i                !      record its position
         END IF
      END DO
      FindMinimum = Location            ! return the position
   END FUNCTION  FindMinimum

! --------------------------------------------------------------------
! SUBROUTINE  Swap():
!    This subroutine swaps the values of its two formal arguments.
! --------------------------------------------------------------------

   SUBROUTINE  Swap(a, b)
      IMPLICIT  NONE
      REAL, INTENT(INOUT) :: a, b
      REAL               :: Temp

      Temp = a
      a    = b
      b    = Temp
   END SUBROUTINE  Swap

! --------------------------------------------------------------------
! SUBROUTINE  Sort():
!    This subroutine receives an array x() and sorts it into ascending
! order.
! --------------------------------------------------------------------

   SUBROUTINE  Sort(x, N)
      IMPLICIT  NONE
      REAL, DIMENSION(0:), INTENT(INOUT) :: x
      INTEGER, INTENT(IN)                   :: N
      INTEGER                               :: i
      INTEGER                               :: Location
	
      DO i = 1, N-1             ! except for the last
         Location = FindMinimum(x, i, N)  ! find min from this to last
         CALL  Swap(x(i), x(Location))  ! swap this and the minimum
      END DO
   END SUBROUTINE  Sort

END MODULE  Sorting

PROGRAM  ComputeMedian
   USE       Sorting
   IMPLICIT  NONE
   REAL, DIMENSION(0:100)			:: X
   INTEGER                          :: N
   INTEGER                          :: IOstatus
   INTEGER                          :: i
   OPEN(1,FILE ='DATA07.DAT', STATUS = 'OLD') 
   DO
      READ(1,*,IOSTAT=IOstatus) N, (X(i), i = 1, N)
      IF (IOstatus < 0) THEN
         WRITE(*,*)  "End of data reached."
         EXIT
      ELSE IF (IOstatus > 0) THEN
         WRITE(*,*)  "Something wrong in your data."
         EXIT
      ELSE
         WRITE(*,*)  "InputData:"
         WRITE(*,5)  (X(i), i = 1, N)
		 5 FORMAT (F6.2)
         WRITE(*,*)
         WRITE(*,*)  "Median = ", Median(X, N)
         WRITE(*,*)

		 OPEN (2, FILE = 'MEDIAN.DAT')
		 WRITE(2,20) Median (X,N)
		 20 FORMAT (5F6.2)
      END IF
   END DO
   CLOSE(1)

CONTAINS

! --------------------------------------------------------------------
! REAL FUNCTION  Median() :
!    This function receives an array X of N entries, copies its value
! to a local array Temp(), sorts Temp() and computes the median.
!    The returned value is of REAL type.
! --------------------------------------------------------------------

   REAL FUNCTION  Median(X, N)
      IMPLICIT  NONE
      REAL, DIMENSION(0:), INTENT(IN) :: X
      INTEGER, INTENT(IN)                :: N
      REAL, DIMENSION(1:N)            :: Temp
      INTEGER                            :: i

      DO i = 1, N                       ! make a copy
         Temp(i) = X(i)
      END DO
      CALL  Sort(Temp, N)               ! sort the copy
      IF (MOD(N,2) == 0) THEN           ! compute the median
         Median = (Temp(N/2) + Temp(N/2+1)) / 2.0
      ELSE
         Median = Temp(N/2+1)
      END IF
   END FUNCTION  Median

END PROGRAM  ComputeMedian