HIJING/hijing1_36/hijset.F

   1 * $Id$
   2 C
   3 C
   4 C
   5         SUBROUTINE HIJSET(EFRM,FRAME,PROJ,TARG,IAP,IZP,IAT,IZT)
   6         CHARACTER FRAME*8,PROJ*8,TARG*8,EFRAME*8
   7         DOUBLE PRECISION  DD1,DD2,DD3,DD4
   8 #define BLANKET_SAVE
   9 #include "histrng.inc"
  10 #include "hijcrdn.inc"
  11 #include "hiparnt.inc"
  12 #include "hijdat.inc"
  13 #include "ludat1_hijing.inc"
  14         EXTERNAL FNKICK,FNKICK2,FNSTRU,FNSTRUM,FNSTRUS
  15         SAVE
  16         CALL TITLE
  17         IHNT2(1)=IAP
  18         IHNT2(2)=IZP
  19         IHNT2(3)=IAT
  20         IHNT2(4)=IZT
  21         IHNT2(5)=0
  22         IHNT2(6)=0
  23 C
  24         HINT1(8)=MAX(ULMASS_HIJING(2112),ULMASS_HIJING(2212))
  25         HINT1(9)=HINT1(8)
  26 C
  27         IF(PROJ.NE.'A') THEN
  28                 IF(PROJ.EQ.'P') THEN
  29                     IHNT2(5)=2212
  30                 ELSE IF(PROJ.EQ.'PBAR') THEN
  31                     IHNT2(5)=-2212
  32                 ELSE IF(PROJ.EQ.'PI+') THEN
  33                     IHNT2(5)=211
  34                 ELSE IF(PROJ.EQ.'PI-') THEN
  35                     IHNT2(5)=-211
  36                 ELSE IF(PROJ.EQ.'K+') THEN
  37                     IHNT2(5)=321
  38                 ELSE IF(PROJ.EQ.'K-') THEN
  39                     IHNT2(5)=-321
  40                 ELSE IF(PROJ.EQ.'N') THEN
  41                     IHNT2(5)=2112
  42                 ELSE IF(PROJ.EQ.'NBAR') THEN
  43                     IHNT2(5)=-2112
  44                 ELSE
  45                     WRITE(6,*) PROJ, 'wrong or unavailable proj name'
  46                     STOP
  47                 ENDIF
  48                 HINT1(8)=ULMASS_HIJING(IHNT2(5))
  49         ENDIF
  50         IF(TARG.NE.'A') THEN
  51                 IF(TARG.EQ.'P') THEN
  52                     IHNT2(6)=2212
  53                 ELSE IF(TARG.EQ.'PBAR') THEN
  54                     IHNT2(6)=-2212
  55                 ELSE IF(TARG.EQ.'PI+') THEN
  56                     IHNT2(6)=211
  57                 ELSE IF(TARG.EQ.'PI-') THEN
  58                     IHNT2(6)=-211
  59                 ELSE IF(TARG.EQ.'K+') THEN
  60                     IHNT2(6)=321
  61                 ELSE IF(TARG.EQ.'K-') THEN
  62                     IHNT2(6)=-321
  63                 ELSE IF(TARG.EQ.'N') THEN
  64                     IHNT2(6)=2112
  65                 ELSE IF(TARG.EQ.'NBAR') THEN
  66                     IHNT2(6)=-2112
  67                 ELSE
  68                     WRITE(6,*) TARG,'wrong or unavailable targ name'
  69                     STOP
  70                 ENDIF
  71                 HINT1(9)=ULMASS_HIJING(IHNT2(6))
  72         ENDIF
  73
  74 C...Switch off decay of pi0, K0S, Lambda, Sigma+-, Xi0-, Omega-.
  75         IF(IHPR2(12).EQ.1) THEN
  76         CALL LUGIVE_HIJING('MDCY(C111,1)=0')
  77         CALL LUGIVE_HIJING('MDCY(C310,1)=0')
  78         CALL LUGIVE_HIJING('MDCY(C411,1)=0;MDCY(C-411,1)=0')
  79         CALL LUGIVE_HIJING('MDCY(C421,1)=0;MDCY(C-421,1)=0')
  80         CALL LUGIVE_HIJING('MDCY(C431,1)=0;MDCY(C-431,1)=0')
  81         CALL LUGIVE_HIJING('MDCY(C511,1)=0;MDCY(C-511,1)=0')
  82         CALL LUGIVE_HIJING('MDCY(C521,1)=0;MDCY(C-521,1)=0')
  83         CALL LUGIVE_HIJING('MDCY(C531,1)=0;MDCY(C-531,1)=0')
  84         CALL LUGIVE_HIJING('MDCY(C3122,1)=0;MDCY(C-3122,1)=0')
  85         CALL LUGIVE_HIJING('MDCY(C3112,1)=0;MDCY(C-3112,1)=0')
  86 C        CALL LUGIVE_HIJING('MDCY(C3212,1)=0;MDCY(C-3212,1)=0')
  87         CALL LUGIVE_HIJING('MDCY(C3222,1)=0;MDCY(C-3222,1)=0')
  88         CALL LUGIVE_HIJING('MDCY(C3312,1)=0;MDCY(C-3312,1)=0')
  89         CALL LUGIVE_HIJING('MDCY(C3322,1)=0;MDCY(C-3322,1)=0')
  90         CALL LUGIVE_HIJING('MDCY(C3334,1)=0;MDCY(C-3334,1)=0')
  91         ENDIF
  92         IF(IHPR2(12).EQ.2) THEN
  93         CALL LUGIVE_HIJING('MDCY(C111,1)=0')
  94         CALL LUGIVE_HIJING('MDCY(C310,1)=0')
  95         CALL LUGIVE_HIJING('MDCY(C411,1)=0;MDCY(C-411,1)=0')
  96         CALL LUGIVE_HIJING('MDCY(C421,1)=0;MDCY(C-421,1)=0')
  97         CALL LUGIVE_HIJING('MDCY(C431,1)=0;MDCY(C-431,1)=0')
  98         CALL LUGIVE_HIJING('MDCY(C4122,1)=0;MDCY(C-4122,1)=0')
  99         CALL LUGIVE_HIJING('MDCY(C4132,1)=0;MDCY(C-4132,1)=0')
 100         CALL LUGIVE_HIJING('MDCY(C4232,1)=0;MDCY(C-4232,1)=0')
 101         CALL LUGIVE_HIJING('MDCY(C4332,1)=0;MDCY(C-4332,1)=0')
 102         CALL LUGIVE_HIJING('MDCY(C511,1)=0;MDCY(C-511,1)=0')
 103         CALL LUGIVE_HIJING('MDCY(C521,1)=0;MDCY(C-521,1)=0')
 104         CALL LUGIVE_HIJING('MDCY(C531,1)=0;MDCY(C-531,1)=0')
 105         CALL LUGIVE_HIJING('MDCY(C5122,1)=0;MDCY(C-5122,1)=0')
 106         CALL LUGIVE_HIJING('MDCY(C5132,1)=0;MDCY(C-5132,1)=0')
 107         CALL LUGIVE_HIJING('MDCY(C5232,1)=0;MDCY(C-5232,1)=0')
 108         CALL LUGIVE_HIJING('MDCY(C5332,1)=0;MDCY(C-5332,1)=0')
 109         CALL LUGIVE_HIJING('MDCY(C3122,1)=0;MDCY(C-3122,1)=0')
 110         CALL LUGIVE_HIJING('MDCY(C3112,1)=0;MDCY(C-3112,1)=0')
 111         CALL LUGIVE_HIJING('MDCY(C3222,1)=0;MDCY(C-3222,1)=0')
 112         CALL LUGIVE_HIJING('MDCY(C3312,1)=0;MDCY(C-3312,1)=0')
 113         CALL LUGIVE_HIJING('MDCY(C3322,1)=0;MDCY(C-3322,1)=0')
 114         CALL LUGIVE_HIJING('MDCY(C3334,1)=0;MDCY(C-3334,1)=0')
 115         ENDIF
 116         IF(IHPR2(12).EQ.3) THEN
 117         CALL LUGIVE_HIJING('MDCY(C310,1)=0')
 118         CALL LUGIVE_HIJING('MDCY(C3122,1)=0;MDCY(C-3122,1)=0')
 119         CALL LUGIVE_HIJING('MDCY(C3112,1)=0;MDCY(C-3112,1)=0')
 120         CALL LUGIVE_HIJING('MDCY(C3222,1)=0;MDCY(C-3222,1)=0')
 121         CALL LUGIVE_HIJING('MDCY(C3312,1)=0;MDCY(C-3312,1)=0')
 122         CALL LUGIVE_HIJING('MDCY(C3322,1)=0;MDCY(C-3322,1)=0')
 123         CALL LUGIVE_HIJING('MDCY(C3334,1)=0;MDCY(C-3334,1)=0')
 124         ENDIF
 125
 126
 127         MSTU(12)=0
 128         MSTU(21)=1
 129         IF(IHPR2(10).EQ.0) THEN
 130                 MSTU(22)=0
 131                 MSTU(25)=0
 132                 MSTU(26)=0
 133         ENDIF
 134         MSTJ(12)=IHPR2(11)
 135         PARJ(21)=HIPR1(2)
 136         PARJ(41)=HIPR1(3)
 137         PARJ(42)=HIPR1(4)
 138 C                       ******** set up for jetset
 139         IF(FRAME.EQ.'LAB') THEN
 140            DD1=EFRM
 141            DD2=HINT1(8)
 142            DD3=HINT1(9)
 143            HINT1(1)=SQRT(HINT1(8)**2+2.0*HINT1(9)*EFRM+HINT1(9)**2)
 144            DD4=DSQRT(DD1**2-DD2**2)/(DD1+DD3)
 145            HINT1(2)=DD4
 146            HINT1(3)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
 147            DD4=DSQRT(DD1**2-DD2**2)/DD1
 148            HINT1(4)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
 149            HINT1(5)=0.0
 150            HINT1(6)=EFRM
 151            HINT1(7)=HINT1(9)
 152         ELSE IF(FRAME.EQ.'CMS') THEN
 153            HINT1(1)=EFRM
 154            HINT1(2)=0.0
 155            HINT1(3)=0.0
 156            DD1=HINT1(1)
 157            DD2=HINT1(8)
 158            DD3=HINT1(9)
 159            DD4=DSQRT(1.D0-4.D0*DD2**2/DD1**2)
 160            HINT1(4)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
 161            DD4=DSQRT(1.D0-4.D0*DD3**2/DD1**2)
 162            HINT1(5)=-0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
 163            HINT1(6)=HINT1(1)/2.0
 164            HINT1(7)=HINT1(1)/2.0
 165         ENDIF
 166 C               ********define Lorentz transform to lab frame
 167 c
 168 C               ********calculate the cross sections involved with
 169 C                       nucleon collisions.
 170         IF(IHNT2(1).GT.1) THEN
 171                 CALL HIJWDS(IHNT2(1),1,RMAX)
 172                 HIPR1(34)=RMAX
 173 C                       ********set up Wood-Sax distr for proj.
 174         ENDIF
 175         IF(IHNT2(3).GT.1) THEN
 176                 CALL HIJWDS(IHNT2(3),2,RMAX)
 177                 HIPR1(35)=RMAX
 178 C                       ********set up Wood-Sax distr for  targ.
 179         ENDIF
 180 C
 181 C
 182         I=0
 183 20      I=I+1
 184         IF(I.EQ.10) GO TO 30
 185         IF(HIDAT0(10,I).LE.HINT1(1)) GO TO 20
 186 30      IF(I.EQ.1) I=2
 187         DO 40 J=1,9
 188            HIDAT(J)=HIDAT0(J,I-1)+(HIDAT0(J,I)-HIDAT0(J,I-1))
 189      &     *(HINT1(1)-HIDAT0(10,I-1))/(HIDAT0(10,I)-HIDAT0(10,I-1))
 190 40      CONTINUE
 191         IF(HIPR1(31).EQ.0) HIPR1(31)=HIDAT(5)
 192         HIPR1(30)=2.0*HIPR1(31)
 193 C
 194 C
 195         CALL HIJCRS
 196 C
 197         IF(IHPR2(5).NE.0) THEN
 198                 CALL HIFUN(3,0.0,36.0,FNKICK)
 199 C               ********booking for generating pt**2 for pt kick
 200         ENDIF
 201         CALL HIFUN(7,0.0,6.0,FNKICK2)
 202         CALL HIFUN(4,0.0,1.0,FNSTRU)
 203         CALL HIFUN(5,0.0,1.0,FNSTRUM)
 204         CALL HIFUN(6,0.0,1.0,FNSTRUS)
 205 C               ********booking for x distribution of valence quarks
 206         EFRAME='Ecm'
 207         IF(FRAME.EQ.'LAB') EFRAME='Elab'
 208         WRITE(6,100) EFRAME,EFRM,PROJ,IHNT2(1),IHNT2(2),
 209      &               TARG,IHNT2(3),IHNT2(4)
 210 100     FORMAT(//10X,'**************************************************'/
 211      &  10X,'*',48X,'*'/
 212      &  10X,'*         HIJING has been initialized at         *'/
 213      &  10X,'*',13X,A4,'= ',F10.2,' GeV/n',13X,'*'/
 214      &  10X,'*',48X,'*'/
 215      &  10X,'*',8X,'for ',
 216      &  A4,'(',I3,',',I3,')',' + ',A4,'(',I3,',',I3,')',7X,'*'/
 217      &  10X,'**************************************************')
 218
 219         write (*,*),'Average jet cross section (mb): " ', HINT1(10)
 220         write (*,*),'Jet cross section (mb): " ', HINT1(11)
 221         write (*,*),'Geometrical N size (mb): ', HIPR1(31)
 222         write (*,*),'Inelastic NN cross section (mb): ', HINT1(12)
 223         write (*,*),'Total NN cross section (mb): ',HINT1(13)
 224         RETURN
 225         END