PHOS/shaker/sh2glw.f

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