Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:15:42

0001 
0002 C
0003 C
0004 C
0005 C****************************************************************
0006 C       conduct soft radiation according to dipole approxiamtion
0007 C****************************************************************
0008         SUBROUTINE ATTRAD(IERROR)
0009 C
0010         COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
0011         SAVE  /HIPARNT/
0012         COMMON/HIJDAT/HIDAT0(10,10),HIDAT(10)
0013         SAVE  /HIJDAT/
0014         COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0015         SAVE  /LUJETS/
0016         IERROR=0
0017 
0018 C.....S INVARIANT MASS-SQUARED BETWEEN PARTONS I AND I+1......
0019 C.....SM IS THE LARGEST MASS-SQUARED....
0020 
0021 40      SM=0.
0022         JL=1
0023         DO 30 I=1,N-1
0024            S=2.*(P(I,4)*P(I+1,4)-P(I,1)*P(I+1,1)-P(I,2)*P(I+1,2)
0025      &          -P(I,3)*P(I+1,3))+P(I,5)**2+P(I+1,5)**2
0026            IF(S.LT.0.) S=0.
0027            WP=SQRT(S)-1.5*(P(I,5)+P(I+1,5))
0028            IF(WP.GT.SM) THEN
0029               PBT1=P(I,1)+P(I+1,1)
0030               PBT2=P(I,2)+P(I+1,2)
0031               PBT3=P(I,3)+P(I+1,3)
0032               PBT4=P(I,4)+P(I+1,4)
0033               BTT=(PBT1**2+PBT2**2+PBT3**2)/PBT4**2
0034               IF(BTT.GE.1.0-1.0E-10) GO TO 30
0035               IF((I.NE.1.OR.I.NE.N-1).AND.
0036      &             (K(I,2).NE.21.AND.K(I+1,2).NE.21)) GO TO 30
0037               JL=I
0038               SM=WP
0039            ENDIF
0040 30      CONTINUE
0041         S=(SM+1.5*(P(JL,5)+P(JL+1,5)))**2
0042         IF(SM.LT.HIPR1(5)) GOTO 2
0043      
0044 C.....MAKE PLACE FOR ONE GLUON.....
0045         IF(JL+1.EQ.N) GOTO 190
0046         DO 160 J=N,JL+2,-1
0047                 K(J+1,1)=K(J,1)
0048                 K(J+1,2)=K(J,2)
0049                 DO 150 M=1,5
0050 C+++BAC
0051                    V(J+1,M) = V(J,M)
0052 C---BAC
0053 150                     P(J+1,M)=P(J,M)
0054 160             CONTINUE
0055 190     N=N+1
0056      
0057 C.....BOOST TO REST SYSTEM FOR PARTICLES JL AND JL+1.....
0058         P1=P(JL,1)+P(JL+1,1)
0059         P2=P(JL,2)+P(JL+1,2)
0060         P3=P(JL,3)+P(JL+1,3)
0061         P4=P(JL,4)+P(JL+1,4)
0062         BEX=-P1/P4
0063         BEY=-P2/P4
0064         BEZ=-P3/P4
0065         IMIN=JL
0066         IMAX=JL+1
0067         CALL ATROBO(0.,0.,BEX,BEY,BEZ,IMIN,IMAX,IERROR)
0068         IF(IERROR.NE.0) RETURN
0069 C.....ROTATE TO Z-AXIS....
0070         CTH=P(JL,3)/SQRT(P(JL,4)**2-P(JL,5)**2)
0071         IF(ABS(CTH).GT.1.0)  CTH=MAX(-1.,MIN(1.,CTH))
0072         THETA=ACOS(CTH)
0073         PHI=ULANGL(P(JL,1),P(JL,2))
0074         CALL ATROBO(0.,-PHI,0.,0.,0.,IMIN,IMAX,IERROR)
0075         CALL ATROBO(-THETA,0.,0.,0.,0.,IMIN,IMAX,IERROR)
0076      
0077 C.....CREATE ONE GLUON AND ORIENTATE.....
0078      
0079 1       CALL AR3JET(S,X1,X3,JL)
0080         CALL ARORIE(S,X1,X3,JL)         
0081         IF(HIDAT(2).GT.0.0) THEN
0082            PTG1=SQRT(P(JL,1)**2+P(JL,2)**2)
0083            PTG2=SQRT(P(JL+1,1)**2+P(JL+1,2)**2)
0084            PTG3=SQRT(P(JL+2,1)**2+P(JL+2,2)**2)
0085            PTG=MAX(PTG1,PTG2,PTG3)
0086            IF(PTG.GT.HIDAT(2)) THEN
0087               FMFACT=EXP(-(PTG**2-HIDAT(2)**2)/HIPR1(2)**2)
0088               IF(ATL_RAN(NSEED).GT.FMFACT) GO TO 1
0089            ENDIF
0090         ENDIF
0091 C.....ROTATE AND BOOST BACK.....
0092         IMIN=JL
0093         IMAX=JL+2
0094         CALL ATROBO(THETA,PHI,-BEX,-BEY,-BEZ,IMIN,IMAX,IERROR)
0095         IF(IERROR.NE.0) RETURN
0096 C.....ENUMERATE THE GLUONS.....
0097         K(JL+2,1)=K(JL+1,1)
0098         K(JL+2,2)=K(JL+1,2)
0099         K(JL+2,3)=K(JL+1,3)
0100         K(JL+2,4)=K(JL+1,4)
0101         K(JL+2,5)=K(JL+1,5)
0102         P(JL+2,5)=P(JL+1,5)
0103         K(JL+1,1)=2
0104         K(JL+1,2)=21
0105         K(JL+1,3)=0
0106         K(JL+1,4)=0
0107         K(JL+1,5)=0
0108         P(JL+1,5)=0.
0109 
0110         V(JL+1,1) = 0.
0111         V(JL+1,2) = 0.
0112         V(JL+1,3) = 0.
0113         V(JL+1,4) = 0.
0114         V(JL+1,5) = 0.
0115 
0116 C----THETA FUNCTION DAMPING OF THE EMITTED GLUONS. FOR HADRON-HADRON.
0117 C----R0=VFR(2)
0118 C       IF(VFR(2).GT.0.) THEN
0119 C       PTG=SQRT(P(JL+1,1)**2+P(JL+1,2)**2)
0120 C       PTGMAX=WSTRI/2.
0121 C       DOPT=SQRT((4.*PAR(71)*VFR(2))/WSTRI)
0122 C       PTOPT=(DOPT*WSTRI)/(2.*VFR(2))
0123 C       IF(PTG.GT.PTOPT) IORDER=IORDER-1
0124 C       IF(PTG.GT.PTOPT) GOTO 1
0125 C       ENDIF
0126 C-----
0127         IF(SM.GE.HIPR1(5)) GOTO 40
0128 
0129 2       K(1,1)=2
0130         K(1,3)=0
0131         K(1,4)=0
0132         K(1,5)=0
0133         K(N,1)=1
0134         K(N,3)=0
0135         K(N,4)=0
0136         K(N,5)=0
0137 
0138         RETURN
0139         END