]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1995/10/24 10:21:15 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 GHSTOP | |
13 | C | |
14 | C *** HANDLING OF STOPPING PARTICLES *** | |
15 | C *** NVE 18-MAY-1988 CERN GENEVA *** | |
16 | C | |
17 | C CALLED BY : GHEISH | |
18 | C ORIGIN : H.FESEFELDT (ROUTINE CALIM 16-SEP-1987) | |
19 | C | |
20 | #include "geant321/gcbank.inc" | |
21 | #include "geant321/gckine.inc" | |
22 | #include "geant321/gcking.inc" | |
23 | #include "geant321/gctrak.inc" | |
24 | #include "geant321/gccuts.inc" | |
25 | C --- GHEISHA COMMONS --- | |
26 | #include "geant321/s_prntfl.inc" | |
27 | C | |
28 | C --- "IPART" CHANGED TO "KPART" IN COMMON /RESULT/ DUE TO CLASH --- | |
29 | C --- WITH VARIABLE "IPART" IN GEANT COMMON --- | |
30 | C | |
31 | COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ, | |
32 | $ USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,KPART,IND, | |
33 | $ LCALO,ICEL,SINL,COSL,SINP,COSP, | |
34 | $ XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD, | |
35 | $ XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT | |
36 | REAL NCH,INTCT | |
37 | C | |
38 | IF (NPRT(2) .OR. NPRT(9)) | |
39 | $ WRITE(NEWBCD,8801) AMAS,NCH,P,EN,EK,XEND,YEND,ZEND,ISTOP | |
40 | 8801 FORMAT(' *GHSTOP* STOPPING TRACK M,CH,P,EN,EK = ',5(G12.5,1X)/ | |
41 | $ 1H ,9X,'POSITION (X,Y,Z) = ',3(G12.5,1X),' ISTOP = ',I3) | |
42 | C | |
43 | C --- IN CASE OF ENERGY DEPOSITION ALL THE EKIN WILL BE DEPOSITED --- | |
44 | EDEP=EK | |
45 | C | |
46 | C --- CALCULATE TIME TO STOP --- | |
47 | TOF1=0.0 | |
48 | IF (P .GT. 1.0E-10) TOF1=STEP*EN*0.666667/P | |
49 | C | |
50 | C --- UPDATE MOMENTUM VECTOR AND ENERGIES FOR STOPPING PARTICLE --- | |
51 | P=0.0 | |
52 | EN=ABS(AMAS) | |
53 | EK=0.0 | |
54 | GETOT=EN | |
55 | GEKIN=EK | |
56 | ISTOP=2 | |
57 | C --- NEXT 2 STMTS. COMMENTED TO AVOID DOUBLE SETTING (NVE 15-AUG-88) | |
58 | C%%% NMEC=NMEC+1 | |
59 | C%%% LMEC(NMEC)=30 | |
60 | C | |
61 | C --- UPDATE TIME OF FLIGHT AND CHECK FOR LIMIT --- | |
62 | TOF=TOF+TOF1 | |
63 | TEST1=TOF-0.5*TOF1 | |
64 | TEST2=(TOFMAX-TOFG)*2.0E10 | |
65 | IF (TEST1 .GT. TEST2) GO TO 9999 | |
66 | C | |
67 | C *** SELECT PROCESS FOR CURRENT PARTICLE *** | |
68 | C | |
69 | C | |
70 | C --- SKIP NEUTRINOS --- | |
71 | IF (IPART .EQ. 4) GO TO 9999 | |
72 | C | |
73 | C --- LOOK FOR PARTICLES WITH SPECIAL TREATMENT --- | |
74 | IF (IPART .EQ. 9) GO TO 90 | |
75 | IF (IPART .EQ. 12) GO TO 120 | |
76 | IF (IPART .EQ. 13) GO TO 130 | |
77 | IF (IPART .EQ. 15) GO TO 150 | |
78 | IF (IPART .EQ. 25) GO TO 250 | |
79 | C | |
80 | C --- ONLY DEPOSIT ALL KINETIC ENERGY FOR P AND HEAVY FRAGMENTS --- | |
81 | IF (IPART .EQ. 14) GO TO 140 | |
82 | IF (IPART.GE.45 .AND. IPART.LE.48) GO TO 140 | |
83 | C | |
84 | C --- LET ALL OTHER PARTICLES DECAY --- | |
85 | CALL GDECAY | |
86 | IF(NGKINE.GT.0) THEN | |
87 | NMEC=NMEC+1 | |
88 | LMEC(NMEC)=5 | |
89 | ISTOP=1 | |
90 | GO TO 9999 | |
91 | ELSE | |
92 | C | |
93 | C --- FOR SOME REASON PARTICLE DID NOT DECAY --- | |
94 | GOTO 140 | |
95 | ENDIF | |
96 | C | |
97 | C --- PI- ABSORBED BY NUCLEUS --- | |
98 | 90 CONTINUE | |
99 | DESTEP=DESTEP+EDEP | |
100 | CALL PIMABS(NOPT) | |
101 | NMEC=NMEC+1 | |
102 | LMEC(NMEC)=16 | |
103 | ISTOP=1 | |
104 | GO TO 9999 | |
105 | C | |
106 | C --- K- ABSORBED BY NUCLEUS --- | |
107 | 120 CONTINUE | |
108 | DESTEP=DESTEP+EDEP | |
109 | CALL KMABS(NOPT) | |
110 | NMEC=NMEC+1 | |
111 | LMEC(NMEC)=16 | |
112 | ISTOP=1 | |
113 | GO TO 9999 | |
114 | C | |
115 | C --- NEUTRON CAPTURED BY NUCLEUS --- | |
116 | 130 CONTINUE | |
117 | IF (EDEP .GE. 1.E-9) GO TO 9999 | |
118 | CALL CAPTUR(NOPT) | |
119 | NMEC=NMEC+1 | |
120 | LMEC(NMEC)=18 | |
121 | ISTOP=1 | |
122 | GO TO 9999 | |
123 | C | |
124 | C --- ANTI-PROTON ==> ANNIHILATION --- | |
125 | 150 CONTINUE | |
126 | DESTEP=DESTEP+EDEP | |
127 | CALL PBANH(NOPT) | |
128 | NMEC=NMEC+1 | |
129 | LMEC(NMEC)=17 | |
130 | ISTOP=1 | |
131 | GO TO 9999 | |
132 | C | |
133 | C --- ANTI-NEUTRON ==> ANNIHILATION --- | |
134 | 250 CONTINUE | |
135 | CALL NBANH(NOPT) | |
136 | NMEC=NMEC+1 | |
137 | LMEC(NMEC)=17 | |
138 | ISTOP=1 | |
139 | GO TO 9999 | |
140 | C | |
141 | C --- P OR HEAVY FRAGMENT ==> ONLY DEPOSIT KINETIC ENERGY --- | |
142 | 140 CONTINUE | |
143 | DESTEP=DESTEP+EDEP | |
144 | C --- REMOVE HADR FLAG BECAUSE THERE HAS BEEN NO HADRONIC INTERACTION | |
145 | DO 180 MMEC=1,NMEC | |
146 | IF(LMEC(MMEC).EQ.12) THEN | |
147 | DO 160 M=MMEC,NMEC-1 | |
148 | LMEC(M)=LMEC(M+1) | |
149 | 160 CONTINUE | |
150 | NMEC=NMEC-1 | |
151 | GOTO 170 | |
152 | ENDIF | |
153 | 180 CONTINUE | |
154 | 170 ISTOP=2 | |
155 | C | |
156 | 9999 CONTINUE | |
157 | TOF=TOF-TOF1*0.5 | |
158 | IF (NPRT(9)) | |
159 | $ PRINT 8802,AMAS,NCH,P,EN,EK,XEND,YEND,ZEND,ISTOP | |
160 | 8802 FORMAT(' *GHSTOP* AFTER STOP : M,CH,P,EN,EK = ',5(G12.5,1X)/ | |
161 | $ 1H ,9X,'POSITION (X,Y,Z) = ',3(G12.5,1X),' ISTOP = ',I3) | |
162 | C | |
163 | END |