Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001 C
0002 C
0003 C
0004 C
0005         SUBROUTINE QUENCH(JPJT,NTP)
0006         DIMENSION RDP(300),LQP(300),RDT(300),LQT(300)
0007         COMMON/HIJCRDN/YP(3,300),YT(3,300)
0008         SAVE  /HIJCRDN/
0009         COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
0010         SAVE  /HIPARNT/
0011 C
0012         COMMON/HIJJET1/NPJ(300),KFPJ(300,500),PJPX(300,500),
0013      &                PJPY(300,500),PJPZ(300,500),PJPE(300,500),
0014      &                PJPM(300,500),NTJ(300),KFTJ(300,500),
0015      &                PJTX(300,500),PJTY(300,500),PJTZ(300,500),
0016      &                PJTE(300,500),PJTM(300,500)
0017         SAVE  /HIJJET1/
0018         COMMON/HIJJET2/NSG,NJSG(900),IASG(900,3),K1SG(900,100),
0019      &          K2SG(900,100),PXSG(900,100),PYSG(900,100),
0020      &          PZSG(900,100),PESG(900,100),PMSG(900,100)
0021         SAVE  /HIJJET2/
0022         COMMON/HISTRNG/NFP(300,15),PP(300,15),NFT(300,15),PT(300,15)
0023         SAVE  /HISTRNG/
0024         COMMON/RANSEED/NSEED
0025         SAVE  /RANSEED/
0026 C
0027         BB=HINT1(19)                                            ! Uzhi
0028         PHI=HINT1(20)                                           ! Uzhi
0029         BBX=BB*COS(PHI)                                         ! Uzhi
0030         BBY=BB*SIN(PHI)                                         ! Uzhi
0031 c
0032         IF(NTP.EQ.2) GO TO 400
0033         IF(NTP.EQ.3) GO TO 2000 
0034 C*******************************************************
0035 C Jet interaction for proj jet in the direction PHIP
0036 C******************************************************
0037 C
0038         IF(NFP(JPJT,7).NE.1) RETURN
0039 
0040         JP=JPJT
0041         DO 290 I=1,NPJ(JP)
0042            PTJET0=SQRT(PJPX(JP,I)**2+PJPY(JP,I)**2)
0043            IF(PTJET0.LE.HIPR1(11)) GO TO 290
0044            PTOT=SQRT(PTJET0*PTJET0+PJPZ(JP,I)**2)
0045            IF(PTOT.LT.HIPR1(8)) GO TO 290
0046            PHIP=ULANGL(PJPX(JP,I),PJPY(JP,I))
0047 C******* find the wounded proj which can interact with jet***
0048            KP=0
0049            DO 100 I2=1,IHNT2(1)
0050               IF(NFP(I2,5).NE.3 .OR. I2.EQ.JP) GO TO 100
0051               DX=YP(1,I2)-YP(1,JP)
0052               DY=YP(2,I2)-YP(2,JP)
0053               PHI=ULANGL(DX,DY)
0054               DPHI=ABS(PHI-PHIP)
0055               IF(DPHI.GE.HIPR1(40)) DPHI=2.*HIPR1(40)-DPHI      ! Uzhi
0056               IF(DPHI.GE.HIPR1(40)/2.0) GO TO 100
0057               RD0=SQRT(DX*DX+DY*DY)
0058               IF(RD0*SIN(DPHI).GT.HIPR1(12)) GO TO 100
0059               KP=KP+1
0060               LQP(KP)=I2
0061               RDP(KP)=COS(DPHI)*RD0
0062  100       CONTINUE
0063 C*******        rearrange according decending rd************
0064            DO 110 I2=1,KP-1
0065               DO 110 J2=I2+1,KP
0066                  IF(RDP(I2).LT.RDP(J2)) GO TO 110
0067                  RD=RDP(I2)
0068                  LQ=LQP(I2)
0069                  RDP(I2)=RDP(J2)
0070                  LQP(I2)=LQP(J2)
0071                  RDP(J2)=RD
0072                  LQP(J2)=LQ
0073  110          CONTINUE
0074 C****** find wounded targ which can interact with jet********
0075               KT=0
0076               DO 120 I2=1,IHNT2(3)
0077                  IF(NFT(I2,5).NE.3) GO TO 120
0078                  DX=YT(1,I2)-YP(1,JP)-BBX
0079                  DY=YT(2,I2)-YP(2,JP)-BBY
0080                  PHI=ULANGL(DX,DY)
0081                  DPHI=ABS(PHI-PHIP)
0082                  IF(DPHI.GE.HIPR1(40)) DPHI=2.*HIPR1(40)-DPHI   ! Uzhi
0083                  IF(DPHI.GT.HIPR1(40)/2.0) GO TO 120
0084                  RD0=SQRT(DX*DX+DY*DY)
0085                  IF(RD0*SIN(DPHI).GT.HIPR1(12)) GO TO 120
0086                  KT=KT+1
0087                  LQT(KT)=I2
0088                  RDT(KT)=COS(DPHI)*RD0
0089  120          CONTINUE
0090 C*******        rearrange according decending rd************
0091               DO 130 I2=1,KT-1
0092                  DO 130 J2=I2+1,KT
0093                     IF(RDT(I2).LT.RDT(J2)) GO TO 130
0094                     RD=RDT(I2)
0095                     LQ=LQT(I2)
0096                     RDT(I2)=RDT(J2)
0097                     LQT(I2)=LQT(J2)
0098                     RDT(J2)=RD
0099                     LQT(J2)=LQ
0100  130             CONTINUE
0101                 
0102                  MP=0
0103                  MT=0
0104                  R0=0.0
0105                  NQ=0
0106                  DP=0.0
0107                  PTOT=SQRT(PJPX(JP,I)**2+PJPY(JP,I)**2+PJPZ(JP,I)**2)
0108                  V1=PJPX(JP,I)/PTOT
0109                  V2=PJPY(JP,I)/PTOT
0110                  V3=PJPZ(JP,I)/PTOT
0111 
0112  200             RN=ATL_RAN(NSEED)
0113  210             IF(MT.GE.KT .AND. MP.GE.KP) GO TO 290
0114                  IF(MT.GE.KT) GO TO 220
0115                  IF(MP.GE.KP) GO TO 240
0116                  IF(RDP(MP+1).GT.RDT(MT+1)) GO TO 240
0117  220             MP=MP+1
0118                  DRR=RDP(MP)-R0
0119                  IF(RN.GE.1.0-EXP(-DRR/HIPR1(13))) GO TO 210
0120                  DP=DRR*HIPR1(14)
0121                  IF(KFPJ(JP,I).NE.21) DP=0.5*DP
0122 C       ********string tension of quark jet is 0.5 of gluon's 
0123                  IF(DP.LE.0.2) GO TO 210
0124                  IF(PTOT.LE.0.4) GO TO 290
0125                  IF(PTOT.LE.DP) DP=PTOT-0.2
0126                  DE=DP
0127 
0128                  IF(KFPJ(JP,I).NE.21) THEN
0129                     PRSHU=PP(LQP(MP),1)**2+PP(LQP(MP),2)**2
0130      &                   +PP(LQP(MP),3)**2
0131                     DE=SQRT(PJPM(JP,I)**2+PTOT**2)
0132      &                  -SQRT(PJPM(JP,I)**2+(PTOT-DP)**2)
0133                     ERSHU=(PP(LQP(MP),4)+DE-DP)**2
0134                     AMSHU=ERSHU-PRSHU
0135                     IF(AMSHU.LT.HIPR1(1)*HIPR1(1)) GO TO 210
0136                     PP(LQP(MP),4)=SQRT(ERSHU)
0137                     PP(LQP(MP),5)=SQRT(AMSHU)
0138                  ENDIF
0139 C               ********reshuffle the energy when jet has mass
0140                  R0=RDP(MP)
0141                  DP1=DP*V1
0142                  DP2=DP*V2
0143                  DP3=DP*V3
0144 C               ********momentum and energy transfer from jet
0145                  
0146                  NPJ(LQP(MP))=NPJ(LQP(MP))+1
0147                  KFPJ(LQP(MP),NPJ(LQP(MP)))=21
0148                  PJPX(LQP(MP),NPJ(LQP(MP)))=DP1
0149                  PJPY(LQP(MP),NPJ(LQP(MP)))=DP2
0150                  PJPZ(LQP(MP),NPJ(LQP(MP)))=DP3
0151                  PJPE(LQP(MP),NPJ(LQP(MP)))=DP
0152                  PJPM(LQP(MP),NPJ(LQP(MP)))=0.0
0153                  GO TO 260
0154 
0155  240             MT=MT+1
0156                  DRR=RDT(MT)-R0
0157                  IF(RN.GE.1.0-EXP(-DRR/HIPR1(13))) GO TO 210
0158                  DP=DRR*HIPR1(14)
0159                  IF(DP.LE.0.2) GO TO 210
0160                  IF(PTOT.LE.0.4) GO TO 290
0161                  IF(PTOT.LE.DP) DP=PTOT-0.2
0162                  DE=DP
0163 
0164                  IF(KFPJ(JP,I).NE.21) THEN
0165                     PRSHU=PT(LQT(MT),1)**2+PT(LQT(MT),2)**2
0166      &                   +PT(LQT(MT),3)**2
0167                     DE=SQRT(PJPM(JP,I)**2+PTOT**2)
0168      &                  -SQRT(PJPM(JP,I)**2+(PTOT-DP)**2)
0169                     ERSHU=(PT(LQT(MT),4)+DE-DP)**2
0170                     AMSHU=ERSHU-PRSHU
0171                     IF(AMSHU.LT.HIPR1(1)*HIPR1(1)) GO TO 210
0172                     PT(LQT(MT),4)=SQRT(ERSHU)
0173                     PT(LQT(MT),5)=SQRT(AMSHU)
0174                  ENDIF
0175 C               ********reshuffle the energy when jet has mass
0176 
0177                  R0=RDT(MT)
0178                  DP1=DP*V1
0179                  DP2=DP*V2
0180                  DP3=DP*V3
0181 C               ********momentum and energy transfer from jet
0182                  NTJ(LQT(MT))=NTJ(LQT(MT))+1
0183                  KFTJ(LQT(MT),NTJ(LQT(MT)))=21
0184                  PJTX(LQT(MT),NTJ(LQT(MT)))=DP1
0185                  PJTY(LQT(MT),NTJ(LQT(MT)))=DP2
0186                  PJTZ(LQT(MT),NTJ(LQT(MT)))=DP3
0187                  PJTE(LQT(MT),NTJ(LQT(MT)))=DP
0188                  PJTM(LQT(MT),NTJ(LQT(MT)))=0.0
0189 
0190  260             PJPX(JP,I)=(PTOT-DP)*V1
0191                  PJPY(JP,I)=(PTOT-DP)*V2
0192                  PJPZ(JP,I)=(PTOT-DP)*V3
0193                  PJPE(JP,I)=PJPE(JP,I)-DE
0194 
0195                  PTOT=PTOT-DP
0196                  NQ=NQ+1
0197                  GO TO 200
0198  290          CONTINUE
0199 
0200               RETURN
0201 
0202 C*******************************************************
0203 C Jet interaction for target jet in the direction PHIT
0204 C******************************************************
0205 C
0206 C******* find the wounded proj which can interact with jet***
0207 
0208  400          IF(NFT(JPJT,7).NE.1) RETURN
0209               JT=JPJT
0210               DO 690 I=1,NTJ(JT)
0211                  PTJET0=SQRT(PJTX(JT,I)**2+PJTY(JT,I)**2)
0212                  IF(PTJET0.LE.HIPR1(11)) GO TO 690
0213                  PTOT=SQRT(PTJET0*PTJET0+PJTZ(JT,I)**2)
0214                  IF(PTOT.LT.HIPR1(8)) GO TO 690
0215                  PHIT=ULANGL(PJTX(JT,I),PJTY(JT,I))
0216                  KP=0
0217                  DO 500 I2=1,IHNT2(1)
0218                     IF(NFP(I2,5).NE.3) GO TO 500
0219                     DX=YP(1,I2)+BBX-YT(1,JT)
0220                     DY=YP(2,I2)+BBY-YT(2,JT)
0221                     PHI=ULANGL(DX,DY)
0222                     DPHI=ABS(PHI-PHIT)
0223                     IF(DPHI.GE.HIPR1(40)) DPHI=2.*HIPR1(40)-DPHI ! Uzhi
0224                     IF(DPHI.GT.HIPR1(40)/2.0) GO TO 500
0225                     RD0=SQRT(DX*DX+DY*DY)
0226                     IF(RD0*SIN(DPHI).GT.HIPR1(12)) GO TO 500
0227                     KP=KP+1
0228                     LQP(KP)=I2
0229                     RDP(KP)=COS(DPHI)*RD0
0230  500             CONTINUE
0231 C*******        rearrange according to decending rd************
0232                  DO 510 I2=1,KP-1
0233                     DO 510 J2=I2+1,KP
0234                        IF(RDP(I2).LT.RDP(J2)) GO TO 510
0235                        RD=RDP(I2)
0236                        LQ=LQP(I2)
0237                        RDP(I2)=RDP(J2)
0238                        LQP(I2)=LQP(J2)
0239                        RDP(J2)=RD
0240                        LQP(J2)=LQ
0241  510                CONTINUE
0242 C****** find wounded targ which can interact with jet********
0243                     KT=0
0244                     DO 520 I2=1,IHNT2(3)
0245                        IF(NFT(I2,5).NE.3 .OR. I2.EQ.JT) GO TO 520
0246                        DX=YT(1,I2)-YT(1,JT)
0247                        DY=YT(2,I2)-YT(2,JT)
0248                        PHI=ULANGL(DX,DY)
0249                        DPHI=ABS(PHI-PHIT)
0250                        IF(DPHI.GE.HIPR1(40)) DPHI=2.*HIPR1(40)-DPHI ! Uzhi
0251                        IF(DPHI.GT.HIPR1(40)/2.0) GO TO 520
0252                        RD0=SQRT(DX*DX+DY*DY)
0253                        IF(RD0*SIN(DPHI).GT.HIPR1(12)) GO TO 520
0254                        KT=KT+1
0255                        LQT(KT)=I2
0256                        RDT(KT)=COS(DPHI)*RD0
0257  520                CONTINUE
0258 C*******        rearrange according to decending rd************
0259                     DO 530 I2=1,KT-1
0260                        DO 530 J2=I2+1,KT
0261                           IF(RDT(I2).LT.RDT(J2)) GO TO 530
0262                           RD=RDT(I2)
0263                           LQ=LQT(I2)
0264                           RDT(I2)=RDT(J2)
0265                           LQT(I2)=LQT(J2)
0266                           RDT(J2)=RD
0267                           LQT(J2)=LQ
0268  530                   CONTINUE
0269                        
0270                        MP=0
0271                        MT=0
0272                        NQ=0
0273                        DP=0.0
0274                        R0=0.0
0275                 PTOT=SQRT(PJTX(JT,I)**2+PJTY(JT,I)**2+PJTZ(JT,I)**2)
0276                 V1=PJTX(JT,I)/PTOT
0277                 V2=PJTY(JT,I)/PTOT
0278                 V3=PJTZ(JT,I)/PTOT
0279 
0280  600            RN=ATL_RAN(NSEED)
0281  610            IF(MT.GE.KT .AND. MP.GE.KP) GO TO 690
0282                 IF(MT.GE.KT) GO TO 620
0283                 IF(MP.GE.KP) GO TO 640
0284                 IF(RDP(MP+1).GT.RDT(MT+1)) GO TO 640
0285 620             MP=MP+1
0286                 DRR=RDP(MP)-R0
0287                 IF(RN.GE.1.0-EXP(-DRR/HIPR1(13))) GO TO 610
0288                 DP=DRR*HIPR1(14)
0289                 IF(KFTJ(JT,I).NE.21) DP=0.5*DP
0290 C       ********string tension of quark jet is 0.5 of gluon's 
0291                 IF(DP.LE.0.2) GO TO 610
0292                 IF(PTOT.LE.0.4) GO TO 690
0293                 IF(PTOT.LE.DP) DP=PTOT-0.2
0294                 DE=DP
0295 C
0296                 IF(KFTJ(JT,I).NE.21) THEN
0297                    PRSHU=PP(LQP(MP),1)**2+PP(LQP(MP),2)**2
0298      &                   +PP(LQP(MP),3)**2
0299                    DE=SQRT(PJTM(JT,I)**2+PTOT**2)
0300      &               -SQRT(PJTM(JT,I)**2+(PTOT-DP)**2)
0301                    ERSHU=(PP(LQP(MP),4)+DE-DP)**2
0302                    AMSHU=ERSHU-PRSHU
0303                    IF(AMSHU.LT.HIPR1(1)*HIPR1(1)) GO TO 610
0304                    PP(LQP(MP),4)=SQRT(ERSHU)
0305                    PP(LQP(MP),5)=SQRT(AMSHU)
0306                 ENDIF
0307 C               ********reshuffle the energy when jet has mass
0308 C
0309                 R0=RDP(MP)
0310                 DP1=DP*V1
0311                 DP2=DP*V2
0312                 DP3=DP*V3
0313 C               ********momentum and energy transfer from jet
0314                 NPJ(LQP(MP))=NPJ(LQP(MP))+1
0315                 KFPJ(LQP(MP),NPJ(LQP(MP)))=21
0316                 PJPX(LQP(MP),NPJ(LQP(MP)))=DP1
0317                 PJPY(LQP(MP),NPJ(LQP(MP)))=DP2
0318                 PJPZ(LQP(MP),NPJ(LQP(MP)))=DP3
0319                 PJPE(LQP(MP),NPJ(LQP(MP)))=DP
0320                 PJPM(LQP(MP),NPJ(LQP(MP)))=0.0
0321 
0322                 GO TO 660
0323 
0324 640             MT=MT+1
0325                 DRR=RDT(MT)-R0
0326                 IF(RN.GE.1.0-EXP(-DRR/HIPR1(13))) GO TO 610
0327                 DP=DRR*HIPR1(14)
0328                 IF(DP.LE.0.2) GO TO 610
0329                 IF(PTOT.LE.0.4) GO TO 690
0330                 IF(PTOT.LE.DP) DP=PTOT-0.2
0331                 DE=DP
0332 
0333                 IF(KFTJ(JT,I).NE.21) THEN
0334                    PRSHU=PT(LQT(MT),1)**2+PT(LQT(MT),2)**2
0335      &                   +PT(LQT(MT),3)**2
0336                    DE=SQRT(PJTM(JT,I)**2+PTOT**2)
0337      &               -SQRT(PJTM(JT,I)**2+(PTOT-DP)**2)
0338                    ERSHU=(PT(LQT(MT),4)+DE-DP)**2
0339                    AMSHU=ERSHU-PRSHU
0340                    IF(AMSHU.LT.HIPR1(1)*HIPR1(1)) GO TO 610
0341                    PT(LQT(MT),4)=SQRT(ERSHU)
0342                    PT(LQT(MT),5)=SQRT(AMSHU)
0343                 ENDIF
0344 C               ********reshuffle the energy when jet has mass
0345 
0346                 R0=RDT(MT)
0347                 DP1=DP*V1
0348                 DP2=DP*V2
0349                 DP3=DP*V3
0350 C               ********momentum and energy transfer from jet
0351                 NTJ(LQT(MT))=NTJ(LQT(MT))+1
0352                 KFTJ(LQT(MT),NTJ(LQT(MT)))=21
0353                 PJTX(LQT(MT),NTJ(LQT(MT)))=DP1
0354                 PJTY(LQT(MT),NTJ(LQT(MT)))=DP2
0355                 PJTZ(LQT(MT),NTJ(LQT(MT)))=DP3
0356                 PJTE(LQT(MT),NTJ(LQT(MT)))=DP
0357                 PJTM(LQT(MT),NTJ(LQT(MT)))=0.0
0358 
0359 660             PJTX(JT,I)=(PTOT-DP)*V1
0360                 PJTY(JT,I)=(PTOT-DP)*V2
0361                 PJTZ(JT,I)=(PTOT-DP)*V3
0362                 PJTE(JT,I)=PJTE(JT,I)-DE
0363 
0364                 PTOT=PTOT-DP
0365                 NQ=NQ+1
0366                 GO TO 600
0367 690     CONTINUE
0368         RETURN
0369 C********************************************************
0370 C       Q-QBAR jet interaction
0371 C********************************************************
0372 2000    ISG=JPJT
0373         IF(IASG(ISG,3).NE.1) RETURN
0374 C
0375         JP=IASG(ISG,1)
0376         JT=IASG(ISG,2)
0377         XJ=(YP(1,JP)+BBX+YT(1,JT))/2.0
0378         YJ=(YP(2,JP)+BBY+YT(2,JT))/2.0
0379         DO 2690 I=1,NJSG(ISG)
0380            PTJET0=SQRT(PXSG(ISG,I)**2+PYSG(ISG,I)**2)
0381            IF(PTJET0.LE.HIPR1(11).OR.PESG(ISG,I).LT.HIPR1(1))
0382      &            GO TO 2690
0383            PTOT=SQRT(PTJET0*PTJET0+PZSG(ISG,I)**2)
0384            IF(PTOT.LT.MAX(HIPR1(1),HIPR1(8))) GO TO 2690
0385            PHIQ=ULANGL(PXSG(ISG,I),PYSG(ISG,I))
0386            KP=0
0387            DO 2500 I2=1,IHNT2(1)
0388               IF(NFP(I2,5).NE.3.OR.I2.EQ.JP) GO TO 2500
0389               DX=YP(1,I2)+BBX-XJ
0390               DY=YP(2,I2)+BBY-YJ
0391               PHI=ULANGL(DX,DY)
0392               DPHI=ABS(PHI-PHIQ)
0393               IF(DPHI.GE.HIPR1(40)) DPHI=2.*HIPR1(40)-DPHI      ! Uzhi
0394               IF(DPHI.GT.HIPR1(40)/2.0) GO TO 2500
0395               RD0=SQRT(DX*DX+DY*DY)
0396               IF(RD0*SIN(DPHI).GT.HIPR1(12)) GO TO 2500
0397               KP=KP+1
0398               LQP(KP)=I2
0399               RDP(KP)=COS(DPHI)*RD0
0400  2500      CONTINUE
0401 C*******        rearrange according to decending rd************
0402            DO 2510 I2=1,KP-1
0403               DO 2510 J2=I2+1,KP
0404                  IF(RDP(I2).LT.RDP(J2)) GO TO 2510
0405                  RD=RDP(I2)
0406                  LQ=LQP(I2)
0407                  RDP(I2)=RDP(J2)
0408                  LQP(I2)=LQP(J2)
0409                  RDP(J2)=RD
0410                  LQP(J2)=LQ
0411  2510         CONTINUE
0412 C****** find wounded targ which can interact with jet********
0413               KT=0
0414               DO 2520 I2=1,IHNT2(3)
0415                  IF(NFT(I2,5).NE.3 .OR. I2.EQ.JT) GO TO 2520
0416                  DX=YT(1,I2)-XJ
0417                  DY=YT(2,I2)-YJ
0418                  PHI=ULANGL(DX,DY)
0419                  DPHI=ABS(PHI-PHIQ)
0420                  IF(DPHI.GE.HIPR1(40)) DPHI=2.*HIPR1(40)-DPHI ! Uzhi
0421                  IF(DPHI.GT.HIPR1(40)/2.0) GO TO 2520
0422                  RD0=SQRT(DX*DX+DY*DY)
0423                  IF(RD0*SIN(DPHI).GT.HIPR1(12)) GO TO 2520
0424                  KT=KT+1
0425                  LQT(KT)=I2
0426                  RDT(KT)=COS(DPHI)*RD0
0427  2520         CONTINUE
0428 C*******        rearrange according to decending rd************
0429               DO 2530 I2=1,KT-1
0430                  DO 2530 J2=I2+1,KT
0431                     IF(RDT(I2).LT.RDT(J2)) GO TO 2530
0432                     RD=RDT(I2)
0433                     LQ=LQT(I2)
0434                     RDT(I2)=RDT(J2)
0435                     LQT(I2)=LQT(J2)
0436                     RDT(J2)=RD
0437                     LQT(J2)=LQ
0438  2530            CONTINUE
0439                 
0440                  MP=0
0441                  MT=0
0442                  NQ=0
0443                  DP=0.0
0444                  R0=0.0
0445                  PTOT=SQRT(PXSG(ISG,I)**2+PYSG(ISG,I)**2
0446      &                +PZSG(ISG,I)**2)
0447                  V1=PXSG(ISG,I)/PTOT
0448                  V2=PYSG(ISG,I)/PTOT
0449                  V3=PZSG(ISG,I)/PTOT
0450 
0451  2600            RN=ATL_RAN(NSEED)
0452  2610            IF(MT.GE.KT .AND. MP.GE.KP) GO TO 2690
0453                  IF(MT.GE.KT) GO TO 2620
0454                  IF(MP.GE.KP) GO TO 2640
0455                  IF(RDP(MP+1).GT.RDT(MT+1)) GO TO 2640
0456  2620            MP=MP+1
0457                  DRR=RDP(MP)-R0
0458                  IF(RN.GE.1.0-EXP(-DRR/HIPR1(13))) GO TO 2610
0459                  DP=DRR*HIPR1(14)/2.0
0460                  IF(DP.LE.0.2) GO TO 2610
0461                  IF(PTOT.LE.0.4) GO TO 2690
0462                  IF(PTOT.LE.DP) DP=PTOT-0.2
0463                  DE=DP
0464 C
0465                  IF(K2SG(ISG,I).NE.21) THEN
0466                     IF(PTOT.LT.DP+HIPR1(1)) GO TO 2690
0467                     PRSHU=PP(LQP(MP),1)**2+PP(LQP(MP),2)**2
0468      &                    +PP(LQP(MP),3)**2
0469                     DE=SQRT(PMSG(ISG,I)**2+PTOT**2)
0470      &                 -SQRT(PMSG(ISG,I)**2+(PTOT-DP)**2)
0471                     ERSHU=(PP(LQP(MP),4)+DE-DP)**2
0472                     AMSHU=ERSHU-PRSHU
0473                     IF(AMSHU.LT.HIPR1(1)*HIPR1(1)) GO TO 2610
0474                     PP(LQP(MP),4)=SQRT(ERSHU)
0475                     PP(LQP(MP),5)=SQRT(AMSHU)
0476                  ENDIF
0477 C               ********reshuffle the energy when jet has mass
0478 C
0479                  R0=RDP(MP)
0480                  DP1=DP*V1
0481                  DP2=DP*V2
0482                  DP3=DP*V3
0483 C               ********momentum and energy transfer from jet
0484                  NPJ(LQP(MP))=NPJ(LQP(MP))+1
0485                  KFPJ(LQP(MP),NPJ(LQP(MP)))=21
0486                  PJPX(LQP(MP),NPJ(LQP(MP)))=DP1
0487                  PJPY(LQP(MP),NPJ(LQP(MP)))=DP2
0488                  PJPZ(LQP(MP),NPJ(LQP(MP)))=DP3
0489                  PJPE(LQP(MP),NPJ(LQP(MP)))=DP
0490                  PJPM(LQP(MP),NPJ(LQP(MP)))=0.0
0491 
0492                  GO TO 2660
0493 
0494  2640            MT=MT+1
0495                  DRR=RDT(MT)-R0
0496                  IF(RN.GE.1.0-EXP(-DRR/HIPR1(13))) GO TO 2610
0497                  DP=DRR*HIPR1(14)
0498                  IF(DP.LE.0.2) GO TO 2610
0499                  IF(PTOT.LE.0.4) GO TO 2690
0500                  IF(PTOT.LE.DP) DP=PTOT-0.2
0501                  DE=DP
0502 
0503                  IF(K2SG(ISG,I).NE.21) THEN
0504                     IF(PTOT.LT.DP+HIPR1(1)) GO TO 2690
0505                     PRSHU=PT(LQT(MT),1)**2+PT(LQT(MT),2)**2
0506      &                    +PT(LQT(MT),3)**2
0507                     DE=SQRT(PMSG(ISG,I)**2+PTOT**2)
0508      &                 -SQRT(PMSG(ISG,I)**2+(PTOT-DP)**2)
0509                     ERSHU=(PT(LQT(MT),4)+DE-DP)**2
0510                     AMSHU=ERSHU-PRSHU
0511                     IF(AMSHU.LT.HIPR1(1)*HIPR1(1)) GO TO 2610
0512                     PT(LQT(MT),4)=SQRT(ERSHU)
0513                     PT(LQT(MT),5)=SQRT(AMSHU)
0514                  ENDIF
0515 C               ********reshuffle the energy when jet has mass
0516 
0517                  R0=RDT(MT)
0518                  DP1=DP*V1
0519                  DP2=DP*V2
0520                  DP3=DP*V3
0521 C               ********momentum and energy transfer from jet
0522                  NTJ(LQT(MT))=NTJ(LQT(MT))+1
0523                  KFTJ(LQT(MT),NTJ(LQT(MT)))=21
0524                  PJTX(LQT(MT),NTJ(LQT(MT)))=DP1
0525                  PJTY(LQT(MT),NTJ(LQT(MT)))=DP2
0526                  PJTZ(LQT(MT),NTJ(LQT(MT)))=DP3
0527                  PJTE(LQT(MT),NTJ(LQT(MT)))=DP
0528                  PJTM(LQT(MT),NTJ(LQT(MT)))=0.0
0529 
0530  2660            PXSG(ISG,I)=(PTOT-DP)*V1
0531                  PYSG(ISG,I)=(PTOT-DP)*V2
0532                  PZSG(ISG,I)=(PTOT-DP)*V3
0533                  PESG(ISG,I)=PESG(ISG,I)-DE
0534 
0535                  PTOT=PTOT-DP
0536                  NQ=NQ+1
0537                  GO TO 2600
0538  2690   CONTINUE
0539         RETURN
0540         END