Commit 85085fdd by 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
 ... ... @@ -133,6 +133,10 @@ 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 nEps=nx+1 & Emin=Eps[0] & Emax=Eps[nEps-1] ... ...
 ;-------------------------------------------------------------------------------- ;******************************************************************************** ; FUNCTION in5_sqw_rebin, w_in, dQ = dQ, Emin = Emin0, all_angles = all_angles, $FUNCTION in5_sqw_rebin, w_in, dQ = dQ, Emin = Emin0, all_angles = all_angles,$ pos_angles = pos_angles, neg_angles = neg_angles, $swap_QE = swap_QE, qb, em, ib,$ verbose = verbose ; ; For IN4, IN5, IN6 and D7 ; ;rebins output data from t2e and reb to regular-grid S(Q,w) data using the old ;KHA IN6 rebin algorithm. Proper rebionning routine with error analysis (unlike ;sqw_interp.pro). ; ;ARGUMENTS: ; dQ : Q bin width ; Emin0: Minimum energy value (meV) - neutron energy gain is negative ; ;KEYWORDS (- only for D7 data) ; /neg_angles : use only negative angles ; /pos_angles : use only positive angles ; /all_angles : use all angles (default) ; input workspace must be in energy transfer versus scattering angle, ; i.e. only one component or spin phase. ; (qb, em and ib are obsolete, kept for backwards compatibility) ; ;DIMENSIONS: ; w_in(nE,nphi) -> w_out(nQs,nEs) ; ;COMMAND SYNTAX: ; w10=spw_rebin(w9,dQ=, Emin=[,/neg_angles][,/pos_angles][,/all_angles]) ; ; (optional keywords shown in square brackets) ; ; ; ; WARNING: Seems to not work with the negative scattering angles of DCSD !!! ; First, remove the negative angles and then that's okay. ; ; ; ; ; Creation: KHA,JRS 9/02/06 ; Modification: JO, Tue Nov 25 18:05:32 CET 2008 : Short-cut of the negative phi (is only for D7) ; IN4, IN5, IN6 only Debye-Scherrer cones Phi > 0 ; ; ;-------------------------------------------------------------------------------- ;******************************************************************************** common c_lamp_access, inst common grid, Qmin, Qmax, Emin, Emax forward_function string_round, overlap ;-------------------------------------------------------------------------------- ;******************************************************************************** ; ; ; For IN4, IN5, IN6 and D7 ; ;rebins output data from t2e and reb to regular-grid S(Q,w) data using the old ;KHA IN6 rebin algorithm. Proper rebionning routine with error analysis (unlike ;sqw_interp.pro). ; ;ARGUMENTS: ; dQ : Q bin width ; Emin0: Minimum energy value (meV) - neutron energy gain is negative ; ;KEYWORDS (- only for D7 data) ; /neg_angles : use only negative angles ; /pos_angles : use only positive angles ; /all_angles : use all angles (default) ; input workspace must be in energy transfer versus scattering angle, ; i.e. only one component or spin phase. ; (qb, em and ib are obsolete, kept for backwards compatibility) ; ;DIMENSIONS: ; w_in(nE,nphi) -> w_out(nQs,nEs) ; ;COMMAND SYNTAX: ; w10=spw_rebin(w9,dQ=, Emin=[,/neg_angles][,/pos_angles][,/all_angles]) ; ; (optional keywords shown in square brackets) ; ; ; ; WARNING: Seems to not work with the negative scattering angles of DCSD !!! ; First, remove the negative angles and then that's okay. ; ; ; ; ; Creation: KHA,JRS 9/02/06 ; Modification: JO, Tue Nov 25 18:05:32 CET 2008 : Short-cut of the negative phi (is only for D7) ; IN4, IN5, IN6 only Debye-Scherrer cones Phi > 0 ; ; ;-------------------------------------------------------------------------------- ;******************************************************************************** COMMON c_lamp_access, inst COMMON grid, Qmin, Qmax, Emin, Emax FORWARD_FUNCTION string_round, overlap iprint = 0 ; if iprint>0, show debugging messages ... ... @@ -58,10 +58,10 @@ take_datp, datp ibank = 2 IF N_ELEMENTS(qb) GT 0 THEN dQ = qb IF N_ELEMENTS(em) GT 0 THEN Emin = em IF N_ELEMENTS(ib) GT 0 THEN ibank = ib ; IF N_ELEMENTS(qb) GT 0 THEN dQ = qb ; IF N_ELEMENTS(em) GT 0 THEN Emin = em ; IF N_ELEMENTS(ib) GT 0 THEN ibank = ib ; IF KEYWORD_SET(pos_angles) THEN ibank = 1 IF KEYWORD_SET(neg_angles) THEN ibank = 0 IF KEYWORD_SET(all_angles) THEN ibank = 2 ... ... @@ -73,9 +73,9 @@ PRINT, 'SQW_rebin: IN4 data without small angle bank' ENDIF ; ------------------------------------------------------------------------------- ; Set up starting parameters ; ------------------------------------------------------------------------------- ; ------------------------------------------------------------------------------- ; Set up starting parameters ; ------------------------------------------------------------------------------- IF N_ELEMENTS(dQ) NE 1 THEN BEGIN ii = DIALOG_MESSAGE('SQW_rebin: Error - dQ must be specified', /ERROR) RETURN, w_in ... ... @@ -84,8 +84,10 @@ IF N_ELEMENTS(Emin0) NE 1 THEN Emin0 = -1.E+10 sw = SIZE(w_in) ; IF keyword_set(verbose) THEN PRINT,'SIZE(w_in) = ',sw nx = sw[1] ny = sw[2] IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: nx = ', strtrim(string(nx),2),', ny = ', strtrim(string(ny),2) IF keyword_set(verbose) THEN PRINT,'SIZE(w_in) = ', strtrim(string(sw),2) IF sw[0] NE 2 THEN BEGIN s = 'SQW_REBIN: ERROR: input workspace must be 2-D: E vs. phi' ... ... @@ -93,15 +95,14 @@ RETURN, w_in ENDIF nx = sw[1] ny = sw[2] ; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: nx=',nx,' ny=',ny x_in = datp.x & sx = SIZE(x_in) y_in = datp.y & sy = SIZE(y_in) ; print, sx ; print, sy IF (nx NE sx[1]) OR (ny NE sy[1]) THEN BEGIN s = 'SQW_rebin: sx = ' + STRTRIM(STRING(sx),2) + $s = 'SQW_REBIN: sx = ' + STRTRIM(STRING(sx),2) +$ ' sy = ' + STRTRIM(STRING(sy),2) ii = DIALOG_MESSAGE(s, /ERROR) RETURN, w_in ... ... @@ -120,9 +121,9 @@ IF keyword_set(verbose) THEN $PRINT, FORMAT = '("SQW_REBIN: lambda = ",F5.2," A")', lambda ; ------------------------------------------------------------------------------------- ; Set constants and prepare arrays for rebinning to regular Q-E grid ; ------------------------------------------------------------------------------------- ; ------------------------------------------------------------------------------------- ; Set constants and prepare arrays for rebinning to regular Q-E grid ; ------------------------------------------------------------------------------------- const1 = 5.22697 ; E(meV) = const1*V(m/ms)^2 const2 = 2.07193571 ; E(meV) = const2*k(A^-1)^2 const3 = 3.956076 ; V(m/ms) = const3/lambda(A) ... ... @@ -130,7 +131,7 @@ Ei = const4 / lambda^2 ki = SQRT(Ei / const2) y_in = y_in*!pi/180. ; convert to radians y_in = y_in*!PI/180. ; convert to radians nEps = nx + 1 Eps = FLTARR(nEps) ... ... @@ -148,22 +149,22 @@ Qmax = SQRT((2.*Ei - Emin - 2.*SQRT(Ei*(Ei - Emin))*COS(max_y))/const2) Qmax = MAX([Qmax,ki]) ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: iEarr(0) = ',iEarr(0),' nx = ',nx ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: iEarr(0) = ',iEarr(0),' nx = ',nx IF keyword_set(verbose) THEN PRINT, FORMAT = '("SQW_REBIN: Emin = ",F7.2," meV")', Emin IF keyword_set(verbose) THEN PRINT, FORMAT = '("SQW_REBIN: Emax = ",F7.2," meV")', Emax ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: SQW_rebin: E-array prepared' ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: SQW_rebin: E-array prepared' ; ----------------------------------------------------------------------------- ; angle grid generation ; ----------------------------------------------------------------------------- ; ----------------------------------------------------------------------------- ; angle grid generation ; ----------------------------------------------------------------------------- nQ = FIX((Qmax - Qmin) / dQ) + 1 w_out = FLTARR(nQ,nEps) e_out = w_out - 1. Q = Qmin + FLOAT(INDGEN(nQ))*dQ ; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: Qmin = ', Qmin ; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: Qmax = ', Qmax ; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: Qmin = ', Qmin ; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: Qmax = ', Qmax IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: nQ = ', nQ IF keyword_set(verbose) THEN PRINT, FORMAT = '("SQW_REBIN: Qmin = ",F7.2," A-1")', Qmin IF keyword_set(verbose) THEN PRINT, FORMAT = '("SQW_REBIN: Qmax = ",F7.2," A-1")', Qmax ... ... @@ -196,7 +197,7 @@ iphi1 = 0 & iphi2 = ny - 1 ENDELSE start: start: IF inst EQ 'D7' THEN BEGIN nphi = iphi2 - iphi1 + 2 phi = FLTARR(nphi) ... ... @@ -210,7 +211,7 @@ start: nphi = ny+2 phi = FLTARR(nphi) IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: Phi_in=',y_in*180./!pi i1=(WHERE(y_in GT 10.*!pi/180.))[0]-1 i1=(WHERE(y_in GT 10.*!PI/180.))[0]-1 phi[0] = y_in[0] - (y_in[1] - y_in[0]) / 2. phi[1:i1] = (y_in[0:i1-1]+y_in[1:i1])/2. phi[i1+1] = phi[i1]+(y_in[i1]-y_in[i1-1]) ... ... @@ -234,9 +235,9 @@ start: ENDELSE COSphi = COS(phi) ; ---------------------------------------------------------------------------------- ; reverse array direction for negative angles ; ---------------------------------------------------------------------------------- ; ---------------------------------------------------------------------------------- ; reverse array direction for negative angles ; ---------------------------------------------------------------------------------- IF inst EQ 'D7' THEN BEGIN IF phi[0] LT 0. THEN BEGIN w_buf = REVERSE(w_buf,2) ... ... @@ -245,15 +246,15 @@ start: phi = ABS(REVERSE(phi)) COSphi= REVERSE(COSphi) ENDIF endif ENDIF ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: phi=',phi*180./!pi ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: phi=',phi*180./!pi IF keyword_set(verbose) THEN$ PRINT, format = '("SQW_REBIN: phi_out = [",F7.3,",",F7.3,"]")',min(phi)*180./!pi,max(phi)*180./!pi ; ------------------------------------------------------------------------------------- ; Rebin angles to constant Q grid ; ------------------------------------------------------------------------------------- ; ------------------------------------------------------------------------------------- ; Rebin angles to constant Q grid ; ------------------------------------------------------------------------------------- a = const2 ; E(meV)=a*Q(A**-1)**2 oldymin = 0. ... ... @@ -280,7 +281,7 @@ start: ip = WHERE(phi LT phimean, np) iphi0 = ip[np - 1] ENDIF startrebin: startrebin: Areasum = 0. wsum = 0. e2sum = 0. ... ... @@ -310,22 +311,22 @@ startrebin: e_out[iQ,iEps] = SQRT(e2sum) / areasum GOTO, binned ENDIF outside: w_out[iQ,iEps] = 0. outside: w_out[iQ,iEps] = 0. e_out[iQ,iEps] = -1. GOTO, nextpoint binned: binned: p1 = phimin > phiminmeas p2 = phimax < phimaxmeas IF p2 - p1 LT (phimax - phimin)/2. THEN BEGIN w_out[iQ,iEps] = 0. e_out[iQ,iEps] = -1. ENDIF nextpoint: nextpoint: ENDFOR ENDFOR ;;IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: End of rebinning' ;;IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: End of rebinning' IF twice THEN BEGIN IF (iphi1 EQ 0) THEN BEGIN ... ... @@ -335,7 +336,7 @@ nextpoint: iphi2 = iphi2next GOTO, start ENDIF ELSE BEGIN ; take weighted averages of negative and positive banks for D7 ; take weighted averages of negative and positive banks for D7 w_out2 = w_out e_out2 = e_out ... ... @@ -360,15 +361,15 @@ nextpoint: ENDELSE ENDIF ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: End of rebinning section' ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: End of rebinning section' ; ------------------------------------------------------------------------------------- ; Chop off superfluous bits ; ------------------------------------------------------------------------------------- ; ------------------------------------------------------------------------------------- ; Chop off superfluous bits ; ------------------------------------------------------------------------------------- i = WHERE(e_out GT -1.,n) IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: ', strtrim(n,2), ' non-zeroed points' checkQ2: checkQ2: iw0 = WHERE(w_out[nQ - 1,*] EQ 0., nw0) ie0 = WHERE(e_out[nQ - 1,*] EQ -1., ne0) ... ... @@ -380,7 +381,7 @@ checkQ2: GOTO, checkQ2 ENDIF checkEps1: checkEps1: iw0 = WHERE(w_out[*,0] EQ 0., nw0) ie0 = WHERE(e_out[*,0] EQ -1., ne0) IF (nw0 EQ nQ) AND (ne0 EQ nQ) THEN BEGIN ... ... @@ -391,7 +392,7 @@ checkEps1: GOTO, checkEps1 ENDIF checkEps2: checkEps2: iw0 = WHERE(w_out[*,nEps - 1] EQ 0., nw0) ie0 = WHERE(e_out[*,nEps - 1] EQ -1., ne0) IF (nw0 EQ nQ) AND (ne0 EQ nQ) THEN BEGIN ... ... @@ -402,10 +403,10 @@ checkEps2: GOTO, checkEps2 ENDIF ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: End of chopping section' ;; IF keyword_set(verbose) THEN PRINT,'SQW_REBIN: End of chopping section' ;------------------------------------------------------------------------------------- ;Return parameters and exit ;------------------------------------------------------------------------------------- ;Return parameters and exit IF NOT swap_QE THEN BEGIN ... ... @@ -441,8 +442,8 @@ checkEps2: GIVE_DATP, datp finished: finished: RETURN, w_out END END
 ... ... @@ -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) ... ...  ... ... @@ -70,6 +70,7 @@ FUNCTION in5_vnorm, w_in, w_van0,$ ; 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 ; ;- ; ... ... @@ -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]'