!
! =====> Program - P97.F90
!
        PROGRAM SrtDmo
!  Program to demonstrate a number of simple
!  sorting algorithms.  N random integers are
!  to be sorted in increasing order (from smallest
!  to largest) in an array A.

        PARAMETER       (NMax = 1000)
        INTEGER         A(NMax), A0(NMax)

        PRINT *, 'This is Program >> P97 = Sorting Demo'
!
!     Tell program where data for  READ *  is coming from
      OPEN(UNIT=5, FILE='P97.DAT')      ! UNIT=5 is the default input
!
        PRINT *, 'Number of elements to sort: '
        READ  *, N
        Print  *, N
        Print  *

        CALL IniAry(A0, N)
        CALL PrnAry(A0, N)

!       Repeat for each sorting method
        PRINT *, 'Bubble'
        CALL CpyAry(A0, A, N)
        CALL Bubble(A, N)
        CALL PrnAry(A, N)
        Print *

        PRINT *, 'Insertion'
        CALL CpyAry(A0, A, N)
        CALL Insert(A, N)
        CALL PrnAry(A, N)
        Print *

        PRINT *, 'Selection'
        CALL CpyAry(A0, A, N)
        CALL Select(A, N)
        CALL PrnAry(A, N)
        Print *

        PRINT *, 'Shell'
        CALL CpyAry(A0, A, N)
        CALL Shell(A, N)
        CALL PrnAry(A, N)
        Print *

        STOP
        END


! SUPPORT ROUTINES

        SUBROUTINE IniAry(A, N)
!       Initializes N elements of array A to random
!       non-negative integers.
        PARAMETER       (MaxInt = 32700)
        INTEGER         A(N), Seed

        Seed = 31415
L1:     DO I = 1, N
          A(I) =  ABS(MOD(INT(URand(Seed) * MaxInt) ,MaxInt))
        END DO L1
        RETURN
        END


        SUBROUTINE CpyAry(A0, A, N)
!       Copy elements 1..N of array A0 to A.

        INTEGER         A0(N), A(N)

L1:     DO I = 1, N
          A(I) = A0(I)
        END DO L1
        RETURN
        END


        SUBROUTINE PrnAry(A, N)
!       Prints the N elements of array A.

        INTEGER         A(N)

L1:     DO I = 1, N
          PRINT 101, I, A(I)
        END DO L1
        RETURN
  101   FORMAT(1X, 'A(', I3, ') = ', I9)
        END


        SUBROUTINE Swap(I, J)
!       Exchanges the integers I and J.

        ITemp = I
        I = J
        J = ITemp
        RETURN
        END


! ALGORITHMS

        SUBROUTINE Bubble(A, N)
        INTEGER         A(N)

!       Make N-1 passes through the array.
!       On pass i, "bubble" the next smallest element
!       up from the end of the array to position i.

L1:     DO I = 1, N-1
L2:       DO J = N, I+1, -1
            IF (A(J) < A(J-1)) THEN
              CALL Swap(A(J), A(J-1))
            ENDIF
          END DO L2
        END DO L1
        RETURN
        END



        SUBROUTINE Insert(A, N)
        INTEGER         A(N)

!       Make repeated passes through the array.
!       On pass i, place the i'th element in its
!       proper sorted position amongst the (sorted)
!       A(1),...,A(i-1).

L1:     DO I = 2, N
          J = I

   20     IF (A(J) >= A(J-1)) CYCLE
          CALL Swap(A(J), A(J-1))
          J = J-1
          IF (J > 1) GO TO 20
        END DO L1

        RETURN
        END



        SUBROUTINE Select(A, N)
        INTEGER         A(N)

!       Make N-1 passes through the array.
!       On pass i, find the smallest element in
!       A(i+1),...,A(N) and swap it with A(i),
!       leaving the elements A(1),...,A(i) in their
!       final, sorted order.

L1:     DO I = 1, N-1
          LowIdx = I
          LowKey = A(I)

L2:       DO J = I+1, N
            IF (A(J) .LT. LowKey) THEN
              LowKey = A(J)
              LowIdx = J
            ENDIF
          END DO L2

          CALL Swap(A(I), A(LowIdx))
        END DO L1

        RETURN
        END



        SUBROUTINE Shell(A, N)
        INTEGER         A(N)

!       Incr is the number of positions separating
!       elements of a particular tuple.
        Incr = N / 2

!       Make passes for Incr = N DIV 2, N DIV 4,
!       N DIV 8,..., 1, and use Insertion Sort on
!       elements separated by distances Incr
!       on each pass.

        DO WHILE  (Incr > 0) 
L1:        DO I = Incr+1, N
             J = I - Incr

   15        IF (J <= 0) CYCLE
             IF (A(J) > A(J+Incr)) THEN
               CALL Swap(A(J), A(J+Incr))
               J = J - Incr
             ELSE
               J = 0
             ENDIF

             GO TO 15
           END DO L1

           Incr = Incr / 2
        END DO

        RETURN
        END
!
!
        REAL FUNCTION URAND( XN )
        INTEGER XN
!
! Uniform random number generator based on techniques described
! in "The Art of Computer Programming", Vol.2, Knuth.
!
!       Xn+1 = a*Xn + c mod m
! where
!       Xn is the seed supplied by the caller
!       m = 2**31
!       a = 2147437301
!       c = 453816693
!
! 'a' satisfies the following:
!
!       max( sm, m/10 ) <  a  < m - sm, where sm = square root of m
!       a mod 8 = 5
!
! 'c' is computed as follows:
!
!       c = idnint( 2d0**31 * ( .5d0 - dsqrt( 3d0 ) / 6d0 ) ) + 1
!
! Note: Integer arithmetic is automatically done modulo 2**31.
!
        INTEGER A, M, C
        DATA A/2147437301/
        DATA M/80000000/
        DATA C/453816693/
        XN = A * XN + C
        IF( XN < 0 ) XN = XN + M
        URAND = XN / 2.0**31
        END