GEANT321/peanut/phdwll.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 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