Using SAC

SAC Reading and Writing Routines

Overview

Using the SAC I/O library, ${SACHOME}/lib/libsacio.a, one can write stand-alone codes in C or FORTRAN to read and write SAC formatted data files. The SAC_I/O library is included in the sub-directory ${SACHOME}/lib. The complete listing of sample programs in both C and Fortran for reading and writing SAC data files and for getting and setting SAC header values, are give in the online version and at $SACAUX/doc/examples

Two distinct interfaces for reading and writing sac type files exist:

  • Fortran-77 style SAC I/O interface (RSAC1, WSAC2, GETFHV, ...)
  • C style SAC I/O interface (see end of this file)

For both styles, SAC uses C programming internally. Reading and writing files with the Fortran-77 stye interface is consistent with previous versions of the libsacio library. The C style interface is documented at the end of this file.

When compiling/linking your code, it is necessary to include ${SACHOME}/lib/libsacio.a in order to access the routines discussed below. To ease the requirements for compilation and linking, a helper script is provided, ${SACHOME}/bin/sac-config, which should output the necessary flags and libraries. Try the following:

gcc -o program source.c `sac-config --cflags --libs sacio`

f77 -o program source.f `sac-config --cflags --libs sacio`

There are two routines in the SAC_I/O library that can be used to read SAC data files into a C or FORTRAN program:

  • RSAC1 reads evenly spaced files
  • RSAC2 reads unevenly spaced or spectral files.

There is a set of routines that let one get the values of header variables after a file has been read:

  • GETFHV gets Float (REAL*4) header variables
  • GETDHV gets Double (REAL*8) NVHDR=7 (v7) footer variables (new in SACv102.0)
  • GETIHV gets character strings enumerated as int or INTEGER header variables
  • GETKHV gets character string header variables
  • GETLHV gets LOGICAL header variables (declared as long in C)
  • GETNHV gets int (INTEGER) header variables.

For definitions of the SAC header variables, see SAC data file format.

There is a like set of routines that let one set the values of header variables currently in memory:

  • SETFHV sets REAL*4 header variables
  • SETDHV sets REAL*8 v7 footer variables
  • SETIHV sets character strings enumerated as int or INTEGER header variables
  • SETKHV sets character string header variables
  • SETLHV sets LOGICAL header variables (declared as long in C)
  • SETNHV sets int or INTEGER header variables.

There are three routines used to write SAC data files to disk:

  • WSAC1 writes evenly spaced files (v6 only)
  • WSAC2 writes unevenly spaced and spectral files (v6 only)
  • WSAC0 writes either format but has more comprehensive header files than the other two - including the ability to write a v7 file.

WSAC1 and WSAC2 write SAC files with a minimum header contains only those variables needed to be able to read the file: B, E, DELTA, LEVEN, and NPTS. For calls to WSAC0, if it is a new file, the call must be preceded by a call to subroutine NEWHDR supplemented by additional header variables to be set using the SETXXX routines (see examples below). If it is writing to a file that is based on one that had been read in previously in the program, one should not call NEWHDR. As shown in the examples below, the type of SAC data file that gets written depends on header variables that must be set: IFTYPE and LEVEN. IFTYPE has the following values:

  • ITIME {Time series file}
  • IRLIM {Spectral file---real and imaginary}
  • IAMPH {Spectral file---amplitude and phase}
  • IXY {General x versus y data}
  • IXYZ {General XYZ (3-D) file}

LEVEN should be set to TRUE unless the IFTYPE is IXY.

NVHDR=6 is the default for WSAC0.

If one is reading this file from within SAC, the code for the programs is not visible, just the link to the file in ${SACHOME}/doc/examples/. The SAC manual, in either HTML or PDF, includes the code. If you do not have the manual on your computer, you can get the more complete version by going to URL <http://ds.iris.edu/files/sac-manual/manual/input_output.html>.

Reading a Evenly-Sampled SAC File

This routine will be used 95% of the time as most SAC files are of the evenly-time-sampled variety. Using rsac1(), the time sampling, beginning time, and amplitude data are returned and the remainder of the header values are held in memory for later access or until the next call to rsac1().

Fortran Example

      program rsac
      implicit none

!     Define the Maximum size of the data Array
      integer MAX
      parameter (MAX=1000)

!     Define the Data Array of size MAX
      real yarray
      dimension yarray(MAX)

!     Declare Variables used in the rsac1() subroutine
      real beg, del
      integer nlen
      character*10 KNAME
      integer nerr

!     Define the file to be read      g
      kname = 'FILE1'

!     Call rsac1 to read filename kname
!        - Data is loaded into yarray
!        - Length of data is stored in nlen
!        - Begining time and time sampling are in beg and del
!        - MAX is the maximum number of points to be read in 
!        - nerr is the Error return flag
      call rsac1(kname, yarray, nlen, beg, del, MAX, nerr)

!     Check the error status, nerr
!        - 0 on Success
!        - Non-Zero on Failure
      if(nerr .NE. 0) then
          write(*,*)'Error reading in file: ',kname
          call exit(-1)
      endif

!     Do some processing ....

      call exit(0)
      end

Be sure to check the error value after the return from rsac1(). This will help solve a number of unforeseen problems in the future.

Reading a Evenly-Sampled SAC File: C Example

#include <stdio.h>
#include <string.h>
#include <stdlib.h>

#include <sacio.h>

/* Define the maximum length of the data array */
#define MAX 1000

int
main(int argc, char **argv)
{
  /* Define variables to be used in the call to rsac1() */
  float yarray[MAX], beg, del;
  int nlen, nerr, max = MAX;
  char kname[ 11 ] ;
  
  /* Copy the name of the file to be read into kname */
  strcpy( kname , "FILE1" ) ;
  

  /* Call rsac1 to read filename kname
     - Data is loaded into yarray
     - Length of data is stored in nlen
     - Begining time and time sampling are in beg and del
     - max is the maximum number of points to be read in 
     - nerr is the error return flag
     - strlen( kname ) is the length of character array kname
     All variables are passed as references either
         arrays like kname and yarray or
         using &varible to pass reference to variable
  */
  rsac1( kname, yarray, &nlen, &beg, &del, &max, &nerr, strlen( kname ) ) ;

  /* Check the error status, nerr
     - 0 on Success
     - Non-Zero on Failure  
  */
  if ( nerr != 0 ) {
    fprintf(stderr, "Error reading in SAC file: %s\n", kname);
    exit ( nerr ) ;
  }
  
  /* Do some processing ... */
  
  exit(0);
}

Note that in the call to rsac1() in C there is an extra parameter after nerr. This is the string length specifier which specifies the length of the string kname. The length of the string does not include a null terminator. Note also that all of the parameters are passed by reference except the string length specifier.

NVHDR=7: Use of rsac1() to read v7 files works, but values of calling arguments b and delta are the REAL*4 header variables. To obtain the full 64 bit v7 footer values, follow the rsac1() call with:

call getdhv("begin", begin, nerr)
call getdhv("delta", delta, nerr)

If there are other REAL*8 variables of interest in the v7 footer such as t0, one can get them by commands such as call getdhv("t0",t0,nerr), where t0 has been declared to be REAL*8.

Reading an Unevenly-Sampled or Spectral SAC File

In routine rsac2() is for reading in either:
  • a spectral file, (Real + Imaginary or Amplitude + Phase)
  • an unevely spaced time series file (Amplitude + Time)

To determine the type of file, you must check the IFTYPE and LEVEN header variables:

  • Evenly spaced file: IFTYPE = ITIME (1) and LEVEN = True
  • Unevenly spaced file: IFTPYE = ITIME (1) and LEVEN = False
  • Spectral file: (Real + Imaginary) IFTYPE = IRLIM (2)
  • Spectrla file: (Amplitude + Phase) IFTYPE = IAMPH (3)

Both components are returned on the call to rsac2(). For an unevenly-sampled file, the first array is the independent variable and the second one the dependent variable. Unlike rsac1(), the beginning time and time sampling are not returned as they can be determined from the returned time data.

Fortran Example

      program rsac_2
      implicit none

!     Define the Maximum size of the data Array
      integer MAX
      parameter (MAX=3000)

!     Define the Time and Amplitude arrays of zize MAX
      real xarray, yarray
      dimension xarray(MAX), yarray(MAX)

!     Declare Variables used in the rsac2() subroutine
      character*10 kname
      integer nlen
      integer nerr

!     Define the file to be read      
      kname='file2'

!     Call rsac2 to read filename kname
!        - Amplitude Data is loaded into yarray
!        - Length of data is stored in nlen
!        - Time Data is loaded into xarray
!        - MAX is the maximum number of points to be read in 
!        - nerr is the Error return flag
      call rsac2(kname,yarray,nlen,xarray,MAX,nerr)

!     Check the error status, nerr
!        - 0 on Success
!        - Non-Zero on Failure
      if(nerr .ne. 0) then
         write(*,*)'error reading in sac file: ',kname
         call exit(-1)
      endif

!     Do some processing ....

      call exit(0)
      end
      

Reading a Spectral SAC File: C Example

#include <stdio.h>
#include <string.h>
#include <stdlib.h>

#include <sacio.h>

/* Define the maximum length of the data and time array */
#define MAX 3000

int
main(int argc, char *argv[])
{
  /* Define variables to be used in the call to rsac2() */
  float xarray[MAX], yarray[MAX];
  int nlen, nerr, max;
  char kname[ 11 ] ;
  
  max = MAX;

  /* Copy the name of the file to be read into kname */
  strcpy(kname, "FILE2") ;

  /* Call rsac1 to read filename kname
     - Amplitude Data is loaded into yarray
     - Length of data is stored in nlen
     - Time Data is loaded into xarray
     - max is the maximum number of points to be read in 
     - nerr is the error return flag
     - strlen( kname ) is the length of character array kname
     All variables are passed as references either
         arrays like kname and yarray or
         using &varible to pass reference to variable
  */
  rsac2(kname, yarray, &nlen, xarray, &max, &nerr, strlen( kname )) ;

  /* Check the error status, nerr
     - 0 on Success
     - Non-Zero on Failure  
  */
  if ( nerr > 0 ) {
      fprintf(stderr, "Error reading in SAC file: %s %d\n", kname, nerr);
    exit(nerr) ;
  }

  /* Do some processing ... */

  exit(0);
}

NVHDR=7: If one uses rsac2() to read a v7 file, timing values stored in xarray are still REAL*4.

Accessing Header Variables

Accessing the header variables following either rsac1() or rsac2() is straight forward. Depending on the type of variable requested, the routine called will be different.

Fortran Example

      program rsac
      implicit none

!     Define the Maximum size of the data Array
      integer max
      parameter (MAX=1000)

!     Define the Data Array of size MAX
      real yarray
      dimension yarray(MAX)

!     Declare Variables used in the rsac1() and getfhv() subroutines
      character*10 kname
      character*9 name
      integer nlen
      real beg, del
      integer nerr
      integer n1, n2
      real delta, b, t1, t2

!     Define the file to be read
      kname='file1'

!     Read in the SAC File
      call rsac1(kname,yarray,nlen,beg,del,MAX,nerr)

!     Check the Error status
      if(nerr .ne. 0) then
         write(*,*)'Error reading SAC file: ',kname
         call exit(-1)
      endif

!     Get floating point header value: Delta
!        'delta' - name of the header variable requested
!        delta   - value of the header variable delta, returned
!        nerr    - Error return flag
      call getfhv('delta',delta,nerr)
      if(nerr .ne. 0) then
         write(*,*)'Error reading variable: delta'
         call exit(-1)
      endif

!     Get floating point header value: B
      call getfhv('b',b,nerr)
      if(nerr .ne. 0) then
         write(*,*)'Error reading variable: b'
         call exit(-1)
      endif

!     Get floating point header value: t1
      call getfhv('t1',t1,nerr)
      if(nerr .ne. 0) then
         write(*,*)'Error reading variable: t1'
         call exit(-1)
      endif

!     Get floating point header value: t2
      call getfhv('t2',t2,nerr)
      if(nerr .ne. 0) then
         write(*,*)'Error reading variable: t2'
         call exit(-1)
      endif

!     Compute the time sample at which t1 and t2 occur
      n1 = int((t1 - b) / delta)
      n2 = int((t2 - b) / delta)

!     ......
      name = ' '
      call getkhv('kstnm', name, nerr);
      if(nerr .ne. 0) then
         write(*,*)'Error reading variable: kstnm'
         call exit(-1)
      endif

      call exit(0)
      end

Accessing Header Variables: C Example


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include <sacio.h>

/* Define the maximum length of the data array */
#define MAX 1000

int
main(int argc, char *argv[])
{ 
  /* Define variables to be used in the call to rsac1() and getfhv() */
  int max = MAX, nlen, nerr, n1, n2;
  float yarray[ MAX ] , beg , del , delta , B , T1 , T2 ;
  char kname[ 11 ] ;

  /* Copy the name of the file to be read into kname */
  strcpy ( kname , "FILE1" ) ;

  /* Read in the SAC File */
  rsac1( kname, yarray, & nlen, & beg, & del, & max, & nerr, strlen( kname ) ) ;

  /* Check the Error status */
  if ( nerr != 0 ) {
    fprintf(stderr, "Error reading SAC file: %s\n", kname);
    exit(-1);
  }

  /* Get floating point header value: Delta
     "DELTA" - name of the header variable requested
      delta  - value of the header variable delta, returned
      nerr   - Error return flag
      strlen("DELTA") - Length of the character array "DELTA"
  */
  getfhv ( "DELTA" , & delta , & nerr , strlen("DELTA") ) ;
  /* Check the Return Value */
  if ( nerr != 0 ) {
    fprintf(stderr, "Error getting header variable: delta\n");
    exit(-1);
  }

  /* Get floating point header value: B */
  getfhv ( "B" , &B , & nerr , strlen("B") ) ;
  if ( nerr != 0 ) {
    fprintf(stderr, "Error getting header variable: b\n");
    exit(-1);
  }

  /* Get floating point header value: T1 */
  getfhv ( "T1" , & T1 , & nerr , strlen("T1") ) ;
  if ( nerr != 0 ) {
    fprintf(stderr, "Error getting header variable: t1\n");
    exit(-1);
  }

  /* Get floating point header value: T2 */
  getfhv ( "T2" , & T2 , & nerr , strlen("T2") ) ;
  if ( nerr != 0 ) {
    fprintf(stderr, "Error getting header variable: t2\n");
    exit(-1);
  }

  /* Compute the time sample at which t1 and t2 occur  */
  n1 = (int) ( ( ( T1 - B ) / delta ) + 0.5 ) ;
  n2 = (int) ( ( ( T2 - B ) / delta ) + 0.5 ) ;
  
  /* ... */

  exit(0);
  
}

NVHDR=7: If one wants the 64-bit version of one of the 22 floating-point header variables that are in the v7 footer, one should use GETDHV. If NVHDR=6, GETDHV will return 32-bit values promoted to 64 bit but does not increase their precision.

Writing an Evenly-Spaced SAC File

Fortran Example

      program wsac
      implicit none

!     Define the Maximum size of data array
      integer MAX
      parameter (MAX=200)

!     Define the data array
      real yfunc
      dimension yfunc(MAX)

!     Define variables to be passed to wsac1()
      character*10 kname
      integer j
      integer nerr
      real beg
      real del
      real x

!     Define the file to be written, the beginning time
!     time sampling, and the initial value
      kname = 'expdata'
      beg   = 0.00
      del   = 0.02
      x     = beg

!     Create the Amplitude data, an Exponential
      do j=1,MAX
         yfunc(j)=exp(-x)
         x=x+del
      enddo

!     Write the SAC file kname
!       - kname holds the name of the file to be written
!       - yfunc Input Amplitude data
!       - MAX number of points to be written
!       - beg Beginning Time of the data
!       - del Time Sampling of the series
!       - nerr Error return Flag
      call newhdr()
      call wsac1(kname,yfunc,MAX,beg,del,nerr)

!     Check the Error status
!       - 0 on Success
!       - Non-Zero on Error
      if(nerr .NE. 0) then
         write(*,*)'Error writing SAC File: ', kname, nerr
         call exit(-1)
      endif

      call exit(0)
      end

Writing an Evenly-Spaced SAC File: C Example


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>

#include <sacio.h>

/* Define the Maximum size of data array */
#define MAX 200

int
main(int argc, char *argv[])
{
  
  /* Define variables to be passed to wsac1() */
  int max, j, nerr;
  float yfunc[ MAX ], x, beg, del;
  char kname[ 10 ];
  
  max = MAX;

  /* Define the file to be written, the beginning time 
     time sampling, and the initial value
  */
  strcpy ( kname , "expdata" ) ;
  beg = 0.00;
  del = 0.02;
  x = beg;

  /* Create the Amplitude data, an Exponential */
  for ( j = 0; j < MAX ; j++ ) {
    yfunc[ j ] = exp ( -x ) ;
    x = x + del;
  }

  /* Write the SAC file kname
     - kname holds the name of the file to be written
     - yfunc Input Amplitude data
     - max number of points to be writtne
     - beg Beginning Time of the data
     - del Time Sampling of the series
     - nerr Error return Flag
     - strlen(kname) Length of the character array kname
  */
  newhdr();
  wsac1 (kname, yfunc, &max, &beg, &del, &nerr, strlen( kname )) ;

  /* Check the Error status
     - 0 on Success
     - Non-Zero on Error
  */
  if(nerr != 0) {
      fprintf(stderr, "Error writing SAC File: %s %d\n", kname, nerr);
      exit(-1);
  }
  
  exit(0);
}


NVHDR=7 - Writing a Version 7 file is only currently possible using WSAC0. Use of WSAC1 or WSAC2 create a v6 header with NEWHDR and are unable to write a v7-type file.

If you are writing a v7 file then, you will need to do either:

!  To Generate a new file
integer :: nerr
real*8  :: t0
real*4  :: y(101), x(1)

y(:)  = 0.0
y(50) = 1.0

call newhdr()
call setnhv("nvhdr", 7, nerr)
call setnhv("npts", 101, nerr)

t0 = 10.12
call setdhv("t0", t0, nerr)

call wsac0("filename.sac", x, y, nerr)
if(nerr .ne. 0) then
   write(*,*)'Error writing sac file',nerr
endif

or to read, update, and write the file over:

! Read, update and write a file
integer :: nerr, max, nlen
real*4 :: b, dt
real*8 :: t0
real*4 :: y(1000), x(1)
max = 1000

call rsac1("filename.sac", y, nlen, b, dt, max, nerr)

! Convert v6 to v7 if necessary
call setnhv("nvhdr", 7, nerr)

t0 = 15.12
call setdhv("t0", t0, nerr  )

call wsac0("filename.sac", x, y, nerr)
if(nerr .ne. 0) then
   write(*,*)'Error writing sac file',nerr
endif

Writing an Unevenly-Spaced or Spectral SAC File

Fortran Example

      program wsac2f
      implicit none

!     Define the Maximum size of the data arrays      p
      integer MAX
      parameter (MAX=300)
      
!     Define both data arrays, time and amplitude
      real xdata, ydata
      dimension xdata(MAX), ydata(MAX)

!     Define the varaibles used in the call to wsac2()
      character*11 kname
      integer j
      integer nerr

!     Set the name the file to be written and initial x value
      kname='expdata    '
      xdata(1) = 0.1

!     Create the Amplitude and Time, an Exponential
!     Best viewed with axis as loglin
      ydata(1) = exp(-xdata(1))
      do j=2,MAX
         xdata(j) = xdata(j-1) + xdata(j-1) * 1.0/(4.0 * 3.1415);
         ydata(j) = exp(-xdata(j))
      enddo

!     Write the SAC file kname
!       - kname holds the name of the file to be written
!       - yfunc Input Amplitude Data
!       - MAX number of points to be written
!       - xdata Input Time Data      
!       - nerr Error return Flag
      call newhdr()
      call wsac2(kname,ydata,MAX,xdata,nerr)

!     Check the Error status
!       - 0 on Success
!       - Non-Zero on Error
      if(nerr .NE. 0) then
         write(*,*)'Error writing SAC File: ', kname,nerr
         call exit(-1)
      endif

      call exit(0)

      end
      

Writing an Unevenly-Spaced or Spectral SAC File: C Example


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>

#include <sacio.h>

/* Define the Maximum size of the data arrays  */
#define MAX 300

int
main(int argc, char *argv[])
{
  /* Define the varaibles used in the call to wsac2() */
  float xdata[MAX], ydata[MAX] ;
  int max, nerr;
  char kname[ 11 ];
  int j;
  
  max = MAX;

  /* Set the name the file to be written and initial x value */
  strcpy ( kname , "expdata" ) ;
  xdata[0] = 0.1;

  /*  Create the Amplitude and Time, an Exponential 
   *  Best viewed with axis as loglin
   */
  ydata[0] = exp(-xdata[0]);
  for(j = 1; j < max; j++) {
    xdata[j] = xdata[j-1] + xdata[j-1] * 1/(4 * M_PI);
    ydata[j] = exp(-xdata[j]);
  }
  
  /* Write the SAC file kname
     - kname holds the name of the file to be written
     - yfunc Input Amplitude Data
     - max number of points to be written
     - xdata Input Time Data      
     - nerr Error return Flag
     - strlen(kname) Length of character string kname
  */
  newhdr();
  wsac2(kname, ydata, &max, xdata, &nerr, strlen( kname )) ;


  /* Check the Error status
     - 0 on Success
     - Non-Zero on Error
  */
  if(nerr != 0) {
    fprintf(stderr, "Error writing SAC File: %s\n", kname);
    exit(-1);
  }

  exit(0);

}

Writing a File with a Comprehensive Header

To create a SAC data file with more information in the header than WSAC1 and WSAC2 allow, you need to use a set of subroutines that store header variables and then use WSAC0. Below are three examples, the first is similar to the example for WSAC2.

Writing Unevenly-Spaced Data: Fortran

      program wsac3f
      implicit none

!     Define the Maximum size of the data arrays      p
      integer MAX
      parameter (MAX=300)

!     Define both data arrays, time and amplitude
      real xdata, ydata
      dimension xdata(MAX), ydata(MAX)

!     Define the varaibles used in the call to wsac2()
      character*11 kname
      integer j
      integer nerr
      real cona, conb

!     Set the name the file to be written and initial x value
      kname='expdata    '
      xdata(1) = 0.1
      cona     = 12.3
      conb     = -45.6

!     Create the Amplitude and Time, an Exponential
!     Best viewed with axis as loglin
      ydata(1) = exp(-xdata(1))
      do j=2,MAX
         xdata(j) = xdata(j-1) + xdata(j-1) * 1.0/(4.0 * 3.1415);
         ydata(j) = exp(-xdata(j))
      enddo

!     Create a New Header to store more information
!     Newly created header value are set to a default state
      call newhdr()

!     Store values in the newly created header
!     You must define the following header variables
!        - delta  Time Sampling
!                 Only if the file is evenly spaced
!        - b      Beginning Time
!        - e      Ending Time
!        - npts   Number of Points in the File
!        - iftype File Type
!             - itime Time Series File
!             - irlim Spectral File Real/Imaginary
!             - iamph Spectral File Amplitue/Phase
!             - ixy   X-Y File
!             - iunkn Unknown
!
!     All other variables are up to the user
      call setnhv('npts',    max,        nerr)
      call setlhv('leven',   .false.,    nerr)
      call setfhv('b',       xdata(1),   nerr)
      call setfhv('e',       xdata(max), nerr)
      call setihv('iftype',  'ixy',      nerr)
      call setfhv('user0',   cona,       nerr)
      call setfhv('user1',   conb,       nerr)
      call setkhv('kuser0', 'gendat',    nerr)

!     Write the SAC file kname
!       - kname holds the name of the file to be written
!       - xdata Input Time Data
!       - yfunc Input Amplitude Data
!       - nerr Error return Flag
      call wsac0(kname,xdata,ydata,nerr)

!     Check the Error status
!       - 0 on Success
!       - Non-Zero on Error
      if(nerr .NE. 0) then
         write(*,*)'Error writing SAC File: ', kname,nerr
         call exit(-1)
      endif

      call exit(0)

      end

Writing Unevenly-Spaced Data: C

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>

#include <sacio.h>

/* Define the Maximum size of the data arrays  */
#define MAX 300

int
main(int argc, char *argv[])
{
  /* Define the varaibles used in the call to wsac2() */
  float xdata[MAX], ydata[MAX] ;
  int max, nerr;
  char kname[ 11 ];
  int j;
  int leven;
  float cona, conb;

  max = MAX;

  /* Set the name the file to be written and initial x value */
  strcpy ( kname , "expdata" ) ;
  xdata[0] = 0.1;
  leven    = 0;
  cona     = 12.3;
  conb     = -45.6;

  /*  Create the Amplitude and Time, an Exponential
   *  Best viewed with axis as loglin
   */
  ydata[0] = exp(-xdata[0]);
  for(j = 1; j < max; j++) {
    xdata[j] = xdata[j-1] + xdata[j-1] * 1/(4 * M_PI);
    ydata[j] = exp(-xdata[j]);
  }

  /* Create a New Header to store more information
     Newly created header value are set to a default state
  */
  newhdr();

  /* Store values in the newly created header
     You must define the following header variables
     - delta  Time Sampling
              Only if the file is evenly spaced
     - b      Beginning Time
     - e      Ending Time
     - npts   Number of Points in the File
     - iftype File Type
          - itime Time Series File
    - irlim Spectral File Real/Imaginary
    - iamph Spectral File Amplitue/Phase
    - ixy   X-Y File
    - iunkn Unknown

     All other variables are up to the user
  */
  setnhv ( "npts",   &max,            &nerr, strlen("npts"));
  setlhv ( "leven",  &leven,          &nerr, strlen("leven"));
  setfhv ( "b",      &(xdata[0]),     &nerr, strlen("b"));
  setfhv ( "e",      &(xdata[max-1]), &nerr, strlen("e"));
  setihv ( "iftype", "ixy",           &nerr, strlen("iftype"), strlen("ixy"));
  setfhv ( "user0",  &cona,           &nerr, strlen("user0"));
  setfhv ( "user1",  &conb,           &nerr, strlen("user1"));
  setkhv ( "kuser0", "gendat",        &nerr, strlen("kuser0"), strlen("gendat"));

  /* Write the SAC file kname
     - kname holds the name of the file to be written
     - xdata Input Time Data
     - yfunc Input Amplitude Data
     - nerr Error return Flag
     - strlen(kname) Length of character string kname
  */
  wsac0(kname, xdata, ydata, &nerr, strlen( kname )) ;

  /* Check the Error status
     - 0 on Success
     - Non-Zero on Error
  */
  if(nerr != 0) {
    fprintf(stderr, "Error writing SAC File: %s\n", kname);
    exit(-1);
  }

  exit(0);

}

XYZ (3-D) Files: Fortran

      program wsac
      implicit none
      
!     Maximum Size of Array, in 2-D
      integer MAX
      parameter (MAX=36)

!     Size of arrays to store the data
      real dummy, zdata
      dimension dummy(MAX), zdata(MAX)
      
!     Define variables to be passed into wsac0() 
      character*10 kname
      integer i, j, k
      integer nerr
      integer nx, ny
      real minimum, maximum

!     Define the file to be written and the min and max of the 2-D Array
      kname   = 'xyzdata'
      minimum = 1.0
      maximum = 6.0
      nx      = 6
      ny      = 6
      
      ! Create the 2D Data
      k = 1
      do i = 1,nx
         do j = 1,ny
            zdata(k) = sqrt(j * 1.0 * j + i * 1.0 * i)
            k = k + 1
         enddo
      enddo

      ! Create a new Header and fill it
      !   We are defining the data type, iftype to be 'ixyz', a 2-D Array
      call newhdr
      call setnhv('npts',     MAX,     nerr)
      call setlhv('leven',    .true.,  nerr)
      call setihv('iftype',   'ixyz',  nerr)
      call setnhv('nxsize',   nx,      nerr)
      call setnhv('nysize',   ny,      nerr)
      call setfhv('xminimum', minimum, nerr)
      call setfhv('xmaximum', maximum, nerr)
      call setfhv('yminimum', minimum, nerr)
      call setfhv('ymaximum', maximum, nerr)

!     Write the SAC file kname
!       - kname holds the name of the file to be written
!       - dummy Input Amplitude Data
!       - zdata Input Time Data      
!       - nerr Error return Flag
      call wsac0(kname,dummy,zdata,nerr)

!     Check the Error status
!       - 0 on Success
!       - Non-Zero on Error
      if(nerr .NE. 0) then
         write(*,*)'Error writing SAC File: ', kname,nerr
         call exit(-1)
      endif

      call exit(0)

      end

Although data in SAC memory are stored in a linear 1-D array, one should think of the Z data as being placed in a 2-D grid, in the order left-to-right, bottom-to-top. See the CONTOUR command for additional information.

XYZ (3-D) Files: C

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>

#include <sacio.h>

#define MAX 36

int
main(int argc, char *argv[]) {

  /*  Maximum Size of Array, in 2-D */
  int max;

  /* Size of arrays to store the data */
  float dummy[MAX], zdata[MAX];

  /*  Define variables to be passed into wsac0 */
  char kname[10];
  int i, j, k;
  int nerr;
  int nx, ny;
  int leven;
  float minimum, maximum;

  /*  Define the file to be written and the min and max of the 2-D Array */
  strcpy(kname, "xyzdata");
  max     = MAX;
  minimum = 1.0;
  maximum = 6.0;
  nx      = 6;
  ny      = 6;
  leven   = 1;

  /* Create the 2D Data */
  k = 0;
  for(i = minimum-1; i < maximum; i++) {
    for(j = minimum-1; j < maximum; j++) {
      zdata[k] = sqrt(i * i + j * j);
      k = k + 1;
    }
  }

  /* Create a new Header and fill it
     We are defining the data type, iftype to be 'ixyz', a 2-D Array
  */
  newhdr();
  setnhv("npts",     &max,     &nerr, strlen("npts"));
  setlhv("leven",    &leven,   &nerr, strlen("leven"));
  setihv("iftype",   "ixyz",   &nerr, strlen("iftype"), strlen("ixyz"));
  setnhv("nxsize",   &nx,      &nerr, strlen("nxsize"));
  setnhv("nysize",   &ny,      &nerr, strlen("nysize"));
  setfhv("xminimum", &minimum, &nerr, strlen("xminimum"));
  setfhv("xmaximum", &maximum, &nerr, strlen("xmaximum"));
  setfhv("yminimum", &minimum, &nerr, strlen("yminimum"));
  setfhv("ymaximum", &maximum, &nerr, strlen("ymaximum"));
  /* Write the SAC file kname
     - kname holds the name of the file to be written
     - dummy Input Amplitude Data
     - zdata Input Time Data
     - nerr Error return Flag
  */

  wsac0(kname, dummy, zdata, &nerr,strlen(kname));

  /* Check the Error status
     - 0 on Success
     - Non-Zero on Error
  */
  if(nerr != 0) {
    fprintf(stderr, "Error writing SAC File: %s %d\n", kname,nerr);
    exit(-1);
  }

  exit(0);

}

Evenly-Spaced Data: Fortran

      program wsac5f
      implicit none

      integer NCOMP
      parameter(NCOMP=11)

      integer NDATA
      parameter(NDATA=4000)

      real sdata(NDATA,NCOMP+1), xdummy(NDATA)
      CHARACTER KNAME(NCOMP+1)*10
      real evla, evlo, stla, stlo
      character*11 kevnm, kstnm
      real b, delta
      real cmpaz, cmpinc
      integer npts
      integer nerr, j, i

      DATA KNAME/'STAZ','STBZ','STCZ','STDZ','STEZ',
     1       'STFZ','STGZ','STHZ','STHN','STHE','STHN','STNQ' /

      b      = 0.0
      delta  = 0.25
      cmpaz  = 0.0
      cmpinc = 0.0
      npts  = NDATA
      evla   = -23.56
      evlo   = 123.56

      call newhdr () ;
      call setihv("IFTYPE", "ITIME", nerr)
      call setihv("IZTYPE", "IB",    nerr)
      call setfhv("B",      b,       nerr)
      call setlhv("LEVEN",  .TRUE.,  nerr)
      call setfhv("DELTA",  delta,   nerr)

      kevnm = "Event Name"

      call setnhv("NPTS",   npts,  nerr)
      call setfhv("EVLA",   evla,   nerr)
      call setfhv("EVLO",   evlo,   nerr)
      call setkhv("KEVNM",  kevnm,  nerr)
      call setfhv("CMPAZ",  cmpaz,  nerr)
      call setfhv("CMPINC", cmpinc, nerr)

      do j = 1,NCOMP-2
         kstnm = kname(j)
         call setkhv ( "KSTNM", kstnm, nerr)
         stla = j * 10
         stlo = j * 20
         do i = 1,NDATA
            sdata(i,j) = 1.0 * rand()
         enddo
         call setfhv ( "STLA" , stla , nerr )
         call setfhv ( "STLO" , stlo , nerr )
         call wsac0 ( kstnm, xdummy, sdata(1,j), nerr)
      enddo

      cmpinc = 90.0
      call setfhv("CMPINC", cmpinc, nerr)
      j = 9
      do i = 1,NDATA
         sdata(i,j) = 1.0 * rand()
      enddo
      call wsac0(kname(9), xdummy, sdata(1,9), nerr)

      cmpaz = 90.0
      call setfhv("CMPAZ", cmpaz, nerr)
      j = 10
      do i = 1,NDATA
         sdata(i,j) = 1.0 * rand()
      enddo
      call wsac0(kname(10), xdummy, sdata(1,10), nerr)

      end

Evenly-Spaced Data: C

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdint.h>

#include <sacio.h>

#define NCOMP   11
#define NDATA   4000
#define NSTA    11
#define FALSE   0
#define TRUE    1

int
main(int argc, char *argv[])
{
    float sdata[NCOMP][NDATA], xdummy[NDATA];
    float evla, evlo, stla, stlo;
    char kevnm[NSTA] , *kstnm ;
    int nerr, ndata, j, i;
    float b, delta;
    float cmpaz, cmpinc;

    char kname[NCOMP][NSTA] = { "STAZ" , "STBZ" , "STCZ" , "STDZ" , "STEZ" ,
                                "STFZ" , "STGZ" , "STHZ" , "STHN" , "STHE", "STHN" } ;

    int true  = TRUE;

    b      = 0.0;
    delta  = 0.25;
    cmpaz  = 0.0;
    cmpinc = 0.0;
    ndata  = NDATA;
    evla   = -23.56;
    evlo   = 123.56;

    newhdr () ;
    setihv("IFTYPE", "ITIME", &nerr , strlen("IFTYPE"), strlen("ITIME"));
    setihv("IZTYPE", "IB",    &nerr , strlen("IZTYPE"), strlen("IB"));
    setfhv("B",      &b,      &nerr , strlen("B"));
    setlhv("LEVEN",  &true,   &nerr , strlen("LEVEN"));
    setfhv("DELTA",  &delta,  &nerr , strlen("DELTA")) ;

    strcpy(kevnm, "Event Name");

    setnhv("NPTS",   &ndata,    &nerr, strlen("NPTS"));
    setfhv("EVLA",   &evla,     &nerr, strlen("EVLA"));
    setfhv("EVLO",   &evlo,     &nerr, strlen("EVLO"));
    setkhv("KEVNM",  &kevnm[0], &nerr, strlen("KEVNM"), SAC_STRING_LENGTH);
    setfhv("CMPAZ",  &cmpaz,    &nerr, strlen("CMPAZ"));
    setfhv("CMPINC", &cmpinc,   &nerr, strlen("CMPINC"));

    for ( j = 0 ; j < NCOMP - 2 ; j++ ) {
        kstnm = kname[j]  ;
        setkhv ( "KSTNM", kstnm, &nerr, strlen("KSTNM"), strlen(kstnm));
        stla = j * 10;
        stlo = j * 20;
        for(i = 0; i < NDATA; i++) {
            sdata[j][i] = 1.0 * rand()/INT32_MAX;
        }
        setfhv ( "STLA" , &stla , &nerr , strlen("STLA"));
        setfhv ( "STLO" , &stlo , &nerr , strlen("STLO"));
        wsac0 ( kstnm, xdummy, sdata[j], &nerr, strlen(kstnm));
    }

    cmpinc = 90.0;
    setfhv("CMPINC", &cmpinc, &nerr, strlen("CMPINC")) ;
    j = 9;
    for(i = 0; i < NDATA; i++) {
        sdata[j][i] = 1.0 * rand()/INT32_MAX;
    }
    wsac0(kname[9], xdummy, sdata[9], &nerr, strlen(kname[9]));

    cmpaz = 90.0;
    setfhv("CMPAZ", &cmpaz, &nerr, strlen("CMPAZ")) ;
    j = 10;
    for(i = 0; i < NDATA; i++) {
        sdata[j][i] = 1.0 * rand()/INT32_MAX;
    }
    wsac0(kname[10], xdummy, sdata[10], &nerr, strlen(kname[10]));

    return 0;
}

C-Style Interface

The C-style version of the library is fully documented at: https://savage13.github.io/sacio/html/index.html. More functions than shown below are available. A simple example is provided here for reference:

#include <stdio.h>
#include <sacio.h>

int nerr     = 0;
int ival     = 0;
double dt    = 0.0;
char sta[18] = {0};

// Read a file named "file.sac"
sac *s = sac_read("filename.sac", &nerr);

// Set and get the delta
sac_set_float(s, SAC_DELTA, 0.25);
sac_get_float(s, SAC_DELTA, &dt);
printf("delta: %f\n", dt);

// Set the file type to: evenly spaced, time series
sac_set_int(s, SAC_EVEN, 1);
sac_set_int(s, SAC_FILE_TYPE, ITIME);
sac_get_int(s, SAC_EVEN, &ival);
printf("leven:  %d\n", ival);
sac_get_int(s, SAC_FILE_TYPE, &ival);
printf("iftype: %d\n", ival);

// Set a string, SAC_KSTNM and SAC_STA are the same
sac_set_string(s, SAC_KSTNM, "PAS");
sac_get_string(s, SAC_STA, sta, sizeof sta);
printf("sta:   '%s'\n", sta);

// Most input strings are truncated at 8 characters
//     SAC_KNETWK and SAC_NET are the same
sac_set_string(s, SAC_KNETWK, "12345678");
sac_get_string(s, SAC_NET, sta, sizeof sta);
printf("net:   '%s'\n", sta);

// ... except for the Event name, it gets 16 characters
//     SAC_KEVNM and SAC_EVENT are the same
sac_set_string(s, SAC_EVENT, "1234567890123456");
sac_get_string(s, SAC_KEVNM, sta, sizeof sta);
printf("event: '%s'\n", sta);

// Set the file version to either v6 or v7
sac_set_v6(s);
sac_set_v7(s);
sac_get_int(s, SAC_HDR, &ival);
printf("hdr:    %d\n", ival);

// Amplitude (and time data) are accessed through
//    s->y and s->x
// Set the first five values
for(int i = 0; i < 5; i++) {
    s->y[i] = (float) i;
}
// Print out the first five data points
for(int i = 0; i < 5; i++) {
    printf("y[%d]: %e\n", i, s->y[i]);
}

// Write a sac file
sac_write(s, "filename.sac", &nerr);
if(nerr != 0) {
    printf("Error writing sac file: %d\n", nerr);
}

// Free the sac file
sac_free(s);
s = NULL;