ISAJET/code/order.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE ORDER(ID,MODEIN,MODOUT,MEOUT)
   3 C
   4 C          Search for mode MODEIN of particle ID in standard /DKYTAB/.
   5 C          If found, return MODOUT = standard order and MEOUT=MELEM.
   6 C          Otherwise return MODOUT = MODEIN and MEOUT=0.
   7 C          If ID<0, use antiparticles instead.
   8 C
   9 #if defined(CERNLIB_IMPNONE)
  10       IMPLICIT NONE
  11 #endif
  12 C
  13 #include "isajet/itapes.inc"
  14 #include "isajet/dkytab.inc"
  15 #include "isajet/force.inc"
  16 C
  17       INTEGER ID,MODEIN(5),MODOUT(5),MODTST(5)
  18       INTEGER IFL1,IFL2,IFL3,JSPIN,INDEX,LOOK0,IUSE(5),ISAME,I,J,
  19      $NADD,NADDI,K,K1,K2,IDANTI,MEOUT
  20 C
  21 C          Find standard starting point
  22 C
  23       CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX)
  24       IF(LOOK(INDEX).GT.0) THEN
  25         LOOK0=LOOK(INDEX)
  26       ELSEIF(LOOK(INDEX).LT.0) THEN
  27         LOOK0=LOOKST(-LOOK(INDEX))
  28       ELSE
  29         ISAME=0
  30         GO TO 300
  31       ENDIF
  32 C
  33 C          Find NADD
  34 C
  35       DO 100 I=1,5
  36 100   IF(MODEIN(I).NE.0) NADD=I
  37 C
  38 C          If ID<0, compare antiparticles
  39 C
  40       IF(ID.GE.0) THEN
  41         DO 110 K=1,NADD
  42 110     MODTST(K)=MODEIN(K)
  43       ELSE
  44         DO 120 K=1,NADD
  45 120     MODTST(K)=IDANTI(MODEIN(K))
  46       ENDIF
  47 C
  48 C          Scan all modes starting at LOOK0. Check for correct NADD.
  49 C          Then check that particles match in arbitrary order.
  50 C
  51       IF(LOOK0.LE.0) GO TO 300
  52       DO 200 I=LOOK0,MXDKY
  53         DO 210 K=1,5
  54 210     IF(MODE(K,I).NE.0) NADDI=K
  55         IF(NADDI.EQ.NADD) THEN
  56           DO 220 K=1,5
  57 220       IUSE(K)=0
  58 C
  59           DO 230 K1=1,NADD
  60             DO 240 K2=1,NADD
  61               IF(MODTST(K1).EQ.MODE(K2,I).AND.IUSE(K2).EQ.0) THEN
  62                 IUSE(K2)=K1
  63                 GO TO 230
  64               ENDIF
  65 240         CONTINUE
  66             GO TO 201
  67 230       CONTINUE
  68 C
  69           ISAME=I
  70           GO TO 300
  71         ENDIF
  72 201     IF(CBR(I).GE.1.) THEN
  73           ISAME=0
  74           GO TO 300
  75         ENDIF
  76 200   CONTINUE
  77       STOP 99
  78 C
  79 C          Return matching mode or original mode.
  80 C
  81 300   IF(ISAME.EQ.0) THEN
  82         WRITE(ITLIS,3001)
  83 3001    FORMAT(' ***** WARNING: NONSTANDARD MODE')
  84         DO 310 K=1,5
  85 310     MODOUT(K)=MODEIN(K)
  86         MEOUT=0
  87       ELSEIF(ID.GT.0) THEN
  88         DO 320 K=1,5
  89 320     MODOUT(K)=MODE(K,ISAME)
  90         MEOUT=MELEM(ISAME)
  91       ELSE
  92         DO 330 K=1,5
  93 330     MODOUT(K)=IDANTI(MODE(K,ISAME))
  94         MEOUT=MELEM(ISAME)
  95       ENDIF
  96 C
  97       RETURN
  98       END