Commit 85085fdd authored by Miguel Angel Gonzalez's avatar Miguel Angel Gonzalez

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
; ---------------------------------------------------------------------------
......
This diff is collapsed.
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment