|
DOUG 0.2
|
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
1.7.3-20110217