;+
; NAME:
;     FMT_WALLOPS 
; PURPOSE:
;     Strip off changes from Wallops 7DAYSS file. Should be able to
;       handle e-mail ASCII files as well as ftp'd files. Renames
;       .wN extensions to (the Wallops standard) to .w0N. Creates 
;       solass.wNN and solasf.sNN files.
; CATEGORY:
; CALLING SEQUENCE:
;     fmt_wallops,'7dayss.wNN'
;     fmt_wallops,'7dayss.wNN',/asca
;     fmt_wallops,'forecast.wNN'
;     fmt_wallops,'forecast.wNN',/asca
; INPUTS:
;     input file
; OPTIONAL (KEYWORD) INPUT PARAMETERS:
; OUTPUTS:
;     creates files in current directory
; COMMON BLOCKS:
; SIDE EFFECTS:
; RESTRICTIONS:
; MODIFICATION HISTORY:
;     19-Jan-98, HSH, JIK, written based on FMT_RASM
;     24-Jan-98, HSH, restored /asca capability
;-
pro fmt_wallops, file_in, change_out, file_out, asca = asca, qstop=qstop
;
break_file,file_in,disk,dir,filnam,ext                  ; Parse the filename
if n_elements(byte(ext)) eq 3 then $
  ext = strmid(ext,0,2)+strtrim(string(0),1)+strmid(ext,2,1)

if n_elements(file_out) eq 0 then begin
  if filnam eq '7dayss' or filnam eq 'forecast' then begin
     if filnam eq '7dayss' then begin
       if keyword_set(asca) eq 0 then begin
         file_out = concat_dir( dir,  'solass' + ext)
         print,'Will write solass file to: ',file_out
       endif else begin
         file_out = concat_dir( dir,  'ascass' + ext)
         print,'Will write ascass file to: ',file_out
       endelse
       if n_elements(change_out) eq 0 then begin
         change_out = concat_dir( dir,  'change_file' + ext)
       endif
       print,'Will write changes to:     ',change_out
     endif
     if filnam eq 'forecast' then begin
       if keyword_set(asca) eq 0 then begin 
         file_out = concat_dir( dir,  'solasf' + ext)
         print,'Will write solasf file to: ',file_out
       endif else begin
         file_out = concat_dir( dir,  'ascasf' + ext)
         print,'Will write solasf file to: ',file_out
       endelse
     endif
  endif else begin
     print,'Input file type is not recognized. Try again?'
     stop
  endelse
endif

pass_changes=' '
i_change=0
remainder= ' '
buf1=' '
openr,lun0,file_in, /get_lun
while buf1 ne '*' do begin                       ; to be tolerant of e-mail
  buf = '' 
  readf,lun0,buf
  buf1 = strmid(buf,0,1)
endwhile
header1 = buf
readf,lun0,buf
header2 = buf
readf,lun0,buf
header3 = buf
readf,lun0,buf
header4 = buf
first_head = strmid(header2,29,6)
while (not EOF(lun0)) and first_head eq 'CHANGE' do begin
  readf,lun0,buf
  if strmid(buf,0,1) eq 'D' or strmid(buf,0,1) eq 'I' then begin
    pass_changes = [pass_changes,buf]
    i_change=i_change+1
  endif
endwhile
change_print=[header1,header2,header3,header4]
if i_change gt 0 then begin
  change_print= [change_print,pass_changes(1:*)]
endif else begin
  text = strarr(1)
  text(0) = ' ' & change_print = [change_print,text]
  text(0) = 'NO CHANGES LISTED' & change_print = [change_print,text]
  text(0) = ' ' & change_print = [change_print,text]
endelse
if filnam ne 'forecast' then begin
  free_lun, lun0
  openw,lun1,change_out,/get_lun
  for i = 0, n_elements(change_print) -1 do printf,lun1,change_print(i)
  free_lun, lun1
  ;spawn,'lpr -h '+change_print
endif
  ;
  ; now go back and do the solass (or ascass) file!
  ;
pass_out = ' '
openr,lun0,file_in, /get_lun
buf1 = ''
while buf1 ne '*' do begin                       ; to be tolerant of e-mail
  buf = '' 
  readf,lun0,buf
  buf1 = strmid(buf,0,1)
endwhile
while (not EOF(lun0) and (strpos(buf,'ACTIVITIES') eq -1)) $
  do readf,lun0,buf
readf,lun0,buf
header2 = buf
readf,lun0,buf
header3=buf
readf,lun0,buf
header4=buf
readf,lun0,buf
header5=buf
readf,lun0,buf
header6=buf
pass_out = [header1,header2,header3,header4,header5,header6]
while (not EOF(lun0)) do begin
  readf,lun0,buf
  if keyword_set(asca) eq 0 then begin
    if (strmid(buf,35,3) ne 'AST' and strpos(buf,'TKG') ne -1) $
      or strmid(buf,0,1) eq '*' then begin
      pass_out = [pass_out,buf]
    endif
  endif else begin
    if (strmid(buf,35,3) ne 'SOL' and strpos(buf,'TKG') ne -1) $
      or strmid(buf,0,1) eq '*' then begin
      pass_out = [pass_out,buf]
    endif
  endelse
endwhile
free_lun, lun0
openw,lun1,file_out,/get_lun
for i = 0, n_elements(pass_out)-1 do printf,lun1,pass_out(i)
free_lun,lun1
if keyword_set(qstop) then stop
end