home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l320 / 2.img / EXAMPLES / TSTQSORT.F < prev    next >
Encoding:
Text File  |  1989-08-22  |  1.9 KB  |  92 lines
  1.       PROGRAM TSTQSORT
  2.  
  3. c Purpose: demonstrates calling NDP Pascal
  4. c from NDP Fortran
  5. c Calls quicksort routine 
  6.  
  7.       INTEGER MAX, N
  8.       PARAMETER (MAX = 300)
  9.  
  10. c Function returns random number
  11.       REAL*4 RAN
  12. c NDP Fortran defaults to REAL*4
  13.       DIMENSION X(MAX)
  14.  
  15.       WRITE (*,100)
  16.       WRITE (*,101) 'Program prompts for array size'
  17.       WRITE (*,101) 'Maximum is 300 - Enter 0 to end'
  18.  
  19.    10 WRITE (*,100)
  20.       WRITE (*,102)
  21.       READ (*,103) N
  22.       WRITE (*,100)
  23.  
  24.       IF (N .GT. MAX) THEN
  25.         WRITE (*,104) 'Array size limit is ',MAX
  26.         GOTO 10
  27.       ENDIF
  28.     
  29.       DO 200 I = 1, N
  30.           X(I) = 100.0 * RAN(1.0)
  31.   200 CONTINUE
  32.  
  33.       WRITE (*,101) 'Displaying unsorted array'
  34.       CALL DISPLAY(X,N)
  35.       WRITE (*,100)
  36.  
  37. c sort random numbers
  38.       CALL QUIKSORT(X,N)
  39.       WRITE (*,101) 'Displaying results of first sort'
  40.       CALL DISPLAY(X,N)
  41.       WRITE (*,100)
  42.  
  43. c sort already sorted numbers
  44.       CALL QUIKSORT(X,N)
  45.       WRITE (*,101) 'Displaying results of second sort'
  46.       CALL DISPLAY(X,N)
  47.       WRITE (*,100)
  48.  
  49.       WRITE (*,101) 'Now filling array with numbers in reverse order'
  50.       DO 300 I = 1, N
  51.           X(I) = N + 1 - I
  52.   300 CONTINUE
  53.       
  54. c sort reversed numbers
  55.       CALL QUIKSORT(X,N)
  56.       WRITE (*,101) 'Displaying results of third sort'
  57.       CALL DISPLAY(X,N)
  58.       WRITE (*,100)
  59.  
  60.       IF (N .EQ. 0) THEN
  61.           STOP
  62.       ELSE
  63.         GOTO 10
  64.       ENDIF
  65.  
  66. c Format statements used in main program
  67.   100 FORMAT (1X)
  68.   101 FORMAT (1X,A)
  69.   102 FORMAT (' Enter array size  ',$)
  70.   103 FORMAT (I)
  71.   104 FORMAT (1X,A,I5)
  72.  
  73. c end of main
  74.       END
  75.  
  76. c displays elements of array X
  77.       SUBROUTINE DISPLAY(A,N)
  78.       INTEGER N
  79.       REAL A(N)
  80.  
  81.       INTEGER I
  82.       WRITE (*,1020)
  83.       DO 1000 I = 1, N
  84.           WRITE (*,1010) A(I)
  85.  1000 CONTINUE
  86.  
  87. c Format statements used in subroutine DISPLAY
  88.  1010 FORMAT (1X,F10.2)
  89.  1020 FORMAT (1X)
  90.  
  91.       END
  92.