text: !-------------------------------------------------------------------------------
  ! Copyright (c) 2016 The University of Tokyo
  ! This software is released under the MIT License, see LICENSE.txt
  !-------------------------------------------------------------------------------
  !> \brief Adaptive Mesh Refinement
  
  !C
  !C***
  !C*** hecmw_adapt_NEW_CELL_341
  !C***
  !C
  !C    create new TET.
  !C
  subroutine hecmw_adapt_NEW_CELL_341 (hecMESH, icouN)
  
    use hecmw_util
    implicit real*8 (A-H,O-Z)
  
    dimension NDIV(6), NNTYP(0:11)
  
    integer(kind=kint)        :: PAR_CEL_TYP
    type (hecmwST_local_mesh) :: hecMESH
  
    !C
    !C +----------------+
    !C | embedding TET. |
    !C +----------------+
    !C===
    do i= 0, 11
      NNTYP(i)= 0
    enddo
  
    do icel0= 1, hecMESH%n_adapt_act_elem_341
      icel_par= hecMESH%adapt_act_elem_341(icel0)
      NPAR= icel_par
  
      if (hecMESH%elem_ID(2*icel_par).eq.hecMESH%my_rank) then
        inc= 1
      else
        inc= 0
      endif
  
      is= hecMESH%elem_node_index(icel_par-1)
      n1= hecMESH%elem_node_item (is+1)
      n2= hecMESH%elem_node_item (is+2)
      n3= hecMESH%elem_node_item (is+3)
      n4= hecMESH%elem_node_item (is+4)
      n5= 0
      n6= 0
      n7= 0
      n8= 0
      n9= 0
      n0= 0
  
      nnn= hecMESH%n_adapt_edge
      call hecmw_adapt_EDGE_INFO ( hecMESH, n1, n2, ie1, 1 )
      call hecmw_adapt_EDGE_INFO ( hecMESH, n1, n3, ie2, 1 )
      call hecmw_adapt_EDGE_INFO ( hecMESH, n1, n4, ie3, 1 )
      call hecmw_adapt_EDGE_INFO ( hecMESH, n2, n3, ie4, 1 )
      call hecmw_adapt_EDGE_INFO ( hecMESH, n2, n4, ie5, 1 )
      call hecmw_adapt_EDGE_INFO ( hecMESH, n3, n4, ie6, 1 )
  
      NDIV(1)= hecMESH%adapt_iemb(ie1)
      NDIV(2)= hecMESH%adapt_iemb(ie2)
      NDIV(3)= hecMESH%adapt_iemb(ie3)
      NDIV(4)= hecMESH%adapt_iemb(ie4)
      NDIV(5)= hecMESH%adapt_iemb(ie5)
      NDIV(6)= hecMESH%adapt_iemb(ie6)
  
      NDIVSUM= NDIV(1)+NDIV(2)+NDIV(3)+NDIV(4)+NDIV(5)+NDIV(6)
      PAR_CEL_TYP= hecMESH%elem_type(NPAR)
      !C
      !C-- init. CHILD. cell array
      is= hecMESH%adapt_children_index(NPAR-1)
      iS1= is + 1
      iS2= is + 2
      iS3= is + 3
      iS4= is + 4
      iS5= is + 5
      iS6= is + 6
      iS7= is + 7
      iS8= is + 8
  
      hecMESH%adapt_children_item(2*iS1)= -1
      hecMESH%adapt_children_item(2*iS2)= -1
      hecMESH%adapt_children_item(2*iS3)= -1
      hecMESH%adapt_children_item(2*iS4)= -1
      hecMESH%adapt_children_item(2*iS5)= -1
      hecMESH%adapt_children_item(2*iS6)= -1
      hecMESH%adapt_children_item(2*iS7)= -1
      hecMESH%adapt_children_item(2*iS8)= -1
  
      hecMESH%adapt_children_item(2*iS1-1)= 0
      hecMESH%adapt_children_item(2*iS2-1)= 0
      hecMESH%adapt_children_item(2*iS3-1)= 0
      hecMESH%adapt_children_item(2*iS4-1)= 0
      hecMESH%adapt_children_item(2*iS5-1)= 0
      hecMESH%adapt_children_item(2*iS6-1)= 0
      hecMESH%adapt_children_item(2*iS7-1)= 0
      hecMESH%adapt_children_item(2*iS8-1)= 0
  
      !C
      !C== embedding TYPE
      if (NDIVSUM.eq.0) NTYP= 0
      !C
      !C-- TYP-1
      if (NDIVSUM.eq.1 .and. NDIV(1).eq.1) then
        NTYP= 1
        n5  = hecMESH%adapt_IWK(ie1)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n5, n3, n4, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n2, n3, n4, 2)
      endif
      !C
      !C-- TYP-2
      if (NDIVSUM.eq.1 .and. NDIV(2).eq.1) then
        NTYP= 2
        n5  = hecMESH%adapt_IWK(ie2)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n2, n5, n4, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n2, n3, n4, 2)
      endif
      !C
      !C-- TYP-3
      if (NDIVSUM.eq.1 .and. NDIV(3).eq.1) then
        NTYP= 3
        n5  = hecMESH%adapt_IWK(ie3)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n2, n3, n5, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n2, n3, n4, 2)
      endif
      !C
      !C-- TYP-4
      if (NDIVSUM.eq.1 .and. NDIV(4).eq.1) then
        NTYP= 4
        n5  = hecMESH%adapt_IWK(ie4)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n2, n5, n4, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n5, n3, n4, 2)
      endif
      !C
      !C-- TYP-5
      if (NDIVSUM.eq.1 .and. NDIV(5).eq.1) then
        NTYP= 5
        n5  = hecMESH%adapt_IWK(ie5)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n2, n3, n5, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n5, n3, n4, 2)
      endif
      !C
      !C-- TYP-6
      if (NDIVSUM.eq.1 .and. NDIV(6).eq.1) then
        NTYP= 6
        n5  = hecMESH%adapt_IWK(ie6)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n2, n3, n5, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n2, n5, n4, 2)
      endif
      !C
      !C-- TYP-7
      if (NDIVSUM.eq.3 .and. NDIV(1).eq.1 .and.                       &
          &      NDIV(3).eq.1 .and. NDIV(5).eq.1) then
        NTYP= 7
        n5  = hecMESH%adapt_IWK(ie1)
        n6  = hecMESH%adapt_IWK(ie3)
        n7  = hecMESH%adapt_IWK(ie5)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n5, n3, n6, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n2, n3, n7, 2)
        call hecmw_adapt_CREATE_NEW_TETRA (n6, n7, n3, n4, 3)
        call hecmw_adapt_CREATE_NEW_TETRA (n6, n5, n3, n7, 4)
      endif
      !C
      !C-- TYP-8
      if (NDIVSUM.eq.3 .and. NDIV(2).eq.1 .and.                       &
          &      NDIV(3).eq.1 .and. NDIV(6).eq.1) then
        NTYP= 8
        n5  = hecMESH%adapt_IWK(ie2)
        n6  = hecMESH%adapt_IWK(ie3)
        n7  = hecMESH%adapt_IWK(ie6)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n2, n5, n6, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n2, n3, n7, 2)
        call hecmw_adapt_CREATE_NEW_TETRA (n6, n2, n7, n4, 3)
        call hecmw_adapt_CREATE_NEW_TETRA (n6, n2, n5, n7, 4)
      endif
      !C
      !C-- TYP-9
      if (NDIVSUM.eq.3 .and. NDIV(1).eq.1 .and.                       &
          &      NDIV(2).eq.1 .and. NDIV(4).eq.1) then
        NTYP= 9
        n5  = hecMESH%adapt_IWK(ie1)
        n6  = hecMESH%adapt_IWK(ie2)
        n7  = hecMESH%adapt_IWK(ie4)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n5, n6, n4, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n2, n7, n4, 2)
        call hecmw_adapt_CREATE_NEW_TETRA (n6, n7, n3, n4, 3)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n7, n6, n4, 4)
      endif
      !C
      !C-- TYP-10
      if (NDIVSUM.eq.3 .and. NDIV(4).eq.1 .and.                       &
          &      NDIV(5).eq.1 .and. NDIV(6).eq.1) then
        NTYP= 10
        n5  = hecMESH%adapt_IWK(ie4)
        n6  = hecMESH%adapt_IWK(ie5)
        n7  = hecMESH%adapt_IWK(ie6)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n2, n5, n6, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n5, n3, n7, 2)
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n6, n7, n4, 3)
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n5, n7, n6, 4)
      endif
      !C
      !C-- TYP-11
      if (NDIVSUM.eq.6) then
        NTYP= 11
        n5  = hecMESH%adapt_IWK(ie1)
        n6  = hecMESH%adapt_IWK(ie2)
        n7  = hecMESH%adapt_IWK(ie3)
        n8  = hecMESH%adapt_IWK(ie4)
        n9  = hecMESH%adapt_IWK(ie5)
        n0  = hecMESH%adapt_IWK(ie6)
  
        hecMESH%adapt_type(NPAR)= NTYP
        call hecmw_adapt_CREATE_NEW_TETRA (n1, n5, n6, n7, 1)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n2, n8, n9, 2)
        call hecmw_adapt_CREATE_NEW_TETRA (n6, n8, n3, n0, 3)
        call hecmw_adapt_CREATE_NEW_TETRA (n7, n9, n0, n4, 4)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n8, n6, n7, 5)
        call hecmw_adapt_CREATE_NEW_TETRA (n5, n8, n7, n9, 6)
        call hecmw_adapt_CREATE_NEW_TETRA (n0, n8, n7, n6, 7)
        call hecmw_adapt_CREATE_NEW_TETRA (n0, n8, n9, n7, 8)
      endif
      !C==
  
      !C
      !C-- TYPE of EMBEDDING
      NNTYP             (NTYP)= NNTYP(NTYP) + 1
    enddo
    !C===
  
    return
  
  contains
    subroutine hecmw_adapt_CREATE_NEW_TETRA (in1, in2, in3, in4, IDchi)
  
      hecMESH%n_adapt_elem_341_cur= hecMESH%n_adapt_elem_341_cur + 1
      hecMESH%n_adapt_elem_cur    = hecMESH%n_adapt_elem_cur     + 1
  
      icel = hecMESH%n_adapt_elem_cur
      icouN= icouN + inc
  
      if (icel.gt.hecMESH%ne_array) then
        call hecmw_adapt_ERROR_EXIT (hecMESH, 61)
      endif
  
      hecMESH%when_i_was_refined_elem(icel)= hecMESH%n_adapt
      hecMESH%elem_node_index(icel)= hecMESH%elem_node_index(icel-1) + 4
  
      is= hecMESH%elem_node_index(icel-1)
      hecMESH%elem_node_item(is+1)= in1
      hecMESH%elem_node_item(is+2)= in2
      hecMESH%elem_node_item(is+3)= in3
      hecMESH%elem_node_item(is+4)= in4
  
      hecMESH%adapt_parent(2*icel-1)= hecMESH%elem_ID(2*NPAR-1)
      hecMESH%adapt_parent(2*icel  )= hecMESH%elem_ID(2*NPAR  )
  
      hecMESH%elem_ID(2*icel-1)= icouN + hecMESH%ne_internal
      hecMESH%elem_ID(2*icel  )= hecMESH%elem_ID(2*NPAR  )
  
      hecMESH%elem_mat_ID_item(icel)= hecMESH%elem_mat_ID_item(NPAR)
      hecMESH%section_ID      (icel)= hecMESH%section_ID      (NPAR)
  
      hecMESH%adapt_type(icel)= 0
  
      if (NDIVSUM.eq.6) then
        hecMESH%adapt_level(icel)= hecMESH%adapt_level(NPAR) + 2
      else
        hecMESH%adapt_level(icel)= hecMESH%adapt_level(NPAR) + 1
      endif
  
      is= hecMESH%adapt_children_index(NPAR-1)
      hecMESH%adapt_children_item(2*(is+IDchi)-1)= icel
      hecMESH%adapt_children_item(2*(is+IDchi)-1)= icouN + hecMESH%ne_internal
      hecMESH%adapt_children_item(2*(is+IDchi)  )= hecMESH%my_rank
  
  
  
      hecMESH%adapt_children_local(is+IDchi)= icel
  
      is= hecMESH%adapt_children_index(icel-1)
      hecMESH%adapt_children_index(icel)= is + 8
  
      iS1= is + 1
      iS2= is + 2
      iS3= is + 3
      iS4= is + 4
      iS5= is + 5
      iS6= is + 6
      iS7= is + 7
      iS8= is + 8
  
      hecMESH%adapt_children_item(2*iS1)= -1
      hecMESH%adapt_children_item(2*iS2)= -1
      hecMESH%adapt_children_item(2*iS3)= -1
      hecMESH%adapt_children_item(2*iS4)= -1
      hecMESH%adapt_children_item(2*iS5)= -1
      hecMESH%adapt_children_item(2*iS6)= -1
      hecMESH%adapt_children_item(2*iS7)= -1
      hecMESH%adapt_children_item(2*iS8)= -1
  
      hecMESH%adapt_children_item(2*iS1-1)=  0
      hecMESH%adapt_children_item(2*iS2-1)=  0
      hecMESH%adapt_children_item(2*iS3-1)=  0
      hecMESH%adapt_children_item(2*iS4-1)=  0
      hecMESH%adapt_children_item(2*iS5-1)=  0
      hecMESH%adapt_children_item(2*iS6-1)=  0
      hecMESH%adapt_children_item(2*iS7-1)=  0
      hecMESH%adapt_children_item(2*iS8-1)=  0
  
      hecMESH%elem_type        (icel)= PAR_CEL_TYP
      hecMESH%adapt_parent_type(icel)= hecMESH%adapt_type(NPAR)
  
  
    end subroutine hecmw_adapt_CREATE_NEW_TETRA
  end subroutine hecmw_adapt_NEW_CELL_341
  
  
  
  