TEvtGen/PHOTOS/phomak.F

   1       SUBROUTINE PHOMAK(IPPAR,NHEP0)
   2 C.----------------------------------------------------------------------
   3 C.
   4 C.    PHOMAK:   PHOtos MAKe
   5 C.
   6 C.    Purpose:  Single or double bremstrahlung radiative corrections
   7 C.              are generated in  the decay of the IPPAR-th particle in
   8 C.              the  HEP common /PH_HEPEVT/. Example of the use of
   9 C.              general tools.
  10 C.
  11 C.    Input Parameter:    IPPAR:  Pointer   to   decaying  particle  in
  12 C.                                /PH_HEPEVT/ and the common itself
  13 C.
  14 C.    Output Parameters:  Common  /PH_HEPEVT/, either  with  or  without
  15 C.                                particles added.
  16 C.
  17 C.    Author(s):  Z. Was,                         Created at:  26/05/93
  18 C.                                                Last Update:
  19 C.
  20 C.----------------------------------------------------------------------
  21       IMPLICIT NONE
  22       DOUBLE PRECISION DATA
  23       REAL*8 PHORAN
  24       INTEGER IP,IPPAR,NCHARG
  25       INTEGER WTDUM,IDUM,NHEP0
  26       INTEGER NCHARB,NEUDAU
  27       REAL*8 RN,WT,PHINT
  28       LOGICAL BOOST
  29       INTEGER NMXHEP
  30       PARAMETER (NMXHEP=10000)
  31       INTEGER IDHEP,ISTHEP,JDAHEP,JMOHEP,NEVHEP,NHEP
  32       REAL*8 PHEP,VHEP
  33       COMMON/PH_HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
  34      &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
  35       LOGICAL INTERF,ISEC,IFTOP
  36       REAL*8 FINT,FSEC
  37       COMMON /PHOKEY/ FSEC,FINT,INTERF,ISEC,IFTOP
  38 C--
  39       IP=IPPAR
  40       IDUM=1
  41       NCHARG=0
  42 C--
  43         CALL PHOIN(IP,BOOST,NHEP0)
  44         CALL PHOCHK(JDAHEP(1,IP))
  45         WT=0.0D0
  46         CALL PHOPRE(1,WT,NEUDAU,NCHARB)
  47         IF (WT.EQ.0.0D0) RETURN
  48         RN=PHORAN(WTDUM)
  49 C PHODO is caling PHORAN, thus change of series if it is moved before if
  50         CALL PHODO(1,NCHARB,NEUDAU)
  51         IF (INTERF) WT=WT*PHINT(IDUM)/FINT
  52         DATA=WT
  53         IF (WT.GT.1.0D0) CALL PHOERR(3,'WT_INT',DATA)
  54       IF (RN.LE.WT) THEN
  55         CALL PHOOUT(IP,BOOST,NHEP0)
  56       ENDIF
  57       RETURN
  58       END