lu1pq3 Subroutine

private subroutine lu1pq3(n, len, iperm, iw, nrank)

Arguments

Type IntentOptional Attributes Name
integer(kind=ip), intent(in) :: n
integer(kind=ip), intent(in) :: len(n)
integer(kind=ip), intent(inout) :: iperm(n)
integer(kind=ip), intent(out) :: iw(n)
integer(kind=ip) :: nrank

Called by

proc~~lu1pq3~~CalledByGraph proc~lu1pq3 lusol::lu1pq3 proc~lu1fad lusol::lu1fad proc~lu1fad->proc~lu1pq3 proc~lu1fac lusol::lu1fac proc~lu1fac->proc~lu1fad proc~solve lusol_ez_module::solve proc~solve->proc~lu1fac proc~test_1 main::test_1 proc~test_1->proc~solve proc~test_2 main::test_2 proc~test_2->proc~solve program~main~2 main program~main~2->proc~test_1 program~main~2->proc~test_2

Source Code

  subroutine lu1pq3( n, len, iperm, iw, nrank )

    integer(ip),   intent(in)    :: n
    integer(ip),   intent(in)    :: len(n)
    integer(ip),   intent(inout) :: iperm(n)
    integer(ip),   intent(out)   :: iw(n)   ! workspace

    !------------------------------------------------------------------
    ! lu1pq3  looks at the permutation  iperm(*)  and moves any entries
    ! to the end whose corresponding length  len(*)  is zero.
    !
    ! 09 Feb 1994: Added work array iw(*) to improve efficiency.
    !
    ! 10 Jan 2010: First f90 version.
    ! 12 Dec 2011: Declare intent and local variables.
    !------------------------------------------------------------------

    integer(ip)        :: i, k, nrank, nzero

    nrank  = 0
    nzero  = 0

    do k = 1, n
       i = iperm(k)

       if (len(i) == 0) then
          nzero     = nzero + 1
          iw(nzero) = i
       else
          nrank        = nrank + 1
          iperm(nrank) = i
       end if
    end do

    do k = 1, nzero
       iperm(nrank + k) = iw(k)
    end do

  end subroutine lu1pq3