! @(#)precess.prg	17.1.1.1 (ES0-DMD) 01/25/02 17:12:28
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  MIDAS command procedure  precess.prg  860201
!  D. Baade ST-ECF, Garching
!  KB	870831,890519,900703,901008,910429
!  MP   920807
!  precess equatorial coordinates from one epoch to another
!
!  the following keywords are used:
!
!  a) if all input is from keywords
!  P1    		original right ascension: hour,min,sec
!  P2           	original declination: degree,min,sec
!  P3           	original epoch: year,month,day
!  P4   		new epoch: year,month,day
!  OUTPUTR/R/1/3        precessed right ascension: hour,min,sec
!  OUTPUTR/R/4/3        precessed declination: degree,min,sec
!  OUTPUTR/R/7/1        new epoch: real years
!
!  b) if input is mainly from table
!
!  P1                   table name
!  P2                   original epoch: year,month,day
!  P3                   new equinox: year,month,day
!
!------------------------------------------------------------------------------
!
crossref ALPHA0 DELTA0 EQUINOX0 EQUINOX1
!
inputc(1:2) = "++"
define/local rneg/r/1/1 1.0
define/local sign/c/1/1 &
!
define/param p1 ? ? "Enter original R.A. (hour,min,sec) or table name: "
!
inputi(20) = m$index(p1,".tbl") 
if inputi(20) .le. 1 then
!
! input only from keywords
! ------------------------
! 
   define/param p2 ? N "Enter original declination (degree,min,sec):      "
   define/param p3 ? N "Enter original epoch (year,month,day):            "
   define/param p4 ? N "Enter new epoch (year,month,day):                 "
   define/maxpar 4
!
   write/keyw inputr/r/1/3 {p3},0,0
   write/keyw inputr/r/4/3 {p4},0,0
   write/keyw inputr/r/7/3 {p1},0,0
   write/keyw inputr/r/10/3 {p2},0,0
   inputc(1:1) = p2(1:1)		!catch eventual minus sign
   rneg = (inputr(10)*3600.)+(inputr(11)*60.)+inputr(12)
   if rneg .lt. 0.0 inputc(1:1) = "-"
!
   write/keyw action PR
   run MID_EXE:COMPXY
!
   outputi(1) = outputr(1)
   outputi(2) = outputr(2)
   outputi(3) = outputr(4)
   outputi(4) = outputr(5)
   set/format i2 f10.3,g20.10		!f10.3 was g10.3 and ugly...
   write/out "Coordinates precessed to {outputd(2)} are:"
   if sign .eq. "-" then
      define/local absout/i/1/2 0,0
      absout(1) = m$abs(outputi(3))
      absout(2) = m$abs(outputi(4))
      define/local absr/r/1/1 0.0
      absr(1) = m$abs(outputr(6))
      write/out "R.A.: {outputi(1)} hrs  {outputi(2)} min  {outputr(3)} sec" -
      "  Decl.: - {absout(1)} deg  {absout(2)} arcmin  {absr(1)} arcsec"
   else
      write/out "R.A.: {outputi(1)} hrs  {outputi(2)} min  {outputr(3)} sec" -
      "  Decl.: {outputi(3)} deg  {outputi(4)} arcmin  {outputr(6)} arcsec"
   endif
!
else
!
! input mainly from table
! -----------------------
! 
   define/param p2 TAB ? "Enter original epoch (year,month,day):            "
   define/param p3 ? N "Enter new epoch (year,month,day):                 "
   define/maxpar 3
!
   define/local lp/i/1/1 0			! loop variable
   define/local nline/i/1/1 0			! number of lines in table
   define/local table/c/1/20			! name of table
!
   inputi(20) = inputi(20)-1
   table = "{p1(1:{inputi(20)})}     "
!
   if p2(1:3) .ne. "TAB" write/keyw inputr/r/1/3 {p2},0,0
   write/keyw inputr/r/4/3 {p3},0,0
!
! create columns which shall accept the results
   set/midas output=logonly	!no error messages if columns exist already
   create/column {table} :PAHR
   create/column {table} :PAMIN
   create/column {table} :PASEC
   create/column {table} :PDDEG
   create/column {table} :PDMIN
   create/column {table} :PDSEC
   set/midas output=yes				! default
!
   nline = m$value({table}.tbl,tblcontr(4))	! get number of lines in table
   do lp = 1 nline				! loop over all lines in table
!
!  get all missing input from table
     copy/tk {table} :AHR :AMIN :ASEC @{lp} inputr/r/7/3
     copy/tk {table} :DDEG :DMIN :DSEC @{lp} inputr/r/10/3
     if p2(1:3) .eq. "TAB" then
        copy/tk {table} :EYEAR :EMONTH :EDAY @{lp} inputr/r/1/3
     endif
     write/keyw outputc/c/1/80 " " all
     outputc = "{inputr(10)},{inputr(11)},{inputr(12)}"
!
     write/keyw action PR
     run MID_EXE:COMPXY
!
!  write all output to table
     copy/kt outputr/r/1/3 {p1} :PAHR :PAMIN :PASEC @{lp}
     copy/kt outputr/r/4/3 {p1} :PDDEG :PDMIN :PDSEC @{lp}
   enddo                                        ! these coordinates precessed
!
   set/format i1
   if nline .eq. 1 then
      outputc = "row "
   else
      outputc = "rows "
   endif
   write/out {nline} {outputc} of table {table}.tbl processed
!
!  update descriptor HISTORY
   write/desc {p1} new_epoch/d/1/1 {outputd(2)}
   if p2(1:3) .eq. "TAB" then
      write/desc {p1} history/c/-1/80 "Coords precessed to {outputd(2)}"
   else
      write/desc {p1} old_epoch/d/1/1 {outputd(1)}
      write/desc {p1} history/c/-1/80 -
      "Coords precessed from {outputd(1)} to {outputd(2)}"
   endif
endif