vector_pde_source Subroutine

subroutine vector_pde_source(sign, pde, phi, side)

Uses

  • proc~~vector_pde_source~~UsesGraph proc~vector_pde_source vector_pde_source module~class_dimensions class_dimensions proc~vector_pde_source->module~class_dimensions module~class_vector_field class_vector_field proc~vector_pde_source->module~class_vector_field module~class_vector_pde class_vector_pde proc~vector_pde_source->module~class_vector_pde module~tools_operators tools_operators proc~vector_pde_source->module~tools_operators module~class_psblas class_psblas proc~vector_pde_source->module~class_psblas module~class_mesh class_mesh proc~vector_pde_source->module~class_mesh module~class_scalar_pde class_scalar_pde proc~vector_pde_source->module~class_scalar_pde module~class_dimensions->module~class_psblas module~class_vector_field->module~class_dimensions module~class_vector_field->module~class_psblas module~class_vector_field->module~class_mesh module~class_field class_field module~class_vector_field->module~class_field module~class_bc class_bc module~class_vector_field->module~class_bc module~class_vector class_vector module~class_vector_field->module~class_vector module~class_material class_material module~class_vector_field->module~class_material module~class_vector_pde->module~class_vector_field module~class_vector_pde->module~class_psblas module~class_vector_pde->module~class_mesh module~class_vector_pde->module~class_vector module~class_pde class_pde module~class_vector_pde->module~class_pde module~tools_operators->module~class_psblas module~class_stopwatch class_stopwatch module~class_psblas->module~class_stopwatch module~tools_psblas tools_psblas module~class_psblas->module~tools_psblas module~class_mesh->module~class_psblas module~class_cell class_cell module~class_mesh->module~class_cell module~class_keytable class_keytable module~class_mesh->module~class_keytable module~class_mesh->module~class_vector module~class_surface class_surface module~class_mesh->module~class_surface module~class_connectivity class_connectivity module~class_mesh->module~class_connectivity module~class_least_squares class_least_squares module~class_mesh->module~class_least_squares psb_base_mod psb_base_mod module~class_mesh->psb_base_mod module~class_vertex class_vertex module~class_mesh->module~class_vertex module~grid_interface grid_interface module~class_mesh->module~grid_interface module~class_face class_face module~class_mesh->module~class_face module~class_scalar_pde->module~class_dimensions module~class_scalar_pde->module~class_psblas module~class_scalar_pde->module~class_mesh module~class_scalar_pde->module~class_material module~class_scalar_field class_scalar_field module~class_scalar_pde->module~class_scalar_field module~class_scalar_pde->psb_base_mod module~class_scalar_pde->module~class_pde module~class_stopwatch->module~tools_psblas module~class_stopwatch->psb_base_mod module~class_field->module~class_dimensions module~class_field->module~class_psblas module~class_field->module~class_mesh module~class_field->module~class_bc module~class_field->module~class_material module~class_field->module~grid_interface module~class_bc->module~class_psblas module~class_motion class_motion module~class_bc->module~class_motion module~class_bc_math class_bc_math module~class_bc->module~class_bc_math module~class_bc_wall class_bc_wall module~class_bc->module~class_bc_wall module~tools_psblas->psb_base_mod psb_krylov_mod psb_krylov_mod module~tools_psblas->psb_krylov_mod psb_prec_mod psb_prec_mod module~tools_psblas->psb_prec_mod module~class_cell->module~class_psblas module~class_vector->module~class_psblas module~class_material->module~class_psblas matlib matlib module~class_material->matlib module~class_surface->module~class_connectivity module~class_cylinder class_cylinder module~class_surface->module~class_cylinder module~class_plane class_plane module~class_surface->module~class_plane module~class_connectivity->module~class_psblas module~class_least_squares->module~class_psblas module~class_least_squares->module~class_connectivity module~class_scalar_field->module~class_dimensions module~class_scalar_field->module~class_psblas module~class_scalar_field->module~class_mesh module~class_scalar_field->module~class_field module~class_scalar_field->module~class_bc module~class_scalar_field->module~class_material module~class_vertex->module~class_psblas module~class_vertex->module~class_vector module~class_pde->module~class_dimensions module~class_pde->module~class_psblas module~class_pde->module~class_mesh module~units_interface units_interface module~grid_interface->module~units_interface module~object_interface object_interface module~grid_interface->module~object_interface module~class_face->module~class_psblas module~class_motion->module~class_psblas module~class_motion->module~class_vector module~class_cylinder->module~class_psblas module~class_cylinder->module~class_vector module~class_cylinder->module~class_vertex module~class_bc_math->module~class_psblas module~class_plane->module~class_psblas module~class_plane->module~class_vector module~class_bc_wall->module~class_dimensions module~class_bc_wall->module~class_psblas module~class_bc_wall->module~class_mesh module~class_bc_wall->module~class_vector module~class_bc_wall->module~class_material module~class_bc_wall->module~class_bc_math module~units_interface->module~object_interface

Arguments

Type IntentOptional AttributesName
character(len=1), intent(in) :: sign
type(vector_pde), intent(inout) :: pde
type(vector_field), intent(in) :: phi
real(kind=psb_dpk_), intent(in), optional :: side

Calls

proc~~vector_pde_source~~CallsGraph proc~vector_pde_source vector_pde_source psb_get_loc_to_glob psb_get_loc_to_glob proc~vector_pde_source->psb_get_loc_to_glob interface~abort_psblas abort_psblas proc~vector_pde_source->interface~abort_psblas interface~mypnum_ mypnum_ proc~vector_pde_source->interface~mypnum_ get_mesh get_mesh proc~vector_pde_source->get_mesh interface~pde_sign pde_sign proc~vector_pde_source->interface~pde_sign psb_cd_get_local_rows psb_cd_get_local_rows proc~vector_pde_source->psb_cd_get_local_rows interface~size_blk size_blk proc~vector_pde_source->interface~size_blk proc~abort_psblas abort_psblas interface~abort_psblas->proc~abort_psblas proc~mypnum_ mypnum_ interface~mypnum_->proc~mypnum_ proc~pde_sign pde_sign interface~pde_sign->proc~pde_sign proc~size_blk size_blk interface~size_blk->proc~size_blk proc~pde_sign->interface~abort_psblas psb_abort psb_abort proc~abort_psblas->psb_abort

Contents

Source Code


Source Code

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