+PATCH,$CORR. +DECK,CORR1. Updates version: 3.02/00 to 3.07/00 +REP,*TITLE*,TITLE,1. * CBKFIT 3.07/00 01/04/95 17.59.52 +ADD,$VERSION,V3_03,*. &DECK,V3_03. *CMZU: 3.03/00 02/03/95 17.04.54 by Pal Hidas *-- Author : Pal Hidas 02/03/95 * *::> VERSION 3.03/00 02/03/95 17.04.53 * With the help of a new TCVERT LOCATER able to fit several * vertices. Using this vertex information it is possible to * fit X KSH KSH, KSH -> PI+ PI-, PI+ PI- where X can be * any group of particles or resonances. One can do it setting * CFKSCC=.TRUE. * * For the future collider data a CFCOLL logical variable is * introduced, which increases the total energy. * * CFCOMMON is modified : new logicals (CFCOLL, CFKSCC) in CFCOMS, * the size of the arrays CHVMOM and CHVPAR is changed. * +ADD,$VERSION,V3_04,*. &DECK,V3_04. *CMZU: 3.04/02 07/03/95 18.02.45 by Pal Hidas *CMZ : 3.04/01 06/03/95 11.39.50 by Pal Hidas *CMZ : 3.04/00 05/03/95 19.28.09 by Pal Hidas *-- Author : Pal Hidas 05/03/95 * *::> VERSION 3.04/02 07/03/95 18.02.44 * A new integer IDRVCF(10) array is introduced to CFCOMMON * which you can fill up with the TCVX numbers of vertices * with respect of which you do not want to do the CFCHCR * correction of charged momenta. This is necessary if you * want to analyse events with several (ambiguous) vertices * wgich contain the same tracks. * *::> VERSION 3.04/01 06/03/95 11.39.50 * You can set CFBEAM for the collider option CFCOLL * *::> VERSION 3.04/00 05/03/95 19.28.08 * * To fit Klong whose energy is "bad", e.g. it has an energy * deposit in the barrel. The energy value not but the direction * of this ped is used in the fit. CFCOMMON is modified, an integer * variable BADKL is introduced, which should be set to the TTKS * number of the Klong ped. See the manual for details. * This is CASE=3 fit. * * I just underline, that it is also possible to fit missing Klongs * with the MISSKL logical (CASE=2). +ADD,$VERSION,V3_05,*. &DECK,V3_05. *CMZU: 3.05/01 31/03/95 14.52.30 by Pal Hidas *CMZ : 3.05/00 28/03/95 11.53.50 by Pal Hidas *-- Author : Pal Hidas 28/03/95 * *::> VERSION 3.05/01 31/03/95 14.52.29 * * work version * *::> VERSION 3.05/00 28/03/95 11.53.50 * * New missing particle fits are included which are more easy * to generalize. The real variable CFMISX and the integer * BADXCF are introduced in CFCOMMON. Setting CFMISX to a mass * value one can fit a missing particle X, if you set BADXCF to * a TTKS id, then only the energy is handled as missing variable. * Please contact the new manual also (susections 3.6 and 3.9 for * these new CASE=11,12 fits). +ADD,$VERSION,V3_06,*. &DECK,V3_06. *CMZU: 3.06/00 31/03/95 15.17.19 by Pal Hidas *-- Author : Pal Hidas 31/03/95 * *::> VERSION 3.06/00 31/03/95 15.17.19 * * CASE=9, Kshort neutral decay vertex fit with missing Klong * Set the logical variable CFKSKM to be true. * +ADD,$VERSION,V3_07,*. &DECK,V3_07. *CMZU: 3.07/00 01/04/95 17.59.52 by Pal Hidas *-- Author : Pal Hidas 01/04/95 * *::> VERSION 3.07/00 01/04/95 17.59.52 * * CASE=10, Kshort neutral decay vertex fit with bad Klong * e.g. when the Klong has an energy deposit in the crystals * so we know its direction, but not the energy. KSKBCF should * be the TTKS id of the Klong. * +ADD,CFCOMMON,CFCOMMON,0. *CMZU: 3.05/01 29/03/95 15.35.29 by Pal Hidas *CMZ : 3.05/00 25/03/95 19.03.01 by Pal Hidas *CMZ : 3.04/02 07/03/95 17.23.04 by Pal Hidas *CMZ : 3.04/00 04/03/95 16.36.26 by Pal Hidas *CMZ : 3.03/00 01/03/95 18.20.12 by Pal Hidas +REP,CFCOMMON,CFCOMMON,85-98. I ,NPOS,NNEG,NNE,IEVEF,CFTAKH,BADTRA,BADNEU,NPI0CF I ,MERPI0,BADKL,IDRVCF,MNVXCF,IMNNEU,KSKBCF,BADXCF R ,CHISQ,CUTCL,CFBEAM,CFMISM,CFVTER,CFMIER,CFMISX L ,MISGAM,MISSKL,MISNEU,MISPRO,CFTRHY,CFTRSU,CFDBUG L ,FPUTZ,CFVERT,CFVRTZ,CFSUPC,CFDEUT,CFORCE,CFGCOV L ,CFIGNR,CFVERZ,CFVERA,CFKS00,CFCHCR,CFKSCC L ,CFCOLL,CFKSKM SAVE /CFVARS/ INTEGER NXTCMB(NPMAX),MEASCO(NPMAX),EVTYPE(6),CFCODE(NCDMAX) INTEGER NPOS,NNEG,NNE,IEVEF,CFTAKH,BADTRA,BADNEU,NPI0CF INTEGER MERPI0(NRMAX),BADKL,IDRVCF(10),MNVXCF,IMNNEU(NPMAX) INTEGER KSKBCF,BADXCF REAL CHISQ,CUTCL,CFBEAM,CFMISM,CFVTER(3),CFMIER(6),CFMISX LOGICAL MISGAM,MISSKL,MISNEU,MISPRO,CFTRHY,CFTRSU,CFDBUG LOGICAL FPUTZ,CFVERT,CFVRTZ,CFSUPC,CFDEUT,CFORCE,CFGCOV LOGICAL CFIGNR,CFVERZ,CFVERA,CFKS00,CFCHCR,CFKSCC LOGICAL CFCOLL,CFKSKM +ADD,CFCOMMON,CFCOMMON,117. * CFVTER : ERRORSQ ON VERTEX "MEASURMENT" (X,Y,Z) * CFMIER : "COVARIANCE MATRIX ON MISSING PARTICLE" +ADD,CFCOMMON,CFCOMMON,129. * CFKSCC : LOGICAL FLAG TO FIT XKSKS,KS -> PI+,PI- BOTH +ADD,CFCOMMON,CFCOMMON,137. * BADKL : TTKS NUMBER OF KLONG WITH BAD ENERGY +REP,CFCOMMON,CFCOMMON,293. DOUBLE PRECISION CHVMOM(3,4),CHVPAR(3,4),CHKMOM(3) +REP,CFCOMMON,CFCOMMON,331-332. C 2 => NEUTRAL C 3 => MISSING CHARGED C 4 => MISSING NEUTRAL C 5 => MISSING (OLD METHOD,CASE=2,3) C 6 => CHARGED WITH MISSING ENERGY C 7 => NEUTRAL WITH MISSING ENERGY +REP,CFCOMMON,CFCOMMON,343-347. C MISSING (SQRT(E)) C 6 => Z-VERTEX FIT, ALL NEUTRALS, NOTHING C MISSING (PHI,SQRT(E),LAMBDA) C 7 => VERTEX FIT, ALL NEUTRALS, NOTHING C MISSING (PHI,SQRT(E),LAMBDA) C 8 => KSHORT VERTEX FIT, FIXED MAIN VERTEX C NOTHING MISSING C 9 => KSHORT VERTEX FIT, FIXED MAIN VERTEX C MISSING KLONG C 10 => KSHORT VERTEX FIT, FIXED MAIN VERTEX C BAD KLONG (ENERGY MISSING) C 11 => MISSING 3-MOMENTA, MISSING MASS IS C KNOWN C 12 => MISSING ENERGY, MISSING MASS C AND DIRECTION KNOWN +ADD,CFCOMMON,CFCOMMON,355. C (OLD METHOD, CASE=3) +ADD,CBKFIT,CFNSQD,0. *CMZU: 3.05/01 29/03/95 16.03.34 by Pal Hidas *CMZ : 3.05/00 27/03/95 11.50.17 by Pal Hidas *CMZ : 3.03/00 26/02/95 11.50.52 by Pal Hidas +REP,CBKFIT,CFNSQD,52-54. REAL DELCHI INTEGER NITER,IC,NVARC,IRET +REP,CBKFIT,CFNSQD,63. INTEGER I,K,MU,NU,IDGT,IER,N,III,NNC,JJJ,NPAR1,IRC,NPAR2 +REP,CBKFIT,CFNSQD,70-71. NPAR2=NPART ELSEIF(CASE.EQ.9.OR.CASE.EQ.10) THEN NPAR1=NPART-4 NPAR2=NPART-1 ELSE NPAR1=1 NPAR2=NPART +REP,CBKFIT,CFNSQD,160-162. CALL CFUPDA(IRET) C IF(CFDBUG) WRITE(LDBG,'('' RETURNED FROM CFUPDA'')') C IF(IRET.LT.0) THEN IF(CFDBUG) WRITE(LDBG,'(''LEAVE CFNSQD, IRET='',I3)') IRET RETURN ENDIF +REP,CBKFIT,CFNSQD,213-215. *************** * case=1-3,6-12 *************** +REP,CBKFIT,CFNSQD,398-400. *************** * case=1-3,6-12 *************** +REP,CBKFIT,CFNSQD,489. IF(ITER.LE.2.AND.CASE.GE.8) GOTO 233 +REP,CBKFIT,CFNSQD,502-504. *************** * case=1-3,6-12 *************** +REP,CBKFIT,CFNSQD,545. ELSEIF(CASE.GE.8.AND.CASE.LE.10) THEN +REP,CBKFIT,CFNSQD,552-557. ********** *case=6-12 ********** C-- CALCULATE NEW BQRS IF(CASE.GE.6.AND.CASE.LE.10) THEN DO 252 I=NPAR1,NPAR2 +REP,CBKFIT,CFNSQD,570. WRITE(LDBG,'('' NPAR1,NPAR2,I :'',3I5)') NPAR1,NPAR2,I +REP,CBKFIT,CFNSQD,594-596. *********************** * case=1,2,3,6,7,8,9,10 *********************** +ADD,CBKFIT,CFKINI,0. *CMZU: 3.07/00 01/04/95 12.48.01 by Pal Hidas *CMZ : 3.05/01 31/03/95 12.06.16 by Pal Hidas *CMZ : 3.05/00 27/03/95 11.13.43 by Pal Hidas *CMZ : 3.04/01 06/03/95 11.24.42 by Pal Hidas *CMZ : 3.04/00 05/03/95 16.16.26 by Pal Hidas *CMZ : 3.03/00 26/02/95 10.44.59 by Pal Hidas +REP,CBKFIT,CFKINI,72-82. DOUBLE PRECISION S,C,PSQ,RP,PP,CL,SL,PXY DOUBLE PRECISION EPSZ /0.2D0/ DOUBLE PRECISION EPSK /0.05D0/ DOUBLE PRECISION ZINCMX /70.D0/ REAL RMK,EMISS,MM LOGICAL EM,RES INTEGER EMR1,EMR2,JRES,M,N,IG,K,IC,I,II,ITYP,ICHAR,JJ INTEGER J,L,IIP1,III,INMAX,ICP1,ICP2,IRC,JUMP,IW(3),IFAIL INTEGER NPAR1,NPAR2 C IRC=0 NC=NC+4 IF(CASE.GE.8.AND.CASE.LE.10) NC=NC+3 +REP,CBKFIT,CFKINI,95-99. ***************** * case = 1-3,6-12 ***************** IF(CASE.LE.3.OR.CASE.GE.6) THEN II=0 C IF(CFDBUG) THEN WRITE(LDBG,'(''ISPE :'',12I3)') (ISPE(I),I=1,NPART) WRITE(LDBG,'(''KTYPE :'',12I3)') (KTYPE(I),I=1,NPART) WRITE(LDBG,'(''MISSI0,MISSID :'',2I3)') MISSI0,MISSID ENDIF C +REP,CBKFIT,CFKINI,106-158. J=NXTCMB(I) C...JUMP MISSING PARTICLE IF(CASE.EQ.2.AND.J.EQ.MISSI0) THEN GOTO 30 ELSEIF((CASE.EQ.9.OR.CASE.EQ.11).AND.J.EQ.MISSI0) THEN II=II+1 GOTO 30 ELSE II=II+1 ENDIF ***************** * case = 1-3,6-12 ***************** X(3*II-2)=XM(3*J-2) C...CHARGED TRACK ICP1=IQ(LQ(LTTKS-IQ(LTTKS-2)-MEASCO(J))+4) IF(ICP1.NE.0) THEN IF(ISPE(II).NE.0) THEN X(3*II-1)=XM(3*J-1) VAR(2,II)=ERR(2,J) VAR(3,II)=ERR(3,J) VAR(5,II)=ERR(5,J) ELSE IIP1=II ICP2=ICP1 ENDIF X(3*II)=XM(3*J) VAR(1,II)=ERR(1,J) VAR(4,II)=ERR(4,J) VAR(6,II)=ERR(6,J) C...PED ELSE X(3*II-1)=XM(3*J-1) VAR(1,II)=ERR(1,J) IF(CFGCOV) VAR(2,II)=ERR(2,J) VAR(3,II)=ERR(3,J) C IF(ISPE(II).NE.0) THEN X(3*II)=XM(3*J) EN(II)=X(3*II)**2 PPP(II)=EN(II) C IF(CFDBUG) THEN WRITE(LDBG,'('' EN,MASS :'',2G14.6)') EN(II),MASS(II) ENDIF C IF(CASE.NE.10.AND.CASE.NE.12.OR.J.NE.MISSI0) THEN IF(MASS(II).GE.1.E-4) PPP(II)=DSQRT(EN(II)**2-MASS(II)**2) IF(CFGCOV) THEN VAR(4,II)=ERR(4,J) VAR(5,II)=ERR(5,J) ENDIF VAR(6,II)=ERR(6,J) ENDIF +REP,CBKFIT,CFKINI,164-168. IIP1=II ICP2=ICP1 ENDIF ENDIF 30 CONTINUE C +REP,CBKFIT,CFKINI,240-245. IF(.NOT.CFCOLL) THEN PMISS(3)=CFBEAM ELSE PMISS(3)=0. ENDIF WRITE(LDBG,'(''IEVEF,NPART,NVAR,CASE='',4I8)') & IEVEF,NPART,NVAR,CASE C DO 233 IG=1,NPART RO(IG)=DSQRT(BQRS(1,IG)**2+BQRS(2,IG)**2+ +REP,CBKFIT,CFKINI,272. 10 CONTINUE IF(.NOT.CFCOLL) THEN SUMGF=-CFBEAM ELSE SUMGF=0. ENDIF +REP,CBKFIT,CFKINI,298-302. GOTO 199 ENDIF C IF (DABS(WNEXT-VERT(3)).LT.EPSZ) THEN IF(CASE.EQ.6.AND.CFBEAM.GT.1500..AND..NOT.CFCOLL) THEN +REP,CBKFIT,CFKINI,310-315. GOTO 199 ENDIF C VERT(3)=WNEXT GOTO 10 199 VERT(1)=0.0D0 +REP,CBKFIT,CFKINI,324. IF(CASE.GE.8.AND.CASE.LE.10) THEN +REP,CBKFIT,CFKINI,338-340. C IF(CASE.EQ.8) THEN NPAR1=NPART-3 NPAR2=NPART ELSEIF(CASE.EQ.9.OR.CASE.EQ.10) THEN NPAR1=NPART-4 NPAR2=NPART-1 ENDIF C C...GAMMA AND KSHORT 4-MOMENTA C DO 360 J=NPAR1,NPAR2 JJ=J-NPAR2+4 +REP,CBKFIT,CFKINI,361. PPK=DSQRT(EK**2-MK**2) +REP,CBKFIT,CFKINI,387. R=DSQRT(U(1)**2+U(2)**2+U(3)**2) +REP,CBKFIT,CFKINI,400-403. FQE(I,J)=BQRS(I,NPAR2-4+J)-U(I) Y(J)=Y(J)+(FQE(I,J))**2 402 CONTINUE Y(J)=DSQRT(Y(J)) +REP,CBKFIT,CFKINI,554. IF(CASE.GE.8.AND.CASE.LE.10) THEN +REP,CBKFIT,CFKINI,565-567. ******************** * not used from here ******************** +ADD,CBKFIT,CFKINI,585. ********* * to here ********* C C -- INITIAL VALUES OF MISSING PARTICLES (CASE >= 9) C IF(CASE.GE.9) THEN C...missing 4-momentum CALL DLRMEM(PMISS,4) PMISS(4)=ETOT IF(.NOT.CFCOLL) THEN PMISS(3)=CFBEAM ELSE PMISS(3)=0. ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'(''PMISS(INIT)='',4G14.6)') (PMISS(III),III=1,4) ENDIF C NSUM=NPART KTYPE(NPART)=2 ISPE(NPART)=1 C DO 600 IG=1,NPART-1 C IF(IG.EQ.MISSID) THEN WRITE(LERR,'(''*** ERROR *** CFKINI :NOT LAST MISS.PART.'')') ENDIF C IF(KTYPE(IG).EQ.1) THEN C M=3*(IG-1) S=SIN(X(M+1)) C=COS(X(M+1)) PSQ=(1.D0+X(M+3)**2)/X(M+2)**2 PFIT(1,IG)=C/X(M+2) PFIT(2,IG)=S/X(M+2) PFIT(3,IG)=X(M+3)/X(M+2) PFIT(4,IG)=DSQRT(PSQ+MASS(IG)**2) C IF(CFDBUG) THEN WRITE(LDBG,'(''PFIT='',4G14.6)') (PFIT(III,IG),III=1,4) ENDIF C ELSEIF(KTYPE(IG).EQ.2) THEN C IF(CASE.EQ.11.OR.CASE.EQ.12.OR. & (CASE.EQ.9.OR.CASE.EQ.10).AND.IG.LT.(NPART-4)) THEN M=3*(IG-1) C=COS(X(M+1)) S=SIN(X(M+1)) PP=X(M+3)**2 CL=COS(X(M+2)) SL=SIN(X(M+2)) IF((MASS(IG).GE.1.E-4)) PP=DSQRT(PP**2-MASS(IG)**2) PXY=PP*CL PFIT(1,IG)=C*PXY PFIT(2,IG)=S*PXY PFIT(3,IG)=PP*SL PFIT(4,IG)=X(M+3)**2 C IF(CFDBUG) THEN WRITE(LDBG,'(''PFIT='',4G14.6)') (PFIT(III,IG),III=1,4) ENDIF C ELSEIF((CASE.EQ.9.OR.CASE.EQ.10).AND.IG.GE.(NPART-4)) THEN II=IG-NPART+5 RO(IG)=DSQRT((BQRS(1,IG)-KSVT(1))**2 & +(BQRS(2,IG)-KSVT(2))**2 & +(BQRS(3,IG)-KSVT(3))**2) C IF(CFDBUG) THEN WRITE(LDBG,'(''IG='',I2,'' RO='',G14.6)') IG,RO(IG) ENDIF C PFIT(1,IG)=PPP4(II)*(BQRS(1,IG)-KSVT(1))/RO(IG) PFIT(2,IG)=PPP4(II)*(BQRS(2,IG)-KSVT(2))/RO(IG) PFIT(3,IG)=PPP4(II)*(BQRS(3,IG)-KSVT(3))/RO(IG) PFIT(4,IG)=EN4(II) C IF(CFDBUG) THEN WRITE(LDBG,'(''PFIT='',4G14.6)') (PFIT(III,IG),III=1,4) ENDIF C ENDIF C ELSE WRITE(LERR,'(''*** ERROR *** CFKINI :MISPLACED MISS.PART.'')') ENDIF C DO 580 K=1,4 PMISS(K)=PMISS(K)-PFIT(K,IG) 580 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'(''PMISS(INIT)='',4G14.6)') (PMISS(III),III=1,4) ENDIF MM=PMISS(4)**2-PMISS(3)**2-PMISS(2)**2-PMISS(1)**2 IF(CFDBUG) WRITE(LDBG,'(''MISS. MASS SQUARED :'',G12.4)') MM IF(MM.GT.0.) THEN MM=SQRT(MM) IF(CFDBUG) WRITE(LDBG,'('' MISSING MASS :'',G12.4)') MM ENDIF C 600 CONTINUE C...parameters (for neutrals only now) EMISS=PMISS(4) IF(EMISS.GT.MASS(NPART)) THEN X(3*NPART)=DSQRT(PMISS(4)) VAR(6,NPART)=CFMIER(6) X0(3*NPART)=X(3*NPART) IF(CASE.EQ.9.OR.CASE.EQ.11) THEN RP=DSQRT(PMISS(1)**2+PMISS(2)**2+PMISS(3)**2) X(3*NPART-2)=DATAN2(PMISS(2),PMISS(1)) X(3*NPART-1)=DASIN(PMISS(3)/RP) VAR(1,NPART)=CFMIER(1) VAR(3,NPART)=CFMIER(3) X0(3*NPART-2)=X(3*NPART-2) X0(3*NPART-1)=X(3*NPART-1) ENDIF ELSE IRC=-6 IF(CFDBUG) THEN WRITE(LDBG,'(''DROPPED BY CFKINI, IRC=-6'')') ENDIF IF(CFTRHY) THEN WRITE(LLOG,'(''DROPPED BY CFKINI, IRC=-6'')') ENDIF RETURN ENDIF C ENDIF +ADD,CBKFIT,CFSQPL,0. *CMZU: 3.05/00 27/03/95 16.18.30 by Pal Hidas *CMZ : 3.03/00 26/02/95 10.50.53 by Pal Hidas +REP,CBKFIT,CFSQPL,31-33. ***************** * case = 1-3,6-12 ***************** +REP,CBKFIT,CFSQPL,39. C IF(RC.NE.0) GOTO 10 +REP,CBKFIT,CFSQPL,49. WRITE(LERR,'(''*** ERROR *** CFSQPL IER='',I4)') IER +REP,CBKFIT,CFSQPL,76-79. SIGX(I)=SQRT(ABS(VAR(IDIAG(JVAR),IPART))) C IF(SIGSQ(I).GT.0.) THEN PULL(I)=DELX(I)/SQRT(ABS(SIGSQ(I))) +REP,CBKFIT,CFSQPL,167. RETURN +ADD,CBKFIT,CFUPDA,0. *CMZU: 3.06/00 31/03/95 14.59.09 by Pal Hidas *CMZ : 3.05/01 30/03/95 16.09.23 by Pal Hidas *CMZ : 3.05/00 27/03/95 12.45.22 by Pal Hidas *CMZ : 3.04/01 06/03/95 11.25.44 by Pal Hidas *CMZ : 3.03/00 27/02/95 09.17.57 by Pal Hidas +REP,CBKFIT,CFUPDA,20. SUBROUTINE CFUPDA(IRET) +REP,CBKFIT,CFUPDA,64-67. INTEGER NVAR1,ICC,JUMP,IP,NPAR2,IRET REAL RMK,PM * * IRET=0 +REP,CBKFIT,CFUPDA,77-81. PMISS(4)=ETOT DO 10 I=1,3 IF(CASE.LE.7) THEN VERW(I)=VERT(I) ELSEIF(CASE.GE.8) THEN +REP,CBKFIT,CFUPDA,91-95. IF(.NOT.CFCOLL) THEN PMISS(3)=CFBEAM ELSE PMISS(3)=0. ENDIF C ***************** * case = 1-3,6-12 ***************** +REP,CBKFIT,CFUPDA,103-143. ********** * case = 2 ********** C-- ONE PARTICLE IS MISSING IF(CASE.EQ.2) THEN IF(IG.EQ.MISSID) THEN N=N+3 GOTO 301 ENDIF ENDIF ********** * case = 3 ********** C-- ONE GAMMA'S ENERGY IS MISSING IF(CASE.EQ.3) THEN IF(IG.EQ.MISSID) THEN N=N+3 M=M+2 GOTO 301 ENDIF ENDIF ***************** * case = 1-3,8-12 ***************** K=KTYPE(IG) GOTO (310,320), K C-- CHARGED (PHI,1/PXY,TAN(LAMBDA)) 310 CONTINUE IF(CASE.LE.3.OR.CASE.EQ.8.AND.(NPART-IG).GE.4.OR. & (CASE.EQ.9.OR.CASE.EQ.10).AND. & ((NPART-IG).GE.5.OR.NPART.EQ.IG) & .OR.CASE.GE.11) THEN C IF((CASE.EQ.9.OR.CASE.EQ.10).AND.NPART.EQ.IG) THEN WRITE(LERR,'(''*** ERROR *** CFUPDA : CHARGED KLONG'')') GOTO 340 ENDIF C S=SIN(X(M+1)) C=COS(X(M+1)) PSQ=(1.D0+X(M+3)**2)/X(M+2)**2 PFIT(1,IG)=C/X(M+2) PFIT(2,IG)=S/X(M+2) PFIT(3,IG)=X(M+3)/X(M+2) PFIT(4,IG)=DSQRT(PSQ+MASS(IG)**2) DPDX(N+1,1)=-PFIT(2,IG) DPDX(N+1,2)=PFIT(1,IG) DPDX(N+2,1)=-PFIT(1,IG)/X(M+2) DPDX(N+2,2)=-PFIT(2,IG)/X(M+2) DPDX(N+2,3)=-PFIT(3,IG)/X(M+2) DPDX(N+2,4)=-PSQ/X(M+2)/PFIT(4,IG) DPDX(N+3,3)=1.D0/X(M+2) DPDX(N+3,4)=PFIT(3,IG)/X(M+2)/PFIT(4,IG) GOTO 340 +REP,CBKFIT,CFUPDA,152. ELSEIF(CASE.GE.8) THEN +REP,CBKFIT,CFUPDA,159-193. IF(CASE.LE.3.OR.CASE.EQ.8.AND.(NPART-IG).GE.4.OR. & (CASE.EQ.9.OR.CASE.EQ.10).AND. & ((NPART-IG).GE.5.OR.NPART.EQ.IG) & .OR.CASE.GE.11) THEN C C=COS(X(M+1)) S=SIN(X(M+1)) PP=X(M+3)**2 CL=COS(X(M+2)) SL=SIN(X(M+2)) IF(MASS(IG).GE.1.E-4) THEN PM=PP IF(PM.GT.MASS(IG)) THEN PP=DSQRT(PP**2-MASS(IG)**2) ELSE IF(CFDBUG) THEN WRITE(LDBG,'(''DROPPED BY CFUPDA,IRET=-1'')') ENDIF IF(CFTRHY) THEN WRITE(LDBG,'(''DROPPED BY CFUPDA,IRET=-1'')') ENDIF IRET=-1 RETURN ENDIF ENDIF PXY=PP*CL PFIT(1,IG)=C*PXY PFIT(2,IG)=S*PXY PFIT(3,IG)=PP*SL PFIT(4,IG)=X(M+3)**2 C-- PHI -- DPDX(N+1,1)=-PFIT(2,IG) DPDX(N+1,2)=PFIT(1,IG) C-- SQRT(E) -- FACTOR=2.D0/X(M+3) C-- for one ped pi0 and eta IF(MASS(IG).GE.1.E-4) FACTOR=2.D0*X(M+3)**3/PP**2 C-- DPDX(N+3,1)=FACTOR*PFIT(1,IG) DPDX(N+3,2)=FACTOR*PFIT(2,IG) DPDX(N+3,3)=FACTOR*PFIT(3,IG) DPDX(N+3,4)=2.D0*X(M+3) C-- LAMBDA DERIVATIVES -- DPDX(N+2,1)=-C*PP*SL DPDX(N+2,2)=-S*PP*SL DPDX(N+2,3)=PP*CL ********** * case = 6 ********** ELSEIF(CASE.EQ.6) THEN RO(IG)=DSQRT((BQRS(1,IG)-VERW(1))**2+(BQRS(2,IG)-VERW(2))**2 & +(BQRS(3,IG)-VERW(3))**2) TRO(IG)=DSQRT(BQRS(1,IG)**2+BQRS(2,IG)**2+BQRS(3,IG)**2) +REP,CBKFIT,CFUPDA,228-234. ************* * case = 7-10 ************* ELSEIF(CASE.EQ.7.OR.CASE.EQ.8.AND.(NPART-IG).LT.4.OR. & (CASE.EQ.9.OR.CASE.EQ.10).AND. & (NPART-IG).LE.5.AND.NPART.NE.IG) THEN RO(IG)=DSQRT((BQRS(1,IG)-VERW(1))**2+(BQRS(2,IG)-VERW(2))**2 & +(BQRS(3,IG)-VERW(3))**2) TRO(IG)=DSQRT(BQRS(1,IG)**2+BQRS(2,IG)**2+BQRS(3,IG)**2) +REP,CBKFIT,CFUPDA,252. Y=DSQRT(Y1**2+Y2**2+Y3**2) +REP,CBKFIT,CFUPDA,280-288. ***************** * case = 1-3,6-12 ***************** 340 CONTINUE DO 341 K=1,4 PMISS(K)=PMISS(K)-PFIT(K,IG) 341 CONTINUE N=N+3 M=M+3 +REP,CBKFIT,CFUPDA,308-310. RO(IG)=DSQRT((BQRS(1,IG)-VERW(1))**2+(BQRS(2,IG)-VERW(2))**2 &+(BQRS(3,IG)-VERW(3))**2) TRO(IG)=DSQRT(BQRS(1,IG)**2+BQRS(2,IG)**2+BQRS(3,IG)**2) +REP,CBKFIT,CFUPDA,431-443. ***************** * case = 1-3,6-12 ***************** IF(CASE.EQ.2) GOTO 470 IF(CASE.EQ.3) GOTO 370 IF(CASE.EQ.4.OR.CASE.EQ.5) GOTO 1999 *************** * case = 1,6-10 *************** C-- NOTHING IS MISSING C IF(CASE.EQ.6) THEN NVAR6=NVAR-1 ELSEIF(CASE.GE.7.AND.CASE.LE.10) THEN +REP,CBKFIT,CFUPDA,451-458. NPAR2=NPART ELSEIF(CASE.EQ.9.OR.CASE.EQ.10) THEN NPAR1=NPART-4 NPAR2=NPART-1 ELSE NPAR1=1 NPAR2=NPART ENDIF C DO 351 IC=1,4 F(IC)=-PMISS(IC) DO 381 LP=1,NVAR6 DFDX(LP,IC)=DPDX(LP,IC) +REP,CBKFIT,CFUPDA,464-470. IF(CASE.GE.6.AND.CASE.LE.10) THEN DO 352 IG=NPAR1,NPAR2 C EN(IG)=X(3*IG)**2 PPP(IG)=EN(IG) IF(MASS(IG).GE.1.E-4) PPP(IG)=DSQRT(EN(IG)**2-MASS(IG)**2) RO(IG)=DSQRT((BQRS(1,IG)-VERW(1))**2+(BQRS(2,IG)-VERW(2))**2 +REP,CBKFIT,CFUPDA,482. ELSEIF(CASE.GE.7) THEN +REP,CBKFIT,CFUPDA,509. ELSEIF(CASE.GE.7) THEN +REP,CBKFIT,CFUPDA,517-524. *************** * case = 8,9,10 *************** C C...KSHORT MOMENTUM CONSTRAINTS DERIVATIVES C IF(CASE.GE.8.AND.CASE.LE.10) THEN RV=DSQRT(VERW(1)**2+VERW(2)**2+VERW(3)**2) +REP,CBKFIT,CFUPDA,534-551. DO 361 J=NPAR1,NPAR2 JJJ=J-NPAR2+4 EN4(JJJ)=X(3*J)**2 EK=EK+EN4(JJJ) DO 361 I=1,3 PSPI(I)=PSPI(I)+PFIT(I,J) PSPIA=PSPIA+PSPI(I)**2 361 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'('' PSPI(A) :'',4G14.6)') & (PSPI(I),I=1,3),PSPIA WRITE(LDBG,'('' MK,EK,RV:'',3G14.6)') MK,EK,RV ENDIF C IF(EK.GT.(MK+1.D-4)) THEN PK=DSQRT(EK**2-MK**2) ELSE PK=1.D-4/2.D0/MK ENDIF PSPIA=DSQRT(PSPIA) C IF(CFDBUG) THEN DO 362 INC=1,3 KMOM(INC)=PK*VERW(INC)/RV 362 CONTINUE WRITE(LDBG,'('' KMOM :'',3G14.6)') (KMOM(INC),INC=1,3) WRITE(LDBG,'('' PSPIA,PK:'',2G14.6)') PSPIA,PK +REP,CBKFIT,CFUPDA,557. DO 365 J=NPAR1,NPAR2 +REP,CBKFIT,CFUPDA,580-589. DO 369 IG=NPAR1,NPAR2 F(IC)=F(IC)-PFIT(INC,IG) 369 CONTINUE C ENDIF ENDIF *************** * case = 1,6-12 *************** +REP,CBKFIT,CFUPDA,647. IF(CASE.EQ.6.OR.CASE.EQ.7.OR.CASE.GE.8.AND.JRES.GE.NRES-2) THEN +REP,CBKFIT,CFUPDA,666-671. C GOTO 460 ********** * case = 2 ********** C-- ONE PARTICLE IS MISSING 470 CONTINUE ******************** * not used from here ******************** C-- EQUAL MASS CONSTRAINT (NOT USED) IF ((MASS(MISSID) .LT. -0.5)) THEN +REP,CBKFIT,CFUPDA,682-705. ********* * to here ********* XMR2=MASS(MISSID)**2 ENDIF EMISS=DSQRT(XMR2+PMISS(1)**2+PMISS(2)**2+PMISS(3)**2) DO 491 I=1,3 PFIT(I,MISSID)=PMISS(I) 491 CONTINUE PFIT(4,MISSID)=EMISS F(1)=EMISS-PMISS(4) N=0 M=0 C DO 501 I=1,NPART IF(I.EQ.MISSID) THEN N=N+3 GOTO 501 ENDIF DO 511 IC=1,3 DFDX(M+IC,1)=DPDX(N+IC,4) DO 521 IV=1,3 DFDX(M+IC,1)=DFDX(M+IC,1)-PMISS(IV)/EMISS*DPDX(N+IC,IV) 521 CONTINUE 511 CONTINUE N=N+3 M=M+3 501 CONTINUE ******************** * not used from here ******************** +REP,CBKFIT,CFUPDA,719-731. ********* * to here ********* IF(NRES.GT.0) THEN DO 561 JRES=1,NRES ******************** * not used from here ******************** IF(((MASS(MISSID) .LT. -0.5) .AND. (JRES .EQ. EMR1)))GO TO561 ********* * to here ********* IR=PMEM(JRES) NMEM=MEM(IR) DO 571 I=1,4 PRES(I)=0 DO 581 IM=1,NMEM PRES(I)=PRES(I)+PFIT(I,MEM(IR+IM)) 581 CONTINUE 571 CONTINUE IPF=JRES+1 SGN=1.D0 ******************** * not used from here ******************** +REP,CBKFIT,CFUPDA,740-784. ********* * to here ********* IF(JRES.NE.EMR2) F(IPF)=0. F(IPF)=F(IPF)+SGN*PRES(4)**2 IF(MRES(JRES).GT.-0.5) F(IPF)=F(IPF)-MRES(JRES)**2 DO 591 I=1,3 F(IPF)=F(IPF)-SGN*PRES(I)**2 591 CONTINUE DO 601 IM=1,NMEM IF(MEM(IR+IM).NE.MISSID) THEN N=3*MEM(IR+IM)-3 M=N IF(MEM(IR+IM).GT.MISSID) M=M-3 DO 611 IC=1,3 IF(JRES.NE.EMR2) DFDX(M+IC,IPF)=0. DFDX(M+IC,IPF)=DFDX(M+IC,IPF)+2.D0*SGN*PRES(4)*DPDX(N+IC,4) DO 621 IV=1,3 DFDX(M+IC,IPF)=DFDX(M+IC,IPF)-2.D0*SGN*PRES(IV)*DPDX(N+IC,IV) 621 CONTINUE 611 CONTINUE ELSE N=0 M=0 DO 631 LP=1,NPART IF(LP.EQ.MISSID) THEN N=N+3 GOTO 631 ENDIF DO 641 IV=1,3 DO 651 I=1,3 DFDX(M+IV,IPF)=DFDX(M+IV,IPF)+SGN*(-2.D0*PRES(4)/EMISS*PMISS(I) & +2.D0*PRES(I))*DPDX(N+IV,I) 651 CONTINUE 641 CONTINUE N=N+3 M=M+3 631 CONTINUE ENDIF 601 CONTINUE 561 CONTINUE END IF GOTO 460 ********** * case = 3 ********** 370 CONTINUE N=3*(MISSID-1) KTYMIS=KTYPE(MISSID) C IF(CFDBUG) THEN WRITE(LDBG,'(''N,MISSID,MISSI0,KTYMIS :'',4I3)') & N,MISSID,MISSI0,KTYMIS ENDIF C +REP,CBKFIT,CFUPDA,792-958. SL=SIN(X(N+2)) ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'(''SSQRT,SL(case=3) :'',2G13.5)') SSQRT,SL ENDIF C C-- ONE PARTICLE'S ENERGY IS MISSING IF(KTYMIS.EQ.1.OR.KTYMIS.EQ.2) THEN RHO(1)=COS(X(N+1))*SSQRT RHO(2)=SIN(X(N+1))*SSQRT RHO(3)=SL C-- DRHO/DFI ---- DRDX(1,1)=-RHO(2) DRDX(1,2)=RHO(1) DRDX(1,3)=0. C-- DRHO/DLAMBDA ---- DRDX(2,1)=-COS(X(N+1))*SL DRDX(2,2)=-SIN(X(N+1))*SL DRDX(2,3)=SSQRT PSI(1)=-SIN(X(N+1)) PSI(2)=COS(X(N+1)) PSI(3)=0. TAU(1)=DRDX(2,1) TAU(2)=DRDX(2,2) TAU(3)=SSQRT C-- DPSI/DFI ---- DSDX(1,1)=-PSI(2) DSDX(1,2)=PSI(1) DSDX(1,3)=0. C-- DPSI/DLAMBDA ---- DSDX(2,1)=0. DSDX(2,2)=0. DSDX(2,3)=0. C-- DTAU/DFI ---- DTDX(1,1)=-TAU(2) DTDX(1,2)=TAU(1) DTDX(1,3)=0. C-- DTAU/DLAMBDA ---- DTDX(2,1)=-RHO(1) DTDX(2,2)=-RHO(2) DTDX(2,3)=-RHO(3) ENDIF C C-- PROJECT PMISS TO RHO ---- PP=0. DO 681 I=1,3 PP=PP+PMISS(I)*RHO(I) 681 CONTINUE PP=MAX (PP,0.D0) EMISS=DSQRT(MASS(MISSID)**2+PP**2) C IF(CFDBUG) THEN WRITE(LDBG,'(''PP,EMISS :'',2G13.5)') PP,EMISS WRITE(LDBG,'(''RHO :'',3G13.5)') (RHO(I),I=1,3) WRITE(LDBG,'(''PMISS :'',3G13.5)') (PMISS(I),I=1,3) ENDIF C DO 691 I=1,3 PFIT(I,MISSID)=PP*RHO(I) 691 CONTINUE PFIT(4,MISSID)=EMISS C-- ENERGY-MOMENTUM CONSTRAINTS ---- F(1)=0. F(2)=0. DO 701 I=1,3 F(1)=F(1)-PMISS(I)*PSI(I) F(2)=F(2)-PMISS(I)*TAU(I) 701 CONTINUE F(3)=EMISS-PMISS(4) C-- PMISS DOT DRHO/DX(I) ---- DO 711 IV=1,2 DEL(IV)=0. DO 721 I=1,3 DEL(IV)=DEL(IV)+PMISS(I)*DRDX(IV,I) 721 CONTINUE 711 CONTINUE C-- DFDX ---- N=0 M=0 DO 731 LP=1,NPART IF(LP.EQ.MISSID) THEN DO 741 IV=1,2 DFDX(M+IV,3)=PP/EMISS*DEL(IV) DFDX(M+IV,1)=0. DFDX(M+IV,2)=0. DO 751 I=1,3 DFDX(M+IV,1)=DFDX(M+IV,1)-PMISS(I)*DSDX(IV,I) DFDX(M+IV,2)=DFDX(M+IV,2)-PMISS(I)*DTDX(IV,I) 751 CONTINUE 741 CONTINUE N=N+3 M=M+2 ELSE DO 761 IC=1,3 DFDX(M+IC,3)=DPDX(N+IC,4) DO 771 IV=1,3 DFDX(M+IC,3)=DFDX(M+IC,3)-PP/EMISS*DPDX(N+IC,IV)*RHO(IV) 771 CONTINUE DFDX(M+IC,1)=0. DFDX(M+IC,2)=0. DO 781 I=1,3 DFDX(M+IC,1)=DFDX(M+IC,1)+PSI(I)*DPDX(N+IC,I) DFDX(M+IC,2)=DFDX(M+IC,2)+TAU(I)*DPDX(N+IC,I) 781 CONTINUE 761 CONTINUE N=N+3 M=M+3 ENDIF 731 CONTINUE C-- RESONANCE CONSTRAINTS ---- IF(NRES.GT.0) THEN DO 791 JRES=1,NRES IR=PMEM(JRES) NMEM=MEM(IR) DO 801 I=1,4 PRES(I) = 0 DO 811 IM=1,NMEM PRES(I)=PRES(I)+PFIT(I,MEM(IR+IM)) 811 CONTINUE 801 CONTINUE IPF=JRES+3 F(IPF)=PRES(4)**2-MRES(JRES)**2 DO 821 I=1,3 F(IPF)=F(IPF)-PRES(I)**2 821 CONTINUE DO 831 IM=1,NMEM IF(MEM(IR+IM).NE.MISSID) THEN N=3*MEM(IR+IM)-3 M=N IF(MEM(IR+IM).GT.MISSID) M=M-1 DO 841 IC=1,3 DFDX(M+IC,IPF)=DFDX(M+IC,IPF)+2*PRES(4)*DPDX(N+IC,4) DO 851 IV=1,3 DFDX(M+IC,IPF)=DFDX(M+IC,IPF)-2*PRES(IV)*DPDX(N+IC,IV) 851 CONTINUE 841 CONTINUE ELSE N=0 M=0 DO 861 LP=1,NPART IF(LP.EQ.MISSID) THEN N=N+3 M=M+2 GOTO 861 ENDIF DO 871 IV=1,3 DO 881 I=1,3 DFDX(M+IV,IPF)=DFDX(M+IV,IPF)-2*PRES(4)*PP/EMISS*DPDX(N+IV,I) & *RHO(I) DO 891 II=1,3 DFDX(M+IV,IPF)=DFDX(M+IV,IPF)+2*PRES(I)*RHO(I)*DPDX(N+IV,II) & *RHO(II) 891 CONTINUE 881 CONTINUE 871 CONTINUE N=N+3 M=M+3 861 CONTINUE M=3*MISSID-3 DO 901 IV=1,2 PDOTD=0. PDOTR=0. DO 911 I=1,3 PDOTD=PDOTD+PMISS(I)*DRDX(IV,I) PDOTR=PDOTR+PMISS(I)*RHO(I) 911 CONTINUE DFDX(M+IV,IPF)=2*PRES(4)*PP/EMISS*PDOTD DO 921 I=1,3 DFDX(M+IV,IPF)=DFDX(M+IV,IPF)-2*PRES(I)*(RHO(I)*PDOTD & +PDOTR*DRDX(IV,I)) 921 CONTINUE 901 CONTINUE ENDIF 831 CONTINUE 791 CONTINUE ENDIF ************** * case = 1,2,3 ************** +REP,CBKFIT,CFUPDA,965-973. ********** * case = 2 ********** C-- MISSING PARTICLE IF(IG.EQ.MISSID.AND.CASE.EQ.2) THEN CONTINUE ********** * case = 3 ********** +REP,CBKFIT,CFUPDA,997-999. ********** * case = 1 ********** +REP,CBKFIT,CFUPDA,1023-1047. GOTO 1999 C 1000 CONTINUE C ************* * case = 6-12 ************* +REP,CBKFIT,CFUPDA,1070. ELSEIF(CASE.GE.7.AND.CASE.LE.10) THEN +ADD,CBHYPO,CFDOPE,0. *CMZU: 3.05/01 29/03/95 12.38.26 by Pal Hidas +REP,CBHYPO,CFDOPE,102. MISCON=MISCON.AND..NOT.CFKSKM MISCON=MISCON.AND.CFMISM.EQ.0 MISCON=MISCON.AND.(CFMISX.EQ.0..OR.BADXCF.NE.0) +ADD,CBHYPO,CFFILC,0. *CMZU: 3.05/01 29/03/95 11.37.08 by Pal Hidas *CMZ : 3.05/00 26/03/95 17.20.22 by Pal Hidas *CMZ : 3.04/00 04/03/95 16.31.02 by Pal Hidas *CMZ : 3.03/00 01/03/95 17.12.03 by Pal Hidas +ADD,CBHYPO,CFFILC,133. JRET=-3 RETURN C +REP,CBHYPO,CFFILC,265. C IF(CFDBUG) THEN WRITE(LDBG,'(''CTYP,JJ,I'',1X,A4,2I4)') CTYP,JJ,I ENDIF C +REP,CBHYPO,CFFILC,324-326. IF(.NOT.MISSKL.AND.BADKL.EQ.0.AND..NOT.CFKSKM & .AND.KSKBCF.EQ.0) THEN WRITE(LERR,'('' *** ERROR *** NO OPTION SPECIFIED TO KL'')') +REP,CBHYPO,CFFILC,360-362. IF(CFMISM.EQ.0..AND.CFMISX.EQ.0.) THEN WRITE(LERR,'('' *** ERROR *** HYPOTHESIS CONTAINS PARTICLE X &BUT CFMISM=CFMISX=0.'')') +ADD,CBHYPO,CFFILC,429. IF(CFKSCC.AND.NCH.EQ.4.AND.COMBFL(J,I).EQ.1) COMBFL(J,I)=0 +REP,CBHYPO,CFFILC,454. IF(MISGAM.OR.MISSKL.OR.MISNEU.OR.MISPRO.OR.CFKSKM & .OR.CFMISM.NE.0..OR.CFMISX.NE.0..AND.BADXCF.EQ.0) +REP,CBHYPO,CFFILC,545. WRITE(LLOG,'('' THE NUMBER OF HYPOTHESES ='',I5)') NHY +ADD,CBHYPO,CFLKUP,0. *CMZU: 3.05/00 27/03/95 13.29.39 by Pal Hidas +REP,CBHYPO,CFLKUP,17. SUBROUTINE CFLKUP(TYPE,ITYP,MS,ICHAR,RES) +REP,CBHYPO,CFLKUP,28. REAL MS,MBUFF(N) +REP,CBHYPO,CFLKUP,85. MS=MBUFF(I) +REP,CBHYPO,CFLKUP,137. IF(CFMISM.GT.0.) MBUFF(I)=CFMISM IF(CFMISX.GT.0.) MBUFF(I)=CFMISX +REP,CBHYPO,CFLKUP,145-148. ENTRY CFDVUP(MS,DEV) C DO 20 I=1,N IF(MS.EQ.MBUFF(I)) THEN +REP,CBHYPO,CFLKUP,177. ENTRY CFMUP(ITYP,MS) +REP,CBHYPO,CFLKUP,184. MS=MBUFF(J) +ADD,CBHYPO,CFDOHY,0. *CMZU: 3.07/00 01/04/95 14.29.04 by Pal Hidas *CMZ : 3.05/01 30/03/95 16.20.27 by Pal Hidas *CMZ : 3.05/00 27/03/95 17.36.35 by Pal Hidas *CMZ : 3.04/00 04/03/95 16.33.42 by Pal Hidas +REP,CBHYPO,CFDOHY,109. DO 101 I=IHA,IHB +REP,CBHYPO,CFDOHY,236. IF(KSKBCF.NE.0.OR.BADXCF.NE.0) THEN DO 609 IMIS=1,NPART IF(MISSI0.EQ.NXTCMB(IMIS)) THEN MISSID=IMIS ENDIF 609 CONTINUE ENDIF C IF(BADNEU.NE.0.OR.BADKL.NE.0) THEN +REP,CBHYPO,CFDOHY,361-363. IF(CASE.GE.6) THEN +REP,CBHYPO,CFDOHY,371. ELSEIF(CASE.GE.8.AND.CASE.LE.10) THEN +ADD,CBHYPO,CFDOHY,406. IF(CASE.EQ.9.OR.CASE.EQ.11) THEN NSUM=NPART-1 ENDIF +REP,CBHYPO,CFDOHY,422-424. ELSEIF(CASE.EQ.4.OR.CASE.EQ.6.OR.CASE.EQ.7.OR.CASE.EQ.10) THEN GODNES=PROB(CHISQ,NC-1) ELSEIF(CASE.EQ.12) THEN GODNES=PROB(CHISQ,NC-1) ELSEIF(CASE.EQ.5.OR.CASE.EQ.8.OR.CASE.EQ.9.OR.CASE.EQ.11) THEN +REP,CBHYPO,CFDOHY,507. ELSEIF(CASE.GE.8.AND.CASE.LE.10) THEN +REP,CBHYPO,CFDOHY,522. WRITE(LLOG,'(''R/EV:'',I5,I6,I2,''C,CA:'',I2, +REP,CBHYPO,CFDOHY,544. CALL CFUPDA(IRET) C IF(IRET.LT.0) THEN WRITE(LDBG,'(''LEAVE CFDOHY,IRET='',I3)') IRET RETURN ENDIF +ADD,CBHYPO,CFDOHY,560. IF(CASE.EQ.9.OR.CASE.EQ.11) THEN NSUM=NPART-1 ENDIF +ADD,CBHYPO,CFDOHY,568. IF(CASE.EQ.9.OR.CASE.EQ.11) THEN NSUM=NPART-1 ENDIF C 101 CONTINUE C +ADD,CBHYPO,CFINIT,0. *CMZU: 3.05/01 29/03/95 15.35.55 by Pal Hidas *CMZ : 3.05/00 27/03/95 17.35.51 by Pal Hidas *CMZ : 3.04/02 07/03/95 17.39.53 by Pal Hidas *CMZ : 3.04/00 04/03/95 16.36.59 by Pal Hidas *CMZ : 3.03/00 01/03/95 18.22.21 by Pal Hidas +REP,CBHYPO,CFINIT,82-92. CFMISX=0. C BADTRA=0 BADNEU=0 BADKL=0 BADXCF=0 KSKBCF=0 NPI0CF=0 CFCASP=0 CFCASR=0 MNVXCF=0 C CFSUPC=.FALSE. CFDEUT=.FALSE. CFCOLL=.FALSE. +REP,CBHYPO,CFINIT,98-101. CFCHCR=.FALSE. CFTAKH=0 C CFVERT=.FALSE. CFVRTZ=.FALSE. CFVERA=.FALSE. CFVERZ=.FALSE. CFKS00=.FALSE. CFKSCC=.FALSE. CFKSKM=.FALSE. +ADD,CBHYPO,CFINIT,112. CFMIER(1)=1.E-3 CFMIER(2)=0. CFMIER(3)=1.E-3 CFMIER(4)=0. CFMIER(5)=0. CFMIER(6)=3. C +ADD,CBHYPO,CFINIT,128. DO I=1,10 IDRVCF(I)=0 ENDDO C DO I=1,NPMAX IMNNEU(I)=0 ENDDO C +ADD,CBHYPO,CFDOFI,0. *CMZU: 3.07/00 31/03/95 16.31.26 by Pal Hidas *CMZ : 3.05/01 31/03/95 10.32.24 by Pal Hidas *CMZ : 3.05/00 26/03/95 15.37.49 by Pal Hidas *CMZ : 3.04/01 06/03/95 11.18.49 by Pal Hidas *CMZ : 3.04/00 04/03/95 16.40.21 by Pal Hidas *CMZ : 3.03/00 02/03/95 13.50.46 by Pal Hidas +ADD,CBHYPO,CFDOFI,71. LOGICAL NEWTYP +REP,CBHYPO,CFDOFI,77-80. IF(CFMISM.NE.0..OR.CFMISX.NE.0.) CALL CFSETX C IF(CFDEUT) THEN ETOT=1875.6134+SQRT(938.2723**2+CFBEAM**2) ELSEIF(CFCOLL) THEN ETOT=2*SQRT(938.2723**2+CFBEAM**2) +REP,CBHYPO,CFDOFI,109. IF(CFIRST.OR.CFORCE) THEN IF(CFDBUG) WRITE(LDBG,'(''CFREA CALLED'')') CALL CFREA(IRET) ENDIF +REP,CBHYPO,CFDOFI,126. WRITE(LDBG,'('' BADNEU,BADTRA,BADKL :'',3I6)') & BADNEU,BADTRA,BADKL +REP,CBHYPO,CFDOFI,150-154. WRITE(LLOG,'('' ### NOW WITH MISSING PARTICLE'')') ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'('' ### NOW WITH MISSING PARTICLE'')') ENDIF C ENDIF C IF(CFMISX.NE.0.) THEN EVTYPE(5)=NNE+1 IF(BADXCF.EQ.0) NPART=NSUM+1 MISSI0=NPART KTYPE(NPART)=2 ISPE(NPART)=1 C IF(CFTRHY) THEN IF(BADXCF.EQ.0) THEN WRITE(LLOG,'('' ### NOW WITH MISSING PARTICLE'')') ELSE WRITE(LLOG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF ENDIF C IF(CFDBUG) THEN IF(BADXCF.EQ.0) THEN WRITE(LLOG,'('' ### NOW WITH MISSING PARTICLE'')') ELSE WRITE(LLOG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF ENDIF C ENDIF C IF(KSKBCF.NE.0) THEN MISSI0=NPART KTYPE(NPART)=2 ISPE(NPART)=1 C IF(CFTRHY) THEN WRITE(LLOG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF C ENDIF C IF(CFKSKM) THEN EVTYPE(5)=NNE+1 NPART=NSUM+1 MISSI0=NPART KTYPE(NPART)=2 ISPE(NPART)=1 C IF(CFTRHY) THEN WRITE(LLOG,'('' ### NOW WITH MISSING PARTICLE'')') ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'('' ### NOW WITH MISSING PARTICLE'')') +REP,CBHYPO,CFDOFI,173-177. WRITE(LLOG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF C ENDIF C IF(BADKL.NE.0) THEN DO 105 I=1,NPART C IF(MEASCO(I).EQ.BADKL) THEN MISSI0 =I KTYPE(I)=2 ISPE(I) =0 GOTO 106 ENDIF C 105 CONTINUE 106 CONTINUE C IF(CFTRHY) THEN WRITE(LLOG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF C ENDIF C IF(BADXCF.NE.0) THEN DO 107 I=1,NPART C IF(MEASCO(I).EQ.BADXCF) THEN MISSI0 =I KTYPE(I)=2 GOTO 108 ENDIF C 107 CONTINUE 108 CONTINUE C IF(CFTRHY) THEN WRITE(LLOG,'('' ### NOW WITH MISSING ENERGY'')') ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'('' ### NOW WITH MISSING ENERGY'')') +REP,CBHYPO,CFDOFI,196-200. WRITE(LLOG,'('' ### NOW WITH MISSING TRACK ENERGY'')') ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'('' ### NOW WITH MISSING TRACK ENERGY'')') +REP,CBHYPO,CFDOFI,213-217. WRITE(LLOG,'('' ### NOW WITH MISSING PARTICLE'')') ENDIF C IF(CFDBUG) THEN WRITE(LDBG,'('' ### NOW WITH MISSING PARTICLE'')') +ADD,CBHYPO,CFDOFI,307. IF(CFDBUG) THEN WRITE(LDBG,'(''IRET,CFORCE ::'',I3,1X,L4)') IRET,CFORCE ENDIF C +REP,CBHYPO,CFSELE,1-18. *CMZU: 3.07/00 31/03/95 16.37.03 by Pal Hidas *CMZ : 3.05/01 28/03/95 14.15.08 by Pal Hidas *CMZ : 3.05/00 26/03/95 15.42.36 by Pal Hidas *CMZ : 3.04/00 05/03/95 11.21.00 by Pal Hidas *CMZ : 2.18/04 02/06/94 12.03.00 by Pal Hidas *CMZ : 2.18/01 24/05/94 11.18.55 by Pal Hidas *CMZ : 2.18/00 23/05/94 14.27.44 by Pal Hidas *CMZ : 2.16/02 18/05/94 15.01.53 by Pal Hidas *CMZU: 2.15/01 01/05/94 11.31.26 by Pal Hidas *CMZU: 2.15/00 27/04/94 10.48.17 by Pal Hidas *CMZ : 2.14/00 27/08/93 13.24.41 by Pal Hidas *CMZ : 2.12/04 16/08/93 13.28.08 by Pal Hidas *CMZU: 2.12/02 07/07/93 11.47.00 by Pal Hidas *CMZU: 2.09/04 24/07/92 13.16.12 by Pal Hidas *CMZU: 2.09/00 09/03/92 14.34.21 by Pal Hidas *CMZ : 2.07/03 14/02/92 16.08.07 by Pal Hidas *CMZ : 2.04/01 16/11/91 13.56.56 by Pal Hidas *CMZ : 2.04/00 13/11/91 14.52.48 by Pal Hidas *CMZU: 2.02/00 21/07/91 16.12.45 by PAL HIDAS *CMZU: 2.00/00 03/06/91 10.54.00 by PAL HIDAS *CMZ : 1.01/00 05/12/90 06.39.26 by Gunter Folger *-- Author : +REP,CBHYPO,CFSELE,51-55. C...SET CASE, NVAR, NC, KTYPE=1,2 C DO 40 I=1,NPART C...MISSING PARTICLE +REP,CBHYPO,CFSELE,63. C...MISSING ENERGY +REP,CBHYPO,CFSELE,70. C...SET KTYPE FOR THE REST +REP,CBHYPO,CFSELE,79-84. 29 CONTINUE ENDIF C 40 CONTINUE C C...NEW MISSING PARTICLE (AND MISSING ENERGY) FIT C IF(CFMISX.GT.0.) THEN IF(BADXCF.GT.0) THEN CASE=12 ELSE CASE=11 ENDIF C IF(MISGAM) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFMISX,MISGAM'')') ENDIF C IF(CFVERT) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFMISX,CFVERT'')') ENDIF C IF(CFVERZ) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFMISX,CFVERZ'')') ENDIF C IF(CFVRTZ) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFMISX,CFVRTZ'')') ENDIF C IF(CFVERA) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFMISX,CFVERA'')') ENDIF C IF(CFMISM.GT.0.) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFMISX,CFMISM'')') ENDIF C ENDIF C C...SET CASE=4 OR 6 FOR VERTEX Z COORDINATE FIT +REP,CBHYPO,CFSELE,116. IF(BADNEU.NE.0.OR.BADTRA.NE.0.OR.BADKL.NE.0) THEN +REP,CBHYPO,CFSELE,153. C...SET CASE=5 OR 7 FOR VERTEX FIT +REP,CBHYPO,CFSELE,185. IF(BADNEU.NE.0.OR.BADTRA.NE.0.OR.BADKL.NE.0) THEN +REP,CBHYPO,CFSELE,193-197. C...SET CASE=8,9,10 FOR KSHORT SECONDARY VERTEX FIT C IF(CFKS00) THEN C CASE=8 C +REP,CBHYPO,CFSELE,218-220. IF(BADNEU.NE.0.OR.BADTRA.NE.0.OR.BADKL.NE.0) THEN WRITE(LERR,'('' *** ERROR *** KSHORT FIT WITH MISSING ENERGY &'')') ENDIF ENDIF C IF(CFKSKM) THEN C CASE=9 C NVAR=3*NPART+3 C IF(MISGAM) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFKSKM,MISGAM'')') ENDIF C IF(MISSKL) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFKSKM,MISSKL'')') ENDIF C IF(CFVERA) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFKSKM,CFVERA'')') ENDIF C IF(CFVERZ) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFKSKM,CFVERZ'')') ENDIF C IF(BADXCF.GT.0) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFKSKM,BADXCF'')') ENDIF C IF(BADKL.GT.0) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFKSKM,BADKL'')') ENDIF C IF(BADNEU.GT.0) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : CFKSKM,BADNEU'')') ENDIF C ENDIF C C ------ C IF(KSKBCF.GT.0) THEN C CASE=10 C NVAR=3*NPART+3 C IF(CFKSKM) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : KSKBCF,CFKSKM'')') ENDIF C IF(MISGAM) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : KSKBCF,MISGAM'')') ENDIF C IF(MISSKL) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : KSKBCF,MISSKL'')') ENDIF C IF(CFVERA) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : KSKBCF,CFVERA'')') ENDIF C IF(CFVERZ) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : KSKBCF,CFVERZ'')') ENDIF C IF(BADXCF.GT.0) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : KSKBCF,BADXCF'')') ENDIF C IF(BADKL.GT.0) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : KSKBCF,BADKL'')') ENDIF C IF(BADNEU.GT.0) THEN WRITE(LERR,'(''*** ERROR *** MISMATCH : KSKBCF,BADNEU'')') +ADD,CBHYPO,CFREA,0. *CMZU: 3.07/00 01/04/95 12.50.17 by Pal Hidas *CMZ : 3.05/01 30/03/95 18.08.03 by Pal Hidas *CMZ : 3.05/00 25/03/95 18.26.58 by Pal Hidas *CMZ : 3.04/00 05/03/95 11.03.47 by Pal Hidas *CMZ : 3.03/00 02/03/95 11.33.05 by Pal Hidas +REP,CBHYPO,CFREA,71-72. INTEGER EVBUF(6),I,J,IRET,JTTKS,IPARN,JCH,II,IEVTLO(6) INTEGER NPOSM,NNEGM,NNEUM,CFCALR +REP,CBHYPO,CFREA,85-96. ENCONS=.TRUE. C DO 2 I=1,NPMAX IF((MISGAM.OR.MISSKL.OR.MISNEU.OR.MISPRO.OR.CFKSKM &.OR.CFMISM.NE.0.) & .AND.I.LE.NSUM+1.OR. &.NOT.MISGAM.AND..NOT.MISSKL.AND..NOT.MISNEU.AND..NOT.MISPRO & .AND..NOT.CFKSKM.AND.CFMISM.EQ.0..AND.I.LE.NSUM) THEN +REP,CBHYPO,CFREA,104-108. C IF(CFDBUG) THEN WRITE(LDBG,'(''NSUM,NCH,NNE (CFREA) :'',3I8)') NSUM,NCH,NNE WRITE(LDBG,'(''NPMAX,NCHMAX(/2),NGMAX:'',3I8)') & NPMAX,NCHMAX,NGMAX ENDIF C IF(NSUM.GT.NPMAX.OR.NCH.GT.2*NCHMAX.OR.NNE.GT.NGMAX) THEN IRET=-1 CFCALR=CFCALR+1 IF(CFCALR.LT.20) & WRITE(LERR,'('' *** WARNING *** IEVEF='',I6,'' NOT TO BE KINEMATI +REP,CBHYPO,CFREA,116. IF(CFCHCR.AND.NCH.GT.0) CALL CFLOCV IF(MNVXCF.GT.0) CALL CFNECR +REP,CBHYPO,CFREA,128. IF(MISGAM.OR.MISSKL.OR.MISNEU.OR.CFKSKM & .OR.CFMISM.NE.0.) THEN +ADD,CBHYPO,CFREA,138. DO J=1,3 BQRS0(J,I)=0. ENDDO +REP,CBHYPO,CFREA,144-145. WRITE(LDBG,'('' IEVEF,EVTYPE :'',I6,2X,6I3)') & IEVEF,(EVTYPE(I),I=1,6) WRITE(LDBG,'('' EVBUF :'',8X,6I3)') & (EVBUF(I),I=1,6) +REP,CBHYPO,CFREA,153-154. IF(MISGAM.OR.MISSKL.OR.MISNEU.OR.CFKSKM.OR.CFMISM.NE.0.) & IEVTLO(5)=IEVTLO(5)-1 +DEL,CBHYPO,CFREA,200-208. +REP,CBHYPO,CFREA,216-226. C...COVARIANCE MATRIX IF(CFCODE(19).EQ.0) THEN +DEL,CBHYPO,CFREA,234. +DEL,CBHYPO,CFREA,240-249. +REP,CBHYPO,CFREA,255-258. ELSEIF(BADKL.EQ.MEASCO(I)) THEN XM(3+3*(I-1))=0 ELSEIF(BADXCF.EQ.MEASCO(I)) THEN XM(3+3*(I-1))=0 ELSEIF(KSKBCF.EQ.MEASCO(I)) THEN XM(3+3*(I-1))=0 ELSE XM(3+3*(I-1))=Q(JTTKS+45) ENDIF +REP,CBHYPO,CFREA,266-273. ERR(1,I)=Q(JTTKS+46) ERR(3,I)=Q(JTTKS+48) ERR(6,I)=Q(JTTKS+51) IF(CFGCOV) THEN ERR(2,I)=Q(JTTKS+47) ERR(4,I)=Q(JTTKS+49) ERR(5,I)=Q(JTTKS+50) +REP,CBHYPO,CFREA,279-299. ENDIF C EGSUM=EGSUM+Q(JTTKS+45)**2 +ADD,CBHYPO,CFEFFM,0. *CMZU: 3.04/00 04/03/95 16.48.20 by Pal Hidas +ADD,CBHYPO,CFEFFM,82. IF(BADKL.EQ.JMEAS) THEN IF(BADKL.NE.0) THEN RETURN ELSEIF(CASE.EQ.3) THEN WRITE(LERR,'('' *** ERROR *** IN CFEFFM: BADKL,JMEAS ='' & ,2I10)') BADKL,JMEAS ENDIF ENDIF C +REP,CBHYPO,CFZOUT,1-33. *CMZU: 3.05/00 26/03/95 17.51.19 by Pal Hidas *CMZ : 3.00/00 04/07/94 15.56.16 by Pal Hidas *CMZ : 2.18/06 29/06/94 11.21.55 by Pal Hidas *CMZ : 2.18/04 02/06/94 14.21.56 by Pal Hidas *CMZ : 2.18/01 25/05/94 16.35.32 by Pal Hidas *CMZ : 2.18/00 23/05/94 14.33.36 by Pal Hidas *CMZ : 2.17/00 21/05/94 12.52.42 by Pal Hidas *CMZ : 2.16/02 18/05/94 15.28.22 by Pal Hidas *CMZ : 2.16/01 17/05/94 16.51.28 by Pal Hidas *CMZU: 2.15/01 01/05/94 11.34.36 by Pal Hidas *CMZU: 2.14/09 14/04/94 16.11.16 by Pal Hidas *CMZU: 2.12/02 07/07/93 11.18.55 by Pal Hidas *CMZU: 2.09/00 09/03/92 16.25.21 by Pal Hidas *CMZ : 2.07/01 12/02/92 15.04.22 by Pal Hidas *CMZ : 2.06/02 08/01/92 17.39.56 by Pal Hidas *CMZ : 2.04/02 23/11/91 10.12.14 by Pal Hidas *CMZ : 2.04/01 16/11/91 14.00.14 by Pal Hidas *CMZ : 2.04/00 12/11/91 14.30.09 by Pal Hidas *CMZ : 2.03/01 24/09/91 16.13.01 by Gunter Folger *CMZU: 2.03/00 09/08/91 14.59.05 by PAL HIDAS *CMZU: 2.00/00 05/06/91 13.23.44 by PAL HIDAS *CMZ : 1.09/08 06/05/91 13.04.01 by PAL HIDAS *CMZ : 1.09/00 27/02/91 09.48.58 by PAL HIDAS *CMZ : 1.08/05 21/02/91 16.10.27 by PAL HIDAS *CMZ : 1.08/04 17/02/91 13.22.36 by PAL HIDAS *CMZ : 1.08/03 29/01/91 15.33.13 by Gunter Folger * Change L-2 into L-4. 4 vector of resonances were wrong. *CMZ : 1.08/02 23/01/91 19.25.50 by PAL HIDAS *CMZ : 1.08/00 19/01/91 12.53.02 by PAL HIDAS *CMZ : 1.07/00 17/01/91 12.52.03 by PAL HIDAS *CMZ : 1.06/00 17/01/91 12.25.46 by PAL HIDAS *CMZ : 1.02/00 10/01/91 14.43.19 by PAL HIDAS *CMZ : 1.01/00 05/12/90 06.39.26 by Gunter Folger *-- Author : +REP,CBHYPO,CFZOUT,93-96. 10 CONTINUE 11 CONTINUE C C...FILL VERTEX COORDINATES +REP,CBHYPO,CFZOUT,126. C...CREATE KRES SUBBANK +REP,CBHYPO,CFZOUT,141. C...FILL KRES SUBBANK +REP,CBHYPO,CFZOUT,150. C...VERTEX COORDINATES +REP,CBHYPO,CFZOUT,173-175. IF(CASE.EQ.5.OR.CASE.EQ.8.OR.CASE.EQ.9.OR.CASE.EQ.11) THEN IQ(JKRES)=NC-3 ELSEIF(CASE.EQ.4.OR.CASE.EQ.6.OR.CASE.EQ.7.OR.CASE.EQ.10) THEN IQ(JKRES)=NC-1 ELSEIF(CASE.EQ.12) THEN +REP,CBHYPO,CFZOUT,197-199. C...MASS USED IN FIT Q(LKSUB+IFP+2)=FITMAS(I,IHY) C...TTKS PARTICLE ID (-1 FOR MISSING GAMMA) +REP,CBHYPO,CFZOUT,211-216. C...FOUR MOMENTUM FROM FIT Q(LKSUB+IFP+3)=PFIT(4,I) Q(LKSUB+IFP+4)=PFIT(1,I) Q(LKSUB+IFP+5)=PFIT(2,I) Q(LKSUB+IFP+6)=PFIT(3,I) C...PULLS +REP,CBHYPO,CFZOUT,229-235. 39 CONTINUE IFP=IFP+NWSUBP 40 CONTINUE IFP=NWSUBF IRDP=0 C C...FILL RESONANCES +REP,CBHYPO,CFZOUT,251-255. C...THERE IS NO TTKS PARTICLE ID IQ(LKSUB+IFP+1)=0 C...MASS USED FOR FIT Q(LKSUB+IFP+2)=RESMAS(I,IHY) C...CALCULATE FOUR MOMENTUM +REP,CBHYPO,CFZOUT,279-280. 50 CONTINUE 60 CONTINUE +REP,CBHYPO,CFZOUT,286. C...NO PULLS CALCULATED +REP,CBHYPO,CFZOUT,293-299. 70 CONTINUE C C...FILL REFERENCE LINKS OF KSUB BANK C DO 80 I=1,NPART+NRES LQ(LKSUB-I)=NWSUBF+(I-1)*NWSUBP+LKSUB 80 CONTINUE +REP,CBHYPO,CFSHOW,1-4. *CMZU: 3.04/00 05/03/95 11.04.59 by Pal Hidas *CMZ : 2.04/02 23/11/91 10.12.37 by Pal Hidas *CMZU: 2.00/00 29/05/91 16.58.07 by PAL HIDAS *CMZ : 1.09/07 28/04/91 20.02.13 by PAL HIDAS *-- Author : PAL HIDAS 24/04/91 +REP,CBHYPO,CFSHOW,27-33. PH=Q(JTTKS+43) TH=Q(JTTKS+44) +REP,CBHYPO,CFVPAR,1-4. *CMZU: 3.04/00 05/03/95 11.05.40 by Pal Hidas *CMZ : 2.04/02 23/11/91 10.12.59 by Pal Hidas *CMZ : 2.04/01 16/11/91 14.03.52 by Pal Hidas *CMZU: 2.00/00 02/06/91 21.23.09 by PAL HIDAS *-- Author : PAL HIDAS 02/06/91 +DEL,CBHYPO,CFVPAR,42-43. +REP,CBHYPO,CFVPAR,54-67. QP=Q(JTTKS+43) QL=PIHLF-Q(JTTKS+44) C XM(1+3*(I-1))=PH XM(2+3*(I-1))=LA C 10 CONTINUE +REP,CBHYPO,CFLOCV,1-4. *CMZU: 3.05/00 08/03/95 18.53.51 by Pal Hidas *CMZ : 3.04/02 07/03/95 17.30.58 by Pal Hidas *CMZ : 3.03/00 01/03/95 20.00.37 by Pal Hidas *CMZ : 3.00/01 11/07/94 10.45.18 by Pal Hidas *CMZ : 3.00/00 04/07/94 11.17.31 by Pal Hidas *-- Author : Pal Hidas 29/06/94 SUBROUTINE CFLOCV +REP,CBHYPO,CFLOCV,13-23. * coordinates from the TVVP bank and the * corrected track momenta from the TCTR * bank and calculates the new fit parameters * overwriting the TTKS bank. * +REP,CBHYPO,CFLOCV,42-43. INTEGER JTVVP,JTVTV,ITCTR,ICD,NTR,NVCH,I,NDF,III,JJJ,J INTEGER ITYP,ICHAR,NPGT,KTCTR,JTTKS,IV,ICHECK(4) +REP,CBHYPO,CFLOCV,49-82. IF(LTVTX.LE.0) RETURN C C...global tracking also creates one bank NVCH=IQ(LTVTX+1)-1 IF(NVCH.LE.0.OR.NVCH.GT.2) RETURN C...check whether vertices are independent DO I=1,4 ICHECK(I)=0 ENDDO C DO IV=1,NVCH JTVTV=LQ(LTVTX-IV) IF(JTVTV.LE.0) THEN WRITE(LERR,'(''*** ERROR *** CFLOCV/JTVTV :'',I12)') JTVTV WRITE(LERR,'('' in run/ev :'',2I8)') & IEHDCB(4),IEHDCB(5) ELSE JTVVP=LQ(JTVTV-1) IF(JTVVP.LE.0) THEN WRITE(LERR,'(''*** ERROR *** CFLOCV/JTVVP :'',I12)') JTVVP WRITE(LERR,'('' in run/ev :'',2I8)') & IEHDCB(4),IEHDCB(5) ELSE ICHECK(IQ(JTVVP+1))=ICHECK(IQ(JTVVP+1))+1 ENDIF ENDIF ENDDO C IF(CFDBUG) THEN WRITE(LDBG,'(''**** CHARGED CORRECTION ,NVCH='',I2)') NVCH WRITE(LDBG,'(''ICHECK :'',4I3)') (ICHECK(I),I=1,4) ENDIF C IF(CFTRHY) THEN WRITE(LLOG,'(''**** CHARGED CORRECTION ,NVCH='',I2)') NVCH ENDIF C DO I=1,4 IF(ICHECK(I).GT.1) THEN IF(CFDBUG) THEN WRITE(LDBG,'(''INDEPENDENCE CHECK -> RETURN'')') RETURN ENDIF ENDIF ENDDO C DO 300 IV=1,NVCH C CALL DLRMEM(CHVT,3) CALL DLRMEM(CHKMOM,3) CALL DLRMEM(CHVMOM,12) CALL DLRMEM(CHVPAR,12) CHCTAU=0.D0 KDIRS=0.D0 C JTVTV=LQ(LTVTX-IV) C IF(JTVTV.LE.0) GOTO 300 C C...CHECK WHETER USER DROP DO I=1,10 IF(IDRVCF(I).EQ.IV) GOTO 300 ENDDO C NTR=IQ(JTVTV+1) ICD=IQ(JTVTV+3) NDF=IQ(JTVTV+4) C IF(CFDBUG) THEN WRITE(LDBG,'(''IV,JTVTV,NTR,ICD,NDF :'',I2,I8,3I4)') & IV,JTVTV,NTR,ICD,NDF ENDIF C IF(ICD.NE.0) GOTO 300 IF(NTR.GT.4) GOTO 300 JTVVP=LQ(JTVTV-1) C CHVT(1)=Q(JTVTV+5) CHVT(2)=Q(JTVTV+6) CHVT(3)=Q(JTVTV+7) CFLY=DSQRT(CHVT(1)**2+CHVT(2)**2+CHVT(3)**2) +REP,CBHYPO,CFLOCV,93-103. ITCTR=IQ(JTVVP+1) CH=Q(JTVVP+3) PX=Q(JTVVP+4) PY=Q(JTVVP+5) PZ=Q(JTVVP+6) EN=Q(JTVVP+7) PP=DSQRT(PX**2+PY**2+PZ**2) C IF(CFDBUG) THEN WRITE(LDBG,'(''I,ITCTR,CHARGE,JTVVP:'',2I3,G10.2,I10)') & I,ITCTR,CH,JTVVP +REP,CBHYPO,CFLOCV,115. PXY=DSQRT(PX**2+PY**2) +REP,CBHYPO,CFLOCV,140-147. JTVVP=JTVVP+13 100 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'(''CHVMOM :''/6G13.5)') & ((CHVMOM(III,JJJ),III=1,3),JJJ=1,4) WRITE(LDBG,'(''CHVPAR :''/6G13.5)') & ((CHVPAR(III,JJJ),III=1,3),JJJ=1,4) +REP,CBHYPO,CFLOCV,154-155. PK=DSQRT(CHKMOM(1)**2+CHKMOM(2)**2+CHKMOM(3)**2) EK=DSQRT(PK**2+MK**2) +REP,CBHYPO,CFLOCV,165-173. C IF(CFDBUG) THEN WRITE(LDBG,'(''KDIRC - A :'',G13.5)') KDIRC ENDIF C KDIRC=KDIRC/PK/CFLY C IF(CFDBUG) THEN WRITE(LDBG,'(''KDIRC - B :'',G13.5)') KDIRC ENDIF C KDIRS=DSQRT(1-KDIRC**2) C IF(CFDBUG) THEN WRITE(LDBG,'(''KDIRS :'',G13.5)') KDIRS ENDIF C BET=PK/EK GAM=1.D0/DSQRT(1-BET**2) +ADD,CBHYPO,CFLOCV,179. 300 CONTINUE C +ADD,CBHYPO,CFNECR,*. &DECK,cfnecr. *CMZU: 3.05/00 09/03/95 13.55.38 by Pal Hidas *-- Author : Pal Hidas 08/03/95 SUBROUTINE CFNECR * * Author: Pal Hidas * * Creation date: 8 March, 1995 * * References: * * Description: This routine overwrites the input parameters * of the parameters of neutral particles coming * from the main vertex, as it is found by * LOCATER. The user must set MNVXCF to the * TVTX number of the main vertex and fill * the array IMNNEU with the TTKS ids of those * neutrals * * Subroutines referenced: CFSHOW * &SELF,IF=-F77,IF=-SUN. IMPLICIT NONE &SELF,IF=-F77,IF=SUN. IMPLICIT UNDEFINED (A-Z) &SELF. &SEQ,PI2PI. &SEQ,CBLINK. &SEQ,CFPARA. &SEQ,CFVARS. &SEQ,SQUIDC. &SEQ,CFSTER. &SEQ,CFCOMB. REAL RSM,XSM,YSM,ZSM,RV,XV,YV,ZV,LA,PH,QP,QL REAL XVMAIN,YVMAIN,ZVMAIN INTEGER I,JTTKS,ITK,II,IFL,LTVTV,J C IF(LTVTX.EQ.0) RETURN LTVTV=LQ(LTVTX-MNVXCF) C XVMAIN=Q(LTVTV+5) YVMAIN=Q(LTVTV+6) ZVMAIN=Q(LTVTV+7) C DO 10 I=1,NPART ITK=MEASCO(I) C IFL=0 DO J=1,NPMAX II=IMNNEU(J) IF(II.NE.0.AND.ITK.EQ.II) IFL=1 ENDDO IF(IFL.EQ.0) GOTO 10 C JTTKS=LQ(LTTKS-IQ(LTTKS-2)-ITK) C CALL CFSHOW(JTTKS,RSM,XSM,YSM,ZSM) C XV=XSM-XVMAIN YV=YSM-YVMAIN ZV=ZSM-ZVMAIN RV=SQRT(XV**2+YV**2+ZV**2) C LA=ASIN(ZV/RV) PH=ATAN2(YV,XV) IF(PH.LT.0) PH=PH+PI2 C QP=Q(JTTKS+43) QL=PIHLF-Q(JTTKS+44) C XM(1+3*(I-1))=PH XM(2+3*(I-1))=LA C 10 CONTINUE C RETURN END +ADD,CFSTOR,TCVERT,*. &DECK,tcvert. *CMZU: 3.05/00 25/03/95 19.39.32 by Pal Hidas *-- Author : Pal Hidas 25/03/95 SUBROUTINE TCVERT * * Author Curtis A Meyer * * Creation date: 22 July, 1988. * Modified: 24 January, 1991. * * Then modified by : Hans-Peter Dietz * Pal Hidas * * References: * * Description: This routine will look through all the fit tracks * in the TCTR data bank, and try to fit them to a * common vertex. In order for tracks to be allowed * to originate from a common vertex inside the * target, they must have their first layer in the * JDC less than 4. If this is not met on a track, * then the routine tries to associate it with a * second track that also failed to come from the * target. * * Subroutines Referenced: TCVRTX * (ZEBRA) MZLIFT,MZDROP * * Edit History: 24 January, 1991 --- C.A.Meyer * Count pwc hits as possible first hits of * a trcak when connectingto a vertex. * Include SUN flag. * * --- H-P. Dietz * Put everything in NTRK0 because the others * are not fitted. Sum over first hit position * for vertex guess. * * --- P. Hidas * Extends to 4 tracks, fits several vertices * * *********************************************************** * &SELF,IF=-F77,IF=-SUN. IMPLICIT NONE &SELF,IF=-F77,IF=SUN. IMPLICIT UNDEFINED (A-Z) &SELF. * * Passed variables: * * Internal variables: * NTRAK * IVRTX * ITRAK * IERR * I * ITR * JTR * INTEGER NTRAK,IVRTX,ITRAK,IERR,I,ITR,JTR,IB,J INTEGER ITR1,ITR2,ITR3,ITR4,IV,NVM * * NTR0 * NTRK0 * NTR1 * NTRK1 * NDROP * IDROP * INTEGER NTR0,NTRK0(20),NTR1,NTRK1(20),NDROP,IDROP(20) INTEGER NTR2,NTRK2(20),NDRO2,IDRO2(20),ISELVX,NS * * ITCTR is the pointer to the TCTR bank being copied. * LTCVT is the pointer to the lifted TCVT bank. * ITCVP is the pointer to the lifted TCVP bank. * INTEGER ITCTR,LTCVT,ITCVP,ITRB(20) INTEGER JTCTR,IL1,JL1,IVTRAK(20),IVTVXB(20,15),IFL INTEGER NV,NTR,IW(100),II,JJ,IVTS(20),ITRS(15),IKEEPV(15) * * ITCHX is the pointer to the lifted TCHX bank. * INTEGER ITCHX * * XH,YH,ZH,RH are x,y,z and r position of the first two hits of * the two tracks * REAL XH(4),YH(4),ZH(4),RH(4),A,B,C,D * * * NCLOTR counts close tracks (when one of the first two hits come * from the PWC REAL VTMOM(3),VTCOR(3),PVT,FVT,VTCN,RVT,AVHIT,VTCHSQ,QVT REAL BCH(15),CH1,CH2 INTEGER NCLOTR,NH,NIH,NQH,NVTC,NTRVT,ICH(15) * * * XGUES is a guess to the vertex position. * REAL XGUES(3) &SELF,IF=TCDEBUG. REAL PROB &SELF. * INTEGER IERTRK SAVE IERTRK * &CDE,CBLINK. &CDE,TCLIFT. &CDE,TCPRMS. &CDE,TCSTAT. &CDE,TCCUTS. &CDE,CBUNIT. &CDE,TCDEBG,IF=TCDEBUG. &CDE,TRKPRM. &CDE,CFCOMS. &CDE,USKEYS. * DATA IERTRK /0/ * * __________________________________ * * Make sure that there are tracks. * IF(LTCTR.LE.0) RETURN IF(IQ(LTCTR+1).LE.0) RETURN IF(LTCHX.LE.0) THEN RETURN ENDIF NTRAK=IQ(LTCTR+1) IF(NTRAK.LE.0) RETURN * * Make sure that not too many tracks have been found. * IF(NTRAK.GT.4) THEN RETURN ENDIF * &SEQ,TCVERT00,T=PASS,IF=DEBVERTX. * *********************************************************************** * * First we try to fit all the tracks to a common vertex * NTR0 = 0 * DO 500 ITRAK = 1,NTRAK * * Get the address for this tracks TCTR bank. * ITCTR = LQ(LTCTR-ITRAK) * * Make sure that this track has not been connected to a vertex. * CCC IF(IQ(ITCTR+3).GT.0) GOTO 500 * * Find out what the first layer is. If it is inside LYVXTC, * including pwc hits and the z0 is within +/- ZVTXTC of * ZOFFTC, then try to attach it to the primary vertex. * Otherwise, it goes on the secondary vertex list. * CCC IF( ((IQ(ITCTR+4).LE.LYVXTC).OR.(IQ(ITCTR+8).GT.0)) CCC & .AND. (ABS(Q(ITCTR+12)-ZOFFTC) .LT. ZVTXTC)) THEN IF(((IQ(ITCTR+4).LE.LYVXTC).OR.(IQ(ITCTR+8).GT.0))) THEN * NTR0=NTR0+1 NTRK0(NTR0)=ITRAK * ENDIF * 500 CONTINUE * &SEQ,TCVERT01,T=PASS,IF=DEBVERTX. * IVRTX=0 * * If NTR0 is at least 1, then we want to use the TCVERTX routine * to iterate to a common vertex, otherwise immediately search * for secondary vertices * IF(NTR0.LE.0) GOTO 900 * * Create a vertex and momentum bank for this vertex. * IVRTX = IVRTX + 1 CALL MZLIFT(IXTCVX,LTCVT,LTCVX,-IVRTX,MTCVT,0) * * Now use the TCVRTX routine to fit and store this vertex, and * the momentum of the particles at the vertex. * XGUES(1) = 0.0 XGUES(2) = 0.0 XGUES(3) = 0.0 * CALL TCVRTX(NTR0,NTRK0,IVRTX,NDROP,IDROP,IERR,XGUES) IF(IERR.EQ. 0)ISTKTC(40) = ISTKTC(40) + 1 IF(IERR.EQ.100)ISTKTC(41) = ISTKTC(41) + 1 IF(IERR.EQ.300)ISTKTC(42) = ISTKTC(42) + 1 IF(IERR.EQ.400)ISTKTC(43) = ISTKTC(43) + 1 IF(IERR.EQ.500)ISTKTC(44) = ISTKTC(44) + 1 IF(IERR.EQ.600)ISTKTC(45) = ISTKTC(45) + 1 IF(IERR.EQ.700)ISTKTC(46) = ISTKTC(46) + 1 IF(NTR0 .GT. ISTKTC(50)) ISTKTC(50) = NTR0 * &SEQ,TCVERT02,T=PASS,IF=DEBVERTX. * * Check the result and drop the vertex if unsatisfactory * VTCHSQ=Q(LTCVT+14) ISELVX=1 C...keep the main vertex unless divergence IF(IERR.GT.300) ISELVX=0 IF(ISELVX.EQ.1) THEN IQ(LTCVX+1)=IVRTX ELSE * CALL MZDROP(IXSTOR,LTCVT,'L') IVRTX=IVRTX-1 * ENDIF C...return if the main vertex is very good IF(VTCHSQ.LT.1.5) RETURN * 900 CONTINUE * IQ(LTCVX+1)=IVRTX * ************************************************************************ * NTR0 = 0 NTR1 = 0 NTR2 = 2 NCLOTR=0 NDROP=0 DO 1000 ITRAK = 1,NTRAK * * Get the address for this tracks TCTR bank. * ITCTR = LQ(LTCTR-ITRAK) * * Make sure that this track has not been connected to a vertex. * C IF(IQ(ITCTR+3).GT.0) GOTO 1000 * * Find out what the first layer is. If it is inside LYVXTC, * including pwc hits and the z0 is within +/- ZVTXTC of * ZOFFTC, then try to attach it to the primary vertex. * Otherwise, it goes on the secondary vertex list. * C-request more than one hits in the pwc (i.e. 2) to put the track C-directly on the main vertex list, try to fit secondary vertices C-otherwise * * Make sure it was well fit here. * IF(IQ(ITCTR+6).LT.30) THEN NTR1=NTR1+1 NTRK1(NTR1)=ITRAK ENDIF * * 1000 CONTINUE * &SEQ,TCVERT01,T=PASS,IF=DEBVERTX. * IVRTX=0 * * If NTR0 is at least 1, then we want to use the TCVERTX routine * to iterate to a common vertex. * IF(NTR1.LE.0) RETURN IF(NTR1.EQ.1) THEN NTR0=NTR0+1 NTRK0(NTR0)=NTRK1(1) NTR1=0 GOTO 1500 ENDIF * DO 2001 ITR=1,NTR1-1 DO 2000 JTR=ITR+1,NTR1 ITCTR = LQ(LTCTR-ITR) JTCTR = LQ(LTCTR-JTR) IL1=IQ(ITCTR+4) JL1=IQ(JTCTR+4) IF(IABS(IL1-JL1).GT.2) GOTO 2000 NTRK2(1)=NTRK1(ITR) NTRK2(2)=NTRK1(JTR) * * Create a vertex and momentum bank for this vertex. * DO 1300 IB=1,2 ITRAK=NTRK2(IB) ITCHX=LQ(LTCHX-ITRAK) DO I=1,2 XH(I+(IB-1)*2)=Q(ITCHX+1+(I-1)*6) YH(I+(IB-1)*2)=Q(ITCHX+2+(I-1)*6) ZH(I+(IB-1)*2)=Q(ITCHX+3+(I-1)*6) RH(I+(IB-1)*2)=SQRT(XH(I+(IB-1)*2)**2+YH(I+(IB-1)*2)**2) ENDDO IF(ZH(1+(IB-1)*2).EQ.0..OR.ZH(2+(IB-1)*2).EQ.0.) THEN NCLOTR=NCLOTR+1 ENDIF 1300 CONTINUE IVRTX=IVRTX+1 CALL MZLIFT(IXTCVX,LTCVT,LTCVX,-IVRTX,MTCVT,0) * * Now use the TCVRTX routine to fit and store this vertex, and * the momentum of the particles at the vertex. * C-hpd in LOCATER this guess is always zero, I use the mean position of C-hpd the first hits of the two tracks if NTRACKS <> 2 C-hpd if ntracks=2 ==> guess = cross of two lines thru the first two hits IF (NCLOTR.EQ.0) THEN A=(YH(2)-YH(1))/(XH(2)-XH(1)) B=YH(1) - A*XH(1) C=(YH(4)-YH(3))/(XH(4)-XH(3)) D=YH(3) - C*XH(3) XGUES(1)=(D-B)/(A-C) XGUES(2)=A*XGUES(1)+B * IF(ABS(ZH(2)-ZH(1)).LT.1.E-2) THEN XGUES(3)=ZH(1) ELSEIF(ABS(ZH(4)-ZH(3)).LT.1.E-2) THEN XGUES(3)=ZH(3) ELSE A=(RH(2)-RH(1))/(ZH(2)-ZH(1)) B=RH(1) - A*ZH(1) C=(RH(4)-RH(3))/(ZH(4)-ZH(3)) D=RH(3) - C*ZH(3) XGUES(3)=(D-B)/(A-C) ENDIF ENDIF * CALL TCVRTX(NTR2,NTRK2,IVRTX,NDRO2,IDRO2,IERR,XGUES) IF(IERR.EQ. 0)ISTKTC(40) = ISTKTC(40) + 1 IF(IERR.EQ.100)ISTKTC(41) = ISTKTC(41) + 1 IF(IERR.EQ.300)ISTKTC(42) = ISTKTC(42) + 1 IF(IERR.EQ.400)ISTKTC(43) = ISTKTC(43) + 1 IF(IERR.EQ.500)ISTKTC(44) = ISTKTC(44) + 1 IF(IERR.EQ.600)ISTKTC(45) = ISTKTC(45) + 1 IF(IERR.EQ.700)ISTKTC(46) = ISTKTC(46) + 1 IF(NTR0 .GT. ISTKTC(50)) ISTKTC(50) = NTR0 IF(NDRO2.GT.0) THEN DO 1900 I=1,NDRO2 IF(NDROP.GT.0) THEN DO J=1,NDROP IF(IDROP(J).EQ.IDRO2(I)) GOTO 1900 ENDDO ENDIF NDROP=NDROP+1 IDROP(NDROP)=IDRO2(I) 1900 CONTINUE ENDIF C--check flight-momentum sine of the vertex IQ(LTCVX+1)=IVRTX LTCVT=LQ(LTCVX-IVRTX) NTRVT=IQ(LTCVT+1) ISELVX=1 C...check for two track case only IF(NTRVT.EQ.2) THEN DO I=1,3 VTCOR(I)=Q(LTCVT+4+I) VTMOM(I)=0 ENDDO VTCHSQ=Q(LTCVT+14) ITCVP=LQ(LTCVT-1) DO ITRAK=1,2 DO I=1,3 VTMOM(I)=VTMOM(I)+Q(ITCVP+3+I) ENDDO ITCVP=ITCVP+13 ENDDO PVT=0. FVT=0. RVT=0. QVT=0. VTCN=0. DO I=1,3 PVT=PVT+VTMOM(I)**2 FVT=FVT+VTCOR(I)**2 IF(I.LE.2) THEN VTCN=VTCN+VTMOM(I)*VTCOR(I) QVT=QVT+VTMOM(I)**2 RVT=RVT+VTCOR(I)**2 ENDIF ENDDO IF(PVT.GT.1.E-6) THEN PVT=SQRT(PVT) ELSE PVT=1.E-3 ENDIF IF(QVT.GT.1.E-6) THEN QVT=SQRT(QVT) ELSE QVT=1.E-3 ENDIF IF(FVT.GT.1.E-6) THEN FVT=SQRT(FVT) ELSE FVT=1.E-3 ENDIF IF(RVT.GT.1.E-6) THEN RVT=SQRT(RVT) ELSE RVT=1.E-3 ENDIF VTCN=VTCN/QVT/RVT C...drop the vertex, if the sine of the momentum and the flight is too large C or the vertex is "behind" the tracks AVHIT=(IQ(ITCTR+4)+IQ(ITCTR+5))/2. AVHIT=AVHIT*(24.3-5.9)/23.+5.9 IF(VTCHSQ.GT.6.) ISELVX=0 IF(RVT.GT.1..AND.VTCN.LT.0.85) ISELVX=0 IF(AVHIT.LT.RVT) ISELVX=0 IF(IL1.GT.3.OR.JL1.GT.3) THEN IF(RVT.LT.6.) ISELVX=0 ENDIF ENDIF C...two track case end IF(IERR.NE.0) ISELVX=0 IF(NTRVT.EQ.0) ISELVX=0 IF(ISELVX.EQ.0) THEN * CALL MZDROP(IXSTOR,LTCVT,'L') IVRTX=IVRTX-1 * ELSE BCH(IVRTX)=VTCHSQ ENDIF 2000 CONTINUE 2001 CONTINUE NVM=IVRTX * &SEQ,TCVERT02,T=PASS,IF=DEBVERTX. * * Copy any dropped tracks to the other list. * IF(NDROP.GT.0) THEN DO 1100 I = 1,NDROP NTR0 = NTR0 + 1 NTRK0(NTR0) = IDROP(I) 1100 CONTINUE ENDIF * * IQ(LTCVX+1)=IVRTX * 1500 CONTINUE C--- try to fit the main vertex on the rest IF(NTR0.LE.0) GOTO 3000 IVRTX=IVRTX+1 CALL MZLIFT(IXTCVX,LTCVT,LTCVX,-IVRTX,MTCVT,0) DO 2500 I=1,NTR0 ITRAK=NTRK0(I) ITCHX=LQ(LTCHX-ITRAK) IF (LQ(ITCHX).GT.0) THEN DO J=1,3 XGUES(J)=XGUES(J)+Q(ITCHX+J) ENDDO ENDIF 2500 CONTINUE DO I=1,3 XGUES(I) = XGUES(I)/FLOAT(NTR0) END DO CALL TCVRTX(NTR0,NTRK0,IVRTX,NDROP,IDROP,IERR,XGUES) IF(IERR.EQ. 0)ISTKTC(40) = ISTKTC(40) + 1 IF(IERR.EQ.100)ISTKTC(41) = ISTKTC(41) + 1 IF(IERR.EQ.300)ISTKTC(42) = ISTKTC(42) + 1 IF(IERR.EQ.400)ISTKTC(43) = ISTKTC(43) + 1 IF(IERR.EQ.500)ISTKTC(44) = ISTKTC(44) + 1 IF(IERR.EQ.600)ISTKTC(45) = ISTKTC(45) + 1 IF(IERR.EQ.700)ISTKTC(46) = ISTKTC(46) + 1 IF(NTR0 .GT. ISTKTC(50)) ISTKTC(50) = NTR0 LTCVT=LQ(LTCVX-IVRTX) VTCHSQ=Q(LTCVT+14) ISELVX=1 IF(VTCHSQ.GT.6.) ISELVX=0 IF(IERR.NE.0) ISELVX=0 IF(ISELVX.EQ.0) THEN CALL MZDROP(IXSTOR,LTCVT,'L') IVRTX=IVRTX-1 ELSE LTCVT=LQ(LTCVX-IVRTX) DO I=1,3 VTCOR(I)=Q(LTCVT+4+I) ENDDO VTCHSQ=Q(LTCVT+14) ENDIF IQ(LTCVX+1)=IVRTX 3000 CONTINUE 3500 CONTINUE C...study the tracks, associated to the vertices IF(LTCVX.LE.0) RETURN NV=IQ(LTCVX+1) IF(NV.GT.15) THEN WRITE(LERR,'(I2,'' VERTICES IN TCVERT, RETURN'')') NV GOTO 9999 ENDIF DO J=1,20 IVTRAK(J)=0 DO I=1,15 IVTVXB(J,I)=0 ENDDO ENDDO II=1 IW(II)=NV IF(NV.LE.0) GOTO 9999 DO I=1,NV II=II+1 LTCVT=LQ(LTCVX-I) NTR=IQ(LTCVT+1) ITRS(I)=NTR IW(II)=-NTR ITCVP=LQ(LTCVT-1) DO J=1,NTR II=II+1 JTCTR=IQ(ITCVP+1) IW(II)=JTCTR IVTVXB(JTCTR,I)=1 ITCVP=ITCVP+13 ENDDO ENDDO IF(NV.LE.1) GOTO 9999 DO I=1,II IF(IW(I).LT.0) IW(I)=-IW(I) ENDDO DO J=1,20 IVTS(J)=0 DO I=1,15 IF(IVTVXB(J,I).EQ.1) IVTS(J)=IVTS(J)+1 ENDDO ENDDO I=0 DO J=1,20 IF(IVTS(J).GT.1) I=1 ENDDO IF(I.EQ.0) GOTO 9999 DO I=1,15 IKEEPV(I)=0 ENDDO JJ=1 DO 4000 I=1,NV JJ=JJ+1 NTR=IW(JJ) IFL=1 DO 3900 J=1,NTR JJ=JJ+1 ITR=IW(JJ) IF(IVTS(ITR).GT.1) IFL=0 3900 CONTINUE IF(IFL.EQ.0) THEN IKEEPV(I)=-1 ELSE IKEEPV(I)=1 ENDIF 4000 CONTINUE IFL=0 DO I=1,NV IF(IKEEPV(I).LT.0) IFL=IFL-1 ENDDO IF(IFL.GE.-1) GOTO 9999 DO I=1,20 ITRB(I)=0 ENDDO JJ=1 DO 4200 I=1,NV JJ=JJ+1 NTR=IW(JJ) IFL=1 DO 4100 J=1,NTR JJ=JJ+1 ITR=IW(JJ) IF(IKEEPV(I).EQ.-1) ITRB(ITR)=1 4100 CONTINUE 4200 CONTINUE NTR0=0 DO I=1,20 IF(ITRB(I).EQ.1) THEN NTR0=NTR0+1 NTRK0(NTR0)=I ENDIF ENDDO * IVRTX=IVRTX+1 CALL MZLIFT(IXTCVX,LTCVT,LTCVX,-IVRTX,MTCVT,0) DO 4500 I=1,NTR0 ITRAK=NTRK0(I) ITCHX=LQ(LTCHX-ITRAK) IF (LQ(ITCHX).GT.0) THEN DO J=1,3 XGUES(J)=XGUES(J)+Q(ITCHX+J) END DO ENDIF 4500 CONTINUE DO I=1,3 XGUES(I) = XGUES(I)/FLOAT(NTR0) END DO CALL TCVRTX(NTR0,NTRK0,IVRTX,NDROP,IDROP,IERR,XGUES) IF(IERR.EQ. 0)ISTKTC(40) = ISTKTC(40) + 1 IF(IERR.EQ.100)ISTKTC(41) = ISTKTC(41) + 1 IF(IERR.EQ.300)ISTKTC(42) = ISTKTC(42) + 1 IF(IERR.EQ.400)ISTKTC(43) = ISTKTC(43) + 1 IF(IERR.EQ.500)ISTKTC(44) = ISTKTC(44) + 1 IF(IERR.EQ.600)ISTKTC(45) = ISTKTC(45) + 1 IF(IERR.EQ.700)ISTKTC(46) = ISTKTC(46) + 1 IF(NTR0 .GT. ISTKTC(50)) ISTKTC(50) = NTR0 LTCVT=LQ(LTCVX-IVRTX) VTCHSQ=Q(LTCVT+14) ISELVX=1 IF(VTCHSQ.GT.6.) ISELVX=0 IF(IERR.NE.0) ISELVX=0 IF(ISELVX.EQ.0) THEN CALL MZDROP(IXSTOR,LTCVT,'L') IVRTX=IVRTX-1 C...try to find the smallest chisquared as independent pairs IF(NV.GE.3) THEN CH1=0. DO 4700 I=1,NV CH2=999. DO 4600 J=1,NV IF(BCH(J).LT.CH2.AND.BCH(J).GT.CH1) THEN ICH(I)=J CH2=BCH(J) ENDIF 4600 CONTINUE CH1=CH2 4700 CONTINUE JJ=1 DO 4900 I=1,NV JJ=JJ+1 NTR=IW(JJ) IF(I.EQ.ICH(1)) THEN ITR1=IW(JJ+1) ITR2=IW(JJ+2) ENDIF IF(I.EQ.ICH(2)) THEN ITR3=IW(JJ+1) ITR4=IW(JJ+2) ENDIF DO 4800 J=1,NTR JJ=JJ+1 4800 CONTINUE 4900 CONTINUE IF(ITR1.NE.ITR3.AND.ITR1.NE.ITR4) THEN IF(ITR2.NE.ITR3.AND.ITR2.NE.ITR4) THEN DO I=3,NV IV=ICH(I) IF(IKEEPV(I).EQ.-1) THEN LTCVT=LQ(LTCVX-IV) CALL MZDROP(IXSTOR,LTCVT,'L') IVRTX=IVRTX-1 ENDIF ENDDO IQ(LTCVX+1)=IVRTX GOTO 9000 ENDIF ENDIF ENDIF ELSE LTCVT=LQ(LTCVX-IVRTX) DO I=1,3 VTCOR(I)=Q(LTCVT+4+I) ENDDO VTCHSQ=Q(LTCVT+14) IF(VTCHSQ.LT.1.5) THEN DO I=NV,1,-1 IF(IKEEPV(I).EQ.-1) THEN LTCVT=LQ(LTCVX-I) CALL MZDROP(IXSTOR,LTCVT,'L') IVRTX=IVRTX-1 ENDIF ENDDO IQ(LTCVX+1)=IVRTX NV=IQ(LTCVX+1) ENDIF ENDIF * 9000 CONTINUE IQ(LTCVX+1)=IVRTX * CALL MZGARB(IXTCVX,0) * C...PUT STRUCTURAL LINKS IN TCVX STRICT (NO GAP) C NS=IQ(LTCVX-2) IFL=0 DO 9200 I=1,NVM-1 IF(LQ(LTCVX-I).EQ.0) THEN IFL=IFL+1 DO 9100 J=I+1,NVM+1 IF(LQ(LTCVX-J).NE.0) THEN LTCVT=LQ(LTCVX-J) LQ(LTCVX-I)=LTCVT LQ(LTCVX-J)=0 LQ(LTCVT+2)=LTCVX-I GOTO 9200 ENDIF 9100 CONTINUE ENDIF IF((I-IFL).EQ.IVRTX) GOTO 9300 9200 CONTINUE 9300 CONTINUE * 9999 CONTINUE NV=IQ(LTCVX+1) IF(NV.NE.IVRTX) THEN WRITE(LERR,'(''*** ERROR *** TCVERT : vertex # check'')') WRITE(LERR,'('' run/event :'',2I8)') & IEHDCB(4),IEHDCB(5) ENDIF IF(NV.GT.0) THEN DO I=1,NV IF(LQ(LTCVX-I).LE.0) THEN WRITE(LERR,'(''*** ERROR *** TCVERT : empty link to TCVT'')') WRITE(LERR,'('' run/event :'',2I8)') & IEHDCB(4),IEHDCB(5) ELSE LTCVT=LQ(LTCVX-I) ITCVP=LQ(LTCVT-1) IF(ITCVP.LE.0) THEN WRITE(LERR,'(''*** ERROR *** TCVERT : empty link to TCVP'')') WRITE(LERR,'('' run/event :'',2I8)') & IEHDCB(4),IEHDCB(5) ENDIF ENDIF ENDDO ENDIF * RETURN END +ADD,CFSTOR,README,*. &DECK,readme. *CMZU: 3.05/01 28/03/95 12.04.43 by Pal Hidas *-- Author : Pal Hidas 28/03/95 * FUNCTION WARNING **************************************************************************** * Do not compile this patch : //CBKFIT/CFSTOR please * **************************************************************************** END