GEANT321/giface/ghstop.F

   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