[u/mrichter/AliRoot.git] / HERWIG / jimmy / divon4 / partn.F

*CMZ :          26/08/93  16.47.55  by  Jonathan Butterworth
*-- Author :
      SUBROUTINE PARTN (NDIM,GMINUS,GPLUS,GOOD,MAXFUN)
      INTEGER NDIM, NPOINT, MAXFUN
      REAL FLOBD, FUPBD, GOOD
      REAL GMINUS(10), GPLUS(10)
      COMMON /D151DT/ IDATE /PRINT/ IPRINT
      REAL*8 IDATE
      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
      SAVE

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