Index: trunk/HiggsBounds-5/AllAnalyses =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Index: trunk/HiggsBounds-5/S95tables.f90 =================================================================== --- trunk/HiggsBounds-5/S95tables.f90 (revision 569) +++ trunk/HiggsBounds-5/S95tables.f90 (revision 570) @@ -1,5140 +1,5140 @@ ! This file is part of HiggsBounds ! -KW !****************************************************************** module S95tables !****************************************************************** use S95tables_type1 use S95tables_type2 use usefulbits, only: Hneut,Hplus implicit none private public :: & & S95_t1,S95_t2, & & setup_S95tables,deallocate_S95tables, & & calcfact,outputproc, & & check_against_bound, & & convolve_chisq_with_gaussian, & & S95_t1_or_S95_t2_idfromelementnumber, & & f_from_t2,f_from_t3,f_from_slices_t2, & & WhichColliderString,get_collider_element_number, & & inrange, deallocate_Exptranges integer :: ntable1,ntable2 !----------------------------------------------------------------------------------- ! delta_M*_* determine how close in mass particles should be before their masses are combined ! nb. delta*_* is only used for tables of type 1 at the moment ! for some analyses, S95_t1(x)%deltax has already been set in S95tables_type1.f90 ! for analyses where S95_t1(x)%deltax is *not* has already set: ! we set ! LEP neutral Higgs tables to have deltax=delta_Mh_LEP ! Tevatron neutral Higgs tables to have deltax=delta_Mh_TEV ! LHC neutral Higgs tables to have deltax=delta_Mh_LHC ! LEP charged Higgs tables to have deltax=delta_Mhplus_LEP ! Tevatron charged Higgs tables to have deltax=delta_Mhplus_TEV ! LHC charged Higgs tables to have deltax=delta_Mhplus_LHC ! other LEP tables to have deltax=delta_M_LEP_default ! other Tevatron tables to have deltax=delta_M_TEV_default ! other LHC tables to have deltax=delta_M_LHC_default ! setting delta_M*_LHC and/or delta_M*_TEV and/or delta_M*_LEP to zero turns this feature off ! DO NOT CHANGE THESE VALUES BEFORE READING THE MANUAL ! even when it is appropriate to add the cross sections, we would recommend using ! delta_Mh_LEP<=2.0D0, delta_Mh_TEV<=10.0, delta_Mh_LHC<=10.0 double precision, parameter :: delta_Mh_LEP=0.0D0 double precision, parameter :: delta_Mh_TEV=10.0D0 double precision, parameter :: delta_Mh_LHC=10.0D0 double precision, parameter :: delta_Mhplus_LEP=0.0D0 double precision, parameter :: delta_Mhplus_TEV=0.0D0 double precision, parameter :: delta_Mhplus_LHC=0.0D0 double precision, parameter :: delta_M_LEP_default=0.0D0 !where delta_M_LEP/TEV/LHC is not specified double precision, parameter :: delta_M_TEV_default=0.0D0 !these values will be used double precision, parameter :: delta_M_LHC_default=0.0D0 ! !double precision, parameter :: delta_Mh_LEP=15.0D0 !crazy values - for debugging only !double precision, parameter :: delta_Mh_TEV=15.0D0 !crazy(ish) values - for debugging only !double precision, parameter :: delta_Mh_LHC=15.0D0 !crazy(ish) values - for debugging only !----------------------------------------------------------------------------------- ! Use the SM expected channel contributions to weight the channels in the likeness test logical :: use_weight = .True. ! eps determines how strict the Standard Model test is double precision, parameter :: eps=2.0D-2 !double precision, parameter :: eps=1.0D3 !crazy value - for debugging only !----------------------------------------------------------------------------------- !table type 1----------------------------- type(table1),allocatable :: S95_t1(:) !------------------------------------------ !table type 2------------------------------ type(table2),allocatable :: S95_t2(:) !------------------------------------------ character(LEN=5),parameter :: colliders(5) = (/'LEP ','TEV ','LHC7 ','LHC8 ','LHC13'/) !------------------------------------------- double precision, allocatable :: Exptrange_Mhmin_forSMdecays(:), Exptrange_Mhmax_forSMdecays(:) double precision, allocatable :: Exptrange_Mhmin_forSMXS(:), Exptrange_Mhmax_forSMXS(:) contains !********************************************************** subroutine setup_S95tables ! Allocates and calls subroutines to fill S95_t1, S95_t2 ! (which store the experimental data) ! Sets delta_M_TEV,delta_M_LEP,delta_M_LHC which govern how close Higgs ! need to be in mass before HiggsBounds combines their cross sections !********************************************************** use usefulbits, only : debug,np,not_a_particle use theory_BRfunctions, only : BRSMt1Mhmax,BRSMt1Mhmin use theory_XS_SM_functions, only : tevXS_SM_functions_xmin, tevXS_SM_functions_xmax, & & lhc7XS_SM_functions_xmin,lhc7XS_SM_functions_xmax, & & lhc8XS_SM_functions_xmin,lhc8XS_SM_functions_xmax, & & lhc13XS_SM_functions_xmin,lhc13XS_SM_functions_xmax implicit none !-----------------------------------internal integer :: i,c double precision, allocatable :: max_expt_delta_Mh(:) double precision, allocatable :: Expttables_Mhmin_forSMXS(:),Expttables_Mhmax_forSMXS(:) double precision, allocatable :: Expttables_Mhmin_forSMdecays(:),Expttables_Mhmax_forSMdecays(:) double precision, allocatable :: delta_x_default(:,:) ! these numbers have to be changed appropriately every time a table is added ! or taken away: - ntable1=191 + ntable1=193 ntable2=37 ! table type 2 involves 2 variables allocate(S95_t1(ntable1)) allocate(S95_t2(ntable2)) call initializetables_type1_blank(S95_t1) call initializetables_type2_blank(S95_t2) call initializetables1(S95_t1) call initializetables2(S95_t2) allocate( Expttables_Mhmin_forSMXS( size(colliders,dim=1) ) ) allocate( Expttables_Mhmax_forSMXS( size(colliders,dim=1) ) ) allocate( Exptrange_Mhmin_forSMXS( size(colliders,dim=1) ) ) allocate( Exptrange_Mhmax_forSMXS( size(colliders,dim=1) ) ) allocate( Expttables_Mhmin_forSMdecays( size(colliders,dim=1) ) ) allocate( Expttables_Mhmax_forSMdecays( size(colliders,dim=1) ) ) allocate( Exptrange_Mhmin_forSMdecays( size(colliders,dim=1) ) ) allocate( Exptrange_Mhmax_forSMdecays( size(colliders,dim=1) ) ) allocate( max_expt_delta_Mh( size(colliders,dim=1) ) ) ! will pick up on any typos in S95_t1%expt do i=lbound(S95_t1,dim=1),ubound(S95_t1,dim=1) if(WhichColliderElement(S95_t1(i)%expt, S95_t1(i)%energy).eq.0)then write(*,*)'~'//trim(adjustl(S95_t1(i)%expt))//'~ is not a valid experiment name' stop 'error in setup_S95tables (a)' endif enddo ! will pick up on any typos in S95_t2%expt do i=lbound(S95_t2,dim=1),ubound(S95_t2,dim=1) if(WhichColliderElement(S95_t2(i)%expt, S95_t2(i)%energy).eq.0)then write(*,*)'~'//trim(adjustl(S95_t2(i)%expt))//'~ is not a valid experiment name' stop 'error in setup_S95tables (b)' endif enddo ! checks that none of the id's are repeated in S95_t1 do i=lbound(S95_t1,dim=1),ubound(S95_t1,dim=1) if( count(S95_t1%id.eq.S95_t1(i)%id) & +count(S95_t2%id.eq.S95_t1(i)%id).ne.1)then write(*,*)'the id',S95_t1(i)%id,'is repeated' stop 'error in setup_S95tables (c1)' endif enddo ! checks that none of the id's are repeated in S95_t2 do i=lbound(S95_t2,dim=1),ubound(S95_t2,dim=1) if( count(S95_t1%id.eq.S95_t2(i)%id)& +count(S95_t2%id.eq.S95_t2(i)%id).ne.1)then write(*,*)'the id',S95_t2(i)%id,'is repeated' stop 'error in setup_S95tables (c2)' endif enddo !check to make sure that S95_t1(i)%particle_x are all particles do i=lbound(S95_t1,dim=1),ubound(S95_t1,dim=1) if(S95_t1(i)%particle_x.eq.not_a_particle)then write(*,*)S95_t1(i)%id,'particle_x=not_a_particle.' stop 'error in setup_S95tables (d1)' endif enddo !check to make sure that S95_t2(i)%particle_x2 are all particles do i=lbound(S95_t2,dim=1),ubound(S95_t2,dim=1) if(S95_t2(i)%particle_x2.eq.not_a_particle)then write(*,*)S95_t2(i)%id,'particle_x2=not_a_particle.' stop 'error in setup_S95tables (d2)' endif enddo ! looks for the min and max values of Mh (neutral Higgs) in each type of tables ! will be used in input.f90 to work out which SM para need to be calculated ! initial (impossible) values Expttables_Mhmin_forSMXS=1.0D6 Expttables_Mhmax_forSMXS=0.0D0 do i=lbound(S95_t1,dim=1),ubound(S95_t1,dim=1) if(S95_t1(i)%particle_x.eq.Hneut)then do c=1,ubound(colliders,dim=1) if(WhichColliderElement(S95_t1(i)%expt, S95_t1(i)%energy).eq.c)then if(S95_t1(i)%xmax.gt.Expttables_Mhmax_forSMXS(c))Expttables_Mhmax_forSMXS(c)=S95_t1(i)%xmax if(S95_t1(i)%xmin.lt.Expttables_Mhmin_forSMXS(c))Expttables_Mhmin_forSMXS(c)=S95_t1(i)%xmin endif enddo endif enddo do i=lbound(S95_t2,dim=1),ubound(S95_t2,dim=1) if(S95_t2(i)%particle_x2.eq.Hneut)then do c=1,ubound(colliders,dim=1) if(WhichColliderElement(S95_t2(i)%expt, S95_t2(i)%energy).eq.c)then if(S95_t2(i)%xmax2.gt.Expttables_Mhmax_forSMdecays(c))Expttables_Mhmax_forSMdecays(c)=S95_t2(i)%xmax2 if(S95_t2(i)%xmin2.lt.Expttables_Mhmin_forSMdecays(c))Expttables_Mhmin_forSMdecays(c)=S95_t2(i)%xmin2 endif enddo endif enddo Expttables_Mhmin_forSMdecays=Expttables_Mhmin_forSMXS Expttables_Mhmax_forSMdecays=Expttables_Mhmax_forSMXS do i=lbound(S95_t2,dim=1),ubound(S95_t2,dim=1) if(S95_t2(i)%particle_x1.eq.Hneut)then do c=1,ubound(colliders,dim=1) if(WhichColliderElement(S95_t2(i)%expt, S95_t2(i)%energy).eq.c)then if(S95_t2(i)%xmax1.gt.Expttables_Mhmax_forSMdecays(c))Expttables_Mhmax_forSMdecays(c)=S95_t2(i)%xmax1 if(S95_t2(i)%xmin1.lt.Expttables_Mhmin_forSMdecays(c))Expttables_Mhmin_forSMdecays(c)=S95_t2(i)%xmin1 ! Needs_M2_gt_2M1 is true only for processes involving hj->hihi. ! Therefore, SM production cross sections will not be needed for hi. if(.not.S95_t2(i)%needs_M2_gt_2M1)then if(S95_t2(i)%xmax1.gt.Expttables_Mhmax_forSMXS(c))Expttables_Mhmax_forSMXS(c)=S95_t2(i)%xmax1 if(S95_t2(i)%xmin1.lt.Expttables_Mhmin_forSMXS(c))Expttables_Mhmin_forSMXS(c)=S95_t2(i)%xmin1 else if(S95_t2(i)%xmax2.gt.Expttables_Mhmax_forSMXS(c))Expttables_Mhmax_forSMXS(c)=S95_t2(i)%xmax2 if(S95_t2(i)%xmin2.lt.Expttables_Mhmin_forSMXS(c))Expttables_Mhmin_forSMXS(c)=S95_t2(i)%xmin2 endif endif enddo endif enddo ! now we set delta_x if(delta_M_LEP_default.gt.2.1d0) write(*,*)'WARNING: delta_M_LEP_default.gt.2.1d0' if(delta_M_TEV_default.gt.10.1d0)write(*,*)'WARNING: delta_M_TEV_default.gt.10.1d0' if(delta_M_LHC_default.gt.10.1d0)write(*,*)'WARNING: delta_M_LHC_default.gt.10.1d0' if(delta_Mh_LEP .gt.2.1d0) write(*,*)'WARNING: delta_Mh_LEP.gt.2.1d0' if(delta_Mh_TEV .gt.10.1d0)write(*,*)'WARNING: delta_Mh_TEV.gt.10.1d0' if(delta_Mh_LHC .gt.10.1d0)write(*,*)'WARNING: delta_Mh_LHC.gt.10.1d0' if(delta_Mhplus_LEP .gt.2.1d0) write(*,*)'WARNING: delta_Mhplus_LEP.gt.2.1d0' if(delta_Mhplus_TEV .gt.10.1d0)write(*,*)'WARNING: delta_Mhplus_TEV.gt.10.1d0' if(delta_Mhplus_LHC .gt.10.1d0)write(*,*)'WARNING: delta_Mhplus_LHC.gt.10.1d0' allocate( delta_x_default(size(np,dim=1),size(colliders,dim=1)) ) ! fill delta_x_default do c=1,ubound(colliders,dim=1) if(c.eq.get_collider_element_number('LEP '))then ! for some reason, gfortran didn't like having a case statement here delta_x_default(:,c) =delta_M_LEP_default delta_x_default(Hneut,c)=delta_Mh_LEP delta_x_default(Hplus,c)=delta_Mhplus_LEP elseif(c.eq.get_collider_element_number('TEV '))then delta_x_default(:,c) =delta_M_TEV_default delta_x_default(Hneut,c)=delta_Mh_TEV delta_x_default(Hplus,c)=delta_Mhplus_TEV elseif(c.eq.get_collider_element_number('LHC7 '))then delta_x_default(:,c) =delta_M_LHC_default delta_x_default(Hneut,c)=delta_Mh_LHC delta_x_default(Hplus,c)=delta_Mhplus_LHC elseif(c.eq.get_collider_element_number('LHC8 '))then delta_x_default(:,c) =delta_M_LHC_default delta_x_default(Hneut,c)=delta_Mh_LHC delta_x_default(Hplus,c)=delta_Mhplus_LHC elseif(c.eq.get_collider_element_number('LHC13'))then delta_x_default(:,c) =delta_M_LHC_default delta_x_default(Hneut,c)=delta_Mh_LHC delta_x_default(Hplus,c)=delta_Mhplus_LHC else stop 'error in subroutine setup_S95tables' endif enddo do i=lbound(S95_t1,dim=1),ubound(S95_t1,dim=1) if(S95_t1(i)%deltax.lt.-0.5D0)then !i.e. deltax has not been set yet S95_t1(i)%deltax = delta_x_default(S95_t1(i)%particle_x,WhichColliderElement(S95_t1(i)%expt, S95_t1(i)%energy)) endif enddo do i=lbound(S95_t2,dim=1),ubound(S95_t2,dim=1) if(S95_t2(i)%deltax.lt.-0.5D0)then !i.e. deltax has not been set yet S95_t2(i)%deltax = delta_x_default(S95_t2(i)%particle_x2,WhichColliderElement(S95_t2(i)%expt, S95_t2(i)%energy)) endif enddo ! finds the maximum delta_Mh for the each set of tables ! will be used in theo_SM.f90 to work out which SM para need to be calculated max_expt_delta_Mh= -1.0D0 do i=lbound(S95_t1,dim=1),ubound(S95_t1,dim=1) do c=1,ubound(colliders,dim=1) if(WhichColliderElement(S95_t1(i)%expt, S95_t1(i)%energy).eq.c)then if( S95_t1(i)%particle_x.eq.Hneut)then if(S95_t1(i)%deltax .gt.max_expt_delta_Mh(c))then max_expt_delta_Mh(c)=S95_t1(i)%deltax endif endif endif enddo enddo do i=lbound(S95_t2,dim=1),ubound(S95_t2,dim=1) do c=1,ubound(colliders,dim=1) if(WhichColliderElement(S95_t2(i)%expt, S95_t2(i)%energy).eq.c)then if( S95_t2(i)%particle_x2.eq.Hneut)then !note, this means only cross sections for different particle_x2 will be combined if(S95_t2(i)%deltax .gt.max_expt_delta_Mh(c))then max_expt_delta_Mh(c)=S95_t2(i)%deltax endif endif endif enddo enddo if(debug)write(*,*)'max_expt_delta_Mh',max_expt_delta_Mh ! Exptrange_Mhmin_forSMXS = max(Expttables_Mhmin_forSMXS - max_expt_delta_Mh,0.0D0) ! Exptrange_Mhmax_forSMXS = Expttables_Mhmax_forSMXS + max_expt_delta_Mh ! ! Exptrange_Mhmin_forSMdecays = max(Expttables_Mhmin_forSMdecays - max_expt_delta_Mh,0.0D0) ! Exptrange_Mhmax_forSMdecays = Expttables_Mhmax_forSMdecays + max_expt_delta_Mh Exptrange_Mhmin_forSMXS = max(Expttables_Mhmin_forSMXS,0.0D0) Exptrange_Mhmax_forSMXS = Expttables_Mhmax_forSMXS Exptrange_Mhmin_forSMdecays = max(Expttables_Mhmin_forSMdecays,0.0D0) Exptrange_Mhmax_forSMdecays = Expttables_Mhmax_forSMdecays !we need tevXS_SM_functions to have a big enough range to cover the tables if(Exptrange_Mhmax_forSMXS(get_collider_element_number('TEV ')).gt.tevXS_SM_functions_xmax)then stop 'need to extend upper range of tevXS_SM_functions or reduce delta_M_TEV' endif if(Exptrange_Mhmin_forSMXS(get_collider_element_number('TEV ')).lt.tevXS_SM_functions_xmin)then write(*,*)Exptrange_Mhmin_forSMXS(get_collider_element_number('TEV ')),tevXS_SM_functions_xmin ! TS 24/03/2017: Commented out the following (because some new analyses for low mass Higgses ! do not need these functions (decay from heavier Higgs) ! stop 'need to extend lower range of tevXS_SM_functions' endif !we need lhc7XS_SM_functions to have a big enough range to cover the tables if(Exptrange_Mhmax_forSMXS(get_collider_element_number('LHC7 ')).gt.lhc7XS_SM_functions_xmax)then stop 'need to extend upper range of lhc7XS_SM_functions or reduce delta_M_LHC' endif if(Exptrange_Mhmin_forSMXS(get_collider_element_number('LHC7 ')).lt.lhc7XS_SM_functions_xmin)then ! TS 24/03/2017: Commented out the following (because some new analyses for low mass Higgses ! do not need these functions (decay from heavier Higgs) ! stop 'need to extend lower range of lhc7XS_SM_functions' endif !we need lhc8XS_SM_functions to have a big enough range to cover the tables if(Exptrange_Mhmax_forSMXS(get_collider_element_number('LHC8 ')).gt.lhc8XS_SM_functions_xmax)then stop 'need to extend upper range of lhc8XS_SM_functions or reduce delta_M_LHC' endif if(Exptrange_Mhmin_forSMXS(get_collider_element_number('LHC8 ')).lt.lhc8XS_SM_functions_xmin)then ! write(*,*) Exptrange_Mhmin_forSMXS(get_collider_element_number('LHC8 ')) ! TS 24/03/2017: Commented out the following (because some new analyses for low mass Higgses ! do not need these functions (decay from heavier Higgs) ! stop 'need to extend lower range of lhc8XS_SM_functions' endif !we need lhc8XS_SM_functions to have a big enough range to cover the tables if(Exptrange_Mhmax_forSMXS(get_collider_element_number('LHC13')).gt.lhc13XS_SM_functions_xmax)then stop 'need to extend upper range of lhc13XS_SM_functions or reduce delta_M_LHC' endif if(Exptrange_Mhmin_forSMXS(get_collider_element_number('LHC13')).lt.lhc13XS_SM_functions_xmin)then write(*,*) Exptrange_Mhmin_forSMXS(get_collider_element_number('LHC13')) ! TS 24/03/2017: Commented out the following (because some new analyses for low mass Higgses ! do not need these functions (decay from heavier Higgs) ! stop 'need to extend lower range of lhc13XS_SM_functions' endif ! we need the branching ratios for all the colliders if( maxval(Exptrange_Mhmax_forSMdecays).gt.BRSMt1Mhmax)then ! write(*,*) "hello : ", BRSMt1Mhmax, maxval(Exptrange_Mhmax_forSMdecays) stop 'need to extend upper range of BRfunctions or reduce delta_M_(LEP/TEV)' elseif(minval(Exptrange_Mhmin_forSMdecays).lt.BRSMt1Mhmin)then write(*,*)'hello',minval(Exptrange_Mhmin_forSMdecays),BRSMt1Mhmin stop 'need to extend lower range of BRfunctions' endif deallocate(Expttables_Mhmin_forSMXS) deallocate(Expttables_Mhmax_forSMXS) deallocate(Expttables_Mhmin_forSMdecays) deallocate(Expttables_Mhmax_forSMdecays) deallocate(max_expt_delta_Mh) deallocate(delta_x_default) end subroutine setup_S95tables !********************************************************** function inrange(mass,str) ! mass is the neutral Higgs mass to be checked ! str indicates which range it should be checked against: ! str should be either 'SMBR' or one of the elements of the array 'colliders' ! ! The function returns .True. if the mass is in the appropriate range. ! If str='SMBR', this range is ! minval(Exptrange_Mhmin_forSMdecays) to maxval(Exptrange_Mhmax_forSMdecays) ! otherwise this range is ! Exptrange_Mhmin_forSMXS(x) to Exptrange_Mhmax_forSMXS(x) ! where x is the element of the array 'colliders' character(len=*),intent(in) :: str double precision,intent(in) :: mass logical :: inrange integer :: x, i !-TS(05/07/2012) Added a check whether the ranges are allocated (which happens in !-subroutine setup_S95tables. If not, they are allocated and given default values. !-This is needed for HiggsSignals. if(.not.allocated(Exptrange_Mhmin_forSMXS)) then allocate(Exptrange_Mhmin_forSMXS(size(colliders,dim=1))) allocate(Exptrange_Mhmax_forSMXS(size(colliders,dim=1))) do i=1, size(colliders) if(i.eq.get_collider_element_number('LEP ')) then Exptrange_Mhmin_forSMXS(i)=1.0D0 Exptrange_Mhmax_forSMXS(i)=180.0D0 else if(i.eq.get_collider_element_number('TEV ')) then Exptrange_Mhmin_forSMXS(i)=80.0D0 Exptrange_Mhmax_forSMXS(i)=350.0D0 else if(i.eq.get_collider_element_number('LHC7 ')) then Exptrange_Mhmin_forSMXS(i)=90.0D0 Exptrange_Mhmax_forSMXS(i)=1000.0D0 else if(i.eq.get_collider_element_number('LHC8 ')) then Exptrange_Mhmin_forSMXS(i)=90.0D0 Exptrange_Mhmax_forSMXS(i)=1000.0D0 else if(i.eq.get_collider_element_number('LHC13')) then Exptrange_Mhmin_forSMXS(i)=90.0D0 Exptrange_Mhmax_forSMXS(i)=3000.0D0 else stop 'Error in subroutine inrange. str for XS unknown.' endif enddo endif if(.not.allocated(Exptrange_Mhmin_forSMdecays)) then allocate( Exptrange_Mhmin_forSMdecays(size(colliders,dim=1))) allocate( Exptrange_Mhmax_forSMdecays(size(colliders,dim=1))) do i=1, size(colliders) if(i.eq.get_collider_element_number('LEP ')) then Exptrange_Mhmin_forSMdecays(i)=1.0D0 Exptrange_Mhmax_forSMdecays(i)=180.0D0 else if(i.eq.get_collider_element_number('TEV ')) then Exptrange_Mhmin_forSMdecays(i)=0.2D0 Exptrange_Mhmax_forSMdecays(i)=350.0D0 else if(i.eq.get_collider_element_number('LHC7 ')) then Exptrange_Mhmin_forSMdecays(i)=90.0D0 Exptrange_Mhmax_forSMdecays(i)=1000.0D0 else if(i.eq.get_collider_element_number('LHC8 ')) then Exptrange_Mhmin_forSMdecays(i)=90.0D0 Exptrange_Mhmax_forSMdecays(i)=1000.0D0 else if(i.eq.get_collider_element_number('LHC13')) then Exptrange_Mhmin_forSMdecays(i)=90.0D0 Exptrange_Mhmax_forSMdecays(i)=1000.0D0 else stop 'Error in subroutine inrange. str for decay unknown.' endif enddo endif if(str.eq.'SMBR')then if( (mass.gt.minval(Exptrange_Mhmin_forSMdecays)) & .and.(mass.lt.maxval(Exptrange_Mhmax_forSMdecays)) )then inrange=.True. else inrange=.False. endif else x=get_collider_element_number(str) ! write(*,*) 'debugging inrange:' ! write(*,*) x, mass, Exptrange_Mhmin_forSMXS(x), Exptrange_Mhmax_forSMXS(x) if( (mass.gt.Exptrange_Mhmin_forSMXS(x)) & .and.(mass.lt.Exptrange_Mhmax_forSMXS(x)) )then inrange=.True. else inrange=.False. endif endif end function inrange !********************************************************** function get_collider_element_number(collidername) ! this will return the position of the element with the value 'collidername' in the array 'colliders' !********************************************************** character(len=*),intent(in) :: collidername integer :: x,y integer :: get_collider_element_number y=0 ! print *, collidername do x=lbound(colliders,dim=1),ubound(colliders,dim=1) if(index(colliders(x),collidername).gt.0)then get_collider_element_number=x y=y+1 endif enddo if(y.ne.1)stop 'problem in function get_collider_element_number' end function get_collider_element_number !****************************************************************** function WhichColliderElement(expt,energy) ! this will return the position of the element corresponding to 'expt' in the array 'colliders' !****************************************************************** use usefulbits, only : small character(LEN=3),intent(in) :: expt integer :: WhichColliderElement double precision :: energy if( expt.eq.'LEP' )then WhichColliderElement=get_collider_element_number('LEP ') elseif( (expt.eq.'CDF').or.(expt.eq.' D0').or.(expt.eq.'TCB') )then WhichColliderElement=get_collider_element_number('TEV ') elseif( (expt.eq.'ATL').or.(expt.eq.'CMS') )then if(energy-7.0D0.le.small) then WhichColliderElement=get_collider_element_number('LHC7 ') else if(energy-8.0D0.le.small) then WhichColliderElement=get_collider_element_number('LHC8 ') else if(energy-13.0D0.le.small) then WhichColliderElement=get_collider_element_number('LHC13') else stop 'WhichColliderElement: Collider Energy not correctly specified.' endif else WhichColliderElement=0 endif end function WhichColliderElement !****************************************************************** function WhichColliderString(expt, energy) ! this will return the contents of the element corresponding to 'expt' in the array 'colliders' !****************************************************************** character(LEN=3),intent(in) :: expt character(LEN=5) :: WhichColliderString double precision :: energy ! write(*,*) 'WhichColliderString = ',colliders(WhichColliderElement(expt, energy)) WhichColliderString=colliders(WhichColliderElement(expt, energy)) end function WhichColliderString !****************************************************************** subroutine calcfact(proc,t,cfact,axis_i,axis_j,nc) !****************************************************************** !for table type1, calls calcfact_t1 !for table type2, calls calcfact_t2 !****************************************************************** use usefulbits, only : dataset,listprocesses !internal implicit none !--------------------------------------input type(dataset) :: t type(listprocesses) :: proc !-----------------------------------output double precision :: cfact,axis_j,axis_i integer :: nc !------------------------------------------- select case(proc%ttype) case(1) call calcfact_t1(proc%tlist,proc%findj,t,cfact,axis_i,nc) axis_j=axis_i case(2) call calcfact_t2(proc%tlist,proc%findj,proc%findi,t,cfact,axis_i,axis_j,nc) case default ! ### OS ### cfact = -1D0 return stop 'wrong input to function calcfact in module channels' end select end subroutine calcfact !****************************************************************** subroutine outputproc(proc,k,descrip,specific) !****************************************************************** !for table type1, calls outputproc_t1 !for table type2, calls outputproc_t2 !if neither table applies, writes message !k is where output goes !specific=1 if the specific process should be printed !e.g. ee->h1Z->bbZ !whereas specific==0 if the generic process should be printed !e.g. ee->hiZ->bbZ !****************************************************************** use usefulbits, only : listprocesses !input use likelihoods, only : outputproc_llh implicit none !--------------------------------------input integer,intent(in) :: k,specific integer :: i,j type(listprocesses),intent(in) :: proc character(LEN=200):: descrip !------------------------------------------- select case(specific) case(0) i=0 j=0 case(1) i=proc%findi j=proc%findj case default end select select case(proc%ttype) case(0) descrip='none of the processes apply' case(1) call outputproc_t1(proc%tlist,i,k,descrip) case(2) call outputproc_t2(proc%tlist,i,j,k,descrip) case(9) call outputproc_llh(proc,k,descrip) case default stop 'wrong input to subroutine outputproc in module channels' end select end subroutine outputproc !****************************************************************** subroutine check_against_bound(proc,fact,axis_i,axis_j,ratio,predobs) !****************************************************************** !for table type1, calls interpolate_tabletype1 !for table type2, calls interpolate_tabletype2 !****************************************************************** use usefulbits, only : dataset,listprocesses !internal use interpolate implicit none !--------------------------------------input integer :: predobs double precision :: fact,axis_i,axis_j type(listprocesses) :: proc !-------------------------------------output double precision :: ratio !-----------------------------------internal double precision :: Mi,Mj,interpol !------------------------------------------- interpol=-1.0D0 Mi=axis_i Mj=axis_j if(fact.gt.0.0D0)then select case(proc%ttype) case(1) call interpolate_tabletype1(Mi,S95_t1(proc%tlist),predobs,interpol) case(2) call interpolate_tabletype2(Mi,Mj,S95_t2(proc%tlist),predobs,interpol) case default ! ### OS ### ratio = -1d0 return write(*,*)'wrong input to subroutine check_against_bound in module channels' stop end select endif !--TESTING! ! if(predobs.eq.1) write(*,*) 'Interpolated value = ', interpol if(interpol.ge.0)then ratio=fact/interpol else ratio= -1.0D0 endif end subroutine check_against_bound !********************************************************** subroutine calcfact_t1(c,jj,t,cfact_t1,M_av,nc) !********************************************************** ! calculates fact for table type 1 ! Takes in to account how Standard Model-like parameter point is ! and whether there are any Higgs with slightly higher masses which ! can be combined with his result ! note: numerator and denominator are worked out separately !********************************************************** use usefulbits, only : dataset, np, div, vvsmall, vsmall use theory_BRfunctions use theory_XS_SM_functions implicit none !--------------------------------------input type(dataset) :: t integer :: c,jj !-----------------------------------output double precision :: cfact_t1,M_av integer :: nc !------------------------------------------- integer :: f,j,ii,iii double precision :: M_tot double precision :: BR_Hbb_SM_av,BR_HWW_SM_av,BR_Htautau_SM_av double precision :: tev_XS_HW_SM_av,tev_XS_HZ_SM_av double precision :: tev_XS_H_SM_av double precision :: tev_XS_Hb_SM_av double precision :: tev_XS_ttH_SM_av double precision :: lhc7_XS_H_SM_av double precision :: lhc7_XS_VBF_SM_av double precision :: BR_Zll,BR_Znunu,BR_Wlnu,BR_Ztautau double precision :: BR_Whad,BR_Zhad double precision :: fact_tmp double precision,allocatable :: mass(:),fact(:) integer,allocatable :: model_like(:) integer :: npart !number of particles !source: PDG (Yao et al. J Phys G 33 (2006)) BR_Zll=3.363D-2+3.366D-2 !BR_Zll = sum(l=e,mu), BR(Z ->l+ l-) BR_Znunu=20D-2 !BR_Znunu = BR(Z ->nu_l nu_l-bar) ('invisible') BR_Wlnu=10.75D-2+10.57D-2 !BR_Wlnu = sum(l=e,mu), !BR(W+ ->l+ nu_l) = BR(W- ->l- + nu_l-bar) BR_Whad=67.6D-2 BR_Zhad=69.91D-2 BR_Ztautau=3.370D-2 npart=np( S95_t1(c)%particle_x ) allocate(mass(npart),fact(npart),model_like(npart)) mass(:)=t%particle( S95_t1(c)%particle_x )%M(:) fact= 0.0D0 cfact_t1=0.0D0 model_like=0 !now calculate numerator of 'fact' do j=1,npart if( (abs(mass(jj)-mass(j)).le.S95_t1(c)%deltax) & & .and.( mass(jj).le.mass(j) ) )then select case(S95_t1(c)%id) !these can be compacted, but not doing it yet... doing it at the !same time as revamping the model_likeness test case(142) fact(j)=t%lep%XS_hjZ_ratio(j) *t%BR_hjbb(j) !notice that this is not absolute XS case(143) fact(j)=t%lep%XS_hjZ_ratio(j) *t%BR_hjtautau(j) !notice that this is not absolute XS case(300) fact(j)=t%lep%XS_hjZ_ratio(j) !notice that this is not absolute XS case(400,401,402,403) fact(j)=t%lep%XS_hjZ_ratio(j) *t%BR_hjinvisible(j) !notice that this is not absolute XS case(500) fact(j)=t%lep%XS_hjZ_ratio(j) *t%BR_hjgaga(j) !notice that this is not absolute XS case(600,601) fact(j)=t%lep%XS_hjZ_ratio(j) &!notice that this is not absolute XS & *(t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)) case(711,713) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(721,723,741,743) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(731,733) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(801,811,821) fact(j)=t%lep%XS_HpjHmj_ratio(j)*(t%BR_Hpjcs(j)+t%BR_Hpjcb(j))**2.0D0 !notice that this is not absolute XS case(802) fact(j)=t%lep%XS_HpjHmj_ratio(j)*(t%BR_Hpjcs(j)+t%BR_Hpjcb(j))*2.0D0*t%BR_Hpjtaunu(j) !notice that this is not absolute XS case(803,813) fact(j)=t%lep%XS_HpjHmj_ratio(j)*t%BR_Hpjtaunu(j)**2.0D0 !notice that this is not absolute XS case(8742,4493,9475,5482,5570,5876,1024,9889,3534,6089,10235,3047,10799,3564,6166,6296) fact(j)=t%tev%XS_hjZ_ratio(j) *t%tev%XS_HZ_SM(j) *t%BR_hjbb(j) case(8958,5489,5624,9236,3930,6039,3216,10433,6221,10600) fact(j)=t%tev%XS_hj_ratio(j)*t%tev%XS_H_SM(j) *t%BR_hjWW(j) case(3331) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) fact(j)=fact(j)*t%tev%XS_H_SM(j)*t%BR_HWW_SM(j)!to get the normalisation right case(5757) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(8957,5472,9219,9463,9596,5828,1970,3493,5972,3155,5613,9868,10068,6092,10217,10239,10796,0874,6220) fact(j)=t%tev%XS_hjW_ratio(j) *t%tev%XS_HW_SM(j) *t%BR_hjbb(j) case(5485,7307,5873) fact(j)=t%tev%XS_hjW_ratio(j) *t%tev%XS_HW_SM(j) *t%BR_hjWW(j) case(9071,2491,5740,5980,1014,3363,4555) fact(j)=t%tev%XS_hj_ratio(j) *t%tev%XS_H_SM(j) *t%BR_hjtautau(j) case(8961,0598) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(9284,5503,5726,10105) fact(j)=t%tev%XS_hjb_ratio(j) *t%tev%XS_Hb_SM(j) *t%BR_hjbb(j)/0.9D0/2.0D0 case(6083) fact(j)=t%tev%XS_hjb_ratio(j) *t%tev%XS_Hb_SM(j) *t%BR_hjtautau(j)/0.1D0/2.0D0 case(1514,5601,5737) fact(j)=( t%tev%XS_hjZ_ratio(j) * t%tev%XS_HZ_SM(j) & & + t%tev%XS_hjW_ratio(j) * t%tev%XS_HW_SM(j) & & + t%tev%XS_hj_ratio(j) * t%tev%XS_H_SM(j) & & + t%tev%XS_vbf_ratio(j) * t%tev%XS_vbf_SM(j) & & ) & & * t%BR_hjgaga(j) case(5858,6177,6295,1887,10065,10485,4960) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(7081,9166,9483,5586,9642,1266,0432,9891,5285,3935,6087,6170,10212,6223,6299,10583,10798,10596) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2012015) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(10010,10607,6436) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(9248,10133,10439) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(4800) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(5845) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6171) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(9290) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(5984,9714,6006,4481,6095,10432,6179,6302,10599) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(3556,1931) fact(j)=t%tev%XS_hjb_ratio(j) *t%tev%XS_Hb_c2_SM(j) *t%BR_hjbb(j) case(4782) fact(j)=t%tev%XS_hjb_ratio(j) *t%tev%XS_Hb_c1_SM(j) *t%BR_hjbb(j) case(9465,5871,9022,0710,9887,4162,10102,4468) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) !case(9023) ! call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(9674) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(9897,9999) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(0024,5985,0968,5974,4885) fact(j)=t%tev%XS_hjb_ratio(j) *t%tev%XS_Hb_c3_SM(j) *t%BR_hjtautau(j) case(5739,10574) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) fact(j)=fact(j)*t%tev%XS_ttH_SM(j)*t%BR_Hbb_SM(j)!to get the normalisation right case(2012135,12025) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(0611) fact(j)=t%tev%XS_hj_ratio(j)*t%tev%XS_H_SM(j) *t%BR_hjZga(j) case(1269,1270,2011094,13035,160311) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(1811) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) - case(1812,2011138,2011151,2760,2013090,2014050,14020,8353,7712,11002,11008) + case(1812,2011138,2011151,2760,2013090,2014050,14020,8353,7712,11002,11008,79152) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6008,9998) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6082,6182,6219,6276,10573) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6096,10606,10806,10884) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6183,3233) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6229) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6286,6301,6304,6305,6309) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6091,1268) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2011048,11004,11015,11013,11028,11006,11017,110271,110272,14161,14162,5064,2012017,2011150,2011131) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2011162,1415,2012092,20130131) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(059301) fact(j)=t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjZZ(j) case(059302) fact(j)=t%lhc8%XS_vbf_ratio(j)*t%lhc8%XS_vbf_SM(j)*t%BR_hjZZ(j) case(20130132) fact(j)=1000.d0*t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjZZ(j)*BR_Zll**2 case(20130133) fact(j)=1000.d0*(t%lhc8%XS_hjZ_ratio(j) * t%lhc8%XS_HZ_SM(j) & & + t%lhc8%XS_hjW_ratio(j) * t%lhc8%XS_HW_SM(j) & & + t%lhc8%XS_vbf_ratio(j) * t%lhc8%XS_vbf_SM(j)) & & * t%BR_hjZZ(j)*BR_Zll**2 case(11025,1997,12041,130021,130022,009361) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) ! write(*,*) "Analysis(130021) fact(",j,")=",fact(j) case(2011026,11005,11016,11026,3478,3357,2011148,2012016) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(110212) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2011025,2011085,2011161,5895,1414,2012091,2012168,1487,12001,12015,13001,11010,11030,11021) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(13006, 13075515,2013009,3051) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(11031,12044,13012) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(13011) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(11034,12039,13009,2012078,12006,12051) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2011005,3615,2012018,12046) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2748, 1408, 2012019) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(7214) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(10500) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(11003,11014,2577,11024,1489,12042,13003,13027) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2011020,2011021) fact(j)=t%lhc7%XS_hj_ratio(j)*t%lhc7%XS_H_SM(j) *t%BR_hjmumu(j) case(5429,2011052,2011111,2011134) fact(j)=t%lhc7%XS_hj_ratio(j)*t%lhc7%XS_H_SM(j) *t%BR_hjWW(j) case(2012012,2012158,2013030) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(10002,5003,2011132,2012094,110201,110292) fact(j)=t%lhc7%XS_hj_ratio(j)*t%lhc7%XS_H_SM(j) *t%BR_hjtautau(j) case(20140492) ! fact(j)=t%lhc8%XS_gg_hj_ratio(j)*t%lhc8%XS_gg_H_SM(j)*t%BR_hjtautau(j) fact(j)=t%lhc8%channelrates(j,6,4)*t%lhc8%XS_gg_H_SM(j) case(2014049) ! fact(j)=t%lhc8%XS_bb_hj_ratio(j)*t%lhc8%XS_bb_H_SM(j)*t%BR_hjtautau(j) fact(j)=t%lhc8%channelrates(j,7,4)*t%lhc8%XS_bb_H_SM(j) case(20160851,160371,20170501) ! fact(j)=t%lhc13%XS_gg_hj_ratio(j)*t%lhc13%XS_gg_H_SM(j)*t%BR_hjtautau(j) ! write(*,*) "debug: ",j,t%lhc13%channelrates(j,6,4) fact(j)=t%lhc13%channelrates(j,6,4)*t%lhc13%XS_gg_H_SM(j) case(20160852,160372,20170502) ! write(*,*) "debug: ",j,t%lhc13%channelrates(j,7,4) ! fact(j)=t%lhc13%XS_bb_hj_ratio(j)*t%lhc13%XS_bb_H_SM(j)*t%BR_hjtautau(j) fact(j)=t%lhc13%channelrates(j,7,4)*t%lhc13%XS_bb_H_SM(j) case(12050,13021) fact(j)=t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) *t%BR_hjtautau(j) case(11009,11020,2011133,2012014,2012160) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(110291,12043) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2013010,7663) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(11011,2011163,11022,11032,1488,12008,12045,2011157) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2011103,2012161,11012) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(13022) fact(j)=t%lhc8%XS_vbf_ratio(j)*div(t%BR_hjWW(j),t%BR_HWW_SM(j) ,0.0D0,1.0D0) case(13013,13441) fact(j)=t%lhc8%XS_vbf_ratio(j)*t%BR_hjinvisible(j) case(13018,13442) fact(j)=t%lhc8%XS_hjZ_ratio(j)*t%BR_hjinvisible(j) case(13443) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2013011,3244) ! Limit is on sigma(HZ)*BR(H->inv)*(BR(Z->ll)+BR(Z->tautau) ! Data given in fb - (multiply by 1000) fact(j)=1000.D0*t%lhc8%XS_hjZ_ratio(j)*t%lhc8%XS_HZ_SM(j) & & *t%BR_hjinvisible(j) !*(BR_Zll+BR_Ztautau) ! print *, 1000.D0*t%lhc8%XS_hjZ_ratio(j)*t%lhc8%XS_HZ_SM(j)*(BR_Zll+BR_Ztautau), fact(j) case(1508329,2015080) fact(j) = t%lhc8%XS_bb_hj_ratio(j)*t%lhc8%XS_bb_H_SM(j)*t%BR_hjbb(j) case(6583) ! Data given in fb - (multiply by 1000) ! (TS 2016/10/13: Added conservatively estimated signal efficiency factor of ~0.56) fact(j)=0.56D0*1000.0D0*( & t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) + & t%lhc8%XS_vbf_ratio(j)*t%lhc8%XS_vbf_SM(j) + & t%lhc8%XS_hjZ_ratio(j)*t%lhc8%XS_HZ_SM(j) + & t%lhc8%XS_hjW_ratio(j)*t%lhc8%XS_HW_SM(j) + & t%lhc8%XS_tthj_ratio(j)*t%lhc8%XS_ttH_SM(j) ) * t%BR_hjgaga(j) case(14011) do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+1000.0D0 * t%lhc8%XS_hj_ratio(j) * t%lhc8%XS_H_SM(j) & & * t%BR_hjhiZ(j,ii) * BR_Zll * t%BR_hjbb(ii) endif enddo case(17006) ! Data given in fb - (multiply by 1000). ! Limit on leptonic (e,mu,tau) decays of VV -> lnulnu ! BR(W->lnu) = 0.3257 ! BR(Z->ll) = 0.10099 ! BR(Z->nunu) = 0.2000 do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+ 1000.0D0 * t%lhc13%XS_gg_hj_ratio(j) * t%lhc13%XS_gg_H_SM(j) & & * t%BR_hkhjhi(j,ii,ii) * t%BR_hjbb(ii) * & & (t%BR_hjWW(ii) * 0.3257D0**2 + t%BR_hjZZ(ii) * 0.10099D0 * 0.2D0 *2.0D0) endif enddo case(1506534) do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+ t%lhc8%XS_gg_hj_ratio(ii) * t%lhc8%XS_gg_H_SM(ii) & & * t%BR_hkhjhi(ii,j,j) * t%BR_hjtautau(j)**2.0D0 endif enddo case(5051) do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.2.5D0) then fact(j)=fact(j)+ t%lhc8%XS_gg_hj_ratio(ii) * t%BR_hkhjhi(ii,j,j)*t%BR_hjgaga(j)**2.0D0 endif enddo case(17020321) do ii=1,npart fact_tmp = 0.0D0 if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.(25.0D0+t%particle(Hneut)%dMh(ii))) then call model_likeness(ii,S95_t1(c)%id,t,model_like(ii),fact_tmp) fact(j) = fact(j) + fact_tmp * t%BR_hkhjhi(ii,j,j) * t%BR_hjtautau(j)**2.0D0 endif enddo case(17020322) do ii=1,npart ! Multiply by 2.0 because limit is set on BR(H->hh->mumubb) fact_tmp = 0.0D0 if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.(25.0D0+t%particle(Hneut)%dMh(ii))) then call model_likeness(ii,S95_t1(c)%id,t,model_like(ii),fact_tmp) fact(j) = fact(j) + fact_tmp * t%BR_hkhjhi(ii,j,j) * 2.0D0 * t%BR_hjmumu(j) * t%BR_hjbb(j) endif enddo case(17020323) do ii=1,npart ! Multiply by 2.0 because limit is set on BR(H->hh->mumutautau) fact_tmp = 0.0D0 if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.(25.0D0+t%particle(Hneut)%dMh(ii))) then call model_likeness(ii,S95_t1(c)%id,t,model_like(ii),fact_tmp) fact(j) = fact(j) + fact_tmp * t%BR_hkhjhi(ii,j,j) * 2.0D0 * t%BR_hjmumu(j) * t%BR_hjtautau(j) endif enddo case(011812) ! Limit given in fb, multiply by 1000. do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+1000.0D0 * t%lhc8%XS_hj_ratio(j) * t%lhc8%XS_H_SM(j) & & * t%BR_hjhiZ(j,ii) * BR_Zll * t%BR_hjtautau(ii) endif enddo case(011811) ! Limit given in pb do ii=1,npart do iii=1,npart ! No symmetry factor (1/2) because limit is set on BR(H->hh->bbtautau) if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0.and.abs(t%particle(Hneut)%M(iii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+ t%lhc8%XS_hj_ratio(j) * t%lhc8%XS_H_SM(j) & & * t%BR_hkhjhi(j,ii,iii) * ( t%BR_hjtautau(ii) * t%BR_hjbb(iii) + & & t%BR_hjtautau(iii) * t%BR_hjbb(ii) ) endif enddo enddo case(16029) ! Limit given in pb do ii=1,npart do iii=1,npart ! No symmetry factor (1/2) because limit is set on BR(H->hh->bbtautau) if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0.and.abs(t%particle(Hneut)%M(iii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+ t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) & & * t%BR_hkhjhi(j,ii,iii) * ( t%BR_hjtautau(ii) * t%BR_hjbb(iii) + & & t%BR_hjtautau(iii) * t%BR_hjbb(ii) ) endif enddo enddo case(17002) ! Limit given in fb do ii=1,npart do iii=1,npart ! No symmetry factor (1/2) because limit is set on BR(H->hh->bbtautau) if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0.and.abs(t%particle(Hneut)%M(iii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+ 1000.0D0 * t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) & & * t%BR_hkhjhi(j,ii,iii) * ( t%BR_hjtautau(ii) * t%BR_hjbb(iii) + & & t%BR_hjtautau(iii) * t%BR_hjbb(ii) ) endif enddo enddo case(2016071) ! Limit given in pb do ii=1,npart do iii=1,npart ! No symmetry factor (1/2) because limit is set on BR(H->hh->WWgaga) if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.2.5D0.and.abs(t%particle(Hneut)%M(iii)-125.0D0).lt.2.5D0) then fact(j)=fact(j)+ t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) & & * t%BR_hkhjhi(j,ii,iii) * ( t%BR_hjWW(ii) * t%BR_hjgaga(iii) + & & t%BR_hjWW(iii) * t%BR_hjgaga(ii) ) endif enddo enddo case(16002,2016049) ! Limit given in fb, multiply by 1000. do ii=1,npart do iii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0.and.abs(t%particle(Hneut)%M(iii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+ 1000.0D0 * t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) & & * t%BR_hkhjhi(j,ii,iii) * t%BR_hjbb(iii) * t%BR_hjbb(ii) endif enddo enddo case(14013) ! Limit given in fb, multiply by 1000. do ii=1,npart do iii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0.and.abs(t%particle(Hneut)%M(iii)-125.0D0).lt.10.0D0) then fact(j)=fact(j)+ 1000.0D0 * t%lhc8%XS_hj_ratio(j) * t%lhc8%XS_H_SM(j) & & * t%BR_hkhjhi(j,ii,iii) * t%BR_hjbb(iii) * t%BR_hjbb(ii) endif enddo enddo case(044781) ! Limit given in pb (Z->ll unfolded) do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j) + t%lhc8%XS_gg_hj_ratio(j) * t%lhc8%XS_gg_H_SM(j) & & * t%BR_hjhiZ(j,ii) * t%BR_hjtautau(ii) endif enddo case(044782) ! Limit given in pb (Z->ll unfolded) do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j) + t%lhc8%XS_gg_hj_ratio(j) * t%lhc8%XS_gg_H_SM(j) & & * t%BR_hjhiZ(j,ii) * t%BR_hjbb(ii) endif enddo case(20160151) ! Limit given in pb (Z->ll unfolded) do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j) + t%lhc13%XS_gg_hj_ratio(j) * t%lhc13%XS_gg_H_SM(j) & & * t%BR_hjhiZ(j,ii) * t%BR_hjbb(ii) endif enddo case(20160152) ! Limit given in pb (Z->ll unfolded) do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j) + t%lhc13%XS_bb_hj_ratio(j) * t%lhc13%XS_bb_H_SM(j) & & * t%BR_hjhiZ(j,ii) * t%BR_hjbb(ii) endif enddo case(14006,14037) ! Data given in pb fact(j)= ( & t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) + & t%lhc8%XS_vbf_ratio(j)*t%lhc8%XS_vbf_SM(j) + & t%lhc8%XS_hjZ_ratio(j)*t%lhc8%XS_HZ_SM(j) + & t%lhc8%XS_hjW_ratio(j)*t%lhc8%XS_HW_SM(j) + & t%lhc8%XS_tthj_ratio(j)*t%lhc8%XS_ttH_SM(j) ) * t%BR_hjgaga(j) case(14031) fact(j)=1000.0D0* t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) * & t%BR_hjZga(j)*BR_Zll case(20160821,20160822,063861) fact(j)=t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j)*t%BR_hjZZ(j) case(20160823) fact(j)=t%lhc13%XS_vbf_ratio(j)*t%lhc13%XS_vbf_SM(j)*t%BR_hjZZ(j) case(20160792) ! Data given in fb fact(j)=1000.0D0*t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j)*t%BR_hjZZ(j)*BR_Zll**2 case(20160793) ! Data given in fb fact(j)=1000.0D0*t%lhc13%XS_vbf_ratio(j)*t%lhc13%XS_vbf_SM(j)*t%BR_hjZZ(j)*BR_Zll**2 case(20160741,2016062) fact(j)=t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j)*t%BR_hjWW(j) case(20160742) fact(j)=t%lhc13%XS_vbf_ratio(j)*t%lhc13%XS_vbf_SM(j)*t%BR_hjWW(j) case(2011112) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(2011135) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(6224,6225,6226) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(04670,046701,046702) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) case(0038911,0038912,0038913,0038914) call model_likeness(j,S95_t1(c)%id,t,model_like(j),fact(j)) - case(160312,2016088) -! Data given in pb - fact(j)= t%lhc13%XS_Hpjtb(j) * t%BR_Hpjtaunu(j) + case(160312,2016088,79151) +! Data given in pb (factor 2 because both signs of the charged Higgs are considered in the limit) + fact(j)= 2.0D0 * t%lhc13%XS_Hpjtb(j) * t%BR_Hpjtaunu(j) case(1504233) -! Data given in fb - fact(j)= 1000.0D0*t%lhc8%XS_vbf_Hpj(j) * t%BR_HpjWZ(j) +! Data given in fb (factor 2 because both signs of the charged Higgs are considered in the limit) + fact(j)= 2.0D0 * 1000.0D0*t%lhc8%XS_vbf_Hpj(j) * t%BR_HpjWZ(j) case(2016089) -! Data given in pb - fact(j)= t%lhc13%XS_Hpjtb(j) * t%BR_Hpjtb(j) +! Data given in pb (factor 2 because both signs of the charged Higgs are considered in the limit) + fact(j)= 2.0D0 * t%lhc13%XS_Hpjtb(j) * t%BR_Hpjtb(j) ! Daniel's attempts case(2016025) fact(j) = t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) * t%BR_hjbb(j) case(2016044) fact(j) = 1000.0D0*t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) * t%BR_hjZga(j) case(201608391) do ii=1,npart if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0) then fact(j)=fact(j) + t%lhc13%XS_hjW_ratio(ii) *t%lhc13%XS_HW_SM(ii) * t%BR_hkhjhi(ii,j,j) & & * t%BR_hjbb(j) * t%BR_hjbb(j) endif enddo case(16030) fact(j) = t%BR_tHpjb(j) * t%BR_Hpjcs(j) case(2016004) ! Limit given in pb do ii=1,npart do iii=1,npart ! Multiply fact by symmetry factor, 1/2. if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.2.5D0.and.abs(t%particle(Hneut)%M(iii)-125.0D0).lt.2.5D0) then fact(j)=fact(j)+ 0.5D0 * t%lhc13%XS_gg_hj_ratio(j)*t%lhc13%XS_gg_H_SM(j) & & * t%BR_hkhjhi(j,ii,iii) * & & ( t%BR_hjbb(ii)/t%BR_Hbb_SM(ii) * t%BR_hjgaga(iii)/t%BR_Hgaga_SM(iii) + & & t%BR_hjbb(iii)/t%BR_Hbb_SM(iii) * t%BR_hjgaga(ii)/t%BR_Hgaga_SM(ii) ) endif enddo enddo ! case(2016004) ! do ii=1,npart ! if(abs(t%particle(Hneut)%M(ii)-125.0D0).lt.10.0D0.and.t%BR_Hbb_SM(ii).gt.0D0.and.t%BR_Hgaga_SM(ii).gt.0D0) then ! fact(j) + t%lhc13%XS_gg_hj_ratio(j)*t%lhc13%XS_gg_H_SM(j) * t%BR_hkhjhi(j,ii,ii) & ! & * t%BR_hjbb(ii)/t%BR_Hbb_SM(ii) * t%BR_hjgaga(ii)/t%BR_Hgaga_SM(ii) ! endif ! enddo case(1604833) if(abs(t%BR_hjWW(j)/t%BR_hjZZ(j) / (t%BR_HWW_SM(j)/t%BR_HZZ_SM(j))-1.0D0).lt.0.05) then fact(j) = t%lhc13%XS_gg_hj_ratio(j)*t%lhc13%XS_gg_H_SM(j) * (t%BR_hjWW(j) + t%BR_hjZZ(j)) else fact(j) = 0.0D0 endif case(16034) fact(j) = (t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) + & & t%lhc13%XS_vbf_ratio(j) * t%lhc13%XS_vbf_SM(j) ) * t%BR_hjZZ(j) case(2016056) fact(j) = 1000.0D0*t%lhc13%XS_gg_hj_ratio(j) * t%lhc13%XS_gg_H_SM(j) * t%BR_hjZZ(j) case(15009) fact(j)= 1000.*t%lhc8%XS_bb_hj_ratio(j)*t%lhc8%XS_bb_H_SM(j)*t%BR_hjmumu(j) case(20160551) fact(j) = 1000.0D0*t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) * t%BR_hjZZ(j) case(20160552) fact(j) = 1000.0D0*t%lhc13%XS_hj_ratio(j) * t%lhc13%XS_H_SM(j) * t%BR_hjWW(j) case default stop 'wrong input to function calcfact_t1 in module S95tables' end select endif enddo if(fact(jj).le.vvsmall)then!A !Higgs jj doesn't contribute - wait until another call of this subroutine before !looking at nearby masses M_av = mass(jj) nc=0 cfact_t1=0.0D0 else!A !find M_av (only using higgs which have non-zero fact): f=0 M_tot=0.0D0 do j=1,npart if( fact(j).gt.vvsmall )then f=f+1 M_tot=M_tot+mass(j) endif enddo nc=f !f will always be > 0 because we've already made sure that fact(jj)>0.0D0 M_av = M_tot/dble(nc) if((WhichColliderString(S95_t1(c)%expt,S95_t1(c)%energy).eq.'LEP'))then!B cfact_t1=sum(fact) elseif(S95_t1(c)%particle_x .ne. Hneut)then!B cfact_t1=sum(fact) else!B ! HB-5 new ---> if(cfact_t1.gt.vvsmall.and.M_av.gt.S95_t1(c)%xmax) then M_av = S95_t1(c)%xmax write(*,*) "WARNING: Evaluating limit of ",trim(adjustl(S95_t1(c)%label))," at upper mass range." else if(cfact_t1.gt.vvsmall.and.M_av.lt.S95_t1(c)%xmin) then M_av = S95_t1(c)%xmin write(*,*) "WARNING: Evaluating limit of ",trim(adjustl(S95_t1(c)%label))," at lower mass range." endif ! <--- if(f.eq.1)then !have already calculated these in theo_manip to save time BR_Hbb_SM_av = t%BR_Hbb_SM(jj) BR_HWW_SM_av = t%BR_HWW_SM(jj) BR_Htautau_SM_av = t%BR_Htautau_SM(jj) tev_XS_HW_SM_av = t%tev%XS_HW_SM(jj) tev_XS_HZ_SM_av = t%tev%XS_HZ_SM(jj) tev_XS_H_SM_av = t%tev%XS_H_SM(jj) tev_XS_Hb_SM_av = t%tev%XS_Hb_SM(jj) tev_XS_ttH_SM_av = t%tev%XS_ttH_SM(jj) lhc7_XS_H_SM_av = t%lhc7%XS_H_SM(jj) lhc7_XS_VBF_SM_av= t%lhc7%XS_vbf_SM(jj) else BR_Hbb_SM_av = BRSM_Hbb(M_av) BR_HWW_SM_av = BRSM_HWW(M_av) BR_Htautau_SM_av = BRSM_Htautau(M_av) tev_XS_HW_SM_av = XS_tev_HW_SM(M_av) tev_XS_HZ_SM_av = XS_tev_HZ_SM(M_av) tev_XS_H_SM_av = XS_tev_gg_H_SM(M_av)+XS_tev_bb_H_SM(M_av) tev_XS_Hb_SM_av = XS_tev_bg_Hb_SM(M_av) tev_XS_ttH_SM_av = XS_tev_ttH_SM(M_av) lhc7_XS_H_SM_av = XS_lhc7_gg_H_SM(M_av)+XS_lhc7_bb_H_SM(M_av) lhc7_XS_VBF_SM_av= XS_lhc7_vbf_SM(M_av) endif ! now include denominator of 'fact' select case(S95_t1(c)%id) case(8742,5482,5570,4493,9475,5876,1024,9889,3534,6089,10235,3047,10799,3564,6166,6296) do j=1,npart fact(j)= div( fact(j) , tev_XS_HZ_SM_av * BR_Hbb_SM_av ,0.0D0,0.0D0) enddo case(8958,5489,5624,9236,3930) do j=1,npart fact(j)= div( fact(j) , tev_XS_H_SM_av * BR_HWW_SM_av ,0.0D0,0.0D0) enddo case(8957,5472,9219,9463,9596,5828,1970,3493,5972,3155,5613,9868,10068,6092,10217,10239,10796,0874,6220) do j=1,npart fact(j)= div( fact(j) , tev_XS_HW_SM_av * BR_Hbb_SM_av ,0.0D0,0.0D0) enddo case(5503,9284,5726,10105) do j=1,npart fact(j)= div( fact(j) , tev_XS_Hb_SM_av ,0.0D0,0.0D0) enddo case(6083) do j=1,npart fact(j)= div( fact(j) , tev_XS_Hb_SM_av ,0.0D0,0.0D0) enddo case(7307,5873) do j=1,npart fact(j)= div( fact(j) , tev_XS_HW_SM_av * BR_HWW_SM_av ,0.0D0,0.0D0) enddo case(8961,0598,10010,9290,9674,9897,9999,10607,6436) case(7081,9166,9483,5586,9642,1266,0432,9891,5285,3935,6087,6170,10212,6223,6299,10583,10798,10596) case(2012015) case(9248,5845,4800,5858,6177,6295,1887,10065,10485,10133,10439,4960) case(9465,5871,9022,9023,0710,9887) case(6171) case(6183,3233) case(6229) case(6304) case(5984,9714,4162,10102,6006,4481,4468,5757,6095,10432,6179,6302,10599) case(5739,10574) do j=1,npart fact(j)= div( fact(j) , tev_XS_ttH_SM_av * BR_Hbb_SM_av ,0.0D0,0.0D0) enddo case(2012135,12025) case(6008,9998) case(6082,6182,6219,6276,10573) case(6096,10606,10806,10884) case(6091,1268) case(5485,9071,2491,5601,1514,3556,5740,4555,0024,5980,1014,5985, & & 0611,3363,6039,3216,0968,5974,1931,4885,6221) case(3331) case(6286,6301,6305,6309) case(10600) case(10433) do j=1,npart fact(j)=div(fact(j) , tev_XS_H_SM_av * BR_HWW_SM_av ,0.0D0,0.0D0) enddo case(2011048,11004,11015,11013,11028,11006,11017,110271,110272,14161,14162,5064,2012017,2011150,2011131) case(2011162,1415,2012092,20130131) case(11025,1997,12041,130021,130022,009361,16034) case(2011026,11005,11016,11026,3478,3357,2011148,2012016) case(110212) case(2011025,2011085,2011161,5895,1414,2012091,2012168,1487,12001,12015,13001,11010,11030,11021) case(13006, 13075515,2013009,3051) case(11031,12044,13012) case(13011) case(11034,12039,13009,2012078,12006,12051) case(2011005,3615,2012018,12046) case(2748, 1408, 2012019) case(7214) case(4782) case(5429,2011052,2011111,2011134) do j=1,npart fact(j)= div( fact(j) , lhc7_XS_H_SM_av * BR_HWW_SM_av ,0.0D0,0.0D0) enddo case(2012012,2012158,2013030) case(10002,5003,2011132,2012094,2014049,20140492,110201,110292,12050,13021) case(059301,059302) case(20130132,20130133) case(11009,11020,2011133,2012014,2012160) case(110291,12043) case(2013010,7663) case(11002,11008) case(11003,11014,2577,11024,1489,12042,13003,13027) case(2011020,2011021) case(10500) case(11011,2011163,11022,11032,1488,12008,12045,2011157) case(2011103,2012161,11012) case(13022) case(13013) case(13441,13442,13443) case(13018) case(2013011,3244) case(2011112) case(6583,14006,14037,14031) case(2011135) case(1508329,2015080) case(17020321,17020322,17020323) case(6224,6225,6226) case(04670,046701,046702) case(0038911,0038912,0038913,0038914) - case(160312,2016088,2016089,14011,011811,16029,17002,14013,2016071,16002,011812,20160851,20160852,20170501,20170502) + case(160312,2016088,2016089,14011,011811,16029,17002,14013,2016071,16002,011812,20160851,20160852,20170501,20170502,79151) case(1504233,1506534,5051) case(160371,160372,044781,044782,20160151,20160152,17006) case(20160741,20160742,2016062,20160821,20160822,20160823,20160792,20160793,2016049,063861) case(2016025,2016044,201608391,2016004,1604833,2016056,20160551,20160552,15009) case(16030) case default stop 'error calculating denom. in calcfact_t1' end select cfact_t1=sum(fact) endif!B endif!A deallocate(mass) deallocate(fact) deallocate(model_like) end subroutine calcfact_t1 !********************************************************** subroutine calcfact_t2(c,jj,ii,t,cfact_t2,axis_i,axis_j,nc) !********************************************************** !calculates fact for table type 2 !********************************************************** use usefulbits, only : dataset,np,vsmall,not_a_particle,extrapolatewidth implicit none !--------------------------------------input type(dataset) :: t integer :: c,jj,ii !-----------------------------------output double precision :: cfact_t2,axis_i,axis_j integer :: nc !------------------------------------------- integer :: f,i,j,npart2,npart1 double precision :: fact,eps2,crosssection,Mi_av,Mj_av,masstot,BR_Zll,acceptance double precision,allocatable :: massj(:),massi(:) BR_Zll=3.363D-2+3.366D-2 !BR_Zll = sum(l=e,mu), BR(Z ->l+ l-) eps2=0.02D0 npart2=np( S95_t2(c)%particle_x2 ) allocate(massj(npart2)) massj(:)=t%particle( S95_t2(c)%particle_x2 )%M(:) if(S95_t2(c)%particle_x1.eq.not_a_particle)then npart1=1 allocate(massi(npart1)) massi(:)=-1.0D0 else npart1=np( S95_t2(c)%particle_x1 ) allocate(massi(npart1)) massi(:)=t%particle( S95_t2(c)%particle_x1 )%M(:) endif Mj_av=massj(jj) Mi_av=massi(ii) fact= 0.0D0 cfact_t2=0.0D0 masstot=0.0D0 j=jj i=ii f=1 select case(S95_t2(c)%id) case(150) fact=test_appl(t%lep%XS_hjZ_ratio(j)*t%BR_hjhihi(j,i)*t%BR_hjbb(i)**2.0D0)!table 15 hep-ex/0602042 XS ratio case(160) fact=test_appl(t%lep%XS_hjZ_ratio(j)*t%BR_hjhihi(j,i)*t%BR_hjtautau(i)**2.0D0)!table 16 hep-ex/0602042 XS ratio case(180) fact=test_appl(t%lep%XS_hjhi_ratio(j,i)*t%BR_hjbb(j)*t%BR_hjbb(i))!table 18 hep-ex/0602042 XS ratio case(190) fact=test_appl(t%lep%XS_hjhi_ratio(j,i)*t%BR_hjtautau(j)*t%BR_hjtautau(i))!table 19 hep-ex/0602042 XS ratio case(200) fact=test_appl(t%lep%XS_hjhi_ratio(j,i)*t%BR_hjhihi(j,i)*t%BR_hjbb(i)**3.0D0)!table 20 hep-ex/0602042 XS ratio case(210) fact=test_appl(t%lep%XS_hjhi_ratio(j,i)*t%BR_hjhihi(j,i)*t%BR_hjtautau(i)**3.0D0)!table 21 hep-ex/0602042 XS ratio case(220) fact=test_appl(t%lep%XS_hjZ_ratio(j)*t%BR_hjhihi(j,i)*t%BR_hjbb(i)*t%BR_hjtautau(i))!table 22 hep-ex/0602042 XS ratio case(230) fact=test_appl(t%lep%XS_hjhi_ratio(j,i)*t%BR_hjbb(j)*t%BR_hjtautau(i))!table 23 hep-ex/0602042 XS ratio case(240) fact=test_appl(t%lep%XS_hjhi_ratio(j,i)*t%BR_hjtautau(j)*t%BR_hjbb(i))!table 24 hep-ex/0602042 XS ratio case(905) fact=test_appl(t%lep%XS_CpjCmj(j)*t%BR_CjqqNi(j,i)**2.0D0)!fig 5 hep-ex/0401026 absolute XS in fb case(906) fact=test_appl(t%lep%XS_CpjCmj(j)*t%BR_CjqqNi(j,i)*t%BR_CjlnuNi(j,i))!fig 6 hep-ex/0401026 absolute XS in fb case(907) fact=test_appl( t%lep%XS_CpjCmj(j)*t%BR_CjlnuNi(j,i)**2.0D0)!fig 7 hep-ex/0401026 absolute XS in fb case(908) fact=test_appl(t%lep%XS_CpjCmj(j)) !fig 8 hep-ex/0401026 absolute XS in fb case(909) fact=test_appl( t%lep%XS_NjNi(j,i)*t%BR_NjqqNi(j,i)) !fig 9 hep-ex/0401026 absolute XS in fb case(910) fact=test_appl(t%lep%XS_NjNi(j,i))!fig 10 hep-ex/0401026 absolute XS in fb case(6065) fact=test_appl(t%lep%XS_HpjHmj_ratio(j)*(t%BR_Hpjcs(j)+t%BR_Hpjcb(j)+t%BR_Hpjtaunu(j))) case(02671) fact=test_appl(t%lep%XS_HpjHmj_ratio(j)*(t%BR_HpjhiW(j,i)*t%BR_hjbb(i))**2.0D0) case(02672) fact=test_appl( 4.0D0 * t%lep%XS_HpjHmj_ratio(j)*t%BR_HpjhiW(j,i) * & & t%BR_Hpjtaunu(j)*t%BR_hjbb(i)**2.0D0) !Multiplied by 4 (see LEP paper) case(3381) fact=test_appl(t%tev%XS_hj_ratio(j) * t%tev%XS_H_SM(j) * t%BR_hjhihi(j,i) * & & t%BR_hjmumu(i)**2.0D0 )! arXiv:0905.3381 table I, absolute XS in fb case(3382) fact=test_appl(t%tev%XS_hj_ratio(j) * t%tev%XS_H_SM(j) * t%BR_hjhihi(j,i) * & & 2.0D0 * t%BR_hjtautau(i) * t%BR_hjmumu(i) )! arXiv:0905.3381 table II (also using fig 3b), absolute XS in fb case(5053) fact=test_appl(t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) * t%BR_hjhihi(j,i)) case(13032) ! Limit given in fb, multiply by 1000. fact=test_appl(1000.0D0*t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjhihi(j,i) ) ! case(011811) ! ! Limit given in pb ! fact=test_appl(t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjhihi(j,i) * & ! & t%BR_hjtautau(i) * t%BR_hjbb(i) ) ! case(011812) ! ! Limit given in fb, multiply by 1000. ! fact=test_appl(1000.0D0*t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjhiZ(j,i) * & ! & t%BR_hjtautau(i) * BR_Zll ) ! case(044781) ! ! Limit given in pb (Z->ll unfolded) ! fact=test_appl(t%lhc8%XS_gg_hj_ratio(j)*t%lhc8%XS_gg_H_SM(j)*t%BR_hjhiZ(j,i) * & ! & t%BR_hjtautau(i)) ! case(044782) ! ! Limit given in pb (Z->ll unfolded) ! fact=test_appl(t%lhc8%XS_gg_hj_ratio(j)*t%lhc8%XS_gg_H_SM(j)*t%BR_hjhiZ(j,i) * & ! & t%BR_hjbb(i) ) ! case(20160151) ! ! Limit given in pb (Z->ll unfolded) ! fact=test_appl(t%lhc13%XS_gg_hj_ratio(j)*t%lhc13%XS_gg_H_SM(j)*t%BR_hjhiZ(j,i) * & ! & t%BR_hjbb(i) ) ! case(20160152) ! ! Limit given in pb (Z->ll unfolded) ! fact=test_appl(t%lhc13%XS_bb_hj_ratio(j)*t%lhc13%XS_bb_H_SM(j)*t%BR_hjhiZ(j,i) * & ! & t%BR_hjbb(i) ) case(06896) ! Limit given in fb, multiply by 1000. fact=test_appl(1000.0D0*t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjhihi(j,i) * & & t%BR_hjgaga(i) * t%BR_hjbb(i) ) case(16032) ! Limit given in fb, multiply by 1000. fact=test_appl(1000.0D0*t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j)*t%BR_hjhihi(j,i) * & & t%BR_hjgaga(i) * t%BR_hjbb(i) ) ! case(14013) ! ! Limit given in fb, multiply by 1000. ! fact=test_appl(1000.0D0*t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjhihi(j,i) * & ! & t%BR_hjbb(i) * t%BR_hjbb(i) ) case(16002) ! Limit given in fb, multiply by 1000. fact=test_appl(1000.0D0*t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j)*t%BR_hjhihi(j,i) * & & t%BR_hjbb(i) * t%BR_hjbb(i) ) case(150011) ! Limit given in fb, multiply by 1000. fact=test_appl(1000.0D0*t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjhiZ(j,i) * & & t%BR_hjtautau(i) * BR_Zll ) case(150012) ! Limit given in fb, multiply by 1000. fact=test_appl(1000.0D0*t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j)*t%BR_hjhiZ(j,i) * & & t%BR_hjbb(i) * BR_Zll ) case(16010) ! Limit given in fb, multiply by 1000. fact=test_appl(1000.0D0*t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j)*t%BR_hjhiZ(j,i) * & & t%BR_hjbb(i) * BR_Zll ) case(14022) fact=test_appl( t%BR_hjhihi(j,i) * t%BR_hjtautau(i) * t%BR_hjtautau(i) ) case(150600424) fact=test_appl(1000.0D0*t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) * & & t%BR_hkhjhi(j,i,i)*t%BR_hjmumu(i)**2.0D0 ) case(16035) fact=test_appl(1000.0D0*t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j) * & & t%BR_hkhjhi(j,i,i)*t%BR_hjmumu(i)**2.0D0 ) case(6227) f=0 do j=1,npart2 if( (abs(massj(jj)-massj(j)).le.S95_t2(c)%deltax) & & .and.( massj(jj).le.massj(j) ) )then crosssection=test_appl( t%tev%XS_hjb_ratio(j)*t%tev%XS_Hb_c4_SM(j) ) if(crosssection.gt.vsmall)then f=f+1 fact=fact+crosssection masstot=massj(j)+masstot endif endif enddo if(f.ne.0)then Mj_av=masstot/dble(f) endif case(02301) fact = ( & t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) + & t%lhc8%XS_vbf_ratio(j)*t%lhc8%XS_vbf_SM(j) + & t%lhc8%XS_hjZ_ratio(j)*t%lhc8%XS_HZ_SM(j) + & t%lhc8%XS_hjW_ratio(j)*t%lhc8%XS_HW_SM(j) + & t%lhc8%XS_tthj_ratio(j)*t%lhc8%XS_ttH_SM(j) ) * t%BR_hjgaga(j) case(2016059) ! Data given in fb - (multiply by 1000) ! ( Acceptance factor linearly increasing between 200 and 700 GeV, then constant) acceptance = 0.61D0 if(Mj_av.le.700.0D0) then acceptance = ((Mj_av-200.0D0)*0.61D0+(700.0D0-Mj_av)*0.54D0)/500.0D0 endif fact =acceptance*1000.0D0*( & t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j) + & t%lhc13%XS_vbf_ratio(j)*t%lhc13%XS_vbf_SM(j) + & t%lhc13%XS_hjZ_ratio(j)*t%lhc13%XS_HZ_SM(j) + & t%lhc13%XS_hjW_ratio(j)*t%lhc13%XS_HW_SM(j) + & t%lhc13%XS_tthj_ratio(j)*t%lhc13%XS_ttH_SM(j) ) * t%BR_hjgaga(j) case(003892) fact = ( & t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) + & t%lhc8%XS_vbf_ratio(j)*t%lhc8%XS_vbf_SM(j)) * t%BR_hjWW(j) case(20160791,160331) fact = 1000.0D0 * t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j) * t%BR_hjZZ(j) * BR_Zll**2.0D0 case(160332) fact = 1000.0D0 * t%lhc13%XS_vbf_ratio(j)*t%lhc13%XS_VBF_SM(j) * t%BR_hjZZ(j) * BR_Zll**2.0D0 case(01123) ! Limit given in pb fact = t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j) * t%BR_hjWW(j) case(170121,06386) ! Limit given in pb fact = t%lhc13%XS_hj_ratio(j)*t%lhc13%XS_H_SM(j) * t%BR_hjZZ(j) case default stop 'wrong input to function calcfact_t2 in module S95tables' end select if(S95_t2(c)%particle_x1.eq.not_a_particle)then select case(S95_t2(c)%id) case(6227) axis_i=t%BR_hjtautau(jj) case(02301,2016059,20160791,06386) axis_i=t%particle( S95_t2(c)%particle_x2 )%GammaTot(j) / & & t%particle( S95_t2(c)%particle_x2 )%M(j) case(01123) ! in percent axis_i=t%particle( S95_t2(c)%particle_x2 )%GammaTot(j) / & & t%particle( S95_t2(c)%particle_x2 )%M(j) * 100.0D0 case(003892) axis_i=t%particle( S95_t2(c)%particle_x2 )%GammaTot(j) / & & t%GammaTot_SM(j) case(160331,160332,170121) axis_i=t%particle( S95_t2(c)%particle_x2 )%GammaTot(j) case(6065) axis_i=t%BR_Hpjtaunu(j) case default stop 'Problem in subroutine calcfact_t2 (y1)' end select select case(S95_t2(c)%id) case(02301,2016059,20160791,06386,01123,003892,160331,160332,170121) if(extrapolatewidth) then if(axis_i.gt.S95_t2(c)%xmax1) then axis_i = S95_t2(c)%xmax1 endif endif case default continue end select else axis_i=Mi_av endif if(S95_t2(c)%particle_x2.eq.not_a_particle)then select case(S95_t2(c)%id) case default stop 'Problem in subroutine calcfact_t2 (y2)' end select else axis_j=Mj_av endif cfact_t2=cfact_t2+fact nc=f deallocate(massi) deallocate(massj) contains !******************************************************** function test_appl(x) !******************************************************** use usefulbits, only : div implicit none !--------------------------------------input double precision :: x !-----------------------------------function double precision :: test_appl !------------------------------------------- double precision, allocatable :: XS_ratio(:), ds(:) double precision :: s integer :: k select case(S95_t2(c)%id) case(150,160,180,190,200,210,220,230,240,3381,3382,13032,06896,14013,& & 16002,150011,150012,16032,16029,011811,011812,044781,044782,20160151,& & 20160152,16010,17002,150600424,16035) if(S95_t2(c)%needs_M2_gt_2M1.and.(massj(j).lt.2.0D0*massi(i)))then test_appl=0.0D0 elseif(massj(j).lt.massi(i))then test_appl=0.0D0 else test_appl=x endif case(02671,02672) if(massj(j).lt.massi(i)+3.0D0) then test_appl=0.0D0 else test_appl=x endif case(6065) if( (t%BR_Hpjtaunu(j) + t%BR_Hpjcs(j) + t%BR_Hpjcb(j)).gt.1.0D0 ) then test_appl=0.0D0 write(*,*) 'WARNING: Sum of charged Higgs branching ratios (cs,cb,taunu) > 1.' else test_appl=x endif case(14022) ! SM likeness test of the heavier Higgs boson allocate(XS_ratio(4),ds(4)) XS_ratio=(/ div( t%lhc8%XS_hj_ratio(j),t%lhc8%XS_H_SM(j),0.0D0,1.0D9), & div( t%lhc8%XS_vbf_ratio(j),t%lhc8%XS_vbf_SM(j),0.0D0,1.0D9), & div( t%lhc8%XS_hjW_ratio(j),t%lhc8%XS_HW_SM(j),0.0D0,1.0D9), & div( t%lhc8%XS_hjZ_ratio(j),t%lhc8%XS_HZ_SM(j),0.0D0,1.0D9) /) s=sum(XS_ratio)/4. do k=1,4 ds(k)= div((XS_ratio(k)-s), s, 0.0D0, 1.0D9) enddo if(S95_t2(c)%needs_M2_gt_2M1.and.(massj(j).lt.2.0D0*massi(i)))then test_appl=0.0D0 elseif(massj(j).lt.massi(i))then test_appl=0.0D0 elseif(maxval(ds).gt.0.1D0) then ! SM likeness test of the heavier Higgs boson test_appl=0.0D0 else test_appl=s*x endif case(5053) if(S95_t2(c)%needs_M2_gt_2M1.and.(massj(j).lt.2.0D0*massi(i)))then test_appl=0.0D0 !----Check for sufficiently SM-like BRs to gaga and bb of lighter Higgs elseif(abs(t%BR_hjgaga(i)-t%BR_Hgaga_SM(i)).gt.0.05*t%BR_Hgaga_SM(i)) then test_appl=0.0D0 elseif(abs(t%BR_hjbb(i)-t%BR_Hbb_SM(i)).gt.0.05*t%BR_Hbb_SM(i)) then test_appl=0.0D0 else test_appl=x endif case(905,906,907,909) if(abs(minval(massi)-massi(i)).gt.vsmall)then !checking that lightest neutralino in process is lightest neutralino in model test_appl=0.0D0 elseif(massj(j).lt.massi(i))then test_appl=0.0D0 else test_appl=x endif case(908) if( abs(t%BR_CjWNi(j,i)-1.0D0) .gt. eps2 )then test_appl=0.0D0 elseif(abs(minval(massi)-massi(i)).gt.vsmall)then !checking that lightest neutralino in process is lightest neutralino in model test_appl=0.0D0 elseif(massj(j).lt.massi(i))then test_appl=0.0D0 else test_appl=x endif case(910) if( abs(t%BR_NjZNi(j,i)-1.0D0) .gt. eps2 )then test_appl=0.0D0 elseif(abs(minval(massi)-massi(i)).gt.vsmall)then !checking that lightest neutralino in process is lightest neutralino in model test_appl=0.0D0 elseif(massj(j).lt.massi(i))then test_appl=0.0D0 else test_appl=x endif case(6227) if( ( t%BR_hjtautau(j)+t%BR_hjbb(j) ).le.0.98D0)then test_appl=0.0D0 else test_appl=x endif case default stop 'error in function test_appl' end select end function test_appl end subroutine calcfact_t2 !******************************************************** subroutine outputproc_t1(tlistn,jj,k,descrip) !******************************************************** ! uses information about the process to output a description ! for processes using table type 1 ! note: at the moment, np(x) (and so ii and jj) needs to be 1 digit long i.e. nH<10 !******************************************************** implicit none !--------------------------------------input integer :: tlistn integer :: jj,k !-----------------------------------internal character(LEN=2) :: j character(LEN=45) :: label character(LEN=200):: descrip !------------------------------------------- if(jj.ne.0)then write(j,'(I2)')jj j=adjustl(j) else j='j' endif if(k.eq.21)then label='' !no need to lable each line in Key.dat else label='('//trim(S95_t1(tlistn)%label)//')' endif descrip='' select case(S95_t1(tlistn)%id) case(142) descrip=' (e e)->(h'//j//')Z->(b b-bar)Z ' //label case(143) descrip=' (e e)->(h'//j//')Z->(tau tau)Z ' //label case(300) descrip=' (e e)->(h'//j//')Z->(...)Z ' //label case(400,401,402,403) descrip=' (e e)->(h'//j//')Z->(invisible)Z ' //label case(500) descrip=' (e e)->(h'//j//')Z->(gamma gamma)Z ' //label case(600,601) descrip=' (e e)->(h'//j//')Z->(2 jets)Z ' //label case(711) descrip=' (e e)->b b-bar(h'//j//')->b b-bar(b b-bar) where h'//j//' is CP even ' //label case(713) descrip=' (e e)->b b-bar(h'//j//')->b b-bar(b b-bar) where h'//j//' is CP odd ' //label case(721,741) descrip=' (e e)->b b-bar(h'//j//')->b b-bar(tau tau) where h'//j//' is CP even ' //label case(723,743) descrip=' (e e)->b b-bar(h'//j//')->b b-bar(tau tau) where h'//j//' is CP odd ' //label case(731) descrip=' (e e)->tau tau(h'//j//')->tau tau(tau tau) where h'//j//' is CP even ' //label case(733) descrip=' (e e)->tau tau(h'//j//')->tau tau(tau tau) where h'//j//' is CP odd ' //label case(801,811,821) descrip=' (e e)->(H'//j//'+)(H'//j//'-)->4 quarks ' //label case(802) descrip=' (e e)->(H'//j//'+)(H'//j//'-)->(2 quarks) tau nu ' //label case(803,813) descrip=' (e e)->(H'//j//'+)(H'//j//'-)->tau nu tau nu' //label case(5482,5570,8742,4493,9475,5876,1024,9889,3534,6089,10235,3047,10799,3564,6166,6296) descrip=' (p p-bar)->Z(h'//j//')->l l (b b-bar) ' //label case(9236,3930,8958,6039,3216,10433,6221,10600) descrip=' (p p-bar)->h'//j//'->W W ' //label case(9219,9463,5472,8957,9596,5828,1970,3493,5972,3155,5613,9868,10068,6092,10217,10239,10796,0874,6220,6309) descrip=' (p p-bar)->W(h'//j//')->l nu (b b-bar) ' //label case(5489) descrip=' (p p-bar)->h'//j//'->W W->e mu ' //label case(5624) descrip=' (p p-bar)->h'//j//'->W W->l l ' //label case(3331) descrip=' (p p-bar)->h'//j//'->V V ' //label case(5757) descrip=' (p p-bar)->h'//j//'/VBF->W W->l l where h'//j//' is SM-like ' //label case(5485,5873) descrip=' (p p-bar)->W(h'//j//')->W W W->l l nu nu ' //label case(9071,2491,5740,5980,1014,3363,4555) descrip=' (p p-bar)->h'//j//'->tau tau ' //label case(8961,9465,9290,9713,9674,0598,9897,9998,9999,6008,6096,6183,3233,6229,6304,10606,10806,10884) descrip=' (p p-bar)->h'//j//'+... where h'//j//' is SM-like ' //label case(9284,5503,5726,3556,10105,1931,4782) descrip=' (p p-bar)->h'//j//'(b/b-bar)->(b b-bar) (b/b-bar) ' //label case(6224,6225,6226) descrip=' (p p-bar)->h'//j//'(b/b-bar)->(b b-bar) (b/b-bar) or (tau tau) (b/b-bar) ' //label case(7307) descrip=' (p p-bar)->W(h'//j//')->W W W ' //label case(6301) descrip=' (p p-bar)->V h'//j//'->V W W ' //label case(5601,5737,1514) descrip=' (p p-bar)->h'//j//'+...->gamma gamma+... ' //label case(5858,6177,6295,1887,10065,10485,4960) descrip=' (p p-bar)->h'//j//'+...->gamma gamma+... where h'//j//' is SM-like ' //label case(7081,9166,9483,5586,9642,1266,0432,9891,5285,3935,6087,6170,10212,6223,6299,10583,10798) descrip=' (p p-bar)->V h'//j//'-> (b b-bar) +missing Et where h'//j//' is SM-like ' //label case(10596) descrip=' (p p-bar)->V h'//j//'-> (b b-bar) l nu where h'//j//' is SM-like ' //label case(6091,1268) descrip=' (p p-bar)->V h'//j//'-> ll + X where h'//j//' is SM-like ' //label case(10010) descrip=' (p p-bar)->V (h'//j//')/VBF-> (b b-bar) q q where h'//j//' is SM-like ' //label case(10607) descrip=' (p p-bar)->V (h'//j//')/VBF-> (b b-bar)+... where h'//j//' is SM-like ' //label case(6436) descrip=' (p p-bar)->V (h'//j//')-> (b b-bar)+...' //label case(9248,10133,10439,6305,6286) descrip=' (p p-bar)->h'//j//'+...->tau tau +... where h'//j//' is SM-like ' //label case(4800,5845,6171) descrip=' (p p-bar)->h'//j//'+...->tau tau (2 jets) where h'//j//' is SM-like ' //label case(5871) descrip=' (p p-bar)->h'//j//'+...->W W +... ->l l nu nu +... where h'//j//' is SM-like ' //label case(6082) descrip=' (p p-bar)->h'//j//'+...->V V +... ->e mu missing Et +... where h'//j//' is SM-like ' //label case(6182,6219) descrip=' (p p-bar)->h'//j//'+...->V V +... ->l l missing Et +... where h'//j//' is SM-like ' //label case(6276) descrip=' (p p-bar)->h'//j//'+...->V V +... ->l l l missing Et +... where h'//j//' is SM-like ' //label case(10573) descrip=' (p p-bar)->h'//j//'+...->V V +... ->l l l l +... where h'//j//' is SM-like ' //label case(5984,9714,6006,9022,9023,0710,9887,4162,10102,4481,4468,6095,10432,6179,6302,10599) descrip=' (p p-bar)->h'//j//'+...->W W +... where h'//j//' is SM-like ' //label case(0024,5985,0968,5974,6083,4885) descrip=' (p p-bar)->h'//j//'(b/b-bar)->(tau tau) (b/b-bar) ' //label case(5739,10574) descrip=' (p p-bar)->t t-bar h'//j//'->t t-bar b b-bar ' //label case(2012135,12025) descrip=' (p p)->t t-bar h'//j//'->t t-bar b b-bar ' //label case(0611) descrip=' (p p-bar)->h'//j//'->Z gamma ' //label case(10500) descrip=' (p p-bar)->V h'//j//'-> V tau tau ' //label case(1811) descrip=' t->(H'//j//'+)b->(2 quarks) b ' //label - case(1812,2011138,2011151,2760,2013090,2014050,14020,8353,7712,11002,11008,160311) + case(1812,2011138,2011151,2760,2013090,2014050,14020,8353,7712,11002,11008,160311,79152) descrip=' t->(H'//j//'+)b->tau nu b ' //label case(1269,1270,2011094,13035) descrip=' t->(H'//j//'+)b->(c s) b' //label case(16030) descrip=' t->(H'//j//'+)b->(c b) b' //label case(11006,11017,110271,110272,14161,14162,5064,2012017,2011150) descrip=' (p p)->h'//j//'/VBF->Z Z-> l l q q where h'//j//' is SM-like ' //label case(2011048,11004,11015,2011131) descrip=' (p p)->h'//j//'/VBF->Z Z-> l l l l where h'//j//' is SM-like ' //label case(2011162,1415,2012092) descrip=' (p p)->h'//j//'/VBF/V h'//j//'->Z Z-> l l l l where h'//j//' is SM-like ' //label case(11025,1997,12041) descrip=' (p p)->h'//j//'/VBF/V/tt h'//j//'->Z Z-> l l l l where h'//j//' is SM-like ' //label case(20130131) descrip=' (p p)->h'//j//'->Z Z-> l l l l where h'//j//' is SM-like ' //label case(20130132) descrip=' (p p)->h'//j//'/ggF h->Z Z-> l l l l ' //label case(20130133) descrip=' (p p)->h'//j//'/VBF/V h->Z Z-> l l l l ' //label case(04670) descrip=' (p p)->h'//j//'->h(SM,125)h(SM,125)-> bb/tautau/WW/gaga (combination) ' //label case(046701) descrip=' (p p)->h'//j//'->h(SM,125)h(SM,125)-> gaga WW ' //label case(046702) descrip=' (p p)->h'//j//'->h(SM,125)h(SM,125)-> bb tautau ' //label case(059301) descrip=' (p p)->h'//j//'->Z Z ' //label case(059302) descrip=' (p p)->h'//j//'(VBF)->Z Z ' //label case(130021) descrip=' (p p)->h'//j//'->Z Z-> l l l l (low mass) where h'//j//' is SM-like ' //label case(130022) descrip=' (p p)->h'//j//'->Z Z-> l l l l (high mass) where h'//j//' is SM-like ' //label case(16034) descrip=' (p p)->h'//j//'/VBF->Z Z-> l l q q, with single-Higgs/VBF ratio profiled ' //label case(009361) descrip=' (p p)->h'//j//'->V V where h'//j//' is SM-like ' //label case(11005,11016,11026,3478) descrip=' (p p)->h'//j//'/VBF->V V-> l l nu nu where h'//j//' is SM-like ' //label case(3357,2011148,2012016) descrip=' (p p)->h'//j//'->V V-> l l nu nu where h'//j//' is SM-like ' //label case(11013,11028) descrip=' (p p)->h'//j//'/VBF->V V-> l l tau tau where h'//j//' is SM-like ' //label case(2011026) descrip=' (p p)->h'//j//'/VBF->V V where h'//j//' is SM-like ' //label case(5429,2011052,2011111,2011134) descrip=' (p p)->h'//j//'->W W ' //label case(063861) descrip=' (g g)->h'//j//' -> Z Z -> 4l+2l2nu (employs NWA)' //label case(20160821) descrip=' (g g)->h'//j//' -> Z Z -> llnunu (employs NWA)' //label case(20160822) descrip=' (g g)->h'//j//' -> Z Z -> llqq (employs NWA)' //label case(20160792) descrip=' (g g)->h'//j//' -> Z Z -> 4l (low-mass range, employs NWA)' //label case(20160823) descrip=' (p p)->h'//j//'(VBF) -> Z Z -> llqq (employs NWA)' //label case(2016062) descrip=' (p p)->h'//j//' -> W W -> lnuqq (employs NWA)' //label case(20160741) descrip=' (p p)->h'//j//' -> W W -> lnulnu (employs NWA)' //label case(20160742) descrip=' (p p)->h'//j//'(VBF) -> W W -> lnulnu (employs NWA)' //label case(20160793) descrip=' (p p)->h'//j//'(VBF) -> Z Z -> 4l (employs NWA)' //label case(0038911) descrip=' (p p)->h'//j//'->W W (employs NWA)' //label case(0038912) descrip=' (p p)->VBF, h'//j//'->W W (employs NWA)' //label case(0038913) descrip=' (p p)->h'//j//'->W W (assumes SM Higgs width, employs CPS)' //label case(0038914) descrip=' (p p)->VBF, h'//j//'->W W (assumes SM Higgs width, employs CPS)' //label case(11034,12039,13009,2012078) descrip=' (p p)->W(h'//j//')->W W W where h'//j//' is SM-like ' //label case(12006) descrip=' (p p)->W(h'//j//')->W tau tau ' //label case(12051) descrip=' (p p)->V(h'//j//')->V tau tau ' //label case(2012012,2012158,2013030) descrip=' (p p)->h'//j//'->W W where h'//j//' is SM-like ' //label case(110212) descrip=' (p p)->V h'//j//'/VBF->gamma gamma ' //label case(2011025,2011085,2011161,5895,1414,2012091,2012168,1487,12001,12015,13001,11010,11030,11021) descrip=' (p p)->h'//j//'+...->gamma gamma+... where h'//j//' is SM-like ' //label case(6583,14006,14037) descrip=' (p p)->h'//j//'/VBF/Wh'//j//'/Zh'//j//'/tth'//j//'->gamma gamma ' //label case(14031) descrip=' (p p)->h'//j//'->Z gamma -> l l gamma ' //label case(13006, 13075515,2013009,3051) descrip=' (p p)->h'//j//'+...->gamma Z+... where h'//j//' is SM-like ' //label case(11031,12044,13012) descrip=' (p p)->V h'//j//'->b b where h'//j//' is SM-like ' //label case(13011) descrip=' (p p)->h'//j//'/VBF->bb+... where h'//j//' is SM-like ' //label case(2011020,2011021) descrip=' (p p)->h'//j//'->mu mu (lower mass range) ' //label case(2011005,3615,2012018) descrip=' (p p)->h'//j//'/VBF->W W where h'//j//' is SM-like ' //label case(12046) descrip=' (p p)->h'//j//'->W W-> l nu q q where h'//j//' is SM-like ' //label case(11003,11014,2577,11024,1489,12042,13003,13027) descrip=' (p p)->h'//j//'+...->W W +... where h'//j//' is SM-like ' //label case(2748,1408,11011,2011163,11022,11032,1488,12008,12045,2011157,2011112,2011135,2012019) descrip=' (p p)->h'//j//'+... where h'//j//' is SM-like ' //label case(7214) descrip=' (p p)->h'//j//'+... where h'//j//' is SM-like ' //label case(10002,5003,2011132,2012094,110201,110292,12050,13021) descrip=' (p p)->h'//j//'->tau tau ' //label case(2014049,20160852,160372,20170502) descrip=' (p p)->bbh'//j//'->tau tau ' //label case(20140492,20160851,160371,20170501) descrip=' (p p)->ggh'//j//'->tau tau ' //label case(11009,11020,2011133,2012014) descrip=' (p p)->h'//j//'/VBF->tau tau +... where h'//j//' is SM-like ' //label case(2012160,12043) descrip=' (p p)->h'//j//'->tau tau +... where h'//j//' is SM-like ' //label case(2013010,7663) descrip=' (p p)->h'//j//'->mu mu +... where h'//j//' is SM-like ' //label case(2012015) descrip=' (p p)->V h'//j//'-> (b b-bar) + X where h'//j//' is SM-like ' //label case(110291) descrip=' (p p)->h'//j//'/VBF/V h'//j//'/tt h'//j//'->tau tau +... where h'//j//' is SM-like ' //label case(2011103,2012161,11012) descrip=' (p p)->V(h'//j//')->V (b b-bar) ' //label case(13022) descrip=' (p p)->h'//j//'(VBF)->WW ' //label case(13013,13441) descrip=' (p p)->h'//j//'(VBF)->V (invisible) ' //label case(13018,13442) descrip=' (p p)->Zh'//j//'->Z (invisible) ' //label case(13443) descrip=' (p p)->h'//j//'(VBF)/Zh'//j//', h'//j//'->(invisible) ' //label case(2013011,3244) descrip=' (p p)->Vh'//j//'->V (invisible) ' //label - case(160312,2016088) + case(160312,2016088,79151) descrip=' (p p) -> (H'//j//'+) t b -> (tau nu) t b '//label case(1504233) descrip=' (p p) -> (H'//j//'+) (VBF) -> W Z '//label case(2016089) descrip=' (p p) -> (H'//j//'+) t b -> (t b) t b '//label case(2016071) descrip=' (p p) -> h'//j//' -> h h -> W W gamma gamma, where h lies around 125 (+- 2.5 GeV) '//label case(14013,16002,2016049) descrip=' (p p) -> h'//j//' -> h h -> b b b b, where h lies around 125 (+- 10 GeV) '//label case(011811,16029,17002) descrip=' (p p) -> h'//j//' -> h h -> b b tau tau, where h lies around 125 (+- 10 GeV) '//label case(14011,044782) descrip=' (p p) -> h'//j//' -> Z h -> l l b b, where h lies around 125 (+- 10 GeV) '//label case(011812,044781) descrip=' (p p) -> h'//j//' -> Z h -> l l tau tau, where h lies around 125 (+- 10 GeV) '//label case(20160151) descrip=' (g g) -> h'//j//' -> Z h -> l l b b, where h lies around 125 (+- 10 GeV) '//label case(20160152) descrip=' (b b) -> h'//j//' -> Z h -> l l b b, where h lies around 125 (+- 10 GeV) '//label case(1508329,2015080) descrip=' (p p)->bbh'//j//'->b b ' //label case(2016025) descrip=' (p p)->h'//j//'->b b ' //label case(2016044) descrip=' (p p)->h'//j//'->Z gamma ' //label case(201608391) descrip=' (p p) -> W h -> W a a -> W b b b b, where h lies around 125 (+- 10 GeV) '//label case(15009) descrip=' (p p)->b b h'//j//'->b b mu mu ' //label case(2016004) descrip=' (p p)->h'//j//'->h h -> b b gamma gamma, where h lies around 125 (+- 2.5 GeV) ' //label case(17006) descrip=' (p p)->h'//j//'->h h -> b b l l nu nu, where h lies around 125 (+- 10 GeV) ' //label case(1604833) descrip=' (p p)->h'//j//'->V V (V=W,Z) ' //label case(2016056) descrip=' (p p)->h'//j//'->Z Z-> l l nu nu ' //label case(20160551) descrip=' (p p)->h'//j//'->Z Z-> q q q q (boosted jets, using RS graviton limit) ' //label case(20160552) descrip=' (p p)->h'//j//'->W W-> q q q q (boosted jets, using RS graviton limit) ' //label case(17020321,1506534) descrip=' (p p)-> H_{SM-like} near 125 GeV -> h'//j//'h'//j//' -> tau tau tau tau ' //label case(5051) descrip=' (p p)-> H_{SM-like} near 125 GeV -> h'//j//'h'//j//' -> gamma gamma gamma gamma ' //label case(17020322) descrip=' (p p)-> H_{SM-like} near 125 GeV -> h'//j//'h'//j//' -> mu mu b b ' //label case(17020323) descrip=' (p p)-> H_{SM-like} near 125 GeV -> h'//j//'h'//j//' -> mu mu tau tau ' //label case default stop 'wrong input to function outputproc_t1 in module S95tables (1)' end select ! New description string based on data file input ! Added by OS 2012-03-12 if(S95_t1(tlistn)%desc.NE.'') then descrip = trim(S95_t1(tlistn)%desc) // ', h='//j if (S95_t1(tlistn)%SMlike.EQ.1) then descrip = trim(descrip)//' where h is SM-like' endif descrip = trim(descrip)//' '//label endif end subroutine outputproc_t1 !******************************************************** subroutine outputproc_t2(tlistn,ii,jj,k,descrip) !******************************************************** ! uses information about the process to output a description ! for processes using table type 1 ! note: at the moment, np(x) (and so ii and jj) needs to be 1 digit long i.e. np(x)<10 !******************************************************** implicit none !--------------------------------------input integer :: tlistn integer :: ii,jj,k !-----------------------------------internal character(LEN=2) :: j,i character(LEN=45) :: label character(LEN=200):: descrip !------------------------------------------- if((ii.ne.0).and.(jj.ne.0))then write(i,'(I2)')ii i=adjustl(i) write(j,'(I2)')jj j=adjustl(j) else i='i' j='j' endif if(k.eq.21)then label='' !no need to lable each line in Key.dat else label='('//trim(S95_t2(tlistn)%label)//')' endif select case(S95_t2(tlistn)%id) case(150) descrip=' (ee)->(h'//j//'->h'//i//' h'//i//')Z->(b b b b)Z ' //label case(160) descrip=' (ee)->(h'//j//'->h'//i//' h'//i//')Z->(tau tau tau tau)Z ' //label case(180) descrip=' (ee)->(h'//j//' h'//i//')->(b b b b) ' //label case(190) descrip=' (ee)->(h'//j//' h'//i//')->(tau tau tau tau) ' //label case(200) descrip=' (ee)->(h'//j//'->h'//i//' h'//i//')h'//i//'->(b b b b)b b '//label case(210) descrip=' (ee)->(h'//j//'->h'//i//' h'//i//')h'//i//'->(tau tau tau tau)tau tau '//label case(220) descrip=' (ee)->(h'//j//'->h'//i//' h'//i//')Z->(b b)(tau tau)Z ' //label case(230) descrip=' (ee)->(h'//j//'->b b)(h'//i//'->tau tau) ' //label case(240) descrip=' (ee)->(h'//j//'->tau tau)(h'//i//'->b b) ' //label case(905) descrip=' (ee)->(C'//j//'+)(C'//j//'-)-> (q q N'//i//') (q q N'//i//') ' //label case(906) descrip=' (ee)->(C'//j//'+)(C'//j//'-)-> q q l nu N'//i//' N'//i//' ' //label case(907) descrip=' (ee)->(C'//j//'+)(C'//j//'-)-> (l nu N'//i//') (l nu N'//i//') ' //label case(908) descrip=' (ee)->(C'//j//'+)(C'//j//'-) with all C'//j//' decaying to W + N'//i//' ' //label case(909) descrip=' (ee)->(N'//j//') N'//i//'-> (q q N'//i//') N'//i//' ' //label case(910) descrip=' (ee)->N'//j//' N'//i//' with all N'//j//' decaying to Z + N'//i//' ' //label case(6065) descrip=' (ee)->(H'//j//'+)(H'//j//'-), with H^(+/-) -> 2 quarks or tau nu (combination)' //label case(02671) descrip=' (ee)->(H'//j//'+)(H'//j//'-)-> (h'//i//'W)(h'//i//'W), with h'//i//'-> bb' //label case(02672) descrip=' (ee)->(H'//j//'+)(H'//j//'-)-> (h'//i//'W)(tau nu), with h'//i//'-> bb' //label case(3381) descrip=' (p p-bar)->h'//j//'->h'//i//' h'//i//'->mu mu mu mu ' //label case(3382) descrip=' (p p-bar)->h'//j//'->h'//i//' h'//i//'->tau tau mu mu ' //label case(5053) descrip=' (p p)->h'//j//'->h'//i//' h'//i//'->gamma gamma b b, where h'//i//' is SM-like around 125 GeV '//label case(13032,06896,16032) descrip=' (p p)->h'//j//'->h'//i//' h'//i//'->gamma gamma b b, where h'//i//' lies around 125 GeV '//label case(011811) descrip=' (p p)->h'//j//'->h'//i//' h'//i//'->b b tau tau, where h'//i//' lies around 125 GeV '//label case(14013,16002) descrip=' (p p)->h'//j//'->h'//i//' h'//i//'->b b b b, where h'//i//' lies around 125 GeV '//label case(14022) descrip=' (p p)->h'//j//'->h'//i//' h'//i//'->tau tau tau tau, where h'//j//' lies around 125 GeV and is SM-like '//label case(011812,150011) descrip=' (p p)->h'//j//' -> h'//i//'Z -> (tau tau)(l l) '//label case(150012,16010) descrip=' (p p)->h'//j//' -> h'//i//'Z -> (b b-bar)(l l) '//label case(044781) descrip=' (g g)->h'//j//' -> h'//i//'Z -> (tau tau)(l l) '//label case(044782,20160151) descrip=' (g g)->h'//j//' -> h'//i//'Z -> (b b-bar)(l l) '//label case(20160152) descrip=' (b b)->h'//j//' -> h'//i//'Z -> (b b-bar)(l l) '//label case(6227) descrip=' (p p-bar)->h'//j//'(b/b-bar)->(b b-bar) (b/b-bar) or (tau tau) (b/b-bar) ' //label case(02301,2016059) descrip=' (p p)->h'//j//'/VBF/Wh'//j//'/Zh'//j//'/tth'//j//'->gamma gamma (including widths effects) ' //label case(003892) descrip=' (p p)->h'//j//'/VBF->W W (including widths effects) ' //label case(01123) descrip=' (p p)->h'//j//'->W W (including widths effects) ' //label case(20160791,160331) descrip=' (g g)->h'//j//'->Z Z -> 4l (including widths effects) ' //label case(170121) descrip=' (p p)->h'//j//'->Z Z -> 4l,2l2q,2l2nu (including widths effects) ' //label case(06386) descrip=' (p p)->h'//j//'->Z Z -> 4l,2l2nu (including widths effects) ' //label case(160332) descrip=' (p p)->h'//j//' (VBF)->Z Z -> 4l (including widths effects) ' //label case(150600424,16035) descrip=' (p p)->h'//j//'->h'//i//'h'//i//'->mu mu mu mu ' //label case default stop 'wrong input to function outputproc_t2 in module S95tables (2)' end select end subroutine outputproc_t2 !****************************************************************** subroutine model_likeness(j,id,t,model_like,sigmaXbr) !***************************************************************** ! Tests how Standard Model-like a parameter point is ! 0 means Mi.ge.MSingleLim (treat as single channel) ! 1 passes the SM-like test and Mi.lt.MSingleLim ! -1 fails the SM-like test and Mi.lt.MSingleLim use usefulbits, only : dataset,div, vsmall, iselementofarray, np, Hneut use theory_BRfunctions use theory_XS_SM_functions implicit none !--------------------------------------input type(dataset) :: t integer :: id,j !-----------------------------------internal integer :: ns,nb,n,jj !--TS 14/03/2011: For revamped model-likeness test method double precision,allocatable :: channel_rat(:,:), channel_SM(:,:) double precision,allocatable :: XS_SM_temp(:), BR_SM_temp(:) double precision :: SMrate, weight, c, dcbyc_dble integer :: ic,nc,nc_rel !---- double precision,allocatable :: XS_rat(:), BR_rat(:) integer :: model_like,testSMratios double precision :: sigmaXbr integer :: is,ib double precision :: s,b double precision,allocatable :: dsbys(:),dbbyb(:),dcbyc(:) logical :: correct_properties double precision,parameter :: unset=-9.9999D6 correct_properties=.True. ns=-1 nb=-1 nc=-1 n=t1elementnumberfromid(S95_t1,id) select case(id) case(711,713,721,723,731,733,741,743,5739,10574,6224,6225,6226,6276,6301,6309,04670,046701,046702,0038911,0038912,0038913,0038914) !these have a very simple model-likeness test, so we can have a non-zero deltax case default if(S95_t1(n)%deltax.gt.0.0D0)then write(*,*)'hello id=',id,'deltax=',S95_t1(n)%deltax stop 'error in subroutine model_likeness (1)' endif end select select case(id) case(8961,0598) ! ns = 3; nb = 2; call initialise_XS_rat_BR_rat nc = 6; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! BR_rat(1) = div(t%BR_hjbb(j) , t%BR_Hbb_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div(t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(10010,10607) ! ns = 4; nb = 2; call initialise_XS_rat_BR_rat nc = 8; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_vbf_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_tthj_ratio(j) ! BR_rat(1) = div(t%BR_hjbb(j) , t%BR_Hbb_SM(j),0.0D0,1.0D0) ! BR_rat(2) = div(( t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j) ) & ! & , t%BR_Hjets_SM(j),0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(13443) nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hjZ_ratio(j) , div(t%BR_hjinvisible(j),1.0D0,0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j) , div(t%BR_hjinvisible(j),1.0D0,0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_HZ_SM(j) , 1.0D0 /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j) , 1.0D0 /) case(6436) nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(9290) ! ns = 4; nb = 4; call initialise_XS_rat_BR_rat nc = 16; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjbb(j) , t%BR_Hbb_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j),0.0D0,1.0D0) ! BR_rat(4) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(13,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(16,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hgaga_SM(j) /) case(9674,9897,9999) ! ns = 4; nb = 3; call initialise_XS_rat_BR_rat nc = 12; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjbb(j) , t%BR_Hbb_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(7081,9166,9483,5586,9642,1266,0432,9891,5285,3935,6087,6170,10212,6223,6299,10583,10798,10596) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hjZ_ratio(j) ! BR_rat(1) = div(t%BR_hjbb(j) , t%BR_Hbb_SM(j),0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(10500) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hjZ_ratio(j) ! BR_rat(1) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) case(9248,10133,10439) ! ns = 4; nb = 1; call initialise_XS_rat_BR_rat nc = 4; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j),0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) case(4800) ! ns = 4; nb = 3; call initialise_XS_rat_BR_rat nc = 12; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div(t%BR_hjbb(j) , t%BR_Hbb_SM(j),0.0D0,1.0D0) ! BR_rat(3) = div(( t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j) ) & ! & , t%BR_Hjets_SM(j),0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(5845) ! ns = 4; nb = 2; call initialise_XS_rat_BR_rat nc = 8; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div(( t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j) ) & ! & , t%BR_Hjets_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hjets_SM(j) /) case(5858,6177,6295,1887,10065,10485,4960) ! ns = 4; nb = 1; call initialise_XS_rat_BR_rat nc = 4; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div(t%BR_hjgaga(j) , t%BR_Hgaga_SM(j),0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hgaga_SM(j) /) case(9465,5871,9022,9023,0710,9887,5984,9714,4162,10102,6006,4481,4468,6095,10432,6179,6302,10599) ! ns = 4; nb = 1; call initialise_XS_rat_BR_rat nc = 4; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) case(6082,6182,6219,10573,6276) ! ns = 4; nb = 2; call initialise_XS_rat_BR_rat nc = 8; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div(t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div(t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HZZ_SM(j) /) case(3331) ! ns = 1; nb = 2; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hj_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_H_SM(j) , t%BR_HZZ_SM(j) /) case(6301) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hjZ_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) case(6309) ! ns = 4; nb = 2; call initialise_XS_rat_BR_rat nc = 5; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) case(1268,6091) ! ns = 2; nb = 2; call initialise_XS_rat_BR_rat nc = 4; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hjZ_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HZZ_SM(j) /) case(6008,9998) ! ns = 5; nb = 5; call initialise_XS_rat_BR_rat nc = 25; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! XS_rat(5) = t%tev%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjbb(j) , t%BR_Hbb_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) ! BR_rat(4) = div(t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) ! BR_rat(5) = div(( t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j) ) & ! & , t%BR_Hjets_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_vbf_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%tev%XS_hjW_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%tev%XS_hjZ_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%tev%XS_tthj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(21,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(22,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(23,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(24,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(25,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(13,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(14,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(15,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(16,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(17,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(18,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(19,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(20,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(21,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(22,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(23,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(24,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(25,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_Hbb_SM(j) /) case(6183,3233) ! ns = 4; nb = 4; call initialise_XS_rat_BR_rat nc = 16; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div(t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) ! BR_rat(4) = div(t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(13,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(16,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hgaga_SM(j) /) case(6286) ! ns = 4; nb = 4; call initialise_XS_rat_BR_rat nc = 9; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjmumu(j),t%BR_Hmumu_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hmumu_SM(j) /) case(6305) ! ns = 4; nb = 3; call initialise_XS_rat_BR_rat nc = 12; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div(t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HZZ_SM(j) /) case(6096,10606,10806,10884) nc = 30; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_vbf_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%tev%XS_hjW_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%tev%XS_hjZ_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%tev%XS_tthj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(21,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(22,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(23,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(24,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(25,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(26,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(27,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(28,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(29,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(30,:) = (/ t%tev%XS_tthj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(13,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(14,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(15,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(16,:) = (/ t%tev%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(17,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(18,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(19,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(20,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(21,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(22,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(23,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(24,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(25,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(26,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(27,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(28,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(29,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(30,:) = (/ t%tev%XS_ttH_SM(j) , t%BR_Hbb_SM(j) /) case(6229) ! ns = 4; nb = 6; call initialise_XS_rat_BR_rat nc = 24; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjbb(j) , t%BR_Hbb_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) ! BR_rat(4) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) ! BR_rat(5) = div(( t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j) ) & ! & , t%BR_Hjets_SM(j) ,0.0D0,1.0D0) ! BR_rat(6) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_vbf_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hjW_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_hjZ_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(21,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(22,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(23,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(24,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(13,:) = (/ t%tev%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(14,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(15,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(16,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(17,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(18,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(19,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(20,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(21,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(22,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(23,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(24,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(6304) ! ns = 4; nb = 5; call initialise_XS_rat_BR_rat nc = 20; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(13,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(16,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(17,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(18,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(19,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(20,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(6171) ! ns = 4; nb = 3; call initialise_XS_rat_BR_rat nc = 12; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hj_ratio(j) ! XS_rat(3) = t%tev%XS_hjZ_ratio(j) ! XS_rat(4) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j),0.0D0,1.0D0) ! BR_rat(3) = div(( t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j) ) & ! & , t%BR_Hjets_SM(j),0.0D0,1.0D0) channel_rat(1,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%tev%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%tev%XS_vbf_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%tev%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%tev%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%tev%XS_hj_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%tev%XS_vbf_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%tev%XS_hjW_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%tev%XS_hjZ_ratio(j) , & & div((t%BR_hjss(j)+t%BR_hjcc(j)+t%BR_hjbb(j)+t%BR_hjgg(j)),t%BR_Hjets_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%tev%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%tev%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%tev%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(6,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(7,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(8,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(9,:) = (/ t%tev%XS_H_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(10,:) = (/ t%tev%XS_vbf_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(11,:) = (/ t%tev%XS_HW_SM(j) , t%BR_Hjets_SM(j) /) channel_SM(12,:) = (/ t%tev%XS_HZ_SM(j) , t%BR_Hjets_SM(j) /) !---------------------- LHC 7/8 TeV searches -------------------- case(5757,2011005,3615,2012018) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hj_ratio(j) ! XS_rat(2) = t%tev%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) case(12046) nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HWW_SM(j) /) case(2011048,11004,11015,11013,11028,11006,11017,110271,110272,14161,14162,5064,2012017,2011150,2011131) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! BR_rat(1) = div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j) , t%BR_HZZ_SM(j) /) case(11034,12039,13009,12006,2012078) ! ns = 1; nb = 2; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc7%XS_hjW_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_HW_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) case(12051) nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc7%XS_hjW_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_hjZ_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_HW_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_HZ_SM(j) , t%BR_Htautau_SM(j) /) case(2012015) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%tev%XS_hjW_ratio(j) ! XS_rat(2) = t%tev%XS_hjZ_ratio(j) ! BR_rat(1) = div(t%BR_hjbb(j) , t%BR_Hbb_SM(j),0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hjW_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_hjZ_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_HW_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_HZ_SM(j) , t%BR_Hbb_SM(j) /) case(2011162,1415) ! ns = 4; nb = 1; call initialise_XS_rat_BR_rat nc = 4; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! BR_rat(1) = div(t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HZZ_SM(j) /) case(2012092,20130131) nc = 4; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HZZ_SM(j) /) case(11025,1997) ! ns = 5; nb = 1; call initialise_XS_rat_BR_rat nc = 5; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div(t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) case(12041,130021,130022) nc = 5; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(5,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) case(2011026,11005,11016,11026,3478,3357,2011148,2012016) ! ns = 2; nb = 2; call initialise_XS_rat_BR_rat nc = 4; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div(t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) case(11003,11014,2577,11024,1489) ! ns = 5; nb = 2; call initialise_XS_rat_BR_rat nc = 10; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(9,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) case(12042,13003,13027) nc = 4; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HWW_SM(j) /) case(2012014) ! ns = 5; nb = 1; call initialise_XS_rat_BR_rat nc = 5; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Htautau_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Htautau_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Htautau_SM(j) /) case(2012160) ! ns = 5; nb = 1; call initialise_XS_rat_BR_rat nc = 4; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Htautau_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Htautau_SM(j) /) case(11009,11020,2011133) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) case(110291) ! ns = 5; nb = 1; call initialise_XS_rat_BR_rat nc = 5; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Htautau_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Htautau_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Htautau_SM(j) /) case(12043) nc = 4; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Htautau_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Htautau_SM(j) /) case(2013010,7663) nc = 4; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjmumu(j),t%BR_Hmumu_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjmumu(j),t%BR_Hmumu_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjmumu(j),t%BR_Hmumu_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjmumu(j),t%BR_Hmumu_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Hmumu_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Hmumu_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Hmumu_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Hmumu_SM(j) /) case(11031,2011103,11012) nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hbb_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hbb_SM(j) /) case(12044,13012) nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Hbb_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Hbb_SM(j) /) case(13011) nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Hbb_SM(j) /) case(2012161) nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Hbb_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Hbb_SM(j) /) case(11021) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! BR_rat(1) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) case(110212) ! ns = 3; nb = 1; call initialise_XS_rat_BR_rat nc = 3; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(2) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjW_ratio(j) ! BR_rat(1) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) case(2011025,2011085,2011161,5895,1414,1487,12001,11010,11030) ! ns = 5; nb = 1; call initialise_XS_rat_BR_rat nc = 5; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) case(2012091,2012168) ! ns = 5; nb = 1; call initialise_XS_rat_BR_rat nc = 5; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(5,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) case(12015,13001) nc = 5; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(5,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) case(13006,13075515,2013009,3051) nc = 5; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjZga(j),t%BR_HZga_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjZga(j),t%BR_HZga_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjZga(j),t%BR_HZga_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjZga(j),t%BR_HZga_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjZga(j),t%BR_HZga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HZga_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HZga_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HZga_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HZga_SM(j) /) channel_SM(5,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_HZga_SM(j) /) case(2748, 1408) ! ns = 5; nb = 3; call initialise_XS_rat_BR_rat nc = 15; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(2) = t%lhc7%XS_hj_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(9,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(12,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(13,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) case(11011,2011163) ! ns = 5; nb = 4; call initialise_XS_rat_BR_rat nc = 20; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(2) = t%lhc7%XS_hj_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) ! BR_rat(4) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(9,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(12,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(13,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(16,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(17,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) channel_SM(18,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Htautau_SM(j) /) channel_SM(19,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Htautau_SM(j) /) channel_SM(20,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Htautau_SM(j) /) case(2012012) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 2; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) case(2012158,2013030) ! ns = 2; nb = 1; call initialise_XS_rat_BR_rat nc = 4; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HWW_SM(j) /) case(2012135,12025) nc = 1; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hbb_SM(j) /) case(2011112) ! ns = 5; nb = 4; call initialise_XS_rat_BR_rat nc = 20; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(2) = t%lhc7%XS_hj_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(4) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) ! BR_rat(4) = div( t%BR_hjbb(j) , t%BR_Hbb_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(9,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(12,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(13,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(16,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(17,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hbb_SM(j) /) channel_SM(18,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hbb_SM(j) /) channel_SM(19,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hbb_SM(j) /) channel_SM(20,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hbb_SM(j) /) case(11022,11032,1488,12008,2011157,2012019,2011135) ! ns = 5; nb = 5; call initialise_XS_rat_BR_rat nc = 25; call initialise_channel_rat_SM ! XS_rat(1) = t%lhc7%XS_hj_ratio(j) ! XS_rat(2) = t%lhc7%XS_vbf_ratio(j) ! XS_rat(1) = t%lhc7%XS_hjW_ratio(j) ! XS_rat(3) = t%lhc7%XS_hjZ_ratio(j) ! XS_rat(5) = t%lhc7%XS_tthj_ratio(j) ! BR_rat(1) = div( t%BR_hjZZ(j) , t%BR_HZZ_SM(j) ,0.0D0,1.0D0) ! BR_rat(2) = div( t%BR_hjWW(j) , t%BR_HWW_SM(j) ,0.0D0,1.0D0) ! BR_rat(3) = div( t%BR_hjgaga(j) , t%BR_Hgaga_SM(j) ,0.0D0,1.0D0) ! BR_rat(4) = div(t%BR_hjtautau(j) , t%BR_Htautau_SM(j) ,0.0D0,1.0D0) ! BR_rat(5) = div( t%BR_hjbb(j) , t%BR_Hbb_SM(j) ,0.0D0,1.0D0) channel_rat(1,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(21,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(22,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(23,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(24,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(25,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(9,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(12,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(13,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(16,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(17,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) channel_SM(18,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Htautau_SM(j) /) channel_SM(19,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Htautau_SM(j) /) channel_SM(20,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Htautau_SM(j) /) channel_SM(21,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(22,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hbb_SM(j) /) channel_SM(23,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hbb_SM(j) /) channel_SM(24,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hbb_SM(j) /) channel_SM(25,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hbb_SM(j) /) case(12045) nc = 25; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(21,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(22,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(23,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(24,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(25,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(9,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(12,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(13,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(16,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(17,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) channel_SM(18,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Htautau_SM(j) /) channel_SM(19,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Htautau_SM(j) /) channel_SM(20,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_Htautau_SM(j) /) channel_SM(21,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(22,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Hbb_SM(j) /) channel_SM(23,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Hbb_SM(j) /) channel_SM(24,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Hbb_SM(j) /) channel_SM(25,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_Hbb_SM(j) /) case(009361) nc = 10; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(9,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) case(17020321,17020322,17020323) ! This only checks the relative proportions of the four main production modes nc = 4; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , 1.0D0 /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), 1.0D0 /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), 1.0D0 /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), 1.0D0 /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , 1.0D0 /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), 1.0D0 /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), 1.0D0 /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), 1.0D0 /) case(7214) nc = 25; call initialise_channel_rat_SM channel_rat(1,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(2,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(3,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(4,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(5,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) /) channel_rat(6,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(7,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(8,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(9,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(10,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) /) channel_rat(11,:) = (/ t%lhc8%XS_hj_ratio(j) , div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(12,:) = (/ t%lhc8%XS_vbf_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(13,:) = (/ t%lhc8%XS_hjZ_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(14,:) = (/ t%lhc8%XS_hjW_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(15,:) = (/ t%lhc8%XS_tthj_ratio(j), div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) /) channel_rat(16,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(17,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(18,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(19,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(20,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) /) channel_rat(21,:) = (/ t%lhc7%XS_hj_ratio(j) , div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(22,:) = (/ t%lhc7%XS_vbf_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(23,:) = (/ t%lhc7%XS_hjZ_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(24,:) = (/ t%lhc7%XS_hjW_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_rat(25,:) = (/ t%lhc7%XS_tthj_ratio(j), div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) /) channel_SM(1,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HWW_SM(j) /) channel_SM(2,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HWW_SM(j) /) channel_SM(3,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HWW_SM(j) /) channel_SM(4,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HWW_SM(j) /) channel_SM(5,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_HWW_SM(j) /) channel_SM(6,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_HZZ_SM(j) /) channel_SM(7,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_HZZ_SM(j) /) channel_SM(8,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_HZZ_SM(j) /) channel_SM(9,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_HZZ_SM(j) /) channel_SM(10,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_HZZ_SM(j) /) channel_SM(11,:) = (/ t%lhc8%XS_H_SM(j) , t%BR_Hgaga_SM(j) /) channel_SM(12,:) = (/ t%lhc8%XS_vbf_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(13,:) = (/ t%lhc8%XS_HZ_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(14,:) = (/ t%lhc8%XS_HW_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(15,:) = (/ t%lhc8%XS_ttH_SM(j), t%BR_Hgaga_SM(j) /) channel_SM(16,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Htautau_SM(j) /) channel_SM(17,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Htautau_SM(j) /) channel_SM(18,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Htautau_SM(j) /) channel_SM(19,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Htautau_SM(j) /) channel_SM(20,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Htautau_SM(j) /) channel_SM(21,:) = (/ t%lhc7%XS_H_SM(j) , t%BR_Hbb_SM(j) /) channel_SM(22,:) = (/ t%lhc7%XS_vbf_SM(j), t%BR_Hbb_SM(j) /) channel_SM(23,:) = (/ t%lhc7%XS_HZ_SM(j), t%BR_Hbb_SM(j) /) channel_SM(24,:) = (/ t%lhc7%XS_HW_SM(j), t%BR_Hbb_SM(j) /) channel_SM(25,:) = (/ t%lhc7%XS_ttH_SM(j), t%BR_Hbb_SM(j) /) case(5739,10574) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%tev%XS_tthj_ratio(j) BR_rat(1) = div(t%BR_hjbb(j) , t%BR_Hbb_SM(j) ,0.0D0,1.0D0) if(t%CP_value(j).eq.1)then ! analysis only applies if higgs is CP even else correct_properties=.False. endif case(711) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lep%XS_bbhj_ratio(j) BR_rat(1) = t%BR_hjbb(j) !note *not* normalised to SM if(t%CP_value(j).eq.1)then ! analysis only applies if higgs is CP even else correct_properties=.False. endif case(713) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lep%XS_bbhj_ratio(j) BR_rat(1) = t%BR_hjbb(j)!note *not* normalised to SM if(t%CP_value(j).eq.-1)then ! analysis only applies if higgs is CP odd else correct_properties=.False. endif case(721) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lep%XS_bbhj_ratio(j) BR_rat(1) = t%BR_hjtautau(j)!note *not* normalised to SM if(t%CP_value(j).eq.1)then ! analysis only applies if higgs is CP even else correct_properties=.False. endif case(723) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lep%XS_bbhj_ratio(j) BR_rat(1) = t%BR_hjtautau(j)!note *not* normalised to SM if(t%CP_value(j).eq.-1)then ! analysis only applies if higgs is CP odd else correct_properties=.False. endif case(731) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lep%XS_tautauhj_ratio(j) BR_rat(1) = t%BR_hjtautau(j)!note *not* normalised to SM if(t%CP_value(j).eq.1)then ! analysis only applies if higgs is CP even else correct_properties=.False. endif case(733) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lep%XS_tautauhj_ratio(j) BR_rat(1) = t%BR_hjtautau(j)!note *not* normalised to SM if(t%CP_value(j).eq.-1)then ! analysis only applies if higgs is CP odd else correct_properties=.False. endif case(741) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lep%XS_bbhj_ratio(j) BR_rat(1) = t%BR_hjtautau(j)!note *not* normalised to SM if(t%CP_value(j).eq.1)then ! analysis only applies if higgs is CP even else correct_properties=.False. endif case(743) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lep%XS_bbhj_ratio(j) BR_rat(1) = t%BR_hjtautau(j)!note *not* normalised to SM if(t%CP_value(j).eq.-1)then ! analysis only applies if higgs is CP odd else correct_properties=.False. endif case(1811,2011094,13035) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%BR_tHpjb(j) BR_rat(1) = t%BR_Hpjcs(j) if( (t%BR_tHpjb(j)+t%BR_tWpb ).le.0.98D0)then correct_properties=.False. elseif((t%BR_Hpjcs(j)+t%BR_Hpjtaunu(j)).le.0.98D0)then correct_properties=.False. endif case(1812,7712,8353,11002,11008,160311) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%BR_tHpjb(j) BR_rat(1) = t%BR_Hpjtaunu(j) if( (t%BR_tHpjb(j)+t%BR_tWpb).le.0.98D0)then correct_properties=.False. elseif((t%BR_Hpjcs(j)+t%BR_Hpjtaunu(j)).le.0.98D0)then correct_properties=.False. endif - case(2011138,2011151,2760,2013090,2014050,14020) + case(2011138,2011151,2760,2013090,2014050,14020,79152) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%BR_tHpjb(j) BR_rat(1) = t%BR_Hpjtaunu(j) if( (t%BR_tHpjb(j)+t%BR_tWpb).le.0.98D0)then correct_properties=.False. endif case(1269,1270) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%BR_tHpjb(j) BR_rat(1) = t%BR_Hpjcs(j) if( (t%BR_tHpjb(j)+t%BR_tWpb ).le.0.98D0)then correct_properties=.False. elseif( t%BR_Hpjcs(j) .le.0.98D0)then correct_properties=.False. endif case(6224) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%tev%XS_hjb_ratio(j)*t%tev%XS_Hb_c4_SM(j) BR_rat(1) = 1.0D0 if( ( t%BR_hjtautau(j)+t%BR_hjbb(j) ).le.0.98D0)then correct_properties=.False. elseif( t%BR_hjtautau(j) .le.0.06D0)then correct_properties=.False. endif case(6225) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%tev%XS_hjb_ratio(j)*t%tev%XS_Hb_c4_SM(j) BR_rat(1) = 1.0D0 if( ( t%BR_hjtautau(j)+t%BR_hjbb(j) ).le.0.98D0)then correct_properties=.False. elseif( t%BR_hjtautau(j) .le.0.1D0)then correct_properties=.False. endif case(6226) ns = 1; nb = 1; call initialise_XS_rat_BR_rat XS_rat(1) = t%tev%XS_hjb_ratio(j)*t%tev%XS_Hb_c4_SM(j) BR_rat(1) = 1.0D0 if( ( t%BR_hjtautau(j)+t%BR_hjbb(j) ).le.0.98D0)then correct_properties=.False. elseif( t%BR_hjtautau(j) .le.0.14D0)then correct_properties=.False. endif case(04670) ! This is a H->h(SM)h(SM) search! ns = 1; nb =1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) BR_rat(1) = 0.0D0 correct_properties=.False. do jj=1,np(Hneut) if(abs(t%particle(Hneut)%M(jj)-125.4).lt.(5.0D0+t%particle(Hneut)%dMh(jj))) then dcbyc_dble=maxval((/ div(abs(t%BR_hjgaga(jj)-t%BR_Hgaga_SM(jj)),t%BR_Hgaga_SM(jj),0.0D0,1.0D0),& & div(abs(t%BR_hjWW(jj)-t%BR_HWW_SM(jj)),t%BR_HWW_SM(jj),0.0D0,1.0D0), & & div(abs(t%BR_hjbb(jj)-t%BR_Hbb_SM(jj)),t%BR_Hbb_SM(jj),0.0D0,1.0D0), & & div(abs(t%BR_hjtautau(jj)-t%BR_Htautau_SM(jj)),t%BR_Htautau_SM(jj),0.0D0,1.0D0) /)) if(dcbyc_dble.lt.0.1D0) then correct_properties=.True. BR_rat(1) = BR_rat(1)+t%BR_hjhihi(j,jj) endif endif enddo case(046701) ! This is a H->h(SM)h(SM) search! ns = 1; nb =1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) BR_rat(1) = 0.0D0 correct_properties=.False. do jj=1,np(Hneut) if(abs(t%particle(Hneut)%M(jj)-125.4).lt.(5.0D0+t%particle(Hneut)%dMh(jj))) then dcbyc_dble=maxval((/ div(abs(t%BR_hjgaga(jj)-t%BR_Hgaga_SM(jj)),t%BR_Hgaga_SM(jj),0.0D0,1.0D0),& & div(abs(t%BR_hjWW(jj)-t%BR_HWW_SM(jj)),t%BR_HWW_SM(jj),0.0D0,1.0D0) /)) if(dcbyc_dble.lt.0.1D0) then correct_properties=.True. BR_rat(1) = BR_rat(1)+t%BR_hjhihi(j,jj) endif endif enddo case(046702) ! This is a H->h(SM)h(SM) search! ns = 1; nb =1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) BR_rat(1) = 0.0D0 correct_properties=.False. do jj=1,np(Hneut) if(abs(t%particle(Hneut)%M(jj)-125.4).lt.(10.0D0+t%particle(Hneut)%dMh(jj))) then dcbyc_dble=maxval((/ div(abs(t%BR_hjbb(jj)-t%BR_Hbb_SM(jj)),t%BR_Hbb_SM(jj),0.0D0,1.0D0), & & div(abs(t%BR_hjtautau(jj)-t%BR_Htautau_SM(jj)),t%BR_Htautau_SM(jj),0.0D0,1.0D0) /)) if(dcbyc_dble.lt.0.1D0) then correct_properties=.True. BR_rat(1) = BR_rat(1)+t%BR_hjhihi(j,jj) endif endif enddo case(0038911) ! H-WW search with width-assumptions ns = 1; nb =1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) BR_rat(1) = t%BR_hjWW(j) if(t%particle(Hneut)%GammaTot(j)<0.2D0*t%GammaTot_SM(j)) then ! NWA requirement correct_properties=.True. else correct_properties=.False. endif case(0038912) ! H-WW search with width-assumptions ns = 1; nb =1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lhc8%XS_vbf_ratio(j)*t%lhc8%XS_vbf_SM(j) BR_rat(1) = t%BR_hjWW(j) if(t%particle(Hneut)%GammaTot(j)<0.2D0*t%GammaTot_SM(j)) then ! NWA requirement correct_properties=.True. else correct_properties=.False. endif case(0038913) ! H-WW search with width-assumptions ns = 1; nb =1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lhc8%XS_hj_ratio(j)*t%lhc8%XS_H_SM(j) BR_rat(1) = t%BR_hjWW(j) if(t%particle(Hneut)%GammaTot(j)>0.8D0*t%GammaTot_SM(j)) then ! NWA requirement correct_properties=.True. else correct_properties=.False. endif case(0038914) ! H-WW search with width-assumptions ns = 1; nb =1; call initialise_XS_rat_BR_rat XS_rat(1) = t%lhc8%XS_vbf_ratio(j)*t%lhc8%XS_vbf_SM(j) BR_rat(1) = t%BR_hjWW(j) if(t%particle(Hneut)%GammaTot(j)>0.8D0*t%GammaTot_SM(j)) then ! NWA requirement correct_properties=.True. else correct_properties=.False. endif !case(801,802,803,811,813,821) !ns = 1; nb = 1; call initialise_XS_rat_BR_rat ! XS_rat(1) = !BR_rat(1) = !if((t%BR_Hpjcb(j)+t%BR_Hpjcs(j)+t%BR_Hpjtaunu(j)).gt.0.98D0)then !else ! correct_properties=.False. !endif case default write(*,*)'hello id=',id stop 'error in subroutine model_likeness (2)' end select !---------------------------------------------------------- !--New model likeness check (TS 23/03/2012) !---------------------------------------------------------- if(allocated(channel_rat)) then if(nc.ne.ubound(channel_rat,dim=1))stop 'error in subroutine model_likeness (3a)' if(nc.ne.ubound(channel_SM,dim=1))stop 'error in subroutine model_likeness (3a)' ! Check if the channels have been filled correctly do ic=1,nc if(abs(channel_rat(ic,1)-unset).lt.1.0D-3)stop 'error in subroutine model_likeness (4a)' if(abs(channel_rat(ic,2)-unset).lt.1.0D-3)stop 'error in subroutine model_likeness (4a)' if(abs(channel_SM(ic,1)-unset).lt.1.0D-3)stop 'error in subroutine model_likeness (4a)' if(abs(channel_SM(ic,2)-unset).lt.1.0D-3)stop 'error in subroutine model_likeness (4a)' enddo !---Eliminate irrelevant channels (=channels with very small SM prediction). !---Construct mean value of the ratio for the relevant channels nc_rel=0 do ic=1,nc if(channel_SM(ic,1).gt.vsmall.and.channel_SM(ic,2).gt.vsmall) then nc_rel=nc_rel+1 channel_SM(nc_rel,:)=channel_SM(ic,:) channel_rat(nc_rel,:)=channel_rat(ic,:) endif enddo if(nc_rel.gt.0) then nc=nc_rel call reallocate_channel_rat_SM endif !--Evaluate the total SM rate expected for the (relevant) channels SMrate=0. do ic=1,nc SMrate=SMrate+channel_SM(ic,1)*channel_SM(ic,2) enddo !--Evaluate the predicted signal strength modifier c of the model c=0. do ic=1,nc !----use a weighted average of the channel rate ratios if(use_weight) then weight = div(channel_SM(ic,1)*channel_SM(ic,2),SMrate,0.0D0,1.0D9) else weight = 1.0D0/nc endif c=c+weight*channel_rat(ic,1)*channel_rat(ic,2) enddo !--Evaluate the deviation of each channel rate ratio to the signal !--strength modifier c allocate(dcbyc(nc)) do ic=1,nc dcbyc(ic)= div((channel_rat(ic,1)*channel_rat(ic,2)-c),c,0.0D0,1.0D9) enddo !--Do the model likeness test testSMratios= 1 !passes the SM-like ratios test do ic=1,nc !----Again, evaluate the weight of the channel if(use_weight) then weight = div(channel_SM(ic,1)*channel_SM(ic,2),SMrate,0.0D0,1.0D9) else weight = 1.0D0 endif !----Check if the channel fulfills the model likeness criteria ! print *, ic, channel_rat(ic,1), channel_rat(ic,2), abs(dcbyc(ic)*weight), dcbyc(ic), weight, c if(abs(dcbyc(ic)*weight).gt.eps)then testSMratios= -1 !fails the SM-like ratios test ! write(*,*) "Analysis application ", id, "fail the SM likeness test!" endif enddo !--Write total ratio into s and b to return later. s=c b=1. deallocate(channel_rat) deallocate(channel_SM) deallocate(dcbyc) !-If channel_rat is not allocated, use old method: else if(ns.ne.ubound(XS_rat,dim=1))stop 'error in subroutine model_likeness (3a)' if(nb.ne.ubound(BR_rat,dim=1))stop 'error in subroutine model_likeness (3b)' do is=1,ns if(abs(XS_rat(is)-unset).lt.1.0D-3)stop 'error in subroutine model_likeness (4a)' enddo do ib=1,nb if(abs(BR_rat(ib)-unset).lt.1.0D-3)stop 'error in subroutine model_likeness (4b)' enddo s=sum(XS_rat)/ns b=sum(BR_rat)/nb allocate(dsbys(ns)) do is=1,ns dsbys(is)= div((XS_rat(is) -s),s, 0.0D0,1.0D9) enddo allocate(dbbyb(nb)) do ib=1,nb dbbyb(ib)= div((BR_rat(ib) -b),b, 0.0D0,1.0D9) enddo testSMratios= 1 !passes the SM-like ratios test do is=1,ns do ib=1,nb if(abs( dsbys(is)+dbbyb(ib)+dsbys(is)*dbbyb(ib) ).gt.eps )then testSMratios= -1 !fails the SM-like ratios test endif enddo enddo deallocate(dsbys) deallocate(dbbyb) deallocate(XS_rat) deallocate(BR_rat) endif if(testSMratios.lt.0)correct_properties=.False. if(correct_properties)then model_like= 1 !passes the model-likeness test sigmaXbr=s*b else model_like= -1 !fails the model-likeness test sigmaXbr=0.0D0 endif contains !---------------------------------------- subroutine initialise_XS_rat_BR_rat allocate(XS_rat(ns)) allocate(BR_rat(nb)) XS_rat=unset BR_rat=unset allocate(XS_SM_temp(ns)) allocate(BR_SM_temp(nb)) XS_SM_temp=unset BR_SM_temp=unset end subroutine initialise_XS_rat_BR_rat !---------------------------------------- subroutine initialise_channel_rat_SM allocate(channel_rat(nc,2)) allocate(channel_SM(nc,2)) channel_rat=unset channel_SM=unset end subroutine initialise_channel_rat_SM !---------------------------------------- subroutine reallocate_channel_rat_SM double precision, allocatable :: reallocate_array(:,:) allocate(reallocate_array(nc,2)) reallocate_array(1:nc,:) = channel_rat(1:nc,:) deallocate(channel_rat) allocate(channel_rat(nc,2)) channel_rat = reallocate_array reallocate_array(1:nc,:) = channel_SM(1:nc,:) deallocate(channel_SM) allocate(channel_SM(nc,2)) channel_SM = reallocate_array deallocate(reallocate_array) end subroutine reallocate_channel_rat_SM !---------------------------------------- end subroutine model_likeness !*********************************************************** subroutine fill_blank_ft1_dat(ft1,ft1_sep,vmasslower,vmasshigher,vmass_xmin,vmass_xmax,vmass_sep,valueoutsidetable) ! don't forget to deallocate f_t1%dat use usefulbits, only : small implicit none integer :: ilower,ihigher double precision, intent(in) :: ft1_sep,vmasslower,vmasshigher,vmass_xmin,vmass_xmax,vmass_sep,valueoutsidetable type(table1) :: ft1 if(abs(vmass_xmin-vmass_xmax).lt.small)stop 'problem in f_from_t3 (4)' ft1%sep=ft1_sep ! we want f_t1%xmin to be lower than x1lower if((vmasslower -vmass_xmin).ge.0.0D0)then ilower = int((vmasslower -vmass_xmin)/vmass_sep)+1 else !off lower edge of table ilower = int((vmasslower -vmass_xmin)/vmass_sep)+1-1 !-1 since int rounds up for negative numbers endif ihigher = int((vmasshigher-vmass_xmin)/vmass_sep)+2 ! we want f_t1%xmax to be higher than x1higher ft1%xmin = dble(ilower - 1)*vmass_sep + vmass_xmin ft1%xmax = dble(ihigher - 1)*vmass_sep + vmass_xmin ft1%nx=nint((ft1%xmax-ft1%xmin)/ft1%sep)+1 allocate(ft1%dat(ft1%nx,1)) ft1%dat(:,1)=valueoutsidetable end subroutine fill_blank_ft1_dat !*********************************************************** subroutine f_from_t1(t1,vmasslower,vmasshigher,sepmultfactor,datcomp, & & f_t1,valueoutsidetable) ! Fills the f_t1 array with the information from a t1 array ! ! Do not forget to deallocate f_t1%dat later on !*********************************************************** use interpolate use usefulbits, only : small implicit none !--------------------------------------input type(table1), intent(in) :: t1 double precision, intent(in) :: vmasslower,vmasshigher,valueoutsidetable double precision, intent(in) :: sepmultfactor integer, intent(in) :: datcomp !-----------------------------------output type(table1), intent(out) :: f_t1 !-----------------------------------internal integer :: i double precision :: interpol double precision :: vmass,vmass_xmin,vmass_xmax,vmass_sep !------------------------------------------- if(vmasslower.gt.vmasshigher)then stop 'problem in f_from_t1 (1)' endif f_t1%id = t1%id f_t1%deltax = t1%deltax vmass_xmin = t1%xmin vmass_xmax = t1%xmax vmass_sep = t1%sep f_t1%sep = t1%sep*sepmultfactor call fill_blank_ft1_dat(f_t1,f_t1%sep,vmasslower,vmasshigher,vmass_xmin,vmass_xmax,vmass_sep,valueoutsidetable) do i=1,ubound(f_t1%dat,dim=1) vmass = dble(i-1)*f_t1%sep + f_t1%xmin if( vmass.lt.vmass_xmin-small )then f_t1%dat(i,1)=valueoutsidetable elseif( vmass.gt.vmass_xmax+small )then f_t1%dat(i,1)=valueoutsidetable else call interpolate_tabletype1(vmass,t1,datcomp,interpol) f_t1%dat(i,1)=interpol endif enddo end subroutine f_from_t1 !*********************************************************** subroutine f_from_t2(t2,m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2, & & vmassm1orm2,vmasslower,vmasshigher,sepmultfactor,datcomp, & & f_t1,valueoutsidetable) ! Fills the f_t1 array with the information from a t2 array along a line ! m2 = line_grad*m1 + line_const ! ! Do not forget to deallocate f_t1%dat later on !*********************************************************** use interpolate use usefulbits, only : small implicit none !--------------------------------------input type(table2), intent(in) :: t2 double precision, intent(in) :: m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2 double precision, intent(in) :: vmasslower,vmasshigher,valueoutsidetable double precision, intent(in) :: sepmultfactor integer, intent(in) :: datcomp,vmassm1orm2 !-----------------------------------output type(table1), intent(out) :: f_t1 !-----------------------------------internal type(table1) :: t1 double precision :: line_grad,line_const integer :: i logical :: const_m1,const_m2 integer :: const_m1_i,const_m2_j logical :: on_m1_gridline,on_m2_gridline double precision :: interpol,mass1,mass2 double precision :: m1bit,m2bit double precision :: vmass,vmass_xmin,vmass_xmax,vmass_sep integer :: ftype_selection(1) !------------------------------------------- if(vmasslower.gt.vmasshigher)then stop 'problem in f_from_t2 (1)' endif if(abs(m1_at_ref_point_1-m1_at_ref_point_2).lt.small)then const_m1=.True. !line_grad is not needed !line_const is not needed else const_m1=.False. line_grad =(m2_at_ref_point_1-m2_at_ref_point_2)/(m1_at_ref_point_1-m1_at_ref_point_2) line_const=(m1_at_ref_point_1*m2_at_ref_point_2-m1_at_ref_point_2*m2_at_ref_point_1) & & /(m1_at_ref_point_1-m1_at_ref_point_2) endif if(abs(m2_at_ref_point_1-m2_at_ref_point_2).lt.small)then const_m2=.True. else const_m2=.False. endif f_t1%id = t2%id f_t1%deltax = t2%deltax select case(vmassm1orm2) case(1) if(const_m1)stop 'problem in f_from_t2 (3a)' vmass_xmin = t2%xmin1 vmass_xmax = t2%xmax1 vmass_sep = t2%sep1 f_t1%sep = t2%sep1*sepmultfactor case(2) if(const_m2)stop 'problem in f_from_t2 (3b)' vmass_xmin = t2%xmin2 vmass_xmax = t2%xmax2 vmass_sep = t2%sep2 f_t1%sep = t2%sep2*sepmultfactor case default stop 'problem in f_from_t2 (3)' end select call fill_blank_ft1_dat(f_t1,f_t1%sep,vmasslower,vmasshigher,vmass_xmin,vmass_xmax,vmass_sep,valueoutsidetable) on_m1_gridline=.False. if(const_m1)then const_m1_i=nint( (m1_at_ref_point_1-t2%xmin1) /t2%sep1)+1 m1bit= m1_at_ref_point_1 -(dble(const_m1_i-1)*t2%sep1+t2%xmin1)/t2%sep1 if(m1bit.lt.small)on_m1_gridline=.True. endif on_m2_gridline=.False. if(const_m2)then const_m2_j=nint( (m2_at_ref_point_1-t2%xmin2) /t2%sep2)+1 m2bit= m2_at_ref_point_1 -(dble(const_m2_j-1)*t2%sep2+t2%xmin2)/t2%sep2 if(m2bit.lt.small)on_m2_gridline=.True. endif ftype_selection(1)=datcomp if( on_m1_gridline )then call fill_t1_from_t2(t2,2,const_m1_i,ftype_selection,t1) call f_from_t1(t1,vmasslower,vmasshigher,sepmultfactor,datcomp, & & f_t1,valueoutsidetable) deallocate(t1%dat) elseif(on_m2_gridline )then call fill_t1_from_t2(t2,1,const_m2_j,ftype_selection,t1) call f_from_t1(t1,vmasslower,vmasshigher,sepmultfactor,datcomp, & & f_t1,valueoutsidetable) deallocate(t1%dat) else do i=1,ubound(f_t1%dat,dim=1) vmass = dble(i-1)*f_t1%sep + f_t1%xmin if(t2%nx2.eq.1)then mass1 = vmass mass2 = t2%xmin2 elseif(vmassm1orm2.eq.1)then mass1 = vmass mass2 = mass1*line_grad+line_const else mass2 = vmass if(const_m1)then mass1 = m1_at_ref_point_1 else mass1 = (mass2 - line_const)/line_grad endif endif if( vmass.lt.vmass_xmin-small )then f_t1%dat(i,1)=valueoutsidetable elseif( vmass.gt.vmass_xmax+small )then f_t1%dat(i,1)=valueoutsidetable elseif(( t2%needs_M2_gt_2M1 ).and.(2.0D0*mass1>mass2+small))then f_t1%dat(i,1)=valueoutsidetable elseif((.not.(t2%needs_M2_gt_2M1)).and.(mass1>mass2+small).and.(t2%nx2.gt.1))then f_t1%dat(i,1)=valueoutsidetable else call interpolate_tabletype2(mass1,mass2,t2,datcomp,interpol) f_t1%dat(i,1)=interpol endif enddo endif end subroutine f_from_t2 !****************************************************************** subroutine f_from_slices_t2(slices_t2,m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2,z, & & vmassm1orm2,vmasslower,vmasshigher,sepmultfactor,datcomp, & & f_t1,valueoutsidetable) !****************************************************************** ! fill the f_t1 array with the information from a t3 array at constant sf along a line ! m2 = line_grad*m1 + line_const ! do not forget to deallocate dat use S95tables_type3 use interpolate use usefulbits, only : small implicit none type(table2), intent(in) :: slices_t2(2) type(table1) :: f_t1 double precision, intent(in) :: m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2 double precision, intent(in) :: z,vmasslower,vmasshigher,valueoutsidetable double precision, intent(in) :: sepmultfactor double precision :: line_grad,line_const integer, intent(in) :: datcomp,vmassm1orm2 integer :: i logical :: const_m1,const_m2 double precision :: interpol,mass1,mass2 double precision :: vmass,vmass_xmin,vmass_xmax,vmass_sep double precision :: z_below,z_above if(vmasslower.gt.vmasshigher)then stop 'problem in f_from_slices_t2 (1)' endif if(abs(m1_at_ref_point_1-m1_at_ref_point_2).lt.small)then const_m1=.True. else const_m1=.False. endif if(abs(m2_at_ref_point_1-m2_at_ref_point_2).lt.small)then const_m2=.True. else const_m2=.False. endif ! check if mass is within z range of table: if( .not. ( (z .ge. slices_t2(1)%z-small).and.(z .le. slices_t2(2)%z+small) ) )then !#1! written in convoluted way to get the NaNs f_t1%id = slices_t2(1)%id f_t1%deltax = slices_t2(1)%deltax if((slices_t2(1)%nx2.eq.1).or.(vmassm1orm2.eq.1))then if(const_m1)stop 'problem in f_from_slices_t2 (1a)' vmass_xmin = slices_t2(1)%xmin1 vmass_sep = slices_t2(1)%sep1 f_t1%sep = slices_t2(1)%sep1*sepmultfactor else if(const_m2)stop 'problem in f_from_slices_t2 (1b)' vmass_xmin = slices_t2(1)%xmin2 vmass_sep = slices_t2(1)%sep2 f_t1%sep = slices_t2(1)%sep2*sepmultfactor endif call fill_blank_ft1_dat(f_t1,f_t1%sep,vmasslower,vmasshigher,vmass_xmin,vmass_xmax,vmass_sep,valueoutsidetable) else !#1 z_below=slices_t2(1)%z z_above=slices_t2(2)%z if(abs(z_below-z).lt.small)then !z is the same as z_below !#2 call f_from_t2(slices_t2(1),m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2, & & vmassm1orm2,vmasslower,vmasshigher,sepmultfactor,1, & & f_t1,valueoutsidetable) elseif(abs(z_above-z).lt.small)then !z is the same as z_above !#2 call f_from_t2(slices_t2(2),m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2, & & vmassm1orm2,vmasslower,vmasshigher,sepmultfactor,1, & & f_t1,valueoutsidetable) else!#2 if(const_m1)then !line_grad is not needed !line_const is not needed else line_grad =(m2_at_ref_point_1-m2_at_ref_point_2)/(m1_at_ref_point_1-m1_at_ref_point_2) line_const=(m1_at_ref_point_1*m2_at_ref_point_2-m1_at_ref_point_2*m2_at_ref_point_1) & & /(m1_at_ref_point_1-m1_at_ref_point_2) endif f_t1%id = slices_t2(1)%id f_t1%deltax = slices_t2(1)%deltax if((slices_t2(1)%nx2.eq.1).or.(vmassm1orm2.eq.1))then vmass_xmin = slices_t2(1)%xmin1 vmass_xmax = slices_t2(1)%xmax1 vmass_sep = slices_t2(1)%sep1 f_t1%sep = slices_t2(1)%sep1*sepmultfactor else if(const_m2)stop 'problem in f_from_slices_t2 (3b)' vmass_xmin = slices_t2(1)%xmin2 vmass_xmax = slices_t2(1)%xmax2 vmass_sep = slices_t2(1)%sep2 f_t1%sep = slices_t2(1)%sep2*sepmultfactor endif call fill_blank_ft1_dat(f_t1,f_t1%sep,vmasslower,vmasshigher,vmass_xmin,vmass_xmax,vmass_sep,valueoutsidetable) do i=1,ubound(f_t1%dat,dim=1) vmass = dble(i-1)*f_t1%sep + f_t1%xmin if(slices_t2(1)%nx2.eq.1)then mass1 = vmass mass2 = slices_t2(1)%xmin2 else select case(vmassm1orm2) case(1) mass1 = vmass mass2 = mass1*line_grad+line_const case(2) mass2 = vmass if(const_m1)then mass1 = m1_at_ref_point_1 else mass1 = (mass2 - line_const)/line_grad endif case default stop 'problem in f_from_slices_t2 (4b)' end select endif if( vmass.lt.vmass_xmin-small )then f_t1%dat(i,1)=valueoutsidetable elseif( vmass.gt.vmass_xmax+small )then f_t1%dat(i,1)=valueoutsidetable elseif((slices_t2(1)%nx2.gt.1).and.( slices_t2(1)%needs_M2_gt_2M1 ).and.(2.0D0*mass1>mass2+small))then f_t1%dat(i,1)=valueoutsidetable elseif((slices_t2(1)%nx2.gt.1).and.(.not.(slices_t2(1)%needs_M2_gt_2M1)).and.(mass1>mass2+small))then f_t1%dat(i,1)=valueoutsidetable else call interpolate_slices_t2(mass1,mass2,z,slices_t2,datcomp,interpol) f_t1%dat(i,1)=interpol endif enddo endif !#2 endif !#1 end subroutine f_from_slices_t2 !****************************************************************** subroutine f_from_t3(t3,m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2,z, & & vmassm1orm2,vmasslower,vmasshigher,sepmultfactor,datcomp, & & f_t1,valueoutsidetable) !****************************************************************** ! fill the f_t1 array with the information from a t3 array at constant sf along a line ! m2 = line_grad*m1 + line_const ! do not forget to deallocate dat use S95tables_type3 use interpolate use usefulbits, only : small implicit none type(table3), intent(in) :: t3 type(table2) :: slices_t2(2) type(table1) :: f_t1 double precision, intent(in) :: m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2 double precision, intent(in) :: z,vmasslower,vmasshigher,valueoutsidetable double precision, intent(in) :: sepmultfactor integer, intent(in) :: datcomp,vmassm1orm2 integer :: a logical :: const_m1,const_m2 double precision :: vmass_xmin,vmass_xmax,vmass_sep integer :: ilow,c_zi(2),ftype_selection(1) double precision :: z_below,z_above if(vmasslower.gt.vmasshigher)then stop 'problem in f_from_t3 (1)' endif if(abs(m1_at_ref_point_1-m1_at_ref_point_2).lt.small)then const_m1=.True. else const_m1=.False. endif if(abs(m2_at_ref_point_1-m2_at_ref_point_2).lt.small)then const_m2=.True. else const_m2=.False. endif ! check if mass is within z range of table: if( .not. ( (z .ge. t3%zmin-small).and.(z .le. t3%zmax+small) ) )then !#1! written in convoluted way to get the NaNs f_t1%id = t3%id f_t1%deltax = t3%deltax if((t3%nx2.eq.1).or.(vmassm1orm2.eq.1))then if(const_m1)stop 'problem in f_from_t3 (1a)' vmass_xmin = t3%xmin1 vmass_sep = t3%sep1 f_t1%sep = t3%sep1*sepmultfactor else if(const_m2)stop 'problem in f_from_t3 (1b)' vmass_xmin = t3%xmin2 vmass_sep = t3%sep2 f_t1%sep = t3%sep2*sepmultfactor endif call fill_blank_ft1_dat(f_t1,f_t1%sep,vmasslower,vmasshigher,vmass_xmin,vmass_xmax,vmass_sep,valueoutsidetable) else !#1 ilow=int((z-t3%zmin)/t3%zsep)+1 z_below=dble(ilow-1)*t3%zsep+t3%zmin z_above=z_below+t3%zsep if(abs(z_below-z).lt.small)then !z is the same as z_below !#2 c_zi= ilow elseif(abs(z_above-z).lt.small)then !z is the same as z_above !#2 c_zi= ilow+1 else !#2 c_zi(1)= ilow c_zi(2)= ilow+1 endif !#2 ftype_selection(1)=datcomp call fill_slices_t2_from_slices_of_t3(t3,c_zi,ftype_selection,slices_t2) call f_from_slices_t2(slices_t2,m1_at_ref_point_1,m2_at_ref_point_1,m1_at_ref_point_2,m2_at_ref_point_2,z, & & vmassm1orm2,vmasslower,vmasshigher,sepmultfactor,datcomp, & & f_t1,valueoutsidetable) do a=1,2 deallocate(slices_t2(a)%dat) enddo endif !#1 end subroutine f_from_t3 !************************************************************ subroutine convolve_chisq_with_gaussian(t1,datcomp,sigma,mass,result) !************************************************************ ! intergrate exp(-t1%dat(xi,1)/2)*exp(-(massx-mass)^2/(2*sigma^2))/sqrt(2*pi*sigma^2) w.r.t. x ! between xlower and xhigher ! then do -2.0D0*log to get result ! negative data points are invalid. They are set to zero. use usefulbits, only : vsmall,vvsmall,pi !internal use interpolate use S95tables_type1 implicit none type(table1),intent(in) :: t1 integer,intent(in) :: datcomp double precision,intent(in) :: sigma,mass double precision,intent(out) :: result !-----------------------------------internal integer :: i,ilow,ihigh,j,divisions,n,ntot double precision :: runningtotal,massx,datvalue,newsep double precision,allocatable :: newdat(:) double precision :: big_number_instead_of_infinity double precision :: dati,datiplus1 !------------------------------------------- if((datcomp.lt.lbound(t1%dat,dim=2)).or.(datcomp.gt.ubound(t1%dat,dim=2)))then stop 'wrong datcomp inputted to subroutine convolve_with_gaussian' elseif(t1%nx.le.1)then stop 'wrong t1%nx inputted to subroutine convolve_with_gaussian (2)' elseif(sigma.le.vsmall)then stop 'wrong sigma inputted to subroutine convolve_with_gaussian' elseif(abs(t1%sep).le.vsmall)then stop 'wrong t1%sep inputted to subroutine convolve_with_gaussian' endif big_number_instead_of_infinity=1.0D5 divisions=5 !do i=1,t1%nx ! if(t1%dat(i,datcomp).ge.big_number_instead_of_infinity)t1%dat(i,datcomp)=1.0D20 !enddo n=0 if(minval(t1%dat(:,datcomp)).lt.1.0D4)then ilow = lbound(t1%dat,dim=1) ihigh = ubound(t1%dat,dim=1) if(ilow.eq.ihigh)stop 'problem in subroutine convolve_with_gaussian' newsep=t1%sep/dble(divisions) ntot=divisions*(ihigh-ilow)+1 allocate(newdat(ntot)) newdat=0.0D0 do i=ilow,ihigh dati=t1%dat(i,datcomp) if(dati.ge.0.0D0)then n=n+1 massx=dble(i-1)*t1%sep+t1%xmin datvalue=dati newdat(n)=exp(-datvalue/2.0D0) & & *exp(-(massx-mass)**2.0D0/(2.0D0*sigma**2.0D0))/sqrt(2.0D0*pi*sigma**2.0D0) if(i.lt.ihigh)then datiplus1=t1%dat(i+1,datcomp) if(datiplus1.ge.0.0D0)then do j=2,divisions-1 n=n+1 massx=dble(i-1)*t1%sep+t1%xmin + dble(j-1)*newsep !do a=1,ihigh ! write(*,*)a,dble(a-1)*t1%sep+t1%xmin ,t1%dat(a,datcomp) !enddo datvalue=dati +((datiplus1-dati)/t1%sep)*dble(j-1)*newsep if(datvalue.lt.0.0D0)then !these are invalid point or places outside range of table datvalue=0.0D0 endif newdat(n)=exp(-datvalue/2.0D0) & & *exp(-(massx-mass)**2.0D0/(2.0D0*sigma**2.0D0))/sqrt(2.0D0*pi*sigma**2.0D0) enddo else do j=2,divisions-1 n=n+1 enddo endif else !negative data points are invalid do j=2,divisions-1 n=n+1 enddo endif !massx=dble(i-1)*t1%sep+t1%xmin !newdat(i)=exp(-t1%dat(i,datcomp)/2.0D0) & ! & *exp(-(massx-mass)**2.0D0/(2.0D0*sigma**2.0D0))/sqrt(2.0D0*pi*sigma**2.0D0) else do j=1,divisions-1 n=n+1 enddo endif enddo !intergrate with trapezium rule runningtotal=0.5D0*(newdat(1)+newdat(ntot)) if((ntot).gt.1)then do n=2,ntot-1 runningtotal=runningtotal+newdat(n) enddo endif deallocate(newdat) if(abs(runningtotal).le.vvsmall)then result= big_number_instead_of_infinity else result= -2.0D0*log(runningtotal*newsep) endif if(result.gt.22.4D0)then !corresponds to clsb=1.0D-6, which is the lowest clsb that ppchi2 can take as input result= big_number_instead_of_infinity endif else result= big_number_instead_of_infinity endif end subroutine convolve_chisq_with_gaussian !************************************************************ function S95_t1_or_S95_t2_idfromelementnumber(ttype,tlist) !************************************************************ implicit none integer :: S95_t1_or_S95_t2_idfromelementnumber integer,intent(in) ::tlist integer,intent(in) ::ttype select case(ttype) case(1) S95_t1_or_S95_t2_idfromelementnumber=S95_t1(tlist)%id case(2) S95_t1_or_S95_t2_idfromelementnumber=S95_t2(tlist)%id case(9) S95_t1_or_S95_t2_idfromelementnumber=3316 case default stop 'wrong input to function S95_t1_or_S95_t2_idfromelementnumber' end select end function S95_t1_or_S95_t2_idfromelementnumber !************************************************************ function S95_t1_or_S95_t2_elementnumberfromid(ttype,id) !************************************************************ use S95tables_type1, only :t1elementnumberfromid use S95tables_type2, only :t2elementnumberfromid implicit none integer,intent(in) ::id integer,intent(in) ::ttype integer :: S95_t1_or_S95_t2_elementnumberfromid select case(ttype) case(1) S95_t1_or_S95_t2_elementnumberfromid= t1elementnumberfromid(S95_t1,id) case(2) S95_t1_or_S95_t2_elementnumberfromid= t2elementnumberfromid(S95_t2,id) case default stop 'problem with function S95_t1_or_S95_t2_elementnumberfromid' end select end function S95_t1_or_S95_t2_elementnumberfromid !************************************************************ subroutine deallocate_S95tables !************************************************************ implicit none !-----------------------------------internal integer x !------------------------------------------- do x=lbound(S95_t1,dim=1),ubound(S95_t1,dim=1) deallocate(S95_t1(x)%dat) enddo do x=lbound(S95_t2,dim=1),ubound(S95_t2,dim=1) deallocate(S95_t2(x)%dat) enddo deallocate(S95_t1) deallocate(S95_t2) call deallocate_Exptranges end subroutine deallocate_S95tables !*********************************************************** subroutine deallocate_Exptranges !*********************************************************** implicit none if(allocated(Exptrange_Mhmin_forSMXS)) deallocate(Exptrange_Mhmin_forSMXS) if(allocated(Exptrange_Mhmax_forSMXS)) deallocate(Exptrange_Mhmax_forSMXS) if(allocated(Exptrange_Mhmin_forSMdecays)) deallocate(Exptrange_Mhmin_forSMdecays) if(allocated(Exptrange_Mhmax_forSMdecays)) deallocate(Exptrange_Mhmax_forSMdecays) end subroutine deallocate_Exptranges !*********************************************************** end module S95tables !************************************************************ Index: trunk/HiggsBounds-5/Expt_tables/ATLtables/079152_Atlas_t-Hpb-taunu_36fb-1.txt =================================================================== --- trunk/HiggsBounds-5/Expt_tables/ATLtables/079152_Atlas_t-Hpb-taunu_36fb-1.txt (revision 0) +++ trunk/HiggsBounds-5/Expt_tables/ATLtables/079152_Atlas_t-Hpb-taunu_36fb-1.txt (revision 570) @@ -0,0 +1,13 @@ +# ATLAS, arXiv:1807.07915, July 2018 +# 079152_Atlas_t-Hpb-taunu_36fb-1.txt +# +# Columns: MHp obs exp (absolute values for BR(t->Hp)*BR(Hp->tau nu)) + + 90.00 0.2485E-02 0.3998E-02 + 100.0 0.2410E-02 0.3326E-02 + 110.0 0.1401E-02 0.2460E-02 + 120.0 0.9357E-03 0.1711E-02 + 130.0 0.1148E-02 0.1265E-02 + 140.0 0.6642E-03 0.7027E-03 + 150.0 0.4214E-03 0.4813E-03 + 160.0 0.3069E-03 0.3765E-03 Index: trunk/HiggsBounds-5/Expt_tables/ATLtables/079151_Atlas_tbHp-taunu_36fb-1.txt =================================================================== --- trunk/HiggsBounds-5/Expt_tables/ATLtables/079151_Atlas_tbHp-taunu_36fb-1.txt (revision 0) +++ trunk/HiggsBounds-5/Expt_tables/ATLtables/079151_Atlas_tbHp-taunu_36fb-1.txt (revision 570) @@ -0,0 +1,197 @@ +# ATLAS, arXiv:1807.07915, July 2018 +# 079151_Atlas_tbHp-taunu_36fb-1.txt +# +# Columns: MHp obs exp (absolute values on sigma13(pp->tb H^\pm)xBR(H^\pm ->tau nu) in pb) + + 90.00 4.161 6.654 + 100.0 4.016 5.525 + 110.0 2.299 4.209 + 120.0 1.585 2.894 + 130.0 1.909 2.104 + 140.0 1.142 1.194 + 150.0 0.7017 0.8157 + 160.0 0.5285 0.6310 + 170.0 0.3219 0.3517 + 180.0 0.2580 0.2869 + 190.0 0.2502 0.2736 + 200.0 0.2424 0.2602 + 210.0 0.2169 0.2277 + 220.0 0.1913 0.1953 + 230.0 0.1657 0.1628 + 240.0 0.1547 0.1466 + 250.0 0.1438 0.1305 + 260.0 0.1329 0.1144 + 270.0 0.1219 0.9824E-01 + 280.0 0.1110 0.9105E-01 + 290.0 0.1001 0.8386E-01 + 300.0 0.8913E-01 0.7667E-01 + 310.0 0.8569E-01 0.7229E-01 + 320.0 0.8225E-01 0.6790E-01 + 330.0 0.7882E-01 0.6352E-01 + 340.0 0.7538E-01 0.5914E-01 + 350.0 0.7194E-01 0.5476E-01 + 360.0 0.6851E-01 0.5258E-01 + 370.0 0.6507E-01 0.5041E-01 + 380.0 0.6163E-01 0.4823E-01 + 390.0 0.5820E-01 0.4606E-01 + 400.0 0.5476E-01 0.4388E-01 + 410.0 0.5141E-01 0.4179E-01 + 420.0 0.4805E-01 0.3971E-01 + 430.0 0.4470E-01 0.3762E-01 + 440.0 0.4135E-01 0.3553E-01 + 450.0 0.3799E-01 0.3344E-01 + 460.0 0.3464E-01 0.3135E-01 + 470.0 0.3129E-01 0.2926E-01 + 480.0 0.2793E-01 0.2717E-01 + 490.0 0.2458E-01 0.2508E-01 + 500.0 0.2123E-01 0.2299E-01 + 510.0 0.2018E-01 0.2230E-01 + 520.0 0.1913E-01 0.2161E-01 + 530.0 0.1808E-01 0.2091E-01 + 540.0 0.1703E-01 0.2022E-01 + 550.0 0.1598E-01 0.1953E-01 + 560.0 0.1493E-01 0.1884E-01 + 570.0 0.1388E-01 0.1815E-01 + 580.0 0.1283E-01 0.1745E-01 + 590.0 0.1178E-01 0.1676E-01 + 600.0 0.1073E-01 0.1607E-01 + 610.0 0.1034E-01 0.1538E-01 + 620.0 0.9954E-02 0.1469E-01 + 630.0 0.9564E-02 0.1400E-01 + 640.0 0.9174E-02 0.1330E-01 + 650.0 0.8784E-02 0.1261E-01 + 660.0 0.8394E-02 0.1192E-01 + 670.0 0.8003E-02 0.1123E-01 + 680.0 0.7613E-02 0.1054E-01 + 690.0 0.7223E-02 0.9844E-02 + 700.0 0.6833E-02 0.9152E-02 + 710.0 0.6633E-02 0.8927E-02 + 720.0 0.6434E-02 0.8701E-02 + 730.0 0.6234E-02 0.8475E-02 + 740.0 0.6035E-02 0.8249E-02 + 750.0 0.5835E-02 0.8023E-02 + 760.0 0.5636E-02 0.7797E-02 + 770.0 0.5436E-02 0.7571E-02 + 780.0 0.5237E-02 0.7346E-02 + 790.0 0.5037E-02 0.7120E-02 + 800.0 0.4837E-02 0.6894E-02 + 810.0 0.4759E-02 0.6787E-02 + 820.0 0.4680E-02 0.6680E-02 + 830.0 0.4602E-02 0.6574E-02 + 840.0 0.4523E-02 0.6467E-02 + 850.0 0.4445E-02 0.6360E-02 + 860.0 0.4366E-02 0.6253E-02 + 870.0 0.4288E-02 0.6146E-02 + 880.0 0.4209E-02 0.6040E-02 + 890.0 0.4131E-02 0.5933E-02 + 900.0 0.4052E-02 0.5826E-02 + 910.0 0.3999E-02 0.5736E-02 + 920.0 0.3945E-02 0.5646E-02 + 930.0 0.3892E-02 0.5555E-02 + 940.0 0.3838E-02 0.5465E-02 + 950.0 0.3785E-02 0.5375E-02 + 960.0 0.3731E-02 0.5285E-02 + 970.0 0.3677E-02 0.5195E-02 + 980.0 0.3624E-02 0.5104E-02 + 990.0 0.3570E-02 0.5014E-02 + 1000. 0.3517E-02 0.4924E-02 + 1010. 0.3495E-02 0.4895E-02 + 1020. 0.3473E-02 0.4865E-02 + 1030. 0.3452E-02 0.4836E-02 + 1040. 0.3430E-02 0.4806E-02 + 1050. 0.3408E-02 0.4777E-02 + 1060. 0.3387E-02 0.4748E-02 + 1070. 0.3365E-02 0.4718E-02 + 1080. 0.3343E-02 0.4689E-02 + 1090. 0.3322E-02 0.4660E-02 + 1100. 0.3300E-02 0.4630E-02 + 1110. 0.3278E-02 0.4601E-02 + 1120. 0.3256E-02 0.4572E-02 + 1130. 0.3235E-02 0.4542E-02 + 1140. 0.3213E-02 0.4513E-02 + 1150. 0.3191E-02 0.4484E-02 + 1160. 0.3170E-02 0.4454E-02 + 1170. 0.3148E-02 0.4425E-02 + 1180. 0.3126E-02 0.4396E-02 + 1190. 0.3105E-02 0.4366E-02 + 1200. 0.3083E-02 0.4337E-02 + 1210. 0.3061E-02 0.4308E-02 + 1220. 0.3040E-02 0.4278E-02 + 1230. 0.3018E-02 0.4249E-02 + 1240. 0.2996E-02 0.4220E-02 + 1250. 0.2974E-02 0.4190E-02 + 1260. 0.2953E-02 0.4161E-02 + 1270. 0.2931E-02 0.4131E-02 + 1280. 0.2909E-02 0.4102E-02 + 1290. 0.2888E-02 0.4073E-02 + 1300. 0.2866E-02 0.4043E-02 + 1310. 0.2844E-02 0.4014E-02 + 1320. 0.2823E-02 0.3985E-02 + 1330. 0.2801E-02 0.3955E-02 + 1340. 0.2779E-02 0.3926E-02 + 1350. 0.2757E-02 0.3897E-02 + 1360. 0.2736E-02 0.3867E-02 + 1370. 0.2714E-02 0.3838E-02 + 1380. 0.2692E-02 0.3809E-02 + 1390. 0.2671E-02 0.3805E-02 + 1400. 0.2649E-02 0.3801E-02 + 1410. 0.2648E-02 0.3798E-02 + 1420. 0.2647E-02 0.3794E-02 + 1430. 0.2645E-02 0.3790E-02 + 1440. 0.2644E-02 0.3786E-02 + 1450. 0.2643E-02 0.3783E-02 + 1460. 0.2642E-02 0.3779E-02 + 1470. 0.2641E-02 0.3775E-02 + 1480. 0.2640E-02 0.3772E-02 + 1490. 0.2638E-02 0.3768E-02 + 1500. 0.2637E-02 0.3764E-02 + 1510. 0.2636E-02 0.3761E-02 + 1520. 0.2635E-02 0.3757E-02 + 1530. 0.2634E-02 0.3753E-02 + 1540. 0.2633E-02 0.3749E-02 + 1550. 0.2631E-02 0.3746E-02 + 1560. 0.2630E-02 0.3742E-02 + 1570. 0.2629E-02 0.3738E-02 + 1580. 0.2628E-02 0.3735E-02 + 1590. 0.2627E-02 0.3731E-02 + 1600. 0.2626E-02 0.3727E-02 + 1610. 0.2616E-02 0.3724E-02 + 1620. 0.2605E-02 0.3720E-02 + 1630. 0.2595E-02 0.3716E-02 + 1640. 0.2585E-02 0.3712E-02 + 1650. 0.2575E-02 0.3709E-02 + 1660. 0.2565E-02 0.3695E-02 + 1670. 0.2555E-02 0.3681E-02 + 1680. 0.2545E-02 0.3668E-02 + 1690. 0.2535E-02 0.3654E-02 + 1700. 0.2525E-02 0.3640E-02 + 1710. 0.2515E-02 0.3627E-02 + 1720. 0.2505E-02 0.3613E-02 + 1730. 0.2495E-02 0.3599E-02 + 1740. 0.2485E-02 0.3585E-02 + 1750. 0.2475E-02 0.3572E-02 + 1760. 0.2465E-02 0.3558E-02 + 1770. 0.2455E-02 0.3544E-02 + 1780. 0.2445E-02 0.3531E-02 + 1790. 0.2435E-02 0.3517E-02 + 1800. 0.2424E-02 0.3526E-02 + 1810. 0.2431E-02 0.3535E-02 + 1820. 0.2438E-02 0.3544E-02 + 1830. 0.2444E-02 0.3553E-02 + 1840. 0.2451E-02 0.3563E-02 + 1850. 0.2458E-02 0.3572E-02 + 1860. 0.2464E-02 0.3581E-02 + 1870. 0.2471E-02 0.3590E-02 + 1880. 0.2477E-02 0.3599E-02 + 1890. 0.2484E-02 0.3608E-02 + 1900. 0.2491E-02 0.3617E-02 + 1910. 0.2497E-02 0.3627E-02 + 1920. 0.2504E-02 0.3636E-02 + 1930. 0.2510E-02 0.3645E-02 + 1940. 0.2517E-02 0.3654E-02 + 1950. 0.2524E-02 0.3663E-02 + 1960. 0.2530E-02 0.3672E-02 + 1970. 0.2537E-02 0.3681E-02 + 1980. 0.2544E-02 0.3690E-02 + 1990. 0.2550E-02 0.3700E-02 + 2000. 0.2557E-02 0.3709E-02 Index: trunk/HiggsBounds-5/S95tables_type1.F90 =================================================================== --- trunk/HiggsBounds-5/S95tables_type1.F90 (revision 569) +++ trunk/HiggsBounds-5/S95tables_type1.F90 (revision 570) @@ -1,5368 +1,5394 @@ ! This file is part of HiggsBounds ! -KW !****************************************************************** module S95tables_type1 !****************************************************************** implicit none !table type 1----------------------------- type table1 integer :: id,nx,particle_x !see usefulbits.f90 for key to particle codes n.b. they're NOT pdg character(LEN=45) :: label character(LEN=100) :: desc character(LEN=3) :: expt double precision :: lumi, energy double precision :: xmax,xmin,sep,deltax integer :: SMlike integer :: llh double precision, allocatable :: dat(:,:) !in dat(a,b), a=row, b=1,2 for obs,pred end type !------------------------------------------ integer,parameter :: file_id_1=10 !same as file_id_common in usefulbits.f90 contains !************************************************************ subroutine initializetables_type1_blank(tablet1) !*********************************************************** ! still leaves dat unallocated integer:: i type(table1) :: tablet1(:) do i=lbound(tablet1,dim=1),ubound(tablet1,dim=1) tablet1(i)%id = -1 tablet1(i)%nx = -1 tablet1(i)%particle_x = -1 tablet1(i)%label = '' tablet1(i)%desc = '' tablet1(i)%expt = '' tablet1(i)%lumi = -1.0D0 tablet1(i)%energy = -1.0D0 tablet1(i)%xmax = -1.0D0 tablet1(i)%xmin = -1.0D0 tablet1(i)%sep = -1.0D0 tablet1(i)%deltax = -1.0D0 tablet1(i)%SMlike = 0 tablet1(i)%llh = 0 enddo end subroutine initializetables_type1_blank !************************************************************ subroutine copy_type1(tablet1_orig,tablet1_copy) !*********************************************************** ! note tablet1_1,tablet1_2 are not arrays ! still leaves dat uncopied type(table1) :: tablet1_orig type(table1) :: tablet1_copy tablet1_copy%id = tablet1_orig%id tablet1_copy%nx = tablet1_orig%nx tablet1_copy%particle_x = tablet1_orig%particle_x tablet1_copy%label = tablet1_orig%label tablet1_copy%expt = tablet1_orig%expt tablet1_copy%xmax = tablet1_orig%xmax tablet1_copy%xmin = tablet1_orig%xmin tablet1_copy%sep = tablet1_orig%sep tablet1_copy%deltax = tablet1_orig%deltax end subroutine copy_type1 !*********************************************************** function t1elementnumberfromid(t1,id) !--------------------------------------input type(table1), intent(in) :: t1(:) integer, intent(in) :: id !-----------------------------------function integer :: t1elementnumberfromid !-----------------------------------internal integer :: n,x !------------------------------------------- n=0 do x=lbound(t1,dim=1),ubound(t1,dim=1) if(t1(x)%id.eq.id)then n=n+1 t1elementnumberfromid=x endif enddo if(n.ne.1)stop 'problem in function t3elementnumberfromid 1' end function t1elementnumberfromid !************************************************************ subroutine initializetables1(S95_t1) !*********************************************************** ! fills S95_t1 !*********************************************************** use store_pathname use usefulbits, only: Hneut,Hplus,file_id_common2 implicit none !--------------------------------------input type(table1) :: S95_t1(:) !-----------------------------------internal logical :: newtables integer :: x,xbeg,xend character(len=100),allocatable :: filename(:) character(LEN=pathname_length+150) :: fullfilename integer :: col integer :: ios !------------------------------------------- xbeg=lbound(S95_t1,dim=1) xend=ubound(S95_t1,dim=1) allocate(filename(xbeg:xend)) x=xbeg-1 !instead, could read in the values of xmin,xmax,sep from the !files, but it's kinda nice having them all here to refer to newtables=.True. ! i.e. use the recommended LEP single Higgs tables if(newtables)then x=x+1 S95_t1(x)%id=142 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0602042, table 14b (LEP)' ! table 14b S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=12.0D0 S95_t1(x)%xmax=120.0D0 S95_t1(x)%sep=0.5D0 filename(x)='lep210_hbb' x=x+1 S95_t1(x)%id=143 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0602042, table 14c (LEP)' ! table 14c S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=4.0D0 S95_t1(x)%xmax=120.0D0 S95_t1(x)%sep=0.5D0 filename(x)='lep210_htt_interpol' else write(*,*)'WARNING: using old LEP tables' x=x+1 S95_t1(x)%id=142 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='LEP table 14b' ! table 14b S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=1.0D0 S95_t1(x)%xmax=140.0D0 S95_t1(x)%sep=0.1D0 filename(x)='old-s95_h2z_bbz' x=x+1 S95_t1(x)%id=143 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='LEP table 14c' ! table 14c S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=1.0D0 S95_t1(x)%xmax=140.0D0 S95_t1(x)%sep=0.1D0 filename(x)='old-s95_h2z_ttz' endif x=x+1 S95_t1(x)%id=300 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0206022 (OPAL)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=1.0D0 S95_t1(x)%xmax=100.0D0 S95_t1(x)%sep=1.0D0 filename(x)='lep_decaymodeindep' x=x+1 S95_t1(x)%id=400 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0107032v1 (LEP)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=118.0D0 S95_t1(x)%sep=1.0D0 filename(x)='LEP_h-invisible' x=x+1 S95_t1(x)%id=500 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='LHWG Note 2002-02' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=20.0D0 S95_t1(x)%xmax=116.0D0 S95_t1(x)%sep=2.0D0 filename(x)='LEP_h-gammagamma' x=x+1 S95_t1(x)%id=600 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='LHWG (unpublished)'!uses hep-ex/0510022,hep-ex/0205055,hep-ex/0312042,hep-ex/0408097 S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=20.0D0 S95_t1(x)%xmax=128.6D0 S95_t1(x)%sep=0.1D0 filename(x)='LEP_h-2jets' x=x+1 S95_t1(x)%id=601 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0107034 (LHWG)'!uses hep-ex/0510022,hep-ex/0205055,hep-ex/0312042,hep-ex/0408097 S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=60.0D0 S95_t1(x)%xmax=114.5D0 S95_t1(x)%sep=0.1D0 filename(x)='LEP_h-2jets_0107034' x=x+1 S95_t1(x)%id=711 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0410017 (DELPHI)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=12.0D0 S95_t1(x)%xmax=50.0D0 S95_t1(x)%sep=1.0D0 filename(x)='Delphi_yuk_h_bbbb' x=x+1 S95_t1(x)%id=713 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0410017 (DELPHI)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=12.0D0 S95_t1(x)%xmax=50.0D0 S95_t1(x)%sep=1.0D0 filename(x)='Delphi_yuk_a_bbbb' x=x+1 S95_t1(x)%id=721 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0410017 (DELPHI)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=4.0D0 S95_t1(x)%xmax=50.0D0 S95_t1(x)%sep=1.0D0 filename(x)='Delphi_yuk_h_bbtautau' x=x+1 S95_t1(x)%id=741 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0111010 (OPAL)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=4.0D0 S95_t1(x)%xmax=12.0D0 S95_t1(x)%sep=1.0D0 filename(x)='OPAL_yuk_h_bbtautau' x=x+1 S95_t1(x)%id=723 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0410017 (DELPHI)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=4.0D0 S95_t1(x)%xmax=50.0D0 S95_t1(x)%sep=1.0D0 filename(x)='Delphi_yuk_a_bbtautau' x=x+1 S95_t1(x)%id=743 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0111010 (OPAL)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=4.0D0 S95_t1(x)%xmax=12.0D0 S95_t1(x)%sep=1.0D0 filename(x)='OPAL_yuk_a_bbtautau' x=x+1 S95_t1(x)%id=731 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0410017 (DELPHI)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=4.0D0 S95_t1(x)%xmax=27.0D0 S95_t1(x)%sep=1.0D0 filename(x)='Delphi_yuk_h_tautautautau' x=x+1 S95_t1(x)%id=733 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0410017 (DELPHI)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=4.0D0 S95_t1(x)%xmax=26.0D0 S95_t1(x)%sep=1.0D0 filename(x)='Delphi_yuk_a_tautautautau' x=x+1 S95_t1(x)%id=402 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0401022 (Delphi)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=40.0D0 S95_t1(x)%xmax=114.0D0 S95_t1(x)%sep=2.0D0 filename(x)='Delphi_h-invisible' x=x+1 S95_t1(x)%id=403 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0501033 (L3)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=50.0D0 S95_t1(x)%xmax=110.0D0 S95_t1(x)%sep=5.0D0 filename(x)='L3_h-invisible' x=x+1 S95_t1(x)%id=401 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='LEP' S95_t1(x)%label='[hep-ex] arXiv:0707.0373 (OPAL)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=5.0D0 S95_t1(x)%xmax=115.0D0 S95_t1(x)%sep=5.0D0 filename(x)='OPAL_h-invisible' !x=x+1 !S95_t1(x)%id=803 !S95_t1(x)%particle_x=Hplus !S95_t1(x)%expt='LEP' !S95_t1(x)%label='[hep-ex] arxiv:0812.0267 (OPAL)' !S95_t1(x)%xmin=50.0D0 !S95_t1(x)%xmax=93.0D0 !S95_t1(x)%sep=1.0D0 !filename(x)='OPAL_HpHm_taunutaunu' !x=x+1 !S95_t1(x)%id=802 !S95_t1(x)%particle_x=Hplus !S95_t1(x)%expt='LEP' !S95_t1(x)%label='[hep-ex] arxiv:0812.0267 (OPAL)' !S95_t1(x)%xmin=50.0D0 !S95_t1(x)%xmax=93.0D0 !S95_t1(x)%sep=1.0D0 !filename(x)='OPAL_HpHm_qqtaunu' !x=x+1 !S95_t1(x)%id=801 !S95_t1(x)%particle_x=Hplus !S95_t1(x)%expt='LEP' !S95_t1(x)%label='[hep-ex] arxiv:0812.0267 (OPAL)' !S95_t1(x)%xmin=50.0D0 !S95_t1(x)%xmax=93.0D0 !S95_t1(x)%sep=1.0D0 !filename(x)='OPAL_HpHm_qqqq' x=x+1 S95_t1(x)%id=821 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0107031 (LHWG)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=60.0D0 S95_t1(x)%xmax=90.0D0 S95_t1(x)%sep=1.0D0 filename(x)='LEP_HpHm_qqqq' x=x+1 S95_t1(x)%id=811 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0404012 (Delphi)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=52.0D0 S95_t1(x)%xmax=94.0D0 S95_t1(x)%sep=2.0D0 filename(x)='Delphi_HpHm_qqqq' x=x+1 S95_t1(x)%id=813 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='LEP' S95_t1(x)%label='hep-ex/0404012 (Delphi)' S95_t1(x)%energy=0.208D0 S95_t1(x)%xmin=52.0D0 S95_t1(x)%xmax=94.0D0 S95_t1(x)%sep=2.0D0 filename(x)='Delphi_HpHm_taunutaunu' !----------------------- Z H -> l l b b ------------------------- ! x=x+1 ! S95_t1(x)%id=10235 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 10235' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=5.7D0 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='CDF_ZH_llbb_5.7fb_10235' ! ! x=x+1 ! S95_t1(x)%id=3047 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='[hep-ex] arXiv:1009.3047 (CDF)' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=4.1D0 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='CDF_ZH_llbb_4.1fb_3047' x=x+1 S95_t1(x)%id=10799 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10799' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.45D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 filename(x)='CDF_ZH_llbb_9.45fb_10799' ! x=x+1 ! S95_t1(x)%id=6166 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6166' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.6D0 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='D0_ZH_llbb_8.6fb_6166' x=x+1 S95_t1(x)%id=6296 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6296' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.7D0 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 filename(x)='D0_ZH_llbb_9.7fb_6296' !x=x+1 !S95_t1(x)%id=6089 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 6089' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='D0_ZH_llbb_6.2fb_6089' x=x+1 S95_t1(x)%id=3564 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:1008.3564 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=4.2D0 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 filename(x)='D0_ZH_llbb_4.2fb_3564' !x=x+1 !S95_t1(x)%id=10212 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 10212' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_VH_Metbb_5.7fb_10212' ! x=x+1 ! S95_t1(x)%id=6087 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6087' ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_VH_bb_6.4fb_6087' ! x=x+1 ! S95_t1(x)%id=2012015 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2012-015' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.7D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=130.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2012015_Atlas_VH_bb_ll_lnu_nunu_4.7fb-1' !----------------------- V H -> b b Etmiss ------------------------- ! x=x+1 ! S95_t1(x)%id=10583 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 10583' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=7.8D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_VH_Metbb_7.8fb_10583' ! x=x+1 ! S95_t1(x)%id=6223 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6223' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.4D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_VH_bb_8.4fb_6223' ! x=x+1 ! S95_t1(x)%id=3935 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='[hep-ex] arXiv:0911.3935v4 (CDF)' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=2.1D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_VH_Metbb_2.1fb_3935_interpol' ! ! x=x+1 ! S95_t1(x)%id=5285 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='[hep-ex] arXiv:0912.5285 (D0)' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=5.2D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_VH_bb_5.2fb_5285' !x=x+1 !S95_t1(x)%id=6092 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 6092'!this is what the note says, but the website says 6082 !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='D0_WH_lnubb_5.3fb_6092' ! x=x+1 ! S95_t1(x)%id=10596 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 10596' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=7.5D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_VH_lnubb_7.5fb_10596' ! x=x+1 ! S95_t1(x)%id=2011103 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-103' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.04D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=130.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011103_Atlas_VH_Vbb_1.04fb-1' x=x+1 S95_t1(x)%id=10798 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10798' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.45D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_VH_Metbb_9.45fb_10798' x=x+1 S95_t1(x)%id=6299 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6299' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.5D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_VH_bb_9.5fb_6299' x=x+1 S95_t1(x)%id=2012161 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-161' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=17.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=130.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012161_Atlas_VH-Vbb_17.7fb-1' ! x=x+1 ! S95_t1(x)%id=11031 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-031' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.7D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=135.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11031_CMS_VH-bb_BDT_4.7fb-1' ! x=x+1 ! S95_t1(x)%id=12044 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-044' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=17.1D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=135.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='12044_CMS_VH_Vbb_17.1fb-1' ! x=x+1 S95_t1(x)%id=13012 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-012' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=24.D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=135.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='13012_CMS_VH_bb_24fb-1' !----------------------- VBF(H), H -> b b ------------------------- x=x+1 S95_t1(x)%id=13011 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-011' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=115.0D0 S95_t1(x)%xmax=135.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='13011_CMS_VBF_bb_19fb-1' !----------------------- W H -> b b ------------------------- ! x=x+1 ! S95_t1(x)%id=6220 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6220' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.5D0 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='D0_WH_lnubb_8.5fb_6220' x=x+1 S95_t1(x)%id=6309 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6309' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.6D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_WH_lnubb_9.7_6309' ! x=x+1 ! S95_t1(x)%id=10239 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 10239' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=5.7D0 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='CDF_WH_lnubb_5.7fb_10239' x=x+1 S95_t1(x)%id=10796 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10796' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.45D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 filename(x)='CDF_WH_lnubb_9.45fb_10796' x=x+1 S95_t1(x)%id=0874 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:1012.0874 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=5.3D0 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 filename(x)='D0_WH_lnubb_5.3fb_0874' x=x+1 S95_t1(x)%id=5613 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='[hep-ex] arXiv:0906.5613 (CDF)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=2.7D0 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 filename(x)='CDF_WH_lnubb_2.7fb_5613' !----------------------- V H, H -> invisible ------------------------- ! x=x+1 ! S95_t1(x)%id=2013011 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2013-011' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=17.7D0 ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2013011_Atlas_H-inv_17.7fb-1' x=x+1 S95_t1(x)%id=3244 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1402.3244 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=24.8D0 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=400.0D0 S95_t1(x)%sep=0.1D0 S95_t1(x)%deltax=0.0D0 filename(x)='3244_Atlas_H-inv_24.8fb-1' ! x=x+1 ! S95_t1(x)%id=13018 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-13-018' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=24.7D0 ! S95_t1(x)%xmin=105.0D0 ! S95_t1(x)%xmax=145.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='13018_CMS_ZH-inv_24.7fb-1' x=x+1 S95_t1(x)%id=13442 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1404.1344 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=24.60 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=105.0D0 S95_t1(x)%xmax=145.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1344_CMS_ZH-invisible_24.6fb-1' !----------------------- VBF, H -> invisible ------------------------- ! x=x+1 ! S95_t1(x)%id=13013 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-13-013' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=19.6D0 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=400.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='13013_CMS_VBF-inv_19.6fb-1' x=x+1 S95_t1(x)%id=13441 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1404.1344 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.5D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=400.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1344_CMS_VBF-invisible_19.5fb-1' x=x+1 S95_t1(x)%id=13443 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1404.1344 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%lumi=24.60 S95_t1(x)%xmin=115.0D0 S95_t1(x)%xmax=145.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1344_CMS_ZH_VBF-invisible_24.6fb-1' !----------------------- H -> W W ------------------------- x=x+1 S95_t1(x)%id=5757 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 5757' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=3.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=115.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_ppH_WW_ll_3.0fb_5757' x=x+1 S95_t1(x)%id=3930 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='[hep-ex] arXiv:0809.3930 (CDF)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=3.0D0 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=10.0D0 filename(x)='CDF_ggH_WW_3.0fb_3930' ! x=x+1 ! S95_t1(x)%id=3216 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:1005.3216 (TEVNPHWG)' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=5.4D0 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='CDF_D0_combined_gg-H-WW_4.8-5.4fb_3216_bayesian_interpol' !x=x+1 !S95_t1(x)%id=10102 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 10102' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_H-WW_5.3fb_10102' ! x=x+1 ! S95_t1(x)%id=6221 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6219' !this note has two results in it, both can not have the id 6219 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.1D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='D0_H-WW_8.1fb_6221_interpol' x=x+1 S95_t1(x)%id=6276 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6276' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_H-VV_9.7fb_6276' x=x+1 S95_t1(x)%id=6301 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6301' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=115.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 filename(x)='D0_VH_VWW_9.7fb_6301' x=x+1 S95_t1(x)%id=10600 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10599' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=8.2D0 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=300.0D0 S95_t1(x)%sep=5.0D0 filename(x)='CDF_ggH-WW_8.2fb_10600_interpol' x=x+1 S95_t1(x)%id=10599 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10599' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=8.2D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_H-WW_8.2fb_10599' x=x+1 S95_t1(x)%id=4468 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='[hep-ex] arXiv:1001.4468 (CDF)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=4.8D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_H-WW_4.8fb_4468_interpol' ! x=x+1 ! S95_t1(x)%id=5871 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5871' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=4.2D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_H-WW_llnunu_4.2fb_5871' !x=x+1 !S95_t1(x)%id=6082 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 6082' !S95_t1(x)%xmin=115.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='D0_H-VV_6.7fb_6082' ! x=x+1 ! S95_t1(x)%id=6219 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6219' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.1D0 ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_H-VV_8.1fb_6219' ! x=x+1 ! S95_t1(x)%id=6179 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6179' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=7.3D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_H-WW-mutau_7.3fb_6179' x=x+1 S95_t1(x)%id=6302 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6302' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=115.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_H-WW_9.7fb_6302' x=x+1 S95_t1(x)%id=6183 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6183' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=8.2D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=130.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_SM_combined_6183' x=x+1 S95_t1(x)%id=4481 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:1001.4481 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=5.4D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=115.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_H-WW_5.4fb_4481' ! x=x+1 ! S95_t1(x)%id=4162 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:1001.4162 (TEVNPHWG)' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=5.4D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=130.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_D0_SM_combined_H-WW_4.8-5.4fb_4162' x=x+1 S95_t1(x)%id=3331 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='TCB' S95_t1(x)%label='[hep-ex] arXiv:1108.3331 (TEVNPHWG)'!CDF note 10608, D0 Note 6230 S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=8.2D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=300.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_D0_combined_gg-H-WW_8.2fb_3331_bayesian_interpol' ! x=x+1 ! S95_t1(x)%id=2011134 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-134' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.7D0 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=1.0D0 ! filename(x)='2011134_Atlas_H-WW-lnulnu_1.7fb-1_interpol' x=x+1 S95_t1(x)%id=2012012 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-012' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012012_Atlas_H-WW-lnulnu_4.7fb-1' ! x=x+1 ! S95_t1(x)%id=2012158 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2012-158' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=13.0D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2012158_Atlas_H-WW-enumunu_13fb-1' x=x+1 S95_t1(x)%id=2013030 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2013-030' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=25.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2013030_Atlas_H-WW-lnulnu_25fb-1' ! x=x+1 ! S95_t1(x)%id=5429 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='[hep-ex] arXiv: 1102.5429(CMS)' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=0.036D0 ! S95_t1(x)%xmin=130.0D0 ! S95_t1(x)%xmax=400.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='5429_CMS_H-WW_36pb-1_rat_interpol' x=x+1 S95_t1(x)%id=2577 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arxiv:1112.2577' S95_t1(x)%desc='pp->h + X->W W* + X ->l l nu nu' S95_t1(x)%energy=7.D0 S95_t1(x)%lumi=2.05D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=300.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2577_Atlas_H-WW-lnulnu_2.05fb-1' ! x=x+1 ! S95_t1(x)%id=1489 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='[hep-ex] arxiv:1202.1489 (CMS)' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.6D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11024_CMS_H-WW-lnulnu_4.6fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=12042 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-042' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=16.0D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='12042_CMS_H-WW-lnulnu_16.0fb-1' x=x+1 S95_t1(x)%id=13003 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-003' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=25.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=5D0 S95_t1(x)%deltax=0.0D0 filename(x)='13003_CMS_H-WW-lnulnu_25fb-1' x=x+1 S95_t1(x)%id=13027 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-027' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=24.3D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=170.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='13027_CMS_H-WW-lnujj_24.3fb-1' x=x+1 S95_t1(x)%id=13022 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-022' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=25.4D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=5D0 S95_t1(x)%deltax=0.0D0 filename(x)='13022_CMS_VBF-WW_25.4fb-1' x=x+1 S95_t1(x)%id=2016062 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-062' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.2D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=500.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=50.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016062_Atlas_gg-H-WW-lnuqq_13.2fb-1' !--------------- H -> VV -> l nu l nu ---------------- x=x+1 S95_t1(x)%id=3357 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1109.3357 (ATLAS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=1.04D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=20.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='3357_Atlas_H-ZZ-llnunu_1.04fb-1' ! x=x+1 ! S95_t1(x)%id=2011148 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-148' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=2.05D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=200.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=20.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011148_Atlas_H-ZZ-lnulnu_2.05fb-1' x=x+1 S95_t1(x)%id=2012016 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-016' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012016_Atlas_H-ZZ-llnunu_4.7fb-1' x=x+1 S95_t1(x)%id=3478 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arxiv:1202.3478 (CMS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.6D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=250.0D0 S95_t1(x)%xmax=590.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='11026_CMS_H-ZZ-llnunu_4.6fb-1' !----------------------- H -> W W ----------------------------- ! x=x+1 ! S95_t1(x)%id=2011052 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-052' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=0.035D0 ! S95_t1(x)%xmin=220.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=20.0D0 ! filename(x)='2011052_Atlas_H-WW_35pb-1' ! x=x+1 ! S95_t1(x)%id=3615 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='[hep-ex] arXiv:1109.3615 (ATLAS)' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=0.035D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=240.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=20.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='3615_Atlas_H-WW-lnuqq_1.04fb-1' ! ! x=x+1 ! S95_t1(x)%id=2012018 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2012-018' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.7D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=300.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2012018_Atlas_H-WW-lnuqq_4.7fb-1' x=x+1 S95_t1(x)%id=12046 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-12-046' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=17D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=170.0D0 S95_t1(x)%xmax=580.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='12046_CMS_H-WW-lnuqq_17fb-1' x=x+1 S95_t1(x)%id=20160741 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-074' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.2D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=50.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016074_Atlas_gg-H-WW-lnulnu_13.2fb-1' x=x+1 S95_t1(x)%id=20160742 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-074' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.2D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=50.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016074_Atlas_vbf-H-WW-lnulnu_13.2fb-1' !------------------------- H -> Z Z -------------------------- x=x+1 S95_t1(x)%id=5064 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1108.5064 (ATLAS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=1.04D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='5064_Atlas_H-ZZ-llqq_1.04fb-1' x=x+1 S95_t1(x)%id=2012017 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-017' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012017_Atlas_H-ZZ-llqq_4.7fb-1' x=x+1 S95_t1(x)%id=14161 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1202.1416 (CMS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.6D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=130.0D0 S95_t1(x)%xmax=164.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='110271_CMS_H-ZZ-llqq_4.6fb-1' x=x+1 S95_t1(x)%id=14162 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1202.1416 (CMS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.6D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='110272_CMS_H-ZZ-llqq_4.6fb-1' x=x+1 S95_t1(x)%id=1415 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1202.1415 (ATLAS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.8D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1415_Atlas_H-ZZ-4l_4.8fb-1' x=x+1 S95_t1(x)%id=2012092 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-092' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=10.6D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012092_Atlas_H-ZZ-4l_10.6fb-1' x=x+1 S95_t1(x)%id=20130131 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2013-013' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=25.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=180.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2013013-1_Atlas_H-ZZ-4l_incl_25fb-1' x=x+1 S95_t1(x)%id=20130132 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2013-013' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=21.0D0 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=5.0D0 filename(x)='2013013-2_Atlas_H-ZZ-4l_ggF_21fb-1' x=x+1 S95_t1(x)%id=20130133 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2013-013' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=21.0D0 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=5.0D0 filename(x)='2013013-3_Atlas_H-ZZ-4l_VBFVH_21fb-1' x=x+1 S95_t1(x)%id=20160792 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-079' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=14.8D0 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=400.0D0 S95_t1(x)%sep=1.0D0 filename(x)='20160792_gg-H-ZZ-4l_14.8fb-1_lowmass' x=x+1 S95_t1(x)%id=20160793 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-079' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=14.8D0 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=1.0D0 filename(x)='20160793_VBF-H-ZZ-4l_14.8fb-1' x=x+1 S95_t1(x)%id=1997 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arxiv:1202.1997 (CMS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='11025_CMS_H-ZZ-4l_4.7fb-1' ! x=x+1 ! S95_t1(x)%id=12041 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-041' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=17.3D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='12041_CMS_H-ZZ-4l_17.3fb-1' x=x+1 S95_t1(x)%id=130021 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-002' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=25.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='13002-1_CMS_H-ZZ-4l_lowm_25fb-1' x=x+1 S95_t1(x)%id=130022 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-002' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=25.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=150.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='13002-2_CMS_H-ZZ-4l_highm_25fb-1' x=x+1 S95_t1(x)%id=009361 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1504.00936 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=24.8D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=145.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='009361_CMS_H-VV_5.1fb-1_19.7fb-1' x=x+1 S95_t1(x)%id=063861 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='arXiv:1712.06386 (ATLAS)' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=36.1D0 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=400.0D0 S95_t1(x)%sep=1.0D0 filename(x)='063861_ATLAS_gg-H-ZZ-4l+2l2nu_NWA_36.1fb-1' x=x+1 S95_t1(x)%id=20160821 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-082' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.2D0 S95_t1(x)%xmin=500.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=1.0D0 filename(x)='20160821_Atlas_gg-H-ZZ-llnunu_13.2fb-1' x=x+1 S95_t1(x)%id=20160822 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-082' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.2D0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=1.0D0 filename(x)='20160822_Atlas_gg-H-ZZ-llqq_13.2fb-1' x=x+1 S95_t1(x)%id=20160823 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-082' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.2D0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=1.0D0 filename(x)='20160823_Atlas_qq-Hqq-ZZ-llqq_13.2fb-1' x=x+1 S95_t1(x)%id=16034 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-16-034' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=12.9D0 S95_t1(x)%xmin=550.0D0 S95_t1(x)%xmax=2000.0D0 S95_t1(x)%sep=10.0D0 filename(x)='16034_CMS_H-ZZ-llqq_12.9fb-1' !------------------------- SM combined ----------------------- ! x=x+1 ! S95_t1(x)%id=8961 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:0712.2383v1(TEVNPHWG)' !CDF Note 8961, D0 Note 5536 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=1.9D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_D0_SM_combined_1.0-1.9fb_8961-5536_interpol' x=x+1 S95_t1(x)%id=10439 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10439' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=6.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_H-tautau_6.0fb_10439' !x=x+1 !S95_t1(x)%id=10133 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 10133' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_H-tautau_2.3fb_10133' ! x=x+1 ! S95_t1(x)%id=4800 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='[hep-ex] arXiv:0903.4800 (D0)' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=1.0D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=105.0D0 ! S95_t1(x)%xmax=145.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_SM_tautau_1.0fb_4800' ! x=x+1 S95_t1(x)%id=5845 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 5845' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=4.9D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=105.0D0 S95_t1(x)%xmax=145.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_tautauqq_4.9fb_5845' ! x=x+1 ! S95_t1(x)%id=9290 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:0804.3423(TEVNPHWG)' !CDF Note 9290, D0 Note 5645 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=2.4D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_D0_SM_combined_1.0-2.4fb_9290-5645_interpol' ! x=x+1 ! S95_t1(x)%id=9465 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:0808.0534(TEVNPHWG)' !CDF Note 9465, D0 Note 5754 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=3.0D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=155.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! !filename(x)='CDF_D0_SM_combined_3.0fb_9465-5754_CLs' ! filename(x)='CDF_D0_SM_combined_3.0fb_9465-5754_bayesian' ! x=x+1 ! S95_t1(x)%id=0598 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='[hep-ex] arXiv:0712.0598v1 (D0)' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=0.44D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_SM_combined_0598_interpol' x=x+1 S95_t1(x)%id=9999 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 9999' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=4.8D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_SM_combined_2.0-4.8fb_9999_interpol' ! x=x+1 ! S95_t1(x)%id=6008 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6008' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=5.4D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_SM_combined_6008' x=x+1 S95_t1(x)%id=6305 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6305' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=7.3D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=105.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_H-tautau_7.3fb_6305' ! x=x+1 ! S95_t1(x)%id=9998 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:0911.3930 (TEVNPHWG)'!CDF Note 9998, D0 Note 5983 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=5.4D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_D0_SM_combined_2.1-5.4fb_9998-5983_bayesian' ! x=x+1 ! S95_t1(x)%id=6096 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:1007.4587 (TEVNPHWG)' !CDF Note 10241, D0 Note 6096 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=6.7D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_D0_SM_combined_2.1-6.7fb_10241-6096_bayesian' x=x+1 S95_t1(x)%id=10010 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10010' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=4D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_hadr_4fb_10010' x=x+1 S95_t1(x)%id=6171 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6171' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=4.3D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=105.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_H-tautaujj-4.3fb_6171' ! x=x+1 ! S95_t1(x)%id=6229 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6229' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.6D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_SM_combined_6229' x=x+1 S95_t1(x)%id=6304 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6304' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_SM_combined_6304' x=x+1 S95_t1(x)%id=10500 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10500' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=6.2D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_VH_tautau_6.2fb_10500' x=x+1 S95_t1(x)%id=10573 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10573' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=8.2D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=120.0D0 S95_t1(x)%xmax=300.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_H-WW_8.2fb_10573' x=x+1 S95_t1(x)%id=6286 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6286' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=7.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_tautaumu_7.0fb_6286' ! x=x+1 ! S95_t1(x)%id=3233 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:1103.3233v2 (TEVNPHWG)' !CDF Note 10432, D0 Note 6183 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.2D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=130.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! !filename(x)='CDF_D0_SM_combined_4.3-8.2fb_3233_CLs' ! filename(x)='CDF_D0_SM_combined_4.3-8.2fb_3233_bayesian' ! ! x=x+1 ! S95_t1(x)%id=10606 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:1107.5518 (TEVNPHWG)' !CDF Note 10606, D0 Note 6226 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.6D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_D0_SM_combined_8.6fb_10606' x=x+1 S95_t1(x)%id=10884 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='TCB' S95_t1(x)%label='[hep-ex] arXiv:1207.0449 (TEVNPHWG)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=10.D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='10884_CDF_D0_SM_combined_10fb-1' ! x=x+1 ! S95_t1(x)%id=10607 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='[hep-ex] arXiv:1107.5518 (TEVNPHWG)' !CDF Note 10606, D0 Note 6226 ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.6D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_D0_combined_h-bb_8.6fb_10607' x=x+1 S95_t1(x)%id=6436 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='TCB' S95_t1(x)%label='[hep-ex] arXiv:1207.6436 (TEVNPHWG)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1207.6436_CDF_D0_combined_h-bb_9.7fb-1' ! x=x+1 ! S95_t1(x)%id=2011112 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-112' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.21D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011112_Atlas_SMcombined_1.04-1.21fb-1_interpol' ! ! x=x+1 ! S95_t1(x)%id=2011135 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-135' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=2.3D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011135_Atlas_SMcombined_1-2.3fb-1_interpol' ! ! x=x+1 ! S95_t1(x)%id=2011163 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-163' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.9D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=0.5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011163_Atlas_SMcombined_4.9fb-1' ! x=x+1 S95_t1(x)%id=1408 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='(hep-ex) arxiv:1202.1408 (ATLAS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.9D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1408_Atlas_SMcombined_4.9fb-1' x=x+1 S95_t1(x)%id=2012019 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-019' S95_t1(x)%desc='(p p)->h+...' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.9D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012019_Atlas_SMcombined_4.9fb-1' x=x+1 S95_t1(x)%id=7214 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='(hep-ex) arXiv:1207.7214 (ATLAS)' S95_t1(x)%desc='(p p)->h+...' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=10.5D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=0.1D0 S95_t1(x)%deltax=0.0D0 filename(x)='7214_Atlas_SMcombined_10.5fb-1' x=x+1 S95_t1(x)%id=2011157 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2011-157, CMS-PAS-HIG-11-023' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=2.3D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2011157_Atlas_CMS_SMcombined_2.7fb-1' ! x=x+1 ! S95_t1(x)%id=11011 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-011' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.1D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11011_CMS_SMcomb_1.1fb-1_interpol' x=x+1 S95_t1(x)%id=1488 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arxiv:1202.1488 (CMS)' S95_t1(x)%energy=7.D0 S95_t1(x)%lumi=4.8D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1488_CMS_SMcombined_4.8fb-1' ! x=x+1 ! S95_t1(x)%id=12008 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-008' ! S95_t1(x)%desc='(p p)->h+...' ! S95_t1(x)%energy=7.D0 ! S95_t1(x)%lumi=4.8D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='12008_CMS_SMcombined_4.8fb-1' x=x+1 S95_t1(x)%id=12045 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-12-045' S95_t1(x)%desc='(p p)->h+...' S95_t1(x)%energy=8.D0 S95_t1(x)%lumi=17.3D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='12045_CMS_SMcombined_17.3fb-1' !----------------- b H -> 3 b jets ------------------- ! x=x+1 ! S95_t1(x)%id=10105 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 10105' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=2.2D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=210.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='CDF_bbH_bb_2.2fb_10105' ! x=x+1 ! S95_t1(x)%id=5726 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5726' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=2.6D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=220.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_bbH_bb_2.6fb_5726_sq_interpol' x=x+1 S95_t1(x)%id=1931 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:1011.1931 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=5.2D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=300.0D0 S95_t1(x)%sep=10.0D0 filename(x)='D0_bbH_bb_5.2fb_1931' x=x+1 S95_t1(x)%id=4782 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='arXiv:1106.4782 (CDF)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=2.6D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=350.0D0 S95_t1(x)%sep=10.0D0 filename(x)='CDF_bbH_bb_2.6fb_4782' ! x=x+1 ! S95_t1(x)%id=12033 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-033' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.8D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=350.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='12033_CMS_bbH-bbbb_4.8fb-1' x=x+1 S95_t1(x)%id=1508329 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='arXiv:1506.08329 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=900.0D0 S95_t1(x)%sep=10.0D0 filename(x)='1508329_CMS_Hb-bbb_19.7fb-1' x=x+1 S95_t1(x)%id=2015080 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='CERN-THESIS-2015-080 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.5D0 S95_t1(x)%xmin=450.0D0 S95_t1(x)%xmax=800.0D0 S95_t1(x)%sep=50.0D0 filename(x)='2015080_Atlas_hb-bbb_19.5fb-1' !-------------------- H -> tau tau ------------------------- x=x+1 S95_t1(x)%id=4555 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:1106.4555 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=5.4D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=300.0D0 S95_t1(x)%sep=10.0D0 filename(x)='D0_H-tautau_5.4fb_4555_interpol' ! x=x+1 ! S95_t1(x)%id=2491 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='[hep-ex] arXiv:0805.2491 (D0)' ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_ppH_tautau_1fb_2491_interpol' x=x+1 S95_t1(x)%id=1014 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='[hep-ex] arXiv:0906.1014 (CDF)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=1.8D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=250.0D0 S95_t1(x)%sep=10.0D0 filename(x)='CDF_H-tautau_1.8fb_1014_interpol' ! x=x+1 ! S95_t1(x)%id=5740 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5740' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=2.2D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_H-tautau_2.2fb_5740_interpol' x=x+1 S95_t1(x)%id=3363 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='TCB' S95_t1(x)%label='[hep-ex] arXiv:1003.3363 (TEVNPHWG)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=2.2D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=10.0D0 filename(x)='CDF_D0_combinedH-tautau_2.2fb_3363_CLs' ! x=x+1 ! S95_t1(x)%id=2011133 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-133' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.06D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=140.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011133_Atlas_H-tautau-ll4nu_1.06fb-1' ! x=x+1 ! S95_t1(x)%id=2012014 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2012-014' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.7D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2012014_Atlas_H-tautau_4.7fb-1' x=x+1 S95_t1(x)%id=2012160 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-160' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=17.6D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012160_Atlas_H-tautau_17.6fb-1' ! x=x+1 ! S95_t1(x)%id=5003 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='[hep-ex] arXiv:1107.5003 (ATLAS)'!CERN-PH-EP-2011-104 ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=0.036D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='5003_Atlas_ggh_h-tautau_36pb-1' ! x=x+1 ! S95_t1(x)%id=2011132 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-132' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.06D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='2011132_Atlas_conserv_h-tautau_1.06fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=2012094 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2012-094' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.7D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=500.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='2012094_Atlas_H-tautau_4.7fb-1' ! Analysis is disabled when using CMS tau tau likelihood x=x+1 S95_t1(x)%id=2014049 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2014-049, arXiv:1409.6064' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%llh=1 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=20.0D0 filename(x)='2014049_Atlas_bbh_h-tautau_20.3fb-1' ! Analysis is disabled when using CMS tau tau likelihood x=x+1 S95_t1(x)%id=20140492 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2014-049, arXiv:1409.6064' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%llh=1 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=20.0D0 filename(x)='20140492_Atlas_ggh_h-tautau_20.3fb-1' ! Analysis is disabled when using CMS tau tau likelihood ! x=x+1 ! S95_t1(x)%id=20160851 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2016-085' ! S95_t1(x)%energy=13.0D0 ! S95_t1(x)%lumi=13.3D0 ! S95_t1(x)%xmin=200.0D0 ! S95_t1(x)%xmax=1200.0D0 ! S95_t1(x)%llh=1 ! S95_t1(x)%sep=20.0D0 ! S95_t1(x)%deltax=20.0D0 ! filename(x)='20160851_Atlas_ggh_h_tautau_13.3fb-1' ! Analysis is disabled when using CMS tau tau likelihood ! x=x+1 ! S95_t1(x)%id=20160852 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2016-085' ! S95_t1(x)%energy=13.0D0 ! S95_t1(x)%lumi=13.3D0 ! S95_t1(x)%xmin=200.0D0 ! S95_t1(x)%xmax=1200.0D0 ! S95_t1(x)%llh=1 ! S95_t1(x)%sep=20.0D0 ! S95_t1(x)%deltax=20.0D0 ! filename(x)='20160852_Atlas_bbh_h_tautau_13.3fb-1' ! Analysis is disabled when using CMS tau tau likelihood ! x=x+1 ! S95_t1(x)%id=160371 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-16-037' ! S95_t1(x)%energy=13.0D0 ! S95_t1(x)%lumi=12.9D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=3000.0D0 ! S95_t1(x)%llh=1 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=20.0D0 ! filename(x)='160371_CMS_ggh_h_tautau_12.9fb-1' ! Analysis is disabled when using CMS tau tau likelihood ! x=x+1 ! S95_t1(x)%id=160372 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-16-037' ! S95_t1(x)%energy=13.0D0 ! S95_t1(x)%lumi=12.9D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=3000.0D0 ! S95_t1(x)%llh=1 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=20.0D0 ! filename(x)='160372_CMS_bbh_h_tautau_12.9fb-1' ! Analysis is disabled when using CMS tau tau likelihood ! x=x+1 ! S95_t1(x)%id=20170501 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2017-050' ! S95_t1(x)%energy=13.0D0 ! S95_t1(x)%lumi=36.1D0 ! S95_t1(x)%xmin=200.0D0 ! S95_t1(x)%xmax=2250.0D0 ! S95_t1(x)%llh=1 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=20.0D0 ! filename(x)='20170501_Atlas_gg-H-tautau_36.1fb-1' ! x=x+1 ! S95_t1(x)%id=20170502 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2017-050' ! S95_t1(x)%energy=13.0D0 ! S95_t1(x)%lumi=36.1D0 ! S95_t1(x)%xmin=200.0D0 ! S95_t1(x)%xmax=2250.0D0 ! S95_t1(x)%llh=1 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=20.0D0 ! filename(x)='20170502_Atlas_bb-H-tautau_36.1fb-1' ! x=x+1 ! S95_t1(x)%id=110291 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-029' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.6D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=145.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11029_CMS_H-tautau_4.6fb-1_SM' x=x+1 S95_t1(x)%id=12043 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-12-043' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=17.D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=145.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='12043_CMS_H_tautau_17fb-1' ! x=x+1 ! S95_t1(x)%id=10002 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='[hep-ex] arXiv: 1104:1619(CMS)'!CMS-PAS-HIG-10-002 ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=0.036D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=500.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='10002_CMS_H-tautau_36pb-1_interpol' ! x=x+1 ! S95_t1(x)%id=110292 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='[hep-ex] arXiv: 1202.4083 (CMS)' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.6D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=500.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='11029_CMS_H-tautau_4.6fb-1_MSSM_interpol' ! ! x=x+1 ! S95_t1(x)%id=12050 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-050' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=17.D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=800.0D0 ! S95_t1(x)%sep=1.0D0 ! filename(x)='12050_CMS_H-tautau_17fb-1' ! Still in testing phase! ! x=x+1 ! S95_t1(x)%id=13021 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-13-021' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=25.6D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=1000.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='13021_CMS_H-tautau_25.6fb-1_MSSM_ggH' !-------------------- Higgs to Higgs decays ------------------------- ! ! Requires hi -> hj Z branching ratio in input! ! x=x+1 S95_t1(x)%id=14011 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-14-011, arXiv:1504.04710 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=225.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=0.1D0 S95_t1(x)%deltax=10.0D0 filename(x)='14011_CMS_A-Zh-llbb_19.7fb-1' ! x=x+1 S95_t1(x)%id=04670 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1509.04670 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=260.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=0.1D0 S95_t1(x)%deltax=10.0D0 filename(x)='04670_Atlas_H-hh-combined_20.3fb-1' x=x+1 S95_t1(x)%id=046701 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1509.04670 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=260.0D0 S95_t1(x)%xmax=500.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='04670_Atlas_H-hh-gagaWW_20.3fb-1' x=x+1 S95_t1(x)%id=2016071 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-071' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=260.0D0 S95_t1(x)%xmax=500.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016071_Atlas_gg-H-hh-WWgaga_13.3fb-1' x=x+1 S95_t1(x)%id=046702 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1509.04670 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=260.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='04670_Atlas_H-hh-bbtautau_20.3fb-1' x=x+1 S95_t1(x)%id=2016049 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-049' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=50.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016049_Atlas_H-hh-bbbb_13.3fb-1' x=x+1 S95_t1(x)%id=011811 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1510.01181 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=260.0D0 S95_t1(x)%xmax=350.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='140341_CMS_H-hh-bbtautau_19.7fb-1' x=x+1 S95_t1(x)%id=17020321 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1701.02032 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=5.0D0 S95_t1(x)%xmax=15.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='170102032_CMS_HSM-aa-tautau_19.7fb-1' x=x+1 S95_t1(x)%id=17020322 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1701.02032 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=25.0D0 S95_t1(x)%xmax=62.5D0 S95_t1(x)%sep=0.5D0 S95_t1(x)%deltax=0.0D0 filename(x)='170102032_CMS_HSM-aa-mumubb_19.7fb-1' x=x+1 S95_t1(x)%id=17020323 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1701.02032 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=15.0D0 S95_t1(x)%xmax=62.5D0 S95_t1(x)%sep=0.5D0 S95_t1(x)%deltax=0.0D0 filename(x)='170102032_CMS_HSM-aa-mumutautau_19.7fb-1' x=x+1 S95_t1(x)%id=5051 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1509.05051 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=10.0D0 S95_t1(x)%xmax=61.75D0 S95_t1(x)%sep=0.05D0 S95_t1(x)%deltax=0.0D0 filename(x)='5051_Atlas_gg-H-aa-gagagaga_20.3fb-1' x=x+1 S95_t1(x)%id=1506534 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1510.06534 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=4.0D0 S95_t1(x)%xmax=8.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1506534_CMS_gg-H-hh-tautautautau_19.7fb-1' x=x+1 S95_t1(x)%id=17006 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG 17-006' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=36.0D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=260.0D0 S95_t1(x)%xmax=900.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='17006_CMS_H-hh-bbVV-bblnulnu_36fb-1' x=x+1 S95_t1(x)%id=011812 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1510.01181 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=220.0D0 S95_t1(x)%xmax=350.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='140342_CMS_A-hZ-tautaull_19.7fb-1' x=x+1 S95_t1(x)%id=044781 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='[hep-ex] arXiv:1502.04478 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=220.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='044781_ATLAS_gg-A-hZ-tautaull_20.3fb-1' x=x+1 S95_t1(x)%id=044782 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='[hep-ex] arXiv:1502.04478 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=220.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='044782_ATLAS_gg-A-hZ-bbll_20.3fb-1' x=x+1 S95_t1(x)%id=20160151 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-015' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=3.2D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=220.0D0 S95_t1(x)%xmax=2000.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='20160151_ATLAS_gg-A-hZ-bbll_3.2fb-1' x=x+1 S95_t1(x)%id=20160152 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-015' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=3.2D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=220.0D0 S95_t1(x)%xmax=2000.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='20160152_ATLAS_bb-A-hZ-bbll_3.2fb-1' x=x+1 S95_t1(x)%id=16002 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-16-002' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=2.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=260.0D0 S95_t1(x)%xmax=1200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='16002_CMS_H-hh-bbbb_2.3fb-1' ! x=x+1 ! S95_t1(x)%id=16029 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-16-029' ! S95_t1(x)%energy=13.0D0 ! S95_t1(x)%lumi=12.9D0 ! S95_t1(x)%SMlike=0 ! S95_t1(x)%xmin=250.0D0 ! S95_t1(x)%xmax=900.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=10.0D0 ! filename(x)='16029_CMS_H-hh-bbtautau_12.9fb-1' x=x+1 S95_t1(x)%id=17002 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-17-002' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=35.9D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=250.0D0 S95_t1(x)%xmax=900.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='17002_CMS_H-hh-tautaubb_35.9fb-1' x=x+1 S95_t1(x)%id=14013 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-14-013,arXiv:1503.04114 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=17.9D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=270.0D0 S95_t1(x)%xmax=1097.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='14013_H-hh-bbbb_17.9fb-1' !-------------------- H -> mu mu ------------------------- x=x+1 S95_t1(x)%id=2013010 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2013-010' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=21D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2013010_Atlas_H-mumu_21fb-1' x=x+1 S95_t1(x)%id=7663 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1406.7663 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=24.8D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=120.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='7663_Atlas_H-mumu_24.8fb-1' !------------------------ H W -> W W W -------------------------- x=x+1 S95_t1(x)%id=5873 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 5873' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=3.6D0 S95_t1(x)%xmin=120.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=20.0D0 filename(x)='D0_WH_WWW_llnunu_3.6fb_5873' x=x+1 S95_t1(x)%id=7307 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 7307 vs 3' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=2.7D0 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=10.0D0 filename(x)='CDF_WH_WWW_2.7fb_7307vs3.0' !filename(x)='CDF_WH_WWW_1.9fb_7307' x=x+1 S95_t1(x)%id=1268 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:1107.1268 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=5.3D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=115.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_VH_ll_5.3fb_1268' ! x=x+1 ! S95_t1(x)%id=11034 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-034' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.6D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11034_CMS_WH-WWW_4.6fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=12039 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-039' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=10.D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='12039_CMS_WH-WWW_10fb-1' x=x+1 S95_t1(x)%id=13009 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-009' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=25.D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='13009_CMS_WH-WWW_25fb-1' x=x+1 S95_t1(x)%id=12006 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-12-006' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=140.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='12006_CMS_WH-Wtautau_4.7fb-1' x=x+1 S95_t1(x)%id=12051 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-12-051' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=17.D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=145.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='12051_CMS_VH_Vtautau_17fb-1' x=x+1 S95_t1(x)%id=2012078 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-078' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=300.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012078_Atlas_WH_WWW_4.7fb-1' !-------------------- H -> gamma gamma -------------------- ! x=x+1 ! S95_t1(x)%id=6177 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6177' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=8.2D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=2.5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_gaga_8.2fb_6177' x=x+1 S95_t1(x)%id=6295 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6295' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=9.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=2.5D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_gaga_9.7fb_6295' x=x+1 S95_t1(x)%id=1887 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:0901.1887 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=2.7D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_Hgaga_2.7fb_1887' x=x+1 S95_t1(x)%id=10485 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10485' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=7.0D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_SM_Hgaga_7.0fb_10485' x=x+1 S95_t1(x)%id=4960 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='TCB' S95_t1(x)%label='[hep-ex] arXiv:1107.4960 (TEVNPHWG)'!CDF Note 10510, D0 Note 6203 S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=8.2D0 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_D0_combined_SM_Hgaga_8.2fb_4960' x=x+1 S95_t1(x)%id=1414 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1202.1414 (ATLAS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.9D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='1414_Atlas_H-gaga_4.9fb-1' ! x=x+1 ! S95_t1(x)%id=2012091 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2012-091' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=10.8D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=0.5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2012091_Atlas_H-gaga_10.8fb-1' x=x+1 S95_t1(x)%id=2012168 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-168' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=17.8D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=0.5D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012168_Atlas_H-gaga_17.8fb-1' x=x+1 S95_t1(x)%id=6583 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1407.6583' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=65.0D0 S95_t1(x)%xmax=600.0D0 S95_t1(x)%sep=0.1D0 S95_t1(x)%deltax=0.0D0 filename(x)='6583_Atlas_H-gaga_20.3fb-1' x=x+1 S95_t1(x)%id=059301 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1507.05930 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=140.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='05930_Atlas_gg-H-ZZ-20.3fb-1' x=x+1 S95_t1(x)%id=059302 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1507.05930 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=140.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='05930_Atlas_VBF-H-ZZ-20.3fb-1' x=x+1 S95_t1(x)%id=0038911 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1509.00389 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=100.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='0038911_Atlas_ggH-WW-NWA_20.3fb-1' x=x+1 S95_t1(x)%id=0038912 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1509.00389 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=100.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='0038912_Atlas_VBF-WW-NWA_20.3fb-1' x=x+1 S95_t1(x)%id=0038913 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1509.00389 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=20.0D0 S95_t1(x)%deltax=20.0D0 filename(x)='0038913_Atlas_ggH-WW-CPS_20.3fb-1' x=x+1 S95_t1(x)%id=0038914 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1509.00389 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=20.0D0 S95_t1(x)%deltax=20.0D0 filename(x)='0038914_Atlas_VBF-WW-CPS_20.3fb-1' ! x=x+1 ! S95_t1(x)%id=1487 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='[hep-ex] arXiv:1202.1487 (CMS)' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.8D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=0.5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='1487_CMS_H-gaga_4.8fb-1' ! x=x+1 ! S95_t1(x)%id=12001 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-001' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=4.76D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=0.5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='12001_CMS_H-gaga_BDT_4.8fb-1' ! x=x+1 ! S95_t1(x)%id=12015 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-12-015' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=9.9D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=0.5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='12015_CMS_H-gaga_9.9fb-1' ! x=x+1 S95_t1(x)%id=13001 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-001' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=25.D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=0.5D0 S95_t1(x)%deltax=0.0D0 filename(x)='13001_CMS_H-gaga_MVA_25fb-1' x=x+1 S95_t1(x)%id=14037 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-14-037' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=80.0D0 S95_t1(x)%xmax=110.0D0 S95_t1(x)%sep=0.5D0 S95_t1(x)%deltax=0.0D0 filename(x)='14037_CMS_H-gaga_19.7fb-1' x=x+1 S95_t1(x)%id=14031 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-14-031' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%SMlike=0 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=500.0D0 S95_t1(x)%sep=1.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='14031_CMS_H-Zgamma-19.7fb-1' ! x=x+1 ! S95_t1(x)%id=14006 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-14-006' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=19.7D0 ! S95_t1(x)%SMlike=0 ! S95_t1(x)%xmin=150.0D0 ! S95_t1(x)%xmax=847.6D0 ! S95_t1(x)%sep=0.1D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='14006_CMS_H-gaga_19.7fb-1' ! !-------------------- H -> gamma Z -------------------- ! x=x+1 ! S95_t1(x)%id=13006 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-13-006' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=25.D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=120.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=1.D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='13006_CMS_H-gaZ_25fb-1' x=x+1 S95_t1(x)%id=13075515 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='[hep-ex] arXiv:1307.5515 (CMS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=24.6D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=120.0D0 S95_t1(x)%xmax=160.0D0 S95_t1(x)%sep=0.1D0 S95_t1(x)%deltax=0.0D0 filename(x)='13075515_CMS_H-Zgamma_24.6fb-1' ! x=x+1 ! S95_t1(x)%id=2013009 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2013-009' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=25.D0 ! S95_t1(x)%SMlike=1 ! S95_t1(x)%xmin=120.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=1.D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2013009_Atlas_H-gaZ_25fb-1' x=x+1 S95_t1(x)%id=3051 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1402.3051 (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=24.8D0 S95_t1(x)%SMlike=1 S95_t1(x)%xmin=120.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=0.1D0 S95_t1(x)%deltax=0.0D0 filename(x)='3051_Atlas_H-Zga_24.8fb-1' !--------------------- b H -> b tau tau --------------------------- x=x+1 S95_t1(x)%id=4885 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:1106.4885 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=7.3D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=320.0D0 S95_t1(x)%sep=10.0D0 filename(x)='D0_Hb_tautaub_7.3fb_4885' ! x=x+1 ! S95_t1(x)%id=5985 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5985' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=2.7D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=320.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_bH_btautau_2.7fb_5985' ! x=x+1 ! S95_t1(x)%id=5974 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5974' ! S95_t1(x)%energy=1.96D0 ! S95_t1(x)%lumi=3.7D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_Hb_tautaub_3.7fb_5974' x=x+1 S95_t1(x)%id=6083 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 6083' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=4.3D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=200.0D0 S95_t1(x)%sep=10.0D0 filename(x)='D0_Hb_tautaub_4.3fb_6083' !-------------------- t t H -> t t b b -------------------- x=x+1 S95_t1(x)%id=5739 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='D0 Note 5739' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=2.1D0 S95_t1(x)%xmin=105.0D0 S95_t1(x)%xmax=155.0D0 S95_t1(x)%sep=10.0D0 filename(x)='D0_ttH_ttbb_2.1fb_5739' x=x+1 S95_t1(x)%id=10574 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 10574' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=7.5D0 S95_t1(x)%xmin=100.0D0 S95_t1(x)%xmax=170.0D0 S95_t1(x)%sep=5.0D0 filename(x)='CDF_ttH_ttbb_7.5fb_10574_interpol' x=x+1 S95_t1(x)%id=2012135 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2012-135' S95_t1(x)%energy=7D0 S95_t1(x)%lumi=4.7D0 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=140.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2012135_Atlas_ttH_Hbb_4.7fb-1' x=x+1 S95_t1(x)%id=12025 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-12-025' S95_t1(x)%energy=7D0 S95_t1(x)%lumi=5.D0 S95_t1(x)%xmin=110.0D0 S95_t1(x)%xmax=140.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='12025_CMS_ttH-ttbb_5fb-1' !-------------------- H -> Z gamma -------------------------- x=x+1 S95_t1(x)%id=0611 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:0806.0611 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=1.1D0 S95_t1(x)%xmin=120.0D0 S95_t1(x)%xmax=320.0D0 S95_t1(x)%sep=20.0D0 filename(x)='D0_H-Zgamma_1.0-1.1fb_0611' !x=x+1 !S95_t1(x)%id=6091 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 6091' !S95_t1(x)%xmin=115.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='D0_VH_ll_5.4fb_6091' !x=x+1 !S95_t1(x)%id=5858 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5858' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=2.5D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='D0_gaga_4.2fb_5858' !x=x+1 !S95_t1(x)%id=10065 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 10065' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=10.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_SM_Hgaga_5.4fb_10065' ! x=x+1 ! S95_t1(x)%id=0968 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='[hep-ex] arXiv:0912.0968 (D0)' ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=320.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_Hb_tautaub_2.7fb_0968' !---------------- Daniel's attempts -------------- x=x+1 S95_t1(x)%id=2016025 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-HIG-16-025' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=2.69D0 S95_t1(x)%xmin=550.0D0 S95_t1(x)%xmax=1200.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016025_CMS_H-bb_2.69fb-1' x=x+1 S95_t1(x)%id=201608391 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-1606-08391' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=3.2D0 S95_t1(x)%xmin=20.0D0 S95_t1(x)%xmax=60.0D0 S95_t1(x)%sep=0.5D0 S95_t1(x)%deltax=10.0D0 filename(x)='160608391_Atlas_HW_Waa_Wbbbb_3.2fb-1' x=x+1 S95_t1(x)%id=2016044 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-044' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.3D0 S95_t1(x)%xmin=250.0D0 S95_t1(x)%xmax=2500.0D0 S95_t1(x)%sep=2D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016044_Atlas_H_ZA_13.3fb-1' x=x+1 S95_t1(x)%id=2016004 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-004' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=3.2D0 S95_t1(x)%xmin=275.0D0 S95_t1(x)%xmax=400.0D0 S95_t1(x)%sep=1D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016004_Atlas_H-hh-bbgaga_3.2fb-1' x=x+1 S95_t1(x)%id=1604833 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-1606-04833' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=3.2D0 S95_t1(x)%xmin=500.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=10D0 S95_t1(x)%deltax=10.0D0 filename(x)='1604833_Atlas_H-VV_3.2fb-1' x=x+1 S95_t1(x)%id=2016056 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-056' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.3D0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=5D0 S95_t1(x)%deltax=10.0D0 filename(x)='2016056_Atlas_H-ZZ-llnunu_13.3fb-1' x=x+1 S95_t1(x)%id=20160551 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-055' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=15.5D0 S95_t1(x)%xmin=1200.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=100D0 S95_t1(x)%deltax=10.0D0 filename(x)='20160551_Atlas_pp-H-ZZ-qqqq_15.5fb-1' x=x+1 S95_t1(x)%id=20160552 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='ATLAS' S95_t1(x)%label='ATLAS-CONF-2016-055' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=15.5D0 S95_t1(x)%xmin=1200.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=100D0 S95_t1(x)%deltax=10.0D0 filename(x)='20160552_Atlas_pp-H-WW-qqqq_15.5fb-1' x=x+1 S95_t1(x)%id=15009 S95_t1(x)%particle_x=Hneut S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-2015-009' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%xmin=25.0D0 S95_t1(x)%xmax=60.0D0 S95_t1(x)%sep=0.1D0 S95_t1(x)%deltax=1.0D0 filename(x)='15009_CMS_bbA_mumu_19.7fb-1' !---------------- charged Higgs ------------------ x=x+1 S95_t1(x)%id=1811 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:0908.1811 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=1.0D0 S95_t1(x)%xmin=80.0D0 S95_t1(x)%xmax=155.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_Hp_qq_1.0fb_1811_interpol' x=x+1 S95_t1(x)%id=1269 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CDF' S95_t1(x)%label='[hep-ex] arXiv:0907.1269 (CDF) lower mass' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=2.2D0 S95_t1(x)%xmin=60.0D0 S95_t1(x)%xmax=70.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_t-Hplusb_1269_lowmass' x=x+1 S95_t1(x)%id=1270 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CDF' S95_t1(x)%label='[hep-ex] arXiv:0907.1269 (CDF) higher mass' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=2.2D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_t-Hplusb_1269_highmass' x=x+1 S95_t1(x)%id=7712 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 7712' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=0.192D0 S95_t1(x)%xmin=80.0D0 S95_t1(x)%xmax=160.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_t-Hplusb_tauonicHM_192pb_7712' x=x+1 S95_t1(x)%id=8353 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CDF' S95_t1(x)%label='CDF Note 8353' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=0.335D0 S95_t1(x)%xmin=80.0D0 S95_t1(x)%xmax=120.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='CDF_t-Hplusb_8353' x=x+1 S95_t1(x)%id=1812 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt=' D0' S95_t1(x)%label='[hep-ex] arXiv:0908.1811 (D0)' S95_t1(x)%energy=1.96D0 S95_t1(x)%lumi=1.0D0 S95_t1(x)%xmin=80.0D0 S95_t1(x)%xmax=155.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='D0_Hp_taunu_1.0fb_1811_interpol' x=x+1 S95_t1(x)%id=2011094 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2011-094' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=0.035D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=130.0D0 S95_t1(x)%sep=20.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2011094_Atlas_Hplus-cs_35pb-1' ! x=x+1 ! S95_t1(x)%id=2011138 ! S95_t1(x)%particle_x=Hplus ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-138' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.03D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=160.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011138_Atlas_Hp-taunu_1.03fb-1' ! x=x+1 ! S95_t1(x)%id=2011151 ! S95_t1(x)%particle_x=Hplus ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-151' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.03D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=160.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011151_Atlas_chargedH-taunu_1.03fb-1' x=x+1 S95_t1(x)%id=2760 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='ATL' S95_t1(x)%label='[hep-ex] arXiv:1204.2760 (ATLAS)' S95_t1(x)%energy=7.0D0 S95_t1(x)%lumi=4.6D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=160.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2760_Atlas_Hp_taunu_4.6fb-1' ! x=x+1 ! S95_t1(x)%id=2013090 ! S95_t1(x)%particle_x=Hplus ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2013-090' ! S95_t1(x)%energy=8.0D0 ! S95_t1(x)%lumi=19.5D0 ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=160.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2013090_Atlas_Hp_taunu_19.6fb-1' x=x+1 S95_t1(x)%id=2014050 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2014-050' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.5D0 S95_t1(x)%xmin=80.0D0 S95_t1(x)%xmax=160.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2014050_Atlas_Hp_taunu_19.5fb-1' + x=x+1 + S95_t1(x)%id=79151 + S95_t1(x)%particle_x=Hplus + S95_t1(x)%expt='ATL' + S95_t1(x)%label='[hep-ex] arXiv:1807.07915 (ATLAS)' + S95_t1(x)%energy=13.0D0 + S95_t1(x)%lumi=36.1D0 + S95_t1(x)%xmin=90.0D0 + S95_t1(x)%xmax=2000.0D0 + S95_t1(x)%sep=10.0D0 + S95_t1(x)%deltax=0.0D0 + filename(x)='079151_Atlas_tbHp-taunu_36fb-1' + + x=x+1 + S95_t1(x)%id=79152 + S95_t1(x)%particle_x=Hplus + S95_t1(x)%expt='ATL' + S95_t1(x)%label='[hep-ex] arXiv:1807.07915 (ATLAS)' + S95_t1(x)%energy=13.0D0 + S95_t1(x)%lumi=36.1D0 + S95_t1(x)%xmin=90.0D0 + S95_t1(x)%xmax=160.0D0 + S95_t1(x)%sep=10.0D0 + S95_t1(x)%deltax=0.0D0 + filename(x)='079152_Atlas_t-Hpb-taunu_36fb-1' + ! x=x+1 ! S95_t1(x)%id=11008 ! S95_t1(x)%particle_x=Hplus ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-008' ! S95_t1(x)%energy=7.0D0 ! S95_t1(x)%lumi=1.1D0 ! S95_t1(x)%xmin=80.0D0 ! S95_t1(x)%xmax=160.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11008_CMS_Hplus-taunu_1.1fb-1_interpol' x=x+1 S95_t1(x)%id=14020 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-14-020' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%xmin=80.0D0 S95_t1(x)%xmax=160.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='14020_CMS_Hp_taunu_19.7fb-1' x=x+1 S95_t1(x)%id=13035 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-13-035' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=160.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='13035_CMS_chargedH-cs_19.7fb-1' x=x+1 S95_t1(x)%id=16030 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-16-030' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=19.7D0 S95_t1(x)%xmin=90.0D0 S95_t1(x)%xmax=150.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='16030_CMS_t_Hplusb_cb_19.7fb-1' ! HB-5 x=x+1 S95_t1(x)%id=1504233 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='ATLAS' S95_t1(x)%label='arXiv:1503.04233 [hep-ex] (ATLAS)' S95_t1(x)%energy=8.0D0 S95_t1(x)%lumi=20.3D0 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=20.0D0 S95_t1(x)%deltax=10.0D0 filename(x)='1504233_Atlas_Hplus_VBF-WZ_20.3fb-1' x=x+1 S95_t1(x)%id=160312 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-16-031' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=12.9D0 S95_t1(x)%xmin=180.0D0 S95_t1(x)%xmax=3000.0D0 S95_t1(x)%sep=10.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='16031_CMS_Hptb_taunu_12.9fb-1' x=x+1 S95_t1(x)%id=160311 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='CMS' S95_t1(x)%label='CMS-PAS-HIG-16-031' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=12.9D0 S95_t1(x)%xmin=80.0D0 S95_t1(x)%xmax=160.0D0 S95_t1(x)%sep=5.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='160311_CMS_t_Hplusb_taunu_12.9fb-1' x=x+1 S95_t1(x)%id=2016088 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-088' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=14.7D0 S95_t1(x)%xmin=200.0D0 S95_t1(x)%xmax=2000.0D0 S95_t1(x)%sep=25.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2016088_Atlas_Hptb-taunutb_14.7fb-1' x=x+1 S95_t1(x)%id=2016089 S95_t1(x)%particle_x=Hplus S95_t1(x)%expt='ATL' S95_t1(x)%label='ATLAS-CONF-2016-089' S95_t1(x)%energy=13.0D0 S95_t1(x)%lumi=13.2D0 S95_t1(x)%xmin=300.0D0 S95_t1(x)%xmax=1000.0D0 S95_t1(x)%sep=50.0D0 S95_t1(x)%deltax=0.0D0 filename(x)='2016089_Atlas_Hptb-tbtb_13.2fb-1' !---------------------------------------------- !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ! superseded !x=x+1 !superseded by arXiv:1011.1931 !S95_t1(x)%id=3556 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='[hep-ex] arXiv:0805.3556 (D0)' !S95_t1(x)%xmin=90.0D0 !S95_t1(x)%xmax=220.0D0 !S95_t1(x)%sep=10.0D0 !filename(x)='D0_bbH_bb_1.0fb_3556_interpol' !x=x+1 !superseded by arXiv:1009.3047 !S95_t1(x)%id=3534 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='[hep-ex] arXiv:0908.3534 (CDF)' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_ZH_llbb_2.7fb_3534' !x=x+1 !superseded by CDF 10239 !S95_t1(x)%id=10217 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 10217' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_WH_lnubb_5.6fb_10217' !x=x+1 !superseded by CDF Note 10133 !S95_t1(x)%id=9248 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9248' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_SMcomb_tautau_2.0fb_9248_interpol' !x=x+1 !superseded by arXiv:1012.0874 !S95_t1(x)%id=1970 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='[hep-ex] arXiv:0808.1970 (D0)' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='D0_WH_lnubb_1.05fb_1970' !x=x+1 !S95_t1(x)%id=6095 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 6095' !S95_t1(x)%xmin=115.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='D0_H-WW_lljj_5.4fb_6095' !x=x+1 !S95_t1(x)%id=5972 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5972' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='D0_WH_lnubb_5.0fb_5972' !x=x+1 !S95_t1(x)%id=10068 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 10068' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_WH_lnubb_4.8fb_10068' !x=x+1 !S95_t1(x)%id=5586 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5586' !S95_t1(x)%xmin=105.0D0 !S95_t1(x)%xmax=145.0D0 !S95_t1(x)%sep=10.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='D0_ZH_nunubb_2.1fb_5586' !x=x+1 !S95_t1(x)%id=9891 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9891' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_VH_Metbb_3.6fb_9891' !x=x+1 !S95_t1(x)%id=5876 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5876' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='D0_ZH_llbb_4.2fb_5876' !x=x+1 !S95_t1(x)%id=9889 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9889' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_ZH_llbb_4.1fb_9889' !x=x+1 !S95_t1(x)%id=9284 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9284' !S95_t1(x)%xmin=90.0D0 !S95_t1(x)%xmax=210.0D0 !S95_t1(x)%sep=10.0D0 !filename(x)='CDF_bbH_bb_1.9fb_9284' !x=x+1 !S95_t1(x)%id=9868 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9868' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_WH_lnubb_4.3fb_9868' !http://www-cdf.fnal.gov/physics/new/hdg/results/whlnubb_090814/WH4.3fb.html !x=x+1 !S95_t1(x)%id=9887 !superseded by arXiv:1001.4468 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9887' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_H-WW_4.8fb_9887_interpol' !x=x+1 !S95_t1(x)%id=0024 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='[hep-ex] arXiv:0811.0024v1 (D0)' !S95_t1(x)%xmin=90.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=10.0D0 !filename(x)='D0_bH_btautau_328pb_0024' !x=x+1 !S95_t1(x)%id=1266 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='[hep-ex] arXiv:0808.1266 (D0)' !S95_t1(x)%xmin=105.0D0 !S95_t1(x)%xmax=135.0D0 !S95_t1(x)%sep=10.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='D0_VH_bb_0.93fb_1266' !x=x+1 !S95_t1(x)%id=0432 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='[hep-ex] arXiv:0802.0432 (CDF)' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=140.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_VH_Metbb_1fb_0432' !x=x+1 !S95_t1(x)%id=9674 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9674' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_SM_combined_2.0-3.0fb_9674_interpol' !x=x+1 !S95_t1(x)%id=5980 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='TCB' !S95_t1(x)%label='D0 Note 5980, CDF Note 9888' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=10.0D0 !filename(x)='CDF_D0_combinedH-tautau_2.2fb_5980' !x=x+1 !S95_t1(x)%id=9714 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='TCB' !S95_t1(x)%label='arXiv:0903.4001 (TEVNPHWG), MH>=155GeV'!CDF Note 9713, D0 Note 5889 !S95_t1(x)%xmin=155.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_D0_SM_combined_4.2fb_9713-5889_bayesian_highmassonly' !x=x+1 !S95_t1(x)%id=9897 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9897' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_SM_combined_2.0-4.8fb_9897_interpol' !x=x+1 !S95_t1(x)%id=8742 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 8742' ! table from CDF note 8742 !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_ZH_llbb_1fb_8742_interpol' ! x=x+1 ! S95_t1(x)%id=7081 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='arxiv 070810 (CDF)' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_ZH_nunubb_1.7fb_070810_interpol' ! ! x=x+1 ! ! S95_t1(x)%id=8958 ! ! S95_t1(x)%particle_x=Hneut ! ! S95_t1(x)%expt='CDF' ! ! S95_t1(x)%label='CDF Note 8958' ! ! S95_t1(x)%xmin=110.0D0 ! ! S95_t1(x)%xmax=200.0D0 ! ! S95_t1(x)%sep=10.0D0 ! ! filename(x)='CDF_ggH_WW_1.9fb_8958' ! x=x+1 ! S95_t1(x)%id=8957 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 8957' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='CDF_WH_lnubb_1.7fb_8957_interpol' ! x=x+1 ! S95_t1(x)%id=5489 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5489' ! S95_t1(x)%xmin=120.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=20.0D0 ! filename(x)='D0_ppH_WW_emu_0.6fb_5489' !x=x+1 !S95_t1(x)%id=5537 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5537' !S95_t1(x)%xmin=120.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=20.0D0 !filename(x)='D0_ppH_WW_ll_1.7fb_5537' ! x=x+1 ! S95_t1(x)%id=5482 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5482' ! S95_t1(x)%xmin=105.0D0 ! S95_t1(x)%xmax=145.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_ZH_llbb_1.1fb_5482' ! x=x+1 ! S95_t1(x)%id=5624 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5624' ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='D0_ppH_WW_ll_2.3fb_5624' !x=x+1 !S95_t1(x)%id=5472 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5472' !S95_t1(x)%xmin=105.0D0 !S95_t1(x)%xmax=145.0D0 !S95_t1(x)%sep=10.0D0 !!filename(x)='D0_WH_lnubb_1.7fb_5472' !filename(x)='D0_WH_lnubb_1.7fb_5472_Fig.6a' !x=x+1 !S95_t1(x)%id=5502 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5502' !S95_t1(x)%xmin=120.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=20.0D0 !filename(x)='D0_ppH_WW_ee_0.6fb_5502' !x=x+1 !S95_t1(x)%id=5332 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5332' !S95_t1(x)%xmin=120.0D0 !S95_t1(x)%xmax=180.0D0 !S95_t1(x)%sep=20.0D0 !filename(x)='D0_ppH_WW_mutau_1fb_5332' !x=x+1 !S95_t1(x)%id=5485 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5485' !S95_t1(x)%xmin=120.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=20.0D0 !filename(x)='D0_WH_WWW_llnunu_1fb_5485' !x=x+1 !S95_t1(x)%id=9071 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9071' !S95_t1(x)%xmin=90.0D0 !S95_t1(x)%xmax=250.0D0 !S95_t1(x)%sep=10.0D0 !filename(x)='CDF_ppH_tautau_1.8fb_9071_interpol' !x=x+1 !S95_t1(x)%id=5331 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5331' !S95_t1(x)%xmin=90.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=10.0D0 !filename(x)='D0_ppH_tautau_1fb_5331_interpol' ! x=x+1 ! S95_t1(x)%id=5503 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5503' ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=170.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_bbH_bb_0.9fb_5503_interpol' !x=x+1 !S95_t1(x)%id=8954 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 8954' !S95_t1(x)%xmin=90.0D0 !S95_t1(x)%xmax=210.0D0 !S95_t1(x)%sep=10.0D0 !filename(x)='CDF_bbH_bb_1fb_8954' ! x=x+1 ! S95_t1(x)%id=9236 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 9236' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='CDF_ggH_WW_2.4fb_9236' ! x=x+1 ! S95_t1(x)%id=9219 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 9219' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='CDF_WH_lnubb_1.9fb_9219' ! x=x+1 ! S95_t1(x)%id=5601 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5601' ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_Hgaga_2.27fb_5601' !taken out until we sort out a fermiophobic-ness test !x=x+1 !S95_t1(x)%id=1514 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='[hep-ex] arXiv:0803.1514v1 (D0)' !S95_t1(x)%xmin=70.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=10.0D0 !filename(x)='D0_gaga_1.1fb_1514' ! x=x+1 ! S95_t1(x)%id=9166 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 9166' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_VH_Metbb_1.97fb_9166_interpol' !x=x+1 !S95_t1(x)%id=9463 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9463' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_WH_lnubb_2.7fb_9463' !x=x+1 !S95_t1(x)%id=5570 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5570' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='D0_ZH_llbb_2.3fb_5570' !x=x+1 !S95_t1(x)%id=4493 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='[hep-ex] arXiv:0807.4493 (CDF)' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_ZH_llbb_1fb_4493_interpol' !x=x+1 !S95_t1(x)%id=9475 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9475' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_ZH_llbb_2.4fb_9475' !x=x+1 !S95_t1(x)%id=5737 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5737' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='D0_gaga_2.68fb_5737' !x=x+1 !S95_t1(x)%id=9483 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF note 9483' !S95_t1(x)%xmin=105.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_VH_Metbb_2.1fb_9483' !x=x+1 !S95_t1(x)%id=9500 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9500' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_ggH_WW_3.0fb_9500_interpol' !x=x+1 !S95_t1(x)%id=9713 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='TCB' !S95_t1(x)%label='CDF Note 9713, D0 Note 5889' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_D0_SM_combined_4.2fb_9713-5889_bayesian' ! x=x+1 ! S95_t1(x)%id=1024 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note XXXX, zhllbb_081024' ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='CDF_ZH_llbb_2.7fb_1024' !x=x+1 !S95_t1(x)%id=9596 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9596' !S95_t1(x)%xmin=100.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_WH_lnubb_2.7fb_9596' ! x=x+1 ! S95_t1(x)%id=5828 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 5828' ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='D0_WH_lnubb_2.7fb_5828' !x=x+1 !S95_t1(x)%id=9642 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9642' !S95_t1(x)%xmin=105.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_VH_Metbb_2.1fb_9642' ! x=x+1 ! S95_t1(x)%id=9022 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='CDF Note 9764,"old" ggH XS' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_H-WW_3.6fb_9022_interpol' !NEW! not yet in OB's code !x=x+1 !S95_t1(x)%id=9023 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 9764,"new" ggH XS' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_H-WW_3.6fb_9023_interpol' ! x=x+1 ! S95_t1(x)%id=3493 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CDF' ! S95_t1(x)%label='[hep-ex] arXiv:0803.3493v1 (CDF)' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! filename(x)='CDF_WH_lnubb_1fb_3493_interpol' !x=x+1 !S95_t1(x)%id=0710 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note XXXX,hwwmenn_090710' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_H-WW_4.8fb_0710_interpol' !x=x+1 !S95_t1(x)%id=5984 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 5984,high mass' !S95_t1(x)%xmin=155.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='D0_SM_combined_5984_highmassonly' !x=x+1 !S95_t1(x)%id=3155 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='[hep-ex] arXiv:0905.3155 (CDF)' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_WH_lnubb_1.9fb_3155_interpol' ! x=x+1 ! S95_t1(x)%id=9997 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='TCB' ! S95_t1(x)%label='arXiv:0911.3930 (TEVNPHWG), MH>=160GeV'!CDF Note 9998, D0 Note 5983 ! S95_t1(x)%xmin=160.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='CDF_D0_SM_combined_2.1-5.4fb_9998-5983_bayesian_highmassonly' !x=x+1 !S95_t1(x)%id=6039 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='TCB' !S95_t1(x)%label='CDF Note 10101, D0 Note 6039' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=260.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_D0_combined_gg-H-WW_4.8-5.4fb_6039_bayesian_interpol' !x=x+1 !S95_t1(x)%id=6006 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt=' D0' !S95_t1(x)%label='D0 Note 6006' !S95_t1(x)%xmin=115.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='D0_H-WW_ll_5.4fb_6006' !x=x+1 !S95_t1(x)%id=2011026 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-026' !S95_t1(x)%xmin=200.0D0 !S95_t1(x)%xmax=600.0D0 !S95_t1(x)%sep=20.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='2011026_Atlas_H-VV_35pb-1' !x=x+1 !superseded by 2011085 !S95_t1(x)%id=2011025 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-025' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=140.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='2011025_Atlas_H-gaga_37.6pb-1_interpol' !x=x+1 !S95_t1(x)%id=2011005 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-005' !S95_t1(x)%xmin=120.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='2011005_Atlas_H-WW_35pb-1_interpol' !x=x+1 !S95_t1(x)%id=10433 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 10432' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=300.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='CDF_ggH-WW_7.1fb_10433_SMnormalized' !x=x+1 !S95_t1(x)%id=10432 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='CDF' !S95_t1(x)%label='CDF Note 10432' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=200.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='CDF_H-WW_7.1fb_10432' ! x=x+1 ! S95_t1(x)%id=6170 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6170' ! S95_t1(x)%xmin=100.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_ZH_bb_6.2fb_6170' ! x=x+1 ! S95_t1(x)%id=6182 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6182' ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=200.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='D0_H-VV_8.1fb_6182' !x=x+1 superseded by 2011131 !S95_t1(x)%id=2011048 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-048' !S95_t1(x)%xmin=120.0D0 !S95_t1(x)%xmax=600.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='2011048_Atlas_H-ZZ-4l_40pb-1_interpol' !x=x+1 !S95_t1(x)%id=2011085 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-085' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=140.0D0 !S95_t1(x)%sep=1.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='2011085_Atlas_H-gaga_209pb-1' ! x=x+1 ! S95_t1(x)%id=2748 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='[hep-ex] arXiv:1106.2748 (ATLAS)' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2748_Atlas_SMcombined_40pb-1' !x=x+1 !S95_t1(x)%id=11002 !S95_t1(x)%particle_x=Hplus !S95_t1(x)%expt='CMS' !S95_t1(x)%label='CMS-PAS-HIG-11-002' !S95_t1(x)%xmin=80.0D0 !S95_t1(x)%xmax=160.0D0 !S95_t1(x)%sep=5.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='11002_CMS_t-Hplusb_36pb-1' !x=x+1 !S95_t1(x)%id=2011020 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-020, lower masses' !S95_t1(x)%xmin=6.1D0 !S95_t1(x)%xmax=9.0D0 !S95_t1(x)%sep=0.1D0 !filename(x)='2011020_Atlas_H-mumu_lowerMa_35pb-1' !x=x+1 !S95_t1(x)%id=2011021 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-020, higher masses' !S95_t1(x)%xmin=11.0D0 !S95_t1(x)%xmax=11.9D0 !S95_t1(x)%sep=0.1D0 !filename(x)='2011021_Atlas_H-mumu_higherMa_35pb-1' ! x=x+1 ! S95_t1(x)%id=11003 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-003' ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11003_CMS_H-WW_1.1fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=11004 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-004' ! S95_t1(x)%xmin=120.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11004_CMS_H-ZZ-llll_1.13fb-1' ! x=x+1 ! S95_t1(x)%id=11005 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-005' ! S95_t1(x)%xmin=250.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11005_CMS_H-ZZ-llnunu_1.1fb-1' ! x=x+1 ! S95_t1(x)%id=11006 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-006' ! S95_t1(x)%xmin=230.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11006_CMS_H-ZZ-llqq_1fb-1' ! x=x+1 ! S95_t1(x)%id=11009 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-009' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=140.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11009_CMS_SM_H-tautau_1.1fb-1' ! x=x+1 ! S95_t1(x)%id=11010 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-010' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=140.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11010_CMS_H-gammagamma_1.09fb-1' !x=x+1 !S95_t1(x)%id=2011111 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-111' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=240.0D0 !S95_t1(x)%sep=5.0D0 !filename(x)='2011111_Atlas_H-WW_1.04fb-1_interpol' !x=x+1 !S95_t1(x)%id=2011131 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-131' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=600.0D0 !S95_t1(x)%sep=2.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='2011131_Atlas_H-ZZ_1.1fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=11012 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-012' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=135.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11012_CMS_H-bb_1.1fb-1' ! x=x+1 ! S95_t1(x)%id=11013 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-013' ! S95_t1(x)%xmin=180.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=10.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11013_CMS_H-ZZ-lltautau_1.1fb-1' ! x=x+1 ! S95_t1(x)%id=11014 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-014' ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11014_CMS_H-WW_1.55fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=11015 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-015' ! S95_t1(x)%xmin=115.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11015_CMS_H-ZZ-4l_1.66fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=11016 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-016' ! S95_t1(x)%xmin=250.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11016_CMS_H-ZZ-llnunu_1.6fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=11017 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-017' ! S95_t1(x)%xmin=225.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11017_CMS_H-ZZ-llqq_1.6fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=11020 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-020' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=145.0D0 ! S95_t1(x)%sep=5.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11020_CMS_H-tautau_1.6fb-1_SM' ! x=x+1 ! S95_t1(x)%id=11021 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-021' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11021_CMS_SM_H-gaga_1.66fb-1' !n.b.: Need fermiophobic-ness check for this analysis ! x=x+1 ! S95_t1(x)%id=110212 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-021' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='110212_CMS_Fermiophob_H-gaga_1.66fb-1' ! x=x+1 ! S95_t1(x)%id=11022 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-022' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11022_CMS_SMcombined_1.1-1.7fb-1' ! x=x+1 ! S95_t1(x)%id=5895 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='[hep-ex] arXiv:1108.5895 (ATLAS)' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='5895_Atlas_H-gaga_1.08fb-1' ! x=x+1 ! S95_t1(x)%id=110201 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-020' ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=500.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='11020_CMS_H-tautau_1.6fb-1_MSSM_interpol' !x=x+1 !S95_t1(x)%id=2011161 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-161' !S95_t1(x)%xmin=110.0D0 !S95_t1(x)%xmax=150.0D0 !S95_t1(x)%sep=1.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='2011161_Atlas_H-gaga_4.9fb-1' ! x=x+1 ! S95_t1(x)%id=2011162 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='ATL' ! S95_t1(x)%label='ATLAS-CONF-2011-162' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='2011162_Atlas_H-ZZ-4l_4.8fb-1' ! x=x+1 ! S95_t1(x)%id=11024 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-024' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11024_CMS_H-WW-lnulnu_4.6fb-1_interpol' ! x=x+1 ! S95_t1(x)%id=11025 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-025' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11025_CMS_H-ZZ-4l_4.7fb-1' ! x=x+1 ! S95_t1(x)%id=11026 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-026' ! S95_t1(x)%xmin=250.0D0 ! S95_t1(x)%xmax=590.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11026_CMS_H-ZZ-llnunu_4.6fb-1' ! x=x+1 ! S95_t1(x)%id=110271 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-027' ! S95_t1(x)%xmin=130.0D0 ! S95_t1(x)%xmax=164.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='110271_CMS_H-ZZ-llqq_4.6fb-1' ! x=x+1 ! S95_t1(x)%id=110272 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-027' ! S95_t1(x)%xmin=200.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='110272_CMS_H-ZZ-llqq_4.6fb-1' ! x=x+1 ! S95_t1(x)%id=11028 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-028' ! S95_t1(x)%xmin=190.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11028_CMS_H-ZZ-lltautau_4.7fb-1' ! x=x+1 ! S95_t1(x)%id=11030 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-030' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=150.0D0 ! S95_t1(x)%sep=0.5D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11030_CMS_H-gaga_4.8fb-1' ! x=x+1 ! S95_t1(x)%id=11032 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt='CMS' ! S95_t1(x)%label='CMS-PAS-HIG-11-032' ! S95_t1(x)%xmin=110.0D0 ! S95_t1(x)%xmax=600.0D0 ! S95_t1(x)%sep=1.0D0 ! S95_t1(x)%deltax=0.0D0 ! filename(x)='11032_CMS_SMcombined_4.7fb-1' !x=x+1 !S95_t1(x)%id=2011150 !S95_t1(x)%particle_x=Hneut !S95_t1(x)%expt='ATL' !S95_t1(x)%label='ATLAS-CONF-2011-150' !S95_t1(x)%xmin=200.0D0 !S95_t1(x)%xmax=600.0D0 !S95_t1(x)%sep=20.0D0 !S95_t1(x)%deltax=0.0D0 !filename(x)='2011150_Atlas_H-ZZ-llqq_2.05fb-1' ! x=x+1 ! S95_t1(x)%id=6224 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6227, Br(h->tautau)>6%' ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_h-bb_h-tautau_comb_Br0.06_5.2-7.3fb_6224' ! ! x=x+1 ! S95_t1(x)%id=6225 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6227, Br(h->tautau)>10%' ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_h-bb_h-tautau_comb_Br0.10_5.2-7.3fb_6225' ! ! x=x+1 ! S95_t1(x)%id=6226 ! S95_t1(x)%particle_x=Hneut ! S95_t1(x)%expt=' D0' ! S95_t1(x)%label='D0 Note 6227, Br(h->tautau)>14%' ! S95_t1(x)%xmin=90.0D0 ! S95_t1(x)%xmax=300.0D0 ! S95_t1(x)%sep=10.0D0 ! filename(x)='D0_h-bb_h-tautau_comb_Br0.14_5.2-7.3fb_6226' ! checks we've filled the whole array if(x.ne.xend)then stop 'error in initializetables1 (a)' endif ! do loop to read in S95 tables col=3 do x=xbeg,xend S95_t1(x)%nx=nint((S95_t1(x)%xmax-S95_t1(x)%xmin)/S95_t1(x)%sep)+1 allocate(S95_t1(x)%dat(S95_t1(x)%nx,col-1)) enddo open(file_id_common2,file = trim(adjustl(pathname))//'Expt_tables/' // & & 'S95_t1.binary',form='unformatted') read(file_id_common2,iostat=ios)S95_t1(xbeg)%dat if(ios.eq.0)then do x=xbeg+1,xend read(file_id_common2)S95_t1(x)%dat enddo else rewind(file_id_common2) do x=xbeg,xend fullfilename=trim(adjustl(pathname))//'Expt_tables/' & & //trim(adjustl(S95_t1(x)%expt))//'tables/' & & //trim(filename(x))//'.txt' call read_tabletype1(S95_t1(x),5,col,fullfilename) #ifndef WEBVERSION write(file_id_common2)S95_t1(x)%dat #endif enddo endif close(file_id_common2) deallocate(filename) end subroutine initializetables1 !************************************************************ subroutine read_tabletype1(t1,skip,col,fullfilename) !************************************************************ !fills t1%dat !--------------------------------------input type(table1) :: t1 integer :: skip,col character(LEN=*) :: fullfilename !-----------------------------------internal integer :: i,n double precision :: xdummy,xdummy_store !------------------------------------------- t1%dat=0.0D0 open(file_id_1, file=(trim(fullfilename))) do i=1,skip read(file_id_1,*) !skip lines enddo xdummy_store = t1%xmin-t1%sep do i=1,t1%nx read(file_id_1,*)xdummy,(t1%dat(i,n),n=1,col-1) ! if(minval(t1%dat(i,:)).lt.0) then ! write(*,*) xdummy,minval(t1%dat(i,:)) ! endif ! checks that x are evenly spaced as expected if((abs(xdummy-xdummy_store-t1%sep).gt.1.0D-7) & & .or.(abs(xdummy-(t1%xmin+dble(i-1)*t1%sep)).gt.1.0D-7))then write(*,*)i,t1%id,xdummy,t1%xmin+dble(i-1)*t1%sep stop 'error in read_tabletype1 (a1)' endif xdummy_store=xdummy enddo if(abs(xdummy-t1%xmax).gt.1.0D-7)stop 'error in read_tabletype1 (a2)' close(file_id_1) end subroutine read_tabletype1 !************************************************************ end module S95tables_type1 !************************************************************ Index: trunk/HiggsBounds-5/minipaper.pdf =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Index: trunk/HiggsBounds-5/theo_manip.f90 =================================================================== --- trunk/HiggsBounds-5/theo_manip.f90 (revision 569) +++ trunk/HiggsBounds-5/theo_manip.f90 (revision 570) @@ -1,1808 +1,1856 @@ ! This file is part of HiggsBounds ! -KW !****************************************************************** module theo_manip !****************************************************************** !use S95tables_type1 use usefulbits, only : ndat,np,Hneut,Hplus,theo,partR,hadroncolliderextras,pdesc implicit none type(hadroncolliderextras) :: tevS(1) ! OBSOLETE ! type(hadroncolliderextras) :: lhc7S(1) ! OBSOLETE ! type(hadroncolliderextras) :: lhc8S(1) ! OBSOLETE ! contains !******************************************************************* ! NEW HB-5 routines: !******************************************************************* subroutine HB5_complete_theo !******************************************************************* use usefulbits, only : whichanalyses,whichinput,ndat,BRdirectinput implicit none if(np(Hneut)>0) then select case(whichinput) case('effC') call HB5_csratios_from_effC ! (DONE, needs adjustments) call HB5_cp_from_effC if(.not.BRdirectinput) then call HB5_br_from_effC endif case('SLHA') call HB5_csratios_from_effC call HB5_cp_from_effC case('hadr') case default stop 'error in subroutine complete_theo (2): unknown whichinput!' end select endif call complete_BRs call check_dataset ! Checks consistency in BRs and total width if(np(Hneut)>0)then select case(whichanalyses) case('onlyH','LandH','onlyP','list ') ! n.b. there's no LEP SM cross sections at the moment call fill_theo_SM ! HB-5.2: calculate hadronic channelrates (need SM reference values) call complete_channelrates case('onlyL') case default stop 'error in subroutine complete_theo (2): unknown whichinput!' end select endif end subroutine HB5_complete_theo !******************************************************************* subroutine HB5_recalculate_theo_for_datapoint(n) !******************************************************************* ! Does the same as complete_theo but just for the datapoint n. use usefulbits, only : whichanalyses,whichinput,BRdirectinput implicit none integer, intent(in) :: n if(np(Hneut)>0) then select case(whichinput) case('effC') call HB5_csratios_from_effC_for_datapoint(n) if(.not.BRdirectinput) then call HB5_br_from_effC_for_datapoint(n) endif case('SLHA') call HB5_csratios_from_effC_for_datapoint(n) case('hadr','part') case default stop 'error in subroutine recalculate_theo_for_datapoint (1)' end select endif call check_dataset ! Checks consistency in BRs and total width if(np(Hneut)>0)then select case(whichanalyses) case('onlyH','LandH','onlyP','list ') ! n.b. there's no LEP SM cross sections at the moment call fill_theo_SM_for_datapoint(n) case('onlyL') case default stop 'error in subroutine recalculate_theo_for_datapoint (2)' end select endif ! DEBUGGING: ! write(*,*) '# --------- complete_theo debugging --------- #' ! write(*,*) 'XS(ggH)_norm at TeV: ', theo(1)%tev%XS_gg_hj_ratio ! write(*,*) 'XS(bbH)_norm at TeV: ', theo(1)%tev%XS_bb_hj_ratio ! write(*,*) 'XS(VBF)_norm at Tev: ', theo(1)%tev%XS_vbf_ratio ! write(*,*) 'XS(HZ)_norm at Tev: ', theo(1)%tev%XS_hjZ_ratio ! write(*,*) 'XS(HW)_norm at TeV: ', theo(1)%tev%XS_hjW_ratio ! write(*,*) 'XS(ttH)_norm at TeV: ', theo(1)%tev%XS_tthj_ratio ! write(*,*) 'XS(tH)_norm at TeV: ', theo(1)%tev%XS_thj_tchan_ratio ! ! write(*,*) 'XS(ggH)_norm at 7 TeV: ', theo(1)%lhc7%XS_gg_hj_ratio ! write(*,*) 'XS(bbH)_norm at 7 TeV: ', theo(1)%lhc7%XS_bb_hj_ratio ! write(*,*) 'XS(VBF)_norm at 7 Tev: ', theo(1)%lhc7%XS_vbf_ratio ! write(*,*) 'XS(HZ)_norm at 7 TeV: ', theo(1)%lhc7%XS_hjZ_ratio ! write(*,*) 'XS(HW)_norm at 7 TeV: ', theo(1)%lhc7%XS_hjW_ratio ! write(*,*) 'XS(ttH)_norm at 7 TeV: ', theo(1)%lhc7%XS_tthj_ratio ! write(*,*) 'XS(tH)_norm at 7 TeV: ', theo(1)%lhc7%XS_thj_tchan_ratio ! ! write(*,*) 'XS(ggH)_norm at 8 TeV: ', theo(1)%lhc8%XS_gg_hj_ratio ! write(*,*) 'XS(bbH)_norm at 8 TeV: ', theo(1)%lhc8%XS_bb_hj_ratio ! write(*,*) 'XS(VBF)_norm at 8 Tev: ', theo(1)%lhc8%XS_vbf_ratio ! write(*,*) 'XS(HZ)_norm at 8 TeV: ', theo(1)%lhc8%XS_hjZ_ratio ! write(*,*) 'XS(HW)_norm at 8 TeV: ', theo(1)%lhc8%XS_hjW_ratio ! write(*,*) 'XS(ttH)_norm at 8 TeV: ', theo(1)%lhc8%XS_tthj_ratio ! write(*,*) 'XS(tH)_norm at 8 TeV: ', theo(1)%lhc8%XS_thj_tchan_ratio ! ! write(*,*) 'XS(ggH)_norm at 13 TeV: ', theo(1)%lhc13%XS_gg_hj_ratio ! write(*,*) 'XS(bbH)_norm at 13 TeV: ', theo(1)%lhc13%XS_bb_hj_ratio ! write(*,*) 'XS(VBF)_norm at 13 Tev: ', theo(1)%lhc13%XS_vbf_ratio ! write(*,*) 'XS(HZ)_norm at 13 TeV: ', theo(1)%lhc13%XS_hjZ_ratio ! write(*,*) 'XS(HW)_norm at 13 TeV: ', theo(1)%lhc13%XS_hjW_ratio ! write(*,*) 'XS(ttH)_norm at 13 TeV: ', theo(1)%lhc13%XS_tthj_ratio ! write(*,*) 'XS(tH)_norm at 13 TeV: ', theo(1)%lhc13%XS_thj_tchan_ratio ! write(*,*) '# --------- end debugging --------- #' ! ------ end subroutine HB5_recalculate_theo_for_datapoint !******************************************************************* subroutine HB5_csratios_from_effC ! calls the subroutine csratios_from_effC_for_datapoint for each ! datapoint !***************************************************************** use usefulbits, only : ndat implicit none !--------------------------------------internal integer :: jj !--------------------------------------------- if(np(Hneut)<1) stop 'error in csratios_from_g2 (np(Hneut))' do jj=1,ndat call HB5_csratios_from_effC_for_datapoint(jj) enddo end subroutine HB5_csratios_from_effC !****************************************************************** subroutine HB5_csratios_from_effC_for_datapoint(jj) ! uses the effective couplings contained in effC to calculate ! the hadronic cross section ratios !***************************************************************** use usefulbits, only : effC use theory_colliderSfunctions ! TODO: this includes the ratio functions, needs to be cleaned! use theory_XS_SM_functions use S95tables, only : inrange implicit none integer, intent(in) :: jj !--------------------------------------internal integer :: i,j double precision :: TEVSM_ZZ_contrib_to_VBF,TEVSM_WW_contrib_to_VBF double precision :: Mhi integer :: kk ! DEBUG int !--------------------------------------------- ! relative contributuion of WW- and ZZ-fusion to VBF (in LO) for ! p p-bar collisions at SqrtS=1.96 TeV (calcuated by T. Figy with VBFNLO):s TEVSM_ZZ_contrib_to_VBF=0.23D0 TEVSM_WW_contrib_to_VBF=0.77D0 do i=1,np(Hneut) Mhi=theo(jj)%particle(Hneut)%M(i) !---------------------------------------! ! LEP ! !---------------------------------------! theo(jj)%lep%XS_hjZ_ratio(i) = effC(jj)%hjZZ(i)**2 theo(jj)%lep%XS_bbhj_ratio(i) = effC(jj)%hjbb_s(i)**2+effC(jj)%hjbb_p(i)**2 !n.b.: LEP tables with bbhj at the moment can not be applied to mixed CP Higgs theo(jj)%lep%XS_tautauhj_ratio(i) = effC(jj)%hjtautau_s(i)**2+effC(jj)%hjtautau_p(i)**2 !n.b.: LEP tables with tautauhj at the moment can not be applied to mixed CP Higgs !---------------------------------------! ! TEVATRON ! !---------------------------------------! theo(jj)%tev%XS_gg_hj_ratio(i) = effC(jj)%hjgg(i)**2 theo(jj)%tev%XS_bb_hj_ratio(i) = effC(jj)%hjbb_s(i)**2 + effC(jj)%hjbb_p(i)**2 theo(jj)%tev%XS_hjb_ratio(i) = effC(jj)%hjbb_s(i)**2 + effC(jj)%hjbb_p(i)**2 ! still needed? ! calculate inclusive single Higgs production: ! n.b.: neglect cc,ss->hj for inclusive single Higgs production (in effC approximation) if(inrange(Mhi,'TEV '))then theo(jj)%tev%XS_hj_ratio(i) = ( theo(jj)%tev%XS_gg_hj_ratio(i)*XS_tev_gg_H_SM(Mhi) + & & theo(jj)%tev%XS_bb_hj_ratio(i)*XS_tev_bb_H_SM(Mhi))/ & & ( XS_tev_gg_H_SM(Mhi) + XS_tev_bb_H_SM(Mhi) ) else theo(jj)%tev%XS_hj_ratio(i) = 0.0D0 endif theo(jj)%tev%XS_vbf_ratio(i) = effC(jj)%hjWW(i)**2*TEVSM_WW_contrib_to_VBF & & + effC(jj)%hjZZ(i)**2*TEVSM_ZZ_contrib_to_VBF theo(jj)%tev%XS_tthj_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 theo(jj)%tev%XS_thj_tchan_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 theo(jj)%tev%XS_thj_schan_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 ! n.b.: Tev tables for tthj at the moment can only use CP even Higgs if(inrange(Mhi,'TEV '))then ! WARNING: This implementation is preliminary. Don't know how to treat a pseudoscalar ! Higgs-fermion coupling here (nobody has ever calculated this!). theo(jj)%tev%XS_hjW_ratio(i) = ( & & XS_WHcoeff(Mhi,'TEV ',1,.True.,.True.)*( effC(jj)%hjtt_s(i)**2 )+ & & XS_WHcoeff(Mhi,'TEV ',2,.True.,.True.)*( effC(jj)%hjbb_s(i)**2 )+ & & XS_WHcoeff(Mhi,'TEV ',3,.True.,.True.)* effC(jj)%hjWW(i)**2 + & & XS_WHcoeff(Mhi,'TEV ',4,.True.,.True.)* effC(jj)%hjtt_s(i) * effC(jj)%hjWW(i) + & & XS_WHcoeff(Mhi,'TEV ',5,.True.,.True.)* effC(jj)%hjbb_s(i) * effC(jj)%hjWW(i) + & & XS_WHcoeff(Mhi,'TEV ',6,.True.,.True.)*( effC(jj)%hjtt_s(i) * effC(jj)%hjbb_s(i) ) & & )/XS_WHcoeff(Mhi,'TEV ',7,.True.,.True.) ! TODO: Check correct units: pb vs fb? theo(jj)%tev%XS_hjZ_ratio(i) = ( & & XS_ZHcoeff(Mhi,'TEV ',1,.True.,.True.)*( effC(jj)%hjtt_s(i)**2 )+ & & XS_ZHcoeff_CPodd(Mhi,'TEV ',1,.True.) *( effC(jj)%hjtt_p(i)**2 )+ & & XS_ZHcoeff(Mhi,'TEV ',2,.True.,.True.)*( effC(jj)%hjbb_s(i)**2 )+ & & XS_ZHcoeff_CPodd(Mhi,'TEV ',2,.True.) *( effC(jj)%hjbb_p(i)**2 )+ & & XS_ZHcoeff(Mhi,'TEV ',3,.True.,.True.)* effC(jj)%hjZZ(i)**2 + & & XS_ZHcoeff(Mhi,'TEV ',4,.True.,.True.)* effC(jj)%hjtt_s(i) * effC(jj)%hjZZ(i) + & & XS_ZHcoeff(Mhi,'TEV ',5,.True.,.True.)* effC(jj)%hjbb_s(i) * effC(jj)%hjZZ(i) + & & XS_ZHcoeff(Mhi,'TEV ',6,.True.,.True.)*( effC(jj)%hjtt_s(i) * effC(jj)%hjbb_s(i) )+& & XS_ZHcoeff_CPodd(Mhi,'TEV ',6,.True.)*( effC(jj)%hjtt_p(i) * effC(jj)%hjbb_p(i)) & & )/XS_ZHcoeff(Mhi,'TEV ',7,.True.,.True.) ! TODO: Check correct units: pb vs fb? ! write(*,*) 'XS_tev_HZ_SM(Mhi) = ', XS_tev_HZ_SM(Mhi) else theo(jj)%tev%XS_hjW_ratio(i) = 0.0D0 theo(jj)%tev%XS_hjZ_ratio(i) = 0.0D0 endif !---------------------------------------! ! LHC 7 ! !---------------------------------------! theo(jj)%lhc7%XS_gg_hj_ratio(i) = effC(jj)%hjgg(i)**2 theo(jj)%lhc7%XS_bb_hj_ratio(i) = effC(jj)%hjbb_s(i)**2 + effC(jj)%hjbb_p(i)**2 theo(jj)%lhc7%XS_hjb_ratio(i) = effC(jj)%hjbb_s(i)**2 + effC(jj)%hjbb_p(i)**2 ! still needed? ! calculate inclusive single Higgs production: ! n.b.: neglect cc,ss->hj for inclusive single Higgs production (in effC approximation) if(inrange(Mhi,'LHC7 '))then theo(jj)%lhc7%XS_hj_ratio(i) = ( theo(jj)%lhc7%XS_gg_hj_ratio(i)*XS_lhc7_gg_H_SM(Mhi) + & & theo(jj)%lhc7%XS_bb_hj_ratio(i)*XS_lhc7_bb_H_SM(Mhi))/ & & ( XS_lhc7_gg_H_SM(Mhi) + XS_lhc7_bb_H_SM(Mhi) ) else theo(jj)%lhc7%XS_hj_ratio(i) = 0.0D0 endif if(inrange(Mhi,'LHC7 '))then theo(jj)%lhc7%XS_vbf_ratio(i) = effC(jj)%hjWW(i)**2*lhc7_rHVBF_WW(Mhi) + & & effC(jj)%hjZZ(i)**2*lhc7_rHVBF_ZZ(Mhi) else theo(jj)%lhc7%XS_vbf_ratio(i) = 0.0D0 endif theo(jj)%lhc7%XS_tthj_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 theo(jj)%lhc7%XS_thj_tchan_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 theo(jj)%lhc7%XS_thj_schan_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 ! n.b.: lhc7 tables for tthj at the moment can only use CP even Higgs if(inrange(Mhi,'LHC7 '))then ! if(Mhi.ge.10.0D0.and.Mhi.le.2000) then ! WARNING: This implementation is preliminary. Don't know how to treat a pseudoscalar ! Higgs-fermion coupling here (nobody has ever calculated this!). theo(jj)%lhc7%XS_hjW_ratio(i) = ( & & XS_WHcoeff(Mhi,'LHC7 ',1,.True.,.True.)*( effC(jj)%hjtt_s(i)**2 )+ & & XS_WHcoeff(Mhi,'LHC7 ',2,.True.,.True.)*( effC(jj)%hjbb_s(i)**2 )+ & & XS_WHcoeff(Mhi,'LHC7 ',3,.True.,.True.)* effC(jj)%hjWW(i)**2 + & & XS_WHcoeff(Mhi,'LHC7 ',4,.True.,.True.)* effC(jj)%hjtt_s(i) * effC(jj)%hjWW(i) + & & XS_WHcoeff(Mhi,'LHC7 ',5,.True.,.True.)* effC(jj)%hjbb_s(i) * effC(jj)%hjWW(i) + & & XS_WHcoeff(Mhi,'LHC7 ',6,.True.,.True.)*( effC(jj)%hjtt_s(i) * effC(jj)%hjbb_s(i) ) & & )/XS_WHcoeff(Mhi,'LHC7 ',7,.True.,.True.) ! TODO: Check correct units: pb vs fb? theo(jj)%lhc7%XS_hjZ_ratio(i) = ( & & XS_ZHcoeff(Mhi,'LHC7 ',1,.True.,.True.)*( effC(jj)%hjtt_s(i)**2 )+ & & XS_ZHcoeff_CPodd(Mhi,'LHC7 ',1,.True.) *( effC(jj)%hjtt_p(i)**2 )+ & & XS_ZHcoeff(Mhi,'LHC7 ',2,.True.,.True.)*( effC(jj)%hjbb_s(i)**2 )+ & & XS_ZHcoeff_CPodd(Mhi,'LHC7 ',2,.True.) *( effC(jj)%hjbb_p(i)**2 )+ & & XS_ZHcoeff(Mhi,'LHC7 ',3,.True.,.True.)* effC(jj)%hjZZ(i)**2 + & & XS_ZHcoeff(Mhi,'LHC7 ',4,.True.,.True.)* effC(jj)%hjtt_s(i) * effC(jj)%hjZZ(i) + & & XS_ZHcoeff(Mhi,'LHC7 ',5,.True.,.True.)* effC(jj)%hjbb_s(i) * effC(jj)%hjZZ(i) + & & XS_ZHcoeff(Mhi,'LHC7 ',6,.True.,.True.)*( effC(jj)%hjtt_s(i) * effC(jj)%hjbb_s(i) )+& & XS_ZHcoeff_CPodd(Mhi,'LHC7 ',6,.True.)*(effC(jj)%hjtt_p(i) * effC(jj)%hjbb_p(i)) & & )/XS_ZHcoeff(Mhi,'LHC7 ',7,.True.,.True.) ! TODO: Check correct units: pb vs fb? ! write(*,*) 'XS_lhc7_HZ_SM(Mhi,.True.,.True.) = ', XS_lhc7_HZ_SM(Mhi,.True.,.True.) else theo(jj)%lhc7%XS_hjW_ratio(i) = 0.0D0 theo(jj)%lhc7%XS_hjZ_ratio(i) = 0.0D0 endif !---------------------------------------! ! LHC 8 ! !---------------------------------------! theo(jj)%lhc8%XS_gg_hj_ratio(i) = effC(jj)%hjgg(i)**2 theo(jj)%lhc8%XS_bb_hj_ratio(i) = effC(jj)%hjbb_s(i)**2 + effC(jj)%hjbb_p(i)**2 theo(jj)%lhc8%XS_hjb_ratio(i) = effC(jj)%hjbb_s(i)**2 + effC(jj)%hjbb_p(i)**2 ! still needed? ! calculate inclusive single Higgs production: ! n.b.: neglect cc,ss->hj for inclusive single Higgs production (in effC approximation) if(inrange(Mhi,'LHC8 '))then theo(jj)%lhc8%XS_hj_ratio(i) = ( theo(jj)%lhc8%XS_gg_hj_ratio(i)*XS_lhc8_gg_H_SM(Mhi) + & & theo(jj)%lhc8%XS_bb_hj_ratio(i)*XS_lhc8_bb_H_SM(Mhi))/ & & ( XS_lhc8_gg_H_SM(Mhi) + XS_lhc8_bb_H_SM(Mhi) ) else theo(jj)%lhc8%XS_hj_ratio(i) = 0.0D0 endif if(inrange(Mhi,'LHC8 '))then theo(jj)%lhc8%XS_vbf_ratio(i) = effC(jj)%hjWW(i)**2*lhc8_rHVBF_WW(Mhi) + & & effC(jj)%hjZZ(i)**2*lhc8_rHVBF_ZZ(Mhi) else theo(jj)%lhc8%XS_vbf_ratio(i) = 0.0D0 endif theo(jj)%lhc8%XS_tthj_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 theo(jj)%lhc8%XS_thj_tchan_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 theo(jj)%lhc8%XS_thj_schan_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 ! n.b.: lhc8 tables for tthj at the moment can only use CP even Higgs if(inrange(Mhi,'LHC8 '))then ! if(Mhi.ge.10.0D0.and.Mhi.le.2000) then ! WARNING: This implementation is preliminary. Don't know how to treat a pseudoscalar ! Higgs-fermion coupling here (nobody has ever calculated this!). theo(jj)%lhc8%XS_hjW_ratio(i) = ( & & XS_WHcoeff(Mhi,'LHC8 ',1,.True.,.True.)*( effC(jj)%hjtt_s(i)**2 )+ & & XS_WHcoeff(Mhi,'LHC8 ',2,.True.,.True.)*( effC(jj)%hjbb_s(i)**2 )+ & & XS_WHcoeff(Mhi,'LHC8 ',3,.True.,.True.)* effC(jj)%hjWW(i)**2 + & & XS_WHcoeff(Mhi,'LHC8 ',4,.True.,.True.)* effC(jj)%hjtt_s(i) * effC(jj)%hjWW(i) + & & XS_WHcoeff(Mhi,'LHC8 ',5,.True.,.True.)* effC(jj)%hjbb_s(i) * effC(jj)%hjWW(i) + & & XS_WHcoeff(Mhi,'LHC8 ',6,.True.,.True.)*( effC(jj)%hjtt_s(i) * effC(jj)%hjbb_s(i) ) & & )/XS_WHcoeff(Mhi,'LHC8 ',7,.True.,.True.) ! TODO: Check correct units: pb vs fb? theo(jj)%lhc8%XS_hjZ_ratio(i) = ( & & XS_ZHcoeff(Mhi,'LHC8 ',1,.True.,.True.)*( effC(jj)%hjtt_s(i)**2 )+ & & XS_ZHcoeff_CPodd(Mhi,'LHC8 ',1,.True.) *( effC(jj)%hjtt_p(i)**2 )+ & & XS_ZHcoeff(Mhi,'LHC8 ',2,.True.,.True.)*( effC(jj)%hjbb_s(i)**2 )+ & & XS_ZHcoeff_CPodd(Mhi,'LHC8 ',2,.True.) *( effC(jj)%hjbb_p(i)**2 )+ & & XS_ZHcoeff(Mhi,'LHC8 ',3,.True.,.True.)* effC(jj)%hjZZ(i)**2 + & & XS_ZHcoeff(Mhi,'LHC8 ',4,.True.,.True.)* effC(jj)%hjtt_s(i) * effC(jj)%hjZZ(i) + & & XS_ZHcoeff(Mhi,'LHC8 ',5,.True.,.True.)* effC(jj)%hjbb_s(i) * effC(jj)%hjZZ(i) + & & XS_ZHcoeff(Mhi,'LHC8 ',6,.True.,.True.)*( effC(jj)%hjtt_s(i) * effC(jj)%hjbb_s(i) )+& & XS_ZHcoeff_CPodd(Mhi,'LHC8 ',6,.True.)*(effC(jj)%hjtt_p(i) * effC(jj)%hjbb_p(i)) & & )/XS_ZHcoeff(Mhi,'LHC8 ',7,.True.,.True.) ! TODO: Check correct units: pb vs fb? ! write(*,*) 'ZHcoeff(8)', Mhi, XS_ZHcoeff(Mhi,'LHC8 ',1,.True.,.True.),& ! & XS_ZHcoeff(Mhi,'LHC8 ',2,.True.,.True.),& ! & XS_ZHcoeff(Mhi,'LHC8 ',3,.True.,.True.),& ! & XS_ZHcoeff(Mhi,'LHC8 ',4,.True.,.True.),& ! & XS_ZHcoeff(Mhi,'LHC8 ',5,.True.,.True.),& ! & XS_ZHcoeff(Mhi,'LHC8 ',6,.True.,.True.) ! write(*,*) 'XS_lhc8_HZ_SM(Mhi,.True.,.True.) = ', XS_lhc8_HZ_SM(Mhi,.True.,.True.) else theo(jj)%lhc8%XS_hjW_ratio(i) = 0.0D0 theo(jj)%lhc8%XS_hjZ_ratio(i) = 0.0D0 endif !---------------------------------------! ! LHC 13 ! !---------------------------------------! theo(jj)%lhc13%XS_gg_hj_ratio(i) = effC(jj)%hjgg(i)**2 theo(jj)%lhc13%XS_bb_hj_ratio(i) = effC(jj)%hjbb_s(i)**2 + effC(jj)%hjbb_p(i)**2 theo(jj)%lhc13%XS_hjb_ratio(i) = effC(jj)%hjbb_s(i)**2 + effC(jj)%hjbb_p(i)**2 ! still needed? ! calculate inclusive single Higgs production: ! n.b.: neglect cc,ss->hj for inclusive single Higgs production (in effC approximation) if(inrange(Mhi,'LHC13'))then theo(jj)%lhc13%XS_hj_ratio(i) = ( theo(jj)%lhc13%XS_gg_hj_ratio(i)*XS_lhc13_gg_H_SM(Mhi) + & & theo(jj)%lhc13%XS_bb_hj_ratio(i)*XS_lhc13_bb_H_SM(Mhi))/ & & ( XS_lhc13_gg_H_SM(Mhi) + XS_lhc13_bb_H_SM(Mhi) ) else theo(jj)%lhc13%XS_hj_ratio(i) = 0.0D0 endif if(inrange(Mhi,'LHC13'))then theo(jj)%lhc13%XS_vbf_ratio(i) = effC(jj)%hjWW(i)**2*lhc13_rHVBF_WW(Mhi) + & & effC(jj)%hjZZ(i)**2*lhc13_rHVBF_ZZ(Mhi) else theo(jj)%lhc13%XS_vbf_ratio(i) = 0.0D0 endif theo(jj)%lhc13%XS_tthj_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 theo(jj)%lhc13%XS_thj_tchan_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 theo(jj)%lhc13%XS_thj_schan_ratio(i) = effC(jj)%hjtt_s(i)**2+effC(jj)%hjtt_p(i)**2 ! n.b.: lhc13 tables for tthj at the moment can only use CP even Higgs ! write(*,*) 'inrange(Mhi,LHC13) = ' , inrange(Mhi,'LHC13') if(inrange(Mhi,'LHC13')) then ! if(Mhi.ge.10.0D0.and.Mhi.le.2000) then ! WARNING: This implementation is preliminary. Don't know how to treat a pseudoscalar ! Higgs-fermion coupling here (nobody has ever calculated this!). theo(jj)%lhc13%XS_hjW_ratio(i) = ( & & XS_WHcoeff(Mhi,'LHC13',1,.True.,.True.)*( effC(jj)%hjtt_s(i)**2 )+ & & XS_WHcoeff(Mhi,'LHC13',2,.True.,.True.)*( effC(jj)%hjbb_s(i)**2 )+ & & XS_WHcoeff(Mhi,'LHC13',3,.True.,.True.)* effC(jj)%hjWW(i)**2 + & & XS_WHcoeff(Mhi,'LHC13',4,.True.,.True.)* effC(jj)%hjtt_s(i) * effC(jj)%hjWW(i) + & & XS_WHcoeff(Mhi,'LHC13',5,.True.,.True.)* effC(jj)%hjbb_s(i) * effC(jj)%hjWW(i) + & & XS_WHcoeff(Mhi,'LHC13',6,.True.,.True.)*( effC(jj)%hjtt_s(i) * effC(jj)%hjbb_s(i) ) & & )/XS_WHcoeff(Mhi,'LHC13',7,.True.,.True.) ! TODO: Check correct units: pb vs fb? theo(jj)%lhc13%XS_hjZ_ratio(i) = ( & & XS_ZHcoeff(Mhi,'LHC13',1,.True.,.True.)*( effC(jj)%hjtt_s(i)**2 )+ & & XS_ZHcoeff_CPodd(Mhi,'LHC13',1,.True.) *( effC(jj)%hjtt_p(i)**2 )+ & & XS_ZHcoeff(Mhi,'LHC13',2,.True.,.True.)*( effC(jj)%hjbb_s(i)**2 )+ & & XS_ZHcoeff_CPodd(Mhi,'LHC13',2,.True.) *( effC(jj)%hjbb_p(i)**2 )+ & & XS_ZHcoeff(Mhi,'LHC13',3,.True.,.True.)* effC(jj)%hjZZ(i)**2 + & & XS_ZHcoeff(Mhi,'LHC13',4,.True.,.True.)* effC(jj)%hjtt_s(i) * effC(jj)%hjZZ(i) + & & XS_ZHcoeff(Mhi,'LHC13',5,.True.,.True.)* effC(jj)%hjbb_s(i) * effC(jj)%hjZZ(i) + & & XS_ZHcoeff(Mhi,'LHC13',6,.True.,.True.)*( effC(jj)%hjtt_s(i) * effC(jj)%hjbb_s(i) )+& & XS_ZHcoeff_CPodd(Mhi,'LHC13',6,.True.)*(effC(jj)%hjtt_p(i) * effC(jj)%hjbb_p(i)) & & )/XS_ZHcoeff(Mhi,'LHC13',7,.True.,.True.) ! TODO: Check correct units: pb vs fb? ! write(*,*) 'XS_lhc13_HZ_SM(Mhi,.True.,.True.) = ', XS_lhc13_HZ_SM(Mhi,.True.,.True.) ! write(*,*) 'DEBUG - 13 TeV ZH approximation:' ! do kk=1,7 ! write(*,*) "XS_ZHcoeff, XS_ZHcoeff_CPodd, kk = ",XS_ZHcoeff(Mhi,'LHC13',kk,.True.,.True.),XS_ZHcoeff_CPodd(Mhi,'LHC13',kk,.True.),kk ! enddo ! write(*,*) "theo(jj)%lhc13%XS_hjZ_ratio(i) = ", theo(jj)%lhc13%XS_hjZ_ratio(i) else theo(jj)%lhc13%XS_hjW_ratio(i) = 0.0D0 theo(jj)%lhc13%XS_hjZ_ratio(i) = 0.0D0 endif enddo theo(jj)%lep%XS_hjhi_ratio=effC(jj)%hjhiZ**2! note only half of XS_hjhi_ratio is filled here do j=2,np(Hneut) do i=1,j-1 theo(jj)%lep%XS_hjhi_ratio(i,j) = theo(jj)%lep%XS_hjhi_ratio(j,i) enddo enddo end subroutine HB5_csratios_from_effC_for_datapoint !****************************************************************** subroutine HB5_cp_from_effC ! uses the effective couplings contained in effC to calculate the ! cp property of neutral higgs !***************************************************************** use usefulbits, only : effC,ndat,vsmall implicit none !--------------------------------------internal integer :: i,jj double precision :: max_hjff_s,max_hjff_p !--------------------------------------------- if(np(Hneut)<1)stop 'error in cp_from_effC (np(Hneut))' do jj=1,ndat do i=1,np(Hneut) max_hjff_s=max(effC(jj)%hjss_s(i),effC(jj)%hjcc_s(i),effC(jj)%hjbb_s(i), & & effC(jj)%hjtt_s(i),effC(jj)%hjmumu_s(i),effC(jj)%hjtautau_s(i)) max_hjff_p=max(effC(jj)%hjss_p(i),effC(jj)%hjcc_p(i),effC(jj)%hjbb_p(i), & & effC(jj)%hjtt_p(i),effC(jj)%hjmumu_p(i),effC(jj)%hjtautau_p(i)) if( max_hjff_p .lt. vsmall )then !CP even theo(jj)%CP_value(i) = 1 elseif( max_hjff_s .lt. vsmall )then !CP odd theo(jj)%CP_value(i) = -1 else !mixed CP theo(jj)%CP_value(i) = 0 endif enddo enddo end subroutine HB5_cp_from_effC !****************************************************************** subroutine HB5_br_from_effC ! calls the subroutine br_from_effC_for_datapoint for each datapoint. !***************************************************************** use usefulbits, only : np,Hneut,ndat implicit none !--------------------------------------internal integer :: jj !--------------------------------------------- if(np(Hneut)<1)stop 'error in br_from_effC (np(Hneut))' do jj=1,ndat call HB5_br_from_effC_for_datapoint(jj) enddo end subroutine HB5_br_from_effC !***************************************************************** subroutine HB5_br_from_effC_for_datapoint(jj) ! uses the effective couplings contained in effC to calculate ! branching ratios !***************************************************************** use theory_BRfunctions use S95tables, only : inrange use usefulbits, only : effC,ms,mc,mt,mbmb,mmu,mtau,small implicit none integer, intent(in) :: jj !--------------------------------------internal integer :: i double precision :: Mhi,GammaRat !--------------------------------------------- do i=1,np(Hneut) Mhi=theo(jj)%particle(Hneut)%M(i) if(theo(jj)%particle(Hneut)%Mc(i).ge.small) Mhi=theo(jj)%particle(Hneut)%Mc(i) theo(jj)%BR_hjss(i) = 0.0D0 theo(jj)%BR_hjcc(i) = 0.0D0 theo(jj)%BR_hjbb(i) = 0.0D0 theo(jj)%BR_hjmumu(i) = 0.0D0 theo(jj)%BR_hjtautau(i)= 0.0D0 theo(jj)%BR_hjWW(i) = 0.0D0 theo(jj)%BR_hjZZ(i) = 0.0D0 theo(jj)%BR_hjZga(i) = 0.0D0 theo(jj)%BR_hjgaga(i) = 0.0D0 theo(jj)%BR_hjgg(i) = 0.0D0 theo(jj)%BR_hjtt(i) = 0.0D0 ! HB5 NEW if( inrange(Mhi,'SMBR') )then GammaRat=theo(jj)%particle(Hneut)%GammaTot(i)/BRSM_GammaTot(Mhi) ! write(*,*) 'br_from_effC debugging: ' ! write(*,*) 'i, Mh = ', i, Mhi ! write(*,*) 'GammaRat = ',GammaRat ! write(*,*) 'Couplings hss = ',effC(jj)%hjss_s(i) ! write(*,*) 'Couplings htt = ',effC(jj)%hjtt_s(i) ! write(*,*) 'Couplings hWW = ',effC(jj)%hjWW(i) if(theo(jj)%particle(Hneut)%GammaTot(i).gt.0.0D0)then theo(jj)%BR_hjss(i) = ( effC(jj)%hjss_s(i)**2 +effC(jj)%hjss_p(i)**2 *invbsq(ms, Mhi) ) *BRSM_Hss(Mhi) /GammaRat theo(jj)%BR_hjcc(i) = ( effC(jj)%hjcc_s(i)**2 +effC(jj)%hjcc_p(i)**2 *invbsq(mc, Mhi) ) *BRSM_Hcc(Mhi) /GammaRat theo(jj)%BR_hjbb(i) = ( effC(jj)%hjbb_s(i)**2 +effC(jj)%hjbb_p(i)**2 *invbsq(mbmb,Mhi) ) *BRSM_Hbb(Mhi) /GammaRat theo(jj)%BR_hjtt(i) = ( effC(jj)%hjtt_s(i)**2 +effC(jj)%hjtt_p(i)**2 *invbsq(mt ,Mhi) ) *BRSM_Htoptop(Mhi) /GammaRat ! HB5 new theo(jj)%BR_hjmumu(i) = ( effC(jj)%hjmumu_s(i)**2 +effC(jj)%hjmumu_p(i)**2 *invbsq(mmu, Mhi) ) *BRSM_Hmumu(Mhi) /GammaRat theo(jj)%BR_hjtautau(i)= ( effC(jj)%hjtautau_s(i)**2+effC(jj)%hjtautau_p(i)**2*invbsq(mtau,Mhi) ) *BRSM_Htautau(Mhi) /GammaRat theo(jj)%BR_hjWW(i) = effC(jj)%hjWW(i)**2 *BRSM_HWW(Mhi) /GammaRat theo(jj)%BR_hjZZ(i) = effC(jj)%hjZZ(i)**2 *BRSM_HZZ(Mhi) /GammaRat theo(jj)%BR_hjZga(i) = effC(jj)%hjZga(i)**2 *BRSM_HZga(Mhi) /GammaRat theo(jj)%BR_hjgaga(i) = effC(jj)%hjgaga(i)**2 *BRSM_Hgaga(Mhi) /GammaRat theo(jj)%BR_hjgg(i) = effC(jj)%hjgg(i)**2 *BRSM_Hgg(Mhi) /GammaRat ! write(*,*) 'BR h->ss = ',theo(jj)%BR_hjss(i), 'SM =',BRSM_Hss(Mhi) ! write(*,*) 'BR h->cc = ',theo(jj)%BR_hjcc(i), 'SM =',BRSM_Hcc(Mhi) ! write(*,*) 'BR h->bb = ',theo(jj)%BR_hjbb(i), 'SM =',BRSM_Hbb(Mhi) ! write(*,*) 'BR h->tt = ',theo(jj)%BR_hjtt(i), 'SM =',BRSM_Htoptop(Mhi) ! write(*,*) 'BR h->mumu = ',theo(jj)%BR_hjmumu(i), 'SM =',BRSM_Hmumu(Mhi) ! write(*,*) 'BR h->tautau = ',theo(jj)%BR_hjtautau(i), 'SM =',BRSM_Htautau(Mhi) ! write(*,*) 'BR h->WW = ',theo(jj)%BR_hjWW(i), 'SM =',BRSM_HWW(Mhi) ! write(*,*) 'BR h->ZZ = ',theo(jj)%BR_hjZZ(i), 'SM =',BRSM_HZZ(Mhi) ! write(*,*) 'BR h->gaga = ',theo(jj)%BR_hjgaga(i), 'SM =',BRSM_Hgaga(Mhi) ! write(*,*) 'BR h->gg = ',theo(jj)%BR_hjgg(i), 'SM =',BRSM_Hgg(Mhi) ! write(*,*) 'BR h->Zga = ',theo(jj)%BR_hjZga(i), 'SM =',BRSM_HZga(Mhi) else write(*,*)'at jj=',jj,'i=',i write(*,*)'total decay width is less than or equal to zero:',theo(jj)%particle(Hneut)%GammaTot(i) endif endif enddo end subroutine HB5_br_from_effC_for_datapoint !***************************************************************** subroutine complete_channelrates ! calls the subroutine complete_channelrates_for_datapoint for each datapoint. !***************************************************************** use usefulbits, only : np,Hneut,ndat implicit none !--------------------------------------internal integer :: jj !--------------------------------------------- if(np(Hneut)<1)stop 'error in complete_channelrates (np(Hneut))' do jj=1,ndat call complete_channelrates_for_datapoint(jj) enddo end subroutine complete_channelrates !***************************************************************** subroutine complete_channelrates_for_datapoint(jj) ! obtains the channelrates either from the XS and BR input (assuming ! the narrow width approximation), or, if provided directly, from the ! user's input ! n.b.: Important case of 0.0D0 will be taken over! (To enable to treat the interference ! of several Higgs bosons in one slot and de-activate (i.e. set to zero) the other slot) !***************************************************************** use usefulbits, only : Nprod, Ndecay implicit none !--------------------------------------internal integer :: i,jj,p,d double precision :: sigma, BR !--------------------------------------------- ! write(*,*) "debug: calling complete_channelrates_for_datapoint" do i=1,np(Hneut) do p=1,Nprod do d=1,Ndecay if(theo(jj)%tev%channelrates_tmp(i,p,d).ge.0.0D0) then theo(jj)%tev%channelrates(i,p,d) = theo(jj)%tev%channelrates_tmp(i,p,d) else select case(p) case(1) sigma = theo(jj)%tev%XS_hj_ratio(i) case(2) sigma = theo(jj)%tev%XS_vbf_ratio(i) case(3) sigma = theo(jj)%tev%XS_hjW_ratio(i) case(4) sigma = theo(jj)%tev%XS_hjZ_ratio(i) case(5) sigma = theo(jj)%tev%XS_tthj_ratio(i) case(6) sigma = theo(jj)%tev%XS_gg_hj_ratio(i) case(7) sigma = theo(jj)%tev%XS_bb_hj_ratio(i) + case(8) + sigma = theo(jj)%tev%XS_thj_tchan_ratio(i) + case(9) + sigma = theo(jj)%tev%XS_thj_schan_ratio(i) + case(10) + sigma = theo(jj)%tev%XS_qq_hjZ_ratio(i) + case(11) + sigma = theo(jj)%tev%XS_gg_hjZ_ratio(i) end select select case(d) case(1) BR = theo(jj)%BR_hjgaga(i)!/theo(jj)%BR_Hgaga_SM(i) case(2) BR = theo(jj)%BR_hjWW(i)!/theo(jj)%BR_HWW_SM(i) case(3) BR = theo(jj)%BR_hjZZ(i)!/theo(jj)%BR_HZZ_SM(i) case(4) BR = theo(jj)%BR_hjtautau(i)!/theo(jj)%BR_Htautau_SM(i) case(5) BR = theo(jj)%BR_hjbb(i)!/theo(jj)%BR_Hbb_SM(i) case(6) BR = theo(jj)%BR_hjZga(i)!/theo(jj)%BR_HZga_SM(i) case(7) BR = theo(jj)%BR_hjcc(i)!/theo(jj)%BR_Hcc_SM(i) case(8) BR = theo(jj)%BR_hjmumu(i)!/theo(jj)%BR_Hmumu_SM(i) case(9) BR = theo(jj)%BR_hjgg(i)!/theo(jj)%BR_Hgg_SM(i) + case(10) + BR = theo(jj)%BR_hjss(i) + case(11) + BR = theo(jj)%BR_hjtt(i) end select theo(jj)%tev%channelrates(i,p,d) = sigma*BR endif if(theo(jj)%lhc7%channelrates_tmp(i,p,d).ge.0.0D0) then theo(jj)%lhc7%channelrates(i,p,d) = theo(jj)%lhc7%channelrates_tmp(i,p,d) else select case(p) case(1) sigma = theo(jj)%lhc7%XS_hj_ratio(i) case(2) sigma = theo(jj)%lhc7%XS_vbf_ratio(i) case(3) sigma = theo(jj)%lhc7%XS_hjW_ratio(i) case(4) sigma = theo(jj)%lhc7%XS_hjZ_ratio(i) case(5) sigma = theo(jj)%lhc7%XS_tthj_ratio(i) case(6) sigma = theo(jj)%lhc7%XS_gg_hj_ratio(i) case(7) sigma = theo(jj)%lhc7%XS_bb_hj_ratio(i) + case(8) + sigma = theo(jj)%lhc7%XS_thj_tchan_ratio(i) + case(9) + sigma = theo(jj)%lhc7%XS_thj_schan_ratio(i) + case(10) + sigma = theo(jj)%lhc7%XS_qq_hjZ_ratio(i) + case(11) + sigma = theo(jj)%lhc7%XS_gg_hjZ_ratio(i) end select select case(d) case(1) BR = theo(jj)%BR_hjgaga(i)!/theo(jj)%BR_Hgaga_SM(i) case(2) BR = theo(jj)%BR_hjWW(i)!/theo(jj)%BR_HWW_SM(i) case(3) BR = theo(jj)%BR_hjZZ(i)!/theo(jj)%BR_HZZ_SM(i) case(4) BR = theo(jj)%BR_hjtautau(i)!/theo(jj)%BR_Htautau_SM(i) case(5) BR = theo(jj)%BR_hjbb(i)!/theo(jj)%BR_Hbb_SM(i) case(6) BR = theo(jj)%BR_hjZga(i)!/theo(jj)%BR_HZga_SM(i) case(7) BR = theo(jj)%BR_hjcc(i)!/theo(jj)%BR_Hcc_SM(i) case(8) BR = theo(jj)%BR_hjmumu(i)!/theo(jj)%BR_Hmumu_SM(i) case(9) BR = theo(jj)%BR_hjgg(i)!/theo(jj)%BR_Hgg_SM(i) + case(10) + BR = theo(jj)%BR_hjss(i) + case(11) + BR = theo(jj)%BR_hjtt(i) end select theo(jj)%lhc7%channelrates(i,p,d) = sigma*BR endif ! write(*,*) "i,p,d,8TeV:", i, p, d, theo(jj)%lhc8%channelrates_tmp(i,p,d) if(theo(jj)%lhc8%channelrates_tmp(i,p,d).ge.0.0D0) then theo(jj)%lhc8%channelrates(i,p,d) = theo(jj)%lhc8%channelrates_tmp(i,p,d) else select case(p) case(1) sigma = theo(jj)%lhc8%XS_hj_ratio(i) case(2) sigma = theo(jj)%lhc8%XS_vbf_ratio(i) case(3) sigma = theo(jj)%lhc8%XS_hjW_ratio(i) case(4) sigma = theo(jj)%lhc8%XS_hjZ_ratio(i) case(5) sigma = theo(jj)%lhc8%XS_tthj_ratio(i) case(6) sigma = theo(jj)%lhc8%XS_gg_hj_ratio(i) case(7) sigma = theo(jj)%lhc8%XS_bb_hj_ratio(i) + case(8) + sigma = theo(jj)%lhc8%XS_thj_tchan_ratio(i) + case(9) + sigma = theo(jj)%lhc8%XS_thj_schan_ratio(i) + case(10) + sigma = theo(jj)%lhc8%XS_qq_hjZ_ratio(i) + case(11) + sigma = theo(jj)%lhc8%XS_gg_hjZ_ratio(i) end select select case(d) case(1) BR = theo(jj)%BR_hjgaga(i)!/theo(jj)%BR_Hgaga_SM(i) case(2) BR = theo(jj)%BR_hjWW(i)!/theo(jj)%BR_HWW_SM(i) case(3) BR = theo(jj)%BR_hjZZ(i)!/theo(jj)%BR_HZZ_SM(i) case(4) BR = theo(jj)%BR_hjtautau(i)!/theo(jj)%BR_Htautau_SM(i) case(5) BR = theo(jj)%BR_hjbb(i)!/theo(jj)%BR_Hbb_SM(i) case(6) BR = theo(jj)%BR_hjZga(i)!/theo(jj)%BR_HZga_SM(i) case(7) BR = theo(jj)%BR_hjcc(i)!/theo(jj)%BR_Hcc_SM(i) case(8) BR = theo(jj)%BR_hjmumu(i)!/theo(jj)%BR_Hmumu_SM(i) case(9) BR = theo(jj)%BR_hjgg(i)!/theo(jj)%BR_Hgg_SM(i) + case(10) + BR = theo(jj)%BR_hjss(i) + case(11) + BR = theo(jj)%BR_hjtt(i) end select theo(jj)%lhc8%channelrates(i,p,d) = sigma*BR endif if(theo(jj)%lhc13%channelrates_tmp(i,p,d).ge.0.0D0) then theo(jj)%lhc13%channelrates(i,p,d) = theo(jj)%lhc13%channelrates_tmp(i,p,d) else select case(p) case(1) sigma = theo(jj)%lhc13%XS_hj_ratio(i) case(2) sigma = theo(jj)%lhc13%XS_vbf_ratio(i) case(3) sigma = theo(jj)%lhc13%XS_hjW_ratio(i) case(4) sigma = theo(jj)%lhc13%XS_hjZ_ratio(i) case(5) sigma = theo(jj)%lhc13%XS_tthj_ratio(i) case(6) sigma = theo(jj)%lhc13%XS_gg_hj_ratio(i) case(7) sigma = theo(jj)%lhc13%XS_bb_hj_ratio(i) + case(8) + sigma = theo(jj)%lhc13%XS_thj_tchan_ratio(i) + case(9) + sigma = theo(jj)%lhc13%XS_thj_schan_ratio(i) + case(10) + sigma = theo(jj)%lhc13%XS_qq_hjZ_ratio(i) + case(11) + sigma = theo(jj)%lhc13%XS_gg_hjZ_ratio(i) end select select case(d) case(1) BR = theo(jj)%BR_hjgaga(i)!/theo(jj)%BR_Hgaga_SM(i) case(2) BR = theo(jj)%BR_hjWW(i)!/theo(jj)%BR_HWW_SM(i) case(3) BR = theo(jj)%BR_hjZZ(i)!/theo(jj)%BR_HZZ_SM(i) case(4) BR = theo(jj)%BR_hjtautau(i)!/theo(jj)%BR_Htautau_SM(i) case(5) BR = theo(jj)%BR_hjbb(i)!/theo(jj)%BR_Hbb_SM(i) case(6) BR = theo(jj)%BR_hjZga(i)!/theo(jj)%BR_HZga_SM(i) case(7) BR = theo(jj)%BR_hjcc(i)!/theo(jj)%BR_Hcc_SM(i) case(8) BR = theo(jj)%BR_hjmumu(i)!/theo(jj)%BR_Hmumu_SM(i) case(9) BR = theo(jj)%BR_hjgg(i)!/theo(jj)%BR_Hgg_SM(i) + case(10) + BR = theo(jj)%BR_hjss(i) + case(11) + BR = theo(jj)%BR_hjtt(i) end select theo(jj)%lhc13%channelrates(i,p,d) = sigma*BR ! write(*,*) "debug: getting 13 TeV from XS x BR:", i,p,d, sigma, BR endif enddo enddo enddo end subroutine complete_channelrates_for_datapoint !***************************************************************** subroutine clean_channelrates ! calls the subroutine clean_channelrates_for_datapoint for each datapoint. !***************************************************************** use usefulbits, only : np,Hneut,ndat implicit none !--------------------------------------internal integer :: jj !--------------------------------------------- if(np(Hneut)<1)stop 'error in complete_channelrates (np(Hneut))' do jj=1,ndat call clean_channelrates_for_datapoint(jj) enddo end subroutine clean_channelrates !***************************************************************** subroutine clean_channelrates_for_datapoint(jj) ! fills all channelrates matrices with -1.0D0 !***************************************************************** use usefulbits, only : Nprod, Ndecay implicit none !--------------------------------------internal integer :: jj !--------------------------------------------- theo(jj)%tev%channelrates = -1.0D0 theo(jj)%tev%channelrates_tmp = -1.0D0 theo(jj)%lhc7%channelrates = -1.0D0 theo(jj)%lhc7%channelrates_tmp = -1.0D0 theo(jj)%lhc8%channelrates = -1.0D0 theo(jj)%lhc8%channelrates_tmp = -1.0D0 theo(jj)%lhc13%channelrates = -1.0D0 theo(jj)%lhc13%channelrates_tmp = -1.0D0 end subroutine clean_channelrates_for_datapoint !***************************************************************** subroutine complete_BRs implicit none integer :: jj,i,j ! write(*,*) "# ------ complete_BRs debuggung -------#" ! copying over the (k,i,i) elements of BR_hkhjhi into BR_hjhihi. do jj=1,ndat do j=1,np(Hneut) do i=1,np(Hneut) theo(jj)%BR_hjhihi(j,i) = theo(jj)%BR_hkhjhi(j,i,i) ! write(*,"(a,I1,a,I1,a,I1,a,1E10.3)") "BR(h",j,"->h",i,"h",i,") = ",theo(jj)%BR_hjhihi(j,i) ! write(*,"(a,I1,a,I1,a,1E10.3)") "BR(h",j,"->h",i,"Z) = ",theo(jj)%BR_hjhiZ(j,i) enddo enddo enddo ! write(*,*) "# ------ end debuggung -------#" end subroutine complete_BRs !******************************************************************* ! OLD HB-4 routines: !****************************************************************** subroutine complete_theo ! OBSOLETE ! ! This is the old routine (HB4 and earlier) !decides what has to be done to the input and calls the appropriate !subroutines !****************************************************************** use usefulbits, only : whichanalyses,whichinput,ndat implicit none !--------------------------------------internal integer :: i,j,jj !---------------------------------------------- if(np(Hneut)>0)then !none if this is needed for the charged Higgs sector yet select case(whichinput) case('effC') call csratios_from_g2 call cp_from_g2 call br_from_g2 case('SLHA') call csratios_from_g2 call cp_from_g2 case('hadr','part') case default stop 'error in subroutine complete_theo (1)' end select do jj=1,ndat ! filling the other half of XS_hjhi_ratio do j=2,np(Hneut) do i=1,j-1 theo(jj)%lep%XS_hjhi_ratio(i,j) = theo(jj)%lep%XS_hjhi_ratio(j,i) enddo enddo enddo endif call check_dataset !involves the charged Higgs sector if(np(Hneut)>0)then !none if this is needed for the charged Higgs sector yet select case(whichanalyses) case('onlyH','LandH','onlyP','list ') ! everything which involves Tevatron and LHC tables call fill_theo_SM ! n.b. there's no LEP SM cross sections at the moment select case(whichinput) case('part','effC','SLHA') ! everything except option 'hadr', where had XS ratios are inputted directly call XS_from_partR case('hadr') case default stop 'error in subroutine complete_theo (2)' end select case('onlyL') case default stop 'error in subroutine complete_theo (3)' end select endif end subroutine complete_theo !****************************************************************** subroutine recalculate_theo_for_datapoint(n) ! OBSOLETE ! ! Does the same as complete_theo but just for the datapoint n. use usefulbits, only : whichanalyses,whichinput implicit none integer, intent(in) :: n if(np(Hneut)>0) then !none if this is needed for the charged Higgs sector yet select case(whichinput) case('effC') call csratios_from_g2_for_datapoint(n) call br_from_g2_for_datapoint(n) case('SLHA') call csratios_from_g2_for_datapoint(n) case('hadr','part') case default stop 'error in subroutine recalculate_theo_for_datapoint (1)' end select endif call check_dataset !involves the charged Higgs sector if(np(Hneut)>0)then !none if this is needed for the charged Higgs sector yet select case(whichanalyses) case('onlyH','LandH','onlyP','list ') ! everything which involves Tevatron and LHC tables call fill_theo_SM_for_datapoint(n) ! n.b. there's no LEP SM cross sections at the moment select case(whichinput) case('part','effC','SLHA') ! everything except option 'hadr', where had XS ratios are inputted directly call XS_from_partR_for_datapoint(n) case('hadr') case default stop 'error in subroutine recalculate_theo_for_datapoint (2)' end select case('onlyL') case default stop 'error in subroutine recalculate_theo_for_datapoint (3)' end select endif end subroutine recalculate_theo_for_datapoint !****************************************************************** subroutine csratios_from_g2 ! OBSOLETE ! ! uses the effective couplings contained in g2 to calculate ! partonic cross section ratios, some hadronic cross section ratios !***************************************************************** use usefulbits, only : ndat implicit none !--------------------------------------internal integer :: jj !--------------------------------------------- if(np(Hneut)<1)stop 'error in csratios_from_g2 (np(Hneut))' do jj=1,ndat call csratios_from_g2_for_datapoint(jj) enddo end subroutine csratios_from_g2 !****************************************************************** subroutine csratios_from_g2_for_datapoint(jj) ! OBSOLETE ! ! uses the effective couplings contained in g2 to calculate ! partonic cross section ratios, some hadronic cross section ratios !***************************************************************** use usefulbits, only : g2 use theory_colliderSfunctions use S95tables, only : inrange implicit none integer, intent(in) :: jj !--------------------------------------internal integer :: i double precision :: TEVSM_ZZ_contrib_to_VBF,TEVSM_WW_contrib_to_VBF double precision :: Mhi !--------------------------------------------- ! relative contributuion of WW- and ZZ-fusion to VBF (in LO) for ! p p-bar collisions at SqrtS=1.96 TeV (calcuated by T. Figy with VBFNLO):s TEVSM_ZZ_contrib_to_VBF=0.23D0 TEVSM_WW_contrib_to_VBF=0.77D0 do i=1,np(Hneut) theo(jj)%lep%XS_hjZ_ratio(i) = g2(jj)%hjZZ(i) theo(jj)%lep%XS_bbhj_ratio(i) = g2(jj)%hjbb_s(i)+g2(jj)%hjbb_p(i)!nb tables at the moment can not be applied to mixed CP Higgs theo(jj)%lep%XS_tautauhj_ratio(i) = g2(jj)%hjtautau_s(i)+g2(jj)%hjtautau_p(i)!nb tables at the moment can not be applied to mixed CP Higgs partR(jj)%bg_hjb(i) = g2(jj)%hjbb_s(i)+g2(jj)%hjbb_p(i) theo(jj)%tev%XS_vbf_ratio(i) = g2(jj)%hjWW(i)*TEVSM_WW_contrib_to_VBF & & + g2(jj)%hjZZ(i)*TEVSM_ZZ_contrib_to_VBF theo(jj)%tev%XS_tthj_ratio(i) = g2(jj)%hjtoptop_s(i)+g2(jj)%hjtoptop_p(i) !nb tev tables at the moment can only use CP even Higgs Mhi=theo(jj)%particle(Hneut)%M(i) if(inrange(Mhi,'LHC7 '))then theo(jj)%lhc7%XS_vbf_ratio(i) = g2(jj)%hjWW(i)*lhc7_rHVBF_WW(Mhi) & & + g2(jj)%hjZZ(i)*lhc7_rHVBF_ZZ(Mhi) else theo(jj)%lhc7%XS_vbf_ratio(i) = 0.0D0 endif theo(jj)%lhc7%XS_tthj_ratio(i) = g2(jj)%hjtoptop_s(i)+g2(jj)%hjtoptop_p(i) !nb no tables need this at the moment ! We are using 7 TeV ratios for VBF contribution from WW/ZZ at the moment also ! for LHC 8 TeV cross sections if(inrange(Mhi,'LHC8 '))then theo(jj)%lhc8%XS_vbf_ratio(i) = g2(jj)%hjWW(i)*lhc7_rHVBF_WW(Mhi) & & + g2(jj)%hjZZ(i)*lhc7_rHVBF_ZZ(Mhi) else theo(jj)%lhc8%XS_vbf_ratio(i) = 0.0D0 endif theo(jj)%lhc8%XS_tthj_ratio(i) = g2(jj)%hjtoptop_s(i)+g2(jj)%hjtoptop_p(i) partR(jj)%qq_hjWp(:,i) = g2(jj)%hjWW(i) partR(jj)%qq_hjWm(:,i) = g2(jj)%hjWW(i) partR(jj)%gg_hj(i) = g2(jj)%hjgg(i) partR(jj)%qq_hj(5,i) = g2(jj)%hjbb_s(i)+g2(jj)%hjbb_p(i) partR(jj)%qq_hjZ(:,i) = g2(jj)%hjZZ(i) partR(jj)%gg_hjZ(i) = g2(jj)%hjggZ(i) enddo theo(jj)%lep%XS_hjhi_ratio=g2(jj)%hjhiZ! note only half of XS_hjhi_ratio is filled here end subroutine csratios_from_g2_for_datapoint !****************************************************************** subroutine cp_from_g2 ! OBSOLETE ! ! uses the effective couplings contained in g2 to calculate ! cp of neutral higgs !***************************************************************** use usefulbits, only : g2,ndat,vsmall implicit none !--------------------------------------internal integer :: i,jj double precision :: max_hjff_s,max_hjff_p !--------------------------------------------- if(np(Hneut)<1)stop 'error in cp_from_g2 (np(Hneut))' do jj=1,ndat do i=1,np(Hneut) max_hjff_s=max(g2(jj)%hjss_s(i),g2(jj)%hjcc_s(i),g2(jj)%hjbb_s(i), & & g2(jj)%hjtoptop_s(i),g2(jj)%hjmumu_s(i),g2(jj)%hjtautau_s(i)) max_hjff_p=max(g2(jj)%hjss_p(i),g2(jj)%hjcc_p(i),g2(jj)%hjbb_p(i), & & g2(jj)%hjtoptop_p(i),g2(jj)%hjmumu_p(i),g2(jj)%hjtautau_p(i)) if( max_hjff_p .lt. vsmall )then !CP even theo(jj)%CP_value(i) = 1 elseif( max_hjff_s .lt. vsmall )then !CP odd theo(jj)%CP_value(i) = -1 else !mixed CP theo(jj)%CP_value(i) = 0 endif enddo enddo end subroutine cp_from_g2 !****************************************************************** subroutine br_from_g2 ! OBSOLETE ! ! uses the effective couplings contained in g2 to calculate ! branching ratios !***************************************************************** use usefulbits, only : np,Hneut,ndat implicit none !--------------------------------------internal integer :: jj !--------------------------------------------- if(np(Hneut)<1)stop 'error in br_from_g2 (np(Hneut))' do jj=1,ndat call br_from_g2_for_datapoint(jj) enddo end subroutine br_from_g2 !***************************************************************** subroutine br_from_g2_for_datapoint(jj) ! OBSOLETE ! ! uses the effective couplings contained in g2 to calculate ! branching ratios !***************************************************************** use theory_BRfunctions use S95tables, only : inrange use usefulbits, only : g2,ms,mc,mbmb,mmu,mtau,small implicit none integer, intent(in) :: jj !--------------------------------------internal integer :: i double precision :: Mhi,GammaRat !--------------------------------------------- do i=1,np(Hneut) Mhi=theo(jj)%particle(Hneut)%M(i) if(theo(jj)%particle(Hneut)%Mc(i).ge.small) Mhi=theo(jj)%particle(Hneut)%Mc(i) theo(jj)%BR_hjss(i) = 0.0D0 theo(jj)%BR_hjcc(i) = 0.0D0 theo(jj)%BR_hjbb(i) = 0.0D0 theo(jj)%BR_hjmumu(i) = 0.0D0 theo(jj)%BR_hjtautau(i)= 0.0D0 theo(jj)%BR_hjWW(i) = 0.0D0 theo(jj)%BR_hjZZ(i) = 0.0D0 theo(jj)%BR_hjZga(i) = 0.0D0 theo(jj)%BR_hjgaga(i) = 0.0D0 theo(jj)%BR_hjgg(i) = 0.0D0 if( inrange(Mhi,'SMBR') )then GammaRat=theo(jj)%particle(Hneut)%GammaTot(i)/BRSM_GammaTot(Mhi) if(theo(jj)%particle(Hneut)%GammaTot(i).gt.0.0D0)then theo(jj)%BR_hjss(i) = ( g2(jj)%hjss_s(i) +g2(jj)%hjss_p(i) *invbsq(ms, Mhi) ) *BRSM_Hss(Mhi) /GammaRat theo(jj)%BR_hjcc(i) = ( g2(jj)%hjcc_s(i) +g2(jj)%hjcc_p(i) *invbsq(mc, Mhi) ) *BRSM_Hcc(Mhi) /GammaRat theo(jj)%BR_hjbb(i) = ( g2(jj)%hjbb_s(i) +g2(jj)%hjbb_p(i) *invbsq(mbmb,Mhi) ) *BRSM_Hbb(Mhi) /GammaRat theo(jj)%BR_hjmumu(i) = ( g2(jj)%hjmumu_s(i) +g2(jj)%hjmumu_p(i) *invbsq(mmu, Mhi) ) *BRSM_Hmumu(Mhi) /GammaRat theo(jj)%BR_hjtautau(i)= ( g2(jj)%hjtautau_s(i)+g2(jj)%hjtautau_p(i)*invbsq(mtau,Mhi) ) *BRSM_Htautau(Mhi) /GammaRat theo(jj)%BR_hjWW(i) = g2(jj)%hjWW(i) *BRSM_HWW(Mhi) /GammaRat theo(jj)%BR_hjZZ(i) = g2(jj)%hjZZ(i) *BRSM_HZZ(Mhi) /GammaRat theo(jj)%BR_hjZga(i) = g2(jj)%hjZga(i) *BRSM_HZga(Mhi) /GammaRat theo(jj)%BR_hjgaga(i) = g2(jj)%hjgaga(i) *BRSM_Hgaga(Mhi) /GammaRat theo(jj)%BR_hjgg(i) = g2(jj)%hjgg(i) *BRSM_Hgg(Mhi) /GammaRat else write(*,*)'at jj=',jj,'i=',i write(*,*)'total decay width is less than or equal to zero:',theo(jj)%particle(Hneut)%GammaTot(i) endif endif enddo end subroutine br_from_g2_for_datapoint !***************************************************************** function invbsq(mf,mh) implicit none double precision,intent(in) :: mf,mh double precision :: invbsq if(mh>2.0D0*mf)then invbsq=1.0D0/(1.0D0-4.0D0*(mf/mh)**2.0D0) else invbsq=0.0D0 endif end function invbsq !***************************************************************** subroutine check_dataset ! checks each parameter point to determine whether the Higgs masses ! and branching ratios make sense ! Sets theo(jj)%gooddataset accordingly !***************************************************************** use usefulbits, only : theo,ndat,debug,np,vsmall implicit none !--------------------------------------internal integer :: jj,kk,ll,mm,x double precision :: testsumBR,testsumBR_t double precision,allocatable :: testBR(:) double precision :: fuzziness double precision, allocatable :: sumhjhi(:), sumhjHpi(:) !--------------------------------------------- fuzziness = 0.01D0 !fuzziness = 100.0D0 ; write(*,*)'WARNING: fuzziness factor is far too high' testsumBR =0.0D0 testsumBR_t =0.0D0 if(np(Hneut)>0)then allocate(testBR(np(Hneut))) allocate(sumhjhi(np(Hneut))) allocate(sumhjHpi(np(Hneut))) ! testing to see if the dataset is ok do jj=1,ndat do kk=1,np(Hneut) do ll=1,np(Hneut) do mm=1,np(Hneut) ! write(*,'(a,I2,a,I2,a,I2,a,1F10.8)') "BR_hkhjhi(",kk,",",ll,",",mm,")=",theo(jj)%BR_hkhjhi(kk,ll,mm) if(abs(theo(jj)%BR_hkhjhi(kk,ll,mm)-theo(jj)%BR_hkhjhi(kk,mm,ll)).gt.vsmall) then if(theo(jj)%BR_hkhjhi(kk,ll,mm).lt.vsmall) then theo(jj)%BR_hkhjhi(kk,ll,mm)=theo(jj)%BR_hkhjhi(kk,mm,ll) ! write(*,'(a,I2,a,I2,a,I2,a)') "WARNING: BR_hkhjhi is not symmetric. Correcting BR_hkhjhi(",& ! & kk,",",ll,",",mm,") element..." else if(theo(jj)%BR_hkhjhi(kk,mm,ll).lt.vsmall) then theo(jj)%BR_hkhjhi(kk,mm,ll)=theo(jj)%BR_hkhjhi(kk,ll,mm) ! write(*,'(a,I2,a,I2,a,I2,a)') "WARNING: BR_hkhjhi is not symmetric. Correcting BR_hkhjhi(",& ! & kk,",",mm,",",ll,") element..." else write(*,*) "WARNING: BR_hkhjhi is not symmetric." endif endif enddo enddo enddo sumhjhi = 0.0D0 do kk=lbound(theo(jj)%BR_hkhjhi,dim=1),ubound(theo(jj)%BR_hkhjhi,dim=1) do ll=lbound(theo(jj)%BR_hkhjhi,dim=2),ubound(theo(jj)%BR_hkhjhi,dim=2) do mm=lbound(theo(jj)%BR_hkhjhi,dim=3),ll sumhjhi(kk) = sumhjhi(kk) + theo(jj)%BR_hkhjhi(kk,ll,mm) ! write(*,*) "kk,ll,mm, sumhjhi = ", kk, ll, mm, sumhjhi enddo enddo enddo sumhjHpi = 0.0D0 if(np(Hplus).gt.0) then sumhjHpi = sum(theo(jj)%BR_hjHpiW,dim=2) endif testBR = theo(jj)%BR_hjss & & + theo(jj)%BR_hjcc & & + theo(jj)%BR_hjbb & & + theo(jj)%BR_hjtt & & + theo(jj)%BR_hjmumu & & + theo(jj)%BR_hjtautau & & + theo(jj)%BR_hjemu & & + theo(jj)%BR_hjetau & & + theo(jj)%BR_hjmutau & & + theo(jj)%BR_hjWW & & + theo(jj)%BR_hjZZ & & + theo(jj)%BR_hjZga & & + theo(jj)%BR_hjgg & & + theo(jj)%BR_hjgaga & & + sum(theo(jj)%BR_hjhiZ,dim=2) & & + sumhjhi + sumhjHpi ! write(*,*) 'sumhjhi = ',sumhjhi ! write(*,*) 'sum(theo(jj)%BR_hjhiZ,dim=2) = ', sum(theo(jj)%BR_hjhiZ,dim=2) ! write(*,*) 'debug: testBR = ', testBR testsumBR = maxval( testBR ) if( testsumBR .gt. 1.0D0+fuzziness )then ! if(debug) write(*,*) 'warning: sum of BR for '//trim(adjustl(pdesc(Hneut)%long))//& &' ',maxloc(testBR),' at line number=',jj,'is',testsumBR write(*,*) 'BR(h',maxloc(testBR),'->WW)=',theo(jj)%BR_hjWW( maxloc(testBR) ) write(*,*) 'BR(h',maxloc(testBR),'->ZZ)=',theo(jj)%BR_hjZZ( maxloc(testBR) ) write(*,*) 'BR(h',maxloc(testBR),'->gg)=',theo(jj)%BR_hjgg( maxloc(testBR) ) write(*,*) 'BR(h',maxloc(testBR),'->gaga)=',theo(jj)%BR_hjgaga( maxloc(testBR) ) write(*,*) 'BR(h',maxloc(testBR),'->bb)=',theo(jj)%BR_hjbb( maxloc(testBR) ) write(*,*) 'BR(h',maxloc(testBR),'->tautau)=',theo(jj)%BR_hjtautau( maxloc(testBR) ) write(*,*) 'BR(h',maxloc(testBR),'->tt)=',theo(jj)%BR_hjtt( maxloc(testBR) ) write(*,*) 'BR(h',maxloc(testBR),'->hiZ)=',theo(jj)%BR_hjhiZ( maxloc(testBR),:) write(*,*) 'sum(BR(h',maxloc(testBR),'->hjhi))=',sumhjhi( maxloc(testBR)) write(*,*) 'sum(BR(h',maxloc(testBR),'->HpjW))=',sumhjHpi( maxloc(testBR)) endif enddo deallocate(testBR) endif if(np(Hplus)>0)then allocate(testBR(np(Hplus))) do jj=1,ndat testBR = theo(jj)%BR_Hpjcs & & + theo(jj)%BR_Hpjcb & & + theo(jj)%BR_Hpjtaunu testsumBR = maxval( testBR ) testsumBR_t = theo(jj)%BR_tWpb & & + sum(theo(jj)%BR_tHpjb,dim=1) if( testsumBR .gt. 1.0D0+fuzziness )then if(debug)write(*,*) 'warning: sum of BR for '//trim(adjustl(pdesc(Hplus)%long))//' at line number=',jj,'is',testsumBR elseif( testsumBR_t .gt. 1.0D0+fuzziness )then if(debug)write(*,*) 'warning: sum of BR for the top quark at jj=',jj,'is',testsumBR_t endif enddo deallocate(testBR) endif do jj=1,ndat theo(jj)%gooddataset=.True. enddo do x=1,ubound(np,dim=1) if(np(x)>0)then do jj=1,ndat if( minval(theo(jj)%particle(x)%M).lt.0.0D0)then theo(jj)%gooddataset=.False. if(debug)write(*,*) 'warning: negative mass for '//trim(adjustl(pdesc(x)%long))//' at line number=',jj,theo(jj)%particle(x)%M !elseif( testsumBR_hj .gt. (1.0D0+fuzziness) )then !i.e. branching ratios for one of the Higgs add up to more than 1+fuzziness ! !theo(jj)%gooddataset=.False. elseif( .not. (sum(theo(jj)%particle(x)%M).ge.0.0D0) )then theo(jj)%gooddataset=.False. write(*,*) 'warning: mass is NaN for '//trim(adjustl(pdesc(x)%long))//' at line number=',jj,theo(jj)%particle(x)%M elseif( minval(theo(jj)%particle(x)%GammaTot).lt.0.0D0)then theo(jj)%gooddataset=.False. if(debug)write(*,*) 'warning: negative total decay width for '//trim(adjustl(pdesc(x)%long))// & & ' at line number=',jj,theo(jj)%particle(x)%GammaTot !elseif( testsumBR_hj .gt. (1.0D0+fuzziness) )then !i.e. branching ratios for one of the Higgs add up to more than 1+fuzziness ! !theo(jj)%gooddataset=.False. elseif( .not. (sum(theo(jj)%particle(x)%GammaTot).ge.0.0D0) )then theo(jj)%gooddataset=.False. if(debug)write(*,*) 'warning: total decay width is NaN for '//trim(adjustl(pdesc(x)%long))// & & ' at line number=',jj,theo(jj)%particle(x)%GammaTot endif enddo endif enddo end subroutine check_dataset !***************************************************************** subroutine fill_theo_SM ! fills the Standard Model part of theo ! We do this here to save computational time - these quantities will be ! needed a few times in subroutine calcfact_t1, so don't want to calculate them each time !************************************************************ use theory_BRfunctions use theory_XS_SM_functions use usefulbits, only : ndat use S95tables, only : inrange implicit none !--------------------------------------internal integer :: n !---------------------------------------------- if(np(Hneut)<1)stop 'error in subroutine fill_theo_SM (np(Hneut))' do n=1,ndat call fill_theo_SM_for_datapoint(n) enddo end subroutine fill_theo_SM !***************************************************************** subroutine fill_theo_SM_for_datapoint(n) ! fills the Standard Model part of theo ! We do this here to save computational time - these quantities will be ! needed a few times in subroutine calcfact_t1, so don't want to calculate them each time !************************************************************ use theory_BRfunctions use theory_XS_SM_functions use usefulbits, only : theo,small use S95tables, only : inrange implicit none integer, intent(in) :: n !--------------------------------------internal integer :: i double precision :: Mhi !---------------------------------------------- if(theo(n)%gooddataset) then do i=1,np(Hneut) Mhi=theo(n)%particle(Hneut)%M(i) if(theo(n)%particle(Hneut)%Mc(i).ge.small) Mhi=theo(n)%particle(Hneut)%Mc(i) ! write(*,*) 'DEBUG HB - running fill_theo_SM_for_datapoint for theo_Mh = ', theo(n)%particle(Hneut)%M, & ! i, theo(n)%particle(Hneut)%M(i) ! write(*,*) 'DEBUG HB - running fill_theo_SM_for_datapoint for Mh = ', Mhi ! write(*,*) 'DEBUG HB - running fill_theo_SM_for_datapoint BRs = ', BRSM_HWW(Mhi) if(inrange(Mhi,'SMBR'))then theo(n)%BR_HWW_SM(i) = BRSM_HWW(Mhi) theo(n)%BR_HZZ_SM(i) = BRSM_HZZ(Mhi) theo(n)%BR_Hbb_SM(i) = BRSM_Hbb(Mhi) theo(n)%BR_Htt_SM(i) = BRSM_Htoptop(Mhi) !HB-5 new theo(n)%BR_Hcc_SM(i) = BRSM_Hcc(Mhi) theo(n)%BR_Hss_SM(i) = BRSM_Hss(Mhi) theo(n)%BR_Hmumu_SM(i) = BRSM_Hmumu(Mhi) theo(n)%BR_Htautau_SM(i)= BRSM_Htautau(Mhi) theo(n)%BR_HZga_SM(i) = BRSM_HZga(Mhi) theo(n)%BR_Hgaga_SM(i) = BRSM_Hgaga(Mhi) theo(n)%BR_Hgg_SM(i) = BRSM_Hgg(Mhi) theo(n)%BR_Hjets_SM(i) = BRSM_Hss(Mhi)+BRSM_Hcc(Mhi)+BRSM_Hbb(Mhi)+BRSM_Hgg(Mhi) theo(n)%GammaTot_SM(i) = BRSM_GammaTot(Mhi) else theo(n)%BR_HWW_SM(i) = 0.0D0 theo(n)%BR_HZZ_SM(i) = 0.0D0 theo(n)%BR_Hbb_SM(i) = 0.0D0 theo(n)%BR_Hcc_SM(i) = 0.0D0 theo(n)%BR_Hss_SM(i) = 0.0D0 theo(n)%BR_Hmumu_SM(i) = 0.0D0 theo(n)%BR_Htautau_SM(i) = 0.0D0 theo(n)%BR_HZga_SM(i) = 0.0D0 theo(n)%BR_Hgaga_SM(i) = 0.0D0 theo(n)%BR_Hgg_SM(i) = 0.0D0 theo(n)%BR_Hjets_SM(i) = 0.0D0 theo(n)%GammaTot_SM(i) = 0.0D0 endif if(inrange(Mhi,'TEV '))then theo(n)%tev%XS_HZ_SM(i) = XS_tev_HZ_SM(Mhi) theo(n)%tev%XS_HW_SM(i) = XS_tev_HW_SM(Mhi) theo(n)%tev%XS_H_SM(i) = XS_tev_gg_H_SM(Mhi)+XS_tev_bb_H_SM(Mhi) theo(n)%tev%XS_gg_H_SM(i) = XS_tev_gg_H_SM(Mhi) !HB-5 new theo(n)%tev%XS_bb_H_SM(i) = XS_tev_bb_H_SM(Mhi) !HB-5 new theo(n)%tev%XS_vbf_SM(i)= XS_tev_vbf_SM(Mhi) theo(n)%tev%XS_ttH_SM(i)= XS_tev_ttH_SM(Mhi) theo(n)%tev%XS_tH_tchan_SM(i) = 0.0D0 !HB-5 new theo(n)%tev%XS_tH_schan_SM(i) = 0.0D0 !HB-5 new theo(n)%tev%XS_Hb_SM(i) = XS_tev_bg_Hb_SM(Mhi) theo(n)%tev%XS_Hb_c1_SM(i) = XS_tev_bg_Hb_c1_SM(Mhi) theo(n)%tev%XS_Hb_c2_SM(i) = XS_tev_bg_Hb_c2_SM(Mhi) theo(n)%tev%XS_Hb_c3_SM(i) = XS_tev_bg_Hb_c3_SM(Mhi) theo(n)%tev%XS_Hb_c4_SM(i) = XS_tev_bg_Hb_c4_SM(Mhi) else theo(n)%tev%XS_HW_SM(i) = 0.0D0 theo(n)%tev%XS_H_SM(i) = 0.0D0 theo(n)%tev%XS_gg_H_SM(i)= 0.0D0 theo(n)%tev%XS_bb_H_SM(i)= 0.0D0 theo(n)%tev%XS_HZ_SM(i) = 0.0D0 theo(n)%tev%XS_vbf_SM(i)= 0.0D0 theo(n)%tev%XS_ttH_SM(i)= 0.0D0 theo(n)%tev%XS_tH_tchan_SM(i) = 0.0D0 theo(n)%tev%XS_tH_tchan_SM(i) = 0.0D0 theo(n)%tev%XS_Hb_SM(i) = 0.0D0 theo(n)%tev%XS_Hb_c1_SM(i) = 0.0D0 theo(n)%tev%XS_Hb_c2_SM(i) = 0.0D0 theo(n)%tev%XS_Hb_c3_SM(i) = 0.0D0 theo(n)%tev%XS_Hb_c4_SM(i) = 0.0D0 endif if(inrange(Mhi,'LHC7 '))then theo(n)%lhc7%XS_HW_SM(i) = XS_lhc7_HW_SM(Mhi) theo(n)%lhc7%XS_H_SM(i) = XS_lhc7_gg_H_SM(Mhi) + XS_lhc7_bb_H_SM(Mhi) theo(n)%lhc7%XS_gg_H_SM(i) = XS_lhc7_gg_H_SM(Mhi) !HB-5 new theo(n)%lhc7%XS_bb_H_SM(i) = XS_lhc7_bb_H_SM(Mhi) !HB-5 new theo(n)%lhc7%XS_HZ_SM(i) = XS_lhc7_HZ_SM(Mhi) theo(n)%lhc7%XS_vbf_SM(i)= XS_lhc7_vbf_SM(Mhi) theo(n)%lhc7%XS_ttH_SM(i)= XS_lhc7_ttH_SM(Mhi) theo(n)%lhc7%XS_tH_tchan_SM(i) = XS_lhc7_tH_tchan_SM(Mhi) !HB-5 new theo(n)%lhc7%XS_tH_schan_SM(i) = XS_lhc7_tH_schan_SM(Mhi) !HB-5 new else theo(n)%lhc7%XS_HW_SM(i) = 0.0D0 theo(n)%lhc7%XS_H_SM(i) = 0.0D0 theo(n)%lhc7%XS_gg_H_SM(i)= 0.0D0 theo(n)%lhc7%XS_bb_H_SM(i)= 0.0D0 theo(n)%lhc7%XS_HZ_SM(i) = 0.0D0 theo(n)%lhc7%XS_vbf_SM(i)= 0.0D0 theo(n)%lhc7%XS_ttH_SM(i)= 0.0D0 theo(n)%lhc7%XS_tH_tchan_SM(i) = 0.0D0 !HB-5 new theo(n)%lhc7%XS_tH_tchan_SM(i) = 0.0D0 !HB-5 new endif if(inrange(Mhi,'LHC8 '))then theo(n)%lhc8%XS_HW_SM(i) = XS_lhc8_HW_SM(Mhi) theo(n)%lhc8%XS_H_SM(i) = XS_lhc8_gg_H_SM(Mhi) + XS_lhc8_bb_H_SM(Mhi) theo(n)%lhc8%XS_gg_H_SM(i) = XS_lhc8_gg_H_SM(Mhi) !HB-5 new theo(n)%lhc8%XS_bb_H_SM(i) = XS_lhc8_bb_H_SM(Mhi) !HB-5 new theo(n)%lhc8%XS_HZ_SM(i) = XS_lhc8_HZ_SM(Mhi) theo(n)%lhc8%XS_vbf_SM(i)= XS_lhc8_vbf_SM(Mhi) theo(n)%lhc8%XS_ttH_SM(i)= XS_lhc8_ttH_SM(Mhi) theo(n)%lhc8%XS_tH_tchan_SM(i) = XS_lhc8_tH_tchan_SM(Mhi) !HB-5 new theo(n)%lhc8%XS_tH_schan_SM(i) = XS_lhc8_tH_schan_SM(Mhi) !HB-5 new else theo(n)%lhc8%XS_HW_SM(i) = 0.0D0 theo(n)%lhc8%XS_H_SM(i) = 0.0D0 theo(n)%lhc8%XS_HZ_SM(i) = 0.0D0 theo(n)%lhc8%XS_vbf_SM(i)= 0.0D0 theo(n)%lhc8%XS_ttH_SM(i)= 0.0D0 theo(n)%lhc8%XS_tH_tchan_SM(i) = 0.0D0 !HB-5 new theo(n)%lhc8%XS_tH_tchan_SM(i) = 0.0D0 !HB-5 new endif if(inrange(Mhi,'LHC13'))then theo(n)%lhc13%XS_HW_SM(i) = XS_lhc13_HW_SM(Mhi) theo(n)%lhc13%XS_H_SM(i) = XS_lhc13_gg_H_SM(Mhi) + XS_lhc13_bb_H_SM(Mhi) theo(n)%lhc13%XS_gg_H_SM(i) = XS_lhc13_gg_H_SM(Mhi) !HB-5 new theo(n)%lhc13%XS_bb_H_SM(i) = XS_lhc13_bb_H_SM(Mhi) !HB-5 new theo(n)%lhc13%XS_HZ_SM(i) = XS_lhc13_HZ_SM(Mhi) theo(n)%lhc13%XS_vbf_SM(i)= XS_lhc13_vbf_SM(Mhi) theo(n)%lhc13%XS_ttH_SM(i)= XS_lhc13_ttH_SM(Mhi) theo(n)%lhc13%XS_tH_tchan_SM(i) = XS_lhc13_tH_tchan_SM(Mhi) !HB-5 new theo(n)%lhc13%XS_tH_schan_SM(i) = XS_lhc13_tH_schan_SM(Mhi) !HB-5 new else theo(n)%lhc13%XS_HW_SM(i) = 0.0D0 theo(n)%lhc13%XS_H_SM(i) = 0.0D0 theo(n)%lhc13%XS_HZ_SM(i) = 0.0D0 theo(n)%lhc13%XS_vbf_SM(i)= 0.0D0 theo(n)%lhc13%XS_ttH_SM(i)= 0.0D0 theo(n)%lhc13%XS_tH_tchan_SM(i) = 0.0D0 !HB-5 new theo(n)%lhc13%XS_tH_tchan_SM(i) = 0.0D0 !HB-5 new endif enddo endif end subroutine fill_theo_SM_for_datapoint !************************************************************ subroutine XS_from_partR ! OBSOLETE ! ! turn partonic cross section ratios in to hadronic cross section ! ratios ! Subroutine is complicated by the fact that if e.g. all ! the partR(n)%qq_hjW partonic cross section ratios are equal, ! just want to use this value for the hadronic cross section ! ratio and not lose any accuracy by combining with the tevS !************************************************************ use usefulbits, only : ndat use S95tables, only : inrange implicit none !--------------------------------------internal integer :: n !---------------------------------------------- if(np(Hneut)<1)stop 'error in subroutine XS_from_partR (np(Hneut))' do n=1,ndat call XS_from_partR_for_datapoint(n) enddo end subroutine XS_from_partR !****************************************************************** subroutine XS_from_partR_for_datapoint(n) ! OBSOLETE ! ! turn partonic cross section ratios in to hadronic cross section ! ratios ! Subroutine is complicated by the fact that if e.g. all ! the partR(n)%qq_hjW partonic cross section ratios are equal, ! just want to use this value for the hadronic cross section ! ratio and not lose any accuracy by combining with the tevS !************************************************************ use usefulbits, only : allocate_hadroncolliderextras_parts, & & deallocate_hadroncolliderextras_parts use S95tables, only : inrange implicit none integer, intent(in) :: n !--------------------------------------internal integer :: i double precision :: Mhi logical :: simple_partR !---------------------------------------------- call allocate_hadroncolliderextras_parts(tevS) call allocate_hadroncolliderextras_parts(lhc7S) call allocate_hadroncolliderextras_parts(lhc8S) if(theo(n)%gooddataset) then do i=1,np(Hneut) Mhi=theo(n)%particle(Hneut)%M(i) call fill_tevS(i,Mhi) call fill_lhc7S(i,Mhi) call fill_lhc8S(i,Mhi) !this if loop is here to make sure partR(n)%qq_hjWp(1,i).eq.0.0D0 is taken care of if(partR(n)%qq_hjWp(1,i).eq.0.0D0)then simple_partR=.False. elseif( (( sum(abs( partR(n)%qq_hjWp(:,i) - partR(n)%qq_hjWp(1,i))) & & + sum(abs( partR(n)%qq_hjWm(:,i) - partR(n)%qq_hjWp(1,i))) )/partR(n)%qq_hjWp(1,i)) .lt. 1.0D-5 )then simple_partR=.True. else simple_partR=.False. endif if(simple_partR)then theo(n)%tev%XS_hjW_ratio(i)=partR(n)%qq_hjWp(1,i) theo(n)%lhc7%XS_hjW_ratio(i)=partR(n)%qq_hjWp(1,i) theo(n)%lhc8%XS_hjW_ratio(i)=partR(n)%qq_hjWp(1,i) else theo(n)%tev%XS_hjW_ratio(i)= & & sum( partR(n)%qq_hjWp(:,i)*tevS(1)%qq_hjWp(:,i) ) & & + sum( partR(n)%qq_hjWm(:,i)*tevS(1)%qq_hjWm(:,i) ) theo(n)%lhc7%XS_hjW_ratio(i)= & & sum( partR(n)%qq_hjWp(:,i)*lhc7S(1)%qq_hjWp(:,i) ) & & + sum( partR(n)%qq_hjWm(:,i)*lhc7S(1)%qq_hjWm(:,i) ) theo(n)%lhc8%XS_hjW_ratio(i)= & & sum( partR(n)%qq_hjWp(:,i)*lhc8S(1)%qq_hjWp(:,i) ) & & + sum( partR(n)%qq_hjWm(:,i)*lhc8S(1)%qq_hjWm(:,i) ) endif theo(n)%tev%XS_hj_ratio(i)= & & partR(n)%gg_hj(i) *tevS(1)%gg_hj(i) & & + sum( partR(n)%qq_hj(:,i) *tevS(1)%qq_hj(:,i) ) theo(n)%lhc7%XS_hj_ratio(i)= & & partR(n)%gg_hj(i) *lhc7S(1)%gg_hj(i) & & + sum( partR(n)%qq_hj(:,i) *lhc7S(1)%qq_hj(:,i) ) theo(n)%lhc8%XS_hj_ratio(i)= & & partR(n)%gg_hj(i) *lhc8S(1)%gg_hj(i) & & + sum( partR(n)%qq_hj(:,i) *lhc8S(1)%qq_hj(:,i) ) !this if loop is here to make sure partR(n)%qq_hjZ(1,i).eq.0.0D0 is taken care of if(partR(n)%qq_hjZ(1,i).eq.0.0D0)then simple_partR=.False. elseif( (abs(sum( partR(n)%qq_hjZ(:,i) - partR(n)%qq_hjZ(1,i)))/partR(n)%qq_hjZ(1,i)).lt. 1.0D-5 )then simple_partR=.True. else simple_partR=.False. endif if( simple_partR )then theo(n)%tev%XS_hjZ_ratio(i) = partR(n)%qq_hjZ(1,i) if(partR(n)%gg_hjZ(i) .le.0.0D0)then theo(n)%lhc7%XS_hjZ_ratio(i)= partR(n)%qq_hjZ(1,i) theo(n)%lhc8%XS_hjZ_ratio(i)= partR(n)%qq_hjZ(1,i) else theo(n)%lhc7%XS_hjZ_ratio(i)= & & partR(n)%gg_hjZ(i) *lhc7S(1)%gg_hjZ(i) & & + sum( partR(n)%qq_hjZ(:,i) *lhc7S(1)%qq_hjZ(:,i) ) theo(n)%lhc8%XS_hjZ_ratio(i)= & & partR(n)%gg_hjZ(i) *lhc8S(1)%gg_hjZ(i) & & + sum( partR(n)%qq_hjZ(:,i) *lhc8S(1)%qq_hjZ(:,i) ) endif else theo(n)%tev%XS_hjZ_ratio(i)= & & partR(n)%gg_hjZ(i) *tevS(1)%gg_hjZ(i) & & + sum( partR(n)%qq_hjZ(:,i) *tevS(1)%qq_hjZ(:,i) ) theo(n)%lhc7%XS_hjZ_ratio(i)= & & partR(n)%gg_hjZ(i) *lhc7S(1)%gg_hjZ(i) & & + sum( partR(n)%qq_hjZ(:,i) *lhc7S(1)%qq_hjZ(:,i) ) theo(n)%lhc8%XS_hjZ_ratio(i)= & & partR(n)%gg_hjZ(i) *lhc8S(1)%gg_hjZ(i) & & + sum( partR(n)%qq_hjZ(:,i) *lhc8S(1)%qq_hjZ(:,i) ) endif theo(n)%tev%XS_hjb_ratio(i) = partR(n)%bg_hjb(i) theo(n)%lhc7%XS_hjb_ratio(i)= partR(n)%bg_hjb(i) theo(n)%lhc8%XS_hjb_ratio(i)= partR(n)%bg_hjb(i) theo(n)%tev%XS_gg_hj_ratio(i) = partR(n)%gg_hj(i) theo(n)%tev%XS_bb_hj_ratio(i) = partR(n)%bg_hjb(i) theo(n)%lhc7%XS_gg_hj_ratio(i) = partR(n)%gg_hj(i) theo(n)%lhc7%XS_bb_hj_ratio(i) = partR(n)%bg_hjb(i) theo(n)%lhc8%XS_gg_hj_ratio(i) = partR(n)%gg_hj(i) theo(n)%lhc8%XS_bb_hj_ratio(i) = partR(n)%bg_hjb(i) enddo endif call deallocate_hadroncolliderextras_parts(lhc8S) call deallocate_hadroncolliderextras_parts(lhc7S) call deallocate_hadroncolliderextras_parts(tevS) end subroutine XS_from_partR_for_datapoint !****************************************************************** subroutine fill_tevS(j,Mhj) ! OBSOLETE ! ! fills the elements of tevS using the functions in module theory_colliderSfunctions !************************************************************ use theory_colliderSfunctions use theory_XS_SM_functions use S95tables, only : inrange implicit none !--------------------------------------internal integer :: j double precision :: Mhj !---------------------------------------------- if(inrange(Mhj,'TEV '))then tevS(1)%qq_hjWp(1,j)=tev_rHWpm_udb(Mhj) tevS(1)%qq_hjWp(2,j)=tev_rHWpm_csb(Mhj) tevS(1)%qq_hjWm(1,j)=tev_rHWpm_dub(Mhj) tevS(1)%qq_hjWm(2,j)=tev_rHWpm_scb(Mhj) !We now have a new gg->H SM function: Should use XS functions instead of r's !For cross check with OB code changed this temporarily! tevS(1)%gg_hj(j)=tev_rH_gg(Mhj) !tevS(1)%gg_hj(j) =XS_tev_gg_H_SM(Mhj)/(XS_tev_gg_H_SM(Mhj)+XS_tev_bb_H_SM(Mhj)) tevS(1)%qq_hj(:,j)=0.0D0 tevS(1)%qq_hj(5,j)=tev_rH_bb(Mhj) !tevS(1)%qq_hj(5,j)=XS_tev_bb_H_SM(Mhj)/(XS_tev_gg_H_SM(Mhj)+XS_tev_bb_H_SM(Mhj)) tevS(1)%gg_hjZ(j)=0.0D0 tevS(1)%qq_hjZ(1,j)=tev_rHZ_ddb(Mhj) tevS(1)%qq_hjZ(2,j)=tev_rHZ_uub(Mhj) tevS(1)%qq_hjZ(3,j)=tev_rHZ_ssb(Mhj) tevS(1)%qq_hjZ(4,j)=tev_rHZ_ccb(Mhj) tevS(1)%qq_hjZ(5,j)=tev_rHZ_bbb(Mhj) if(abs(sum(tevS(1)%qq_hjWp(:,j))+sum(tevS(1)%qq_hjWm(:,j)) - 1.0D0) .gt. 1.0D-2)then stop 'error in fill_tevS (a)' elseif(abs(tevS(1)%gg_hj(j)+sum(tevS(1)%qq_hj(:,j)) - 1.0D0) .gt. 1.0D-2)then stop 'error in fill_tevS (b)' elseif(abs(tevS(1)%gg_hjZ(j)+sum(tevS(1)%qq_hjZ(:,j)) - 1.0D0) .gt. 1.0D-2)then stop 'error in fill_tevS (c)' endif else tevS(1)%qq_hjWp(:,j)=0.0D0 tevS(1)%qq_hjWm(:,j)=0.0D0 tevS(1)%gg_hj(j)=0.0D0 tevS(1)%qq_hj(:,j)=0.0D0 tevS(1)%gg_hjZ(j)=0.0D0 tevS(1)%qq_hjZ(:,j)=0.0D0 endif end subroutine fill_tevS !****************************************************************** subroutine fill_lhc7S(j,Mhj) ! OBSOLETE ! ! fills the elements of lhc7S using the functions in module theory_colliderSfunctions !************************************************************ use theory_colliderSfunctions use theory_XS_SM_functions use usefulbits, only : vsmall use S95tables, only : inrange implicit none !--------------------------------------internal integer :: j double precision :: Mhj !---------------------------------------------- if(inrange(Mhj,'LHC7 '))then lhc7S(1)%gg_hj(j)=LHC7_rH_gg(Mhj) lhc7S(1)%qq_hj(:,j)=0.0D0 lhc7S(1)%qq_hj(5,j)=LHC7_rH_bb(Mhj) if(abs(lhc7S(1)%gg_hj(j)+sum(lhc7S(1)%qq_hj(:,j)) - 1.0D0) .gt. 1.0D-2)then stop 'error in fill_lhc7S (b)' endif if(XS_lhc7_HW_SM(Mhj).lt.vsmall)then lhc7S(1)%qq_hjWp(:,j)=0.0D0 lhc7S(1)%qq_hjWm(:,j)=0.0D0 else lhc7S(1)%qq_hjWp(1,j)=LHC7_rHWp_udb(Mhj) lhc7S(1)%qq_hjWp(2,j)=LHC7_rHWp_csb(Mhj) lhc7S(1)%qq_hjWm(1,j)=LHC7_rHWm_dub(Mhj) lhc7S(1)%qq_hjWm(2,j)=LHC7_rHWm_scb(Mhj) if(abs(sum(lhc7S(1)%qq_hjWp(:,j))+sum(lhc7S(1)%qq_hjWm(:,j)) - 1.0D0) .gt. 1.0D-2)then ! write(*,*) "hello: ", Mhj stop 'error in fill_lhc7S (a)' endif endif if(XS_lhc7_HZ_SM(Mhj).lt.vsmall)then lhc7S(1)%gg_hjZ(j)=0.0D0 lhc7S(1)%qq_hjZ(:,j)=0.0D0 else lhc7S(1)%gg_hjZ(j)=LHC7_rHZ_gg(Mhj) lhc7S(1)%qq_hjZ(1,j)=LHC7_rHZ_ddb(Mhj) lhc7S(1)%qq_hjZ(2,j)=LHC7_rHZ_uub(Mhj) lhc7S(1)%qq_hjZ(3,j)=LHC7_rHZ_ssb(Mhj) lhc7S(1)%qq_hjZ(4,j)=LHC7_rHZ_ccb(Mhj) lhc7S(1)%qq_hjZ(5,j)=LHC7_rHZ_bbb(Mhj) if(abs(lhc7S(1)%gg_hjZ(j)+sum(lhc7S(1)%qq_hjZ(:,j)) - 1.0D0) .gt. 1.0D-2)then stop 'error in fill_lhc7S (c)' endif endif else lhc7S(1)%qq_hjWp(:,j)=0.0D0 lhc7S(1)%qq_hjWm(:,j)=0.0D0 lhc7S(1)%gg_hj(j)=0.0D0 lhc7S(1)%qq_hj(:,j)=0.0D0 lhc7S(1)%gg_hjZ(j)=0.0D0 lhc7S(1)%qq_hjZ(:,j)=0.0D0 endif end subroutine fill_lhc7S !****************************************************************** subroutine fill_lhc8S(j,Mhj) ! OBSOLETE ! ! fills the elements of lhc8S using the functions in module theory_colliderSfunctions !************************************************************ use theory_colliderSfunctions use theory_XS_SM_functions use usefulbits, only : vsmall use S95tables, only : inrange implicit none !--------------------------------------internal integer :: j double precision :: Mhj !---------------------------------------------- if(inrange(Mhj,'LHC8 '))then lhc8S(1)%gg_hj(j)=LHC8_rH_gg(Mhj) lhc8S(1)%qq_hj(:,j)=0.0D0 lhc8S(1)%qq_hj(5,j)=LHC8_rH_bb(Mhj) if(abs(lhc8S(1)%gg_hj(j)+sum(lhc8S(1)%qq_hj(:,j)) - 1.0D0) .gt. 1.0D-2)then stop 'error in fill_lhc8S (b)' endif if(XS_lhc8_HW_SM(Mhj).lt.vsmall)then lhc8S(1)%qq_hjWp(:,j)=0.0D0 lhc8S(1)%qq_hjWm(:,j)=0.0D0 else lhc8S(1)%qq_hjWp(1,j)=LHC8_rHWp_udb(Mhj) lhc8S(1)%qq_hjWp(2,j)=LHC8_rHWp_csb(Mhj) lhc8S(1)%qq_hjWm(1,j)=LHC8_rHWm_dub(Mhj) lhc8S(1)%qq_hjWm(2,j)=LHC8_rHWm_scb(Mhj) if(abs(sum(lhc8S(1)%qq_hjWp(:,j))+sum(lhc8S(1)%qq_hjWm(:,j)) - 1.0D0) .gt. 1.0D-2)then ! write(*,*) Mhj,sum(lhc8S(1)%qq_hjWp(:,j)), sum(lhc8S(1)%qq_hjWm(:,j)) stop 'error in fill_lhc8S (a)' endif endif if(XS_lhc8_HZ_SM(Mhj).lt.vsmall)then lhc8S(1)%gg_hjZ(j)=0.0D0 lhc8S(1)%qq_hjZ(:,j)=0.0D0 else lhc8S(1)%gg_hjZ(j)=LHC8_rHZ_gg(Mhj) lhc8S(1)%qq_hjZ(1,j)=LHC8_rHZ_ddb(Mhj) lhc8S(1)%qq_hjZ(2,j)=LHC8_rHZ_uub(Mhj) lhc8S(1)%qq_hjZ(3,j)=LHC8_rHZ_ssb(Mhj) lhc8S(1)%qq_hjZ(4,j)=LHC8_rHZ_ccb(Mhj) lhc8S(1)%qq_hjZ(5,j)=LHC8_rHZ_bbb(Mhj) if(abs(lhc8S(1)%gg_hjZ(j)+sum(lhc8S(1)%qq_hjZ(:,j)) - 1.0D0) .gt. 1.0D-2)then stop 'error in fill_lhc8S (c)' endif endif else lhc8S(1)%qq_hjWp(:,j)=0.0D0 lhc8S(1)%qq_hjWm(:,j)=0.0D0 lhc8S(1)%gg_hj(j)=0.0D0 lhc8S(1)%qq_hj(:,j)=0.0D0 lhc8S(1)%gg_hjZ(j)=0.0D0 lhc8S(1)%qq_hjZ(:,j)=0.0D0 endif end subroutine fill_lhc8S !****************************************************************** end module theo_manip !****************************************************************** Index: trunk/HiggsBounds-5/usefulbits.f90 =================================================================== --- trunk/HiggsBounds-5/usefulbits.f90 (revision 569) +++ trunk/HiggsBounds-5/usefulbits.f90 (revision 570) @@ -1,1460 +1,1462 @@ ! This file is part of HiggsBounds ! -KW !****************************************************************** module usefulbits !****************************************************************** implicit none logical :: debug = .False. logical :: full_dmth_variation = .True. integer :: dmhsteps = 3 ! Mass uncertainties smaller than 0.1 GeV are not considered double precision :: small_mh = 0.1D0 logical :: run_HB_classic = .False. logical :: wantkey = .True. logical :: extrapolatewidth = .True. ! For the CMS likelihood extension integer :: using_likelihood = 0 ! For the LEP chisq extension: logical :: chisqcut_at_mumax = .False. ! HB-5: logical :: BRdirectinput = .False. character(LEN=5) :: whichanalyses character(LEN=4) :: whichinput character(LEN=7) :: inputmethod = 'subrout' character(LEN=9),parameter :: vers='5.2.0beta' integer, parameter :: numres = 3 integer :: n_additional character(len=300) :: infile1,infile2 integer,parameter :: file_id_common=10 integer,parameter :: file_id_common2=12 integer,parameter :: file_id_common3=133 integer,parameter :: file_id_common4=134 integer,parameter :: file_id_debug1=444 integer,parameter :: file_id_debug2=45 integer, allocatable :: analysislist(:) integer, allocatable :: analysis_exclude_list(:) !read from http://pdg.lbl.gov/ 22.10.2009 double precision,parameter :: mt=173.2D0 double precision,parameter :: ms=0.105D0 double precision,parameter :: mc=1.27D0 double precision,parameter :: mbmb=4.20D0 double precision,parameter :: mmu=105.7D-3 double precision,parameter :: mtau=1.777D0 double precision,parameter :: MZ=91.1876D0 !PDG 2009 double precision,parameter :: MW=80.398D0 !PDG 2009 double precision,parameter :: GF=1.16637D-5 double precision,parameter :: pi=3.14159265358979323846264338328D0 double precision,parameter :: alphas=0.118D0 double precision,parameter :: small=1.0D-6 double precision,parameter :: vsmall=1.0D-16 double precision,parameter :: vvsmall=1.0D-100 type particledescriptions character(LEN=10) :: short character(LEN=30) :: long end type ! particle codes: (n.b. these are NOT pdg) integer,parameter :: not_a_particle = 0 integer,parameter :: Hneut = 1 !either Mhi, Mh2 or Mh3 (says nothing about CP properties) integer,parameter :: Hplus = 2 !single charged Higgs integer,parameter :: Chineut = 3 !either neutralino1, neutralino2, neutralino3 or neutralino4 integer,parameter :: Chiplus = 4 !either chargino1 or chargino2 integer :: np(0:4)=1 !e.g np(Hneut) holds number of neutral Higgs considered type(particledescriptions),allocatable :: pdesc(:) ! HB-5.2: Needed for the channelrates_matrix - integer, parameter :: Nprod = 7 - integer, parameter :: Ndecay = 9 +! integer, parameter :: Nprod = 7 +! integer, parameter :: Ndecay = 9 + integer, parameter :: Nprod = 11 + integer, parameter :: Ndecay = 11 !for subroutine version-------------------- (HB5: Removed!) ! type inputsubroutineinfo ! integer :: stat ! character(LEN=40) :: desc ! integer :: req ! end type ! type(inputsubroutineinfo),allocatable :: inputsub(:) logical :: just_after_run !associated with 'channels'---------------- integer :: ntot type listprocesses integer :: tlist,ttype integer :: findi,findj integer :: corresponding_clsb_table_element end type type(listprocesses), allocatable :: pr(:) type(listprocesses), allocatable :: prsep(:,:) !------------------------------------------- !associated with 'input'-------------------- type particlemasses double precision, allocatable :: M(:) ! Central value for mass with uncertainties double precision, allocatable :: Mc(:) double precision, allocatable :: GammaTot(:) ! Mass uncertainties (chi-2 test) used in HiggsSignals double precision, allocatable :: dM(:) ! Mass uncertainties (variation) used in HiggsBounds double precision, allocatable :: dMh(:) end type double precision, allocatable :: diffMhneut(:,:) double precision, allocatable :: diffMhch(:,:) double precision, allocatable :: dmn(:) double precision, allocatable :: dmch(:) integer ndmh integer ndat type lepdataset double precision, allocatable :: XS_hjZ_ratio(:) double precision, allocatable :: XS_bbhj_ratio(:) double precision, allocatable :: XS_tautauhj_ratio(:) double precision, allocatable :: XS_hjhi_ratio(:,:) double precision, allocatable :: XS_HpjHmj_ratio(:) double precision, allocatable :: XS_CpjCmj(:) double precision, allocatable :: XS_NjNi(:,:) end type type hadroncolliderdataset double precision, allocatable :: XS_hj_ratio(:) double precision, allocatable :: XS_gg_hj_ratio(:) ! HB-5: for gluon fusion double precision, allocatable :: XS_bb_hj_ratio(:) ! HB-5: for bb+Higgs production double precision, allocatable :: XS_hjZ_ratio(:) double precision, allocatable :: XS_gg_hjZ_ratio(:) ! HB-5 (TS 6.4.2018) double precision, allocatable :: XS_qq_hjZ_ratio(:) ! HB-5 (TS 6.4.2018) double precision, allocatable :: XS_hjW_ratio(:) double precision, allocatable :: XS_hjb_ratio(:) ! still needed? double precision, allocatable :: XS_tthj_ratio(:) double precision, allocatable :: XS_vbf_ratio(:) double precision, allocatable :: XS_thj_tchan_ratio(:) ! HB-5 double precision, allocatable :: XS_thj_schan_ratio(:) ! HB-5 double precision, allocatable :: XS_hjhi(:,:) ! HB-5 ! SM reference cross section holders: double precision, allocatable :: XS_HZ_SM(:) double precision, allocatable :: XS_gg_HZ_SM(:) ! HB-5 (TS 6.4.2018) double precision, allocatable :: XS_qq_HZ_SM(:) ! HB-5 (TS 6.4.2018) double precision, allocatable :: XS_HW_SM(:) double precision, allocatable :: XS_H_SM(:) double precision, allocatable :: XS_gg_H_SM(:) ! HB-5 double precision, allocatable :: XS_bb_H_SM(:) ! HB-5 !double precision, allocatable :: XS_H_SM_9713(:),XS_H_SM_9674(:) double precision, allocatable :: XS_ttH_SM(:) double precision, allocatable :: XS_tH_tchan_SM(:) ! HB-5 double precision, allocatable :: XS_tH_schan_SM(:) ! HB-5 double precision, allocatable :: XS_vbf_SM(:) ! Higgs produced in association with b, where b is tagged, comes uncut and with various cuts ! see subroutines in theory_XS_SM_functions.f90 for details double precision, allocatable :: XS_Hb_SM(:) double precision, allocatable :: XS_Hb_c1_SM(:),XS_Hb_c2_SM(:), XS_Hb_c3_SM(:),XS_Hb_c4_SM(:) ! HB-5: Charged Higgs production cross sections (in pb) double precision, allocatable :: XS_vbf_Hpj(:) ! for Hp_j production in VBF double precision, allocatable :: XS_Hpjtb(:) ! for Hp_j + t + b production double precision, allocatable :: XS_Hpjcb(:) ! for Hp_j + c + b production double precision, allocatable :: XS_Hpjbjet(:) ! for Hp_j + b + jet production double precision, allocatable :: XS_Hpjcjet(:) ! for Hp_j + b + jet production double precision, allocatable :: XS_Hpjjetjet(:) ! for Hp_j + jet + jet production double precision, allocatable :: XS_HpjW(:) ! for Hp_j + W production double precision, allocatable :: XS_HpjZ(:) ! for Hp_j + Z production double precision, allocatable :: XS_HpjHmj(:) ! (j,i), for Hp_j Hm_j production double precision, allocatable :: XS_Hpjhi(:,:) ! (j,i), for Hp_j h_i production ! HB-5.2 beyond the narrow-width approximation matrix: holds the SM normalized channel rates ! with the dimensions (N_H, N_production-modes, N_decay-modes) = (N_H, 7, 9), where the ! ordering is the following ! 1: singleH, 2: VBF, 3: WH, 4: ZH, 5: ttH, 6: gg->phi, 7: bb->phi ! 1: gaga, 2: WW, 3: ZZ, 4: tautau, 5:bb, 6: Zga, 7: cc, 8: mumu, 9: gg double precision, allocatable :: channelrates(:,:,:) ! We need a temporary copy for the interface (will be copied in complete_theo) double precision, allocatable :: channelrates_tmp(:,:,:) ! This one holds the corresponding SM rates (in pb), assuming the NWA: double precision, allocatable :: channelrates_SM(:,:,:) end type type dataset logical :: gooddataset integer, allocatable :: CP_value(:) double precision, allocatable :: additional(:) type(particlemasses), allocatable :: particle(:) double precision, allocatable :: BR_hjss(:),BR_hjcc(:) double precision, allocatable :: BR_hjbb(:),BR_hjtt(:) !HB-5 new H->tt double precision, allocatable :: BR_hjmumu(:),BR_hjtautau(:) double precision, allocatable :: BR_hjinvisible(:) double precision, allocatable :: BR_hjhihi(:,:) ! legacy HB-4 double precision, allocatable :: BR_hkhjhi(:,:,:) ! HB-5: for the decay h_k -> h_j h_i double precision, allocatable :: BR_hjhiZ(:,:) ! HB-5: for the decay h_j -> h_i Z double precision, allocatable :: BR_hjemu(:), BR_hjetau(:), BR_hjmutau(:) ! HB-5 double precision, allocatable :: BR_hjHpiW(:,:) ! HB-5: for the decay h_j -> Hp_i W type(lepdataset) :: lep !------------------------------------------- double precision, allocatable :: BR_hjWW(:),BR_hjgaga(:) double precision, allocatable :: BR_hjZga(:) double precision, allocatable :: BR_hjZZ(:),BR_hjgg(:) double precision :: BR_tWpb double precision, allocatable :: BR_tHpjb(:) double precision, allocatable :: BR_Hpjcs(:) double precision, allocatable :: BR_Hpjcb(:) double precision, allocatable :: BR_Hpjtaunu(:) double precision, allocatable :: BR_Hpjtb(:) ! HB-5: for the decay Hp_j -> t b double precision, allocatable :: BR_HpjWZ(:) ! HB-5: for the decay Hp_j -> W Z double precision, allocatable :: BR_HpjhiW(:,:) ! HB-5: for the decay Hp_j -> h_i W double precision, allocatable :: BR_CjqqNi(:,:) double precision, allocatable :: BR_CjlnuNi(:,:) double precision, allocatable :: BR_CjWNi(:,:) double precision, allocatable :: BR_NjqqNi(:,:) double precision, allocatable :: BR_NjZNi(:,:) type(hadroncolliderdataset) :: tev type(hadroncolliderdataset) :: lhc7 type(hadroncolliderdataset) :: lhc8 type(hadroncolliderdataset) :: lhc13 ! HB-5 ! NEW(24/09/2014, TS): ! double precision, allocatable :: gg_hj_ratio(:) ! double precision, allocatable :: bb_hj_ratio(:) double precision, allocatable :: BR_Htt_SM(:), BR_Hbb_SM(:) !HB-5 new H->tt double precision, allocatable :: BR_Hcc_SM(:),BR_Hss_SM(:) double precision, allocatable :: BR_Hmumu_SM(:),BR_Htautau_SM(:) double precision, allocatable :: BR_HWW_SM(:),BR_HZZ_SM(:),BR_HZga_SM(:),BR_Hgaga_SM(:),BR_Hgg_SM(:) double precision, allocatable :: BR_Hjets_SM(:) double precision, allocatable :: GammaTot_SM(:) !------------------------------------------- end type type(dataset), allocatable :: theo(:) type sqcouplratio double precision, allocatable :: hjss_s(:),hjss_p(:) double precision, allocatable :: hjcc_s(:),hjcc_p(:) double precision, allocatable :: hjbb_s(:),hjbb_p(:) double precision, allocatable :: hjtoptop_s(:),hjtoptop_p(:) ! ToDo: Change name top -> t ! double precision, allocatable :: hjmumu_s(:),hjmumu_p(:) double precision, allocatable :: hjtautau_s(:),hjtautau_p(:) double precision, allocatable :: hjWW(:),hjZZ(:) double precision, allocatable :: hjZga(:) double precision, allocatable :: hjgaga(:),hjgg(:),hjggZ(:) double precision, allocatable :: hjhiZ(:,:) end type type(sqcouplratio), allocatable :: g2(:) ! HB-5: NEW! --> type couplratio double precision, allocatable :: hjcc_s(:),hjcc_p(:) double precision, allocatable :: hjss_s(:),hjss_p(:) double precision, allocatable :: hjtt_s(:),hjtt_p(:) double precision, allocatable :: hjbb_s(:),hjbb_p(:) double precision, allocatable :: hjmumu_s(:),hjmumu_p(:) double precision, allocatable :: hjtautau_s(:),hjtautau_p(:) double precision, allocatable :: hjWW(:),hjZZ(:) double precision, allocatable :: hjZga(:) double precision, allocatable :: hjgaga(:),hjgg(:) !,hjggZ(:) double precision, allocatable :: hjhiZ(:,:) end type ! <--- ! type(couplratio), allocatable :: effC(:) type hadroncolliderextras !nq_hjWp,nq_hjWm,nq_hj,nq_hjZ are set in allocate_hadroncolliderextras_parts below double precision, allocatable :: qq_hjWp(:,:) integer :: nq_hjWp!=2 i.e. (u dbar), (c sbar) e.g. allocate(tR%qq_hjWp(tR%nq_hjWp,np(Hneut))) double precision, allocatable :: qq_hjWm(:,:) integer :: nq_hjWm!=2 i.e. (ubar d), (cbar s) double precision, allocatable :: gg_hj(:) double precision, allocatable :: qq_hj(:,:) integer :: nq_hj!=5 i.e.(d dbar), (u ubar), (s sbar), (c cbar), (b bbar) double precision, allocatable :: gg_hjZ(:) double precision, allocatable :: qq_hjZ(:,:) integer :: nq_hjZ!=5 i.e.(d dbar), (u ubar), (s sbar), (c cbar), (b bbar) double precision, allocatable :: bg_hjb(:) end type type(hadroncolliderextras), allocatable :: partR(:) !------------------------------------------- !associated with 'output'-------------------- integer rep type results integer, allocatable :: chan(:) double precision, allocatable :: obsratio(:) double precision, allocatable :: predratio(:) double precision, allocatable :: sfactor(:) double precision, allocatable :: axis_i(:) double precision, allocatable :: axis_j(:) integer, allocatable :: allowed95(:) integer, allocatable :: ncombined(:) character(LEN=4), allocatable :: channelselection(:) end type type(results), allocatable :: res(:) !--new in HB-4: type fullresults integer :: chan = 0 integer :: ncombined = 0 integer :: allowed95 = 1 double precision :: obsratio = 0.0D0 end type type(fullresults), allocatable :: fullHBres(:) integer, allocatable :: allocate_if_stats_required(:) ! Needed to store relevant information on next-to-most sensitive channels: integer,allocatable :: HBresult_all(:,:), chan_all(:,:), ncombined_all(:,:) double precision,allocatable :: obsratio_all(:,:),predratio_all(:,:) !------------------------------------------- contains subroutine HiggsBounds_info implicit none write(*,*) write(*,*)"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" write(*,*)"~ ~" write(*,*)"~ HiggsBounds "//adjustl(vers)//" ~" write(*,*)"~ ~" write(*,*)"~ Philip Bechtle, Daniel Dercks, Sven Heinemeyer, ~" write(*,*)"~ Tim Stefaniak, Georg Weiglein ~" write(*,*)"~ ~" write(*,*)"~ arXiv:0811.4169, arXiv:1102.1898, ~" write(*,*)"~ arXiv:1301.2345, arXiv:1311.0055 ~" write(*,*)"~ arXiv:1507.06706, ~" write(*,*)"~ http://higgsbounds.hepforge.org ~" write(*,*)"~ ~" write(*,*)"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" write(*,*) write(*,*)"HiggsBounds collects together results from " write(*,*) write(*,*)" * the LEP collaborations and LEP Higgs Working Group" write(*,*)" * the CDF and D0 Collaborations" write(*,*)" * the ATLAS and CMS Collaborations" write(*,*)" * the program HDECAY (arXiv:hep-ph/9704448)" write(*,*)" * the program VH@NNLO" write(*,*)" (arXiv:1210.5347,arXiv:1802.04817)" write(*,*)" * TeV4LHC Higgs Working Group report" write(*,*)" (see arXiv:hep-ph/0612172 and refs. therein)" write(*,*)" * LHC Higgs Cross Section Working Group" write(*,*)" (arXiv:1101.0593, arXiv:1201.3084, arXiv:1307.1347," write(*,*)" arXiv:1610.07922 and refs. therein, including the " write(*,*)" gluon fusion N3LO prediction (arXiv:1602.00695).)" end subroutine HiggsBounds_info !********************************************************** function div(a,b,divlimit,div0res) !********************************************************** ! be careful about using this - not a mathematical limit double precision :: div !--------------------------------------input double precision :: a,b,divlimit,div0res !-----------------------------------internal double precision :: small1,small2 !------------------------------------------- small1 = 1.0D-28 small2 = 1.0D-20 if(abs(b).gt.small1)then div=a/b elseif(abs(a).lt.small2)then div=divlimit if(div.lt.0)stop 'error type divA (see function div in module usefulbits)' else div=div0res if(div.lt.0)stop 'error type divB (see function div in module usefulbits)' endif end function !--TESTING !********************************************************** subroutine iselementofarray(value, array, output) !********************************************************** implicit none !-------------------------------------input and output double precision, intent(in) :: value double precision, allocatable, dimension(:), intent(in) :: array integer, intent(out) :: output !---------------------------------------------internal integer :: i double precision :: small !----------------------------------------------------- small = 1.0D-20 output = -1 if(allocated(array)) then do i=lbound(array,dim=1),ubound(array,dim=1) if(abs(value-array(i)).le.small) output = 1 enddo else stop 'error: Passing an unallocated array to subroutine iselementofarray!' endif end subroutine iselementofarray !---- !********************************************************** subroutine fill_pdesc !********************************************************** integer :: x if(ubound(np,dim=1).ne.4)stop 'error: have made a mistake in subroutine fill_pdesc (1)' x=0 allocate( pdesc( ubound(np,dim=1) ) ) x=x+1 pdesc(x)%short='h' pdesc(x)%long ='neutral Higgs boson' x=x+1 pdesc(x)%short='hplus' pdesc(x)%long ='charged Higgs boson' x=x+1 pdesc(x)%short='N' pdesc(x)%long ='neutralino' x=x+1 pdesc(x)%short='C' pdesc(x)%long ='chargino' if(x.ne.ubound(np,dim=1))stop 'error: have made a mistake in subroutine fill_pdesc (2)' end subroutine fill_pdesc !********************************************************** subroutine allocate_dataset_parts(d,n_addit) !********************************************************** implicit none !------------------------------------------- type(dataset) :: d(:) !--------------------------------------input integer, intent(in) :: n_addit !-----------------------------------internal integer :: n_add,x,y integer, allocatable :: np_t(:) !------------------------------------------- allocate(np_t(lbound(np,dim=1):ubound(np,dim=1))) np_t=np do x=lbound(np_t,dim=1),ubound(np_t,dim=1) if(np(x)>0)then np_t(x)=np(x) elseif(np(x).eq.0)then np_t(x)=1 else write(*,*)'np=',np stop 'error in subroutine allocate_dataset_parts (1)' endif enddo if(n_addit>0)then n_add=n_addit elseif(n_addit.eq.0)then n_add=1 else stop 'error in subroutine allocate_dataset_parts (2)' endif do x=lbound(d,dim=1),ubound(d,dim=1) allocate(d(x)%additional(n_add)) allocate(d(x)%particle( ubound(np_t,dim=1) )) do y= 1,ubound(np_t,dim=1) allocate(d(x)%particle(y)%M( np_t(y) )) allocate(d(x)%particle(y)%Mc( np_t(y) )) allocate(d(x)%particle(y)%GammaTot( np_t(y) )) allocate(d(x)%particle(y)%dM( np_t(y) )) allocate(d(x)%particle(y)%dMh( np_t(y) )) enddo allocate(d(x)%lep%XS_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lep%XS_bbhj_ratio( np_t(Hneut) )) allocate(d(x)%lep%XS_tautauhj_ratio( np_t(Hneut) )) allocate(d(x)%lep%XS_hjhi_ratio( np_t(Hneut),np_t(Hneut) )) allocate(d(x)%lep%XS_HpjHmj_ratio( np_t(Hplus) )) allocate(d(x)%lep%XS_CpjCmj( np_t(Chiplus) )) allocate(d(x)%lep%XS_NjNi( np_t(Chineut),np_t(Chineut) )) allocate(d(x)%BR_hjss( np_t(Hneut) )) allocate(d(x)%BR_hjcc( np_t(Hneut) )) allocate(d(x)%BR_hjbb( np_t(Hneut) )) allocate(d(x)%BR_hjtt( np_t(Hneut) )) allocate(d(x)%BR_hjmumu( np_t(Hneut) )) allocate(d(x)%BR_hjtautau( np_t(Hneut) )) allocate(d(x)%BR_hkhjhi( np_t(Hneut),np_t(Hneut),np_t(Hneut) )) allocate(d(x)%BR_hjhihi( np_t(Hneut),np_t(Hneut) )) allocate(d(x)%BR_hjhiZ( np_t(Hneut),np_t(Hneut) )) allocate(d(x)%BR_hjHpiW( np_t(Hneut),np_t(Hplus) )) allocate(d(x)%BR_hjWW( np_t(Hneut) )) allocate(d(x)%BR_hjZZ( np_t(Hneut) )) allocate(d(x)%BR_hjZga( np_t(Hneut) )) allocate(d(x)%BR_hjgaga( np_t(Hneut) )) allocate(d(x)%BR_hjgg( np_t(Hneut) )) allocate(d(x)%BR_hjinvisible( np_t(Hneut) )) allocate(d(x)%BR_hjemu( np_t(Hneut) )) allocate(d(x)%BR_hjetau( np_t(Hneut) )) allocate(d(x)%BR_hjmutau( np_t(Hneut) )) allocate(d(x)%BR_tHpjb( np_t(Hplus) )) allocate(d(x)%BR_Hpjcs( np_t(Hplus) )) allocate(d(x)%BR_Hpjcb( np_t(Hplus) )) allocate(d(x)%BR_Hpjtaunu( np_t(Hplus) )) allocate(d(x)%BR_Hpjtb( np_t(Hplus) )) allocate(d(x)%BR_HpjWZ( np_t(Hplus) )) allocate(d(x)%BR_HpjhiW( np_t(Hplus),np_t(Hneut) )) allocate(d(x)%BR_CjqqNi( np_t(Chiplus),np_t(Chineut) )) allocate(d(x)%BR_CjlnuNi( np_t(Chiplus),np_t(Chineut) )) allocate(d(x)%BR_CjWNi( np_t(Chiplus),np_t(Chineut) )) allocate(d(x)%BR_NjqqNi( np_t(Chineut),np_t(Chineut) )) allocate(d(x)%BR_NjZNi( np_t(Chineut),np_t(Chineut) )) allocate(d(x)%tev%XS_hjb_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_tthj_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_vbf_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_gg_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_qq_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_hjW_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_hj_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_gg_hj_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_bb_hj_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_thj_tchan_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_thj_schan_ratio( np_t(Hneut) )) allocate(d(x)%tev%XS_hjhi( np_t(Hneut),np_t(Hneut) )) allocate(d(x)%tev%XS_vbf_Hpj( np_t(Hplus) )) allocate(d(x)%tev%XS_Hpjtb( np_t(Hplus) )) allocate(d(x)%tev%XS_Hpjcb( np_t(Hplus) )) allocate(d(x)%tev%XS_Hpjbjet( np_t(Hplus) )) allocate(d(x)%tev%XS_Hpjcjet( np_t(Hplus) )) allocate(d(x)%tev%XS_Hpjjetjet( np_t(Hplus) )) allocate(d(x)%tev%XS_HpjW( np_t(Hplus) )) allocate(d(x)%tev%XS_HpjZ( np_t(Hplus) )) allocate(d(x)%tev%XS_HpjHmj( np_t(Hplus) )) allocate(d(x)%tev%XS_Hpjhi( np_t(Hplus), np_t(Hneut) )) allocate(d(x)%tev%channelrates(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%tev%channelrates_tmp(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%lhc7%XS_hjb_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_tthj_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_vbf_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_gg_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_qq_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_hjW_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_gg_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_bb_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_thj_tchan_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_thj_schan_ratio( np_t(Hneut) )) allocate(d(x)%lhc7%XS_hjhi( np_t(Hneut),np_t(Hneut) )) allocate(d(x)%lhc7%XS_vbf_Hpj( np_t(Hplus) )) allocate(d(x)%lhc7%XS_Hpjtb( np_t(Hplus) )) allocate(d(x)%lhc7%XS_Hpjcb( np_t(Hplus) )) allocate(d(x)%lhc7%XS_Hpjbjet( np_t(Hplus) )) allocate(d(x)%lhc7%XS_Hpjcjet( np_t(Hplus) )) allocate(d(x)%lhc7%XS_Hpjjetjet( np_t(Hplus) )) allocate(d(x)%lhc7%XS_HpjW( np_t(Hplus) )) allocate(d(x)%lhc7%XS_HpjZ( np_t(Hplus) )) allocate(d(x)%lhc7%XS_HpjHmj( np_t(Hplus) )) allocate(d(x)%lhc7%XS_Hpjhi( np_t(Hplus), np_t(Hneut) )) allocate(d(x)%lhc7%channelrates(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%lhc7%channelrates_tmp(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%lhc8%XS_hjb_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_tthj_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_vbf_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_gg_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_qq_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_hjW_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_gg_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_bb_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_thj_tchan_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_thj_schan_ratio( np_t(Hneut) )) allocate(d(x)%lhc8%XS_hjhi( np_t(Hneut),np_t(Hneut) )) allocate(d(x)%lhc8%XS_vbf_Hpj( np_t(Hplus) )) allocate(d(x)%lhc8%XS_Hpjtb( np_t(Hplus) )) allocate(d(x)%lhc8%XS_Hpjcb( np_t(Hplus) )) allocate(d(x)%lhc8%XS_Hpjbjet( np_t(Hplus) )) allocate(d(x)%lhc8%XS_Hpjcjet( np_t(Hplus) )) allocate(d(x)%lhc8%XS_Hpjjetjet( np_t(Hplus) )) allocate(d(x)%lhc8%XS_HpjW( np_t(Hplus) )) allocate(d(x)%lhc8%XS_HpjZ( np_t(Hplus) )) allocate(d(x)%lhc8%XS_HpjHmj( np_t(Hplus) )) allocate(d(x)%lhc8%XS_Hpjhi( np_t(Hplus), np_t(Hneut) )) allocate(d(x)%lhc8%channelrates(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%lhc8%channelrates_tmp(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%lhc13%XS_hjb_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_tthj_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_vbf_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_gg_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_qq_hjZ_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_hjW_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_gg_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_bb_hj_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_thj_tchan_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_thj_schan_ratio( np_t(Hneut) )) allocate(d(x)%lhc13%XS_hjhi( np_t(Hneut),np_t(Hneut) )) allocate(d(x)%lhc13%XS_vbf_Hpj( np_t(Hplus) )) allocate(d(x)%lhc13%XS_Hpjtb( np_t(Hplus) )) allocate(d(x)%lhc13%XS_Hpjcb( np_t(Hplus) )) allocate(d(x)%lhc13%XS_Hpjbjet( np_t(Hplus) )) allocate(d(x)%lhc13%XS_Hpjcjet( np_t(Hplus) )) allocate(d(x)%lhc13%XS_Hpjjetjet( np_t(Hplus) )) allocate(d(x)%lhc13%XS_HpjW( np_t(Hplus) )) allocate(d(x)%lhc13%XS_HpjZ( np_t(Hplus) )) allocate(d(x)%lhc13%XS_HpjHmj( np_t(Hplus) )) allocate(d(x)%lhc13%XS_Hpjhi( np_t(Hplus), np_t(Hneut) )) allocate(d(x)%lhc13%channelrates(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%lhc13%channelrates_tmp(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%CP_value( np_t(Hneut) )) do y= 1,ubound(np_t,dim=1) d(x)%particle(y)%M =-1.0D0 d(x)%particle(y)%Mc =-1.0D0 d(x)%particle(y)%GammaTot =0.0D0 d(x)%particle(y)%dM =0.0D0 d(x)%particle(y)%dMh =0.0D0 enddo d(x)%lep%XS_hjZ_ratio =0.0D0 d(x)%lep%XS_bbhj_ratio =0.0D0 d(x)%lep%XS_tautauhj_ratio =0.0D0 d(x)%lep%XS_hjhi_ratio =0.0D0 d(x)%lep%XS_HpjHmj_ratio =0.0D0 d(x)%lep%XS_CpjCmj =0.0D0 d(x)%lep%XS_NjNi =0.0D0 d(x)%BR_hjss =0.0D0 d(x)%BR_hjcc =0.0D0 d(x)%BR_hjbb =0.0D0 d(x)%BR_hjtt =0.0D0 d(x)%BR_hjmumu =0.0D0 d(x)%BR_hjtautau =0.0D0 d(x)%BR_hjWW =0.0D0 d(x)%BR_hjZZ =0.0D0 d(x)%BR_hjZga =0.0D0 d(x)%BR_hjgaga =0.0D0 d(x)%BR_hjgg =0.0D0 d(x)%BR_hjinvisible =0.0D0 d(x)%BR_hjhihi =0.0D0 d(x)%BR_hjhiZ =0.0D0 d(x)%BR_hkhjhi =0.0D0 d(x)%BR_hjHpiW =0.0D0 d(x)%BR_hjemu =0.0D0 d(x)%BR_hjetau =0.0D0 d(x)%BR_hjmutau =0.0D0 d(x)%BR_tWpb =0.0D0 d(x)%BR_tHpjb =0.0D0 d(x)%BR_Hpjcs =0.0D0 d(x)%BR_Hpjcb =0.0D0 d(x)%BR_Hpjtaunu =0.0D0 d(x)%BR_Hpjtb =0.0D0 d(x)%BR_HpjWZ =0.0D0 d(x)%BR_HpjhiW =0.0D0 d(x)%BR_CjqqNi =0.0D0 d(x)%BR_CjlnuNi =0.0D0 d(x)%BR_CjWNi =0.0D0 d(x)%BR_NjqqNi =0.0D0 d(x)%BR_NjZNi =0.0D0 d(x)%tev%XS_hjb_ratio =0.0D0 d(x)%tev%XS_tthj_ratio =0.0D0 d(x)%tev%XS_vbf_ratio =0.0D0 d(x)%tev%XS_hj_ratio =0.0D0 d(x)%tev%XS_hjW_ratio =0.0D0 d(x)%tev%XS_hjZ_ratio =0.0D0 d(x)%tev%XS_gg_hj_ratio = 0.0D0 d(x)%tev%XS_bb_hj_ratio = 0.0D0 d(x)%tev%XS_thj_tchan_ratio = 0.0D0 d(x)%tev%XS_thj_schan_ratio = 0.0D0 d(x)%tev%XS_hjhi = 0.0D0 d(x)%tev%XS_vbf_Hpj =0.0D0 d(x)%tev%XS_Hpjtb =0.0D0 d(x)%tev%XS_Hpjcb =0.0D0 d(x)%tev%XS_Hpjbjet =0.0D0 d(x)%tev%XS_Hpjcjet =0.0D0 d(x)%tev%XS_Hpjjetjet =0.0D0 d(x)%tev%XS_HpjW =0.0D0 d(x)%tev%XS_HpjZ =0.0D0 d(x)%tev%XS_HpjHmj =0.0D0 d(x)%tev%XS_Hpjhi =0.0D0 d(x)%tev%channelrates = 0.0D0 d(x)%tev%channelrates_tmp = -1.0D0 d(x)%lhc7%XS_hjb_ratio =0.0D0 d(x)%lhc7%XS_tthj_ratio =0.0D0 d(x)%lhc7%XS_vbf_ratio =0.0D0 d(x)%lhc7%XS_hj_ratio =0.0D0 d(x)%lhc7%XS_hjW_ratio =0.0D0 d(x)%lhc7%XS_hjZ_ratio =0.0D0 d(x)%lhc7%XS_gg_hj_ratio = 0.0D0 d(x)%lhc7%XS_bb_hj_ratio = 0.0D0 d(x)%lhc7%XS_thj_tchan_ratio = 0.0D0 d(x)%lhc7%XS_thj_schan_ratio = 0.0D0 d(x)%lhc7%XS_hjhi = 0.0D0 d(x)%lhc7%XS_vbf_Hpj =0.0D0 d(x)%lhc7%XS_Hpjtb =0.0D0 d(x)%lhc7%XS_Hpjcb =0.0D0 d(x)%lhc7%XS_Hpjbjet =0.0D0 d(x)%lhc7%XS_Hpjcjet =0.0D0 d(x)%lhc7%XS_Hpjjetjet =0.0D0 d(x)%lhc7%XS_HpjW =0.0D0 d(x)%lhc7%XS_HpjZ =0.0D0 d(x)%lhc7%XS_HpjHmj =0.0D0 d(x)%lhc7%XS_Hpjhi =0.0D0 d(x)%lhc7%channelrates = 0.0D0 d(x)%lhc7%channelrates_tmp = -1.0D0 d(x)%lhc8%XS_hjb_ratio =0.0D0 d(x)%lhc8%XS_tthj_ratio =0.0D0 d(x)%lhc8%XS_vbf_ratio =0.0D0 d(x)%lhc8%XS_hj_ratio =0.0D0 d(x)%lhc8%XS_hjW_ratio =0.0D0 d(x)%lhc8%XS_hjZ_ratio =0.0D0 d(x)%lhc8%XS_gg_hj_ratio = 0.0D0 d(x)%lhc8%XS_bb_hj_ratio = 0.0D0 d(x)%lhc8%XS_thj_tchan_ratio = 0.0D0 d(x)%lhc8%XS_thj_schan_ratio = 0.0D0 d(x)%lhc8%XS_hjhi = 0.0D0 d(x)%lhc8%XS_vbf_Hpj =0.0D0 d(x)%lhc8%XS_Hpjtb =0.0D0 d(x)%lhc8%XS_Hpjcb =0.0D0 d(x)%lhc8%XS_Hpjbjet =0.0D0 d(x)%lhc8%XS_Hpjcjet =0.0D0 d(x)%lhc8%XS_Hpjjetjet =0.0D0 d(x)%lhc8%XS_HpjW =0.0D0 d(x)%lhc8%XS_HpjZ =0.0D0 d(x)%lhc8%XS_HpjHmj =0.0D0 d(x)%lhc8%XS_Hpjhi =0.0D0 d(x)%lhc8%channelrates = 0.0D0 d(x)%lhc8%channelrates_tmp = -1.0D0 d(x)%lhc13%XS_hjb_ratio =0.0D0 d(x)%lhc13%XS_tthj_ratio =0.0D0 d(x)%lhc13%XS_vbf_ratio =0.0D0 d(x)%lhc13%XS_hj_ratio =0.0D0 d(x)%lhc13%XS_hjW_ratio =0.0D0 d(x)%lhc13%XS_hjZ_ratio =0.0D0 d(x)%lhc13%XS_gg_hj_ratio = 0.0D0 d(x)%lhc13%XS_bb_hj_ratio = 0.0D0 d(x)%lhc13%XS_thj_tchan_ratio = 0.0D0 d(x)%lhc13%XS_thj_schan_ratio = 0.0D0 d(x)%lhc13%XS_hjhi = 0.0D0 d(x)%lhc13%XS_vbf_Hpj =0.0D0 d(x)%lhc13%XS_Hpjtb =0.0D0 d(x)%lhc13%XS_Hpjcb =0.0D0 d(x)%lhc13%XS_Hpjbjet =0.0D0 d(x)%lhc13%XS_Hpjcjet =0.0D0 d(x)%lhc13%XS_Hpjjetjet =0.0D0 d(x)%lhc13%XS_HpjW =0.0D0 d(x)%lhc13%XS_HpjZ =0.0D0 d(x)%lhc13%XS_HpjHmj =0.0D0 d(x)%lhc13%XS_Hpjhi =0.0D0 d(x)%lhc13%channelrates = 0.0D0 d(x)%lhc13%channelrates_tmp = -1.0D0 d(x)%additional =0.0D0 d(x)%CP_value=0 enddo select case(whichanalyses) case('onlyH','LandH','onlyP','list ') do x=lbound(d,dim=1),ubound(d,dim=1) allocate(d(x)%tev%XS_HZ_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_HW_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_H_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_ttH_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_vbf_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_gg_H_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_bb_H_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_tH_tchan_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_tH_schan_SM( np_t(Hneut) )) allocate(d(x)%tev%channelrates_SM(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%tev%XS_Hb_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_Hb_c1_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_Hb_c2_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_Hb_c3_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_Hb_c4_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_gg_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_qq_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_HW_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_H_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_ttH_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_vbf_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_gg_H_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_bb_H_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_tH_tchan_SM( np_t(Hneut) )) allocate(d(x)%lhc7%XS_tH_schan_SM( np_t(Hneut) )) allocate(d(x)%lhc7%channelrates_SM(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%lhc7%XS_Hb_SM( np_t(Hneut) )) ! allocate(d(x)%lhc7%XS_Hb_c1_SM( np_t(Hneut) )) ! allocate(d(x)%lhc7%XS_Hb_c2_SM( np_t(Hneut) )) ! allocate(d(x)%lhc7%XS_Hb_c3_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_gg_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_qq_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_HW_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_H_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_ttH_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_vbf_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_gg_H_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_bb_H_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_tH_tchan_SM( np_t(Hneut) )) allocate(d(x)%lhc8%XS_tH_schan_SM( np_t(Hneut) )) allocate(d(x)%lhc8%channelrates_SM(np_t(Hneut),Nprod,Ndecay)) allocate(d(x)%lhc8%XS_Hb_SM( np_t(Hneut) )) ! allocate(d(x)%lhc8%XS_Hb_c1_SM( np_t(Hneut) )) ! allocate(d(x)%lhc8%XS_Hb_c2_SM( np_t(Hneut) )) ! allocate(d(x)%lhc8%XS_Hb_c3_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_gg_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_qq_HZ_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_HW_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_H_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_ttH_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_vbf_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_gg_H_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_bb_H_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_tH_tchan_SM( np_t(Hneut) )) allocate(d(x)%lhc13%XS_tH_schan_SM( np_t(Hneut) )) allocate(d(x)%lhc13%channelrates_SM(np_t(Hneut),Nprod,Ndecay)) ! allocate(d(x)%lhc8%XS_Hb_SM( np_t(Hneut) )) allocate(d(x)%BR_Hbb_SM( np_t(Hneut) )) allocate(d(x)%BR_Hcc_SM( np_t(Hneut) )) allocate(d(x)%BR_Hss_SM( np_t(Hneut) )) allocate(d(x)%BR_Htt_SM( np_t(Hneut) )) allocate(d(x)%BR_Hmumu_SM( np_t(Hneut) )) allocate(d(x)%BR_Htautau_SM( np_t(Hneut) )) allocate(d(x)%BR_HWW_SM( np_t(Hneut) )) allocate(d(x)%BR_HZZ_SM( np_t(Hneut) )) allocate(d(x)%BR_HZga_SM( np_t(Hneut) )) allocate(d(x)%BR_Hgaga_SM( np_t(Hneut) )) allocate(d(x)%BR_Hgg_SM( np_t(Hneut) )) allocate(d(x)%BR_Hjets_SM( np_t(Hneut) )) allocate(d(x)%GammaTot_SM( np_t(Hneut) )) enddo case('onlyL') case default stop 'error in allocate_dataset_parts (3)' end select deallocate(np_t) end subroutine allocate_dataset_parts !********************************************************** subroutine allocate_sqcouplratio_parts(gsq) ! to use this, gsq must be an array !********************************************************** implicit none !------------------------------------------- type(sqcouplratio) :: gsq(:) !-----------------------------------internal integer :: x integer :: nHiggsneut !------------------------------------------- if(np(Hneut)>0)then nHiggsneut=np(Hneut) elseif(np(Hneut).eq.0)then nHiggsneut=1 else stop 'error in subroutine allocate_sqcouplratio_parts (1)' endif do x=lbound(gsq,dim=1),ubound(gsq,dim=1) allocate(gsq(x)%hjss_s(nHiggsneut) ,gsq(x)%hjss_p(nHiggsneut)) allocate(gsq(x)%hjcc_s(nHiggsneut) ,gsq(x)%hjcc_p(nHiggsneut)) allocate(gsq(x)%hjbb_s(nHiggsneut) ,gsq(x)%hjbb_p(nHiggsneut)) allocate(gsq(x)%hjtoptop_s(nHiggsneut),gsq(x)%hjtoptop_p(nHiggsneut)) allocate(gsq(x)%hjmumu_s(nHiggsneut) ,gsq(x)%hjmumu_p(nHiggsneut)) allocate(gsq(x)%hjtautau_s(nHiggsneut),gsq(x)%hjtautau_p(nHiggsneut)) allocate(gsq(x)%hjWW(nHiggsneut) ,gsq(x)%hjZZ(nHiggsneut) ) allocate(gsq(x)%hjZga(nHiggsneut) ) allocate(gsq(x)%hjgaga(nHiggsneut) ,gsq(x)%hjgg(nHiggsneut) ) allocate(gsq(x)%hjggZ(nHiggsneut) ) allocate(gsq(x)%hjhiZ(nHiggsneut,nHiggsneut) ) gsq(x)%hjss_s =0.0D0 gsq(x)%hjss_p =0.0D0 gsq(x)%hjcc_s =0.0D0 gsq(x)%hjcc_p =0.0D0 gsq(x)%hjbb_s =0.0D0 gsq(x)%hjbb_p =0.0D0 gsq(x)%hjtoptop_s =0.0D0 gsq(x)%hjtoptop_p =0.0D0 gsq(x)%hjmumu_s =0.0D0 gsq(x)%hjmumu_p =0.0D0 gsq(x)%hjtautau_s =0.0D0 gsq(x)%hjtautau_p =0.0D0 gsq(x)%hjWW =0.0D0 gsq(x)%hjZZ =0.0D0 gsq(x)%hjZga =0.0D0 gsq(x)%hjgaga =0.0D0 gsq(x)%hjgg =0.0D0 gsq(x)%hjggZ =0.0D0 gsq(x)%hjhiZ =0.0D0 enddo end subroutine allocate_sqcouplratio_parts !********************************************************** subroutine allocate_couplratio_parts(g) ! to use this, gsq must be an array !********************************************************** implicit none !------------------------------------------- type(couplratio) :: g(:) !-----------------------------------internal integer :: x integer :: nHiggsneut !------------------------------------------- if(np(Hneut)>0)then nHiggsneut=np(Hneut) elseif(np(Hneut).eq.0)then nHiggsneut=1 else stop 'error in subroutine allocate_couplratio_parts (1)' endif do x=lbound(g,dim=1),ubound(g,dim=1) allocate(g(x)%hjss_s(nHiggsneut) ,g(x)%hjss_p(nHiggsneut)) allocate(g(x)%hjcc_s(nHiggsneut) ,g(x)%hjcc_p(nHiggsneut)) allocate(g(x)%hjbb_s(nHiggsneut) ,g(x)%hjbb_p(nHiggsneut)) allocate(g(x)%hjtt_s(nHiggsneut) ,g(x)%hjtt_p(nHiggsneut)) allocate(g(x)%hjmumu_s(nHiggsneut) ,g(x)%hjmumu_p(nHiggsneut)) allocate(g(x)%hjtautau_s(nHiggsneut),g(x)%hjtautau_p(nHiggsneut)) allocate(g(x)%hjWW(nHiggsneut) ,g(x)%hjZZ(nHiggsneut)) allocate(g(x)%hjZga(nHiggsneut)) allocate(g(x)%hjgaga(nHiggsneut) ,g(x)%hjgg(nHiggsneut)) ! allocate(g(x)%hjggZ(nHiggsneut) ) allocate(g(x)%hjhiZ(nHiggsneut,nHiggsneut)) g(x)%hjss_s =0.0D0 g(x)%hjss_p =0.0D0 g(x)%hjcc_s =0.0D0 g(x)%hjcc_p =0.0D0 g(x)%hjbb_s =0.0D0 g(x)%hjbb_p =0.0D0 g(x)%hjtt_s =0.0D0 g(x)%hjtt_p =0.0D0 g(x)%hjmumu_s =0.0D0 g(x)%hjmumu_p =0.0D0 g(x)%hjtautau_s =0.0D0 g(x)%hjtautau_p =0.0D0 g(x)%hjWW =0.0D0 g(x)%hjZZ =0.0D0 g(x)%hjZga =0.0D0 g(x)%hjgaga =0.0D0 g(x)%hjgg =0.0D0 ! g(x)%hjggZ =0.0D0 g(x)%hjhiZ =0.0D0 enddo end subroutine allocate_couplratio_parts ! !********************************************************** ! subroutine deallocate_sqcouplratio_parts(gsq) ! !********************************************************** ! implicit none ! !--------------------------------------input ! type(sqcouplratio) :: gsq(:) ! !-----------------------------------internal ! integer :: x ! !------------------------------------------- ! ! do x=lbound(gsq,dim=1),ubound(gsq,dim=1) ! deallocate(gsq(x)%hjbb ) ! deallocate(gsq(x)%hjtautau ) ! deallocate(gsq(x)%hjWW ) ! deallocate(gsq(x)%hjZZ ) ! deallocate(gsq(x)%hjgaga ) ! deallocate(gsq(x)%hjgg ) ! deallocate(gsq(x)%hjggZ ) ! deallocate(gsq(x)%hjhiZ ) ! enddo ! ! end subroutine deallocate_sqcouplratio_parts ! !********************************************************** subroutine allocate_hadroncolliderextras_parts(tR) !********************************************************** implicit none !------------------------------------------- type(hadroncolliderextras) :: tR(:) !-----------------------------------internal integer :: x integer :: nHiggsneut !------------------------------------------- if(np(Hneut)>0)then nHiggsneut=np(Hneut) elseif(np(Hneut).eq.0)then nHiggsneut=1 else stop 'error in subroutine allocate_hadroncolliderextras_parts (1)' endif tR%nq_hjWp=2 ! (u dbar), (c sbar) e.g tR%nq_hjWm=2 ! (ubar d), (cbar s) tR%nq_hj=5 !(d dbar), (u ubar), (s sbar), (c cbar), (b bbar) tR%nq_hjZ=5 !(d dbar), (u ubar), (s sbar), (c cbar), (b bbar) do x=lbound(tR,dim=1),ubound(tR,dim=1) allocate(tR(x)%qq_hjWp(tR(x)%nq_hjWp,nHiggsneut)) allocate(tR(x)%qq_hjWm(tR(x)%nq_hjWm,nHiggsneut)) allocate(tR(x)%gg_hj(nHiggsneut)) allocate(tR(x)%qq_hj(tR(x)%nq_hj,nHiggsneut)) allocate(tR(x)%gg_hjZ(nHiggsneut)) allocate(tR(x)%qq_hjZ(tR(x)%nq_hjZ,nHiggsneut)) allocate(tR(x)%bg_hjb(nHiggsneut)) tR(x)%qq_hjWp =0.0D0 tR(x)%qq_hjWm =0.0D0 tR(x)%gg_hj =0.0D0 tR(x)%qq_hj =0.0D0 tR(x)%gg_hjZ =0.0D0 tR(x)%qq_hjZ =0.0D0 tR(x)%bg_hjb =0.0D0 enddo end subroutine allocate_hadroncolliderextras_parts !********************************************************** subroutine deallocate_hadroncolliderextras_parts(tR) !********************************************************** implicit none !--------------------------------------input type(hadroncolliderextras) :: tR(:) !-----------------------------------internal integer :: x !------------------------------------------- do x=lbound(tR,dim=1),ubound(tR,dim=1) deallocate(tR(x)%qq_hjWp) deallocate(tR(x)%qq_hjWm) deallocate(tR(x)%gg_hj) deallocate(tR(x)%qq_hj) deallocate(tR(x)%gg_hjZ) deallocate(tR(x)%qq_hjZ) deallocate(tR(x)%bg_hjb) enddo end subroutine deallocate_hadroncolliderextras_parts !********************************************************** subroutine deallocate_usefulbits !********************************************************** ! deallocates theo,res (and everything inside) ! deallocates c,predratio,fact !************************************************************ implicit none !-----------------------------------internal integer x,y !------------------------------------------- deallocate(pdesc)!allocated in fill_pdesc !these are allocated in subroutine do_input do x=lbound(theo,dim=1),ubound(theo,dim=1) deallocate(theo(x)%additional) do y= 1,ubound(np,dim=1) deallocate(theo(x)%particle(y)%M) deallocate(theo(x)%particle(y)%GammaTot) deallocate(theo(x)%particle(y)%dM) deallocate(theo(x)%particle(y)%dMh) enddo deallocate(theo(x)%particle) deallocate(theo(x)%lep%XS_hjZ_ratio) deallocate(theo(x)%lep%XS_bbhj_ratio) deallocate(theo(x)%lep%XS_tautauhj_ratio) deallocate(theo(x)%lep%XS_hjhi_ratio) deallocate(theo(x)%lep%XS_HpjHmj_ratio) deallocate(theo(x)%lep%XS_CpjCmj) deallocate(theo(x)%lep%XS_NjNi) deallocate(theo(x)%BR_hjss) deallocate(theo(x)%BR_hjcc) deallocate(theo(x)%BR_hjbb) deallocate(theo(x)%BR_hjtt) deallocate(theo(x)%BR_hjmumu) deallocate(theo(x)%BR_hjtautau) deallocate(theo(x)%BR_hjhihi) deallocate(theo(x)%BR_hjhiZ) deallocate(theo(x)%BR_hkhjhi) deallocate(theo(x)%BR_hjHpiW) deallocate(theo(x)%BR_hjWW) deallocate(theo(x)%BR_hjZZ) deallocate(theo(x)%BR_hjZga) deallocate(theo(x)%BR_hjgaga) deallocate(theo(x)%BR_hjgg) deallocate(theo(x)%BR_hjinvisible) deallocate(theo(x)%BR_tHpjb) deallocate(theo(x)%BR_Hpjcs) deallocate(theo(x)%BR_Hpjcb) deallocate(theo(x)%BR_Hpjtaunu) deallocate(theo(x)%BR_Hpjtb) deallocate(theo(x)%BR_HpjWZ) deallocate(theo(x)%BR_HpjhiW) deallocate(theo(x)%BR_CjqqNi) deallocate(theo(x)%BR_CjlnuNi) deallocate(theo(x)%BR_CjWNi) deallocate(theo(x)%BR_NjqqNi) deallocate(theo(x)%BR_NjZNi) deallocate(theo(x)%tev%XS_hjb_ratio) deallocate(theo(x)%tev%XS_tthj_ratio) deallocate(theo(x)%tev%XS_vbf_ratio) deallocate(theo(x)%tev%XS_hjZ_ratio) deallocate(theo(x)%tev%XS_hjW_ratio) deallocate(theo(x)%tev%XS_hj_ratio) deallocate(theo(x)%tev%XS_gg_hj_ratio) deallocate(theo(x)%tev%XS_bb_hj_ratio) deallocate(theo(x)%tev%XS_thj_tchan_ratio) deallocate(theo(x)%tev%XS_thj_schan_ratio) deallocate(theo(x)%tev%XS_hjhi) deallocate(theo(x)%tev%XS_vbf_Hpj) deallocate(theo(x)%tev%XS_Hpjtb) deallocate(theo(x)%tev%XS_Hpjcb) deallocate(theo(x)%tev%XS_Hpjbjet) deallocate(theo(x)%tev%XS_Hpjcjet) deallocate(theo(x)%tev%XS_Hpjjetjet) deallocate(theo(x)%tev%XS_HpjW) deallocate(theo(x)%tev%XS_HpjZ) deallocate(theo(x)%tev%XS_HpjHmj) deallocate(theo(x)%tev%XS_Hpjhi) deallocate(theo(x)%tev%channelrates) deallocate(theo(x)%tev%channelrates_tmp) deallocate(theo(x)%lhc7%XS_hjb_ratio) deallocate(theo(x)%lhc7%XS_tthj_ratio) deallocate(theo(x)%lhc7%XS_vbf_ratio) deallocate(theo(x)%lhc7%XS_hjZ_ratio) deallocate(theo(x)%lhc7%XS_qq_hjZ_ratio) deallocate(theo(x)%lhc7%XS_gg_hjZ_ratio) deallocate(theo(x)%lhc7%XS_hjW_ratio) deallocate(theo(x)%lhc7%XS_hj_ratio) deallocate(theo(x)%lhc7%XS_gg_hj_ratio) deallocate(theo(x)%lhc7%XS_bb_hj_ratio) deallocate(theo(x)%lhc7%XS_thj_tchan_ratio) deallocate(theo(x)%lhc7%XS_thj_schan_ratio) deallocate(theo(x)%lhc7%XS_hjhi) deallocate(theo(x)%lhc7%XS_vbf_Hpj) deallocate(theo(x)%lhc7%XS_Hpjtb) deallocate(theo(x)%lhc7%XS_Hpjcb) deallocate(theo(x)%lhc7%XS_Hpjbjet) deallocate(theo(x)%lhc7%XS_Hpjcjet) deallocate(theo(x)%lhc7%XS_Hpjjetjet) deallocate(theo(x)%lhc7%XS_HpjW) deallocate(theo(x)%lhc7%XS_HpjZ) deallocate(theo(x)%lhc7%XS_HpjHmj) deallocate(theo(x)%lhc7%XS_Hpjhi) deallocate(theo(x)%lhc7%channelrates) deallocate(theo(x)%lhc7%channelrates_tmp) deallocate(theo(x)%lhc8%XS_hjb_ratio) deallocate(theo(x)%lhc8%XS_tthj_ratio) deallocate(theo(x)%lhc8%XS_vbf_ratio) deallocate(theo(x)%lhc8%XS_hjZ_ratio) deallocate(theo(x)%lhc8%XS_qq_hjZ_ratio) deallocate(theo(x)%lhc8%XS_gg_hjZ_ratio) deallocate(theo(x)%lhc8%XS_hjW_ratio) deallocate(theo(x)%lhc8%XS_hj_ratio) deallocate(theo(x)%lhc8%XS_gg_hj_ratio) deallocate(theo(x)%lhc8%XS_bb_hj_ratio) deallocate(theo(x)%lhc8%XS_thj_tchan_ratio) deallocate(theo(x)%lhc8%XS_thj_schan_ratio) deallocate(theo(x)%lhc8%XS_hjhi) deallocate(theo(x)%lhc8%XS_vbf_Hpj) deallocate(theo(x)%lhc8%XS_Hpjtb) deallocate(theo(x)%lhc8%XS_Hpjcb) deallocate(theo(x)%lhc8%XS_Hpjbjet) deallocate(theo(x)%lhc8%XS_Hpjcjet) deallocate(theo(x)%lhc8%XS_Hpjjetjet) deallocate(theo(x)%lhc8%XS_HpjW) deallocate(theo(x)%lhc8%XS_HpjZ) deallocate(theo(x)%lhc8%XS_HpjHmj) deallocate(theo(x)%lhc8%XS_Hpjhi) deallocate(theo(x)%lhc8%channelrates) deallocate(theo(x)%lhc8%channelrates_tmp) deallocate(theo(x)%lhc13%XS_hjb_ratio) deallocate(theo(x)%lhc13%XS_tthj_ratio) deallocate(theo(x)%lhc13%XS_vbf_ratio) deallocate(theo(x)%lhc13%XS_hjZ_ratio) deallocate(theo(x)%lhc13%XS_qq_hjZ_ratio) deallocate(theo(x)%lhc13%XS_gg_hjZ_ratio) deallocate(theo(x)%lhc13%XS_hjW_ratio) deallocate(theo(x)%lhc13%XS_hj_ratio) deallocate(theo(x)%lhc13%XS_gg_hj_ratio) deallocate(theo(x)%lhc13%XS_bb_hj_ratio) deallocate(theo(x)%lhc13%XS_thj_tchan_ratio) deallocate(theo(x)%lhc13%XS_thj_schan_ratio) deallocate(theo(x)%lhc13%XS_hjhi) deallocate(theo(x)%lhc13%XS_vbf_Hpj) deallocate(theo(x)%lhc13%XS_Hpjtb) deallocate(theo(x)%lhc13%XS_Hpjcb) deallocate(theo(x)%lhc13%XS_Hpjbjet) deallocate(theo(x)%lhc13%XS_Hpjcjet) deallocate(theo(x)%lhc13%XS_Hpjjetjet) deallocate(theo(x)%lhc13%XS_HpjW) deallocate(theo(x)%lhc13%XS_HpjZ) deallocate(theo(x)%lhc13%XS_HpjHmj) deallocate(theo(x)%lhc13%XS_Hpjhi) deallocate(theo(x)%lhc13%channelrates) deallocate(theo(x)%lhc13%channelrates_tmp) !deallocate(theo(x)%inLEPrange_Hpj) !deallocate(theo(x)%inTEVrange_Hpj) deallocate(theo(x)%CP_value) enddo select case(whichanalyses) case('onlyH','LandH','onlyP','list ') do x=lbound(theo,dim=1),ubound(theo,dim=1) deallocate(theo(x)%BR_Hbb_SM) deallocate(theo(x)%BR_Hss_SM) deallocate(theo(x)%BR_Hcc_SM) deallocate(theo(x)%BR_Hmumu_SM) deallocate(theo(x)%BR_Htautau_SM) deallocate(theo(x)%BR_HWW_SM) deallocate(theo(x)%BR_HZZ_SM) deallocate(theo(x)%BR_HZga_SM) deallocate(theo(x)%BR_Hgaga_SM) deallocate(theo(x)%BR_Hgg_SM) deallocate(theo(x)%BR_Hjets_SM) deallocate(theo(x)%GammaTot_SM) deallocate(theo(x)%tev%XS_HZ_SM) deallocate(theo(x)%tev%XS_HW_SM) deallocate(theo(x)%tev%XS_H_SM) deallocate(theo(x)%tev%XS_gg_H_SM) deallocate(theo(x)%tev%XS_bb_H_SM) deallocate(theo(x)%tev%XS_ttH_SM) deallocate(theo(x)%tev%XS_vbf_SM) !deallocate(theo(x)%tev%XS_H_SM_9713) !deallocate(theo(x)%tev%XS_H_SM_9674) deallocate(theo(x)%tev%XS_tH_tchan_SM) deallocate(theo(x)%tev%XS_tH_schan_SM) deallocate(theo(x)%tev%channelrates_SM) deallocate(theo(x)%tev%XS_Hb_SM) deallocate(theo(x)%tev%XS_Hb_c1_SM) deallocate(theo(x)%tev%XS_Hb_c2_SM) deallocate(theo(x)%tev%XS_Hb_c3_SM) deallocate(theo(x)%tev%XS_Hb_c4_SM) deallocate(theo(x)%lhc7%XS_HZ_SM) deallocate(theo(x)%lhc7%XS_gg_HZ_SM) deallocate(theo(x)%lhc7%XS_qq_HZ_SM) deallocate(theo(x)%lhc7%XS_HW_SM) deallocate(theo(x)%lhc7%XS_H_SM) deallocate(theo(x)%lhc7%XS_gg_H_SM) deallocate(theo(x)%lhc7%XS_bb_H_SM) deallocate(theo(x)%lhc7%XS_ttH_SM) deallocate(theo(x)%lhc7%XS_vbf_SM) deallocate(theo(x)%lhc7%XS_tH_tchan_SM) deallocate(theo(x)%lhc7%XS_tH_schan_SM) deallocate(theo(x)%lhc7%XS_Hb_SM) deallocate(theo(x)%lhc7%channelrates_SM) ! deallocate(theo(x)%lhc7%XS_Hb_c1_SM) ! deallocate(theo(x)%lhc7%XS_Hb_c2_SM) ! deallocate(theo(x)%lhc7%XS_Hb_c3_SM) deallocate(theo(x)%lhc8%XS_HZ_SM) deallocate(theo(x)%lhc8%XS_gg_HZ_SM) deallocate(theo(x)%lhc8%XS_qq_HZ_SM) deallocate(theo(x)%lhc8%XS_HW_SM) deallocate(theo(x)%lhc8%XS_H_SM) deallocate(theo(x)%lhc8%XS_gg_H_SM) deallocate(theo(x)%lhc8%XS_bb_H_SM) deallocate(theo(x)%lhc8%XS_ttH_SM) deallocate(theo(x)%lhc8%XS_vbf_SM) deallocate(theo(x)%lhc8%XS_tH_tchan_SM) deallocate(theo(x)%lhc8%XS_tH_schan_SM) deallocate(theo(x)%lhc8%XS_Hb_SM) deallocate(theo(x)%lhc8%channelrates_SM) ! deallocate(theo(x)%lhc8%XS_Hb_c1_SM) ! deallocate(theo(x)%lhc8%XS_Hb_c2_SM) ! deallocate(theo(x)%lhc8%XS_Hb_c3_SM) deallocate(theo(x)%lhc13%XS_HZ_SM) deallocate(theo(x)%lhc13%XS_gg_HZ_SM) deallocate(theo(x)%lhc13%XS_qq_HZ_SM) deallocate(theo(x)%lhc13%XS_HW_SM) deallocate(theo(x)%lhc13%XS_H_SM) deallocate(theo(x)%lhc13%XS_gg_H_SM) deallocate(theo(x)%lhc13%XS_bb_H_SM) deallocate(theo(x)%lhc13%XS_ttH_SM) deallocate(theo(x)%lhc13%XS_vbf_SM) deallocate(theo(x)%lhc13%XS_tH_tchan_SM) deallocate(theo(x)%lhc13%XS_tH_schan_SM) deallocate(theo(x)%lhc13%channelrates_SM) enddo case('onlyL') case default stop 'error in deallocate_usefulbits' end select deallocate(theo) !allocated in subroutine do_input !allocated in subroutine setup_output if(allocated(res)) then do x=lbound(res,dim=1),ubound(res,dim=1) deallocate(res(x)%chan) deallocate(res(x)%obsratio) deallocate(res(x)%predratio) deallocate(res(x)%axis_i) deallocate(res(x)%axis_j) deallocate(res(x)%sfactor) deallocate(res(x)%allowed95) deallocate(res(x)%ncombined) enddo deallocate(res) !allocated in subroutine setup_output endif if (allocated(fullHBres)) then deallocate(fullHBres) endif ! call deallocate_sqcouplratio_parts(g2) do x=lbound(g2,dim=1),ubound(g2,dim=1) deallocate(g2(x)%hjss_s) deallocate(g2(x)%hjss_p) deallocate(g2(x)%hjcc_s) deallocate(g2(x)%hjcc_p) deallocate(g2(x)%hjbb_s) deallocate(g2(x)%hjbb_p) deallocate(g2(x)%hjtoptop_s) deallocate(g2(x)%hjtoptop_p) deallocate(g2(x)%hjmumu_s) deallocate(g2(x)%hjmumu_p) deallocate(g2(x)%hjtautau_s) deallocate(g2(x)%hjtautau_p) deallocate(g2(x)%hjWW) deallocate(g2(x)%hjZZ) deallocate(g2(x)%hjZga) deallocate(g2(x)%hjgaga) deallocate(g2(x)%hjgg) deallocate(g2(x)%hjggZ) deallocate(g2(x)%hjhiZ) enddo deallocate(g2) do x=lbound(effC,dim=1),ubound(effC,dim=1) deallocate(effC(x)%hjss_s) deallocate(effC(x)%hjss_p) deallocate(effC(x)%hjcc_s) deallocate(effC(x)%hjcc_p) deallocate(effC(x)%hjbb_s) deallocate(effC(x)%hjbb_p) deallocate(effC(x)%hjtt_s) deallocate(effC(x)%hjtt_p) deallocate(effC(x)%hjmumu_s) deallocate(effC(x)%hjmumu_p) deallocate(effC(x)%hjtautau_s) deallocate(effC(x)%hjtautau_p) deallocate(effC(x)%hjWW) deallocate(effC(x)%hjZZ) deallocate(effC(x)%hjZga) deallocate(effC(x)%hjgaga) deallocate(effC(x)%hjgg) ! deallocate(effC(x)%hjggZ) deallocate(effC(x)%hjhiZ) enddo deallocate(effC) !these are allocated in subroutine do_input call deallocate_hadroncolliderextras_parts(partR) deallocate(partR) !allocated in subroutine do_input if(allocated(pr)) deallocate(pr) !allocated in subroutine fill_pr or fill_pr_select if(allocated(prsep)) deallocate(prsep) !allocated in subroutine fill_pr or fill_pr_select if(allocated(diffMhneut)) deallocate(diffMhneut) if(allocated(diffMhch)) deallocate(diffMhch) if(allocated(dmn)) deallocate(dmn) if(allocated(dmch)) deallocate(dmch) if(allocated(analysislist)) deallocate(analysislist) if(allocated(analysis_exclude_list)) deallocate(analysis_exclude_list) if(allocated(HBresult_all)) deallocate(HBresult_all) if(allocated(chan_all)) deallocate(chan_all) if(allocated(ncombined_all)) deallocate(ncombined_all) if(allocated(obsratio_all)) deallocate(obsratio_all) if(allocated(predratio_all)) deallocate(predratio_all) end subroutine deallocate_usefulbits !********************************************************** end module usefulbits !****************************************************************** Index: trunk/HiggsSignals-2/HiggsSignals_subroutines.F90 =================================================================== --- trunk/HiggsSignals-2/HiggsSignals_subroutines.F90 (revision 569) +++ trunk/HiggsSignals-2/HiggsSignals_subroutines.F90 (revision 570) @@ -1,2409 +1,2409 @@ !------------------------------------------------------------ ! This file is part of HiggsSignals (TS 03/03/2013). !------------------------------------------------------------ subroutine initialize_HiggsSignals_latestresults(nHiggsneut,nHiggsplus) !------------------------------------------------------------ ! Wrapper subroutine to intitialize HiggsSignals with the experimental ! dataset "latestresults", avoiding to specify this via a string argument. !------------------------------------------------------------ implicit none !--------------------------------------input integer,intent(in) :: nHiggsneut integer,intent(in) :: nHiggsplus character(LEN=13) :: Expt_string Expt_string = "latestresults" call initialize_HiggsSignals(nHiggsneut,nHiggsplus,Expt_string) end subroutine initialize_HiggsSignals_latestresults !------------------------------------------------------------ subroutine initialize_HiggsSignals_LHC13(nHiggsneut,nHiggsplus) !------------------------------------------------------------ ! Wrapper subroutine to intitialize HiggsSignals with the experimental ! dataset "latestresults", avoiding to specify this via a string argument. !------------------------------------------------------------ implicit none !--------------------------------------input integer,intent(in) :: nHiggsneut integer,intent(in) :: nHiggsplus character(LEN=13) :: Expt_string Expt_string = "LHC13" call initialize_HiggsSignals(nHiggsneut,nHiggsplus,Expt_string) end subroutine initialize_HiggsSignals_LHC13 !------------------------------------------------------------ subroutine initialize_HiggsSignals_empty(nHiggsneut,nHiggsplus) !------------------------------------------------------------ ! Wrapper subroutine to intitialize HiggsSignals without dataset. !------------------------------------------------------------ implicit none !--------------------------------------input integer,intent(in) :: nHiggsneut integer,intent(in) :: nHiggsplus character(LEN=13) :: Expt_string Expt_string = "none" call initialize_HiggsSignals(nHiggsneut,nHiggsplus,Expt_string) end subroutine initialize_HiggsSignals_empty !------------------------------------------------------------ subroutine initialize_HiggsSignals(nHiggsneut,nHiggsplus,Expt_string) !------------------------------------------------------------ ! This the first HiggsSignals subroutine that should be called ! by the user. ! It calls subroutines to read in the tables of Standard Model ! decay and production rates from HiggsBounds, sets up the ! experimental data from Tevatron and LHC, allocate arrays, etc. ! Arguments (input): ! * nHiggs = number of neutral Higgs in the model ! * nHiggsplus = number of singly, positively charged Higgs in the model ! * Expt_string = name of experimental dataset to be used !------------------------------------------------------------ use usefulbits, only : np,Hneut,Hplus,Chineut,Chiplus,debug,inputmethod,& & theo,whichanalyses,just_after_run,& & file_id_debug1,file_id_debug2,allocate_if_stats_required use usefulbits_HS, only : HiggsSignals_info, nanalys, eps, Exptdir, obs use datatables, only: setup_observables, setup_LHC_Run1_combination use STXS, only : load_STXS use input, only : check_number_of_particles,check_whichanalyses use io, only : setup_input_for_hs, setup_output_for_hs use theory_BRfunctions, only : setup_BRSM, BRSM use theory_XS_SM_functions, only : setup_XSSM, XSSM #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !--------------------------------------input integer,intent(in) :: nHiggsneut integer,intent(in) :: nHiggsplus character(LEN=*), intent(in) :: Expt_string !-----------------------------------internal integer :: i logical :: exptdirpresent = .False. !----------------------------------parameter eps=5.0D0 np(Hneut)=nHiggsneut np(Hplus)=nHiggsplus if(Expt_string.ne.'none') then Exptdir = Expt_string exptdirpresent = .True. endif np(Chineut)=0! not considering bounds on neutralinos here np(Chiplus)=0! not considering bounds on charginos here debug=.False. select case(whichanalyses) case('onlyL') whichanalyses='LandH' case('onlyH','onlyP','list ','LandH') case default whichanalyses='onlyH' end select call HiggsSignals_info if(inputmethod=='subrout') then if(allocated(theo))then if(debug) write(*,*) "HiggsBounds/HiggsSignals internal structure already initialized!" else if(debug)write(*,*)'doing other preliminary tasks...' ; call flush(6) call setup_input_for_hs ! allocate(inputsub( 2 )) !(1)np(Hneut)>0 (2)np(Hplus)>0 ! inputsub(1)%desc='HiggsBounds_neutral_input_*' ; inputsub(1)%req=req( 0, 1) ! inputsub(2)%desc='HiggsBounds_charged_input' ; inputsub(2)%req=req( 1, 0) ! ! do i=1,ubound(inputsub,dim=1) ! inputsub(i)%stat=0 ! enddo endif endif if(debug)write(*,*)'reading in Standard Model tables...' ; call flush(6) if(.not.allocated(BRSM)) call setup_BRSM if(.not.allocated(XSSM)) call setup_XSSM call setup_uncertainties if(debug)write(*,*)'reading in experimental data...' ; call flush(6) if(exptdirpresent) call setup_observables if(exptdirpresent) call load_STXS(Expt_string) call setup_LHC_Run1_combination if(debug)write(*,*)'sorting out processes to be checked...'; call flush(6) nanalys = size(obs) if(debug)write(*,*)'preparing output arrays...' ; call flush(6) call setup_output_for_hs if(debug)write(*,*)'HiggsSignals has been initialized...' ; call flush(6) just_after_run=.False. contains ! | np ! |Hneu Hcha ! | ==0 ==0 ! function req(Hneu,Hcha) ! integer, intent(in) ::Hneu,Hcha ! integer :: req ! ! req=1 ! if(np(Hneut)==0) req= Hneu * req ! if(np(Hplus)==0) req= Hcha * req ! ! end function req end subroutine initialize_HiggsSignals !------------------------------------------------------------ subroutine HiggsSignals_neutral_input_MassUncertainty(dMh) ! Sets the theoretical mass uncertainty of the Higgs bosons. !------------------------------------------------------------ use usefulbits, only: theo,np,Hneut implicit none double precision,intent(in) :: dMh(np(Hneut)) if(.not.allocated(theo))then stop 'subroutine HiggsSignals_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsSignal_neutral_input_MassUncertainty should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsSignal_neutral_input_MassUncertainty' endif theo(1)%particle(Hneut)%dM = dMh end subroutine HiggsSignals_neutral_input_MassUncertainty !------------------------------------------------------------ subroutine setup_uncertainties !------------------------------------------------------------ use usefulbits, only : file_id_common3 use store_pathname_hs, only : pathname_HS use usefulbits_hs, only : delta_rate use io, only : read_matrix_from_file logical :: BRmodel, BRSM, XSmodel, XSSM call read_matrix_from_file(9,pathname_HS//"BRcov.in",delta_rate%BRcov, BRmodel) call read_matrix_from_file(9,pathname_HS//"BRcovSM.in",delta_rate%BRcovSM, BRSM) call read_matrix_from_file(5,pathname_HS//"XScov.in",delta_rate%CScov, XSmodel) call read_matrix_from_file(5,pathname_HS//"XScovSM.in",delta_rate%CScovSM, XSSM) call read_matrix_from_file(5,pathname_HS//"XScov_13TeV.in",delta_rate%CS13cov, XSmodel) call read_matrix_from_file(5,pathname_HS//"XScovSM_13TeV.in",delta_rate%CS13covSM, XSSM) if(BRmodel.and.BRSM) then delta_rate%BRcov_ok=.True. write(*,*) "Covariance matrix for relative branching ratio uncertainties read in successfully." else write(*,*) "Covariance matrix for relative branching ratio uncertainties not provided. Using default values." endif if(XSmodel.and.XSSM) then delta_rate%CScov_ok=.True. write(*,*) "Covariance matrix for relative cross section uncertainties read in successfully." else write(*,*) "Covariance matrix for relative cross section uncertainties not provided. Using default values." endif end subroutine setup_uncertainties !------------------------------------------------------------ subroutine setup_model_rate_uncertainties(filename_XS, filename_XS13, filename_BR) !------------------------------------------------------------ use usefulbits, only : file_id_common3 use store_pathname_hs, only : pathname_HS use usefulbits_hs, only : delta_rate use io, only : read_matrix_from_file character(LEN=*),intent(in) :: filename_XS, filename_XS13, filename_BR logical :: BRmodel, XSmodel call read_matrix_from_file(9,filename_BR,delta_rate%BRcov, BRmodel) call read_matrix_from_file(5,filename_XS,delta_rate%CScov, XSmodel) call read_matrix_from_file(5,filename_XS13,delta_rate%CS13cov, XSmodel) if(BRmodel.and.XSmodel) then delta_rate%BRcov_ok=.True. delta_rate%CScov_ok=.True. write(*,*) "Covariance matrices for rate uncertainties read in successfully." else write(*,*) "Covariance matrix for rate uncertainties not provided. Using default values." endif end subroutine setup_model_rate_uncertainties !------------------------------------------------------------ subroutine setup_rate_uncertainties( dCS, dBR ) !------------------------------------------------------------ ! Sets (relative) systematic uncertainties of the model for: ! dCS(1) - singleH dBR(1) - gamma gamma ! dCS(2) - VBF dBR(2) - W W ! dCS(3) - HW dBR(3) - Z Z ! dCS(4) - HZ dBR(4) - tau tau ! dCS(5) - ttH dBR(5) - b bbar !------------------------------------------------------------ use usefulbits_hs, only : delta_rate implicit none double precision, intent(in) :: dCS(5) double precision, intent(in) :: dBR(5) integer :: i delta_rate%dCS = dCS do i=lbound(dBR,dim=1),ubound(dBR,dim=1) call setup_dbr(i,dBR(i)) enddo end subroutine setup_rate_uncertainties !------------------------------------------------------------ subroutine setup_dbr(BRid, value) !------------------------------------------------------------ use usefulbits_hs, only : delta_rate integer,intent(in) :: BRid double precision, intent(in) :: value if(BRid.gt.0.and.BRid.lt.10) then delta_rate%dBR(BRid) = value else write(*,*) "Warning in setup_dbr: Unknown decay mode." endif end subroutine setup_dbr !------------------------------------------------------------ subroutine setup_correlations(corr_mu, corr_mh) !------------------------------------------------------------ ! With this subroutine the user may switch off/on correlations ! (default=on) by setting corr = 0/1. !------------------------------------------------------------ use usefulbits_hs, only : correlations_mu, correlations_mh implicit none integer, intent(in) :: corr_mu, corr_mh if(corr_mu.eq.0) then correlations_mu = .False. write(*,*) 'Correlations in signal strength observables are switched off.' elseif(corr_mu.eq.1) then correlations_mu = .True. else stop 'Error: Correlations must be switched on/off by an integer value of 0 or 1.' endif if(corr_mh.eq.0) then correlations_mh = .False. write(*,*) 'Correlations in Higgs mass observables are switched off.' elseif(corr_mh.eq.1) then correlations_mh = .True. else stop 'Error: Correlations must be switched on/off by an integer value of 0 or 1.' endif end subroutine setup_correlations !------------------------------------------------------------ subroutine setup_symmetricerrors(symm) ! Sets the measured rate uncertainties to either a symmetrical average ! of the upper and lower cyan band widths (symm==1) or else uses the ! original (asymmetrical) errors. !------------------------------------------------------------ use usefulbits_hs, only : symmetricerrors implicit none integer, intent(in) :: symm if(symm.eq.1) then write(*,*) "Using averaged (symmetrical) experimental rate uncertainties." symmetricerrors = .True. else write(*,*) "Using original (asymmetrical) experimental rate uncertainties." symmetricerrors = .False. endif end subroutine setup_symmetricerrors !------------------------------------------------------------ subroutine setup_absolute_errors(absol) ! Treats the measured rate uncertainties as either absolute ! uncertainties (1) or relative (0). By default, they are ! treated as relative uncertainties. !------------------------------------------------------------ use usefulbits_hs, only : absolute_errors implicit none integer, intent(in) :: absol if(absol.eq.1) then write(*,*) "Using absolute experimental rate uncertainties." absolute_errors = .True. else write(*,*) "Using relative experimental rate uncertainties." absolute_errors = .False. endif end subroutine setup_absolute_errors !------------------------------------------------------------ subroutine setup_correlated_rate_uncertainties(corr) !------------------------------------------------------------ use usefulbits_hs, only : delta_rate integer, intent(in) :: corr if(corr.eq.0) then delta_rate%usecov = .False. write(*,*) "Deactivated correlated CS and BR uncertainties. Using approximated maximum error." elseif(corr.eq.1) then delta_rate%usecov = .True. write(*,*) "Activated correlated CS and BR uncertainties. Using them if covariance matrices are present." else write(*,*) "Warning in subroutine setup_correlated_rate_uncertainties: Argument ",corr," is not equal to 0 or 1." endif end subroutine setup_correlated_rate_uncertainties !------------------------------------------------------------ subroutine setup_SMweights(useweight) ! If set to 1 (true), HiggsSignals assumes the same signal decomposition ! (weights) as in the SM for the given model. This will enter the determination ! of the theoretical rate uncertainty. !------------------------------------------------------------ use usefulbits_hs, only : useSMweights implicit none integer, intent(in) :: useweight if(useweight.eq.1) then write(*,*) "Using SM weights for theoretical rate uncertainties of the model." useSMweights = .True. else write(*,*) "Using true model weights for theoretical rate uncertainties of the model." useSMweights = .False. endif end subroutine setup_SMweights !------------------------------------------------------------ subroutine setup_anticorrelations_in_mu(acorr) ! Allows for anti-correlations in the signal strength covariance ! matrix if there is a relative sign difference in two mu measurements ! (acorr==1) or else uses only correlations irrespective of the relative ! (acorr==0). !------------------------------------------------------------ use usefulbits_hs, only : anticorrmu implicit none integer, intent(in) :: acorr if(acorr.eq.1) then write(*,*) "Allow anti-correlated signal strength measurements." anticorrmu = .True. else write(*,*) "Prohibit anti-correlated signal strength measurements." anticorrmu = .False. endif end subroutine setup_anticorrelations_in_mu !------------------------------------------------------------ subroutine setup_anticorrelations_in_mh(acorr) ! Allows for anti-correlations in the mass covariance ! matrix if there is a relative sign difference in two mu measurements ! (acorr==1) or else uses only correlations irrespective of the relative ! (acorr==0). !------------------------------------------------------------ use usefulbits_hs, only : anticorrmh implicit none integer, intent(in) :: acorr if(acorr.eq.1) then write(*,*) "Allow anti-correlated mass measurements." anticorrmh = .True. else write(*,*) "Prohibit anti-correlated mass measurements." anticorrmh = .False. endif end subroutine setup_anticorrelations_in_mh !------------------------------------------------------------ subroutine setup_assignmentrange(range) !------------------------------------------------------------ ! This sets up the mass range (in standard deviations) in which ! the Higgs is forced to be assigned to the peak observables. !------------------------------------------------------------ use usefulbits_hs, only : assignmentrange,assignmentrange_massobs, pdf implicit none double precision, intent(in) :: range if(range.le.0.0D0) then write(*,*) "Error: Bad assignment range ",range write(*,*) "Keeping the value ",assignmentrange else assignmentrange = range assignmentrange_massobs = range endif if(assignmentrange.ne.1.0D0.and.pdf.eq.1) then write(*,*) "Note: For a box pdf, only 1s mass range is used to force the Higgs-to-peak assignment." endif end subroutine setup_assignmentrange !------------------------------------------------------------ subroutine setup_assignmentrange_LHCrun1(range) !------------------------------------------------------------ ! This sets up the mass range (in standard deviations) in which ! the Higgs is forced to be assigned to the peak observables. !------------------------------------------------------------ use usefulbits_hs, only : assignmentrange_LHCrun1, pdf implicit none double precision, intent(in) :: range if(range.le.0.0D0) then write(*,*) "Error: Bad assignment range ",range write(*,*) "Keeping the value ",assignmentrange_LHCrun1 else assignmentrange_LHCrun1 = range endif ! if(assignmentrange_LHCrun1.ne.1.0D0.and.pdf.eq.1) then ! write(*,*) "Note: For a box pdf, only 1s mass range is used to force the Higgs-to-peak assignment." ! endif end subroutine setup_assignmentrange_LHCrun1 !------------------------------------------------------------ subroutine setup_assignmentrange_massobservables(range) !------------------------------------------------------------ ! This sets up the mass range (in standard deviations) in which ! the Higgs is forced to be assigned to the peak observables. !------------------------------------------------------------ use usefulbits_hs, only : assignmentrange_massobs, pdf implicit none double precision, intent(in) :: range if(range.le.0.0D0) then write(*,*) "Error: Bad assignment range ",range write(*,*) "Keeping the value ",assignmentrange_massobs else assignmentrange_massobs = range endif if(assignmentrange_massobs.ne.1.0D0.and.pdf.eq.1) then write(*,*) "Note: For a box pdf, only 1s mass range is used to force the Higgs-to-peak assignment." endif end subroutine setup_assignmentrange_massobservables !------------------------------------------------------------ subroutine setup_nparam(Np) !------------------------------------------------------------ use usefulbits_hs, only : Nparam implicit none integer, intent(in) :: Np Nparam = Np end subroutine setup_nparam !------------------------------------------------------------ subroutine setup_Higgs_to_peaks_assignment_iterations(iter) ! Sets the number of iterations for the Higgs-to-peak-assignment. !------------------------------------------------------------ use usefulbits_hs, only : iterations implicit none integer, intent(in) :: iter iterations = iter end subroutine setup_Higgs_to_peaks_assignment_iterations !------------------------------------------------------------ subroutine setup_mcmethod_dm_theory(mode) use mc_chisq, only : mc_mode implicit none integer, intent(in) :: mode character(LEN=14) :: mode_desc(2) = (/'mass variation','convolution '/) if(mode.eq.1.or.mode.eq.2) then mc_mode = mode write(*,'(1X,A,A)') 'The mass-centered chi^2 method will treat the Higgs',& & ' boson mass theory uncertainty by '//trim(mode_desc(mode))//'.' else stop 'Error in subroutine setup_mcmethod_dm_theory: Unknown mode (1 or 2 possible)!' endif end subroutine setup_mcmethod_dm_theory !------------------------------------------------------------ subroutine setup_sm_test(int_SMtest,epsilon) ! With this subroutine the user may switch off the SM likeness test ! (default=on) or change the maximal deviation epsilon (default=5.0D-2) !------------------------------------------------------------ use usefulbits_hs, only : useSMtest, eps implicit none integer, intent(in) :: int_SMtest double precision, intent(in) :: epsilon if(int_SMtest.eq.0) then useSMtest = .False. write(*,*) 'SM likeness test has been switched off.' elseif(int_SMtest.eq.1) then useSMtest = .True. write(*,*) 'SM likeness test has been switched on.' else stop 'Error: SM test must be switched on/off by an integer value of 0 or 1.' endif eps = epsilon end subroutine setup_sm_test !------------------------------------------------------------ subroutine setup_thu_observables(thuobs) use usefulbits_hs, only : THU_included integer, intent(in) :: thuobs if(thuobs.eq.0) then THU_included = .False. write(*,*) 'Observables are assumed to NOT include theory errors.' else THU_included = .True. write(*,*) 'Observables are assumed to include theory errors.' endif end subroutine setup_thu_observables !------------------------------------------------------------ subroutine setup_output_level(level) ! Controls the level of information output: ! 0 : silent mode ! 1 : screen output for each analysis with its peak/mass-centered observables and ! their respective values predicted by the model ! 2 : screen output of detailed information on each analysis with its ! peak/mass-centered observables ! 3 : creates the files peak_information.txt and peak_massesandrates.txt !------------------------------------------------------------ use usefulbits_hs, only : output_level, additional_output implicit none integer, intent(in) :: level if(level.eq.0.or.level.eq.1.or.level.eq.2.or.level.eq.3) then output_level = level else stop 'Error in subroutine setup_output_level: level not equal to 0,1,2 or 3.' endif if(level.eq.3) additional_output = .True. end subroutine setup_output_level !------------------------------------------------------------ subroutine setup_pdf(pdf_in) ! Sets the probability density function for the Higgs mass uncertainty parametrization: ! 1 : box-shaped pdf ! 2 : Gaussian pdf ! 3 : box-shaped theory error + Gaussian experimental pdf !------------------------------------------------------------ use usefulbits_hs, only : pdf, assignmentrange implicit none integer, intent(in) :: pdf_in character(LEN=13) :: pdf_desc(3) = (/'box ','Gaussian ','box+Gaussian'/) pdf=pdf_in if((pdf.eq.1).or.(pdf.eq.2).or.(pdf.eq.3)) then write(*,'(1X,A,A,1I1,A)') 'Use a '//trim(pdf_desc(pdf))//' probability density function ',& & 'for the Higgs mass(es) (pdf=',pdf,')' endif if(assignmentrange.ne.1.0D0.and.pdf.eq.1) then write(*,*) "Note: For a box pdf, only 1s mass range is used to force the Higgs-to-peak assignment." endif end subroutine setup_pdf !------------------------------------------------------------ !subroutine assign_toyvalues_to_observables(ii, peakindex, npeaks, mu_obs, mh_obs) !! Assigns toy values to the peak's mass and mu value for analysis ii. !! ii :: analysis number (entry in mutables) !! peakindex :: index of the peak of analysis ii !! npeaks :: number of peaks found in analysis ii !! mu_obs :: toy value for mu to be given to the peak with peakindex !! mh_obs :: toy value for mh to be given to the peak with peakindex !------------------------------------------------------------ ! use usefulbits_hs, only: obs, usetoys ! ! integer, intent(in) :: ii, peakindex, npeaks ! double precision, intent(in) :: mh_obs, mu_obs ! ! if(peakindex.gt.npeaks) then ! stop 'Error in subroutine assign_toyvalues_to_observables: Observable does not exist!' ! endif ! ! obs(ii)%table%npeaks = npeaks ! if(.not.allocated(obs(ii)%table%Toys_muobs)) allocate(obs(ii)%table%Toys_muobs(npeaks)) ! if(.not.allocated(obs(ii)%table%Toys_mhobs)) allocate(obs(ii)%table%Toys_mhobs(npeaks)) ! ! obs(ii)%table%Toys_muobs(peakindex) = mu_obs ! obs(ii)%table%Toys_mhobs(peakindex) = mh_obs ! ! usetoys = .True. ! !end subroutine assign_toyvalues_to_observables !------------------------------------------------------------ subroutine assign_toyvalues_to_peak(ID, mu_obs, mh_obs) ! Assigns toy values to the peak's mass and mu value to a peak observable. ! ID :: observable ID ! mu_obs :: toy value for mu to be given to the peak ! mh_obs :: toy value for mh to be given to the peak ! ! n.B.: Do we also want to set mu uncertainties here? !------------------------------------------------------------ use usefulbits_hs, only: obs, usetoys implicit none integer, intent(in) :: ID double precision, intent(in) :: mh_obs, mu_obs integer :: pos, ii pos = -1 do ii=lbound(obs,dim=1),ubound(obs,dim=1) if(obs(ii)%id.eq.ID) then pos = ii exit endif enddo if(pos.ne.-1) then obs(pos)%peak%mpeak = mh_obs obs(pos)%peak%mu = mu_obs usetoys = .True. else write(*,*) "WARNING in assign_toyvalues_to_peak: ID unknown." endif end subroutine assign_toyvalues_to_peak !------------------------------------------------------------ subroutine assign_modelefficiencies_to_peak(ID, Nc, eff_ratios) ! Assigns to each channel of the observable the efficiency in the model ! w.r.t the SM efficiency (as a ratio!) ! ! ID :: observable ID ! Nc :: number of channels ! eff_ratios :: array of length (Number of channels) giving the efficiency ratios ! ! Note: You can first employ the subroutine get_peak_channels (io module) to obtain ! the relevant channel information of the observable. !------------------------------------------------------------ use usefulbits_hs, only: obs implicit none integer, intent(in) :: ID, Nc double precision, dimension(Nc), intent(in) :: eff_ratios integer :: pos, ii pos = -1 do ii=lbound(obs,dim=1),ubound(obs,dim=1) if(obs(ii)%id.eq.ID) then pos = ii exit endif enddo if(pos.ne.-1) then if(size(eff_ratios,dim=1).ne.obs(pos)%table%Nc) then write(*,*) "WARNING in assign modelefficiencies_to_peak: Number of channels (",& & size(eff_ratios,dim=1),"!=",obs(pos)%table%Nc,"does not match for observable ID = ",ID else obs(pos)%table%channel_eff_ratios = eff_ratios endif else write(*,*) "WARNING in assign_modelefficiencies_to_peak: ID unknown." endif end subroutine assign_modelefficiencies_to_peak !------------------------------------------------------------ subroutine assign_rate_uncertainty_scalefactor_to_peak(ID, scale_mu) ! Assigns a rate uncertainty scalefactor to the peak specified by ID. ! This scalefactor will only scale the experimental rate uncertainties. ! The theory rate uncertainties must be given manually via setup_rate_uncertainties. ! ! ID :: observable ID of the peak observable ! scale_mu :: scale_mu by which the mu uncertainty is scaled !------------------------------------------------------------ use usefulbits_hs, only: obs, usescalefactor implicit none integer, intent(in) :: ID double precision, intent(in) :: scale_mu integer :: pos, ii pos = -1 do ii=lbound(obs,dim=1),ubound(obs,dim=1) if(obs(ii)%id.eq.ID) then pos = ii exit endif enddo if(pos.ne.-1) then obs(pos)%peak%scale_mu = scale_mu else write(*,*) "WARNING in assign_uncertainty_scalefactors_to_peak: ID unknown." endif usescalefactor = .True. end subroutine assign_rate_uncertainty_scalefactor_to_peak !------------------------------------------------------------ subroutine run_HiggsSignals_LHC_Run1_combination(Chisq_mu, Chisq_mh, Chisq, nobs, Pvalue) use usefulbits, only : theo,just_after_run, ndat use theo_manip, only : HB5_complete_theo use usefulbits_HS, only : HSres, output_level, Nparam implicit none !----------------------------------------output integer,intent(out) :: nobs double precision,intent(out) :: Pvalue, Chisq, Chisq_mu, Chisq_mh !-------------------------------------internal integer :: n,i, nobs_mu, nobs_mh logical :: debug=.False. !--------------------------------------------- if(.not.allocated(theo))then stop 'subroutine HiggsSignals_initialize must be called first' endif call HB5_complete_theo do n=1,ndat call evaluate_LHC_Run1_combination(theo(n),n) Pvalue = HSres(n)%Pvalue_LHCRun1 Chisq = HSres(n)%Chisq_LHCRun1 Chisq_mu = HSres(n)%Chisq_LHCRun1_mu Chisq_mh = HSres(n)%Chisq_LHCRun1_mh nobs_mu = HSres(n)%nobs_LHCRun1_mu nobs_mh = HSres(n)%nobs_LHCRun1_mh nobs = nobs_mu+nobs_mh if(output_level.ne.0) then write(*,*) write(*,*) '#*************************************************************************#' write(*,*) '# HIGGSSIGNALS RESULTS (LHC ATLAS + CMS Run1 combination) #' write(*,*) '#*************************************************************************#' write(*,'(A55,F21.8)') 'chi^2 from signal rate observables = ',Chisq_mu write(*,'(A55,F21.8)') 'chi^2 from Higgs mass observables = ',Chisq_mh write(*,'(A55,F21.8)') 'chi^2 (total) = ',Chisq write(*,'(A55,I21)') 'Number of rate observables = ', nobs_mu write(*,'(A55,I21)') 'Number of mass observables = ', nobs_mh write(*,'(A55,I21)') 'Number of observables (total) = ', nobs write(*,'(A48,I3,A4,F21.8)') 'Probability (ndf =',nobs-Nparam,') = ', Pvalue write(*,*) '#*************************************************************************#' write(*,*) endif enddo just_after_run=.True. end subroutine run_HiggsSignals_LHC_Run1_combination !------------------------------------------------------------ subroutine setup_LHC_combination_run1_SMXS_from_paper(useSMXS_from_paper) !------------------------------------------------------------ use usefulbits_hs, only : LHC_combination_run1_SMXS_from_paper implicit none logical, intent(in) :: useSMXS_from_paper if(useSMXS_from_paper) then write(*,*) "Using SM cross sections from Tab.1 of arXiv:1606.02266 for LHC Run 1 combination chi^2 test." else write(*,*) "Using internal SM cross sections for LHC Run 1 combination chi^2 test." endif LHC_combination_run1_SMXS_from_paper = useSMXS_from_paper end subroutine setup_LHC_combination_run1_SMXS_from_paper !------------------------------------------------------------ subroutine evaluate_LHC_Run1_combination( t , n ) !------------------------------------------------------------ ! !------------------------------------------------------------ use usefulbits, only : np,Hneut,Hplus,dataset,results, vsmall use usefulbits_hs, only : HSresults, output_level, Nparam, & & LHCrun1_rates, LHCrun1_correlationmatrix, useaveragemass, & & assignmentrange_LHCrun1, HSres, normalize_rates_to_reference_position, & & normalize_rates_to_reference_position_outside_dmtheo use pc_chisq, only : csq_mh use numerics, only : invmatrix, matmult, gammp implicit none !--------------------------------------input type(dataset), intent(in) :: t integer, intent(in) :: n !--------------------------------------output ! type(HSresults), intent(inout) :: r !--------------------------------------internal integer :: p, d, id, i, j, k, ncomb double precision, allocatable :: covmat(:,:), invcovmat(:,:) double precision, allocatable :: covmatzero(:,:), invcovmatzero(:,:) double precision, dimension(20) :: v, v2, csq_mu, vzero, vzero2, csq_mu_max double precision, dimension(20,1) :: vmat, vzeromat double precision :: mobs = 125.09D0 - double precision :: dmobs = 0.237D0 + double precision :: dmobs = 0.24D0 double precision :: Higgs_signal_k double precision :: num1, num2, dnum1, dnum2, denom1, denom2, mav, dmav allocate(covmat(20,20),invcovmat(20,20)) allocate(covmatzero(20,20),invcovmatzero(20,20)) mav =0.0D0 dmav = 0.0D0 denom1 = 0.0D0 denom2 = 0.0D0 num1 = 0.0D0 num2 = 0.0D0 dnum1 = 0.0D0 dnum2 = 0.0D0 do i=lbound(LHCrun1_rates,dim=1),ubound(LHCrun1_rates,dim=1) id = LHCrun1_rates(i)%channel_id p = int((id-modulo(id,10))/dble(10)) d = modulo(id,10) LHCrun1_rates(i)%r_pred = 0.0D0 ncomb = 0 do k=1,np(Hneut) if(abs(t%particle(Hneut)%M(k)-mobs).le.& & abs(assignmentrange_LHCrun1*dmobs + t%particle(Hneut)%dM(k)) ) then Higgs_signal_k = signalrate(k,p,d,mobs,t%particle(Hneut)%M(k),t%particle(Hneut)%dM(k)) LHCrun1_rates(i)%r_pred = LHCrun1_rates(i)%r_pred + Higgs_signal_k if(id.eq.11) then ! gg -> h_k -> gaga weighted mass average num1 = num1 + Higgs_signal_k * t%particle(Hneut)%M(k) dnum1 = dnum1 + Higgs_signal_k * t%particle(Hneut)%dM(k) else if(id.eq.13) then ! gg -> h_k -> ZZ -> 4l weighted mass average num2 = num2 + Higgs_signal_k * t%particle(Hneut)%M(k) dnum2 = dnum2 + Higgs_signal_k * t%particle(Hneut)%dM(k) endif ncomb = ncomb+1 endif enddo if(id.eq.11) then denom1 = LHCrun1_rates(i)%r_pred else if(id.eq.13) then denom2 = LHCrun1_rates(i)%r_pred endif if(LHCrun1_rates(i)%r_pred.gt.LHCrun1_rates(i)%r) then LHCrun1_rates(i)%dr = LHCrun1_rates(i)%dr_up else LHCrun1_rates(i)%dr = LHCrun1_rates(i)%dr_low endif if(LHCrun1_rates(i)%r.lt.0.0D0) then LHCrun1_rates(i)%dr0 = LHCrun1_rates(i)%dr_up else LHCrun1_rates(i)%dr0 = LHCrun1_rates(i)%dr_low endif v(i) = LHCrun1_rates(i)%r_pred - LHCrun1_rates(i)%r vmat(i,1) = v(i) vzero(i) = LHCrun1_rates(i)%r vzeromat(i,1) = vzero(i) ! write(*,'(2I3,3F10.5)') p, d, LHCrun1_rates(i)%r_pred, LHCrun1_rates(i)%r, LHCrun1_rates(i)%r/LHCrun1_rates(i)%r_pred enddo if(denom1.gt.vsmall.and.denom2.gt.vsmall) then mav = 0.5D0 * (num1/denom1 + num2/denom2) dmav = 0.5D0 * (dnum1/denom1 + dnum2/denom2) ! write(*,*) "Averaged mass is ",mav, " +- ",dmav ! else ! write(*,*) "denom1 and denom2 are ",denom1, denom2 endif do i=lbound(LHCrun1_rates,dim=1),ubound(LHCrun1_rates,dim=1) do j=lbound(LHCrun1_rates,dim=1),ubound(LHCrun1_rates,dim=1) covmat(i,j) = LHCrun1_correlationmatrix(i,j) * & & LHCrun1_rates(i)%dr * LHCrun1_rates(j)%dr covmatzero(i,j) = LHCrun1_correlationmatrix(i,j) * & & LHCrun1_rates(i)%dr0 * LHCrun1_rates(j)%dr0 enddo enddo call invmatrix(covmat, invcovmat) call matmult(invcovmat,vmat,v2,20,1) call invmatrix(covmatzero, invcovmatzero) call matmult(invcovmatzero,vzeromat,vzero2,20,1) do i=1, 20 csq_mu(i) = v(i)*v2(i) enddo do i=1, 20 csq_mu_max(i) = vzero(i)*vzero2(i) enddo if(mav.lt.vsmall) then HSres(n)%Chisq_LHCRun1_mh=0.0D0 else HSres(n)%Chisq_LHCRun1_mh=csq_mh(mav,mobs,dmav,dmobs) endif if((HSres(n)%Chisq_LHCRun1_mh+sum(csq_mu)).gt.sum(csq_mu_max)) then HSres(n)%Chisq_LHCRun1_mu=sum(csq_mu_max) HSres(n)%Chisq_LHCRun1_mh=0.0D0 else HSres(n)%Chisq_LHCRun1_mu=sum(csq_mu) endif HSres(n)%Chisq_LHCRun1= HSres(n)%Chisq_LHCRun1_mu + HSres(n)%Chisq_LHCRun1_mh HSres(n)%nobs_LHCRun1_mu=20 HSres(n)%nobs_LHCRun1_mh=1 if(HSres(n)%Chisq_LHCRun1.gt.vsmall.and.(HSres(n)%nobs_LHCRun1_mu+HSres(n)%nobs_LHCRun1_mh-Nparam).gt.0) then HSres(n)%Pvalue_LHCRun1=1 - gammp(dble(HSres(n)%nobs_LHCRun1_mu + HSres(n)%nobs_LHCRun1_mh-Nparam)/2,HSres(n)%Chisq_LHCRun1/2) endif deallocate(covmat,invcovmat) deallocate(covmatzero,invcovmatzero) contains !------------------------------------------------------------ function signalrate(k,p,d,mobs,m,dmtheo) !------------------------------------------------------------ use usefulbits_hs, only : LHC_combination_run1_SMXS_from_paper !--------------------------------------external functions double precision :: SMCS_lhc8_gg_H,SMCS_lhc8_bb_H,SMCS_lhc8_vbf_H, & & SMCS_lhc8_HW, SMCS_lhc8_HZ, SMCS_lhc8_ttH, SMBR_Hgamgam,SMBR_HWW, & & SMBR_HZZ, SMBR_Htautau, SMBR_Hbb, SMBR_HZgam, SMBR_Hcc, SMBR_Hmumu, & & SMBR_Hgg double precision, intent(in) :: mobs, m, dmtheo integer, intent(in) :: k,p,d double precision :: signalrate, production_rate, decay_rate, mass double precision :: production_rate_scalefactor, decay_rate_scalefactor mass = t%particle(Hneut)%M(k) if(p.eq.1) then if(LHC_combination_run1_SMXS_from_paper) then production_rate= t%lhc8%XS_gg_hj_ratio(k) * 19.2D0 & & + t%lhc8%XS_bb_hj_ratio(k) * 0.203D0 else production_rate= t%lhc8%XS_gg_hj_ratio(k) * SMCS_lhc8_gg_H(mass) & & + t%lhc8%XS_bb_hj_ratio(k) * SMCS_lhc8_bb_H(mass) endif ! NOTE: Here we make a small error in the scalefactor. Correct would be to rescale ! the gg and bb contributions separately. production_rate_scalefactor = (SMCS_lhc8_gg_H(mobs)+SMCS_lhc8_bb_H(mobs))/& & (SMCS_lhc8_gg_H(mass)+SMCS_lhc8_bb_H(mass)) else if(p.eq.2) then if(LHC_combination_run1_SMXS_from_paper) then production_rate= t%lhc8%XS_vbf_ratio(k) * 1.58D0 else production_rate= t%lhc8%XS_vbf_ratio(k) * SMCS_lhc8_vbf_H(mass) endif production_rate_scalefactor = SMCS_lhc8_vbf_H(mobs)/SMCS_lhc8_vbf_H(mass) else if(p.eq.3) then if(LHC_combination_run1_SMXS_from_paper) then production_rate= t%lhc8%XS_hjW_ratio(k) * 0.703D0 else production_rate= t%lhc8%XS_hjW_ratio(k) * SMCS_lhc8_HW(mass) endif production_rate_scalefactor = SMCS_lhc8_HW(mobs)/SMCS_lhc8_HW(mass) else if(p.eq.4) then if(LHC_combination_run1_SMXS_from_paper) then production_rate= t%lhc8%XS_hjZ_ratio(k) * 0.446D0 else production_rate= t%lhc8%XS_hjZ_ratio(k) * SMCS_lhc8_HZ(mass) endif production_rate_scalefactor = SMCS_lhc8_HZ(mobs)/SMCS_lhc8_HZ(mass) else if(p.eq.5) then if(LHC_combination_run1_SMXS_from_paper) then production_rate= t%lhc8%XS_tthj_ratio(k) * 0.129D0 else production_rate= t%lhc8%XS_tthj_ratio(k) * SMCS_lhc8_ttH(mass) endif production_rate_scalefactor = SMCS_lhc8_ttH(mobs)/SMCS_lhc8_ttH(mass) endif if(d.eq.1) then decay_rate = t%BR_hjgaga(k) decay_rate_scalefactor = SMBR_Hgamgam(mobs)/SMBR_Hgamgam(mass) else if(d.eq.2) then decay_rate = t%BR_hjWW(k) decay_rate_scalefactor = SMBR_HWW(mobs)/SMBR_HWW(mass) else if(d.eq.3) then decay_rate = t%BR_hjZZ(k) decay_rate_scalefactor = SMBR_HZZ(mobs)/SMBR_HZZ(mass) else if(d.eq.4) then decay_rate = t%BR_hjtautau(k) decay_rate_scalefactor = SMBR_Htautau(mobs)/SMBR_Htautau(mass) else if(d.eq.5) then decay_rate = t%BR_hjbb(k) decay_rate_scalefactor = SMBR_Hbb(mobs)/SMBR_Hbb(mass) endif if(normalize_rates_to_reference_position) then signalrate = production_rate * decay_rate else signalrate = production_rate * production_rate_scalefactor * & & decay_rate * decay_rate_scalefactor endif if(normalize_rates_to_reference_position_outside_dmtheo) then if(abs(mobs-m).ge.dmtheo) then signalrate = production_rate * decay_rate endif endif end function signalrate !------------------------------------------------------------ end subroutine evaluate_LHC_Run1_combination !------------------------------------------------------------ subroutine run_HiggsSignals_STXS(Chisq_STXS_rates, Chisq_STXS_mh, Chisq_STXS, nobs_STXS, Pvalue_STXS) !------------------------------------------------------------ use STXS, only : evaluate_model_for_STXS, get_chisq_from_STXS, & & get_number_of_STXS_observables, STXSlist use usefulbits, only : theo,just_after_run, ndat, vsmall use usefulbits_hs, only : HSres use theo_manip, only : HB5_complete_theo use numerics, only : gammp double precision, intent(out) :: Chisq_STXS_rates, Chisq_STXS_mh, Chisq_STXS, Pvalue_STXS integer, intent(out) :: nobs_STXS double precision :: Pvalue integer :: nobs_STXS_rates, nobs_STXS_mh, i, n call HB5_complete_theo Chisq_STXS_mh = 0.0D0 do n=1, ndat do i=lbound(STXSlist,dim=1), ubound(STXSlist,dim=1) call evaluate_model_for_STXS(STXSlist(i),theo(n)) enddo call get_chisq_from_STXS(Chisq_STXS_rates, Pvalue_STXS) call get_number_of_STXS_observables(nobs_STXS_rates, nobs_STXS_mh) nobs_STXS = nobs_STXS_rates + nobs_STXS_mh ! Add routine for possible mh-observable in STXS here! Chisq_STXS = Chisq_STXS_rates + Chisq_STXS_mh HSres(n)%Chisq_STXS_rates = Chisq_STXS_rates HSres(n)%Chisq_STXS_mh = Chisq_STXS_mh HSres(n)%Chisq_STXS = Chisq_STXS HSres(n)%nobs_STXS_rates = nobs_STXS_rates HSres(n)%nobs_STXS_mh = nobs_STXS_mh HSres(n)%nobs_STXS = nobs_STXS Pvalue = 1.0D0 if(Chisq_STXS.gt.vsmall.and.(nobs_STXS-Nparam).gt.0) then Pvalue = 1 - gammp(dble(nobs_STXS-Nparam)/2,Chisq_STXS/2) endif HSres(n)%Pvalue_STXS = Pvalue enddo end subroutine run_HiggsSignals_STXS !------------------------------------------------------------------------------------ subroutine run_HiggsSignals(mode, Chisq_mu, Chisq_mh, Chisq, nobs, Pvalue) !------------------------------------------------------------ ! This subroutine can be called by the user after HiggsSignals_initialize has been called. ! The input routines, where required, should be called before calling run_HiggsSignals. ! It takes theoretical predictions for a particular parameter point ! in the model and calls subroutines which compare these predictions ! to the experimental results. ! Arguments (output): ! * mode = 1,2 or 3 for peak-centered, mass-centered chi^2 method or both, respectively. ! * Chisq_mu = total chi^2 contribution from signal strength measurements ! * Chisq_mh = total chi^2 contribution from Higgs mass measurements ! * Chisq = total chi^2 value for the combination of the considered Higgs signals ! * nobs = total number of observables ! * Pvalue = total chi^2 probability for the agreement between model and data, ! assuming number of observables == number of degrees of freedom ! (see manual for more precise definitions)) !------------------------------------------------------------ use usefulbits, only : theo,just_after_run, inputmethod, ndat!inputsub, use usefulbits_HS, only : HSres, runmode, output_level, usescalefactor, Nparam,Exptdir use channels, only : check_channels use theo_manip, only : HB5_complete_theo!, HB5_recalculate_theo_for_datapoint #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none integer,intent(in) :: mode !----------------------------------------output integer,intent(out) :: nobs double precision,intent(out) :: Pvalue, Chisq, Chisq_mu, Chisq_mh !-------------------------------------internal integer :: n,i logical :: debug=.False. !--------------------------------------------- if(mode.eq.1) then runmode="peak" else if(mode.eq.2) then ! runmode="mass" write(*,*) "Warning: The 'mass' method (runmode = 2) is no longer maintained." write(*,*) " The peak-centered chi^2 method will be used instead." runmode="peak" else if(mode.eq.3) then ! runmode="both" write(*,*) "Warning: The 'both' method (runmode = 3) is no longer maintained." write(*,*) " The peak-centered chi^2 method will be used instead." runmode="peak" else stop'Error in subroutine run_HiggsSignals: mode unknown' endif if(.not.allocated(theo))then stop 'subroutine HiggsSignals_initialize must be called first' endif ! if(inputmethod.eq.'subrout') then ! do i=1,ubound(inputsub,dim=1) ! if( inputsub(i)%req .ne. inputsub(i)%stat )then ! write(*,*) inputsub(i)%req, inputsub(i)%stat ! write(*,*)'subroutine '//trim(adjustl(inputsub(i)%desc)) ! write(*,*)'should be called once and only once before each call to' ! write(*,*)'subroutine run_HiggsSignals.' ! stop'error in subroutine run_HiggsSignals' ! endif ! TS: Have to work on this bit to make it run simultaneously with HiggsBounds. Now, ! commented out the =0 statement. HS thus has to be run before HB. ! inputsub(i)%stat=0!now we have used this input, set back to zero ! enddo ! endif if(debug)write(*,*)'manipulating input...' ; call flush(6) call HB5_complete_theo if(debug)write(*,*)'compare each model to the experimental data...' ; call flush(6) do n=1,ndat ! call recalculate_theo_for_datapoint(n) call evaluate_model(theo(n),n) Pvalue = HSres(n)%Pvalue_peak Chisq = HSres(n)%Chisq_peak Chisq_mu = HSres(n)%Chisq_peak_mu Chisq_mh = HSres(n)%Chisq_peak_mh nobs = HSres(n)%nobs_peak if(output_level.ne.0) then write(*,*) write(*,*) '#*************************************************************************#' write(*,*) '# HIGGSSIGNALS RESULTS (',trim(adjustl(Exptdir)),') #' write(*,*) '#*************************************************************************#' write(*,'(A55,F21.8)') 'chi^2 from signal strength peak observables = ',& & HSres(n)%Chisq_peak_mu write(*,'(A55,F21.8)') 'chi^2 from Higgs mass peak observables = ',HSres(n)%Chisq_mh ! write(*,'(A55,F21.8)') 'chi^2 from mass-centered observables = ',HSres(n)%Chisq_mpred write(*,'(A55,F21.8)') 'chi^2 from signal strength (total) = ',HSres(n)%Chisq_mu write(*,'(A55,F21.8)') 'chi^2 (total) = ',HSres(n)%Chisq write(*,'(A55,I21)') 'Number of signal strength peak observables = ',& & HSres(n)%nobs_peak_mu write(*,'(A55,I21)') 'Number of Higgs mass peak observables = ',HSres(n)%nobs_peak_mh ! write(*,'(A55,I21)') 'Number of mass-centered observables = ',HSres(n)%nobs_mpred write(*,'(A55,I21)') 'Number of observables (total) = ',HSres(n)%nobs write(*,'(A48,I3,A4,F21.8)') 'Probability (ndf =',HSres(n)%nobs-Nparam,') = ',HSres(n)%Pvalue write(*,*) '#*************************************************************************#' write(*,*) endif enddo just_after_run=.True. usescalefactor=.False. end subroutine run_HiggsSignals !------------------------------------------------------------ subroutine evaluate_model( t , n ) !------------------------------------------------------------ ! This subroutine evaluates the signal strength modifier for every Higgs boson and ! considered analysis. It fills a matrix neutHiggs(:,:) of type neutHiggs with dimensions ! (number(considered analyses),nH). !------------------------------------------------------------ use usefulbits, only : np,Hneut,Hplus,dataset,results, vsmall use usefulbits_hs, only : neutHiggses, nanalys, runmode, HSresults, cov, obs, analyses,& & cov_mhneut, iterations, deallocate_covariance_matrices, & & output_level, Nparam, nanalys use datatables, only : setup_tablelist, check_available_Higgses use pc_chisq use mc_chisq use all_chisq use numerics implicit none !--------------------------------------input type(dataset), intent(in) :: t integer, intent(in) :: n !-------------------------------------output ! type(HSresults), intent(out) :: r integer :: ii, jj, iii, jjj double precision :: totchisq, muchisq, mhchisq, mpchisq, mpredchisq integer :: nobs, Nmu, Nmh, Nmpred character(LEN=100), allocatable :: assignmentgroups(:) integer, allocatable :: assignmentgroups_domH(:) integer, allocatable :: assignmentgroups_Higgs_comb(:,:) allocate(assignmentgroups(nanalys),assignmentgroups_domH(nanalys)) allocate(assignmentgroups_Higgs_comb(nanalys,np(Hneut))) assignmentgroups = '' !---Initialize assignmentgroups arrays with default values do ii=lbound(assignmentgroups_domH,dim=1),ubound(assignmentgroups_domH,dim=1) assignmentgroups_domH(ii) = 0 assignmentgroups_Higgs_comb(ii,:) = 0 enddo !---First, evaluate the model predictions allocate(neutHiggses(nanalys,np(Hneut))) !-Loop over considered analyses do ii=lbound(neutHiggses,dim=1),ubound(neutHiggses,dim=1) !-Loop over the neutral Higgs bosons of the model do jj=lbound(neutHiggses,dim=2),ubound(neutHiggses,dim=2) !! write(*,*) "hello evaluate model:", ii, jj call calc_mupred(jj, t, obs(ii)%table, neutHiggses(ii,jj)) enddo if(.not.allocated(obs(ii)%Higgses)) allocate(obs(ii)%Higgses(np(Hneut))) obs(ii)%Higgses(:) = neutHiggses(ii,:) enddo !-Pass the observables and their predicted Higgs properties (obs%Higgses) !-to the tablelist "analyses" call setup_tablelist ! select case(runmode) ! ! case('peak') !-Peak-centered chisq method jjj=0 do ii=lbound(analyses,dim=1),ubound(analyses,dim=1) call deallocate_covariance_matrices call assign_Higgs_to_peaks(analyses(ii)%table, analyses(ii)%peaks,0) do iii=lbound(analyses(ii)%peaks,dim=1),ubound(analyses(ii)%peaks,dim=1) if(analyses(ii)%table%mhchisq.eq.1.and.& & len(trim(adjustl(analyses(ii)%peaks(iii)%assignmentgroup))).ne.0) then jjj=jjj+1 assignmentgroups(jjj)=analyses(ii)%peaks(iii)%assignmentgroup assignmentgroups_Higgs_comb(jjj,:)=analyses(ii)%peaks(iii)%Higgs_comb assignmentgroups_domH(jjj)=analyses(ii)%peaks(iii)%domH !! write(*,*) "Found leader of group ",assignmentgroups(jjj) !! write(*,*) "ID ",analyses(ii)%peaks(iii)%id !! write(*,*) "with Higgs combination ",assignmentgroups_Higgs_comb(jjj,:) !! write(*,*) "and dominant Higgs boson ",assignmentgroups_domH(jjj) endif enddo enddo do ii=lbound(analyses,dim=1),ubound(analyses,dim=1) do iii=lbound(analyses(ii)%peaks,dim=1),ubound(analyses(ii)%peaks,dim=1) if(analyses(ii)%table%mhchisq.eq.0.and.& & len(trim(adjustl(analyses(ii)%peaks(iii)%assignmentgroup))).ne.0) then !SELECT ASSIGNMENT GROUP FOLLOWERS do jjj=lbound(assignmentgroups,dim=1),ubound(assignmentgroups,dim=1) if(analyses(ii)%peaks(iii)%assignmentgroup.eq.assignmentgroups(jjj)) then !TAKE OVER THE HIGGS ASSIGNMENT OF THE LEADING PEAK analyses(ii)%peaks(iii)%Higgs_comb=assignmentgroups_Higgs_comb(jjj,:) analyses(ii)%peaks(iii)%domH=assignmentgroups_domH(jjj) if(assignmentgroups_domH(jjj).ne.0) then analyses(ii)%peaks(iii)%Higgs_assignment_forced=1 endif call evaluate_peak(analyses(ii)%peaks(iii),analyses(ii)%table) endif enddo endif enddo enddo ! Do the iterative Higgs-to-peak-assignment here: call assign_Higgs_to_peaks_with_correlations(iterations) call calculate_total_pc_chisq(totchisq, muchisq, mhchisq, nobs, Nmu, Nmh) if(output_level.eq.1) call print_peakinformation if(output_level.eq.2) call print_peakinformation_essentials if(output_level.eq.3) then call print_peaks_to_file call print_peaks_signal_rates_to_file endif call add_peaks_to_HSresults(HSres(n)) HSres(n)%Chisq_peak=totchisq HSres(n)%Chisq_peak_mu = muchisq HSres(n)%Chisq_mpred = 0.0D0 HSres(n)%Chisq_peak_mu=muchisq HSres(n)%Chisq_peak_mh=mhchisq HSres(n)%nobs_mpred=0 HSres(n)%nobs_peak_mu=Nmu HSres(n)%nobs_peak_mh=Nmh HSres(n)%nanalysis=size(analyses) HSres(n)%nobs_peak=nobs if(HSres(n)%Chisq.gt.vsmall.and.(HSres(n)%nobs-Nparam).gt.0) then HSres(n)%Pvalue_peak = 1 - gammp(dble(HSres(n)%nobs-Nparam)/2,HSres(n)%Chisq/2) endif ! case('mass') ! do ii=lbound(analyses,dim=1),ubound(analyses,dim=1) ! call fill_mp_obs(ii) ! enddo ! if(mc_mode.eq.1) call mass_variation_by_theory_uncertainty ! call create_covariance_matrix_mp ! call calculate_mpred_chisq(mpchisq, nobs) ! ! if(output_level.eq.1) call print_mc_observables ! if(output_level.eq.2) call print_mc_observables_essentials ! if(output_level.eq.3) then ! call print_mc_tables_to_file ! call print_mc_observables_to_file ! endif ! ! HSres(n)%Chisq=mpchisq ! HSres(n)%Chisq_peak_mu = 0.0D0 ! HSres(n)%Chisq_mpred = mpchisq ! HSres(n)%Chisq_mu=mpchisq ! HSres(n)%Chisq_mh=0.0D0 ! HSres(n)%nobs_mpred=nobs ! HSres(n)%nobs_peak_mu=0 ! HSres(n)%nobs_peak_mh=0 ! HSres(n)%nanalysis=size(analyses) ! HSres(n)%nobs=nobs ! if(HSres(n)%Chisq.gt.vsmall.and.(HSres(n)%nobs-Nparam).gt.0) then ! HSres(n)%Pvalue=1 - gammp(dble(HSres(n)%nobs-Nparam)/2,HSres(n)%Chisq/2) ! endif ! ! case('both') ! jjj=0 ! do ii=lbound(analyses,dim=1),ubound(analyses,dim=1) ! call deallocate_covariance_matrices ! call assign_Higgs_to_peaks(analyses(ii)%table, analyses(ii)%peaks,0) ! do iii=lbound(analyses(ii)%peaks,dim=1),ubound(analyses(ii)%peaks,dim=1) ! if(analyses(ii)%table%mhchisq.eq.1.and.& ! & len(trim(analyses(ii)%peaks(iii)%assignmentgroup)).ne.0) then ! jjj=jjj+1 ! assignmentgroups(jjj)=analyses(ii)%peaks(iii)%assignmentgroup ! assignmentgroups_Higgs_comb(jjj,:)=analyses(ii)%peaks(iii)%Higgs_comb ! assignmentgroups_domH(jjj)=analyses(ii)%peaks(iii)%domH ! endif ! enddo ! enddo ! do ii=lbound(analyses,dim=1),ubound(analyses,dim=1) ! do iii=lbound(analyses(ii)%peaks,dim=1),ubound(analyses(ii)%peaks,dim=1) ! if(analyses(ii)%table%mhchisq.eq.0.and.& ! & len(trim(analyses(ii)%peaks(iii)%assignmentgroup)).ne.0) then ! do jjj=lbound(assignmentgroups,dim=1),ubound(assignmentgroups,dim=1) ! if(analyses(ii)%peaks(iii)%assignmentgroup.eq.assignmentgroups(jjj)) then ! !TAKE OVER THE HIGGS ASSIGNMENT OF THE LEADING PEAK ! analyses(ii)%peaks(iii)%Higgs_comb=assignmentgroups_Higgs_comb(jjj,:) ! analyses(ii)%peaks(iii)%domH=assignmentgroups_domH(jjj) ! if(assignmentgroups_domH(jjj).ne.0) then ! analyses(ii)%peaks(iii)%Higgs_assignment_forced=1 ! endif ! ! TODO: Need to evaluate everything else here! ! call evaluate_peak(analyses(ii)%peaks(iii),analyses(ii)%table) ! endif ! enddo ! endif ! enddo ! enddo ! ! call assign_Higgs_to_peaks_with_correlations(iterations) ! ! do ii=lbound(analyses,dim=1),ubound(analyses,dim=1) ! call check_available_Higgses(ii) ! call fill_mp_obs(ii) ! enddo ! if(mc_mode.eq.1) call mass_variation_by_theory_uncertainty ! ! call calculate_total_chisq(totchisq, muchisq, mhchisq, mpredchisq, nobs, Nmu, Nmh, Nmpred) ! ! !Have to write a new print method ! if(output_level.eq.1) call print_all_observables ! if(output_level.eq.2) call print_peakinformation_essentials ! if(output_level.eq.3) then ! call print_peaks_to_file ! call print_peaks_signal_rates_to_file ! endif ! ! call add_peaks_to_HSresults(r) ! ! HSres(n)%Chisq=totchisq ! HSres(n)%Chisq_peak_mu = muchisq ! HSres(n)%Chisq_mpred = mpredchisq ! HSres(n)%Chisq_mu=muchisq + mpredchisq ! HSres(n)%Chisq_mh=mhchisq ! HSres(n)%nobs_mpred=Nmpred ! HSres(n)%nobs_peak_mu=Nmu ! HSres(n)%nobs_peak_mh=Nmh ! HSres(n)%nanalysis=size(analyses) ! HSres(n)%nobs=nobs ! if(HSres(n)%Chisq.gt.vsmall.and.(HSres(n)%nobs-Nparam).gt.0) then ! HSres(n)%Pvalue=1 - gammp(dble(HSres(n)%nobs-Nparam)/2,HSres(n)%Chisq/2) ! endif ! ! case default ! stop "Error in subroutine evaluate_model: Please specify runmode!" ! ! end select deallocate(neutHiggses) deallocate(assignmentgroups, assignmentgroups_domH, assignmentgroups_Higgs_comb) end subroutine evaluate_model !------------------------------------------------------------ subroutine calc_mupred( j, t, mutab, Higgs ) ! Calculates the model-predicted signal strength modifier !------------------------------------------------------------ use usefulbits, only : dataset, div, vsmall use usefulbits_HS, only : neutHiggs, mutable, useSMtest, eps implicit none integer, intent(in) :: j ! Higgs index type(dataset), intent(in) :: t type(mutable), intent(inout) :: mutab type(neutHiggs), intent(inout) :: Higgs integer :: i double precision :: c, dcbyc integer :: testSMratios logical :: correct_properties Higgs%m = t%particle(mutab%particle_x)%M(j) Higgs%dm = t%particle(mutab%particle_x)%dM(j) Higgs%id = j call get_channelrates( j, t, mutab ) correct_properties=.True. !--Evaluate the predicted signal strength modifier c of the model c=0. do i=1,mutab%Nc !----use a weighted average of the channel rate ratios c=c+mutab%channel_w(i,j)*mutab%channel_mu(i,j) enddo !--Evaluate the deviation of each channel rate ratio to the signal !--strength modifier c and test SM likeness criterium, if this is !--activated. testSMratios= 1 !passes the SM-like ratios test do i=1,mutab%Nc dcbyc=div((mutab%channel_mu(i,j)-c),c,0.0D0,1.0D9) if(dcbyc*mutab%channel_w(i,j).gt.eps.and.useSMtest) then testSMratios= -1 !fails the SM-like ratios test endif enddo if(testSMratios.lt.0) correct_properties=.False. if(correct_properties) then Higgs%mu=c else Higgs%mu=0.0D0 endif end subroutine calc_mupred !------------------------------------------------------------ subroutine get_channelrates( j, t, mutab ) ! This subroutine assignes the rates, weights and systematic rate uncertainty of ! the Higgs boson (j) for the channels considered by the analysis (mutab). ! ! WARNING: if normalize_rates_to_reference_position is true ! The rates are normalized w.r.t. a reference rate at the (peak) mass position. ! This does not work with the mass-centered chi^2 method. ! Also, theoretical mass uncertainties are problematic! !------------------------------------------------------------ use usefulbits, only : dataset, div, small use usefulbits_HS, only : neutHiggs, mutable, delta_rate, normalize_rates_to_reference_position,& & normalize_rates_to_reference_position_outside_dmtheo use theory_XS_SM_functions use theory_BRfunctions integer, intent(in) :: j type(dataset), intent(in) :: t type(mutable), intent(inout) :: mutab integer :: i, p, d ! id integer :: ii, p1, p2, d1, d2 !id1, id2 double precision :: rate, SMrate, modelrate, drsq_SM, drsq, dBR, dBRSM,drcov,drcovSM !!NEW: double precision :: rate_SMref,refmass,BR_SMref!,BR_SMref_mpeak if(size(mutab%mass,dim=1).eq.1) then refmass = mutab%mass(1) else ! write(*,*) "mutab%id", mutab%id, "Mass measurements: ",size(mutab%mass,dim=1) ! write(*,*) "mutab%particle_x = ", mutab%particle_x, " j= ", j refmass = t%particle(mutab%particle_x)%M(j) endif !write(*,*) 'DEBUG HS: id = ', mutab%id !write(*,*) 'DEBUG HS, m = ', t%particle(mutab%particle_x)%M(j) do i=1,mutab%Nc ! id = mutab%channel_id(i) ! p = int((id-modulo(id,10))/dble(10)) ! d = modulo(id,10) p = mutab%channel_p_id(i) d = mutab%channel_d_id(i) !--Do the production rate for the relevant experiment and cms-energy if(mutab%collider.eq.'LHC') then if(abs(mutab%energy-7.0D0).le.small) then if(p.eq.1) then rate=t%lhc7%XS_hj_ratio(j) SMrate=t%lhc7%XS_H_SM(j) rate_SMref=XS_lhc7_gg_H_SM(refmass) mutab%channel_description(i,1)='singleH' else if(p.eq.2) then rate=t%lhc7%XS_vbf_ratio(j) SMrate=t%lhc7%XS_vbf_SM(j) rate_SMref=XS_lhc7_vbf_SM(refmass) mutab%channel_description(i,1)='VBF' else if(p.eq.3) then rate=t%lhc7%XS_hjW_ratio(j) SMrate=t%lhc7%XS_HW_SM(j) rate_SMref=XS_lhc7_HW_SM(refmass) mutab%channel_description(i,1)='HW' else if(p.eq.4) then rate=t%lhc7%XS_hjZ_ratio(j) SMrate=t%lhc7%XS_HZ_SM(j) rate_SMref=XS_lhc7_HZ_SM(refmass) mutab%channel_description(i,1)='HZ' else if(p.eq.5) then rate=t%lhc7%XS_tthj_ratio(j) SMrate=t%lhc7%XS_ttH_SM(j) rate_SMref=XS_lhc7_ttH_SM(refmass) mutab%channel_description(i,1)='ttH' else if(p.eq.6) then rate=t%lhc7%XS_gg_hj_ratio(j) SMrate=t%lhc7%XS_gg_H_SM(j) rate_SMref=XS_lhc7_gg_H_SM(refmass) mutab%channel_description(i,1)='ggH' else if(p.eq.7) then rate=t%lhc7%XS_bb_hj_ratio(j) SMrate=t%lhc7%XS_bb_H_SM(j) rate_SMref=XS_lhc7_bb_H_SM(refmass) mutab%channel_description(i,1)='bbH' else if(p.eq.8) then rate=t%lhc7%XS_thj_tchan_ratio(j) SMrate=t%lhc7%XS_tH_tchan_SM(j) rate_SMref=XS_lhc7_tH_tchan_SM(refmass) mutab%channel_description(i,1)='tH (t-channel)' else if(p.eq.9) then rate=t%lhc7%XS_thj_schan_ratio(j) SMrate=t%lhc7%XS_tH_schan_SM(j) rate_SMref=XS_lhc7_tH_schan_SM(refmass) mutab%channel_description(i,1)='tH (s-channel)' else if(p.eq.10) then rate=t%lhc7%XS_qq_hjZ_ratio(j) SMrate=t%lhc7%XS_qq_HZ_SM(j) rate_SMref=XS_lhc7_HZ_SM(refmass) ! WARNING: This is still the inclusive rate!!! ! rate_SMref=XS_lhc7_qq_HZ_SM(refmass) !Need to create this function yet! mutab%channel_description(i,1)='qq-HZ' else if(p.eq.11) then rate=t%lhc7%XS_gg_hjZ_ratio(j) SMrate=t%lhc7%XS_gg_HZ_SM(j) rate_SMref=XS_lhc7_HZ_SM(refmass) ! WARNING: This is still the inclusive rate!!! ! rate_SMref=XS_lhc7_gg_HZ_SM(refmass) !Need to create this function yet! mutab%channel_description(i,1)='gg-HZ' else if(p.eq.0) then rate=1.0D0 SMrate=1.0D0 rate_SMref=1.0D0 mutab%channel_description(i,1)='none' endif else if(abs(mutab%energy-8.0D0).le.small) then if(p.eq.1) then rate=t%lhc8%XS_hj_ratio(j) SMrate=t%lhc8%XS_H_SM(j) rate_SMref=XS_lhc8_gg_H_SM(refmass) mutab%channel_description(i,1)='singleH' else if(p.eq.2) then rate=t%lhc8%XS_vbf_ratio(j) SMrate=t%lhc8%XS_vbf_SM(j) rate_SMref=XS_lhc8_vbf_SM(refmass) mutab%channel_description(i,1)='VBF' else if(p.eq.3) then rate=t%lhc8%XS_hjW_ratio(j) SMrate=t%lhc8%XS_HW_SM(j) rate_SMref=XS_lhc8_HW_SM(refmass) mutab%channel_description(i,1)='HW' else if(p.eq.4) then rate=t%lhc8%XS_hjZ_ratio(j) SMrate=t%lhc8%XS_HZ_SM(j) rate_SMref=XS_lhc8_HZ_SM(refmass) mutab%channel_description(i,1)='HZ' else if(p.eq.5) then rate=t%lhc8%XS_tthj_ratio(j) SMrate=t%lhc8%XS_ttH_SM(j) rate_SMref=XS_lhc8_ttH_SM(refmass) mutab%channel_description(i,1)='ttH' else if(p.eq.0) then rate=1.0D0 SMrate=1.0D0 rate_SMref=1.0D0 mutab%channel_description(i,1)='none' endif else if(abs(mutab%energy-13.0D0).le.small) then if(p.eq.1) then rate=t%lhc13%XS_hj_ratio(j) SMrate=t%lhc13%XS_H_SM(j) rate_SMref=XS_lhc13_gg_H_SM(refmass) mutab%channel_description(i,1)='singleH' else if(p.eq.2) then rate=t%lhc13%XS_vbf_ratio(j) SMrate=t%lhc13%XS_vbf_SM(j) rate_SMref=XS_lhc13_vbf_SM(refmass) mutab%channel_description(i,1)='VBF' else if(p.eq.3) then rate=t%lhc13%XS_hjW_ratio(j) SMrate=t%lhc13%XS_HW_SM(j) rate_SMref=XS_lhc13_HW_SM(refmass) mutab%channel_description(i,1)='HW' else if(p.eq.4) then rate=t%lhc13%XS_hjZ_ratio(j) SMrate=t%lhc13%XS_HZ_SM(j) rate_SMref=XS_lhc13_HZ_SM(refmass) mutab%channel_description(i,1)='HZ' else if(p.eq.5) then rate=t%lhc13%XS_tthj_ratio(j) SMrate=t%lhc13%XS_ttH_SM(j) rate_SMref=XS_lhc13_ttH_SM(refmass) mutab%channel_description(i,1)='ttH' else if(p.eq.0) then rate=1.0D0 SMrate=1.0D0 rate_SMref=1.0D0 mutab%channel_description(i,1)='none' endif endif else if(mutab%collider.eq.'TEV') then if(p.eq.1) then rate=t%tev%XS_hj_ratio(j) SMrate=t%tev%XS_H_SM(j) rate_SMref=XS_tev_gg_H_SM(refmass) mutab%channel_description(i,1)='singleH' else if(p.eq.2) then rate=t%tev%XS_vbf_ratio(j) SMrate=t%tev%XS_vbf_SM(j) rate_SMref=XS_tev_vbf_SM(refmass) mutab%channel_description(i,1)='VBF' else if(p.eq.3) then rate=t%tev%XS_hjW_ratio(j) SMrate=t%tev%XS_HW_SM(j) rate_SMref=XS_tev_HW_SM(refmass) mutab%channel_description(i,1)='HW' else if(p.eq.4) then rate=t%tev%XS_hjZ_ratio(j) SMrate=t%tev%XS_HZ_SM(j) rate_SMref=XS_tev_HZ_SM(refmass) mutab%channel_description(i,1)='HZ' else if(p.eq.5) then rate=t%tev%XS_tthj_ratio(j) SMrate=t%tev%XS_ttH_SM(j) rate_SMref=XS_tev_ttH_SM(refmass) mutab%channel_description(i,1)='ttH' else if(p.eq.0) then rate=1.0D0 SMrate=1.0D0 rate_SMref=1.0D0 mutab%channel_description(i,1)='none' endif else if(mutab%collider.eq.'ILC') then !--n.B.: As a first attempt, we use the LHC8 normalized cross sections for ZH, VBF, ttH. ! In order to do this properly, a separate input for the ILC cross sections ! has to be provided! It works only for single production mode observables (no ! correct weighting of channels included!)Then, at least in the effective coupling ! approximation, there is no difference to a full implementation. ! The theoretical uncertainty of the ILC production modes will are defined in ! usefulbits_HS.f90. if(p.eq.1.or.p.eq.2) then write(*,*) 'Warning: Unknown ILC production mode (',p,') in table ',mutab%id rate=0.0D0 SMrate=1.0D0 rate_SMref=1.0D0 mutab%channel_description(i,1)='unknown' else if(p.eq.3) then rate=t%lhc8%XS_hjW_ratio(j) SMrate=t%lhc8%XS_HW_SM(j) rate_SMref=XS_lhc8_HW_SM(refmass) mutab%channel_description(i,1)='WBF' else if(p.eq.4) then rate=t%lhc8%XS_hjZ_ratio(j) SMrate=t%lhc8%XS_HZ_SM(j) rate_SMref=XS_lhc8_HZ_SM(refmass) mutab%channel_description(i,1)='HZ' else if(p.eq.5) then rate=t%lhc8%XS_tthj_ratio(j) SMrate=t%lhc8%XS_ttH_SM(j) rate_SMref=XS_lhc8_ttH_SM(refmass) mutab%channel_description(i,1)='ttH' else if(p.eq.0) then rate=1.0D0 SMrate=1.0D0 rate_SMref=1.0D0 mutab%channel_description(i,1)='none' endif endif !--Multiply now by the decay rate if(d.eq.1) then rate=rate*div(t%BR_hjgaga(j),t%BR_Hgaga_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_Hgaga_SM(j) rate_SMref = rate_SMref*BRSM_Hgaga(refmass) mutab%channel_description(i,2)='gammagamma' else if(d.eq.2) then rate=rate*div(t%BR_hjWW(j),t%BR_HWW_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_HWW_SM(j) rate_SMref = rate_SMref*BRSM_HWW(refmass) mutab%channel_description(i,2)='WW' else if(d.eq.3) then rate=rate*div(t%BR_hjZZ(j),t%BR_HZZ_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_HZZ_SM(j) rate_SMref = rate_SMref*BRSM_HZZ(refmass) mutab%channel_description(i,2)='ZZ' else if(d.eq.4) then rate=rate*div(t%BR_hjtautau(j),t%BR_Htautau_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_Htautau_SM(j) rate_SMref = rate_SMref*BRSM_Htautau(refmass) mutab%channel_description(i,2)='tautau' else if(d.eq.5) then rate=rate*div(t%BR_hjbb(j),t%BR_Hbb_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_Hbb_SM(j) rate_SMref = rate_SMref*BRSM_Hbb(refmass) mutab%channel_description(i,2)='bb' else if(d.eq.6) then rate=rate*div(t%BR_hjZga(j),t%BR_HZga_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_HZga_SM(j) rate_SMref = rate_SMref*BRSM_HZga(refmass) mutab%channel_description(i,2)='Zgamma' else if(d.eq.7) then rate=rate*div(t%BR_hjcc(j),t%BR_Hcc_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_Hcc_SM(j) rate_SMref = rate_SMref*BRSM_Hcc(refmass) mutab%channel_description(i,2)='cc' else if(d.eq.8) then rate=rate*div(t%BR_hjmumu(j),t%BR_Hmumu_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_Hmumu_SM(j) rate_SMref = rate_SMref*BRSM_Hmumu(refmass) mutab%channel_description(i,2)='mumu' else if(d.eq.9) then rate=rate*div(t%BR_hjgg(j),t%BR_Hgg_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_Hgg_SM(j) rate_SMref = rate_SMref*BRSM_Hgg(refmass) mutab%channel_description(i,2)='gg' else if(d.eq.10) then rate=rate*div(t%BR_hjss(j),t%BR_Hss_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_Hss_SM(j) rate_SMref = rate_SMref*BRSM_Hss(refmass) mutab%channel_description(i,2)='ss' else if(d.eq.11) then rate=rate*div(t%BR_hjtt(j),t%BR_Htt_SM(j),0.0D0,1.0D0) SMrate=SMrate*t%BR_Htt_SM(j) rate_SMref = rate_SMref*BRSM_Htoptop(refmass) mutab%channel_description(i,2)='tt' else if(d.eq.0) then rate=rate*1.0D0 SMrate=SMrate*1.0D0 rate_SMref = rate_SMref*1.0D0 mutab%channel_description(i,2)='none' endif !------------------------- ! NEW FEATURE (since HB-5.2): Enable to set channelrates directly. if(p.ne.0.and.d.ne.0) then select case(d) case(1) BR_SMref = t%BR_Hgaga_SM(j) ! BR_SMref_mpeak = BRSM_Hgaga(refmass) case(2) BR_SMref = t%BR_HWW_SM(j) ! BR_SMref_mpeak = BRSM_HWW(refmass) case(3) BR_SMref = t%BR_HZZ_SM(j) ! BR_SMref_mpeak = BRSM_HZZ(refmass) case(4) BR_SMref = t%BR_Htautau_SM(j) ! BR_SMref_mpeak = BRSM_Htautau(refmass) case(5) BR_SMref = t%BR_Hbb_SM(j) ! BR_SMref_mpeak = BRSM_Hbb(refmass) case(6) BR_SMref = t%BR_HZga_SM(j) ! BR_SMref_mpeak = BRSM_HZga(refmass) case(7) BR_SMref = t%BR_Hcc_SM(j) ! BR_SMref_mpeak = BRSM_Hcc(refmass) case(8) BR_SMref = t%BR_Hmumu_SM(j) ! BR_SMref_mpeak = BRSM_Hmumu(refmass) case(9) BR_SMref = t%BR_Hgg_SM(j) ! BR_SMref_mpeak = BRSM_Hgg(refmass) case(10) BR_SMref = t%BR_Hss_SM(j) case(11) BR_SMref = t%BR_Htt_SM(j) end select if(mutab%collider.eq.'LHC') then if(abs(mutab%energy-7.0D0).le.small) then if(t%lhc7%channelrates(j,p,d).ge.0.0d0) then rate=div(t%lhc7%channelrates(j,p,d),BR_SMref,0.0D0,1.0D0) endif else if(abs(mutab%energy-8.0D0).le.small) then if(t%lhc8%channelrates(j,p,d).ge.0.0d0) then rate=div(t%lhc8%channelrates(j,p,d),BR_SMref,0.0D0,1.0D0) endif else if(abs(mutab%energy-13.0D0).le.small) then if(t%lhc13%channelrates(j,p,d).ge.0.0d0) then rate=div(t%lhc13%channelrates(j,p,d),BR_SMref,0.0D0,1.0D0) endif endif else if(mutab%collider.eq.'TEV') then if(t%tev%channelrates(j,p,d).ge.0.0d0) then rate=div(t%tev%channelrates(j,p,d),BR_SMref,0.0D0,1.0D0) endif endif endif !------------------------- ! write(*,*) 'DEBUG HS: SM BRs = ', t%BR_HWW_SM(j), t%BR_HZZ_SM(j), t%BR_Hgaga_SM(j) ! write(*,*) 'DEBUG HS: rate, SMrate(i) = ', rate, SMrate ! write(*,*) 'DEBUG HS: eff(i) = ', mutab%channel_eff(i) if(normalize_rates_to_reference_position) then !! THIS IS STILL IN TESTING PHASE !! mutab%channel_mu(i,j)=rate*SMrate/(rate_SMref) else mutab%channel_mu(i,j)=rate !! OLD WAY endif if(normalize_rates_to_reference_position_outside_dmtheo) then if(abs(refmass-t%particle(mutab%particle_x)%M(j)).ge.t%particle(mutab%particle_x)%dM(j)) then mutab%channel_mu(i,j)=rate*SMrate/(rate_SMref) endif endif mutab%channel_w(i,j)=mutab%channel_eff(i)*SMrate ! mutab%channel_w_corrected_eff(i,j)=mutab%channel_eff_ratios(i)*mutab%channel_eff(i)*SMrate enddo ! write(*,*) 'DEBUG HS: BRs = ', t%BR_hjWW, t%BR_hjZZ, t%BR_hjgaga ! write(*,*) 'DEBUG HS: LHC8 = ', t%lhc8%XS_hj_ratio, t%lhc8%XS_vbf_ratio, t%lhc8%XS_hjW_ratio,& ! t%lhc8%XS_hjZ_ratio, t%lhc8%XS_tthj_ratio SMrate=sum(mutab%channel_w(:,j)) ! write(*,*) 'DEBUG HS: SMrate = ', SMrate ! modelrate=sum(mutab%channel_w_corrected_eff(:,j)) do i=1,mutab%Nc mutab%channel_w(i,j)=div(mutab%channel_w(i,j),SMrate,0.0D0,1.0D9) ! mutab%channel_w_corrected_eff(i,j)=div(mutab%channel_w_corrected_eff(i,j),modelrate,0.0D0,1.0D9) enddo ! (TS 30/10/2013): ! write(*,*) "get_channelrates (mu, w, weff):" ! write(*,*) mutab%channel_mu ! write(*,*) mutab%channel_w ! write(*,*) mutab%channel_eff_ratios do i=1,mutab%Nc mutab%channel_w_corrected_eff(i,j)=mutab%channel_eff_ratios(i)*mutab%channel_w(i,j) ! n.b.: model weights are not normalized to 1! enddo ! write(*,*) j,mutab%id, "SM = ", mutab%channel_w(:,j) ! write(*,*) j,mutab%id, "SM effcorr = ",mutab%channel_w_corrected_eff(:,j) do i=1,mutab%Nc drsq_SM = 0.0D0 drsq = 0.0D0 ! id1 = mutab%channel_id(i) ! p1 = int((id1-modulo(id1,10))/dble(10)) ! d1 = modulo(id1,10) p1 = mutab%channel_p_id(i) d1 = mutab%channel_d_id(i) if(mutab%collider.ne.'ILC') then do ii=1,mutab%Nc p2 = mutab%channel_p_id(ii) d2 = mutab%channel_d_id(ii) ! id2 = mutab%channel_id(ii) ! p2 = int((id2-modulo(id2,10))/dble(10)) ! d2 = modulo(id2,10) if(p1.eq.p2.and.p1.ne.0) then if(delta_rate%CScov_ok.and.delta_rate%usecov) then !-- TS 29/03/2017: Add 13 TeV XS covariance matrix here if(abs(mutab%energy-13.0D0).le.small) then drcov=delta_rate%CS13cov(p1,p1) drcovSM=delta_rate%CS13covSM(p1,p1) else drcov=delta_rate%CScov(p1,p1) drcovSM=delta_rate%CScovSM(p1,p1) endif drsq=drsq+drcov*mutab%channel_w_corrected_eff(i,j)*mutab%channel_w_corrected_eff(ii,j) drsq_SM=drsq_SM+drcovSM*mutab%channel_w(i,j)*mutab%channel_w(ii,j) else drsq=drsq+delta_rate%dCS(p1)**2*mutab%channel_w_corrected_eff(i,j)*mutab%channel_w_corrected_eff(ii,j) drsq_SM=drsq_SM+delta_rate%dCS_SM(p1)**2*mutab%channel_w(i,j)*mutab%channel_w(ii,j) endif endif if(d1.eq.d2.and.d1.ne.0) then if(delta_rate%BRcov_ok.and.delta_rate%usecov) then dBRSM = delta_rate%BRcovSM(d1,d1) dBR = delta_rate%BRcov(d1,d1) else dBRSM = delta_rate%dBR_SM(d1)**2 dBR = delta_rate%dBR(d1)**2 endif drsq=drsq+dBR*mutab%channel_w_corrected_eff(i,j)*mutab%channel_w_corrected_eff(ii,j) drsq_SM=drsq_SM+dBRSM*mutab%channel_w(i,j)*mutab%channel_w(ii,j) endif enddo endif mutab%channel_syst(i,j)=sqrt(drsq) mutab%channel_systSM(i,j)=sqrt(drsq_SM) enddo !write(*,*) 'DEBUG HS: mu = ', mutab%channel_mu !write(*,*) 'DEBUG HS: w = ', mutab%channel_w !write(*,*) 'DEBUG HS: eff = ', mutab%channel_eff end subroutine get_channelrates !------------------------------------------------------------ subroutine get_Rvalues(ii,collider,R_H_WW, R_H_ZZ, R_H_gaga, R_H_tautau, R_H_bb, R_VH_bb) ! Returns SM normalized signal rates of some relevant channels (w/o efficiencies) ! for Higgs boson "ii" for a specific collider (see subroutine get_rates). !------------------------------------------------------------ ! use usefulbits, only : theo, np,Hneut ! use usefulbits_HS, only : mutable integer, intent(in) :: ii, collider double precision, intent(out) :: R_H_WW, R_H_ZZ, R_H_gaga, R_H_tautau, R_H_bb, R_VH_bb ! type(mutable) :: dummytable ! integer :: i call get_rates(ii,collider,5,(/ 12, 22, 32, 42, 52 /),R_H_WW) call get_rates(ii,collider,5,(/ 13, 23, 33, 43, 53 /),R_H_ZZ) call get_rates(ii,collider,5,(/ 11, 21, 31, 41, 51 /),R_H_gaga) call get_rates(ii,collider,5,(/ 14, 24, 34, 44, 54 /),R_H_tautau) call get_rates(ii,collider,5,(/ 15, 25, 35, 45, 55 /),R_H_bb) call get_rates(ii,collider,2,(/ 35, 45 /),R_VH_bb) end subroutine get_Rvalues !************************************************************ subroutine get_rates(ii,collider,Nchannels,IDchannels,rate) ! Returns SM normalized signal rates (w/o efficiencies) for Higgs boson "ii" and collider ! experiment "collider"(=1,2,3 for TEV, LHC7, LHC8). "Nchannels" gives the total number ! and IDchannels the two-digit ID of the subchannels, which should be included in the rates. ! IDchannels is an array of size(Nchannels). !------------------------------------------------------------ use usefulbits, only : theo, np,Hneut use usefulbits_HS, only : mutable integer, intent(in) :: ii, collider, Nchannels integer, dimension(Nchannels), intent(in) :: IDchannels double precision, intent(out) :: rate !-Internal type(mutable) :: dummytable integer :: i !-Initialize a dummy mutable in order to run get_channelrates for the channels we want. if(collider.eq.1) then dummytable%collider = 'TEV' else if(collider.eq.2) then dummytable%collider = 'LHC' dummytable%energy = 7.0D0 else if(collider.eq.3) then dummytable%collider = 'LHC' dummytable%energy = 8.0D0 else if(collider.eq.4) then dummytable%collider = 'LHC' dummytable%energy = 13.0D0 else write(*,*) 'WARNING: collider experiment for get_rates unknown.' continue endif dummytable%id = 999999 dummytable%particle_x = 1 dummytable%Nc=Nchannels allocate(dummytable%mass(10)) ! allocate(dummytable%channel_id(Nchannels)) allocate(dummytable%channel_p_id(Nchannels)) allocate(dummytable%channel_d_id(Nchannels)) allocate(dummytable%channel_eff(Nchannels)) allocate(dummytable%channel_eff_ratios(Nchannels)) !-Set all efficiencies equal: dummytable%channel_eff = 1.0D0 dummytable%channel_eff_ratios = 1.0D0 allocate(dummytable%channel_description(Nchannels,2)) allocate(dummytable%channel_w(Nchannels,np(Hneut))) allocate(dummytable%channel_w_corrected_eff(Nchannels,np(Hneut))) allocate(dummytable%channel_systSM(Nchannels,np(Hneut))) allocate(dummytable%channel_syst(Nchannels,np(Hneut))) allocate(dummytable%channel_mu(Nchannels,np(Hneut))) do i=1,Nchannels if(IDchannels(i).le.99) then dummytable%channel_p_id(i) = int((IDchannels(i)-modulo(id,10))/dble(10)) dummytable%channel_d_id(i) = modulo(IDchannels(i),10) else write(*,*) "Error in get_rates: channel-ID not supported. Use get_rates_str instead!" endif enddo call get_channelrates(ii, theo(1), dummytable) rate=0.0D0 do i=lbound(dummytable%channel_mu,dim=1),ubound(dummytable%channel_mu,dim=1) rate = rate + dummytable%channel_mu(i,ii)*dummytable%channel_w(i,ii) enddo deallocate(dummytable%channel_p_id,dummytable%channel_d_id,dummytable%channel_eff,& & dummytable%channel_w,dummytable%channel_systSM,dummytable%channel_syst, & & dummytable%channel_mu,dummytable%channel_eff_ratios,dummytable%channel_description, & & dummytable%channel_w_corrected_eff,dummytable%mass) end subroutine get_rates !************************************************************ subroutine get_rates_str(ii,collider,Nchannels,IDchannels_str,rate) ! Returns SM normalized signal rates (w/o efficiencies) for Higgs boson "ii" and collider ! experiment "collider"(=1,2,3 for TEV, LHC7, LHC8). "Nchannels" gives the total number ! and IDchannels_str the channel ID string of the subchannels, which should be included in the rates. ! IDchannels_str is an array of size(Nchannels). !------------------------------------------------------------ use usefulbits, only : theo, np,Hneut use usefulbits_HS, only : mutable integer, intent(in) :: ii, collider, Nchannels character(LEN=5), dimension(Nchannels), intent(in) :: IDchannels_str double precision, intent(out) :: rate !-Internal type(mutable) :: dummytable integer :: i,id,posperiod !-Initialize a dummy mutable in order to run get_channelrates for the channels we want. if(collider.eq.1) then dummytable%collider = 'TEV' else if(collider.eq.2) then dummytable%collider = 'LHC' dummytable%energy = 7.0D0 else if(collider.eq.3) then dummytable%collider = 'LHC' dummytable%energy = 8.0D0 else if(collider.eq.4) then dummytable%collider = 'LHC' dummytable%energy = 13.0D0 else write(*,*) 'WARNING: collider experiment for get_rates unknown.' continue endif dummytable%id = 999999 dummytable%particle_x = 1 dummytable%Nc=Nchannels allocate(dummytable%mass(10)) ! allocate(dummytable%channel_id(Nchannels)) allocate(dummytable%channel_p_id(Nchannels)) allocate(dummytable%channel_d_id(Nchannels)) allocate(dummytable%channel_eff(Nchannels)) allocate(dummytable%channel_eff_ratios(Nchannels)) !-Set all efficiencies equal: dummytable%channel_eff = 1.0D0 dummytable%channel_eff_ratios = 1.0D0 allocate(dummytable%channel_description(Nchannels,2)) allocate(dummytable%channel_w(Nchannels,np(Hneut))) allocate(dummytable%channel_w_corrected_eff(Nchannels,np(Hneut))) allocate(dummytable%channel_systSM(Nchannels,np(Hneut))) allocate(dummytable%channel_syst(Nchannels,np(Hneut))) allocate(dummytable%channel_mu(Nchannels,np(Hneut))) do i=1,Nchannels posperiod = index(IDchannels_str(i),'.') if(posperiod.eq.0) then if(len(trim(adjustl(IDchannels_str(i)))).eq.2) then read(IDchannels_str(i),*) id dummytable%channel_p_id(i) = int((id-modulo(id,10))/dble(10)) dummytable%channel_d_id(i) = modulo(id,10) else stop " Error in get_rates_str: Cannot handle channel IDs!" endif else read(IDchannels_str(i)(:posperiod-1),*) dummytable%channel_p_id(i) read(IDchannels_str(i)(posperiod+1:),*) dummytable%channel_d_id(i) endif enddo call get_channelrates(ii, theo(1), dummytable) rate=0.0D0 do i=lbound(dummytable%channel_mu,dim=1),ubound(dummytable%channel_mu,dim=1) rate = rate + dummytable%channel_mu(i,ii)*dummytable%channel_w(i,ii) enddo deallocate(dummytable%channel_p_id,dummytable%channel_d_id,dummytable%channel_eff,& & dummytable%channel_w,dummytable%channel_systSM,dummytable%channel_syst, & & dummytable%channel_mu,dummytable%channel_eff_ratios,dummytable%channel_description, & & dummytable%channel_w_corrected_eff,dummytable%mass) end subroutine get_rates_str !------------------------------------------------------------ subroutine get_Pvalue(nparam, Pvalue) ! Calculates the Chi^2 probability for the total Chi^2 value ! and the number of degrees of freedom given by the ! number of observables - nparam !------------------------------------------------------------ use usefulbits, only : vsmall use usefulbits_hs, only: HSres use numerics implicit none integer, intent(in) :: nparam double precision, intent(out) :: Pvalue if(allocated(HSres)) then if(HSres(1)%Chisq.gt.vsmall.and.(HSres(1)%nobs-nparam).gt.0) then HSres(1)%Pvalue = 1 - gammp(dble(HSres(1)%nobs-nparam)/2,HSres(1)%Chisq/2) endif else write(*,*) "Warning: subroutine get_Pvalue should be called after run_HiggsSignals." endif Pvalue = HSres(1)%Pvalue end subroutine get_Pvalue !------------------------------------------------------------ subroutine get_neutral_Higgs_masses(Mh, dMh) ! Sets the theoretical mass uncertainty of the Higgs bosons. !------------------------------------------------------------ use usefulbits, only: theo,np,Hneut implicit none double precision,intent(out) :: Mh(np(Hneut)), dMh(np(Hneut)) if(.not.allocated(theo))then stop 'No model information given!' endif if(np(Hneut).eq.0)then write(*,*)'Cannot access the neutral Higgs boson masses' write(*,*)'because np(Hneut) == 0.' stop 'error in subroutine get_neutral_Higgs_masses' endif Mh = theo(1)%particle(Hneut)%M dMh = theo(1)%particle(Hneut)%dM end subroutine get_neutral_Higgs_masses !------------------------------------------------------------ subroutine complete_HS_results() !------------------------------------------------------------ use usefulbits, only : just_after_run, ndat use usefulbits_HS, only : HSres, Nparam use numerics, only : gammp integer :: n if(just_after_run) then do n=1,ndat HSres(n)%Chisq_mu = HSres(n)%Chisq_peak_mu + & !HSres(n)%Chisq_mpred + & & HSres(n)%Chisq_STXS_rates + HSres(n)%Chisq_LHCRun1_mu HSres(n)%Chisq_mh = HSres(n)%Chisq_peak_mh + HSres(n)%Chisq_LHCRun1_mh + & & HSres(n)%Chisq_STXS_mh HSres(n)%Chisq_STXS = HSres(n)%Chisq_STXS_rates + HSres(n)%Chisq_STXS_mh HSres(n)%Chisq_peak = HSres(n)%Chisq_peak_mu + HSres(n)%Chisq_peak_mh HSres(n)%Chisq_LHCRun1 = HSres(n)%Chisq_LHCRun1_mu + HSres(n)%Chisq_LHCRun1_mh HSres(n)%Chisq = HSres(n)%Chisq_mu + HSres(n)%Chisq_mh HSres(n)%nobs_mu = HSres(n)%nobs_peak_mu + &!HSres(n)%nobs_mpred + & & HSres(n)%nobs_LHCRun1_mu + HSres(n)%nobs_STXS_rates HSres(n)%nobs_mh = HSres(n)%nobs_peak_mh + HSres(n)%nobs_LHCRun1_mh + & & HSres(n)%nobs_STXS_mh HSres(n)%nobs_peak = HSres(n)%nobs_peak_mu + HSres(n)%nobs_peak_mh HSres(n)%nobs_STXS = HSres(n)%nobs_STXS_rates + HSres(n)%nobs_STXS_mh HSres(n)%nobs_LHCRun1 = HSres(n)%nobs_LHCRun1_mu + HSres(n)%nobs_LHCRun1_mh HSres(n)%nobs = HSres(n)%nobs_mu + HSres(n)%nobs_mh if(HSres(n)%Chisq.gt.vsmall.and.(HSres(n)%nobs-Nparam).gt.0) then HSres(n)%Pvalue=1 - gammp(dble(HSres(n)%nobs-Nparam)/2.0D0,HSres(n)%Chisq/2.0D0) endif if(HSres(n)%Chisq_peak.gt.vsmall.and.(HSres(n)%nobs_peak-Nparam).gt.0) then HSres(n)%Pvalue_peak=1 - gammp(dble(HSres(n)%nobs_peak-Nparam)/2.0D0,HSres(n)%Chisq_peak/2.0D0) endif if(HSres(n)%Chisq_LHCRun1.gt.vsmall.and.(HSres(n)%nobs_LHCRun1-Nparam).gt.0) then HSres(n)%Pvalue_LHCRun1=1 - gammp(dble(HSres(n)%nobs_LHCRun1-Nparam)/2.0D0,HSres(n)%Chisq_LHCRun1/2.0D0) endif if(HSres(n)%Chisq_STXS.gt.vsmall.and.(HSres(n)%nobs_STXS-Nparam).gt.0) then HSres(n)%Pvalue_STXS=1 - gammp(dble(HSres(n)%nobs_STXS-Nparam)/2.0D0,HSres(n)%Chisq_STXS/2.0D0) endif enddo else write(*,*) "Warning: complete_HS_results was called but just_after_run is", just_after_run endif !------------------------------------------------------------ end subroutine complete_HS_results !------------------------------------------------------------ subroutine finish_HiggsSignals ! This subroutine needs to be called right at the end, to close files ! and deallocate arrays !------------------------------------------------------------ use usefulbits, only : deallocate_usefulbits,debug,theo,debug, &!,inputsub & file_id_debug1,file_id_debug2 use S95tables, only : deallocate_Exptranges use theory_BRfunctions, only : deallocate_BRSM use datatables, only : deallocate_observables use usefulbits_HS, only : deallocate_usefulbits_HS, analyses use mc_chisq, only : deallocate_mc_observables use store_pathname_HS !#if defined(NAGf90Fortran) ! use F90_UNIX_IO, only : flush !#endif if(debug)then close(file_id_debug2) close(file_id_debug1) endif if(debug) write(*,*)'finishing off...' ; call flush(6) if(.not.allocated(theo))then ! stop 'HiggsBounds_initialize should be called first' if(debug) write(*,*) "HiggsBounds/HiggsSignals internal structure already deallocated!" else call deallocate_BRSM call deallocate_Exptranges call deallocate_usefulbits ! if (allocated(inputsub)) deallocate(inputsub) endif ! write(*,*) "before deallocate mc observables." call deallocate_mc_observables ! write(*,*) "after deallocate mc observables." call deallocate_observables if(allocated(analyses)) deallocate(analyses) call deallocate_usefulbits_HS ! call system('rm -f '//trim(adjustl(pathname_HS))//'Expt_tables/analyses.txt') call system('rm -f HS_analyses.txt') if(debug) write(*,*)'finished' ; call flush(6) end subroutine finish_HiggsSignals !------------------------------------------------------------ subroutine finish_HiggsSignals_only !------------------------------------------------------------ use datatables, only : deallocate_observables use usefulbits_HS, only : deallocate_usefulbits_HS, analyses use mc_chisq, only : deallocate_mc_observables use store_pathname_HS call deallocate_mc_observables call deallocate_observables if(allocated(analyses)) deallocate(analyses) call deallocate_usefulbits_HS call system('rm -f HS_analyses.txt') end subroutine finish_HiggsSignals_only !------------------------------------------------------------ ! SOME HANDY WRAPPER SUBROUTINES !------------------------------------------------------------ subroutine initialize_HiggsSignals_for_Fittino(nHiggsneut,nHiggsplus) !------------------------------------------------------------ ! Wrapper subroutine to intitialize HiggsSignals with the experimental ! dataset "latestresults", avoiding to specify this via a string argument. !------------------------------------------------------------ implicit none !--------------------------------------input integer,intent(in) :: nHiggsneut integer,intent(in) :: nHiggsplus ! character(LEN=19) :: Expt_string character(LEN=33) :: Expt_string ! Expt_string = "Moriond2013_Fittino" Expt_string = "latestresults_April2013_inclusive" call initialize_HiggsSignals(nHiggsneut,nHiggsplus,Expt_string) end subroutine initialize_HiggsSignals_for_Fittino !------------------------------------------------------------ subroutine get_number_of_observables_wrapper(ntotal, npeakmu, npeakmh, nmpred, nanalyses) !------------------------------------------------------------ use io, only : get_number_of_observables implicit none integer, intent(out) :: ntotal, npeakmu, npeakmh, nmpred, nanalyses call get_number_of_observables(ntotal, npeakmu, npeakmh, nmpred, nanalyses) end subroutine get_number_of_observables_wrapper !------------------------------------------------------------ subroutine get_ID_of_peakobservable_wrapper(ii, ID) !------------------------------------------------------------ use io, only : get_ID_of_peakobservable implicit none integer, intent(in) :: ii integer, intent(out) :: ID call get_ID_of_peakobservable(ii, ID) end subroutine get_ID_of_peakobservable_wrapper !------------------------------------------------------------ subroutine get_peakinfo_from_HSresults_wrapper(obsID, mupred, domH, nHcomb) !-------------------------------------------------------------------- use io, only : get_peakinfo_from_HSresults implicit none integer, intent(in) :: obsID double precision, intent(out) :: mupred integer, intent(out) :: domH, nHcomb call get_peakinfo_from_HSresults(obsID, mupred, domH, nHcomb) end subroutine get_peakinfo_from_HSresults_wrapper !------------------------------------------------------------ subroutine print_cov_mh_to_file_wrapper(Hindex) !------------------------------------------------------------ use pc_chisq, only : print_cov_mh_to_file implicit none integer, intent(in) :: Hindex call print_cov_mh_to_file(Hindex) end subroutine print_cov_mh_to_file_wrapper !------------------------------------------------------------ subroutine print_cov_mu_to_file_wrapper !------------------------------------------------------------ use pc_chisq, only : print_cov_mu_to_file implicit none call print_cov_mu_to_file end subroutine print_cov_mu_to_file_wrapper !------------------------------------------------------------ subroutine print_corr_mu_to_file_wrapper !------------------------------------------------------------ use pc_chisq, only : print_corr_mu_to_file implicit none call print_corr_mu_to_file end subroutine print_corr_mu_to_file_wrapper !------------------------------------------------------------ Index: trunk/webversion/minipaper.pdf =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Index: docs/HB5_Expt/ATLAS_1807.07915/079152_Atlas_t-Hpb-taunu_36fb-1.txt =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/079152_Atlas_t-Hpb-taunu_36fb-1.txt (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/079152_Atlas_t-Hpb-taunu_36fb-1.txt (revision 570) @@ -0,0 +1,13 @@ +# ATLAS, arXiv:1807.07915, July 2018 +# 079152_Atlas_t-Hpb-taunu_36fb-1.txt +# +# Columns: MHp obs exp (absolute values for BR(t->Hp)*BR(Hp->tau nu)) + + 90.00 0.2485E-02 0.3998E-02 + 100.0 0.2410E-02 0.3326E-02 + 110.0 0.1401E-02 0.2460E-02 + 120.0 0.9357E-03 0.1711E-02 + 130.0 0.1148E-02 0.1265E-02 + 140.0 0.6642E-03 0.7027E-03 + 150.0 0.4214E-03 0.4813E-03 + 160.0 0.3069E-03 0.3765E-03 Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08a_exp_interpol.dat =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08a_exp_interpol.dat (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08a_exp_interpol.dat (revision 570) @@ -0,0 +1,192 @@ + 90.00 6.653910 + 100.00 5.524687 + 110.00 4.209477 + 120.00 2.894266 + 130.00 2.104151 + 140.00 1.193777 + 150.00 0.8157150 + 160.00 0.6309573 + 170.00 0.3516850 + 180.00 0.2868747 + 190.00 0.2735605 + 200.00 0.2602463 + 210.00 0.2277497 + 220.00 0.1952531 + 230.00 0.1627565 + 240.00 0.1466285 + 250.00 0.1305005 + 260.00 0.1143724 + 270.00 0.9824437E-01 + 280.00 0.9105232E-01 + 290.00 0.8386027E-01 + 300.00 0.7666822E-01 + 310.00 0.7228653E-01 + 320.00 0.6790484E-01 + 330.00 0.6352314E-01 + 340.00 0.5914145E-01 + 350.00 0.5475976E-01 + 360.00 0.5258464E-01 + 370.00 0.5040952E-01 + 380.00 0.4823439E-01 + 390.00 0.4605927E-01 + 400.00 0.4388415E-01 + 410.00 0.4179473E-01 + 420.00 0.3970531E-01 + 430.00 0.3761590E-01 + 440.00 0.3552648E-01 + 450.00 0.3343706E-01 + 460.00 0.3134764E-01 + 470.00 0.2925823E-01 + 480.00 0.2716881E-01 + 490.00 0.2507939E-01 + 500.00 0.2298997E-01 + 510.00 0.2229810E-01 + 520.00 0.2160622E-01 + 530.00 0.2091435E-01 + 540.00 0.2022247E-01 + 550.00 0.1953060E-01 + 560.00 0.1883872E-01 + 570.00 0.1814685E-01 + 580.00 0.1745497E-01 + 590.00 0.1676310E-01 + 600.00 0.1607122E-01 + 610.00 0.1537935E-01 + 620.00 0.1468747E-01 + 630.00 0.1399560E-01 + 640.00 0.1330372E-01 + 650.00 0.1261185E-01 + 660.00 0.1191997E-01 + 670.00 0.1122810E-01 + 680.00 0.1053622E-01 + 690.00 0.9844348E-02 + 700.00 0.9152473E-02 + 710.00 0.8926610E-02 + 720.00 0.8700748E-02 + 730.00 0.8474885E-02 + 740.00 0.8249022E-02 + 750.00 0.8023159E-02 + 760.00 0.7797296E-02 + 770.00 0.7571434E-02 + 780.00 0.7345571E-02 + 790.00 0.7119708E-02 + 800.00 0.6893845E-02 + 810.00 0.6787080E-02 + 820.00 0.6680314E-02 + 830.00 0.6573549E-02 + 840.00 0.6466783E-02 + 850.00 0.6360018E-02 + 860.00 0.6253252E-02 + 870.00 0.6146486E-02 + 880.00 0.6039721E-02 + 890.00 0.5932955E-02 + 900.00 0.5826190E-02 + 910.00 0.5735959E-02 + 920.00 0.5645728E-02 + 930.00 0.5555498E-02 + 940.00 0.5465267E-02 + 950.00 0.5375036E-02 + 960.00 0.5284805E-02 + 970.00 0.5194575E-02 + 980.00 0.5104344E-02 + 990.00 0.5014113E-02 + 1000.00 0.4923883E-02 + 1010.00 0.4894534E-02 + 1020.00 0.4865185E-02 + 1030.00 0.4835837E-02 + 1040.00 0.4806488E-02 + 1050.00 0.4777139E-02 + 1060.00 0.4747791E-02 + 1070.00 0.4718442E-02 + 1080.00 0.4689093E-02 + 1090.00 0.4659745E-02 + 1100.00 0.4630396E-02 + 1110.00 0.4601047E-02 + 1120.00 0.4571699E-02 + 1130.00 0.4542350E-02 + 1140.00 0.4513002E-02 + 1150.00 0.4483653E-02 + 1160.00 0.4454304E-02 + 1170.00 0.4424956E-02 + 1180.00 0.4395607E-02 + 1190.00 0.4366258E-02 + 1200.00 0.4336910E-02 + 1210.00 0.4307561E-02 + 1220.00 0.4278212E-02 + 1230.00 0.4248864E-02 + 1240.00 0.4219515E-02 + 1250.00 0.4190166E-02 + 1260.00 0.4160818E-02 + 1270.00 0.4131469E-02 + 1280.00 0.4102120E-02 + 1290.00 0.4072772E-02 + 1300.00 0.4043423E-02 + 1310.00 0.4014074E-02 + 1320.00 0.3984726E-02 + 1330.00 0.3955377E-02 + 1340.00 0.3926029E-02 + 1350.00 0.3896680E-02 + 1360.00 0.3867331E-02 + 1370.00 0.3837983E-02 + 1380.00 0.3808634E-02 + 1390.00 0.3804936E-02 + 1400.00 0.3801237E-02 + 1410.00 0.3797539E-02 + 1420.00 0.3793840E-02 + 1430.00 0.3790142E-02 + 1440.00 0.3786444E-02 + 1450.00 0.3782745E-02 + 1460.00 0.3779047E-02 + 1470.00 0.3775348E-02 + 1480.00 0.3771650E-02 + 1490.00 0.3767952E-02 + 1500.00 0.3764253E-02 + 1510.00 0.3760555E-02 + 1520.00 0.3756856E-02 + 1530.00 0.3753158E-02 + 1540.00 0.3749460E-02 + 1550.00 0.3745761E-02 + 1560.00 0.3742063E-02 + 1570.00 0.3738365E-02 + 1580.00 0.3734666E-02 + 1590.00 0.3730968E-02 + 1600.00 0.3727269E-02 + 1610.00 0.3723571E-02 + 1620.00 0.3719873E-02 + 1630.00 0.3716174E-02 + 1640.00 0.3712476E-02 + 1650.00 0.3708777E-02 + 1660.00 0.3695068E-02 + 1670.00 0.3681359E-02 + 1680.00 0.3667650E-02 + 1690.00 0.3653941E-02 + 1700.00 0.3640232E-02 + 1710.00 0.3626523E-02 + 1720.00 0.3612814E-02 + 1730.00 0.3599105E-02 + 1740.00 0.3585396E-02 + 1750.00 0.3571686E-02 + 1760.00 0.3557977E-02 + 1770.00 0.3544268E-02 + 1780.00 0.3530559E-02 + 1790.00 0.3516850E-02 + 1800.00 0.3525989E-02 + 1810.00 0.3535129E-02 + 1820.00 0.3544268E-02 + 1830.00 0.3553408E-02 + 1840.00 0.3562547E-02 + 1850.00 0.3571686E-02 + 1860.00 0.3580826E-02 + 1870.00 0.3589965E-02 + 1880.00 0.3599105E-02 + 1890.00 0.3608244E-02 + 1900.00 0.3617383E-02 + 1910.00 0.3626523E-02 + 1920.00 0.3635662E-02 + 1930.00 0.3644802E-02 + 1940.00 0.3653941E-02 + 1950.00 0.3663080E-02 + 1960.00 0.3672220E-02 + 1970.00 0.3681359E-02 + 1980.00 0.3690499E-02 + 1990.00 0.3699638E-02 + 2000.00 0.3708777E-02 Index: docs/HB5_Expt/ATLAS_1807.07915/079151_Atlas_tbHp-taunu_36fb-1.txt =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/079151_Atlas_tbHp-taunu_36fb-1.txt (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/079151_Atlas_tbHp-taunu_36fb-1.txt (revision 570) @@ -0,0 +1,197 @@ +# ATLAS, arXiv:1807.07915, July 2018 +# 079151_Atlas_tbHp-taunu_36fb-1.txt +# +# Columns: MHp obs exp (absolute values on sigma13(pp->tb H^\pm)xBR(H^\pm ->tau nu) in pb) + + 90.00 4.161 6.654 + 100.0 4.016 5.525 + 110.0 2.299 4.209 + 120.0 1.585 2.894 + 130.0 1.909 2.104 + 140.0 1.142 1.194 + 150.0 0.7017 0.8157 + 160.0 0.5285 0.6310 + 170.0 0.3219 0.3517 + 180.0 0.2580 0.2869 + 190.0 0.2502 0.2736 + 200.0 0.2424 0.2602 + 210.0 0.2169 0.2277 + 220.0 0.1913 0.1953 + 230.0 0.1657 0.1628 + 240.0 0.1547 0.1466 + 250.0 0.1438 0.1305 + 260.0 0.1329 0.1144 + 270.0 0.1219 0.9824E-01 + 280.0 0.1110 0.9105E-01 + 290.0 0.1001 0.8386E-01 + 300.0 0.8913E-01 0.7667E-01 + 310.0 0.8569E-01 0.7229E-01 + 320.0 0.8225E-01 0.6790E-01 + 330.0 0.7882E-01 0.6352E-01 + 340.0 0.7538E-01 0.5914E-01 + 350.0 0.7194E-01 0.5476E-01 + 360.0 0.6851E-01 0.5258E-01 + 370.0 0.6507E-01 0.5041E-01 + 380.0 0.6163E-01 0.4823E-01 + 390.0 0.5820E-01 0.4606E-01 + 400.0 0.5476E-01 0.4388E-01 + 410.0 0.5141E-01 0.4179E-01 + 420.0 0.4805E-01 0.3971E-01 + 430.0 0.4470E-01 0.3762E-01 + 440.0 0.4135E-01 0.3553E-01 + 450.0 0.3799E-01 0.3344E-01 + 460.0 0.3464E-01 0.3135E-01 + 470.0 0.3129E-01 0.2926E-01 + 480.0 0.2793E-01 0.2717E-01 + 490.0 0.2458E-01 0.2508E-01 + 500.0 0.2123E-01 0.2299E-01 + 510.0 0.2018E-01 0.2230E-01 + 520.0 0.1913E-01 0.2161E-01 + 530.0 0.1808E-01 0.2091E-01 + 540.0 0.1703E-01 0.2022E-01 + 550.0 0.1598E-01 0.1953E-01 + 560.0 0.1493E-01 0.1884E-01 + 570.0 0.1388E-01 0.1815E-01 + 580.0 0.1283E-01 0.1745E-01 + 590.0 0.1178E-01 0.1676E-01 + 600.0 0.1073E-01 0.1607E-01 + 610.0 0.1034E-01 0.1538E-01 + 620.0 0.9954E-02 0.1469E-01 + 630.0 0.9564E-02 0.1400E-01 + 640.0 0.9174E-02 0.1330E-01 + 650.0 0.8784E-02 0.1261E-01 + 660.0 0.8394E-02 0.1192E-01 + 670.0 0.8003E-02 0.1123E-01 + 680.0 0.7613E-02 0.1054E-01 + 690.0 0.7223E-02 0.9844E-02 + 700.0 0.6833E-02 0.9152E-02 + 710.0 0.6633E-02 0.8927E-02 + 720.0 0.6434E-02 0.8701E-02 + 730.0 0.6234E-02 0.8475E-02 + 740.0 0.6035E-02 0.8249E-02 + 750.0 0.5835E-02 0.8023E-02 + 760.0 0.5636E-02 0.7797E-02 + 770.0 0.5436E-02 0.7571E-02 + 780.0 0.5237E-02 0.7346E-02 + 790.0 0.5037E-02 0.7120E-02 + 800.0 0.4837E-02 0.6894E-02 + 810.0 0.4759E-02 0.6787E-02 + 820.0 0.4680E-02 0.6680E-02 + 830.0 0.4602E-02 0.6574E-02 + 840.0 0.4523E-02 0.6467E-02 + 850.0 0.4445E-02 0.6360E-02 + 860.0 0.4366E-02 0.6253E-02 + 870.0 0.4288E-02 0.6146E-02 + 880.0 0.4209E-02 0.6040E-02 + 890.0 0.4131E-02 0.5933E-02 + 900.0 0.4052E-02 0.5826E-02 + 910.0 0.3999E-02 0.5736E-02 + 920.0 0.3945E-02 0.5646E-02 + 930.0 0.3892E-02 0.5555E-02 + 940.0 0.3838E-02 0.5465E-02 + 950.0 0.3785E-02 0.5375E-02 + 960.0 0.3731E-02 0.5285E-02 + 970.0 0.3677E-02 0.5195E-02 + 980.0 0.3624E-02 0.5104E-02 + 990.0 0.3570E-02 0.5014E-02 + 1000. 0.3517E-02 0.4924E-02 + 1010. 0.3495E-02 0.4895E-02 + 1020. 0.3473E-02 0.4865E-02 + 1030. 0.3452E-02 0.4836E-02 + 1040. 0.3430E-02 0.4806E-02 + 1050. 0.3408E-02 0.4777E-02 + 1060. 0.3387E-02 0.4748E-02 + 1070. 0.3365E-02 0.4718E-02 + 1080. 0.3343E-02 0.4689E-02 + 1090. 0.3322E-02 0.4660E-02 + 1100. 0.3300E-02 0.4630E-02 + 1110. 0.3278E-02 0.4601E-02 + 1120. 0.3256E-02 0.4572E-02 + 1130. 0.3235E-02 0.4542E-02 + 1140. 0.3213E-02 0.4513E-02 + 1150. 0.3191E-02 0.4484E-02 + 1160. 0.3170E-02 0.4454E-02 + 1170. 0.3148E-02 0.4425E-02 + 1180. 0.3126E-02 0.4396E-02 + 1190. 0.3105E-02 0.4366E-02 + 1200. 0.3083E-02 0.4337E-02 + 1210. 0.3061E-02 0.4308E-02 + 1220. 0.3040E-02 0.4278E-02 + 1230. 0.3018E-02 0.4249E-02 + 1240. 0.2996E-02 0.4220E-02 + 1250. 0.2974E-02 0.4190E-02 + 1260. 0.2953E-02 0.4161E-02 + 1270. 0.2931E-02 0.4131E-02 + 1280. 0.2909E-02 0.4102E-02 + 1290. 0.2888E-02 0.4073E-02 + 1300. 0.2866E-02 0.4043E-02 + 1310. 0.2844E-02 0.4014E-02 + 1320. 0.2823E-02 0.3985E-02 + 1330. 0.2801E-02 0.3955E-02 + 1340. 0.2779E-02 0.3926E-02 + 1350. 0.2757E-02 0.3897E-02 + 1360. 0.2736E-02 0.3867E-02 + 1370. 0.2714E-02 0.3838E-02 + 1380. 0.2692E-02 0.3809E-02 + 1390. 0.2671E-02 0.3805E-02 + 1400. 0.2649E-02 0.3801E-02 + 1410. 0.2648E-02 0.3798E-02 + 1420. 0.2647E-02 0.3794E-02 + 1430. 0.2645E-02 0.3790E-02 + 1440. 0.2644E-02 0.3786E-02 + 1450. 0.2643E-02 0.3783E-02 + 1460. 0.2642E-02 0.3779E-02 + 1470. 0.2641E-02 0.3775E-02 + 1480. 0.2640E-02 0.3772E-02 + 1490. 0.2638E-02 0.3768E-02 + 1500. 0.2637E-02 0.3764E-02 + 1510. 0.2636E-02 0.3761E-02 + 1520. 0.2635E-02 0.3757E-02 + 1530. 0.2634E-02 0.3753E-02 + 1540. 0.2633E-02 0.3749E-02 + 1550. 0.2631E-02 0.3746E-02 + 1560. 0.2630E-02 0.3742E-02 + 1570. 0.2629E-02 0.3738E-02 + 1580. 0.2628E-02 0.3735E-02 + 1590. 0.2627E-02 0.3731E-02 + 1600. 0.2626E-02 0.3727E-02 + 1610. 0.2616E-02 0.3724E-02 + 1620. 0.2605E-02 0.3720E-02 + 1630. 0.2595E-02 0.3716E-02 + 1640. 0.2585E-02 0.3712E-02 + 1650. 0.2575E-02 0.3709E-02 + 1660. 0.2565E-02 0.3695E-02 + 1670. 0.2555E-02 0.3681E-02 + 1680. 0.2545E-02 0.3668E-02 + 1690. 0.2535E-02 0.3654E-02 + 1700. 0.2525E-02 0.3640E-02 + 1710. 0.2515E-02 0.3627E-02 + 1720. 0.2505E-02 0.3613E-02 + 1730. 0.2495E-02 0.3599E-02 + 1740. 0.2485E-02 0.3585E-02 + 1750. 0.2475E-02 0.3572E-02 + 1760. 0.2465E-02 0.3558E-02 + 1770. 0.2455E-02 0.3544E-02 + 1780. 0.2445E-02 0.3531E-02 + 1790. 0.2435E-02 0.3517E-02 + 1800. 0.2424E-02 0.3526E-02 + 1810. 0.2431E-02 0.3535E-02 + 1820. 0.2438E-02 0.3544E-02 + 1830. 0.2444E-02 0.3553E-02 + 1840. 0.2451E-02 0.3563E-02 + 1850. 0.2458E-02 0.3572E-02 + 1860. 0.2464E-02 0.3581E-02 + 1870. 0.2471E-02 0.3590E-02 + 1880. 0.2477E-02 0.3599E-02 + 1890. 0.2484E-02 0.3608E-02 + 1900. 0.2491E-02 0.3617E-02 + 1910. 0.2497E-02 0.3627E-02 + 1920. 0.2504E-02 0.3636E-02 + 1930. 0.2510E-02 0.3645E-02 + 1940. 0.2517E-02 0.3654E-02 + 1950. 0.2524E-02 0.3663E-02 + 1960. 0.2530E-02 0.3672E-02 + 1970. 0.2537E-02 0.3681E-02 + 1980. 0.2544E-02 0.3690E-02 + 1990. 0.2550E-02 0.3700E-02 + 2000. 0.2557E-02 0.3709E-02 Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08b_exp_interpol.dat =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08b_exp_interpol.dat (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08b_exp_interpol.dat (revision 570) @@ -0,0 +1,8 @@ + 90.00 0.3998134E-02 + 100.00 0.3325874E-02 + 110.00 0.2459655E-02 + 120.00 0.1710771E-02 + 130.00 0.1265203E-02 + 140.00 0.7026832E-03 + 150.00 0.4812988E-03 + 160.00 0.3765414E-03 Index: docs/HB5_Expt/ATLAS_1807.07915/H+taunu_fig_08a.png =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Index: docs/HB5_Expt/ATLAS_1807.07915/H+taunu_fig_08a.png =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/H+taunu_fig_08a.png (revision 569) +++ docs/HB5_Expt/ATLAS_1807.07915/H+taunu_fig_08a.png (revision 570) Property changes on: docs/HB5_Expt/ATLAS_1807.07915/H+taunu_fig_08a.png ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08a_exp.dat =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08a_exp.dat (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08a_exp.dat (revision 570) @@ -0,0 +1,24 @@ +90.29356133643826 6.653910011034483 +99.99999999999994 5.524687179591878 +120.66783474039413 2.8942661247167503 +129.87292932573348 2.104151098066508 +140.06596479390646 1.1937766417144364 +150.1364023535519 0.8157150244438605 +160.27495511768998 0.630957344480193 +170.4007862490584 0.3516850007169746 +180.05986975468733 0.28687473895638604 +200.23218089978474 0.2602463309528382 +230.05975512348246 0.16275654480267535 +269.7839271071449 0.09824437458374244 +300.6213927569929 0.0766682207454621 +348.9482139526669 0.05475976030421941 +400.11136818790743 0.04388415014769084 +499.8608285133065 0.022989973016685428 +701.5660847884967 0.009152473108773892 +799.5173714525092 0.006893845379073929 +900.0487567757607 0.005826189623389707 +1002.9282089279944 0.004923882631706742 +1379.1791553351247 0.003808633918385846 +1654.0613414541917 0.0037087774117744725 +1791.1803696836346 0.0035168500071697446 +1995.92000601069 0.0037087774117744725 Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08b.png =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08b.png =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08b.png (revision 569) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08b.png (revision 570) Property changes on: docs/HB5_Expt/ATLAS_1807.07915/fig_08b.png ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08b_exp.dat =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08b_exp.dat (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08b_exp.dat (revision 570) @@ -0,0 +1,8 @@ +90.04707464694015 0.0039981340208045035 +100.07397444519165 0.003325874201259403 +109.86550100874243 0.00245965471177732 +120.12777404169469 0.0017107713216000008 +129.91930060524544 0.0012652032179550129 +139.94620040349696 7.026831965084446E-4 +149.97310020174848 4.812987761586329E-4 +159.90585070611968 3.7654138688191044E-4 Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08a_obs_interpol.dat =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08a_obs_interpol.dat (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08a_obs_interpol.dat (revision 570) @@ -0,0 +1,192 @@ + 90.00 4.161317 + 100.00 4.016485 + 110.00 2.298997 + 120.00 1.584893 + 130.00 1.908839 + 140.00 1.142069 + 150.00 0.7017038 + 160.00 0.5285389 + 170.00 0.3218788 + 180.00 0.2579517 + 190.00 0.2501990 + 200.00 0.2424462 + 210.00 0.2168525 + 220.00 0.1912587 + 230.00 0.1656650 + 240.00 0.1547307 + 250.00 0.1437965 + 260.00 0.1328622 + 270.00 0.1219279 + 280.00 0.1109936 + 290.00 0.1000594 + 300.00 0.8912509E-01 + 310.00 0.8568856E-01 + 320.00 0.8225203E-01 + 330.00 0.7881549E-01 + 340.00 0.7537896E-01 + 350.00 0.7194243E-01 + 360.00 0.6850589E-01 + 370.00 0.6506936E-01 + 380.00 0.6163283E-01 + 390.00 0.5819629E-01 + 400.00 0.5475976E-01 + 410.00 0.5140665E-01 + 420.00 0.4805355E-01 + 430.00 0.4470044E-01 + 440.00 0.4134733E-01 + 450.00 0.3799422E-01 + 460.00 0.3464111E-01 + 470.00 0.3128801E-01 + 480.00 0.2793490E-01 + 490.00 0.2458179E-01 + 500.00 0.2122868E-01 + 510.00 0.2017923E-01 + 520.00 0.1912979E-01 + 530.00 0.1808034E-01 + 540.00 0.1703089E-01 + 550.00 0.1598144E-01 + 560.00 0.1493199E-01 + 570.00 0.1388254E-01 + 580.00 0.1283309E-01 + 590.00 0.1178364E-01 + 600.00 0.1073419E-01 + 610.00 0.1034408E-01 + 620.00 0.9953964E-02 + 630.00 0.9563851E-02 + 640.00 0.9173738E-02 + 650.00 0.8783626E-02 + 660.00 0.8393513E-02 + 670.00 0.8003400E-02 + 680.00 0.7613288E-02 + 690.00 0.7223175E-02 + 700.00 0.6833062E-02 + 710.00 0.6633500E-02 + 720.00 0.6433937E-02 + 730.00 0.6234375E-02 + 740.00 0.6034812E-02 + 750.00 0.5835250E-02 + 760.00 0.5635688E-02 + 770.00 0.5436125E-02 + 780.00 0.5236563E-02 + 790.00 0.5037000E-02 + 800.00 0.4837438E-02 + 810.00 0.4758915E-02 + 820.00 0.4680393E-02 + 830.00 0.4601870E-02 + 840.00 0.4523348E-02 + 850.00 0.4444826E-02 + 860.00 0.4366303E-02 + 870.00 0.4287781E-02 + 880.00 0.4209258E-02 + 890.00 0.4130736E-02 + 900.00 0.4052213E-02 + 910.00 0.3998677E-02 + 920.00 0.3945141E-02 + 930.00 0.3891604E-02 + 940.00 0.3838068E-02 + 950.00 0.3784532E-02 + 960.00 0.3730995E-02 + 970.00 0.3677459E-02 + 980.00 0.3623923E-02 + 990.00 0.3570386E-02 + 1000.00 0.3516850E-02 + 1010.00 0.3495153E-02 + 1020.00 0.3473456E-02 + 1030.00 0.3451759E-02 + 1040.00 0.3430062E-02 + 1050.00 0.3408365E-02 + 1060.00 0.3386668E-02 + 1070.00 0.3364971E-02 + 1080.00 0.3343274E-02 + 1090.00 0.3321577E-02 + 1100.00 0.3299880E-02 + 1110.00 0.3278183E-02 + 1120.00 0.3256486E-02 + 1130.00 0.3234789E-02 + 1140.00 0.3213092E-02 + 1150.00 0.3191395E-02 + 1160.00 0.3169698E-02 + 1170.00 0.3148001E-02 + 1180.00 0.3126304E-02 + 1190.00 0.3104607E-02 + 1200.00 0.3082910E-02 + 1210.00 0.3061213E-02 + 1220.00 0.3039516E-02 + 1230.00 0.3017819E-02 + 1240.00 0.2996122E-02 + 1250.00 0.2974425E-02 + 1260.00 0.2952728E-02 + 1270.00 0.2931031E-02 + 1280.00 0.2909334E-02 + 1290.00 0.2887636E-02 + 1300.00 0.2865939E-02 + 1310.00 0.2844242E-02 + 1320.00 0.2822545E-02 + 1330.00 0.2800848E-02 + 1340.00 0.2779151E-02 + 1350.00 0.2757454E-02 + 1360.00 0.2735757E-02 + 1370.00 0.2714060E-02 + 1380.00 0.2692363E-02 + 1390.00 0.2670666E-02 + 1400.00 0.2648969E-02 + 1410.00 0.2647801E-02 + 1420.00 0.2646634E-02 + 1430.00 0.2645466E-02 + 1440.00 0.2644298E-02 + 1450.00 0.2643130E-02 + 1460.00 0.2641963E-02 + 1470.00 0.2640795E-02 + 1480.00 0.2639627E-02 + 1490.00 0.2638459E-02 + 1500.00 0.2637291E-02 + 1510.00 0.2636124E-02 + 1520.00 0.2634956E-02 + 1530.00 0.2633788E-02 + 1540.00 0.2632620E-02 + 1550.00 0.2631452E-02 + 1560.00 0.2630285E-02 + 1570.00 0.2629117E-02 + 1580.00 0.2627949E-02 + 1590.00 0.2626781E-02 + 1600.00 0.2625613E-02 + 1610.00 0.2615556E-02 + 1620.00 0.2605498E-02 + 1630.00 0.2595441E-02 + 1640.00 0.2585383E-02 + 1650.00 0.2575326E-02 + 1660.00 0.2565268E-02 + 1670.00 0.2555210E-02 + 1680.00 0.2545153E-02 + 1690.00 0.2535095E-02 + 1700.00 0.2525038E-02 + 1710.00 0.2514980E-02 + 1720.00 0.2504923E-02 + 1730.00 0.2494865E-02 + 1740.00 0.2484807E-02 + 1750.00 0.2474750E-02 + 1760.00 0.2464692E-02 + 1770.00 0.2454635E-02 + 1780.00 0.2444577E-02 + 1790.00 0.2434520E-02 + 1800.00 0.2424462E-02 + 1810.00 0.2431078E-02 + 1820.00 0.2437693E-02 + 1830.00 0.2444309E-02 + 1840.00 0.2450924E-02 + 1850.00 0.2457540E-02 + 1860.00 0.2464156E-02 + 1870.00 0.2470771E-02 + 1880.00 0.2477387E-02 + 1890.00 0.2484002E-02 + 1900.00 0.2490618E-02 + 1910.00 0.2497233E-02 + 1920.00 0.2503849E-02 + 1930.00 0.2510465E-02 + 1940.00 0.2517080E-02 + 1950.00 0.2523696E-02 + 1960.00 0.2530311E-02 + 1970.00 0.2536927E-02 + 1980.00 0.2543543E-02 + 1990.00 0.2550158E-02 + 2000.00 0.2556774E-02 Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08b_obs_interpol.dat =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08b_obs_interpol.dat (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08b_obs_interpol.dat (revision 570) @@ -0,0 +1,8 @@ + 90.00 0.2484940E-02 + 100.00 0.2409853E-02 + 110.00 0.1401451E-02 + 120.00 0.9356827E-03 + 130.00 0.1148058E-02 + 140.00 0.6642475E-03 + 150.00 0.4213781E-03 + 160.00 0.3068864E-03 Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08a_obs.dat =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08a_obs.dat (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08a_obs.dat (revision 570) @@ -0,0 +1,24 @@ +90.10936274267527 4.161316698909232 +100.20441670893729 4.016485041281364 +110.07346156015825 2.298997301668543 +119.93085416464781 1.5848931924611134 +130.40443595109153 1.9088386974548013 +140.06596479390646 1.1420689062920002 +149.83012454396246 0.7017038286703826 +159.9479946909314 0.5285388593079244 +170.05316915722346 0.3218787511821234 +180.05986975468733 0.25795173988625225 +199.82370785251592 0.2424462017082327 +230.53003570349532 0.16566500167797737 +300.6213927569929 0.08912509381337455 +400.11136818790743 0.05475976030421941 +498.841113925393 0.021228684221461944 +599.4873612704939 0.010734188827013522 +700.134892083977 0.006833062366443819 +799.5173714525092 0.004837437696757799 +900.0487567757607 0.004052213393797469 +1000.8822383959265 0.0035168500071697446 +1401.8953636601013 0.002648969287610524 +1604.1635583700022 0.0026256133338848496 +1802.1872548535046 0.0024244620170823256 +1995.92000601069 0.0025567738022175216 Index: docs/HB5_Expt/ATLAS_1807.07915/fig_08b_obs.dat =================================================================== --- docs/HB5_Expt/ATLAS_1807.07915/fig_08b_obs.dat (revision 0) +++ docs/HB5_Expt/ATLAS_1807.07915/fig_08b_obs.dat (revision 570) @@ -0,0 +1,8 @@ +90.04707464694015 0.002484939939775053 +100.0268997982515 0.0024098534988019867 +110.00672494956288 0.0014014506337499037 +119.89240080699395 9.356827312411496E-4 +129.91930060524544 0.0011480575188746512 +139.99327505043712 6.642475086222042E-4 +149.97310020174848 4.2137812465042044E-4 +159.90585070611968 3.0688642991367804E-4