+TITLE. LEPTOP 2.00/03 08/09/98 23.49.32 +PATCH,CODE. *CMZ : 2.00/00 25/06/97 09.22.18 by A.Rozanov +KEEP,deltac. *CMZ : 2.00/02 06/07/98 10.24.47 by A.Rozanov *-- Author : A.Rozanov 06/07/98 COMMON/DELTAC/X,Yv 06/07/98 +DECK,MAIN. *CMZ : 1.30/07 17/02/95 22.30.55 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 : *====================================================================* program LEPTOP * 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 * *====================================================================* CALL LTTEST END +DECK,LTSCAN. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,DEBUG. 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 +DECK,LTFOUR. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,DEBUG. +SEQ,ZVALUE. 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 +DECK,ZVM. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,ZVALUE. T=(AMT/AMZ)**2 H=(ZZMH/AMZ)**2 ZVM=ZZVM-VM(T,H,ZZALSB) END +DECK,ZVA. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,ZVALUE. T=(AMT/AMZ)**2 H=(ZZMH/AMZ)**2 ZVA=ZZVA-VAL(T,H,ZZALSB) END +DECK,ZVR. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,ZVALUE. T=(AMT/AMZ)**2 H=(ZZMH/AMZ)**2 ZVR=ZZVR-VRL(T,H,ZZALSB) END +DECK,LTSTRT. *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 +SEQ,DOUBLE. +SEQ,DEBUG. *-----initialisations DO I=1,10 PRTFLG(I)=-1. ENDDO CALL LTINIT(0) END +DECK,LTGLASGOW. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,SMITH. * 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 +DECK,LTISOLINE. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,SMITH. * 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 +DECK,LTCHCK. *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 +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,PAWC. +SEQ,TTBAR. +SEQ,FOURTH. +SEQ,TMINDV. +SEQ,MASSES. +SEQ,LEPFIT. +SEQ,LBTABL. +SEQ,OPTIONS. 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 +DECK,LTBOOK. *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 +SEQ,DOUBLE. +SEQ,PAWC. 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 +DECK,LTFMTH. *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) *------------------------------------------------------------------- +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,CONST. +SEQ,LEPFIT. 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 +DECK,LTFIT. *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 *----------------------------------------------------------------------* +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. 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 +DECK,PRTERR. *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 +SEQ,DOUBLE. 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 +DECK,FCNLB. *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) +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,LEPFIT. +SEQ,CONST. DIMENSION X(*),GIN(*),THEOR(NL) DIMENSION DLEP(NL*NL) REAL*4 ROLEP(NL*NL) * REAL*4 I1(NL*NL) SAVE NPARX 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 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)=GELE(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 NI=0 CHI2=0. 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 * 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 F=CHI2 IF(IFLAG.EQ.3)THEN *-----FINISH if(PRTFLG(2).GT.0.)then WRITE(6,*)'NPLEP,CHI2',NPLEP,CHI2 endif ENDIF END +DECK,FT. *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) +SEQ,DOUBLE. 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 +DECK,F1T. *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) +SEQ,DOUBLE. 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 +DECK,FH. *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) +SEQ,DOUBLE. 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 +DECK,F1H. *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) +SEQ,DOUBLE. 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 +DECK,TM. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,TA. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,TR. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,TTM. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,TTA. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,TTR. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,HM. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,HR. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,HA. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,CM. *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) *----- +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,CA. *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) *----- +SEQ,DOUBLE. +SEQ,CONST. * CA=-2.26185+1.3082*(c2-0.7688) CA=-2.2619-2.63*(0.23117-s2) END +DECK,CR. *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) *----- +SEQ,DOUBLE. +SEQ,CONST. * 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 +DECK,HHM. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,HHA. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,HHR. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,ALSRUN. *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. +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CHETYR. 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 +DECK,ALSRU2. *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. +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CHETYR. * 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 +DECK,AMU. *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. +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CHETYR. +SEQ,CAFBBB. * 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 +DECK,VAL. *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) +SEQ,DOUBLE. * 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 +DECK,VRL. *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) +SEQ,DOUBLE. * 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 +DECK,VM. *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) +SEQ,DOUBLE. * 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 +DECK,VM_NOB. *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 +SEQ,DOUBLE. * 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 +DECK,VNU. *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) +SEQ,DOUBLE. +SEQ,CONST. ***** 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 +DECK,VAQ. *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) +SEQ,DOUBLE. 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 +DECK,VRQ. *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) +SEQ,DOUBLE. 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 +DECK,VAU. *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) +SEQ,DOUBLE. +SEQ,CONST. 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)*(FAU+FAL))/ 1 (3*ALBAR) END +DECK,VAD. *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) +SEQ,DOUBLE. +SEQ,CONST. 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)*(-FAD+FAL))/ 1 (3*ALBAR) END +DECK,VRU. *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) +SEQ,DOUBLE. +SEQ,CONST. 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-(1.-4*S2)*FAL+1.5*(-(1.-(8./3.)*S2)*FAU+FVU))/ 2 (3*ALBAR) END +DECK,VRD. *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) +SEQ,DOUBLE. +SEQ,CONST. 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-(1.-4*S2)*FAL+ 3.*( (1.-(4./3.)*S2)*FAD-FVD))/ 1 (3*ALBAR) END +DECK,DVM4. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. IF(AML4.GT.0.000001.OR.AMQ4.GT.0.000001)THEN DVM4=DVML4(T,ALSBAR)+DVMQ4(T,ALSBAR) ELSE DVM4=0. ENDIF END +DECK,DVML4. *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 preprint 11.05.94 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. DATA NC/1/,QU/0.0000000/,QD/ 1.0000000/ IF(AML4.GT.0.000001)THEN P=(AML4/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) DVML4=(4./9.)*NC*D*NL4 ELSE DVML4=0. ENDIF END +DECK,DVMQ4. *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 preprint 11.05.94 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ IF(AMQ4.GT.0.000001)THEN P=(AMQ4/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) DVMQ4=(4./9.)*NC*D*NQ4 ELSE DVMQ4=0. ENDIF END +DECK,DVR4. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. IF(AML4.GT.0.000001.OR.AMQ4.GT.0.000001)THEN DVR4=DVRL4(T,ALSBAR)+DVRQ4(T,ALSBAR) ELSE DVR4=0. ENDIF END +DECK,DVRL4. *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(T,ALSBAR) * from draft TH preprint 11.05.94 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. DATA NC/1/,QU/0.0000000/,QD/ 1.0000000/ IF(AML4.GT.0.000001)THEN P=(AML4/AMZ)**2 D=-3*P*FP(P)+4*S2*C2*(QU**2+QD**2)*((1+2*P)*FP(P)-0.333333333) DVRL4=(4./9.)*NC*D*NL4 ELSE DVRL4=0. ENDIF END +DECK,DVRQ4. *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(T,ALSBAR) * from draft TH preprint 11.05.94 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ IF(AMQ4.GT.0.000001)THEN P=(AMQ4/AMZ)**2 D=-3*P*FP(P)+4*S2*C2*(QU**2+QD**2)*((1+2*P)*FP(P)-0.333333333) DVRQ4=(4./9.)*NC*D*NQ4 ELSE DVRQ4=0. ENDIF END +DECK,DVA4. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. IF(AML4.GT.0.000001.OR.AMQ4.GT.0.000001)THEN DVA4=DVAL4(T,ALSBAR)+DVAQ4(T,ALSBAR) ELSE DVA4=0. ENDIF END +DECK,DVAL4. *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(T,ALSBAR) * from draft TH preprint 11.05.94 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. DATA NC/1/,QU/0.0000000/,QD/ 1.0000000/ IF(AML4.GT.0.000001)THEN P=(AML4/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 DVAL4=(-4./9.)*NC*D*NL4/PPRIME ELSE DVAL4=0. ENDIF END +DECK,DVAQ4. *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(T,ALSBAR) * from draft TH preprint 11.05.94 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,FOURTH. DATA NC/3/,QU/0.6666666/,QD/-0.3333333/ IF(AMQ4.GT.0.000001)THEN P=(AMQ4/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 ELSE DVAQ4=0. ENDIF END +DECK,DVA5. *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 +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,DVR5. *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 +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,DVM5. *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 +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,DVM. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,TMINDV. +SEQ,OPTIONS. * 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 +DECK,DVR. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,TMINDV. +SEQ,OPTIONS. * 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 +DECK,DVA. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,TMINDV. +SEQ,OPTIONS. * 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 +DECK,D1VM. *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) +SEQ,DOUBLE. +SEQ,CONST. D1VM=-16.*PI*s2**2*(DWAA(C2)+DTAA(T))/3. END +DECK,D1VA. *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) +SEQ,DOUBLE. +SEQ,CONST. D1VA=0.D0 END +DECK,D1VR. *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) +SEQ,DOUBLE. +SEQ,CONST. D1VR=-16.*PI*s2*c2*(DWAA(c2)+DTAA(T))/3. END +DECK,V1. *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) +SEQ,DOUBLE. DATA DZ2/1.644934067/ DATA DZ3/1.2020569/ V1=R*(4*DZ3-(5./6.))+R**2*(328./81.)+ 1R**3*(1796./(25.*27.)) END +DECK,V1mcad. *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 +SEQ,DOUBLE. 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 +DECK,V11mcd. *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 +SEQ,DOUBLE. 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 +DECK,V11. *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) +SEQ,DOUBLE. DATA DZ2/1.644934067/ DATA DZ3/1.2020569/ V11=(4*DZ3-(5./6.))+2*R*(328./81.)+3*R**2*(1796./(25.*27.)) END +DECK,A1. *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) +SEQ,DOUBLE. 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 +DECK,A1mcad. *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 +SEQ,DOUBLE. 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 +DECK,A11. *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) +SEQ,DOUBLE. 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 +DECK,A11mcd. *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 +SEQ,DOUBLE. 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 +DECK,F1. *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 +SEQ,DOUBLE. 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 +DECK,F1mcad. *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 +SEQ,DOUBLE. 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 +DECK,DDVM. *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 +SEQ,DOUBLE. +SEQ,CONST. *-----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 +DECK,DDVA. *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 +SEQ,DOUBLE. +SEQ,CONST. DDVA=(ALSBAR/PI)*(-2.8599*T+2.2432 1 -0.1911/T-0.0461/T**2) END +DECK,DDVR. *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 +SEQ,DOUBLE. +SEQ,CONST. DDVR=(ALSBAR/PI)*(-2.8599*T+0.2222*DLOG(T) 1-1.5129-0.4207/T-0.0775/T**2) END +DECK,G. *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) +SEQ,DOUBLE. +SEQ,CONST. * 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 +DECK,PHI. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. 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 *****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 END +DECK,PHItest. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,PHIA. *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 +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,AI. *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) +SEQ,DOUBLE. IF(T.GE.1)THEN AI=-9.25-3*DLOG(T)+0.26/T+0.04/T**2 ELSE AI=0. ENDIF END +DECK,GDB. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,GUB. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,GSB. *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) +SEQ,DOUBLE. +SEQ,CONST. GSB=GDB(T,H,ALSBAR) END +DECK,GCB. *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) +SEQ,DOUBLE. +SEQ,CONST. GCB=GUB(T,H,ALSBAR) END +DECK,GTB. *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) +SEQ,DOUBLE. +SEQ,CONST. GTB=0.D0 END +DECK,GT. *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) +SEQ,DOUBLE. +SEQ,CONST. GT=0.D0 END +DECK,GG. *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) +SEQ,DOUBLE. +SEQ,CONST. GG=0.D0 END +DECK,GGB. *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) +SEQ,DOUBLE. +SEQ,CONST. GGB=0.D0 END +DECK,DGAB. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. * 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 +DECK,DGVB. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. * 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 +DECK,GD. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,MASSES. 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 +DECK,GU. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,MASSES. 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 +DECK,GS. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,MASSES. 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 +DECK,GC. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,MASSES. 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 +DECK,GB. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,OPTIONS. 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 +DECK,GQQ. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. *-----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 +DECK,FF2. *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) +SEQ,DOUBLE. FF2=-37./12.+DLOG(X)+(7./81.)*X+0.0132*X**2 END +DECK,FF3. *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) +SEQ,DOUBLE. 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 +DECK,GBB. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,GH. *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) +SEQ,DOUBLE. +SEQ,CONST. *-----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 +DECK,GHB. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,GL. *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) +SEQ,DOUBLE. GL=GELE(T,H,ALSBAR) END +DECK,VA_GL. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,GLB. *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) +SEQ,DOUBLE. +SEQ,CONST. SBRA=1.-4*S2 BRA=1.+SBRA**2 GLB=GO* 1BRA*(1.+(3.*ALBAR)/(4.*PI)) END +DECK,GELE. *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) +SEQ,DOUBLE. +SEQ,MASSES. GELE=GLEPTON(T,H,ALSBAR,AMMU) END +DECK,GMUO. *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) +SEQ,DOUBLE. +SEQ,MASSES. GMUO=GLEPTON(T,H,ALSBAR,AMMU) END +DECK,GTAU. *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) +SEQ,DOUBLE. +SEQ,MASSES. GTAU=GLEPTON(T,H,ALSBAR,AMTAU) END +DECK,GNU. *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) +SEQ,DOUBLE. +SEQ,CONST. GNU=8*GO*(0.5+(3*ALBAR*VNU(T,H,ALSBAR))/(64*PI*S2*C2))**2 END +DECK,GNUB. *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) +SEQ,DOUBLE. +SEQ,CONST. GNUB=2*GO END +DECK,GZ. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,GZB. *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) +SEQ,DOUBLE. +SEQ,CONST. GZB=GHB(T,H,ALSBAR)+ 1 3*GLB(T,H,ALSBAR)+ 2 3*GNUB(T,H,ALSBAR) END +DECK,RL. *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) +SEQ,DOUBLE. RL=GH(T,H,ALSBAR)/GL(T,H,ALSBAR) END +DECK,RLB. *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) +SEQ,DOUBLE. RLB=GHB(T,H,ALSBAR)/GLB(T,H,ALSBAR) END +DECK,RB. *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) +SEQ,DOUBLE. RB=GB(T,H,ALSBAR)/GH(T,H,ALSBAR) END +DECK,RBB. *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) +SEQ,DOUBLE. RBB=GBB(T,H,ALSBAR)/GHB(T,H,ALSBAR) END +DECK,RC. *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) +SEQ,DOUBLE. RC=GC(T,H,ALSBAR)/GH(T,H,ALSBAR) END +DECK,SIGH. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,SIGHB. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,AFB. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,ALE. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,AF. *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. +SEQ,DOUBLE. +SEQ,CONST. *-----??????????? 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 +DECK,AFBBB. *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) +SEQ,DOUBLE. +SEQ,DEBUG. 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 +DECK,SIN2B. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,DEBUG. 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))/(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 +DECK,AFBBBP. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,DEBUG. 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))/(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 +DECK,AFBCC. *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) +SEQ,DOUBLE. +SEQ,CONST. DATA T3/+0.5/ DATA QF/0.66666666666666/ AFBCC=0.75*ALE(T,H,ALSBAR)*AF(T,H,ALSBAR,T3,QF) END +DECK,QFB. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,ALR. *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 +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,AMWMZ. *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) +SEQ,DOUBLE. +SEQ,CONST. C=DSQRT(C2) VMTHA=VM(T,H,ALSBAR) AMWMZ=C+(3*C*ALBAR*VMTHA)/(32*PI*S2*(C2-S2)) END +DECK,AMWMZNOB. *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 +SEQ,DOUBLE. +SEQ,CONST. C=DSQRT(C2) AMWMZNOB=C+(3*C*ALBAR*VM_NOB(T,H,ALSBAR))/(32*PI*S2*(C2-S2)) END +DECK,VM_MWMZ. *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 +SEQ,DOUBLE. +SEQ,CONST. C=DSQRT(C2) VM_MWMZ=((AMWMZ-C)/(3*C*ALBAR))*(32*PI*S2*(C2-S2)) END +DECK,AMWMZB. *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) +SEQ,DOUBLE. +SEQ,CONST. C=DSQRT(C2) AMWMZB=C END +DECK,S2NUN. *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) +SEQ,DOUBLE. +SEQ,CONST. C=DSQRT(C2) AMWMZ=C+(3*C*ALBAR*VM(T,H,ALSBAR))/(32*PI*S2*(C2-S2)) S2NUN=1.-AMWMZ**2 END +DECK,GAELE. *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) +SEQ,DOUBLE. +SEQ,CONST. DATA T3/-0.5/ DATA QF/1./ GA=T3*(1.+(3*ALBAR*VAL(T,H,ALSBAR))/(32*PI*S2*C2)) GAELE=GA END +DECK,GAELEB. *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) +SEQ,DOUBLE. +SEQ,CONST. GAELEB=-0.5 END +DECK,GVAELE. *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) +SEQ,DOUBLE. +SEQ,CONST. DATA T3/-0.5/ DATA QF/1./ GVAELE=1.-4*QF*S2+(3*ALBAR*QF*VRL(T,H,ALSBAR))/(4*PI*(C2-S2)) END +DECK,VR_GVGA. *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) +SEQ,DOUBLE. +SEQ,CONST. DATA T3/-0.5/ DATA QF/1./ VR_GVGA=((GVGA-1.+4*QF*S2)/(3*ALBAR*QF))*(4*PI*(C2-S2)) END +DECK,GVAELB. *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) +SEQ,DOUBLE. +SEQ,CONST. DATA T3/-0.5/ DATA QF/1./ GVAELB=1.-4*QF*S2 END +DECK,FP. *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. * +SEQ,DOUBLE. 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 +DECK,THEORY. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,THMSM. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,THBORN. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,LTINIT. *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) +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,CONST. +SEQ,SMITH. +SEQ,AVDEEV. +SEQ,VERLT. +SEQ,CONFER. +SEQ,OPTIONS. +SEQ,MTMHAL. +SEQ,MNCOM. 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) +SEQ,TTBAR. +SEQ,FOURTH. +SEQ,TMINDV. +SEQ,CAFBBB. +SEQ,MASSES. +SEQ,LEPFIT. +SEQ,LBTABL. *================================================================= * * 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 +SEQ,DATEQQ. +SEQ,TIMEQQ. +SEQ,VERSQQ. 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=.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') 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 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.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) 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 +DECK,TABLE. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,TTBAR. +SEQ,CAFBBB. +SEQ,CONFER. +SEQ,LEPFIT. +SEQ,LBTABL. 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 +DECK,TEQ. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CITAB. 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 +DECK,FTHEOR. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CITAB. T=(X/AMZ)**2 TH=THMSM(ITABLE,T,HCI,ALSBCI) FTHEOR=TH-VALUE END +DECK,AMHMT. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,Z1Z2. *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) +SEQ,DOUBLE. +SEQ,CONST,OPTIONS. 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 if(IOPTION(10).ne.0)Z1Z2=1. END +DECK,TPRIME. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. * 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 +DECK,ALPHAT. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,SMITH. * 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 +DECK,ALPHAMT. *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 +SEQ,DOUBLE. +SEQ,CONST. ALPHAMT=ALSBAR/(1.+(23./(12.*PI))*ALSBAR*DLOG(T)) END +DECK,ALPHATT. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,AVDEEV. * a la AVDEEV BY L.B. 25.09.94 ALSMT=ALPHAMT(T,ALSBAR) ALPHATT=ALSMT*(1.+AVDEEV*ALSMT) END +DECK,DYBTAB. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. +SEQ,DYBCOM. 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 +DECK,FTAB. *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 +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,LBOTAB. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,DEBUG. 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 +DECK,DERTAB. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,DEBUG. 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 +DECK,ETAB. *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 +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,SM4. *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) +SEQ,DOUBLE. +SEQ,FOURTH. DATA N/0/ N=N+1 AM4=CM4 * IF(N.EQ.1)WRITE(6,*)'SET AM4= ',AM4 END +DECK,GM4. *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) +SEQ,DOUBLE. +SEQ,FOURTH. GM4=AM4 END +DECK,LTSML4. *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) +SEQ,DOUBLE. +SEQ,FOURTH. DATA N/0/ N=N+1 AML4=CM4 * IF(N.EQ.1)WRITE(6,*)'SET AML4= ',AML4 END +DECK,GML4. *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) +SEQ,DOUBLE. +SEQ,FOURTH. GML4=AML4 END +DECK,LTSMQ4. *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) +SEQ,DOUBLE. +SEQ,FOURTH. DATA N/0/ N=N+1 AMQ4=CM4 * IF(N.EQ.1)WRITE(6,*)'SET AMQ4= ',AMQ4 END +DECK,LTSNQ4. *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) +SEQ,DOUBLE. +SEQ,FOURTH. DATA N/0/ N=N+1 NQ4=N4 * IF(N.EQ.1)WRITE(6,*)'SET NQ4= ',N4 END +DECK,LTSNL4. *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) +SEQ,DOUBLE. +SEQ,FOURTH. DATA N/0/ N=N+1 NL4=N4 * IF(N.EQ.1)WRITE(6,*)'SET NL4= ',N4 END +DECK,GMQ4. *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) +SEQ,DOUBLE. +SEQ,FOURTH. GMQ4=AMQ4 END +DECK,CA2CA1. *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) * +SEQ,DOUBLE. * * 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 +DECK,ltcomp. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE. +CDE,DYBCOM. 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 +DECK,dwaa. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE. +CDE,CONST. 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 +DECK,dtaa. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE. +CDE,CONST. 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 +DECK,DTTVM. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,TTBAR. gamma=PI*EPSIL/(2*AMZ) DTTVM=-GAMMA*DSQRT(T)*(1.+(-1.+16*S2/3.)/(4*T-1.)) END +DECK,DTTVA. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,TTBAR. gamma=PI*EPSIL/(2*AMZ) DTTVA=-GAMMA*DSQRT(T)*(1.+(1.-8*S2/3.)/(4*T-1.)**2) END +DECK,DTTVR. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,TTBAR. gamma=PI*EPSIL/(2*AMZ) DTTVR=-GAMMA*DSQRT(T)*(1.+(5./3.)/(4*T-1.)) END +DECK,d3vi. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE. 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 +DECK,d5vm. *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] * *----------------------------------------------------------------------* +CDE,DOUBLE,OPTIONS. +SEQ,CONST. C ----------- end CDE -------------------------------------------------- if(IOPTION(10).eq.0)then D5VM=(albar/(24*PI))*0.747*h/c2 else D5VM=0. endif END ! D5VM *---------------------------------------------------------------------- +DECK,D5VA. *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] * *----------------------------------------------------------------------* +CDE,DOUBLE,OPTIONS. +SEQ,CONST. 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 +DECK,D5VR. *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] * *----------------------------------------------------------------------* +CDE,DOUBLE,OPTIONS. +SEQ,CONST. 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 +DECK,GLEPTON. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,GAQ. *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) +SEQ,DOUBLE. +SEQ,CONST. * 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 +DECK,GVAQ. *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) +SEQ,DOUBLE. +SEQ,CONST. * 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 +DECK,RVQ. *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) +SEQ,DOUBLE. +SEQ,CONST. *-----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 +DECK,RAQ. *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) +SEQ,DOUBLE. +SEQ,CONST. *-----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 +DECK,VAB. *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) +SEQ,DOUBLE. VAB=VAD(T,H,ALSBAR)+DPHIA(T,H,ALSBAR) END +DECK,VRB. *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) +SEQ,DOUBLE. VRB=VRD(T,H,ALSBAR)+DPHIR(T,H,ALSBAR) END +DECK,DPHIA. *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) +SEQ,DOUBLE. +SEQ,CONST. DPHIA=-8*s2*c2*PHI(T,H,ALSBAR)/(3*(3.-2.*S2)) END +DECK,DPHIR. *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) +SEQ,DOUBLE. +SEQ,CONST. DPHIR=-4*s2*(c2-s2)*PHI(T,H,ALSBAR)/(3*(3.-2.*S2)) END +DECK,MIVTAB. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. +SEQ,CAFBBB. 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 +DECK,lttest. *CMZ : 22/09/98 17.22.39 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 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 +DECK,AMHMT_PR. *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 +DECK,TAU2_PR. *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 +DECK,LTPUT. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. +CDE,FOURTH. 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 ELSEIF(CHKEY(1:LK).EQ.'MQ4'.OR.CHKEY(1:LK).EQ.'mq4')THEN AMQ4=DBLE(VALUE) AM4=AML4 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 +DECK,LTGET. *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 *----------------------------------------------------------------------* +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. +CDE,MASSES. +CDE,CAFBBB. 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=1.-AMWMZ(T,H,ALSCOM)**2 ELSEIF(CHKEY(1:LK).EQ.'GNU')THEN VALUED=GNU(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.'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 +DECK,LTFLAG. *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 * *----------------------------------------------------------------------* * +CDE,DOUBLE. +CDE,DEBUG. +CDE,OPTIONS. +CDE,MNCOM. * 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 +DECK,LTMAIN. *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 * *====================================================================* +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,DEBUG. 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 +DECK,LTFPUT. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. 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 +DECK,LTFITT. *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) *------------------------------------------------------------------- +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,CONST. +SEQ,LEPFIT. 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 +DECK,LTFPUV. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,DEBUG. +CDE,LEPFIT. 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 +DECK,dble7. *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 * *----------------------------------------------------------------------* * +CDE, DOUBLE. 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 +DECK,LTFPUE. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,DEBUG. +CDE,LEPFIT. 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 +DECK,LTFCOR. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,DEBUG. +CDE,LEPFIT. 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 +DECK,LTFIND. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,DEBUG. +CDE,LEPFIT. 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 ELSE LTFIND=0 write(6,*)'+LTFIND: wrong key: ', 1 KEY(1:LK) ENDIF * * END ! LTFIND +DECK,LTCONF. *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) +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,CONFER. +SEQ,LEPFIT. 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. 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. 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 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.1479D0 ! new ELEP(8)=0.0051D0 ! new CHLEP(8)='ATAU' *-----AETAU VLEP(9)=0.1431D0 ! new ELEP(9)=0.0045D0 ! 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.083960D0 ELEP(16)=0.000180D0 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 DO 2 I=1,NLEP DO 2 J=I,NLEP RLEP(J,I)=RLEP(I,J) 2 CONTINUE 99 CONTINUE END ! LTCONF +DECK,LTFUSE. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,DEBUG. +CDE,LEPFIT. 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 +DECK,LTFGET. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,LEPFIT. +CDE,FITRES. 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 +DECK,LTFGEV. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,DEBUG. +CDE,LEPFIT. 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 +DECK,LTFGEE. *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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,DEBUG. +CDE,LEPFIT. 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 +DECK,LTFIT2. *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 *----------------------------------------------------------------------* +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. +CDE,LEPFIT. 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 +DECK,LTFTWO. *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) *------------------------------------------------------------------- +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,CONST. +SEQ,LEPFIT. +SEQ,MNCOM. +SEQ,FITRES. 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 +DECK,LTFIT1. *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 * *----------------------------------------------------------------------* +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. +CDE,LEPFIT. 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 +DECK,LTMOR95. *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 +DECK,LTFFIP. *CMZ : 27/09/98 15.57.47 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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,DEBUG. 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')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 +DECK,lterr. *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 *----------------------------------------------------------------------* +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. +CDE,MASSES. +CDE,CAFBBB. * * 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 +DECK,ltplot2. *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 *----------------------------------------------------------------------* +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. 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)*AMHSTP AMHS =AMH DO 202 IAMT=1,NAMT AMT=AMTMIN+(IAMT-1)*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)*AMHSTP AMHS =AMH DO 204 IAMT=1,NAMT AMT=AMTMIN+(IAMT-1)*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.'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 +DECK,ltplot1. *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 * *----------------------------------------------------------------------* +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. 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 +DECK,ltbei95. *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 +DECK,ltfit3. *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 *----------------------------------------------------------------------* +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. +CDE,LEPFIT. 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 +DECK,ltf3. *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) *------------------------------------------------------------------- +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,CONST. +SEQ,LEPFIT. +SEQ,MNCOM. +SEQ,FITRES. 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 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 +DECK,ltufn96. *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 +DECK,LTHROUT. *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 +DECK,ltplotvi. *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 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 +DECK,vmexp. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,vrexp. *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) +SEQ,DOUBLE. +SEQ,CONST. *-----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 +DECK,vaexp. *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) +SEQ,DOUBLE. +SEQ,CONST. 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 +DECK,alr_frs2. *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 +DECK,s2_fralr. *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 +DECK,ab. *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) +SEQ,DOUBLE. +SEQ,CONST. +SEQ,CAFBBB. +SEQ,DEBUG. 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))/(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 +DECK,lttab2. *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 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 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 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 +DECK,lttable1. *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 +DECK,lttable1_bac. *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 +DECK,ltellis96. *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 +DECK,ltvertex96. *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 +DECK,ltyad97. *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 +DECK,ltvys97. *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 +DECK,ltfit4. *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 *----------------------------------------------------------------------* +CDE,DOUBLE. +CDE,CONST. +CDE,DEBUG. +CDE,MTMHAL. +CDE,LEPFIT. 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) 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 NDF=NPLEP-4 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 +DECK,ltf4. *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) *------------------------------------------------------------------- +SEQ,DOUBLE. +SEQ,DEBUG. +SEQ,CONST. +SEQ,LEPFIT. +SEQ,MNCOM. +SEQ,FITRES. 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-1/ *-----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) 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) ARGLIS(1)=100. CALL MNEXCM(FCNLB,'MINOS',ARGLIS,0,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 +DECK,mnpint. *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 +DECK,ltwint97. *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 +DECK,ltward97. *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 +DECK,lttable2. *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 +DECK,lttable3. *CMZ : 17/09/98 07.30.20 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=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'/ 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 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) 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 +DECK,ltmori98. *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 +DECK,ltsusy. *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 * *----------------------------------------------------------------------* * +CDE,OPTIONS. dimension e3(3,3),e4(4,4),alogmhv(20),chi2v(20) double precision dsusylrva,dsusylrvr,dsusylrvm * * * 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 +DECK,LTSUSY_INIT. *CMZ : 27/09/98 15.20.35 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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,SUSY. C ----------- end CDE -------------------------------------------------- * * from point 3 in PR D 55 (1997) 5520. if(ist.eq.0)then AMHIGGS=379. ! mass of big H BETA=ATAN(2.) SUSYFL=1. YL=1./3. AMSB=278. AMST1=329. AMST2=264. AMSQ=AMSB AMGLUINO=298. endif END ! LTSUSY_INIT +DECK,gsusy. *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 : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * +CDE,DOUBLE. C ----------- end CDE -------------------------------------------------- * * AM12=AM1*AM1 AM22=AM2*AM2 GSUSY=AM12+AM22-(2*AM12*AM22/(AM12-AM22))*DLOG(AM12/AM22) END ! GSUSY +DECK,hsusy. *CMZ : 26/09/98 20.11.55 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 : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * +CDE,DOUBLE. C ----------- end CDE -------------------------------------------------- * * AM12=AM1*AM1 AM22=AM2*AM2 HSUSY=-5./3.+4*AM12*AM22/(AM12-AM22)**2+ 1(AM12+AM22)*(AM12**2-4*AM12*AM22+AM22**2)*DLOG(AM12/AM22) 2/(AM12-AM22)**3 END ! HSUSY +DECK,DSUSYLRVA. *CMZ : 27/09/98 15.57.48 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] * *----------------------------------------------------------------------* * +CDE,DOUBLE. +CDE,CONST. +CDE,SUSY. C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.D0)then CU2=DCOS(THETALR(T))**2 SU2=1-CU2 DSUSYLRVA=(cu2*gsusy(AMST1,AMSB)+su2*gsusy(AMST2,AMSB) 1 -cu2*su2*gsusy(AMST1,AMST2))/AMZ**2 else DSUSYLRVA=0. endif END ! DSUSYLRVA +DECK,DSUSYLRVR. *CMZ : 27/09/98 15.57.48 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 : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,SUSY. C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.)then CU2=DCOS(THETALR(T))**2 SU2=1.-CU2 DSUSYLRVR=DSUSYLRVA(T,H,ALSBAR)+(YL/3.)* 1 (cu2*dlog(AMST1/AMSB)+su2*dlog(AMST2/AMSB)) 2 -cu2*su2*hsusy(AMST1,AMST2)/3 else DSUSYLRVR=0. endif END ! DSUSYLRVR +DECK,DSUSYLRVM. *CMZ : 27/09/98 15.57.48 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 : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,SUSY. C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.)then CU2=COS(THETALR(T))**2 SU2=1.-CU2 DSUSYLRVM=DSUSYLRVA(T,H,ALSBAR)+(2*YL*s2/3.)* 1 (cu2*dlog(AMST1/AMSB)+su2*dlog(AMST2/AMSB)) 2 +(cu2-su2)*(cu2*hsusy(AMST1,AMSB)+SU2*hsusy(AMST2,AMSB))/3 3 -cu2*su2*hsusy(AMST1,AMST2)/3 else DSUSYLRVM=0. endif END ! DSUSYLRVM +DECK,DSUSYRV. *CMZ : 25/09/98 19.27.32 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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,SUSY. 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 +DECK,DELTA. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,DELTAC. 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 +DECK,ltsusyput. *CMZ : 27/09/98 15.21.25 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 : * * Date : 27/09/98 * * * * Keywords : * * LTINIT, LTPUT, LTFLAG * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,CONST,DEBUG. +CDE,SUSY. 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.'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.'MHIGGS')THEN AMHIGGS=DBLE(VALUE) ! mass of big H ELSEIF(CHKEY(1:LK).EQ.'BETA')THEN BETA=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 +DECK,DSUSYRA. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,SUSY,DELTAC. EXTERNAL DELTA C ----------- end CDE -------------------------------------------------- * * if(SUSYFL.NE.0.)then DSUSYRA=DSUSYRV(T,H,ALSBAR) else DSUSYRA=0. endif END ! DSUSYRA +DECK,ddgvr. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,OPTIONS. 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 +DECK,ddgvm. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,OPTIONS. * 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 +DECK,delta1. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,DELTAC. C ----------- end CDE -------------------------------------------------- * DELTA1=-(4./3.)*( z1-1+(1-z1-1/(x*z1))*DLOG(1-x*z1*(1-z1)) ) END ! DELTA1 +DECK,d4vi. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. * 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 +DECK,d4pvm. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. 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 +DECK,d4pva. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. if(IOPTION(10).eq.0)then D4PVA=(9./4.)*ALBAR*T**2/(PI*16*S2*C2) else D4PVA=0. endif END +DECK,d4pvr. *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 +SEQ,DOUBLE. +SEQ,CONST. +SEQ,OPTIONS. if(IOPTION(10).eq.0)then D4PVR=-(3*c2*s2/((c2-s2)**2))*ALBAR*T**2/(PI*16*S2*C2) else D4PVR=0. endif END +DECK,ltobzor. *CMZ : 17/09/98 07.37.27 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 Vancouver-98 conference * * for review in PR * * * *----------------------------------------------------------------------* * * * Author : A.Rozanov Date : 05/09/98 * * * * * * Last modifications : 08/09/98 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * +CDE,OPTIONS. dimension e3(3,3),e4(4,4),alogmhv(20),chi2v(20) 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('VANCOUVER98','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 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,4 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 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') 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) 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) 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,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,' +- ',f7.3,f7.3) write(6,*)'+LTOBZOR98: 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=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 write(6,*)'No als, yes albar for MH upper limit' 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 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' * 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(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' * 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(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,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' *========================================================================== 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 END ! LTOBZOR +DECK,lttable6. *CMZ : 17/09/98 07.34.48 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 garg 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 +DECK,lttable66. *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 +DECK,ltsusy2. *CMZ : 27/09/98 17.45.37 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 : 22/09/98 * * * * Keywords : * * LTINIT, LTGET, LTPUT, LTFLAG * *----------------------------------------------------------------------* * +CDE,OPTIONS. dimension e4(4,4) double precision dsusylrva,dsusylrvr,dsusylrvm,t,h,aals double precision dsusyrv,dsusyrv_old * * * initialisation CALL LTINIT(0) CALL LTFPUT('VANCOUVER98','ALL',DUMMY) * call hlimit(100000) 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) 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) 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 * 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') call ltsusy_init(0) write(6,*)'SUSY point number 3' amsb=150. call ltsusyput('MSB',amsb) amgluino=amsb call ltsusyput('MGLUINO',amgluino) beta=atan(2.) call ltsusyput('BETA',beta) write(6,*)'Four parameter fit ===========================' do ifit=1,3 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') CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar' write(6,*)'ifit=',ifit call LTSUSYGET('MLL',AMLL) if(ifit.eq.1)then AM1=sqrt(AMLL**2+10.**2) AM2=amsb elseif(ifit.eq.2)then AM2=sqrt(AMLL**2-10.**2) AM1=sqrt(AMLL**2-amsb**2+AM2**2) elseif(ifit.eq.3)then AM1=sqrt((3*AMLL**2-amsb**2)/2.) AM2=sqrt((AMLL**2+amsb**2)/2.) endif call LTSUSYPUT('MST1',AM1) call LTSUSYPUT('MST2',AM2) call ltsusyget('THETALR',thetalr) write(6,*)'Stop masses mst1,mst2=',AM1,AM2 write(6,*)'mLL,ThetaLR=',AMLL,THETALR 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 * 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 * make 3-par fits for mH=120 GeV go to 999 CALL LTFUSE('NOUSE','ALS') CALL LTFUSE('USE','ALB-1') write(6,*)'No als, yes albar for MH upper limit' alogmhbest=120. alogmh=alogmhbest 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,*)'amh,chi2,ndf=',amh,chi2,ndf write(6,10040)amt,emtpos,emtneg,eamt,sqrt(e4(1,1)),glbemt, 2 als,eals,sqrt(e4(2,2)), 2 albfitinv1,ealbfitinv1,ealbfitinv4 10040 format('+LTSUSY2: mt= ',f6.1,' + ',f6.1,' ',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) enddo ! ifit 999 continue *========================================================================== END ! LTSUSY2 +DECK,dsusyrv_old. *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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,SUSY,DELTAC. 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 +DECK,delta11. *CMZ : 22/09/98 19.24.17 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] * *----------------------------------------------------------------------* * +CDE,DOUBLE. 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=finter END ! DELTA11 +DECK,ltsusyget. *CMZ : 27/09/98 16.37.57 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 * *----------------------------------------------------------------------* * * +CDE,DOUBLE. +CDE,CONST,DEBUG. +CDE,SUSY,MTMHAL. 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(AMST1) ELSEIF(CHKEY(1:LK).EQ.'MST2')THEN VALUE=SNGL(AMST2) 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 VALUE=SNGL(THETALR(T)) 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 +DECK,thetalr. *CMZ : 27/09/98 16.22.49 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 : * * [name] Date : [date] * * * * Keywords : * * [keywords] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,SUSY. C ----------- end CDE -------------------------------------------------- * AMZ2=AMZ**2 AMTOP2=T*AMZ2 AMLL2=AMSB**2+AMTOP2+AMZ2*DCOS(2*BETA)*(1.-s2) * AMLL=DSQRT(AMLL2) DISCR=AMLL2*(AMST1**2+AMST2**2-AMLL2)-AMST1**2*AMST2**2 if(DISCR.LE.0.)then write(6,*)'+THETALR:AMSB,AMTOP2,AMZ,BETA,S2,', 1 'AMST1,AMST2,AMLL2', 2 AMSB,AMTOP2,AMZ,BETA,S2,AMST1,AMST2,AMLL2 DISCR=0.0000001 endif TGTHETALR=(AMST1**2-AMLL2)/dsqrt(DISCR) THETALR=DATAN(TGTHETALR) END ! THETALR +DECK,amll. *CMZ : 27/09/98 15.54.39 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] * *----------------------------------------------------------------------* * +CDE,DOUBLE,CONST,SUSY. C ----------- end CDE -------------------------------------------------- * AMZ2=AMZ**2 AMTOP2=T*AMZ2 AMLL2=AMSB**2+AMTOP2+AMZ2*DCOS(2*BETA)*(1.-s2) AMLL=DSQRT(AMLL2) END ! AMLL +PATCH,DCDES. *CMZ : 2.00/00 25/06/97 09.22.36 by A.Rozanov +KEEP,DELTAC. *CMZ : 2.00/02 03/07/98 18.24.49 by A.Rozanov *-- Author : A.Rozanov 03/07/98 COMMON/DELTAC/X,Y +KEEP,susy. *CMZ : 27/09/98 15.17.38 by A.Rozanov *CMZ : 2.00/02 04/07/98 21.17.58 by A.Rozanov *CMZ : 1.30/01 16/01/95 10.55.49 by A.Rozanov *-- Author : A.Rozanov COMMON/SUSY/SUSYFL,YL,AMST1,AMST2,AMSB,AMSQ,AMGLUINO, 1 AMHIGGS,BETA +KEEP,FITRES. *CMZ : 2.00/01 26/06/97 13.23.37 by A.Rozanov *CMZ : 2.00/01 08/03/95 10.50.38 by A.Rozanov *-- Author : A.Rozanov 08/03/95 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) +KEEP,mncom. *CMZ : 2.00/01 09/03/95 11.04.42 by A.Rozanov *-- Author : A.Rozanov 07/03/95 COMMON/MNCOM/MNPRNT,MNREAD,MNUNIT,MNSAVE,EPSMN +KEEP,MTMHAL. *CMZ : 1.30/07 02/02/95 09.38.09 by A.Rozanov *-- Author : A.Rozanov 02/02/95 COMMON/MTMHAL/AMTCOM,AMHCOM,ALSCOM +KEEP,VERLT. *CMZ : 1.30/01 16/01/95 16.19.51 by A.Rozanov *-- Author : COMMON/VERLT/VERSION +KEEP,CONFER. *CMZ : 2.00/03 08/09/98 22.10.39 by A.Rozanov *CMZ : 2.00/01 17/03/98 22.26.45 by A.Rozanov *CMZ : 2.00/00 16/04/97 17.41.55 by A.Rozanov *CMZ : 2.00/03 26/10/95 12.13.01 by A.Rozanov *CMZ : 2.00/02 09/03/95 21.13.23 by A.Rozanov *CMZ : 1.30/01 16/01/95 16.19.51 by A.Rozanov *-- Author : LOGICAL MARSEILLE,MORIOND94,GLASGOW,MORIOND95,BEIJING95, 1 MORIOND96,MORIOND97,MORIALL97,JERUSALEM97,MORIOND98, 2 VANCOUVER98 COMMON/CONFER/MARSEILLE,MORIOND94,GLASGOW,MORIOND95,BEIJING95, 1 MORIOND96,MORIOND97,MORIALL97,JERUSALEM97,MORIOND98, 2 VANCOUVER98 +KEEP,CITAB. *CMZ : 1.30/01 16/01/95 16.19.51 by A.Rozanov *-- Author : COMMON/CITAB/ITABLE,II,VALUE,TCI,HCI,ALSBCI +KEEP,AVDEEV. *CMZ : 1.30/01 16/01/95 16.21.29 by A.Rozanov *-- Author : COMMON/AVDEEV/AVDEEV +KEEP,FOURTH. *CMZ : 1.30/01 16/01/95 10.55.49 by A.Rozanov *-- Author : COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4 +KEEP,TMINDV. *CMZ : 1.30/01 16/01/95 10.55.49 by A.Rozanov *-- Author : COMMON/TMINDV/TMIN,DELTVM,DELTVA,DELTVR +KEEP,MASSES. *CMZ : 1.30/01 16/01/95 10.55.49 by A.Rozanov *-- Author : COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT +KEEP,LEPFIT. *CMZ : 2.00/02 03/07/98 18.42.13 by A.Rozanov *CMZ : 2.00/01 27/06/97 11.59.25 by A.Rozanov *CMZ : 2.00/00 28/01/96 15.04.55 by A.Rozanov *CMZ : 1.30/01 16/01/95 10.55.49 by A.Rozanov *-- Author : PARAMETER (NL=22) CHARACTER*10 CHLEP COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,NPLEP,CHLEP(NL) +KEEP,LBTABL. *CMZ : 1.30/01 16/01/95 17.46.58 by A.Rozanov *-- Author : 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. *CMZ : 2.00/02 05/07/98 19.30.46 by A.Rozanov *CMZ : 1.30/07 19/02/95 23.08.36 by A.Rozanov *CMZ : 1.30/01 16/01/95 10.55.49 by A.Rozanov *-- Author : A.Rozanov PARAMETER (NOPTIONS=20) COMMON/OPTIONS/IOPTION(NOPTIONS) +KEEP,CHETYR. *CMZ : 1.30/01 16/01/95 10.55.49 by A.Rozanov *-- Author : COMMON/CHETYR/BETA0,BETA1,BETA2,GAMMA0,GAMMA1,GAMMA2,AKBOT,FERMI +KEEP,PAWC. *CMZ : 1.30/01 16/01/95 17.40.42 by A.Rozanov 15/01/95 23.13.46 by A.Rozanov *-- Author : REAL*4 PAW COMMON/PAWC/PAW(100000) +KEEP,TTBAR. *CMZ : 1.30/01 16/01/95 10.55.49 by A.Rozanov *-- Author : COMMON/TTBAR/EPSIL +KEEP,SMITH. *CMZ : 1.30/01 15/01/95 22.09.24 by A.Rozanov *-- Author : COMMON/SMITH/VOLOSHIN +KEEP,ZVALUE. *CMZ : 1.30/01 15/01/95 22.00.03 by A.Rozanov *-- Author : COMMON/ZVALUE/ZZVM,ZZVA,ZZVR,ZZMH,ZZALSB +KEEP,DOUBLE. *CMZ : 1.30/01 12/01/95 17.47.54 by A.Rozanov *-- Author : IMPLICIT DOUBLE PRECISION (A-H,O-Z) +KEEP,CONST. *CMZ : 1.30/01 12/01/95 17.47.54 by A.Rozanov *-- Author : COMMON/CONST/AMZ,DAMZ,GMU,AL,ALBAR,C2,S2,TONB,PI,F2,GO,AMU2 +KEEP,CAFBBB. *CMZ : 1.30/01 12/01/95 17.47.54 by A.Rozanov *-- Author : COMMON/CAFBBB/EB,AMB,AMB0,VELOB +KEEP,DEBUG. *CMZ : 1.30/01 15/01/95 22.00.03 by A.Rozanov *-- Author : COMMON/DEBUG/PRTFLG(10) +KEEP,DYBCOM. *CMZ : 2.00/02 03/07/98 19.02.06 by A.Rozanov *CMZ : 1.30/07 03/02/95 11.48.30 by A.Rozanov *CMZ : 1.30/01 12/01/95 17.47.54 by A.Rozanov *-- Author : 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) +PATCH,//LEPTOP/DCDES +PATCH,DCDES. *CMZ : 12/01/95 11.36.38 by A.Rozanov +KEEP,VERLT. *CMZ : 16/01/95 16.19.51 by A.Rozanov *-- Author : COMMON/VERLT/VERSION +KEEP,CONFER. *CMZ : 16/01/95 16.19.51 by A.Rozanov *-- Author : LOGICAL MARSEILLE,MORIOND94,GLASGOW COMMON/CONFER/MARSEILLE,MORIOND94,GLASGOW +KEEP,CITAB. *CMZ : 16/01/95 16.19.51 by A.Rozanov *-- Author : COMMON/CITAB/ITABLE,II,VALUE,TCI,HCI,ALSBCI +KEEP,AVDEEV. *CMZ : 16/01/95 16.21.29 by A.Rozanov *-- Author : COMMON/AVDEEV/AVDEEV +KEEP,FOURTH. *CMZ : 16/01/95 10.55.49 by A.Rozanov *-- Author : COMMON/FOURTH/AM4,AML4,AMQ4,NL4,NQ4 +KEEP,TMINDV. *CMZ : 16/01/95 10.55.49 by A.Rozanov *-- Author : COMMON/TMINDV/TMIN,DELTVM,DELTVA,DELTVR +KEEP,MASSES. *CMZ : 16/01/95 10.55.49 by A.Rozanov *-- Author : COMMON/MASSES/AMEL,AMMU,AMTAU,AMUP,AMDOWN,AMCHRM,AMSTRN,AMTOP, 1 AMBOTT +KEEP,LEPFIT. *CMZ : 16/01/95 10.55.49 by A.Rozanov *-- Author : PARAMETER (NL=17) CHARACTER*10 CHLEP,CHALB COMMON/LEPFIT/VLEP(NL),ELEP(NL),RLEP(NL,NL),WLEP(NL,NL), 1FLEP(NL),NLEP,CHLEP(NL) +KEEP,LBTABL. *CMZ : 16/01/95 10.55.49 by A.Rozanov *-- Author : 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) +PATCH,$VERSION. *CMZ : 2.00/00 25/06/97 09.27.09 by A.Rozanov +DECK,V2_00. *CMZ : 2.00/03 08/09/98 23.49.32 by A.Rozanov *CMZ : 2.00/02 03/09/98 12.20.48 by A.Rozanov *CMZ : 2.00/01 19/03/98 20.03.12 by A.Rozanov *CMZ : 2.00/00 25/06/97 09.27.09 by A.Rozanov *-- Author : A.Rozanov 25/06/97 *________________________________________________________________________ * *::> VERSION 2.00/03 08/09/98 23.49.32 1. Reclassify Czarnecki-Kuhn-Harlander corrections as one-loop in IOPTION(10) 2. Correct bug of Degrassi correction in VM (MIV E-mail 8.09.98) 3. Introduce experimental data from Vancouver-98 Conference from talk of Dean Karlen 4. In LTOBZOR calculate two-sigma errors on MH and logMH * *________________________________________________________________________ * *::> VERSION 2.00/02 03/09/98 12.20.48 1. Introduce terms delta4primeVi propotional to alphabar**2*t**2 according to MIV fax of 07.08.98 2. Introduce Czarnecki-Kuhn-Harlander corrections to Z boson width according to MIV E-mail of 10.08.98 3. Some simplified Degrassification was made with MIV in July 1998 4. SUSY options introduced with MIV in July 1998. Examples in the LTSUSY. * *________________________________________________________________________ * *::> VERSION 2.00/01 19/03/98 20.03.12 Moriond-98 data introduced. * *________________________________________________________________________ * *::> VERSION 2.00/00 25/06/97 09.27.09 * New CMZ file to clean the unmanagable old one. * The old file is leptop_old.cmz now