root / synthbench / euroben-dm / mod2b / ger.f @ 0:839f52ef7657
History | View | Annotate | Download (1.8 kB)
1 |
Subroutine ger( m, n, alpha, x, incx, y, incy, a, lda ) |
---|---|
2 |
! ----------------------------------------------------------------------- |
3 |
Use numerics |
4 |
Implicit None |
5 |
|
6 |
Real(l_) :: alpha |
7 |
Integer :: incx, incy, lda, m, n |
8 |
Real(l_) :: a(lda,*), x(*), y(*) |
9 |
Real(l_) :: temp |
10 |
Integer :: i, info, ix, j, jy, kx |
11 |
! ----------------------------------------------------------------------- |
12 |
info = 0 |
13 |
If (m < 0 ) Then |
14 |
info = 1 |
15 |
Else If ( n < 0 ) Then |
16 |
info = 2 |
17 |
Else If ( incx == 0 ) Then |
18 |
info = 5 |
19 |
Else If ( incy == 0 ) Then |
20 |
Info = 7 |
21 |
Else If ( lda < Max( 1, m ) ) Then |
22 |
Info = 9 |
23 |
End If |
24 |
If ( Info /= 0 ) Then |
25 |
Call xerbla( 'GER ', info ) |
26 |
Return |
27 |
End If |
28 |
If ( ( m == 0 ) .OR. ( n == 0 ) .OR. ( alpha == 0.0_l_ ) ) Return |
29 |
If ( incy > 0 ) Then |
30 |
jy = 1 |
31 |
Else |
32 |
jy = 1 - (n-1)*incy |
33 |
End If |
34 |
If ( incx == 1 ) Then |
35 |
Do j = 1, n |
36 |
If ( y(jy) /= 0.0_l_ ) Then |
37 |
temp = alpha*y(jy) |
38 |
Do i = 1, m |
39 |
a(i,j) = a(i,j) + x(i)*temp |
40 |
End Do |
41 |
End If |
42 |
jy = jy + incy |
43 |
End Do |
44 |
Else |
45 |
If ( incx > 0 ) Then |
46 |
kx = 1 |
47 |
Else |
48 |
kx = 1 - (m-1)*incx |
49 |
End If |
50 |
Do j = 1, n |
51 |
If ( y(jy) /= 0.0_l_ ) Then |
52 |
temp = alpha*y(jy) |
53 |
ix = kx |
54 |
Do i = 1, m |
55 |
a(i,j) = a(i,j) + x(ix)*temp |
56 |
ix = ix + incx |
57 |
End Do |
58 |
End If |
59 |
jy = jy + incy |
60 |
End Do |
61 |
End If |
62 |
! ----------------------------------------------------------------------- |
63 |
End Subroutine ger |