[u/mrichter/AliRoot.git] / HIJING / hijing1_36 / hijwds.F

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