1 #pragma TextEncoding = "UTF-8"
2 #pragma rtGlobals=3 // Use modern global access method and strict wave access.
3 #pragma IgorVersion = 6.1
4 #pragma ModuleName = PearlScientaPreprocess
5 #include "pearl-fitfuncs"
6 #include "pearl-area-import"
40 variable Lcrop = NumberByKey(
"Lcrop", param,
"=",
";")
41 variable Lsize = NumberByKey("Lsize", param, "=", ";")
42 variable Hcrop = NumberByKey("Hcrop", param, "=", ";")
43 variable Hsize = NumberByKey("Hsize", param, "=", ";")
44 variable Cpos = NumberByKey("Cpos", param, "=", ";")
45 variable Csize = NumberByKey("Csize", param, "=", ";")
47 prompt Lcrop, "Lower cropping region"
48 prompt Hcrop, "Upper cropping region"
49 prompt Lsize, "Lower background region"
50 prompt Hsize, "Upper background region"
51 prompt Cpos, "Center position"
52 prompt Csize, "Center integration region"
56 param = ReplaceNumberByKey("Lcrop", param, Lcrop, "=", ";")
57 param = ReplaceNumberByKey("Lsize", param, Lsize, "=", ";")
58 param = ReplaceNumberByKey("Hcrop", param, Hcrop, "=", ";")
59 param = ReplaceNumberByKey("Hsize", param, Hsize, "=", ";")
60 param = ReplaceNumberByKey("Cpos", param, Cpos, "=", ";")
61 param = ReplaceNumberByKey("Csize", param, Csize, "=", ";")
97 svar /z global_params = root:packages:pearl_explorer:s_reduction_params
98 if (svar_exists(global_params))
142 make /n=(nc) /free positions
145 string imagename = ""
146 string tracename = ""
149 for (ic = 0; ic < nc; ic += 1)
150 sc = num2char(char2num("A") + ic)
151 wave /z wc = CsrWaveRef($sc, win)
152 info = CsrInfo($sc, win)
153 tracename = StringByKey("TNAME", info, ":", ";")
154 if (waveexists(wc) && (wavedims(wc) == 2))
155 if (!waveexists(image))
157 imagename = tracename
159 if (cmpstr(tracename, imagename) == 0)
160 positions[np] = pcsr($sc, win)
166 np = floor(np / 2) * 2
167 redimension /n=(np) positions
168 sort positions, positions
170 positions = p >= np / 2 ? positions + 1 : positions
171 positions = positions / dimsize(image, 0)
174 variable ip2 = np / 2
175 variable ip1 = ip2 - 1
179 Cpos = (positions[ip1] + positions[ip2]) / 2
180 Csize = positions[ip2] - positions[ip1]
193 Lsize = positions[ip1]
194 Hsize = 1 - positions[ip2]
197 Lsize = Cpos - Csize / 2
198 Hsize = 1 - (Cpos + Csize / 2)
207 Lcrop = positions[ip1]
208 Hcrop = 1 - positions[ip2]
211 if (dimsize(image, 0) >= 992)
216 Lsize = max(Lsize - Lcrop, 0)
217 Hsize = max(Hsize - Hcrop, 0)
220 param = ReplaceNumberByKey("Lcrop", param, Lcrop, "=", ";")
221 param = ReplaceNumberByKey("Lsize", param, Lsize, "=", ";")
222 param = ReplaceNumberByKey("Hcrop", param, Hcrop, "=", ";")
223 param = ReplaceNumberByKey("Hsize", param, Hsize, "=", ";")
224 param = ReplaceNumberByKey("Cpos", param, Cpos, "=", ";")
225 param = ReplaceNumberByKey("Csize", param, Csize, "=", ";")
266 variable nx = dimsize(source, 0)
267 variable ny = dimsize(source, 1)
270 variable lcrop = NumberByKey("Lcrop", param, "=", ";")
271 variable lsize = NumberByKey("Lsize", param, "=", ";")
272 variable hcrop = NumberByKey("Hcrop", param, "=", ";")
273 variable hsize = NumberByKey("Hsize", param, "=", ";")
274 variable cpos = NumberByKey("Cpos", param, "=", ";")
275 variable csize = NumberByKey("Csize", param, "=", ";")
277 make /wave /free /n=2 result_waves
278 make /free /n=0 dest1, dest2
279 result_waves[0] = dest1
280 result_waves[1] = dest2
286 if (numtype(lcrop) != 0)
289 if (numtype(lsize) != 0)
292 if (numtype(hcrop) != 0)
295 if (numtype(hsize) != 0)
298 if (numtype(Cpos) != 0)
299 redimension /n=0 result_waves
302 if (numtype(Csize) != 0)
303 redimension /n=0 result_waves
307 variable lpos = lcrop + lsize / 2
308 variable hpos = 1 - (hcrop + hsize / 2)
313 duplicate /free dest1, lbg, hbg
315 p0 = round(lcrop * nx)
316 p1 = round((lcrop + lsize) * nx)
322 p0 = round((1 - hcrop - hsize) * nx)
323 p1 = round((1 - hcrop) * nx)
329 p0 = round((cpos - csize/2) * nx)
330 p1 = round((cpos + csize/2) * nx)
336 variable scale = (cpos - lpos) / (hpos - lpos)
338 dest1 -= scale * (hbg - lbg) + lbg
339 dest2 = sqrt(dest2 + scale^2 * (hbg + lbg))
343 sprintf s_note1, "AxisLabelD=peak integral"
344 sprintf s_note2, "KineticEnergy=%.3f", cpos * nx * dimdelta(source, 0) + dimoffset(source, 0)
356 variable Lcrop = NumberByKey("Lcrop", param, "=", ";")
357 variable Lsize = NumberByKey("Lsize", param, "=", ";")
358 variable Hcrop = NumberByKey("Hcrop", param, "=", ";")
359 variable Hsize = NumberByKey("Hsize", param, "=", ";")
360 variable Cpos = NumberByKey("Cpos", param, "=", ";")
361 variable Csize = NumberByKey("Csize", param, "=", ";")
363 prompt Lcrop, "Lower cropping region"
364 prompt Hcrop, "Upper cropping region"
365 prompt Lsize, "Lower background region"
366 prompt Hsize, "Upper background region"
367 prompt Cpos, "Center position"
368 prompt Csize, "Center integration region"
372 param = ReplaceNumberByKey("Lcrop", param, Lcrop, "=", ";")
373 param = ReplaceNumberByKey("Lsize", param, Lsize, "=", ";")
374 param = ReplaceNumberByKey("Hcrop", param, Hcrop, "=", ";")
375 param = ReplaceNumberByKey("Hsize", param, Hsize, "=", ";")
376 param = ReplaceNumberByKey("Cpos", param, Cpos, "=", ";")
377 param = ReplaceNumberByKey("Csize", param, Csize, "=", ";")
419 variable nx = dimsize(source, 0)
420 variable ny = dimsize(source, 1)
423 variable lcrop = NumberByKey("Lcrop", param, "=", ";")
424 variable lsize = NumberByKey("Lsize", param, "=", ";")
425 variable hcrop = NumberByKey("Hcrop", param, "=", ";")
426 variable hsize = NumberByKey("Hsize", param, "=", ";")
427 variable cpos = NumberByKey("Cpos", param, "=", ";")
428 variable csize = NumberByKey("Csize", param, "=", ";")
430 make /wave /free /n=2 result_waves
431 make /free /n=0 dest1, dest2
432 result_waves[0] = dest1
433 result_waves[1] = dest2
439 if (numtype(lcrop) != 0)
442 if (numtype(lsize) != 0)
445 if (numtype(hcrop) != 0)
448 if (numtype(hsize) != 0)
451 if (numtype(Cpos) != 0)
452 redimension /n=0 result_waves
455 if (numtype(Csize) != 0)
456 redimension /n=0 result_waves
461 variable pcl = round(lcrop * nx)
462 variable pch = round((1 - hcrop) * nx)
464 variable pfl = round((lcrop + lsize) * nx)
465 variable pfh = round((1 - hcrop - hsize) * nx)
467 variable pil = round((cpos - csize/2) * nx)
468 variable pih = round((cpos + csize/2) * nx)
471 make /n=(nx) /d /free profile, mask, fit
472 setscale /p x dimoffset(source,0), dimdelta(source,0), waveunits(source,0), profile, mask, fit
473 mask = ((p >= pcl) && (p < pfl)) || ((p >= pfh) && (p < pch))
477 variable xil = x2pnt(profile, pil)
478 variable xih = x2pnt(profile, pih)
480 make /n=3 /free /d w_coef
481 for (qq = 0; qq < ny; qq += 1)
482 profile = source[p][qq]
483 curvefit /Q /NTHR=1 /W=2 poly 3, kwCWave=w_coef, profile /M=mask
484 fit = poly(w_coef, x)
485 sp = sum(profile, xil, xih)
486 sf = sum(fit, xil, xih)
493 sprintf s_note1, "AxisLabelD=peak integral"
494 sprintf s_note2, "KineticEnergy=%.3f", cpos * nx * dimdelta(source, 0) + dimoffset(source, 0)
514 variable Lcrop = NumberByKey("Lcrop", param, "=", ";")
515 variable Lsize = NumberByKey("Lsize", param, "=", ";")
516 variable Hcrop = NumberByKey("Hcrop", param, "=", ";")
517 variable Hsize = NumberByKey("Hsize", param, "=", ";")
518 variable Cpos = NumberByKey("Cpos", param, "=", ";")
519 variable Csize = NumberByKey("Csize", param, "=", ";")
521 prompt Lcrop, "Lower cropping region"
522 prompt Hcrop, "Upper cropping region"
523 prompt Lsize, "Lower background region"
524 prompt Hsize, "Upper background region"
525 prompt Cpos, "Center position"
526 prompt Csize, "Center integration region"
530 param = ReplaceNumberByKey("Lcrop", param, Lcrop, "=", ";")
531 param = ReplaceNumberByKey("Lsize", param, Lsize, "=", ";")
532 param = ReplaceNumberByKey("Hcrop", param, Hcrop, "=", ";")
533 param = ReplaceNumberByKey("Hsize", param, Hsize, "=", ";")
534 param = ReplaceNumberByKey("Cpos", param, Cpos, "=", ";")
535 param = ReplaceNumberByKey("Csize", param, Csize, "=", ";")
578 variable nx = dimsize(source, 0)
579 variable ny = dimsize(source, 1)
581 duplicate /free source, source_redim
582 redimension /n=(nx * ny) source_redim
584 redimension /n=(nx, ny) source_redim
599 param = ReplaceNumberByKey("rngl", param, -inf, "=", ";")
600 param = ReplaceNumberByKey("rngh", param, inf, "=", ";")
601 param = ReplaceNumberByKey("npeaks", param, 4, "=", ";")
602 param = ReplaceNumberByKey("ybox", param, 1, "=", ";")
603 param = ReplaceNumberByKey("pos1", param, 11, "=", ";")
604 param = ReplaceNumberByKey("wid1", param, 0.1, "=", ";")
605 param = ReplaceNumberByKey("pos2", param, 12, "=", ";")
606 param = ReplaceNumberByKey("wid2", param, 0.2, "=", ";")
607 param = ReplaceNumberByKey("pos3", param, 13, "=", ";")
608 param = ReplaceNumberByKey("wid3", param, 0.3, "=", ";")
609 param = ReplaceNumberByKey("pos4", param, 14, "=", ";")
610 param = ReplaceNumberByKey("wid4", param, 0.4, "=", ";")
614 variable npk = numpnts(results) / 2
617 for (ipk = 0; ipk < npk; ipk += 1)
618 sw = "test_int_" + num2str(ipk + 1)
619 duplicate /o results[ipk], $sw
620 sw = "test_sig_" + num2str(ipk + 1)
621 duplicate /o results[ipk + npk], $sw
631 variable rngl = NumberByKey("rngl", param, "=", ";")
632 variable rngh = NumberByKey("rngh", param, "=", ";")
633 variable pos1 = NumberByKey("pos1", param, "=", ";")
634 variable wid1 = NumberByKey("wid1", param, "=", ";")
635 variable pos2 = NumberByKey("pos2", param, "=", ";")
636 variable wid2 = NumberByKey("wid2", param, "=", ";")
637 variable pos3 = NumberByKey("pos3", param, "=", ";")
638 variable wid3 = NumberByKey("wid3", param, "=", ";")
639 variable pos4 = NumberByKey("pos4", param, "=", ";")
640 variable wid4 = NumberByKey("wid4", param, "=", ";")
641 variable npeaks = NumberByKey("npeaks", param, "=", ";")
642 variable ybox = NumberByKey("ybox", param, "=", ";")
644 prompt rngl, "range low"
645 prompt rngh, "range high"
646 prompt pos1, "position 1"
647 prompt wid1, "width 1"
648 prompt pos2, "position 2"
649 prompt wid2, "width 2"
650 prompt pos3, "position 3"
651 prompt wid3, "width 3"
652 prompt pos4, "position 4"
653 prompt wid4, "width 4"
654 prompt npeaks, "number of peaks"
655 prompt ybox, "ybox (1 or 3)"
657 doprompt "
gauss4_reduction reduction parameters (1/2)", rngl, rngh, npeaks, ybox
659 param = ReplaceNumberByKey("rngl", param, rngl, "=", ";")
660 param = ReplaceNumberByKey("rngh", param, rngh, "=", ";")
661 param = ReplaceNumberByKey("npeaks", param, npeaks, "=", ";")
662 param = ReplaceNumberByKey("ybox", param, ybox, "=", ";")
664 doprompt "
gauss4_reduction reduction parameters (2/2)", pos1, wid1, pos2, wid2, pos3, wid3, pos4, wid4
666 param = ReplaceNumberByKey("pos1", param, pos1, "=", ";")
667 param = ReplaceNumberByKey("wid1", param, wid1, "=", ";")
668 param = ReplaceNumberByKey("pos2", param, pos2, "=", ";")
669 param = ReplaceNumberByKey("wid2", param, wid2, "=", ";")
670 param = ReplaceNumberByKey("pos3", param, pos3, "=", ";")
671 param = ReplaceNumberByKey("wid3", param, wid3, "=", ";")
672 param = ReplaceNumberByKey("pos4", param, pos4, "=", ";")
673 param = ReplaceNumberByKey("wid4", param, wid4, "=", ";")
724 variable nx = dimsize(source, 0)
725 variable ny = dimsize(source, 1)
728 variable rngl = NumberByKey("rngl", param, "=", ";")
729 variable rngh = NumberByKey("rngh", param, "=", ";")
730 variable pos1 = NumberByKey("pos1", param, "=", ";")
731 variable wid1 = NumberByKey("wid1", param, "=", ";")
732 variable pos2 = NumberByKey("pos2", param, "=", ";")
733 variable wid2 = NumberByKey("wid2", param, "=", ";")
734 variable pos3 = NumberByKey("pos3", param, "=", ";")
735 variable wid3 = NumberByKey("wid3", param, "=", ";")
736 variable pos4 = NumberByKey("pos4", param, "=", ";")
737 variable wid4 = NumberByKey("wid4", param, "=", ";")
738 variable npeaks = NumberByKey("npeaks", param, "=", ";")
739 variable ybox = NumberByKey("ybox", param, "=", ";")
745 duplicate /free xprof, xprof_sig
746 variable pl = max(x2pnt(xprof, rngl), 0)
747 variable ph = min(x2pnt(xprof, rngh), numpnts(xprof) - 1)
749 make /free /n=(npeaks) peak_coef
750 peak_coef = p * 3 + 2
751 variable n_coef = npeaks * 3 + 2
752 make /free /d /n=14 w_coef, W_sigma
753 w_coef[0] = {0, 0, 1, pos1, wid1, 1, pos2, wid2, 1, pos3, wid3, 1, pos4, wid4}
754 redimension /n=(n_coef) w_coef, w_sigma
760 make /free /n=(npeaks + 2, numpnts(w_coef)) cmat
761 make /free /n=(npeaks + 2) cvec
768 for (ipk=0; ipk < npeaks; ipk += 1)
770 cmat[2 + ipk][2 + ipk*3] = -1
774 make /free /n=(npeaks * 2) /wave result_waves
776 for (ipk = 0; ipk < npeaks; ipk += 1)
777 make /free /n=0 pk_int
780 sprintf s_note,
"AxisLabelD=peak %u integral", ipk+1
782 sprintf s_note,
"KineticEnergy=%.3f", w_coef[3 + ipk * 3]
784 result_waves[ipk] = pk_int
786 make /free /n=0 pk_sig
789 sprintf s_note, "AxisLabelD=peak %u sigma", ipk+1
791 sprintf s_note, "KineticEnergy=%.3f", w_coef[3 + ipk * 3]
793 result_waves[ipk + npeaks] = pk_sig
795 waveclear pk_int, pk_sig
800 variable p1 = dimsize(source, 1) - 1
805 p0 += ceil((ybox - 1) / 2)
806 p1 -= ceil((ybox - 1) / 2)
808 variable V_FitNumIters
811 for (pp = p0; pp <= p1; pp += 1)
813 xprof = source[p][pp]
815 xprof += source[p][pp-1] + source[p][pp+1]
817 xprof_sig = max(sqrt(xprof), 1)
822 wmin = wavemin(xprof)
823 wmax = wavemax(xprof)
826 for (ipk=0; ipk < npeaks; ipk += 1)
827 w_coef[2 + ipk*3] = wmax - wmin
831 FuncFit /H=hold /Q /NTHR=1 /N /W=2
MultiGaussLinBG_AO w_coef xprof[pl,ph] /C={cmat, cvec} /I=1 /W=xprof_sig[pl,ph]
835 if (V_FitNumIters < 40)
836 for (ipk = 0; ipk < npeaks; ipk += 1)
837 wave val = result_waves[ipk]
838 wave sig = result_waves[ipk + npeaks]
839 val[pp] = max(w_coef[peak_coef[ipk]], 0)
840 sig[pp] = max(w_sigma[peak_coef[ipk]], 0)
846 for (ipk = 0; ipk < npeaks; ipk += 1)
847 wave val = result_waves[ipk]
848 wave sig = result_waves[ipk + npeaks]
849 val *= w_coef[peak_coef[ipk] + 2] * sqrt(pi)
850 sig *= w_coef[peak_coef[ipk] + 2] * sqrt(pi)
860 variable nx = dimsize(source, 0)
861 variable ny = dimsize(source, 1)
864 variable rngl = NumberByKey("rngl", param, "=", ";")
865 variable rngh = NumberByKey("rngh", param, "=", ";")
866 variable pos1 = NumberByKey("pos1", param, "=", ";")
867 variable wid1 = NumberByKey("wid1", param, "=", ";")
868 variable pos2 = NumberByKey("pos2", param, "=", ";")
869 variable wid2 = NumberByKey("wid2", param, "=", ";")
870 variable pos3 = NumberByKey("pos3", param, "=", ";")
871 variable wid3 = NumberByKey("wid3", param, "=", ";")
872 variable pos4 = NumberByKey("pos4", param, "=", ";")
873 variable wid4 = NumberByKey("wid4", param, "=", ";")
874 variable pos5 = NumberByKey("pos5", param, "=", ";")
875 variable wid5 = NumberByKey("wid5", param, "=", ";")
876 variable pos6 = NumberByKey("pos6", param, "=", ";")
877 variable wid6 = NumberByKey("wid6", param, "=", ";")
878 variable npeaks = NumberByKey("npeaks", param, "=", ";")
879 variable ybox = NumberByKey("ybox", param, "=", ";")
885 duplicate /free xprof, xprof_sig
886 variable pl = max(x2pnt(xprof, rngl), 0)
887 variable ph = min(x2pnt(xprof, rngh), numpnts(xprof) - 1)
889 make /free /n=(npeaks) peak_coef
890 peak_coef = p * 3 + 2
891 variable n_coef = npeaks * 3 + 2
892 make /free /d /n=(n_coef) w_coef, W_sigma
893 w_coef[0] = {0, 0, 1, pos1, wid1, 1, pos2, wid2, 1, pos3, wid3, 1, pos4, wid4, 1, pos5, wid5, 1, pos6, wid6}
894 redimension /n=(n_coef) w_coef, w_sigma
900 make /free /n=(npeaks + 2, numpnts(w_coef)) cmat
901 make /free /n=(npeaks + 2) cvec
908 for (ipk=0; ipk < npeaks; ipk += 1)
910 cmat[2 + ipk][2 + ipk*3] = -1
914 make /free /n=(npeaks * 2) /wave result_waves
916 for (ipk = 0; ipk < npeaks; ipk += 1)
917 make /free /n=0 pk_int
920 sprintf s_note,
"AxisLabelD=peak %u integral", ipk+1
922 sprintf s_note,
"KineticEnergy=%.3f", w_coef[3 + ipk * 3]
924 result_waves[ipk] = pk_int
926 make /free /n=0 pk_sig
929 sprintf s_note, "AxisLabelD=peak %u sigma", ipk+1
931 sprintf s_note, "KineticEnergy=%.3f", w_coef[3 + ipk * 3]
933 result_waves[ipk + npeaks] = pk_sig
935 waveclear pk_int, pk_sig
940 variable p1 = dimsize(source, 1) - 1
945 p0 += ceil((ybox - 1) / 2)
946 p1 -= ceil((ybox - 1) / 2)
948 variable V_FitNumIters
951 for (pp = p0; pp <= p1; pp += 1)
953 xprof = source[p][pp]
955 xprof += source[p][pp-1] + source[p][pp+1]
957 xprof_sig = max(sqrt(xprof), 1)
962 wmin = wavemin(xprof)
963 wmax = wavemax(xprof)
966 for (ipk=0; ipk < npeaks; ipk += 1)
967 w_coef[2 + ipk*3] = wmax - wmin
971 FuncFit /H=hold /Q /NTHR=1 /N /W=2
MultiGaussLinBG_AO w_coef xprof[pl,ph] /C={cmat, cvec} /I=1 /W=xprof_sig[pl,ph]
975 if (V_FitNumIters < 40)
976 for (ipk = 0; ipk < npeaks; ipk += 1)
977 wave val = result_waves[ipk]
978 wave sig = result_waves[ipk + npeaks]
979 val[pp] = max(w_coef[peak_coef[ipk]], 0)
980 sig[pp] = max(w_sigma[peak_coef[ipk]], 0)
986 for (ipk = 0; ipk < npeaks; ipk += 1)
987 wave val = result_waves[ipk]
988 wave sig = result_waves[ipk + npeaks]
989 val *= w_coef[peak_coef[ipk] + 2] * sqrt(pi)
990 sig *= w_coef[peak_coef[ipk] + 2] * sqrt(pi)
1030 function /s find_gauss4_reduction_params(spectrum, peakpos)
1035 variable wmin = wavemin(spectrum)
1036 variable wmax = wavemax(spectrum)
1039 variable rngl = dimoffset(spectrum, 0)
1040 variable rngh = dimoffset(spectrum, 0) + dimdelta(spectrum, 0) * (dimsize(spectrum, 0) - 1)
1041 make /n=4 /free positions, widths
1042 variable npeaks = numpnts(peakpos)
1045 positions[0, npeaks-1] = peakpos[p]
1048 variable n_coef = npeaks * 3 + 2
1049 make /free /d /n=(n_coef) w_coef
1054 make /free /n=(2+npeaks, numpnts(w_coef)) cmat
1055 make /free /n=(2+npeaks) cvec
1062 for (ip=0; ip < npeaks; ip += 1)
1063 cmat[2 + ip][2 + ip*3] = -1
1064 w_coef[2 + ip*3] = wmax - wmin
1065 w_coef[3 + ip*3] = peakpos[ip]
1066 w_coef[4 + ip*3] = widths[ip]
1069 variable V_FitNumIters
1072 for (ip=0; ip < npeaks; ip += 1)
1073 positions[ip] = w_coef[3 + ip * 3]
1074 widths[ip ] = abs(w_coef[4 + ip * 3])
1076 for (ip=npeaks; ip < 4; ip += 1)
1081 param = ReplaceNumberByKey(
"rngl", param, rngl,
"=",
";")
1082 param = ReplaceNumberByKey(
"rngh", param, rngh,
"=",
";")
1083 param = ReplaceNumberByKey("npeaks", param, npeaks, "=", ";")
1084 param = ReplaceNumberByKey("ybox", param, ybox, "=", ";")
1085 param = ReplaceNumberByKey("pos1", param, positions[0], "=", ";")
1086 param = ReplaceNumberByKey("wid1", param, widths[0], "=", ";")
1087 param = ReplaceNumberByKey("pos2", param, positions[1], "=", ";")
1088 param = ReplaceNumberByKey("wid2", param, widths[1], "=", ";")
1089 param = ReplaceNumberByKey("pos3", param, positions[2], "=", ";")
1090 param = ReplaceNumberByKey("wid3", param, widths[2], "=", ";")
1091 param = ReplaceNumberByKey("pos4", param, positions[3], "=", ";")
1092 param = ReplaceNumberByKey("wid4", param, widths[3], "=", ";")
1138 threadsafe function /wave voigt4_reduction(source, param)
1142 dfref orig_dfr = GetDataFolderDFR()
1144 variable nx = dimsize(source, 0)
1145 variable ny = dimsize(source, 1)
1148 variable rngl = NumberByKey("rngl", param, "=", ";")
1149 variable rngh = NumberByKey("rngh", param, "=", ";")
1150 variable pos1 = NumberByKey("pos1", param, "=", ";")
1151 variable wid1 = NumberByKey("wid1", param, "=", ";")
1152 variable shp1 = NumberByKey("shp1", param, "=", ";")
1153 variable pos2 = NumberByKey("pos2", param, "=", ";")
1154 variable wid2 = NumberByKey("wid2", param, "=", ";")
1155 variable shp2 = NumberByKey("shp2", param, "=", ";")
1156 variable pos3 = NumberByKey("pos3", param, "=", ";")
1157 variable wid3 = NumberByKey("wid3", param, "=", ";")
1158 variable shp3 = NumberByKey("shp3", param, "=", ";")
1159 variable pos4 = NumberByKey("pos4", param, "=", ";")
1160 variable wid4 = NumberByKey("wid4", param, "=", ";")
1161 variable shp4 = NumberByKey("shp4", param, "=", ";")
1162 variable npeaks = NumberByKey("npeaks", param, "=", ";")
1168 duplicate /free xprof, xprof_sig
1169 variable pl = max(x2pnt(xprof, rngl), 0)
1170 variable ph = min(x2pnt(xprof, rngh), numpnts(xprof) - 1)
1172 make /free /n=(npeaks) peak_coef
1173 variable coef_per_peak = 4
1174 peak_coef = p * coef_per_peak + 2
1175 variable n_coef = npeaks * coef_per_peak + 2
1176 make /free /d /n=18 w_coef, W_sigma
1177 w_coef[0] = {0, 0, 1, pos1, wid1, shp1, 1, pos2, wid2, shp2, 1, pos3, wid3, shp3, 1, pos4, wid4, shp4}
1178 redimension /n=(n_coef) w_coef, w_sigma
1182 make /free /n=(npeaks, numpnts(w_coef)) cmat
1183 make /free /n=(npeaks) cvec
1188 for (ipk=0; ipk < npeaks; ipk += 1)
1190 cmat[ipk][2 + ipk * coef_per_peak] = -1
1194 make /free /n=(npeaks * 2) /wave result_waves
1196 for (ipk = 0; ipk < npeaks; ipk += 1)
1197 make /free /n=0 pk_int
1200 sprintf s_note,
"AxisLabelD=peak %u integral", ipk+1
1202 sprintf s_note,
"KineticEnergy=%.3f", w_coef[3 + ipk * coef_per_peak]
1204 result_waves[ipk] = pk_int
1206 make /free /n=0 pk_sig
1209 sprintf s_note, "AxisLabelD=peak %u sigma", ipk+1
1211 sprintf s_note, "KineticEnergy=%.3f", w_coef[3 + ipk * coef_per_peak]
1213 result_waves[ipk + npeaks] = pk_sig
1215 waveclear pk_int, pk_sig
1220 variable p1 = dimsize(source, 1) - 1
1224 variable V_FitNumIters
1227 for (pp = p0; pp <= p1; pp += 1)
1228 xprof = source[p][pp]
1229 xprof_sig = max(sqrt(xprof), 1)
1232 wmin = wavemin(xprof)
1233 wmax = wavemax(xprof)
1237 for (ipk=0; ipk < npeaks; ipk += 1)
1238 w_coef[2 + ipk * coef_per_peak] = wmax - wmin
1242 FuncFit /H=hold /Q /N /W=2
MultiVoigtLinBG_AO w_coef xprof[pl,ph] /C={cmat, cvec} /I=1 /W=xprof_sig[pl,ph]
1246 if (V_FitNumIters < 40)
1247 for (ipk = 0; ipk < npeaks; ipk += 1)
1248 wave val = result_waves[ipk]
1249 wave sig = result_waves[ipk + npeaks]
1250 val[pp] = max(w_coef[peak_coef[ipk]], 0)
1251 sig[pp] = max(w_sigma[peak_coef[ipk]], 0)
1256 SetDataFolder orig_dfr
1264 function prompt_voigt4_reduction(param)
1267 variable rngl = NumberByKey("rngl", param, "=", ";")
1268 variable rngh = NumberByKey("rngh", param, "=", ";")
1269 variable pos1 = NumberByKey("pos1", param, "=", ";")
1270 variable wid1 = NumberByKey("wid1", param, "=", ";")
1271 variable shp1 = NumberByKey("shp1", param, "=", ";")
1272 variable pos2 = NumberByKey("pos2", param, "=", ";")
1273 variable wid2 = NumberByKey("wid2", param, "=", ";")
1274 variable shp2 = NumberByKey("shp2", param, "=", ";")
1275 variable pos3 = NumberByKey("pos3", param, "=", ";")
1276 variable wid3 = NumberByKey("wid3", param, "=", ";")
1277 variable shp3 = NumberByKey("shp3", param, "=", ";")
1278 variable pos4 = NumberByKey("pos4", param, "=", ";")
1279 variable wid4 = NumberByKey("wid4", param, "=", ";")
1280 variable shp4 = NumberByKey("shp4", param, "=", ";")
1281 variable npeaks = NumberByKey("npeaks", param, "=", ";")
1282 variable dummy = nan
1284 prompt rngl, "range low"
1285 prompt rngh, "range high"
1286 prompt pos1, "position 1"
1287 prompt wid1, "width 1"
1288 prompt shp1, "shape 1"
1289 prompt pos2, "position 2"
1290 prompt wid2, "width 2"
1291 prompt shp2, "shape 2"
1292 prompt pos3, "position 3"
1293 prompt wid3, "width 3"
1294 prompt shp3, "shape 3"
1295 prompt pos4, "position 4"
1296 prompt wid4, "width 4"
1297 prompt shp4, "shape 4"
1298 prompt npeaks, "number of peaks"
1299 prompt dummy, "(not used)"
1301 doprompt "voigt4_reduction reduction parameters (1/2)", rngl, rngh, npeaks, dummy, pos1, pos2, pos3, pos4
1303 param = ReplaceNumberByKey("rngl", param, rngl, "=", ";")
1304 param = ReplaceNumberByKey("rngh", param, rngh, "=", ";")
1305 param = ReplaceNumberByKey("npeaks", param, npeaks, "=", ";")
1306 param = ReplaceNumberByKey("pos1", param, pos1, "=", ";")
1307 param = ReplaceNumberByKey("pos2", param, pos2, "=", ";")
1308 param = ReplaceNumberByKey("pos3", param, pos3, "=", ";")
1309 param = ReplaceNumberByKey("pos4", param, pos4, "=", ";")
1311 doprompt "voigt4_reduction reduction parameters (2/2)", wid1, shp1, wid2, shp2, wid3, shp3, wid4, shp4
1313 param = ReplaceNumberByKey("wid1", param, wid1, "=", ";")
1314 param = ReplaceNumberByKey("shp1", param, shp1, "=", ";")
1315 param = ReplaceNumberByKey("wid2", param, wid2, "=", ";")
1316 param = ReplaceNumberByKey("shp2", param, shp2, "=", ";")
1317 param = ReplaceNumberByKey("wid3", param, wid3, "=", ";")
1318 param = ReplaceNumberByKey("shp3", param, shp3, "=", ";")
1319 param = ReplaceNumberByKey("wid4", param, wid4, "=", ";")
1320 param = ReplaceNumberByKey("shp4", param, shp4, "=", ";")
1335 function test_shockley_anglefit(image, branch)
1340 param = ReplaceStringByKey("branch", param, num2str(branch), "=", ";")
1348 string pkpos_name = "saf_pkpos_" + s_branch
1349 string pkwid_name = "saf_pkwid_" + s_branch
1351 wave /wave results = shockley_anglefit(image, param)
1352 duplicate results[0], $pkpos_name
1353 duplicate results[1], $pkwid_name
1356 function prompt_Shockley_anglefit(param)
1359 variable branch = NumberByKey("branch", param, "=", ";")
1361 prompt branch, "Branch (-1 or +1)"
1363 doprompt "Shockley_anglefit_reduction Parameters", branch
1365 param = ReplaceNumberByKey("branch", param, branch, "=", ";")
1393 threadsafe function /wave Shockley_anglefit(source, param)
1397 variable nx = dimsize(source, 0)
1398 variable ny = dimsize(source, 1)
1401 variable branch = NumberByKey("branch", param, "=", ";")
1404 if (numtype(branch) != 0)
1409 make /wave /free /n=2 result_waves
1410 make /free /n=0 dest1, dest2
1411 result_waves[0] = dest1
1412 result_waves[1] = dest2
1436 duplicate /free dest1, center
1437 q0 = round((y0 - dimoffset(source, 1)) / dimdelta(source, 1))
1438 q1 = round((y1 - dimoffset(source, 1)) / dimdelta(source, 1))
1440 wavestats /q/m=1 center
1441 p0 = round((v_maxloc - dimoffset(source, 0)) / dimdelta(source, 0))
1442 p1 = round((v_maxloc + 0.4 - dimoffset(source, 0)) / dimdelta(source, 0))
1445 make /n=(ny)/d/free profile
1446 setscale /p x dimoffset(source,1), dimdelta(source,1), waveunits(source,1), profile
1449 for (pp = p0; pp <= p1; pp += 1)
1450 profile = source[pp][p]
1451 curvefit /Q /NTHR=1 /W=2 gauss profile(y0,y1)
1453 dest1[pp] = w_coef[2]
1454 dest2[pp] = w_coef[3]
1460 function scienta_norm(w, x): fitfunc
1464 return w[0] * (x^2 - w[1]^2)
1467 function /wave fit_scienta_ang_transm(data, params)
1471 if (!waveexists(params))
1472 make /n=12 /o params
1474 redimension /n=12/d params
1476 variable h = wavemax(data) - wavemin(data)
1489 FuncFit /NTHR=0 /q scienta_ang_transm params data
1494 threadsafe function scienta_ang_transm(w, x): fitfunc
1511 make /free /n=4 /d w_int
1513 w_int[1,] = w[p - 1]
1514 variable pk1 = gauss1d(w_int, x)
1515 w_int[1,] = w[p + 2]
1516 variable pk2 = gauss1d(w_int, x)
1517 w_int[1,] = w[p + 5]
1518 variable pk3 = gauss1d(w_int, x)
1519 w_int[0,2] = w[9 + p]
1521 variable bg = poly(w_int, x)
1523 return bg + pk1 + pk2 + pk3
1526 function /wave fit_scienta_poly_bg(data, params, bgterms)
1531 if (!waveexists(params))
1532 make /n=15 /o params
1534 redimension /n=15 /d params
1536 variable wmax = wavemax(data)
1537 variable wmin = wavemin(data)
1550 params[12] = (wmax - wmin) / dimdelta(data,1) / dimsize(data,1)
1554 string h = "0000000000000"
1565 FuncFitMD /NTHR=1 /q /h=h scienta_poly_bg params data
1570 function scienta_poly_bg(w, e, a): fitfunc
1596 make /free /n=4 /d w_int
1601 w_int[2,] = w[p0 + p - 2]
1602 variable pk1 = gauss1d(w_int, a)
1605 w_int[1,] = w[p0 + p - 1]
1606 variable pk2 = gauss1d(w_int, a)
1609 w_int[1,] = w[p0 + p - 1]
1610 variable pk3 = gauss1d(w_int, a)
1613 w_int[0,2] = w[p0 + p]
1615 variable base = poly(w_int, a)
1618 w_int[0,3] = w[p0 + p]
1619 variable bg = poly(w_int, e)
1621 return bg * (base + pk1 + pk2 + pk3)