← Back to branch summary

~maddevelopers/mg5amcnlo/new_clustering

« back to all changes in this revision

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

  • Committer: Rikkert Frederix
  • Date: 2021-09-09 15:51:40 UTC
  • mfrom: (78.75.502 3.2.1)
  • Revision ID: frederix@physik.uzh.ch-20210909155140-rg6umfq68h6h47cf
merge with 3.2.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
Template/NLO/SubProcesses/splitorders_stuff.f
 
1
C some functions which deal with the splitorders
 
2
      subroutine fill_needed_splittings()
 
3
      ! loop over the FKS configurations and fill the split_type_used
 
4
      ! common blocks
 
5
      implicit none
 
6
      include "nexternal.inc"
 
7
      include "nFKSconfigs.inc"
 
8
      include "fks_info.inc"
 
9
      include "orders.inc"
 
10
      logical split_type_used(nsplitorders)
 
11
      common/to_split_type_used/split_type_used
 
12
      integer i, j
 
13
      do j = 1, nsplitorders
 
14
        split_type_used(j)=.false.
 
15
      enddo
 
16
      do i = 1, fks_configs
 
17
        do j = 1, nsplitorders
 
18
          split_type_used(j)=split_type_used(j).or.
 
19
     %      split_type_d(i,j)
 
20
        enddo
 
21
      enddo
 
22
      write(*,*) 'SPLIT TYPE USED:', split_type_used
 
23
      return
 
24
      end
 
25
 
 
26
 
 
27
      integer function get_orders_tag(ord)
 
28
C a function that assigns to a given order
 
29
C array an integer number
 
30
      implicit none
 
31
      include 'orders.inc'
 
32
      integer ord(nsplitorders)
 
33
      integer i,j
 
34
      integer base, step
 
35
      parameter(base=100)
 
36
      ! this is for the printout of the informations
 
37
      logical firsttime, firsttime_contr(amp_split_size)
 
38
      data firsttime/.true./
 
39
      data firsttime_contr/amp_split_size * .true./
 
40
      integer orders_to_amp_split_pos
 
41
 
 
42
      ! print out some extra informations
 
43
      if (firsttime) write(*,fmt='(a)',advance="NO") 
 
44
     $    "INFO: orders_tag_plot is computed as:"
 
45
 
 
46
      get_orders_tag=0
 
47
      step=1
 
48
      do i =1, nsplitorders
 
49
        if (firsttime) write(*,fmt='(3a,i8)',advance="NO") 
 
50
     $      "         + ", ordernames(i), " * ", step
 
51
        get_orders_tag=get_orders_tag+step*ord(i)
 
52
        step=step*100
 
53
      enddo
 
54
      if (firsttime) then
 
55
        write(*,*)
 
56
        firsttime=.false.
 
57
      endif
 
58
 
 
59
      if (firsttime_contr(orders_to_amp_split_pos(ord))) then
 
60
        write(*,*) 'orders_tag_plot= ', get_orders_tag, ' for ',
 
61
     #     (ordernames(i),",",i=1,nsplitorders), ' = ',
 
62
     #     (ord(i),",",i=1,nsplitorders)
 
63
        firsttime_contr(orders_to_amp_split_pos(ord)) = .false.
 
64
      endif
 
65
 
 
66
      return 
 
67
      end
 
68
 
 
69
 
 
70
      integer function get_orders_tag_from_amp_pos(iamp)
 
71
C     calls get_orders_tag for the orders corresponding to 
 
72
C     the iamp-th amp_split
 
73
      implicit none
 
74
      integer iamp
 
75
      include 'orders.inc'
 
76
      integer ord(nsplitorders)
 
77
      integer get_orders_tag
 
78
 
 
79
      call amp_split_pos_to_orders(iamp, ord)
 
80
      get_orders_tag_from_amp_pos = get_orders_tag(ord)
 
81
 
 
82
      return
 
83
      end
 
84
      
 
85
      
 
86
      integer function orders_to_amp_split_pos(ord)
 
87
C helper function to keep track of the different coupling order combinations
 
88
C given the squared orders ord, return the corresponding position into the amp_split array
 
89
      implicit none
 
90
      include 'orders.inc'
 
91
      integer ord(nsplitorders)
 
92
      integer i,j
 
93
      include 'amp_split_orders.inc'
 
94
 
 
95
      do i=1, amp_split_size
 
96
        do j=1, nsplitorders
 
97
          if (amp_split_orders(i,j).ne.ord(j)) goto 999 
 
98
        enddo
 
99
        orders_to_amp_split_pos = i
 
100
        return
 
101
 999    continue   
 
102
      enddo
 
103
 
 
104
      WRITE(*,*) 'ERROR:: Stopping function orders_to_amp_split_pos'
 
105
      WRITE(*,*) 'Could not find orders ',(ord(i),i=1
 
106
     $ ,nsplitorders)
 
107
      stop
 
108
 
 
109
      return
 
110
      end
 
111
 
 
112
 
 
113
      subroutine amp_split_pos_to_orders(pos, orders)
 
114
C helper function to keep track of the different coupling order combinations
 
115
C given the position pos, return the corresponding order powers orders
 
116
C it is the inverse of orders_to_amp_split_pos
 
117
      implicit none
 
118
      include 'orders.inc'
 
119
      integer pos, orders(nsplitorders)
 
120
      integer i
 
121
      include 'amp_split_orders.inc'
 
122
 
 
123
C sanity check
 
124
      if (pos.gt.amp_split_size.or.pos.lt.0) then
 
125
        write(*,*) 'ERROR in amp_split_pos_to_orders'
 
126
        write(*,*) 'Invalid pos', pos, amp_split_size
 
127
        stop 1
 
128
      endif
 
129
 
 
130
      do i = 1, nsplitorders
 
131
        orders(i) = amp_split_orders(pos,i)
 
132
      enddo
 
133
      return
 
134
      end
 
135
 
 
136
 
 
137
      integer function lo_qcd_to_amp_pos(qcdpower)
 
138
      implicit none
 
139
      integer qcdpower
 
140
      include 'orders.inc'
 
141
      integer pos, orders(nsplitorders)
 
142
      do pos = 1, amp_split_size_born
 
143
        call amp_split_pos_to_orders(pos, orders)
 
144
        if (orders(qcd_pos).eq.qcdpower) exit
 
145
      enddo
 
146
      lo_qcd_to_amp_pos = pos
 
147
      return
 
148
      end
 
149
 
 
150
 
 
151
      integer function nlo_qcd_to_amp_pos(qcdpower)
 
152
      implicit none
 
153
      integer qcdpower
 
154
      include 'orders.inc'
 
155
      integer pos, orders(nsplitorders)
 
156
      do pos = amp_split_size_born + 1, amp_split_size
 
157
        call amp_split_pos_to_orders(pos, orders)
 
158
        if (orders(qcd_pos).eq.qcdpower) exit
 
159
      enddo
 
160
      nlo_qcd_to_amp_pos = pos
 
161
      return
 
162
      end
 
163
 
 
164
 
 
165
      subroutine check_amp_split()
 
166
C check that amp_split_pos_to_orders and orders_to_amp_split_pos behave
 
167
C as expected (one the inverse of the other)
 
168
C Check also get_orders_tag vs get_orders_tag_from_amp_pos
 
169
C Stop the code if anything wrong is found
 
170
C Also, print on screen a summary of the orders in amp_split 
 
171
      implicit none
 
172
      include 'orders.inc'
 
173
      integer orders_to_amp_split_pos
 
174
      integer i, pos
 
175
      integer ord(nsplitorders)
 
176
      integer get_orders_tag, get_orders_tag_from_amp_pos
 
177
 
 
178
      do i = 1, amp_split_size
 
179
        call amp_split_pos_to_orders(i, ord)
 
180
        pos = orders_to_amp_split_pos(ord)
 
181
 
 
182
        if (pos.ne.i) then
 
183
          write(*,*) 'ERROR#1 in check amp_split', pos, i 
 
184
          write(*,*) 'ORD is ', ord
 
185
          stop 1
 
186
        endif
 
187
 
 
188
        if (get_orders_tag(ord).ne.get_orders_tag_from_amp_pos(i)) then
 
189
          write(*,*) 'ERROR#2 in check amp_split', get_orders_tag(ord), 
 
190
     $    get_orders_tag_from_amp_pos(i) 
 
191
          write(*,*) 'I, ORD ', i, ord
 
192
          stop 1
 
193
        endif
 
194
 
 
195
        write(*,*) 'AMP_SPLIT: ', i, 'correspond to S.O.', ord
 
196
      enddo
 
197
 
 
198
      return
 
199
      end
 
200
 
 
201
 
 
202