Octave logo Octave-Forge - Extra packages for GNU Octave
Home · Packages · Developers · Documentation · Function Reference · FAQ · Bugs · Mailing Lists · Links · SVN
  • Main Page
  • Classes
  • Files

examples/fortdemo.cc

Go to the documentation of this file.
00001 /*
00002 
00003 Copyright (C) 2006, 2007 John W. Eaton
00004 
00005 This file is part of Octave.
00006 
00007 Octave is free software; you can redistribute it and/or 
00008 modify it under the terms of the GNU General Public License 
00009 as published by the Free Software Foundation; either
00010 version 3  of the License, or (at your option) any later 
00011 version.
00012 
00013 Octave is distributed in the hope that it will be useful, 
00014 but WITHOUT ANY WARRANTY; without even the implied warranty
00015 of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00016 See the GNU General Public License for more details.
00017 
00018 You should have received a copy of the GNU General Public 
00019 License along with Octave; see the file COPYING.  If not,
00020 see <http://www.gnu.org/licenses/>.
00021 
00022 */
00023 
00024 #include <octave/oct.h>
00025 #include <octave/f77-fcn.h>
00026 
00027 extern "C" 
00028 {
00029   F77_RET_T 
00030   F77_FUNC (fortsub, FORTSUB) 
00031         (const int&, double*, F77_CHAR_ARG_DECL  
00032          F77_CHAR_ARG_LEN_DECL);
00033 }
00034 
00035 DEFUN_DLD (fortdemo , args , , "Fortran Demo.")
00036 {
00037   octave_value_list retval;  
00038   int nargin = args.length();
00039   if (nargin != 1)
00040     print_usage ();
00041   else
00042     {
00043       NDArray a = args(0).array_value ();
00044       if (! error_state)
00045         {
00046           double *av = a.fortran_vec ();
00047           octave_idx_type na = a.nelem ();
00048           OCTAVE_LOCAL_BUFFER (char, ctmp, 128);
00049 
00050           F77_XFCN (fortsub, FORTSUB, (na, av, ctmp 
00051                     F77_CHAR_ARG_LEN (128)));
00052 
00053           if (f77_exception_encountered)
00054             error ("fortdemo: error in fortran");
00055           else
00056             {
00057               retval(1) = std::string (ctmp);
00058               retval(0) = a;
00059             }
00060         }
00061     }
00062   return retval;
00063 }
SourceForge.net Logo