HIJING/hijing1_36/hijhrd.F

   1 * $Id$
   2 C
   3 C
   4 C
   5         SUBROUTINE HIJHRD(JP,JT,JOUT,JFLG,IOPJET0)
   6 C
   7 C       IOPTJET=1, ALL JET WILL FORM SINGLE STRING SYSTEM
   8 C               0, ONLY Q-QBAR JET FORM SINGLE STRING SYSTEM
   9 C*******Perform jets production and fragmentation when JP JT *******
  10 C     scatter. JOUT-> number of hard scatterings precede this one  *
  11 C     for the the same pair(JP,JT). JFLG->a flag to show whether   *
  12 C     jets can be produced (with valence quark=1,gluon=2, q-qbar=3)*
  13 C     or not(0). Information of jets are in  COMMON/ATTJET and     *
  14 C     /MINJET. ABS(NFP(JP,6)) is the total number jets produced by *
  15 C    JP. If NFP(JP,6)<0 JP can not produce jet anymore.            *
  16 C*******************************************************************
  17         DIMENSION IP(100,2),IPQ(50),IPB(50),IT(100,2),ITQ(50),ITB(50)
  18 #include "hijcrdn.inc"
  19 #include "hiparnt.inc"
  20 #include "hijdat.inc"
  21 #include "histrng.inc"
  22 #include "hijjet1.inc"
  23 #include "hijjet2.inc"
  24 #include "hijjet4.inc"
  25 C************************************ HIJING common block
  26 #include "lujets_hijing.inc"
  27 #include "ludat1_hijing.inc"
  28 #include "pysubs_hijing.inc"
  29 #include "pypars_hijing.inc"
  30 #include "pyint1_hijing.inc"
  31 #include "pyint2_hijing.inc"
  32 #include "pyint5_hijing.inc"
  33 #include "hipyint.inc"
  34         SAVE
  35 C*********************************** LU common block
  36         MXJT=500
  37 C               SIZE OF COMMON BLOCK FOR # OF PARTON PER STRING
  38         MXSG=900
  39 C               SIZE OF COMMON BLOCK FOR # OF SINGLE STRINGS
  40         MXSJ=100
  41 C               SIZE OF COMMON BLOCK FOR # OF PARTON PER SINGLE
  42 C               STRING
  43         JFLG=0
  44         IHNT2(11)=JP
  45         IHNT2(12)=JT
  46 C
  47         IOPJET=IOPJET0
  48         IF(IOPJET.EQ.1.AND.(NFP(JP,6).NE.0.OR.NFT(JT,6).NE.0))
  49      &                   IOPJET=0
  50         IF(JP.GT.IHNT2(1) .OR. JT.GT.IHNT2(3)) RETURN
  51         IF(NFP(JP,6).LT.0 .OR. NFT(JT,6).LT.0) RETURN
  52 C               ******** JP or JT can not produce jet anymore
  53 C
  54         IF(JOUT.EQ.0) THEN
  55                 EPP=PP(JP,4)+PP(JP,3)
  56                 EPM=PP(JP,4)-PP(JP,3)
  57                 ETP=PT(JT,4)+PT(JT,3)
  58                 ETM=PT(JT,4)-PT(JT,3)
  59                 IF(EPP.LT.0.0) GO TO 1000
  60                 IF(EPM.LT.0.0) GO TO 1000
  61                 IF(ETP.LT.0.0) GO TO 1000
  62                 IF(ETM.LT.0.0) GO TO 1000
  63                 IF(EPP/(EPM+0.01).LE.ETP/(ETM+0.01)) RETURN
  64         ENDIF
  65 C               ********for the first hard scattering of (JP,JT)
  66 C                       have collision only when Ycm(JP)>Ycm(JT)
  67
  68         ECUT1=HIPR1(1)+HIPR1(8)+PP(JP,14)+PP(JP,15)
  69         ECUT2=HIPR1(1)+HIPR1(8)+PT(JT,14)+PT(JT,15)
  70         IF(PP(JP,4).LE.ECUT1) THEN
  71                 NFP(JP,6)=-ABS(NFP(JP,6))
  72                 RETURN
  73         ENDIF
  74         IF(PT(JT,4).LE.ECUT2) THEN
  75                 NFT(JT,6)=-ABS(NFT(JT,6))
  76                 RETURN
  77         ENDIF
  78 C               *********must have enough energy to produce jets
  79
  80         MISS=0
  81         MISP=0
  82         MIST=0
  83 C
  84         IF(NFP(JP,10).EQ.0 .AND. NFT(JT,10).EQ.0) THEN
  85                 MINT(44)=MINT4
  86                 MINT(45)=MINT5
  87                 XSEC(0,1)=ATXS(0)
  88                 XSEC(11,1)=ATXS(11)
  89                 XSEC(12,1)=ATXS(12)
  90                 XSEC(28,1)=ATXS(28)
  91                 DO 120 I=1,20
  92                 COEF(11,I)=ATCO(11,I)
  93                 COEF(12,I)=ATCO(12,I)
  94                 COEF(28,I)=ATCO(28,I)
  95 120             CONTINUE
  96         ELSE
  97                 ISUB11=0
  98                 ISUB12=0
  99                 ISUB28=0
 100                 IF(XSEC(11,1).NE.0) ISUB11=1
 101                 IF(XSEC(12,1).NE.0) ISUB12=1
 102                 IF(XSEC(28,1).NE.0) ISUB28=1
 103                 MINT(44)=MINT4-ISUB11-ISUB12-ISUB28
 104                 MINT(45)=MINT5-ISUB11-ISUB12-ISUB28
 105                 XSEC(0,1)=ATXS(0)-ATXS(11)-ATXS(12)-ATXS(28)
 106                 XSEC(11,1)=0.0
 107                 XSEC(12,1)=0.0
 108                 XSEC(28,1)=0.0
 109                 DO 110 I=1,20
 110                 COEF(11,I)=0.0
 111                 COEF(12,I)=0.0
 112                 COEF(28,I)=0.0
 113 110             CONTINUE
 114         ENDIF
 115 C       ********Scatter the valence quarks only once per NN
 116 C       collision,
 117 C               afterwards only gluon can have hard scattering.
 118  155    CALL PYTHIA_HIJING
 119         JJ=MINT(31)
 120         IF(JJ.NE.1) GO TO 155
 121 C               *********one hard collision at a time
 122         IF(K(7,2).EQ.-K(8,2)) THEN
 123                 QMASS2=(P(7,4)+P(8,4))**2-(P(7,1)+P(8,1))**2
 124      &                  -(P(7,2)+P(8,2))**2-(P(7,3)+P(8,3))**2
 125                 QM=ULMASS_HIJING(K(7,2))
 126                 IF(QMASS2.LT.(2.0*QM+HIPR1(1))**2) GO TO 155
 127         ENDIF
 128 C               ********q-qbar jets must has minimum mass HIPR1(1)
 129         PXP=PP(JP,1)-P(3,1)
 130         PYP=PP(JP,2)-P(3,2)
 131         PZP=PP(JP,3)-P(3,3)
 132         PEP=PP(JP,4)-P(3,4)
 133         PXT=PT(JT,1)-P(4,1)
 134         PYT=PT(JT,2)-P(4,2)
 135         PZT=PT(JT,3)-P(4,3)
 136         PET=PT(JT,4)-P(4,4)
 137
 138         IF(PEP.LE.ECUT1) THEN
 139                 MISP=MISP+1
 140                 IF(MISP.LT.50) GO TO 155
 141                 NFP(JP,6)=-ABS(NFP(JP,6))
 142                 RETURN
 143         ENDIF
 144         IF(PET.LE.ECUT2) THEN
 145                 MIST=MIST+1
 146                 IF(MIST.LT.50) GO TO 155
 147                 NFT(JT,6)=-ABS(NFT(JT,6))
 148                 RETURN
 149         ENDIF
 150 C               ******** if the remain energy<ECUT the proj or targ
 151 C                        can not produce jet anymore
 152
 153         WP=PEP+PZP+PET+PZT
 154         WM=PEP-PZP+PET-PZT
 155         IF(WP.LT.0.0 .OR. WM.LT.0.0) THEN
 156                 MISS=MISS+1
 157                 IF(MISS.LT.50) GO TO 155
 158                 RETURN
 159         ENDIF
 160 C               ********the total W+, W- must be positive
 161         SW=WP*WM
 162         AMPX=SQRT((ECUT1-HIPR1(8))**2+PXP**2+PYP**2+0.01)
 163         AMTX=SQRT((ECUT2-HIPR1(8))**2+PXT**2+PYT**2+0.01)
 164         SXX=(AMPX+AMTX)**2
 165         IF(SW.LT.SXX.OR.VINT(43).LT.HIPR1(1)) THEN
 166                 MISS=MISS+1
 167                 IF(MISS.LT.50) GO TO 155
 168                 RETURN
 169         ENDIF
 170 C               ********the proj and targ remnants must have at least
 171 C                       a CM energy that can produce two strings
 172 C                       with minimum mass HIPR1(1)(see HIJSFT HIJFRG)
 173 C
 174         HINT1(41)=P(7,1)
 175         HINT1(42)=P(7,2)
 176         HINT1(43)=P(7,3)
 177         HINT1(44)=P(7,4)
 178         HINT1(45)=P(7,5)
 179         HINT1(46)=SQRT(P(7,1)**2+P(7,2)**2)
 180         HINT1(51)=P(8,1)
 181         HINT1(52)=P(8,2)
 182         HINT1(53)=P(8,3)
 183         HINT1(54)=P(8,4)
 184         HINT1(55)=P(8,5)
 185         HINT1(56)=SQRT(P(8,1)**2+P(8,2)**2)
 186         IHNT2(14)=K(7,2)
 187         IHNT2(15)=K(8,2)
 188 C
 189         PINIRAD=(1.0-EXP(-2.0*(VINT(47)-HIDAT(1))))
 190      &          /(1.0+EXP(-2.0*(VINT(47)-HIDAT(1))))
 191         I_INIRAD=0
 192         IF(RLU_HIJING(0).LE.PINIRAD) I_INIRAD=1
 193         IF(K(7,2).EQ.-K(8,2)) GO TO 190
 194         IF(K(7,2).EQ.21.AND.K(8,2).EQ.21.AND.IOPJET.EQ.1) GO TO 190
 195 C*******************************************************************
 196 C       gluon  jets are going to be connectd with
 197 C       the final leading string of quark-aintquark
 198 C*******************************************************************
 199         JFLG=2
 200         JPP=0
 201         LPQ=0
 202         LPB=0
 203         JTT=0
 204         LTQ=0
 205         LTB=0
 206         IS7=0
 207         IS8=0
 208         HINT1(47)=0.0
 209         HINT1(48)=0.0
 210         HINT1(49)=0.0
 211         HINT1(50)=0.0
 212         HINT1(67)=0.0
 213         HINT1(68)=0.0
 214         HINT1(69)=0.0
 215         HINT1(70)=0.0
 216         DO 180 I=9,N
 217            IF(K(I,3).EQ.1 .OR. K(I,3).EQ.2.OR.
 218      &                   ABS(K(I,2)).GT.30) GO TO 180
 219 C************************************************************
 220            IF(K(I,3).EQ.7) THEN
 221               HINT1(47)=HINT1(47)+P(I,1)
 222               HINT1(48)=HINT1(48)+P(I,2)
 223               HINT1(49)=HINT1(49)+P(I,3)
 224               HINT1(50)=HINT1(50)+P(I,4)
 225            ENDIF
 226            IF(K(I,3).EQ.8) THEN
 227               HINT1(67)=HINT1(67)+P(I,1)
 228               HINT1(68)=HINT1(68)+P(I,2)
 229               HINT1(69)=HINT1(69)+P(I,3)
 230               HINT1(70)=HINT1(70)+P(I,4)
 231            ENDIF
 232 C************************modifcation made on Apr 10. 1996*****
 233            IF(K(I,2).GT.21.AND.K(I,2).LE.30) THEN
 234               NDR=NDR+1
 235               IADR(NDR,1)=JP
 236               IADR(NDR,2)=JT
 237               KFDR(NDR)=K(I,2)
 238               PDR(NDR,1)=P(I,1)
 239               PDR(NDR,2)=P(I,2)
 240               PDR(NDR,3)=P(I,3)
 241               PDR(NDR,4)=P(I,4)
 242               PDR(NDR,5)=P(I,5)
 243 C************************************************************
 244               GO TO 180
 245 C************************correction made on Oct. 14,1994*****
 246            ENDIF
 247            IF(K(I,3).EQ.7.OR.K(I,3).EQ.3) THEN
 248               IF(K(I,3).EQ.7.AND.K(I,2).NE.21.AND.K(I,2).EQ.K(7,2)
 249      &               .AND.IS7.EQ.0) THEN
 250                  PP(JP,10)=P(I,1)
 251                  PP(JP,11)=P(I,2)
 252                  PP(JP,12)=P(I,3)
 253                  PZP=PZP+P(I,3)
 254                  PEP=PEP+P(I,4)
 255                  NFP(JP,10)=1
 256                  IS7=1
 257                  GO TO 180
 258               ENDIF
 259               IF(K(I,3).EQ.3.AND.(K(I,2).NE.21.OR.
 260      &                               I_INIRAD.EQ.0)) THEN
 261                  PXP=PXP+P(I,1)
 262                  PYP=PYP+P(I,2)
 263                  PZP=PZP+P(I,3)
 264                  PEP=PEP+P(I,4)
 265                  GO TO 180
 266               ENDIF
 267               JPP=JPP+1
 268               IP(JPP,1)=I
 269               IP(JPP,2)=0
 270               IF(K(I,2).NE.21) THEN
 271                  IF(K(I,2).GT.0) THEN
 272                     LPQ=LPQ+1
 273                     IPQ(LPQ)=JPP
 274                     IP(JPP,2)=LPQ
 275                  ELSE IF(K(I,2).LT.0) THEN
 276                     LPB=LPB+1
 277                     IPB(LPB)=JPP
 278                     IP(JPP,2)=-LPB
 279                  ENDIF
 280               ENDIF
 281            ELSE IF(K(I,3).EQ.8.OR.K(I,3).EQ.4) THEN
 282               IF(K(I,3).EQ.8.AND.K(I,2).NE.21.AND.K(I,2).EQ.K(8,2)
 283      &                          .AND.IS8.EQ.0) THEN
 284                  PT(JT,10)=P(I,1)
 285                  PT(JT,11)=P(I,2)
 286                  PT(JT,12)=P(I,3)
 287                  PZT=PZT+P(I,3)
 288                  PET=PET+P(I,4)
 289                  NFT(JT,10)=1
 290                  IS8=1
 291                  GO TO 180
 292               ENDIF
 293               IF(K(I,3).EQ.4.AND.(K(I,2).NE.21.OR.
 294      &                             I_INIRAD.EQ.0)) THEN
 295                  PXT=PXT+P(I,1)
 296                  PYT=PYT+P(I,2)
 297                  PZT=PZT+P(I,3)
 298                  PET=PET+P(I,4)
 299                  GO TO 180
 300               ENDIF
 301               JTT=JTT+1
 302               IT(JTT,1)=I
 303               IT(JTT,2)=0
 304               IF(K(I,2).NE.21) THEN
 305                  IF(K(I,2).GT.0) THEN
 306                     LTQ=LTQ+1
 307                     ITQ(LTQ)=JTT
 308                     IT(JTT,2)=LTQ
 309                  ELSE IF(K(I,2).LT.0) THEN
 310                     LTB=LTB+1
 311                     ITB(LTB)=JTT
 312                     IT(JTT,2)=-LTB
 313                  ENDIF
 314               ENDIF
 315            ENDIF
 316  180    CONTINUE
 317 c
 318 c
 319         IF(LPQ.NE.LPB .OR. LTQ.NE.LTB) THEN
 320                 MISS=MISS+1
 321                 IF(MISS.LE.50) GO TO 155
 322                 WRITE(6,*) ' Q -QBAR NOT MATCHED IN HIJHRD'
 323                 JFLG=0
 324                 RETURN
 325         ENDIF
 326 C****The following will rearrange the partons so that a quark is***
 327 C****allways followed by an anti-quark ****************************
 328
 329         J=0
 330 181     J=J+1
 331         IF(J.GT.JPP) GO TO 182
 332         IF(IP(J,2).EQ.0) THEN
 333                 GO TO 181
 334         ELSE IF(IP(J,2).NE.0) THEN
 335                 LP=ABS(IP(J,2))
 336                 IP1=IP(J,1)
 337                 IP2=IP(J,2)
 338                 IP(J,1)=IP(IPQ(LP),1)
 339                 IP(J,2)=IP(IPQ(LP),2)
 340                 IP(IPQ(LP),1)=IP1
 341                 IP(IPQ(LP),2)=IP2
 342                 IF(IP2.GT.0) THEN
 343                         IPQ(IP2)=IPQ(LP)
 344                 ELSE IF(IP2.LT.0) THEN
 345                         IPB(-IP2)=IPQ(LP)
 346                 ENDIF
 347 C               ********replace J with a quark
 348                 IP1=IP(J+1,1)
 349                 IP2=IP(J+1,2)
 350                 IP(J+1,1)=IP(IPB(LP),1)
 351                 IP(J+1,2)=IP(IPB(LP),2)
 352                 IP(IPB(LP),1)=IP1
 353                 IP(IPB(LP),2)=IP2
 354                 IF(IP2.GT.0) THEN
 355                         IPQ(IP2)=IPB(LP)
 356                 ELSE IF(IP2.LT.0) THEN
 357                         IPB(-IP2)=IPB(LP)
 358                 ENDIF
 359 C               ******** replace J+1 with anti-quark
 360                 J=J+1
 361                 GO TO 181
 362         ENDIF
 363
 364 182     J=0
 365 183     J=J+1
 366         IF(J.GT.JTT) GO TO 184
 367         IF(IT(J,2).EQ.0) THEN
 368                 GO TO 183
 369         ELSE IF(IT(J,2).NE.0) THEN
 370                 LT=ABS(IT(J,2))
 371                 IT1=IT(J,1)
 372                 IT2=IT(J,2)
 373                 IT(J,1)=IT(ITQ(LT),1)
 374                 IT(J,2)=IT(ITQ(LT),2)
 375                 IT(ITQ(LT),1)=IT1
 376                 IT(ITQ(LT),2)=IT2
 377                 IF(IT2.GT.0) THEN
 378                         ITQ(IT2)=ITQ(LT)
 379                 ELSE IF(IT2.LT.0) THEN
 380                         ITB(-IT2)=ITQ(LT)
 381                 ENDIF
 382 C               ********replace J with a quark
 383                 IT1=IT(J+1,1)
 384                 IT2=IT(J+1,2)
 385                 IT(J+1,1)=IT(ITB(LT),1)
 386                 IT(J+1,2)=IT(ITB(LT),2)
 387                 IT(ITB(LT),1)=IT1
 388                 IT(ITB(LT),2)=IT2
 389                 IF(IT2.GT.0) THEN
 390                         ITQ(IT2)=ITB(LT)
 391                 ELSE IF(IT2.LT.0) THEN
 392                         ITB(-IT2)=ITB(LT)
 393                 ENDIF
 394 C               ******** replace J+1 with anti-quark
 395                 J=J+1
 396                 GO TO 183
 397
 398         ENDIF
 399
 400 184     CONTINUE
 401         IF(NPJ(JP)+JPP.GT.MXJT.OR.NTJ(JT)+JTT.GT.MXJT) THEN
 402                 JFLG=0
 403                 WRITE(6,*) 'number of partons per string exceeds'
 404                 WRITE(6,*) 'the common block size'
 405                 RETURN
 406         ENDIF
 407 C                       ********check the bounds of common blocks
 408         DO 186 J=1,JPP
 409                 KFPJ(JP,NPJ(JP)+J)=K(IP(J,1),2)
 410                 PJPX(JP,NPJ(JP)+J)=P(IP(J,1),1)
 411                 PJPY(JP,NPJ(JP)+J)=P(IP(J,1),2)
 412                 PJPZ(JP,NPJ(JP)+J)=P(IP(J,1),3)
 413                 PJPE(JP,NPJ(JP)+J)=P(IP(J,1),4)
 414                 PJPM(JP,NPJ(JP)+J)=P(IP(J,1),5)
 415 186     CONTINUE
 416         NPJ(JP)=NPJ(JP)+JPP
 417         DO 188 J=1,JTT
 418                 KFTJ(JT,NTJ(JT)+J)=K(IT(J,1),2)
 419                 PJTX(JT,NTJ(JT)+J)=P(IT(J,1),1)
 420                 PJTY(JT,NTJ(JT)+J)=P(IT(J,1),2)
 421                 PJTZ(JT,NTJ(JT)+J)=P(IT(J,1),3)
 422                 PJTE(JT,NTJ(JT)+J)=P(IT(J,1),4)
 423                 PJTM(JT,NTJ(JT)+J)=P(IT(J,1),5)
 424 188     CONTINUE
 425         NTJ(JT)=NTJ(JT)+JTT
 426         GO TO 900
 427 C*****************************************************************
 428 CThis is the case of a quark-antiquark jet it will fragment alone
 429 C****************************************************************
 430 190     JFLG=3
 431         IF(K(7,2).NE.21.AND.K(8,2).NE.21.AND.
 432      &                   K(7,2)*K(8,2).GT.0) GO TO 155
 433         JPP=0
 434         LPQ=0
 435         LPB=0
 436         DO 200 I=9,N
 437            IF(K(I,3).EQ.1.OR.K(I,3).EQ.2.OR.
 438      &                  ABS(K(I,2)).GT.30) GO TO 200
 439                 IF(K(I,2).GT.21.AND.K(I,2).LE.30) THEN
 440                         NDR=NDR+1
 441                         IADR(NDR,1)=JP
 442                         IADR(NDR,2)=JT
 443                         KFDR(NDR)=K(I,2)
 444                         PDR(NDR,1)=P(I,1)
 445                         PDR(NDR,2)=P(I,2)
 446                         PDR(NDR,3)=P(I,3)
 447                         PDR(NDR,4)=P(I,4)
 448                         PDR(NDR,5)=P(I,5)
 449 C************************************************************
 450                         GO TO 200
 451 C************************correction made on Oct. 14,1994*****
 452                 ENDIF
 453                 IF(K(I,3).EQ.3.AND.(K(I,2).NE.21.OR.
 454      &                              I_INIRAD.EQ.0)) THEN
 455                         PXP=PXP+P(I,1)
 456                         PYP=PYP+P(I,2)
 457                         PZP=PZP+P(I,3)
 458                         PEP=PEP+P(I,4)
 459                         GO TO 200
 460                 ENDIF
 461                 IF(K(I,3).EQ.4.AND.(K(I,2).NE.21.OR.
 462      &                                I_INIRAD.EQ.0)) THEN
 463                         PXT=PXT+P(I,1)
 464                         PYT=PYT+P(I,2)
 465                         PZT=PZT+P(I,3)
 466                         PET=PET+P(I,4)
 467                         GO TO 200
 468                 ENDIF
 469                 JPP=JPP+1
 470                 IP(JPP,1)=I
 471                 IP(JPP,2)=0
 472                 IF(K(I,2).NE.21) THEN
 473                         IF(K(I,2).GT.0) THEN
 474                                 LPQ=LPQ+1
 475                                 IPQ(LPQ)=JPP
 476                                 IP(JPP,2)=LPQ
 477                         ELSE IF(K(I,2).LT.0) THEN
 478                                 LPB=LPB+1
 479                                 IPB(LPB)=JPP
 480                                 IP(JPP,2)=-LPB
 481                         ENDIF
 482                 ENDIF
 483 200     CONTINUE
 484         IF(LPQ.NE.LPB) THEN
 485            MISS=MISS+1
 486            IF(MISS.LE.50) GO TO 155
 487            WRITE(6,*) LPQ,LPB, 'Q-QBAR NOT CONSERVED OR NOT MATCHED'
 488            JFLG=0
 489            RETURN
 490         ENDIF
 491
 492 C**** The following will rearrange the partons so that a quark is***
 493 C**** allways followed by an anti-quark ****************************
 494         J=0
 495 220     J=J+1
 496         IF(J.GT.JPP) GO TO 222
 497         IF(IP(J,2).EQ.0) GO TO 220
 498                 LP=ABS(IP(J,2))
 499                 IP1=IP(J,1)
 500                 IP2=IP(J,2)
 501                 IP(J,1)=IP(IPQ(LP),1)
 502                 IP(J,2)=IP(IPQ(LP),2)
 503                 IP(IPQ(LP),1)=IP1
 504                 IP(IPQ(LP),2)=IP2
 505                 IF(IP2.GT.0) THEN
 506                         IPQ(IP2)=IPQ(LP)
 507                 ELSE IF(IP2.LT.0) THEN
 508                         IPB(-IP2)=IPQ(LP)
 509                 ENDIF
 510                 IPQ(LP)=J
 511 C               ********replace J with a quark
 512                 IP1=IP(J+1,1)
 513                 IP2=IP(J+1,2)
 514                 IP(J+1,1)=IP(IPB(LP),1)
 515                 IP(J+1,2)=IP(IPB(LP),2)
 516                 IP(IPB(LP),1)=IP1
 517                 IP(IPB(LP),2)=IP2
 518                 IF(IP2.GT.0) THEN
 519                         IPQ(IP2)=IPB(LP)
 520                 ELSE IF(IP2.LT.0) THEN
 521                         IPB(-IP2)=IPB(LP)
 522                 ENDIF
 523 C               ******** replace J+1 with an anti-quark
 524                 IPB(LP)=J+1
 525                 J=J+1
 526                 GO TO 220
 527
 528 222     CONTINUE
 529         IF(LPQ.GE.1) THEN
 530                 DO 240 L0=2,LPQ
 531                         IP1=IP(2*L0-3,1)
 532                         IP2=IP(2*L0-3,2)
 533                         IP(2*L0-3,1)=IP(IPQ(L0),1)
 534                         IP(2*L0-3,2)=IP(IPQ(L0),2)
 535                         IP(IPQ(L0),1)=IP1
 536                         IP(IPQ(L0),2)=IP2
 537                         IF(IP2.GT.0) THEN
 538                                 IPQ(IP2)=IPQ(L0)
 539                         ELSE IF(IP2.LT.0) THEN
 540                                 IPB(-IP2)=IPQ(L0)
 541                         ENDIF
 542                         IPQ(L0)=2*L0-3
 543 C
 544                         IP1=IP(2*L0-2,1)
 545                         IP2=IP(2*L0-2,2)
 546                         IP(2*L0-2,1)=IP(IPB(L0),1)
 547                         IP(2*L0-2,2)=IP(IPB(L0),2)
 548                         IP(IPB(L0),1)=IP1
 549                         IP(IPB(L0),2)=IP2
 550                         IF(IP2.GT.0) THEN
 551                                 IPQ(IP2)=IPB(L0)
 552                         ELSE IF(IP2.LT.0) THEN
 553                                 IPB(-IP2)=IPB(L0)
 554                         ENDIF
 555                         IPB(L0)=2*L0-2
 556 240             CONTINUE
 557 C               ********move all the qqbar pair to the front of
 558 C                               the list, except the first pair
 559                 IP1=IP(2*LPQ-1,1)
 560                 IP2=IP(2*LPQ-1,2)
 561                 IP(2*LPQ-1,1)=IP(IPQ(1),1)
 562                 IP(2*LPQ-1,2)=IP(IPQ(1),2)
 563                 IP(IPQ(1),1)=IP1
 564                 IP(IPQ(1),2)=IP2
 565                 IF(IP2.GT.0) THEN
 566                         IPQ(IP2)=IPQ(1)
 567                 ELSE IF(IP2.LT.0) THEN
 568                         IPB(-IP2)=IPQ(1)
 569                 ENDIF
 570                 IPQ(1)=2*LPQ-1
 571 C               ********move the first quark to the beginning of
 572 C                               the last string system
 573                 IP1=IP(JPP,1)
 574                 IP2=IP(JPP,2)
 575                 IP(JPP,1)=IP(IPB(1),1)
 576                 IP(JPP,2)=IP(IPB(1),2)
 577                 IP(IPB(1),1)=IP1
 578                 IP(IPB(1),2)=IP2
 579                 IF(IP2.GT.0) THEN
 580                         IPQ(IP2)=IPB(1)
 581                 ELSE IF(IP2.LT.0) THEN
 582                         IPB(-IP2)=IPB(1)
 583                 ENDIF
 584                 IPB(1)=JPP
 585 C               ********move the first anti-quark to the end of the
 586 C                       last string system
 587         ENDIF
 588         IF(NSG.GE.MXSG) THEN
 589            JFLG=0
 590            WRITE(6,*) 'number of jets forming single strings exceeds'
 591            WRITE(6,*) 'the common block size'
 592            RETURN
 593         ENDIF
 594         IF(JPP.GT.MXSJ) THEN
 595            JFLG=0
 596            WRITE(6,*) 'number of partons per single jet system'
 597            WRITE(6,*) 'exceeds the common block size'
 598            RETURN
 599         ENDIF
 600 C               ********check the bounds of common block size
 601         NSG=NSG+1
 602         NJSG(NSG)=JPP
 603         IASG(NSG,1)=JP
 604         IASG(NSG,2)=JT
 605         IASG(NSG,3)=0
 606         DO 300 I=1,JPP
 607                 K1SG(NSG,I)=2
 608                 K2SG(NSG,I)=K(IP(I,1),2)
 609                 IF(K2SG(NSG,I).LT.0) K1SG(NSG,I)=1
 610                 PXSG(NSG,I)=P(IP(I,1),1)
 611                 PYSG(NSG,I)=P(IP(I,1),2)
 612                 PZSG(NSG,I)=P(IP(I,1),3)
 613                 PESG(NSG,I)=P(IP(I,1),4)
 614                 PMSG(NSG,I)=P(IP(I,1),5)
 615 300     CONTINUE
 616         K1SG(NSG,1)=2
 617         K1SG(NSG,JPP)=1
 618 C******* reset the energy-momentum of incoming particles ********
 619 900     PP(JP,1)=PXP
 620         PP(JP,2)=PYP
 621         PP(JP,3)=PZP
 622         PP(JP,4)=PEP
 623         PP(JP,5)=0.0
 624         PT(JT,1)=PXT
 625         PT(JT,2)=PYT
 626         PT(JT,3)=PZT
 627         PT(JT,4)=PET
 628         PT(JT,5)=0.0
 629
 630         NFP(JP,6)=NFP(JP,6)+1
 631         NFT(JT,6)=NFT(JT,6)+1
 632         RETURN
 633 C
 634 1000    JFLG=-1
 635         IF(IHPR2(10).EQ.0) RETURN
 636         WRITE(6,*) 'Fatal HIJHRD error'
 637         WRITE(6,*) JP, ' proj E+,E-',EPP,EPM,' status',NFP(JP,5)
 638         WRITE(6,*) JT, ' targ E+,E_',ETP,ETM,' status',NFT(JT,5)
 639         RETURN
 640         END