[44] | 1 | ;+ |
---|
| 2 | ; |
---|
[130] | 3 | ; @file_comments |
---|
| 4 | ; write an Oasis file (version < 2.5) |
---|
[44] | 5 | ; |
---|
[238] | 6 | ; @param FILENAME {in}{required} |
---|
[136] | 7 | ; the filename |
---|
[44] | 8 | ; |
---|
[238] | 9 | ; @param VARNAME {in}{required} |
---|
[136] | 10 | ; the name of the variable to be written |
---|
| 11 | ; |
---|
[238] | 12 | ; @param Z2D {in}{required} |
---|
[136] | 13 | ; the variable (2D array) to be written |
---|
| 14 | ; |
---|
[130] | 15 | ; @keyword I2 |
---|
| 16 | ; @keyword I4 |
---|
| 17 | ; @keyword I8 |
---|
| 18 | ; @keyword R4 |
---|
[121] | 19 | ; to change the default format (R8) of the data to be written. |
---|
[44] | 20 | ; |
---|
[238] | 21 | ; @keyword APPEND |
---|
| 22 | ; to open the file with the file pointer at the end of the file, ready for |
---|
[136] | 23 | ; data to be appended. |
---|
[44] | 24 | ; |
---|
[332] | 25 | ; @keyword RECSIZE |
---|
| 26 | ; define the size of the full data array to be written. Usefull 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 writting 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 | ; |
---|
[238] | 46 | ; @restrictions |
---|
[136] | 47 | ; varname is automatically written as a "character*8" |
---|
| 48 | ; by default z2d is written as an R8 array |
---|
[44] | 49 | ; |
---|
[332] | 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 | ; |
---|
[238] | 67 | ; @history |
---|
| 68 | ; Sebastien Masson (smasson\@lodyc.jussieu.fr) |
---|
[44] | 69 | ; July 01, 2002 |
---|
[238] | 70 | ; @version |
---|
| 71 | ; $Id$ |
---|
| 72 | ; |
---|
[44] | 73 | ;- |
---|
[332] | 74 | PRO write_oasis, filename, varname, z2d, I2 = i2, I4 = i4, I8 = i8, R4 = r4, APPEND = append $ |
---|
| 75 | , RECSIZE = recsize, TEMPORARY = temporary, HEADER = header, ENDING = ending, POSITION = position |
---|
[114] | 76 | ; |
---|
| 77 | compile_opt idl2, strictarrsubs |
---|
| 78 | ; |
---|
[332] | 79 | openw, unit, filename, F77_UNFORMATTED = keyword_set(recsize) EQ 0, /GET_LUN, /SWAP_IF_LITTLE_ENDIAN $ |
---|
| 80 | , error = err, APPEND = append |
---|
| 81 | IF err NE 0 THEN BEGIN |
---|
| 82 | ras = report(!err_string) |
---|
| 83 | return |
---|
| 84 | ENDIF |
---|
| 85 | IF n_elements(position) NE 0 THEN point_lun, unit, position |
---|
[238] | 86 | |
---|
[332] | 87 | IF keyword_set(recsize) THEN BEGIN |
---|
| 88 | IF keyword_set(header) THEN BEGIN |
---|
| 89 | writeu, unit, 8L |
---|
| 90 | writeu, unit, string(varname, format = '(a8)') |
---|
| 91 | writeu, unit, 8L |
---|
| 92 | writeu, unit, long(recsize) |
---|
| 93 | ENDIF |
---|
| 94 | ENDIF ELSE BEGIN |
---|
| 95 | writeu, unit, string(varname, format = '(a8)') |
---|
| 96 | ENDELSE |
---|
| 97 | |
---|
| 98 | IF keyword_set(temporary) THEN BEGIN |
---|
| 99 | CASE 1 OF |
---|
| 100 | keyword_set(i2):writeu, unit, fix( temporary(z2d)) |
---|
| 101 | keyword_set(i4):writeu, unit, long( temporary(z2d)) |
---|
| 102 | keyword_set(i8):writeu, unit, long64(temporary(z2d)) |
---|
| 103 | keyword_set(r4):writeu, unit, float( temporary(z2d)) |
---|
| 104 | ELSE: writeu, unit, double(temporary(z2d)) |
---|
| 105 | ENDCASE |
---|
| 106 | ENDIF ELSE BEGIN |
---|
| 107 | CASE 1 OF |
---|
| 108 | keyword_set(i2):writeu, unit, fix( z2d) |
---|
| 109 | keyword_set(i4):writeu, unit, long( z2d) |
---|
[44] | 110 | keyword_set(i8):writeu, unit, long64(z2d) |
---|
[332] | 111 | keyword_set(r4):writeu, unit, float( z2d) |
---|
| 112 | ELSE: writeu, unit, double(z2d) |
---|
| 113 | ENDCASE |
---|
| 114 | ENDELSE |
---|
[44] | 115 | |
---|
[332] | 116 | IF keyword_set(recsize) AND keyword_set(ending) THEN writeu, unit, long(recsize) |
---|
| 117 | |
---|
| 118 | free_lun, unit |
---|
| 119 | return |
---|
| 120 | END |
---|