Index: trunk/webversion/minipaper.pdf =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Index: trunk/testsuite/ZH_implementation/test_HS.f90 =================================================================== --- trunk/testsuite/ZH_implementation/test_HS.f90 (revision 591) +++ trunk/testsuite/ZH_implementation/test_HS.f90 (revision 592) @@ -1,91 +1,248 @@ program test_HS use theory_colliderSfunctions use STXS implicit none - double precision :: SMBR_HZZ, SMBR_Htoptop, SMBR_Hbb, SMGamma_h + double precision :: SMBR_HZZ, SMBR_HWW, SMBR_Htoptop, SMBR_Hbb, SMGamma_h,SMBR_Hgg,& + & SMBR_Hcc,SMBR_Hss,SMBR_Htautau,SMBR_Hmumu, SMBR_Hgamgam double precision :: SMGammaTotal, Mh, GammaTotal, BR_hjbb - double precision :: ghjZZ, ghjtt_s, ghjtt_p, ghjbb_s, ghjbb_p + double precision :: ghjZZ, ghjff_s, ghjff_p,ghjtt_s, ghjtt_p,ghjbb_s, ghjbb_p,& + & ghjtautau_s, ghjtautau_p,ghjcc_s, ghjcc_p,ghjss_s, ghjss_p,& + & ghjmumu_s, ghjmumu_p + double precision :: ghjgg,ghjgaga double precision :: Chisq_STXS_rates, Chisq_STXS_mh, Chisq_STXS, Pvalue_STXS - integer :: nobs_STXS, nobs_peak, i,j - double precision :: ZH_rate_ggqq, ZH_rate_incl, ZH_rate_gg, ZH_rate_qq + integer :: nobs_STXS, nobs_peak, nobs_LHCRun1, i,j + double precision :: ZH_rate_ggqq, ZH_rate_incl, ZH_rate_gg, ZH_rate_qq, WH_rate_incl double precision :: Chisq_peak_mu, Chisq_peak_mh, Chisq_peak, Pvalue_peak + double precision :: Chisq_LHCRun1_mu,Chisq_LHCRun1_mh,Chisq_LHCRun1, Pvalue_LHCRun1 + double precision :: R_H_WW, R_H_ZZ, R_H_gaga, R_H_tautau, R_H_bb, R_VH_bb + double precision :: tau_t, tau_b +! call initialize_HiggsSignals(1,0,"LHC13-2.3.0-dev-full") call initialize_HiggsSignals(1,0,"LHC13-2.3.0-dev") + call setup_output_level(0) ! call load_STXS("LHC13") -! do j = 1,3 - do i = 1, 81 +! open(21,file="test_HS-full_allfermions.dat") + open(21,file="test_HS-VHbb_allfermions.dat") +! open(21,file="test_HS-VHbb.dat") + + do j = 1,41 + + ghjZZ = 0.90D0 + (j-1)*0.005D0 + + write(*,*) j + do i = 1,41 + + ghjff_s = 1.0D0 - (i-1)*0.0025D0 + ghjff_p = sqrt(1.0D0 - ghjff_s**2.0D0) + Mh = 125.09D0 - ghjZZ = 0.80D0 + (i-1)*0.005D0 - ghjtt_s = 1.0D0 - ghjtt_p = 0.0D0 - ghjbb_s = 1.0D0 - ghjbb_p = 0.0D0 + +! ghjZZ = 0.60D0 + (j-1)*0.02D0 + ghjtt_s = ghjff_s + ghjtt_p = ghjff_p + ghjbb_s = ghjff_s + ghjbb_p = ghjff_p + ghjtautau_s = ghjff_s + ghjtautau_p = ghjff_p + ghjcc_s = ghjff_s + ghjcc_p = ghjff_p + ghjss_s = ghjff_s + ghjss_p = ghjff_p + ghjmumu_s = ghjff_s + ghjmumu_p = ghjff_p + +! ghjbb_s = 1.0D0 +! ghjbb_p = 0.0D0 ! ghjZZ = 0.80D0 + (j-1)*0.2D0 -! ghjtt_s = 1.0D0 - (i-1)*0.1D0 -! ghjtt_p = sqrt(1.0D0 - ghjtt_s**2.0D0) -! ghjbb_s = 1.0D0 - (i-1)*0.1D0 -! ghjbb_p = sqrt(1.0D0 - ghjbb_s**2.0D0) +! ghjtt_s = 1.0D0 - (i-1)*0.04D0 + +! write(*,*) ghjtt_s, Hgg(ghjtt_s,ghjtt_p,ghjbb_s,ghjbb_p,Mh), & +! & Hgaga(ghjtt_s,ghjtt_p,ghjbb_s,ghjbb_p,ghjbb_s,ghjbb_p,ghjZZ,Mh) + + tau_t = Mh**2.0D0 / (4.0D0 * 172.3D0 **2.0D0) + tau_b = Mh**2.0D0 / (4.0D0 * 4.2D0 **2.0D0) + + ghjgg = Hgg(ghjtt_s,ghjtt_p,ghjbb_s,ghjbb_p,Mh) + ghjgaga = Hgaga(ghjtt_s,ghjtt_p,ghjbb_s,ghjbb_p,ghjtautau_s,ghjtautau_p,ghjZZ,Mh) + +! write(*,*) "Hgg (CP even part) = ", abs(ghjtt_s * Hhalf(tau_t) + ghjbb_s * Hhalf(tau_b) )**2.0D0 & +! & / abs( Hhalf(tau_t) + Hhalf(tau_b))**2.0D0 +! write(*,*) "Hgg (CP odd part) = ", abs(ghjtt_p * Ahalf(tau_t) + ghjbb_p * Ahalf(tau_b) )**2.0D0 & +! & / abs( Hhalf(tau_t) + Hhalf(tau_b))**2.0D0 SMGammaTotal = SMGamma_h(Mh) - GammaTotal = SMGammaTotal * (1 + (ghjZZ**2.0 - 1)*SMBR_HZZ(Mh) + & + GammaTotal = SMGammaTotal * (1 + & + & (ghjZZ**2.0 - 1)*SMBR_HZZ(Mh) + & + & (ghjZZ**2.0 - 1)*SMBR_HWW(Mh) + & + & (ghjgaga**2.0 - 1)*SMBR_Hgamgam(Mh) + & + & (ghjgg**2.0 - 1)*SMBR_Hgg(Mh) + & & (ghjtt_s**2.0 + ghjtt_p**2.0 - 1)*SMBR_Htoptop(Mh) + & + & (ghjcc_s**2.0 + ghjcc_p**2.0 - 1)*SMBR_Hcc(Mh) + & + & (ghjss_s**2.0 + ghjss_p**2.0 - 1)*SMBR_Hss(Mh) + & + & (ghjtautau_s**2.0 + ghjtautau_p**2.0 - 1)*SMBR_Htautau(Mh) + & + & (ghjmumu_s**2.0 + ghjmumu_p**2.0 - 1)*SMBR_Hmumu(Mh) + & & (ghjbb_s**2.0 + ghjbb_p**2.0 - 1)*SMBR_Hbb(Mh) ) - BR_hjbb = SMBR_Hbb(125.0D0) +! BR_hjbb = SMBR_Hbb(125.0D0) +! write(*,*) "total widths = ", SMGammaTotal, GammaTotal call HiggsBounds_neutral_input_properties(Mh,GammaTotal) - -! call HiggsBounds_neutral_input_effC( & -! & 1.0D0,0.0D0,1.0D0,0.0D0, & -! & ghjbb_s,ghjbb_p,ghjtt_s,ghjtt_p, & -! & 1.0D0,0.0D0, & -! & 1.0D0,0.0D0, & -! & 1.0D0,ghjZZ,1.0D0, & -! & 1.0D0,1.0D0, 0.0D0) + + call HiggsBounds_neutral_input_effC( & + & ghjss_s,ghjss_p,ghjcc_s,ghjcc_p, & + & ghjbb_s,ghjbb_p,ghjtt_s,ghjtt_p, & + & ghjmumu_s,ghjmumu_p, & + & ghjtautau_s,ghjtautau_p, & + & ghjZZ,ghjZZ,ghjZZ, & + & ghjgaga,ghjgg,0.0D0)!, & -call HiggsBounds_neutral_input_SMBR(0.0D0,0.0D0,BR_hjbb, & - & 0.0D0,0.0D0, & - & 0.0D0,0.0D0, & - & 0.0D0,0.0D0,0.0D0, & - & 0.0D0) - -call HiggsBounds_neutral_input_hadr_single(13,"XS_hjZ_ratio",ghjZZ) -call HiggsBounds_neutral_input_hadr_single(13,"XS_qq_hjZ_ratio",ghjZZ) -call HiggsBounds_neutral_input_hadr_single(13,"XS_gg_hjZ_ratio",ghjZZ) -call HiggsBounds_neutral_input_hadr_single(13,"XS_hjW_ratio",ghjZZ) +! call HiggsBounds_neutral_input_SMBR(0.0D0,0.0D0,BR_hjbb, & +! & 0.0D0,0.0D0, & +! & 0.0D0,0.0D0, & +! & 0.0D0,0.0D0,0.0D0, & +! & 0.0D0) + +! call HiggsBounds_neutral_input_hadr_single(13,"XS_hjZ_ratio",ghjZZ) +! call HiggsBounds_neutral_input_hadr_single(13,"XS_qq_hjZ_ratio",ghjZZ) +! call HiggsBounds_neutral_input_hadr_single(13,"XS_gg_hjZ_ratio",ghjZZ) +! call HiggsBounds_neutral_input_hadr_single(13,"XS_hjW_ratio",ghjZZ) +! + call run_HiggsSignals_STXS(Chisq_STXS_rates, Chisq_STXS_mh, Chisq_STXS, nobs_STXS, Pvalue_STXS) -! call run_HiggsSignals_STXS(Chisq_STXS_rates, Chisq_STXS_mh, Chisq_STXS, nobs_STXS, Pvalue_STXS) + call run_HiggsSignals_LHC_Run1_combination(Chisq_LHCRun1_mu,Chisq_LHCRun1_mh,& + & Chisq_LHCRun1, nobs_LHCRun1, Pvalue_LHCRun1) call run_HiggsSignals( 1, Chisq_peak_mu, Chisq_peak_mh, Chisq_peak, nobs_peak, Pvalue_peak) + call get_Rvalues(1,4,R_H_WW, R_H_ZZ, R_H_gaga, R_H_tautau, R_H_bb, R_VH_bb) + +! write(*,*) R_H_WW, R_H_ZZ, R_H_gaga, R_H_tautau, R_H_bb, R_VH_bb + ! write(*,*) Chisq_STXS_rates, Chisq_STXS_mh, Chisq_STXS, nobs_STXS, Pvalue_STXS - call get_rates_str(1,4,2,(/"10.0","11.0"/),ZH_rate_ggqq) +! call get_rates_str(1,4,2,(/"10.0","11.0"/),ZH_rate_ggqq) +! +! call get_rates_str(1,4,1,(/"4.0"/),ZH_rate_incl) +! +! call get_rates_str(1,4,1,(/"11.0"/),ZH_rate_gg) +! +! call get_rates_str(1,4,1,(/"10.0"/),ZH_rate_qq) + + call get_rates_str(1,4,2,(/"10.5","11.5"/),ZH_rate_ggqq) + + call get_rates(1,4,1,(/45/),ZH_rate_incl) +! write(*,*) " ZH_rate_incl = ", ZH_rate_incl + + call get_rates_str(1,4,1,(/"3.5"/),WH_rate_incl) - call get_rates_str(1,4,1,(/"4.0"/),ZH_rate_incl) + call get_rates_str(1,4,1,(/"4.5"/),ZH_rate_incl) - call get_rates_str(1,4,1,(/"11.0"/),ZH_rate_gg) + call get_rates_str(1,4,1,(/"11.5"/),ZH_rate_gg) - call get_rates_str(1,4,1,(/"10.0"/),ZH_rate_qq) + call get_rates_str(1,4,1,(/"10.5"/),ZH_rate_qq) + ! write(*,*) ghjZZ, ghjtt_s, ghjtt_p, ghjbb_s, ghjbb_p, ZH_rate_ggqq, ZH_rate_incl, ZH_rate_gg, ZH_rate_qq, Chisq_STXS_rates - write(*,*) ghjZZ, ghjtt_s, ghjtt_p, ghjbb_s, ghjbb_p, ZH_rate_ggqq, ZH_rate_incl, ZH_rate_gg, ZH_rate_qq, Chisq_peak_mu + write(21,*) ghjZZ, ghjtt_s, ghjtt_p, ghjbb_s, ghjbb_p, ZH_rate_ggqq,& + & ZH_rate_incl, ZH_rate_gg, ZH_rate_qq, Chisq_peak_mu, Chisq_LHCRun1_mu,& + & Chisq_STXS_rates, GammaTotal, ghjgg, ghjgaga, WH_rate_incl enddo -! enddo - + enddo + + close(21) call finish_HiggsSignals + contains + + function Hgaga(kt,ktodd,kb,kbodd,ktau,ktauodd,kW,m) + + double precision, intent(in) :: kt, ktodd, kb, ktau,ktauodd,kW, kbodd, m + double precision :: Hgaga + double precision :: tau_t, tau_b, tau_tau, tau_W + + tau_t = m**2.0D0 / (4.0D0 * 172.3D0 **2.0D0) + tau_b = m**2.0D0 / (4.0D0 * 4.2D0 **2.0D0) + tau_tau = m**2.0D0 / (4.0D0 * 1.77D0 **2.0D0) + tau_W = m**2.0D0 / (4.0D0 * 80.385D0 **2.0D0) + + + Hgaga = abs(4.D0/3.D0 * kt * Hhalf(tau_t) + 1.D0/3.D0 * kb * Hhalf(tau_b) + ktau * Hhalf(tau_tau) & + & - kW * Hone(tau_W))**2.0D0 / abs(4.D0/3.D0 * Hhalf(tau_t) + 1.D0/3.D0 * Hhalf(tau_b) + & + & Hhalf(tau_tau) - Hone(tau_W))**2.0D0 + & + & abs(4.D0/3.D0 * ktodd * Ahalf(tau_t) + 1.D0/3.D0 * kbodd * Ahalf(tau_b) + & + & ktauodd * Ahalf(tau_tau) )**2.0D0 / abs(4.D0/3.D0 * Hhalf(tau_t) + 1.D0/3.D0 * Hhalf(tau_b) +& + & Hhalf(tau_tau) - Hone(tau_W))**2.0D0 + + end function Hgaga + + function Hgg(kt,ktodd,kb,kbodd,m) + + double precision, intent(in) :: kt, ktodd, kb, kbodd, m + double precision :: Hgg + double precision :: tau_t, tau_b + + tau_t = m**2.0D0 / (4.0D0 * 172.3D0 **2.0D0) + tau_b = m**2.0D0 / (4.0D0 * 4.2D0 **2.0D0) + + + Hgg = abs(kt * Hhalf(tau_t) + kb * Hhalf(tau_b) )**2.0D0 / abs( Hhalf(tau_t) + Hhalf(tau_b))**2.0D0 + & + & abs(ktodd * Ahalf(tau_t) + kbodd * Ahalf(tau_b) )**2.0D0 / abs( Hhalf(tau_t) + Hhalf(tau_b))**2.0D0 + + end function Hgg + + function Hhalf(tau) + double precision, intent(in) :: tau + complex :: Hhalf + + Hhalf = ((tau - 1) * f(tau) + tau) / tau**2.0D0 + + end function Hhalf + + function Hone(tau) + double precision, intent(in) :: tau + complex :: Hone + + Hone = (3.0D0 * ( 2.0D0 * tau - 1.0D0) * f(tau) + 3.0D0 * tau + 2.0D0 * tau**2.0D0 ) / ( 2.0D0 * tau**2.0D0 ) + + end function Hone + + function Ahalf(tau) + double precision, intent(in) :: tau + complex :: Ahalf + + Ahalf = f(tau) / tau + + end function Ahalf + + + function f(tau) + double precision, intent(in) :: tau + complex :: f + double precision :: pi + complex :: z + + pi = 4.0D0 * atan(1.0d0) + + if(tau.le.1) then + f = asin(sqrt(tau))**2.0D0 + else + z = complex( log( (1+sqrt(1.0D0-1.0D0/tau))/(1-sqrt(1.0D0-1.0D0/tau)) ) , - pi ) + f = -1.0D0/4.0D0 * z**2.0D0 + endif + + end function f + end program test_HS \ No newline at end of file Index: trunk/HiggsBounds-5/theo_manip.f90 =================================================================== --- trunk/HiggsBounds-5/theo_manip.f90 (revision 591) +++ trunk/HiggsBounds-5/theo_manip.f90 (revision 592) @@ -1,1861 +1,1872 @@ ! 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 theo(jj)%tev%XS_hjW_ratio(i) = WH_nnlo(Mhi,'TEV ',effC(jj)%hjWW(i), & & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),.True.,.True.) / & - & WH_nnlo_SM(Mhi,'TEV ',.True.,.True.) +! & WH_nnlo_SM(Mhi,'TEV ',.True.,.True.) + & WH_nnlo(Mhi,'TEV ',1.0D0,1.0D0,1.0D0,.True.,.True.) theo(jj)%tev%XS_hjZ_ratio(i) = ZH_cpmix_nnlo_ggqqbb(Mhi,'TEV ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & ZH_cpmix_nnlo_ggqqbb(Mhi,'TEV ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(jj)%tev%XS_gg_hjZ_ratio(i) = ZH_cpmix_nnlo_gg(Mhi,'TEV ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & ZH_cpmix_nnlo_gg(Mhi,'TEV ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(jj)%tev%XS_qq_hjZ_ratio(i) = ZH_cpmix_nnlo_qqbb(Mhi,'TEV ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & & ZH_cpmix_nnlo_qqbb(Mhi,'TEV ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) else theo(jj)%tev%XS_hjW_ratio(i) = 0.0D0 theo(jj)%tev%XS_hjZ_ratio(i) = 0.0D0 theo(jj)%tev%XS_gg_hjZ_ratio(i) = 0.0D0 theo(jj)%tev%XS_qq_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 theo(jj)%lhc7%XS_hjW_ratio(i) = WH_nnlo(Mhi,'LHC7 ',effC(jj)%hjWW(i), & & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),.True.,.True.) / & - & WH_nnlo_SM(Mhi,'LHC7 ',.True.,.True.) - +! & WH_nnlo_SM(Mhi,'LHC7 ',.True.,.True.) + & WH_nnlo(Mhi,'LHC7 ',1.0D0,1.0D0,1.0D0,.True.,.True.) + theo(jj)%lhc7%XS_hjZ_ratio(i) = ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC7 ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(jj)%lhc7%XS_gg_hjZ_ratio(i) = ZH_cpmix_nnlo_gg(Mhi,'LHC7 ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & ZH_cpmix_nnlo_gg(Mhi,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(jj)%lhc7%XS_qq_hjZ_ratio(i) = ZH_cpmix_nnlo_qqbb(Mhi,'LHC7 ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & & ZH_cpmix_nnlo_qqbb(Mhi,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) else theo(jj)%lhc7%XS_hjW_ratio(i) = 0.0D0 theo(jj)%lhc7%XS_hjZ_ratio(i) = 0.0D0 theo(jj)%lhc7%XS_gg_hjZ_ratio(i) = 0.0D0 theo(jj)%lhc7%XS_qq_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 theo(jj)%lhc8%XS_hjW_ratio(i) = WH_nnlo(Mhi,'LHC8 ',effC(jj)%hjWW(i), & & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),.True.,.True.) / & - & WH_nnlo_SM(Mhi,'LHC8 ',.True.,.True.) - +! & WH_nnlo_SM(Mhi,'LHC8 ',.True.,.True.) + & WH_nnlo(Mhi,'LHC8 ',1.0D0,1.0D0,1.0D0,.True.,.True.) + theo(jj)%lhc8%XS_hjZ_ratio(i) = ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC8 ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(jj)%lhc8%XS_gg_hjZ_ratio(i) = ZH_cpmix_nnlo_gg(Mhi,'LHC8 ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & ZH_cpmix_nnlo_gg(Mhi,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(jj)%lhc8%XS_qq_hjZ_ratio(i) = ZH_cpmix_nnlo_qqbb(Mhi,'LHC8 ',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & & ZH_cpmix_nnlo_qqbb(Mhi,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) else theo(jj)%lhc8%XS_hjW_ratio(i) = 0.0D0 theo(jj)%lhc8%XS_hjZ_ratio(i) = 0.0D0 theo(jj)%lhc8%XS_gg_hjZ_ratio(i) = 0.0D0 theo(jj)%lhc8%XS_qq_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 theo(jj)%lhc13%XS_hjW_ratio(i) = WH_nnlo(Mhi,'LHC13',effC(jj)%hjWW(i), & & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),.True.,.True.) / & - & WH_nnlo_SM(Mhi,'LHC13',.True.,.True.) +! & WH_nnlo_SM(Mhi,'LHC13',.True.,.True.) + & WH_nnlo(Mhi,'LHC13',1.0D0,1.0D0,1.0D0,.True.,.True.) + +! DEBUGGING: +! write(*,*) "theo(jj)%lhc13%XS_hjW_ratio(i) = ",theo(jj)%lhc13%XS_hjW_ratio(i) +! write(*,*) WH_nnlo(Mhi,'LHC13',effC(jj)%hjWW(i), & +! & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),.True.,.True.) +! write(*,*) WH_nnlo(Mhi,'LHC13',1.0D0,1.0D0,1.0D0,.True.,.True.) +! write(*,*) WH_nnlo_SM(Mhi,'LHC13',.True.,.True.) theo(jj)%lhc13%XS_hjZ_ratio(i) = ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC13',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(jj)%lhc13%XS_gg_hjZ_ratio(i) = ZH_cpmix_nnlo_gg(Mhi,'LHC13',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & ZH_cpmix_nnlo_gg(Mhi,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(jj)%lhc13%XS_qq_hjZ_ratio(i) = ZH_cpmix_nnlo_qqbb(Mhi,'LHC13',effC(jj)%hjZZ(i),& & effC(jj)%hjtt_s(i),effC(jj)%hjbb_s(i),effC(jj)%hjtt_p(i),effC(jj)%hjbb_p(i),.True.) / & & ZH_cpmix_nnlo_qqbb(Mhi,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) else theo(jj)%lhc13%XS_hjW_ratio(i) = 0.0D0 theo(jj)%lhc13%XS_hjZ_ratio(i) = 0.0D0 theo(jj)%lhc13%XS_gg_hjZ_ratio(i) = 0.0D0 theo(jj)%lhc13%XS_qq_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 ! n.b.: in fb ! 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_HZ_SM(i) = 1000.0D0 * ZH_cpmix_nnlo_ggqqbb(Mhi,'TEV ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(n)%tev%XS_gg_HZ_SM(i) = 1000.0D0 * ZH_cpmix_nnlo_gg(Mhi,'TEV ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(n)%tev%XS_qq_HZ_SM(i) = theo(n)%tev%XS_HZ_SM(i) - theo(n)%tev%XS_gg_HZ_SM(i) theo(n)%tev%XS_HW_SM(i) = 1000.0D0 * WH_nnlo(Mhi,'TEV ',1.0D0,1.0D0,1.0D0,.True.,.True.) 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_gg_HZ_SM(i) = 0.0D0 theo(n)%tev%XS_qq_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_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) = ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(n)%lhc7%XS_gg_HZ_SM(i) = ZH_cpmix_nnlo_gg(Mhi,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(n)%lhc7%XS_qq_HZ_SM(i) = theo(n)%lhc7%XS_HZ_SM(i) - theo(n)%lhc7%XS_gg_HZ_SM(i) theo(n)%lhc7%XS_HW_SM(i) = WH_nnlo(Mhi,'LHC7 ',1.0D0,1.0D0,1.0D0,.True.,.True.) ! theo(n)%lhc7%XS_HW_SM(i) = XS_lhc7_HW_SM(Mhi) ! 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_gg_HZ_SM(i) = 0.0D0 theo(n)%lhc7%XS_qq_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) = ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(n)%lhc8%XS_gg_HZ_SM(i) = ZH_cpmix_nnlo_gg(Mhi,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(n)%lhc8%XS_qq_HZ_SM(i) = theo(n)%lhc8%XS_HZ_SM(i) - theo(n)%lhc8%XS_gg_HZ_SM(i) theo(n)%lhc8%XS_HW_SM(i) = WH_nnlo(Mhi,'LHC8 ',1.0D0,1.0D0,1.0D0,.True.,.True.) ! 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_gg_HZ_SM(i) = 0.0D0 theo(n)%lhc8%XS_qq_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) = ZH_cpmix_nnlo_ggqqbb(Mhi,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(n)%lhc13%XS_gg_HZ_SM(i) = ZH_cpmix_nnlo_gg(Mhi,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) theo(n)%lhc13%XS_qq_HZ_SM(i) = theo(n)%lhc13%XS_HZ_SM(i) - theo(n)%lhc13%XS_gg_HZ_SM(i) theo(n)%lhc13%XS_HW_SM(i) = WH_nnlo(Mhi,'LHC13',1.0D0,1.0D0,1.0D0,.True.,.True.) ! 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_gg_HZ_SM(i) = 0.0D0 theo(n)%lhc13%XS_qq_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 591) +++ trunk/HiggsBounds-5/usefulbits.f90 (revision 592) @@ -1,1466 +1,1466 @@ ! 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' + character(LEN=9),parameter :: vers='5.3.0test' 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 = 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(*,*)"~ Tobias Klingl, 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_gg_HZ_SM( np_t(Hneut) )) allocate(d(x)%tev%XS_qq_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_gg_HZ_SM) deallocate(theo(x)%tev%XS_qq_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/HiggsBounds-5/AllAnalyses =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Index: trunk/HiggsBounds-5/minipaper.pdf =================================================================== Cannot display: file marked as a binary type. svn:mime-type = application/octet-stream Index: trunk/HiggsBounds-5/HiggsBounds_subroutines.F90 =================================================================== --- trunk/HiggsBounds-5/HiggsBounds_subroutines.F90 (revision 591) +++ trunk/HiggsBounds-5/HiggsBounds_subroutines.F90 (revision 592) @@ -1,2858 +1,2860 @@ ! This file is part of HiggsBounds ! -KW !************************************************************ subroutine initialize_HiggsBounds(nHiggsneut,nHiggsplus,whichanalyses_in) ! This the first Higgsbounds subroutine that should be called ! by the user. ! It calls subroutines to read in the tables of Standard Model data, ! read in the tables of LEP, Tevatron and LHC data, ! set up lists of processes which should be checked against ! the experimental results, allocate arrays etc ! Arguments (input): ! * nHiggs= number of neutral Higgs in the model ! (see subroutine check_nH_nHplus in input.f90 for more details) ! * nHiggsplus= number of singly,positively charged Higgs in the model ! (see subroutine check_nH_nHplus in input.f90 for more details) ! * whichanalyses_in= which combination of experimental results to use ! (see subroutine check_whichanalyses in input.f90 for more details) !************************************************************ use usefulbits, only : np,Hneut,Hplus,Chineut,Chiplus,debug,inputmethod, & & theo,whichanalyses,HiggsBounds_info,just_after_run,BRdirectinput,& & file_id_debug1,file_id_debug2,allocate_if_stats_required,run_HB_classic! ,inputsub use input, only : setup_input,check_number_of_particles,check_whichanalyses use S95tables, only : setup_S95tables,S95_t2 use likelihoods, only : setup_likelihoods use theory_BRfunctions, only : setup_BRSM use theory_XS_SM_functions, only : setup_XSSM use channels, only : setup_channels use output, only : setup_output #ifdef enableCHISQ use S95tables_type3, only : clsb_t3,fillt3needs_M2_gt_2M1 #endif #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif !#define FORFITTINO implicit none !--------------------------------------input integer,intent(in) :: nHiggsneut ! integer,intent(in),optional :: nHiggsplus ! character(LEN=5),intent(in),optional :: whichanalyses_in integer,intent(in) :: nHiggsplus character(LEN=5),intent(in) :: whichanalyses_in !-----------------------------------internal integer :: i logical :: messages !------------------------------------------- ! if((.not.present(nHiggsplus)).or.(.not.present(whichanalyses_in)))then !Actually, this doesn't work as I wanted it to !because if initialize_HiggsBounds is called in the old way, the program !usually just crashes..... but leaving it in for now, in case !some compilers accept it ! call attempting_to_use_an_old_HB_version('init') ! endif #ifdef FORFITTINO write(*,*)'The arguments passed to initialize_HiggsBounds are:' write(*,*)'nHiggsneut=',nHiggsneut write(*,*)'nHiggsplus=',nHiggsplus write(*,*)'whichanalyses_in=','~'//trim(adjustl(whichanalyses_in))//'~' #endif #ifdef DEBUGGING debug=.True. #else debug=.False. #endif messages=debug.or.(inputmethod=='datfile') ! inputmethod='subrout' !('datfile' or 'website' are also possible, but not here) np(Hneut)=nHiggsneut np(Hplus)=nHiggsplus np(Chineut)=0! do not change this without contacting us first! np(Chiplus)=0! do not change this without contacting us first! whichanalyses=whichanalyses_in if(inputmethod=='subrout') then if(allocated(theo))then stop 'subroutine HiggsBounds_initialize has already been called once' endif if(messages)write(*,*)'doing other preliminary tasks...' ; call flush(6) call setup_input ! allocate(inputsub( 4 )) !(1)np(Hneut)>0 (2)np(Hplus)>0 (3)np(Chineut)>0 (4)np(Chineut)>0 and np(Chiplus)>0 ! | np ! |Hneu Hcha Chineut Chiplus ! | ==0 ==0 ==0 ==0 ! inputsub(1)%desc='HiggsBounds_neutral_input_*' ! inputsub(1)%req=req( 0, 1, 1, 1) ! inputsub(2)%desc='HiggsBounds_charged_input' ! inputsub(2)%req=req( 1, 0, 1, 1) ! inputsub(3)%desc='SUSYBounds_neutralinoonly_input' ! inputsub(3)%req=req( 1, 1, 0, 1) ! inputsub(4)%desc='SUSYBounds_neutralinochargino_input' ! inputsub(4)%req=req( 1, 1, 0, 0) ! do i=1,ubound(inputsub,dim=1) ! inputsub(i)%stat=0 ! enddo endif #ifndef WEBVERSION if(inputmethod.ne.'datfile') call HiggsBounds_info if (run_HB_classic.EQV..True.) then PRINT *, "run_HB_classic=True - HiggsBounds is running in classic mode" endif #endif if(messages)write(*,*)'reading in Standard Model tables...' ; call flush(6) call setup_BRSM call setup_XSSM if(messages)write(*,*)'reading in S95tables...' ; call flush(6) call setup_S95tables if(messages)write(*,*)'reading in likelihoods...' ; call flush(6) call setup_likelihoods if(messages)then open(file_id_debug2,file='debug_predratio.txt') open(file_id_debug1,file='debug_channels.txt') endif if(messages)write(*,*)'sorting out processes to be checked...'; call flush(6) call setup_channels if(messages)write(*,*)'preparing output arrays...' ; call flush(6) call setup_output #ifdef enableCHISQ if(allocated(allocate_if_stats_required))then call fillt3needs_M2_gt_2M1(clsb_t3,S95_t2) endif #endif just_after_run=.False. BRdirectinput=.False. ! contains ! ! | np ! ! |Hneu Hcha Chineut Chiplus ! ! | ==0 ==0 ==0 ==0 ! function req(Hneu,Hcha, Chneu, Chcha) ! integer, intent(in) ::Hneu,Hcha, Chneu, Chcha ! integer :: req ! ! req=1 ! if(np(Hneut)==0) req= Hneu * req ! if(np(Hplus)==0) req= Hcha * req ! if(np(Chineut)==0)req= Chneu * req ! if(np(Chiplus)==0)req= Chcha * req ! ! end function req end subroutine initialize_HiggsBounds !************************************************************ !************************************************************ ! Version of initialize_HiggsBounds which takes an integer as ! the third argument. More useful for library linking to ! non-Fortran codes. subroutine initialize_HiggsBounds_int(nHn,nHp,flag) implicit none integer nHn,nHp,flag interface subroutine initialize_HiggsBounds(nHiggsneut, nHiggsplus, whichanalyses_in) integer,intent(in) :: nHiggsneut integer,intent(in) :: nHiggsplus character(LEN=5),intent(in) :: whichanalyses_in ! integer,intent(in),optional :: nHiggsplus ! character(LEN=5),intent(in),optional :: whichanalyses_in end subroutine initialize_HiggsBounds end interface IF (flag.EQ.1) then call initialize_HiggsBounds(nHn,nHp, "onlyL") elseif (flag.EQ.2) then call initialize_HiggsBounds(nHn,nHp, "onlyH") elseif (flag.EQ.3) then call initialize_HiggsBounds(nHn,nHp, "LandH") elseif (flag.EQ.4) then call initialize_HiggsBounds(nHn,nHp, "onlyP") else stop "Illegal value for flag in call to initialize_HB" endif end subroutine !************************************************************ !************************************************************ subroutine attempting_to_use_an_old_HB_version(subroutineid) use usefulbits, only : vers character(len=4),intent(in) :: subroutineid select case(subroutineid) case('init') write(*,*)'The subroutine initialize_HiggsBounds has been called with the' write(*,*)'wrong number of arguments. It should be called as:' write(*,*)'initialize_HiggsBounds(nHiggsneut,nHiggsplus,whichanalyses)' write(*,*) write(*,*)'Note that in early versions of HiggsBounds (HB 1.*.*)' write(*,*)'this subroutine was called as:' write(*,*)'initialize_HiggsBounds(nHiggsneut,whichanalyses)' write(*,*) case('effC','part','hadr') write(*,*)'The subroutine run_HiggsBounds_'//subroutineid//' has been discontinued in this' write(*,*)'version of HiggsBounds.' case default stop 'wrong input to subroutine attempting_to_use_an_old_HB_version' end select write(*,*)'If you have code written for use with HB 1.*.*, you have two choices:' write(*,*) write(*,*)' (1) You can edit your code, such that it works with this' write(*,*)' version of HiggsBounds (HB'//trim(adjustl(vers))//').' write(*,*)' This has the advantage that you can test your model against many, many' write(*,*)' more Higgs search limits , including charged Higgs search limits.' write(*,*)' See the updated manual for more information.' write(*,*) write(*,*)' (2) You can download the most recent HB 1.*.* from the HiggsBounds' write(*,*)' website. This contains the LEP Higgs search limits which are' write(*,*)' generally the most useful when constraining new physics models.' write(*,*)' We will continue to support this code.' stop 'Incorrect call to a HiggsBounds subroutine.' end subroutine attempting_to_use_an_old_HB_version !************************************************************ subroutine HiggsBounds_input_SLHA(infile) ! This subroutine can be called by the user after subroutine initialize_HiggsBounds ! has been called. ! Arguments (input): SLHA filename !************************************************************ use usefulbits, only : whichinput,infile1,theo,g2,effC,just_after_run, & & np,Hneut,Hplus! ,inputsub use extra_bits_for_SLHA #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input character(len=300),intent(in) :: infile !--------------------------------------internal integer :: n !---------------------------------------------- whichinput='SLHA' ! if(np(Hneut).gt.0)inputsub(Hneut)%stat=inputsub(Hneut)%stat+1 ! if(np(Hplus).gt.0)inputsub(Hplus)%stat=inputsub(Hplus)%stat+1 ! note: can't be used for charginos or neutralinos yet n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif infile1=infile call getSLHAdata(theo(n),effC(n),infile1) just_after_run=.False. end subroutine HiggsBounds_input_SLHA !************************************************************ ! ! HB5 GENERAL INPUT ROUTINES ! !************************************************************ subroutine HiggsBounds_neutral_input_properties(Mh,GammaTotal_hj,CP_value) !************************************************************ use usefulbits, only : theo,np,Hneut,just_after_run!,inputsub #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input double precision,intent(in) :: Mh(np(Hneut)),GammaTotal_hj(np(Hneut)),CP_value(np(Hneut)) !--------------------------------------internal integer :: n ! integer :: subtype !---------------------------------------------- ! subtype=1 n=1 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_mass_width should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_mass_width' endif theo(n)%particle(Hneut)%M = Mh theo(n)%particle(Hneut)%Mc = Mh theo(n)%particle(Hneut)%GammaTot= GammaTotal_hj theo(n)%CP_value = CP_value just_after_run=.False. end subroutine HiggsBounds_neutral_input_properties !************************************************************ subroutine HiggsBounds_neutral_input_effC( & & ghjss_s,ghjss_p,ghjcc_s,ghjcc_p, & & ghjbb_s,ghjbb_p,ghjtt_s,ghjtt_p, & & ghjmumu_s,ghjmumu_p, & & ghjtautau_s,ghjtautau_p, & & ghjWW,ghjZZ,ghjZga, & & ghjgaga,ghjgg,ghjhiZ)!, & ! & BR_hjinvisible,BR_hjhihi_nHbynH) ! New neutral Higgs effective coupling input routine. ! BR's are set separately. !************************************************************ use usefulbits, only : theo,np,Hneut,effC,whichinput,just_after_run!,inputsub #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input double precision,intent(in) :: &!Mh( np(Hneut) ),GammaTotal_hj( np(Hneut) ),& & ghjss_s( np(Hneut) ),ghjss_p( np(Hneut) ), & & ghjcc_s( np(Hneut) ),ghjcc_p( np(Hneut) ), & & ghjbb_s( np(Hneut) ),ghjbb_p( np(Hneut) ), & & ghjtt_s( np(Hneut) ),ghjtt_p( np(Hneut) ), & & ghjmumu_s( np(Hneut) ),ghjmumu_p( np(Hneut) ), & & ghjtautau_s( np(Hneut) ),ghjtautau_p( np(Hneut) ), & & ghjWW( np(Hneut) ),ghjZZ( np(Hneut) ),ghjZga( np(Hneut) ), & & ghjgaga( np(Hneut) ),ghjgg( np(Hneut) ), & & ghjhiZ(np(Hneut),np(Hneut)) ! & BR_hjinvisible( np(Hneut) ),BR_hjhihi_nHbynH(np(Hneut),np(Hneut)) !--------------------------------------internal integer :: n ! integer :: subtype !---------------------------------------------- whichinput='effC' ! subtype=1 n=1 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_effC should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_effC' endif ! theo(n)%particle(Hneut)%M = Mh ! theo(n)%particle(Hneut)%Mc = Mh ! theo(n)%particle(Hneut)%GammaTot= GammaTotal_hj effC(n)%hjss_s = ghjss_s effC(n)%hjss_p = ghjss_p effC(n)%hjcc_s = ghjcc_s effC(n)%hjcc_p = ghjcc_p effC(n)%hjbb_s = ghjbb_s effC(n)%hjbb_p = ghjbb_p effC(n)%hjtt_s = ghjtt_s effC(n)%hjtt_p = ghjtt_p effC(n)%hjmumu_s = ghjmumu_s effC(n)%hjmumu_p = ghjmumu_p effC(n)%hjtautau_s = ghjtautau_s effC(n)%hjtautau_p = ghjtautau_p effC(n)%hjWW = ghjWW effC(n)%hjZZ = ghjZZ effC(n)%hjZga = ghjZga effC(n)%hjgaga = ghjgaga effC(n)%hjgg = ghjgg ! g2(n)%hjggZ = g2hjggZ effC(n)%hjhiZ = ghjhiZ ! theo(n)%BR_hjinvisible = BR_hjinvisible ! theo(n)%BR_hjhihi = BR_hjhihi_nHbynH +! write(*,*) "HiggsBounds_neutral_input_effC hWW coupling = ",effC(n)%hjWW + just_after_run=.False. end subroutine HiggsBounds_neutral_input_effC !************************************************************ subroutine HiggsBounds_neutral_input_SMBR(BR_hjss,BR_hjcc,BR_hjbb, & & BR_hjtt,BR_hjmumu, & & BR_hjtautau,BR_hjWW, & & BR_hjZZ,BR_hjZga,BR_hjgaga, & & BR_hjgg) ! Input for the SM branching ratios !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run,BRdirectinput #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input double precision,intent(in) :: BR_hjss( np(Hneut) ),BR_hjcc( np(Hneut) ), & & BR_hjbb( np(Hneut) ),BR_hjtt( np(Hneut) ), & & BR_hjmumu( np(Hneut) ),BR_hjtautau( np(Hneut) ), & & BR_hjWW( np(Hneut) ),BR_hjZZ( np(Hneut) ), & & BR_hjZga( np(Hneut) ),BR_hjgaga( np(Hneut) ), & & BR_hjgg( np(Hneut) ) !-------------------------------------internal integer :: n !--------------------------------------------- n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_SMBR should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_SMBR' endif ! theo(n)%BR_hjss = BR_hjss theo(n)%BR_hjcc = BR_hjcc theo(n)%BR_hjbb = BR_hjbb theo(n)%BR_hjtt = BR_hjtt theo(n)%BR_hjmumu = BR_hjmumu theo(n)%BR_hjtautau = BR_hjtautau theo(n)%BR_hjWW = BR_hjWW theo(n)%BR_hjZZ = BR_hjZZ theo(n)%BR_hjZga = BR_hjZga theo(n)%BR_hjgaga = BR_hjgaga theo(n)%BR_hjgg = BR_hjgg just_after_run=.False. BRdirectinput=.True. end subroutine HiggsBounds_neutral_input_SMBR !************************************************************ subroutine HiggsBounds_neutral_input_nonSMBR(BR_hjinvisible,BR_hkhjhi,BR_hjhiZ,& & BR_hjemu,BR_hjetau,BR_hjmutau,BR_hjHpiW) ! Input for the non-SM branching ratios !************************************************************ use usefulbits, only : theo,np,Hneut,Hplus,whichinput,just_after_run!,inputsub #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input double precision,intent(in) :: BR_hjinvisible( np(Hneut) ), & & BR_hkhjhi(np(Hneut),np(Hneut),np(Hneut)), & & BR_hjhiZ(np(Hneut),np(Hneut)), & & BR_hjemu(np(Hneut)),& & BR_hjetau(np(Hneut)),& & BR_hjmutau(np(Hneut)) double precision,intent(in) :: BR_hjHpiW(np(Hneut),np(Hplus)) !--------------------------------------internal integer :: n n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_nonSMBR should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_nonSMBR' endif theo(n)%BR_hjinvisible = BR_hjinvisible theo(n)%BR_hkhjhi = BR_hkhjhi theo(n)%BR_hjhiZ = BR_hjhiZ theo(n)%BR_hjemu = BR_hjemu theo(n)%BR_hjetau = BR_hjetau theo(n)%BR_hjmutau = BR_hjmutau ! write(*,*) "HiggsBounds_neutral_input_nonSMBR" ! write(*,*) theo(n)%BR_hjHpiW ! if(present(BR_hjHpiW)) then theo(n)%BR_hjHpiW = BR_hjHpiW ! endif just_after_run=.False. end subroutine HiggsBounds_neutral_input_nonSMBR !************************************************************ subroutine HiggsBounds_neutral_input_LEP(XS_ee_hjZ_ratio,XS_ee_bbhj_ratio, & XS_ee_tautauhj_ratio,XS_ee_hjhi_ratio) !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run implicit none !--------------------------------------------- double precision, intent(in) :: XS_ee_hjZ_ratio(np(Hneut)),& XS_ee_bbhj_ratio(np(Hneut)),XS_ee_tautauhj_ratio(np(Hneut)),& XS_ee_hjhi_ratio(np(Hneut),np(Hneut)) !-------------------------------------internal integer :: n !--------------------------------------------- whichinput='hadr' ! What if effC otherwise used? n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_LEP should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_LEP' endif theo(n)%lep%XS_hjZ_ratio = XS_ee_hjZ_ratio theo(n)%lep%XS_bbhj_ratio = XS_ee_bbhj_ratio theo(n)%lep%XS_tautauhj_ratio = XS_ee_tautauhj_ratio theo(n)%lep%XS_hjhi_ratio = XS_ee_hjhi_ratio just_after_run=.False. end subroutine HiggsBounds_neutral_input_LEP !************************************************************ subroutine HiggsBounds_neutral_input_hadr(collider,CS_hj_ratio, & & CS_gg_hj_ratio,CS_bb_hj_ratio, & & CS_hjW_ratio,CS_hjZ_ratio, & & CS_vbf_ratio,CS_tthj_ratio, & & CS_thj_tchan_ratio,CS_thj_schan_ratio, & & CS_hjhi) !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run,hadroncolliderdataset #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none double precision,intent(in) :: CS_hj_ratio( np(Hneut) ), & & CS_gg_hj_ratio( np(Hneut) ),CS_bb_hj_ratio( np(Hneut) ), & & CS_hjW_ratio( np(Hneut) ) ,CS_hjZ_ratio( np(Hneut) ), & & CS_vbf_ratio( np(Hneut) ) ,CS_tthj_ratio( np(Hneut) ), & & CS_thj_tchan_ratio( np(Hneut) ),CS_thj_schan_ratio( np(Hneut) ), & & CS_hjhi( np(Hneut), np(Hneut) ) integer, intent(in) :: collider !-------------------------------------internal integer :: n ! type(hadroncolliderdataset) :: dataset !--------------------------------------------- whichinput='hadr' n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_hadr should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_hadr' endif select case(collider) case(2) call set_input(theo(n)%tev,CS_hj_ratio, & & CS_gg_hj_ratio,CS_bb_hj_ratio, & & CS_hjW_ratio,CS_hjZ_ratio, & & CS_vbf_ratio,CS_tthj_ratio, & & CS_thj_tchan_ratio,CS_thj_schan_ratio, & & CS_hjhi) case(7) call set_input(theo(n)%lhc7,CS_hj_ratio, & & CS_gg_hj_ratio,CS_bb_hj_ratio, & & CS_hjW_ratio,CS_hjZ_ratio, & & CS_vbf_ratio,CS_tthj_ratio, & & CS_thj_tchan_ratio,CS_thj_schan_ratio, & & CS_hjhi) case(8) call set_input(theo(n)%lhc8,CS_hj_ratio, & & CS_gg_hj_ratio,CS_bb_hj_ratio, & & CS_hjW_ratio,CS_hjZ_ratio, & & CS_vbf_ratio,CS_tthj_ratio, & & CS_thj_tchan_ratio,CS_thj_schan_ratio, & & CS_hjhi) case(13) call set_input(theo(n)%lhc13,CS_hj_ratio, & & CS_gg_hj_ratio,CS_bb_hj_ratio, & & CS_hjW_ratio,CS_hjZ_ratio, & & CS_vbf_ratio,CS_tthj_ratio, & & CS_thj_tchan_ratio,CS_thj_schan_ratio, & & CS_hjhi) case default stop 'wrong input for collider to subroutine HiggsBounds_neutral_input_hadr' end select just_after_run=.False. contains subroutine set_input(dataset,CS_hj_ratio, & & CS_gg_hj_ratio,CS_bb_hj_ratio, & & CS_hjW_ratio,CS_hjZ_ratio, & & CS_vbf_ratio,CS_tthj_ratio, & & CS_thj_tchan_ratio,CS_thj_schan_ratio, & & CS_hjhi) implicit none double precision,intent(in) :: CS_hj_ratio( np(Hneut) ), & & CS_gg_hj_ratio( np(Hneut) ),CS_bb_hj_ratio( np(Hneut) ), & & CS_hjW_ratio( np(Hneut) ) ,CS_hjZ_ratio( np(Hneut) ), & & CS_vbf_ratio( np(Hneut) ) ,CS_tthj_ratio( np(Hneut) ), & & CS_thj_tchan_ratio( np(Hneut) ),CS_thj_schan_ratio( np(Hneut) ), & & CS_hjhi( np(Hneut), np(Hneut) ) type(hadroncolliderdataset) :: dataset dataset%XS_hj_ratio = CS_hj_ratio dataset%XS_gg_hj_ratio = CS_gg_hj_ratio dataset%XS_bb_hj_ratio = CS_bb_hj_ratio dataset%XS_hjW_ratio = CS_hjW_ratio dataset%XS_hjZ_ratio = CS_hjZ_ratio dataset%XS_gg_hjZ_ratio = CS_hjZ_ratio ! assume here that the SM-normalized ratio is equal! dataset%XS_qq_hjZ_ratio = CS_hjZ_ratio ! assume here that the SM-normalized ratio is equal! dataset%XS_vbf_ratio = CS_vbf_ratio dataset%XS_tthj_ratio = CS_tthj_ratio dataset%XS_thj_tchan_ratio = CS_thj_tchan_ratio dataset%XS_thj_schan_ratio = CS_thj_schan_ratio dataset%XS_hjhi = CS_hjhi end subroutine set_input end subroutine HiggsBounds_neutral_input_hadr !************************************************************ ! subroutine HiggsBounds_neutral_input_ZHprod(collider,CS_qq_hjZ_ratio,CS_gg_hjZ_ratio) !************************************************************ !************************************************************ subroutine HiggsBounds_neutral_input_hadr_channelrates(collider,channelrates) ! n.b.: Elements of the matrix channelrates with values < 0 will be overwritten ! by XS times BR using the narrow width approximation. !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run,hadroncolliderdataset,& & Nprod,Ndecay #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none double precision,intent(in) :: channelrates(np(Hneut),Nprod,Ndecay) integer, intent(in) :: collider !-------------------------------------internal integer :: n !--------------------------------------------- whichinput='hadr' n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_hadr_channelrates should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_hadr' endif select case(collider) case(2) theo(n)%tev%channelrates_tmp=channelrates case(7) theo(n)%lhc7%channelrates_tmp=channelrates case(8) theo(n)%lhc8%channelrates_tmp=channelrates case(13) theo(n)%lhc13%channelrates_tmp=channelrates case default stop 'wrong input for collider to subroutine HiggsBounds_neutral_input_hadr_channelrates' end select just_after_run=.False. end subroutine HiggsBounds_neutral_input_hadr_channelrates !************************************************************ subroutine HiggsBounds_charged_input(Mhplus,GammaTotal_Hpj, & & CS_ee_HpjHmj_ratio, & & BR_tWpb,BR_tHpjb, & & BR_Hpjcs,BR_Hpjcb,BR_Hpjtaunu,BR_Hpjtb, & & BR_HpjWZ,BR_HpjhiW) ! This subroutine can be called by the user after subroutine ! initialize_HiggsBounds has been called. ! Arguments (input): theoretical predictions (see manual for definitions) ! HB-5: Extended input by charged Higgs decays to tb, WZ, hiW !************************************************************ use usefulbits, only : theo,np,Hplus,Hneut,just_after_run!,inputsub #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input double precision,intent(in) :: Mhplus( np(Hplus) ),GammaTotal_Hpj( np(Hplus) ), & & CS_ee_HpjHmj_ratio( np(Hplus) ), & & BR_tWpb,BR_tHpjb( np(Hplus) ), & & BR_Hpjcs( np(Hplus) ),BR_Hpjcb( np(Hplus) ),BR_Hpjtaunu( np(Hplus) ), & & BR_Hpjtb( np(Hplus) ),BR_HpjWZ( np(Hplus) ) double precision,intent(in) :: BR_HpjhiW(np(Hplus),np(Hneut)) !--------------------------------------internal integer :: n ! integer :: j ! integer :: subtype !---------------------------------------------- n=1 ! subtype=2 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hplus).eq.0)then write(*,*)'subroutine HiggsBounds_charged_input should' write(*,*)'only be called if np(Hplus)>0' stop 'error in subroutine HiggsBounds_charged_input' endif theo(n)%particle(Hplus)%M = Mhplus theo(n)%particle(Hplus)%Mc = Mhplus theo(n)%particle(Hplus)%GammaTot= GammaTotal_Hpj theo(n)%lep%XS_HpjHmj_ratio = CS_ee_HpjHmj_ratio theo(n)%BR_tWpb = BR_tWpb theo(n)%BR_tHpjb = BR_tHpjb theo(n)%BR_Hpjcs = BR_Hpjcs theo(n)%BR_Hpjcb = BR_Hpjcb theo(n)%BR_Hpjtaunu = BR_Hpjtaunu theo(n)%BR_Hpjtb = BR_Hpjtb theo(n)%BR_HpjWZ = BR_HpjWZ theo(n)%BR_HpjhiW = BR_HpjhiW ! write(*,*) 'HiggsBounds_charged_input' ! write(*,*) theo(n)%BR_HpjhiW ! if(present(BR_HpjhiW_in)) then ! write(*,*) "BR_HpjhiW given: ", BR_HpjhiW_in ! theo(n)%BR_HpjhiW = BR_HpjhiW_in ! else ! if(np(Hneut).gt.0) then ! theo(n)%BR_HpjhiW = 0.0D0 ! endif ! endif ! write(*,*) theo(n)%BR_HpjhiW just_after_run=.False. end subroutine HiggsBounds_charged_input !************************************************************ subroutine HiggsBounds_charged_input_hadr(collider, CS_Hpjtb, CS_Hpjcb, & & CS_Hpjbjet, CS_Hpjcjet, CS_Hpjjetjet, CS_HpjW, & & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj, CS_Hpjhi) ! This subroutine can be called by the user after subroutine initialize_HiggsBounds ! has been called. ! Arguments (input): theoretical predictions (see manual for definitions) !************************************************************ use usefulbits, only : theo,np,Hplus,Hneut,just_after_run,hadroncolliderdataset!,inputsub #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input double precision,intent(in) :: CS_Hpjtb( np(Hplus) ), CS_Hpjcb( np(Hplus) ),& & CS_Hpjbjet( np(Hplus) ), CS_Hpjcjet( np(Hplus) ),& & CS_Hpjjetjet( np(Hplus) ), & & CS_HpjW( np(Hplus) ), CS_HpjZ( np(Hplus) ),& & CS_vbf_Hpj( np(Hplus) ), CS_HpjHmj( np(Hplus) ) integer, intent(in) :: collider double precision,intent(in) :: CS_Hpjhi( np(Hplus),np(Hneut) ) !--------------------------------------internal integer :: n !---------------------------------------------- n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hplus).eq.0)then write(*,*)'subroutine HiggsBounds_charged_input should' write(*,*)'only be called if np(Hplus)>0' stop 'error in subroutine HiggsBounds_charged_input' endif select case(collider) case(2) ! if(present(CS_Hpjhi)) then call set_input(theo(n)%tev,CS_Hpjtb, CS_Hpjcb, CS_Hpjbjet, & & CS_Hpjcjet, CS_Hpjjetjet, CS_HpjW, & & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj, CS_Hpjhi) ! else ! call set_input(theo(n)%tev,CS_Hpjtb, CS_Hpjbjet, CS_HpjW, & ! & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj) ! endif case(7) ! if(present(CS_Hpjhi)) then call set_input(theo(n)%lhc7,CS_Hpjtb, CS_Hpjcb, CS_Hpjbjet, & & CS_Hpjcjet, CS_Hpjjetjet, CS_HpjW, & & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj, CS_Hpjhi) ! else ! call set_input(theo(n)%lhc7,CS_Hpjtb, CS_Hpjbjet, CS_HpjW, & ! & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj) ! endif case(8) ! if(present(CS_Hpjhi)) then call set_input(theo(n)%lhc8,CS_Hpjtb, CS_Hpjcb, CS_Hpjbjet, & & CS_Hpjcjet, CS_Hpjjetjet, CS_HpjW, & & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj, CS_Hpjhi) ! else ! call set_input(theo(n)%lhc8,CS_Hpjtb, CS_Hpjbjet, CS_HpjW, & ! & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj) ! endif case(13) ! if(present(CS_Hpjhi)) then call set_input(theo(n)%lhc13,CS_Hpjtb, CS_Hpjcb, CS_Hpjbjet, & & CS_Hpjcjet, CS_Hpjjetjet, CS_HpjW, & & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj, CS_Hpjhi) ! else ! call set_input(theo(n)%lhc13,CS_Hpjtb, CS_Hpjbjet, CS_HpjW, & ! & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj) ! endif case default stop 'wrong input for collider to subroutine HiggsBounds_charged_input_hadr' end select just_after_run=.False. contains subroutine set_input(dataset,CS_Hpjtb, CS_Hpjcb, CS_Hpjbjet, & & CS_Hpjcjet, CS_Hpjjetjet, CS_HpjW, & & CS_HpjZ, CS_vbf_Hpj, CS_HpjHmj, CS_Hpjhi) double precision,intent(in) :: CS_Hpjtb( np(Hplus) ), CS_Hpjcb( np(Hplus) ),& & CS_Hpjbjet( np(Hplus) ), CS_Hpjcjet( np(Hplus) ),& & CS_Hpjjetjet( np(Hplus) ), & & CS_HpjW( np(Hplus) ), CS_HpjZ( np(Hplus) ),& & CS_vbf_Hpj( np(Hplus) ), CS_HpjHmj( np(Hplus) ) double precision,intent(in) :: CS_Hpjhi( np(Hplus),np(Hneut) ) type(hadroncolliderdataset) :: dataset dataset%XS_Hpjtb = CS_Hpjtb dataset%XS_Hpjcb = CS_Hpjcb dataset%XS_Hpjbjet = CS_Hpjbjet dataset%XS_Hpjcjet = CS_Hpjcjet dataset%XS_Hpjjetjet = CS_Hpjjetjet dataset%XS_vbf_Hpj = CS_vbf_Hpj dataset%XS_HpjW = CS_HpjW dataset%XS_HpjZ = CS_HpjZ dataset%XS_HpjHmj = CS_HpjHmj ! if(present(CS_Hpjhi)) then dataset%XS_Hpjhi = CS_Hpjhi ! endif end subroutine set_input end subroutine HiggsBounds_charged_input_hadr !************************************************************ subroutine HiggsBounds_get_neutral_hadr_CS(i,collider,& & singleH, ggH, bbH, VBF, WH, ZH, ttH, tH_tchan, tH_schan) use usefulbits, only : theo, np, Hneut, hadroncolliderdataset implicit none integer, intent(in) :: i, collider double precision, intent(out) :: singleH, ggH, bbH, VBF, WH, ZH, ttH, tH_tchan, tH_schan if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(i.gt.np(Hneut)) then write(*,"(A,I2,A)") 'WARNING: Requested neutral Higgs h',i,' not part of the model!' else select case(collider) case(2) call get_cross_section(theo(1)%tev,i, singleH, ggH, bbH, VBF, WH, ZH, ttH, tH_tchan, tH_schan) case(7) call get_cross_section(theo(1)%lhc7,i, singleH, ggH, bbH, VBF, WH, ZH, ttH, tH_tchan, tH_schan) case(8) call get_cross_section(theo(1)%lhc8,i, singleH, ggH, bbH, VBF, WH, ZH, ttH, tH_tchan, tH_schan) case(13) call get_cross_section(theo(1)%lhc13,i, singleH, ggH, bbH, VBF, WH, ZH, ttH, tH_tchan, tH_schan) case default stop 'wrong input for collider to subroutine HiggsBounds_get_neutral_SMnormalizedCS' end select endif contains subroutine get_cross_section(dataset,i, singleH, ggH, bbH, VBF, WH, ZH, ttH, tH_tchan, tH_schan) integer, intent(in) :: i double precision, intent(inout) :: singleH, ggH, bbH, VBF, WH, ZH, ttH, tH_tchan, tH_schan type(hadroncolliderdataset) :: dataset singleH = dataset%XS_hj_ratio(i) ggH = dataset%XS_gg_hj_ratio(i) bbH = dataset%XS_bb_hj_ratio(i) VBF = dataset%XS_vbf_ratio(i) WH = dataset%XS_hjW_ratio(i) ZH = dataset%XS_hjZ_ratio(i) ttH = dataset%XS_tthj_ratio(i) tH_tchan = dataset%XS_thj_tchan_ratio(i) tH_schan = dataset%XS_thj_schan_ratio(i) end subroutine get_cross_section !************************************************************ end subroutine HiggsBounds_get_neutral_hadr_CS !************************************************************ subroutine HiggsBounds_get_neutral_BR(i,BR_hjss,BR_hjcc,BR_hjbb,& & BR_hjtt,BR_hjmumu,BR_hjtautau,BR_hjWW,BR_hjZZ,BR_hjZga,& & BR_hjgaga,BR_hjgg) use usefulbits, only : theo, np, Hneut implicit none integer, intent(in) :: i double precision, intent(out) :: BR_hjss,BR_hjcc,BR_hjbb,& & BR_hjtt,BR_hjmumu,BR_hjtautau,BR_hjWW,BR_hjZZ,BR_hjZga,& & BR_hjgaga,BR_hjgg if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(i.gt.np(Hneut)) then write(*,"(A,I2,A)") 'WARNING: Requested neutral Higgs h',i,' not part of the model!' else BR_hjss = theo(1)%BR_hjss(i) BR_hjcc = theo(1)%BR_hjcc(i) BR_hjbb = theo(1)%BR_hjbb(i) BR_hjtt = theo(1)%BR_hjtt(i) BR_hjmumu = theo(1)%BR_hjmumu(i) BR_hjtautau = theo(1)%BR_hjtautau(i) BR_hjWW = theo(1)%BR_hjWW(i) BR_hjZZ = theo(1)%BR_hjZZ(i) BR_hjZga = theo(1)%BR_hjZga(i) BR_hjgaga = theo(1)%BR_hjgaga(i) BR_hjgg = theo(1)%BR_hjgg(i) endif end subroutine HiggsBounds_get_neutral_BR !************************************************************ subroutine HiggsBounds_set_mass_uncertainties(dMhneut, dMhch) !************************************************************ ! Assigns the mass uncertainties in the subroutine version. ! use usefulbits, only : theo,np,Hneut,Hplus implicit none double precision, intent(in) :: dMhneut(np(Hneut)) double precision, intent(in) :: dMhch(np(Hplus)) theo(1)%particle(Hneut)%dMh = dMhneut theo(1)%particle(Hplus)%dMh = dMhch end subroutine HiggsBounds_set_mass_uncertainties !************************************************************ subroutine get_mass_variation_param(n) use usefulbits, only : theo,np,Hneut,Hplus,diffMhneut,diffMhch,ndmh,dmhsteps,small_mh implicit none integer, intent(in) :: n double precision :: dMhneut(np(Hneut)) double precision :: dMhch(np(Hplus)) integer :: km(np(Hneut)+np(Hplus)) integer :: dm(dmhsteps**(np(Hneut)+np(Hplus)),np(Hneut)+np(Hplus)) integer i,j,k,kp if(np(Hneut).gt.0) dMhneut = theo(n)%particle(Hneut)%dMh if(np(Hplus).gt.0) dMhch = theo(n)%particle(Hplus)%dMh if (modulo(dmhsteps,2).NE.1) then stop 'Wrong number of steps in set_mass_uncertainty: must be odd (>=3)' endif ndmh = 0 do i=1,np(Hneut) IF (dMhneut(i).GT.small_mh) THEN ndmh = ndmh + 1 ENDIF km(i)=-(dmhsteps-1)/2 enddo do i=1,np(Hplus) IF (dMhch(i).GT.small_mh) ndmh = ndmh + 1 km(i+np(Hneut))=-(dmhsteps-1)/2 enddo IF (ndmh.EQ.0) THEN RETURN ENDIF ! print *, "Number of mass uncertainties: ", ndmh if(allocated(diffMhneut)) deallocate(diffMhneut) if(allocated(diffMhch)) deallocate(diffMhch) allocate(diffMhneut(dmhsteps**(np(Hneut)+np(Hplus)),np(Hneut))) allocate(diffMhch(dmhsteps**(np(Hneut)+np(Hplus)),np(Hplus))) k = 1 do i=1,dmhsteps**ndmh do j=1,ndmh dm(i,j) = km(j) enddo km(k) = km(k)+1 do j=2,ndmh IF (modulo(i,dmhsteps**(j-1)).EQ.0) THEN km(j) = km(j)+1 km(j-1) = -1 ENDIF ENDDO enddo do i=1,dmhsteps**ndmh k=1 do j=1,np(Hneut) IF (dMhneut(j).GT.small_mh) THEN diffMhneut(i,j)=theo(n)%particle(Hneut)%M(j)+dm(i,k)*dMhneut(k)/((dmhsteps-1)/2) k = k +1 ELSE diffMhneut(i,j)=theo(n)%particle(Hneut)%M(j) ENDIF enddo kp = k do j=1,np(Hplus) IF (dMhch(j).GT.small_mh) THEN diffMhch(i,j)=theo(n)%particle(Hplus)%M(j)+dm(i,k)*dMhch(k-(kp-1))/((dmhsteps-1)/2) k = k +1 ELSE diffMhch(i,j)=theo(n)%particle(Hplus)%M(j) ENDIF enddo ! print *, i, (diffMhneut(i,j),j=1,np(Hneut)),(diffMhch(i,j),j=1,np(Hplus)) enddo end subroutine get_mass_variation_param subroutine SUSYBounds_neutralinoonly_input(MN,GammaTotal_N, & & CS_NjNi, & & BR_NjqqNi,BR_NjZNi & & ) ! This subroutine can be called by the user after subroutine initialize_HiggsBounds ! has been called. ! Arguments (input): theoretical predictions (see manual for definitions) !************************************************************ use usefulbits, only : theo,np,Chineut,just_after_run!,inputsub, #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input double precision,intent(in) :: MN( np(Chineut) ),GammaTotal_N( np(Chineut) ) , & & CS_NjNi( np(Chineut),np(Chineut) ), & & BR_NjqqNi( np(Chineut),np(Chineut) ),BR_NjZNi( np(Chineut),np(Chineut) ) !--------------------------------------internal integer :: n ! integer :: subtype !---------------------------------------------- n=1 ! subtype=3 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Chineut).eq.0)then write(*,*)'subroutine SUSYBounds_neutralinoonly_input should' write(*,*)'only be called if np(Chineut)>0' stop 'error in SUSYBounds_neutralinoonly_input' endif theo(n)%particle(Chineut)%M = MN theo(n)%particle(Chineut)%GammaTot= GammaTotal_N theo(n)%lep%XS_NjNi = CS_NjNi theo(n)%BR_NjqqNi = BR_NjqqNi theo(n)%BR_NjZNi = BR_NjZNi just_after_run=.False. end subroutine SUSYBounds_neutralinoonly_input !************************************************************ subroutine SUSYBounds_neutralinochargino_input(MC,GammaTotal_C, & & CS_CpjCmj, & & BR_CjqqNi, & & BR_CjlnuNi, & & BR_CjWNi & & ) ! This subroutine can be called by the user after subroutine initialize_HiggsBounds ! has been called. ! Arguments (input): theoretical predictions (see manual for definitions) !************************************************************ use usefulbits, only : theo,np,Chineut,Chiplus,just_after_run!,inputsub #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------input double precision,intent(in) :: MC( np(Chiplus) ),GammaTotal_C( np(Chiplus) ), & & CS_CpjCmj( np(Chiplus) ), & & BR_CjqqNi( np(Chiplus),np(Chineut) ), & & BR_CjlnuNi( np(Chiplus),np(Chineut) ), & & BR_CjWNi( np(Chiplus),np(Chineut) ) !--------------------------------------internal integer :: n integer :: subtype !---------------------------------------------- n=1 ! subtype=4 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if((np(Chineut).eq.0).or.(np(Chiplus).eq.0))then write(*,*)'subroutine SUSYBounds_neutralinochargino_input should' write(*,*)'only be called if np(Chineut)>0 and np(Chiplus)>0' stop 'error in subroutine SUSYBounds_neutralinochargino_input' endif theo(n)%particle(Chineut)%M = MC theo(n)%particle(Chineut)%GammaTot= GammaTotal_C theo(n)%lep%XS_CpjCmj = CS_CpjCmj theo(n)%BR_CjqqNi = BR_CjqqNi theo(n)%BR_CjlnuNi = BR_CjlnuNi theo(n)%BR_CjWNi = BR_CjWNi just_after_run=.False. end subroutine SUSYBounds_neutralinochargino_input !************************************************************ subroutine run_HiggsBounds(HBresult, chan, obsratio, ncombined) ! This subroutine can be called by the user after HiggsBounds_initialize has been called. ! The input routines, where required, should be called before calling run_HiggsBounds. ! It takes theoretical predictions for a particular parameter point ! in the model and calls subroutines which compare these predictions ! to the experimental limits ! Arguments (output): ! * HBresult = 1 if point is unexcluded, 0 if excluded, -1 if parameter point is invalid ! * chan = number of channel predicted to have the highest statistical sensitivity, as defined in Key.dat ! * obsratio = ratio of the theoretical rate to the observed limit for this channel ! * ncombined = number of Higgs combined in order to calculate this obsratio ! (see manual for more precise definitions)) ! (TS 30/01/2012): Note, that if many data points are tested at the same time (as for ! inputmethod==datfiles), this subroutine only returns the results of ! the last datapoint. The full results are saved in fullHBres. use usefulbits, only : np, Hneut, Hplus, run_HB_classic implicit none integer HBresult, chan, ncombined double precision obsratio integer hbres(0:np(Hneut)+np(Hplus)), hbchan(0:np(Hneut)+np(Hplus)), hbcomb(0:np(Hneut)+np(Hplus)) double precision hbobs(0:np(Hneut)+np(Hplus)) ! Check if we are using the old 'classic' method if (run_HB_classic.EQV..True.) then call run_HiggsBounds_classic(HBresult,chan,obsratio,ncombined) return endif ! Call the new ('full') method call run_HiggsBounds_full(hbres, hbchan, hbobs, hbcomb) ! Combined results are contained in the zero elements of result arrays HBresult = hbres(0) chan = hbchan(0) obsratio = hbobs(0) ncombined = hbcomb(0) end subroutine run_HiggsBounds !************************************************************ subroutine run_HiggsBounds_single(h, HBresult, chan, obsratio, ncombined) ! This subroutine can be used to get the exclusion results ! for a single Higgs boson (specified by the index h). ! ! To obtain individual results from more than one Higgs boson, it ! is more efficient to use run_HiggsBounds_full rather than this method. use usefulbits, only : np, Hneut, Hplus implicit none integer, intent(in) :: h integer, intent(out) :: HBresult, chan, ncombined double precision, intent(out) :: obsratio integer hbres(0:np(Hneut)+np(Hplus)), hbchan(0:np(Hneut)+np(Hplus)), hbcomb(0:np(Hneut)+np(Hplus)) double precision hbobs(0:np(Hneut)+np(Hplus)) IF (h.LT.0) stop "Illegal number of Higgs boson: h < 0" if (h.GT.np(Hneut)+np(Hplus)) stop "Illegal number of Higgs boson" call run_HiggsBounds_full(hbres, hbchan, hbobs, hbcomb) HBresult = hbres(h) chan = hbchan(h) obsratio = hbobs(h) ncombined = hbcomb(h) end subroutine run_HiggsBounds_single !************************************************************ subroutine run_HiggsBounds_full( HBresult,chan, & & obsratio, ncombined ) ! This subroutine can be called by the user after HiggsBounds_initialize has been called. ! The input routines, where required, should be called before calling run_HiggsBounds. ! It takes theoretical predictions for a particular parameter point ! in the model and calls subroutines which compare these predictions ! to the experimental limits. ! ! The results are given as (n+1)-component arrays (starting from 0), ! where n is the total number of Higgs bosons in the model (neutral+charged). ! The zeroth component gives the combined results (equivalent to run_HiggsBounds). ! ! Arguments (output): ! * HBresult = 1 if point is unexcluded, 0 if excluded, -1 if parameter point is invalid ! * chan = number of channel predicted to have the highest statistical sensitivity, as defined in Key.dat ! * obsratio = ratio of the theoretical rate to the observed limit for this channel ! * ncombined = number of Higgs combined in order to calculate this obsratio ! (see manual for more precise definitions)) use usefulbits, only : theo,res,just_after_run,ndmh,debug,numres, & & np,Hneut,Hplus,dmhsteps,ndat,fullHBres,small_mh,& HBresult_all,ncombined_all,chan_all,obsratio_all,predratio_all use channels, only : check_channels !use input, only : test_input use theo_manip, only : HB5_complete_theo, HB5_recalculate_theo_for_datapoint #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------output integer,intent(out):: HBresult(0:np(Hneut)+np(Hplus)) integer,intent(out):: chan(0:np(Hneut)+np(Hplus)) integer,intent(out):: ncombined(0:np(Hneut)+np(Hplus)) double precision,intent(out) :: obsratio(0:np(Hneut)+np(Hplus)) double precision :: Mhneut(np(Hneut)) double precision :: Mhch(np(Hplus)) !-------------------------------------internal integer :: n,i,j,ind,part,k !--------------------------------------------- ! print *, "Running HiggsBounds in Normal Mode (most sensitive limit considered for each Higgs boson)" if (lbound(HBresult,dim=1).NE.0) stop "run_HiggsBounds_full: Array HBresult must begin with element 0" if (ubound(HBresult,dim=1).NE.(np(Hneut)+np(Hplus))) then stop "run_HiggsBounds_full: Upper limit of array HBresult must be equal to number of Higgses" endif if (lbound(chan,dim=1).NE.0) stop "run_HiggsBounds_full: Array chan must begin with element 0" if (ubound(chan,dim=1).NE.(np(Hneut)+np(Hplus))) then stop "run_HiggsBounds_full: Upper limit of array chan must be equal to number of Higgses" endif if (lbound(obsratio,dim=1).NE.0) stop "run_HiggsBounds_full: Array obsratio must begin with element 0" if (ubound(obsratio,dim=1).NE.(np(Hneut)+np(Hplus))) then stop "run_HiggsBounds_full: Upper limit of array obsratio must be equal to number of Higgses" endif if (lbound(ncombined,dim=1).NE.0) stop "run_HiggsBounds_full: Array ncombined must begin with element 0" if (ubound(ncombined,dim=1).NE.(np(Hneut)+np(Hplus))) then stop "run_HiggsBounds_full: Upper limit of array ncombined must be equal to number of Higgses" endif if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(.not.allocated(HBresult_all)) allocate(HBresult_all(0:np(Hneut)+np(Hplus),numres)) if(.not.allocated(chan_all)) allocate(chan_all(0:np(Hneut)+np(Hplus),numres)) if(.not.allocated(ncombined_all)) allocate(ncombined_all(0:np(Hneut)+np(Hplus),numres)) if(.not.allocated(obsratio_all)) allocate(obsratio_all(0:np(Hneut)+np(Hplus),numres)) if(.not.allocated(predratio_all)) allocate(predratio_all(0:np(Hneut)+np(Hplus),numres)) ! do i=1,ubound(inputsub,dim=1) ! if( inputsub(i)%req .ne. inputsub(i)%stat )then ! write(*,*)'subroutine '//trim(adjustl(inputsub(i)%desc)) ! write(*,*)'should be called once and only once before each call to' ! write(*,*)'subroutine run_HiggsBounds.' ! stop 'error in subroutine run_HiggsBounds' ! endif ! inputsub(i)%stat=0!now we have used this input, set back to zero ! enddo call HB5_complete_theo do n=1,ndat ! if(debug) then ! write(*,*) "DEBUG BRs: ", theo(n)%BR_hjWW, theo(n)%BR_hjZZ, theo(n)%BR_hjgaga ! endif theo(n)%particle(Hneut)%Mc = theo(n)%particle(Hneut)%M theo(n)%particle(Hplus)%Mc = theo(n)%particle(Hplus)%M call get_mass_variation_param(n) do i=0,ubound(Hbresult,dim=1) obsratio_all(i,:) = -999d0 predratio_all(i,:) = -999d0 HBresult_all(i,:) = 1 chan_all(i,:) = -999 ncombined_all(i,:) = -999 obsratio(i) = -999d0 HBresult(i) = 1 chan(i) = -999 ncombined(i) = -999 enddo ! Do we have mass uncertainties to take care off IF (ndmh.GT.0) THEN ! print *, "Running HiggsBounds with Higgs mass uncertainties" ! write(*,*) theo(n)%particle(Hplus)%dM if(np(Hneut).ne.0) Mhneut = theo(n)%particle(Hneut)%M if(np(Hplus).ne.0) Mhch = theo(n)%particle(Hplus)%M ! Loop over all Higgses do i=1,np(Hneut)+np(Hplus) obsratio_all(i,:) = 1.D23 IF (i.LE.np(Hneut)) THEN ind = i part = Hneut ELSE ind = i-np(Hneut) part = Hplus ENDIF ! Check for mass steps for this particular Higgs boson IF(theo(n)%particle(part)%dMh(ind).GT.small_mh) THEN ! theo(n)%particle(part)%M(ind)=theo(n)%particle(part)%M(ind) & ! & -(dmhsteps-1)/2*theo(n)%particle(part)%dMh(ind) theo(n)%particle(part)%M(ind)=theo(n)%particle(part)%M(ind) & & -theo(n)%particle(part)%dMh(ind) do j=1,dmhsteps ! print *, theo(n)%particle(Hneut)%M, theo(n)%particle(Hplus)%M call HB5_recalculate_theo_for_datapoint(n) call check_channels(theo(n),res(n),i) do k=1,size(res(n)%obsratio) ! write(*,*) "i,k,res(n)%obsratio(k),res(n)%chan(k) = ",i,k,res(n)%obsratio(k),res(n)%chan(k) IF (res(n)%obsratio(k).LT.obsratio_all(i,k)) THEN ! write(*,*) "i,k,res(n)%obsratio(k),res(n)%chan(k) = ",i,k,res(n)%obsratio(k),res(n)%chan(k) HBresult_all(i,k) = res(n)%allowed95(k) chan_all(i,k) = res(n)%chan(k) obsratio_all(i,k) = res(n)%obsratio(k) predratio_all(i,k) = res(n)%predratio(k) ncombined_all(i,k) = res(n)%ncombined(k) ENDIF enddo ! print *, i,theo(n)%particle(part)%M(ind),HBresult(i),chan(i),obsratio(i),ncombined(i) theo(n)%particle(part)%M(ind)= theo(n)%particle(part)%M(ind) & & +theo(n)%particle(part)%dMh(ind)/(dmhsteps-1)*2 enddo else call HB5_recalculate_theo_for_datapoint(n) call check_channels(theo(n),res(n),i) do k=1,size(res(n)%obsratio) ! write(*,*) "i,k,res(n)%obsratio(k),res(n)%chan(k) = ",i,k,res(n)%obsratio(k),res(n)%chan(k) HBresult_all(i,k) = res(n)%allowed95(k) chan_all(i,k) = res(n)%chan(k) obsratio_all(i,k) = res(n)%obsratio(k) predratio_all(i,k) = res(n)%predratio(k) ncombined_all(i,k) = res(n)%ncombined(k) enddo ! HBresult(i) = res(n)%allowed95(1) ! chan(i) = res(n)%chan(1) ! obsratio(i) = res(n)%obsratio(1) ! ncombined(i) = res(n)%ncombined(1) endif HBresult(i) = HBresult_all(i,1) chan(i) = chan_all(i,1) obsratio(i) = obsratio_all(i,1) ncombined(i) = ncombined_all(i,1) ! Logical OR between exclusions (one Higgs excluded = combined exclusion) HBresult(0) = HBresult(0) * HBresult(i) ! Save the data for the Higgs that has the highest ratio of theory/obs IF (obsratio(i).GT.obsratio(0)) THEN chan(0) = chan(i) obsratio(0) = obsratio(i) ncombined(0) = ncombined(i) ENDIF theo(n)%particle(Hneut)%M = Mhneut theo(n)%particle(Hplus)%M = Mhch enddo ! return ELSE ! print *, "Running HiggsBounds without Higgs mass uncertainties" call HB5_recalculate_theo_for_datapoint(n) ! write(*,*) "Higgses = " , np(Hneut)+np(Hplus) do i=1,np(Hneut)+np(Hplus) call check_channels(theo(n),res(n),i) ! do k=1,size(res(n)%obsratio) ! write(*,*) "i,k,res(n)%obsratio(k),res(n)%chan(k) = ",i,k,res(n)%obsratio(k),res(n)%chan(k) ! enddo do k=1,size(res(n)%obsratio) ! write(*,*) "i,k,res(n)%obsratio(k),res(n)%chan(k) = ",i,k,res(n)%obsratio(k),res(n)%chan(k) HBresult_all(i,k) = res(n)%allowed95(k) chan_all(i,k) = res(n)%chan(k) obsratio_all(i,k) = res(n)%obsratio(k) predratio_all(i,k) = res(n)%predratio(k) ncombined_all(i,k) = res(n)%ncombined(k) enddo HBresult(i) = HBresult_all(i,1) chan(i) = chan_all(i,1) obsratio(i) = obsratio_all(i,1) ncombined(i) = ncombined_all(i,1) ! HBresult(i) = res(n)%allowed95(1) ! chan(i) = res(n)%chan(1) ! obsratio(i) = res(n)%obsratio(1) ! ncombined(i) = res(n)%ncombined(1) ! ! write(*,*) "hello: i=",i," HBres, chan, obsratio = ", HBresult(i), chan(i), obsratio(i) HBresult(0) = HBresult(0) * res(n)%allowed95(1) IF (obsratio(i).GT.obsratio(0)) THEN ! write(*,*) "hello: ", n, i chan(0) = res(n)%chan(1) obsratio(0) = res(n)%obsratio(1) ncombined(0) = res(n)%ncombined(1) ENDIF ! IF (i.LE.np(Hneut)) THEN ! print *, i,theo(n)%particle(Hneut)%M(i),HBresult(i),chan(i),obsratio(i),ncombined(i),HBresult(0), obsratio(0) ! ELSE ! print *, i,theo(n)%particle(Hplus)%M(i-np(Hneut)),HBresult(i),chan(i),obsratio(i),ncombined(i),HBresult(0), obsratio(0) ! endif enddo ENDIF ! write(*,*) "run_HB_full, obsratio: ", obsratio ! write(*,*) "run_HB_full, chan : ", chan fullHBres(n)%allowed95=HBresult(0) fullHBres(n)%chan=chan(0) fullHBres(n)%obsratio=obsratio(0) fullHBres(n)%ncombined=ncombined(0) enddo just_after_run=.True. ! print *, "HB: run done" end subroutine run_HiggsBounds_full !************************************************************ subroutine HiggsBounds_get_most_sensitive_channels_per_Higgs(nH,pos,HBresult,chan,obsratio,predratio,ncombined) !************************************************************ use usefulbits, only : HBresult_all,obsratio_all,chan_all,ncombined_all,predratio_all,& & just_after_run,np,Hneut,Hplus,numres integer, intent(in) :: nH, pos integer, intent(out) :: HBresult, chan, ncombined double precision, intent(out) :: obsratio, predratio HBresult = 0 chan = 0 obsratio = 0 predratio = 0 ncombined = 0 if(just_after_run.and.allocated(HBresult_all)) then if(nH.le.np(Hneut)+np(Hplus)) then if(pos.le.numres) then HBresult = HBresult_all(nH,pos) chan = chan_all(nH,pos) obsratio = obsratio_all(nH,pos) predratio = predratio_all(nH,pos) ncombined = ncombined_all(nH,pos) else write(*,*) 'WARNING: request exceeds the number of stored most sensitive channels (',numres,')' endif else write(*,*) 'WARNING: requested Higgs boson is invalid (choose between 1 and ',np(Hneut)+np(Hplus),'!)' endif else write(*,*) 'WARNING: Please call run_HiggsBounds or run_HiggsBounds_full before calling',& & ' HiggsBounds_get_most_sensitive_channels!' endif end subroutine HiggsBounds_get_most_sensitive_channels_per_Higgs !************************************************************ subroutine HiggsBounds_get_most_sensitive_channels(pos,HBresult,chan,obsratio,predratio,ncombined) !************************************************************ use usefulbits, only : HBresult_all,obsratio_all,predratio_all,chan_all,ncombined_all,& & just_after_run,np,Hneut,Hplus,numres integer, intent(in) :: pos integer, intent(out) :: HBresult, chan, ncombined double precision, intent(out) :: obsratio,predratio integer :: i,j,count integer,allocatable :: nH_rank(:),pos_rank(:), posflat(:) double precision, allocatable :: predratio_tmp(:) allocate(nH_rank(numres),pos_rank(numres),posflat(numres),predratio_tmp(numres*(np(Hneut)+np(Hplus)))) HBresult = 0 chan = 0 obsratio = 0 ncombined = 0 predratio_tmp = 0 count=0 if(just_after_run.and.allocated(HBresult_all)) then if(pos.le.numres) then do j=1,np(Hneut)+np(Hplus) do i=1,numres count=count+1 predratio_tmp(count)=predratio_all(j,i) enddo enddo do i=1,numres posflat(i) = maxloc(predratio_tmp,1) predratio_tmp(posflat(i)) = -1.0D0 enddo count=0 do j=1,np(Hneut)+np(Hplus) do i=1,numres count=count+1 do k=1,numres if(count.eq.posflat(k)) then nH_rank(k) = j pos_rank(k) = i endif enddo enddo enddo HBresult = HBresult_all(nH_rank(pos),pos_rank(pos)) chan = chan_all(nH_rank(pos),pos_rank(pos)) obsratio = obsratio_all(nH_rank(pos),pos_rank(pos)) predratio = predratio_all(nH_rank(pos),pos_rank(pos)) ncombined = ncombined_all(nH_rank(pos),pos_rank(pos)) else write(*,*) 'WARNING: request exceeds the number of stored most sensitive channels (',numres,')' endif else write(*,*) 'WARNING: Please call run_HiggsBounds or run_HiggsBounds_full before calling',& & ' HiggsBounds_get_most_sensitive_channels!' endif deallocate(nH_rank,pos_rank,posflat,predratio_tmp) end subroutine HiggsBounds_get_most_sensitive_channels !************************************************************ subroutine run_HiggsBounds_classic( HBresult,chan,obsratio,ncombined) ! This subroutine can be called by the user after HiggsBounds_initialize has been called. ! The input routines, where required, should be called before calling run_HiggsBounds. ! It takes theoretical predictions for a particular parameter point ! in the model and calls subroutines which compare these predictions ! to the experimental limits ! Arguments (output): ! * HBresult = 1 if point is unexcluded, 0 if excluded, -1 if parameter point is invalid ! * chan = number of channel predicted to have the highest statistical sensitivity, as defined in Key.dat ! * obsratio = ratio of the theoretical rate to the observed limit for this channel ! * ncombined = number of Higgs combined in order to calculate this obsratio ! (see manual for more precise definitions)) use usefulbits, only : theo,res,debug,just_after_run,ndmh,diffmhneut,diffmhch, & np,Hneut,Hplus,full_dmth_variation,dmhsteps, ndat,fullHBres!,inputsub use channels, only : check_channels !use input, only : test_input use theo_manip, only : HB5_complete_theo, HB5_recalculate_theo_for_datapoint #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none !----------------------------------------output integer,intent(out):: HBresult,chan,ncombined double precision,intent(out) :: obsratio double precision :: Mhneut(np(Hneut)) double precision :: Mhch(np(Hplus)) !-------------------------------------internal integer :: n,i integer :: HBresult_tmp,chan_tmp,ncombined_tmp double precision :: obsratio_tmp !--------------------------------------------- ! n=1 ! print *, "Running HiggsBounds in Classic Mode (globally most sensitive limit only)" if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif ! do i=1,ubound(inputsub,dim=1) ! if( inputsub(i)%req .ne. inputsub(i)%stat )then ! write(*,*)'subroutine '//trim(adjustl(inputsub(i)%desc)) ! write(*,*)'should be called once and only once before each call to' ! write(*,*)'subroutine run_HiggsBounds.' ! stop 'error in subroutine run_HiggsBounds' ! endif ! inputsub(i)%stat=0!now we have used this input, set back to zero ! enddo call HB5_complete_theo do n=1,ndat theo(n)%particle(Hneut)%Mc = theo(n)%particle(Hneut)%M call get_mass_variation_param(n) IF (ndmh.GT.0) THEN if(np(Hneut).ne.0) Mhneut = theo(n)%particle(Hneut)%M if(np(Hplus).ne.0) Mhch = theo(n)%particle(Hplus)%M obsratio_tmp = 10.0E6 ! Set to very large initial value do i=1,dmhsteps**ndmh theo(n)%particle(Hneut)%M = diffMhneut(i,:) theo(n)%particle(Hplus)%M = diffMhch(i,:) if(debug)write(*,*)'manipulating input...' ; call flush(6) call HB5_recalculate_theo_for_datapoint(n) if(debug)write(*,*)'compare each data point to the experimental bounds...' ; call flush(6) call check_channels(theo(n),res(n),0) HBresult = res(n)%allowed95(1) chan = res(n)%chan(1) obsratio = res(n)%obsratio(1) ncombined = res(n)%ncombined(1) ! print *, HBresult, chan, obsratio, ncombined IF (.NOT.full_dmth_variation) THEN IF (HBresult.EQ.1) THEN ! theo(n)%particle(Hneut)%M = Mhneut ! theo(n)%particle(Hplus)%M = Mhch just_after_run=.True. exit ENDIF ELSE IF (obsratio.lt.obsratio_tmp) THEN HBresult_tmp = HBresult chan_tmp = chan obsratio_tmp = obsratio ncombined_tmp = ncombined ENDIF ENDIF enddo IF (full_dmth_variation) THEN HBresult = HBresult_tmp chan = chan_tmp obsratio = obsratio_tmp ncombined = ncombined ! theo(n)%particle(Hneut)%M = Mhneut ! theo(n)%particle(Hplus)%M = Mhch just_after_run=.True. ! return ENDIF theo(n)%particle(Hneut)%M = Mhneut theo(n)%particle(Hplus)%M = Mhch call HB5_recalculate_theo_for_datapoint(n) call check_channels(theo(n),res(n),0) ELSE if(debug)write(*,*)'manipulating input...' ; call flush(6) call HB5_recalculate_theo_for_datapoint(n) if(debug)write(*,*)'compare each data point to the experimental bounds...' ; call flush(6) call check_channels(theo(n),res(n),0) HBresult = res(n)%allowed95(1) chan = res(n)%chan(1) obsratio = res(n)%obsratio(1) ncombined = res(n)%ncombined(1) just_after_run=.True. ENDIF fullHBres(n)%allowed95=HBresult fullHBres(n)%chan=chan fullHBres(n)%obsratio=obsratio fullHBres(n)%ncombined=ncombined enddo just_after_run=.True. end subroutine run_HiggsBounds_classic !************************************************************ subroutine HiggsBounds_get_likelihood(analysisID, Hindex, nc, cbin, M, llh, obspred) !************************************************************ use usefulbits, only : theo,np,Hneut,Hplus use theo_manip, only : HB5_complete_theo use likelihoods, only : get_likelihood, calcpredratio_llh implicit none integer, intent(in) :: analysisID integer, intent(out) :: Hindex, nc, cbin double precision, intent(out) :: llh, M character(LEN=*), intent(in) :: obspred integer :: i double precision, allocatable :: expllh(:) ! double precision :: fact double precision, allocatable :: mass(:) ! predratio(:) integer, allocatable :: nclist(:) ! call complete_theo ! allocate(predratio(np(Hneut))) ! predratio = 0.0D0 ! write(*,*) "Calling HiggsBounds_get_likelihood..." allocate(expllh(np(Hneut)),mass(np(Hneut)),nclist(np(Hneut))) expllh = 0.0D0 ! select case(analysisID) ! case(14029) ! c=1 ! case(16037) ! c=2 ! case(170907242) ! c=3 ! case default ! stop 'Unknown analysisID in subroutine HiggsBounds_get_likelihood!' ! end select call HB5_complete_theo ! Determine most sensitive combination do i=1,np(Hneut) call get_likelihood(analysisID, i, theo(1), expllh(i), mass(i), nclist(i), cbin, 'pred') enddo Hindex = maxloc(expllh,dim=1) call get_likelihood(analysisID, Hindex, theo(1), llh, M, nc, cbin, obspred) deallocate(mass,nclist,expllh) !predratio end subroutine HiggsBounds_get_likelihood !************************************************************ subroutine HiggsBounds_get_combined_likelihood(analysisID, llh, obspred) !************************************************************ use usefulbits, only : theo,np,Hneut,Hplus, vsmall integer, intent(in) :: analysisID character(LEN=*), intent(in), optional :: obspred double precision, intent(out) :: llh double precision :: M, llh_tmp integer :: i, j, nc, cbin, Hindex, cbin_end, cbin_in write(*,*) 'WARNING: The subroutine HiggsBounds_get_combined_likelihood is NOT ' write(*,*) ' officially validated and approved. Use it on your own risk!' cbin_end = 0 do i= 1,np(Hneut) cbin_end = cbin_end + 2**(i-1) enddo llh = -1.0D0 cbin_in = 0 llh_tmp = 0.0D0 do while(cbin_in.lt.cbin_end) if(present(obspred)) then call HiggsBounds_get_likelihood_for_comb(analysisID, cbin_in, Hindex, nc, cbin, M, llh, obspred) else call HiggsBounds_get_likelihood_for_comb(analysisID, cbin_in, Hindex, nc, cbin, M, llh, 'obs') endif if(llh.ge.0.0D0) then llh_tmp = llh_tmp + llh else exit endif cbin_in = cbin_in + cbin enddo if(llh_tmp.gt.0.0D0) then llh = llh_tmp endif end subroutine HiggsBounds_get_combined_likelihood !************************************************************ subroutine HiggsBounds_get_likelihood_for_Higgs(analysisID, cbin_in, Hindex, nc, cbin, M, llh, obspred) !************************************************************ use usefulbits, only : theo,np,Hneut,Hplus use theo_manip, only : HB5_complete_theo use likelihoods, only : get_likelihood, calcpredratio_llh implicit none integer, intent(in) :: analysisID,Hindex integer, intent(out) :: nc, cbin double precision, intent(out) :: llh, M integer, intent(in) :: cbin_in character(LEN=*), intent(in) :: obspred integer :: i ! select case(analysisID) ! case(3316,14029) ! c=1 ! case default ! stop 'Unknown analysisID in subroutine HiggsBounds_get_likelihood_for_Higgs!' ! end select call HB5_complete_theo call get_likelihood(analysisID, Hindex, theo(1), llh, M, nc, cbin, obspred, cbin_in) end subroutine HiggsBounds_get_likelihood_for_Higgs !************************************************************ subroutine HiggsBounds_get_likelihood_for_comb(analysisID, cbin_in, Hindex, nc, cbin, M, llh, obspred) !************************************************************ use usefulbits, only : theo,np,Hneut,Hplus use theo_manip, only : HB5_complete_theo use likelihoods, only : get_likelihood, calcpredratio_llh implicit none integer, intent(in) :: analysisID, cbin_in integer, intent(out) :: Hindex, nc, cbin double precision, intent(out) :: llh, M character(LEN=*), intent(in) :: obspred integer :: i double precision, allocatable :: obsllh(:) double precision, allocatable :: mass(:) integer, allocatable :: nclist(:), cbinlist(:) allocate(obsllh(np(Hneut)),mass(np(Hneut)),nclist(np(Hneut)),cbinlist(np(Hneut))) obsllh = 0.0D0 ! select case(analysisID) ! case(3316,14029) ! c=1 ! case default ! stop 'Unknown analysisID in subroutine HiggsBounds_get_likelihood_for_comb!' ! end select call HB5_complete_theo ! Determine most sensitive combination do i=1,np(Hneut) call get_likelihood(analysisID, i, theo(1), obsllh(i), mass(i), nclist(i),cbinlist(i),obspred, cbin_in) enddo Hindex = maxloc(obsllh,dim=1) llh = obsllh(Hindex) M = mass(Hindex) nc = nclist(Hindex) cbin = cbinlist(Hindex) deallocate(mass,nclist,obsllh,cbinlist) end subroutine HiggsBounds_get_likelihood_for_comb !************************************************************ subroutine HiggsBounds_SLHA_output !**** ******************************************************** use usefulbits, only : whichinput,just_after_run use output, only : do_output if(.not.just_after_run)then stop 'subroutine run_HiggsBounds should be called before subroutine HiggsBounds_SLHA_output' endif select case(whichinput) case('SLHA') call do_output case default stop 'The subroutine HiggsBounds_SLHA_output should only be used when whichinput=SLHA' end select end subroutine HiggsBounds_SLHA_output #ifdef enableCHISQ !************************************************************ subroutine initialize_HiggsBounds_chisqtables ! use S95tables, only : S95_t2 use S95tables_type3 use usefulbits, only : allocate_if_stats_required,theo implicit none if(allocated(theo))then stop 'subroutine initialize_HiggsBounds_chisqtables should be called before subroutine HiggsBounds_initialize' elseif(allocated(clsb_t3))then stop 'subroutine initialize_HiggsBounds_chisqtables has already been called once' endif allocate(clsb_t3(ntable3)) call initializetables_type3_blank(clsb_t3) call initializetables3(clsb_t3) call readclsbfiles_binary if(allocated(allocate_if_stats_required))then stop 'error in subroutine initialize_HiggsBounds_chisqtables' else allocate(allocate_if_stats_required(1)) endif end subroutine initialize_HiggsBounds_chisqtables !************************************************************ subroutine finish_HiggsBounds_chisqtables !************************************************************ use S95tables_type3 use usefulbits, only : allocate_if_stats_required implicit none integer :: x if(.not.allocated(clsb_t3))then stop 'initialize_HiggsBounds_chisqtables should be called first' endif do x=lbound(clsb_t3,dim=1),ubound(clsb_t3,dim=1) deallocate(clsb_t3(x)%dat) enddo deallocate(filename) deallocate(clsb_t3) deallocate(allocate_if_stats_required) end subroutine finish_HiggsBounds_chisqtables !************************************************************ subroutine HB_calc_stats(theory_uncertainty_1s,chisq_withouttheory,chisq_withtheory,chan2) !************************************************************ ! this is in the middle of development! DO NOT USE! use usefulbits, only : res,theo,pr,just_after_run,vsmall use interpolate use S95tables_type1 use S95tables_type3 use S95tables use extra_bits_for_chisquared implicit none integer,intent(out)::chan2 integer :: x,c,z,y integer :: id double precision, intent(in) :: theory_uncertainty_1s double precision :: chisq_withouttheory,chisq_withtheory double precision :: low_chisq,sigma x=1 low_chisq=1.0D-2 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' elseif(.not.allocated(clsb_t3))then stop 'subroutine initialize_HiggsBounds_chisqtables must be called first' elseif(.not.just_after_run)then stop 'subroutine run_HiggsBounds must be called first' endif sigma=theory_uncertainty_1s if(sigma.lt.vsmall)then write(*,*)'Warning: will not calculate chi^2 with theory uncertainty' endif chisq_withtheory = -2.0D0 chisq_withouttheory = -2.0D0 z=2; c= res(x)%chan(z) chan2=c if(res(x)%allowed95(z).eq.-1)then! labels an unphysical parameter point chisq_withtheory =-1.0D0 chisq_withouttheory =-1.0D0 elseif( c.gt.0 )then ! labels a physical parameter point and a real channel id=S95_t1_or_S95_t2_idfromelementnumber(pr(c)%ttype,pr(c)%tlist) y=clsb_t3elementnumber_from_S95table(pr(c)%ttype,id) if(y.gt.0)then !------------------------------ call get_chisq(sigma,res(x)%axis_i(z),res(x)%axis_j(z),res(x)%sfactor(z), & & y,chisq_withouttheory,chisq_withtheory) !------------------------------- else write(*,*)'hello y=',y stop 'problem here with y' endif else chisq_withtheory =0.0D0 chisq_withouttheory =0.0D0 endif end subroutine HB_calc_stats #endif !************************************************************ subroutine finish_HiggsBounds ! This subroutine needs to be called right at the end, to close files ! and deallocate arrays !************************************************************ use usefulbits, only : deallocate_usefulbits,debug,theo,debug, & & file_id_debug1,file_id_debug2!,inputsub use S95tables, only : deallocate_S95tables use theory_BRfunctions, only : deallocate_BRSM use theory_XS_SM_functions, only: deallocate_XSSM #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif if(debug)then close(file_id_debug2) close(file_id_debug1) endif if(.not.allocated(theo))then stop 'HiggsBounds_initialize should be called first' endif if(debug)write(*,*)'finishing off...' ; call flush(6) call deallocate_BRSM call deallocate_XSSM call deallocate_S95tables call deallocate_usefulbits if(debug)write(*,*)'finished' ; call flush(6) ! if(allocated(inputsub)) deallocate(inputsub) end subroutine finish_HiggsBounds ! ! HB-5 additions ! Do we need control functions to guarantee all theory input is up-to-date and reset? !subroutine HB5_reset_input !end subroutine HB5_reset_input !************************************************************ ! ! SIMPLIFIED EFFC INPUT ROUTINES ! !************************************************************ subroutine HiggsBounds_neutral_input_effC_single(quantity,val) !************************************************************ use usefulbits, only : theo,np,Hneut,effC,whichinput,just_after_run!,inputsub implicit none !--------------------------------------------- character(LEN=*), intent(in) :: quantity double precision, intent(in) :: val(np(Hneut)) !-------------------------------------internal integer :: n ! integer :: subtype !--------------------------------------------- whichinput='effC' ! subtype=1 n=1 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 ! WHAT IS THIS DOING? if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_effC_single should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_effC_single' endif select case(trim(adjustl(quantity))) case("ghjcc_s") effC(n)%hjcc_s=val case("ghjcc_p") effC(n)%hjcc_p=val case("ghjss_s") effC(n)%hjss_s=val case("ghjss_p") effC(n)%hjss_p=val case("ghjbb_s") effC(n)%hjbb_s=val case("ghjbb_p") effC(n)%hjbb_p=val case("ghjtt_s") effC(n)%hjtt_s=val case("ghjtt_p") effC(n)%hjtt_p=val case("ghjmumu_s") effC(n)%hjmumu_s=val case("ghjmumu_p") effC(n)%hjmumu_p=val case("ghjtautau_s") effC(n)%hjtautau_s=val case("ghjtautau_p") effC(n)%hjtautau_p=val case("ghjWW") effC(n)%hjWW=val case("ghjZZ") effC(n)%hjZZ=val case("ghjZga") effC(n)%hjZga=val case("ghjgaga") effC(n)%hjgaga=val case("ghjgg") effC(n)%hjgg=val case default stop 'wrong input for quantity to subroutine HiggsBounds_neutral_input_effC_single' end select just_after_run=.False. end subroutine HiggsBounds_neutral_input_effC_single !************************************************************ subroutine HiggsBounds_neutral_input_effC_double(quantity,val) !************************************************************ use usefulbits, only : theo,np,Hneut,effC,whichinput,just_after_run!,inputsub implicit none !--------------------------------------------- character(LEN=*), intent(in) :: quantity double precision, intent(in) :: val(np(Hneut),np(Hneut)) !-------------------------------------internal integer :: n ! integer :: subtype !--------------------------------------------- whichinput='effC' ! subtype=1 n=1 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 ! WHAT IS THIS DOING? if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_effC_double should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_effC_double' endif select case(trim(adjustl(quantity))) case("ghjhiZ") effC(n)%hjhiZ = val case default stop 'wrong input for quantity to subroutine HiggsBounds_neutral_input_effC_double' end select just_after_run=.False. end subroutine HiggsBounds_neutral_input_effC_double !************************************************************ ! ! SIMPLIFIED LEP/HADRONIC XS INPUT ROUTINES ! !************************************************************ subroutine HiggsBounds_neutral_input_LEP_single(quantity,val) !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run!,inputsub implicit none !--------------------------------------------- character(LEN=*), intent(in) :: quantity double precision, intent(in) :: val(np(Hneut)) !-------------------------------------internal integer :: n ! integer :: subtype !--------------------------------------------- whichinput='hadr' ! subtype=1 n=1 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 ! WHAT IS THIS DOING? if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_LEP_single should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_LEP_single' endif select case(trim(adjustl(quantity))) case("XS_hjZ_ratio") theo(n)%lep%XS_hjZ_ratio = val case("XS_bbhj_ratio") theo(n)%lep%XS_bbhj_ratio = val case("XS_tautauhj_ratio") theo(n)%lep%XS_tautauhj_ratio = val case default stop 'wrong input for quantity to subroutine HiggsBounds_neutral_input_LEP_single' end select just_after_run=.False. end subroutine HiggsBounds_neutral_input_LEP_single !************************************************************ subroutine HiggsBounds_neutral_input_LEP_double(quantity,val) !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run!,inputsub implicit none !--------------------------------------------- character(LEN=*), intent(in) :: quantity double precision, intent(in) :: val(np(Hneut),np(Hneut)) !-------------------------------------internal integer :: n ! integer :: subtype !--------------------------------------------- whichinput='hadr' ! subtype=1 n=1 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 ! WHAT IS THIS DOING? if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_LEP_double should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_LEP_double' endif select case(trim(adjustl(quantity))) case("XS_hjhi_ratio") theo(n)%lep%XS_hjhi_ratio = val case default stop 'wrong input for quantity to subroutine HiggsBounds_neutral_input_LEP_double' end select just_after_run=.False. end subroutine HiggsBounds_neutral_input_LEP_double !************************************************************ subroutine HiggsBounds_neutral_input_hadr_single(collider,quantity,val) !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run, & & hadroncolliderdataset !,inputsub implicit none !--------------------------------------------- integer, intent(in) :: collider character(LEN=*), intent(in) :: quantity double precision, intent(in) :: val(np(Hneut)) !-------------------------------------internal integer :: n ! integer :: subtype ! type(hadroncolliderdataset) :: dataset !--------------------------------------------- whichinput='hadr' ! subtype=1 n=1 ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 ! WHAT IS THIS DOING? if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_hadr_single should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_hadr_single' endif select case(collider) case(2) call set_input(theo(n)%tev,quantity,val) case(7) call set_input(theo(n)%lhc7,quantity,val) case(8) call set_input(theo(n)%lhc8,quantity,val) case(13) call set_input(theo(n)%lhc13,quantity,val) case default stop 'wrong input for collider to subroutine HiggsBounds_neutral_input_hadr_single' end select just_after_run=.False. contains subroutine set_input(dataset,quantity,val) character(LEN=*), intent(in) :: quantity double precision, intent(in) :: val(np(Hneut)) type(hadroncolliderdataset) :: dataset select case(trim(adjustl(quantity))) case("XS_hj_ratio") dataset%XS_hj_ratio=val case("XS_gg_hj_ratio") dataset%XS_gg_hj_ratio=val case("XS_bb_hj_ratio") dataset%XS_bb_hj_ratio=val dataset%XS_hjb_ratio=val case("XS_vbf_ratio") dataset%XS_vbf_ratio=val case("XS_hjZ_ratio") dataset%XS_hjZ_ratio=val case("XS_gg_hjZ_ratio") dataset%XS_gg_hjZ_ratio=val case("XS_qq_hjZ_ratio") dataset%XS_qq_hjZ_ratio=val case("XS_hjW_ratio") dataset%XS_hjW_ratio=val case("XS_tthj_ratio") dataset%XS_tthj_ratio=val case("XS_thj_tchan_ratio") dataset%XS_thj_tchan_ratio=val case("XS_thj_schan_ratio") dataset%XS_thj_schan_ratio=val case default stop 'wrong input for quantity to subroutine HiggsBounds_neutral_input_hadr_single' end select end subroutine set_input end subroutine HiggsBounds_neutral_input_hadr_single !************************************************************ subroutine HiggsBounds_neutral_input_hadr_double(collider,quantity,val) !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run, & & hadroncolliderdataset! ,inputsub implicit none !--------------------------------------------- integer, intent(in) :: collider character(LEN=*), intent(in) :: quantity double precision, intent(in) :: val(np(Hneut),np(Hneut)) !-------------------------------------internal integer :: n !--------------------------------------------- whichinput='hadr' n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(np(Hneut).eq.0)then write(*,*)'subroutine HiggsBounds_neutral_input_hadr_double should' write(*,*)'only be called if np(Hneut)>0' stop 'error in subroutine HiggsBounds_neutral_input_hadr_double' endif select case(trim(adjustl(quantity))) case("XS_hjhi") select case(collider) case(2) theo(n)%tev%XS_hjhi=val case(7) theo(n)%lhc7%XS_hjhi=val case(8) theo(n)%lhc8%XS_hjhi=val case(13) theo(n)%lhc13%XS_hjhi=val case default stop 'wrong input for collider to subroutine HiggsBounds_neutral_input_hadr_double' end select case default stop 'wrong input for quantity to subroutine HiggsBounds_neutral_input_hadr_double' end select just_after_run=.False. end subroutine HiggsBounds_neutral_input_hadr_double !************************************************************ subroutine HiggsBounds_neutral_input_hadr_channelrates_single(collider,nHiggs,p,d,val) ! n.b.: Elements of the matrix channelrates with values < 0 will be overwritten ! by XS times BR using the narrow width approximation. !************************************************************ use usefulbits, only : theo,np,Hneut,whichinput,just_after_run,hadroncolliderdataset,& & Nprod,Ndecay #if defined(NAGf90Fortran) use F90_UNIX_IO, only : flush #endif implicit none double precision,intent(in) :: val integer, intent(in) :: collider,p,d,nHiggs !-------------------------------------internal integer :: n !--------------------------------------------- whichinput='hadr' n=1 if(.not.allocated(theo))then stop 'subroutine HiggsBounds_initialize must be called first' endif if(nHiggs.gt.np(Hneut))then write(*,*)'subroutine HiggsBounds_neutral_input_hadr_channelrates_single should' write(*,*)'only be called with nHiggs <= np(Hneut)' stop 'error in subroutine HiggsBounds_neutral_input_hadr_channelrates_single' endif select case(collider) case(2) theo(n)%tev%channelrates_tmp(nHiggs,p,d)=val case(7) theo(n)%lhc7%channelrates_tmp(nHiggs,p,d)=val case(8) theo(n)%lhc8%channelrates_tmp(nHiggs,p,d)=val case(13) theo(n)%lhc13%channelrates_tmp(nHiggs,p,d)=val case default stop 'wrong input for collider to subroutine HiggsBounds_neutral_input_hadr_channelrates_single' end select just_after_run=.False. end subroutine HiggsBounds_neutral_input_hadr_channelrates_single !************************************************************ subroutine HiggsBounds_neutral_input_hadr_channelrates_clean !************************************************************ use theo_manip,only : clean_channelrates implicit none call clean_channelrates end subroutine HiggsBounds_neutral_input_hadr_channelrates_clean !************************************************************ ! HB-4 legacy routines !************************************************************ ! subroutine HiggsBounds_neutral_input_effC(Mh,GammaTotal_hj, & ! & g2hjss_s,g2hjss_p,g2hjcc_s,g2hjcc_p, & ! & g2hjbb_s,g2hjbb_p,g2hjtoptop_s,g2hjtoptop_p, & ! & g2hjmumu_s,g2hjmumu_p, & ! & g2hjtautau_s,g2hjtautau_p, & ! & g2hjWW,g2hjZZ,g2hjZga, & ! & g2hjgaga,g2hjgg,g2hjggZ,g2hjhiZ_nHbynH, & ! & BR_hjinvisible,BR_hjhihi_nHbynH ) ! ! This subroutine can be called by the user after subroutine initialize_HiggsBounds ! ! has been called. ! ! Arguments (input): theoretical predictions (see manual for definitions) ! !************************************************************ ! use usefulbits, only : theo,np,Hneut,g2,whichinput,just_after_run!,inputsub ! ! #if defined(NAGf90Fortran) ! use F90_UNIX_IO, only : flush ! #endif ! ! implicit none ! ! !----------------------------------------input ! double precision,intent(in) :: Mh( np(Hneut) ),GammaTotal_hj( np(Hneut) ), & ! & g2hjss_s( np(Hneut) ),g2hjss_p( np(Hneut) ),g2hjcc_s( np(Hneut) ),g2hjcc_p( np(Hneut) ), & ! & g2hjbb_s( np(Hneut) ),g2hjbb_p( np(Hneut) ),g2hjtoptop_s( np(Hneut) ),g2hjtoptop_p( np(Hneut) ),& ! & g2hjmumu_s( np(Hneut) ),g2hjmumu_p( np(Hneut) ), & ! & g2hjtautau_s( np(Hneut) ),g2hjtautau_p( np(Hneut) ), & ! & g2hjWW( np(Hneut) ),g2hjZZ( np(Hneut) ),g2hjZga( np(Hneut) ), & ! & g2hjgaga( np(Hneut) ),g2hjgg( np(Hneut) ),g2hjggZ( np(Hneut) ),g2hjhiZ_nHbynH(np(Hneut),np(Hneut)),& ! & BR_hjinvisible( np(Hneut) ),BR_hjhihi_nHbynH(np(Hneut),np(Hneut)) ! !--------------------------------------internal ! integer :: n ! ! integer :: subtype ! !---------------------------------------------- ! ! whichinput='effC' ! ! subtype=1 ! n=1 ! ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 ! ! if(.not.allocated(theo))then ! stop 'subroutine HiggsBounds_initialize must be called first' ! endif ! ! if(np(Hneut).eq.0)then ! write(*,*)'subroutine HiggsBounds_neutral_input_effC should' ! write(*,*)'only be called if np(Hneut)>0' ! stop 'error in subroutine HiggsBounds_neutral_input_effC' ! endif ! ! theo(n)%particle(Hneut)%M = Mh ! theo(n)%particle(Hneut)%Mc = Mh ! theo(n)%particle(Hneut)%GammaTot= GammaTotal_hj ! ! g2(n)%hjss_s = g2hjss_s ! g2(n)%hjss_p = g2hjss_p ! g2(n)%hjcc_s = g2hjcc_s ! g2(n)%hjcc_p = g2hjcc_p ! g2(n)%hjbb_s = g2hjbb_s ! g2(n)%hjbb_p = g2hjbb_p ! g2(n)%hjtoptop_s = g2hjtoptop_s ! g2(n)%hjtoptop_p = g2hjtoptop_p ! g2(n)%hjmumu_s = g2hjmumu_s ! g2(n)%hjmumu_p = g2hjmumu_p ! g2(n)%hjtautau_s = g2hjtautau_s ! g2(n)%hjtautau_p = g2hjtautau_p ! ! g2(n)%hjWW = g2hjWW ! g2(n)%hjZZ = g2hjZZ ! g2(n)%hjZga = g2hjZga ! g2(n)%hjgaga = g2hjgaga ! g2(n)%hjgg = g2hjgg ! g2(n)%hjggZ = g2hjggZ ! ! g2(n)%hjhiZ = g2hjhiZ_nHbynH ! ! theo(n)%BR_hjinvisible = BR_hjinvisible ! theo(n)%BR_hjhihi = BR_hjhihi_nHbynH ! ! just_after_run=.False. ! ! end subroutine HiggsBounds_neutral_input_effC ! !************************************************************ ! subroutine HiggsBounds_neutral_input_part(Mh,GammaTotal_hj,CP_value, & ! & CS_lep_hjZ_ratio, & ! & CS_lep_bbhj_ratio,CS_lep_tautauhj_ratio, & ! & CS_lep_hjhi_ratio_nHbynH, & ! & CS_gg_hj_ratio,CS_bb_hj_ratio, & ! & CS_bg_hjb_ratio, & ! & CS_ud_hjWp_ratio,CS_cs_hjWp_ratio, & ! & CS_ud_hjWm_ratio,CS_cs_hjWm_ratio, & ! & CS_gg_hjZ_ratio, & ! & CS_dd_hjZ_ratio,CS_uu_hjZ_ratio, & ! & CS_ss_hjZ_ratio,CS_cc_hjZ_ratio, & ! & CS_bb_hjZ_ratio, & ! & CS_tev_vbf_ratio,CS_tev_tthj_ratio, & ! & CS_lhc7_vbf_ratio,CS_lhc7_tthj_ratio, & ! & CS_lhc8_vbf_ratio,CS_lhc8_tthj_ratio, & ! & BR_hjss,BR_hjcc, & ! & BR_hjbb,BR_hjmumu,BR_hjtautau, & ! & BR_hjWW,BR_hjZZ,BR_hjZga, BR_hjgaga,BR_hjgg, & ! & BR_hjinvisible,BR_hjhihi_nHbynH ) ! ! This subroutine can be called by the user after subroutine initialize_HiggsBounds ! ! has been called. ! ! (see manual for full description) ! !************************************************************ ! use usefulbits, only : theo,np,Hneut,partR,whichinput,just_after_run!,inputsub ! ! #if defined(NAGf90Fortran) ! use F90_UNIX_IO, only : flush ! #endif ! ! implicit none ! !----------------------------------------input ! double precision,intent(in) :: Mh( np(Hneut) ),GammaTotal_hj( np(Hneut) ) ! integer,intent(in) ::CP_value( np(Hneut) ) ! double precision,intent(in) :: CS_lep_hjZ_ratio( np(Hneut) ), & ! & CS_lep_bbhj_ratio( np(Hneut) ),CS_lep_tautauhj_ratio( np(Hneut) ), & ! & CS_lep_hjhi_ratio_nHbynH(np(Hneut),np(Hneut)), & ! & CS_gg_hj_ratio( np(Hneut) ),CS_bb_hj_ratio( np(Hneut) ), & ! & CS_bg_hjb_ratio( np(Hneut) ), & ! & CS_ud_hjWp_ratio( np(Hneut) ),CS_cs_hjWp_ratio( np(Hneut) ), & ! & CS_ud_hjWm_ratio( np(Hneut) ),CS_cs_hjWm_ratio( np(Hneut) ), & ! & CS_gg_hjZ_ratio( np(Hneut) ), & ! & CS_dd_hjZ_ratio( np(Hneut) ),CS_uu_hjZ_ratio( np(Hneut) ), & ! & CS_ss_hjZ_ratio( np(Hneut) ),CS_cc_hjZ_ratio( np(Hneut) ), & ! & CS_bb_hjZ_ratio( np(Hneut) ), & ! & CS_tev_vbf_ratio( np(Hneut) ),CS_tev_tthj_ratio( np(Hneut) ), & ! & CS_lhc7_vbf_ratio( np(Hneut) ),CS_lhc7_tthj_ratio( np(Hneut) ), & ! & CS_lhc8_vbf_ratio( np(Hneut) ),CS_lhc8_tthj_ratio( np(Hneut) ), & ! & BR_hjss( np(Hneut) ),BR_hjcc( np(Hneut) ), & ! & BR_hjbb( np(Hneut) ),BR_hjmumu( np(Hneut) ),BR_hjtautau( np(Hneut) ), & ! & BR_hjWW( np(Hneut) ),BR_hjZZ( np(Hneut) ),BR_hjZga( np(Hneut) ), & ! & BR_hjgaga( np(Hneut) ),BR_hjgg( np(Hneut) ), & ! & BR_hjinvisible( np(Hneut) ),BR_hjhihi_nHbynH(np(Hneut),np(Hneut)) ! !---------------------------------------internal ! integer :: n ! ! integer :: subtype ! !----------------------------------------------- ! ! whichinput='part' ! ! subtype=1 ! n=1 ! ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 ! ! if(.not.allocated(theo))then ! stop 'subroutine HiggsBounds_initialize must be called first' ! endif ! ! if(np(Hneut).eq.0)then ! write(*,*)'subroutine HiggsBounds_neutral_input_part should' ! write(*,*)'only be called if np(Hneut)>0' ! stop 'error in subroutine HiggsBounds_neutral_input_part' ! endif ! ! theo(n)%particle(Hneut)%M = Mh ! theo(n)%particle(Hneut)%Mc = Mh ! theo(n)%particle(Hneut)%GammaTot= GammaTotal_hj ! theo(n)%CP_value = CP_value ! theo(n)%lep%XS_hjZ_ratio = CS_lep_hjZ_ratio ! theo(n)%lep%XS_bbhj_ratio = CS_lep_bbhj_ratio ! theo(n)%lep%XS_tautauhj_ratio = CS_lep_tautauhj_ratio ! theo(n)%lep%XS_hjhi_ratio = CS_lep_hjhi_ratio_nHbynH ! partR(n)%gg_hj = CS_gg_hj_ratio ! partR(n)%qq_hj(5,:) = CS_bb_hj_ratio ! partR(n)%bg_hjb = CS_bg_hjb_ratio ! partR(n)%qq_hjWp(1,:) = CS_ud_hjWp_ratio ! partR(n)%qq_hjWp(2,:) = CS_cs_hjWp_ratio ! partR(n)%qq_hjWm(1,:) = CS_ud_hjWm_ratio ! partR(n)%qq_hjWm(2,:) = CS_cs_hjWm_ratio ! partR(n)%gg_hjZ(:) = CS_gg_hjZ_ratio ! partR(n)%qq_hjZ(1,:) = CS_dd_hjZ_ratio ! partR(n)%qq_hjZ(2,:) = CS_uu_hjZ_ratio ! partR(n)%qq_hjZ(3,:) = CS_ss_hjZ_ratio ! partR(n)%qq_hjZ(4,:) = CS_cc_hjZ_ratio ! partR(n)%qq_hjZ(5,:) = CS_bb_hjZ_ratio ! theo(n)%tev%XS_vbf_ratio = CS_tev_vbf_ratio ! theo(n)%tev%XS_tthj_ratio = CS_tev_tthj_ratio ! theo(n)%lhc7%XS_vbf_ratio = CS_lhc7_vbf_ratio ! theo(n)%lhc7%XS_tthj_ratio= CS_lhc7_tthj_ratio ! theo(n)%lhc8%XS_vbf_ratio = CS_lhc8_vbf_ratio ! theo(n)%lhc8%XS_tthj_ratio= CS_lhc8_tthj_ratio ! theo(n)%BR_hjss = BR_hjss ! theo(n)%BR_hjcc = BR_hjcc ! theo(n)%BR_hjbb = BR_hjbb ! theo(n)%BR_hjmumu = BR_hjmumu ! theo(n)%BR_hjtautau = BR_hjtautau ! theo(n)%BR_hjWW = BR_hjWW ! theo(n)%BR_hjZZ = BR_hjZZ ! theo(n)%BR_hjZga = BR_hjZga ! theo(n)%BR_hjgaga = BR_hjgaga ! theo(n)%BR_hjgg = BR_hjgg ! theo(n)%BR_hjinvisible = BR_hjinvisible ! theo(n)%BR_hjhihi = BR_hjhihi_nHbynH ! ! just_after_run=.False. ! ! end subroutine HiggsBounds_neutral_input_part ! !************************************************************ ! subroutine HiggsBounds_neutral_input_hadr(Mh,GammaTotal_hj,CP_value, & ! & CS_lep_hjZ_ratio, & ! & CS_lep_bbhj_ratio,CS_lep_tautauhj_ratio, & ! & CS_lep_hjhi_ratio_nHbynH, & ! & CS_tev_hj_ratio ,CS_tev_hjb_ratio, & ! & CS_tev_hjW_ratio,CS_tev_hjZ_ratio, & ! & CS_tev_vbf_ratio,CS_tev_tthj_ratio, & ! & CS_lhc7_hj_ratio ,CS_lhc7_hjb_ratio, & ! & CS_lhc7_hjW_ratio,CS_lhc7_hjZ_ratio, & ! & CS_lhc7_vbf_ratio,CS_lhc7_tthj_ratio, & ! & CS_lhc8_hj_ratio ,CS_lhc8_hjb_ratio, & ! & CS_lhc8_hjW_ratio,CS_lhc8_hjZ_ratio, & ! & CS_lhc8_vbf_ratio,CS_lhc8_tthj_ratio, & ! & BR_hjss,BR_hjcc, & ! & BR_hjbb, & ! & BR_hjmumu, & ! & BR_hjtautau, & ! & BR_hjWW,BR_hjZZ,BR_hjZga,BR_hjgaga, & ! & BR_hjgg, BR_hjinvisible, & ! & BR_hjhihi_nHbynH ) ! ! This subroutine can be called by the user after subroutine initialize_HiggsBounds ! ! has been called. ! ! (see manual for full description) ! !************************************************************ ! use usefulbits, only : theo,np,Hneut,whichinput,just_after_run!,inputsub ! ! #if defined(NAGf90Fortran) ! use F90_UNIX_IO, only : flush ! #endif ! ! implicit none ! !----------------------------------------input ! double precision,intent(in) :: Mh( np(Hneut) ),GammaTotal_hj( np(Hneut) ) ! integer,intent(in) :: CP_value( np(Hneut) ) ! double precision,intent(in) :: CS_lep_hjZ_ratio( np(Hneut) ), & ! & CS_lep_bbhj_ratio( np(Hneut) ),CS_lep_tautauhj_ratio( np(Hneut) ), & ! & CS_lep_hjhi_ratio_nHbynH(np(Hneut),np(Hneut)), & ! & CS_tev_hj_ratio( np(Hneut) ) ,CS_tev_hjb_ratio( np(Hneut) ), & ! & CS_tev_hjW_ratio( np(Hneut) ) ,CS_tev_hjZ_ratio( np(Hneut) ), & ! & CS_tev_vbf_ratio( np(Hneut) ) ,CS_tev_tthj_ratio( np(Hneut)), & ! & CS_lhc7_hj_ratio( np(Hneut) ),CS_lhc7_hjb_ratio( np(Hneut) ), & ! & CS_lhc7_hjW_ratio( np(Hneut) ),CS_lhc7_hjZ_ratio( np(Hneut) ), & ! & CS_lhc7_vbf_ratio( np(Hneut) ),CS_lhc7_tthj_ratio( np(Hneut)), & ! & CS_lhc8_hj_ratio( np(Hneut) ),CS_lhc8_hjb_ratio( np(Hneut) ), & ! & CS_lhc8_hjW_ratio( np(Hneut) ),CS_lhc8_hjZ_ratio( np(Hneut) ), & ! & CS_lhc8_vbf_ratio( np(Hneut) ),CS_lhc8_tthj_ratio( np(Hneut)), & ! & BR_hjss( np(Hneut) ),BR_hjcc( np(Hneut) ), & ! & BR_hjbb( np(Hneut) ), & ! & BR_hjmumu( np(Hneut) ),BR_hjtautau( np(Hneut) ), & ! & BR_hjWW( np(Hneut) ),BR_hjZZ( np(Hneut) ), & ! & BR_hjZga( np(Hneut) ),BR_hjgaga( np(Hneut) ), & ! & BR_hjgg( np(Hneut) ), BR_hjinvisible( np(Hneut) ), & ! & BR_hjhihi_nHbynH(np(Hneut),np(Hneut)) ! !-------------------------------------internal ! integer :: n ! ! integer :: subtype ! !--------------------------------------------- ! ! whichinput='hadr' ! ! subtype=1 ! n=1 ! ! inputsub(subtype)%stat=inputsub(subtype)%stat+1 ! ! if(.not.allocated(theo))then ! stop 'subroutine HiggsBounds_initialize must be called first' ! endif ! ! if(np(Hneut).eq.0)then ! write(*,*)'subroutine HiggsBounds_neutral_input_hadr should' ! write(*,*)'only be called if np(Hneut)>0' ! stop 'error in subroutine HiggsBounds_neutral_input_hadr' ! endif ! ! ! write(*,*) "DEBUG HB: before hadronic input. Mass is ",theo(n)%particle(Hneut)%M ! ! ! theo(n)%particle(Hneut)%M = Mh ! theo(n)%particle(Hneut)%Mc = Mh ! theo(n)%particle(Hneut)%GammaTot= GammaTotal_hj ! theo(n)%CP_value = CP_value ! theo(n)%lep%XS_hjZ_ratio = CS_lep_hjZ_ratio ! theo(n)%lep%XS_bbhj_ratio = CS_lep_bbhj_ratio ! theo(n)%lep%XS_tautauhj_ratio = CS_lep_tautauhj_ratio ! theo(n)%lep%XS_hjhi_ratio = CS_lep_hjhi_ratio_nHbynH ! theo(n)%tev%XS_hj_ratio = CS_tev_hj_ratio ! theo(n)%tev%XS_hjb_ratio = CS_tev_hjb_ratio ! theo(n)%tev%XS_hjW_ratio = CS_tev_hjW_ratio ! theo(n)%tev%XS_hjZ_ratio = CS_tev_hjZ_ratio ! theo(n)%tev%XS_vbf_ratio = CS_tev_vbf_ratio ! theo(n)%tev%XS_tthj_ratio = CS_tev_tthj_ratio ! theo(n)%lhc7%XS_hj_ratio = CS_lhc7_hj_ratio ! theo(n)%lhc7%XS_hjb_ratio = CS_lhc7_hjb_ratio ! theo(n)%lhc7%XS_hjW_ratio = CS_lhc7_hjW_ratio ! theo(n)%lhc7%XS_hjZ_ratio = CS_lhc7_hjZ_ratio ! theo(n)%lhc7%XS_vbf_ratio = CS_lhc7_vbf_ratio ! theo(n)%lhc7%XS_tthj_ratio = CS_lhc7_tthj_ratio ! theo(n)%lhc8%XS_hj_ratio = CS_lhc8_hj_ratio ! theo(n)%lhc8%XS_hjb_ratio = CS_lhc8_hjb_ratio ! theo(n)%lhc8%XS_hjW_ratio = CS_lhc8_hjW_ratio ! theo(n)%lhc8%XS_hjZ_ratio = CS_lhc8_hjZ_ratio ! theo(n)%lhc8%XS_vbf_ratio = CS_lhc8_vbf_ratio ! theo(n)%lhc8%XS_tthj_ratio = CS_lhc8_tthj_ratio ! theo(n)%BR_hjss = BR_hjss ! theo(n)%BR_hjcc = BR_hjcc ! theo(n)%BR_hjbb = BR_hjbb ! theo(n)%BR_hjmumu = BR_hjmumu ! theo(n)%BR_hjtautau = BR_hjtautau ! theo(n)%BR_hjWW = BR_hjWW ! theo(n)%BR_hjZZ = BR_hjZZ ! theo(n)%BR_hjZga = BR_hjZga ! theo(n)%BR_hjgaga = BR_hjgaga ! theo(n)%BR_hjgg = BR_hjgg ! theo(n)%BR_hjinvisible = BR_hjinvisible ! theo(n)%BR_hjhihi = BR_hjhihi_nHbynH ! ! just_after_run=.False. ! ! ! write(*,*) "DEBUG HB: filled hadronic input. Mass is ",theo(n)%particle(Hneut)%M ! ! end subroutine HiggsBounds_neutral_input_hadr !************************************************************ \ No newline at end of file Index: trunk/HiggsSignals-2/HiggsSignals_subroutines.F90 =================================================================== --- trunk/HiggsSignals-2/HiggsSignals_subroutines.F90 (revision 591) +++ trunk/HiggsSignals-2/HiggsSignals_subroutines.F90 (revision 592) @@ -1,2655 +1,2660 @@ !------------------------------------------------------------ ! 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(11,pathname_HS//"XScov.in",delta_rate%CScov, XSmodel) call read_matrix_from_file(11,pathname_HS//"XScovSM.in",delta_rate%CScovSM, XSSM) call read_matrix_from_file(11,pathname_HS//"XScov_13TeV.in",delta_rate%CS13cov, XSmodel) call read_matrix_from_file(11,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_rate_normalization(normalize_to_refmass, normalize_to_refmass_outside_dmtheo) use usefulbits_hs, only : normalize_rates_to_reference_position,& & normalize_rates_to_reference_position_outside_dmtheo implicit none logical, intent(in) :: normalize_to_refmass logical, intent(in) :: normalize_to_refmass_outside_dmtheo if(normalize_to_refmass) then write(*,*) "Using SM rate prediction at observed mass for signal strength calculation." else write(*,*) "Using SM rate prediction at predicted mass for signal strength calculation." endif if(normalize_to_refmass_outside_dmtheo) then write(*,*) "If predicted mass and observed mass do not agree within theory uncertainty:",& & " SM rate prediction at observed mass is used for signal strength calculation." else write(*,*) "If predicted mass and observed mass do not agree within theory uncertainty:",& & " SM rate prediction at predicted mass is used for signal strength calculation." endif normalize_rates_to_reference_position = normalize_to_refmass normalize_rates_to_reference_position_outside_dmtheo = normalize_to_refmass_outside_dmtheo end subroutine setup_rate_normalization !------------------------------------------------------------ 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(11,filename_XS,delta_rate%CScov, XSmodel) call read_matrix_from_file(11,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_assignmentrange_STXS(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_STXS implicit none double precision, intent(in) :: range if(range.le.0.0D0) then write(*,*) "Error: Bad assignment range ",range write(*,*) "Keeping the value ",assignmentrange_STXS else assignmentrange_STXS = range endif end subroutine setup_assignmentrange_STXS !------------------------------------------------------------ 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, pdf, & & 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.24D0 double precision :: dmbbtautau = 20.0D0 double precision :: dmWW = 5.0D0 double precision :: expmassrange, allowed_massrange 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) if(d.eq.4.or.d.eq.5) then expmassrange = dmbbtautau elseif(d.eq.2) then expmassrange = dmWW else if(pdf.eq.1) then expmassrange = dmobs else expmassrange = assignmentrange_LHCrun1*dmobs endif endif LHCrun1_rates(i)%r_pred = 0.0D0 ncomb = 0 do k=1,np(Hneut) if(pdf.eq.1) then allowed_massrange = expmassrange + t%particle(Hneut)%dM(k) else allowed_massrange = sqrt(expmassrange**2.0D0 + t%particle(Hneut)%dM(k)**2.0D0) endif if(abs(t%particle(Hneut)%M(k)-mobs).le.allowed_massrange ) 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, refmass double precision :: production_rate_scalefactor, decay_rate_scalefactor mass = t%particle(Hneut)%M(k) ! TS (17/10/2018): Take reference mass for SM-normalization at mobs+dmtheo box boundary. if(mass.ge.(mobs+dmtheo)) then refmass = mobs + dmtheo else if(mass.le.(mobs-dmtheo)) then refmass = mobs - dmtheo else refmass = mass endif !--- 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(refmass)+SMCS_lhc8_bb_H(refmass)) 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(refmass) 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(refmass) 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(refmass) 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(refmass) endif if(d.eq.1) then decay_rate = t%BR_hjgaga(k) decay_rate_scalefactor = SMBR_Hgamgam(mobs)/SMBR_Hgamgam(refmass) else if(d.eq.2) then decay_rate = t%BR_hjWW(k) decay_rate_scalefactor = SMBR_HWW(mobs)/SMBR_HWW(refmass) else if(d.eq.3) then decay_rate = t%BR_hjZZ(k) decay_rate_scalefactor = SMBR_HZZ(mobs)/SMBR_HZZ(refmass) else if(d.eq.4) then decay_rate = t%BR_hjtautau(k) decay_rate_scalefactor = SMBR_Htautau(mobs)/SMBR_Htautau(refmass) else if(d.eq.5) then decay_rate = t%BR_hjbb(k) decay_rate_scalefactor = SMBR_Hbb(mobs)/SMBR_Hbb(refmass) endif if(normalize_rates_to_reference_position) then signalrate = production_rate * decay_rate else ! This is the default: 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, print_STXS, & & get_number_of_STXS_observables, STXSlist, print_STXS_to_file use usefulbits, only : theo,just_after_run, ndat, vsmall use usefulbits_hs, only : HSres, output_level 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 if(output_level.eq.1) call print_STXS if(output_level.eq.3) then call print_STXS_to_file endif if(output_level.ne.0) then write(*,*) write(*,*) '#*************************************************************************#' write(*,*) '# HIGGSSIGNALS RESULTS (STXS observables) #' write(*,*) '#*************************************************************************#' write(*,'(A55,F21.8)') 'chi^2 (signal rate) from STXS observables = ',Chisq_STXS_rates write(*,'(A55,F21.8)') 'chi^2 (Higgs mass) from STXS observables = ',Chisq_STXS_mh write(*,'(A55,F21.8)') 'chi^2 (total) = ',Chisq_STXS write(*,'(A55,I21)') 'Number of STXS rate observables = ', nobs_STXS_rates write(*,'(A55,I21)') 'Number of STXS mass observables = ', nobs_STXS_mh write(*,'(A55,I21)') 'Number of STXS observables (total) = ', nobs_STXS write(*,'(A48,I3,A4,F21.8)') 'Probability (ndf =',nobs-Nparam,') = ', Pvalue write(*,*) '#*************************************************************************#' write(*,*) endif 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)),') -- peak observables #' write(*,*) '#*************************************************************************#' write(*,'(A55,F21.8)') 'chi^2 (signal strength) from peak observables = ',& & HSres(n)%Chisq_peak_mu write(*,'(A55,F21.8)') 'chi^2 (Higgs mass) from peak observables = ',HSres(n)%Chisq_peak_mh ! write(*,'(A55,F21.8)') 'chi^2 from mass-centered observables = ',HSres(n)%Chisq_mpred ! write(*,'(A55,F21.8)') 'chi^2 from signal strength peak observables (total) = ',HSres(n)%Chisq_mu write(*,'(A55,F21.8)') 'chi^2 (total) from peak observables = ',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 peak observables (total) = ',HSres(n)%nobs_peak write(*,'(A48,I3,A4,F21.8)') 'Probability (ndf =',HSres(n)%nobs-Nparam,') using peak observables = ',HSres(n)%Pvalue_peak 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 ! write(*,*) "Starting assignment procedure..." ! Do the iterative Higgs-to-peak-assignment here: call assign_Higgs_to_peaks_with_correlations(iterations) ! write(*,*) "Calculating chi^2..." call calculate_total_pc_chisq(totchisq, muchisq, mhchisq, nobs, Nmu, Nmh) ! write(*,*) "...done." 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 double precision :: rate_SMref,refmass,BR_SMref!,BR_SMref_mpeak double precision :: dynamicalmass, rate_SMdyn ! TS (17/10/2018: dynamicalmass is the default reference mass position for the SM normalization) if(size(mutab%mass,dim=1).eq.1) then refmass = mutab%mass(1) ! TS (17/10/2018): Take dynamical reference mass for SM-normalization at mobs+dmtheo box boundary. if(t%particle(mutab%particle_x)%M(j).ge.(mutab%mass(1)+t%particle(mutab%particle_x)%dM(j))) then dynamicalmass = mutab%mass(1) + t%particle(mutab%particle_x)%dM(j) else if(t%particle(mutab%particle_x)%M(j).le.(mutab%mass(1)-t%particle(mutab%particle_x)%dM(j))) then dynamicalmass = mutab%mass(1) - t%particle(mutab%particle_x)%dM(j) else dynamicalmass = t%particle(mutab%particle_x)%M(j) endif -! write(*,*) "debug, dynamicalmass = ",dynamicalmass +! write(*,*) "HS debug, dynamicalmass, refmass = ",dynamicalmass, refmass !--- else ! Only relevant for the mass-centered chi^2 method 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_SMdyn=XS_lhc7_gg_H_SM(dynamicalmass) - rate_SMref=XS_lhc7_gg_H_SM(refmass) + rate_SMdyn=XS_lhc7_gg_H_SM(dynamicalmass)+XS_lhc7_bb_H_SM(dynamicalmass) + rate_SMref=XS_lhc7_gg_H_SM(refmass)+XS_lhc7_bb_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_SMdyn=XS_lhc7_vbf_SM(dynamicalmass) 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_SMdyn=XS_lhc7_HW_SM(dynamicalmass) - rate_SMref=XS_lhc7_HW_SM(refmass) + rate_SMdyn=WH_nnlo(dynamicalmass,'LHC7 ',1.0D0,1.0D0,1.0D0,.True.,.True.) + rate_SMref=WH_nnlo(refmass,'LHC7 ',1.0D0,1.0D0,1.0D0,.True.,.True.) 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_SMdyn=XS_lhc7_HZ_SM(dynamicalmass) - rate_SMref=XS_lhc7_HZ_SM(refmass) + rate_SMdyn=ZH_cpmix_nnlo_ggqqbb(dynamicalmass,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) + rate_SMref=ZH_cpmix_nnlo_ggqqbb(refmass,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) 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_SMdyn=XS_lhc7_ttH_SM(dynamicalmass) 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_SMdyn=XS_lhc7_gg_H_SM(dynamicalmass) 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_SMdyn=XS_lhc7_bb_H_SM(dynamicalmass) 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_SMdyn=XS_lhc7_tH_tchan_SM(dynamicalmass) 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_SMdyn=XS_lhc7_tH_schan_SM(dynamicalmass) 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_SMdyn=ZH_cpmix_nnlo_qqbb(dynamicalmass,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) rate_SMref=ZH_cpmix_nnlo_qqbb(refmass,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) 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_SMdyn=ZH_cpmix_nnlo_gg(dynamicalmass,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) rate_SMref=ZH_cpmix_nnlo_gg(refmass,'LHC7 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) mutab%channel_description(i,1)='gg-HZ' else if(p.eq.0) then rate=1.0D0 SMrate=1.0D0 rate_SMdyn=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_SMdyn=XS_lhc8_gg_H_SM(dynamicalmass) - rate_SMref=XS_lhc8_gg_H_SM(refmass) + rate_SMdyn=XS_lhc8_gg_H_SM(dynamicalmass)+XS_lhc8_bb_H_SM(dynamicalmass) + rate_SMref=XS_lhc8_gg_H_SM(refmass)+XS_lhc8_bb_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_SMdyn=XS_lhc8_vbf_SM(dynamicalmass) 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_SMdyn=XS_lhc8_HW_SM(dynamicalmass) - rate_SMref=XS_lhc8_HW_SM(refmass) + rate_SMdyn=WH_nnlo(dynamicalmass,'LHC8 ',1.0D0,1.0D0,1.0D0,.True.,.True.) + rate_SMref=WH_nnlo(refmass,'LHC8 ',1.0D0,1.0D0,1.0D0,.True.,.True.) 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_SMdyn=XS_lhc8_HZ_SM(dynamicalmass) - rate_SMref=XS_lhc8_HZ_SM(refmass) + rate_SMdyn=ZH_cpmix_nnlo_ggqqbb(dynamicalmass,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) + rate_SMref=ZH_cpmix_nnlo_ggqqbb(refmass,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) 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_SMdyn=XS_lhc8_ttH_SM(dynamicalmass) rate_SMref=XS_lhc8_ttH_SM(refmass) mutab%channel_description(i,1)='ttH' else if(p.eq.6) then rate=t%lhc8%XS_gg_hj_ratio(j) SMrate=t%lhc8%XS_gg_H_SM(j) rate_SMdyn=XS_lhc8_gg_H_SM(dynamicalmass) rate_SMref=XS_lhc8_gg_H_SM(refmass) mutab%channel_description(i,1)='ggH' else if(p.eq.7) then rate=t%lhc8%XS_bb_hj_ratio(j) SMrate=t%lhc8%XS_bb_H_SM(j) rate_SMdyn=XS_lhc8_bb_H_SM(dynamicalmass) rate_SMref=XS_lhc8_bb_H_SM(refmass) mutab%channel_description(i,1)='bbH' else if(p.eq.8) then rate=t%lhc8%XS_thj_tchan_ratio(j) SMrate=t%lhc8%XS_tH_tchan_SM(j) rate_SMdyn=XS_lhc8_tH_tchan_SM(dynamicalmass) rate_SMref=XS_lhc8_tH_tchan_SM(refmass) mutab%channel_description(i,1)='tH (t-channel)' else if(p.eq.9) then rate=t%lhc8%XS_thj_schan_ratio(j) SMrate=t%lhc8%XS_tH_schan_SM(j) rate_SMdyn=XS_lhc8_tH_schan_SM(dynamicalmass) rate_SMref=XS_lhc8_tH_schan_SM(refmass) mutab%channel_description(i,1)='tH (s-channel)' else if(p.eq.10) then rate=t%lhc8%XS_qq_hjZ_ratio(j) SMrate=t%lhc8%XS_qq_HZ_SM(j) rate_SMdyn=ZH_cpmix_nnlo_qqbb(dynamicalmass,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) rate_SMref=ZH_cpmix_nnlo_qqbb(refmass,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) mutab%channel_description(i,1)='qq-HZ' else if(p.eq.11) then rate=t%lhc8%XS_gg_hjZ_ratio(j) SMrate=t%lhc8%XS_gg_HZ_SM(j) rate_SMdyn=ZH_cpmix_nnlo_gg(dynamicalmass,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) rate_SMref=ZH_cpmix_nnlo_gg(refmass,'LHC8 ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) mutab%channel_description(i,1)='gg-HZ' else if(p.eq.0) then rate=1.0D0 SMrate=1.0D0 rate_SMdyn=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_SMdyn=XS_lhc13_gg_H_SM(dynamicalmass) - rate_SMref=XS_lhc13_gg_H_SM(refmass) + rate_SMdyn=XS_lhc13_gg_H_SM(dynamicalmass)+XS_lhc13_bb_H_SM(dynamicalmass) + rate_SMref=XS_lhc13_gg_H_SM(refmass) + XS_lhc13_bb_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_SMdyn=XS_lhc13_vbf_SM(dynamicalmass) 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_SMdyn=XS_lhc13_HW_SM(dynamicalmass) - rate_SMref=XS_lhc13_HW_SM(refmass) + rate_SMdyn=WH_nnlo(dynamicalmass,'LHC13',1.0D0,1.0D0,1.0D0,.True.,.True.) + rate_SMref=WH_nnlo(refmass,'LHC13',1.0D0,1.0D0,1.0D0,.True.,.True.) 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_SMdyn=XS_lhc13_HZ_SM(dynamicalmass) - rate_SMref=XS_lhc13_HZ_SM(refmass) + rate_SMdyn=ZH_cpmix_nnlo_ggqqbb(dynamicalmass,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) + rate_SMref=ZH_cpmix_nnlo_ggqqbb(refmass,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) 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_SMdyn=XS_lhc13_ttH_SM(dynamicalmass) rate_SMref=XS_lhc13_ttH_SM(refmass) mutab%channel_description(i,1)='ttH' else if(p.eq.6) then rate=t%lhc13%XS_gg_hj_ratio(j) SMrate=t%lhc13%XS_gg_H_SM(j) rate_SMdyn=XS_lhc13_gg_H_SM(dynamicalmass) rate_SMref=XS_lhc13_gg_H_SM(refmass) mutab%channel_description(i,1)='ggH' else if(p.eq.7) then rate=t%lhc13%XS_bb_hj_ratio(j) SMrate=t%lhc13%XS_bb_H_SM(j) rate_SMdyn=XS_lhc13_bb_H_SM(dynamicalmass) rate_SMref=XS_lhc13_bb_H_SM(refmass) mutab%channel_description(i,1)='bbH' else if(p.eq.8) then rate=t%lhc13%XS_thj_tchan_ratio(j) SMrate=t%lhc13%XS_tH_tchan_SM(j) rate_SMdyn=XS_lhc13_tH_tchan_SM(dynamicalmass) rate_SMref=XS_lhc13_tH_tchan_SM(refmass) mutab%channel_description(i,1)='tH (t-channel)' else if(p.eq.9) then rate=t%lhc13%XS_thj_schan_ratio(j) SMrate=t%lhc13%XS_tH_schan_SM(j) rate_SMdyn=XS_lhc13_tH_schan_SM(dynamicalmass) rate_SMref=XS_lhc13_tH_schan_SM(refmass) mutab%channel_description(i,1)='tH (s-channel)' else if(p.eq.10) then rate=t%lhc13%XS_qq_hjZ_ratio(j) SMrate=t%lhc13%XS_qq_HZ_SM(j) rate_SMdyn=ZH_cpmix_nnlo_qqbb(dynamicalmass,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) rate_SMref=ZH_cpmix_nnlo_qqbb(refmass,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) mutab%channel_description(i,1)='qq-HZ' else if(p.eq.11) then rate=t%lhc13%XS_gg_hjZ_ratio(j) SMrate=t%lhc13%XS_gg_HZ_SM(j) rate_SMdyn=ZH_cpmix_nnlo_gg(dynamicalmass,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) rate_SMref=ZH_cpmix_nnlo_gg(refmass,'LHC13',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) mutab%channel_description(i,1)='gg-HZ' else if(p.eq.0) then rate=1.0D0 SMrate=1.0D0 rate_SMdyn=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_SMdyn=XS_tev_gg_H_SM(dynamicalmass) - rate_SMref=XS_tev_gg_H_SM(refmass) + rate_SMdyn=XS_tev_gg_H_SM(dynamicalmass)+XS_tev_bb_H_SM(dynamicalmass) + rate_SMref=XS_tev_gg_H_SM(refmass)+XS_tev_bb_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_SMdyn=XS_tev_vbf_SM(dynamicalmass) 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_SMdyn=XS_tev_HW_SM(dynamicalmass) - rate_SMref=XS_tev_HW_SM(refmass) + rate_SMdyn=WH_nnlo(dynamicalmass,'TEV ',1.0D0,1.0D0,1.0D0,.True.,.True.) + rate_SMref=WH_nnlo(refmass,'TEV ',1.0D0,1.0D0,1.0D0,.True.,.True.) 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_SMdyn=XS_tev_HZ_SM(dynamicalmass) - rate_SMref=XS_tev_HZ_SM(refmass) + rate_SMdyn=ZH_cpmix_nnlo_ggqqbb(dynamicalmass,'TEV ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) + rate_SMref=ZH_cpmix_nnlo_ggqqbb(refmass,'TEV ',1.0D0,1.0D0,1.0D0,0.0D0,0.0D0,.True.) 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_SMdyn=XS_tev_ttH_SM(dynamicalmass) 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_SMdyn=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_SMdyn=XS_lhc8_HW_SM(dynamicalmass) - rate_SMref=XS_lhc8_HW_SM(refmass) + rate_SMdyn=WH_nnlo(dynamicalmass,'LHC8 ',1.0D0,1.0D0,1.0D0,.True.,.True.) + rate_SMref=WH_nnlo(refmass,'LHC8 ',1.0D0,1.0D0,1.0D0,.True.,.True.) 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_SMdyn=XS_lhc8_HZ_SM(dynamicalmass) 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_SMdyn=XS_lhc8_ttH_SM(dynamicalmass) 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_SMdyn=1.0D0 rate_SMref=1.0D0 mutab%channel_description(i,1)='none' endif endif ! write(*,*) "DEBUG, after production mode, rate_SMdyn = ",rate_SMdyn !--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_SMdyn = rate_SMdyn*BRSM_Hgaga(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_HWW(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_HZZ(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_Htautau(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_Hbb(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_HZga(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_Hcc(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_Hmumu(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_Hgg(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_Hss(dynamicalmass) 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_SMdyn = rate_SMdyn*BRSM_Htoptop(dynamicalmass) 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_SMdyn = rate_SMdyn*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_SMdyn = ', rate, SMrate, rate_SMdyn ! 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) +! write(*,*) "DEBUG HS: normalize_rates_to_reference_position, mu = ",mutab%channel_mu(i,j) else ! mutab%channel_mu(i,j)=rate !! OLD WAY mutab%channel_mu(i,j)=rate*SMrate/(rate_SMdyn) !! NEW WAY (TS 17/10/2018) +! write(*,*) "DEBUG HS: not normalize_rates_to_reference_position, mu = ",mutab%channel_mu(i,j) 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 +! write(*,*) 'DEBUG HS: LHC13 = ', t%lhc13%XS_hj_ratio, t%lhc13%XS_vbf_ratio, t%lhc13%XS_hjW_ratio,& +! t%lhc13%XS_hjZ_ratio, t%lhc13%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 +! 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%mass(1)) + dummytable%mass(1) = theo(1)%particle(dummytable%particle_x)%M(ii) ! 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=*), 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%mass(1)) + dummytable%mass(1) = theo(1)%particle(dummytable%particle_x)%M(ii) ! 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 ! write(*,*) i, IDchannels_str(i) ! enddo do i=1,Nchannels posperiod = index(IDchannels_str(i),'.') ! write(*,*) 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 ! write(*,*) dummytable%channel_p_id(i), dummytable%channel_d_id(i) read(IDchannels_str(i)(:posperiod-1),*) dummytable%channel_p_id(i) read(IDchannels_str(i)(posperiod+1:),*) dummytable%channel_d_id(i) endif enddo +! write(*,*) dummytable%channel_p_id, dummytable%channel_d_id 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 !------------------------------------------------------------