[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / partn.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:03:24  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE PARTN (NDIM,GMINUS,GPLUS,GOOD,MAXFUN)
      INTEGER NDIM, NPOINT, MAXFUN
      REAL FLOBD, FUPBD, GOOD
      REAL GMINUS(10), GPLUS(10)
      COMMON /PRINT/ IPRINT
#include "d151dt.inc"
      COMMON /ISTRGE/ MXRGNS,TREE(4,1),DUMMY1(11996)
      INTEGER MXRGNS, TREE
      COMMON /RSTRGE/ RSTSZE,PRTNS(18001)
      INTEGER RSTSZE
      COMMON /MLIMIT/ MFLAG
      LOGICAL MFLAG
      COMMON /TRESZE/ ENTREE,ENTBUC
      INTEGER ENTREE, ENTBUC
      COMMON /START/ ISTART
      INTEGER ISTART
      COMMON /EXFILE/ NFILE
      INTEGER NFILE
      COMMON /DISPOS/ IDISP
      INTEGER IDISP
      COMMON /QUADRE/ IDEG
      INTEGER IDEG
      COMMON /BUKSZE/ MAXWRD
      INTEGER MAXWRD
      COMMON /GENINL/ INLGEN
      INTEGER INLGEN
      COMMON /LIMITS/ QMINUS(10),QPLUS(10)
      COMMON /SAMPLE/ NPOINT
      COMMON /BNDLMT/ FLOBD,FUPBD
      REAL UMINUS(10),UPLUS(10)
      INTEGER MAXDPH,PARENT
      INTEGER TARGET,MAXBUC,NEWENT,OLDSTR,NEWBUC,NEWEND,EXMBUC
      INTEGER NXRGNS,NEEDST,NMOVE
C         INITIALISATION OF CONSTANTS
      CALL DVNBKD
C
      IF(NDIM.LE.10) GOTO 20
      WRITE(6,10) NDIM
 10   FORMAT('0DIMENSION = ',I5,'  IS LARGER THAN UPPER LIMIT SET AT',
     1' COMPILE TIME.')
      STOP
 20   DO 30 I=1,NDIM
      QMINUS(I)=GMINUS(I)
      QPLUS(I)=GPLUS(I)
 30   CONTINUE
      MAXWRD=4
      IF(IDEG.EQ.1) MAXWRD=7
      IF(IDEG.GE.2) MAXWRD=MAXWRD+1
      IF(IDEG.GE.3) MAXWRD=MAXWRD+1
      IF(IDEG.EQ.5) MAXWRD=MAXWRD+1
      NEEDST=MXRGNS*(MAXWRD+1)+MAX((NDIM+1)*(NPOINT+5),MXRGNS)+1
      IF(NEEDST.LE.RSTSZE) GOTO 40
      NEEDST=RSTSZE-1
      MXRGNS=NEEDST/(MAXWRD+2)
      IF(MXRGNS.LT.(NDIM+1)*(NPOINT+5)) MXRGNS=(NEEDST-(NDIM+1)*(NPOINT
     1+5))/(MAXWRD+1)
 40   IF(ISTART.NE.2.AND.ISTART.NE.3) ISTART=1
      INLGEN=NPOINT
      IF(IPRINT.EQ.0) GOTO 120
      WRITE(6,50) IDATE
 50   FORMAT('1PARTN VERSION OF ',A8)
      WRITE(6,60) NDIM,GOOD,MAXFUN
 60   FORMAT(1X,I2,' DIMENSIONS. MAXIMUM RSS SPREAD OF',G13.5/
     1 '  WITH A MAXIMUM OF  ',I6,'  INTEGRAND EVALUATIONS.')
      IF(ISTART.NE.1) GOTO 80
      WRITE(6,70)
 70   FORMAT(' BEGIN PARTITIONING.')
      GOTO 120
 80   IF(ISTART.NE.3) GOTO 100
      WRITE(6,90) NFILE
 90   FORMAT(' CONTINUE PARTITIONING READ FROM TAPE',I2)
      GOTO 120
 100  IF(ISTART.NE.2) GOTO 120
      WRITE(6,110)
 110  FORMAT(' PARTITIONING CONTINUES.')
 120  MFLAG=.FALSE.
      IRM=18001-MXRGNS
      I=EXMBUC(1,NDIM,PRTNS(MXRGNS+1),GOOD,MAXFUN,MAXDPH,IRM)
      IF(ISTART.NE.1) GOTO 140
      ENTREE=1
      ENTBUC=ENTREE
      MXWDSV=MAXWRD
      NXRGNS=MXRGNS
      DO 130 I=1,NDIM
      UPLUS(I)=GPLUS(I)
      UMINUS(I)=GMINUS(I)
 130  CONTINUE
      IMR=18001-MXRGNS
      CALL RECPAR(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,MAXDPH,ENTREE,TREE,PRTN
     1S,ENTBUC,PRTNS(MXRGNS+1),IMR)
      GOTO 160
 140  IF(ISTART.NE.3) GOTO 160
      READ (NFILE) ENTREE,INFO,NXRGNS,MXWDSV,((TREE(I,J),I=1,4),J=1,ENTR
     1EE),(PRTNS(J),J=1,INFO)
      ENTBUC=(INFO-NXRGNS)/MXWDSV
      IF(ENTREE.EQ.ENTBUC-1) GOTO 160
      WRITE(6,150) NFILE
 150  FORMAT(' INCONSISTENT INFORMATION ON TAPE',I2)
      STOP
 160  IF(NXRGNS.EQ.MXRGNS) GOTO 230
      NMOVE=MXWDSV*NXRGNS
      IF(NXRGNS.LE.MXRGNS) GOTO 200
      IF(ENTBUC.LT.MXRGNS) GOTO 180
      WRITE(6,170) MXRGNS,ENTBUC
 170  FORMAT(' MAXIMUM NUMBER OF REGIONS ',I5,' IS TOO SMALL.'/
     1 ' RESET TO GREATER THAN ',I5,'.')
      STOP
 180  DO 190 I=1,NMOVE
      PRTNS(I+MXRGNS)=PRTNS(I+NXRGNS)
 190  CONTINUE
      GOTO 230
 200  I=NMOVE
      GOTO 220
 210  I=I+(-1)
 220  IF((-1)*((I)-(1)).GT.0) GOTO 230
      PRTNS(I+MXRGNS)=PRTNS(I+NXRGNS)
      GOTO 210
 230  IF(MXWDSV.EQ.MAXWRD) GOTO 300
      IF(MXWDSV.GE.MAXWRD) GOTO 270
      I=ENTBUC
      GOTO 250
 240  I=I+(-1)
 250  IF((-1)*((I)-(1)).GT.0) GOTO 300
      DO 260 J=1,MXWDSV
      PRTNS(MAXWRD*(I-1)+J+MXRGNS)=PRTNS(MXWDSV*(I-1)+J+MXRGNS)
 260  CONTINUE
      GOTO 240
 270  DO 290 I=1,ENTBUC
      DO 280 J=1,MAXWRD
      PRTNS(MAXWRD*(I-1)+J+MXRGNS)=PRTNS(MXWDSV*(I-1)+J+MXRGNS)
 280  CONTINUE
 290  CONTINUE
 300  TARGET=EXMBUC(ENTBUC,NDIM,PRTNS(MXRGNS+1),GOOD,MAXFUN,MAXDPH,IRM)
      IF(TARGET.EQ.0) GOTO 350
      PARENT=1
      DO 310 I=1,NDIM
      UPLUS(I)=GPLUS(I)
      UMINUS(I)=GMINUS(I)
 310  CONTINUE
      CALL BOUNDS(TARGET,PARENT,TREE,PRTNS,UMINUS,UPLUS)
      NEWENT=ENTREE+1
      NEWBUC=ENTBUC+1
      IMR=18001-MXRGNS
      CALL RECPAR(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,MAXDPH,NEWENT,TREE,PRTN
     1S,NEWBUC,PRTNS(MXRGNS+1),IMR)
      IF(.NOT.(MFLAG)) GOTO 330
      WRITE(6,320) MXRGNS
 320  FORMAT(' STORAGE LIMIT  ',I6,' REACHED.')
      GOTO 350
 330  IF(NEWBUC.EQ.ENTBUC+1) GOTO 350
      MAXBUC=NEWBUC
      PARENT=ENTREE+1
      OLDSTR=ENTBUC+1
      NEWBUC=TARGET
      CALL TREAUD(PARENT,OLDSTR,NEWBUC,MAXBUC-ENTBUC+NEWBUC-1,TREE)
      NEWEND=NEWBUC
      IF(TARGET.GE.ENTBUC) GOTO 340
      PARENT=1
      OLDSTR=TARGET+1
      NEWBUC=NEWBUC+1
      CALL TREAUD(PARENT,OLDSTR,NEWBUC,MAXBUC-1,TREE)
 340  PARENT=1
      CALL NODAUD(PARENT,TARGET,ENTREE+1,NEWEND,TREE)
      I11=18001-MAXWRD*MXRGNS-MXRGNS
      I12=18001-MXRGNS
      CALL BUCMVE(TARGET,NEWEND,ENTBUC+1,PRTNS(MAXWRD*MXRGNS+MXRGNS+1),
     1PRTNS(MXRGNS+1),I11,I12)
      ENTBUC=MAXBUC-1
      ENTREE=NEWENT
      GOTO 300
 350  MXWDSV=MAXWRD
      NXRGNS=MXRGNS
      IF(IDISP.EQ.0) RETURN
      INFO=MXRGNS+MAXWRD*ENTBUC
      REWIND NFILE
      WRITE(NFILE) ENTREE,INFO,MXRGNS,MAXWRD,((TREE(I,J),I=1,4),J=1,ENT
     1REE),(PRTNS(J),J=1,INFO)
      END FILE NFILE
      IF(IPRINT.EQ.0) GOTO 370
      WRITE(6,360) NFILE
 360  FORMAT(' INFORMATION FOR RESTART WRITTEN ON TAPE',I2)
 370  RETURN
      END
Commit	Line	Data
fe4da5cc	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