GEANT321/giface/gheini.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:14  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.37  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GHEINI
  13 C
  14 C *** INITIALIZATION OF RELEVANT GHEISHA VARIABLES ***
  15 C *** INTERFACE WITH GHEISHA8 ***
  16 C *** NVE 20-MAY-1988 CERN GENEVA ***
  17 C
  18 C CALLED BY : GPGHEI, GHEISH
  19 C ORIGIN : F.CARMINATI
  20 C
  21 #include "geant321/gcflag.inc"
  22 #include "geant321/gcunit.inc"
  23 #include "geant321/gccuts.inc"
  24 #include "geant321/gsecti.inc"
  25 #include "geant321/gcbank.inc"
  26 #include "geant321/gcking.inc"
  27 #include "geant321/mxgkgh.inc"
  28 C --- GHEISHA COMMONS ---
  29 #include "geant321/s_kginit.inc"
  30 #include "geant321/s_consts.inc"
  31 #include "geant321/s_event.inc"
  32 #include "geant321/s_prntfl.inc"
  33 #include "geant321/s_blank.inc"
  34 #include "geant321/limits.inc"
  35 C
  36 C --- "NEVENT" CHANGED TO "KEVENT" IN COMMON /CURPAR/ DUE TO CLASH ---
  37 C --- WITH VARIABLE "NEVENT" IN GEANT COMMON ---
  38 C
  39       PARAMETER (MXGKCU=MXGKGH)
  40       COMMON /CURPAR/ WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,KEVENT,SHFLAG,
  41      $                ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5),
  42      $                RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU),
  43      $                ATNO2,ZNO2
  44 C
  45       DATA CLIGHT /2.99792458E10/
  46 C
  47 C --- SET GHEISHA I/O UNITS TO THE SAME AS FOR GEANT ---
  48       INBCD=LIN
  49       NEWBCD=LOUT
  50 C --- CHECK CONSISTENCY OF PREDEFINED VALUES FOR MXGKGH AND MXGKIN.
  51       IF(MXGKGH .GT. MXGKIN) THEN
  52          PRINT 1002, MXGKGH,MXGKIN
  53  1002    FORMAT(1H0,'*** GHEINI ***    MXGKGH = ',I5,' MUST NOT BE ',
  54      $              'LARGER THAN MXGKIN = ',I5/
  55      $          1H ,'                  PROGRAM TERMINATED ABNORMALLY')
  56          STOP
  57       ENDIF
  58       IF(MXGKGH .LT. 100)  PRINT 1003, MXGKGH
  59  1003 FORMAT(1H0,'*** GHEINI ***    WARNING: MXGKGH = ',I5,' SHOULD ',
  60      $           'BE LARGER THAN 100'/
  61      $       1H ,'                  PLEASE CHECK')
  62 C
  63 C --- INITIALISE ALL GHEISHA PRINT FLAGS AS FALSE ---
  64 C --- ACTIVATION IS DONE BY "DEBUG" STEERING CARD ---
  65       NVEFLG=0
  66       DO 10 J=1,10
  67       IF (ISWIT(J) .EQ. 109) NVEFLG=1
  68  10   CONTINUE
  69       DO 11 J=1,10
  70       NPRT(J)=.FALSE.
  71       IF ((J .EQ. 9) .AND. (NVEFLG .EQ. 1)) NPRT(J)=.TRUE.
  72  11   CONTINUE
  73       LPRT=.FALSE.
  74       DO 12 I=1,MXGKPV
  75          DO 12 J=1,10
  76             PV(J,I)=0.
  77   12  CONTINUE
  78 C
  79 C --- INITIALISE KGINIT ARRAY ---
  80       DO 20 J=1,50
  81       KGINIT(J)=0
  82 20    CONTINUE
  83 C
  84 C --- INITIALIZE SOME CUT-OFF PARAMETERS WITH GEANT VALUES ---
  85       TOFCUT=1.0E+20
  86       NSIZE=MXEVEN
  87       K0FLAG=0
  88       CENG(3)=CUTHAD
  89       CENG(4)=CUTNEU
  90 C
  91 C --- INITIALIZE PI, 2*PI, PI/2 AND PARTICLE PARAMETERS ---
  92       PI=ACOS(-1.0)
  93       TWPI=2.0*PI
  94       PIBTW=PI/2.0
  95 C *** GAMMA ***
  96       RMASS(1)=0.0
  97       RCHARG(1)=0.0
  98       LNVE=LQ(JPART-1)
  99       RMASS(1)=Q(LNVE+7)
 100       RCHARG(1)=Q(LNVE+8)
 101 C *** NEUTRINO ***
 102       RMASS(2)=0.0
 103       RCHARG(2)=0.0
 104       LNVE=LQ(JPART-4)
 105       RMASS(2)=Q(LNVE+7)
 106       RCHARG(2)=Q(LNVE+8)
 107 C *** E+ ***
 108       RMASS(3)=0.000511
 109       RCHARG(3)=1.0
 110       LNVE=LQ(JPART-2)
 111       RMASS(3)=Q(LNVE+7)
 112       RCHARG(3)=Q(LNVE+8)
 113 C *** E- ***
 114       RMASS(4)=0.000511
 115       RCHARG(4)=-1.0
 116       LNVE=LQ(JPART-3)
 117       RMASS(4)=Q(LNVE+7)
 118       RCHARG(4)=Q(LNVE+8)
 119 C *** MU+ ***
 120       RMASS(5)=0.105658
 121       RCHARG(5)=1.0
 122       LNVE=LQ(JPART-5)
 123       RMASS(5)=Q(LNVE+7)
 124       RCHARG(5)=Q(LNVE+8)
 125 C *** MU- ***
 126       RMASS(6)=0.105658
 127       RCHARG(6)=-1.0
 128       LNVE=LQ(JPART-6)
 129       RMASS(6)=Q(LNVE+7)
 130       RCHARG(6)=Q(LNVE+8)
 131 C *** PI+ ***
 132       RMASS(7)=0.139569
 133       RCHARG(7)=1.0
 134       CT=780.4
 135       LNVE=LQ(JPART-8)
 136       RMASS(7)=Q(LNVE+7)
 137       RCHARG(7)=Q(LNVE+8)
 138       CT=CLIGHT*Q(LNVE+9)
 139 C *** PI0 ***
 140       RMASS(8)=0.134964
 141       RCHARG(8)=0.0
 142       LNVE=LQ(JPART-7)
 143       RMASS(8)=Q(LNVE+7)
 144       RCHARG(8)=Q(LNVE+8)
 145 C *** PI- ***
 146       RMASS(9)=0.139569
 147       RCHARG(9)=-1.0
 148       LNVE=LQ(JPART-9)
 149       RMASS(9)=Q(LNVE+7)
 150       RCHARG(9)=Q(LNVE+8)
 151 C *** K+ ***
 152       RMASS(10)=0.493667
 153       RCHARG(10)=1.0
 154       CTKCH=370.9
 155       LNVE=LQ(JPART-11)
 156       RMASS(10)=Q(LNVE+7)
 157       RCHARG(10)=Q(LNVE+8)
 158       CTKCH=CLIGHT*Q(LNVE+9)
 159 C *** K0 SHORT (==> K0) ***
 160       RMASS(11)=0.49772
 161       RCHARG(11)=0.0
 162       CTK0=2.675
 163       LNVE=LQ(JPART-16)
 164       RMASS(11)=Q(LNVE+7)
 165       RCHARG(11)=Q(LNVE+8)
 166       CTK0=CLIGHT*Q(LNVE+9)
 167 C *** K0 LONG (==> K0 BAR) ***
 168       RMASS(12)=-0.49772
 169       RCHARG(12)=0.0
 170       LNVE=LQ(JPART-10)
 171       RMASS(12)=-Q(LNVE+7)
 172       RCHARG(12)=Q(LNVE+8)
 173 C *** K- ***
 174       RMASS(13)=0.493667
 175       RCHARG(13)=-1.0
 176       LNVE=LQ(JPART-12)
 177       RMASS(13)=Q(LNVE+7)
 178       RCHARG(13)=Q(LNVE+8)
 179 C *** P ***
 180       RMASS(14)=0.938272
 181       RCHARG(14)=1.0
 182       LNVE=LQ(JPART-14)
 183       RMASS(14)=Q(LNVE+7)
 184       RCHARG(14)=Q(LNVE+8)
 185 C *** P BAR ***
 186       RMASS(15)=-0.938272
 187       RCHARG(15)=-1.0
 188       LNVE=LQ(JPART-15)
 189       RMASS(15)=-Q(LNVE+7)
 190       RCHARG(15)=Q(LNVE+8)
 191 C *** N ***
 192       RMASS(16)=0.939566
 193       RCHARG(16)=0.0
 194       LNVE=LQ(JPART-13)
 195       RMASS(16)=Q(LNVE+7)
 196       RCHARG(16)=Q(LNVE+8)
 197 C *** N BAR ***
 198       RMASS(17)=-0.939566
 199       RCHARG(17)=0.0
 200       LNVE=LQ(JPART-25)
 201       RMASS(17)=-Q(LNVE+7)
 202       RCHARG(17)=Q(LNVE+8)
 203 C *** L0 ***
 204       RMASS(18)=1.11560
 205       RCHARG(18)=0.0
 206       CTL0=7.89
 207       LNVE=LQ(JPART-18)
 208       RMASS(18)=Q(LNVE+7)
 209       RCHARG(18)=Q(LNVE+8)
 210       CTL0=CLIGHT*Q(LNVE+9)
 211 C *** L0 BAR ***
 212       RMASS(19)=-1.11560
 213       RCHARG(19)=0.0
 214       LNVE=LQ(JPART-26)
 215       RMASS(19)=-Q(LNVE+7)
 216       RCHARG(19)=Q(LNVE+8)
 217 C *** S+ ***
 218       RMASS(20)=1.18937
 219       RCHARG(20)=1.0
 220       CTSP=2.40
 221       LNVE=LQ(JPART-19)
 222       RMASS(20)=Q(LNVE+7)
 223       RCHARG(20)=Q(LNVE+8)
 224       CTSP=CLIGHT*Q(LNVE+9)
 225 C *** S0 ***
 226       RMASS(21)=1.19246
 227       RCHARG(21)=0.0
 228       LNVE=LQ(JPART-20)
 229       RMASS(21)=Q(LNVE+7)
 230       RCHARG(21)=Q(LNVE+8)
 231 C *** S- ***
 232       RMASS(22)=1.19734
 233       RCHARG(22)=-1.0
 234       CTSM=4.44
 235       LNVE=LQ(JPART-21)
 236       RMASS(22)=Q(LNVE+7)
 237       RCHARG(22)=Q(LNVE+8)
 238       CTSM=CLIGHT*Q(LNVE+9)
 239 C *** S+ BAR ***
 240       RMASS(23)=-1.18937
 241       RCHARG(23)=-1.0
 242       LNVE=LQ(JPART-27)
 243       RMASS(23)=-Q(LNVE+7)
 244       RCHARG(23)=Q(LNVE+8)
 245 C *** S0 BAR ***
 246       RMASS(24)=-1.19246
 247       RCHARG(24)=0.0
 248       LNVE=LQ(JPART-28)
 249       RMASS(24)=-Q(LNVE+7)
 250       RCHARG(24)=Q(LNVE+8)
 251 C *** S- BAR ***
 252       RMASS(25)=-1.19734
 253       RCHARG(25)=1.0
 254       LNVE=LQ(JPART-29)
 255       RMASS(25)=-Q(LNVE+7)
 256       RCHARG(25)=Q(LNVE+8)
 257 C *** XI0 ***
 258       RMASS(26)=1.31490
 259       RCHARG(26)=0.0
 260       CTX0=8.69
 261       LNVE=LQ(JPART-22)
 262       RMASS(26)=Q(LNVE+7)
 263       RCHARG(26)=Q(LNVE+8)
 264       CTX0=CLIGHT*Q(LNVE+9)
 265 C *** XI- ***
 266       RMASS(27)=1.32132
 267       RCHARG(27)=-1.0
 268       CTXM=4.92
 269       LNVE=LQ(JPART-23)
 270       RMASS(27)=Q(LNVE+7)
 271       RCHARG(27)=Q(LNVE+8)
 272       CTXM=CLIGHT*Q(LNVE+9)
 273 C *** XI0 BAR ***
 274       RMASS(28)=-1.31490
 275       RCHARG(28)=0.0
 276       LNVE=LQ(JPART-30)
 277       RMASS(28)=-Q(LNVE+7)
 278       RCHARG(28)=Q(LNVE+8)
 279 C *** XI- BAR ***
 280       RMASS(29)=-1.32132
 281       RCHARG(29)=1.0
 282       LNVE=LQ(JPART-31)
 283       RMASS(29)=-Q(LNVE+7)
 284       RCHARG(29)=Q(LNVE+8)
 285 C *** DEUTERON ***
 286       RMASS(30)=1.875613
 287       RCHARG(30)=1.0
 288       LNVE=LQ(JPART-45)
 289       RMASS(30)=Q(LNVE+7)
 290       RCHARG(30)=Q(LNVE+8)
 291 C *** TRITON ***
 292       RMASS(31)=2.8144798
 293       RCHARG(31)=1.0
 294       LNVE=LQ(JPART-46)
 295       RMASS(31)=Q(LNVE+7)
 296       RCHARG(31)=Q(LNVE+8)
 297 C *** ALPHA ***
 298       RMASS(32)=3.727417
 299       RCHARG(32)=2.0
 300       LNVE=LQ(JPART-47)
 301       RMASS(32)=Q(LNVE+7)
 302       RCHARG(32)=Q(LNVE+8)
 303 C *** OMEGA- ***
 304       RMASS(33)=1.67245
 305       RCHARG(33)=-1.0
 306       LNVE=LQ(JPART-24)
 307       RMASS(33)=Q(LNVE+7)
 308       RCHARG(33)=Q(LNVE+8)
 309 C *** OMEGA- BAR ***
 310       RMASS(34)=-1.67245
 311       RCHARG(34)=1.0
 312       LNVE=LQ(JPART-32)
 313       RMASS(34)=-Q(LNVE+7)
 314       RCHARG(34)=Q(LNVE+8)
 315 C *** NEW PARTICLE (GEANTINO) ***
 316       RMASS(35)=0.0
 317       RCHARG(35)=0.0
 318 C
 319       IF (NPRT(9))
 320      $ PRINT 1000,(I,RMASS(I),RCHARG(I),I=1,33),
 321      $            CT,CTKCH,CTK0,CTL0,CTSP,CTSM,CTX0,CTXM
 322  1000 FORMAT(' *GHEINI* === GHEISHA PARTICLE PROPERTIES ==='/
 323      $ '0INDEX',5X,'MASS (GEV)',5X,'CHARGE'/1H /
 324      $ 33(1H ,1X,I3,5X,F11.6,6X,F5.2/),
 325      $ '0PI +-  CT = ',G12.5,' K  +-  CT = ',G12.5/
 326      $ ' K0     CT = ',G12.5,' L0     CT = ',G12.5/
 327      $ ' S+     CT = ',G12.5,' S-     CT = ',G12.5/
 328      $ ' X0     CT = ',G12.5,' X-     CT = ',G12.5)
 329 C
 330       MP=RMASS(14)
 331       MPI=RMASS(7)
 332       MMU=RMASS(5)
 333       MEL=RMASS(3)
 334       MKCH=RMASS(10)
 335       MK0=RMASS(11)
 336       SMP=MP**2
 337       SMPI=MPI**2
 338       SMU=MMU**2
 339       ML0=RMASS(18)
 340       MSP=RMASS(20)
 341       MS0=RMASS(21)
 342       MSM=RMASS(22)
 343       MX0=RMASS(26)
 344       MXM=RMASS(27)
 345 C
 346 C --- LOAD LIMITS FOR INTRINSIC FUNCTION ARGUMENTS ---
 347       EXPXL = - 82.0
 348       EXPXU =   82.0
 349 C
 350       IF (NPRT(9)) PRINT 1001,EXPXL,EXPXU
 351  1001 FORMAT('0*GHEINI* === INTRINSIC FUNCTION BOUNDARIES ==='/
 352      $ ' EXPXL,EXPXU = ',2(G12.5,1X))
 353 C
 354   90  IFINIT(4)=1
 355 C
 356       END