- Timestamp:
- Feb 3, 2009 3:57:08 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
sans/Dev/trunk/NCNR_User_Procedures/Reduction/SANS/NCNR_DataReadWrite.ipf
r425 r472 351 351 352 352 //clean up - get rid of w = $"root:Packages:NIST:RAW:tempGBWave0" 353 KillWaves/Z w353 // KillWaves/Z w 354 354 355 355 //return the data folder to root … … 1287 1287 Variable refnum 1288 1288 Open/A/T="????TEXT" refnum as fname //Open for writing! Move to EOF before closing! 1289 FSetPos refnum, 311289 FSetPos refnum,start 1290 1290 FBinWrite/B=3/F=3 refnum, val //write a 4-byte integer 1291 1291 //move to the end of the file before closing … … 1772 1772 return(0) 1773 1773 End 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 /// 1808 Function 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) 2150 End 2151 2152 2153 Function 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) 2178 End 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 // 2222 Function 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) 2254 End 2255 2256 2257 // function to fill the extra bits of header information to make a "complete" 2258 // simulated VAX data file. 2259 // 2260 // 2261 Function 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) 2325 End
Note: See TracChangeset
for help on using the changeset viewer.
