File: fortransub.f

package info (click to toggle)
octave 11.0.92-1
  • links: PTS, VCS
  • area: main
  • in suites: experimental
  • size: 148,624 kB
  • sloc: cpp: 347,499; ansic: 85,112; fortran: 20,693; objc: 10,276; sh: 8,747; lex: 4,496; yacc: 4,406; perl: 1,544; java: 1,365; awk: 1,282; makefile: 666; xml: 192
file content (20 lines) | stat: -rw-r--r-- 558 bytes parent folder | download | duplicates (7) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
      subroutine fortransub (n, a, s)
      implicit none
      character*(*) s
      real*8 a(*)
      integer*4 i, n, ioerr
      do i = 1, n
        if (a(i) .eq. 0d0) then
          call xstopx ('fortransub: divide by zero')
        else
          a(i) = 1d0 / a(i)
        endif
      enddo
      write (unit = s, fmt = '(a,i3,a,a)', iostat = ioerr)
     $       'There are ', n,
     $       ' values in the input vector', char(0)
      if (ioerr .ne. 0) then
        call xstopx ('fortransub: error writing string')
      endif
      return
      end