*
* $Id: ghstop.F,v 1.1.1.1 1995/10/24 10:21:15 cernlib Exp $
*
* $Log: ghstop.F,v $
* Revision 1.1.1.1  1995/10/24 10:21:15  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.38  by  S.Giani
*-- Author :
      SUBROUTINE GHSTOP
C
C *** HANDLING OF STOPPING PARTICLES ***
C *** NVE 18-MAY-1988 CERN GENEVA ***
C
C CALLED BY : GHEISH
C ORIGIN : H.FESEFELDT (ROUTINE CALIM 16-SEP-1987)
C
#include "geant321/gcbank.inc"
#include "geant321/gckine.inc"
#include "geant321/gcking.inc"
#include "geant321/gctrak.inc"
#include "geant321/gccuts.inc"
C --- GHEISHA COMMONS ---
#include "geant321/s_prntfl.inc"
C
C --- "IPART" CHANGED TO "KPART" IN COMMON /RESULT/ DUE TO CLASH ---
C --- WITH VARIABLE "IPART" IN GEANT COMMON ---
C
      COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ,
     $              USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,KPART,IND,
     $              LCALO,ICEL,SINL,COSL,SINP,COSP,
     $              XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD,
     $              XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT
                    REAL NCH,INTCT
C
      IF (NPRT(2) .OR. NPRT(9))
     $ WRITE(NEWBCD,8801) AMAS,NCH,P,EN,EK,XEND,YEND,ZEND,ISTOP
 8801 FORMAT(' *GHSTOP* STOPPING TRACK M,CH,P,EN,EK = ',5(G12.5,1X)/
     $ 1H ,9X,'POSITION (X,Y,Z) = ',3(G12.5,1X),' ISTOP = ',I3)
C
C --- IN CASE OF ENERGY DEPOSITION ALL THE EKIN WILL BE DEPOSITED ---
      EDEP=EK
C
C --- CALCULATE TIME TO STOP ---
      TOF1=0.0
      IF (P .GT. 1.0E-10) TOF1=STEP*EN*0.666667/P
C
C --- UPDATE MOMENTUM VECTOR AND ENERGIES FOR STOPPING PARTICLE ---
      P=0.0
      EN=ABS(AMAS)
      EK=0.0
      GETOT=EN
      GEKIN=EK
      ISTOP=2
C --- NEXT 2 STMTS. COMMENTED TO AVOID DOUBLE SETTING (NVE 15-AUG-88)
C%%%      NMEC=NMEC+1
C%%%      LMEC(NMEC)=30
C
C --- UPDATE TIME OF FLIGHT AND CHECK FOR LIMIT ---
      TOF=TOF+TOF1
      TEST1=TOF-0.5*TOF1
      TEST2=(TOFMAX-TOFG)*2.0E10
      IF (TEST1 .GT. TEST2) GO TO 9999
C
C *** SELECT PROCESS FOR CURRENT PARTICLE ***
C
C
C --- SKIP NEUTRINOS ---
      IF (IPART .EQ. 4) GO TO 9999
C
C --- LOOK FOR PARTICLES WITH SPECIAL TREATMENT ---
      IF (IPART .EQ. 9) GO TO 90
      IF (IPART .EQ. 12) GO TO 120
      IF (IPART .EQ. 13) GO TO 130
      IF (IPART .EQ. 15) GO TO 150
      IF (IPART .EQ. 25) GO TO 250
C
C --- ONLY DEPOSIT ALL KINETIC ENERGY FOR P AND HEAVY FRAGMENTS ---
      IF (IPART .EQ. 14) GO TO 140
      IF (IPART.GE.45 .AND. IPART.LE.48) GO TO 140
C
C --- LET ALL OTHER PARTICLES DECAY ---
      CALL GDECAY
      IF(NGKINE.GT.0) THEN
      NMEC=NMEC+1
      LMEC(NMEC)=5
      ISTOP=1
      GO TO 9999
      ELSE
C
C --- FOR SOME REASON PARTICLE DID NOT DECAY ---
      GOTO 140
      ENDIF
C
C --- PI- ABSORBED BY NUCLEUS ---
 90   CONTINUE
      DESTEP=DESTEP+EDEP
      CALL PIMABS(NOPT)
      NMEC=NMEC+1
      LMEC(NMEC)=16
      ISTOP=1
      GO TO 9999
C
C --- K- ABSORBED BY NUCLEUS ---
 120  CONTINUE
      DESTEP=DESTEP+EDEP
      CALL KMABS(NOPT)
      NMEC=NMEC+1
      LMEC(NMEC)=16
      ISTOP=1
      GO TO 9999
C
C --- NEUTRON CAPTURED BY NUCLEUS ---
 130  CONTINUE
      IF (EDEP .GE. 1.E-9) GO TO 9999
      CALL CAPTUR(NOPT)
      NMEC=NMEC+1
      LMEC(NMEC)=18
      ISTOP=1
      GO TO 9999
C
C --- ANTI-PROTON ==> ANNIHILATION ---
 150  CONTINUE
      DESTEP=DESTEP+EDEP
      CALL PBANH(NOPT)
      NMEC=NMEC+1
      LMEC(NMEC)=17
      ISTOP=1
      GO TO 9999
C
C --- ANTI-NEUTRON ==> ANNIHILATION ---
 250  CONTINUE
      CALL NBANH(NOPT)
      NMEC=NMEC+1
      LMEC(NMEC)=17
      ISTOP=1
      GO TO 9999
C
C --- P OR HEAVY FRAGMENT ==> ONLY DEPOSIT KINETIC ENERGY ---
 140  CONTINUE
      DESTEP=DESTEP+EDEP
C --- REMOVE HADR FLAG BECAUSE THERE HAS BEEN NO HADRONIC INTERACTION
      DO 180 MMEC=1,NMEC
         IF(LMEC(MMEC).EQ.12) THEN
            DO 160 M=MMEC,NMEC-1
               LMEC(M)=LMEC(M+1)
 160        CONTINUE
            NMEC=NMEC-1
            GOTO 170
         ENDIF
 180  CONTINUE
 170  ISTOP=2
C
 9999 CONTINUE
      TOF=TOF-TOF1*0.5
      IF (NPRT(9))
     $ PRINT 8802,AMAS,NCH,P,EN,EK,XEND,YEND,ZEND,ISTOP
 8802 FORMAT(' *GHSTOP* AFTER STOP : M,CH,P,EN,EK = ',5(G12.5,1X)/
     $ 1H ,9X,'POSITION (X,Y,Z) = ',3(G12.5,1X),' ISTOP = ',I3)
C
      END