[u/mrichter/AliRoot.git] / PHOS / AliPHOSf.F

*CMZ :          15/02/99  14.40.30  by  Federico Carminati
*CMZ :  2.03/01 20/08/98  09.43.00  by  Federico Carminati
*CMZ :  2.03/00 09/07/98  19.21.29  by  Federico Carminati
*CMZ :  2.00/05 25/05/98  14.39.01  by  Federico Carminati
*CMZ :  1.05/06 26/10/95  17.04.53  by  Nick van Eijndhoven (RUU/CERN)
*CMZ :  1.05/00 11/11/94  15.21.30  by  Nick van Eijndhoven (RUU/CERN)
*-- Author :    Nick van Eijndhoven (CERN)   24/09/90
      SUBROUTINE PHOS_INIT
C
C *** DEFINITION OF THE GEOMETRY OF THE PHOS ***
C *** NVE 24-SEP-1990 CERN GENEVA ***
C
C CALLED BY : SXGEOM
C ORIGIN    : NICK VAN EIJNDHOVEN
C
*KEEP,GCKINE.
      COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
     +      ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
C
      INTEGER       IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
      REAL          PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
C
*KEEP,LUDAT1.
      COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
      INTEGER MSTU,MSTJ
      REAL    PARU,PARJ
      SAVE /LUDAT1/
*
*KEEP,SHRUNP.
      COMMON /SHRUNP/ VMAJ,IMIN,NRUN,NEVTOT
*KEEP,SHPHYP.
      COMMON /SHPHYP/ JWEI,NDNDY,YLIM,PTLIM,JWEAK,JPI0,JETA,JPIC,JPRO,
     +                  JKAC,JKA0,JRHO,JOME,JPHI,JPSI,JDRY
*KEEP,SCPHOS.
        INTEGER MAXCRAD
        PARAMETER (MAXCRAD=100)
        INTEGER PHOSsize,PHOS_Ndiv_magic
        REAL    PHOSflags,PHOScell,PHOSradius,PHOSCPV,
     +          PHOScradlesA,PHOSTXW,PHOSAIR,PHOSFTI,
     +          PHOSextra, PHOSangle
        COMMON /PHOS_PARS/ PHOSflags(9),
     +                           PHOScell(9),PHOSradius,PHOSCPV(9),
     +                           PHOSsize(3), PHOScradlesA,
     +                           PHOSTXW(3),PHOSAIR(3),PHOSFTI(4),
     +                           PHOSextra(9), PHOSangle(MAXCRAD),
     +                           PHOS_Ndiv_magic
*KEND.
C
      IF (PHOSsize(3).GT.MAXCRAD) THEN
         STOP 'PHOS_INIT Increase MAXCRAD, too many cradles!'
      ENDIF

*AZ { SHAKER initialization
      IF( IKINE.EQ.700 ) THEN
         JWEI        = 0
         NDNDY       = NINT(PKINE(4))
         YLIM        = PKINE(5)
         PTLIM       = PKINE(6)
         JWEAK       = 0
         JPI0        = 1
         JETA        = 1
         JPIC        = NINT(PKINE(7))
         JPRO        = NINT(PKINE(7))
         JKAC        = NINT(PKINE(7))
         JKA0        = NINT(PKINE(7))
         JRHO        = NINT(PKINE(7))
         JOME        = NINT(PKINE(7))
         JPHI        = NINT(PKINE(7))
         JPSI        = NINT(PKINE(7))
         JDRY        = NINT(PKINE(7))
         NEVTOT      = 999999999

         MSTU(11)    = 6        ! Shaker output to screen (Fortran channel 6).
         CALL SHINIT            ! Shaker initialization.

         print *,'************************************************'
         print *,'Print some SHAKER parameters.'
         print *,'NDNDY=',NDNDY
         print *,'YLIM=',YLIM
         print *,'PTLIM=',PTLIM
         print *,'JPIC=',JPIC
         print *,'************************************************'
*AZ }

      ENDIF
*
      END
*CMZ :          15/02/99  14.40.30  by  Federico Carminati
*CMZ :  2.03/01 28/07/98  16.12.22  by  Federico Carminati
*-- Author :    Federico Carminati   17/07/98
      SUBROUTINE PHOS_KINE(NT)
*KEEP,GCKINE.
      COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
     +      ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
C
      INTEGER       IKINE,ITRA,ISTAK,IVERT,IPART,ITRTYP,NAPART,IPAOLD
      REAL          PKINE,AMASS,CHARGE,TLIFE,VERT,PVERT
C
*KEEP,SHGENE.
      COMMON /SHGENE/ IEVT,NPI0,NETA,NPIC,NPRO,NKAC,NKA0,NRHO,NOME,
     +                  NPHI,NPSI,NDRY
*KEEP,BLUJETS.
      COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
      SAVE /LUJETS/

*KEEP,SCPHOS.
        INTEGER MAXCRAD
        PARAMETER (MAXCRAD=100)
        INTEGER PHOSsize,PHOS_Ndiv_magic
        REAL    PHOSflags,PHOScell,PHOSradius,PHOSCPV,
     +          PHOScradlesA,PHOSTXW,PHOSAIR,PHOSFTI,
     +          PHOSextra, PHOSangle
        COMMON /PHOS_PARS/ PHOSflags(9),
     +                           PHOScell(9),PHOSradius,PHOSCPV(9),
     +                           PHOSsize(3), PHOScradlesA,
     +                           PHOSTXW(3),PHOSAIR(3),PHOSFTI(4),
     +                           PHOSextra(9), PHOSangle(MAXCRAD),
     +                           PHOS_Ndiv_magic
*KEND.
*
      DIMENSION V_TMP(3),P_TMP(3)
*
      IF(IKINE.EQ.700) THEN
* Shaker genrator          SHOULD BE CHECKED!!!!
         IEVT = IEVT + 1        ! Increament SHAKER event number.
         CALL SHEVNT


***********************************
* Begin:   create list of SHAKER particles (if required)
* ------
* PHOSflags:    YES: X<>0   NO: X=0
* PHOSflags(1) : -----X  Create branch for TObjArray of AliPHOSCradle
*                ----X-  Create file (ftn03 on HP-UX) with list of SHAKER particles (7Mb/event)
         tmp = PHOSflags(1)/(10**2)
         i   = tmp
         i   = (tmp-i)*10

         IF( i.NE.0. ) CALL SHLIST   ! List of SHAKER particles. 7 Mbytes/event

* End of creation
************************************

         DO I=1,N
                                !? IF( K_LUJETS(I,5).EQ.0 )      MPRIMA=MPRIMA+1
            IPART = IPART_FROM_LUJET_TO_GEANT(K(I,2))

            IF( K(I,5).EQ.0 ) THEN
              IFLAG_DONE = 1
            ELSE
              IFLAG_DONE = 0
            ENDIF
            DO JJ=1,3
               V_TMP(JJ)=V(I,JJ)
               P_TMP(JJ)=P(I,JJ)
            ENDDO
            CALL RXSTRAK(IFLAG_DONE,K(I,3),IPART,P_TMP
     $           ,V_TMP,V(I,4),'Primary',NT)
            IF( I.NE.NT ) THEN
               STOP 'GUKINE: Bad thing...'
            ENDIF

            CALL RXKEEP(I)
         ENDDO

      ENDIF
      GOTO 999
*
  999 END
      INTEGER FUNCTION IPART_FROM_LUJET_TO_GEANT(N)
        ! Return GEANT particle number from LUJET particle number.
        ! This code is from file shake005.f :  SUBROUTINE SHTOGL

        IMPLICIT NONE
        INTEGER N

	IF      (N.EQ.0) THEN
          IPART_FROM_LUJET_TO_GEANT = 0
	ELSE IF (N.EQ.22) THEN
	  IPART_FROM_LUJET_TO_GEANT = 1         ! gamma
	ELSE IF (N.EQ.-11) THEN
	  IPART_FROM_LUJET_TO_GEANT = 2
	ELSE IF (N.EQ.11) THEN
	  IPART_FROM_LUJET_TO_GEANT = 3
	ELSE IF (ABS(N).EQ.12) THEN
          IPART_FROM_LUJET_TO_GEANT = 4
	ELSE IF (ABS(N).EQ.14) THEN
	  IPART_FROM_LUJET_TO_GEANT = 4
	ELSE IF (ABS(N).EQ.16) THEN
	  IPART_FROM_LUJET_TO_GEANT = 4
	ELSE IF (N.EQ.-13) THEN
	  IPART_FROM_LUJET_TO_GEANT = 5
	ELSE IF (N.EQ.13) THEN
	  IPART_FROM_LUJET_TO_GEANT = 6
	ELSE IF (N.EQ.111) THEN
	  IPART_FROM_LUJET_TO_GEANT = 7
	ELSE IF (N.EQ.211) THEN
	  IPART_FROM_LUJET_TO_GEANT = 8
	ELSE IF (N.EQ.-211) THEN
	  IPART_FROM_LUJET_TO_GEANT = 9
	ELSE IF (N.EQ.130) THEN
	  IPART_FROM_LUJET_TO_GEANT = 10
	ELSE IF (N.EQ.321) THEN
	  IPART_FROM_LUJET_TO_GEANT = 11
	ELSE IF (N.EQ.-321) THEN
	  IPART_FROM_LUJET_TO_GEANT = 12
	ELSE IF (N.EQ.2112) THEN
	  IPART_FROM_LUJET_TO_GEANT = 13
	ELSE IF (N.EQ.2212) THEN
	  IPART_FROM_LUJET_TO_GEANT = 14
	ELSE IF (N.EQ.-2212) THEN
	  IPART_FROM_LUJET_TO_GEANT = 15
	ELSE IF (N.EQ.310) THEN
	  IPART_FROM_LUJET_TO_GEANT = 16
	ELSE IF (N.EQ.221) THEN
	  IPART_FROM_LUJET_TO_GEANT = 17        ! eta
	ELSE IF (N.EQ.311) THEN                 ! This is (K0) and we set it to
	  IPART_FROM_LUJET_TO_GEANT = 10        ! GEANT K0 short
	ELSE IF (N.EQ.-311) THEN                ! This is (K~0) and we set it to
	  IPART_FROM_LUJET_TO_GEANT = 10        ! GEANT K0 short
	ELSE
          WRITE(*,*) 'Unknown LUJET particle ', N
          stop
	ENDIF
      END

********************************************************************************
Commit	Line	Data
fe4da5cc	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	********************************************************************************