TEvtGen/PHOTOS/phochk.F

   1       SUBROUTINE PHOCHK(JFIRST)
   2 C.----------------------------------------------------------------------
   3 C.
   4 C.    PHOCHK:   checking branch.
   5 C.
   6 C.    Purpose:  checks whether particles in the common block /PHOEVT/
   7 C.              can be served by PHOMAK.
   8 C.              JFIRST is the position in /PH_HEPEVT/ (!) of the first
   9 C.              daughter of sub-branch under action.
  10 C.
  11 C.
  12 C.    Author(s):  Z. Was                           Created at: 22/10/92
  13 C.                                                Last Update: 16/10/93
  14 C.
  15 C.----------------------------------------------------------------------
  16 C     ********************
  17       IMPLICIT NONE
  18       INTEGER NMXPHO
  19       PARAMETER (NMXPHO=10000)
  20       INTEGER IDPHO,ISTPHO,JDAPHO,JMOPHO,NEVPHO,NPHO
  21       REAL*8 PPHO,VPHO
  22       COMMON/PHOEVT/NEVPHO,NPHO,ISTPHO(NMXPHO),IDPHO(NMXPHO),
  23      &JMOPHO(2,NMXPHO),JDAPHO(2,NMXPHO),PPHO(5,NMXPHO),VPHO(4,NMXPHO)
  24       LOGICAL CHKIF
  25       COMMON/PHOIF/CHKIF(NMXPHO)
  26       INTEGER NMXHEP
  27       PARAMETER (NMXHEP=10000)
  28       LOGICAL QEDRAD
  29       COMMON/PHOQED/QEDRAD(NMXHEP)
  30       INTEGER JFIRST
  31       LOGICAL F
  32       INTEGER IDABS,NLAST,I,IPPAR
  33       LOGICAL INTERF,ISEC,IFTOP
  34       REAL*8 FINT,FSEC
  35       COMMON /PHOKEY/ FSEC,FINT,INTERF,ISEC,IFTOP
  36       LOGICAL IFRAD
  37       INTEGER IDENT,K
  38 C these are OK .... if you do not like somebody else, add here.
  39       F(IDABS)=
  40      &     ( ((IDABS.GT.9).AND.(IDABS.LE.40)) .OR. (IDABS.GT.100) )
  41      & .AND.(IDABS.NE.21)
  42      $ .AND.(IDABS.NE.2101).AND.(IDABS.NE.3101).AND.(IDABS.NE.3201)
  43      & .AND.(IDABS.NE.1103).AND.(IDABS.NE.2103).AND.(IDABS.NE.2203)
  44      & .AND.(IDABS.NE.3103).AND.(IDABS.NE.3203).AND.(IDABS.NE.3303)
  45 C
  46       NLAST = NPHO
  47 C
  48       IPPAR=1
  49 C checking for good particles
  50       DO 10 I=IPPAR,NLAST
  51       IDABS    = ABS(IDPHO(I))
  52 C possibly call on PHZODE is a dead (to be omitted) code.
  53       CHKIF(I)= F(IDABS)       .AND.F(ABS(IDPHO(1)))
  54      &  .AND.   (IDPHO(2).EQ.0)
  55       IF(I.GT.2) CHKIF(I)=CHKIF(I).AND.QEDRAD(JFIRST+I-IPPAR-2)
  56  10   CONTINUE
  57 C--
  58 C now we go to special cases, where CHKIF(I) will be overwritten
  59 C--
  60       IF(IFTOP) THEN
  61 C special case of top pair production
  62         DO  K=JDAPHO(2,1),JDAPHO(1,1),-1
  63            IF(IDPHO(K).NE.22) THEN
  64              IDENT=K
  65              GOTO 15
  66            ENDIF
  67         ENDDO
  68  15     CONTINUE
  69         IFRAD=((IDPHO(1).EQ.21).AND.(IDPHO(2).EQ.21))
  70      &  .OR. ((ABS(IDPHO(1)).LE.6).AND.((IDPHO(2)).EQ.(-IDPHO(1))))
  71         IFRAD=IFRAD
  72      &        .AND.(ABS(IDPHO(3)).EQ.6).AND.((IDPHO(4)).EQ.(-IDPHO(3)))
  73      &        .AND.(IDENT.EQ.4)
  74         IF(IFRAD) THEN
  75            DO 20 I=IPPAR,NLAST
  76            CHKIF(I)= .TRUE.
  77            IF(I.GT.2) CHKIF(I)=CHKIF(I).AND.QEDRAD(JFIRST+I-IPPAR-2)
  78  20        CONTINUE
  79         ENDIF
  80       ENDIF
  81 C--
  82 C--
  83       IF(IFTOP) THEN
  84 C special case of top decay
  85         DO  K=JDAPHO(2,1),JDAPHO(1,1),-1
  86            IF(IDPHO(K).NE.22) THEN
  87              IDENT=K
  88              GOTO 25
  89            ENDIF
  90         ENDDO
  91  25     CONTINUE
  92         IFRAD=((ABS(IDPHO(1)).EQ.6).AND.(IDPHO(2).EQ.0))
  93         IFRAD=IFRAD
  94      &        .AND.((ABS(IDPHO(3)).EQ.24).AND.(ABS(IDPHO(4)).EQ.5)
  95      &        .OR.(ABS(IDPHO(3)).EQ.5).AND.(ABS(IDPHO(4)).EQ.24))
  96      &        .AND.(IDENT.EQ.4)
  97         IF(IFRAD) THEN
  98            DO 30 I=IPPAR,NLAST
  99            CHKIF(I)= .TRUE.
 100            IF(I.GT.2) CHKIF(I)=CHKIF(I).AND.QEDRAD(JFIRST+I-IPPAR-2)
 101  30        CONTINUE
 102         ENDIF
 103       ENDIF
 104 C--
 105 C--
 106       END