339
SUBROUTINE PRINT_MADLOOP_BANNER()
341
WRITE(*,*) ' ==================================================='
342
$ //'======================================= '
345
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
347
$ /CHAR(27)//'[0m'//' }'
348
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
350
$ /CHAR(27)//'[0m'//' }'
351
WRITE(*,*) '{ '//CHAR(27)//'[32m'//'`7MMM. ,MMF'/
352
$ /CHAR(39)//' `7MM `7MMF'//CHAR(39)//' '
353
$ //' '//CHAR(27)//'[0m'//' }'
354
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' MMMb dPMM '
356
$ /CHAR(27)//'[0m'//' }'
357
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' M YM ,M MM ,6'/
358
$ /CHAR(34)//'Yb. ,M'//CHAR(34)//''//CHAR(34)//'bMM MM '
359
$ //' ,pW'//CHAR(34)//'Wq. ,pW'//CHAR(34)//'Wq.`7MMpdMAo. '/
360
$ /CHAR(27)//'[0m'//' }'
361
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' M Mb M'//CHAR(39)/
362
$ /' MM 8) MM ,AP MM MM 6W'//CHAR(39)//' `W'
363
$ //'b 6W'//CHAR(39)//' `Wb MM `Wb '//CHAR(27)//'[0m'/
365
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' M YM.P'//CHAR(39)/
366
$ /' MM ,pm9MM 8MI MM MM , 8M M8 8M M8 MM '
367
$ //' M8 '//CHAR(27)//'[0m'//' }'
368
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' M `YM'//CHAR(39)/
369
$ /' MM 8M MM `Mb MM MM ,M YA. ,A9 YA. '
370
$ //' ,A9 MM ,AP '//CHAR(27)//'[0m'//' }'
371
WRITE(*,*) '{ '//CHAR(27)//'[32m'//'.JML. `'//CHAR(39)/
372
$ /' .JMML.`Moo9^Yo.`Wbmd'//CHAR(34)//'MML..JMMmmmmMMM `Ybmd9'/
373
$ /CHAR(39)//' `Ybmd9'//CHAR(39)//' MMbmmd'//CHAR(39)//' '/
374
$ /CHAR(27)//'[0m'//' }'
375
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
377
$ /CHAR(27)//'[0m'//' }'
378
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
380
$ /CHAR(27)//'[0m'//' }'
381
WRITE(*,*) '{ '//CHAR(27)//'[32m'//CHAR(27)//'[0m'/
382
$ /'v2.3.0 (2015-02-05), Ref: arXiv:1103.0621v2, arXiv:1405.0301'
383
$ //CHAR(27)//'[32m'//' '//CHAR(27)//'[0m'/
385
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
387
$ /CHAR(27)//'[0m'//' }'
390
WRITE(*,*) ' ==================================================='
391
$ //'======================================= '
339
C Now some sorting related routines. Only to be used for small
340
C arrays since these are not the most optimized sorting algorithms.
342
! --------------------------------------------------------------------
343
! INTEGER FUNCTION FindMinimum():
344
! This function returns the location of the minimum in the section
345
! between Start and End.
346
! --------------------------------------------------------------------
348
INTEGER FUNCTION FINDMINIMUM(X, MSTART, MEND)
350
INTEGER MAXNREF_EVALS
351
PARAMETER (MAXNREF_EVALS=30)
352
INTEGER, DIMENSION(MAXNREF_EVALS), INTENT(IN) :: X
353
INTEGER, INTENT(IN) :: MSTART, MEND
358
MINIMUM = X(MSTART) ! assume the first is the min
359
LOCATION = MSTART ! record its position
360
DO I = MSTART+1, MEND ! start with next elements
361
IF (X(I) < MINIMUM) THEN ! if x(i) less than the min?
362
MINIMUM = X(I) ! Yes, a new minimum found
363
LOCATION = I ! record its position
366
FINDMINIMUM = LOCATION ! return the position
367
END FUNCTION FINDMINIMUM
369
! --------------------------------------------------------------------
371
! This subroutine swaps the values of its two formal arguments.
372
! --------------------------------------------------------------------
374
SUBROUTINE SWAP(A, B)
376
REAL*8, INTENT(INOUT) :: A, B
384
! --------------------------------------------------------------------
386
! This subroutine receives an array x() and sorts it into ascending
388
! --------------------------------------------------------------------
390
SUBROUTINE SORT(X, MSIZE)
392
INTEGER MAXNREF_EVALS
393
PARAMETER (MAXNREF_EVALS=30)
394
REAL*8, DIMENSION(MAXNREF_EVALS), INTENT(INOUT) :: X
395
INTEGER, INTENT(IN) :: MSIZE
398
INTEGER :: FINDMINIMUM
399
DO I = 1, MSIZE-1 ! except for the last
400
LOCATION = FINDMINIMUM(X, I, MSIZE) ! find min from this to last
401
CALL SWAP(X(I), X(LOCATION)) ! swap this and the minimum
405
! --------------------------------------------------------------------
406
! REAL*8 FUNCTION Median() :
407
! This function receives an array X of N entries, copies its value
408
! to a local array Temp(), sorts Temp() and computes the median.
409
! The returned value is of REAL type.
410
! --------------------------------------------------------------------
412
REAL*8 FUNCTION MEDIAN(X, N)
414
INTEGER MAXNREF_EVALS
415
PARAMETER (MAXNREF_EVALS=30)
416
REAL*8, DIMENSION(MAXNREF_EVALS), INTENT(IN) :: X
417
INTEGER, INTENT(IN) :: N
418
REAL*8, DIMENSION(MAXNREF_EVALS) :: TEMP
421
DO I = 1, N ! make a copy
424
CALL SORT(TEMP, N) ! sort the copy
425
IF (MOD(N,2) == 0) THEN ! compute the median
426
MEDIAN = (TEMP(N/2) + TEMP(N/2+1)) / 2.0D0
433
SUBROUTINE PRINT_MADLOOP_BANNER()
435
WRITE(*,*) ' ========================================='
436
$ //'================================================= '
440
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
442
$ //' '//CHAR(27)//'[0m'//' }'
443
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
445
$ //' '//CHAR(27)//'[0m'//' }'
446
WRITE(*,*) '{ '//CHAR(27)//'[32m'//'`7MMM. '
447
$ //' ,MMF'//CHAR(39)//' `7MM `7MMF'/
449
$ /CHAR(27)//'[0m'//' }'
450
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' MMMb '
452
$ //' '//CHAR(27)//'[0m'//' }'
453
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' M YM '
454
$ //' ,M MM ,6'//CHAR(34)//'Yb. ,M'//CHAR(34)//''/
455
$ /CHAR(34)//'bMM MM ,pW'//CHAR(34)/
456
$ /'Wq. ,pW'//CHAR(34)//'Wq.`7MMpdMAo. '//CHAR(27)/
458
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' M Mb M'/
459
$ /CHAR(39)//' MM 8) MM ,AP MM MM 6W'/
460
$ /CHAR(39)//' `Wb 6W'//CHAR(39)//' `Wb MM `Wb '/
461
$ /CHAR(27)//'[0m'//' }'
462
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' M YM.P'/
463
$ /CHAR(39)//' MM ,pm9MM 8MI MM MM '
464
$ //' , 8M M8 8M M8 MM M8 '//CHAR(27)//'[0m'
466
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' M `YM'/
467
$ /CHAR(39)//' MM 8M MM `Mb MM MM '
468
$ //' ,M YA. ,A9 YA. ,A9 MM ,AP '//CHAR(27)/
470
WRITE(*,*) '{ '//CHAR(27)//'[32m'//'.JML. `'/
471
$ /CHAR(39)//' .JMML.`Moo9^Yo.`Wbmd'//CHAR(34)/
472
$ /'MML..JMMmmmmMMM `Ybmd9'//CHAR(39)//' `Ybmd9'/
473
$ /CHAR(39)//' MMbmmd'//CHAR(39)//' '//CHAR(27)/
475
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
477
$ //' MM '//CHAR(27)//'[0m'//' }'
478
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
480
$ //' .JMML. '//CHAR(27)//'[0m'//' }'
481
WRITE(*,*) '{ '//CHAR(27)//'[32m'//CHAR(27)/
482
$ /'[0m'//'v2.2.3 (2015-02-10), Ref: arXiv:1103.0621v'
483
$ //'2, arXiv:1405.0301'//CHAR(27)//'[32m'//' '
484
$ //' '//CHAR(27)//'[0m'//' }'
485
WRITE(*,*) '{ '//CHAR(27)//'[32m'//' '
487
$ //' '//CHAR(27)//'[0m'//' }'
491
WRITE(*,*) ' ========================================='
492
$ //'================================================= '