[u/mrichter/AliRoot.git] / GEANT321 / gheisha / kmabs.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:58  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.38  by  S.Giani
*-- Author :
      SUBROUTINE KMABS(NOPT)
C
C *** CHARGED KAON ABSORPTION BY A NUCLEUS ***
C *** NVE 04-MAR-1988 CERN GENEVA ***
C
C ORIGIN : H.FESEFELDT (09-JULY-1987)
C
C PRODUCTION OF A HYPERFRAGMENT WITH SUBSEQUENT DECAY
C PANOFSKY RATIO (K- P --> LAMBDA PI0/K- P --> LAMBDA GAMMA) = 3/2
C
#include "geant321/s_defcom.inc"
      DIMENSION RNDM(4)
C
      CALL COMPO
      PV(1,1)=0.
      PV(2,1)=0.
      PV(3,1)=0.
      PV(4,1)=RMASS(13)
      PV(5,1)=RMASS(13)
      PV(6,1)=-1.
      PV(7,1)=TOF
      PV(8,1)=IPART
      PV(9,1)=0.
      PV(10,1)=USERW
      IER(84)=IER(84)+1
      IF(ATNO2.GT.1.5) GOTO 30
      CALL GRNDM(RNDM,4)
      RAN=RNDM(1)
      TOF1=-12.5*LOG(RAN)
      TOF1= 20.*TOF1
      RAN=RNDM(2)
      ISW=1
      IF(RAN.LT.0.33) ISW=2
      NOPT=ISW
      PV(1,3)=0.
      PV(2,3)=0.
      PV(3,3)=0.
      PV(4,3)=RMASS(18)
      PV(5,3)=RMASS(18)
      PV(6,3)=0.
      PV(7,3)=TOF+TOF1
      PV(8,3)=18.
      PV(9,3)=0.
      PV(10,3)=0.
      PCM=RMASS(13)+RMASS(14)-RMASS(18)
      COST=-1.+RNDM(3)*2.
      SINT=SQRT(ABS(1.-COST*COST))
      PHI=RNDM(4)*TWPI
      IF(ISW.EQ.1) GOTO 1
      PV(1,2)=PCM*COST*SIN(PHI)
      PV(2,2)=PCM*COST*COS(PHI)
      PV(3,2)=PCM*SINT
      PV(4,2)=PCM
      PV(5,2)=0.
      PV(6,2)=0.
      PV(7,2)=TOF+TOF1
      PV(8,2)=1.
      PV(9,2)=0.
      PV(10,2)=0.
      GOTO 2
    1 PCM=PCM*PCM-RMASS(8)*RMASS(8)
      IF(PCM.LE.0.) PCM=0.
      PCM=SQRT(PCM)
      PV(1,2)=PCM*COST*SIN(PHI)
      PV(2,2)=PCM*COST*COS(PHI)
      PV(3,2)=PCM*SINT
      PV(4,2)=SQRT(PCM*PCM+RMASS(8)*RMASS(8))
      PV(5,2)=RMASS(8)
      PV(6,2)=0.
      PV(7,2)=TOF+TOF1
      PV(8,2)=8.
      PV(9,2)=0.
      PV(10,2)=0.
    2 INTCT=INTCT+1.
      CALL SETCUR(2)
      NTK=NTK+1
      CALL SETTRK(3)
      IF(NPRT(3))
     *WRITE(NEWBCD,1002) XEND,YEND,ZEND,P,ISW
1002  FORMAT(1H0,'KAON ABSORBTION   POSITION',3(2X,F8.2),2X,
     * 'K MOMENTUM',2X,F8.4,2X,'INT CODE',2X,I2)
      GO TO 9999
C**
C** STAR PRODUCTION FOR PION ABSORPTION IN HEAVY ELEMENTS
C**
   30 ENP(1)=0.300
      ENP(3)=0.150
      NT=1
      TEX=ENP(1)
      BLACK=0.5*LOG(ATNO2)
      CALL POISSO(BLACK,NBL)
      IF(NPRT(3))
     *WRITE(NEWBCD,3003) NBL,TEX
      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
      IF(NBL.LE.0) NBL=1
      EKIN=TEX/NBL
      EKIN2=0.
      DO 31 I=1,NBL
      IF(NT.EQ.MXGKPV-2) GOTO 31
      CALL GRNDM(RNDM,4)
      RAN2=RNDM(1)
      EKIN1=-EKIN*LOG(RAN2)
      EKIN2=EKIN2+EKIN1
      IPA1=16
      PNRAT=1.-ZNO2/ATNO2
      IF(RNDM(2).GT.PNRAT) IPA1=14
      NT=NT+1
      COST=-1.+RNDM(3)*2.
      SINT=SQRT(ABS(1.-COST*COST))
      PHI=TWPI*RNDM(4)
      IPA(NT)=-IPA1
      PV(5,NT)=ABS(RMASS(IPA1))
      PV(6,NT)=RCHARG(IPA1)
      PV(7,NT)=2.
      PV(4,NT)=EKIN1+PV(5,NT)
      PP=SQRT(ABS(PV(4,NT)**2-PV(5,NT)**2))
      PV(1,NT)=PP*SINT*SIN(PHI)
      PV(2,NT)=PP*SINT*COS(PHI)
      PV(3,NT)=PP*COST
      IF(EKIN2.GT.TEX) GOTO 33
   31 CONTINUE
   33 TEX=ENP(3)
      BLACK=0.50*LOG(ATNO2)
      CALL POISSO(BLACK,NBL)
      IF(NT+NBL.GT.MXGKPV-2) NBL=MXGKPV-2-NT
      IF(NBL.LE.0) NBL=1
      EKIN=TEX/NBL
      EKIN2=0.
      IF(NPRT(3))
     *WRITE(NEWBCD,3004) NBL,TEX
      DO 32 I=1,NBL
      IF(NT.EQ.MXGKPV-2) GOTO 32
      CALL GRNDM(RNDM,4)
      RAN2=RNDM(1)
      EKIN1=-EKIN*LOG(RAN2)
      EKIN2=EKIN2+EKIN1
      NT=NT+1
      COST=-1.+RNDM(2)*2.
      SINT=SQRT(ABS(1.-COST*COST))
      PHI=TWPI*RNDM(3)
      RAN=RNDM(4)
      IPA(NT)=-30
      IF(RAN.GT.0.60) IPA(NT)=-31
      IF(RAN.GT.0.90) IPA(NT)=-32
      PV(5,NT)=(ABS(IPA(NT))-28)*RMASS(14)
      PV(6,NT)=1.
      IF(IPA(NT).EQ.-32) PV(6,NT)=2.
      PV(7,NT)=2.
      PV(4,NT)=PV(5,NT)+EKIN1
      PP=SQRT(ABS(PV(4,NT)**2-PV(5,NT)**2))
      PV(1,NT)=PP*SINT*SIN(PHI)
      PV(2,NT)=PP*SINT*COS(PHI)
      PV(3,NT)=PP*COST
      IF(EKIN2.GT.TEX) GOTO 40
   32 CONTINUE
C**
C** STORE ON EVENT COMMON
C**
   40 CALL GRNDM(RNDM,1)
      RAN=RNDM(1)
      TOF1=-12.5*LOG(RAN)
      TOF1=20.*TOF1
      DO 41 I=2,NT
      IF(PV(7,I).LT.0.) PV(5,I)=-PV(5,I)
      PV(7,I)=TOF+TOF1
      PV(8,I)=ABS(IPA(I))
      PV(9,I)=0.
   41 PV(10,I)=0.
      INTCT=INTCT+1.
      CALL SETCUR(2)
      NTK=NTK+1
      IF(NT.EQ.2) GO TO 9999
      DO 50 I=3,NT
      IF(NTOT.LT.NSIZE/12) GOTO 43
      GO TO 9999
   43 CALL SETTRK(I)
   50 CONTINUE
C
 3003 FORMAT(1H ,I3,' BLACK TRACK PARTICLES PRODUCED WITH TOTAL KINETIC
     * ENERGY OF ',F8.3,' GEV')
 3004 FORMAT(1H ,I5,' HEAVY FRAGMENTS WITH TOTAL ENERGY OF',F8.4,' GEV')
C
 9999 CONTINUE
      END
Commit	Line	Data
fe4da5cc	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)=PCMCOSTSIN(PHI)
	62	PV(2,2)=PCMCOSTCOS(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=PCMPCM-RMASS(8)RMASS(8)
73	IF(PCM.LE.0.) PCM=0.
74	PCM=SQRT(PCM)
75	PV(1,2)=PCMCOSTSIN(PHI)
76	PV(2,2)=PCMCOSTCOS(PHI)
77	PV(3,2)=PCM*SINT
78	PV(4,2)=SQRT(PCMPCM+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)=PPSINTSIN(PHI)
129	PV(2,NT)=PPSINTCOS(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)=PPSINTSIN(PHI)
163	PV(2,NT)=PPSINTCOS(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