GEANT321/fluka/abbrch.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:53  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.41  by  S.Giani
  11 *-- Author :
  12 *$ CREATE ABBRCH.FOR
  13 *COPY ABBRCH
  14 *
  15 *=== abbrch ===========================================================*
  16 *
  17       SUBROUTINE ABBRCH(IT,LL,LA,LT,E0,PGX,PGY,PGZ,KFR1,KFR2,RE,
  18      *KR1R,KR2R,KR1L,KR2L,RPX,RPY,RPZ,RPXR,RPYR,RPZR,RPXL,RPYL,RPZL,
  19      *RER,REL,IV,B1,B2,KFA1,KFA2,KFA3,KFA4,IOPT,IYY)
  20 #include "geant321/dblprc.inc"
  21 #include "geant321/dimpar.inc"
  22 #include "geant321/iounit.inc"
  23       DIMENSION RE(*),KFR1(*),KFR2(*),RPX(*),RPY(*),IV(*)
  24       REAL RNDM(6)
  25 C*****POSSIBILITY OF THE CUT OFF OF THE RIGHT AND LEFT JET
  26 *      CUTBAM=0.2D+00/(2.D+00+0.5D+00*LOG(E0+2.D+00))
  27       CUTBAM=0.D0
  28       I=IT
  29       J=IT-1
  30       IVA=1
  31       IF (LT.EQ.1) WRITE(LUNOUT,288)IT,LL,LA,LT,E0,PGX,PGY,PGZ,KR1R,
  32      *KR2R,KR1L,KR2L,RPZ,RPXR,RPYR,RPZR,RPXL,RPYL,RPZL,RER,REL,B1,B2,
  33      *KFA1,KFA2,KFA3,KFA4,IOPT,IYY
  34   288 FORMAT(4I5,4E12.4,4I5/11E11.3/6I5/
  35      *  ' ABBRCH ,IT,LL,LA,LT,E0,PGX,PGY,PGZ,KR1R,KR2R,
  36      *KR1L,KR2L,RPZ,RPXR,RPYR,RPZR,RPXL,RPYL'/' RPZL,RER,REL,B1,B2,
  37      *KFA1,KFA2,KFA3,KFA4,IOPT,IYY')
  38       RM=0.764D0
  39       RMK=0.891D0
  40       DM=1.863D0
  41       IF(LA.EQ.1)GOTO10
  42 C*****CHOICE OF THE CUT OFF ENERGY
  43       IF(I.GT.1)GOTO50
  44       AM0=1.D0
  45       KFAA=KFA1
  46       IF(IOPT.EQ.2) KFAA=MAX(KFA2,KFA3)
  47       IF(IOPT.EQ.5) KFAA=MAX(KFA3,KFA4)
  48       IF (KFAA.GT.6)KFAA=KFAA-6
  49       IF(KFAA.EQ.1.OR.KFAA.EQ.2) AM0=RM
  50       IF(KFAA.EQ.3) AM0=RMK
  51       IF(KFAA.EQ.4) AM0=DM
  52       GOTO60
  53    50 CONTINUE
  54       IF(KFR1(J).EQ.1.OR.KFR1(J).EQ.2)AM0=RM
  55       IF(KFR1(J).EQ.7.OR.KFR1(J).EQ.8)AM0=RM
  56       IF(KFR1(J).EQ.3.OR.KFR1(J).EQ.9)AM0=RMK
  57       IF(KFR1(J).EQ.4.OR.KFR1(J).EQ.10)AM0=DM
  58       BM0=0.D0
  59       IF(KFR2(J).EQ.3.OR.KFR2(J).EQ.9) BM0=RMK
  60       IF(KFR2(J).EQ.4.OR.KFR2(J).EQ.10)BM0=DM
  61       IF(AM0.LT.BM0)AM0=BM0
  62    60 CONTINUE
  63       CALL GRNDM(RNDM,6)
  64       X=RNDM(1)
  65       IF(I.EQ.1)RX=E0
  66       IF(I.GT.1)RX=RE(J)
  67       AM=AM0-1.D0/B1*LOG(1.D0-X)
  68       IF (RNDM(2).LT.CUTBAM)AM=AM0+0.9D0*RX*RNDM(3)
  69       X=RNDM(4)
  70       ESA=AM0-1.D0/B2*LOG(1.D0-X)
  71       IF (RNDM(5).LT.CUTBAM)ESA=AM0+0.9D0*RX*RNDM(6)
  72 *  *** Now: ***
  73       PSA=ABS(ESA-AM0)*(ESA+AM0)
  74       EAB=SQRT(3.D0*.5D0*PSA+AM**2)
  75       IF(RX.GT.EAB)GOTO30
  76       IF(IYY.EQ.1.AND.I.EQ.1.AND.IOPT.NE.5) GOTO 30
  77    10 CONTINUE
  78       LA=1
  79       IF(I.EQ.1) GO TO 40
  80       IF(LL.EQ.1)GOTO20
  81       KR1R=KFR1(J)
  82       KR2R=KFR2(J)
  83       RER=RE(J)
  84       RPXR=-PGX
  85       RPYR=-PGY
  86       RPZR=-PGZ
  87       RE(J)=E0
  88       KFR1(J)=KFA2
  89       KFR2(J)=0
  90       IV(J)=IVA+5
  91       IF(IOPT.EQ.5) KFR2(J)=KFA2
  92       IF(IOPT.EQ.5) KFR1(J)=KFA1
  93       IF(IOPT.EQ.5) IV(J)=7
  94       RPX(J)=0.D0
  95       RPY(J)=0.D0
  96       IF(IOPT.NE.4.OR.KFA1.GT.6) GO TO 1111
  97       IV(J)=7
  98       KFR1(J)=KFA2
  99       KFR2(J)=KFA3
 100  1111 CONTINUE
 101       PGX=0.D0
 102       PGY=0.D0
 103       PGZ=0.D0
 104       IF(LT.EQ.0)GOTO101
 105       WRITE(LUNOUT,2)KR1R,KR2R,RER,RPXR,RPYR,RPZR
 106     2 FORMAT(1H0,27HQR1,QR2,RER,RPXR,RPYR,RPZR=,2I3,4F8.4)
 107   101 CONTINUE
 108       GO TO 30
 109    20 CONTINUE
 110       KR1L=KFR1(J)
 111       KR2L=KFR2(J)
 112       REL=RE(J)
 113       RPXL=-PGX
 114       RPYL=-PGY
 115       RPZL=-PGZ
 116       IF(IOPT.NE.4.OR.KFA1.LT.6) GO TO 4444
 117       IV(J)=2
 118       KFR1(J)=KFA2
 119       KFR2(J)=KFA3
 120       RE(J)=E0
 121       RPX(J)=0.D0
 122       RPY(J)=0.D0
 123       PGX=0.D0
 124       PGY=0.D0
 125       PGZ=0.D0
 126  4444 CONTINUE
 127       IF(LT.EQ.0)GO TO 102
 128       WRITE(LUNOUT,3)KR1L,KR2L,REL,RPXL,RPYL,RPZL
 129     3 FORMAT(1H0,27HQL1,QL2,REL,RPXL,RPYL,RPZL=,2I3,4F8.4)
 130   102 CONTINUE
 131       GOTO30
 132    40 CONTINUE
 133       IF(LL.EQ.1)GO TO 70
 134       KR1R=KFA1
 135       KR2R=0
 136       IF(IOPT.EQ.5) KR1R=KFA3
 137       IF(IOPT.EQ.5) KR2R=KFA4
 138       RER=E0
 139       RPXR=0.D0
 140       RPYR=0.D0
 141       RPZR=0.D0
 142       PGX=0.D0
 143       PGY=0.D0
 144       PGZ=0.D0
 145       IF (IOPT.EQ.2)  KR1R=KFA1
 146       IF (IOPT.EQ.2)KR2R=KFA2
 147       IF(IOPT.NE.4.OR.KFA1.LE.6) GO TO 3333
 148  3331 CONTINUE
 149       KR1R=KFA2
 150       KR2R=KFA3
 151  3333 CONTINUE
 152       IF(LT.EQ.0)GO TO 103
 153       WRITE(LUNOUT,2)KR1R,KR2R,RER,RPXR,RPYR,RPZR
 154   103 CONTINUE
 155       GO TO 30
 156    70 CONTINUE
 157       KR1L=KFA2
 158       KR2L=0
 159       IF(IOPT.EQ.5) KR1L=KFA1
 160       IF(IOPT.EQ.5) KR2L=KFA2
 161       REL=E0
 162       RPXL=0.D0
 163       RPYL=0.D0
 164       RPZL=0.D0
 165       IF(IOPT.EQ.2) KR1L=KFA1
 166       IF(IOPT.EQ.2)KR2L=KFA2
 167       IF(IOPT.NE.4.OR.KFA1.GT.6) GO TO 2222
 168  2221 CONTINUE
 169       KR1L=KFA2
 170       KR2L=KFA3
 171  2222 CONTINUE
 172       IF(LT.EQ.0)GO TO 104
 173       WRITE(LUNOUT,3)KR1L,KR2L,REL,RPXL,RPYL,RPZL
 174   104 CONTINUE
 175       GO TO 30
 176    30 CONTINUE
 177       IF(LT.EQ.0)GO TO 100
 178       WRITE(LUNOUT,1)I,LL,LA,AM0,AM,PSA,EAB,RX
 179     1 FORMAT(1H0,26HI,LL,LA,AM0,AM,APS,EAB,RX=,3I3,5F8.4)
 180   100 CONTINUE
 181       RETURN
 182       END