Merging the VirtualMC branch to the main development branch (HEAD)
[u/mrichter/AliRoot.git] / 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