PHOS/shaker/lurobo.f

   1 *CMZ :          17/07/98  15.44.33  by  Federico Carminati
   2 *-- Author :
   3 C*********************************************************************
   4
   5       SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ)
   6
   7 C...Purpose: to perform rotations and boosts.
   8       IMPLICIT DOUBLE PRECISION(D)
   9 *KEEP,LUJETS.
  10       COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
  11       SAVE /LUJETS/
  12 *KEEP,LUDAT1.
  13       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  14       SAVE /LUDAT1/
  15 *KEND.
  16       DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4)
  17
  18 C...Find range of rotation/boost. Convert boost to double precision.
  19       IMIN=1
  20       IF(MSTU(1).GT.0) IMIN=MSTU(1)
  21       IMAX=N
  22       IF(MSTU(2).GT.0) IMAX=MSTU(2)
  23       DBX=BEX
  24       DBY=BEY
  25       DBZ=BEZ
  26       GOTO 110
  27
  28 C...Entry for specific range and double precision boost.
  29       ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ)
  30       IMIN=IMI
  31       IF(IMIN.LE.0) IMIN=1
  32       IMAX=IMA
  33       IF(IMAX.LE.0) IMAX=N
  34       DBX=DBEX
  35       DBY=DBEY
  36       DBZ=DBEZ
  37
  38 C...Optional resetting of V (when not set before.)
  39       IF(MSTU(33).NE.0) THEN
  40         DO 100 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4))
  41         DO 100 J=1,5
  42   100   V(I,J)=0.
  43         MSTU(33)=0
  44       ENDIF
  45
  46 C...Check range of rotation/boost.
  47   110 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN
  48         CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory')
  49         RETURN
  50       ENDIF
  51
  52 C...Rotate, typically from z axis to direction (theta,phi).
  53       IF(THE**2+PHI**2.GT.1E-20) THEN
  54         ROT(1,1)=COS(THE)*COS(PHI)
  55         ROT(1,2)=-SIN(PHI)
  56         ROT(1,3)=SIN(THE)*COS(PHI)
  57         ROT(2,1)=COS(THE)*SIN(PHI)
  58         ROT(2,2)=COS(PHI)
  59         ROT(2,3)=SIN(THE)*SIN(PHI)
  60         ROT(3,1)=-SIN(THE)
  61         ROT(3,2)=0.
  62         ROT(3,3)=COS(THE)
  63         DO 140 I=IMIN,IMAX
  64         IF(K(I,1).LE.0) GOTO 140
  65         DO 120 J=1,3
  66         PR(J)=P(I,J)
  67   120   VR(J)=V(I,J)
  68         DO 130 J=1,3
  69         P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3)
  70   130   V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3)
  71   140   CONTINUE
  72       ENDIF
  73
  74 C...Boost, typically from rest to momentum/energy=beta.
  75       IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN
  76         DB=SQRT(DBX**2+DBY**2+DBZ**2)
  77         IF(DB.GT.0.99999999D0) THEN
  78 C...Rescale boost vector if too close to unity.
  79           CALL LUERRM(3,'(LUROBO:) boost vector too large')
  80           DBX=DBX*(0.99999999D0/DB)
  81           DBY=DBY*(0.99999999D0/DB)
  82           DBZ=DBZ*(0.99999999D0/DB)
  83           DB=0.99999999D0
  84         ENDIF
  85         DGA=1D0/SQRT(1D0-DB**2)
  86         DO 160 I=IMIN,IMAX
  87         IF(K(I,1).LE.0) GOTO 160
  88         DO 150 J=1,4
  89         DP(J)=P(I,J)
  90   150   DV(J)=V(I,J)
  91         DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3)
  92         DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4))
  93         P(I,1)=DP(1)+DGABP*DBX
  94         P(I,2)=DP(2)+DGABP*DBY
  95         P(I,3)=DP(3)+DGABP*DBZ
  96         P(I,4)=DGA*(DP(4)+DBP)
  97         DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3)
  98         DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4))
  99         V(I,1)=DV(1)+DGABV*DBX
 100         V(I,2)=DV(2)+DGABV*DBY
 101         V(I,3)=DV(3)+DGABV*DBZ
 102         V(I,4)=DGA*(DV(4)+DBV)
 103   160   CONTINUE
 104       ENDIF
 105
 106       RETURN
 107       END