linsolve Subroutine

public subroutine linsolve(n, a, nrhs, b, x, LU, P, toggle)

Arguments

Type IntentOptional AttributesName
integer, intent(in) :: n
real(kind=wp), intent(in), dimension(n, n):: a
integer, intent(in) :: nrhs
real(kind=wp), intent(in), dimension(n, nrhs):: b
real(kind=wp), intent(out), dimension(n, nrhs):: x
real(kind=wp), intent(inout), dimension(n, n):: LU
integer, intent(inout), dimension(n):: P
logical, intent(in) :: toggle

Calls

proc~~linsolve~~CallsGraph proc~linsolve linsolve dgetrf dgetrf proc~linsolve->dgetrf dgetrs dgetrs proc~linsolve->dgetrs

Called by

proc~~linsolve~~CalledByGraph proc~linsolve linsolve proc~linsolve_quick linsolve_quick proc~linsolve_quick->proc~linsolve proc~getalpha1d getAlpha1D proc~getalpha1d->proc~linsolve_quick program~driver1d driver1D program~driver1d->proc~linsolve_quick proc~getalpha2d getAlpha2D proc~getalpha2d->proc~linsolve_quick

Contents

Source Code


Source Code

  subroutine linsolve (n, a, nrhs, b, x, LU, P, toggle)

    ! Linsolve is a wrapper of dgesv, the main linear solver routine for
    ! general dense matrices in LAPACK. This routine splits dgesv into
    ! its two primary components:
    !
    !       dgetrf - Decomposes A into P*L*U
    !       dgetrs - Uses P*L*U to solve for x (Ax=b => (P*L*U)x=b)
    !
    ! Splitting these two up like this allows you to save the decomposed
    ! version of 'A' so that you don't have to do it again. If 'toggle'
    ! is equal to true, then the decomposition has already occured and
    ! LU can be trusted - OK to skip dgetrf

    ! Dummy variables
    integer,  intent(in)                          :: n, nrhs
    integer,  intent(inout),  dimension(n)        :: P
    real(wp), intent(in),     dimension(n, n)     :: a
    real(wp), intent(in),     dimension(n, nrhs)  :: b
    real(wp), intent(out),    dimension(n, nrhs)  :: x
    real(wp), intent(inout),  dimension(n, n)     :: LU
    logical,  intent(in)                          :: toggle

    ! Local variables
    integer                                       :: info
    integer,                  dimension(n)        :: my_P
    real(wp),                 dimension(n, n)     :: my_a
    real(wp),                 dimension(n, nrhs)  :: my_b

    my_a = a
    my_b = b

    if ( .not. toggle ) then
      call dgetrf (n, n, my_a, n, my_P, info)

      if ( info /= 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'DGETRF'
        write ( *, '(a,i8)' ) '  Factorization failed, INFO = ', info
        stop
      endif

      LU  = my_a
      P   = my_P

    endif

    call dgetrs ('No transpose', n, nrhs, LU, n, P, my_b, n, info)

    if ( info /= 0 ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'DGETRS'
      write ( *, '(a,i8)' ) '  Back substitution failed, INFO = ', info
      stop
    endif

    x = my_b

    return
  end subroutine linsolve