GEANT321/fluka/datar3.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:19:59  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 DATAR3.FOR
  13 *COPY DATAR3
  14 *
  15 *=== datar3 ===========================================================*
  16 *
  17       SUBROUTINE DATAR3
  18
  19 #include "geant321/dblprc.inc"
  20 #include "geant321/dimpar.inc"
  21 #include "geant321/iounit.inc"
  22 *
  23 #include "geant321/bamjcm.inc"
  24 #include "geant321/inpdat.inc"
  25       LOGICAL LSWTCH
  26       COMMON /FKVALI/ LSWTCH
  27       DIMENSION IVV(36),IP(36),IB(126),IBB(126),IA(126),IAA(126)
  28 C     DEFINE THE FIELDS FOR PARTICLE CLASSIFICATION
  29 C     IMPS=PSEUDO SCALAR MESONS (SPIN=0)
  30 C     IMVE=VECTOR MESONS (SPIN=1)
  31 C     IB08(IA08)=BARYONS (ANTIBARYONS) (SPIN=1/2)
  32 C     IB10(IA10)=BARYONS (ANTIBARYONS) (SPIN=3/2)
  33       DATA IP/
  34      *23,14,16,116,0,0,13,23,25,117,0,0,15,24,31,120,0,0,119,118,121,
  35      *122,14*0/
  36       LSWTCH = .FALSE.
  37       L=0
  38 C     PRINT 7769
  39 C7769  FORMAT (' ***********************************************'/
  40 C    1' *********************************************************'/
  41 C    1'         ETA SUPRESSED IN DATAR3 AND HKLASS   SEPT 85 J.RANFT'/
  42 C    1'     ETA (31)--->RHO0(33);  ETA*(95)--->OMEG(35)          '/
  43 C    1'*************************************************************'/
  44 C    1'*************************************************************')
  45       DO 1 I=1,6
  46       DO 2 J=1,6
  47       L=L+1
  48       IMPS(I,J)=IP(L)
  49     2 CONTINUE
  50     1 CONTINUE
  51       DATA IVV/
  52      *33,34,38,123,0,0,32,33,39,124,0,0,36,37,96,127,0,0,126,125,128,
  53      *129,14*0/
  54       L=0
  55       DO 3 I=1,6
  56       DO 4 J=1,6
  57       L=L+1
  58       IMVE(I,J)=IVV(L)
  59     4 CONTINUE
  60     3 CONTINUE
  61       DATA IB/
  62      *0,1,21,140,0,0,8,22,137,0,0,97,138,0,0,146,5*0,
  63      *1,8,22,137,0,0,0,20,142,0,0,98,139,0,0,147,5*0,
  64      *21,22,97,138,0,0,20,98,139,0,0,0,145,0,0,148,5*0,
  65      *140,137,138,146,0,0,142,139,147,0,0,145,148,50*0/
  66       L=0
  67       DO 5 I=1,6
  68       DO 6 J=1,21
  69       L=L+1
  70       IB08(I,J)=IB(L)
  71     6 CONTINUE
  72     5 CONTINUE
  73       DATA IBB/
  74      *53,54,104,161,0,0,55,105,162,0,0,107,164,0,0,167,5*0,
  75      *54,55,105,162,0,0,56,106,163,0,0,108,165,0,0,168,5*0,
  76      *104,105,107,164,0,0,106,108,165,0,0,109,166,0,0,169,5*0,
  77      *161,162,164,167,0,0,163,165,168,0,0,166,169,0,0,170,47*0/
  78       L=0
  79       DO 7 I=1,6
  80       DO 8 J=1,21
  81       L=L+1
  82       IB10(I,J)=IBB(L)
  83     8 CONTINUE
  84     7 CONTINUE
  85       DATA IA/
  86      *0,2,99,152,0,0,9,100,149,0,0,102,150,0,0,158,5*0,
  87      *2,9,100,149,0,0,0,101,154,0,0,103,151,0,0,159,5*0,
  88      *99,100,102,150,0,0,101,103,151,0,0,0,157,0,0,160,5*0,
  89      *152,149,150,158,0,0,154,151,159,0,0,157,160,50*0/
  90       L=0
  91       DO 9 I=1,6
  92       DO 10 J=1,21
  93       L=L+1
  94       IA08(I,J)=IA(L)
  95    10 CONTINUE
  96     9 CONTINUE
  97       DATA IAA/
  98      *67,68,110,171,0,0,69,111,172,0,0,113,174,0,0,177,5*0,
  99      *68,69,111,172,0,0,70,112,173,0,0,114,175,0,0,178,5*0,
 100      *110,111,113,174,0,0,112,114,175,0,0,115,176,0,0,179,5*0,
 101      *171,172,174,177,0,0,173,175,178,0,0,176,179,0,0,180,47*0/
 102       L=0
 103       DO 11 I=1,6
 104       DO 12 J=1,21
 105       L=L+1
 106       IA10(I,J)=IAA(L)
 107    12 CONTINUE
 108    11 CONTINUE
 109 C     DEFINE THE FREE PARAMETERS FOR THE MONTE-CARLO PROGRAMMES BAMJET
 110 C     PARJET HAPAQ
 111       A1=0.88D0
 112       B3=6.D0
 113       B1=8.D0
 114       B2=8.D0
 115       ISU=4
 116       BET=8.D0
 117       AS=0.25D0
 118       AME=0.93D0
 119       LT=0
 120       LE=0
 121       B8=0.33D0
 122       DIQ=0.375D0
 123 C
 124 C     BAMJCM INITIALIZATION
 125       DO 13 J = 1,KMXJCM
 126          IV (J) = 0
 127          RE (J) = 0.D+00
 128          KFR1 (J) = 0
 129          KFR2 (J) = 0
 130          RPX (J) = 0.D+00
 131          RPY (J) = 0.D+00
 132    13 CONTINUE
 133       RETURN
 134       END