hijing/src/hijfrg.f

0001
0002 C
0003 C
0004 C
0005 C
0006         SUBROUTINE HIJFRG(JTP,NTP,IERROR)
0007 C       NTP=1, fragment proj string, NTP=2, targ string,
0008 C       NTP=3, independent
0009 C       strings from jets.  JTP is the line number of the string
0010 C*******Fragment all leading strings of proj and targ**************
0011 C       IHNT2(1)=atomic #, IHNT2(2)=proton #(=-1 if anti-proton)  *
0012 C******************************************************************
0013         COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
0014         SAVE  /HIPARNT/
0015         COMMON/HIJDAT/HIDAT0(10,10),HIDAT(10)
0016         SAVE  /HIJDAT/
0017         COMMON/HISTRNG/NFP(300,15),PP(300,15),NFT(300,15),PT(300,15)
0018         SAVE  /HISTRNG/
0019         COMMON/HIJJET1/NPJ(300),KFPJ(300,500),PJPX(300,500),
0020      &                PJPY(300,500),PJPZ(300,500),PJPE(300,500),
0021      &                PJPM(300,500),NTJ(300),KFTJ(300,500),
0022      &                PJTX(300,500),PJTY(300,500),PJTZ(300,500),
0023      &                PJTE(300,500),PJTM(300,500)
0024         SAVE  /HIJJET1/
0025         COMMON/HIJJET2/NSG,NJSG(900),IASG(900,3),K1SG(900,100),
0026      &          K2SG(900,100),PXSG(900,100),PYSG(900,100),
0027      &          PZSG(900,100),PESG(900,100),PMSG(900,100)
0028         SAVE  /HIJJET2/
0029 C
0030         COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0031         SAVE  /LUJETS/
0032         COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0033         SAVE  /LUDAT1/
0034         COMMON/RANSEED/NSEED
0035         SAVE  /RANSEED/
0036
0037         IERROR=0
0038         CALL LUEDIT(0)
0039         N=0
0040 C                       ********initialize the document lines
0041         IF(NTP.EQ.3) THEN
0042                 ISG=JTP
0043                 N=NJSG(ISG)
0044                 DO 100 I=1,NJSG(ISG)
0045                         K(I,1)=K1SG(ISG,I)
0046                         K(I,2)=K2SG(ISG,I)
0047                         P(I,1)=PXSG(ISG,I)
0048                         P(I,2)=PYSG(ISG,I)
0049                         P(I,3)=PZSG(ISG,I)
0050                         P(I,4)=PESG(ISG,I)
0051                         P(I,5)=PMSG(ISG,I)
0052 C BAC+++
0053 C
0054 C       Clear the starting point information in the Pythia arrays
0055 C
0056                         V(I,1)=0
0057                         V(I,2)=0
0058                         V(I,3)=0
0059                         V(I,4)=0
0060                         V(I,5)=0
0061 C BAC---
0062
0063 100             CONTINUE
0064 C               IF(IHPR2(1).GT.0) CALL ATTRAD(IERROR)
0065 c               IF(IERROR.NE.0) RETURN
0066 C               CALL LULIST(1)
0067                 CALL LUEXEC
0068                 RETURN
0069         ENDIF
0070 C
0071         IF(NTP.EQ.2) GO TO 200
0072         IF(JTP.GT.IHNT2(1))   RETURN
0073         IF(NFP(JTP,5).NE.3.AND.NFP(JTP,3).NE.0
0074      &      .AND.NPJ(JTP).EQ.0.AND.NFP(JTP,10).EQ.0) GO TO 1000
0075         IF(NFP(JTP,15).EQ.-1) THEN
0076                 KF1=NFP(JTP,2)
0077                 KF2=NFP(JTP,1)
0078                 PQ21=PP(JTP,6)
0079                 PQ22=PP(JTP,7)
0080                 PQ11=PP(JTP,8)
0081                 PQ12=PP(JTP,9)
0082                 AM1=PP(JTP,15)
0083                 AM2=PP(JTP,14)
0084         ELSE
0085                 KF1=NFP(JTP,1)
0086                 KF2=NFP(JTP,2)
0087                 PQ21=PP(JTP,8)
0088                 PQ22=PP(JTP,9)
0089                 PQ11=PP(JTP,6)
0090                 PQ12=PP(JTP,7)
0091                 AM1=PP(JTP,14)
0092                 AM2=PP(JTP,15)
0093         ENDIF
0094 C       ********for NFP(JTP,15)=-1 NFP(JTP,1) IS IN -Z DIRECTION
0095         PB1=PQ11+PQ21
0096         PB2=PQ12+PQ22
0097         PB3=PP(JTP,3)
0098         PECM=PP(JTP,5)
0099         BTZ=PB3/PP(JTP,4)
0100         IF((ABS(PB1-PP(JTP,1)).GT.0.01.OR.
0101      &    ABS(PB2-PP(JTP,2)).GT.0.01).AND.IHPR2(10).NE.0)
0102      &    WRITE(6,*) '  Pt of Q and QQ do not sum to the total'
0103
0104         GO TO 300
0105
0106 200     IF(JTP.GT.IHNT2(3))  RETURN
0107         IF(NFT(JTP,5).NE.3.AND.NFT(JTP,3).NE.0
0108      &     .AND.NTJ(JTP).EQ.0.AND.NFT(JTP,10).EQ.0) GO TO 1200
0109         IF(NFT(JTP,15).EQ.1) THEN
0110                 KF1=NFT(JTP,1)
0111                 KF2=NFT(JTP,2)
0112                 PQ11=PT(JTP,6)
0113                 PQ12=PT(JTP,7)
0114                 PQ21=PT(JTP,8)
0115                 PQ22=PT(JTP,9)
0116                 AM1=PT(JTP,14)
0117                 AM2=PT(JTP,15)
0118         ELSE
0119                 KF1=NFT(JTP,2)
0120                 KF2=NFT(JTP,1)
0121                 PQ11=PT(JTP,8)
0122                 PQ12=PT(JTP,9)
0123                 PQ21=PT(JTP,6)
0124                 PQ22=PT(JTP,7)
0125                 AM1=PT(JTP,15)
0126                 AM2=PT(JTP,14)
0127         ENDIF
0128 C       ********for NFT(JTP,15)=1 NFT(JTP,1) IS IN +Z DIRECTION
0129         PB1=PQ11+PQ21
0130         PB2=PQ12+PQ22
0131         PB3=PT(JTP,3)
0132         PECM=PT(JTP,5)
0133         BTZ=PB3/PT(JTP,4)
0134
0135         IF((ABS(PB1-PT(JTP,1)).GT.0.01.OR.
0136      &     ABS(PB2-PT(JTP,2)).GT.0.01).AND.IHPR2(10).NE.0)
0137      &     WRITE(6,*) '  Pt of Q and QQ do not sum to the total'
0138
0139 300     IF(PECM.LT.HIPR1(1)) THEN
0140            IERROR=1
0141            IF(IHPR2(10).EQ.0) RETURN
0142            WRITE(6,*) ' ECM=',PECM,' energy of the string is too small'
0143            RETURN
0144         ENDIF
0145         AMT=PECM**2+PB1**2+PB2**2
0146         AMT1=AM1**2+PQ11**2+PQ12**2
0147         AMT2=AM2**2+PQ21**2+PQ22**2
0148         PZCM=SQRT(ABS(AMT**2+AMT1**2+AMT2**2-2.0*AMT*AMT1
0149      &       -2.0*AMT*AMT2-2.0*AMT1*AMT2))/2.0/SQRT(AMT)
0150 C               *******PZ of end-partons in c.m. frame of the string
0151         K(1,1)=2
0152         K(1,2)=KF1
0153         P(1,1)=PQ11
0154         P(1,2)=PQ12
0155         P(1,3)=PZCM
0156         P(1,4)=SQRT(AMT1+PZCM**2)
0157         P(1,5)=AM1
0158         K(2,1)=1
0159         K(2,2)=KF2
0160         P(2,1)=PQ21
0161         P(2,2)=PQ22
0162         P(2,3)=-PZCM
0163         P(2,4)=SQRT(AMT2+PZCM**2)
0164         P(2,5)=AM2
0165
0166 C BAC+++
0167 C
0168 C       Clear the starting point information in the Pythia arrays
0169 C
0170         V(1,1)=0
0171         V(1,2)=0
0172         V(1,3)=0
0173         V(1,4)=0
0174         V(1,5)=0
0175
0176         V(2,1)=0
0177         V(2,2)=0
0178         V(2,3)=0
0179         V(2,4)=0
0180         V(2,5)=0
0181 C BAC---
0182
0183
0184         N=2
0185 C*****
0186         CALL HIROBO(0.0,0.0,0.0,0.0,BTZ)
0187         JETOT=0
0188         IF((PQ21**2+PQ22**2).GT.(PQ11**2+PQ12**2)) THEN
0189                 PMAX1=P(2,1)
0190                 PMAX2=P(2,2)
0191                 PMAX3=P(2,3)
0192         ELSE
0193                 PMAX1=P(1,1)
0194                 PMAX2=P(1,2)
0195                 PMAX3=P(1,3)
0196         ENDIF
0197         IF(NTP.EQ.1) THEN
0198                 PP(JTP,10)=PMAX1
0199                 PP(JTP,11)=PMAX2
0200                 PP(JTP,12)=PMAX3
0201         ELSE IF(NTP.EQ.2) THEN
0202                 PT(JTP,10)=PMAX1
0203                 PT(JTP,11)=PMAX2
0204                 PT(JTP,12)=PMAX3
0205         ENDIF
0206 C*******************attach produced jets to the leading partons****
0207         IF(NTP.EQ.1.AND.NPJ(JTP).NE.0) THEN
0208                 JETOT=NPJ(JTP)
0209 C               IF(NPJ(JTP).GE.2) CALL HIJSRT(JTP,1)
0210 C                       ********sort jets in order of y
0211                 IEX=0
0212                 IF((ABS(KF1).GT.1000.AND.KF1.LT.0)
0213      &                  .OR.(ABS(KF1).LT.1000.AND.KF1.GT.0)) IEX=1
0214                 DO 520 I=N,2,-1
0215                 DO 520 J=1,5
0216                         II=NPJ(JTP)+I
0217                         K(II,J)=K(I,J)
0218                         P(II,J)=P(I,J)
0219                         V(II,J)=V(I,J)
0220 520             CONTINUE
0221                 DO 540 I=1,NPJ(JTP)
0222                         DO 542 J=1,5
0223                                 K(I+1,J)=0
0224                                 V(I+1,J)=0
0225 542                     CONTINUE
0226                         I0=I
0227                         IF(IEX.EQ.1) I0=NPJ(JTP)-I+1
0228 C                               ********reverse the order of jets
0229                         KK1=KFPJ(JTP,I0)
0230                         K(I+1,1)=2
0231                         K(I+1,2)=KK1
0232                         IF(KK1.NE.21 .AND. KK1.NE.0)  K(I+1,1)=
0233      &                    1+(ABS(KK1)+(2*IEX-1)*KK1)/2/ABS(KK1)
0234                         P(I+1,1)=PJPX(JTP,I0)
0235                         P(I+1,2)=PJPY(JTP,I0)
0236                         P(I+1,3)=PJPZ(JTP,I0)
0237                         P(I+1,4)=PJPE(JTP,I0)
0238                         P(I+1,5)=PJPM(JTP,I0)
0239 540             CONTINUE
0240                 N=N+NPJ(JTP)
0241         ELSE IF(NTP.EQ.2.AND.NTJ(JTP).NE.0) THEN
0242                 JETOT=NTJ(JTP)
0243 c               IF(NTJ(JTP).GE.2)  CALL HIJSRT(JTP,2)
0244 C                       ********sort jets in order of y
0245                 IEX=1
0246                 IF((ABS(KF2).GT.1000.AND.KF2.LT.0)
0247      &                  .OR.(ABS(KF2).LT.1000.AND.KF2.GT.0)) IEX=0
0248                 DO 560 I=N,2,-1
0249                 DO 560 J=1,5
0250                         II=NTJ(JTP)+I
0251                         K(II,J)=K(I,J)
0252                         P(II,J)=P(I,J)
0253                         V(II,J)=V(I,J)
0254 560             CONTINUE
0255                 DO 580 I=1,NTJ(JTP)
0256                         DO 582 J=1,5
0257                                 K(I+1,J)=0
0258                                 V(I+1,J)=0
0259 582                     CONTINUE
0260                         I0=I
0261                         IF(IEX.EQ.1) I0=NTJ(JTP)-I+1
0262 C                               ********reverse the order of jets
0263                         KK1=KFTJ(JTP,I0)
0264                         K(I+1,1)=2
0265                         K(I+1,2)=KK1
0266                         IF(KK1.NE.21 .AND. KK1.NE.0) K(I+1,1)=
0267      &                     1+(ABS(KK1)+(2*IEX-1)*KK1)/2/ABS(KK1)
0268                         P(I+1,1)=PJTX(JTP,I0)
0269                         P(I+1,2)=PJTY(JTP,I0)
0270                         P(I+1,3)=PJTZ(JTP,I0)
0271                         P(I+1,4)=PJTE(JTP,I0)
0272                         P(I+1,5)=PJTM(JTP,I0)
0273 580             CONTINUE
0274                 N=N+NTJ(JTP)
0275         ENDIF
0276         IF(IHPR2(1).GT.0.AND.ATL_RAN(NSEED).LE.HIDAT(3)) THEN
0277              HIDAT20=HIDAT(2)
0278              HIPR150=HIPR1(5)
0279              IF(IHPR2(8).EQ.0.AND.IHPR2(3).EQ.0.AND.IHPR2(9).EQ.0)
0280      &                  HIDAT(2)=2.0
0281              IF(HINT1(1).GE.1000.0.AND.JETOT.EQ.0)THEN
0282                 HIDAT(2)=3.0
0283                 HIPR1(5)=5.0
0284              ENDIF
0285              CALL ATTRAD(IERROR)
0286              HIDAT(2)=HIDAT20
0287              HIPR1(5)=HIPR150
0288         ELSE IF(JETOT.EQ.0.AND.IHPR2(1).GT.0.AND.
0289      &                       HINT1(1).GE.1000.0.AND.
0290      &          ATL_RAN(NSEED).LE.0.8) THEN
0291                 HIDAT20=HIDAT(2)
0292                 HIPR150=HIPR1(5)
0293                 HIDAT(2)=3.0
0294                 HIPR1(5)=5.0
0295              IF(IHPR2(8).EQ.0.AND.IHPR2(3).EQ.0.AND.IHPR2(9).EQ.0)
0296      &                  HIDAT(2)=2.0
0297                 CALL ATTRAD(IERROR)
0298                 HIDAT(2)=HIDAT20
0299                 HIPR1(5)=HIPR150
0300         ENDIF
0301         IF(IERROR.NE.0) RETURN
0302 C               ******** conduct soft radiations
0303 C****************************
0304 C
0305 C
0306 C       CALL LULIST(1)
0307         CALL LUEXEC
0308         RETURN
0309
0310 1000    N=1
0311         K(1,1)=1
0312         K(1,2)=NFP(JTP,3)
0313         DO 1100 JJ=1,5
0314                 P(1,JJ)=PP(JTP,JJ)
0315 C BAC+++
0316 C
0317 C       Clear the starting point information in the Pythia arrays
0318 C
0319                 V(1,JJ)=0
0320 C BAC---
0321
0322 1100            CONTINUE
0323 C                       ********proj remain as a nucleon or delta
0324         CALL LUEXEC
0325 C       call lulist(1)
0326         RETURN
0327 C
0328 1200    N=1
0329         K(1,1)=1
0330         K(1,2)=NFT(JTP,3)
0331         DO 1300 JJ=1,5
0332                 P(1,JJ)=PT(JTP,JJ)
0333 C BAC+++
0334 C
0335 C       Clear the starting point information in the Pythia arrays
0336 C
0337                 V(1,JJ)=0
0338 C BAC---
0339
0340 1300    CONTINUE
0341 C                       ********targ remain as a nucleon or delta
0342         CALL LUEXEC
0343 C       call lulist(1)
0344         RETURN
0345         END