[u/mrichter/AliRoot.git] / TAmpt / AMPT / profile.f

C	THIS FUNCTION IS TO CALCULATE THE NUCLEAR PROFILE FUNCTION
C       OF THE  COLLIDERING SYSTEM (IN UNITS OF 1/mb)
	FUNCTION FLAP(X)
        REAL HIPR1, HINT1
        COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
        REAL BB, B1, PHI, Z1
        COMMON/PACT_HIJING/BB,B1,PHI,Z1
        EXTERNAL FGP1
        B1=X
        FLAP=GAUSS2(FGP1,0.0,2.0*HIPR1(40),0.01)
	RETURN
	END
C
        FUNCTION FLAP1(X)
        REAL BB, B1, PHI, Z1
        COMMON/PACT_HIJING/BB,B1,PHI,Z1
        R=SQRT(BB**2+X**2)
        FLAP1=WDSAX1(R)
        RETURN
        END
C
        FUNCTION FLAP2(X)
        REAL BB, B1, PHI, Z1
        COMMON/PACT_HIJING/BB,B1,PHI,Z1
        R=SQRT(BB**2+X**2)
        FLAP2=WDSAX2(R)
        RETURN
        END
C
	FUNCTION FGP1(X)
        REAL HIPR1, HINT1
        COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
        REAL BB, B1, PHI, Z1
        COMMON/PACT_HIJING/BB,B1,PHI,Z1
        EXTERNAL FGP2
        PHI=X
        FGP1=2.0*GAUSS3(FGP2,0.0,HIPR1(34),0.01)
	RETURN
	END
C
        FUNCTION FGP2(X)
        REAL HIPR1, HINT1
        COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
        REAL BB, B1, PHI, Z1
        COMMON/PACT_HIJING/BB,B1,PHI,Z1
        EXTERNAL FGP3
        Z1=X
        FGP2=2.0*GAUSS4(FGP3,0.0,HIPR1(35),0.01)
	RETURN
	END
C
        FUNCTION FGP3(X)
        REAL BB, B1, PHI, Z1
        COMMON/PACT_HIJING/BB,B1,PHI,Z1
        R1=SQRT(B1**2+Z1**2)
        R2=SQRT(BB**2+B1**2-2.0*B1*BB*COS(PHI)+X**2)
        FGP3=B1*WDSAX1(R1)*WDSAX2(R2)
        RETURN
        END
C
	FUNCTION WDSAX1(X)
        REAL HIPR1, HINT1
        COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
      	WDSAX1=HINT1(75)*(1.+HINT1(74)*(X/HINT1(72))**2)/
     &       (1+EXP((X-HINT1(72))/HINT1(73)))
       	IF (HINT1(74).LT.0.) THEN
       		IF (X.GE.HINT1(72)/SQRT(ABS(HINT1(74)))) WDSAX1=0.
       	ENDIF
      	RETURN
      	END
C
	FUNCTION WDSAX2(X)
        REAL HIPR1, HINT1
        COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
      	WDSAX2=HINT1(79)*(1.+HINT1(78)*(X/HINT1(76))**2)/
     &       (1+EXP((X-HINT1(76))/HINT1(77)))
       	IF (HINT1(78).LT.0.) THEN
       		IF (X.GE.HINT1(76)/SQRT(ABS(HINT1(78)))) WDSAX2=0.
       	ENDIF
      	RETURN
      	END
C
	FUNCTION  PROFILE(XB)
        REAL HIPR1, HINT1
        COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
        REAL BB, B1, PHI, Z1
        COMMON/PACT_HIJING/BB,B1,PHI,Z1
	SAVE
	EXTERNAL FLAP, FLAP1, FLAP2
C
        BB=XB
        PROFILE=1.0
        IF(IHNT2(1).GT.1 .AND. IHNT2(3).GT.1) THEN
           PROFILE=float(IHNT2(1))*float(IHNT2(3))*0.1*
     &          GAUSS1(FLAP,0.0,HIPR1(34),0.01)
        ELSE IF(IHNT2(1).EQ.1 .AND. IHNT2(3).GT.1) THEN
           PROFILE=0.2*float(IHNT2(3))*
     &          GAUSS1(FLAP2,0.0,HIPR1(35),0.001)
        ELSE IF(IHNT2(1).GT.1 .AND. IHNT2(3).EQ.1) THEN
           PROFILE=0.2*float(IHNT2(1))*
     &          GAUSS1(FLAP1,0.0,HIPR1(34),0.001)
        ENDIF
	RETURN
	END
Commit	Line	Data
0119ef9a	1	C THIS FUNCTION IS TO CALCULATE THE NUCLEAR PROFILE FUNCTION
	2	C OF THE COLLIDERING SYSTEM (IN UNITS OF 1/mb)
	3	FUNCTION FLAP(X)
	4	REAL HIPR1, HINT1
	5	COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
	6	REAL BB, B1, PHI, Z1
	7	COMMON/PACT_HIJING/BB,B1,PHI,Z1
	8	EXTERNAL FGP1
	9	B1=X
	10	FLAP=GAUSS2(FGP1,0.0,2.0*HIPR1(40),0.01)
	11	RETURN
	12	END
	13	C
	14	FUNCTION FLAP1(X)
	15	REAL BB, B1, PHI, Z1
	16	COMMON/PACT_HIJING/BB,B1,PHI,Z1
	17	R=SQRT(BB2+X2)
	18	FLAP1=WDSAX1(R)
	19	RETURN
	20	END
	21	C
	22	FUNCTION FLAP2(X)
	23	REAL BB, B1, PHI, Z1
	24	COMMON/PACT_HIJING/BB,B1,PHI,Z1
	25	R=SQRT(BB2+X2)
	26	FLAP2=WDSAX2(R)
	27	RETURN
	28	END
	29	C
	30	FUNCTION FGP1(X)
	31	REAL HIPR1, HINT1
	32	COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
	33	REAL BB, B1, PHI, Z1
	34	COMMON/PACT_HIJING/BB,B1,PHI,Z1
	35	EXTERNAL FGP2
	36	PHI=X
	37	FGP1=2.0*GAUSS3(FGP2,0.0,HIPR1(34),0.01)
	38	RETURN
	39	END
	40	C
	41	FUNCTION FGP2(X)
	42	REAL HIPR1, HINT1
	43	COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
	44	REAL BB, B1, PHI, Z1
	45	COMMON/PACT_HIJING/BB,B1,PHI,Z1
	46	EXTERNAL FGP3
	47	Z1=X
	48	FGP2=2.0*GAUSS4(FGP3,0.0,HIPR1(35),0.01)
	49	RETURN
	50	END
	51	C
	52	FUNCTION FGP3(X)
	53	REAL BB, B1, PHI, Z1
	54	COMMON/PACT_HIJING/BB,B1,PHI,Z1
	55	R1=SQRT(B12+Z12)
	56	R2=SQRT(BB2+B12-2.0B1BBCOS(PHI)+X*2)
	57	FGP3=B1WDSAX1(R1)WDSAX2(R2)
	58	RETURN
	59	END
	60	C
	61	FUNCTION WDSAX1(X)
	62	REAL HIPR1, HINT1
	63	COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
	64	WDSAX1=HINT1(75)(1.+HINT1(74)(X/HINT1(72))**2)/
65	& (1+EXP((X-HINT1(72))/HINT1(73)))
66	IF (HINT1(74).LT.0.) THEN
67	IF (X.GE.HINT1(72)/SQRT(ABS(HINT1(74)))) WDSAX1=0.
68	ENDIF
69	RETURN
70	END
71	C
72	FUNCTION WDSAX2(X)
73	REAL HIPR1, HINT1
74	COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
75	WDSAX2=HINT1(79)(1.+HINT1(78)(X/HINT1(76))**2)/
76	& (1+EXP((X-HINT1(76))/HINT1(77)))
77	IF (HINT1(78).LT.0.) THEN
78	IF (X.GE.HINT1(76)/SQRT(ABS(HINT1(78)))) WDSAX2=0.
79	ENDIF
80	RETURN
81	END
82	C
83	FUNCTION PROFILE(XB)
84	REAL HIPR1, HINT1
85	COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
86	REAL BB, B1, PHI, Z1
87	COMMON/PACT_HIJING/BB,B1,PHI,Z1
88	SAVE
89	EXTERNAL FLAP, FLAP1, FLAP2
90	C
91	BB=XB
92	PROFILE=1.0
93	IF(IHNT2(1).GT.1 .AND. IHNT2(3).GT.1) THEN
94	PROFILE=float(IHNT2(1))float(IHNT2(3))0.1*
95	& GAUSS1(FLAP,0.0,HIPR1(34),0.01)
96	ELSE IF(IHNT2(1).EQ.1 .AND. IHNT2(3).GT.1) THEN
97	PROFILE=0.2float(IHNT2(3))
98	& GAUSS1(FLAP2,0.0,HIPR1(35),0.001)
99	ELSE IF(IHNT2(1).GT.1 .AND. IHNT2(3).EQ.1) THEN
100	PROFILE=0.2float(IHNT2(1))
101	& GAUSS1(FLAP1,0.0,HIPR1(34),0.001)
102	ENDIF
103	RETURN
104	END