HIJING/hipyset1_35/lurobo_hijing.F

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