| fe4da5cc |
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 |
git://git.uio.no / u / mrichter / AliRoot.git / blame