← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to examples/intersci-examples-so/ex05f.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/intersci-examples-so/ex05f.f
 
1
      subroutine foubare2(ch,a,ia,b,ib,c,mc,nc,d,w)
 
2
c     -----------------------------------------
 
3
c     -----------   EXAMPLE   -----------------
 
4
c     inputs:  ch, a,b and c; ia,ib and mc,nc
 
5
c     ch=character, a=integer, b=real and c=double 
 
6
c     ia,ib and [mc,nc] are the dimensions of a,b and c resp.
 
7
c     outputs: a,b,c,d
 
8
c     if ch='mul'   a,b and c = 2 * (a,b and c) 
 
9
c     and d of same dimensions as c with
 
10
c     d(i,j)=(i+j)*c(i,j)
 
11
c     if ch='add' a,b and c = 2 + (a,b and c)
 
12
c     d(i,j)=(i+j)+c(i,j)
 
13
c     w is a working array of size [mc,nc]
 
14
c     -------------------------------------------
 
15
      character*(*) ch
 
16
      integer a(*)
 
17
      real b(*)
 
18
      double precision c(mc,*),d(mc,*),w(mc,*)
 
19
      if(ch(1:3).eq.'mul') then
 
20
      do 1 k=1,ia
 
21
         a(k)=2*a(k)
 
22
 1    continue
 
23
      do 2 k=1,ib
 
24
         b(k)=2.0*b(k)
 
25
 2    continue
 
26
      do 3 i=1,mc
 
27
      do 3 j=1,nc
 
28
         c(i,j)=2.0d0*c(i,j)
 
29
 3    continue
 
30
      do 4 i=1,mc
 
31
      do 4 j=1,nc
 
32
       w(i,j)=dble(i+j)
 
33
       d(i,j)=w(i,j)*c(i,j)
 
34
 4    continue
 
35
      elseif(ch(1:3).eq.'add') then
 
36
      do 10 k=1,ia
 
37
         a(k)=2+a(k)
 
38
 10   continue
 
39
      do 20 k=1,ib
 
40
         b(k)=2.0+b(k)
 
41
 20   continue
 
42
      do 30 i=1,mc
 
43
      do 30 j=1,nc
 
44
         c(i,j)=2.0d0+c(i,j)
 
45
 30   continue
 
46
      do 40 i=1,mc
 
47
      do 40 j=1,nc
 
48
       w(i,j)=dble(i+j)
 
49
       d(i,j)=w(i,j)+c(i,j)
 
50
 40   continue
 
51
      endif
 
52
      end
 
53