* * $Id: partn.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $ * * $Log: partn.F,v $ * 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