hijing/src/hijwds.f

0001 C*************************
0002 C
0003 C
0004 C
0005 C
0006 C ********************************************************
0007 C ************************              WOOD-SAX
0008         SUBROUTINE HIJWDS(IA,IDH,XHIGH)
0009 C     SETS UP HISTOGRAM IDH WITH RADII FOR
0010 C     NUCLEUS IA DISTRIBUTED ACCORDING TO THREE PARAM WOOD SAXON
0011         COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
0012         SAVE  /HIPARNT/
0013         COMMON/WOOD/R,D,FNORM,W
0014         SAVE  /WOOD/
0015         DIMENSION IAA(20),RR(20),DD(20),WW(20),RMS(20)
0016         EXTERNAL RWDSAX,WDSAX
0017 C
0018 C   PARAMETERS OF SPECIAL NUCLEI FROM ATOMIC DATA AND NUC DATA TABLES
0019 C     VOL 14, 5-6 1974
0020         DATA IAA/2,4,12,16,27,32,40,56,63,93,184,197,208,7*0./
0021         DATA RR/0.01,.964,2.355,2.608,2.84,3.458,3.766,3.971,4.214,
0022      1        4.87,6.51,6.38,6.624,7*0./
0023         DATA DD/0.5882,.322,.522,.513,.569,.61,.586,.5935,.586,.573,
0024      1        .535,.535,.549,7*0./
0025         DATA WW/0.0,.517,-0.149,-0.051,0.,-0.208,-0.161,13*0./
0026         DATA RMS/2.11,1.71,2.46,2.73,3.05,3.247,3.482,3.737,3.925,4.31,
0027      1        5.42,5.33,5.521,7*0./
0028 C
0029         A=IA
0030 C
0031 C               ********SET WOOD-SAX PARAMS FIRST  AS IN DATE ET AL
0032         D=0.54
0033 C                       ********D IS WOOD SAX DIFFUSE PARAM IN FM
0034         R=1.19*A**(1./3.) - 1.61*A**(-1./3.)
0035 C                       ********R IS RADIUS PARAM
0036         W=0.
0037 C               ********W IS The third of three WOOD-SAX PARAM
0038 C
0039 C               ********CHECK TABLE FOR SPECIAL CASES
0040         DO 10 I=1,13
0041                 IF (IA.EQ.IAA(I)) THEN
0042                         R=RR(I)
0043                         D=DD(I)
0044                         W=WW(I)
0045                         RS=RMS(I)
0046                 END IF
0047 10      CONTINUE
0048 C                       ********FNORM is the normalize factor
0049         FNORM=1.0
0050         XLOW=0.
0051         XHIGH=R+ 12.*D
0052         IF (W.LT.-0.01)  THEN
0053                 IF (XHIGH.GT.R/SQRT(ABS(W))) XHIGH=R/SQRT(ABS(W))
0054         END IF
0055         FGAUS=GAUSS1(RWDSAX,XLOW,XHIGH,0.001)
0056         FNORM=1./FGAUS
0057 C
0058         IF (IDH.EQ.1) THEN
0059            HINT1(72)=R
0060            HINT1(73)=D
0061            HINT1(74)=W
0062            HINT1(75)=FNORM/4.0/HIPR1(40)
0063         ELSE IF (IDH.EQ.2) THEN
0064            HINT1(76)=R
0065            HINT1(77)=D
0066            HINT1(78)=W
0067            HINT1(79)=FNORM/4.0/HIPR1(40)
0068         ENDIF
0069 C
0070 C       NOW SET UP HBOOK FUNCTIONS IDH FOR  R**2*RHO(R)
0071 C       THESE HISTOGRAMS ARE USED TO GENERATE RANDOM RADII
0072         CALL HIFUN(IDH,XLOW,XHIGH,RWDSAX)
0073         RETURN
0074         END