1 | ;+ |
---|
2 | ; |
---|
3 | ; @file_comments |
---|
4 | ; write an Oasis file (version < 2.5) |
---|
5 | ; |
---|
6 | ; @param FILENAME {in}{required} |
---|
7 | ; the filename |
---|
8 | ; |
---|
9 | ; @param VARNAME {in}{required} |
---|
10 | ; the name of the variable to be written |
---|
11 | ; |
---|
12 | ; @param Z2D {in}{required} |
---|
13 | ; the variable (2D array) to be written |
---|
14 | ; |
---|
15 | ; @keyword I2 |
---|
16 | ; @keyword I4 |
---|
17 | ; @keyword I8 |
---|
18 | ; @keyword R4 |
---|
19 | ; to change the default format (R8) of the data to be written. |
---|
20 | ; |
---|
21 | ; @keyword APPEND |
---|
22 | ; to open the file with the file pointer at the end of the file, ready for |
---|
23 | ; data to be appended. |
---|
24 | ; |
---|
25 | ; @keyword RECSIZE |
---|
26 | ; define the size of the full data array to be written. Useful when |
---|
27 | ; you want to save memory and write the data in several write_oasis |
---|
28 | ; instructions. see example |
---|
29 | ; |
---|
30 | ; @keyword TEMPORARY |
---|
31 | ; activate undefine z2d when yo write it (to save memory) -> z2d will |
---|
32 | ; be lost once write_oasis is returning. |
---|
33 | |
---|
34 | ; @keyword HEADER |
---|
35 | ; activate to write the header ("character*8" contained in varname) |
---|
36 | ; before writing the data. Used when recsize is defined and /= 0, see example |
---|
37 | ; |
---|
38 | ; @keyword ENDING |
---|
39 | ; activate when you write the last part of the data. Used when recsize |
---|
40 | ; is defined and /= 0, see example |
---|
41 | ; |
---|
42 | ; @keyword POSITION |
---|
43 | ; specify the position (in byte) at which you want to write the |
---|
44 | ; data. Used when recsize is defined and /= 0, see example |
---|
45 | ; |
---|
46 | ; @restrictions |
---|
47 | ; varname is automatically written as a "character*8" |
---|
48 | ; by default z2d is written as an R8 array |
---|
49 | ; |
---|
50 | ; @examples |
---|
51 | ; |
---|
52 | ; write_oasis, fa2of, 'WEIGHTS5', weig |
---|
53 | ; |
---|
54 | ; or in several call so save memory |
---|
55 | ; |
---|
56 | ; ysz = 100L |
---|
57 | ; recsz8 = 16L * jpio * jpjo * 8L |
---|
58 | ; FOR i = 0L, jpjo-1L, ysz DO BEGIN |
---|
59 | ; ii = (i+ysz-1L) < (jpjo-1L) |
---|
60 | ; position = (4L + 8L + 4L + 4L)*(i NE 0) + 16L * jpio * i * 8L |
---|
61 | ; weig = .... |
---|
62 | ; write_oasis, fa2ou, 'WEIGHTS3', temporary(weig), /temporary, append = i NE 0, header = i EQ 0 $ |
---|
63 | ; , ending = ii EQ jpjo-1, recsize = recsz8, position = position |
---|
64 | ; ENDFOR |
---|
65 | ; |
---|
66 | ; @history |
---|
67 | ; Sebastien Masson (smasson\@lodyc.jussieu.fr) |
---|
68 | ; July 01, 2002 |
---|
69 | ; @version |
---|
70 | ; $Id$ |
---|
71 | ; |
---|
72 | ;- |
---|
73 | PRO write_oasis, filename, varname, z2d, I2 = i2, I4 = i4, I8 = i8, R4 = r4, APPEND = append $ |
---|
74 | , RECSIZE = recsize, TEMPORARY = temporary, HEADER = header, ENDING = ending, POSITION = position |
---|
75 | ; |
---|
76 | compile_opt idl2, strictarrsubs |
---|
77 | ; |
---|
78 | openw, unit, filename, F77_UNFORMATTED = keyword_set(recsize) EQ 0, /GET_LUN, /SWAP_IF_LITTLE_ENDIAN $ |
---|
79 | , error = err, APPEND = append |
---|
80 | IF err NE 0 THEN BEGIN |
---|
81 | ras = report(!err_string) |
---|
82 | return |
---|
83 | ENDIF |
---|
84 | IF n_elements(position) NE 0 THEN point_lun, unit, position |
---|
85 | |
---|
86 | IF keyword_set(recsize) THEN BEGIN |
---|
87 | IF keyword_set(header) THEN BEGIN |
---|
88 | writeu, unit, 8L |
---|
89 | writeu, unit, string(varname, format = '(a8)') |
---|
90 | writeu, unit, 8L |
---|
91 | writeu, unit, long(recsize) |
---|
92 | ENDIF |
---|
93 | ENDIF ELSE BEGIN |
---|
94 | writeu, unit, string(varname, format = '(a8)') |
---|
95 | ENDELSE |
---|
96 | |
---|
97 | IF keyword_set(temporary) THEN BEGIN |
---|
98 | CASE 1 OF |
---|
99 | keyword_set(i2):writeu, unit, fix( temporary(z2d)) |
---|
100 | keyword_set(i4):writeu, unit, long( temporary(z2d)) |
---|
101 | keyword_set(i8):writeu, unit, long64(temporary(z2d)) |
---|
102 | keyword_set(r4):writeu, unit, float( temporary(z2d)) |
---|
103 | ELSE: writeu, unit, double(temporary(z2d)) |
---|
104 | ENDCASE |
---|
105 | ENDIF ELSE BEGIN |
---|
106 | CASE 1 OF |
---|
107 | keyword_set(i2):writeu, unit, fix( z2d) |
---|
108 | keyword_set(i4):writeu, unit, long( z2d) |
---|
109 | keyword_set(i8):writeu, unit, long64(z2d) |
---|
110 | keyword_set(r4):writeu, unit, float( z2d) |
---|
111 | ELSE: writeu, unit, double(z2d) |
---|
112 | ENDCASE |
---|
113 | ENDELSE |
---|
114 | |
---|
115 | IF keyword_set(recsize) AND keyword_set(ending) THEN writeu, unit, long(recsize) |
---|
116 | |
---|
117 | free_lun, unit |
---|
118 | return |
---|
119 | END |
---|