/* Given coverages of contour lines and rivers, /* we want river slope, which incorporates an elevation for river /* junctions dervied by interpolating elevation along the main stem. /* vertical and xy dimensions may not match, but zfactor makes slope correct /* Before running this aml: /* Run flipper.aml to create the arc/node cover wholerivs. /* check the variables set below this constant. /* This aml creates splitrivs and rivspots. /* It creates and deletes splitconts, tmpcov, and tmpcov2. /* Note the constants which are set in the next few lines. /* This is base don topgrida.aml, Version 2.02, but it has /* total distrust of DEM. When node elevations cannot be /* interpolated, extrapolated slope of connecting segments. /* Do not even think about building a DEM. /* The one [?] reaining flaw: if you have a dangling source/outlet with a /* junction, and if the less preferred search path (lower shreve or /* dangling rather than hitting a contour) is actually the longer path, /* The extrapolation from a contour through a junction to the end can /* exceed the contour interval &args netcov /*****&set netcov wholerivs submit off &set concov clipcont &set elv_item elv /***********DXF-ELEVATION &set interval 40 /* intervals on contour files &set maxdangle 2 &set zfactor .3048 /************** 1 &TYPE streamslope.aml, Version 1.2 10/24/96 &type Using the following constants:\concov %concov%\netcov %netcov%\elv_item %elv_item%\interval %interval%\maxdangle %maxdangle%\zfactor %zfactor% &if [exist splitrivs -cover] or [exist rivspots -cover] &then ;~ &return The covers splitrivs and rivspots must be deleted for this to run. &if ^ [exist %concov% -cover] &then ;~ &return The coverage %concov% does not exist here. &if ^ [exist %netcov% -cover] &then ;~ &return The coverage %netcov% does not exist here. &if ^ [iteminfo %concov% -ARC JORDER -exists] &then ;~ additem %concov%.aat %concov%.aat JORDER 4 4 I &if ^ [iteminfo %concov% -ARC SHREVE -exists] &then ;~ additem %concov%.aat %concov%.aat SHREVE 4 4 I &if ^ [iteminfo %concov% -ARC STRAHLER -exists] &then ;~ additem %concov%.aat %concov%.aat STRAHLER 2 2 I &if ^ [iteminfo %concov% -ARC TLENGTH -exists] &then ;~ additem %concov%.aat %concov%.aat TLENGTH 4 12 F &if ^ [iteminfo %netcov% -ARC %elv_item% -exists] &then ;~ additem %netcov%.aat %netcov%.aat %elv_item% 8 8 N 2 arcedit ec %netcov%;ef arc;sel all;put tmpcov ec %concov%;ef arc;sel all;put tmpcov;yes quit clean tmpcov tmpcov2 %maxdangle% .001 line kill tmpcov Arcedit ec tmpcov2 ef arc sel all calc tmpcov2-id = tmpcov2# sel strahler eq 0 put splitconts nselect put splitrivs QUIT y y &type The coverages splitrivs and splitconts have been created. /* going to the use of NEAR instead of tracking topology renode splitrivs nodepoint splitrivs rivspots near rivspots splitconts line .001 /* now we have to go back to topology INDEXITEM splitconts.aat splitconts# INDEXITEM rivspots.pat splitconts# INDEXITEM splitrivs.aat FNODE# INDEXITEM splitrivs.aat TNODE# INDEXITEM rivspots.pat RIVSPOTS# /* These are all the relates for this aml relate add scont; splitconts.aat;INFO;splitconts#;splitconts#;linear;ro topt; rivspots.pat; INFO;TNODE#; RIVSPOTS#; linear;ro frompt; rivspots.pat; INFO;FNODE#; RIVSPOTS#; linear;ro [unquote ''] tables additem rivspots.pat elv 4 12 F 3 sel rivspots.pat calc elv = -99 resel scont//%elv_item% ge 0 /* otherwise we lose the -99 calc elv = scont//%elv_item% &if ^ [iteminfo splitrivs -ARC uid -exists] &then /* unique ID additem splitrivs.aat uid 4 5 B &if ^ [iteminfo splitrivs -ARC elvf -exists] &then additem splitrivs.aat elvf 4 10 f 3 &if ^ [iteminfo splitrivs -ARC elvt -exists] &then additem splitrivs.aat elvt 4 10 f 3 &if ^ [iteminfo splitrivs -ARC dz -exists] &then additem splitrivs.aat dz 4 10 f 3 &if ^ [iteminfo splitrivs -ARC slope -exists] &then additem splitrivs.aat slope 4 10 f 3 sel splitrivs.aat calc elvf = -99 calc elvt = -99 resel frompt//elv ge 0 calc elvf = frompt//elv sel splitrivs.aat resel topt//elv ge 0 calc elvt = topt//elv sel splitrivs.aat calc uid = splitrivs# calc splitrivs-id = splitrivs# /* This is confusing. In tables we must refer to some things by record number. /* Can we count on tables not changing record# like arcedeit does? quit /* tables /* kill tmpcov2 /* here comes the tricky part, now in tables tables &label tricky sel splitrivs.aat &set oldnum 9999 &set hugeit 0 &label hugeloop &s hugeit [calc %hugeit% + 1] asel /* 10/1/96: fixes problems on second iteration. /******* resel elvf < 0 /* sub-top junctions arcs (plus dangling sources.) /*******resel SHREVE > 1 /* exclude dangling sources and uncoded streams resel elvt > 0 &if %hugeit% gt 1 &then asel topt//flag = 'M' /* and outlets resel elvf < 0 &set num [show number select] &type looking at %num% arcs &if %num% eq %oldnum% and %hugeit% > 10 &then; &do &type WARNING: dropping out of hugeloop with %num% arcs unfinished. &goto interpdone &end &set oldnum %num% /* Except for dangling outlets and complex river topology between contours , /* the aml will drop out of the loop on the 2nd iteration. &if %num% = 0 &then; &goto interpdone UNLOAD tricktmp splitrivs-id # init &sys cat -n tricktmp | tr -d ' ' | tr '\011' ' ' | sed 's/^/\&set .id/' >! tricktmp2 &sys echo ' ' >>tricktmp2 &ty writing all %num% ids for bigloop %hugeit% into a pseudoarray .idn &pause # &seconds 2 &RUN tricktmp2 /*T &do index = 1 &to %num% /* using global vars for debugging /*T &s .id%index% = [show arc [show select %index%] item UID] /*T &end &s .index 0 &label bigloop /* I use gotos because aml nested doloops are unreliable &s .index [calc %.index% + 1 ] &set .id = [value .id%.index%] &TYPE index %.index% %.id% asel resel splitrivs-id = %.id% /* we are now at a contour line or a previously coded node &s .totlength [show record %.id% item LENGTH] &s .stringnum = 1 &s .stringid%.stringnum% %.id% &s .lowelv [show record %.id% item elvt] &label searchup asel resel TNODE# = [show record %.id% item FNODE#] /* all upstream arcs &s .unum [show number select] /* ususally 2 &if %.unum% = 0 &then /*dangling source. Extrapolate slope of lower arc (Skip until later if unknown) /* If dz of arc(s) > interval, set dz = interval * .8 &do asel;resel FNODE# = [show record [value .id%.index%] item TNODE#] /* the downstream arc UNLOAD tricktmp slope # init &sys sed 's/^/\&set .slope /' tricktmp >! tricktmp2 &sys echo ' ' >>tricktmp2 &ty Running tricktmp2 fro slope list UID ELVF ELVT DZ SLOPE LENGTH &RUN tricktmp2 &if %.slope% le 0 &then &goto endloop /* we can catch this later /* not needed asel;resel splitrivs-id = [value .id%.index%] /* our lowest arc &s dz = [ calc %.slope% * %.totlength% / %zfactor% ] &if %dz% > %interval% &then &s dz = [ calc %interval% * .8 ] &s .highelv = [ calc %.lowelv% + %dz% ] &type Calculated dz of %dz% for dangling source of %.stringnum% pieces &goto filling &end UNLOAD tricktmp splitrivs-id # init &sys cat -n tricktmp | tr -d ' ' | tr '\011' ' ' | sed 's/^/\&set .uid/' >! tricktmp2 &sys echo ' ' >>tricktmp2 &ty writing the %.unum% ids into a pseudoarray list UID ELVF ELVT DZ SLOPE LENGTH &RUN tricktmp2 &ty They are %.uid1% %.uid2% /*T &do .uind = 1 &to %.unum% /*T &s .uid%.uind% = [show arc [show select %.uind%] item UID] /*T &end &s .shrevemax [show record %.uid1% item shreve] &s .lengmax [show record %.uid1% item LENGTH] /* In a simple Y, we want to avoid tracing up a dangling branch. /* By weighting the length, we virtually avoid this, while still allowing the /* trace to operate with complex topology and with total dangling. &if [show record %.uid1% item elvf] le 0 &then /* We dont want this if we have a choice &s .lengmax = [calc %.lengmax% * .1] &s .maxind 1 &do .uind = 2 &to %.unum% /* ususally 2 &s .shreve = [show record [value .uid%.uind%] item shreve] &if %.shreve% eq %.shrevemax% &then ; &do /* if equal shreve, &s otherleng = [show record [value .uid%.uind%] item LENGTH] &if [show record [value .uid%.uind%] item elvf] le 0 &then &s otherleng = [calc %otherleng% * .1] &if %otherleng% gt %.lengmax% &then ; &do &s .shrevemax %.shreve% &s .maxind %.uind% &end &end &if %.shreve% > %.shrevemax% &then ; &do &s .shrevemax %.shreve% &s .maxind %.uind% &end &end /*T sel UID = [value .uid%.maxind%] /* the upstream arc with highest shreve asel resel splitrivs-id = [value .uid%.maxind%] &type Took choice %.maxind% : id [value .uid%.maxind%] &s .totlength = [calc %.totlength% + [show record [value .uid%.maxind%] item LENGTH]] &s .stringnum = %.stringnum% + 1 &s .stringid%.stringnum% [value .uid%.maxind%] &s .highelv = [show record [value .uid%.maxind%] item elvf] &if %.highelv% < 0 &then;&DO &set .id [value .uid%.maxind%] &TYPE searching up %.highelv% %.stringnum% to %.id% &goto searchup &end /* We have traced up to a contour &label filling &if %.lowelv% eq -99 &then; &do /* dangling mouth asel resel TNODE# = [show record [value .uid%.maxind%] item FNODE#] /* the upstream arc UNLOAD tricktmp slope # init &sys sed 's/^/\&set .slope /' tricktmp >! tricktmp2 &sys echo ' ' >>tricktmp2 &ty Running tricktmp2 for slope list UID ELVF ELVT DZ SLOPE LENGTH &RUN tricktmp2 /* too easy:**** &s slope = [show record [show select 1] item slope] &if %.slope% le 0 &then &goto endloop /* we can catch this later (Is this needed?) &s dz = [ calc %.slope% * %.totlength% / %zfactor% ] &if %dz% > %interval% &then &s dz = [ calc %interval% * .8 ] &s .lowelv = [ calc %.highelv% - %dz% ] &type Calculating mouth elevation base on dz of %dz% asel;resel splitrivs-id = %.stringid1% calc elvt = %.lowelv% &end &type Filling nodes on %.stringnum% arcs from %.lowelv% to %.highelv% &s subleng 0 &s .delv = %.highelv% - %.lowelv% /* &do .uind = 1 &to [ calc %.stringnum% - 1 ] &do .uind = 1 &to %.stringnum% sel splitrivs.aat resel splitrivs-id = [value .stringid%.uind%] &s subleng = [ calc %subleng% + [show record [value .stringid%.uind%] item LENGTH] ] &s .here = [ calc %subleng% / %.totlength% ] &s .elv = [ calc %.here% * %.delv% + %.lowelv% ] &if [show record [value .stringid%.uind%] item elvf] < 0 &then; &do CALC elvf = %.elv% calc dz = elvf - elvt calc slope = dz / length * %zfactor% &end &ty %.index% calculated elv of %.elv% on arc [value .stringid%.uind%] /* &if %.uind% < %.stringnum% &then ; &do &set upnode = [show record [value .stringid%.uind%] item FNODE#] /* all upstream arcs sel splitrivs.aat resel TNODE# = %upnode% resel elvt < 0 CALC elvt = %.elv% /* &end &end &label endloop /* &end /* .index &if %.index% < %num% &then; &goto bigloop /* We have examined every arc. If the topology is not complex between contours, /* we have finished interpolation. asel;resel elvf ge 0 and elvt ge 0 &if [show number select] gt 0 &then; &do &ty Calcing dz for [show number select] arcs calc dz = elvf - elvt /* vertical and xy dimensions may not match, but zfactor makes slope correct calc slope = dz / length * %zfactor% &end &goto hugeloop &label interpdone /* end of the tricky part asel;resel elvf ge 0 and elvt ge 0 &if [show number select] gt 0 &then; &do &ty Calculating dz for [show number select] arcs calc dz = elvf - elvt /* vertical and xy dimensions may not match, but zfactor makes slope correct calc slope = dz / length * %zfactor% &end quit /* out of tables /* delete unneeded coverages /* kill splitconts