hijing/src/hiboost.f

0001 C
0002 C
0003 C
0004 C
0005         SUBROUTINE HIBOOST
0006         IMPLICIT DOUBLE PRECISION(D)
0007         COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0008         SAVE /LUJETS/
0009         COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0010         SAVE /LUDAT1/
0011         COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
0012         SAVE  /HIPARNT/
0013         DO 100 I=1,N
0014            DBETA=P(I,3)/P(I,4)
0015            IF(ABS(DBETA).GE.1.D0) THEN
0016               DB=HINT1(2)
0017               IF(DB.GT.0.99999999D0) THEN
0018 C               ********Rescale boost vector if too close to unity.
0019                  WRITE(6,*) '(HIBOOT:) boost vector too large'
0020                  DB=0.99999999D0
0021               ENDIF
0022               DGA=1D0/SQRT(1D0-DB**2)
0023               DP3=P(I,3)
0024               DP4=P(I,4)
0025               P(I,3)=(DP3+DB*DP4)*DGA
0026               P(I,4)=(DP4+DB*DP3)*DGA
0027               GO TO 100
0028            ENDIF
0029            Y=0.5*DLOG((1.D0+DBETA)/(1.D0-DBETA))
0030            AMT=SQRT(P(I,1)**2+P(I,2)**2+P(I,5)**2)
0031            P(I,3)=AMT*SINH(Y+HINT1(3))
0032            P(I,4)=AMT*COSH(Y+HINT1(3))
0033 100     CONTINUE
0034         RETURN
0035         END