;******************************************************************************
;+
;*NAME:
;
;	DISPCON     6-MAY-81 	PROGRAMMER:   T.B. AKE
;
;*CLASS:
;  
;*CATEGORY:
;
;	IUESIPS
;  
;*PURPOSE:
;
;	Extracts dispersion constants from an IUE extracted spectral file
;       header label.
;  
;*CALLING SEQUENCE:
;
;	DISPCON,IMAGET,B,A
;  
;*PARAMETERS:
;
;    	IMAGET	(REQ) (I) (0) (S)
;		Image name and version only; '.lab' is filled in by the 
;	      	procedure. 
;
;    	B	(REQ) (O) (1) (D)
;		Array of B (line direction) and A (sample direction) 
;		dispersion constants (9-element double precision array). 
;		These constants describe the line and sample positions as a 
;		function of order number and wavelength in geomd space 
;		(i.e., in a reference frame in which the geometrical image 
;		distortion has been corrected).  See Version 2.0 of the 
;		IUESIPS Information Manual for more information.
;  
;	A	(REQ) (O) (1) (D)
;		Sample direction.
;
;*EXAMPLES:
;
;	dispcon,'swp30307l',b,a
;
;*SYSTEM VARIABLES USED:
;
;	none
;  
;*INTERACTIVE INPUT:
;  
;  	None.
;  
;*SUBROUTINES CALLED:
;  
;	PARCHECK
;	DECOMPOSE
;	CHKFITS
;	EBCDIC
;  
;*FILES USED:
;  
;  	imaget.lab
;  
;*SIDE EFFECTS:
;  
;*RESTRICTIONS:
;
;	Not for use with fits formatted files.
;  
;*NOTES:
;
;    	Input file can not be a RI or PI image file (their labels do not 
;	contain the dispersion constants). 
;
;    	Note:  To determine the original coordinates of the spectral format
;	or a particular spectral feature, 2 additional steps are required:
;    	         1) The transformation must be made from 'geomd space' (which
;		    the dispersion constants refer to) to 'raw image space'
;		    using the IUESIPS tables of displacement values, and
;    	         2) compensation must be made for additional corrections made
;		    to the wavelength assignments such as the heliocentric
;		    velocity correction in high dispersion, and the
;		    vacuum-to-air correction above 2000 angstroms.
;        
;*PROCEDURE:
;
;     	0) Use DECOMPOSE to separate parts of input file name.
;     	1) Open label file and get total number of lines in the label.
;     	2) Prints an appropriate error message if it cannot find the '.lab'
;	   file, closes logical unit 3 and does a RETALL.
;     	3) Find location of dispersion constants by searching for a B & A in
;     	   column 1 (if it can't find them, it prints an appropriate message).
;     	4) Extract values for B and A.
;     	5) Closes open files, and ends.
;  	
;*I_HELP nn:
;  
;*MODIFICATION HISTORY:
;
;    	1-28-86 RWT remove search for @ symbol, use double precision variables
;    	  	    and update DOC file.
;  	1-19-87 RWT correctly handle current image labels & use double 
;		    precision 
;  	4-13-87 RWT VAX mods: add PARCHECK, and remove INSERT
;      12-06-89 RWT modify code to handle label changes in exponent
;               sign and sign location introduced in SIPS, and use GET_LUN
;       1-9-90 RWT UNIX mods: use lower-case, 
;     23July91 LLT clean up, update prolog, add parcheck, tested on VAX
;     25July91 PJL tested on SUN; updated prolog
;	29 Nov 93  PJL  update prolog; clean up;  added CHKFITS
;
;-
;******************************************************************************
 pro dispcon,imageit,b,a
;
 npar = n_params(0)
 if (npar eq 0) then begin
    print,'DISPCON,IMAGET,B,A'
    retall
 endif  ; no input parameters given
 parcheck,npar,3,'DISPCON'
 a = dblarr(9)
 b = a
 x = dblarr(3)
;
;  check file format
;
 decompose,imageit,dk,path,nam,ext,ver
 chkfits,dk+path+nam+'.lab'+ver,newsips,/silent
 case newsips of
    0:
    1:  begin
           print,dk + path + nam + '.lab' + ver + ' is a fits file.'
           print,'ACTION:  retall'
           retall
        end  ; newsips eq 1
    2:  begin
           print,dk + path + nam + '.lab' + ver + ' not found.'
           print,'ACTION:  retall'
           retall
        end  ; newsips eq 2
    else:  print,'This should not happen.'
 endcase  ; newsips
;
;  open label file and get total number of lines in the label
;
 openr,/get_lun,lun,dk+path+nam+'.lab'+ver
 rec = assoc(lun,bytarr(74))
 reci = assoc(lun,intarr(37))
 header = reci(0)
 totl = header(2)  ; number of lines in label
 witch = 194       ; 194 = 'b' in ebcdic
 ln = 100          ; start looking at line 101 in label
;
;  find position where dispersion constants are
;
 repeat begin
    ln = ln + 1
    if (ln gt totl) then begin
       print,'Unable to find dispersion constants in the label.'
       print,'ACTION:  retall'
       free_lun,lun 
       retall 
    endif  ; ln gt totl
    l = rec(ln)
 endrep until (l(1) eq witch)      ;   find uppercase 'b'
 while (witch gt 192) do begin   ;  repeat for b,a arrays
    na = ln
    while (l(1) eq witch) do begin
;
;  extract the dispersion constants for b and a
;
       for i=0,2 do begin   ;  extract 3 values per line
          j = i * 24
          d = l
          ebcdic,d
	  sign_exp = string(d(21+j))
	  if (sign_exp eq ' ') then sign_exp = '+'
	  exp = sign_exp + string(d((22+j):(23+j)))
          n = string(d((5+j):(19+j))) + 'E' + exp
          x(i) = double(n)
       endfor  ; 3 values per line
       if (witch eq 194) then b((ln-na)*3) = x else a((ln-na)*3) = x
       ln = ln + 1
       l = rec(ln)  ; read next line
    endwhile  ; output array complete
    witch = witch - 1  ; ebcdic 'a' = 193
 endwhile  ; witch gt 192
 free_lun,lun
;
 return
 end  ; dispcon