source: sans/Dev/trunk/NCNR_User_Procedures/Reduction/SANS/NCNR_DataReadWrite.ipf @ 472

Last change on this file since 472 was 472, checked in by srkline, 14 years ago

A large number of changes and fixes:

--168/169/170: panels and windows are now at least on-screen for all packages. Tested
with 1024x768 resolution.
-- closed ticket 176 which was a question about resampling data to generate error estimates
on fitted parameters. Useful for reflectometry, not needed for SANS.
--157: bug of low Q power law extrapolation in Invariant fixed by avoiding q==0
--178/180: Tr/Tw? notification in USANS. log/lin checkbox for display.
--167: saveData checkbox for USANS not behaving well. turns off/on better now.
--197: changed all (?) 1D writing routines to enforce 26 characters as the maximum length
to make sure that file loading will never exceed 31 characters

-- lots of changes to MonteCarlo? and SASCALC

  • SASCALC now enforces *exact* lens conditions, rather than a close approximation
  • improved MonteCarlo? interface panel
  • added writer for simlulated VAX binary data file
  • can save 2D as ABS or raw counts
  • can freeze w/no offset
File size: 56.9 KB
Line 
1#pragma rtGlobals=1             // Use modern global access method.
2#pragma version=5.0
3#pragma IgorVersion = 6.0
4
5//**************************
6//
7// Vers. 1.2 092101
8// Vers. 5.0 29MAR07 - branched from main reduction to split out facility
9//                     specific calls
10//
11// functions for reading raw data files from the VAX
12// - RAW data files are read into the RAW folder - integer data from the detector
13//   is decompressed and given the proper orientation
14// - header information is placed into real,integer, or text waves in the order they appear
15//   in the file header
16//
17// Work data (DIV File) is read into the DIV folder
18//
19//*****************************
20
21//simple, main entry procedure that will load a RAW sans data file (not a work file)
22//into the RAW dataFolder. It is up to the calling procedure to display the file
23//
24// called by MainPanel.ipf and ProtocolAsPanel.ipf
25//
26Function LoadRawSANSData(msgStr)
27        String msgStr
28
29        String filename=""
30
31        //each routine is responsible for checking the current (displayed) data folder
32        //selecting it, and returning to root when done
33        PathInfo/S catPathName          //should set the next dialog to the proper path...
34        //get the filename, then read it in
35        filename = PromptForPath(msgStr)                //in SANS_Utils.ipf
36        //check for cancel from dialog
37        if(strlen(filename)==0)
38                //user cancelled, abort
39                SetDataFolder root:
40                DoAlert 0, "No file selected, action aborted"
41                return(1)
42        Endif
43        //Print  "GetFileNameFromPath(filename) = " +  GetFileNameFromPathNoSemi(filename)
44        ReadHeaderAndData(filename)     //this is the full Path+file
45
46///***** done by a call to UpdateDisplayInformation()
47//      //the calling macro must change the display type
48//      String/G root:myGlobals:gDataDisplayType="RAW"          //displayed data type is raw
49//     
50//      //data is displayed here
51//      fRawWindowHook()
52       
53        Return(0)
54End
55
56
57//function that does the guts of reading the binary data file
58//fname is the full path:name;vers required to open the file
59//VAX record markers are skipped as needed
60//VAX data as read in is in compressed I*2 format, and is decompressed
61//immediately after being read in. The final root:Packages:NIST:RAW:data wave is the real
62//neutron counts and can be directly operated on
63//
64// header information is put into three waves: integersRead, realsRead, and textRead
65// logicals in the header are currently skipped, since they are no use in the
66// data reduction process.
67//
68// The output is the three R/T/I waves that are filled at least with minimal values
69// and the detector data loaded into an array named "data"
70//
71// see documentation for the expected information in each element of the R/T/I waves
72// and the minimum set of information. These waves can be increased in length so that
73// more information can be accessed as needed (propagating changes...)
74//
75// called by multiple .ipfs (when the file name is known)
76//
77Function ReadHeaderAndData(fname)
78        String fname
79        //this function is for reading in RAW data only, so it will always put data in RAW folder
80        String curPath = "root:Packages:NIST:RAW:"
81        SetDataFolder curPath           //use the full path, so it will always work
82        Variable/G root:Packages:NIST:RAW:gIsLogScale = 0               //initial state is linear, keep this in RAW folder
83       
84        Variable refNum,integer,realval
85        String sansfname,textstr
86       
87        Make/O/N=23 $"root:Packages:NIST:RAW:IntegersRead"
88        Make/O/N=52 $"root:Packages:NIST:RAW:RealsRead"
89        Make/O/T/N=11 $"root:Packages:NIST:RAW:TextRead"
90       
91        Wave intw=$"root:Packages:NIST:RAW:IntegersRead"
92        Wave realw=$"root:Packages:NIST:RAW:RealsRead"
93        Wave/T textw=$"root:Packages:NIST:RAW:TextRead"
94       
95        //***NOTE ****
96        // the "current path" gets mysteriously reset to "root:" after the SECOND pass through
97        // this read routine, after the open dialog is presented
98        // the "--read" waves end up in the correct folder, but the data does not! Why?
99        //must re-set data folder before writing data array (done below)
100       
101        //full filename and path is now passed in...
102        //actually open the file
103        Open/R refNum as fname
104        //skip first two bytes (VAX record length markers, not needed here)
105        FSetPos refNum, 2
106        //read the next 21 bytes as characters (fname)
107        FReadLine/N=21 refNum,textstr
108        textw[0]= textstr
109        //read four i*4 values  /F=3 flag, B=3 flag
110        FBinRead/F=3/B=3 refNum, integer
111        intw[0] = integer
112        //
113        FBinRead/F=3/B=3 refNum, integer
114        intw[1] = integer
115        //
116        FBinRead/F=3/B=3 refNum, integer
117        intw[2] = integer
118        //
119        FBinRead/F=3/B=3 refNum, integer
120        intw[3] = integer
121        // 6 text fields
122        FSetPos refNum,55               //will start reading at byte 56
123        FReadLine/N=20 refNum,textstr
124        textw[1]= textstr
125        FReadLine/N=3 refNum,textstr
126        textw[2]= textstr
127        FReadLine/N=11 refNum,textstr
128        textw[3]= textstr
129        FReadLine/N=1 refNum,textstr
130        textw[4]= textstr
131        FReadLine/N=8 refNum,textstr
132        textw[5]= textstr
133        FReadLine/N=60 refNum,textstr
134        textw[6]= textstr
135       
136        //3 integers
137        FSetPos refNum,174
138        FBinRead/F=3/B=3 refNum, integer
139        intw[4] = integer
140        FBinRead/F=3/B=3 refNum, integer
141        intw[5] = integer
142        FBinRead/F=3/B=3 refNum, integer
143        intw[6] = integer
144       
145        //2 integers, 3 text fields
146        FSetPos refNum,194
147        FBinRead/F=3/B=3 refNum, integer
148        intw[7] = integer
149        FBinRead/F=3/B=3 refNum, integer
150        intw[8] = integer
151        FReadLine/N=6 refNum,textstr
152        textw[7]= textstr
153        FReadLine/N=6 refNum,textstr
154        textw[8]= textstr
155        FReadLine/N=6 refNum,textstr
156        textw[9]= textstr
157       
158        //2 integers
159        FSetPos refNum,244
160        FBinRead/F=3/B=3 refNum, integer
161        intw[9] = integer
162        FBinRead/F=3/B=3 refNum, integer
163        intw[10] = integer
164       
165        //2 integers
166        FSetPos refNum,308
167        FBinRead/F=3/B=3 refNum, integer
168        intw[11] = integer
169        FBinRead/F=3/B=3 refNum, integer
170        intw[12] = integer
171       
172        //2 integers
173        FSetPos refNum,332
174        FBinRead/F=3/B=3 refNum, integer
175        intw[13] = integer
176        FBinRead/F=3/B=3 refNum, integer
177        intw[14] = integer
178       
179        //3 integers
180        FSetPos refNum,376
181        FBinRead/F=3/B=3 refNum, integer
182        intw[15] = integer
183        FBinRead/F=3/B=3 refNum, integer
184        intw[16] = integer
185        FBinRead/F=3/B=3 refNum, integer
186        intw[17] = integer
187       
188        //1 text field - the file association for transmission are the first 4 bytes
189        FSetPos refNum,404
190        FReadLine/N=42 refNum,textstr
191        textw[10]= textstr
192       
193        //1 integer
194        FSetPos refNum,458
195        FBinRead/F=3/B=3 refNum, integer
196        intw[18] = integer
197       
198        //4 integers
199        FSetPos refNum,478
200        FBinRead/F=3/B=3 refNum, integer
201        intw[19] = integer
202        FBinRead/F=3/B=3 refNum, integer
203        intw[20] = integer
204        FBinRead/F=3/B=3 refNum, integer
205        intw[21] = integer
206        FBinRead/F=3/B=3 refNum, integer
207        intw[22] = integer
208       
209        Close refNum
210       
211        //now get all of the reals
212        //
213        //Do all the GBLoadWaves at the end
214        //
215        //FBinRead Cannot handle 32 bit VAX floating point
216        //GBLoadWave, however, can properly read it
217        String GBLoadStr="GBLoadWave/O/N=tempGBwave/T={2,2}/J=2/W=1/Q"
218        String strToExecute
219        //append "/S=offset/U=numofreals" to control the read
220        // then append fname to give the full file path
221        // then execute
222       
223        Variable a=0,b=0
224       
225        SetDataFolder curPath
226       
227        // 4 R*4 values
228        strToExecute = GBLoadStr + "/S=39/U=4" + "\"" + fname + "\""
229        Execute strToExecute
230        Wave w=$"root:Packages:NIST:RAW:tempGBWave0"
231        b=4     //num of reals read
232        realw[a,a+b-1] = w[p-a]
233        a+=b
234       
235        // 4 R*4 values
236        SetDataFolder curPath
237        strToExecute = GBLoadStr + "/S=158/U=4" + "\"" + fname + "\""
238        Execute strToExecute
239        b=4     
240        realw[a,a+b-1] = w[p-a]
241        a+=b
242
243///////////
244        // 2 R*4 values
245        SetDataFolder curPath
246        strToExecute = GBLoadStr + "/S=186/U=2" + "\"" + fname + "\""
247        Execute strToExecute
248        b=2     
249        realw[a,a+b-1] = w[p-a]
250        a+=b
251
252        // 6 R*4 values
253        SetDataFolder curPath
254        strToExecute = GBLoadStr + "/S=220/U=6" + "\"" + fname + "\""
255        Execute strToExecute
256        b=6     
257        realw[a,a+b-1] = w[p-a]
258        a+=b
259       
260        // 13 R*4 values
261        SetDataFolder curPath
262        strToExecute = GBLoadStr + "/S=252/U=13" + "\"" + fname + "\""
263        Execute strToExecute
264        b=13
265        realw[a,a+b-1] = w[p-a]
266        a+=b
267       
268        // 3 R*4 values
269        SetDataFolder curPath
270        strToExecute = GBLoadStr + "/S=320/U=3" + "\"" + fname + "\""
271        Execute strToExecute
272        b=3     
273        realw[a,a+b-1] = w[p-a]
274        a+=b
275       
276        // 7 R*4 values
277        SetDataFolder curPath
278        strToExecute = GBLoadStr + "/S=348/U=7" + "\"" + fname + "\""
279        Execute strToExecute
280        b=7
281        realw[a,a+b-1] = w[p-a]
282        a+=b
283       
284        // 4 R*4 values
285        SetDataFolder curPath
286        strToExecute = GBLoadStr + "/S=388/U=4" + "\"" + fname + "\""
287        Execute strToExecute
288        b=4     
289        realw[a,a+b-1] = w[p-a]
290        a+=b
291       
292        // 2 R*4 values
293        SetDataFolder curPath
294        strToExecute = GBLoadStr + "/S=450/U=2" + "\"" + fname + "\""
295        Execute strToExecute
296        b=2
297        realw[a,a+b-1] = w[p-a]
298        a+=b
299       
300        // 2 R*4 values
301        SetDataFolder curPath
302        strToExecute = GBLoadStr + "/S=470/U=2" + "\"" + fname + "\""
303        Execute strToExecute
304        b=2
305        realw[a,a+b-1] = w[p-a]
306        a+=b
307       
308        // 5 R*4 values
309        SetDataFolder curPath
310        strToExecute = GBLoadStr + "/S=494/U=5" + "\"" + fname + "\""
311        Execute strToExecute
312        b=5     
313        realw[a,a+b-1] = w[p-a]
314       
315        //if the binary VAX data ws transferred to a MAC, all is OK
316        //if the data was trasnferred to an Intel machine (IBM), all the real values must be
317        //divided by 4 to get the correct floating point values
318        // I can't find any combination of settings in GBLoadWave or FBinRead to read data in correctly
319        // on an Intel machine.
320        //With the corrected version of GBLoadWave XOP (v. 1.43 or higher) Mac and PC both read
321        //VAX reals correctly, and no checking is necessary 12 APR 99
322        //if(cmpstr("Macintosh",IgorInfo(2)) == 0)
323                //do nothing
324        //else
325                //either Windows or Windows NT
326                //realw /= 4
327        //endif
328       
329        SetDataFolder curPath
330        //read in the data
331        strToExecute = "GBLoadWave/O/N=tempGBwave/B/T={16,2}/S=514/Q" + "\"" + fname + "\""
332        Execute strToExecute
333
334        SetDataFolder curPath           //use the full path, so it will always work
335       
336        Make/O/N=16384 $"root:Packages:NIST:RAW:data"
337        WAVE data=$"root:Packages:NIST:RAW:data"
338        SkipAndDecompressVAX(w,data)
339        Redimension/N=(128,128) data                    //NIST raw data is 128x128 - do not generalize
340       
341        //keep a string with the filename in the RAW folder
342        String/G root:Packages:NIST:RAW:fileList = textw[0]
343       
344        //set the globals to the detector dimensions (pixels)
345        Variable/G root:myGlobals:gNPixelsX=128         //default for Ordela data (also set in Initialize/NCNR_Utils.ipf)
346        Variable/G root:myGlobals:gNPixelsY=128
347//      if(cmpstr(textW[9],"ILL   ")==0)                //override if OLD Cerca data
348//              Variable/G root:myGlobals:gNPixelsX=64
349//              Variable/G root:myGlobals:gNPixelsY=64
350//      endif
351       
352        //clean up - get rid of w = $"root:Packages:NIST:RAW:tempGBWave0"
353//      KillWaves/Z w
354       
355        //return the data folder to root
356        SetDataFolder root:
357       
358        Return 0
359
360End
361
362
363//function to take the I*2 data that was read in, in VAX format
364//where the integers are "normal", but there are 2-byte record markers
365//sprinkled evenly through the data
366//there are skipped, leaving 128x128=16384 data values
367//the input array (in) is larger than 16384
368//(out) is 128x128 data (single precision) as defined in ReadHeaderAndData()
369//
370// local function to post-process compressed VAX binary data
371//
372//
373Function SkipAndDecompressVAX(in,out)
374        Wave in,out
375       
376        Variable skip,ii
377
378        ii=0
379        skip=0
380        do
381                if(mod(ii+skip,1022)==0)
382                        skip+=1
383                endif
384                out[ii] = Decompress(in[ii+skip])
385                ii+=1
386        while(ii<16384)
387        return(0)
388End
389
390//decompresses each I*2 data value to its real I*4 value
391//using the decompression routine written by Jim Ryhne, many moons ago
392//
393// the compression routine (not shown here, contained in the VAX fortran RW_DATAFILE.FOR) maps I4 to I2 values.
394// (back in the days where disk space *really* mattered). the I4toI2 function spit out:
395// I4toI2 = I4                                                          when I4 in [0,32767]
396// I4toI2 = -777                                                        when I4 in [2,767,000,...]
397// I4toI2 mapped to -13277 to -32768    otherwise
398//
399// the mapped values [-776,-1] and [-13276,-778] are not used.
400// in this compression scheme, only 4 significant digits are retained (to allow room for the exponent)
401// technically, the maximum value should be 2,768,499 since this maps to -32768. But this is of
402// little consequence. If you have individual pixel values on the detector that are that large, you need
403// to re-think your experiment.
404//
405// local function to post-process compressed VAX binary data
406//
407//
408Function Decompress(val)
409        Variable val
410
411        Variable i4,npw,ipw,ib,nd
412
413        ib=10
414        nd=4
415        ipw=ib^nd
416        i4=val
417
418        if (i4 <= -ipw)
419                npw=trunc(-i4/ipw)
420                i4=mod(-i4,ipw)*(ib^npw)
421                return i4
422        else
423                return i4
424        endif
425End
426
427//****************
428//main entry procedure for reading a "WORK.DIV" file
429//displays a quick image of the  file, to check that it's correct
430//data is deposited in root:Packages:NIST:DIV data folder
431//
432// local, currently unused
433//
434//
435Proc ReadWork_DIV()
436//      Silent 1
437       
438        String fname = PromptForPath("Select detector sensitivity file")
439        ReadHeaderAndWork("DIV",fname)          //puts what is read in work.div
440       
441        String waveStr = "root:Packages:NIST:DIV:data"
442        NewImage/F/K=1/S=2 $waveStr             //this is an experimental IGOR operation
443        ModifyImage '' ctab= {*,*,YellowHot,0}
444        //Display;AppendImage $waveStr
445       
446        //change the title string to WORK.DIV, rather than PLEXnnn_TST_asdfa garbage
447        String/G root:Packages:NIST:DIV:fileList = "WORK.DIV"
448       
449        SetDataFolder root:             //(redundant)
450//      Silent 0
451End
452
453
454//this function is the guts of reading a binary VAX file of real (4-byte) values
455// (i.e. a WORK.aaa file)
456// work files have the same header structure as RAW SANS data, just with
457//different data (real, rather than compressed integer data)
458//
459//************
460//this routine incorrectly reads in several data values where the VAX record
461//marker splits the 4-byte real (at alternating record markers)
462//this error seems to not be severe, but shoud be corrected (at great pain)
463//************
464//
465// called from ProtocolAsPanel.ipf
466//
467//
468Function ReadHeaderAndWork(type,fname)
469        String type,fname
470       
471        //type is the desired folder to read the workfile to
472        //this data will NOT be automatically displayed gDataDisplayType is unchanged
473
474//      SVAR cur_folder=root:myGlobals:gDataDisplayType
475        String cur_folder = type
476        String curPath = "root:Packages:NIST:"+cur_folder
477        SetDataFolder curPath           //use the full path, so it will always work
478       
479        Variable refNum,integer,realval
480        String sansfname,textstr
481        Variable/G $(curPath + ":gIsLogScale") = 0              //initial state is linear, keep this in DIV folder
482       
483        Make/O/N=23 $(curPath + ":IntegersRead")
484        Make/O/N=52 $(curPath + ":RealsRead")
485        Make/O/T/N=11 $(curPath + ":TextRead")
486       
487        WAVE intw=$(curPath + ":IntegersRead")
488        WAVE realw=$(curPath + ":RealsRead")
489        WAVE/T textw=$(curPath + ":TextRead")
490       
491        //***NOTE ****
492        // the "current path" gets mysteriously reset to "root:" after the SECOND pass through
493        // this read routine, after the open dialog is presented
494        // the "--read" waves end up in the correct folder, but the data does not! Why?
495        //must re-set data folder before writing data array (done below)
496       
497        SetDataFolder curPath
498       
499        //actually open the file
500        Open/R refNum as fname
501        //skip first two bytes
502        FSetPos refNum, 2
503        //read the next 21 bytes as characters (fname)
504        FReadLine/N=21 refNum,textstr
505        textw[0]= textstr
506        //read four i*4 values  /F=3 flag, B=3 flag
507        FBinRead/F=3/B=3 refNum, integer
508        intw[0] = integer
509        //
510        FBinRead/F=3/B=3 refNum, integer
511        intw[1] = integer
512        //
513        FBinRead/F=3/B=3 refNum, integer
514        intw[2] = integer
515        //
516        FBinRead/F=3/B=3 refNum, integer
517        intw[3] = integer
518        // 6 text fields
519        FSetPos refNum,55               //will start reading at byte 56
520        FReadLine/N=20 refNum,textstr
521        textw[1]= textstr
522        FReadLine/N=3 refNum,textstr
523        textw[2]= textstr
524        FReadLine/N=11 refNum,textstr
525        textw[3]= textstr
526        FReadLine/N=1 refNum,textstr
527        textw[4]= textstr
528        FReadLine/N=8 refNum,textstr
529        textw[5]= textstr
530        FReadLine/N=60 refNum,textstr
531        textw[6]= textstr
532       
533        //3 integers
534        FSetPos refNum,174
535        FBinRead/F=3/B=3 refNum, integer
536        intw[4] = integer
537        FBinRead/F=3/B=3 refNum, integer
538        intw[5] = integer
539        FBinRead/F=3/B=3 refNum, integer
540        intw[6] = integer
541       
542        //2 integers, 3 text fields
543        FSetPos refNum,194
544        FBinRead/F=3/B=3 refNum, integer
545        intw[7] = integer
546        FBinRead/F=3/B=3 refNum, integer
547        intw[8] = integer
548        FReadLine/N=6 refNum,textstr
549        textw[7]= textstr
550        FReadLine/N=6 refNum,textstr
551        textw[8]= textstr
552        FReadLine/N=6 refNum,textstr
553        textw[9]= textstr
554       
555        //2 integers
556        FSetPos refNum,244
557        FBinRead/F=3/B=3 refNum, integer
558        intw[9] = integer
559        FBinRead/F=3/B=3 refNum, integer
560        intw[10] = integer
561       
562        //2 integers
563        FSetPos refNum,308
564        FBinRead/F=3/B=3 refNum, integer
565        intw[11] = integer
566        FBinRead/F=3/B=3 refNum, integer
567        intw[12] = integer
568       
569        //2 integers
570        FSetPos refNum,332
571        FBinRead/F=3/B=3 refNum, integer
572        intw[13] = integer
573        FBinRead/F=3/B=3 refNum, integer
574        intw[14] = integer
575       
576        //3 integers
577        FSetPos refNum,376
578        FBinRead/F=3/B=3 refNum, integer
579        intw[15] = integer
580        FBinRead/F=3/B=3 refNum, integer
581        intw[16] = integer
582        FBinRead/F=3/B=3 refNum, integer
583        intw[17] = integer
584       
585        //1 text field - the file association for transmission are the first 4 bytes
586        FSetPos refNum,404
587        FReadLine/N=42 refNum,textstr
588        textw[10]= textstr
589       
590        //1 integer
591        FSetPos refNum,458
592        FBinRead/F=3/B=3 refNum, integer
593        intw[18] = integer
594       
595        //4 integers
596        FSetPos refNum,478
597        FBinRead/F=3/B=3 refNum, integer
598        intw[19] = integer
599        FBinRead/F=3/B=3 refNum, integer
600        intw[20] = integer
601        FBinRead/F=3/B=3 refNum, integer
602        intw[21] = integer
603        FBinRead/F=3/B=3 refNum, integer
604        intw[22] = integer
605       
606        Close refNum
607       
608        //now get all of the reals
609        //
610        //Do all the GBLoadWaves at the end
611        //
612        //FBinRead Cannot handle 32 bit VAX floating point
613        //GBLoadWave, however, can properly read it
614        String GBLoadStr="GBLoadWave/O/N=tempGBwave/T={2,2}/J=2/W=1/Q"
615        String strToExecute
616        //append "/S=offset/U=numofreals" to control the read
617        // then append fname to give the full file path
618        // then execute
619       
620        Variable a=0,b=0
621       
622        SetDataFolder curPath
623        // 4 R*4 values
624        strToExecute = GBLoadStr + "/S=39/U=4" + "\"" + fname + "\""
625        Execute strToExecute
626       
627        SetDataFolder curPath
628        Wave w=$(curPath + ":tempGBWave0")
629        b=4     //num of reals read
630        realw[a,a+b-1] = w[p-a]
631        a+=b
632       
633        // 4 R*4 values
634        SetDataFolder curPath
635        strToExecute = GBLoadStr + "/S=158/U=4" + "\"" + fname + "\""
636        Execute strToExecute
637        b=4     
638        realw[a,a+b-1] = w[p-a]
639        a+=b
640
641///////////
642        // 2 R*4 values
643        SetDataFolder curPath
644        strToExecute = GBLoadStr + "/S=186/U=2" + "\"" + fname + "\""
645        Execute strToExecute
646        b=2     
647        realw[a,a+b-1] = w[p-a]
648        a+=b
649
650        // 6 R*4 values
651        SetDataFolder curPath
652        strToExecute = GBLoadStr + "/S=220/U=6" + "\"" + fname + "\""
653        Execute strToExecute
654        b=6     
655        realw[a,a+b-1] = w[p-a]
656        a+=b
657       
658        // 13 R*4 values
659        SetDataFolder curPath
660        strToExecute = GBLoadStr + "/S=252/U=13" + "\"" + fname + "\""
661        Execute strToExecute
662        b=13
663        realw[a,a+b-1] = w[p-a]
664        a+=b
665       
666        // 3 R*4 values
667        SetDataFolder curPath
668        strToExecute = GBLoadStr + "/S=320/U=3" + "\"" + fname + "\""
669        Execute strToExecute
670        b=3     
671        realw[a,a+b-1] = w[p-a]
672        a+=b
673       
674        // 7 R*4 values
675        SetDataFolder curPath
676        strToExecute = GBLoadStr + "/S=348/U=7" + "\"" + fname + "\""
677        Execute strToExecute
678        b=7
679        realw[a,a+b-1] = w[p-a]
680        a+=b
681       
682        // 4 R*4 values
683        SetDataFolder curPath
684        strToExecute = GBLoadStr + "/S=388/U=4" + "\"" + fname + "\""
685        Execute strToExecute
686        b=4     
687        realw[a,a+b-1] = w[p-a]
688        a+=b
689       
690        // 2 R*4 values
691        SetDataFolder curPath
692        strToExecute = GBLoadStr + "/S=450/U=2" + "\"" + fname + "\""
693        Execute strToExecute
694        b=2
695        realw[a,a+b-1] = w[p-a]
696        a+=b
697       
698        // 2 R*4 values
699        SetDataFolder curPath
700        strToExecute = GBLoadStr + "/S=470/U=2" + "\"" + fname + "\""
701        Execute strToExecute
702        b=2
703        realw[a,a+b-1] = w[p-a]
704        a+=b
705       
706        // 5 R*4 values
707        SetDataFolder curPath
708        strToExecute = GBLoadStr + "/S=494/U=5" + "\"" + fname + "\""
709        Execute strToExecute
710        b=5     
711        realw[a,a+b-1] = w[p-a]
712       
713        //if the binary VAX data ws transferred to a MAC, all is OK
714        //if the data was trasnferred to an Intel machine (IBM), all the real values must be
715        //divided by 4 to get the correct floating point values
716        // I can't find any combination of settings in GBLoadWave or FBinRead to read data in correctly
717        // on an Intel machine.
718        //With the corrected version of GBLoadWave XOP (v. 1.43 or higher) Mac and PC both read
719        //VAX reals correctly, and no checking is necessary 12 APR 99
720        //if(cmpstr("Macintosh",IgorInfo(2)) == 0)
721                //do nothing
722        //else
723                //either Windows or Windows NT
724                //realw /= 4
725        //endif
726       
727        //read in the data
728         GBLoadStr="GBLoadWave/O/N=tempGBwave/T={2,2}/J=2/W=1/Q"
729
730        curPath = "root:Packages:NIST:"+cur_folder
731        SetDataFolder curPath           //use the full path, so it will always work
732       
733        Make/O/N=16384 $(curPath + ":data")
734        WAVE data = $(curPath + ":data")
735       
736        Variable skip,ii,offset
737       
738        //read in a total of 16384 values (ii)
739        //as follows :
740        // skip first 2 bytes
741        // skip 512 byte header
742        // skip first 2 bytes of data
743        //(read 511 reals, skip 2b, 510 reals, skip 2b) -16 times = 16336 values
744        // read the final 48 values in seperately to avoid EOF error
745       
746        /////////////
747        SetDataFolder curPath
748        skip = 0
749        ii=0
750        offset = 514 +2
751        a=0
752        do
753                SetDataFolder curPath
754               
755                strToExecute = GBLoadStr + "/S="+num2str(offset)+"/U=511" + "\"" + fname + "\""
756                Execute strToExecute
757                //Print strToExecute
758                b=511
759                data[a,a+b-1] = w[p-a]
760                a+=b
761               
762                offset += 511*4 +2
763               
764                strToExecute = GBLoadStr + "/S="+num2str(offset)+"/U=510" + "\"" + fname + "\""
765                SetDataFolder curPath
766                Execute strToExecute
767                //Print strToExecute
768                b=510
769                data[a,a+b-1] = w[p-a]
770                a+=b
771               
772                offset += 510*4 +2
773               
774                ii+=1
775                //Print "inside do, data[2] =",data[2]
776                //Print "inside do, tempGBwave0[0] = ",w[0]
777        while(ii<16)
778       
779        // 16336 values have been read in --
780        //read in last 64 values
781        strToExecute = GBLoadStr + "/S="+num2str(offset)+"/U=48" + "\"" + fname + "\""
782       
783        SetDataFolder curPath
784        Execute strToExecute
785        b=48
786        data[a,a+b-1] = w[p-a]
787        a+=b
788//
789/// done reading in raw data
790//
791        //Print "in workdatareader , data = ", data[1][1]
792
793        Redimension/n=(128,128) data
794       
795        //clean up - get rid of w = $"tempGBWave0"
796        KillWaves w
797       
798        //divide the FP data by 4 if read from a PC (not since GBLoadWave update)
799        //if(cmpstr("Macintosh",IgorInfo(2)) == 0)
800                //do nothing
801        //else
802                //either Windows or Windows NT
803                //data /= 4
804        //endif
805       
806        //keep a string with the filename in the DIV folder
807        String/G $(curPath + ":fileList") = textw[0]
808       
809        //return the data folder to root
810        SetDataFolder root:
811       
812        Return(0)
813End
814
815/////   ASC FORMAT READER  //////
816/////   FOR WORKFILE MATH PANEL //////
817
818//function to read in the ASC output of SANS reduction
819// currently the file has 20 header lines, followed by a single column
820// of 16384 values, Data is written by row, starting with Y=1 and X=(1->128)
821//
822//returns 0 if read was ok
823//returns 1 if there was an error
824//
825// called by WorkFileUtils.ipf
826//
827Function ReadASCData(fname,destPath)
828        String fname, destPath
829        //this function is for reading in ASCII data so put data in user-specified folder
830        SetDataFolder "root:Packages:NIST:"+destPath
831
832        NVAR pixelsX = root:myGlobals:gNPixelsX
833        NVAR pixelsY = root:myGlobals:gNPixelsY
834        Variable refNum=0,ii,p1,p2,tot,num=pixelsX,numHdrLines=20
835        String str=""
836        //data is initially linear scale
837        Variable/G :gIsLogScale=0
838        Make/O/T/N=(numHdrLines) hdrLines
839        Make/O/D/N=(pixelsX*pixelsY) data                       //,linear_data
840       
841        //full filename and path is now passed in...
842        //actually open the file
843//      SetDataFolder destPath
844        Open/R/Z refNum as fname                // /Z flag means I must handle open errors
845        if(refnum==0)           //FNF error, get out
846                DoAlert 0,"Could not find file: "+fname
847                Close/A
848                SetDataFolder root:
849                return(1)
850        endif
851        if(V_flag!=0)
852                DoAlert 0,"File open error: V_flag="+num2Str(V_Flag)
853                Close/A
854                SetDataFolder root:
855                return(1)
856        Endif
857        //
858        for(ii=0;ii<numHdrLines;ii+=1)          //read (or skip) 18 header lines
859                FReadLine refnum,str
860                hdrLines[ii]=str
861        endfor
862        //     
863        Close refnum
864       
865//      SetDataFolder destPath
866        LoadWave/Q/G/D/N=temp fName
867        Wave/Z temp0=temp0
868        data=temp0
869        Redimension/N=(pixelsX,pixelsY) data            //,linear_data
870       
871        //linear_data = data
872       
873        KillWaves/Z temp0
874       
875        //return the data folder to root
876        SetDataFolder root:
877       
878        Return(0)
879End
880
881// fills the "default" fake header so that the SANS Reduction machinery does not have to be altered
882// pay attention to what is/not to be trusted due to "fake" information.
883// uses what it can from the header lines from the ASC file (hdrLines wave)
884//
885// destFolder is of the form "myGlobals:WorkMath:AAA"
886//
887//
888// called by WorkFileUtils.ipf
889//
890Function FillFakeHeader_ASC(destFolder)
891        String destFolder
892        Make/O/N=23 $("root:Packages:NIST:"+destFolder+":IntegersRead")
893        Make/O/N=52 $("root:Packages:NIST:"+destFolder+":RealsRead")
894        Make/O/T/N=11 $("root:Packages:NIST:"+destFolder+":TextRead")
895       
896        Wave intw=$("root:Packages:NIST:"+destFolder+":IntegersRead")
897        Wave realw=$("root:Packages:NIST:"+destFolder+":RealsRead")
898        Wave/T textw=$("root:Packages:NIST:"+destFolder+":TextRead")
899       
900        //Put in appropriate "fake" values
901        //parse values as needed from headerLines
902        Wave/T hdr=$("root:Packages:NIST:"+destFolder+":hdrLines")
903        Variable monCt,lam,offset,sdd,trans,thick
904        Variable xCtr,yCtr,a1,a2,a1a2Dist,dlam,bsDiam
905        String detTyp=""
906        String tempStr="",formatStr="",junkStr=""
907        formatStr = "%g %g %g %g %g %g"
908        tempStr=hdr[3]
909        sscanf tempStr, formatStr, monCt,lam,offset,sdd,trans,thick
910//      Print monCt,lam,offset,sdd,trans,thick,avStr,step
911        formatStr = "%g %g %g %g %g %g %g %s"
912        tempStr=hdr[5]
913        sscanf tempStr,formatStr,xCtr,yCtr,a1,a2,a1a2Dist,dlam,bsDiam,detTyp
914//      Print xCtr,yCtr,a1,a2,a1a2Dist,dlam,bsDiam,detTyp
915       
916        realw[16]=xCtr          //xCtr(pixels)
917        realw[17]=yCtr  //yCtr (pixels)
918        realw[18]=sdd           //SDD (m)
919        realw[26]=lam           //wavelength (A)
920        //
921        // necessary values
922        realw[10]=5                     //detector calibration constants, needed for averaging
923        realw[11]=10000
924        realw[12]=0
925        realw[13]=5
926        realw[14]=10000
927        realw[15]=0
928        //
929        // used in the resolution calculation, ONLY here to keep the routine from crashing
930        realw[20]=65            //det size
931        realw[27]=dlam  //delta lambda
932        realw[21]=bsDiam        //BS size
933        realw[23]=a1            //A1
934        realw[24]=a2    //A2
935        realw[25]=a1a2Dist      //A1A2 distance
936        realw[4]=trans          //trans
937        realw[3]=0              //atten
938        realw[5]=thick          //thick
939        //
940        //
941        realw[0]=monCt          //def mon cts
942
943        // fake values to get valid deadtime and detector constants
944        //
945        textw[9]=detTyp+"  "            //6 characters 4+2 spaces
946        textw[3]="[NGxSANS00]"  //11 chars, NGx will return default values for atten trans, deadtime...
947       
948        //set the string values
949        formatStr="FILE: %s CREATED: %s"
950        sscanf hdr[0],formatStr,tempStr,junkStr
951//      Print tempStr
952//      Print junkStr
953        String/G $("root:Packages:NIST:"+destFolder+":fileList") = tempStr
954        textw[0] = tempStr              //filename
955        textw[1] = junkStr              //run date-time
956       
957        //file label = hdr[1]
958        tempStr = hdr[1]
959        tempStr = tempStr[0,strlen(tempStr)-2]          //clean off the last LF
960//      Print tempStr
961        textW[6] = tempStr      //sample label
962       
963        return(0)
964End
965
966
967/////*****************
968////unused testing procedure for writing a 4 byte floating point value in VAX format
969//Proc TestReWriteReal()
970//      String Path
971//      Variable value,start
972//     
973//      GetFileAndPath()
974//      Path = S_Path + S_filename
975//     
976//      value = 0.2222
977//      start = 158             //trans starts at byte 159
978//      ReWriteReal(path,value,start)
979//     
980//      SetDataFolder root:
981//End
982
983//function will re-write a real value (4bytes) to the header of a RAW data file
984//to ensure re-readability, the real value must be written mimicking VAX binary format
985//which is done in this function
986//path is the full path:file;vers to the file
987//value is the real value to write
988//start is the position to move the file marker to, to begin writing
989//--so start is actually the "end byte" of the previous value
990//
991// Igor cannot write VAX FP values - so to "fake it"
992// (1) write IEEE FP, 4*desired value, little endian
993// (2) read back as two 16-bit integers, big endian
994// (3) write the two 16-bit integers, reversed, writing each as big endian
995//
996//this procedure takes care of all file open/close pairs needed
997//
998Function WriteVAXReal(path,value,start)
999        String path
1000        Variable value,start
1001       
1002        //Print " in F(), path = " + path
1003        Variable refnum,int1,int2, value4
1004
1005//////
1006        value4 = 4*value
1007       
1008        Open/A/T="????TEXT" refnum as path
1009        //write IEEE FP, 4*desired value
1010        FSetPos refnum,start
1011        FBinWrite/B=3/F=4 refnum,value4         //write out as little endian
1012        //move to the end of the file
1013        FStatus refnum
1014        FSetPos refnum,V_logEOF
1015        Close refnum
1016       
1017///////
1018        Open/R refnum as path
1019        //read back as two 16-bit integers
1020        FSetPos refnum,start
1021        FBinRead/B=2/F=2 refnum,int1    //read as big-endian
1022        FBinRead/B=2/F=2 refnum,int2   
1023        //file was opened read-only, no need to move to the end of the file, just close it     
1024        Close refnum
1025       
1026///////
1027        Open/A/T="????TEXT" refnum as path
1028        //write the two 16-bit integers, reversed
1029        FSetPos refnum,start
1030        FBinWrite/B=2/F=2 refnum,int2   //re-write as big endian
1031        FBinWrite/B=2/F=2 refnum,int1
1032        //move to the end of the file
1033        FStatus refnum
1034        FSetPos refnum,V_logEOF
1035        Close refnum            //at this point, it is as the VAX would have written it.
1036       
1037        Return(0)
1038End
1039
1040//sample transmission is a real value at byte 158
1041Function WriteTransmissionToHeader(fname,trans)
1042        String fname
1043        Variable trans
1044       
1045        WriteVAXReal(fname,trans,158)           //transmission start byte is 158
1046        return(0)
1047End
1048
1049//whole transmission is a real value at byte 392
1050Function WriteWholeTransToHeader(fname,trans)
1051        String fname
1052        Variable trans
1053       
1054        WriteVAXReal(fname,trans,392)           //transmission start byte is 392
1055        return(0)
1056End
1057
1058//box sum counts is a real value at byte 494
1059Function WriteBoxCountsToHeader(fname,counts)
1060        String fname
1061        Variable counts
1062       
1063        WriteVAXReal(fname,counts,494)          // start byte is 494
1064        return(0)
1065End
1066
1067//beam stop X-pos is at byte 368
1068Function WriteBSXPosToHeader(fname,xpos)
1069        String fname
1070        Variable xpos
1071       
1072        WriteVAXReal(fname,xpos,368)
1073        return(0)
1074End
1075
1076//sample thickness is at byte 162
1077Function WriteThicknessToHeader(fname,num)
1078        String fname
1079        Variable num
1080       
1081        WriteVAXReal(fname,num,162)
1082        return(0)
1083End
1084
1085//beam center X pixel location is at byte 252
1086Function WriteBeamCenterXToHeader(fname,num)
1087        String fname
1088        Variable num
1089       
1090        WriteVAXReal(fname,num,252)
1091        return(0)
1092End
1093
1094//beam center Y pixel location is at byte 256
1095Function WriteBeamCenterYToHeader(fname,num)
1096        String fname
1097        Variable num
1098       
1099        WriteVAXReal(fname,num,256)
1100        return(0)
1101End
1102
1103//attenuator number (not its transmission) is at byte 51
1104Function WriteAttenNumberToHeader(fname,num)
1105        String fname
1106        Variable num
1107       
1108        WriteVAXReal(fname,num,51)
1109        return(0)
1110End
1111
1112//monitor count is at byte 39
1113Function WriteMonitorCountToHeader(fname,num)
1114        String fname
1115        Variable num
1116       
1117        WriteVAXReal(fname,num,39)
1118        return(0)
1119End
1120
1121//total detector count is at byte 47
1122Function WriteDetectorCountToHeader(fname,num)
1123        String fname
1124        Variable num
1125       
1126        WriteVAXReal(fname,num,47)
1127        return(0)
1128End
1129
1130//transmission detector count is at byte 388
1131Function WriteTransDetCountToHeader(fname,num)
1132        String fname
1133        Variable num
1134       
1135        WriteVAXReal(fname,num,388)
1136        return(0)
1137End
1138
1139//wavelength is at byte 292
1140Function WriteWavelengthToHeader(fname,num)
1141        String fname
1142        Variable num
1143       
1144        WriteVAXReal(fname,num,292)
1145        return(0)
1146End
1147
1148//wavelength spread is at byte 296
1149Function WriteWavelengthDistrToHeader(fname,num)
1150        String fname
1151        Variable num
1152       
1153        WriteVAXReal(fname,num,296)
1154        return(0)
1155End
1156
1157//temperature is at byte 186
1158Function WriteTemperatureToHeader(fname,num)
1159        String fname
1160        Variable num
1161       
1162        WriteVAXReal(fname,num,186)
1163        return(0)
1164End
1165
1166//magnetic field is at byte 190
1167Function WriteMagnFieldToHeader(fname,num)
1168        String fname
1169        Variable num
1170       
1171        WriteVAXReal(fname,num,190)
1172        return(0)
1173End
1174
1175//Source Aperture diameter is at byte 280
1176Function WriteSourceApDiamToHeader(fname,num)
1177        String fname
1178        Variable num
1179       
1180        WriteVAXReal(fname,num,280)
1181        return(0)
1182End
1183
1184//Sample Aperture diameter is at byte 284
1185Function WriteSampleApDiamToHeader(fname,num)
1186        String fname
1187        Variable num
1188       
1189        WriteVAXReal(fname,num,284)
1190        return(0)
1191End
1192
1193//Source to sample distance is at byte 288
1194Function WriteSrcToSamDistToHeader(fname,num)
1195        String fname
1196        Variable num
1197       
1198        WriteVAXReal(fname,num,288)
1199        return(0)
1200End
1201
1202//detector offset is at byte 264
1203Function WriteDetectorOffsetToHeader(fname,num)
1204        String fname
1205        Variable num
1206       
1207        WriteVAXReal(fname,num,264)
1208        return(0)
1209End
1210
1211//beam stop diameter is at byte 272
1212Function WriteBeamStopDiamToHeader(fname,num)
1213        String fname
1214        Variable num
1215       
1216        WriteVAXReal(fname,num,272)
1217        return(0)
1218End
1219
1220//sample to detector distance is at byte 260
1221Function WriteSDDToHeader(fname,num)
1222        String fname
1223        Variable num
1224       
1225        WriteVAXReal(fname,num,260)
1226        return(0)
1227End
1228
1229//detector pixel X size (mm) is at byte 220
1230Function WriteDetPixelXToHeader(fname,num)
1231        String fname
1232        Variable num
1233       
1234        WriteVAXReal(fname,num,220)
1235        return(0)
1236End
1237
1238//detector pixel Y size (mm) is at byte 232
1239Function WriteDetPixelYToHeader(fname,num)
1240        String fname
1241        Variable num
1242       
1243        WriteVAXReal(fname,num,232)
1244        return(0)
1245End
1246
1247//rewrite a text field back to the header
1248// fname is the full path:name
1249// str is the CORRECT length - it will all be written - pad or trim before passing
1250// start is the start byte
1251Function WriteTextToHeader(fname,str,start)
1252        String fname,str
1253        Variable start
1254       
1255        Variable refnum
1256        Open/A/T="????TEXT" refnum as fname      //Open for writing! Move to EOF before closing!
1257        FSetPos refnum,start
1258        FBinWrite/F=0 refnum, str      //native object format (character)
1259        //move to the end of the file before closing
1260        FStatus refnum
1261        FSetPos refnum,V_logEOF
1262        Close refnum
1263               
1264        return(0)
1265end
1266
1267// sample label, starts at byte 98
1268// limit to 60 characters
1269Function WriteSamLabelToHeader(fname,str)
1270        String fname,str
1271       
1272        if(strlen(str) > 60)
1273                str = str[0,59]
1274        endif
1275        WriteTextToHeader(fname,str,98)
1276        return(0)
1277End
1278
1279//rewrite an integer field back to the header
1280// fname is the full path:name
1281// val is the integer value
1282// start is the start byte
1283Function RewriteIntegerToHeader(fname,val,start)
1284        String fname
1285        Variable val,start
1286       
1287        Variable refnum
1288        Open/A/T="????TEXT" refnum as fname      //Open for writing! Move to EOF before closing!
1289        FSetPos refnum,start
1290        FBinWrite/B=3/F=3 refnum, val      //write a 4-byte integer
1291        //move to the end of the file before closing
1292        FStatus refnum
1293        FSetPos refnum,V_logEOF
1294        Close refnum
1295               
1296        return(0)
1297end
1298
1299Function WriteCountTimeToHeader(fname,num)
1300        String fname
1301        Variable num
1302       
1303        RewriteIntegerToHeader(fname,num,31)
1304        return(0)
1305End
1306
1307// read specific bits of information from the header
1308// each of these operations MUST take care of open/close on their own
1309
1310Function/S getStringFromHeader(fname,start,num)
1311        String fname                            //full path:name
1312        Variable start,num              //starting byte and number of characters to read
1313       
1314        String str
1315        Variable refnum
1316        Open/R refNum as fname
1317        FSetPos refNum,start
1318        FReadLine/N=(num) refNum,str
1319        Close refnum
1320       
1321        return(str)
1322End
1323
1324// file suffix (4 characters @ byte 19)
1325Function/S getSuffix(fname)
1326        String fname
1327       
1328        return(getStringFromHeader(fname,19,4))
1329End
1330
1331// associated file suffix (for transmission) (4 characters @ byte 404)
1332Function/S getAssociatedFileSuffix(fname)
1333        String fname
1334       
1335        return(getStringFromHeader(fname,404,4))
1336End
1337
1338// sample label (60 characters @ byte 98)
1339Function/S getSampleLabel(fname)
1340        String fname
1341       
1342        return(getStringFromHeader(fname,98,60))
1343End
1344
1345// file creation date (20 characters @ byte 55)
1346Function/S getFileCreationDate(fname)
1347        String fname
1348       
1349        return(getStringFromHeader(fname,55,20))
1350End
1351
1352// read a single real value with GBLoadWave
1353Function getRealValueFromHeader(fname,start)
1354        String fname
1355        Variable start
1356
1357        String GBLoadStr="GBLoadWave/O/N=tempGBwave/T={2,2}/J=2/W=1/Q"
1358       
1359        GBLoadStr += "/S="+num2str(start)+"/U=1" + "\"" + fname + "\""
1360        Execute GBLoadStr
1361        Wave w=$"tempGBWave0"
1362       
1363        return(w[0])
1364End
1365
1366//monitor count is at byte 39
1367Function getMonitorCount(fname)
1368        String fname
1369       
1370        return(getRealValueFromHeader(fname,39))
1371end
1372
1373//saved monitor count is at byte 43
1374Function getSavMon(fname)
1375        String fname
1376       
1377        return(getRealValueFromHeader(fname,43))
1378end
1379
1380//detector count is at byte 47
1381Function getDetCount(fname)
1382        String fname
1383       
1384        return(getRealValueFromHeader(fname,47))
1385end
1386
1387//Attenuator number is at byte 51
1388Function getAttenNumber(fname)
1389        String fname
1390       
1391        return(getRealValueFromHeader(fname,51))
1392end
1393
1394//transmission is at byte 158
1395Function getSampleTrans(fname)
1396        String fname
1397       
1398        return(getRealValueFromHeader(fname,158))
1399end
1400
1401//box counts are stored at byte 494
1402Function getBoxCounts(fname)
1403        String fname
1404       
1405        return(getRealValueFromHeader(fname,494))
1406end
1407
1408//whole detector trasmission is at byte 392
1409Function getSampleTransWholeDetector(fname)
1410        String fname
1411       
1412        return(getRealValueFromHeader(fname,392))
1413end
1414
1415//SampleThickness is at byte 162
1416Function getSampleThickness(fname)
1417        String fname
1418       
1419        return(getRealValueFromHeader(fname,162))
1420end
1421
1422//Sample Rotation Angle is at byte 170
1423Function getSampleRotationAngle(fname)
1424        String fname
1425       
1426        return(getRealValueFromHeader(fname,170))
1427end
1428
1429//temperature is at byte 186
1430Function getTemperature(fname)
1431        String fname
1432       
1433        return(getRealValueFromHeader(fname,186))
1434end
1435
1436//field strength is at byte 190
1437// 190 is not the right location, 348 looks to be correct for the electromagnets, 450 for the
1438// superconducting magnet. Although each place is only the voltage, it is correct
1439Function getFieldStrength(fname)
1440        String fname
1441       
1442//      return(getRealValueFromHeader(fname,190))
1443        return(getRealValueFromHeader(fname,348))
1444end
1445
1446//beam xPos is at byte 252
1447Function getBeamXPos(fname)
1448        String fname
1449       
1450        return(getRealValueFromHeader(fname,252))
1451end
1452
1453//beam Y pos is at byte 256
1454Function getBeamYPos(fname)
1455        String fname
1456       
1457        return(getRealValueFromHeader(fname,256))
1458end
1459
1460//sample to detector distance is at byte 260
1461Function getSDD(fname)
1462        String fname
1463       
1464        return(getRealValueFromHeader(fname,260))
1465end
1466
1467//detector offset is at byte 264
1468Function getDetectorOffset(fname)
1469        String fname
1470       
1471        return(getRealValueFromHeader(fname,264))
1472end
1473
1474//Beamstop diameter is at byte 272
1475Function getBSDiameter(fname)
1476        String fname
1477       
1478        return(getRealValueFromHeader(fname,272))
1479end
1480
1481//source aperture diameter is at byte 280
1482Function getSourceApertureDiam(fname)
1483        String fname
1484       
1485        return(getRealValueFromHeader(fname,280))
1486end
1487
1488//sample aperture diameter is at byte 284
1489Function getSampleApertureDiam(fname)
1490        String fname
1491       
1492        return(getRealValueFromHeader(fname,284))
1493end
1494
1495//source AP to Sample AP distance is at byte 288
1496Function getSourceToSampleDist(fname)
1497        String fname
1498       
1499        return(getRealValueFromHeader(fname,288))
1500end
1501
1502//wavelength is at byte 292
1503Function getWavelength(fname)
1504        String fname
1505       
1506        return(getRealValueFromHeader(fname,292))
1507end
1508
1509//wavelength spread is at byte 296
1510Function getWavelengthSpread(fname)
1511        String fname
1512       
1513        return(getRealValueFromHeader(fname,296))
1514end
1515
1516//transmission detector count is at byte 388
1517Function getTransDetectorCounts(fname)
1518        String fname
1519       
1520        return(getRealValueFromHeader(fname,388))
1521end
1522
1523//detector pixel X size is at byte 220
1524Function getDetectorPixelXSize(fname)
1525        String fname
1526       
1527        return(getRealValueFromHeader(fname,220))
1528end
1529
1530//detector pixel Y size is at byte 232
1531Function getDetectorPixelYSize(fname)
1532        String fname
1533       
1534        return(getRealValueFromHeader(fname,232))
1535end
1536
1537// stub for ILL - power is written to their header, not ours
1538Function getReactorPower(fname)
1539        String fname
1540
1541        return 0
1542
1543end
1544
1545//////  integer values
1546
1547Function getIntegerFromHeader(fname,start)
1548        String fname                            //full path:name
1549        Variable start          //starting byte
1550       
1551        Variable refnum,val
1552        Open/R refNum as fname
1553        FSetPos refNum,start
1554        FBinRead/B=3/F=3 refnum,val
1555        Close refnum
1556       
1557        return(val)
1558End
1559
1560//total count time is at byte 31       
1561Function getCountTime(fname)
1562        String fname
1563        return(getIntegerFromHeader(fname,31))
1564end
1565
1566
1567//reads the wavelength from a reduced data file (not very reliable)
1568// - does not work with NSORTed files
1569// - only used in FIT/RPA (which itself is almost NEVER used...)
1570//
1571Function GetLambdaFromReducedData(tempName)
1572        String tempName
1573       
1574        String junkString
1575        Variable lambdaFromFile, fileVar
1576        lambdaFromFile = 6.0
1577        Open/R/P=catPathName fileVar as tempName
1578        FReadLine fileVar, junkString
1579        FReadLine fileVar, junkString
1580        FReadLine fileVar, junkString
1581        if(strsearch(LowerStr(junkString),"lambda",0) != -1)
1582                FReadLine/N=11 fileVar, junkString
1583                FReadLine/N=10 fileVar, junkString
1584                lambdaFromFile = str2num(junkString)
1585        endif
1586        Close fileVar
1587       
1588        return(lambdaFromFile)
1589End
1590
1591/////   TRANSMISSION RELATED FUNCTIONS    ////////
1592//box coordinate are returned by reference
1593// filename is the full path:name
1594Function getXYBoxFromFile(filename,x1,x2,y1,y2)
1595        String filename
1596        Variable &x1,&x2,&y1,&y2
1597       
1598        Variable refnum
1599//      String tmpFile = FindValidFilename(filename)
1600               
1601//      Open/R/P=catPathName refnum as tmpFile
1602        Open/R refnum as filename
1603        FSetPos refnum,478
1604        FBinRead/F=3/B=3 refnum, x1
1605        FBinRead/F=3/B=3 refnum, x2
1606        FBinRead/F=3/B=3 refnum, y1
1607        FBinRead/F=3/B=3 refnum, y2
1608        Close refnum
1609       
1610        return(0)
1611End
1612
1613//go find the file, open it and write 4 integers to the file
1614//in the positions for analysis.rows(2), .cols(2) = 4 unused 4byte integers
1615Function WriteXYBoxToHeader(filename,x1,x2,y1,y2)
1616        String filename
1617        Variable x1,x2,y1,y2
1618       
1619        Variable refnum
1620        Open/A/T="????TEXT" refnum as filename
1621        FSetPos refnum,478
1622        FBinWrite/F=3/B=3 refNum, x1
1623        FBinWrite/F=3/B=3 refNum, x2
1624        FBinWrite/F=3/B=3 refNum, y1
1625        FBinWrite/F=3/B=3 refNum, y2
1626        //move to the end of the file before closing
1627        FStatus refnum
1628        FSetPos refnum,V_logEOF
1629        Close refnum
1630       
1631        return(0)
1632End
1633
1634//associated file suffix is the first 4 characters of a text field starting
1635// at byte 404
1636// suffix must be four characters long, if not, it's truncated
1637//
1638Function WriteAssocFileSuffixToHeader(fname,suffix)
1639        String fname,suffix
1640               
1641        suffix = suffix[0,3]            //limit to 4 characters
1642        WriteTextToHeader(fname,suffix,404)
1643       
1644        return(0)
1645end
1646
1647
1648// Jan 2008
1649// it has been determined that the true pixel dimension of the ordela detectors is not 5.0 mm
1650// but somewhat larger (5.08? mm). "new" data files will be written out with the proper size
1651// and old files will be patched batchwise to put the prpoer value in the header
1652
1653Proc PatchDetectorPixelSize(firstFile,lastFile,XSize,YSize)
1654        Variable firstFile=1,lastFile=100,XSize=5.08,YSize=5.08
1655
1656        fPatchDetectorPixelSize(firstFile,lastFile,XSize,YSize)
1657
1658End
1659
1660Proc ReadDetectorPixelSize(firstFile,lastFile)
1661        Variable firstFile=1,lastFile=100
1662       
1663        fReadDetectorPixelSize(firstFile,lastFile)
1664End
1665
1666// simple utility to patch the detector pixel size in the file headers
1667// pass in the dimensions in mm
1668// lo is the first file number
1669// hi is the last file number (inclusive)
1670//
1671Function fPatchDetectorPixelSize(lo,hi,xdim,ydim)
1672        Variable lo,hi,xdim,ydim
1673       
1674        Variable ii
1675        String file
1676       
1677        //loop over all files
1678        for(ii=lo;ii<=hi;ii+=1)
1679                file = FindFileFromRunNumber(ii)
1680                if(strlen(file) != 0)
1681                        WriteDetPixelXToHeader(file,xdim)
1682                        WriteDetPixelyToHeader(file,ydim)
1683                else
1684                        printf "run number %d not found\r",ii
1685                endif
1686        endfor
1687       
1688        return(0)
1689End
1690
1691// simple utility to read the pixel size stored in the file header
1692Function fReadDetectorPixelSize(lo,hi)
1693        Variable lo,hi
1694       
1695        String file
1696        Variable xdim,ydim,ii
1697       
1698        for(ii=lo;ii<=hi;ii+=1)
1699                file = FindFileFromRunNumber(ii)
1700                if(strlen(file) != 0)
1701                        xdim = getDetectorPixelXSize(file)
1702                        ydim = getDetectorPixelYSize(file)
1703                        printf "File %d:  Pixel dimensions (mm): X = %g\t Y = %g\r",ii,xdim,ydim
1704                else
1705                        printf "run number %d not found\r",ii
1706                endif
1707        endfor
1708       
1709        return(0)
1710End
1711
1712
1713
1714//*******************
1715//************
1716// simple command - line utilities to convert/unconvert the header value
1717// that flags files as using lenses
1718//
1719// stored in reals[28], header byte start @ 300
1720//
1721// currently, two values (0 | 1) = (no lens | yes lens)
1722// ideally, this field will have the actual number of lenses inserted.
1723//
1724// this is used in getResolution (reads the reals[]) and switches the calculation
1725//************
1726
1727Proc ConvertToLens(RunNumber)
1728        Variable RunNumber
1729        HeaderToLensResolution(RunNumber)
1730End
1731
1732Proc ConvertToPinhole(RunNumber)
1733        Variable RunNumber
1734        HeaderToPinholeResolution(RunNumber)
1735End
1736
1737// sets the flag to zero in the file (= 0)
1738Function HeaderToPinholeResolution(num)
1739        Variable num   
1740       
1741        //Print "UnConvert"
1742        String fullname=""
1743       
1744        fullname = FindFileFromRunNumber(num)
1745        Print fullname
1746        //report error or change the file
1747        if(cmpstr(fullname,"")==0)
1748                Print "HeaderToPinhole - file not found"
1749        else
1750                //Print "Unconvert",fullname
1751                WriteVAXReal(fullname,0,300)
1752        Endif
1753        return(0)
1754End
1755
1756// sets the flag to one in the file (= 1)
1757Function HeaderToLensResolution(num)
1758        Variable num   
1759       
1760        //Print "UnConvert"
1761        String fullname=""
1762       
1763        fullname = FindFileFromRunNumber(num)
1764        Print fullname
1765        //report error or change the file
1766        if(cmpstr(fullname,"")==0)
1767                Print "HeaderToPinhole - file not found"
1768        else
1769                //Print "Unconvert",fullname
1770                WriteVAXReal(fullname,1,300)
1771        Endif
1772        return(0)
1773End
1774
1775
1776// given a data folder, write out the corresponding VAX binary data file.
1777//
1778// I don't think that I can generate a STRUCT and then lay that down - since the
1779// VAX FP format has to be duplicated with a write/read/flip/re-write dance...
1780//
1781// seems to work correctly byte for byte
1782// compression has bee implmented also, for complete replication of the format (n>32767 in a cell)
1783//
1784// SRK 29JAN09
1785//
1786// other functions needed:
1787//
1788//
1789// one to generate a fake data file name, and put the matching name in the data header
1790// !! must fake the Annn suffix too! this is used...
1791// use a prefix, keep a run number, initials SIM, and alpha as before (start randomly, don't bother changing?)
1792//
1793// for right now, keep a run number, and generate
1794// PREFIXnnn.SA2_SIM_Annn
1795// also, start the index @ 100 to avoid leading zeros (although I have the functions available)
1796
1797// one to generate the date/time string in VAX format, right # characters// Print Secs2Time(DateTime,3)                         // Prints 13:07:29
1798// Print Secs2Time(DateTime,3)                          // Prints 13:07:29
1799//      Print Secs2Date(DateTime,-2)            // 1993-03-14                   //this call is independent of System date/time!//
1800//
1801// for now, 20 characters 01-JAN-2009 12:12:12
1802//
1803
1804// simulation should call as ("SAS","",0) to bypass the dialog, and to fill the header
1805// this could be modified in the future to be more generic
1806//
1807///
1808Function WriteVAXData(type,fullpath,dialog)
1809        String type,fullpath
1810        Variable dialog         //=1 will present dialog for name
1811       
1812        String destStr=""
1813        Variable refNum,ii,val,err
1814       
1815       
1816        destStr = "root:Packages:NIST:"+type
1817       
1818        SetDataFolder $destStr
1819        WAVE intw=integersRead
1820        WAVE rw=realsRead
1821        WAVE/T textw=textRead
1822        WAVE data=linear_data
1823       
1824        //check each wave
1825        If(!(WaveExists(intw)))
1826                Abort "intw DNExist WriteVAXData()"
1827        Endif
1828        If(!(WaveExists(rw)))
1829                Abort "rw DNExist WriteVAXData()"
1830        Endif
1831        If(!(WaveExists(textw)))
1832                Abort "textw DNExist WriteVAXData()"
1833        Endif
1834        If(!(WaveExists(data)))
1835                Abort "linear_data DNExist WriteVAXData()"
1836        Endif
1837       
1838       
1839//      if(dialog)
1840//              PathInfo/S catPathName
1841//              fullPath = DoSaveFileDialog("Save data as")
1842//              If(cmpstr(fullPath,"")==0)
1843//                      //user cancel, don't write out a file
1844//                      Close/A
1845//                      Abort "no data file was written"
1846//              Endif
1847//              //Print "dialog fullpath = ",fullpath
1848//      Endif
1849       
1850        // save to home, or get out
1851        //
1852        PathInfo home
1853        if(V_flag       == 0)
1854                Abort "no save path defined. Save the experiment to generate a home path"
1855        endif
1856       
1857        fullPath = S_path               //not the full path yet, still need the name, after the header is filled
1858       
1859       
1860        Make/O/B/U/N=33316 tmpFile              //unsigned integers for a blank data file
1861        tmpFile=0
1862       
1863        Make/O/W/N=16401 dataWRecMarkers
1864        AddRecordMarkers(data,dataWRecMarkers)
1865       
1866        // need to re-compress?? maybe never a problem, but should be done for the odd case
1867        dataWRecMarkers = CompressI4toI2(dataWRecMarkers)               //unless a pixel value is > 32767, the same values are returned
1868       
1869        // fill the last bits of the header information
1870        err = SimulationVAXHeader(type)
1871        if (err == -1)
1872                Abort "no sample label entered - no file written"                       // User did not fill in header correctly/completely
1873        endif
1874        fullPath = fullPath + textW[0]
1875       
1876        // lay down a blank file
1877        Open refNum as fullpath
1878                FBinWrite refNum,tmpFile                        //file is the right size, but all zeroes
1879        Close refNum
1880       
1881        // fill up the header
1882        // text values
1883        // elements of textW are already the correct length set by the read, but just make sure
1884        String str
1885       
1886        if(strlen(textw[0])>21)
1887                textw[0] = (textw[0])[0,20]
1888        endif
1889        if(strlen(textw[1])>20)
1890                textw[1] = (textw[1])[0,19]
1891        endif
1892        if(strlen(textw[2])>3)
1893                textw[2] = (textw[2])[0,2]
1894        endif
1895        if(strlen(textw[3])>11)
1896                textw[3] = (textw[3])[0,10]
1897        endif
1898        if(strlen(textw[4])>1)
1899                textw[4] = (textw[4])[0]
1900        endif
1901        if(strlen(textw[5])>8)
1902                textw[5] = (textw[5])[0,7]
1903        endif
1904        if(strlen(textw[6])>60)
1905                textw[6] = (textw[6])[0,59]
1906        endif
1907        if(strlen(textw[7])>6)
1908                textw[7] = (textw[7])[0,5]
1909        endif
1910        if(strlen(textw[8])>6)
1911                textw[8] = (textw[8])[0,5]
1912        endif
1913        if(strlen(textw[9])>6)
1914                textw[9] = (textw[9])[0,5]
1915        endif
1916        if(strlen(textw[10])>42)
1917                textw[10] = (textw[10])[0,41]
1918        endif   
1919       
1920        ii=0
1921        Open/A/T="????TEXT" refnum as fullpath      //Open for writing! Move to EOF before closing!
1922                str = textW[ii]
1923                FSetPos refnum,2                                                        ////file name
1924                FBinWrite/F=0 refnum, str      //native object format (character)
1925                ii+=1
1926                str = textW[ii]
1927                FSetPos refnum,55                                                       ////date/time
1928                FBinWrite/F=0 refnum, str
1929                ii+=1
1930                str = textW[ii]
1931                FSetPos refnum,75                                                       ////type
1932                FBinWrite/F=0 refnum, str
1933                ii+=1
1934                str = textW[ii]
1935                FSetPos refnum,78                                               ////def dir
1936                FBinWrite/F=0 refnum, str
1937                ii+=1
1938                str = textW[ii]
1939                FSetPos refnum,89                                               ////mode
1940                FBinWrite/F=0 refnum, str
1941                ii+=1
1942                str = textW[ii]
1943                FSetPos refnum,90                                               ////reserve
1944                FBinWrite/F=0 refnum, str
1945                ii+=1
1946                str = textW[ii]
1947                FSetPos refnum,98                                               ////@98, sample label
1948                FBinWrite/F=0 refnum, str
1949                ii+=1
1950                str = textW[ii]
1951                FSetPos refnum,202                                              //// T units
1952                FBinWrite/F=0 refnum, str
1953                ii+=1
1954                str = textW[ii]
1955                FSetPos refnum,208                                              //// F units
1956                FBinWrite/F=0 refnum, str
1957                ii+=1
1958                str = textW[ii]
1959                FSetPos refnum,214                                              ////det type
1960                FBinWrite/F=0 refnum, str
1961                ii+=1
1962                str = textW[ii]
1963                FSetPos refnum,404                                              ////reserve
1964                FBinWrite/F=0 refnum, str
1965       
1966                //move to the end of the file before closing
1967                FStatus refnum
1968                FSetPos refnum,V_logEOF
1969        Close refnum
1970       
1971       
1972        // integer values (4 bytes)
1973        ii=0
1974        Open/A/T="????TEXT" refnum as fullpath      //Open for writing! Move to EOF before closing!
1975                val = intw[ii]
1976                FSetPos refnum,23                                                       //nprefactors
1977                FBinWrite/B=3/F=3 refnum, val      //write a 4-byte integer
1978                ii+=1
1979                val=intw[ii]
1980                FSetPos refnum,27                                                       //ctime
1981                FBinWrite/B=3/F=3 refnum, val
1982                ii+=1
1983                val=intw[ii]
1984                FSetPos refnum,31                                                       //rtime
1985                FBinWrite/B=3/F=3 refnum, val
1986                ii+=1
1987                val=intw[ii]
1988                FSetPos refnum,35                                                       //numruns
1989                FBinWrite/B=3/F=3 refnum, val
1990                ii+=1
1991                val=intw[ii]
1992                FSetPos refnum,174                                                      //table
1993                FBinWrite/B=3/F=3 refnum, val
1994                ii+=1
1995                val=intw[ii]
1996                FSetPos refnum,178                                                      //holder
1997                FBinWrite/B=3/F=3 refnum, val
1998                ii+=1
1999                val=intw[ii]
2000                FSetPos refnum,182                                                      //blank
2001                FBinWrite/B=3/F=3 refnum, val
2002                ii+=1
2003                val=intw[ii]
2004                FSetPos refnum,194                                                      //tctrlr
2005                FBinWrite/B=3/F=3 refnum, val
2006                ii+=1
2007                val=intw[ii]
2008                FSetPos refnum,198                                                      //magnet
2009                FBinWrite/B=3/F=3 refnum, val
2010                ii+=1
2011                val=intw[ii]
2012                FSetPos refnum,244                                                      //det num
2013                FBinWrite/B=3/F=3 refnum, val
2014                ii+=1
2015                val=intw[ii]
2016                FSetPos refnum,248                                                      //det spacer
2017                FBinWrite/B=3/F=3 refnum, val
2018                ii+=1
2019                val=intw[ii]
2020                FSetPos refnum,308                                                      //tslice mult
2021                FBinWrite/B=3/F=3 refnum, val
2022                ii+=1
2023                val=intw[ii]
2024                FSetPos refnum,312                                                      //tsclice ltslice
2025                FBinWrite/B=3/F=3 refnum, val
2026                ii+=1
2027                val=intw[ii]
2028                FSetPos refnum,332                                                      //extra
2029                FBinWrite/B=3/F=3 refnum, val
2030                ii+=1
2031                val=intw[ii]
2032                FSetPos refnum,336                                                      //reserve
2033                FBinWrite/B=3/F=3 refnum, val
2034                ii+=1
2035                val=intw[ii]
2036                FSetPos refnum,376                                                      //blank1
2037                FBinWrite/B=3/F=3 refnum, val
2038                ii+=1
2039                val=intw[ii]
2040                FSetPos refnum,380                                                      //blank2
2041                FBinWrite/B=3/F=3 refnum, val
2042                ii+=1
2043                val=intw[ii]
2044                FSetPos refnum,384                                                      //blank3
2045                FBinWrite/B=3/F=3 refnum, val
2046                ii+=1
2047                val=intw[ii]
2048                FSetPos refnum,458                                                      //spacer
2049                FBinWrite/B=3/F=3 refnum, val
2050                ii+=1
2051                val=intw[ii]
2052                FSetPos refnum,478                                                      //box x1
2053                FBinWrite/B=3/F=3 refnum, val
2054                ii+=1
2055                val=intw[ii]
2056                FSetPos refnum,482                                                      //box x2
2057                FBinWrite/B=3/F=3 refnum, val
2058                ii+=1
2059                val=intw[ii]
2060                FSetPos refnum,486                                                      //box y1
2061                FBinWrite/B=3/F=3 refnum, val
2062                ii+=1
2063                val=intw[ii]
2064                FSetPos refnum,490                                                      //box y2
2065                FBinWrite/B=3/F=3 refnum, val
2066               
2067                //move to the end of the file before closing
2068                FStatus refnum
2069                FSetPos refnum,V_logEOF
2070        Close refnum
2071       
2072               
2073        //VAX 4-byte FP values. No choice here but to write/read/re-write to get
2074        // the proper format. there are 52! values to write
2075        //WriteVAXReal(fullpath,rw[n],start)
2076        // [0]
2077        WriteVAXReal(fullpath,rw[0],39)
2078        WriteVAXReal(fullpath,rw[1],43)
2079        WriteVAXReal(fullpath,rw[2],47)
2080        WriteVAXReal(fullpath,rw[3],51)
2081        WriteVAXReal(fullpath,rw[4],158)
2082        WriteVAXReal(fullpath,rw[5],162)
2083        WriteVAXReal(fullpath,rw[6],166)
2084        WriteVAXReal(fullpath,rw[7],170)
2085        WriteVAXReal(fullpath,rw[8],186)
2086        WriteVAXReal(fullpath,rw[9],190)
2087        // [10]
2088        WriteVAXReal(fullpath,rw[10],220)
2089        WriteVAXReal(fullpath,rw[11],224)
2090        WriteVAXReal(fullpath,rw[12],228)
2091        WriteVAXReal(fullpath,rw[13],232)
2092        WriteVAXReal(fullpath,rw[14],236)
2093        WriteVAXReal(fullpath,rw[15],240)
2094        WriteVAXReal(fullpath,rw[16],252)
2095        WriteVAXReal(fullpath,rw[17],256)
2096        WriteVAXReal(fullpath,rw[18],260)
2097        WriteVAXReal(fullpath,rw[19],264)
2098        // [20]
2099        WriteVAXReal(fullpath,rw[20],268)
2100        WriteVAXReal(fullpath,rw[21],272)
2101        WriteVAXReal(fullpath,rw[22],276)
2102        WriteVAXReal(fullpath,rw[23],280)
2103        WriteVAXReal(fullpath,rw[24],284)
2104        WriteVAXReal(fullpath,rw[25],288)
2105        WriteVAXReal(fullpath,rw[26],292)
2106        WriteVAXReal(fullpath,rw[27],296)
2107        WriteVAXReal(fullpath,rw[28],300)
2108        WriteVAXReal(fullpath,rw[29],320)
2109        // [30]
2110        WriteVAXReal(fullpath,rw[30],324)
2111        WriteVAXReal(fullpath,rw[31],328)
2112        WriteVAXReal(fullpath,rw[32],348)
2113        WriteVAXReal(fullpath,rw[33],352)
2114        WriteVAXReal(fullpath,rw[34],356)
2115        WriteVAXReal(fullpath,rw[35],360)
2116        WriteVAXReal(fullpath,rw[36],364)
2117        WriteVAXReal(fullpath,rw[37],368)
2118        WriteVAXReal(fullpath,rw[38],372)
2119        WriteVAXReal(fullpath,rw[39],388)
2120        // [40]
2121        WriteVAXReal(fullpath,rw[40],392)
2122        WriteVAXReal(fullpath,rw[41],396)
2123        WriteVAXReal(fullpath,rw[42],400)
2124        WriteVAXReal(fullpath,rw[43],450)
2125        WriteVAXReal(fullpath,rw[44],454)
2126        WriteVAXReal(fullpath,rw[45],470)
2127        WriteVAXReal(fullpath,rw[46],474)
2128        WriteVAXReal(fullpath,rw[47],494)
2129        WriteVAXReal(fullpath,rw[48],498)
2130        WriteVAXReal(fullpath,rw[49],502)
2131        // [50]
2132        WriteVAXReal(fullpath,rw[50],506)
2133        WriteVAXReal(fullpath,rw[51],510)
2134       
2135       
2136        // write out the data
2137        Open refNum as fullpath
2138                FSetPos refnum,514                                      //  OK
2139                FBinWrite/F=2/B=3 refNum,dataWRecMarkers                //don't trust the native format
2140                FStatus refNum
2141                FSetPos refNum,V_logEOF
2142        Close refNum
2143       
2144        // all done
2145        Killwaves/Z tmpFile,dataWRecMarkers
2146       
2147        Print "Saved VAX binary data as:  ",textW[0]
2148        SetDatafolder root:
2149        return(0)
2150End
2151
2152
2153Function AddRecordMarkers(in,out)
2154        Wave in,out
2155       
2156        Variable skip,ii
2157
2158//      Duplicate/O in,out
2159//      Redimension/N=16401 out
2160
2161        out=0
2162       
2163        ii=0
2164        skip=0
2165        out[ii] = 1
2166        ii+=1
2167        do
2168                if(mod(ii+skip,1022)==0)
2169                        out[ii+skip] = 0                //999999
2170                        skip+=1                 //increment AFTER filling the current marker
2171                endif
2172                out[ii+skip] = in[ii-1]
2173                ii+=1
2174        while(ii<=16384)
2175       
2176       
2177        return(0)
2178End
2179
2180
2181
2182
2183//        INTEGER*2 FUNCTION I4ToI2(I4)
2184//C
2185//C       Original author : Jim Rhyne
2186//C       Modified by     : Frank Chen 09/26/90
2187//C
2188//C       I4ToI2 = I4,                            I4 in [0,32767]
2189//C       I4ToI2 = -777,                          I4 in (2767000,...)
2190//C       I4ToI2 mapped to -13277 to -32768,      otherwise
2191//C
2192//C       the mapped values [-776,-1] and [-13276,-778] are not used
2193//C
2194//C       I4max should be 2768499, this value will maps to -32768
2195//C       and mantissa should be compared  using
2196//C               IF (R4 .GE. IPW)
2197//C       instead of
2198//C               IF (R4 .GT. (IPW - 1.0))
2199//C
2200//
2201//
2202//C       I4      :       input I*4
2203//C       R4      :       temperory real number storage
2204//C       IPW     :       IPW = IB ** ND
2205//C       NPW     :       number of power
2206//C       IB      :       Base value
2207//C       ND      :       Number of precision digits
2208//C       I4max   :       max data value w/ some error
2209//C       I2max   :       max data value w/o error
2210//C       Error   :       when data value > I4max
2211//C
2212//        INTEGER*4       I4
2213//        INTEGER*4       NPW
2214//        REAL*4          R4
2215//        INTEGER*4       IPW
2216//        INTEGER*4       IB      /10/
2217//        INTEGER*4       ND      /4/
2218//        INTEGER*4       I4max   /2767000/
2219//        INTEGER*4       I2max   /32767/
2220//        INTEGER*4       Error   /-777/
2221//
2222Function CompressI4toI2(i4)
2223        Variable i4
2224
2225        Variable npw,ipw,ib,nd,i4max,i2max,error,i4toi2
2226        Variable r4
2227       
2228        ib=10
2229        nd=4
2230        i4max=2767000
2231        i2max=32767
2232        error=-777
2233       
2234        if(i4 <= i4max)
2235                r4=i4
2236                if(r4 > i2max)
2237                        ipw = ib^nd
2238                        npw=0
2239                        do
2240                                if( !(r4 > (ipw-1)) )           //to simulate a do-while loop evaluating at top
2241                                        break
2242                                endif
2243                                npw=npw+1
2244                                r4=r4/ib               
2245                        while (1)
2246                        i4toi2 = -1*trunc(r4+ipw*npw)
2247                else
2248                        i4toi2 = trunc(r4)              //shouldn't I just return i4 (as a 2 byte value?)
2249                endif
2250        else
2251                i4toi2=error
2252        endif
2253        return(i4toi2)
2254End
2255
2256
2257// function to fill the extra bits of header information to make a "complete"
2258// simulated VAX data file.
2259//
2260//
2261Function SimulationVAXHeader(folder)
2262        String folder
2263
2264        Wave rw=root:Packages:NIST:SAS:realsRead
2265        Wave iw=root:Packages:NIST:SAS:integersRead
2266        Wave/T tw=root:Packages:NIST:SAS:textRead
2267        Wave res=root:Packages:NIST:SAS:results
2268       
2269// integers needed:
2270        //[2] count time
2271        NVAR ctTime = root:Packages:NIST:SAS:gCntTime
2272        iw[2] = ctTime
2273       
2274//reals are partially set in SASCALC initializtion
2275        //remaining values are updated automatically as SASCALC is modified
2276        // -- but still need:
2277        //      [0] monitor count
2278        //      [2] detector count (w/o beamstop)
2279        //      [4] transmission
2280        //      [5] thickness (in cm)
2281        NVAR imon = root:Packages:NIST:SAS:gImon
2282        rw[0] = imon
2283        rw[2] = res[9]
2284        rw[4] = res[8]
2285        NVAR thick = root:Packages:NIST:SAS:gThick
2286        rw[5] = thick
2287       
2288// text values needed:
2289// be sure they are padded to the correct length
2290        // [0] filename (do I fake a VAX name? probably yes...)
2291        // [1] date/time in VAX format
2292        // [2] type (use SIM)
2293        // [3] def dir (use [NG7SANS99])
2294        // [4] mode? C
2295        // [5] reserve (another date), prob not needed
2296        // [6] sample label
2297        // [9] det type "ORNL  " (6 chars)
2298       
2299        tw[1] = "01-JAN-2009 12:12:12"
2300        tw[2] = "SIM"
2301        tw[3] = "[NG7SANS99]"
2302        tw[4] = "C"
2303        tw[5] = "01JAN09 "
2304        tw[9] = "ORNL  "
2305       
2306        NVAR index = root:Packages:NIST:SAS:gSaveIndex
2307        SVAR prefix = root:Packages:NIST:SAS:gSavePrefix
2308
2309        tw[0] = prefix+num2str(index)+".SA2_SIM_A"+num2str(index)
2310        index += 1
2311       
2312        String labelStr=" "     
2313        Prompt labelStr, "Enter sample label "          // Set prompt for x param
2314        DoPrompt "Enter sample label", labelStr
2315        if (V_Flag)
2316                //Print "no sample label entered - no file written"
2317                index -=1
2318                return -1                                                               // User canceled
2319        endif
2320       
2321        labelStr = PadString(labelStr,60,0x20)  //60 fortran-style spaces
2322        tw[6] = labelStr[0,59]
2323       
2324        return(0)
2325End
Note: See TracBrowser for help on using the repository browser.