Skip to content
GitLab
Commit 85085fdd authored by Miguel Angel Gonzalez's avatar Miguel Angel Gonzalez
Browse files

Update some IN5 files from /home/cs/lambda/macros/IN5/JOR_LIBRARY

parent a9afb575
Hide whitespace changes
Inline Side-by-side
lamp_mac/IN5/in5_gdos.pro
View file @ 85085fdd
FUNCTION in5_gdos, w_in, Temp=temp, Emin=emin, Emax=emax, $
method=method, cutoff=cutoff, nbbins=nbbins,$
bgcorr=bgcorr, verbose=verbose, plotting=plotting
;------------------------------------------------------------------------------------
;
;+
;
;<h2>NAME:</h2>
; gdos
;
;
; <h2>PURPOSES:</h2>
;
; Calculates the generalized density of states G(w) at a temperature T
; in the case of the incoherent scattering and each time the incoherent
; approximation holds. Does not manage multi-phonons.
;
;
;<h2>COMMAND SYNTAX:</h2>
; w2 = gdos(w1, Emin=&lt;Emin&gt;, Emax=&lt;Emax&gt;, Temp=&lt;T&gt;, method=&lt;method&gt;, cutoff=&lt;cutoff&gt;, nbbins=&lt;nbbins&gt;,/bgcorr,/verbose,/plotting)
;
;<h2>EXAMPLES:</h2>
; w2 = gdos(w1)
;
; With all default parameters
;
; w2 = gdos(w1,emax=50.0)
;
; gdos from E = 0 to 50 meV
;
; w2 = gdos(w1, nbbins = 100, emax = 50.0, /plotting, /verbose)
; With a given number of points in the gdos, an enery max, with a plotting
; of the extrapolation fit in 10 groups, with some info on the prompt
;
;
; w2 = gdos(w1, nbbins = 100, emax = 50.0, cutoff = 1.3)
; With a given number of points in the gdos, a enery max, with
; a given cutoff for the extrapolation (default is 1.5 A-1).
;
;
; w2 = gdos(w1, nbbins = 100, emax = 50.0, cutoff = 1.1, method = 'fitlog', /plotting)
; With a given number of points in the gdos, a enery max, with
; a given cutoff for the extrapolation (default is 1.5 A-1).and with
; the fitlog method instead of the default Egelstaff method.
;
;
;
; The calculus is the following:
;
; p(a,b)=S(2theta,w)*Q^2/w/n(w,T) and
;
; lim p(a,b) = G(w)
; Q^2->0
;
;
; Workspace data must be as a function of energy transfer. Energies in meV.
; y should contain scattering angles (or averaged scattering angle)
;
; <h2>ARGUMENTS:</h2>
; (all optional)
;
; <b>Emin</b>: Minimum energy transfer to consider
;
; Default: MIN(E)
;
;
; <b>Emax</b>: Maximum energy transfer to consider
;
; Default: MAX(E)
;
; Always >= 0 and Emax>Emin: for IN5 and IN6 the up-scattering only is
; considered. For IN4: downscattering side has to be chosen.
;
;
; <b>Temp</b>: The temperature at which the experiment was performed
; if not in the parameters.
;
; Default: From the parameters or 295K if not in the parameters
;
;
; <b>method</b>: methods holds for the extrapolation method for:
;
; lim p(a,b) = G(w) (a prop. to Q^2)
; Q^2->0
;
; method = 'egelstaff' is for the (early) Egelstaff approximation
; with the Q_cutoff = threshold (straight line fit of S(a)/a with)
; a cutoff.
; Ref.: Egelstaff PA. & Schofield P. Nucl. Sci. Eng. 12(1962)260
;
; method = 'fitlog' is an "improvement" of the above method by fitting
; a straight line to the natural log of S(a)/a with or without a cutoff.
; Depending on the estimated multiple scattering let's try one or the other
; method.
; Derived from: JC. Smith et al. J. Chem. Phys. 85(1886)3636
;
; Default: 'egelstaff' method with a cutoff of 1.5 A-1
;
;
; <b>cutoff</b>: a threshold for the low-Q cutoff (e.g. 1.0, 1.5 A-1 , ...)
;
; Default: 1.5 for 'egelstaff' and 'fitlog' method
; This value is okay relative to cold neutrons instruments.
;
; <b>nbbins</b>: a slicing allowing to rebin in less than NbMax points
; in energy (for clarity of the presentation only)
;
; Default: no binning
;
;
; <b>/plotting</b> allow one to evaluate by eye the quality of the
; extrapolation on fit samples (for 10 spectra max).
;
; Default: no plotting
;
;
; <b>/verbose</b> write some information about what is doing the routine
;
; Default: no verbose
;
;
;<h2>VERSION HISTORY:</h2>
;
; ToDo: compute the error bar, mean angle by testing the instrument,
; background correction, mutli-phonons treatment.
;
; written by: S. Rols 11/01 rols@gdpc.univ-montp2.fr
; revisions: SR 04.02.02, 07/08/03
; JOR 29-Oct-2004 (ollivier@ill.fr) New version.
; makes the extrapolation (previous versions above = P(a)/a)
; included lots of new functionalities and keywords:
; methods Egelstaff & "fitlog"
; with Q-cutoff, energy rebinning,...
; JOR 02-Dec-2004: added error bars
; JOR 25-May-2005: added the down-scattering possibility
; in the energy sorting (IN4).
;
; JOR, Mon May 17 13:36:34 CEST 2010: Add prefix in5_
;
;
;
;-
;
;---------------------------------------------------------------------------------
method=method, cutoff=cutoff, nbbins=nbbins,$
bgcorr=bgcorr, verbose=verbose, plotting=plotting
;------------------------------------------------------------------------------------
;
;+
;
;<h2>NAME:</h2>
; gdos
;
;
; <h2>PURPOSES:</h2>
;
; Calculates the generalized density of states G(w) at a temperature T
; in the case of the incoherent scattering and each time the incoherent
; approximation holds. Does not manage multi-phonons.
;
;
;<h2>COMMAND SYNTAX:</h2>
; w2 = gdos(w1, Emin=&lt;Emin&gt;, Emax=&lt;Emax&gt;, Temp=&lt;T&gt;, method=&lt;method&gt;, cutoff=&lt;cutoff&gt;, nbbins=&lt;nbbins&gt;,/bgcorr,/verbose,/plotting)
;
;<h2>EXAMPLES:</h2>
; w2 = gdos(w1)
;
; With all default parameters
;
; w2 = gdos(w1,emax=50.0)
;
; gdos from E = 0 to 50 meV
;
; w2 = gdos(w1, nbbins = 100, emax = 50.0, /plotting, /verbose)
; With a given number of points in the gdos, an enery max, with a plotting
; of the extrapolation fit in 10 groups, with some info on the prompt
;
;
; w2 = gdos(w1, nbbins = 100, emax = 50.0, cutoff = 1.3)
; With a given number of points in the gdos, a enery max, with
; a given cutoff for the extrapolation (default is 1.5 A-1).
;
;
; w2 = gdos(w1, nbbins = 100, emax = 50.0, cutoff = 1.1, method = 'fitlog', /plotting)
; With a given number of points in the gdos, a enery max, with
; a given cutoff for the extrapolation (default is 1.5 A-1).and with
; the fitlog method instead of the default Egelstaff method.
;
;
;
; The calculus is the following:
;
; p(a,b)=S(2theta,w)*Q^2/w/n(w,T) and
;
; lim p(a,b) = G(w)
; Q^2->0
;
;
; Workspace data must be as a function of energy transfer. Energies in meV.
; y should contain scattering angles (or averaged scattering angle)
;
; <h2>ARGUMENTS:</h2>
; (all optional)
;
; <b>Emin</b>: Minimum energy transfer to consider
;
; Default: MIN(E)
;
;
; <b>Emax</b>: Maximum energy transfer to consider
;
; Default: MAX(E)
;
; Always >= 0 and Emax>Emin: for IN5 and IN6 the up-scattering only is
; considered. For IN4: downscattering side has to be chosen.
;
;
; <b>Temp</b>: The temperature at which the experiment was performed
; if not in the parameters.
;
; Default: From the parameters or 295K if not in the parameters
;
;
; <b>method</b>: methods holds for the extrapolation method for:
;
; lim p(a,b) = G(w) (a prop. to Q^2)
; Q^2->0
;
; method = 'egelstaff' is for the (early) Egelstaff approximation
; with the Q_cutoff = threshold (straight line fit of S(a)/a with)
; a cutoff.
; Ref.: Egelstaff PA. & Schofield P. Nucl. Sci. Eng. 12(1962)260
;
; method = 'fitlog' is an "improvement" of the above method by fitting
; a straight line to the natural log of S(a)/a with or without a cutoff.
; Depending on the estimated multiple scattering let's try one or the other
; method.
; Derived from: JC. Smith et al. J. Chem. Phys. 85(1886)3636
;
; Default: 'egelstaff' method with a cutoff of 1.5 A-1
;
;
; <b>cutoff</b>: a threshold for the low-Q cutoff (e.g. 1.0, 1.5 A-1 , ...)
;
; Default: 1.5 for 'egelstaff' and 'fitlog' method
; This value is okay relative to cold neutrons instruments.
;
; <b>nbbins</b>: a slicing allowing to rebin in less than NbMax points
; in energy (for clarity of the presentation only)
;
; Default: no binning
;
;
; <b>/plotting</b> allow one to evaluate by eye the quality of the
; extrapolation on fit samples (for 10 spectra max).
;
; Default: no plotting
;
;
; <b>/verbose</b> write some information about what is doing the routine
;
; Default: no verbose
;
;
;<h2>VERSION HISTORY:</h2>
;
; ToDo: compute the error bar, mean angle by testing the instrument,
; background correction, mutli-phonons treatment.
;
; written by: S. Rols 11/01 rols@gdpc.univ-montp2.fr
; revisions: SR 04.02.02, 07/08/03
; JOR 29-Oct-2004 (ollivier@ill.fr) New version.
; makes the extrapolation (previous versions above = P(a)/a)
; included lots of new functionalities and keywords:
; methods Egelstaff & "fitlog"
; with Q-cutoff, energy rebinning,...
; JOR 02-Dec-2004: added error bars
; JOR 25-May-2005: added the down-scattering possibility
; in the energy sorting (IN4).
;
; JOR, Mon May 17 13:36:34 CEST 2010: Add prefix in5_
;
;
;
;-
;
;---------------------------------------------------------------------------------
COMMON c_lamp_access, inst
COMMON printing, iprint, outstring
COMMON c_lamp_access, inst
COMMON printing, iprint, outstring
;---------------------------------------------------------------------------------
;
; Analyses the entries
;
;---------------------------------------------------------------------------------
if ~keyword_set(method) then begin
method = 'egelstaff'
if keyword_set(verbose) then $
;---------------------------------------------------------------------------------
;
; Analyses the entries
;
;---------------------------------------------------------------------------------
IF ~keyword_set(method) THEN BEGIN
method = 'egelstaff'
IF keyword_set(verbose) THEN $
print,'GDOS: Warning: Method not given, set to ',method
endif
if ( ~strcmp(method,'egelstaff',/fold_case) ) && ( ~strcmp(method,'fitlog',/fold_case) ) then begin
method = 'egelstaff'
if keyword_set(verbose) then $
ENDIF
IF ( ~strcmp(method,'egelstaff',/fold_case) ) && ( ~strcmp(method,'fitlog',/fold_case) ) THEN BEGIN
method = 'egelstaff'
IF keyword_set(verbose) THEN $
print,'GDOS: Warning: Undefined method, set to ',method
endif
if ~keyword_set(cutoff) then begin
cutoff = 1.5
if keyword_set(verbose) then $
ENDIF
IF ~keyword_set(cutoff) THEN BEGIN
cutoff = 1.5
IF keyword_set(verbose) THEN $
print,'GDOS: Warning: Cutoff not given, set to ',strtrim(cutoff,2),' A-1'
endif
if keyword_set(bgcorr) then begin
if keyword_set(verbose) then $
ENDIF
IF keyword_set(bgcorr) THEN BEGIN
IF keyword_set(verbose) THEN $
print,'GDOS: Background correction not yet implemented...'
endif
ENDIF
take_datp, datp
par=datp.p
x = datp.x
y = datp.y
err = datp.e
w = w_in
take_datp, datp
par=datp.p
x = datp.x
y = datp.y
err = datp.e
w = w_in
lambda=0.
CASE strlowcase(inst) OF
'mibemol':begin
lambda=FLOAT(par[0])
temp=FLOAT(par[59])
ei=81.805/par[0]^2 + x*0.
end
'dcsasc':begin
lambda=float(par[8])
ei=81.799/(lambda^2)+x*0.
end
'qens_raw':begin
ef=3.167 ;average final neutron energy in mev
lambda=sqrt(81.799/ef)
ei=x+ef
end
else:begin
lambda=par[21]
if (n_elements(temp) eq 0) then temp=par[11]
ei=81.799/(lambda^2)+x*0.
end
endcase
lambda=0.
CASE strlowcase(inst) OF
'mibemol':BEGIN
lambda=FLOAT(par[0])
temp=FLOAT(par[59])
ei=81.805/par[0]^2 + x*0.
END
'dcsasc':BEGIN
lambda=float(par[8])
ei=81.799/(lambda^2)+x*0.
END
'qens_raw':BEGIN
ef=3.167 ;average final neutron energy in mev
lambda=sqrt(81.799/ef)
ei=x+ef
END
ELSE:BEGIN
lambda=par[21]
IF (n_elements(temp) EQ 0) THEN temp=par[11]
ei=81.799/(lambda^2)+x*0.
END
ENDCASE
if (temp eq 0.0) then begin
IF (temp EQ 0.0) THEN BEGIN
temp=293.0
if keyword_set(verbose) then $
print,'verboseTemperature unknown, T set to: ',strtrim(temp,2),' K'
endif
IF keyword_set(verbose) THEN $
print,'verboseTemperature unknown, T set to: ',strtrim(temp,2),' K'
ENDIF
if keyword_set(verbose) then begin
print, 'GDOS: Instrument is ', strupcase(inst)
print, 'GDOS: lambda = ',strtrim(lambda,2),' Angs'
print, 'GDOS: Ei = ', strtrim(mean(ei),2),' meV'
endif
IF keyword_set(verbose) THEN BEGIN
print, 'GDOS: Instrument is ', strupcase(inst)
print, 'GDOS: lambda = ',strtrim(lambda,2),' Angs'
print, 'GDOS: Ei = ', strtrim(mean(ei),2),' meV'
ENDIF
;------------------------------------------------------
; Sort energies in ascending order with up-scattering
; positive, i.e, the condition hw = Ef - Ei
;
; Warning: Problem if IN4, i.e. working in down
; scattering mode
;------------------------------------------------------
if strlowcase(inst) eq 'in4' then begin
endif else begin
a1 = x[0] & a2 = x[n_elements(x)-1]
if abs(a1) gt abs(a2) then begin
if a1 lt a2 then begin
ind = sort(-1.0*x)
x = -1.0*x[ind]
w = w[ind,*]
err = err[ind,*]
endif else begin
x = reverse(x)
err = reverse(err)
w = reverse(w)
endelse
endif else begin
if a1 gt a2 then begin
ind = sort(x)
x = x[ind]
w = w[ind,*]
err = err[ind,*]
endif
endelse
endelse
;------------------------------------------------------
; Sort energies in ascending order with up-scattering
; positive, i.e, the condition hw = Ef - Ei
;
; Warning: Problem if IN4, i.e. working in down
; scattering mode
;------------------------------------------------------
IF strlowcase(inst) EQ 'in4' THEN BEGIN
ENDIF ELSE BEGIN
a1 = x[0] & a2 = x[n_elements(x)-1]
IF abs(a1) GT abs(a2) THEN BEGIN
IF a1 LT a2 THEN BEGIN
ind = sort(-1.0*x)
x = -1.0*x[ind]
w = w[ind,*]
err = err[ind,*]
ENDIF ELSE BEGIN
x = reverse(x)
err = reverse(err)
w = reverse(w)
ENDELSE
ENDIF ELSE BEGIN
IF a1 GT a2 THEN BEGIN
ind = sort(x)
x = x[ind]
w = w[ind,*]
err = err[ind,*]
ENDIF
ENDELSE
ENDELSE
;----------------------------------------------------
; reduce the number of points if any
;----------------------------------------------------
if (n_elements(emax) EQ 0) then emax=MAX(x)
if (n_elements(emin) EQ 0) then emin=0.0
if emin lt 0. or emax lt 0. then begin
print,'Error , Emin and Emax must be >= 0.0'
return,0
endif
if emin gt emax then begin
print,'Error , Emax must be > Emin'
return,0
endif
ind = where(x ge emin and x le emax)
x = x[ind]
err = err[ind,*]
w = w[ind,*]
;-------------------------------------------------------
if keyword_set(verbose) then begin
print,'GDOS: Temperature=',strtrim(temp,2),' K'
print,'GDOS: emin=',strtrim(emin,2),' meV'
print,'GDOS: emax=',strtrim(emax,2),' meV'
endif
;-------------------------------------------------------
;Calcul de Q^2
;-------------------------------------------------------
q2=w*0.0
x=float(x)
FOR i=0,n_elements(y)-1 DO begin
if y[i] eq 0.0 then y[i]= 61.96 ; IN6 only, 'instr' must be tested
q2[*,i]=2*(2*!PI/lambda)*(1+0.5*x[*]/ei[*] $
- sqrt(1+x[*]/ei[*])*cos(y[i]*!PI/180))
endfor
alpha = 2.0721*q2/temp
;----------------------------------------------------
; reduce the number of points if any
;----------------------------------------------------
IF (n_elements(emax) EQ 0) THEN emax=MAX(x)
IF (n_elements(emin) EQ 0) THEN emin=0.0
IF emin LT 0. OR emax LT 0. THEN BEGIN
print,'Error , Emin and Emax must be >= 0.0'
return,0
ENDIF
IF emin GT emax THEN BEGIN
print,'Error , Emax must be > Emin'
return,0
ENDIF
ind = where(x GE emin AND x LE emax)
x = x[ind]
err = err[ind,*]
w = w[ind,*]
;-------------------------------------------------------
IF keyword_set(verbose) THEN BEGIN
print,'GDOS: Temperature=',strtrim(temp,2),' K'
print,'GDOS: emin=',strtrim(emin,2),' meV'
print,'GDOS: emax=',strtrim(emax,2),' meV'
ENDIF
;-------------------------------------------------------
;Calcul de Q^2
;-------------------------------------------------------
q2=w*0.0
x=float(x)
FOR i=0,n_elements(y)-1 DO BEGIN
IF y[i] EQ 0.0 THEN y[i]= 61.96 ; IN6 only, 'instr' must be tested
q2[*,i]=2*(2*!PI/lambda)*(1+0.5*x[*]/ei[*] $
- sqrt(1+x[*]/ei[*])*cos(y[i]*!PI/180))
ENDFOR
alpha = 2.0721*q2/temp
;-------------------------------------------------------------
; Calcul de w/n(w) ou n(w) est le facteur de temperature dans
; le cas Stokes et anti Stokes
;-------------------------------------------------------------
beta = 11.605*x/temp
bosex= beta*(exp(beta)-1)
;-----------------------------------------------------
; Corrections
;-----------------------------------------------------
indnul=where(abs(bosex) LE 1.e-12)
if n_elements(indnul) gt 1 then begin
w[indnul,0:n_elements(y)-1]=0.000001
bosex[indnul]=1.
end
;------------------------------------------------------
; The main transform: p(a,b)
;------------------------------------------------------
for i=0,n_elements(y)-1 do begin
err[*,i]=err[*,i]/w[*,i]
w[*,i]=w[*,i]*bosex[*]/alpha[*,i]
err[*,i]=err[*,i]*w[*,i]
endfor
;-------------------------------------------------------
; slicing in energy if requested
;-------------------------------------------------------
if keyword_set(nbbins) then begin
nchannels = n_elements(x)
if nbbins gt nchannels then nbbins = nchannels
if keyword_set(verbose) then $
;-------------------------------------------------------------
; Calcul de w/n(w) ou n(w) est le facteur de temperature dans
; le cas Stokes et anti Stokes
;-------------------------------------------------------------
beta = 11.605*x/temp
bosex= beta*(exp(beta)-1)
;-----------------------------------------------------
; Corrections
;-----------------------------------------------------
indnul=where(abs(bosex) LE 1.e-12)
IF n_elements(indnul) GT 1 THEN BEGIN
w[indnul,0:n_elements(y)-1]=0.000001
bosex[indnul]=1.
END
;------------------------------------------------------
; The main transform: p(a,b)
;------------------------------------------------------
FOR i=0,n_elements(y)-1 DO BEGIN
err[*,i]=err[*,i]/w[*,i]
w[*,i]=w[*,i]*bosex[*]/alpha[*,i]
err[*,i]=err[*,i]*w[*,i]
ENDFOR
;-------------------------------------------------------
; slicing in energy if requested
;-------------------------------------------------------
IF keyword_set(nbbins) THEN BEGIN
nchannels = n_elements(x)