!  Connected components in the grid.  -- for 128x128 array
!  File:  grcc.f
!
!  Axis convention:
!         0     1       ---(2)--->              YMX-1
!      +-----+-----+-----+-----+-----+- . . . -+-----+
!    0 |     |     |     |     |     |         |     |
!      +-----+-----+-----+-----+-----+- . . . -+-----+
!    1 |     |     |     |     |     |         |     |
!  |   +-----+-----+-----+-----+-----+- . . . -+-----+
! (1)  |     |     |     |     |     |         |     |
!  |   +-----+-----+-----+-----+-----+- . . . -+-----+
!  v   :     :     :     :     :     :         :     :
!      +-----+-----+-----+-----+-----+- . . . -+-----+
! XMX-1|     |     |     |     |     |         |     |
!      +-----+-----+-----+-----+-----+- . . . -+-----+!
!  Parallel vars for cell data.  These are in common b!ock /GRCCPE/
!  defined in grcc.h.  Parameters are defined by grcc.hp, which is
!  included automatically with grcc.h.
!  All arrays are (0:XMX-1, 0:YMX-1)
!
!  integer:  cc    Component number
!            cw    Working component
!             x    x coord (axis 1)
!             y    y coord (axis 2)
!	     id    Unique identifying number
!
!  logical:   nb,  Northern barrier
!             eb,  Eastern barrier
!             wb,  Western barrier
!             sb;  Southern barrier

!  Setup random test with probability of barrier = p/100.
!  Returns total number of barriers installed [nb + wb]
!  Expects 0 <= p <= 100.

      integer function setup(p)
      integer p

      INCLUDE 'grcc.h'

      integer nc, wc	! Barrier counts (north, west)
      integer ir(0:XMX-1, 0:YMX-1)
      integer rr(1:XMX*YMX)

      x = SPREAD((/ (ii, ii=0,XMX-1) /), 2, YMX)	! x coordinate
      y = SPREAD((/ (ii, ii=0,YMX-1) /), 1, XMX)	! y coordinate
      id = y + YMX*x			! Unique identification
      nb = (x == 0)		        ! Northern edge
      wb = (y == 0)		        ! Western edge
!  Add random barriers on North and West
      call CMF_random(ir, 100)	! 0 <= ir < 100
      where ( ir < p ) nb = .TRUE.
      call CMF_random(ir, 100)
      where ( ir < p ) wb = .TRUE.
!  Make Eastern and Southern barriers consistent
      sb = CSHIFT(nb, DIM=1, SHIFT=1)
      eb = CSHIFT(wb, DIM=2, SHIFT=1)
!  Count barriers
      ir = 0
      where (nb) ir = 1
      where (wb) ir = ir + 1
      setup = SUM(ir)
      end function setup


!  Calculate connected components.
!  Returns no. of cycles, not counting final test.

      integer function gccs()
      INCLUDE 'grcc.h'

      INTERFACE
	logical function gccx()
      END INTERFACE
	
      integer nc		! Counts number of cycles

      nc = 0
      cc = id			! Unique numbers
      do while ( gccx() )	! Repeat until solved
	nc = nc + 1
      end do
      gccs = nc			! Result
      end function gccs


!  Perform one cycle of sweeps, test for changes.
!  Updates component numbers in cc.
!  Returns test result, .TRUE. indicates one or more changes.

      logical function gccx()
      INCLUDE 'grcc.h'
      INCLUDE '/usr/include/cm/CMF_defs.h'

      cw = cc
      call CMF_SCAN_MIN(cw, cw, wb, 2, CMF_UPWARD,
     *			CMF_INCLUSIVE, CMF_START_BIT, .TRUE.)
      call CMF_SCAN_MIN(cw, cw, eb, 2, CMF_DOWNWARD,
     *			CMF_INCLUSIVE, CMF_START_BIT, .TRUE.)
      call CMF_SCAN_MIN(cw, cw, nb, 1, CMF_UPWARD,
     *			CMF_INCLUSIVE, CMF_START_BIT, .TRUE.)
      call CMF_SCAN_MIN(cw, cw, sb, 1, CMF_DOWNWARD,
     *			CMF_INCLUSIVE, CMF_START_BIT, .TRUE.)
      gccx = ANY(cw <> cc)	! Any changes?
      cc = cw
      end function gccx


!  Draw horizontal line in grid according to b in row i,
!  starting in column j for c columns.

      subroutine bline(b, i, j, c)
      INCLUDE 'grcc.hp'
      logical b(0:XMX-1, 0:YMX-1)
      integer i, j, c

      integer k

      print '("+"$)'
      k = j
      do (c) times
	if ( b(i, k) ) then
	  print '("-----+"$)'
	else
	  print '("     +"$)'
	end if
	k = k + 1
      end do
      print '(1X)'	! Finishes the line
      end subroutine bline


!  Print a portion of the current grid showing barriers.
!  Uses cc for component numbers, nb, sb, wb, eb for barriers.

      subroutine dcc(i, j, r, c)
      integer i, j, r, c
      INCLUDE 'grcc.h'

      INTERFACE
	subroutine bline(b, i, j, c)
	INCLUDE 'grcc.hp'
	logical b(0:XMX-1, 0:YMX-1)
	integer i, j, c
      END INTERFACE

      integer m, n, k, ii, ci

      m = i + r	- 1	! Row limit
      n = j + c	- 1	! Column limit
      ii = i
      call bline(nb, i, j, c)
      do while ( ii <= m )
	if ( wb(ii, j) ) then
	  print '("|"$)'
	else
	  print '(" "$)'
	end if
	do, k = j, n
	  ci = cc(ii, k)	! Suspect compiler problem with
	  print '(I5$)', ci	! cc(ii, k) in print statement
	  if ( eb(ii, k) ) then
	    print '("|"$)'
	  else
	    print '(" "$)'
	  end if
	end do	! k
	print '(1X)'	! End line
	call bline(sb, ii, j, c)
	ii = ii + 1
      end do	! ii
      end subroutine dcc


!  Main program -- manages tests and timing interactively.
!
!  Responses (prompts for additional input as needed):
!
!   p			- run test with probability dd [0..100]
!      <dd>
!   w			- print [i..]i+r by [j..]j+c  (r by c)
!      <i> <j> <r> <c>
!   q                   - quit

      program gridcc
      INCLUDE 'grcc.h'

      INTERFACE
	integer function setup(p)
	integer p
      END INTERFACE
      INTERFACE
	integer function gccs()
      END INTERFACE
      INTERFACE
	subroutine dcc(i, j, r, c)
	integer i, j, r, c
      END INTERFACE

      character c
      integer pr, bs, nc, rg, i, j, rw, cl

      print 21, XMX, YMX
 21   FORMAT (" Grid is ", I4, " by ", I4, ".")
!   Read - execute - print loop
 11   print '(" grid cc> "$)'
      read *, c
      if      ( c == 'p' ) then
	print '("  probability> "$)'
	read *, pr
	bs = setup(pr)
	call CM_timer_clear(1)
	call CM_timer_start(1)
	nc = gccs()
	call CM_timer_stop(1)
	call CM_timer_print(1)
!   Count number of regions
	rg = SUM(MERGE(1, 0, id == cc))
	print 22, bs, nc, rg
 22	FORMAT (1X, I7, " barriers, ", I6, " cycles,", I6, " regions.")
      else if ( c == 'w' ) then
	print '("  i j r c> "$)'
	read *, i, j, rw, cl
	call dcc(i, j, rw, cl)
      else if ( c == 'q' ) then
	go to 99		! Exit
      else
	print '(" Bad input -- ignored.")'
      end if
      go to 11		! Next command
 99   continue		! For exit
      end program gridcc
