Viewing contents of file '../idllib/iuedac/iuelib/pro/binlab.pro'
;******************************************************************************
;+
;*NAME:
;
;       BINLAB
;
;*CLASS:
;
;*CATEGORY:
;
;       NEWSIPS
;
;*PURPOSE:
;
;       Converts lines of the binary portion of the IUESIPS Vicar label that
;       are stored in hexadecimal notation in the NEWSIPS fits header back
;       into binary.
;
;*CALLING SEQUENCE:
;
;       BINLAB,HEADER,STARTLINE,ENDLINE,BINPART
;
;*PARAMETERS:
;
;       HEADER  (REQ) (I) (1) (S)
;               NEWSIPS fits header - including IUESIPS Vicar label (in COMMENT
;               portion.
;
;       STARTLINE (REQ) (I) (0) (I)
;               The IUE Vicar label line number to start converting hexadecimal
;               to binary.  Binary lines are 38 to 82 and 86 to 100.
;
;       ENDLINE (REQ) (I) (0) (I)
;               The IUE Vicar label line number to stop converting hexadecimal
;               to binary.  Binary lines are 38 to 82 and 86 to 100.
;
;       BINPART (REQ) (O) (1) (B)
;               The binary portion of the IUESIPS Vicar label.
;
;*EXAMPLES:
;
;       fitslab,'swp24787r.lab',lab,flab
;       binlab,lab,86,100,binpt
;
;*SYSTEM VARIABLES USED:
;
;       none
;
;*INTERACTIVE INPUT:
;
;       none
;
;*SUBROUTINES CALLED:
;
;       PARCHECK
;       HEXTODEC
;
;*FILES USED:
;
;       none
;
;*SIDE EFFECTS:
;
;*RESTRICTIONS:
;
;       Only for use with binary lines of IUE Vicar label.
;
;*NOTES:
;
;       Double check which lines are considered binary??????
;
;       Line number an 'C' are not "translated" - left as zeroes.
;
;       Leading 0 difference between RDAF format and output of BINLAB.
;
;       STARTLINE and ENDLINE may be changed by the procedure.
;
;*PROCEDURE:
;
;       If HEADER parameter is not a string array, procedure retalls.  The IUE
;       Vicar label is located in the fits header.  If the phrase, "IUE-VICAR
;       HEADER START" is not found, the procedure retalls.  The end of the
;       IUE Vicar label is located in the fits header.  If the phrase,
;       "IUE-VICAR HEADER END" is not found, the procedure assumes the end of
;       the HEADER array is the end.  The label is separated from the fits
;       header.
;
;       The provided line numbers are checked.  If the starting line must be
;       less than or equal to 82 and greater than or equal to 38, or greater
;       than or equal to 86 and less than or equal to 100.  The ending line
;       must be greater than or equal to the starting line and less than or
;       equal to 82, or 100.  The numbers will be reset accordingly.
;       The number of lines is calculated.
;
;       If the starting line munber is not found, the procedure retalls.  Each
;       line number in the binary portions of the IUE Vicar label occurs twice.
;       Each line is read, the hexadecimal portion is passed to HEXTODEC, and
;       the returned value is place in the correct half of the line in the
;       working array.  The first line in the label is placed in elements 0
;       through 32.  The second line in the label is placed in elements 33
;       through 65.  The line number and 'C' are not included.
;
;       The working array is converted to byte and returned.
;       
;
;*I_HELP  nn:
;
;*MODIFICATION HISTORY:
;
;       16 Feb 94  PJL  started
;       22 Feb 94  PJL  make more general - add start and end line numbers
;
;-
;******************************************************************************
 pro binlab,header,startline,endline,binpart
;
 npar = n_params(0)
 if (npar eq 0) then begin
    print,'BINLAB,HEADER,STARTLINE,ENDLINE,BINPART'
    retall
 endif  ; npar eq 0
 parcheck,npar,4,'BINLAB'
;
;  header must be a string vector
;
 temp = size(header)
 if ( (temp(0) ne 1) or (temp(temp(0)+1) ne 7) ) then begin
    print,'HEADER must be a string array.'
    print,'ACTION:  retall'
    retall
 endif  ; (temp(0) ne 1) or (temp(temp(0)+1) ne 7)
;
;  locate the IUESIPS Vicar label in the NEWSIPS fits header
;
 temp = strpos(header,'IUE-VICAR HEADER START')   ; start line
 sline = where(temp ge 0,ct)
 if (ct le 0) then begin
    print,"Can not find the line 'IUE_VICAR HEADER START'."
    print,'Unable to locate beginning of IUESIPS Vicar label.
    print,'ACTION:  retall'
    retall
 endif  ; ct le 0
;
 temp = strpos(header,'IUE-VICAR HEADER END')     ; end line
 eline = where(temp ge 0,ct)
 if (ct le 0) then begin
    print,"Can not find the line 'IUE_VICAR HEADER END'."
    print,'Unable to locate end of IUESIPS Vicar label.
    print,'Will use last line of HEADER'
    eline = n_elements(header)
 endif  ; ct le 0
;
 label = header(sline(0)+1:eline(0)-1)    ; the IUE Vicar label
;
;  determine which - if any - of the requested lines are binary lines in the
;  IUESIPS Vicar label
;
 if (endline lt startline) then begin
    print,'The ending line number ' + strtrim(endline,2) +    $
       ' is greater than the starting line number ' +    $
       strtrim(startline,2) + '.'
    print,'ACTION:  retall'
    retall
 endif  ; endline gt startline
;
 if (startline le 82) then begin
;
;  line numbers must be between 38 and 82 - inclusive
;
    startline = 38 > startline < 82
    endline = startline > endline < 82
 endif else begin
;
;  line numbers must be between 86 and 100 - inclusive
;
    startline = 86 > startline < 100
    endline = startline > endline < 100
 endelse  ; startline lt 86
 if (startline eq endline) then print,'WARNING:  Starting line number ' +  $
    'equals ending line number - continuing.'
;
;  number of lines
;
 numline = endline - startline + 1
;
 temp = strpos(label,strtrim(startline,2),74)
 sline = where(temp ge 0,ct)
 if (ct le 0) then begin
    print,'Can not locate line ' + strtrim(startline,2) +    $
       ' of IUESIPS Vicar label.'
    print,'ACTION:  retall'
    retall
 endif  ; ct le 0
 workarr = intarr(74,numline)    ; working array
;
 for i = 0,(numline*2)-1 do begin
    line = strmid(label(sline(0)+i),8,66)
    hextodec,line,intvec,2
    if (i/2 eq i/2.) then workarr(0:32,i/2) = intvec(0:32)  $  ; first part
       else workarr(33:65,i/2) = intvec(0:32)    ; second part of line
 endfor  ; i
;
 binpart = byte(workarr)
;
 return
 end  ; binlab