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