hijwds.f

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file hijwds.f

C*************************
C
C
C
C
C ********************************************************
C ************************              WOOD-SAX
        SUBROUTINE hijwds(IA,IDH,XHIGH)
C     SETS UP HISTOGRAM IDH WITH RADII FOR
C     NUCLEUS IA DISTRIBUTED ACCORDING TO THREE PARAM WOOD SAXON
        common/hiparnt/hipr1(100),ihpr2(50),hint1(100),ihnt2(50)
        SAVE  /hiparnt/
        common/wood/r,d,fnorm,w
        SAVE  /wood/
        dimension iaa(20),rr(20),dd(20),ww(20),rms(20)
        EXTERNAL rwdsax,wdsax
C
C   PARAMETERS OF SPECIAL NUCLEI FROM ATOMIC DATA AND NUC DATA TABLES
C     VOL 14, 5-6 1974
        DATA iaa/2,4,12,16,27,32,40,56,63,93,184,197,208,7*0./
        DATA rr/0.01,.964,2.355,2.608,2.84,3.458,3.766,3.971,4.214,
     1        4.87,6.51,6.38,6.624,7*0./
        DATA dd/0.5882,.322,.522,.513,.569,.61,.586,.5935,.586,.573,
     1        .535,.535,.549,7*0./
        DATA ww/0.0,.517,-0.149,-0.051,0.,-0.208,-0.161,13*0./
        DATA rms/2.11,1.71,2.46,2.73,3.05,3.247,3.482,3.737,3.925,4.31,
     1        5.42,5.33,5.521,7*0./
C
        a=ia
C
C               ********SET WOOD-SAX PARAMS FIRST  AS IN DATE ET AL
        d=0.54
C                       ********D IS WOOD SAX DIFFUSE PARAM IN FM
        r=1.19*a**(1./3.) - 1.61*a**(-1./3.)
C                       ********R IS RADIUS PARAM
        w=0.
C               ********W IS The third of three WOOD-SAX PARAM
C
C               ********CHECK TABLE FOR SPECIAL CASES
        DO 10 i=1,13
                IF (ia.EQ.iaa(i)) THEN
                        r=rr(i)
                        d=dd(i)
                        w=ww(i)
                        rs=rms(i)
                END IF
10      CONTINUE
C                       ********FNORM is the normalize factor
        fnorm=1.0
        xlow=0.
        xhigh=r+ 12.*d
        IF (w.LT.-0.01)  THEN
                IF (xhigh.GT.r/sqrt(abs(w))) xhigh=r/sqrt(abs(w))
        END IF
        fgaus=gauss1(rwdsax,xlow,xhigh,0.001)
        fnorm=1./fgaus
C
        IF (idh.EQ.1) THEN
           hint1(72)=r
           hint1(73)=d
           hint1(74)=w
           hint1(75)=fnorm/4.0/hipr1(40)
        ELSE IF (idh.EQ.2) THEN
           hint1(76)=r
           hint1(77)=d
           hint1(78)=w
           hint1(79)=fnorm/4.0/hipr1(40)
        ENDIF
C
C       NOW SET UP HBOOK FUNCTIONS IDH FOR  R**2*RHO(R)
C       THESE HISTOGRAMS ARE USED TO GENERATE RANDOM RADII
        CALL hifun(idh,xlow,xhigh,rwdsax)
        RETURN
        END