/*
/* girasarc2.aml
/*
/* Extends the giras to arc compatibility by bringing in the GIRAS data set
/* into and Arc coverage with a projection file present, already in "real"
/* coordinates.  In this example, it shall be brought into the correct
/* original coordinate system, UTM meters, as determined from one of the
/* registration tics.
/*
/* Author:  DDNEBERT  USGS-WRD,  11/15/91,  Original coding
/*                               11/19/91,  Added standard Albers projection
/*
&args infile outcov prjopt cm1 cm2 cm3
&if [null %infile%] or [null %outcov%] &then &do 
  &type Usage: GIRASARC2 <infile> <out.coverage> {ALBERS | UTM} {Central Meridian}
  &type   Example: GIRASARC2 willow.giras willow ALBERS -105 30 00
  &return
  &end

&if not [exists %infile% -file] &then &return %infile% not found.
&if [exists %outcov% -cov] &then &return %outcov% already exists.
&if [exists tmpcov -cov] &then kill tmpcov all
&if [null %prjopt%] &then &s prjopt = ALBERS
&s prjopt = [translate %prjopt%]
&if %prjopt% = ALBERS and [null %cm1%] and [null %cm2%] and [null %cm3%] ~
  &then &s cm = '-96 00 00'
  &else &s cm = [quote %cm1% %cm2% %cm3%] 
&if %prjopt% = ALBERS and [null %cm%] &then &do
  &if [null %cm1%] or [null %cm2%] or [null %cm3%]  ~
  &then &return Must enter full degrees minutes seconds e.g. -120 30 00
  &end

/* Version number
&type \'[GIRASARC2  11/19/91 Ver. 0.2 for Arc 5.0.1 -- Platform independent]' \
precision double

/* test for projection type...
&select [translate %prjopt%]
&when UTM
  &do
    &type Will transform to local UTM meters...
    &s cm = ' '
  &end
&when ALBERS
  &do
    &type Will first transform to UTM meters then to Albers projection
    &type with [unquote %cm%] Central Meridian...
  &end
&otherwise
  &do
    &type Projection type %prjopt% not supported.
    &return Exiting GIRASARC2...
  &end
&end

&type Converting GIRAS data...
&mess &off
girasarc %infile% tmpcov
&severity &error &ignore
build tmpcov poly
&mess &on
&if not [exists tmpcov -poly] &then &do
  &type Unable to build coverage, running CLEAN instead...
  tolerance tmpcov fuzzy 1
  clean tmpcov
  &end

&type Reading header information for transformation...
&s girunit [open %infile% ostat -r]
&do i = 1 &to 3
 &s buff [read %girunit% rstat]
 &if %rstat% ne 0 &then &return Bad read of %infile%...
&end
&do i = 1 &to 8 
 &s .j = %i%
 &call setdd
 &s elem%.j% = %.dd%
&end
 &s buff [read %girunit% rstat]
&do i = 1 &to 4
 &s .j = %i%
 &call setdd
 &s .j = 8 + %i%
 &s elem%.j% = %.dd%
&end
 &s cerr [close -all]

/* load the projection stuff into an empty cov
&mess &off
create %outcov%ll
tables
sel %outcov%ll.tic
add
1,-%elem2%,%elem1%
2,-%elem4%,%elem3%
3,-%elem6%,%elem5%
4,-%elem8%,%elem7%
5,-%elem10%,%elem9%
6,-%elem12%,%elem11%
[unquote ' ']
q stop
project cover %outcov%ll %outcov%
input
projection geographic
units dd
parameters
output
projection utm
units meters
parameters
-%.deg% %.min% %.sec%
45 00 00
end

transform tmpcov %outcov%
&mess &on

/* If ALBERS selected, then do the following projection
&if %prjopt% = ALBERS &then &do
  rename %outcov% %outcov%U
  &type Projecting into ALBERS standard projection...
  &mess &off
  project cover %outcov%U %outcov%
input
projection utm
units meters
parameters
-%.deg% %.min% %.sec%
45 00 00
output
projection albers
units meters
parameters
29 30 00
45 30 00
[unquote %cm%]
23 00 00
0.0
0.0
end

build %outcov% poly
&mess &on
&end /* to close ALBERS do loop

&type Cleaning up...
&mess &off
kill tmpcov
kill %outcov%ll all
kill %outcov%U all
&delvar .* 
&mess &on

log %outcov% add
GIRASARC2 %infile% %outcov% %prjopt% [unquote %cm%] [username]
&return
/*****************************************************************
&routine setdd
&s xtic = [extract %.j% [unquote %buff%]]
&if [length %xtic%] = 6 &then &do
 &s .deg = [substr %xtic% 1 2]
 &s .min = [substr %xtic% 3 2]
 &s .sec = [substr %xtic% 5 2]
 &s .dd = %.deg% + ( %.min% / 60 ) + ( %.sec% / 3600 )
 &end
&if [length %xtic%] = 7 &then &do
 &s .deg = [substr %xtic% 1 3]
 &s .min = [substr %xtic% 4 2]
 &s .sec = [substr %xtic% 6 2]
 &s .dd = %.deg% + ( %.min% / 60 ) + ( %.sec% / 3600 )
 &end
&return