801909a60d624db68adb5fd199ffb0fc81194f9e
[u/mrichter/AliRoot.git] / PHOS / AliPHOSf.F
1 *CMZ :          15/02/99  14.40.30  by  Federico Carminati
2 *CMZ :  2.03/01 20/08/98  09.43.00  by  Federico Carminati
3 *CMZ :  2.03/00 09/07/98  19.21.29  by  Federico Carminati
4 *CMZ :  2.00/05 25/05/98  14.39.01  by  Federico Carminati
5 *CMZ :  1.05/06 26/10/95  17.04.53  by  Nick van Eijndhoven (RUU/CERN)
6 *CMZ :  1.05/00 11/11/94  15.21.30  by  Nick van Eijndhoven (RUU/CERN)
7 *-- Author :    Nick van Eijndhoven (CERN)   24/09/90
8       SUBROUTINE PHOS_INIT
9 C
10 C *** DEFINITION OF THE GEOMETRY OF THE PHOS ***
11 C *** NVE 24-SEP-1990 CERN GENEVA ***
12 C
13 C CALLED BY : SXGEOM
14 C ORIGIN    : NICK VAN EIJNDHOVEN
15 C
16 *KEEP,GCKINE.
17       COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
18      +      ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
19 C
20       INTEGER       IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
21       REAL          PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
22 C
23 *KEEP,LUDAT1.
24       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
25       INTEGER MSTU,MSTJ
26       REAL    PARU,PARJ
27       SAVE /LUDAT1/
28 *
29 *KEEP,SHRUNP.
30       COMMON /SHRUNP/ VMAJ,IMIN,NRUN,NEVTOT
31 *KEEP,SHPHYP.
32       COMMON /SHPHYP/ JWEI,NDNDY,YLIM,PTLIM,JWEAK,JPI0,JETA,JPIC,JPRO,
33      +                  JKAC,JKA0,JRHO,JOME,JPHI,JPSI,JDRY
34 *KEEP,SCPHOS.
35         INTEGER MAXCRAD
36         PARAMETER (MAXCRAD=100)
37         INTEGER PHOSsize,PHOS_Ndiv_magic
38         REAL    PHOSflags,PHOScell,PHOSradius,PHOSCPV,
39      +          PHOScradlesA,PHOSTXW,PHOSAIR,PHOSFTI,
40      +          PHOSextra, PHOSangle
41         COMMON /PHOS_PARS/ PHOSflags(9),
42      +                           PHOScell(9),PHOSradius,PHOSCPV(9),
43      +                           PHOSsize(3), PHOScradlesA,
44      +                           PHOSTXW(3),PHOSAIR(3),PHOSFTI(4),
45      +                           PHOSextra(9), PHOSangle(MAXCRAD),
46      +                           PHOS_Ndiv_magic
47 *KEND.
48 C
49       IF (PHOSsize(3).GT.MAXCRAD) THEN
50          STOP 'PHOS_INIT Increase MAXCRAD, too many cradles!'
51       ENDIF
52
53 *AZ { SHAKER initialization
54       IF( IKINE.EQ.700 ) THEN
55          JWEI        = 0
56          NDNDY       = NINT(PKINE(4))
57          YLIM        = PKINE(5)
58          PTLIM       = PKINE(6)
59          JWEAK       = 0
60          JPI0        = 1
61          JETA        = 1
62          JPIC        = NINT(PKINE(7))
63          JPRO        = NINT(PKINE(7))
64          JKAC        = NINT(PKINE(7))
65          JKA0        = NINT(PKINE(7))
66          JRHO        = NINT(PKINE(7))
67          JOME        = NINT(PKINE(7))
68          JPHI        = NINT(PKINE(7))
69          JPSI        = NINT(PKINE(7))
70          JDRY        = NINT(PKINE(7))
71          NEVTOT      = 999999999
72
73          MSTU(11)    = 6        ! Shaker output to screen (Fortran channel 6).
74          CALL SHINIT            ! Shaker initialization.
75
76          print *,'************************************************'
77          print *,'Print some SHAKER parameters.'
78          print *,'NDNDY=',NDNDY
79          print *,'YLIM=',YLIM
80          print *,'PTLIM=',PTLIM
81          print *,'JPIC=',JPIC
82          print *,'************************************************'
83 *AZ }
84
85       ENDIF
86 *
87       END
88 *CMZ :          15/02/99  14.40.30  by  Federico Carminati
89 *CMZ :  2.03/01 28/07/98  16.12.22  by  Federico Carminati
90 *-- Author :    Federico Carminati   17/07/98
91       SUBROUTINE PHOS_KINE(NT)
92 *KEEP,GCKINE.
93       COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
94      +      ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
95 C
96       INTEGER       IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
97       REAL          PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
98 C
99 *KEEP,SHGENE.
100       COMMON /SHGENE/ IEVT,NPI0,NETA,NPIC,NPRO,NKAC,NKA0,NRHO,NOME,
101      +                  NPHI,NPSI,NDRY
102 *KEEP,BLUJETS.
103       COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
104       SAVE /LUJETS/
105
106 *KEEP,SCPHOS.
107         INTEGER MAXCRAD
108         PARAMETER (MAXCRAD=100)
109         INTEGER PHOSsize,PHOS_Ndiv_magic
110         REAL    PHOSflags,PHOScell,PHOSradius,PHOSCPV,
111      +          PHOScradlesA,PHOSTXW,PHOSAIR,PHOSFTI,
112      +          PHOSextra, PHOSangle
113         COMMON /PHOS_PARS/ PHOSflags(9),
114      +                           PHOScell(9),PHOSradius,PHOSCPV(9),
115      +                           PHOSsize(3), PHOScradlesA,
116      +                           PHOSTXW(3),PHOSAIR(3),PHOSFTI(4),
117      +                           PHOSextra(9), PHOSangle(MAXCRAD),
118      +                           PHOS_Ndiv_magic
119 *KEND.
120 *
121       DIMENSION V_TMP(3),P_TMP(3)
122 *
123       IF(IKINE.EQ.700) THEN
124 * Shaker genrator          SHOULD BE CHECKED!!!!
125          IEVT = IEVT + 1        ! Increament SHAKER event number.
126          CALL SHEVNT
127
128
129 ***********************************
130 * Begin:   create list of SHAKER particles (if required)
131 * ------
132 * PHOSflags:    YES: X<>0   NO: X=0
133 * PHOSflags(1) : -----X  Create branch for TObjArray of AliPHOSCradle
134 *                ----X-  Create file (ftn03 on HP-UX) with list of SHAKER particles (7Mb/event)
135          tmp = PHOSflags(1)/(10**2)
136          i   = tmp
137          i   = (tmp-i)*10
138
139          IF( i.NE.0. ) CALL SHLIST   ! List of SHAKER particles. 7 Mbytes/event
140
141 * End of creation
142 ************************************
143
144          DO I=1,N
145                                 !? IF( K_LUJETS(I,5).EQ.0 )      MPRIMA=MPRIMA+1
146             IPART = IPART_FROM_LUJET_TO_GEANT(K(I,2))
147
148             IF( K(I,5).EQ.0 ) THEN
149               IFLAG_DONE = 1
150             ELSE
151               IFLAG_DONE = 0
152             ENDIF
153             DO JJ=1,3
154                V_TMP(JJ)=V(I,JJ)
155                P_TMP(JJ)=P(I,JJ)
156             ENDDO
157             CALL RXSTRAK(IFLAG_DONE,K(I,3),IPART,P_TMP
158      $           ,V_TMP,V(I,4),'Primary',NT)
159             IF( I.NE.NT ) THEN
160                STOP 'GUKINE: Bad thing...'
161             ENDIF
162
163             CALL RXKEEP(I)
164          ENDDO
165
166       ENDIF
167       GOTO 999
168 *
169   999 END
170       INTEGER FUNCTION IPART_FROM_LUJET_TO_GEANT(N)
171         ! Return GEANT particle number from LUJET particle number.
172         ! This code is from file shake005.f :  SUBROUTINE SHTOGL
173
174         IMPLICIT NONE
175         INTEGER N
176
177         IF      (N.EQ.0) THEN
178           IPART_FROM_LUJET_TO_GEANT = 0
179         ELSE IF (N.EQ.22) THEN
180           IPART_FROM_LUJET_TO_GEANT = 1         ! gamma
181         ELSE IF (N.EQ.-11) THEN
182           IPART_FROM_LUJET_TO_GEANT = 2
183         ELSE IF (N.EQ.11) THEN
184           IPART_FROM_LUJET_TO_GEANT = 3
185         ELSE IF (ABS(N).EQ.12) THEN
186           IPART_FROM_LUJET_TO_GEANT = 4
187         ELSE IF (ABS(N).EQ.14) THEN
188           IPART_FROM_LUJET_TO_GEANT = 4
189         ELSE IF (ABS(N).EQ.16) THEN
190           IPART_FROM_LUJET_TO_GEANT = 4
191         ELSE IF (N.EQ.-13) THEN
192           IPART_FROM_LUJET_TO_GEANT = 5
193         ELSE IF (N.EQ.13) THEN
194           IPART_FROM_LUJET_TO_GEANT = 6
195         ELSE IF (N.EQ.111) THEN
196           IPART_FROM_LUJET_TO_GEANT = 7
197         ELSE IF (N.EQ.211) THEN
198           IPART_FROM_LUJET_TO_GEANT = 8
199         ELSE IF (N.EQ.-211) THEN
200           IPART_FROM_LUJET_TO_GEANT = 9
201         ELSE IF (N.EQ.130) THEN
202           IPART_FROM_LUJET_TO_GEANT = 10
203         ELSE IF (N.EQ.321) THEN
204           IPART_FROM_LUJET_TO_GEANT = 11
205         ELSE IF (N.EQ.-321) THEN
206           IPART_FROM_LUJET_TO_GEANT = 12
207         ELSE IF (N.EQ.2112) THEN
208           IPART_FROM_LUJET_TO_GEANT = 13
209         ELSE IF (N.EQ.2212) THEN
210           IPART_FROM_LUJET_TO_GEANT = 14
211         ELSE IF (N.EQ.-2212) THEN
212           IPART_FROM_LUJET_TO_GEANT = 15
213         ELSE IF (N.EQ.310) THEN
214           IPART_FROM_LUJET_TO_GEANT = 16
215         ELSE IF (N.EQ.221) THEN
216           IPART_FROM_LUJET_TO_GEANT = 17        ! eta
217         ELSE IF (N.EQ.311) THEN                 ! This is (K0) and we set it to
218           IPART_FROM_LUJET_TO_GEANT = 10        ! GEANT K0 short
219         ELSE IF (N.EQ.-311) THEN                ! This is (K~0) and we set it to
220           IPART_FROM_LUJET_TO_GEANT = 10        ! GEANT K0 short
221         ELSE
222           WRITE(*,*) 'Unknown LUJET particle ', N
223           stop
224         ENDIF
225       END
226
227 ********************************************************************************