CalorimeterLevel2/src/calol2cm.for

*****************************************************************************
      INTEGER FUNCTION CALOL2CM()
c
      IMPLICIT NONE
C
      INCLUDE 'INTEST.TXT'
C
      REAL PIANO(22), VARFIT(2)
      REAL SHIFT
      REAL TG(2), BAR(2,NPLA)
      REAL DISTX, DISTY, Y(NPLA), YY(NPLA)
      REAL RIG, RMASS
      REAL CHECK, ENER, CX, CY
      REAL EINF, ESUP,ENPLANEX,ENPLANEY,TENPLAX,TENPLAY
      REAL hmemor(9000000)
c
      INTEGER gtr
      INTEGER j, m, nn, i
      INTEGER IBAR(2,NPLA), NPFIT(2)
      INTEGER Iquest(100), IWPL(2),CHTRACK
c
      COMMON / TAGLIOEN / EINF, ESUP, ENER(2)
      SAVE / TAGLIOEN /
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 /
C
      COMMON / CH / CHECK
      SAVE / CH /
C
      COMMON / CALOFIT / VARFIT, NPFIT, IWPL,CHTRACK
      SAVE / CALOFIT /
C
      COMMON / pawcd / hmemor
      save / pawcd /
C
      Common / QUESTd / Iquest
      save / questd /
C
C Begin !
C
      CALOL2CM = 0;
      RMASS = 0.938
C
C Z position of Y planes, Y1 = 0., Y2 = -8.09, Y3 = -18.18, ...
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(CBAR,2*NPLA)
      CALL VZERO(CIBAR,2*NPLA)
      CALL VZERO(QQ,4)
      CALL VZERO(Y,NPLA)
      CALL VZERO(YY,NPLA)      
      VARFIT(1) = 0.
      VARFIT(2) = 0.
      NPFIT(1) = 0.
      NPFIT(2) = 0.
      VARCFIT(1) = 0.
      VARCFIT(2) = 0.
      NPCFIT(1) = 0.
      NPCFIT(2) = 0.
      ELEN = 0.
      SELEN = 0.
      NSTRIP = 0.
      QTOT = 0.
      NX22 = 0.
      QX22 = 0.
      QMAX = 0.
      GTR = 0
      CHTRACK = 0
C     
      DISTX = 0.
      DISTY = 0.
C
      PLANEMAX(1) = 0
      PLANEMAX(2) = 0
      TENPLAX = 0. 
      TENPLAY = 0. 
C
      IF (GOOD2.EQ.0.AND.TRIGTY.LT.2) goto 9696
C
C     CALCULATE QTOT, NSTRIP, QQ, NX22, QX22, QMAX AND PLANEMAX
C
      DO I = 1,22
         ENPLANEY = 0.
         ENPLANEX = 0.         
         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)
                  ENPLANEY = ENPLANEY + DEXY(2,I,J)
                  NSTRIP = NSTRIP + 1.
                  QTOT = QTOT + DEXY(2,I,J)
                  IF (I.LT.11) QQ(1) = QQ(1) + DEXY(2,I,J)
               ENDIF
               IF ( ESTRIP(1,I,J).GT.EMIN ) THEN
C               IF ( ESTRIP(1,I+1,J).GT.EMIN ) THEN
C                  
c                  print *,' i ',i,' i + 1 ',I+1
C                  DEXY(1,I,J) = ESTRIP(1,I+1,J)
                  DEXY(1,I,J) = ESTRIP(1,I,J)
C
                  ENPLANEX = ENPLANEX + DEXY(1,I,J)
                  NSTRIP = NSTRIP + 1.
                  QTOT = QTOT + DEXY(1,I,J)
                  if (i.lt.11) QQ(2) = QQ(2) + DEXY(1,I,J)
c                  IF (I.EQ.21) THEN
c                     NX22 = NX22 + 1.
c                     QX22 = QX22 + DEXY(1,I,J)
c                  ENDIF
               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)
                  ENPLANEY = ENPLANEY + DEXY(2,I,J)
                  NSTRIP = NSTRIP + 1.
                  QTOT = QTOT + DEXY(2,I,J)
                  if (i.lt.11) QQ(3) = QQ(3) + DEXY(2,I,J)
               ENDIF
               IF (ESTRIP(1,I,J).GT.EMIN) THEN
C               IF (ESTRIP(1,I-1,J).GT.EMIN) THEN
C                  
c                  print *,' i ',i,' i - 1 ',I-1
C                  DEXY(1,I,J) = ESTRIP(1,I-1,J)
                  DEXY(1,I,J) = ESTRIP(1,I,J)
C
                  ENPLANEX = ENPLANEX + DEXY(1,I,J)
                  NSTRIP = NSTRIP + 1.
                  QTOT = QTOT + DEXY(1,I,J)
                  IF (I.EQ.22) THEN
                     NX22 = NX22 + 1.
                     QX22 = QX22 + DEXY(1,I,J)
                  ENDIF
                  IF (I.LT.11) QQ(4) = QQ(4) + DEXY(1,I,J)
               ENDIF
            ENDIF
C
            IF (DEXY(1,I,J).GT.QMAX) QMAX = DEXY(1,I,J)
            IF (DEXY(2,I,J).GT.QMAX) QMAX = DEXY(2,I,J)
C
         ENDDO
         IF (ENPLANEX.GT.TENPLAX) THEN
            PLANEMAX(1) = I
            TENPLAX = ENPLANEX
         ENDIF
         IF (ENPLANEY.GT.TENPLAY) THEN
            PLANEMAX(2) = I
            TENPLAY = ENPLANEY
         ENDIF
      ENDDO
C
C     FIT THE TRACK INSIDE THE CALORIMETER
C 
      if (GOOD2.EQ.1.OR.TRIGTY.GE.2) then
         CALL CLUSTER     
         CALL DIRECTION(TG)
         NPCFIT(1) = NPFIT(1)
         NPCFIT(2) = NPFIT(2)
C     
         DO M = 1,2
C
            IF (NPCFIT(M).GE.2) THEN
               VARCFIT(M) = VARFIT(M)
               IF (M.EQ.1) THEN
                  IMPX = (CX - XALIG)/10.
                  TANX = TG(1)
               ELSE
                  IMPY =( CY - YALIG)/10. 
                  TANY = TG(2)
               ENDIF
C               
               DO I = 1,NPLA     
                  NN = 1
C                  NN = 0
C                  IF (M.EQ.2) NN = 1
                  IF (MOD(I,2).EQ.NN) THEN
                     SHIFT = +0.5
                  ELSE
                     SHIFT = -0.5
                  ENDIF
C     
                  IF (M.EQ.1) THEN
                     DISTX = PIANO(I) - 5.81
                     Y(I) = DISTX * TG(1) + CX
                     BAR(M,I) = Y(I)
                     CBAR(M,I) = (Y(I) - XALIG)/10.        
C     
                  ELSE
                     DISTY = PIANO(I)                
                     YY(I) = DISTY * TG(2) + CY
                     BAR(M,I) = YY(I)
                     CBAR(M,I) = (-YALIG + YY(I))/10.
C     
                  ENDIF
                  CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
                  CIBAR(M,I) = IBAR(M,I)
                  IF (ibar(m,i).EQ.-1) THEN 
                     CHTRACK = CHTRACK + 1
                  ELSE
                     IWPL(M) = IWPL(M) + 1
                  ENDIF
               ENDDO            
            ENDIF
C
         ENDDO
      ELSE
         GOTO 9696
      ENDIF
C
C     CALCULATE ELEN AND SELEN
C
      ELEN =  40.82 * QTOT * 1.06 * 1E-4  
      IF (ELEN.GT.0.) THEN
         SELEN = ELEN * (0.01183 + 0.121 / SQRT(ELEN))
      ELSE
         SELEN = 0.
      ENDIF
C
 9696 CONTINUE
C
 45   continue

 50   continue

      return
      END


1	mocchiut	1.1	*****************************************************************************
2			INTEGER FUNCTION CALOL2CM()
3			c
4			IMPLICIT NONE
5			C
6			INCLUDE 'INTEST.TXT'
7			C
8			REAL PIANO(22), VARFIT(2)
9			REAL SHIFT
10			REAL TG(2), BAR(2,NPLA)
11			REAL DISTX, DISTY, Y(NPLA), YY(NPLA)
12			REAL RIG, RMASS
13			REAL CHECK, ENER, CX, CY
14			REAL EINF, ESUP,ENPLANEX,ENPLANEY,TENPLAX,TENPLAY
15			REAL hmemor(9000000)
16			c
17			INTEGER gtr
18			INTEGER j, m, nn, i
19			INTEGER IBAR(2,NPLA), NPFIT(2)
20	mocchiut	1.5	INTEGER Iquest(100), IWPL(2),CHTRACK
21	mocchiut	1.1	c
22			COMMON / TAGLIOEN / EINF, ESUP, ENER(2)
23			SAVE / TAGLIOEN /
24			C
25			COMMON / SHIFT / SHIFT
26			SAVE / SHIFT /
27			C
28			COMMON / ANGOLO / BAR, IBAR
29			SAVE / ANGOLO /
30			C
31			COMMON / WHERE / CX, CY, PIANO
32			SAVE / WHERE /
33			C
34			COMMON / GENERAL / RIG, RMASS
35			SAVE / GENERAL /
36			C
37			COMMON / CH / CHECK
38			SAVE / CH /
39			C
40	mocchiut	1.5	COMMON / CALOFIT / VARFIT, NPFIT, IWPL,CHTRACK
41	mocchiut	1.1	SAVE / CALOFIT /
42			C
43			COMMON / pawcd / hmemor
44			save / pawcd /
45			C
46			Common / QUESTd / Iquest
47			save / questd /
48			C
49			C Begin !
50			C
51			CALOL2CM = 0;
52			RMASS = 0.938
53			C
54			C Z position of Y planes, Y1 = 0., Y2 = -8.09, Y3 = -18.18, ...
55			C
56			PIANO(1) = 0.
57			DO I = 2, 22
58			IF ( MOD(I,2).EQ.0 ) THEN
59			PIANO(I) = PIANO(I-1) - 8.09
60			ELSE
61			PIANO(I) = PIANO(I-1) - 10.09
62			ENDIF
63			ENDDO
64			C
65			CALL VZERO(DEXY,2*LENSEV)
66			CALL VZERO(BAR,2*NPLA)
67			CALL VZERO(IBAR,2*NPLA)
68			CALL VZERO(CBAR,2*NPLA)
69			CALL VZERO(CIBAR,2*NPLA)
70			CALL VZERO(QQ,4)
71			CALL VZERO(Y,NPLA)
72			CALL VZERO(YY,NPLA)
73			VARFIT(1) = 0.
74			VARFIT(2) = 0.
75			NPFIT(1) = 0.
76			NPFIT(2) = 0.
77			VARCFIT(1) = 0.
78			VARCFIT(2) = 0.
79			NPCFIT(1) = 0.
80			NPCFIT(2) = 0.
81			ELEN = 0.
82			SELEN = 0.
83			NSTRIP = 0.
84			QTOT = 0.
85			NX22 = 0.
86			QX22 = 0.
87			QMAX = 0.
88			GTR = 0
89	mocchiut	1.5	CHTRACK = 0
90	mocchiut	1.1	C
91			DISTX = 0.
92			DISTY = 0.
93			C
94			PLANEMAX(1) = 0
95			PLANEMAX(2) = 0
96			TENPLAX = 0.
97			TENPLAY = 0.
98			C
99			IF (GOOD2.EQ.0.AND.TRIGTY.LT.2) goto 9696
100			C
101			C CALCULATE QTOT, NSTRIP, QQ, NX22, QX22, QMAX AND PLANEMAX
102			C
103			DO I = 1,22
104			ENPLANEY = 0.
105			ENPLANEX = 0.
106			DO J = 1,96
107			IF ( MOD(I,2).NE.0 ) THEN
108			IF ( ESTRIP(2,I,J).GT.EMIN ) THEN
109			DEXY(2,I,J) = ESTRIP(2,I,J)
110	mocchiut	1.7	ENPLANEY = ENPLANEY + DEXY(2,I,J)
111	mocchiut	1.1	NSTRIP = NSTRIP + 1.
112	mocchiut	1.7	QTOT = QTOT + DEXY(2,I,J)
113			IF (I.LT.11) QQ(1) = QQ(1) + DEXY(2,I,J)
114	mocchiut	1.1	ENDIF
115			IF ( ESTRIP(1,I,J).GT.EMIN ) THEN
116	mocchiut	1.7	C IF ( ESTRIP(1,I+1,J).GT.EMIN ) THEN
117			C
118			c print *,' i ',i,' i + 1 ',I+1
119			C DEXY(1,I,J) = ESTRIP(1,I+1,J)
120	mocchiut	1.1	DEXY(1,I,J) = ESTRIP(1,I,J)
121	mocchiut	1.7	C
122			ENPLANEX = ENPLANEX + DEXY(1,I,J)
123	mocchiut	1.1	NSTRIP = NSTRIP + 1.
124	mocchiut	1.7	QTOT = QTOT + DEXY(1,I,J)
125			if (i.lt.11) QQ(2) = QQ(2) + DEXY(1,I,J)
126			c IF (I.EQ.21) THEN
127			c NX22 = NX22 + 1.
128			c QX22 = QX22 + DEXY(1,I,J)
129			c ENDIF
130	mocchiut	1.1	ENDIF
131			ENDIF
132			IF ( MOD(I,2).EQ.0 ) THEN
133			IF (ESTRIP(2,I,J).GT.EMIN) THEN
134			DEXY(2,I,J) = ESTRIP(2,I,J)
135	mocchiut	1.7	ENPLANEY = ENPLANEY + DEXY(2,I,J)
136	mocchiut	1.1	NSTRIP = NSTRIP + 1.
137	mocchiut	1.7	QTOT = QTOT + DEXY(2,I,J)
138			if (i.lt.11) QQ(3) = QQ(3) + DEXY(2,I,J)
139	mocchiut	1.1	ENDIF
140			IF (ESTRIP(1,I,J).GT.EMIN) THEN
141	mocchiut	1.7	C IF (ESTRIP(1,I-1,J).GT.EMIN) THEN
142			C
143			c print *,' i ',i,' i - 1 ',I-1
144			C DEXY(1,I,J) = ESTRIP(1,I-1,J)
145	mocchiut	1.1	DEXY(1,I,J) = ESTRIP(1,I,J)
146	mocchiut	1.7	C
147			ENPLANEX = ENPLANEX + DEXY(1,I,J)
148	mocchiut	1.1	NSTRIP = NSTRIP + 1.
149	mocchiut	1.7	QTOT = QTOT + DEXY(1,I,J)
150	mocchiut	1.1	IF (I.EQ.22) THEN
151			NX22 = NX22 + 1.
152	mocchiut	1.7	QX22 = QX22 + DEXY(1,I,J)
153	mocchiut	1.1	ENDIF
154	mocchiut	1.7	IF (I.LT.11) QQ(4) = QQ(4) + DEXY(1,I,J)
155	mocchiut	1.1	ENDIF
156			ENDIF
157			C
158			IF (DEXY(1,I,J).GT.QMAX) QMAX = DEXY(1,I,J)
159			IF (DEXY(2,I,J).GT.QMAX) QMAX = DEXY(2,I,J)
160			C
161			ENDDO
162			IF (ENPLANEX.GT.TENPLAX) THEN
163			PLANEMAX(1) = I
164			TENPLAX = ENPLANEX
165			ENDIF
166			IF (ENPLANEY.GT.TENPLAY) THEN
167			PLANEMAX(2) = I
168			TENPLAY = ENPLANEY
169			ENDIF
170			ENDDO
171			C
172			C FIT THE TRACK INSIDE THE CALORIMETER
173			C
174			if (GOOD2.EQ.1.OR.TRIGTY.GE.2) then
175			CALL CLUSTER
176			CALL DIRECTION(TG)
177			NPCFIT(1) = NPFIT(1)
178			NPCFIT(2) = NPFIT(2)
179			C
180			DO M = 1,2
181			C
182			IF (NPCFIT(M).GE.2) THEN
183			VARCFIT(M) = VARFIT(M)
184			IF (M.EQ.1) THEN
185	mocchiut	1.2	IMPX = (CX - XALIG)/10.
186	mocchiut	1.1	TANX = TG(1)
187			ELSE
188	mocchiut	1.3	IMPY =( CY - YALIG)/10.
189	mocchiut	1.1	TANY = TG(2)
190			ENDIF
191			C
192			DO I = 1,NPLA
193	mocchiut	1.7	NN = 1
194			C NN = 0
195			C IF (M.EQ.2) NN = 1
196	mocchiut	1.1	IF (MOD(I,2).EQ.NN) THEN
197			SHIFT = +0.5
198			ELSE
199			SHIFT = -0.5
200			ENDIF
201			C
202			IF (M.EQ.1) THEN
203			DISTX = PIANO(I) - 5.81
204			Y(I) = DISTX * TG(1) + CX
205			BAR(M,I) = Y(I)
206			CBAR(M,I) = (Y(I) - XALIG)/10.
207			C
208			ELSE
209			DISTY = PIANO(I)
210			YY(I) = DISTY * TG(2) + CY
211			BAR(M,I) = YY(I)
212	mocchiut	1.3	CBAR(M,I) = (-YALIG + YY(I))/10.
213	mocchiut	1.1	C
214			ENDIF
215			CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
216			CIBAR(M,I) = IBAR(M,I)
217	mocchiut	1.5	IF (ibar(m,i).EQ.-1) THEN
218			CHTRACK = CHTRACK + 1
219			ELSE
220			IWPL(M) = IWPL(M) + 1
221			ENDIF
222	mocchiut	1.1	ENDDO
223			ENDIF
224			C
225			ENDDO
226			ELSE
227			GOTO 9696
228			ENDIF
229			C
230			C CALCULATE ELEN AND SELEN
231			C
232			ELEN = 40.82 * QTOT * 1.06 * 1E-4
233			IF (ELEN.GT.0.) THEN
234			SELEN = ELEN * (0.01183 + 0.121 / SQRT(ELEN))
235			ELSE
236			SELEN = 0.
237			ENDIF
238			C
239			9696 CONTINUE
240			C
241			45 continue
242
243			50 continue
244
245			return
246			END
247
248