! @(#)outdisk.prg	17.1.1.1 (ESO-DMD) 01/25/02 17:12:27
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! MIDAS procedure outdisk.prg  to write FITS files on disk
! K. Banse	951211
! execute via OUTDISK/FITS in_files out_files option out_type
! where
!        in_files is a list of filenames (separated by a comma)
!                 or the name of an ASCII file (indicated by file.cat)
!                 containing each filename in a record
!        out_files is a list of result filenames (separated by a comma)
!                 or the name of an ASCII file (indicated by file.cat)
!                 containing each filename in a record
!                 if there are less out_names than in_files `toto*.mt'
!                 is used as output file name
!        option is Image, Table or Fitfile
!        out_type is defaulted to currently set default FITS file type
!
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
crossref IN OUT OPTION TYPE
!
!
define/param p1 ? c -
"Enter input Midas file name(s) or ASCII file with list of names: "
define/param p2 + c -
"Enter output FITS name(s) or ASCII file with list of names: "
define/param p3 Image c "Enter type of in_files:"
! define/param p4 {mid$types} c "Enter type for output files: "
define/param p4 mt c "Enter type for output files: "
! 
define/local caty/i/1/2 0,0
define/local kindx/i/1/2 0
define/local zindx/i/1/2 0
define/local oindx/i/1/2 0,0
define/local count/i/1/2 0,0
define/local fin/i/1/2 -1,-1
define/local fout/i/1/2 -1,-1
define/local root/c/1/20 "toto " 
define/local out_type/c/1/8 " " all
define/local names/c/1/80 " " all
define/local onames/c/1/80 " " all
define/local single/c/1/80 " " all
define/local osingle/c/1/80 " " all
define/local out_opt/i/1/1 1		!1: filename(s), name.cat or `nada'
					!2: filetype=xyz, 3: root=abcd
define/local chacha/c/1/1 x
if aux_mode .lt. 2 then
   define/local diri/c/1/1 ]
else
   define/local diri/c/1/1 /
endif
if p3(1:1) .eq. "T" then
   define/local ftype/c/1/4 .tbl
   define/local cattype/c/1/6 =Table 
elseif p3(1:1) .eq. "F" then
   define/local ftype/c/1/4 .fit
   define/local cattype/c/1/5 =FITS  
else
   define/local ftype/c/1/4 .bdf
   define/local cattype/c/1/6 =Image
endif
if p4(1:1) .eq. "." then
   write/keyw out_type {p4(2:)}
else
   write/keyw out_type {p4(1:)}
endif
!
! look for wildcard stuff
! 
if m$index(p1,"*") .gt. 0 then
comma_loop:
   kindx = m$index(p1,",")
   if kindx .gt. 0 then
      p1({kindx}:{kindx}) = " "
      goto comma_loop
   endif
   if aux_mode .lt. 2 then
      $dir/out=z__z.cat/column=1/version=1 {p1}
      open/file z__z.cat read fin
      read/file {fin} names		!skip 1. line
      if fin(2) .le. 0 then
         write/error 30
         return/exit
      endif
      read/file {fin} names		!skip 2. line
      read/file {fin} names		!skip 3. line
      open/file y__y.cat write fout
vms_read:
      read/file {fin} names
      if fin(2) .le. 0 .or. names(1:1) .eq. " " then
         close/file {fout}
      else
         write/file {fout} {names(1:80)}
         goto vms_read
      endif
      close/file {fin}
   else
      $ls {p1} > y__y.cat
   endif
   write/keyw names " " all
   write/keyw p1 "y__y.cat                "
endif
! 
! check output names
! 
fout = -1
if p2(1:1) .eq. "+" then
   count(2) = 1
   write/out -
   "We miss the names of the output files... so we use `{root}*'"
else
   if m$index(p2,".cat") .gt. 1 then
      open/file {p2} read fout
      if fout .lt. 1 then
         write/out Could not open file: {p2} ...
         return/exit
      endif
      read/file {fout} inputc		!read 1. record
      if inputc(1:2) .ne. " =" then
         close/file {fout}		!rewind file
         open/file {p2} read fout
      endif
   else
      inputi = m$index(p2,"=")
      if inputi .gt. 1 then
         inputi = inputi+1		!move to following char.
         if p2(1:4) .eq. "name" .and. -
            p2({inputi}:{inputi}) .eq. "i" then			!name=input
            out_opt = 2
         elseif p2(1:4) .eq. "root" then			!root=abcd
            write/keyw root "{p2({inputi}:>)}  "
         endif
      else	
         inputi = m$index(p2,"*")
         if inputi .gt. 0 then				!also support abcd*
            inputi = inputi- 1
            write/keyw root {p2(1:{inputi})}
         else
            write/keyw onames/c/1/80 {p2}
         endif
      endif
   endif
endif
! 
!  check if input catalog of images 
!
if m$index(p1,".cat") .gt. 1 then
   open/file {p1} read fin
   if fin .lt. 1 then
      write/out Could not open file: {p1} ...
      return/exit
   endif
   caty(1) = 1				!input from catalog/file
   goto cat_loop
else
   write/keyw names/c/1/80 {p1}
endif
!
! -----------------------------------
! here for input names(s) on one line
! -----------------------------------
! 
in_loop:
if names(1:1) .eq. " " return			!we finished
! 
count = count+1
zindx = m$index(names,",")
if zindx .gt. 1 then
   zindx = zindx-1
   write/keyw single "{names(1:{zindx}))} "
   zindx = zindx+2
   write/keyw names "{names({zindx}:))} "
else
   write/keyw single "{names(1:))} "
   names(1:1) = " "
endif
! 
if out_opt .eq. 2 goto do_it			!outname created later on
! 
if fout .gt. 0 then
   write/keyw onames/c/1/80 " " all
   read/file {fout} inputc
   inputi = m$index(inputc," ")
   if inputi .gt. 1 then
      write/keyw onames {inputc(1:{inputi})}
   else
      write/keyw onames {inputc}
   endif
   if fout(2) .lt. 1 then
      close/file {fout}
      fout = -1
   endif
endif
! 
if onames(1:1) .eq. " " then
   if count(2) .eq. 0 then
      count(2) = count(1)			!save the index
      set/format i1
      write/keyw p8 "{count}. output file..."
      set/format i4
      write/out -
      "We miss the name of the {p8}" "so we use `{root}{count}'"
   endif
   write/keyw osingle {root}{count}
else
   oindx = m$index(onames,",")
   if oindx .gt. 1 then
      oindx = oindx-1
      write/keyw osingle "{onames(1:{oindx}))} "
      oindx = oindx+2
      write/keyw onames "{onames({oindx}:))} "
   else
      write/keyw osingle "{onames(1:))} "
      onames(1:1) = " "
   endif
endif
goto do_it
! 
!  read name from catalog/file and prepare it for `in_loop'
! 
cat_loop:
write/keyw names/c/1/80 " " all
read/file {fin} names
zindx = M$INDEX(names," ")
if zindx .gt. 1 then
   kindx = 80-zindx+1
   write/keyw names/c/{zindx}/{kindx} " " all
endif
if fin(2) .lt. 1 then
   close/file {fin}
   if fout .gt. 0 close/file {fout}
   if caty(2) .eq. 0 then
      write/out "no files obtained from wildcard list => " -
                "no more space left in directory!"
   endif
   return
else
   caty(2) = caty(2)+1			!no. of entries used from catalog/file
endif
if names(1:1) .eq. " " then		!look for ASCII or catalog
   if names(2:6) .eq. cattype(1:5) .or. names(2:7) .eq. "=ASCII" then
      goto cat_loop
   endif
   write/keyw names "{names(2:)} "
else
   if names(1:2) .eq. "! " goto cat_loop
endif
goto in_loop				!now work like with command line input
! 
! now we have single input and output file prepared
! 
do_it:
kindx(2) = m$len(single)
type_loop:
chacha = single({kindx(2)}:{kindx(2)})
if chacha .eq. "." then
   goto dodo_it					!there is a filetype
elseif chacha .eq. diri then
   wait/secs 0					!NoOp
else
   kindx(2) = kindx(2)-1
   if kindx(2) .gt. 1 goto type_loop
endif
write/keyw single {single}{ftype}
! 
dodo_it:
if out_opt .eq. 2 then				!filetype=xyz option
   inputi = m$indexb(single,".")		!there is a type for sure
   write/keyw osingle {single(1:{inputi})}{out_type} 
   goto dododo_it
else
   kindx(2) = m$len(osingle)
endif
! 
otype_loop:
chacha = osingle({kindx(2)}:{kindx(2)})
if chacha .eq. "." then
   goto dododo_it                               !there is a filetype
elseif chacha .eq. diri then
   wait/secs 0
else
   kindx(2) = kindx(2)-1
   if kindx(2) .gt. 1 goto otype_loop
endif
write/keyw osingle {osingle}.{out_type}
! 
!  here we do a single OUTTAPE/FITS 
! 
dododo_it:
if m$tstno(single(1:2)) .eq. 1 then		!check, if name is digit...
   outdisk/sfits "{single}" {osingle}
else
   outdisk/sfits {single} {osingle} 
endif
! 
write/out {single} "written to FITS file" {osingle}
last_but_one:
if caty(1) .eq. 1 then
   goto cat_loop
else
   goto in_loop
endif