← Back to branch summary

~maddevelopers/mg5amcnlo/2.6.6_bug_1813292

« back to all changes in this revision

Viewing changes to Template/NLO/SubProcesses/symmetry_fks_v3.f

  • Committer: olivier-mattelaer
  • Date: 2017-05-26 07:48:55 UTC
  • mfrom: (271.1.33 2.5.5)
  • Revision ID: olivier-mattelaer-20170526074855-r463wfxlom110fiu
pass the 2.5.5

Show diffs side-by-side

added added

removed removed

Lines of Context:
Template/NLO/SubProcesses/symmetry_fks_v3.f
52
52
     &     ,nexternal-1),p_ev_red1(0:3,nexternal-1)
53
53
      integer ninvar, ndim, minconfig, maxconfig
54
54
      common/tosigint/ndim
55
 
      integer ncall,itmax,nconfigs,ntry, ngraphs
 
55
      integer ncall,itmax,nconfigs,ntry
56
56
      integer icb(nexternal-1,maxswitch),jc(12),nswitch
57
 
      double precision saveamp(maxamps)
 
57
      double precision saveamp(ngraphs)
58
58
      integer nmatch, ibase
59
59
      logical mtc, even
60
60
 
61
61
c
62
62
c     Global
63
63
c
64
 
      Double Precision amp2(maxamps), jamp2(0:maxamps)
 
64
      Double Precision amp2(ngraphs), jamp2(0:ncolor)
65
65
      common/to_amps/  amp2,       jamp2
66
66
      include 'coupl.inc'
67
67
 
183
183
      iconfig=1
184
184
      ichan=1
185
185
      iconfigs(1)=iconfig
186
 
      call setfksfactor(iconfig,.false.)
 
186
      call setfksfactor(.false.)
187
187
c
188
188
      ndim = 55
189
189
      ncall = 10000
370
370
c
371
371
c     Process info
372
372
c
373
 
      integer maxflow
374
 
      parameter (maxflow=999)
375
373
      integer idup(nexternal,maxproc),mothup(2,nexternal,maxproc),
376
374
     &     icolup(2,nexternal,maxflow),niprocs
377
375
c      include 'leshouche.inc'
449
447
      subroutine clear_events()
450
448
      end
451
449
 
452
 
       subroutine write_input(nconfigs)
453
 
c***************************************************************************
454
 
c     Writes out input file for approximate calculation based on the
455
 
c     number of active configurations
456
 
c***************************************************************************
457
 
      implicit none
458
 
c
459
 
c     Constants
460
 
c
461
 
      include 'genps.inc'
462
 
      include '../../Source/run_config.inc'
463
 
      integer    maxpara
464
 
      parameter (maxpara=1000)
465
 
c      integer   npoint_tot,         npoint_min
466
 
c      parameter (npoint_tot=50000, npoint_min=1000)
467
 
c
468
 
c     Arguments
469
 
c
470
 
      integer nconfigs
471
 
c
472
 
c     local
473
 
c
474
 
      integer npoints
475
 
      character*20 param(maxpara),value(maxpara)
476
 
      integer npara, nreq
477
 
      logical gridpack
478
 
c-----
479
 
c  Begin Code
480
 
c-----
481
 
      call load_para(npara,param,value)
482
 
      gridpack=.false.
483
 
 
484
 
      npoints = min_events_subprocess/nconfigs
485
 
      npoints = max(npoints,min_events_channel)
486
 
      open (unit=26, file = 'input_app.txt', status='unknown',
487
 
     $     err=99)
488
 
      if (gridpack) then
489
 
         write(26,*) npoints_wu,itmax_wu,
490
 
     &     '     !Number of events and iterations'      
491
 
         write(26,'(f8.4,a)') acc_wu, '    !Accuracy'
492
 
         write(26,*) ' 2       !Grid Adjustment 0=none'
493
 
      else
494
 
         write(26,*) npoints,iter_survey,
495
 
     &     '     !Number of events and iterations'      
496
 
         write(26,*) ' 0.0    !Accuracy'
497
 
         write(26,*) ' 0       !Grid Adjustment 0=none'
498
 
      endif
499
 
      write(26,*) ' 1       !Suppress Amplitude 1=yes'
500
 
      write(26,*) nhel_survey,'       !Helicity Sum/event 0=exact'
501
 
      close(26)
502
 
      return
503
 
 99   close(26)
504
 
      write(*,*) 'Error opening input_app.txt'
505
 
      end
506
450
 
507
451
      subroutine write_bash(mapconfig, use_config, pwidth, jcomp
508
452
     &     ,iforest)
554
498
      ic = 0      
555
499
      do i=1,mapconfig(0)
556
500
         if (use_config(i) .gt. 0) then
557
 
            call bw_conflict(i,iforest(1,-max_branch,i),lconflict)
558
 
            nbw=0               !Look for B.W. resonances
559
 
            do j=1,imax
560
 
               iarray(j)=0      !Assume no cuts on BW
561
 
            enddo
562
 
            do j=1,nexternal-3
563
 
               if (pwidth(-j,i) .gt. 1d-20) then
564
 
                  nbw=nbw+1
565
 
                  write(*,*) 'Got bw',-nbw,j
566
 
                  if(lconflict(-j).or.gForceBW(-j,i)) then
567
 
                     if(lconflict(-j)) write(*,*) 'Got conflict ',-nbw,j
568
 
                     if(gForceBW(-j,i)) write(*,*) 'Got forced BW ',-nbw,j
569
 
                     iarray(nbw)=1 !Cuts on BW
570
 
                     if (nbw .gt. imax) then
571
 
                        write(*,*) 'Too many BW w conflicts',nbw,imax
572
 
                     endif
573
 
                  endif
574
 
               endif
575
 
            enddo
576
 
c            do j=1,2**nbw
577
 
            done = .false.
578
 
            do while (.not. done)
579
 
               call enCode(icode,iarray,ibase,imax)
580
 
c               write(*,*) 'mapping',ic,mapconfig(i)
581
 
c$$$               if (r_from_b(mapconfig(i)) .lt. 10) then
582
 
c$$$                  write(26,'(i1$)') r_from_b(mapconfig(i))
583
 
c$$$               elseif (r_from_b(mapconfig(i)) .lt. 100) then
584
 
c$$$                  write(26,'(i2$)') r_from_b(mapconfig(i))
585
 
c$$$               elseif (r_from_b(mapconfig(i)) .lt. 1000) then
586
 
c$$$                  write(26,'(i3$)') r_from_b(mapconfig(i))
587
 
c$$$               elseif (r_from_b(mapconfig(i)) .lt. 10000) then
588
 
c$$$                  write(26,'(i4$)') r_from_b(mapconfig(i))
589
 
               if (mapconfig(i) .lt. 10) then
590
 
                  write(26,'(i1$)') mapconfig(i)
591
 
               elseif (mapconfig(i) .lt. 100) then
592
 
                  write(26,'(i2$)') mapconfig(i)
593
 
               elseif (mapconfig(i) .lt. 1000) then
594
 
                  write(26,'(i3$)') mapconfig(i)
595
 
               elseif (mapconfig(i) .lt. 10000) then
596
 
                  write(26,'(i4$)') mapconfig(i)
597
 
               endif
598
 
               if (icode .eq. 0) then
599
 
c                 write(26,'($a)') '.000'
600
 
               elseif (icode .lt. 10) then
601
 
                  write(26,'(a,i1$)') '.00', icode
602
 
               elseif (icode .lt. 100) then
603
 
                  write(26,'(a,i2$)') '.0', icode
604
 
               elseif (icode .lt. 1000) then
605
 
                  write(26,'(a,i3$)') '.', icode
606
 
               else
607
 
                  write(*,*) 'Error too many B.W. in symmetry.f',icode
608
 
                  stop
609
 
               endif
610
 
               write(26,'(a$)') ' '
611
 
               call bw_increment_array(iarray,imax,ibase,gForceBW(-imax,i),done)
612
 
            enddo
 
501
            if (mapconfig(i) .lt. 10) then
 
502
               write(26,'(i1$)') mapconfig(i)
 
503
            elseif (mapconfig(i) .lt. 100) then
 
504
               write(26,'(i2$)') mapconfig(i)
 
505
            elseif (mapconfig(i) .lt. 1000) then
 
506
               write(26,'(i3$)') mapconfig(i)
 
507
            elseif (mapconfig(i) .lt. 10000) then
 
508
               write(26,'(i4$)') mapconfig(i)
 
509
            endif
 
510
            write(26,'(a$)') ' '
613
511
         endif
614
512
      enddo
615
513
      close(26)
616
514
      if (mapconfig(0) .gt. 9999) then
617
515
         write(*,*) 'Only writing first 9999 jobs',mapconfig(0)
 
516
         stop 1
618
517
      endif
619
518
c
620
519
c     Now write out the symmetry factors for each graph
622
521
      open (unit=26, file = 'symfact.dat', status='unknown')
623
522
      do i=1,mapconfig(0)
624
523
         if (use_config(i) .gt. 0) then
625
 
c
626
 
c        Need to write appropriate number of BW sets this is
627
 
c        same thing as above for the bash file
628
 
c
629
 
            call bw_conflict(i,iforest(1,-max_branch,i),lconflict)
630
 
            nbw=0               !Look for B.W. resonances
631
 
            if (jcomp .eq. 0 .or. jcomp .eq. 1 .or. .true.) then
632
 
               do j=1,imax
633
 
                  iarray(j)=0   !Assume no cuts on BW
634
 
               enddo
635
 
               do j=1,nexternal-3
636
 
                  if (pwidth(-j,i) .gt. 1d-20) then
637
 
                     nbw=nbw+1
638
 
                     write(*,*) 'Got bw',nbw,j
639
 
                     if(lconflict(-j).or.gForceBW(-j,i)) then
640
 
                        iarray(nbw)=1 !Cuts on BW
641
 
                        if (nbw .gt. imax) then
642
 
                           write(*,*) 'Too many BW w conflicts',nbw,imax
643
 
                        endif
644
 
                     endif
645
 
                  endif
646
 
               enddo
647
 
            endif            
648
 
            done = .false.
649
 
            do while (.not. done)
650
 
               call enCode(icode,iarray,ibase,imax)
651
 
               if (icode .gt. 0) then
652
 
                  write(26,'(f9.3,i6)') mapconfig(i)+real(icode)/1000.,
653
 
     $                 use_config(i)
654
 
               else
655
 
                  write(26,'(2i6)') mapconfig(i),use_config(i)
656
 
               endif
657
 
               call bw_increment_array(iarray,imax,ibase,gForceBW(-imax,i),done)
658
 
            enddo
 
524
            write(26,'(2i6)') mapconfig(i),use_config(i)
659
525
         else
660
526
            write(26,'(2i6)') mapconfig(i),-mapconfig(-use_config(i))
661
527
         endif
663
529
      end
664
530
 
665
531
 
666
 
      subroutine BW_Conflict(iconfig,itree,lconflict)
667
 
c***************************************************************************
668
 
c     Determines which BW conflict
669
 
c***************************************************************************
670
 
      implicit none
671
 
c
672
 
c     Constants
673
 
c
674
 
      include 'genps.inc'
675
 
      include 'nexternal.inc'
676
 
      double precision zero
677
 
      parameter       (zero=0d0)
678
 
c      include '../../Source/run_config.inc'
679
 
c
680
 
c     Arguments
681
 
c
682
 
      integer itree(2,-max_branch:-1),iconfig
683
 
      logical lconflict(-max_branch:nexternal)
684
 
 
685
 
c
686
 
c     local
687
 
c
688
 
      integer i,j
689
 
      double precision pwidth(-max_branch:-1,lmaxconfigs)  !Propagator width
690
 
      double precision pmass(-max_branch:-1,lmaxconfigs)   !Propagator mass
691
 
      double precision pow(-max_branch:-1,lmaxconfigs)    !Not used, in props.inc
692
 
      double precision xmass(-max_branch:nexternal)
693
 
c
694
 
c     Global
695
 
c
696
 
      include 'coupl.inc'                     !Mass and width info
697
 
c-----
698
 
c  Begin Code
699
 
c-----
700
 
      include 'born_props.inc'   !Propagator mass and width information pmass,pwidth
701
 
      write(*,*) 'Checking for BW ',iconfig
702
 
c
703
 
c     Reset variables
704
 
c      
705
 
      do i=1,nexternal-1
706
 
         xmass(i) = 0d0
707
 
         lconflict(-i) = .false.
708
 
      enddo
709
 
c
710
 
c     Start by determining which propagators are part of the same 
711
 
c     chain, or could potentially conflict
712
 
c
713
 
      i=1
714
 
      do while (i .lt. nexternal-3 .and. itree(1,-i) .ne. 1)
715
 
         xmass(-i) = xmass(itree(1,-i))+xmass(itree(2,-i))
716
 
         if (pwidth(-i,iconfig) .gt. 0d0) then
717
 
            if (xmass(-i) .gt. pmass(-i,iconfig)) then  !Can't be on shell
718
 
               lconflict(-i)=.true.
719
 
               write(*,*) "Found Conflict", iconfig,i,
720
 
     $              pmass(-i,iconfig),xmass(-i)
721
 
            endif
722
 
         endif
723
 
         xmass(-i) = max(xmass(-i),pmass(-i,iconfig)+
724
 
     &                                 3d0*pwidth(-i,iconfig))        
725
 
         i=i+1
726
 
      enddo
727
 
c
728
 
c     Mark all daughters of conflicted BW as conflicting
729
 
c
730
 
      do j=i,1,-1
731
 
         if (lconflict(-j)) then 
732
 
            lconflict(itree(1,-j)) = .true.
733
 
            lconflict(itree(2,-j)) = .true.
734
 
            write(*,*) 'Adding conflict ',itree(1,-j),itree(2,-j)
735
 
         endif
736
 
      enddo
737
 
c
738
 
c     Only include BW props as conflicting
739
 
c
740
 
      do j=i,1,-1
741
 
         if (lconflict(-j)) then 
742
 
            if (pwidth(-j,iconfig) .le. 0) then 
743
 
               lconflict(-j) = .false.
744
 
               write(*,*) 'No conflict BW',iconfig,j
745
 
            else
746
 
               write(*,*) 'Conflicting BW',iconfig,j
747
 
            endif
748
 
         endif
749
 
      enddo                  
750
 
 
751
 
      end
752
 
 
753
 
 
754
 
 
755
 
 
756
 
      subroutine bw_increment_array(iarray,imax,ibase,force,done)
757
 
c************************************************************************
758
 
c     Increments iarray     
759
 
c************************************************************************
760
 
      implicit none
761
 
c
762
 
c     Arguments
763
 
c
764
 
      integer imax          !Input, number of elements in iarray
765
 
      integer ibase         !Base for incrementing, 0 is skipped
766
 
      logical force(imax)   !Force onshell BW, counting from -imax to -1
767
 
      integer iarray(imax)  !Output:Array of values being incremented
768
 
      logical done          !Output:Set when no more incrementing
769
 
 
770
 
c
771
 
c     Global
772
 
c
773
 
      include 'genps.inc'
774
 
 
775
 
c
776
 
c     Local
777
 
c
778
 
      integer i,j
779
 
      logical found
780
 
c-----
781
 
c  Begin Code
782
 
c-----
783
 
      found = .false.
784
 
      i = 1
785
 
      do while (i .le. imax .and. .not. found)
786
 
         if (iarray(i) .eq. 0) then    !don't increment this
787
 
            i=i+1
788
 
         elseif (iarray(i) .lt. ibase-1 .and. .not. force(imax+1-i)) then
789
 
            found = .true.
790
 
            iarray(i)=iarray(i)+1
791
 
         else
792
 
            iarray(i)=1
793
 
            i=i+1
794
 
         endif
795
 
      enddo
796
 
      done = .not. found
797
 
      end
798
532
c
799
533
c
800
534
c Dummy routines