This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / partn.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 PARTN (NDIM,GMINUS,GPLUS,GOOD,MAXFUN)
11       INTEGER NDIM, NPOINT, MAXFUN
12       REAL FLOBD, FUPBD, GOOD
13       REAL GMINUS(10), GPLUS(10)
14       COMMON /PRINT/ IPRINT
15 #include "d151dt.inc"
16       COMMON /ISTRGE/ MXRGNS,TREE(4,1),DUMMY1(11996)
17       INTEGER MXRGNS, TREE
18       COMMON /RSTRGE/ RSTSZE,PRTNS(18001)
19       INTEGER RSTSZE
20       COMMON /MLIMIT/ MFLAG
21       LOGICAL MFLAG
22       COMMON /TRESZE/ ENTREE,ENTBUC
23       INTEGER ENTREE, ENTBUC
24       COMMON /START/ ISTART
25       INTEGER ISTART
26       COMMON /EXFILE/ NFILE
27       INTEGER NFILE
28       COMMON /DISPOS/ IDISP
29       INTEGER IDISP
30       COMMON /QUADRE/ IDEG
31       INTEGER IDEG
32       COMMON /BUKSZE/ MAXWRD
33       INTEGER MAXWRD
34       COMMON /GENINL/ INLGEN
35       INTEGER INLGEN
36       COMMON /LIMITS/ QMINUS(10),QPLUS(10)
37       COMMON /SAMPLE/ NPOINT
38       COMMON /BNDLMT/ FLOBD,FUPBD
39       REAL UMINUS(10),UPLUS(10)
40       INTEGER MAXDPH,PARENT
41       INTEGER TARGET,MAXBUC,NEWENT,OLDSTR,NEWBUC,NEWEND,EXMBUC
42       INTEGER NXRGNS,NEEDST,NMOVE
43 C         INITIALISATION OF CONSTANTS
44       CALL DVNBKD
45 C
46       IF(NDIM.LE.10) GOTO 20
47       WRITE(6,10) NDIM
48  10   FORMAT('0DIMENSION = ',I5,'  IS LARGER THAN UPPER LIMIT SET AT',
49      1' COMPILE TIME.')
50       STOP
51  20   DO 30 I=1,NDIM
52       QMINUS(I)=GMINUS(I)
53       QPLUS(I)=GPLUS(I)
54  30   CONTINUE
55       MAXWRD=4
56       IF(IDEG.EQ.1) MAXWRD=7
57       IF(IDEG.GE.2) MAXWRD=MAXWRD+1
58       IF(IDEG.GE.3) MAXWRD=MAXWRD+1
59       IF(IDEG.EQ.5) MAXWRD=MAXWRD+1
60       NEEDST=MXRGNS*(MAXWRD+1)+MAX((NDIM+1)*(NPOINT+5),MXRGNS)+1
61       IF(NEEDST.LE.RSTSZE) GOTO 40
62       NEEDST=RSTSZE-1
63       MXRGNS=NEEDST/(MAXWRD+2)
64       IF(MXRGNS.LT.(NDIM+1)*(NPOINT+5)) MXRGNS=(NEEDST-(NDIM+1)*(NPOINT
65      1+5))/(MAXWRD+1)
66  40   IF(ISTART.NE.2.AND.ISTART.NE.3) ISTART=1
67       INLGEN=NPOINT
68       IF(IPRINT.EQ.0) GOTO 120
69       WRITE(6,50) IDATE
70  50   FORMAT('1PARTN VERSION OF ',A8)
71       WRITE(6,60) NDIM,GOOD,MAXFUN
72  60   FORMAT(1X,I2,' DIMENSIONS. MAXIMUM RSS SPREAD OF',G13.5/
73      1 '  WITH A MAXIMUM OF  ',I6,'  INTEGRAND EVALUATIONS.')
74       IF(ISTART.NE.1) GOTO 80
75       WRITE(6,70)
76  70   FORMAT(' BEGIN PARTITIONING.')
77       GOTO 120
78  80   IF(ISTART.NE.3) GOTO 100
79       WRITE(6,90) NFILE
80  90   FORMAT(' CONTINUE PARTITIONING READ FROM TAPE',I2)
81       GOTO 120
82  100  IF(ISTART.NE.2) GOTO 120
83       WRITE(6,110)
84  110  FORMAT(' PARTITIONING CONTINUES.')
85  120  MFLAG=.FALSE.
86       IRM=18001-MXRGNS
87       I=EXMBUC(1,NDIM,PRTNS(MXRGNS+1),GOOD,MAXFUN,MAXDPH,IRM)
88       IF(ISTART.NE.1) GOTO 140
89       ENTREE=1
90       ENTBUC=ENTREE
91       MXWDSV=MAXWRD
92       NXRGNS=MXRGNS
93       DO 130 I=1,NDIM
94       UPLUS(I)=GPLUS(I)
95       UMINUS(I)=GMINUS(I)
96  130  CONTINUE
97       IMR=18001-MXRGNS
98       CALL RECPAR(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,MAXDPH,ENTREE,TREE,PRTN
99      1S,ENTBUC,PRTNS(MXRGNS+1),IMR)
100       GOTO 160
101  140  IF(ISTART.NE.3) GOTO 160
102       READ (NFILE) ENTREE,INFO,NXRGNS,MXWDSV,((TREE(I,J),I=1,4),J=1,ENTR
103      1EE),(PRTNS(J),J=1,INFO)
104       ENTBUC=(INFO-NXRGNS)/MXWDSV
105       IF(ENTREE.EQ.ENTBUC-1) GOTO 160
106       WRITE(6,150) NFILE
107  150  FORMAT(' INCONSISTENT INFORMATION ON TAPE',I2)
108       STOP
109  160  IF(NXRGNS.EQ.MXRGNS) GOTO 230
110       NMOVE=MXWDSV*NXRGNS
111       IF(NXRGNS.LE.MXRGNS) GOTO 200
112       IF(ENTBUC.LT.MXRGNS) GOTO 180
113       WRITE(6,170) MXRGNS,ENTBUC
114  170  FORMAT(' MAXIMUM NUMBER OF REGIONS ',I5,' IS TOO SMALL.'/
115      1 ' RESET TO GREATER THAN ',I5,'.')
116       STOP
117  180  DO 190 I=1,NMOVE
118       PRTNS(I+MXRGNS)=PRTNS(I+NXRGNS)
119  190  CONTINUE
120       GOTO 230
121  200  I=NMOVE
122       GOTO 220
123  210  I=I+(-1)
124  220  IF((-1)*((I)-(1)).GT.0) GOTO 230
125       PRTNS(I+MXRGNS)=PRTNS(I+NXRGNS)
126       GOTO 210
127  230  IF(MXWDSV.EQ.MAXWRD) GOTO 300
128       IF(MXWDSV.GE.MAXWRD) GOTO 270
129       I=ENTBUC
130       GOTO 250
131  240  I=I+(-1)
132  250  IF((-1)*((I)-(1)).GT.0) GOTO 300
133       DO 260 J=1,MXWDSV
134       PRTNS(MAXWRD*(I-1)+J+MXRGNS)=PRTNS(MXWDSV*(I-1)+J+MXRGNS)
135  260  CONTINUE
136       GOTO 240
137  270  DO 290 I=1,ENTBUC
138       DO 280 J=1,MAXWRD
139       PRTNS(MAXWRD*(I-1)+J+MXRGNS)=PRTNS(MXWDSV*(I-1)+J+MXRGNS)
140  280  CONTINUE
141  290  CONTINUE
142  300  TARGET=EXMBUC(ENTBUC,NDIM,PRTNS(MXRGNS+1),GOOD,MAXFUN,MAXDPH,IRM)
143       IF(TARGET.EQ.0) GOTO 350
144       PARENT=1
145       DO 310 I=1,NDIM
146       UPLUS(I)=GPLUS(I)
147       UMINUS(I)=GMINUS(I)
148  310  CONTINUE
149       CALL BOUNDS(TARGET,PARENT,TREE,PRTNS,UMINUS,UPLUS)
150       NEWENT=ENTREE+1
151       NEWBUC=ENTBUC+1
152       IMR=18001-MXRGNS
153       CALL RECPAR(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,MAXDPH,NEWENT,TREE,PRTN
154      1S,NEWBUC,PRTNS(MXRGNS+1),IMR)
155       IF(.NOT.(MFLAG)) GOTO 330
156       WRITE(6,320) MXRGNS
157  320  FORMAT(' STORAGE LIMIT  ',I6,' REACHED.')
158       GOTO 350
159  330  IF(NEWBUC.EQ.ENTBUC+1) GOTO 350
160       MAXBUC=NEWBUC
161       PARENT=ENTREE+1
162       OLDSTR=ENTBUC+1
163       NEWBUC=TARGET
164       CALL TREAUD(PARENT,OLDSTR,NEWBUC,MAXBUC-ENTBUC+NEWBUC-1,TREE)
165       NEWEND=NEWBUC
166       IF(TARGET.GE.ENTBUC) GOTO 340
167       PARENT=1
168       OLDSTR=TARGET+1
169       NEWBUC=NEWBUC+1
170       CALL TREAUD(PARENT,OLDSTR,NEWBUC,MAXBUC-1,TREE)
171  340  PARENT=1
172       CALL NODAUD(PARENT,TARGET,ENTREE+1,NEWEND,TREE)
173       I11=18001-MAXWRD*MXRGNS-MXRGNS
174       I12=18001-MXRGNS
175       CALL BUCMVE(TARGET,NEWEND,ENTBUC+1,PRTNS(MAXWRD*MXRGNS+MXRGNS+1),
176      1PRTNS(MXRGNS+1),I11,I12)
177       ENTBUC=MAXBUC-1
178       ENTREE=NEWENT
179       GOTO 300
180  350  MXWDSV=MAXWRD
181       NXRGNS=MXRGNS
182       IF(IDISP.EQ.0) RETURN
183       INFO=MXRGNS+MAXWRD*ENTBUC
184       REWIND NFILE
185       WRITE(NFILE) ENTREE,INFO,MXRGNS,MAXWRD,((TREE(I,J),I=1,4),J=1,ENT
186      1REE),(PRTNS(J),J=1,INFO)
187       END FILE NFILE
188       IF(IPRINT.EQ.0) GOTO 370
189       WRITE(6,360) NFILE
190  360  FORMAT(' INFORMATION FOR RESTART WRITTEN ON TAPE',I2)
191  370  RETURN
192       END