~madteam/mg5amcnlo/series2.0

« back to all changes in this revision

Viewing changes to Template/loop_material/StandAlone/SubProcesses/MadLoopCommons.inc

  • Committer: olivier Mattelaer
  • Date: 2015-03-05 00:14:16 UTC
  • mfrom: (258.1.9 2.3)
  • mto: (258.8.1 2.3)
  • mto: This revision was merged to the branch mainline in revision 259.
  • Revision ID: olivier.mattelaer@uclouvain.be-20150305001416-y9mzeykfzwnl9t0j
partial merge

Show diffs side-by-side

added added

removed removed

Lines of Context:
294
294
C BEGIN CODE
295
295
C ----------
296
296
      LPASS=.TRUE.
297
 
      IF(NLOOPLINE.GE.7.OR.RANK.GE.7)LPASS=.FALSE.
 
297
      IF(NLOOPLINE.GE.8.OR.RANK.GE.8)LPASS=.FALSE.
298
298
      RETURN
299
299
      END
300
300
 
328
328
      RETURN
329
329
      END
330
330
 
 
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.
 
333
 
 
334
! --------------------------------------------------------------------
 
335
! INTEGER FUNCTION  FindMinimum():
 
336
!    This function returns the location of the minimum in the section
 
337
! between Start and End.
 
338
! --------------------------------------------------------------------
 
339
 
 
340
      INTEGER FUNCTION  FindMinimum(x, mStart, mEnd)
 
341
      IMPLICIT  NONE
 
342
      INTEGER MAXNREF_EVALS
 
343
      PARAMETER (MAXNREF_EVALS=30)
 
344
      INTEGER, DIMENSION(MAXNREF_EVALS), INTENT(IN) :: x
 
345
      INTEGER, INTENT(IN)                                                         :: mStart, mEnd
 
346
      INTEGER                                                                             :: Minimum
 
347
      INTEGER                                                                             :: Location
 
348
      INTEGER                                                                             :: i
 
349
 
 
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
 
356
         END IF
 
357
      END DO
 
358
      FindMinimum = Location         ! return the position
 
359
      END FUNCTION  FindMinimum
 
360
 
 
361
! --------------------------------------------------------------------
 
362
! SUBROUTINE  Swap():
 
363
!    This subroutine swaps the values of its two formal arguments.
 
364
! --------------------------------------------------------------------
 
365
 
 
366
      SUBROUTINE  Swap(a, b)
 
367
      IMPLICIT  NONE
 
368
      REAL*8,  INTENT(INOUT) :: a, b
 
369
      REAL*8                 :: Temp
 
370
 
 
371
      Temp = a
 
372
      a    = b
 
373
      b    = Temp
 
374
      END SUBROUTINE  Swap
 
375
 
 
376
! --------------------------------------------------------------------
 
377
! SUBROUTINE  Sort():
 
378
!    This subroutine receives an array x() and sorts it into ascending
 
379
! order.
 
380
! --------------------------------------------------------------------
 
381
 
 
382
      SUBROUTINE  Sort(x, mSize)
 
383
      IMPLICIT  NONE
 
384
      INTEGER MAXNREF_EVALS
 
385
      PARAMETER (MAXNREF_EVALS=30)
 
386
      REAL*8, DIMENSION(MAXNREF_EVALS), INTENT(INOUT)  :: x
 
387
      INTEGER, INTENT(IN)                                                          :: mSize
 
388
      INTEGER                                                                              :: i
 
389
      INTEGER                                                                              :: Location
 
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
 
394
      END DO
 
395
      END SUBROUTINE  Sort
 
396
 
 
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
! --------------------------------------------------------------------
 
403
 
 
404
      REAL*8 FUNCTION  Median(X, N)
 
405
      IMPLICIT  NONE
 
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
 
411
      INTEGER                                         :: i
 
412
 
 
413
      DO i = 1, N                       ! make a copy
 
414
         Temp(i) = X(i)
 
415
      END DO
 
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
 
419
      ELSE
 
420
         Median = Temp(N/2+1)
 
421
      END IF
 
422
      END FUNCTION  Median
 
423
 
 
424
 
331
425
      SUBROUTINE PRINT_MADLOOP_BANNER()
332
426
 
333
427
      %(print_banner_commands)s
334
428
 
335
429
      END
 
430