MINICERN/mathlib/gen/divon/recpar.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 RECPAR (NDIM,UMINUS,UPLUS,FLOBD,FUPBD,MAXDPH,ENTREE,TRE
  11      1E,PARTN,ENTBUC,BUCKTS,IBUC)
  12       INTEGER NDIM,ENTREE,ENTBUC,TREE(4,1000),MAXDPH
  13       REAL UMINUS(NDIM),UPLUS(NDIM),PARTN(18001),BUCKTS(IBUC)
  14       COMMON /MLIMIT/ MFLAG
  15       LOGICAL MFLAG
  16       COMMON /ISTRGE/ BUKMAX, DUMMY1(12000)
  17       COMMON /BUKSZE/ MAXWRD
  18 C*NS  INTEGER MAXWRD,TREMAX,BUKMAX,PARENT,COORD
  19       INTEGER MAXWRD,TREMAX,BUKMAX,PARENT
  20       LOGICAL TERMNL
  21       INTEGER SNODES(100)
  22       INTEGER PNODES,MNODES
  23       REAL SPRTNS(100)
  24       INTEGER PPRTNS,MPRTNS
  25       INTEGER SAXES(100)
  26       INTEGER PAXES,MAXES
  27       IF(100.GT.100) GOTO 420
  28       PNODES=0
  29       MNODES=100
  30       IF(100.GT.100) GOTO 440
  31       PPRTNS=0
  32       MPRTNS=100
  33       IF(100.GT.100) GOTO 460
  34       PAXES=0
  35       MAXES=100
  36       TREMAX=BUKMAX-1
  37       TERMNL=.FALSE.
  38       IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
  39       IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
  40       CALL SPLIT(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,TERMNL,ITREE,PARTN(ENTRE
  41      1E),BUCKTS(MAXWRD*(ENTBUC-1)+1),IRBUC)
  42       TREE(4,ENTREE)=-ITREE
  43       IF(TERMNL) RETURN
  44       PNODES=PNODES+1
  45       IF(PNODES.GT.MNODES) GOTO 320
  46       SNODES(PNODES)=ENTREE
  47       TREE(1,ENTREE)=0
  48  10   ENTREE=ENTREE+1
  49       IF(ENTREE.GT.TREMAX) GOTO 380
  50       TERMNL=PNODES.GE.MAXDPH
  51       IF(PNODES.LE.0) GOTO 210
  52       PARENT=SNODES(PNODES)
  53       JTREE=TREE(4,PARENT)
  54       PAXES=PAXES+1
  55       IF(PAXES.GT.MAXES) GOTO 360
  56       SAXES(PAXES)=JTREE
  57       IF(TREE(1,PARENT).NE.0) GOTO 90
  58       IF(JTREE.GE.0) GOTO 20
  59       PPRTNS=PPRTNS+1
  60       IF(PPRTNS.GT.MPRTNS) GOTO 340
  61       SPRTNS(PPRTNS)=UPLUS(-JTREE)
  62       UPLUS(-JTREE)=PARTN(PARENT)
  63       GOTO 30
  64  20   PPRTNS=PPRTNS+1
  65       IF(PPRTNS.GT.MPRTNS) GOTO 340
  66       SPRTNS(PPRTNS)=UMINUS(JTREE)
  67       UMINUS(JTREE)=PARTN(PARENT)
  68  30   IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
  69       IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
  70       CALL SPLIT(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,TERMNL,ITREE,PARTN(ENTRE
  71      1E),BUCKTS(MAXWRD*(ENTBUC-1)+1),IRBUC)
  72       TREE(4,ENTREE)=-ITREE
  73       IF(.NOT.(.NOT.TERMNL)) GOTO 50
  74       IF(JTREE.GE.0) GOTO 40
  75       TREE(2,PARENT)=ENTREE
  76       TREE(1,ENTREE)=0
  77       PNODES=PNODES+1
  78       IF(PNODES.GT.MNODES) GOTO 320
  79       SNODES(PNODES)=ENTREE
  80       GOTO 10
  81  40   TREE(3,PARENT)=ENTREE
  82       TREE(1,ENTREE)=0
  83       PNODES=PNODES+1
  84       IF(PNODES.GT.MNODES) GOTO 320
  85       SNODES(PNODES)=ENTREE
  86       GOTO 10
  87  50   ENTREE=ENTREE-1
  88       IF(ENTREE.LT.1) GOTO 400
  89       IF(JTREE.GE.0) GOTO 60
  90       TREE(2,PARENT)=-ENTBUC
  91       GOTO 70
  92  60   TREE(3,PARENT)=-ENTBUC
  93  70   TREE(1,PARENT)=ENTBUC
  94       ENTBUC=ENTBUC+1
  95       IF(ENTBUC.GT.BUKMAX) GOTO 390
  96       IF(PAXES.LE.0) GOTO 220
  97       JTREE=SAXES(PAXES)
  98       PAXES=PAXES-1
  99       IF(PAXES.LT.0) GOTO 280
 100       IF(JTREE.GE.0) GOTO 80
 101       IF(PPRTNS.LE.0) GOTO 240
 102       UPLUS(-JTREE)=SPRTNS(PPRTNS)
 103       PPRTNS=PPRTNS-1
 104       IF(PPRTNS.LT.0) GOTO 300
 105       GOTO 10
 106  80   IF(PPRTNS.LE.0) GOTO 240
 107       UMINUS(JTREE)=SPRTNS(PPRTNS)
 108       PPRTNS=PPRTNS-1
 109       IF(PPRTNS.LT.0) GOTO 300
 110       GOTO 10
 111  90   IF(JTREE.LE.0) GOTO 100
 112       PPRTNS=PPRTNS+1
 113       IF(PPRTNS.GT.MPRTNS) GOTO 340
 114       SPRTNS(PPRTNS)=UPLUS(JTREE)
 115       UPLUS(JTREE)=PARTN(PARENT)
 116       GOTO 110
 117  100  PPRTNS=PPRTNS+1
 118       IF(PPRTNS.GT.MPRTNS) GOTO 340
 119       SPRTNS(PPRTNS)=UMINUS(-JTREE)
 120       UMINUS(-JTREE)=PARTN(PARENT)
 121  110  IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
 122       IRBUC=IBUC-(MAXWRD*(ENTBUC-1))
 123       CALL SPLIT(NDIM,UMINUS,UPLUS,FLOBD,FUPBD,TERMNL,ITREE,PARTN(ENTRE
 124      1E),BUCKTS(MAXWRD*(ENTBUC-1)+1),IRBUC)
 125       TREE(4,ENTREE)=-ITREE
 126       IF(.NOT.(.NOT.TERMNL)) GOTO 130
 127       IF(JTREE.LE.0) GOTO 120
 128       TREE(2,PARENT)=ENTREE
 129       TREE(1,ENTREE)=0
 130       PNODES=PNODES+1
 131       IF(PNODES.GT.MNODES) GOTO 320
 132       SNODES(PNODES)=ENTREE
 133       GOTO 10
 134  120  TREE(3,PARENT)=ENTREE
 135       TREE(1,ENTREE)=0
 136       PNODES=PNODES+1
 137       IF(PNODES.GT.MNODES) GOTO 320
 138       SNODES(PNODES)=ENTREE
 139       GOTO 10
 140  130  ENTREE=ENTREE-1
 141       IF(ENTREE.LT.1) GOTO 400
 142       IF(JTREE.LE.0) GOTO 140
 143       TREE(2,PARENT)=-ENTBUC
 144       GOTO 150
 145  140  TREE(3,PARENT)=-ENTBUC
 146  150  IF(TREE(1,PARENT).EQ.0) GOTO 180
 147       IF(PAXES.LE.0) GOTO 220
 148       JTREE=SAXES(PAXES)
 149       PAXES=PAXES-1
 150       IF(PAXES.LT.0) GOTO 280
 151       IF(JTREE.LE.0) GOTO 160
 152       IF(PPRTNS.LE.0) GOTO 240
 153       UPLUS(JTREE)=SPRTNS(PPRTNS)
 154       PPRTNS=PPRTNS-1
 155       IF(PPRTNS.LT.0) GOTO 300
 156       GOTO 170
 157  160  IF(PPRTNS.LE.0) GOTO 240
 158       UMINUS(-JTREE)=SPRTNS(PPRTNS)
 159       PPRTNS=PPRTNS-1
 160       IF(PPRTNS.LT.0) GOTO 300
 161  170  PNODES=PNODES-1
 162       IF(PNODES.LT.0) GOTO 260
 163       IF(PNODES.LE.0) GOTO 210
 164       PARENT=SNODES(PNODES)
 165       GOTO 150
 166  180  IF(PAXES.LE.0) GOTO 220
 167       JTREE=SAXES(PAXES)
 168       PAXES=PAXES-1
 169       IF(PAXES.LT.0) GOTO 280
 170       IF(JTREE.GE.0) GOTO 190
 171       IF(PPRTNS.LE.0) GOTO 240
 172       UPLUS(-JTREE)=SPRTNS(PPRTNS)
 173       PPRTNS=PPRTNS-1
 174       IF(PPRTNS.LT.0) GOTO 300
 175       GOTO 200
 176  190  IF(PPRTNS.LE.0) GOTO 240
 177       UMINUS(JTREE)=SPRTNS(PPRTNS)
 178       PPRTNS=PPRTNS-1
 179       IF(PPRTNS.LT.0) GOTO 300
 180  200  TREE(1,PARENT)=ENTBUC
 181       ENTBUC=ENTBUC+1
 182       IF(ENTBUC.GT.BUKMAX) GOTO 390
 183       GOTO 10
 184  210  RETURN
 185  220  WRITE(6,230)
 186  230  FORMAT(' STACK AXES EMPTY')
 187       STOP
 188  240  WRITE(6,250)
 189  250  FORMAT(' STACK PRTNS EMPTY')
 190       STOP
 191  260  WRITE(6,270)
 192  270  FORMAT(' STACK NODES UNDERFLOW')
 193       STOP
 194  280  WRITE(6,290)
 195  290  FORMAT(' STACK AXES UNDERFLOW')
 196       STOP
 197  300  WRITE(6,310)
 198  310  FORMAT(' STACK PRTNS UNDERFLOW')
 199       STOP
 200  320  WRITE(6,330)
 201  330  FORMAT(' STACK NODES OVERFLOW')
 202       STOP
 203  340  WRITE(6,350)
 204  350  FORMAT(' STACK PRTNS OVERFLOW')
 205       STOP
 206  360  WRITE(6,370)
 207  370  FORMAT(' STACK AXES OVERFLOW')
 208       STOP
 209  380  MFLAG=.TRUE.
 210       RETURN
 211  390  MFLAG=.TRUE.
 212       RETURN
 213  400  WRITE(6,410)
 214  410  FORMAT(' ENTREE DECREMENTED PAST ONE')
 215       STOP
 216  420  WRITE(6,430) MAXDPH
 217  430  FORMAT(' MAXDPH = ',I10,' TOO LARGE')
 218       STOP
 219  440  WRITE(6,450) MAXDPH
 220  450  FORMAT(' MAXDPH = ',I10,' TOO LARGE')
 221       STOP
 222  460  WRITE(6,470) MAXDPH
 223  470  FORMAT(' MAXDPH = ',I10,' TOO LARGE')
 224       STOP
 225       END