/*------------------------------------------------------------------------------ /* Program: neatline.aml /* Usage: &r neatline

/* {UTM Y-shift} /* Last edit date: 08/18/97 /* /* Program header follows at end of file /*------------------------------------------------------------------------------ /*------------------------------------------------------------------------------ /* &args product selat selon xdim ydim datum yshift &severity &error &routine bailout &severity &warning &routine warning_trap &s prog = [ENTRYNAME %aml$file% -NOEXT -FILE] /* current AML being run /* &if [NULL %product%] &then &s product = xx &s oldwatch = [LOCASE [SHOW &watch]] /* old watch file or &off &if %oldwatch% ^= &off &then &s oldwatch = %oldwatch% &append /* to allow continuation /* /***** If PGE, put watch file in history directory; else, in workspace ***** /* &if [VARIABLE .histdir] &then &s watchfile = [JOINFILE %.histdir% %prog%.watch -FILE] &else &s watchfile = %prog%.watch &watch %watchfile% /* &s origprecis = [SHOW PRECISION] PRECISION DOUBLE DOUBLE /* /******************************************************************************* /************************** CHECK REQUIRED ARGUMENTS ********************** /******************************************************************************* /* /* /* &if [NULL %datum%] &then &call usage /* &type \%prog%.aml: Processing started [DATE -DOW] [DATE -CAL] [DATE -AMPM]\ /* /***** Check arguments ***** /* /***** Check datum argument ***** /* &type *** %prog%.aml: Checking arguments... &s datum = [UPCASE %datum%] &if [TYPE %datum%] ^= 1 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]:Datum argument must be NAD27, NAD27_AK,~ NAD83, or NAD83_AK.] &call error_cond &end &if %datum% NOT IN {'NAD27','NAD27_AK','NAD83','NAD83_AK'} &then &do &s phrase = [QUOTE [UNQUOTE %prog%]:Datum argument must be NAD27, NAD27_AK,~ NAD83, or NAD83_AK.] &call error_cond &end &s nad = [AFTER %datum% NAD] &if %datum% IN {'NAD27_AK','NAD83_AK'} &then &do &s alaska = .TRUE. &if %datum% = NAD27_AK &then &do &s datum = NAS_D /* See table 14 in Archelp for PROJECT command &s nad = 27 &end &if %datum% = NAD83_AK &then &do &s datum = NAR_A &s nad = 83 &end &end /* /***** Check SE lat/lon (DMS) arguments ***** /* /*&s selon = [ABS %selon%] /*EJ &if [TYPE %selat%] ^= -1 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]: Latitude entered incorrectly ... must ~ be an integer.] &call error_cond &end &if [TYPE %selon%] ^= -1 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]:Longitude entered incorrectly ... must ~ be an integer.] &call error_cond &end /* /***** Check Degrees of DMS latitude/longitude strings. ***** /***** Lat/long restrictions removed, except can't be > 80 degrees latitude. ** /* &if [ABS %selat%] > 800000 &then /*EJ &do &s phrase = [QUOTE [UNQUOTE %prog%]: Latitude must not be more than 800000.] &call error_cond &end &if [ABS %selon%] > 1800000 &then /*EJ &do &s phrase = [QUOTE [UNQUOTE %prog%]: Longitude must not be more than 1800000.] &call error_cond &end /* /***** Check Y-shift argument. ***** /* &if [NULL %yshift%] &then &s yshift = 0 &if [type %yshift%] ^= -1 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]: Y-shift argument must be an integer.] &call error_cond &end &if %yshift% ^= 0 & [ABS %yshift%] < 1000000 | [ABS %yshift%] > 10000000 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]: Y-shift must be between 1 and 10 million.] &call error_cond &end &if %yshift% > 0 &then &s yshift = [CALC %yshift% * -1] /* /***** Check X-dimension argument. ***** /* &if [TYPE %xdim%] ^= -1 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]: X dimension must be integer (eg. 000730).] &call error_cond &end &if [length %xdim%] < 5 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]: X dimension must designate degrees as DMS (eg. 000730).] &call error_cond &end /* /***** Check Y-dimension argument. ***** /* &if [TYPE %ydim%] ^= -1 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]: Y dimension must be integer (eg. 000730).] &call error_cond &end /* Check Degrees of DMS Y dimension string. &if [length %ydim%] < 5 &then &do &s phrase = [QUOTE [UNQUOTE %prog%]: Y dimension must designate degrees as DMS (eg. 000730).] &call error_cond &end /* /******************************************************************************* /*********** SET VARIABLES FROM PGE GLOBAL VARIABLES OR USE DEFAULTS ********* /******************************************************************************* /* &if [VARIABLE .pge_coordsys] &then &s proj = %.pge_coordsys% &else &s proj = UTM &if [VARIABLE .pge_coordzone] &then &s zone = [TRUNCATE %.pge_coordzone%] &else &call calc_zone /* sets zone based on SE longitude &if [VARIABLE .pge_unitsh] &then &s units = %.pge_unitsh% &else &s units = meters &s outcovutm = %product%ntutm%nad% &s outcovgeo = %product%ntgeo &s outcovpge = %product%n /* /******************************************************************************* /******************** KILL ANY EXISTING NEATLINE COVERAGES ******************* /******************************************************************************* /* &if [EXISTS %outcovgeo% -COVER] &then &do &type Neatline geographic coverage %outcovgeo% already exists. &type Killing existing coverage and replacing...\ KILL %outcovgeo% ALL &end &if [EXISTS %outcovutm% -COVER] &then &do &type %datum% UTM neatline coverage %outcovutm% already exists. &type Killing existing coverage and replacing...\ KILL %outcovutm% ALL &type &end /* /******************************************************************************* /*************** CREATE DMS AND DD STRINGS FOR ALL FOUR CORNERS ************** /******************************************************************************* /* &type *** %prog%.aml: Computing geographic positions for four quad corners... /* /* Compute X-dimension /* &s lond = [SUBSTR %xdim% 1 [CALC [LENGTH %xdim%] - 4]] &s lonm = [SUBSTR %xdim% [CALC [LENGTH %xdim%] - 3] 2] &s lons = [SUBSTR %xdim% [CALC [LENGTH %xdim%] - 1] 2] &s londm = %lonm% / 60.0 &s londs = %lons% / 3600.0 &s xdimd = %lond% + %londm% + %londs% /* /* Compute Y-dimension /* &s latd = [SUBSTR %ydim% 1 [CALC [LENGTH %ydim%] - 4]] &s latm = [SUBSTR %ydim% [CALC [LENGTH %ydim%] - 3] 2] &s lats = [SUBSTR %ydim% [CALC [LENGTH %ydim%] - 1] 2] &s latdm = %latm% / 60.0 &s latds = %lats% / 3600.0 &s ydimd = %latd% + %latdm% + %latds% /* /* Compute SE latitude/longitude /* &s selatd = [SUBSTR %selat% 1 [CALC [LENGTH %selat%] - 4]] &s selatm = [SUBSTR %selat% [CALC [LENGTH %selat%] - 3] 2] &s selats = [SUBSTR %selat% [CALC [LENGTH %selat%] - 1] 2] /* &s selatdd = %selatd% &s selatdm = %selatm% / 60.0 &s selatds = %selats% / 3600.0 &if %selatd% < 0 &then /*EJ &s selatdec = %selatd% - %selatdm% - %selatds% &else &s selatdec = %selatd% + %selatdm% + %selatds% /* &s selond = [SUBSTR %selon% 1 [CALC [LENGTH %selon%] - 4]] &s selonm = [SUBSTR %selon% [CALC [LENGTH %selon%] - 3] 2] &s selons = [SUBSTR %selon% [CALC [LENGTH %selon%] - 1] 2] /* &s selondd = %selond% &s selondm = %selonm% / 60.0 &s selonds = %selons% / 3600.0 &s selon00 .false. &s selon180 .false. &if %selond% < 0 &then /*EJ &do &if %selond% = -180 &then &do &s selon180 .true. &s selondec = 180 &s selond = 180 &s selonm = 00 &s selons = 00 &end &else &do &s selondec = %selond% - %selondm% - %selonds% &end &end &else &do &if %selond% < 1 AND %selonm% = 00 AND %selons% = 00 &then &do &s selon00 .true. &s selondec = 0 &end &else &do &if %selond% = -00 &then &s selon00 .true. &if [quote [substr %selond% 1 1]] = '-' &then &s selondec = %selond% - %selondm% - %selonds% &else &s selondec = %selond% + %selondm% + %selonds% &end &end /*END of else selond not < 0 /* /* Compute NE latitude/longitude /* &s nelatdec = %selatdec% + %ydimd% &s nelondec = %selondec% &s nelatdadd = 0 &s nelatmadd = 0 &s nelatsadd = 0 &s nelatd = %selatd% + %latd% &s nelatm = %selatm% + %latm% &s nelats = %selats% + %lats% &if %nelats% > 59 &then &do &s nelatmadd = 1 &s nelats = [CALC %nelats% - 60] &end &s nelatm = [CALC %nelatm% + %nelatmadd%] &if %nelatm% > 59 &then &do &s nelatdadd = 1 &s nelatm = [CALC %nelatm% - 60] &end &s nelatd = [CALC %nelatd% + %nelatdadd%] &if [LENGTH %nelatm%] = 1 &then &s nelatm = 0%nelatm% &if [LENGTH %nelats%] = 1 &then &s nelats = 0%nelats% &s lat3 = [TRIM %nelatd%%nelatm%%nelats%] &s lon3 = %selon% &s nelond = %selond% &s nelonm = %selonm% &s nelons = %selons% /* /* Compute NW latitude/longitude /* &s nwlatdec = %nelatdec% &s nwlondec = %nelondec% - %xdimd% &s nwlondadd = 0 &s nwlonmadd = 0 &s nwlonsadd = 0 &s nwlond = %selond% - %lond% &s nwlonm = %selonm% + %lonm% &s nwlons = %selons% + %lons% &if %nwlons% > 59 &then &do &s nwlonmadd = 1 &s nwlons = [CALC %nwlons% - 60] &end &s nwlonm = [CALC %nwlonm% + %nwlonmadd%] &if %nwlonm% > 59 &then &do &s nwlondadd = 1 &s nwlonm = [CALC %nwlonm% - 60] &end &s nwlond = [CALC %nwlond% - %nwlondadd%] &if [LENGTH %nwlonm%] = 1 &then &s nwlonm = 0%nwlonm% &if [LENGTH %nwlons%] = 1 &then &s nwlons = 0%nwlons% &s lon2 = [TRIM %nwlond%%nwlonm%%nwlons%] &s lat2 = %lat3% &s nwlatd = %nelatd% &s nwlatm = %nelatm% &s nwlats = %nelats% /* /* Compute SW latitude/longitude /* &s swlatdec = %selatdec% &s swlondec = %nwlondec% &s lat1 = %selat% &s lon1 = %lon2% &s swlatd = %selatd% &s swlatm = %selatm% &s swlats = %selats% &s swlond = %nwlond% &s swlonm = %nwlonm% &s swlons = %nwlons% /* /******************************************************************************* /*************** COMPUTE POINT WITHIN QUAD FOR UTM PROJECTION *************** /******************************************************************************* /* &type *** %prog%.aml: Creating within-quad DMS strings for UTM projection... /* &s latpoint = %selatd%' '%selatm%' '%selats% /*&s lonpoint = '-'%selond%' '%selonm%' '%selons% &s lonpoint = %selond%' '%selonm%' '%selons% /*EJ /* /******************************************************************************* /***************** ARC:GENERATE A COVERAGE IN DECIMAL DEGREES **************** /******************************************************************************* /* &type *** %prog%.aml: Generating geographic neatline coverage %outcovgeo%... /* GENERATE %outcovgeo% LINES 1 %selondec%,%selatdec% %nelondec%,%nelatdec% END 2 %nelondec%,%nelatdec% %nwlondec%,%nwlatdec% END 3 %nwlondec%,%nwlatdec% %swlondec%,%swlatdec% END 4 %swlondec%,%swlatdec% %selondec%,%selatdec% END END QUIT /* BUILD %outcovgeo% /* /******************************************************************************* /******************* DENSIFY VERTICES FOR GEOGRAPHIC NEATLINE *************** /******************************************************************************* /* /* NOTE !!: Reorder the tic ID's so final tics will be clockwise, from SW corner. /* &type *** %prog%.aml: Densify vertices for %outcovgeo%... /* DISPLAY 0 ARCEDIT EDITCOVER %outcovgeo% EDITFEATURE TIC SELECT $ID = 1 CALC $ID = 7 SELECT $ID = 2 CALC $ID = 1 SELECT $ID = 3 CALC $ID = 2 SELECT $ID = 4 CALC $ID = 3 SELECT $ID = 7 CALC $ID = 4 EDITFEATURE ARC GRAIN [CALC 0.041666668 / 2.000000000] /* divide RevPG tol by 2 - more vertices SELECT ALL DENSIFY QUIT YES BUILD %outcovgeo% /* /******************************************************************************* /******************* ARC:PROJECT GEOGRAPHIC NEATLINE INTO UTM *************** /******************************************************************************* /* &type *** %prog%.aml: Creating NAD%nad% UTM neatline coverage %outcovutm%... /* PROJECT COVER %outcovgeo% %outcovutm% INPUT PROJECTION GEOGRAPHIC UNITS DD DATUM %datum% /* See ArcDoc PROJECT help - Datums table 14 PARAMETERS OUTPUT PROJECTION %proj% DATUM %datum% UNITS %units% &if %selon00% &then /* If Greenwich meridian ZONE 30 &else &if %selon180% &then /* If 180 meridian ZONE 60 &else &if %zone% ^= 0 &then /* If valid zone from PGE tables ZONE %zone% &if %yshift% ^= 0 &then YSHIFT %yshift% PARAMETERS &if ^ %selon00% AND ^ %selon180% AND %zone% = 0 &then /* only if zone not used &do [UNQUOTE %lonpoint%] [UNQUOTE %latpoint%] &end END BUILD %outcovutm% LINE BUILD %outcovutm% NODE BUILD %outcovutm% POLY /* /******************************************************************************* /************************* CLEAN UP UNNECESSARY FILES ********************** /******************************************************************************* /* &type *** %prog%.aml: Cleaning up... /* /***** Check coverage existence ***** /* &if [EXISTS %outcovpge% -COVER] &then &do &messages &off &all KILL %outcovpge% ALL &messages &on &end &type Renaming final output coverage to %outcovpge%... RENAME %outcovutm% %outcovpge% &s didwhat = completed &call exit /* &type \****************** PROGRAM [UPCASE %didwhat%] ****************** &type %prog%.aml has been run to create covers %outcovpge% and %outcovgeo%. &type Please read the %watchfile% file to verify processing. &type Processing %didwhat% [DATE -DOW] [DATE -CAL] [DATE -AMPM] &type *******************************************************\ &watch %oldwatch% &return /* /* /*------------------------------------------------------------------------------ /*------------------------------ ROUTINE LIST -------------------------------- /*------------------------------------------------------------------------------ /* /* /*------------------- &routine usage /*------------------- /* &call exit /* &type \*********************** PROGRAM %prog% *********************** &type USAGE: &r %prog%

&type {UTM Y-shift} &type Ex: &r %prog% mor 393730 -1050730 000730 000730 NAD83 -4000000 &type &r %prog% fair 645230 -1471500 001500 000730 NAD27_AK &type &type This AML creates two coverages: "prefix"n (morn, fairn) - a polygon-built &type neatline in UTM meters, and "prefix"ntgeo - a polygon-built neatline &type in geographic lat/long coordinates. &type *************************************************************************\ &if [VARIABLE oldwatch] &then &watch %oldwatch% /* &return; &return &error /* /* /*------------------- &routine error_cond /*------------------- /* /***** Anticipated errors are trapped here /* &s didwhat = halted &call exit /* &if [VARIABLE outcovpge] &then &do &if [EXISTS %outcovgeo% -COVER] &then KILL %outcovgeo% ALL &if [EXISTS %outcovutm% -COVER] &then KILL %outcovutm% ALL &if [EXISTS %outcovpge% -COVER] &then KILL %outcovpge% ALL &end /* &type \****************** PROGRAM [UPCASE %didwhat%] ****************** &type [UNQUOTE %phrase%] &type Processing %didwhat% [DATE -DOW] [DATE -CAL] [DATE -AMPM] &type *******************************************************\ &if [VARIABLE oldwatch] &then &watch %oldwatch% /* &return; &return &error /* /* /*------------------- &routine bailout /*------------------- /* /***** Unanticipated errors are trapped here /* &severity &error &ignore &messages &on /* &s didwhat = bombed &call exit /* &if [VARIABLE outcovpge] &then &do &if [EXISTS %outcovgeo% -COVER] &then KILL %outcovgeo% ALL &if [EXISTS %outcovutm% -COVER] &then KILL %outcovutm% ALL &if [EXISTS %outcovpge% -COVER] &then KILL %outcovpge% ALL &end /* &type \****************** PROGRAM [UPCASE %didwhat%] ****************** &type Error occurred at line %aml$errorline% in %aml$errorfile% &type Processing %didwhat% [DATE -DOW] [DATE -CAL] [DATE -AMPM] &type ********************************************************\ /* &if [VARIABLE oldwatch] &then &watch %oldwatch% /* &return; &return &error /* /* /*------------------- &routine warning_trap /*------------------- /* /***** Program returning a warning /* &type *** %prog%.aml returned a warning for %outcovutm% cover &return /* /* /*------------------- &routine calc_zone /*------------------- /* /***** Calculates UTM zone from SE longitude coord (from RevPG's srchadj.aml) /***** if no PGE global zone variable exists (i.e. zone not in Oracle table). /* &s zone = 0 /* initialize to 0, PROJECT will handle appropriately &s zonea = [CALC %selon% / 60000] &if %zonea% = 30 or %zonea% = -30 &then &s zonea = 29 &if %zonea% LE 0 &then &s zone = [CALC [BEFORE %zonea% .] + 30] &if %zonea% GT 0 &then &s zone = [CALC [BEFORE %zonea% .] + 31] /* /***** If running PGE, set global variable ***** /* &if [VARIABLE .product] &then &s .pge_coordzone = %zone% /* &return /* /* /*------------------- &routine exit /*------------------- /* &if [UPCASE [SHOW program]] = PROJECT &then &do PARAMETERS END &end &if [UPCASE [SHOW program]] = PRJDEF &then END &if [UPCASE [SHOW program]] = ARCEDIT &then QUIT NO &if [VARIABLE origprecis] &then PRECISION %origprecis% /* &return /* from the routine /* /* /* /*------------------------------------------------------------------------------ /*----------------------------- PROGRAM HEADER ------------------------------ /*------------------------------------------------------------------------------ /* Program: NEATLINE.AML /* Purpose: Creates two double-precision output neatline coverages in UTM /* meters and Geographic projections based on the SE corner /* latitude/longitude values. The UTM neatline can be output in /* either NAD27 or NAD83. /* /* The output coverages are %product%n and %product%ntgeo /*------------------------------------------------------------------------------ /* U.S. Geological Survey /*------------------------------------------------------------------------------ /* Disclaimer: Although this program has been used by the U.S. Geological /* Survey (USGS), no warranty, expressed or implied, is made by the USGS /* as to the accuracy and functioning of the program and related program /* material, nor shall the fact of distribution constitute any such warranty, /* and no responsibility is assumed by the USGS in connection therewith. /*------------------------------------------------------------------------------ /* Primary module: Arc /* Other modules: ArcEdit, PROJECT /*------------------------------------------------------------------------------ /* Arguments: product - product name (prefix) /* selat - SE latitude (DDMMSS format) /* selon - SE longitude " " /* xdim - x dimension " " /* ydim - y dimension " " /* datum - horizontal datum (NAD27 or NAD83) /* yshift - optional y shift /* /* Local variables: /* didwhat - program processing status /* lat1 - SW corner latitude (TIC #1) /* lat2 - NW corner latitude (TIC #2) /* lat3 - NE corner latitude (TIC #3) /* latd - latitude degrees /* latdm - latitude decimal minutes (latm / 60) /* latds - latitude decimal seconds (lats / 3600) /* latm - latitude minutes /* latpoint - latitude text string with spaces /* lats - latitude seconds /* lon1 - SW corner longitude (TIC #1) /* lon2 - NW corner longitude (TIC #2) /* lon3 - NE corner longitude (TIC #3) /* lond - longitude degrees /* londm - longitude decimal minutes (lonm / 60) /* lonpoint - longitude text string with spaces /* londs - longitude decimal seconds (lons / 3600) /* lonm - longitude minutes /* lons - longitude seconds /* nad - numeric designation of datum /* nelat*** - used to derive NE latitude decimal degrees /* nelon*** - used to derive NE longitude decimal degrees /* nwlat*** - used to derive NW latitude decimal degrees /* nwlon*** - used to derive NW longitude decimal degrees /* oldwatch - original watch file or &off status /* origprecis - original Arc precision /* outcovgeo - Geographic neatline coverage name /* outcovpge - projected PGE neatline coverage name /* outcovutm - projected neatline coverage name pre-Rename /* phrase - used to record message /* prog - program name /* proj - projection (from PGE global or default) /* selatd - SE latitude degrees (also for NE,NW,SW) /* selatdd - SE latitude decimal degrees " /* selatdec - total SE latitude decimal degrees " /* selatdm - SE latitude decimal minutes " /* selatds - SE latitude decimal seconds " /* selatm - SE latitude minutes " /* selats - SE latitude seconds " /* selon00 - .true. if SE long is from 00 to -1 (ZONE 30) /* selon180 - .true. if SE long is -180 (in ZONE 60) /* selond - SE longitude degrees /* selondd - SE longitude decimal degrees portion /* selondec - total SE longitude decimal degrees /* selondm - SE longitude decimal minutes portion /* selonds - SE longitude decimal seconds portion /* selonm - SE longitude minutes /* selons - SE longitude seconds /* swlat*** - used to derive SW latitude decimal degrees /* swlon*** - used to derive SW longitude decimal degrees /* units - projection ground units /* watchfile - watch file name /* xdimd - X dimension in decimal degrees /* ydimd - Y dimension in decimal degrees /* zone - projection zone (eg. UTM zone) /* zonea - used to calculate UTM zone /* /* Global variables: /* Created: .pge_coordzone (only if running PGE, None if standalone) /* Existing, no mod: .histdir, .pge_coordsys, .pge_coordzone, .pge_unitsh /* Existing, mod: None /* /* AML reserved variables: aml$errorfile, aml$errorline, aml$file *------------------------------------------------------------------------------ /* Called from: Arc Command Line /* Called AMLs: None /* Called exec: None /* Called scripts: None /*------------------------------------------------------------------------------ /* Routines: bailout - called in case of program failure /* calc_zone - calc's UTM zone if no zone global exists /* error_cond - traps for anticipated problems /* exit - called upon successful program completion /*------------------------------------------------------------------------------ /* History: /* JKosovich RMMC 11/08/95 Original coding, based on RevPG's ntline.aml /* JKosovich RMMC 02/16/96 Changed dataset to product var /* LLile RMMC 06/07/96 Changed some variables and bailout calls /* MMcCormick RMMC 07/26/96 Modifications for PGE system /* JKosovich RMMC 11/06/96 Modified to reflect new PGE coding standards /* JKosovich RMMC 12/12/96 Fixed RENAME, added PROJECTDEFINE info /* JKosovich RMMC 12/13/96 Renamed to neatline.aml, independent of PGE /* JKosovich RMMC 02/11/97 Misc modifications /* JKosovich RMMC 03/03/97 Fixed Yshift to always subtract value entered /* JKosovich RMMC 08/18/97 Added Alaska NAD27 (NAS_D) & NAD83 (NAR_A) /* datums /*------------------------------------------------------------------------------ /* Error conditions/handling: _ /* Assumptions: - /*------------------------------------------------------------------------------ /* Notes: /*------------------------------------------------------------------------------ /*------------------------------------------------------------------------------