f7da0b4a510df80746a84195b1c866d5c70443be
[u/mrichter/AliRoot.git] / HIJING / hijing1_36 / hijwds.F
1 * $Id$
2 C*************************
3 C
4 C
5 C
6 C
7 C ********************************************************
8 C ************************              WOOD-SAX
9         SUBROUTINE HIJWDS(IA,IDH,XHIGH)
10 C     SETS UP HISTOGRAM IDH WITH RADII FOR
11 C     NUCLEUS IA DISTRIBUTED ACCORDING TO THREE PARAM WOOD SAXON
12 #define BLANKET_SAVE
13 #include "hiparnt.inc"
14 #include "wood_hijing.inc"
15         DIMENSION IAA(20),RR(20),DD(20),WW(20),RMS(20)
16         EXTERNAL RWDSAX,WDSAX
17 C
18 C   PARAMETERS OF SPECIAL NUCLEI FROM ATOMIC DATA AND NUC DATA TABLES
19 C     VOL 14, 5-6 1974
20         DATA IAA/4,12,16,27,32,40,56,63,93,184,197,208,8*0./
21         DATA RR/.964,2.355,2.608,2.84,3.458,3.766,3.971,4.214,
22      1        4.87,6.51,6.38,6.624,8*0./
23         DATA DD/.322,.522,.513,.569,.61,.586,.5935,.586,.573,
24      1        .535,.535,.549,8*0./
25         DATA WW/.517,-0.149,-0.051,0.,-0.208,-0.161,14*0./
26         DATA RMS/1.71,2.46,2.73,3.05,3.247,3.482,3.737,3.925,4.31,
27      1        5.42,5.33,5.521,8*0./
28         SAVE
29 C
30         A=IA
31 C
32 C               ********SET WOOD-SAX PARAMS FIRST  AS IN DATE ET AL
33         D=0.54
34 C                       ********D IS WOOD SAX DIFFUSE PARAM IN FM
35         R=1.19*A**(1./3.) - 1.61*A**(-1./3.)
36 C                       ********R IS RADIUS PARAM
37         W=0.
38 C               ********W IS The third of three WOOD-SAX PARAM
39 C
40 C               ********CHECK TABLE FOR SPECIAL CASES
41         DO 10 I=1,12
42                 IF (IA.EQ.IAA(I)) THEN
43                         R=RR(I)
44                         D=DD(I)
45                         W=WW(I)
46                         RS=RMS(I)
47                 END IF
48 10      CONTINUE
49 C                       ********FNORM is the normalize factor
50         FNORM=1.0
51         XLOW=0.
52         XHIGH=R+ 12.*D
53         IF (W.LT.-0.01)  THEN
54                 IF (XHIGH.GT.R/SQRT(ABS(W))) XHIGH=R/SQRT(ABS(W))
55         END IF
56         FGAUS=GAUSS1(RWDSAX,XLOW,XHIGH,0.001)
57         FNORM=1./FGAUS
58 C
59         IF (IDH.EQ.1) THEN
60            HINT1(72)=R
61            HINT1(73)=D
62            HINT1(74)=W
63            HINT1(75)=FNORM/4.0/HIPR1(40)
64         ELSE IF (IDH.EQ.2) THEN
65            HINT1(76)=R
66            HINT1(77)=D
67            HINT1(78)=W
68            HINT1(79)=FNORM/4.0/HIPR1(40)
69         ENDIF
70 C
71 C       NOW SET UP HBOOK FUNCTIONS IDH FOR  R**2*RHO(R)
72 C       THESE HISTOGRAMS ARE USED TO GENERATE RANDOM RADII
73         CALL HIFUN(IDH,XLOW,XHIGH,RWDSAX)
74         RETURN
75         END