+++ /dev/null
-*
-* $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
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff