SUBROUTINE GHSTOPP(IPART,CODE,ISTOP)
      IMPLICIT NONE
C
C     DECLARATIONS WHEN SWITCH TO IMPLICIT NONE
C
      REAL*4 XEND,YEND,ZEND,RCA,RCE,AMAS
      REAL*4 TOF,PX,PY,PZ,USERW,P,EN,EK,AMASQ,DELTN
      INTEGER*4 ITK,NTK,KPART,IND,LCALO,ICEL
      REAL*4 SINL,COSL,SINP,COSP,XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD
      REAL*4 XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT,EDEP
      REAL*4 GETOT,GEKIN
      INTEGER*4 NOPT
C
      INTEGER *4 CODE,ISTOP,IPART
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
C
C
C
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
C
C --- IN CASE OF ENERGY DEPOSITION ALL THE EKIN WILL BE DEPOSITED ---
      EDEP=EK
C
C --- UPDATE MOMENTUM VECTOR AND ENERGIES FOR STOPPING PARTICLE ---
      P=0.0
      PX=0.0
      PY=0.0
      PZ=0.0
      EN=ABS(AMAS)
      EK=0.0
      GETOT=EN
      GEKIN=EK
      ISTOP=2
C
C
C *** SELECT PROCESS FOR CURRENT PARTICLE ***
C
C --- SKIP EXOTIC PARTICLES ---
      IF (IPART .GE. 48) 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) GO TO 140
C
C --- LET ALL OTHER PARTICLES DECAY ---
COFF  CALL GDECAY  !Leave this to Gismo
      CODE=5
      ISTOP=1
      GO TO 9999
C
C --- PI- ABSORBED BY NUCLEUS ---
 90   CONTINUE
      CALL PIMABS(NOPT)
      CODE=16
      ISTOP=1
      GO TO 9999
C
C --- K- ABSORBED BY NUCLEUS ---
 120  CONTINUE
      CALL KMABS(NOPT)
      CODE=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)
      CODE=18
      ISTOP=1
      GO TO 9999
C
C --- ANTI-PROTON ==> ANNIHILATION ---
 150  CONTINUE
      CALL PBANH(NOPT)
      CODE=17
      ISTOP=1
      GO TO 9999
C
C --- ANTI-NEUTRON ==> ANNIHILATION ---
 250  CONTINUE
      CALL NBANH(NOPT)
      CODE=17
      ISTOP=1
      GO TO 9999
C
C --- P OR HEAVY FRAGMENT ==> ONLY DEPOSIT KINETIC ENERGY ---
 140  CONTINUE
      CODE=19
      ISTOP=2
C
 9999 CONTINUE
C
      RETURN
      END