hecmw_api_local_mesh.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2026 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
 
module hecmw_api_local_mesh
  use iso_c_binding
  use hecmw_util, only : hecmwst_local_mesh
  implicit none
 
contains
 
  function hecmw_api_mesh_new() bind(C,name='hecmw_api_mesh_new')
    use hecmw_util, only : hecmw_nullify_mesh
    implicit none
    type(c_ptr) :: hecmw_api_mesh_new
    type(hecmwst_local_mesh), target, save :: hecmesh
    call hecmw_nullify_mesh(hecmesh)
    allocate( hecmesh%node_group%grp_index(0:0) )
    hecmesh%node_group%grp_index(0) = 0
    allocate( hecmesh%surf_group%grp_index(0:0) )
    hecmesh%surf_group%grp_index(0) = 0
    allocate( hecmesh%elem_group%grp_index(0:0) )
    hecmesh%elem_group%grp_index(0) = 0
    hecmw_api_mesh_new = c_loc(hecmesh)
  end function
 
  subroutine hecmw_api_mesh_delete(mesh) bind(C,name='hecmw_api_mesh_delete')
    use hecmw_dist_free_f, only : hecmw_dist_free
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecMESH
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    call hecmw_dist_free(hecmesh)
  end subroutine
 
  subroutine hecmw_api_mesh_set_node(mesh,nnode,node) bind(C,name='hecmw_api_mesh_set_node')
    implicit none
    type(c_ptr), value :: mesh
    integer(c_int), value, intent(in) :: nnode
    real(c_double), intent(in) :: node(3*nnode)
 
    integer :: i
    type(hecmwst_local_mesh), pointer :: hecMESH
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
 
    hecmesh%n_node = nnode
    hecmesh%n_node_gross = nnode
    hecmesh%nn_middle = nnode
    hecmesh%nn_internal = nnode
    allocate(hecmesh%node(3*nnode))
    allocate(hecmesh%node_ID(2*nnode))
    allocate(hecmesh%node_internal_list(nnode))
    allocate(hecmesh%global_node_ID(nnode))
 
    do i=1, nnode
      hecmesh%node_internal_list(i) = i
      hecmesh%node_ID(2*i-1) = i
      hecmesh%node_ID(2*i) = 0
      hecmesh%global_node_ID(i) = i
      hecmesh%node(3*i-2) = node(3*i-2)
      hecmesh%node(3*i-1) = node(3*i-1)
      hecmesh%node(3*i-0) = node(3*i-0)
    enddo
 
  end subroutine
 
  function hecmw_api_mesh_n_node(mesh) bind(C,name='hecmw_api_mesh_n_node')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    integer(c_int) hecmw_api_mesh_n_node
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_n_node = hecmesh%n_node
  end function
 
  function hecmw_api_mesh_get_node(mesh) bind(C,name='hecmw_api_mesh_get_node')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    type(c_ptr) :: hecmw_api_mesh_get_node
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_get_node = c_loc(hecmesh%node)
  end function
 
  subroutine hecmw_api_mesh_set_n_dof(mesh,ndof) bind(C,name='hecmw_api_mesh_set_n_dof')
    implicit none
    type(c_ptr), value :: mesh
    integer(c_int), value, intent(in) :: ndof
    type(hecmwst_local_mesh), pointer :: hecMESH
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmesh%n_dof = ndof
  end subroutine
 
  function hecmw_api_mesh_get_n_dof(mesh) bind(C,name='hecmw_api_mesh_get_n_dof')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    integer(c_int) :: hecmw_api_mesh_get_n_dof
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_get_n_dof = hecmesh%n_dof
  end function
 
  subroutine hecmw_api_mesh_set_element(mesh,nelem,elemtype,element,sectionID) bind(C,name='hecmw_api_mesh_set_element')
    use hecmw_etype, only : hecmw_get_max_node
    implicit none
    type(c_ptr), value                :: mesh
    integer(c_int), value, intent(in) :: nelem
    integer(c_int), intent(in)        :: element(*)
    integer(c_int), intent(in)        :: elemtype(nelem)
    integer(c_int), intent(in)        :: sectionID(nelem)
 
    type(hecmwst_local_mesh), pointer :: hecMESH
    integer :: i, j, ncon, n, ii, jj, off
    integer, parameter :: etypes(35) = [ &
      111, 112, &
      231, 232, 2322, 241, 242, &
      301, 341, 3414, 342, 3422, 351, 352, 361, 362, 363, &
      511, &
      611, 612, 641, &
      732, 733, 731, 741, 742, 743, 761, 781, &
      881, 891, &
      1031, 1032, 1041, 1042 &
    ]
    integer :: etype_counter(35)
 
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
 
    hecmesh%n_elem = nelem
    hecmesh%n_elem_gross = nelem
    hecmesh%ne_internal = nelem
    allocate(hecmesh%elem_internal_list(nelem))
    allocate(hecmesh%elem_ID(2*nelem))
    allocate(hecmesh%global_elem_ID(nelem))
    allocate(hecmesh%elem_node_index(0:nelem))
    allocate(hecmesh%elem_type(nelem))
    allocate(hecmesh%section_ID(nelem))
 
    ! 要素の型ごとの個数を調べる
    etype_counter(:) = 0
    do i=1, nelem
      do j=1, 35
        if (elemtype(i) == etypes(j)) then
          etype_counter(j) = etype_counter(j) + 1
        end if
      end do
    end do
    ! 存在する型は何種類あるか
    n = 0
    do j=1, 35
      if (etype_counter(j) > 0) then
        n = n + 1
      end if
    end do
 
    hecmesh%n_elem_type = n
    allocate(hecmesh%elem_type_index(0:n))
    allocate(hecmesh%elem_type_item(n))
 
    ! 型ごとに要素がいくつあるかを記録
    i = 1
    n = 0
    hecmesh%elem_type_index(0) = n
    do j=1, 35
      if (etype_counter(j) > 0) then
        n = n + etype_counter(j)
        hecmesh%elem_type_item(i) = etypes(j)
        hecmesh%elem_type_index(i) = n
        i = i + 1
      end if
    end do
 
    ! elem_node_item の個数を調べる
    ncon = 0
    do i=1, nelem
      n = hecmw_get_max_node(elemtype(i))
      ncon = ncon + n
    end do
    allocate(hecmesh%elem_node_item(ncon))
 
    ! 要素の型ごとに並び替えて代入
    ncon = 0 ! elem_node_item　のオフセット
    hecmesh%elem_node_index(0) = ncon
    ii = 0
    do j=1, 35
      if (etype_counter(j) == 0) continue
      n = hecmw_get_max_node(etypes(j))
      off = 0 ! 入力配列のオフセット
      do i=1, nelem
        if (elemtype(i)==etypes(j)) then
          hecmesh%elem_node_item(ncon+1:ncon+n) = element(off+1:off+n)
          ncon = ncon + n
          ii = ii + 1
          hecmesh%elem_node_index(ii)    = ncon
          hecmesh%elem_ID(2*ii-1)        = i
          hecmesh%elem_ID(2*ii)          = 0
          hecmesh%global_elem_ID(ii)     = i
          hecmesh%elem_internal_list(ii) = i
          hecmesh%elem_type(ii)          = elemtype(i)
          hecmesh%section_ID(ii)         = sectionid(i)
        end if
        off = off + hecmw_get_max_node(elemtype(i))
      end do
    end do
 
    ! n_sect を調べる
    hecmesh%section%n_sect = 0
    do i=1, nelem
      if (hecmesh%section%n_sect < hecmesh%section_ID(i)) then
        hecmesh%section%n_sect = hecmesh%section_ID(i)
      end if
    end do
 
  end subroutine
 
  function hecmw_api_mesh_get_elem_type(mesh) bind(C,name='hecmw_api_mesh_get_elem_type')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    type(c_ptr) :: hecmw_api_mesh_get_elem_type
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_get_elem_type = c_loc(hecmesh%elem_type(1))
  end function
 
  function hecmw_api_mesh_get_elem_node_item(mesh) bind(C,name='hecmw_api_mesh_get_elem_node_item')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    type(c_ptr) :: hecmw_api_mesh_get_elem_node_item
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_get_elem_node_item = c_loc(hecmesh%elem_node_item(1))
  end function
 
  function hecmw_api_mesh_get_section_id(mesh) bind(C,name='hecmw_api_mesh_get_section_id')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    type(c_ptr) :: hecmw_api_mesh_get_section_id
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_get_section_id = c_loc(hecmesh%section_ID(1))
  end function
 
  function hecmw_api_mesh_n_elem(mesh) bind(C,name='hecmw_api_mesh_n_elem')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    integer(c_int) hecmw_api_mesh_n_elem
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_n_elem = hecmesh%n_elem
  end function
 
  function hecmw_api_mesh_n_elem_node_item(mesh) bind(C,name='hecmw_api_mesh_n_elem_node_item')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    integer(c_int) hecmw_api_mesh_n_elem_node_item
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_n_elem_node_item = hecmesh%elem_node_index(hecmesh%n_elem)
  end function
 
  function hecmw_api_mesh_n_ngrp(mesh) bind(C,name='hecmw_api_mesh_n_ngrp')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    integer(c_int) hecmw_api_mesh_n_ngrp
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_n_ngrp = hecmesh%node_group%n_grp
  end function
 
  subroutine hecmw_api_mesh_append_ngrp(mesh,grp_name,count,list) bind(C,name='hecmw_api_mesh_append_ngrp')
    use hecmw_api_common, only : c_f_str_copy
    use hecmw_util, only : hecmw_name_len
    use hecmw, only: kint
    use hecmw_setup_util, only : append_new_group 
    implicit none
    type(c_ptr), value, intent(in) :: mesh
    type(c_ptr), value, intent(in) :: grp_name
    integer(c_int), value, intent(in) :: count
    integer(c_int), intent(in) :: list(count)
    type(hecmwst_local_mesh), pointer :: hecMESH
    character(kind=c_char), pointer :: char_array(:) => null()
    character(len=HECMW_NAME_LEN) :: grp_name_f
    integer(kind=kint) :: grp_id
 
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    call c_f_pointer(grp_name, char_array, [hecmw_name_len])
    call c_f_str_copy(char_array, grp_name_f, hecmw_name_len)
    call append_new_group(hecmesh, 'node_grp', grp_name_f, count, list, grp_id)
  end subroutine
 
  subroutine hecmw_api_mesh_get_ngrp_name(mesh,i,buf,buflen) bind(C,name='hecmw_api_mesh_get_ngrp_name')
    use hecmw_api_common, only : f_c_str_copy
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecMESH
    integer(c_int), value, intent(in) :: i
    character(kind=c_char), intent(inout) :: buf(*)
    integer(c_int), value, intent(in) :: buflen
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    call f_c_str_copy(hecmesh%node_group%grp_name(i),buf,buflen)
  end subroutine
 
  subroutine hecmw_api_mesh_get_ngrp(mesh,i,array,count) bind(C,name='hecmw_api_mesh_get_ngrp')
    implicit none
    type(c_ptr), value :: mesh
    integer(c_int), value, intent(in) :: i
    type(c_ptr), intent(out) :: array
    integer(c_int), intent(out) :: count
    type(hecmwst_local_mesh), pointer :: hecMESH
    integer :: is, ie
 
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    is = hecmesh%node_group%grp_index(i-1)+1
    ie = hecmesh%node_group%grp_index(i)
    array = c_loc(hecmesh%node_group%grp_item(is))
    count = ie - is + 1
  end subroutine
 
  function hecmw_api_mesh_n_sgrp(mesh) bind(C,name='hecmw_api_mesh_n_sgrp')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    integer(c_int) hecmw_api_mesh_n_sgrp
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_n_sgrp = hecmesh%surf_group%n_grp
  end function
 
  subroutine hecmw_api_mesh_append_sgrp(mesh,grp_name,count,list) bind(C,name='hecmw_api_mesh_append_sgrp')
    use hecmw_api_common, only : c_f_str_copy
    use hecmw_util, only : hecmw_name_len
    use hecmw, only: kint
    use hecmw_setup_util, only : append_new_group 
    implicit none
    type(c_ptr), value, intent(in) :: mesh
    type(c_ptr), value, intent(in) :: grp_name
    integer(c_int), value, intent(in) :: count
    integer(c_int), intent(in) :: list(count)
    type(hecmwst_local_mesh), pointer :: hecMESH
    character(kind=c_char), pointer :: char_array(:) => null()
    character(len=HECMW_NAME_LEN) :: grp_name_f
    integer(kind=kint) :: grp_id
 
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    call c_f_pointer(grp_name, char_array, [hecmw_name_len])
    call c_f_str_copy(char_array, grp_name_f, hecmw_name_len)
 
    call append_new_group(hecmesh, 'surf_grp', grp_name_f, count, list, grp_id)
  end subroutine
 
  subroutine hecmw_api_mesh_get_sgrp_name(mesh,i,buf,buflen) bind(C,name='hecmw_api_mesh_get_sgrp_name')
    use hecmw_api_common, only : f_c_str_copy
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecMESH
    integer(c_int), value, intent(in) :: i
    character(kind=c_char), intent(inout) :: buf(*)
    integer(c_int), value, intent(in) :: buflen
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    call f_c_str_copy(hecmesh%surf_group%grp_name(i),buf,buflen)
  end subroutine
 
  subroutine hecmw_api_mesh_get_sgrp(mesh,i,array,count) bind(C,name='hecmw_api_mesh_get_sgrp')
    implicit none
    type(c_ptr), value :: mesh
    integer(c_int), value, intent(in) :: i
    type(c_ptr), intent(out) :: array
    integer(c_int), intent(out) :: count
    type(hecmwst_local_mesh), pointer :: hecMESH
    integer :: is, ie
 
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    is = hecmesh%surf_group%grp_index(i-1)+1
    ie = hecmesh%surf_group%grp_index(i)
    array = c_loc(hecmesh%surf_group%grp_item(is))
    count = ie - is + 1
  end subroutine
 
  function hecmw_api_mesh_n_egrp(mesh) bind(C,name='hecmw_api_mesh_n_egrp')
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecmesh
    integer(c_int) hecmw_api_mesh_n_egrp
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    hecmw_api_mesh_n_egrp = hecmesh%elem_group%n_grp
  end function
 
  subroutine hecmw_api_mesh_append_egrp(mesh,grp_name,count,list) bind(C,name='hecmw_api_mesh_append_egrp')
    use hecmw_api_common, only : c_f_str_copy
    use hecmw_util, only : hecmw_name_len
    use hecmw, only: kint
    use hecmw_setup_util, only : append_new_group 
    implicit none
    type(c_ptr), value, intent(in) :: mesh
    type(c_ptr), value, intent(in) :: grp_name
    integer(c_int), value, intent(in) :: count
    integer(c_int), intent(in) :: list(count)
    type(hecmwst_local_mesh), pointer :: hecMESH
    character(kind=c_char), pointer :: char_array(:) => null()
    character(len=HECMW_NAME_LEN) :: grp_name_f
    integer(kind=kint) :: grp_id
 
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    call c_f_pointer(grp_name, char_array, [hecmw_name_len])
    call c_f_str_copy(char_array, grp_name_f, hecmw_name_len)
 
    call append_new_group(hecmesh, 'elem_grp', grp_name_f, count, list, grp_id)
  end subroutine
 
  subroutine hecmw_api_mesh_get_egrp_name(mesh,i,buf,buflen) bind(C,name='hecmw_api_mesh_get_egrp_name')
    use hecmw_api_common, only : f_c_str_copy
    implicit none
    type(c_ptr), value :: mesh
    type(hecmwst_local_mesh), pointer :: hecMESH
    integer(c_int), value, intent(in) :: i
    character(kind=c_char), intent(inout) :: buf(*)
    integer(c_int), value, intent(in) :: buflen
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    call f_c_str_copy(hecmesh%elem_group%grp_name(i),buf,buflen)
  end subroutine
  
  subroutine hecmw_api_mesh_get_egrp(mesh,i,array,count) bind(C,name='hecmw_api_mesh_get_egrp')
    implicit none
    type(c_ptr), value :: mesh
    integer(c_int), value, intent(in) :: i
    type(c_ptr), intent(out) :: array
    integer(c_int), intent(out) :: count
    type(hecmwst_local_mesh), pointer :: hecMESH
    integer :: is, ie
 
    call c_f_pointer(cptr=mesh, fptr=hecmesh)
    is = hecmesh%elem_group%grp_index(i-1)+1
    ie = hecmesh%elem_group%grp_index(i)
    array = c_loc(hecmesh%elem_group%grp_item(is))
    count = ie - is + 1
  end subroutine
 
end module