[u/mrichter/AliRoot.git] / HIJING / hijing1_36 / hijset.F

* $Id$
C
C
C
	SUBROUTINE HIJSET(EFRM,FRAME,PROJ,TARG,IAP,IZP,IAT,IZT)
	CHARACTER FRAME*4,PROJ*4,TARG*4,EFRAME*4
	DOUBLE PRECISION  DD1,DD2,DD3,DD4
#define BLANKET_SAVE
#include "histrng.inc"
#include "hijcrdn.inc"
#include "hiparnt.inc"
#include "hijdat.inc"
#include "ludat1_hijing.inc"
	EXTERNAL FNKICK,FNKICK2,FNSTRU,FNSTRUM,FNSTRUS
	SAVE
	CALL TITLE
	IHNT2(1)=IAP
	IHNT2(2)=IZP
	IHNT2(3)=IAT
	IHNT2(4)=IZT
	IHNT2(5)=0
	IHNT2(6)=0
C
	HINT1(8)=MAX(ULMASS_HIJING(2112),ULMASS_HIJING(2212))
	HINT1(9)=HINT1(8)
C
	IF(PROJ.NE.'A') THEN
		IF(PROJ.EQ.'P') THEN
		    IHNT2(5)=2212
		ELSE IF(PROJ.EQ.'PBAR') THEN 
		    IHNT2(5)=-2212
		ELSE IF(PROJ.EQ.'PI+') THEN
		    IHNT2(5)=211
		ELSE IF(PROJ.EQ.'PI-') THEN
		    IHNT2(5)=-211
		ELSE IF(PROJ.EQ.'K+') THEN
		    IHNT2(5)=321
		ELSE IF(PROJ.EQ.'K-') THEN
		    IHNT2(5)=-321
		ELSE IF(PROJ.EQ.'N') THEN
		    IHNT2(5)=2112
		ELSE IF(PROJ.EQ.'NBAR') THEN
		    IHNT2(5)=-2112
		ELSE
		    WRITE(6,*) PROJ, 'wrong or unavailable proj name'
		    STOP
		ENDIF
		HINT1(8)=ULMASS_HIJING(IHNT2(5))
	ENDIF
	IF(TARG.NE.'A') THEN
		IF(TARG.EQ.'P') THEN
		    IHNT2(6)=2212
		ELSE IF(TARG.EQ.'PBAR') THEN 
		    IHNT2(6)=-2212
		ELSE IF(TARG.EQ.'PI+') THEN
		    IHNT2(6)=211
		ELSE IF(TARG.EQ.'PI-') THEN
		    IHNT2(6)=-211
		ELSE IF(TARG.EQ.'K+') THEN
		    IHNT2(6)=321
		ELSE IF(TARG.EQ.'K-') THEN
		    IHNT2(6)=-321
		ELSE IF(TARG.EQ.'N') THEN
		    IHNT2(6)=2112
		ELSE IF(TARG.EQ.'NBAR') THEN
		    IHNT2(6)=-2112
		ELSE
		    WRITE(6,*) TARG,'wrong or unavailable targ name'
		    STOP
		ENDIF
		HINT1(9)=ULMASS_HIJING(IHNT2(6))
	ENDIF

C...Switch off decay of pi0, K0S, Lambda, Sigma+-, Xi0-, Omega-.
	IF(IHPR2(12).GT.0) THEN
	CALL LUGIVE_HIJING('MDCY(C111,1)=0')
	CALL LUGIVE_HIJING('MDCY(C310,1)=0')
	   CALL LUGIVE_HIJING('MDCY(C411,1)=0;MDCY(C-411,1)=0')
	   CALL LUGIVE_HIJING('MDCY(C421,1)=0;MDCY(C-421,1)=0')
	   CALL LUGIVE_HIJING('MDCY(C431,1)=0;MDCY(C-431,1)=0')
	   CALL LUGIVE_HIJING('MDCY(C511,1)=0;MDCY(C-511,1)=0')
	   CALL LUGIVE_HIJING('MDCY(C521,1)=0;MDCY(C-521,1)=0')
	   CALL LUGIVE_HIJING('MDCY(C531,1)=0;MDCY(C-531,1)=0')
        CALL LUGIVE_HIJING('MDCY(C3122,1)=0;MDCY(C-3122,1)=0')
        CALL LUGIVE_HIJING('MDCY(C3112,1)=0;MDCY(C-3112,1)=0')
        CALL LUGIVE_HIJING('MDCY(C3212,1)=0;MDCY(C-3212,1)=0')
        CALL LUGIVE_HIJING('MDCY(C3222,1)=0;MDCY(C-3222,1)=0')
        CALL LUGIVE_HIJING('MDCY(C3312,1)=0;MDCY(C-3312,1)=0')
        CALL LUGIVE_HIJING('MDCY(C3322,1)=0;MDCY(C-3322,1)=0')
        CALL LUGIVE_HIJING('MDCY(C3334,1)=0;MDCY(C-3334,1)=0')
	ENDIF
	MSTU(12)=0
	MSTU(21)=1
	IF(IHPR2(10).EQ.0) THEN
		MSTU(22)=0
		MSTU(25)=0
		MSTU(26)=0
	ENDIF
	MSTJ(12)=IHPR2(11)
	PARJ(21)=HIPR1(2)
	PARJ(41)=HIPR1(3)
	PARJ(42)=HIPR1(4)
C			******** set up for jetset
	IF(FRAME.EQ.'LAB') THEN
	   DD1=EFRM
	   DD2=HINT1(8)
	   DD3=HINT1(9)
	   HINT1(1)=SQRT(HINT1(8)**2+2.0*HINT1(9)*EFRM+HINT1(9)**2)
	   DD4=DSQRT(DD1**2-DD2**2)/(DD1+DD3)
	   HINT1(2)=DD4
	   HINT1(3)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
	   DD4=DSQRT(DD1**2-DD2**2)/DD1
	   HINT1(4)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
	   HINT1(5)=0.0
	   HINT1(6)=EFRM
	   HINT1(7)=HINT1(9)
	ELSE IF(FRAME.EQ.'CMS') THEN
	   HINT1(1)=EFRM
	   HINT1(2)=0.0
	   HINT1(3)=0.0
	   DD1=HINT1(1)
	   DD2=HINT1(8)
	   DD3=HINT1(9)
	   DD4=DSQRT(1.D0-4.D0*DD2**2/DD1**2)
	   HINT1(4)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
	   DD4=DSQRT(1.D0-4.D0*DD3**2/DD1**2)
	   HINT1(5)=-0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
	   HINT1(6)=HINT1(1)/2.0
	   HINT1(7)=HINT1(1)/2.0
	ENDIF
C		********define Lorentz transform to lab frame
c
C		********calculate the cross sections involved with
C			nucleon collisions.
	IF(IHNT2(1).GT.1) THEN
		CALL HIJWDS(IHNT2(1),1,RMAX)
		HIPR1(34)=RMAX
C			********set up Wood-Sax distr for proj.
	ENDIF
	IF(IHNT2(3).GT.1) THEN
		CALL HIJWDS(IHNT2(3),2,RMAX)
		HIPR1(35)=RMAX
C			********set up Wood-Sax distr for  targ.
	ENDIF
C
C
	I=0
20	I=I+1
	IF(I.EQ.10) GO TO 30
	IF(HIDAT0(10,I).LE.HINT1(1)) GO TO 20
30	IF(I.EQ.1) I=2
	DO 40 J=1,9
	   HIDAT(J)=HIDAT0(J,I-1)+(HIDAT0(J,I)-HIDAT0(J,I-1))
     &	   *(HINT1(1)-HIDAT0(10,I-1))/(HIDAT0(10,I)-HIDAT0(10,I-1))
40	CONTINUE
	HIPR1(31)=HIDAT(5)
	HIPR1(30)=2.0*HIDAT(5)
C
C
	CALL HIJCRS
C
	IF(IHPR2(5).NE.0) THEN
		CALL HIFUN(3,0.0,36.0,FNKICK)
C		********booking for generating pt**2 for pt kick
	ENDIF
	CALL HIFUN(7,0.0,6.0,FNKICK2)
	CALL HIFUN(4,0.0,1.0,FNSTRU)
	CALL HIFUN(5,0.0,1.0,FNSTRUM)
	CALL HIFUN(6,0.0,1.0,FNSTRUS)
C		********booking for x distribution of valence quarks
	EFRAME='Ecm'
	IF(FRAME.EQ.'LAB') EFRAME='Elab'
	WRITE(6,100) EFRAME,EFRM,PROJ,IHNT2(1),IHNT2(2),
     &               TARG,IHNT2(3),IHNT2(4) 
100	FORMAT(//10X,'**************************************************'/
     &	10X,'*',48X,'*'/
     &	10X,'*         HIJING has been initialized at         *'/
     &	10X,'*',13X,A4,'= ',F10.2,' GeV/n',13X,'*'/
     &	10X,'*',48X,'*'/
     &	10X,'*',8X,'for ',
     &	A4,'(',I3,',',I3,')',' + ',A4,'(',I3,',',I3,')',7X,'*'/
     &	10X,'**************************************************')
	RETURN
	END
Commit	Line	Data
e74335a4	1	* $Id$
	2	C
	3	C
	4	C
	5	SUBROUTINE HIJSET(EFRM,FRAME,PROJ,TARG,IAP,IZP,IAT,IZT)
	6	CHARACTER FRAME4,PROJ4,TARG4,EFRAME4
	7	DOUBLE PRECISION DD1,DD2,DD3,DD4
bc676b8e	8	#define BLANKET_SAVE
e74335a4	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).GT.0) 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	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	MSTU(12)=0
93	MSTU(21)=1
94	IF(IHPR2(10).EQ.0) THEN
95	MSTU(22)=0
96	MSTU(25)=0
97	MSTU(26)=0
98	ENDIF
99	MSTJ(12)=IHPR2(11)
100	PARJ(21)=HIPR1(2)
101	PARJ(41)=HIPR1(3)
102	PARJ(42)=HIPR1(4)
103	C ******** set up for jetset
104	IF(FRAME.EQ.'LAB') THEN
105	DD1=EFRM
106	DD2=HINT1(8)
107	DD3=HINT1(9)
108	HINT1(1)=SQRT(HINT1(8)*2+2.0HINT1(9)EFRM+HINT1(9)*2)
109	DD4=DSQRT(DD12-DD22)/(DD1+DD3)
110	HINT1(2)=DD4
111	HINT1(3)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
112	DD4=DSQRT(DD12-DD22)/DD1
113	HINT1(4)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
114	HINT1(5)=0.0
115	HINT1(6)=EFRM
116	HINT1(7)=HINT1(9)
117	ELSE IF(FRAME.EQ.'CMS') THEN
118	HINT1(1)=EFRM
119	HINT1(2)=0.0
120	HINT1(3)=0.0
121	DD1=HINT1(1)
122	DD2=HINT1(8)
123	DD3=HINT1(9)
124	DD4=DSQRT(1.D0-4.D0DD22/DD1*2)
125	HINT1(4)=0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
126	DD4=DSQRT(1.D0-4.D0DD32/DD1*2)
127	HINT1(5)=-0.5*DLOG((1.D0+DD4)/(1.D0-DD4))
128	HINT1(6)=HINT1(1)/2.0
129	HINT1(7)=HINT1(1)/2.0
130	ENDIF
131	C ********define Lorentz transform to lab frame
132	c
133	C ********calculate the cross sections involved with
134	C nucleon collisions.
135	IF(IHNT2(1).GT.1) THEN
136	CALL HIJWDS(IHNT2(1),1,RMAX)
137	HIPR1(34)=RMAX
138	C ********set up Wood-Sax distr for proj.
139	ENDIF
140	IF(IHNT2(3).GT.1) THEN
141	CALL HIJWDS(IHNT2(3),2,RMAX)
142	HIPR1(35)=RMAX
143	C ********set up Wood-Sax distr for targ.
144	ENDIF
145	C
146	C
147	I=0
148	20 I=I+1
149	IF(I.EQ.10) GO TO 30
150	IF(HIDAT0(10,I).LE.HINT1(1)) GO TO 20
151	30 IF(I.EQ.1) I=2
152	DO 40 J=1,9
153	HIDAT(J)=HIDAT0(J,I-1)+(HIDAT0(J,I)-HIDAT0(J,I-1))
154	& *(HINT1(1)-HIDAT0(10,I-1))/(HIDAT0(10,I)-HIDAT0(10,I-1))
155	40 CONTINUE
156	HIPR1(31)=HIDAT(5)
157	HIPR1(30)=2.0*HIDAT(5)
158	C
159	C
160	CALL HIJCRS
161	C
162	IF(IHPR2(5).NE.0) THEN
163	CALL HIFUN(3,0.0,36.0,FNKICK)
164	C ******booking for generating pt2 for pt kick
165	ENDIF
166	CALL HIFUN(7,0.0,6.0,FNKICK2)
167	CALL HIFUN(4,0.0,1.0,FNSTRU)
168	CALL HIFUN(5,0.0,1.0,FNSTRUM)
169	CALL HIFUN(6,0.0,1.0,FNSTRUS)
170	C ********booking for x distribution of valence quarks
171	EFRAME='Ecm'
172	IF(FRAME.EQ.'LAB') EFRAME='Elab'
173	WRITE(6,100) EFRAME,EFRM,PROJ,IHNT2(1),IHNT2(2),
174	& TARG,IHNT2(3),IHNT2(4)
7aae3926	175	100 FORMAT(//10X,'**************************************************'/
e74335a4	176	& 10X,'',48X,''/
	177	& 10X,'* HIJING has been initialized at *'/
	178	& 10X,'',13X,A4,'= ',F10.2,' GeV/n',13X,''/
	179	& 10X,'',48X,''/
	180	& 10X,'*',8X,'for ',
	181	& A4,'(',I3,',',I3,')',' + ',A4,'(',I3,',',I3,')',7X,'*'/
	182	& 10X,'**************************************************')
	183	RETURN
	184	END