MINICERN/mathlib/gen/v/graph.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 GRAPH(H, IE, INOD, ISL, NPTR, NISL)
  11 C
  12 C   DESCRIPTION OF PARAMETERS
  13 C
  14 C   H(3,96)  INP   MUST CONTAIN THE INCIDENCE-MATRIX OF THE GRAPH IN
  15 C                  BIT FORMAT, I.E. THE MATRIX IS PACKED INTO A BITSTRIN
  16 C                  (USE *SETBIT* FOR THIS PURPOSE.
  17 C                  CALLING SEQUENCE IS 'CALL SETBIT(N, A, BIT)'
  18 C                  SETS THE N-TH BIT OF STRING A (COUNTED FROM LEFT TO
  19 C                  RIGHT) TO THE VALUE OF 'BIT' (0 OR 1))
  20 C                  H(I,J) = 1 IF THERE'S AN EDGE FROM NODE I TO NODE J
  21 C                  H(I,J) = 0 ELSE
  22 C   IE       INP   NUMBER OF EDGES IN THE GRAPH
  23 C                  THIS VALUE IS USED FOR PLAUSIBILITY-CONTROL ONLY
  24 C   INOD     INP   NUMBER OF NODES IN THE GRAPH
  25 C   ISL(96)  OUT   ONE SOLUTION EXTRACTED OUT OF THE GRAPH
  26 C                  IF H(I,J) REPRESENTS AN INCOMPATIBILITY GRAPH, THEN
  27 C                  ISL(1) ... ISL(NPTR) CONTAINS THE REMAINING COMPATIBL
  28 C                  NODES, IF THE NODES ISL(NPTR+1) ... ISL(NISL) ARE
  29 C                  REMOVED FROM THE GRAPH.
  30 C                  N O T E :  ISL CONTAINS, HOWEVER, ONLY NODES WITHIN
  31 C                  THE CURRENT SUBGRAPH, IF NISL WAS 0 IN THE FIRST CALL
  32 C   NPTR     OUT   CONFER *ISL*
  33 C   NISL     I/O   CONTROLS THE FLOW OF THE ROUTINE AND INDICATES
  34 C                  THE TYPE OF RESULT ON OUTPUT.
  35 C        INPUT..   0  IF H, IE, INOD DESCRIBE A NEW GRAPH, FROM WHICH TH
  36 C                     FIRST SOLUTION OF ITS FIRST SUBGRAPH IS TO BE EXTR
  37 C                 -1  THE GRAPH WON'T BE SPLIT UP INTO SUBGRAPHS. THE
  38 C                     GRAPH IS THEREFORE TREATED AS A SINGLE SUBGRAPH
  39 C                     INCLUDING ALL ITS ISOLATED NODES. IF THERE ARE
  40 C                     MANY SUBGRAPHS, THEN THE NUMBER OF SOLUTIONS MAY
  41 C                     BECOME QUITE LARGE.
  42 C                  1  IF THE NEXT SOLUTION OF THE CURRENT SUBGRAPH IS TO
  43 C                     EXTRACTED
  44 C                  2  IF FURTHER SOLUTIONS OF THE CURRENT SUBGRAPH ARE T
  45 C                     BE DROPPED AND THE NEXT SOLUTION OF THE NEXT SUBGR
  46 C                     IS TO BE EVALUATED.
  47 C        OUTPUT.  -1  THERE'S NO FURTHER SOLUTION AVAILABLE IN THE GRAPH
  48 C                     ('END-OF-GRAPH' - INDICATION)
  49 C                  0  LAST SOLUTION GIVEN WAS THE LAST ONE IN THE CURREN
  50 C                     SUBGRAPH ('END-OF-SUBGRAPH' - INDICATION)
  51 C            .GT.0  CONFER *ISL*
  52 C        IF NISL IS EQUAL TO 0 OR -1, THE CONTENTS OF ISL ARE
  53 C        UNDEFINED.(THERE'S NO SOLUTION STORED)
  54 C
  55 C        WRONG CALLING SEQUENCE OR UNBELIEVABLE PARAMETER VALUES FORCE
  56 C        A RETURN WITH NISL = NPTR = -1. (ISL REMAINS UNDEFINED)
  57 C
  58 C   DESCRIPTION OF IMPORTANT PROGRAM VARIABLES
  59 C
  60 C   IV(3), IF(3)   THESE TWO BITSTRINGS ARE USED BY THE ALGORITHM TO EXT
  61 C                  SUBGRAPHS OUT OF THE GRAPH GIVEN (BY H, IE, INOD)
  62 C        IV(I)=1,IF(I)=0   NODE I HASN'T YET BEEN INVESTIGATED BY THE AL
  63 C        IV(I)=0,IF(I)=1  THIS NODE SURELY BELONGS TO THE SUBGRAPH NOW
  64 C                  UNDER CONSTRUCTION AND THERE MIGHT BE EDGES LEADING
  65 C                  TO ADJACENT NODES
  66 C        IV(I)=0,IF(I)=0  THIS NODE (I) IS DEACTIVATED, I.E. ALL INCIDEN
  67 C                  EDGES HAVE BEEN REMOVED AND ADDED TO THE SUBGRAPH.
  68 C   IPTR   GIVES THE CURRENT LENGTH OF THE EDGE INCLUSION TABLE(EIT) WHI
  69 C          DESCRIBES THE SUBGRAPH. (THE EIT IS THEN PASSED TO *PGRAPH*
  70 C          FOR EVALUATION).
  71 C   IZ     CONTROL VARIABLE FOR PGRAPH (SEE DESCRIPTION OF *PGRAPH*)
  72 C   NINFO, INFO(96)  SINCE PGRAPH REQUIRES THE NODES OF THE DELIVERED GR
  73 C          TO BE SEQUENTIALLY NUMBERED, EACH SUBGRAPH GENERATED BY GRAPH
  74 C          MUST BE RENUMBERED, BEFORE IT IS PASSED TO PGRAPH. WHEN PGRAP
  75 C          RETURNS A SOLUTION, THE ORIGINAL NUMBERS OF THE NODES MUST BE
  76 C          RECONSTRUCTED PRIOR TO THE RETURN-TO-MAINLINE. TO PROVIDE
  77 C          THIS, FOR NODE I INFO(I) CONTAINS ITS SEQUENTIAL NUMBER WITHI
  78 C          THE SUBGRAPH. THE SEQU. NUMBER IS UPDATED IN NINFO.
  79 C
  80       INTEGER EIT(652,2)
  81      +, IV(3)
  82      +, IF(3)
  83      +, INFO(96)
  84      +, ISL(96)
  85      +, H(3,96)
  86       LOGICAL BYPASS,SPLIT
  87       COMMON /BITSXB/ NBITPW, NBYTPW
  88       DATA BYPASS /.FALSE./
  89       DATA NOLD /-1/
  90       DATA IZ/0/
  91 #if defined(CERNLIB_CDC)
  92       DATA IFILWD/-0/
  93       NBITPW=60
  94 #endif
  95 #if defined(CERNLIB_NORD)
  96       DATA IFILWD / 37777777777B/
  97       NBITPW=32
  98 #endif
  99 #if (!defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_CDC))
 100       DATA IFILWD/-1/
 101       NBITPW=64
 102 #endif
 103 #if (defined(CERNLIB_DOUBLE))&&(!defined(CERNLIB_NORD))
 104       DATA IFILWD/-1/
 105       NBITPW=32
 106 #endif
 107       NPTR = -1
 108       IF(NISL - 1) 999,555,111
 109 C
 110 C   DO SOME ERROR CHECKING
 111 C   DON'T PROCESS GRAPH ON IMPROPER CALLING SEQUENCE
 112 C
 113 999   IF(IE.GT.652*(NBITPW/8)) GOTO 888
 114       IF(IE.LT.0) GOTO 888
 115       IF(INOD.GT.96) GOTO 888
 116       IF(INOD.LE.1) GOTO 888
 117       NOLD = 0
 118       IF(BYPASS) GOTO 777
 119       NBYTPW = NBITPW/8
 120       BYPASS = .TRUE.
 121 777   CONTINUE
 122 C
 123 C   CHECK, WHETHER TO SPLIT UP INTO SUBGRAPHS OR NOT.
 124 C
 125       IF(NISL.NE.-1) GOTO 666
 126 C
 127 C   DON'T SPLIT
 128 C
 129       SPLIT = .FALSE.
 130       IPTR = 0
 131 C
 132 C   CONSTRUCT EIT
 133 C
 134       DO 40 I = 2,INOD
 135       II = I - 1
 136       DO 40 K = 1,II
 137       CALL GETBIT(K, H(1,I), IBIT)
 138       IF(IBIT.EQ.0) GOTO 40
 139       CALL SETBIT(K, H(1,I), 0)
 140       CALL SETBIT(I, H(1,K), 0)
 141       IPTR = IPTR + 1
 142       CALL TUP(EIT(1,1), IPTR, I)
 143       CALL TUP(EIT(1,2), IPTR, K)
 144 40    CONTINUE
 145       IF(IPTR.EQ.0) GOTO 888
 146       IZ = 0
 147       CALL UZERO(IV, 1, 3)
 148       NINFO = INOD
 149       GOTO 556
 150 666   CONTINUE
 151       SPLIT = .TRUE.
 152 C
 153 C   SET INITIAL VALUES
 154 C
 155       CALL UZERO(IF, 1, 3)
 156       CALL UFILL(IV,1,3,IFILWD)
 157 111   IPTR = 0
 158       IF(NOLD.NE.0) GOTO 888
 159 C*UL 112   NINFO = 0
 160       NINFO = 0
 161       CALL UZERO(INFO, 1, INOD)
 162       DO 1 I = 1,INOD
 163       CALL GETBIT(I, IV, IBIT)
 164       IF(IBIT.EQ.1) GOTO 2
 165 1     CONTINUE
 166 C   THERE ARE NO FURTHER NODES LEFT IN THE GRAPH
 167       NPTR = 1
 168 888   NISL = -1
 169       RETURN
 170 C   A NODE HAS BEEN FOUND. ALL ITS INCIDENT EDGES ARE DETERMINED,
 171 C   REMOVED FROM THE GRAPH AND STORED INTO THE EIT
 172 2     NODE = I
 173       DO 3 I = 1,INOD
 174       CALL GETBIT(NODE, H(1,I), IBIT)
 175       IF(IBIT.EQ.0) GOTO 3
 176       CALL SETBIT(NODE, H(1,I), 0)
 177       CALL SETBIT(I, H(1,NODE), 0)
 178 C   MARK THIS ADJACENT NODE FOUND TO PROVIDE FURTHER EXPANSION
 179 C   OF THE (SUB)GRAPH
 180       CALL SETBIT(I, IV, 0)
 181       CALL SETBIT(I, IF, 1)
 182 C   STORE THE EDGE (NODE,I) INTO THE EIT
 183 C   REMARK.. THE FIRST 'CALL TUP(..)' MEANS  EIT(IPTR,1) = NODE
 184       IPTR = IPTR + 1
 185       CALL TUP(EIT(1,1), IPTR, NODE)
 186       CALL TUP(EIT(1,2), IPTR, I)
 187 3     CONTINUE
 188 C   SET UP ARRAY TO PROVIDE SEQUENTIAL NUMBERING OF THE NODES OF
 189 C   EACH SUBGRAPH BEFORE ENTERING SUBROUTINE PGRAPH
 190       NINFO = NINFO + 1
 191       INFO(NODE) = NINFO
 192 C   MARK THE NODE AS INACTIVE. (ALL INCIDENT EDGES HAVE BEEN REMOVED)
 193       CALL SETBIT(NODE, IV, 0)
 194       CALL SETBIT(NODE, IF, 0)
 195 C   IS THERE STILL A NODE IN THE GRAPH, FROM WHICH THE CURRENT
 196 C   SUBGRAPH MIGHT BE EXPANDED
 197       DO 4 I = 1,INOD
 198       CALL GETBIT(I, IF, IBIT)
 199       IF(IBIT.EQ.1) GOTO 2
 200 4     CONTINUE
 201 C   NO, THE SUBGRAPH IS COMPLETE. CHECK, IF IT IS ONLY AN ISOLATED NODE
 202       IF(IPTR.GT.0) GOTO 6
 203       NPTR = 1
 204       NISL = 1
 205       IZ = 0
 206       ISL(1) = NODE
 207       RETURN
 208 C   REARRANGE THE NUMBERS WITHIN THE SUBGRAPH FOUND TO BE SEQUENTIAL
 209 6     CONTINUE
 210       DO 7 I = 1,IPTR
 211       DO 7 J = 1,2
 212       JX =  IGET(EIT(1,J), I)
 213       NEW = INFO(JX)
 214       CALL TUP(EIT(1,J), I, NEW)
 215 7     CONTINUE
 216       IZ = 0
 217       GOTO 556
 218 555   IF(IZ.EQ.0) GOTO 111
 219 556   CALL PGRAPH(EIT, IPTR, NINFO, ISL, NPTR, IZ)
 220       IF(IZ.EQ.0) GOTO 8
 221       IF(.NOT. SPLIT) GOTO 8
 222 C   RE-REARRANGE THE NUMBERS IN THE EIT FROM SEQUENTIAL TO ORIGINAL
 223       DO 9 I = 1,IZ
 224       NEW = ISL(I)
 225       DO 11 J = 1,INOD
 226       IF(INFO(J).EQ.NEW) GOTO 12
 227 11    CONTINUE
 228 12    ISL(I) = J
 229 9     CONTINUE
 230 8     NISL = IZ
 231       RETURN
 232       END