Viewing contents of file '../idllib/iuedac/iuelib/pro/g2_archeck.pro'
;************************************************************************
;+
;*NAME:
;
;   	G2_ARCHECK
;  
;*CLASS:
;  
;  	Spectral Data Reduction
;  
;*CATEGORY:
;  
;*PURPOSE:
;
;   	Procedure to check wcenter (WIG) and width (WID) vectors for bad
;    	points & fix them (by removing elements or replacing values).
;  
;*CALLING SEQUENCE:
;
;   	G2_ARCHECK,WAVE,WIG,WID,HR,WFIT,WGFIT,WDFIT,NKEPT
;  
;*PARAMETERS:
;
;	WAVE	(REQ) (I) (1) (F D)
;
;	WIG 	(REQ) (I) (1) (F D)
;
;	WID	(REQ) (I) (1) (F D)
;
;	HR	(REQ) (I) (1) (F D)
;
;	WFIT	(REQ) (O) (1) (F D)
;
;	WGFIT 	(REQ) (O) (1) (F D)
;
;	WDFIT 	(REQ) (O) (1) (F D)
;
;	NKEPT	(REQ) (O) (0) (I)
;  
;*SYSTEM VARIABLES USED:
;  
;  	NOPRINT	-   !NOPRINT
;
;*INTERACTIVE INPUT:
;  
;*SUBROUTINES CALLED:
;  
;  	PARCHECK
;  
;*FILES USED:
;
;*SIDE EFFECTS:
;  
;*RESTRICTIONS:  
;
;	modified to run using unix/sun idl version 1.1
;  
;*NOTES:
;
;       tested with IDL Version 2.1.0 (sunos sparc)	16 Jul 91
;       tested with IDL Version 2.1.0 (ultrix mispel)	N/A
;       tested with IDL Version 2.1.0 (vms vax) 	16 Jul 91
;  
;*PROCEDURE:
;
;   	Procedure to check wcenter (WIG) and width (WID) vectors for bad
;    	points & fix them (by removing elements or replacing values).	
;  
;*I_HELP nn:
;  
;*EXAMPLES:
;  
;*MODIFICATION HISTORY:
;
;      nov-21-1989 jtb@gsfc modifications for unix/sun idl
;      8 July 1991 llt add parcheck, update prolog, clean up; tested on VAX.
;      16 Jul 91  PJL tested on SUN and VAX; updated prolog
;
;-
;************************************************************************
 pro g2_archeck,wave,wig,wid,hr,wfit,wgfit,wdfit,nkept
;
 npar=n_params(0)
 if npar eq 0 then begin
    print,'G2_ARCHECK,WAVE,WIG,WID,HR,WFIT,WGFIT,WDFIT,NKEPT'
    retall
 endif  ; npar
 parcheck,npar,8,'G2_ARCHECK'
 sc = hr(5)                                  ; 1 = lbls, 2 = elbl
 ind = where( (wig ne 0.) and (wid ne 0.) , nfit)
 nkept = nfit
 wfit = wave(ind)
 wgfit = wig(ind)
 wdfit = wid(ind)
;
 if !noprint eq 0 then begin
    print,' '
    print,'Check for zeroes and reorder:'
    print,form="(1x,i5,a,i3,a)",nfit,' of',hr(1),' points kept in signal vector'
    in=where( (wig eq 0.) or (wid eq 0.), count )
    if count gt 0 then print,'   Indices of deleted elements: ',in
 endif  ; debug printout loop
;
; check width values
;
 check = 3.0 * sc
 ind = where( wdfit le check ,nkept)
 if !noprint eq 0 then begin
  print,form="(1x,a,f4.1,a)",'Check for large widths ( >',check,') and reorder:'
    print,form="(1x,i5,a,i3,a)",nkept,' of',nfit,' points kept in signal vector'
    in = where( wdfit gt check , count )
    if count gt 0 then print,'   indices of deleted elements: ',in
 endif  ; debug printout loop
 if nkept ne nfit then begin
    wfit = wfit(ind)
    wgfit = wgfit(ind)
    wdfit = wdfit(ind)
 endif  ; reorder loop for nkept ne nfit
;
; check center values
;
 min = hr(3) + 1 - sc           ; allow centers + or - sc from center
 max = hr(3) + 1 + sc  
 wgfit = wgfit > min < max
 if !noprint eq 0 then begin
    print,form="(1x,a,i3,a,i3)",'Check centers for values outside range ', $
        fix(min),' to ',fix(max)
    in = where ( wgfit eq max , count)
    if count gt 0 then print,'   Indices equal to max:',in
    in = where ( wgfit eq min , count)
    if count gt 0 then print,'   Indices equal to min:',in
 endif  ; debug printout loop
 return
 end  ; g2_archeck