331
C Now some sorting related routines. Only to be used for small
332
C arrays since these are not the most optimized sorting algorithms.
334
! --------------------------------------------------------------------
335
! INTEGER FUNCTION FindMinimum():
336
! This function returns the location of the minimum in the section
337
! between Start and End.
338
! --------------------------------------------------------------------
340
INTEGER FUNCTION FindMinimum(x, mStart, mEnd)
342
INTEGER MAXNREF_EVALS
343
PARAMETER (MAXNREF_EVALS=30)
344
INTEGER, DIMENSION(MAXNREF_EVALS), INTENT(IN) :: x
345
INTEGER, INTENT(IN) :: mStart, mEnd
350
Minimum = x(mStart) ! assume the first is the min
351
Location = mStart ! record its position
352
DO i = mStart+1, mEnd ! start with next elements
353
IF (x(i) < Minimum) THEN ! if x(i) less than the min?
354
Minimum = x(i) ! Yes, a new minimum found
355
Location = i ! record its position
358
FindMinimum = Location ! return the position
359
END FUNCTION FindMinimum
361
! --------------------------------------------------------------------
363
! This subroutine swaps the values of its two formal arguments.
364
! --------------------------------------------------------------------
366
SUBROUTINE Swap(a, b)
368
REAL*8, INTENT(INOUT) :: a, b
376
! --------------------------------------------------------------------
378
! This subroutine receives an array x() and sorts it into ascending
380
! --------------------------------------------------------------------
382
SUBROUTINE Sort(x, mSize)
384
INTEGER MAXNREF_EVALS
385
PARAMETER (MAXNREF_EVALS=30)
386
REAL*8, DIMENSION(MAXNREF_EVALS), INTENT(INOUT) :: x
387
INTEGER, INTENT(IN) :: mSize
390
INTEGER :: FindMinimum
391
DO i = 1, mSize-1 ! except for the last
392
Location = FindMinimum(x, i, mSize) ! find min from this to last
393
CALL Swap(x(i), x(Location)) ! swap this and the minimum
397
! --------------------------------------------------------------------
398
! REAL*8 FUNCTION Median() :
399
! This function receives an array X of N entries, copies its value
400
! to a local array Temp(), sorts Temp() and computes the median.
401
! The returned value is of REAL type.
402
! --------------------------------------------------------------------
404
REAL*8 FUNCTION Median(X, N)
406
INTEGER MAXNREF_EVALS
407
PARAMETER (MAXNREF_EVALS=30)
408
REAL*8, DIMENSION(MAXNREF_EVALS), INTENT(IN) :: X
409
INTEGER, INTENT(IN) :: N
410
REAL*8, DIMENSION(MAXNREF_EVALS) :: Temp
413
DO i = 1, N ! make a copy
416
CALL Sort(Temp, N) ! sort the copy
417
IF (MOD(N,2) == 0) THEN ! compute the median
418
Median = (Temp(N/2) + Temp(N/2+1)) / 2.0d0
331
425
SUBROUTINE PRINT_MADLOOP_BANNER()
333
427
%(print_banner_commands)s