Statistics
| Branch: | Revision:

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