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) - 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 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			X(I) = PIANO(I) - 5.81
82			ELSE
83			X(I) = PIANO(I)
84			ENDIF
85			Y(I) = 0.
86	mocchiut	1.2	C
87			C
88			C
89			IF (FMODE(M).EQ.0) THEN
90			IF (NCL(M,I).GE.1) THEN
91			ICONT = ICONT + 1
92			Y(I) = CLUS(M,I,1)
93			W(I) = ((CLUS(M,I,1+NCHA/2)0.79))2.
94			IF (W(I).GT.2000.) THEN
95			W(I) = 2000.
96			C Y(I) = 0.
97			C ICONT = ICONT -1
98			ENDIF
99			ENDIF
100			ENDIF
101			C
102	mocchiut	1.4	C No weigth and less cluster per plane
103	mocchiut	1.2	C
104			IF(FMODE(M).EQ.1) THEN
105			IF (NCL(M,I).GE.1.AND.NCL(M,I).LE.2) THEN
106			ICONT = ICONT + 1
107			Y(I) = CLUS(M,I,1)
108	mocchiut	1.5	W(I) = ((CLUS(M,I,1+NCHA/2)0.29))2.
109			c W(I) = 1.
110	mocchiut	1.2	ENDIF
111	mocchiut	1.4	c IF (W(I).GT.2000.) THEN
112			cx W(I) = 2000.
113			cc Y(I) = 0.
114			cc ICONT = ICONT -1
115			c ENDIF
116	mocchiut	1.2	ENDIF
117			c
118			c One cluster per plane
119			c
120			IF(FMODE(M).EQ.2) THEN
121			IF (NCL(M,I).EQ.1) THEN
122			ICONT = ICONT + 1
123			Y(I) = CLUS(M,I,1)
124	mocchiut	1.5	W(I) = ((CLUS(M,I,1+NCHA/2)0.79))2.
125			c W(I) = 1.
126	mocchiut	1.2	ENDIF
127	mocchiut	1.1	ENDIF
128	mocchiut	1.2	c if (Y(I).eq.0.or.W(I).eq.2000.) NPFIT(M) = NPFIT(M) - 1
129			if (Y(I).eq.0.) NPFIT(M) = NPFIT(M) - 1
130	mocchiut	1.1	ENDDO
131			C
132
133			A = 0.
134			B = 0.
135	mocchiut	1.2	VAR = 0.
136			c print *,' icont = ',icont
137			IF (ICONT.GE.2) THEN
138			CALL LFITW(X,Y,W,NPLA,0,A,B,VAR)
139			ELSE
140			NPFIT(M) = 0
141			ENDIF
142			C
143			C TRY A BETTER FIT IF VAR IS BIG ON THE FIRST TRY
144			C
145			IF ((ABS(VAR).GT.FLIMIT.OR.VAR.EQ.0.).AND.FMODE(M).EQ.0) THEN
146			SVAR = VAR
147			SB = B
148			SA = A
149			SNPFIT = NPFIT(M)
150			NPFIT(M) = NPLA
151			FMODE(M) = 1
152			GOTO 10
153			ENDIF
154			C
155	mocchiut	1.4	C TRY AGAIN IF STILL BAD AND WE HAVE AT LEAST 10 POINT TO MAKE THE FIT
156	mocchiut	1.2	C
157	mocchiut	1.3	IF ((ABS(VAR).GT.FLIMIT2.OR.VAR.EQ.0.).AND.FMODE(M).EQ.1
158	mocchiut	1.4	& .AND.SNPFIT.GT.5) THEN
159	mocchiut	1.2	SSVAR = VAR
160			SSB = B
161			SSA = A
162			SSNPFIT = NPFIT(M)
163			NPFIT(M) = NPLA
164			FMODE(M) = 2
165			GOTO 10
166			ENDIF
167			C
168			C IF WE ARE AT THE THIRD TRY AND THE FIT IS WORST THAN THE SECOND TRY TAKE THE FIRST TRY
169			C
170			IF (FMODE(M).EQ.2) THEN
171			IF (ABS(VAR).GT.ABS(SSVAR).OR.ABS(VAR).EQ.0.
172			& .OR.NPFIT(M).LE.4) THEN
173			FMODE(M) = 1
174			VAR=SSVAR
175			B = SSB
176			A = SSA
177			NPFIT(M) = SSNPFIT
178			ENDIF
179			ENDIF
180			C
181			C IF THE SECOND TRY AND THE FIT IS WORST THAN THE FIRST TRY TAKE THE FIRST TRY
182			C
183			IF (FMODE(M).EQ.1) THEN
184			IF (ABS(VAR).GT.ABS(SVAR).OR.ABS(VAR).EQ.0.) THEN
185			FMODE(M) = 0
186			VAR=SVAR
187			B = SB
188			A = SA
189			NPFIT(M) = SNPFIT
190			ENDIF
191			ENDIF
192			C
193	mocchiut	1.1	VARFIT(M) = VAR
194			IF (M.EQ.1) CX = B
195			IF (M.EQ.2) CY = B
196			DEVIA(M) = A
197			TG(M) = A
198	mocchiut	1.2	C
199	mocchiut	1.1	ENDDO
200			C
201
202			500 CONTINUE
203			RETURN
204			END