Blame view

src/idl/dustem_create_rfield.pro 5.19 KB
ad743c1b   Annie Hughes   made function cal...
1
FUNCTION DUSTEM_CREATE_RFIELD, temp, x=x, isrf=isrf, wdil=wdil, wcut=wcut, g0=g0, chi=chi, fname=fname, help=help
52a3cc37   Annie Hughes   First commit of I...
2

ad743c1b   Annie Hughes   made function cal...
3
  if N_PARAMS() LT 1 or keyword_set(help) then begin 
52a3cc37   Annie Hughes   First commit of I...
4
     print,'------------------------------------------------------------------------------------------------------'
ad743c1b   Annie Hughes   made function cal...
5
     print,'FUNCTION DUSTEM_CREATE_RFIELD, temp, x=x, isrf=isrf, wdil=wdil, wcut=wcut, g0=g0, chi=chi, fname=fname'
52a3cc37   Annie Hughes   First commit of I...
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
     print,'------------------------------------------------------------------------------------------------------'
     print,''
     print,' generates the radiation field for DUSTEM (ISRF.DAT)'
     print,' in erg/cm2/s/Hz (4*!pi*I_nu)'
     print,' RFIELD = ISRF + WDIL*PI*BB(TEMP) '
     print,' ISRF from Mathis et al. 1983, A&A 128, 212'
     print,' NB: if blackbody is isotropic set WDIL to 4 (to get 4*!pi factor)'
     print,''  
     print,' TEMP (I): blackbody temperature (can be an array). If 0 only ISRF.'
     print,' X    (I): X-grid for the ISRF in microns. Default is 200 pts over 0.01-10^5 microns.'
     print,'           (including WCUT point). You want to include WCUT for accurate edges.'
     print,' ISRF (I): if set to 0 no ISRF is added, 1 is Mathis (default), 2 is Habing'
     print,' WDIL (I): blackbody dilution factor (can be an array)'
     print,' FNAME(I): filename for ISRF.DAT'
     print,' WCUT (I): for wave < wcut radiation field is 0 '
     print,' G0   (O): factor flux(6-13.6eV) wrt. Mathis field '
     print,' CHI  (O): scaling factor at 100nm wrt. Mathis field'
     print,''
ad743c1b   Annie Hughes   made function cal...
24
     print,'Example: tt = dustem_create_rfield([2d4,5d4],wdil=[1.d-14,1.d-16],x=x,fname=''ISRF.DAT'')'
52a3cc37   Annie Hughes   First commit of I...
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
     print,''
     print,' Created Aug. 2009, L. Verstraete, IAS'
     print,' Force the WCUT point, May 2011, LV'
     print,''
     print,'------------------------------------------------------------------------------------------------------'
     RETURN,0
  endif

; inits 
  unit='W'
  ly_limit =  9.11267101235d-2
  xi = [ ly_limit, 2.07d-1 ] ; for G0 6-13.6 eV in microns
  x1 = 1.d-1 ; for CHI

  if n_elements(WCUT) EQ 0 then wcut=ly_limit  
  if n_elements(x) EQ 0 then begin
     nx = 199
     xb = [ 1.d-2, 1.d5 ] ; wave boundaries in microns
     dx = (alog(xb(1))-alog(xb(0))) / (nx-1)
     x = alog(xb(0)) + dindgen(nx)*dx
     x = exp(x)
     x = [x, wcut] ; add wcut to avoid coarse edge
     x = x(UNIQ(x,SORT(x)))
     nx = n_elements(x)
     if x(nx-1) NE xb(1) then x(nx-1)=xb(1) ; check rounding
  endif else begin
ad743c1b   Annie Hughes   made function cal...
51
     print,'(W) DUSTEM_CREATE-RFIELD : using input wave x'
52a3cc37   Annie Hughes   First commit of I...
52
53
54
55
     x = double(x)
     nx = n_elements(x)
     ix = WHERE( ABS(x-wcut)/x LE 0.01, cx )
     if cx EQ 0 then begin
ad743c1b   Annie Hughes   made function cal...
56
        print,'(W) DUSTEM_CREATE_RFIELD: your x-grid does not contain wcut.'
52a3cc37   Annie Hughes   First commit of I...
57
58
59
60
61
62
        print,'                   Should be included if radiation is 0 below wcut.'
     endif 
  endelse

  rfield = dblarr(nx)
; get Habing for normalization
ad743c1b   Annie Hughes   made function cal...
63
  rhabing = DUSTEM_HABING_FIELD(x,unit=unit)
52a3cc37   Annie Hughes   First commit of I...
64
65
66
  rhabing =  1.d3*x*rhabing/3.d14 ; erg/cm2/s/Hz

; get isrf
ad743c1b   Annie Hughes   made function cal...
67
  rmathis = DUSTEM_MATHIS_FIELD(x,unit=unit)
52a3cc37   Annie Hughes   First commit of I...
68
69
70
71
  rmathis =  1.d3*x*rmathis/3.d14 ; erg/cm2/s/Hz

  if n_elements(ISRF) EQ 0 then ISRF=1
  if ISRF EQ 1 then begin 
ad743c1b   Annie Hughes   made function cal...
72
     print,'(W) DUSTEM_CREATE_RFIELD : adding Mathis ISRF'
52a3cc37   Annie Hughes   First commit of I...
73
74
     rfield = rmathis
  endif else if ISRF EQ 2 then begin 
ad743c1b   Annie Hughes   made function cal...
75
     print,'(W) DUSTEM_CREATE_RFIELD : adding Habing ISRF'
52a3cc37   Annie Hughes   First commit of I...
76
77
78
79
80
81
     rfield = rhabing
  endif

; get blackbody  
  ntemp = n_elements(TEMP)
  if ntemp GT 0 then begin 
ad743c1b   Annie Hughes   made function cal...
82
     bb = DUSTEM_BLACKBODY( x, temp, unit=unit, wdil=wdil )
52a3cc37   Annie Hughes   First commit of I...
83
     bb = bb * 1.d3 * !pi * x^2 / 3.d14   ; erg/cm2/s/Hz
ad743c1b   Annie Hughes   made function cal...
84
     print,'(W) DUSTEM_CREATE_RFIELD : adding BB with T= ',temp, format='(A38,10(1E10.4,1x))'
52a3cc37   Annie Hughes   First commit of I...
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
     print,'                dilution factor wdil= ',wdil, format='(A38,10(1E10.4,1x))'
  endif else bb=0.D0
  rfield = rfield + bb

; apply cut
  ix = WHERE( x LT WCUT, cx )
  if cx GT 0 then rfield(ix)=0.d0

; get G0
 ig = where( x GE xi(0) AND x LE xi(1), cg)
 if cg GT 0 then begin
    xx=x(ig)
    yy=rfield(ig)
    rr=rmathis(ig)
    s1 = TOTAL( (yy(1:cg-1)+yy(0:cg-2))*(xx(1:cg-1)-xx(0:cg-2))/2.D0 )
    s2 = TOTAL( (rr(1:cg-1)+rr(0:cg-2))*(xx(1:cg-1)-xx(0:cg-2))/2.D0 )
    g0 = s1/s2
 endif else g0 = 0.d0
ad743c1b   Annie Hughes   made function cal...
103
 print,'(W) DUSTEM_CREATE_RFIELD : G0 =',g0
52a3cc37   Annie Hughes   First commit of I...
104
105
106
107
108
109
110
111
112

; get chi
 ig = where( abs(2.*(x-x1)/(x+x1)) LE 1.d-1, cg) 
 if cg GT 0 then begin 
   tmp = min( abs(x(ig)-x1), i_min )   
   ig = ig(i_min)
   ig = ig(0)
   chi = rfield(ig) / rmathis(ig)  
 endif else chi = 0
ad743c1b   Annie Hughes   made function cal...
113
 print,'(W) DUSTEM_CREATE_RFIELD : chi =',chi
52a3cc37   Annie Hughes   First commit of I...
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136

; write file
 if n_elements(FNAME) NE 0 then begin
   OPENW, iu, fname, /get_lun
   printf, iu, '# DUSTEM: exciting radiation field featuring '
   if ISRF EQ 1 then printf, iu, '# Mathis ISRF'
   if NTEMP GT 0 then begin 
      a =  '# Blackbody with     T='
      a1 = '# dilution factor wdil='
      for i = 0, ntemp - 1 do begin
         a = a   + string( format='(2x,1E11.4)', temp(i) )
         a1 = a1 + string( format='(2x,1E11.4)', wdil(i) )
      endfor
      printf, iu, a
      printf, iu, a1
   endif
   printf, iu, '# Nbr of points'
   printf, iu, '# wave (microns), 4*pi*Inu (erg/cm2/s/Hz)'
   printf, iu, nx, format='(i4)'
   for i=0,nx-1 do begin 
    printf, iu, x(i), rfield(i), format='(2(1E13.6,2x))'
   endfor
   FREE_LUN, iu
ad743c1b   Annie Hughes   made function cal...
137
   print,'(W) DUSTEM_CREATE_RFIELD: radiation field written in ', strtrim(fname,2)
52a3cc37   Annie Hughes   First commit of I...
138
139
140
141
 ENDIF

 RETURN, RFIELD
END