TEvtGen/PHOTOS/phtype.F

   1       SUBROUTINE PHTYPE(ID)
   2 C.----------------------------------------------------------------------
   3 C.
   4 C.    PHTYPE:   Central manadgement routine.
   5 C.
   6 C.    Purpose:   defines what kind of the
   7 C.              actions will be performed at point ID.
   8 C.
   9 C.    Input Parameters:       ID:  pointer of particle starting branch
  10 C.                                 in /PH_HEPEVT/ to be treated.
  11 C.
  12 C.    Output Parameters:  Common /PH_HEPEVT/.
  13 C.
  14 C.    Author(s):  Z. Was                          Created at:  24/05/93
  15 C.                                                Last Update: 01/10/93
  16 C.
  17 C.----------------------------------------------------------------------
  18       IMPLICIT NONE
  19       INTEGER NMXHEP
  20       PARAMETER (NMXHEP=10000)
  21       INTEGER IDHEP,ISTHEP,JDAHEP,JMOHEP,NEVHEP,NHEP
  22       REAL*8 PHEP,VHEP
  23       COMMON/PH_HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
  24      &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
  25       LOGICAL INTERF,ISEC,IFTOP
  26       REAL*8 FINT,FSEC
  27       COMMON /PHOKEY/ FSEC,FINT,INTERF,ISEC,IFTOP
  28       INTEGER ID,NHEP0
  29       LOGICAL IPAIR
  30       REAL*8 RN,PHORAN
  31       INTEGER WTDUM
  32 C--
  33       IPAIR=.TRUE.
  34 C--   Check decay multiplicity..
  35       IF (JDAHEP(1,ID).EQ.0) RETURN
  36 C      IF (JDAHEP(1,ID).EQ.JDAHEP(2,ID)) RETURN
  37 C--
  38       NHEP0=NHEP
  39 C--
  40       IF(ISEC) THEN
  41 C-- double photon emission
  42         FSEC=1.0D0
  43         RN=PHORAN(WTDUM)
  44         IF (RN.GE.0.5D0) THEN
  45           CALL PHOMAK(ID,NHEP0)
  46           CALL PHOMAK(ID,NHEP0)
  47         ENDIF
  48       ELSE
  49 C-- single photon emission
  50         FSEC=1.0D0
  51         CALL PHOMAK(ID,NHEP0)
  52       ENDIF
  53 C--
  54 C-- electron positron pair (coomented out for a while
  55 C      IF (IPAIR) CALL PHOPAR(ID,NHEP0)
  56       END