Viewing contents of file '../idllib/contrib/icur/bbody.pro'
;***********************************************************************
PRO BBODY,W,F,EPS,temp=temp      ; COMPUTE AND OVERPLOT BLACK BODY SPECTRUM
COMMON COM1,H,IK,IFT,NSM,C
COMMON COMXY,Xcur,Ycur,zerr
common icurunits,xunits,yunits,title,col1,col2,col3
IMULT=0 & IPT=0
if n_params(0) lt 2 then return
if n_params(0) lt 3 then eps=fix(w)*0+100
if max(eps) eq 0 then eps=eps+100
E=FLOAT(EPS/(ABS(EPS)>1))
E=E>0.
if n_elements(col2) eq 0 then opcol=!p.color else opcol=col2
REENT:
case 1 of
   !d.name eq 'PS' : begin
      read,'BBody: scale to all (1), point (2), or range(3), - for multiple: ',itype
      if abs(itype) le 1 then begin
         x1=min(w) & x2=max(w)
         endif
      if abs(itype) eq 2 then begin
         read,' enter wavelength of point: ',x1
         ipt=1
         x2=x1
         endif
      if abs(itype) eq 3 then read,' enter wavelength limits: ',x1,x2
      if itype lt 0 then imult=1
      I1=FIX(xindex(w,x1)) & I2=FIX(xindex(w,x2))
      y1=f(i1)
      if ipt eq 1 then i2=0
   end
;
   else: begin         ;plot to screen
      print,'BBody: scale to all (0,N), point (1,P), or select range(<space> ,M)'
      opstat,'  Waiting'
      BLOWUP,-1
      opstat,'  Working'
      IF ZERR EQ 90 THEN BEGIN
         STOP,' BBODY STOP
         GOTO,REENT
         ENDIF
      IF (zERR EQ 77) OR (ZERR EQ 109) THEN IMULT=1 ;<M>
      IF (zERR EQ 80) OR (ZERR EQ 112) THEN BEGIN   ;<P>
         IMULT=1 & IPT=1
         ENDIF
      IF zERR EQ 49 THEN IPT=1   ;<1>
      IF (zERR EQ 78) OR (ZERR EQ 110) THEN BEGIN   ;<N>
         IMULT=1 & zERR =48
         ENDIF
      IF zERR EQ 48 THEN BEGIN   ;<0>
         I1=0
         I2=N_ELEMENTS(W)-1
         GOTO,GOON
         ENDIF
      IF (ZERR EQ 90) OR (ZERR EQ 122) THEN STOP,'BBODY'    ;<Z,Z>
      IF (ZERR EQ 81) OR (ZERR EQ 113) OR (ZERR EQ 26) THEN RETURN   ;<Q,Q,^Z>
      X1=Xcur
      I1=FIX(xindex(w,x1))         ;TABINV,W,X1,I1
      IF IPT EQ 1 THEN BEGIN   ;<1,P>
         I2=0
         Y1=Ycur
         ENDIF ELSE BEGIN   ;SECOND INPUT
         opstat,'  Waiting'
         BLOWUP,-1
         opstat,'  Working'
         X1=Xcur
         I2=FIX(xindex(w,x1))           ;   TABINV,W,X1,I2
   IF I2 LT I1 THEN BEGIN
      T=I2 & I2=I1 & I1=T
      ENDIF
   IF I2 EQ I1 THEN BEGIN
      I2=0
      Y1=F(I1)
      ENDIF                      ;ELSE I2=I2-I1+1  ;# POINTS
   ENDELSE
      end
   endcase
GOON:
z='($," Enter BB temperature (K) ")'
if not keyword_set(temp) then begin
   print,format=z
   READ,TEMP
   endif
C1=3.7412E-5 & C2=1.43879
W1=W/1.E8   ;CM
MPLT:  BB=C1/W1^5/(EXP(C2/W1/TEMP)-1.)
BB=BB/1.E25                           ; NORMALIZE FLUX
FP=F*E
BP=BB*E
IF I2 EQ 0 THEN NORM=Y1/BB(I1) ELSE NORM=TOTAL(FP(I1:I2))/TOTAL(BP(I1:I2))
OPLOT,W,BB*NORM,color=opcol
IK=IK+1
Z='BB:T='+STRTRIM(STRING(TEMP),2)+' N='+STRTRIM(STRING(NORM),2)
print,z
IF IMULT EQ 0 THEN RETURN ELSE BEGIN
   z='($,"Enter T, <0 to end ")'
   print,format=z
   READ,TEMP
   IF TEMP LE 0. THEN RETURN
   GOTO,MPLT
   ENDELSE
END