1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
c Copyright (C) ????-2008 - INRIA
c
c This file must be used under the terms of the CeCILL.
c This source file is licensed as described in the file COPYING, which
c you should have received as part of this distribution. The terms
c are also available at
c http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
subroutine foubare2(ch,a,ia,b,ib,c,mc,nc,d,w)
c -----------------------------------------
c ----------- EXAMPLE -----------------
c inputs: ch, a,b and c; ia,ib and mc,nc
c ch=character, a=integer, b=real and c=double
c ia,ib and [mc,nc] are the dimensions of a,b and c resp.
c outputs: a,b,c,d
c if ch='mul' a,b and c = 2 * (a,b and c)
c and d of same dimensions as c with
c d(i,j)=(i+j)*c(i,j)
c if ch='add' a,b and c = 2 + (a,b and c)
c d(i,j)=(i+j)+c(i,j)
c w is a working array of size [mc,nc]
c -------------------------------------------
character*(*) ch
integer a(*)
real b(*)
double precision c(mc,*),d(mc,*),w(mc,*)
if(ch(1:3).eq.'mul') then
do 1 k=1,ia
a(k)=2*a(k)
1 continue
do 2 k=1,ib
b(k)=2.0*b(k)
2 continue
do 3 i=1,mc
do 3 j=1,nc
c(i,j)=2.0d0*c(i,j)
3 continue
do 4 i=1,mc
do 4 j=1,nc
w(i,j)=dble(i+j)
d(i,j)=w(i,j)*c(i,j)
4 continue
elseif(ch(1:3).eq.'add') then
do 10 k=1,ia
a(k)=2+a(k)
10 continue
do 20 k=1,ib
b(k)=2.0+b(k)
20 continue
do 30 i=1,mc
do 30 j=1,nc
c(i,j)=2.0d0+c(i,j)
30 continue
do 40 i=1,mc
do 40 j=1,nc
w(i,j)=dble(i+j)
d(i,j)=w(i,j)+c(i,j)
40 continue
endif
end
|
