PRO dustem_show_fortran, model=model $

                         , st=st $
                         , restart=restart $

                         , data_dir=data_dir $
                         , dustem_dir=dustem_dir $
                         , nh=nh, fsed=fsed, sw=sw $
                         , inst=inst, smdat=smdat, com=com $
                         , wref=wref, bbpar=bbpar, wext=wext  $
                         , xr=xr, yr=yr, tit=tit $

                         , CMB=cmb, COSMO=COSMO, plottype=plottype, SHOW=show $

                         , wn=wn, HARD=hard

;+
; NAME:
;    dustem_show_fortran

;

; PURPOSE:

;    shows various outputs of the DUSTEM fortran calculations,
;    overlaid on an example observation of diffuse ISM dust 

;

; CATEGORY:
;    DustEM, Distributed, User-Example

;

; CALLING SEQUENCE:

;    dustem_show_fortran

;

; INPUTS:

;    DATA_DIR : path to directory containing observational
;               SED files. Defaults to Data/EXAMPLE_OBSDATA/ subdirectory.

;    DUSTEM_DIR : path to directory containing DustEM data files. Default
;                 is the !dustem_dat directory (which is defined in
;                 a user's idl_startup file)
;    model = specifies the interstellar dust mixture used by DustEM
;           'MC10' model from Compiegne et al 2010 (default)
;           'DBP90' model from Desert et al 1990
;           'DL01' model from Draine & Li 2001
;           'WD01_RV5p5B' model from Weingartner & Draine 2002 with Rv=5.5
;           'DL07' model from Draine & Li 2007
;           'J13' model from Jones et al 2013, as updated in
;                 Koehler et al 2014
;           'G17_ModelA' model A from Guillet et al (2018). Includes
;                 polarisation. See Tables 2 and 3 of that paper for details.
;           'G17_ModelB' model B from Guillet et al (2018)
;           'G17_ModelC' model C from Guillet et al (2018)
;           'G17_ModelD' model A from Guillet et al (2018)
;    NH     : float, fiducial column density for emission [Default is 1e20 cm-2]'
;    FSED   : string, read SED from the file FSED 
;    SW     : integer, width of window to SMOOTH the PAH emission 
;    INST   : string array, instruments to be shown. Default is  ['DIRBE','FIRAS','HFI','WMAP']
;    COM    : string to describe SMDAT structure
;    WEXT   : normalize the UV-extinction to be 1 at wavelength WEXT (in microns). Also applied to IR-extinction
;    WREF   : get the dust cross-section per H at wavelength WREF (in microns)
;    BBPAR  : float tuple, T and beta for modified BB to get dust opacity from FIRAS
;    XR,YR  : plot ranges
;    TIT    : title for SMDAT and plots
;    CMB    : keyword to overlay the CMB
;    COSMO  : keyword to plot long wavelengths

;    plottype   : if plottype=0, only the model spectrum is shown
;             if plottype=1, only the observational SED is shown
;             if plottype=2, both the model and data are shown

;             both are shown (default)'
;    SHOW   : string array, defines what to plot display. Possible
;             options include
;             ''emis'', ''extuv'', ''extir'', ''alb'', ''sdist'', ''polext'', ''polsed'', ''align''
;              Default is [''emis'']. SHOW=0 no plot
;   WN     : array of window numbers for plots

;  HARD    :  /HARD for postscript of requested plots (if set, plots will not
;            show on screen)
;            

; OPTIONAL INPUT PARAMETERS:

;    None

;

; OUTPUTS:

;

; OPTIONAL OUTPUT PARAMETERS:

;

; SMDAT : from DUSTEM_GET_BAND_FLUX (see format there), structure containing model projected on data points: I_INST field in SMDAT.
;             SMDAT also contains model direct outputs in M_EMIS, M_EXT fields (see format in ADD_MOD.pro )

;

; ACCEPTED KEY-WORDS:
;    help      = If set, print this help
;    restart   = If set, reinitialise DustEMWrap and use a new
;                wavelength vector for integration. 

;

; COMMON BLOCKS:
;    None

;

; SIDE EFFECTS:
;    None

;

; RESTRICTIONS:
;    The DustEM fortran code must be installed
;    The DustEMWrap IDL code must be installed

;

; PROCEDURES AND SUBROUTINES USED:

;   

; EXAMPLES
    ;; print,' Examples:'
    ;; print,'  path=''/Users/lverstra/DUSTEM_LOCAL/dustem4.0/''' 

    ;; print,'  to show SED only:                     dustem_show_fortran,path'
    ;; print,'  SED+UV-extinction:                    dustem_show_fortran,path,show=''extuv'' '
    ;; print,'  SED+IR extinction+size dist.:         dustem_show_fortran,path,show=[''extir'',''sdist''] '
    ;; print,'  ps files with default names:          dustem_show_fortran,path,show=[''extir'',''alb''],/hard '
    ;; print,'  ps files with given names:            dustem_show_fortran,path,show=[''extir'',''sdist''],hard=[''f1.ps'',''f2.ps''] '
    ;; print,'  no plot :                             dustem_show_fortran,path,show=0'
    ;; print,'  to get band fluxes in structure SM:   dustem_show_fortran,path,smdat=sm'

    ;; print,'  see structure SM (overall):           help,/str,sm'
    ;; print,'  see structure SM model field:         help,/str,sm.m_emis'
    ;; print,'  see structure SM inst field:          help,/str,sm.i_dirbe'
    ;; print,'  see structure SM inst flux field:     help,/str,sm.i_dirbe.flx'
    ;; print,'                                        array(i,j+1) i:index of inst band, j:index of grain type (ntype+1 is total SED) '

    ;; print,'  to select or add instrument field(s): dustem_show_fortran,path,smdat=sm,inst=[''spire'']  (on existing SM to add instrumentx) '

;

; MODIFICATION HISTORY:

;    Inherited from DustEM fortran repo, July 2022. 

;    Written by L Verstraete and M Compiegne, Spring 2010
;    Modified by LV : change to cgs, add band fluxes in SMDAT, 2011
;    Modified by LV & V Guillet : add polarization part, 2017
;    Further evolution details on the DustEMWrap gitlab.
;    See http://dustemwrap.irap.omp.eu/ for FAQ and help.  

;    

  
if keyword_set(help) then begin 
  doc_library,'dustem_show_fortran'
  goto,the_end
END

; specify the grain model
IF keyword_set(model) THEN BEGIN
  use_model=strupcase(model)
ENDIF ELSE BEGIN
  use_model='MC10'    ;Default is the Compiegne et al 2010 model
ENDELSE

; run the fortran via the wrapper once

if keyword_set(restart) then begin
   dustem_init,model=use_model
   st_model=dustem_read_all(!dustem_soft_dir) 
   dustem_write_all,st_model,!dustem_dat
   st=dustem_run()
endif

data_path = !dustem_wrap_soft_dir+'/Data/'
fortran_path = !dustem_dat
if keyword_set(dustem_data_dir) then fortran_path = dustem_data_dir
if keyword_set(data_dir) then data_path = data_dir

 if n_elements(NH) EQ 0 then nh = 1.d20 
 if n_elements(INST) EQ 0 then begin 
    inst = ['DIRBE','FIRAS','HFI','WMAP']
 endif else begin 
    inst = strupcase(inst)
    inst = inst(UNIQ(inst, SORT(inst)))
 endelse
 n_inst = n_elements(inst)
 if n_elements(WREF) EQ 0 then wref = 2.5d2
 if n_elements(BBPAR) EQ 0 then BBPAR = [17.75d, 1.8d0] 
 if n_elements(SW) EQ 0 then sw = 0
 if n_elements(TIT) EQ 0 then tit = 'DustEM'
 if n_elements(COM) EQ 0 then com = tit
 if n_elements(WN) EQ 0 then wn = [0, 2, 1, 3, 6, 4, 5, 7, 8, 9, 10, 11, 12, 13] ; absolute display 
 if n_elements( XR ) NE 2 then begin 
    if keyword_set( COSMO ) then xr = [1., 1.e5] else xr = [ 1, 1.e3 ] 
    endif else xr = [min(xr),max(xr)]
 if n_elements( YR ) NE 2 then begin 
    if keyword_set( COSMO ) then yr = [1.e-12, 1.e-3] else yr = [1e-8, 1e-4] 
 endif else yr = [min(yr),max(yr)]

 if n_elements( plottype ) EQ 0 then plottype = 0

 if n_elements( SHOW ) EQ 0 THEN BEGIN 
    show = ['emis'] 
 ENDIF ELSE BEGIN
    show = [STRLOWCASE(STRTRIM(STRING(show),2))]  
    IF SHOW(0) NE '0' THEN BEGIN 
       show = ['emis',show]     ; always show the SED 
       show = show(UNIQ(show))
    ENDIF 
 ENDELSE
 pgrid = [ 'emis', 'extuv', 'extir', 'alb', 'sdist','polext', 'polsed', 'align' ]
 nplots = n_elements( SHOW ) ; nr of plots 
 nhard = n_elements( HARD ) 
 if nhard EQ 0 OR show(0) EQ '0' THEN hard=['0']
 if nhard GT 0 then hard = [STRLOWCASE(STRTRIM(STRING(hard),2))]  
 if  ((nhard GT 0) AND (nhard LT nplots)) OR (hard(0) EQ '1') then begin
    ig = INTARR( nplots )
    for i = 1, nplots-1 do begin
       ig(i) = WHERE( pgrid EQ show(i))
    endfor 
    hard = pgrid(ig(sort(ig))) + REPLICATE('.ps',nplots)
 endif
 hard = strtrim(hard,2)
 nhard = n_elements( HARD )


; constants 
 na = 6.02d23
 clight = 2.9979246d10          ; cm/s

;
; plot inits
;
; set the rgb colors
 red  =[0,1,1,0,0,1]
 green=[0,1,0,1,0,1]
 blue =[0,1,0,0,1,0]
 tvlct,255*red, 255*green, 255*blue 
 ls = [ [ 0,3,1,4,5 ], [ 0,3,1,4,5 ] ]
 ihard = 0

;
; get the SED data
;

; FarIR-mm SED from FBoulanger

 RESTORE, data_path+'/EXAMPLE_OBSDATA/filters_ref_wave.xdr'
 fact_em = 0.77                     ; to account for 20% of H to be in ionized form + 3% H2
 to_sed_20 = 1d-17 * (1d20/1.82d18) ; MJy/sr->erg/s/cm2/sr and normalization to NH = 10^20 H/cm2
 
; FIRAS
 READCOL, data_path+'/EXAMPLE_OBSDATA/diffuse_ISM_SED.dat', wfirasf, firasf, ufirasf, skipline=5, numline=156, /sil
 nufirasf = clight/(wfirasf*1.d-4)
 firasf   = firasf * nufirasf * fact_em * to_sed_20 
 ufirasf  = ufirasf * nufirasf * to_sed_20 ; error

; DIRBE 60 --> 240 microns
 READCOL, data_path+'/EXAMPLE_OBSDATA/diffuse_ISM_SED.dat', wdirbef, dirbef, udirbef, skipline=162, numline=4, /sil
 nudirbef  = clight/ (wdirbef*1.d-4)
 dirbef    = dirbef * nudirbef * fact_em * to_sed_20 
 udirbef   = udirbef * nudirbef * to_sed_20 ; error
 dwdirbef  =   dwdirbe[6:9]/2.

; WMAP
 READCOL,data_path+'/EXAMPLE_OBSDATA/diffuse_ISM_SED.dat', wwmapf, wmapf, uwmapf, skipline=167, numline=5,/sil
 wwmapf = wwmapf[3:4]
 wmapf  = wmapf[3:4]
 uwmapf = uwmapf[3:4] 
 nuwmapf = clight/(wwmapf*1.d-4)
 wmapf   = wmapf * nuwmapf * fact_em * to_sed_20 
 uwmapf  = uwmapf * nuwmapf * to_sed_20 ; error

; DIRBE Arendt et al (1998) for |b|>25
; numbers from Li & Draine, apj, 2001, 554, 778-802
 Wave_ARENDT  = WDIRBE[2:*]
 Dwave_ARENDT = DWDIRBE[2:*] / 2.
 ARENDT       = [0.97, 1.11, 7.16, 3.57, 5.30, 18.6, 22.5, 10.1] ; 10^-26 erg/s/H/sr
 ARENDT = ARENDT * 1.d-26 * 1.d20                                ; To erg s-1 cm-2 sr-1 for NH=10^20 H/cm2
 err_ARENDT = 0.2 * ARENDT                                       ; from Dwek et al. 1997 DIRBE 1Sigma unc = 20%
 nu_arendt = nudirbe[2:*] * 1.e9

; Normalization of the Arendt spectrum on the Boulanger 100 microns
 wave_arendt_midIR  = wave_arendt[0:3]
 dwave_ARENDT_midir = Dwave_ARENDT[0:3]
 nu_arendt_midIR    = nu_arendt[0:3]
 correl_coeff_midIR  = [0.00183, 0.00291, 0.0462, 0.0480]               ; for Inu
 ucorrel_coeff_midIR = [0.00001, 0.00003, 0.0001, 0.0002]               ; For Inu
 arendt_midIR = correl_coeff_midIR * (dirbef[1]*100.*1e-4/clight*1e20)  ; in (Inu) MJy sr-1
 err_arendt_midIR = FLTARR(N_ELEMENTS(arendt_midIR))
 for i=0,3 do begin 
    tmp= SQRT( ((udirbef[1]*100.*1e-4/clight*1e20)/(dirbef[1]*100.*1e-4/clight*1e20))^2. + (ucorrel_coeff_midIR[i]/correl_coeff_midIR[i])^2. )
    err_arendt_midIR[i]  = arendt_midIR[i] * tmp
 endfor
 arendt_midIR = arendt_midIR / wave_arendt_midIR/1e-4*clight/1e20          ; to erg s-1 cm-2 sr-1 
 err_arendt_midIR = err_arendt_midIR / wave_arendt_midIR/1e-4*clight/1e20  ; to erg s-1 cm-2 sr-1 
 wdirbe_ful = [ wave_arendt_midir, wdirbef ]
 dwdirbe_ful = [ dwave_arendt_midir, dwdirbef ]
 dirbe_ful  = [ arendt_midir, dirbef ]
 udirbe_ful = [ err_arendt_midir, udirbef ]

; isocam galactic spectrum
 RESTORE, data_path+'/EXAMPLE_OBSDATA/spectre_gal.xdr'                     ; wgal in microns, spec_gal in MJy/sr
 nuisocam =   clight / wgal/1.d-4
 norm = 0.65*0.045/filters(9)                         ; normalization for Nh=1e20 cm-2 and I12/I100 =0.045 
 iso = 1d-17 * spec_gal*nuisocam * norm               ; galactic mid-IR SED in erg/s/cm2/sr
 stars = 1d3 * wgal * DUSTEM_BLACKBODY(wgal, 3d3, unit='w')  ; assumed spectrum for stars in cgs
 stars = 1.3d-6 * stars/stars(0)                      ; normalization of stellar spectrum
 err_cvf = 0.2 
 isocam   = iso-stars
 smp = DUSTEM_GET_BAND_FLUX( data_path + 'FILTERS/', 'DIRBE', xs=wgal, ys=isocam )
 isocam = isocam / smp.i_dirbe.ym(4) * arendt_midIR[2] ; factor is now 1.013027 (1.0235712 before)

; Arome 3.3 microns: Giard et al 1988
 xg = [3.3d]
 yg = 1.1e-6 / 4./!pi * xg/0.05  ; SED erg/s/cm2/sr assumes a feature width of 0.05 mic
 eg = 0.5e-6 / 4./!pi * xg/0.05  ; error

; Modified BB overlaid to dust: default is 17.75 K and beta=1.8  (Miville-Deschênes et al 2013, Planck data)
 np = 1000 
 wbr = ALOG10( [20.,1.d5] )
 dwbr = (wbr(1)-wbr(0)) / (np-1)
 lambdaf = 10.^(wbr(0) + findgen(np)*dwbr)
 temp1 = bbpar(0)
 beta = bbpar(1)
 lamb_ref = 250.
 qf = (lambdaf/ lamb_ref)^(-beta)
 bbm = 1d3 * lambdaf * DUSTEM_BLACKBODY(lambdaf, temp1, unit='w')
 SP1 = bbm*qf
 firas_nuinu = firasf 
; normalize to FIRAS @ wave WREF < wfiras_max and get dust cross-section per H
 wfiras_max = 8d2
 if WREF LE wfiras_max then lamb_ref = wref 
 tt = MIN( ABS(lambdaf-lamb_ref), ibb )
 tt = MIN( ABS(wfirasf-lamb_ref), ifiras )
 nw = 1
 eps_firas = median(firasf(ifiras-nw:ifiras+nw)) / INTERPOL(sp1/qf, lambdaf, lamb_ref) / nh
 SP1 = SP1 * median(firasf(ifiras-nw:ifiras+nw)) / INTERPOL(sp1, lambdaf, lamb_ref)

; add HFI (Planck2011t, Dust in the diffuse interstellar medium and the Galactic halo)
 nu_pep_dism = [5d3,3d3,857.,545.,353.] * 1d9 ; includes IRAS60 and 100
 w_pep_dism = 1d4*clight / nu_pep_dism
 dw_pep_dism = dblarr(n_elements(nu_pep_dism))
 dw_pep_dism(0:1) = [31.,35.6] / 2.
 dw_pep_dism(2:*) = w_pep_dism(2:*)/3. / 2.
 y_pep_dism = [ 1.288, 6.522,5.624, 1.905, 0.465 ] * 1d-1  ; MJy/sr/1e20cm-2 
 u_pep_dism = [ 0.436, 1.473, 1.015, 0.347, 0.100 ] * 1d-1
 y_pep_dism = fact_em * y_pep_dism * nu_pep_dism * 1d-17 ; MJy/sr/1e20cm-2 to erg/s/cm2/sr
 u_pep_dism = fact_em * u_pep_dism * nu_pep_dism * 1d-17
 y_hfi_dism = y_pep_dism(0:2) & u_hfi_dism = u_pep_dism(0:2)

; add cosmosomas
 IF keyword_set( COSMO ) then begin 
; Watson et al 2005
;    nu=1.e9*[ 0.408, 1.42, 10.9, 12.7, 14.7, 16.3, 22.8, 33.0, 40.9, 61.3, 93.8, 1250, 2143., 3.e3 ]
;    i_jy=[6.3,7.3,17.,18.7,26.2,32.6,42.3,40.3,33.9,34.7,77.5,9.68e4,1.31e5,6.44e4 ]
;    e_jy=[7.8,2.,0.1,0.4,0.6,1.5,0.2,0.4,0.7,1.8,4.3,7d2,1.25d3,100.] 
;    beam = 4.9e-4               ; steradians
;    lref = 140d                 ; wave for normalization

; nu in GHz and i_jy in Janskys
; Planck 2011p, "New light on anomalous microwave emission from spinning dust grains"
    nu=[0.408,0.82,1.42,10.9,12.7,14.7,16.3,22.8,28.5,33.0,40.9,44.1,61.3,70.3,93.8,100.,143.,217.,353.,545.,857.,1250,2143.,3.e3]
    iplck = where( (nu eq 33.) or (nu eq 40.9) or (nu eq 70.3) or (nu eq 100.) or (nu eq 143.) or (nu eq 217.) )
    nu=1d9*[0.408,0.82,1.42,10.9,12.7,14.7,16.3,22.8,28.5,33.0,40.9,44.1,61.3,70.3,93.8,100.,143.,217.,353.,545.,857.,1250,2143.,3.e3]
    i_jy=[9.7,9.4,8.0,16.1,20.,28.4,35.8,39.8,38.1,36.7,30.8,28.5,27.4,32.2,63.,78.4,202.,1050.,3060.,1.53d4,4.87d4,9.3d4,1.17d5,5.36d4]
    e_jy=[3.3,4.7,1.7,1.8,2.2,3.1,4.,4.2,4.,3.9,3.3,3.2,3.4,3.9,7.8,15.4,22.,128.,467.,2.09d3,6.11d3,1.29d4,1.45d4,6.67d3] 
    fwhm = 1.81d
    beam = !pi*(!pi/1.8d2 * fwhm/2d0)^2 ; steradians
    lref = 140d                         ; wave for normalization

    x_pep_ame = 1d4*clight/nu
    nc = n_elements(x_pep_ame)
    y_pep_ame = 1.e-23 * nu * i_jy / beam
    e_pep_ame = 1.e-23 * nu * e_jy / beam
    lref = 240d
    iref = WHERE( wdirbe_ful EQ lref, cr)
    if cr EQ 1 then begin
       yic = INTERPOL(y_pep_ame,x_pep_ame,wdirbe_ful[iref])
       y_norm = dirbe_ful[iref]/yic
       y_norm = y_norm[0]
    endif else y_norm = 1d
    is = WHERE( x_pep_ame/lref GE 0.9, cs)
    x_pep_ame=x_pep_ame(is) & y_pep_ame=y_pep_ame(is)*y_norm & e_pep_ame=e_pep_ame(is)*y_norm
 ENDIF

;
; plot SED data
;
 IF SHOW(0) NE '0' THEN BEGIN
    if HARD(0) NE '0' then begin 
       !y.thick = 5
       !x.thick = 5
       !p.thick = 5
       !p.charsize = 1.3
       !p.charthick = 5
       !x.ticklen = 0.04
       set_plot,'ps'
;       device,file=hard(0),xs=26, ys=20,/portrait,/color

       device,file="emis.ps",/portrait,/color

       ihard = ihard + 1

    endif else begin
       cleanplot

       window, wn(0), xs=900,ys=600,tit='DUSTEM_SHOW_FORTRAN: SED '+strtrim(wn(0),2)

    endelse

    xtit = 'Wavelength (!4l!3m)'
    ytit = '!4m!3 I!d!4m!3!n (erg s!u-1!n cm!u-2!n sr!u-1!n)'
    fine = 1
;    plot_oo, INDGEN(1),/NODAT,/xs,/ys,XR=xr,YR=yr,XTIT=xtit,YTIT= ytit,tit=tit 

    cgplot, INDGEN(1),/NODAT,/xs,/ys,/xlo,/ylo,XR=xr,YR=yr,XTIT=xtit,YTIT= ytit,tit=tit+" SED",color=cgcolor('black')
;    axis, /data, xr=1d-5*clight/xr, xax=1,/xlo,xs=1,xtit='Frequency (GHz)',color=cgcolor('black'),ticksize_font=1.5

    if plottype NE 0 then begin 

       if HARD(0) NE '0' then begin 
          oploterror,xg,yg,0.,eg,psym=5
          oploterror, wfirasf, firasf, wfirasf*0d, ufirasf, errthick=0.7, /nohat
          oploterror, wdirbe_ful(0:3), dirbe_ful(0:3), dwdirbe_ful(0:3), udirbe_ful(0:3), psym=6
          oploterror, wdirbe_ful(6:*), dirbe_ful(6:*), dwdirbe_ful(6:*), udirbe_ful(6:*), psym=6
;          oploterror, wdirbe_ful, dirbe_ful, dwdirbe_ful, udirbe_ful, psym=6
          oploterror, wgal,isocam, wgal*0d, isocam*err_cvf, errthick=0.7, /nohat
          oploterror, wwmapf, wmapf, wwmapf*0d, uwmapf, psym=4
          oploterror, w_pep_dism, y_pep_dism, dw_pep_dism, u_pep_dism, psym=5
       endif else begin
          oploterror,xg,yg,0.,eg,psym=5
          oploterror, wfirasf, firasf, wfirasf*0d, ufirasf, errthick=0.4, /nohat
          oploterror, wdirbe_ful(0:3), dirbe_ful(0:3), dwdirbe_ful(0:3), udirbe_ful(0:3), psym=6
          oploterror, wdirbe_ful(6:*), dirbe_ful(6:*), dwdirbe_ful(6:*), udirbe_ful(6:*), psym=6
;          oploterror, wdirbe_ful, dirbe_ful, dwdirbe_ful, udirbe_ful, psym=6
          oploterror, wgal,isocam, wgal*0d, isocam*err_cvf, errthick=0.4, /nohat
          oploterror, wwmapf, wmapf, wwmapf*0d, uwmapf, psym=4
          oploterror, w_pep_dism, y_pep_dism, dw_pep_dism, u_pep_dism, psym=5
       endelse
    endif

    if plottype EQ 1 then begin

       OPLOT, LAMBDAf, SP1, lines=1,color=cgcolor('black') ; FIR blackbody

       sp1_firas = INTERPOL( sp1, lambdaf, wfirasf )
       firas_chi2 = DUSTEM_CHI2( firasf, sp1_firas, 3, err=ufirasf )
       print,'Grey body: Td = ',strtrim(bbpar(0),2),' and beta = ',strtrim(bbpar(1),2)
       print,'Chi-squared of grey body to FIRAS: ', strtrim(firas_chi2,2)
    endif
    if keyword_set( CMB ) then begin 
       lambda_cmb = 1.d2^( 1.d0 + dindgen(500)*0.01 )
       sp_cmb = 1d3 * lambda_cmb * DUSTEM_BLACKBODY(LAMBDA_CMB, 2.728, unit='w') ; SED in erg/s/cm2/s/sr

       OPLOT, LAMBDA_CMB, SP_CMB, color=cgcolor('black'),lines=0                                 ; CMB

    endif

    if keyword_set( COSMO ) AND plottype NE 0 then begin 

       oploterror, x_pep_ame, y_pep_ame, y_pep_ame*0d, e_pep_ame, ps=4
;       oploterror, x_pep_ame(iplck), y_pep_ame(iplck), y_pep_ame(iplck)*0d, e_pep_ame(iplck), ps=5, syms=1.5, col=3
    endif
 ENDIF

;
; get the model SED
;
 fname = fortran_path + 'data/GRAIN.DAT'
 nlines = FILE_LINES( fname )
 OPENR, uu, fname, /get_lun
 tmp = '#'
 print,'(W) DUSTEM_SHOW_FORTRAN: GRAIN.DAT'
 cnt = 0
 WHILE STRPOS(tmp,'#') EQ 0 do begin
    READF, uu, tmp
    cnt = cnt + 1
 ENDWHILE
 r_opt = STRLOWCASE(STRTRIM(STRING(tmp),2))
 print,r_opt
 READF, uu, g0
 ntype = nlines - (cnt+1)
 nsize=intarr(ntype)
 t_opt=strarr(ntype)
 gtype = strarr(ntype)
 propm = dblarr(ntype)
 rho = dblarr(ntype)
 for i=0,ntype-1 do begin 
    READF,uu,tmp
    PRINT, tmp
    tt = strsplit(tmp, /extract)
    gtype(i) = strtrim(tt(0))
    nsize(i)=fix(tt(1))
    t_opt(i)=strlowcase(strtrim(tt(2)))
    propm(i) = double(tt(3))
    rho(i) = double(tt(4))
 endfor
 close,uu
 free_lun,uu
 nsz_max = MAX(nsize)

 IF n_elements(FSED) EQ 0 THEN fsed = fortran_path+'out/SED.RES'
 OPENR, uu, fsed, /get_lun
 tmp = '#'
 WHILE (STRPOS(tmp,'#') EQ 0) do begin
    READF, uu, tmp
 ENDWHILE
 tt = double( strsplit(tmp, ' ', /extract) )
 ntype_sed = fix(tt(0))
 if ntype_sed NE ntype then begin
    print,'(F) DUSTEM_SHOW_FORTRAN: SED.RES & GRAIN.DAT have different NTYPE'
    print,'                 data is not from present GRAIN.DAT'
    return
 endif
 nlamb = fix(tt(1)) ; nr of wavelengths
 x = dblarr(nlamb)
 sedh = dblarr(nlamb,ntype+1)
 for i=0,nlamb-1 do begin 
    READF, uu, tmp
    tt = double( strsplit(tmp, ' ', /extract) )
    x(i) = tt(0) 
    sedh(i,*) = tt(1:*)
 endfor
 close,uu
 free_lun,uu
 xlamb= x
 sed = sedh * nh / 4. / !pi     ; in erg/s/cm2/sr
 if keyword_set( SW ) then sed = SMOOTH( sed, sw)

 if (plottype NE 1) AND (SHOW(0) NE '0') then begin 

    dy = 10.^((ALOG10(yr(1))-ALOG10(yr(0))) / 25.)
    dx = 10.^((ALOG10(xr(1))-ALOG10(xr(0))) / 50.)
    yps= 10.^((ALOG10(yr(1))+ALOG10(yr(0))) / 2. + (ALOG10(yr(1))-ALOG10(yr(0))) / 2.3)
    if keyword_set(COSMO) then begin
       xpr=10.^((ALOG10(xr(1))+ALOG10(xr(0)))/3.) 
       yps= 10.^((ALOG10(yr(1))+ALOG10(yr(0))) / 2. - (ALOG10(yr(1))-ALOG10(yr(0))) / 4.)
    endif else xpr=xr(0)
    xpr = xpr*[dx,dx^4]
; overlay model SED in erg/s/cm2/sr
    for i=0,ntype-1 do begin

       oplot, x, sed(*,i), lin=ls(i+1),color=cgcolor('black')
       oplot,xpr,yps*[1.,1.], lin=ls(i+1),color=cgcolor('black')
       xyouts,/data,xpr(1)*1.1,yps,gtype(i),chars=1.3,color=cgcolor('black')

       yps = yps/dy
    endfor

    oplot, x, sed(*,ntype),lin=ls(0),col=cgcolor('blue')

    s1 = STRMID(STRTRIM(ROUND(1e1*g0)/1e1,2), 0, 4) 
    s2 = STRMID(STRTRIM(ROUND(1e2*alog10(nh))/1e2,2), 0, 5) 

    xyouts,/norm,0.6,0.85,'G!d0!n='+s1+' N!dH!n=10!u'+s2+'!ncm!u-2!n',color=cgcolor('black'),chars=1.3

; overlay model polarized SED in erg/s/cm2/sr
    ;IF (C_POLSED EQ 1) THEN oplot, x, sed_p(*,ntype),lin=ls(0),col=3
 endif

;
; fill in SMDAT
; 
; first get model fluxes in instrument bands
 unit = 'x(microns) SED(erg/s/cm2/sr)'
 if n_elements(SMDAT) GT 0 then begin
    smdat = DUSTEM_GET_BAND_FLUX( data_path + 'FILTERS/', inst, xs=x, ys=sed, unit=unit, smi=smdat )
 endif else smdat = DUSTEM_GET_BAND_FLUX( data_path + 'FILTERS/', inst, xs=x, ys=sed, unit=unit )
 smdat.com = com
 stag = TAG_NAMES(smdat)
 ;if c_polsed EQ 1 then smdat.m_emis.yp = sed_p

; then get diffuse data available here
 ii = WHERE( inst EQ 'DIRBE', cic)
 if cic GT 0 then begin
    smdat.i_dirbe.unit = smdat.i_dirbe.unit + ' YD(erg/s/cm2/sr)'
    smdat.i_dirbe.yd = [ 0d, 0d, dirbe_ful ]
    smdat.i_dirbe.err = [ 0d, 0d, udirbe_ful]
    nband = n_elements( smdat.i_dirbe.x)
    smdat.i_dirbe.isel = [ 0,0,intarr(nband-2)+1 ]
    smdat.i_dirbe.npar = ntype
 endif
 
 ii = WHERE( inst EQ 'HFI', cic)
 if cic GT 0 then begin 
    smdat.i_hfi.unit = smdat.i_hfi.unit + ' YD(erg/s/cm2/sr)'
    ibx = indgen(3)             ; only 3 first bands in PEP DISM
    smdat.i_hfi.yd(ibx) = y_hfi_dism
    smdat.i_hfi.err(ibx) = u_hfi_dism
    smdat.i_hfi.isel = [1,1,1,0,0,0]
    smdat.i_hfi.npar = 1
 endif
    
 ii = WHERE( inst EQ 'WMAP', cic)
 if cic GT 0 then begin  
    smdat.i_wmap.unit = smdat.i_wmap.unit + ' YD(erg/s/cm2/sr)'
    smdat.i_wmap.yd = [ 0d, 0d, 0d, wmapf ] ; only 61 and 94 GHz bands
    smdat.i_wmap.err = [ 0d, 0d, 0d, uwmapf]
    nband = n_elements( smdat.i_wmap.x)
    smdat.i_wmap.isel = [ 0,0,0,intarr(nband-3)+1 ]
    smdat.i_wmap.npar = 1
 endif
 
; put FIRAS pts in SMDAT
 ii = WHERE( inst EQ 'FIRAS', cic)
 if cic GT 0 then begin  
    nband = n_elements(wfirasf)
    smdat = DUSTEM_ADD_INST( smdat, 'FIRAS', [n_elements(firasf),ntype+1] )
    smdat.i_firas.unit = 'x(microns) YM(erg/s/cm2/sr) FLX(MJy/sr) YD(erg/s/cm2/sr)'
    smdat.i_firas.yd = firasf
    smdat.i_firas.err = ufirasf
    sd_firas = dblarr(n_elements(wfirasf),ntype+1)
    for itp=0,ntype do sd_firas(*,itp) = INTERPOL( sed(*,itp), x, wfirasf )
    smdat.i_firas.ym = sd_firas
    smdat.i_firas.isel = intarr(nband)+1
    smdat.i_firas.npar = 2
 endif
    
; overlay model band fluxes

 if (plottype NE 1) AND (SHOW(0) NE '0') then begin 

    itg = WHERE( STRPOS(stag,'I_') GE 0 AND stag NE 'I_FIRAS', ctg )
; then other instruments
    if ctg GT 0 then begin
       for k=0,ctg-1 do begin

          oplot, smdat.(itg(k)).x, smdat.(itg(k)).ym(*,ntype), ps=6, syms=1.5, col=cgcolor('red')

       endfor
    endif
 endif

;
; get extinction
;
 OPENR, uu, fortran_path+'out/EXT.RES', /get_lun
 tmp = '#'
 WHILE STRPOS(tmp,'#') EQ 0 do begin
    READF, uu, tmp
 ENDWHILE
 tt = double( strsplit(tmp, ' ', /extract) )
 ntype_ext = fix(tt(0))
 if ntype_ext NE ntype then begin
    print,'(F) DUSTEM_SHOW_FORTRAN: EXT.RES & GRAIN.DAT have different NTYPE'
    print,'                 data is not from present GRAIN.DAT'
    return
 endif
 nlamb = fix(tt(1))             ; nr of wavelengths
 x = dblarr(nlamb)
 stmp = dblarr(nlamb,2*ntype+1)
 ssca = dblarr(nlamb,ntype+1)
 sabs = dblarr(nlamb,ntype+1)
 sext = dblarr(nlamb,ntype+1)
 alb = dblarr(nlamb,ntype+1)
 for i=0,nlamb-1 do begin 
    READF, uu, tmp
    tt = double( strsplit(tmp, ' ', /extract) )
    x(i) = tt(0)
    stmp(i,*) = tt(1:*)
 endfor
 CLOSE,uu
 FREE_LUN,uu
 wlm = x
 x = 1. / wlm                   ; 1/micron
 
 mH = 1.67262158d-24            ; proton mass /gdust -> /gH 
 pm = [propm,propm]
 for i=0,ntype-1 do begin 
    sabs(*,i) = stmp(*,i) 
    ssca(*,i) = stmp(*,ntype+i) 
    sext(*,i) = sabs(*,i) + ssca(*,i)
    alb(*,i) = ssca(*,i) / sext(*,i)
 endfor
 for i=0,nlamb-1 do begin 
    sabs(i,ntype) = TOTAL(sabs(i,0:ntype-1))
    ssca(i,ntype) = TOTAL(ssca(i,0:ntype-1))  
    sext(i,ntype) = TOTAL(sext(i,0:ntype-1))  
    alb(i,ntype) = ssca(i,ntype)/sext(i,ntype)
 endfor

; get RV
 av = INTERPOL( sext(*,ntype), wlm, 0.55 )
 ab = INTERPOL( sext(*,ntype), wlm, 0.44 )
 rv = av / (ab-av)

; get 250 microns emissivity
 eps_a = dblarr(ntype+1) & eps_e = eps_a & eps_s = eps_a
 for i = 0,ntype-1 do begin 
    eps_a(i)=INTERPOL(sabs(*,i), wlm, wref)
    eps_s(i)=INTERPOL(ssca(*,i), wlm, wref)
    eps_e(i)=INTERPOL(sext(*,i), wlm, wref)
 endfor
 eps_a(ntype) = INTERPOL(sabs(*,ntype), wlm, wref)
 eps_s(ntype) = INTERPOL(ssca(*,ntype), wlm, wref)
 eps_e(ntype) = INTERPOL(sext(*,ntype), wlm, wref)
 print,'(W) DUSTEM_SHOW_FORTRAN: model dust cross-section @ ',STRTRIM(wref,2),' per type and total (cm2/H)', $
       format='(A44,1E10.3,A27)'
 print, ' Abs : ',eps_a, format='(A8,100(1E12.4))'
 print, ' Sca : ',eps_s, format='(A8,100(1E12.4))'
 print, ' Ext : ',eps_e, format='(A8,100(1E12.4))'
 if WREF GT wfiras_max then begin
    print,'(W) DUSTEM_SHOW_FORTRAN: WREF above longer FIRAS wave, using 250 microns'
    wp = lamb_ref
 endif else wp = wref
 print,'(W) DUSTEM_SHOW_FORTRAN: dust cross-section @ ', STRTRIM(wp,2), ' microns from FIRAS',format='(A38,1E10.3,A20)'
 print,'                 using T = ',bbpar(0), ' and beta = ',bbpar(1),' sigma(cm2/H) = ', eps_firas, $
       format='(A27,1E8.2,A13,1E8.2,A17,1E12.4)'

; fill in model
 it = WHERE( stag EQ 'M_EXT', ct)
 if ct EQ 0 then begin
    smdat = DUSTEM_ADD_MOD( smdat, 'EXT', [n_elements(wlm),ntype+1])
    smdat.m_ext.x = wlm
    smdat.m_ext.y = sext
    smdat.m_ext.abs = sabs
    smdat.m_ext.sca = ssca
    smdat.m_ext.alb = alb
    smdat.m_ext.xr = wref
    smdat.m_ext.yr_abs = eps_a
    smdat.m_ext.yr_sca = eps_s
    smdat.m_ext.rv = rv
 endif
 
; get standard Savage & Mathis 79 + Mathis 1990 extinction and fill in data
 READCOL, data_path+'/EXAMPLE_OBSDATA/mean_ism_ext.dat', skip=3, x_sm, e_sm, /SIL
 it = WHERE( stag EQ 'I_SM79', ct)
 if ct EQ 0 then begin
    smdat = DUSTEM_ADD_INST( smdat, 'SM79', [n_elements(x_sm),ntype+1] )
    smdat.i_sm79.x = x_sm
    smdat.i_sm79.ym = INTERPOL( sext(*,ntype), wlm, x_sm)
    smdat.i_sm79.yd = e_sm
    smdat.i_sm79.err = smdat.i_sm79.yd*0.2
    smdat.i_sm79.unit = 'x(microns) sigma(cm2/H)'
    smdat.i_sm79.npar = ntype
    smdat.i_sm79.isel = intarr(n_elements(x_sm)) + 1
 endif
 
;
; plot the vis-UV extinction
;
 yscl = 1d0
 ip = WHERE( STRPOS(show,'extuv') GE 0, cp )
 IF (SHOW(0) NE '0') AND (CP EQ 1) THEN BEGIN
    if HARD(0) NE '0' then begin 

       device, file="extuv.ps", /portrait,/color

       ihard = ihard + 1
    endif else begin 

       cleanplot

       window, wn(1), xs=600,ys=400, tit='DUSTEM_SHOW_FORTRAN: Extinction UV '+strtrim(wn(1),2)
    endelse 
    xtit = 'x (!4l!3m!u-1!n)'
    xr = [0,11] 
    if n_elements(WEXT) then begin 
       xe = [x,1./wext]
       xe = xe(SORT(XE))
       ei = INTERPOL(sext(*,ntype),x,xe)
       tmp = MIN( ABS(xe - 1./wext),iw  ) 
       yr = minmax( sext(*,ntype)/ei(iw) ) * [1.,1.]
       yscl = 1.d0 / ei(iw)
       ytit='Normalized !4r!3!dext!n '
       print,'(W) DUSTEM_SHOW_FORTRAN: extinction normalized to 1 at ',wext, ' microns yscl=',yscl
    endif else begin
       yr=[ 0, 2.5 ]
       yscl = 1d0
       ytit='!4r!3!dext!n (10!u-21!n cm!u2!n per H)'
    endelse

    cgplot, [1d], [1d], lin=ls(0), xr=xr,/xs,xtit=xtit, yr=yr,/ys,ytit=ytit, tit=tit+" Ext UV",col=cgcolor('black')
    oplot, x, sext(*,ntype)*yscl, lin=ls(0), col=cgcolor('blue')
    oplot, 1d/x_sm, e_sm*1d21*yscl, ps=4,col=cgcolor('red')

;    oploterror, 1d/x_sm, e_sm*1d21, smdat.i_sm79.err*1d21, psym = 4, /nohat

    for i=0,ntype-1 do oplot, x, (sext(*,i))*yscl, lin=ls(i+1),col=cgcolor('black')

    xyouts,/norm,0.2,0.8,'R!dV!n='+STRMID(STRTRIM(ROUND(1e1*rv)/1e1,2), 0, 4)
 ENDIF

; plot IR extinction
 ip = WHERE( STRPOS(show,'extir') GE 0, cp )
 IF (SHOW(0) NE '0') AND (CP EQ 1) THEN BEGIN
    if HARD(0) NE '0' then begin 

       device, file="extir.ps", /portrait,/color

       ihard = ihard + 1
    endif else begin 

       cleanplot

       window, wn(2), xs=600,ys=400, tit='DUSTEM_SHOW_FORTRAN: Extinction IR '+strtrim(wn(2),2)
    endelse 
    xtit = textoidl('\lambda (\mum)')
    xr = [1,400] 
    yr = [1e-6,1.]
    if yscl NE 1d0 THEN ytit='Normalized !4r!3!dext!n' ELSE $
       ytit='!4r!3!dext!n (10!u-21!n cm!u2!n per H)'

;    plot_oo, [1d], [1d], xr=xr,/xs,xtit=xtit, yr=yr,/ys,ytit=ytit, tit=tit 
    cgplot, [1d], [1d], xr=xr,/xs,xtit=xtit, yr=yr,/ys,ytit=ytit, tit=tit+" Ext IR",col=cgcolor('black'),/xlo,/ylo
    oplot, wlm, sext(*,ntype)*yscl, lin=ls(0), col=cgcolor('blue')
    oplot, x_sm, e_sm*1d21*yscl, ps=4,col=cgcolor('red')

;    oploterror, x_sm, e_sm*1d21, smdat.i_sm79.err*1d21, psym = 4, /nohat

    for i=0,ntype-1 do oplot, wlm, sext(*,i)*yscl, lin=ls(i+1),col=cgcolor('black')

    xyouts,/norm,0.8,0.85,'R!dV!n='+STRMID(STRTRIM(ROUND(1e1*rv)/1e1,2), 0, 4)
 ENDIF

;
; and the albedo
;
 ip = WHERE( STRPOS(show,'alb') GE 0, cp )
 IF (SHOW(0) NE '0') AND (CP EQ 1) THEN BEGIN
    if HARD(0) NE '0' then begin 

       device, file="alb.ps", /portrait,/color

       ihard = ihard + 1
    endif else begin 

       cleanplot
       window, wn(3), xs=600,ys=400, tit='DUSTEM_SHOW_FORTRAN: Albedo '+strtrim(wn(3),2)

    endelse 
    xtit = 'x (!4l!3m!u-1!n)'
    xr = [0,11] 
    ytit='Albedo'
    yr=[ 0, 1]

    cgplot, x, alb(*,ntype), xr=xr,/xs,xtit=xtit, yr=yr,/ys,ytit=ytit, tit=tit+" Albedo",/nodata,col=cgcolor('black')
    oplot, x, alb(*,ntype), col=cgcolor('blue')
    for i=0,ntype-1 do oplot, x, alb(*,i), lin=ls(i+1),col=cgcolor('black')

 ENDIF


;
;  get the size distribution and plot
;
 ip = WHERE( STRPOS(show,'sdist') GE 0, cp )
 ir = WHERE( STRPOS(r_opt,'sdist') GE 0, cr )
 IF CR EQ 0 THEN BEGIN 
    cp = 0
    print,'(W) DUSTEM_SHOW_FORTRAN: SDIST keyword not set in current run'
 ENDIF ELSE IF ((SHOW(0) NE '0') AND (CP EQ 1)) THEN BEGIN 
    fn = fortran_path+'out/SDIST.RES'
    OPENR, uu, fn, /get_lun
    tt = '#'
    WHILE STRPOS(tt,'#') EQ 0 do begin
       READF, uu, tt
    ENDWHILE
    ax = dblarr(nsz_max,ntype)
    ava = dblarr(nsz_max,ntype)
    nsz_tot = TOTAL(nsize)
    ava_tot = dblarr(nsz_tot,ntype+1)
    ax_tot = 0d
    FOR i=0,ntype-1 do begin 
       READF,uu,tt
       for is=0,nsize(i)-1 do begin 
          READF, uu, tx, ty
          ax(is,i) = tx
          ava(is,i) = ty
       endfor
       ax_tot =  [ax_tot, ax(0:nsize(i)-1,i)]
    ENDFOR
    close,uu
    free_lun,uu
    ax_tot = ax_tot(1:*)
    ax_tot = ax_tot(SORT(ax_tot))
    FOR i=0,ntype-1 do begin 
       tt = INTERPOL( ava(0:nsize(i)-1,i), ax(0:nsize(i)-1,i), ax_tot )
       ix = WHERE( ax_tot LT MIN(ax(*,i)) OR ax_tot GT MAX(ax(*,i)), cx )
       if cx GT 0 then tt(ix) = 0d ; no extrapolation
       ava_tot(*,i) = tt
    endfor
    for i=0, nsz_tot-1 do ava_tot(i,ntype) = TOTAL( ava_tot(i,0:ntype-1))

; fill in model
    it = WHERE( stag EQ 'M_SDIST', ct)
    if ct EQ 0 then begin
       smdat = DUSTEM_ADD_MOD( smdat, 'SDIST', [nsz_tot,ntype+1,nsz_max])
       smdat.m_sdist.xtot = ax_tot
       smdat.m_sdist.ytot = ava_tot
       smdat.m_sdist.xi = ax
       smdat.m_sdist.yi = ava
    endif
    
    if HARD(0) NE '0' then begin 

       device, file="sdist.ps", /portrait,/color

    endif else begin 

       cleanplot
       window, wn(5), xs=600,ys=400, xpos=0,ypos=0,tit='DUSTEM_SHOW_FORTRAN: Size Distribution '+strtrim(wn(5),2)

    endelse 
    yscl = 1.D29
    xr=[0.1,1e4]
    yr=[-3,3]
    xtit='a (nm)'
    ytit='log( 10!u29!n n!dH!u-1!n a!u4!n dn/da (cm!u3!n/H)) ' 

;    tit='DustEM'
;    plot_oi, ax(0:nsize(0)-1,0)*1.e7, alog10(ava(0:nsize(0)-1,0)*yscl), line=ls(1),xr=xr,/xs,xtit=xtit,/ys,yr=yr,ytit=ytit,tit='DUSTEM'
     cgplot, ax(0:nsize(0)-1,0)*1.e7, alog10(ava(0:nsize(0)-1,0)*yscl), line=ls(1),xr=xr,/xs,xtit=xtit,/ys,yr=yr,ytit=ytit,tit=tit+" Size Dist",col=cgcolor('black'),/xlo

    FOR i=1,ntype-1 DO begin 

       oplot, ax(0:nsize(i)-1,i)*1.e7, alog10(ava(0:nsize(i)-1,i)*yscl), line=ls(i+1),col=cgcolor('black')

    ENDFOR

 ENDIF


; Display polarized SED
;
 ip = WHERE( STRPOS(show,'polsed') GE 0, c_polsed )
 IF (SHOW(0) NE '0') AND (C_POLsed EQ 1) THEN BEGIN 
    if HARD(0) NE '0' then begin 

       device, file="polsed.ps", /portrait,/color

       ihard = ihard + 1
    endif else begin 

       cleanplot

       window, wn(6), xs=600,ys=400, tit='DUSTEM_SHOW_FORTRAN: Polarized SED '+strtrim(wn(6),2)
    endelse 

 ; get polarized SED
    OPENR, uu, fortran_path+'out/SED_POL.RES', /get_lun
    tmp = '#'
    WHILE (STRPOS(tmp,'#') EQ 0) do begin
       READF, uu, tmp
    ENDWHILE
    tt = double( strsplit(tmp, ' ', /extract) )
    sedh_p = dblarr(nlamb,ntype+1)
    for i=0,nlamb-1 do begin 
       readf, uu, tmp
       tt = double( strsplit(tmp, ' ', /extract) )
       sedh_p(i,*) = tt(1:*)
       x(i) = tt(0)
    endfor
    close,uu
    free_lun,uu
    sed_p = sedh_p * nh / 4. / !pi ; in erg/s/cm2/sr

    yr = [1e-10,1e-5]
    xr = [10,1e4]
    dy = 10.^((ALOG10(yr(1))-ALOG10(yr(0))) / 25.)
    dx = 10.^((ALOG10(xr(1))-ALOG10(xr(0))) / 50.)
    yps= 10.^((ALOG10(yr(1))+ALOG10(yr(0))) / 2. + (ALOG10(yr(1))-ALOG10(yr(0))) / 2.3)
    xpr=xr(0)
    xpr = xpr*[dx,dx^4]

    xtit = 'Wavelength (!4l!3m)'
    ytit = '!4m!3 P!d!4m!3!n (erg s!u-1!n cm!u-2!n sr!u-1!n)'
    fine = 1

;    plot_oo, INDGEN(1),/NODAT,xs=9,/ys,XR=xr,YR=yr,XTIT=xtit,YTIT= ytit
    cgplot, INDGEN(1),/NODAT,/xs,/ys,XR=xr,YR=yr,XTIT=xtit,YTIT= ytit,tit=tit+" PolSED",col=cgcolor('black'),/xlo,/ylo
;    axis, /data, xr=1d-5*clight/xr, xax=1,/xlo,xs=1,xtit='Frequency (GHz)',col=cgcolor('black')

    for i=0,ntype-1 do begin

       oplot, x, sed_p(*,i), lin=ls(i+1),col=cgcolor('black')
       oplot,xpr,yps*[1.,1.], lin=ls(i+1),col=cgcolor('black')
       xyouts,/data,xpr(1)*1.1,yps,gtype(i),chars=1.3,col=cgcolor('black')

       yps = yps/dy
    endfor

    oplot,x,sed_p(*,ntype),lin=ls(0),col=cgcolor('blue')

 ENDIF


;
; get the polarisation extinction
;
 ip = WHERE( STRPOS(show,'polext') GE 0, c_polext )
 IF (SHOW(0) NE '0') AND (C_POLEXT EQ 1) THEN BEGIN 

    itp = WHERE( STRPOS(t_opt,'pol') GE 0, ctp)
    IF ctp EQ 0 THEN BEGIN 
       c_pol = 0
       print,'(W) DUSTEM_SHOW_FORTRAN: no POL data in current run'
    ENDIF ELSE BEGIN
       OPENR, uu, fortran_path+'out/EXT_POL.RES', /get_lun
       tmp = '#'
       WHILE STRPOS(tmp,'#') EQ 0 do begin
          READF, uu, tmp
       ENDWHILE
       tt = double( strsplit(tmp, ' ', /extract) )
       ntype_pol = fix(tt(0))
       if ntype_pol NE ntype then begin
          print,'(F) DUSTEM_SHOW_FORTRAN: POL.RES & GRAIN.DAT have different NTYPE'
          print,'                 data is not from present GRAIN.DAT'
          return
       endif
       nlamb = fix(tt(1))       ; nr of wavelengths
       x = dblarr(nlamb)
       spabs = dblarr(nlamb,ntype+1)
       spsca = dblarr(nlamb,ntype+1)
       for i=0,nlamb-1 do begin 
          READF, uu, tmp
          tt = double( strsplit(tmp, ' ', /extract) )
          x(i) = tt(0)
          spabs(i,0:ntype-1) = tt(1:ntype) 
          spsca(i,0:ntype-1) = tt(ntype+1:2*ntype) 
          spabs(i,ntype) = TOTAL(spabs(i,0:ntype-1))
          spsca(i,ntype) = TOTAL(spsca(i,0:ntype-1))
       endfor
       close,uu
       free_lun,uu

; fill in model
       smdat.m_ext.abs_p = spabs
       smdat.m_ext.sca_p = spsca

       if HARD(0) NE '0' then begin 

          device, file="serkowski.ps", /portrait,/color

          ihard = ihard + 1
       endif else begin 

          cleanplot

          window, wn(7), xs=600,ys=400, xpos=0,ypos=0,tit='DUSTEM_SHOW_FORTRAN: Serkowski '+strtrim(wn(7),2)
       endelse 

; plot Serkowski       
       yscl = 1.D23
       yscl2 = 1.D2
       xr=[0.2,10.]
       yr=[0.1,5]
       xtit = textoidl('1/\lambda (\mum^{-1})')
       ytit = textoidl('\sigma_{pol} (10^{-23}cm^2/H)')

;       tit='DUSTEM: Serkowski'
;       plot_oo, 1./x, yscl2*(spabs(*,0)+spsca(*,0)), line=ls(1),xr=xr,/xs,xtit=xtit,/ys,yr=yr,ytit=ytit,tit=tit
       cgplot, 1./x, yscl2*(spabs(*,0)+spsca(*,0)), line=ls(1),xr=xr,/xs $
               ,xtit=xtit,/ys,yr=yr,ytit=ytit,tit=tit+" Serkwoski",col=cgcolor('black'),/xlo,/ylo
       FOR i=1,ntype-1 DO oplot, 1./x, yscl2*(spabs(*,i)+spsca(*,i)), line=ls(i+1),col=cgcolor('black')
       oplot, 1./x, yscl2*(spabs(*,ntype)+spsca(*,ntype)), col=cgcolor('blue')

       ix = WHERE(x_sm LE 7d, csm) ; keep wave below 7 microns
       if csm GT 0 then begin 
          xx = 1./x_sm(ix)
          xe = e_sm(ix) 
       endif
       ix = SORT(xx)
       xx = xx(ix) & xe = xe(ix)
       fpol = DUSTEM_SERKOWSKI(xx)

       oplot,xx,yscl*fpol/5.8e21*3.1,ps=4,col=cgcolor('red')

;       oplot,xx,25*fpol*3.1/5.8e21/xe, ps=5
    ENDELSE

  ENDIF
  
;
;  Polarization fraction in emission
;
 IF (SHOW(0) NE '0') AND (C_POLSED EQ 1) THEN BEGIN 
; plot fractional polarisation       
       if HARD(0) NE '0' then begin 

          device, file="polfrac.ps", /portrait,/color

          ihard = ihard + 1

       endif else begin
          cleanplot

          window, wn(8), xs=600,ys=400, xpos=0,ypos=0,tit='DUSTEM_SHOW_FORTRAN: P/I '+strtrim(wn(8),2)
       endelse 
       xr=[10,1.e4]
       yr=[0.,0.4]
       xtit = textoidl('\lambda (\mum)')
       ytit = textoidl('P/I')

;       tit=''
;       plot_oi, x, sed_p(*,0)/sed(*,0), line=ls(1),xr=xr,/xs,xtit=xtit,/ys,yr=yr,ytit=ytit,tit=tit
       cgplot, x, sed_p(*,0)/sed(*,0), line=ls(1),xr=xr,/xs,xtit=xtit,/ys,yr=yr,ytit=ytit,tit=tit+ "PolFrac",/xlo
;       axis, /data, xr=1d-5*clight/xr, xax=1,/xlo,xs=1,xtit='Frequency (GHz)'

       FOR i=1,ntype-1 DO begin 

          oplot, x, sed_p(*,i)/sed(*,i), line=ls(i+1),col=cgcolor('black')

       ENDFOR

       oplot, x, sed_p(*,ntype)/sed(*,ntype),col=cgcolor('blue')

 ENDIF

;
;  Polarization fraction in extinction
;
 IF (SHOW(0) NE '0') AND (C_POLEXT EQ 1) THEN BEGIN 
; plot fractional polarisation       
       if HARD(0) NE '0' then begin 

          device, file="polext.ps", /portrait,/color

          ihard = ihard + 1

       endif else begin
          cleanplot

          window, wn(9), xs=600,ys=400, xpos=0,ypos=0,tit='DUSTEM_SHOW_FORTRAN: p/tau '+strtrim(wn(9),2)
       endelse 
       yscl = 1.
       xr=[1.e-1,1.e4]
       yr=[0.,0.5]
       xtit = textoidl('\lambda (\mum)')
       ytit = textoidl('p/\tau')

;       tit=''
;       plot_oi, x, yscl*(spabs(*,0)+spsca(*,0))/sext(*,0), line=ls(1),xr=xr,/xs,xtit=xtit,/ys,yr=yr,ytit=ytit,tit=tit
       cgplot, x, yscl*(spabs(*,0)+spsca(*,0))/sext(*,0), line=ls(1),xr=xr,/xs,xtit=xtit,/ys,yr=yr,ytit=ytit,tit=tit+" Pol Ext",/xlo

       FOR i=1,ntype-1 DO begin 

          oplot, x, yscl*(spabs(*,i)+spsca(*,i))/sext(*,i), line=ls(i+1), col=cgcolor('black')

       ENDFOR

       oplot, x, yscl*(spabs(*,ntype)+spsca(*,ntype))/sext(*,ntype), col=cgcolor('blue')

 ENDIF

;
; Alignment function
;
 ip = WHERE( STRPOS(show,'align') GE 0, c_align )
 IF (SHOW(0) NE '0') AND (C_ALIGN EQ 1) THEN BEGIN 
    fname = fortran_path + 'data/ALIGN.DAT'
    nlines = FILE_LINES( fname )
    OPENR, uu, fname, /get_lun
    tmp = '#'
    print,'(W) DUSTEM_SHOW_FORTRAN: GRAIN.DAT'
    cnt = 0
    WHILE STRPOS(tmp,'#') EQ 0 do begin
       READF, uu, tmp
       cnt = cnt + 1
    ENDWHILE
    flags = tmp
    readf, uu, anisG0
   
    if HARD(0) NE '0' then begin 

          device, file="align.ps", /portrait,/color

          ihard = ihard + 1

       endif else begin
          cleanplot

          window, wn(10), xs=600,ys=400, xpos=0,ypos=0,tit='DUSTEM_SHOW_FORTRAN: f_align '+strtrim(wn(10),2)
    endelse 

    ; Parametric 
    readf, uu, tmp
    tt = strsplit(tmp, /extract)
    align_type = tt(0)
    if (align_type eq 'par') then begin
       athresh = tt(1)
       pstiff = tt(2)
       plev = tt(3)
       n = 100
       ; Grain radius in microns
       radmin = 1d-3
       radmax = 10
       radius = radmin * exp(indgen(n)*alog(radmax/radmin)/n)
       fpol = 0.5 * plev * (1 + TANH(ALOG(radius/athresh) / pstiff ) )
       xr=[radmin,radmax]
       yr = [0,1.05]
       xtit=textoidl('Grain radius (\mum)')
       ytit='Alignment efficiency'

;       plot_oi,radius,fpol,xr=xr,yr=yr,/ys,xtit=xtit,ytit=ytit
        cgplot,radius,fpol,xr=xr,yr=yr,/ys,xtit=xtit,ytit=ytit,tit=tit+" Align Eff",/xlo

    endif
       
 ENDIF


; get all the chi2
 if n_elements(smdat) EQ 0 then npar = ntype
 smdat = DUSTEM_FIL_CHI2( smdat,ntype=ntype+1 ) 
 stag = TAG_NAMES(smdat)
 itx = WHERE( STRPOS(stag,'I_') GE 0, ctx )
 print,'Chi-square of model to :'
 for ii=0,ctx-1 do print,stag(itx(ii))+': ', strtrim(smdat.(itx(ii)).chi2,2)
 print,'Chi-square of model to all data : ', strtrim(smdat.chi2,2)

;
; reset defaults
;
 !x.tickname = ''
 !y.tickname = ''

 if HARD(0) NE '0' then begin
   device, /close
   set_plot,'x'

;   print,'(W): hardcopies in ',hard
   print,'(W): Generated postscript files in current directory'

   !y.thick = 0
   !x.thick = 0
   !p.thick = 0
   !p.charsize = 1
   !p.charthick = 0
   !x.ticklen = 0.02
 endif

 RETURN
 the_end:
 END