root / synthbench / euroben-dm / mod2b / .svn / text-base / getf2.f.svn-base @ 0:839f52ef7657
History | View | Annotate | Download (1.6 kB)
1 |
Subroutine getf2( m, n, a, lda, ipiv, info ) |
---|---|
2 |
! ----------------------------------------------------------------------- |
3 |
Use numerics |
4 |
Use dist_module |
5 |
Implicit None |
6 |
Include 'mpif.h' |
7 |
|
8 |
Integer :: m, n, lda, info |
9 |
Integer :: ipiv(*) |
10 |
Real(l_) :: a(lda,*) |
11 |
|
12 |
Integer :: i, j, ip |
13 |
Integer :: idmax |
14 |
Real(l_) :: pivcol(m-1) |
15 |
Integer :: comm, ierr |
16 |
! ----------------------------------------------------------------------- |
17 |
info = 0 |
18 |
comm = MPI_Comm_World |
19 |
|
20 |
Do i = 1, m |
21 |
j = localindex(i) |
22 |
If ( me == owner(i) ) Then |
23 |
ip = i - 1 + idmax( m-i+1, a(i,j), 1 ) |
24 |
If ( a(ip,j) == 0.0_l_ ) ip = -ip |
25 |
End If |
26 |
|
27 |
Call MPI_Bcast( ip, 1, MPI_Integer, owner(i), comm, ierr ) |
28 |
|
29 |
ipiv(i) = Abs( ip ) |
30 |
If ( ip > 0 ) Then |
31 |
If ( ip /= i ) Call swap( n, a(i,1), lda, a(ip,1), lda ) |
32 |
If ( me == owner(i) ) Then |
33 |
Call scal( m-i, 1.0_l_/a(i,j), a(i+1,j), 1 ) |
34 |
End If |
35 |
Else If ( info == 0 ) Then |
36 |
info = i |
37 |
End If |
38 |
|
39 |
If ( i < m ) Then |
40 |
If ( me == owner(i) ) Then |
41 |
pivcol(1:m-i) = a(i+1:m,j) |
42 |
Else |
43 |
j = j-1 |
44 |
End If |
45 |
|
46 |
Call MPI_Bcast(pivcol, m-i, MPI_Real8, owner(I), comm, ierr) |
47 |
|
48 |
If ( j < n ) Call ger( m-i, n-j, -1.0_l_, |
49 |
& pivcol, 1, a(i,j+1), lda, a(i+1,j+1), lda) |
50 |
End If |
51 |
End Do ! --- i-loop |
52 |
! ----------------------------------------------------------------------- |
53 |
End Subroutine getf2 |