C=============================================================================== SUBROUTINE CTVM00 (IERR, WXYZPV) C=============================================================================== C Checks the current input specifications at the beginning of this call to C CTVMFT: (Vertex, conversion, Pointing, Mass Constraints) compound fit. C Any error detected in CTVM00 is a structural failure on the input conditions C and is (by default) treated as a fatal error. We attempt to crash the job C (after printing a specific error condition message). The studious who are C running interactively can discover how to avoid this crash; cf. the variables C "EXCUSE" and "ME", set in a local common block in CTVMFT. C If an error is detected, IERR = IJKERR(1) = 1 C IJKERR(2) = the precise detected trouble. C WXYZPV is returned, it is the primary vertex double precision weight matrix C VtxVtx, the vertex "geneology", association structure is made and returned. C--Input data in the include file CTVMFT (COMMON /CTVMFC/) C NVERTX Number of vertices in this fit (MUST be at least 1) C NTRACK Number of tracks in this fit. NTRACK MUST be at least 2. C TrkVtx(MAXTRK,MAXVTX) (Logical) See the discussion in CTVMFT. C VtxPnt(MAXVTX,2) (Integer) See the discussion in CTVMFT. C TrkMcn(MAXTRK,NMASSC) (Logical) See the discussion in CTVMFT. C CMASS(NMASSC) (Real) See the discussion in CTVMFT. C LIST (MAXTRK) (Integer) C Bank numbers of the tracks to be used. C Note that if LIST(i) is a negative integer it is assumed that the C information for this track is present unchanged from a previous call. C Edit log: C ---- --- C 11/28/94 WJA Require exactly 2 tracks for conversion vertex; always C require 1 or more tracks per vertex; If there is a "single C track vertex", this vertex must be contain at least one C multi-track exclusive vertex in its descendant chain. C=============================================================================== IMPLICIT NONE #include c----------------------------------------------------------------------- INTEGER IERR DOUBLE PRECISION WXYZPV(3,3) INTEGER Nv,Mv,Kv, Nt,Kt, Np,Nm INTEGER I,J, II,JJ INTEGER NtrVtx(MaxVtx) REAL SUM, WORK(MAXDIM) CHARACTER*4 NAME CHARACTER*80 STRING REAL ZERO,MINUS,SHOUT DATA ZERO /0.0/, MINUS /-1.0/ c----------------------------------------------------------------------- c Check Input Conditions for illegal conditions c----------------------------------------------------------------------- c$$$ call print_v('CTVM00: number of tracks: %2i\n',NTRACK) c$$$ call print_v('CTVM00: number of vertices: %2i\n',NVERTX) c$$$ do i=1,ntrack c$$$ call print_v('CTVM00: track %2i',i) c$$$ call print_v('list %2i\n',list(i)) c$$$ enddo IF (NTRACK.LT.2 .OR. NTRACK.GT.MAXTRK) THEN IJKERR(2) = 1 call print_v('CTVM00: Wrong number of tracks: %2i',NTRACK) GOTO 900 ENDIF IF (NVERTX.LT.1 .OR. NVERTX.GT.MAXVTX) THEN IJKERR(2) = 2 call print_v('CTVM00: Wrong number of vertices: %2i',NVERTX) GOTO 900 ENDIF IF (NMASSC.LT.0 .OR. NMASSC.GT.MAXMCN) THEN IJKERR(2) = 3 call print_v('CTVM00: Wrong number of mass constraints: %2i', $ NMASSC) GOTO 900 ENDIF c----------------------------------------------------------------------- C count the number of measured tracks present at each vertex c----------------------------------------------------------------------- DO Nv=1,MaxVtx NtrVtx(Nv) = 0 Do Nt=1,NTRACK IF (TrkVtx(Nt,Nv)) NtrVtx(Nv) = NtrVtx(Nv)+1 ENDDO ENDDO C make the vertex geneology table DO Kv=NVERTX,1,-1 DO Nv =NVERTX,1,-1 VtxVtx(Kv,Nv) =.FALSE. ENDDO VtxVtx(Kv,Kv) = .TRUE. C Kv is a descendant of its parent, 1 IF (Nv.GT.0) THEN C its parent's parent, ... VtxVtx(Kv,Nv) = .TRUE. Nv = VtxPnt(Nv,1) GOTO 1 ENDIF ENDDO c----------------------------------------------------------------------- C Check the logic of vertex specifications c----------------------------------------------------------------------- DO 10 Kv=NVERTX,1,-1 IJKERR(3) = Kv C Require >0 tracks at each vertex IF (NtrVtx(Kv).LT.1) THEN IJKERR(2) = 11 call print_v('CTVM00: Impossible vertex %2i',kv) call print_v(' with %2i tracks\n',NtrVtx(Kv)) GOTO 900 ENDIF c----------------------------------------------------------------------- C exactly 2 tracks for conversion c----------------------------------------------------------------------- IF (Cvtx(Kv).NE.0) THEN IF (NtrVtx(Kv).NE.2) THEN IJKERR(2) = 12 call print_v('CTVM00: conversion vertex %2i',kv) call print_v(' with %2i tracks\n',NtrVtx(Kv)) GOTO 900 ENDIF ENDIF c----------------------------------------------------------------------- C a one-track vertex must have a descendant with at least 2 tracks c----------------------------------------------------------------------- IF (NtrVtx(Kv).LE.1) THEN Mv = Kv DO Nv=Kv+1,NVERTX IF (VtxPnt(Nv,1).EQ.Mv) THEN IF (NtrVtx(Nv).GT.1) GOTO 5 Mv = VtxPnt(Nv,1) ENDIF ENDDO IJKERR(2) = 13 call print_v('CTVMFT: vertex %2i',kv) call print_v(' with %2i tracks is not legally pointed at\n', $ NtrVtx(Kv)) GOTO 900 ENDIF c----------------------------------------------------------------------- C Check that Kv`s pointing is valid c----------------------------------------------------------------------- 5 CONTINUE Nv = VtxPnt(Kv,1) IF (Nv.LE.0) THEN IF (Nv.LT.0) VtxPnt(Kv,2) = -1 ELSE C Daughter vertex number must exceed IF (Nv.GE.Kv) THEN C mother vertex number IJKERR(2) = 14 call print_v('CTVMFT: vertex %2i',kv) call print_v(' has illegal target vertex number %2i\n',Nv) GOTO 900 ENDIF c----------------------------------------------------------------------- C conversion vertex cannot be a target c----------------------------------------------------------------------- IF (Cvtx(Nv).GT.0) THEN IJKERR(2) = 15 call print_v('CTVMFT: vertex %2i',kv) call print_s(' has illegal target vertex type\n') GOTO 900 ENDIF c----------------------------------------------------------------------- C Single-track pointing if and only if to single-track vertex c----------------------------------------------------------------------- IF (VtxPnt(Kv,2).EQ.3.XOR.NtrVtx(Nv).EQ.1) THEN IJKERR(2) = 16 call print_v('CTVMFT: vertex %2i',kv) call print_v(' ==> %2i',nv) call print_s('is an illegal 1-track vertex pointing\n') GO TO 900 ENDIF ENDIF 10 CONTINUE c----------------------------------------------------------------------- C If VtxPnt requires a primary vertex, checks that the input primary vertex C covariance matrix is "reasonable" (id est, non-singular). c----------------------------------------------------------------------- IJKERR(3) = 0 NP = 0 DO NV=1,NVERTX IF (VtxPnt(Nv,1).EQ.0) NP = NP+1 END DO IF (NP.GT.0) THEN DO I=1,3 C primary vertex input position XYZPV(I) = XYZPV0(I) DO J=1,3 C primary vertex error matrix WXYZPV(J,I)= EXYZPV(J,I) END DO END DO C make the primary vertex weight matrix CALL DINV(3,WXYZPV,3,WORK,I) IF (I.NE.0) THEN IJKERR(2) = 19 call print_s('The input primary vertex covariance matrix') call print_s('is singular.\n') GOTO 900 ENDIF ENDIF c----------------------------------------------------------------------- C Check the specification of tracks: every track must be at a vertex c----------------------------------------------------------------------- DO 20 Nt=1,NTRACK IJKERR(3) = Nt IF (LIST(Nt).LT.0) THEN IJKERR(2) = 20 C some track failed TkSlct IF (LIST(Nt).LT.0) THEN IJKERR(1) = 2 IERR = 2 RETURN END IF call print_v('track %2i is not specified\n',nt) GO TO 900 END IF c$$$ 11 CONTINUE II = 0 DO NV=1,NVERTX IF (TrkVtx(NT,NV)) II=II+1 END DO C every track belongs to a vertex IF (II.LT.1) THEN IJKERR(2) = 21 call print_v('CTVM00: track %2i is not at a vertex\n',nt) GO TO 900 C and to only one vertex ELSE IF (II.GT.1) THEN IJKERR(2) = 22 call print_v('CTVM00: track %2i appears at 2 vertices\n',nt) GO TO 900 END IF C each track may appear only once DO Kt=Nt+1,NTRACK IF (IABS(LIST(Nt)).EQ.IABS(LIST(Kt))) THEN IJKERR(2) = 23 call print_v('CTVM00: track %2i ',nt) call print_v('and track %2i are identical\n',kt) GO TO 900 END IF END DO 20 CONTINUE IJKERR(3) = 0 C Check the Mass Constraint/Track/Vertex specifications DO NM=1,NMASSC II = 0 SUM = 0.0 DO NT=1,NTRACK IF (TrkMcn(NT,NM)) THEN II=II+1 SUM = SUM + TMASS(NT) END IF END DO C check for enough tracks IF (II.LT.2) THEN IJKERR(2) = 31 call print_v('CTVM00: mass constraint %2i has too few tracks', $ nm) GO TO 900 END IF C check for possible mass constraint IF (CMASS(NM).LE.SUM) THEN IJKERR(2) = 32 call print_v('CTVM00: mass constraint %2i ',nm) call print_v('mass %6.3f ',cmass(nm)) call print_v('has track mass 0 %6.3f\n',sum) GO TO 900 END IF END DO 100 CONTINUE IERR = 0 IJKERR(1) = 0 RETURN C Executive action; Terminate with extreme prejudice. 900 CONTINUE IERR = 1 IJKERR(1) = 1 call print_v('Improper input specification, IJKERR= %3i',ijkerr(1)) call print_v('%3i',ijkerr(2)) call print_v('%3i\n',ijkerr(3)) CALL ctvmft_ERROR ('CTVM00',IERR,STRING) C Escape hatch, for debuggery IF (EXCUSE.EQ.0) THEN SHOUT = SQRT(MINUS) / ZERO return ELSE RETURN END IF END