MINICERN/mathlib/gen/v/pgraph.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:57  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE PGRAPH(WEIT, EDGES, NODES, SET, SETPTR, NPTR)
  11       INTEGER EDGES, TABNR, ONETWO, TWOONE, SETPTR
  12       INTEGER CHOICE
  13       INTEGER SETT(652)
  14       INTEGER WEIT(652,2)
  15       INTEGER SET(96)
  16       INTEGER WSET(96)
  17       INTEGER VSET(96)
  18       INTEGER TEIT(652,2)
  19       INTEGER LTEIT(96)
  20       INTEGER LSETT(96)
  21       COMMON /BITSXB/ NBITPW, NBYTPW
  22       IF(NPTR.GT.0) GO TO CHOICE,(10,20)
  23       LWEIT = EDGES
  24       TABNR = 1
  25       LTEIT(1) = 0
  26       LSETT(1) = 0
  27       K1 = 0
  28       LWSET = 0
  29       LVSET = 0
  30 888   CONTINUE
  31       MAX = 0
  32       NODE = 0
  33       DO 60 L = 1,NODES
  34       NODEFQ = 0
  35       DO 1 K = 1,LWEIT
  36       IF(IGET(WEIT(1,1), K) .EQ. L) NODEFQ = NODEFQ + 1
  37       IF(IGET(WEIT(1,2), K) .EQ. L) NODEFQ = NODEFQ + 1
  38 1     CONTINUE
  39       IF(MAX .GE. NODEFQ) GO TO 60
  40       MAX = NODEFQ
  41       NODE = L
  42 60    CONTINUE
  43 C
  44 C ***   STEP2
  45 C
  46       LVSET = LVSET + 1
  47       VSET(LVSET) = NODE
  48 C
  49 C ***   STEP 3 + 4
  50 C
  51       K1 = 0
  52       K2 = 0
  53       DO 2 I = 1,LWEIT
  54       DO 3 ONETWO = 1,2
  55       IF(IGET(WEIT(1,ONETWO), I) .NE. NODE) GO TO 3
  56       TWOONE = 3 - ONETWO
  57       LWSET = LWSET + 1
  58       WSET(LWSET) = IGET(WEIT(1,TWOONE), I)
  59       K2 = K2 + 1
  60       GO TO 2
  61 3     CONTINUE
  62       IND = LTEIT(TABNR) + 1 + K1
  63       CALL TUP(TEIT(1,1), IND, IGET(WEIT(1,1), I))
  64       CALL TUP(TEIT(1,2), IND, IGET(WEIT(1,2), I))
  65       K1 = K1 + 1
  66 2     CONTINUE
  67       IF(K1 .EQ. 0) GO TO 300
  68       IND = LSETT(TABNR) + 1
  69       DO 51 I = 1,LVSET
  70       CALL TUP(SETT, IND, VSET(I))
  71 51    IND = IND + 1
  72 C
  73 C ***   STEP 5
  74 C
  75       TABNR = TABNR + 1
  76       LSETT(TABNR) = LSETT(TABNR - 1) + LVSET
  77       LTEIT(TABNR) = LTEIT(TABNR - 1) + K1
  78       IEND = LTEIT(TABNR)
  79       IANF = LTEIT(TABNR - 1) + 1
  80       K1 = 0
  81       JANF = LWSET - K2 + 1
  82       DO 200 I = IANF, IEND
  83       DO 22 L = JANF,LWSET
  84       DO 21 ONETWO = 1,2
  85       IF(IGET(TEIT(1,ONETWO), I) .EQ. WSET(L)) GO TO 200
  86 21    CONTINUE
  87 22    CONTINUE
  88       K1 = K1 + 1
  89       CALL TUP(WEIT(1,1), K1, IGET(TEIT(1,1), I))
  90       CALL TUP(WEIT(1,2), K1, IGET(TEIT(1,2), I))
  91 200   CONTINUE
  92       IF(K1 .EQ. 0) GO TO 10
  93       DO 50 I = 1,LWSET
  94 50    VSET(I) = WSET(I)
  95       LVSET = LWSET
  96       LWEIT = K1
  97       GO TO 888
  98 C
  99 C   THE STATEMENTS 300 ... 20 RETURN THE SOLUTIONS IN V AND W.
 100 C   BEFORE RETURNING, HOWEVER, THE 'COMPLEMENT' OF THE SOLUTION IS
 101 C   COMPUTED (= ALL NODES OF THE GRAPH NOT CONTAINED IN THE SOLUTION)
 102 C   AND STORED INTO 'SET', FOLLOWED BY THE ACTUAL(CONFER ALGORITHM OF
 103 C   S.R. DAS) SOLUTION.
 104 C
 105 300   CONTINUE
 106       CALL TREVNI(VSET, LVSET, SET, NODES, SETPTR)
 107       NPTR = SETPTR
 108       DO 41 I = 1,LVSET
 109       NPTR = NPTR + 1
 110 41    SET(NPTR) = VSET(I)
 111       ASSIGN 10 TO CHOICE
 112       RETURN
 113 10    CONTINUE
 114       CALL TREVNI(WSET, LWSET, SET, NODES, SETPTR)
 115       NPTR = SETPTR
 116       DO 40 I = 1,LWSET
 117       NPTR = NPTR + 1
 118 40    SET(NPTR) = WSET(I)
 119       ASSIGN 20 TO CHOICE
 120       RETURN
 121 20    CONTINUE
 122 C
 123 C ***   STEP 6
 124 C
 125       IF(TABNR .EQ. 1) GO TO 999
 126       LWEIT = LTEIT(TABNR) - LTEIT(TABNR - 1)
 127       LWSET = LSETT(TABNR) - LSETT(TABNR - 1)
 128       LVSET = LWSET
 129       TABNR = TABNR - 1
 130       IND = LTEIT(TABNR) + 1
 131       DO 31 I = 1,LWEIT
 132       CALL TUP(WEIT(1,1), I, IGET(TEIT(1,1), IND))
 133       CALL TUP(WEIT(1,2), I, IGET(TEIT(1,2), IND))
 134 31    IND = IND + 1
 135       IND = LSETT(TABNR) + 1
 136       DO 32 I = 1,LWSET
 137       IX = IGET(SETT, IND)
 138       WSET(I) = IX
 139       VSET(I) = IX
 140 32    IND = IND + 1
 141       GO TO 888
 142 999   NPTR = 0
 143       RETURN
 144       END