function hb_to_mmm ( input_file, output_file )

%*****************************************************************************80
%
%% HB_TO_MM transfers sparse matrix information from an HB file to an MM file.
%
%  Discussion:
%
%    An HB file is a sparse matrix stored in the Harwell Boeing format.
%
%    An MM file is a sparse matrix stored in the Matrix Market format.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 November 2008
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILE, the name of the HB file to be read.
%
%    Input, string OUTPUT_FILE, the name of the MM file to be created.
%
  a = hb_to_msm ( input_file );

  msm_to_mm_coordinate_real_general ( output_file, a );

  return
end
function c = ch_cap ( c )

%*****************************************************************************80
%
%% CH_CAP capitalizes a single character.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 November 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, character C, the character to capitalize.
%
%    Output, character C, the capitalized character.
%
  if ( 'a' <= c & c <= 'z' )
    c = c + 'A' - 'a';
  end

  return
end
function truefalse = ch_eqi ( c1, c2 )

%*****************************************************************************80
%
%% CH_EQI is a case insensitive comparison of two characters for equality.
%
%  Example:
%
%    CH_EQI ( 'A', 'a' ) is TRUE.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 July 2000
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, character C1, C2, the characters to compare.
%
%    Output, logical TRUEFALSE, is TRUE (1) if the characters are equal.
%
  FALSE = 0;
  TRUE = 1;

  if ( ch_cap ( c1 ) == ch_cap ( c2 ) )
    truefalse = TRUE;
  else
    truefalse = FALSE;
  end

  return
end
function truefalse = ch_is_digit ( c )

%*****************************************************************************80
%
% CH_IS_DIGIT returns TRUE if the character C is a digit.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    11 December 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, character C, a character.
%
%    Output, integer TRUEFALSE, is TRUE (1) if C is a digit, FALSE (0) otherwise.
%
  TRUE = 1;
  FALSE = 0;

  if ( '0' <= c & c <= '9' )
    truefalse = TRUE;
  else
    truefalse = FALSE;
  end

  return
end
function truefalse = ch_is_format_code ( c )

%*****************************************************************************80
%
%% CH_IS_FORMAT_CODE returns TRUE if a character is a FORTRAN format code.
%
%  Discussion:
%
%    The format codes accepted here are not the only legal format
%    codes in FORTRAN90.  However, they are more than sufficient
%    for my needs!
%
%  Table:
%
%    A  Character
%    B  Binary digits
%    D  Real number, exponential representation
%    E  Real number, exponential representation
%    F  Real number, fixed point
%    G  General format
%    I  Integer
%    L  Logical variable
%    O  Octal digits
%    Z  Hexadecimal digits
%    *  Free format
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    21 November 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, character C, the character to be analyzed.
%
%    Output, logical TRUEFALSE, is TRUE (1) if C is a FORTRAN format code
%     and FALSE (0) otherwise.
%
  FALSE = 0;
  TRUE = 1;

      if ( ch_eqi ( c, 'A' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'B' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'D' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'E' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'F' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'G' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'I' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'L' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'O' ) )
    truefalse = TRUE;
  elseif ( ch_eqi ( c, 'Z' ) )
    truefalse = TRUE;
  elseif ( c == '*' )
    truefalse = TRUE;
  else
    truefalse = FALSE;
  end

  return
end
function digit = ch_to_digit ( c )

%*****************************************************************************80
%
%% CH_TO_DIGIT returns the integer value of a base 10 digit.
%
%  Example:
%
%     C   DIGIT
%    ---  -----
%    '0'    0
%    '1'    1
%    ...  ...
%    '9'    9
%    ' '    0
%    'X'   -1
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 November 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, character C, the decimal digit, '0' through '9' or blank
%    are legal.
%
%    Output, integer DIGIT, the corresponding integer value.  If C was
%    'illegal', then DIGIT is -1.
%
  if ( '0' <= c & c <= '9' )

    digit = c - '0';

  elseif ( c == ' ' )

    digit = 0;

  else

    digit = -1;

  end

  return
end
function exact = hb_exact_read ( input_unit, nrow, nrhs, rhscrd, rhsfmt, rhstyp )

%*****************************************************************************80
%
%% HB_EXACT_READ reads the exact solution vectors in an HB file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 February 2005
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992.
%
%  Parameters:
%
%    Input, integer INPUT_UNIT, the unit from which data is read.
%
%    Input, integer NROW, the number of rows or variables.
%
%    Input, integer NRHS, the number of right hand sides.
%
%    Input, integer RHSCRD, the number of lines in the file for
%    right hand sides.
%
%    Input, character ( len = 20 ) RHSFMT, the format for reading values
%    of the right hand side.
%
%    Input, character ( len = 3 ) RHSTYP, the right hand side type.
%    First character is F for full storage or M for same as matrix.
%    Second character is G if starting "guess" vectors are supplied.
%    Third character is X if exact solution vectors are supplied.
%    Ignored if NRHS = 0.
%
%    Output, real EXACT(NROW,NRHS), the exact solution vectors.
%
  exact = [];

  if ( 0 < rhscrd )

    if ( rhstyp(3) == 'X' )

      [ p, code, w, m ] = s_to_format ( rhsfmt );

      line_num = 1 + floor ( ( nrow - 1 ) / p );

      for irhs = 1 : nrhs

        jhi = 0;

        for i = 1 : line_num

          line = fgetl ( input_unit );
          jlo = jhi + 1;
          jhi = min ( jlo + p - 1, nrow );

          khi = 0;

          for j = jlo : jhi
            klo = khi + 1;
            khi = min ( klo + w - 1, length ( line ) );
            s = line(klo:khi);
            exact(j,irhs) = s_to_r8 ( s );
          end
        end
      end

    end

  end

  return
end
function [ title, key, totcrd, ptrcrd, indcrd, valcrd, rhscrd, mxtype, ...
  nrow, ncol, nnzero, neltvl, ptrfmt, indfmt, valfmt, rhsfmt, rhstyp, ...
  nrhs, nrhsix, colptr, rowind, values, rhsval, rhsptr, rhsind, guess, ...
  exact ] = hb_file_read ( input_unit )

%*****************************************************************************80
%
%% HB_FILE_READ reads an HB file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 April 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992.
%
%  Parameters:
%
%    Input, integer INPUT_UNIT, the unit from data is read.
%
%    Output, character ( len = 72 ) TITLE, a title for the matrix.
%
%    Output, character ( len = 8 ) KEY, an identifier for the matrix.
%
%    Output, integer TOTCRD, the total number of lines of data.
%
%    Output, integer PTRCRD, the number of input lines for pointers.
%
%    Output, integer INDCRD, the number of input lines for row indices.
%
%    Output, integer VALCRD, the number of input lines for numerical values.
%
%    Output, integer RHSCRD, the number of input lines for right hand sides.
%
%    Output, character ( len = 3 ) MXTYPE, the matrix type.
%    First character is R for Real, C for complex, P for pattern only.
%    Second character is S for symmetric, U for unsymmetric, H for
%      Hermitian, Z for skew symmetric, R for rectangular.
%    Third character is A for assembled and E for unassembled
%      finite element matrices.
%
%    Output, integer NROW, the number of rows or variables.
%
%    Output, integer NCOL, the number of columns or elements.
%
%    Output, integer NNZERO.  In the case of assembled sparse matrices,
%    this is the number of nonzeroes.  In the case of unassembled finite
%    element matrices, in which the right hand side vectors are also
%    stored as unassembled finite element vectors, this is the total
%    number of entries in a single unassembled right hand side vector.
%
%    Output, integer NELTVL, the number of finite element matrix entries,
%    set to 0 in the case of assembled matrices.
%
%    Output, character ( len = 16 ) PTRFMT, the format for reading pointers.
%
%    Output, character ( len = 16 ) INDFMT, the format for reading indices.
%
%    Output, character ( len = 20 ) VALFMT, the format for reading values.
%
%    Output, character ( len = 20 ) RHSFMT, the format for reading values
%    of the right hand side.
%
%    Output, character ( len = 3 ) RHSTYP, the right hand side type.
%    First character is F for full storage or M for same as matrix.
%    Second character is G if starting "guess" vectors are supplied.
%    Third character is X if exact solution vectors are supplied.
%    Ignored if NRHS = 0.
%
%    Output, integer NRHS, the number of right hand sides.
%
%    Output, integer NRHSIX, the number of row indices (set to 0
%    in the case of unassembled matrices.)  Ignored if NRHS = 0.
%
%    Output, integer COLPTR(NCOL+1), COLPTR(I) points to the location of
%    the first entry of column I in the sparse matrix structure.
%
%    Output, integer ROWIND(NNZERO) or ROWIND(NELTVL), the row index of
%    each item.
%
%    Output, real VALUES(NNZERO) or VALUES(NELTVL), the nonzero values
%    of the matrix.
%
%    If RHSTYP(1:1) == 'F':
%
%      Output, integer RHSPTR(*), is not used.
%
%      Output, integer RHSIND(*), is not used.
%
%      Output, real RHSVAL(NROW,NRHS), contains NRHS dense right hand
%      side vectors.
%
%    If RHSTYP(1:1) = 'M' and MXTYPE(3:3) = 'A':
%
%      Output, integer RHSPTR(NRHS+1), RHSPTR(I) points to the location of
%      the first entry of right hand side I in the sparse right hand
%      side vector.
%
%      Output, integer RHSIND(NRHSIX), indicates, for each entry of
%      RHSVAL, the corresponding row index.
%
%      Output, real RHSVAL(NRHSIX), contains the value of the right hand
%      side entries.
%
%    If RHSTYP(1:1) = 'M' and MXTYPE(3:3) = 'E':
%
%      Output, integer RHSPTR(*), is not used.
%
%      Output, integer RHSIND(*), is not used.
%
%      Output, real RHSVAL(NNZERO,NRHS), contains NRHS unassembled
%      finite element vector right hand sides.
%
%    Output, real GUESS(NROW,NRHS), the starting guess vectors.
%
%    Output, real EXACT(NROW,NRHS), the exact solution vectors.
%

%
%  Read the header block.
%
  [ title, key, totcrd, ptrcrd, indcrd, valcrd, rhscrd, mxtype, ...
    nrow, ncol, nnzero, neltvl, ptrfmt, indfmt, valfmt, rhsfmt, rhstyp, ...
    nrhs, nrhsix ] = hb_header_read ( input_unit );
%
%  Read the matrix structure.
%
  [ colptr, rowind ] = hb_structure_read ( input_unit, ncol, mxtype, ...
    nnzero, neltvl, ptrcrd, ptrfmt, indcrd, indfmt );
%
%  Read the matrix values.
%
  values = hb_values_read ( input_unit, valcrd, mxtype, nnzero, neltvl, ...
    valfmt );
%
%  Read the right hand sides.
%
  [ rhsval, rhsptr, rhsind ] = hb_rhs_read ( input_unit, nrow, nnzero, ...
    nrhs, nrhsix, rhscrd, ptrfmt, indfmt, rhsfmt, mxtype, rhstyp );
%
%  Read the starting guesses.
%
  guess = hb_guess_read ( input_unit, nrow, nrhs, rhscrd, rhsfmt, rhstyp );
%
%  Read the exact solutions.
%
  exact = hb_exact_read ( input_unit, nrow, nrhs, rhscrd, rhsfmt, rhstyp );

  return
end
function guess = hb_guess_read ( input_unit, nrow, nrhs, rhscrd, rhsfmt, rhstyp )

%*****************************************************************************80
%
%% HB_GUESS_READ reads the starting guess vectors in an HB file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 February 2005
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992.
%
%  Parameters:
%
%    Input, integer INPUT_UNIT, the unit from which data is read.
%
%    Input, integer NROW, the number of rows or variables.
%
%    Input, integer NRHS, the number of right hand sides.
%
%    Input, integer RHSCRD, the number of lines in the file for
%    right hand sides.
%
%    Input, character ( len = 20 ) RHSFMT, the format for reading values
%    of the right hand side.
%
%    Input, character ( len = 3 ) RHSTYP, the right hand side type.
%    First character is F for full storage or M for same as matrix.
%    Second character is G if starting "guess" vectors are supplied.
%    Third character is X if exact solution vectors are supplied.
%    Ignored if NRHS = 0.
%
%    Output, real GUESS(NROW,NRHS), the starting guess vectors.
%
  guess = [];

  if ( 0 < rhscrd )

    if ( rhstyp(2) == 'G' )

      [ p, code, w, m ] = s_to_format ( rhsfmt );

      line_num = 1 + floor ( ( nrow - 1 ) / p );

      for irhs = 1 : nrhs

        jhi = 0;

        for i = 1 : line_num

          line = fgetl ( input_unit );
          jlo = jhi + 1;
          jhi = min ( jlo + p - 1, nrow );

          khi = 0;

          for j = jlo : jhi
            klo = khi + 1;
            khi = min ( klo + w - 1, length ( line ) );
            s = line(klo:khi);
            guess(j,irhs) = s_to_r8 ( s );
          end
        end
      end

    end

  end

  return
end
function [ title, key, totcrd, ptrcrd, indcrd, valcrd, rhscrd, mxtype, ...
  nrow, ncol, nnzero, neltvl, ptrfmt, indfmt, valfmt, rhsfmt, rhstyp, ...
  nrhs, nrhsix ] = hb_header_read ( input_unit )

%*****************************************************************************80
%
%% HB_HEADER_READ reads the header of an HB file.
%
%  Discussion:
%
%    The user should already have opened the file, and positioned it
%    to the first record.
%
%    Thanks to Shahadat Hossain for pointing out an error in the determination
%    of INDFMT, on 24 June 2004.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 June 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992.
%
%  Parameters:
%
%    Input, integer INPUT_UNIT, the unit from which data is read.
%
%    Output, character ( len = 72 ) TITLE, a title for the matrix.
%
%    Output, character ( len = 8 ) KEY, an identifier for the matrix.
%
%    Output, integer TOTCRD, the total number of lines of data.
%
%    Output, integer PTRCRD, the number of input lines for pointers.
%
%    Output, integer INDCRD, the number of input lines for row indices.
%
%    Output, integer VALCRD, the number of input lines for numerical values.
%
%    Output, integer RHSCRD, the number of input lines for right hand sides.
%
%    Output, character ( len = 3 ) MXTYPE, the matrix type.
%    First character is R for Real, C for complex, P for pattern only.
%    Second character is S for symmetric, U for unsymmetric, H for
%      Hermitian, Z for skew symmetric, R for rectangular.
%    Third character is A for assembled and E for unassembled
%      finite element matrices.
%
%    Output, integer NROW, the number of rows or variables.
%
%    Output, integer NCOL, the number of columns or elements.
%
%    Output, integer NNZERO.  In the case of assembled sparse matrices,
%    this is the number of nonzeroes.  In the case of unassembled finite
%    element matrices, in which the right hand side vectors are also
%    stored as unassembled finite element vectors, this is the total
%    number of entries in a single unassembled right hand side vector.
%
%    Output, integer NELTVL, the number of finite element matrix entries,
%    set to 0 in the case of assembled matrices.
%
%    Output, character ( len = 16 ) PTRFMT, the format for reading pointers.
%
%    Output, character ( len = 16 ) INDFMT, the format for reading indices.
%
%    Output, character ( len = 20 ) VALFMT, the format for reading values.
%
%    Output, character ( len = 20 ) RHSFMT, the format for reading values
%    of the right hand side.
%
%    Output, character ( len = 3 ) RHSTYP, the right hand side type.
%    First character is F for full storage or M for same as matrix.
%    Second character is G if starting "guess" vectors are supplied.
%    Third character is X if exact solution vectors are supplied.
%
%    Output, integer NRHS, the number of right hand sides.
%
%    Output, integer NRHSIX, the number of entries of storage for right
%    hand side values, in the case where RHSTYP(1:1) = 'M' and
%    MXTYPE(3:3) = 'A'.
%

%
%  Read the header block.
%  Use FGETL rather that FGETS, because we don't want the line terminator character!
%  If fewer than 80 characters were read, you need to pad the line out.
%
  line = fgetl ( input_unit );

  if ( line == -1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'HB_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  I/O error reading header line 1.\n' );
    return;
  end

  line_num = length ( line );
  for i = line_num+1 : 80
    line(i) = ' ';
  end

  title = line(1:72);
  title = title(1:s_len_trim(title));

  key = line(73:80);
  key = key(1:s_len_trim(key));

  line = fgetl ( input_unit );

  if ( line == -1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'HB_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  I/O error reading header line 2.\n' );
    return;
  end

  line_num = length ( line );
  for i = line_num+1 : 80
    line(i) = ' ';
  end

  totcrd = s_to_i4 ( line( 1:14) );
  ptrcrd = s_to_i4 ( line(15:28) );
  indcrd = s_to_i4 ( line(29:42) );
  valcrd = s_to_i4 ( line(43:56) );
  rhscrd = s_to_i4 ( line(57:70) );

  line = fgetl ( input_unit );

  if ( line == -1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'HB_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  I/O error reading header line 3.\n' );
    return;
  end

  line_num = length ( line );
  for i = line_num+1 : 80
    line(i) = ' ';
  end

  mxtype =           line( 1: 3);
  nrow   = s_to_i4 ( line(15:28) );
  ncol   = s_to_i4 ( line(29:42) );
  nnzero = s_to_i4 ( line(43:56) );
  neltvl = s_to_i4 ( line(57:70) );

  line = fgetl ( input_unit );

  if ( line == -1 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'HB_HEADER_READ - Fatal error!\n' );
    fprintf ( 1, '  I/O error reading header line 4.\n' );
    return;
  end

  line_num = length ( line );
  for i = line_num+1 : 80
    line(i) = ' ';
  end

  ptrfmt = line( 1:16);
  ptrfmt = ptrfmt(1:s_len_trim(ptrfmt));
  indfmt = line(17:32);
  indfmt = indfmt(1:s_len_trim(indfmt));
  valfmt = line(33:52);
  valfmt = valfmt(1:s_len_trim(valfmt));
  rhsfmt = line(53:72);
  rhsfmt = rhsfmt(1:s_len_trim(rhsfmt));

  if ( 0 < rhscrd )

    line = fgetl ( input_unit );

    if ( line == -1 )
      fprintf ( 1, '\n' );
      fprintf ( 1, 'HB_HEADER_READ - Fatal error!\n' );
      fprintf ( 1, '  I/O error reading header line 5.\n' );
      return;
    end

    line_num = length ( line );
    for i = line_num+1 : 80
      line(i) = ' ';
    end

    rhstyp =           line( 1: 3);
    nrhs   = s_to_i4 ( line(15:28) );
    nrhsix = s_to_i4 ( line(29:42) );

  else

    rhstyp = ' ';
    nrhs = 0;
    nrhsix = 0;

  end

  return
end
function [ rhsval, rhsptr, rhsind ] = hb_rhs_read ( input_unit, nrow, ...
  nnzero, nrhs, nrhsix, rhscrd, ptrfmt, indfmt, rhsfmt, mxtype, rhstyp )

%*****************************************************************************80
%
%% HB_RHS_READ reads the right hand side information in an HB file.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 February 2005
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992.
%
%  Parameters:
%
%    Input, integer INPUT_UNIT, the unit from which data is read.
%
%    Input, integer NROW, the number of rows or variables.
%
%    Input, integer NNZERO.  In the case of assembled sparse matrices,
%    this is the number of nonzeroes.  In the case of unassembled finite
%    element matrices, in which the right hand side vectors are also
%    stored as unassembled finite element vectors, this is the total
%    number of entries in a single unassembled right hand side vector.
%
%    Input, integer NRHS, the number of right hand sides.
%
%    Input, integer NRHSIX, the number of entries of storage for right
%    hand side values, in the case where RHSTYP(1:1) = 'M' and
%    MXTYPE(3:3) = 'A'.
%
%    Input, integer RHSCRD, the number of lines in the file for
%    right hand sides.
%
%    Input, character ( len = 16 ) PTRFMT, the format for reading pointers.
%
%    Input, character ( len = 16 ) INDFMT, the format for reading indices.
%
%    Input, character ( len = 20 ) RHSFMT, the format for reading values
%    of the right hand side.
%
%    Input, character ( len = 3 ) MXTYPE, the matrix type.
%    First character is R for Real, C for complex, P for pattern only.
%    Second character is S for symmetric, U for unsymmetric, H for
%      Hermitian, Z for skew symmetric, R for rectangular.
%    Third character is A for assembled and E for unassembled
%      finite element matrices.
%
%    Input, character ( len = 3 ) RHSTYP, the right hand side type.
%    First character is F for full storage or M for same as matrix.
%    Second character is G if starting "guess" vectors are supplied.
%    Third character is X if exact solution vectors are supplied.
%    Ignored if NRHS = 0.
%
%    If RHSTYP(1:1) == 'F':
%
%      Output, integer RHSPTR(*), is not used.
%
%      Output, integer RHSIND(*), is not used.
%
%      Output, real RHSVAL(NROW,NRHS), contains NRHS dense right hand
%      side vectors.
%
%    If RHSTYP(1:1) = 'M' and MXTYPE(3:3) = 'A':
%
%      Output, integer RHSPTR(NRHS+1), RHSPTR(I) points to the location of
%      the first entry of right hand side I in the sparse right hand
%      side vector.
%
%      Output, integer RHSIND(NRHSIX), indicates, for each entry of
%      RHSVAL, the corresponding row index.
%
%      Output, real RHSVAL(NRHSIX), contains the value of the right hand
%      side entries.
%
%    If RHSTYP(1:1) = 'M' and MXTYPE(3:3) = 'E':
%
%      Output, integer RHSPTR(*), is not used.
%
%      Output, integer RHSIND(*), is not used.
%
%      Output, real RHSVAL(NNZERO,NRHS), contains NRHS unassembled
%      finite element vector right hand sides.
%
  rhsptr = [];
  rhsind = [];
  rhsval = [];
%
%  Read the right hand sides.
%    case F                             = "full" or "dense";
%    case not F + matrix storage is "A" = sparse pointer RHS
%    case not F + matrix storage is "E" = finite element RHS
%
  if ( 0 < rhscrd )
%
%  Dense right hand sides:
%
    if ( rhstyp(1) == 'F' )

      [ p, code, w, m ] = s_to_format ( rhsfmt );

      line_num = 1 + floor ( ( nrow - 1 ) / p );

      for irhs = 1 : nrhs

        jhi = 0;

        for i = 1 : line_num

          line = fgetl ( input_unit );
          jlo = jhi + 1;
          jhi = min ( jlo + p - 1, nrow );

          khi = 0;

          for j = jlo : jhi
            klo = khi + 1;
            khi = min ( klo + w - 1, length ( line ) );
            s = line(klo:khi);
            rhsval(j,irhs) = s_to_r8 ( s );
          end
        end
      end
%
%  Sparse right-hand sides stored like the matrix.
%  Read pointer array, indices, and values.
%
    elseif ( rhstyp(1) == 'M' )

      if ( mxtype(3) == 'A' )

        [ p, code, w, m ] = s_to_format ( ptrfmt );

        line_num = 1 + floor ( ( nrhs + 1 - 1 ) / p );

        jhi = 0;

        for i = 1 : line_num

          line = fgetl ( input_unit );
          jlo = jhi + 1;
          jhi = min ( jlo + p - 1, nrhs + 1 );

          khi = 0;

          for j = jlo : jhi
            klo = khi + 1;
            khi = min ( klo + w - 1, length ( line ) );
            s = line(klo:khi);
            rhsptr(j) = s_to_i4 ( s );
          end
        end

        [ p, code, w, m ] = s_to_format ( indfmt );

        line_num = 1 + floor ( ( nrhsix - 1 ) / p );

        jhi = 0;

        for i = 1 : line_num

          line = fgetl ( input_unit );
          jlo = jhi + 1;
          jhi = min ( jlo + p - 1, nrhsix );

          khi = 0;

          for j = jlo : jhi
            klo = khi + 1;
            khi = min ( klo + w - 1, length ( line ) );
            s = line(klo:khi);
            rhsind(j) = s_to_i4 ( s );
          end
        end

        [ p, code, w, m ] = s_to_format ( rhsfmt );

        line_num = 1 + floor ( ( nrhsix - 1 ) / p );

        jhi = 0;

        for i = 1 : line_num

          line = fgetl ( input_unit );
          jlo = jhi + 1;
          jhi = min ( jlo + p - 1, nrhsix );

          khi = 0;

          for j = jlo : jhi
            klo = khi + 1;
            khi = min ( klo + w - 1, length ( line ) );
            s = line(klo:khi);
            rhsval(j) = s_to_r8 ( s );
          end
        end
%
%  Sparse right hand sides in finite element format.
%
      elseif ( mxtype(3) == 'E' )

        [ p, code, w, m ] = s_to_format ( rhsfmt );

        line_num = 1 + floor ( ( nnzero - 1 ) / p );

        for irhs = 1 : nrhs

          jhi = 0;

          for i = 1 : line_num

            line = fgetl ( input_unit );
            jlo = jhi + 1;
            jhi = min ( jlo + p - 1, nnzero );

            khi = 0;

            for j = jlo : jhi
              klo = khi + 1;
              khi = min ( klo + w - 1, length ( line ) );
              s = line(klo:khi);
              rhsval(j,irhs) = s_to_r8 ( s );
            end
          end
        end

      else

        fprintf ( 1, '\n' );
        fprintf ( 1, 'HB_RHS_READ - Fatal error!\n' );
        fprintf ( 1, '  Illegal value of MXTYPE(3)!\n' );
        error ( 'HB_RHS_READ - Fatal error!' );

      end
%
%  0 < RHSCARD, but RHSTYP not recognized.
%
    else

      fprintf ( 1, '\n' );
      fprintf ( 1, 'HB_RHS_READ - Fatal error!\n' );
      fprintf ( 1, '  Illegal value of RHSTYP(1)!\n' );
      error ( 'HB_RHS_READ - Fatal error!' );

    end

  end

  return
end
function [ colptr, rowind ] = hb_structure_read ( input_unit, ncol, mxtype, ...
  nnzero, neltvl, ptrcrd, ptrfmt, indcrd, indfmt )

%*****************************************************************************80
%
%% HB_STRUCTURE_READ reads the structure of an HB matrix.
%
%  Discussion:
%
%    The user should already have opened the file, and positioned it
%    to just after the header records.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    08 April 2004
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992.
%
%  Parameters:
%
%    Input, integer INPUT_UNIT, the unit from which data is read.
%
%    Input, integer NCOL, the number of columns.
%
%    Input, character ( len = 3 ) MXTYPE, the matrix type.
%    First character is R for Real, C for complex, P for pattern only.
%    Second character is S for symmetric, U for unsymmetric, H for
%      Hermitian, Z for skew symmetric, R for rectangular.
%    Third character is A for assembled and E for unassembled
%      finite element matrices.
%
%    Input, integer NNZERO.  In the case of assembled sparse matrices,
%    this is the number of nonzeroes.  In the case of unassembled finite
%    element matrices, in which the right hand side vectors are also
%    stored as unassembled finite element vectors, this is the total
%    number of entries in a single unassembled right hand side vector.
%
%    Input, integer NELTVL, the number of finite element matrix entries,
%    set to 0 in the case of assembled matrices.
%
%    Input, integer PTRCRD, the number of pointer records.
%
%    Input, character ( len = 16 ) PTRFMT, the format for reading pointers.
%
%    Input, integer INDCRD, the number of index records.
%
%    Input, character ( len = 16 ) INDFMT, the format for reading indices.
%
%    Output, integer COLPTR(NCOL+1), COLPTR(I) points to the location of
%    the first entry of column I in the sparse matrix structure.
%
%    Output, integer ROWIND(NNZERO) or ROWIND(NELTVL), the row index of
%    each item.
%
  [ p, code, w, m ] = s_to_format ( ptrfmt );

  if ( mxtype(3) == 'A' )
    line_num = 1 + floor ( ( ( ncol + 1 ) - 1 ) / p );
  else
    line_num = 1 + floor ( ( ( ncol     ) - 1 ) / p );
  end

  jhi = 0;

  for i = 1 : line_num
    line = fgetl ( input_unit );
    jlo = jhi + 1;
    if ( mxtype(3) == 'A' )
      jhi = min ( jlo + p - 1, ncol + 1 );
    else
      jhi = min (  jlo + p - 1, ncol );
    end

    khi = 0;

    for j = jlo : jhi
      klo = khi + 1;
      khi = min ( klo + w - 1, length ( line ) );
      s = line(klo:khi);
      colptr(j) = s_to_i4 ( s );
    end

  end

  if ( mxtype(3) == 'A' )

    [ p, code, w, m ] = s_to_format ( indfmt );

    line_num = 1 + floor ( ( nnzero - 1 ) / p );

    jhi = 0;

    for i = 1 : line_num
      line = fgetl ( input_unit );
      jlo = jhi + 1;
      jhi = min ( jlo + p - 1, nnzero );

      khi = 0;

      for j = jlo : jhi
        klo = khi + 1;
        khi = min ( klo + w - 1, length ( line ) );
        s = line(klo:khi);
        rowind(j) = s_to_i4 ( s );
      end

    end

  elseif ( mxtype(3) == 'E' )

    [ p, code, w, m ] = s_to_format ( indfmt );
    number = colptr(ncol) - colptr(1);
    line_num = 1 + floor ( ( number - 1 ) / p );

    jhi = 0;

    for i = 1 : line_num
      line = fgetl ( input_unit );
      jlo = jhi + 1;
      jhi = min ( jlo + p - 1, number );

      khi = 0;

      for j = jlo : jhi
        klo = khi + 1;
        khi = min ( klo + w - 1, length ( line ) );
        s = line(klo:khi);
        rowind(j) = s_to_i4 ( s );
      end

    end

  else

    fprintf ( 1, '\n' );
    fprintf ( 1, 'HB_STRUCTURE_READ - Fatal error!\n' );
    fprintf ( 1, '  Illegal value of MXTYPE(3).\n' );
    return

  end

  return
end
function a = hb_to_msm ( input_file )

%*****************************************************************************80
%
%% HB_TO_MSM reads a Harwell-Boeing Sparse Matrix File, and returns it in MATLAB Sparse format.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    30 March 2005
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string INPUT_FILE, the name of the file containing the
%    Harwell-Boeing matrix data.
%
%    Output, real A, a sparse matrix in MATLAB sparse matrix format.
%
  input_unit = fopen ( input_file );

  if ( input_unit < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'HB_TO_MSM - Fatal error!\n' );
    fprintf ( 1, '  Error opening the file.\n' );
    error ( 'HB_TO_MSM - Fatal error!' );
  end

  [ title, key, totcrd, ptrcrd, indcrd, valcrd, rhscrd, mxtype, ...
    nrow, ncol, nnzero, neltvl, ptrfmt, indfmt, valfmt, rhsfmt, rhstyp, ...
    nrhs, nrhsix, colptr, rowind, values, rhsval, rhsptr, rhsind, guess, ...
    exact ] = hb_file_read ( input_unit );

  for col = 1 : ncol
    for k = colptr(col) : colptr(col+1)-1
      colind(k) = col;
    end
  end

  a = sparse ( rowind, colind, values, nrow, ncol );

  fclose ( input_unit );

  return
end
function values = hb_values_read ( input_unit, valcrd, mxtype, nnzero, ...
  neltvl, valfmt )

%*****************************************************************************80
%
%% HB_VALUES_READ reads the values of an HB matrix.
%
%  Discussion:
%
%    The user should already have opened the file, and positioned it
%    to just after the header and structure records.
%
%    Values are contained in an HB file if the VALCRD parameter
%    is nonzero.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    04 February 2005
%
%  Author:
%
%    John Burkardt
%
%  Reference:
%
%    Iain Duff, Roger Grimes, John Lewis,
%    User's Guide for the Harwell-Boeing Sparse Matrix Collection,
%    October 1992.
%
%  Parameters:
%
%    Input, integer INPUT_UNIT, the unit from which data is read.
%
%    Input, integer VALCRD, the number of input lines for numerical values.
%
%    Input, character ( len = 3 ) MXTYPE, the matrix type.
%    First character is R for Real, C for complex, P for pattern only.
%    Second character is S for symmetric, U for unsymmetric, H for
%      Hermitian, Z for skew symmetric, R for rectangular.
%    Third character is A for assembled and E for unassembled
%      finite element matrices.
%
%    Input, integer NNZERO.  In the case of assembled sparse matrices,
%    this is the number of nonzeroes.  In the case of unassembled finite
%    element matrices, in which the right hand side vectors are also
%    stored as unassembled finite element vectors, this is the total
%    number of entries in a single unassembled right hand side vector.
%
%    Input, integer NELTVL, the number of finite element matrix entries,
%    set to 0 in the case of assembled matrices.
%
%    Input, character ( len = 20 ) VALFMT, the format for reading values.
%
%    Output, real VALUES(NNZERO) or VALUES(NELTVL), the nonzero values
%    of the matrix.
%
  [ p, code, w, m ] = s_to_format ( valfmt );
%
%  Read the matrix values.
%    case "A" = assembled;
%    case "E" = unassembled finite element matrices.
%
  if ( 0 < valcrd )

    if ( mxtype(3:3) == 'A' )

      line_num = 1 + floor ( ( nnzero - 1 ) / p );

      jhi = 0;

      for i = 1 : line_num

        line = fgetl ( input_unit );
        jlo = jhi + 1;
        jhi = min ( jlo + p - 1, nnzero );

        khi = 0;

        for j = jlo : jhi
          klo = khi + 1;
          khi = min ( klo + w - 1, length ( line ) );
          s = line(klo:khi);
          values(j) = s_to_r8 ( s );
        end

      end

    elseif ( mxtype(3) == 'E' )

      line_num = 1 + floor ( ( neltvl - 1 ) / p );

      jhi = 0;

      for i = 1 : line_num

        line = fgetl ( input_unit );
        jlo = jhi + 1;
        jhi = min ( jlo + p - 1, neltvl );

        khi = 0;

        for j = jlo : jhi
          klo = khi + 1;
          khi = min ( klo + w - 1, length ( line ) );
          s = line(klo:khi);
          values(j) = s_to_r8 ( s );
        end

      end

    else

      fprintf ( 1, '\n' );
      fprintf ( 1, 'HB_VALUES_READ - Fatal error!\n' );
      fprintf ( 1, '  Illegal value of MXTYPE(3).\n' );
      error ( 'HB_VALUES_READ - Fatal error!' );

    end

  end

  return
end
function msm_to_mm_coordinate_real_general ( output_filename, a )

%*****************************************************************************80
%
%% MSM_TO_MM_COORDINATE_REAL_GENERAL writes a "matrix coordinate real general" Matrix Market file.
%
%  Modified:
%
%    02 November 2008
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string OUTPUT_FILENAME, the name of the file to which the information
%    should be written.
%
%    Input, sparse matrix A, the NROW by NCOL matrix, stored in MATLAB sparse
%    matrix format, which is to be written to the file.
%
  [ nrow, ncol ] = size ( a );
  nnzeros = nnz ( a );

  fid = fopen ( output_filename, 'wt+' );

  if ( fid < 0 );
    fprintf ( 1, '\n' );
    fprintf ( 1, 'MSM_TO_MM_COORDINATE_REAL_GENERAL - Fatal error!\n' );
    fprintf ( 1, '  Cannot open the output file.\n' );
    error ( 'MSM_TO_MM_COORDINATE_REAL_GENERAL - Fatal error!');
  end;

  fprintf ( fid, '%%%%MatrixMarket matrix coordinate real general\n');
  fprintf ( fid, '%%%%  Created by MSM_TO_MM_COORDINATE_REAL_GENERAL.M\n' );
  fprintf ( fid, '  %d  %d  %d\n', nrow, ncol, nnzeros );

  for j = 1 : ncol
    [ rows, temp, vals ] = find ( a(:,j) );
    sz = size ( rows );
    for k2 = 1 : sz
      fprintf ( fid, '  %d  %d  %f\n', rows(k2), j, vals(k2) );
    end

  end

  fclose ( fid );

  return
end
function len = s_len_trim ( s )

%*****************************************************************************80
%
%% S_LEN_TRIM returns the length of a character string to the last nonblank.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 June 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string to be measured.
%
%    Output, integer LEN, the length of the string up to the last nonblank.
%
  len = length ( s );

  while ( 0 < len )
    if ( s(len) ~= ' ' )
      return
    end
    len = len - 1;
  end

  return
end
function [ r, code, w, m ] = s_to_format ( s )

%*****************************************************************************80
%
%% S_TO_FORMAT reads a FORTRAN format from a string.
%
%  Discussion:
%
%    This routine will read as many characters as possible until it reaches
%    the end of the string, or encounters a character which cannot be
%    part of the format.  This routine is limited in its ability to
%    recognize FORTRAN formats.  In particular, we are only expecting
%    a single format specification, and cannot handle extra features
%    such as 'ES' and 'EN' codes, '5X' spacing, and so on.
%
%    Legal input is:
%
%       0 nothing
%       1 blanks
%       2 optional '('
%       3 blanks
%       4 optional repeat factor R
%       5 blanks
%       6 CODE ( 'A', 'B', 'E', 'F', 'G', 'I', 'L', 'O', 'Z', '*' )
%       7 blanks
%       8 width W
%       9 optional decimal point
%      10 optional mantissa M
%      11 blanks
%      12 optional ')'
%      13 blanks
%
%  Example:
%
%    S                 R   CODE   W    M
%
%    'I12              1   I      12   0
%    'E8.0'            1   E       8   0
%    'F10.5'           1   F      10   5
%    '2G14.6'          2   G      14   6
%    '*'               1   *      -1  -1
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 November 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string containing the
%    data to be read.  Reading will begin at position 1 and
%    terminate at the end of the string, or when no more
%    characters can be read.
%
%    Output, integer R, the repetition factor, which defaults to 1.
%
%    Output, character CODE, the format code.
%
%    Output, integer W, the field width.
%
%    Output, integer M, the mantissa width.
%
  LEFT = 1;
  RIGHT = -1;

  state = 0;
  paren_sum = 0;
  pos = 0;
  s_length = s_len_trim ( s );

  r = 0;
  w = 0;
  code = '?';
  m = 0;

  while ( pos < s_length )

    pos = pos + 1;
    c = s(pos);
%
%  BLANK character:
%
    if ( c == ' ' )

      if ( state == 4 )
        state = 5;
      elseif ( state == 6 )
        state = 7;
      elseif ( state == 10 )
        state = 11;
      elseif ( state == 12 )
        state = 13;
      end
%
%  LEFT PAREN
%
    elseif ( c == '(' )

      if ( state < 2 )
        paren_sum = paren_sum + LEFT;
      else
        state = -1;
        break;
      end
%
%  DIGIT (R, F, or W)
%
    elseif ( ch_is_digit ( c ) )

      if ( state <= 3 )
        state = 4;
        r = ch_to_digit ( c );
      elseif ( state == 4 )
        d = ch_to_digit ( c );
        r = 10 * r + d;
      elseif ( state == 6 | state == 7 )
        if ( code == '*' )
          state = -1;
          break;
        end
        state = 8;
        w = ch_to_digit ( c );
      elseif ( state == 8 )
        d = ch_to_digit ( c );
        w = 10 * w + d;
      elseif ( state == 9 )
        state = 10;
        m = ch_to_digit ( c );
      elseif ( state == 10 )
        d = ch_to_digit ( c );
        m = 10 * m + d;
      else
        state = -1;
        break;
      end
%
%  DECIMAL POINT
%
    elseif ( c == '.' )

      if ( state == 8 )
        state = 9;
      else
        state = -1;
        break;
      end
%
%  RIGHT PAREN
%
    elseif ( c == ')' )

      paren_sum = paren_sum + RIGHT;

      if ( paren_sum ~= 0 )
        state = -1;
        break;
      end

      if ( state == 6 & code == '*' )
        state = 12;
      elseif ( 6 <= state )
        state = 12;
      else
        state = -1;
        break;
      end
%
%  Code
%
    elseif ( ch_is_format_code ( c ) )

      if ( state < 6 )
        state = 6;
        code = c;
      else
        state = -1;
        break;
      end
%
%  Unexpected character
%
    else

      state = -1;
      break;

    end

  end

  if ( paren_sum ~= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'S_TO_FORMAT - Fatal error!\n' );
    fprintf ( 1, '  Parentheses mismatch.\n' );
    error ( 'S_TO_FORMAT - Fatal error!' );
  end

  if ( state < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'S_TO_FORMAT - Fatal error!\n' );
    fprintf ( 1, '  Parsing error.\n' );
    error ( 'S_TO_FORMAT - Fatal error!' );
  end

  if ( r == 0 )
    r = 1;
  end

  return
end
function ival = s_to_i4 ( s )

%*****************************************************************************80
%
%% S_TO_I4 reads an integer value from a string.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    18 November 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, a string to be examined.
%
%    Output, integer IVAL, the integer value read from the string.
%
  sgn = 1;
  state = 0;
  ival = 0;

  i = 0;

  while ( i < s_len_trim ( s ) )

    i = i + 1;
    c = s(i);

    if ( state == 0 )

      if ( c == ' ' )

      elseif ( c == '-' )
        state = 1;
        sgn = -1;
      elseif ( c == '+' )
        state = 1;
        sgn = +1;
      elseif ( '0' <= c & c <= '9' )
        state = 2;
        ival = c - '0';
      else
        fprintf ( '\n' );
        fprintf ( 'S_TO_I4 - Fatal error!\n' );
        fprintf ( '  Illegal character %c while in state %d.\n', c, state );
        return;
      end
%
%  Have read the sign, now expecting the first digit.
%
    elseif ( state == 1 )

      if ( c == ' ' )

      elseif ( '0' <= c & c <= '9' )
        state = 2;
        ival = c - '0';
      else
        fprintf ( '\n' );
        fprintf ( 'S_TO_I4 - Fatal error!\n' );
        fprintf ( '  Illegal character %c while in state %d.\n', c, state );
        return
      end
%
%  Have read at least one digit, expecting more.
%
    elseif ( state == 2 )

      if ( '0' <= c & c <= '9' )
        ival = 10 * ival + c - '0';
      else
        ival = sgn * ival;
        return;
      end

    end

  end
%
%  If we read all the characters in the string, see if we're OK.
%
  if ( state ~= 2 )
    fprintf ( '\n' );
    fprintf ( 'S_TO_I4 - Fatal error!\n' );
    fprintf ( '  Did not read enough information to define an integer!\n' );
    return;
  end

  ival = sgn * ival;

  return
end
function [ r, lchar, ierror ] = s_to_r8 ( s )

%*****************************************************************************80
%
%% S_TO_R8 reads an R8 from a string.
%
%  Discussion:
%
%    This routine will read as many characters as possible until it reaches
%    the end of the string, or encounters a character which cannot be
%    part of the real number.
%
%    Legal input is:
%
%       1 blanks,
%       2 '+' or '-' sign,
%       2.5 spaces
%       3 integer part,
%       4 decimal point,
%       5 fraction part,
%       6 'E' or 'e' or 'D' or 'd', exponent marker,
%       7 exponent sign,
%       8 exponent integer part,
%       9 exponent decimal point,
%      10 exponent fraction part,
%      11 blanks,
%      12 final comma or semicolon.
%
%    with most quantities optional.
%
%  Example:
%
%    S                 R
%
%    '1'               1.0
%    '     1   '       1.0
%    '1A'              1.0
%    '12,34,56'        12.0
%    '  34 7'          34.0
%    '-1E2ABCD'        -100.0
%    '-1X2ABCD'        -1.0
%    ' 2E-1'           0.2
%    '23.45'           23.45
%    '-4.2E+2'         -420.0
%    '17d2'            1700.0
%    '-14e-2'         -0.14
%    'e2'              100.0
%    '-12.73e-9.23'   -12.73 * 10.0**(-9.23)
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 November 2003
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string containing the
%    data to be read.  Reading will begin at position 1 and
%    terminate at the end of the string, or when no more
%    characters can be read to form a legal real.  Blanks,
%    commas, or other nonnumeric data will, in particular,
%    cause the conversion to halt.
%
%    Output, real R, the value that was read from the string.
%
%    Output, integer LCHAR, the number of characters of S that were used to form R.
%
%    Output, integer IERROR, is 0 if no error occurred.
%
  s_length = s_len_trim ( s );
  ierror = 0;
  r = 0.0;
  lchar = -1;
  isgn = 1;
  rtop = 0.0;
  rbot = 1.0;
  jsgn = 1;
  jtop = 0;
  jbot = 1;
  ihave = 1;
  iterm = 0;

  while ( 1 )

    lchar = lchar + 1;
    c = s(lchar+1);
%
%  Blank character.
%
    if ( c == ' ' )

      if ( ihave == 2 )

      elseif ( ihave == 6 | ihave == 7 )
        iterm = 1;
      elseif ( 1 < ihave )
        ihave = 11;
      end
%
%  Comma.
%
    elseif ( c == ',' | c == ';' )

      if ( ihave ~= 1 )
        iterm = 1;
        ihave = 12;
        lchar = lchar + 1;
      end
%
%  Minus sign.
%
    elseif ( c == '-' )

      if ( ihave == 1 );
        ihave = 2;
        isgn = -1;
      elseif ( ihave == 6 )
        ihave = 7;
        jsgn = -1;
      else
        iterm = 1;
      end
%
%  Plus sign.
%
    elseif ( c == '+' )

      if ( ihave == 1 )
        ihave = 2;
      elseif ( ihave == 6 )
        ihave = 7;
      else
        iterm = 1;
      end
%
%  Decimal point.
%
    elseif ( c == '.' )

      if ( ihave < 4 )
        ihave = 4;
      elseif ( 6 <= ihave & ihave <= 8 )
        ihave = 9;
      else
        iterm = 1;
      end
%
%  Exponent marker.
%
    elseif ( ch_eqi ( c, 'E' ) | ch_eqi ( c, 'D' ) )

      if ( ihave < 6 )
        ihave = 6;
      else
        iterm = 1;
      end
%
%  Digit.
%
    elseif ( ihave < 11 & ch_is_digit ( c ) )

      if ( ihave <= 2 )
        ihave = 3;
      elseif ( ihave == 4 )
        ihave = 5;
      elseif ( ihave == 6 | ihave == 7 )
        ihave = 8;
      elseif ( ihave == 9 )
        ihave = 10;
      end

      d = ch_to_digit ( c );

      if ( ihave == 3 )
        rtop = 10.0 * rtop + d;
      elseif ( ihave == 5 )
        rtop = 10.0 * rtop + d;
        rbot = 10.0 * rbot;
      elseif ( ihave == 8 )
        jtop = 10 * jtop + d;
      elseif ( ihave == 10 )
        jtop = 10 * jtop + d;
        jbot = 10 * jbot;
      end
%
%  Anything else is regarded as a terminator.
%
    else
      iterm = 1;
    end
%
%  If we haven't seen a terminator, and we haven't examined the
%  entire string, go get the next character.
%
    if ( iterm == 1 | s_length <= lchar + 1 )
      break;
    end

  end
%
%  If we haven't seen a terminator, and we have examined the
%  entire string, then we're done, and LCHAR is equal to S_LENGTH.
%
  if ( iterm ~= 1 & lchar + 1 == s_length )
    lchar = s_length;
  end
%
%  Number seems to have terminated.  Have we got a legal number?
%  Not if we terminated in states 1, 2, 6 or 7!
%
  if ( ihave == 1 | ihave == 2 | ihave == 6 | ihave == 7 )
    ierror = ihave;
    fprintf ( 1, '\n' );
    fprintf ( 1, 'S_TO_R8 - Fatal error!\n' );
    fprintf ( 1, '  IHAVE = %d\n', ihave );
    error ( 'S_TO_R8 - Fatal error!' );
  end
%
%  Number seems OK.  Form it.
%
  if ( jtop == 0 )
    rexp = 1.0;
  else

    if ( jbot == 1 )
      rexp = 10.0^( jsgn * jtop );
    else
      rexp = jsgn * jtop;
      rexp = rexp / jbot;
      rexp = 10.0^rexp;
    end

  end

  r = isgn * rexp * rtop / rbot;

  return
end
function timestamp ( )

%*****************************************************************************80
%
%% TIMESTAMP prints the current YMDHMS date as a timestamp.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 February 2003
%
%  Author:
%
%    John Burkardt
%
  t = now;
  c = datevec ( t );
  s = datestr ( c, 0 );
  fprintf ( 1, '%s\n', s );

  return
end


EulerShockDriver2D
figure; PlotField2D(N, x, y, Q(:,:,4)); drawnow; pause(.1);


function comet(f, g, ignored)
%COMET   Two-dimensional comet plot.
%   COMET(F) displays a comet graph of the CHEBFUN F, and COMET(F, G) displays a
%   comet graph of the CHEBFUN F versus the CHEBFUN G.
%
%   A comet graph is an animated graph in which a thick dot (the comet head)
%   traces the data points on the screen.
%
% See also COMET3.

% Copyright 2017 by The University of Oxford and The Chebfun Developers.
% See http://www.chebfun.org/ for Chebfun information.

if ( nargin == 1 ) % COMET(F)
    data = plotData(f);
else               % COMET(F, G)
    if ( nargin > 2 )
        warning('CHEBFUN:CHEBFUN:comet:nargin', ...
            'Third input to @CHEBFUN/COMET() is ignored.');
    end
    data = plotData(f, g);
end

comet(data.xLine, data.yLine, 0);

end


% $Id: publish_lagextraction_plugin.m 4 2009-08-15 21:10:35Z gramfort $
% $LastChangedBy: gramfort $
% $LastChangedDate: 2009-08-15 17:10:35 -0400 (Sam, 15 aoû 2009) $
% $Revision: 4 $

clear
opts.stylesheet = 'doc/agramfort.xsl';
opts.outputDir = 'doc';
opts.maxWidth = 600;
opts.catchError = false;
opts.evalCode = true;
% opts.evalCode = false;

% publish('lagextraction_demo',opts);
publish('lagextraction_tutorial',opts);
zip('../lagextraction_eeglab_plugin.zip','../lagextraction');


function h = surfo(varargin)

% surfo surface plot with workaround surface normals for OpenGL renderer
%
% Syntax:
%     surfo(Z)
%     surfo(Z,C)
%     surfo(X,Y,Z)
%     surfo(X,Y,Z,C)
%     surfo(...,'PropertyName',PropertyValue)
%     surfo(axes_handles,...)
%
% Only use surfo as a subsitute for surf if you need both transparency and
% flat lighting and the OpenGL renderer produces wrong results (see
% Example).
%
% surfo replaces the surface's standard 'VertexNormals' data with the face
% normal data computed by facenorm.
% surfo always switches the figure's renderer to OpenGL as the new normal
% data is not suited for lighting with the zbuffer renderer.
%
% Example:
%
%   % generate some demo data
%   [Y,Z,X] = cylinder([0.8 1 1 0.8],144);
%   idxShift = mod(1:size(X,2),4)>1;
%   X(2,idxShift) = X(2,idxShift)-0.2;
%   X(3,idxShift) = X(3,idxShift)+0.2;
%
%   % standard surf plot
%   figure(1)
%   surf(X,Y,Z,'EdgeAlpha',0.2,'FaceColor','c')
%   axis equal
%   light('Position',[0 0 1],'Style','infinite')
%
%   % same plot with surfo
%   % (giving symmetrical lighting, as it should)
%   figure(10)
%   surfo(X,Y,Z,'EdgeAlpha',0.2,'FaceColor','c')
%   axis equal
%   light('Position',[0 0 1],'Style','infinite')
%
% See also surf, facenorm

% Andres, 2009-07-08

args = varargin;

% plot with surf
hs = surf(args{:});

% switch to OpenGL renderer
fig = ancestor(hs,'figure');
set(fig,'Renderer','OpenGL')

% extract surface coordinate data
X = get(hs,'XData');
Y = get(hs,'YData');
Z = get(hs,'ZData');

% use workaround normals
set(hs,'VertexNormals',facenorm(X,Y,Z));

if nargout > 0
    h = hs;
end


function pbma_io_test02 ( )

%*****************************************************************************80
%
%% TEST02 tests PBMA_READ.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    01 October 2008
%
%  Author:
%
%    John Burkardt
%
  file_name = 'pbma_io_test02.ascii.pbm';

  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST02\n' );
  fprintf ( 1, '  PBMA_READ reads an ASCII PBMA file.\n' );

  pbma_write_test ( file_name );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  PBMA_WRITE_TEST created data and wrote it to a file.\n' );
%
%  Now try to read the data.
%
  b = pbma_read ( file_name );

  [ nrow, ncol ] = size ( b );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The data file was read by PBMA_READ.\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '  Number of rows of data =    %d\n', nrow );
  fprintf ( 1, '  Number of columns of data = %d\n', ncol );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  Sample data:\n' );
  fprintf ( 1, '\n' );

  for k = 1 : 30
    i = floor ( ( ( 30 - k ) * 1 + ( k - 1 ) * nrow ) / ( 30 - 1 ) );
    j = floor ( ( ( 30 - k ) * 1 + ( k - 1 ) * ncol ) / ( 30 - 1 ) );
    fprintf ( 1, '%4d  %4d  %6d\n', i, j, b(i,j) );
  end

  return
end


function [ x, y ] = p00_dat ( prob, data_num )

%*****************************************************************************80
%
%% P00_DAT returns the data vector for any problem.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    06 February 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer PROB, the number of the desired test problem.
%
%    Input, integer DATA_NUM, the number of data points.
%
%    Output, real X(DATA_NUM), the abscissa data.
%
%    Output, real Y(DATA_NUM), the ordinate data.
%
  if ( prob == 1 )
    [ x, y ] = p01_dat ( data_num );
  elseif ( prob == 2 )
    [ x, y ] = p02_dat ( data_num );
  elseif ( prob == 3 )
    [ x, y ] = p03_dat ( data_num );
  elseif ( prob == 4 )
    [ x, y ] = p04_dat ( data_num );
  elseif ( prob == 5 )
    [ x, y ] = p05_dat ( data_num );
  elseif ( prob == 6 )
    [ x, y ] = p06_dat ( data_num );
  elseif ( prob == 7 )
    [ x, y ] = p07_dat ( data_num );
  elseif ( prob == 8 )
    [ x, y ] = p08_dat ( data_num );
  elseif ( prob == 9 )
    [ x, y ] = p09_dat ( data_num );
  elseif ( prob == 10 )
    [ x, y ] = p10_dat ( data_num );
  else
    fprintf ( 1, '\n' );
    fprintf ( 1, 'P00_DAT - Fatal error!\n' );
    fprintf ( 1, '  Illegal problem number = %d\n', prob );
    error ( 'P00_DAT - Fatal error!' );
  end

  return
end


function [ output_meta ] = meta2sicd_sio( sio_hdr, user_data )
%META2SICD_SIO Converts SIO header into SICD-style structure
%
% Really not much to do here since SIO header is so minimal.  Just fill in
% image size and datatype.
%
% Written by: Wade Schwartzkopf, NGA/IDT
%
% //////////////////////////////////////////
% /// CLASSIFICATION: UNCLASSIFIED       ///
% //////////////////////////////////////////

if nargin<2
    user_data=struct();
end

% Check to see if we have a SICD-in-SIO type file.  If there's a SICDMETA
% field in the user_data structure we'll assume that has all the valid
% metadata for this file and we'll use that.  Otherwise we'll just return a
% small 'stub' SICD metadata structure (not much information in the SIO
% header).
if (isfield(user_data,'SICDMETA'))
  output_meta = sicdxml2struct( xmlread( java.io.StringBufferInputStream(user_data.SICDMETA) ) );
else
  output_meta.ImageData.NumRows=sio_hdr(2);
  output_meta.ImageData.NumCols=sio_hdr(3);
  output_meta.ImageData.FullImage=output_meta.ImageData; % Assume full image, but no way to know for sure
  output_meta.ImageData.FirstRow=uint32(0); output_meta.ImageData.FirstCol=uint32(0);
  if (sio_hdr(4)==13)&&(sio_hdr(5)==8), output_meta.ImageData.PixelType='RE32F_IM32F'; end;
  output_meta.ImageData.SCPPixel.Row=fix(output_meta.ImageData.NumRows/2); % Not usually given explicitly in accompanying metadata, so just guess center
  output_meta.ImageData.SCPPixel.Col=fix(output_meta.ImageData.NumCols/2);
end
end

% //////////////////////////////////////////
% /// CLASSIFICATION: UNCLASSIFIED       ///
% //////////////////////////////////////////


function jed = epoch_to_jed_ethiopian ( )

%*****************************************************************************80
%
%% EPOCH_TO_JED_ETHIOPIAN returns the epoch of the Ethiopian calendar as a JED.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    14 June 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, real JED, the Julian Ephemeris Date of the epoch.
%
  jed = 1724220.5;

  return
end


function [ r, code, w, m ] = s_to_format ( s )

%*****************************************************************************80
%
%% S_TO_FORMAT reads a FORTRAN format from a string.
%
%  Discussion:
%
%    This routine will read as many characters as possible until it reaches
%    the end of the string, or encounters a character which cannot be
%    part of the format.  This routine is limited in its ability to
%    recognize FORTRAN formats.  In particular, we are only expecting
%    a single format specification, and cannot handle extra features
%    such as 'ES' and 'EN' codes, '5X' spacing, and so on.
%
%    Legal input is:
%
%       0 nothing
%       1 blanks
%       2 optional '('
%       3 blanks
%       4 optional repeat factor R
%       5 blanks
%       6 CODE ( 'A', 'B', 'E', 'F', 'G', 'I', 'L', 'O', 'Z', '*' )
%       7 blanks
%       8 width W
%       9 optional decimal point
%      10 optional mantissa M
%      11 blanks
%      12 optional ')'
%      13 blanks
%
%  Example:
%
%    S                 R   CODE   W    M
%
%    'I12              1   I      12   0
%    'E8.0'            1   E       8   0
%    'F10.5'           1   F      10   5
%    '2G14.6'          2   G      14   6
%    '*'               1   *      -1  -1
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    22 February 2010
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, string S, the string containing the
%    data to be read.  Reading will begin at position 1 and
%    terminate at the end of the string, or when no more
%    characters can be read.
%
%    Output, integer R, the repetition factor, which defaults to 1.
%
%    Output, character CODE, the format code.
%
%    Output, integer W, the field width.
%
%    Output, integer M, the mantissa width.
%
  LEFT = 1;
  RIGHT = -1;

  state = 0;
  paren_sum = 0;
  pos = 0;
  s_length = s_len_trim ( s );

  r = 0;
  w = 0;
  code = '?';
  m = 0;

  while ( pos < s_length )

    pos = pos + 1;
    c = s(pos);
%
%  BLANK character:
%
    if ( c == ' ' )

      if ( state == 4 )
        state = 5;
      elseif ( state == 6 )
        state = 7;
      elseif ( state == 10 )
        state = 11;
      elseif ( state == 12 )
        state = 13;
      end
%
%  LEFT PAREN
%
    elseif ( c == '(' )

      if ( state < 2 )
        paren_sum = paren_sum + LEFT;
      else
        state = -1;
        break;
      end
%
%  DIGIT (R, F, or W)
%
    elseif ( ch_is_digit ( c ) )

      if ( state <= 3 )
        state = 4;
        r = ch_to_digit ( c );
      elseif ( state == 4 )
        d = ch_to_digit ( c );
        r = 10 * r + d;
      elseif ( state == 6 || state == 7 )
        if ( code == '*' )
          state = -1;
          break;
        end
        state = 8;
        w = ch_to_digit ( c );
      elseif ( state == 8 )
        d = ch_to_digit ( c );
        w = 10 * w + d;
      elseif ( state == 9 )
        state = 10;
        m = ch_to_digit ( c );
      elseif ( state == 10 )
        d = ch_to_digit ( c );
        m = 10 * m + d;
      else
        state = -1;
        break;
      end
%
%  DECIMAL POINT
%
    elseif ( c == '.' )

      if ( state == 8 )
        state = 9;
      else
        state = -1;
        break;
      end
%
%  RIGHT PAREN
%
    elseif ( c == ')' )

      paren_sum = paren_sum + RIGHT;

      if ( paren_sum ~= 0 )
        state = -1;
        break;
      end

      if ( state == 6 && code == '*' )
        state = 12;
      elseif ( 6 <= state )
        state = 12;
      else
        state = -1;
        break;
      end
%
%  Code
%
    elseif ( ch_is_format_code ( c ) )

      if ( state < 6 )
        state = 6;
        code = c;
      else
        state = -1;
        break;
      end
%
%  Unexpected character
%
    else

      state = -1;
      break;

    end

  end

  if ( paren_sum ~= 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'S_TO_FORMAT - Fatal error!\n' );
    fprintf ( 1, '  Parentheses mismatch.\n' );
    error ( 'S_TO_FORMAT - Fatal error!' );
  end

  if ( state < 0 )
    fprintf ( 1, '\n' );
    fprintf ( 1, 'S_TO_FORMAT - Fatal error!\n' );
    fprintf ( 1, '  Parsing error.\n' );
    error ( 'S_TO_FORMAT - Fatal error!' );
  end

  if ( r == 0 )
    r = 1;
  end

  return
end


function matrixPSD = enforcePSD(matrix)
    if size(matrix,1) ~= size(matrix,2)
        error('Input matrix is not symmetric.');
    else
        matrixPSD = matrix;
        for r = 1:size(matrixPSD,1)
            for c = 1:size(matrixPSD,2)
                if r == c
                    matrixPSD(r,c) = abs(matrixPSD(r,c));
                else
                     offDiagElement = mean([matrixPSD(r,c),matrixPSD(c,r)]);
%                      offDiagElement = matrixPSD(r,c);
                     matrixPSD(c,r) = offDiagElement;
                     matrixPSD(r,c) = offDiagElement;
                end
            end
        end
    end
end


function title = p31_title ( )

%*****************************************************************************80
%
%% P31_TITLE returns a title for problem 31.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    10 January 2001
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, string TITLE, a title for the problem.
%
  title = 'The Shekel SQRN5 Function';

  return
end


function r = foldr(list, identity, func)
% VAL = FOLDR(ARRAY, ID, FUNC)
%   Perform a right fold on ARRAY using FUNC with identity ID.  FOLDR is
%   the generic recursive list operator.  It applies FUNC to every element
%   of ARRAY in reverse order, along with ID.  The result is an `update' to
%   ID.  The final result of ID is returned.
%
%   FOLDR is most simply viewed as the haskell code
%     foldr []   id f = id
%     foldr x:xs id f = f (foldr xs id f) x
%
%   FOLDL and FOLDR are implemented as a loop for optimization purposes in
%   these libraries, whereas usually FOLDL is tail recursive and thus more
%   efficient on most platforms.
%

  if isempty(list)
    r = identity;
    return;
  end

  if iscell(list)
    for i = numel(list):-1:1
      identity = func(identity, list{i});
    end
  else
    for i = numel(list):-1:1
      identity = func(identity, list(i));
    end
  end

  r = identity;
end


function x = real2int_vbmc(x,trinfo,integervars)
%REAL2INT_VBMC Convert to integer-valued representation.

if ~any(integervars); return; end

xtemp = warpvars_vbmc(x,'inv',trinfo);
xtemp(:,integervars) = round(xtemp(:,integervars));
xtemp = warpvars_vbmc(xtemp,'d',trinfo);

x(:,integervars) = xtemp(:,integervars);

end


function hdr = analyzeWrite(imArray, fileName, mmPerVox, notes, origin)
%  hdr = analyzeWrite(imArray, fileName, [mmPerVox], [notes], [origin]);
%
% Saves Analyze7.5 image file from a matlab array 'imArray'.
% fileName should be a root filename- no '.img' or '.hdr' suffix.
% mmPerVox is the row,col,slice voxel size, in mm. Defaults to
% [1 1 1].
%
% If imarray is int16 or int32 then it will be saved as such. If it is
% logical it will be saved as uint1 (1-bit). Any other matlab type will
% be saved as 'float'.
%
% Returns hdr - Analyse header modified after image write.
%
% REQUIRES:
%   fmris_write_analyze from VISTASOFT 'filters' module.
%
% SEE ALSO: loadAnalyze, analyze2mrGray, mrGray2Analyze
%
% HISTORY:
%   2002.04.01 RFD (bob@white.stanford.edu) wrote it.
%   2003.07.09 RFD added origin option.
%   2003.12.04 RFD: minor edits to allow for 4-d data.
%   2004.01.06 RFD: replaced 'V = spm_vol(fileName);' with code to set up
%   the V struct manually. This fixes a bug where an existing image
%   transform 'mat' file would be read in a replace our carefully
%   calculated scale factors. (This bug would not affect those who don't
%   use the spm-style '.mat' transform files.)
%   2004.07.27 RFD: Removed SPM99 dependency. We now use a modified version
%   of Worsley's fmris_write_analyze.
%   2004.10.19 AG: Added version check for Matlab7 compatibility
%   datestr(now) format changed, used date instead
%
% BOB (c) Stanford VISTASOFT, 2002

if (~exist('mmPerVox','var') | isempty(mmPerVox))
    if(ndims(imArray==4)) mmPerVox = [1 1 1 1];
    else mmPerVox = [1 1 1]; end
end

% datestr(now) format changed, used date instead
if (~exist('notes','var') | isempty(notes))
    matlabVersion=ver('Matlab');
    majorVersion = str2num(matlabVersion.Version(1));
    if (majorVersion>=7)
        notes = ['Created by saveAnalyze on ',date];
    else
        notes = ['Created by saveAnalyze on ',datestr(now)];
    end
end

imDim = size(imArray);
if (~exist('origin','var') | isempty(origin))
    origin = (imDim(1:3)+1)./2;
end

d.file_name = [fileName '.img'];
d.data = imArray;
d.vox = mmPerVox;
d.vox_units = 'mm';
d.vox_offset = 0;
d.calib_units = 'min^-1';
d.origin = origin;
d.descrip = notes;
switch(class(imArray))
    case {'uint8','int16','int32'}
        d.precision = class(imArray);
    case {'logical'}
        d.precision = 'uint1';
    otherwise
        d.precision = 'float';
end
disp(['saving data as ' d.precision '...']);
d = fmris_write_analyze(d);
hdr = d;

% s = spm_hwrite(fileName, imDim, mmPerVox, 1, spm_type('int16'), 0, origin, notes);
% %V = spm_vol(fileName);
% V.fname = fileName;
% V.dim = [imDim spm_type('int16')];
% % Offset is from center of image
% offset = -mmPerVox.*origin;
% V.mat = [mmPerVox(1) 0 0 offset(1) ; 0 mmPerVox(2) 0 offset(2) ; 0 0 mmPerVox(3) offset(3) ; 0 0 0 1];
% V.pinfo = [1 0 0]';
% V.descrip = notes;
%
% hdr = spm_write_vol(V, imArray);

return


function o = spoptimget(options,name,default,flag)
% SPOPTIMGET   Get sparse grid optimization OPTIONS parameters.
%   VAL = SPOPTIMGET(OPTIONS,'NAME') extracts the value of the
%   named property from the sparse grid options structure OPTIONS,
%   returning an empty matrix if the property value is not
%   specified in OPTIONS. It is sufficient to type only the leading
%   characters that uniquely identify the property. Case is ignored
%   for property names. [] is a valid OPTIONS argument.
%
%   VAL = SPOPTIMGET(OPTIONS,'NAME',DEFAULT) extracts the named
%   property as above, but returns VAL = DEFAULT if the named
%   property is not specified in OPTIONS. For example
%
%       val = spoptimget(opts, 'Maximize', 'off');
%
%   returns val = 'off' if the Maximize property is not specified in opts.
%
%   See also SPOPTIMSET, SPCOMPSEARCH, SPFMINSEARCH, SPCGSEARCH,
%            SPMULTISTART

% Author : Andreas Klimke
% Version: 1.2
% Date   : November 13, 2006

% Change log:
% V1.2   : November 13, 2006
%          Cleaned up options.
% V1.1   : August 8, 2005
%          Added BisectGap and funTol parameters
% V1.0   : June 9, 2005
%          Initial version

% Note: SPOPTIMGET is similar in syntax and code to the options
% handling with ODEGET and ODESET of the MATLAB ODE suite by Marc
% Reichelt and Lawrence Shampine.

% ------------------------------------------------------------
% Sparse Grid Interpolation Toolbox
% Copyright (c) 2006 W. Andreas Klimke, Universitaet Stuttgart
% Copyright (c) 2007-2008 W. A. Klimke. All Rights Reserved.
% See LICENSE.txt for license.
% email: klimkeas@ians.uni-stuttgart.de
% web  : http://www.ians.uni-stuttgart.de/spinterp
% ------------------------------------------------------------

% undocumented usage for fast access with no error checking
if (nargin == 4) & isequal(flag,'fast')
   o = getknownfield(options,name,default);
   return
end

if nargin < 2
  error('Not enough input arguments.');
end
if nargin < 3
  default = [];
end

if ~isempty(options) & ~isa(options,'struct')
  error(['First argument must be an options structure created with' ...
	 ' SPOPTIMSET.']);
end

if isempty(options)
  o = default;
  return;
end

Names = {'Minimize', 'Maximize', 'TolFun', 'TolX', ...
	 'MaxIter', 'StartPoint', 'TestCorners', 'PrevResult', ...
	 'Method', 'NumStarts', 'OptimsetOptions', 'Display'};

m = length(Names);
for k = 1:m
  names{k} = lower(Names{k});
end

lowName = lower(name);
matched = strmatch(lowName,names);
if isempty(matched)               % if no matches
  error(sprintf(['Unrecognized property name ''%s''.  ' ...
                 'See SPOPTIMSET for possibilities.'], name));
elseif length(matched) > 1
  msg = sprintf('Ambiguous property name ''%s'' ', name);
  msg = [msg '(' Names{matched}];
  for k = j(2:length(matched))'
    msg = [msg ', ' Names{matched}];
  end
  msg = sprintf('%s).', msg);
  error(msg);
end

if any(strcmp(fieldnames(options),Names{matched}))
  o = options.(Names{matched});
  if isempty(o)
    o = default;
  end
else
  o = default;
end

%-----------------------------------------------------------------------
function v = getknownfield(s, f, d)
% GETKNOWNFIELD   Get field f from struct s, or else yield default d.

if isfield(s,f)   % s could be empty.
  v = subsref(s, struct('type','.','subs',f));
  if isempty(v)
    v = d;
  end
else
  v = d;
end


function alpha = p06_alpha ( )

%*****************************************************************************80
%
%% P06_ALPHA returns ALPHA for problem 6.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    28 July 2007
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, real ALPHA, the value of ALPHA.
%
  alpha = 2.0;

  return
end


function n = p05_n ( )

%*****************************************************************************80
%
%% P05_N returns the number of variables N for problem 5.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    16 April 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Output, integer N, the number of variables.
%
  n = 10;

  return
end


function [ds, err, dsname, plotok] = dfcreatedataset(varargin)
%DFCREATEDATASET Create dfittool data set
%   DFCREATEDATASET(YEXPR,CEXPR,FEXPR,DSNAME) creates a data set named DSNAME
%   using the data obtained by evaluating the expressions entered in the gui
%   for Y, CENSORING, and FREQUENCY.
%
%   DFCREATEDATASET(YDATA,CDATA,FDATA,DSNAME,YNAME,CNAME,FNAME) creates a data
%   set named DSNAME using the y, censoring, and frequency data passed in via
%   the command line.  The "name" arguments are the names of these data
%   variables, or empty if they are not simple variable names.

%   $Revision: 1.1.6.7 $  $Date: 2004/01/24 09:35:24 $
%   Copyright 2003-2004 The MathWorks, Inc.

% Determine if we had data passed directly in from the command line
if nargin>=1 && isnumeric(varargin{1})
   fromgui = false;
else
   fromgui = true;
end

% Check for a data set name (we used to check for duplicate names
% before calling this function).

if nargin>=4
    dsname = varargin{4};
    if fromgui
        % Get the array of data sets
        dsdb = getdsdb;
        dset = down(dsdb);
        while(~isempty(dset))
            if strcmp(dset.name, dsname);
                err = 'datanamethesame';
                ds = [];
                plotok = false;
                return;
            end
            dset = right(dset);
        end
    end
else
   dsname = '';
end

n = min(length(varargin),3);
nameargs = cell(1,3);
if ~fromgui
   % Input data entered at the command line, maybe input names in args 5-7
   nameargs(:) = {''};
   valargs = cell(1,3);
   for j=1:n
      valargs{j} = varargin{j};
   end
   for j=5:nargin
      nameargs{j-4} = varargin{j};
   end
else
   % Input expressions from gui, get values by evaluating them
   nameargs = varargin(1:n);
   valargs = cell(1,0);
end

% Check input expressions or data vectors
outvecs = cell(1,3);
[err,outvecs{:}] = dfcheckselections(nameargs{:}, valargs{:});
if ~isequal(err, '')
   ds = [];
   return;
end

% Make a new data set
ds = stats.dfdata(nameargs{:},dsname,outvecs{:});
dsname = ds.name;

% Set the function type before plotting
setftype(ds,dfgetset('ftype'));
ds.conflev = dfgetset('conflev');

% Plot the histogram or other empirical curve if possible
dffig = dfgetset('dffig');
if dfcanplotdata(ds,dffig)
   ds.plot = 1;
   ds.plotok = 1;   % this was the default when we created ds
   plotok = 'true'; % use text; boolean causes problems in java caller
else
   % Update the java dialog to show current flag state
   % ds.plot = 0;   % this was the default when we created ds
   ds.plotok = 0;
   plotok = 'false';
end

% Update the plot
dfupdatexlim;
dfupdateylim;
dfupdatelegend(dffig);


function s = y_to_s_common ( y )

%*****************************************************************************80
%
%% Y_TO_S_COMMON writes a Common year into a string.
%
%  Format:
%
%    YearNumber BCE
%    YearNumber CE
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    20 October 2012
%
%  Author:
%
%    John Burkardt
%
%  Parameters:
%
%    Input, integer Y, the year.
%
%    Output, string S, a representation of the year.
%
  if ( y < 0 )
    s = sprintf ( 'BCE %d', y );
  else
    s = sprintf ( 'CE %d', y );
  end

  return
end


function test_triangulation_test01 ( )

%*****************************************************************************80
%
%% TEST01 tests P00_TEST_NUM, P00_TITLE and P00_HEADER.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    12 April 2009
%
%  Author:
%
%    John Burkardt
%
  fprintf ( 1, '\n' );
  fprintf ( 1, 'TEST01\n' );
  fprintf ( 1, '  P00_TEST_NUM reports the number of problems.\n' );
  fprintf ( 1, '  P00_TITLE returns a title for each problem.\n' );
  fprintf ( 1, '  P00_HEADER prints some information about each problem.\n' );

  test_num = p00_test_num ( );

  fprintf ( 1, '\n' );
  fprintf ( 1, '  The number of tests available = %d\n', test_num );

  for test = 1 : test_num

    title = p00_title ( test );

    fprintf ( 1, '\n' );
    fprintf ( 1, '  Test number: %d\n', test );
    fprintf ( 1, '  Title:      "%s"\n', title );

    p00_header ( test );

  end

  return
end


function [sFile, ChannelMat] = in_fopen_ant(DataFile)
% IN_FOPEN_ANT: Open an ANT EEProbe .cnt/.avr file (continuous recordings).
%
% USAGE:  [sFile, ChannelMat] = in_fopen_ant(DataFile)

% @=============================================================================
% This function is part of the Brainstorm software:
% https://neuroimage.usc.edu/brainstorm
%
% Copyright (c) University of Southern California & McGill University
% This software is distributed under the terms of the GNU General Public License
% as published by the Free Software Foundation. Further details on the GPLv3
% license can be found at http://www.gnu.org/copyleft/gpl.html.
%
% FOR RESEARCH PURPOSES ONLY. THE SOFTWARE IS PROVIDED "AS IS," AND THE
% UNIVERSITY OF SOUTHERN CALIFORNIA AND ITS COLLABORATORS DO NOT MAKE ANY
% WARRANTY, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO WARRANTIES OF
% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, NOR DO THEY ASSUME ANY
% LIABILITY OR RESPONSIBILITY FOR THE USE OF THIS SOFTWARE.
%
% For more information type "brainstorm license" at command prompt.
% =============================================================================@
%
% Authors: Francois Tadel, 2012-2019

%% ===== READ HEADER =====
% Read a small block of data, to get all the extra information
hdr = eepv4_read_info(DataFile);
% Copy some fields for backward compatibility with previous versions of the library
hdr.nsample = hdr.sample_count;

% Initialize returned file structure
sFile = db_template('sfile');
% Add information read from header
sFile.byteorder  = 'l';
sFile.filename   = DataFile;
sFile.format     = 'EEG-ANT-CNT';
sFile.prop.sfreq = double(hdr.sample_rate);
sFile.device     = 'ANT';
sFile.header     = hdr;
% Comment: short filename
[fPath, fBase, fExt] = bst_fileparts(DataFile);
sFile.comment = fBase;
% Time and samples indices
sFile.prop.times = [0, hdr.sample_count - 1] ./ sFile.prop.sfreq;
sFile.prop.nAvg  = 1;
% Get bad channels
sFile.channelflag = ones(hdr.channel_count, 1);

%% ===== EVENTS =====
if isfield(hdr, 'triggers') && ~isempty(hdr.triggers)
    % Get list of events
    allNames = {hdr.triggers.label};
    [uniqueEvt, iUnique] = unique(allNames);
    uniqueEvt = allNames(sort(iUnique));
    % Initialize list of events
    events = repmat(db_template('event'), 1, length(uniqueEvt));
    % Format list
    for iEvt = 1:length(uniqueEvt)
        % Find list of occurences of this event
        iOcc = find(strcmpi(allNames, uniqueEvt{iEvt}));
        % Fill event structures
        events(iEvt).label      = uniqueEvt{iEvt};
        events(iEvt).color      = [];
        events(iEvt).times      = round([hdr.triggers(iOcc).seconds_in_file] .* sFile.prop.sfreq) ./ sFile.prop.sfreq;
        events(iEvt).epochs     = ones(1, length(events(iEvt).times));  % Epoch: set as 1 for all the occurrences
        events(iEvt).reactTimes = [];
        events(iEvt).select     = 1;
        events(iEvt).channels   = [];
        events(iEvt).notes      = [];
    end
    % Import this list
    sFile = import_events(sFile, [], events);

%% ===== EXTERNAL EVENT FILE =====
else
    % If a .trg file exists with the same name: load it
    [fPath, fBase, fExt] = bst_fileparts(DataFile);
    TrgFile = bst_fullfile(fPath, [fBase '.trg']);
    % If file exists
    if file_exist(TrgFile)
        sFile = import_events(sFile, [], TrgFile, 'ANT');
    end
end

%% ===== CREATE DEFAULT CHANNEL FILE =====
% Create channel structure
Channel = repmat(db_template('channeldesc'), [1 hdr.channel_count]);
for i = 1:hdr.channel_count
    Channel(i).Name    = hdr.channels(i).label;
    Channel(i).Type    = 'EEG';
    Channel(i).Orient  = [];
    Channel(i).Weight  = 1;
    Channel(i).Comment = [];
    Channel(i).Loc = [0; 0; 0];
end
ChannelMat = db_template('channelmat');
ChannelMat.Comment = 'ANT standard position';
ChannelMat.Channel = Channel;


%------------------------------------------------------------------
% Programed by:
%   - Lucas Rath (lucasrm25@gmail.com, https://github.com/lucasrm25)
%   -
%   -

%   Generate fancy plots (fp)
%------------------------------------------------------------------

classdef fp
    properties
    end

    methods(Static)

        function savefig(fname,varargin)

            p = inputParser;

            defaultFormat  = 'epsc';
            expectedFormat = {'epsc','svg','png','jpg'};
            addParameter(p,'format',defaultFormat, @(x) any(validatestring(x,expectedFormat)));
            addParameter(p,'fighandle',gcf, @(x) isa(x,'matlab.ui.Figure'));
            addParameter(p,'folder',fullfile(pwd,'images'), @(x) isa(x,'char'));
            parse(p,varargin{:});

            if ~ exist(p.Results.folder,'dir'), mkdir(p.Results.folder); end
            % set(p.Results.fighandle.CurrentAxes,'LooseInset',p.Results.fighandle.CurrentAxes.TightInset)
            saveas(p.Results.fighandle, fullfile(p.Results.folder,fname), p.Results.format)
        end

        function fig = f()
            fig = figure('Color','white');
            hold on, grid on;
        end

        function latexcode = m2latex(matrix)
            if ~isa(matrix,'sym')
                matrix = sym(matrix);
            end
            latexcode = latex(vpa(simplify(matrix)));
            if numel(latexcode)>=6 && strcmp(latexcode(6),'(') && strcmp(latexcode(end),')')
                latexcode(6) = '[';
                latexcode(end) = ']';
            end
            clipboard('copy',latexcode);
        end

        function str = figpos()
            a = gcf;
            pos = a.Position;
            str = ['figure(''Color'',''white'',''Position'',[' num2str(pos) ']);'];
            clipboard('copy',str);
        end

        % varargin{1}: line opacity
        function cl = getColor(n, varargin)
            colrs = lines(max(n));
            if nargin >= 2
                opacity = varargin{1};
            else
                opacity = [];
            end
            cl = [colrs(n,:), repmat(opacity,numel(n),1)];
        end
    end
end


function fiff_write_short(fid, kind, data)
%
% fiff_write_short(fid, kind, data)
%
% Writes a 16-bit integer tag to a fif file
%
%     fid           An open fif file descriptor
%     kind          Tag kind
%     data          The integers to use as data
%

%
%   Author : Matti Hamalainen, MGH Martinos Center
%   License : BSD 3-clause
%
%   Revision 1.1  2006/04/27 22:38:37  msh
%   Splitting an empty list now results in an empty output.
%   Added fiff_write_double and fiff_write_short
%   Write an array of floats, ints, and doubles instead of just one value.
%   Fixed help text of fiff_pick_channels.
%
%

me = 'MNE:fiff_write_short';

if nargin ~= 3
    error(me, 'Incorrect number of arguments');
end

FIFFT_SHORT = 2;
FIFFV_NEXT_SEQ = 0;
nel = numel(data);
datasize = nel * 2;
count = fwrite(fid, int32(kind), 'int32');
if count ~= 1
    error(me, 'write failed');
end
count = fwrite(fid, int32(FIFFT_SHORT), 'int32');
if count ~= 1
    error(me, 'write failed');
end
count = fwrite(fid, int32(datasize), 'int32');
if count ~= 1
    error(me, 'write failed');
end
count = fwrite(fid, int32(FIFFV_NEXT_SEQ), 'int32');
if count ~= 1
    error(me, 'write failed');
end
count = fwrite(fid, int16(data), 'int16');
if count ~= nel
    error(me, 'write failed');
end

return


% ------------------------------------------------------------------------
%  Copyright (C)
%  Universitat Politecnica de Catalunya BarcelonaTech (UPC) - Spain
%  University of California Berkeley (UCB) - USA
%
%  Jordi Pont-Tuset <jordi.pont@upc.edu>
%  Pablo Arbelaez <arbelaez@berkeley.edu>
%  June 2014
% ------------------------------------------------------------------------
% This file is part of the MCG package presented in:
%    Arbelaez P, Pont-Tuset J, Barron J, Marques F, Malik J,
%    "Multiscale Combinatorial Grouping,"
%    Computer Vision and Pattern Recognition (CVPR) 2014.
% Please consider citing the paper if you use this code.
% ------------------------------------------------------------------------
% This function computes the MCG candidates given an image.
%  INPUT:
%  - image : Input image
%  - mode  : It can be: + 'fast'     (SCG in the paper)
%                       + 'accurate' (MCG in the paper)
%  - compute_masks : Compute the candidates maks [0] or not [1]. Note that
%                    it is very time consuming. Otherwise use the labels
%                    as shown in the demo.
%
%  OUTPUT:
%  - candidates : Struct containing the following fields
%          + superpixels : Label matrix of the superpixel partition
%          + labels : Cell containing the superpixel labels that form
%                     each of the candidates
%          + scores : Score of each of the ranked candidates
%          + masks  : 3D boolean matrix containing the masks of the candidates
%                     (only if compute_masks==1)
%  - ucm2       : Ultrametric Contour Map from which the candidates are
%                 extracted
%  - bboxes     : Bounding boxes of the candidates (up,left,down,right)
%                 See 'bboxes' folder for functions to work with them
%
%  DEMO:
%  - See demos/demo_im2mcg.m
% ------------------------------------------------------------------------
function [candidates, ucm2] = im2mcg(image,mode,compute_masks)
if nargin<2
    mode = 'fast';
end
if nargin<3
    compute_masks = 0;
end

% Load pre-trained Structured Forest model
sf_model = loadvar(fullfile(root_dir, 'datasets', 'models', 'sf_modelFinal.mat'),'model');

% Level of overlap to erase duplicates
J_th = 0.95;

% Max margin parameter
theta = 0.7;

if strcmp(mode,'fast')
    % Which scales to work on (MCG is [2, 1, 0.5], SCG is just [1])
    scales = 1;

    % Get the hierarchies at each scale and the global hierarchy
    [ucm2] = img2ucms(image, sf_model, scales);
    all_ucms = ucm2;

    % Load pre-trained pareto point
    pareto_n_cands = loadvar(fullfile(root_dir, 'datasets', 'models', 'scg_pareto_point_train2012.mat'),'n_cands');

    % Load pre-trained random forest regresssor for the ranking of candidates
    rf_regressor = loadvar(fullfile(root_dir, 'datasets', 'models', 'scg_rand_forest_train2012.mat'),'rf');

elseif strcmp(mode,'accurate')
    % Which scales to work on (MCG is [2, 1, 0.5], SCG is just [1])
    scales = [2, 1, 0.5];

    % Get the hierarchies at each scale and the global hierarchy
    [ucm2,ucms] = img2ucms(image, sf_model, scales);
    all_ucms = cat(3,ucm2,ucms(:,:,3),ucms(:,:,2),ucms(:,:,1)); % Multi, 0.5, 1, 2

    % Load pre-trained pareto point
    pareto_n_cands = loadvar(fullfile(root_dir, 'datasets', 'models', 'mcg_pareto_point_train2012.mat'),'n_cands');

    % Load pre-trained random forest regresssor for the ranking of candidates
    rf_regressor = loadvar(fullfile(root_dir, 'datasets', 'models', 'mcg_rand_forest_train2012.mat'),'rf');
else
    error('Unknown mode for MCG: Possibilities are ''fast'' or ''accurate''')
end
% ------------------------------------

% Transform ucms to hierarchies (dendogram) and put them all together
n_hiers = size(all_ucms,3);
lps = [];
ms  = cell(n_hiers,1);
ths = cell(n_hiers,1);
for ii=1:n_hiers
    % Transform the UCM to a hierarchy
    curr_hier = ucm2hier(all_ucms(:,:,ii));
    ths{ii}.start_ths = curr_hier.start_ths';
    ths{ii}.end_ths   = curr_hier.end_ths';
    ms{ii}            = curr_hier.ms_matrix;
    lps = cat(3, lps, curr_hier.leaves_part);
end

% Get full cands, represented on a fused hierarchy
[f_lp,f_ms,cands,start_ths,end_ths] = full_cands_from_hiers(lps,ms,ths,pareto_n_cands);

% Hole filling and complementary candidates
if ~isempty(f_ms)
    [cands_hf, cands_comp] = hole_filling(double(f_lp), double(f_ms), cands); %#ok<NASGU>
else
    cands_hf = cands;
    cands_comp = cands; %#ok<NASGU>
end

% Select which candidates to keep (Uncomment just one line)
cands = cands_hf;                       % Just the candidates with holes filled
% cands = [cands_hf; cands_comp];         % Holes filled and the complementary
% cands = [cands; cands_hf; cands_comp];  % All of them

% Compute base features
b_feats = compute_base_features(f_lp, f_ms, all_ucms);
b_feats.start_ths = start_ths;
b_feats.end_ths   = end_ths;
b_feats.im_size   = size(f_lp);

% Filter by overlap
red_cands = mex_fast_reduction(cands-1,b_feats.areas,b_feats.intersections,J_th);

% Compute full features on reduced cands
[feats, bboxes] = compute_full_features(red_cands,b_feats);

% Rank candidates
class_scores = regRF_predict(feats,rf_regressor);
[scores, ids] = sort(class_scores,'descend');
red_cands = red_cands(ids,:);
bboxes = bboxes(ids,:);
if isrow(scores)
    scores = scores';
end

% Max margin
[new_ids, mm_scores] = mex_max_margin(red_cands-1,scores,b_feats.intersections,theta); %#ok<NASGU>
cand_labels = red_cands(new_ids,:);
candidates.scores = scores(new_ids);
bboxes = bboxes(new_ids,:);

% Change the coordinates of bboxes to be coherent with
% other results from other sources (sel_search, etc.)
candidates.bboxes = [bboxes(:,2) bboxes(:,1) bboxes(:,4) bboxes(:,3)];

% Get the labels of leave regions that form each candidates
candidates.superpixels = f_lp;
if ~isempty(f_ms)
    candidates.labels = cands2labels(cand_labels,f_ms);
else
    candidates.labels = {1};
end

% Transform the results to masks
if compute_masks
    if ~isempty(f_ms)
        candidates.masks = cands2masks(cand_labels, f_lp, f_ms);
    else
        candidates.masks = true(size(f_lp));
    end
end


function out = extractFIR(x,n)
out = reshape(VBA_vec(x)',n,[]);
out = mean(out,2)';