This is the mail archive of the gcc-bugs@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

problem with egcs (2.91.57)


Hello,
I have a strange compiler message by asking optimisation in the compiling
of the file bellow :

g77 -c -O2 -fno-automatic -o bug_egcs2.o bug_egcs2.f -v
g77 version egcs-2.91.57 19980901 (egcs-1.1 release) (from FSF-g77 version
0.5.24-19980804)
Reading specs from
/usr/local/lib/gcc-lib/powerpc-unknown-linux-gnulibc1/egcs-2.91.57/specs
gcc version egcs-2.91.57 19980901 (egcs-1.1 release)
 /usr/local/lib/gcc-lib/powerpc-unknown-linux-gnulibc1/egcs-2.91.57/f771
bug_egcs2.f -quiet -dumpbase bug_egcs2.f -O2 -version -fversion
-fno-automatic -o /tmp/ccHLdDle.s
GNU F77 version egcs-2.91.57 19980901 (egcs-1.1 release)
(powerpc-unknown-linux-gnulibc1) compiled by GNU C version egcs-2.91.52
19980727 (gcc2 ss-980609 experimental).
GNU Fortran Front End version 0.5.24-19980804

/cern/pro/src/mclibs/cojets/code/topdcy.F: In subroutine `topdcy':
/cern/pro/src/mclibs/cojets/code/topdcy.F:589: internal error--insn does
not satisfy its constraints:
(insn 13582 13022 5040 (set (reg:DF 11 r11)
        (mem/s:DF (lo_sum:SI (reg:SI 28 r28)
                (symbol_ref:SI ("v1.3"))))) 420 {*movdf_hardfloat32} (nil)
    (nil))
../../egcs-1.1b/gcc/toplev.c:1360: Internal compiler error in function
fatal_insn

Which does not mean a lot to me.... If somebody can help me, he is
welcome.

egcs 2.91.57 running on a power macintosh 8500/180 on mklinux DR3

Cheers,

The routine is :

# 1 "/cern/pro/src/mclibs/cojets/code/topdcy.F"
*
* $Id: topdcy.F,v 1.1.1.1 1996/01/11 14:14:43 mclareni Exp $
*
* $Log: topdcy.F,v $
* Revision 1.1.1.1  1996/01/11 14:14:43  mclareni
* Cojets
*
*
# 1 "/cern/pro/src/mclibs/cojets/cojets/pilot.h" 1










# 9 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

      SUBROUTINE TOPDCY
C     *****************
C-- PICKS UP TOP PSEUDOSCALAR PARTICLES FROM PARHAD, DECAYS THEM AND ADD
C-- DECAY PRODUCTS TO PARHAD, PARQUA, /JETSET/
C-- CREATED: 88/05/08




      IMPLICIT DOUBLE PRECISION (A-H,O-Z)

# 1 "/cern/pro/src/mclibs/cojets/cojets/boflag.inc" 1
*
* $Id: boflag.inc,v 1.1.1.1 1996/01/11 14:14:46 mclareni Exp $
*
* $Log: boflag.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:46  mclareni
* Cojets
*
*


*
*
* boflag.inc
*
      COMMON/BOFLAG/CTHWRF,IBOFLA


# 21 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/bopar.inc" 1
*
* $Id: bopar.inc,v 1.1.1.1 1996/01/11 14:14:46 mclareni Exp $
*
* $Log: bopar.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:46  mclareni
* Cojets
*
*


*
*
* bopar.inc
*
      COMMON/BOPAR/IDECBO,LWIDTH,LEPRAD,DYMASS
     *,KOPTWZ,WZTHRS
      REAL DYMASS,WZTHRS


# 22 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/boson.inc" 1
*
* $Id: boson.inc,v 1.1.1.1 1996/01/11 14:14:46 mclareni Exp $
*
* $Log: boson.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:46  mclareni
* Cojets
*
*


*
*
* boson.inc
*
      COMMON/BOSON/PBOS(6),ICHDB,IQRKFW


# 23 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/ctopdc.inc" 1
*
* $Id: ctopdc.inc,v 1.1.1.1 1996/01/11 14:14:46 mclareni Exp $
*
* $Log: ctopdc.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:46  mclareni
* Cojets
*
*


*
*
* ctopdc.inc
*
      COMMON/CTOPDC/NTOP,NTOPD(3)


# 24 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/cutoff.inc" 1
*
* $Id: cutoff.inc,v 1.1.1.1 1996/01/11 14:14:46 mclareni Exp $
*
* $Log: cutoff.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:46  mclareni
* Cojets
*
*


*
*
* cutoff.inc
*
      COMMON/CUTOFF/QZSQ,QZMASS(6),QZFL(7),QZFLSQ(7),QTHRSQ(7)
     1,QZ,NFLAVT,LGLU
      REAL QZ


# 25 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/data1.inc" 1
*
* $Id: data1.inc,v 1.1.1.1 1996/01/11 14:14:46 mclareni Exp $
*
* $Log: data1.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:46  mclareni
* Cojets
*
*


*
*
* data1.inc
*
      COMMON/DATA1/MESO(36),CMIX(6,2),PMAS(352),QMAS(6),LCHARG(352)
     1,IDENTF(352),IDGL
      REAL CMIX,PMAS,QMAS


# 26 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/data2.inc" 1
*
* $Id: data2.inc,v 1.1.1.1 1996/01/11 14:14:47 mclareni Exp $
*
* $Log: data2.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:47  mclareni
* Cojets
*
*


*
*
* data2.inc
*
      PARAMETER (MAXDEC=1199)
      COMMON/DATA2/CBR(MAXDEC),WTCOR(10),KDP(MAXDEC,5)


# 27 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/decpar.inc" 1
*
* $Id: decpar.inc,v 1.1.1.1 1996/01/11 14:14:47 mclareni Exp $
*
* $Log: decpar.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:47  mclareni
* Cojets
*
*


*
*
* decpar.inc
*
      COMMON/DECPAR/BZDMIX,BZSMIX,CND1,CND2,IDB(352)
      REAL BZDMIX,BZSMIX,CND1,CND2


# 28 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/edpar.inc" 1
*
* $Id: edpar.inc,v 1.1.1.1 1996/01/11 14:14:47 mclareni Exp $
*
* $Log: edpar.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:47  mclareni
* Cojets
*
*


*
*
* edpar.inc
*
      COMMON/EDPAR/THETA,PHI


# 29 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/event.inc" 1
*
* $Id: event.inc,v 1.1.1.1 1996/01/11 14:14:47 mclareni Exp $
*
* $Log: event.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:47  mclareni
* Cojets
*
*


*
*
* event.inc
*
      PARAMETER (MXPART=2000,IPACK=10000)
      COMMON/EVENT/NEVENT,ECM,PARHAD(MXPART,7),NPART,WEIGHT
     1,IORIG(MXPART),IDENT(MXPART),IDCAY(MXPART)
      REAL ECM,PARHAD,WEIGHT
      EQUIVALENCE (NPART,NPTCL)
      COMMON/NOUNST/NOUNST
      LOGICAL NOUNST


# 30 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/forcsl.inc" 1
*
* $Id: forcsl.inc,v 1.1.1.1 1996/01/11 14:14:49 mclareni Exp $
*
* $Log: forcsl.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:49  mclareni
* Cojets
*
*


*
*
* forcsl.inc
*
      PARAMETER (MXFOSL=200)
      COMMON/FORCSC/CBRF(MXFOSL),BRXFSL,IKDP(MXFOSL),IFORSL


# 31 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/fstate.inc" 1
*
* $Id: fstate.inc,v 1.1.1.1 1996/01/11 14:14:50 mclareni Exp $
*
* $Log: fstate.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:50  mclareni
* Cojets
*
*


*
*
* fstate.inc
*
      COMMON/FSTATE/KWMODE,KYWOPT,KYWQED,KYHEAV,KYFLAV,KTPFRM
     1,KYEVOL,KYTQED,KYTQCD,NODECY,NOFRGM,KFORSL
     2,LFORSL,NFORSL,NFORCE,KFORCE(6,100),NSTOPD,KSTOPD(352)
      LOGICAL NODECY,NOFRGM


# 32 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/iflghv.inc" 1
*
* $Id: iflghv.inc,v 1.1.1.1 1996/01/11 14:14:50 mclareni Exp $
*
* $Log: iflghv.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:50  mclareni
* Cojets
*
*


*
*
* iflghv.inc
*
      COMMON/IFLGHV/IFLGHV,NHVREJ


# 33 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/intype.inc" 1
*
* $Id: intype.inc,v 1.1.1.1 1996/01/11 14:14:50 mclareni Exp $
*
* $Log: intype.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:50  mclareni
* Cojets
*
*


*
*
* intype.inc
*
      COMMON/INTYPE/INTYPE


# 34 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/isjetn.inc" 1
*
* $Id: isjetn.inc,v 1.1.1.1 1996/01/11 14:14:51 mclareni Exp $
*
* $Log: isjetn.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:51  mclareni
* Cojets
*
*


*
*
* isjetn.inc
*
      COMMON/ISJETN/JETN


# 35 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/itapes.inc" 1
*
* $Id: itapes.inc,v 1.1.1.1 1996/01/11 14:14:50 mclareni Exp $
*
* $Log: itapes.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:50  mclareni
* Cojets
*
*


*
*
* itapes.inc
*
      COMMON/ITAPES/ITDKY,ITEVT,ITCOM,ITLIS


# 36 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/jet.inc" 1
*
* $Id: jet.inc,v 1.1.1.1 1996/01/11 14:14:51 mclareni Exp $
*
* $Log: jet.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:51  mclareni
* Cojets
*
*


*
*
* jet.inc
*
      PARAMETER (MAXJTP=900)
      COMMON/JET/P(MAXJTP,5),PJTOT(5),K(MAXJTP,2),KDEC(MAXJTP,2)


# 37 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/jetnpc.inc" 1
*
* $Id: jetnpc.inc,v 1.1.1.1 1996/01/11 14:14:51 mclareni Exp $
*
* $Log: jetnpc.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:51  mclareni
* Cojets
*
*


*
*
* jetnpc.inc
*
      COMMON/JETNPC/NP,NP1,NPRIMR


# 38 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/jetset.inc" 1
*
* $Id: jetset.inc,v 1.1.1.1 1996/01/11 14:14:52 mclareni Exp $
*
* $Log: jetset.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:52  mclareni
* Cojets
*
*


*
*
* jetset.inc
*
      PARAMETER (MXJSET=400,JPACK=10000)
      COMMON/JETSET/NJSET,PJSET(5,MXJSET),JORIG(MXJSET),JTYPE(MXJSET)
     1,JDCAY(MXJSET)
      REAL PJSET


# 39 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/keybre.inc" 1
*
* $Id: keybre.inc,v 1.1.1.1 1996/01/11 14:14:52 mclareni Exp $
*
* $Log: keybre.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:52  mclareni
* Cojets
*
*


*
*
* keybre.inc
*
      COMMON/KEYBRE/KEYBRE


# 40 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/parqua.inc" 1
*
* $Id: parqua.inc,v 1.1.1.1 1996/01/11 14:14:54 mclareni Exp $
*
* $Log: parqua.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:54  mclareni
* Cojets
*
*


*
*
* parqua.inc
*
      PARAMETER (MAXQUA=200)
      COMMON/PARQUA/PARQUA(MAXQUA,7),JETQUA(MAXQUA),NQUA
      REAL PARQUA


# 41 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/qcds.inc" 1
*
* $Id: qcds.inc,v 1.1.1.1 1996/01/11 14:14:56 mclareni Exp $
*
* $Log: qcds.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:56  mclareni
* Cojets
*
*


*
*
* qcds.inc
*
      COMMON/QCDS/CF,CA,BALPH,PI,PI2,PROGL,PROFLA(2),NFLAVS,LGLUS,IVAL


# 42 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/quaor.inc" 1
*
* $Id: quaor.inc,v 1.1.1.1 1996/01/11 14:14:56 mclareni Exp $
*
* $Log: quaor.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:56  mclareni
* Cojets
*
*


*
*
* quaor.inc
*
      COMMON/QUAOR/IQUAOR


# 43 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/quaor2.inc" 1
*
* $Id: quaor2.inc,v 1.1.1.1 1996/01/11 14:14:56 mclareni Exp $
*
* $Log: quaor2.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:56  mclareni
* Cojets
*
*


*
*
* quaor2.inc
*
      COMMON/QUAOR2/IQUAO1,IQUAO2


# 44 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/radlep.inc" 1
*
* $Id: radlep.inc,v 1.1.1.1 1996/01/11 14:14:56 mclareni Exp $
*
* $Log: radlep.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:56  mclareni
* Cojets
*
*


*
*
* radlep.inc
*
      COMMON/RADLEP/IRADLP


# 45 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/stable.inc" 1
*
* $Id: stable.inc,v 1.1.1.1 1996/01/11 14:14:56 mclareni Exp $
*
* $Log: stable.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:56  mclareni
* Cojets
*
*


*
*
* stable.inc
*
      COMMON/STABLE/RDECAY(352)
      REAL RDECAY
      DIMENSION IDECAY(352)
      EQUIVALENCE (IDECAY,RDECAY)


# 46 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

# 1 "/cern/pro/src/mclibs/cojets/cojets/zwpar.inc" 1
*
* $Id: zwpar.inc,v 1.1.1.1 1996/01/11 14:14:59 mclareni Exp $
*
* $Log: zwpar.inc,v $
* Revision 1.1.1.1  1996/01/11 14:14:59  mclareni
* Cojets
*
*


*
*
* zwpar.inc
*
      COMMON/ZWPAR/GF,ALFQED,S2THW,DELTAR,COSCAB,ZGAM,WGAM,ZCHDEC
     *,WCHDEC
      REAL GF,ALFQED,S2THW,DELTAR,COSCAB,ZGAM,WGAM,ZCHDEC,WCHDEC


# 47 "/cern/pro/src/mclibs/cojets/code/topdcy.F" 2

      LOGICAL SKPRES
      DIMENSION IFRSLP(2)
      DIMENSION WMIN(6),V1(4),V2(4),SETIN(6),PBOOST(4),NPIF(3,2)
      DATA WMIN/.5,.5,2.5,6.,10.,0./
      PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A)
C
      IF(KYTQCD.NE.0.AND.KYTQCD.NE.1.AND.KYTQCD.NE.3) THEN
        WRITE(ITLIS,81) KYTQCD
81      FORMAT(/' ***',I3,' IS BAD INPUT FOR KYTQCD'
     *  ,' (ACCEPTED VALUES: 0,1,3) -- JOB IS ABORTED')
        STOP
      ENDIF
      IF(KYTQED.NE.0.AND.KYTQED.NE.1) THEN
        WRITE(ITLIS,82) KYTQED
82      FORMAT(/' ***',I3,' IS BAD INPUT FOR KYTQED'
     *  ,' (0: NO QED RADIATION; 1: MULTIPLE QED RADIATION WITH LLA)'
     *  /' ***JOB IS ABORTED')
        STOP
      ENDIF
      IBOFLA=1
      KEYBRL=KEYBRE
      IRADLL=IRADLP
      KEYBRE=KYTQCD
      IRADLP=KYTQED
C-- FORCE SL - PRELIMINARIES
      IFLGHV=0
      IFRSLP(1)=0
      IFRSLP(2)=0
      IF(LFORSL.NE.0.AND.KFORSL.EQ.6) THEN
        IFORX=0
        DO 301 L=1,NFORSL
        PTP2X=0.
        DO 300 I=1,NPART
        IF(RDECAY(INT(PARHAD(I,6))).GE.0.) GO TO 300
        IF(I.EQ.IFORX) GO TO 300
        PTP2=PARHAD(I,1)**2+PARHAD(I,2)**2
        IF(PTP2.LE.PTP2X) GO TO 300
        IFRSLP(L)=I
        PTP2X=PTP2
300     CONTINUE
        IFORX=IFRSLP(L)
301     CONTINUE
      ENDIF
C-- LOOP ON ALL PARTICLES LOOKING FOR JSPIN=0 TOP
      NTOP=0
1     NTOP=NTOP+1
      IF(NTOP.GT.NPART) GO TO 120
      KTOP=INT(PARHAD(NTOP,6))
      IF(ABS(KTOP).GE.1000) GO TO 1
      IDTOP=IDENTF(KTOP)
      IDTOPA=ABS(IDTOP)
      IF(IDTOPA.LT.100.OR.MOD(IDTOPA,100).NE.60) GO TO 1
      IF(IDB(KTOP).EQ.0) GO TO 1
      JET=ABS(IORIG(NTOP))/IPACK
C-- GENERATE DECAY CHANNEL
      TBR=CJRN(0.)
      IFORSL=0
      IF(NTOP.EQ.IFRSLP(1).OR.NTOP.EQ.IFRSLP(2)) IFORSL=1
      IF(IFORSL.EQ.1) THEN
C-- FORCE SL
        IF(CJRN(0.)*BRXFSL.GT.-MOD(RDECAY(KTOP),1.)) THEN
C-- REJECT EVENT (CORRECTION FOR DIFFERENCES IN TOTAL PARTICLE SL BR)
          IFLGHV=1
          NHVREJ=NHVREJ+1
          GO TO 120
        ENDIF
        IDC=-INT(RDECAY(KTOP))-1
      ELSE
        IDC=ABS(IDB(KTOP))-1
      ENDIF
100   IDC=IDC+1
      IF(IFORSL.EQ.1) THEN
        IF(TBR.GT.CBRF(IDC)) GO TO 100
        IDC=IKDP(IDC)
      ELSE
        IF(TBR.GT.CBR(IDC)) GO TO 100
      ENDIF
C-- RECORD TOP PRIMARY DECAY STUFF (KINEMATICS DEALT WITH LATER)
      IPI=NPART+1
      IPF=NPART+3
      DO 110 IP=IPI,IPF
      IPR=IP-NPART
      NTOPD(IPR)=IP
      KIP=KDP(IDC,IPR)
      PARHAD(IP,5)=0.
      PARHAD(IP,6)=KIP
      PARHAD(IP,7)=PARHAD(NTOP,7)
      IORIG(IP)=IPACK*JET+NTOP
      IDCAY(IP)=0
      KIPA=ABS(KIP)
      IF(KIPA.LT.1000) PARHAD(IP,5)=PMAS(KIP)
      IDENT(IP)=IDEXT(KIP)
110   CONTINUE
C-- IF TOP ID IS NEGATIVE, CHARGE CONJUGATE DECAY PRODUCTS
      IF(IDTOP.GT.0) GO TO 111
      DO 112 IP=IPI,IPF
      IDINA=ABS(PARHAD(IP,6))
      IF(IDINA.LT.1000) THEN
        IDENA=ABS(IDENT(IP))
        IF(IDENA.LE.100) THEN
          IF(LCHARG(IDINA).EQ.0) GO TO 112
        ELSEIF(IDENA.LT.1000) THEN
          IQ1=IDENA/100
          IQ2=MOD(IDENA/10,10)
          IF(IQ1.EQ.IQ2) GO TO 112
        ENDIF
        IDENT(IP)=-IDENT(IP)
        PARHAD(IP,6)=INTID(IDENT(IP))
      ELSE
        IDENT(IP)=-IDENT(IP)
        PARHAD(IP,6)=-PARHAD(IP,6)
      ENDIF
112   CONTINUE
111   CONTINUE
      IDCAY(NTOP)=IPACK*IPI+IPF
C-- DECAY PRELIMINARIES
      TMASS=PARHAD(NTOP,5)
      LTOP=MOD(IDTOP,100)/10
      IF(ABS(IDTOP).LT.1000) LTOP=-LTOP
      IF(LTOP.GT.0) PBOS(6)=3
      IF(LTOP.LT.0) PBOS(6)=4
      K1=PARHAD(NTOPD(1),6)
      IF(K1.EQ. 9.OR.K1.EQ.10) ICHDB=IDB(3)
      IF(K1.EQ.13.OR.K1.EQ.14) ICHDB=IDB(3)+1
      IF(K1.EQ.17.OR.K1.EQ.18) ICHDB=IDB(3)+2
      IF(ABS(K1).EQ.1000)      ICHDB=IDB(3)+3
      IF(ABS(K1).EQ.4000)      ICHDB=IDB(3)+4
      IQUAO1=JET
      IQUAO2=JET
      IFLABJ=MOD(INT(PARHAD(NTOPD(3),6))/1000,10)
      DO 3 J=1,3
3     PBOS(J)=0.
      DO 4 L=1,3
      DO 4 IF=1,2
4     NPIF(L,IF)=NPART+L
      NPART=IPF
C-- WORKING REF. FRAME IS VIRTUAL 'W' REST FRAME
C-- PHASE SPACE AND MATRIX ELEMENT FACTORS TREATED IN THE APPROXIMATION
C-- OF MASSLESS 'W' DECAY LEPTONS/QUARKS AND B-JET MASS GIVEN BY QCD
C-- RADIATION ONLY
C-- GENERATE 'W' MASS
      ICHR=ICHDB-(IDB(3)-1)
      WMASS=PMAS(3)
      WPHSPX=PAWT(TMASS,WMIN(ICHR),QZFL(5))
      WMATX=TMASS**4/16.
      ADRMIN=ATAN((WMIN(ICHR)**2-WMASS**2)/(WMASS*WGAM))
      ADRMAX=ATAN(((TMASS-QZFL(5))**2-WMASS**2)/(WMASS*WGAM))
11    DR=TAN((ADRMAX-ADRMIN)*CJRN(0.)+ADRMIN)
      WVRM=SQRT(DR*WMASS*WGAM+WMASS**2)
C-- GENERATE B JET VIRTUALITY FOR PHASE SPACE, MATRIX ELEMENT CALCS.
C-- (ACTUAL B JET MASS, FOR KINEMATICS, CALCULATED AFTER FRAGMENTATION)
      XQSQB=(TMASS-WVRM)**2
      CALL PSQGEN(5,XQSQB,QSQB,IGO)
      BJMASS=SQRT(QSQB)
      IF(WVRM+BJMASS.GE.TMASS) GO TO 11
C-- MODULATION BY PHASE SPACE FACTOR
      PBTCM=PAWT(TMASS,WVRM,BJMASS)
      WPHSP=PBTCM
      IF(CJRN(0.)*WPHSPX.GT.WPHSP) GO TO 11
C-- MODULATION BY MATRIX ELEMENT ('W' REST FRAME)
      PB=PBTCM*TMASS/WVRM
      PBSQ=PB**2
      EB=SQRT(BJMASS**2+PBSQ)
      ET=SQRT(TMASS**2+PBSQ)
      CTHWRF=-1.+2.*CJRN(0.)
      WMAT=WVRM**2/4.*(ET+PB*CTHWRF)*(EB-PB*CTHWRF)
      IF(CJRN(0.)*WMATX.GT.WMAT) GO TO 11
C-- HANDLE 'W' DECAY
      PBOS(5)=WVRM
      NQWI=NQUA+1
      NJWI=NJSET+1
      SKPRES=.FALSE.
      IF(ICHR.LE.3) THEN
C-- LEPTONIC DECAYS
        NP1=1
        NQWF=NQUA
        NJWF=NJSET
        IDCAY(NTOPD(1))=0
        IDCAY(NTOPD(2))=0
        IF(IRADLP.EQ.0) THEN
          CALL BLEPT
C-- ROTATION OF 'W' DECAY PRODUCTS
          THETA=ACOSX(CTHWRF)
          PHI=PI2*CJRN(0.)
          CALL EDITP(NP)
          DO 7 I=1,2
          DO 7 J=1,5
7         PARHAD(NTOPD(I),J)=P(I,J)
          SKPRES=.TRUE.
        ELSE
          CALL BRADLP
C-- ROTATION DONE IN BRADLP
          DO 9 J=1,5
9         PARHAD(NTOPD(1),J)=P(1,J)
          IF(NPRIMR.GT.2) THEN
            NPIF(2,1)=NPART+1
      NPIF(2,2)=NPART+NP-1
      IDCAY(NTOPD(2))=IPACK*(NPART+1)+(NPART+NPRIMR-1)
            DO 13 I=2,NPRIMR
            IP=NPART+I-1
            IORIG(IP)=IPACK*JET+NTOPD(2)
            IDCAY(IP)=0
            IF(KDEC(I,2).GE.KDEC(I,1))
     *      IDCAY(IP)=IPACK*(KDEC(I,1)+NPART-1)+(KDEC(I,2)+NPART-1)
            IDENT(IP)=IDENTF(K(I,2))
            DO 10 J=1,5
10          PARHAD(IP,J)=P(I,J)
            PARHAD(IP,6)=K(I,2)
13          PARHAD(IP,7)=PARHAD(NTOP,7)
          ELSE
            DO 8 J=1,5
8           PARHAD(NTOPD(2),J)=P(2,J)
            SKPRES=.TRUE.
          ENDIF
        ENDIF
C-- TAU DECAYS, COMPLETE
        IF(NP.EQ.NPRIMR) GO TO 71
        NS=1
        IF(NPRIMR.EQ.2) THEN
          NS=2
          NPIF(2,1)=NPART+1
          NPIF(2,2)=NPART+NP-NS
          IDCAY(NTOPD(2))=IPACK*(KDEC(2,1)+NPART-NS)
     *                         +(KDEC(2,2)+NPART-NS)
        ENDIF
        NPRIM1=NPRIMR+1
        DO 73 I=NPRIM1,NP
        IP=NPART+I-NS
        IF(K(I,1).EQ.-2) IORIG(IP)=IPACK*JET+NTOPD(2)
        IF(K(I,1).NE.-2) IORIG(IP)=IPACK*JET
     *  +(-K(I,1)+NPART-NS)
        IDCAY(IP)=0
        IF(KDEC(I,2).GE.KDEC(I,1))
     *  IDCAY(IP)=IPACK*(KDEC(I,1)+NPART-NS)+(KDEC(I,2)+NPART-NS)
        IDENT(IP)=IDENTF(K(I,2))
        DO 70 J=1,5
70      PARHAD(IP,J)=P(I,J)
        PARHAD(IP,6)=K(I,2)
73      PARHAD(IP,7)=PARHAD(NTOP,7)
71      IF(NPRIMR.GT.2) NPART=NPART+NP-1
        IF(NPRIMR.EQ.2) NPART=NPART+NP-2
      ELSE
C-- TWO JET DECAYS
        CALL BJETS
        NQWF=NQUA
        NJWF=NJSET
        NPIF(1,1)=NPART+1
        NPIF(1,2)=NPART+NP1
        NPIF(2,1)=NPART+NP1+1
        NPIF(2,2)=NPART+NP
C-- ROTATION OF 'W' DECAY PRODUCTS
        THETA=ACOSX(CTHWRF)
        PHI=PI2*CJRN(0.)
        CALL EDITP(NP)
        IDCAY(NTOPD(1))=IPACK*(NPART+1)+(NPART+NP1)
        IDCAY(NTOPD(2))=IPACK*(NPART+NP1+1)+(NPART+NP)
        DO 14 I=1,NP
        IP=NPART+I
        DO 14 J=1,5
14      PARHAD(IP,J)=P(I,J)
        NPART=NPART+NP
      ENDIF
C-- RESET MASSES OF TOP PRIMARY DECAY PRODUCTS - 'W' PART
      DO 16 L=1,2
      IF(NPIF(L,1).LE.NTOPD(3).OR.SKPRES) GO TO 16
      DO 15 J=1,4
      V1(J)=0.
      NPI=NPIF(L,1)
      NPF=NPIF(L,2)
      DO 15 I=NPI,NPF
15    IF(IDCAY(I).EQ.0) V1(J)=V1(J)+PARHAD(I,J)
      PARHAD(NTOPD(L),5)=SQRT(ABS(V1(4)**2-V1(1)**2-V1(2)**2-V1(3)**2))
16    CONTINUE
C-- HANDLE B JET
      V1(1)=0.
      V1(2)=0.
      V1(3)=PB
      V1(4)=EB
      IORPRQ=INT(PARQUA(INT(PARHAD(NTOP,7)),7))
      CALL INSET(V1,IFLABJ,QSQB,IORPRQ,SETIN)
      NQBI=NQUA+1
      NJBI=NJSET+1
      IQUAOR=JET
      JETN=JET
      CALL JETQCD(SETIN)
      JORIG(NJBI)=-(JPACK*JET+NTOPD(3))
      NQBF=NQUA
      NJBF=NJSET
      IFLAQB=INT(PARHAD(NTOPD(3),6))/1000
      IF(ABS(IFLAQB).LT.10) GO TO 18
      IFLAJB=IFLAQB*100
      JS=NJBI
61    JTYPE(JS)=IFLAJB
      IF(JDCAY(JS).EQ.0) GO TO 60
      NJD1=JDCAY(JS)/JPACK
      JS=NJD1-1
62    JS=JS+1
      IF(JTYPE(JS).NE.IFLABJ) GO TO 62
      GO TO 61
60    CONTINUE
      DO 17 JQ=NQBI,NQBF
      IF(INT(PARQUA(JQ,6)).NE.IFLABJ) GO TO 17
      JS=JETQUA(JQ)
      IF(ABS(JTYPE(JS)).LT.100) GO TO 17
      PARQUA(JQ,6)=IFLAQB
      GO TO 18
17    CONTINUE
18    CONTINUE
      NPIF(3,1)=NPART+1
      CALL HADRON(NQBI,NQBF,0)
      NPIF(3,2)=NPART
      IDCAY(NTOPD(3))=IPACK*NPIF(3,1)+NPIF(3,2)
C-- RESET MASSES OF TOP PRIMARY DECAY PRODUCTS - BOTTOM QUANTUM
      L=3
      DO 19 J=1,4
      V1(J)=0.
      NPI=NPIF(L,1)
      NPF=NPIF(L,2)
      DO 19 I=NPI,NPF
19    IF(IDCAY(I).EQ.0) V1(J)=V1(J)+PARHAD(I,J)
      PARHAD(NTOPD(L),5)=SQRT(ABS(V1(4)**2-V1(1)**2-V1(2)**2-V1(3)**2))
      IF(NQBF.LE.NQBI) GO TO 20
C-- ALIGN B-JET ALONG 3RD AXIS
      IF(V1(2).EQ.0..AND.V1(1).EQ.0) THEN
        PHIP=0.
      ELSE
        PHIP=ATAN2X(V1(2),V1(1))
      ENDIF
      CP=COS(PHIP)
      SP=SIN(PHIP)
      SP=-SP
      PMT2=V1(1)**2+V1(2)**2
      PMT=SQRT(PMT2)
      PM=SQRT(PMT2+V1(3)**2)
      CT=V1(3)/PM
      ST=PMT/PM
      ST=-ST
      NPI=NPIF(3,1)
      NPF=NPIF(3,2)
      DO 121 IP=NPI,NPF
      P1          =PARHAD(IP,1)*CP-PARHAD(IP,2)*SP
      PARHAD(IP,2)=PARHAD(IP,1)*SP+PARHAD(IP,2)*CP
      PARHAD(IP,1)=P1
      P3          =PARHAD(IP,3)*CT-PARHAD(IP,1)*ST
      PARHAD(IP,1)=PARHAD(IP,3)*ST+PARHAD(IP,1)*CT
      PARHAD(IP,3)=P3
121   CONTINUE
20    CONTINUE
C-- RESET 4-MOMENTA OF TOP PRIMARY DECAY PRODUCTS
      DO 31 L=1,3
      NPI=NPIF(L,1)
      NPF=NPIF(L,2)
      IF((NPI.LE.NTOPD(3).OR.SKPRES).AND.L.NE.3) GO TO 31
      NPL=NTOPD(L)
      DO 32 J=1,4
32    PARHAD(NPL,J)=0.
      DO 34 IP=NPI,NPF
      IF(IDCAY(IP).NE.0) GO TO 34
      DO 33 J=1,4
33    PARHAD(NPL,J)=PARHAD(NPL,J)+PARHAD(IP,J)
34    CONTINUE
31    CONTINUE
C-- SET FINAL KINEMATICS
      EBF=EB
      PBF=SQRT(ABS(EBF**2-PARHAD(NTOPD(3),5)**2))
      ETF=SQRT(TMASS**2+PBF**2)
C-- BOOST BACK TO TOP REST FRAME
C-- ARBITRARY PHI, COS(THETA) ROTATION IN TOP REST FRAME
C-- FINAL BOOST TO LABORATORY (TOP MOMENTUM)
      CHR= ETF/TMASS
      SHR=-PBF/TMASS
      CT=-1.+2.*CJRN(0.)
      ST=SQRT(ABS(1.-CT**2))
      PHIP=PI2*CJRN(0.)
      CP=COS(PHIP)
      SP=SIN(PHIP)
      DO 21 J=1,4
      SETIN(J)=0.
21    PBOOST(J)=PARHAD(NTOP,J)
      NEW=1
      DO 22 IP=NTOPD(1),NPART
      DO 23 J=1,4
23    V1(J)=PARHAD(IP,J)
      ER   =V1(4)*CHR+V1(3)*SHR
      V1(3)=V1(4)*SHR+V1(3)*CHR
      V1(4)=ER
      P3   =V1(3)*CT-V1(1)*ST
      V1(1)=V1(3)*ST+V1(1)*CT
      V1(3)=P3
      P1   =V1(1)*CP-V1(2)*SP
      V1(2)=V1(1)*SP+V1(2)*CP
      V1(1)=P1
      CALL CJLORN(PBOOST,V1,V2,NEW)
      NEW=0
      DO 24 J=1,4
24    PARHAD(IP,J)=V2(J)
22    CONTINUE
C
C-- REARRANGE PARTICLE STREAM CONSISTENTLY WITH IDCAY REQUIREMENTS
      DO 80 L=1,3
      IF(IDCAY(NTOPD(L)).EQ.0) GO TO 80
      NPI=NPIF(L,1)
      NPF=NPIF(L,2)
      NBASE=NPI-1
      MP=0
C-- COLLECT PRIMARY PARTICLES FROM JET FRAGMENTATION
      DO 91 IPD=NPI,NPF
      IF(IORIG(IPD).GT.0) GO TO 91
      MP=MP+1
      IF(MP.GT.MAXJTP) GO TO 500
      DO 92 J=1,5
92    P(MP,J)=PARHAD(IPD,J)
      K(MP,1)=PARHAD(IPD,6)
      K(MP,2)=PARHAD(IPD,7)
      KDEC(MP,1)=IORIG(IPD)
      KDEC(MP,2)=IDCAY(IPD)
91    CONTINUE
      IF(MP.EQ.0) GO TO 80
      MPRIM=MP
      IDCAY(NTOPD(L))=NPI*IPACK+(NBASE+MPRIM)
C-- SECONDARY PARTICLES
      DO 83 M=1,MPRIM
      IF(KDEC(M,2).EQ.0) GO TO 83
      MBASC=MP
      IP1=KDEC(M,2)/IPACK
      IP2=MOD(KDEC(M,2),IPACK)
      IPBAS=IP1-1
      NLDIFF=NBASE+MBASC-IPBAS
      NLDFPK=NLDIFF*IPACK+NLDIFF
      KDEC(M,2)=KDEC(M,2)+NLDFPK
      IG1=-KDEC(M,1)/IPACK
      IG=IG1*IPACK+(NBASE+M)
      IP=IPBAS
84    IP=IP+1
      IF(IP.GT.NPF) GO TO 83
      IF(IORIG(IP).LT.0) GO TO 83
      MP=MP+1
      IF(MP.GT.MAXJTP) GO TO 500
      DO 95 J=1,5
95    P(MP,J)=PARHAD(IP,J)
      K(MP,1)=PARHAD(IP,6)
      K(MP,2)=PARHAD(IP,7)
      KDEC(MP,1)=IORIG(IP)
      KDEC(MP,2)=IDCAY(IP)
      IF(IP.LE.IP2) THEN
        KDEC(MP,1)=IG
      ELSE
        KDEC(MP,1)=KDEC(MP,1)+NLDIFF
      ENDIF
      IF(IDCAY(IP).NE.0) KDEC(MP,2)=KDEC(MP,2)+NLDFPK
      GO TO 84
83    CONTINUE
C-- PUT BACK IN PARHAD
      DO 87 M=1,MP
      IP=NBASE+M
      DO 86 J=1,5
86    PARHAD(IP,J)=P(M,J)
      PARHAD(IP,6)=K(M,1)
      PARHAD(IP,7)=K(M,2)
      IORIG(IP)=KDEC(M,1)
      IDCAY(IP)=KDEC(M,2)
      IDENT(IP)=IDEXT(K(M,1))
87    CONTINUE
80    CONTINUE
C
C-- SET OUTPUT TO EXACT ISAJET FORMAT
      IF(INTYPE.EQ.1.AND.KTPFRM.EQ.1) THEN
        NQUA=NQWI-1
        NJSET=NJWI-1
        NPI=NPIF(1,1)
        DO 25 I=NPI,NPART
        IF(IORIG(I).LT.0) THEN
          JET=-IORIG(I)/IPACK
          JOR=MOD(-IORIG(I),IPACK)
26        JOR=JORIG(JOR)
          JOR=MOD(JOR,JPACK)
          IF(JOR.GT.0) GO TO 26
          IORIG(I)=IPACK*JET-JOR
          PARHAD(I,7)=PARHAD(-JOR,7)
        ELSE IF(IORIG(I).GT.0) THEN
          IOR=MOD(IORIG(I),IPACK)
          PARHAD(I,7)=PARHAD(IOR,7)
        ENDIF
25      CONTINUE
        GO TO 1
      ENDIF
C
C-- RESET PARQUA FOR DECAY QUANTA
      DO 40 NQ=NQWI,NQBF
      DO 41 J=1,4
41    PARQUA(NQ,J)=0.
      NPI=NPIF(1,1)
      NPF=NPIF(3,2)
      DO 42 IP=NPI,NPF
      IQ=ABS(PARHAD(IP,7))
      IF(IQ.NE.NQ) GO TO 42
      IF(IDCAY(IP).NE.0) GO TO 42
      DO 43 J=1,4
43    PARQUA(NQ,J)=PARQUA(NQ,J)+PARHAD(IP,J)
42    CONTINUE
      PARQUA(NQ,5)=SQRT(ABS(PARQUA(NQ,4)**2-PARQUA(NQ,1)**2
     1                     -PARQUA(NQ,2)**2-PARQUA(NQ,3)**2))
C-- 1ST STEP PJSET
      JQ=JETQUA(NQ)
      DO 44 J=1,5
44    PJSET(J,JQ)=PARQUA(NQ,J)
40    CONTINUE
C-- PJSET
      DO 55 JQ=NJWI,NJBF
55    JDCAY(JQ)=-ABS(JDCAY(JQ))
51    IFLAG=0
      JQ=NJWI-1
52    JQ=JQ+1
      IF(JQ.GT.NJBF) GO TO 53
      IF(JDCAY(JQ).GE.0) GO TO 52
      JQ1=ABS(JDCAY(JQ))/JPACK
      IF(JDCAY(JQ1).LT.0) GO TO 52
      JQ2=MOD(ABS(JDCAY(JQ)),JPACK)
      IF(JDCAY(JQ2).LT.0) GO TO 52
      IFLAG=1
      JDCAY(JQ)=ABS(JDCAY(JQ))
      DO 54 J=1,4
54    PJSET(J,JQ)=PJSET(J,JQ1)+PJSET(J,JQ2)
      PJSET(5,JQ)=SQRT(ABS(PJSET(4,JQ)**2-PJSET(1,JQ)**2
     1                    -PJSET(2,JQ)**2-PJSET(3,JQ)**2))
      GO TO 52
53    IF(IFLAG.EQ.1) GO TO 51
      GO TO 1
120   KEYBRE=KEYBRL
      IRADLP=IRADLL
      RETURN
C
C-- ABNORMAL EXIT
500   CONTINUE
      WRITE(ITLIS,501) MAXJTP,NEVENT
501   FORMAT(5(/),' NO. OF PARTICLES IN P( ,5) (/JET/) EXCEEDS',I10
     1 
     2 
     4 
     5)
      CALL OVERDM
      RETURN
      END




Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]