CalorimeterLevel2/src/direction.for

      SUBROUTINE DIRECTION(DEVIA)
C-----------------------------------------------------
C-
C-   Purpose and Methods : PROGRAM THAT DETERMINES THE
C-   TRACK PROJECTIONS ON THE PLANE XZ AND YZ USING
C-   ONLY CALORIMETER INFORMATION .
C-
C-   Inputs  :
C-   Outputs :
C-   Controls:
C-
C-   Created   9-FEB-1994   MIRKO BOEZIO
C-   Modified  21-FEB-2003   MIRKO BOEZIO . ADAPTED TO
C-   BE USED FOR PAMELA CALORIMETER .
C-
C------------------------------------------------------

      IMPLICIT NONE

      INCLUDE 'INTEST.TXT'

      REAL FLIMIT, FLIMIT2
      INTEGER NVAR,NPAR
      PARAMETER (NVAR=1,NPAR=2)          
c      PARAMETER (FLIMIT=10000)
c      PARAMETER (FLIMIT2=2000)
c      PARAMETER (FLIMIT=500)
      PARAMETER (FLIMIT=2000)
      PARAMETER (FLIMIT2=500)
      REAL X(NPLAV),Y(NPLAV),W(NPLAV)
      REAL DEVIA(2),TG(2)
      REAL BAR(2,NPLAV)
      REAL A, B, VAR
      REAL SA, SB, SVAR
      REAL SSA, SSB, SSVAR
      REAL PIANO(NPLAV)
      REAL VARFIT(2)

      INTEGER ICONT, M, I, SNPFIT,SSNPFIT
      INTEGER NPFIT(2), CHTRACK,IWPL(2)
      
      INTEGER IBAR(2,NPLAV)      
      COMMON/ANGOLO/BAR,IBAR
      SAVE /ANGOLO/

      REAL CX, CY
      COMMON/WHERE/CX,CY,PIANO
      SAVE /WHERE/

      COMMON/CALOFIT/VARFIT,NPFIT,IWPL,CHTRACK
      SAVE/CALOFIT/
C
      ICONT = 0
      DEVIA(1) = 0.
      DEVIA(2) = 0.
      CX = 0.
      CY = 0.
C
      NPFIT(1) = NPLA
      NPFIT(2) = NPLA
      VARFIT(1) = 0.
      VARFIT(2) = 0.      
C
C THE FIT IS PERFORMED WHEN THERE ARE AT LEAST TWO 
C LAYERS WITH SIGNAL . FOR THE FIT THE CLUSTER WITH THE
C HIGHEST DETECTED ENERGY IS USED . 
C
      DO M = 1,2
         SA = 0
         SB = 0
         SVAR = 0
         FMODE(M) = 0
 10      CONTINUE         
         ICONT = 0
         CALL VZERO(X,NPLAV)
         CALL VZERO(Y,NPLAV)
         CALL VZERO(W,NPLAV)
         DO I = 1,NPLA
C    
            IF (MOD(M,2).EQ.0) THEN
               X(I) = PIANO(I)
C               X(I) = PIANO(I) - 5.81
            ELSE
               X(I) = PIANO(I) - 5.81
C               X(I) = PIANO(I)                  
            ENDIF
            Y(I) = 0.
C
C
C
            IF (FMODE(M).EQ.0) THEN
               IF (NCL(M,I).GE.1) THEN
                  ICONT = ICONT + 1
                  Y(I) = CLUS(M,I,1)
                  W(I) = ((CLUS(M,I,1+NCHA/2)**0.79))**2.
                  IF (W(I).GT.2000.) THEN
                     W(I) = 2000.
C                     Y(I) = 0. 
C                     ICONT = ICONT -1
                  ENDIF
               ENDIF
            ENDIF
C
C No weigth and less cluster per plane
C
            IF(FMODE(M).EQ.1) THEN
               IF (NCL(M,I).GE.1.AND.NCL(M,I).LE.2) THEN
                  ICONT = ICONT + 1
                  Y(I) = CLUS(M,I,1)
                  W(I) = ((CLUS(M,I,1+NCHA/2)**0.29))**2.
c                  W(I) = 1.
               ENDIF
c               IF (W(I).GT.2000.) THEN
cx                  W(I) = 2000.
cc                  Y(I) = 0. 
cc                  ICONT = ICONT -1
c               ENDIF
            ENDIF
c
c One cluster per plane
c
            IF(FMODE(M).EQ.2) THEN
               IF (NCL(M,I).EQ.1) THEN
                  ICONT = ICONT + 1
                  Y(I) = CLUS(M,I,1)
                  W(I) = ((CLUS(M,I,1+NCHA/2)**0.79))**2.
c                  W(I) = 1.
               ENDIF
            ENDIF
c            if (Y(I).eq.0.or.W(I).eq.2000.) NPFIT(M) = NPFIT(M) - 1
            if (Y(I).eq.0.) NPFIT(M) = NPFIT(M) - 1
         ENDDO
C     
         
         A = 0.
         B = 0.
         VAR = 0.
c         print *,' icont = ',icont
         IF (ICONT.GE.2) THEN
            CALL LFITW(X,Y,W,NPLA,0,A,B,VAR)
         ELSE
            NPFIT(M) = 0
         ENDIF
C
C TRY A BETTER FIT IF VAR IS BIG ON THE FIRST TRY
C
         IF ((ABS(VAR).GT.FLIMIT.OR.VAR.EQ.0.).AND.FMODE(M).EQ.0) THEN
            SVAR = VAR
            SB = B
            SA = A
            SNPFIT = NPFIT(M)
            NPFIT(M) = NPLA
            FMODE(M) = 1
            GOTO 10
         ENDIF
C
C TRY AGAIN IF STILL BAD AND WE HAVE AT LEAST 10 POINT TO MAKE THE FIT
C
         IF ((ABS(VAR).GT.FLIMIT2.OR.VAR.EQ.0.).AND.FMODE(M).EQ.1
     &        .AND.SNPFIT.GT.5) THEN
            SSVAR = VAR
            SSB = B
            SSA = A
            SSNPFIT = NPFIT(M)
            NPFIT(M) = NPLA
            FMODE(M) = 2
            GOTO 10
         ENDIF          
C
C IF WE ARE AT THE THIRD TRY AND THE FIT IS WORST THAN THE SECOND TRY TAKE THE FIRST TRY
C
         IF (FMODE(M).EQ.2) THEN
            IF (ABS(VAR).GT.ABS(SSVAR).OR.ABS(VAR).EQ.0.
     &           .OR.NPFIT(M).LE.4) THEN
               FMODE(M) = 1
               VAR=SSVAR
               B = SSB
               A = SSA
               NPFIT(M) = SSNPFIT
            ENDIF
         ENDIF
C
C IF THE SECOND TRY AND THE FIT IS WORST THAN THE FIRST TRY TAKE THE FIRST TRY
C
         IF (FMODE(M).EQ.1) THEN
            IF (ABS(VAR).GT.ABS(SVAR).OR.ABS(VAR).EQ.0.) THEN
               FMODE(M) = 0
               VAR=SVAR
               B = SB
               A = SA
               NPFIT(M) = SNPFIT
            ENDIF
         ENDIF
C
         VARFIT(M) = VAR
         IF (M.EQ.1) CX = B
         IF (M.EQ.2) CY = B
         DEVIA(M) = A
         TG(M) = A
C
      ENDDO
C

  500 CONTINUE
      RETURN
      END
1	mocchiut	1.1	SUBROUTINE DIRECTION(DEVIA)
2			C-----------------------------------------------------
3			C-
4			C- Purpose and Methods : PROGRAM THAT DETERMINES THE
5			C- TRACK PROJECTIONS ON THE PLANE XZ AND YZ USING
6			C- ONLY CALORIMETER INFORMATION .
7			C-
8			C- Inputs :
9			C- Outputs :
10			C- Controls:
11			C-
12			C- Created 9-FEB-1994 MIRKO BOEZIO
13			C- Modified 21-FEB-2003 MIRKO BOEZIO . ADAPTED TO
14			C- BE USED FOR PAMELA CALORIMETER .
15			C-
16			C------------------------------------------------------
17
18			IMPLICIT NONE
19
20			INCLUDE 'INTEST.TXT'
21
22	mocchiut	1.3	REAL FLIMIT, FLIMIT2
23	mocchiut	1.1	INTEGER NVAR,NPAR
24			PARAMETER (NVAR=1,NPAR=2)
25	mocchiut	1.4	c PARAMETER (FLIMIT=10000)
26			c PARAMETER (FLIMIT2=2000)
27	mocchiut	1.5	c PARAMETER (FLIMIT=500)
28			PARAMETER (FLIMIT=2000)
29	mocchiut	1.4	PARAMETER (FLIMIT2=500)
30	mocchiut	1.6	REAL X(NPLAV),Y(NPLAV),W(NPLAV)
31	mocchiut	1.1	REAL DEVIA(2),TG(2)
32	mocchiut	1.6	REAL BAR(2,NPLAV)
33	mocchiut	1.1	REAL A, B, VAR
34	mocchiut	1.2	REAL SA, SB, SVAR
35			REAL SSA, SSB, SSVAR
36	mocchiut	1.6	REAL PIANO(NPLAV)
37	mocchiut	1.1	REAL VARFIT(2)
38
39	mocchiut	1.2	INTEGER ICONT, M, I, SNPFIT,SSNPFIT
40			INTEGER NPFIT(2), CHTRACK,IWPL(2)
41	mocchiut	1.1
42	mocchiut	1.6	INTEGER IBAR(2,NPLAV)
43	mocchiut	1.1	COMMON/ANGOLO/BAR,IBAR
44			SAVE /ANGOLO/
45
46			REAL CX, CY
47			COMMON/WHERE/CX,CY,PIANO
48			SAVE /WHERE/
49
50	mocchiut	1.2	COMMON/CALOFIT/VARFIT,NPFIT,IWPL,CHTRACK
51	mocchiut	1.1	SAVE/CALOFIT/
52			C
53			ICONT = 0
54			DEVIA(1) = 0.
55			DEVIA(2) = 0.
56			CX = 0.
57			CY = 0.
58			C
59			NPFIT(1) = NPLA
60			NPFIT(2) = NPLA
61			VARFIT(1) = 0.
62			VARFIT(2) = 0.
63			C
64			C THE FIT IS PERFORMED WHEN THERE ARE AT LEAST TWO
65			C LAYERS WITH SIGNAL . FOR THE FIT THE CLUSTER WITH THE
66			C HIGHEST DETECTED ENERGY IS USED .
67			C
68			DO M = 1,2
69	mocchiut	1.2	SA = 0
70			SB = 0
71			SVAR = 0
72			FMODE(M) = 0
73			10 CONTINUE
74	mocchiut	1.1	ICONT = 0
75	mocchiut	1.6	CALL VZERO(X,NPLAV)
76			CALL VZERO(Y,NPLAV)
77			CALL VZERO(W,NPLAV)
78	mocchiut	1.1	DO I = 1,NPLA
79			C
80			IF (MOD(M,2).EQ.0) THEN
81	mocchiut	1.7	X(I) = PIANO(I)
82			C X(I) = PIANO(I) - 5.81
83			ELSE
84	mocchiut	1.1	X(I) = PIANO(I) - 5.81
85	mocchiut	1.7	C X(I) = PIANO(I)
86	mocchiut	1.1	ENDIF
87			Y(I) = 0.
88	mocchiut	1.2	C
89			C
90			C
91			IF (FMODE(M).EQ.0) THEN
92			IF (NCL(M,I).GE.1) THEN
93			ICONT = ICONT + 1
94			Y(I) = CLUS(M,I,1)
95			W(I) = ((CLUS(M,I,1+NCHA/2)0.79))2.
96			IF (W(I).GT.2000.) THEN
97			W(I) = 2000.
98			C Y(I) = 0.
99			C ICONT = ICONT -1
100			ENDIF
101			ENDIF
102			ENDIF
103			C
104	mocchiut	1.4	C No weigth and less cluster per plane
105	mocchiut	1.2	C
106			IF(FMODE(M).EQ.1) THEN
107			IF (NCL(M,I).GE.1.AND.NCL(M,I).LE.2) THEN
108			ICONT = ICONT + 1
109			Y(I) = CLUS(M,I,1)
110	mocchiut	1.5	W(I) = ((CLUS(M,I,1+NCHA/2)0.29))2.
111			c W(I) = 1.
112	mocchiut	1.2	ENDIF
113	mocchiut	1.4	c IF (W(I).GT.2000.) THEN
114			cx W(I) = 2000.
115			cc Y(I) = 0.
116			cc ICONT = ICONT -1
117			c ENDIF
118	mocchiut	1.2	ENDIF
119			c
120			c One cluster per plane
121			c
122			IF(FMODE(M).EQ.2) THEN
123			IF (NCL(M,I).EQ.1) THEN
124			ICONT = ICONT + 1
125			Y(I) = CLUS(M,I,1)
126	mocchiut	1.5	W(I) = ((CLUS(M,I,1+NCHA/2)0.79))2.
127			c W(I) = 1.
128	mocchiut	1.2	ENDIF
129	mocchiut	1.1	ENDIF
130	mocchiut	1.2	c if (Y(I).eq.0.or.W(I).eq.2000.) NPFIT(M) = NPFIT(M) - 1
131			if (Y(I).eq.0.) NPFIT(M) = NPFIT(M) - 1
132	mocchiut	1.1	ENDDO
133			C
134
135			A = 0.
136			B = 0.
137	mocchiut	1.2	VAR = 0.
138			c print *,' icont = ',icont
139			IF (ICONT.GE.2) THEN
140			CALL LFITW(X,Y,W,NPLA,0,A,B,VAR)
141			ELSE
142			NPFIT(M) = 0
143			ENDIF
144			C
145			C TRY A BETTER FIT IF VAR IS BIG ON THE FIRST TRY
146			C
147			IF ((ABS(VAR).GT.FLIMIT.OR.VAR.EQ.0.).AND.FMODE(M).EQ.0) THEN
148			SVAR = VAR
149			SB = B
150			SA = A
151			SNPFIT = NPFIT(M)
152			NPFIT(M) = NPLA
153			FMODE(M) = 1
154			GOTO 10
155			ENDIF
156			C
157	mocchiut	1.4	C TRY AGAIN IF STILL BAD AND WE HAVE AT LEAST 10 POINT TO MAKE THE FIT
158	mocchiut	1.2	C
159	mocchiut	1.3	IF ((ABS(VAR).GT.FLIMIT2.OR.VAR.EQ.0.).AND.FMODE(M).EQ.1
160	mocchiut	1.4	& .AND.SNPFIT.GT.5) THEN
161	mocchiut	1.2	SSVAR = VAR
162			SSB = B
163			SSA = A
164			SSNPFIT = NPFIT(M)
165			NPFIT(M) = NPLA
166			FMODE(M) = 2
167			GOTO 10
168			ENDIF
169			C
170			C IF WE ARE AT THE THIRD TRY AND THE FIT IS WORST THAN THE SECOND TRY TAKE THE FIRST TRY
171			C
172			IF (FMODE(M).EQ.2) THEN
173			IF (ABS(VAR).GT.ABS(SSVAR).OR.ABS(VAR).EQ.0.
174			& .OR.NPFIT(M).LE.4) THEN
175			FMODE(M) = 1
176			VAR=SSVAR
177			B = SSB
178			A = SSA
179			NPFIT(M) = SSNPFIT
180			ENDIF
181			ENDIF
182			C
183			C IF THE SECOND TRY AND THE FIT IS WORST THAN THE FIRST TRY TAKE THE FIRST TRY
184			C
185			IF (FMODE(M).EQ.1) THEN
186			IF (ABS(VAR).GT.ABS(SVAR).OR.ABS(VAR).EQ.0.) THEN
187			FMODE(M) = 0
188			VAR=SVAR
189			B = SB
190			A = SA
191			NPFIT(M) = SNPFIT
192			ENDIF
193			ENDIF
194			C
195	mocchiut	1.1	VARFIT(M) = VAR
196			IF (M.EQ.1) CX = B
197			IF (M.EQ.2) CY = B
198			DEVIA(M) = A
199			TG(M) = A
200	mocchiut	1.2	C
201	mocchiut	1.1	ENDDO
202			C
203
204			500 CONTINUE
205			RETURN
206			END