This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / genpnt.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:03:24  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE GENPNT (NDIM,X,WT)
11       REAL X(10),WWT,WT,FUN
12       COMMON /ISTRGE/ MXRGNS,ISTOR(12000)
13       COMMON /RSTRGE/ RSTSZE,RSTOR(18001)
14       INTEGER RSTSZE
15       COMMON /BUKSZE/ MAXWRD
16       INTEGER MAXWRD
17       COMMON /TRESZE/ ENTREE,ENTBUC
18       INTEGER ENTREE,ENTBUC
19       COMMON /LIMITS/ GMINUS(10),GPLUS(10)
20       COMMON /FUNN/ NFUN, NFOPT, NFCUT /GENINL/ JNLGEN
21       COMMON /QUADRE/ IDEG
22       INTEGER IDEG
23       INTEGER NFUN,JNLGEN,INLGEN
24       INTEGER PARENT,PNTR,NTIMES,MODE
25       REAL UPLUS(10),UMINUS(10),XSAVE(10),WWTSVE
26       MODE=1
27 #if defined(CERNLIB_DOUBLE)||!defined(CERNLIB_F4)
28       ENTRY RANGEN(NDIM,X)
29 #endif
30 #if (defined(CERNLIB_SINGLE))&&(defined(CERNLIB_F4))
31       ENTRY RANGEN
32 #endif
33 C*UL 10   INLGEN=JNLGEN
34       INLGEN=JNLGEN
35       IF(INLGEN.EQ.0) GOTO 90
36       INLGEN=0
37       NTIMES=0
38       IF(ENTBUC.GT.1) GOTO 30
39       WRITE(6,20)
40  20   FORMAT(' GENPNT/RANGEN CALLED BEFORE PARTN')
41       STOP
42  30   IF(IDEG.EQ.1) GOTO 50
43       WRITE(6,40)
44  40   FORMAT(' GENPNT/RANGEN CALLED WITH IDEG NE 1')
45       STOP
46  50   IF(MAXWRD.EQ.7) GOTO 70
47       WRITE(6,60)
48  60   FORMAT(' GENPNT/RANGEN CALLED WITH IMPROPER BUCKET STORAGE')
49       STOP
50  70   ISCR=MXRGNS*(MAXWRD+1)
51       RSTOR(ISCR+1)=0.0E+0
52       PNTR=MXRGNS+1
53       DO 80 J=1,ENTBUC
54       RSTOR(ISCR+J+1)=RSTOR(ISCR+J)+RSTOR(PNTR+4)*RSTOR(PNTR+6)
55       PNTR=PNTR+MAXWRD
56  80   CONTINUE
57  90   IF(MODE.EQ.1) GOTO 100
58       IF(NTIMES.GT.0) GOTO 180
59  100  CALL RANUMS(R,1)
60       R=R*RSTOR(ISCR+ENTBUC+1)
61       NL=1
62       NH=ENTBUC+1
63  110  IF(NH.LE.NL+1) GOTO 130
64       NX=(NH+NL)/2
65       IF(R.GT.RSTOR(ISCR+NX)) GOTO 120
66       NH=NX
67       GOTO 110
68  120  NL=NX
69       GOTO 110
70  130  PARENT=1
71       DO 140 J=1,NDIM
72       UMINUS(J)=GMINUS(J)
73       UPLUS(J)=GPLUS(J)
74  140  CONTINUE
75       CALL BOUNDS(NL,PARENT,ISTOR,RSTOR,UMINUS,UPLUS)
76       PNTR=MXRGNS+1+MAXWRD*(NL-1)
77       CALL RANUMS (X(1), NDIM)
78       DO 150 J=1,NDIM
79       X(J)=(UPLUS(J)-UMINUS(J))*X(J)+UMINUS(J)
80  150  CONTINUE
81       IF(MODE.NE.1) GOTO 160
82       WT=FUN(NDIM,X)/RSTOR(PNTR+4)
83       NFUN=NFUN+1
84       RETURN
85  160  CALL RANUMS(R,1)
86       IF(R.LE.RSTOR(PNTR+5)/RSTOR(PNTR+4)) RETURN
87       WWT=FUN(NDIM,X)/RSTOR(PNTR+4)
88       NFUN=NFUN+1
89       IF(R.GT.WWT) GOTO 100
90       IF(WWT.LE.1.0E+0) RETURN
91       NTIMES=INT(WWT)
92       WWTSVE=WWT
93       DO 170 I=1,NDIM
94       XSAVE(I)=X(I)
95  170  CONTINUE
96       RETURN
97  180  IF(NTIMES.LE.1) GOTO 200
98       NTIMES=NTIMES-1
99       DO 190 I=1,NDIM
100       X(I)=XSAVE(I)
101  190  CONTINUE
102       RETURN
103  200  NTIMES=0
104       WWT=WWTSVE-INT(WWTSVE)
105       IF(R.LT.WWT) RETURN
106       GOTO 100
107       END