c-----------------------------------------------------------
c Chapter 18: Spanning Forest of a Graph(p158)
c-----------------------------------------------------------
c   Name of subroutine: SPANFO
c
c   Algorithm:Determine connectivity of a graph;
c             find spanning forest.
c
c-----------------------------------------------------------

c-----The driver program is in spanfo_2.f

c-----Subroutine begins here--------------------------------
      subroutine spanfo(n,e,endpt,k,x)
      implicit integer(a-z)
      dimension endpt(2,e),x(n)
      mm=1+max0(n,e)
c     
c     start link
c 
      do 11  i=1,n
11      x(i)=-i
      do 12  m=1,e
      do 12  l=1,2
      p=endpt(l,m)
      endpt(l,m)=x(p)
12    x(p)=-l*mm-m
c     
c      end link--start main s/r
c
      k=0
      loc=0
      i=0
20    i=i+1
      if(i .gt. n)go to 21
         q= x(i)
      if(q .gt. 0)go to 20
      k=k+1
      x(i)=k
      if(q+i)30,20,20
c      30 is call to component-from where to 20
21    do 23 m=1,e
22    r=-endpt(1,m)
      if(r .lt. 0) go to 23
      s=endpt(2,m)
      endpt(2,m)=endpt(2,r)
      endpt(2,r)=s
      endpt(1,m)=endpt(1,r)
      endpt(1,r)=x(endpt(2,r))
      go to 22
23    continue
      do 24 i=1,loc
24    x(endpt(2,i))=x(endpt(1,i))
      return
c
c      end main s/r-- start compoent
c
30    p=i
      s=-q
      assign 31 to rtnvis
      go to 53
c      call to visit-from where to 31
31    l0=l1
      m0=m1
      r=0
      assign 43 to rtnvis
      go to 41
32    go to 40
c      call to scan-from where to 33
33    if(r .eq. 0) go to 34
      loc=loc+1
      x(p)=endpt(1,r)+endpt(2,r)-p
      endpt(1,r)=-loc
      endpt(2,r)=r
34    p=m
      if(m)20,20,32
c
c      end component-start scan
c
40    s=-x(p)
41    l=s/mm
      m=s-l*mm
      if(l .eq. 0) go to 33
      l1=3-l
      m1=m
      go to 50
c      call to visit-from where to 42,43 or 44
42    r=m1
      go to 44
43    endpt(l0,m0)=q
      l0=l1
      m0=m1
44    s=iabs(endpt(l,m))
      endpt(l,m)=p
      go to 41
c
c      end scan-start visit
c
50    q=endpt(l1,m1)
      if(q) 51,44,54
51    if(q .lt. -mm) go to 52
      q=-q
      endpt(l1,m1)=0
      go to rtnvis,(31,43)
52    endpt(l1,m1)=-q
53    l1= -q/mm
      m1=-q-l1*mm
      go to 50
54    if(q .gt. mm) go to 44
      if(x(q)) 44,42,42
c
c      end visit
c
      end