hecmw_adapt_new_mesh.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
 
!C
!C***
!C*** hecmw_adapt_new_mesh
!C***
!C
 
subroutine hecmw_adapt_new_mesh (hecMESH, hecMESHnew)
 
  use  hecmw_util
  type (hecmwST_local_mesh) :: hecMESH
  type (hecmwST_local_mesh) :: hecMESHnew
 
  integer(kind=kint), pointer :: WORKaI(:)
  real(kind=kreal),   pointer :: workar(:)
 
  !C
  !C-- START.
  if (hecmesh%my_rank.eq.3) write (*,'(/,a)') '#final mesh (n_node, nn_int, n_elem, ne_int)'
  call mpi_barrier (hecmesh%MPI_COMM, ierr)
 
  write (*,'(a,i5,4i8)') 'PE#', hecmesh%my_rank,                      &
    &                              hecmesh%n_node, hecmesh%nn_internal,  &
    &                              hecmesh%n_elem, hecmesh%ne_internal
 
  !C
  !C-- 1. ENTIRE INFO.
  hecmeshnew%hecmw_n_file= 0
  hecmeshnew%header              = hecmesh%header
  hecmeshnew%hecmw_flag_adapt    = hecmesh%hecmw_flag_adapt
  hecmeshnew%hecmw_flag_initcon  = hecmesh%hecmw_flag_initcon
  hecmeshnew%hecmw_flag_parttype = hecmesh%hecmw_flag_parttype
  hecmeshnew%hecmw_flag_partdepth= hecmesh%hecmw_flag_partdepth
  hecmeshnew%hecmw_flag_version  = hecmesh%hecmw_flag_version
  hecmeshnew%zero_temp           = hecmesh%zero_temp
  hecmeshnew%gridfile            = hecmesh%gridfile
  hecmeshnew%hecmw_n_file        = hecmesh%hecmw_n_file
 
  !C
  !C-- 2. NODE
  hecmeshnew%n_node     = hecmesh%n_node
  hecmeshnew%nn_internal= hecmesh%nn_internal
  hecmeshnew%n_dof      = 3
  hecmeshnew%n_dof_grp  = 1
 
  allocate (hecmeshnew%node   (3*hecmeshnew%n_node))
  allocate (hecmeshnew%node_ID(2*hecmeshnew%n_node))
  allocate (hecmeshnew%global_node_ID(hecmeshnew%n_node))
  hecmeshnew%global_node_ID= 1
 
  do i= 1, hecmeshnew%n_node
    in= hecmesh%adapt_OLDtoNEW_node(i)
    hecmeshnew%node(3*in-2)= hecmesh%node(3*i-2)
    hecmeshnew%node(3*in-1)= hecmesh%node(3*i-1)
    hecmeshnew%node(3*in  )= hecmesh%node(3*i  )
 
    hecmeshnew%node_ID(2*in-1)= hecmesh%node_ID(2*i-1)
    hecmeshnew%node_ID(2*in  )= hecmesh%node_ID(2*i  )
  enddo
 
  deallocate (hecmesh%node_ID, hecmesh%node, hecmesh%global_node_ID)
 
  allocate (hecmeshnew%node_dof_index(0:hecmeshnew%n_dof_grp))
  hecmeshnew%node_dof_index(0)= 0
  hecmeshnew%node_dof_index(1)= hecmeshnew%n_node
  allocate (hecmeshnew%node_dof_item(1))
  hecmeshnew%node_dof_item(1) =  3
 
  !C
  !C-- 3. ELEMENT
  hecmeshnew%n_elem     = hecmesh%n_elem
  hecmeshnew%ne_internal= hecmesh%ne_internal
  hecmeshnew%n_elem_type= hecmesh%n_elem_type
 
  hecmeshnew%n_elem_mat_ID= hecmesh%n_elem
 
  allocate (hecmeshnew%elem_type_index(0:hecmeshnew%n_elem_type))
  hecmeshnew%elem_type_index= hecmesh%elem_type_index
  allocate (hecmeshnew%elem_type_item(hecmeshnew%n_elem_type))
 
  hecmeshnew%elem_type_item = hecmesh%elem_type_item
  deallocate (hecmesh%elem_type_index, hecmesh%elem_type_item)
 
  allocate (hecmeshnew%elem_type        (hecmeshnew%n_elem))
  allocate (hecmeshnew%section_ID       (hecmeshnew%n_elem))
  allocate (hecmeshnew%elem_mat_ID_item (hecmeshnew%n_elem))
 
  do i= 1, hecmeshnew%n_elem
    in= hecmesh%adapt_OLDtoNEW_elem(i)
    hecmeshnew%elem_type       (in)= hecmesh%elem_type       (i)
    hecmeshnew%section_ID      (in)= hecmesh%section_ID      (i)
    hecmeshnew%elem_mat_ID_item(in)= hecmesh%elem_mat_ID_item(i)
  enddo
 
  allocate (hecmeshnew%elem_mat_ID_index (0:hecmeshnew%n_elem))
  hecmeshnew%elem_mat_ID_index= 0
  do i= 1, hecmeshnew%n_elem
    hecmeshnew%elem_mat_ID_index(i)= i
  enddo
 
  deallocate (hecmesh%elem_type, hecmesh%section_ID)
  deallocate (hecmesh%elem_mat_ID_index)
  deallocate (hecmesh%elem_mat_ID_item )
 
  nnn= hecmesh%elem_node_index(hecmesh%n_elem)
  allocate (hecmeshnew%elem_node_index(0:hecmeshnew%n_elem))
  allocate (hecmeshnew%elem_node_item (nnn))
  hecmeshnew%elem_node_index= 0
  hecmeshnew%elem_node_item = 0
  do i= 1, hecmeshnew%n_elem
    in= hecmesh%adapt_OLDtoNEW_elem(i)
    hecmeshnew%elem_node_index(in)= hecmesh%elem_node_index(i) - hecmesh%elem_node_index(i-1)
  enddo
 
  do i= 1, hecmeshnew%n_elem
    hecmeshnew%elem_node_index(i)= hecmeshnew%elem_node_index(i-1) + hecmeshnew%elem_node_index(i)
  enddo
 
  do i= 1, hecmeshnew%n_elem
    in = hecmesh%adapt_OLDtoNEW_elem(i)
    is = hecmesh%elem_node_index(i-1)
    ie = hecmesh%elem_node_index(i  )
    is0= hecmeshnew%elem_node_index(in-1)
    do k= is+1, ie
      kk= k - is + is0
      nodk= hecmesh%adapt_OLDtoNEW_node(hecmesh%elem_node_item(k))
      hecmeshnew%elem_node_item(kk)= nodk
    enddo
  enddo
  deallocate (hecmesh%elem_node_index, hecmesh%elem_node_item)
 
  allocate (hecmeshnew%elem_ID(2*hecmeshnew%n_elem))
  do i= 1, hecmeshnew%n_elem
    in = hecmesh%adapt_OLDtoNEW_elem(i)
    hecmeshnew%elem_ID(2*in-1)= hecmesh%elem_ID(2*i-1)
    hecmeshnew%elem_ID(2*in  )= hecmesh%elem_ID(2*i  )
  enddo
  deallocate (hecmesh%elem_ID)
  allocate (hecmeshnew%global_elem_ID(hecmeshnew%n_elem))
  hecmeshnew%global_elem_ID= 1
  deallocate (hecmesh%global_elem_ID)
  allocate (hecmeshnew%elem_internal_list(hecmeshnew%ne_internal))
  do i= 1, hecmesh%ne_internal
    icel= hecmesh%elem_internal_list (i)
    in  = hecmesh%adapt_OLDtoNEW_elem(icel)
    hecmeshnew%elem_internal_list(i)= in
  enddo
  deallocate (hecmesh%elem_internal_list)
 
  !C
  !C-- 5. COMMUNICATION
  hecmeshnew%my_rank = hecmesh%my_rank
  hecmeshnew%zero    = hecmesh%zero
  hecmeshnew%PETOT   = hecmesh%PETOT
  hecmeshnew%PEsmpTOT= hecmesh%PEsmpTOT
 
  hecmeshnew%errnof  = hecmesh%errnof
 
  call mpi_comm_dup (hecmesh%MPI_COMM, hecmeshnew%MPI_COMM, ierr)
 
  hecmeshnew%n_subdomain  = hecmesh%n_subdomain
  hecmeshnew%n_neighbor_pe= hecmesh%n_neighbor_pe
 
  allocate (hecmeshnew%neighbor_pe(hecmeshnew%n_neighbor_pe))
  hecmeshnew%neighbor_pe= hecmesh%neighbor_pe
 
  nn1= hecmesh%adapt_import_new_index(hecmesh%n_neighbor_pe)
  nn2= hecmesh%adapt_export_new_index(hecmesh%n_neighbor_pe)
 
  allocate (hecmeshnew%import_index(0:hecmeshnew%n_neighbor_pe), hecmeshnew%import_item(nn1))
  allocate (hecmeshnew%export_index(0:hecmeshnew%n_neighbor_pe), hecmeshnew%export_item(nn2))
 
  hecmeshnew%import_index= 0
  hecmeshnew%export_index= 0
 
  do i= 1, hecmeshnew%n_neighbor_pe
    hecmeshnew%import_index(i)= hecmesh%adapt_import_new_index(i)
    hecmeshnew%export_index(i)= hecmesh%adapt_export_new_index(i)
  enddo
 
  do i= 1, nn1
    hecmeshnew%import_item(i) = hecmesh%adapt_import_new_item(i)
  enddo
 
  do i= 1, nn2
    hecmeshnew%export_item(i) = hecmesh%adapt_export_new_item(i)
  enddo
 
  allocate (hecmeshnew%shared_index(0:hecmeshnew%n_neighbor_pe))
  hecmeshnew%shared_index= 0
 
  !C
  !C-- 6. GRID ADAPTATION
  hecmeshnew%coarse_grid_level= hecmesh%coarse_grid_level
  hecmeshnew%n_adapt          = hecmesh%n_adapt
 
  allocate (hecmeshnew%when_i_was_refined_node(hecmeshnew%n_node))
  allocate (hecmeshnew%when_i_was_refined_elem(hecmeshnew%n_elem))
  allocate (hecmeshnew%adapt_parent_type(hecmeshnew%n_elem))
  allocate (hecmeshnew%adapt_type       (hecmeshnew%n_elem))
  allocate (hecmeshnew%adapt_level      (hecmeshnew%n_elem))
  allocate (hecmeshnew%adapt_parent     (hecmeshnew%n_elem*2))
  allocate (hecmeshnew%adapt_children_index (0: hecmeshnew%n_elem))
  allocate (hecmeshnew%adapt_children_item  (16*hecmeshnew%n_elem))
 
  do i= 1, hecmeshnew%n_node
    in= hecmesh%adapt_OLDtoNEW_node(i)
    hecmeshnew%when_i_was_refined_node(in)= hecmesh%when_i_was_refined_node(i)
  enddo
 
  hecmeshnew%adapt_children_index= 0
  hecmeshnew%adapt_children_item = 0
  do i= 1, hecmeshnew%n_elem
    in= hecmesh%adapt_OLDtoNEW_elem(i)
    hecmeshnew%when_i_was_refined_elem(in)= hecmesh%when_i_was_refined_elem(i)
    hecmeshnew%adapt_parent_type(in)= hecmesh%adapt_parent_type(i)
    hecmeshnew%adapt_type       (in)= hecmesh%adapt_type       (i)
    hecmeshnew%adapt_level      (in)= hecmesh%adapt_level      (i)
 
    hecmeshnew%adapt_parent(2*in-1)= hecmesh%adapt_parent(2*i-1)
    hecmeshnew%adapt_parent(2*in  )= hecmesh%adapt_parent(2*i  )
 
    hecmeshnew%adapt_children_index(i)= hecmeshnew%adapt_children_index(i-1) + 8
 
    isorg= (i -1)*16
    isnew= (in-1)*16
    do kk= 1, 16
      hecmeshnew%adapt_children_item(isnew+kk)= hecmesh%adapt_children_item(isorg+kk)
    enddo
  enddo
 
  deallocate (hecmesh%when_i_was_refined_node)
  deallocate (hecmesh%when_i_was_refined_elem)
  deallocate (hecmesh%adapt_type, hecmesh%adapt_parent_type, hecmesh%adapt_parent, hecmesh%adapt_level)
  deallocate (hecmesh%adapt_children_index, hecmesh%adapt_children_item)
 
  !C
  !C-- 7. SECTION
  hecmeshnew%section%n_sect= hecmesh%section%n_sect
 
  allocate (hecmeshnew%section%sect_type(hecmeshnew%section%n_sect))
  allocate (hecmeshnew%section%sect_opt (hecmeshnew%section%n_sect))
  hecmeshnew%section%sect_type= hecmesh%section%sect_type
  hecmeshnew%section%sect_opt = hecmesh%section%sect_opt
 
  nnn= hecmesh%section%sect_mat_ID_index(hecmesh%section%n_sect)
  allocate (hecmeshnew%section%sect_mat_ID_index(0:hecmeshnew%section%n_sect))
  allocate (hecmeshnew%section%sect_mat_ID_item (nnn))
  hecmeshnew%section%sect_mat_ID_index= hecmesh%section%sect_mat_ID_index
  hecmeshnew%section%sect_mat_ID_item = hecmesh%section%sect_mat_ID_item
 
  allocate (hecmeshnew%section%sect_I_index(0:hecmeshnew%section%n_sect))
  allocate (hecmeshnew%section%sect_R_index(0:hecmeshnew%section%n_sect))
  hecmeshnew%section%sect_I_index= 0
  hecmeshnew%section%sect_R_index= 0
 
  !C
  !C-- 8. MATERIAL
  hecmeshnew%material%n_mat        = hecmesh%material%n_mat
  hecmeshnew%material%n_mat_item   = hecmesh%material%n_mat_item
  hecmeshnew%material%n_mat_subitem= hecmesh%material%n_mat_subitem
  hecmeshnew%material%n_mat_table  = hecmesh%material%n_mat_table
 
  n_mat    = hecmeshnew%material%n_mat
  n_item   = hecmeshnew%material%n_mat_item
  n_subitem= hecmeshnew%material%n_mat_subitem
  nnn      = hecmesh%material%mat_table_index(n_subitem)
 
  allocate (hecmeshnew%material%mat_name(n_mat))
  hecmeshnew%material%mat_name= hecmesh%material%mat_name
 
  allocate (hecmeshnew%material%mat_item_index   (0:n_mat))
  allocate (hecmeshnew%material%mat_subitem_index(0:n_item))
  allocate (hecmeshnew%material%mat_table_index  (0:n_subitem))
  hecmeshnew%material%mat_item_index   = hecmesh%material%mat_item_index
  hecmeshnew%material%mat_subitem_index= hecmesh%material%mat_subitem_index
  hecmeshnew%material%mat_table_index  = hecmesh%material%mat_table_index
 
  allocate (hecmeshnew%material%mat_val(nnn), hecmeshnew%material%mat_temp(nnn))
  hecmeshnew%material%mat_val = hecmesh%material%mat_val
  hecmeshnew%material%mat_temp= hecmesh%material%mat_temp
 
  !C
  !C-- 9. MPC/AMPLITUDE
  hecmeshnew%mpc%n_mpc= hecmesh%mpc%n_mpc
  if (hecmesh%mpc%n_mpc.ne.0) then
    nnn= hecmesh%mpc%mpc_index(hecmesh%mpc%n_mpc)
    allocate (hecmeshnew%mpc%mpc_index(0:hecmeshnew%mpc%n_mpc))
    allocate (hecmeshnew%mpc%mpc_item (nnn))
    allocate (hecmeshnew%mpc%mpc_dof  (nnn))
    allocate (hecmeshnew%mpc%mpc_val  (nnn))
    hecmeshnew%mpc%mpc_index= hecmesh%mpc%mpc_index
    hecmeshnew%mpc%mpc_item = hecmesh%mpc%mpc_item
    hecmeshnew%mpc%mpc_dof  = hecmesh%mpc%mpc_dof
    hecmeshnew%mpc%mpc_val  = hecmesh%mpc%mpc_val
  endif
 
  hecmeshnew%amp%n_amp= 0
  if (hecmesh%amp%n_amp.ne.0) then
    nnn= hecmesh%amp%amp_index(hecmesh%amp%n_amp)
    allocate (hecmeshnew%amp%amp_type_definition(hecmeshnew%amp%n_amp))
    allocate (hecmeshnew%amp%amp_type_time      (hecmeshnew%amp%n_amp))
    allocate (hecmeshnew%amp%amp_type_value     (hecmeshnew%amp%n_amp))
    allocate (hecmeshnew%amp%amp_index(0:hecmeshnew%amp%n_amp))
    allocate (hecmeshnew%amp%amp_val  (nnn))
    allocate (hecmeshnew%amp%amp_table(nnn))
    hecmeshnew%amp%amp_type_definition= hecmesh%amp%amp_type_definition
    hecmeshnew%amp%amp_type_time      = hecmesh%amp%amp_type_time
    hecmeshnew%amp%amp_type_value     = hecmesh%amp%amp_type_value
    hecmeshnew%amp%amp_index          = hecmesh%amp%amp_index
    hecmeshnew%amp%amp_val            = hecmesh%amp%amp_val
    hecmeshnew%amp%amp_table          = hecmesh%amp%amp_table
  endif
 
  !C
  !C-- 10. NODE-GROUP
  n_grp  = hecmesh%node_group%n_grp
 
  if (n_grp.ne.0) then
    n_array= hecmesh%node_group%grp_index(n_grp)
    hecmeshnew%node_group%n_grp= hecmesh%node_group%n_grp
 
    allocate (hecmeshnew%node_group%grp_name (  n_grp))
    allocate (hecmeshnew%node_group%grp_index(0:n_grp))
    allocate (hecmeshnew%node_group%grp_item (n_array))
 
    hecmeshnew%node_group%grp_name = hecmesh%node_group%grp_name
    hecmeshnew%node_group%grp_index= hecmesh%node_group%grp_index
 
    do i= 1, n_array
      in0= hecmesh%node_group%grp_item(i)
      hecmeshnew%node_group%grp_item(i)= hecmesh%adapt_OLDtoNEW_node(in0)
    enddo
  endif
 
  !C
  !C-- 11. ELEM-GROUP
  n_grp  = hecmesh%elem_group%n_grp
 
  if (n_grp.ne.0) then
    n_array= hecmesh%elem_group%grp_index(n_grp)
    hecmeshnew%elem_group%n_grp= hecmesh%elem_group%n_grp
 
    allocate (hecmeshnew%elem_group%grp_name (  n_grp))
    allocate (hecmeshnew%elem_group%grp_index(0:n_grp))
    allocate (hecmeshnew%elem_group%grp_item (n_array))
 
    hecmeshnew%elem_group%grp_name = hecmesh%elem_group%grp_name
    hecmeshnew%elem_group%grp_index= hecmesh%elem_group%grp_index
 
    do i= 1, n_array
      in0= hecmesh%elem_group%grp_item(i)
      hecmeshnew%elem_group%grp_item(i)= hecmesh%adapt_OLDtoNEW_elem(in0)
    enddo
  endif
 
  !C
  !C-- 11. SURF-GROUP
  n_grp  = hecmesh%surf_group%n_grp
 
  if (n_grp.ne.0) then
    n_array= hecmesh%surf_group%grp_index(n_grp)
    hecmeshnew%surf_group%n_grp= hecmesh%surf_group%n_grp
 
    allocate (hecmeshnew%surf_group%grp_name (  n_grp))
    allocate (hecmeshnew%surf_group%grp_index(0:n_grp))
    allocate (hecmeshnew%surf_group%grp_item (2*n_array))
 
    hecmeshnew%surf_group%grp_name = hecmesh%surf_group%grp_name
    hecmeshnew%surf_group%grp_index= hecmesh%surf_group%grp_index
 
    do i= 1, n_array
      in0 = hecmesh%surf_group%grp_item(2*i-1)
      isuf= hecmesh%surf_group%grp_item(2*i  )
      hecmeshnew%surf_group%grp_item(2*i-1)= hecmesh%adapt_OLDtoNEW_elem(in0)
      hecmeshnew%surf_group%grp_item(2*i  )= isuf
    enddo
  endif
 
end subroutine hecmw_adapt_new_mesh