C=============================================================================== SUBROUTINE CTVMPR (LSUNIT,DBGPRTa, PARERRa) C=============================================================================== C Author: John Marriner, CDF, FNAL (with a little help from his friends) C print the fit results of CTVMFT C Input parameters C LSUNIT = fortran logical unit for write C DBGPRTa = print level C PARERR Original (input) track parameters C Preconditions C CTVMFT must have been called and returned no error C CTVMPR assumes fit information is stored in common defined by CTVMFT.INC C------------------------------------------------------------------------------- IMPLICIT NONE #include INTEGER DBGPRTa, LSUNIT REAL PARERRa(5,MaxTrk) INTEGER I,J,K,L,M,N, IFAIL, IM, IN, INDEX(5) INTEGER Nt,Nv,Mv, Nc,Np,Nm, NtF,NvF, NPAR, NVPAR, NPC INTEGER NtrVtx(0:Maxvtx), TMcn(MaxTrk) LOGICAL PRIMARY REAL CHIP, VALUE,SIGMA, U,V,W, ERRRAT(5), PULL(3) REAL DXYZ(3), Dr,Dz, Dl(3) REAL ERR(MAXDIM), WORK(MAXDIM), CORR(MAXDIM,MAXDIM) DOUBLE PRECISION P4(4), EPAR(5,5) INTEGER MRUN,MNEV INTEGER MTRACK(MaxTrk) LOGICAL FIRST CHARACTER*9 VN, VP, VS, VB SAVE MRUN,MNEV, VP,VS,VB DATA VP / 'primary ' /, VS / 'secondary' /, VB / ' ' / DATA MRUN /-1/, MNEV /-1/ C------------------------------------------------------------------------------- C Write header, chi-squared, # deg of freedom IF (RunNum.NE.MRUN .OR. TrgNum.NE.MNEV) THEN call print_s(' =============================================\n') MRUN = RunNum MNEV = TrgNum END IF DO I=1,MaxTrk MTRACK(I) = I END DO Nc = 0 Np = 0 PRIMARY =.FALSE. NtrVtx(0) = 0 DO Nv=1,NVERTX NtrVtx(Nv) = 0 Do Nt=1,NTRACK IF (TrkVtx(Nt,Nv)) NtrVtx(Nv) = NtrVtx(Nv)+1 END DO IF (VtxPnt(Nv,1).EQ.0) PRIMARY =.TRUE. Nc = Nc + Cvtx(Nv) IF (VtxPnt(Nv,1).GE.0) THEN NPC = VtxPnt(Nv,2) IF (NPC.EQ.3) NPC = 2 Np = Np+NPC END IF END DO C make the fit errors and the correlation matrix NPAR = TOFF(NTRACK)+3 C Loop over fitted parameters DO I=1,NPAR C Get error = sqrt(diagonal element) ERR(I) = DSQRT(VMAT(I,I)) END DO C Correlation matrix DO I=1,NPAR DO J=1,NPAR CORR(I,J) = VMAT(I,J)/(ERR(I)*ERR(J)) ENDDO ENDDO I = RunNum J = TrgNum CHIP = AMIN1(CHISQR(0),999.0) CALL MCALC(NTRACK,MTRACK, Value,SIGMA, P4) VALUE = AMIN1(VALUE,999.999) SIGMA = AMIN1(SIGMA, 99.999) call print_v('-----------------------------------------------\n') call print_v(' Event %5i.',i) call print_v('%6i;',j) call print_v(' Ct_VM fit results Chi square = %7.2f',chip) call print_v(' Ndof %3i;',ndof) call print_v(' (Iter %3i',iter) call print_v(', NtCut %3i)',ntscut) call print_s(' Mass Sigma\n') call print_v(' %2i Tracks',ntrack) call print_v(' %2i Vertices;',nvertx) call print_v(' Constraints (Pointing %3i',np) call print_v(', Conversion %2i',nc) call print_v(', Mass %2i)',nmassc) call print_v(' %8.3f',value) call print_v('%7.3f\n',sigma) c----------------------------------------------------------------------- C write vertex fit Chi-Square results c----------------------------------------------------------------------- call print_s(' Vertex coordinate fit results\n') call print_s(' Vtx Ntr Xv Yv Zv') call print_s(' Chisq Np Nc DLr DLz') call print_s(' SumPx SumPy SumPz Sum_E') L = 1 IF (PRIMARY) L=0 DO Nv=L,NVERTX IF (Nv.GT.0) THEN NvF = VOFF(Nv) END IF CHIP = AMIN1(CHIV(Nv),999.0) Dr = 0 Dz = 0 IF (Nv.EQ.0) THEN NvF = 0 Np =-1 Nc =-1 c$$$ WRITE(LSUNIT,1015) VP,Nv,NtrVtx(Nv),(XYZVRT(I,Nv),I=1,3),CHIP c$$$ WRITE(LSUNIT,1016) (ERR(NvF+I),I=1,3) ELSE VN = VS IF (Nv.GT.1) VN=VB Mv = VtxPnt(Nv,1) Nc = Cvtx(Nv) Np = VtxPnt(Nv,2) IF (Np.LT.0) Np = 0 IF (NP.EQ.3) NP = 2 IF (Np.LT.1) PCON(Nv,1)=0.0 IF (Np.LT.2) PCON(Nv,2)=0.0 NvF = VOFF(Nv) IF (Np.LE.0) THEN c$$$ WRITE(LSUNIT,1015) VN,Nv,NtrVtx(Nv),(XYZVRT(I,Nv),I=1,3) c$$$ &, CHIP, Np,Nc, (VtxP4(I,Nv),I=1,4) c$$$ 1015 FORMAT(1X,A9,I3,I5, F11.4,F9.4,F10.4,F9.2 c$$$ &, I5,I4,20X ,F14.3,3F8.3) c$$$ WRITE(LSUNIT,1016) (ERR(NvF+I),I=1,3) c$$$ 1016 FORMAT(20X,2F9.4,F10.4 , 58X,3F6.3) ELSE CALL DCALC(Nv,Mv, DXYZ, Dr,Dz, Dl) c$$$ WRITE(LSUNIT,1017) VN,Nv,Mv,NtrVtx(Nv),(XYZVRT(I,Nv),I=1,3) c$$$ &, CHIP, Np,Nc,Dr,Dz,(VtxP4(I,Nv),I=1,4) c$$$ 1017 FORMAT(1X,A9,I3,',',I1,I3,2X, F9.4,F9.4,F10.4,F9.2 c$$$ &, I5,I4,F9.4,F10.4,5X,F10.3,3F8.3) c$$$ WRITE(LSUNIT,1018) (ERR(NvF+I),I=1,3),Dl c$$$ 1018 FORMAT(20X,2F9.4,F10.4,15X,2F7.4,F8.4, 20X,3F6.3) END IF END IF END DO c$$$ WRITE(LSUNIT,*) C Write information on mass constraints IF (NMASSC.GT.0) THEN DO Nm=1,NMASSC L = 0 DO Nt=1,NTRACK IF (TrkMcn(Nt,Nm)) THEN L = L+1 TMcn(L) = Nt END IF END DO IF (Nm.EQ.1) THEN c$$$ WRITE(LSUNIT,1020) Nm, CMASS(Nm),FMCDIF(Nm),(TMcn(I),I=1,L) c$$$ 1020 FORMAT(' Mass Constraints; Mcn',I2,' Mass ',F7.4,' Gev/c**2' c$$$ &, ' Residual ' ,1P,E9.1,' Mev/c**2 Tracks',10I3) ELSE c$$$ WRITE(LSUNIT,1021) Nm, CMASS(Nm),FMCDIF(Nm),(TMcn(I),I=1,L) c$$$ 1021 FORMAT(I24, F13.4,17X,1P,E12.1 ,18X ,10I3) END IF END DO c... WRITE(LSUNIT,*) END IF C Now, print the track fit results call print_s(' Track parameter fit results -\n') call print_s('Vtx Bank Mass Crv Phi ') call print_s('Ctg D0 Z0 Chisq ') call print_s(' ErrFit / ErrMst\n') DO 50 Nv=1,Nvertx c... WRITE(LSUNIT,*) DO 49 Nt=1,Ntrack IF (.NOT.TrkVtx(Nt,Nv)) GO TO 49 NtF = TOFF(Nt) VALUE = AMIN1(CHIT(Nt),999.0) DO I=1,3 ERRRAT(I) = ERR(NtF+I) / PARERRa(I,Nt) END DO call print_v('%3i)',nt) call print_v('%3i QTRK',nv) call print_v('%3i',list(nt)) call print_v('%8.4f',tmass(nt)) do j=1,5 call print_v('%12.5e',par(j,nt)) enddo call print_v('%9.2f\n',value) call print_s(' ') do j=1,3 call print_v('%12.5e',err(ntf+j)) enddo call print_s(' ') do j=1,3 call print_v('%6.3f',errrat(j)) enddo call print_s('\n') IF (DBGPRTa.LT.987654) GO TO 49 c----------------------------------------------------------------------- c Loop over weight matrix c----------------------------------------------------------------------- DO I = 1, 5 DO J = 1, 5 EPAR(I,J) = G(I,J,NT) ENDDO ENDDO c----------------------------------------------------------------------- C Invert weight matrix to get error matrix c----------------------------------------------------------------------- CALL DINV(5,EPAR,5,WORK,IFAIL) c----------------------------------------------------------------------- C Get index into fit error matrix for track NT C Loop over fitted parameters (first 3 in a track) c----------------------------------------------------------------------- DO I = 1,3 C Get sigma = denominator for pull SIGMA = EPAR(I,I) - VMAT(NtF+I,NtF+I) C Allow modest underflow (rounding errors?) IF (ABS(SIGMA) .LT. 0.001*EPAR(I,I)) SIGMA = 0.001*EPAR(I,I) C Test for negative argument IF (SIGMA .LT. 0.0) GO TO 45 C Pull = (Fitted value - CTC fit)/sigma PULL(I) = PARDIF(I,NT)/SQRT(SIGMA) C Continue loop on fitted parameters ENDDO c----------------------------------------------------------------------- C Write pulls, contribution to chi-squared for this track c----------------------------------------------------------------------- call print_v(' Pulls: %9.4f',pull(1)) call print_v('%9.4f',pull(2)) call print_v('%9.4f\n',pull(3)) GO TO 49 45 CONTINUE call print_s(' Error in calculating pulls.\n') c----------------------------------------------------------------------- C Continue loop on tracks c----------------------------------------------------------------------- 49 CONTINUE 50 CONTINUE c----------------------------------------------------------------------- C Loop over fitted parameters c----------------------------------------------------------------------- 60 CONTINUE IF (DBGPRTa.LE.99) GO TO 900 C Write header for error matrix print call print_s('\n Correlation matrix\n') DO I=1,NPAR DO J=1,I call print_v(' %5.2f',corr(i,j)) enddo call print_s('\n') ENDDO C Done. Exit 900 CONTINUE RETURN END