/*-------------------------------------------------------------------------- /* Program: ARCSWAT.AML /* Purpose: Graphical user interface to extract data from ARC/INFO coverages /* for input to the Soil and Water Assessment Tool (SWAT) /*-------------------------------------------------------------------------- /* Usage: ARCSWAT INIT {'position'} {'stripe'} {MODELESS | MODAL} /* Usage: ARCSWAT /* /* Arguments: routine - name of the routine to be called. /* position - (quoted string) opening menu position. /* stripe - (quoted string) menu stripe displayed. /* MODELESS | MODAL - keyword for creating modal thread. /* /* Globals: .bsn$covname /* .sub$covname /* .pstreams$covname /* .streams$covname /* .elevation$covname /* .bsn$da /* .cod$lu /* .cod$lu_temp /* .wgn$ylt /* .sub$sub%i%flu /* .sub$sub%i%chl1 /* .sub$sub%i%chs /* .sub$sub%i%sl /* .sub$sub%i%stp /* .pcp$sub%i%poly%j% /* .pcp$sub%i%poly%j%id /* .tmp$sub%i%poly%j% /* .tmp$sub%i%poly%j%id /* .sol$sub%i%poly%j% /* .sol$sub%i%poly%j%muid /* .sol$sub%i%poly%j%seqnum%k% /* .sol$sub%i%poly%j%comppct%k% /* .sol$sub%i%poly%j%compname%k% /* .rte$sub%i%chss /* .rte$sub%i%chl2 /*-------------------------------------------------------------------------- /* Calls: arcswat.menu disp_help.aml modal.aml getcover.aml getgrid.aml /* msworking.aml /*-------------------------------------------------------------------------- /* Notes: /*-------------------------------------------------------------------------- /* History: Clayton F. Blodgett - 06/22/95 - Original coding /* Clayton F. Blodgett - 08/03/95 - Added error trapping /*========================================================================== /* &args routine arglist:rest /* &severity &error &routine bailout /* /* Check arguments &if ^ [NULL %routine%] &then &call %routine% &else &call usage &return /*----------- &routine INIT /* {'position'} {'stripe'} {MODELESS | MODAL} /*----------- &set position = [EXTRACT 1 [UNQUOTE %arglist%]] &set stripe = [EXTRACT 2 [UNQUOTE %arglist%]] &set modality = [EXTRACT 3 [UNQUOTE %arglist%]] &if [SHOW &thread &size [SHOW &thread &self]] = 0,0 &then &set launch = &thread &delete &self &else &set launch &if [NULL %position%] or %position%_ = #_ &then &set position = &cc &screen &cc &if [NULL %stripe%] or %stripe%_ = #_ &then &set stripe = ARCSWAT &if [NULL %modality%] or %modality%_ = #_ &then &set .arcswat$modal = .FALSE. &else &do &if [TRANSLATE %modality%] = MODAL &then &set .arcswat$modal = .TRUE. &else &set .arcswat$modal = .FALSE. &end &if [SHOW &thread &exists tool$arcswat] &then &thread &delete tool$arcswat &thread &create tool$arcswat ~ &menu arcswat.menu ~ &position [UNQUOTE %position%] ~ &stripe [QUOTE [UNQUOTE %stripe%]] ~ &pinaction '&run arcswat exit' /* Set the display environment display 9999 3 /* Define global variables &sv .bsn$covname = &sv .cod$lu_temp = &sv .sub$covname = &sv .pstreams$covname = &sv .streams$covname = &sv .elevation$grdname = &sv .pcp$covname = &sv .tmp$covname = &sv .sol$covname = &sv .flag$bsn = .FALSE. &sv .flag$sub = .FALSE. &sv .flag$pcp = .FALSE. &sv .flag$tmp = .FALSE. &sv .flag$sol = .FALSE. &sv .flag$rte = .FALSE. &sv .again = 'NO' /* Set the AMLPATH &if [null [show &amlpath]] &then &amlpath [show &workspace] &if %.arcswat$modal% &then &run modal.aml open tool$arcswat &else %launch% &return /*------------------- &routine BASIN /*------------------- &if %.flag$bsn% &then &sv .again = [getchoice YES NO ~ -prompt 'BASIN routine already executed, execute it again?'] &if %.again% = 'YES' or %.flag$bsn% = .FALSE. &then &do /* If the routine has been executed previously, clean up variables /* associated with the routine before proceeding &if %.again% = 'YES' &then &dv .bsn$* &r getcover INIT .bsn$covname * polygon # 'BASIN Coverage' &if NOT [null %.bsn$covname%] &then &do &sv .flag$bsn = .TRUE. &messages &off &r msworking 'Calculating basin area' ~ '(waiting time, very short)' # 'Routine BASIN' cursor basin declare %.bsn$covname%.pat info ro cursor basin open cursor basin next /* Determine basin area (file .BSN, variable DA) &sv .bsn$da = %:basin.area% / 1000000 cursor basin close cursor basin remove &r msworking close &end &end &sv .again = 'NO' &return /*------------------- &routine SUBBASIN /*------------------- /* Basin coverage must be defined before proceeding &if NOT [null %.bsn$covname%] &then &do &if %.flag$sub% &then &sv .again = [getchoice YES NO ~ -prompt 'SUBBASIN routine already executed, execute it again?'] &if %.again% = 'YES' or %.flag$sub% = .FALSE. &then &do /* If the routine has been executed previously, clean up coverages, grids, /* and variables associated with the routine before proceeding &if %.again% = 'YES' &then &do &messages &off &sv qcover = [exists qz_pstreams -cover] &if %qcover% &then kill qz_pstreams &do i = 1 &to %.cod$lu_temp% &sv qcover = [exists qz_sub%i% -cover] &if %qcover% &then kill qz_sub%i% &sv qcover = [exists qzsub%i%_geo -cover] &if %qcover% &then kill qzsub%i%_geo &sv qgrid = [exists qz_sub%i%lat -grid] &if %qgrid% &then kill qz_sub%i%lat &sv qcover = [exists qz_sub%i%c -cover] &if %qcover% &then kill qz_sub%i%c &sv qcover = [exists qz_streams%i% -cover] &if %qcover% &then kill qz_streams%i% &end &dv .sub$* &dv .cod$* &dv .wgn$* &dv .pstreams$* &dv .streams$* &dv .elevation$* &end /* Input coverages associated with the subbasin variables &sv .flag$sub = .TRUE. &r getcover INIT .sub$covname * polygon # 'SUBBASIN Coverage' /* Determine the number of subbasins contined within the basin &describe %.sub$covname% &sv .cod$lu_temp = %dsc$polygons% - 1 /* Split the subbasin coverage by subbasin into individual coverages &r msworking 'Spliting subbasin coverage into' ~ 'individual subbasins (waiting time, intermediate)' # 'Routine SUBBASIN' &sv unit = [open seperate.aml openstat -write] &if %openstat% = 0 &then &do &sv writestat = [write %unit% ~ 'split %.sub$covname% %.sub$covname% [entryname %.sub$covname%]# poly'] &do i = 1 &to %.cod$lu_temp% &sv k = %i% + 1 &sv writestat = [write %unit% qz_sub%i%] &sv writestat = [write %unit% %k%] &end &sv writestat = [write %unit% end] &sv closestat = [close %unit%] &end &else &type Error creating file, error code: %openstat% &r seperate &sv del_file = [delete seperate.aml] &r msworking close &sv .cod$lu = 0 arcplot &do i = 1 &to %.cod$lu_temp% mape %.sub$covname% linecolor 1 arcs %.sub$covname% linecolor 2 arcs qz_sub%i% &sv .sub$used%i% = [GETCHOICE YES NO ~ -prompt 'Is the highlighted subbasin to be included in future processing?'] &if [value .sub$used%i%] = 'YES' &then &do &sv .sub$num%i% = [GETCHOICE 1 2 3 4 5 6 7 8 9 10 ~ 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 ~ 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 ~ 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 ~ 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 ~ -prompt 'Select subbasin number for the highlighted subbasin'] &sv .cod$lu = %.cod$lu% + 1 &end &else &sv .sub$num%i% = -9999 clear &end q &r getcover INIT .pstreams$covname * line # ~ 'Primary STREAMS Coverage' copy %.pstreams$covname% qz_pstreams renode qz_pstreams build qz_pstreams node &r getcover INIT .streams$covname * line # 'STREAMS Coverage' &r getgrid INIT .elevation$grdname * # 'ELEVATION Grid' /* Do not proceed unless all coverages have been defined &if NOT [null %.sub$covname%] AND NOT ~ [null %.pstreams$covname%] AND NOT [null %.streams$covname%] ~ AND NOT [null %.elevation$grdname%] &then &do /* Declare cursor for determination of subbasin area and fraction of ~ /* total subbasin area &r msworking 'Calculating fraction of basin area' ~ 'that each subbasin occupies (waiting time, very short)' # 'Routine SUBBASIN' cursor subbasin declare %.sub$covname%.pat info ro cursor subbasin open &do i = 1 &to %.cod$lu_temp% cursor subbasin next /* Determine subbasin area &if [value .sub$used%i%] = 'YES' &then &do &sv .sub$sub%i%da = %:subbasin.area% /* Calculate the fraction of the total basin area that each subbasin /* occupies (file .SUB, variable FLU) &sv .sub$sub%i%flu = [value .sub$sub%i%da] / [calc ~ %.bsn$da% * 1000000] &end &end cursor subbasin close cursor subbasin remove &r msworking close /* Project subbasin coverages to geographic, needed to determine subbasin /* latitude &r msworking 'Calculating subbasin latitude' ~ 'for input to weather generator (waiting time, intermediate)' ~ # 'Routine SUBBASIN' &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do project cover qz_sub%i% qzsub%i%_geo output projection geographic units dd parameters end &describe qzsub%i%_geo /* Calculate latitude of subbasin (file .WGN, variable YLT) &sv .wgn$sub%i%ylt = ( %dsc$ymin% + %dsc$ymax% ) / 2 &end &end &r msworking close /* Clip the streams coverage by subbasin &r msworking 'Clipping streams coverage by subbasin' ~ '(waiting time, long)' # 'Routine SUBBASIN' &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do clip %.streams$covname% qz_sub%i% qz_streams%i% line &end &end &r msworking close /* Prompt the user to determine if lattices for each individual subbasin /* exist, if so, run getgrid and have user supply needed information, if /* not, clip the elevation grid by subbasin into individual lattices &sv latchoice = [getchoice YES NO ~ -prompt 'Do the subbasin elevation files exist as individual lattices?'] &if %latchoice% = YES &then &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &r getgrid INIT .sub$sub%i%grdname * # ~ 'SUBBASIN #'[value .sub$num%i%]' ELEVATION Grid' &r msworking 'Calculating contour lines' ~ '(waiting time, short)' # 'Routine SUBBASIN' copy [value .sub$sub%i%grdname] qz_sub%i%lat &describe qz_sub%i%lat &sv .sub$sub%i%zmax = %grd$zmax% &sv .sub$sub%i%zmin = %grd$zmin% &sv .sub$sub%i%interval = ~ ( %grd$zmax% - %grd$zmin% ) / 4 &if [value .sub$sub%i%interval] <> 0 &then latticecontour qz_sub%i%lat qz_sub%i%c [value ~ .sub$sub%i%interval] [value .sub$sub%i%zmin] &r msworking close &end &end &else &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &r msworking 'Clipping elevation lattice' ~ '(waiting time, long)' # 'Routine SUBBASIN' latticeclip %.elevation$grdname% ~ qz_sub%i% qz_sub%i%lat &r msworking close &r msworking 'Calculating contour lines' ~ '(waiting time, short)' # 'Routine SUBBASIN' &describe qz_sub%i%lat &sv .sub$sub%i%zmax = %grd$zmax% &sv .sub$sub%i%zmin = %grd$zmin% &sv .sub$sub%i%interval = ~ ( %grd$zmax% - %grd$zmin% ) / 4 &if [value .sub$sub%i%interval] <> 0 &then latticecontour qz_sub%i%lat qz_sub%i%c [value ~ .sub$sub%i%interval] [value .sub$sub%i%zmin] &r msworking close &end &end arcedit &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &sv iter = .TRUE. &sv iter_nodes = .TRUE. &messages &on /* The user interactively selects stream segments for each subbasin /* which will be used to determine the channel length for each subbasin &do &while %iter_nodes% editc qz_pstreams mape qz_sub%i% editf arc drawe arc node backc %.sub$covname% 5 backc qz_sub%i% 2 backe arc draw &r msworking 'Currently processing subbasin #'~ [value .sub$num%i%] '' # 'Routine SUBBASIN' &pause &seconds 3 &r msworking close &do &while %iter% sel many &sv choice = [getchoice YES NO ~ -prompt 'Are the ARCS selected correct?'] &if %choice% = YES &then &sv iter = .FALSE. &end &messages &off /* Calculate the channel length for each subbasin (file .SUB, variable CHL1) statistic sum length end &r msworking 'Calculating channel length' ~ '(waiting time, very short)' # 'Routine SUBBASIN' &sv .sub$sub%i%chl1 = [show statistic 1 1] / 1000 &sv numsel%i% = [show number select] &r msworking close /*Store the arc, tnode, and fnode numbers for future processing &do j = 1 &to [value numsel%i%] &sv .sub$sub%i%arc%j% = [show select %j%] &sv .sub$sub%i%arc%j%tnode = [show arc [value ~ .sub$sub%i%arc%j%] tnode#] &sv .sub$sub%i%arc%j%fnode = [show arc [value ~ .sub$sub%i%arc%j%] fnode#] &end removeback qz_sub%i% removeedit qz_pstreams yes /* Put tnode and fnode numbers into an array type structure &sv k = 1 &do j = 1 &to [value numsel%i%] &sv .sub$node%i%_%k% = [value ~ .sub$sub%i%arc%j%tnode] &sv k = %k% + 1 &sv .sub$node%i%_%k% = [value ~ .sub$sub%i%arc%j%fnode] &sv k = %k% + 1 &end /* Sort the tnodes and fnodes for each subbasin &r msworking 'Sorting nodes' ~ '(waiting time, very short)' # 'Routine SUBBASIN' &sv last = [value numsel%i%] * 2 &sv j_term = [value numsel%i%] * 2 - 1 &do j = 1 &to %j_term% &sv exchanges = 0 &sv l_last = %last% - 1 &do k = 1 &to %l_last% &sv temp_k = %k% + 1 &if [value .sub$node%i%_%k%] > [value ~ .sub$node%i%_%temp_k%] &then &do &sv temp_node = ~ [value .sub$node%i%_%k%] &sv .sub$node%i%_%k% = [value ~ .sub$node%i%_%temp_k%] &sv .sub$node%i%_%temp_k% = ~ %temp_node% &sv exchanges = %exchanges% + 1 &end &end &if %exchanges% <> 0 &then &sv last = %last% - 1 &end &r msworking close /* Determine the unique nodes for each subbasin, these will be the /* outlet and headwater points for each subbasin &r msworking 'Determining outlet and headwater' ~ 'for subbasin (waiting time, short)' # 'Routine SUBBASIN' editc qz_pstreams editf node &sv unique_nodes = 0 &sv last = [value numsel%i%] * 2 &sv last_1 = [value numsel%i%] * 2 - 1 &if [value .sub$node%i%_1] <> ~ [value .sub$node%i%_2] &then &do &sv unique_nodes = %unique_nodes% + 1 &sv unique%i%_%unique_nodes% = 1 &end &if [value .sub$node%i%_%last%] <> [value ~ .sub$node%i%_%last_1%] &then &do &sv unique_nodes = %unique_nodes% + 1 &sv unique%i%_%unique_nodes% = %last% &end &do j = 2 &to %last_1% &sv previous = %j% - 1 &sv next = %j% + 1 &if [value .sub$node%i%_%previous%] <> [value ~ .sub$node%i%_%j%] and [value .sub$node%i%_%j%] <> [value ~ .sub$node%i%_%next%] &then &do &sv unique_nodes = %unique_nodes% + 1 &sv unique%i%_%unique_nodes% = %j% &end &end &if %unique_nodes% = 2 &then &do &sv .sub$sub%i%tnode = [value ~ .sub$node%i%_[value unique%i%_1]] &sv .sub$sub%i%fnode = [value ~ .sub$node%i%_[value unique%i%_2]] &sv .sub$sub%i%tnodecoord = [show node ~ [value .sub$sub%i%tnode] coordinate] &sv .sub$sub%i%fnodecoord = [show node ~ [value .sub$sub%i%fnode] coordinate] &sv iter_nodes = .FALSE. &end &else &do &sv iter_nodes = .TRUE. &sv iter = .TRUE. &popup 2manynod.err &end &r msworking close removeedit qz_pstreams yes &end &r msworking 'Calculating slope length and average' ~ 'slope steepness (waiting time, intermediate)' # 'Routine SUBBASIN' editc qz_streams%i% editf arc sel all statistic sum length end &sv .sub$sub%i%lch = [show statistic 1 1] removeedit qz_streams%i% yes /* Calculate the average slope length for each subbasin based on Williams /* and Berndt, 1976 (file .SUB, variable SL) &sv .sub$sub%i%sl = 0.5 * ~ [value .sub$sub%i%da] * 1000 / [value .sub$sub%i%lch] &if [value .sub$sub%i%interval] <> 0 &then &do editc qz_sub%i%c editf arc sel all res contour = [value .sub$sub%i%zmax] - ~ [value .sub$sub%i%interval] statistic sum length end /* Calculate the length of the contour at 75% of the total subbasin height &sv .sub$sub%i%lc1 = [show statistic 1 1] removeedit qz_sub%i%c yes editc qz_sub%i%c editf arc sel all res contour = [value .sub$sub%i%zmax] - 2 ~ * [value .sub$sub%i%interval] statistic sum length end /* Calculate the length of the contour at 50% of the total subbasin height &sv .sub$sub%i%lc2 = [show statistic 1 1] removeedit qz_sub%i%c yes editc qz_sub%i%c editf arc sel all res contour = [value .sub$sub%i%zmax] - 3 ~ * [value .sub$sub%i%interval] statistic sum length end /* Calculate the length of the contour at 25% of the total subbasin height &sv .sub$sub%i%lc3 = [show statistic 1 1] /* Calculate the average slope steepness for each subbasin based on Williams /* and Berndt, 1976 (file .SUB, variable STP) &sv .sub$sub%i%stp = ~ [value .sub$sub%i%interval] * [value .sub$sub%i%zmax] * ~ ( [value .sub$sub%i%lc1] + [value .sub$sub%i%lc2] + [value ~ .sub$sub%i%lc3] ) / [value .sub$sub%i%da] removeedit qz_sub%i%c yes &end &r msworking close &end &end q arcplot &r msworking 'Determining elevation at outlet and' ~ 'headwaters (waiting time, very short)' # 'Routine SUBBASIN' mape %.elevation$grdname% &watch node_elev.wat &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do /* Determine the elevation at the outlet and headwater points for each subbasin cellvalue %.elevation$grdname% ~ [value .sub$sub%i%tnodecoord] cellvalue %.elevation$grdname% ~ [value .sub$sub%i%fnodecoord] &end &end &watch &off &r msworking close q &sv unit = [open node_elev.wat openstat -read] &if %openstat% = 0 &then &do &r msworking 'Calculating average channel slope' ~ '(waiting time, very short)' # 'Routine SUBBASIN' &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &sv record = [read %unit% readstat] &sv .sub$sub%i%tnodeelev = ~ [after %record% 'value '] &sv record = [read %unit% readstat] &sv .sub$sub%i%fnodeelev = ~ [after %record% 'value '] &if NOT [null [value .sub$sub%i%tnodeelev]] ~ and NOT [null [value .sub$sub%i%fnodeelev]] &then /* Calculate the average channel slope for each subbasin /* (file .SUB, variable CHS) &sv .sub$sub%i%chs = [abs [calc [value ~ .sub$sub%i%tnodeelev] - [value .sub$sub%i%fnodeelev]]] / [value .sub$sub%i%chl1] &end &end &r msworking close &end &else &type Error opening file, error code: %readstat% &sv closestat = [close %unit%] &sv del_file = [delete node_elev.wat] &messages &on &end &end &end &else &popup basin.err &sv .again = 'NO' &return /*------------------- &routine PRECIPITATION /*------------------- &if NOT [null %.sub$covname%] &then &do &if %.flag$pcp% &then &sv .again = [getchoice YES NO ~ -prompt 'PRECIPITATION routine already executed, ~ execute it again?'] &if %.again% = 'YES' or %.flag$pcp% = .FALSE. &then &do /* If the routine has been executed previously, clean up coverages, grids, /* and variables associated with the routine before proceeding &if %.again% = 'YES' &then &do &messages &off &do i = 1 &to %.cod$lu_temp% &sv qcover = [exists qz_sub%i%_pcp -cover] &if %qcover% &then kill qz_sub%i%_pcp &end &sv qcover = [exists qz_pcpth -cover] &if %qcover% &then kill qz_pcpth &dv .pcp$* &end &sv .flag$pcp = .TRUE. &r getcover INIT .pcp$covname * point # 'PRECIPITATION Coverage' &messages &off &r msworking 'Determining proportion precipitation contributed' ~ 'by each station (waiting time, long)' # 'Routine PRECIPITATION' thiessen %.pcp$covname% qz_pcpth &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do identity qz_sub%i% qz_pcpth qz_sub%i%_pcp &describe qz_sub%i%_pcp cursor precip declare qz_sub%i%_pcp.pat info ro cursor precip open &sv .pcp$sub%i% = %dsc$polygons% - 1 &do j = 1 &to [calc %dsc$polygons% - 1] cursor precip next /* Calculate proportion of each subbasin that each precipitation /* polygon occupies and determine precipitation ID for that polygon. /* These figures will be interpreted by the internal database which /* will provide the required input for the model run. &sv .pcp$sub%i%poly%j% = ~ %:precip.area% / [value .sub$sub%i%da] &sv .pcp$sub%i%poly%j%id = %:precip.stnid% &end cursor precip close cursor precip remove &end &end &r msworking close &messages &on &end &end &else &popup subbasin.err &sv .again = 'NO' &return /*------------------- &routine TEMPERATURE /*------------------- &if NOT [null %.sub$covname%] &then &do &if %.flag$tmp% &then &sv .again = [getchoice YES NO ~ -prompt 'TEMPERATURE routine already executed, ~ execute it again?'] &if %.again% = 'YES' or %.flag$tmp% = .FALSE. &then &do /* If the routine has been executed previously, clean up coverages, grids, /* and variables associated with the routine before proceeding &if %.again% = 'YES' &then &do &messages &off &do i = 1 &to %.cod$lu_temp% &sv qcover = [exists qz_sub%i%_tmp -cover] &if %qcover% &then kill qz_sub%i%_tmp &end &sv qcover = [exists qz_tmpth -cover] &if %qcover% &then kill qz_tmpth &dv .tmp$* &end &sv .flag$tmp = .TRUE. &r getcover INIT .tmp$covname * point # 'TEMPERATURE Coverage' &messages &off &r msworking 'Determining proportion temperature contributed' ~ 'by each station (waiting time, long)' # 'Routine TEMPERATURE' thiessen %.tmp$covname% qz_tmpth &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do identity qz_sub%i% qz_tmpth qz_sub%i%_tmp &describe qz_sub%i%_tmp cursor tempera declare qz_sub%i%_tmp.pat info ro cursor tempera open &sv .tmp$sub%i% = %dsc$polygons% - 1 &do j = 1 &to [calc %dsc$polygons% - 1] cursor tempera next /* Calculate proportion of each subbasin that each temperature /* polygon occupies and determine temperature ID for that polygon. /* These figures will be interpreted by the internal database which /* will provide the required input for the model run. &sv .tmp$sub%i%poly%j% = ~ %:tempera.area% / [value .sub$sub%i%da] &sv .tmp$sub%i%poly%j%id = ~ %:tempera.stnid% &end cursor tempera close cursor tempera remove &end &end &r msworking close &messages &on &end &end &else &popup subbasin.err &sv .again = 'NO' &return /*------------------- &routine SOILS /*------------------- &if NOT [null %.sub$covname%] &then &do &if %.flag$sol% &then &sv .again = [getchoice YES NO ~ -prompt 'SOILS routine already executed, ~ execute it again?'] &if %.again% = 'YES' or %.flag$sol% = .FALSE. &then &do /* If the routine has been executed previously, clean up variables /* associated with the routine before proceeding &if %.again% = 'YES' &then &dv .sol$* &sv .flag$sol = .TRUE. &r getcover INIT .sol$covname * poly # 'SOILS Coverage' &messages &off &r msworking 'Determining proportion of soils for each subbasin' ~ '(waiting time, very long)' # 'Routine SOILS' &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do identity qz_sub%i% %.sol$covname% qz_sub%i%_sol &describe qz_sub%i%_sol cursor dirt declare qz_sub%i%_sol.pat info ro cursor dirt open &sv .sol$numpoly%i% = %dsc$polygons% - 1 &do j = 1 &to [calc %dsc$polygons% - 1] cursor dirt next /* Calculate proportion of each subbasin that each soil /* polygon occupies and determine soil MUID for that polygon. /* These figures will be interpreted by the internal database which /* will provide the required input for the model run. &sv .sol$sub%i%poly%j% = %:dirt.area% / ~ [value .sub$sub%i%da] &sv .sol$sub%i%poly%j%muid = %:dirt.muid% &end cursor dirt close cursor dirt remove &end &end &r msworking close arcedit &r msworking 'Determining soil characteristics' ~ '(waiting time, very very long)' # 'Routine SOILS' &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &do j = 1 &to [value .sol$numpoly%i%] edit comp info sel all res muid = [quote [value .sol$sub%i%poly%j%muid]] &sv .sol$numseries%i%%j% = [show number select] cursor open &do k = 1 &to [value .sol$numseries%i%%j%] /* Determining the soil attributes needed by the internal database /* for each MUID encountered in each subbasin. &sv .sol$sub%i%poly%j%s5id%k% = %:edit.s5id% &sv .sol$sub%i%poly%j%comppct%k% = %:edit.comppct% &sv .sol$sub%i%poly%j%compname%k% = %:edit.compname% cursor next &end cursor close removeedit comp info yes &end &end &end &r msworking close q &messages &on &end &end &else &popup subbasin.err &sv .again = 'NO' &return /*------------------- &routine ROUTING /*------------------- &if NOT [null %.sub$covname%] &then &do &if %.flag$rte% &then &sv .again = [getchoice YES NO ~ -prompt 'ROUTING routine already executed, ~ execute it again?'] &if %.again% = 'YES' or %.flag$rte% = .FALSE. &then &do /* If the routine has been executed previously, clean up variables /* associated with the routine before proceeding &if %.again% = 'YES' &then &dv .rte$* &sv .flag$rte = .TRUE. arcedit &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &sv iter = .TRUE. &sv iter_nodes = .TRUE. &messages &on &do &while %iter_nodes% editc qz_pstreams mape %.sub$covname% editf arc drawe arc node backc %.sub$covname% 5 backc qz_sub%i% 2 backe arc draw &r msworking 'Currently processing subbasin #'~ [value .sub$num%i%] '' # 'Routine SUBBASIN' &pause &seconds 3 &r msworking close /* The user interactively selects stream segments for each subbasin /* which will be used to determine the routing channel length for each /* subbasin &do &while %iter% sel many &sv choice = [getchoice YES NO ~ -prompt 'Are the ARCS selected correct?'] &if %choice% = YES &then &sv iter = .FALSE. &end &messages &off /* Calculate the routing channel length for each subbasin /* (file .RTE, variable CHL2) &r msworking 'Calculating routing channel length' ~ '(waiting time, very short)' # 'Routine ROUTING' &if [show number select] <> 0 &then &do statistic sum length end &sv .rte$sub%i%chl2 = [show statistic 1 1] / 1000 &sv numsel%i% = [show number select] &end &else &do &sv .rte$sub%i%chl2 = -9999 &sv numsel%i% = 0 &end &r msworking close /*Store the arc, tnode, and fnode numbers for future processing &do j = 1 &to [value numsel%i%] &sv .rte$sub%i%arc%j% = [show select %j%] &sv .rte$sub%i%arc%j%tnode = [show arc [value ~ .rte$sub%i%arc%j%] tnode#] &sv .rte$sub%i%arc%j%fnode = [show arc [value ~ .rte$sub%i%arc%j%] fnode#] &end removeback qz_sub%i% removeedit qz_pstreams yes /* Put the tnode and fnode numbers into an array type structure &sv k = 1 &do j = 1 &to [value numsel%i%] &sv .rte$node%i%_%k% = [value .rte$sub%i%arc%j%tnode] &sv k = %k% + 1 &sv .rte$node%i%_%k% = [value .rte$sub%i%arc%j%fnode] &sv k = %k% + 1 &end /* Sort the tnodes and fnodes for each subbasin &r msworking 'Sorting nodes' ~ '(waiting time, intermediate)' # 'Routine ROUTING' &sv last = [value numsel%i%] * 2 &sv j_term = [value numsel%i%] * 2 - 1 &do j = 1 &to %j_term% &sv exchanges = 0 &sv l_last = %last% - 1 &do k = 1 &to %l_last% &sv temp_k = %k% + 1 &if [value .rte$node%i%_%k%] > [value ~ .rte$node%i%_%temp_k%] &then &do &sv temp_node = [value .rte$node%i%_%k%] &sv .rte$node%i%_%k% = [value ~ .rte$node%i%_%temp_k%] &sv .rte$node%i%_%temp_k% = %temp_node% &sv exchanges = %exchanges% + 1 &end &end &if %exchanges% <> 0 &then &sv last = %last% - 1 &end &r msworking close /* Determine the unique nodes for each subbasin, these will be the /* routing outlet and headwater points for each subbasin &r msworking 'Determining basin outlet and subbasin ' ~ 'outlet for each subbasin (waiting time, intermediate)' # 'Routine ROUTING' &if [value .rte$sub%i%chl2] <> -9999 &then &do editc qz_pstreams editf node &sv unique_nodes = 0 &sv last = [value numsel%i%] * 2 &sv last_1 = [value numsel%i%] * 2 - 1 &if [value .rte$node%i%_1] <> ~ [value .rte$node%i%_2] &then &do &sv unique_nodes = %unique_nodes% + 1 &sv unique%i%_%unique_nodes% = 1 &end &if [value .rte$node%i%_%last%] <> [value ~ .rte$node%i%_%last_1%] &then &do &sv unique_nodes = %unique_nodes% + 1 &sv unique%i%_%unique_nodes% = %last% &end &do j = 2 &to %last_1% &sv previous = %j% - 1 &sv next = %j% + 1 &if [value .rte$node%i%_%previous%] <> [value ~ .rte$node%i%_%j%] and [value .rte$node%i%_%j%] <> [value ~ .rte$node%i%_%next%] &then &do &sv unique_nodes = %unique_nodes% + 1 &sv unique%i%_%unique_nodes% = %j% &end &end &if %unique_nodes% = 2 &then &do &sv .rte$sub%i%tnode = [value ~ .rte$node%i%_[value unique%i%_1]] &sv .rte$sub%i%fnode = [value ~ .rte$node%i%_[value unique%i%_2]] &sv .rte$sub%i%tnodecoord = [show node ~ [value .rte$sub%i%tnode] coordinate] &sv .rte$sub%i%fnodecoord = [show node ~ [value .rte$sub%i%fnode] coordinate] &sv iter_nodes = .FALSE. &end &else &do &sv iter_nodes = .TRUE. &sv iter = .TRUE. &popup 2manynod.err &end removeedit qz_pstreams yes &end &else &sv iter_nodes = .FALSE. &r msworking close &end &end &end q arcplot &r msworking 'Determining elevation at basin outlet and' ~ 'subbasin outlet (waiting time, very short)' # 'Routine ROUTING' mape %.elevation$grdname% &watch node_elev.wat &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do /* Determine the elevation at the routing outlet and headwater points /* for each subbasin &if [value .rte$sub%i%chl2] > 0 &then &do cellvalue %.elevation$grdname% ~ [value .rte$sub%i%tnodecoord] cellvalue %.elevation$grdname% ~ [value .rte$sub%i%fnodecoord] &end &end &end &watch &off &r msworking close q &sv unit = [open node_elev.wat openstat -read] &if %openstat% = 0 &then &do &r msworking 'Calculating average routing channel slope' ~ '(waiting time, very short)' # 'Routine SUBBASIN' &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &if [value .rte$sub%i%chl2] > 0 &then &do &sv record = [read %unit% readstat] &sv .rte$sub%i%tnodeelev = ~ [after %record% 'value '] &sv record = [read %unit% readstat] &sv .rte$sub%i%fnodeelev = ~ [after %record% 'value '] &if NOT [null [value .rte$sub%i%tnodeelev]] ~ and NOT [null [value .rte$sub%i%fnodeelev]] &then /* Calculate the average routing channel slope for each subbasin /* (file .RTE, variable CHSS) &sv .rte$sub%i%chss = [abs [calc [value ~ .rte$sub%i%tnodeelev] - [value .rte$sub%i%fnodeelev]]] / [value .rte$sub%i%chl2] &end &end &end &r msworking close &end &else &type Error opening file, error code: %readstat% &sv closestat = [close %unit%] &sv del_file = [delete node_elev.wat] &messages &on &end &end &else &popup subbasin.err &sv .again = 'NO' &return /*----------- &routine HELP /*----------- &run disp_help.aml arcswat &return /*------------ &routine USAGE /*------------ &type Usage: ARCSWAT INIT {'''position'''} {'''stripe'''} {MODELESS | MODAL} &type Usage: ARCSWAT {args} &return &inform /*----------- &routine OK /*----------- &sv file_exists = [exists arcswat.dat -file] &if %file_exists% &then &sv output_file = [response 'ARCSWAT.DAT already exists, enter new filename'] &else &sv output_file = arcswat.dat &sv unit = [open %output_file% openstat -write] &if %openstat% = 0 &then &do &r msworking 'Generating ASCII output file' # # 'Routine OK' &if %.flag$sub% &then &sv writestat = [write %unit% [quote COD,LU,%.cod$lu%]] &if %.flag$bsn% &then &sv writestat = [write %unit% [quote BSN,DA,%.bsn$da%]] &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &if %.flag$sub% &then &sv writestat = [write %unit% [quote [value .sub$num%i%]]] &if %.flag$pcp% &then &do &sv writestat = [write %unit% ~ [quote PCP,[value .pcp$sub%i%]]] &do j = 1 &to [value .pcp$sub%i%] &sv writestat = [write %unit% [quote ~ [value .pcp$sub%i%poly%j%id],[value .pcp$sub%i%poly%j%]]] &end &end &if %.flag$tmp% &then &do &sv writestat = [write %unit% ~ [quote TMP,[value .tmp$sub%i%]]] &do j = 1 &to [value .tmp$sub%i%] &sv writestat = [write %unit% [quote ~ [value .tmp$sub%i%poly%j%id],[value .tmp$sub%i%poly%j%]]] &end &end &if %.flag$sub% &then &do &sv writestat = [write %unit% [quote WGN,YLT,~ [value .wgn$sub%i%ylt]]] &sv writestat = [write %unit% [quote SUB,FLU,~ [value .sub$sub%i%flu],CHL1,[value .sub$sub%i%chl1]]] &sv writestat = [write %unit% [quote CHS,~ [value .sub$sub%i%chs],SL,[value .sub$sub%i%sl]]] &sv writestat = [write %unit% [quote STP,~ [value .sub$sub%i%stp]]] &end &if %.flag$rte% &then &sv writestat = [write %unit% [quote RTE,CHSS,~ [value .rte$sub%i%chss],CHL2,[value .rte$sub%i%chl2]]] &end &end &end &else &type Error creating file %output_file%, error code: %openstat% &sv closestat = [close %unit%] &sv file_exists = [exists arcswat.sol -file] &if %file_exists% &then &sv output_file = [response 'ARCSWAT.SOL already exists, enter new filename'] &else &sv output_file = arcswat.sol &sv unit = [open %output_file% openstat -write] &if %openstat% = 0 &then &do &do i = 1 &to %.cod$lu_temp% &if [value .sub$used%i%] = 'YES' &then &do &if %.flag$sol% &then &do &sv writestat = [write %unit% [quote SOL,~ [value .sol$numpoly%i%]]] &do j = 1 &to [value .sol$numpoly%i%] &sv writestat = [write %unit% [quote ~ [value .sol$sub%i%poly%j%muid],[value .sol$sub%i%poly%j%],~ [value .sol$numseries%i%%j%]]] &do k = 1 &to [value .sol$numseries%i%%j%] &sv writestat = [write %unit% [quote ~ [value .sol$sub%i%poly%j%s5id%k%],[value .sol$sub%i%poly%j%comppct%k%],~ [value .sol$sub%i%poly%j%compname%k%]]] &end &end &end &end &end &end &else &type Error creating file %output_file%, error code: %openstat% &sv closestat = [close %unit%] &r msworking close &r arcswat exit /*----------- &routine EXIT /*----------- &if [VARIABLE .arcswat$modal] &then &if %.arcswat$modal% &then &run modal.aml close tool$arcswat &dv .arcswat$* &messages &off /* Clean up intermediate coverages and grids &r msworking 'Cleaning up coverages, grids and deleting variables' ~ # # 'Routine EXIT' &sv qcover = [exists qz_pstreams -cover] &if %qcover% &then kill qz_pstreams &if NOT [null %.cod$lu_temp%] &then &do i = 1 &to %.cod$lu_temp% &sv qcover = [exists qz_sub%i% -cover] &if %qcover% &then kill qz_sub%i% &sv qcover = [exists qzsub%i%_geo -cover] &if %qcover% &then kill qzsub%i%_geo &sv qgrid = [exists qz_sub%i%lat -grid] &if %qgrid% &then kill qz_sub%i%lat &sv qcover = [exists qz_sub%i%c -cover] &if %qcover% &then kill qz_sub%i%c &sv qcover = [exists qz_streams%i% -cover] &if %qcover% &then kill qz_streams%i% &sv qcover = [exists qz_sub%i%_pcp -cover] &if %qcover% &then kill qz_sub%i%_pcp &sv qcover = [exists qz_sub%i%_tmp -cover] &if %qcover% &then kill qz_sub%i%_tmp &sv qcover = [exists qz_sub%i%_sol -cover] &if %qcover% &then kill qz_sub%i%_sol &end &sv qcover = [exists qz_pcpth -cover] &if %qcover% &then kill qz_pcpth &sv qcover = [exists qz_tmpth -cover] &if %qcover% &then kill qz_tmpth &dv * &dv .* &r msworking close &messages &on &if [SHOW &thread &exists tool$arcswat] &then &thread &delete tool$arcswat &return /*-------------- &routine BAILOUT /*-------------- &severity &error &ignore &messages &on &return &warning An error has occurred in routine: %routine% (ARCSWAT.AML)