/[PAMELA software]/calo/flight/CaloDoubleShower/src/dblsc.for
ViewVC logotype

Contents of /calo/flight/CaloDoubleShower/src/dblsc.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations) (download)
Tue Aug 4 13:59:09 2009 UTC (15 years, 4 months ago) by mocchiut
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +4 -2 lines
Error occurred while calculating annotation data.
Changed to work with GCC 4.x (gfortran) + ROOT >= 5.24

1 SUBROUTINE DBLSC(INDIC,QQQ,DEVT)
2 C----------------------------------------------------------------------
3 C-
4 C- Purpose and Methods :
5 C-
6 C- Inputs :
7 C- Outputs :
8 C- Controls:
9 C-
10 C- Created 31-JAN-1995 MIRKO BOEZIO
11 C-
12 C----------------------------------------------------------------------
13 IMPLICIT NONE
14
15 INCLUDE 'INTEST.TXT'
16
17 INTEGER J,K,L,M,INDIC,NGIR,ISTOP
18 INTEGER LK,LVMIN,DBLS
19 REAL A,B,VAR
20 REAL QQQ,DAT,DAD,RR,DD
21 REAL POS,ANGOL,DBLSQ
22 REAL DEVT
23 REAL RIL(NCHA/2)
24 REAL YY(2),XX(2)
25 REAL DBNCL(4)
26 REAL DBCLUS(4,NCHA)
27 REAL DIST
28 C
29 REAL CX,CY, PIANO(NPLAV)
30 REAL BAR(2,NPLAV),SHIFT
31 INTEGER ITL, LPIANO
32 INTEGER II
33 INTEGER IBAR(2,NPLAV)
34 C
35 COMMON / SHIFT / SHIFT
36 SAVE / SHIFT /
37 C
38 COMMON / ANGOLO / BAR, IBAR
39 SAVE / ANGOLO /
40 C
41 COMMON / WHERE / CX, CY, PIANO
42 SAVE / WHERE /
43 C
44 COMMON /SDOUBLE/ POS,ANGOL,DBLSQ,DBLS
45 SAVE / SDOUBLE /
46 C
47 C Begin!
48 C
49 LPIANO = NPLA / 2
50 C
51 DO K = 1,NCHA/2
52 RIL(K) = 1000.
53 ENDDO
54 C
55 DO J = 1,4
56 DO K = 1,NCHA
57 DBCLUS(J,K) = CLUS4(1,J,K)
58 ENDDO
59 DBNCL(J) = NCL4(1,J)
60 ENDDO
61 C
62 QQQ = 0.
63 INDIC = 0
64 NGIR = 0
65 M = 1
66 C
67 DO 5 J = 1,2
68 C
69 IF (J.EQ.1) ITL = (LPIANO-6 + 1) / 2
70 IF (J.EQ.2) ITL = (LPIANO + LPIANO-6 + 1) / 2
71
72 DAD = BAR(M,ITL)
73 C
74 NGIR = NCL4(M,J)
75 IF (NGIR.EQ.0) GO TO 5
76 DO L = 1,NGIR
77 RR = ABS(DAD - CLUS4(M,J,L))
78 DD = CLUS4(M,J,L)
79 IF (RR.LE.10) THEN
80 DBNCL(J) = DBNCL(J) - 1
81 DBCLUS(J,L) = 0.
82 DBCLUS(J,L+NCHA/2) = 0.
83 ENDIF
84 ENDDO
85 C
86 5 CONTINUE
87 C
88 DO J = 1,2
89 C
90 IF (J.EQ.1) ITL = (LPIANO-6 + 1) / 2
91 IF (J.EQ.2) ITL = (LPIANO + LPIANO-6 + 1) / 2
92 C
93 C CHE COS'E' QUESTO DIST?
94 C
95 II = MOD((ITL-1),2)
96 DIST = II * 8.09 + INT((ITL-1)/2) * (8.09 + 10.09)
97 IF (M.EQ.1) DIST = -DIST - 0.68 - 5.81
98 C
99 DAT = DIST * ANGOL
100 C
101 DAD = POS + DAT
102 C
103 NGIR = NCL4(M,J)
104 C
105 IF (NGIR.GE.1) THEN
106 DO L = 1,NGIR
107 RIL(L) = ABS(DAD - DBCLUS(J,L))
108 RR = RIL(L)
109 IF (RIL(L).LE.15.AND.DBCLUS(J,L).NE.0) THEN
110 QQQ = QQQ + DBCLUS(J,L+NCHA/2)
111 ENDIF
112 ENDDO
113 LK = LVMIN(RIL,NCHA/2)
114 IF (RIL(LK).LE.10.AND.DBCLUS(J,LK).NE.0) THEN
115 YY(J) = DBCLUS(J,LK)
116 ENDIF
117 c 7 ENDIF
118 ENDIF
119 ENDDO
120 C
121 CALL LFIT(XX,YY,2,0,A,B,VAR)
122 DEVT = ANGOL - A
123 C
124 DO K = 1,NCHA/2
125 RIL(K) = 1000.
126 ENDDO
127 C
128 ISTOP = 0
129 C
130 IF (QQQ.GT.30.AND.ISTOP.EQ.0) INDIC = 1
131 C
132 c 999 RETURN
133 RETURN
134 END

  ViewVC Help
Powered by ViewVC 1.1.23