print_sparsity Subroutine

private subroutine print_sparsity(me, n, m, iunit, dense)

Print the sparsity pattern.

Type Bound

sparsity_pattern

Arguments

Type IntentOptional Attributes Name
class(sparsity_pattern), intent(in) :: me
integer, intent(in) :: n

number of variables (columns of jacobian)

integer, intent(in) :: m

number of functions (rows of jacobian)

integer, intent(in) :: iunit

file unit to write to. (assumed to be already opened)

logical, intent(in), optional :: dense

if present and true, the matrix form of the sparsity pattern is printed (default is vector form)


Source Code

    subroutine print_sparsity(me,n,m,iunit,dense)

    implicit none

    class(sparsity_pattern),intent(in) :: me
    integer,intent(in) :: n  !! number of variables (columns of jacobian)
    integer,intent(in) :: m  !! number of functions (rows of jacobian)
    integer,intent(in) :: iunit !! file unit to write to.
                                !! (assumed to be already opened)
    logical,intent(in),optional :: dense  !! if present and true, the matrix form
                                          !! of the sparsity pattern is printed
                                          !! (default is vector form)

    logical :: print_matrix !! if the matrix form is to be printed
    integer :: r   !! row counter
    character(len=1),dimension(n) :: row  !! a row of the sparsity matrix

    if (present(dense)) then
        print_matrix = dense
    else
        print_matrix = .false.  ! default
    end if

    write(iunit,'(A)') '---Sparsity pattern---'
    if (allocated(me%irow) .and. allocated(me%icol)) then

        if (print_matrix) then
            do r = 1,m    ! print by row
                row = '0'
                row(pack(me%icol,mask=me%irow==r)) = 'X'
                write(iunit,'(*(A1))') row
            end do
        else
            write(iunit,'(A,1X,*(I3,","))') 'irow:',me%irow
            write(iunit,'(A,1X,*(I3,","))') 'icol:',me%icol
        end if

        if (allocated(me%ngrp)) then
            write(iunit,'(A)') ''
            write(iunit,'(A)') '---Sparsity partition---'
            write(iunit,'(A,1x,I5)')       'Number of groups:',me%maxgrp
            write(iunit,'(A,1x,*(I5,1X))') 'Group array:     ',me%ngrp
        end if

    end if
    write(iunit,'(A)') ''

    ! print linear pattern if available
    if (me%linear_sparsity_computed) then
        write(iunit,'(A)') '---Linear sparsity pattern---'
        if (allocated(me%linear_icol) .and. allocated(me%linear_irow)) then
            if (print_matrix) then
                do r = 1,m    ! print by row
                    row = '0'
                    row(pack(me%linear_icol,mask=me%linear_irow==r)) = 'X'
                    write(iunit,'(*(A1))') row
                end do
            else
                write(iunit,'(A,1X,*(I3,","))') 'irow:',me%linear_irow
                write(iunit,'(A,1X,*(I3,","))') 'icol:',me%linear_icol
                write(iunit,'(A,1X,*(E30.16,","))') 'vals:',me%linear_vals
            end if
        end if
        write(iunit,'(A)') ''
    end if

    end subroutine print_sparsity