Processing math: 100%

create_rect_x_ymesh Subroutine

public subroutine create_rect_x_ymesh(m)


Arguments

Type IntentOptional AttributesName
type(FE_MESH), intent(inout) :: m

FE mesh


Called by

proc~~create_rect_x_ymesh~~CalledByGraph proc~create_rect_x_ymesh create_rect_x_ymesh proc~create_rect_fe_film create_rect_FE_film proc~create_rect_fe_film->proc~create_rect_x_ymesh proc~multi_scale_create_rect_fe_film multi_scale_create_rect_fe_film proc~multi_scale_create_rect_fe_film->proc~create_rect_fe_film proc~init_fe_prob init_fe_prob proc~init_fe_prob->proc~create_rect_fe_film proc~test_rough_fe test_rough_fe proc~test_rough_fe->proc~init_fe_prob proc~init_ms_prob init_ms_prob proc~init_ms_prob->proc~multi_scale_create_rect_fe_film proc~test_bearing_x_fe test_bearing_x_fe proc~test_bearing_x_fe->proc~init_fe_prob proc~test_pocket_fe test_pocket_fe proc~test_pocket_fe->proc~init_fe_prob proc~test_bearing_y_fe test_bearing_y_fe proc~test_bearing_y_fe->proc~init_fe_prob proc~test_slider_fe test_slider_fe proc~test_slider_fe->proc~init_fe_prob proc~run_test run_test proc~run_test->proc~test_rough_fe proc~run_test->proc~test_bearing_x_fe proc~run_test->proc~test_pocket_fe proc~run_test->proc~test_bearing_y_fe proc~run_test->proc~test_slider_fe proc~test_rough_ms test_rough_ms proc~run_test->proc~test_rough_ms proc~test_slider_ms test_slider_ms proc~run_test->proc~test_slider_ms proc~test_rough_ms->proc~init_ms_prob proc~test_slider_ms->proc~init_ms_prob program~main main program~main->proc~run_test

Contents

Source Code


Source Code

   subroutine create_rect_x_ymesh(m)
   implicit none
   type(FE_MESH), intent(inout)   :: m  !! *FE mesh*
      integer(kind=I4) :: i, j, ind, inde
      real(kind=R8)    :: lx, ly, zx, zy
      integer(kind=I4) :: nx, ny

      lx = m%lx
      ly = m%ly
      zx = m%zx
      zy = m%zy
      nx = m%nx
      ny = m%ny

      ! mesh size definition
      ! number of nodes
      m%n = nx * ny
      ! number of elements
      m%ne = (nx - 1) * (ny - 1)
      ! nodes and elements table allocation
      allocate( m%x(m%n), m%y(m%n), m%z(m%n), m%con(m%ne, 4), m%el_t(m%ne), m%el_n(m%ne) )
      ! all the elements are qua_4
      m%el_t = 4 ! 4 nodes
      m%el_n = 4 ! number of different lines
      ! tables initialisation
      m%con = 0
      m%x   = 0._R8
      m%y   = 0._R8
      m%z   = 0._R8
      ! nodes coordinates
      do j = 1, ny
         do i = 1, nx
            ind =  (j - 1) * nx + i
            m%x(ind) = zx + lx * (i - 1) / (nx - 1)
            m%y(ind) = zy + ly * (j - 1) / (ny - 1)
         enddo
      enddo
      ! connectivity table
      do j = 1, ny - 1
         do i = 1, nx -1
            inde =  (j - 1) * (nx - 1) + i
            ind  =  (j - 1) * nx + i
            m%con(inde, 1) = ind
            m%con(inde, 2) = ind + 1
            m%con(inde, 3) = ind + 1 + nx
            m%con(inde, 4) = ind + nx
         enddo
      enddo
      !----
      ! edges definition
      ! number of edges
      m%ned = 4
      ! allocattion of the edges table
      allocate( m%ed(m%ned) )
      ! number of nodes and elements of each edge
      m%ed(1)%n  = nx
      m%ed(1)%ne = nx - 1
      m%ed(2)%n  = ny
      m%ed(2)%ne = ny - 1
      m%ed(3)%n  = nx
      m%ed(3)%ne = nx - 1
      m%ed(4)%n  = ny
      m%ed(4)%ne = ny - 1
      ! allocation of the edges nodes table
      do j = 1, m%ned
         allocate( m%ed(j)%nm(m%ed(j)%n) )
         m%ed(j)%nm = 0
      enddo
      ! nodes number of the edges from the 2D mesh
      do i = 1, nx
         m%ed(1)%nm(i) = i
         m%ed(3)%nm(i) = (ny -1 ) *nx + (nx - i + 1)
      enddo
      do j = 1, ny
         m%ed(2)%nm(j) = nx * j
         m%ed(4)%nm(j) = nx * (ny - j) + 1
      enddo
      ! edges connectivity table allocation and creation
      do j = 1, m%ned
         allocate (m%ed(j)%con(m%ed(j)%ne, 2))
         m%ed(j)%con=0
         do i = 1, m%ed(j)%ne
            m%ed(j)%con(i,1) = m%ed(j)%nm(i)
            m%ed(j)%con(i,2) = m%ed(j)%nm(i) + 1
         enddo
      enddo
      !----
      ! corners of the mesh
      ! number of corners ( = 4)
      m%nc = m%ned
      ! allocation of corner nodes table
      allocate(m%cor(m%nc))
      ! value of the corner nodes table
      do j = 1, m%nc
         m%cor(j) = m%ed(j)%nm(1)
      enddo

   return
   endsubroutine create_rect_x_ymesh