C=============================================================================== SUBROUTINE CTVMPF (PRINT, NV, VXI) C=============================================================================== C CTVMPD calculates "pointing constraint" contributions to the derivative C vector and matrix for vertex Nv, "pointing" at vertex Mv =VtxPnt(Nv,2) C--Input parameters C Input data in the include file CTVMFT (COMMON /CTVMFC/) C Let dX, dY, dZ = difference between the first and the second vertex C Px = VtxP4(1,Nv), etc C dX = DELV(1), etc C The first pointing constraint is Px * dY - Py * dX = 0, C The second is Pi * dZ - Pz * di = 0 C (where i is x if |Px| > |Py|, otherwise i is y) C The first pointing constraint constrains the projections of the two vectors C P and d onto the x,y plane to be parallel (or antiparallel). C The second constraint constrains the vectors to be parallel or antiparallel C in 3 dimensions. C NB: The program makes this explicit choice of axes so that one can apply an C x,y pointing constraint or (optionally) a 3 dimensional constraint. C This choice of axes will not produce the desired results for the case C Px = Py = 0. This case is thought to be unlikely; It might occur for massive C objects (Z`s, eg) produced with no transverse momentum. For these types of C events one is probably better advised to use the "beam constraint" anyway. C Edit log: C ---- --- C 10/xx/94 WJA To handle 1-track vertex, add NPC variable and set it to C the number of Lagrange multipliers needed to effect the C desired pointing constraint: normally equal to VtxPnt(Nv,2) C but equal to 2 if VtxPnt(Nv,2) is zero, since 1-track point C points in both projections. C------------------------------------------------------------------------------- IMPLICIT NONE #include INTEGER PRINT INTEGER Nv DOUBLE PRECISION VXI(MaxDim) REAL TEMP(5), C, DELV(3) INTEGER I1,I2, IMAT,JMAT INTEGER NvF,MvF,Kv,KvF,NtF, LpF,Lp, I,J, Nt,Mv, Np INTEGER NPC C------------------------------------------------------------------------------- C IMAT points to larger PSUM component (1=x,2=y) IF (ABS(VtxP4(1,Nv)).GT.ABS(VtxP4(2,Nv))) THEN IMAT = 1 JMAT = 0 ELSE IMAT = 2 JMAT = 4 END IF C vertex towards which Nv "points" Mv = VtxPnt(Nv,1) C vertex displacement vector DO I=1,3 DELV(I) = XYZVRT(I,Mv) - XYZVRT(I,Nv) END DO C offset to 2nd vertex NvF = VOFF(Nv) C offset to this pointing constraint LpF = POFF(Nv) C offset to target (primary) vertex MvF = 0 C the target vertex is NOT primary IF (Mv.GT.0) MvF=VOFF(Mv) NPC = VtxPnt(Nv,2) C Use both constraints for 1-track vertex IF (NPC.EQ.3) NPC = 2 C Loop over pointing constraints DO 50 Np=1,NPC C offset to the current pointing constraint Lp = LpF + Np C First constraint. 1=x, 2=y IF (Np.EQ.1) THEN I1 = 1 I2 = 2 C otherwise 2nd constraint ELSE C 1=bigger of px,py (IMAT), 2=z I1 = IMAT I2 = 3 ENDIF C "residual" (Pi) VXI(Lp) =-VtxP4(I1,Nv)*DELV(I2) +VtxP4(I2,Nv)*DELV(I1) C dPi/dI1p (1st vtx) VMAT(MvF+I1,Lp) =-VtxP4(I2,Nv) C dPi/dI2p VMAT(MvF+I2,Lp) = VtxP4(I1,Nv) C dPi/dI1s (2nd vtx) VMAT(NvF+I1,Lp) =-VMAT(MvF+I1,Lp) C dPi/dI2s VMAT(NvF+I2,Lp) =-VMAT(MvF+I2,Lp) D IF (PRINT.GT.0) THEN D WRITE(PRINT,2040) Lp, Nv,Mv, I1,I2, VXI(Lp) D @, VMAT(MVF+I1,Lp),VMAT(MvF+I2,Lp),VMAT(NvF+I1,Lp),VMAT(NvF+I2,Lp) D2040 FORMAT(/,' Pnt Lp',I3, 2X,2I2,I4,I3, 1P,E11.3,3X,4E11.3) D END IF c----------------------------------------------------------------------- C Scan over ancestor vertices c----------------------------------------------------------------------- DO 40 Kv=NVERTX,Nv,-1 IF (.NOT.VtxVtx(Kv,Nv)) THEN GO TO 40 END IF KvF = VOFF(Kv) C Loop over tracks DO 20 Nt=1,NTRACK C check vertex association IF (.NOT.TrkVtx(Nt,Kv)) GO TO 20 C offset for track Nt NtF = TOFF(Nt) IF (Np .EQ. 1) THEN C (R,Phi) pointing constraint, dP1/dc, dP1/dphi, dP1/dcotg, dP1/dXsv, dP1/dYsv TEMP(1) = DDA(Nt,1)*DELV(2) - DDA(Nt,5)*DELV(1) TEMP(2) = DDA(Nt,2)*DELV(2) - DDA(Nt,6)*DELV(1) TEMP(3) = 0.0 TEMP(4) = DDA(Nt,3)*DELV(2) - DDA(Nt,7)*DELV(1) TEMP(5) = DDA(Nt,4)*DELV(2) - DDA(Nt,8)*DELV(1) ELSE C (R,Z) pointing constraint, dP2/dc, dP2/dphi, dP2/dcotg, dP2/dXsv, dP2/dYsv C = PAR0(1,Nt) + PARDIF(1,Nt) TEMP(1) = DDA(Nt,JMAT+1)*DELV(3) TEMP(1) = TEMP(1) + TrkP4(Nt,3)*DELV(IMAT)/C TEMP(2) = DDA(Nt,JMAT+2)*DELV(3) TEMP(3) =-DELV(IMAT)*TrkP4(Nt,5) TEMP(4) = DDA(Nt,JMAT+3)*DELV(3) TEMP(5) = DDA(Nt,JMAT+4)*DELV(3) ENDIF VMAT(NtF+1,Lp) = TEMP(1) VMAT(NtF+2,Lp) = TEMP(2) VMAT(NtF+3,Lp) = TEMP(3) VMAT(KvF+1,Lp) = TEMP(4) + VMAT(KvF+1,Lp) VMAT(KvF+2,Lp) = TEMP(5) + VMAT(KvF+2,Lp) D IF (PRINT.GT.0) THEN D WRITE(PRINT,2041) NT,LP, TEMP D2041 FORMAT(7X,I3,I5,22X,7E11.3) D END IF C End track loop 20 CONTINUE C End ancestor vertex loop 40 CONTINUE C End pointing constraints loop 50 CONTINUE C===Return to Caller: 100 CONTINUE C Symmetrize the derivative matrix DO I=1,MATDIM-1 DO J=I+1,MATDIM VMAT(J,I) = VMAT(I,J) ENDDO ENDDO RETURN END