ISAJET/isatape/wgens.F

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