ms_fe_f_2_mat Subroutine

public subroutine ms_fe_f_2_mat(ms_fe_f, code, nodal, mat)


Arguments

Type IntentOptional AttributesName
type(MS_FE_FILM), intent(in) :: ms_fe_f
integer(kind=I4), intent(in) :: code

saved information like P_N

logical(kind=I4), intent(in) :: nodal

if false : cell value, if true : nodal value

real(kind=R8), intent(inout), allocatable:: mat(:,:)

output matrix containing the information


Called by

proc~~ms_fe_f_2_mat~~CalledByGraph proc~ms_fe_f_2_mat ms_fe_f_2_mat proc~solve_ms_prob solve_ms_prob proc~solve_ms_prob->proc~ms_fe_f_2_mat proc~save_ms_field save_ms_field proc~solve_ms_prob->proc~save_ms_field proc~save_ms_field->proc~ms_fe_f_2_mat proc~smooth_ms_fe_f smooth_ms_fe_f proc~smooth_ms_fe_f->proc~ms_fe_f_2_mat proc~test_slider_ms test_slider_ms proc~test_slider_ms->proc~solve_ms_prob proc~test_rough_ms test_rough_ms proc~test_rough_ms->proc~solve_ms_prob proc~run_test run_test proc~run_test->proc~test_slider_ms proc~run_test->proc~test_rough_ms program~main main program~main->proc~run_test

Contents

Source Code


Source Code

   subroutine ms_fe_f_2_mat(ms_fe_f, code, nodal, mat)
   implicit none
   type(MS_FE_FILM), intent(in   )              :: ms_fe_f
   integer(kind=I4), intent(in   )              :: code        !! *saved information like P_N*
   logical(kind=I4), intent(in   )              :: nodal       !! *if false : cell value, if true : nodal value*
   real(kind=R8),    intent(inout), allocatable :: mat(:,:)    !! *output matrix containing the information*

      integer(kind=I4) :: ts_nx, ts_ny, ex, ey, e, ne_x, ne_y, nnx, nny, c
      integer(kind=I4), allocatable, dimension(:) :: bs_nx, bs_ny

      ts_nx = ms_fe_f%ts_fe_f%m%nx -1
      ts_ny = ms_fe_f%ts_fe_f%m%ny -1

      allocate(bs_nx(ts_nx*ts_ny), bs_ny(ts_nx*ts_ny))

      bs_nx(:) = ms_fe_f%bs_fe_f(:)%m%nx -1
      bs_ny(:) = ms_fe_f%bs_fe_f(:)%m%ny -1

      nnx = sum( bs_nx(1:ts_nx) )
      nny = sum( bs_ny(1:ts_ny) )
      if (nodal) then
         nnx = nnx +1
         nny = nny +1
      endif

      allocate( mat(1:nnx, 1:nny) ) ; mat = -1.

      c = 0
      if (nodal) c = 1
      do ey = 1, ts_ny
      do ex = 1, ts_nx
         e    = ts_nx*(ey -1) +ex
         ne_x = bs_nx(e)*(ex -1) +1
         ne_y = bs_ny(e)*(ey -1) +1
         mat( ne_x:( ne_x +bs_nx(e) -1 +c), &
              ne_y:( ne_y +bs_ny(e) -1 +c) ) = reshape( ms_fe_f%bs_fe_f(e)%vn(:, code), (/bs_nx(e) +c, bs_ny(e) +c/) )
      enddo
      enddo

      deallocate(bs_nx, bs_ny)
   return
   endsubroutine ms_fe_f_2_mat