GEANT321/gheisha/kmabs.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:58  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.38  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE KMABS(NOPT)
  13 C
  14 C *** CHARGED KAON ABSORPTION BY A NUCLEUS ***
  15 C *** NVE 04-MAR-1988 CERN GENEVA ***
  16 C
  17 C ORIGIN : H.FESEFELDT (09-JULY-1987)
  18 C
  19 C PRODUCTION OF A HYPERFRAGMENT WITH SUBSEQUENT DECAY
  20 C PANOFSKY RATIO (K- P --> LAMBDA PI0/K- P --> LAMBDA GAMMA) = 3/2
  21 C
  22 #include "geant321/s_defcom.inc"
  23       DIMENSION RNDM(4)
  24 C
  25       CALL COMPO
  26       PV(1,1)=0.
  27       PV(2,1)=0.
  28       PV(3,1)=0.
  29       PV(4,1)=RMASS(13)
  30       PV(5,1)=RMASS(13)
  31       PV(6,1)=-1.
  32       PV(7,1)=TOF
  33       PV(8,1)=IPART
  34       PV(9,1)=0.
  35       PV(10,1)=USERW
  36       IER(84)=IER(84)+1
  37       IF(ATNO2.GT.1.5) GOTO 30
  38       CALL GRNDM(RNDM,4)
  39       RAN=RNDM(1)
  40       TOF1=-12.5*LOG(RAN)
  41       TOF1= 20.*TOF1
  42       RAN=RNDM(2)
  43       ISW=1
  44       IF(RAN.LT.0.33) ISW=2
  45       NOPT=ISW
  46       PV(1,3)=0.
  47       PV(2,3)=0.
  48       PV(3,3)=0.
  49       PV(4,3)=RMASS(18)
  50       PV(5,3)=RMASS(18)
  51       PV(6,3)=0.
  52       PV(7,3)=TOF+TOF1
  53       PV(8,3)=18.
  54       PV(9,3)=0.
  55       PV(10,3)=0.
  56       PCM=RMASS(13)+RMASS(14)-RMASS(18)
  57       COST=-1.+RNDM(3)*2.
  58       SINT=SQRT(ABS(1.-COST*COST))
  59       PHI=RNDM(4)*TWPI
  60       IF(ISW.EQ.1) GOTO 1
  61       PV(1,2)=PCM*COST*SIN(PHI)
  62       PV(2,2)=PCM*COST*COS(PHI)
  63       PV(3,2)=PCM*SINT
  64       PV(4,2)=PCM
  65       PV(5,2)=0.
  66       PV(6,2)=0.
  67       PV(7,2)=TOF+TOF1
  68       PV(8,2)=1.
  69       PV(9,2)=0.
  70       PV(10,2)=0.
  71       GOTO 2
  72     1 PCM=PCM*PCM-RMASS(8)*RMASS(8)
  73       IF(PCM.LE.0.) PCM=0.
  74       PCM=SQRT(PCM)
  75       PV(1,2)=PCM*COST*SIN(PHI)
  76       PV(2,2)=PCM*COST*COS(PHI)
  77       PV(3,2)=PCM*SINT
  78       PV(4,2)=SQRT(PCM*PCM+RMASS(8)*RMASS(8))
  79       PV(5,2)=RMASS(8)
  80       PV(6,2)=0.
  81       PV(7,2)=TOF+TOF1
  82       PV(8,2)=8.
  83       PV(9,2)=0.
  84       PV(10,2)=0.
  85     2 INTCT=INTCT+1.
  86       CALL SETCUR(2)
  87       NTK=NTK+1
  88       CALL SETTRK(3)
  89       IF(NPRT(3))
  90      *WRITE(NEWBCD,1002) XEND,YEND,ZEND,P,ISW
  91 1002  FORMAT(1H0,'KAON ABSORBTION   POSITION',3(2X,F8.2),2X,
  92      * 'K MOMENTUM',2X,F8.4,2X,'INT CODE',2X,I2)
  93       GO TO 9999
  94 C**
  95 C** STAR PRODUCTION FOR PION ABSORPTION IN HEAVY ELEMENTS
  96 C**
  97    30 ENP(1)=0.300
  98       ENP(3)=0.150
  99       NT=1
 100       TEX=ENP(1)
 101       BLACK=0.5*LOG(ATNO2)
 102       CALL POISSO(BLACK,NBL)
 103       IF(NPRT(3))
 104      *WRITE(NEWBCD,3003) NBL,TEX
 105       IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
 106       IF(NBL.LE.0) NBL=1
 107       EKIN=TEX/NBL
 108       EKIN2=0.
 109       DO 31 I=1,NBL
 110       IF(NT.EQ.MXGKPV-2) GOTO 31
 111       CALL GRNDM(RNDM,4)
 112       RAN2=RNDM(1)
 113       EKIN1=-EKIN*LOG(RAN2)
 114       EKIN2=EKIN2+EKIN1
 115       IPA1=16
 116       PNRAT=1.-ZNO2/ATNO2
 117       IF(RNDM(2).GT.PNRAT) IPA1=14
 118       NT=NT+1
 119       COST=-1.+RNDM(3)*2.
 120       SINT=SQRT(ABS(1.-COST*COST))
 121       PHI=TWPI*RNDM(4)
 122       IPA(NT)=-IPA1
 123       PV(5,NT)=ABS(RMASS(IPA1))
 124       PV(6,NT)=RCHARG(IPA1)
 125       PV(7,NT)=2.
 126       PV(4,NT)=EKIN1+PV(5,NT)
 127       PP=SQRT(ABS(PV(4,NT)**2-PV(5,NT)**2))
 128       PV(1,NT)=PP*SINT*SIN(PHI)
 129       PV(2,NT)=PP*SINT*COS(PHI)
 130       PV(3,NT)=PP*COST
 131       IF(EKIN2.GT.TEX) GOTO 33
 132    31 CONTINUE
 133    33 TEX=ENP(3)
 134       BLACK=0.50*LOG(ATNO2)
 135       CALL POISSO(BLACK,NBL)
 136       IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
 137       IF(NBL.LE.0) NBL=1
 138       EKIN=TEX/NBL
 139       EKIN2=0.
 140       IF(NPRT(3))
 141      *WRITE(NEWBCD,3004) NBL,TEX
 142       DO 32 I=1,NBL
 143       IF(NT.EQ.MXGKPV-2) GOTO 32
 144       CALL GRNDM(RNDM,4)
 145       RAN2=RNDM(1)
 146       EKIN1=-EKIN*LOG(RAN2)
 147       EKIN2=EKIN2+EKIN1
 148       NT=NT+1
 149       COST=-1.+RNDM(2)*2.
 150       SINT=SQRT(ABS(1.-COST*COST))
 151       PHI=TWPI*RNDM(3)
 152       RAN=RNDM(4)
 153       IPA(NT)=-30
 154       IF(RAN.GT.0.60) IPA(NT)=-31
 155       IF(RAN.GT.0.90) IPA(NT)=-32
 156       PV(5,NT)=(ABS(IPA(NT))-28)*RMASS(14)
 157       PV(6,NT)=1.
 158       IF(IPA(NT).EQ.-32) PV(6,NT)=2.
 159       PV(7,NT)=2.
 160       PV(4,NT)=PV(5,NT)+EKIN1
 161       PP=SQRT(ABS(PV(4,NT)**2-PV(5,NT)**2))
 162       PV(1,NT)=PP*SINT*SIN(PHI)
 163       PV(2,NT)=PP*SINT*COS(PHI)
 164       PV(3,NT)=PP*COST
 165       IF(EKIN2.GT.TEX) GOTO 40
 166    32 CONTINUE
 167 C**
 168 C** STORE ON EVENT COMMON
 169 C**
 170    40 CALL GRNDM(RNDM,1)
 171       RAN=RNDM(1)
 172       TOF1=-12.5*LOG(RAN)
 173       TOF1=20.*TOF1
 174       DO 41 I=2,NT
 175       IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
 176       PV(7,I)=TOF+TOF1
 177       PV(8,I)=ABS(IPA(I))
 178       PV(9,I)=0.
 179    41 PV(10,I)=0.
 180       INTCT=INTCT+1.
 181       CALL SETCUR(2)
 182       NTK=NTK+1
 183       IF(NT.EQ.2) GO TO 9999
 184       DO 50 I=3,NT
 185       IF(NTOT.LT.NSIZE/12) GOTO 43
 186       GO TO 9999
 187    43 CALL SETTRK(I)
 188    50 CONTINUE
 189 C
 190  3003 FORMAT(1H ,I3,' BLACK TRACK PARTICLES PRODUCED WITH TOTAL KINETIC
 191      * ENERGY OF ',F8.3,' GEV')
 192  3004 FORMAT(1H ,I5,' HEAVY FRAGMENTS WITH TOTAL ENERGY OF',F8.4,' GEV')
 193 C
 194  9999 CONTINUE
 195       END