ISAJET/code/irmov0.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE IRMOV0
   3 C----------------------------------------------------------------------
   4 C-
   5 C-   Purpose and Methods :
   6 C-      remove 0's from PJSET
   7 C-
   8 C-   Created  15-OCT-1991   Serban D. Protopopescu
   9 C-
  10 C----------------------------------------------------------------------
  11 #if defined(CERNLIB_IMPNONE)
  12       IMPLICIT NONE
  13 #endif
  14 #include "isajet/jetset.inc"
  15 #include "isajet/jwork.inc"
  16       INTEGER NCOUNT,I,J,K
  17 C----------------------------------------------------------------------
  18 C
  19 C         remove zeroes
  20       NCOUNT=NJSET
  21       DO 160 I=3,NJSET
  22   151   IF (PJSET(4,I).EQ.0.AND.I.LT.NCOUNT) THEN
  23           DO 155 K=I+1,NCOUNT
  24             DO 154 J=1,5
  25               PJSET(J,K-1)=PJSET(J,K)
  26   154       CONTINUE
  27             JORIG(K-1)=JORIG(K)
  28             JTYPE(K-1)=JTYPE(K)
  29             JDCAY(K-1)=JDCAY(K)
  30             ZZC(K-1)=ZZC(K)
  31             JMATCH(K-1)=JMATCH(K)
  32             IF(JMATCH(K-1).GT.I) JMATCH(K-1)=JMATCH(K-1)-1
  33   155     CONTINUE
  34           NCOUNT=NCOUNT-1
  35           GOTO 151
  36         ENDIF
  37   160 CONTINUE
  38       NJSET=NCOUNT
  39 C          remove last one if 0
  40       IF(PJSET(4,NJSET).EQ.0) NJSET=NJSET-1
  41   999 RETURN
  42       END