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