|
7019
|
1 c Copyright (C) 2007 John W. Eaton |
|
|
2 c |
|
|
3 c This file is part of Octave. |
|
|
4 c |
|
7081
|
5 c Octave is free software; you can redistribute it and/or |
|
|
6 c modify it under the terms of the GNU General Public |
|
|
7 c License as published by the Free Software Foundation; |
|
|
8 c either version 3 of the License, or (at your option) any |
|
|
9 c later version. |
|
7019
|
10 c |
|
7081
|
11 c Octave is distributed in the hope that it will be useful, |
|
|
12 c but WITHOUT ANY WARRANTY; without even the implied |
|
|
13 c warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR |
|
|
14 c PURPOSE. See the GNU General Public License for more |
|
|
15 c details. |
|
7019
|
16 c |
|
7081
|
17 c You should have received a copy of the GNU General Public |
|
|
18 c License along with Octave; see the file COPYING. If not, |
|
|
19 c see <http://www.gnu.org/licenses/>. |
|
7019
|
20 |
|
6572
|
21 subroutine fortsub (n, a, s) |
|
|
22 implicit none |
|
|
23 character*(*) s |
|
|
24 real*8 a(*) |
|
|
25 integer*4 i, n, ioerr |
|
|
26 do i = 1, n |
|
|
27 if (a(i) .eq. 0d0) then |
|
|
28 call xstopx ('fortsub: divide by zero') |
|
|
29 else |
|
|
30 a(i) = 1d0 / a(i) |
|
|
31 endif |
|
|
32 enddo |
|
|
33 write (unit = s, fmt = '(a,i3,a,a)', iostat = ioerr) |
|
7081
|
34 $ 'There are ', n, |
|
|
35 $ ' values in the input vector', char(0) |
|
6572
|
36 if (ioerr .ne. 0) then |
|
|
37 call xstopx ('fortsub: error writing string') |
|
|
38 endif |
|
|
39 return |
|
|
40 end |
|
|
41 |
