Page Menu
Home
HEPForge
Search
Configure Global Search
Log In
Files
F8310176
SusHiWrap.f
No One
Temporary
Actions
Download File
Edit File
Delete File
View Transforms
Subscribe
Mute Notifications
Award Token
Flag For Later
Size
16 KB
Subscribers
None
SusHiWrap.f
View Options
subroutine
sushixsection
(
xsecggh_out
,
errxsecggh_out
,
&
xsecbbh_out
,
errxsecbbh_out
)
implicit none
integer
ndm
,
ncall
,
itmx
,
nprn
,
ncall1
,
itmx1
,
nprn1
,
count1
logical
ppcoll
,
fhflagout
,
thdmcflagout
double precision
xl
(
10
),
xu
(
10
),
acc
double precision
SigLO
,
errLO
,
Sig_bb
,
err_bb
,
Sig_bg
,
err_bg
double precision
delmb
,
delAb
double precision
wAex
(
2
),
wLHex
(
2
),
wHHex
(
2
)
double precision
xsecggh_out
,
xsecbbh_out
double precision
errxsecggh_out
,
errxsecbbh_out
!common variables used by various routines
include
'commons/common-inputoutput.f'
include
'commons/common-consts.f'
include
'commons/common-vars.f'
include
'commons/common-quark.f'
include
'commons/common-int.f'
include
'commons/common-ren.f'
include
'commons/common-readdata.f'
include
'commons/common-citations.f'
common
/
coll
/
ppcoll
common
/
bveg1
/
xl
,
xu
,
acc
,
ndm
,
ncall
,
itmx
,
nprn
c
jfilein
=
"tempsushi.in"
jfilein
=
"tempsushi.in"
call
initsushi
(
0
,
fhflagout
,
thdmcflagout
,
delmb
,.
false
.)
!settings for VEGAS and PDF initialization
ncall1
=
ncall
itmx1
=
itmx
nprn1
=
nprn
C
-
{{{
cuts
!definition of cuts
subtr
=
.
true
.
minpt
=
0.d0
maxpt
=
cme
*
(
1
-
z
)
/
2.d0
minrap
=
0.d0
maxrap
=
-
dlog
(
z
)
/
2.d0
if
(
dist
.
ge
.
2
)
then
if
((
maxrapc
.
lt
.
0.d0
).
or
.(
&
(
maxrapc
.
ge
.
maxrap
).
and
.(.
not
.
pseudorap
)
))
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: y out of range. '
write
(
*
,
*
)
'Abs[y] < '
,
maxrap
write
(
*
,
105
)
stop
endif
endif
if
(
dist
.
eq
.
1
)
then
subtr
=
.
false
.
if
(
norderggh
.
eq
.
0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: At LO, the pt of the Higgs'
,
&
'is always zero. No distribution can be calulated. '
write
(
*
,
105
)
stop
endif
if
((
maxptc
.
lt
.
0.d0
).
or
.(
maxptc
.
ge
.
maxpt
))
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: pt out of range. '
! write(*,*) '30 GeV < pt < ', maxpt, ' GeV '
write
(
*
,
105
)
stop
endif
elseif
(
dist
.
eq
.
3
)
then
if
(
norderggh
.
eq
.
0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: At LO, the pt of the Higgs'
,
&
'is always zero. No distribution can be calulated. '
write
(
*
,
105
)
stop
endif
subtr
=
.
false
.
if
(
maxptc
.
gt
.
&
dsqrt
(
mh2
*
(
dexp
(
2
*
maxrapc
)
*
(
1
/
z
+
z
)
-
1
-
dexp
(
4
*
maxrapc
)))
/
&(
1
+
dexp
(
2
*
maxrapc
)))
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: pt out of range. '
write
(
*
,
*
)
'for y = '
,
maxrapc
,
', pt must satisfy'
write
(
*
,
*
)
'0 < pt < '
,
dsqrt
(
mh2
*
(
dexp
(
2
*
maxrapc
)
&
*
(
1
/
z
+
z
)
-
1
-
dexp
(
4
*
maxrapc
)))
/
(
1
+
dexp
(
2
*
maxrapc
))
write
(
*
,
105
)
stop
endif
endif
if
(
ptc
.
eq
.
0
)
then
!no pt-cut
ptcut
=
.
false
.
mincut
=
.
false
.
elseif
(
ptc
.
eq
.
1
)
then
!pt > ptmin
if
((
minptc
.
lt
.
0.d0
).
or
.(
minptc
.
ge
.
maxpt
))
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ptmin out of range. '
write
(
*
,
105
)
stop
endif
ptcut
=
.
true
.
mincut
=
.
true
.
if
(
minptc
.
gt
.
0.d0
)
subtr
=
.
false
.
minpt
=
minptc
elseif
(
ptc
.
eq
.
2
)
then
!pt < ptmax
if
(
maxptc
.
lt
.
0.d0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ptmax out of range. '
write
(
*
,
105
)
stop
endif
ptcut
=
.
true
.
mincut
=
.
false
.
minpt
=
0.d0
if
(
maxptc
.
gt
.
maxpt
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Warning: ptmax too large. '
write
(
*
,
*
)
'maximal value for ptmax is '
,
maxpt
,
' GeV. '
write
(
*
,
105
)
else
maxpt
=
maxptc
endif
elseif
(
ptc
.
eq
.
3
)
then
!ptmin < pt < ptmax
if
((
minptc
.
lt
.
0.d0
).
or
.(
minptc
.
ge
.
maxpt
))
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ptmin out of range. '
write
(
*
,
105
)
stop
endif
if
(
maxptc
.
lt
.
0.d0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ptmax out of range. '
write
(
*
,
105
)
stop
endif
ptcut
=
.
true
.
mincut
=
.
true
.
if
(
minptc
.
gt
.
0.d0
)
subtr
=
.
false
.
minpt
=
minptc
if
(
maxptc
.
gt
.
maxpt
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Warning: ptmax too large. '
write
(
*
,
*
)
'maximal value for ptmax is '
,
maxpt
,
' GeV. '
write
(
*
,
105
)
else
maxpt
=
maxptc
endif
if
(
maxpt
.
le
.
minpt
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ptmin larger then ptmax. '
write
(
*
,
105
)
stop
endif
else
write
(
*
,
105
)
write
(
*
,
*
)
'Error: bad value in Block DISTRIB. '
write
(
*
,
105
)
stop
endif
if
(
rapc
.
eq
.
0
)
then
!no ycut
rapcut
=
.
false
.
elseif
(
rapc
.
eq
.
1
)
then
!Abs[y] < ymax
if
(
maxrapc
.
lt
.
0.d0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ymax out of range. '
write
(
*
,
105
)
stop
endif
rapcut
=
.
true
.
minrap
=
0.d0
if
((
maxrapc
.
gt
.
maxrap
).
and
.(.
not
.
pseudorap
))
then
write
(
*
,
105
)
write
(
*
,
*
)
'Warning: ymax too large. '
write
(
*
,
*
)
'maximal value for ymax is '
,
maxrap
,
'. '
write
(
*
,
105
)
else
maxrap
=
maxrapc
endif
elseif
(
rapc
.
eq
.
2
)
then
!Abs[y] > ymin
if
(
pseudorap
)
then
if
(
minrapc
.
lt
.
0.d0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ymin out of range. '
write
(
*
,
*
)
'0 < ymin'
write
(
*
,
105
)
stop
endif
maxrap
=
1.d100
else
if
((
minrapc
.
lt
.
0.d0
).
or
.(
minrapc
.
ge
.
maxrap
))
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ymin out of range. '
write
(
*
,
*
)
'0 < ymin < '
,
maxrap
write
(
*
,
105
)
stop
endif
endif
rapcut
=
.
true
.
minrap
=
minrapc
elseif
(
rapc
.
eq
.
3
)
then
!ymin < Abs[y] < ymax
if
(
pseudorap
)
then
if
(
minrapc
.
lt
.
0.d0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ymin out of range. '
write
(
*
,
*
)
'0 < ymin'
write
(
*
,
105
)
stop
endif
maxrap
=
maxrapc
else
if
((
minrapc
.
lt
.
0.d0
).
or
.(
minrapc
.
ge
.
maxrap
))
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ymin out of range. '
write
(
*
,
*
)
'0 < ymin < '
,
maxrap
write
(
*
,
105
)
stop
endif
if
(
maxrapc
.
gt
.
maxrap
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Warning: ymax too large. '
write
(
*
,
*
)
'maximal value for ymax is '
,
maxrap
,
'. '
write
(
*
,
105
)
else
maxrap
=
maxrapc
endif
endif
if
(
maxrapc
.
lt
.
0.d0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: ymax out of range. '
write
(
*
,
105
)
stop
endif
rapcut
=
.
true
.
minrap
=
minrapc
else
write
(
*
,
105
)
write
(
*
,
*
)
'Error: bad value in Block DISTRIB. '
write
(
*
,
105
)
stop
endif
if
(
rapcut
.
and
.
pseudorap
.
and
.
subtr
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: Pseudorapidity cuts cannot be '
,
&
'applied when pt = 0 is allowed. '
write
(
*
,
105
)
stop
endif
if
((
dist
.
eq
.
2
).
and
.
subtr
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Error: (Pseudo)rapidity distributions cannot be '
,
&
'calculated when pt = 0 is allowed. '
write
(
*
,
105
)
stop
endif
if
(((
dist
.
eq
.
1
).
or
.(
dist
.
eq
.
3
)).
and
.
ptcut
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Warning: Cuts in pt will be ignored '
,
&
'when calculating pt-distribution. '
write
(
*
,
105
)
ptcut
=
.
false
.
minpt
=
0.d0
maxpt
=
cme
*
(
1
-
z
)
/
2.d0
endif
if
((
dist
.
ge
.
2
).
and
.
rapcut
)
then
write
(
*
,
105
)
write
(
*
,
*
)
'Warning: (Pseudo)rapidity cuts will be ignored '
,
&
'when calculating (pseudo)rapidity-distribution. '
write
(
*
,
105
)
rapcut
=
.
false
.
minrap
=
0.d0
maxrap
=
-
dlog
(
z
)
/
2.d0
endif
pty
=
.
false
.
juser
=
.
false
.
if
(
rapcut
.
and
.(.
not
.
pseudorap
))
then
pty
=
.
true
.
endif
if
(
juser
)
then
pty
=
.
false
.
endif
pt
=
maxptc
y
=
maxrapc
C
----
In
initializing
arrays
needed
to
store
cross
section
values
,
to
zero
do
count1
=
1
,
3
SUbbh
(
count1
)
=
0.D0
SUbbhsusy
(
count1
)
=
0.D0
SUbbherr
(
count1
)
=
0.D0
SUbbhsusyerr
(
count1
)
=
0.D0
SUggh
(
count1
)
=
0.D0
SUggherr
(
count1
)
=
0.D0
end do
itmx
=
itmx1
nprn
=
nprn1
C
----
initialization
of
pdfs
if
((
norderggh
.
eq
.
0
).
or
.((
dist
.
eq
.
0
).
and
.(
norderbbh
.
ge
.
0
)))
then
call
SUinitpdf
(
1
,
SUpdfs
(
1
),
SUiset
)
endif
if
((
norderggh
.
ge
.
1
).
or
.((
dist
.
eq
.
0
).
and
.(
norderbbh
.
ge
.
1
)))
then
call
SUinitpdf
(
2
,
SUpdfs
(
2
),
SUiset
)
endif
if
((
dist
.
eq
.
0
).
and
.(
ptc
.
eq
.
0
).
and
.(
rapc
.
eq
.
0
)
&
.
and
.((
norderggh
.
ge
.
2
).
or
.(
norderbbh
.
ge
.
2
)))
then
call
SUinitpdf
(
3
,
SUpdfs
(
3
),
SUiset
)
endif
!Differential distributions for bbh
if
((
dist
.
eq
.
0
).
and
.((
ptc
.
gt
.
0
).
or
.(
rapc
.
gt
.
0
)))
then
if
(
norderbbh
.
ge
.
0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
"Performing (N)LO bbh calculation with cuts"
write
(
*
,
105
)
citations
(
9
)
=
1
if
(
ptc
.
gt
.
0
)
then
write
(
*
,
*
)
"Applied p_t cuts: "
,
minpt
,
maxpt
end if
if
(
rapc
.
gt
.
0
)
then
write
(
*
,
*
)
"Applied pseudorapidity cuts:"
,
minrap
,
maxrap
end if
call
SUinitpdf
(
1
,
SUpdfs
(
1
),
SUiset
)
call
runCouplings
(
muR
,
0
)
call
bbhdiffinit
(
0
,
cme
,
mh
,
0.d0
,
mt
&
,
-
1
,
-
1
,
0
,
pseudorap
,
minpt
,
maxpt
,
minrap
,
maxrap
,
muR
,
muF
)
call
Sigma_bbHNLO
(
ncall1
,
SigLO
,
errLO
,
Sig_bb
,
err_bb
,
&
Sig_bg
,
err_bg
,
SUbbh
(
1
),
SUbbherr
(
1
))
if
(
norderbbh
.
ge
.
1
)
then
call
SUinitpdf
(
2
,
SUpdfs
(
2
),
SUiset
)
call
runCouplings
(
muR
,
1
)
call
bbhdiffinit
(
1
,
cme
,
mh
,
0.d0
,
mt
,
-
1
,
-
1
,
0
,
&
pseudorap
,
minpt
,
maxpt
,
minrap
,
maxrap
,
muR
,
muF
)
call
Sigma_bbHNLO
(
ncall1
,
SigLO
,
errLO
,
Sig_bb
,
err_bb
,
&
Sig_bg
,
err_bg
,
SUbbh
(
2
),
SUbbherr
(
2
))
end if
if
(
norderbbh
.
eq
.
2
)
then
write
(
*
,
105
)
write
(
*
,
*
)
&
"Warning: Differential cross sections for bb->H are"
write
(
*
,
*
)
&
"not available at NNLO. NLO results are given."
write
(
*
,
105
)
end if
end if
end if
ncall
=
ncall1
C
-
}}}
C
-
{{{
settings
for
NLO
calculation
call
initcouplings
(
fhflagout
,
delmb
,
delAb
)
if
((
dist
.
eq
.
0
).
and
.(
ptc
.
eq
.
0
).
and
.(
rapc
.
eq
.
0
))
then
write
(
*
,
105
)
write
(
*
,
*
)
"Calling ggh@nnlo and bbh@nnlo"
write
(
*
,
105
)
!calling at LO
call
XSgghbbh
(
0
,
SUggh
(
1
),
SUggherr
(
1
),
SUbbh
(
1
))
!calling at NLO
call
XSgghbbh
(
1
,
SUggh
(
2
),
SUggherr
(
2
),
SUbbh
(
2
))
!calling at NNLO
call
XSgghbbh
(
2
,
SUggh
(
3
),
SUggherr
(
3
),
SUbbh
(
3
))
end if
if
(
norderggh
.
eq
.
0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
"Performing LO ggh calculation"
write
(
*
,
105
)
else if
(
norderggh
.
gt
.
0
)
then
write
(
*
,
105
)
write
(
*
,
*
)
"Performing NLO ggh calculation"
write
(
*
,
105
)
endif
C
-
}}}
C
-
{{{
weighting
of
bbh
results
If
(
dist
.
eq
.
0
)
then
!weighting bbh result for MSSM
if
((
model
.
eq
.
1
).
or
.(
model
.
eq
.
2
))
then
if
(
delmbfh
.
eq
.
1
)
then
call
bbhweights
(
model
,
twohdmver
,
alpha
,
tanb
,
&
delmb
,
1.D0
,
wAex
,
wLHex
,
wHHex
)
else
call
bbhweights
(
model
,
twohdmver
,
alpha
,
tanb
,
&
delmb
,
delAb
,
wAex
,
wLHex
,
wHHex
)
endif
if
(
norderbbh
.
eq
.
0
)
then
do
count1
=
1
,
3
if
(
pseudo
.
eq
.
0
)
then
SUbbhsusy
(
count1
)
=
wLHex
(
1
)
*
SUbbh
(
count1
)
SUbbhsusyerr
(
count1
)
=
wLHex
(
1
)
*
SUbbherr
(
count1
)
else if
(
pseudo
.
eq
.
1
)
then
SUbbhsusy
(
count1
)
=
wAex
(
1
)
*
SUbbh
(
count1
)
SUbbhsusyerr
(
count1
)
=
wAex
(
1
)
*
SUbbherr
(
count1
)
else if
(
pseudo
.
eq
.
2
)
then
SUbbhsusy
(
count1
)
=
wHHex
(
1
)
*
SUbbh
(
count1
)
SUbbhsusyerr
(
count1
)
=
wHHex
(
1
)
*
SUbbherr
(
count1
)
end if
end do
else
do
count1
=
1
,
3
if
(
pseudo
.
eq
.
0
)
then
SUbbhsusy
(
count1
)
=
wLHex
(
2
)
*
SUbbh
(
count1
)
SUbbhsusyerr
(
count1
)
=
wLHex
(
2
)
*
SUbbherr
(
count1
)
else if
(
pseudo
.
eq
.
1
)
then
SUbbhsusy
(
count1
)
=
wAex
(
2
)
*
SUbbh
(
count1
)
SUbbhsusyerr
(
count1
)
=
wAex
(
2
)
*
SUbbherr
(
count1
)
else if
(
pseudo
.
eq
.
2
)
then
SUbbhsusy
(
count1
)
=
wHHex
(
2
)
*
SUbbh
(
count1
)
SUbbhsusyerr
(
count1
)
=
wHHex
(
2
)
*
SUbbherr
(
count1
)
end if
end do
end if
end if
end if
C
-
}}}
C
-
{{{
calculation
of
cross
sections
-
NLO
full
contributions
ncall
=
ncall1
itmx
=
itmx1
nprn
=
nprn1
if
(
norderggh
.
ge
.
0
)
then
if
(
model
.
eq
.
1
)
then
call
XSFull
(
SUggh
,
SUggherr
,
ggsusy
,
qgsusy
,
qqsusy
,
ggsusyerr
,
&
qgsusyerr
,
qqsusyerr
,
CSsusy
,
susyerr
,
elw
,
mssm
,
errmssm
)
endif
if
(
model
.
eq
.
2
)
then
call
renormalizeSM
call
XSFull
(
SUggh
,
SUggherr
,
ggsusy
,
qgsusy
,
qqsusy
,
ggsusyerr
,
&
qgsusyerr
,
qqsusyerr
,
CSsusy
,
susyerr
,
elw
,
mssm
,
errmssm
)
endif
if
(
model
.
eq
.
0
)
then
!set couplings to SM values:
gc
=
yukfac
(
1
)
gt
=
yukfac
(
2
)
gb
=
yukfac
(
3
)
gtp
=
yukfac
(
4
)
gbp
=
yukfac
(
5
)
call
renormalizeSM
ncall
=
ncall1
itmx
=
itmx1
nprn
=
nprn1
call
XSFull
(
SUggh
,
SUggherr
,
ggsm
,
qgsm
,
qqsm
,
ggsmerr
,
qgsmerr
,
&
qqsmerr
,
CSsm
,
smerr
,
elw
,
sm
,
errsm
)
end if
end if
C
-
}}}
C
-
{{{
showing
output
/
writing
the
file
-
output
call
screenoutputsushi
()
102
format
(
' '
,
i4
,
' '
,
e16
.
8
,
' # '
,
a21
)
103
format
(
a
)
104
format
(
a
,
a
)
105
format
(
'#--------------------------------------------------#'
)
106
format
(
a12
,
' '
,
f10
.
5
,
' GeV'
)
c
xsecggh_out
=
c
errxsecggh_out
=
c
xsecbbh_out
=
c
write
(
*
,
*
)
order
,
"....."
c
call
initcouplings
(
fhflagout
,
delmb
,
delAb
)
c
call
XSgghbbh
(
order
,
xsecggh_out
,
errxsecggh_out
,
xsecbbh_out
)
if
((
model
.
eq
.
1
).
or
.(
model
.
eq
.
2
))
then
xsecggh_out
=
CSsusy
(
1
)
errxsecggh_out
=
susyerr
(
1
)
if
(
norderggh
.
ge
.
1
)
then
xsecggh_out
=
CSsusy
(
2
)
errxsecggh_out
=
susyerr
(
2
)
endif
else if
(
model
.
eq
.
0
)
then
xsecggh_out
=
CSsm
(
1
)
errxsecggh_out
=
smerr
(
1
)
if
(
norderggh
.
ge
.
1
)
then
xsecggh_out
=
CSsm
(
2
)
errxsecggh_out
=
smerr
(
2
)
endif
endif
if
(
model
.
eq
.
0
)
then
if
(
norderbbh
.
eq
.
0
)
then
xsecbbh_out
=
SUbbh
(
1
)
errxsecbbh_out
=
SUbbherr
(
1
)
else if
(
norderbbh
.
ge
.
0
)
then
xsecbbh_out
=
SUbbh
(
2
)
errxsecbbh_out
=
SUbbherr
(
2
)
end if
if
(
norderbbh
.
eq
.
2
)
then
if
(.
not
.((
ptc
.
gt
.
0
).
or
.(
rapc
.
gt
.
0
)))
then
xsecbbh_out
=
SUbbh
(
3
)
errxsecbbh_out
=
SUbbherr
(
3
)
end if
end if
endif
if
((
model
.
eq
.
1
).
or
.(
model
.
eq
.
2
))
then
if
(
norderbbh
.
eq
.
0
)
then
xsecbbh_out
=
SUbbhsusy
(
1
)
errxsecbbh_out
=
SUbbhsusyerr
(
1
)
else if
(
norderbbh
.
ge
.
1
)
then
xsecbbh_out
=
SUbbhsusy
(
2
)
errxsecbbh_out
=
SUbbhsusyerr
(
2
)
end if
if
(
norderbbh
.
eq
.
2
)
then
if
((
ptc
.
eq
.
0
).
and
.(
rapc
.
eq
.
0
))
then
xsecbbh_out
=
SUbbhsusy
(
3
)
errxsecbbh_out
=
SUbbhsusyerr
(
3
)
end if
end if
endif
end
File Metadata
Details
Attached
Mime Type
text/x-fortran
Expires
Sat, Dec 21, 5:36 PM (9 h, 50 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
4022776
Default Alt Text
SusHiWrap.f (16 KB)
Attached To
rSCANNERSSVN scannerssvn
Event Timeline
Log In to Comment