PHOS/shaker/shptge.f

   1 *CMZ :          17/07/98  15.49.05  by  Federico Carminati
   2 *-- Author :
   3       SUBROUTINE SHPTGE(KF,PT,PHI,W)
   4 c       ==============================
   5
   6 c       Pt generation
   7
   8 *KEEP,LUDAT1.
   9       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  10       SAVE /LUDAT1/
  11 *KEEP,SHRAND.
  12       COMMON /SHRAND/ PISP1(100),PISP2(100),ETASP1(100),ETASP2(100),
  13      +                  PROSP(100),KAOSP(100)
  14 *KEEP,SHPHYP.
  15       COMMON /SHPHYP/ JWEI,NDNDY,YLIM,PTLIM,JWEAK,JPI0,JETA,JPIC,JPRO,
  16      +                  JKAC,JKA0,JRHO,JOME,JPHI,JPSI,JDRY
  17 *KEEP,SHGENE.
  18       COMMON /SHGENE/ IEVT,NPI0,NETA,NPIC,NPRO,NKAC,NKA0,NRHO,NOME,
  19      +                  NPHI,NPSI,NDRY
  20 *KEEP,SHNORM.
  21       COMMON /SHNORM/ PINOR,PIRAT,ETANOR,ETARAT,RHONOR,OMENOR,PHINOR,
  22      +                  PSINOR,DRYNOR
  23 *KEEP,SHPRAT.
  24       COMMON /SHPRAT/ PI0R,ETAR,RHOR,OMER,PHIR,PSIR,DRYR
  25 *KEND.
  26
  27       CHARACTER   CODEP*16
  28
  29       KFA = ABS(KF)
  30
  31       IF (JWEI.EQ.0) THEN
  32         W = 1.
  33         IF (KFA.EQ.111.OR.KFA.EQ.211) THEN
  34           IF(RLU(0).LE.PIRAT) THEN
  35             CALL FUNRAN(PISP1,PT)
  36           ELSE
  37             CALL FUNRAN(PISP2,PT)
  38           ENDIF
  39 c           PT = 10.
  40           ELSE IF (KFA.EQ.221) THEN
  41           IF(RLU(0).LE.ETARAT) THEN
  42             CALL FUNRAN(ETASP1,PT)
  43           ELSE
  44             CALL FUNRAN(ETASP2,PT)
  45           ENDIF
  46 C           PT = 2.744
  47         ELSE IF (KFA.EQ.2212) THEN
  48           CALL FUNRAN(PROSP,PT)
  49         ELSE IF (KFA.EQ.321.OR.KFA.EQ.311) THEN
  50           CALL FUNRAN(KAOSP,PT)
  51         ELSE
  52           CALL LUNAME(KFA,CODEP)
  53           WRITE(MSTU(11),*)'ERROR:'
  54           WRITE(MSTU(11),*)CODEP,'NOT generated with JWEI=0'
  55           WRITE(MSTU(11),*)'EXECUTION STOPPED!'
  56           STOP
  57         ENDIF
  58       ENDIF
  59
  60       IF (JWEI.EQ.1) THEN
  61         PT = PTLIM*RLU(0)
  62         IF (KFA.EQ.111.OR.KFA.EQ.211) THEN
  63           W = PTLIM*SHFPI(PT)*PI0R/PINOR/FLOAT(NPI0)
  64         ELSE IF (KFA.EQ.221) THEN
  65           W = PTLIM*SHFETA(PT)*ETAR/ETANOR/FLOAT(NETA)
  66         ELSE IF (KFA.EQ.113) THEN
  67             W = PTLIM*SHFRHO(PT)*RHOR/RHONOR/FLOAT(NRHO)
  68         ELSE IF (KFA.EQ.223) THEN
  69             W = PTLIM*SHFOME(PT)*OMER/OMENOR/FLOAT(NOME)
  70         ELSE IF (KFA.EQ.333) THEN
  71             W = PTLIM*SHFPHI(PT)*PHIR/PHINOR/FLOAT(NPHI)
  72         ELSE IF (KFA.EQ.443) THEN
  73             W = PTLIM*SHFPSI(PT)*PSIR/PSINOR/FLOAT(NPSI)
  74         ELSE
  75           CALL LUNAME(KFA,CODEP)
  76           WRITE(MSTU(11),*)'ERROR:'
  77           WRITE(MSTU(11),*)CODEP,'NOT generated with JWEI=1'
  78           WRITE(MSTU(11),*)'EXECUTION STOPPED!'
  79           STOP
  80         ENDIF
  81       ENDIF
  82
  83       PHI = 3.14159*2*(RLU(0)-.5)
  84
  85       RETURN
  86       END