DOUG 0.2

SpMtx_op_block.f90

Go to the documentation of this file.
00001 
00002 module SpMtx_op_block
00003   use SpMtx_class
00004 
00005   integer,parameter :: D_ADDBLOCK_OPERATION_COLS = 1 !< add block as columns (right)
00006   integer,parameter :: D_ADDBLOCK_OPERATION_ROWS = 2 !< add block as rows (lower)
00007   integer,parameter :: D_ADDBLOCK_OPERATION_DIAG = 3 !< add block on diagonal (lower-right)
00008 
00009 contains
00012   subroutine SpMtx_addBlock(A, B, operation)
00013     type(SpMtx), intent(inout) :: A !< Matrix to add block to
00014     type(SpMtx), intent(in) :: B !< Matrix block to add
00015     integer, intent(in) :: operation !< Specifies how block to be added
00016 
00017     integer :: old_nnz, old_ncols
00018 
00019     if (operation==D_ADDBLOCK_OPERATION_COLS) then
00020        old_nnz = A%nnz
00021        old_ncols = A%ncols
00022        if (B%nnz/=0) then
00023           call SpMtx_resize(A, A%nnz+B%nnz)
00024           A%indi(old_nnz+1:) = B%indi
00025           A%indj(old_nnz+1:) = B%indj + old_ncols
00026           A%val(old_nnz+1:) = B%val
00027           A%arrange_type = D_ARRNG_NO
00028        end if
00029        A%ncols = old_ncols + B%ncols
00030        A%nrows = max(A%nrows, B%nrows)
00031 
00032     else if (operation==D_ADDBLOCK_OPERATION_DIAG) then
00033        old_nnz = A%nnz
00034        old_ncols = A%ncols
00035        old_nrows = A%nrows
00036        if (B%nnz/=0) then
00037           call SpMtx_resize(A, A%nnz+B%nnz)
00038           A%indi(old_nnz+1:) = B%indi + old_nrows
00039           A%indj(old_nnz+1:) = B%indj + old_ncols
00040           A%val(old_nnz+1:) = B%val
00041           A%arrange_type = D_ARRNG_NO
00042        end if
00043        A%ncols = old_ncols + B%ncols
00044        A%nrows = old_nrows + B%nrows
00045 
00046     else ! unsupported block addition operation
00047        write (stream, *) "[SpMtx_addBlock] Operation not supported:", operation
00048        call DOUG_Abort("Cannot add block to the matrix")
00049     endif
00050   end subroutine SpMtx_addBlock
00051 
00052 end module SpMtx_op_block