C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = PROGRAM COMBINE C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = C C COMBINE THE EXCLUSIVE B HADRON LIFETIME MEASUREMENTS FROM THE FOUR LEP C EXPERIMENTS INTO EXPERIMENTAL AVERAGES AND A LEP AVERAGE. ALSO, INPUT C THE AVERAGE B0 LIFETIME FOR EACH EXPERIMENT IN ORDER TO CALCULATE THE C LIFETIME RATIO WITH RESPECT TO THE B0 LIFETIME. C C Compiling on HPUX: C fort77 +ppu -o newcombine.run combine.f -L/cern/pro/lib -lmathlib -lkernlib C C AUTHOR:- C ======== C TIM HESSING, CERN-PPE/LEP-DELPHI C C DATE/HISTORY:- C ============== C 27-APRIL-1994: CREATED-TLH C IMPLICIT NONE C C DECLARATIONS:- C ============== INTEGER ILUN, ISTAT CHARACTER*80 LINE CHARACTER*132 FILENAME C C COMMON VARIABLES C C IFRAC EQ 1 IMPLIES USE FRACTIONAL ERRORS C IFRAC NE 2 IMPLIES USE ABSOLUTE ERRORS C INTEGER IFRAC PARAMETER (IFRAC = 1) C C MAXIMUM NUMBER OF MEASUREMENTS TO COMBINE C INTEGER MXMEAS PARAMETER (MXMEAS = 25) C C MAXIMUM NUMBER OF SYSTEMATICS FOR EACH MEASUREMENT C INTEGER MXSYST PARAMETER (MXSYST = 50) C C IMPORTANT NUMBERS C INTEGER NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC INTEGER PTRA(MXMEAS), PTRD(MXMEAS) INTEGER PTRL(MXMEAS), PTRO(MXMEAS) REAL*4 TAUB(MXMEAS) REAL*4 USTA(MXMEAS), LSTA(MXMEAS) REAL*4 USYS(MXMEAS,MXSYST), LSYS(MXMEAS,MXSYST) REAL*4 CORR(MXMEAS,MXMEAS), COVA(MXMEAS,MXMEAS) REAL*4 TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB REAL*4 RATIO(MXMEAS), EUCOR(MXMEAS), RTIME(MXMEAS) LOGICAL LB0, LBP, LBS, LLB, LAV, LRT COMMON/TAUAVG/ NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC, & PTRA, PTRD, & PTRL, PTRO, & TAUB, & USTA, LSTA, & USYS, LSYS, & CORR, COVA, & TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB, & RATIO, EUCOR, RTIME, & LB0, LBP, LBS, LLB, LAV, LRT C C KEEP TRACK OF AVERAGES C REAL*4 LEPB0, ELEPB0, PLEPB0, ALPB0, EALPB0, PALPB0 REAL*4 DELB0, EDELB0, PDELB0, L3B0, EL3B0, PL3B0 REAL*4 OPAB0, EOPAB0, POPAB0 REAL*4 LEPBP, ELEPBP, PLEPBP, ALPBP, EALPBP, PALPBP REAL*4 DELBP, EDELBP, PDELBP, L3BP, EL3BP, PL3BP REAL*4 OPABP, EOPABP, POPABP REAL*4 LEPRP, ELEPRP, PLEPRP, ALPRP, EALPRP, PALPRP REAL*4 DELRP, EDELRP, PDELRP, L3RP, EL3RP, PL3RP REAL*4 OPARP, EOPARP, POPARP REAL*4 LEPBS, ELEPBS, PLEPBS, ALPBS, EALPBS, PALPBS REAL*4 DELBS, EDELBS, PDELBS, L3BS, EL3BS, PL3BS REAL*4 OPABS, EOPABS, POPABS REAL*4 LEPRS, ELEPRS, PLEPRS, ALPRS, EALPRS, PALPRS REAL*4 DELRS, EDELRS, PDELRS, L3RS, EL3RS, PL3RS REAL*4 OPARS, EOPARS, POPARS REAL*4 LEPLB, ELEPLB, PLEPLB, ALPLB, EALPLB, PALPLB REAL*4 DELLB, EDELLB, PDELLB, L3LB, EL3LB, PL3LB REAL*4 OPALB, EOPALB, POPALB REAL*4 LEPRL, ELEPRL, PLEPRL, ALPRL, EALPRL, PALPRL REAL*4 DELRL, EDELRL, PDELRL, L3RL, EL3RL, PL3RL REAL*4 OPARL, EOPARL, POPARL REAL*4 LEPAV, ELEPAV, PLEPAV, ALPAV, EALPAV, PALPAV REAL*4 DELAV, EDELAV, PDELAV, L3AV, EL3AV, PL3AV REAL*4 OPAAV, EOPAAV, POPAAV REAL*4 LEPRT, ELEPRT, PLEPRT, ALPRT, EALPRT, PALPRT REAL*4 DELRT, EDELRT, PDELRT, L3RT, EL3RT, PL3RT REAL*4 OPART, EOPART, POPART COMMON/LEPAVG/ & LEPB0, ELEPB0, PLEPB0, ALPB0, EALPB0, PALPB0, & DELB0, EDELB0, PDELB0, L3B0, EL3B0, PL3B0, & OPAB0, EOPAB0, POPAB0, & LEPBP, ELEPBP, PLEPBP, ALPBP, EALPBP, PALPBP, & DELBP, EDELBP, PDELBP, L3BP, EL3BP, PL3BP, & OPABP, EOPABP, POPABP, & LEPRP, ELEPRP, PLEPRP, ALPRP, EALPRP, PALPRP, & DELRP, EDELRP, PDELRP, L3RP, EL3RP, PL3RP, & OPARP, EOPARP, POPARP, & LEPBS, ELEPBS, PLEPBS, ALPBS, EALPBS, PALPBS, & DELBS, EDELBS, PDELBS, L3BS, EL3BS, PL3BS, & OPABS, EOPABS, POPABS, & LEPRS, ELEPRS, PLEPRS, ALPRS, EALPRS, PALPRS, & DELRS, EDELRS, PDELRS, L3RS, EL3RS, PL3RS, & OPARS, EOPARS, POPARS, & LEPLB, ELEPLB, PLEPLB, ALPLB, EALPLB, PALPLB, & DELLB, EDELLB, PDELLB, L3LB, EL3LB, PL3LB, & OPALB, EOPALB, POPALB, & LEPRL, ELEPRL, PLEPRL, ALPRL, EALPRL, PALPRL, & DELRL, EDELRL, PDELRL, L3RL, EL3RL, PL3RL, & OPARL, EOPARL, POPARL, & LEPAV, ELEPAV, PLEPAV, ALPAV, EALPAV, PALPAV, & DELAV, EDELAV, PDELAV, L3AV, EL3AV, PL3AV, & OPAAV, EOPAAV, POPAAV, & LEPRT, ELEPRT, PLEPRT, ALPRT, EALPRT, PALPRT, & DELRT, EDELRT, PDELRT, L3RT, EL3RT, PL3RT, & OPART, EOPART, POPART LOGICAL DEBUG COMMON /MYDEBUG/ DEBUG INTEGER LENOCC EXTERNAL LENOCC C ------------------------------------------------------------------ DEBUG = .FALSE. C C FORMAT STATEMENTS:- C =================== 10 FORMAT(' ENTER INPUT DATA FILE NAME: ') 20 FORMAT(A) 30 FORMAT(A80) 40 FORMAT(/,' >>> END-OF-FILE. This was the version with Dales ' + ,'error checking features. ',/) 50 FORMAT(' >>> ERROR-DURING-PARSE ') C C EXECUTABLE CODE:- C ================= ILUN = 10 C C READ INPUT DATA TO BE USED FOR AVERAGING C WRITE(6,10) READ (5,20) FILENAME C C OPEN FILE C OPEN(UNIT=ILUN,FILE=FILENAME,FORM='FORMATTED',STATUS='OLD') C C ZERO B LIFETIMES C LEPB0 = 0.0 ALPB0 = 0.0 DELB0 = 0.0 L3B0 = 0.0 OPAB0 = 0.0 LEPBP = 0.0 ALPBP = 0.0 DELBP = 0.0 L3BP = 0.0 OPABP = 0.0 LEPBS = 0.0 ALPBS = 0.0 DELBS = 0.0 L3BS = 0.0 OPABS = 0.0 LEPLB = 0.0 ALPLB = 0.0 DELLB = 0.0 L3LB = 0.0 OPALB = 0.0 LEPRP = 0.0 ALPRP = 0.0 DELRP = 0.0 L3RP = 0.0 OPARP = 0.0 LEPRS = 0.0 ALPRS = 0.0 DELRS = 0.0 L3RS = 0.0 OPARS = 0.0 LEPRL = 0.0 ALPRL = 0.0 DELRL = 0.0 L3RL = 0.0 OPARL = 0.0 LEPAV = 0.0 ALPAV = 0.0 DELAV = 0.0 L3AV = 0.0 OPAAV = 0.0 LEPRT = 0.0 ALPRT = 0.0 DELRT = 0.0 L3RT = 0.0 OPART = 0.0 C C LOOP OVER FILE AND READ DATA C 100 READ(ILUN,30,END=200,ERR=900) LINE C C Skip blanks lines. C IF (LENOCC(LINE).EQ.0 .OR. LINE.EQ.' ') THEN GOTO 100 ENDIF C C PARSE LINE C CALL PARSEIT(ILUN,LINE,ISTAT) IF (ISTAT .LT. 0) GOTO 100 IF (ISTAT .GT. 0) GOTO 800 200 WRITE(6,40) CLOSE(10) GOTO 900 800 WRITE(6,50) 900 STOP END C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE PARSEIT(ILUN,LINE,ISTAT) C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = C C PARSE INPUT LINE AND EXECUTE COMMAND C C ISTAT < 0 GET NEXT LINE C ISTAT > 0 ERROR C ISTAT = 0 END OF FILE C C AUTHOR:- C ======== C TIM HESSING, CERN-PPE/LEP-DELPHI C C DATE/HISTORY:- C ============== C 27-APRIL-1994: CREATED-TLH C IMPLICIT NONE C C DECLARATIONS:- C ============== INTEGER ILUN, ISTAT, I, J REAL*4 ERTAU, ERRAT, AVG, ERR CHARACTER*80 LINE C C COMMON VARIABLES C C IFRAC EQ 1 IMPLIES USE FRACTIONAL ERRORS C IFRAC NE 2 IMPLIES USE ABSOLUTE ERRORS C INTEGER IFRAC PARAMETER (IFRAC = 1) C C MAXIMUM NUMBER OF MEASUREMENTS TO COMBINE C INTEGER MXMEAS PARAMETER (MXMEAS = 25) C C MAXIMUM NUMBER OF SYSTEMATICS FOR EACH MEASUREMENT C INTEGER MXSYST PARAMETER (MXSYST = 50) C C IMPORTANT NUMBERS C CHARACTER*1 EXPT(MXMEAS) SAVE EXPT ! this was missing. sloppy. -- DALE INTEGER NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC INTEGER PTRA(MXMEAS), PTRD(MXMEAS) INTEGER PTRL(MXMEAS), PTRO(MXMEAS) REAL*4 TAUB(MXMEAS) REAL*4 USTA(MXMEAS), LSTA(MXMEAS) REAL*4 USYS(MXMEAS,MXSYST), LSYS(MXMEAS,MXSYST) REAL*4 CORR(MXMEAS,MXMEAS), COVA(MXMEAS,MXMEAS) REAL*4 TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB REAL*4 RATIO(MXMEAS), EUCOR(MXMEAS), RTIME(MXMEAS) LOGICAL LB0, LBP, LBS, LLB, LAV, LRT COMMON/TAUAVG/ NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC, & PTRA, PTRD, & PTRL, PTRO, & TAUB, & USTA, LSTA, & USYS, LSYS, & CORR, COVA, & TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB, & RATIO, EUCOR, RTIME, & LB0, LBP, LBS, LLB, LAV, LRT C C KEEP TRACK OF AVERAGES C REAL*4 LEPB0, ELEPB0, PLEPB0, ALPB0, EALPB0, PALPB0 REAL*4 DELB0, EDELB0, PDELB0, L3B0, EL3B0, PL3B0 REAL*4 OPAB0, EOPAB0, POPAB0 REAL*4 LEPBP, ELEPBP, PLEPBP, ALPBP, EALPBP, PALPBP REAL*4 DELBP, EDELBP, PDELBP, L3BP, EL3BP, PL3BP REAL*4 OPABP, EOPABP, POPABP REAL*4 LEPRP, ELEPRP, PLEPRP, ALPRP, EALPRP, PALPRP REAL*4 DELRP, EDELRP, PDELRP, L3RP, EL3RP, PL3RP REAL*4 OPARP, EOPARP, POPARP REAL*4 LEPBS, ELEPBS, PLEPBS, ALPBS, EALPBS, PALPBS REAL*4 DELBS, EDELBS, PDELBS, L3BS, EL3BS, PL3BS REAL*4 OPABS, EOPABS, POPABS REAL*4 LEPRS, ELEPRS, PLEPRS, ALPRS, EALPRS, PALPRS REAL*4 DELRS, EDELRS, PDELRS, L3RS, EL3RS, PL3RS REAL*4 OPARS, EOPARS, POPARS REAL*4 LEPLB, ELEPLB, PLEPLB, ALPLB, EALPLB, PALPLB REAL*4 DELLB, EDELLB, PDELLB, L3LB, EL3LB, PL3LB REAL*4 OPALB, EOPALB, POPALB REAL*4 LEPRL, ELEPRL, PLEPRL, ALPRL, EALPRL, PALPRL REAL*4 DELRL, EDELRL, PDELRL, L3RL, EL3RL, PL3RL REAL*4 OPARL, EOPARL, POPARL REAL*4 LEPAV, ELEPAV, PLEPAV, ALPAV, EALPAV, PALPAV REAL*4 DELAV, EDELAV, PDELAV, L3AV, EL3AV, PL3AV REAL*4 OPAAV, EOPAAV, POPAAV REAL*4 LEPRT, ELEPRT, PLEPRT, ALPRT, EALPRT, PALPRT REAL*4 DELRT, EDELRT, PDELRT, L3RT, EL3RT, PL3RT REAL*4 OPART, EOPART, POPART COMMON/LEPAVG/ & LEPB0, ELEPB0, PLEPB0, ALPB0, EALPB0, PALPB0, & DELB0, EDELB0, PDELB0, L3B0, EL3B0, PL3B0, & OPAB0, EOPAB0, POPAB0, & LEPBP, ELEPBP, PLEPBP, ALPBP, EALPBP, PALPBP, & DELBP, EDELBP, PDELBP, L3BP, EL3BP, PL3BP, & OPABP, EOPABP, POPABP, & LEPRP, ELEPRP, PLEPRP, ALPRP, EALPRP, PALPRP, & DELRP, EDELRP, PDELRP, L3RP, EL3RP, PL3RP, & OPARP, EOPARP, POPARP, & LEPBS, ELEPBS, PLEPBS, ALPBS, EALPBS, PALPBS, & DELBS, EDELBS, PDELBS, L3BS, EL3BS, PL3BS, & OPABS, EOPABS, POPABS, & LEPRS, ELEPRS, PLEPRS, ALPRS, EALPRS, PALPRS, & DELRS, EDELRS, PDELRS, L3RS, EL3RS, PL3RS, & OPARS, EOPARS, POPARS, & LEPLB, ELEPLB, PLEPLB, ALPLB, EALPLB, PALPLB, & DELLB, EDELLB, PDELLB, L3LB, EL3LB, PL3LB, & OPALB, EOPALB, POPALB, & LEPRL, ELEPRL, PLEPRL, ALPRL, EALPRL, PALPRL, & DELRL, EDELRL, PDELRL, L3RL, EL3RL, PL3RL, & OPARL, EOPARL, POPARL, & LEPAV, ELEPAV, PLEPAV, ALPAV, EALPAV, PALPAV, & DELAV, EDELAV, PDELAV, L3AV, EL3AV, PL3AV, & OPAAV, EOPAAV, POPAAV, & LEPRT, ELEPRT, PLEPRT, ALPRT, EALPRT, PALPRT, & DELRT, EDELRT, PDELRT, L3RT, EL3RT, PL3RT, & OPART, EOPART, POPART LOGICAL DEBUG COMMON /MYDEBUG/ DEBUG C C FORMAT STATEMENTS:- C =================== 10 FORMAT(1X,A80) 20 FORMAT(I2) 30 FORMAT(' >>> PARSE: NMEAS OR NSYST ZERO ') 40 FORMAT(' >>> PARSE: ERROR ON RETURN FROM GETINFO ') 50 FORMAT(' >>> PARSE: ON RETURN FROM GETCOR ') 60 FORMAT(' >>> PARSE: ON RETURN FROM AVGIT ') 70 FORMAT(' >>> PARSE: CONTINUATION BLANK ERROR ') 80 FORMAT(' >>> PARSE: NMEAS EXCEEDS MXMEAS ') 90 FORMAT(' >>> PARSE: NSYST EXCEEDS MXSYST ') 100 FORMAT(' *** AVERAGE B LIFETIME =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 101 FORMAT(' *** ALEPH AVERAGE VALUE =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 102 FORMAT(' *** DELPHI AVERAGE VALUE =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 103 FORMAT(' *** L3 AVERAGE VALUE =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 104 FORMAT(' *** OPAL AVERAGE VALUE =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 110 FORMAT(' *** AVERAGE B0 LIFETIME =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 120 FORMAT(' *** AVERAGE B+- LIFETIME =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 125 FORMAT(' / =',F6.3,' +-',F6.3) 130 FORMAT(' *** AVERAGE BS LIFETIME =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 135 FORMAT(' / =',F6.3,' +-',F6.3) 140 FORMAT(' *** AVERAGE LB LIFETIME =',F6.3,' +-',F6.3, & ' ps C.L. = ',F5.1,' % *** ') 145 FORMAT(' / =',F6.3,' +-',F6.3) 150 FORMAT(' *** AVERAGE RATIO =',F6.3,' +-',F6.3, & ' C.L. = ',F5.1,' % *** ') 160 FORMAT(' *** AVERAGE B+-/B0 RATIO =',F6.3,' +-',F6.3, & ' C.L. = ',F5.1,' % *** ') 170 FORMAT(' *** AVERAGE BS/B0 RATIO =',F6.3,' +-',F6.3, & ' C.L. = ',F5.1,' % *** ') 180 FORMAT(' *** AVERAGE LB/B0 RATIO =',F6.3,' +-',F6.3, & ' C.L. = ',F5.1,' % *** ') 190 FORMAT(1X,I2,'.) ',A1,' TIME =',F6.3,' +-',F6.3,' ps') 200 FORMAT(1X,I2,'.) ',A1,' TIME =',F6.3,' +-',F6.3,' ps', & ' RATIO =',F6.3,' +-',F6.3) 210 FORMAT(1X,I2,'.) ',A1,' TIME =',F6.3,' +-',F6.3) C C EXECUTABLE CODE:- C ================= C C SET GET NEXT LINE FLAG C ISTAT = -100 C C SKIP COMMENTS C IF (LINE(1:1) .EQ. '!') THEN C WRITE(6,10) LINE C C TURN ON DEBUGGING C ELSEIF (LINE(1:5) .EQ. 'DEBUG') THEN DEBUG = .TRUE. WRITE (*,*) 'Turn on debugging....... ',DEBUG C C TOGGLE FLAG START OF INPUT C WRITE(6,*) 'Start of input' ELSEIF (LINE(1:1) .EQ. '>' ) THEN WRITE(6,10) LINE C C INITIALIZE VARIABLES C LB0 = .FALSE. LBP = .FALSE. LBS = .FALSE. LLB = .FALSE. LAV = .FALSE. LRT = .FALSE. C C INITIALIZE COUNTERS C CNTM = 0 NA = 0 ND = 0 NL = 0 NO = 0 NS = 0 NC = 0 DO I=1,MXMEAS ! no clue why this is necessary... DSK EXPT(I)='-' ENDDO C C SET FLAG C IF (LINE(2:3) .EQ. 'B0') LB0 = .TRUE. IF (LINE(2:3) .EQ. 'B+') LBP = .TRUE. IF (LINE(2:3) .EQ. 'BS') LBS = .TRUE. IF (LINE(2:3) .EQ. 'LB') LLB = .TRUE. IF (LINE(2:3) .EQ. 'AV') LAV = .TRUE. IF (LINE(2:3) .EQ. 'RT') LRT = .TRUE. WRITE(6,*) LB0,LBP,LBS,LLB,LAV,LRT C C READ NUMBER OF MEASUREMENTS TO BE ANALYSED C WRITE(6,*) 'BEFORE ELSEIF' ELSEIF (LINE(1:2) .EQ. 'NM') THEN WRITE(6,*) 'No of measurements' WRITE(6,10) LINE READ(LINE(3:4),20) NMEAS IF (NMEAS .GT. MXMEAS) THEN WRITE(6,80) ISTAT = 100 ENDIF C C READ NUMBER OF SYSTEMATICS TO BE INCLUDED C ELSEIF (LINE(1:2) .EQ. 'NS') THEN WRITE(6,*) 'No of systematics' WRITE(6,10) LINE READ(LINE(3:4),20) NSYST IF (NSYST .GT. MXSYST) THEN WRITE(6,90) ISTAT = 100 ENDIF C C IS IT ALEPH, DELPHI, L3, OR OPAL DATA? C C ALEPH? C ELSEIF (LINE(1:2) .EQ. 'A ') THEN WRITE(6,*) 'ALEPH data' WRITE(6,'(''--------------------------'')') WRITE(6,10) LINE IF (NMEAS .EQ. 0 .OR. NSYST .EQ. 0) THEN WRITE(6,30) ISTAT = 100 ELSE WRITE(6,*) 'aleph data' CNTM = CNTM + 1 NA = NA + 1 PTRA(NA) = CNTM EXPT(CNTM) = 'A' CALL GETINFO(ILUN,LINE,ISTAT) IF (ISTAT .EQ. 100) THEN WRITE(6,40) ENDIF ENDIF C C DELPHI? C ELSEIF (LINE(1:2) .EQ. 'D ') THEN WRITE(6,'(''--------------------------'')') WRITE(6,10) LINE IF (NMEAS .EQ. 0 .OR. NSYST .EQ. 0) THEN WRITE(6,30) ISTAT = 100 ELSE CNTM = CNTM + 1 ND = ND + 1 PTRD(ND) = CNTM EXPT(CNTM) = 'D' CALL GETINFO(ILUN,LINE,ISTAT) IF (ISTAT .EQ. 100) THEN WRITE(6,40) ENDIF ENDIF C C L3? C ELSEIF (LINE(1:2) .EQ. 'L ') THEN WRITE(6,'(''--------------------------'')') WRITE(6,10) LINE IF (NMEAS .EQ. 0 .OR. NSYST .EQ. 0) THEN WRITE(6,30) ISTAT = 100 ELSE CNTM = CNTM + 1 NL = NL + 1 PTRL(NL) = CNTM EXPT(CNTM) = 'L' CALL GETINFO(ILUN,LINE,ISTAT) IF (ISTAT .EQ. 100) THEN WRITE(6,40) ENDIF ENDIF C C OPAL? C ELSEIF (LINE(1:2) .EQ. 'O ') THEN WRITE(6,'(''--------------------------'')') WRITE(6,10) LINE IF (NMEAS .EQ. 0 .OR. NSYST .EQ. 0) THEN WRITE(6,30) ISTAT = 100 ELSE CNTM = CNTM + 1 NO = NO + 1 PTRO(NO) = CNTM EXPT(CNTM) = 'O' CALL GETINFO(ILUN,LINE,ISTAT) IF (ISTAT .EQ. 100) THEN WRITE(6,40) ENDIF ENDIF WRITE(6,*) 'Finished getting info' C C EXTRACT STATISTICAL CORRELATIONS C ELSEIF (LINE(1:2) .EQ. 'P ') THEN C WRITE(6,10) LINE CALL GETCOR(ILUN,LINE,ISTAT) IF (ISTAT .EQ. 100) THEN WRITE(6,50) ISTAT = 100 ENDIF C C END OF ONE DATA ENTRY, ANALYSE IT! C ELSEIF (LINE(1:2) .EQ. 'E ') THEN WRITE(6,*) 'Asked to average' CALL AVGIT(ISTAT,0) WRITE(6,*) ISTAT IF (ISTAT .EQ. 100) THEN WRITE(6,60) ENDIF C C OUTPUT RESULTS C WRITE(6,*) 'To output stage' IF (LB0) THEN LEPB0 = TAU ELEPB0 = ETAU PLEPB0 = TAUPRB*100.0 CALL AVGIT(ISTAT,1) ALPB0 = TAU EALPB0 = ETAU PALPB0 = TAUPRB*100.0 CALL AVGIT(ISTAT,2) DELB0 = TAU EDELB0 = ETAU PDELB0 = TAUPRB*100.0 CALL AVGIT(ISTAT,3) L3B0 = TAU EL3B0 = ETAU PL3B0 = TAUPRB*100.0 CALL AVGIT(ISTAT,4) OPAB0 = TAU EOPAB0 = ETAU POPAB0 = TAUPRB*100.0 WRITE(6,*) ' ' IF (LEPB0 .NE. 0.0) WRITE(6,110) LEPB0, ELEPB0, PLEPB0 IF (ALPB0 .NE. 0.0) WRITE(6,101) ALPB0, EALPB0, PALPB0 IF (DELB0 .NE. 0.0) WRITE(6,102) DELB0, EDELB0, PDELB0 IF ( L3B0 .NE. 0.0) WRITE(6,103) L3B0, EL3B0, PL3B0 IF (OPAB0 .NE. 0.0) WRITE(6,104) OPAB0, EOPAB0, POPAB0 DO I = 1, NMEAS ERTAU = (USTA(I)+LSTA(I))*(USTA(I)+LSTA(I))/4.0 DO J = 1, NSYST ERTAU = ERTAU + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ENDDO WRITE(6,190) I, EXPT(I), TAUB(I), SQRT(ERTAU) ENDDO ELSEIF (LBP) THEN LEPBP = TAU ELEPBP = ETAU PLEPBP = TAUPRB*100.0 LEPRP = RAT ELEPRP = ERAT PLEPRP = RATPRB*100.0 CALL AVGIT(ISTAT,1) ALPBP = TAU EALPBP = ETAU PALPBP = TAUPRB*100.0 ALPRP = RAT EALPRP = ERAT PALPRP = RATPRB*100.0 CALL AVGIT(ISTAT,2) DELBP = TAU EDELBP = ETAU PDELBP = TAUPRB*100.0 DELRP = RAT EDELRP = ERAT PDELRP = RATPRB*100.0 CALL AVGIT(ISTAT,3) L3BP = TAU EL3BP = ETAU PL3BP = TAUPRB*100.0 L3RP = RAT EL3RP = ERAT PL3RP = RATPRB*100.0 CALL AVGIT(ISTAT,4) OPABP = TAU EOPABP = ETAU POPABP = TAUPRB*100.0 OPARP = RAT EOPARP = ERAT POPARP = RATPRB*100.0 WRITE(6,*) ' ' IF (LEPBP .NE. 0.0) WRITE(6,120) LEPBP, ELEPBP, PLEPBP IF (ALPBP .NE. 0.0) WRITE(6,101) ALPBP, EALPBP, PALPBP IF (DELBP .NE. 0.0) WRITE(6,102) DELBP, EDELBP, PDELBP IF ( L3BP .NE. 0.0) WRITE(6,103) L3BP, EL3BP, PL3BP IF (OPABP .NE. 0.0) WRITE(6,104) OPABP, EOPABP, POPABP WRITE(6,*) ' ' IF (LEPRP .NE. 0.0) THEN AVG = LEPBP/LEPB0 ERR = ELEPBP ERR = SQRT(ELEPBP*ELEPBP /LEPB0**2 & + (LEPBP*ELEPB0)**2/LEPB0**4) WRITE(6,160) LEPRP, ELEPRP, PLEPRP WRITE(6,125) AVG, ERR ENDIF IF (ALPRP .NE. 0.0) THEN AVG = ALPBP/ALPB0 ERR = EALPBP ERR = SQRT(EALPBP*EALPBP /ALPB0**2 & + (ALPBP*EALPB0)**2/ALPB0**4) WRITE(6,101) ALPRP, EALPRP, PALPRP WRITE(6,125) AVG, ERR ENDIF IF (DELRP .NE. 0.0) THEN AVG = DELBP/DELB0 ERR = EDELBP ERR = SQRT(EDELBP*EDELBP /DELB0**2 & + (DELBP*EDELB0)**2/DELB0**4) WRITE(6,102) DELRP, EDELRP, PDELRP WRITE(6,125) AVG, ERR ENDIF IF ( L3RP .NE. 0.0) THEN AVG = L3BP/ L3B0 ERR = EL3BP ERR = SQRT(EL3BP*EL3BP /L3B0**2 & + (L3BP*EL3B0)**2/L3B0**4) WRITE(6,103) L3RP, EL3RP, PL3RP WRITE(6,125) AVG, ERR ENDIF IF (OPARP .NE. 0.0) THEN AVG = OPABP/OPAB0 ERR = EOPABP ERR = SQRT(EOPABP*EOPABP /OPAB0**2 & + (OPABP*EOPAB0)**2/OPAB0**4) WRITE(6,104) OPARP, EOPARP, POPARP WRITE(6,125) AVG, ERR ENDIF DO I = 1, NMEAS ERTAU = (USTA(I)+LSTA(I))*(USTA(I)+LSTA(I))/4.0 ERRAT = EUCOR(I)*EUCOR(I) DO J = 1, NSYST ERRAT = ERRAT + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ERTAU = ERTAU + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ENDDO WRITE(6,200) I, EXPT(I), TAUB(I), SQRT(ERTAU), & RATIO(I), SQRT(ERRAT) ENDDO ELSEIF (LBS) THEN LEPBS = TAU ELEPBS = ETAU PLEPBS = TAUPRB*100.0 LEPRS = RAT ELEPRS = ERAT PLEPRS = RATPRB*100.0 CALL AVGIT(ISTAT,1) ALPBS = TAU EALPBS = ETAU PALPBS = TAUPRB*100.0 ALPRS = RAT EALPRS = ERAT PALPRS = RATPRB*100.0 CALL AVGIT(ISTAT,2) DELBS = TAU EDELBS = ETAU PDELBS = TAUPRB*100.0 DELRS = RAT EDELRS = ERAT PDELRS = RATPRB*100.0 CALL AVGIT(ISTAT,3) L3BS = TAU EL3BS = ETAU PL3BS = TAUPRB*100.0 L3RS = RAT EL3RS = ERAT PL3RS = RATPRB*100.0 CALL AVGIT(ISTAT,4) OPABS = TAU EOPABS = ETAU POPABS = TAUPRB*100.0 OPARS = RAT EOPARS = ERAT POPARS = RATPRB*100.0 WRITE(6,*) ' ' IF (LEPBS .NE. 0.0) WRITE(6,130) LEPBS, ELEPBS, PLEPBS IF (ALPBS .NE. 0.0) WRITE(6,101) ALPBS, EALPBS, PALPBS IF (DELBS .NE. 0.0) WRITE(6,102) DELBS, EDELBS, PDELBS IF ( L3BS .NE. 0.0) WRITE(6,103) L3BS, EL3BS, PL3BS IF (OPABS .NE. 0.0) WRITE(6,104) OPABS, EOPABS, POPABS WRITE(6,*) ' ' IF (LEPRS .NE. 0.0) THEN AVG = LEPBS/LEPB0 ERR = ELEPBS ERR = SQRT(ELEPBS*ELEPBS /LEPB0**2 & + (LEPBS*ELEPB0)**2/LEPB0**4) WRITE(6,170) LEPRS, ELEPRS, PLEPRS WRITE(6,135) AVG, ERR ENDIF IF (ALPRS .NE. 0.0) THEN AVG = ALPBS/ALPB0 ERR = EALPBS ERR = SQRT(EALPBS*EALPBS /ALPB0**2 & + (ALPBS*EALPB0)**2/ALPB0**4) WRITE(6,101) ALPRS, EALPRS, PALPRS WRITE(6,135) AVG, ERR ENDIF IF (DELRS .NE. 0.0) THEN AVG = DELBS/DELB0 ERR = EDELBS ERR = SQRT(EDELBS*EDELBS /DELB0**2 & + (DELBS*EDELB0)**2/DELB0**4) WRITE(6,102) DELRS, EDELRS, PDELRS WRITE(6,135) AVG, ERR ENDIF IF ( L3RS .NE. 0.0) THEN AVG = L3BS/L3B0 ERR = EL3BS ERR = SQRT(EL3BS*EL3BS /L3B0**2 & + (L3BS*EL3B0)**2/L3B0**4) WRITE(6,103) L3RS, EL3RS, PL3RS WRITE(6,135) AVG, ERR ENDIF IF (OPARS .NE. 0.0) THEN AVG = OPABS/OPAB0 ERR = EOPABS ERR = SQRT(EOPABS*EOPABS /OPAB0**2 & + (OPABS*EOPAB0)**2/OPAB0**4) WRITE(6,104) OPARS, EOPARS, POPARS WRITE(6,135) AVG, ERR ENDIF DO I = 1, NMEAS ERTAU = (USTA(I)+LSTA(I))*(USTA(I)+LSTA(I))/4.0 ERRAT = EUCOR(I)*EUCOR(I) DO J = 1, NSYST ERRAT = ERRAT + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ERTAU = ERTAU + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ENDDO WRITE(6,200) I, EXPT(I), TAUB(I), SQRT(ERTAU), & RATIO(I), SQRT(ERRAT) ENDDO ELSEIF (LLB) THEN LEPLB = TAU ELEPLB = ETAU PLEPLB = TAUPRB*100.0 LEPRL = RAT ELEPRL = ERAT PLEPRL = RATPRB*100.0 CALL AVGIT(ISTAT,1) ALPLB = TAU EALPLB = ETAU PALPLB = TAUPRB*100.0 ALPRL = RAT EALPRL = ERAT PALPRL = RATPRB*100.0 CALL AVGIT(ISTAT,2) DELLB = TAU EDELLB = ETAU PDELLB = TAUPRB*100.0 DELRL = RAT EDELRL = ERAT PDELRL = RATPRB*100.0 CALL AVGIT(ISTAT,3) L3LB = TAU EL3LB = ETAU PL3LB = TAUPRB*100.0 L3RL = RAT EL3RL = ERAT PL3RL = RATPRB*100.0 CALL AVGIT(ISTAT,4) OPALB = TAU EOPALB = ETAU POPALB = TAUPRB*100.0 OPARL = RAT EOPARL = ERAT POPARL = RATPRB*100.0 WRITE(6,*) ' ' IF (LEPLB .NE. 0.0) WRITE(6,140) LEPLB, ELEPLB, PLEPLB IF (ALPLB .NE. 0.0) WRITE(6,101) ALPLB, EALPLB, PALPLB IF (DELLB .NE. 0.0) WRITE(6,102) DELLB, EDELLB, PDELLB IF ( L3LB .NE. 0.0) WRITE(6,103) L3LB, EL3LB, PL3LB IF (OPALB .NE. 0.0) WRITE(6,104) OPALB, EOPALB, POPALB WRITE(6,*) ' ' IF (LEPRL .NE. 0.0) THEN AVG = LEPLB/LEPB0 ERR = ELEPLB ERR = SQRT(ELEPLB*ELEPLB /LEPB0**2 & + (LEPLB*ELEPB0)**2/LEPB0**4) WRITE(6,180) LEPRL, ELEPRL, PLEPRL WRITE(6,145) AVG, ERR ENDIF IF (ALPRL .NE. 0.0) THEN AVG = ALPLB/ALPB0 ERR = EALPLB ERR = SQRT(EALPLB*EALPLB /ALPB0**2 & + (ALPLB*EALPB0)**2/ALPB0**4) WRITE(6,101) ALPRL, EALPRL, PALPRL WRITE(6,145) AVG, ERR ENDIF IF (DELRL .NE. 0.0) THEN AVG = DELLB/DELB0 ERR = EDELLB ERR = SQRT(EDELLB*EDELLB /DELB0**2 & + (DELLB*EDELB0)**2/DELB0**4) WRITE(6,102) DELRL, EDELRL, PDELRL WRITE(6,145) AVG, ERR ENDIF IF ( L3RL .NE. 0.0) THEN AVG = L3LB/L3B0 ERR = EL3LB ERR = SQRT(EL3LB*EL3LB /L3B0**2 & + (L3LB*EL3B0)**2/L3B0**4) WRITE(6,103) L3RL, EL3RL, PL3RL WRITE(6,145) AVG, ERR ENDIF IF (OPARL .NE. 0.0) THEN AVG = OPALB/OPAB0 ERR = EOPALB ERR = SQRT(EOPALB*EOPALB /OPAB0**2 & + (OPALB*EOPAB0)**2/OPAB0**4) WRITE(6,104) OPARL, EOPARL, POPARL WRITE(6,145) AVG, ERR ENDIF DO I = 1, NMEAS ERTAU = (USTA(I)+LSTA(I))*(USTA(I)+LSTA(I))/4.0 ERRAT = EUCOR(I)*EUCOR(I) DO J = 1, NSYST ERRAT = ERRAT + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ERTAU = ERTAU + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ENDDO WRITE(6,200) I, EXPT(I), TAUB(I), SQRT(ERTAU), & RATIO(I), SQRT(ERRAT) ENDDO ELSEIF (LAV) THEN LEPAV = TAU ELEPAV = ETAU PLEPAV = TAUPRB*100.0 CALL AVGIT(ISTAT,1) ALPAV = TAU EALPAV = ETAU PALPAV = TAUPRB*100.0 CALL AVGIT(ISTAT,2) DELAV = TAU EDELAV = ETAU PDELAV = TAUPRB*100.0 CALL AVGIT(ISTAT,3) L3AV = TAU EL3AV = ETAU PL3AV = TAUPRB*100.0 CALL AVGIT(ISTAT,4) OPAAV = TAU EOPAAV = ETAU POPAAV = TAUPRB*100.0 WRITE(6,*) ' ' IF (LEPAV .NE. 0.0) WRITE(6,100) LEPAV, ELEPAV, PLEPAV IF (ALPAV .NE. 0.0) WRITE(6,101) ALPAV, EALPAV, PALPAV IF (DELAV .NE. 0.0) WRITE(6,102) DELAV, EDELAV, PDELAV IF ( L3AV .NE. 0.0) WRITE(6,103) L3AV, EL3AV, PL3AV IF (OPAAV .NE. 0.0) WRITE(6,104) OPAAV, EOPAAV, POPAAV DO I = 1, NMEAS ERTAU = (USTA(I)+LSTA(I))*(USTA(I)+LSTA(I))/4.0 DO J = 1, NSYST ERTAU = ERTAU + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ENDDO WRITE(6,190) I, EXPT(I), TAUB(I), SQRT(ERTAU) ENDDO ELSEIF (LRT) THEN LEPRT = TAU ELEPRT = ETAU PLEPRT = TAUPRB*100.0 CALL AVGIT(ISTAT,1) ALPRT = TAU EALPRT = ETAU PALPRT = TAUPRB*100.0 CALL AVGIT(ISTAT,2) DELRT = TAU EDELRT = ETAU PDELRT = TAUPRB*100.0 CALL AVGIT(ISTAT,3) L3RT = TAU EL3RT = ETAU PL3RT = TAUPRB*100.0 CALL AVGIT(ISTAT,4) OPART = TAU EOPART = ETAU POPART = TAUPRB*100.0 WRITE(6,*) ' ' IF (LEPRT .NE. 0.0) WRITE(6,150) LEPRT, ELEPRT, PLEPRT IF (ALPRT .NE. 0.0) WRITE(6,101) ALPRT, EALPRT, PALPRT IF (DELRT .NE. 0.0) WRITE(6,102) DELRT, EDELRT, PDELRT IF ( L3RT .NE. 0.0) WRITE(6,103) L3RT, EL3RT, PL3RT IF (OPART .NE. 0.0) WRITE(6,104) OPART, EOPART, POPART DO I = 1, NMEAS ERTAU = (USTA(I)+LSTA(I))*(USTA(I)+LSTA(I))/4.0 DO J = 1, NSYST ERTAU = ERTAU + & (USYS(I,J)+LSYS(I,J))*(USYS(I,J)+LSYS(I,J))/4.0 ENDDO WRITE(6,210) I, EXPT(I), TAUB(I), SQRT(ERTAU) ENDDO ENDIF C C RESET COUNTER C CNTM = 0 C C CONTINUATION SHOULD NOT OCCUR HERE? C ELSEIF (LINE(1:2) .EQ. ' ') THEN write(6,*) 'problem here' write(6,999) line 999 format(a80) WRITE(6,70) ISTAT = 100 ENDIF RETURN END C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE GETINFO(ILUN,LINE,ISTAT) C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = C C ISTAT < 0 GET NEXT LINE C ISTAT > 0 ERROR C ISTAT = 0 END OF FILE C C AUTHOR:- C ======== C TIM HESSING, CERN-PPE/LEP-DELPHI C C DATE/HISTORY:- C ============== C 27-APRIL-1994: CREATED-TLH C IMPLICIT NONE C C DECLARATIONS:- C ============== INTEGER ILUN, ISTAT INTEGER I, J, K CHARACTER*80 LINE C C COMMON VARIABLES C C IFRAC EQ 1 IMPLIES USE FRACTIONAL ERRORS C IFRAC NE 2 IMPLIES USE ABSOLUTE ERRORS C INTEGER IFRAC PARAMETER (IFRAC = 1) C C MAXIMUM NUMBER OF MEASUREMENTS TO COMBINE C INTEGER MXMEAS PARAMETER (MXMEAS = 25) C C MAXIMUM NUMBER OF SYSTEMATICS FOR EACH MEASUREMENT C INTEGER MXSYST PARAMETER (MXSYST = 50) C C IMPORTANT NUMBERS C INTEGER NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC INTEGER PTRA(MXMEAS), PTRD(MXMEAS) INTEGER PTRL(MXMEAS), PTRO(MXMEAS) REAL*4 TAUB(MXMEAS) REAL*4 USTA(MXMEAS), LSTA(MXMEAS) REAL*4 USYS(MXMEAS,MXSYST), LSYS(MXMEAS,MXSYST) REAL*4 CORR(MXMEAS,MXMEAS), COVA(MXMEAS,MXMEAS) REAL*4 TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB REAL*4 RATIO(MXMEAS), EUCOR(MXMEAS), RTIME(MXMEAS) LOGICAL LB0, LBP, LBS, LLB, LAV, LRT COMMON/TAUAVG/ NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC, & PTRA, PTRD, & PTRL, PTRO, & TAUB, & USTA, LSTA, & USYS, LSYS, & CORR, COVA, & TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB, & RATIO, EUCOR, RTIME, & LB0, LBP, LBS, LLB, LAV, LRT LOGICAL DEBUG COMMON /MYDEBUG/ DEBUG CHARACTER*80 BLANK INTEGER IOSTAT C C FORMAT STATEMENTS:- C =================== 10 FORMAT(F5.3,1X,F5.3,1X,F5.3) 20 FORMAT(A80) 30 FORMAT(1X,A80,A2) 40 FORMAT(F5.3,1X,F5.3) 50 FORMAT(' >>> GETINFO: CONTINUATION BLANK ERROR ') 60 FORMAT(' >>> GETINFO: CNTM EXCEEDS MXMEAS ') C C EXECUTABLE CODE:- C ================= BLANK=' ' IF (CNTM .GT. MXMEAS) THEN WRITE(6,60) ISTAT = 100 RETURN ENDIF C C READ MEASUREMENT AND UPPER/LOWER STATISTICAL ERROR C READ(LINE(3:19),10) TAUB(CNTM), USTA(CNTM), LSTA(CNTM) C C LOOP UNTIL ALL UPPER/LOWER SYSTEMATICS HAVE BEEN READ IN C DO I = 1, NSYST J = 21 + (I-1)*12 K = 31 + (I-1)*12 IF (I .GT. 5) THEN IF (I .EQ. (I/5)*5+1) THEN READ(ILUN,20,END=100,ERR=200) LINE WRITE(6,30) LINE,line(1:2) IF (LINE(1:2) .NE. ' ') THEN WRITE(6,30) LINE,line(1:2) WRITE(6,50) GOTO 200 ELSE C C ADDED THIS CHECK: DALE C IF (LINE(63:80).NE.' ')THEN WRITE(*,'(63X,''^^^^^^^^^^^^^^^^^^^^^^^^'')') WRITE(*,*) + 'FORMAT ERROR: THERE ARE CHARACTERS AFTER COLUMN 62!' WRITE(*,*) + 'ONLY 5 PAIRS OF SYST ERRORS ARE ALLOWED PER LINE!' STOP ENDIF ENDIF ENDIF J = 3 + ( (I-1) - ( (I-1)/5 )*5 )*12 K = 13 + ( (I-1) - ( (I-1)/5 )*5 )*12 ENDIF C C ADDED THIS CHECK TOO: DALE C IF (LINE(J+1:J+1).NE.'.' .OR. LINE(J+7:J+7).NE.'.') THEN WRITE (*,*) 'FORMAT ERROR "'//LINE(J:K) + //'" IS NOT F5.3,1X,F5.3 --> STOP.' STOP ENDIF READ(LINE(J:K),40,IOSTAT=IOSTAT) USYS(CNTM,I), LSYS(CNTM,I) C C check return code: DALE C IF (IOSTAT.NE.0) THEN WRITE (*,*) 'ERROR READING "'//LINE(J:K) + //'" WITH FORMAT F5.3,1X,F5.3 --> STOP.' STOP ENDIF ! FOR DEBUGGING: ------------------------------------------------- C C add debugging output: DALE C IF (DEBUG) WRITE (*,'(3X,A,I3,A,I3,A,2F6.3,A)') + ' Measurement (CNTM)=',CNTM,' Syst Err (I)=',I + ,': ',USYS(CNTM,I), LSYS(CNTM,I),' "'//LINE(J:K) + //'" ' ! ---------------------------------------------------------------- ENDDO C C ADDED THIS CHECK TOO: DALE C IF (LINE(K+1:80).NE.' ') THEN WRITE (*,*) BLANK(1:K)//'^-- column ',K WRITE (*,*) 'EXTRA STUFF ON THIS LINE AFTER COLUMN ',K, + ' --> STOP.' STOP ENDIF GOTO 300 100 ISTAT = 0 GOTO 300 200 ISTAT = 100 300 RETURN END C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE GETCOR(ILUN,LINE,ISTAT) C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = C C ISTAT < 0 GET NEXT LINE C ISTAT > 0 ERROR C ISTAT = 0 END OF FILE C C AUTHOR:- C ======== C TIM HESSING, CERN-PPE/LEP-DELPHI C C DATE/HISTORY:- C ============== C 27-APRIL-1994: CREATED-TLH C IMPLICIT NONE C C DECLARATIONS:- C ============== INTEGER ILUN, ISTAT INTEGER I, J, K, L, M CHARACTER*80 LINE C C COMMON VARIABLES C C IFRAC EQ 1 IMPLIES USE FRACTIONAL ERRORS C IFRAC NE 2 IMPLIES USE ABSOLUTE ERRORS C INTEGER IFRAC PARAMETER (IFRAC = 1) C C MAXIMUM NUMBER OF MEASUREMENTS TO COMBINE C INTEGER MXMEAS PARAMETER (MXMEAS = 25) C C MAXIMUM NUMBER OF SYSTEMATICS FOR EACH MEASUREMENT C INTEGER MXSYST PARAMETER (MXSYST = 50) C C IMPORTANT NUMBERS C INTEGER NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC INTEGER PTRA(MXMEAS), PTRD(MXMEAS) INTEGER PTRL(MXMEAS), PTRO(MXMEAS) REAL*4 TAUB(MXMEAS) REAL*4 USTA(MXMEAS), LSTA(MXMEAS) REAL*4 USYS(MXMEAS,MXSYST), LSYS(MXMEAS,MXSYST) REAL*4 CORR(MXMEAS,MXMEAS), COVA(MXMEAS,MXMEAS) REAL*4 TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB REAL*4 RATIO(MXMEAS), EUCOR(MXMEAS), RTIME(MXMEAS) LOGICAL LB0, LBP, LBS, LLB, LAV, LRT COMMON/TAUAVG/ NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC, & PTRA, PTRD, & PTRL, PTRO, & TAUB, & USTA, LSTA, & USYS, LSYS, & CORR, COVA, & TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB, & RATIO, EUCOR, RTIME, & LB0, LBP, LBS, LLB, LAV, LRT C C FORMAT STATEMENTS:- C =================== 10 FORMAT(A80) 20 FORMAT(1X,A80) 30 FORMAT(' >>> GETCOR: CONTINUATION BLANK ERROR ') 40 FORMAT(F5.3) C C EXECUTABLE CODE:- C ================= DO I = 1, NMEAS CORR(I,I) = 1.0 ENDDO K = 0 DO I = 1, NMEAS-1 DO J = I+1, NMEAS K = K + 1 L = 3 + ( (K-1) - ( (K-1)/10 )*10 )*6 M = 7 + ( (K-1) - ( (K-1)/10 )*10 )*6 IF (K .EQ. (K/10)*10+1 .AND. K .NE. 1) THEN READ(ILUN,10,END=100,ERR=200) LINE C WRITE(6,20) LINE IF (LINE(1:2) .NE. ' ') THEN WRITE(6,30) GOTO 200 ENDIF ENDIF READ(LINE(L:M),40) CORR(I,J) CORR(J,I) = CORR(I,J) ENDDO ENDDO GOTO 300 100 ISTAT = 0 GOTO 300 200 ISTAT = 100 300 RETURN END C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE AVGIT(ISTAT,IW) C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = C C ISTAT < 0 GET NEXT LINE C ISTAT > 0 ERROR C ISTAT = 0 END OF FILE C C IW = 0 : AVG ALL EXPERIMENTS MEASUREMENTS C IW = 1 : AVG ALL ALEPH's MEASUREMENTS C IW = 2 : AVG ALL DELPHI's MEASUREMENTS C IW = 3 : AVG ALL L3's MEASUREMENTS C IW = 4 : AVG ALL OPAL's MEASUREMENTS C C AUTHOR:- C ======== C TIM HESSING, CERN-PPE/LEP-DELPHI C C DATE/HISTORY:- C ============== C 27-APRIL-1994: CREATED-TLH C IMPLICIT NONE C C DECLARATIONS:- C ============== INTEGER ISTAT, IW, NW INTEGER I, J, K, L, M, IFAIL REAL*4 FRAC(2), ERSUM, SUM2, CHI2, ERR REAL*4 PROB EXTERNAL PROB C C COMMON VARIABLES C C IFRAC EQ 1 IMPLIES USE FRACTIONAL ERRORS C IFRAC NE 2 IMPLIES USE ABSOLUTE ERRORS C INTEGER IFRAC PARAMETER (IFRAC = 1) C C MAXIMUM NUMBER OF MEASUREMENTS TO COMBINE C INTEGER MXMEAS PARAMETER (MXMEAS = 25) C C MAXIMUM NUMBER OF SYSTEMATICS FOR EACH MEASUREMENT C INTEGER MXSYST PARAMETER (MXSYST = 50) C C IMPORTANT NUMBERS C INTEGER NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC INTEGER PTRA(MXMEAS), PTRD(MXMEAS) INTEGER PTRL(MXMEAS), PTRO(MXMEAS) REAL*4 TAUB(MXMEAS) REAL*4 USTA(MXMEAS), LSTA(MXMEAS) REAL*4 USYS(MXMEAS,MXSYST), LSYS(MXMEAS,MXSYST) REAL*4 CORR(MXMEAS,MXMEAS), COVA(MXMEAS,MXMEAS) REAL*4 TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB REAL*4 RATIO(MXMEAS), EUCOR(MXMEAS), RTIME(MXMEAS) LOGICAL LB0, LBP, LBS, LLB, LAV, LRT COMMON/TAUAVG/ NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC, & PTRA, PTRD, & PTRL, PTRO, & TAUB, & USTA, LSTA, & USYS, LSYS, & CORR, COVA, & TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB, & RATIO, EUCOR, RTIME, & LB0, LBP, LBS, LLB, LAV, LRT C C KEEP TRACK OF AVERAGES C REAL*4 LEPB0, ELEPB0, PLEPB0, ALPB0, EALPB0, PALPB0 REAL*4 DELB0, EDELB0, PDELB0, L3B0, EL3B0, PL3B0 REAL*4 OPAB0, EOPAB0, POPAB0 REAL*4 LEPBP, ELEPBP, PLEPBP, ALPBP, EALPBP, PALPBP REAL*4 DELBP, EDELBP, PDELBP, L3BP, EL3BP, PL3BP REAL*4 OPABP, EOPABP, POPABP REAL*4 LEPRP, ELEPRP, PLEPRP, ALPRP, EALPRP, PALPRP REAL*4 DELRP, EDELRP, PDELRP, L3RP, EL3RP, PL3RP REAL*4 OPARP, EOPARP, POPARP REAL*4 LEPBS, ELEPBS, PLEPBS, ALPBS, EALPBS, PALPBS REAL*4 DELBS, EDELBS, PDELBS, L3BS, EL3BS, PL3BS REAL*4 OPABS, EOPABS, POPABS REAL*4 LEPRS, ELEPRS, PLEPRS, ALPRS, EALPRS, PALPRS REAL*4 DELRS, EDELRS, PDELRS, L3RS, EL3RS, PL3RS REAL*4 OPARS, EOPARS, POPARS REAL*4 LEPLB, ELEPLB, PLEPLB, ALPLB, EALPLB, PALPLB REAL*4 DELLB, EDELLB, PDELLB, L3LB, EL3LB, PL3LB REAL*4 OPALB, EOPALB, POPALB REAL*4 LEPRL, ELEPRL, PLEPRL, ALPRL, EALPRL, PALPRL REAL*4 DELRL, EDELRL, PDELRL, L3RL, EL3RL, PL3RL REAL*4 OPARL, EOPARL, POPARL REAL*4 LEPAV, ELEPAV, PLEPAV, ALPAV, EALPAV, PALPAV REAL*4 DELAV, EDELAV, PDELAV, L3AV, EL3AV, PL3AV REAL*4 OPAAV, EOPAAV, POPAAV REAL*4 LEPRT, ELEPRT, PLEPRT, ALPRT, EALPRT, PALPRT REAL*4 DELRT, EDELRT, PDELRT, L3RT, EL3RT, PL3RT REAL*4 OPART, EOPART, POPART COMMON/LEPAVG/ & LEPB0, ELEPB0, PLEPB0, ALPB0, EALPB0, PALPB0, & DELB0, EDELB0, PDELB0, L3B0, EL3B0, PL3B0, & OPAB0, EOPAB0, POPAB0, & LEPBP, ELEPBP, PLEPBP, ALPBP, EALPBP, PALPBP, & DELBP, EDELBP, PDELBP, L3BP, EL3BP, PL3BP, & OPABP, EOPABP, POPABP, & LEPRP, ELEPRP, PLEPRP, ALPRP, EALPRP, PALPRP, & DELRP, EDELRP, PDELRP, L3RP, EL3RP, PL3RP, & OPARP, EOPARP, POPARP, & LEPBS, ELEPBS, PLEPBS, ALPBS, EALPBS, PALPBS, & DELBS, EDELBS, PDELBS, L3BS, EL3BS, PL3BS, & OPABS, EOPABS, POPABS, & LEPRS, ELEPRS, PLEPRS, ALPRS, EALPRS, PALPRS, & DELRS, EDELRS, PDELRS, L3RS, EL3RS, PL3RS, & OPARS, EOPARS, POPARS, & LEPLB, ELEPLB, PLEPLB, ALPLB, EALPLB, PALPLB, & DELLB, EDELLB, PDELLB, L3LB, EL3LB, PL3LB, & OPALB, EOPALB, POPALB, & LEPRL, ELEPRL, PLEPRL, ALPRL, EALPRL, PALPRL, & DELRL, EDELRL, PDELRL, L3RL, EL3RL, PL3RL, & OPARL, EOPARL, POPARL, & LEPAV, ELEPAV, PLEPAV, ALPAV, EALPAV, PALPAV, & DELAV, EDELAV, PDELAV, L3AV, EL3AV, PL3AV, & OPAAV, EOPAAV, POPAAV, & LEPRT, ELEPRT, PLEPRT, ALPRT, EALPRT, PALPRT, & DELRT, EDELRT, PDELRT, L3RT, EL3RT, PL3RT, & OPART, EOPART, POPART C C C FORMAT STATEMENTS:- C =================== C C EXECUTABLE CODE:- C ================= C C INITIALIZE VARIABLES C TAU = 0.0 ETAU = 0.0 C C WHAT WE DOING? C NW = 0 IF (IW .EQ. 0) NW = NA + ND + NL + NO IF (IW .EQ. 1) NW = NA IF (IW .EQ. 2) NW = ND IF (IW .EQ. 3) NW = NL IF (IW .EQ. 4) NW = NO IF (IW .EQ. 0 .AND. NW .NE. NMEAS) WRITE(6,*) ' *** NW <> NMEAS' C C COMBINE ALL MEASUREMENTS C IF (NW .GT. 1) THEN C C FILL COVARIANCE MATRIX C DO L = 1, NW IF (IW .EQ. 0) THEN IF (L .LE. NA) THEN I = PTRA(L) IF (ALPB0 .NE. 0.0) THEN RATIO(I) = TAUB(I)/ALPB0 EUCOR(I) = (USTA(I)+LSTA(I))/2.0 EUCOR(I) = SQRT( EUCOR(I)**2/ALPB0**2 & + (TAUB(I)*EALPB0)**2/ALPB0**4) RTIME(I) = ALPB0 ENDIF ELSEIF (L .GT. NA .AND. L .LE. NA+ND) THEN I = PTRD(L-NA) IF (DELB0 .NE. 0.0) THEN RATIO(I) = TAUB(I)/DELB0 EUCOR(I) = (USTA(I)+LSTA(I))/2.0 EUCOR(I) = SQRT( EUCOR(I)**2/DELB0**2 & + (TAUB(I)*EDELB0)**2/DELB0**4) RTIME(I) = DELB0 ENDIF ELSEIF (L .GT. NA+ND .AND. L .LE. NA+ND+NL) THEN I = PTRL(L-NA-ND) IF (L3B0 .NE. 0.0) THEN RATIO(I) = TAUB(I)/L3B0 EUCOR(I) = (USTA(I)+LSTA(I))/2.0 EUCOR(I) = SQRT( EUCOR(I)**2/L3B0**2 & + (TAUB(I)* EL3B0)**2/L3B0**4) RTIME(I) = L3B0 ENDIF ELSEIF (L .GT. NA+ND+NL)THEN I = PTRO(L-NA-ND-NL) IF (OPAB0 .NE. 0.0) THEN RATIO(I) = TAUB(I)/OPAB0 EUCOR(I) = (USTA(I)+LSTA(I))/2.0 EUCOR(I) = SQRT( EUCOR(I)**2/OPAB0**2 & + (TAUB(I)*EOPAB0)**2/OPAB0**4) RTIME(I) = OPAB0 ENDIF ENDIF ELSEIF (IW .EQ. 1) THEN I = PTRA(L) ELSEIF (IW .EQ. 2) THEN I = PTRD(L) ELSEIF (IW .EQ. 3) THEN I = PTRL(L) ELSEIF (IW .EQ. 4) THEN I = PTRO(L) ENDIF DO M = 1, NW IF (IW .EQ. 0) THEN IF (M .LE. NA) & J = PTRA(M) IF (M .GT. NA .AND. M .LE. NA+ND) & J = PTRD(M-NA) IF (M .GT. NA+ND .AND. M .LE. NA+ND+NL) & J = PTRL(M-NA-ND) IF (M .GT. NA+ND+NL) & J = PTRO(M-NA-ND-NL) ELSEIF (IW .EQ. 1) THEN J = PTRA(M) ELSEIF (IW .EQ. 2) THEN J = PTRD(M) ELSEIF (IW .EQ. 3) THEN J = PTRL(M) ELSEIF (IW .EQ. 4) THEN J = PTRO(M) ENDIF IF (IFRAC .EQ. 1) THEN FRAC(1) = TAUB(I) FRAC(2) = TAUB(J) ELSE FRAC(1) = 1.0 FRAC(2) = 1.0 ENDIF IF (L .EQ. M) THEN COVA(L,M) = (USTA(I)+LSTA(I))*(USTA(J)+LSTA(J))/4.0 ELSE COVA(L,M) = (USTA(I)+LSTA(I))*(USTA(J)+LSTA(J))/4.0 & * CORR(I,J) ENDIF DO K = 1, NSYST COVA(L,M) = COVA(L,M) + & (USYS(I,K)+LSYS(I,K))*(USYS(J,K)+LSYS(J,K))/4.0 ENDDO COVA(L,M) = COVA(L,M)/(FRAC(1)*FRAC(2)) ENDDO ENDDO C C INVERT COVARIANCE MATRIX C CALL TIMINV(IFAIL,NW) IF (IFAIL .EQ. 0.0) THEN ERSUM = 0.0 SUM2 = 0.0 DO L = 1, NW DO M = 1, NW IF (IW .EQ. 0) THEN IF (M .LE. NA) & J = PTRA(M) IF (M .GT. NA .AND. M .LE. NA+ND) & J = PTRD(M-NA) IF (M .GT. NA+ND .AND. M .LE. NA+ND+NL) & J = PTRL(M-NA-ND) IF (M .GT. NA+ND+NL) & J = PTRO(M-NA-ND-NL) ELSEIF (IW .EQ. 1) THEN J = PTRA(M) ELSEIF (IW .EQ. 2) THEN J = PTRD(M) ELSEIF (IW .EQ. 3) THEN J = PTRL(M) ELSEIF (IW .EQ. 4) THEN J = PTRO(M) ENDIF ERSUM = ERSUM + COVA(L,M) SUM2 = SUM2 + COVA(L,M)*TAUB(J) ENDDO ENDDO TAU = SUM2/ERSUM ETAU = SQRT(1.0/ERSUM) IF (IFRAC .EQ. 1) ETAU = ETAU*TAU ELSE WRITE(60,*) ' MATRIX INVERSION FAILED IN TOT LIFETIME' WRITE(6, *) ' MATRIX INVERSION FAILED IN TOT LIFETIME' ENDIF C C C NOW THE RATIOS C C FILL COVARIANCE MATRIX C IF (LEPB0 .NE. 0.0 .AND. .NOT.LB0) THEN DO L = 1, NW IF (IW .EQ. 0) THEN IF (L .LE. NA) THEN I = PTRA(L) ELSEIF (L .GT. NA .AND. L .LE. NA+ND) THEN I = PTRD(L-NA) ELSEIF (L .GT. NA+ND .AND. L .LE. NA+ND+NL) THEN I = PTRL(L-NA-ND) ELSEIF (L .GT. NA+ND+NL)THEN I = PTRO(L-NA-ND-NL) ENDIF ELSEIF (IW .EQ. 1) THEN I = PTRA(L) ELSEIF (IW .EQ. 2) THEN I = PTRD(L) ELSEIF (IW .EQ. 3) THEN I = PTRL(L) ELSEIF (IW .EQ. 4) THEN I = PTRO(L) ENDIF DO M = 1, NW IF (IW .EQ. 0) THEN IF (M .LE. NA) & J = PTRA(M) IF (M .GT. NA .AND. M .LE. NA+ND) & J = PTRD(M-NA) IF (M .GT. NA+ND .AND. M .LE. NA+ND+NL) & J = PTRL(M-NA-ND) IF (M .GT. NA+ND+NL) & J = PTRO(M-NA-ND-NL) ELSEIF (IW .EQ. 1) THEN J = PTRA(M) ELSEIF (IW .EQ. 2) THEN J = PTRD(M) ELSEIF (IW .EQ. 3) THEN J = PTRL(M) ELSEIF (IW .EQ. 4) THEN J = PTRO(M) ENDIF IF (IFRAC .EQ. 1) THEN FRAC(1) = RATIO(I) FRAC(2) = RATIO(J) ELSE FRAC(1) = 1.0 FRAC(2) = 1.0 ENDIF IF (L .EQ. M) THEN COVA(L,M) = EUCOR(I)*EUCOR(J) ELSE COVA(L,M) = EUCOR(I)*EUCOR(J) & * CORR(I,J) ENDIF DO K = 1, NSYST COVA(L,M) = COVA(L,M) + & (USYS(I,K)+LSYS(I,K))*(USYS(J,K)+LSYS(J,K))/4.0 & /(RTIME(I)*RTIME(J)) ENDDO COVA(L,M) = COVA(L,M)/(FRAC(1)*FRAC(2)) ENDDO ENDDO C C INVERT COVARIANCE MATRIX C CALL TIMINV(IFAIL,NW) IF (IFAIL .EQ. 0.0) THEN ERSUM = 0.0 SUM2 = 0.0 DO L = 1, NW DO M = 1, NW IF (IW .EQ. 0) THEN IF (M .LE. NA) & J = PTRA(M) IF (M .GT. NA .AND. M .LE. NA+ND) & J = PTRD(M-NA) IF (M .GT. NA+ND .AND. M .LE. NA+ND+NL) & J = PTRL(M-NA-ND) IF (M .GT. NA+ND+NL) & J = PTRO(M-NA-ND-NL) ELSEIF (IW .EQ. 1) THEN J = PTRA(M) ELSEIF (IW .EQ. 2) THEN J = PTRD(M) ELSEIF (IW .EQ. 3) THEN J = PTRL(M) ELSEIF (IW .EQ. 4) THEN J = PTRO(M) ENDIF ERSUM = ERSUM + COVA(L,M) SUM2 = SUM2 + COVA(L,M)*RATIO(J) ENDDO ENDDO RAT = SUM2/ERSUM ERAT = SQRT(1.0/ERSUM) IF (IFRAC .EQ. 1) ERAT = ERAT*RAT ELSE WRITE(60,*) ' MATRIX INVERSION FAILED IN TOT RATIO' WRITE(6, *) ' MATRIX INVERSION FAILED IN TOT RATIO' ENDIF ENDIF ELSE TAU = 0.0 ETAU = 0.0 IF (NW .EQ. 1) THEN L = 1 IF (IW .EQ. 0) THEN IF (L .LE. NA) & I = PTRA(L) IF (L .GT. NA .AND. L .LE. NA+ND) & I = PTRD(L-NA) IF (L .GT. NA+ND .AND. L .LE. NA+ND+NL) & I = PTRL(L-NA-ND) IF (L .GT. NA+ND+NL) & I = PTRO(L-NA-ND-NL) ELSEIF (IW .EQ. 1) THEN I = PTRA(L) ELSEIF (IW .EQ. 2) THEN I = PTRD(L) ELSEIF (IW .EQ. 3) THEN I = PTRL(L) ELSEIF (IW .EQ. 4) THEN I = PTRO(L) ENDIF TAU = TAUB(I) ETAU = (USTA(I)+LSTA(I))*(USTA(I)+LSTA(I))/4.0 DO K = 1, NSYST ETAU = ETAU+(USYS(I,K)+LSYS(I,K))*(USYS(I,K)+LSYS(I,K))/4.0 ENDDO ETAU = SQRT(ETAU) ENDIF IF (LEPB0 .NE. 0.0 .AND. .NOT.LB0) THEN RAT = 0.0 ERAT = 0.0 IF (NW .EQ. 1) THEN L = 1 IF (IW .EQ. 0) THEN IF (L .LE. NA) & I = PTRA(L) IF (L .GT. NA .AND. L .LE. NA+ND) & I = PTRD(L-NA) IF (L .GT. NA+ND .AND. L .LE. NA+ND+NL) & I = PTRL(L-NA-ND) IF (L .GT. NA+ND+NL) & I = PTRO(L-NA-ND-NL) ELSEIF (IW .EQ. 1) THEN I = PTRA(L) ELSEIF (IW .EQ. 2) THEN I = PTRD(L) ELSEIF (IW .EQ. 3) THEN I = PTRL(L) ELSEIF (IW .EQ. 4) THEN I = PTRO(L) ENDIF RAT = RATIO(I) ERAT = EUCOR(I)*EUCOR(I) DO K = 1, NSYST ERAT = ERAT+(USYS(I,K)+LSYS(I,K))*(USYS(I,K)+LSYS(I,K))/4.0 & /(RTIME(I)*RTIME(I)) ENDDO ERAT = SQRT(ERAT) ENDIF ENDIF ENDIF C C CALCULATE CHI-SQUARED AND PROBABILITY C CHI2 = 0 DO L = 1, NW IF (IW .EQ. 0) THEN IF (L .LE. NA) & I = PTRA(L) IF (L .GT. NA .AND. L .LE. NA+ND) & I = PTRD(L-NA) IF (L .GT. NA+ND .AND. L .LE. NA+ND+NL) & I = PTRL(L-NA-ND) IF (L .GT. NA+ND+NL) & I = PTRO(L-NA-ND-NL) ELSEIF (IW .EQ. 1) THEN I = PTRA(L) ELSEIF (IW .EQ. 2) THEN I = PTRD(L) ELSEIF (IW .EQ. 3) THEN I = PTRL(L) ELSEIF (IW .EQ. 4) THEN I = PTRO(L) ENDIF IF (TAUB(I) .GT. TAU) THEN ERR = (LSTA(I)*LSTA(I)) DO K = 1, NSYST ERR = ERR + (LSYS(I,K)*LSYS(I,K)) ENDDO ELSE ERR = (USTA(I)*USTA(I)) DO K = 1, NSYST ERR = ERR + (USYS(I,K)*USYS(I,K)) ENDDO ENDIF CHI2 = CHI2 + (TAUB(I)-TAU)*(TAUB(I)-TAU)/ERR ENDDO TAUPRB = 0.0 IF (NW .GT. 1) THEN TAUPRB = PROB(CHI2,NW-1) ENDIF IF (LEPB0 .NE. 0.0 .AND. .NOT.LB0) THEN CHI2 = 0 DO L = 1, NW IF (IW .EQ. 0) THEN IF (L .LE. NA) & I = PTRA(L) IF (L .GT. NA .AND. L .LE. NA+ND) & I = PTRD(L-NA) IF (L .GT. NA+ND .AND. L .LE. NA+ND+NL) & I = PTRL(L-NA-ND) IF (L .GT. NA+ND+NL) & I = PTRO(L-NA-ND-NL) ELSEIF (IW .EQ. 1) THEN I = PTRA(L) ELSEIF (IW .EQ. 2) THEN I = PTRD(L) ELSEIF (IW .EQ. 3) THEN I = PTRL(L) ELSEIF (IW .EQ. 4) THEN I = PTRO(L) ENDIF IF (RATIO(I) .GT. RAT) THEN ERR = EUCOR(I)*EUCOR(I) DO K = 1, NSYST ERR = ERR + (LSYS(I,K)*LSYS(I,K)) & /(RTIME(I)*RTIME(I)) ENDDO ELSE ERR = EUCOR(I)*EUCOR(I) DO K = 1, NSYST ERR = ERR + (USYS(I,K)*USYS(I,K)) & /(RTIME(I)*RTIME(I)) ENDDO ENDIF CHI2 = CHI2 + (RATIO(I)-RAT)*(RATIO(I)-RAT)/ERR ENDDO RATPRB = 0.0 IF (NW .GT. 1) THEN RATPRB = PROB(CHI2,NW-1) ENDIF ENDIF RETURN END C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = SUBROUTINE TIMINV(IFAIL,NTOT) C= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = C C THIS IS THE TEDIOUS WAY TO TO THIS, BUT I AM BEING LAZY NOW. C C AUTHOR:- C ======== C TIM HESSING, CERN-PPE/LEP-DELPHI C C DATE/HISTORY:- C ============== C 27-APRIL-1994: CREATED-TLH C IMPLICIT NONE C C DECLARATIONS:- C ============== INTEGER IFAIL INTEGER I, J, NTOT REAL*4 COV02( 2, 2) REAL*4 COV03( 3, 3) REAL*4 COV04( 4, 4) REAL*4 COV05( 5, 5) REAL*4 COV06( 6, 6) REAL*4 COV07( 7, 7) REAL*4 COV08( 8, 8) REAL*4 COV09( 9, 9) REAL*4 COV10(10,10) REAL*4 COV11(11,11) REAL*4 COV12(12,12) REAL*4 COV13(13,13) REAL*4 COV14(14,14) REAL*4 COV15(15,15) REAL*4 COV16(16,16) REAL*4 COV17(17,17) REAL*4 COV18(18,18) REAL*4 COV19(19,19) REAL*4 COV20(20,20) REAL*4 COV21(21,21) REAL*4 COV22(22,22) REAL*4 COV23(23,23) REAL*4 COV24(24,24) REAL*4 COV25(25,25) C C COMMON VARIABLES C C IFRAC EQ 1 IMPLIES USE FRACTIONAL ERRORS C IFRAC NE 2 IMPLIES USE ABSOLUTE ERRORS C INTEGER IFRAC PARAMETER (IFRAC = 1) C C MAXIMUM NUMBER OF MEASUREMENTS TO COMBINE C INTEGER MXMEAS PARAMETER (MXMEAS = 25) C C MAXIMUM NUMBER OF SYSTEMATICS FOR EACH MEASUREMENT C INTEGER MXSYST PARAMETER (MXSYST = 50) C C IMPORTANT NUMBERS C INTEGER NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC INTEGER PTRA(MXMEAS), PTRD(MXMEAS) INTEGER PTRL(MXMEAS), PTRO(MXMEAS) REAL*4 TAUB(MXMEAS) REAL*4 USTA(MXMEAS), LSTA(MXMEAS) REAL*4 USYS(MXMEAS,MXSYST), LSYS(MXMEAS,MXSYST) REAL*4 CORR(MXMEAS,MXMEAS), COVA(MXMEAS,MXMEAS) REAL*4 TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB REAL*4 RATIO(MXMEAS), EUCOR(MXMEAS), RTIME(MXMEAS) LOGICAL LB0, LBP, LBS, LLB, LAV, LRT COMMON/TAUAVG/ NMEAS, NSYST, CNTM, NA, ND, NL, NO, NS, NC, & PTRA, PTRD, & PTRL, PTRO, & TAUB, & USTA, LSTA, & USYS, LSYS, & CORR, COVA, & TAU, ETAU, TAUPRB, RAT, ERAT, RATPRB, & RATIO, EUCOR, RTIME, & LB0, LBP, LBS, LLB, LAV, LRT C C C FORMAT STATEMENTS:- C =================== C C EXECUTABLE CODE:- C ================= IF (NTOT .EQ. 2) THEN DO I = 1, NTOT DO J = 1, NTOT COV02(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV02, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV02(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 3) THEN DO I = 1, NTOT DO J = 1, NTOT COV03(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV03, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV03(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 4) THEN DO I = 1, NTOT DO J = 1, NTOT COV04(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV04, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV04(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 5) THEN DO I = 1, NTOT DO J = 1, NTOT COV05(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV05, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV05(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 6) THEN DO I = 1, NTOT DO J = 1, NTOT COV06(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV06, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV06(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 7) THEN DO I = 1, NTOT DO J = 1, NTOT COV07(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV07, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV07(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 8) THEN DO I = 1, NTOT DO J = 1, NTOT COV08(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV08, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV08(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 9) THEN DO I = 1, NTOT DO J = 1, NTOT COV09(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV09, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV09(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 10) THEN DO I = 1, NTOT DO J = 1, NTOT COV10(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV10, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV10(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 11) THEN DO I = 1, NTOT DO J = 1, NTOT COV11(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV11, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV11(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 12) THEN DO I = 1, NTOT DO J = 1, NTOT COV12(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV12, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV12(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 13) THEN DO I = 1, NTOT DO J = 1, NTOT COV13(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV13, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV13(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 14) THEN DO I = 1, NTOT DO J = 1, NTOT COV14(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV14, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV14(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 15) THEN DO I = 1, NTOT DO J = 1, NTOT COV15(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV15, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV15(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 16) THEN DO I = 1, NTOT DO J = 1, NTOT COV16(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV16, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV16(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 17) THEN DO I = 1, NTOT DO J = 1, NTOT COV17(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV17, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV17(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 18) THEN DO I = 1, NTOT DO J = 1, NTOT COV18(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV18, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV18(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 19) THEN DO I = 1, NTOT DO J = 1, NTOT COV19(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV19, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV19(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 20) THEN DO I = 1, NTOT DO J = 1, NTOT COV20(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV20, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV20(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 21) THEN DO I = 1, NTOT DO J = 1, NTOT COV21(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV21, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV21(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 22) THEN DO I = 1, NTOT DO J = 1, NTOT COV22(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV22, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV22(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 23) THEN DO I = 1, NTOT DO J = 1, NTOT COV23(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV23, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV23(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 24) THEN DO I = 1, NTOT DO J = 1, NTOT COV24(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV24, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV24(I,J) ENDDO ENDDO ELSEIF (NTOT .EQ. 25) THEN DO I = 1, NTOT DO J = 1, NTOT COV25(I,J) = COVA(I,J) ENDDO ENDDO CALL RSINV(NTOT, COV25, NTOT, IFAIL) DO I = 1, NTOT DO J = 1, NTOT COVA(I,J) = COV25(I,J) ENDDO ENDDO ENDIF RETURN END