hijing/src/lurobo.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ)
0005
0006 C...Purpose: to perform rotations and boosts.
0007       IMPLICIT DOUBLE PRECISION(D)
0008       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0009       SAVE /LUJETS/
0010       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0011       SAVE /LUDAT1/
0012       DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4)
0013
0014 C...Find range of rotation/boost. Convert boost to double precision.
0015       IMIN=1
0016       IF(MSTU(1).GT.0) IMIN=MSTU(1)
0017       IMAX=N
0018       IF(MSTU(2).GT.0) IMAX=MSTU(2)
0019       DBX=BEX
0020       DBY=BEY
0021       DBZ=BEZ
0022       GOTO 100
0023
0024 C...Entry for specific range and double precision boost.
0025       ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ)
0026       IMIN=IMI
0027       IF(IMIN.LE.0) IMIN=1
0028       IMAX=IMA
0029       IF(IMAX.LE.0) IMAX=N
0030       DBX=DBEX
0031       DBY=DBEY
0032       DBZ=DBEZ
0033
0034 C...Check range of rotation/boost.
0035   100 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN
0036         CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory')
0037         RETURN
0038       ENDIF
0039
0040 C...Rotate, typically from z axis to direction (theta,phi).
0041       IF(THE**2+PHI**2.GT.1E-20) THEN
0042         ROT(1,1)=COS(THE)*COS(PHI)
0043         ROT(1,2)=-SIN(PHI)
0044         ROT(1,3)=SIN(THE)*COS(PHI)
0045         ROT(2,1)=COS(THE)*SIN(PHI)
0046         ROT(2,2)=COS(PHI)
0047         ROT(2,3)=SIN(THE)*SIN(PHI)
0048         ROT(3,1)=-SIN(THE)
0049         ROT(3,2)=0.
0050         ROT(3,3)=COS(THE)
0051         DO 130 I=IMIN,IMAX
0052         IF(K(I,1).LE.0) GOTO 130
0053         DO 110 J=1,3
0054         PR(J)=P(I,J)
0055   110   VR(J)=V(I,J)
0056         DO 120 J=1,3
0057         P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3)
0058   120   V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3)
0059   130   CONTINUE
0060       ENDIF
0061
0062 C...Boost, typically from rest to momentum/energy=beta.
0063       IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN
0064         DB=SQRT(DBX**2+DBY**2+DBZ**2)
0065         IF(DB.GT.0.99999999D0) THEN
0066 C...Rescale boost vector if too close to unity.
0067           CALL LUERRM(3,'(LUROBO:) boost vector too large')
0068           DBX=DBX*(0.99999999D0/DB)
0069           DBY=DBY*(0.99999999D0/DB)
0070           DBZ=DBZ*(0.99999999D0/DB)
0071           DB=0.99999999D0
0072         ENDIF
0073         DGA=1D0/SQRT(1D0-DB**2)
0074         DO 150 I=IMIN,IMAX
0075         IF(K(I,1).LE.0) GOTO 150
0076         DO 140 J=1,4
0077         DP(J)=P(I,J)
0078   140   DV(J)=V(I,J)
0079         DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3)
0080         DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4))
0081         P(I,1)=DP(1)+DGABP*DBX
0082         P(I,2)=DP(2)+DGABP*DBY
0083         P(I,3)=DP(3)+DGABP*DBZ
0084         P(I,4)=DGA*(DP(4)+DBP)
0085         DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3)
0086         DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4))
0087         V(I,1)=DV(1)+DGABV*DBX
0088         V(I,2)=DV(2)+DGABV*DBY
0089         V(I,3)=DV(3)+DGABV*DBZ
0090         V(I,4)=DGA*(DV(4)+DBV)
0091   150   CONTINUE
0092       ENDIF
0093
0094       RETURN
0095       END