source: sans/Dev/trunk/NCNR_User_Procedures/Reduction/SANS/WriteQIS.ipf @ 740

Last change on this file since 740 was 708, checked in by srkline, 12 years ago

SA_Includes_v410 : now include Smear_2D

PeakGauss_2D, Sphere_2D : included threaded resolution smearing calculations for testing

DataSetHandling? : Included a quick and dirty batch converter for XML->6-col. See the top
of the file for the command to run

GaussUtils? : re-define the ResSemear_2D_AAOStruct. Relocated q-value and phi calculations from
RawWindowHook? to this file so they would be available for reduction and analysis

Smear_2D : now has a generic (non-threaded) smearing routine. Threading must be done in
individual functions since FUNCREF can't be passed to threads (plus a few other issues)

PlotUtils_2D : updated loader for new QxQy? columns. Fixes to Wrapper_2D to enable smeared fits

RawWindowHook? : removed Q-value calculation functions and moved these to GaussUtils?

WriteQIS : now writes out 8-columns for QxQy? data, defining the resolution
function in terms of directions parallel and perpendicular to Q. TEMPORARILY in the data
file an error in intensity is generated that is SQRT(I), being careful to
replace any NaN, inf, or zero with an average error value

MultiScatter_MonteCarlo_2D : 4-processor aware

NCNR_Utils : 2D resolution calculation is now in terms of parallel and perpendicular
rather than x and y. Gravity is included in the y-component

File size: 29.5 KB
Line 
1#pragma rtGlobals=1             // Use modern global access method.
2#pragma version=5.0
3#pragma IgorVersion=6.1
4
5//************************
6// Vers 1.2 091001
7//
8//************************
9
10//for writing out data (q-i-s) from the "type" folder, and including reduction information
11//if fullpath is a complete HD path:filename, no dialog will be presented
12//if fullpath is just a filename, the save dialog will be presented
13//if dialog = 1, a dialog will always be presented
14//
15// root:myGlobals:Protocols:gProtoStr is the name of the currently active protocol
16//
17Function WriteWaves_W_Protocol(type,fullpath,dialog)
18        String type,fullpath
19        Variable dialog         //=1 will present dialog for name
20       
21        String destStr=""
22        destStr = "root:Packages:NIST:"+type
23       
24        Variable refNum
25        String formatStr = "%15.4g %15.4g %15.4g %15.4g %15.4g %15.4g\r\n"
26        String fname,ave="C",hdrStr1="",hdrStr2=""
27        Variable step=1
28       
29       
30       
31        //*****these waves MUST EXIST, or IGOR Pro will crash, with a type 2 error****
32        WAVE intw=$(destStr + ":integersRead")
33        WAVE rw=$(destStr + ":realsRead")
34        WAVE/T textw=$(destStr + ":textRead")
35        WAVE qvals =$(destStr + ":qval")
36        WAVE inten=$(destStr + ":aveint")
37        WAVE sig=$(destStr + ":sigave")
38        WAVE qbar = $(destStr + ":QBar")
39        WAVE sigmaq = $(destStr + ":SigmaQ")
40        WAVE fsubs = $(destStr + ":fSubS")
41
42        SVAR gProtoStr = root:myGlobals:Protocols:gProtoStr
43        Wave/T proto=$("root:myGlobals:Protocols:"+gProtoStr)
44       
45        //check each wave
46        If(!(WaveExists(intw)))
47                Abort "intw DNExist BinaryWrite_W_Protocol()"
48        Endif
49        If(!(WaveExists(rw)))
50                Abort "rw DNExist BinaryWrite_W_Protocol()"
51        Endif
52        If(!(WaveExists(textw)))
53                Abort "textw DNExist BinaryWrite_W_Protocol()"
54        Endif
55        If(!(WaveExists(qvals)))
56                Abort "qvals DNExist BinaryWrite_W_Protocol()"
57        Endif
58        If(!(WaveExists(inten)))
59                Abort "inten DNExist BinaryWrite_W_Protocol()"
60        Endif
61        If(!(WaveExists(sig)))
62                Abort "sig DNExist BinaryWrite_W_Protocol()"
63        Endif
64        If(!(WaveExists(qbar)))
65                Abort "qbar DNExist BinaryWrite_W_Protocol()"
66        Endif
67        If(!(WaveExists(sigmaq)))
68                Abort "sigmaq DNExist BinaryWrite_W_Protocol()"
69        Endif
70        If(!(WaveExists(fsubs)))
71                Abort "fsubs DNExist BinaryWrite_W_Protocol()"
72        Endif
73        If(!(WaveExists(proto)))
74                Abort "current protocol wave DNExist BinaryWrite_W_Protocol()"
75        Endif
76
77        //strings can be too long to print-- must trim to 255 chars
78        Variable ii,num=8
79        Make/O/T/N=(num) tempShortProto
80        for(ii=0;ii<num;ii+=1)
81                tempShortProto[ii] = (proto[ii])[0,240]
82        endfor
83       
84        if(dialog)
85                PathInfo/S catPathName
86                fullPath = DoSaveFileDialog("Save data as")
87                If(cmpstr(fullPath,"")==0)
88                        //user cancel, don't write out a file
89                        Close/A
90                        Abort "no data file was written"
91                Endif
92                //Print "dialog fullpath = ",fullpath
93        Endif
94       
95        hdrStr1 = num2str(rw[0])+"  "+num2str(rw[26])+"       "+num2str(rw[19])+"     "+num2str(rw[18])
96        hdrStr1 += "     "+num2str(rw[4])+"     "+num2str(rw[5]) + ave +"   "+num2str(step) + "\r\n"
97
98        hdrStr2 = num2str(rw[16])+"  "+num2str(rw[17])+"  "+num2str(rw[23])+"    "+num2str(rw[24])+"    "
99        hdrStr2 += num2str(rw[25])+"    "+num2str(rw[27])+"    "+num2str(rw[21])+"    "+textW[9] + "\r\n"
100       
101        SVAR samFiles = $("root:Packages:NIST:"+type+":fileList")
102        //actually open the file here
103        Open refNum as fullpath
104       
105        //write out the standard header information
106        fprintf refnum,"FILE: %s\t\t CREATED: %s\r\n",textw[0],textw[1]
107        fprintf refnum,"LABEL: %s\r\n",textw[6]
108        fprintf refnum,"MON CNT   LAMBDA   DET ANG   DET DIST   TRANS   THICK   AVE   STEP\r\n"
109        fprintf refnum,hdrStr1
110        fprintf refnum,"BCENT(X,Y)   A1(mm)   A2(mm)   A1A2DIST(m)   DL/L   BSTOP(mm)   DET_TYP \r\n"
111        fprintf refnum,hdrStr2
112//      fprintf refnum,headerFormat,rw[0],rw[26],rw[19],rw[18],rw[4],rw[5],ave,step
113
114        //insert protocol information here
115        //-1 list of sample files
116        //0 - bkg
117        //1 - emp
118        //2 - div
119        //3 - mask
120        //4 - abs params c2-c5
121        //5 - average params
122        fprintf refnum, "SAM: %s\r\n",samFiles
123        fprintf refnum, "BGD: %s\r\n",tempShortProto[0]
124        fprintf refnum, "EMP: %s\r\n",tempShortProto[1]
125        fprintf refnum, "DIV: %s\r\n",tempShortProto[2]
126        fprintf refnum, "MASK: %s\r\n",tempShortProto[3]
127        fprintf refnum, "ABS Parameters (3-6): %s\r\n",tempShortProto[4]
128        fprintf refnum, "Average Choices: %s\r\n",tempShortProto[5]
129       
130        //write out the data columns
131        fprintf refnum,"The 6 columns are | Q (1/A) | I(Q) (1/cm) | std. dev. I(Q) (1/cm) | sigmaQ | meanQ | ShadowFactor|\r\n"
132        wfprintf refnum, formatStr, qvals,inten,sig,sigmaq,qbar,fsubs
133       
134        Close refnum
135       
136        SetDataFolder root:             //(redundant)
137       
138        //write confirmation of write operation to history area
139        Print "Averaged File written: ", GetFileNameFromPathNoSemi(fullPath)
140        KillWaves/Z tempShortProto
141        Return(0)
142End
143
144
145//for writing out data (phi-i-s) from the "type" folder, and including reduction information
146//if fullpath is a complete HD path:filename, no dialog will be presented
147//if fullpath is just a filename, the save dialog will be presented
148//if dialog = 1, a dialog will always be presented
149//
150// root:myGlobals:Protocols:gProtoStr is the name of the currently active protocol
151//
152Function WritePhiave_W_Protocol(type,fullpath,dialog)
153        String type,fullpath
154        Variable dialog         //=1 will present dialog for name
155       
156        String destStr
157        destStr = "root:Packages:NIST:"+type
158       
159        Variable refNum
160        String formatStr = "%15.4g %15.4g %15.4g\r\n"
161        String fname,ave="C",hdrStr1,hdrStr2
162        Variable step=1
163       
164        //*****these waves MUST EXIST, or IGOR Pro will crash, with a type 2 error****
165        WAVE intw=$(destStr + ":integersRead")
166        WAVE rw=$(destStr + ":realsRead")
167        WAVE/T textw=$(destStr + ":textRead")
168        WAVE phival =$(destStr + ":phival")
169        WAVE inten=$(destStr + ":aveint")
170        WAVE sig=$(destStr + ":sigave")
171        SVAR gProtoStr = root:myGlobals:Protocols:gProtoStr
172        Wave/T proto=$("root:myGlobals:Protocols:"+gProtoStr)
173       
174        //check each wave
175        If(!(WaveExists(intw)))
176                Abort "intw DNExist BinaryWrite_W_Protocol()"
177        Endif
178        If(!(WaveExists(rw)))
179                Abort "rw DNExist BinaryWrite_W_Protocol()"
180        Endif
181        If(!(WaveExists(textw)))
182                Abort "textw DNExist BinaryWrite_W_Protocol()"
183        Endif
184        If(!(WaveExists(phival)))
185                Abort "qvals DNExist BinaryWrite_W_Protocol()"
186        Endif
187        If(!(WaveExists(inten)))
188                Abort "inten DNExist BinaryWrite_W_Protocol()"
189        Endif
190        If(!(WaveExists(sig)))
191                Abort "sig DNExist BinaryWrite_W_Protocol()"
192        Endif
193        If(!(WaveExists(proto)))
194                Abort "current protocol wave DNExist BinaryWrite_W_Protocol()"
195        Endif
196        //strings can be too long to print-- must trim to 255 chars
197        Variable ii,num=8
198        Make/O/T/N=(num) tempShortProto
199        for(ii=0;ii<num;ii+=1)
200                tempShortProto[ii] = (proto[ii])[0,240]
201        endfor
202       
203        if(dialog)
204                PathInfo/S catPathName
205                fullPath = DoSaveFileDialog("Save data as")
206                If(cmpstr(fullPath,"")==0)
207                        //user cancel, don't write out a file
208                        Close/A
209                        Abort "no data file was written"
210                Endif
211                //Print "dialog fullpath = ",fullpath
212        Endif
213       
214        hdrStr1 = num2str(rw[0])+"  "+num2str(rw[26])+"       "+num2str(rw[19])+"     "+num2str(rw[18])
215        hdrStr1 += "     "+num2str(rw[4])+"     "+num2str(rw[5]) + ave +"   "+num2str(step) + "\r\n"
216
217        hdrStr2 = num2str(rw[16])+"  "+num2str(rw[17])+"  "+num2str(rw[23])+"    "+num2str(rw[24])+"    "
218        hdrStr2 += num2str(rw[25])+"    "+num2str(rw[27])+"    "+num2str(rw[21])+"    "+textW[9] + "\r\n"
219       
220        SVAR samFiles = $("root:Packages:NIST:"+type+":fileList")
221        //actually open the file here
222        Open refNum as fullpath
223       
224        //write out the standard header information
225        fprintf refnum,"FILE: %s\t\t CREATED: %s\r\n",textw[0],textw[1]
226        fprintf refnum,"LABEL: %s\r\n",textw[6]
227        fprintf refnum,"MON CNT   LAMBDA   DET ANG   DET DIST   TRANS   THICK   AVE   STEP\r\n"
228        fprintf refnum,hdrStr1
229        fprintf refnum,"BCENT(X,Y)   A1(mm)   A2(mm)   A1A2DIST(m)   DL/L   BSTOP(mm)   DET_TYP \r\n"
230        fprintf refnum,hdrStr2
231       
232        //insert protocol information here
233        //0 - bkg
234        //1 - emp
235        //2 - div
236        //3 - mask
237        //4 - abs params c2-c5
238        //5 - average params
239        fprintf refnum, "SAM: %s\r\n",samFiles
240        fprintf refnum, "BGD: %s\r\n",tempShortProto[0]
241        fprintf refnum, "EMP: %s\r\n",tempShortProto[1]
242        fprintf refnum, "DIV: %s\r\n",tempShortProto[2]
243        fprintf refnum, "MASK: %s\r\n",tempShortProto[3]
244        fprintf refnum, "ABS Parameters (3-6): %s\r\n",tempShortProto[4]
245        fprintf refnum, "Average Choices: %s\r\n",tempShortProto[5]
246       
247        //write out the data columns
248        fprintf refnum,"The 3 columns are | Phi (deg) | I(phi) (1/cm) | std. dev. I(phi) (1/cm) |\r\n"
249        wfprintf refnum, formatStr, phival,inten,sig
250       
251        Close refnum
252       
253        SetDataFolder root:             //(redundant)
254       
255        //write confirmation of write operation to history area
256        Print "Averaged File written: ", GetFileNameFromPathNoSemi(fullPath)
257        KillWaves/Z tempShortProto
258
259        Return(0)
260End
261
262//*****************
263// saves the data after all of the desired reduction steps (average options)
264// as a 2x expanded PNG file (approx 33kb)
265//
266Function SaveAsPNG(type,fullPath,dialog)
267        String type,fullPath
268        Variable dialog
269       
270        Variable refnum
271        if(dialog)
272                PathInfo/S catPathName
273                fullPath = DoSaveFileDialog("Save data as")             //won't actually open the file
274                If(cmpstr(fullPath,"")==0)
275                        //user cancel, don't write out a file
276                        Close/A
277                        Abort "no data file was written"
278                Endif
279                //Print "dialog fullpath = ",fullpath
280        Endif
281       
282        //cleanup the filename passed in from Protocol...
283        String oldStr="",newStr="",pathStr=""
284        oldStr=GetFileNameFromPathNoSemi(fullPath)      //just the filename
285        pathStr=GetPathStrFromfullName(fullPath)        //just the path
286       
287        newStr = CleanupName(oldStr, 0 )                                //filename with _EXT rather than .EXT
288        fullPath=pathStr+newStr+".png"                          //tack on the png extension
289       
290        print "type=",type
291        //graph the current data and save a little graph
292        Wave data =  $("root:Packages:NIST:"+type+":data")
293        Wave q_x_axis = $"root:myGlobals:q_x_axis"
294        Wave q_y_axis = $"root:myGlobals:q_y_axis"
295        Wave NIHColors = $"root:myGlobals:NIHColors"
296       
297        NewImage/F data
298        DoWindow/C temp_PNG
299        ModifyImage data cindex= NIHColors
300        AppendToGraph/R q_y_axis
301        ModifyGraph tkLblRot(right)=90,lowTrip(right)=0.001
302        AppendToGraph/T q_x_axis
303        ModifyGraph lowTrip(top)=0.001,standoff=0,mode=2
304        ModifyGraph fSize(right)=9,fSize(top)=9,btLen=3
305       
306//      ModifyGraph nticks=0
307       
308//      WaveStats/Q data
309//      ScaleColorsToData(V_min, V_max, NIHColors)
310
311// ***comment out for DEMO_MODIFIED version
312        SavePict/Z/E=-5/B=144 as fullPath                       //PNG at 2x screen resolution
313//***
314
315        Print "Saved graphic as ",newStr+".png"
316        DoWindow/K temp_PNG
317End
318
319//****************
320//Testing only , not called
321Proc Fast_ASCII_2D_Export(type,term)
322        String type,term
323        Prompt type,"2-D data type for Export",popup,"SAM;EMP;BGD;DIV;COR;CAL;RAW;ABS;MSK;"
324        Prompt term,"line termination",popup,"CR;LF;CRLF;"
325       
326        //terminator is currently ignored
327        Fast2dExport(type,"",1)
328       
329End
330
331//the default termination for the platform is used...
332//if RAW export, sets "dummy" protocol to "RAW data export"
333Function Fast2dExport(type,fullpath,dialog)
334        String type,fullpath
335        Variable dialog         //=1 will present dialog for name
336               
337        String destStr="",ave="C",typeStr=""
338        Variable step=1,refnum
339        destStr = "root:Packages:NIST:"+type
340       
341        //must select the linear_data to export
342        // can't export log data if there are -ve intensities from a subtraction
343        NVAR isLog = $(destStr+":gIsLogScale")
344        if(isLog==1)
345                typeStr = ":linear_data"
346        else
347                typeStr = ":data"
348        endif
349       
350        NVAR pixelsX = root:myGlobals:gNPixelsX
351        NVAR pixelsY = root:myGlobals:gNPixelsY
352       
353        Wave data=$(destStr+typeStr)
354        WAVE intw=$(destStr + ":integersRead")
355        WAVE rw=$(destStr + ":realsRead")
356        WAVE/T textw=$(destStr + ":textRead")
357
358        SVAR gProtoStr = root:myGlobals:Protocols:gProtoStr
359        String rawTag=""
360        if(cmpstr(type,"RAW")==0)
361                Make/O/T/N=8 proto={"none","none","none","none","none","none","none","none"}
362                RawTag = "RAW Data File: "     
363        else
364                Wave/T proto=$("root:myGlobals:Protocols:"+gProtoStr)
365        endif
366        SVAR samFiles = $("root:Packages:NIST:"+type+":fileList")
367        //check each wave - MUST exist, or will cause a crash
368        If(!(WaveExists(data)))
369                Abort "data DNExist AsciiExport()"
370        Endif
371        If(!(WaveExists(intw)))
372                Abort "intw DNExist AsciiExport()"
373        Endif
374        If(!(WaveExists(rw)))
375                Abort "rw DNExist AsciiExport()"
376        Endif
377        If(!(WaveExists(textw)))
378                Abort "textw DNExist AsciiExport()"
379        Endif
380        If(!(WaveExists(proto)))
381                Abort "current protocol wave DNExist AsciiExport()"
382        Endif
383       
384        if(dialog)
385                PathInfo/S catPathName
386                fullPath = DoSaveFileDialog("Save data as")
387                If(cmpstr(fullPath,"")==0)
388                        //user cancel, don't write out a file
389                        Close/A
390                        Abort "no data file was written"
391                Endif
392                //Print "dialog fullpath = ",fullpath
393        Endif
394       
395/////////
396        Variable numTextLines=18
397        Make/O/T/N=(numTextLines) labelWave
398        labelWave[0] = "FILE: "+textw[0]+"   CREATED: "+textw[1]
399        labelWave[1] = "LABEL: "+textw[6]
400        labelWave[2] = "MON CNT   LAMBDA(A)   DET_OFF(cm)   DET_DIST(m)   TRANS   THICK(cm)    COUNT TIME"
401        labelWave[3] = num2str(rw[0])+"  "+num2str(rw[26])+"       "+num2str(rw[19])+"     "+num2str(rw[18])
402        labelWave[3] += "     "+num2str(rw[4])+"     "+num2str(rw[5])+"     "+num2str(intw[2])
403        labelWave[4] = "BCENT(X,Y)   A1(mm)   A2(mm)   A1A2DIST(m)   DL/L   BSTOP(mm)   DET_TYP  "
404        labelWave[5] = num2str(rw[16])+"  "+num2str(rw[17])+"  "+num2str(rw[23])+"  "+num2str(rw[24])+"  "
405        labelWave[5] += num2str(rw[25])+"  "+num2str(rw[27])+"  "+num2str(rw[21])+"  "+textW[9]
406        labelWave[6] = "PIXELS(X)    PIXELS(Y)   PIXELSIZE X (mm)  PIXELSIZE Y (mm)"
407        labelWave[7] += num2str(pixelsX)+"    "+num2str(pixelsY)+"    "+num2str(rw[10])+"    "+num2str(rw[13])
408        labelWave[8] =  "SAM: "+rawTag+samFiles
409        labelWave[9] =  "BGD: "+proto[0]
410        labelWave[10] =  "EMP: "+proto[1]
411        labelWave[11] =  "DIV: "+proto[2]
412        labelWave[12] =  "MASK: "+proto[3]
413        labelWave[13] =  "ABS Parameters (3-6): "+proto[4]
414        labelWave[14] = "Average Choices: "+proto[5]
415        labelWave[15] = ""
416        labelWave[16] = "*** Data written from "+type+" folder and may not be a fully corrected data file ***"
417        labelWave[17] = "The detector image is a standard X-Y coordinate system"
418        labelWave[18] = "Data is written by row, starting with Y=1 and X=(1->128)"
419        //labelWave[19] = "ASCII data created " +date()+" "+time()
420        PathInfo catPathName
421        String sfPath = S_Path+StringFromList(0,samfiles,";")
422        print sfPath
423        labelWave[19] = "RAW SAM FILE "+StringFromList(0, samfiles  , ";")+ " TIMESTAMP: "+getFileCreationDate(sfPath)
424       
425        //strings can be too long to print-- must trim to 255 chars
426        Variable ii
427        for(ii=0;ii<numTextLines;ii+=1)
428                labelWave[ii] = (labelWave[ii])[0,240]
429        endfor
430//      If(cmpstr(term,"CR")==0)
431//              termStr = "\r"
432//      Endif
433//      If(cmpstr(term,"LF")==0)
434//              termStr = "\n"
435//      Endif
436//      If(cmpstr(term,"CRLF")==0)
437//              termStr = "\r\n"
438//      Endif
439       
440        Duplicate/O data,spWave         
441        Redimension/S/N=(pixelsX*pixelsY) spWave                //single precision (/S)
442       
443        //not demo- compatible, but approx 100x faster!!
444       
445// for some reason, Igor 6.10 barfs on this and the Save operation gives an out-of-memory error!
446// so for now, go back to the old way...
447
448//#if(cmpstr(stringbykey("IGORKIND",IgorInfo(0),":",";"),"pro") == 0)
449//      Save/G/M="\r\n" labelWave,spWave as fullPath
450//#else
451        Open refNum as fullpath
452        wfprintf refNum,"%s\r\n",labelWave
453        fprintf refnum,"\r\n"
454        wfprintf refNum,"%g\r\n",spWave
455        Close refNum
456//#endif
457
458        Killwaves/Z spWave,labelWave            //don't delete proto!
459       
460        Print "2D ASCII File written: ", GetFileNameFromPathNoSemi(fullPath)
461       
462        return(0)
463End
464
465
466//// ASCII EXPORT in detector coordinates - mimicking the VAX CONVERT command
467// this is done simply to be able to produce converted raw data files that can be
468// read in with Grasp. A rather awkward structure, definitely not the preferred export format
469//
470// SRK 14 NOV 07
471//
472Function Fast2dExport_OldStyle(type,fullpath,dialog)
473        String type,fullpath
474        Variable dialog         //=1 will present dialog for name
475               
476        String destStr=""
477        String typeStr=""
478        Variable refnum
479       
480        destStr = "root:Packages:NIST:"+type
481       
482        //must select the linear_data to export
483        // can't export log data if there are -ve intensities from a subtraction
484        NVAR isLog = $(destStr+":gIsLogScale")
485        if(isLog==1)
486                typeStr = ":linear_data"
487        else
488                typeStr = ":data"
489        endif
490       
491        NVAR pixelsX = root:myGlobals:gNPixelsX
492        NVAR pixelsY = root:myGlobals:gNPixelsY
493       
494        Wave data=$(destStr+typeStr)
495        WAVE intw=$(destStr + ":integersRead")
496        WAVE rw=$(destStr + ":realsRead")
497        WAVE/T textw=$(destStr + ":textRead")
498
499        //check each wave - MUST exist, or will cause a crash
500        If(!(WaveExists(data)))
501                Abort "data DNExist AsciiExport()"
502        Endif
503        If(!(WaveExists(intw)))
504                Abort "intw DNExist AsciiExport()"
505        Endif
506        If(!(WaveExists(rw)))
507                Abort "rw DNExist AsciiExport()"
508        Endif
509        If(!(WaveExists(textw)))
510                Abort "textw DNExist AsciiExport()"
511        Endif
512
513        if(dialog)
514                PathInfo/S catPathName
515                fullPath = DoSaveFileDialog("Save data as")
516                If(cmpstr(fullPath,"")==0)
517                        //user cancel, don't write out a file
518                        Close/A
519                        Abort "no data file was written"
520                Endif
521                //Print "dialog fullpath = ",fullpath
522        Endif
523       
524/////////
525        String tmpStr=""
526        Variable numTextLines=17
527        Make/O/T/N=(numTextLines) labelWave
528       
529//      sprintf tmpStr," '%s'   '%s'   '%s'",textw[0],textw[1],textw[2]
530        sprintf tmpStr," '%s'        '%s'        '%s'     'SAn''ABC''A123'",GetFileNameFromPathNoSemi(fullPath),textw[1],textw[2]
531        labelWave[0] = tmpStr
532        labelWave[1] = " "+textw[6]             //label
533       
534//      sprintf tmpStr," %d  %g  %g  %g",intw[2],rw[0],rw[39],rw[2]
535        sprintf tmpStr," %6d        %13.5E     %13.5E     %13.5E",intw[2],rw[0],rw[39],rw[2]
536        labelWave[2] = tmpStr
537        labelWave[3] = " Cnt.Time(sec.)    Mon. Cnt.      Trans. Det. Cnt.  Tot. Det. Cnt."
538       
539//      sprintf tmpStr," %g  %g  %g '%s' %g '%s' %d  %d  %g",rw[4],rw[5],rw[8],textw[7],rw[9],textw[8],intw[4],intw[5],rw[6]
540        sprintf tmpStr,"%10.3g   %9.2g%8.2f '%6s'%8.2f '%6s'%7d%7d%7.2f",rw[4],rw[5],rw[8],textw[7],rw[9],textw[8],intw[4],intw[5],rw[6]
541        labelWave[4] = tmpStr
542        labelWave[5] = " Trans.      Thckns       Temp.           H Field         Table  Holder  Pos"
543       
544//      sprintf tmpStr," %g  %g  %d  '%s'  %g",rw[26],rw[27],intw[9],textw[9],rw[7]
545        sprintf tmpStr," %8.2f        %5.2f          %2d   '%6s'          %6.2f",rw[26],rw[27],intw[9],textw[9],rw[7]
546        labelWave[6] = tmpStr
547        labelWave[7] = " Wavelength &  Spread(FWHM)    Det.#  Type      Sample Rotation Angle"
548       
549//      sprintf tmpStr," %g  %g  %g  %g  %g  %g",rw[18],rw[19],rw[16],rw[17],rw[21],rw[3]
550        sprintf tmpStr," %12.2f%12.2f          %6.2f  %6.2f  %10.2f        %4.1f",rw[18],rw[19],rw[16],rw[17],rw[21],rw[3]
551        labelWave[8] = tmpStr
552        labelWave[9] = " Sam-Det Dis.(m)   Det.Ang.(cm.)   Beam Center(x,y)  Beam Stop(mm)  Atten.No."
553       
554//      sprintf tmpStr," %g  %g  %g  %g  %g  %g",rw[10],rw[11],rw[12],rw[13],rw[14],rw[15]
555        sprintf tmpStr," %8.3f      %10.4E  %10.4E%8.3f      %10.4E  %10.4E",rw[10],rw[11],rw[12],rw[13],rw[14],rw[15]
556        labelWave[10] = tmpStr
557        labelWave[11] = "        Det. Calib Consts. (x)           Det. Calib Consts. (y)"
558       
559//      sprintf tmpStr," %g  %g  %g  '%s'  %g  %g",rw[23],rw[24],rw[25],"    F",rw[45],rw[46]
560        sprintf tmpStr,"%12.2f%12.2f%12.2f      '%s'%8.2f    %8.2f",rw[23],rw[24],rw[25],"     F",rw[45],rw[46]
561        labelWave[12] = tmpStr
562        labelWave[13] = " Aperture (A1,A2) Sizes(mm)    Sep.(m)    Flip ON   Horiz. and Vert. Cur.(amps)"
563       
564//      sprintf tmpStr," %d  %d  %d  %d  %g  %g  %g",intw[19],intw[20],intw[21],intw[22],rw[47],rw[48],rw[49]
565        sprintf tmpStr,"%6d%6d%6d%6d%10.3f%10.6f%10.6f",intw[19],intw[20],intw[21],intw[22],rw[47],rw[48],rw[49]
566        labelWave[14] = tmpStr
567        labelWave[15] = "      Rows        Cols       Factor   Qmin      Qmax"
568       
569        labelWave[16] = " Packed Counts by Rows (L -> R) and Top -> Bot"
570         
571        //strings can be too long to print-- must trim to 255 chars
572        Variable ii
573        for(ii=0;ii<numTextLines;ii+=1)
574                labelWave[ii] = (labelWave[ii])[0,240]
575        endfor
576       
577        Duplicate/O data,spWave         
578        Redimension/S/N=(pixelsX*pixelsY) spWave                //single precision (/S)
579       
580//      now need to convert the wave of data points into row of no more than 80 characters
581// per row, comma delimited, not splitting any values
582        Make/O/T/N=0 tw
583       
584        Variable sPt,ePt,ind=0,len
585        sPt=0
586        ePt=0
587        len = pixelsX*pixelsY
588        do
589                tmpStr = Fill80Chars(spWave,sPt,ePt,len)
590                InsertPoints ind, 1, tw
591                tw[ind]=tmpStr
592                ind+=1
593//              Print "at top, ePt = ",ePt
594                sPt=ePt
595        while(ePt<len)
596               
597        Open refNum as fullpath
598        wfprintf refNum,"%s\r",labelWave                        //VAX uses just \r
599        wfprintf refNum,"%s\r",tw
600        Close refNum
601       
602        Killwaves/Z spWave,labelWave,tw         //clean up
603       
604        Print "2D ASCII File written for Grasp: ", GetFileNameFromPathNoSemi(fullPath)
605       
606        return(0)
607End
608
609Function/S Fill80chars(w,sPt,ePt,len)
610        Wave w
611        Variable sPt,&ePt,len
612       
613        String retStr
614        Variable numChars=1,numPt=0
615       
616        retStr = " "            //lines start with a space
617        do
618                if( (numChars + strlen(num2str(w[sPt+numPt])) + 1 <= 80)         && (sPt + numPt) < len )
619                        retStr += num2str(w[sPt+numPt]) +","
620                        numChars += strlen(num2str(w[sPt+numPt])) + 1
621                        numPt += 1
622                else
623                        // pad to 80 chars
624                        ePt = sPt + numPt
625                        //printf "%d : ", strlen(retstr)
626                        if(strlen(retStr) < 80)
627                                do
628                                        retStr += " "
629                                while(strlen(retStr) < 80)
630                        endif
631                        //Print strlen(retStr),sPt,ePt," : ",retstr
632                        break
633                endif
634        while(1)
635       
636        return(retStr)
637End
638
639//// end ASCII - old style export procedures
640
641
642// NEW additions - May 2009
643//ASCII export of data as 7-columns qx-qy-Intensity-qz-sigmaQ_parall-sigmaQ_perp-fShad
644//limited header information?
645//
646// *** DEC 2009 ***
647// Removed the SAVE of the 2D resolution waves - I'm not sure they are correct. Can't verify the
648// smearing of the 2D data yet. For a future minor release...
649// -- when the Qz and resolution are written, be sure to change the tw[15] in the header back to the
650//              proper labels
651// - May 2010:
652// now the smearing is correct, and is now defined in terms of Q_parallel and Q_perpendicular
653//
654// - June 2010:
655// TEMPORARY - I've added "fake" error that is sqrt(value). It really needs to be propogated
656//  in a more correct way, but this is at least a placeholder for the error column
657//
658// - creates the qx and qy data here, based on the data and header information
659//
660// Need to ensure that the data being exported is the linear copy of the dataset - check the global
661//
662Function QxQy_Export(type,fullpath,dialog)
663        String type,fullpath
664        Variable dialog         //=1 will present dialog for name
665       
666        String destStr="",typeStr=""
667        Variable step=1,refnum
668        destStr = "root:Packages:NIST:"+type
669       
670        //must select the linear_data to export
671        NVAR isLog = $(destStr+":gIsLogScale")
672        if(isLog==1)
673                typeStr = ":linear_data"
674        else
675                typeStr = ":data"
676        endif
677       
678        NVAR pixelsX = root:myGlobals:gNPixelsX
679        NVAR pixelsY = root:myGlobals:gNPixelsY
680       
681        Wave data=$(destStr+typeStr)
682        WAVE intw=$(destStr + ":integersRead")
683        WAVE rw=$(destStr + ":realsRead")
684        WAVE/T textw=$(destStr + ":textRead")
685
686        SVAR gProtoStr = root:myGlobals:Protocols:gProtoStr
687        String rawTag=""
688        if(cmpstr(type,"RAW")==0)
689                Make/O/T/N=8 proto={"none","none","none","none","none","none","none","none"}
690                RawTag = "RAW Data File: "     
691        else
692                Wave/T proto=$("root:myGlobals:Protocols:"+gProtoStr)
693        endif
694        SVAR samFiles = $("root:Packages:NIST:"+type+":fileList")
695        //check each wave - MUST exist, or will cause a crash
696        If(!(WaveExists(data)))
697                Abort "data DNExist QxQy_Export()"
698        Endif
699        If(!(WaveExists(intw)))
700                Abort "intw DNExist QxQy_Export()"
701        Endif
702        If(!(WaveExists(rw)))
703                Abort "rw DNExist QxQy_Export()"
704        Endif
705        If(!(WaveExists(textw)))
706                Abort "textw DNExist QxQy_Export()"
707        Endif
708        If(!(WaveExists(proto)))
709                Abort "current protocol wave DNExist QxQy_Export()"
710        Endif
711       
712        if(dialog)
713                PathInfo/S catPathName
714                fullPath = DoSaveFileDialog("Save data as")
715                If(cmpstr(fullPath,"")==0)
716                        //user cancel, don't write out a file
717                        Close/A
718                        Abort "no data file was written"
719                Endif
720                //Print "dialog fullpath = ",fullpath
721        Endif
722       
723/////////
724        Variable numTextLines=18
725        Make/O/T/N=(numTextLines) labelWave
726        labelWave[0] = "FILE: "+textw[0]+"   CREATED: "+textw[1]
727        labelWave[1] = "LABEL: "+textw[6]
728        labelWave[2] = "MON CNT   LAMBDA (A)  DET_OFF(cm)   DET_DIST(m)   TRANS   THICK(cm)"
729        labelWave[3] = num2str(rw[0])+"  "+num2str(rw[26])+"       "+num2str(rw[19])+"     "+num2str(rw[18])
730        labelWave[3] += "     "+num2str(rw[4])+"     "+num2str(rw[5])
731        labelWave[4] = "BCENT(X,Y)   A1(mm)   A2(mm)   A1A2DIST(m)   DL/L   BSTOP(mm)   DET_TYP  "
732        labelWave[5] = num2str(rw[16])+"  "+num2str(rw[17])+"  "+num2str(rw[23])+"    "+num2str(rw[24])+"    "
733        labelWave[5] += num2str(rw[25])+"    "+num2str(rw[27])+"    "+num2str(rw[21])+"    "+textW[9]
734        labelWave[6] =  "SAM: "+rawTag+samFiles
735        labelWave[7] =  "BGD: "+proto[0]
736        labelWave[8] =  "EMP: "+proto[1]
737        labelWave[9] =  "DIV: "+proto[2]
738        labelWave[10] =  "MASK: "+proto[3]
739        labelWave[11] =  "ABS Parameters (3-6): "+proto[4]
740        labelWave[12] = "Average Choices: "+proto[5]
741        labelWave[13] = ""
742        labelWave[14] = "*** Data written from "+type+" folder and may not be a fully corrected data file ***"
743//      labelWave[15] = "Data columns are Qx - Qy - I(Qx,Qy)"
744//      labelWave[15] = "Data columns are Qx - Qy - I(Qx,Qy) - Qz - SigmaQ_parall - SigmaQ_perp - fSubS(beam stop shadow)"
745        labelWave[15] = "Data columns are Qx - Qy - I(Qx,Qy) - err(I) - Qz - SigmaQ_parall - SigmaQ_perp - fSubS(beam stop shadow)"
746        labelWave[16] = "ERROR WAVE IS ONLY AN ESTIMATE  - 6/2010"
747        labelWave[17] = "ASCII data created " +date()+" "+time()
748        //strings can be too long to print-- must trim to 255 chars
749        Variable ii,jj
750        for(ii=0;ii<numTextLines;ii+=1)
751                labelWave[ii] = (labelWave[ii])[0,240]
752        endfor
753//      If(cmpstr(term,"CR")==0)
754//              termStr = "\r"
755//      Endif
756//      If(cmpstr(term,"LF")==0)
757//              termStr = "\n"
758//      Endif
759//      If(cmpstr(term,"CRLF")==0)
760//              termStr = "\r\n"
761//      Endif
762       
763        Duplicate/O data,qx_val,qy_val,z_val,qval,qz_val,phi,r_dist
764       
765//      Redimension/N=(pixelsX*pixelsY) qx_val,qy_val,z_val
766//      MyMat2XYZ(data,qx_val,qy_val,z_val)             //x and y are [p][q] indexes, not q-vals yet
767       
768        Variable xctr,yctr,sdd,lambda,pixSize
769        xctr = rw[16]
770        yctr = rw[17]
771        sdd = rw[18]
772        lambda = rw[26]
773        pixSize = rw[13]/10             //convert mm to cm (x and y are the same size pixels)
774       
775        qx_val = CalcQx(p+1,q+1,rw[16],rw[17],rw[18],rw[26],rw[13]/10)          //+1 converts to detector coordinate system
776        qy_val = CalcQy(p+1,q+1,rw[16],rw[17],rw[18],rw[26],rw[13]/10)
777       
778        Redimension/N=(pixelsX*pixelsY) qx_val,qy_val,z_val
779
780///************
781// do everything to write out the resolution too
782        // un-comment these if you want to write out qz_val and qval too, then use the proper save command
783        qval = CalcQval(p+1,q+1,rw[16],rw[17],rw[18],rw[26],rw[13]/10)
784        qz_val = CalcQz(p+1,q+1,rw[16],rw[17],rw[18],rw[26],rw[13]/10)
785        phi = FindPhi( pixSize*((p+1)-xctr) , pixSize*((q+1)-yctr))             //(dx,dy)
786        r_dist = sqrt(  (pixSize*((p+1)-xctr))^2 +  (pixSize*((q+1)-yctr))^2 )          //radial distance from ctr to pt
787        Redimension/N=(pixelsX*pixelsY) qz_val,qval,phi,r_dist
788        //everything in 1D now
789        Duplicate/O qval SigmaQX,SigmaQY,fsubS
790
791        Variable L2 = rw[18]
792        Variable BS = rw[21]
793        Variable S1 = rw[23]
794        Variable S2 = rw[24]
795        Variable L1 = rw[25]
796        Variable lambdaWidth = rw[27]   
797        Variable usingLenses = rw[28]           //new 2007
798
799        //Two parameters DDET and APOFF are instrument dependent.  Determine
800        //these from the instrument name in the header.
801        //From conversation with JB on 01.06.99 these are the current good values
802        Variable DDet
803        NVAR apOff = root:myGlobals:apOff               //in cm
804        DDet = rw[10]/10                        // header value (X) is in mm, want cm here
805
806        Variable ret1,ret2,ret3,nq
807        nq = pixelsX*pixelsY
808        ii=0
809       
810        do
811                get2DResolution(qval[ii],phi[ii],lambda,lambdaWidth,DDet,apOff,S1,S2,L1,L2,BS,pixSize,usingLenses,r_dist[ii],ret1,ret2,ret3)
812                SigmaQX[ii] = ret1     
813                SigmaQY[ii] = ret2     
814                fsubs[ii] = ret3       
815                ii+=1
816        while(ii<nq)   
817
818//*********************
819
820        // generate my own error wave for I(qx,qy)
821        Duplicate/O z_val sw
822        sw = sqrt(z_val)                //assumes Poisson statistics for each cell (counter)
823        //      sw = 0.05*sw            // uniform 5% error? tends to favor the low intensity too strongly
824        // get rid of the "bad" errorsby replacing the NaN, Inf, and zero with V_avg
825        // THIS IS EXTREMEMLY IMPORTANT - if this is not done, there are some "bad" values in the
826        // error wave (things that are not numbers) - and this wrecks the smeared model fitting.
827        // It appears to have no effect on the unsmeared model.
828        WaveStats/Q sw
829        sw = numtype(sw[p]) == 0 ? sw[p] : V_avg
830        sw = sw[p] != 0 ? sw[p] : V_avg
831       
832
833        //not demo-compatible, but approx 8x faster!!   
834#if(cmpstr(stringbykey("IGORKIND",IgorInfo(0),":",";"),"pro") == 0)
835        Duplicate/O qx_val,qx_val_s
836        Duplicate/O qy_val,qy_val_s
837        Duplicate/O qz_val,qz_val_s
838        Duplicate/O z_val,z_val_s
839        Duplicate/O SigmaQx,sigmaQx_s
840        Duplicate/O SigmaQy,sigmaQy_s
841        Duplicate/O fSubS,fSubS_s
842        Duplicate/O sw,sw_s
843       
844        //so that double precision is not written ou
845        Redimension/S qx_val_s,qy_val_s,qz_val_s,z_val_s,sigmaQx_s,sigmaQy_s,fSubS_s,sw_s
846       
847//      Save/G/M="\r\n" labelWave,qx_val,qy_val,z_val as fullpath       // without resolution
848        Save/G/M="\r\n" labelWave,qx_val_s,qy_val_s,z_val_s,sw_s,qz_val_s,SigmaQx_s,SigmaQy_s,fSubS_s as fullpath       // write out the resolution information
849#else
850        Open refNum as fullpath
851        wfprintf refNum,"%s\r\n",labelWave
852        fprintf refnum,"\r\n"
853//      wfprintf refNum,"%8g\t%8g\t%8g\r\n",qx_val,qy_val,z_val
854        wfprintf refNum,"%8g\t%8g\t%8g\t%8g\t%8g\t%8g\t%8g\t%8g\r\n",qx_val,qy_val,z_val,sw,qz_val,SigmaQx,SigmaQy,fSubS
855        Close refNum
856#endif
857       
858        KillWaves/Z qx_val_s,qy_val_s,z_val_s,qz_val_s,SigmaQx_s,SigmaQy_s,fSubS_s
859       
860        Killwaves/Z spWave,labelWave,qx_val,qy_val,z_val,qval,qz_val,sigmaQx,SigmaQy,fSubS,phi,r_dist
861       
862        Print "QxQy_Export File written: ", GetFileNameFromPathNoSemi(fullPath)
863        return(0)
864
865End
866
867
868//Function MyMat2XYZ(mat,xw,yw,zw)
869//      WAVE mat,xw,yw,zw
870//
871//      NVAR pixelsX = root:myGlobals:gNPixelsX
872//      NVAR pixelsY = root:myGlobals:gNPixelsY
873//     
874//      xw= mod(p,pixelsX)              // X varies quickly
875//      yw= floor(p/pixelsY)    // Y varies slowly
876//      zw= mat(xw[p])(yw[p])
877//
878//End
879
880//converts xyz triple to a matrix
881//MAJOR assumption is that the x and y-spacings are LINEAR
882// (ok for small-angle approximation)
883//
884// currently unused
885//
886Function LinXYZToMatrix(xw,yw,zw,matStr)
887        WAVE xw,yw,zw
888        String matStr
889       
890        NVAR pixelsX = root:myGlobals:gNPixelsX
891        NVAR pixelsY = root:myGlobals:gNPixelsY
892        //mat is "zw" redimensioned to a matrix
893        Make/O/N=(pixelsX*pixelsY) $matStr
894        WAVE mat=$matStr
895        mat=zw
896        Redimension/N=(pixelsX,pixelsY) mat
897        WaveStats/Q xw
898        SetScale/I x, V_min, V_max, "",mat
899        WaveStats/Q yw
900        SetScale/I y, V_min, V_max, "",mat
901       
902        Display;Appendimage mat
903        ModifyGraph lowTrip=0.0001
904        ModifyGraph width={Plan,1,bottom,left},height={Plan,1,left,bottom}
905        ModifyImage $matStr ctab={*,*,YellowHot,0}
906       
907        return(0)
908End
Note: See TracBrowser for help on using the repository browser.