~madteam/mg5amcnlo/series2.0

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/MadLoop_output_from_the_interface/TIR_output/%ggttx_IOTest%SubProcesses%MadLoopCommons.f

  • 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:
302
302
C     BEGIN CODE
303
303
C     ----------
304
304
      LPASS=.TRUE.
305
 
      IF(NLOOPLINE.GE.7.OR.RANK.GE.7)LPASS=.FALSE.
 
305
      IF(NLOOPLINE.GE.8.OR.RANK.GE.8)LPASS=.FALSE.
306
306
      RETURN
307
307
      END
308
308
 
336
336
      RETURN
337
337
      END
338
338
 
339
 
      SUBROUTINE PRINT_MADLOOP_BANNER()
340
 
 
341
 
      WRITE(*,*) ' ==================================================='
342
 
     $ //'======================================= '
343
 
      WRITE(*,*) '{                                                  '
344
 
     $ //'                                        }'
345
 
      WRITE(*,*) '{       '//CHAR(27)//'[32m'//'                     '
346
 
     $ //'                                                       '/
347
 
     $ /CHAR(27)//'[0m'//'       }'
348
 
      WRITE(*,*) '{       '//CHAR(27)//'[32m'//'                     '
349
 
     $ //'          ,,                                           '/
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       '
355
 
     $ //'          MM    MM                                     '/
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'/
364
 
     $ /'       }'
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'//'                     '
376
 
     $ //'                                              MM       '/
377
 
     $ /CHAR(27)//'[0m'//'       }'
378
 
      WRITE(*,*) '{       '//CHAR(27)//'[32m'//'                     '
379
 
     $ //'                                            .JMML.     '/
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'/
384
 
     $ /'       }'
385
 
      WRITE(*,*) '{       '//CHAR(27)//'[32m'//'                     '
386
 
     $ //'                                                       '/
387
 
     $ /CHAR(27)//'[0m'//'       }'
388
 
      WRITE(*,*) '{                                                  '
389
 
     $ //'                                        }'
390
 
      WRITE(*,*) ' ==================================================='
391
 
     $ //'======================================= '
392
 
 
393
 
      END
 
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.
 
341
 
 
342
        ! --------------------------------------------------------------------
 
343
        ! INTEGER FUNCTION  FindMinimum():
 
344
        !    This function returns the location of the minimum in the section
 
345
        ! between Start and End.
 
346
        ! --------------------------------------------------------------------
 
347
 
 
348
      INTEGER FUNCTION  FINDMINIMUM(X, MSTART, MEND)
 
349
      IMPLICIT  NONE
 
350
      INTEGER MAXNREF_EVALS
 
351
      PARAMETER (MAXNREF_EVALS=30)
 
352
      INTEGER, DIMENSION(MAXNREF_EVALS), INTENT(IN) :: X
 
353
      INTEGER, INTENT(IN)                                                         :: MSTART, MEND
 
354
      INTEGER                                                                             :: MINIMUM
 
355
      INTEGER                                                                             :: LOCATION
 
356
      INTEGER                                                                             :: I
 
357
 
 
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
 
364
          END IF
 
365
          END DO
 
366
          FINDMINIMUM = LOCATION  ! return the position
 
367
          END FUNCTION  FINDMINIMUM
 
368
 
 
369
            ! --------------------------------------------------------------------
 
370
            ! SUBROUTINE  Swap():
 
371
            !    This subroutine swaps the values of its two formal arguments.
 
372
            ! --------------------------------------------------------------------
 
373
 
 
374
          SUBROUTINE  SWAP(A, B)
 
375
          IMPLICIT  NONE
 
376
          REAL*8,  INTENT(INOUT) :: A, B
 
377
          REAL*8                 :: TEMP
 
378
 
 
379
          TEMP = A
 
380
          A    = B
 
381
          B    = TEMP
 
382
          END SUBROUTINE  SWAP
 
383
 
 
384
            ! --------------------------------------------------------------------
 
385
            ! SUBROUTINE  Sort():
 
386
            !    This subroutine receives an array x() and sorts it into ascending
 
387
            ! order.
 
388
            ! --------------------------------------------------------------------
 
389
 
 
390
          SUBROUTINE  SORT(X, MSIZE)
 
391
          IMPLICIT  NONE
 
392
          INTEGER MAXNREF_EVALS
 
393
          PARAMETER (MAXNREF_EVALS=30)
 
394
          REAL*8, DIMENSION(MAXNREF_EVALS), INTENT(INOUT)  :: X
 
395
          INTEGER, INTENT(IN)                                                      :: MSIZE
 
396
          INTEGER                                                                                  :: I
 
397
          INTEGER                                                                                  :: LOCATION
 
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
 
402
            END DO
 
403
            END SUBROUTINE  SORT
 
404
 
 
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
              ! --------------------------------------------------------------------
 
411
 
 
412
            REAL*8 FUNCTION  MEDIAN(X, N)
 
413
            IMPLICIT  NONE
 
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
 
419
            INTEGER                                         :: I
 
420
 
 
421
            DO I = 1, N  ! make a copy
 
422
              TEMP(I) = X(I)
 
423
              END DO
 
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
 
427
              ELSE
 
428
                MEDIAN = TEMP(N/2+1)
 
429
                END IF
 
430
                END FUNCTION  MEDIAN
 
431
 
 
432
 
 
433
                SUBROUTINE PRINT_MADLOOP_BANNER()
 
434
 
 
435
                WRITE(*,*) ' ========================================='
 
436
     $           //'================================================= '
 
437
                WRITE(*,*) '{                                        '
 
438
     $           //'                                                '
 
439
     $           //'  }'
 
440
                WRITE(*,*) '{       '//CHAR(27)//'[32m'//'           '
 
441
     $           //'                                                 '
 
442
     $           //'                '//CHAR(27)//'[0m'//'       }'
 
443
                WRITE(*,*) '{       '//CHAR(27)//'[32m'//'           '
 
444
     $           //'                    ,,                           '
 
445
     $           //'                '//CHAR(27)//'[0m'//'       }'
 
446
                WRITE(*,*) '{       '//CHAR(27)//'[32m'//'`7MMM.    '
 
447
     $           //' ,MMF'//CHAR(39)//'             `7MM  `7MMF'/
 
448
     $           /CHAR(39)//'                                   '/
 
449
     $           /CHAR(27)//'[0m'//'       }'
 
450
                WRITE(*,*) '{       '//CHAR(27)//'[32m'//'  MMMb  '
 
451
     $           //'  dPMM                 MM    MM                  '
 
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)/
 
457
     $           /'[0m'//'       }'
 
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'
 
465
     $           //'       }'
 
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)/
 
469
     $           /'[0m'//'       }'
 
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)/
 
474
     $           /'[0m'//'       }'
 
475
                WRITE(*,*) '{       '//CHAR(27)//'[32m'//'           '
 
476
     $           //'                                                 '
 
477
     $           //'       MM       '//CHAR(27)//'[0m'//'       }'
 
478
                WRITE(*,*) '{       '//CHAR(27)//'[32m'//'           '
 
479
     $           //'                                                 '
 
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'//'           '
 
486
     $           //'                                                 '
 
487
     $           //'                '//CHAR(27)//'[0m'//'       }'
 
488
                WRITE(*,*) '{                                        '
 
489
     $           //'                                                '
 
490
     $           //'  }'
 
491
                WRITE(*,*) ' ========================================='
 
492
     $           //'================================================= '
 
493
 
 
494
                END
 
495
 
394
496