2
c**************************************************************************
3
c This is the driver for the whole calulation
4
c**************************************************************************
10
parameter (ZERO = 0d0)
12
include 'nexternal.inc'
17
integer i,ninvar,nconfigs,j,l,l1,l2,ndim
18
double precision dsig,tot,mean,sigma
19
integer npoints,lunsud
20
double precision x,y,jac,s1,s2,xmin
29
character*40 result_file,where_file
30
common /sample_status/result_file,where_file,nsteps
31
integer Minvar(maxdim,lmaxconfigs)
32
common /to_invar/ Minvar
34
common/to_dsig/ dsigtot
36
common/to_group/ngroup
41
integer mincfig, maxcfig
42
common/to_configs/mincfig, maxcfig
45
double precision twgt, maxwgt,swgt(maxevents)
47
common/to_unwgt/twgt, maxwgt, swgt, lun, nw
50
double precision pmass(nexternal)
52
double precision qmass(2)
53
common/to_qmass/ qmass
55
c $B$ new_def $E$ this is a tag for MadWeigth, Don't edit this line
57
c double precision xsec,xerr
58
c integer ncols,ncolflow(maxamps),ncolalt(maxamps),ic
59
c common/to_colstats/ncols,ncolflow,ncolalt,ic
69
open (unit=lun+1,file='../dname.mg',status='unknown',err=11)
70
read (lun+1,'(a130)',err=11,end=11) buf
73
if(l1.ne.0.and.l2.ne.0.and.l1.lt.l2-1)
74
$ read(buf(l1+1:l2-1),*,err=11) ngroup
75
11 print *,'Process in group number ',ngroup
78
twgt = -2d0 !determine wgt after first iteration
79
open(unit=lun,status='scratch')
81
call setrun !Sets up run parameters
82
c $B$ setpara $B$ ! this is a tag for MadWeight. Don't edit this line
83
call setpara('param_card.dat',.true.) !Sets up couplings and masses
84
c $E$ setpara $E$ ! this is a tag for MadWeight. Don't edit this line
85
include 'pmass.inc' !Sets up particle masses
86
include 'qmass.inc' !Sets up particle masses inside onium state
87
call setcuts !Sets up cuts
88
call printout !Prints out a summary of paramaters
89
call run_printout !Prints out a summary of the run settings
92
c If CKKW-type matching, read IS Sudakov grid
93
if(ickkw.eq.2 .and. (lpp(1).ne.0.or.lpp(2).ne.0))then
95
open(unit=lunsud,file=issgridfile,status='old',ERR=20)
97
20 issgridfile='lib/'//issgridfile
99
open(unit=lunsud,file=issgridfile,status='old',ERR=30)
101
30 issgridfile='../'//issgridfile
103
print *,'ERROR: No Sudakov grid file found in lib with ickkw=2'
107
print *,'Reading Sudakov grid file ',issgridfile
108
40 call readgrid(lunsud)
109
print *,'Done reading IS Sudakovs'
114
if(ngroup.ge.nhmult) hmult=.true.
116
print *,'Running CKKW as highest mult sample'
118
print *,'Running CKKW as lower mult sample'
125
write(*,*) "getting user params"
126
call get_user_params(ncall,itmax,mincfig)
128
minvar(1,1) = 0 !This tells it to map things invarients
129
write(*,*) 'Attempting mappinvarients',nconfigs,nexternal
130
call map_invarients(minvar,nconfigs,ninvar,mincfig,maxcfig,nexternal,nincoming)
131
write(*,*) "Completed mapping",nexternal
132
ndim = 3*(nexternal-2)-4
133
if (abs(lpp(1)) .ge. 1) ndim=ndim+1
134
if (abs(lpp(2)) .ge. 1) ndim=ndim+1
137
if (abs(lpp(1)) .ge. 1 .and. abs(lpp(1)) .ge. 1) then
138
minvar(ndim-1,j)=ninvar-1
139
minvar(ndim,j) = ninvar
140
elseif (abs(lpp(1)) .ge. 1 .or. abs(lpp(1)) .ge. 1) then
141
minvar(ndim,j) = ninvar
144
write(*,*) "about to integrate ", ndim,ncall,itmax,ninvar,nconfigs
145
call sample_full(ndim,ncall,itmax,dsig,ninvar,nconfigs)
147
c Now write out events to permanent file
149
if (twgt .gt. 0d0) maxwgt=maxwgt/twgt
150
write(lun,'(a,f20.5)') 'Summary', maxwgt
154
c write(*,'(a34,20I7)'),'Color flows originally chosen: ',
155
c & (ncolflow(i),i=1,ncols)
156
c write(*,'(a34,20I7)'),'Color flows according to diagram:',
157
c & (ncolalt(i),i=1,ncols)
159
c call sample_result(xsec,xerr)
160
c write(*,*) 'Final xsec: ',xsec
167
c $B$ get_user_params $B$ ! tag for MadWeight
168
c change this routine to read the input in a file
170
subroutine get_user_params(ncall,itmax,iconfig)
171
c**********************************************************************
172
c Routine to get user specified parameters for run
173
c**********************************************************************
178
include 'nexternal.inc'
182
integer ncall,itmax,iconfig, jconfig
187
double precision dconfig
192
logical multi_channel
193
common/to_matrix/isum_hel, multi_channel
194
double precision accur
195
common /to_accuracy/accur
197
common /to_weight/use_cut
199
integer lbw(0:nexternal) !Use of B.W.
205
write(*,'(a)') 'Enter number of events and iterations: '
206
read(*,*) ncall,itmax
207
write(*,*) 'Number of events and iterations ',ncall,itmax
208
write(*,'(a)') 'Enter desired fractional accuracy: '
210
write(*,*) 'Desired fractional accuracy: ',accur
212
write(*,'(a)') 'Enter 0 for fixed, 2 for adjustable grid: '
214
if (use_cut .lt. 0 .or. use_cut .gt. 2) then
215
write(*,*) 'Bad choice, using 2',use_cut
219
write(*,10) 'Suppress amplitude (0 no, 1 yes)? '
222
multi_channel = .true.
223
write(*,*) 'Using suppressed amplitude.'
225
multi_channel = .false.
226
write(*,*) 'Using full amplitude.'
229
write(*,10) 'Exact helicity sum (0 yes, n = number/event)? '
233
write(*,*) 'Explicitly summing over helicities'
236
write(*,*) 'Summing over',i,' helicities/event'
239
write(*,10) 'Enter Configuration Number: '
241
iconfig = int(dconfig)
242
write(*,12) 'Running Configuration Number: ',iconfig
244
c Here I want to set up with B.W. we map and which we don't
246
dconfig = dconfig-iconfig
247
if (dconfig .eq. 0) then
248
write(*,*) 'Not subdividing B.W.'
252
jconfig=dconfig*1000.1
253
write(*,*) 'Using dconfig=',jconfig
254
call DeCode(jconfig,lbw(1),3,nexternal)
255
write(*,*) 'BW Setting ', (lbw(j),j=1,nexternal-2)
256
c do i=nexternal-3,0,-1
257
c if (jconfig .ge. 2**i) then
259
c jconfig=jconfig-2**i
263
c write(*,*) i+1, lbw(i+1)
269
c $E$ get_user_params $E$ ! tag for MadWeight
270
c change this routine to read the input in a file
added
removed
Template/SubProcesses/driver.f
