ISAJET/isatape/rgens.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE RGENS(IFLAG)
   3 C
   4 C          Inverse of WRGEN
   5 C          Read a record by a call BUFIN
   6 C          If record type is not event type return.
   7 C          If RGENS called with IFLAG=10 return without unpacking.
   8 C          Unpack ZEVEL into appropriate common blocks.
   9 C
  10 #if defined(CERNLIB_IMPNONE)
  11       IMPLICIT NONE
  12 #endif
  13 #include "isajet/itapes.inc"
  14 #include "isajet/mbgen.inc"
  15 #include "isajet/keys.inc"
  16 #include "isajet/rectp.inc"
  17 #include "isajet/idrun.inc"
  18 #include "isajet/jetpar.inc"
  19 #include "isajet/jetset.inc"
  20 #include "isajet/jetsig.inc"
  21 #include "isajet/partcl.inc"
  22 #include "isajet/pjets.inc"
  23 #include "isajet/pinits.inc"
  24 #include "isajet/primar.inc"
  25 #include "isajet/zevel.inc"
  26 #include "isajet/totals.inc"
  27 #include "isajet/wsig.inc"
  28 #include "isajet/final.inc"
  29 C
  30       INTEGER IFLAG
  31       INTEGER I,IEX,IZ5,K,IFL,ISAV,IL
  32 C
  33       IFL=IFLAG
  34       CALL BUFIN(IL,IFLAG)
  35       IF(IFLAG.NE.0) RETURN
  36       ISAV=IZEVEL(1)/100
  37       IRECTP=ISAV*100
  38       IREC=MOD(IZEVEL(1),100)
  39       IF(IRECTP.EQ.200) RETURN
  40       IF(IRECTP.EQ.300) RETURN
  41       IF(IFL.EQ.10) RETURN
  42       IL=3
  43       CALL MOVLEI(IZEVEL(IL),IDVER,4)
  44       IL=IL+4
  45       CALL MOVLEL(LZEVEL(IL),KEYS(1),MXKEYS)
  46       IL=IL+MXKEYS
  47       NJET=IZEVEL(IL)
  48       IL=IL+1
  49       CALL MOVLEV(ZEVEL(IL),P(1),59)
  50       IL=IL+59
  51       CALL MOVLEV(ZEVEL(IL),SIGF,1)
  52       IL=IL+1
  53       IF(.NOT.KEYS(4)) THEN
  54         SIGMA=ZEVEL(IL)
  55         SIGEVT=ZEVEL(IL+1)
  56         WT=ZEVEL(IL+2)
  57         IL=IL+3
  58       ENDIF
  59       NPTCL=IZEVEL(IL)
  60       IL=IL+1
  61       IF(NJET.GT.0) THEN
  62         IEX=NJET*5
  63         CALL MOVLEV(ZEVEL(IL),PJETS(1,1),IEX)
  64         IL=IL+IEX
  65         CALL MOVLEI(IZEVEL(IL),IDJETS(1),NJET)
  66         IL=IL+NJET
  67       ENDIF
  68       IF(KEYS(3).OR.KEYS(7).OR.KEYS(11)) THEN
  69         CALL MOVLEV(ZEVEL(IL),QWJET(1),6)
  70         IL=IL+6
  71         CALL MOVLEV(ZEVEL(IL),QMW,16)
  72         IL=IL+16
  73         SIGLLQ=ZEVEL(IL)
  74         IL=IL+1
  75       ENDIF
  76       IF(KEYS(6).OR.KEYS(7)) THEN
  77         NPAIR=IZEVEL(IL)
  78         IL=IL+1
  79         IF(NPAIR.NE.0) THEN
  80           CALL MOVLEV(ZEVEL(IL),PPAIR(1,1),5*NPAIR)
  81           IL=IL+5*NPAIR
  82           CALL MOVLEI(IZEVEL(IL),IDPAIR(1),NPAIR)
  83           IL=IL+NPAIR
  84           CALL MOVLEI(IZEVEL(IL),JPAIR(1),NPAIR)
  85           IL=IL+NPAIR
  86         ENDIF
  87       ENDIF
  88       NJSET=IZEVEL(IL)
  89       IL=IL+1
  90       CALL MOVLEI(IZEVEL(IL),NKINPT,5)
  91       IL=IL+5
  92       CALL MOVLEI(IZEVEL(IL),NPOM,1)
  93       IL=IL+1
  94 C
  95 C          /JETSET/ COMMON BLOCK
  96       IF(NJSET.LT.1) GOTO 12
  97       DO 50 I=1,NJSET
  98       CALL MOVLEV(ZEVEL(IL),PJSET(1,I),5)
  99       IL=IL+5
 100       JORIG(I)=IZEVEL(IL)
 101       JTYPE(I)=IZEVEL(IL+1)
 102       JDCAY(I)=IZEVEL(IL+2)
 103       IL=IL+3
 104       IF(IL.LE.MAXLEN-9) GO TO 50
 105       IF(I.EQ.NJSET.AND.NPTCL.EQ.0) GO TO 12
 106       CALL BUFIN(IL,IFLAG)
 107       IF(IFLAG.NE.0) RETURN
 108 50    CONTINUE
 109 C
 110 C          /PARTCL/ COMMON BLOCK
 111 C          NPTCL.LT.0 IMPLIES ONLY STABLE PARTICLES ON THIS FILE
 112 C          ORIGIN AND DECAY INFORMATION SUPPRESSED
 113 12    IF(NPTCL.EQ.0) GOTO 999
 114       IF(NPTCL.GT.0) GOTO 997
 115 C          ONLY STABLE PARTICLES
 116       NPTCL=-NPTCL
 117       DO 992 K=1,NPTCL
 118       CALL MOVLEV(ZEVEL(IL),PPTCL(1,K),5)
 119       IZ5=IABS(IZEVEL(IL+5))
 120       IORIG(K)=(IZ5/10000)*1000
 121       IDENT(K)=MOD(IZ5,10000)*ISIGN(1,IZEVEL(IL+5))
 122       IDCAY(K)=0
 123       IL=IL+6
 124       IF(IL.LE.MAXLEN-6) GOTO 992
 125       IF(K.EQ.NPTCL) RETURN
 126       CALL BUFIN(IL,IFLAG)
 127       IF(IFLAG.NE.0) RETURN
 128   992 CONTINUE
 129       RETURN
 130 C          ALL PARTICLES
 131 C          NOTE THAT IDCAY CAN EXCEED 2**24 LIMIT OF PAIRPAK
 132   997 CONTINUE
 133       DO 998 K=1,NPTCL
 134       CALL MOVLEV(ZEVEL(IL),PPTCL(1,K),5)
 135       IORIG(K)=IZEVEL(IL+5)
 136       IDENT(K)=IZEVEL(IL+6)
 137       IDCAY(K)=IZEVEL(IL+7)*IPACK+IZEVEL(IL+8)
 138       IL=IL+9
 139       IF(IL.LE.MAXLEN-9) GOTO 998
 140       IF(K.EQ.NPTCL) RETURN
 141       CALL BUFIN(IL,IFLAG)
 142       IF(IFLAG.NE.0) RETURN
 143   998 CONTINUE
 144   999 CONTINUE
 145       RETURN
 146       END