The code.ill.fr has been recreated and upgraded with the latest version this weekend, If you encounter any problem please inform the Helpdesk.

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
This diff is collapsed.
FUNCTION in5_pab,w_in,emin=emin,emax=emax, dw=dw, verbose = verbose
;** *********************************************************
;
; Examples:
;
; w2 = in5_pab(w1, /verbose)
;
; w2 = in5_pab(w1, emin = -150, emax = 0.0, /verbose)
;
;
; Calculates (P(a,b))
;
; P(a,b)=S(2theta,w)*Q^2/w/n(w,T)
;
; w1 should be a horizontal S(Q,w) (after sqw_rebin and transpose)
;
;
;----------------------------------------------------
; empty cell 300K-500 5.1A
;----------------------------------------------------
; a = '180632>180662'
; w1 = rdopr(a) & w1 = remove_spectra(w1,M) & w1 = normalise(w1) & w1 = sumbank(w1) & w1 = in5_vnorm(w1, w60, /verbose)
; w2 = in5_t2e(w1, w60, /verbose)
; w3 = in5_pab(w2, /verbose) ; axes in E, Phi for sqw_rebin
; w4 = in5_sqw_rebin(w3, emin=-100., dq=0.02, /verbose)
; w5 = transpose(w4)
;
;
;
;
; New: JO, Fri Jul 7 15:47:16 2017 Pab for nuclear data
;
;
;** *********************************************************
COMMON c_lamp_access, inst
COMMON printing, iprint, outstring
take_datp, datp
par = datp.p
x_in = datp.x
y_in = datp.y
e_in = datp.e
lambda = par(21)
temp = par(11)
ei = 81.799/(lambda^2)+x_in*0.
sz = size(w_in)
IF (temp EQ 0.0) THEN BEGIN
print, 'WARNING: Temperature not found, set to 300 K'
temp=300.0
ENDIF
IF NOT keyword_set(emax) THEN emax = MAX(x_in)
IF NOT keyword_set(emin) THEN emin = MIN(x_in)
IF NOT keyword_set(dw) THEN dw = 0.0
IF keyword_set(verbose) THEN BEGIN
print, 'IN5_PAB: T =',strtrim(string(temp),2),' K'
print, 'IN5_PAB: lambda =',strtrim(string(lambda),2),' A'
print, 'IN5_PAB: emin=',strtrim(string(emin),2),' meV, emax=',strtrim(string(emax),2),' meV'
ENDIF
points=where(x_in GE emin AND x_in LE emax)
w_buf=w_in & e_buf=e_in & y_out=y_in
; -------------------------
; Compute Alpha and Beta
; -------------------------
;
; a = hbar^2 Q^2/2mkT and DW factor
q2=w_in*0.0 & deb_wal=q2
x_in=FLOAT(x_in)
FOR i=0,n_elements(y_in)-1 DO q2[*,i]=2*ei[*]-x_in[*]-2*sqrt(ei[*]*ABS(ei[*]-x_in[*]))*cos(y_in[i]*!PI/180)
q2=q2/2.072
deb_wal=exp(-dw*q2)
a = q2*deb_wal
; b = hbar omega/kT
; b = x_in/(1-exp(-1.*x_in*11.6045/temp))
b = x_in*11.6045/temp
indnul=WHERE(ABS(b) LE 1.e-12)
IF n_elements(indnul) GT 1 THEN BEGIN
w_buf(indnul,0:n_elements(y_in)-1)=0.
b(indnul)=1.
END
; -------------------------------------
; Compute S(a,b)
; -------------------------------------
w_buf = w_buf/a
e_buf = e_buf/a
; FOR i=0,n_elements(x_in)-1 DO BEGIN
; w_buf[i,*] = w_buf[i,*]/a
; e_buf[i,*] = e_buf[i,*]/a
;ENDFOR
; simplification: 2*b*sinh(b/2)*exp(-b/2) = x (1 - Cosh[x] + Sinh[x])
FOR i=0,n_elements(y_in)-1 DO BEGIN
; w_buf[*,i] = 2*b*sinh(b/2)*w_buf[*,i] *exp(-b/2)
; e_buf[*,i] = 2*b*sinh(b/2)*e_buf[*,i] *exp(-b/2)
w_buf[*,i] = 2*b*sinh(b/2)*w_buf[*,i] *exp(-b/2)
e_buf[*,i] = 2*b*sinh(b/2)*e_buf[*,i] *exp(-b/2)
; w_buf[*,i] = b*(exp(b)-1)*w_buf[*,i]
; e_buf[*,i] = b*(exp(b)-1)*e_buf[*,i]
ENDFOR
;************************
;output
;************************
; y_out = a[points] ; alpha is x Q^2
; x_out = b[points] ; beta is x hw
; in Phi and energy as for Sqw_rebin:
y_out = y_in ; in 2theta
x_out = x_in[points] ;
e_out = e_buf[points,*]
w_out = w_buf[points,*]
output:
mod_datp, datp, "e", e_out
mod_datp, datp, "x", x_out
mod_datp, datp, "y", y_out
mod_datp, datp, "x_tit", "Energy [meV]"
mod_datp, datp, "y_tit", "$2\theta$]"
give_datp, datp
return, w_out
END
......@@ -119,10 +119,10 @@
; -------------------------------------------------------------------------------------
; Set constants and prepare arrays for rebinning to regular Q-E grid
; -------------------------------------------------------------------------------------
const1 = 5.22697 ; E(meV)=const1*V(m/ms)^2 for neutron
const1 = 5.22697 ; E(meV)=const1*V(m/ms)^2 for neutron
const2 = 2.07193571 ; E(meV)=const2*k(A^-1)^2 for neutron
const3 = 3.956076 ; V(m/ms)=const3/lambda(A) for neutron
const4 = 81.8066 ; E(meV)=const4/lambda(A)^2 for neutron
const3 = 3.956076 ; V(m/ms)=const3/lambda(A) for neutron
const4 = 81.8066 ; E(meV)=const4/lambda(A)^2 for neutron
Ei = const4 / lambda^2
ki = SQRT(Ei / const2)
......@@ -132,6 +132,10 @@
Eps[0] = x_in[0]-(x_in[1]-x_in[0])/2.
Eps[1:nx-1] = (x_in[0:nx-2]+x_in[1:nx-1])/2.
Eps[nx] = x_in[nx-1]+(x_in[nx-1]-x_in[nx-2])/2.
; Seems to be a shift of 1/2 dE in the output energies ... ?
Eps = Eps + 0.5*(Eps[1] - Eps[0])
; IF keyword_set(verbose) THEN PRINT,'x=',x_in
......
This diff is collapsed.
......@@ -150,7 +150,7 @@ function in5_t2e,w_in, w_van, elp=elp, average_elp=average_elp, verbose=verbose
; Is it always true ???
; ----------------------------------------------------------------------------------
epp = gauss[*,2] - 1.0
; ----------------------------------------------------------------------------------
; Transform into S(2theta,W)
......@@ -173,7 +173,8 @@ function in5_t2e,w_in, w_van, elp=elp, average_elp=average_elp, verbose=verbose
print, 'T2E: Elastic peak position forced to (AVERAGE_ELP): ', strtrim(string( average_elp ),2)
endif
if keyword_set(elp) then begin
average_elp = elp
; same on the ELP index: should be read indice - 1 (see above)
average_elp = elp - 1
epp = average_elp # (fltarr(nspectra)+1.)
if keyword_set(verbose) then $
print, 'T2E: Elastic peak position forced to user value (ELP) : ', strtrim(string( elp ),2)
......
......@@ -69,7 +69,8 @@ FUNCTION in5_vnorm, w_in, w_van0, $
; JOR, Fri Feb 15 19:07:51 CET 2013: Debye-Waller corrections for PSD case.
; JOR, Wed Nov 20 14:47:36 CET 2013: Add the absolute normnalisation for the PSD case. Changes have
; been made in t2e_psd for correctness of the result vnorm+t2epsd.
;
;
; JOR, Mon Oct 3 10:35:44 CEST 2016 Remove the restriction on Nb channels
;
;-
;
......@@ -105,7 +106,7 @@ forward_function str_fit
size_win = SIZE(w_in)
; IF keyword_set(verbose) THEN PRINT,'SIZE(w_in)=',size_win
nchannels = size_win[1]
IF size_win[0] EQ 1 THEN nspectra = 1 ; A single 1D spectrum
IF size_win[0] EQ 1 THEN nspectra = 1 ; A single 1D spectrum
IF size_win[0] EQ 2 THEN BEGIN ; 2D [ToF,phi] Debye-Scherrer usual dataset
nspectra = size_win[2]
......@@ -171,8 +172,7 @@ forward_function str_fit
GOTO, fin
ENDIF
IF (size_wvan[1] NE size_win[1]) OR $
(size_wvan[2] NE size_win[2]) THEN BEGIN
IF (size_wvan[2] NE size_win[2]) THEN BEGIN
sstr = 'VNORM: ERROR: Win and Vanadium data are not on the same format:'
print, sstr
print, ' Win : ', size_win
......
; -----------------------------------
;
; @mupho_example
;
; w1 contains a reduced data set.
;
;
; -----------------------------------
RDSET,inst="IN4"
rdset, path = '../../rawdata/'
; data numbers for file naming
c = '189138-189167'
; -------------------------------------------------------------
; gdos (Bredov & Ostowskii) through the MUPHOCOR routine
; -------------------------------------------------------------
; -------------------------------------------------------------
; Create the MUPHOCOR input with various options.
; WARNING: Sample parameters to be adjusted for the UO2 case:
; amass: atomic mass = 238.03 + 2*16.0 = 270.03 g (per formula unit) (90.01 g/at)
; sig : total scattering cross section: 8.908+ 2* 4.232 = 13.14 barns (per formula unit) (4.38 barns/at)
; conc : concentration if one component: = 1
; unt : flat background
;
; -------------------------------------------------------------
s = 'input_mupho.txt'
print, '--------------------------------------------------------------'
print, ' UNT = ', strtrim(string(g),2)
print, '--------------------------------------------------------------'
; -------------------------------------------------------------
; the gdos sensible to emax and unt
; -------------------------------------------------------------
w59 = write_mupho(w1, file=s, emax=70.0, abs=0.0, phimin=10.0, phimax=115.5, iemp=0, amass=270.03, sig=13.14, unt=g)
; For check
; w21 = total(w1,2)
; w22 = read_mupho(file=s) & see, w22, /below
; -------------------------------------------------------------
; Compute the GDOS with the MUPHOCOR routine
; -------------------------------------------------------------
; without multi-phonon corrections (/first_guess)
; -------------------------------------------------------------
w10 = muphocor(s, /first_guess) & see, w10, /below
; with multi-phonon corrections
; -------------------------------------------------------------
w11 = muphocor(s) & see, w11, /below
y_tit(10) = 'GDOS [a.u.]'
y_tit(11) = 'GDOS [a.u.]'
; -------------------------------------------------------------
; plotting (better thsan the basics above)
; -------------------------------------------------------------
p = plot(x10, w10, '-db', xrange=[0,140], yrange=[0, 0.12], name='wo. multi-ph corr.')
q = plot(x11, w11, '-tur', xrange=[0,140], yrange=[0, 0.12], name='with multi-ph corr.', /overplot)
p.xtitle='Energy [meV]'
p.ytitle='G(w) [a.u.]'
p.XTickLen=1.0
p.YTickLen=1.0
p.XGridStyle=1
p.YGridStyle=1 & p.xminor=0 & p.yminor=0
p.title= 'IN4 GDOS - UO2, 1.7 $\AA$ , T ~ 446-346 K'
l= LEGEND(TARGET= [p,q], POSITION=[140, 0.115], /DATA, /AUTO_TEXT_COLOR)
p.save, "Figures/gdos_xxx.png", BORDER=10, RESOLUTION=300 ;;, /TRANSPARENT
; -------------------------------------------------------------
; write in column format
; -------------------------------------------------------------
WRITE_LAMP,"gdos_muphocor_"+c, w=10, format="column"
WRITE_LAMP,"gdos_muphocor_multi_"+c, w=11, format="column"
; -------------------------------------------------------------
; write in hdf
; -------------------------------------------------------------
s = "gdos_muphocor_"+c
WRITE_LAMP, s, w=10, format="hdf"
spawn,"mv -f "+s+"_LAMP.hdf "+s+".hdf"
s = "gdos_muphocor_multi_"+c
WRITE_LAMP, s, w=11, format="hdf"
spawn,"mv -f "+s+"_LAMP.hdf "+s+".hdf"
......@@ -2,7 +2,7 @@
;
; read_mupho
;
; Read the input_mupho.txtx inut files for MUPHOCOR routine
; Read the input_mupho.txt inut files for MUPHOCOR routine
; and exit the "Z00" time-of-flight distribution in a workspace.
;
; Example:
......@@ -36,6 +36,7 @@ FUNCTION read_mupho, file=file
E0=0. & FP=0. & CW=0. & XNEL=0. & FIMI=0. & FIMA=0. & ABK=0. & AEMP=0.
READF,u ,E0,FP,CW,XNEL,FIMI,FIMA,ABK,AEMP
; ---------------------------------------------------------------------------
; NSPEC: NUMBER OF DIFFERENT ATOMIC SPECIES
; ---------------------------------------------------------------------------
......@@ -65,7 +66,6 @@ FUNCTION read_mupho, file=file
SIGI[I]=tmp[1]
CONCI[I]=tmp[2]
ENDFOR
IF (NSPEC EQ 2) THEN BEGIN
tmp=fltarr(LPAR)
......@@ -103,19 +103,25 @@ FUNCTION read_mupho, file=file
UNT=0. & FUN=0.
READF,u,UNT,FUN
Z00=fltarr(1024) & UN0=Z00
IF (ISOUR NE 1) THEN BEGIN
tmp=fltarr(NOO-NUU+1)
READF,u,tmp,format=fmt40
print, NUU
Z00[NUU-1]=tmp
IF (FUN NE 0.) THEN BEGIN
READF,u,tmp,format=fmt40
UN0[NUU-1]=tmp
ENDIF
ENDIF
; ---------------------------------------------------------------------------
; Print the input parameters
; ---------------------------------------------------------------------------
......
FUNCTION write_mupho, w_in, file=file, phimin=phimin, phimax=phimax, abs=abs, $
aemp=aemp, emax = emax, sam=sam, npho=npho, itm=itm, $
ivit=ivit, idw=idw, iemp=iemp, ires=ires, ipr=ipr, iloss=iloss, $
amass=amass, sig=sig, conc=conc, $
unt=unt, fun=fun
;+
;
; write_mupho(w_in, file='input_mupho.txt')
;
; w_in: Spectrum in time-of-flight
;
; write_mupho sum the sin(theta)-weighted intensities of the instrument-free
; time-of-flight data and create the input_mupho.txt input file for the routine
; MUPHOCOR.
;
; prox example:
;
; RDSET,inst="IN5"
; RDSET,base="Current Path"
; w_clear, /all
;
; ; read the time-of-flight reduced data
; ; BGA at room temperature
; w1 = rdrun('152965_152990.hdf')
;
; ; Create the MUPHOCOR input with various options
; w2 = write_mupho(w1, file='input_mupho.txt', emax=40.0, abs=0.0, phimin=31.0, phimax=134.8, iemp=0, amass=44.8, sig=3.9, conc=1.0, unt=0.015)
;
; ; Compute the GDOS with the MUPHOCOR routine
; w10 = muphocor('input_test.txt') & see, w10, /below
;
;
;
; input_mupho.txt example and parameters:
;
;! E0:INC. ENERGY(MEV) FP:FLIGHTPATH(CM)
;! XNEL:CHANNEL OF ELASTIC LINE CW:CHANNEL WIDTH(MYS)
;! FIMI:MIN.SCATT.ANGLE FIMA:MAX.SCATT.ANGLE
;! UNT:CONST.BACKGROUND ABK: Absorption coefficient
;! AEMP: Coeff. for calculating the detector efficiency
;
; e0, fp, cw, xnel, fimi, fima, abk, aemp
; 4.77 248.30 3.91 794.08 10.33 115.05 0.00 3.30
;
;
;! Correction OF constant backgroud FOR counter efficiency
; bac=unt/(1.0-EXP(-aemp/SQRT(e0-hot(n))))
;
;
;
;! NSPEC: NUMBER OF DIFFERENT ATOMIC SPECIES
;! IF IQUO is unequal 0 an external model FOR the ratio OF F/G has
;! to be provided. The model is given through the array PARQ
; lm, nspec, iquo,lpar
; 500 1 0 1
;
;! HOX: UPPER LIMIT OF DENSITY OF STATES
;! TEMPO: TEMPERATURE IN KELVIN
;! DW: MEAN DEBY WALLER COEFFICIENT
;
;hox, temp0, dw
;40.00 298.52 0.03
;
;
;! AMASI: ATOMIC MASS
;! SIGI : SIGMA
;! CONCI: CONCENTRATION
;! ALFI: SCATTERING POWER
;DO i=1,nspec <-- 1 in our CASE so far
;READ 40,amasi(i),sigi(i),conci(i)
;END DO
;amasi(i), sigi(i), conci(i)
;44.80 3.90 1.00
;
;
;! NPHO: NUMBER OF MULTI PHONON TERMS
;! ITM: TOTAL NUMBER OF ITERATIONS
;! IVIT=0(1):ITERATION BY DIFFERENCE(QUOTIENT) METHOD
;! IDW=0: DW COEFF. KEPT CONST.=INPUT VALUE,DW=1:DW COEFF.ITERATED
;! IEMP=1(0):CORRECTIONS FOR COUNTER EFFICIENCY WILL BE(NOT BE) DONE
;! IRES=1(0):DATA WILL BE(NOT BE) CORRECTED FOR SPECTR. RESOLUTION
;! IPR=1(0): Convolutions integrals o the multiphonon term are printed
;! ILOSS=1: Analysis OF the imcomplete energy loss spectrum will be done
;
;npho,itm, ivit, idw, iemp, ires, ipr,iloss
;5 10 10 1 1 0 0 0
;
;
;
;! NU: First channel OF spektrum NO: Last channel OF spektrum
;! NUU: First channel OF TOF distribution used FOR calculation
;! NOO: Last channel OF TOF distribution used FOR calculation
;! IGLU: Number OF smoothing processes in CASE OF a time-dependant background
;
;isour,nuu, noo, nu, no, iglu
;0 200 750 200 750 0
;
;
;! UNT: CONSTANT BACKGROUND
;! FUN: MULTIPLICATION FACTOR FOR TIME DEPENDENT BACKGROUND
;
;unt, fun
;1.0000 0.0000
;
;
;; Z00: TIME OF FLIGHT DISTRIBUTION
;; UN0: TIME DEPENDENT BACKGROUND (if fun = 1)
;
aemp=aemp, emax = emax, sam=sam, npho=npho, itm=itm, $
ivit=ivit, idw=idw, iemp=iemp, ires=ires, ipr=ipr, iloss=iloss, $
amass=amass, sig=sig, conc=conc, $
unt=unt, fun=fun
;+
;
; write_mupho(w_in, file='input_mupho.txt')
;
; w_in: Spectrum in time-of-flight
;
; write_mupho sum the sin(theta)-weighted intensities of the instrument-free
; time-of-flight data and create the input_mupho.txt input file for the routine
; MUPHOCOR.
;
; prox example:
;
; RDSET,inst="IN5"
; RDSET,base="Current Path"
; w_clear, /all
;
; ; read the time-of-flight reduced data
; ; BGA at room temperature
; w1 = rdrun('152965_152990.hdf')
;
; ; Create the MUPHOCOR input with various options
; w2 = write_mupho(w1, file='input_mupho.txt', emax=40.0, abs=0.0, phimin=31.0, phimax=134.8, iemp=0, amass=44.8, sig=3.9, conc=1.0, unt=0.015)
;
; ; Compute the GDOS with the MUPHOCOR routine
; w10 = muphocor('input_test.txt') & see, w10, /below
;
;
;
; input_mupho.txt example and parameters:
;
;! E0:INC. ENERGY(MEV) FP:FLIGHTPATH(CM)
;! XNEL:CHANNEL OF ELASTIC LINE CW:CHANNEL WIDTH(MYS)
;! FIMI:MIN.SCATT.ANGLE FIMA:MAX.SCATT.ANGLE
;! UNT:CONST.BACKGROUND ABK: Absorption coefficient
;! AEMP: Coeff. for calculating the detector efficiency
;
; e0, fp, cw, xnel, fimi, fima, abk, aemp
; 4.77 248.30 3.91 794.08 10.33 115.05 0.00 3.30
;
;
;! Correction OF constant backgroud FOR counter efficiency
; bac=unt/(1.0-EXP(-aemp/SQRT(e0-hot(n))))
;
;
;
;! NSPEC: NUMBER OF DIFFERENT ATOMIC SPECIES
;! IF IQUO is unequal 0 an external model FOR the ratio OF F/G has
;! to be provided. The model is given through the array PARQ
; lm, nspec, iquo,lpar
; 500 1 0 1
;
;! HOX: UPPER LIMIT OF DENSITY OF STATES
;! TEMPO: TEMPERATURE IN KELVIN
;! DW: MEAN DEBY WALLER COEFFICIENT
;
;hox, temp0, dw
;40.00 298.52 0.03
;
;
;! AMASI: ATOMIC MASS
;! SIGI : SIGMA
;! CONCI: CONCENTRATION
;! ALFI: SCATTERING POWER
;DO i=1,nspec <-- 1 in our CASE so far
;READ 40,amasi(i),sigi(i),conci(i)
;END DO
;amasi(i), sigi(i), conci(i)
;44.80 3.90 1.00
;
;
;! NPHO: NUMBER OF MULTI PHONON TERMS
;! ITM: TOTAL NUMBER OF ITERATIONS
;! IVIT=0(1):ITERATION BY DIFFERENCE(QUOTIENT) METHOD
;! IDW=0: DW COEFF. KEPT CONST.=INPUT VALUE,DW=1:DW COEFF.ITERATED
;! IEMP=1(0):CORRECTIONS FOR COUNTER EFFICIENCY WILL BE(NOT BE) DONE
;! IRES=1(0):DATA WILL BE(NOT BE) CORRECTED FOR SPECTR. RESOLUTION
;! IPR=1(0): Convolutions integrals o the multiphonon term are printed
;! ILOSS=1: Analysis OF the imcomplete energy loss spectrum will be done
;
;npho,itm, ivit, idw, iemp, ires, ipr,iloss
;5 10 10 1 1 0 0 0
;
;
;
;! NU: First channel OF spektrum NO: Last channel OF spektrum
;! NUU: First channel OF TOF distribution used FOR calculation
;! NOO: Last channel OF TOF distribution used FOR calculation
;! IGLU: Number OF smoothing processes in CASE OF a time-dependant background
;
;isour,nuu, noo, nu, no, iglu
;0 200 750 200 750 0
;
;
;! UNT: CONSTANT BACKGROUND
;! FUN: MULTIPLICATION FACTOR FOR TIME DEPENDENT BACKGROUND
;
;unt, fun
;1.0000 0.0000
;
;
;; Z00: TIME OF FLIGHT DISTRIBUTION
;; UN0: TIME DEPENDENT BACKGROUND (if fun = 1)
;
; :Author: ollivier (2016-12-23)
;-
;Corrections:
;
;2017-07-04: doesn't work for water: no elastic line large enough
; :Author: ollivier (2016-12-23)
;-
COMMON c_lamp_access, inst
COMMON c_lamp_access, inst
s = SIZE(w_in)
if s[0] NE 2 THEN GOTO, ERROR
IF s[0] NE 2 THEN GOTO, ERROR