TAmpt/AMPT/profile.f

   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(BB**2+X**2)
  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(BB**2+X**2)
  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(B1**2+Z1**2)
  56         R2=SQRT(BB**2+B1**2-2.0*B1*BB*COS(PHI)+X**2)
  57         FGP3=B1*WDSAX1(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.2*float(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.2*float(IHNT2(1))*
 101      &          GAUSS1(FLAP1,0.0,HIPR1(34),0.001)
 102         ENDIF
 103         RETURN
 104         END