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)          
      PARAMETER (FLIMIT=10000)
      PARAMETER (FLIMIT2=2000)
      REAL X(NPLA),Y(NPLA),W(NPLA)
      REAL DEVIA(2),TG(2)
      REAL BAR(2,NPLA)
      REAL A, B, VAR
      REAL SA, SB, SVAR
      REAL SSA, SSB, SSVAR
      REAL PIANO(22)
      REAL VARFIT(2)

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