PHOS/shaker/shtogl.f

   1 *CMZ :          17/07/98  15.49.05  by  Federico Carminati
   2 *-- Author :
   3       SUBROUTINE SHTOGL
   4 C       =================
   5
   6 C       Output in GLHID format
   7
   8 *KEEP,SHRUNP.
   9       COMMON /SHRUNP/ VMAJ,IMIN,NRUN,NEVTOT
  10 *KEEP,SHGENE.
  11       COMMON /SHGENE/ IEVT,NPI0,NETA,NPIC,NPRO,NKAC,NKA0,NRHO,NOME,
  12      +                  NPHI,NPSI,NDRY
  13 *KEEP,LUJETS.
  14       COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
  15       SAVE /LUJETS/
  16 *KEEP,LUDAT1.
  17       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  18       SAVE /LUDAT1/
  19 *KEND.
  20
  21       CHARACTER   CODEP*16
  22
  23       FTHET = 1.E6
  24       FPHI  = 1.E6
  25       FP    = 1.E5
  26       FE    = 1.E5
  27
  28       CALL LUEDIT(1)
  29
  30       KDAT  = 0
  31       KTIM  = 0
  32       KRUN  = NRUN
  33       KEVT  = IEVT
  34       KPART = N
  35
  36       KPROJ = 0
  37       KTARG = 0
  38       KZPRO = 0
  39       KZTAR = 0
  40       KDECA = 0
  41
  42       KMPAC = 0
  43       KPREF = 0
  44       KECM  = 0
  45       KDB   = 0
  46       KDM   = 0
  47
  48       WRITE(7) KDAT,KTIM,KRUN,KEVT,KPART
  49       WRITE(7) KPROJ,KTARG,KZPRO,KZTAR,KDECA
  50       WRITE(7) KMPAC,KPREF,KECM,KDB,KDM
  51
  52
  53       DO 10 JPART=1,N
  54         IF (K(JPART,2).EQ.22) THEN
  55           IPART = 1
  56         ELSE IF (K(JPART,2).EQ.-11) THEN
  57           IPART = 2
  58         ELSE IF (K(JPART,2).EQ.11) THEN
  59           IPART = 3
  60         ELSE IF (ABS(K(JPART,2)).EQ.12) THEN
  61             IPART = 4
  62         ELSE IF (ABS(K(JPART,2)).EQ.14) THEN
  63           IPART = 4
  64         ELSE IF (ABS(K(JPART,2)).EQ.16) THEN
  65           IPART = 4
  66         ELSE IF (K(JPART,2).EQ.-13) THEN
  67           IPART = 5
  68         ELSE IF (K(JPART,2).EQ.13) THEN
  69           IPART = 6
  70         ELSE IF (K(JPART,2).EQ.111) THEN
  71           IPART = 7
  72         ELSE IF (K(JPART,2).EQ.211) THEN
  73           IPART = 8
  74         ELSE IF (K(JPART,2).EQ.-211) THEN
  75           IPART = 9
  76         ELSE IF (K(JPART,2).EQ.130) THEN
  77           IPART = 10
  78         ELSE IF (K(JPART,2).EQ.321) THEN
  79           IPART = 11
  80         ELSE IF (K(JPART,2).EQ.-321) THEN
  81           IPART = 12
  82         ELSE IF (K(JPART,2).EQ.2112) THEN
  83           IPART = 13
  84         ELSE IF (K(JPART,2).EQ.2212) THEN
  85           IPART = 14
  86         ELSE IF (K(JPART,2).EQ.-2212) THEN
  87           IPART = 15
  88         ELSE IF (K(JPART,2).EQ.310) THEN
  89           IPART = 16
  90         ELSE
  91           CALL LUNAME(KFA,CODEP)
  92           WRITE(MSTU(11),*)'ERROR:'
  93           WRITE(MSTU(11),*)CODEP,'NOT generated with JWEI=1'
  94           WRITE(MSTU(11),*)'EXECUTION STOPPED!'
  95         ENDIF
  96
  97         THETA = PLU(JPART,14)
  98         PHI   = PLU(JPART,16)
  99         PP    = PLU(JPART,8)
 100         EE    = P(JPART,4)
 101
 102         KTHET = NINT(THETA*FTHET)
 103         KPHI  = NINT(PHI*FPHI)
 104         KP    = NINT(PP*FP)
 105         KE    = NINT(EE*FE)
 106
 107         WRITE(7) IPART,KTHET,KPHI,KP,KE
 108
 109 10      CONTINUE
 110       RETURN
 111       END