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 ********************************************************************************