&s cover netwater   /* name of clean river coverage
/* Make all arcs point downstream
/* This version was developed on /jo5/topog/areas/hoh/owl3
/* See http://duff.geology.washinton.edu/tools/streams/index.html
&if [show program] ne 'ARC' &then; &do
   &type This must be started from ARC
   &return &pause 'Exiting.  Try again.'
&end
&set status = [delete fro -file]
&set status = [delete too -file]
&set status = [delete mouth.sel -file]
build %cover% line
indexitem %cover%.aat TNODE#  /* This will speed things up
indexitem %cover%.aat FNODE# 
&if ^ [iteminfo %cover% -arc JORDER -exists] &then
  additem %cover%.aat %cover%.aat JORDER 4 4 i
/* SHREVE and STRAHLER are used for scrath space here.
&if ^ [iteminfo %cover% -arc SHREVE -exists] &then
  additem %cover%.aat %cover%.aat SHREVE 4 4 i
&if ^ [iteminfo %cover% -arc STRAHLER -exists] &then
  additem %cover%.aat %cover%.aat STRAHLER 2 2 i
ARCEDIT
ec %cover%
ef arc
sel all
calc STRAHLER = 66   /* used as a temporary flag in this routine
sel all
put tmpcov
ec mouthline
ef arc
sel all
put tmpcov 
y
QUIT
no
clean tmpcov wholerivs 100 .001 LINE
/* caveat, this clean can die if the dangle is too long,
/* garbage can be left behind if it's too short
kill tmpcov
ARCEDIT 
ec wholerivs
ef node
ADDITEM flag 2 2 c
ef arc
sel dangle 
resel STRAHLER ne 0
calc STRAHLER = 99
sel STRAHLER = 0  /* contributions from mouthline
sel connect
resel STRAHLER ne 99  /* ignore short one-arc rivers
calc JORDER = 1  /* we have river outlets
calc  STRAHLER = 1
selectput node   
ef node 
moveitem 'o' flag  /* these are both ends of the outlet segments
ef arc
sel dangle        /* sources and mouthline ends
/* resel STRAHLER > 1 /* sources only
/* If this were > 0, single-arc rivers would not be excluded.
/* calc STRAHLER = 99  /* not used
sel STRAHLER = 0  /* contributions from mouthline
selectput node    /* all nodes on mouthline
ef node
resel flag = 'o'
moveitem 'M' flag
ef arc
sel STRAHLER = 0  /* remove contributions from mouthline
delete
save
&s order 1  /* here we number the arcs from the outlet
sel JORDER = 1
&label beowulf 
  &set order = [calc %order% + 1]
  sel connect
  resel JORDER = 0
  &if [show number select] > 0 &then ; &do
     calc JORDER = %order%
     &goto beowulf
  &end
 &set order = [calc %order% - 1]
 &type The highest order is %order%   /* 32
sel JORDER = 0
&if [show number select] ne 0 &then
  delete  /* We leave only rivers with designated outlets
save
QUIT

build wholerivs arc
ARCPLOT  /* here we make all the arcs face the right way
mapex wholerivs /* else it will not trace
clearselect
resel wholerivs node flag = 'M'
writeselect mouth.sel
clearselect
TRACE DIRECTION wholerivs fro too mouth.sel
/* if cycles are found, copy the coverage to uff, build uff poly,
/* polygonlines uff 2; &r extex, and edit
readselect fro
calc wholerivs line SHREVE = -1
quit /* to arc
ARCEDIT
ec wholerivs
ef arc
sel SHREVE = -1
&if [show number select] > 0 &then ;flip
save  /* arcs are pointing the right way, so now we can find sources
relate add
arcnod
wholerivs.nat
info
FNODE#
WHOLERIVS#
linear
rw
[unquote '']
sel dangle
resel JORDER ne 1
moveitem 'S' arcnod//flag  /* this is flaky, try again
calc SHREVE = 11
save
ef node
relate add
nodarc
wholerivs.aat
info
ARC#
WHOLERIVS#
linear
ro
[unquote '']
sel nodarc//SHREVE = 11
resel nodarc//FNODE# = WHOLERIVS#
moveitem 'S' flag
save
QUIT