SUBROUTINE vector_pde_source(sign,pde,phi,side)
USE class_psblas
USE class_dimensions
USE class_mesh
USE class_vector_pde
USE tools_operators
USE class_vector_field
USE class_scalar_pde
IMPLICIT NONE
!
CHARACTER(len=1), INTENT(IN) :: sign
TYPE(vector_pde), INTENT(INOUT) :: pde
TYPE(vector_field), INTENT(IN) :: phi
REAL(psb_dpk_), INTENT(IN), OPTIONAL :: side
!
INTEGER :: i, ic, ic_glob, ifirst, info, ncells, nel, nmax
INTEGER, ALLOCATABLE :: ia(:), ja(:)
INTEGER, ALLOCATABLE :: iloc_to_glob(:)
REAL(psb_dpk_) :: fact, fsign, sc, sp, side_
REAL(psb_dpk_), ALLOCATABLE :: A(:), b(:)
TYPE(dimensions) :: dim
TYPE(mesh), POINTER :: msh => NULL()
CALL sw_pde%tic()
IF(mypnum_() == 0) THEN
WRITE(*,*) '* ', TRIM(pde%name_()), ': applying the Source term'
END IF
! Possible reinit of pde
CALL pde%reinit_pde()
! Dimensional check
dim = phi%dim_() * volume_
IF(dim /= pde%dim_()) THEN
WRITE(*,100)
CALL abort_psblas
END IF
! Computes sign factor
IF(PRESENT(side)) THEN
side_ = side
ELSE
side_ = lhs_ ! Default = LHS
END IF
fsign = pde_sign(sign,side_)
! Gets PDE mesh
CALL get_mesh(pde,msh)
! Number of strictly local cells
ncells = psb_cd_get_local_rows(msh%desc_c)
! Gets local to global list for cell indices
CALL psb_get_loc_to_glob(msh%desc_c,iloc_to_glob)
! Computes maximum size of blocks to be inserted
nmax = size_blk(1,ncells)
ALLOCATE(b(nmax),ia(nmax),ja(nmax),stat=info)
IF(info /= 0) THEN
WRITE(*,200)
CALL abort_psblas
END IF
ifirst = 1; ic = 0
insert: DO
IF(ifirst > ncells) EXIT insert
nel = size_blk(ifirst,ncells)
BLOCK: DO i = 1, nel
! Local indices
ic = ic + 1
fact = fsign * msh%vol(ic)
! WARNING! If one assumes that SRC is applied to RHS then
! pde_sign returns FSIGN < 0.
A(i) = fact * sp
b(i) = -fact * sc
! Global indices in COO format
ic_glob = iloc_to_glob(ic)
ia(i)= ic_glob
ja(i)= ic_glob
END DO BLOCK
CALL pde%spins_pde(nel,ia,ja,A)
CALL pde%geins_pde(nel,ia,b)
ifirst = ifirst + nel
END DO insert
DEALLOCATE(A,b,ia,ja)
DEALLOCATE(iloc_to_glob)
NULLIFY(msh)
CALL sw_pde%toc()
100 FORMAT(' ERROR! Dimensional check failure in SCALAR_PDE_SOURCE')
200 FORMAT(' ERROR! Memory allocation failure in SCALAR_PDE_SOURCE')
END SUBROUTINE vector_pde_source