cell_mod.f90

Go to the documentation of this file.

module cell_mod

  use choral_constants
  use real_type
  use basic_tools

  implicit none
  private

  !       %----------------------------------------%
  !       |                                        |
  !       |          PUBLIC DATA                   |
  !       |                                        |
  !       %----------------------------------------%

  public :: cell_init     ! tested
  !!
  public :: cell_nbnodes, cell_nbvtx
  public :: cell_dim    , cell_name
  public :: cell_nbfc   , cell_fc_nbvtx
  public :: cell_fc_vtx , cell_geo
  public :: cell_nbed   , cell_ed_vtx
  public :: cell_to_gmsh, gmsh_to_cell
  public :: cell_coord  , cell_nbitf



  character(LEN=4), dimension(CELL_TOT_NB) :: cell_name

  integer, dimension(CELL_TOT_NB) :: cell_nbnodes=0

  integer, dimension(CELL_TOT_NB) :: cell_nbvtx  =0

  integer, dimension(CELL_TOT_NB) :: cell_nbed   =0

  integer, dimension(CELL_TOT_NB) :: cell_nbfc   =0

  integer, dimension(CELL_TOT_NB) :: cell_nbitf   =0

  integer, dimension(CELL_TOT_NB) :: cell_dim    =0

  integer, dimension(CELL_TOT_NB) :: cell_geo    =0

  integer, dimension(2,CELL_MAX_NBED,CELL_TOT_NB)::cell_ed_vtx=0

  integer, dimension(CELL_MAX_NBFC,CELL_TOT_NB) :: cell_fc_nbvtx =0


  integer, dimension(CELL_MAX_NBVTX,CELL_MAX_NBFC,CELL_TOT_NB)::cell_fc_vtx=0

  integer, dimension(CELL_TOT_NB) :: cell_to_gmsh = -1

  integer, dimension(:), allocatable :: gmsh_to_cell 

  type(r_2d), dimension(CELL_TOT_NB) :: cell_coord

  
contains

  
  subroutine cell_init(b)
    logical, intent(in) :: b

    if (b) write(*,*)"cell_mod        : cell_init"
    call def_cell()
    call def_cell_fc()
    call def_cell_ed_vtx()
    call def_gmsh_to_cell()
    call def_cell_coord()
    
  end subroutine cell_init

  subroutine def_cell()

    cell_name(cell_vtx  ) = 'VTX'
    cell_name(cell_edg  ) = 'EDG'
    cell_name(cell_edg_2) = 'EDG2'
    cell_name(cell_trg  ) = 'TRG'
    cell_name(cell_trg_2) = 'TRG2'
    cell_name(cell_tet  ) = 'TET'
    cell_name(cell_tet_2) = 'TET2'

    cell_nbnodes(cell_vtx  ) = 1
    cell_nbnodes(cell_edg  ) = 2
    cell_nbnodes(cell_edg_2) = 3
    cell_nbnodes(cell_trg  ) = 3
    cell_nbnodes(cell_trg_2) = 6
    cell_nbnodes(cell_tet  ) = 4
    cell_nbnodes(cell_tet_2) = 10

    if ( cell_max_nbnodes /= maxval(cell_nbnodes) ) &
         & call quit( 'cell_mod: def_CELL: 1' )

    cell_nbvtx(cell_vtx  ) = 1
    cell_nbvtx(cell_edg  ) = 2
    cell_nbvtx(cell_edg_2) = 2
    cell_nbvtx(cell_trg  ) = 3
    cell_nbvtx(cell_trg_2) = 3
    cell_nbvtx(cell_tet  ) = 4
    cell_nbvtx(cell_tet_2) = 4

    if (cell_max_nbvtx /= maxval(cell_nbvtx)) &
         & call quit( 'cell_mod: def_CELL: 2' )

    cell_nbed(cell_trg  ) = 3
    cell_nbed(cell_trg_2) = 3
    cell_nbed(cell_tet  ) = 6
    cell_nbed(cell_tet_2) = 6

    if (cell_max_nbed /= maxval(cell_nbed)) &
         & call quit( 'cell_mod: def_CELL: 3' )

    cell_nbfc(cell_tet  ) = 4
    cell_nbfc(cell_tet_2) = 4
    if (cell_max_nbfc /= maxval(cell_nbfc)) &
         & call quit( 'cell_mod: def_CELL: 4' )

    cell_nbitf(cell_vtx  ) = 0
    cell_nbitf(cell_edg  ) = 2
    cell_nbitf(cell_edg_2) = 2
    cell_nbitf(cell_trg  ) = 3
    cell_nbitf(cell_trg_2) = 3
    cell_nbitf(cell_tet  ) = 4
    cell_nbitf(cell_tet_2) = 4
    if (cell_max_nbitf /= maxval(cell_nbitf)) &
         & call quit( 'cell_mod: def_CELL: 5' )


    cell_dim(cell_vtx  ) = 0
    cell_dim(cell_edg  ) = 1
    cell_dim(cell_edg_2) = 1
    cell_dim(cell_trg  ) = 2
    cell_dim(cell_trg_2) = 2
    cell_dim(cell_tet  ) = 3
    cell_dim(cell_tet_2) = 3

    cell_geo(cell_vtx  ) = cell_vtx
    cell_geo(cell_edg  ) = cell_edg
    cell_geo(cell_edg_2) = cell_edg
    cell_geo(cell_trg  ) = cell_trg
    cell_geo(cell_trg_2) = cell_trg
    cell_geo(cell_tet  ) = cell_tet
    cell_geo(cell_tet_2) = cell_tet

  end subroutine def_cell

  subroutine def_cell_ed_vtx()

    integer :: c
    
    c = cell_trg
    cell_ed_vtx(:,1,c) = (/1,2/)
    cell_ed_vtx(:,2,c) = (/2,3/)
    cell_ed_vtx(:,3,c) = (/3,1/)

    cell_ed_vtx(:,:, cell_trg_2) = cell_ed_vtx(:,:, cell_trg)
    
    c = cell_tet
    cell_ed_vtx(:,1,c) = (/1,2/)
    cell_ed_vtx(:,2,c) = (/2,3/)
    cell_ed_vtx(:,3,c) = (/3,1/)
    cell_ed_vtx(:,4,c) = (/1,4/)
    cell_ed_vtx(:,5,c) = (/2,4/)
    cell_ed_vtx(:,6,c) = (/3,4/)
    
    c = cell_tet_2
    cell_ed_vtx(:,1,c) = (/1,2/)
    cell_ed_vtx(:,2,c) = (/2,3/)
    cell_ed_vtx(:,3,c) = (/3,1/)
    cell_ed_vtx(:,4,c) = (/1,4/)
    cell_ed_vtx(:,5,c) = (/2,4/)
    cell_ed_vtx(:,6,c) = (/3,4/)
    
  end subroutine def_cell_ed_vtx


  subroutine def_cell_fc()

    integer :: c
    
    c = cell_tet
    cell_fc_nbvtx(1:4, c) = 3

    c = cell_tet_2
    cell_fc_nbvtx(1:4, c) = 3

    if (cell_max_fc_nbvtx /= maxval(cell_fc_nbvtx)) &
         & call quit( 'cell_mod: def_CELL_FC' )

    c = cell_tet
    cell_fc_vtx(1:3,1,c) = (/1,2,3/)
    cell_fc_vtx(1:3,2,c) = (/1,2,4/)
    cell_fc_vtx(1:3,3,c) = (/2,3,4/)
    cell_fc_vtx(1:3,4,c) = (/3,1,4/)

    c = cell_tet_2
    cell_fc_vtx(1:3,1,c) = (/1,2,3/)
    cell_fc_vtx(1:3,2,c) = (/1,2,4/)
    cell_fc_vtx(1:3,3,c) = (/2,3,4/)
    cell_fc_vtx(1:3,4,c) = (/3,1,4/)

  end subroutine def_cell_fc

  subroutine def_gmsh_to_cell()

    integer :: ii, jj

    cell_to_gmsh(cell_vtx)   = 15
    cell_to_gmsh(cell_edg)   = 1
    cell_to_gmsh(cell_edg_2) = 8
    cell_to_gmsh(cell_trg)   = 2
    cell_to_gmsh(cell_trg_2) = 9
    cell_to_gmsh(cell_tet)   = 4
    cell_to_gmsh(cell_tet_2) = 11

    call allocmem( gmsh_to_cell, maxval(cell_to_gmsh) )

    gmsh_to_cell = -1
    do ii=1, cell_tot_nb

       jj = cell_to_gmsh(ii)
       gmsh_to_cell(jj) = ii

    end do

  end subroutine def_gmsh_to_cell

  
  subroutine def_cell_coord()

    integer :: ct

    do ct=1, cell_tot_nb
       cell_coord(ct) = r_2d( cell_dim(ct), cell_nbnodes(ct) ) 
       cell_coord(ct)%y = 0.0_rp       
    end do

    ct = cell_edg
    cell_coord(ct)%y(1, 2) = 1.0_rp

    ct = cell_trg
    cell_coord(ct)%y(1, 2) = 1.0_rp
    cell_coord(ct)%y(2, 3) = 1.0_rp

    ct = cell_tet
    cell_coord(ct)%y(1, 2) = 1.0_rp
    cell_coord(ct)%y(2, 3) = 1.0_rp
    cell_coord(ct)%y(3, 4) = 1.0_rp

    ct = cell_tet_2
    cell_coord(ct)%y(1, 2) = 1.0_rp
    cell_coord(ct)%y(2, 3) = 1.0_rp
    cell_coord(ct)%y(3, 4) = 1.0_rp

    cell_coord(ct)%y(  1, 5) = 0.5_rp
    cell_coord(ct)%y(1:2, 6) = 0.5_rp
    cell_coord(ct)%y(  2, 7) = 0.5_rp

    cell_coord(ct)%y(  3, 8:10) = 0.5_rp
    cell_coord(ct)%y(  2, 9   ) = 0.5_rp
    cell_coord(ct)%y(  1, 10  ) = 0.5_rp

    ct = cell_edg_2
    cell_coord(ct)%y(:, 1:2) = cell_coord(cell_edg)%y
    cell_coord(ct)%y(1, 3  ) = 0.5_rp

    ct = cell_trg_2
    cell_coord(ct)%y(:, 1:3) = cell_coord(cell_trg)%y
    cell_coord(ct)%y(:, 4  ) = (/ 0.5_rp, 0.0_rp /)
    cell_coord(ct)%y(:, 5  ) = (/ 0.5_rp, 0.5_rp /)
    cell_coord(ct)%y(:, 6  ) = (/ 0.0_rp, 0.5_rp /)

  end subroutine def_cell_coord

  
end module cell_mod