GEANT321/ghrout/ghepec.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:13  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.40  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GHEPEC(LEDPAR)
  13 C**
  14 C** MOMENTUM CONSERVATION AT HIGH ENERGIES
  15 C**
  16 #include "geant321/mxgkgh.inc"
  17 #include "geant321/s_prntfl.inc"
  18 #include "geant321/s_blank.inc"
  19 C
  20 #if !defined(CERNLIB_SINGLE)
  21       DOUBLE PRECISION AHMF,BHMF
  22 #endif
  23 C**
  24       IF(LEDPAR.LE.0) RETURN
  25 C**
  26       MX=MXGKPV-10
  27       MX5=MX+5
  28       MX6=MX+6
  29       MX7=MX+7
  30       MX9=MX+9
  31 C**
  32 C** APPLY CORRECTION ON LEADING PARTICLE
  33 C**
  34         IF(NPRT(4))
  35      $     WRITE(NEWBCD,1002) LEDPAR,(PV(J,LEDPAR),J=1,10)
  36 C**
  37         CALL SUB3(MX9,MXGKPV,MX5)
  38         CALL ANG(MXGKPV,LEDPAR,COST,TETA)
  39         CALL LENGTX(LEDPAR,PPP)
  40         PTLED=PPP*SQRT(1.-COST**2)
  41         CALL SUB3(LEDPAR,MX5,LEDPAR)
  42         CALL ANG(MXGKPV,LEDPAR,COST,TETA)
  43         CALL LENGTX(LEDPAR,PPP)
  44         PPP=PPP*COST
  45         CALL LENGTX(MXGKPV,PBEAM)
  46         PV(1,MX6)=PV(1,MXGKPV)*PPP/PBEAM
  47         PV(2,MX6)=PV(2,MXGKPV)*PPP/PBEAM
  48         PV(3,MX6)=PV(3,MXGKPV)*PPP/PBEAM
  49         CALL CROSS3(MXGKPV,LEDPAR,MX7)
  50         CALL CROSS3(MX7,MXGKPV,MX7)
  51         CALL LENGTX(MX7,PPP)
  52         PV(1,MX7)=PV(1,MX7)*PTLED/PPP
  53         PV(2,MX7)=PV(2,MX7)*PTLED/PPP
  54         PV(3,MX7)=PV(3,MX7)*PTLED/PPP
  55         CALL ADD3(MX6,MX7,LEDPAR)
  56         CALL LENGTX(LEDPAR,PPP)
  57         AHMF=PPP
  58         BHMF=PV(5,LEDPAR)
  59         PV(4,LEDPAR)=DSQRT(AHMF**2+BHMF**2)
  60 C**
  61       IF(NPRT(4)) THEN
  62          WRITE(NEWBCD,1003) LEDPAR,(PV(J,LEDPAR),J=1,10)
  63       ENDIF
  64 C**
  65       RETURN
  66  1002 FORMAT(1H ,'LEADING PARTICLE ',I3,2X,10F8.3)
  67  1003 FORMAT(1H ,'CORRECTED 4-VECT ',I3,2X,10F8.3)
  68
  69       END