Viewing contents of file '../idllib/astron/contrib/varosi/code/allpro/build_bb_trans.pro'
;+
; NAME:
; Build_BB_Trans
; PURPOSE:
; Build the array of bound-bound transitions between selected Levels,
; between selected single energy Levels and SuperLevels,
; and between all SuperLevel combinations.
; CALLING:
; Build_BB_Trans
;
; INPUTS:
; All thru common blocks in file: ~/modion/code/modion_common.pro
;
; ELevs = array of structures with tags for energy of level,
; quantum numbers, graphics Locations, etc.
;
; Rad_Trans = array of structures, radiative transitions, with tags for
; levels, oscillator strength (gf), quantum numbers, etc.
;
; SupLevs = array of SuperLevel structures with tags for
; average energy, effective temperature, etc.
;
; OUTPUT (common block):
;
; BB_Trans = array of structures, the calculated bound-bound transitions,
; with tags for "gf" values, wavelengths, quantum numbers, etc.
; (see code below for complete structure).
; COMMON BLOCKS:
; common Build_BB_Trans, bbTran (structure template)
; common Build_BB_Tran1, Line_Styles, Line_Thicks (options)
; and see file: ~/modion/code/modion_common.pro
; EXTERNAL CALLS:
; function Allowed_Trans
; function N_struct
; function Fsort
; function fosc_approx
; pro match
; PROCEDURE:
; Loop over the selected Levels and find out which combinations
; are allowed, then get the gf values for those allowed transitions.
; For the case of SuperLevels (energy Levels in groups) process all
; transitions between the energy Levels to get the needed "gf" values
; and then add up "gf" for each SuperLevel group, creating a new set
; of transitions involving SuperLevels, keeping only those single
; energy Levels transitions that are not any SuperLevel group.
; HISTORY:
; Written: Frank Varosi NASA/GSFC 1994.
; F.V. 1995, vectorized using function Allowed_Trans.
; F.V. 1995, added computation of SuperLevel transitions.
; F.V. 1995, further vectorized using pro match.
;-
pro Build_BB_Trans
@modion_common
common Build_BB_Trans, bbTran
common Build_BB_Tran1, Line_Styles, Line_Thicks
if N_elements( Line_Styles ) NE 3 then Line_Styles = [0,2,1]
if N_elements( Line_Thicks ) NE 3 then Line_Thicks = [1,1,1]
if N_struct( bbTran ) NE 1 then begin
bbTran = { nz:0, $;atomic number
nel:0, $;number of electrons
slp:intarr(2), $;(Low,up) quantum numbers.
ilv:intarr(2), $;(Low,up) Level indices.
gf:0.0, $;oscillator strength of trans.
wavel:0.0, $;wavelength in Angstroms.
allowed:0b, $;flag for allowed transition.
approx:0b, $;flag for GF approximation.
gwij:intarr(2), $;(Low,up) statistical wieghts.
Eij:fltarr(2), $;(Low,up) energies.
Nij:fltarr(2), $;(Low,up) main q.nums.
Gij:intarr(2), $;(Low,up) group #s.
Loci:intarr(2), $;graphic (x,y) Location (Low)
Locj:intarr(2), $;graphic (x,y) Location (up)
LineStyle:0b, $
LineThick:0b, $
color: 0 }
endif
if (N_struct( ELevs ) LE 0) OR (N_struct( Rad_Trans ) LE 0) then return
BELL = string(7b)
if (Rad_Trans(0).nz NE ELevs(0).nz) OR $
(Rad_Trans(0).nel NE ELevs(0).nel) then begin
BB_Trans = 0
Modion_Status,/BELL, $
"transition gf data is not for the current atom/ion"
return
endif
Lsel = where( ( ELevs.Sel OR (ELevs.group GT 0) ) AND $
NOT (ELevs.group LT 0), nsel )
if (nsel LT 2) then begin
BB_Trans = 0
Modion_Status,"need more than 2 Levels for transitions",/BELL
return
endif
ELvs = ELevs(Lsel)
so = sort( ELvs.gw )
ELvs = ELvs( so( Fsort( ELvs(so).E ) ) )
;Form big structured array with all transitions:
Nbbtr = nsel * (nsel-1) /2
bbTran.nz = ELevs(0).nz
bbTran.nel = ELevs(0).nel
BB_Trans = replicate( bbTran, Nbbtr )
itr = 0L
for i=0,nsel-2 do begin
ntran = nsel-i-1
bbT = replicate( bbTran, ntran )
Ei = ELvs(i).E
bbT.Eij(0) = Ei
bbT.slp(0) = ELvs(i).islp
bbT.ilv(0) = ELvs(i).ilv
bbT.Nij(0) = ELvs(i).N
bbT.Gij(0) = ELvs(i).group
bbT.gwij(0) = ELvs(i).gw
wj = i+1 + indgen( ntran )
Ej = ELvs(wj).E
bbT.wavel = 1e8/( abs( Ei - Ej ) > 1e-9 )
bbT.Eij(1) = Ej
bbT.slp(1) = ELvs(wj).islp
bbT.ilv(1) = ELvs(wj).ilv
bbT.Nij(1) = ELvs(wj).N
bbT.Gij(1) = ELvs(wj).group
bbT.gwij(1) = ELvs(wj).gw
wall = Allowed_Trans( ELvs, wj, i, COUNT=nall )
if (nall GT 0) then begin
wja = wj(wall)
bbT(wall).allowed = 1
w = where( (Rad_Trans.ilv EQ ELvs(i).ilv) AND $
(Rad_Trans.islp EQ ELvs(i).islp), nwi )
if (nwi GT 0) then begin
qne = 1000*ELvs(wja).ilv + ELvs(wja).islp
qnrt = 1000*Rad_Trans(w).jlv + Rad_Trans(w).jslp
match, qne, qnrt, me, mrt, COUNT=nmat
if (nmat GT 0) then begin
mrt = w(mrt)
mall = wall(me)
if (nmat LT nall) then begin
wap = wall( remix( N=nall,REM=me ) )
wjap = wj(wap)
endif
endif else begin
wap = wall
wjap = wja
endelse
endif else begin
nmat = 0
wap = wall
wjap = wja
endelse
if (nmat GT 0) then begin
bbT(mall).gf = Rad_Trans(mrt).gf
bbT(mall).wavel = Rad_Trans(mrt).wavel
endif
if (nmat LT nall) then begin
bbT(wap).approx = 1
bbT(wap).gf = ELvs(i).gw * $
fosc_approx( ELvs(i).N, ELvs(wjap).N )
endif
endif
BB_Trans(itr:itr+ntran-1) = bbT
itr = itr + ntran
endfor
nallow = Long( total( BB_Trans.allowed ) )
message," ",/INFO
print, nallow, " allowed radiative transitions"
print, Nbbtr - nallow, " forbidden transitions"
print,"-------------"
print, itr, " total single Level transitions"
naprx = Long( total( BB_Trans.approx ) )
if (naprx GT 0) then print, naprx, " approximated radiative transitions"
if (itr NE Nbbtr) then print," total # trans expected =",Nbbtr
print,"-------------"
grpij = transpose( BB_Trans.Gij )
grpijtot = fix( total( grpij, 2 ) )
w_sing_sing = where( grpijtot LE 0, nt_sing )
if (nt_sing LE 0) then nallow=0 else begin
w = where( BB_Trans(w_sing_sing).allowed, nallow )
nallow = fix( nallow )
if (nallow GT 0) then begin
w = w_sing_sing(w)
BB_Trans(w).color = it_get_color( "Rad_Trans" )
BB_Trans(w).LineThick = Line_Thicks(0)
BB_Trans(w).LineStyle = Line_Styles(0)
endif
endelse
wsup = where( grpijtot GT 0, nt_sup )
if (nt_sup LE 0) then return
print, nt_sing, " (", nallow, $
" allowed ) transitions between single Levels only"
nsuplev = N_struct( SupLevs )
if (nsuplev LE 0) then begin
Modion_Status,"missing the SupLevs structure array!",/BELL
if (nt_sing GT 0) then BB_Trans = BB_Trans(w_sing_sing) $
else BB_Trans = 0
return
endif
;Next calculate transitions between single energy Levels and SuperLevels:
wsing = where( ELvs.group EQ 0, nsinglev )
Ntr_sing_sup = nsinglev * nsuplev
gfin = total( BB_Trans(wsup).gf )
gfout = 0
grpij = grpij(wsup,*)
if (nsinglev GT 0) then begin
itr = 0
BBT_sing_sup = replicate( bbTran, Ntr_sing_sup )
ELvs = ELvs(wsing)
qn = 1000*ELvs.ilv + ELvs.islp
qnst = transpose( 1000*BB_Trans(wsup).ilv + BB_Trans(wsup).slp )
endif
for i=0,nsinglev-1 do begin
wi = where( ( (qnst(*,0) EQ qn(i)) AND (grpij(*,0) EQ 0) ) OR $
( (qnst(*,1) EQ qn(i)) AND (grpij(*,1) EQ 0) ) )
ELv = ELvs(i)
BB_Trsg = BB_Trans(wsup(wi))
for j=0,nsuplev-1 do begin
SupLv = SupLevs(j)
wj = where( ( BB_Trsg.Gij(0) EQ SupLv.group ) OR $
( BB_Trsg.Gij(1) EQ SupLv.group ) )
BBTsg = BB_Trsg(wj)
BBTsup = BBTsg(0)
BBTsup.gf = total( BBTsg.gf )
BBTsup.allowed = max( BBTsg.allowed )
BBTsup.approx = min( BBTsg.approx )
Eij = [ ELv.E, SupLv.E ]
Nij = [ ELv.n, SupLv.n ]
gwij = [ ELv.gw, SupLv.gw ]
slp = [ ELv.islp, -100*SupLv.S - 10*SupLv.L - SupLv.P ]
ilv = [ ELv.ilv, SupLv.group ]
gij = [ 0, SupLv.group ]
so = sort( gwij )
so = so( Fsort( Eij(so) ) )
BBTsup.Eij = Eij(so)
BBTsup.Nij = Nij(so)
BBTsup.gwij = gwij(so)
BBTsup.slp = slp(so)
BBTsup.ilv = ilv(so)
BBTsup.gij = gij(so)
BBT_sing_sup(itr) = BBTsup
itr = itr + 1
endfor
endfor
if N_struct( BBT_sing_sup ) GT 0 then begin
BBT_sing_sup.wavel = 1e8/( abs( BBT_sing_sup.Eij(0) - $
BBT_sing_sup.Eij(1) ) > 1e-9 )
w = where( BBT_sing_sup.allowed, nallow )
nallow = fix( nallow )
gfout = gfout + total( BBT_sing_sup.gf )
if (nallow GT 0) then begin
BBT_sing_sup(w).LineThick = Line_Thicks(1)
BBT_sing_sup(w).LineStyle = Line_Styles(1)
BBT_sing_sup(w).color = $
it_get_color( "Single_Super_Trans" )
endif
endif else nallow=0
print, N_struct( BBT_sing_sup ), " (", nallow, $
" allowed ) transitions between single Levels and SuperLevels"
;Next calculate transitions between just SuperLevels:
if (nsuplev GT 1) then begin
itr = 0
Ntr_sup_sup = nsuplev * (nsuplev-1) /2
BBT_sup_sup = replicate( bbTran, Ntr_sup_sup )
endif
for i=0,nsuplev-2 do begin
for j=i+1,nsuplev-1 do begin
SupLv = SupLevs([i,j])
wij = where( ( (grpij(*,0) EQ SupLv(0).group) AND $
(grpij(*,1) EQ SupLv(1).group) ) OR $
( (grpij(*,0) EQ SupLv(1).group) AND $
(grpij(*,1) EQ SupLv(0).group) ) )
BBTss = BB_Trans(wsup(wij))
BBTij = BBTss(0)
BBTij.gf = total( BBTss.gf )
BBTij.allowed = max( BBTss.allowed )
BBTij.approx = min( BBTss.approx )
Eij = SupLv.E
gwij = SupLv.gw
so = sort( gwij )
so = so( Fsort( Eij(so) ) )
BBTij.Eij = Eij(so)
BBTij.gwij = gwij(so)
slp = 100*SupLv.S + 10*SupLv.L + SupLv.P
BBTij.slp = -slp(so)
BBTij.ilv = SupLv(so).group
BBTij.Nij = SupLv(so).N
BBTij.gij = SupLv(so).group
BBT_sup_sup(itr) = BBTij
itr = itr + 1
endfor
endfor
if N_struct( BBT_sup_sup ) GT 0 then begin
BBT_sup_sup.wavel = 1e8/( abs( BBT_sup_sup.Eij(0) - $
BBT_sup_sup.Eij(1) ) > 1e-9 )
w = where( BBT_sup_sup.allowed, nallow )
nallow = fix( nallow )
gfout = gfout + total( BBT_sup_sup.gf )
if (nallow GT 0) then begin
BBT_sup_sup(w).color=it_get_color( "Super_Super_Trans" )
BBT_sup_sup(w).LineThick = Line_Thicks(2)
BBT_sup_sup(w).LineStyle = Line_Styles(2)
endif
endif else nallow=0
print, N_struct( BBT_sup_sup ), " (", nallow, $
" allowed ) transitions between SuperLevels only"
;Finally, combine the different types of transition arrays and sort:
if (nsinglev GT 0) then begin
if (nt_sing GT 0) then begin
BB_Trans = [ BB_Trans(w_sing_sing), BBT_sing_sup ]
endif else BB_Trans = BBT_sing_sup
if N_struct( BBT_sup_sup ) GT 0 then $
BB_Trans = [ BB_Trans, BBT_sup_sup ]
endif else begin
if N_struct( BBT_sup_sup ) GT 0 then BB_Trans = BBT_sup_sup $
else BB_Trans = 0
endelse
if N_struct( BB_Trans ) GT 1 then begin
so = sort( BB_Trans.gwij(1) )
so = so( Fsort( BB_Trans(so).Eij(1) ) )
so = so( Fsort( BB_Trans(so).gwij(0) ) )
BB_Trans = BB_Trans( so( Fsort( BB_Trans(so).Eij(0) ) ) )
endif
print,"-------------"
print, N_struct( BB_Trans ), " (", fix( total( BB_Trans.allowed ) ), $
" allowed ) transitions, total"
print,"-------------"
print, "account of gf in super-transitions:"
print, " total gf input =", gfin
print, " gf actually used =", gfout, $
" ( ", byte( round( 100*gfout/gfin ) ), " % )"
end