source: trunk/SRC/ReadWrite/write_oasis.pro @ 361

;+
;
; @file_comments
; write an Oasis file (version < 2.5)
;
; @param FILENAME {in}{required}
; the filename
;
; @param VARNAME {in}{required}
; the name of the variable to be written
;
; @param Z2D {in}{required}
; the variable (2D array) to be written
;
; @keyword I2
; @keyword I4
; @keyword I8
; @keyword R4
; to change the default format (R8) of the data to be written.
;
; @keyword APPEND
; to open the file with the file pointer at the end of the file, ready for
; data to be appended.
;
; @keyword RECSIZE
; define the size of the full data array to be written. Usefull when
; you want to save memory and write the data in several write_oasis
; instructions. see example
;
; @keyword TEMPORARY
; activate undefine z2d when yo write it (to save memory) -> z2d will
; be lost once write_oasis is returning.

; @keyword HEADER
; activate to write the header ("character*8" contained in varname)
; before writting the data. Used when recsize is defined and /= 0, see example
;
; @keyword ENDING
; activate when you write the last part of the data. Used when recsize
; is defined and /= 0, see example
;
; @keyword POSITION
; specify the position (in byte) at which you want to write the
; data. Used when recsize is defined and /= 0, see example
;
; @restrictions
; varname is automatically written as a "character*8"
; by default z2d is written as an R8 array
;
; @examples
;
;   write_oasis, fa2of, 'WEIGHTS5', weig
;
; or in several call so save memory
;
;   ysz = 100L
;   recsz8 = 16L * jpio * jpjo * 8L
;   FOR i = 0L, jpjo-1L, ysz DO BEGIN 
;     ii = (i+ysz-1L) < (jpjo-1L)
;     position = (4L + 8L + 4L + 4L)*(i NE 0) + 16L * jpio * i * 8L
;     weig = .... 
;     write_oasis, fa2ou, 'WEIGHTS3', temporary(weig), /temporary, append = i NE 0, header = i EQ 0 $
;                  , ending = ii EQ jpjo-1, recsize = recsz8, position = position
;   ENDFOR
;
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
;                      July 01, 2002
; @version
; $Id$
;
;-
PRO write_oasis, filename, varname, z2d, I2 = i2, I4 = i4, I8 = i8, R4 = r4, APPEND = append $
                 , RECSIZE = recsize, TEMPORARY = temporary, HEADER = header, ENDING = ending, POSITION = position
;
  compile_opt idl2, strictarrsubs
;
  openw, unit, filename, F77_UNFORMATTED = keyword_set(recsize) EQ 0, /GET_LUN, /SWAP_IF_LITTLE_ENDIAN $
         , error = err, APPEND = append
  IF err NE 0 THEN BEGIN
    ras = report(!err_string)
    return
  ENDIF
  IF n_elements(position) NE 0 THEN point_lun, unit, position

  IF keyword_set(recsize) THEN BEGIN
    IF keyword_set(header) THEN BEGIN
      writeu, unit, 8L
      writeu, unit, string(varname, format = '(a8)')
      writeu, unit, 8L
      writeu, unit, long(recsize)
    ENDIF
  ENDIF ELSE BEGIN 
    writeu, unit, string(varname, format = '(a8)')
  ENDELSE 

  IF keyword_set(temporary)  THEN BEGIN
    CASE 1 OF
      keyword_set(i2):writeu, unit, fix(   temporary(z2d))
      keyword_set(i4):writeu, unit, long(  temporary(z2d))
      keyword_set(i8):writeu, unit, long64(temporary(z2d))
      keyword_set(r4):writeu, unit, float( temporary(z2d))
      ELSE:           writeu, unit, double(temporary(z2d))
    ENDCASE
  ENDIF ELSE BEGIN 
    CASE 1 OF
      keyword_set(i2):writeu, unit, fix(   z2d)
      keyword_set(i4):writeu, unit, long(  z2d)
      keyword_set(i8):writeu, unit, long64(z2d)
      keyword_set(r4):writeu, unit, float( z2d)
      ELSE:           writeu, unit, double(z2d)
    ENDCASE
  ENDELSE 

  IF keyword_set(recsize) AND keyword_set(ending) THEN writeu, unit, long(recsize)

  free_lun, unit
  return
END