solve Subroutine

public subroutine solve(n_cols, n_rows, n_nonzero, irow, icol, mat, b, x, istat, settings)

Wrapper for lu1fac + lu6sol to solve a linear system A*x = b.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: n_cols

n: number of columns in A.

integer, intent(in) :: n_rows

m: number of rows in A.

integer, intent(in) :: n_nonzero

number of nonzero elements of A.

integer, intent(in), dimension(n_nonzero) :: irow

sparsity pattern (size is n_nonzero)

integer, intent(in), dimension(n_nonzero) :: icol

sparsity pattern (size is n_nonzero)

real(kind=rp), intent(in), dimension(n_nonzero) :: mat

matrix elements (size is n_nonzero)

real(kind=rp), intent(in), dimension(n_rows) :: b

right hand side (size is m)

real(kind=rp), intent(out), dimension(n_cols) :: x

solution !size is n

integer, intent(out) :: istat

status code

type(lusol_settings), intent(in), optional :: settings

settings (if not present, defaults are used)


Calls

proc~~solve~~CallsGraph proc~solve lusol_ez_module::solve proc~lu1fac lusol::lu1fac proc~solve->proc~lu1fac proc~lu6sol lusol::lu6sol proc~solve->proc~lu6sol proc~lu1fad lusol::lu1fad proc~lu1fac->proc~lu1fad proc~lu1or1 lusol::lu1or1 proc~lu1fac->proc~lu1or1 proc~lu1or2 lusol::lu1or2 proc~lu1fac->proc~lu1or2 proc~lu1or3 lusol::lu1or3 proc~lu1fac->proc~lu1or3 proc~lu1or4 lusol::lu1or4 proc~lu1fac->proc~lu1or4 proc~lu1pq1 lusol::lu1pq1 proc~lu1fac->proc~lu1pq1 proc~lu1slk lusol::lu1slk proc~lu1fac->proc~lu1slk proc~lu6chk lusol::lu6chk proc~lu1fac->proc~lu6chk proc~lu6l lusol::lu6L proc~lu6sol->proc~lu6l proc~lu6ld lusol::lu6LD proc~lu6sol->proc~lu6ld proc~lu6lt lusol::lu6Lt proc~lu6sol->proc~lu6lt proc~lu6u lusol::lu6U proc~lu6sol->proc~lu6u proc~lu6ut lusol::lu6Ut proc~lu6sol->proc~lu6ut proc~hbuild lusol::Hbuild proc~lu1fad->proc~hbuild proc~hchange lusol::Hchange proc~lu1fad->proc~hchange proc~hdelete lusol::Hdelete proc~lu1fad->proc~hdelete proc~lu1ful lusol::lu1ful proc~lu1fad->proc~lu1ful proc~lu1gau lusol::lu1gau proc~lu1fad->proc~lu1gau proc~lu1mar lusol::lu1mar proc~lu1fad->proc~lu1mar proc~lu1mrp lusol::lu1mRP proc~lu1fad->proc~lu1mrp proc~lu1msp lusol::lu1mSP proc~lu1fad->proc~lu1msp proc~lu1mxc lusol::lu1mxc proc~lu1fad->proc~lu1mxc proc~lu1mxr lusol::lu1mxr proc~lu1fad->proc~lu1mxr proc~lu1pen lusol::lu1pen proc~lu1fad->proc~lu1pen proc~lu1pq2 lusol::lu1pq2 proc~lu1fad->proc~lu1pq2 proc~lu1pq3 lusol::lu1pq3 proc~lu1fad->proc~lu1pq3 proc~lu1rec lusol::lu1rec proc~lu1fad->proc~lu1rec proc~hinsert lusol::Hinsert proc~hbuild->proc~hinsert proc~hdown lusol::Hdown proc~hchange->proc~hdown proc~hup lusol::Hup proc~hchange->proc~hup proc~hdelete->proc~hchange proc~lu1dcp lusol::lu1DCP proc~lu1ful->proc~lu1dcp proc~lu1dpp lusol::lu1DPP proc~lu1ful->proc~lu1dpp proc~hinsert->proc~hup proc~jdamax lusol::jdamax proc~lu1dcp->proc~jdamax proc~lu1dpp->proc~jdamax

Called by

proc~~solve~~CalledByGraph proc~solve lusol_ez_module::solve 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 solve(n_cols,n_rows,n_nonzero,irow,icol,mat,b,x,istat,settings)

    integer,intent(in) :: n_cols !! `n`: number of columns in A.
    integer,intent(in) :: n_rows !! `m`: number of rows in A.
    integer,intent(in) :: n_nonzero !! number of nonzero elements of A.
    integer,dimension(n_nonzero),intent(in) :: irow, icol !! sparsity pattern (size is `n_nonzero`)
    real(rp),dimension(n_nonzero),intent(in) :: mat !! matrix elements (size is `n_nonzero`)
    real(rp),dimension(n_rows),intent(in) :: b !! right hand side (size is `m`)
    real(rp),dimension(n_cols),intent(out) :: x !! solution !size is `n`
    integer,intent(out) :: istat !! status code
    type(lusol_settings),intent(in),optional :: settings !! settings (if not present, defaults are used)

    integer(ip) :: nelem, n, m
    integer(ip) :: lena
    real(rp),dimension(:),allocatable :: a
    integer(ip),dimension(:),allocatable :: indc
    integer(ip),dimension(:),allocatable :: indr
    real(rp),dimension(:),allocatable :: ww
    real(rp),dimension(:),allocatable :: w
    real(rp),dimension(:),allocatable :: v
    integer(ip) :: inform
    integer(ip) :: luparm(30)
    real(rp) :: parmlu(30)
    integer(ip),dimension(:),allocatable :: p, q,  &
                                            lenc, lenr,  &
                                            iploc, iqloc,  &
                                            ipinv, iqinv,  &
                                            locc, locr

    type(lusol_settings) :: options

    if (present(settings)) options = settings ! use user-supplied settings

    n = n_cols
    m = n_rows
    nelem = n_nonzero
    lena = 1 + max( 2*nelem, 10*m, 10*n, 10000 )

    allocate(a(lena))
    allocate(indc(lena))
    allocate(indr(lena))
    associate (n =>n_cols, m => n_rows)
        allocate(p(m), q(n), lenc(n), lenr(m), &
                 iploc(n), iqloc(m), ipinv(m), &
                 iqinv(n), locc(n) , locr(m))
        allocate(ww(n))
        allocate(w(n)) ! x
        allocate(v(m)) ! b
    end associate

    a = 0; indc=0; indr=0
    a(1:nelem) = mat
    indc(1:nelem) = irow
    indr(1:nelem) = icol

    ! settings
    luparm = 0
    luparm( 1) = options%nout
    luparm( 2) = options%lprint
    luparm( 3) = options%maxcol
    luparm( 6) = options%method
    luparm( 8) = options%keepLU
    parmlu = 0
    parmlu( 1) = options%Ltol1
    parmlu( 2) = options%Ltol2
    parmlu( 3) = options%small
    parmlu( 4) = options%Utol1
    parmlu( 5) = options%Utol2
    parmlu( 6) = options%Uspace
    parmlu( 7) = options%dens1
    parmlu( 8) = options%dens2

    call lu1fac( m    , n    , nelem, lena , luparm, parmlu, &
                 a    , indc , indr , p    , q     ,         &
                 lenc , lenr , locc , locr ,                 &
                 iploc, iqloc, ipinv, iqinv, ww     , inform )

    !write(*,*) 'lu1fac inform = ', inform

    !  inform = 0 if the LU factors were obtained successfully.
    !         = 1 if U appears to be singular, as judged by lu6chk.
    !         = 3 if some index pair indc(l), indr(l) lies outside
    !             the matrix dimensions 1:m , 1:n.
    !         = 4 if some index pair indc(l), indr(l) duplicates
    !             another such pair.
    !         = 7 if the arrays a, indc, indr were not large enough.
    !             Their length "lena" should be increase to at least
    !             the value "minlen" given in luparm(13).
    !         = 8 if there was some other fatal error.  (Shouldn't happen!)
    !         = 9 if no diagonal pivot could be found with TSP or TDP.
    !             The matrix must not be sufficiently definite
    !             or quasi-definite.
    !         =10 if there was some other fatal error.


    v = b ! right hand side

    ! solve `A w = v`.
    call lu6sol( options%mode, m, n, v, w, &
                 lena, luparm, parmlu,   &
                 a, indc, indr, p, q,    &
                 lenc, lenr, locc, locr, &
                 inform )

    !write(*,*) 'lu6sol inform = ', inform

    ! On exit, inform = 0 except as follows.
    ! If mode = 3,4,5,6 and if U (and hence A) is singular, then
    ! inform = 1 if there is a nonzero residual in solving the system
    ! involving U.  parmlu(20) returns the norm of the residual.

    x = w ! solution
    istat = int(inform)

    end subroutine solve