***************************************************************************** INTEGER FUNCTION CRCALOL2() c IMPLICIT NONE C INCLUDE 'INTEST.TXT' C integer ICONTROL5 INTEGER j, m, ii, nn INTEGER i INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY INTEGER IBAR(2,NPLA) integer ifail INTEGER nin INTEGER good2 c LOGICAL good2 c REAL hsh double precision al_pp(2,5), al_p(5) & , xout(npla),yout(npla),zin(npla) REAL PIANO(22) C REAL TX, TY REAL timpx, timpy REAL TG(2) REAL SHIFT REAL BAR(2,NPLA) REAL DISTX, DISTY, Y(NPLA), YY(NPLA) REAL CX, CY REAL RIG, PLANEMAX, RMASS REAL RNSS, QTOTT, RQT REAL CHECK REAL ENER c integer INDEX, NTOT(2), NPIANI,gtr,t integer trkchi2 c REAL EINF, ESUP, RPIANO(2) COMMON/TAGLIOEN/EINF,ESUP,ENER(2) SAVE /TAGLIOEN/ C REAL estrip(2,22,96), ispaw c real ab C parameter(AB=25.) c parameter(AB=260.) real zalig, xalig, yalig C COMMON /SHIFT/ SHIFT SAVE / SHIFT / C COMMON/ANGOLO/BAR,IBAR SAVE / ANGOLO / C COMMON/WHERE/CX,CY,PIANO SAVE / WHERE / C COMMON/GENERAL/RIG,RMASS SAVE / GENERAL / COMMON / CH / CHECK SAVE / CH / C COMMON / clevel1 / al_pp,estrip, ispaw,good2, & trkchi2, xalig, yalig, zalig SAVE / clevel1 / REAL VARFIT(2) INTEGER NPFIT(2) COMMON/CALOFIT/VARFIT,NPFIT SAVE/CALOFIT/ REAL hmemor(9000000) integer Iquest(100) COMMON /pawcd/hmemor save /pawcd/ C Common /QUESTd/ Iquest save /questd/ C C Begin ! C CRCALOL2 = 0; RMASS = 0.938 C C IF (.not.GOOD2.OR..not.GCRC) goto 9696 c print *,' good2 ',good2,' al_p(5) ',AL_P(5) C PIANO(1) = 0. DO I = 2, 22 IF ( MOD(I,2).EQ.0 ) THEN PIANO(I) = PIANO(I-1) - 8.09 ELSE PIANO(I) = PIANO(I-1) - 10.09 ENDIF ENDDO C CALL VZERO(DEXY,2*LENSEV) CALL VZERO(BAR,2*NPLA) CALL VZERO(IBAR,2*NPLA) CALL VZERO(TBAR,2*NPLA) CALL VZERO(TIBAR,2*NPLA) CALL VZERO(CBAR,2*NPLA) CALL VZERO(CIBAR,2*NPLA) CALL VZERO(QQ,4) CALL VZERO(Y,NPLA) CALL VZERO(YY,NPLA) CALL VZERO(XOUT,NPLA) CALL VZERO(YOUT,NPLA) QLOW = 0. NLOW = 0. NCORE = 0. QCORE = 0. NSTRIP = 0. QTOT = 0. NX22 = 0. QX22 = 0. NINT = 0. QCYL = 0. NCYL = 0. QTR = 0. NTR = 0. QLAST = 0. QTRACK = 0. QMAX = 0. QPRESH = 0. NPRESH = 0. QMAX = 0. QTRACKX = 0. QTRACKY = 0. DXTRACK = 0. DYTRACK = 0. QPRE = 0. NPRE = 0. NLAST = 0. GTR = 0 C IF (GOOD2.EQ.0.AND.TRIGTY.NE.2) goto 9696 C DISTX = 0. DISTY = 0. C DO I = 1,22 DO J = 1,96 IF ( MOD(I,2).NE.0 ) THEN IF ( ESTRIP(2,I,J).GT.EMIN ) THEN DEXY(2,I,J) = ESTRIP(2,I,J) NSTRIP = NSTRIP + 1. QTOT = QTOT + ESTRIP(2,I,J) IF (I.LT.11) QQ(1) = QQ(1) + ESTRIP(2,I,J) ENDIF IF ( ESTRIP(1,I,J).GT.EMIN ) THEN DEXY(1,I,J) = ESTRIP(1,I,J) NSTRIP = NSTRIP + 1. QTOT = QTOT + ESTRIP(1,I,J) if (i.lt.11) QQ(2) = QQ(2) + ESTRIP(1,I,J) ENDIF ENDIF IF ( MOD(I,2).EQ.0 ) THEN IF (ESTRIP(2,I,J).GT.EMIN) THEN DEXY(2,I,J) = ESTRIP(2,I,J) NSTRIP = NSTRIP + 1. QTOT = QTOT + ESTRIP(2,I,J) if (i.lt.11) QQ(3) = QQ(3) + ESTRIP(2,I,J) ENDIF IF (ESTRIP(1,I,J).GT.EMIN) THEN DEXY(1,I,J) = ESTRIP(1,I,J) NSTRIP = NSTRIP + 1. QTOT = QTOT + ESTRIP(1,I,J) IF (I.EQ.22) THEN NX22 = NX22 + 1. QX22 = QX22 + ESTRIP(1,I,J) ENDIF IF (I.LT.11) QQ(4) = QQ(4) + ESTRIP(1,I,J) ENDIF ENDIF ENDDO ENDDO C C determine variables only if we have a good track C if (good2.eq.1.or.trigty.eq.2) then CALL CLUSTER CALL DIRECTION(TG) THEX = TG(1) THEY = TG(2) varcfit(1) = varfit(1) varcfit(2) = varfit(2) npcfit(1) = npfit(1) npcfit(2) = npfit(2) IMPX = CX IMPY = CY SHIFT = -0.5 CALL LASTRISCIA(CX,II) SHIFT = +0.5 CALL LASTRISCIA(CY,II) TANX = TG(1) TANY = TG(2) C DO M = 1,2 DO I = 1,NPLA NN = 0 IF (M.EQ.2) NN = 1 IF (MOD(I,2).EQ.NN) THEN SHIFT = +0.5 ELSE SHIFT = -0.5 ENDIF C c IF (MOD(M,2).EQ.0) THEN c ELSE c ENDIF C IF (M.EQ.1) THEN DISTX = PIANO(I) - 5.1 Y(I) = DISTX * TG(1) + CX BAR(M,I) = Y(I) CBAR(M,I) = Y(I) c print *,' cbar ',m,i,cbar(m,i) C ELSE DISTY = PIANO(I) YY(I) = DISTY * TG(2) + CY BAR(M,I) = YY(I) CBAR(M,I) = YY(I) c print *,'cy ',cy,' disty ',disty,' tg ', c & tg(2),' cbar ',m,i,cbar(m,i) C ENDIF CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) c CBAR(M,I) = bar(m,i) cibar(M,I) = ibar(m,i) ENDDO ENDDO C if (trigty.eq.2) goto 6996 C do t = 1,2 CALL VZERO(BAR,2*NPLA) CALL VZERO(IBAR,2*NPLA) CALL VZERO(TBAR,2*NPLA) CALL VZERO(TIBAR,2*NPLA) do m = 1, 5 al_p(m) = al_pp(t,m) enddo if (al_p(5).eq.0.) goto 9696 DO M = 1,2 DO I = 1,NPLA C if (M.eq.1) then C hsh = 1.3 C else C hsh = -1.3 C endif C DISTX = -PIANO * (I - 1.) - AB +HSH -235. ! Z ALIGNEMENT FACTORS C XOUT(I) = 0. YOUT(I) = 0. IF (MOD(M,2).EQ.0) THEN DISTX = PIANO(I) + ZALIG ! Z ALIGNEMENT FACTOR ELSE DISTX = PIANO(I) - 5.1 + ZALIG ! Z ALIGNEMENT FACTOR C ENDIF ZIN(I) = distx / 10. c print *,' zin ',i,' ',zin(i) C TBAR(M,I) = 0. TIBAR(M,I) = 0 C enddo IFAIL = 0 c print *,' al ',al_p(1),al_p(2),al_p(3),al_p(4),al_p(5) call TRACK(NPLA,ZIN,XOUT,YOUT,AL_P,IFAIL) if(IFAIL.ne.0)then good2 = 0 good = 0 print *,' Tracking error (ifail not zero)!!!' c goto 6996 if (t.eq.2) goto 9696 goto 969 endif TX = TAN(ASIN(AL_P(3))) * COS(AL_P(4)) TY = TAN(ASIN(AL_P(3))) * SIN(AL_P(4)) DO I = 1, NPLA NN = 0 IF (M.EQ.2) NN = 1 IF (MOD(I,2).EQ.NN) THEN SHIFT = +0.5 ELSE SHIFT = -0.5 ENDIF C C CHECK IF XOUT OR YOUT ARE NaN C IF (XOUT(I).NE.XOUT(I).OR.YOUT(I).NE.YOUT(I)) THEN print *,' Tracking error (NaN values)!!!' GOOD2 = 0 GOOD = 0 if (t.eq.2) goto 9696 goto 969 ENDIF CX = XOUT(I)*10. + XALIG !+ 120.4 ! X ALIGNEMENT FACTOR CY = -YOUT(I)*10. + YALIG ! 118.6 ! Y ALIGNEMENT FACTOR c IF (I.EQ.1) THEN TIMPX = CX TIMPY = CY ENDIF IF (M.EQ.1) THEN Y(I) = CX BAR(M,I) = Y(I) TBAR(M,I) = Y(I) c print *,'tbar ',m,i,' ',tbar(m,i),' cx ',cx,' xout ' c & ,xout(i) ELSE YY(I) = CY BAR(M,I) = YY(I) TBAR(M,I) = YY(I) c print *,'tbar ',m,i,' ',tbar(m,i),' cy ',cy,' yout ' c & ,yout(i) ENDIF CALL LASTRISCIA(BAR(M,I),IBAR(M,I)) tibar(M,I) = ibar(m,i) ENDDO ENDDO 969 continue if (npfit(2).gt.15.and.varfit(2).lt.1000) then if ( abs(tbar(2,1)-tbar(2,2))<40.) then GTR = t goto 6996 else if ( t.eq.2 ) goto 9696 endif else if (t.eq.trkchi2) goto 6996 if (t.eq.2) goto 9696 endif enddo ELSE GOTO 9696 endif 6996 CONTINUE C C RIG IS RIGIDITY AS DETERMINED BY THE TRACKER C OR by CALORIMETER IF IN SELFTRIGGER MODE C if (trigty.ne.2) then IF ( AL_PP(GTR,5).NE.0 ) THEN RIG = 1./(AL_PP(GTR,5)) ELSE RIG = 1000. ENDIF else RIG = 1000. endif C RNSS = 0. QTOTT = 0. PLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.) IPLANE = INT(ANINT(PLANEMAX)) + 5 IF (IPLANE.GT.NPLA) IPLANE=NPLA DO J = 1,IPLANE NNX = IBAR(1,J) NNY = IBAR(2,J) IF (NNX.LT.9) NNX = 9 IF (NNY.LT.9) NNY = 9 IF (NNX.GT.88) NNX = 88 IF (NNY.GT.88) NNY = 88 INFX = NNX - 8 INFY = NNY - 8 C C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . C ISUPX = NNX + 8 ISUPY = NNY + 8 DO I = INFX,ISUPX IF (DEXY(1,J,I).GE.EMIN) THEN RNSS = RNSS + 1 QTOTT = QTOTT + DEXY(1,J,I) ENDIF ENDDO DO I = INFY,ISUPY IF (DEXY(2,J,I).GE.EMIN) THEN RNSS = RNSS + 1 QTOTT = QTOTT + DEXY(2,J,I) ENDIF ENDDO NCORE = RNSS * FLOAT(J) + NCORE QCORE = QTOTT * FLOAT(J) + QCORE ENDDO C QTOTT = 0. RNSS = 0. DO J = IPLANE,NPLA DO I = 1,NCHA IF (DEXY(1,J,I).GE.EMIN) THEN RNSS = RNSS + 1 QTOTT = QTOTT + DEXY(1,J,I) ENDIF IF (DEXY(2,J,I).GE.EMIN) THEN RNSS = RNSS + 1 QTOTT = QTOTT + DEXY(2,J,I) ENDIF ENDDO ENDDO QLOW = QTOTT NLOW = RNSS C CALL NOINT(NIN) ! if NINT=1 not interacting particle NINT = FLOAT(NIN) C C C QCYL = DETECTED ENERGY AND NCYL = NUMBER OF HIT STRIPS IN A CYLINDER oF C RADIUS 8.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING C PARTICLE . C DO J = 1,NPLA C NNX = IBAR(1,J) NNY = IBAR(2,J) IF (NNX.LT.9) NNX = 9 IF (NNY.LT.9) NNY = 9 IF (NNX.GT.88) NNX = 88 IF (NNY.GT.88) NNY = 88 INFX = NNX - 8 INFY = NNY - 8 C C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . C ISUPX = NNX + 8 ISUPY = NNY + 8 DO I = INFX,ISUPX IF (DEXY(1,J,I).LT.EMIN) GO TO 710 NCYL = NCYL + 1 QCYL = QCYL + DEXY(1,J,I) 710 ENDDO DO I=INFY,ISUPY IF (DEXY(2,J,I).LT.EMIN) GO TO 810 NCYL = NCYL + 1 QCYL = QCYL + DEXY(2,J,I) 810 ENDDO ENDDO C C QTR = DETECTED ENERGY AND NTR = NUMBER OF HIT STRIPS IN A CYLINDER oF C RADIUS 4.5 STRIPS WITH AXIS DEFINED BY THE DIRECTION OF THE INCOMING C PARTICLE . C DO I = 1,NPLA C NNX = IBAR(1,I) NNY = IBAR(2,I) IF (NNX.LT.5) NNX = 5 IF (NNY.LT.5) NNY = 5 IF (NNX.GT.92) NNX = 92 IF (NNY.GT.92) NNY = 92 INFX = NNX - 4 INFY = NNY - 4 C C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . C ISUPX = NNX + 4 ISUPY = NNY + 4 DO J = INFX,ISUPX IF (DEXY(1,I,J).GT.EMIN) THEN NTR = NTR + 1 QTR = QTR + DEXY(1,I,J) ENDIF ENDDO DO J = INFY,ISUPY IF (DEXY(2,I,J).GT.EMIN) THEN NTR = NTR + 1 QTR = QTR + DEXY(2,I,J) ENDIF ENDDO ENDDO C CALL LATERALE(QTRACK,RQT) C DO M = 1,2 DO I = 1,NPLA DO J = 1,NCHA IF (DEXY(M,I,J).GT.QMAX) QMAX = DEXY(M,I,J) ENDDO ENDDO ENDDO C DO I = 1,4 C NNX = IBAR(1,I) NNY = IBAR(2,I) IF (NNX.LT.3) NNX = 3 IF (NNY.LT.3) NNY = 3 IF (NNX.GT.94) NNX = 94 IF (NNY.GT.94) NNY = 94 INFX = NNX - 2 INFY = NNY - 2 C C 8 STRIPS ARE 2.88 cm , A MOLIERE RADIUS IS ABOUT 0.7 cm . C ISUPX = NNX + 2 ISUPY = NNY + 2 DO J = INFX,ISUPX IF (DEXY(1,I,J).GE.EMIN) THEN NPRESH = NPRESH + 1 QPRESH = QPRESH + DEXY(1,I,J) ENDIF ENDDO DO J = INFY,ISUPY IF (DEXY(2,I,J).GE.EMIN) THEN NPRESH = NPRESH + 1 QPRESH = QPRESH + DEXY(2,I,J) ENDIF ENDDO ENDDO C DO M = 1,2 DO I = 1,NPLA DO J = 1,NCHA IF (DEXY(M,I,J).GT.QMAX) QMAX = DEXY(M,I,J) ENDDO ENDDO ENDDO C ICONTROL5 = 0 CALL NSHOWER(ICONTROL5,DXTRACK,DYTRACK,QTRACKX,QTRACKY) C DO J = 1,3 C NNX = IBAR(1,J) NNY = IBAR(2,J) IF (NNX.LT.9) NNX = 9 IF (NNY.LT.9) NNY = 9 IF (NNX.GT.88) NNX = 88 IF (NNY.GT.88) NNY = 88 INFX = NNX - 8 INFY = NNY - 8 ISUPX = NNX + 8 ISUPY = NNY + 8 DO I = INFX,ISUPX IF (DEXY(1,J,I).GE.EMIN) THEN NPRE = NPRE + 1 QPRE = QPRE + DEXY(1,J,I) ENDIF ENDDO DO I=INFY,ISUPY IF (DEXY(2,J,I).GE.EMIN) THEN NPRE = NPRE + 1 QPRE = QPRE + DEXY(2,J,I) ENDIF ENDDO ENDDO C DO J = NPLA-4,NPLA C NNX = IBAR(1,J) NNY = IBAR(2,J) IF (NNX.LT.9) NNX = 9 IF (NNY.LT.9) NNY = 9 IF (NNX.GT.88) NNX = 88 IF (NNY.GT.88) NNY = 88 INFX = NNX - 8 INFY = NNY - 8 ISUPX = NNX + 8 ISUPY = NNY + 8 DO I = INFX,ISUPX IF (DEXY(1,J,I).GE.EMIN) THEN NLAST = NLAST + 1 QLAST = QLAST + DEXY(1,J,I) ENDIF ENDDO DO I=INFY,ISUPY IF (DEXY(2,J,I).GE.EMIN) THEN NLAST = NLAST + 1 QLAST = QLAST + DEXY(2,J,I) ENDIF ENDDO ENDDO C EINF = EMIN ESUP = 50. C DO M = 1,2 RPIANO(M) = 0. NTOT(M) = 0 ENDDO NPIANI = 5 QMEAN = 0. INDEX = 0 CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX) PLANETOT = RPIANO(1) + RPIANO(2) C C C c print *,'prima hfnt ' c print *,' trigty ',trigty c print *,' qtot ',qtot c print *,' nstrip ',nstrip c print *,' ncore ',ncore c print *,' qcore ',qcore c print *,' impx ',impx c print *,' impy ',impy c print *,' tany ',tany c print *,' tanx ',tanx c print *,' nint ',nint c print *,' ncyl ',ncyl c print *,' qcyl ',qcyl c print *,' qtrack ',qtrack c print *,' qmax ',qmax c print *,' qx22 ',qx22 c print *,' nx22 ',nx22 c print *,' qq(1) ',qq(1) c print *,' qq(1) ',qq(2) c print *,' qq(1) ',qq(3) c print *,' qq(1) ',qq(4) c print *,' qtrackx ',qtrackx c print *,' qtrackx ',qtracky c print *,' dxtrack ',dxtrack c print *,' dxtrack ',dytrack c print *,' qlast ',qlast c print *,' nlast ',nlast c print *,' qpre ',qpre c print *,' npre ',npre c print *,' qpresh ',qpresh c print *,' npresh ',npresh c print *,' qlow ',qlow c print *,' nlow ',nlow c print *,' qtr ',qtr c print *,' ntr ',ntr c print *,' planetot ',planetot c print *,' qmean ',qmean c do i = 1, 2 c do j = 1, 22 c print *,' cibar ',i,j,cibar(i,j) c print *,' tibar ',i,j,tibar(i,j) c print *,' cbar ',i,j,cbar(i,j) c print *,' tbar ',i,j,tbar(i,j) c enddo c enddo 9696 CONTINUE C IF (ispaw.eq.1.) call hfnt(1) c print *,'dopo hfnt ' C 45 continue 50 continue return END C C--------------------------------------------------------------------- SUBROUTINE LATERALE(RQT1,RQT2) C--------------------------------------------------------------------- C RQT1 (IT WILL BE CALLED QTRACK IN THE N-TUPLE) IS THE SUM OF THE DETECTED C ENERGY IN THE STRIP ALONG THE TRACK AND THE TWO CLOSEST STRIPS . FOR ALL THE C LAYERS . RQT2 (IS NOT USED IN THE N-TUPLA) IS THE TOTAL ENERGY MINUS RQT1 . C INCLUDE 'INTEST.TXT' REAL RQT1 INTEGER A,B REAL BAR(2,NPLA) REAL Q(0:NPLA) INTEGER IBAR(2,NPLA) COMMON/ANGOLO/BAR,IBAR RQT2=0. INPIA = 1 C QQQ=0 MAX=0 Q(MAX)=0 C DO I = INPIA,NPLA A = IBAR(1,I) B = IBAR(2,I) IF (A.LE.2) A = 3 IF (B.LE.2) B = 3 IF (A.GE.(NCHA-1)) A = NCHA - 2 IF (B.GE.(NCHA-1)) B = NCHA - 2 DO J = A-1,A+1 IF (DEXY(1,I,J).GE.EMIN) RQT1 = RQT1 + DEXY(1,I,J) 600 ENDDO C DO J = B-1,B+1 IF (DEXY(2,I,J).GE.EMIN) RQT1 = RQT1 + DEXY(2,I,J) ENDDO C DO J=1,A-2 PXY = DEXY(1,I,J) IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY 650 ENDDO C DO J=A+2,NCHA PXY = DEXY(1,I,J) IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY 700 ENDDO C DO J=1,B-2 PXY = DEXY(2,I,J) IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY 750 ENDDO C DO J=B+2,NCHA PXY = DEXY(2,I,J) IF (PXY.GE.EMIN) RQT2 = RQT2 + PXY 800 ENDDO C ENDDO C C 400 RETURN END