GEANT321/peanut/phdset.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:22:02  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.46  by  S.Giani
  11 *-- Author :
  12 *$ CREATE PHDSET.FOR
  13 *COPY PHDSET
  14 *
  15 *=== phdset ===========================================================*
  16 *
  17       SUBROUTINE PHDSET ( IKPMX )
  18
  19 #include "geant321/dblprc.inc"
  20 #include "geant321/dimpar.inc"
  21 #include "geant321/iounit.inc"
  22 *
  23 *----------------------------------------------------------------------*
  24 *----------------------------------------------------------------------*
  25 *
  26 #include "geant321/nucgeo.inc"
  27 #include "geant321/parnuc.inc"
  28 #include "geant321/part.inc"
  29 *
  30  1000 CONTINUE
  31       PDIFF = PNUCL (IKPMX) - PNUCCO
  32       IF ( PDIFF .LT. - ANGLGB ) THEN
  33          PNUCL0 = PNUCL (IKPMX)
  34          PNUCL (IKPMX) = PNUCCO
  35          PDTCMP = - ( PXNUCL (IKPMX) * CXIMPC + PYNUCL (IKPMX)
  36      &          * CYIMPC + PZNUCL (IKPMX) * CZIMPC )
  37          DELTAE = PDTCMP**2 - PNUCL0**2 + PNUCL (IKPMX)**2
  38          DELTAP = - PDTCMP + SQRT ( DELTAE )
  39          PXNUCL (IKPMX) = PXNUCL (IKPMX) + DELTAP * CXIMPC
  40          PYNUCL (IKPMX) = PYNUCL (IKPMX) + DELTAP * CYIMPC
  41          PZNUCL (IKPMX) = PZNUCL (IKPMX) + DELTAP * CZIMPC
  42       ELSE IF ( PDIFF .GT. ANGLGB ) THEN
  43          PNUCL0 = PNUCL (IKPMX)
  44          PNUCL (IKPMX) = PNUCCO
  45          PDTCMP = PXNUCL (IKPMX) * CXIMPC + PYNUCL (IKPMX)
  46      &          * CYIMPC + PZNUCL (IKPMX) * CZIMPC
  47          IF ( PDTCMP .GE. 0.D+00 ) THEN
  48             PNUCL0 = PNUCL (IKPMX) / PNUCL0
  49             PXNUCL (IKPMX) = PXNUCL (IKPMX) * PNUCL0
  50             PYNUCL (IKPMX) = PYNUCL (IKPMX) * PNUCL0
  51             PZNUCL (IKPMX) = PZNUCL (IKPMX) * PNUCL0
  52          ELSE
  53             DELTAE = PDTCMP**2 - PNUCL0**2 + PNUCL (IKPMX)**2
  54             IF ( DELTAE .LT. 0.D+00 ) THEN
  55                DELTAP = - PDTCMP
  56                PXNUCL (IKPMX) = PXNUCL (IKPMX) + DELTAP * CXIMPC
  57                PYNUCL (IKPMX) = PYNUCL (IKPMX) + DELTAP * CYIMPC
  58                PZNUCL (IKPMX) = PZNUCL (IKPMX) + DELTAP * CZIMPC
  59                PNUCL0 = SQRT ( PXNUCL (IKPMX)**2
  60      &                + PYNUCL (IKPMX)**2 + PZNUCL (IKPMX)**2 )
  61                PNUCL0 = PNUCL (IKPMX) / PNUCL0
  62                PXNUCL (IKPMX) = PXNUCL (IKPMX) * PNUCL0
  63                PYNUCL (IKPMX) = PYNUCL (IKPMX) * PNUCL0
  64                PZNUCL (IKPMX) = PZNUCL (IKPMX) * PNUCL0
  65             ELSE
  66                DELTAP = - PDTCMP - SQRT ( DELTAE )
  67                PXNUCL (IKPMX) = PXNUCL (IKPMX) + DELTAP * CXIMPC
  68                PYNUCL (IKPMX) = PYNUCL (IKPMX) + DELTAP * CYIMPC
  69                PZNUCL (IKPMX) = PZNUCL (IKPMX) + DELTAP * CZIMPC
  70             END IF
  71          END IF
  72       END IF
  73       RETURN
  74 *=== End of subroutine phdset =========================================*
  75       END