| 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 PHDWLL.FOR |
| 13 | *COPY PHDWLL |
| 14 | * |
| 15 | *=== phdwll ===========================================================* |
| 16 | * |
| 17 | SUBROUTINE PHDWLL ( UBIMPT, VBIMPT, WBIMPT ) |
| 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 = PNUCCO - PPRWLL |
| 32 | IF ( PDIFF .LT. - ANGLGB ) THEN |
| 33 | IF ( RIMPTR .LE. RADIU0 ) THEN |
| 34 | RADHLP = 0.5D+00 * ( RADTOT + RADPRO + MAX ( ABS (RIMPTR), |
| 35 | & RADIU0 ) ) |
| 36 | CZHLP = SQRT ( ( RADHLP + BIMPTR ) * ( RADHLP - BIMPTR ) ) |
| 37 | & / RADHLP |
| 38 | HLPHLP = RIMPTR / ( RIMPCT * RADHLP ) |
| 39 | CXHLP = CZHLP * CXIMPC - XBIMPC * HLPHLP |
| 40 | CYHLP = CZHLP * CYIMPC - YBIMPC * HLPHLP |
| 41 | CZHLP = CZHLP * CZIMPC - ZBIMPC * HLPHLP |
| 42 | PXPROJ = PNUCCO * CXIMPC |
| 43 | PYPROJ = PNUCCO * CYIMPC |
| 44 | PZPROJ = PNUCCO * CZIMPC |
| 45 | PDTCMP = PXPROJ * CXHLP + PYPROJ * CYHLP + PZPROJ * CZHLP |
| 46 | DELTAE = PDTCMP**2 - PNUCCO**2 + PPRWLL**2 |
| 47 | DELTAP = - PDTCMP + SQRT ( DELTAE ) |
| 48 | PXPROJ = PXPROJ + DELTAP * CXHLP |
| 49 | PYPROJ = PYPROJ + DELTAP * CYHLP |
| 50 | PZPROJ = PZPROJ + DELTAP * CZHLP |
| 51 | ELSE |
| 52 | EKEBIM = MAX ( EKECON + VPRBIM, EKEWLL ) |
| 53 | PBIMSQ = EKEBIM * ( EKEBIM + 2.D+00 * AM (KPRIN) ) |
| 54 | RADHLP = 0.5D+00 * ( RADTOT + RADPRO + MAX ( BIMPTR, |
| 55 | & RADIU0 ) ) |
| 56 | CZHLP = SQRT ( ( RADHLP + BIMPTR ) * ( RADHLP - BIMPTR ) ) |
| 57 | & / RADHLP |
| 58 | HLPHLP = RIMPTR / ( RIMPCT * RADHLP ) |
| 59 | CXHLP = CZHLP * CXIMPC - XBIMPC * HLPHLP |
| 60 | CYHLP = CZHLP * CYIMPC - YBIMPC * HLPHLP |
| 61 | CZHLP = CZHLP * CZIMPC - ZBIMPC * HLPHLP |
| 62 | PXPROJ = PNUCCO * CXIMPC |
| 63 | PYPROJ = PNUCCO * CYIMPC |
| 64 | PZPROJ = PNUCCO * CZIMPC |
| 65 | PDTCMP = PXPROJ * CXHLP + PYPROJ * CYHLP + PZPROJ * CZHLP |
| 66 | DELTAE = PDTCMP**2 - PNUCCO**2 + PBIMSQ |
| 67 | DELTAP = - PDTCMP + SQRT ( DELTAE ) |
| 68 | PXPROJ = PXPROJ + DELTAP * CXHLP |
| 69 | PYPROJ = PYPROJ + DELTAP * CYHLP |
| 70 | PZPROJ = PZPROJ + DELTAP * CZHLP |
| 71 | PPBIM = SQRT ( PBIMSQ ) |
| 72 | COSTHE = ( PXPROJ * CXIMPC + PYPROJ * CYIMPC |
| 73 | & + PZPROJ * CZIMPC ) / PPBIM |
| 74 | THETA = ACOS (COSTHE) * ( 1.D+00 + ( PNUCCO - PPBIM ) |
| 75 | & / PDIFF ) |
| 76 | SINTHE = SIN (THETA) |
| 77 | COSTHE = COS (THETA) |
| 78 | PXPROJ = PPRWLL * ( COSTHE * CXIMPC - SINTHE * UBIMPT ) |
| 79 | PYPROJ = PPRWLL * ( COSTHE * CYIMPC - SINTHE * VBIMPT ) |
| 80 | PZPROJ = PPRWLL * ( COSTHE * CZIMPC - SINTHE * WBIMPT ) |
| 81 | END IF |
| 82 | ELSE IF ( PDIFF .GT. ANGLGB ) THEN |
| 83 | STOP 'PHDWLL' |
| 84 | ELSE |
| 85 | PXPROJ = PPRWLL * CXIMPC |
| 86 | PYPROJ = PPRWLL * CYIMPC |
| 87 | PZPROJ = PPRWLL * CZIMPC |
| 88 | END IF |
| 89 | RETURN |
| 90 | *=== End of subroutine phdwll =========================================* |
| 91 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame