LEVEL2/src/nshower.for

      SUBROUTINE NSHOWER(IERR,RNUMX,RNUMY,ENERGIAX,ENERGIAY)
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : IT IDENTIFIES ELECTROMAGNETIC SHOWERS USING :
C-   CENTER OF GRAVITY IN THE FIRST HALF - SECOND HALF OF THE CALORIMETER .
C-   RNUMX AND RNUMY (X AND Y VIEW) ARE THE DISTANCES IN mm OF THE CLUSTERS
C-   CLOSEST TO THE TRACK NORMALIZED TO THE TRACK .  
C-   ENERGIAX AND ENERGIAY ARE THE ENERGY OF THESE CLUSTERS .
C-   THE CENTERS OF GRAVITY AND THE CLUSTERS COME FROM THE ROUTINE CLUSTER2 .
C-
C-   Inputs  :
C-   Outputs :
C-   Controls:
C-
C-   Created   3-NOV-1993   MIRKO BOEZIO
C-
C----------------------------------------------------------------------
      INCLUDE 'INTEST.TXT'

      REAL RX(2),RY(2)
      REAL RIL(NCHA/2)
C$      DIMENSION IP(6)
      REAL BAR(2,NPLA)
      REAL TG(2)
      REAL DAD
      INTEGER IBAR(2,NPLA)
      INTEGER ITL
      COMMON/VARIE/MAX
      SAVE /VARIE/
      COMMON/INIZIO/INPIA
      SAVE /INIZIO/
      COMMON / IMPULSO / QUAMOT
      SAVE /IMPULSO/
      COMMON/DOVE/NX,NY,LUNGH
      SAVE /DOVE/
      COMMON/TANGENTI/TG
      SAVE /TANGENTI/
      COMMON/ANGOLO/BAR,IBAR
      SAVE /ANGOLO/
C$      INTEGER NUM(10)
C$      REAL IMP(10)
      INTEGER LK(2)
C$      DATA (IMP(I),I=1,3) / 3*0 /,(NUM(I),I=1,3) / 3*0 /
C$      DATA (IMP(I),I=4,5) / 2*50 /,(NUM(I),I=4,5) / 2*4 /

C
      LPIANO = NPLA / 2 
      CALL CLUSTER2
C
      ITL = 0
      IALFA = 0
  499 CONTINUE
C
      DO I = 1,NCHA/2
        RIL(I) = 1000.
      ENDDO
C
      RX(1) = 0.
      RX(2) = 0.
      RY(1) = 0.
      RY(2) = 0.      
C
      DO M = 1,2
        DO J = 1,2
C
          DO I = 1,NCHA/2
            RIL(I) = 1000.
          ENDDO
C
          LK(J) = 0
C$$          IF (J.EQ.1) TL = 3.
C$$          IF (J.EQ.2) TL = (15. + 7.) / 2.
C$$          DAT = -PIANO * TL * TG(M)
C$$
C$$          DAD = BAR(M,1) + DAT
C
          IF (J.EQ.1) ITL = (LPIANO + 1) / 2
          IF (J.EQ.2) ITL = (NPLA + LPIANO + 1) / 2

          DAD = BAR(M,ITL) 
c          PRINT *,' DAD ',DAD,' M ',M,' ITL ',ITL
C
C$          CALL LASTRISCIA(DAD,NN)
C
          NGIR = NCL2(M,J)
          IF (NGIR.EQ.0) GO TO 555
          DO L = 1,NGIR
C$            CALL LASTRISCIA(CLUS2(M,J,L),IN)
C$            RIL(L) = FLOAT(ABS(NN - IN))
            RIL(L) = ABS(DAD - CLUS2(M,J,L))
          ENDDO
          MM = NCHA/2
          LK(J) = LVMIN(RIL,MM)
C
          IF (CLUS2(M,J,LK(J)+NCHA/2).GT.EMIN) THEN
C$            CALL MILLIM(NN,RR)
            IF (M.EQ.1) THEN
              ENERGIAX = ENERGIAX + CLUS2(M,J,LK(J)+NCHA/2)
              RX(J) = CLUS2(M,J,LK(J)) - DAD
c              print *,'m j lk(j) ',m,j,lk(j)
c              PRINT*,' RX: ',RX(J)
c              PRINT*,' DAD: ',DAD
c              PRINT*,' CLUS2: ',CLUS2(M,J,LK(J))
C$              RX(J) = CLUS2(M,J,LK(J)) - RR
            ENDIF
            IF (M.EQ.2) THEN
              ENERGIAY = ENERGIAY + CLUS2(M,J,LK(J)+NCHA/2)
              RY(J) = CLUS2(M,J,LK(J)) - DAD
C$              RY(J) = CLUS2(M,J,LK(J)) - RR
            ENDIF
          ENDIF
C
  555     CONTINUE
        ENDDO
C
        IF (M.EQ.1) RNUMX = ABS( RX(2) - RX(1) ) 
        IF (M.EQ.2) RNUMY = ABS( RY(2) - RY(1) ) 
c        PRINT*,' RX: ',RX(1),RX(2),' RY: ',RY(1),RY(2)
C
      ENDDO
C
      ESOGLIATOT = 50.
      EINT = 10.
C
      IF (ENERGIAX.EQ.0.OR.ENERGIAY.EQ.0) THEN
        II = 1
      ENDIF
C
      EINF = ENERGIAX - EINT
      ESUP = ENERGIAX + EINT
      ETOT = ENERGIAX + ENERGIAY
C
      IF (ENERGIAY.LT.EINF.OR.ENERGIAY.GT.ESUP.OR.
     &    ETOT.LT.ESOGLIATOT) GO TO 2
C
      GO TO 10
C
    2 IERR = 1
C
   10 CONTINUE

      RETURN
      END
1	SUBROUTINE NSHOWER(IERR,RNUMX,RNUMY,ENERGIAX,ENERGIAY)
2	C----------------------------------------------------------------------
3	C-
4	C- Purpose and Methods : IT IDENTIFIES ELECTROMAGNETIC SHOWERS USING :
5	C- CENTER OF GRAVITY IN THE FIRST HALF - SECOND HALF OF THE CALORIMETER .
6	C- RNUMX AND RNUMY (X AND Y VIEW) ARE THE DISTANCES IN mm OF THE CLUSTERS
7	C- CLOSEST TO THE TRACK NORMALIZED TO THE TRACK .
8	C- ENERGIAX AND ENERGIAY ARE THE ENERGY OF THESE CLUSTERS .
9	C- THE CENTERS OF GRAVITY AND THE CLUSTERS COME FROM THE ROUTINE CLUSTER2 .
10	C-
11	C- Inputs :
12	C- Outputs :
13	C- Controls:
14	C-
15	C- Created 3-NOV-1993 MIRKO BOEZIO
16	C-
17	C----------------------------------------------------------------------
18	INCLUDE 'INTEST.TXT'
19
20	REAL RX(2),RY(2)
21	REAL RIL(NCHA/2)
22	C$ DIMENSION IP(6)
23	REAL BAR(2,NPLA)
24	REAL TG(2)
25	REAL DAD
26	INTEGER IBAR(2,NPLA)
27	INTEGER ITL
28	COMMON/VARIE/MAX
29	SAVE /VARIE/
30	COMMON/INIZIO/INPIA
31	SAVE /INIZIO/
32	COMMON / IMPULSO / QUAMOT
33	SAVE /IMPULSO/
34	COMMON/DOVE/NX,NY,LUNGH
35	SAVE /DOVE/
36	COMMON/TANGENTI/TG
37	SAVE /TANGENTI/
38	COMMON/ANGOLO/BAR,IBAR
39	SAVE /ANGOLO/
40	C$ INTEGER NUM(10)
41	C$ REAL IMP(10)
42	INTEGER LK(2)
43	C$ DATA (IMP(I),I=1,3) / 30 /,(NUM(I),I=1,3) / 30 /
44	C$ DATA (IMP(I),I=4,5) / 250 /,(NUM(I),I=4,5) / 24 /
45
46	C
47	LPIANO = NPLA / 2
48	CALL CLUSTER2
49	C
50	ITL = 0
51	IALFA = 0
52	499 CONTINUE
53	C
54	DO I = 1,NCHA/2
55	RIL(I) = 1000.
56	ENDDO
57	C
58	RX(1) = 0.
59	RX(2) = 0.
60	RY(1) = 0.
61	RY(2) = 0.
62	C
63	DO M = 1,2
64	DO J = 1,2
65	C
66	DO I = 1,NCHA/2
67	RIL(I) = 1000.
68	ENDDO
69	C
70	LK(J) = 0
71	C$$ IF (J.EQ.1) TL = 3.
72	C$$ IF (J.EQ.2) TL = (15. + 7.) / 2.
73	C$$ DAT = -PIANO * TL * TG(M)
74	C$$
75	C$$ DAD = BAR(M,1) + DAT
76	C
77	IF (J.EQ.1) ITL = (LPIANO + 1) / 2
78	IF (J.EQ.2) ITL = (NPLA + LPIANO + 1) / 2
79
80	DAD = BAR(M,ITL)
81	c PRINT *,' DAD ',DAD,' M ',M,' ITL ',ITL
82	C
83	C$ CALL LASTRISCIA(DAD,NN)
84	C
85	NGIR = NCL2(M,J)
86	IF (NGIR.EQ.0) GO TO 555
87	DO L = 1,NGIR
88	C$ CALL LASTRISCIA(CLUS2(M,J,L),IN)
89	C$ RIL(L) = FLOAT(ABS(NN - IN))
90	RIL(L) = ABS(DAD - CLUS2(M,J,L))
91	ENDDO
92	MM = NCHA/2
93	LK(J) = LVMIN(RIL,MM)
94	C
95	IF (CLUS2(M,J,LK(J)+NCHA/2).GT.EMIN) THEN
96	C$ CALL MILLIM(NN,RR)
97	IF (M.EQ.1) THEN
98	ENERGIAX = ENERGIAX + CLUS2(M,J,LK(J)+NCHA/2)
99	RX(J) = CLUS2(M,J,LK(J)) - DAD
100	c print *,'m j lk(j) ',m,j,lk(j)
101	c PRINT*,' RX: ',RX(J)
102	c PRINT*,' DAD: ',DAD
103	c PRINT*,' CLUS2: ',CLUS2(M,J,LK(J))
104	C$ RX(J) = CLUS2(M,J,LK(J)) - RR
105	ENDIF
106	IF (M.EQ.2) THEN
107	ENERGIAY = ENERGIAY + CLUS2(M,J,LK(J)+NCHA/2)
108	RY(J) = CLUS2(M,J,LK(J)) - DAD
109	C$ RY(J) = CLUS2(M,J,LK(J)) - RR
110	ENDIF
111	ENDIF
112	C
113	555 CONTINUE
114	ENDDO
115	C
116	IF (M.EQ.1) RNUMX = ABS( RX(2) - RX(1) )
117	IF (M.EQ.2) RNUMY = ABS( RY(2) - RY(1) )
118	c PRINT*,' RX: ',RX(1),RX(2),' RY: ',RY(1),RY(2)
119	C
120	ENDDO
121	C
122	ESOGLIATOT = 50.
123	EINT = 10.
124	C
125	IF (ENERGIAX.EQ.0.OR.ENERGIAY.EQ.0) THEN
126	II = 1
127	ENDIF
128	C
129	EINF = ENERGIAX - EINT
130	ESUP = ENERGIAX + EINT
131	ETOT = ENERGIAX + ENERGIAY
132	C
133	IF (ENERGIAY.LT.EINF.OR.ENERGIAY.GT.ESUP.OR.
134	& ETOT.LT.ESOGLIATOT) GO TO 2
135	C
136	GO TO 10
137	C
138	2 IERR = 1
139	C
140	10 CONTINUE
141
142	RETURN
143	END