GEANT321/giface/gpghei.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:14  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.37  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GPGHEI
  13 C
  14 C *** COMPUTE DISTANCE TO NEXT HADRONIC INTERACTION POINT ***
  15 C *** THIS ROUTINE IS AN INTERFACE TO GHEISHA8 ***
  16 C *** NVE 06-APR-1988 CERN GENEVA ***
  17 C
  18 C CALLED BY : GUPHAD (USER ROUTINE)
  19 C ORIGIN : F.CARMINATI
  20 C
  21 #include "geant321/gcflag.inc"
  22 #include "geant321/gcbank.inc"
  23 #include "geant321/gckine.inc"
  24 #include "geant321/gctrak.inc"
  25 #include "geant321/gcmate.inc"
  26 #include "geant321/gconsp.inc"
  27 #include "geant321/gcphys.inc"
  28 #include "geant321/gcjloc.inc"
  29 C --- GHEISHA COMMONS ---
  30 #include "geant321/s_prntfl.inc"
  31 C
  32 C --- INITIALIZE RELEVANT GHEISHA VARIABLES AT FIRST PASS ---
  33       IF (IFINIT(4) .EQ. 0) CALL GHEINI
  34 C
  35       IF (Z .LT. 1.0) GO TO 1000
  36 C
  37       KK=ABS(Q(JMA+11))
  38       IF (KK .GT. 1) GO TO 10
  39 C
  40       SIG=GHESIG(VECT(7),GEKIN,A,A,Z,1.0,1,DENS,0.0,IPART)
  41       GO TO 20
  42 C
  43  10   CONTINUE
  44       QCOR=0.0
  45       IF(JTM.GT.0) THEN
  46          LNVE=LQ(JTM)
  47          IF (LNVE .GT. 0) QCOR=Q(LNVE+26)
  48       ENDIF
  49       SIG=GHESIG(VECT(7),GEKIN,A,Q(JMIXT+1),Q(JMIXT+KK+1),
  50      $           Q(JMIXT+2*KK+1),KK,DENS,QCOR,IPART)
  51 C
  52  20   CONTINUE
  53       IF (SIG .LE. 0.0) GO TO 1000
  54       SHADR=ZINTHA/SIG
  55       IF (NPRT(9)) PRINT 2000,KK,SIG,SHADR
  56  2000 FORMAT(' *GPGHEI* KK,SIG,SHADR = ',I3,1X,2(G12.5,1X))
  57       GO TO 9999
  58 C
  59 C --- ENSURE NO INTERACTION IN CURRENT MEDIUM ---
  60 C
  61  1000 CONTINUE
  62       SHADR=BIG
  63       IF (NPRT(9)) PRINT 2001,KK,SIG,SHADR
  64  2001 FORMAT(' *GPGHEI* === NO INTERACTION IN CURRENT MEDIUM ==='/
  65      $ ' KK,SIG,SHADR = ',I3,1X,2(G12.5,1X))
  66 C
  67  9999 CONTINUE
  68       END