/[PAMELA software]/calo/ground/LEVEL2/src/nshower.for
ViewVC logotype

Contents of /calo/ground/LEVEL2/src/nshower.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Mon Dec 5 16:13:54 2005 UTC (19 years ago) by mocchiut
Branch point for: LEVEL2, MAIN
Initial revision

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) / 3*0 /,(NUM(I),I=1,3) / 3*0 /
44 C$ DATA (IMP(I),I=4,5) / 2*50 /,(NUM(I),I=4,5) / 2*4 /
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

  ViewVC Help
Powered by ViewVC 1.1.23