hijing/src/hijset.f

0001 C
0002 C
0003 C
0004         SUBROUTINE HIJSET(EFRM,FRAME,PROJ,TARG,IAP,IZP,IAT,IZT)
0005         CHARACTER FRAME*8,PROJ*8,TARG*8,EFRAME*8                 ! Ilya Seluzhenkov
0006         DOUBLE PRECISION  DD1,DD2,DD3,DD4
0007         COMMON/HISTRNG/NFP(300,15),PP(300,15),NFT(300,15),PT(300,15)
0008         SAVE  /HISTRNG/
0009         COMMON/HIJCRDN/YP(3,300),YT(3,300)
0010         SAVE  /HIJCRDN/
0011         COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
0012         SAVE  /HIPARNT/
0013         COMMON/HIJDAT/HIDAT0(10,10),HIDAT(10)
0014         SAVE  /HIJDAT/
0015         COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0016         SAVE  /LUDAT1/
0017         EXTERNAL FNKICK,FNKICK2,FNSTRU,FNSTRUM,FNSTRUS
0018         CALL TITLE
0019         IHNT2(1)=IAP
0020         IHNT2(2)=IZP
0021         IHNT2(3)=IAT
0022         IHNT2(4)=IZT
0023         IHNT2(5)=0
0024         IHNT2(6)=0
0025 C
0026         HINT1(8)=MAX(ULMASS(2112),ULMASS(2212))
0027         HINT1(9)=HINT1(8)
0028 C
0029         IF(PROJ.NE.'A') THEN
0030                 IF(PROJ.EQ.'P') THEN
0031                     IHNT2(5)=2212
0032                 ELSE IF(PROJ.EQ.'PBAR') THEN
0033                     IHNT2(5)=-2212
0034                 ELSE IF(PROJ.EQ.'PI+') THEN
0035                     IHNT2(5)=211
0036                 ELSE IF(PROJ.EQ.'PI-') THEN
0037                     IHNT2(5)=-211
0038                 ELSE IF(PROJ.EQ.'K+') THEN
0039                     IHNT2(5)=321
0040                 ELSE IF(PROJ.EQ.'K-') THEN
0041                     IHNT2(5)=-321
0042                 ELSE IF(PROJ.EQ.'N') THEN
0043                     IHNT2(5)=2112
0044                 ELSE IF(PROJ.EQ.'NBAR') THEN
0045                     IHNT2(5)=-2112
0046                 ELSE
0047                     WRITE(6,*) PROJ, 'wrong or unavailable proj name'
0048                     STOP
0049                 ENDIF
0050                 HINT1(8)=ULMASS(IHNT2(5))
0051         ENDIF
0052         IF(TARG.NE.'A') THEN
0053                 IF(TARG.EQ.'P') THEN
0054                     IHNT2(6)=2212
0055                 ELSE IF(TARG.EQ.'PBAR') THEN
0056                     IHNT2(6)=-2212
0057                 ELSE IF(TARG.EQ.'PI+') THEN
0058                     IHNT2(6)=211
0059                 ELSE IF(TARG.EQ.'PI-') THEN
0060                     IHNT2(6)=-211
0061                 ELSE IF(TARG.EQ.'K+') THEN
0062                     IHNT2(6)=321
0063                 ELSE IF(TARG.EQ.'K-') THEN
0064                     IHNT2(6)=-321
0065                 ELSE IF(TARG.EQ.'N') THEN
0066                     IHNT2(6)=2112
0067                 ELSE IF(TARG.EQ.'NBAR') THEN
0068                     IHNT2(6)=-2112
0069                 ELSE
0070                     WRITE(6,*) TARG,'wrong or unavailable targ name'
0071                     STOP
0072                 ENDIF
0073                 HINT1(9)=ULMASS(IHNT2(6))
0074         ENDIF
0075
0076 C...Switch off decay of pi0, K0S, Lambda, Sigma+-, Xi0-, Omega-.
0077
0078         print *, 'IHPR2(12) = ', IHPR2(12)
0079
0080         IF(IHPR2(12).GT.0) THEN
0081            CALL LUGIVE('MDCY(C111,1)=0')
0082            CALL LUGIVE('MDCY(C310,1)=0')
0083            CALL LUGIVE('MDCY(C3122,1)=0;MDCY(C-3122,1)=0')
0084            CALL LUGIVE('MDCY(C3112,1)=0;MDCY(C-3112,1)=0')
0085            CALL LUGIVE('MDCY(C3212,1)=0;MDCY(C-3212,1)=0')
0086            CALL LUGIVE('MDCY(C3222,1)=0;MDCY(C-3222,1)=0')
0087            CALL LUGIVE('MDCY(C3312,1)=0;MDCY(C-3312,1)=0')
0088            CALL LUGIVE('MDCY(C3322,1)=0;MDCY(C-3322,1)=0')
0089            CALL LUGIVE('MDCY(C3334,1)=0;MDCY(C-3334,1)=0')
0090
0091            IF (IHPR2(12).EQ.1) THEN
0092               CALL LUGIVE('MDCY(C411,1)=0;MDCY(C-411,1)=0')
0093               CALL LUGIVE('MDCY(C421,1)=0;MDCY(C-421,1)=0')
0094               CALL LUGIVE('MDCY(C431,1)=0;MDCY(C-431,1)=0')
0095               CALL LUGIVE('MDCY(C511,1)=0;MDCY(C-511,1)=0')
0096               CALL LUGIVE('MDCY(C521,1)=0;MDCY(C-521,1)=0')
0097               CALL LUGIVE('MDCY(C531,1)=0;MDCY(C-531,1)=0')
0098            ENDIF
0099         ENDIF
0100
0101         MSTU(12)=0
0102         MSTU(21)=1
0103         IF(IHPR2(10).EQ.0) THEN
0104                 MSTU(22)=0
0105                 MSTU(25)=0
0106                 MSTU(26)=0
0107         ENDIF
0108         MSTJ(12)=IHPR2(11)
0109         PARJ(21)=HIPR1(2)
0110         PARJ(41)=HIPR1(3)
0111         PARJ(42)=HIPR1(4)
0112 C                       ******** set up for jetset
0113         IF(FRAME.EQ.'LAB') THEN
0114            DD1=EFRM
0115            DD2=HINT1(8)
0116            DD3=HINT1(9)
0117            HINT1(1)=SQRT(HINT1(8)**2+2.0*HINT1(9)*EFRM+HINT1(9)**2)
0118            DD4=DSQRT(DD1**2-DD2**2)/(DD1+DD3)
0119            HINT1(2)=DD4
0120            HINT1(3)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
0121            DD4=DSQRT(DD1**2-DD2**2)/DD1
0122            HINT1(4)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
0123            HINT1(5)=0.0
0124            HINT1(6)=EFRM
0125            HINT1(7)=HINT1(9)
0126         ELSE IF(FRAME.EQ.'CMS') THEN
0127            HINT1(1)=EFRM
0128            HINT1(2)=0.0
0129            HINT1(3)=0.0
0130            DD1=HINT1(1)
0131            DD2=HINT1(8)
0132            DD3=HINT1(9)
0133            DD4=DSQRT(1.D0-4.D0*DD2**2/DD1**2)
0134            HINT1(4)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
0135            DD4=DSQRT(1.D0-4.D0*DD3**2/DD1**2)
0136            HINT1(5)=-0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
0137            HINT1(6)=HINT1(1)/2.0
0138            HINT1(7)=HINT1(1)/2.0
0139         ENDIF
0140 C               ********define Lorentz transform to lab frame
0141 c
0142 C               ********calculate the cross sections involved with
0143 C                       nucleon collisions.
0144         IF(IHNT2(1).GT.1) THEN
0145                 CALL HIJWDS(IHNT2(1),1,RMAX)
0146                 HIPR1(34)=RMAX
0147 C                       ********set up Wood-Sax distr for proj.
0148         ENDIF
0149         IF(IHNT2(3).GT.1) THEN
0150                 CALL HIJWDS(IHNT2(3),2,RMAX)
0151                 HIPR1(35)=RMAX
0152 C                       ********set up Wood-Sax distr for  targ.
0153         ENDIF
0154 C
0155 C
0156         I=0
0157 20      I=I+1
0158         IF(I.EQ.10) GO TO 30
0159         IF(HIDAT0(10,I).LE.HINT1(1)) GO TO 20
0160 30      IF(I.EQ.1) I=2
0161         DO 40 J=1,9
0162            HIDAT(J)=HIDAT0(J,I-1)+(HIDAT0(J,I)-HIDAT0(J,I-1))
0163      &     *(HINT1(1)-HIDAT0(10,I-1))/(HIDAT0(10,I)-HIDAT0(10,I-1))
0164 40      CONTINUE
0165         HIPR1(31)=HIDAT(5)
0166         HIPR1(30)=2.0*HIDAT(5)
0167 C
0168 C
0169         CALL HIJCRS
0170 C
0171         IF(IHPR2(5).NE.0) THEN
0172                 CALL HIFUN(3,0.0,36.0,FNKICK)
0173 C               ********booking for generating pt**2 for pt kick
0174         ENDIF
0175         CALL HIFUN(7,0.0,6.0,FNKICK2)
0176         CALL HIFUN(4,0.0,1.0,FNSTRU)
0177         CALL HIFUN(5,0.0,1.0,FNSTRUM)
0178         CALL HIFUN(6,0.0,1.0,FNSTRUS)
0179 C               ********booking for x distribution of valence quarks
0180         EFRAME='Ecm'
0181         IF(FRAME.EQ.'LAB') EFRAME='Elab'
0182         WRITE(6,100) EFRAME,EFRM,PROJ,IHNT2(1),IHNT2(2),
0183      &               TARG,IHNT2(3),IHNT2(4)
0184 100     FORMAT(//10X,'****************************************
0185      &  **********'/
0186      &  10X,'*',48X,'*'/
0187      &  10X,'*         HIJING has been initialized at         *'/
0188      &  10X,'*',13X,A4,'= ',F10.2,' GeV/n',13X,'*'/
0189      &  10X,'*',48X,'*'/
0190      &  10X,'*',8X,'for ',
0191      &  A4,'(',I3,',',I3,')',' + ',A4,'(',I3,',',I3,')',7X,'*'/
0192      &  10X,'**************************************************')
0193         RETURN
0194         END