GEANT321/fluka/hklass.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:00  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.44  by  S.Giani
  11 *-- Author :
  12 *$ CREATE HKLASS.FOR
  13 *COPY HKLASS
  14 *
  15 *=== hklass ===========================================================*
  16 *
  17       SUBROUTINE HKLASS(IT,LT,LA,LL,KFR1,KFR2,KR1R,KR2R,KR1L,KR2L,IV,
  18      *IMPS,IMVE,IB08,IA08,IB10,IA10,AS,B8,KFA1,KFA2,KFA3,KFA4,IOPT)
  19
  20 #include "geant321/dblprc.inc"
  21 #include "geant321/dimpar.inc"
  22 #include "geant321/iounit.inc"
  23 *
  24 *----------------------------------------------------------------------*
  25 *  Hklass89: slight revision by A. Ferrari                             *
  26 *----------------------------------------------------------------------*
  27 *
  28 #include "geant321/finpar2.inc"
  29 #include "geant321/part.inc"
  30       LOGICAL LSWTCH
  31       COMMON/FKVALI/LSWTCH
  32       DIMENSION KFR1(*),KFR2(*),IV(*),IMPS(6,6),IMVE(6,6),
  33      *IB08(6,21),IB10(6,21),IA08(6,21),IA10(6,21)
  34       REAL RNDM(2)
  35 C     CLASSIFICATION OF THE HADRONS ACCORDING TO THEIR FLAVOUR CONTENTS
  36 *
  37 *or      IF (LT.EQ.1)WRITE(LUNOUT,288)IT,LT,LA,LL,KR1R,KR2R,KR1L,KR2L,
  38 *or     *AS,B8,KFA1,KFA2,KFA3,KFA4,IOPT
  39 *or  288 FORMAT (8I5,2E12.4,5I5/
  40 *or     *' HKLASS IT,LT,LA,LL,KR1R,KR2R,KR1L,KR2L,AS,B8,KFA1,KFA2,KFA3,'
  41 *or     *,'KFA4,IOPT')
  42 C**RESC=PROBABILITY FOR AN U,AU/D,AD/U,AD/D,AU PAIR TO BECOME E HEAVY
  43 C**RESONANCE RO,R+,R-
  44       RESC=0.5D0
  45       IX=0
  46       CALL GRNDM(RNDM,2)
  47       X=RNDM(1)
  48       Z=RNDM(2)
  49       IF(LA.EQ.0) GO TO 100
  50       A=KR1R*KR2R*KR1L*KR2L
  51       IF(A.EQ.0) GO TO 90
  52       IX=1
  53       LI=KR1R-6
  54       LJ=KR1L
  55       I=IT
  56       GO TO 10
  57   101 IX=2
  58       LI=KR2R-6
  59       LJ=KR2L
  60       I=IT+1
  61       IT=IT+1
  62       GO TO 10
  63    90 B=KR1R*KR2R
  64       C=KR1L*KR2L
  65       IF(B.GT.0.D0.OR.C.GT.0.D0) GO TO 91
  66       LJ=KR1R
  67       IF(KR1R.EQ.0)LJ=KR2R
  68       LI=KR1L-6
  69       IF(KR1L.EQ.0)LI=KR2L-6
  70       I=IT
  71       GO TO 10
  72    91 IF(B.GT.0.D0) GO TO 92
  73       LI=KR1R
  74       IF(KR1R.EQ.0)LI=KR2R
  75       KA=KR1L
  76       KB=KR2L
  77       CALL INDEX2(KA,KB,IND)
  78       LJ=IND
  79       I=IT
  80       GO TO 20
  81    92 LI=KR1L-6
  82       IF(KR1L.EQ.0)LI=KR2L-6
  83       KA=KR1R-6
  84       KB=KR2R-6
  85       CALL INDEX2(KA,KB,IND)
  86       LJ=IND
  87       I=IT
  88       GO TO 30
  89 C     LA=0
  90   100 CONTINUE
  91       I=IT
  92       J=IT-1
  93       K1I=KFR1(I)
  94       K2I=KFR2(I)
  95       K2J=0
  96       K1J=KFA1
  97       IF(I.GT.1) GO TO 5555
  98       IF(IOPT.EQ.3.AND.LL.EQ.1) K1J=KFA2
  99       IF(IOPT.EQ.2) K1J=KFA1
 100       IF(IOPT.EQ.2) K2J=KFA2
 101       IF(IOPT.EQ.4.AND.KFA1.LE.6.AND.LL.EQ.1) K1J=KFA2
 102       IF(IOPT.EQ.4.AND.KFA1.LE.6.AND.LL.EQ.1) K2J=KFA3
 103       IF(IOPT.EQ.4.AND.KFA1.GT.6.AND.LL.EQ.0) K1J=KFA2
 104       IF(IOPT.EQ.4.AND.KFA1.GT.6.AND.LL.EQ.0) K2J=KFA3
 105       IF(IOPT.EQ.5.AND.LL.EQ.0) K1J=KFA3
 106       IF(IOPT.EQ.5.AND.LL.EQ.0) K2J=KFA4
 107       IF(IOPT.EQ.5.AND.LL.EQ.1) K1J=KFA1
 108       IF(IOPT.EQ.5.AND.LL.EQ.1) K2J=KFA2
 109  5555 CONTINUE
 110       IF(I.GT.1)K1J=KFR1(J)
 111       IF(I.GT.1)K2J=KFR2(J)
 112       IVY=IV(I)
 113 *or      IF(LT.EQ.0) GO TO 606
 114 *or      WRITE(LUNOUT,601)K1I,K2I,K1J,K2J,IVY,I,LL,LA
 115 *or  601 FORMAT(1H0,8I3,27HK1I,K2I,K1J,K2J,IVY,I,LL,LA)
 116 *or  606 CONTINUE
 117       GO TO(1,4,5,2,3,1,4,5,2,3),IVY
 118     1 LI=K1I
 119       LJ=K1J
 120       IF(LL.EQ.1)LI=K1J-6
 121       IF(LL.EQ.1)LJ=K1I-6
 122       GO TO 10
 123     2 LI=K1J-6
 124       LJ=K1I-6
 125       IF(LL.EQ.1) LI=K1I
 126       IF(LL.EQ.1)LJ=K1J
 127       GO TO 10
 128     3 LI=K2J-6
 129       LJ=K2I-6
 130       IF(LL.EQ.1)LI=K2I
 131       IF(LL.EQ.1)LJ=K2J
 132       GO TO 10
 133     4 LI=K1J
 134       IF(LL.EQ.1)LI=K1J-6
 135       KA=K1I
 136       KB=K2I
 137       IF(LL.EQ.0)KA=K1I-6
 138       IF(LL.EQ.0)KB=K2I-6
 139       IF(LL.EQ.1)KA=K1I
 140       IF(LL.EQ.1)KB=K2I
 141       CALL INDEX2(KA,KB,IND)
 142       LJ=IND
 143       IF(LL.EQ.1) GO TO 30
 144       GO TO 20
 145     5 LI=K1I
 146       IF(LL.EQ.1)LI=K1I-6
 147       KA=K1J
 148       KB=K2J
 149       IF(LL.EQ.0)KA=K1J-6
 150       IF(LL.EQ.0)KB=K2J-6
 151       CALL INDEX2(KA,KB,IND)
 152       LJ=IND
 153       IF(LL.EQ.1) GO TO 20
 154       GO TO 30
 155 C     MESONENAUSWAHL
 156    10 CONTINUE
 157       IF(X.LE.AS) GO TO 11
 158       INDEX=IMVE(LI,LJ)
 159       IF(INDEX.EQ.33.AND.Z.LE.0.5D0)INDEX=35
 160       IF(.NOT.LSWTCH) GO TO 40
 161       CALL GRNDM(RNDM,1)
 162       X=RNDM(1)
 163       IF(X.GE.RESC) GO TO 40
 164       IF(INDEX.EQ.33.OR.INDEX.EQ.35.OR.INDEX.EQ.96) INDEX=181
 165       IF(INDEX.EQ.32) INDEX=182
 166       IF(INDEX.EQ.34) INDEX=183
 167       GO TO 40
 168    11 INDEX=IMPS(LI,LJ)
 169       IF(INDEX.EQ.23) GO TO 15
 170       IF(INDEX.EQ.31.AND.Z.LE.0.33D0)INDEX=95
 171       IF(.NOT.LSWTCH) GO TO 40
 172       IF(INDEX.EQ.31.AND.Z.LE.0.97D0)INDEX=95
 173       CALL GRNDM(RNDM,1)
 174       X=RNDM(1)
 175       IF(X.GE.RESC) GO TO 40
 176       IF(INDEX.EQ.23.OR.INDEX.EQ.31.OR.INDEX.EQ.95) INDEX=181
 177       IF(INDEX.EQ.13) INDEX=182
 178       IF(INDEX.EQ.14) INDEX=183
 179       GO TO 40
 180 C     BARYONMULTIPLETTS
 181    20 CONTINUE
 182       B10=1.D0-B8
 183       IF(X.LE.B8)GO TO 21
 184    24 INDEX=IB10(LI,LJ)
 185       GO TO 40
 186    21 INDEX=IB08(LI,LJ)
 187       IF(INDEX.EQ.22.AND.Z.LE.0.5D0)INDEX=17
 188       IF(INDEX.EQ.137.AND.Z.LE.0.5D0)INDEX=141
 189       IF(INDEX.EQ.138.AND.Z.LE.0.5D0)INDEX=143
 190       IF(INDEX.EQ.139.AND.Z.LE.0.5D0)INDEX=144
 191       IF(INDEX.EQ.0)GO TO 24
 192       GO TO 40
 193 C     ANTIBARYONMULTIPLETTS
 194    30 CONTINUE
 195       A8=B8
 196       A10=1.D0-A8
 197       IF(X.LE.A8)GO TO 31
 198    34 INDEX=IA10(LI,LJ)
 199       GO TO 40
 200    31 INDEX=IA08(LI,LJ)
 201       IF(INDEX.EQ.100.AND.Z.LE.0.5D0)INDEX=18
 202       IF(INDEX.EQ.149.AND.Z.LE.0.5D0)INDEX=153
 203       IF(INDEX.EQ.150.AND.Z.LE.0.5D0)INDEX=155
 204       IF(INDEX.EQ.151.AND.Z.LE.0.5D0)INDEX=156
 205       IF(INDEX.EQ.0)GO TO 34
 206       GO TO 40
 207  15   CONTINUE
 208       IF(LSWTCH)THEN
 209         IF(Z.LE.0.5D0)INDEX=31
 210         IF(Z.LE.0.5D0*0.03D0)INDEX=95
 211       ELSE
 212         IF(Z.LE.0.5D0)INDEX=33
 213         IF(Z.LE.0.5D0*0.67D0)INDEX=95
 214       ENDIF
 215       GO TO 40
 216 C     UEBERLESEN DER HADRONDATEN
 217    40 CONTINUE
 218       IF(LT.EQ.0) GO TO 604
 219       WRITE(LUNOUT,602)INDEX
 220   602 FORMAT(1H0,I3,6H=INDEX)
 221   604 CONTINUE
 222       ANF(I)=ANAME(INDEX)
 223       AMF(I)=AM(INDEX)
 224       ICHF(I)=ICH(INDEX)
 225       IBARF(I)=IBAR(INDEX)
 226       NREF(I)=INDEX
 227       IF(IX.EQ.1)GO TO 101
 228       IF(IX.EQ.2)GO TO 500
 229       GO TO 500
 230   500 CONTINUE
 231       IF(LT.EQ.0) GO TO 600
 232       IZ=0
 233       IF(IX.EQ.2)I=I-1
 234   504 CONTINUE
 235       WRITE(LUNOUT,503)ANF(I),AMF(I),ICHF(I),IBARF(I),NREF(I),LL
 236   503 FORMAT((1X,A7,1X,F6.3,1X,4(I3,1X),
 237      *'MAME,MASS,Q,BQ,NR,LL'))
 238       IF(IX.EQ.0) GO TO 600
 239       IZ=IZ+1
 240       IF(IZ.EQ.2) GO TO 600
 241       I=I+1
 242       GO TO 504
 243   600 CONTINUE
 244       RETURN
 245       END