*CMZ : 2.00/00 28/01/96 15.19.46 by A.Rozanov *CMZ : 1.30/07 15/02/95 00.29.13 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE LTSCAN *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. DIMENSION CERR(2,2) DO I=1,10 PRTFLG(I)=-1. ENDDO ALBNEW=ALBAR AMHNEW=300. CALL LTFITT(AMHNEW,ALBNEW,AMTFIT,ALSFIT,CERR,CHI2,NDF) AMTPL=DSQRT(CERR(1,1)) AMTMI=DSQRT(CERR(1,1)) ALSPL=DSQRT(CERR(2,2)) ALSMI=DSQRT(CERR(2,2)) WRITE(6,10778)AMHNEW,CHI2 WRITE(6,10779)AMTFIT,AMTPL,AMTMI WRITE(6,10780)ALSFIT,ALSPL,ALSMI 10778 FORMAT(1X,'MHIGGS = ',F10.1,' CHI2= ',F10.1) 10779 FORMAT(1X,'MTOP = ',F10.1,' + ',F10.1,' ',F10.1) 10780 FORMAT(1X,'ALSB = ',F10.4,' + ',F10.4,' ',F10.4) AMHNEW=60. CALL LTFITT(AMHNEW,ALBNEW,AMTFIT,ALSFIT,CERR,CHI2,NDF) AMHNEW=1000. CALL LTFITT(AMHNEW,ALBNEW,AMTFIT,ALSFIT,CERR,CHI2,NDF) END *CMZ : 2.00/02 03/07/98 19.37.43 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE LTFOUR *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,ZVALUE. COMMON/ZVALUE/ZZVM,ZZVA,ZZVR,ZZMH,ZZALSB *KEND. EXTERNAL ZVM,ZVA,ZVR DIMENSION PIN(3),RPIN(3,2),POUT(3),EPOUT(3,2) PARAMETER(NM4=25) DIMENSION TABL4(NM4),AMT4(NM4),DAMT4(NM4,2) DIMENSION ALSB4(NM4),DALSB4(NM4,2),CHI24(NM4) REAL*4 RDM,RDA,RDR,RAMT,RAM4,RAM5 DATA TABL4/0.,0.01,1.,10.,20.,30.,32.,34.,36.,38.,40., 1 42.,44.,46.,47.,48.,50.,60.,70.,80.,90.,100., 2 200.,500.,1000./ ALSBAR=0.125 WRITE(6,*)'MHIGGS, MTOP, VM, VA, VR' DO IAMH=1,3 IF(IAMH.EQ.1)AMH=60. IF(IAMH.EQ.2)AMH=300. IF(IAMH.EQ.3)AMH=1000. DO IAMT=100,250,25 AMT=IAMT T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 DM=VM(T,H,ALSBAR) DR=VRL(T,H,ALSBAR) DA=VAL(T,H,ALSBAR) WRITE(6,10030)AMH,AMT,DM,DA,DR 10030 FORMAT(2F7.1,3F10.5) ENDDO DO IAMT=100,250,1 AMT=IAMT T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 DM=VM(T,H,ALSBAR) DR=VRL(T,H,ALSBAR) DA=VAL(T,H,ALSBAR) RAMT=AMT+0.5 RDM=DM RDA=DA RDR=DR CALL HF1(201+3*(IAMH-1),RAMT,RDM) CALL HF1(202+3*(IAMH-1),RAMT,RDA) CALL HF1(203+3*(IAMH-1),RAMT,RDR) IF(IAMH.EQ.2)WRITE(6,*)IAMT,AMT,DM ENDDO ENDDO AMT=170. AMH=300. T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 WRITE(6,*)'MASS-4, DVM4, DVA4, DVR4' do i4=1,24 CALL LTSML4(TABL4(i4)) NG=1 CALL LTSNL4(NG) CALL LTSNQ4(NG) CALL LTSML4(TABL4(i4)) CALL LTSMQ4(TABL4(i4)) DM4=DVM4(T,ALSBAR) DR4=DVR4(T,ALSBAR) DA4=DVA4(T,ALSBAR) WRITE(6,10020)TABL4(I4),DM4,DA4,DR4 10020 FORMAT(F10.1,3F10.5) ENDDO do i4=300,500,5 AM4=I4/10. NG=1 CALL LTSNL4(NG) CALL LTSNQ4(NG) CALL LTSML4(AM4) CALL LTSMQ4(AM4) DM4=DVM4(T,ALSBAR) DR4=DVR4(T,ALSBAR) DA4=DVA4(T,ALSBAR) RAM4=AM4 RDM=DM4 RDA=DA4 RDR=DR4 write(6,*)'ram4,rdm,rda,rdr',ram4,rdm,rda,rdr CALL HF1(211,RAM4,RDM) CALL HF1(212,RAM4,RDA) CALL HF1(213,RAM4,RDR) ENDDO do i4=50,300 AM4=I4 NG=1 CALL LTSNL4(NG) CALL LTSNQ4(NG) CALL LTSML4(AM4) CALL LTSMQ4(AM4) DM4=DVM4(T,ALSBAR) DR4=DVR4(T,ALSBAR) DA4=DVA4(T,ALSBAR) RAM4=AM4 RDM=DM4 RDA=DA4 RDR=DR4 CALL HF1(221,RAM4,RDM) CALL HF1(222,RAM4,RDA) CALL HF1(223,RAM4,RDR) ENDDO WRITE(6,*)'AMB5,AMT5,X,DVM5,DVA5,DVR5' DO IMT5=400,800,400 AMT5=IMT5 DO IMB5=200,400,10 AMB5=IMB5 if(imb5.eq.400)AMB5=399.9 DM5=DVM5(AMB5,AMT5) DR5=DVR5(AMB5,AMT5) DA5=DVA5(AMB5,AMT5) WRITE(6,10040)AMB5,AMT5,DM5,DA5,DR5 10040 FORMAT(2F10.1,3F10.5) ENDDO ENDDO AMT5=400. DO IMB5=200,400,1 AMB5=IMB5 DM5=DVM5(AMB5,AMT5) DR5=DVR5(AMB5,AMT5) DA5=DVA5(AMB5,AMT5) RAM5=AMB5+0.5 RDM=DM5 RDA=DA5 RDR=DR5 CALL HF1(231,RAM5,RDM) CALL HF1(232,RAM5,RDA) CALL HF1(233,RAM5,RDR) ENDDO * calculate experimental values of VM,VA,VR EPS=0.0005 MAXF=10000 ZZMH=300. ZZALSB=0.125 *----------------------------------------------- amwmze=0.8814 damwmz=0.0021 VMexp=VM_MWMZ(amwmze) VMexp1=VM_MWMZ(amwmze+damwmz) VMexp2=VM_MWMZ(amwmze-damwmz) DVMexp=0.5*(VMexp1-VMexp2) ZZVM=VMexp CALL DZERO(90.,300.,AMT_VM,R,EPS,MAXF,ZVM) ZZVM=VMexp1 CALL DZERO(90.,300.,AMT_VM1,R,EPS,MAXF,ZVM) ZZVM=VMexp2 CALL DZERO(90.,300.,AMT_VM2,R,EPS,MAXF,ZVM) DAMT_VM=0.5*(AMT_VM1-AMT_VM2) write(6,*)'amwmze,damwmz',amwmze,damwmz write(6,10060)AMT_VM,AMT_VM1-AMT_VM,AMT_VM2-AMT_VM 10060 FORMAT(' MTVM = ',F10.1,2F8.1) write(6,*)'VMexp,DVMexp',VMexp,DVMexp T=(AMT_VM/AMZ)**2 H=(ZZMH/AMZ)**2 VMchk=VM(T,H,ALSBAR) WRITE(6,*)'VMchk',VMchk AMWZchk=AMWMZ(T,H,ALSBAR) WRITE(6,*)'AMWZchk',AMWZchk *-------------------------------------------------------------------- gvga=0.0711 dgvga=0.0020 VRexp=VR_GVGA(gvga) VRexp1=VR_GVGA(gvga+dgvga) VRexp2=VR_GVGA(gvga-dgvga) DVRexp=0.5*(VRexp1-VRexp2) ZZVR=VRexp CALL DZERO(10.,300.,AMT_VR,R,EPS,MAXF,ZVR) ZZVR=VRexp1 CALL DZERO(10.,300.,AMT_VR1,R,EPS,MAXF,ZVR) ZZVR=VRexp2 CALL DZERO(10.,300.,AMT_VR2,R,EPS,MAXF,ZVR) DAMT_VR=0.5*(AMT_VR1-AMT_VR2) GL=0.08398 DGL=0.00018 VAexp=VA_GL(GL,VRexp) VAexp1=VA_GL(GL+DGL,VRexp) VAexp2=VA_GL(GL-DGL,VRexp) VAexp3=VA_GL(GL,VRexp1) VAexp4=VA_GL(GL,VRexp2) DVAexp1=dabs(VAexp1-VAexp2)/2. DVAexp2=dabs(VAexp3-VAexp4)/2. DVAexp=dsqrt(DVAexp1**2+DVAexp2**2) ZZVA=VAexp CALL DZERO(10.,300.,AMT_VA,R,EPS,MAXF,ZVA) ZZVA=VAexp1 CALL DZERO(10.,300.,AMT_VA1,R,EPS,MAXF,ZVA) ZZVA=VAexp2 CALL DZERO(10.,300.,AMT_VA2,R,EPS,MAXF,ZVA) DAMT_VA=0.5*(AMT_VA1-AMT_VA2) write(6,*)'GL,DGL',GL,DGL write(6,10070)AMT_VA,AMT_VA1-AMT_VA,AMT_VA2-AMT_VA 10070 FORMAT(' MTVA = ',F10.1,2F8.1) write(6,*)'VAexp,DVAexp',VAexp,DVAexp T=(AMT_VA/AMZ)**2 H=(ZZMH/AMZ)**2 VAchk=VAL(T,H,ALSBAR) WRITE(6,*)'VAchk',VAchk write(6,*)'gvga,dgvga',gvga,dgvga write(6,10080)AMT_VR,AMT_VR1-AMT_VR,AMT_VR2-AMT_VR 10080 FORMAT(' MTVR = ',F10.1,2F8.1) write(6,*)'VRexp,DVRexp',VRexp,DVRexp T=(AMT_VR/AMZ)**2 H=(ZZMH/AMZ)**2 VRchk=VRL(T,H,ALSBAR) WRITE(6,*)'VRchk',VRchk call hropen(14,'LEPTOP','LEPTOP.HIST','N',1024) call hrout(0,icycle,' ') call hrend('LEPTOP') *-----fits do i4=1,NM4 CALL LTSML4(TABL4(i4)) NG=1 CALL LTSNL4(NG) CALL LTSNQ4(NG) * CALL LTSML4(47.D0) CALL LTSML4(TABL4(i4)) CALL LTSMQ4(TABL4(i4)) * CALL LTSML4( 0.D0) * CALL LTSMQ4( 0.D0) WRITE(6,*)'-----I4,ML4',I4,TABL4(I4) * ALBAR=1./128.99 * amb0=4.7-0.2 * write(6,*)'amb0',amb0 CALL LTINIT(1) * write(6,*)'1/albar',1./albar CALL LTFMTH(PIN,RPIN,POUT,EPOUT,CHIOUT) WRITE(6,10010) 1 POUT(1),EPOUT(1,1),EPOUT(1,2), 2 POUT(2),EPOUT(2,1),EPOUT(2,2),CHIOUT AMT4(I4)=POUT(1) DAMT4(I4,1)=EPOUT(1,1) DAMT4(I4,2)=EPOUT(1,2) ALSB4(I4)=POUT(2) DALSB4(I4,1)=EPOUT(2,1) DALSB4(I4,2)=EPOUT(2,2) CHI24(I4)=CHIOUT * ALBAR=1./128.75 * amb0=4.7+0.2 * write(6,*)'amb0',amb0 * CALL LTINIT(1) * write(6,*)'1/albar',1./albar * CALL LTFMTH(PIN,RPIN,POUT,EPOUT,CHIOUT) * WRITE(6,10010) * 1 POUT(1),EPOUT(1,1),EPOUT(1,2), * 2 POUT(2),EPOUT(2,1),EPOUT(2,2),CHIOUT 10010 FORMAT(F10.1,F10.1,F10.1, 1 F10.4,F10.4,F10.4,6HCHI2= ,F10.2) enddo ! i4 WRITE(6,*)'I, M4, MTOP +- EMTOP, ALSB +- EALSB, CHI2' DO I4=1,NM4 WRITE(6,10050)I4,TABL4(I4),AMT4(I4),DAMT4(I4,1),DAMT4(I4,2), 1 ALSB4(I4),DALSB4(I4,1),DALSB4(I4,2),CHI24(I4) 10050 FORMAT(I4,F10.2,F7.1,2F6.1,F8.4,2F7.4,F10.1) ENDDO END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ZVM(AMT,I) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,ZVALUE. COMMON/ZVALUE/ZZVM,ZZVA,ZZVR,ZZMH,ZZALSB *KEND. T=(AMT/AMZ)**2 H=(ZZMH/AMZ)**2 ZVM=ZZVM-VM(T,H,ZZALSB) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ZVA(AMT,I) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,ZVALUE. COMMON/ZVALUE/ZZVM,ZZVA,ZZVR,ZZMH,ZZALSB *KEND. T=(AMT/AMZ)**2 H=(ZZMH/AMZ)**2 ZVA=ZZVA-VAL(T,H,ZZALSB) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ZVR(AMT,I) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,ZVALUE. COMMON/ZVALUE/ZZVM,ZZVA,ZZVR,ZZMH,ZZALSB *KEND. T=(AMT/AMZ)**2 H=(ZZMH/AMZ)**2 ZVR=ZZVR-VRL(T,H,ZZALSB) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE LTSTRT *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. *-----initialisations DO I=1,10 PRTFLG(I)=-1. ENDDO CALL LTINIT(0) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE LTGLASGOW *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,SMITH. COMMON/SMITH/VOLOSHIN *KEND. * calculate tables for GLASGOW-94 conference AMT=175.D0 AMH=300.D0 ALSBAR=0.125D0 T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 AMWB=AMWMZB(T,H,ALSBAR)*AMZ WRITE(6,*)'A. BORN AMW= ',AMWB ALSBAR=0.000D0 VOLOSHIN=1.00D0 AMW_ONEL=AMWMZNOB(T,H,ALSBAR)*AMZ WRITE(6,*)'B. ALS=0,BAR=0,VOL=1. AMW= ',AMW_ONEL ALSBAR=0.125D0 AMW_ALALS=AMWMZNOB(T,H,ALSBAR)*AMZ WRITE(6,*)'C. BAR=0,VOL=1. AMW= ',AMW_ALALS ALSBAR=0.125D0 AMW_BARB=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'D. BAR=1,VOL=1. AMW= ',AMW_BARB ALSBAR=0.125D0 VOLOSHIN=0.35D0 AMW_SV=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'E. BAR=1,VOL=0.35 AMW= ',AMW_SV AMT=175.06D0 AMH=300.D0 ALSBAR=0.12433D0 T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 VOLOSHIN=0.35D0 * phtest=phitest(t,h,alsbar) write(6,*)'amt,amh,alsbar',amt,amh,alsbar AMW1SV=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'f. BAR=1,VOL=0.35 AMW= ',AMW1SV AMT=175.00D0 AMH=60.D0 ALSBAR=0.12500D0 T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 VOLOSHIN=0.35D0 write(6,*)'amt,amh,alsbar',amt,amh,alsbar AMW_SV=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'1. BAR=1,VOL=0.35 AMW= ',AMW_SV AMH=1000.D0 H=(AMH/AMZ)**2 write(6,*)'amt,amh,alsbar',amt,amh,alsbar AMW_SV=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'2. BAR=1,VOL=0.35 AMW= ',AMW_SV AMT=165.00D0 AMH= 300.D0 T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 write(6,*)'amt,amh,alsbar',amt,amh,alsbar AMW_SV=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'3. BAR=1,VOL=0.35 AMW= ',AMW_SV AMT=185.00D0 T=(AMT/AMZ)**2 write(6,*)'amt,amh,alsbar',amt,amh,alsbar AMW_SV=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'4. BAR=1,VOL=0.35 AMW= ',AMW_SV AMT=175.00D0 AMH=300.D0 T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 ALSBAR=0.12000D0 write(6,*)'amt,amh,alsbar',amt,amh,alsbar AMW_SV=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'5. BAR=1,VOL=0.35 AMW= ',AMW_SV ALSBAR=0.13000D0 write(6,*)'amt,amh,alsbar',amt,amh,alsbar AMW_SV=AMWMZ(T,H,ALSBAR)*AMZ WRITE(6,*)'6. BAR=1,VOL=0.35 AMW= ',AMW_SV END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE LTISOLINE *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,SMITH. COMMON/SMITH/VOLOSHIN *KEND. * calculate isolines for GLASGOW-94 conference emwmz=0.8798 demwmz=0.0021 gvga=0.0732 dgvga=0.0018 ga=0.5013 dga=0.0005 c=dsqrt(c2) vme=(emwmz-c)*32*pi*(c2-s2)*s2/(3*albar*c) vmp=(emwmz+demwmz-c)*32*pi*(c2-s2)*s2/(3*albar*c) vmn=(emwmz-demwmz-c)*32*pi*(c2-s2)*s2/(3*albar*c) vae=(ga-0.5)*64*pi*s2*c2/(3*albar) vap=(ga+dga-0.5)*64*pi*s2*c2/(3*albar) van=(ga-dga-0.5)*64*pi*s2*c2/(3*albar) vre=(gvga-1+4*s2)*4*pi*(c2-s2)/(3*albar) vrp=(gvga+dgvga-1+4*s2)*4*pi*(c2-s2)/(3*albar) vrn=(gvga-dgvga-1+4*s2)*4*pi*(c2-s2)/(3*albar) write(6,*)'VM = ',vme,' +- ',vmp,vmn write(6,*)'VA = ',vae,' +- ',vap,van write(6,*)'VR = ',vre,' +- ',vrp,vrn AMTMIN=50.D0 AMTMAX=250.D0 NAMT=100 AMTSTP=(AMTMAX-AMTMIN)/DFLOAT(NAMT) AMHMIN=0.000D0 AMHMAX=1000.0D0 NAMH=100 AMHSTP=(AMHMAX-AMHMIN)/DFLOAT(NAMH) CALL HBOOK2(31,'VM(Mtop, Mhiggs)',NAMT,AMTMIN,AMTMAX, 1 NAMH,AMHMIN,AMHMAX,0) CALL HBOOK2(32,'VA(Mtop, Mhiggs)',NAMT,AMTMIN,AMTMAX, 1 NAMH,AMHMIN,AMHMAX,0) CALL HBOOK2(33,'VR(Mtop, Mhiggs)',NAMT,AMTMIN,AMTMAX, 1 NAMH,AMHMIN,AMHMAX,0) ALSBAR=0.125D0 do iamt=1,namt do iamh=1,namh AMT=amtmin+(iamt-0.5)*amtstp AMH=amhmin+(iamh-0.5)*amhstp T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 vvm=vm(t,h,alsbar) vva=val(t,h,alsbar) vvr=vrl(t,h,alsbar) call hf2(31,amt,amh,vvm) call hf2(32,amt,amh,vva) call hf2(33,amt,amh,vvr) enddo enddo call hropen(12,'isolin','ISOLIN.HIST','N',1024) call hrout(31,icycle,' ') call hrout(32,icycle,' ') call hrout(33,icycle,' ') call hrend('isolin') END *CMZ : 2.00/03 08/09/98 21.57.28 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.40.56 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE LTCHCK *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,PAWC. REAL*4 PAW COMMON/PAWC/PAW(100000) *KEEP,TTBAR. COMMON/TTBAR/EPSIL *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEEP,TMINDV. COMMON/TMINDV/TMIN,DELTVM,DELTVA,DELTVR *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEEP,LBTABL. PARAMETER (NT=10) CHARACTER*16 TCH COMMON/LBTABL/TCH(NT),TEXP(NT,3),TMSM(NT,3),TBORN(NT,3), 1TCOR(NT,3),TDMT(NT,2),TMSM2(NT,3),TCOR2(NT,3),ECOR2(NT,3,2) 2,ttborn(nt) 3,t2born(nt,3) 4,EMSM(NT,3),EBORN(NT,3),TMSM_ALB(NT,3) *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. DIMENSION TLEP(3,NL) * DIMENSION TMON(3,NL) * DATA TMON/91.187 , 0.00000, 0.00000, * 2 2.488 , 0.0023 ,-0.0023 , * 3 41.47 , 0.01 ,-0.01 , * 4 20.76 ,-0.004 , 0.004 , * 5 0.0140 , 0.0006 ,-0.0006 , * 6 0.2155 ,-0.0005 , 0.0005 , * 7 0.000 , 0.0000 ,-0.0000 , * 8 0.137 , 0.0030 ,-0.0030 , * 9 0.138 , 0.0030 ,-0.0030 , * X 0.000 , 0.0000 ,-0.0000 , * 1 0.000 , 0.0000 ,-0.0000 , * 2 0.2324 ,-0.0004 , 0.0004 , * 3 0.0000 ,-0.0000 , 0.0000 , * 4 0.0000 ,-0.0000 , 0.0000 , * 5 0.0000 ,-0.0000 , 0.0000 , * 6 0.0000 ,-0.0000 , 0.0000 , * 7 0.0000 ,-0.0000 , 0.0000 / * DIMENSION WIDTHS(0:11) ** write(6,*)'open unit 7 zbardyn.table' ** ** open(7,file='zbardyn.table',status='OLD',form='FORMATTED') *-----initialise constants init(0) call LTINIT(0) prtflg(4)= 1. CALL DYBTAB * WRITE(6,*)'CHECK RUNNING MU2' * DO I=1,10 * ALS=0.080+0.01*I * VMU2=AMU(ALS)**2 * Q2=AMZ**2 * ALSPRI=ALSRUN(Q2,ALS) * WRITE(6,*)'ALS,MU2,ALSPRI= ',ALS,VMU2,ALSPRI * ENDDO * write(6,*)'start read zbardyn.table' *-----read output of ZFITTER ----------- * read(7,'(3F10.5)')TMASS,HMASS,ALFAS * DO INDF=0,11 * read(7,'(I10,F10.5)')I,WIDTHS(INDF) * ENDDO * DO IP=1,12 * read(7,'(I10,3F10.5)')I,TBRD(1,IP), * 1 TBRD(2,IP),TBRD(3,IP) * ENDDO * *-----normalise to D.Y..Bardine ZFIITER 4.6 * AMT=150.D0 * AMH=300. * ALSBAR=0.120 * T=(AMT/AMZ)**2 * H=(AMH/AMZ)**2 * GGNU=GNU(T,H,ALSBAR) * GGL=GL(T,H,ALSBAR) * GGELE=GELE(T,H,ALSBAR) * GGMUO=GMUO(T,H,ALSBAR) * GGTAU=GTAU(T,H,ALSBAR) * GGU=GU(T,H,ALSBAR) * GGD=GD(T,H,ALSBAR) * GGC=GC(T,H,ALSBAR) * GGS=GS(T,H,ALSBAR) * GGT=0.D0 * GGB=GB(T,H,ALSBAR) * GGH=GH(T,H,ALSBAR) * GGZ=GZ(T,H,ALSBAR) * WRITE(6,*)'Corrections to coincide with ZFITTER' * DO 10 I=1,31 * AMT=10.*(I-1) * T=(AMT/AMZ)**2 * WRITE(6,*)'AMT,T,TA(T),TR(T)',AMT,T,TA(T),TR(T) * 10 CONTINUE * DO 20 I=1,101 * AMH=10.*(I-1) * H=(AMH/AMZ)**2 * AMT=160. * T=(AMT/AMZ)**2 * WRITE(6,*)'AMH,VM,VAL,VRL',AMH,VM(T,H),VAL(T,H),VRL(T,H) * 20 CONTINUE * DO 22 I=1,101 * AMH=10.*(I-1) * H=(AMH/AMZ)**2 * AMT=160. * T=(AMT/AMZ)**2 * WRITE(6,*)'AMH,AMWMZ,GH,GB',AMH,AMWMZ(T,H),GH(T,H,0.126), * 1 GB(T,H,0.126) * 22 CONTINUE *-----check delta(V) functions * write(6,*)'t,h,ft(t),f1t(t),fh(t),f1h(t)', * 1 t,h,ft(t),f1t(t),fh(t),f1h(t) * write(6,*)'tm(t),ttm(t),ta(t),tta(t),tr(t),ttr(t)', * 1 tm(t),ttm(t),ta(t),tta(t),tr(t),ttr(t) * write(6,*)'hm(t),hhm(t),ha(t),hha(t),hr(t),hhr(t)', * 1 hm(t),hhm(t),ha(t),hha(t),hr(t),hhr(t) * * write(6,*)'iT,AMT,', * 1'DVM(T,H,ALSBAR),DDVM(T,ALSBAR),', * 1'DVA(T,H,ALSBAR),DDVA(T,ALSBAR),', * 1'DVR(T,H,ALSBAR),DDVR(T,ALSBAR)' * do it=90,250,10 * AMT=DFLOAT(it) * AMH=300. * ALSBAR=0.120 * T=(AMT/AMZ)**2 * H=(AMH/AMZ)**2 * write(6,'(I3,F8.1,6F10.3)')IT,AMT, * 1DVM(T,H,ALSBAR),DDVM(T,ALSBAR), * 1DVA(T,H,ALSBAR),DDVA(T,ALSBAR), * 1DVR(T,H,ALSBAR),DDVR(T,ALSBAR) * ENDDO *............................. * SML4= GML4(CM4) * SMQ4= GMQ4(CM4) * WRITE(6,*)'M4 deltaVm4 deltaVa4 deltaVr4' * DO IM4=1,29 * CM4=IM4+0. * CALL LTSML4(CM4) * CALL LTSMQ4(CM4) * DDVM4=DVML4(T,ALSBAR)+DVMQ4(T,ALSBAR) * DDVA4=DVAL4(T,ALSBAR)+DVAQ4(T,ALSBAR) * DDVR4=DVRL4(T,ALSBAR)+DVRQ4(T,ALSBAR) * WRITE(6,'(1X,F10.0,3F10.5)')CM4,DDVM4,DDVA4,DDVR4 * ENDDO * DO IM4=30,50 * CM4=IM4+0. * CALL LTSML4(CM4) * CALL LTSMQ4(CM4) * DDVM4=DVML4(T,ALSBAR)+DVMQ4(T,ALSBAR) * DDVA4=DVAL4(T,ALSBAR)+DVAQ4(T,ALSBAR) * DDVR4=DVRL4(T,ALSBAR)+DVRQ4(T,ALSBAR) * WRITE(6,'(1X,F10.0,3F10.5)')CM4,DDVM4,DDVA4,DDVR4 * ENDDO * DO IM4=50,100,10 * CM4=IM4+0. * CALL LTSML4(CM4) * CALL LTSMQ4(CM4) * DDVM4=DVML4(T,ALSBAR)+DVMQ4(T,ALSBAR) * DDVA4=DVAL4(T,ALSBAR)+DVAQ4(T,ALSBAR) * DDVR4=DVRL4(T,ALSBAR)+DVRQ4(T,ALSBAR) * WRITE(6,'(1X,F10.0,3F10.5)')CM4,DDVM4,DDVA4,DDVR4 * ENDDO * DO IM4=100,1000,100 * CM4=IM4+0. * CALL LTSML4(CM4) * CALL LTSMQ4(CM4) * DDVM4=DVML4(T,ALSBAR)+DVMQ4(T,ALSBAR) * DDVA4=DVAL4(T,ALSBAR)+DVAQ4(T,ALSBAR) * DDVR4=DVRL4(T,ALSBAR)+DVRQ4(T,ALSBAR) * WRITE(6,'(1X,F10.0,3F10.5)')CM4,DDVM4,DDVA4,DDVR4 * ENDDO * CALL LTSML4(SML4) * CALL LTSMQ4(SMQ4) *------------------------------------------------------------------- DO 301 IH=1,4 IF(IH.EQ.1)THEN AMH=100. ELSEIF(IH.EQ.2)THEN AMH=300. ELSEIF(IH.EQ.3)THEN AMH=750. ELSEIF(IH.EQ.4)THEN AMH=1000. ENDIF ALSBAR=0.120 AMT=150. T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 GGH=GH(T,H,ALSBAR) GGL=GL(T,H,ALSBAR) GGNU=GNU(T,H,ALSBAR) GGZ=GZ(T,H,ALSBAR) SIGGH=SIGH(T,H,ALSBAR) AFBG=AFB(T,H,ALSBAR) WRITE(6,*)'AMT,AMH,ALSBAR', 1 AMT,AMH,ALSBAR WRITE(6,*)'GGH,GGL,GGNU,GGZ', 1 GGH,GGL,GGNU,GGZ WRITE(6,*)'SIGGH,AFBG',SIGGH,AFBG write(6,*)'amt,amh,VM,VM-base,DVM,DDVM' write(6,'(2F6.1,4F12.3)')AMT,AMH, 1VM(T,H,ALSBAR),VM(T,H,ALSBAR)-DVM(T,H,ALSBAR), 1DVM(T,H,ALSBAR),DDVM(T,ALSBAR) write(6,*)'amt,amh,VA,VA-base,DVA,DDVA' write(6,'(2F6.1,4D12.3)')AMT,AMH, 1VAL(T,H,ALSBAR),VAL(T,H,ALSBAR)-DVA(T,H,ALSBAR), 1DVA(T,H,ALSBAR),DDVA(T,ALSBAR) write(6,*)'amt,amh,VR,VR-base,DVR,DDVR' write(6,'(2F6.1,4F12.3)')AMT,AMH, 1VRL(T,H,ALSBAR),VRL(T,H,ALSBAR)-DVR(T,H,ALSBAR), 1DVR(T,H,ALSBAR),DDVR(T,ALSBAR) WRITE(6,*)'--------------------------------------------------' 301 CONTINUE DO IAMT=1,3 WRITE(6,*)'*******************************' IF(IAMT.EQ.1)AMT=150.D0 IF(IAMT.EQ.2)AMT=160.D0 IF(IAMT.EQ.3)AMT=140.D0 AMH=300. ALSBAR=0.120 T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 GGNU=GNU(T,H,ALSBAR) GGL=GL(T,H,ALSBAR) GGELE=GELE(T,H,ALSBAR) GGMUO=GMUO(T,H,ALSBAR) GGTAU=GTAU(T,H,ALSBAR) GGU=GU(T,H,ALSBAR) GGD=GD(T,H,ALSBAR) GGC=GC(T,H,ALSBAR) GGS=GS(T,H,ALSBAR) GGT=0.D0 GGB=GB(T,H,ALSBAR) GGH=GH(T,H,ALSBAR) GGZ=GZ(T,H,ALSBAR) TLEP(IAMT,1)=AMZ TLEP(IAMT,2)=GGZ SIGGH=SIGH(T,H,ALSBAR) TLEP(IAMT,3)=SIGGH RRL=GGH/GGL TLEP(IAMT,4)=RRL AFBL=AFB(T,H,ALSBAR) TLEP(IAMT,5)=AFBL TLEP(IAMT,5)=AFBL RRB=GGB/GGH TLEP(IAMT,6)=RRB AMWZ=AMWMZ(T,H,ALSBAR) TLEP(IAMT,7)=AMWZ ATAU=ALE(T,H,ALSBAR) TLEP(IAMT,8)=ATAU TLEP(IAMT,9)=ATAU AFBB=AFBBB(T,H,ALSBAR) TLEP(IAMT,10)=AFBB AFBC=AFBCC(T,H,ALSBAR) TLEP(IAMT,11)=AFBC SIN2TE=QFB(T,H,ALSBAR) TLEP(IAMT,12)=SIN2TE GVGA=1.-4.*SIN2TE GA=GAELE(T,H,ALSBAR) GV=GVGA*GA SIN2TW=1.D0-AMWZ**2 WRITE(6,*)'AMT,AMH,ALSBAR', 1 AMT,AMH,ALSBAR WRITE(6,'(A10,F10.2)')'GGNU',GGNU*1000. WRITE(6,'(A10,F10.2)')'GGELE',GGELE*1000. WRITE(6,'(A10,F10.2)')'GGMUO',GGMUO*1000. WRITE(6,'(A10,F10.2)')'GGTAU',GGTAU*1000. WRITE(6,'(A10,F10.2)')'GGU',GGU*1000. WRITE(6,'(A10,F10.2)')'GGD',GGD*1000. WRITE(6,'(A10,F10.2)')'GGC',GGC*1000. WRITE(6,'(A10,F10.2)')'GGS',GGS*1000. WRITE(6,'(A10,F10.2)')'GGT',GGT*1000. WRITE(6,'(A10,F10.2)')'GGB',GGB*1000. WRITE(6,'(A10,F10.2)')'GGH',GGH*1000. WRITE(6,'(A10,F10.2)')'GGZ',GGZ*1000. WRITE(6,'(A10,F10.2)')'GGZ',GGZ*1000. WRITE(6,'(A10,F10.3)')'SIGGH',SIGGH WRITE(6,'(A10,F10.3)')'RRL',RRL WRITE(6,'(A10,F10.4)')'AFBL',AFBL WRITE(6,'(A10,F10.4)')'RRB',RRB WRITE(6,'(A10,F10.5)')'AMWZ',AMWZ WRITE(6,'(A10,F10.5)')'ATAU ',ATAU WRITE(6,'(A10,F10.5)')'ATAU ',ATAU WRITE(6,'(A10,F10.4)')'AFBB',AFBB WRITE(6,'(A10,F10.4)')'AFBC',AFBC WRITE(6,'(A10,F10.5)')'SIN2TE',SIN2TE WRITE(6,'(A10,F10.2)')'GGL',GGL*1000. WRITE(6,'(A10,F10.5)')'SIN2TW',SIN2TW WRITE(6,'(A10,F10.5)')'GVGA ',GVGA WRITE(6,'(A10,F10.5)')'GV ',GV WRITE(6,'(A10,F10.5)')'GA ',GA ENDDO DO IP=1,NL WRITE(6,'(A10,5F10.5)')CHLEP(IP),VLEP(IP),ELEP(IP),TLEP(1,IP), 1 TLEP(2,IP)-TLEP(1,IP),TLEP(3,IP)-TLEP(1,IP) ENDDO WRITE(6,*)'--------------------------------------------------' * AMH=300. * H=(AMH/AMZ)**2 * ALSBAR=0.120 * WRITE(6,*)'ALSBAR,AMH',ALSBAR,AMH * do imt=40,200 * AMT=DFLOAT(IMT) * T=(AMT/AMZ)**2 * GGL=GL(T,H,ALSBAR) * GGH=GH(T,H,ALSBAR) * RRL=GGH/GGL * WRITE(6,'(4F10.5)')AMT,GGH,GGL,RRL * ENDDO * ALSBAR=0.11761 * WRITE(6,*)'ALSBAR,AMH',ALSBAR,AMH * do imt=40,200 * AMT=DFLOAT(IMT) * T=(AMT/AMZ)**2 * GGL=GL(T,H,ALSBAR) * GGH=GH(T,H,ALSBAR) * RRL=GGH/GGL * WRITE(6,'(4F10.5)')AMT,GGH,GGL,RRL * ENDDO * ******************************************************************** END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : * SUBROUTINE LTBOOK *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,PAWC. REAL*4 PAW COMMON/PAWC/PAW(100000) *KEND. real*4 AMTMIN,AMTMAX,ALSMIN,ALSMAX,AMHMIN,AMHMAX CALL HLIMIT(100000) call hbook1(104,'mt,als,MH',100,0.5,100.5,0.) ALSMIN=0.080D0 ALSMAX=0.160D0 NALS=50 ALSSTP=(ALSMAX-ALSMIN)/NALS AMTMIN=50.D0 AMTMAX=250.D0 NAMT=100 AMTSTP=(AMTMAX-AMTMIN)/DFLOAT(NAMT) do i=1,3 CALL HBOOK2(10+i,'Mtop versus Alphas',NAMT,AMTMIN,AMTMAX, 1 NALS,ALSMIN,ALSMAX,0) enddo AMHMIN=0.000D0 AMHMAX=1000.0D0 NAMH=100 AMHSTP=(AMHMAX-AMHMIN)/DFLOAT(NAMH) * AMTMIN=50.D0 * AMTMAX=250.D0 * NAMT=100 * AMTSTP=(AMTMAX-AMTMIN)/NAMT CALL HBOOK2(20,'Mtop versus Mhiggs',NAMT,AMTMIN,AMTMAX, 1 NAMH,AMHMIN,AMHMAX,0) *----------------------------------------------------------------- CALL HBOOK1(201,'VM',150,100.,250.,0.) CALL HBOOK1(202,'VA',150,100.,250.,0.) CALL HBOOK1(203,'VR',150,100.,250.,0.) CALL HBOOK1(204,'VM',150,100.,250.,0.) CALL HBOOK1(205,'VA',150,100.,250.,0.) CALL HBOOK1(206,'VR',150,100.,250.,0.) CALL HBOOK1(207,'VM',150,100.,250.,0.) CALL HBOOK1(208,'VA',150,100.,250.,0.) CALL HBOOK1(209,'VR',150,100.,250.,0.) CALL HBOOK1(211,'VM',40,30.,50.,0.) CALL HBOOK1(212,'VA',40,30.,50.,0.) CALL HBOOK1(213,'VR',40,30.,50.,0.) CALL HBOOK1(221,'VM',250,50.,300.,0.) CALL HBOOK1(222,'VA',250,50.,300.,0.) CALL HBOOK1(223,'VR',250,50.,300.,0.) CALL HBOOK1(231,'VM',200,200.,400.,0.) CALL HBOOK1(232,'VA',200,200.,400.,0.) CALL HBOOK1(233,'VR',200,200.,400.,0.) END *CMZ : 2.00/02 03/07/98 18.44.31 by A.Rozanov *CMZ : 1.30/07 18/02/95 00.59.31 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : *------------------------------------------------------------------- SUBROUTINE LTFMTH(PIN,RPIN,POUT,EPOUT,CHIOUT) *------------------------------------------------------------------- *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. CHARACTER*10 CHTITL,CHALB REAL*4 AMTMIN,AMTMAX,ALSMIN,ALSMAX,AMHMIN,AMHMAX REAL*4 R4,AMS,AMHS,ALSBAS,CHI2S DIMENSION PIN(3),RPIN(3,2),POUT(3),EPOUT(3,2) EXTERNAL FCNLB CHARACTER*10 PNAM(3) PARAMETER (NPT=30) DIMENSION NPRM(3),VSTRT(3),STP(3),ARGLIS(6),XPT(NPT),YPT(NPT) DIMENSION VSTRT2(3) DIMENSION X(3),CH2(100,100),FLEPO(NL),AMTLEP(NL),EMTLEP(NL) DIMENSION EMTPOS(NL),EMTNEG(NL) DIMENSION AMHIGG(3),AMTF(3),DAMT1(3),DAMT2(3) DIMENSION CHI2F(3),ALSF(3),DALS1(3),DALS2(3) DIMENSION EMAT(2,2,3) PARAMETER(NAMHIG=3) LOGICAL LCONT LOGICAL HEXIST DATA AMHIGG/300.,60.,1000./ DATA NPRM/ 1 , 2 , 3 / DATA PNAM/'MT','ALS','MH'/ DATA VSTRT/150.D0,0.125D0,300.D0/ * DATA VSTRT/150.D0,0.120D0, 300.D0/ DATA STP/10.D0,0.01D0,10.D0/ LCONT=.FALSE. ! not to produce contours * LCONT=.TRUE. ! to produce contours * initialize open(UNIT=19,STATUS='SCRATCH') CALL MNINIT(5,19,7) * switch off the output ARGLIS(1)=-1. CALL MNEXCM(FCNLB,'SET PRIntout',ARGLIS,1,IERFLG) ZERO=0.D0 DO 777 IMH=1,NAMHIG if(prtflg(2).gt.0.)then WRITE(6,*)'****************************************************' WRITE(6,*)'IMH,AMHIGG= ',IMH,AMHIGG(IMH) WRITE(6,*)'****************************************************' endif VSTRT(3)=AMHIGG(IMH) CALL MNPARM(1,PNAM(1),VSTRT(1),STP(1),5.D0,1.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 1' ENDIF CALL MNPARM(2,PNAM(2),VSTRT(2),STP(2),0.D0,1.D0,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNPARM(3,PNAM(3),VSTRT(3),STP(3),5.D0,2.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNSETI('Fit mass of the top and strong coupling constant') ARGLIS(1)=1. CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) ARGLIS(1)=3. CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) *********************************************** * for gluon free fit * fix als * ARGLIS(1)=2. * CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) *********************************************** ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SET PRINT',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'MIGRAD',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'HES',ARGLIS,1,IERFLG) * ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SHOW ERR',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,0,IERFLG) *---------------------------------------------------------- if(prtflg(2).gt.0.)then CALL PRTERR endif CALL MNSTAT(FMIN,FEDM,ERRDEF,NPARI,NPARX,ISTAT) CHI2F(IMH)=FMIN CALL MNPOUT(1,CHNAM,VALUE ,ERROR,BND1,BND2,IVARBL) CALL MNERRS(1,EPLUS,EMINUS,EPARAB,GLOBCC) AMTF(IMH)=VALUE DAMT1(IMH)=EPLUS DAMT2(IMH)=EMINUS CALL MNPOUT(2,CHNAM,VALUE ,ERROR,BND1,BND2,IVARBL) CALL MNERRS(2,EPLUS,EMINUS,EPARAB,GLOBCC) ALSF(IMH)=VALUE DALS1(IMH)=EPLUS DALS2(IMH)=EMINUS CALL MNEMAT(EMAT(1,1,IMH),2) ARGLIS(1)=3. CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) IF(LCONT)THEN C-----plot contour---------------------------------- ARGLIS(1)=1. ARGLIS(2)=2. CALL MNEXCM(FCNLB,'CONT',ARGLIS,2,IERFLG) ARGLIS(2)=0. CALL MNCONT(FCNLB,1,2,NPT,XPT,YPT,NFOUND,0) ARGLIS(1)=4. CALL MNEXCM(FCNLB,'SET ERR',ARGLIS,1,IERFLG) CALL MNCONT(FCNLB,1,2,NPT,XPT,YPT,NFOUND,0) *--------------------------------------------------- ARGLIS(1)=1. CALL MNEXCM(FCNLB,'SET ERR',ARGLIS,1,IERFLG) IFLAG=2 CALL MNSTAT(CHIMIN,FEDM,ERRDEF,NPARI,NPARX,ISTAT) CALL HGIVE(11,CHTITL,NAMT,AMTMIN,AMTMAX,NALS,ALSMIN,ALSMAX,NWT,LO) CALL HGIVE(20,CHTITL,NAMT,AMTMIN,AMTMAX,NAMH,AMHMIN,AMHMAX,NWT,LO) AMTSTP=(AMTMAX-AMTMIN)/NAMT ALSSTP=(ALSMAX-ALSMIN)/NALS AMHSTP=(AMHMAX-AMHMIN)/NAMH DO 101 IALS=1,NALS ALSBAR=ALSMIN+(DFLOAT(IALS-1)+0.5)*ALSSTP ALSBAS=ALSBAR DO 102 IAMT=1,NAMT AMT=AMTMIN+(DFLOAT(IAMT-1)+0.5)*AMTSTP AMS=AMT X(1)=AMT X(2)=ALSBAR X(3)=VSTRT(3) * WRITE(6,*)IALS,IAMT,X CALL FCNLB(NPAR,GIN,F,X,IFLAG) CHI2S=F-CHIMIN * WRITE(6,*)'AMS,ALSBAS,CHI2S', * 1 AMS,ALSBAS,CHI2S id=10+IMH CALL HF2(id,AMS,ALSBAS,CHI2S) * IF(CHI2S.LE.CHIMIN+1)CALL HF2(id,AMS,ALSBAS,1.) * IF(CHI2S.GT.CHIMIN+4.AND.CHI2S.LE.CHIMIN+9) * 1 CALL HF2(id,AMS,ALSBAS,3.) * IF(CHI2S.GT.CHIMIN+16.AND.CHI2S.LE.CHIMIN+25) * 1 CALL HF2(id,AMS,ALSBAS,5.) * IF(CHI2S.GT.CHIMIN+36.AND.CHI2S.LE.CHIMIN+49) * 1 CALL HF2(id,AMS,ALSBAS,7.) * IF(CHI2S.GT.CHIMIN+64) * 1 CALL HF2(id,AMS,ALSBAS,9.) 102 CONTINUE 101 CONTINUE CALL HPRINT(id) * CALL HRESET(1,' ') *---------------------------------------------------------------- ENDIF ! lcont IF(IMH.GT.1)GO TO 777 CALL MNPOUT(2,CHALB,ALSBAR,EALSBA,BND1,BND2,IVAR) c-----made 2-parameter fit MT-MH CALL MNPARM(2,PNAM(2),ALSF(1),STP(2),0.D0,1.D0,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF ARGLIS(1)=1. CALL MNEXCM(FCNLB,'SET ERR',ARGLIS,1,IERFLG) ARGLIS(1)=2. CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) ARGLIS(1)=3. CALL MNEXCM(FCNLB,'RELEASE',ARGLIS,1,IERFLG) ZERO=0. * DO 12 I=1,3 * CALL MNPARM(NPRM(I),PNAM(I),VSTRT(I),STP(I),ZERO,ZERO,IERFLG) * IF(IERFLG.NE.0)THEN * WRITE(6,*)'UNABLE TO DEFINE PARAMETER',I * ENDIF * 12 CONTINUE ARGLIS(1)=1. CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'MIGRAD',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'HES',ARGLIS,1,IERFLG) * ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SHOW ERR',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,0,IERFLG) * Mtop CALL MNPOUT(1,CHNAM,VALUE ,ERROR,BND1,BND2,IVARBL) R4=VALUE call hf1(104,41.,R4) CALL MNERRS(1,EPLUS,EMINUS,EPARAB,GLOBCC) * alphas CALL MNPOUT(2,CHNAM,VALUE ,ERROR,BND1,BND2,IVARBL) R4=VALUE call hf1(104,42.,R4) CALL MNERRS(2,EPLUS,EMINUS,EPARAB,GLOBCC) * Mhiggs CALL MNPOUT(3,CHNAM,VALUE ,ERROR,BND1,BND2,IVARBL) R4=VALUE call hf1(104,43.,R4) CALL MNERRS(3,EPLUS,EMINUS,EPARAB,GLOBCC) c-----made 2-parameter fit ARGLIS(1)=3. CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) IF(PRTFLG(2).GT.0.)THEN CALL PRTERR ENDIF IF(LCONT)THEN C-----plot contour--------------------------------- ARGLIS(1)=1. ARGLIS(2)=2. CALL MNEXCM(FCNLB,'CONT',ARGLIS,2,IERFLG) ARGLIS(2)=0. CALL MNCONT(FCNLB,1,2,NPT,XPT,YPT,NFOUND,0) ARGLIS(1)=4. CALL MNEXCM(FCNLB,'SET ERR',ARGLIS,1,IERFLG) CALL MNCONT(FCNLB,1,2,NPT,XPT,YPT,NFOUND,0) ARGLIS(1)=1. CALL MNEXCM(FCNLB,'SET ERR',ARGLIS,1,IERFLG) IFLAG=2 * CALL MNSTAT(CHIMIN,FEDM,ERRDEF,NPARI,NPARX,ISTAT) CHIMIN=9999999999. DO 201 IAMH=1,NAMH AMH=AMHMIN+(IAMH-1)*AMHSTP AMHS =AMH DO 202 IAMT=1,NAMT AMT=AMTMIN+(IAMT-1)*AMTSTP AM=AMT X(1)=AMT X(2)=ALSBAR X(3)=AMH CALL FCNLB(NPAR,GIN,F,X,IFLAG) CH2(IAMT,IAMH)=F IF(F.LT.CHIMIN)THEN CHIMIN=F ITMIN=IAMT IHMIN=IAMH ENDIF 202 CONTINUE 201 CONTINUE if(prtflg(2).gt.0.)then WRITE(6,*)'ITMIN,IHMIN,CHIMIN', 1 ITMIN,IHMIN,CHIMIN endif DO 203 IAMH=1,NAMH AMH=AMHMIN+(IAMH-1)*AMHSTP AMHS =AMH DO 204 IAMT=1,NAMT AMT=AMTMIN+(IAMT-1)*AMTSTP AMS=AMT CHI2S=CH2(IAMT,IAMH)-CHIMIN CALL HF2(20,AMS,AMHS,CHI2S) * IF(CHI2.LE.CHIMIN+1)CALL HF2(20,AM,AMHS,1.) * IF(CHI2.GT.CHIMIN+4.AND.CHI2.LE.CHIMIN+9) * 1 CALL HF2(20,AM,AMHS,3.) * IF(CHI2.GT.CHIMIN+16.AND.CHI2.LE.CHIMIN+25) * 1 CALL HF2(20,AM,AMHS,5.) * IF(CHI2.GT.CHIMIN+36.AND.CHI2.LE.CHIMIN+49) * 1 CALL HF2(20,AM,AMHS,7.) * IF(CHI2.GT.CHIMIN+64) * 1 CALL HF2(20,AM,AMHS,9.) 204 CONTINUE 203 CONTINUE CALL HPRINT(20) * CALL HRESET(2,' ') ENDIF ! lcont *---------------------------------------------------- ARGLIS(1)=2. CALL MNEXCM(FCNLB,'RELEASE',ARGLIS,1,IERFLG) 777 CONTINUE DO 778 IMH=1,NAMHIG R4=AMHIGG(IMH) call hf1(104,float(3+10*(IMH-1)),R4) R4=AMTF(IMH) call hf1(104,float(1+10*(IMH-1)),R4) R4=ALSF(IMH) call hf1(104,float(2+10*(IMH-1)),R4) if(prtflg(2).gt.0.)then WRITE(6,10778)IMH,AMHIGG(IMH),CHI2F(IMH) WRITE(6,10779)AMTF(IMH),DAMT1(IMH),DAMT2(IMH) WRITE(6,10780)ALSF(IMH),DALS1(IMH),DALS2(IMH) 10778 FORMAT(1X,I5,'MHIGGS = ',F10.1,' CHI2= ',F10.1) 10779 FORMAT(1X,'MTOP = ',F10.1,' + ',F10.1,' ',F10.1) 10780 FORMAT(1X,'ALSB = ',F10.4,' + ',F10.4,' ',F10.4) endif 778 CONTINUE IMH=1 DT1=AMTF(3)-AMTF(1) DT2=AMTF(2)-AMTF(1) DA1=ALSF(3)-ALSF(1) DA2=ALSF(2)-ALSF(1) if(prtflg(2).gt.0.)then WRITE(6,10781)AMHIGG(IMH),CHI2F(IMH) WRITE(6,10782)AMTF(IMH),DAMT1(IMH),DAMT2(IMH),DT1,DT2 WRITE(6,10783)ALSF(IMH),DALS1(IMH),DALS2(IMH),DA1,DA2 10781 FORMAT(1X,'MHIGGS = ',F10.1,' CHI2= ',F10.1) 10782 FORMAT(1X,'MTOP = ',F10.1,' + ',F10.1,' ',F10.1, 1 ' + ',F10.1,' ',F10.1) 10783 FORMAT(1X,'ALSB = ',F10.4,' + ',F10.4,' ',F10.4, 1 ' + ',F10.4,' ',F10.4) ******************************************************************** write(6,*)'***********************************************' endif CALL MNSETI('Fit mass of the top ') VSTRT2(1)=VSTRT(1) VSTRT2(2)=ALSF(IMH) VSTRT2(3)=300. ARGLIS(1)=3. CALL MNEXCM(FCNLB,'RELEASE',ARGLIS,1,IERFLG) IF(PRTFLG(2).GT.0.)THEN DO I=1,3 WRITE(6,*)I,NPRM(I),PNAM(I),VSTRT2(I),STP(I) ENDDO ENDIF CALL MNPARM(1,PNAM(1),VSTRT2(1),STP(1),5.D0,1.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 1' ENDIF CALL MNPARM(2,PNAM(2),VSTRT2(2),STP(2),0.D0,1.D0,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNPARM(3,PNAM(3),VSTRT2(3),STP(3),5.D0,2.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF ARGLIS(1)=2. CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) ARGLIS(1)=3. CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) do i=1,nlep FLEPO(i)=FLEP(i) enddo FLEPO(7)=1. FLEPO(13)=1. FLEPO(14)=1. ARGLIS(1)=1. CALL MNEXCM(FCNLB,'SET ERR',ARGLIS,1,IERFLG) do imeas=1,NLEP if(FLEPO(imeas).ge.0.)then if(prtflg(2).gt.0.)then write(6,*)'*********imeas ',imeas,VLEP(imeas),' +- ', 1 ELEP(imeas) endif do i=1,nlep FLEP(i)=-1. enddo flep(imeas)=1. CALL MNPARM(1,PNAM(1),VSTRT2(1),STP(1),5.D0,1.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 1' ENDIF * ARGLIS(1)=1. * IF(IMEAS.EQ.6)ARGLIS(1)=1. * CALL MNEXCM(FCNLB,'SET ERR',ARGLIS,1,IERFLG) ARGLIS(1)=1. CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) ARGLIS(1)=0. CALL MNEXCM(FCNLB,'SET PRINT',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'MIGRAD',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'HES',ARGLIS,1,IERFLG) * CALL MNEXCM(FCNLB,'SHOW ERR',ARGLIS,0,IERFLG) ARGLIS(1)=1000. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,1,IERFLG) *---------------------------------------------------------- if(prtflg(2).gt.0.)then CALL PRTERR endif CALL MNSTAT(FMIN,FEDM,ERRDEF,NPARI,NPARX,ISTAT) CALL MNPOUT(1,CHNAM,VALUE ,ERROR,BND1,BND2,IVARBL) CALL MNERRS(1,EPLUS,EMINUS,EPARAB,GLOBCC) *-------SPECIAL TREATMENT OF GBB ------------------------------- IF(IMEAS.EQ.6)THEN SAVEV6=VLEP(6) VLEP(6)=VLEP(6)-ELEP(6) CALL MNPARM(1,PNAM(1),VSTRT2(1),STP(1),5.D0,1.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 1' ENDIF * ARGLIS(1)=1. * IF(IMEAS.EQ.6)ARGLIS(1)=1. * CALL MNEXCM(FCNLB,'SET ERR',ARGLIS,1,IERFLG) ARGLIS(1)=1. CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) ARGLIS(1)=0. CALL MNEXCM(FCNLB,'SET PRINT',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'MIGRAD',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'HES',ARGLIS,1,IERFLG) * CALL MNEXCM(FCNLB,'SHOW ERR',ARGLIS,0,IERFLG) ARGLIS(1)=1000. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,1,IERFLG) *---------------------------------------------------------- if(prtflg(2).gt.0.)then CALL PRTERR endif CALL MNSTAT(FMIN,FEDM,ERRDEF,NPARI,NPARX,ISTAT) CALL MNPOUT(1,CHNAM,VPLUS,ERRPL,BND1,BND2,IVARBL) VLEP(6)=SAVEV6 EPLUS=VPLUS-VALUE ENDIF ! IMEAS=6 IF(EPLUS.EQ.0.)EPLAS=999. IF(EMINUS.EQ.0.)EMINUS=-999. AMTLEP(IMEAS)=VALUE EMTLEP(IMEAS)=ERROR EMTPOS(IMEAS)=EPLUS EMTNEG(IMEAS)=EMINUS H=(VSTRT2(3)/AMZ)**2 ALSBAR=VSTRT2(2) * ALSBAR=ALSF(1) T=(VALUE/AMZ)**2 CENTRE=THEORY(IMEAS,T,H,ALSBAR) T=((VALUE+EPLUS)/AMZ)**2 CPLUS=THEORY(IMEAS,T,H,ALSBAR) T=((VALUE+EMINUS)/AMZ)**2 CMINUS=THEORY(IMEAS,T,H,ALSBAR) if(prtflg(2).gt.0.)then WRITE(6,*)'IMEAS,T,H,ALSBAR',IMEAS,T,H,ALSBAR WRITE(6,*)'CENTRE,CPLUS,CMINUS',CENTRE,CPLUS,CMINUS endif T=((VALUE+EPARAB)/AMZ)**2 CPPARA=THEORY(IMEAS,T,H,ALSBAR) T=((VALUE-EPARAB)/AMZ)**2 CNPARA=THEORY(IMEAS,T,H,ALSBAR) if(prtflg(2).gt.0.)then WRITE(6,*)'IMEAS,T,H,ALSBAR',IMEAS,T,H,ALSBAR WRITE(6,*)'CENTRE,CPPARA,CNPARA',CENTRE,CPPARA,CNPARA endif X(1)=VALUE+EPLUS X(2)=ALSBAR X(3)=VSTRT2(3) CALL FCNLB(NPAR,GIN,F,X,IFLAG) if(prtflg(2).gt.0.)then WRITE(6,*)'F,X',F,X endif X(1)=VALUE+EMINUS X(2)=ALSBAR X(3)=VSTRT2(3) CALL FCNLB(NPAR,GIN,F,X,IFLAG) * WRITE(6,*)'F,X',F,X ARGLIS(1)=3. CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) endif enddo if(prtflg(2).gt.0.)then WRITE(6,*)'***************************************************' WRITE(6,10781)AMHIGG(IMH),CHI2F(IMH) WRITE(6,10782)AMTF(IMH),DAMT1(IMH),DAMT2(IMH),DT1,DT2 WRITE(6,10783)ALSF(IMH),DALS1(IMH),DALS2(IMH),DA1,DA2 WRITE(6,*)'***************************************************' endif AMTB=AMTF(IMH) AMTMEA=0.D0 WSUM=0.D0 IF(.NOT.HEXIST(101))CALL HBOOK1(101,'MTOP',100,0.5,100.5,0.) R4=AMTF(IMH) CALL HF1(101,1.,R4) IF(.NOT.HEXIST(102))CALL HBOOK1(102,'DMT+',100,0.5,100.5,0.) R4=DAMT1(IMH) CALL HF1(102,1.,R4) IF(.NOT.HEXIST(103))CALL HBOOK1(103,'DMT-',100,0.5,100.5,0.) R4=DAMT2(IMH) CALL HF1(103,1.,R4) DO I=1,NL if(prtflg(2).gt.0.)then WRITE(6,10790)I,CHLEP(I),AMTLEP(I), 1 EMTPOS(I),EMTNEG(I),EMTLEP(I) 10790 FORMAT(I4,A20,F7.1,' + ',F7.1,F7.1,' PARAB.+-',F7.1) endif IF(FLEPO(I).GT.0.)THEN R4=AMTLEP(I) CALL HF1(101,FLOAT(I),R4) R4=EMTPOS(I) CALL HF1(102,FLOAT(I),R4) R4=EMTNEG(I) CALL HF1(103,FLOAT(I),R4) IF(ABS(AMTB-(AMTLEP(I)-EMTNEG(I))).LT. 1 ABS(AMTB-(AMTLEP(I)+EMTPOS(I))))THEN ERROR=EMTNEG(I) ELSE ERROR=EMTPOS(I) ENDIF IF(ERROR.NE.0)THEN W=1./ERROR**2 ENDIF WSUM=WSUM+W AMTMEA=AMTMEA+AMTLEP(I)*W ENDIF ENDDO IF(WSUM.NE.0)THEN AMTMEA=AMTMEA/WSUM ENDIF IF(PRTFLG(2).GT.0.)THEN WRITE(6,*)'AMTMEAN = ',AMTMEA ENDIF CALL MNEXCM(FCNLB,'END ',0.D0,0,IERFLG) CALL MNEXCM(FCNLB,'CLEAR ',0.D0,0,IERFLG) * WRITE(6,10782)AMTF(IMH),DAMT1(IMH),DAMT2(IMH),DT1,DT2 * WRITE(6,10783)ALSF(IMH),DALS1(IMH),DALS2(IMH),DA1,DA2 AMHP=300. if(PRTFLG(3).gt.0.D0)then WRITE(6,*)'AMTF(1),DAMT1(1),DAMT2(1),ALSF(1),AMHP', 1 AMTF(1),DAMT1(1),DAMT2(1),ALSF(1),AMHP CALL TABLE(AMTF(1),DAMT1(1),DAMT2(1),DT1,DT2,ALSF(1), 1 DA1,DA2,AMHP,EMAT) DO IMH=1,NAMHIG WRITE(6,10778)IMH,AMHIGG(IMH),CHI2F(IMH) WRITE(6,10779)AMTF(IMH),DAMT1(IMH),DAMT2(IMH) WRITE(6,10780)ALSF(IMH),DALS1(IMH),DALS2(IMH) ENDDO IMH=1 DT1=AMTF(3)-AMTF(1) DT2=AMTF(2)-AMTF(1) DA1=ALSF(3)-ALSF(1) DA2=ALSF(2)-ALSF(1) WRITE(6,10781)AMHIGG(IMH),CHI2F(IMH) WRITE(6,10782)AMTF(IMH),DAMT1(IMH),DAMT2(IMH),DT1,DT2 WRITE(6,10783)ALSF(IMH),DALS1(IMH),DALS2(IMH),DA1,DA2 ******************************************************************** write(6,*)'***********************************************' endif POUT(1)=AMTF(1) POUT(2)=ALSF(1) POUT(3)=AMHIGG(1) EPOUT(1,1)=DAMT1(1) EPOUT(1,2)=DAMT2(1) EPOUT(2,1)=DALS1(1) EPOUT(2,2)=DALS2(1) EPOUT(3,1)=AMHIGG(3)-AMHIGG(1) EPOUT(3,2)=AMHIGG(2)-AMHIGG(1) CHIOUT=CHI2F(1) call hropen(12,'lbfit','LBFITN.HIST','N',1024,istat) call hrout(0,icycle,' ') call hrend('lbfit') CALL HRESET(0,' ') CALL LTINIT(0) CLOSE(19) END *CMZ : 2.00/00 28/01/96 15.19.46 by A.Rozanov *CMZ : 1.30/07 17/02/95 22.19.11 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFIT(CHKEY,FMT,FALS,EFMT,EFALS,RHO,CHI2S,NDF) * * *----------------------------------------------------------------------* * * * Name : LTFIT * * (module) * * * * Description : * * fit MT and ALSBAR from experimental data * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEND. DIMENSION CERR(2,2) REAL*4 FMT,FALS,EFMT,EFALS,RHO,CHI2S * * CHARACTER*(*) CHKEY * * LK=LEN(CHKEY) AMHNEW=AMHCOM ALBNEW=ALBAR IF(CHKEY(1:LK).EQ.'MT,ALS')THEN CALL LTFITT(AMHNEW,ALBNEW,AMTFIT,ALSFIT,CERR,CHI2,NDF) FMT=AMTFIT FALS=ALSFIT EFMT=dsqrt(CERR(1,1)) EFALS=dsqrt(CERR(2,2)) RHO=CERR(1,2)/(EFMT*EFALS) CHI2S=CHI2 ELSE WRITE(6,*)'+LTFIT: wrong keyword: ',CHKEY(1:LK) ENDIF IF(PRTFLG(9).ne.0)THEN WRITE(6,10010)FMT,EFMT,FALS,EFALS,RHO,CHI2S 10010 FORMAT(1x,'+LTFIT: MT= ',f8.1,' +- ',f6.1,' ALS= ',F8.4, 1 ' +- ',F8.4,/ 2 ' RHO= ',E12.5,' CHI2= ',E12.5) ENDIF END ! LTFIT *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE PRTERR *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. CHARACTER*10 CHNAM CALL MNSTAT(FMIN,FEDM,ERRDEF,NPARI,NPARX,ISTAT) * DO 50 I=1,NPARI DO 50 I=1,3 CALL MNPOUT(I,CHNAM,VALUE ,ERROR,BND1,BND2,IVARBL) CALL MNERRS(I,EPLUS,EMINUS,EPARAB,GLOBCC) WRITE(6,45) I,CHNAM,VALUE,ERROR,EPLUS,EMINUS,EPARAB,GLOBCC 45 FORMAT(1X,I2,1X,A10,F9.4,' +-',F9.4, 1 ' E+,E-,EPAR,GLOBCC',4F9.4) 50 CONTINUE END *CMZ : 09/11/99 19.17.19 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.41.59 by A.Rozanov *CMZ : 2.00/01 18/07/97 19.57.45 by A.Rozanov *CMZ : 2.00/00 24/06/97 17.32.47 by A.Rozanov *CMZ : 2.00/01 07/03/95 21.28.17 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE FCNLB(NPAR,GIN,F,X,IFLAG) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. real*8 chi2n,chi2p,albexp,albthr,walb,chi2alb common/chi2np/chi2n,chi2p,albexp,albthr,walb,chi2alb DIMENSION X(*),GIN(*),THEOR(NL) DIMENSION DLEP(NL*NL) REAL*4 ROLEP(NL*NL) * REAL*4 I1(NL*NL) REAL*4 SUSYFL,SMT,SMH SAVE NPARX,NI,NJ,DLEP,ROLEP IF(IFLAG.EQ.1)THEN *-----initialization CALL MNSTAT(FMINN,FEDMM,ERRDEFF,NPARII,NPARX,ISTAT) NPLEP=0 DO 7 I=1,NLEP IF(FLEP(I).GT.0.)NPLEP=NPLEP+1 7 CONTINUE NI=0 DO 3 I=1,NLEP IF(FLEP(I).GT.0.)THEN NI=NI+1 NJ=0 DO 13 J=1,NLEP IF(FLEP(J).GT.0.)THEN NJ=NJ+1 S=RLEP(I,J)*ELEP(I)*ELEP(J) * SLEP(NI+NPLEP*(NJ-1))=S DLEP(NI+NPLEP*(NJ-1))=S ROLEP(NI+NPLEP*(NJ-1))=RLEP(I,J) ENDIF 13 CONTINUE ENDIF 3 CONTINUE * CALL MATIN1(ROLEP,NPLEP,NPLEP,NPLEP,0,I1,NERROR,DET) * IF(NERROR.NE.0)WRITE(6,*)'ERROR IN MATIN1' if(PRTFLG(2).GT.0.)then * WRITE(6,*)'DETERMINANT OF CORRELATION MATRIX',DET * DETI=1./DET * CALL VSCALE(SLEP,DETI,SLEP,NPLEP*NPLEP) WRITE(6,*)'Error matrix' DO 5 I=1,NPLEP * WRITE(6,10010)(SLEP(NPLEP*(I-1)+J),J=1,NPLEP) *0010 FORMAT(1X,5E11.3) WRITE(6,10010)(DLEP(NPLEP*(I-1)+J),J=1,NPLEP) 10010 FORMAT(1X,5D11.3) 5 CONTINUE endif * CALL SMXINV(SLEP,NPLEP,NERROR) CALL DSINV(NPLEP,DLEP,NPLEP,NERROR) IF(NERROR.NE.0)WRITE(6,*)'ERROR IN INVERSION' if(PRTFLG(2).GT.0.)then WRITE(6,*)'Inverted error matrix' DO 6 I=1,NPLEP * WRITE(6,10010)(SLEP(NPLEP*(I-1)+J),J=1,NPLEP) WRITE(6,10010)(DLEP(NPLEP*(I-1)+J),J=1,NPLEP) 6 CONTINUE endif ENDIF ! iflag=1 *================================================================= AMT=X(1) ALSBAR=X(2) AMH=X(3) * in case we fit log(MH) if(X(3).lt.3.5)AMH=10**X(3) * in case we fit albar if(NPARX.GE.4.and.x(4).ne.1.D0/ALBAR)then ALBAR=1.D0/X(4) CALL LTINIT(1) endif * check if SUGRA model used to calculate mH and corrections call ltsusyget('SUSYFL',SUSYFL) if(SUSYFL.ge.1.)then SMT=AMT call fsugrun(SMT,ierr,SMH) AMH=SMH if(ierr.ne.0)then CHI2=9999999. go to 999 endif endif if(PRTFLG(2).GT.0.)then write(6,*)'mt,alsbar,mh',amt,alsbar,amh endif T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 if(T.GT.1.D6.OR.H.GT.1.D6.OR.T.LT.1.D-4)THEN WRITE(6,*)'++FCNLB: T,H,AMT,AMH,AMZ', 1 T,H,AMT,AMH,AMZ ENDIF IF(FLEP(1).GT.0.)THEOR(1)=0. IF(FLEP(2).GT.0.)THEOR(2)=GZ(T,H,ALSBAR) IF(FLEP(3).GT.0.)THEOR(3)=SIGH(T,H,ALSBAR) IF(FLEP(4).GT.0.)THEOR(4)=RL(T,H,ALSBAR) IF(FLEP(5).GT.0.)THEOR(5)=AFB(T,H,ALSBAR) IF(FLEP(6).GT.0.)THEOR(6)=RB(T,H,ALSBAR) IF(FLEP(7).GT.0.)THEOR(7)=AMWMZ(T,H,ALSBAR) IF(FLEP(8).GT.0.)THEOR(8)=ALE(T,H,ALSBAR) IF(FLEP(9).GT.0.)THEOR(9)=ALE(T,H,ALSBAR) IF(FLEP(10).GT.0.)THEOR(10)=AFBBB(T,H,ALSBAR) IF(FLEP(11).GT.0.)THEOR(11)=AFBCC(T,H,ALSBAR) IF(FLEP(12).GT.0.)THEOR(12)=QFB(T,H,ALSBAR) IF(FLEP(13).GT.0.)THEOR(13)=S2NUN(T,H,ALSBAR) IF(FLEP(14).GT.0.)THEOR(14)=ALR(T,H,ALSBAR) IF(FLEP(15).GT.0.)THEOR(15)=AMT IF(FLEP(16).GT.0.)THEOR(16)=GL(T,H,ALSBAR) IF(FLEP(17).GT.0.)THEOR(17)=RC(T,H,ALSBAR) IF(FLEP(18).GT.0.)THEOR(18)=RB(T,H,ALSBAR) IF(FLEP(19).GT.0.)THEOR(19)=AB(T,H,ALSBAR) IF(FLEP(20).GT.0.)THEOR(20)=AF(T,H,ALSBAR,0.5D0,0.6666666D0) IF(FLEP(21).GT.0.)THEOR(21)=ALSBAR IF(FLEP(22).GT.0.)THEOR(22)=1.D0/ALBAR IF(FLEP(23).GT.0.)THEOR(23)=0.25*(1.-GVAELE(T,H,ALSBAR)) IF(FLEP(24).GT.0.)THEOR(24)=GAELE(T,H,ALSBAR) IF(FLEP(25).GT.0.)then THEOR(25)=AMH if(AMH.gt.VLEP(25))THEOR(25)=VLEP(25) ! no low limit endif NI=0 CHI2=0.D0 chi2n=0.D0 chi2p=0.D0 DO 1 I=1,NLEP IF(FLEP(I).GT.0.)THEN NI=NI+1 NJ=0 DO 2 J=1,NLEP IF(FLEP(J).GT.0.)THEN NJ=NJ+1 * W=SLEP(NPLEP*(NI-1)+NJ) W=DLEP(NPLEP*(NI-1)+NJ) CHIP=(VLEP(I)-THEOR(I))*(VLEP(J)-THEOR(J))*W CHI2=CHI2+CHIP ***DEBUG if(i.eq.22.and.j.eq.22)then albexp=VLEP(I) albthr=THEOR(I) walb=W chi2alb=CHIP endif if(chip.lt.0.D0)chi2n=chi2n+chip if(chip.gt.0.D0)chi2p=chi2p+chip *============================================= * IF(IFLAG.EQ.1.OR.IFLAG.EQ.3)THEN if(PRTFLG(2).GT.0.)then WRITE(6,10020)I,J,VLEP(I),THEOR(I),VLEP(J), 1 THEOR(J),NI,NJ,W,CHIP, 2 CHI2 10020 FORMAT(' V-T(I) V-T(J) W D CHI2',2I2,4F7.3, 1 2I2,E10.3,2F10.2) endif * ENDIF ENDIF 2 CONTINUE ENDIF 1 CONTINUE 999 F=CHI2 IF(IFLAG.EQ.3)THEN *-----FINISH if(PRTFLG(2).GT.0.)then WRITE(6,*)'NPLEP,CHI2',NPLEP,CHI2 endif ENDIF END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FT(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. if(t.ge.0.25)then os4t=1./dsqrt(4.*t) ft=2*(1.-dsqrt(4.*t-1.)*dasin(os4t)) elseif(t.gt.0.)then root=dsqrt(1.-4.*t) os4t=1./dsqrt(4.*t) ft=2*(1.-root*dlog((1+root)*os4t)) else ft=-100000000. endif END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION F1T(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. data eps/0.00001/ if(t.ne.0.25)then f1t=(1.-2*t*ft(t))/(4.*t-1.) else f1t=(1.-2*t*ft(t))/eps endif END *CMZ : 1.30/02 17/01/95 12.55.56 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FH(H) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. if(h.ge.4.)then br1=(h/(h-1)-0.5*h)*dlog(h) br2=dsqrt(h/4.-1.)+dsqrt(h/4.) fh=1.+br1+h*dsqrt(1.-4./h)*dlog(br2) elseif(h.lt.4.)then br1=(h/(h-1)-0.5*h)*dlog(h) br2=dsqrt(4./h-1.) fh=1.+br1-h*dsqrt(4./h-1.)*datan(br2) endif END *CMZ : 1.30/02 17/01/95 12.51.48 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION F1H(H) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. if(h.gt.4.)then br1=0.5*(h-1.)*dlog(h) br2=dsqrt(h/4.-1.)+dsqrt(h/4.) f1h=-1.+br1+(3.-h)*dsqrt(h/(h-4.))*dlog(br2) elseif(h.lt.4.)then br1=0.5*(h-1.)*dlog(h) br2=dsqrt(4./h-1.) f1h=-1.+br1+(3.-h)*dsqrt(h/(4.-h))*datan(br2) else f1h=-2.+3.*dlog(2.d0) endif END *CMZ : 2.00/00 05/01/96 18.49.33 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION TM(TP) *-----formula (42) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. if(tp.gt.0.)then t=tp else t=0.00000001 endif alc2t=dlog(abs(1.-c2/t)) br1=(0.666666666-(8./9.)*s2)*dlog(t)-4./3.+(32./9.)*s2 br2=0.66666666666*(c2-s2)*(t**3/c2**3-3*t/c2+2)*alc2t br3=0.66666666666*(c2-s2)*(t**2/c2**2)+0.333333*(c2-s2)*(t/c2) br4=0.66666666666-(16./9.)*s2-0.66666666*t-(32./9.)*s2*t TM=br1+br2+br3+br4*ft(t) END *CMZ : 1.30/02 17/01/95 12.33.45 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION TA(T) *-----formula (79) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. br1=2./3.-(8./9.)*s2+(16./27.)*s2**2-f1t(t) br2=(32./9.)*s2**2-(8./3.)*s2-0.5 br3=(4./3.)*t*ft(t)-(2./3.)*(1.+2.*t)*f1t(t) TA=br1+br2*br3 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION TR(T) *-----formula (104) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. if(t.gt.0.)then dlogt=dlog(t) else dlogt=-100000000. endif TR=4./9.+(2./9.)*dlogt-(2./9.)*(1.+11.*t)*ft(t) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION TTM(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. PARAMETER (NP=31,MPOL=2) REAL*4 AMT(NP),TMP(NP),AMTOP,DIVDIF DATA AMT/0.,10.,20.,30.,40.,50.,60.,70.,80.,90., 1 100.,110.,120.,130.,140.,150.,160.,170.,180.,190., 2 200.,210.,220.,230.,240.,250.,260.,270.,280.,290., 3 300./ DATA TMP/-.189,-.192,-.256,-.431,-.754, 1 -.985,-.930,-.686,-.316,-.080, 2 0.084,0.214,0.323,0.418,0.503, 3 0.579,0.648,0.712,0.772,0.827, 4 0.879,0.928,0.974,1.018,1.060, 5 1.100,1.138,1.175,1.210,1.244, 6 1.276/ AMTOP=DSQRT(T)*AMZ TTM=DIVDIF(TMP,AMT,NP,AMTOP,MPOL) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION TTA(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. PARAMETER (NP=31,MPOL=2) REAL*4 AMT(NP),TAP(NP),AMTOP,DIVDIF DATA AMT/0.,10.,20.,30.,40.,50.,60.,70.,80.,90., 1 100.,110.,120.,130.,140.,150.,160.,170.,180.,190., 2 200.,210.,220.,230.,240.,250.,260.,270.,280.,290., 3 300./ DATA TAP/0.875,0.934,0.954,0.811,0.401, 1 0.112,0.327,0.390,0.421,0.439, 2 0.451,0.459,0.465,0.470,0.473, 3 0.476,0.478,0.480,0.481,0.482, 4 0.483,0.484,0.485,0.486,0.486, 5 0.487,0.487,0.488,0.488,0.488, 6 0.489/ AMTOP=DSQRT(T)*AMZ TTA=DIVDIF(TAP,AMT,NP,AMTOP,MPOL) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION TTR(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. PARAMETER (NP=31,MPOL=2) REAL*4 AMT(NP),TRP(NP),AMTOP,DIVDIF DATA AMT/0.,10.,20.,30.,40.,50.,60.,70.,80.,90., 1 100.,110.,120.,130.,140.,150.,160.,170.,180.,190., 2 200.,210.,220.,230.,240.,250.,260.,270.,280.,290., 3 300./ DATA TRP/0.000,0.039,-.015,-.305,-.960, 1 -.747,-.411,-.250,-.142,-.061, 2 0.006,0.062,0.111,0.154,0.193, 3 0.228,0.261,0.291,0.319,0.345, 4 0.370,0.393,0.415,0.436,0.456, 5 0.475,0.493,0.511,0.527,0.544, 6 0.559/ AMTOP=DSQRT(T)*AMZ TTR=DIVDIF(TRP,AMT,NP,AMTOP,MPOL) END *CMZ : 1.30/02 17/01/95 12.31.18 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION HM(H) *-----formula (E.10) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. if(h.gt.0.)then br1=-h/(h-1.)*dlog(h)+(c2*h/(h-c2))*dlog(h/c2)-(s2*h)/(18.*c2) br2=-8*s2/3.+(h**2/9.-(4./9.)*h+4./3.)*fh(h) br3=-(c2-s2)*(h**2/(9.*c2**2)-(4.*h)/(9.*c2)+4./3.)*fh(h/c2) * HM=br1+br2+br3+0.5040041+2.07995*(c2-0.7688)! up to 17.01.95 HM=br1+br2+br3+1.1205-2.59*(0.23117-s2) ! MIV 17.01.95 else HM=0. endif END *CMZ : 1.30/02 17/01/95 17.31.25 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION HR(H) *-----formula (E.17) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. if(h.gt.0)then br1=-4./3.-h/18.+(c2*h/(h-c2))*dlog(h/c2) * br1= -h/18.+(c2*h/(h-c2))*dlog(h/c2) br2=(h**2/9.-(4./9.)*h+4./3.)*fh(h) br3=(h/(1-h))*dlog(h) * HR=br1+br2+br3+0.0256256-0.00698*(c2-0.7688) HR=br1+br2+br3+1.3590+0.51*(0.23117-s2) else HR=0. endif END *CMZ : 1.30/02 17/01/95 12.43.27 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION HA(H) *-----formula (E.13) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. if(h.gt.0.)then br1=(c2*h/(h-c2))*dlog(h/c2) br2=(h**2*2./9.-(2./3.)*h+4./3.)*fh(h) br3=-(8./9.)*(h/(h-1))*dlog(h) br4=-(h**2/9.-(4./9.)*h+4./3.)*f1h(h)-h/18. * HA=br1+br2+br3+br4+0.7750503+1.40732*(c2-0.7688) HA=br1+br2+br3+br4+0.7751+1.07*(0.23117-s2) ! MIV 17.01.95 else HA=0. endif END *CMZ : 1.30/02 17/01/95 14.49.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION CM(T) *----- *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. CM=-1.3500+4.13*(0.23117-s2) ! MIV 17.01.95 ***** CM=-1.35011+4.1352*(c2-0.7688) *****1-1.3333333333*s2**2*0.7248 ! gamma-ww-gamma 09.11.93 van *****1-1.3333333333*s2**2*0.8626 ! gamma-ww-gamma END *CMZ : 1.30/02 17/01/95 15.50.51 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION CA(T) *----- *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * CA=-2.26185+1.3082*(c2-0.7688) CA=-2.2619-2.63*(0.23117-s2) END *CMZ : 1.30/02 17/01/95 17.49.23 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION CR(T) *----- *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * CR=-3.50415-4.3408*(c2-0.7688) CR=-3.5041 -5.7200*(0.23117-s2) *****1-1.3333333333*s2*c2*0.7248 ! gamma-ww-gamma 09.11.93 van *****1-1.3333333333*s2*c2*0.8626 ! gamma-ww-gamma END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION HHM(H) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. PARAMETER (NP=24,MPOL=2) REAL*4 AMH(NP),HMP(NP),AMHIGG,DIVDIF DATA AMH/0.01,0.1,1.,10.,50.,100.,150.,200.,250.,300., 1 350.,400.,450.,500.,550.,600.,650.,700.,750.,800., 2 850.,900.,950.,1000./ DATA HMP/1.121,1.120,1.104,0.980,0.661, 1 0.433,0.274,0.150,0.049,-.038, 2 -.113,-.180,-.239,-.294,-.343, 3 -.389,-.431,-.471,-.508,-.542, 4 -.575,-.606,-.635,-.663/ AMHIGG=DSQRT(H)*AMZ HHM=DIVDIF(HMP,AMH,NP,AMHIGG,MPOL) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION HHA(H) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. PARAMETER (NP=24,MPOL=2) REAL*4 AMH(NP),HAP(NP),AMHIGG,DIVDIF DATA AMH/0.01,0.1,1.,10.,50.,100.,150.,200.,250.,300., 1 350.,400.,450.,500.,550.,600.,650.,700.,750.,800., 2 850.,900.,950.,1000./ DATA HAP/-8.717,-5.654,-2.653,-0.133, 0.645, 1 0.652, 0.587, 0.517, 0.451, 0.391, 2 0.337, 0.287, 0.242, 0.201, 0.162, 3 0.126, 0.093, 0.062, 0.033, 0.005, 4 -0.021,-0.046,-0.069,-0.092/ AMHIGG=DSQRT(H)*AMZ HHA=DIVDIF(HAP,AMH,NP,AMHIGG,MPOL) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION HHR(H) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. PARAMETER (NP=24,MPOL=2) REAL*4 AMH(NP),HRP(NP),AMHIGG,DIVDIF DATA AMH/0.01,0.1,1.,10.,50.,100.,150.,200.,250.,300., 1 350.,400.,450.,500.,550.,600.,650.,700.,750.,800., 2 850.,900.,950.,1000./ DATA HRP/ 1.358, 1.354, 1.315, 1.016, 0.359, 1 -0.022,-0.258,-0.431,-0.567,-0.680, 2 -0.777,-0.862,-0.937,-1.005,-1.067, 3 -1.124,-1.176,-1.225,-1.271,-1.310, 4 -1.353,-1.392,-1.428,-1.462/ AMHIGG=DSQRT(H)*AMZ HHR=DIVDIF(HRP,AMH,NP,AMHIGG,MPOL) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ALSRUN(Q2,ALS) * running alsbar according (27) of Chetyrkin and Kwiatkowski * Phys.Lett. B305 (1993) 285-294. *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CHETYR. COMMON/CHETYR/BETA0,BETA1,BETA2,GAMMA0,GAMMA1,GAMMA2,AKBOT,FERMI *KEND. PARAMETER (NP=120,MPOL=2) REAL*4 VLAQCD(NP),VALS(NP),ALSMZ2,DIVDIF DATA NEV/0/ NEV=NEV+1 IF(NEV.EQ.1)THEN FERMI=5. BETA0=0.25*(11.-0.666666666666*FERMI) BETA1=(102.-38.*FERMI/3.)/16. BETA2=(2857./2.-5033.*FERMI/18.+325.*FERMI**2/54.)/64. DZI3=1.2020569 GAMMA0=1. GAMMA1=(202./3.-20.*FERMI/9.)/16. GAMMA2=(1249.-(2216./27.+160.*DZI3/3.)*FERMI-140.*FERMI**2/81.) 1 /64. * WRITE(6,*)'BETA0,BETA1,BETA2,GAMMA0,GAMMA1,GAMMA2', * 1 BETA0,BETA1,BETA2,GAMMA0,GAMMA1,GAMMA2 AKBOT=12.4 Q22=AMZ**2 DO I=1,10 VLAQCD(I)=0.001*I-0.0005 VLA=VLAQCD(I) VALS(I)=ALSRU2(Q22,VLA) * WRITE(6,*)'I,VLAQCD(I),VALS(I)', * 1 I,VLAQCD(I),VALS(I) ENDDO DO I=11,110 VLAQCD(I)=0.01*(I-10) VLA=VLAQCD(I) VALS(I)=ALSRU2(Q22,VLA) * WRITE(6,*)'I,VLAQCD(I),VALS(I)', * 1 I,VLAQCD(I),VALS(I) ENDDO DO I=111,120 VLAQCD(I)=1.*(I-110)+0.5 VLA=VLAQCD(I) VALS(I)=ALSRU2(Q22,VLA) * WRITE(6,*)'I,VLAQCD(I),VALS(I)', * 1 I,VLAQCD(I),VALS(I) ENDDO ENDIF * ALSMZ2=ALS IF(ALS.GT.VALS(NP))ALSMZ2=VALS(NP) IF(ALS.LT.VALS(1))ALSMZ2=VALS(1) ALAQCD=DIVDIF(VLAQCD,VALS,NP,ALSMZ2,MPOL) IF(ALAQCD**2.GE.Q2)ALAQCD=DSQRT(Q2)*0.99 ALSRUN=ALSRU2(Q2,ALAQCD) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ALSRU2(Q2,ALAQCD) * running alsbar according (27) of Chetyrkin and Kwiatkowski * Phys.Lett. B305 (1993) 285-294. *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CHETYR. COMMON/CHETYR/BETA0,BETA1,BETA2,GAMMA0,GAMMA1,GAMMA2,AKBOT,FERMI *KEND. * ALQCD2=ALAQCD**2 R=Q2/ALQCD2 ALL=DLOG(R) ALAL=DLOG(ALL) BR1=PI/(BETA0*ALL) * WRITE(6,*)'Q2,ALAQCD,ALL,ALAL,BETA0,BR1', * 1 Q2,ALAQCD,ALL,ALAL,BETA0,BR1 T1=BETA1*ALAL/(BETA0*ALL*BETA0) T2=((BETA1**2/BETA0**2)*(ALAL**2-ALAL-1.)+BETA2/BETA0) Z2=(BETA0*ALL)**2 ALSRU2=BR1*(1.-T1+T2/Z2) * WRITE(6,*)'T1,T2,Z2,ALSRU2', * 1 T1,T2,Z2,ALSRU2 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AMU(ALS) * running AMU=MB(MZ2)/MB(phys) * according (28-29) of Chetyrkin and Kwiatkowski * Phys.Lett. B305 (1993) 285-294. *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CHETYR. COMMON/CHETYR/BETA0,BETA1,BETA2,GAMMA0,GAMMA1,GAMMA2,AKBOT,FERMI *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEND. * Q2=AMB0**2 ALSMB2=ALSRUN(Q2,ALS) * WRITE(6,*)'ALS,AMB0,Q2,ALSMB2', * 1 ALS,AMB0,Q2,ALSMB2 BASE=(ALS/ALSMB2) IF(BASE.GE.1.D-15)THEN BR1=(ALS/ALSMB2)**(GAMMA0/BETA0) ELSE BR1=0. ENDIF Z1=(GAMMA1/BETA0-BETA1*GAMMA0/BETA0**2) T1=Z1*(ALS/PI-ALSMB2/PI) T2=0.5*T1**2 Z2=GAMMA2/BETA0-BETA1*GAMMA1/BETA0**2-BETA2*GAMMA0/BETA0**2 1 +BETA1**2*GAMMA0/BETA0**3 T3=0.5*Z2*((ALS/PI)**2-(ALSMB2/PI)**2) T4=1.+1.3333333*ALSMB2/PI+AKBOT*(ALSMB2/PI)**2 AMU=BR1*(1.+T1+T2+T3)/T4 * WRITE(6,*)'BR1,Z1,Z2,T1,T2,T3,T4,AMU', * 1 BR1,Z1,Z2,T1,T2,T3,T4,AMU END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 2.00/02 02/09/98 22.37.46 by A.Rozanov *CMZ : 1.30/02 17/01/95 15.24.44 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VAL(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * VAL=T+TA(T)+HA(H)-2.26+DVA(T,ALSBAR) * TP=TPRIME(T,H) * VAL=TP+TA(TP)+HA(H)+CA(T)+DVA(T,ALSBAR)+D1VA(T) ! bug MIV 16.11.94 VAL=T+TA(T )+HA(H)+CA(T)+DVA(T,H,ALSBAR)+DTTVA(T) 1 +DSUSYLRVA(T,H,ALSBAR) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 2.00/02 02/09/98 22.37.46 by A.Rozanov *CMZ : 1.30/02 17/01/95 15.25.37 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VRL(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * VRL=T+TR(T)+HR(H)-3.50+DVR(T,H,ALSBAR) * TP=TPRIME(T,H) * VRL=TP+TR(TP)+HR(H)+CR(T)+DVR(T,ALSBAR)+D1VR(T) !bug MIV 16.11.9 VRL=T+TR(T )+HR(H)+CR(T)+DVR(T,H,ALSBAR)+DTTVR(T) 1 +DSUSYLRVR(T,H,ALSBAR) +DDGVR(T,H,ALSBAR) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 2.00/02 02/09/98 22.37.46 by A.Rozanov *CMZ : 1.30/02 17/01/95 15.23.32 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VM(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * VM=T+TM(T)+HM(H)-1.36+DVM(T,ALSBAR) * TP=TPRIME(T,H) * VM=TP+TM(TP)+HM(H)+CM(T)+DVM(T,ALSBAR)+D1VM(T) ! bug MIV 16.11.94 VM=T+TM(T )+HM(H)+CM(T)+DVM(T,H,ALSBAR)+DTTVM(T) 1 +DSUSYLRVM(T,H,ALSBAR) +DDGVM(T,H,ALSBAR) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VM_NOB(T,H,ALSBAR) * no Barbieri 2 loop corrections *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * VM=T+TM(T)+HM(H)-1.36+DVM(T,ALSBAR) TP=T * VM_NOB=TP+TM(TP)+HM(H)+CM(T)+DVM(T,ALSBAR)+D1VM(T) ! bug 16.11.94 VM_NOB=TP+TM(T )+HM(H)+CM(T)+DVM(T,H,ALSBAR)+D1VM(T) END *CMZ : 1.30/02 17/01/95 16.04.31 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VNU(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. ***** VNU=VAL(T,H,ALSBAR)+1.0981551-4.0646*(c2-0.7688) VNU=VAL(T,H,ALSBAR)-CA(T)-1.1638-4.88*(0.23117-s2) ! MIV 17.01.95 END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 2.00/02 04/07/98 21.29.46 by A.Rozanov *CMZ : 1.30/06 19/01/95 20.35.38 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VAQ(T,H,ALSBAR,IFLAV) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. IF(IFLAV.EQ.1.OR.IFLAV.EQ.3)THEN VAQ=VAD(T,H,ALSBAR) ELSEIF(IFLAV.EQ.2.OR.IFLAV.EQ.4.OR.IFLAV.EQ.6)THEN VAQ=VAU(T,H,ALSBAR) ELSEIF(IFLAV.EQ.5)THEN VAQ=VAB(T,H,ALSBAR) ENDIF END *CMZ : 2.00/02 04/07/98 21.30.12 by A.Rozanov *CMZ : 1.30/06 19/01/95 20.36.59 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VRQ(T,H,ALSBAR,IFLAV) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. IF(IFLAV.EQ.1.OR.IFLAV.EQ.3)THEN VRQ=VRD(T,H,ALSBAR) ELSEIF(IFLAV.EQ.2.OR.IFLAV.EQ.4.OR.IFLAV.EQ.6)THEN VRQ=VRU(T,H,ALSBAR) ELSEIF(IFLAV.EQ.5)THEN VRQ=VRB(T,H,ALSBAR) ENDIF END *CMZ : 15/01/99 09.33.58 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VAU(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * DATA FAL/0.00186/,FAU/-0.00165/,FAD/0.00137/ * DATA FVL/0.00197/,FVU/-0.00169/,FVD/0.00138/ VAU=VAL(T,H,ALSBAR)+(128*PI*S2*DSQRT(S2)*C2*DSQRT(C2)* 1 (FAU(albar,s2)+FAL(albar,s2)))/ 1 (3*ALBAR) END *CMZ : 15/01/99 09.33.58 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VAD(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * DATA FAL/0.00186/,FAU/-0.00165/,FAD/0.00137/ * DATA FVL/0.00197/,FVU/-0.00169/,FVD/0.00138/ VAD=VAL(T,H,ALSBAR)+(128*PI*S2*DSQRT(S2)*C2*DSQRT(C2)* 1 (-FAD(albar,s2)+FAL(albar,s2)))/ 1 (3*ALBAR) END *CMZ : 15/01/99 09.33.58 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VRU(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * DATA FAL/0.00186/,FAU/-0.00165/,FAD/0.00137/ * DATA FVL/0.00197/,FVU/-0.00169/,FVD/0.00138/ VRU=VRL(T,H,ALSBAR)+(16*PI*DSQRT(S2)*DSQRT(C2)*(C2-S2))* 1 (FVL(albar,s2)-(1.-4*S2)*FAL(albar,s2) 1 +1.5*(-(1.-(8./3.)*S2)*FAU(albar,s2)+FVU(albar,s2)))/ 2 (3*ALBAR) END *CMZ : 15/01/99 09.33.58 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VRD(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * DATA FAL/0.00186/,FAU/-0.00165/,FAD/0.00137/ * DATA FVL/0.00197/,FVU/-0.00169/,FVD/0.00138/ VRD=VRL(T,H,ALSBAR)+(16*PI*DSQRT(S2)*DSQRT(C2)*(C2-S2))* 1 (FVL(albar,s2)-(1.-4*S2)*FAL(albar,s2) 1 + 3.*( (1.-(4./3.)*S2)*FAD(albar,s2)-FVD(albar,s2)))/ 1 (3*ALBAR) END *CMZ : 12/10/99 14.02.18 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVM4(T,ALSBAR) * from draft TH preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. IF(AML4.GT.0.000001.OR.AMQ4.GT.0.000001)THEN DVM4=DVML4(T,ALSBAR)+DVMQ4(T,ALSBAR) ELSE DVM4=0. ENDIF END *CMZ : 12/10/99 14.01.52 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVML4(T,ALSBAR) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/1/,QU/0.0000000/,QD/-1.0000000/ DVML4=DVMF4(T,ALSBAR,NC,QU,QD,NL4,AMN4,AME4,AML4) END *CMZ : 07/02/99 23.49.20 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVMQ4(T,ALSBAR) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ DVMQ4=DVMF4(T,ALSBAR,NC,QU,QD,NQ4,AMU4,AMD4,AMQ4) END *CMZ : 10/12/98 20.23.37 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVR4(T,ALSBAR) * from draft TH preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. IF(AML4.GT.0.000001.OR.AMQ4.GT.0.000001)THEN DVR4=DVRL4(T,ALSBAR)+DVRQ4(T,ALSBAR) ELSE DVR4=0. ENDIF END *CMZ : 11/10/99 23.43.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVRL4(T,ALSBAR) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/1/,QU/0.0000000/,QD/-1.0000000/ DVRL4=DVRF4(T,ALSBAR,NC,QU,QD,NL4,AMN4,AME4,AML4) END *CMZ : 11/10/99 23.44.16 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVRQ4(T,ALSBAR) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ DVRQ4=DVRF4(T,ALSBAR,NC,QU,QD,NQ4,AMU4,AMD4,AMQ4) END *CMZ : 10/12/98 20.23.37 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVA4(T,ALSBAR) * from draft TH preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. IF(AML4.GT.0.000001.OR.AMQ4.GT.0.000001)THEN DVA4=DVAL4(T,ALSBAR)+DVAQ4(T,ALSBAR) ELSE DVA4=0. ENDIF END *CMZ : 22/01/99 08.48.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVAL4(T,ALSBAR) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/1/,QU/0.0000000/,QD/-1.0000000/ DVAL4=DVAF4(T,ALSBAR,NC,QU,QD,NL4,AMN4,AME4,AML4) END *CMZ : 07/02/99 23.49.20 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVAQ4(T,ALSBAR) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ DVAQ4=DVAF4(T,ALSBAR,NC,QU,QD,NQ4,AMU4,AMD4,AMQ4) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVA5(AMB5,AMT5) * from VAN E-MAIL 12.05.94 * for new generation with MT5>>MZ and MB5>>MZ * correction by L.B. fax 21.06.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. X=(AMT5/AMB5)**2-1. IF(DABS(X).LT.0.00000001)X=0.00000001 DVAQ5=(AMB5/AMZ)**2*(2+X-2*(1+1/X)*DLOG(1.+X)) DVA5=(4./3.)*DVAQ5 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVR5(AMB5,AMT5) * from VAN E-MAIL 12.05.94 * for new generation with MT5>>MZ and MB5>>MZ * correction by L.B. fax 21.06.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. IF(DABS(X).LT.0.00000001)X=0.00000001 ** DVRQ5=0.75*DVA5(AMB5,AMT5)-2./3.+(2./9)*DLOG(1.+X) ** DVR5=(4./3.)*DVRQ5 DVR5 = DVA5(AMB5,AMT5) -8./9. END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVM5(AMB5,AMT5) * from VAN E-MAIL 12.05.94 * for new generation with MT5>>MZ and MB5>>MZ * correction by L.B. fax 21.06.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. X=(AMT5/AMB5)**2-1. IF(DABS(X).LT.0.00000001)X=0.00000001 * DVMQ5=0.75*DVA5(AMB5,AMT5)-2./3.+(4./9)*DLOG(1.+X) * 1+(4./3.)*(S2-C2)*(0.25-3/X-3/X**2+(3/X**3)*(1+X/2)*(1+X-X**2/3) * 2*DLOG(1.+X)) * DVM5=(4./3.)*DVMQ5 DVM5=DVA5(AMB5,AMT5)-8./9.+(16./9.)*(S2-C2)* 1(0.333333-(2/X**2)*(1+X)+(3./X**3)*(X+2./3.-X**3/6.)*DLOG(1+X)) END *CMZ : 2.00/02 02/09/98 22.51.20 by A.Rozanov *CMZ : 1.30/04 18/01/95 16.34.21 by A.Rozanov *CMZ : 1.30/03 18/01/95 14.45.22 by A.Rozanov *CMZ : 1.30/02 17/01/95 23.50.21 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVM(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,TMINDV. COMMON/TMINDV/TMIN,DELTVM,DELTVA,DELTVR *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. * FACT=1.3333333333D0*(ALSBAR/PI) *-----M.Vysotsky 21.03.94 correction for running of alsbar in * oblique terms to alsbar(mt) * FACT=1.3333333333D0*(ALPHATT(T,ALSBAR)/PI) FACT=1.3333333333D0*(ALPHAMT(T,ALSBAR)/PI) ! MIV 17.01.95 * if(IOPTION(1).eq.0)then * O4T=1./(4.*T) * afac=1. * else * af1=alphamt(t,alsbar) * af2=alphatt(t,alsbar) * if(af2.gt.0.)then * afac=af1/af2 * else afac=1. * endif O4T=afac/(4.*T) * endif if(IOPTION(1).eq.0.and.IOPTION(2).eq.0)then dvt2=0. elseif(IOPTION(1).ne.0)then dvt2=-(albar/pi)*amhmt(t,h)*t**2/(16*s2*c2)*(2/t) elseif(IOPTION(2).ne.0)then dvt2=+(albar/pi)*amhmt(t,h)*t**2/(16*s2*c2)*(2/t) endif if(IOPTION(3).eq.0.and.IOPTION(4).eq.0)then dvals2=0. elseif(IOPTION(3).ne.0)then dvals2=-1.2*alphamt(t,alsbar)**2*t*(2/t) elseif(IOPTION(4).ne.0)then dvals2=+1.2*alphamt(t,alsbar)**2*t*(2/t) endif C2T=C2/T BRACK1=T*A1(O4T)+(1.-(16./3.)*S2)*T*V1(O4T) BRACK2=(0.5-0.6666666666D0*S2)*DLOG(T)*afac-4*(1.-S2/C2)*T*F1(C2T) BRACK3=-4*(S2/C2)*T*F1(0.D0) BRACK=BRACK1+BRACK2+BRACK3 IF(T.GE.TMIN)THEN DVM=D1VM(T)+ 1 FACT*BRACK+(8./3.)*(ALSBAR/PI)*(C2-S2)*DLOG(C2) 2 +D3VI(T,ALSBAR) ! MIV 17.01.95 2 +D4VI(T,H)+D4PVM(T,H) ! AR 02.09.98 3 +D5VM(T,H,ALSBAR) 4 +DVML4(T,ALSBAR)+DVMQ4(T,ALSBAR)+dvt2+dvals2 ELSE DVM=DELTVM*ALSBAR/PI+DVML4(T,ALSBAR)+DVMQ4(T,ALSBAR) ENDIF END *CMZ : 11/10/99 23.43.08 by A.Rozanov *CMZ : 2.00/02 02/09/98 22.51.20 by A.Rozanov *CMZ : 1.30/04 18/01/95 16.36.18 by A.Rozanov *CMZ : 1.30/03 18/01/95 14.50.18 by A.Rozanov *CMZ : 1.30/02 17/01/95 23.51.21 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVR(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,TMINDV. COMMON/TMINDV/TMIN,DELTVM,DELTVA,DELTVR *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. * FACT=1.33333333333333333D0*(ALSBAR/PI) *-----M.Vysotsky 21.03.94 correction for running of alsbar in * oblique terms to alsbar(mt) * FACT=1.3333333333D0*(ALPHATT(T,ALSBAR)/PI) FACT=1.3333333333D0*(ALPHAMT(T,ALSBAR)/PI) ! MIV 17.01.95 * if(IOPTION(1).eq.0)then * O4T=1./(4.*T) * afac=1. * else * af1=alphamt(t,alsbar) * af2=alphatt(t,alsbar) * if(af2.gt.0.)then * afac=af1/af2 * else afac=1. * endif O4T=afac/(4.*T) * endif if(IOPTION(1).eq.0.and.IOPTION(2).eq.0)then dvt2=0. elseif(IOPTION(1).ne.0)then dvt2=-(albar/pi)*amhmt(t,h)*t**2/(16*s2*c2)*(2/t) elseif(IOPTION(2).ne.0)then dvt2=+(albar/pi)*amhmt(t,h)*t**2/(16*s2*c2)*(2/t) endif if(IOPTION(3).eq.0.and.IOPTION(4).eq.0)then dvals2=0. elseif(IOPTION(3).ne.0)then dvals2=-1.2*alphamt(t,alsbar)**2*t*(2/t) elseif(IOPTION(4).ne.0)then dvals2=+1.2*alphamt(t,alsbar)**2*t*(2/t) endif BRACK=T*A1(O4T)-(5./3.)*T*V1(O4T) 1 -4*T*F1(0.D0)+(1./6.)*DLOG(T)*afac IF(T.GE.TMIN)THEN DVR=D1VR(T) 1 +FACT*BRACK 2 +D3VI(T,ALSBAR) ! MIV 17.01.95 2 +D4VI(T,H)+D4PVR(T,H) ! AR 02.09.98 3 +D5VR(T,H,ALSBAR) 4 +DVRL4(T,ALSBAR)+DVRQ4(T,ALSBAR)+dvt2+dvals2 ELSE DVR=DELTVR*ALSBAR/PI+DVRL4(T,ALSBAR)+DVRQ4(T,ALSBAR) ENDIF END *CMZ : 2.00/02 02/09/98 22.51.20 by A.Rozanov *CMZ : 1.30/04 18/01/95 16.35.27 by A.Rozanov *CMZ : 1.30/03 18/01/95 14.46.55 by A.Rozanov *CMZ : 1.30/02 17/01/95 23.50.46 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVA(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,TMINDV. COMMON/TMINDV/TMIN,DELTVM,DELTVA,DELTVR *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. * FACT=1.3333333333D0*(ALSBAR/PI) *-----M.Vysotsky 21.03.94 correction for running of alsbar in * oblique terms to alsbar(mt) * FACT=1.3333333333D0*(ALPHATT(T,ALSBAR)/PI) FACT=1.3333333333D0*(ALPHAMT(T,ALSBAR)/PI) ! MIV 17.01.95 * if(IOPTION(1).eq.0)then * O4T=1./(4.*T) * afac=1. * else * af1=alphamt(t,alsbar) * af2=alphatt(t,alsbar) * if(af2.gt.0.)then * afac=af1/af2 * else afac=1. * endif O4T=afac/(4.*T) * endif if(IOPTION(1).eq.0.and.IOPTION(2).eq.0)then dvt2=0. elseif(IOPTION(1).ne.0)then dvt2=-(albar/pi)*amhmt(t,h)*t**2/(16*s2*c2)*(2/t) elseif(IOPTION(2).ne.0)then dvt2=+(albar/pi)*amhmt(t,h)*t**2/(16*s2*c2)*(2/t) endif if(IOPTION(3).eq.0.and.IOPTION(4).eq.0)then dvals2=0. elseif(IOPTION(3).ne.0)then dvals2=-1.2*alphamt(t,alsbar)**2*t*(2/t) elseif(IOPTION(4).ne.0)then dvals2=+1.2*alphamt(t,alsbar)**2*t*(2/t) endif BRACK1=T*A1(O4T)-0.25*A11(O4T/afac)*afac *-----BRACK2=(T*V1(O4T)-0.25*V11(O4T))*(1.-(1./8.)*S2)**2--misprint BRACK2=(T*V1(O4T)-0.25*V11(O4T/afac)*afac)*(1.-(8./3.)*S2)**2 *-----BRACK3=0.5-0.6666666666D0*S2+(16./9.)*S2**2- bug BRACK3=(0.5-0.6666666666D0*S2+( 4./9.)*S2**2)*afac BRACK4=-4*T*F1(0.D0) BRACK=BRACK1+BRACK2+BRACK3+BRACK4 * DVR=FACT*BRACK IF(T.GE.TMIN)THEN DVA=FACT*BRACK+(8./3.)*(ALSBAR/PI)*(C2-S2+(20./9.)*S2**2) 1 +D3VI(T,ALSBAR) ! MIV 17.01.95 1 +D4VI(T,H)+D4PVA(T,H) ! AR 02.09.98 2 +D5VA(T,H,ALSBAR) 3 +DVAL4(T,ALSBAR)+DVAQ4(T,ALSBAR)+dvt2+dvals2 ELSE DVA=DELTVA*ALSBAR/PI+DVAL4(T,ALSBAR)+DVAQ4(T,ALSBAR) ENDIF END *CMZ : 1.30/02 17/01/95 16.35.46 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.57.55 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION D1VM(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. D1VM=-16.*PI*s2**2*(DWAA(C2)+DTAA(T))/3. END *CMZ : 1.30/02 17/01/95 15.37.56 by A.Rozanov *CMZ : 1.30/01 16/01/95 17.00.40 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION D1VA(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. D1VA=0.D0 END *CMZ : 1.30/02 17/01/95 16.36.44 by A.Rozanov *CMZ : 1.30/01 16/01/95 17.01.39 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION D1VR(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. D1VR=-16.*PI*s2*c2*(DWAA(c2)+DTAA(T))/3. END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION V1(R) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. DATA DZ2/1.644934067/ DATA DZ3/1.2020569/ V1=R*(4*DZ3-(5./6.))+R**2*(328./81.)+ 1R**3*(1796./(25.*27.)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION V1mcad(R) *-----from V.A.Novikov MATHCAD 26.07.93 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. R1=DMAX1(1.D-6,1.D0-R) Y=DSQRT(R1) V1mcad=-6.57977*(3.-5.*Y**2)*DLOG(2.*Y)+1.0829 1 +25.1327*Y+8.4465*Y**2-66.3929*Y**3+22.6086*Y**4 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION V11mcd(R) *-----from V.A.Novikov MATHCAD 26.07.93 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. R1=DMAX1(1.D-6,1.D0-R) Y=DSQRT(R1) V11mcd=9.8696/Y**2-12.56637/Y-24.8958-32.89868*DLOG(2*Y) + +99.58845*Y-45.2172*Y**2 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION V11(R) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. DATA DZ2/1.644934067/ DATA DZ3/1.2020569/ V11=(4*DZ3-(5./6.))+2*R*(328./81.)+3*R**2*(1796./(25.*27.)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION A1(R) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. DATA DZ2/1.644934067/ DATA DZ3/1.2020569/ *-----A1prep=(-6*DZ3-3*DZ2+21./4.)+R*(4*DZ3-5./6.)+R**2*(689./405.)+ A1=(-6*DZ3-3*DZ2+21./4.)+R*(4*DZ3-49./18.)+R**2*(689./405.)+ 1 R**3*(3382./(7.*25.*27.)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION A1mcad(R) *-----from V.A.Novikov MATHCAD 26.07.93 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. R1=DMAX1(1.D-6,1.D0-R) Y=DSQRT(R1) A1mcad=13.1595*Y**2*DLOG(2.*Y)-0.6043-9.7824*Y**2-6.5179*Y**3 1 +0.8861*Y**4 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION A11(R) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. DATA DZ2/1.644934067/ DATA DZ3/1.2020569/ *-----A11prep=(4*DZ3-5./6.)+2*R*(689./405.)+ A11=(4*DZ3-49./18.)+2*R*(689./405.)+ 1 3*R**2*(3382./(7.*25.*27.)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION A11mcd(R) *-----from V.A.Novikov MATHCAD 26.07.93 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. R1=DMAX1(1.D-6,1.D0-R) Y=DSQRT(R1) A11mcd=-13.1595*DLOG(2*Y)+3.2027+9.7769*Y-1.7722*Y**2 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION F1(X) *-----formula (40) from TH6696 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. DATA DZ2/1.644934067/ DATA DZ3/1.2020569/ *-----F1prep=(-1.5*DZ3-0.5*DZ2+23./16.) + X*(DZ3-(1./9.)*DZ2+23./16.)+ F1=(-1.5*DZ3-0.5*DZ2+23./16.) + X*(DZ3-(1./9.)*DZ2-25./72.)+ 1 X**2*((1./8.)*DZ2+25./(3.*64.))+X**3*(DZ2/30.+5./72.) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION F1mcad(X) *-----formula from MATCAD ov V.Novikov 27.07.93 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. DL1X=DLOG(1.D0-X) F1mcad = -1.1881 - 2.0979*X 1+ 4.1157*X**2 - 2.2082*X**3 2+ 3.6968*X**4 - 2.1815*X**5 3+ (1.-X)**2*DL1X*((3./8.)*DL1X-1.64493-9./8.) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DDVM(T,ALSBAR) *----- short formula (41) from TH-6696 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. *-----DVM=(ALSBAR/PI)*(-2.86*T+0.46*DLOG(T)-1.92-0.68/T-0.21/T**2) DDVM=(ALSBAR/PI)*(-2.8599*T+0.4612*DLOG(T) 1-1.9174-0.6765/T-0.2083/T**2) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DDVA(T,ALSBAR) *----- short formula (42) from TH-6696 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DDVA=(ALSBAR/PI)*(-2.8599*T+2.2432 1 -0.1911/T-0.0461/T**2) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DDVR(T,ALSBAR) *----- short formula (43) from TH-6696 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DDVR=(ALSBAR/PI)*(-2.8599*T+0.2222*DLOG(T) 1-1.5129-0.4207/T-0.0775/T**2) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION G(T,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * KUHN CORRECTION 1.4 => 1.4+ (44/675.+... * D.B.+M.I.V. 04.07.94 BRA=1.40923+(44./675.+(2./135.)*DLOG(T))/T G=1.+ALSBAR/PI+BRA*(ALSBAR/PI)**2-12.76706*(ALSBAR/PI)**3 END *CMZ : 14/01/99 18.27.07 by A.Rozanov *CMZ : 1.30/05 18/01/95 19.03.32 by A.Rozanov *CMZ : 1.30/02 17/01/95 23.36.30 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION PHI(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. CONST=(3-2*S2)/(2*S2*C2) CLOG=DLOG(T/C2) BRA1= -6.716+(8.368*C2*CLOG-3.408*C2)/T 1 +(9.126*C2**2*CLOG+2.26*C2**2)/T**2 2 +(4.043*C2**3*CLOG+7.41*C2**3)/T**3 BRA=2.88*CLOG+BRA1 IF(T.GE.1.)THEN PHI=CONST*(T+C2*BRA) ELSE PHI=0. ENDIF END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION PHItest(t,h,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. CONST=(3-2*S2)/(2*S2*C2) CLOG=DLOG(T/C2) BRA=2.88*CLOG-6.716+(8.368*C2*CLOG-3.408*C2)/T 1 +(9.126*C2**2*CLOG+2.26*C2**2)/T**2 2 +(4.043*C2**3*CLOG+7.41*C2**3)/T**3 * * 2.29 = (1./3.)*(PI**2-3.) ! from TH6855 before (31) * * PHI=CONST*(T*Z1Z2(T,H)*(1-2.29*ALSBAR/PI)+C2*BRA) ! until 24.03.94 * M.Vysotsky 24.03.94 correct double counting of alsbar/pi term OSPI=PI**2/3. IF(T.GE.1)THEN PHItest=const*(T*Z1Z2(T,H)*(1.-OSPI*ALPHATT(T,ALSBAR)/PI)+C2*BRA) ELSE PHItest=0. ENDIF write(6,*)'t,h,alsbar,c2,bra,phi', * t,h,alsbar,c2,bra,phitest END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION PHIA(T,H,ALSBAR) *-----phi(t) for amplitude, like AFBBB, sin2bb etc *-----correction by D.Bardine 28.03.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. CONST=(3-2*S2)/(2*S2*C2) CLOG=DLOG(T/C2) BRA=2.88*CLOG-6.716+(8.368*C2*CLOG-3.408*C2)/T 1 +(9.126*C2**2*CLOG+2.26*C2**2)/T**2 2 +(4.043*C2**3*CLOG+7.41*C2**3)/T**3 * * 2.29 = (1./3.)*(PI**2-3.) ! from TH6855 before (31) * * PHI=CONST*(T*Z1Z2(T,H)*(1-2.29*ALSBAR/PI)+C2*BRA) ! until 24.03.94 * M.Vysotsky 24.03.94 correct double counting of alsbar/pi term OSPI=PI**2/3. IF(T.GE.1)THEN * PHI=CONST*(T*Z1Z2(T,H)*(1.-OSPI*ALPHAT(T,ALSBAR)/PI)+C2*BRA) *-----D.Y.Bardine remark for amplitude phi(t) PHIA=CONST*(T*Z1Z2(T,H) +C2*BRA) ELSE PHIA=0. ENDIF END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AI(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. IF(T.GE.1)THEN AI=-9.25-3*DLOG(T)+0.26/T+0.04/T**2 ELSE AI=0. ENDIF END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GDB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. SBRA=1.-4*S2/3. BRA=1.+SBRA**2 GDB=3*GO*G(T,ALSBAR)* 1BRA*(1.+ALBAR/(12.*PI)-ALBAR*ALSBAR/(36*PI**2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GUB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. SBRA=1.-8*S2/3. BRA=1.+SBRA**2 GUB=3*GO*G(T,ALSBAR)* 1BRA*(1.+ALBAR/(3.*PI)-ALBAR*ALSBAR/(9*PI**2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GSB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GSB=GDB(T,H,ALSBAR) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GCB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GCB=GUB(T,H,ALSBAR) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GTB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GTB=0.D0 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GT(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GT=0.D0 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GG(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GG=0.D0 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GGB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GGB=0.D0 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DGAB(T,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEND. * D.Y.B.+M.I.V. redefine from Kuhn's formulas B143=1.43 * 04.07.94 DLT=DLOG(T) B143=11.286-DLT BRA=1+3.67*(ALSBAR/PI)+B143*(ALSBAR/PI)**2 IF(ALSBAR.GE.0.001)THEN * AMU22=AMU2 AMU22=AMU(ALSBAR)**2 ! running b mass * WRITE(6,*)'ALSBAR,AMU22',ALSBAR,AMU22 ELSE AMU22=1. ENDIF f016= 6*(amb0/amz)**2 DGAB=(ALSBAR/PI)**2*(AI(T)/3.)-f016*AMU22*BRA 1-10.*(AMB0/AMZ)**2*(AMU22/T)*(ALSBAR/PI)**2*(8./81.+DLT/54.) 2+(ALSBAR/PI)**3*((23./12.)*DLT**2-67.*DLT/18.-15.9) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DGVB(T,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEND. * BRA=1+8.7*(ALSBAR/PI)+45.3*(ALSBAR/PI)**2 BRA=1.+8.7*(ALSBAR/PI)+45.15*(ALSBAR/PI)**2 * AMU22=AMU2 AMU22=AMU(ALSBAR)**2 ! running b mass * WRITE(6,*)'ALSBAR,AMU22',ALSBAR,AMU22 f032=12*(amb0/amz)**2 DGVB=f032*AMU22*(ALSBAR/PI)*BRA END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GD(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEND. DATA AIQ3/-0.5/,QQ/-0.33333333333333/ *-----use Kuhn formulas checked by L.B. 29.09.94 *-----from a piece of paper given by D,Bardine IFLAV=1 GD=GQQ(T,H,ALSBAR,AIQ3,QQ,AMDOWN,IFLAV) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GU(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEND. DATA AIQ3/+0.5/,QQ/0.66666666666666/ *-----use Kuhn formulas checked by L.B. 29.09.94 *-----from a piece of paper given by D,Bardine IFLAV=2 GU=GQQ(T,H,ALSBAR,AIQ3,QQ,AMUP,IFLAV) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GS(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEND. DATA AIQ3/-0.5/,QQ/-0.33333333333333/ *-----use Kuhn formulas checked by L.B. 29.09.94 *-----from a piece of paper given by D,Bardine AMSRUN=0. IFLAV=3 GS=GQQ(T,H,ALSBAR,AIQ3,QQ,AMSRUN,IFLAV) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GC(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEND. DATA AIQ3/+0.5/,QQ/0.66666666666666/ *-----use Kuhn formulas checked by L.B. 29.09.94 *-----from a piece of paper given by D,Bardine AMCRUN=AMCHRM IF(ALSBAR.GT.0.001)AMCRUN=0.52*AMCHRM IFLAV=4 GC=GQQ(T,H,ALSBAR,AIQ3,QQ,AMCRUN,IFLAV) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 2.00/01 08/03/95 11.51.24 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. DATA AIQ3/-0.5/,QQ/-0.3333333333/ *-----use Kuhn formulas checked by L.B. 29.09.94 *-----from a piece of paper given by D,Bardine IF(ALSBAR.GE.0.001)THEN AMU22=AMU(ALSBAR)**2 ! running b mass ELSE AMU22=1. ENDIF AMBRUN=AMB0*DSQRT(AMU22) IFLAV=5 GB=GQQ(T,H,ALSBAR,AIQ3,QQ,AMBRUN,IFLAV) *****1 + 0.007 ! MIV idea to solve Rb crisis 07.12.94 * Shiftman-Vysotsky's option 8 IF(IOPTION(8).NE.0)GB=GB+0.007 END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 2.00/03 08/09/98 20.16.44 by A.Rozanov *CMZ : 2.00/02 02/09/98 23.09.17 by A.Rozanov *CMZ : 1.30/06 18/01/95 23.46.51 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GQQ(T,H,ALSBAR,AIQ3,QQ,AMQBAR,IFLAV) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. *-----use Kuhn formulas checked by L.B. 29.09.94 *-----from a of paper given by D,Bardine IF(IFLAV.EQ.5)THEN LBOT=1 ELSE LBOT=0 ENDIF SMT2=1./T Q=DABS(QQ) ga=GAQ(T,H,ALSBAR,AIQ3,QQ,IFLAV) gva=GVAQ(T,H,ALSBAR,AIQ3,QQ,IFLAV) gv=gva*ga RA=RAQ(T,H,ALSBAR,AIQ3,QQ,AMQBAR,IFLAV) RV=RVQ(T,H,ALSBAR,AIQ3,QQ,AMQBAR,IFLAV) * if(IOPTION(5).eq.0.and.IOPTION(6).eq.0)then dgqq=0. elseif(IOPTION(5).ne.0)then *-------CORRECTION BY MIV,VAN AROUND 18.11.94 BY E-MAIL IF(IFLAV.EQ.1.OR.IFLAV.EQ.3)THEN DGQQ= 0.0000756 ELSEIF(IFLAV.EQ.2.OR.IFLAV.EQ.4)THEN DGQQ= 0.0000796 ELSE DGQQ= 0.0 ENDIF elseif(IOPTION(6).ne.0)then IF(IFLAV.EQ.1.OR.IFLAV.EQ.3)THEN DGQQ=-0.0000756 ELSEIF(IFLAV.EQ.2.OR.IFLAV.EQ.4)THEN DGQQ=-0.0000796 ELSE DGQQ= 0.0 ENDIF endif * calculate alpha*alphas correction to Z boson width according * to Czarnecki, Kuhn PRL 77 (1996) 3955 and * Harlander et al. PL B 426 (1998) 125 (From MIV E-mail 10.08.98) IF(IFLAV.EQ.2.OR.IFLAV.EQ.4)THEN * u,c quarks DGCZ= -0.000124 ELSEIF(IFLAV.EQ.1.OR.IFLAV.EQ.3)THEN * d,s quarks DGCZ= -0.000173 ELSEIF(IFLAV.EQ.5)THEN * b quark DGCZ= -0.00004 ELSE DGCZ= 0.0 ENDIF * GQQ=12*GO*(RA*ga**2+RV*gv**2) +DGCZ + dgqq END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FF2(X) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. FF2=-37./12.+DLOG(X)+(7./81.)*X+0.0132*X**2 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FF3(X) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. DATA DZ2/1.644934067/ DATA DZ3/1.2020569/ FF3=-5651./216.+8./3.+23*PI**2/36.+DZ3 1+67.*DLOG(X)/18.+23*(DLOG(X))**2/12. END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GBB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. BRA1=1. BRA2=(1.-4.*S2/3.)**2 G2=3*GO*(1+ALBAR/(12*PI)-ALBAR*ALSBAR/(36*PI**2)) GBB=G2*(G(T,ALSBAR)+ 1G(T,ALSBAR)*BRA2) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GH(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. *-----G1=GO*G(T,ALSBAR)*(20.2288+0.05268*VAL(T,H,ALSBAR) *----1+0.02487*VRL(T,H,ALSBAR)) *-----G2=GO*(-(ALBAR/PI)*PHI(T)+(ALSBAR/PI)**2*AI(T)-0.05*AMU2) *---- GH=G1+G2 GH=GU(T,H,ALSBAR)+GD(T,H,ALSBAR)+GC(T,H,ALSBAR)+ 1 GS(T,H,ALSBAR)+GT(T,H,ALSBAR)+GB(T,H,ALSBAR)+GG(T,H,ALSBAR) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GHB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GHB=GUB(T,H,ALSBAR)+GDB(T,H,ALSBAR)+GCB(T,H,ALSBAR)+ 1GSB(T,H,ALSBAR)+GTB(T,H,ALSBAR)+GBB(T,H,ALSBAR)+GGB(T,H,ALSBAR) END *CMZ : 11/04/99 21.01.26 by A.Rozanov *CMZ : 1.30/06 18/01/95 21.06.33 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GL(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. GL=GLEPTON(T,H,ALSBAR,0.D0) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VA_GL(GL,VR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. SBRA=1.-4*S2 BRA=1.+SBRA**2+(3*ALBAR*SBRA*VR)/(2*PI*(C2-S2)) VA_GL=(GL/(GO*BRA*(1.+(3.*ALBAR)/(4.*PI)))-1.) 1*((16*PI*S2*C2)/(3*ALBAR)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GLB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. SBRA=1.-4*S2 BRA=1.+SBRA**2 GLB=GO* 1BRA*(1.+(3.*ALBAR)/(4.*PI)) END *CMZ : 11/04/99 20.59.49 by A.Rozanov *CMZ : 1.30/06 18/01/95 21.02.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GELE(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEND. GELE=GLEPTON(T,H,ALSBAR,AMEL) END *CMZ : 1.30/06 18/01/95 21.04.11 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GMUO(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEND. GMUO=GLEPTON(T,H,ALSBAR,AMMU) END *CMZ : 1.30/06 18/01/95 21.05.15 by A.Rozanov *CMZ : 1.30/01 16/01/95 22.50.18 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GTAU(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEND. GTAU=GLEPTON(T,H,ALSBAR,AMTAU) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GNU(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GNU=8*GO*(0.5+(3*ALBAR*VNU(T,H,ALSBAR))/(64*PI*S2*C2))**2 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GNUB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GNUB=2*GO END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GZ(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GZ=GH(T,H,ALSBAR)+ 1 GELE(T,H,ALSBAR)+GMUO(T,H,ALSBAR)+GTAU(T,H,ALSBAR)+ 2 3*GNU(T,H,ALSBAR) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GZB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GZB=GHB(T,H,ALSBAR)+ 1 3*GLB(T,H,ALSBAR)+ 2 3*GNUB(T,H,ALSBAR) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION RL(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. RL=GH(T,H,ALSBAR)/GL(T,H,ALSBAR) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION RLB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. RLB=GHB(T,H,ALSBAR)/GLB(T,H,ALSBAR) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION RB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. RB=GB(T,H,ALSBAR)/GH(T,H,ALSBAR) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION RBB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. RBB=GBB(T,H,ALSBAR)/GHB(T,H,ALSBAR) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION RC(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. RC=GC(T,H,ALSBAR)/GH(T,H,ALSBAR) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION SIGH(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. AMZ102=(AMZ/100.D0)**2 TONB10=TONB/10000. GLL=GL(T,H,ALSBAR) GHH=GH(T,H,ALSBAR) GZZ=GZ(T,H,ALSBAR) IF(GLL.GT.1000..OR.GZZ.GT.1000.OR.GZZ.LT.0.01)THEN WRITE(6,*)'AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO', 1 AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO WRITE(6,*)'GLL,GHH,GZZ,T,H,ALSBAR', 1 GLL,GHH,GZZ,T,H,ALSBAR ENDIF SH=(12*PI*GLL*GHH)/ 1(AMZ102*GZZ**2) SIGH=SH*TONB10 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION SIGHB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. AMZ102=(AMZ/100.D0)**2 TONB10=TONB/10000. GLL=GLB(T,H,ALSBAR) GHH=GHB(T,H,ALSBAR) GZZ=GZB(T,H,ALSBAR) IF(GLL.GT.1000..OR.GZZ.GT.1000.OR.GZZ.LT.0.01)THEN WRITE(6,*)'AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO', 1 AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO WRITE(6,*)'GLL,GHH,GZZ,T,H,ALSBAR', 1 GLL,GHH,GZZ,T,H,ALSBAR ENDIF SH=(12*PI*GLL*GHH)/ 1(AMZ102*GZZ**2) SIGHB=SH*TONB10 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AFB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/-0.5/ DATA QF/1./ GA=T3*(1.+(3*ALBAR*VAL(T,H,ALSBAR))/(32*PI*S2*C2)) GV=GA*(1-4*QF*S2+(3*ALBAR*QF*VRL(T,H,ALSBAR))/(4*PI*(C2-S2))) AFB=0.75*(2*GA*GV/(GV**2+GA**2))**2 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ALE(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/-0.5/ DATA QF/1./ GA=T3*(1.+(3*ALBAR*VAL(T,H,ALSBAR))/(32*PI*S2*C2)) GV=GA*(1-4*QF*S2+(3*ALBAR*QF*VRL(T,H,ALSBAR))/(4*PI*(C2-S2))) ALE=2*GA*GV/(GV**2+GA**2) END *CMZ : 29/09/98 22.22.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AF(T,H,ALSBAR,T3,QF) *-----introduce ALSBAR as argument 26.05.95 A.R. *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. *-----??????????? IF(QF.GT.0.3.AND.QF.LT.0.4)THEN VAF=VAD(T,H,ALSBAR) VRF=VRD(T,H,ALSBAR) ELSEIF(QF.GT.0.6.AND.QF.LT.0.7)THEN *bug VAF=VAD(T,H,ALSBAR) *bug VRF=VRD(T,H,ALSBAR) VAF=VAU(T,H,ALSBAR) VRF=VRU(T,H,ALSBAR) ELSE VAF=VAL(T,H,ALSBAR) VRF=VRL(T,H,ALSBAR) ENDIF *-----???????????? GA=T3*(1.+(3*ALBAR*VAF)/(32*PI*S2*C2)) GV=GA*(1-4*QF*S2+(3*ALBAR*QF*VRF)/(4*PI*(C2-S2))) AF=2*GA*GV/(GV**2+GA**2) END *CMZ : 2.00/00 26/01/96 09.05.47 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AFBBB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. AFBBB=0.75*ALE(T,H,ALSBAR)*AB(T,H,ALSBAR) IF(PRTFLG(1).GT.0.)THEN WRITE(6,*)'++AFBBB: T,H,ALSBAR', 1 T,H,ALSBAR WRITE(6,*)'AFBBB', 1 AFBBB ENDIF END *CMZ : 14/01/99 18.27.08 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION SIN2B(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. DATA T3/-0.5/ DATA QF/0.33333333333333/ VAF=VAD(T,H,ALSBAR) VRF=VRD(T,H,ALSBAR) GA=T3*(1.+(3*ALBAR*VAF)/(32*PI*S2*C2)) * correction by van 09.11.93 : DGVBB=DGVB(T,ALSBAR) DGABB=DGAB(T,ALSBAR) GGG=G(T,ALSBAR) BR0=1+(DGVBB-DGABB)/(2.*GGG) ! corrected VAN 22.12.93 BR0=1. BR1=(1-4*QF*S2)*BR0 BR2=(3*ALBAR*QF*VRF)/(4*PI*(C2-S2)) *-----special phia(t) for amplitude * BR3=-(ALBAR*s2*PHIA(T,H,ALSBAR))/(3.*PI*(3.-2.*s2)) BR3=- ALBAR*s2*(PHI(T,H,ALSBAR)+DPHI(T,H,ALSBAR)) 1 /(3.*PI*(3.-2.*s2)) GV=GA*(BR1+BR2+BR3) * AF=2*GA*GV*VELOB/((3.-VELOB**2)*0.5*GV**2+(VELOB*GA)**2) SIN2B=0.75*(1.-GV/GA) END *CMZ : 14/01/99 18.27.08 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AFBBBP(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. DATA T3/-0.5/ DATA QF/0.33333333333333/ VAF=VAD(T,H,ALSBAR) VRF=VRD(T,H,ALSBAR) GA=T3*(1.+(3*ALBAR*VAF)/(32*PI*S2*C2)) * correction by van 09.11.93 : DGVBB=DGVB(T,ALSBAR) DGABB=DGAB(T,ALSBAR) GGG=G(T,ALSBAR) BR0=1+(DGVBB-DGABB)/(2.*GGG) ! corrected VAN 22.12.93 BR0=1. BR1=(1-4*QF*S2)*BR0 BR2=(3*ALBAR*QF*VRF)/(4*PI*(C2-S2)) *-----special phia(t) for amplitude * BR3=-(ALBAR*s2*PHIA(T,H,ALSBAR))/(3.*PI*(3.-2.*s2)) BR3=- ALBAR*s2*(PHI(T,H,ALSBAR)+DPHI(T,H,ALSBAR)) 1/(3.*PI*(3.-2.*s2)) GV=GA*(BR1+BR2+BR3) * AF=2*GA*GV*VELOB/((3.-VELOB**2)*0.5*GV**2+(VELOB*GA)**2) AFBBBP=2*GV*GA/(GV**2+GA**2) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AFBCC(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/+0.5/ DATA QF/0.66666666666666/ AFBCC=0.75*ALE(T,H,ALSBAR)*AF(T,H,ALSBAR,T3,QF) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION QFB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/-0.5/ DATA QF/1./ *-----QFB=0.25*(1.-GV/GA) QFB= QF*S2-(3*ALBAR*QF*VRL(T,H,ALSBAR))/(16*PI*(C2-S2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ALR(T,H,ALSBAR) *-----left-right asymmetry for SLD *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA QF/1./ *-----QFB=0.25*(1.-GV/GA) QFB= QF*S2-(3*ALBAR*QF*VRL(T,H,ALSBAR))/(16*PI*(C2-S2)) alr=(2*(1.-4.*qfb))/(1+(1.-4*qfb)**2) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AMWMZ(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C=DSQRT(C2) VMTHA=VM(T,H,ALSBAR) AMWMZ=C+(3*C*ALBAR*VMTHA)/(32*PI*S2*(C2-S2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AMWMZNOB(T,H,ALSBAR) * MW/MZ WITHOUR BARBIERI CORRECTION *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C=DSQRT(C2) AMWMZNOB=C+(3*C*ALBAR*VM_NOB(T,H,ALSBAR))/(32*PI*S2*(C2-S2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VM_MWMZ(AMWMZ) * to calculate VM from Mw/Mz *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C=DSQRT(C2) VM_MWMZ=((AMWMZ-C)/(3*C*ALBAR))*(32*PI*S2*(C2-S2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AMWMZB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C=DSQRT(C2) AMWMZB=C END *CMZ : 11/01/99 01.30.01 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION S2NUN(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C=DSQRT(C2) AMWMZ=C+(3*C*ALBAR*VM(T,H,ALSBAR))/(32*PI*S2*(C2-S2)) S2NUN=1.-AMWMZ**2 + +0.00142*(T*AMZ**2-175.**2)/(100.**2) + -0.00048*dlog(DSQRT(H)*AMZ/150.) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GAELE(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/-0.5/ DATA QF/1./ GA=T3*(1.+(3*ALBAR*VAL(T,H,ALSBAR))/(32*PI*S2*C2)) GAELE=GA END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GAELEB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. GAELEB=-0.5 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GVAELE(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/-0.5/ DATA QF/1./ GVAELE=1.-4*QF*S2+(3*ALBAR*QF*VRL(T,H,ALSBAR))/(4*PI*(C2-S2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VR_GVGA(GVGA) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/-0.5/ DATA QF/1./ VR_GVGA=((GVGA-1.+4*QF*S2)/(3*ALBAR*QF))*(4*PI*(C2-S2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GVAELB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/-0.5/ DATA QF/1./ GVAELB=1.-4*QF*S2 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FP(P) * * formula F.2 on page 78 of Novikov et al, NP B397 (1993)35-83. * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. OS4P=1./DSQRT(4.*P) IF(4*P.GE.1)THEN FP=2.*(1.-DSQRT(4.*P-1.)*DASIN(OS4P)) ELSE T1=DSQRT(1.-4.*P) T2=(1.+T1)*OS4P FP=2.*(1.-T1*DLOG(T2)) ENDIF END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION THEORY(I,T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. IF(I.EQ.2)THEN THEORY=GZ(T,H,ALSBAR) ELSEIF(I.EQ.3)THEN THEORY=SIGH(T,H,ALSBAR) ELSEIF(I.EQ.4)THEN THEORY=RL(T,H,ALSBAR) ELSEIF(I.EQ.5)THEN THEORY=AFB(T,H,ALSBAR) ELSEIF(I.EQ.6)THEN THEORY=RB(T,H,ALSBAR) ELSEIF(I.EQ.7)THEN THEORY=AMWMZ(T,H,ALSBAR) ELSEIF(I.EQ.8)THEN THEORY=ALE(T,H,ALSBAR) ELSEIF(I.EQ.9)THEN THEORY=ALE(T,H,ALSBAR) ELSEIF(I.EQ.10)THEN THEORY=AFBBB(T,H,ALSBAR) ELSEIF(I.EQ.11)THEN THEORY=AFBCC(T,H,ALSBAR) ELSEIF(I.EQ.12)THEN THEORY=QFB(T,H,ALSBAR) ELSEIF(I.EQ.13)THEN THEORY=S2NUN(T,H,ALSBAR) ELSEIF(I.EQ.14)THEN THEORY=ALR(T,H,ALSBAR) ELSE THEORY=0. ENDIF END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION THMSM(I,T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. IF(I.EQ.1)THEN THMSM=AMWMZ(T,H,ALSBAR) ELSEIF(I.EQ.2)THEN THMSM=GAELE(T,H,ALSBAR) ELSEIF(I.EQ.3)THEN THMSM=GVAELE(T,H,ALSBAR) ELSEIF(I.EQ.4)THEN THMSM=GELE(T,H,ALSBAR) ELSEIF(I.EQ.5)THEN THMSM=GH(T,H,ALSBAR) ELSEIF(I.EQ.6)THEN THMSM=GZ(T,H,ALSBAR) ELSEIF(I.EQ.7)THEN THMSM=SIGH(T,H,ALSBAR) ELSEIF(I.EQ.8)THEN THMSM=RL(T,H,ALSBAR) ELSEIF(I.EQ.9)THEN THMSM=RB(T,H,ALSBAR) ELSEIF(I.EQ.10)THEN THMSM=QFB(T,H,ALSBAR) ELSE THMSM=0. ENDIF END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION THBORN(I,T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. IF(I.EQ.1)THEN THBORN=AMWMZB(T,H,ALSBAR) ELSEIF(I.EQ.2)THEN THBORN=GAELEB(T,H,ALSBAR) ELSEIF(I.EQ.3)THEN THBORN=GVAELB(T,H,ALSBAR) ELSEIF(I.EQ.4)THEN THBORN=GLB(T,H,ALSBAR) ELSEIF(I.EQ.5)THEN THBORN=GHB(T,H,ALSBAR) ELSEIF(I.EQ.6)THEN THBORN=GZB(T,H,ALSBAR) ELSEIF(I.EQ.7)THEN THBORN=SIGHB(T,H,ALSBAR) ELSEIF(I.EQ.8)THEN THBORN=RLB(T,H,ALSBAR) ELSEIF(I.EQ.9)THEN THBORN=RBB(T,H,ALSBAR) ELSEIF(I.EQ.10)THEN THBORN=S2 ELSE THBORN=0. ENDIF END *CMZ : 05/11/99 22.14.14 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.19.23 by A.Rozanov *CMZ : 2.00/02 05/07/98 19.32.28 by A.Rozanov *CMZ : 2.00/01 18/03/98 21.07.32 by A.Rozanov *CMZ : 2.00/00 16/04/97 18.36.25 by A.Rozanov *CMZ : 2.00/03 26/10/95 12.25.47 by A.Rozanov *CMZ : 2.00/02 09/03/95 21.12.22 by A.Rozanov *CMZ : 2.00/01 09/03/95 11.07.02 by A.Rozanov *CMZ : 1.30/07 19/02/95 20.27.09 by A.Rozanov *CMZ : 1.30/02 17/01/95 22.15.13 by A.Rozanov *CMZ : 1.30/01 16/01/95 21.17.17 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.46.25 by Rozanov Alexandre *-- Author : subroutine LTINIT(istat) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,SMITH. COMMON/SMITH/VOLOSHIN *KEEP,AVDEEV. COMMON/AVDEEV/AVDEEV *KEEP,VERLT. COMMON/VERLT/VERSION *KEEP,CONFER. LOGICAL MARSEILLE,MORIOND94,GLASGOW,MORIOND95,BEIJING95, 1 MORIOND96,MORIOND97,MORIALL97,JERUSALEM97,MORIOND98, 2 VANCOUVER98,EWWG99,LP99 COMMON/CONFER/MARSEILLE,MORIOND94,GLASGOW,MORIOND95,BEIJING95, 1 MORIOND96,MORIOND97,MORIALL97,JERUSALEM97,MORIOND98, 2 VANCOUVER98,EWWG99,LP99 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,mncom. COMMON/MNCOM/MNPRNT,MNREAD,MNUNIT,MNSAVE,EPSMN *KEND. character*8 VERSQQ logical init/.true./ * list of options used for evaluation of theoretical errors *-----IOPTION(1)= - terms non-linear in mt in dVm,dVa,dVr * are with als(mt) instead of * als(mt)*(1+1.3734*als(mt)) *-----IOPTION(2)= - variation of Barbieri correction by * extra term +-2/t*Barbieri * (positive) * (3)= the same Barbieri negative *-----IOPTION(4)= DEFACTORIZATION OF gluons in Gqq * by using * GQQ=3*GO*(BRA1+BRA2+RAQ+(1-4*S2*Q)**2*(RVQ-1)-1) *-----IOPTION(5)= estimation of non-calculated QCD alphas * corrections for next to the next terms in phi(t), * which are constant or 1/t, 1/t**2, ... *-----IOPTION(6)= same as (5), bit negative sign *-----IOPTION(7)= estimation of non-calculated * corrections for the function Z1Z2 in phi(t), *-----IOPTION(8)= same as (7), bit negative sign * * options changed by VAN and MIV 15.11.94 * now they corresponds to writeup for YR * IOPTION(1)= correction deltaVit2 from eq.71 added * to Va, Vm and Vr * virtual higgs correction alphaW**2*t**2 * in the W and Z selfenergies * IOPTION(2) same as (1), but subtracted * IOPTION(3)= correction deltaVials2 from eq.72 added * to Va, Vm and Vr * two gluon correction alphaW*als**2*t * to the top quark loop * in the W and Z selfenergies * IOPTION(4) same as (3), but subtracted * IOPTION(5)= correction to Gqq of 0.3 MeV added * in order to take into account gluon * corrections to the electroweak Zqq triangle * vertices * IOPTION(5) same as (5), but subtracted * IOPTION(9) two-loop Degrassi terms by MIV approximation * IOPTION(10) no two loop terms in dV4,dV5,Phi(t) * IOPTION(11) nearly degenerate chargino-netralino with * Higgsino dominated case * IOPTION(12) nearly degenerate chargino-netralino with * Gaugino dominated case *KEEP,TTBAR. COMMON/TTBAR/EPSIL *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEEP,TMINDV. COMMON/TMINDV/TMIN,DELTVM,DELTVA,DELTVR *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEEP,LBTABL. PARAMETER (NT=10) CHARACTER*16 TCH COMMON/LBTABL/TCH(NT),TEXP(NT,3),TMSM(NT,3),TBORN(NT,3), 1TCOR(NT,3),TDMT(NT,2),TMSM2(NT,3),TCOR2(NT,3),ECOR2(NT,3,2) 2,ttborn(nt) 3,t2born(nt,3) 4,EMSM(NT,3),EBORN(NT,3),TMSM_ALB(NT,3) *KEND. *================================================================= * * version=1.0 04.05.94 A.Rozanov * with Smith-Voloshin corrections * data from Moriond-94 *---------------------------------------------------------------- * * version=1.1 26.06.94 A.Rozanov * correct bug in AFBCC, AF by introducing ALSBAR as argument * AFBCC decreased by 0.0001 (was not important for fits) *----------------------------------------------------------------- * * version=1.2 21.07.94 A.Rozanov * correct bug in AMHMT (BARBIERI CORRECTIONS FOR MH>4MT) * * INTRODUCE HIGH ORDER QCD FROM KUHN VIA BARDIN * for b-quark *----------------------------------------------------------------- * * version=1.3 03.10.94 A.Rozanov * * INTRODUCE HIGH ORDER QCD FROM KUHN VIA BARDIN * with L.B.Okun for all quark flavors * calculate theoretical error by variations of the formulas * with 4 options *----------------------------------------------------------------- * * version=1.4 03.02.94 A.Rozanov * * *----------------------------------------------------------------- if(init)then *KEEP,DATEQQ. IDATQQ = 991216 *KEEP,TIMEQQ. ITIMQQ = 2109 *KEEP,VERSQQ. VERSQQ = ' 2.00/03' IVERSQ = 20003 *KEND. init=.false. call datime(id,it) WRITE(6,*)'+++++++++++++++++++++++++++++++++++++++++++++++' WRITE(6,*)' LEPTOP version ',versqq,' created: ',idatqq, 1 itimqq WRITE(6,*)' ',' used: ',id,it WRITE(6,*)'+++++++++++++++++++++++++++++++++++++++++++++++' VERSION=IVERSQ endif MARSEILLE=.false. MORIOND94=.false. GLASGOW=.false. MORIOND95=.false. BEIJING95=.false. MORIOND96=.false. MORIOND97=.false. MORIALL97=.false. MORIOND98=.false. VANCOUVER98=.false. EWWG99=.true. IF(PRTFLG(2).GT.0.)THEN WRITE(6,*)'LEPTOP DATA SET MARSEILLE: ',MARSEILLE, 1 ' MORIOND94: ',MORIOND94,' GLASGOW: ',GLASGOW,' BEIJING:', 2 BEIJING95,' MORIOND96: ',MORIOND96,' MORIOND97: ',MORIOND97 3 ,' MORIALL97: ',MORIALL97,' MORIOND98: ',MORIOND98 4 ,' VANCOUVER98: ',VANCOUVER98 ENDIF if(istat.eq.0)then IF(MARSEILLE)THEN CALL LTCONF('MARSEILLE') ELSEIF(MORIOND94)THEN CALL LTCONF('MORIOND94') ELSEIF(GLASGOW)THEN CALL LTCONF('GLASGOW') ELSEIF(MORIOND95)THEN CALL LTCONF('MORIOND95') ELSEIF(BEIJING95)THEN CALL LTCONF('BEIJING95') ELSEIF(MORIOND96)THEN CALL LTCONF('MORIOND96') ELSEIF(MORIOND97)THEN CALL LTCONF('MORIOND97') ELSEIF(MORIALL97)THEN CALL LTCONF('MORIALL97') ELSEIF(MORIOND98)THEN CALL LTCONF('MORIOND98') ELSEIF(VANCOUVER98)THEN CALL LTCONF('VANCOUVER98') ELSEIF(EWWG99)THEN CALL LTCONF('EWWG99') ELSE WRITE(6,*)'+LTINIT: data set not defined' ENDIF FLEP(1)=-1. FLEP(2)=1. ! Gz FLEP(3)=1. ! sigmah FLEP(4)=1. ! Rl FLEP(5)=1. FLEP(6)=1. ! RB FLEP(7)=1. ! MW/MZ FLEP(8)=1. FLEP(9)=1. FLEP(10)=1. ! AFBbb FLEP(11)=1. ! AFBcc FLEP(12)=1. ! QFB FLEP(13)=1. ! nuN FLEP(14)=1. ! ALR from SLAC FLEP(15)=-1. ! Mtop from CDF FLEP(16)=-1. ! Glep FLEP(17)=1. ! Rc FLEP(18)=-1. ! RbSLC FLEP(19)=-1. ! AbSLC FLEP(20)=-1. ! AcSLC FLEP(21)=-1. ! als FLEP(22)=-1. ! albar FLEP(23)=-1. ! s2l FLEP(24)=-1. ! ga FLEP(25)=-1. ! mH lowlimit+2*sigma if (prtflg(4).gt.0.)then WRITE(6,*)' DATA VALUE ERROR USED IN THE FIT' DO 21 I=1,NLEP WRITE(6,10121)I,CHLEP(I),VLEP(I),ELEP(I),FLEP(I) 10121 FORMAT(1X,I2,1x,A10,3F10.4) 21 CONTINUE endif TCH(1)='MW/MZ' TEXP(1,1)=VLEP(7) TEXP(1,2)=ELEP(7) TCH(3)='GV/GA' IF(MORIOND94)THEN * TEXP(3,1)=0.07167 * TEXP(3,1)=0.07167 ! from sin2tweff * TEXP(3,2)=0.0036 * TEXP(3,2)=0.0028 ! from sin2tweff TCH(3)='GV/GA' TEXP(3,1)=0.0711 ! Moriond-94 TEXP(3,2)=0.0020 ! Moriond-94 ELSEIF(MARSEILLE)THEN TEXP(3,1)=0.0712 ! MARSEILLE-93 TEXP(3,2)=0.0028 ! MARSEILLE-93 ELSEIF(GLASGOW)THEN TEXP(3,1)=0.07332 ! GLASGOW-94 TEXP(3,2)=0.00160 ! GLASGOW-94 ENDIF TCH(4)='GL' TEXP(4,1)=VLEP(16) TEXP(4,2)=ELEP(16) TCH(5)='GH' * TEXP(5,1)=1.7403 * TEXP(5,2)=0.0059 * TEXP(5,1)=1.7460 ! Moriond - 94 * TEXP(5,2)=0.0040 ! Moriond-94 TEXP(5,1)=VLEP(16)*VLEP(4) TEXP(5,2)=TEXP(5,1)*DSQRT((ELEP(4)/VLEP(4))**2+ 1 (ELEP(16)/VLEP(16))**2) TCH(6)='GZ' TEXP(6,1)=VLEP(2) TEXP(6,2)=ELEP(2) TCH(7)='SIGHAD' TEXP(7,1)=VLEP(3) TEXP(7,2)=ELEP(3) TCH(8)='RL' TEXP(8,1)=VLEP(4) TEXP(8,2)=ELEP(4) TCH(9)='RB' TEXP(9,1)=VLEP(6) TEXP(9,2)=ELEP(6) TCH(10)='SIN2EFF' TEXP(10,1)=(1.-TEXP(3,1))*0.25 TEXP(10,2)=TEXP(3,2)*0.25 TCH(2)='GA' * TEXP(2,1)=-0.50093 * TEXP(2,2)=0.00082 if(prtflg(4).gt.0.)then WRITE(6,*)'Constants used:' endif AMZ=VLEP(1) DAMZ=ELEP(1) AL=1./137.0359855D0 ALBAR=1./128.878D0 ! new default from EWWG-99 draft error(90) * ALBAR=1./128.896D0 ! new default from BEIJING95 error (90) ******ALBAR=1./128.87D0 ! with CA,CM and CR constants in V's ******ALBAR=1./129.10D0 ! LB request 04.12.94 ******ALBAR=1./128.99D0 ! one sigma up ******ALBAR=1./128.75D0 ! one sigma down ******ALBAR=1./128.81D0 ! new with gamma-ww-gamma if(prtflg(4).gt.0.)then write(6,*)'1/albar used = ',1./albar endif * GMU=1.16637D-5 ! 1990 value GMU=1.16639D-5 ! 1992 value TONB=0.38937966D6 PI=2*DASIN(1.D0) * AMU2=0.25D0 ! used untill 25.01.94 AMU2=0.435D0 ******AMU2=0.50D0 ! a la D.Y.Bardin ******EPSIL=2.5 ! with one level t-tbar correction EPSIL=0.0 ! no t-tbar correction VOLOSHIN=0.35 * define ratio of ALS2/ALS terms in Avdeev AVDEEV=CA2CA1(0.) call vzero(ioption,20) * AMB0=4.8 AMB0=4.7 ! agreed by bardin's group mb0=4.7 +- 0.1 GeV AMEL=0.00051099906D0 AMMU=0.105658389D0 AMTAU=1.7841D0 AMUP=0.D0 AMDOWN=0.D0 * AMCHRM=1.3D0 * AMCHRM=1.3D0 ! agreed by bardin's group 27.06.94 AMCHRM=1.5D0 ! agreed by bardin's group SEPTEMBER 1994 AMSTRN=0.5D0 AMTOP=175.D0 AMBOTT=AMB0 * AM4=0.D0 CALL SM4(0.D0) CALL LTSML4(0.D0) CALL LTSMQ4(0.D0) CALL LTSNL4(1) CALL LTSNQ4(1) AMDG2=2.**2 * AMTCOM=AMTOP AMHCOM=300.D0 ALSCOM=0.125D0 * MINUIT parameters MNPRNT=-1 MNREAD=-5 MNUNIT=-19 MNSAVE=7 EPSMN=1.D-10 endif ! istat=0 *--------------------------------------------------------------------- ********************TMIN,DELTVM,DELTVA,DELTVR AMBOTT=AMB0 TMIN=1. * TMIN=(50./AMZ)**2 TMIN=0. * DELTVM=0.647 ! bug LBO 20.12.93 DELTVM=-0.57 DELTVA=2.626 DELTVR=0. if(prtflg(4).gt.0.)then WRITE(6,*)'TMIN,DELTVM,DELTVA,DELTVR', 1 TMIN,DELTVM,DELTVA,DELTVR endif F2=4.*DSQRT(2.D0)*(GMU*10000.)*(AMZ/100.)**2 S2=0.5-DSQRT(F2-16*PI*ALBAR)/(2*DSQRT(F2)) C2=1.-S2 ******ALBAR=AL ! variation to compare withD.Y.Bardine if(prtflg(4).gt.0.)then write(6,*)'1/albar used = ',1./albar endif GO=DSQRT(2.D0)*(GMU*1000000.)*(AMZ/100.)**3/(48*PI) CORREC=(1+0.75*ALBAR/PI)*(1+TEXP(3,1)**2) TEXP(2,1)=-DSQRT(VLEP(16)/(4*CORREC*GO)) TEXP(2,2)=-TEXP(2,1)*0.5*(ELEP(16)/VLEP(16)) if(prtflg(4).gt.0.)then WRITE(6,*)'AMZ,DAMZ',AMZ,DAMZ WRITE(6,*)'AL,ALBAR,GMU,TONB,PI',AL,ALBAR,GMU,TONB,PI WRITE(6,*)'F2,S2,C2,GO,AMU2',F2,S2,C2,GO,AMU2 WRITE(6,*)'EPSIL= ',EPSIL WRITE(6,*)'AM4= ',AM4 WRITE(6,*)'SMITH=VOLOSHIN= ',VOLOSHIN WRITE(6,*)'AVDEEV= ',AVDEEV endif EB=AMZ/2. AMB=AMB0*DSQRT(AMU2) VELOB=DSQRT(1.-(AMB/EB)**2) if(prtflg(4).gt.0.)then WRITE(6,*)'EB,AMB0,AMB,VELOB', 1 EB,AMB0,AMB,VELOB write(6,*)'PRTFLG(3)=',PRTFLG(3) write(6,*)'end of init' endif end *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : SUBROUTINE TABLE(AMTP,DAMT1P,DAMT2P,DT1,DT2, 1ALSBAP,DALS1H,DALS2H,AMHP,EMAT) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,TTBAR. COMMON/TTBAR/EPSIL *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,CONFER. LOGICAL MARSEILLE,MORIOND94,GLASGOW,MORIOND95,BEIJING95, 1 MORIOND96,MORIOND97,MORIALL97,JERUSALEM97,MORIOND98, 2 VANCOUVER98,EWWG99,LP99 COMMON/CONFER/MARSEILLE,MORIOND94,GLASGOW,MORIOND95,BEIJING95, 1 MORIOND96,MORIOND97,MORIALL97,JERUSALEM97,MORIOND98, 2 VANCOUVER98,EWWG99,LP99 *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEEP,LBTABL. PARAMETER (NT=10) CHARACTER*16 TCH COMMON/LBTABL/TCH(NT),TEXP(NT,3),TMSM(NT,3),TBORN(NT,3), 1TCOR(NT,3),TDMT(NT,2),TMSM2(NT,3),TCOR2(NT,3),ECOR2(NT,3,2) 2,ttborn(nt) 3,t2born(nt,3) 4,EMSM(NT,3),EBORN(NT,3),TMSM_ALB(NT,3) *KEND. DIMENSION AMTP(3),DAMT1P(3),DAMT2P(3),ALSBAP(3),EMAT(2,2,3) DIMENSION CHI2B(3),CHI2M(3) CALL LTINIT(0) IF(AMTP(1).GT.0.)THEN ALSBA0=ALSBAP(1) AMT0=AMTP(1) DAMT1=DAMT1P(1) DAMT2=DAMT2P(1) ALSBAR=ALSBAP(1) AMH0=AMHP ELSE ALSBA0=0.120 AMT0=150. DAMT1=10. DAMT2=-10. ALSBAR=ALSBA0 AMH0=300. ENDIF * write(6,*)'amt0,damt1,daam2,amh0,alsba0', * 1 amt0,damt1,daam2,amh0,alsba0 DO I=1,NT AMT=AMT0 T=(AMT/AMZ)**2 AMH=60. H=(AMH/AMZ)**2 IH=2 TMSM(I,1)=THMSM(I,T,H,ALSBAR) DALS=DSQRT(EMAT(2,2,IH)) DT=DSQRT(EMAT(1,1,IH)) T1=(AMT+DT)**2/AMZ**2 T2=(AMT-DT)**2/AMZ**2 DTDT=(THMSM(I,T1,H,ALSBAR)-THMSM(I,T2,H,ALSBAR))/(2*DT) DTDA=(THMSM(I,T,H,ALSBAR+DALS)-THMSM(I,T,H,ALSBAR-DALS))/ 1 (2*DALS) E2=DTDT**2*EMAT(1,1,IH)+DTDT*DTDA*EMAT(1,2,IH)+ 1 DTDT*DTDA*EMAT(2,1,IH)+DTDA**2*EMAT(2,2,IH) EMSM(I,1)=DSQRT(E2) * write(6,*) * 1 'IH,EMAT(1,1,IH),EMAT(1,2,IH),EMAT(2,1,IH),EMAT(2,2,IH)', * 2 IH,EMAT(1,1,IH),EMAT(1,2,IH),EMAT(2,1,IH),EMAT(2,2,IH) AMH=AMH0 H=(AMH/AMZ)**2 TMSM(I,2)=THMSM(I,T,H,ALSBAR) IH=1 DALS=DSQRT(EMAT(2,2,IH)) DT=DSQRT(EMAT(1,1,IH)) T1=(AMT+DT)**2/AMZ**2 T2=(AMT-DT)**2/AMZ**2 DTDT=(THMSM(I,T1,H,ALSBAR)-THMSM(I,T2,H,ALSBAR))/(2*DT) DTDA=(THMSM(I,T,H,ALSBAR+DALS)-THMSM(I,T,H,ALSBAR-DALS))/ 1 (2*DALS) E2=DTDT**2*EMAT(1,1,IH)+DTDT*DTDA*EMAT(1,2,IH)+ 1 DTDT*DTDA*EMAT(2,1,IH)+DTDA**2*EMAT(2,2,IH) EMSM(I,2)=DSQRT(E2) AMH=1000. H=(AMH/AMZ)**2 TMSM(I,3)=THMSM(I,T,H,ALSBAR) IH=3 DALS=DSQRT(EMAT(2,2,IH)) DT=DSQRT(EMAT(1,1,IH)) T1=(AMT+DT)**2/AMZ**2 T2=(AMT-DT)**2/AMZ**2 DTDT=(THMSM(I,T1,H,ALSBAR)-THMSM(I,T2,H,ALSBAR))/(2*DT) DTDA=(THMSM(I,T,H,ALSBAR+DALS)-THMSM(I,T,H,ALSBAR-DALS))/ 1 (2*DALS) E2=DTDT**2*EMAT(1,1,IH)+DTDT*DTDA*EMAT(1,2,IH)+ 1 DTDT*DTDA*EMAT(2,1,IH)+DTDA**2*EMAT(2,2,IH) EMSM(I,3)=DSQRT(E2) ENDDO AMT=AMT0 T=(AMT/AMZ)**2 AMH=AMH0 H=(AMH/AMZ)**2 DO I=1,NT TBORN(I,1)=THBORN(I,T,H,ALSBAR) TMSM_ALB(I,1)=THMSM(I,T,H,ALSBAR) TTBORN(I)=THBORN(I,T,H,0.120) ENDDO DALBAR=ALBAR*0.00093 ALBAR=ALBAR+DALBAR CALL LTINIT(1) * DO I=1,4 DO I=1,NT TBORN(I,2)=THBORN(I,T,H,ALSBAR) ENDDO DO I=1,NT TMSM_ALB(I,2)=THMSM(I,T,H,ALSBAR) ENDDO ALBAR=ALBAR-2*DALBAR CALL LTINIT(1) * DO I=1,4 DO I=1,NT TBORN(I,3)=THBORN(I,T,H,ALSBAR) ENDDO DO I=1,NT TMSM_ALB(I,3)=THMSM(I,T,H,ALSBAR) ENDDO CALL LTINIT(0) * DALSBA=0.01 * ALSBAR=ALSBA0+DALSBA * DO I=5,NT * TBORN(I,2)=THBORN(I,T,H,ALSBAR) * ENDDO * ALSBAR=ALSBA0-DALSBA * DO I=5,NT * TBORN(I,3)=THBORN(I,T,H,ALSBAR) * ENDDO ALSBAR=ALSBA0 AMH=300. H=(AMH/AMZ)**2 DO I=1,NT TCOR(I,1)=TMSM(I,1)-TBORN(I,1) TCOR(I,2)=TMSM(I,2)-TBORN(I,1) TCOR(I,3)=TMSM(I,3)-TBORN(I,1) AMT=AMT0+DAMT1 T=(AMT/AMZ)**2 TDMT(I,1)=THMSM(I,T,H,ALSBAR)-TMSM(I,2) AMT=AMT0+DAMT2 T=(AMT/AMZ)**2 TDMT(I,2)=THMSM(I,T,H,ALSBAR)-TMSM(I,2) ENDDO WRITE(6,*) 1'Observable Exp.value Born MSM correction(60,300,1000) deltamt-+' do i=1,nt write(6,'(a6,7f9.5)')TCH(i),TEXP(i,1),TBORN(i,1), 1 TCOR(i,1),TCOR(i,2),TCOR(i,3),TDMT(i,1),TDMT(i,2) write(6,'(6x,2f9.5)')TEXP(i,2), 1 TBORN(i,2)-TBORN(i,1) write(6,'(15x,f9.5)') 1 TBORN(i,3)-TBORN(i,1) ENDDO WRITE(6,*)'*****************************************************' DO I=1,NT AMT=AMTP(2) T=(AMT/AMZ)**2 ALSBAR=ALSBAP(2) AMH=60. H=(AMH/AMZ)**2 TMSM2(I,1)=THMSM(I,T,H,ALSBAR) T2BORN(I,1)=THBORN(I,T,H,ALSBAR) TCOR2(I,1)=TMSM2(I,1)-T2BORN(I,1) IH=2 DALS=DSQRT(EMAT(2,2,IH)) DT=DSQRT(EMAT(1,1,IH)) T1=(AMT+DT)**2/AMZ**2 T2=(AMT-DT)**2/AMZ**2 DTDT=(THBORN(I,T1,H,ALSBAR)-THBORN(I,T2,H,ALSBAR))/(2*DT) DTDA=(THBORN(I,T,H,ALSBAR+DALS)-THBORN(I,T,H,ALSBAR-DALS))/ 1 (2*DALS) E2=DTDT**2*EMAT(1,1,IH)+DTDT*DTDA*EMAT(1,2,IH)+ 1 DTDT*DTDA*EMAT(2,1,IH)+DTDA**2*EMAT(2,2,IH) EBORN(I,1)=DSQRT(E2) AMT=AMTP(2)+DAMT1P(2) T=(AMT/AMZ)**2 ECOR2(I,1,1)=THMSM(I,T,H,ALSBAR)-TMSM2(I,1) AMT=AMTP(2)+DAMT2P(2) T=(AMT/AMZ)**2 ECOR2(I,1,2)=THMSM(I,T,H,ALSBAR)-TMSM2(I,1) AMT=AMTP(1) T=(AMT/AMZ)**2 ALSBAR=ALSBAP(1) AMH=300. H=(AMH/AMZ)**2 TMSM2(I,2)=THMSM(I,T,H,ALSBAR) T2BORN(I,2)=THBORN(I,T,H,ALSBAR) TCOR2(I,2)=TMSM2(I,2)-T2BORN(I,2) IH=1 DALS=DSQRT(EMAT(2,2,IH)) DT=DSQRT(EMAT(1,1,IH)) T1=(AMT+DT)**2/AMZ**2 T2=(AMT-DT)**2/AMZ**2 DTDT=(THBORN(I,T1,H,ALSBAR)-THBORN(I,T2,H,ALSBAR))/(2*DT) DTDA=(THBORN(I,T,H,ALSBAR+DALS)-THBORN(I,T,H,ALSBAR-DALS))/ 1 (2*DALS) E2=DTDT**2*EMAT(1,1,IH)+DTDT*DTDA*EMAT(1,2,IH)+ 1 DTDT*DTDA*EMAT(2,1,IH)+DTDA**2*EMAT(2,2,IH) EBORN(I,2)=DSQRT(E2) AMT=AMTP(1)+DAMT1P(1) T=(AMT/AMZ)**2 ECOR2(I,2,1)=THMSM(I,T,H,ALSBAR)-TMSM2(I,2) AMT=AMTP(1)+DAMT2P(1) T=(AMT/AMZ)**2 ECOR2(I,2,2)=THMSM(I,T,H,ALSBAR)-TMSM2(I,2) AMT=AMTP(3) T=(AMT/AMZ)**2 ALSBAR=ALSBAP(3) AMH=1000. H=(AMH/AMZ)**2 TMSM2(I,3)=THMSM(I,T,H,ALSBAR) T2BORN(I,3)=THBORN(I,T,H,ALSBAR) TCOR2(I,3)=TMSM2(I,3)-T2BORN(I,3) IH=3 DALS=DSQRT(EMAT(2,2,IH)) DT=DSQRT(EMAT(1,1,IH)) T1=(AMT+DT)**2/AMZ**2 T2=(AMT-DT)**2/AMZ**2 DTDT=(THBORN(I,T1,H,ALSBAR)-THBORN(I,T2,H,ALSBAR))/(2*DT) DTDA=(THBORN(I,T,H,ALSBAR+DALS)-THBORN(I,T,H,ALSBAR-DALS))/ 1 (2*DALS) E2=DTDT**2*EMAT(1,1,IH)+DTDT*DTDA*EMAT(1,2,IH)+ 1 DTDT*DTDA*EMAT(2,1,IH)+DTDA**2*EMAT(2,2,IH) EBORN(I,3)=DSQRT(E2) AMT=AMTP(3)+DAMT1P(3) T=(AMT/AMZ)**2 ECOR2(I,3,1)=THMSM(I,T,H,ALSBAR)-TMSM2(I,3) AMT=AMTP(3)+DAMT2P(3) T=(AMT/AMZ)**2 ECOR2(I,3,2)=THMSM(I,T,H,ALSBAR)-TMSM2(I,3) ENDDO WRITE(6,*)'Observable Exp.value Born MSM correction 60,300,1000' DO IMH=1,3 CHI2B(IMH)=0. CHI2M(IMH)=0. ENDDO do i=1,nt DO IMH=1,3 CHI2B(IMH)=CHI2B(IMH)+(TEXP(I,1)-T2BORN(I,IMH))**2/TEXP(I,2)**2 CHI2M(IMH)=CHI2M(IMH)+(TEXP(I,1)-TMSM2(I,IMH))**2/TEXP(I,2)**2 ENDDO write(6,'(a6,5f10.6)')TCH(i),TEXP(i,1),TTBORN(i), 1 TMSM2(i,1),TMSM2(i,2),TMSM2(i,3) write(6,'(a6,5f10.6)')TCH(i),TEXP(i,1),TTBORN(i), 1 EMSM(i,1),EMSM(i,2),EMSM(i,3) write(6,'(A6,9X,5f10.6)')'BORN= ',TTBORN(i), 1 T2BORN(i,1),T2BORN(i,2),T2BORN(i,3) write(6,'(A6,9X,5f10.6)')'BORN= ',TTBORN(i), 1 EBORN(i,1),EBORN(i,2),EBORN(i,3) write(6,'(a6,5f10.6)')TCH(i),TEXP(i,1),TTBORN(i), 1 TCOR2(i,1),TCOR2(i,2),TCOR2(i,3) write(6,'(6x,5f10.6)')TEXP(i,2), 1 TBORN(i,2)-TBORN(i,1),ECOR2(I,1,1),ECOR2(I,2,1),ECOR2(I,3,1) write(6,'(15x,4f10.6)') 1 TBORN(i,3)-TBORN(i,1) 1 ,ECOR2(I,1,2),ECOR2(I,2,2),ECOR2(I,3,2) ENDDO WRITE(6,'(6HCHI2B=,3F10.2)')CHI2B WRITE(6,'(6HCHI2M=,3F10.2)')CHI2M WRITE(6,*)'*****************************************************' WRITE(6,*)'Observable Exp.value Born MSM (MH=300 (60,1000) GEV)' do i=1,nt write(6,'(a6,3f10.6)')TCH(i),TEXP(i,1),T2BORN(i,2), 1 TMSM2(i,2) *-------total Born error is the sum of error due to albar * and the error due to MH EBORN_ALB=0.5*(ABS(TBORN(i,3)-TBORN(i,1))+ 1 ABS(TBORN(i,2)-TBORN(i,1))) EBORN_TOT=DSQRT(EBORN_ALB**2+EBORN(I,2)**2) EMSM_ALB=0.5*(ABS(TMSM_ALB(i,3)-TMSM_ALB(i,1))+ 1 ABS(TMSM_ALB(i,2)-TMSM_ALB(i,1))) EMSM_TOT=DSQRT(EMSM_ALB**2+EMSM(I,2)**2) write(6,'(6X,3f10.6)')TEXP(i,2),EBORN_TOT,EMSM_TOT write(6,'(16X,2f10.6,12a)') 1 T2BORN(I,3)-T2BORN(I,2),TMSM2(I,3)-TMSM2(i,2),' mh=1000 GeV' write(6,'(16X,2f10.6,12a)') 1 T2BORN(I,1)-T2BORN(I,2),TMSM2(i,1)-TMSM2(I,2),' mh= 60 GeV' ENDDO WRITE(6,*)'*****************************************************' I=9 write(6,*)'===============================================' write(6,*)'Special request of LB 13.04.94' write(6,*)'===============================================' AMH=300. H=(AMH/AMZ)**2 ALSBAR=ALSBAP(1) AMT=AMTP(1) T=(AMT/AMZ)**2 write(6,*)'AMT,AMH,ALSBAR',AMT,AMH,ALSBAR gvga=THMSM(3,T,H,ALSBAR) WRITE(6,*)'gv/ga=',gvga AMH=60. H=(AMH/AMZ)**2 ALSBAR=ALSBAP(1) AMT=AMTP(1) T=(AMT/AMZ)**2 write(6,*)'AMT,AMH,ALSBAR',AMT,AMH,ALSBAR gvga=THMSM(3,T,H,ALSBAR) WRITE(6,*)'gv/ga=',gvga AMH=1000. H=(AMH/AMZ)**2 ALSBAR=ALSBAP(1) AMT=AMTP(1) T=(AMT/AMZ)**2 write(6,*)'AMT,AMH,ALSBAR',AMT,AMH,ALSBAR gvga=THMSM(3,T,H,ALSBAR) WRITE(6,*)'gv/ga=',gvga AMT=170. T=(AMT/AMZ)**2 ALSBAR=0.125 AMH=300. H=(AMH/AMZ)**2 als015=ALPHATT(T,ALSBAR) write(6,*)'AMT,AMH,ALSBAR',AMT,AMH,ALSBAR write(6,*)'als015',als015 write(6,*)'===============================================' * write(6,*)'teq i=',i * CALL TEQ(I,TEXP(I,1),TOP1,H,ALSBAR) * do i=1,nt * ALSBAR=ALSBAP(1) * AMH=300. * H=(AMH/AMZ)**2 * CALL TEQ(I,TEXP(I,1),TOP300,H,ALSBAR) * CALL TEQ(I,TEXP(I,1)+TEXP(I,2),E1T300,H,ALSBAR) * CALL TEQ(I,TEXP(I,1)-TEXP(I,2),E2T300,H,ALSBAR) * ALSBAR=ALSBAP+DALS2H * AMH=60. * H=(AMH/AMZ)**2 * CALL TEQ(I,TEXP(I,1),TOP60,H,ALSBAR) * CALL TEQ(I,TEXP(I,1)+TEXP(I,2),E1T60,H,ALSBAR) * CALL TEQ(I,TEXP(I,1)-TEXP(I,2),E2T60,H,ALSBAR) * ALSBAR=ALSBAP+DALS1H * AMH=1000. * H=(AMH/AMZ)**2 * CALL TEQ(I,TEXP(I,1),TOP1,H,ALSBAR) * CALL TEQ(I,TEXP(I,1)+TEXP(I,2),E1T1,H,ALSBAR) * CALL TEQ(I,TEXP(I,1)-TEXP(I,2),E2T1,H,ALSBAR) * write(6,'(a6,2f9.5,3F9.1)')TCH(i),TEXP(i,1),TBORN(i,1), * 1 TOP60,TOP300,TOP1 * write(6,'(6x,2f9.5,3F9.1)')TEXP(i,2), * 1 TBORN(i,2)-TBORN(i,1),E1T60-TOP60,E1T300-TOP300,E1T1-TOP1 * write(6,'(15x,f9.5,3F9.1)') * 1 TBORN(i,3)-TBORN(i,1),E2T60-TOP60,E2T300-TOP300,E2T1-TOP1 * ENDDO * do i=1,nt * write(6,'(a6,7f9.5)')TCH(i),TEXP(i,1),TBORN(i,1), * 1 TCOR(i,1),TCOR(i,2),TCOR(i,3),TDMT(i,1),TDMT(i,2) * write(6,'(6x,2f9.5)')TEXP(i,2), * 1 TBORN(i,2)-TBORN(i,1) * write(6,'(15x,f9.5)') * 1 TBORN(i,3)-TBORN(i,1) * ENDDO end *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : SUBROUTINE TEQ(IT,VEXP,TOPMAS,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CITAB. COMMON/CITAB/ITABLE,II,VALUE,TCI,HCI,ALSBCI *KEND. EXTERNAL FTHEOR DATA A0/60.D0/ DATA B0/600.D0/ DATA EPS/1.D-4/ DATA MAXF/10000/ IF(IT.EQ.9)THEN A=50. ELSE A=A0 ENDIF B=B0 ITABLE=IT VALUE=VEXP HCI=H ALSBCI=ALSBAR *------------------------------------------------- IF(ITABLE.EQ.9)THEN DO I=1,100 AMT=30.D0+10.*(I-1) T=(AMT/AMZ)**2 TH=THMSM(ITABLE,T,HCI,ALSBCI) WRITE(6,*)I,AMT,T,VALUE,TH ENDDO ENDIF *------------------------------------------------- CALL DZERO(A,B,TOPMAS,RESID,EPS,MAXF,FTHEOR) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FTHEOR(X,I) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CITAB. COMMON/CITAB/ITABLE,II,VALUE,TCI,HCI,ALSBCI *KEND. T=(X/AMZ)**2 TH=THMSM(ITABLE,T,HCI,ALSBCI) FTHEOR=TH-VALUE END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AMHMT(T,H) * x**2 coefficient of 1/rho-1 expansion (apart of Nc=3 factor) * from formula (18) of TH-6696 preprint and formula (17) of * Barbieri et al.PL B 288 , 95-98 (1992) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. PARAMETER(NPA=11,MPOL=2) PARAMETER(NPAD=41) REAL*4 AX(NPAD),RX(NPAD) REAL*4 RMHMT,RS,DIVDIF DATA AX/.00, &.10,.20,.30,.40,.50,.60,.70,.80,.90,1.0, &1.1,1.2,1.3,1.4,1.5,1.6,1.7,1.8,1.9,2.0, &2.1,2.2,2.3,2.4,2.5,2.6,2.7,2.8,2.9,3.0, &3.1,3.2,3.3,3.4,3.5,3.6,3.7,3.8,3.9,4.0/ DATA RX/.73921, &1.821,2.704,3.462,4.127,4.720,5.254,5.737, &6.179,6.583,6.956,7.299,7.617,7.912,8.186, &8.441,8.679,8.902,9.109,9.303,9.485,9.655, &9.815,9.964,10.104,10.235,10.358,10.473, &10.581,10.683,10.777,10.866,10.949,11.026, &11.098,11.165,11.228,11.286,11.340,11.390, &11.436/ * * REAL*4 A(NPA),VMHMT(NPA),RMHMT,RS * DATA A/0.7,2.9,4.3,5.5,6.2,7.0,8.3,9.5,10.7,11.4,11.7/ * DATA VMHMT/0.0,0.2,0.4,0.6,0.8,1.0,1.4,2.0,3.0,5.0,5.5/ IF(H.GT.0.)THEN R=T/H ELSE R=T/0.000001 ENDIF IF(T.GT.0.)THEN RS=H/T ELSE RS=H/0.000001 ENDIF RMHMT=SQRT(RS) IF(RMHMT.LT.AX(NPAD))THEN * AMHMT1=DIVDIF(A,VMHMT,NPA,RMHMT,MPOL) AMHMT2=DIVDIF(RX,AX,NPAD,RMHMT,MPOL) * WRITE(6,*)'AMHMT1,AMHMT2', * 1 AMHMT1,AMHMT2 ELSE DLGR=DLOG(R) *********AMHMT2=-(49./4.+PI**2+(27./2.)*DLGR+(3./3.)*DLGR**2+!bug220794 AMHMT2=-(49./4.+PI**2+(27./2.)*DLGR+(3./2.)*DLGR**2+ 1 (R/3.)*(2.-12*PI**2+12.*DLGR-27*DLGR**2)+ 2 (R**2/48)*(1613.-240*PI**2-1500*DLGR-720.*DLGR**2)) ENDIF AMHMT=AMHMT2 END *CMZ : 04/02/99 15.27.35 by A.Rozanov *CMZ : 2.00/03 05/09/98 13.02.10 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION Z1Z2(T,H) * Z1/Z2 (apart of -2x factor) * from formulas (16) and (17) of Barbieri et al.PL B * 288 , 95-98 (1992) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. PARAMETER(MPOL=2) PARAMETER(NPAD=41) REAL*4 AX(NPAD),TX(NPAD),RS,RMHMT,DIVDIF * tables from Fleisher, Tarasov, Jegerleiner, BI-TP-93/24 DATA AX/.00, &.10,.20,.30,.40,.50,.60,.70,.80,.90,1.0, &1.1,1.2,1.3,1.4,1.5,1.6,1.7,1.8,1.9,2.0, &2.1,2.2,2.3,2.4,2.5,2.6,2.7,2.8,2.9,3.0, &3.1,3.2,3.3,3.4,3.5,3.6,3.7,3.8,3.9,4.0/ DATA TX/ 5.710, &4.671,3.901,3.304,2.834,2.461,2.163,1.924, &1.735,1.586,1.470,1.382,1.317,1.272,1.245, &1.232,1.232,1.243,1.264,1.293,1.330,1.373, &1.421,1.475,1.533,1.595,1.661,1.730,1.801, &1.875,1.951,2.029,2.109,2.190,2.272,2.356, &2.441,2.526,2.613,2.700,2.788/ IF(T.GT.0.)THEN RS=H/T ELSE RS=H/0.000001 ENDIF X=GMU*T*(AMZ)**2/(8*PI**2*DSQRT(2.D0)) RMHMT=SQRT(RS) IF(RMHMT.LE.AX(NPAD))THEN * Z1Z21=1.+(X/3.)*(27.-PI**2) TAU=DIVDIF(TX,AX,NPAD,RMHMT,MPOL) Z1Z22=1.+X*TAU * WRITE(6,*)'Z1Z21,Z1Z22', * 1 Z1Z21,Z1Z22 Z1Z2=Z1Z22 ELSE R=T/H DLGR=DLOG(R) Z1Z2=1.+(X/144.)* 1 (311.+24.*PI**2+282.*DLGR+90.*DLGR**2 2 -4*R*(40+6*PI**2+15.*DLGR+18*DLGR**2) 3 +0.003*R**2*(24209.-6000.*PI**2-45420.*DLGR-18000*DLGR**2)) ENDIF * In notation of eq.(1.85( LEPTOP writeup: * Z1Z2=1 means second term in delta_fi(t)=0 if(IOPTION(10).ne.0)Z1Z2=1. END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION TPRIME(T,H) * FORMULA (48) FROM TH-6696 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. * if(ioption(2).eq.0.and.ioption(3).eq.0)then fac=0. * elseif(ioption(2).ne.0)then * fac=1. * elseif(ioption(3).ne.0)then * fac=-1. * endif * albar=gmu*sqrt(2)*mz**2*(4*s2*c2)/(4*pi) TPRIM=T*(1.-ALBAR*AMHMT(T,H)*T*(1.+fac*2./t)/(PI*16*S2*C2)) TPRIME=TPRIM END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ALPHAT(T,ALSBAR) * running of alsbar according to Politzer-Gross-Terentiev *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,SMITH. COMMON/SMITH/VOLOSHIN *KEND. * ALPHAT=ALSBAR/(1.+(23./(12.*PI))*ALSBAR*DLOG(T)) * a la Smith-Voloshin ALPHAT=ALSBAR/(1.+(23./(12.*PI))*ALSBAR*DLOG(T*VOLOSHIN**2)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ALPHAMT(T,ALSBAR) * running of alsbar according to Politzer-Gross-Terentiev *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. ALPHAMT=ALSBAR/(1.+(23./(12.*PI))*ALSBAR*DLOG(T)) END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ALPHATT(T,ALSBAR) * running of alsbar according to Politzer-Gross-Terentiev *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,AVDEEV. COMMON/AVDEEV/AVDEEV *KEND. * a la AVDEEV BY L.B. 25.09.94 ALSMT=ALPHAMT(T,ALSBAR) ALPHATT=ALSMT*(1.+AVDEEV*ALSMT) END *CMZ : 1.30/07 17/02/95 22.34.33 by A.Rozanov *CMZ : 1.30/05 18/01/95 19.19.54 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : SUBROUTINE DYBTAB *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEEP,DYBCOM. COMMON/DYBCOM/TABLE,TABMI,TABMA,IPAMI,IPAMA,ARAL,ARMT,ARMH DIMENSION AMHIG(4),AMTOP(4) PARAMETER(NALSM=4,NAMTM=7,NAMHM=3) DIMENSION ARAL(NALSM),ARMT(NAMTM),ARMH(NAMHM) PARAMETER (NOBS=23) DIMENSION TABLE(NOBS,NALSM,NAMHM,NAMTM) DIMENSION TABMI(NOBS,NALSM,NAMHM,NAMTM) DIMENSION TABMA(NOBS,NALSM,NAMHM,NAMTM) DIMENSION IPAMI(NOBS,NALSM,NAMHM,NAMTM) DIMENSION IPAMA(NOBS,NALSM,NAMHM,NAMTM) *KEND. character*13 fileout data fileout/'dybtab.output'/ LOGICAL OLD/.FALSE./ DATA ARAL/0.0D0,0.118D0,0.125D0,0.132D0/ DATA ARMT/100.D0,125.D0,150.D0,175.D0,200.D0,225.D0,250.D0/ DATA ARMH/60.D0,300.D0,1000.D0/ DATA AMHIG/100.,300.,500.,1000./ DATA AMTOP/100.,150.,200.,250./ call datime(id,it) open(10,file=fileout,IOSTAT=IOS) if(ios.ne.0)then write(6,*)'++DYBTAB: can-t open file 10 for output',fileout endif WRITE(10,*)' LEPTOP results - ITEP group -',id,it IF(OLD)THEN ALSBAR=0.000 WRITE(6,'(A7,F9.4)')'ALSBAR=',ALSBAR DO IMH=1,4 AMH=AMHIG(IMH) WRITE(6,'(A4,F6.1)')'AMH=',AMH WRITE(6,*)'MT GNU GELE GMU ', 1 'GTAU GU GD GC GB SIN2E ', 2'SIN2B MW' DO IMT=1,5 AMT=AMTOP(IMT) * WRITE(6,'(A4,F6.0)')'AMT=',AMT T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 GGNU=GNU(T,H,ALSBAR) GGL=GL(T,H,ALSBAR) GGELE=GELE(T,H,ALSBAR) GGMUO=GMUO(T,H,ALSBAR) GGTAU=GTAU(T,H,ALSBAR) GGU=GU(T,H,ALSBAR) GGD=GD(T,H,ALSBAR) GGC=GC(T,H,ALSBAR) * GGS=GS(T,H,ALSBAR) * GGT=0.D0 GGB=GB(T,H,ALSBAR) * GGH=GH(T,H,ALSBAR) * GGZ=GZ(T,H,ALSBAR) SSIN2E=0.25*(1.-GVAELE(T,H,ALSBAR)) SSIN2B=SIN2B(T,H,ALSBAR) AMW=AMZ*AMWMZ(T,H,ALSBAR) WRITE(6,10010)amt,GGNU*1000,GGELE*1000,GGMUO*1000, 1 GGTAU*1000,GGU*1000,GGD*1000,GGC*1000,GGB*1000,SSIN2E, 2 SSIN2B,AMW 10010 FORMAT(F4.0,F7.2,3F7.3,4F7.2,2F8.5,F7.3) ENDDO ENDDO ENDIF ! OLD *----------------------------------------------------------------------- * * PRINTING BLOCK FOR PLOTS * DO IAMH=1,NAMHM DO IAMT=1,NAMTM DO IALS=1,NALSM AMT=ARMT(IAMT) AMH=ARMH(IAMH) ALSBAR=ARAL(IALS) T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 * 1. MW TABLE(1,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,1) * write(6,*)'amt,amh,alsbar,amz,table(1,ials,iamh,iamt)', * 1 amt,amh,alsbar,amz,table(1,ials,iamh,iamt) * 2. GNU IN MEV TABLE(2,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,2) * 3. GEL TABLE(3,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,3) * 4. GMU TABLE(4,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,4) * 5. GTAU TABLE(5,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,5) * 6. GU TABLE(6,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,6) * 7. GD TABLE(7,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,7) * 8. GC TABLE(8,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,8) * 9. GB TABLE(9,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,9) * 10. SIN2T TABLE(10,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,10) * 11. SIN2T TABLE(11,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,11) * 12. AFBL TABLE(12,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,12) * 13. ALR TABLE(13,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,13) * 14. GZ TABLE(14,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,14) * 15. RL TABLE(15,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,15) * 16. SIGMAH TABLE(16,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,16) * 17. RB TABLE(17,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,17) * 18. AFBBB TABLE(18,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,18) * 19. GH TABLE(19,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,19) * 20. AFBBBP TABLE(20,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,20) * 21. GINV TABLE(21,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,21) * 22. AFBCC TABLE(22,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,22) * 23. RC TABLE(23,IALS,IAMH,IAMT)=FTAB(T,H,ALSBAR,23) do iobs=1,nobs TABMI(IOBS,IALS,IAMH,IAMT)=TABLE(IOBS,IALS,IAMH,IAMT) TABMA(IOBS,IALS,IAMH,IAMT)=TABLE(IOBS,IALS,IAMH,IAMT) ENDDO ENDDO ENDDO ENDDO CALL vzero(ipami,NOBS*NALS*NAMH*NAMT) CALL vzero(ipama,NOBS*NALS*NAMH*NAMT) * NOPTION=8 ! before 15.11.94 NOPTION=6 NOPTION=7 ! 18.01.95 ncomb=2**noption DO ICOMB=1,NCOMB DO IBIT=1,NOPTION IF(JBIT(ICOMB,IBIT).EQ.1)THEN * if(ibit.eq.4)then IOPTION(IBIT)=1 * endif ELSE IOPTION(IBIT)=0 ENDIF ENDDO ! ibit DO IAMH=1,NAMHM DO IAMT=1,NAMTM DO IALS=1,NALSM AMT=ARMT(IAMT) AMH=ARMH(IAMH) ALSBAR=ARAL(IALS) T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 DO IOBS=1,NOBS OBS=FTAB(T,H,ALSBAR,IOBS) * write(6,*)'iobs,obs,tabmi(iobs,ials,iamh,iamt)', * 1 iobs,obs,tabmi(iobs,ials,iamh,iamt) IF(OBS.GT.TABMA(IOBS,IALS,IAMH,IAMT))THEN TABMA(IOBS,IALS,IAMH,IAMT)=OBS IPAMA(IOBS,IALS,IAMH,IAMT)=ICOMB * write(6,*)'MAX ,obs,tabmi(iobs,ials,iamh,iamt)', * 1 iobs,obs,tabmi(iobs,ials,iamh,iamt) ELSEIF(OBS.LT.TABMI(IOBS,IALS,IAMH,IAMT))THEN TABMI(IOBS,IALS,IAMH,IAMT)=OBS IPAMI(IOBS,IALS,IAMH,IAMT)=ICOMB * write(6,*)'MIN ,obs,tabmi(iobs,ials,iamh,iamt)', * 1 iobs,obs,tabmi(iobs,ials,iamh,iamt) ENDIF ENDDO ! iobs ENDDO ENDDO ENDDO ENDDO ! ncomb DO 6 IOBS=1,NOBS DO 5 IALS=1,NALSM DO 4 IAMT=1,NAMTM write(10,3)IOBS,ARAL(IALS),ARMT(IAMT), & (TABLE(IOBS,IALS,IAMH,IAMT),IAMH=1,NAMHM) 3 FORMAT(1X,I2,1X,F5.3,1X,F4.0,1X,3(D12.5)) 4 CONTINUE 5 CONTINUE 6 CONTINUE DO IOBS=1,NOBS DO IALS=1,NALSM DO IAMT=1,NAMTM write(10,3)IOBS,ARAL(IALS),ARMT(IAMT), & (TABMI(IOBS,IALS,IAMH,IAMT),IAMH=1,NAMHM) ENDDO ENDDO ENDDO DO IOBS=1,NOBS DO IALS=1,NALSM DO IAMT=1,NAMTM write(10,3)IOBS,ARAL(IALS),ARMT(IAMT), & (TABMA(IOBS,IALS,IAMH,IAMT),IAMH=1,NAMHM) ENDDO ENDDO ENDDO CLOSE(10) call ltcomp * * END OF PRINTING BLOCK FOR PLOTS * *----------------------------------------------------------------------- END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FTAB(T,H,ALSBAR,I) * fill FTAB with observable I *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. if(I.eq.1)then * 1. MW ftab=AMWMZ(T,H,ALSBAR)*AMZ elseif(I.EQ.2)then * 2. GNU IN MEV ftab=GNU(T,H,ALSBAR)*1000. elseif(I.EQ.3)then * 3. GEL ftab=GELE(T,H,ALSBAR)*1000. elseif(I.EQ.4)then * 4. GMU ftab=GMUO(T,H,ALSBAR)*1000. elseif(I.EQ.5)then * 5. GTAU ftab=GTAU(T,H,ALSBAR)*1000. elseif(I.EQ.6)then * 6. GU ftab=GU(T,H,ALSBAR)*1000. elseif(I.EQ.7)then * 7. GD ftab=GD(T,H,ALSBAR)*1000. elseif(I.EQ.8)then * 8. GC ftab=GC(T,H,ALSBAR)*1000. elseif(I.EQ.9)then * 9. GB ftab=GB(T,H,ALSBAR)*1000. elseif(I.EQ.10)then * 10. SIN2T ftab=QFB(T,H,ALSBAR) elseif(I.EQ.11)then * 11. SIN2T ftab=SIN2B(T,H,ALSBAR) elseif(I.EQ.12)then * 12. AFBL ftab=AFB(T,H,ALSBAR) elseif(I.EQ.13)then * 13. ALR ftab=ALR(T,H,ALSBAR) elseif(I.EQ.14)then * 14. GZ ftab=GZ(T,H,ALSBAR)*1000. elseif(I.EQ.15)then * 15. RL ftab=RL(T,H,ALSBAR) elseif(I.EQ.16)then * 16. SIGMAH ftab=SIGH(T,H,ALSBAR) elseif(I.EQ.17)then * 17. RB ftab=RB(T,H,ALSBAR) elseif(I.EQ.18)then * 18. AFBBB ftab=AFBBB(T,H,ALSBAR) elseif(I.EQ.19)then * 19. GH ftab=GH(T,H,ALSBAR)*1000. elseif(I.EQ.20)then * 20. AFBBBP ftab=AFBBBP(T,H,ALSBAR) elseif(I.EQ.21)then * 21. GINV ftab=3*GNU(T,H,ALSBAR) elseif(I.EQ.22)then * 22. AFBCC ftab=AFBCC(T,H,ALSBAR) elseif(I.EQ.23)then * 23. RC ftab=RC(T,H,ALSBAR) endif return end *CMZ : 2.00/00 28/01/96 15.19.46 by A.Rozanov *CMZ : 1.30/07 15/02/95 00.31.33 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : SUBROUTINE LBOTAB *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. PARAMETER(NALSM=1,NAMHM=7,NERRM=3) DIMENSION ARAL(NALSM),ARMH(NAMHM) PARAMETER (NOBS=23) DIMENSION TABLE(NOBS,NALSM,NERRM,NAMHM) DIMENSION TABMT(NOBS,NAMHM),TABAL(NOBS,NAMHM) DIMENSION CERR(2,2) DATA ARAL/0.0D0/ DATA ARMH/ 60.D0,120.D0,200.D0,300.D0,500.D0,700.D0,1000.D0/ call datime(id,it) WRITE(6,*)' LEPTOP results - ITEP group -',id,it DO IPR=1,10 PRTFLG(IPR)=-1. ENDDO *----------------------------------------------------------------------- * * PRINTING BLOCK FOR PLOTS * DO IAMH=1,NAMHM AMHNEW=ARMH(IAMH) ALBNEW=ALBAR CALL LTFITT(AMHNEW,ALBNEW,AMTFIT,ALSFIT,CERR,CHI2,NDF) * WRITE(6,*)'AMHNEW,ALBNEW', * 1 AMHNEW,ALBNEW * WRITE(6,*)'AMTFIT,ALSFIT,CHI2', * 1 AMTFIT,ALSFIT,CHI2 * WRITE(6,*)'CERR',CERR AMT=AMTFIT AMH=AMHNEW ALSBAR=ALSFIT T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 DALBAR=0.12 DO IOBS=1,NOBS TABLE(IOBS,1,1,IAMH)=AMH TABMT(IOBS,IAMH)=AMT TABAL(IOBS,IAMH)=ALSBAR TABLE(IOBS,1,2,IAMH)=FTAB(T,H,ALSBAR,IOBS) TABLE(IOBS,1,3,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,IOBS) ENDDO * IALS=1 * IERR=2 * 1. MW * TABLE(1,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,1) * 2. GNU IN MEV * TABLE(2,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,2) * 3. GEL * TABLE(3,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,3) * 4. GMU * TABLE(4,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,4) * 5. GTAU * TABLE(5,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,5) * 6. GU * TABLE(6,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,6) * 7. GD * TABLE(7,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,7) * 8. GC * TABLE(8,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,8) * 9. GB * TABLE(9,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,9) * 10. SIN2T * TABLE(10,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,10) * 11. SIN2T * TABLE(11,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,11) * 12. AFBL * TABLE(12,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,12) * 13. ALR * TABLE(13,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,13) * 14. GZ * TABLE(14,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,14) * 15. RL * TABLE(15,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,15) * 16. SIGMAH * TABLE(16,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,16) * 17. RB * TABLE(17,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,17) * 18. AFBBB * TABLE(18,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,18) * 19. GH * TABLE(19,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,19) * 20. AFBBBP * TABLE(20,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,20) * 21. GINV * TABLE(21,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,21) * 22. AFBCC * TABLE(22,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,22) * 23. RC * TABLE(23,IALS,IERR,IAMH)=FTAB(T,H,ALSBAR,23) * * IERR=3 * DALBAR=0.12 * 1. MW * TABLE(1,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,1) * 2. GNU IN MEV * TABLE(2,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,2) * 3. GEL * TABLE(3,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,3) * 4. GMU * TABLE(4,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,4) * 5. GTAU * TABLE(5,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,5) * 6. GU * TABLE(6,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,6) * 7. GD * TABLE(7,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,7) * 8. GC * TABLE(8,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,8) * 9. GB * TABLE(9,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,9) * 10. SIN2T * TABLE(10,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,10) * 11. SIN2T * TABLE(11,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,11) * 12. AFBL * TABLE(12,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,12) * 13. ALR * TABLE(13,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,13) * 14. GZ * TABLE(14,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,14) * 15. RL * TABLE(15,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,15) * 16. SIGMAH * TABLE(16,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,16) * 17. RB * TABLE(17,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,17) * 18. AFBBB * TABLE(18,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,18) * 19. GH * TABLE(19,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,19) * 20. AFBBBP * TABLE(20,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,20) * 21. GINV * TABLE(21,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,21) * 22. AFBCC * TABLE(22,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,22) * 23. RC * TABLE(23,IALS,IERR,IAMH)=ETAB(CERR,DALBAR,T,H,ALSBAR,23) ENDDO ! ials DO 6 IOBS=1,NOBS DO 5 IALS=1,NALSM DO 4 IAMH=1,NAMHM PRINT 3,IOBS,TABAL(IOBS,IAMH),TABMT(IOBS,IAMH), & (TABLE(IOBS,IALS,IERR,IAMH),IERR=1,NERRM) 3 FORMAT(1X,I2,1X,F5.3,1X,F4.0,1X,3(D12.5)) 4 CONTINUE 5 CONTINUE 6 CONTINUE * * END OF PRINTING BLOCK FOR PLOTS * *----------------------------------------------------------------------- END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : SUBROUTINE DERTAB *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. PARAMETER (NOBS=23) DIMENSION TABDA(NOBS) DIMENSION TABDB(NOBS) call datime(id,it) WRITE(6,*)' LEPTOP results - ITEP group -',id,it DO IPR=1,10 PRTFLG(IPR)=-1. ENDDO *----------------------------------------------------------------------- * AMT= 175. AMH= 300. alsbar=0.125 DALBAR=0.12 ALBAR0=1./128.87 ALBAR1=1./(128.87+DALBAR) ALBAR2=1./(128.87-DALBAR) AMB00=4.7 DAMB=0.3 AMB1 =AMB00+DAMB AMB2 =AMB00-DAMB T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 DO IOBS=1,NOBS ALBAR=ALBAR0 AMB0=AMB00 CALL LTINIT(0) TAB0=FTAB(T,H,ALSBAR,IOBS) ALBAR=ALBAR1 CALL LTINIT(1) TAB1=FTAB(T,H,ALSBAR,IOBS) ALBAR=ALBAR2 CALL LTINIT(1) TAB2=FTAB(T,H,ALSBAR,IOBS) TABDA(IOBS)=(TAB1-TAB0)/DALBAR IF(DABS(TAB2-TAB0).GT.DABS(TAB1-TAB0)) 1 TABDA(IOBS)=(TAB0-TAB2)/DALBAR ALBAR=ALBAR0 AMB0=AMB1 CALL LTINIT(1) TAB1=FTAB(T,H,ALSBAR,IOBS) ALBAR=ALBAR0 AMB0=AMB2 CALL LTINIT(1) TAB2=FTAB(T,H,ALSBAR,IOBS) TABDB(IOBS)=(TAB1-TAB0)/DAMB IF(DABS(TAB2-TAB0).GT.DABS(TAB1-TAB0)) 1 TABDB(IOBS)=(TAB0-TAB2)/DAMB ENDDO ! iobs DO 6 IOBS=1,NOBS PRINT 3,IOBS,TABDA(IOBS),TABDB(IOBS) 3 FORMAT(1X,I2,1X,E12.5,1X,E12.5) 6 CONTINUE * * END OF PRINTING BLOCK FOR PLOTS * *----------------------------------------------------------------------- END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION ETAB(CERR,DALBAR,T,H,ALSBAR,I) * fill ETAB with observable I *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DIMENSION CERR(2,2) DALB=ALBAR-1./(1./ALBAR+DALBAR) F0=FTAB(T,H,ALSBAR,I) AMT=DSQRT(T)*AMZ AMH=DSQRT(H)/AMZ DALS=DSQRT(CERR(2,2)) DT =DSQRT(CERR(1,1)) T1=(AMT+DT)**2/AMZ**2 T2=(AMT-DT)**2/AMZ**2 DTDT=(FTAB(T1,H,ALSBAR,I)-FTAB(T2,H,ALSBAR,I))/(2*DT) DTDA=(FTAB(T,H,ALSBAR+DALS,I)-FTAB(T,H,ALSBAR-DALS,I))/ 1 (2*DALS) * WRITE(6,*)'CERR',CERR E2=DTDT**2*CERR(1,1)+DTDT*DTDA*CERR(1,2)+ 1 DTDT*DTDA*CERR(2,1)+DTDA**2*CERR(2,2) * WRITE(6,*)'DTDT,DTDA',DTDT,DTDA ALBAR0=ALBAR ALBAR=ALBAR0+DALB CALL LTINIT(1) EALB2=(FTAB(T,H,ALSBAR,I)-F0)**2 ETAB=DSQRT(E2+EALB2) * write(6,*)'E2,EALB2,ETAB', * 1 E2,EALB2,ETAB CALL LTINIT(0) return end *CMZ : 1.30/07 03/02/95 13.04.53 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : SUBROUTINE SM4(CM4) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA N/0/ N=N+1 AM4=CM4 * IF(N.EQ.1)WRITE(6,*)'SET AM4= ',AM4 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GM4(IDUMMY) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. GM4=AM4 END *CMZ : 1.30/07 03/02/95 13.04.53 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : SUBROUTINE LTSML4(CM4) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA N/0/ N=N+1 AML4=CM4 * IF(N.EQ.1)WRITE(6,*)'SET AML4= ',AML4 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GML4(IDUMMY) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. GML4=AML4 END *CMZ : 1.30/07 03/02/95 13.04.53 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : SUBROUTINE LTSMQ4(CM4) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA N/0/ N=N+1 AMQ4=CM4 * IF(N.EQ.1)WRITE(6,*)'SET AMQ4= ',AMQ4 END *CMZ : 1.30/07 03/02/95 13.04.53 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : SUBROUTINE LTSNQ4(N4) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA N/0/ N=N+1 NQ4=N4 * IF(N.EQ.1)WRITE(6,*)'SET NQ4= ',N4 END *CMZ : 1.30/07 03/02/95 13.04.53 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : SUBROUTINE LTSNL4(N4) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA N/0/ N=N+1 NL4=N4 * IF(N.EQ.1)WRITE(6,*)'SET NL4= ',N4 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GMQ4(IDUMMY) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. GMQ4=AMQ4 END *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.51 by Rozanov Alexandre *-- Author : FUNCTION CA2CA1(X) * FUNCTION AFMT3(ALST) * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * * NUMERICAL CONSTANTS PI=ATAN(1D0)*4D0 PI2=PI**2 D2=PI2/6D0 D3=1.2020569031596D0 D4=PI2**2/90 AL2=LOG(2D0) TS2=+0.2604341376322D0 TD3=-3.0270094939877D0 TB4=-1.7628000870738D0 * AMT2=(175D0)**2 * AMU2=AMT2 * ALMU=LOG(AMU2/AMT2) almu=0.d0 NF=5 CA1=-2D0/3*(1+2*D2) * print *,'CA1/PI=',CA1/PI CA2=157D0/648-3313D0/162*D2-308D0/27*D3+1051D0/90*D4-4D0/3*D2*AL2 & +441D0/8*TS2-1D0/9*TB4-1D0/18*TD3-(1D0/18-13D0/9*D2+4D0/9*D3)*NF & -(11D0/6-1D0/9*NF)*(1+2*D2)*ALMU * print *,'CA2/PI^2=',CA2/PI2 * AFMT3=CA1*ALST/PI+CA2*(ALST/PI)**2 CA2CA1=CA2/(CA1*pi) * WRITE(6,*)'++CA2CA1: CA2/CA1= ', CA2CA1 * END *CMZ : 2.00/03 08/09/98 21.57.30 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.35.43 by A.Rozanov *CMZ : 1.30/06 18/01/95 23.43.33 by A.Rozanov *CMZ : 1.30/02 17/01/95 18.00.07 by A.Rozanov *CMZ : 1.30/01 16/01/95 21.17.48 by A.Rozanov *-- Author : A.Rozanov 12/01/95 SUBROUTINE LTCOMP * * *----------------------------------------------------------------------* * * * Name : LTCOMP * * (module) * * * * Description : * * to compare LEPTOP results with reference table * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 12/01/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DYBCOM. COMMON/DYBCOM/TABLE,TABMI,TABMA,IPAMI,IPAMA,ARAL,ARMT,ARMH DIMENSION AMHIG(4),AMTOP(4) PARAMETER(NALSM=4,NAMTM=7,NAMHM=3) DIMENSION ARAL(NALSM),ARMT(NAMTM),ARMH(NAMHM) PARAMETER (NOBS=23) DIMENSION TABLE(NOBS,NALSM,NAMHM,NAMTM) DIMENSION TABMI(NOBS,NALSM,NAMHM,NAMTM) DIMENSION TABMA(NOBS,NALSM,NAMHM,NAMTM) DIMENSION IPAMI(NOBS,NALSM,NAMHM,NAMTM) DIMENSION IPAMA(NOBS,NALSM,NAMHM,NAMTM) *KEND. C ----------- end CDE -------------------------------------------------- DIMENSION ARALn(NALSM),ARMTn(NAMTM) DIMENSION TABLEn(NOBS,NALSM,NAMHM,NAMTM) DIMENSION TABMIn(NOBS,NALSM,NAMHM,NAMTM) DIMENSION TABMAn(NOBS,NALSM,NAMHM,NAMTM) * DIMENSION IPAMIn(NOBS,NALSM,NAMHM,NAMTM) * DIMENSION IPAMAn(NOBS,NALSM,NAMHM,NAMTM) character*14 filein CHARACTER*80 TITLE data filein/'leptop.referen'/ * * write(6,*)'+LTCOMP: Test: amhig,amtop=',amhig,amtop rresid_max=0.0001 open(7,FILE=filein,IOSTAT=IOS) if(ios.ne.0)then write(6,*)'++LTCOMP: error in open file #7 iostat=', 1 ios,filein endif read(7,'(a80)')title write(6,*)'LTCOMP: reference file: ',filein write(6,*)title nbad=0 DO 6 IOB =1,NOBS DO 5 IALS=1,NALSM DO 4 IAMT=1,NAMTM read(7,3)IOBS,ARALn(IALS),ARMTn(IAMT), & (TABLEn(IOBS,IALS,IAMH,IAMT),IAMH=1,NAMHM) do iamh=1,namhm resid=TABLE(IOBS,IALS,IAMH,IAMT)-TABLEn(IOBS,IALS,IAMH,IAMT) * write(6,*)'iob,ials,iamt,iobs', * 1 iob,ials,iamt,iobs * write(6,*)TABLE(IOBS,IALS,IAMH,IAMT),TABLEn(IOBS,IALS,IAMH,IAMT) rresid=resid/TABLE(IOBS,IALS,IAMH,IAMT) if(dabs(rresid).gt.rresid_max)then write(6,*)'Observable:iobs,resid,rresid',iobs,resid,rresid write(6,*)ARMTn(IAMT),ARMH(IAMH),ARALn(IALS) nbad=nbad+1 endif enddo 3 FORMAT(1X,I2,1X,F5.3,1X,F4.0,1X,3(D12.5)) 4 CONTINUE 5 CONTINUE 6 CONTINUE DO IOB =1,NOBS DO IALS=1,NALSM DO IAMT=1,NAMTM read(7,3)IOBS,ARALn(IALS),ARMTn(IAMT), & (TABMIn(IOBS,IALS,IAMH,IAMT),IAMH=1,NAMHM) do iamh=1,namh resid=TABMI(IOBS,IALS,IAMH,IAMT)-TABMIn(IOBS,IALS,IAMH,IAMT) rresid=resid/TABMI(IOBS,IALS,IAMH,IAMT) if(dabs(rresid).gt.rresid_max)then write(6,*)'Minimal:iobs,resid,rresid',iobs,resid,rresid nbad=nbad+1 endif enddo ENDDO ENDDO ENDDO DO IOB =1,NOBS DO IALS=1,NALSM DO IAMT=1,NAMTM read(7,3)IOBS,ARALn(IALS),ARMTn(IAMT), & (TABMAn(IOBS,IALS,IAMH,IAMT),IAMH=1,NAMHM) do iamh=1,namh resid=TABMA(IOBS,IALS,IAMH,IAMT)-TABMAn(IOBS,IALS,IAMH,IAMT) rresid=resid/TABMA(IOBS,IALS,IAMH,IAMT) if(dabs(rresid).gt.rresid_max)then write(6,*)'Maximum:iobs,resid,rresid',iobs,resid,rresid nbad=nbad+1 endif enddo ENDDO ENDDO ENDDO close(7) if(nbad.eq.0)write(6,*)'LTCOMP: no difference from Ref.file' 1,' rresid_max=',rresid_max END ! LTCOMP *CMZ : 1.30/02 17/01/95 15.01.44 by A.Rozanov *-- Author : A.Rozanov 17/01/95 DOUBLE PRECISION FUNCTION DWAA(CW2) * * *----------------------------------------------------------------------* * * * Name : DWAA * * (module) * * * * Description : * * correction due to W-boson polarization of e.m. vacuum. * * * * Arguments : * * CW2 ( in ) c2 * * * * Banks/Tables: * * no * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 17/01/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C ----------- end CDE -------------------------------------------------- * * ARG=1/(2*DSQRT(CW2)) DWAA=((3+4*CW2)*(1.-dsqrt(4*CW2-1.)*dasin(ARG))-1./3.)/(2*PI) END ! DWAA *CMZ : 1.30/03 18/01/95 16.15.26 by A.Rozanov *CMZ : 1.30/02 17/01/95 18.33.33 by A.Rozanov *-- Author : A.Rozanov 17/01/95 DOUBLE PRECISION FUNCTION DTAA(T) * * *----------------------------------------------------------------------* * * * Name : DTAA * * (module) * * * * Description : * * corrections due to t-quark polarization of e.m.vacuum * * * * Arguments : * * T ( in ) t=(AMT/AMZ)**2 * * * * Banks/Tables: * * no * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 17/01/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C ----------- end CDE -------------------------------------------------- * * DTAA=-4*((1+2*t)*FT(T)-1./3.)/(9*PI) * DTAA=-0.01089 ! temporary mt=150 GeV MIV 17.01.95 END ! DTAA *CMZ : 1.30/02 17/01/95 16.05.09 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.57.55 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DTTVM(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,TTBAR. COMMON/TTBAR/EPSIL *KEND. gamma=PI*EPSIL/(2*AMZ) DTTVM=-GAMMA*DSQRT(T)*(1.+(-1.+16*S2/3.)/(4*T-1.)) END *CMZ : 1.30/02 17/01/95 16.05.38 by A.Rozanov *CMZ : 1.30/01 16/01/95 17.00.40 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DTTVA(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,TTBAR. COMMON/TTBAR/EPSIL *KEND. gamma=PI*EPSIL/(2*AMZ) DTTVA=-GAMMA*DSQRT(T)*(1.+(1.-8*S2/3.)/(4*T-1.)**2) END *CMZ : 1.30/02 17/01/95 16.06.09 by A.Rozanov *CMZ : 1.30/01 16/01/95 17.01.39 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DTTVR(T) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,TTBAR. COMMON/TTBAR/EPSIL *KEND. gamma=PI*EPSIL/(2*AMZ) DTTVR=-GAMMA*DSQRT(T)*(1.+(5./3.)/(4*T-1.)) END *CMZ : 1.30/09 04/03/95 16.03.00 by A.Rozanov *CMZ : 1.30/04 18/01/95 16.34.45 by A.Rozanov *CMZ : 1.30/02 17/01/95 23.48.57 by A.Rozanov *-- Author : A.Rozanov 17/01/95 DOUBLE PRECISION FUNCTION D3VI(T,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : D3VI * * (module) * * * * Description : * * corrections Avdeev-Fleisher-Michailov-Tarasov * * W(Z)-QQgg-W(Z) * * Arguments : * * T ( in ) t=(mt/mz)**2 * * ALSBAR ( in ) \hat \alpha_s (Mz) * * Banks/Tables: * * no * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 17/01/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. data NF /5/ C ----------- end CDE -------------------------------------------------- * * * D3VI=-(2.1552-0.18094*NF)*(ALPHAMT(T,ALSBAR))**2*T D3VI=-(2.38 -0.18 *NF)*(ALPHAMT(T,ALSBAR))**2*T ! MIV 2.03.95 ******D3VI=0. ! temporary MIV 17.01.95 END ! D3VI *CMZ : 2.00/03 05/09/98 13.02.10 by A.Rozanov *CMZ : 1.30/03 18/01/95 16.00.32 by A.Rozanov *-- Author : A.Rozanov 18/01/95 DOUBLE PRECISION FUNCTION D5VM(T,H,ALSBAR) *----------------------------------------------------------------------* * Name : D5VM * * (module) * * Description : * * quadratic dependence on the Higgs mass * * from Van der Bij and M.Veltman * * Arguments : * * T ( in ) t=(m_t/M_Z)^2 * * H ( in ) H=(M_H/M_Z)^2 * * ALSBAR ( in ) \hat \alpha_s (M_Z) * * Banks/Tables: * * no * *----------------------------------------------------------------------* * Author : A.Rozanov Date : 18/01/95 * * Last modifications : * * [name] Date : 05/09/98 * * Keywords : * * [keywords] * *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C ----------- end CDE -------------------------------------------------- if(IOPTION(10).eq.0)then D5VM=(albar/(24*PI))*0.747*h/c2 else D5VM=0. endif END ! D5VM *---------------------------------------------------------------------- *CMZ : 2.00/03 05/09/98 13.07.25 by A.Rozanov *CMZ : 1.30/03 18/01/95 16.01.02 by A.Rozanov *-- Author : A.Rozanov 18/01/95 DOUBLE PRECISION FUNCTION D5VA(T,H,ALSBAR) *----------------------------------------------------------------------* * Name : D5VA * * (module) * * Description : * * quadratic dependence on the Higgs mass * * from Van der Bij and M.Veltman * * Arguments : * * T ( in ) t=(m_t/M_Z)^2 * * H ( in ) H=(M_H/M_Z)^2 * * ALSBAR ( in ) \hat \alpha_s (M_Z) * * Banks/Tables: * * no * *----------------------------------------------------------------------* * Author : A.Rozanov Date : 18/01/95 * * Last modifications : * * [name] Date : 05/09/98 * * Keywords : * * [keywords] * *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C ----------- end CDE -------------------------------------------------- if(IOPTION(10).ne.0)then D5VA=(albar/(24*PI))*1.199*(c2/s2)*h/c2 else D5VA=0. endif END ! D5VA *CMZ : 2.00/03 05/09/98 13.07.25 by A.Rozanov *CMZ : 1.30/03 18/01/95 16.01.34 by A.Rozanov *-- Author : A.Rozanov 18/01/95 DOUBLE PRECISION FUNCTION D5VR(T,H,ALSBAR) *----------------------------------------------------------------------* * Name : D5VR * * (module) * * Description : * * quadratic dependence on the Higgs mass * * from Van der Bij and M.Veltman * * Arguments : * * T ( in ) t=(m_t/M_Z)^2 * * H ( in ) H=(M_H/M_Z)^2 * * ALSBAR ( in ) \hat \alpha_s (M_Z) * * Banks/Tables: * * no * *----------------------------------------------------------------------* * Author : A.Rozanov Date : 18/01/95 * * Last modifications : * * [name] Date : 05/09/98 * * Keywords : * * [keywords] * *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C ----------- end CDE -------------------------------------------------- if(IOPTION(10).ne.0)then D5VR=(albar/(24*PI))*0.973*((c2-s2)/s2)*h/c2 else D5VR=0. endif END ! D5VR *CMZ : 1.30/06 18/01/95 21.14.03 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GLEPTON(T,H,ALSBAR,AMLEPT) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. ga=GAELE(T,H,ALSBAR) gv=GVAELE(T,H,ALSBAR)*ga GLEPTON=4*GO*(gv**2*(1.+3*ALBAR/(4*PI)) 1 +ga**2*(1.-6*(AMLEPT/AMZ)**2+3*ALBAR/(4*PI))) END *CMZ : 29/09/98 22.22.50 by A.Rozanov *CMZ : 1.30/06 19/01/95 20.31.04 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GAQ(T,H,ALSBAR,AIQ3,QQ,IFLAV) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * IF(IFLAV.EQ.5)THEN * LBOT=1 * ELSE * LBOT=0 * ENDIF GAQ=AIQ3*(1.+3*ALBAR*VAQ(T,H,ALSBAR,IFLAV)/(32*PI*S2*C2)) *****1+LBOT*ALBAR*PHI(T,H,ALSBAR)/(8*PI*(3.-2.*S2)) ! 19.01.95 END *CMZ : 1.30/06 19/01/95 20.32.59 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION GVAQ(T,H,ALSBAR,AIQ3,QQ,IFLAV) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. * IF(IFLAV.EQ.5)THEN * LBOT=1 * ELSE * LBOT=0 * ENDIF Q=DABS(QQ) GVAQ=1.-4.*S2*Q 1+(3*ALBAR*Q*VRQ(T,H,ALSBAR,IFLAV))/(4*PI*(C2-S2)) *****2-LBOT*ALBAR*s2*PHI(T,H,ALSBAR)/(3*PI*(3.-2.*S2)) ! 19.01.95 END *CMZ : 2.00/02 03/07/98 17.35.24 by A.Rozanov *CMZ : 1.30/06 18/01/95 22.58.37 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION RVQ(T,H,ALSBAR,AIQ3,QQ,AMQBAR,IFLAV) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. *-----use Kuhn formulas checked by L.B. 29.09.94 *-----from a of paper given by D,Bardine SMT2=1./T AMQ2=AMQBAR**2 AM2QS=AMQ2/AMZ**2 RVQ=1.+(3./4.)*QQ**2*(ALBAR/PI)+ALSBAR/PI 1-0.25*QQ**2*(ALBAR/PI)*(ALSBAR/PI) 2+(1.40923+(44./675.-(2./135.)*DLOG(SMT2))*SMT2)*(ALSBAR/PI)**2 3-12.76706*(ALSBAR/PI)**3 4+12.*AM2QS*(ALSBAR/PI)*(1.+8.7*(ALSBAR/PI)+45.65*(ALSBAR/PI)**2) 5+DSUSYRV(T,H,ALSBAR) END *CMZ : 2.00/02 03/07/98 17.36.34 by A.Rozanov *CMZ : 1.30/06 18/01/95 22.57.34 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION RAQ(T,H,ALSBAR,AIQ3,QQ,AMQBAR,IFLAV) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. *-----use Kuhn formulas checked by L.B. 29.09.94 *-----from a of paper given by D,Bardine SMT2=1./T AM2QS=(AMQBAR/AMZ)**2 RAQ=1.+(3./4.)*QQ**2*(ALBAR/PI)+ALSBAR/PI 1-0.25*QQ**2*(ALBAR/PI)*(ALSBAR/PI) 2+(1.40923+(44./675.-(2./135.)*DLOG(SMT2))*SMT2 3-2*AIQ3*FF2(SMT2))*(ALSBAR/PI)**2 4+(-12.76706-2*AIQ3*FF3(SMT2))*(ALSBAR/PI)**3 5-6.*AM2QS*(1.+(11./3.)*(ALSBAR/PI) 6+(11.286+DLOG(SMT2))*(ALSBAR/PI)**2) 7-10.*(AM2QS/T)*(8./81-DLOG(SMT2)/54.)*(ALSBAR/PI)**2 8+DSUSYRA(T,H,ALSBAR) END *CMZ : 1.30/06 19/01/95 20.42.59 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VAB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. VAB=VAD(T,H,ALSBAR)+DPHIA(T,H,ALSBAR) END *CMZ : 1.30/06 19/01/95 20.17.30 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION VRB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. VRB=VRD(T,H,ALSBAR)+DPHIR(T,H,ALSBAR) END *CMZ : 14/01/99 18.27.08 by A.Rozanov *CMZ : 1.30/06 19/01/95 20.39.05 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DPHIA(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DPHIA=-8*s2*c2*(PHI(T,H,ALSBAR)+DPHI(T,H,ALSBAR)) 1 /(3*(3.-2.*S2)) END *CMZ : 14/01/99 18.27.08 by A.Rozanov *CMZ : 1.30/06 19/01/95 20.40.32 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DPHIR(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DPHIR=-4*s2*(c2-s2)*(PHI(T,H,ALSBAR)+DPHI(T,H,ALSBAR)) 1 /(3*(3.-2.*S2)) END *CMZ : 1.30/07 20/01/95 22.22.10 by A.Rozanov *CMZ : 1.30/05 18/01/95 19.19.54 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : SUBROUTINE MIVTAB *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEND. parameter (NOBS=23) parameter (NCOMB=7) parameter (NMIV=10) character*5 chtab dimension TABMIV(NOBS,NCOMB),ITAB(NMIV),CHTAB(NMIV) dimension error(NMIV),total(NMIV) data ITAB/1,3,10,16,14,19,15,9,17,23/ data CHTAB/'MW ','Gl ','sin2T','sigH ','GZ ','Gh ', 1 'Rl ','Gb ','Rb ','Rc '/ call datime(id,it) WRITE(6,*)' LEPTOP results - ITEP group -',id,it WRITE(6,*)' MIV table of errors Table 26 of YR' *----------------------------------------------------------------------- * * AMT=175. AMH=300. ALSBAR=0.125 T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 DALBAR=0.12 ALBAR0=1./128.87 ALBAR1=1./(128.87+DALBAR) ALBAR2=1./(128.87-DALBAR) AMB00=4.7 DAMB=0.3 AMB1 =AMB00+DAMB AMB2 =AMB00-DAMB * 1. MW * 2. GNU IN MEV * 3. GEL * 4. GMU * 5. GTAU * 6. GU * 7. GD * 8. GC * 9. GB * 10. SIN2T * 11. SIN2T * 12. AFBL * 13. ALR * 14. GZ * 15. RL * 16. SIGMAH * 17. RB * 18. AFBBB * 19. GH * 20. AFBBBP * 21. GINV * 22. AFBCC * 23. RC DO ICOMB=1,NCOMB call ltinit(0) do iop=1,7 ioption(iop)=0 enddo if(icomb.eq.2)then * vary albar ALBAR=ALBAR1 CALL LTINIT(1) elseif(icomb.eq.3)then * vary mb AMB0=AMB1 CALL LTINIT(1) elseif(icomb.eq.4)then * vary delta V t2 i ioption(1)=1 elseif(icomb.eq.5)then * vary delta Vas2i ioption(3)=1 elseif(icomb.eq.6)then * vary delta Fasq ioption(5)=1 elseif(icomb.eq.7)then * vary delta phi as2 ioption(7)=1 endif DO IOBS=1,NOBS OBS=FTAB(T,H,ALSBAR,IOBS) * write(6,*)'iobs,obs', * 1 iobs,obs TABMIV(IOBS,ICOMB)=OBS ENDDO ! iobs * ENDDO ! ncomb DO IOBS=1,NMIV TOTAL(IOBS)=0.D0 ENDDO write(6,*)' ',(CHTAB(ip),ip=1,NMIV) DO ICOMB=2,NCOMB DO JOBS=1,NMIV IOBS=ITAB(JOBS) error(JOBS)=dabs(TABMIV(IOBS,ICOMB)-TABMIV(IOBS,1)) if(icomb.ge.4)total(JOBS)=total(JOBS)+ERROR(JOBS) ENDDO write(6,10010)icomb,(error(IOBS),iobs=1,NMIV) 10010 format(i4,f8.6,f9.6,2f8.5,2f5.2,f7.4,f5.2,2f9.6) ENDDO icomb=0 write(6,10010)icomb,(total(IOBS),iobs=1,NMIV) END *CMZ : 16/12/99 19.55.49 by A.Rozanov *CMZ : 2.00/03 05/09/98 11.25.05 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.32.35 by A.Rozanov *CMZ : 2.00/01 17/03/98 21.57.20 by A.Rozanov *CMZ : 2.00/00 24/06/97 14.20.46 by A.Rozanov *CMZ : 2.00/03 26/10/95 12.29.31 by A.Rozanov *CMZ : 2.00/01 09/03/95 13.43.52 by A.Rozanov *CMZ : 1.30/09 23/02/95 02.19.11 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.36.39 by A.Rozanov *CMZ : 1.30/07 19/02/95 23.53.01 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTTEST * * *----------------------------------------------------------------------* * * * Name : LTTEST * * (module) * * * * Description : * * template program to demonstrate LEPTOP package * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/02/95 * * * * * * Last modifications : * * A.Rozanov Date : 26/10/95 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * * CALL LTELLIS96 * CALL LTVERTEX96 * CALL LTYAD97 * CALL LTVYS97 * CALL LTWARD97 * CALL LTMORI98 * CALL LTSUSY2 * CALL LTOBZOR * CALL LTSUGRA * CALL LT4SUSY * CALL LT4M4 * CALL LT4MN50 * CALL LT4SUSYINO * CALL LTCHARGINO CALL LTLP99 * CALL LTISOL * CALL LTWINT97 RETURN 1002 continue * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) * MINUIT settings * CALL LTFLAG('MNPRNT',-1) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNSAVE',7) * CALL LTFLAG('MNEPS',-10) * get some constants CALL LTGET('MZ',AMZ) CALL LTGET('GFERMI',GFERMI) CALL LTGET('ALBAR',ALBAR) * write(6,'(' MZ= ',F8.4,'GF= ',E16.8,'alphabar= 1./',F6.2)') * 1 AMZ,GFERMI,1./ALBAR * get more constants CALL LTGET('MELE',amele) CALL LTGET('MMUO',ammuo) CALL LTGET('MTAU',amtau) CALL LTGET('MS',amstr) CALL LTGET('MC',amchrm) CALL LTGET('MB',ambot) * write(6,10010)amele,ammuo,amtau,amstr,amchrm,ambot *10010 format(' me= ',f10.6,' mmu= ',f6.3,' mtau= ',f6.3, * 1 ' ms= ',f6.3,' mc= ',f6.3,' mb= ',f6.3) * swith on print out inside LTGET CALL LTFLAG('PRNT',9) CALL LTFGET('VALUE','GZ',gz) CALL LTFGET('ERROR','GZ',egz) write(6,*)'+LTTEST: gz= ',gz,' +- ',egz CALL LTFGET(' ','ALL',0.) * swith on print out inside LTPUT CALL LTFLAG('PRNT',8) * modify some constants AMT=175. CALL LTPUT('MT',AMT) AMH=300. CALL LTPUT('MH',AMH) als=0.125 CALL LTPUT('ALSHAT',als) CALL LTPUT('ALBAR',1./128.87) CALL LTPUT('GFERMI',1.16639E-5) * get some physical quantities CALL LTGET('GV',gv) CALL LTGET('GA',ga) CALL LTGET('MW',amw) CALL LTGET('GNU',gnu) CALL LTGET('GE',ge) CALL LTGET('GMUON',gmuon) CALL LTGET('GTAU',gtau) CALL LTGET('GU',gu) CALL LTGET('GD',gd) CALL LTGET('GS',gs) CALL LTGET('GC',gc) CALL LTGET('GB',gb) CALL LTGET('SIN2E',sin2e) CALL LTGET('SIN2B',sin2b) CALL LTGET('AFBL',afbl) CALL LTGET('ALR',alr) CALL LTGET('GZ',gz) CALL LTGET('RL',rl) CALL LTGET('SIGH',sigh) CALL LTGET('RB',rb) CALL LTGET('AFBB',afbb) CALL LTGET('GH',gh) CALL LTGET('AFBB',afbb) CALL LTGET('GINV',ginv) CALL LTGET('AFBC',afbc) CALL LTGET('RC',rc) CALL LTGET('ALBAR',alphabar) CALL LTGET('ALSHAT',alphas) CALL LTGET('GFERMI',gfermi) * test fit of mtop and alsbar CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) write(6,*)'+LTTEST: mt= ',amt,' +- ',eamt, 1 ' als= ',als,' +- ',eals write(6,*)'+LTTEST: rho,chi2= ',rho,chi2 gz=2.4974 CALL LTFPUT('VALUE','GZ',gz) sigh=41.49 CALL LTFPUT('VALUE','SIGH',sigh) rl=20.795 CALL LTFPUT('VALUE','RL',rl) afbl=0.017 CALL LTFPUT('VALUE','AFBL',afbl) rb=0.2202 CALL LTFPUT('VALUE','RB',rb) amwmz=0.8798 CALL LTFPUT('VALUE','MWMZ',amwmz) atau=0.143 CALL LTFPUT('VALUE','ATAU',atau) aetau=0.135 CALL LTFPUT('VALUE','AETAU',aetau) afbb=0.0967 CALL LTFPUT('VALUE','AFBB',afbb) afbc=0.076 CALL LTFPUT('VALUE','AFBC',afbc) qfb=0.232 CALL LTFPUT('VALUE','QFB',qfb) s2nun=0.2256 CALL LTFPUT('VALUE','S2NUN',s2nun) alr=0.1637 CALL LTFPUT('VALUE','ALR',alr) amtcdf=174. CALL LTFPUT('VALUE','MT',amtcdf) gl=0.08396 CALL LTFPUT('VALUE','GL',gl) rc=0.1583 CALL LTFPUT('VALUE','RC',rc) * set experimental errors egz=0.0038 CALL LTFPUT('ERROR','GZ',egz) esigh=0.12 CALL LTFPUT('ERROR','SIGH',esigh) erl=0.04 CALL LTFPUT('ERROR','RL',erl) eafbl=0.0016 CALL LTFPUT('ERROR','AFBL',eafbl) erb=0.0020 CALL LTFPUT('ERROR','RB',erb) eamwmz=0.0021 CALL LTFPUT('ERROR','MWMZ',eamwmz) eatau=0.010 CALL LTFPUT('ERROR','ATAU',eatau) eaetau=0.011 CALL LTFPUT('ERROR','AETAU',eaetau) eafbb=0.0038 CALL LTFPUT('ERROR','AFBB',eafbb) eafbc=0.0091 CALL LTFPUT('ERROR','AFBC',eafbc) eqfb=0.00156 CALL LTFPUT('ERROR','QFB',eqfb) es2nun=0.0047 CALL LTFPUT('ERROR','S2NUN',es2nun) ealr=0.0079 CALL LTFPUT('ERROR','ALR',ealr) eamtcdf=16. CALL LTFPUT('ERROR','MT',eamtcdf) egl=0.000180 CALL LTFPUT('ERROR','GL',egl) erc=0.0098 CALL LTFPUT('ERROR','RC',erc) * set error correlation in the fit CALL LTFCOR('MZ','GZ',0.040) CALL LTFCOR('GZ','SIGH',-0.110) CALL LTFCOR('GZ','RL',0.010) CALL LTFCOR('GZ','AFBL',0.000) CALL LTFCOR('GZ','RB',0.0) CALL LTFCOR('RB','AFBB',-0.047) CALL LTFCOR('RB','AFBC',0.082) CALL LTFCOR('RB','RC',-0.401) CALL LTFCOR('AFBB','AFBC',0.084) CALL LTFCOR('AFBB','RC',0.083) CALL LTFCOR('AFBC','RC',-0.107) CALL LTFUSE('NOUSE','ALL') CALL LTFUSE('USE','GZ') CALL LTFUSE('USE','SIGH') CALL LTFUSE('USE','RL') CALL LTFUSE('USE','AFBL') CALL LTFUSE('USE','RB') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('USE','ATAU') CALL LTFUSE('USE','AETAU') CALL LTFUSE('USE','AFBB') CALL LTFUSE('USE','AFBC') CALL LTFUSE('USE','QFB') CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','ALR') CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','RC') * test fit of mtop and alsbar CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) write(6,*)'+LTTEST: mt= ',amt,' +- ',eamt, 1 ' als= ',als,' +- ',eals write(6,*)'+LTTEST: rho,chi2= ',rho,chi2 * swith off print out inside LTPUT CALL LTFLAG('PRNT',-8) * swith on print out inside LTPUT CALL LTFLAG('PRNT',8) * test standard subsets CALL LTFPUT('MARSEILLE','ALL',dummy) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) write(6,*)'+LTTEST: mt= ',amt,' +- ',eamt, 1 ' als= ',als,' +- ',eals write(6,*)'+LTTEST: rho,chi2= ',rho,chi2 CALL LTFPUT('MORIOND94','ALL',dummy) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) write(6,*)'+LTTEST: mt= ',amt,' +- ',eamt, 1 ' als= ',als,' +- ',eals write(6,*)'+LTTEST: rho,chi2= ',rho,chi2 * set options CALL LTFLAG('OPT',1) CALL LTFLAG('OPT',3) CALL LTFLAG('OPT',5) CALL LTFLAG('OPT',7) CALL LTFPUT('GLASGOW','ALL',dummy) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) write(6,*)'+LTTEST: mt= ',amt,' +- ',eamt, 1 ' als= ',als,' +- ',eals write(6,*)'+LTTEST: rho,chi2= ',rho,chi2 * reset options CALL LTFLAG('OPT',0) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) write(6,*)'+LTTEST: mt= ',amt,' +- ',eamt, 1 ' als= ',als,' +- ',eals write(6,*)'+LTTEST: rho,chi2= ',rho,chi2 CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) write(6,*)'+LTTEST: mt= ',amt,' +- ',eamt, 1 ' mh= ',amh,' +- ',eamh write(6,*)'+LTTEST: rho,chi2= ',rho,chi2 * test LTFGET with fit results CALL LTFGET('FIT_RESULT','MT',amt) CALL LTFGET('FIT_ERROR' ,'MT',emt) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbmt) write(6,*)'+LTTEST:amt,emt,emtpos,emtneg,glbmt', 1 amt,emt,emtpos,emtneg,glbmt CALL LTFGET('FIT_RESULT','MH',aMH) CALL LTFGET('FIT_ERROR' ,'MH',eMH) CALL LTFGET('FIT_ERR+' ,'MH',eMHpos) CALL LTFGET('FIT_ERR-' ,'MH',eMHneg) CALL LTFGET('FIT_GLB' ,'MH',glbMH) write(6,*)'+LTTEST:aMH,eMH,eMHpos,eMHneg,glbMH', 1 aMH,eMH,eMHpos,eMHneg,glbMH CALL LTFIT2('ALS,MH',als,amh,eals,eamh,rho,chi2,ndf) write(6,*)'+LTTEST: als= ',als,' +- ',eals, 1 ' mh= ',amh,' +- ',eamh write(6,*)'+LTTEST: rho,chi2= ',rho,chi2 CALL LTFIT1('MT',amt,eamt,chi2,ndf) write(6,*)'+LTTEST: mt= ',amt,' +- ',eamt write(6,*)'+LTTEST: chi2= ',chi2 CALL LTFIT1('MH',amh,eamh,chi2,ndf) write(6,*)'+LTTEST:', 1 ' mh= ',amh,' +- ',eamh write(6,*)'+LTTEST: chi2= ',chi2 CALL LTFIT1('ALS',als,eals,chi2,ndf) write(6,*)'+LTTEST: als= ',als,' +- ',eals write(6,*)'+LTTEST: chi2= ',chi2 END ! LTTEST *CMZ : 2.00/02 03/07/98 19.32.06 by A.Rozanov *CMZ : 1.30/07 01/02/95 21.02.54 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : SUBROUTINE AMHMT_PR * x**2 coefficient of 1/rho-1 expansion (apart of Nc=3 factor) * from formula (18) of TH-6696 preprint and formula (17) of * Barbieri et al.PL B 288 , 95-98 (1992) PARAMETER(NPA=11,MPOL=2) PARAMETER(NPAD=41) REAL*4 AX(NPAD),RX(NPAD) DATA AX/.00, &.10,.20,.30,.40,.50,.60,.70,.80,.90,1.0, &1.1,1.2,1.3,1.4,1.5,1.6,1.7,1.8,1.9,2.0, &2.1,2.2,2.3,2.4,2.5,2.6,2.7,2.8,2.9,3.0, &3.1,3.2,3.3,3.4,3.5,3.6,3.7,3.8,3.9,4.0/ DATA RX/.73921, &1.821,2.704,3.462,4.127,4.720,5.254,5.737, &6.179,6.583,6.956,7.299,7.617,7.912,8.186, &8.441,8.679,8.902,9.109,9.303,9.485,9.655, &9.815,9.964,10.104,10.235,10.358,10.473, &10.581,10.683,10.777,10.866,10.949,11.026, &11.098,11.165,11.228,11.286,11.340,11.390, &11.436/ do i=1,npad write(6,'(f5.2,f10.3)')ax(i),rx(i) enddo END *CMZ : 2.00/02 03/07/98 19.31.26 by A.Rozanov *CMZ : 1.30/07 01/02/95 21.11.11 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : SUBROUTINE TAU2_PR * Z1/Z2 (apart of -2x factor) * from formulas (16) and (17) of Barbieri et al.PL B * 288 , 95-98 (1992) PARAMETER(MPOL=2) PARAMETER(NPAD=41) REAL*4 AX(NPAD),TX(NPAD) * tables from Fleisher, Tarasov, Jegerleiner, BI-TP-93/24 DATA AX/.00, &.10,.20,.30,.40,.50,.60,.70,.80,.90,1.0, &1.1,1.2,1.3,1.4,1.5,1.6,1.7,1.8,1.9,2.0, &2.1,2.2,2.3,2.4,2.5,2.6,2.7,2.8,2.9,3.0, &3.1,3.2,3.3,3.4,3.5,3.6,3.7,3.8,3.9,4.0/ DATA TX/ 5.710, &4.671,3.901,3.304,2.834,2.461,2.163,1.924, &1.735,1.586,1.470,1.382,1.317,1.272,1.245, &1.232,1.232,1.243,1.264,1.293,1.330,1.373, &1.421,1.475,1.533,1.595,1.661,1.730,1.801, &1.875,1.951,2.029,2.109,2.190,2.272,2.356, &2.441,2.526,2.613,2.700,2.788/ do i=1,npad write(6,'(f6.2,f10.3)')ax(i),tx(i) enddo END *CMZ : 04/12/98 16.01.15 by A.Rozanov *CMZ : 2.00/00 05/01/96 19.19.02 by A.Rozanov *CMZ : 1.30/08 22/02/95 16.28.16 by A.Rozanov *CMZ : 1.30/07 18/02/95 01.20.15 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTPUT(CHKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTPUT * * (module) * * * * Description : * * input of parameters for LEPTOP * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * fourth generation Date : 02/11/95 * * * * Keywords : * * LTINIT, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. CHARACTER*(*) CHKEY REAL*4 VALUE * LK=LEN(CHKEY) * modify some constants IF(CHKEY(1:LK).eq.'MT')THEN AMTCOM=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'MH')THEN AMHCOM=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'MZ')THEN AMZ=DBLE(VALUE) * CALL LTFPUV('MZ',VALUE) ELSEIF(CHKEY(1:LK).EQ.'ALSHAT'.OR.CHKEY(1:LK).EQ.'ALSBAR')THEN ALSCOM=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'ALBAR'.OR.CHKEY(1:LK).EQ.'albar')THEN ALBAR=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'GFERMI'.OR.CHKEY(1:LK).EQ.'gfermi')THEN GMU=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'NL4'.OR.CHKEY(1:LK).EQ.'nl4')THEN NL4=VALUE ELSEIF(CHKEY(1:LK).EQ.'NQ4'.OR.CHKEY(1:LK).EQ.'nq4')THEN NQ4=VALUE ELSEIF(CHKEY(1:LK).EQ.'ML4'.OR.CHKEY(1:LK).EQ.'ml4')THEN AML4=DBLE(VALUE) AM4=AML4 AMN4=AML4 AME4=AML4 ELSEIF(CHKEY(1:LK).EQ.'MQ4'.OR.CHKEY(1:LK).EQ.'mq4')THEN AMQ4=DBLE(VALUE) AM4=AMQ4 AMU4=AMQ4 AMD4=AMQ4 ELSEIF(CHKEY(1:LK).EQ.'MN4'.OR.CHKEY(1:LK).EQ.'mn4')THEN AMN4=DBLE(VALUE) AM4=AMN4 ELSEIF(CHKEY(1:LK).EQ.'ME4'.OR.CHKEY(1:LK).EQ.'me4')THEN AME4=DBLE(VALUE) AM4=AME4 ELSEIF(CHKEY(1:LK).EQ.'MU4'.OR.CHKEY(1:LK).EQ.'mu4')THEN AMU4=DBLE(VALUE) AM4=AMU4 ELSEIF(CHKEY(1:LK).EQ.'MD4'.OR.CHKEY(1:LK).EQ.'md4')THEN AMD4=DBLE(VALUE) AM4=AMD4 ELSE WRITE(6,*)'+LTPUT: wrong key: ',CHKEY(1:LK), DBLE(VALUE) ENDIF * * print IF(PRTFLG(8).NE.0)THEN WRITE(6,10010)CHKEY(1:LK),DBLE(VALUE) 10010 FORMAT(1x,'+LTPUT: ',A20,' = ',E16.8) ENDIF * initialisation CALL LTINIT(1) END ! LTPUT *CMZ : 11/04/99 23.02.40 by A.Rozanov *CMZ : 2.00/00 29/01/96 11.43.05 by A.Rozanov *CMZ : 1.30/09 23/02/95 02.17.30 by A.Rozanov *CMZ : 1.30/07 17/02/95 23.53.32 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTGET(CHKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTGET * * (module) * * * * Description : * * interface to extract values from LEPTOP package * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/02/95 * * * * * * Last modifications : * * int. S2 Date : 05/01/96 * * * * Keywords : * * LTINIT, LTGET *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEND. REAL*4 VALUE * * CHARACTER*(*) CHKEY * * get some constants or variables LK=LEN(CHKEY) T=(AMTCOM/AMZ)**2 H=(AMHCOM/AMZ)**2 IF(CHKEY(1:LK).EQ.'MZ')THEN VALUED=AMZ ELSEIF(CHKEY(1:LK).EQ.'MW')THEN VALUED=AMWMZ(T,H,ALSCOM)*AMZ ELSEIF(CHKEY(1:LK).EQ.'MWMZ')THEN VALUED=AMWMZ(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'S2NUN')THEN VALUED=S2NUN(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GNU')THEN VALUED=GNU(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GL')THEN VALUED=GL(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GE')THEN VALUED=GELE(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GMUON')THEN VALUED=GMUO(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GTAU')THEN VALUED=GTAU(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GU')THEN VALUED=GU(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GD')THEN VALUED=GD(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GC')THEN VALUED=GC(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GB')THEN VALUED=GB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'SIN2E'.OR.CHKEY(1:LK).EQ.'QFB')THEN VALUED=QFB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'SIN2B')THEN VALUED=SIN2B(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'AFBL')THEN VALUED=AFB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'ALR')THEN VALUED=ALR(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GZ')THEN VALUED=GZ(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'RL')THEN VALUED=RL(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'SIGH')THEN VALUED=SIGH(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'RB')THEN VALUED=RB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'ATAU'.OR.CHKEY(1:LK).EQ.'AETAU')THEN VALUED=ALE(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'AFBB')THEN VALUED=AFBBB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GH')THEN VALUED=GH(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'AFBBP')THEN VALUED=AFBBBP(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GINV')THEN VALUED=3*GNU(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'AFBC')THEN VALUED=AFBCC(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'RC')THEN VALUED=RC(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'MELE')THEN VALUED=AMELE ELSEIF(CHKEY(1:LK).EQ.'MELE')THEN VALUED=AMEL ELSEIF(CHKEY(1:LK).EQ.'MMUO')THEN VALUED=AMMU ELSEIF(CHKEY(1:LK).EQ.'MTAU')THEN VALUED=AMTAU ELSEIF(CHKEY(1:LK).EQ.'MS')THEN VALUED=AMSTRN ELSEIF(CHKEY(1:LK).EQ.'MC')THEN VALUED=AMCHRMTOP ELSEIF(CHKEY(1:LK).EQ.'MB')THEN VALUED=AMB0 ELSEIF(CHKEY(1:LK).EQ.'MT')THEN VALUED=AMTCOM ELSEIF(CHKEY(1:LK).EQ.'MH')THEN VALUED=AMHCOM ELSEIF(CHKEY(1:LK).EQ.'ALSHAT' 1 .OR.CHKEY(1:LK).eq.'ALSBAR')THEN VALUED=ALSCOM ELSEIF(CHKEY(1:LK).EQ.'ALBAR' 1 .OR.CHKEY(1:LK).eq.'albar')THEN VALUED=ALBAR ELSEIF(CHKEY(1:LK).EQ.'GFERMI')THEN VALUED=GMU ELSEIF(CHKEY(1:LK).EQ.'GVA')THEN VALUED=GVAELE(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'S2L')THEN VALUED=0.25*(1.-GVAELE(T,H,ALSCOM)) ELSEIF(CHKEY(1:LK).EQ.'GV')THEN VALUED=GVAELE(T,H,ALSCOM)*GAELE(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GA')THEN VALUED=GAELE(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GS')THEN VALUED=GS(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'S2')THEN VALUED=S2 ELSEIF(CHKEY(1:LK).EQ.'AB')THEN VALUED=AB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'AC')THEN VALUED=AF(T,H,ALSCOM,0.5D0,0.666666D0) ELSE VALUED=0.D0 WRITE(6,*)'+LTGET: wrong keyword: ',CHKEY ENDIF IF(PRTFLG(9).ne.0)THEN WRITE(6,10010)CHKEY(1:LK),VALUED 10010 FORMAT(1x,'+LTGET: ',A20,E16.8) ENDIF VALUE=SNGL(VALUED) END ! LTGET *CMZ : 2.00/01 09/03/95 13.43.52 by A.Rozanov *CMZ : 1.30/07 19/02/95 23.12.03 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFLAG(KEY,ICODE) * * *----------------------------------------------------------------------* * * * Name : LTFLAG * * (module) * * * * Description : * * flag steering of LEPTOP package * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTFLAG * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEEP,mncom. COMMON/MNCOM/MNPRNT,MNREAD,MNUNIT,MNSAVE,EPSMN *KEND. * CHARACTER*(*) KEY PARAMETER (NPR=10) * LK=LEN(KEY) I=IABS(ICODE) IF(KEY(1:LK).EQ.'PRNT')THEN IF(ICODE.EQ.0)THEN DO IPR=1,NPR PRTFLG(IPR)=0. ENDDO ELSEIF(ICODE.GE.1.AND.ICODE.LE.NPR)THEN PRTFLG(I)=1. ELSEIF(ICODE.GE.-NPR.AND.ICODE.LE.-1)THEN PRTFLG(I)=0. ELSE WRITE(6,*)'+LTFLAG: PRNT key with wrong code: ',ICODE ENDIF ELSEIF(KEY(1:LK).EQ.'OPT')THEN IF(ICODE.EQ.0)THEN DO IP=1,20 IOPTION(IP)=0. ENDDO ELSEIF(ICODE.GE.1.AND.ICODE.LE.NOPTIONS)THEN IOPTION(I)=1 ELSEIF(ICODE.GE.-NOPTIONS.AND.ICODE.LE.-1)THEN IOPTION(I)=0 ELSE WRITE(6,*)'+LTFLAG: OPT key with wrong code: ',ICODE ENDIF ELSEIF(KEY(1:LK).EQ.'MNPRNT')THEN IF(ICODE.GE.-1.AND.ICODE.LE.3)THEN MNPRNT=ICODE ELSE WRITE(6,*)'+LTFLAG: wrong MNPRNT level',ICODE ENDIF ELSEIF(KEY(1:LK).EQ.'MNUNIT')THEN IF(ICODE.eq.-19.OR.(ICODE.GE.1.AND.ICODE.LE.99))THEN MNUNIT=ICODE ELSE WRITE(6,*)'+LTFLAG: wrong MNUNIT ',ICODE ENDIF ELSEIF(KEY(1:LK).EQ.'MNREAD')THEN IF(ICODE.GE.-99.AND.ICODE.LE.99)THEN MNREAD=ICODE ELSE WRITE(6,*)'+LTFLAG: wrong MNREAD ',ICODE ENDIF ELSEIF(KEY(1:LK).EQ.'MNSAVE')THEN IF(ICODE.GE.1.AND.ICODE.LE.99)THEN MNSAVE=ICODE ELSE WRITE(6,*)'+LTFLAG: wrong MNSAVE ',ICODE ENDIF ELSEIF(KEY(1:LK).EQ.'MNEPS')THEN IF(ICODE.GE.-15.AND.ICODE.LE.-4)THEN EPSMN=10.D0**ICODE ELSE WRITE(6,*)'+LTFLAG: wrong MNEPS power ',ICODE ENDIF ELSE WRITE(6,*)'+LTFLAG: wrong key: ',KEY(1:LK) ENDIF END ! LTFLAG *CMZ : 2.00/02 03/07/98 19.30.30 by A.Rozanov *CMZ : 1.30/07 11/02/95 23.09.39 by A.Rozanov *CMZ : 1.30/01 16/01/95 23.19.33 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : *====================================================================* subroutine LTMAIN * calculation of the electroweak corrections for LEP * * with formulas from V.A.Novikov, L.B.Okun and M.I.Vysotsky * * ITEP, Moscow, Russia * * Author: A.Rozanov , rozanov@cernvm.cern.ch * *====================================================================* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. CALL LTTEST *-----initialisations CALL LTSTRT * CALL LTGLASGOW * CALL LTCHCK CALL LTBOOK PRTFLG(1)=-1. ! print in AFBBB PRTFLG(2)=-1. ! print in LTFMTH PRTFLG(3)=1. ! print result in LTFMTH PRTFLG(4)=1. ! print in INIT CALL LTINIT(0) * CALL LTISOLINE *-----fits * CALL LTFMTH(PIN,RPIN,POUT,EPOUT,CHIOUT) * CALL LBOTAB CALL DERTAB CALL MIVTAB ! TAble 26 of YR * CALL LTFOUR END *CMZ : 2.00/00 20/01/96 23.00.58 by A.Rozanov *CMZ : 1.30/07 19/02/95 19.39.18 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFPUT(TKEY,VKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTFPUT * * (module) * * * * Description : * * input of experimental data for LEPTOP fit * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTFPUT, LTFIT * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEND. CHARACTER*(*) TKEY, VKEY REAL*4 VALUE * LKT=LEN(TKEY) LKV=LEN(VKEY) * modify some constants IF(TKEY(1:LKT).eq.'VALUE')THEN CALL LTFPUV(VKEY,VALUE) ELSEIF(TKEY(1:LKT).eq.'ERROR')THEN CALL LTFPUE(VKEY,VALUE) ELSEIF(VKEY(1:LKV).EQ.'ALL')THEN * *------- print++++++++++++++++++++++++ IF(PRTFLG(8).NE.0)THEN WRITE(6,10010)TKEY(1:LKT) 10010 FORMAT(1x,'+LTFPUT: ',A20) ENDIF *--------+++++++++++++++++++++++++++++ CALL LTCONF(TKEY) ELSE write(6,*)'+LTFPUT: wrong keys: ', 1 TKEY(1:LKT),' ',VKEY(1:LKV),' ',VALUE ENDIF * * initialisation CALL LTINIT(1) END ! LTFPUT *CMZ : 2.00/02 03/07/98 19.29.55 by A.Rozanov *CMZ : 2.00/00 28/01/96 15.08.55 by A.Rozanov *CMZ : 1.30/07 18/02/95 01.02.09 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : *------------------------------------------------------------------- SUBROUTINE LTFITT(AMHNEW,ALBNEW,AMTFIT,ALSFIT,CERR,CHI2,NDF) *------------------------------------------------------------------- *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. EXTERNAL FCNLB CHARACTER*10 PNAM(3) PARAMETER (NPT=30) DIMENSION NPRM(3),VSTRT(3),STP(3),ARGLIS(6) * DIMENSION X(3),CH2(100,100),FLEPO(NL),AMTLEP(NL),EMTLEP(NL) * DIMENSION EMTPOS(NL),EMTNEG(NL) DIMENSION CERR(2,2) DATA NPRM/ 1 , 2 , 3 / DATA PNAM/'MT','ALS','MH'/ DATA VSTRT/150.D0,0.125D0,300.D0/ DATA STP/10.D0,0.01D0,10.D0/ *-----initialization-------------------------- OPEN(UNIT=19,STATUS='SCRATCH') CALL MNINIT(5,19,7) *-----switch off the output ARGLIS(1)=-1. CALL MNEXCM(FCNLB,'SET PRIntout',ARGLIS,1,IERFLG) *-----set Higgs mass ZERO=0.D0 VSTRT(3)=AMHNEW ALBOLD=ALBAR ALBAR=ALBNEW CALL LTINIT(1) CALL MNPARM(1,PNAM(1),VSTRT(1),STP(1),5.D0,1.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 1' ENDIF CALL MNPARM(2,PNAM(2),VSTRT(2),STP(2),0.D0,1.D0,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNPARM(3,PNAM(3),VSTRT(3),STP(3),5.D0,2.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNSETI('Fit mass of the top and strong coupling constant') ARGLIS(1)=1. CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) ARGLIS(1)=3. CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) *********************************************** * for gluon free fit * fix als * ARGLIS(1)=2. * CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) *********************************************** ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SET PRINT',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'MIGRAD',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'HES',ARGLIS,1,IERFLG) * ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SHOW ERR',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,0,IERFLG) *---------------------------------------------------------- if(prtflg(2).gt.0.)then CALL PRTERR endif CALL MNSTAT(CHI2,FEDM,ERRDEF,NPARI,NPARX,ISTAT) CALL MNPOUT(1,CHNAM,AMTFIT,AMTER,BND1,BND2,IVARBL) CALL MNERRS(1,AMTPL,AMTMI,AMTPAR,AMTGLB) CALL MNPOUT(2,CHNAM,ALSFIT,ALSER,BND1,BND2,IVARBL) CALL MNERRS(2,ALSPL,ALSMI,ALSPAR,ALSGLB) CALL MNEMAT(CERR,2) NDF=NPLEP-2 if(prtflg(2).gt.0.)then WRITE(6,10778)AMHNEW,CHI2 WRITE(6,10779)AMTFIT,AMTPL,AMTMI WRITE(6,10780)ALSFIT,ALSPL,ALSMI 10778 FORMAT(1X,'MHIGGS = ',F10.1,' CHI2= ',F10.1) 10779 FORMAT(1X,'MTOP = ',F10.1,' + ',F10.1,' ',F10.1) 10780 FORMAT(1X,'ALSB = ',F10.4,' + ',F10.4,' ',F10.4) endif ALBAR=ALBOLD CALL LTINIT(1) CLOSE(19) END *CMZ : 1.30/07 19/02/95 22.24.44 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFPUV(VKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTFPUV * * (module) * * * * Description : * * input of experimental data for LEPTOP fit * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTFPUT, LTFPUV * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. CHARACTER*(*) VKEY REAL*4 VALUE * LKV=LEN(VKEY) I=LTFIND(VKEY) * modify some constants IF(I.GE.2.AND.I.LE.NL)THEN VLEP(I)=DBLE7(VALUE) ELSE write(6,*)'+LFTPUV: wrong key: ', 1 VKEY(1:LKV),' ',VALUE ENDIF * * * print IF(PRTFLG(8).NE.0)THEN WRITE(6,10010)VKEY(1:LKV),DBLE7(VALUE) 10010 FORMAT(1x,'+LTFPUV: ',A20,' = ',D16.8) ENDIF END ! LTFPUV *CMZ : 1.30/07 19/02/95 18.24.18 by A.Rozanov *-- Author : A.Rozanov 18/02/95 DOUBLE PRECISION FUNCTION DBLE7(VALUE) * * *----------------------------------------------------------------------* * * * Name : DBLE7 * * * * * * Description : * * convert single to double precision with only 7 digits * * * * Arguments : * * VALUE in real*4 variable * * DBLE7 out real*8 variable * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 18/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * DBLE7 DBLE double precision conversion * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. C ----------- end CDE -------------------------------------------------- * * REAL*4 VALUE,VEXP if(value.ne.0.)then vexp=alog10(abs(value)) else vexp=0. endif ivexp=int(vexp) vfrac=dble(aint(value*10.**(7-ivexp))) DBLE7=vfrac*10.D0**(ivexp-7) END ! DBLE7 *CMZ : 1.30/07 19/02/95 18.34.51 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFPUE(VKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTFPUE * * (module) * * * * Description : * * input of errors of experimental data for LEPTOP fit * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTFPUT, LTFPUV * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. CHARACTER*(*) VKEY REAL*4 VALUE * LKV=LEN(VKEY) I=LTFIND(VKEY) * modify some constants IF(I.GE.1.AND.I.LE.NL)THEN ELEP(I)=DBLE7(VALUE) ELSE write(6,*)'+LFTPUE: wrong key: ', 1 VKEY(1:LKV),' ',VALUE ENDIF * * * print IF(PRTFLG(8).NE.0)THEN WRITE(6,10010)VKEY(1:LKV),DBLE7(VALUE) 10010 FORMAT(1x,'+LTFPUE: error on ',A20,' = ',D16.8) ENDIF END ! LTFPUE *CMZ : 1.30/07 19/02/95 19.25.07 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFCOR(KEY1,KEY2,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTFCOR * * (module) * * * * Description : * * input of error correlations for LEPTOP fit * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTFCOR * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. CHARACTER*(*) KEY1,KEY2 REAL*4 VALUE * LK1=LEN(KEY1) LK2=LEN(KEY2) I=LTFIND(KEY1) J=LTFIND(KEY2) IF(I.GE.1.AND.I.LE.NL.AND.J.GE.1.AND.J.LE.NL)THEN IF(I.NE.J.AND.ABS(VALUE).LE.1.)THEN RLEP(I,J)=DBLE7(VALUE) RLEP(J,I)=RLEP(I,J) ELSEIF(I.EQ.J.AND.VALUE.EQ.1.)THEN RLEP(I,I)=1.D0 ELSE write(6,*)'+LTFCOR: wrong value: ', 1 I,' ',KEY1(1:LK1),' ',J,' ',KEY2(1:LK2),' ',VALUE ENDIF ELSE write(6,*)'+LTFCOR: wrong keys: ', 1 KEY1(1:LK1),KEY2(1:LK2),' ',VALUE ENDIF * * * print IF(PRTFLG(8).NE.0)THEN WRITE(6,10010)KEY1(1:LK1),KEY2(1:LK2),DBLE7(VALUE) 10010 FORMAT(1x,'+LTFCOR: correlation ',2A10,' = ',D16.8) ENDIF END ! LTFCOR *CMZ : 15/04/99 22.26.58 by A.Rozanov *CMZ : 2.00/01 09/10/97 22.50.37 by A.Rozanov *CMZ : 2.00/00 26/01/96 09.10.11 by A.Rozanov *CMZ : 1.30/07 19/02/95 17.44.45 by A.Rozanov *-- Author : A.Rozanov 01/02/95 INTEGER FUNCTION LTFIND(KEY) * * *----------------------------------------------------------------------* * * * Name : LTFIND * * * * * * Description : * * find the index of the key in the fit array * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTFIND * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. CHARACTER*(*) KEY * LK=LEN(KEY) * IF(KEY(1:LK).eq.'MZ')THEN LTFIND=1 ELSEIF(KEY(1:LK).eq.'GZ')THEN LTFIND=2 ELSEIF(KEY(1:LK).eq.'SIGH')THEN LTFIND=3 ELSEIF(KEY(1:LK).eq.'RL')THEN LTFIND=4 ELSEIF(KEY(1:LK).eq.'AFBL')THEN LTFIND=5 ELSEIF(KEY(1:LK).eq.'RB')THEN LTFIND=6 ELSEIF(KEY(1:LK).eq.'MWMZ')THEN LTFIND=7 ELSEIF(KEY(1:LK).eq.'ATAU')THEN LTFIND=8 ELSEIF(KEY(1:LK).eq.'AETAU')THEN LTFIND=9 ELSEIF(KEY(1:LK).eq.'AFBB')THEN LTFIND=10 ELSEIF(KEY(1:LK).eq.'AFBC')THEN LTFIND=11 ELSEIF(KEY(1:LK).eq.'QFB')THEN LTFIND=12 ELSEIF(KEY(1:LK).eq.'S2NUN')THEN LTFIND=13 ELSEIF(KEY(1:LK).eq.'ALR')THEN LTFIND=14 ELSEIF(KEY(1:LK).eq.'MT')THEN LTFIND=15 ELSEIF(KEY(1:LK).eq.'GL')THEN LTFIND=16 ELSEIF(KEY(1:LK).eq.'RC')THEN LTFIND=17 ELSEIF(KEY(1:LK).eq.'RBSLC')THEN LTFIND=18 ELSEIF(KEY(1:LK).eq.'ABSLC')THEN LTFIND=19 ELSEIF(KEY(1:LK).eq.'ACSLC')THEN LTFIND=20 ELSEIF(KEY(1:LK).eq.'ALS')THEN LTFIND=21 ELSEIF(KEY(1:LK).eq.'ALB-1')THEN LTFIND=22 ELSEIF(KEY(1:LK).eq.'S2L')THEN LTFIND=23 ELSEIF(KEY(1:LK).eq.'GA')THEN LTFIND=24 ELSEIF(KEY(1:LK).eq.'MH')THEN LTFIND=25 ELSE LTFIND=0 write(6,*)'+LTFIND: wrong key: ', 1 KEY(1:LK) ENDIF * * END ! LTFIND *CMZ : 16/12/99 21.05.20 by A.Rozanov *CMZ : 2.00/03 08/09/98 22.12.46 by A.Rozanov *CMZ : 2.00/02 20/03/98 01.34.41 by A.Rozanov *CMZ : 2.00/01 19/03/98 01.29.40 by A.Rozanov *CMZ : 2.00/00 16/04/97 17.40.38 by A.Rozanov *CMZ : 2.00/03 26/10/95 12.02.45 by A.Rozanov *CMZ : 2.00/02 10/03/95 15.48.36 by A.Rozanov *CMZ : 1.30/07 19/02/95 19.34.35 by A.Rozanov *CMZ : 1.30/02 17/01/95 22.15.13 by A.Rozanov *CMZ : 1.30/01 16/01/95 21.17.17 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.46.25 by Rozanov Alexandre *-- Author : subroutine LTCONF(KEY) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONFER. LOGICAL MARSEILLE,MORIOND94,GLASGOW,MORIOND95,BEIJING95, 1 MORIOND96,MORIOND97,MORIALL97,JERUSALEM97,MORIOND98, 2 VANCOUVER98,EWWG99,LP99 COMMON/CONFER/MARSEILLE,MORIOND94,GLASGOW,MORIOND95,BEIJING95, 1 MORIOND96,MORIOND97,MORIALL97,JERUSALEM97,MORIOND98, 2 VANCOUVER98,EWWG99,LP99 *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. character*(*) KEY * LK=LEN(KEY) MARSEILLE=.false. MORIOND94=.false. GLASGOW=.false. MORIOND95=.false. BEIJING95=.false. MORIOND96=.false. MORIOND97=.false. MORIALL97=.false. JERUSALEM97=.false. MORIOND98=.false. VANCOUVER98=.false. EWWG99=.false. LP99=.false. IF(KEY(1:LK).EQ.'MARSEILLE')THEN MARSEILLE=.true. ELSEIF(KEY(1:LK).EQ.'MORIOND94')THEN MORIOND94=.true. ELSEIF(KEY(1:LK).EQ.'GLASGOW')THEN GLASGOW=.true. ELSEIF(KEY(1:LK).EQ.'MORIOND95')THEN MORIOND95=.true. ELSEIF(KEY(1:LK).EQ.'BEIJING95')THEN BEIJING95=.true. ELSEIF(KEY(1:LK).EQ.'MORIOND96')THEN MORIOND96=.true. ELSEIF(KEY(1:LK).EQ.'MORIOND97')THEN MORIOND97=.true. ELSEIF(KEY(1:LK).EQ.'MORIALL97')THEN MORIALL97=.true. ELSEIF(KEY(1:LK).EQ.'JERUSALEM97')THEN JERUSALEM97=.true. ELSEIF(KEY(1:LK).EQ.'MORIOND98')THEN MORIOND98=.true. ELSEIF(KEY(1:LK).EQ.'VANCOUVER98')THEN VANCOUVER98=.true. ELSEIF(KEY(1:LK).EQ.'EWWG99')THEN EWWG99=.true. ELSEIF(KEY(1:LK).EQ.'LP99')THEN LP99=.true. ELSE WRITE(6,*)'+LTCONF: unknown key ',KEY(1:LK) GO TO 99 ENDIF IF(PRTFLG(2).GT.0.)THEN WRITE(6,*)'LEPTOP DATA SET MARSEILLE: ',MARSEILLE 1 ,' MORIOND94: ',MORIOND94,' GLASGOW: ',GLASGOW 2 ,' MORIOND95: ',MORIOND95,' MORIOND96: ',MORIOND96 3 ,' MORIOND97: ',MORIOND97,' MORIALL97: ',MORIALL97 4 ,' JERUSALEM97: ',JERUSALEM97,' MORIOND98: ',MORIOND98 5 ,' VANCOUVER98: ',VANCOUVER98,'EWWG99 : ',EWWG99 6 ,' LP99: ',LP99 ENDIF NLEP=NL CALL VZERO(RLEP,NLEP*NLEP) DO 1 I=1,NLEP 1 RLEP(I,I)=1. *-----Monica PEPE-ALTARELLI * RLEP(1,2)=-0.15 * RLEP(1,3)= 0.02 * RLEP(1,4)= 0.01 * RLEP(1,5)= 0.07 * RLEP(1,6)= 0.00 * RLEP(2,3)=-0.14 * RLEP(2,4)= 0.01 * RLEP(2,5)= 0.07 * RLEP(2,6)= 0.00 * RLEP(3,4)= 0.13 * RLEP(3,5)= 0.00 * RLEP(3,6)= 0.00 * RLEP(4,5)= 0.01 * RLEP(4,6)= 0.00 * RLEP(5,6)= 0.00 *-----CERN/PPE/93-157 RLEP(1,2)=-0.157 RLEP(1,3)= 0.007 RLEP(1,4)= 0.012 RLEP(1,5)= 0.075 RLEP(1,6)= 0.000 RLEP(2,3)=-0.070 RLEP(2,4)= 0.003 RLEP(2,5)= 0.006 RLEP(2,6)= 0.000 RLEP(3,4)= 0.137 RLEP(3,5)= 0.003 RLEP(3,6)= 0.000 RLEP(4,5)= 0.008 RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 *-----A.Blondel CERN-PPE/94-133 RLEP(1,2)= 0.040 RLEP(1,3)= 0.010 RLEP(1,4)=-0.010 RLEP(1,5)= 0.040 RLEP(1,6)= 0.000 RLEP(2,3)=-0.110 RLEP(2,4)= 0.010 RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.130 RLEP(3,5)= 0.003 RLEP(3,6)= 0.000 RLEP(4,5)= 0.010 *-----D.Shaile Glasgow-94 private communiation RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.047 RLEP(6,11)=+0.082 RLEP(6,17)=-0.401 RLEP(10,11)=+0.084 RLEP(10,17)=+0.083 RLEP(11,17)=-0.107 *-----MZ * VLEP(1)=91.187D0 * ELEP(1)=0.007D0 * CHLEP(1)='MZ' *-----MONICA PEPE-ALRARELLI LaThuile-93 *-----GZ * VLEP(2)=2.488D0 * ELEP(2)=0.007D0 * CHLEP(2)='GZ' *-----SIGH * VLEP(3)=41.45D0 * ELEP(3)=0.17D0 * CHLEP(3)='SIGHAD' *-----RL * VLEP(4)=20.83D0 * ELEP(4)=0.06D0 * CHLEP(4)='RL' *-----AFB * VLEP(5)=0.0164D0 * ELEP(5)=0.0021D0 * CHLEP(5)='AFB lepton' *-----RB * VLEP(6)=0.2200D0 * ELEP(6)=0.0031D0 * CHLEP(6)='RBottom' *-----MW/MZ * VLEP(7)=0.8790D0 * ELEP(7)=0.0030D0 * CHLEP(7)='MW/MZ' *-----ATAU * VLEP(8)=0.142D0 * ELEP(8)=0.017D0 * CHLEP(8)='ATAU' *-----AETAU * VLEP(9)=0.130D0 * ELEP(9)=0.025D0 * CHLEP(9)='AETAU' *-----AFBBB *---- VLEP(10)=0.093D0 *---- ELEP(10)=0.008D0 * VLEP(10)=0.098D0 * ELEP(10)=0.009D0 * CHLEP(10)='AFBBB' *-----AFBCC * VLEP(11)=0.081D0 * ELEP(11)=0.018D0 * VLEP(11)=0.090D0 ** ELEP(11)=0.019D0 ** CHLEP(11)='AFBCC' **----QFB ** VLEP(12)=0.2320D0 * ELEP(12)=0.00156D0 * CHLEP(12)='QFB' *-----MARSEILLE EPS JULY 1993 DATA LEFRANCOIS *-----GZ * VLEP(2)=2.489D0 * ELEP(2)=0.007D0 * CHLEP(2)='GZ' *-----SIGH * VLEP(3)=41.55D0 * ELEP(3)=0.14D0 * CHLEP(3)='SIGHAD' *-----RL * VLEP(4)=20.77D0 * ELEP(4)=0.05D0 * CHLEP(4)='RL' *-----AFB * VLEP(5)=0.0161D0 * ELEP(5)=0.0019D0 * CHLEP(5)='AFB lepton' *-----RB * VLEP(6)=0.2200D0 * ELEP(6)=0.0027D0 * CHLEP(6)='RBottom' *-----MW/MZ * VLEP(7)=0.8790D0 * ELEP(7)=0.0030D0 * CHLEP(7)='MW/MZ' *-----ATAU * VLEP(8)=0.138D0 * ELEP(8)=0.014D0 * CHLEP(8)='ATAU' *-----AETAU * VLEP(9)=0.130D0 * ELEP(9)=0.025D0 * CHLEP(9)='AETAU' *-----AFBBB * VLEP(10)=0.098D0 * ELEP(10)=0.006D0 * CHLEP(10)='AFBBB' *-----AFBCC * VLEP(11)=0.075D0 * ELEP(11)=0.015D0 * CHLEP(11)='AFBCC' *-----QFB * VLEP(12)=0.2320D0 * ELEP(12)=0.00156D0 * CHLEP(12)='QFB' *-----sin2te * VLEP(12)=0.2322D0 * ELEP(12)=0.0006D0 * CHLEP(12)='sin2te' IF(MARSEILLE)THEN *-----MARSEILLE EPS JULY 1993 DATA CERN/PPE/93-157 *-----GZ VLEP(2)=2.489D0 ELEP(2)=0.007D0 CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.56D0 ELEP(3)=0.14D0 CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.763D0 ELEP(4)=0.049D0 CHLEP(4)='RL' *-----AFB VLEP(5)=0.0158D0 ELEP(5)=0.0018D0 CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.2200D0 ELEP(6)=0.0027D0 CHLEP(6)='RBottom' *-----MW/MZ *-----VLEP(7)=0.8790D0 *-----ELEP(7)=0.0030D0 VLEP(7)=0.8798D0 ! PDG fit 1992 ELEP(7)=0.0028D0 CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.139D0 ELEP(8)=0.014D0 CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.130D0 ELEP(9)=0.025D0 CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.099D0 ELEP(10)=0.006D0 CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.075D0 ELEP(11)=0.015D0 CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2320D0 ELEP(12)=0.00156D0 CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2256D0 ELEP(13)=0.0047D0 CHLEP(13)='NUN' *-----ALR VLEP(14)=0.1000D0 ELEP(14)=0.0440D0 CHLEP(14)='ALR' *-----MTOP FROM CDF VLEP(15)=174.00D0 ELEP(15)=16.000D0 CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083790D0 ELEP(16)=0.000280D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1583D0 ! ????? ELEP(17)=0.0300D0 ! ????? CHLEP(17)='Rc ' ENDIF ! marseille IF(MORIOND94)THEN *-----LATHUILE-MORIOND-94 data sheet *-----MZ VLEP(1)=91.1899D0 ELEP(1)=0.0044D0 CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4971D0 ELEP(2)=0.0038D0 CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.51D0 ELEP(3)=0.12D0 CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.79D0 ELEP(4)=0.04D0 CHLEP(4)='RL' *-----AFB VLEP(5)=0.0170D0 ELEP(5)=0.0016D0 CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.2210D0 ELEP(6)=0.0019D0 CHLEP(6)='RBottom' *-----MW/MZ *-----VLEP(7)=0.8790D0 *-----ELEP(7)=0.0030D0 VLEP(7)=0.8814D0 ! LATHUILE-94 ELEP(7)=0.0021D0 CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.150D0 ELEP(8)=0.010D0 CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.120D0 ELEP(9)=0.012D0 CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0970D0 ELEP(10)=0.0045D0 CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.072D0 ELEP(11)=0.011D0 CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2320D0 ELEP(12)=0.00156D0 CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2256D0 ELEP(13)=0.0047D0 CHLEP(13)='NUN' *-----ALR VLEP(14)=0.1668D0 ELEP(14)=0.0079D0 CHLEP(14)='ALR' *-----MTOP FROM CDF VLEP(15)=174.00D0 ELEP(15)=16.000D0 CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083980D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1583D0 ! ????? ELEP(17)=0.0300D0 ! ????? CHLEP(17)='Rc ' ENDIF ! moriond94 *-----Glasgo-94 Table-39 of preprint PPE/???-94 *-----MZ * VLEP(1)=91.1895D0 * ELEP(1)=0.0044D0 * CHLEP(1)='MZ' *-----GZ * VLEP(2)=2.4969D0 * ELEP(2)=0.0038D0 * CHLEP(2)='GZ' *-----SIGH * VLEP(3)=41.51D0 * ELEP(3)=0.12D0 * CHLEP(3)='SIGHAD' *-----RL * VLEP(4)=20.789D0 * ELEP(4)=0.04D0 * CHLEP(4)='RL' *-----AFB * VLEP(5)=0.0170D0 * ELEP(5)=0.0016D0 * CHLEP(5)='AFB lepton' *-----RB * VLEP(6)=0.2208D0 * ELEP(6)=0.0024D0 * CHLEP(6)='RBottom' *-----MW/MZ *-----VLEP(7)=0.8790D0 *-----ELEP(7)=0.0030D0 * VLEP(7)=0.8798D0 ! glasgo-94 * ELEP(7)=0.0021D0 * VLEP(7)=0.8803D0 ! gedungen Misha's experiment * ELEP(7)=0.0006D0 ! * CHLEP(7)='MW/MZ' *-----ATAU * VLEP(8)=0.150D0 * ELEP(8)=0.010D0 * CHLEP(8)='ATAU' *-----AETAU * VLEP(9)=0.120D0 * ELEP(9)=0.012D0 * CHLEP(9)='AETAU' *-----AFBBB * VLEP(10)=0.0960D0 * ELEP(10)=0.0043D0 * CHLEP(10)='AFBBB' *-----AFBCC * VLEP(11)=0.070D0 * ELEP(11)=0.011D0 * CHLEP(11)='AFBCC' *-----QFB * VLEP(12)=0.2320D0 * ELEP(12)=0.00156D0 * CHLEP(12)='QFB' *-----NUN * VLEP(13)=0.2256D0 * ELEP(13)=0.0047D0 * CHLEP(13)='NUN' *-----ALR * VLEP(14)=0.1637D0 ! glasgo 94 * ELEP(14)=0.0079D0 * CHLEP(14)='ALR' *-----Mtop from CDF * VLEP(15)=174.00D0 * ELEP(15)=16.000D0 * VLEP(15)=145.00D0 * VLEP(15)=190.00D0 * ELEP(15)= 5.000D0 * CHLEP(15)='Mtop' IF(GLASGOW)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 23.10.94 * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----Passarino of preprint July-94 HEP=ph/9407246 * latest D.S. before Glasgo 18.07.94 *-----MZ * VLEP(1)=91.1899 ! Passarino * VLEP(1)=91.1900 ! Passarino * VLEP(1)=91.1888D0 ! Shaile Glasgow VLEP(1)=91.1887D0 ! A.Blondel and e.w.calc. group ELEP(1)=0.0044D0 CHLEP(1)='MZ' *-----GZ * VLEP(2)=2.4971D0 ! Passarino VLEP(2)=2.4974D0 ELEP(2)=0.0038D0 CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.49D0 ELEP(3)=0.12D0 CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.795D0 ELEP(4)=0.04D0 CHLEP(4)='RL' *-----AFB VLEP(5)=0.0170D0 ELEP(5)=0.0016D0 CHLEP(5)='AFB lepton' *-----RB * VLEP(6)=0.2210D0 ! Passarino * ELEP(6)=0.0019D0 ! Passarino VLEP(6)=0.2202D0 ******VLEP(6)=0.2160D0 ! Standard model value ELEP(6)=0.0020D0 CHLEP(6)='RBottom' *-----MW/MZ *-----VLEP(7)=0.8790D0 *-----ELEP(7)=0.0030D0 * VLEP(7)=0.8814D0 ! Passarino VLEP(7)=0.8798D0 ! Shaile 80.23/91.1895 ELEP(7)=0.0021D0 * VLEP(7)=0.8803D0 ! gedungen Misha's experiment * ELEP(7)=0.0006D0 ! CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.143D0 ELEP(8)=0.010D0 CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.135D0 ELEP(9)=0.011D0 CHLEP(9)='AETAU' *-----AFBBB * VLEP(10)=0.0970D0 ! Passarino * ELEP(10)=0.0045D0 ! Passarino VLEP(10)=0.0967D0 ELEP(10)=0.0038D0 CHLEP(10)='AFBBB' *-----AFBCC * VLEP(11)=0.072D0 ! Passarino VLEP(11)=0.0760D0 ELEP(11)=0.0091D0 CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2320D0 ELEP(12)=0.00156D0 CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2256D0 ELEP(13)=0.0047D0 CHLEP(13)='NUN' *-----ALR * VLEP(14)=0.1668D0 ! Passarino VLEP(14)=0.1637D0 ! glasgo 94 ELEP(14)=0.0079D0 CHLEP(14)='ALR' *-----Mtop from CDF * VLEP(15)=190.00D0 * ELEP(15)= 5.000D0 VLEP(15)=174.00D0 * ELEP(15)=17.000D0 ! Passarino ELEP(15)=16.000D0 * VLEP(15)=145.00D0 * VLEP(15)=190.00D0 * ELEP(15)= 5.000D0 CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1583D0 ELEP(17)=0.0098D0 CHLEP(17)='Rc ' ENDIF ! glasgow IF(MORIOND95)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 09.03.95 * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really moriond95' VLEP(1)=91.1887D0 ELEP(1)=0.0022D0 CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4971D0 ELEP(2)=0.0033D0 CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.492D0 ELEP(3)=0.081D0 CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.800D0 ELEP(4)=0.035D0 CHLEP(4)='RL' *-----AFB VLEP(5)=0.0172D0 ELEP(5)=0.0013D0 CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.2204D0 ELEP(6)=0.0020D0 CHLEP(6)='RBottom' *-----MW/MZ VLEP(7)=0.8798D0 ELEP(7)=0.0021D0 CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.140D0 ELEP(8)=0.008D0 CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.137D0 ELEP(9)=0.009D0 CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.1015D0 ELEP(10)=0.0036D0 CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0760D0 ELEP(11)=0.0089D0 CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2320D0 ELEP(12)=0.00156D0 CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2253D0 ELEP(13)=0.0047D0 CHLEP(13)='NUN' *-----ALR VLEP(14)=0.1637D0 ELEP(14)=0.0079D0 CHLEP(14)='ALR' *-----Mtop from CDF VLEP(15)=174.00D0 ELEP(15)=16.000D0 CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1606D0 ELEP(17)=0.0095D0 CHLEP(17)='Rc ' *---- RLEP(1,2)=-0.007 RLEP(1,3)= 0.010 RLEP(1,4)= 0.010 RLEP(1,5)= 0.060 RLEP(1,6)= 0.000 RLEP(2,3)=-0.140 RLEP(2,4)= 0.000 RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.200 RLEP(3,5)= 0.010 RLEP(3,6)= 0.000 RLEP(4,5)= 0.000 *---- RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.006 RLEP(6,11)=+0.110 RLEP(6,17)=-0.356 RLEP(10,11)=+0.234 RLEP(10,17)=+0.064 RLEP(11,17)=-0.134 ENDIF ! moriond95 IF(BEIJING95)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 26.10.95 * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really beijing95' VLEP(1)=91.1884D0 ! new!!! ELEP(1)=0.0022D0 CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4963D0 ! new!!! ELEP(2)=0.0032D0 ! new!!! CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.488D0 ! new !!! ELEP(3)=0.078D0 ! new !!! CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.788D0 ! new!!! ELEP(4)=0.032D0 ! new !!! CHLEP(4)='RL' *-----AFB VLEP(5)=0.0172D0 ELEP(5)=0.0012D0 ! new!!! CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.2219D0 ! new !!! ELEP(6)=0.0017D0 ! new !!! CHLEP(6)='RBottom' *-----MW/MZ VLEP(7)=0.8802D0 ! new!!! ELEP(7)=0.0018D0 ! new!!! CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1418D0 ! new!!! ELEP(8)=0.0075D0 ! new!!! CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1390D0 ! new !!! ELEP(9)=0.0089D0 ! new !!! CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0999D0 ! new ELEP(10)=0.0031D0 ! new CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0725D0 ! new ELEP(11)=0.0058D0 ! new CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2325D0 ! new ELEP(12)=0.0013D0 ! new CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2257D0 ! new ELEP(13)=0.0047D0 CHLEP(13)='NUN' *-----ALR * s2alr = 0.23049 * es2alr= 0.00050 * gvgaalr=1.-4*s2alr * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.1551D0 ! new !!! ELEP(14)=0.0040D0 ! new !!! CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=180.00D0 ! new ELEP(15)=12.000D0 ! new CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1543D0 ! new ELEP(17)=0.0074D0 ! new CHLEP(17)='Rc ' *----SLC data added by A.R. 25.01.96 *-----Rb at SLC VLEP(18)=0.2171D0 ! new ELEP(18)=0.0054D0 ! new CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.841D0 ! new ELEP(19)=0.053D0 ! new CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.606D0 ! new ELEP(20)=0.090D0 ! new CHLEP(20)='AcSLC' *---- RLEP(1,2)=-0.007 RLEP(1,3)= 0.010 RLEP(1,4)= 0.010 RLEP(1,5)= 0.060 RLEP(1,6)= 0.000 RLEP(2,3)=-0.140 RLEP(2,4)= 0.000 RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.200 RLEP(3,5)= 0.010 RLEP(3,6)= 0.000 RLEP(4,5)= 0.000 *---- RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.006 RLEP(6,11)=+0.110 RLEP(6,17)=-0.356 RLEP(10,11)=+0.234 RLEP(10,17)=+0.064 RLEP(11,17)=-0.134 ENDIF ! beijing95 ************************************************************ IF(MORIOND96)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 08.06.96 * from CERN-PPE/95-172 and 96-017 * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really moriond96' VLEP(1)=91.1884D0 ! ELEP(1)=0.0022D0 CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4963D0 ! ELEP(2)=0.0032D0 ! CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.488D0 ! ELEP(3)=0.078D0 ! CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.788D0 ! ELEP(4)=0.032D0 ! CHLEP(4)='RL' *-----AFB VLEP(5)=0.0172D0 ELEP(5)=0.0012D0 ! CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.2209D0 ! new !!! ELEP(6)=0.0021D0 ! new !!! CHLEP(6)='RBottom' *-----MW/MZ VLEP(7)=0.8802D0 ! ELEP(7)=0.0018D0 ! CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1418D0 ! ELEP(8)=0.0075D0 ! CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1390D0 ! ELEP(9)=0.0089D0 ! CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.1014D0 ! new ELEP(10)=0.0046D0 ! new CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.079D0 ! new ELEP(11)=0.011D0 ! new CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2325D0 ! new ELEP(12)=0.0013D0 ! new CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2257D0 ! new ELEP(13)=0.0047D0 CHLEP(13)='NUN' *-----ALR * s2alr = 0.23049 * es2alr= 0.00050 * gvgaalr=1.-4*s2alr * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.1551D0 ! new !!! ELEP(14)=0.0040D0 ! new !!! CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=180.00D0 ! new ELEP(15)=12.000D0 ! new CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.158D0 ! new ELEP(17)=0.010D0 ! new CHLEP(17)='Rc ' *----SLC data added by A.R. 25.01.96 *-----Rb at SLC VLEP(18)=0.2171D0 ! new ELEP(18)=0.0054D0 ! new CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.841D0 ! new ELEP(19)=0.053D0 ! new CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.606D0 ! new ELEP(20)=0.090D0 ! new CHLEP(20)='AcSLC' *---- RLEP(1,2)=-0.08 ! MZ-GZ RLEP(1,3)= 0.02 ! MZ-SH RLEP(1,4)= 0.00 ! MZ-RL RLEP(1,5)= 0.08 ! MZ-AFB RLEP(1,6)= 0.000 RLEP(2,3)=-0.12 ! GZ-SH RLEP(2,4)=-0.01 ! GZ-RL RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.15 ! SH-RL RLEP(3,5)= 0.010 ! SH-AFB RLEP(3,6)= 0.000 RLEP(4,5)= 0.000 *---- * from CERN/PPE/96-017 8.02.96 "Combining Heavy Flavour ..." RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.05 ! Rb-AFBb RLEP(6,11)=+0.07 ! Rb-AFBc RLEP(6,17)=-0.39 ! Rb-Rc RLEP(10,11)=+0.19 ! AFBb-AFBc RLEP(10,17)=+0.16 ! AFBb-Rc RLEP(11,17)=-0.09 ! AFBc-Rc ENDIF ! moriond96 ************************************************************ IF(MORIOND97)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 16.04.97 * from LEPEWWG/97-01 7 April 1997 Internal Note * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really moriond97' VLEP(1)=91.1863D0 ! ELEP(1)=0.0019D0 CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4947D0 ! ELEP(2)=0.0026D0 ! CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.489D0 ! ELEP(3)=0.055D0 ! CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.783D0 ! ELEP(4)=0.029D0 ! CHLEP(4)='RL' *-----AFB VLEP(5)=0.0177D0 ELEP(5)=0.0010D0 ! CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.2179D0 ! new !!! ELEP(6)=0.0011D0 ! new !!! CHLEP(6)='RBottom' *-----MW/MZ VLEP(7)=0.8814D0 ! ELEP(7)=0.0009D0 ! CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1401D0 ! ELEP(8)=0.0067D0 ! CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1382D0 ! ELEP(9)=0.0076D0 ! CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0985D0 ! new ELEP(10)=0.0022D0 ! new CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0734D0 ! new ELEP(11)=0.0048D0 ! new CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2322D0 ! new ELEP(12)=0.0010D0 ! new CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2244D0 ! new ELEP(13)=0.0042D0 CHLEP(13)='NUN' *-----ALR * s2alr = 0.23049 * es2alr= 0.00050 * gvgaalr=1.-4*s2alr * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.15466D0 ! new !!! ELEP(14)=0.00328D0 ! new !!! CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=175.6D0 ! new ELEP(15)= 5.5D0 ! new CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1720D0 ! new ELEP(17)=0.0056D0 ! new CHLEP(17)='Rc ' *----SLC data *-----Rb at SLC VLEP(18)=0.2152D0 ! new ELEP(18)=0.0038D0 ! new CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.897D0 ! new ELEP(19)=0.047D0 ! new CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.623D0 ! new ELEP(20)=0.085D0 ! new CHLEP(20)='AcSLC' *-----als strong coupling world average VLEP(21)=0.118D0 ! new ELEP(21)=0.003D0 ! new CHLEP(21)='ALS' *-----albar=alpha(Mz) e.m. coupling world average VLEP(22)=1.D0/128.896 ! new ELEP(22)=VLEP(22)-1.D0/(1.D0/VLEP(22)+0.090) CHLEP(22)='ALS' *---- * from table 8 in LEPEWWG/97-01 RLEP(1,2)= 0.09 ! MZ-GZ RLEP(1,3)=-0.02 ! MZ-SH RLEP(1,4)=-0.02 ! MZ-RL RLEP(1,5)= 0.07 ! MZ-AFB RLEP(1,6)= 0.000 RLEP(2,3)=-0.15 ! GZ-SH RLEP(2,4)=-0.01 ! GZ-RL RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.12 ! SH-RL RLEP(3,5)= 0.00 ! SH-AFB RLEP(3,6)= 0.000 RLEP(4,5)= 0.01 ! RL-AFB *---- * from table 12 in LEPEWWG/97-01 RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.02 ! Rb-AFBb RLEP(6,11)=-0.02 ! Rb-AFBc RLEP(6,17)=-0.23 ! Rb-Rc RLEP(10,11)=+0.12 ! AFBb-AFBc RLEP(10,17)=+0.05 ! AFBb-Rc RLEP(11,17)=-0.07 ! AFBc-Rc ENDIF ! moriond97 ************************************************************ IF(MORIALL97)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 01.07.97 * from LEPEWWG/97-01 7 April 1997 Internal Note * with combined LEP SLD heavy flavour measurement in eq.10 table 13 * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really moriall97' VLEP(1)=91.1863D0 ! ELEP(1)=0.0019D0 CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4947D0 ! ELEP(2)=0.0026D0 ! CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.489D0 ! ELEP(3)=0.055D0 ! CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.783D0 ! ELEP(4)=0.029D0 ! CHLEP(4)='RL' *-----AFB VLEP(5)=0.0177D0 ELEP(5)=0.0010D0 ! CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.2177D0 ! combined LEP+SLD !!! ELEP(6)=0.0011D0 ! CHLEP(6)='RBottom' *-----MW/MZ VLEP(7)=0.8814D0 ! ELEP(7)=0.0009D0 ! CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1401D0 ! ELEP(8)=0.0067D0 ! CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1382D0 ! ELEP(9)=0.0076D0 ! CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0985D0 ! ELEP(10)=0.0022D0 ! CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0734D0 ! ELEP(11)=0.0048D0 ! CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2322D0 ! ELEP(12)=0.0010D0 ! CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2244D0 ! ELEP(13)=0.0042D0 CHLEP(13)='NUN' *-----ALR * s2alr = 0.23055 * es2alr= 0.00041 * gvgaalr=1.-4*s2alr * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.15466D0 ! ELEP(14)=0.00328D0 ! CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=175.6D0 ! ELEP(15)= 5.5D0 ! CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1722D0 ! combined LEP+SLD ELEP(17)=0.0053D0 ! combined LEP+SLD CHLEP(17)='Rc ' *----SLC data *-----Rb at SLC VLEP(18)=0.2152D0 ! should not be used in moriall97 ELEP(18)=0.0038D0 ! CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.897D0 ! ELEP(19)=0.047D0 ! CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.623D0 ! ELEP(20)=0.085D0 ! CHLEP(20)='AcSLC' *-----als strong coupling world average VLEP(21)=0.118D0 ! ELEP(21)=0.003D0 ! CHLEP(21)='ALS' *-----albar^-1=alpha(Mz)^-1 e.m. coupling world average VLEP(22)=128.896D0 ELEP(22)=0.090D0 CHLEP(22)='ALB-1' *---- * from table 8 in LEPEWWG/97-01 RLEP(1,2)= 0.09 ! MZ-GZ RLEP(1,3)=-0.02 ! MZ-SH RLEP(1,4)=-0.02 ! MZ-RL RLEP(1,5)= 0.07 ! MZ-AFB RLEP(1,6)= 0.000 RLEP(2,3)=-0.15 ! GZ-SH RLEP(2,4)=-0.01 ! GZ-RL RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.12 ! SH-RL RLEP(3,5)= 0.00 ! SH-AFB RLEP(3,6)= 0.000 RLEP(4,5)= 0.01 ! RL-AFB * from table 13 in LEPEWWG/97-01 RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.01 ! Rb-AFBb combined LEP+SLD RLEP(6,11)=-0.02 ! Rb-AFBc RLEP(6,17)=-0.23 ! Rb-Rc RLEP(10,11)=+0.12 ! AFBb-AFBc RLEP(10,17)=+0.05 ! AFBb-Rc RLEP(11,17)=-0.06 ! AFBc-Rc combined LEP+SLD RLEP(6,19)=-0.03 ! Rb-Ab combined LEP+SLD RLEP(6,20)=0.01 ! Rb-Ac combined LEP+SLD RLEP(17,19)=0.05 ! Rc-Ab combined LEP+SLD RLEP(17,20)=-0.05 ! Rc-Ac combined LEP+SLD RLEP(10,19)=0.04 ! AFBb-Ab combined LEP+SLD RLEP(10,20)=0.02 ! AFBb-Ac combined LEP+SLD RLEP(11,19)=0.01 ! AFBc-Ab combined LEP+SLD RLEP(11,20)=0.10 ! AFBc-Ac combined LEP+SLD RLEP(19,20)=0.12 ! Ab-Ac SLD ENDIF ! moriall97 ************************************************************ IF(JERUSALEM97)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 16.09.97 * from David Ward talk at EPS Jerusalem conference * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really jerusalem97' VLEP(1)=91.1867D0 ! ELEP(1)=0.0020D0 CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4948D0 ! ELEP(2)=0.0025D0 ! CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.486D0 ! ELEP(3)=0.053D0 ! CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.775D0 ! ELEP(4)=0.027D0 ! CHLEP(4)='RL' *-----AFB VLEP(5)=0.0171D0 ELEP(5)=0.0010D0 ! CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.2170D0 ! combined LEP+SLD !!! ELEP(6)=0.0009D0 ! CHLEP(6)='RBottom' *-----MW/MZ 80.43(8)/91.1867(20) VLEP(7)=0.88204D0 ! ELEP(7)=0.00088D0 ! CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1411D0 ! ELEP(8)=0.0064D0 ! CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1399D0 ! ELEP(9)=0.0073D0 ! CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0984D0 ! ELEP(10)=0.0024D0 ! CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0741D0 ! ELEP(11)=0.0048D0 ! CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2322D0 ! ELEP(12)=0.0010D0 ! CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2254D0 ! ELEP(13)=0.0037D0 CHLEP(13)='NUN' *-----ALR * s2alr = 0.23055 * es2alr= 0.00041 * gvgaalr=1.-4*s2alr * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.15466D0 ! ELEP(14)=0.00328D0 ! CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=175.6D0 ! ELEP(15)= 5.5D0 ! CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1734D0 ! combined LEP+SLD ELEP(17)=0.0048D0 ! combined LEP+SLD CHLEP(17)='Rc ' *----SLC data *-----Rb at SLC VLEP(18)=0.2152D0 ! should not be used in moriall97 ELEP(18)=0.0038D0 ! CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.900D0 ! ELEP(19)=0.050D0 ! CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.650D0 ! ELEP(20)=0.058D0 ! CHLEP(20)='AcSLC' *-----als strong coupling world average VLEP(21)=0.118D0 ! ELEP(21)=0.003D0 ! CHLEP(21)='ALS' *-----albar^-1=alpha(Mz)^-1 e.m. coupling world average VLEP(22)=128.896D0 ELEP(22)=0.090D0 CHLEP(22)='ALB-1' *---- * from table 8 in LEPEWWG/97-01 RLEP(1,2)= 0.09 ! MZ-GZ RLEP(1,3)=-0.02 ! MZ-SH RLEP(1,4)=-0.02 ! MZ-RL RLEP(1,5)= 0.07 ! MZ-AFB RLEP(1,6)= 0.000 RLEP(2,3)=-0.15 ! GZ-SH RLEP(2,4)=-0.01 ! GZ-RL RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.12 ! SH-RL RLEP(3,5)= 0.00 ! SH-AFB RLEP(3,6)= 0.000 RLEP(4,5)= 0.01 ! RL-AFB * from table 13 in LEPEWWG/97-01 RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.01 ! Rb-AFBb combined LEP+SLD RLEP(6,11)=-0.02 ! Rb-AFBc RLEP(6,17)=-0.23 ! Rb-Rc RLEP(10,11)=+0.12 ! AFBb-AFBc RLEP(10,17)=+0.05 ! AFBb-Rc RLEP(11,17)=-0.06 ! AFBc-Rc combined LEP+SLD RLEP(6,19)=-0.03 ! Rb-Ab combined LEP+SLD RLEP(6,20)=0.01 ! Rb-Ac combined LEP+SLD RLEP(17,19)=0.05 ! Rc-Ab combined LEP+SLD RLEP(17,20)=-0.05 ! Rc-Ac combined LEP+SLD RLEP(10,19)=0.04 ! AFBb-Ab combined LEP+SLD RLEP(10,20)=0.02 ! AFBb-Ac combined LEP+SLD RLEP(11,19)=0.01 ! AFBc-Ab combined LEP+SLD RLEP(11,20)=0.10 ! AFBc-Ac combined LEP+SLD RLEP(19,20)=0.12 ! Ab-Ac SLD ENDIF ! jerusalem97 ************************************************************ IF(MORIOND98)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 17.03.98 * from plot on EWWG WWW page * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really moriond98' VLEP(1)=91.1867D0 ! ELEP(1)=0.0020D0 CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4948D0 ! ELEP(2)=0.0025D0 ! CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.486D0 ! ELEP(3)=0.053D0 ! CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.775D0 ! ELEP(4)=0.027D0 ! CHLEP(4)='RL' *-----AFB VLEP(5)=0.0171D0 ELEP(5)=0.0010D0 ! CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.21736D0 ! combined LEP+SLD new !!! 0.21720 ??? ELEP(6)=0.00086D0 ! new !!! 0.00089 ??? CHLEP(6)='RBottom' *-----MW/MZ 80.375(64)/91.1867(20) new VLEP(7)=0.88143D0 ! new ELEP(7)=0.00070D0 ! new CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1400D0 ! new ELEP(8)=0.0063D0 ! new CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1438D0 ! new ELEP(9)=0.0071D0 ! new CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0998D0 ! new 0.09997 ?? ELEP(10)=0.0022D0 ! new CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0735D0 ! new 0.0734 ?? ELEP(11)=0.0045D0 ! new CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2321D0 ! new ELEP(12)=0.0010D0 ! CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2254D0 ! ELEP(13)=0.0037D0 CHLEP(13)='NUN' *-----ALR * s2alr = 0.23084 new !!!! * es2alr= 0.00035 new !!!! * gvgaalr=1.-4*s2alr 0.07664 * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.1523849D0 ! new ELEP(14)=0.0028D0 ! new CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=173.5D0 ! new ELEP(15)= 5.2D0 ! new CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ELEP(16)=0.000180D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1731D0 ! combined LEP+SLD new !!! ELEP(17)=0.0044D0 ! combined LEP+SLD new !!! CHLEP(17)='Rc ' *----SLC data *-----Rb at SLC VLEP(18)=0.2152D0 ! should not be used in moriond98 ELEP(18)=0.0038D0 ! CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.901D0 ! new ELEP(19)=0.049D0 ! new CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.643D0 ! new ELEP(20)=0.049D0 ! new CHLEP(20)='AcSLC' *-----als strong coupling world average VLEP(21)=0.118D0 ! ELEP(21)=0.003D0 ! CHLEP(21)='ALS' *-----albar^-1=alpha(Mz)^-1 e.m. coupling world average * VLEP(22)=128.896D0 * ELEP(22)=0.090D0 VLEP(22)=128.923D0 ELEP(22)=0.036D0 CHLEP(22)='ALB-1' *---- * from table 8 in LEPEWWG/97-01 RLEP(1,2)= 0.09 ! MZ-GZ RLEP(1,3)=-0.02 ! MZ-SH RLEP(1,4)=-0.02 ! MZ-RL RLEP(1,5)= 0.07 ! MZ-AFB RLEP(1,6)= 0.000 RLEP(2,3)=-0.15 ! GZ-SH RLEP(2,4)=-0.01 ! GZ-RL RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.12 ! SH-RL RLEP(3,5)= 0.00 ! SH-AFB RLEP(3,6)= 0.000 RLEP(4,5)= 0.01 ! RL-AFB * from table 13 in LEPEWWG/97-01 RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.01 ! Rb-AFBb combined LEP+SLD RLEP(6,11)=-0.02 ! Rb-AFBc RLEP(6,17)=-0.23 ! Rb-Rc RLEP(10,11)=+0.12 ! AFBb-AFBc RLEP(10,17)=+0.05 ! AFBb-Rc RLEP(11,17)=-0.06 ! AFBc-Rc combined LEP+SLD RLEP(6,19)=-0.03 ! Rb-Ab combined LEP+SLD RLEP(6,20)=0.01 ! Rb-Ac combined LEP+SLD RLEP(17,19)=0.05 ! Rc-Ab combined LEP+SLD RLEP(17,20)=-0.05 ! Rc-Ac combined LEP+SLD RLEP(10,19)=0.04 ! AFBb-Ab combined LEP+SLD RLEP(10,20)=0.02 ! AFBb-Ac combined LEP+SLD RLEP(11,19)=0.01 ! AFBc-Ab combined LEP+SLD RLEP(11,20)=0.10 ! AFBc-Ac combined LEP+SLD RLEP(19,20)=0.12 ! Ab-Ac SLD ENDIF ! moriond98 *---- ************************************************************ IF(VANCOUVER98)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 09.09.98 * from plot on Dean Karlen trans. on Vancouver conf. * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really vancouver98' VLEP(1)=91.1867D0 ! ELEP(1)=0.0021D0 ! new CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4939D0 ! new ELEP(2)=0.0024D0 ! new CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.491D0 ! new ELEP(3)=0.058D0 ! new CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.765D0 ! new ELEP(4)=0.026D0 ! new CHLEP(4)='RL' *-----AFB VLEP(5)=0.01683D0 ! new ELEP(5)=0.00096D0 ! new CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.21656D0 ! new ELEP(6)=0.00074D0 ! new CHLEP(6)='RBottom' *-----MW/MZ (80.370(90)+80.410(90))=80.390(64)/91.1867(21) new VLEP(7)=0.88160D0 ! new ELEP(7)=0.00070D0 ! new CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1431D0 ! new ELEP(8)=0.0045D0 ! new CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1479D0 ! new ELEP(9)=0.0051D0 ! new CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0991D0 ! new ELEP(10)=0.0021D0 ! new CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0714D0 ! new ELEP(11)=0.0044D0 ! new CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2321D0 ! ELEP(12)=0.0010D0 ! CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2255D0 ! new ELEP(13)=0.0021D0 ! new CHLEP(13)='NUN' *-----ALR * s2alr = 0.23101 new * es2alr= 0.00031 new * gvgaalr=1.-4*s2alr 0.07596 * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.151048D0 ! new ELEP(14)=0.002480D0 ! new CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=173.8D0 ! new ELEP(15)= 5.0D0 ! new CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083900D0 ELEP(16)=0.000100D0 CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1733D0 ! new ELEP(17)=0.0044D0 ! CHLEP(17)='Rc ' *----SLC data *-----Rb at SLC VLEP(18)=0.2152D0 ! should not be used in vancouver98 ELEP(18)=0.0038D0 ! CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.856D0 ! new ELEP(19)=0.036D0 ! new CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.638D0 ! new ELEP(20)=0.040D0 ! new CHLEP(20)='AcSLC' *-----als strong coupling world average VLEP(21)=0.118D0 ! ELEP(21)=0.003D0 ! CHLEP(21)='ALS' *-----albar^-1=alpha(Mz)^-1 e.m. coupling world average VLEP(22)=128.896D0 ! Eidelman-Jegerlehner ELEP(22)=0.090D0 ! Eidelman-Jegerlehner * VLEP(22)=128.923D0 ! Davier-Hocker * ELEP(22)=0.036D0 ! Davier-Hocker CHLEP(22)='ALB-1' *---- * from table 8 in LEPEWWG/97-01 RLEP(1,2)= 0.09 ! MZ-GZ RLEP(1,3)=-0.02 ! MZ-SH RLEP(1,4)=-0.02 ! MZ-RL RLEP(1,5)= 0.07 ! MZ-AFB RLEP(1,6)= 0.000 RLEP(2,3)=-0.15 ! GZ-SH RLEP(2,4)=-0.01 ! GZ-RL RLEP(2,5)= 0.000 RLEP(2,6)= 0.000 RLEP(3,4)= 0.12 ! SH-RL RLEP(3,5)= 0.00 ! SH-AFB RLEP(3,6)= 0.000 RLEP(4,5)= 0.01 ! RL-AFB * from table 13 in LEPEWWG/97-01 RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.01 ! Rb-AFBb combined LEP+SLD RLEP(6,11)=-0.02 ! Rb-AFBc RLEP(6,17)=-0.23 ! Rb-Rc RLEP(10,11)=+0.12 ! AFBb-AFBc RLEP(10,17)=+0.05 ! AFBb-Rc RLEP(11,17)=-0.06 ! AFBc-Rc combined LEP+SLD RLEP(6,19)=-0.03 ! Rb-Ab combined LEP+SLD RLEP(6,20)=0.01 ! Rb-Ac combined LEP+SLD RLEP(17,19)=0.05 ! Rc-Ab combined LEP+SLD RLEP(17,20)=-0.05 ! Rc-Ac combined LEP+SLD RLEP(10,19)=0.04 ! AFBb-Ab combined LEP+SLD RLEP(10,20)=0.02 ! AFBb-Ac combined LEP+SLD RLEP(11,19)=0.01 ! AFBc-Ab combined LEP+SLD RLEP(11,20)=0.10 ! AFBc-Ac combined LEP+SLD RLEP(19,20)=0.12 ! Ab-Ac SLD ENDIF ! vancouver98 ************************************************************ IF(EWWG99)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 09.01.99 * from draft CERN-EP/99-xxx xx Jan 1999 * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really EWWG 99' VLEP(1)=91.1867D0 ! ELEP(1)=0.0021D0 ! CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4939D0 ! ELEP(2)=0.0024D0 ! CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.491D0 ! ELEP(3)=0.058D0 ! CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.765D0 ! ELEP(4)=0.026D0 ! CHLEP(4)='RL' *-----AFB VLEP(5)=0.01683D0 ! ELEP(5)=0.00096D0 ! CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.21656D0 ! ELEP(6)=0.00074D0 ! CHLEP(6)='RBottom' *-----MW/MZ (80.370(90)+80.410(90))=80.390(64)/91.1867(21) VLEP(7)=0.88160D0 ! ELEP(7)=0.00070D0 ! CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1431D0 ! ELEP(8)=0.0045D0 ! CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1479D0 ! ELEP(9)=0.0051D0 ! CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0990D0 ! new ELEP(10)=0.0021D0 ! CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0709D0 ! new ELEP(11)=0.0044D0 ! CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2321D0 ! ELEP(12)=0.0010D0 ! CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2254D0 ! new ELEP(13)=0.0021D0 ! CHLEP(13)='NUN' *-----ALR * s2alr = 0.23109 new * es2alr= 0.00029 new * gvgaalr=1.-4*s2alr 0.07564 * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.150419D0 ! new ELEP(14)=0.002320D0 ! new CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=173.8D0 ! ELEP(15)= 5.0D0 ! CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083900D0 ! new ELEP(16)=0.000100D0 ! new CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1735D0 ! new ELEP(17)=0.0044D0 ! CHLEP(17)='Rc ' *----SLC data *-----Rb at SLC VLEP(18)=0.2152D0 ! should not be used in vancouver98 ELEP(18)=0.0038D0 ! CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.867D0 ! new ELEP(19)=0.035D0 ! CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.647D0 ! new ELEP(20)=0.040D0 ! CHLEP(20)='AcSLC' *-----als strong coupling world average PDG-98 page95 VLEP(21)=0.1178D0 ! ELEP(21)=0.0023D0 ! CHLEP(21)='ALS' *-----albar^-1=alpha(Mz)^-1 e.m. coupling world average VLEP(22)=128.878D0 ! new ELEP(22)=0.090D0 ! Eidelman-Jegerlehner * VLEP(22)=128.923D0 ! Davier-Hocker * ELEP(22)=0.036D0 ! Davier-Hocker CHLEP(22)='ALB-1' *-----s2l - effective sin2thetal from Table 30 of EWWG-99 VLEP(23)=0.23157D0 ! last line, column 3 ELEP(23)=0.00018D0 ! CHLEP(23)='S2L' *-----ga - gAl with lepton universality LEP+SLD Table 29 EWWG-99 VLEP(24)=-0.50102D0 ! ELEP(24)= 0.00030D0 ! CHLEP(24)='GA' *-----low direct limit on mH dmh=1.5 ! Fig.1-D of 183 GeV 55pb-1 draft VLEP(25)= 90.D0 + 1.64*dmh ! upper lim. at 95 % CL + 1.64sigma ELEP(25)= dmh ! CHLEP(25)='MH' *---- * from table 8 in LEPEWWG/99-01 RLEP(1,2)= 0.00 ! MZ-GZ new RLEP(1,3)=-0.04 ! MZ-SH new RLEP(1,4)=-0.01 ! MZ-RL new RLEP(1,5)= 0.062 ! MZ-AFB new RLEP(1,6)= 0.000 RLEP(2,3)=-0.184 ! GZ-SH new RLEP(2,4)= 0.002 ! GZ-RL new RLEP(2,5)= 0.004 ! GZ-AFB new RLEP(2,6)= 0.000 RLEP(3,4)= 0.123 ! SH-RL new RLEP(3,5)= 0.006 ! SH-AFB new RLEP(3,6)= 0.000 RLEP(4,5)=-0.072 ! RL-AFB new * from table 18 in LEPEWWG/99-01 RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.06 ! Rb-AFBb combined LEP+SLD new RLEP(6,11)= 0.02 ! Rb-AFBc new RLEP(6,17)=-0.17 ! Rb-Rc new RLEP(6,19)=-0.02 ! Rb-Ab combined LEP+SLD new RLEP(6,20)=0.02 ! Rb-Ac combined LEP+SLD new RLEP(10,11)=+0.13 ! AFBb-AFBc new RLEP(10,17)=+0.05 ! AFBb-Rc RLEP(10,19)=0.03 ! AFBb-Ab combined LEP+SLD new RLEP(10,20)=0.02 ! AFBb-Ac combined LEP+SLD new RLEP(11,17)=-0.04 ! AFBc-Rc combined LEP+SLD new RLEP(11,19)=-0.01 ! AFBc-Ab combined LEP+SLD new RLEP(11,20)=0.07 ! AFBc-Ac combined LEP+SLD new RLEP(17,19)=0.01 ! Rc-Ab combined LEP+SLD new RLEP(17,20)=-0.04 ! Rc-Ac combined LEP+SLD new RLEP(19,20)=0.04 ! Ab-Ac SLD new ENDIF ! ewwg99 ************************************************************ IF(LP99)THEN * Experimental values used by LEPTOP in the fit * A.Rozanov 16.12.99 * from Lepton-Photon Conference Stanforg * talk Morris SWARTZ 10.08.1999 morris@jhu.edu * VLEP(i) - experimental value * ELEP(i) - experimental error * CHLEP(i) - characher name of the experimental value * RLEP(i,i) - error correlation matrix * FLEP(i) = 1. used in the fit * =-1. not used in the fit *-----MZ write(6,*)'really LP 99' VLEP(1)=91.1871D0 ! new ELEP(1)=0.0021D0 ! CHLEP(1)='MZ' *-----GZ VLEP(2)=2.4944D0 ! new ELEP(2)=0.0024D0 ! CHLEP(2)='GZ' *-----SIGH VLEP(3)=41.544D0 ! new ELEP(3)=0.037D0 ! new CHLEP(3)='SIGHAD' *-----RL VLEP(4)=20.768D0 ! new ELEP(4)=0.024D0 ! new CHLEP(4)='RL' *-----AFB VLEP(5)=0.01701D0 ! new ELEP(5)=0.00095D0 ! new CHLEP(5)='AFB lepton' *-----RB VLEP(6)=0.21642D0 ! new ELEP(6)=0.00073D0 ! new CHLEP(6)='RBottom' *-----MW/MZ (80.370(90)+80.410(90))=80.390(64)/91.1867(21) VLEP(7)=0.88160D0 ! not checked ELEP(7)=0.00070D0 ! not checked CHLEP(7)='MW/MZ' *-----ATAU VLEP(8)=0.1429D0 ! new ELEP(8)=0.0043D0 ! new CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1510D0 ! new ELEP(9)=0.0021D0 ! new CHLEP(9)='AETAU' *-----AFBBB VLEP(10)=0.0988D0 ! new ELEP(10)=0.0020D0 ! new CHLEP(10)='AFBBB' *-----AFBCC VLEP(11)=0.0692D0 ! new ELEP(11)=0.0037D0 ! new CHLEP(11)='AFBCC' *-----QFB VLEP(12)=0.2321D0 ! not checked ELEP(12)=0.0010D0 ! not checked CHLEP(12)='QFB' *-----NUN VLEP(13)=0.2254D0 ! not checked ELEP(13)=0.0021D0 ! not checked CHLEP(13)='NUN' *-----ALR * s2alr = 0.23101 new * es2alr= 0.00028 new * gvgaalr=1.-4*s2alr 0.07596 * alr=2*gvgaalr/(1+gvgaalr**2) * ealr=8*es2alr VLEP(14)=0.15108D0 ! new direct ELEP(14)=0.00218D0 ! new direct CHLEP(14)='ALR' *-----Mtop from CDF and D0 VLEP(15)=174.3D0 ! new ELEP(15)= 5.1D0 ! new CHLEP(15)='Mtop' *-----Glepton VLEP(16)=0.083960D0 ! new ELEP(16)=0.000090D0 ! new CHLEP(16)='Glep' *-----Rc VLEP(17)=0.1674D0 ! new ELEP(17)=0.0038D0 ! new CHLEP(17)='Rc ' *----SLC data *-----Rb at SLC VLEP(18)=0.21594D0 ! should not be used in LP99 ELEP(18)=0.00197D0 ! CHLEP(18)='RbSLC' *-----Ab at SLC VLEP(19)=0.905D0 ! new ELEP(19)=0.026D0 ! new CHLEP(19)='AbSLC' *-----Ac at SLC VLEP(20)=0.634D0 ! new ELEP(20)=0.027D0 ! new CHLEP(20)='AcSLC' *-----als strong coupling world average PDG-98 page95 VLEP(21)=0.1178D0 ! not checked ELEP(21)=0.0023D0 ! not checked CHLEP(21)='ALS' *-----albar^-1=alpha(Mz)^-1 e.m. coupling world average VLEP(22)=128.878D0 ! not checked ELEP(22)=0.090D0 ! Eidelman-Jegerlehner not checked * VLEP(22)=128.923D0 ! Davier-Hocker * ELEP(22)=0.036D0 ! Davier-Hocker CHLEP(22)='ALB-1' *-----s2l - effective sin2thetal from Table 30 of EWWG-99 VLEP(23)=0.23157D0 ! last line, column 3 not checked ELEP(23)=0.00018D0 ! not checked CHLEP(23)='S2L' *-----ga - gAl with lepton universality LEP+SLD Table 29 EWWG-99 VLEP(24)=-0.50102D0 ! not checked ELEP(24)= 0.00030D0 ! not checked CHLEP(24)='GA' *-----low direct limit on mH --- not checked dmh=1.5 ! Fig.1-D of 183 GeV 55pb-1 draft VLEP(25)= 90.D0 + 1.64*dmh ! upper lim. at 95 % CL + 1.64sigma ELEP(25)= dmh ! CHLEP(25)='MH' *---- * from table 8 in LEPEWWG/99-01 RLEP(1,2)= 0.00 ! MZ-GZ new RLEP(1,3)=-0.04 ! MZ-SH new RLEP(1,4)=-0.01 ! MZ-RL new RLEP(1,5)= 0.062 ! MZ-AFB new RLEP(1,6)= 0.000 RLEP(2,3)=-0.184 ! GZ-SH new RLEP(2,4)= 0.002 ! GZ-RL new RLEP(2,5)= 0.004 ! GZ-AFB new RLEP(2,6)= 0.000 RLEP(3,4)= 0.123 ! SH-RL new RLEP(3,5)= 0.006 ! SH-AFB new RLEP(3,6)= 0.000 RLEP(4,5)=-0.072 ! RL-AFB new * from table 18 in LEPEWWG/99-01 RLEP(4,6)= 0.00 RLEP(5,6)= 0.00 RLEP(6,10)=-0.06 ! Rb-AFBb combined LEP+SLD new RLEP(6,11)= 0.02 ! Rb-AFBc new RLEP(6,17)=-0.17 ! Rb-Rc new RLEP(6,19)=-0.02 ! Rb-Ab combined LEP+SLD new RLEP(6,20)=0.02 ! Rb-Ac combined LEP+SLD new RLEP(10,11)=+0.13 ! AFBb-AFBc new RLEP(10,17)=+0.05 ! AFBb-Rc RLEP(10,19)=0.03 ! AFBb-Ab combined LEP+SLD new RLEP(10,20)=0.02 ! AFBb-Ac combined LEP+SLD new RLEP(11,17)=-0.04 ! AFBc-Rc combined LEP+SLD new RLEP(11,19)=-0.01 ! AFBc-Ab combined LEP+SLD new RLEP(11,20)=0.07 ! AFBc-Ac combined LEP+SLD new RLEP(17,19)=0.01 ! Rc-Ab combined LEP+SLD new RLEP(17,20)=-0.04 ! Rc-Ac combined LEP+SLD new RLEP(19,20)=0.04 ! Ab-Ac SLD new ENDIF ! LP99 DO 2 I=1,NLEP DO 2 J=I,NLEP RLEP(J,I)=RLEP(I,J) 2 CONTINUE 99 CONTINUE END ! LTCONF *CMZ : 1.30/07 19/02/95 22.33.35 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFUSE(KEY1,KEY2) * * *----------------------------------------------------------------------* * * * Name : LTFUSE * * (module) * * * * Description : * * input of use flags for LEPTOP fit * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTFCOR * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. CHARACTER*(*) KEY1,KEY2 * LK1=LEN(KEY1) LK2=LEN(KEY2) IF(KEY1(1:LK1).EQ.'USE')THEN FLAG=1. ELSEIF(KEY1(1:LK1).EQ.'NOUSE')THEN FLAG=-1. ELSE FLAG=0. WRITE(6,*)'+LTFUSE: wrong key ',KEY1(1:LK1) GO TO 99 ENDIF IF(KEY2(1:LK2).EQ.'ALL')THEN DO I=1,NL FLEP(I)=FLAG ENDDO ELSE J=LTFIND(KEY2) IF(J.GE.2.AND.J.LE.NL)THEN FLEP(J)=FLAG ELSE WRITE(6,*)'+LTFUSE: wrong key ',KEY2(1:LK2) GO TO 99 ENDIF ! check of J ENDIF ! check of ALL * * * print IF(PRTFLG(8).NE.0)THEN WRITE(6,10010)KEY1(1:LK1),KEY2(1:LK2) 10010 FORMAT(1x,'+LTFUSE: use in the fit ',2A10) ENDIF 99 CONTINUE END ! LTFUSE *CMZ : 2.00/01 17/07/97 16.20.30 by A.Rozanov *CMZ : 2.00/00 20/01/96 23.00.24 by A.Rozanov *CMZ : 2.00/01 08/03/95 10.35.27 by A.Rozanov *CMZ : 1.30/07 19/02/95 23.36.27 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFGET(TKEY,VKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTFGET * * (module) * * * * Description : * * extract of experimental data for LEPTOP fit * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTFPUT, LTFGET * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEEP,FITRES. COMMON/FITRES/AMTFIT,AMTERR,AMTEPL,AMTEMI,AMTGLB, 1 ALSFIT,ALSERR,ALSEPL,ALSEMI,ALSGLB, 2 AMHFIT,AMHERR,AMHEPL,AMHEMI,AMHGLB, 3 ALBARFIT,ALBARERR,ALNAREPL,ALBAREMI,ALBARGLB DIMENSION FITPAR(5,4) EQUIVALENCE(AMTFIT,FITPAR) *KEND. CHARACTER*(*) TKEY, VKEY REAL*4 VALUE * LKT=LEN(TKEY) LKV=LEN(VKEY) IFIT=0 JFIT=0 * modify some constants IF(TKEY(1:LKT).eq.'VALUE')THEN CALL LTFGEV(VKEY,VALUE) ELSEIF(TKEY(1:LKT).eq.'ERROR')THEN CALL LTFGEE(VKEY,VALUE) ELSEIF(VKEY(1:LKV).EQ.'ALL')THEN * *------- print++++++++++++++++++++++++ IF(PRTFLG(9).NE.0)THEN WRITE(6,10010)VKEY(1:LKV) 10010 FORMAT(1x,'+LTFGET: ',A20) WRITE(6,*)' DATA VALUE ERROR USED IN THE FIT' DO I=1,NLEP WRITE(6,10121)I,CHLEP(I),VLEP(I),ELEP(I),FLEP(I) 10121 FORMAT(1X,I2,1x,A10,3F10.4) ENDDO ENDIF *--------+++++++++++++++++++++++++++++ ELSEIF(TKEY(1:LKT).eq.'FIT_RESULT')THEN IFIT=1 JFIT=LTFFIP(VKEY) IF(JFIT.NE.0)VALUE=FITPAR(IFIT,JFIT) ELSEIF(TKEY(1:LKT).eq.'FIT_ERROR')THEN IFIT=2 JFIT=LTFFIP(VKEY) IF(JFIT.NE.0)VALUE=FITPAR(IFIT,JFIT) ELSEIF(TKEY(1:LKT).eq.'FIT_ERR+')THEN IFIT=3 JFIT=LTFFIP(VKEY) IF(JFIT.NE.0)VALUE=FITPAR(IFIT,JFIT) ELSEIF(TKEY(1:LKT).eq.'FIT_ERR-')THEN IFIT=4 JFIT=LTFFIP(VKEY) IF(JFIT.NE.0)VALUE=FITPAR(IFIT,JFIT) ELSEIF(TKEY(1:LKT).eq.'FIT_GLB')THEN IFIT=5 JFIT=LTFFIP(VKEY) IF(JFIT.NE.0)VALUE=FITPAR(IFIT,JFIT) ELSE write(6,*)'+LTFGET: wrong keys: ', 1 TKEY(1:LKT),' ',VKEY(1:LKV),' ',VALUE ENDIF END ! LTFGET *CMZ : 1.30/07 19/02/95 23.44.30 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFGEV(VKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTFGEV * * (module) * * * * Description : * * extract experimental data for LEPTOP fit * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTFPUT, LTFGEV * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. CHARACTER*(*) VKEY REAL*4 VALUE * LKV=LEN(VKEY) I=LTFIND(VKEY) * modify some constants IF(I.GE.1.AND.I.LE.NL)THEN VALUE=VLEP(I) ELSE write(6,*)'+LTFGEV: wrong key: ', 1 VKEY(1:LKV) ENDIF * * * print IF(PRTFLG(9).NE.0)THEN WRITE(6,10010)VKEY(1:LKV),VLEP(I) 10010 FORMAT(1x,'+LTFGEV: ',A20,' = ',D16.8) ENDIF END ! LTFGEV *CMZ : 1.30/07 19/02/95 23.46.38 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFGEE(VKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTFGEE * * (module) * * * * Description : * * input of errors of experimental data for LEPTOP fit * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTFPUT, LTFPUV * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. CHARACTER*(*) VKEY REAL*4 VALUE * LKV=LEN(VKEY) I=LTFIND(VKEY) * modify some constants IF(I.GE.1.AND.I.LE.NL)THEN VALUE=ELEP(I) ELSE write(6,*)'+LTFGEE: wrong key: ', 1 VKEY(1:LKV) ENDIF * * * print IF(PRTFLG(9).NE.0)THEN WRITE(6,10010)VKEY(1:LKV),ELEP(I) 10010 FORMAT(1x,'+LTFGEE: error on ',A20,' = ',D16.8) ENDIF END ! LTFGEE *CMZ : 2.00/00 28/01/96 15.03.21 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.45.15 by A.Rozanov *CMZ : 1.30/07 17/02/95 22.19.11 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFIT2(CHKEY,PAR1S,PAR2S,EPAR1S,EPAR2S,RHO,CHI2S,NDF) * * *----------------------------------------------------------------------* * * * Name : LTFIT2 * * (module) * * * * Description : * * fit two parameters * * MT and ALSBAR from experimental data * * or MT and MH * * or ALSBAR and MH * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET, LTFIT2 *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. DIMENSION CERR(2,2),FLAG(3),PARAM(3) REAL*4 PAR1S,PAR2S,EPAR1S,EPAR2S,RHO,CHI2S * * CHARACTER*(*) CHKEY * * LK=LEN(CHKEY) PARAM(1)=AMTCOM PARAM(2)=ALSCOM PARAM(3)=AMHCOM FLAG(1)=0. FLAG(2)=0. FLAG(3)=0. IF(CHKEY(1:LK).EQ.'MT,ALS')THEN FLAG(1)=1. FLAG(2)=1. CALL LTFTWO(FLAG,PARAM,PAR1,PAR2,CERR,CHI2) ELSEIF(CHKEY(1:LK).EQ.'MT,MH')THEN FLAG(1)=1. FLAG(3)=1. CALL LTFTWO(FLAG,PARAM,PAR1,PAR2,CERR,CHI2) ELSEIF(CHKEY(1:LK).EQ.'ALS,MH')THEN FLAG(2)=1. FLAG(3)=1. CALL LTFTWO(FLAG,PARAM,PAR1,PAR2,CERR,CHI2) ELSE WRITE(6,*)'+LTFIT2: wrong keyword: ',CHKEY(1:LK) GO TO 99 ENDIF PAR1S=PAR1 PAR2S=PAR2 EPAR1S=dsqrt(CERR(1,1)) EPAR2S=dsqrt(CERR(2,2)) RHO=CERR(1,2)/(EPAR1S*EPAR2S) CHI2S=CHI2 NDF=NPLEP-2 IF(PRTFLG(9).ne.0)THEN WRITE(6,10010)CHKEY(1:LK),PAR1S,EPAR1S,PAR2S,EPAR2S,RHO,CHI2S 1 ,NDF 10010 FORMAT(1x,'+LTFIT2: ',A10,' = ',f10.4,' +- ',f8.4, 1 ' PAR2= ',F10.4, 1 ' +- ',F8.4,/ 2 ' RHO= ',E12.5,' CHI2= ',E12.5,' NDF',I3) ENDIF 99 CONTINUE END ! LTFIT2 *CMZ : 2.00/02 03/07/98 19.29.08 by A.Rozanov *CMZ : 2.00/01 26/06/97 13.25.17 by A.Rozanov *CMZ : 2.00/01 09/03/95 11.18.27 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.20.00 by A.Rozanov *CMZ : 1.30/07 18/02/95 01.02.09 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : *------------------------------------------------------------------- SUBROUTINE LTFTWO(FLAG,PARAM,PAR1,PAR2,CERR,CHI2) *------------------------------------------------------------------- *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEEP,mncom. COMMON/MNCOM/MNPRNT,MNREAD,MNUNIT,MNSAVE,EPSMN *KEEP,FITRES. COMMON/FITRES/AMTFIT,AMTERR,AMTEPL,AMTEMI,AMTGLB, 1 ALSFIT,ALSERR,ALSEPL,ALSEMI,ALSGLB, 2 AMHFIT,AMHERR,AMHEPL,AMHEMI,AMHGLB, 3 ALBARFIT,ALBARERR,ALNAREPL,ALBAREMI,ALBARGLB DIMENSION FITPAR(5,4) EQUIVALENCE(AMTFIT,FITPAR) *KEND. EXTERNAL FCNLB CHARACTER*10 PNAM(3) Character*10 CHNAM1,CHNAM2 PARAMETER (NPT=30) DIMENSION NPRM(3),VSTRT(3),STP(3),ARGLIS(6) * DIMENSION X(3),CH2(100,100),FLEPO(NL),AMTLEP(NL),EMTLEP(NL) * DIMENSION EMTPOS(NL),EMTNEG(NL) DIMENSION CERR(2,2),FLAG(3),PARAM(3) DATA NPRM/ 1 , 2 , 3 / DATA PNAM/'MT','ALS','MH'/ * DATA VSTRT/150.D0,0.125D0,300.D0/ DATA STP/10.D0,0.01D0,10.D0/ *-----initialization-------------------------- DO I=1,5 DO J=1,4 FITPAR(I,J)=0.D0 ENDDO ENDDO IF(MNUNIT.EQ.-19)THEN OPEN(UNIT=19,STATUS='SCRATCH') ENDIF MNRD=IABS(MNREAD) MNWR=IABS(MNUNIT) * CALL MNINIT(5,19,7) CALL MNINIT(MNRD,MNWR,MNSAVE) IF(MNREAD.LE.0)THEN * Fortran-driven mode of MINUIT VSTRT(1)=PARAM(1) VSTRT(2)=PARAM(2) VSTRT(3)=PARAM(3) CALL MNPARM(1,PNAM(1),VSTRT(1),STP(1),5.D0,1.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 1' ENDIF CALL MNPARM(2,PNAM(2),VSTRT(2),STP(2),0.D0,1.D0,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNPARM(3,PNAM(3),VSTRT(3),STP(3),5.D0,2.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNSETI('LEPTOP fit') ARGLIS(1)=0.D0 CALL MNEXCM(FCNLB,'SET BATCH',ARGLIS,0,IERFLG) *-----switch off the output * ARGLIS(1)=-1.D0 ARGLIS(1)=dfloat(MNPRNT) CALL MNEXCM(FCNLB,'SET PRI',ARGLIS,1,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'+LTFTWO: UNABLE TO SET PRI',ARGLIS(1) ENDIF ARGLIS(1)=EPSMN CALL MNEXCM(FCNLB,'SET EPS',ARGLIS,1,IERFLG) ARGLIS(1)=1.D0 CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) FIXED=0.D0 DO IPAR=1,3 FIXED=FIXED+1.D0 IF(FLAG(IPAR).LE.0.D0)THEN ARGLIS(1)=FIXED CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) ENDIF ENDDO *********************************************** ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SET PRINT',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'MIGRAD',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'HES',ARGLIS,1,IERFLG) * ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SHOW ERR',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,0,IERFLG) *---------------------------------------------------------- ELSEIF(MNREAD.GT.0)THEN * data-driven mode of MINUIT CALL MINUIT(FCNLB,0) ENDIF if(prtflg(2).gt.0.)then CALL PRTERR endif CALL MNSTAT(CHI2,FEDM,ERRDEF,NPARI,NPARX,ISTAT) IF(FLAG(3).le.0.D0)THEN CALL MNPOUT(1,CHNAM1,PAR1,EPAR1,BND1,BND2,IVARBL) CALL MNERRS(1,PAR1PL,PAR1MI,PAR1PAR,PAR1GLB) CALL MNPOUT(2,CHNAM2,PAR2,EPAR2,BND1,BND2,IVARBL) CALL MNERRS(2,PAR2PL,PAR2MI,PAR2PAR,PAR2GLB) CALL MNEMAT(CERR,2) AMTFIT=PAR1 AMTERR=PAR1PAR AMTEPL=PAR1PL AMTEMI=PAR1MI AMTGLB=PAR1GLB ALSFIT=PAR2 ALSERR=PAR2PAR ALSEPL=PAR2PL ALSEMI=PAR2MI ALSGLB=PAR2GLB ELSEIF(FLAG(2).le.0.D0)THEN CALL MNPOUT(1,CHNAM1,PAR1,EPAR1,BND1,BND2,IVARBL) CALL MNERRS(1,PAR1PL,PAR1MI,PAR1PAR,PAR1GLB) CALL MNPOUT(3,CHNAM2,PAR2,EPAR2,BND1,BND2,IVARBL) CALL MNERRS(3,PAR2PL,PAR2MI,PAR2PAR,PAR2GLB) CALL MNEMAT(CERR,2) AMTFIT=PAR1 AMTERR=PAR1PAR AMTEPL=PAR1PL AMTEMI=PAR1MI AMTGLB=PAR1GLB AMHFIT=PAR2 AMHERR=PAR2PAR AMHEPL=PAR2PL AMHEMI=PAR2MI AMHGLB=PAR2GLB ELSEIF(FLAG(1).le.0.D0)THEN CALL MNPOUT(2,CHNAM1,PAR1,EPAR1,BND1,BND2,IVARBL) CALL MNERRS(2,PAR1PL,PAR1MI,PAR1PAR,PAR1GLB) CALL MNPOUT(3,CHNAM2,PAR2,EPAR2,BND1,BND2,IVARBL) CALL MNERRS(3,PAR2PL,PAR2MI,PAR2PAR,PAR2GLB) CALL MNEMAT(CERR,2) ALSFIT=PAR1 ALSERR=PAR1PAR ALSEPL=PAR1PL ALSEMI=PAR1MI ALSGLB=PAR1GLB AMHFIT=PAR2 AMHERR=PAR2PAR AMHEPL=PAR2PL AMHEMI=PAR2MI AMHGLB=PAR2GLB ELSE WRITE(6,*)'+LTFTWO: 3 parameters fit not allowed' go to 99 ENDIF if(prtflg(4).gt.0.)then WRITE(6,*)CHNAM1,PAR1,EPAR1 WRITE(6,*)CHNAM2,PAR2,EPAR2 WRITE(6,*)'CERR',CERR WRITE(6,*)'CHI2= ',CHI2 endif 99 CONTINUE ARGLIS(1)=0.D0 CALL MNEXCM(FCNLB,'RESTORE',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'RETURN',ARGLIS,0,IERFLG) if(MNUNIT.eq.-19)CLOSE(19) END *CMZ : 2.00/00 28/01/96 15.19.47 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.47.46 by A.Rozanov *CMZ : 1.30/07 17/02/95 22.19.11 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFIT1(CHKEY,PAR1S,EPAR1S,CHI2S,NDF) * * *----------------------------------------------------------------------* * * * Name : LTFIT1 * * (module) * * * * Description : * * fit one parameter * * MT or ALSBAR or MH from experimental data * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET, LTFIT1. LTFIT2 * *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. DIMENSION CERR(2,2),FLAG(3),PARAM(3) REAL*4 PAR1S,EPAR1S,CHI2S * * CHARACTER*(*) CHKEY * * LK=LEN(CHKEY) PARAM(1)=AMTCOM PARAM(2)=ALSCOM PARAM(3)=AMHCOM FLAG(1)=0. FLAG(2)=0. FLAG(3)=0. IF(CHKEY(1:LK).EQ.'MT')THEN FLAG(1)=1. CALL LTFTWO(FLAG,PARAM,PAR1,PAR2,CERR,CHI2) PAR1S=PAR1 ELSEIF(CHKEY(1:LK).EQ.'ALS')THEN FLAG(2)=1. CALL LTFTWO(FLAG,PARAM,PAR1,PAR2,CERR,CHI2) PAR1S=PAR2 ELSEIF(CHKEY(1:LK).EQ.'MH')THEN FLAG(3)=1. CALL LTFTWO(FLAG,PARAM,PAR1,PAR2,CERR,CHI2) PAR1S=PAR2 ELSE WRITE(6,*)'+LTFIT1: wrong keyword: ',CHKEY(1:LK) GO TO 99 ENDIF EPAR1S=dsqrt(CERR(1,1)) CHI2S=CHI2 NDF=NPLEP-1 IF(PRTFLG(9).ne.0)THEN WRITE(6,10010)CHKEY(1:LK),PAR1S,EPAR1S,CHI2S,NDF 10010 FORMAT(1x,'+LTFIT1: ',A6,' = ',f10.4,' +- ',f8.4, 2 ' CHI2= ',E12.5,' NDF',I3) ENDIF 99 CONTINUE END ! LTFIT1 *CMZ : 2.00/00 28/01/96 15.19.47 by A.Rozanov *CMZ : 2.00/03 09/05/95 22.48.37 by A.Rozanov *CMZ : 2.00/02 11/03/95 11.36.18 by A.Rozanov *CMZ : 2.00/01 08/03/95 21.56.25 by A.Rozanov *CMZ : 1.30/09 23/02/95 02.19.11 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.36.39 by A.Rozanov *CMZ : 1.30/07 19/02/95 23.53.01 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTMOR95 * * *----------------------------------------------------------------------* * * * Name : LTMOR95 * * (module) * * * * Description : * * fit data for L.B. talk at Moriond-95 Conference * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 07/03/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * parameter (ntry=4) dimension amtf(ntry,3),e1amtf(ntry,3),e2amtf(ntry,3),chi2f(ntry,3) dimension alsf(ntry),albf(ntry) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) CALL LTFPUT('MORIOND95','ALL',DUMMY) do imh=1,3 alb=1./128.896 CALL LTPUT('ALBAR',alb) if(imh.eq.1)then AMH=60. elseif(imh.eq.2)then AMH=300. elseif(imh.eq.3)then AMH=1000. endif write(6,*)'amh=',AMH CALL LTPUT('MH',AMH) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) write(6,*)'+LTMOR95: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' als= ',als,' +- ',eals write(6,*)'+LTMOR95: rho,chi2= ',rho,chi2 enddo ! imh * * * do ipass=1,3 call vzero(amtf,48) do itry=1,4 * initialisation CALL LTINIT(0) CALL LTFPUT('MORIOND95','ALL',DUMMY) if(ipass.eq.1.and.itry.eq.1)then CALL LTFGET(' ','ALL',0.) endif * swith on print out inside LTPUT CALL LTFLAG('PRNT',8) CALL LTGET('ALSHAT',als) CALL LTGET('ALBAR',alb) pi=2*asin(1.) * set excursion in albar LB request 08.03.95 if(ipass.eq.1)then alb=1./128.87 CALL LTPUT('ALBAR',alb) elseif(ipass.eq.2)then alb=1./129.1 CALL LTPUT('ALBAR',alb) elseif(ipass.eq.3)then alb=1./128.896 CALL LTPUT('ALBAR',alb) endif if(itry.eq.2.or.itry.eq.3)then * modify some constants AMT=175. CALL LTPUT('MT',AMT) als=0.109 CALL LTPUT('ALSHAT',als) endif * use Vysotsky-Shifman's option 8 to increass Gbb by 7 MeV if(itry.eq.3)then CALL LTFLAG('OPT',8) write(6,*)'+LTMOR95: Increase Gbb by 0.007 GeV' endif if(itry.eq.4)then CALL LTFGET('VALUE','RB',rb) CALL LTFGET('VALUE','RL',rl) CALL LTFGET('VALUE','SIGH',sigh) CALL LTFGET('VALUE','GZ',gz) CALL LTGET('MZ',amz) gh2=sigh*rl*amz**2*gz**2/(12*pi*38.938*10**4) gh=sqrt(gh2) gb=rb*gh rbnew=(gb-0.007)/gh write(6,*)'rb,gh,gb,rbnew',rb,gh,gb,rbnew CALL LTFPUT('VALUE','RB',rbnew) endif alsf(itry)=als albf(itry)=alb do imh=1,3 * test fit of mtop and alsbar if(imh.eq.1)then AMH=100. elseif(imh.eq.2)then AMH=300. elseif(imh.eq.3)then AMH=700. endif CALL LTPUT('MH',AMH) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) write(6,*)'+LTMOR95: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' als= ',als,' +- ',eals write(6,*)'+LTMOR95: rho,chi2= ',rho,chi2 CALL LTPUT('MT',amt) CALL LTPUT('ALSHAT',als) CALL LTGET('SIN2E',sin2efit) CALL LTGET('GV',gvfit) CALL LTGET('GA',gafit) CALL LTGET('RB',rbfit) emt=eamt ealsbar=eals emh=700. ealbar=alb-1./(1./alb-0.12) CALL LTERR('SIN2E',emt,ealsbar,emh,ealbar,esin2efit) CALL LTERR('GV',emt,ealsbar,emh,ealbar,egvfit) CALL LTERR('GA',emt,ealsbar,emh,ealbar,egafit) CALL LTERR('RB',emt,ealsbar,emh,ealbar,erbfit) write(6,*)'+LTMOR95: sin2efit,gvfit,gafit', 1 sin2efit,gvfit,gafit write(6,*)'+LTMOR95: esin2efit,egvfit,egafit', 1 esin2efit,egvfit,egafit write(6,*)'+LTMOR95: rbfit,erbfit',rbfit,erbfit enddo ! imh AMH=100. CALL LTPUT('MH',AMH) CALL LTFIT1('MT',amt,eamt,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) amtf(itry,1)=amt e1amtf(itry,1)=emtpos e2amtf(itry,1)=emtneg chi2f(itry,1)=chi2 write(6,*)'+LTMOR95: mt= ',amt,' +- ',eamt write(6,*)'+LTMOR95: chi2= ',chi2 AMH=300. CALL LTPUT('MH',AMH) CALL LTFIT1('MT',amt,eamt,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) amtf(itry,2)=amt e1amtf(itry,2)=emtpos e2amtf(itry,2)=emtneg chi2f(itry,2)=chi2 write(6,*)'+LTMOR95: mt= ',amt,' +- ',eamt write(6,*)'+LTMOR95: chi2= ',chi2 AMH=700. CALL LTPUT('MH',AMH) CALL LTFIT1('MT',amt,eamt,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) amtf(itry,3)=amt e1amtf(itry,3)=emtpos e2amtf(itry,3)=emtneg chi2f(itry,3)=chi2 write(6,*)'+LTMOR95: mt= ',amt,' +- ',eamt write(6,*)'+LTMOR95: chi2= ',chi2 CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) write(6,*)'+LTMOR95: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' mh= ',amh,' + ',emhpos,' ',emhneg write(6,*)'+LTMOR95: rho,chi2= ',rho,chi2 enddo ! itry write(6,*)'---------------------------------------------------' write(6,*)'ipass',ipass write(6,*)'---------------------------------------------------' do itry=1,4 albinv=1./albf(itry) write(6,10010)albinv,alsf(itry), 1 ifix(amtf(itry,1)),ifix(e1amtf(itry,1)),ifix(e2amtf(itry,1)), 2 ifix(chi2f(itry,1)), 3 ifix(amtf(itry,2)),ifix(e1amtf(itry,2)),ifix(e2amtf(itry,2)), 4 ifix(chi2f(itry,2)), 5 ifix(amtf(itry,3)),ifix(e1amtf(itry,3)),ifix(e2amtf(itry,3)), 6 ifix(chi2f(itry,3)) 10010 format(2f8.3,3(' ',i3,' +',i2,i3,' ',i2)) enddo enddo ! ipass END ! LTMOR95 *CMZ : 04/03/99 11.37.50 by A.Rozanov *CMZ : 2.00/03 08/09/98 21.57.31 by A.Rozanov *CMZ : 2.00/02 02/09/98 23.09.19 by A.Rozanov *CMZ : 2.00/01 15/07/97 17.38.32 by A.Rozanov *CMZ : 2.00/00 24/06/97 17.44.02 by A.Rozanov *CMZ : 2.00/01 09/03/95 13.43.52 by A.Rozanov *CMZ : 1.30/07 19/02/95 23.44.30 by A.Rozanov *-- Author : A.Rozanov 01/02/95 INTEGER FUNCTION LTFFIP(KEY) * * *----------------------------------------------------------------------* * * * Name : LTFFIP * * (module) * * * * Description : * * find index of the fitted parameter from the KEY * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/02/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTFPUT, LTFFIP * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. CHARACTER*(*) KEY * LTFFIP=0 LK=LEN(KEY) * modify some constants IF(KEY(1:LK).eq.'MT')THEN LTFFIP=1 ELSEIF(KEY(1:LK).eq.'ALSHAT'.OR.KEY(1:LK).eq.'ALSBAR')THEN LTFFIP=2 ELSEIF(KEY(1:LK).eq.'MH'.OR.KEY(1:LK).eq.'LOGMH')THEN LTFFIP=3 ELSEIF(KEY(1:LK).eq.'ALBAR'.or.KEY(1:LK).eq.'ALBAR-1')THEN LTFFIP=4 ELSE write(6,*)'+LTFFIP: wrong key: ', 1 KEY(1:LK) ENDIF * * END ! LTFFIP *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov *CMZ : 2.00/00 20/01/96 21.06.38 by A.Rozanov *CMZ : 2.00/03 01/05/95 20.21.34 by A.Rozanov *CMZ : 1.30/09 23/02/95 02.17.30 by A.Rozanov *CMZ : 1.30/07 17/02/95 23.53.32 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTERR(CHKEY,DMT,DALSBAR,DMH,DALBAR,EVALUE) * * *----------------------------------------------------------------------* * * * Name : LTERR * * (module) * * * * Description : * * to calculate the error on the variable CHKEY * * due to the error in mt, alsbar, mh and albar * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/05/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET *----------------------------------------------------------------------* *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEND. * * CHARACTER*(*) CHKEY * * get some constants or variables CALL LTGET('MT',amt0) CALL LTGET('ALSHAT',alsbar0) CALL LTGET('MH',amh0) CALL LTGET('ALBAR',albar0) CALL LTGET(CHKEY,value0) * vary mtop CALL LTPUT('MT',amt0-dmt) CALL LTGET(CHKEY,value) d1=value-value0 CALL LTPUT('MT',amt0+dmt) CALL LTGET(CHKEY,value) d2=value-value0 dvmt=amax1(abs(d1),abs(d2)) CALL LTPUT('MT',amt0) * vary alsbar CALL LTPUT('ALSHAT',alsbar0-dalsbar) CALL LTGET(CHKEY,value) d1=value-value0 CALL LTPUT('ALSHAT',alsbar0+dalsbar) CALL LTGET(CHKEY,value) d2=value-value0 dvalsbar=amax1(abs(d1),abs(d2)) CALL LTPUT('ALSHAT',alsbar0) * vary mh if(amh0-damh.ge.60.)then CALL LTPUT('MH',amh0-damh) else CALL LTPUT('MH',60.) endif CALL LTGET(CHKEY,value) d1=value-value0 CALL LTPUT('MH',amh0+damh) CALL LTGET(CHKEY,value) d2=value-value0 dvmh=amax1(abs(d1),abs(d2)) CALL LTPUT('MH',amh0) * vary albar CALL LTPUT('ALBAR',albar0-dalbar) CALL LTGET(CHKEY,value) d1=value-value0 CALL LTPUT('ALBAR',albar0+dalbar) CALL LTGET(CHKEY,value) d2=value-value0 dvalbar=amax1(abs(d1),abs(d2)) CALL LTPUT('ALBAR',albar0) * calculate total error EVALUE=SQRT(dvmt**2+dvalsbar**2+dvmh**2+dvalbar**2) IF(PRTFLG(9).ne.0)THEN WRITE(6,10010)CHKEY(1:LK),EVALUE 10010 FORMAT(1x,'+LTERR: ',A20,E16.8) ENDIF END ! LTERR *CMZ : 12/04/99 03.39.27 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.27.53 by A.Rozanov *CMZ : 2.00/00 22/01/96 16.45.50 by A.Rozanov *CMZ : 2.00/03 09/05/95 22.43.16 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.45.15 by A.Rozanov *CMZ : 1.30/07 17/02/95 22.19.11 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTPLOT2(CHKEY,ID) * * *----------------------------------------------------------------------* * * * Name : LTPLOT2 * * (module) * * * * Description : * * plot two parameters chi2 plot * * MT and ALSBAR from experimental data * * or MT and MH * * or ALSBAR and MH * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/05/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET, LTFIT2 *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEND. REAL*4 CHI2S,AMS,AMHS,ALSBAS character*10 CHTITL REAL*4 AMTMIN,AMTMAX,ALSMIN,ALSMAX,AMHMIN,AMHMAX PARAMETER (NPT=30) DIMENSION X(3),CH2(100,100) PARAMETER(NAMHIG=3) * * CHARACTER*(*) CHKEY * * LK=LEN(CHKEY) IF(CHKEY(1:LK).EQ.'MT,ALS')THEN CALL HGIVE(ID,CHTITL,NAMT,AMTMIN,AMTMAX,NALS,ALSMIN,ALSMAX,NWT,LO) AMTSTP=(AMTMAX-AMTMIN)/NAMT ALSSTP=(ALSMAX-ALSMIN)/NALS DO 101 IALS=1,NALS ALSBAR=ALSMIN+(DFLOAT(IALS-1)+0.5)*ALSSTP ALSBAS=ALSBAR DO 102 IAMT=1,NAMT AMT=AMTMIN+(DFLOAT(IAMT-1)+0.5)*AMTSTP AMS=AMT X(1)=AMT X(2)=ALSBAR X(3)=AMHCOM CALL FCNLB(NPAR,GIN,F,X,IFLAG) CHI2S=F-CHIMIN CALL HF2(id,AMS,ALSBAS,CHI2S) 102 CONTINUE 101 CONTINUE * CALL HPRINT(id) * ELSEIF(CHKEY(1:LK).EQ.'MT,MH')THEN CALL HGIVE(ID,CHTITL,NAMT,AMTMIN,AMTMAX,NAMH,AMHMIN,AMHMAX,NWT,LO) AMTSTP=(AMTMAX-AMTMIN)/NAMT AMHSTP=(AMHMAX-AMHMIN)/NAMH CHIMIN=9999999999. DO 201 IAMH=1,NAMH AMH=AMHMIN+(IAMH-1+0.5)*AMHSTP AMHS =AMH DO 202 IAMT=1,NAMT AMT=AMTMIN+(IAMT-1+0.5)*AMTSTP AM=AMT X(1)=AMT X(2)=ALSCOM X(3)=AMH CALL FCNLB(NPAR,GIN,F,X,IFLAG) CH2(IAMT,IAMH)=F IF(F.LT.CHIMIN)THEN CHIMIN=F ITMIN=IAMT IHMIN=IAMH ENDIF 202 CONTINUE 201 CONTINUE DO 203 IAMH=1,NAMH AMH=AMHMIN+(IAMH-1+0.5)*AMHSTP AMHS =AMH DO 204 IAMT=1,NAMT AMT=AMTMIN+(IAMT-1+0.5)*AMTSTP AMS=AMT CHI2S=CH2(IAMT,IAMH)-CHIMIN CALL HF2(ID,AMS,AMHS,CHI2S) 204 CONTINUE 203 CONTINUE * CALL HPRINT(ID) ELSEIF(CHKEY(1:LK).EQ.'MT,LOGMH')THEN CALL HGIVE(ID,CHTITL,NAMT,AMTMIN,AMTMAX,NAMH,AMHMIN,AMHMAX,NWT,LO) AMTSTP=(AMTMAX-AMTMIN)/NAMT AMHSTP=(AMHMAX-AMHMIN)/NAMH CHIMIN=9999999999. DO 301 IAMH=1,NAMH DLOGMH=AMHMIN+(IAMH-1+0.5)*AMHSTP AMH=10.D0**DLOGMH AMHS = DLOGMH DO 302 IAMT=1,NAMT AMT=AMTMIN+(IAMT-1+0.5)*AMTSTP AM=AMT X(1)=AMT X(2)=ALSCOM X(3)=AMH CALL FCNLB(NPAR,GIN,F,X,IFLAG) CH2(IAMT,IAMH)=F IF(F.LT.CHIMIN)THEN CHIMIN=F ITMIN=IAMT IHMIN=IAMH ENDIF 302 CONTINUE 301 CONTINUE DO 303 IAMH=1,NAMH DLOGMH=AMHMIN+(IAMH-1+0.5)*AMHSTP AMH=10D0**DLOGMH AMHS = DLOGMH DO 304 IAMT=1,NAMT AMT=AMTMIN+(IAMT-1+0.5)*AMTSTP AMS=AMT CHI2S=CH2(IAMT,IAMH)-CHIMIN CALL HF2(ID,AMS,AMHS,CHI2S) 304 CONTINUE 303 CONTINUE * CALL HPRINT(ID) ELSEIF(CHKEY(1:LK).EQ.'ALS,MH')THEN CALL HGIVE(ID,CHTITL,NALS,ALSMIN,ALSMAX,NAMH,AMHMIN,AMHMAX,NWT,LO) ALSSTP=(ALSMAX-ALSMIN)/NALS AMHSTP=(AMHMAX-AMHMIN)/NAMH DO 1001 IALS=1,NALS ALSBAR=ALSMIN+(DFLOAT(IALS-1)+0.5)*ALSSTP ALSBAS=ALSBAR DO 1002 IAMH=1,NAMH AMH=AMHMIN+(DFLOAT(IAMH-1)+0.5)*AMHSTP AMS=AMH X(1)=AMTCOM X(2)=ALSBAR X(3)=AMH CALL FCNLB(NPAR,GIN,F,X,IFLAG) CHI2S=F-CHIMIN CALL HF2(id,ALSBAS,AMS,CHI2S) 1002 CONTINUE 1001 CONTINUE * CALL HPRINT(id) ELSE WRITE(6,*)'++LTPLOT2: wrong key:',CHKEY ENDIF END *CMZ : 2.00/02 03/07/98 19.19.05 by A.Rozanov *CMZ : 2.00/03 01/05/95 22.12.18 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.47.46 by A.Rozanov *CMZ : 1.30/07 17/02/95 22.19.11 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTPLOT1(CHKEY,PAR1S,EPAR1S) * * *----------------------------------------------------------------------* * * * Name : LTPLOT1 * * (module) * * * * Description : * * plot one parameter chi2 curve * * MT or ALSBAR or MH from experimental data * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/05/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET, LTFIT1. LTFIT2 * *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEND. DIMENSION FLAG(3),PARAM(3) REAL*4 PAR1S,EPAR1S * * CHARACTER*(*) CHKEY * * LK=LEN(CHKEY) PARAM(1)=AMTCOM PARAM(2)=ALSCOM PARAM(3)=AMHCOM FLAG(1)=0. FLAG(2)=0. FLAG(3)=0. IF(CHKEY(1:LK).EQ.'MT')THEN ELSEIF(CHKEY(1:LK).EQ.'ALS')THEN ELSEIF(CHKEY(1:LK).EQ.'MH')THEN ELSE WRITE(6,*)'+LTPLOT1: wrong keyword: ',CHKEY(1:LK) GO TO 99 ENDIF 99 CONTINUE END ! LTPLOT1 *CMZ : 2.00/00 28/01/96 15.19.47 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTBEI95 * * *----------------------------------------------------------------------* * * * Name : LTBEI95 * * (module) * * * * Description : * * fit data for MIV and VAN of Beijing-95 conference * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 26/10/95 * * * * * * Last modifications : * * fourth generation Date : 06/11/95 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * DIMENSION E3(3,3) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) CALL LTFPUT('BEIJING95','ALL',DUMMY) CALL LTFUSE('USE','MT') do imh=1,3 alb=1./128.896 CALL LTPUT('ALBAR',alb) if(imh.eq.1)then AMH=60. elseif(imh.eq.2)then AMH=300. elseif(imh.eq.3)then AMH=1000. endif write(6,*)'amh=',AMH CALL LTPUT('MH',AMH) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) write(6,*)'+LTBEI95: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' als= ',als,' +- ',eals write(6,*)'+LTBEI95: rho,chi2= ',rho,chi2 enddo ! imh * do imt=1,6 if(imt.eq.1)then AMT=168. elseif(imt.eq.2)then AMT=180. elseif(imt.eq.3)then AMT=192. endif AMT=132.+(imt-1)*12. write(6,*)'amt=',AMT CALL LTPUT('MT',AMT) CALL LTFIT2('ALS,MH',als,amh,eals,eamh,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) write(6,10010)amh,emhpos,emhneg,als,eals 10010 format('+LTBEI95: mh= ',f6.1,' + ',f6.1,' ',f6.1, 1 ' als= ',f7.5,' +- ',f7.5) write(6,*)'+LTBEI95: rho,chi2= ',rho,chi2 enddo ! imt CALL LTFIT3('MT,ALS,MH',amt,als,amh,eamt,eals,eamh,e3,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) write(6,10020)amt,emtpos,emtneg,amh,emhpos,emhneg,als,eals 10020 format('+LTBEI95: mt= ',f6.1,' + ',f6.1,' ',f6.1, 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1, 1 ' als= ',f7.5,' +- ',f7.5) write(6,*)'+LTBEI95: chi2= ',chi2 *========================================================================== am4=200. do ian4=1,4 an4=ian4 write(6,*)'Fit with 4-th generation am4,an4=',am4,an4 call ltput('ml4',am4) call ltput('mq4',am4) call ltput('nl4',an4) call ltput('nq4',an4) CALL LTFIT3('MT,ALS,MH',amt,als,amh,eamt,eals,eamh,e3,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) write(6,10020)amt,emtpos,emtneg,amh,emhpos,emhneg,als,eals write(6,*)'+LTBEI95: chi2= ',chi2 enddo ! ian4 *==================================================================== * mt-als fit fixing mh do imh=1,2 alb=1./128.896 CALL LTPUT('ALBAR',alb) if(imh.eq.1)then AMH=60. elseif(imh.eq.2)then AMH=300. elseif(imh.eq.3)then AMH=1000. endif write(6,*)'amh=',AMH CALL LTPUT('MH',AMH) am4=60. do ian4=1,4 an4=ian4 write(6,*)'Fit with 4-th generation am4,an4=',am4,an4 call ltput('ml4',am4) call ltput('mq4',am4) call ltput('nl4',an4) call ltput('nq4',an4) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) write(6,*)'+LTBEI95: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' als= ',als,' +- ',eals write(6,*)'+LTBEI95: rho,chi2= ',rho,chi2 enddo ! ian4 enddo ! imh * END ! LTBEI95 *CMZ : 2.00/01 15/07/97 18.27.47 by A.Rozanov *CMZ : 2.00/00 24/06/97 17.03.06 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.42.02 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.45.15 by A.Rozanov *CMZ : 1.30/07 17/02/95 22.19.11 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFIT3(CHKEY,PAR1S,PAR2S,PAR3S, 1 EPAR1S,EPAR2S,EPAR3S, 2 ERR,CHI2S,NDF) * * *----------------------------------------------------------------------* * * * Name : LTFIT3 * * (module) * * * * Description : * * fit two parameters * * MT and ALSBAR from experimental data * * or MT and MH * * or ALSBAR and MH * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 26/10/95 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET, LTFIT3 *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. DIMENSION CERR(3,3),FLAG(3),PARAM(3),ERR(3,3) REAL*4 PAR1S,PAR2S,PAR3S,EPAR1S,EPAR2S,EPAR3S,ERR,CHI2S * * CHARACTER*(*) CHKEY * * LK=LEN(CHKEY) PARAM(1)=AMTCOM PARAM(2)=ALSCOM PARAM(3)=AMHCOM FLAG(1)=0. FLAG(2)=0. FLAG(3)=0. IF(CHKEY(1:LK).EQ.'MT,ALS,MH')THEN FLAG(1)=1. FLAG(2)=1. FLAG(3)=1. CALL LTF3(FLAG,PARAM,PAR1,PAR2,PAR3,CERR,CHI2) ELSEIF(CHKEY(1:LK).EQ.'MT,ALS,LOGMH')THEN FLAG(1)=1. FLAG(2)=1. FLAG(3)=2. PARAM(3)=DLOG10(AMHCOM) CALL LTF3(FLAG,PARAM,PAR1,PAR2,PAR3,CERR,CHI2) ELSE WRITE(6,*)'+LTFIT3: wrong keyword: ',CHKEY(1:LK) GO TO 99 ENDIF PAR1S=PAR1 PAR2S=PAR2 PAR3S=PAR3 EPAR1S=dsqrt(CERR(1,1)) EPAR2S=dsqrt(CERR(2,2)) EPAR3S=dsqrt(CERR(3,3)) DO I=1,3 DO J=1,3 ERR(I,J)=CERR(I,J) ENDDO ENDDO CHI2S=CHI2 NDF=NPLEP-3 IF(PRTFLG(9).ne.0)THEN WRITE(6,10010)CHKEY(1:LK),PAR1S,EPAR1S, 1 PAR2S,EPAR2S,PAR3S,EPAR3S,CHI2S,NDF 10010 FORMAT(1x,'+LTFIT3: ',A10,' = ',f10.4,' +- ',f8.4, 1 ' PAR2= ',F10.4, 1 ' +- ',F8.4,/ 1 ' PAR3= ',F10.4, 1 ' +- ',F8.4,/ 2 ' CHI2= ',E12.5,' NDF',I3) ENDIF 99 CONTINUE END ! LTFIT3 *CMZ : 28/09/98 09.50.07 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.17.43 by A.Rozanov *CMZ : 2.00/01 18/03/98 21.11.42 by A.Rozanov *CMZ : 2.00/00 24/06/97 17.16.18 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.36.27 by A.Rozanov *-- Author : A.Rozanov *------------------------------------------------------------------- SUBROUTINE LTF3(FLAG,PARAM,PAR1,PAR2,PAR3,CERR,CHI2) *------------------------------------------------------------------- *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEEP,mncom. COMMON/MNCOM/MNPRNT,MNREAD,MNUNIT,MNSAVE,EPSMN *KEEP,FITRES. COMMON/FITRES/AMTFIT,AMTERR,AMTEPL,AMTEMI,AMTGLB, 1 ALSFIT,ALSERR,ALSEPL,ALSEMI,ALSGLB, 2 AMHFIT,AMHERR,AMHEPL,AMHEMI,AMHGLB, 3 ALBARFIT,ALBARERR,ALNAREPL,ALBAREMI,ALBARGLB DIMENSION FITPAR(5,4) EQUIVALENCE(AMTFIT,FITPAR) *KEND. EXTERNAL FCNLB CHARACTER*10 PNAM(3) Character*10 CHNAM1,CHNAM2,CHNAM3 PARAMETER (NPT=30) DIMENSION NPRM(3),VSTRT(3),STP(3),ARGLIS(6) DIMENSION PMIN(3),PMAX(3) * DIMENSION X(3),CH2(100,100),FLEPO(NL),AMTLEP(NL),EMTLEP(NL) * DIMENSION EMTPOS(NL),EMTNEG(NL) DIMENSION CERR(3,3),FLAG(3),PARAM(3) DATA NPRM/ 1 , 2 , 3 / DATA PNAM/'MT','ALS','MH'/ DATA ARGLIS/6*0.D0/ * DATA VSTRT/150.D0,0.125D0,300.D0/ DATA STP/10.D0,0.01D0,10.D0/ *-----initialization-------------------------- if(FLAG(3).eq.1.)then PNAM(3)='MH' STP(3)=10.D0 PMIN(3)=5.D0 PMAX(3)=2.D3 elseif(FLAG(3).EQ.2.)then PNAM(3)='LOGMH' STP(3)=1.0D-2 PMIN(3)=0.7D0 PMAX(3)=3.3D0 endif DO I=1,5 DO J=1,4 FITPAR(I,J)=0.D0 ENDDO ENDDO IF(MNUNIT.EQ.-19)THEN OPEN(UNIT=19,STATUS='SCRATCH') ENDIF MNRD=IABS(MNREAD) MNWR=IABS(MNUNIT) * CALL MNINIT(5,19,7) CALL MNINIT(MNRD,MNWR,MNSAVE) IF(MNREAD.LE.0)THEN * Fortran-driven mode of MINUIT VSTRT(1)=PARAM(1) VSTRT(2)=PARAM(2) VSTRT(3)=PARAM(3) CALL MNPARM(1,PNAM(1),VSTRT(1),STP(1),5.D0,1.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 1' ENDIF CALL MNPARM(2,PNAM(2),VSTRT(2),STP(2),0.D0,1.D0,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNPARM(3,PNAM(3),VSTRT(3),STP(3),PMIN(3),PMAX(3),IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 3' ENDIF CALL MNSETI('LEPTOP fit') ARGLIS(1)=0.D0 write(6,*)'before SET BATCH ARGLIS(1)=',ARGLIS CALL MNEXCM(FCNLB,'SET BATCH',ARGLIS,0,IERFLG) *-----switch off the output * ARGLIS(1)=-1.D0 ARGLIS(1)=dfloat(MNPRNT) CALL MNEXCM(FCNLB,'SET PRI',ARGLIS,1,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'+LTF3: UNABLE TO SET PRI',ARGLIS(1) ENDIF ARGLIS(1)=EPSMN CALL MNEXCM(FCNLB,'SET EPS',ARGLIS,1,IERFLG) ARGLIS(1)=1.D0 CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG) FIXED=0.D0 DO IPAR=1,3 FIXED=FIXED+1.D0 IF(FLAG(IPAR).LE.0.D0)THEN ARGLIS(1)=FIXED CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG) ENDIF ENDDO *********************************************** ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SET PRINT',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'MIGRAD',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'HES',ARGLIS,1,IERFLG) * ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SHOW ERR',ARGLIS,0,IERFLG) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,0,IERFLG) *---------------------------------------------------------- ELSEIF(MNREAD.GT.0)THEN * data-driven mode of MINUIT CALL MINUIT(FCNLB,0) ENDIF if(prtflg(2).gt.0.)then CALL PRTERR endif CALL MNSTAT(CHI2,FEDM,ERRDEF,NPARI,NPARX,ISTAT) CALL MNPOUT(1,CHNAM1,PAR1,EPAR1,BND1,BND2,IVARBL) CALL MNERRS(1,PAR1PL,PAR1MI,PAR1PAR,PAR1GLB) CALL MNPOUT(2,CHNAM2,PAR2,EPAR2,BND1,BND2,IVARBL) CALL MNERRS(2,PAR2PL,PAR2MI,PAR2PAR,PAR2GLB) CALL MNPOUT(3,CHNAM3,PAR3,EPAR3,BND1,BND2,IVARBL) CALL MNERRS(3,PAR3PL,PAR3MI,PAR3PAR,PAR3GLB) CALL MNEMAT(CERR,3) AMTFIT=PAR1 AMTERR=PAR1PAR AMTEPL=PAR1PL AMTEMI=PAR1MI AMTGLB=PAR1GLB ALSFIT=PAR2 ALSERR=PAR2PAR ALSEPL=PAR2PL ALSEMI=PAR2MI ALSGLB=PAR2GLB AMHFIT=PAR3 AMHERR=PAR3PAR AMHEPL=PAR3PL AMHEMI=PAR3MI AMHGLB=PAR3GLB if(prtflg(4).gt.0.)then WRITE(6,*)CHNAM1,PAR1,EPAR1 WRITE(6,*)CHNAM2,PAR2,EPAR2 WRITE(6,*)CHNAM3,PAR3,EPAR3 WRITE(6,*)'CERR',CERR WRITE(6,*)'CHI2= ',CHI2 endif 99 CONTINUE ARGLIS(1)=0.D0 CALL MNEXCM(FCNLB,'RESTORE',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'RETURN',ARGLIS,0,IERFLG) if(MNUNIT.eq.-19)CLOSE(19) END *CMZ : 2.00/00 29/01/96 11.33.06 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTUFN96 * * *----------------------------------------------------------------------* * * * Name : LTUFN96 * * (module) * * * * Description : * * calculations for UFN review * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/01/96 * * * * * * Last modifications : * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * double precision H,HM,HA,HR,T,TM,TA,TR double precision amwmz_exp,damwmz_exp,vmexp double precision s2_exp,ds2_exp,vrexp double precision ga_exp,dga_exp,vaexp dimension amt_t(4),damt_t(4),als_t(4),dals_t(4) dimension s2_t(4),ds2_t(4),ds2p_t(4),ds2n_t(4) dimension amw_t(4),damw_t(4),damwp_t(4),damwn_t(4) dimension chi2_t(4),ndf_t(4), 3 amtn_t(4),eamtn_t(4),alsn_t(4),ealsn_t(4), 4 amtp_t(4),eamtp_t(4),alsp_t(4),ealsp_t(4) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) * write(6,*)'Calculate now Vi_exp' call ltfget('VALUE','MWMZ',amwmz) call ltfget('ERROR','MWMZ',damwmz) amwmz_exp=amwmz damwmz_exp=damwmz vm_exp=vmexp(amwmz_exp) dvm_expp=vmexp(amwmz_exp+damwmz_exp)-vm_exp dvm_expn=vmexp(amwmz_exp-damwmz_exp)-vm_exp write(6,*)'amwmz_exp,damwmz_exp',amwmz_exp,damwmz_exp write(6,*)'vm_exp,dvm_expp,dvm_expn',vm_exp,dvm_expp,dvm_expn * * s2_exp = 0.23186D0 ! only LEP * ds2_exp = 0.00034D0 ! only LEP s2_exp = 0.23143D0 ds2_exp = 0.00028D0 vr_exp = vrexp(s2_exp) dvr_expp = vrexp(s2_exp+ds2_exp)-vr_exp dvr_expn = vrexp(s2_exp-ds2_exp)-vr_exp write(6,*)'s2_exp,ds2_exp',s2_exp,ds2_exp write(6,*)'vr_exp,dvr_expp,dvr_expn',vr_exp,dvr_expp,dvr_expn * * ga_exp = -0.50119D0 ! only LEP * dga_exp = 0.00041D0 ! only LEP ga_exp = -0.50111D0 dga_exp = 0.00041D0 va_exp = vaexp(ga_exp) dva_expp = vaexp(ga_exp+dga_exp)-va_exp dva_expn = vaexp(ga_exp-dga_exp)-va_exp write(6,*)'ga_exp,dga_exp',ga_exp,dga_exp write(6,*)'va_exp,dva_expp,dva_expn',va_exp,dva_expp,dva_expn call hlimit(100000) * CALL LTFPUT('BEIJING95','ALL',DUMMY) * CALL LTFUSE('USE','MT') alb=1./128.896 * alb=1./128.87 CALL LTPUT('ALBAR',alb) * CALL LTGET('MZ',AMZ) CALL LTGET('S2',S2) write(6,*)'+LTUFN96: s2=',s2 write(6,*)'AMH H HM(H) HA(H) HR(H)' do imh=-150,1000,50 if(imh.eq.-150)then AMH=0.01 elseif(imh.eq.-100)then AMH=0.1 elseif(imh.eq.-50)then AMH=1. elseif(imh.eq.0)then AMH=10. else AMH=FLOAT(imh) endif H=(AMH/AMZ)**2 HHM=HM(H) HHA=HA(H) HHR=HR(H) write(6,10010)AMH,H,HHM,HHA,HHR 10010 format(1x,f8.2,4f10.3) enddo ! imh * write(6,*)'AMT T TM(T) TA(T) TR(T)' do imt=0,300,10 AMT=FLOAT(imt) T=(AMT/AMZ)**2 TTM=TM(T) TTA=TA(T) TTR=TR(T) write(6,10020)AMT,T,TTM,TTA,TTR 10020 format(1x,f8.0,4f10.3) enddo ! imt *============================================================================ call ltplotvi * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) CALL LTFPUT('BEIJING95','ALL',DUMMY) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttable1(300.,60.,1000.) do imh=1,3 if(imh.eq.1)then AMH=60. elseif(imh.eq.2)then AMH=300. elseif(imh.eq.3)then AMH=1000. endif write(6,*)'amh=',AMH CALL LTPUT('MH',AMH) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) write(6,*)'+LTUFN96: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' als= ',als,' +- ',eals write(6,*)'+LTUFN96: rho,chi2= ',rho,chi2 enddo ! imh * * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) IH=2000 call hbook1(104,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ih+1,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+2,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+3,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.125 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') do imt=1,3 ID=IH+imt if(imt.eq.1)then amtt=150. elseif(imt.eq.2)then amtt=175. elseif(imt.eq.3)then amtt=200. endif eamtt=5. CALL LTFPUT('VALUE','MT',amtt) CALL LTFPUT('ERROR','MT',eamtt) CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(104,float(1+(imt-1)*10),amt) call hf1(104,float(2+(imt-1)*10),alsbar) call hf1(104,float(3+(imt-1)*10),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTUFN96: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTUFN96: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) enddo ! imh CALL LTHROUT * * start calculations for the table of fit results write(6,*)'start calculations for the table of fit results' CALL LTFUSE('NOUSE','MT') * i=1 i=1 CALL LTFUSE('NOUSE','S2NUN') CALL LTFUSE('NOUSE','MWMZ') CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) * i=2 LEP + SLC i=2 CALL LTFUSE('NOUSE','S2NUN') CALL LTFUSE('NOUSE','MWMZ') CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) * i=3 LEP + MW i=3 CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) * i=4 LEP +SLC + MW i=4 CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) write(6,*)'=====================================================' write(6,10100) 10100 format(11x,'LEP',14x,'LEP+SLC',10x,'LEP+MW',11x,'LEP+SLC+MW') write(6,*)'=====================================================' write(6,10110)(amt_t(ip),damt_t(ip),ip=1,4) 10110 format(1x,'mt ',4(f6.1,' +- ',f6.1,1x)) write(6,10111)((amtn_t(ip)-amt_t(ip)),ip=1,4) 10111 format(1x,' 60 ',4(6x,' ',f6.1,1x)) write(6,10112)(amtp_t(ip)-amt_t(ip),ip=1,4) 10112 format(1x,' 1000 ',4(6x,' ',f6.1,1x)) write(6,10120)(als_t(ip),dals_t(ip),ip=1,4) 10120 format(1x,'als ',4(f6.3,' +- ',f6.3,1x)) write(6,10121)(alsn_t(ip)-als_t(ip),ip=1,4) 10121 format(1x,' 60 ',4(6x,' ',f6.3,1x)) write(6,10122)(alsp_t(ip)-als_t(ip),ip=1,4) 10122 format(1x,' 1000',4(6x,' ',f6.3,1x)) write(6,10130)(s2_t(ip),ds2_t(ip),ip=1,4) 10130 format(1x,'s2 ',4(f6.4,' +- ',f6.4,1x)) write(6,10140)(ds2p_t(ip),ip=1,4) write(6,10140)(ds2n_t(ip),ip=1,4) 10140 format(1x,' ',4(10x,f6.4,1x)) write(6,10150)(amw_t(ip),damw_t(ip),ip=1,4) 10150 format(1x,'mw ',4(f6.2,' +- ',f4.2,3x)) write(6,10160)(damwp_t(ip),ip=1,4) write(6,10160)(damwn_t(ip),ip=1,4) 10160 format(1x,' ',4(10x,f4.2,3x)) write(6,10070)(chi2_t(ip),ndf_t(ip),ip=1,4) 10070 format(1x,'chi2/ndf',4(f6.1,' / ',i2,6x)) END ! LTUFN96 *CMZ : 2.00/00 22/06/97 15.02.45 by A.Rozanov *-- Author : A.Rozanov 21/01/96 SUBROUTINE LTHROUT * * *----------------------------------------------------------------------* * * * Name : LTHROUT * * (module) * * * * Description : * * write histograms on disk * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 21/01/96 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *+CDE,TYPING. C ----------- end CDE -------------------------------------------------- * * LU=12 call hropen(LU,'ltfit','leptop.hbook','N',1024,istat) if(istat.ne.0)then write(6,*)'+LTHROUT: error in HROPEN on unit',LU,'istat=',istat endif call hrout(0,icycle,' ') call hrend('ltfit') END ! LTHROUT *CMZ : 01/02/99 18.10.28 by A.Rozanov *CMZ : 2.00/00 23/01/96 20.40.46 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : SUBROUTINE LTPLOTVI DOUBLE PRECISION T,H,ALSBAR,VM,VRL,VAL ALSBAR=0.125D0 call ltget('MZ',AMZ) do ih=1,3 call hbook1(201+10*(IH-1),'Vm(mt)',220,30.,250.,0.) call hbook1(202+10*(IH-1),'Va(mt)',220,30.,250.,0.) call hbook1(203+10*(IH-1),'Vr(mt)',220,30.,250.,0.) call hbook1(204+10*(IH-1),'Veltman',220,30.,250.,0.) enddo DO IAMH=1,3 * IF(IAMH.EQ.1)AMH=60.D0 * IF(IAMH.EQ.2)AMH=300.D0 * IF(IAMH.EQ.3)AMH=1000.D0 IF(IAMH.EQ.1)AMH=100.D0 IF(IAMH.EQ.2)AMH=200.D0 IF(IAMH.EQ.3)AMH=800.D0 DO IAMT=30,250,1 AMT=IAMT T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 VVM=VM(T,H,ALSBAR) VVR=VRL(T,H,ALSBAR) VVA=VAL(T,H,ALSBAR) RAMT=AMT+0.5 * write(6,*)'AMH,AMT,VVM,VVA,VVR',AMH,AMT,VVM,VVA,VVR CALL HF1(201+10*(IAMH-1),RAMT,VVM) CALL HF1(202+10*(IAMH-1),RAMT,VVA) CALL HF1(203+10*(IAMH-1),RAMT,VVR) TS=T CALL HF1(204+10*(IAMH-1),RAMT,TS) ENDDO ENDDO do it=1,3 call hbook1(301+10*(IT-1),'Vm(mh)',100,0.,1000.,0.) call hbook1(302+10*(IT-1),'Va(mh)',100,0.,1000.,0.) call hbook1(303+10*(IT-1),'Vr(mh)',100,0.,1000.,0.) enddo DO IAMT=1,3 IF(IAMT.EQ.1)AMT=140.D0 IF(IAMT.EQ.2)AMT=180.D0 IF(IAMT.EQ.3)AMT=220.D0 DO IAMH=0,1000,10 AMH=IAMH T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 VVM=VM(T,H,ALSBAR) VVR=VRL(T,H,ALSBAR) VVA=VAL(T,H,ALSBAR) RAMH=AMH+0.5 * write(6,*)'AMH,AMT,VVM,VVA,VVR',AMH,AMT,VVM,VVA,VVR CALL HF1(301+10*(IAMT-1),RAMH,VVM) CALL HF1(302+10*(IAMT-1),RAMH,VVA) CALL HF1(303+10*(IAMT-1),RAMH,VVR) ENDDO ENDDO END *CMZ : 2.00/00 25/01/96 10.00.49 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION vmexp(AMWMZ) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. C=DSQRT(C2) * AMWMZ=C+(3*C*ALBAR*VMTHA)/(32*PI*S2*(C2-S2)) vmexp=(AMWMZ-C)*(32*PI*S2*(C2-S2))/(3*C*ALBAR) END *CMZ : 2.00/00 24/01/96 22.04.50 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION vrexp(QFB) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. *-----QFB=0.25*(1.-GV/GA) * QFB=S2-(3*ALBAR*VRL(T,H,ALSBAR))/(16*PI*(C2-S2)) vrexp=(S2-QFB)*(16*PI*(C2-S2))/(3*ALBAR) END *CMZ : 2.00/00 25/01/96 10.01.11 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION vaexp(GA) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. DATA T3/-0.5/ * GA=T3*(1.+(3*ALBAR*VAL(T,H,ALSBAR))/(32*PI*S2*C2)) vaexp=(GA-T3)*(32*PI*S2*C2)/(3*ALBAR*T3) END *CMZ : 2.00/00 25/01/96 18.44.14 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : FUNCTION ALR_FRS2(SIN2) *-----left-right asymmetry for SLD *-----s2=0.25*(1.-GV/GA) *-----sin2=S2-(3*ALBAR*VRL(T,H,ALSBAR))/(16*PI*(C2-S2)) alr_frs2=(2*(1.-4.*sin2))/(1+(1.-4*sin2)**2) END *CMZ : 2.00/00 25/01/96 18.43.25 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : FUNCTION S2_FRALR(ALR) *-----left-right asymmetry for SLD *-----sin2=0.25*(1.-GV/GA) *-----sin2=S2-(3*ALBAR*VRL(T,H,ALSBAR))/(16*PI*(C2-S2)) *-----alr=(2*(1.-4.*sin2))/(1+(1.-4*sin2)**2) xalr=(1.D0-dsqrt(1.D0-alr**2))/alr s2_fralr=(1.D0-xalr)/4.D0 END *CMZ : 14/01/99 19.09.53 by A.Rozanov *CMZ : 2.00/00 26/01/96 09.03.02 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION AB(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEND. DATA T3/-0.5/ DATA QF/0.33333333333333/ VAF=VAD(T,H,ALSBAR) VRF=VRD(T,H,ALSBAR) GA=T3*(1.+(3*ALBAR*VAF)/(32*PI*S2*C2)) * correction by van 09.11.93 : DGVBB=DGVB(T,ALSBAR) DGABB=DGAB(T,ALSBAR) GGG=G(T,ALSBAR) * BR0=1+(DGVBB-DGABB)/(2.*GGG) ! corrected VAN 22.12.93 BR0=1. BR1=(1-4*QF*S2)*BR0 BR2=(3*ALBAR*QF*VRF)/(4*PI*(C2-S2)) *-----special phia(t) for amplitude * BR3=-(ALBAR*s2*PHIA(T,H,ALSBAR))/(3.*PI*(3.-2.*s2)) * 27.06.94 D.Bardin sujest to go back to phi(t) * cpommon opinion of e.w.g., m.vysotsky does not reject it BR3=- ALBAR*s2*(PHI(T,H,ALSBAR)+DPHI(T,H,ALSBAR)) 1 /(3.*PI*(3.-2.*s2)) GV=GA*(BR1+BR2+BR3) AF=2*GA*GV*VELOB/((3.-VELOB**2)*0.5*GV**2+(VELOB*GA)**2) AB=AF IF(PRTFLG(1).GT.0.)THEN WRITE(6,*)'++AB: DGVBB,DGABB,GGG,BR0', 1 DGVBB,DGABB,GGG,BR0 WRITE(6,*)'++AB: T,H,ALSBAR', 1 T,H,ALSBAR WRITE(6,*)'BR1,BR2,BR3,GV,GA', 1 BR1,BR2,BR3,GV,GA WRITE(6,*)'VAF,VRF,AF,AB', 1 VAF,VRF,AF,AB ENDIF END *CMZ : 20/01/99 17.12.00 by A.Rozanov *CMZ : 2.00/00 28/01/96 14.50.28 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE lttab2(amt,eamt,als,eals, 1 sin2te,dsin2te,dsin2tep,dsin2ten, 2 amw,damw,damwp,damwn,chi2,ndf, 3 amtn,eamtn,alsn,ealsn,amtp,eamtp,alsp,ealsp) * * *----------------------------------------------------------------------* * * * Name : LTTAB2 * * (module) * * * * Description : * * calculations for UFN review * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/01/96 * * * * * * Last modifications : * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * CALL LTGET('MZ',amz) AMH=300. write(6,*)'+LTTAB2: amh=',AMH CALL LTPUT('MH',AMH) call ltinit(1) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) write(6,*)'+LTTAB2: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' als= ',als,' +- ',eals CALL LTPUT('MT',amt) CALL LTPUT('ALSHAT',als) CALL LTGET('QFB',sin2te) CALL LTGET('MWMZ',amwmz) * CALL LTGET('ALBAR',albar0) ealbar=albar0-1./(1./albar0+0.090) write(6,*)'+LTTAB2: albar0,ealbar=',albar0,ealbar CALL LTERR('QFB',eamt,eals,0.,ealbar,dsin2te) CALL LTERR('MWMZ',eamt,eals,0.,ealbar,damwmz) AMH=60. CALL LTPUT('MH',AMH) call ltinit(1) CALL LTFIT2('MT,ALS',amtn,alsn,eamtn,ealsn,rhon,chi2n,ndfn) CALL LTPUT('MT',amtn) CALL LTPUT('ALSHAT',alsn) CALL LTGET('QFB',sin2ten) dsin2ten=sin2ten-sin2te CALL LTGET('MWMZ',amwmzn) amw=amwmz*amz damw=damwmz*amz damwn=amwmzn*amz-amw AMH=1000. CALL LTPUT('MH',AMH) call ltinit(1) CALL LTFIT2('MT,ALS',amtp,alsp,eamtp,ealsp,rhop,chi2p,ndfp) CALL LTPUT('MT',amtp) CALL LTPUT('ALSHAT',alsp) CALL LTGET('QFB',sin2tep) dsin2tep=sin2tep-sin2te CALL LTGET('MWMZ',amwmzp) damwp=amwmzp*amz-amw write(6,*)'+LTTAB2: rho,chi2= ',rho,chi2 END ! LTTAB2 *CMZ : 2.00/00 05/02/96 15.54.14 by A.Rozanov *-- Author : A.Rozanov 20/01/96 SUBROUTINE LTTABLE1(AMH,AMHMIN,AMHMAX) * * *----------------------------------------------------------------------* * * * Name : LTTABLE1 * * (module) * * * * Description : * * calculate table of boservables with predictions * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMHMIN - in - minimum value of Higgs mass * * AMHMAX - in - maximum value of Higgs mass * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 20/01/96 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. parameter (nexp=17) character*5 keyval,key,keypred dimension keyval(nexp),keypred(nexp) data keyval /'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'RBSLC','ABSLC','ACSLC','MWMZ','S2NUN'/ data keypred/'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'RB','AB','AC','MWMZ','S2NUN'/ dimension vexp(nexp),eexp(nexp),vthe(nexp),ethe(nexp), 1 epmh(nexp),enmh(nexp),pull(nexp) C ----------- end CDE -------------------------------------------------- call ltget('MZ',amz) write(6,*) 1'obs vexp eexp vthe ethe epmh enmh pull' do i=1,nexp call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) * call ltput('MH',AMH) call ltfit2('MT,ALS',amt,als,eamt,eals,corr,chi2,ndf) call ltput('MT',amt) call ltput('ALSHAT',als) call ltget(keypred(i),vthe(i)) * call ltput('MH',AMHMIN) call ltfit2('MT,ALS',amtmi,alsmi,eamtmi,ealsmi,corr,chi2,ndf) call ltput('MT',amtmi) call ltput('ALSHAT',alsmi) call ltget(keypred(i),vthemi) enmh(i)=vthemi-vthe(i) * call ltput('MH',AMHMAX) call ltfit2('MT,ALS',amtma,alsma,eamtma,ealsma,corr,chi2,ndf) call ltput('MT',amtma) call ltput('ALSHAT',alsma) call ltget(keypred(i),vthema) epmh(i)=vthema-vthe(i) * ealbar=1./128.896-1./(128.896+0.090) call lterr(keypred(i),eamt,eals,0.,ealbar,ethe(i)) pull(i)=(vexp(i)-vthe(i))/eexp(i) key=keypred(i) if(key(1:4).eq.'MWMZ')then vexp(i)=vexp(i)*AMZ eexp(i)=eexp(i)*AMZ vthe(i)=vthe(i)*AMZ ethe(i)=ethe(i)*AMZ epmh(i)=epmh(i)*AMZ enmh(i)=enmh(i)*AMZ endif if(key(1:3).eq.'ALR')then s2alr=s2_fralr(vexp(i)) es2alr= 1 abs(0.5*(s2_fralr(vexp(i)+eexp(i))-s2_fralr(vexp(i)-eexp(i)))) s2alrt=s2_fralr(vthe(i)) es2alrt= 1 abs(0.5*(s2_fralr(vthe(i)+ethe(i))-s2_fralr(vthe(i)-ethe(i)))) ens2alr=-s2alrt+s2_fralr(vthemi) eps2alr=-s2alrt+s2_fralr(vthema) pullalr=(s2alr-s2alrt)/es2alr write(6,10010)'s2ALR',s2alr,es2alr,s2alrt,es2alrt, 1 eps2alr,ens2alr,pullalr endif write(6,10010)keyval(i),vexp(i),eexp(i),vthe(i),ethe(i), 1 epmh(i),enmh(i),pull(i) 10010 format(1x,a5,4f10.4,2f7.4,f5.1) enddo * * END ! LTTABLE1 *CMZ : 2.00/00 29/01/96 11.40.13 by A.Rozanov *-- Author : A.Rozanov 20/01/96 SUBROUTINE LTTABLE1_bac(AMH,AMHMIN,AMHMAX) * * *----------------------------------------------------------------------* * * * Name : LTTABLE * * (module) * * * * Description : * * calculate table of boservables with predictions * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMHMIN - in - minimum value of Higgs mass * * AMHMAX - in - maximum value of Higgs mass * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 20/01/96 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. parameter (nexp=17) character*5 keyval,key,keypred dimension keyval(nexp),keypred(nexp) data keyval /'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'RBSLC','ABSLC','ACSLC','MWMZ','S2NUN'/ data keypred/'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'RB','AB','AC','MWMZ','S2NUN'/ dimension vexp(nexp),eexp(nexp),vthe(nexp),ethe(nexp), 1 epmh(nexp),enmh(nexp),pull(nexp) C ----------- end CDE -------------------------------------------------- call ltget('MZ',amz) write(6,*) 1'obs vexp eexp vthe ethe epmh enmh pull' do i=1,nexp call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) * call ltput('MH',AMH) call ltfit2('MT,ALS',amt,als,eamt,eals,corr,chi2,ndf) call ltput('MT',amt) call ltput('ALSHAT',als) call ltget(keypred(i),vthe(i)) * call ltput('MH',AMHMIN) call ltfit2('MT,ALS',amtmi,alsmi,eamtmi,ealsmi,corr,chi2,ndf) call ltput('MT',amtmi) call ltput('ALSHAT',alsmi) call ltget(keypred(i),vthemi) enmh(i)=vthemi-vthe(i) * call ltput('MH',AMHMAX) call ltfit2('MT,ALS',amtma,alsma,eamtma,ealsma,corr,chi2,ndf) call ltput('MT',amtma) call ltput('ALSHAT',alsma) call ltget(keypred(i),vthema) epmh(i)=vthema-vthe(i) * ealbar=1./128.896-1./(128.896+0.090) call lterr(keypred(i),eamt,eals,0.,ealbar,ethe(i)) pull(i)=(vexp(i)-vthe(i))/eexp(i) key=keypred(i) if(key(1:4).eq.'MWMZ')then vexp(i)=vexp(i)*AMZ eexp(i)=eexp(i)*AMZ vthe(i)=vthe(i)*AMZ ethe(i)=ethe(i)*AMZ epmh(i)=epmh(i)*AMZ enmh(i)=enmh(i)*AMZ endif if(key(1:3).eq.'ALR')then s2alr=s2_fralr(vexp(i)) es2alr= 1 abs(0.5*(s2_fralr(vexp(i)+eexp(i))-s2_fralr(vexp(i)-eexp(i)))) s2alrt=s2_fralr(vthe(i)) es2alrt= 1 abs(0.5*(s2_fralr(vthe(i)+ethe(i))-s2_fralr(vthe(i)-ethe(i)))) ens2alr=s2alrt-s2_fralr(vthemi) eps2alr=s2alrt-s2_fralr(vthema) write(6,10010)'s2ALR',s2alr,es2alr,s2alrt,es2alrt, 1 eps2alr,ens2alr,pull(i) endif write(6,10010)keyval(i),vexp(i),eexp(i),vthe(i),ethe(i), 1 epmh(i),enmh(i),pull(i) 10010 format(1x,a5,4f10.4,2f7.4,f5.1) enddo * * END ! LTTABLE *CMZ : 2.00/02 03/07/98 19.14.56 by A.Rozanov *CMZ : 2.00/00 27/02/96 17.03.05 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTELLIS96 * * *----------------------------------------------------------------------* * * * Name : LTELLIS96 * * (module) * * * * Description : * * calculations for comparison with CERN-TH/95-202 * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 27/02/96 * * * * * * Last modifications : * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * * call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) CALL LTFPUT('BEIJING95','ALL',DUMMY) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) * * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) IH=2000 call hbook1(104,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ih+1,'Mt-Mh no FNAL',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+2,'Mt-Mh with FNAL',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+3,'Mt-Mh nFNAL,0.117',100,50.,250.,100,0.,1000.,0) call hbook2(ih+4,'Mt-Mh FNAL,0.117',100,50.,250.,100,0.,1000.,0) ALSBAR=0.124 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) do imt=1,4 ID=IH+imt if(imt.eq.1)then CALL LTFUSE('NOUSE','MT') elseif(imt.eq.2)then CALL LTFUSE('USE','MT') elseif(imt.eq.3)then CALL LTFUSE('NOUSE','MT') ALSBAR=0.117 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) elseif(imt.eq.4)then CALL LTFUSE('USE','MT') ALSBAR=0.117 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) endif CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(104,float(1+(imt-1)*10),amt) call hf1(104,float(2+(imt-1)*10),alsbar) call hf1(104,float(3+(imt-1)*10),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTUFN96: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTUFN96: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) enddo ! imt CALL LTHROUT * END ! LTELLIS96 *CMZ : 2.00/02 03/07/98 18.19.45 by A.Rozanov *CMZ : 2.00/00 08/06/96 16.47.42 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTVERTEX96 * * *----------------------------------------------------------------------* * * * Name : LTVERTEX96 * * (module) * * * * Description : * * calculations for VERTEX96 conference * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 27/02/96 * * * * * * Last modifications : * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * * call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) CALL LTFPUT('MORIOND96','ALL',DUMMY) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) * * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) IH=2000 call hbook1(104,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ih+1,'Mt-Mh no FNAL',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+2,'Mt-Mh with FNAL',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+3,'Mt-Mh nFNAL,0.117',100,50.,250.,100,0.,1000.,0) call hbook2(ih+4,'Mt-Mh FNAL,0.117',100,50.,250.,100,0.,1000.,0) ALSBAR=0.124 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) do imt=1,4 ID=IH+imt if(imt.eq.1)then CALL LTFUSE('NOUSE','MT') elseif(imt.eq.2)then CALL LTFUSE('USE','MT') elseif(imt.eq.3)then CALL LTFUSE('NOUSE','MT') ALSBAR=0.117 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) elseif(imt.eq.4)then CALL LTFUSE('USE','MT') ALSBAR=0.117 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) endif CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(104,float(1+(imt-1)*10),amt) call hf1(104,float(2+(imt-1)*10),alsbar) call hf1(104,float(3+(imt-1)*10),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTUFN96: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTUFN96: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) enddo ! imt CALL LTHROUT * END ! LTVERTEX96 *CMZ : 2.00/00 23/06/97 11.09.11 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTYAD97 * * *----------------------------------------------------------------------* * * * Name : LTYAD97 * * (module) * * * * Description : * * calculations for Yadernaia Fizika review * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 16/04/97 * * * * * * Last modifications : * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * double precision H,HM,HA,HR,T,TM,TA,TR double precision amwmz_exp,damwmz_exp,vmexp double precision s2_exp,ds2_exp,vrexp double precision ga_exp,dga_exp,vaexp dimension amt_t(4),damt_t(4),als_t(4),dals_t(4) dimension s2_t(4),ds2_t(4),ds2p_t(4),ds2n_t(4) dimension amw_t(4),damw_t(4),damwp_t(4),damwn_t(4) dimension chi2_t(4),ndf_t(4), 3 amtn_t(4),eamtn_t(4),alsn_t(4),ealsn_t(4), 4 amtp_t(4),eamtp_t(4),alsp_t(4),ealsp_t(4) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) * write(6,*)'Calculate now Vi_exp' call ltfget('VALUE','MWMZ',amwmz) call ltfget('ERROR','MWMZ',damwmz) amwmz_exp=amwmz damwmz_exp=damwmz vm_exp=vmexp(amwmz_exp) dvm_expp=vmexp(amwmz_exp+damwmz_exp)-vm_exp dvm_expn=vmexp(amwmz_exp-damwmz_exp)-vm_exp write(6,*)'amwmz_exp,damwmz_exp',amwmz_exp,damwmz_exp write(6,*)'vm_exp,dvm_expp,dvm_expn',vm_exp,dvm_expp,dvm_expn * * s2_exp = 0.23186D0 ! only LEP * ds2_exp = 0.00034D0 ! only LEP s2_exp = 0.23143D0 ds2_exp = 0.00028D0 vr_exp = vrexp(s2_exp) dvr_expp = vrexp(s2_exp+ds2_exp)-vr_exp dvr_expn = vrexp(s2_exp-ds2_exp)-vr_exp write(6,*)'s2_exp,ds2_exp',s2_exp,ds2_exp write(6,*)'vr_exp,dvr_expp,dvr_expn',vr_exp,dvr_expp,dvr_expn * * ga_exp = -0.50119D0 ! only LEP * dga_exp = 0.00041D0 ! only LEP ga_exp = -0.50111D0 dga_exp = 0.00041D0 va_exp = vaexp(ga_exp) dva_expp = vaexp(ga_exp+dga_exp)-va_exp dva_expn = vaexp(ga_exp-dga_exp)-va_exp write(6,*)'ga_exp,dga_exp',ga_exp,dga_exp write(6,*)'va_exp,dva_expp,dva_expn',va_exp,dva_expp,dva_expn call hlimit(100000) * CALL LTFPUT('BEIJING95','ALL',DUMMY) * CALL LTFUSE('USE','MT') alb=1./128.896 * alb=1./128.87 CALL LTPUT('ALBAR',alb) * CALL LTGET('MZ',AMZ) CALL LTGET('S2',S2) write(6,*)'+LTYAD97: s2=',s2 write(6,*)'AMH H HM(H) HA(H) HR(H)' do imh=-150,1000,50 if(imh.eq.-150)then AMH=0.01 elseif(imh.eq.-100)then AMH=0.1 elseif(imh.eq.-50)then AMH=1. elseif(imh.eq.0)then AMH=10. else AMH=FLOAT(imh) endif H=(AMH/AMZ)**2 HHM=HM(H) HHA=HA(H) HHR=HR(H) write(6,10010)AMH,H,HHM,HHA,HHR 10010 format(1x,f8.2,4f10.3) enddo ! imh * write(6,*)'AMT T TM(T) TA(T) TR(T)' do imt=0,300,10 AMT=FLOAT(imt) T=(AMT/AMZ)**2 TTM=TM(T) TTA=TA(T) TTR=TR(T) write(6,10020)AMT,T,TTM,TTA,TTR 10020 format(1x,f8.0,4f10.3) enddo ! imt *============================================================================ call ltplotvi * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) CALL LTFPUT('MORIOND97','ALL',DUMMY) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttable1(300.,60.,1000.) do imh=1,3 if(imh.eq.1)then AMH=60. elseif(imh.eq.2)then AMH=300. elseif(imh.eq.3)then AMH=1000. endif write(6,*)'amh=',AMH CALL LTPUT('MH',AMH) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) write(6,*)'+LTYAD97: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' als= ',als,' +- ',eals write(6,*)'+LTYAD97: rho,chi2= ',rho,chi2 enddo ! imh * * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * fit standard mt-mh plot first IH=4000 ID=IH+1 call hbook1(404,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ID,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.120 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(404,float(1),amt) call hf1(404,float(2),alsbar) call hf1(404,float(3),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTYAD97: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTYAD97: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) * make special fits with "future" measurements of Mt IH=2000 call hbook1(104,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ih+1,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+2,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+3,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.125 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') do imt=1,3 ID=IH+imt if(imt.eq.1)then amtt=150. elseif(imt.eq.2)then amtt=175. elseif(imt.eq.3)then amtt=200. endif eamtt=5. CALL LTFPUT('VALUE','MT',amtt) CALL LTFPUT('ERROR','MT',eamtt) CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(104,float(1+(imt-1)*10),amt) call hf1(104,float(2+(imt-1)*10),alsbar) call hf1(104,float(3+(imt-1)*10),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTYAD97: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTYAD97: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) enddo ! imh CALL LTHROUT * * start calculations for the table of fit results write(6,*)'start calculations for the table of fit results' CALL LTFUSE('NOUSE','MT') * i=1 i=1 CALL LTFUSE('NOUSE','S2NUN') CALL LTFUSE('NOUSE','MWMZ') CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) * i=2 LEP + SLC i=2 CALL LTFUSE('NOUSE','S2NUN') CALL LTFUSE('NOUSE','MWMZ') CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) * i=3 LEP + MW i=3 CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) * i=4 LEP +SLC + MW i=4 CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) write(6,*)'=====================================================' write(6,10100) 10100 format(11x,'LEP',14x,'LEP+SLC',10x,'LEP+MW',11x,'LEP+SLC+MW') write(6,*)'=====================================================' write(6,10110)(amt_t(ip),damt_t(ip),ip=1,4) 10110 format(1x,'mt ',4(f6.1,' +- ',f6.1,1x)) write(6,10111)((amtn_t(ip)-amt_t(ip)),ip=1,4) 10111 format(1x,' 60 ',4(6x,' ',f6.1,1x)) write(6,10112)(amtp_t(ip)-amt_t(ip),ip=1,4) 10112 format(1x,' 1000 ',4(6x,' ',f6.1,1x)) write(6,10120)(als_t(ip),dals_t(ip),ip=1,4) 10120 format(1x,'als ',4(f6.3,' +- ',f6.3,1x)) write(6,10121)(alsn_t(ip)-als_t(ip),ip=1,4) 10121 format(1x,' 60 ',4(6x,' ',f6.3,1x)) write(6,10122)(alsp_t(ip)-als_t(ip),ip=1,4) 10122 format(1x,' 1000',4(6x,' ',f6.3,1x)) write(6,10130)(s2_t(ip),ds2_t(ip),ip=1,4) 10130 format(1x,'s2 ',4(f6.4,' +- ',f6.4,1x)) write(6,10140)(ds2p_t(ip),ip=1,4) write(6,10140)(ds2n_t(ip),ip=1,4) 10140 format(1x,' ',4(10x,f6.4,1x)) write(6,10150)(amw_t(ip),damw_t(ip),ip=1,4) 10150 format(1x,'mw ',4(f6.2,' +- ',f4.2,3x)) write(6,10160)(damwp_t(ip),ip=1,4) write(6,10160)(damwn_t(ip),ip=1,4) 10160 format(1x,' ',4(10x,f4.2,3x)) write(6,10070)(chi2_t(ip),ndf_t(ip),ip=1,4) 10070 format(1x,'chi2/ndf',4(f6.1,' / ',i2,6x)) END ! LTYAD97 *CMZ : 2.00/02 03/07/98 18.20.31 by A.Rozanov *CMZ : 2.00/01 13/09/97 10.03.55 by A.Rozanov *CMZ : 2.00/00 24/06/97 18.51.22 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 24/06/97 SUBROUTINE LTVYS97 * * *----------------------------------------------------------------------* * * * Name : LTYAD97 * * (module) * * * * Description : * * calculations for Misha Vysotsky * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 24/06/97 * * * * * * Last modifications : 02/07/97 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * dimension e3(3,3),e4(4,4),alogmhv(20),chi2v(20) * * * initialisation CALL LTINIT(0) CALL LTFPUT('MORIALL97','ALL',DUMMY) * call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) CALL LTFLAG('MNUNIT',6) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriall97, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') go to 1001 1002 continue * fit standard mt-mh plot first IH=4000 ID=IH+1 call hbook1(404,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ID,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.118 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(404,float(1),amt) call hf1(404,float(2),alsbar) call hf1(404,float(3),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTVYS97: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTVYS97: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) CALL LTHROUT 1001 continue do il=1,3 if(il.eq.1)then albar=1./128.896 elseif(il.eq.2)then albar=1./(128.896-0.090) elseif(il.eq.3)then albar=1./(128.896+0.090) endif write(6,*)'1/albar=',1./albar call LTPUT('ALBAR',albar) CALL LTINIT(1) CALL LTFIT3('MT,ALS,LOGMH',amt,als,alogmh,eamt,eals,ealogmh, 1 e3,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh write(6,10020)amt,emtpos,emtneg,amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,als,eals 10020 format('+LTVYS97: mt= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,/ 1 ' als= ',f7.5,' +- ',f7.5) write(6,*)'+LTVYS97: chi2= /ndf ',chi2,ndf enddo ! il * 1000 continue write(6,*)'Four parameter fit ===========================' do ifit=1,4 CALL LTINIT(0) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriall97, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') write(6,*)'ifit=',ifit if(ifit.eq.1)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','ALBAR') write(6,*)'No als, no albar' elseif(ifit.eq.2)then CALL LTFUSE('USE','ALS') CALL LTFUSE('NOUSE','ALBAR') write(6,*)'Yes als, no albar' elseif(ifit.eq.3)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALBAR') write(6,*)'No als, yes albar' elseif(ifit.eq.4)then CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALBAR') write(6,*)'Yes als, yes albar' endif CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfit, 1 eamt,eals,ealogmh,ealbfit, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfit1=albfit ealbfit1=ealbfit ealbfit4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfit1,ealbfit1,ealbfit4 10030 format('+LTVYS97: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,' +- ',f7.3,f7.3) write(6,*)'+LTVYS97: chi2/ndf= ',chi2,ndf enddo ! ifit * make the chi2 curve vs mH by 3-par fits for each mH alogmhbest=alogmh do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfit, 1 eamt,eals,eamh,ealbfit, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863+0.0019) CALL LTINIT(1) write(6,*)'MZ mass up by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfit, 1 eamt,eals,eamh,ealbfit, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863-0.0019) CALL LTINIT(1) write(6,*)'MZ mass down by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfit, 1 eamt,eals,eamh,ealbfit, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' *========================================================================== END ! LTVYS97 *CMZ : 09/11/99 19.18.09 by A.Rozanov *CMZ : 2.00/01 28/07/97 23.20.50 by A.Rozanov *CMZ : 2.00/00 24/06/97 17.03.06 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.42.02 by A.Rozanov *CMZ : 1.30/08 22/02/95 21.45.15 by A.Rozanov *CMZ : 1.30/07 17/02/95 22.19.11 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTFIT4(CHKEY,PAR1S,PAR2S,PAR3S,PAR4S, 1 EPAR1S,EPAR2S,EPAR3S,EPAR4S, 2 ERR,CHI2S,NDF) * * *----------------------------------------------------------------------* * * * Name : LTFIT4 * * (module) * * * * Description : * * fit four parameters * * MT,ALSBAR,Mh,Albar from experimental data * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 26/06/97 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * LTINIT, LTGET, LTFIT4 *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEND. DIMENSION CERR(4,4),FLAG(4),PARAM(4),ERR(4,4) REAL*4 PAR1S,PAR2S,PAR3S,PAR4S,EPAR1S,EPAR2S,EPAR3S,EPAR4S REAL*4 ERR,CHI2S * * CHARACTER*(*) CHKEY * * LK=LEN(CHKEY) PARAM(1)=AMTCOM PARAM(2)=ALSCOM PARAM(3)=AMHCOM PARAM(4)=1.D0/ALBAR FLAG(1)=0. FLAG(2)=0. FLAG(3)=0. FLAG(4)=0. IF(CHKEY(1:LK).EQ.'MT,ALS,MH,ALBAR')THEN FLAG(1)=1. FLAG(2)=1. FLAG(3)=1. FLAG(3)=1. CALL LTF4(FLAG,PARAM,PAR1,PAR2,PAR3,PAR4,CERR,CHI2) ELSEIF(CHKEY(1:LK).EQ.'MT,ALS,LOGMH,ALBAR')THEN FLAG(1)=1. FLAG(2)=1. FLAG(3)=2. FLAG(4)=1. PARAM(3)=DLOG10(AMHCOM) CALL LTF4(FLAG,PARAM,PAR1,PAR2,PAR3,PAR4,CERR,CHI2) ELSEIF(CHKEY(1:LK).EQ.'MT,ALS,ALBAR')THEN FLAG(1)=1. FLAG(2)=1. FLAG(3)=0. FLAG(4)=1. CALL LTF4(FLAG,PARAM,PAR1,PAR2,PAR3,PAR4,CERR,CHI2) ELSEIF(CHKEY(1:LK).EQ.'MT,ALS,LOGMH')THEN FLAG(1)=1. FLAG(2)=1. FLAG(3)=2. FLAG(4)=0. PARAM(3)=DLOG10(AMHCOM) CALL LTF4(FLAG,PARAM,PAR1,PAR2,PAR3,PAR4,CERR,CHI2) ELSE WRITE(6,*)'+LTFIT4: wrong keyword: ',CHKEY(1:LK) GO TO 99 ENDIF PAR1S=PAR1 PAR2S=PAR2 PAR3S=PAR3 PAR4S=PAR4 EPAR1S=dsqrt(CERR(1,1)) EPAR2S=dsqrt(CERR(2,2)) EPAR3S=dsqrt(CERR(3,3)) EPAR4S=dsqrt(CERR(4,4)) DO I=1,4 DO J=1,4 ERR(I,J)=CERR(I,J) ENDDO ENDDO CHI2S=CHI2 IF(CHKEY(1:LK).EQ.'MT,ALS,MH,ALBAR')THEN NDF=NPLEP-4 ELSEIF(CHKEY(1:LK).EQ.'MT,ALS,LOGMH,ALBAR')THEN NDF=NPLEP-4 ELSEIF(CHKEY(1:LK).EQ.'MT,ALS,ALBAR')THEN NDF=NPLEP-3 ELSEIF(CHKEY(1:LK).EQ.'MT,ALS,LOGMH')THEN NDF=NPLEP-3 ELSE WRITE(6,*)'+LTFIT4: wrong keyword: ',CHKEY(1:LK) GO TO 99 ENDIF IF(PRTFLG(9).ne.0)THEN WRITE(6,10010)CHKEY(1:LK),PAR1S,EPAR1S, 1 PAR2S,EPAR2S,PAR3S,EPAR3S,PAR4S,EPAR4S,CHI2S,NDF 10010 FORMAT(1x,'+LTFIT3: ',A10,' = ',f10.4,' +- ',f8.4, 1 ' PAR2= ',F10.4, 1 ' +- ',F8.4,/ 1 ' PAR3= ',F10.4, 1 ' +- ',F8.4,/ 1 ' PAR4= ',F10.4, 1 ' +- ',F8.4,/ 2 ' CHI2= ',E12.5,' NDF',I3) ENDIF 99 CONTINUE END ! LTFIT4 *CMZ : 09/11/99 19.17.46 by A.Rozanov *CMZ : 2.00/02 03/07/98 18.39.38 by A.Rozanov *CMZ : 2.00/01 18/07/97 19.58.44 by A.Rozanov *CMZ : 2.00/00 24/06/97 17.16.18 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.36.27 by A.Rozanov *-- Author : A.Rozanov *------------------------------------------------------------------- SUBROUTINE LTF4(FLAG,PARAM,PAR1,PAR2,PAR3,PAR4,CERR,CHI2) *------------------------------------------------------------------- *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,LEPFIT. PARAMETER (NL=25) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) *KEEP,mncom. COMMON/MNCOM/MNPRNT,MNREAD,MNUNIT,MNSAVE,EPSMN *KEEP,FITRES. COMMON/FITRES/AMTFIT,AMTERR,AMTEPL,AMTEMI,AMTGLB, 1 ALSFIT,ALSERR,ALSEPL,ALSEMI,ALSGLB, 2 AMHFIT,AMHERR,AMHEPL,AMHEMI,AMHGLB, 3 ALBARFIT,ALBARERR,ALNAREPL,ALBAREMI,ALBARGLB DIMENSION FITPAR(5,4) EQUIVALENCE(AMTFIT,FITPAR) *KEND. EXTERNAL FCNLB CHARACTER*10 PNAM(4) Character*10 CHNAM1,CHNAM2,CHNAM3,CHNAM4 PARAMETER (NPT=30) DIMENSION NPRM(4),VSTRT(4),STP(4),ARGLIS(6) DIMENSION PMIN(4),PMAX(4) * DIMENSION X(4),CH2(100,100),FLEPO(NL),AMTLEP(NL),EMTLEP(NL) * DIMENSION EMTPOS(NL),EMTNEG(NL) DIMENSION CERR(4,4),FLAG(4),PARAM(4) DATA NPRM/ 1 , 2 , 3, 4 / DATA PNAM/'MT','ALS','MH','ALBAR-1'/ * DATA VSTRT/150.D0,0.125D0,300.D0,1./128.896D0/ DATA STP/10.D0,0.01D0,10.D0,1.D-2/ *-----initialization-------------------------- if(FLAG(3).eq.1.)then PNAM(3)='MH' STP(3)=10.D0 PMIN(3)=5.D0 PMAX(3)=2.D3 elseif(FLAG(3).EQ.2.)then PNAM(3)='LOGMH' STP(3)=1.0D-2 PMIN(3)=0.7D0 PMAX(3)=3.3D0 endif PMIN(4)=128.896D0-10.D0*0.090D0 PMAX(4)=128.896D0+10.D0*0.090D0 DO I=1,5 DO J=1,4 FITPAR(I,J)=0.D0 ENDDO ENDDO IF(MNUNIT.EQ.-19)THEN OPEN(UNIT=19,STATUS='SCRATCH') ENDIF MNRD=IABS(MNREAD) MNWR=IABS(MNUNIT) * CALL MNINIT(5,19,7) ***DEBUG!!!!!!!!!!!!!!!!!!!!!!!! * MNWR=6 CALL MNINIT(MNRD,MNWR,MNSAVE) IF(MNREAD.LE.0)THEN * Fortran-driven mode of MINUIT VSTRT(1)=PARAM(1) VSTRT(2)=PARAM(2) VSTRT(3)=PARAM(3) VSTRT(4)=PARAM(4) CALL MNPARM(1,PNAM(1),VSTRT(1),STP(1),5.D0,1.D3,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 1' ENDIF CALL MNPARM(2,PNAM(2),VSTRT(2),STP(2),0.D0,1.D0,IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 2' ENDIF CALL MNPARM(3,PNAM(3),VSTRT(3),STP(3),PMIN(3),PMAX(3),IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 3' ENDIF CALL MNPARM(4,PNAM(4),VSTRT(4),STP(4),PMIN(4),PMAX(4),IERFLG) IF(IERFLG.NE.0)THEN WRITE(6,*)'UNABLE TO DEFINE PARAMETER 4' ENDIF CALL MNSETI('LEPTOP fit') * ARGLIS(1)=0.D0 * CALL MNEXCM(FCNLB,'SET BAT',ARGLIS,0,IERFLG,0) *-----switch off the output * ARGLIS(1)=-1.D0 ARGLIS(1)=dfloat(MNPRNT) CALL MNEXCM(FCNLB,'SET PRI',ARGLIS,1,IERFLG,0) IF(IERFLG.NE.0)THEN WRITE(6,*)'+LTF4: UNABLE TO SET PRI',ARGLIS(1) ENDIF **** ARGLIS(1)=EPSMN **** CALL MNEXCM(FCNLB,'SET EPS',ARGLIS,1,IERFLG,0) ARGLIS(1)=1.D0 CALL MNEXCM(FCNLB,'CALL FCN',ARGLIS,1,IERFLG,0) FIXED=0.D0 NFIXED=0 DO IPAR=1,4 FIXED=FIXED+1.D0 IF(FLAG(IPAR).LE.0.D0)THEN ARGLIS(1)=FIXED CALL MNEXCM(FCNLB,'FIX',ARGLIS,1,IERFLG,0) NFIXED=NFIXED+1 ENDIF ENDDO *********************************************** ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SET PRINT',ARGLIS,1,IERFLG) CALL MNEXCM(FCNLB,'MIGRAD',ARGLIS,0,IERFLG,0) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'HES',ARGLIS,1,IERFLG,0) CALL MNPOUT(4,CHNAM4,PAR4,EPAR4,BND1,BND2,IVARBL) * ARGLIS(1)=0. * CALL MNEXCM(FCNLB,'SHOW ERR',ARGLIS,0,IERFLG) ***DEBUG !!!!!!!!!!!!!!!! * ARGLIS(1)=3 * CALL MNEXCM(FCNLB,'SET PRI',ARGLIS,1,IERFLG,0) *=================================================== ARGLIS(1)=100. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,0,IERFLG,0) ***DEBUG !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * ARGLIS(1)=0 * CALL MNEXCM(FCNLB,'SET PRI',ARGLIS,1,IERFLG,0) *===================================================== CALL MNPOUT(4,CHNAM4,PAR4,EPAR4,BND1,BND2,IVARBL) if(ierflg.ne.0)then write(6,*)'+LTF4: After MINOS IERFLG=',ierflg endif *---------------------------------------------------------- ELSEIF(MNREAD.GT.0)THEN * data-driven mode of MINUIT CALL MINUIT(FCNLB,0) ENDIF if(prtflg(2).gt.0.)then CALL PRTERR endif CALL MNSTAT(CHI2,FEDM,ERRDEF,NPARI,NPARX,ISTAT) if(ISTAT.ne.3)then write(6,*)'+LTF4: After MNSTAT ISTAT=',ISTAT endif CALL MNPOUT(1,CHNAM1,PAR1,EPAR1,BND1,BND2,IVARBL) CALL MNERRS(1,PAR1PL,PAR1MI,PAR1PAR,PAR1GLB) CALL MNPOUT(2,CHNAM2,PAR2,EPAR2,BND1,BND2,IVARBL) CALL MNERRS(2,PAR2PL,PAR2MI,PAR2PAR,PAR2GLB) CALL MNPOUT(3,CHNAM3,PAR3,EPAR3,BND1,BND2,IVARBL) CALL MNERRS(3,PAR3PL,PAR3MI,PAR3PAR,PAR3GLB) CALL MNPOUT(4,CHNAM4,PAR4,EPAR4,BND1,BND2,IVARBL) CALL MNERRS(4,PAR4PL,PAR4MI,PAR4PAR,PAR4GLB) CALL MNEMAT(CERR,4) AMTFIT=PAR1 AMTERR=PAR1PAR AMTEPL=PAR1PL AMTEMI=PAR1MI AMTGLB=PAR1GLB ALSFIT=PAR2 ALSERR=PAR2PAR ALSEPL=PAR2PL ALSEMI=PAR2MI ALSGLB=PAR2GLB AMHFIT=PAR3 AMHERR=PAR3PAR AMHEPL=PAR3PL AMHEMI=PAR3MI AMHGLB=PAR3GLB ALBARFIT=PAR4 ALBARERR=PAR4PAR ALBAREPL=PAR4PL ALBAREMI=PAR4MI ALBARGLB=PAR4GLB if(prtflg(4).gt.0.)then WRITE(6,*)CHNAM1,PAR1,EPAR1 WRITE(6,*)CHNAM2,PAR2,EPAR2 WRITE(6,*)CHNAM3,PAR3,EPAR3 WRITE(6,*)CHNAM4,PAR4,EPAR4 WRITE(6,*)'CERR',CERR WRITE(6,*)'CHI2= ',CHI2 endif 99 CONTINUE IF(NFIXED.GT.0)THEN ARGLIS(1)=0.D0 CALL MNEXCM(FCNLB,'RESTORE',ARGLIS,1,IERFLG) ENDIF CALL MNEXCM(FCNLB,'RETURN',ARGLIS,0,IERFLG) if(MNUNIT.eq.-19)CLOSE(19) END *CMZ : 2.00/01 18/07/97 14.50.54 by A.Rozanov *-- Author : A.Rozanov 18/07/97 * * $Id: mnpint.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $ * * $Log: mnpint.F,v $ * Revision 1.1.1.1 1996/03/07 14:31:31 mclareni * Minuit * * *#include "minuit/pilot.h" SUBROUTINE MNPINT(PEXTI,I,PINTI) *#include "minuit/d506dp.inc" * * $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $ * * $Log: d506dp.inc,v $ * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni * Minuit * * *#ifndef CERNLIB_MINUIT_D506DP_INC *#define CERNLIB_MINUIT_D506DP_INC * * * d506dp.inc * *#if defined(CERNLIB_DOUBLE) C ************ DOUBLE PRECISION VERSION ************* IMPLICIT DOUBLE PRECISION (A-H,O-Z) *#endif *#if !defined(CERNLIB_DOUBLE) C ************ SINGLE PRECISION VERSION ************* *#endif * *#endif CC Calculates the internal parameter value PINTI corresponding CC to the external value PEXTI for parameter I. CC *#include "minuit/d506cm.inc" * * $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $ * * $Log: d506cm.inc,v $ * Revision 1.1.1.1 1996/03/07 14:31:32 mclareni * Minuit * * *#ifndef CERNLIB_MINUIT_D506CM_INC *#define CERNLIB_MINUIT_D506CM_INC * * * d506cm.inc * PARAMETER (MNE=100 , MNI=50) PARAMETER (MNIHL=MNI*(MNI+1)/2) CHARACTER*10 CPNAM COMMON 1/MN7NAM/ CPNAM(MNE) 2/MN7EXT/ U(MNE) ,ALIM(MNE) ,BLIM(MNE) 3/MN7ERR/ ERP(MNI) ,ERN(MNI) ,WERR(MNI) ,GLOBCC(MNI) 4/MN7INX/ NVARL(MNE) ,NIOFEX(MNE),NEXOFI(MNI) 5/MN7INT/ X(MNI) ,XT(MNI) ,DIRIN(MNI) 6/MN7FX2/ XS(MNI) ,XTS(MNI) ,DIRINS(MNI) 7/MN7DER/ GRD(MNI) ,G2(MNI) ,GSTEP(MNI) ,GIN(MNE) ,DGRD(MNI) 8/MN7FX3/ GRDS(MNI) ,G2S(MNI) ,GSTEPS(MNI) 9/MN7FX1/ IPFIX(MNI) ,NPFIX A/MN7VAR/ VHMAT(MNIHL) B/MN7VAT/ VTHMAT(MNIHL) C/MN7SIM/ P(MNI,MNI+1),PSTAR(MNI),PSTST(MNI) ,PBAR(MNI),PRHO(MNI) C PARAMETER (MAXDBG=10, MAXSTK=10, MAXCWD=20, MAXP=30, MAXCPT=101) PARAMETER (ZERO=0.0, ONE=1.0, HALF=0.5) COMMON D/MN7NPR/ MAXINT ,NPAR ,MAXEXT ,NU E/MN7IOU/ ISYSRD ,ISYSWR ,ISYSSA ,NPAGWD ,NPAGLN ,NEWPAG E/MN7IO2/ ISTKRD(MAXSTK) ,NSTKRD ,ISTKWR(MAXSTK) ,NSTKWR F/MN7TIT/ CFROM ,CSTATU ,CTITL ,CWORD ,CUNDEF ,CVRSN ,COVMES G/MN7FLG/ ISW(7) ,IDBG(0:MAXDBG) ,NBLOCK ,ICOMND H/MN7MIN/ AMIN ,UP ,EDM ,FVAL3 ,EPSI ,APSI ,DCOVAR I/MN7CNV/ NFCN ,NFCNMX ,NFCNLC ,NFCNFR ,ITAUR,ISTRAT,NWRMES(2) J/MN7ARG/ WORD7(MAXP) K/MN7LOG/ LWARN ,LREPOR ,LIMSET ,LNOLIM ,LNEWMN ,LPHEAD L/MN7CNS/ EPSMAC ,EPSMA2 ,VLIMLO ,VLIMHI ,UNDEFI ,BIGEDM,UPDFLT M/MN7RPT/ XPT(MAXCPT) ,YPT(MAXCPT) N/MN7CPT/ CHPT(MAXCPT) o/MN7XCR/ XMIDCR ,YMIDCR ,XDIRCR ,YDIRCR ,KE1CR ,KE2CR CHARACTER CTITL*50, CWORD*(MAXCWD), CUNDEF*10, CFROM*8, + CVRSN*6, COVMES(0:3)*22, CSTATU*10, CHPT*1 LOGICAL LWARN, LREPOR, LIMSET, LNOLIM, LNEWMN, LPHEAD *#endif CHARACTER CHBUFI*4, CHBUF2*30 PINTI = PEXTI IGO = NVARL(I) IF (IGO .EQ. 4) THEN C-- there are two limits ALIMI = ALIM(I) BLIMI = BLIM(I) YY=2.0*(PEXTI-ALIMI)/(BLIMI-ALIMI) - 1.0 YY2 = YY**2 IF (YY2 .GE. (1.0- EPSMA2)) THEN IF (YY .LT. 0.) THEN write(6,*)'I,PEXTI,ALIMI,BLIMI,YY,YY2,epsma2=', 1 I,PEXTI,ALIMI,BLIMI,YY,YY2,epsma2 A = VLIMLO CHBUF2 = ' IS AT ITS LOWER ALLOWED LIMIT.' ELSE A = VLIMHI CHBUF2 = ' IS AT ITS UPPER ALLOWED LIMIT.' ENDIF PINTI = A PEXTI = ALIMI + 0.5* (BLIMI-ALIMI) *(SIN(A) +1.0) LIMSET = .TRUE. WRITE (CHBUFI,'(I4)') I IF (YY2 .GT. 1.0) CHBUF2 = ' BROUGHT BACK INSIDE LIMITS.' CALL MNWARN('W',CFROM,'VARIABLE'//CHBUFI//CHBUF2) ELSE PINTI = ASIN(YY) ENDIF ENDIF RETURN END *CMZ : 2.00/02 03/07/98 18.21.10 by A.Rozanov *CMZ : 2.00/01 05/08/97 12.41.29 by A.Rozanov *CMZ : 2.00/00 24/06/97 18.51.22 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 24/06/97 SUBROUTINE LTWINT97 * * *----------------------------------------------------------------------* * * * Name : LTYAD97 * * (module) * * * * Description : * * calculations for Misha Vysotsky * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 24/06/97 * * * * * * Last modifications : 02/07/97 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * dimension e4(4,4),alogmhv(20),chi2v(20) * * * initialisation CALL LTINIT(0) CALL LTFPUT('MORIALL97','ALL',DUMMY) * call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) CALL LTFLAG('MNUNIT',6) write(6,*)'Four parameter fit ===========================' do ifit=1,4 CALL LTINIT(0) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') CALL LTFUSE('NOUSE','ALR') * do not use Rbslc in case of moriall97, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') write(6,*)'ifit=',ifit if(ifit.eq.1)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','ALBAR') write(6,*)'No als, no albar' elseif(ifit.eq.2)then CALL LTFUSE('USE','ALS') CALL LTFUSE('NOUSE','ALBAR') write(6,*)'Yes als, no albar' elseif(ifit.eq.3)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALBAR') write(6,*)'No als, yes albar' elseif(ifit.eq.4)then CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALBAR') write(6,*)'Yes als, yes albar' endif CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfit, 1 eamt,eals,ealogmh,ealbfit, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfit1=albfit ealbfit1=ealbfit ealbfit4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfit1,ealbfit1,ealbfit4 10030 format('+LTWINT97: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,' +- ',f7.3,f7.3) write(6,*)'+LTWINT97: chi2/ndf= ',chi2,ndf enddo ! ifit * make the chi2 curve vs mH by 3-par fits for each mH alogmhbest=alogmh do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfit, 1 eamt,eals,eamh,ealbfit, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863+0.0019) CALL LTINIT(1) write(6,*)'MZ mass up by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfit, 1 eamt,eals,eamh,ealbfit, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863-0.0019) CALL LTINIT(1) write(6,*)'MZ mass down by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfit, 1 eamt,eals,eamh,ealbfit, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' *========================================================================== END ! LTWINT97 *CMZ : 2.00/02 03/07/98 18.21.36 by A.Rozanov *CMZ : 2.00/01 03/11/97 22.38.45 by A.Rozanov *CMZ : 2.00/00 24/06/97 18.51.22 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 24/06/97 SUBROUTINE LTWARD97 * * *----------------------------------------------------------------------* * * * Name : LTWARD97 * * (module) * * * * Description : * * calculations of new data from EPS Jerusalem conference * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 24/06/97 * * * * * * Last modifications : 02/07/97 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * dimension e3(3,3),e4(4,4),alogmhv(20),chi2v(20) * * * initialisation CALL LTINIT(0) CALL LTFPUT('JERUSALEM97','ALL',DUMMY) * call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) CALL LTFLAG('MNUNIT',6) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of jerusalem97, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') go to 1001 1002 continue * fit standard mt-mh plot first IH=4000 ID=IH+1 call hbook1(404,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ID,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.118 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(404,float(1),amt) call hf1(404,float(2),alsbar) call hf1(404,float(3),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTWARD97: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTWARD97: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) CALL LTHROUT 1001 continue do il=1,3 if(il.eq.1)then albar=1./128.896 elseif(il.eq.2)then albar=1./(128.896-0.090) elseif(il.eq.3)then albar=1./(128.896+0.090) endif write(6,*)'1/albar=',1./albar call LTPUT('ALBAR',albar) CALL LTINIT(1) CALL LTFIT3('MT,ALS,LOGMH',amt,als,alogmh,eamt,eals,ealogmh, 1 e3,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh write(6,10020)amt,emtpos,emtneg,amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,als,eals 10020 format('+LTWARD97: mt= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,/ 1 ' als= ',f7.5,' +- ',f7.5) write(6,*)'+LTWARD97: chi2= /ndf ',chi2,ndf enddo ! il * 1000 continue * fit mt-als CALL LTINIT(0) CALL LTFPUT('JERUSALEM97','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of jerusalem97, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') AMH=300. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=60. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=1000. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt write(6,*)'Four parameter fit ===========================' do ifit=1,4 CALL LTINIT(0) CALL LTFPUT('JERUSALEM97','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of jerusalem97, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') write(6,*)'ifit=',ifit if(ifit.eq.1)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'No als, no albar' elseif(ifit.eq.2)then CALL LTFUSE('USE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'Yes als, no albar' elseif(ifit.eq.3)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' elseif(ifit.eq.4)then CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'Yes als, yes albar' endif CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 10030 format('+LTWARD97: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,' +- ',f7.3,f7.3) write(6,*)'+LTWARD97: chi2/ndf= ',chi2,ndf * call lttable2(amh,amt,als,1./albfitinv) call lttable3(amh,amt,als,1./albfitinv,e4) enddo ! ifit * make the chi2 curve vs mH by 3-par fits for each mH CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar for MH upper limit' alogmhbest=alogmh do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863+0.0019) CALL LTINIT(1) write(6,*)'MZ mass up by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863-0.0019) CALL LTINIT(1) write(6,*)'MZ mass down by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' *========================================================================== END ! LTWARD97 *CMZ : 2.00/01 02/11/97 18.05.52 by A.Rozanov *CMZ : 2.00/00 05/02/96 15.54.14 by A.Rozanov *-- Author : A.Rozanov 25/09/97 SUBROUTINE LTTABLE2(AMH,AMT,ALS,ALB) * * *----------------------------------------------------------------------* * * * Name : LTTABLE2 * * (module) * * * * Description : * * calculate table of observables with predictions * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMT - in - central value of Top mass * * ALS - in - central value of strong constant * * ALB - in - central value of e.m.constant at Mz scale * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 25/09/97 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. parameter (nexp=19) character*5 keyval,key,keypred dimension keyval(nexp),keypred(nexp) data keyval /'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'RBSLC','ABSLC','ACSLC','MWMZ','S2NUN','MT','ALB-1'/ data keypred/'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'RB','AB','AC','MWMZ','S2NUN','MT','ALBAR'/ dimension vexp(nexp),eexp(nexp),vthe(nexp),ethe(nexp), 1 epmh(nexp),enmh(nexp),pull(nexp) C ----------- end CDE -------------------------------------------------- write(6,*)'AMH,AMT,ALS,ALB=',AMH,AMT,ALS,ALB call ltget('MZ',amz) call ltput('ALBAR',ALB) call ltinit(1) call ltput('MH',AMH) call ltput('MT',AMT) call ltput('ALSHAT',ALS) write(6,*) 1'obs vexp eexp vthe pull' do i=1,nexp call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) * call ltget(keypred(i),vthe(i)) if(keypred(i).EQ.'ALBAR')vthe(i)=1./vthe(i) * pull(i)=(vexp(i)-vthe(i))/eexp(i) key=keypred(i) if(key(1:4).eq.'MWMZ')then vexp(i)=vexp(i)*AMZ eexp(i)=eexp(i)*AMZ vthe(i)=vthe(i)*AMZ ethe(i)=ethe(i)*AMZ epmh(i)=epmh(i)*AMZ enmh(i)=enmh(i)*AMZ endif if(key(1:3).eq.'ALR')then s2alr=s2_fralr(vexp(i)) es2alr= 1 abs(0.5*(s2_fralr(vexp(i)+eexp(i))-s2_fralr(vexp(i)-eexp(i)))) s2alrt=s2_fralr(vthe(i)) es2alrt= 1 abs(0.5*(s2_fralr(vthe(i)+ethe(i))-s2_fralr(vthe(i)-ethe(i)))) ens2alr=-s2alrt+s2_fralr(vthemi) eps2alr=-s2alrt+s2_fralr(vthema) pullalr=(s2alr-s2alrt)/es2alr write(6,10010)'s2ALR',s2alr,es2alr,s2alrt, 1 pullalr endif write(6,10010)keyval(i),vexp(i),eexp(i),vthe(i), 1 pull(i) 10010 format(1x,a5,4f10.4,2f7.4,f5.1) enddo * * END ! LTTABLE2 *CMZ : 17/01/99 22.34.31 by A.Rozanov *CMZ : 2.00/02 05/07/98 20.03.51 by A.Rozanov *CMZ : 2.00/01 03/11/97 19.33.54 by A.Rozanov *CMZ : 2.00/00 05/02/96 15.54.14 by A.Rozanov *-- Author : A.Rozanov 25/09/97 SUBROUTINE LTTABLE3(AMH,AMT,ALS,ALB,V) * * *----------------------------------------------------------------------* * * * Name : LTTABLE3 * * (module) * * * * Description : * * calculate table of observables with predictions * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMT - in - central value of Top mass * * ALS - in - central value of strong constant * * ALB - in - central value of e.m.constant at Mz scale * * V - variance matrix of fitted parameters * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/11/97 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. parameter (nexp=18) character*5 keyval,key,keypred dimension keyval(nexp),keypred(nexp) data keyval /'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'ABSLC','ACSLC','MWMZ','S2NUN','MT','ALB-1'/ data keypred/'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'AB','AC','MWMZ','S2NUN','MT','ALBAR'/ real v(4,4),dfda(nexp,4),efit(nexp) dimension vexp(nexp),eexp(nexp),vthe(nexp),ethe(nexp), 1 epmh(nexp),enmh(nexp),pull(nexp) C ----------- end CDE -------------------------------------------------- write(6,*)'AMH,AMT,ALS,ALB=',AMH,AMT,ALS,ALB write(6,*) 1'obs vexp eexp vthe efit pull' do i=1,nexp call ltget('MZ',amz) call ltput('ALBAR',ALB) call ltinit(1) call ltput('MH',AMH) call ltput('MT',AMT) call ltput('ALSHAT',ALS) * call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) * call ltget(keypred(i),vthe(i)) if(keypred(i).EQ.'ALBAR')vthe(i)=1./vthe(i) * calculate derivatives albinv=1./alb almh=alog10(amh) do ipar=1,4 if(ipar.eq.1)then amt1=amt+sqrt(v(1,1)) als1=als almh1=almh albinv1=albinv elseif(ipar.eq.2)then amt1=amt als1=als+sqrt(v(2,2)) almh1=almh albinv1=albinv elseif(ipar.eq.3)then amt1=amt als1=als almh1=almh+sqrt(v(3,3)) albinv1=albinv elseif(ipar.eq.4)then amt1=amt als1=als almh1=almh albinv1=albinv+sqrt(v(4,4)) endif alb1=1./albinv1 amh1=10**almh1 call ltput('ALBAR',ALB1) call ltinit(1) call ltput('MH',AMH1) call ltput('MT',AMT1) call ltput('ALSHAT',ALS1) call ltget(keypred(i),dfda(i,ipar)) if(keypred(i).EQ.'ALBAR')dfda(i,ipar)=1./dfda(i,ipar) if(v(ipar,ipar).gt.0.)then dfda(i,ipar)=(dfda(i,ipar)-vthe(i))/sqrt(v(ipar,ipar)) else dfda(i,ipar)=0. endif enddo * efit(i)=0. do ipar=1,4 do jpar=1,4 efit(i)=efit(i)+dfda(i,ipar)*dfda(i,jpar)*v(ipar,jpar) enddo enddo efit(i)=sqrt(efit(i)) pull(i)=(vexp(i)-vthe(i))/eexp(i) key=keypred(i) if(key(1:4).eq.'MWMZ')then vexp(i)=vexp(i)*AMZ eexp(i)=eexp(i)*AMZ vthe(i)=vthe(i)*AMZ ethe(i)=ethe(i)*AMZ epmh(i)=epmh(i)*AMZ enmh(i)=enmh(i)*AMZ efit(i)=efit(i)*AMZ endif if(key(1:3).eq.'ALR')then s2alr=s2_fralr(vexp(i)) es2alr= 1 abs(0.5*(s2_fralr(vexp(i)+eexp(i))-s2_fralr(vexp(i)-eexp(i)))) s2alrt=s2_fralr(vthe(i)) es2alrt= 1 abs(0.5*(s2_fralr(vthe(i)+ethe(i))-s2_fralr(vthe(i)-ethe(i)))) ens2alr=-s2alrt+s2_fralr(vthemi) eps2alr=-s2alrt+s2_fralr(vthema) efitalr= 1 abs(0.5*(s2_fralr(vthe(i)+efit(i))-s2_fralr(vthe(i)-efit(i)))) pullalr=(s2alr-s2alrt)/es2alr write(6,10010)'s2ALR',s2alr,es2alr,s2alrt,efitalr, 1 pullalr endif write(6,10010)keyval(i),vexp(i),eexp(i),vthe(i),efit(i), 1 pull(i) 10010 format(1x,a5,4f10.4,3f7.4,f5.1) enddo * * END ! LTTABLE3 *CMZ : 2.00/02 03/07/98 18.37.01 by A.Rozanov *CMZ : 2.00/01 19/03/98 00.47.55 by A.Rozanov *CMZ : 2.00/00 24/06/97 18.51.22 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 24/06/97 SUBROUTINE LTMORI98 * * *----------------------------------------------------------------------* * * * Name : LTMORI98 * * (module) * * * * Description : * * calculations of new data from Moriond-98 conference * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 24/06/97 * * * * * * Last modifications : 19/03/98 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * dimension e3(3,3),e4(4,4),alogmhv(20),chi2v(20) * * * initialisation CALL LTINIT(0) CALL LTFPUT('MORIOND98','ALL',DUMMY) * call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) CALL LTFLAG('MNUNIT',6) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') go to 1001 1002 continue * fit standard mt-mh plot first IH=4000 ID=IH+1 call hbook1(404,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ID,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.118 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(404,float(1),amt) call hf1(404,float(2),alsbar) call hf1(404,float(3),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTMORI98: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTMORI98: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) CALL LTHROUT 1001 continue do il=1,3 if(il.eq.1)then albar=1./128.896 elseif(il.eq.2)then albar=1./(128.896-0.090) elseif(il.eq.3)then albar=1./(128.896+0.090) endif write(6,*)'1/albar=',1./albar call LTPUT('ALBAR',albar) CALL LTINIT(1) CALL LTFIT3('MT,ALS,LOGMH',amt,als,alogmh,eamt,eals,ealogmh, 1 e3,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh write(6,10020)amt,emtpos,emtneg,amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,als,eals 10020 format('+LTMORI98: mt= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,/ 1 ' als= ',f7.5,' +- ',f7.5) write(6,*)'+LTMORI98: chi2= /ndf ',chi2,ndf enddo ! il * 1000 continue * fit mt-als CALL LTINIT(0) CALL LTFPUT('MORIOND98','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') AMH=300. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=60. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=1000. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt write(6,*)'Four parameter fit ===========================' do ifit=1,4 CALL LTINIT(0) CALL LTFPUT('MORIOND98','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') write(6,*)'ifit=',ifit if(ifit.eq.1)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'No als, no albar' elseif(ifit.eq.2)then CALL LTFUSE('USE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'Yes als, no albar' elseif(ifit.eq.3)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' elseif(ifit.eq.4)then CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'Yes als, yes albar' endif CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 10030 format('+LTMORI98: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,' +- ',f7.3,f7.3) write(6,*)'+LTMORI98: chi2/ndf= ',chi2,ndf * call lttable2(amh,amt,als,1./albfitinv) call lttable3(amh,amt,als,1./albfitinv,e4) enddo ! ifit * make the chi2 curve vs mH by 3-par fits for each mH CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar for MH upper limit' alogmhbest=alogmh do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863+0.0019) CALL LTINIT(1) write(6,*)'MZ mass up by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863-0.0019) CALL LTINIT(1) write(6,*)'MZ mass down by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' *========================================================================== END ! LTMORI98 *CMZ : 28/09/98 17.41.17 by A.Rozanov *CMZ : 2.00/02 06/07/98 16.56.47 by A.Rozanov *-- Author : A.Rozanov 24/06/97 SUBROUTINE LTSUSY * * *----------------------------------------------------------------------* * * * Name : LTSUSY * * (module) * * * * Description : * * calculations of SUSY corrections * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 24/06/97 * * * * * * Last modifications : 19/03/98 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e3(3,3),e4(4,4),alogmhv(20),chi2v(20) double precision dsusylrva,dsusylrvr,dsusylrvm,t,h,aals * * * initialisation CALL LTINIT(0) CALL LTFPUT('MORIOND98','ALL',DUMMY) * call hlimit(100000) go to 1002 1004 continue call ltsusy_init(0) t=1. h=1. aals=0.1 amt=175. beta=atan(2.) call ltget('S2',s2) call ltget('MZ',amz) do i=5,100 amsb=i*10. call ltsusyput('MSB',amsb) amst1=sqrt(amsb**2+amt**2+amz**2*cos(2*beta)*(1.-s2)) call ltsusyput('MST1',amst1) call ltsusy_init(1) vaa=dsusylrva(t,h,aals) vrr=dsusylrvr(t,h,aals) vmm=dsusylrvm(t,h,aals) write(6,*)'i,amsb,va,vr,vm=',i,amsb,vaa,vrr,vmm enddo return 1002 continue * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) CALL LTFLAG('MNUNIT',6) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') * test for MIV 05.07.98 AMT=175. CALL LTPUT('MT',AMT) alb=1./128.896 CALL LTPUT('ALBAR',alb) alsbar=0.118 CALL LTPUT('ALSBAR',alsbar) write(6,*)'amt,1./alb,alsbar=',amt,1./alb,alsbar do i=1,5 if(i.eq.1)AMH=65. if(i.eq.2)AMH=100. if(i.eq.3)AMH=300. if(i.eq.4)AMH=600. if(i.eq.5)AMH=1000. CALL LTPUT('MH',AMH) CALL LTGET('QFB',qfb) write(6,*)'i,amh,qfb=',i,amh,qfb enddo call ltsusy_init(0) write(6,*)'SUSY point number 3' amsb=1000. call ltsusyput('MSB',amsb) beta=atan(2.) eps=10. amst12=amsb**2+(170.)**2+91.**2*cos(2*beta)*(1-0.231)+eps/10. amst22=amst12-10*eps amst1=sqrt(amst12) amst2=sqrt(amst22) call ltsusyput('MST1',amst1) call ltsusyput('MST2',amst2) call ltsusy_init(1) go to 1001 1003 continue * fit standard mt-mh plot first IH=4000 ID=IH+1 call hbook1(404,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ID,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.118 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * CALL LTFUSE('USE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') alb=1./128.896 CALL LTPUT('ALBAR',alb) CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(404,float(1),amt) call hf1(404,float(2),alsbar) call hf1(404,float(3),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTMORI98: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTMORI98: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) CALL LTHROUT 1001 continue do il=1,3 if(il.eq.1)then albar=1./128.896 elseif(il.eq.2)then albar=1./(128.896-0.090) elseif(il.eq.3)then albar=1./(128.896+0.090) endif write(6,*)'1/albar=',1./albar call LTPUT('ALBAR',albar) CALL LTINIT(1) CALL LTFIT3('MT,ALS,LOGMH',amt,als,alogmh,eamt,eals,ealogmh, 1 e3,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh write(6,10020)amt,emtpos,emtneg,amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,als,eals 10020 format('+LTMORI98: mt= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,/ 1 ' als= ',f7.5,' +- ',f7.5) write(6,*)'+LTMORI98: chi2= /ndf ',chi2,ndf enddo ! il * 1000 continue * fit mt-als CALL LTINIT(0) ioption(9)=1. CALL LTFPUT('MORIOND98','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') AMH=300. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=60. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=1000. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt write(6,*)'Four parameter fit ===========================' do ifit=1,4 CALL LTINIT(0) ioption(9)=1. CALL LTFPUT('MORIOND98','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') write(6,*)'ifit=',ifit if(ifit.eq.1)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'No als, no albar' elseif(ifit.eq.2)then CALL LTFUSE('USE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'Yes als, no albar' elseif(ifit.eq.3)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' elseif(ifit.eq.4)then CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'Yes als, yes albar' endif CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 10030 format('+LTMORI98: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,' +- ',f7.3,f7.3) write(6,*)'+LTMORI98: chi2/ndf= ',chi2,ndf * call lttable2(amh,amt,als,1./albfitinv) call lttable3(amh,amt,als,1./albfitinv,e4) enddo ! ifit * make the chi2 curve vs mH by 3-par fits for each mH CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar for MH upper limit' alogmhbest=alogmh do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863+0.0019) CALL LTINIT(1) write(6,*)'MZ mass up by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' * vary MZ mass CALL LTPUT('MZ',91.1863-0.0019) CALL LTINIT(1) write(6,*)'MZ mass down by one standard' do imh=1,20 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv,chi2v,20,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' *========================================================================== END ! LTSUSY *CMZ : 05/11/99 22.33.42 by A.Rozanov *CMZ : 2.00/02 05/07/98 20.18.46 by A.Rozanov *-- Author : A.Rozanov 03/07/98 SUBROUTINE LTSUSY_INIT(ist) * * *----------------------------------------------------------------------* * * * Name : LTSUSY_INIT * * (module) * * * * Description : * * [description] * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : 27/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. C ----------- end CDE -------------------------------------------------- * * from point 3 in PR D 55 (1997) 5520. if(ist.eq.0)then SUSY_M0=200. SUSY_MHF=100. SUSY_A0=0. BETA=ATAN(2.) SUSY_SGNMU=-1. AMHIGGS=379. ! mass of big H SUSYFL=0.5 ! 1 - SUGRA model YL=1./3. AMSB=278. AMST1=329. AMST2=264. DMST1=10. DMST2=10. AMSQ=AMSB AMGLUINO=298. AMCHARGINO=90. IMST1=0 ! take mst1 from AMST1, not from relations IMST2=0 ! take mst2 from AMST2, not from relations endif END ! LTSUSY_INIT *CMZ : 30/09/98 14.55.37 by A.Rozanov *CMZ : 2.00/02 03/07/98 18.52.38 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION GSUSY(AM1,AM2) * * *----------------------------------------------------------------------* * * * Name : GSUSY * * (module) * * * * Description : * * scalar particle contribution to the vector boson self energy * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : 29/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. C ----------- end CDE -------------------------------------------------- * data eps/0.000001/ * if(dabs(AM1-AM2).gt.eps)then AM12=AM1*AM1 AM22=AM2*AM2 RAM12=AM12/AM22 GSUSY=AM12+AM22-(2*AM12*AM22/(AM12-AM22))*DLOG(RAM12) else * Taylor expansion from MIV E-mail 30.09.98 GSUSY=(AM2**2-AM1**2)**2/(3*AM1**2) endif END ! GSUSY *CMZ : 30/09/98 15.00.11 by A.Rozanov *CMZ : 2.00/02 03/07/98 18.53.00 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION HSUSY(AM1,AM2) * * *----------------------------------------------------------------------* * * * Name : HSUSY * * (module) * * * * Description : * * scalar particle contribution to the vector boson self energy * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : 29/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. C ----------- end CDE -------------------------------------------------- * * data eps/0.00001D0/ if(DABS(AM1-AM2).gt.eps)then AM12=AM1*AM1 AM22=AM2*AM2 RAM12=AM12/AM22 HSUSY=-5./3.+4*AM12*AM22/(AM12-AM22)**2+ 1 (AM12+AM22)*(AM12**2-4*AM12*AM22+AM22**2)*DLOG(RAM12) 2 /(AM12-AM22)**3 else * Taylor expansion from MIV e-mail 30.09.98 HSUSY=(AM1**2-AM2**2)/(5*AM1**4) endif END ! HSUSY *CMZ : 09/11/99 23.58.08 by A.Rozanov *CMZ : 2.00/02 03/07/98 20.16.17 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DSUSYLRVA(T,H,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : DSUSYLRVA * * (module) * * * * Description : * * SUSY E.W. corrections * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.D0)then THLR=THETALR(T) CU2=DCOS(THLR)**2 SU2=1-CU2 AMST1C=AMST1F(T) AMST2C=AMST2F(T) DSUSYLRVA=(cu2*gsusy(AMST1C,AMSB)+su2*gsusy(AMST2C,AMSB) 1 -cu2*su2*gsusy(AMST1C,AMST2C))/AMZ**2 else DSUSYLRVA=0. endif if(IOPTION(11).ne.0)then * higgsino dominated case of nearly degenerate chargino-neutralino * hep-ph/9907219 xi=(AMCHARGINO/amz)**2 xi1=4*xi-1 if(dabs(xi1).lt.1.D-10)xi1=1.D-10 DHVA=(16/9.)*(.5-s2+s2**2)*(12*xi**2*FP(xi)-2*xi-1)/xi1 DSUSYLRVA=DSUSYLRVA+DHVA elseif(IOPTION(12).ne.0)then * gaugino dominated case of nearly degenerate chargino-neutralino xi=(AMCHARGINO/amz)**2 xi1=4*xi-1 if(dabs(xi1).lt.1.D-10)xi1=1.D-10 DWVA=(16/9.)*c2**2*(12*xi**2*FP(xi)-2*xi-1)/xi1 DSUSYLRVA=DSUSYLRVA+DWVA endif END ! DSUSYLRVA *CMZ : 09/11/99 23.58.08 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.50.12 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DSUSYLRVR(T,H,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : DSUSYLRVR * * (module) * * * * Description : * * SUSY E.W. corrections VR * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * A.R. Date : 07.12.98 * * correct bug: under dlog masses**2 * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.)then THLR=THETALR(T) CU2=DCOS(THLR)**2 SU2=1.-CU2 AMST1C=AMST1F(T) AMST2C=AMST2F(T) DSUSYLRVR=DSUSYLRVA(T,H,ALSBAR)+(YL/3.)* 1 (cu2*2*dlog(AMST1C/AMSB)+su2*2*dlog(AMST2C/AMSB)) 2 -cu2*su2*hsusy(AMST1C,AMST2C)/3 else DSUSYLRVR=0. endif if(IOPTION(11).ne.0)then * higgsino dominated case of nearly degenerate chargino-neutralino * hep-ph/9907219 xi=(amCHARGINO/amz)**2 DHVR=(16/9.)*s2*c2*((1+2*xi)*FP(xi)-1/3.) DSUSYLRVR=DSUSYLRVR+DHVR elseif(IOPTION(12).ne.0)then * gaugino dominated case of nearly degenerate chargino-neutralino xi=(amCHARGINO/amz)**2 DWVR=(16/9.)*s2*c2*((1+2*xi)*FP(xi)-1/3.) DSUSYLRVR=DSUSYLRVR+DWVR endif END ! DSUSYLRVR *CMZ : 09/11/99 23.58.08 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.50.12 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DSUSYLRVM(T,H,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : DSUSYLRVM * * (module) * * * * Description : * * SUSY E.W. corrections VM * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * A.R. Date : 07/12/98 * * correct bug: under dlog masses**2 * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.)then THLR=THETALR(T) CU2=DCOS(THLR)**2 SU2=1.-CU2 AMST1C=AMST1F(T) AMST2C=AMST2F(T) RMST1=AMST1C/AMSB RMST2=AMST2C/AMSB DSUSYLRVM=DSUSYLRVA(T,H,ALSBAR)+(2*YL*s2/3.)* 1 (cu2*2*dlog(RMST1)+su2*2*dlog(RMST2)) 2 +(cu2-su2)*(cu2*hsusy(AMST1C,AMSB)+SU2*hsusy(AMST2C,AMSB))/3 3 -cu2*su2*hsusy(AMST1C,AMST2C)/3 else DSUSYLRVM=0. endif if(IOPTION(11).ne.0)then * higgsino dominated case of nearly degenerate chargino-neutralino * hep-ph/9907219 xi=(amCHARGINO/amz)**2 DHVM=(16/9.)*((.5-s2+s2**2)*(1+2*xi)*FP(xi) 1 -(0.5-s2)*(1+2*xi/c2)*FP(xi/c2)-s2**2/3) DSUSYLRVM=DSUSYLRVM+DHVM elseif(IOPTION(12).ne.0)then * gaugino dominated case of nearly degenerate chargino-neutralino xi=(amCHARGINO/amz)**2 DWVM=(16/9.)*(c2**2*(1+2*xi)*FP(xi) 1 -(1-2*s2)*(1+2*xi/c2)*FP(xi/c2)-s2**2/3) DSUSYLRVM=DSUSYLRVM+DWVM endif END ! DSUSYLRVM *CMZ : 29/09/98 22.22.52 by A.Rozanov *CMZ : 2.00/02 06/07/98 12.39.45 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DSUSYRV(T,H,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : DSUSYRV * * (module) * * * * Description : * * SUSY E.W. corrections VR * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : 22/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.)then X=(AMZ/AMSB)**2 Y=(AMZ/AMGLUINO)**2 DSUSYRV=(ALSBAR/PI)*DELTA11(X,Y) else DSUSYRV=0. endif END ! DSUSYRV *CMZ : 2.00/02 06/07/98 12.32.26 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DELTA(Z1) * * *----------------------------------------------------------------------* * * * Name : DELTA * * (module) * * * * Description : * * SUSY Delta integrated over z1 * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DELTAC. COMMON/DELTAC/X,Y *KEND. C ----------- end CDE -------------------------------------------------- * A=y-x*y*z1+x*y*z1**2 DLOGA=DLOG(A) B=x+(y-x)*z1 DLOGB=DLOG(B) C=y-x-x*y*z1 DELTA=-(4./3.)*((A*DLOGA-(1-z1)*C-B*DLOGB)/C 1-(y*DLOG(y)-(1-z1)*(y-x)-B*DLOGB)/(y-x)) END ! DELTA *CMZ : 05/11/99 22.33.42 by A.Rozanov *CMZ : 2.00/02 04/07/98 21.21.03 by A.Rozanov *CMZ : 2.00/00 05/01/96 19.19.02 by A.Rozanov *CMZ : 1.30/08 22/02/95 16.28.16 by A.Rozanov *CMZ : 1.30/07 18/02/95 01.20.15 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTSUSYPUT(CHKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTSUSYPUT * * (module) * * * * Description : * * input of SUSY parameters for LEPTOP * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 20/07/98 * * * * * * Last modifications : * * A.Rozano Date : 30/09/98 * * * * Keywords : * * LTINIT, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. CHARACTER*(*) CHKEY REAL*4 VALUE * LK=LEN(CHKEY) * modify some constants IF(CHKEY(1:LK).eq.'MSB')THEN AMSB=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'MSQ')THEN AMSQ=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'MGLUINO')THEN AMGLUINO=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'MCHARGINO')THEN AMCHARGINO=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'YL')THEN YL=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'SUSYFL')THEN SUSYFL=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'MST1')THEN AMST1=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'MST2')THEN AMST2=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'DMST1')THEN DMST1=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'DMST2')THEN DMST2=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'IMST1')THEN IMST1=VALUE ELSEIF(CHKEY(1:LK).EQ.'IMST2')THEN IMST2=VALUE ELSEIF(CHKEY(1:LK).EQ.'MHIGGS')THEN AMHIGGS=DBLE(VALUE) ! mass of big H ELSEIF(CHKEY(1:LK).EQ.'BETA')THEN BETA=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'M0')THEN SUSY_M0=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'MHF')THEN SUSY_MHF=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'A0')THEN SUSY_A0=DBLE(VALUE) ELSEIF(CHKEY(1:LK).EQ.'SGNMU')THEN SUSY_SGNMU=DBLE(VALUE) ELSE WRITE(6,*)'+LTSUSYPUT:wrong key',CHKEY(1:LK),DBLE(VALUE) ENDIF * * print IF(PRTFLG(8).NE.0)THEN WRITE(6,10010)CHKEY(1:LK),DBLE(VALUE) 10010 FORMAT(1x,'+LTSUSYPUT: ',A20,' = ',E16.8) ENDIF END ! LTSUSYPUT *CMZ : 29/09/98 12.37.25 by A.Rozanov *CMZ : 2.00/02 03/07/98 19.50.13 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DSUSYRA(T,H,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : DSUSYRA * * (module) * * * * Description : * * SUSY E.W. corrections RA * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.)then DSUSYRA=DSUSYRV(T,H,ALSBAR) else DSUSYRA=0. endif END ! DSUSYRA *CMZ : 2.00/03 08/09/98 20.16.47 by A.Rozanov *CMZ : 2.00/02 05/07/98 22.37.33 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DDGVR(T,H,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : DDGVR * * (module) * * * * Description : * * Degrassi two loop E.W. corrections VR * * by inverse ingeneering * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. real*4 DIVDIF,AMHT(5),DS2(5),AMH DATA AMHT/65.,100.,300.,600.,1000./ DATA DS2/.00020,.00019,.00017,.00015,.00016/ * DS2 s2(Degrassi)-s2(LEPTOP) C ----------- end CDE -------------------------------------------------- * * if(IOPTION(9).NE.0.)then AMH=DSQRT(H)*AMZ if(amh.lt.amht(1))amh=amht(1) if(amh.gt.amht(5))amh=amht(5) DDGVR=-(16*PI*(c2-s2)/(3*albar))*DIVDIF(DS2,AMHT,5,amh,1) else DDGVR=0. endif END ! DDGVR *CMZ : 2.00/03 08/09/98 20.16.47 by A.Rozanov *CMZ : 2.00/02 05/07/98 23.03.41 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DDGVM(T,H,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : DDGVM * * (module) * * * * Description : * * Degrassi two loop E.W. corrections VM * * by inverse ingeneering * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * A.Rozanov Date : 08/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. * from Degrassi et al., hep-ph/9603374, DFPD 96/TH20,MPI-PhT-96-17 C ----------- end CDE -------------------------------------------------- * * if(IOPTION(9).NE.0.)then HH=DSQRT(H/T) FH=-9.098-0.095*DSQRT(HH)-6.703*HH+2.836*HH**2-0.666*HH**3 1 +0.067*HH**4 * DDGVM=(ALBAR*(c2-s2)/(16*PI*s2*c2**2))*T**2*FH ! bug MIV 8.09.98 DDGVM=(ALBAR/(16*PI*s2*c2))*T**2*FH else DDGVM=0. endif END ! DDGVM *CMZ : 2.00/02 06/07/98 12.44.06 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DELTA1(Z1) * * *----------------------------------------------------------------------* * * * Name : DELTA * * (module) * * * * Description : * * SUSY Delta integrated over z1 * * approximation x=y * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DELTAC. COMMON/DELTAC/X,Y *KEND. C ----------- end CDE -------------------------------------------------- * DELTA1=-(4./3.)*( z1-1+(1-z1-1/(x*z1))*DLOG(1-x*z1*(1-z1)) ) END ! DELTA1 *CMZ : 2.00/03 05/09/98 13.02.12 by A.Rozanov *CMZ : 2.00/02 02/09/98 22.41.40 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION D4VI(T,H) * FORMULA (48) FROM TH-6696 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. * if(ioption(2).eq.0.and.ioption(3).eq.0)then fac=0. * elseif(ioption(2).ne.0)then * fac=1. * elseif(ioption(3).ne.0)then * fac=-1. * endif * albar=gmu*sqrt(2)*mz**2*(4*s2*c2)/(4*pi) if(IOPTION(10).eq.0)then D4VI=-ALBAR*AMHMT(T,H)*T**2*(1.+fac*2./t)/(PI*16*S2*C2) else D4VI=0. endif END *CMZ : 2.00/03 05/09/98 13.02.12 by A.Rozanov *CMZ : 2.00/02 02/09/98 22.47.13 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION D4PVM(T,H) * FORMULA from MIV fax 7.08.98 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. if(IOPTION(10).eq.0)then D4PVM=(3*c2*(3-10*s2)/(4*(c2-s2)**2))*ALBAR*T**2/(PI*16*S2*C2) else D4PVM=0. endif END *CMZ : 2.00/03 05/09/98 13.02.12 by A.Rozanov *CMZ : 2.00/02 02/09/98 22.48.29 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION D4PVA(T,H) * FORMULA from MIV fax 7.08.98 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. if(IOPTION(10).eq.0)then D4PVA=(9./4.)*ALBAR*T**2/(PI*16*S2*C2) else D4PVA=0. endif END *CMZ : 10/03/99 12.10.09 by A.Rozanov *CMZ : 2.00/03 05/09/98 13.02.12 by A.Rozanov *CMZ : 2.00/02 03/09/98 10.50.19 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION D4PVR(T,H) * FORMULA from MIV fax 7.08.98 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. if(IOPTION(10).eq.0)then D4PVR=-(3/((c2-s2)**2))*ALBAR*T**2/(PI*16) else D4PVR=0. endif END *CMZ : 05/11/99 22.14.17 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LTOBZOR * * *----------------------------------------------------------------------* * * * Name : LTOBZOR * * (module) * * * * Description : * * calculations of new data from EWWG-99 report * * for review in Reports on Progress in Physics * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/09/98 * * * * * * Last modifications : 10/01/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e3(3,3),e4(4,4),alogmhv(22),chi2v(22) real*8 h,t,amhmt,z1z2 integer nopt,iopt(20),lvopt(20) logical twoloops call hlimit(100000) * ipart = 1 - table of observables * 2 - 4-generations * 3 - Vi and tables * test for MIV 05.07.98 and 10.01.99 call ltinit(0) * test GMU * call ltgmu AMT=175. CALL LTPUT('MT',AMT) alb=1./128.896 CALL LTPUT('ALBAR',alb) alsbar=0.118 CALL LTPUT('ALSBAR',alsbar) write(6,*)'amt,1./alb,alsbar=',amt,1./alb,alsbar do i=1,5 if(i.eq.1)AMH=65. if(i.eq.2)AMH=100. if(i.eq.3)AMH=300. if(i.eq.4)AMH=600. if(i.eq.5)AMH=1000. CALL LTPUT('MH',AMH) CALL LTGET('QFB',qfb) write(6,*)'i,amh,qfb=',i,amh,qfb enddo * * table 4 of UFN for MIV 03.02.99 call ltinit(0) AMT=175. CALL LTPUT('MT',AMT) CALL LTGET('MZ',AMZ) alb=1./128.878 CALL LTPUT('ALBAR',alb) alsbar=0.118 CALL LTPUT('ALSBAR',alsbar) call ltinit(0) CALL LTGET('S2',s2) c2=1.-s2 write(6,*)'amt,1./alb,alsbar=',amt,1./alb,alsbar write(6,*)'i mh/mt A(mh/mt) tau2(mh/mt)' do i=1,51 rmhmt=(i-1)*.1 AMH=AMT*rmhmt CALL LTPUT('MH',AMH) T=(AMT/AMZ)**2 H=(AMH/AMZ)**2 amhmts=amhmt(t,h) x=t*alb/(3.1415*16*s2*c2) z1z2s=z1z2(t,h) tau2=(z1z2s-1.)/x write(6,10310)i,rmhmt,amhmts,tau2 10310 format(i3,f5.2,2f6.3) enddo * ipart=2 if(ipart.eq.1)then call tabconstvi * table with Born predictions call ltinit(0) call vzero(e4,16) amh=100. e4(1,1)=(alog10(150.)-alog10(100.))**2 CALL LTFGET('VALUE','MT',amt) CALL LTFGET('ERROR','MT',eamt) e4(2,2)=eamt**2 CALL LTFGET('VALUE','ALS',als) CALL LTFGET('ERROR','ALS',eals) e4(3,3)=eals**2 CALL LTFGET('VALUE','ALB-1',albinv) CALL LTFGET('ERROR','ALB-1',ealbinv) e4(4,4)=ealbinv**2 call ltufntab1(amh,amt,als,1./albinv,e4) call tabconstlb * The ultimate fit with alsPDG and albarDavier CALL LTINIT(0) write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') als=0.1178 CALL LTFPUT('VALUE','ALS',als) eals=0.0023 CALL LTFPUT('ERROR','ALS',eals) write(6,*)'als,eals=',als,eals albinv=128.923 ! Davier CALL LTFPUT('VALUE','ALB-1',albinv) ealbinv=0.036 CALL LTFPUT('ERROR','ALB-1',ealbinv) write(6,*)'albinv,ealbinv=',albinv,ealbinv CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'Yes als, yes albar' CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) do ip=1,4 write(6,10200)(e4(ip,jp),jp=1,4) enddo CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) CALL LTFGET('FIT_ERR+' ,'ALBAR-1',ealbpos) CALL LTFGET('FIT_ERR-' ,'ALBAR-1',ealbneg) CALL LTFGET('FIT_GLB' ,'ALBAR-1',glbalb) amh=10**alogmh if(ifit.eq.3)alogmhbest=alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbpos,ealbneg,ealbfitinv1,ealbfitinv4 write(6,*)'+LTOBZOR98: chi2/ndf= ',chi2,ndf call lttable3(amh,amt,als,1./albfitinv,e4) call ltpredmt(amh,amt,als,1./albfitinv,e4) * call ltscanalb(amh,amt,als,1./albfitinv,e4) * do iloop=1,2 * initialisation CALL LTINIT(0) if(iloop.eq.1)then twoloops=.true. elseif(iloop.eq.2)then twoloops=.false. endif if(twoloops)then write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi else write(6,*)'No two loops corrections (also no Degrassi)' IOPTION(9)=0 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=1 ! 1 -no two loops in d4Vi,d5Vi,dPhi endif write(6,*)'opt(9),opt(10)=',ioption(9),ioption(10) * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) CALL LTFPUT('EWWG99','ALL',DUMMY) * call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) CALL LTFLAG('MNUNIT',6) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') do il=1,3 if(il.eq.1)then albar=1./128.896 elseif(il.eq.2)then albar=1./(128.896-0.090) elseif(il.eq.3)then albar=1./(128.896+0.090) endif write(6,*)'1/albar=',1./albar call LTPUT('ALBAR',albar) CALL LTINIT(1) CALL LTFIT3('MT,ALS,LOGMH',amt,als,alogmh,eamt,eals,ealogmh, 1 e3,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh write(6,10020)amt,emtpos,emtneg,amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,als,eals 10020 format('+LTOBZOP98: mt= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,/ 1 ' als= ',f7.5,' +- ',f7.5) write(6,*)'+LTOBZOR98: chi2= /ndf ',chi2,ndf enddo ! il * 1000 continue * fit mt-als CALL LTINIT(0) if(twoloops)then write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi else write(6,*)'No two loops corrections (also no Degrassi)' IOPTION(9)=0 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=1 ! 1 -no two loops in d4Vi,d5Vi,dPhi endif * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') AMH=300. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=60. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=1000. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt write(6,*)'Four parameter fit ===========================' do ifit=1,7 CALL LTINIT(0) if(twoloops)then write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi else write(6,*)'No two loops corrections (also no Degrassi)' IOPTION(9)=0 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=1 ! 1 -no two loops in d4Vi,d5Vi,dPhi endif * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') als=0.1178 CALL LTFPUT('VALUE','ALS',als) eals=0.0023 CALL LTFPUT('ERROR','ALS',eals) write(6,*)'ifit,als,eals=',ifit,als,eals if(ifit.eq.1)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'No als, no albar' elseif(ifit.eq.2)then CALL LTFUSE('USE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'Yes als, no albar' elseif(ifit.eq.3)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' elseif(ifit.eq.4)then CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'Yes als, yes albar' elseif(ifit.eq.5)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar, no MT FNAL' elseif(ifit.eq.6)then CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar, no MT FNAL, no ALR, no Ab', 1 'no AC' elseif(ifit.eq.7)then CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','AFBL') CALL LTFUSE('NOUSE','ATAU') CALL LTFUSE('NOUSE','AETAU') CALL LTFUSE('NOUSE','AFBB') CALL LTFUSE('NOUSE','AFBC') CALL LTFUSE('NOUSE','QFB') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','ALB-1') write(6,*)'Noals, yesalbar, noMTFNAL, noAFB, noAtau, noAe,', 1 'noAFBb, noAFBc, noQFB' endif call ltinit(1) call ltget('S2',s2) call ltget('ALBAR',albar) call ltget('MZ',amz) write(6,*)'s2,albar,amz=',s2,albar,amz CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) do ip=1,4 write(6,10200)(e4(ip,jp),jp=1,4) enddo CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) CALL LTFGET('FIT_ERR+' ,'ALBAR-1',ealbpos) CALL LTFGET('FIT_ERR-' ,'ALBAR-1',ealbneg) CALL LTFGET('FIT_GLB' ,'ALBAR-1',glbalb) amh=10**alogmh if(iloop.eq.2.and.ifit.eq.3)then amhno2loop=amh endif if(ifit.eq.3)alogmhbest=alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbpos,ealbneg,ealbfitinv1,ealbfitinv4 10030 format('+LTOBZOR98: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,'+',f5.3,'-',f5.3,' +- ',f5.3,f5.3) write(6,*)'+LTOBZOR98: chi2/ndf= ',chi2,ndf * call lttable2(amh,amt,als,1./albfitinv) call lttable3(amh,amt,als,1./albfitinv,e4) call ltpredmt(amh,amt,als,1./albfitinv,e4) * call ltscanalb(amh,amt,als,1./albfitinv,e4) enddo ! ifit * make the chi2 curve vs mH by 3-par fits for each mH CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar for MH=100,130 GeV fits' do imh=1,2 if(imh.eq.1)then amh=100. elseif(imh.eq.2)then amh=130. endif CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) do ip=1,4 e4(ip,3)=0. e4(3,ip)=0. enddo do ip=1,4 write(6,10200)(e4(ip,jp),jp=1,4) enddo 10200 format(1x,4f10.6) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf call lttable3(amh,amt,als,1./albfitinv,e4) enddo *====================================================================== do imz=1,3 * vary MZ mass if(imz.eq.1)then CALL LTPUT('MZ',91.1867) CALL LTINIT(1) write(6,*)'Central MZ mass' elseif(imz.eq.2)then CALL LTPUT('MZ',91.1867+0.0021) CALL LTINIT(1) write(6,*)'MZ mass up by one s.d.' elseif(imz.eq.3)then CALL LTPUT('MZ',91.1867-0.0021) CALL LTINIT(1) write(6,*)'MZ mass down by one s.d.' endif do imh=1,22 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate 2-sigma errors xchi2=chi2v(10)+2.**2 xalogmh_neg=divdif(alogmhv(1),chi2v(1),10,xchi2,2) xalogmh_pos=divdif(alogmhv(10),chi2v(10),11,xchi2,2) dalogmh_neg=alogmhbest-xalogmh_neg dalogmh_pos=xalogmh_pos-alogmhbest dmh_neg=10**alogmhbest-10**xalogmh_neg dmh_pos=10**xalogmh_pos-10**alogmhbest amh=10**alogmhbest write(6,*)'Higgs two-sigma errors:' write(6,*)'mh= ',amh,' + ',dmh_pos,' - ',dmh_neg write(6,*)'alogmh= ',alogmhbest, 1 ' + ',dalogmh_pos,' - ',dalogmh_neg * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv(10),chi2v(10),11,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv(10),chi2v(10),11,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' enddo ! imz *========================================================================== call ltinit(0) amh=88.3 amt=171.0 als=0.1192 albfitinv=128.908 alb=1./albfitinv call lttable6(amh,amt,als,alb,e4) enddo ! iloop *====================================================================== * special request of LB 20.01.99 to fit with mh=139 GeV from fit without 2-l CALL LTINIT(0) write(6,*)'Special fit fixing Mh to the value from no2loop fit' write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar for MH=no2loop fit' amh=amhno2loop CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) do ip=1,4 e4(ip,3)=0. e4(3,ip)=0. enddo write(6,*)'amh,chi2,ndf=',amh,chi2,ndf call lttable3(amh,amt,als,1./albfitinv,e4) *============================================================================ write(6,*)'MH upper limits' write(6,*)'With two loops corrections including Degrassi' ncase=4 do icase=1,ncase CALL LTINIT(0) IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') als=0.1178 CALL LTFPUT('VALUE','ALS',als) eals=0.0023 CALL LTFPUT('ERROR','ALS',eals) write(6,*)'als,eals=',als,eals CALL LTFUSE('USE','ALB-1') if(icase.eq.1)then * only LEP without SLAC CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') CALL LTFUSE('NOUSE','ALS') elseif(icase.eq.2)then * LEP + SLAC CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') elseif(icase.eq.3)then * LEP + SLAC +als(PDG) CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('USE','ALS') elseif(icase.eq.4)then * LEP + SLAC +als(PDG) + albar from Davier CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('USE','ALS') albinv=128.923 ! Davier CALL LTFPUT('VALUE','ALB-1',albinv) ealbinv=0.036 CALL LTFPUT('ERROR','ALB-1',ealbinv) write(6,*)'Davier: albinv,ealbinv=',albinv,ealbinv endif call ltinit(1) call ltget('S2',s2) call ltget('ALBAR',albar) call ltget('MZ',amz) write(6,*)'s2,albar,amz=',s2,albar,amz CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 write(6,*)'+LTOBZOR98: chi2/ndf= ',chi2,ndf *----------------------- alogmhbest=alogmh do imz=1,3 * vary MZ mass if(imz.eq.1)then CALL LTPUT('MZ',91.1867) CALL LTINIT(1) elseif(imz.eq.2)then CALL LTPUT('MZ',91.1867+0.0021) CALL LTINIT(1) elseif(imz.eq.3)then CALL LTPUT('MZ',91.1867-0.0021) CALL LTINIT(1) endif write(6,*)'imz,icase=',imz,icase call hbook1(1000+imz*10+icase,' ',1000,0.,2000.,0.) call hbook1(2000+imz*10+icase,' ',100,0.5,100.5,0.) write(6,*)'alogmhbest=',alogmhbest do imh=1,22 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 call hf1(1000+imz*10+icase,amh,chi2) enddo ! imh * calculate 1-sigma errors xchi2=chi2v(10)+1. xalogmh_neg=divdif(alogmhv(1),chi2v(1),10,xchi2,2) xalogmh_pos=divdif(alogmhv(10),chi2v(10),11,xchi2,2) dalogmh_neg=alogmhbest-xalogmh_neg dalogmh_pos=xalogmh_pos-alogmhbest dmh_neg=10**alogmhbest-10**xalogmh_neg dmh_pos=10**xalogmh_pos-10**alogmhbest amh=10**alogmhbest write(6,*)'Higgs one-sigma errors:' write(6,*)'mh= ',amh,' + ',dmh_pos,' - ',dmh_neg write(6,*)'alogmh= ',alogmhbest, 1 ' + ',dalogmh_pos,' - ',dalogmh_neg call hf1(2000+imz*10+icase,1.0,amh) call hf1(2000+imz*10+icase,2.0,dmh_pos) call hf1(2000+imz*10+icase,3.0,dmh_neg) * calculate 2-sigma errors xchi2=chi2v(10)+2.**2 xalogmh_neg=divdif(alogmhv(1),chi2v(1),10,xchi2,2) xalogmh_pos=divdif(alogmhv(10),chi2v(10),11,xchi2,2) dalogmh_neg=alogmhbest-xalogmh_neg dalogmh_pos=xalogmh_pos-alogmhbest dmh_neg=10**alogmhbest-10**xalogmh_neg dmh_pos=10**xalogmh_pos-10**alogmhbest amh=10**alogmhbest write(6,*)'Higgs two-sigma errors:' write(6,*)'mh= ',amh,' + ',dmh_pos,' - ',dmh_neg write(6,*)'alogmh= ',alogmhbest, 1 ' + ',dalogmh_pos,' - ',dalogmh_neg * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv(10),chi2v(10),11,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv(10),chi2v(10),11,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' enddo ! icase enddo ! imz call lthrout *========================================================================== * fit fourth generation in Ngen-deltaM plane elseif(ipart.eq.2)then * amh=90. * amh=300. * amh=50. amh=0. ! fit also mH amd4=130. nopt=1 iopt(1)=9 lvopt(1)=1 ! with Degrassi call ltn4m4(amh,amd4,iopt,lvopt,nopt) call lthrout elseif(ipart.eq.3)then call ltobzorfig endif ! ipart END ! LTOBZOR *CMZ : 11/01/99 00.56.03 by A.Rozanov *-- Author : A.Rozanov 13/09/98 SUBROUTINE LTTABLE6(AMH,AMT0,ALS,ALB0,V) * * *----------------------------------------------------------------------* * * * Name : LTTABLE6 * * (module) * * * * Description : * * calculate s2l from observables as Table 6 in * * UFN 39 (5) 503-538 * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMT - in - central value of Top mass * * ALS - in - central value of strong constant * * ALB - in - central value of e.m.constant at Mz scale * * V - variance matrix of fitted parameters * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 15/09/98 * * * * * * Last modifications : * * [name] Date : 15/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. parameter (nexp=9) parameter (ngru=4) character*5 keyval,keypred dimension keyval(nexp),keypred(nexp) data keyval /'AFBL','ATAU','AETAU', 1 'AFBB','AFBC','QFB','ALR', 2 'ABSLC','ACSLC'/ data keypred/'AFBL','ATAU','AETAU', 1 'AFBB','AFBC','QFB','ALR', 2 'AB','AC'/ real v(4,4) dimension vexp(nexp),eexp(nexp),vthe(nexp) real s2lexp(nexp),eps2lexp(nexp) real ens2lexp(nexp),es2lexp(nexp),s2lgru(ngru),ws2lgru(ngru) C ----------- end CDE -------------------------------------------------- s2lfun(x)=0.25*(1.-(1./x-sqrt(1./x**2-1))) write(6,*)'+LTTABLE6: AMH,AMT0,ALS,ALB=',AMH,AMT0,ALS,ALB0 AMT=AMT0 ALB=ALB0 * write(6,*) * 1'obs vexp eexp vthe efit pull' do i=1,nexp call ltget('MZ',amz) call ltput('ALBAR',ALB) call ltinit(1) * call ltput('MH',AMH) call ltput('MT',AMT) call ltput('ALSHAT',ALS) * call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) * call ltget(keypred(i),vthe(i)) if(keypred(i).EQ.'AFBL')then x=sqrt(4*vexp(i)/3.) s2lexp(i)=s2lfun(x) xp=sqrt(4*(vexp(i)+eexp(i))/3.) eps2lexp(i)=s2lfun(xp) xn=sqrt(4*(vexp(i)-eexp(i))/3.) ens2lexp(i)=s2lfun(xn) elseif(keypred(i).EQ.'ATAU'.or.keypred(i).EQ.'AETAU' 1 .or.keypred(i).EQ.'ALR')then x=vexp(i) s2lexp(i)=s2lfun(x) xp=vexp(i)+eexp(i) eps2lexp(i)=s2lfun(xp) xn=vexp(i)-eexp(i) ens2lexp(i)=s2lfun(xn) elseif(keypred(i).EQ.'AFBB')then call ltget('AB',AB) x=4*vexp(i)/(3*AB) s2lexp(i)=s2lfun(x) xp=4*(vexp(i)+eexp(i))/(3*AB) eps2lexp(i)=s2lfun(xp) xn=4*(vexp(i)-eexp(i))/(3*AB) ens2lexp(i)=s2lfun(xn) elseif(keypred(i).EQ.'AFBC')then call ltget('AC',AC) x=4*vexp(i)/(3*AC) s2lexp(i)=s2lfun(x) xp=4*(vexp(i)+eexp(i))/(3*AC) eps2lexp(i)=s2lfun(xp) xn=4*(vexp(i)-eexp(i))/(3*AC) ens2lexp(i)=s2lfun(xn) elseif(keypred(i).EQ.'QFB')then s2lexp(i)=vexp(i) eps2lexp(i)=vexp(i)+eexp(i) ens2lexp(i)=vexp(i)-eexp(i) else s2lexp(i)=0. eps2lexp(i)=1. ens2lexp(i)=1. endif enddo ! i * write(6,*) 1'obs s2l es2l gavrg errr cavrg errr' 2,' chi2 ndf' s2lcum=0. ws2lcum=0. call vzero(s2lgru,4) call vzero(ws2lgru,4) do i=1,nexp eps2lexp(i)=s2lexp(i)-eps2lexp(i) ens2lexp(i)=s2lexp(i)-ens2lexp(i) es2lexp(i)=amax1(abs(eps2lexp(i)),abs(ens2lexp(i))) s2lcum=s2lcum+s2lexp(i)/es2lexp(i)**2 ws2lcum=ws2lcum+1./es2lexp(i)**2 s2lc=s2lcum/ws2lcum es2lc=1./sqrt(ws2lcum) if(i.ge.1.and.i.le.3)then ig=1 elseif(i.ge.4.and.i.le.5)then ig=2 elseif(i.eq.6)then ig=3 elseif(i.ge.7.and.i.le.7)then ig=4 else ig=0 endif if(ig.ge.1)then s2lgru(ig)=s2lgru(ig)+s2lexp(i)/es2lexp(i)**2 ws2lgru(ig)=ws2lgru(ig)+1./es2lexp(i)**2 s2lg=s2lgru(ig)/ws2lgru(ig) es2lg=1./sqrt(ws2lgru(ig)) endif chi2=0. ndf=0 do k=1,i chi2=chi2+(s2lexp(k)-s2lc)**2/es2lexp(k)**2 ndf=ndf+1 enddo ndf=ndf-1 write(6,10020)keyval(i),s2lexp(i),es2lexp(i),s2lg,es2lg, 1 s2lc,es2lc,chi2,ndf 10020 format(1x,a5,6f9.5,f4.1,i2) enddo * END ! LTTABLE6 *CMZ : 15/09/98 09.37.59 by A.Rozanov *-- Author : A.Rozanov 13/09/98 SUBROUTINE LTTABLE66(AMH,AMT0,ALS,ALB0,V) * * *----------------------------------------------------------------------* * * * Name : LTTABLE66 * * (module) * * * * Description : * * calculate s2l from observables as Table 6 in * * UFN 39 (5) 503-538 * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMT - in - central value of Top mass * * ALS - in - central value of strong constant * * ALB - in - central value of e.m.constant at Mz scale * * V - variance matrix of fitted parameters * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 13/09/98 * * * * * * Last modifications : * * [name] Date : 13/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. parameter (nexp=9) character*5 keyval,key,keypred dimension keyval(nexp),keypred(nexp) data keyval /'AFBL','ATAU','AETAU', 1 'AFBB','AFBC','QFB','ALR', 2 'ABSLC','ACSLC'/ data keypred/'AFBL','ATAU','AETAU', 1 'AFBB','AFBC','QFB','ALR', 2 'AB','AC'/ real v(4,4),dfda(nexp,4),efit(nexp) dimension vexp(nexp),eexp(nexp),vthe(nexp),ethe(nexp), 1 epmh(nexp),enmh(nexp),pull(nexp) real s2l(100),pred(100,nexp),s2lexp(nexp),eps2lexp(nexp) real ens2lexp(nexp) C ----------- end CDE -------------------------------------------------- write(6,*)'+LTTABLE6: AMH,AMT0,ALS,ALB=',AMH,AMT0,ALS,ALB * write(6,*) * 1'obs vexp eexp vthe efit pull' do it=1,100 * amt=amt0-(it-50)*2.0 amt=amt0 alb=alb0+(it-50)*0.000005 do i=1,nexp call ltget('MZ',amz) call ltput('ALBAR',ALB) call ltinit(1) * call ltput('MH',AMH) call ltput('MT',AMT) call ltput('ALSHAT',ALS) * call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) * call ltget(keypred(i),vthe(i)) if(keypred(i).EQ.'ALBAR')vthe(i)=1./vthe(i) * calculate derivatives albinv=1./alb almh=alog10(amh) do ipar=1,4 if(ipar.eq.1)then amt1=amt+sqrt(v(1,1)) als1=als almh1=almh albinv1=albinv elseif(ipar.eq.2)then amt1=amt als1=als+sqrt(v(2,2)) almh1=almh albonv1=albinv elseif(ipar.eq.3)then amt1=amt als1=als almh1=almh+sqrt(v(3,3)) albinv1=albinv elseif(ipar.eq.4)then amt1=amt als1=als almh1=almh albinv1=albinv+sqrt(v(4,4)) endif alb1=1./albinv1 amh1=10**almh1 call ltput('ALBAR',ALB1) call ltinit(1) call ltput('MH',AMH1) call ltput('MT',AMT1) call ltput('ALSHAT',ALS1) call ltget(keypred(i),dfda(i,ipar)) if(keypred(i).EQ.'ALBAR')dfda(i,ipar)=1./dfda(i,ipar) dfda(i,ipar)=(dfda(i,ipar)-vthe(i))/sqrt(v(ipar,ipar)) enddo * efit(i)=0. do ipar=1,4 do jpar=1,4 efit(i)=efit(i)+dfda(i,ipar)*dfda(i,jpar)*v(ipar,jpar) enddo enddo efit(i)=sqrt(efit(i)) pull(i)=(vexp(i)-vthe(i))/eexp(i) key=keypred(i) if(key(1:4).eq.'MWMZ')then vexp(i)=vexp(i)*AMZ eexp(i)=eexp(i)*AMZ vthe(i)=vthe(i)*AMZ ethe(i)=ethe(i)*AMZ epmh(i)=epmh(i)*AMZ enmh(i)=enmh(i)*AMZ efit(i)=efit(i)*AMZ endif if(key(1:3).eq.'ALR')then s2alr=s2_fralr(vexp(i)) es2alr= 1 abs(0.5*(s2_fralr(vexp(i)+eexp(i))- 2 s2_fralr(vexp(i)-eexp(i)))) s2alrt=s2_fralr(vthe(i)) es2alrt= 1 abs(0.5*(s2_fralr(vthe(i)+ethe(i))- 2 s2_fralr(vthe(i)-ethe(i)))) ens2alr=-s2alrt+s2_fralr(vthemi) eps2alr=-s2alrt+s2_fralr(vthema) efitalr= 1 abs(0.5*(s2_fralr(vthe(i)+efit(i))- 2 s2_fralr(vthe(i)-efit(i)))) pullalr=(s2alr-s2alrt)/es2alr * write(6,10010)'s2ALR',s2alr,es2alr,s2alrt,efitalr, * 1 pullalr endif * write(6,10010)keyval(i),vexp(i),eexp(i),vthe(i),efit(i), * 1 pull(i) *10010 format(1x,a5,4f10.4,3f7.4,f5.1) call LTGET('SIN2E',s2l(it)) pred(it,i)=vthe(i) enddo ! i write(6,10030)it,s2l(it),(pred(it,ip),ip=1,nexp) 10030 format(1x,i4,10F7.5) enddo ! it * write(6,*) 1'obs s2l es2l es2l garg cavrg' do i=1,nexp s2lexp(i) =DIVDIF(s2l,pred(1,i),100,vexp(i),2) eps2lexp(i)=DIVDIF(s2l,pred(1,i),100,vexp(i)+eexp(i),2) 1 -s2lexp(i) ens2lexp(i)=DIVDIF(s2l,pred(1,i),100,vexp(i)-eexp(i),2) 1 -s2lexp(i) write(6,10020)keyval(i),s2lexp(i),eps2lexp(i),ens2lexp(i) 10020 format(1x,a5,3f10.5) enddo * END ! LTTABLE66 *CMZ : 09/03/99 19.57.20 by A.Rozanov *CMZ : 2.00/02 06/07/98 16.56.47 by A.Rozanov *-- Author : A.Rozanov 24/06/97 SUBROUTINE LTSUSY2 * * *----------------------------------------------------------------------* * * * Name : LTSUSY2 * * (module) * * * * Description : * * calculations of SUSY corrections * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 24/06/97 * * * * * * Last modifications : 28/09/98 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e4(4,4) double precision dsusylrva,dsusylrvr,dsusylrvm,t,h,aals double precision dsusyrv,dsusyrv_old parameter (nfit=900) dimension amtfit(nfit),eamtfit(nfit),amhfit(nfit), 1 emhpfit(nfit),emhnfit(nfit), 1 alsfit(nfit),ealsfit(nfit),albfit(nfit),ealbfit(nfit), 2 chi2fit(nfit),vafit(nfit),vrfit(nfit),vmfit(nfit) dimension amthfit(nfit),eamthfit(nfit), 1 alshfit(nfit),ealshfit(nfit),albhfit(nfit),ealbhfit(nfit), 2 chi2hfit(nfit) dimension amst1fit(nfit),amst2fit(nfit),thLRfit(nfit) * * initialisation CALL LTINIT(0) CALL LTFPUT('EWWG99','ALL',DUMMY) * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) * call hlimit(100000) call ltget('MZ',amz) ioption(9)=1. CALL LTFLAG('PRNT',0) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10070)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 10070 format('+LTSUSY2: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,' +- ',f7.3,f7.3) write(6,*)'+LTSUSY2: chi2/ndf= ',chi2,ndf amtsm=amt eamtsm=eamt amhsm=amh emhpsm=emhpos emhnsm=emhneg alssm=als ealssm=eals albsm=albfitinv ealbsm=ealbfitinv chi2sm=chi2 ndfsm=ndf probsm=prob(chi2sm,ndfsm) go to 1002 1004 continue call ltsusy_init(0) t=1.D0 h=1.D0 aals=0.1D0 amt=175. beta=atan(2.) call ltget('S2',s2) do i=5,100 amsb=i*10. call ltsusyput('MSB',amsb) amst1=sqrt(amsb**2+amt**2+amz**2*cos(2*beta)*(1.-s2)) call ltsusyput('MST1',amst1) vaa=dsusylrva(t,h,aals) vrr=dsusylrvr(t,h,aals) vmm=dsusylrvm(t,h,aals) write(6,*)'i,amsb,va,vr,vm=',i,amsb,vaa,vrr,vmm enddo do i=5,100 amsb=i*10. call ltsusyput('MSB',amsb) amgluino=amsb call ltsusyput('MGLUINO',amgluino) amst1=sqrt(amsb**2+amt**2+amz**2*cos(2*beta)*(1.-s2)) call ltsusyput('MST1',amst1) vaa=dsusylrva(t,h,aals) vrr=dsusylrvr(t,h,aals) vmm=dsusylrvm(t,h,aals) write(6,*)'i,amsb,va,vr,vm=',i,amsb,vaa,vrr,vmm drv_old=dsusyrv_old(t,h,aals) drv_new=dsusyrv(t,h,aals) write(6,*)'drv_old,drv_new=',drv_old,drv_new enddo return 1002 continue write(6,*)'Four parameter fit for six points in msb' npoint=6 do ifit=1,npoint CALL LTINIT(0) ioption(9)=1. CALL LTFPUT('EWWG99','ALL',DUMMY) * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit=',ifit call ltsusy_init(0) if(ifit.eq.1)then amsb=100. elseif(ifit.eq.2)then amsb=150. elseif(ifit.eq.3)then amsb=200. elseif(ifit.eq.4)then amsb=300. elseif(ifit.eq.5)then amsb=400. elseif(ifit.eq.6)then amsb=1000. else amsb=1000. endif call LTSUSYPUT('IMST1',1.) call LTSUSYPUT('IMST2',2.) D1=sqrt(0.1)*10. D2=sqrt(9.9)*10. call LTSUSYPUT('DMST1',D1) call LTSUSYPUT('DMST2',D2) write(6,*)'amsb=',amsb call ltsusyput('MSB',amsb) amgluino=amsb call ltsusyput('MGLUINO',amgluino) beta=atan(2.) call ltsusyput('BETA',beta) call LTSUSYGET('MLL',AMLL) write(6,*)'beta,AMLL=',beta,AMLL thlr=0. call ltsusyget('THETALR',thlr) call ltsusyget('MST1',AM1) call ltsusyget('MST2',AM2) write(6,*)'Stop masses mst1,mst2=',AM1,AM2 write(6,*)'mLL,ThetaLR=',AMLL,THLR CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 write(6,*)'+LTSUSY2: chi2/ndf= ',chi2,ndf amtfit(ifit)=amt eamtfit(ifit)=eamt amhfit(ifit)=amh emhpfit(ifit)=emhpos emhnfit(ifit)=emhneg alsfit(ifit)=als ealsfit(ifit)=eals albfit(ifit)=albfitinv ealbfit(ifit)=ealbfitinv chi2fit(ifit)=chi2 call ltput('MT',amt) call ltsusyget('THETALR',thlr) call ltsusyget('MST1',AM1) call ltsusyget('MST2',AM2) write(6,*)'Fit stop masses mst1,mst2=',AM1,AM2 write(6,*)'Fit ThetaLR=',THLR amst1fit(ifit)=AM1 amst2fit(ifit)=AM2 thLRfit(ifit)=thlr * call lttable2(amh,amt,als,1./albfitinv) * call lttable3(amh,amt,als,1./albfitinv,e4) t=(amt/amz)**2 h=(amh/amz)**2 aals=als vaa=dsusylrva(t,h,aals) vrr=dsusylrvr(t,h,aals) vmm=dsusylrvm(t,h,aals) write(6,*)'amsb,va,vr,vm=',amsb,vaa,vrr,vmm vafit(ifit)=vaa vrfit(ifit)=vrr vmfit(ifit)=vmm * make 3-par fits for mH=120 GeV write(6,*)'No als, yes albar for fixed MH fit' amh=120. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'amh,chi2,ndf=',amh,chi2,ndf write(6,10040)amt,eamt,sqrt(e4(1,1)),glbemt, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 amthfit(ifit)=amt eamthfit(ifit)=eamt alshfit(ifit)=als ealshfit(ifit)=eals albhfit(ifit)=albfitinv ealbhfit(ifit)=ealbfitinv chi2hfit(ifit)=chi2 enddo ! ifit write(6,*)'i thLR ', 1 'mh als chi2' do i=1,npoint write(6,10050)i,thLRfit(i), 1 amhfit(i),emhpfit(i),emhnfit(i), 2 alsfit(i),ealsfit(i), 2 chi2fit(i) enddo ! i write(6,*)'Fixing mh=120 GeV' write(6,*)'i mst1 mst2 ', 1 ' va vr vm als chi2' do i=1,npoint write(6,10060)i,amst1fit(i),amst2fit(i), 2 vafit(i),vrfit(i),vmfit(i), 3 alshfit(i),ealshfit(i),chi2hfit(i) enddo ! i write(6,*)'i chi2sm ndfsm probsm chi2h ndfh probh Rprob ' do i=1,npoint probh=prob(chi2hfit(i),ndf) rprob=probsm/probh write(6,10080)i,chi2sm,ndfsm,probsm, 3 chi2hfit(i),ndf,probh,rprob enddo ! i ************************************************************************* write(6,*)'Four parameter fit ===========================' npoint=3 do ifit=1,npoint CALL LTINIT(0) ioption(9)=1. CALL LTFPUT('EWWG99','ALL',DUMMY) * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit=',ifit call ltsusy_init(0) amsb=150. call ltsusyput('MSB',amsb) amgluino=amsb call ltsusyput('MGLUINO',amgluino) beta=atan(2.) call ltsusyput('BETA',beta) call LTSUSYGET('MLL',AMLL) write(6,*)'beta,AMLL=',beta,AMLL if(ifit.eq.1)then call LTSUSYPUT('IMST1',1.) call LTSUSYPUT('IMST2',1.) elseif(ifit.eq.2)then call LTSUSYPUT('IMST1',2.) call LTSUSYPUT('IMST2',2.) elseif(ifit.eq.3)then call LTSUSYPUT('IMST1',3.) call LTSUSYPUT('IMST2',3.) endif thlr=0. call ltsusyget('THETALR',thlr) call ltsusyget('MST1',AM1) call ltsusyget('MST2',AM2) write(6,*)'Stop masses mst1,mst2=',AM1,AM2 write(6,*)'mLL,ThetaLR=',AMLL,THLR CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 10030 format('+LTSUSY2: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,' +- ',f7.3,f7.3) write(6,*)'+LTSUSY2: chi2/ndf= ',chi2,ndf amtfit(ifit)=amt eamtfit(ifit)=eamt amhfit(ifit)=amh emhpfit(ifit)=emhpos emhnfit(ifit)=emhneg alsfit(ifit)=als ealsfit(ifit)=eals albfit(ifit)=albfitinv ealbfit(ifit)=ealbfitinv chi2fit(ifit)=chi2 call ltput('MT',amt) call ltsusyget('THETALR',thlr) call ltsusyget('MST1',AM1) call ltsusyget('MST2',AM2) write(6,*)'Fit stop masses mst1,mst2=',AM1,AM2 write(6,*)'Fit ThetaLR=',THLR amst1fit(ifit)=AM1 amst2fit(ifit)=AM2 thLRfit(ifit)=thlr * call lttable2(amh,amt,als,1./albfitinv) * call lttable3(amh,amt,als,1./albfitinv,e4) t=(amt/amz)**2 h=(amh/amz)**2 aals=als vaa=dsusylrva(t,h,aals) vrr=dsusylrvr(t,h,aals) vmm=dsusylrvm(t,h,aals) write(6,*)'amsb,va,vr,vm=',amsb,vaa,vrr,vmm vafit(ifit)=vaa vrfit(ifit)=vrr vmfit(ifit)=vmm * make 3-par fits for mH=120 GeV write(6,*)'No als, yes albar for fixed MH fit' amh=120. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'amh,chi2,ndf=',amh,chi2,ndf write(6,10040)amt,eamt,sqrt(e4(1,1)),glbemt, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 10040 format('+LTSUSY2: mt= ',f6.1,' +- ',2f6.1,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,' +- ',f7.3,f7.3) amthfit(ifit)=amt eamthfit(ifit)=eamt alshfit(ifit)=als ealshfit(ifit)=eals albhfit(ifit)=albfitinv ealbhfit(ifit)=ealbfitinv chi2hfit(ifit)=chi2 enddo ! ifit write(6,*)'i thLR ', 1 'mh als chi2' do i=1,npoint write(6,10050)i,thLRfit(i), 1 amhfit(i),emhpfit(i),emhnfit(i), 2 alsfit(i),ealsfit(i), 2 chi2fit(i) 10050 format(I2,1x,E10.4, 1 f6.1,' +',f6.1,' ',f6.1, 1 f6.4,' +-',f6.4,f6.2) enddo ! i write(6,*)'Fixing mh=120 GeV' write(6,*)'i mst1 mst2 ', 1 ' va vr vm als chi2' do i=1,npoint write(6,10060)i,amst1fit(i),amst2fit(i), 2 vafit(i),vrfit(i),vmfit(i), 3 alshfit(i),ealshfit(i),chi2hfit(i) 10060 format(I2,1x,2f6.1, 1 3f6.4, 1 f6.4,' +-',f6.4,f6.2) enddo ! i write(6,*)'i chi2sm ndfsm probsm chi2h ndfh probh Rprob ' do i=1,npoint probh=prob(chi2hfit(i),ndf) rprob=probsm/probh write(6,10080)i,chi2sm,ndfsm,probsm, 3 chi2hfit(i),ndf,probh,rprob 10080 format(I2,1x,f6.1,i3,E10.4,1x,f6.1,i3,E10.4,E10.4) enddo ! i *======================================================================= write(6,*)'Scan mst1-mst2 with 3 parameter fit =================' CALL LTINIT(0) ioption(9)=1. CALL LTFPUT('EWWG99','ALL',DUMMY) * CALL LTFPUT('VANCOUVER98','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') call ltsusy_init(0) np1=30 np2=30 do imsb=1,2 if(imsb.eq.1)amsb=150. ! first scan if(imsb.eq.2)amsb=200. ! second scan write(6,*)'amsb=',amsb chimin=999999999. am1min=200. am1max=1200. am2min=100. am2max=220. do i1=1,np1 do i2=1,np2 ifit=(i2-1)*np1+i1 call ltsusyput('MSB',amsb) amgluino=amsb call ltsusyput('MGLUINO',amgluino) beta=atan(2.) call ltsusyput('BETA',beta) call LTSUSYGET('MLL',AMLL) call LTSUSYPUT('IMST1',1.) call LTSUSYPUT('IMST2',2.) am1=am1min+(i1-1)*(am1max-am1min)/np1 if(am1.le.AMLL)then write(6,*)'Too small am1,AMLL=',am1,AMLL amst1fit(ifit)=-991. go to 666 endif D1=sqrt(am1**2-AMLL**2) * D1=10.+(1400./np1)*(i1-1) * if(imsb.eq.1)then * D2=20.+(200./np2)*(i2-1) * elseif(imsb.eq.2)then * D2=5.+(250./np2)*(i2-1) * D2=20.+(300./np2)*(i2-1) * endif am2=am2min+(i2-1)*(am2max-am2min)/np2 if(am2.ge.AMLL)then write(6,*)'Too big am2,AMLL=',am2,AMLL amst1fit(ifit)=-992. go to 666 endif D2=sqrt(AMLL**2-am2**2) call LTSUSYPUT('DMST1',D1) call LTSUSYPUT('DMST2',D2) * make 3-par fits for mH=120 GeV * write(6,*)'No als, yes albar for fixed MH fit D1,D2=',D1,D2 amh=120. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) amthfit(ifit)=amt eamthfit(ifit)=eamt alshfit(ifit)=als ealshfit(ifit)=eals albhfit(ifit)=albfitinv ealbhfit(ifit)=ealbfitinv chi2hfit(ifit)=chi2 if(chi2.lt.chimin)chimin=chi2 call ltput('MT',amt) call ltsusyget('THETALR',thlr) call ltsusyget('MLL',amLL) call ltsusyget('MST1',AM1) call ltsusyget('MST2',AM2) amst1fit(ifit)=AM1 amst2fit(ifit)=AM2 thLRfit(ifit)=thlr 666 continue enddo ! i1 enddo ! i2 write(6,*)'Fixing mh=120 GeV' write(6,*)'i j mst1 mst2 ', 1 ' als chi2' ih=int(amh)*1000+int(amsb) ihe=1000000+ih call hbook2(ih ,' ',20,am1min,am1max,20,am2min,am2max,0.) call hbook2(ihe,' ',20,am1min,am1max,20,am2min,am2max,0.) do i=1,np1*np2 i1=mod(i-1,np1)+1 i2=(i-1)/np1+1 if(amst1fit(i).gt.0.)then call hf2(ih,amst1fit(i),amst2fit(i),chi2hfit(i)-chimin) call hf2(ihe,amst1fit(i),amst2fit(i),1.) write(6,10090)i1,i2,amst1fit(i),amst2fit(i), 3 alshfit(i),ealshfit(i),chi2hfit(i) 10090 format(2I2,1x,2f6.1, 1 f6.4,' +-',f6.4,f6.2) endif enddo ! i enddo !imsb 999 continue call lthrout *========================================================================== END ! LTSUSY2 *CMZ : 22/09/98 19.16.31 by A.Rozanov *CMZ : 2.00/02 06/07/98 12.39.45 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DSUSYRV_OLD(T,H,ALSBAR) * * *----------------------------------------------------------------------* * * * Name : DSUSYRV_OLD * * (module) * * * * Description : * * SUSY E.W. corrections VR in appr x=y * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * [name] Date : 22/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEEP,DELTAC. COMMON/DELTAC/X,Y *KEND. EXTERNAL DELTA1 C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.)then X=(AMZ/AMSB)**2 * Y=(AMZ/AMGLUINO)**2 but simplification by MIV 04.07.98 Y=(AMZ/AMSB)**2 A=0.D0 B=1.D0 EPS=1.D-2 * in approximation x=y DSUSYRV_OLD=(ALSBAR/PI)*DGAUSS(DELTA1,A,B,EPS) else DSUSYRV_OLD=0. endif END ! DSUSYRV_OLD *CMZ : 29/09/98 20.23.39 by A.Rozanov *CMZ : 2.00/02 06/07/98 12.44.06 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION DELTA11(X,Y) * * *----------------------------------------------------------------------* * * * Name : DELTA * * (module) * * * * Description : * * SUSY Delta integrated over z1 and z by numerical calculation * * as function of x,y by Alesha Novikov * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 03/07/98 * * * * * * Last modifications : * * A.Rozanov Date : 22/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. integer*4 na(2) real*4 coor(2),a(20),f(10,10),finter,fint external fint data na/10,10/ data a/0.05,0.15,0.25,0.35,0.45,0.55,0.65,0.75,0.85,0.95, 1 0.05,0.15,0.25,0.35,0.45,0.55,0.65,0.75,0.85,0.95/ data f/0.00278709,0.00327851,0.00342478,0.00349688,0.00354015, 6 0.00356909,0.00358985,0.00360547,0.00361767,0.00362747, 1 0.0062974,0.0084180,0.00920426,0.00963309,0.00990711, 6 0.0100987,0.0102407,0.0103505,0.010438,0.0105095, 1 0.0087681,0.012561,0.0141268,0.0150288,0.0156262, 6 0.0160549,0.0163792,0.0166339,0.0168398,0.0170099, 1 0.0107257,0.0161076,0.0184908,0.0199160,0.0208804, 6 0.0215918,0.0221351,0.0225671,0.0229196,0.0232135, 1 0.0123673,0.0192445,0.0224505,0.0244227,0.0257885, 6 0.0268018,0.0275887,0.0282203,0.02874,0.029176, 1 0.0137921,0.0220783,0.0260997,0.0286302,0.0304105, 6 0.0317472,0.0327953,0.0336431,0.0343454,0.034938, 1 0.0150579,0.0246772,0.0295016,0.0325952,0.0348005, 6 0.0364732,0.0377954,0.0388722,0.0397693,0.0405302, 1 0.016202,0.027088,0.0327011,0.0363586,0.0389959, 6 0.0410138,0.0426203,0.0439363,0.0450383,0.0459769, 1 0.0172495,0.0293446,0.0357316,0.0399521,0.0430259, 6 0.045396,0.0472948,0.0488584,0.0501736,0.0512983, 1 0.0182186,0.0314725,0.038619,0.0434003,0.0469136, 6 0.0496415,0.0518391,0.0536575,0.0551931,0.0565110/ C ----------- end CDE -------------------------------------------------- * coor(1)=Y coor(2)=X finter=fint(2,coor,na,a,f) DELTA11=DBLE(finter) END ! DELTA11 *CMZ : 06/05/99 19.34.58 by A.Rozanov *CMZ : 2.00/02 04/07/98 21.21.03 by A.Rozanov *CMZ : 2.00/00 05/01/96 19.19.02 by A.Rozanov *CMZ : 1.30/08 22/02/95 16.28.16 by A.Rozanov *CMZ : 1.30/07 18/02/95 01.20.15 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTSUSYGET(CHKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTSUSYGET * * (module) * * * * Description : * * output of SUSY parameters for LEPTOP * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 26/09/98 * * * * * * Last modifications : * * Date : 27/09/98 * * * * Keywords : * * LTINIT, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEND. CHARACTER*(*) CHKEY REAL*4 VALUE * LK=LEN(CHKEY) T=(AMTCOM/AMZ)**2 * modify some constants IF(CHKEY(1:LK).eq.'MSB')THEN VALUE=SNGL(AMSB) ELSEIF(CHKEY(1:LK).EQ.'MSQ')THEN VALUE=SNGL(AMSQ) ELSEIF(CHKEY(1:LK).EQ.'MGLUINO')THEN VALUE=SNGL(AMGLUINO) ELSEIF(CHKEY(1:LK).EQ.'YL')THEN VALUE=SNGL(YL) ELSEIF(CHKEY(1:LK).EQ.'SUSYFL')THEN VALUE=SNGL(SUSYFL) ELSEIF(CHKEY(1:LK).EQ.'MST1')THEN VALUE=SNGL(AMST1F(T)) ELSEIF(CHKEY(1:LK).EQ.'MST2')THEN VALUE=SNGL(AMST2F(T)) ELSEIF(CHKEY(1:LK).EQ.'DMST1')THEN VALUE=SNGL(DMST1) ELSEIF(CHKEY(1:LK).EQ.'DMST2')THEN VALUE=SNGL(DMST2) ELSEIF(CHKEY(1:LK).EQ.'IMST1')THEN VALUE=IMST1 ELSEIF(CHKEY(1:LK).EQ.'IMST2')THEN VALUE=IMST2 ELSEIF(CHKEY(1:LK).EQ.'MHIGGS')THEN VALUE=SNGL(AMHIGGS) ! mass of big H ELSEIF(CHKEY(1:LK).EQ.'BETA')THEN VALUE=SNGL(BETA) ELSEIF(CHKEY(1:LK).EQ.'MLL')THEN VALUE=SNGL(AMLL(T)) ELSEIF(CHKEY(1:LK).EQ.'THETALR')THEN THLR=THETALR(T) VALUE=SNGL(THLR) ELSEIF(CHKEY(1:LK).EQ.'M0')THEN VALUE=SNGL(SUSY_M0) ELSEIF(CHKEY(1:LK).EQ.'MHF')THEN VALUE=SNGL(SUSY_MHF) ELSEIF(CHKEY(1:LK).EQ.'A0')THEN VALUE=SNGL(SUSY_A0) ELSEIF(CHKEY(1:LK).EQ.'SGNMU')THEN VALUE=SNGL(SUSY_SGNMU) ELSE WRITE(6,*)'+LTSUSYGET:wrong key',CHKEY(1:LK) ENDIF * print IF(PRTFLG(8).NE.0)THEN WRITE(6,10010)CHKEY(1:LK),VALUE 10010 FORMAT(1x,'+LTSUSYGET: ',A20,' = ',E16.8) ENDIF END ! LTSUSYGET *CMZ : 14/05/99 14.37.17 by A.Rozanov *CMZ : 2.00/02 05/07/98 20.18.46 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION THETALR(T) * * *----------------------------------------------------------------------* * * * Name : THETALR * * (function) * * * * Description : * * [description] * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 27/09/98 * * * * * * Last modifications : * * A.Rozanov Date : 29/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. C ----------- end CDE -------------------------------------------------- * AMZ2=AMZ**2 AMTOP2=T*AMZ2 TWOBETA=2*BETA AMLL2=AMSB**2+AMTOP2+AMZ2*DCOS(TWOBETA)*(1.-s2) * AMLL=DSQRT(AMLL2) AMST1C=AMST1F(T) AMST2C=AMST2F(T) DISCR=AMLL2-AMST2C**2 if(DISCR.eq.0.D0)then write(6,*)'+THETALR:DISCR,T,AMSB,AMTOP2,AMZ,BETA,S2,', 1 'AMST1C,AMST2C,AMLL2', 2 DISCR,T,AMSB,AMTOP2,AMZ,BETA,S2,AMST1C,AMST2C,AMLL2 DISCR=0.00000001 endif D2=(AMST1C**2-AMLL2)/DISCR if(D2.lt.0.D0)then if(D2.lt.-0.01)then write(6,*)'+THETALR:D2,T,AMSB,AMTOP2,AMZ,BETA,S2,', 1 'AMST1C,AMST2C,AMLL2', 2 D2,T,AMSB,AMTOP2,AMZ,BETA,S2,AMST1C,AMST2C,AMLL2 endif D2=0.00000001 endif TGTHETALR=dsqrt(D2) THETALR=DATAN(TGTHETALR) END ! THETALR *CMZ : 29/09/98 20.55.08 by A.Rozanov *CMZ : 2.00/02 05/07/98 20.18.46 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION AMLL(T) * * *----------------------------------------------------------------------* * * * Name : AMLL * * (function) * * * * Description : * * [description] * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 27/09/98 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. C ----------- end CDE -------------------------------------------------- * AMZ2=AMZ**2 AMTOP2=T*AMZ2 TWOBETA=2*BETA AMLL2=AMSB**2+AMTOP2+AMZ2*DCOS(TWOBETA)*(1.-s2) AMLL=DSQRT(AMLL2) END ! AMLL *CMZ : 08/12/98 16.08.01 by A.Rozanov *CMZ : 2.00/02 05/07/98 20.18.46 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION AMST1F(T) * * *----------------------------------------------------------------------* * * * Name : AMST1F * * (function) * * * * Description : * * calculation of the stop mass * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 30/09/98 * * * * * * Last modifications : * * A.Rozanov Date : 30/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. C ----------- end CDE -------------------------------------------------- * IF(IMST1.eq.0)then AMST1F=AMST1 elseif(IMST1.eq.1)then AMLL2=AMLL(T)**2 DM2=DMST1**2 AMST1F=dsqrt(AMLL2+DM2) elseif(IMST1.eq.2)then AMLL2=AMLL(T)**2 DM2=DMST2**2 AMST1F2=2*AMLL2-DM2-AMSB**2 if(AMST1F2.ge.0)then AMST1F=dsqrt(AMST1F2) else AMST1F=0. write(6,*)'+AMST1F: negative AMST1F2,DM2,AMSB=', + AMST1F2,DM2,AMSB endif elseif(IMST1.eq.3)then AMLL2=AMLL(T)**2 AMST1F=dsqrt(0.5*(3*AMLL2-AMSB**2)) else AMST1F=AMST1 write(6,*)'+AMST1F: wrong IMST1=',IMST1 endif END ! AMST1F *CMZ : 09/03/99 14.53.13 by A.Rozanov *CMZ : 2.00/02 05/07/98 20.18.46 by A.Rozanov *-- Author : A.Rozanov 03/07/98 DOUBLE PRECISION FUNCTION AMST2F(T) * * *----------------------------------------------------------------------* * * * Name : AMST2F * * (function) * * * * Description : * * calculation of the stop mass * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 30/09/98 * * * * * * Last modifications : * * A.Rozanov Date : 30/09/98 * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. C ----------- end CDE -------------------------------------------------- * IF(IMST2.eq.0)then AMST2F=AMST2 elseif(IMST2.eq.1)then AMST2F=AMSB elseif(IMST2.eq.2)then AMLL2=AMLL(T)**2 DM2=DMST2**2 AMST2F2=AMLL2-DM2 if(AMST2F2.ge.0.)then AMST2F=dsqrt(AMST2F2) else AMST2F2=0. write(6,*)'+AMST2F: negative AMST2F2,AMLL2,DM2=', + AMST2F2,AMLL2,DM2 endif elseif(IMST2.eq.3)then AMLL2=AMLL(T)**2 AMST2F=dsqrt(0.5*(AMLL2+AMSB**2)) else AMST2F=AMST2 write(6,*)'+AMST2F: wrong IMST2=',IMST2 endif END ! AMST2F *CMZ : 10/11/99 02.27.18 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LTN4M4(amh0,am40,iopt,lvopt,nopt) * * *----------------------------------------------------------------------* * * * Name : LTN4M4 * * (module) * * * * Description : * * calculations of the contour plot Number of generations vs * * difference in masses * * * * amh0 - Higgs mass * * am40 - fourth generation mass * * iopt - option number to be changed * * lvopt- option value to be changed * * nopt - number of options to be changed * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 21/12/98 * * * * * * Last modifications : 19/02/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e4(4,4) dimension amq4v(50),amu4v(50),chi24v(50) * parameter (n4=100) * parameter (nm4=100) * TEST small number of points parameter (n4=20) parameter (nm4=20) dimension dmq4f(nm4),an4f(n4),chi24f(n4,nm4) real*8 tt,alss,ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 real*8 dval4, dvaq4, dvrl4, dvrq4, dvml4, dvmq4 integer nopt,iopt(20),lvopt(20) write(6,*)'+LTN4M4: amh0,am40= ',amh0,am40 amh=amh0 am4=am40 * go to 555 556 continue *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) do i=1,nopt iold=IOPTION(iopt(i)) IOPTION(iopt(i))=lvopt(i) write(6,*)i,'Option No=',iopt(i), 1 'changed from= ',iold,' to ',lvopt(i) enddo if(IOPTION(9).eq.0)write(6,*)'WARNING NO DEGRASSI' * IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) go to 557 558 continue CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit amq4 als chi2 ndf ' * fit degenerate fourth generation do ifit=1,50 amq4=(ifit-1)*10. if(ifit.gt.21)amq4=100.+21*10.+(ifit-21)*100. aml4=amq4 call LTPUT('MU4',amq4) call LTPUT('MD4',amq4) call LTPUT('MN4',aml4) call LTPUT('ME4',aml4) AMH=90. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) amq4v(ifit)=amq4 chi24v(ifit)=chi2 * CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, * 1 eamt,eals,ealogmh,ealbfitinv, * 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) * CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) * CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) * CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) * amh=10**alogmh * emhpos=10**(alogmh+elogmhpos)-amh * emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) * write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, * 1 amh,emhpos,emhneg, * 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), * 1 glblogmh, * 2 als,eals,sqrt(e4(2,2)), * 2 albfitinv1,ealbfitinv1,ealbfitinv4 * write(6,*) ifit,amq4,amh,chi2,ndf write(6,10010) ifit,amq4,als,chi2,ndf 10010 format(i3,f6.0,f6.4,f12.2,i3) enddo ! ifit chi2sm=chi24v(1) ifit=14 dsig=sqrt(chi24v(ifit)-chi2sm) prob1=prob(chi2sm,ndf) prob2=prob(chi24v(ifit),ndf) write(6,*)'prob1,prob2=', prob1,prob2 write(6,*)'dsig=',dsig rprob=prob2/prob1 rinv=1./rprob write(6,*)'Assuming mH > 90 GeV and mq4 > ',amq4v(ifit) write(6,*)'fourth degenerate generation is depreciated by ' write(6,*) rinv,' times' write(6,*)'Relative probability of fourth generation = ', + rprob * fit non-degenerate fourth generation do iamd4=1,2 amd4=150.+(iamd4-1)*150. write(6,*)'ifit amd4 amu4 amh chi2 ndf ' ifitmin=0 chi2min=99999999. do ifit=1,50 ame4=amd4 amu4=amd4+(ifit-1)*2. if(ifit.ge.21)amu4=amd4+19.*2.+(ifit-20)*3. amn4=amu4 call LTPUT('MU4',amu4) call LTPUT('MD4',amd4) call LTPUT('MN4',amn4) call LTPUT('ME4',ame4) AMH=90. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) amu4v(ifit)=amu4 chi24v(ifit)=chi2 if(chi2.lt.chi2min)then chi2min=chi2 ifitmin=ifit endif * CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, * 1 eamt,eals,ealogmh,ealbfitinv, * 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) * CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) * CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) * CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) * amh=10**alogmh * emhpos=10**(alogmh+elogmhpos)-amh * emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) * write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, * 1 amh,emhpos,emhneg, * 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), * 1 glblogmh, * 2 als,eals,sqrt(e4(2,2)), * 2 albfitinv1,ealbfitinv1,ealbfitinv4 * write(6,*) ifit,amd4,amu4,amh,chi2,ndf write(6,10040) ifit,amd4,amu4,als,chi2,ndf 10040 format(i3,2f5.0,f6.4,f12.2,i3) enddo ! ifit dsig=sqrt(chi24v(ifitmin)-chi2sm) prob1=prob(chi2sm,ndf) prob2=prob(chi24v(ifitmin),ndf) write(6,*)'prob1,prob2=', prob1,prob2 write(6,*)'dsig=',dsig rprob=prob2/prob1 rinv=1./rprob write(6,*)'Assuming mH > 90 GeV and md4 > ',amd4 write(6,*)'fourth generation with mu4= ',amu4v(ifitmin) write(6,*)' is depreciated by ' write(6,*) rinv,' times' write(6,*)'Relative probability of fourth generation = ', + rprob * one side 95 % C.L. on mu4 xchi2=chi24v(ifitmin)+(1.64)**2 xamu4=divdif(amu4v(ifitmin),chi24v(ifitmin),50,xchi2,2) write(6,*)'One-side 95 % CL on mu4= ',xamu4 enddo ! iamd4 557 continue * non-degenerate fourth generation write(6,*)'ifit,ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4' do iamd4=1,2 amd4=150.+(iamd4-1)*150. do ifit=1,50 ame4=amd4 amu4=amd4+(ifit-1)*5. * if(ifit.gt.10)amq4=100.+(ifit-1)*100. amn4=amu4 call LTPUT('MU4',amu4) call LTPUT('MD4',amd4) call LTPUT('MN4',amn4) call LTPUT('ME4',ame4) tt=(175./91.)**2 alss=0.120 ddval4=dval4(tt,alss) ddvaq4=dvaq4(tt,alss) ddvrl4=dvrl4(tt,alss) ddvrq4=dvrq4(tt,alss) ddvml4=dvml4(tt,alss) ddvmq4=dvmq4(tt,alss) write(6,10050)ifit,amd4,amu4, + ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 enddo ! ifit enddo ! iamd4 * non-degenerate fourth generation write(6,*)'i,md4,mu4,', + 'ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4' do ifit=1,50 amd4=200.+(ifit-1)*4. ame4=amd4 amu4=400. amn4=amu4 call LTPUT('MU4',amu4) call LTPUT('MD4',amd4) call LTPUT('MN4',amn4) call LTPUT('ME4',ame4) tt=(175./91.)**2 alss=0.120 ddval4=dval4(tt,alss) ddvaq4=dvaq4(tt,alss) ddvrl4=dvrl4(tt,alss) ddvrq4=dvrq4(tt,alss) ddvml4=dvml4(tt,alss) ddvmq4=dvmq4(tt,alss) write(6,10050)ifit,amd4,amu4, + ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 10050 format(i3,2f6.0,6D10.4) enddo ! ifit 555 continue amh=amh0 if(amh0.le.0.)amh=90. am4=am40 imh=amh im4=am4 ih=imh*1000+im4 an4min=-0.5 an4max=+2.0 dm4min=0. dm4max=250. call hbook2(ih,' ',n4,an4min,an4max,nm4,dm4min,dm4max,0.) CHIMIN=0. *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) do i=1,nopt iold=IOPTION(iopt(i)) IOPTION(iopt(i))=lvopt(i) write(6,*)i,'Option No=',iopt(i), 1 'changed from= ',iold,' to ',lvopt(i) enddo if(IOPTION(9).eq.0)write(6,*)'WARNING NO DEGRASSI' * IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit amq4 als chi2 ndf ' * fit fourth generation plot n4 vs dm4 CALL LTPUT('MH',AMH) call LTPUT('MD4',am4) call LTPUT('ME4',am4) do i4=1,n4 an4=an4min+(i4-1+0.5)*(an4max-an4min)/n4 an4f(i4)=an4 call LTPUT('NQ4',an4) call LTPUT('NL4',an4) do im4=1,nm4 dm4=dm4min+(im4-1)*(dm4max-dm4min)/nm4 amu4=sqrt(am4**2+dm4**2) call LTPUT('MU4',amu4) call LTPUT('MN4',amu4) * write(6,*)'an4,am4=',an4,am4 if(amh0.gt.0.)then CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) else * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) * CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) * CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) * CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amhfit=10**alogmh * emhpos=10**(alogmh+elogmhpos)-amh * emhneg=10**(alogmh+elogmhneg)-amh CALL LTFUSE('NOUSE','MH') endif dmq4f(im4)=dm4 chi24f(i4,im4)=chi2 CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10060) i4,im4,an4,dm4,als,amhfit,chi2,ndf 10060 format(2i3,2f6.1,f6.4,2f12.2,i3) call hf2(ih,an4,dm4+0.0001,chi2-chimin) enddo ! im4 enddo ! i4 write(6,*)'dm4 ',(an4f(ip),ip=1,n4) do im4=1,nm4 * write(6,10070)dmq4f(im4),(chi24f(ip,im4),ip=1,n4) enddo 10070 format(f5.1,10f5.1) END ! LTN4M4 *CMZ : 01/02/99 18.08.27 by A.Rozanov *CMZ : 2.00/00 23/06/97 11.09.11 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTOBZORFIG * * *----------------------------------------------------------------------* * * * Name : LTOBZORFIG * * (module) * * * * Description : * * calculations for Progress in Physics * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 04/01/99 * * * * * * Last modifications : * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. double precision H,HM,HA,HR,T,TM,TA,TR double precision amwmz_exp,damwmz_exp,vmexp double precision s2_exp,ds2_exp,vrexp double precision ga_exp,dga_exp,vaexp parameter (nfit=5) dimension amt_t(nfit),damt_t(nfit),als_t(nfit),dals_t(nfit) dimension s2_t(nfit),ds2_t(nfit),ds2p_t(nfit),ds2n_t(nfit) dimension gva_t(nfit),dgva_t(nfit),dgvap_t(nfit),dgvan_t(nfit) dimension amw_t(nfit),damw_t(nfit),damwp_t(nfit),damwn_t(nfit) dimension amwz_t(nfit),damwz_t(nfit),damwzp_t(nfit), 3 damwzn_t(nfit) dimension sw_t(nfit),dsw_t(nfit),dswp_t(nfit),dswn_t(nfit) dimension chi2_t(nfit),ndf_t(nfit), 3 amtn_t(nfit),eamtn_t(nfit),alsn_t(nfit),ealsn_t(nfit), 4 amtp_t(nfit),eamtp_t(nfit),alsp_t(nfit),ealsp_t(nfit) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('EWWG99','ALL',DUMMY) * write(6,*)'Calculate now Vi_exp' call ltfget('VALUE','MWMZ',amwmz) call ltfget('ERROR','MWMZ',damwmz) amwmz_exp=amwmz damwmz_exp=damwmz vm_exp=vmexp(amwmz_exp) dvm_expp=vmexp(amwmz_exp+damwmz_exp)-vm_exp dvm_expn=vmexp(amwmz_exp-damwmz_exp)-vm_exp write(6,*)'amwmz_exp,damwmz_exp',amwmz_exp,damwmz_exp write(6,*)'vm_exp,dvm_expp,dvm_expn',vm_exp,dvm_expp,dvm_expn * * s2_exp = 0.23186D0 ! only LEP * ds2_exp = 0.00034D0 ! only LEP * s2_exp = 0.23143D0 * ds2_exp = 0.00028D0 s2_exp = 0.23157D0 ! EWWG draft-99 LEP+SLD ds2_exp = 0.00018D0 ! EWWG draft-99 LEP+SLD vr_exp = vrexp(s2_exp) dvr_expp = vrexp(s2_exp+ds2_exp)-vr_exp dvr_expn = vrexp(s2_exp-ds2_exp)-vr_exp write(6,*)'s2_exp,ds2_exp',s2_exp,ds2_exp write(6,*)'vr_exp,dvr_expp,dvr_expn',vr_exp,dvr_expp,dvr_expn * * ga_exp = -0.50119D0 ! only LEP * dga_exp = 0.00041D0 ! only LEP * ga_exp = -0.50111D0 * dga_exp = 0.00041D0 ga_exp = -0.50102D0 ! EWWG report table 29 LEP+SLD dga_exp = 0.00030D0 ! EWWG report table 29 LEP+SLD va_exp = vaexp(ga_exp) dva_expp = vaexp(ga_exp+dga_exp)-va_exp dva_expn = vaexp(ga_exp-dga_exp)-va_exp write(6,*)'ga_exp,dga_exp',ga_exp,dga_exp write(6,*)'va_exp,dva_expp,dva_expn',va_exp,dva_expp,dva_expn call hlimit(100000) * CALL LTFPUT('BEIJING95','ALL',DUMMY) * CALL LTFUSE('USE','MT') alb=1./128.878 * alb=1./128.87 CALL LTPUT('ALBAR',alb) call ltinit(1) * CALL LTGET('MZ',AMZ) CALL LTGET('S2',S2) write(6,*)'+LTOBZORFIG: s2=',s2 write(6,*)'AMH H HM(H) HA(H) HR(H)' do imh=-150,1000,50 if(imh.eq.-150)then AMH=0.01 elseif(imh.eq.-100)then AMH=0.1 elseif(imh.eq.-50)then AMH=1. elseif(imh.eq.0)then AMH=10. else AMH=FLOAT(imh) endif H=(AMH/AMZ)**2 HHM=HM(H) HHA=HA(H) HHR=HR(H) write(6,10010)AMH,H,HHM,HHA,HHR 10010 format(1x,f8.2,4f10.3) enddo ! imh * write(6,*)'AMT T TM(T) TA(T) TR(T)' do imt=0,300,10 AMT=FLOAT(imt) T=(AMT/AMZ)**2 TTM=TM(T) TTA=TA(T) TTR=TR(T) write(6,10020)AMT,T,TTM,TTA,TTR 10020 format(1x,f8.0,4f10.3) enddo ! imt *============================================================================ call ltplotvi * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') * ?????????????????????????? CALL LTFUSE('NOUSE','MT') alb=1./128.878 CALL LTPUT('ALBAR',alb) call ltinit(1) call lttable1(300.,60.,1000.) do imh=1,3 if(imh.eq.1)then AMH=60. elseif(imh.eq.2)then AMH=300. elseif(imh.eq.3)then AMH=1000. endif write(6,*)'amh=',AMH CALL LTPUT('MH',AMH) CALL LTFIT2('MT,ALS',amt,als,eamt,eals,rho,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) write(6,*)'+LTOBZORFIG: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' als= ',als,' +- ',eals write(6,*)'+LTOBZORFIG: rho,chi2= ',rho,chi2 enddo ! imh * * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * fit standard mt-mh plot first IH=4000 ID=IH+1 call hbook1(404,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ID,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.120 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(404,float(1),amt) call hf1(404,float(2),alsbar) call hf1(404,float(3),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTOBZORFIG: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTOBZORFIG: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) * make special fits with "future" measurements of Mt IH=2000 call hbook1(104,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ih+1,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+2,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) call hbook2(ih+3,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.125 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') do imt=1,3 ID=IH+imt if(imt.eq.1)then amtt=150. elseif(imt.eq.2)then amtt=175. elseif(imt.eq.3)then amtt=200. endif eamtt=5. CALL LTFPUT('VALUE','MT',amtt) CALL LTFPUT('ERROR','MT',eamtt) CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(104,float(1+(imt-1)*10),amt) call hf1(104,float(2+(imt-1)*10),alsbar) call hf1(104,float(3+(imt-1)*10),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTOBZORFIG: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTOBZORFIG: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) enddo ! imh CALL LTHROUT * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') * * start calculations for the table of fit results write(6,*)'start calculations for the table of fit results' * i=1 i=1 CALL LTFUSE('NOUSE','S2NUN') CALL LTFUSE('NOUSE','MWMZ') CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') CALL LTFUSE('NOUSE','MT') alb=1./128.878 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) gva_t(i)=1.-4*s2_t(i) dgva_t(i)=abs(1-4*(s2_t(i)+ds2_t(i))-gva_t(i)) dgvap_t(i)=abs(1-4*(s2_t(i)+ds2p_t(i))-gva_t(i)) dgvan_t(i)=abs(1-4*(s2_t(i)+ds2n_t(i))-gva_t(i)) sw_t(i)=1.-(amw_t(i)/amz)**2 dsw_t(i)=abs(1-((amw_t(i)+damw_t(i))/amz)**2-sw_t(i)) dswp_t(i)=abs(1-((amw_t(i)+damwp_t(i))/amz)**2-sw_t(i)) dswn_t(i)=abs(1-((amw_t(i)+damwn_t(i))/amz)**2-sw_t(i)) amwz_t(i)=amw_t(i)/amz damwz_t(i)=abs((amw_t(i)+damw_t(i))/amz-amwz_t(i)) damwzp_t(i)=abs((amw_t(i)+damwp_t(i))/amz-amwz_t(i)) damwzn_t(i)=abs((amw_t(i)+damwn_t(i))/amz-amwz_t(i)) * i=2 LEP + SLC i=2 CALL LTFUSE('NOUSE','S2NUN') CALL LTFUSE('NOUSE','MWMZ') CALL LTFUSE('USE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','MT') alb=1./128.878 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) gva_t(i)=1.-4*s2_t(i) dgva_t(i)=abs(1-4*(s2_t(i)+ds2_t(i))-gva_t(i)) dgvap_t(i)=abs(1-4*(s2_t(i)+ds2p_t(i))-gva_t(i)) dgvan_t(i)=abs(1-4*(s2_t(i)+ds2n_t(i))-gva_t(i)) sw_t(i)=1.-(amw_t(i)/amz)**2 dsw_t(i)=abs(1-((amw_t(i)+damw_t(i))/amz)**2-sw_t(i)) dswp_t(i)=abs(1-((amw_t(i)+damwp_t(i))/amz)**2-sw_t(i)) dswn_t(i)=abs(1-((amw_t(i)+damwn_t(i))/amz)**2-sw_t(i)) amwz_t(i)=amw_t(i)/amz damwz_t(i)=abs((amw_t(i)+damw_t(i))/amz-amwz_t(i)) damwzp_t(i)=abs((amw_t(i)+damwp_t(i))/amz-amwz_t(i)) damwzn_t(i)=abs((amw_t(i)+damwn_t(i))/amz-amwz_t(i)) * i=3 LEP + MW i=3 CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') CALL LTFUSE('NOUSE','MT') alb=1./128.878 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) gva_t(i)=1.-4*s2_t(i) dgva_t(i)=abs(1-4*(s2_t(i)+ds2_t(i))-gva_t(i)) dgvap_t(i)=abs(1-4*(s2_t(i)+ds2p_t(i))-gva_t(i)) dgvan_t(i)=abs(1-4*(s2_t(i)+ds2n_t(i))-gva_t(i)) sw_t(i)=1.-(amw_t(i)/amz)**2 dsw_t(i)=abs(1-((amw_t(i)+damw_t(i))/amz)**2-sw_t(i)) dswp_t(i)=abs(1-((amw_t(i)+damwp_t(i))/amz)**2-sw_t(i)) dswn_t(i)=abs(1-((amw_t(i)+damwn_t(i))/amz)**2-sw_t(i)) amwz_t(i)=amw_t(i)/amz damwz_t(i)=abs((amw_t(i)+damw_t(i))/amz-amwz_t(i)) damwzp_t(i)=abs((amw_t(i)+damwp_t(i))/amz-amwz_t(i)) damwzn_t(i)=abs((amw_t(i)+damwn_t(i))/amz-amwz_t(i)) * i=4 LEP +SLC + MW i=4 CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('USE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','MT') alb=1./128.878 CALL LTPUT('ALBAR',alb) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) gva_t(i)=1.-4*s2_t(i) dgva_t(i)=abs(1-4*(s2_t(i)+ds2_t(i))-gva_t(i)) dgvap_t(i)=abs(1-4*(s2_t(i)+ds2p_t(i))-gva_t(i)) dgvan_t(i)=abs(1-4*(s2_t(i)+ds2n_t(i))-gva_t(i)) sw_t(i)=1.-(amw_t(i)/amz)**2 dsw_t(i)=abs(1-((amw_t(i)+damw_t(i))/amz)**2-sw_t(i)) dswp_t(i)=abs(1-((amw_t(i)+damwp_t(i))/amz)**2-sw_t(i)) dswn_t(i)=abs(1-((amw_t(i)+damwn_t(i))/amz)**2-sw_t(i)) amwz_t(i)=amw_t(i)/amz damwz_t(i)=abs((amw_t(i)+damw_t(i))/amz-amwz_t(i)) damwzp_t(i)=abs((amw_t(i)+damwp_t(i))/amz-amwz_t(i)) damwzn_t(i)=abs((amw_t(i)+damwn_t(i))/amz-amwz_t(i)) * i=5 LEP +SLC + MW + mt i=5 CALL LTFUSE('USE','S2NUN') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('USE','ALR') CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('USE','MT') alb=1./128.878 CALL LTPUT('ALBAR',alb) CALL LTFLAG('PRNT',0) call lttab2(amt_t(i),damt_t(i),als_t(i),dals_t(i),s2_t(i), 1 ds2_t(i),ds2p_t(i),ds2n_t(i),amw_t(i),damw_t(i),damwp_t(i), 2 damwn_t(i),chi2_t(i),ndf_t(i), 3 amtn_t(i),eamtn_t(i),alsn_t(i),ealsn_t(i), 4 amtp_t(i),eamtp_t(i),alsp_t(i),ealsp_t(i)) write(6,*)'====================================================' write(6,10100) 10100 format(11x,'LEP',8x,'LEP+SLC',8x,'LEP+MW',8x,'LEP+SLC+MW', 1 4x,'LEP+SLC+MW+MT') gva_t(i)=1.-4*s2_t(i) dgva_t(i)=abs(1-4*(s2_t(i)+ds2_t(i))-gva_t(i)) dgvap_t(i)=abs(1-4*(s2_t(i)+ds2p_t(i))-gva_t(i)) dgvan_t(i)=abs(1-4*(s2_t(i)+ds2n_t(i))-gva_t(i)) sw_t(i)=1.-(amw_t(i)/amz)**2 dsw_t(i)=abs(1-((amw_t(i)+damw_t(i))/amz)**2-sw_t(i)) dswp_t(i)=abs(1-((amw_t(i)+damwp_t(i))/amz)**2-sw_t(i)) dswn_t(i)=abs(1-((amw_t(i)+damwn_t(i))/amz)**2-sw_t(i)) amwz_t(i)=amw_t(i)/amz damwz_t(i)=abs((amw_t(i)+damw_t(i))/amz-amwz_t(i)) damwzp_t(i)=abs((amw_t(i)+damwp_t(i))/amz-amwz_t(i)) damwzn_t(i)=abs((amw_t(i)+damwn_t(i))/amz-amwz_t(i)) write(6,*)'====================================================' write(6,10110)(amt_t(ip),damt_t(ip),ip=1,nfit) 10110 format(1x,'mt ',5(f6.1,'+-',f6.1,1x)) write(6,10111)((amtn_t(ip)-amt_t(ip)),ip=1,nfit) 10111 format(1x,'60 ',5(6x,' ',f6.1,1x)) write(6,10112)(amtp_t(ip)-amt_t(ip),ip=1,nfit) 10112 format('1000',5(6x,' ',f6.1,1x)) write(6,10120)(als_t(ip),dals_t(ip),ip=1,nfit) 10120 format(1x,'als',5(f6.3,'+-',f6.3,1x)) write(6,10121)(alsn_t(ip)-als_t(ip),ip=1,nfit) 10121 format(1x,'60 ',5(6x,' ',f6.3,1x)) write(6,10122)(alsp_t(ip)-als_t(ip),ip=1,nfit) 10122 format('1000',5(6x,' ',f6.3,1x)) write(6,10130)(s2_t(ip),ds2_t(ip),ip=1,nfit) 10130 format(1x,'s2 ',5(f6.4,'+-',f6.4,1x)) write(6,10140)(ds2p_t(ip),ip=1,nfit) write(6,10140)(ds2n_t(ip),ip=1,nfit) 10140 format(1x,' ',5(8x,f6.4,1x)) write(6,10180)(gva_t(ip),dgva_t(ip),ip=1,nfit) 10180 format('gva',5(1x,f6.5,'+-',f6.5)) write(6,10190)(dgvap_t(ip),ip=1,nfit) write(6,10190)(dgvan_t(ip),ip=1,nfit) 10190 format(' ',5(9x,f6.5)) write(6,10150)(amw_t(ip),damw_t(ip),ip=1,nfit) 10150 format(1x,'mw ',5(f6.2,'+-',f4.2,3x)) write(6,10160)(damwp_t(ip),ip=1,nfit) write(6,10160)(damwn_t(ip),ip=1,nfit) 10160 format(1x,' ',5(8x,f4.2,3x)) write(6,10220)(sw_t(ip),dsw_t(ip),ip=1,nfit) 10220 format(1x,'sw ',5(f6.4,'+-',f6.4)) write(6,10230)(dswp_t(ip),ip=1,nfit) write(6,10230)(dswn_t(ip),ip=1,nfit) 10230 format(1x,' ',5(8x,f6.4)) write(6,10200)(amwz_t(ip),damw_t(ip),ip=1,nfit) 10200 format(1x,'mwz',5(f6.4,'+-',f6.4)) write(6,10210)(damwzp_t(ip),ip=1,nfit) write(6,10210)(damwzn_t(ip),ip=1,nfit) 10210 format(1x,' ',5(8x,f6.4)) write(6,10070)(chi2_t(ip),ndf_t(ip),ip=1,nfit) 10070 format(1x,'chi2n',5(f6.1,'/',i2,5x)) END ! LTOBZORFIG *CMZ : 17/01/99 18.43.58 by A.Rozanov *-- Author : A.Rozanov 08/01/99 SUBROUTINE LTUFNTAB1(AMH,AMT,ALS,ALB,VV) * * *----------------------------------------------------------------------* * * * Name : LTUFNTAB1 * * (module) * * * * Description : * * calculate table of observables with Born predictions * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMT - in - central value of Top mass * * ALS - in - central value of strong constant * * ALB - in - central value of e.m.constant at Mz scale * * VV - variance matrix of fitted parameters * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 08/01/99 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. parameter (nexp=7) character*5 keyval,key,keypred dimension keyval(nexp),keypred(nexp) data keyval /'MWMZ','MW','S2W','GA','GL','GVA','S2L'/ data keypred/'MWMZ','MW','S2W','GA','GL','GVA','S2L'/ real vv(4,4),v(5,5),dfda(nexp,5),efit(nexp) dimension vexp(nexp),eexp(nexp),vthe(nexp),pull(nexp) C ----------- end CDE -------------------------------------------------- gv=-0.03753 egv=0.00044 ga=-0.50102 ega=0.00030 call vzero(v,25) do i=1,4 do j=1,4 v(i,j)=vv(i,j) enddo enddo call ltfget('VALUE','MZ',amz) call ltfget('ERROR','MZ',eamz) v(5,5)=eamz**2 write(6,*)'AMZ,AMH,AMT,ALS,ALB=',AMZ,AMH,AMT,ALS,ALB write(6,*) 1'Observable Experiment err Born err Pull ' do i=1,nexp call ltput('ALBAR',ALB) call ltinit(1) call ltput('MH',AMH) call ltput('MT',AMT) call ltput('ALSHAT',ALS) * if(keyval(i).eq.'MWMZ')then call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) elseif(keyval(i).eq.'MW')then call ltfget('VALUE','MWMZ',vexp(i)) call ltfget('ERROR','MWMZ',eexp(i)) vexp(i)=vexp(i)*amz eexp(i)=eexp(i)*amz elseif(keyval(i).eq.'S2W')then call ltfget('VALUE','MWMZ',amwmz) call ltfget('ERROR','MWMZ',eamwmz) vexp(i)=1.-amwmz**2 eexp(i)=2*amwmz*eamwmz elseif(keyval(i).eq.'GL')then call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) elseif(keyval(i).eq.'GV')then vexp(i)=gv eexp(i)=egv elseif(keyval(i).eq.'GA')then vexp(i)=ga eexp(i)=ega elseif(keyval(i).eq.'GVA')then vexp(i)=gv/ga eexp(i)=vexp(i)*sqrt((egv/gv)**2+(ega/ga)**2) elseif(keyval(i).eq.'S2L')then vexp(i)=0.25*(1.-gv/ga) eexp(i)=0.25*(gv/ga)*sqrt((egv/gv)**2+(ega/ga)**2) else * use fit results as "experimental" values call ltget(keypred(i),vexp(i)) * calculate derivatives albinv=1./alb almh=alog10(amh) do ipar=1,5 if(ipar.eq.1)then amz1=amz amt1=amt+sqrt(v(1,1)) als1=als almh1=almh albinv1=albinv elseif(ipar.eq.2)then amz1=amz amt1=amt als1=als+sqrt(v(2,2)) almh1=almh albonv1=albinv elseif(ipar.eq.3)then amz1=amz amt1=amt als1=als almh1=almh+sqrt(v(3,3)) albinv1=albinv elseif(ipar.eq.4)then amz1=amz amt1=amt als1=als almh1=almh albinv1=albinv+sqrt(v(4,4)) elseif(ipar.eq.5)then amz1=amz+sqrt(v(5,5)) amt1=amt als1=als almh1=almh albinv1=albinv endif alb1=1./albinv1 amh1=10**almh1 call ltput('MZ',amz1) call ltput('ALBAR',ALB1) call ltinit(1) call ltput('MH',AMH1) call ltput('MT',AMT1) call ltput('ALSHAT',ALS1) call ltget(keypred(i),dfda(i,ipar)) if(v(ipar,ipar).gt.0.)then dfda(i,ipar)=(dfda(i,ipar)-vexp(i))/sqrt(v(ipar,ipar)) else dfda(i,ipar)=0. endif enddo * eexp(i)=0. do ipar=1,5 do jpar=1,5 eexp(i)=eexp(i)+dfda(i,ipar)*dfda(i,jpar)*v(ipar,jpar) enddo enddo eexp(i)=sqrt(eexp(i)) endif * call ltput('MZ',amz) call ltput('ALBAR',ALB) call ltinit(1) call ltput('MH',AMH) call ltput('MT',AMT) call ltput('ALSHAT',ALS) call ltget_born(keypred(i),vthe(i)) if(keypred(i).EQ.'ALBAR')vthe(i)=1./vthe(i) * calculate derivatives albinv=1./alb almh=alog10(amh) do ipar=1,5 if(ipar.eq.1)then amz1=amz amt1=amt+sqrt(v(1,1)) als1=als almh1=almh albinv1=albinv elseif(ipar.eq.2)then amz1=amz amt1=amt als1=als+sqrt(v(2,2)) almh1=almh albinv1=albinv elseif(ipar.eq.3)then amz1=amz amt1=amt als1=als almh1=almh+sqrt(v(3,3)) albinv1=albinv elseif(ipar.eq.4)then amz1=amz amt1=amt als1=als almh1=almh albinv1=albinv+sqrt(v(4,4)) elseif(ipar.eq.5)then amz1=amz+sqrt(v(5,5)) amt1=amt als1=als almh1=almh albinv1=albinv endif alb1=1./albinv1 amh1=10**almh1 call ltput('MZ',amz1) call ltput('ALBAR',ALB1) call ltinit(1) call ltput('MH',AMH1) call ltput('MT',AMT1) call ltput('ALSHAT',ALS1) call ltget_born(keypred(i),dfda(i,ipar)) if(keypred(i).EQ.'ALBAR')dfda(i,ipar)=1./dfda(i,ipar) if(v(ipar,ipar).gt.0.)then dfda(i,ipar)=(dfda(i,ipar)-vthe(i))/sqrt(v(ipar,ipar)) else dfda(i,ipar)=0. endif enddo * efit(i)=0. do ipar=1,4 do jpar=1,4 efit(i)=efit(i)+dfda(i,ipar)*dfda(i,jpar)*v(ipar,jpar) enddo enddo efit(i)=sqrt(efit(i)) pull(i)=(vexp(i)-vthe(i))/eexp(i) key=keypred(i) write(6,10010)keyval(i),vexp(i),eexp(i),vthe(i),efit(i), 1 pull(i) 10010 format(1x,a5,4f11.5,f5.1) enddo * * END ! LTUFNTAB1 *CMZ : 11/01/99 20.32.37 by A.Rozanov *-- Author : A.Rozanov 08/01/99 SUBROUTINE LTGET_BORN(CHKEY,VALUE) * * *----------------------------------------------------------------------* * * * Name : LTGET * * (module) * * * * Description : * * interface to extract Born values from LEPTOP package * * * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 08/01/99 * * * * * * Last modifications : * * Date : 08/01/99 * * * * Keywords : * * LTINIT, LTGET *----------------------------------------------------------------------* *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,MTMHAL. COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM *KEEP,MASSES. COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT *KEEP,CAFBBB. COMMON/CAFBBB/EB,AMB,AMB0,VELOB *KEND. REAL*4 VALUE * * CHARACTER*(*) CHKEY * * get some constants or variables LK=LEN(CHKEY) T=(AMTCOM/AMZ)**2 H=(AMHCOM/AMZ)**2 * block of Born values IF(CHKEY(1:LK).EQ.'MW')THEN VALUED=AMWMZB(T,H,ALSCOM)*AMZ ELSEIF(CHKEY(1:LK).EQ.'MWMZ')THEN VALUED=AMWMZB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'S2W')THEN VALUED=1.-AMWMZB(T,H,ALSCOM)**2 ELSEIF(CHKEY(1:LK).EQ.'GL')THEN VALUED=GLB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'SIN2E'.OR.CHKEY(1:LK).EQ.'QFB')THEN call ltinit(1) VALUED=s2 ELSEIF(CHKEY(1:LK).EQ.'GZ')THEN VALUED=GZB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'RL')THEN VALUED=RLB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'SIGH')THEN VALUED=SIGHB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'RB')THEN VALUED=RBB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GH')THEN VALUED=GHB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GVA')THEN VALUED=GVAELB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'S2L')THEN VALUED=0.25*(1-GVAELB(T,H,ALSCOM)) ELSEIF(CHKEY(1:LK).EQ.'GV')THEN VALUED=GVAELB(T,H,ALSCOM)*GAELEB(T,H,ALSCOM) ELSEIF(CHKEY(1:LK).EQ.'GA')THEN VALUED=GAELEB(T,H,ALSCOM) ELSE VALUED=0.D0 WRITE(6,*)'+LTGET_BORN: wrong keyword: ',CHKEY ENDIF IF(PRTFLG(9).ne.0)THEN WRITE(6,10010)CHKEY(1:LK),VALUED 10010 FORMAT(1x,'+LTGET_BORN: ',A20,E16.8) ENDIF VALUE=SNGL(VALUED) END ! LTGET_BORN *CMZ : 14/01/99 18.27.07 by A.Rozanov *CMZ : 1.30/05 18/01/95 19.03.32 by A.Rozanov *CMZ : 1.30/02 17/01/95 23.36.30 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION PHI_OLD(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. OSPI=PI**2/3. Z1Z2V=Z1Z2(T,H) IF(Z1Z2V.EQ.0.)Z1Z2V=0.00000001 * if(IOPTION(5).eq.0.AND.IOPTION(6).EQ.0)then FAC56=0. * elseif(IOPTION(5).ne.0)then * FAC56=ALSBAR/PI * elseif(IOPTION(6).ne.0)then * FAC56=-ALSBAR/PI * endif * if(IOPTION(7).eq.0.AND.IOPTION(8).EQ.0)then FAC78=1. * elseif(IOPTION(7).ne.0)then * FAC78=(1+(2./T)*(Z1Z2V-1.)/Z1Z2V) * elseif(IOPTION(8).ne.0)then * FAC78=(1-(2./T)*(Z1Z2V-1.)/Z1Z2V) * endif CONST=(3-2*S2)/(2*S2*C2) CLOG=DLOG(T/C2) BRA1= -6.716+(8.368*C2*CLOG-3.408*C2)/T 1 +(9.126*C2**2*CLOG+2.26*C2**2)/T**2 2 +(4.043*C2**3*CLOG+7.41*C2**3)/T**3 BRA=2.88*CLOG+BRA1+BRA1*FAC56 * * 2.29 = (1./3.)*(PI**2-3.) ! from TH6855 before (31) * * PHI=CONST*(T*Z1Z2(T,H)*(1-2.29*ALSBAR/PI)+C2*BRA) ! until 24.03.94 * M.Vysotsky 24.03.94 correct double counting of alsbar/pi term ALPHAS=ALPHAMT(T,ALSBAR) IF(IOPTION(7).NE.0)ALPHAS=ALPHATT(T,ALSBAR) IF(T.GE.1.)THEN * PHI=CONST*(1.-OSPI*ALPHATT(T,ALSBAR)/PI) * 1 *(T*Z1Z2(T,H)+C2*BRA*afac) *-----L.B.O. 23.10.94 introduce (1-(pi2/3)(als/pi))inside brackets PHI=CONST* 1 ((1.-OSPI*ALPHAS/PI)*T + (Z1Z2V-1.)*T 2 +C2*BRA) !MIV 17.01.95 * In notations of eq.(1.84-1.85) of LEPTOP writeup: * fi(t)=CONST*(T+C2*BRA) * delta_fi(t)=CONST*(-OSPI*(ALPHAS/PI)*T+(Z1Z2-1)*T) *****1 ((1.-OSPI*ALPHATT(T,ALSBAR)/PI)*T*Z1Z2V*FAC78+C2*BRA) !MIV 17.01.95 *****1 ((1.-OSPI*ALPHATT(T,ALSBAR)/PI)*T*Z1Z2V*FAC78+C2*BRA) ELSE PHI=0. ENDIF * old phi is the sum of new phi + delta phi PHI_OLD=PHI END *CMZ : 14/01/99 18.27.07 by A.Rozanov *CMZ : 1.30/05 18/01/95 19.03.32 by A.Rozanov *CMZ : 1.30/02 17/01/95 23.36.30 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DPHI(T,H,ALSBAR) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. OSPI=PI**2/3. Z1Z2V=Z1Z2(T,H) IF(Z1Z2V.EQ.0.)Z1Z2V=0.00000001 CONST=(3-2*S2)/(2*S2*C2) ALPHAS=ALPHAMT(T,ALSBAR) IF(IOPTION(7).NE.0)ALPHAS=ALPHATT(T,ALSBAR) IF(T.GE.1.)THEN DPHI=CONST*(-OSPI*(ALPHAS/PI)*T + (Z1Z2V-1.)*T) ELSE DPHI=0. ENDIF END *CMZ : 15/01/99 15.49.08 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION FAL(ALBAR,S2) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * functions from UFN 39 (5) 1996 p.517 AR 15.01.99 DATA PI/3.141592654/ FAL=albar*(3.0099+16.4*(0.2311-s2))/(4*PI) END *CMZ : 15/01/99 09.33.58 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION FVL(ALBAR,S2) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * functions from UFN 39 (5) 1996 p.517 AR 15.01.99 DATA PI/3.141592654/ FVL=albar*(3.1878+14.9*(0.2311-s2))/(4*PI) END *CMZ : 15/01/99 09.33.58 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION FAU(ALBAR,S2) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * functions from UFN 39 (5) 1996 p.517 AR 15.01.99 DATA PI/3.141592654/ FAU=-albar*(2.6802+14.7*(0.2311-s2))/(4*PI) END *CMZ : 15/01/99 09.33.58 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION FVU(ALBAR,S2) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * functions from UFN 39 (5) 1996 p.517 AR 15.01.99 DATA PI/3.141592654/ FVU=-albar*(2.7329+14.2*(0.2311-s2))/(4*PI) END *CMZ : 15/01/99 09.33.58 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION FAD(ALBAR,S2) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * functions from UFN 39 (5) 1996 p.517 AR 15.01.99 DATA PI/3.141592654/ FAD=albar*(2.2221+13.5*(0.2311-s2))/(4*PI) END *CMZ : 15/01/99 09.33.58 by A.Rozanov *-- Author : A.Rozanov DOUBLE PRECISION FUNCTION FVD(ALBAR,S2) *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. * functions from UFN 39 (5) 1996 p.517 AR 15.01.99 DATA PI/3.141592654/ FVD=albar*(2.2287+13.5*(0.2311-s2))/(4*PI) END *CMZ : 15/01/99 15.33.27 by A.Rozanov *-- Author : A.Rozanov 15/01/99 SUBROUTINE TABCONSTVI * * *----------------------------------------------------------------------* * * * Name : TABCONSTVI * * (module) * * * * Description : * * calculations of constants of Vij * * for review in Reports on Progress in Physics * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 15/01/99 * * * * * * Last modifications : 15/01/99 * * * * Keywords : * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. double precision vau,vad,vru,vrd,vab,vrb,phi,dphi,val,vrl double precision t,h,als logical twoloops * do iloop=1,2 * initialisation CALL LTINIT(0) if(iloop.eq.1)then twoloops=.true. elseif(iloop.eq.2)then twoloops=.false. endif if(twoloops)then write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi else write(6,*)'No two loops corrections (also no Degrassi)' IOPTION(9)=0 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=1 ! 1 -no two loops in d4Vi,d5Vi,dPhi endif write(6,*)'opt(9),opt(10)=',ioption(9),ioption(10) CALL LTFPUT('EWWG99','ALL',DUMMY) albar=1./128.878 write(6,*)'1/albar=',1./albar call LTPUT('ALBAR',albar) alshat=0.120 als=alshat write(6,*)'alshat=',alshat call LTPUT('ALSHAT',alshat) amt=175. write(6,*)'amt=',amt call LTPUT('MT',amt) call LTGET('MZ',amz) CALL LTINIT(1) do ih=1,3 amh=ih*100. call LTPUT('MH',amh) write(6,*)'amh=',amh write(6,*)'cau,cad,cru,crd,cab,crb,cphi,cdphi' t=(amt/amz)**2 h=(amh/amz)**2 val0=val(t,h,als) vrl0=vrl(t,h,als) vau0=vau(t,h,als) vru0=vru(t,h,als) vad0=vad(t,h,als) vrd0=vrd(t,h,als) vab0=vab(t,h,als) vrb0=vrb(t,h,als) cau=vau0-val0 cad=vad0-val0 cru=vru0-vrl0 crd=vrd0-vrl0 cab=vab0-vad0 crb=vrb0-vrd0 cphi=phi(t,h,als) cdphi=dphi(t,h,als) write(6,10010)cau,cad,cru,crd,cab,crb,cphi,cdphi 10010 format(6f8.4,2f6.2) enddo ! ih enddo ! iloop END ! TABCONSTVI *CMZ : 18/01/99 20.19.27 by A.Rozanov *-- Author : A.Rozanov 15/01/99 SUBROUTINE TABCONSTLB * * *----------------------------------------------------------------------* * * * Name : TABCONSTVI * * (module) * * * * Description : * * calculations of constants of some constants for LB * * for review in Reports on Progress in Physics * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 17/01/99 * * * * * * Last modifications : 17/01/99 * * * * Keywords : * *----------------------------------------------------------------------* * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. real*4 eamz,albinv,ealbinv call ltinit(0) write(6,*)'GMU,AMZ=',GMU,AMZ fbar2=4*dsqrt(2.D0)*GMU*AMZ**2 call ltfget('ERROR','MZ',eamz) efbar2=4*dsqrt(2.D0)*GMU*2*AMZ*eamz fbar=dsqrt(fbar2) efbar=0.5*fbar*(efbar2/fbar2) call ltfget('VALUE','ALB-1',albinv) call ltfget('ERROR','ALB-1',ealbinv) sin2t2=4*pi/(dsqrt(2.D0)*GMU*AMZ**2*albinv) esin2t2=sin2t2*dsqrt((ealbinv/albinv)**2+(2*eamz/amz)**2) write(6,*)'fbar2,efbar2=',fbar2,efbar2 write(6,*)'fbar,efbar=',fbar,efbar write(6,*)'sin2t2,esin2t2=',sin2t2,esin2t2 END ! TABCONSTLB *CMZ : 18/01/99 23.35.45 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVML4_old(T,ALSBAR) * from draft TH-7252/94 preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/1/,QU/0.0000000/,QD/-1.0000000/ IF(AML4.GT.0.000001.OR.AMN4+AME4.GT.0.000001)THEN * firtst assume degenerate AMLL4=(AMN4+AME4)/2. if(AML4.gt.AMLL4)AMLL4=AML4 P=(AMLL4/AMZ)**2 * D=(1-P)*FP(P)-(1-P/C2)+2*S2*((1-P/C2)*FP(P/C2)-(1+2*P)*FP(P)) * CORRECT BACK TO OLD FORMULA 12.05.94 D=(1-P)*FP(P)-(1-P/C2)*FP(P/C2) 1 +2*S2*((1-P/C2)*FP(P/C2)-(1+2*P)*FP(P)) 2 +4*S2**2*(QU**2+QD**2)*((1+2*P)*FP(P)-0.3333333333) DVML4DG=(4./9.)*NC*D*NL4 * second calculate non-degenerate x=(AMN4/AME4)**2-1.D0 if(dabs(x).gt.1.D-10)then D=1./3.-2*(1+x)/x**2+3*(x+2./3.-x**3/6.)*DLOG(1.D0+x)/x**3 DVML4=DVAL4(T,ALSBAR)-2.*NC/9. 1 +4*NC*S2*(1.+2*QD)*DLOG(1.D0+x)/9. 2 +4.*NC*(S2-C2)*D/9. DVML4=DVML4*NL4 else DVML4=0. endif * soft transition from degenerate to nondegenerate case with AMDG2 DM2=(AME4-AMN4)**2 DVML4_old=(DVML4*DM2+DVML4DG*AMDG2)/(DM2+AMDG2) ELSE DVML4_old=0. ENDIF END *CMZ : 18/01/99 23.35.45 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVMQ4_old(T,ALSBAR) * from draft TH preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ IF(AMQ4.GT.0.000001.OR.AMU4+AMD4.GT.0.000001)THEN * first assume degenerate AMQQ4=(AMU4+AMD4)/2. if(AMQ4.gt.AMQQ4)AMQQ4=AMQ4 P=(AMQQ4/AMZ)**2 * D=(1-P)*FP(P)-(1-P/C2)+2*S2*((1-P/C2)*FP(P/C2)-(1+2*P)*FP(P)) * CORRECT BACK TO OLD FORMULA 12.05.94 D=(1-P)*FP(P)-(1-P/C2)*FP(P/C2) 1 +2*S2*((1-P/C2)*FP(P/C2)-(1+2*P)*FP(P)) 2 +4*S2**2*(QU**2+QD**2)*((1+2*P)*FP(P)-0.3333333333) DVMQ4DG=(4./9.)*NC*D*NQ4 * second non-degenerate x=(AMU4/AMD4)**2-1. if(dabs(x).gt.1.D-10)then D=1./3.-2*(1+x)/x**2+3*(x+2./3.-x**3/6.)*DLOG(1.D0+x)/x**3 DVMQ4=DVAQ4(T,ALSBAR)-2.*NC/9. 1 +4*NC*S2*(1.+2*QD)*DLOG(1.D0+x)/9. 2 +4.*NC*(S2-C2)*D/9. DVMQ4=DVMQ4*NQ4 else DVMQ4=0. endif * soft transition from degenerate to nondegenerate case with AMDG2 DM2=(AMU4-AMD4)**2 DVMQ4_old=(DVMQ4*DM2+DVMQ4DG*AMDG2)/(DM2+AMDG2) ELSE DVMQ4_old=0. ENDIF END *CMZ : 14/11/99 11.51.24 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVMF4(T,ALSBAR,NC,QU,QD,NF4,AMFU4,AMFD4 1 ,AMF4) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. Real*4 AMWZ Real*8 NF4 Save amw2 Logical First/.true./ if(First)then call ltfget('VALUE','MWMZ',amwz) amw2=(amwz*AMZ)**2 First=.false. endif if(NC.eq.1)then Y=-1. elseif(NC.eq.3)then Y=1./3. endif IF(AMF4.GT.0.000001.OR.AMFU4+AMFD4.GT.0.000001)THEN if(DABS(AMFU4-AMFD4).lt.0.1)then * degenerate AMFF4=(AMFU4+AMFD4)/2. if(AMF4.gt.AMFF4)AMFF4=AMF4 P=(AMFF4/AMZ)**2 D=(1-P)*FP(P)-(1-P/C2)*FP(P/C2) 1 +2*S2*((1-P/C2)*FP(P/C2)-(1+2*P)*FP(P)) 2 +4*S2**2*(QU**2+QD**2)*((1+2*P)*FP(P)-0.3333333333) DVMF4=(4./9.)*NC*D*NF4 else * non-degenerate x=(AMFU4/AMFD4)**2-1.D0 u=(AMFU4/AMZ)**2 d=(AMFD4/AMZ)**2 ud=u/d dlogud=dlog(ud) dmu=d-u if(dmu.ge.0.D0.and.dmu.lt.1.D-10)then dmu= 1.D-10 elseif(dmu.lt.0.D0.and.dmu.gt.-1.D-10)then dmu=-1.D-10 endif * call ltget('MW',amw) * amw2=amw**2 AMFU42=AMFU4**2 AMFD42=AMFD4**2 FI=FFF(amw2,amfu42,amfd42) * formula from Natasha Igumnova file 11.08.99 * DI=((1+2*u)*FP(u)-1./3.)*(S2**2*QU**2-S2*QU/2.) * 1 +((1+2*d)*FP(d)-1./3.)*(S2**2*QD**2+S2*QD/2.) * 1 +S2*Y*dlogud/4. * 1 +(1./8.)*((1-u)*FP(u)+(1-d)*FP(d)-2./3.) * 2 +(3./16.)*(S2/C2)*(u+d-2*u*d*dlogud/(u-d)) * 3 +(1./8.)*(1-S2/C2)*((u-d)*dlogud/2.+u+d * 4 +(C2-(u+d)/2.)*(u+d)*dlogud/(u-d)-4*C2/3. * 5 -(2*C2-(u+d)-(u-d)**2/C2)*FI) * DVMF4=(16./9.)*NC*DI*NF4 * formula from "Extra quark-lepton .." draft 4.08.99 Fu=FP(u) Fd=FP(d) DVMF4=(2./9.)*NC*(1-s2/c2)*(-FI*(2*c2-u-d-(u-d)**2/c2) 1 +u+d-(4./3.)*c2) 2 -(4*s2/9.)*NC*Y*((1+2*u)*Fu-(1+2*d)*Fd-dlogud) 3 +(16/9.)*NC*s2**2*(QU**2*((1+2*u)*Fu-1/3.) 3 +QD**2*((1+2*d)*Fd-1/3.)) 3 +(s2/(3*c2))*NC*(u+d) 4 +(2/9.)*NC*((1-u)*Fu+(1-d)*Fd-2/3.) 4 -(4/9.)*NC*S2*((1+2*u)*Fu+(1+2*d)*Fd-2/3.) 5 +(2/9.)*NC*dlogud*((1+1/c2)*u*d+(s2-c2)*(d+u))/dmu DVMF4=DVMF4*NF4 endif ELSE DVMF4=0. ENDIF END *CMZ : 19/01/99 17.30.25 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVRL4_old(T,ALSBAR) * from draft TH-7252/95 preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/1/,QU/0.0000000/,QD/-1.0000000/ IF(AML4.GT.0.000001.or.AMN4+AME4.gt.0.000001)THEN * first degenerate case AMLL4=(AMN4+AME4)/2. if(AML4.gt.AMLL4)AMLL4=AML4 P=(AMLL4/AMZ)**2 D=-3*P*FP(P)+4*S2*C2*(QU**2+QD**2)*((1+2*P)*FP(P)-0.333333333) DVRL4DG=(4./9.)*NC*D*NL4 * second non-degenerate x=(AMN4/AME4)**2-1. DVRL4=DVAL4(T,ALSBAR)-2.*NC/9. 1 +2*NC*(1.+2*QD)*DLOG(1.D0+x)/9. DVRL4=DVRL4*NL4 * soft transition from degenerate to nondegenerate case with AMDG2 DM2=(AME4-AMN4)**2 DVRL4_old=(DVRL4*DM2+DVRL4DG*AMDG2)/(DM2+AMDG2) ELSE DVRL4_old=0. ENDIF END *CMZ : 19/01/99 17.30.25 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVRQ4_old(T,ALSBAR) * from draft TH preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ IF(AMQ4.GT.0.000001.or.AMU4+AMD4.gt.0.000001)THEN * first degenerate case AMQQ4=(AMU4+AMD4)/2. if(AMQ4.gt.AMQQ4)AMQQ4=AMQ4 P=(AMQQ4/AMZ)**2 D=-3*P*FP(P)+4*S2*C2*(QU**2+QD**2)*((1+2*P)*FP(P)-0.333333333) DVRQ4DG=(4./9.)*NC*D*NQ4 * second non-degenerate case x=(AMU4/AMD4)**2-1. DVRQ4=DVAQ4(T,ALSBAR)-2.*NC/9. 1 +2*NC*(1.+2*QD)*DLOG(1.D0+x)/9. DVRQ4=DVRQ4*NQ4 * soft transition from degenerate to nondegenerate case with AMDG2 DM2=(AMU4-AMD4)**2 DVRQ4_old=(DVRQ4*DM2+DVRQ4DG*AMDG2)/(DM2+AMDG2) ELSE DVRQ4_old=0. ENDIF END *CMZ : 19/01/99 17.30.25 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVAL4_old(T,ALSBAR) * from draft TH preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/1/,QU/0.0000000/,QD/-1.0000000/ IF(AML4.GT.0.000001.or.AMN4+AME4.gt.0.000001)THEN * first degenerate case AMLL4=(AMN4+AME4)/2. if(AML4.gt.AMLL4)AMLL4=AML4 P=(AMLL4/AMZ)**2 D=(1-P)+(6*P**2-3*P)*FP(P) 1 +(4*S2**2*(QU**2+QD**2)-2*S2)*((2*P+1)-12*P**2*FP(P)) PPRIME=4*P-1. IF(DABS(PPRIME).LE.1.D-6)PPRIME=1.D-6 DVAL4DG=(-4./9.)*NC*D*NL4/PPRIME * second non-degenerate case x=(AMN4/AME4)**2-1. if(dabs(x).gt.1.D-10)then DVAL4=(NC/3.)*(AME4/AMZ)**2 1 *(2.+x-2*(1+1./x)*DLOG(1.D0+x)) DVAL4=DVAL4*NL4 else DVAL4=0. endif * soft transition from degenerate to nondegenerate case with AMDG2 DM2=(AME4-AMN4)**2 DVAL4_old=(DVAL4*DM2+DVAL4DG*AMDG2)/(DM2+AMDG2) ELSE DVAL4_old=0. ENDIF END *CMZ : 19/01/99 17.30.25 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVAQ4_old(T,ALSBAR) * from draft TH preprint 11.05.94 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEEP,FOURTH. REAL*8 AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4,AMN4,AME4,AMU4,AMD4,AMDG2 *KEND. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ IF(AMQ4.GT.0.000001.or.AMU4+AMD4.gt.0.000001)THEN * first degenerate case AMQQ4=(AMU4+AMD4)/2. if(AMQ4.gt.AMQQ4)AMQQ4=AMQ4 P=(AMQQ4/AMZ)**2 D=(1-P)+(6*P**2-3*P)*FP(P) 1 +(4*S2**2*(QU**2+QD**2)-2*S2)*((2*P+1)-12*P**2*FP(P)) PPRIME=4*P-1. IF(DABS(PPRIME).LE.1.D-6)PPRIME=1.D-6 DVAQ4=(-4./9.)*NC*D*NQ4/PPRIME * second non-degenerate case x=(AMU4/AMD4)**2-1. if(dabs(x).gt.1.D-10)then DVAQ4=(NC/3.)*(AMD4/AMZ)**2 1 *(2.+x-2*(1+1./x)*DLOG(1.D0+x)) DVAQ4=DVAQ4*NQ4 else DVAQ4=0. endif * soft transition from degenerate to nondegenerate case with AMDG2 DM2=(AMU4-AMD4)**2 DVAQ4_old=(DVAQ4*DM2+DVAQ4DG*AMDG2)/(DM2+AMDG2) ELSE DVAQ4_old=0. ENDIF END *CMZ : 11/02/99 17.43.31 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVAF4(T,ALSBAR,NC,QU,QD,NF4,AMFU4,AMFD4 1 ,AMF4) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. Real*8 NF4 IF(AMF4.GT.0.000001.OR.AMFU4+AMFD4.GT.0.000001)THEN if(DABS(AMFU4-AMFD4).lt.0.1)then * degenerate case AMFF4=(AMFU4+AMFD4)/2. if(AMF4.gt.AMFF4)AMFF4=AMF4 P=(AMFF4/AMZ)**2 D=(1-P)+(6*P**2-3*P)*FP(P) 1 +(4*S2**2*(QU**2+QD**2)-2*S2)*((2*P+1)-12*P**2*FP(P)) PPRIME=4*P-1. IF(DABS(PPRIME).LE.1.D-6)PPRIME=1.D-6 DVAF4=(-4./9.)*NC*D*NF4/PPRIME else * non-degenerate x=(AMFU4/AMFD4)**2-1.D0 u=(AMFU4/AMZ)**2 d=(AMFD4/AMZ)**2 * write(6,*)'+DVAF4:u,d,x=',u,d,x ud=u/d dlogud=dlog(ud) * ?????????? DI=(S2**2*QU**2-S2*QU/2.)*(2*u*FP(u)-(1+2*u)*FPRIME(u)) 1 +(S2**2*QD**2+S2*QD/2.)*(2*d*FP(d)-(1+2*d)*FPRIME(d)) 2 -(1./8.)*(u*FP(u)+(1-u)*FPRIME(u) 3 -(3./2.)*u+d*FP(d)+(1-d)*FPRIME(d)-(3./2.)*d 4 +3*u*d*dlogud/(u-d)) * write(6,*)'D,NF4=',D,NF4 DVAF4=(16./9.)*NC*DI*NF4 endif ELSE DVAF4=0. ENDIF END *CMZ : 14/11/99 11.51.24 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION DVRF4(T,ALSBAR,NC,QU,QD,NF4,AMFU4,AMFD4 1 ,AMF4) * from draft TH-7252/94 preprint 11.05.94 and VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. Real*8 NF4 if(NC.eq.1)then Y=-1. elseif(NC.eq.3)then Y=1./3. endif IF(AMF4.GT.0.000001.OR.AMFU4+AMFD4.GT.0.000001)THEN if(DABS(AMFU4-AMFD4).lt.0.1)then * degenerate case AMFF4=(AMFU4+AMFD4)/2. if(AMF4.gt.AMFF4)AMFF4=AMF4 P=(AMFF4/AMZ)**2 D=-3*P*FP(P)+4*S2*C2*(QU**2+QD**2)*((1+2*P)*FP(P)-0.333333333) DVRF4=(4./9.)*NC*D*NF4 else * non-degenerate x=(AMFU4/AMFD4)**2-1.D0 u=(AMFU4/AMZ)**2 d=(AMFD4/AMZ)**2 ud=u/d dlogud=dlog(ud) DI=(16./3.)*S2*C2*( QU**2*((1+2*u)*FP(u)-1./3.) 1 +QD**2*((1+2*d)*FP(d)-1./3.)) 2 +u+d-2*u*d*dlogud/(u-d)-2*u*FP(u)-2*d*FP(d) 3 +(2./3.)*Y*(dlogud-(1+2*u)*FP(u)+(1+2*d)*FP(d)) ! draft 4.08.99 good * 3 +(4./3.)*Y*(dlogud-(1+2*u)*FP(u)+(1+2*d)*FP(d)) ! bug NataliIgumnova11.02.99 DVRF4=(1./3.)*NC*DI*NF4 endif ELSE DVRF4=0. ENDIF END *CMZ : 22/01/99 17.04.06 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FFF(sp,am12p,am22p) * from VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. common/cfff/s,am12,am22 save FFFLAST external FFFLOG data A/0.D0/,B/1.D0/,EPS/1.D-3/ if(sp.eq.s.and.am12p.eq.am12.and.am22p.eq.am22)then FFF=FFFLAST else s=sp am12=am12p am22=am22p FI=DGAUSS(FFFLOG,A,B,EPS) FFF=-1+(am12+am22)*DLOG(am12/am22)/(2*(AM12-AM22))-FI 1 +0.5*DLOG(AM12*AM22) FFFLAST=FFF endif END *CMZ : 14/11/99 11.51.24 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.49 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FFFLOG(x) * from VAN draft 18.01.99 *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. common/cfff/s,am12,am22 FFFLOG=DLOG(x*x*s-x*(s+am12-am22)+am12) END *CMZ : 11/02/99 17.00.55 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.52.48 by A.Rozanov *CMZ : 1.30/00 10/01/95 18.34.50 by Rozanov Alexandre *-- Author : DOUBLE PRECISION FUNCTION FPRIME(P) * -P*dFP/dP (derivative) of the * formula F.2 on page 78 of Novikov et al, NP B397 (1993)35-83. * *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEND. OS4P=1./DSQRT(4.*P) IF(4*P.GE.1)THEN FPRIME=-1.+4*P*DASIN(OS4P)/DSQRT(4.*P-1.) ELSE T1=DSQRT(1.-4.*P) T2=(1.+T1)*OS4P FPRIME=-1.-4.*P*DLOG(T2)/T1 ENDIF END *CMZ : 11/04/99 21.08.40 by A.Rozanov *CMZ : 2.00/02 05/07/98 20.03.51 by A.Rozanov *CMZ : 2.00/01 03/11/97 19.33.54 by A.Rozanov *CMZ : 2.00/00 05/02/96 15.54.14 by A.Rozanov *-- Author : A.Rozanov 25/09/97 SUBROUTINE LTPREDMT(AMH,AMT,ALS,ALB,V) * * *----------------------------------------------------------------------* * * * Name : LTPREDMT * * (module) * * * * Description : * * calculate predivtions on mt from observables * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMT - in - central value of Top mass * * ALS - in - central value of strong constant * * ALB - in - central value of e.m.constant at Mz scale * * V - variance matrix of fitted parameters * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/02/99 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. parameter (nexp=20) character*5 keyval,key,keypred dimension keyval(nexp),keypred(nexp) data keyval /'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'ABSLC','ACSLC','MWMZ','S2NUN','MT', 3 'GL','S2L','GA'/ data keypred/'GZ','SIGH','RL','AFBL','ATAU','AETAU','RB', 1 'RC','AFBB','AFBC','QFB','ALR', 2 'AB','AC','MWMZ','S2NUN','MT', 3 'GL','S2L','GA'/ real v(4,4) dimension vexp(nexp),eexp(nexp),vthe(nexp) parameter (nmt=20) real mtval(nmt),vval(nmt) real mtpred(nexp),mtpredp(nexp),mtpredn(nexp) data mtval/50.,100.,110.,120.,130.,140.,150.,160.,165.,170., 1 175.,180.,185.,190.,200.,210.,220.,230.,250.,300./ C ----------- end CDE -------------------------------------------------- write(6,*)'AMH,AMT,ALS,ALB=',AMH,AMT,ALS,ALB write(6,*) 1'obs vexp eexp mt(pred.) +-dmt(pred)' do i=1,nexp call ltget('MZ',amz) call ltput('ALBAR',ALB) call ltinit(1) call ltput('MH',AMH) call ltput('ALSHAT',ALS) * call ltfget('VALUE',keyval(i),vexp(i)) call ltfget('ERROR',keyval(i),eexp(i)) * do it=1,nmt AMTV=mtval(it) call ltput('MT',AMTV) call ltget(keypred(i),vthe(i)) if(keypred(i).EQ.'ALBAR')vthe(i)=1./vthe(i) vval(it)=vthe(i) * write(6,*)'i,it,mtval,vval=',i,it,mtval(it),vval(it) enddo mtpred(i)=divdif(mtval,vval,nmt,vexp(i),2) mtpredp(i)=divdif(mtval,vval,nmt,vexp(i)+eexp(i),2) mtpredn(i)=divdif(mtval,vval,nmt,vexp(i)-eexp(i),2) * if(key(1:4).eq.'MWMZ')then vexp(i)=vexp(i)*AMZ eexp(i)=eexp(i)*AMZ endif dmt1=mtpredp(i)-mtpred(i) dmt2=mtpredn(i)-mtpred(i) write(6,10010)keyval(i),vexp(i),eexp(i),mtpred(i), 1 dmt1,dmt2 10010 format(1x,a5,2f10.4,3f7.1) enddo * * END ! LTPREDMT *CMZ : 10/02/99 21.53.54 by A.Rozanov *-- Author : subroutine LTGMU *KEEP,DOUBLE. IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,DEBUG. COMMON/DEBUG/PRTFLG(10) *KEEP,CONST. COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 *KEND. ame=0.000510999D0 amu=0.105658389D0 hcgevsec=6.5821220D0 ! in units 10**-25 GeV sec taumu=2.19703D0 ! in micro sec gammu=hcgevsec/taumu x=(ame/amu)**2 rmue=amu/ame fx=1.-8*x+8*x**3-x**4-12*x**2*dlog(x) amu5=amu**5*10**9 fact=amu5*fx/(192*pi**3) almu=1./(1./al-2*dlog(rmue)/(3*pi)+1./(6*pi)) cora =1.-al *(pi**2-25./4.)/(2.*pi) coral=1.-almu*(pi**2-25./4.)/(2.*pi) gmua=dsqrt(gammu/(fact*cora ))*1.D-5 gmual=dsqrt(gammu/(fact*coral))*1.D-5 prop=1+(3./5.)*(amu/80.33)**2 gmualprop=dsqrt(gammu/(fact*coral*prop))*1.D-5 write(6,*)'gmu,gmua,gmual,gmualprop=',gmu,gmua,gmual,gmualprop end *CMZ : 09/03/99 12.09.38 by A.Rozanov *CMZ : 2.00/02 05/07/98 20.03.51 by A.Rozanov *CMZ : 2.00/01 03/11/97 19.33.54 by A.Rozanov *CMZ : 2.00/00 05/02/96 15.54.14 by A.Rozanov *-- Author : A.Rozanov 25/09/97 SUBROUTINE LTSCANALB(AMH,AMT,ALS,ALB,V) * * *----------------------------------------------------------------------* * * * Name : LTSCANALB * * (module) * * * * Description : * * scan alb * * * * Arguments : * * AMH - in - central value of Higgs mass * * AMT - in - central value of Top mass * * ALS - in - central value of strong constant * * ALB - in - central value of e.m.constant at Mz scale * * V - variance matrix of fitted parameters * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/02/99 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * *KEEP,TYPING. *KEND. real*8 chi2n,chi2p,albexp,albthr,walb,chi2alb common/chi2np/chi2n,chi2p,albexp,albthr,walb,chi2alb integer NPAR * integer IFLAG real *8 X(4) * real *8 GIN(4),F dimension e4(4,4) C ----------- end CDE -------------------------------------------------- * CALL LTFLAG('PRNT',2) call ltput('MH',amh) call ltput('MT',amt) call ltput('ALSBAR',als) call ltput('ALBAR',alb) write(6,*)'i,albinv,chi2,chi2p,chi2n,albexp,albthr,walb,chi2alb' do i= 1,400 NPAR=4 x(1)=amt x(2)=als x(3)=alog10(amh) albinv=1./alb+(i-200)*0.002 x(4)=albinv albar=1./albinv albfitinv=albinv CALL LTPUT('ALBAR',albar) amtfit=amt alsfit=als amhfit=amh CALL LTFIT4('MT,ALS,LOGMH',amtfit,alsfit,alogmhfit,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) * iflag=3 * call FCNLB(NPAR,GIN,F,X,IFLAG) * write(6,*)'+LTSCANALB:i,albinv,f=',i,albinv,f write(6,10100)i,albinv,chi2,chi2p,chi2n,albexp,albthr, 1 walb,chi2alb 10100 format(1x,i3,f9.4,3f7.3,2f9.4,D12.5,f7.3) enddo CALL LTFLAG('PRNT',0) END ! LTSCANALB *CMZ : 11/04/99 22.35.47 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LTISOL * * *----------------------------------------------------------------------* * * * Name : LTISOL * * (module) * * * * Description : * * calculations of a la isolines * * of Yurov et al, PLB 308 (1993) p.123,TH-68-49/93 * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 11/04/99 * * * * * * Last modifications : 11/04/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e4(4,4) call hlimit(100000) call ltinit(0) * * The standard fit: no als, no Davier CALL LTINIT(0) write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') als=0.1178 CALL LTFPUT('VALUE','ALS',als) eals=0.0023 CALL LTFPUT('ERROR','ALS',eals) write(6,*)'als,eals=',als,eals albinv=128.878 ! Jegerlener CALL LTFPUT('VALUE','ALB-1',albinv) ealbinv=0.090 CALL LTFPUT('ERROR','ALB-1',ealbinv) write(6,*)'albinv,ealbinv=',albinv,ealbinv CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'no als, yes albar' CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) do ip=1,4 write(6,10200)(e4(ip,jp),jp=1,4) 10200 format(1x,4f10.6) enddo CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) CALL LTFGET('FIT_ERR+' ,'ALBAR-1',ealbpos) CALL LTFGET('FIT_ERR-' ,'ALBAR-1',ealbneg) CALL LTFGET('FIT_GLB' ,'ALBAR-1',glbalb) amh=10**alogmh if(ifit.eq.3)alogmhbest=alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbpos,ealbneg,ealbfitinv1,ealbfitinv4 10030 format('+LTISOL99: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,'+',f5.3,'-',f5.3,' +- ',f5.3,f5.3) write(6,*)'+LTISOL99: chi2/ndf= ',chi2,ndf * call lttable3(amh,amt,als,1./albfitinv,e4) do imh=1,4 if (imh.eq.1)then amh=50. elseif(imh.eq.2)then amh=100. elseif(imh.eq.3)then amh=130. elseif(imh.eq.4)then amh=300. endif call ltpredmt(amh,amt,als,1./albfitinv,e4) enddo ! imh * call ltscanalb(amh,amt,als,1./albfitinv,e4) * call ltisolfig END ! LTISOL *CMZ : 12/04/99 02.25.07 by A.Rozanov *CMZ : 2.00/00 23/06/97 11.09.11 by A.Rozanov *CMZ : 2.00/03 26/10/95 16.52.39 by A.Rozanov *-- Author : A.Rozanov 01/02/95 SUBROUTINE LTISOLFIG * * *----------------------------------------------------------------------* * * * Name : LTISOLFIG * * (module) * * * * Description : * * calculations for isolines * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 11/04/99 * * * * * * Last modifications : * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. double precision amwmz_exp,damwmz_exp,vmexp double precision s2_exp,ds2_exp,vrexp double precision ga_exp,dga_exp,vaexp * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('EWWG99','ALL',DUMMY) * write(6,*)'Calculate now Vi_exp' call ltfget('VALUE','MWMZ',amwmz) call ltfget('ERROR','MWMZ',damwmz) amwmz_exp=amwmz damwmz_exp=damwmz vm_exp=vmexp(amwmz_exp) dvm_expp=vmexp(amwmz_exp+damwmz_exp)-vm_exp dvm_expn=vmexp(amwmz_exp-damwmz_exp)-vm_exp write(6,*)'amwmz_exp,damwmz_exp',amwmz_exp,damwmz_exp write(6,*)'vm_exp,dvm_expp,dvm_expn',vm_exp,dvm_expp,dvm_expn * * s2_exp = 0.23186D0 ! only LEP * ds2_exp = 0.00034D0 ! only LEP * s2_exp = 0.23143D0 * ds2_exp = 0.00028D0 s2_exp = 0.23157D0 ! EWWG draft-99 LEP+SLD ds2_exp = 0.00018D0 ! EWWG draft-99 LEP+SLD vr_exp = vrexp(s2_exp) dvr_expp = vrexp(s2_exp+ds2_exp)-vr_exp dvr_expn = vrexp(s2_exp-ds2_exp)-vr_exp write(6,*)'s2_exp,ds2_exp',s2_exp,ds2_exp write(6,*)'vr_exp,dvr_expp,dvr_expn',vr_exp,dvr_expp,dvr_expn * * ga_exp = -0.50119D0 ! only LEP * dga_exp = 0.00041D0 ! only LEP * ga_exp = -0.50111D0 * dga_exp = 0.00041D0 ga_exp = -0.50102D0 ! EWWG report table 29 LEP+SLD dga_exp = 0.00030D0 ! EWWG report table 29 LEP+SLD va_exp = vaexp(ga_exp) dva_expp = vaexp(ga_exp+dga_exp)-va_exp dva_expn = vaexp(ga_exp-dga_exp)-va_exp write(6,*)'ga_exp,dga_exp',ga_exp,dga_exp write(6,*)'va_exp,dva_expp,dva_expn',va_exp,dva_expp,dva_expn call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * initialisation CALL LTINIT(0) write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('NOUSE','ALL') CALL LTFUSE('USE','MWMZ') CALL LTFUSE('USE','S2L') CALL LTFUSE('USE','GA') * * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) * fit standard mt-mh plot first IH=4000 ID=IH+1 call hbook1(404,'mt,als,MH',100,0.5,100.5,0.) call hbook2(ID,'Mt - Mh ',100,50.,250.,100,0.,1000.,0.) call hbook2(ID+4,'Mt - log(Mh) ',100,50.,250.,100,0.,3.,0.) call hbook2(ID+1,'Mt - Mh (Mw) ',100,50.,250.,100,0.,1000.,0.) call hbook2(ID+2,'Mt - Mh (s2) ',100,50.,250.,100,0.,1000.,0.) call hbook2(ID+3,'Mt - Mh (ga) ',100,50.,250.,100,0.,1000.,0.) ALSBAR=0.1194 write(6,*)'als=',ALSBAR CALL LTPUT('ALSHAT',ALSBAR) CALL LTFUSE('USE','MT') CALL LTFIT2('MT,MH',amt,amh,eamt,eamh,rho,chi2,ndf) call hf1(404,float(1),amt) call hf1(404,float(2),alsbar) call hf1(404,float(3),amh) * CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'MH',emhpos) CALL LTFGET('FIT_ERR-' ,'MH',emhneg) * write(6,*)'+LTISOLFIG: mt= ',amt,' + ',emtpos,' ',emtneg, 1 ' amh= ',amh,' + ',emhpos,' - ',emhneg write(6,*)'+LTISOLFIG: rho,chi2= ',rho,chi2 CALL LTPLOT2('MT,MH',ID) CALL LTPLOT2('MT,LOGMH',ID+4) do ii=1,3 if(ii.eq.1)then CALL LTFUSE('NOUSE','ALL') CALL LTFUSE('USE','MWMZ') elseif(ii.eq.2)then CALL LTFUSE('NOUSE','ALL') CALL LTFUSE('USE','S2L') elseif(ii.eq.3)then CALL LTFUSE('NOUSE','ALL') CALL LTFUSE('USE','GA') endif CALL LTPLOT2('MT,MH',ID+ii) enddo ! ii CALL LTHROUT END ! LTISOLFIG *CMZ : 14/05/99 14.38.27 by A.Rozanov *CMZ : 2.00/02 06/07/98 16.56.47 by A.Rozanov *-- Author : A.Rozanov 24/06/97 SUBROUTINE LTSUGRA * * *----------------------------------------------------------------------* * * * Name : LTSUGRA * * (module) * * * * Description : * * calculations of SUGRA corrections * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/05/99 * * * * * * Last modifications : 05/05/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. integer IOPTION REAL DUMMY,AMH REAL M0,MHF,A0,TANB,SGNMU,MT INTEGER IMODEL,IERR integer nfit,np1,np2,imu,i1,i2,ifit,ndf,ih,ihe,i parameter (nfit=900) real amthfit(nfit),eamthfit(nfit), 1 alshfit(nfit),ealshfit(nfit),albhfit(nfit),ealbhfit(nfit), 2 chi2hfit(nfit) real am0fit(nfit),amhffit(nfit) real beta,vmu,chimin,am0min,am0max,amhfmin,amhfmax,tanbeta real am0,amhf,amt,als,albfitinv,eamt,eamh,eals,ealbfitinv real e4(4,4),chi2 * * * initialisation CALL LTINIT(0) call ltsusy_init(0) CALL LTFPUT('EWWG99','ALL',DUMMY) * extract from SUGRUN imodel=1 ! 1 -sugra model * Point 3 M0=800. MHF=200. A0=0. TANB=10. BETA=ATAN(TANB) SGNMU=-1. MT=175. call ltsusyput('M0',M0) call ltsusyput('MHF',MHF) call ltsusyput('A0',A0) call ltsusyput('BETA',BETA) call ltsusyput('SGNMU',SGNMU) CALL MYSUGRUN(M0,MHF,A0,TANB,SGNMU,MT,IMODEL) CALL FSUGRUN(MT,IERR,AMH) write(6,*)'+LTSUGRA: IERR,AMH=', IERR,AMH * call hlimit(100000) *======================================================================= write(6,*)'Scan mA - tan(Beta) with 3 parameter fit =============' CALL LTINIT(0) ioption(9)=1. CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of moriond98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') np1=10 np2=10 do imu=1,2 if(imu.eq.1)vmu=-1. ! first scan if(imu.eq.2)vmu=+10. ! second scan write(6,*)'mu=',vmu chimin=999999999. am0min=0. am0max=2000. amhfmin=0. amhfmax=1000. tanbeta=10. a0=0. sgnmu=vmu beta=atan(tanbeta) flag=1. call ltsusyput('BETA',beta) call ltsusyput('A0',a0) call ltsusyput('SGNMU',sgnmu) call ltsusyput('SUSYFL',flag) do i1=1,np1 do i2=1,np2 ifit=(i2-1)*np1+i1 am0 =am0min +(i1-0.5)*(am0max -am0min )/np1 amhf=amhfmin+(i2-0.5)*(amhfmax-amhfmin)/np2 write(6,*)'am0,amhf=',am0,amhf call ltsusyput('M0',am0) call ltsusyput('MHF',amhf) * make 3-par fits for mH=120 GeV * write(6,*)'No als, yes albar for fixed MH fit D1,D2=',D1,D2 call fsugrun(MT,ierr,amh) if(ierr.eq.0)then CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'i1,i2,amt,als,albfininv,ndf,chi2=', 1 i1,i2,amt,als,albfininv,ndf,chi2 amthfit(ifit)=amt eamthfit(ifit)=eamt alshfit(ifit)=als ealshfit(ifit)=eals albhfit(ifit)=albfitinv ealbhfit(ifit)=ealbfitinv chi2hfit(ifit)=chi2 if(chi2.lt.chimin)chimin=chi2 am0fit(ifit)=am0 amhffit(ifit)=amhf else amthfit(ifit)=0. eamthfit(ifit)=0. alshfit(ifit)=0. ealshfit(ifit)=0. albhfit(ifit)=0. ealbhfit(ifit)=0. chi2hfit(ifit)=9999. am0fit(ifit)=0. amhffit(ifit)=0. endif 666 continue enddo ! i1 enddo ! i2 write(6,*)'Fixing A0, tan(beta), sgnmu' write(6,*)'i j m0 m1/2 ', 1 ' als chi2' ih= 1000+1+imu ihe=1000000+ih call hbook2(ih ,' ',20,am0min,am0max,20,amhfmin,amhfmax,0.) call hbook2(ihe,' ',20,am0min,am0max,20,amhfmin,amhfmax,0.) do i=1,np1*np2 i1=mod(i-1,np1)+1 i2=(i-1)/np1+1 if(am0fit(i).gt.0.)then call hf2(ih,am0fit(i),amhffit(i),chi2hfit(i)-chimin) call hf2(ihe,am0fit(i),amhffit(i),1.) write(6,10090)i1,i2,am0fit(i),amhffit(i), 3 alshfit(i),ealshfit(i),chi2hfit(i) 10090 format(2I2,1x,2f6.1, 1 f6.4,' +-',f6.4,f6.2) endif enddo ! i enddo !imsb 999 continue call lthrout *========================================================================== END ! LTSUGRA *CMZ : 07/05/99 14.19.32 by A.Rozanov *-- Author : A.Rozanov 05/05/99 SUBROUTINE MYSUGRUN(M0,MHF,A0,TANB,SGNMU,MT,IMODEL) * * *----------------------------------------------------------------------* * * * Name : MYSUGRUN * * (module) * * * * Description : * * [description] * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/05/99 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * C C Main program to calculate MSSM input parameters for ISAJET C from renormalization group equations and supergravity. C All external names are of the form SUxxxx. C Must link with block data ALDATA. C IMPLICIT NONE *+CDE,SSLUN COMMON/SSLUN/LOUT INTEGER LOUT SAVE /SSLUN/ *+CDE,SSPAR C SUSY parameters C AMGLSS = gluino mass C AMULSS = up-left squark mass C AMELSS = left-selectron mass C AMERSS = right-slepton mass C AMNiSS = sneutrino mass for generation i C TWOM1 = Higgsino mass = - mu C RV2V1 = ratio v2/v1 of vev's C AMTLSS,AMTRSS = left,right stop masses C AMT1SS,AMT2SS = light,heavy stop masses C AMBLSS,AMBRSS = left,right sbottom masses C AMB1SS,AMB2SS = light,heavy sbottom masses C AMLLSS,AMLRSS = left,right stau masses C AML1SS,AML2SS = light,heavy stau masses C AMZiSS = signed mass of Zi C ZMIXSS = Zi mixing matrix C AMWiSS = signed Wi mass C GAMMAL,GAMMAR = Wi left, right mixing angles C AMHL,AMHH,AMHA = neutral Higgs h0, H0, A0 masses C AMHC = charged Higgs H+ mass C ALFAH = Higgs mixing angle C AAT = stop trilinear term C THETAT = stop mixing angle C AAB = sbottom trilinear term C THETAB = sbottom mixing angle C AAL = stau trilinear term C THETAL = stau mixing angle C AMGVSS = gravitino mass COMMON/SSPAR/AMGLSS,AMULSS,AMURSS,AMDLSS,AMDRSS,AMSLSS $,AMSRSS,AMCLSS,AMCRSS,AMBLSS,AMBRSS,AMB1SS,AMB2SS $,AMTLSS,AMTRSS,AMT1SS,AMT2SS,AMELSS,AMERSS,AMMLSS,AMMRSS $,AMLLSS,AMLRSS,AML1SS,AML2SS,AMN1SS,AMN2SS,AMN3SS $,TWOM1,RV2V1,AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS,ZMIXSS(4,4) $,AMW1SS,AMW2SS $,GAMMAL,GAMMAR,AMHL,AMHH,AMHA,AMHC,ALFAH,AAT,THETAT $,AAB,THETAB,AAL,THETAL,AMGVSS REAL AMGLSS,AMULSS,AMURSS,AMDLSS,AMDRSS,AMSLSS $,AMSRSS,AMCLSS,AMCRSS,AMBLSS,AMBRSS,AMB1SS,AMB2SS $,AMTLSS,AMTRSS,AMT1SS,AMT2SS,AMELSS,AMERSS,AMMLSS,AMMRSS $,AMLLSS,AMLRSS,AML1SS,AML2SS,AMN1SS,AMN2SS,AMN3SS $,TWOM1,RV2V1,AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS,ZMIXSS $,AMW1SS,AMW2SS $,GAMMAL,GAMMAR,AMHL,AMHH,AMHA,AMHC,ALFAH,AAT,THETAT $,AAB,THETAB,AAL,THETAL,AMGVSS REAL AMZISS(4) EQUIVALENCE (AMZISS(1),AMZ1SS) SAVE /SSPAR/ *+CDE,SSTYPE C SM ident code definitions. These are standard ISAJET but C can be changed. INTEGER IDUP,IDDN,IDST,IDCH,IDBT,IDTP INTEGER IDNE,IDE,IDNM,IDMU,IDNT,IDTAU INTEGER IDGL,IDGM,IDW,IDZ PARAMETER (IDUP=1,IDDN=2,IDST=3,IDCH=4,IDBT=5,IDTP=6) PARAMETER (IDNE=11,IDE=12,IDNM=13,IDMU=14,IDNT=15,IDTAU=16) PARAMETER (IDGL=9,IDGM=10,IDW=80,IDZ=90) C SUSY ident code definitions. They are chosen to be similar C to those in versions < 6.50 but may be changed. INTEGER ISUPL,ISDNL,ISSTL,ISCHL,ISBT1,ISTP1 INTEGER ISNEL,ISEL,ISNML,ISMUL,ISNTL,ISTAU1 INTEGER ISUPR,ISDNR,ISSTR,ISCHR,ISBT2,ISTP2 INTEGER ISNER,ISER,ISNMR,ISMUR,ISNTR,ISTAU2 INTEGER ISZ1,ISZ2,ISZ3,ISZ4,ISW1,ISW2,ISGL INTEGER ISHL,ISHH,ISHA,ISHC INTEGER ISGRAV PARAMETER (ISUPL=21,ISDNL=22,ISSTL=23,ISCHL=24,ISBT1=25,ISTP1=26) PARAMETER (ISNEL=31,ISEL=32,ISNML=33,ISMUL=34,ISNTL=35,ISTAU1=36) PARAMETER (ISUPR=41,ISDNR=42,ISSTR=43,ISCHR=44,ISBT2=45,ISTP2=46) PARAMETER (ISNER=51,ISER=52,ISNMR=53,ISMUR=54,ISNTR=55,ISTAU2=56) PARAMETER (ISGL=29) PARAMETER (ISZ1=30,ISZ2=40,ISZ3=50,ISZ4=60,ISW1=39,ISW2=49) PARAMETER (ISHL=82,ISHH=83,ISHA=84,ISHC=86) PARAMETER (ISGRAV=91) *+CDE,SUGMG C Frozen couplings from RG equations: C GSS( 1) = g_1 GSS( 2) = g_2 GSS( 3) = g_3 C GSS( 4) = y_tau GSS( 5) = y_b GSS( 6) = y_t C GSS( 7) = M_1 GSS( 8) = M_2 GSS( 9) = M_3 C GSS(10) = A_tau GSS(11) = A_b GSS(12) = A_t C GSS(13) = M_h1^2 GSS(14) = M_h2^2 GSS(15) = M_er^2 C GSS(16) = M_el^2 GSS(17) = M_dnr^2 GSS(18) = M_upr^2 C GSS(19) = M_upl^2 GSS(20) = M_taur^2 GSS(21) = M_taul^2 C GSS(22) = M_btr^2 GSS(23) = M_tpr^2 GSS(24) = M_tpl^2 C GSS(25) = mu GSS(26) = B C Masses: C MSS( 1) = glss MSS( 2) = upl MSS( 3) = upr C MSS( 4) = dnl MSS( 5) = dnr MSS( 6) = stl C MSS( 7) = str MSS( 8) = chl MSS( 9) = chr C MSS(10) = b1 MSS(11) = b2 MSS(12) = t1 C MSS(13) = t2 MSS(14) = nuel MSS(15) = numl C MSS(16) = nutl MSS(17) = el- MSS(18) = er- C MSS(19) = mul- MSS(20) = mur- MSS(21) = tau1 C MSS(22) = tau2 MSS(23) = z1ss MSS(24) = z2ss C MSS(25) = z3ss MSS(26) = z4ss MSS(27) = w1ss C MSS(28) = w2ss MSS(29) = hl0 MSS(30) = hh0 C MSS(31) = ha0 MSS(32) = h+ C Unification: C MGUTSS = M_GUT GGUTSS = g_GUT AGUTSS = alpha_GUT COMMON /SUGMG/ MSS(32),GSS(26),MGUTSS,GGUTSS,AGUTSS REAL MSS,GSS,MGUTSS,GGUTSS,AGUTSS SAVE /SUGMG/ *+CDE,SUGXIN C XSUGIN contains the inputs to SUGRA: C XSUGIN(1) = M_0 XSUGIN(2) = M_(1/2) XSUGIN(3) = A_0 C XSUGIN(4) = tan(beta) XSUGIN(5) = sgn(mu) XSUGIN(6) = M_t C XGMIN(1) = LAM XGMIN(2) = M_MES XGMIN(3) = XN5 C XISAIN contains the MSSMi inputs in natural order. COMMON /SUGXIN/ XISAIN(24),XSUGIN(6),XGMIN(7) REAL XISAIN,XSUGIN,XGMIN SAVE /SUGXIN/ *+CDE,SUGPAS COMMON /SUGPAS/ XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW,NOGOOD, $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ REAL XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ INTEGER NOGOOD SAVE /SUGPAS/ *+CDE,SUGNU C XNUSUG contains non-universal GUT scale soft terms for SUGRA: C XNUSUG(1)=M1 XNUSUG(2)=M2 XNUSUG(3)=M3 C XNUSUG(4)=A_tau XNUSUG(5)=A_b XNUSUG(6)=A_t C XNUSUG(7)=m_Hd XNUSUG(8)=m_Hu XNUSUG(9)=m_eR XNUSUG(10)=m_eL C XNUSUG(11)=m_dR XNUSUG(12)=m_uR XNUSUG(13)=m_uL XNUSUG(14)=m_lR C XNUSUG(15)=m_lL XNUSUG(16)=m_bR XNUSUG(17)=m_tR XNUSUG(18)=m_tL C COMMON /SUGNU/ XNUSUG(18) REAL XNUSUG SAVE /SUGNU/ *+CDE,ISAPW C ISAPW1 is used to check whether ALDATA is loaded COMMON/ISAPW/ISAPW1 CHARACTER*30 ISAPW1 SAVE /ISAPW/ *================================================================= CHARACTER*80 FNAME REAL M0,MHF,A0,TANB,SGNMU,MT,AMPL,XCMGV ** REAL XLAMGM,XMESGM,XN5GM INTEGER NSTEP,IMODEL,INUSUG * INTEGER K INTEGER NOUT,IALLOW,IITEST,J CHARACTER*40 VERSN,VISAJE PARAMETER (NOUT=33) INTEGER IDOUT(NOUT) CHARACTER*30 ISAPW2 SAVE ISAPW2 C DATA IDOUT/ $IDTP,ISGL,ISUPL,ISDNL,ISSTL,ISCHL,ISBT1,ISTP1,ISUPR,ISDNR, $ISSTR,ISCHR,ISBT2,ISTP2,ISEL,ISMUL,ISTAU1,ISNEL,ISNML,ISNTL, $ISER,ISMUR,ISTAU2,ISZ1,ISZ2,ISZ3,ISZ4,ISW1,ISW2, $ISHL,ISHH,ISHA,ISHC/ DATA AMPL/2.4E18/ C ISAPW2 is used to check whether ALDATA is loaded DATA ISAPW2/'ALDATA REQUIRED BY FORTRAN G,H'/ DATA FNAME/'test_sugra.txt'/ C ----------- end CDE -------------------------------------------------- C C Initialize C IF(ISAPW1.NE.ISAPW2) THEN PRINT*, ' ERROR: BLOCK DATA ALDATA HAS NOT BEEN LOADED.' PRINT*, ' ISAJET CANNOT RUN WITHOUT IT.' PRINT*, ' PLEASE READ THE FINE MANUAL FOR ISAJET.' STOP99 ENDIF C LOUT=1 NSTEP=1000 C ** PRINT*,'ENTER output file name (in single quotes):' ** READ*,FNAME OPEN(1,FILE=FNAME,FORM='FORMATTED') ** OPEN(1,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') ** PRINT*,'ENTER 1 for SUGRA, 2 for GMSB, 3 for NU-SUGRA:' ** READ*,IMODEL IF (IMODEL.EQ.1.OR.IMODEL.EQ.3) THEN ** PRINT*,'ENTER M_0, M_(1/2), A_0, tan(beta), sgn(mu), M_t:' ** READ*,M0,MHF,A0,TANB,SGNMU,MT IF (IMODEL.EQ.3) THEN IMODEL=1 10 PRINT*,' ENTER 1,...,5 for NUSUGx keyword; 0 to continue:' PRINT*,' NUSUG1 = GUT scale gaugino masses' PRINT*,' NUSUG2 = GUT scale A terms' PRINT*,' NUSUG3 = GUT scale Higgs masses' PRINT*,' NUSUG4 = GUT scale 1st/2nd generation masses' PRINT*,' NUSUG1 = GUT scale 3rd generation masses' READ*,INUSUG IF (INUSUG.EQ.0) THEN GO TO 15 ELSE IF (INUSUG.EQ.1) THEN PRINT*,'Enter GUT scale M_1, M_2, M_3:' READ*,XNUSUG(1),XNUSUG(2),XNUSUG(3) ELSE IF (INUSUG.EQ.2) THEN PRINT*,'Enter GUT scale A_t, A_b, A_tau:' READ*,XNUSUG(6),XNUSUG(5),XNUSUG(4) ELSE IF (INUSUG.EQ.3) THEN PRINT*,'Enter GUT scale m_Hd, m_Hu:' READ*,XNUSUG(7),XNUSUG(8) ELSE IF (INUSUG.EQ.4) THEN PRINT*,'Enter GUT scale M(ul), M(dr), M(ur), M(el), M(er):' READ*,XNUSUG(13),XNUSUG(11),XNUSUG(12),XNUSUG(10),XNUSUG(9) ELSE IF (INUSUG.EQ.5) THEN PRINT*,'Enter GUT scale M(tl), M(br), M(tr), M(Ll), M(Lr):' READ*,XNUSUG(18),XNUSUG(16),XNUSUG(17),XNUSUG(15),XNUSUG(14) END IF GO TO 10 END IF ELSE IF (IMODEL.EQ.2) THEN ** PRINT*,'ENTER Lambda, M_mes, N_5, tan(beta), sgn(mu), ', ** $ 'M_t, C_gv:' ** READ*,M0,MHF,A0,TANB,SGNMU,MT,XCMGV XGMIN(7)=XCMGV AMGVSS=M0*MHF*XCMGV/SQRT(3.)/AMPL ELSE PRINT*,'Invalid model choice.' STOP99 END IF C C Solve RG equations C 15 CALL SUGRA(M0,MHF,A0,TANB,SGNMU,MT,IMODEL) C C Print results C VERSN=VISAJE() WRITE(LOUT,20) VERSN 20 FORMAT(' ',44('*')/' *',42X,'*'/ $ ' * ',A40,' *'/ $ ' *',42X,'*'/' ',44('*')/) IF (NOGOOD.EQ.1) THEN PRINT*, 'BAD POINT: TACHYONIC PARTICLES!' WRITE(LOUT,*) 'BAD POINT: TACHYONIC PARTICLES!' ELSE IF (NOGOOD.EQ.2) THEN PRINT*, 'BAD POINT: NO EW SYMMETRY BREAKING!' WRITE(LOUT,*) 'BAD POINT: NO EW SYMMETRY BREAKING!' ELSE IF (NOGOOD.EQ.3) THEN PRINT*, 'BAD POINT: M(H_P)^2<0!' WRITE(LOUT,*) 'BAD POINT: M(H_P)^2<0!' ELSE IF (NOGOOD.EQ.4) THEN PRINT*, 'BAD POINT: YUKAWA>100!' WRITE(LOUT,*) 'BAD POINT: YUKAWA>100!' ELSE IF (NOGOOD.EQ.5.AND.IMODEL.EQ.1) THEN PRINT*, 'SUGRA BAD POINT: Z1SS NOT LSP!' WRITE(LOUT,*) 'SUGRA BAD POINT: Z1SS NOT LSP!' ELSE IF (NOGOOD.EQ.7) THEN PRINT*, 'BAD POINT: XT EWSB BAD!' WRITE(LOUT,*) 'BAD POINT: XT EWSB BAD!' ELSE IF (NOGOOD.EQ.8) THEN PRINT*, 'BAD POINT: MHL^2<0!' WRITE(LOUT,*) 'BAD POINT: MHL^2<0!' END IF IF(NOGOOD.NE.0) STOP99 CALL SUGPRT(IMODEL) C C Calculate all masses and decay modes C CALL SSMSSM(XISAIN(1),XISAIN(2),XISAIN(3), $ XISAIN(4),XISAIN(5),XISAIN(6),XISAIN(7),XISAIN(8),XISAIN(9), $ XISAIN(10),XISAIN(11),XISAIN(12),XISAIN(13),XISAIN(14), $ XISAIN(15),XISAIN(16),XISAIN(17),XISAIN(18),XISAIN(19), $ XISAIN(20),XISAIN(21),XISAIN(22),XISAIN(23),XISAIN(24), $ MT,IALLOW,IMODEL) C C Test parameters C IF(IALLOW.NE.0) THEN WRITE(LOUT,2001) 2001 FORMAT(//' MSSM WARNING: Z1SS IS NOT LSP') ENDIF C CALL SSTEST(IALLOW) IITEST=IALLOW/2 IF(MOD(IITEST,2).NE.0) THEN WRITE(LOUT,2002) 2002 FORMAT(' MSSM WARNING: Z -> Z1SS Z1SS EXCEEDS BOUND') ENDIF IITEST=IITEST/2 IF(MOD(IITEST,2).NE.0) THEN WRITE(LOUT,2004) 2004 FORMAT(' MSSM WARNING: Z -> CHARGINOS ALLOWED') ENDIF IITEST=IITEST/2 IF(MOD(IITEST,2).NE.0) THEN WRITE(LOUT,2008) 2008 FORMAT(' MSSM WARNING: Z -> Z1SS Z2SS TOO BIG') ENDIF IITEST=IITEST/2 IF(MOD(IITEST,2).NE.0) THEN WRITE(LOUT,2016) 2016 FORMAT(' MSSM WARNING: Z -> SQUARKS, SLEPTONS ALLOWED') ENDIF IITEST=IITEST/2 IF(MOD(IITEST,2).NE.0) THEN WRITE(LOUT,2032) 2032 FORMAT(' MSSM WARNING: Z -> Z* HL0 EXCEEDS BOUND') ENDIF IITEST=IITEST/2 IF(MOD(IITEST,2).NE.0) THEN WRITE(LOUT,2064) 2064 FORMAT(' MSSM WARNING: Z -> HL0 HA0 ALLOWED') ENDIF C WRITE(LOUT,3600) 3600 FORMAT(//' ISASUSY decay modes:'/ $' Parent --> daughters',18X,'Width',10X,'Branching ratio'/) C Write all modes DO 200 J=1,NOUT CALL SSPRT(IDOUT(J)) 200 CONTINUE C * END ! MYSUGRUN SUBROUTINE SSPRT(ID) C----------------------------------------------------------------------- C C Print decay modes for ID. Note these need not be contiguous, C so the loop is over all modes in /SSMODE/. C C----------------------------------------------------------------------- *+SELF,IF=IMPNONE IMPLICIT NONE *+SELF *+CDE,SSLUN COMMON/SSLUN/LOUT INTEGER LOUT SAVE /SSLUN/ *+CDE,SSMODE C MXSS = maximum number of modes C NSSMOD = number of modes C ISSMOD = initial particle C JSSMOD = final particles C GSSMOD = width C BSSMOD = branching ratio INTEGER MXSS PARAMETER (MXSS=1000) COMMON/SSMODE/NSSMOD,ISSMOD(MXSS),JSSMOD(5,MXSS),GSSMOD(MXSS) $,BSSMOD(MXSS) INTEGER NSSMOD,ISSMOD,JSSMOD REAL GSSMOD,BSSMOD SAVE /SSMODE/ *====================================================== C INTEGER ID,I,K,NOUT CHARACTER*5 SSID,LBLIN,LBLOUT(3) C NOUT=0 DO 100 I=1,NSSMOD IF(ISSMOD(I).NE.ID) GO TO 100 NOUT=NOUT+1 LBLIN=SSID(ISSMOD(I)) DO 110 K=1,3 110 LBLOUT(K)=SSID(JSSMOD(K,I)) WRITE(LOUT,1000) LBLIN,(LBLOUT(K),K=1,3),GSSMOD(I),BSSMOD(I) 1000 FORMAT(1X,A5,' --> ',3(A5,2X),2E15.5) 100 CONTINUE C IF(NOUT.GT.0) WRITE(LOUT,*) ' ' C RETURN END SUBROUTINE SUGPRT(IMODEL) C-------------------------------------------------------------------- C C Print SUGRA parameters and results C IMPLICIT NONE *+CDE,SSLUN COMMON/SSLUN/LOUT INTEGER LOUT SAVE /SSLUN/ *+CDE,SUGXIN C XSUGIN contains the inputs to SUGRA: C XSUGIN(1) = M_0 XSUGIN(2) = M_(1/2) XSUGIN(3) = A_0 C XSUGIN(4) = tan(beta) XSUGIN(5) = sgn(mu) XSUGIN(6) = M_t C XGMIN(1) = LAM XGMIN(2) = M_MES XGMIN(3) = XN5 C XISAIN contains the MSSMi inputs in natural order. COMMON /SUGXIN/ XISAIN(24),XSUGIN(6),XGMIN(7) REAL XISAIN,XSUGIN,XGMIN SAVE /SUGXIN/ *+CDE,SUGMG C Frozen couplings from RG equations: C GSS( 1) = g_1 GSS( 2) = g_2 GSS( 3) = g_3 C GSS( 4) = y_tau GSS( 5) = y_b GSS( 6) = y_t C GSS( 7) = M_1 GSS( 8) = M_2 GSS( 9) = M_3 C GSS(10) = A_tau GSS(11) = A_b GSS(12) = A_t C GSS(13) = M_h1^2 GSS(14) = M_h2^2 GSS(15) = M_er^2 C GSS(16) = M_el^2 GSS(17) = M_dnr^2 GSS(18) = M_upr^2 C GSS(19) = M_upl^2 GSS(20) = M_taur^2 GSS(21) = M_taul^2 C GSS(22) = M_btr^2 GSS(23) = M_tpr^2 GSS(24) = M_tpl^2 C GSS(25) = mu GSS(26) = B C Masses: C MSS( 1) = glss MSS( 2) = upl MSS( 3) = upr C MSS( 4) = dnl MSS( 5) = dnr MSS( 6) = stl C MSS( 7) = str MSS( 8) = chl MSS( 9) = chr C MSS(10) = b1 MSS(11) = b2 MSS(12) = t1 C MSS(13) = t2 MSS(14) = nuel MSS(15) = numl C MSS(16) = nutl MSS(17) = el- MSS(18) = er- C MSS(19) = mul- MSS(20) = mur- MSS(21) = tau1 C MSS(22) = tau2 MSS(23) = z1ss MSS(24) = z2ss C MSS(25) = z3ss MSS(26) = z4ss MSS(27) = w1ss C MSS(28) = w2ss MSS(29) = hl0 MSS(30) = hh0 C MSS(31) = ha0 MSS(32) = h+ C Unification: C MGUTSS = M_GUT GGUTSS = g_GUT AGUTSS = alpha_GUT COMMON /SUGMG/ MSS(32),GSS(26),MGUTSS,GGUTSS,AGUTSS REAL MSS,GSS,MGUTSS,GGUTSS,AGUTSS SAVE /SUGMG/ *+CDE,SUGPAS COMMON /SUGPAS/ XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW,NOGOOD, $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ REAL XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ INTEGER NOGOOD SAVE /SUGPAS/ *+CDE,SSPAR C SUSY parameters C AMGLSS = gluino mass C AMULSS = up-left squark mass C AMELSS = left-selectron mass C AMERSS = right-slepton mass C AMNiSS = sneutrino mass for generation i C TWOM1 = Higgsino mass = - mu C RV2V1 = ratio v2/v1 of vev's C AMTLSS,AMTRSS = left,right stop masses C AMT1SS,AMT2SS = light,heavy stop masses C AMBLSS,AMBRSS = left,right sbottom masses C AMB1SS,AMB2SS = light,heavy sbottom masses C AMLLSS,AMLRSS = left,right stau masses C AML1SS,AML2SS = light,heavy stau masses C AMZiSS = signed mass of Zi C ZMIXSS = Zi mixing matrix C AMWiSS = signed Wi mass C GAMMAL,GAMMAR = Wi left, right mixing angles C AMHL,AMHH,AMHA = neutral Higgs h0, H0, A0 masses C AMHC = charged Higgs H+ mass C ALFAH = Higgs mixing angle C AAT = stop trilinear term C THETAT = stop mixing angle C AAB = sbottom trilinear term C THETAB = sbottom mixing angle C AAL = stau trilinear term C THETAL = stau mixing angle C AMGVSS = gravitino mass COMMON/SSPAR/AMGLSS,AMULSS,AMURSS,AMDLSS,AMDRSS,AMSLSS $,AMSRSS,AMCLSS,AMCRSS,AMBLSS,AMBRSS,AMB1SS,AMB2SS $,AMTLSS,AMTRSS,AMT1SS,AMT2SS,AMELSS,AMERSS,AMMLSS,AMMRSS $,AMLLSS,AMLRSS,AML1SS,AML2SS,AMN1SS,AMN2SS,AMN3SS $,TWOM1,RV2V1,AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS,ZMIXSS(4,4) $,AMW1SS,AMW2SS $,GAMMAL,GAMMAR,AMHL,AMHH,AMHA,AMHC,ALFAH,AAT,THETAT $,AAB,THETAB,AAL,THETAL,AMGVSS REAL AMGLSS,AMULSS,AMURSS,AMDLSS,AMDRSS,AMSLSS $,AMSRSS,AMCLSS,AMCRSS,AMBLSS,AMBRSS,AMB1SS,AMB2SS $,AMTLSS,AMTRSS,AMT1SS,AMT2SS,AMELSS,AMERSS,AMMLSS,AMMRSS $,AMLLSS,AMLRSS,AML1SS,AML2SS,AMN1SS,AMN2SS,AMN3SS $,TWOM1,RV2V1,AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS,ZMIXSS $,AMW1SS,AMW2SS $,GAMMAL,GAMMAR,AMHL,AMHH,AMHA,AMHC,ALFAH,AAT,THETAT $,AAB,THETAB,AAL,THETAL,AMGVSS REAL AMZISS(4) EQUIVALENCE (AMZISS(1),AMZ1SS) SAVE /SSPAR/ *+CDE,SUGNU C XNUSUG contains non-universal GUT scale soft terms for SUGRA: C XNUSUG(1)=M1 XNUSUG(2)=M2 XNUSUG(3)=M3 C XNUSUG(4)=A_tau XNUSUG(5)=A_b XNUSUG(6)=A_t C XNUSUG(7)=m_Hd XNUSUG(8)=m_Hu XNUSUG(9)=m_eR XNUSUG(10)=m_eL C XNUSUG(11)=m_dR XNUSUG(12)=m_uR XNUSUG(13)=m_uL XNUSUG(14)=m_lR C XNUSUG(15)=m_lL XNUSUG(16)=m_bR XNUSUG(17)=m_tR XNUSUG(18)=m_tL C COMMON /SUGNU/ XNUSUG(18) REAL XNUSUG SAVE /SUGNU/ *============================================================== REAL PI,GPX,SIN2W,ALEMI,AS INTEGER IMODEL,J,K C C Entry C PI=4.*ATAN(1.) GPX=SQRT(.6)*GSS(1) SIN2W=GPX**2/(GSS(2)**2+GPX**2) ALEMI=4*PI/GSS(2)**2/SIN2W AS=GSS(3)**2/4./PI C C Print inputs and couplings C IF (IMODEL.EQ.1) THEN WRITE(LOUT,1000) XSUGIN 1000 FORMAT(//' ISASUGRA input:'/ $ ' M_0, M_(1/2), A_0, tan(beta), sgn(mu), M_t =' $ /4F10.3,2X,F6.1,F10.3) WRITE(LOUT,1001) MGUTSS,GGUTSS,AGUTSS 1001 FORMAT(/' ISASUGRA unification:'/' M_GUT =',E10.3, $ ' g_GUT =',F5.3,3X,' alpha_GUT =',F5.3) ELSE IF (IMODEL.EQ.2) THEN WRITE(LOUT,1002) XGMIN 1002 FORMAT(//' GMSB model input:'/ $ ' Lambda, M_mes, N_5, tan(beta), sgn(mu), M_t, C_grav=' $ /2E10.3,2F10.3,2X,F6.1,F10.3,1X,E10.3) WRITE(LOUT,1003) AMGVSS 1003 FORMAT(//' M(gravitino)=',E10.3) END IF C WRITE(LOUT,1004) ALEMI,SIN2W,AS 1004 FORMAT(' 1/alpha_em =',F8.2,2X, $' sin**2(thetaw) =',F6.4,2X,' alpha_s =',F5.3) WRITE(LOUT,1005) GSS(7),GSS(8),GSS(9) 1005 FORMAT(' M_1 =',F8.2,2X, $' M_2 =',F8.2,' M_3 =',F8.2) WRITE(LOUT,1006) MU,B,HIGFRZ 1006 FORMAT(' mu(Q) =',F8.2,2X, $' B(Q) =',F8.2,' Q =',F8.2) WRITE(LOUT,1007) GSS(13),GSS(14) 1007 FORMAT(' M_H1^2 =',E10.3,' M_H2^2 =',E10.3) C C Write out non-universal GUT scale parameters C IF (XNUSUG(1).LT.1.E19.OR.XNUSUG(2).LT.1.E19.OR.XNUSUG(3) $.LT.1.E19) THEN WRITE(LOUT,1010) XNUSUG(1),XNUSUG(2),XNUSUG(3) 1010 FORMAT(/' M_1(GUT)= ',F8.2,' M_2(GUT)= ',F8.2,' M_3(GUT)= ', $ F8.2) END IF IF (XNUSUG(4).LT.1.E19.OR.XNUSUG(5).LT.1.E19.OR.XNUSUG(6) $.LT.1.E19) THEN WRITE(LOUT,1011) XNUSUG(4),XNUSUG(5),XNUSUG(6) 1011 FORMAT(/' A_tau(GUT)= ',F8.2,' A_b(GUT)= ',F8.2,' A_t(GUT)= ', $ F8.2) END IF IF (XNUSUG(7).LT.1.E19.OR.XNUSUG(8).LT.1.E19) THEN WRITE(LOUT,1012) XNUSUG(7),XNUSUG(8) 1012 FORMAT(/' m_Hd(GUT)= ',F8.2,' m_Hu(GUT)= ',F8.2) END IF IF (XNUSUG(9).LT.1.E19.OR.XNUSUG(10).LT.1.E19) THEN WRITE(LOUT,1013) XNUSUG(9),XNUSUG(10) 1013 FORMAT(/' m_eR(GUT)= ',F8.2,' m_eL(GUT)= ',F8.2) END IF IF (XNUSUG(11).LT.1.E19.OR.XNUSUG(12).LT.1.E19.OR.XNUSUG(13) $.LT.1.E19) THEN WRITE(LOUT,1014) XNUSUG(11),XNUSUG(12),XNUSUG(13) 1014 FORMAT(' m_dR(GUT)= ',F8.2,' m_uR(GUT)= ',F8.2,' m_uL(GUT)=', $ F8.2) END IF IF (XNUSUG(14).LT.1.E19.OR.XNUSUG(15).LT.1.E19) THEN WRITE(LOUT,1015) XNUSUG(14),XNUSUG(15) 1015 FORMAT(/' m_tauR(GUT)= ',F8.2,' m_tauL(GUT)= ',F8.2) END IF IF (XNUSUG(16).LT.1.E19.OR.XNUSUG(17).LT.1.E19.OR.XNUSUG(18) $.LT.1.E19) THEN WRITE(LOUT,1016) XNUSUG(16),XNUSUG(17),XNUSUG(18) 1016 FORMAT(' m_bR(GUT)= ',F8.2,' m_tR(GUT)= ',F8.2,' m_tL(GUT)=', $ F8.2) END IF C C Print mass spectrum from ISASUGRA C WRITE(LOUT,2000) MSS(1),MSS(2),MSS(3),MSS(4),MSS(5),MSS(10), $MSS(11),MSS(12),MSS(13),MSS(14),MSS(17),MSS(18),MSS(16), $MSS(21),MSS(22),MSS(23),MSS(24),MSS(25),MSS(26),MSS(27), $MSS(28),MSS(29),MSS(30),MSS(31),MSS(32) 2000 FORMAT(/' ISAJET masses (with signs):'/ $' M(GL) =',F9.2/ $' M(UL) =',F9.2,' M(UR) =',F9.2,' M(DL) =',F9.2, $' M(DR) =',F9.2/ $' M(B1) =',F9.2,' M(B2) =',F9.2,' M(T1) =',F9.2, $' M(T2) =',F9.2/ $' M(SN) =',F9.2,' M(EL) =',F9.2,' M(ER) =',F9.2/ $' M(NTAU)=',F9.2,' M(TAU1)=',F9.2,' M(TAU2)=',F9.2/ $' M(Z1) =',F9.2,' M(Z2) =',F9.2,' M(Z3) =',F9.2, $' M(Z4) =',F9.2/ $' M(W1) =',F9.2,' M(W2) =',F9.2/ $' M(HL) =',F9.2,' M(HH) =',F9.2,' M(HA) =',F9.2, $' M(H+) =',F9.2) WRITE(LOUT,2001) THETAT,THETAB,THETAL,ALFAH 2001 FORMAT(/,' theta_t=',F9.4,' theta_b=',F9.4, $' theta_l=',F9.4,' alpha_h=',F9.4) C C Write out chargino /neutralino masses/eigenvectors C WRITE(LOUT,3100) AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS 3100 FORMAT(/' NEUTRALINO MASSES (SIGNED) =',4F10.3) DO 100 J=1,4 WRITE(LOUT,3200) J,(ZMIXSS(K,J),K=1,4) 3200 FORMAT(' EIGENVECTOR ',I1,' =',4F10.5) 100 CONTINUE WRITE(LOUT,3300) AMW1SS,AMW2SS 3300 FORMAT(/' CHARGINO MASSES (SIGNED) =',2F10.3) WRITE(LOUT,3400) GAMMAL,GAMMAR 3400 FORMAT(' GAMMAL, GAMMAR =',2F10.5/) C C Print ISAJET MSSMi equivalent input C WRITE(LOUT,3000) 3000 FORMAT(/' ISAJET equivalent input:') WRITE(LOUT,3001) MSS(1),MU,MSS(31),XSUGIN(4) 3001 FORMAT(' MSSMA: ',4F8.2) WRITE(LOUT,3002) SQRT(GSS(19)),SQRT(GSS(17)),SQRT(GSS(18)), $SQRT(GSS(16)),SQRT(GSS(15)) 3002 FORMAT(' MSSMB: ',5F8.2) WRITE(LOUT,3003) SQRT(GSS(24)),SQRT(GSS(22)),SQRT(GSS(23)), $SQRT(GSS(21)),SQRT(GSS(20)),GSS(12),GSS(11),GSS(10) 3003 FORMAT(' MSSMC: ',8F8.2) RETURN END CHARACTER*5 FUNCTION SSID(ID) C----------------------------------------------------------------------- C C Return character name for ID, assuming the default IDENT codes C are used in /SSTYPE/. C C----------------------------------------------------------------------- IMPLICIT NONE *+CDE,SSLUN COMMON/SSLUN/LOUT INTEGER LOUT SAVE /SSLUN/ *===================================================================== CHARACTER*5 LABEL(-100:100) SAVE LABEL INTEGER ID,J C DATA LABEL(0)/' '/ C DATA (LABEL(J),J=1,10) $/'UP ','DN ','ST ','CH ','BT ','TP ' $,'ERROR','ERROR','GL ','GM '/ DATA (LABEL(J),J=-1,-10,-1) $/'UB ','DB ','SB ','CB ','BB ','TB ' $,'ERROR','ERROR','ERROR','ERROR'/ C DATA (LABEL(J),J=11,20) $/'NUE ','E- ','NUM ','MU- ','NUT ','TAU- ' $,'ERROR','ERROR','ERROR','ERROR'/ DATA (LABEL(J),J=-11,-20,-1) $/'ANUE ','E+ ','ANUM ','MU+ ','ANUT ','TAU+ ' $,'ERROR','ERROR','ERROR','ERROR'/ C DATA (LABEL(J),J=21,30) $/'UPL ','DNL ','STL ','CHL ','BT1 ','TP1 ' $,'ERROR','ERROR','GLSS ','Z1SS '/ DATA (LABEL(J),J=-21,-30,-1) $/'UBL ','DBL ','SBL ','CBL ','BB1 ','TB1 ' $,'ERROR','ERROR','ERROR','ERROR'/ C DATA (LABEL(J),J=31,40) $/'NUEL ','EL- ','NUML ','MUL- ','NUTL ','TAU1-' $,'ERROR','ERROR','W1SS+','Z2SS '/ DATA (LABEL(J),J=-31,-40,-1) $/'ANUEL','EL+ ','ANUML','MUL+ ','ANUTL','TAU1+' $,'ERROR','ERROR','W1SS-','ERROR'/ C DATA (LABEL(J),J=41,50) $/'UPR ','DNR ','STR ','CHR ','BT2 ','TP2 ' $,'ERROR','ERROR','W2SS+','Z3SS '/ DATA (LABEL(J),J=-41,-50,-1) $/'UBR ','DBR ','SBR ','CBR ','BB2 ','TB2 ' $,'ERROR','ERROR','W2SS-','ERROR'/ C DATA (LABEL(J),J=51,60) $/'NUER ','ER- ','NUMR ','MUR- ','NUTR ','TAU2-' $,'ERROR','ERROR','ERROR','Z4SS '/ DATA (LABEL(J),J=-51,-60,-1) $/'ANUEL','ER+ ','ANUMR','MUR+ ','ANUTR','TAU2+' $,'ERROR','ERROR','ERROR','ERROR'/ C DATA (LABEL(J),J=82,86) $/'HL0 ','HH0 ','HA0 ','ERROR','H+ '/ DATA LABEL(-86)/'H- '/ C DATA LABEL(80)/'W+ '/,LABEL(-80)/'W- '/,LABEL(90)/'Z0 '/ DATA LABEL(91)/'GVSS '/ C IF(IABS(ID).GT.100) THEN WRITE(LOUT,*) 'SSID: ID = ',ID STOP99 ENDIF SSID=LABEL(ID) RETURN END *CMZ : 05/11/99 22.45.26 by A.Rozanov *-- Author : A.Rozanov 05/05/99 SUBROUTINE FSUGRUN(AMT0,IERR,AMH) * * *----------------------------------------------------------------------* * * * Name : FSUGRUN * * (module) * * * * Description : * * [description] * * * * Arguments : * * [name] ([in | out | in/out]) [description] * * * * Banks/Tables: * * [name] ([filled | used | modified]) * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/05/99 * * * * * * Last modifications : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * C C Main program to calculate MSSM input parameters for ISAJET C from renormalization group equations and supergravity. C All external names are of the form SUxxxx. C Must link with block data ALDATA. C IMPLICIT NONE *+CDE,SSLUN COMMON/SSLUN/LOUT INTEGER LOUT SAVE /SSLUN/ *+CDE,SSPAR C SUSY parameters C AMGLSS = gluino mass C AMULSS = up-left squark mass C AMELSS = left-selectron mass C AMERSS = right-slepton mass C AMNiSS = sneutrino mass for generation i C TWOM1 = Higgsino mass = - mu C RV2V1 = ratio v2/v1 of vev's C AMTLSS,AMTRSS = left,right stop masses C AMT1SS,AMT2SS = light,heavy stop masses C AMBLSS,AMBRSS = left,right sbottom masses C AMB1SS,AMB2SS = light,heavy sbottom masses C AMLLSS,AMLRSS = left,right stau masses C AML1SS,AML2SS = light,heavy stau masses C AMZiSS = signed mass of Zi C ZMIXSS = Zi mixing matrix C AMWiSS = signed Wi mass C GAMMAL,GAMMAR = Wi left, right mixing angles C AMHL,AMHH,AMHA = neutral Higgs h0, H0, A0 masses C AMHC = charged Higgs H+ mass C ALFAH = Higgs mixing angle C AAT = stop trilinear term C THETAT = stop mixing angle C AAB = sbottom trilinear term C THETAB = sbottom mixing angle C AAL = stau trilinear term C THETAL = stau mixing angle C AMGVSS = gravitino mass COMMON/SSPAR/AMGLSS,AMULSS,AMURSS,AMDLSS,AMDRSS,AMSLSS $,AMSRSS,AMCLSS,AMCRSS,AMBLSS,AMBRSS,AMB1SS,AMB2SS $,AMTLSS,AMTRSS,AMT1SS,AMT2SS,AMELSS,AMERSS,AMMLSS,AMMRSS $,AMLLSS,AMLRSS,AML1SS,AML2SS,AMN1SS,AMN2SS,AMN3SS $,TWOM1,RV2V1,AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS,ZMIXSS(4,4) $,AMW1SS,AMW2SS $,GAMMAL,GAMMAR,AMHL,AMHH,AMHA,AMHC,ALFAH,AAT,THETAT $,AAB,THETAB,AAL,THETAL,AMGVSS REAL AMGLSS,AMULSS,AMURSS,AMDLSS,AMDRSS,AMSLSS $,AMSRSS,AMCLSS,AMCRSS,AMBLSS,AMBRSS,AMB1SS,AMB2SS $,AMTLSS,AMTRSS,AMT1SS,AMT2SS,AMELSS,AMERSS,AMMLSS,AMMRSS $,AMLLSS,AMLRSS,AML1SS,AML2SS,AMN1SS,AMN2SS,AMN3SS $,TWOM1,RV2V1,AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS,ZMIXSS $,AMW1SS,AMW2SS $,GAMMAL,GAMMAR,AMHL,AMHH,AMHA,AMHC,ALFAH,AAT,THETAT $,AAB,THETAB,AAL,THETAL,AMGVSS REAL AMZISS(4) EQUIVALENCE (AMZISS(1),AMZ1SS) SAVE /SSPAR/ *+CDE,SSTYPE C SM ident code definitions. These are standard ISAJET but C can be changed. INTEGER IDUP,IDDN,IDST,IDCH,IDBT,IDTP INTEGER IDNE,IDE,IDNM,IDMU,IDNT,IDTAU INTEGER IDGL,IDGM,IDW,IDZ PARAMETER (IDUP=1,IDDN=2,IDST=3,IDCH=4,IDBT=5,IDTP=6) PARAMETER (IDNE=11,IDE=12,IDNM=13,IDMU=14,IDNT=15,IDTAU=16) PARAMETER (IDGL=9,IDGM=10,IDW=80,IDZ=90) C SUSY ident code definitions. They are chosen to be similar C to those in versions < 6.50 but may be changed. INTEGER ISUPL,ISDNL,ISSTL,ISCHL,ISBT1,ISTP1 INTEGER ISNEL,ISEL,ISNML,ISMUL,ISNTL,ISTAU1 INTEGER ISUPR,ISDNR,ISSTR,ISCHR,ISBT2,ISTP2 INTEGER ISNER,ISER,ISNMR,ISMUR,ISNTR,ISTAU2 INTEGER ISZ1,ISZ2,ISZ3,ISZ4,ISW1,ISW2,ISGL INTEGER ISHL,ISHH,ISHA,ISHC INTEGER ISGRAV PARAMETER (ISUPL=21,ISDNL=22,ISSTL=23,ISCHL=24,ISBT1=25,ISTP1=26) PARAMETER (ISNEL=31,ISEL=32,ISNML=33,ISMUL=34,ISNTL=35,ISTAU1=36) PARAMETER (ISUPR=41,ISDNR=42,ISSTR=43,ISCHR=44,ISBT2=45,ISTP2=46) PARAMETER (ISNER=51,ISER=52,ISNMR=53,ISMUR=54,ISNTR=55,ISTAU2=56) PARAMETER (ISGL=29) PARAMETER (ISZ1=30,ISZ2=40,ISZ3=50,ISZ4=60,ISW1=39,ISW2=49) PARAMETER (ISHL=82,ISHH=83,ISHA=84,ISHC=86) PARAMETER (ISGRAV=91) *+CDE,SUGMG C Frozen couplings from RG equations: C GSS( 1) = g_1 GSS( 2) = g_2 GSS( 3) = g_3 C GSS( 4) = y_tau GSS( 5) = y_b GSS( 6) = y_t C GSS( 7) = M_1 GSS( 8) = M_2 GSS( 9) = M_3 C GSS(10) = A_tau GSS(11) = A_b GSS(12) = A_t C GSS(13) = M_h1^2 GSS(14) = M_h2^2 GSS(15) = M_er^2 C GSS(16) = M_el^2 GSS(17) = M_dnr^2 GSS(18) = M_upr^2 C GSS(19) = M_upl^2 GSS(20) = M_taur^2 GSS(21) = M_taul^2 C GSS(22) = M_btr^2 GSS(23) = M_tpr^2 GSS(24) = M_tpl^2 C GSS(25) = mu GSS(26) = B C Masses: C MSS( 1) = glss MSS( 2) = upl MSS( 3) = upr C MSS( 4) = dnl MSS( 5) = dnr MSS( 6) = stl C MSS( 7) = str MSS( 8) = chl MSS( 9) = chr C MSS(10) = b1 MSS(11) = b2 MSS(12) = t1 C MSS(13) = t2 MSS(14) = nuel MSS(15) = numl C MSS(16) = nutl MSS(17) = el- MSS(18) = er- C MSS(19) = mul- MSS(20) = mur- MSS(21) = tau1 C MSS(22) = tau2 MSS(23) = z1ss MSS(24) = z2ss C MSS(25) = z3ss MSS(26) = z4ss MSS(27) = w1ss C MSS(28) = w2ss MSS(29) = hl0 MSS(30) = hh0 C MSS(31) = ha0 MSS(32) = h+ C Unification: C MGUTSS = M_GUT GGUTSS = g_GUT AGUTSS = alpha_GUT COMMON /SUGMG/ MSS(32),GSS(26),MGUTSS,GGUTSS,AGUTSS REAL MSS,GSS,MGUTSS,GGUTSS,AGUTSS SAVE /SUGMG/ *+CDE,SUGXIN C XSUGIN contains the inputs to SUGRA: C XSUGIN(1) = M_0 XSUGIN(2) = M_(1/2) XSUGIN(3) = A_0 C XSUGIN(4) = tan(beta) XSUGIN(5) = sgn(mu) XSUGIN(6) = M_t C XGMIN(1) = LAM XGMIN(2) = M_MES XGMIN(3) = XN5 C XISAIN contains the MSSMi inputs in natural order. COMMON /SUGXIN/ XISAIN(24),XSUGIN(6),XGMIN(7) REAL XISAIN,XSUGIN,XGMIN SAVE /SUGXIN/ *+CDE,SUGPAS COMMON /SUGPAS/ XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW,NOGOOD, $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ REAL XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ INTEGER NOGOOD SAVE /SUGPAS/ *+CDE,SUGNU C XNUSUG contains non-universal GUT scale soft terms for SUGRA: C XNUSUG(1)=M1 XNUSUG(2)=M2 XNUSUG(3)=M3 C XNUSUG(4)=A_tau XNUSUG(5)=A_b XNUSUG(6)=A_t C XNUSUG(7)=m_Hd XNUSUG(8)=m_Hu XNUSUG(9)=m_eR XNUSUG(10)=m_eL C XNUSUG(11)=m_dR XNUSUG(12)=m_uR XNUSUG(13)=m_uL XNUSUG(14)=m_lR C XNUSUG(15)=m_lL XNUSUG(16)=m_bR XNUSUG(17)=m_tR XNUSUG(18)=m_tL C COMMON /SUGNU/ XNUSUG(18) REAL XNUSUG SAVE /SUGNU/ *+CDE,ISAPW C ISAPW1 is used to check whether ALDATA is loaded COMMON/ISAPW/ISAPW1 CHARACTER*30 ISAPW1 SAVE /ISAPW/ *================================================================= DOUBLE PRECISION SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU 3 ,AMCHARGINO INTEGER IMST1,IMST2 *KEEP,susy. COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA,DMST1,DMST2,IMST1,IMST2, 2 SUSY_M0,SUSY_MHF,SUSY_A0,SUSY_SGNMU, 3 AMCHARGINO *KEND. *-------------------------------------------------------------------- CHARACTER*80 FNAME REAL M0,MHF,A0,TANB,SGNMU,MT,AMPL,XCMGV REAL AMH,AMT0,SBETA ** REAL XLAMGM,XMESGM,XN5GM INTEGER NSTEP,IMODEL,INUSUG * INTEGER K INTEGER IERR INTEGER NOUT,IALLOW,IITEST/0/,J/0/ CHARACTER*40 VERSN,VISAJE PARAMETER (NOUT=33) INTEGER IDOUT(NOUT) CHARACTER*30 ISAPW2 SAVE ISAPW2 C DATA IDOUT/ $IDTP,ISGL,ISUPL,ISDNL,ISSTL,ISCHL,ISBT1,ISTP1,ISUPR,ISDNR, $ISSTR,ISCHR,ISBT2,ISTP2,ISEL,ISMUL,ISTAU1,ISNEL,ISNML,ISNTL, $ISER,ISMUR,ISTAU2,ISZ1,ISZ2,ISZ3,ISZ4,ISW1,ISW2, $ISHL,ISHH,ISHA,ISHC/ DATA AMPL/2.4E18/ C ISAPW2 is used to check whether ALDATA is loaded DATA ISAPW2/'ALDATA REQUIRED BY FORTRAN G,H'/ DATA FNAME/'test_sugra.txt'/ C ----------- end CDE -------------------------------------------------- C C Initialize C ** IF(ISAPW1.NE.ISAPW2) THEN ** PRINT*, ' ERROR: BLOCK DATA ALDATA HAS NOT BEEN LOADED.' ** PRINT*, ' ISAJET CANNOT RUN WITHOUT IT.' ** PRINT*, ' PLEASE READ THE FINE MANUAL FOR ISAJET.' ** STOP99 ** ENDIF C IMODEL=1 if(SUSYFL.EQ.1.D0)IMODEL=1 SBETA=BETA TANB=TAN(SBETA) M0=SUSY_M0 MHF=SUSY_MHF A0=SUSY_A0 SGNMU=SUSY_SGNMU MT=AMT0 LOUT=1 NSTEP=1000 C ** PRINT*,'ENTER output file name (in single quotes):' ** READ*,FNAME ** OPEN(1,FILE=FNAME,FORM='FORMATTED') ** OPEN(1,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') ** PRINT*,'ENTER 1 for SUGRA, 2 for GMSB, 3 for NU-SUGRA:' ** READ*,IMODEL IF (IMODEL.EQ.1.OR.IMODEL.EQ.3) THEN ** PRINT*,'ENTER M_0, M_(1/2), A_0, tan(beta), sgn(mu), M_t:' ** READ*,M0,MHF,A0,TANB,SGNMU,MT IF (IMODEL.EQ.3) THEN IMODEL=1 10 PRINT*,' ENTER 1,...,5 for NUSUGx keyword; 0 to continue:' PRINT*,' NUSUG1 = GUT scale gaugino masses' PRINT*,' NUSUG2 = GUT scale A terms' PRINT*,' NUSUG3 = GUT scale Higgs masses' PRINT*,' NUSUG4 = GUT scale 1st/2nd generation masses' PRINT*,' NUSUG1 = GUT scale 3rd generation masses' READ*,INUSUG IF (INUSUG.EQ.0) THEN GO TO 15 ELSE IF (INUSUG.EQ.1) THEN PRINT*,'Enter GUT scale M_1, M_2, M_3:' READ*,XNUSUG(1),XNUSUG(2),XNUSUG(3) ELSE IF (INUSUG.EQ.2) THEN PRINT*,'Enter GUT scale A_t, A_b, A_tau:' READ*,XNUSUG(6),XNUSUG(5),XNUSUG(4) ELSE IF (INUSUG.EQ.3) THEN PRINT*,'Enter GUT scale m_Hd, m_Hu:' READ*,XNUSUG(7),XNUSUG(8) ELSE IF (INUSUG.EQ.4) THEN PRINT*,'Enter GUT scale M(ul), M(dr), M(ur), M(el), M(er):' READ*,XNUSUG(13),XNUSUG(11),XNUSUG(12),XNUSUG(10),XNUSUG(9) ELSE IF (INUSUG.EQ.5) THEN PRINT*,'Enter GUT scale M(tl), M(br), M(tr), M(Ll), M(Lr):' READ*,XNUSUG(18),XNUSUG(16),XNUSUG(17),XNUSUG(15),XNUSUG(14) END IF GO TO 10 END IF ELSE IF (IMODEL.EQ.2) THEN ** PRINT*,'ENTER Lambda, M_mes, N_5, tan(beta), sgn(mu), ', ** $ 'M_t, C_gv:' ** READ*,M0,MHF,A0,TANB,SGNMU,MT,XCMGV XGMIN(7)=XCMGV AMGVSS=M0*MHF*XCMGV/SQRT(3.)/AMPL ELSE PRINT*,'Invalid model choice.' STOP99 END IF C C Solve RG equations C 15 CALL SUGRA(M0,MHF,A0,TANB,SGNMU,MT,IMODEL) C C Print results C VERSN=VISAJE() ** WRITE(LOUT,20) VERSN **20 FORMAT(' ',44('*')/' *',42X,'*'/ ** $ ' * ',A40,' *'/ ** $ ' *',42X,'*'/' ',44('*')/) ** IF (NOGOOD.EQ.1) THEN ** PRINT*, 'BAD POINT: TACHYONIC PARTICLES!' ** WRITE(LOUT,*) 'BAD POINT: TACHYONIC PARTICLES!' ** ELSE IF (NOGOOD.EQ.2) THEN ** PRINT*, 'BAD POINT: NO EW SYMMETRY BREAKING!' ** WRITE(LOUT,*) 'BAD POINT: NO EW SYMMETRY BREAKING!' ** ELSE IF (NOGOOD.EQ.3) THEN ** PRINT*, 'BAD POINT: M(H_P)^2<0!' ** WRITE(LOUT,*) 'BAD POINT: M(H_P)^2<0!' ** ELSE IF (NOGOOD.EQ.4) THEN ** PRINT*, 'BAD POINT: YUKAWA>100!' ** WRITE(LOUT,*) 'BAD POINT: YUKAWA>100!' ** ELSE IF (NOGOOD.EQ.5.AND.IMODEL.EQ.1) THEN ** PRINT*, 'SUGRA BAD POINT: Z1SS NOT LSP!' ** WRITE(LOUT,*) 'SUGRA BAD POINT: Z1SS NOT LSP!' ** ELSE IF (NOGOOD.EQ.7) THEN ** PRINT*, 'BAD POINT: XT EWSB BAD!' ** WRITE(LOUT,*) 'BAD POINT: XT EWSB BAD!' ** ELSE IF (NOGOOD.EQ.8) THEN ** PRINT*, 'BAD POINT: MHL^2<0!' ** WRITE(LOUT,*) 'BAD POINT: MHL^2<0!' ** END IF ** IF(NOGOOD.NE.0) STOP99 ierr=0 IF(NOGOOD.NE.0) ierr=NOGOOD ** CALL SUGPRT(IMODEL) C C Calculate all masses and decay modes C CALL SSMSSM(XISAIN(1),XISAIN(2),XISAIN(3), $ XISAIN(4),XISAIN(5),XISAIN(6),XISAIN(7),XISAIN(8),XISAIN(9), $ XISAIN(10),XISAIN(11),XISAIN(12),XISAIN(13),XISAIN(14), $ XISAIN(15),XISAIN(16),XISAIN(17),XISAIN(18),XISAIN(19), $ XISAIN(20),XISAIN(21),XISAIN(22),XISAIN(23),XISAIN(24), $ MT,IALLOW,IMODEL) AMH=AMHL AMHIGGS=AMHH ! mass of big H AMSB = AMB1SS ! MIV define sb1(ISAJET)==sbL(LEPTOP) AMST1 = AMT2SS ! MIV used opposite numbering to ISAJET AMST2 = AMT1SS DMST1 = 0. DMST2 = 0. AMSQ = AMULSS AMGLUINO=AMGLSS IMST1=0 ! take mst1 from AMST1, not from relations IMST2=0 ! take mst2 from AMST2, not from relations C C Test parameters C ** IF(IALLOW.NE.0) THEN ** WRITE(LOUT,2001) **2001 FORMAT(//' MSSM WARNING: Z1SS IS NOT LSP') ** ENDIF C ** CALL SSTEST(IALLOW) ** IITEST=IALLOW/2 ** IF(MOD(IITEST,2).NE.0) THEN ** WRITE(LOUT,2002) **2002 FORMAT(' MSSM WARNING: Z -> Z1SS Z1SS EXCEEDS BOUND') ** ENDIF ** IITEST=IITEST/2 ** IF(MOD(IITEST,2).NE.0) THEN ** WRITE(LOUT,2004) **2004 FORMAT(' MSSM WARNING: Z -> CHARGINOS ALLOWED') ** ENDIF ** IITEST=IITEST/2 ** IF(MOD(IITEST,2).NE.0) THEN ** WRITE(LOUT,2008) **2008 FORMAT(' MSSM WARNING: Z -> Z1SS Z2SS TOO BIG') ** ENDIF ** IITEST=IITEST/2 ** IF(MOD(IITEST,2).NE.0) THEN ** WRITE(LOUT,2016) **2016 FORMAT(' MSSM WARNING: Z -> SQUARKS, SLEPTONS ALLOWED') ** ENDIF ** IITEST=IITEST/2 ** IF(MOD(IITEST,2).NE.0) THEN ** WRITE(LOUT,2032) **2032 FORMAT(' MSSM WARNING: Z -> Z* HL0 EXCEEDS BOUND') ** ENDIF ** IITEST=IITEST/2 ** IF(MOD(IITEST,2).NE.0) THEN ** WRITE(LOUT,2064) **2064 FORMAT(' MSSM WARNING: Z -> HL0 HA0 ALLOWED') ** ENDIF C ** WRITE(LOUT,3600) **3600 FORMAT(//' ISASUSY decay modes:'/ ** $' Parent --> daughters',18X,'Width',10X,'Branching ratio'/) C Write all modes ** DO 200 J=1,NOUT ** CALL SSPRT(IDOUT(J)) **200 CONTINUE C * END ! FSUGRUN *CMZ : 02/08/99 14.05.01 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LT4SUSY * * *----------------------------------------------------------------------* * * * Name : LT4SUSY * * (module) * * * * Description : * * calculations of new data from EWWG-99 report * * for paper on 4 generations * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/08/99 * * * * * * Last modifications : 02/08/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * call hlimit(100000) call ltinit(0) *========================================================================== * fit fourth generation in Ngen-msb plane amh=120. amd4=130. amgluino=200. call ltn4msb(amh,amd4,amgluino) call lthrout END ! LT4SUSY *CMZ : 03/08/99 19.50.27 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 02/08/99 SUBROUTINE LTN4MSB(amh0,am40,amgluino0) * * *----------------------------------------------------------------------* * * * Name : LTN4MSB * * (module) * * * * Description : * * calculations of the contour plot Number of generations vs * * mass of sbottom * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 02/08/99 * * * * * * Last modifications : 02/08/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e4(4,4) parameter (n4=100) parameter (nmsb=100) dimension amsbf(nmsb),an4f(n4),chi24f(n4,nmsb) write(6,*)'+LTN4MSB: amh0,am40,amgluino0= ',amh0,am40,amgluino0 *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) amh=amh0 if(amh0.le.0.)amh=90. am4=am40 imh=amh imsb=am4 ih=imh*1000+imsb an4min=-0.5 an4max=+2.0 amsbmin=100. amsbmax=1000. call hbook2(ih,' ',n4,an4min,an4max,nmsb,amsbmin,amsbmax,0.) CHIMIN=0. *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit amq4 als chi2 ndf ' * fit fourth generation plot n4 vs msb CALL LTPUT('MH',AMH) call LTPUT('MD4',am4) call LTPUT('ME4',am4) do i4=1,n4 an4=an4min+(i4-1+0.5)*(an4max-an4min)/n4 an4f(i4)=an4 call LTPUT('NQ4',an4) call LTPUT('NL4',an4) amu4=am4 call LTPUT('MU4',amu4) call LTPUT('MN4',amu4) do imsb=1,nmsb call ltsusy_init(0) amsb=amsbmin+(imsb-1)*(amsbmax-amsbmin)/nmsb * no TL-tR mixing * mst1=mLL call LTSUSYPUT('IMST1',1.) D1=0. call LTSUSYPUT('DMST1',D1) * mst2=msb call LTSUSYPUT('IMST2',1.) D2=0. call LTSUSYPUT('DMST2',D2) write(6,*)'amsb=',amsb call ltsusyput('MSB',amsb) amgluino=200. call ltsusyput('MGLUINO',amgluino) beta=atan(2.) call ltsusyput('BETA',beta) call LTSUSYGET('MLL',AMLL) write(6,*)'beta,AMLL=',beta,AMLL thlr=0. call ltsusyget('THETALR',thlr) call ltsusyget('MST1',AM1) call ltsusyget('MST2',AM2) write(6,*)'Stop masses mst1,mst2=',AM1,AM2 write(6,*)'mLL,ThetaLR=',AMLL,THLR if(amh0.gt.0.)then CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) else * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) * CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) * CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) * CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amhfit=10**alogmh * emhpos=10**(alogmh+elogmhpos)-amh * emhneg=10**(alogmh+elogmhneg)-amh CALL LTFUSE('NOUSE','MH') endif amsbf(imsb)=amsb chi24f(i4,imsb)=chi2 CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10060) i4,imsb,an4,amsb,als,amhfit,chi2,ndf 10060 format(2i3,2f6.1,f6.4,2f12.2,i3) call hf2(ih,an4,amsb+0.0001,chi2-chimin) enddo ! imsb enddo ! i4 write(6,*)'amsb ',(an4f(ip),ip=1,n4) do imsb=1,nmsb * write(6,10070)amsbf(imsb),(chi24f(ip,imsb),ip=1,n4) enddo 10070 format(f5.1,10f5.1) END ! LTN4MSB *CMZ : 14/10/99 13.44.03 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LT4MN50 * * *----------------------------------------------------------------------* * * * Name : LT4MN50 * * (module) * * * * Description : * * calculations of the limits on 4-th generation * * with neutral heavy lepton around 50 GeV * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 01/10/99 * * * * * * Last modifications : * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. call hlimit(100000) * fit fourth generation in Ngen-MN4 plane amh=0. ! fit also mH ame4=100. amd4=200. amu4=220. call ltn4mn4(amh,ame4,amu4,amd4) call lthrout END ! LT4MN50 *CMZ : 05/11/99 23.04.07 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LTN4MN4(amh0,ame40,amu40,amd40) * * *----------------------------------------------------------------------* * * * Name : LTN4MN4 * * (module) * * * * Description : * * calculations of the contour plot Number of generations vs * * mass of the neutral heavy lepton * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 1/10/99 * * * * * * Last modifications : 3/10/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e4(4,4) parameter (n4=100) parameter (nm4=100) dimension dmq4f(nm4),an4f(n4),chi24f(n4,nm4) real*8 dva4,dvr4,dvm4 real*8 tt,alss real*8 ddva4, ddvr4, ddvm4 write(6,*)'+LTN4M4: amh0,ame40,amu40,amd40=', 1 amh0,ame40,amu40,amd40 amh=amh0 *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) ame4=ame40 amd4=amd40 amu4=amu40 amh=amh0 if(amh0.le.0.)amh=90. am4=am40 imh=amh im4=amd40 ih=imh*1000+im4 an4min=-0.5 an4max=+5.0 * dm4min=45.5935 -.1140 ! MZ/2 -halfbin * dm4max=68.39025-.1140 ! MZ/2+MZ/4 -halfbin dm4min=45.5935 -.228 ! MZ/2 -halfbin dm4max=91.1870 -.228 ! MZ/2+MZ/4 -halfbin call hbook2(ih,' ',n4,an4min,an4max,nm4,dm4min,dm4max,0.) CHIMIN=0. *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit amq4 als chi2 ndf ' * fit fourth generation plot n4 vs dm4 CALL LTPUT('MH',AMH) call LTPUT('MQ4',amu4) ! should be before MU4,MD4 call LTPUT('MU4',amu4) call LTPUT('MD4',amd4) call LTPUT('ML4',ame4) ! should be before ME4,MN4 call LTPUT('ME4',ame4) * test Vi call LTPUT('NQ4',1.) call LTPUT('NL4',1.) write(6,*)'amn4 ddvm4 ddva4 dvmr4 ' do itest=1,20 amn4=50.+(itest-1)*5. call LTPUT('MN4',amn4) ddvm4=dvm4(tt,alss) ddva4=dva4(tt,alss) ddvr4=dvr4(tt,alss) write(6,*) amn4,ddvm4,ddva4,ddvr4 enddo * do i4=1,n4 an4=an4min+(i4-1+0.5)*(an4max-an4min)/n4 an4f(i4)=an4 call LTPUT('NQ4',an4) call LTPUT('NL4',an4) do im4=1,nm4 dm4=dm4min+(im4-1)*(dm4max-dm4min)/nm4 amn4=dm4 call LTPUT('MN4',amn4) * write(6,*)'an4,am4=',an4,am4 * tt=(174/91.1867)**2 * alss=0.120 * ddvml4=dvml4(tt,alss) * ddvmq4=dvmq4(tt,alss) * ddval4=dval4(tt,alss) * ddvaq4=dvaq4(tt,alss) * ddvrl4=dvrl4(tt,alss) * ddvrq4=dvrq4(tt,alss) * ddvm4=dvm4(tt,alss) * ddva4=dva4(tt,alss) * ddvr4=dvr4(tt,alss) * write(6,*)'i4,im4,an4,amn4,tt,alss=',i4,im4,an4,amn4,tt,alss * write(6,*)'ddvml4,ddvmq4,ddval4,ddvaq4,ddvrl4,ddvrq4=', * 1 ddvml4,ddvmq4,ddval4,ddvaq4,ddvrl4,ddvrq4 * write(6,*)'ddvm4,ddva4,dvmr4 =', * 1 ddvm4,ddva4,ddvr4 if(amh0.gt.0.)then CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) else * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) * CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) * CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) * CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amhfit=10**alogmh * emhpos=10**(alogmh+elogmhpos)-amh * emhneg=10**(alogmh+elogmhneg)-amh CALL LTFUSE('NOUSE','MH') endif dmq4f(im4)=dm4 chi24f(i4,im4)=chi2 CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10060) i4,im4,an4,dm4,als,amhfit,chi2,ndf 10060 format(2i3,2f6.1,f6.4,2f12.2,i3) call hf2(ih,an4,dm4+0.0001,chi2-chimin) enddo ! im4 enddo ! i4 write(6,*)'dm4 ',(an4f(ip),ip=1,n4) do im4=1,nm4 * write(6,10070)dmq4f(im4),(chi24f(ip,im4),ip=1,n4) enddo 10070 format(f5.1,10f5.1) END ! LTN4MN4 *CMZ : 22/11/99 13.37.09 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/11/99 SUBROUTINE LT4SUSYINO * * *----------------------------------------------------------------------* * * * Name : LT4SUSYINO * * (module) * * * * Description : * * calculations of new data from EWWG-99 report * * for four generation paper of nearly degenerate * * chargino/neutralino case * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/11/99 * * * * * * Last modifications : 5/11/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. integer nopt,iopt(20),lvopt(20) real e4(4,4) call hlimit(100000) call ltinit(0) write(6,*)'Scan M-neutralino with four parameter fit ========' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' * fit fourth generation plot n4 vs dm4 AMH=110. CALL LTPUT('MH',AMH) call ltsusy_init(0) call ltsusyput('SUSYFL',0.) nchar=50 write(6,*)' higgsino-dominated case' write(6,*)'ifit amchargino als mh chi2 ndf ' IOPTION(11)=1 ! higgsino-dominated case IOPTION(12)=0 ! no gaugino domination do ichar=1,nchar amc=50.+(ichar-1+0.5)*(100.-50.)/nchar call ltsusyput('MCHARGINO',amc) * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) amhfit=10**alogmh CALL LTFUSE('NOUSE','MH') CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) write(6,10060) ichar,amc,als,amhfit,chi2,ndf 10060 format(i3,f6.1,f6.4,2f12.2,i3) enddo ! ichar write(6,*)'gaugino-dominated case' write(6,*)'ifit amchargino als mh chi2 ndf ' IOPTION(11)=0 ! IOPTION(12)=1 ! gaugino-dominated case do ichar=1,nchar amc=50.+(ichar-1+0.5)*(100.-50.)/nchar call ltsusyput('MCHARGINO',amc) * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) amhfit=10**alogmh CALL LTFUSE('NOUSE','MH') CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) write(6,10060) ichar,amc,als,amhfit,chi2,ndf enddo ! ichar IOPTION(11)=0 IOPTION(12)=0 * fit fourth generation in Ngen-deltaM plane amh=0. ! fit also mH amd4=130. nopt=2 iopt(1)=9 lvopt(1)=1 ! with Degrassi iopt(2)=11 ! higgsino dominated case lvopt(2)=1 ! with nearly degenerate chargino/neutralino * iopt(2)=12 ! gaugino dominated case * lvopt(2)=1 ! with nearly degenerate chargino/neutralino call ltsusy_init(0) call ltsusyput('MCHARGINO',57.) call ltsusyput('SUSYFL',0.) irun=1 ! n4 versus mn4 plot irun=2 ! n4 versus mchargino plot if(irun.eq.1)then call ltn4m4(amh,amd4,iopt,lvopt,nopt) endif if(irun.eq.2)then call ltn4mc(amh,amd4,iopt,lvopt,nopt) endif call lthrout END ! LT4SUSYINO *CMZ : 23/11/99 16.33.25 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/11/99 SUBROUTINE LTCHARGINO * * *----------------------------------------------------------------------* * * * Name : LTCHARGINO * * (module) * * * * Description : * * calculations of new data from EWWG-99 report * * for four generation paper of nearly degenerate * * chargino/neutralino case * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/11/99 * * * * * * Last modifications : 5/11/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. real e4(4,4) call hlimit(100000) call ltinit(0) write(6,*)'Scan M-neutralino with four parameter fit ========' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' * fit fourth generation plot n4 vs dm4 AMH=110. CALL LTPUT('MH',AMH) call ltsusy_init(0) call ltsusyput('SUSYFL',0.) nchar=300 amcharmin=40. amcharmax=100. write(6,*)' higgsino-dominated case' write(6,*)'ifit amchargino als mh chi2 ndf ' IOPTION(11)=1 ! higgsino-dominated case IOPTION(12)=0 ! no gaugino domination do ichar=1,nchar amc=amcharmin+(ichar-1+0.5)*(amcharmax-amcharmin)/nchar call ltsusyput('MCHARGINO',amc) * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) amhfit=10**alogmh CALL LTFUSE('NOUSE','MH') CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) write(6,10060) ichar,amc,als,amhfit,chi2,ndf 10060 format(i3,f6.1,f6.4,f12.2,f12.6,i3) enddo ! ichar write(6,*)'gaugino-dominated case' write(6,*)'ifit amchargino als mh chi2 ndf ' IOPTION(11)=0 ! IOPTION(12)=1 ! gaugino-dominated case do ichar=1,nchar amc=amcharmin+(ichar-1+0.5)*(amcharmax-amcharmin)/nchar call ltsusyput('MCHARGINO',amc) * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) amhfit=10**alogmh CALL LTFUSE('NOUSE','MH') CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) write(6,10060) ichar,amc,als,amhfit,chi2,ndf enddo ! ichar call lthrout END ! LTCHARGINO *CMZ : 23/11/99 00.04.20 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LTN4MC(amh0,am40,iopt,lvopt,nopt) * * *----------------------------------------------------------------------* * * * Name : LTN4MC * * (module) * * * * Description : * * calculations of the contour plot Number of generations vs * * mass of the degenerated chargino/neutralino * * * * amh0 - Higgs mass * * am40 - fourth generation mass * * iopt - option number to be changed * * lvopt- option value to be changed * * nopt - number of options to be changed * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 21/12/98 * * * * * * Last modifications : 19/02/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e4(4,4) * parameter (n4=100) * parameter (nm4=100) * TEST small number of points parameter (n4=20) parameter (nm4=20) real an4f(n4),dmq4f(nm4),chi24f(n4,nm4) integer nopt,iopt(20),lvopt(20) write(6,*)'+LTN4M4: amh0,am40= ',amh0,am40 amh=amh0 am4=am40 * go to 555 556 continue *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) do i=1,nopt iold=IOPTION(iopt(i)) IOPTION(iopt(i))=lvopt(i) write(6,*)i,'Option No=',iopt(i), 1 'changed from= ',iold,' to ',lvopt(i) enddo if(IOPTION(9).eq.0)write(6,*)'WARNING NO DEGRASSI' * IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) 555 continue amh=amh0 if(amh0.le.0.)amh=90. am4=am40 imh=amh im4=am4 ih=imh*1000+im4 an4min=-0.5 an4max=+2.0 dm4min=46. dm4max=96. call hbook2(ih,' ',n4,an4min,an4max,nm4,dm4min,dm4max,0.) CHIMIN=0. *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) do i=1,nopt iold=IOPTION(iopt(i)) IOPTION(iopt(i))=lvopt(i) write(6,*)i,'Option No=',iopt(i), 1 'changed from= ',iold,' to ',lvopt(i) enddo if(IOPTION(9).eq.0)write(6,*)'WARNING NO DEGRASSI' * IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit amq4 als chi2 ndf ' * fit fourth generation plot n4 vs dm4 CALL LTPUT('MH',AMH) call LTPUT('MD4',am4) call LTPUT('ME4',am4) do i4=1,n4 an4=an4min+(i4-1+0.5)*(an4max-an4min)/n4 an4f(i4)=an4 call LTPUT('NQ4',an4) call LTPUT('NL4',an4) do im4=1,nm4 dm4=125. amu4=sqrt(am4**2+dm4**2) call LTPUT('MU4',amu4) call LTPUT('MN4',amu4) amc=dm4min+(im4-1+0.5)*(dm4max-dm4min)/nm4 call LTSUSYPUT('MCHARGINO',amc) * write(6,*)'an4,am4=',an4,am4 if(amh0.gt.0.)then CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) else * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) * CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) * CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) * CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amhfit=10**alogmh * emhpos=10**(alogmh+elogmhpos)-amh * emhneg=10**(alogmh+elogmhneg)-amh CALL LTFUSE('NOUSE','MH') endif dmq4f(im4)=amc chi24f(i4,im4)=chi2 CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10060) i4,im4,an4,amc,als,amhfit,chi2,ndf 10060 format(2i3,2f6.1,f6.4,2f12.2,i3) call hf2(ih,an4,amc+0.0001,chi2-chimin) enddo ! im4 enddo ! i4 END ! LTN4MC *CMZ : 16/12/99 20.11.55 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LTN4MEMU(amh0,am40,iopt,lvopt,nopt) * * *----------------------------------------------------------------------* * * * Name : LTN4MEMU * * (module) * * * * Description : * * calculations of the contour plot Number of generations vs * * difference in masses * * * * amh0 - Higgs mass * * am40 - fourth generation mass * * iopt - option number to be changed * * lvopt- option value to be changed * * nopt - number of options to be changed * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 21/12/98 * * * * * * Last modifications : 19/02/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e4(4,4) * parameter (n4=100) * parameter (nm4=100) * TEST small number of points parameter (n4=20) parameter (nm4=20) dimension dmq4f(nm4),an4f(n4),chi24f(n4,nm4) real*8 tt,alss,ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 real*8 dval4, dvaq4, dvrl4, dvrq4, dvml4, dvmq4 integer nopt,iopt(20),lvopt(20) write(6,*)'+LTN4MEMU: amh0,am40= ',amh0,am40 amh=amh0 am4=am40 * go to 555 556 continue *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) do i=1,nopt iold=IOPTION(iopt(i)) IOPTION(iopt(i))=lvopt(i) write(6,*)i,'Option No=',iopt(i), 1 'changed from= ',iold,' to ',lvopt(i) enddo if(IOPTION(9).eq.0)write(6,*)'WARNING NO DEGRASSI' * IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) * non-degenerate fourth generation write(6,*)'ifit,ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4' do iamd4=1,2 amd4=150.+(iamd4-1)*150. do ifit=1,50 ame4=amd4 amu4=amd4+(ifit-1)*5. * if(ifit.gt.10)amq4=100.+(ifit-1)*100. amn4=amu4 call LTPUT('MU4',amu4) call LTPUT('MD4',amd4) call LTPUT('MN4',amn4) call LTPUT('ME4',ame4) tt=(175./91.)**2 alss=0.120 ddval4=dval4(tt,alss) ddvaq4=dvaq4(tt,alss) ddvrl4=dvrl4(tt,alss) ddvrq4=dvrq4(tt,alss) ddvml4=dvml4(tt,alss) ddvmq4=dvmq4(tt,alss) write(6,10050)ifit,amd4,amu4, + ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 enddo ! ifit enddo ! iamd4 * non-degenerate fourth generation write(6,*)'i,md4,mu4,', + 'ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4' do ifit=1,50 amd4=200.+(ifit-1)*4. ame4=amd4 amu4=400. amn4=amu4 call LTPUT('MU4',amu4) call LTPUT('MD4',amd4) call LTPUT('MN4',amn4) call LTPUT('ME4',ame4) tt=(175./91.)**2 alss=0.120 ddval4=dval4(tt,alss) ddvaq4=dvaq4(tt,alss) ddvrl4=dvrl4(tt,alss) ddvrq4=dvrq4(tt,alss) ddvml4=dvml4(tt,alss) ddvmq4=dvmq4(tt,alss) write(6,10050)ifit,amd4,amu4, + ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 10050 format(i3,2f6.0,6D10.4) enddo ! ifit 555 continue amh=amh0 if(amh0.le.0.)amh=90. am4=am40 imh=amh im4=am4 ih=imh*1000+im4 an4min=-0.5 an4max=+2.0 dm4min=0. dm4max=250. call hbook2(ih,' ',n4,an4min,an4max,nm4,dm4min,dm4max,0.) CHIMIN=0. *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) do i=1,nopt iold=IOPTION(iopt(i)) IOPTION(iopt(i))=lvopt(i) write(6,*)i,'Option No=',iopt(i), 1 'changed from= ',iold,' to ',lvopt(i) enddo if(IOPTION(9).eq.0)write(6,*)'WARNING NO DEGRASSI' * IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit amq4 als chi2 ndf ' * fit fourth generation plot n4 vs dm4 CALL LTPUT('MH',AMH) call LTPUT('MD4',am4) call LTPUT('MN4',am4) do i4=1,n4 an4=an4min+(i4-1+0.5)*(an4max-an4min)/n4 an4f(i4)=an4 call LTPUT('NQ4',an4) call LTPUT('NL4',an4) do im4=1,nm4 dm4=dm4min+(im4-1)*(dm4max-dm4min)/nm4 amu4=sqrt(am4**2+dm4**2) call LTPUT('MU4',amu4) call LTPUT('ME4',amu4) * write(6,*)'an4,am4=',an4,am4 if(amh0.gt.0.)then CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) else * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) * CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) * CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) * CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amhfit=10**alogmh * emhpos=10**(alogmh+elogmhpos)-amh * emhneg=10**(alogmh+elogmhneg)-amh CALL LTFUSE('NOUSE','MH') endif dmq4f(im4)=dm4 chi24f(i4,im4)=chi2 CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10060) i4,im4,an4,dm4,als,amhfit,chi2,ndf 10060 format(2i3,2f6.1,f6.4,2f12.2,i3) call hf2(ih,an4,dm4+0.0001,chi2-chimin) enddo ! im4 enddo ! i4 write(6,*)'dm4 ',(an4f(ip),ip=1,n4) do im4=1,nm4 * write(6,10070)dmq4f(im4),(chi24f(ip,im4),ip=1,n4) enddo 10070 format(f5.1,10f5.1) END ! LTN4MEMU *CMZ : 23/11/99 14.56.51 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LT4M4 * * *----------------------------------------------------------------------* * * * Name : LT4M4 * * (module) * * * * Description : * * calculations of new data from EWWG-99 report * * for four generations paper * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 23/11/99 * * * * * * Last modifications : 23/11/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. integer nopt,iopt(20),lvopt(20) call hlimit(100000) call ltinit(0) *========================================================================== * fit fourth generation in Ngen-deltaM plane * amh=90. * amh=300. * amh=50. amh=0. ! fit also mH amd4=130. nopt=1 iopt(1)=9 lvopt(1)=1 ! with Degrassi * call ltn4m4(amh,amd4,iopt,lvopt,nopt) * call ltn4memu(amh,amd4,iopt,lvopt,nopt) call ltn4mnmd(amh,amd4,iopt,lvopt,nopt) call lthrout END ! LT4M4 *CMZ : 16/12/99 20.11.23 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LTN4MNMD(amh0,am40,iopt,lvopt,nopt) * * *----------------------------------------------------------------------* * * * Name : LTN4MNMD * * (module) * * * * Description : * * calculations of the contour plot Number of generations vs * * difference in masses * * * * amh0 - Higgs mass * * am40 - fourth generation mass * * iopt - option number to be changed * * lvopt- option value to be changed * * nopt - number of options to be changed * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 21/12/98 * * * * * * Last modifications : 19/02/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e4(4,4) * parameter (n4=100) * parameter (nm4=100) * TEST small number of points parameter (n4=20) parameter (nm4=20) dimension dmq4f(nm4),an4f(n4),chi24f(n4,nm4) real*8 tt,alss,ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 real*8 dval4, dvaq4, dvrl4, dvrq4, dvml4, dvmq4 integer nopt,iopt(20),lvopt(20) write(6,*)'+LTN4MNMD: amh0,am40= ',amh0,am40 amh=amh0 am4=am40 * go to 555 556 continue *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) do i=1,nopt iold=IOPTION(iopt(i)) IOPTION(iopt(i))=lvopt(i) write(6,*)i,'Option No=',iopt(i), 1 'changed from= ',iold,' to ',lvopt(i) enddo if(IOPTION(9).eq.0)write(6,*)'WARNING NO DEGRASSI' * IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) * non-degenerate fourth generation write(6,*)'ifit,ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4' do iamd4=1,2 amd4=150.+(iamd4-1)*150. do ifit=1,50 ame4=amd4 amu4=amd4+(ifit-1)*5. * if(ifit.gt.10)amq4=100.+(ifit-1)*100. amn4=amu4 call LTPUT('MU4',amu4) call LTPUT('MD4',amd4) call LTPUT('MN4',amn4) call LTPUT('ME4',ame4) tt=(175./91.)**2 alss=0.120 ddval4=dval4(tt,alss) ddvaq4=dvaq4(tt,alss) ddvrl4=dvrl4(tt,alss) ddvrq4=dvrq4(tt,alss) ddvml4=dvml4(tt,alss) ddvmq4=dvmq4(tt,alss) write(6,10050)ifit,amd4,amu4, + ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 enddo ! ifit enddo ! iamd4 * non-degenerate fourth generation write(6,*)'i,md4,mu4,', + 'ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4' do ifit=1,50 amd4=200.+(ifit-1)*4. ame4=amd4 amu4=400. amn4=amu4 call LTPUT('MU4',amu4) call LTPUT('MD4',amd4) call LTPUT('MN4',amn4) call LTPUT('ME4',ame4) tt=(175./91.)**2 alss=0.120 ddval4=dval4(tt,alss) ddvaq4=dvaq4(tt,alss) ddvrl4=dvrl4(tt,alss) ddvrq4=dvrq4(tt,alss) ddvml4=dvml4(tt,alss) ddvmq4=dvmq4(tt,alss) write(6,10050)ifit,amd4,amu4, + ddval4,ddvaq4,ddvrl4,ddvrq4,ddvml4,ddvmq4 10050 format(i3,2f6.0,6D10.4) enddo ! ifit 555 continue amh=amh0 if(amh0.le.0.)amh=90. am4=am40 imh=amh im4=am4 ih=imh*1000+im4 an4min=-0.5 an4max=+2.0 dm4min=0. dm4max=250. call hbook2(ih,' ',n4,an4min,an4max,nm4,dm4min,dm4max,0.) CHIMIN=0. *========================================================================== * fit fourth generation write(6,*)'Four parameter fit with fourth generation ========' CALL LTINIT(0) do i=1,nopt iold=IOPTION(iopt(i)) IOPTION(iopt(i))=lvopt(i) write(6,*)i,'Option No=',iopt(i), 1 'changed from= ',iold,' to ',lvopt(i) enddo if(IOPTION(9).eq.0)write(6,*)'WARNING NO DEGRASSI' * IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification CALL LTFPUT('EWWG99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of EWWG99, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit amq4 als chi2 ndf ' * fit fourth generation plot n4 vs dm4 CALL LTPUT('MH',AMH) call LTPUT('MU4',am4) call LTPUT('ME4',am4) do i4=1,n4 an4=an4min+(i4-1+0.5)*(an4max-an4min)/n4 an4f(i4)=an4 call LTPUT('NQ4',an4) call LTPUT('NL4',an4) do im4=1,nm4 dm4=dm4min+(im4-1)*(dm4max-dm4min)/nm4 amu4=sqrt(am4**2+dm4**2) call LTPUT('MD4',amu4) call LTPUT('MN4',amu4) * write(6,*)'an4,am4=',an4,am4 if(amh0.gt.0.)then CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) else * use low mH limit in the fit CALL LTFUSE('USE','MH') CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) * CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) * CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) * CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amhfit=10**alogmh * emhpos=10**(alogmh+elogmhpos)-amh * emhneg=10**(alogmh+elogmhneg)-amh CALL LTFUSE('NOUSE','MH') endif dmq4f(im4)=dm4 chi24f(i4,im4)=chi2 CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10060) i4,im4,an4,dm4,als,amhfit,chi2,ndf 10060 format(2i3,2f6.1,f6.4,2f12.2,i3) call hf2(ih,an4,dm4+0.0001,chi2-chimin) enddo ! im4 enddo ! i4 write(6,*)'dm4 ',(an4f(ip),ip=1,n4) do im4=1,nm4 * write(6,10070)dmq4f(im4),(chi24f(ip,im4),ip=1,n4) enddo 10070 format(f5.1,10f5.1) END ! LTN4MNMD *CMZ : 16/12/99 21.09.11 by A.Rozanov *CMZ : 2.00/03 08/09/98 23.32.33 by A.Rozanov *-- Author : A.Rozanov 05/09/98 SUBROUTINE LTLP99 * * *----------------------------------------------------------------------* * * * Name : LTLP99 * * (module) * * * * Description : * * calculations of new data from LP-99 conference * * * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 16/12/99 * * * * * * Last modifications : 16/12/99 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * *KEEP,OPTIONS. PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) *KEND. dimension e3(3,3),e4(4,4),alogmhv(22),chi2v(22) logical twoloops call hlimit(100000) * table of observables call ltinit(0) * table with Born predictions call ltinit(0) call vzero(e4,16) amh=100. e4(1,1)=(alog10(150.)-alog10(100.))**2 CALL LTFGET('VALUE','MT',amt) CALL LTFGET('ERROR','MT',eamt) e4(2,2)=eamt**2 CALL LTFGET('VALUE','ALS',als) CALL LTFGET('ERROR','ALS',eals) e4(3,3)=eals**2 CALL LTFGET('VALUE','ALB-1',albinv) CALL LTFGET('ERROR','ALB-1',ealbinv) e4(4,4)=ealbinv**2 call ltufntab1(amh,amt,als,1./albinv,e4) call tabconstlb * The ultimate fit with alsPDG and albarDavier CALL LTINIT(0) write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('LP99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') als=0.1178 CALL LTFPUT('VALUE','ALS',als) eals=0.0023 CALL LTFPUT('ERROR','ALS',eals) write(6,*)'als,eals=',als,eals albinv=128.923 ! Davier CALL LTFPUT('VALUE','ALB-1',albinv) ealbinv=0.036 CALL LTFPUT('ERROR','ALB-1',ealbinv) write(6,*)'albinv,ealbinv=',albinv,ealbinv CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'Yes als, yes albar' CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) do ip=1,4 write(6,10200)(e4(ip,jp),jp=1,4) enddo CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) CALL LTFGET('FIT_ERR+' ,'ALBAR-1',ealbpos) CALL LTFGET('FIT_ERR-' ,'ALBAR-1',ealbneg) CALL LTFGET('FIT_GLB' ,'ALBAR-1',glbalb) amh=10**alogmh if(ifit.eq.3)alogmhbest=alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbpos,ealbneg,ealbfitinv1,ealbfitinv4 write(6,*)'+LTLP9998: chi2/ndf= ',chi2,ndf call lttable3(amh,amt,als,1./albfitinv,e4) call ltpredmt(amh,amt,als,1./albfitinv,e4) * call ltscanalb(amh,amt,als,1./albfitinv,e4) * do iloop=1,1 * initialisation CALL LTINIT(0) if(iloop.eq.1)then twoloops=.true. elseif(iloop.eq.2)then twoloops=.false. endif if(twoloops)then write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi else write(6,*)'No two loops corrections (also no Degrassi)' IOPTION(9)=0 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=1 ! 1 -no two loops in d4Vi,d5Vi,dPhi endif write(6,*)'opt(9),opt(10)=',ioption(9),ioption(10) CALL LTFPUT('LP99','ALL',DUMMY) * call hlimit(100000) * set all LEPTOP print flags off CALL LTFLAG('PRNT',0) CALL LTFLAG('MNUNIT',6) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') do il=1,3 if(il.eq.1)then albar=1./128.896 elseif(il.eq.2)then albar=1./(128.896-0.090) elseif(il.eq.3)then albar=1./(128.896+0.090) endif write(6,*)'1/albar=',1./albar call LTPUT('ALBAR',albar) CALL LTINIT(1) CALL LTFIT3('MT,ALS,LOGMH',amt,als,alogmh,eamt,eals,ealogmh, 1 e3,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh write(6,10020)amt,emtpos,emtneg,amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,als,eals 10020 format('+LTOBZOP98: mt= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,/ 1 ' als= ',f7.5,' +- ',f7.5) write(6,*)'+LTLP9998: chi2= /ndf ',chi2,ndf enddo ! il * 1000 continue * fit mt-als CALL LTINIT(0) if(twoloops)then write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi else write(6,*)'No two loops corrections (also no Degrassi)' IOPTION(9)=0 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=1 ! 1 -no two loops in d4Vi,d5Vi,dPhi endif CALL LTFPUT('LP99','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') AMH=300. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=60. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt AMH=1000. CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'mt-als fit: mh= ',amh,'mt= ',amt,' +- ',eamt write(6,*)'Four parameter fit ===========================' do ifit=1,7 CALL LTINIT(0) if(twoloops)then write(6,*)'With two loops corrections including Degrassi' IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi else write(6,*)'No two loops corrections (also no Degrassi)' IOPTION(9)=0 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=1 ! 1 -no two loops in d4Vi,d5Vi,dPhi endif CALL LTFPUT('LP99','ALL',DUMMY) CALL LTFLAG('PRNT',0) * CALL LTFLAG('MNUNIT',6) * CALL LTFLAG('MNPRNT',1) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') als=0.1178 CALL LTFPUT('VALUE','ALS',als) eals=0.0023 CALL LTFPUT('ERROR','ALS',eals) write(6,*)'ifit,als,eals=',ifit,als,eals if(ifit.eq.1)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'No als, no albar' elseif(ifit.eq.2)then CALL LTFUSE('USE','ALS') CALL LTFUSE('NOUSE','ALB-1') write(6,*)'Yes als, no albar' elseif(ifit.eq.3)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' elseif(ifit.eq.4)then CALL LTFUSE('USE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'Yes als, yes albar' elseif(ifit.eq.5)then CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar, no MT FNAL' elseif(ifit.eq.6)then CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar, no MT FNAL, no ALR, no Ab', 1 'no AC' elseif(ifit.eq.7)then CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','AFBL') CALL LTFUSE('NOUSE','ATAU') CALL LTFUSE('NOUSE','AETAU') CALL LTFUSE('NOUSE','AFBB') CALL LTFUSE('NOUSE','AFBC') CALL LTFUSE('NOUSE','QFB') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('NOUSE','MT') CALL LTFUSE('USE','ALB-1') write(6,*)'Noals, yesalbar, noMTFNAL, noAFB, noAtau, noAe,', 1 'noAFBb, noAFBc, noQFB' endif call ltinit(1) call ltget('S2',s2) call ltget('ALBAR',albar) call ltget('MZ',amz) write(6,*)'s2,albar,amz=',s2,albar,amz CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) do ip=1,4 write(6,10200)(e4(ip,jp),jp=1,4) enddo CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) CALL LTFGET('FIT_ERR+' ,'ALBAR-1',ealbpos) CALL LTFGET('FIT_ERR-' ,'ALBAR-1',ealbneg) CALL LTFGET('FIT_GLB' ,'ALBAR-1',glbalb) amh=10**alogmh if(iloop.eq.2.and.ifit.eq.3)then amhno2loop=amh endif if(ifit.eq.3)alogmhbest=alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbpos,ealbneg,ealbfitinv1,ealbfitinv4 10030 format('+LTLP9998: mt= ',f6.1,' + ',f6.1,' ',f6.1,2f6.1,' glb=', 1 f5.3,/ 1 ' mh= ',f6.1,' + ',f6.1,' ',f6.1,/ 1 ' logmh= ',f6.2,' + ',f6.2,' ',f6.2,2f6.2,' glb=', 1 f5.3,/ 1 ' als= ',f7.5,' +- ',f7.5,f7.5,/ 1 ' 1/alb= ',f7.3,'+',f5.3,'-',f5.3,' +- ',f5.3,f5.3) write(6,*)'+LTLP9998: chi2/ndf= ',chi2,ndf * call lttable2(amh,amt,als,1./albfitinv) call lttable3(amh,amt,als,1./albfitinv,e4) call ltpredmt(amh,amt,als,1./albfitinv,e4) * call ltscanalb(amh,amt,als,1./albfitinv,e4) enddo ! ifit * make the chi2 curve vs mH by 3-par fits for each mH CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar for MH=100,130 GeV fits' do imh=1,2 if(imh.eq.1)then amh=100. elseif(imh.eq.2)then amh=130. endif CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) do ip=1,4 e4(ip,3)=0. e4(3,ip)=0. enddo do ip=1,4 write(6,10200)(e4(ip,jp),jp=1,4) enddo 10200 format(1x,4f10.6) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf call lttable3(amh,amt,als,1./albfitinv,e4) enddo *====================================================================== do imz=1,3 * vary MZ mass if(imz.eq.1)then CALL LTPUT('MZ',91.1867) CALL LTINIT(1) write(6,*)'Central MZ mass' elseif(imz.eq.2)then CALL LTPUT('MZ',91.1867+0.0021) CALL LTINIT(1) write(6,*)'MZ mass up by one s.d.' elseif(imz.eq.3)then CALL LTPUT('MZ',91.1867-0.0021) CALL LTINIT(1) write(6,*)'MZ mass down by one s.d.' endif do imh=1,22 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 enddo ! imh * calculate 2-sigma errors xchi2=chi2v(10)+2.**2 xalogmh_neg=divdif(alogmhv(1),chi2v(1),10,xchi2,2) xalogmh_pos=divdif(alogmhv(10),chi2v(10),11,xchi2,2) dalogmh_neg=alogmhbest-xalogmh_neg dalogmh_pos=xalogmh_pos-alogmhbest dmh_neg=10**alogmhbest-10**xalogmh_neg dmh_pos=10**xalogmh_pos-10**alogmhbest amh=10**alogmhbest write(6,*)'Higgs two-sigma errors:' write(6,*)'mh= ',amh,' + ',dmh_pos,' - ',dmh_neg write(6,*)'alogmh= ',alogmhbest, 1 ' + ',dalogmh_pos,' - ',dalogmh_neg * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv(10),chi2v(10),11,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv(10),chi2v(10),11,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' enddo ! imz *========================================================================== call ltinit(0) amh=88.3 amt=171.0 als=0.1192 albfitinv=128.908 alb=1./albfitinv call lttable6(amh,amt,als,alb,e4) enddo ! iloop write(6,*)'MH upper limits' write(6,*)'With two loops corrections including Degrassi' ncase=4 do icase=1,ncase CALL LTINIT(0) IOPTION(9)=1 ! 0 -no Degrassification, 1 -with degrassification IOPTION(10)=0 ! 1 -no two loops in d4Vi,d5Vi,dPhi CALL LTFPUT('LP99','ALL',DUMMY) CALL LTFLAG('PRNT',0) CALL LTFUSE('USE','MT') CALL LTFUSE('USE','S2NUN') * do not use Rbslc in case of vancouver98, because it is already combined in Rb CALL LTFUSE('NOUSE','RBSLC') als=0.1178 CALL LTFPUT('VALUE','ALS',als) eals=0.0023 CALL LTFPUT('ERROR','ALS',eals) write(6,*)'als,eals=',als,eals CALL LTFUSE('USE','ALB-1') if(icase.eq.1)then * only LEP without SLAC CALL LTFUSE('NOUSE','ALR') CALL LTFUSE('NOUSE','ABSLC') CALL LTFUSE('NOUSE','ACSLC') CALL LTFUSE('NOUSE','ALS') elseif(icase.eq.2)then * LEP + SLAC CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('NOUSE','ALS') elseif(icase.eq.3)then * LEP + SLAC +als(PDG) CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('USE','ALS') elseif(icase.eq.4)then * LEP + SLAC +als(PDG) + albar from Davier CALL LTFUSE('USE','ALR') CALL LTFUSE('USE','ABSLC') CALL LTFUSE('USE','ACSLC') CALL LTFUSE('USE','ALS') albinv=128.923 ! Davier CALL LTFPUT('VALUE','ALB-1',albinv) ealbinv=0.036 CALL LTFPUT('ERROR','ALB-1',ealbinv) write(6,*)'Davier: albinv,ealbinv=',albinv,ealbinv endif call ltinit(1) call ltget('S2',s2) call ltget('ALBAR',albar) call ltget('MZ',amz) write(6,*)'s2,albar,amz=',s2,albar,amz CALL LTFIT4('MT,ALS,LOGMH,ALBAR',amt,als,alogmh,albfitinv, 1 eamt,eals,ealogmh,ealbfitinv, 1 e4,chi2,ndf) CALL LTFGET('FIT_ERR+' ,'MT',emtpos) CALL LTFGET('FIT_ERR-' ,'MT',emtneg) CALL LTFGET('FIT_GLB' ,'MT',glbemt) CALL LTFGET('FIT_ERR+' ,'LOGMH',elogmhpos) CALL LTFGET('FIT_ERR-' ,'LOGMH',elogmhneg) CALL LTFGET('FIT_GLB' ,'LOGMH',glblogmh) amh=10**alogmh emhpos=10**(alogmh+elogmhpos)-amh emhneg=10**(alogmh+elogmhneg)-amh albfitinv1=albfitinv ealbfitinv1=ealbfitinv ealbfitinv4=sqrt(e4(4,4)) write(6,10030)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 1 amh,emhpos,emhneg, 1 alogmh,elogmhpos,elogmhneg,ealogmh,sqrt(e4(3,3)), 1 glblogmh, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 write(6,*)'+LTLP9998: chi2/ndf= ',chi2,ndf *----------------------- alogmhbest=alogmh do imz=1,3 * vary MZ mass if(imz.eq.1)then CALL LTPUT('MZ',91.1867) CALL LTINIT(1) elseif(imz.eq.2)then CALL LTPUT('MZ',91.1867+0.0021) CALL LTINIT(1) elseif(imz.eq.3)then CALL LTPUT('MZ',91.1867-0.0021) CALL LTINIT(1) endif write(6,*)'imz,icase=',imz,icase call hbook1(1000+imz*10+icase,' ',1000,0.,2000.,0.) call hbook1(2000+imz*10+icase,' ',100,0.5,100.5,0.) write(6,*)'alogmhbest=',alogmhbest do imh=1,22 alogmh=alogmhbest+0.1*(imh-10) amh=10**alogmh CALL LTPUT('MH',AMH) CALL LTFIT4('MT,ALS,ALBAR',amt,als,amh,albfitinv, 1 eamt,eals,eamh,ealbfitinv, 1 e4,chi2,ndf) write(6,*)'imh,amh,chi2,ndf=',imh,amh,chi2,ndf alogmhv(imh)=alogmh chi2v(imh)=chi2 call hf1(1000+imz*10+icase,amh,chi2) enddo ! imh * calculate 1-sigma errors xchi2=chi2v(10)+1. xalogmh_neg=divdif(alogmhv(1),chi2v(1),10,xchi2,2) xalogmh_pos=divdif(alogmhv(10),chi2v(10),11,xchi2,2) dalogmh_neg=alogmhbest-xalogmh_neg dalogmh_pos=xalogmh_pos-alogmhbest dmh_neg=10**alogmhbest-10**xalogmh_neg dmh_pos=10**xalogmh_pos-10**alogmhbest amh=10**alogmhbest write(6,*)'Higgs one-sigma errors:' write(6,*)'mh= ',amh,' + ',dmh_pos,' - ',dmh_neg write(6,*)'alogmh= ',alogmhbest, 1 ' + ',dalogmh_pos,' - ',dalogmh_neg call hf1(2000+imz*10+icase,1.0,amh) call hf1(2000+imz*10+icase,2.0,dmh_pos) call hf1(2000+imz*10+icase,3.0,dmh_neg) * calculate 2-sigma errors xchi2=chi2v(10)+2.**2 xalogmh_neg=divdif(alogmhv(1),chi2v(1),10,xchi2,2) xalogmh_pos=divdif(alogmhv(10),chi2v(10),11,xchi2,2) dalogmh_neg=alogmhbest-xalogmh_neg dalogmh_pos=xalogmh_pos-alogmhbest dmh_neg=10**alogmhbest-10**xalogmh_neg dmh_pos=10**xalogmh_pos-10**alogmhbest amh=10**alogmhbest write(6,*)'Higgs two-sigma errors:' write(6,*)'mh= ',amh,' + ',dmh_pos,' - ',dmh_neg write(6,*)'alogmh= ',alogmhbest, 1 ' + ',dalogmh_pos,' - ',dalogmh_neg * calculate chi2 for one-side 95 % CL xchi2=chi2v(10)+1.64**2 xalogmh=divdif(alogmhv(10),chi2v(10),11,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh950=10**(xalogmh) amh95=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh950,' GeV on 95 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh95, 1 ' GeV on 95 % CL' * calculate chi2 for one-side 99.5 % CL xchi2=chi2v(10)+2.58**2 xalogmh=divdif(alogmhv(10),chi2v(10),11,xchi2,2) * correct upper limit on theor.error from higher orders delta(logmh)=0.1 amh9950=10**(xalogmh) amh995=10**(xalogmh+0.1) write(6,*)'One-sided upper mH < ',amh9950,' GeV on 99.5 % CL' write(6,*)'One-sided (with th.er.)upper mH < ',amh995, 1 ' GeV on 99.5 % CL' enddo ! icase enddo ! imz call lthrout END ! LTLP99