annotate examples/fortsub.f @ 6909:fc55a5e1760b ss-2-9-14

[project @ 2007-09-17 20:47:40 by jwe]
author jwe
date Mon, 17 Sep 2007 20:47:41 +0000
parents 8e7148b84b59
children 4270ded9ddc6
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
6572
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
1 subroutine fortsub (n, a, s)
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
2 implicit none
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
3 character*(*) s
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
4 real*8 a(*)
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
5 integer*4 i, n, ioerr
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
6 do i = 1, n
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
7 if (a(i) .eq. 0d0) then
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
8 call xstopx ('fortsub: divide by zero')
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
9 else
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
10 a(i) = 1d0 / a(i)
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
11 endif
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
12 enddo
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
13 write (unit = s, fmt = '(a,i3,a,a)', iostat = ioerr)
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
14 $ 'There are ', n, ' values in the input vector',
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
15 $ char(0)
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
16 if (ioerr .ne. 0) then
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
17 call xstopx ('fortsub: error writing string')
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
18 endif
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
19 return
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
20 end
8e7148b84b59 [project @ 2007-04-25 04:13:44 by jwe]
jwe
parents:
diff changeset
21