/[PAMELA software]/DarthVader/CalorimeterLevel2/src/calol2tr.for
ViewVC logotype

Diff of /DarthVader/CalorimeterLevel2/src/calol2tr.for

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by mocchiut, Wed May 31 09:31:11 2006 UTC revision 1.19 by mocchiut, Thu Nov 29 16:11:53 2007 UTC
# Line 6  C Line 6  C
6        INCLUDE 'INTEST.TXT'        INCLUDE 'INTEST.TXT'
7  C  C
8        DOUBLE PRECISION al_p(5),        DOUBLE PRECISION al_p(5),
9       &     xout(npla),yout(npla),zin(npla)       &     xout(nplav),yout(nplav),zin(nplav)
10  C  C
11        REAL PIANO(22), VARFIT(2)        REAL PIANO(NPLAV), VARFIT(2)
12        REAL TX, TY, SHIFT        REAL TX, TY, SHIFT
13        REAL BAR(2,NPLA), DISTY        REAL BAR(2,NPLAV), DISTY
14        REAL DISTX, Y(NPLA), YY(NPLA)        REAL DISTX, Y(NPLAV), YY(NPLAV)
15        REAL RIG, PPLANEMAX, RMASS        REAL RIG, PPLANEMAX, RMASS
16        REAL RNSS, QTOTT, RQT, MX, MY        REAL RNSS, QTOTT, RQT, MX, MY
17        REAL CHECK, ENER, CX, CY        REAL CHECK, ENER, CX, CY
# Line 26  C Line 26  C
26        INTEGER INDEX, NTOT(2), NPIANI, GTR        INTEGER INDEX, NTOT(2), NPIANI, GTR
27        INTEGER j, m, i, IWPL(2), timpx, timpy, T, nn        INTEGER j, m, i, IWPL(2), timpx, timpy, T, nn
28        INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY        INTEGER IPLANE, NNX, NNY, INFX, INFY, ISUPX, ISUPY
29        INTEGER IBAR(2,NPLA), NPFIT(2), CHTRACK,IWPLU        INTEGER IBAR(2,NPLAV), NPFIT(2), CHTRACK,IWPLU
30        INTEGER Iquest(100), ICONTROL5, nin, IFAIL        INTEGER Iquest(100), ICONTROL5, nin, IFAIL
31  C  C
32        PARAMETER (X01PL=0.74)        PARAMETER (X01PL=0.74)
# Line 55  C Line 55  C
55        COMMON / CH / CHECK        COMMON / CH / CHECK
56        SAVE / CH /        SAVE / CH /
57  C  C
58        COMMON / CALOFIT / VARFIT, NPFIT        COMMON / CALOFIT / VARFIT, NPFIT, IWPL,CHTRACK
59        SAVE / CALOFIT /        SAVE / CALOFIT /
60  C  C
61        COMMON / pawcd / hmemor        COMMON / pawcd / hmemor
# Line 66  C Line 66  C
66  C  C
67  C Begin !  C Begin !
68  C  C
69    c      print *,' sono qui'
70        CALOL2TR = 0;        CALOL2TR = 0;
71        NCORE = 0.        NCORE = 0.
72        QCORE = 0.        QCORE = 0.
# Line 89  C Line 90  C
90        NLAST = 0.        NLAST = 0.
91        PLANETOT = 0.        PLANETOT = 0.
92        QMEAN = 0.        QMEAN = 0.
93        SELFTRIGGER = 0  C      SELFTRIGGER = 0
       CALL VZERO(VARCFIT,2)  
       CALL VZERO(NPCFIT,2)  
       CALL VZERO(TBAR,2*NPLA)  
       CALL VZERO(TIBAR,2*NPLA)  
       CALL VZERO(BAR,2*NPLA)  
       CALL VZERO(IBAR,2*NPLA)  
       CALL VZERO(IBAR,2*NPLA)  
       CALL VZERO(Y,NPLA)  
       CALL VZERO(YY,NPLA)  
       CALL VZERO(XOUT,NPLA)  
       CALL VZERO(YOUT,NPLA)  
94  C  C
95  C     BEGIN WITH THE FISRT TRACK IF WE HAVE A TRACK FROM TRACKER  C     BEGIN WITH THE FIRST TRACK IF WE HAVE A TRACK FROM TRACKER
96  C  C
97        T = 1        T = 1
98  C  C
# Line 113  C     Line 103  C    
103           CHTRACK = 0           CHTRACK = 0
104  C  C
105           CALL VZERO(IWPL,2)           CALL VZERO(IWPL,2)
106           CALL VZERO(BAR,2*NPLA)           CALL VZERO(BAR,2*NPLAV)
107           CALL VZERO(IBAR,2*NPLA)           CALL VZERO(IBAR,2*NPLAV)
108           CALL VZERO(TBAR,2*NPLA)           CALL VZERO(TBAR,2*NPLAV)
109           CALL VZERO(TIBAR,2*NPLA)           CALL VZERO(TIBAR,2*NPLAV)
110             CALL VZERO(Y,NPLAV)
111             CALL VZERO(YY,NPLAV)
112             CALL VZERO(XOUT,NPLAV)
113             CALL VZERO(YOUT,NPLAV)
114           do m = 1, 5           do m = 1, 5
115              al_p(m) = al_pp(t,m)              al_p(m) = al_pp(t,m)
116    c            print *,' al_p(',m,') = ',al_p(m)
117           enddo           enddo
118           if (al_p(5).eq.0.) THEN           if (al_p(5).eq.0.) THEN
119              PRINT *,' CALORIMETER - WARNING F77: track with R = 0, discarded'         PRINT *,' CALORIMETER - WARNING F77: track with R = 0, discarded'
120              GOOD2 = 0              GOOD2 = 0
121              GOTO 969              GOTO 969
122           ENDIF           ENDIF
# Line 131  C Line 126  C
126                 YOUT(I) = 0.                 YOUT(I) = 0.
127                 IF (MOD(M,2).EQ.0) THEN                 IF (MOD(M,2).EQ.0) THEN
128                    DISTX = PIANO(I) + ZALIG                    DISTX = PIANO(I) + ZALIG
129    c                  print *,'T Y PLANE I= ',I,' Z = ',DISTX
130                 ELSE                 ELSE
131                    DISTX = PIANO(I) - 5.81 + ZALIG                    DISTX = PIANO(I) - 5.81 + ZALIG
132    c                  print *,'T X PLANE I= ',I,' Z = ',DISTX
133                 ENDIF                               ENDIF              
134                 ZIN(I) = distx / 10.                 ZIN(I) = distx / 10.
135    c               print *,' ZIN(',I,') = ',ZIN(I)
136                 TBAR(M,I) = 0.                 TBAR(M,I) = 0.
137                 TIBAR(M,I) = 0                 TIBAR(M,I) = 0
138              enddo              enddo
# Line 149  c               print *,' CALORIMETER - Line 147  c               print *,' CALORIMETER -
147              TY = TAN(ASIN(AL_P(3))) * SIN(AL_P(4))              TY = TAN(ASIN(AL_P(3))) * SIN(AL_P(4))
148              DO I = 1, NPLA              DO I = 1, NPLA
149                 NN = 0                 NN = 0
150                 IF (M.EQ.2) NN = 1  c               IF (M.EQ.2) NN = 1
151                 IF (MOD(I,2).EQ.NN) THEN                 IF (MOD(I,2).EQ.NN) THEN
152                    SHIFT = +0.5                    IF (REVERSE.EQ.0) THEN
153                         SHIFT = -0.5
154                      ELSE
155                         SHIFT = +0.5
156                      ENDIF
157                 ELSE                 ELSE
158                    SHIFT = -0.5                    IF (REVERSE.EQ.0) THEN
159                         SHIFT = +0.5
160                      ELSE
161                         SHIFT = -0.5
162                      ENDIF
163                 ENDIF                 ENDIF
164  C      C    
165  C     CHECK IF XOUT OR YOUT ARE NaN  C     CHECK IF XOUT OR YOUT ARE NaN
# Line 166  c     &         ' CALORIMETER - WARNING Line 172  c     &         ' CALORIMETER - WARNING
172                 ENDIF                 ENDIF
173  C  C
174                 CX = XOUT(I)*10. + XALIG                 CX = XOUT(I)*10. + XALIG
175                 CY = -YOUT(I)*10. + YALIG                 CY = YOUT(I)*10. + YALIG
176  C      C    
177                 IF (I.EQ.1) THEN                 IF (I.EQ.1) THEN
178                    TIMPX = CX                    TIMPX = CX
# Line 176  C     Line 182  C    
182                    Y(I) = CX                    Y(I) = CX
183                    BAR(M,I) = Y(I)                        BAR(M,I) = Y(I)    
184                    TBAR(M,I) = (Y(I) - XALIG)/10.                    TBAR(M,I) = (Y(I) - XALIG)/10.
185                    IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))                    IF (I.EQ.NPLA) MX=ABS(Y(1)-Y(NPLA))/
186         &                 ABS(ZIN(1)-ZIN(NPLA))
187                 ELSE                 ELSE
188                    YY(I) = CY                    YY(I) = CY
189                    BAR(M,I) = YY(I)                                      BAR(M,I) = YY(I)                  
190                    TBAR(M,I) = (YALIG - YY(I))/10.                        TBAR(M,I) = (-YALIG + YY(I))/10.    
191                    IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))                    IF (I.EQ.NPLA) MY=ABS(Y(1)-Y(NPLA))/
192         &                 ABS(ZIN(1)-ZIN(NPLA))
193                 ENDIF                 ENDIF
194                 CALL LASTRISCIA(BAR(M,I),IBAR(M,I))                 CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
195                 tibar(M,I) = ibar(m,i)                 tibar(M,I) = ibar(m,i)
# Line 235  C Line 243  C
243  C          C        
244  C     WE MUST PROCESS A SELFTRIGGER EVENT  C     WE MUST PROCESS A SELFTRIGGER EVENT
245  C  C
246        IF (TRIGTY.GE.2) THEN        IF (TRIGTY.GE.2.AND.HZN.EQ.0) THEN
247  C  C
248  C     CALL SELFTRIGGER SUBROUTINE  C     CALL SELFTRIGGER SUBROUTINE
249  C  C
250             CALL VZERO(IWPL,2)
251             CALL VZERO(VARCFIT,2)
252             CALL VZERO(NPCFIT,2)
253             CALL VZERO(TBAR,2*NPLAV)
254             CALL VZERO(TIBAR,2*NPLAV)
255             CALL VZERO(BAR,2*NPLAV)
256             CALL VZERO(IBAR,2*NPLAV)
257             CALL VZERO(Y,NPLAV)
258             CALL VZERO(YY,NPLAV)
259             CALL VZERO(XOUT,NPLAV)
260             CALL VZERO(YOUT,NPLAV)
261    C
262           CALL SELFTRIG()           CALL SELFTRIG()
263           ELEN = PARZEN3           ELEN = PARZEN3
264           SELEN = ABS(ELEN) * (11.98*1E-2 + 7.6 * EXP(-5736/ABS(ELEN)))           SELEN = ABS(ELEN) * (11.98*1E-2 + 7.6 * EXP(-5736/ABS(ELEN)))
# Line 248  C Line 268  C
268  C      C    
269           DO M = 1,2           DO M = 1,2
270  C  C
271    c            print *,' ax ',ax,' ay ',ay
272    c            print *,' bx ',bx,' by ',by
273              IF (NPCFIT(M).GE.2) THEN              IF (NPCFIT(M).GE.2) THEN
274                 IF (M.EQ.1) THEN                 IF (M.EQ.1) THEN
275                    VARCFIT(1) = CHI2X                    VARCFIT(1) = CHI2X
276                    IMPX = 10. * ( AX + 12.1 )                    IMPX = AX ! PAMELA REF
277                    TANX = BX                    TANX = BX
278                 ELSE                 ELSE
279                    VARCFIT(2) = CHI2Y                    VARCFIT(2) = CHI2Y
280                    IMPY = 10. * ( AY + 12.2 )                    IMPY = AY ! PAMELA REF
281                    TANY = BY                    TANY = BY
282                 ENDIF                 ENDIF
283  C  C
284                 DO I = 1,NPLA                     DO I = 1,NPLA    
285                    NN = 0                    NN = 0
286                    IF (M.EQ.2) NN = 1  c                  IF (M.EQ.2) NN = 1
287                    IF (MOD(I,2).EQ.NN) THEN                    IF (MOD(I,2).EQ.NN) THEN
288                       SHIFT = +0.5                       IF (REVERSE.EQ.0) THEN
289                            SHIFT = -0.5
290                         ELSE
291                            SHIFT = +0.5
292                         ENDIF
293                    ELSE                    ELSE
294                       SHIFT = -0.5                       IF (REVERSE.EQ.0) THEN
295                            SHIFT = +0.5
296                         ELSE
297                            SHIFT = -0.5
298                         ENDIF
299                    ENDIF                    ENDIF
300  C      C    
301                    IF (M.EQ.1) THEN                    IF (M.EQ.1) THEN
302                       DISTX = PIANO(I) - 5.81                       DISTX = PIANO(I) - 5.81
303                       Y(I) = DISTX * TANX + CX                       Y(I) = (DISTX * TANX) +  AX - XALIG
304    c                     CBAR(M,I) = Y(I)
305                       BAR(M,I) = Y(I)                       BAR(M,I) = Y(I)
306                       CBAR(M,I) = Y(I)                               CBAR(M,I) = (Y(I) + XALIG)/10.
307                       IF (I.EQ.22) MX=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))                       IF (I.EQ.NPLA) MX=ABS(Y(1)-Y(NPLA))/
308         &                    ABS(ZIN(1)-ZIN(NPLA))
309  C      C    
310                    ELSE                    ELSE
311                       DISTY = PIANO(I)                                       DISTY = PIANO(I)                
312                       YY(I) = DISTY * TANY + CY                       YY(I) = (DISTY * TANY) + AY - YALIG
313    c                     CBAR(M,I) = YY(I)
314                       BAR(M,I) = YY(I)                       BAR(M,I) = YY(I)
315                       CBAR(M,I) = YY(I)                       CBAR(M,I) = (YY(I) + YALIG)/10.
316                       IF (I.EQ.22) MY=ABS(Y(1)-Y(22))/ABS(ZIN(1)-ZIN(22))                       IF (I.EQ.NPLA) MY=ABS(Y(1)-Y(NPLA))/
317         &                    ABS(ZIN(1)-ZIN(NPLA))
318  C      C    
319                    ENDIF                    ENDIF
320                    CALL LASTRISCIA(BAR(M,I),IBAR(M,I))                    CALL LASTRISCIA(BAR(M,I),IBAR(M,I))
321                    cibar(M,I) = ibar(m,i)                    cibar(M,I) = ibar(m,i)
322                      IF (ibar(m,i).EQ.-1) THEN
323                         CHTRACK = CHTRACK + 1
324                      ELSE
325                         IWPL(M) = IWPL(M) + 1
326                      ENDIF
327                 ENDDO                             ENDDO            
328              ENDIF              ENDIF
329  C  C
330           ENDDO           ENDDO
331  C  C
332        ELSE        ENDIF
333           IF (GOOD2.EQ.0) THEN  C
334          IF (TRIGTY.GE.2.AND.HZN.NE.0) THEN
335             IF (GOOD2.EQ.1) THEN
336              PRINT *,' CALORIMETER - WARNING F77: unknown request'              PRINT *,' CALORIMETER - WARNING F77: unknown request'
337              GOOD2 = 1              GOOD2 = 1
338              GOTO 50              GOTO 50
339           ENDIF           ENDIF
340             IF ( NPCFIT(1).EQ.0.OR.NPCFIT(2).EQ.0 ) THEN
341                GOOD2 = 1
342                GOTO 50
343             ENDIF
344        ENDIF        ENDIF
345  C  C
346   6996 CONTINUE   6996 CONTINUE
# Line 304  C Line 349  C
349  C  C
350  C IF THE TRACK IS OUTSIDE THE CALORIMETER GO OUT, IF NOT CALCULATE DX0L  C IF THE TRACK IS OUTSIDE THE CALORIMETER GO OUT, IF NOT CALCULATE DX0L
351  C  C
352        IF (CHTRACK.EQ.44) THEN        IF (CHTRACK.EQ.44) THEN  ! CHTRACK is the number of planes not touched by the track
353           GOOD2 = 0           GOOD2 = 0
354  c         PRINT *,' CALORIMETER - WARNING F77: track outside calorimeter'  c         PRINT *,' CALORIMETER - WARNING F77: track outside calorimeter'
355           GOTO 50           GOTO 50
# Line 319  C Line 364  C
364       &      + (BAR(1,1)-(2.66*MX+BAR(1,1)))**2 + 2.66**2) /       &      + (BAR(1,1)-(2.66*MX+BAR(1,1)))**2 + 2.66**2) /
365       &      3.6         &      3.6  
366  C  C
 C         DX0L = X01PL * SQRT( (IWPL(1) * SQRT(1 + MX*MX))**2 +  
 C     &                        (IWPL(2) * SQRT(1 + MY*MY))**2 )/2.  
367        ENDIF        ENDIF
368  C  C
369  C  C
# Line 338  C Line 381  C
381              GOTO 50              GOTO 50
382           ENDIF           ENDIF
383        ENDIF        ENDIF
384        IF (TRIGTY.GE.2.AND.GOOD2.EQ.0) THEN        IF (TRIGTY.GE.2.AND.HZN.EQ.0.AND.GOOD2.EQ.0) THEN
385           RIG = ELEN ! SELFTRIGGER RIGIDITY           RIG = ELEN ! SELFTRIGGER RIGIDITY
386           IF ( RIG.EQ.0. ) THEN           IF ( RIG.EQ.0. ) THEN
387              GOOD2 = 0              GOOD2 = 1
388              PRINT *,' CALORIMETER - WARNING F77: ST track with R = 0'              PRINT *,' CALORIMETER - WARNING F77: ST track with R = 0'
389              GOTO 50              GOTO 50
390           ENDIF           ENDIF
391        ENDIF        ENDIF
392  C  C
393          IF (GOOD2.EQ.0.AND.(TRIGTY.LT.2.OR.HZN.EQ.1)) THEN
394             RIG = RIGINPUT
395          ENDIF
396    C
397        RNSS = 0.        RNSS = 0.
398        QTOTT = 0.        QTOTT = 0.
399  C  C
400        PPLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.)        PPLANEMAX = 1.01*(LOG(ABS(RIG)/0.0081)-1.) / 0.74
401  C  C
402        IPLANE = INT(ANINT(PPLANEMAX)) + 5        IPLANE = INT(ANINT(PPLANEMAX)) + 5
403  C  C
404        IF (IPLANE.GT.NPLA) IPLANE=NPLA        IF (IPLANE.GT.NPLA) IPLANE=NPLA
405        IF (IPLANE.LT.1) IPLANE = 1        IF (IPLANE.LT.1) IPLANE = 1
406    c      print *,' calcolo...'
407  C  C
408  C     CALCULATE QLOW AND NLOW  C     CALCULATE QLOW AND NLOW
409  C  C
# Line 379  C     8 STRIPS ARE 2.88 cm , A MOLIERE R Line 427  C     8 STRIPS ARE 2.88 cm , A MOLIERE R
427  C      C    
428        DO J = 1,IPLANE        DO J = 1,IPLANE
429           NNX = IBAR(1,J)           NNX = IBAR(1,J)
430             RNSS = 0.               ! BACO!!
431             QTOTT = 0.               ! BACO!!
432           IF (NNX.NE.-1) THEN           IF (NNX.NE.-1) THEN
433              IF (NNX.LT.9) NNX = 9              IF (NNX.LT.9) NNX = 9
434              IF (NNX.GT.88) NNX = 88              IF (NNX.GT.88) NNX = 88
# Line 594  c            ISUPY = NNY + 8 Line 644  c            ISUPY = NNY + 8
644           ENDIF           ENDIF
645        ENDDO        ENDDO
646  C  C
       EINF = EMIN  
       ESUP = 50.  
647  C  C
648  C     CALCULATE PLANETOT AND QMEAN  C     CALCULATE PLANETOT AND QMEAN
649  C  C
# Line 606  C Line 654  C
654        NPIANI = 5        NPIANI = 5
655        QMEAN = 0.        QMEAN = 0.
656        INDEX = 0        INDEX = 0
657        CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX)  C
658        PLANETOT = RPIANO(1) + RPIANO(2)          IF (TRIGTY.GE.2.AND.HZN.NE.0) THEN
659             EINF = 50.
660             ESUP = 15000.
661             CALL NUCLEI(RPIANO,NPIANI,QMEAN,NTOT,INDEX)
662             PLANETOT = RPIANO(1) + RPIANO(2)  
663          ELSE
664             EINF = EMIN
665             ESUP = 15000.
666             CALL ELIO(RPIANO,NPIANI,QMEAN,NTOT,INDEX)
667             PLANETOT = RPIANO(1) + RPIANO(2)  
668          ENDIF
669  C  C
670   50   CONTINUE   50   CONTINUE
671  C  C
672    c      print *,' esco'
673        RETURN        RETURN
674        END        END
675    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.23