fstr_heat_setup.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
module m_fstr_heat_setup
  use m_fstr
  use hecmw_setup_util, only &
    : hecmw_streqr &
    , get_grp_member &
    , get_grp_member_n &
    , hecmw_expand_integer_array &
    , hecmw_expand_real_array &
    , hecmw_expand_integer_array2 &
    , hecmw_expand_real_array2
  use fstr_setup_util, only &
    : fstr_param_pack &
    , fstr_card_slot &
    , fstr_ctrl_err_stop &
    , reallocate_integer &
    , reallocate_real &
    , amp_name_to_id &
    , get_local_member_index &
    , get_sorted_local_member_index
  use fstr_ctrl_heat
  use fstr_ctrl_util_f
  implicit none
 
contains
 
  subroutine fstr_heat_init( fstrHEAT )
    implicit none
    type(fstr_heat) :: fstrHEAT
 
    fstrheat%STEPtot     = 0
    fstrheat%MATERIALtot = 0
    fstrheat%AMPLITUDEtot= 0
    fstrheat%T_FIX_tot   = 0
    fstrheat%Q_NOD_tot   = 0
    fstrheat%Q_VOL_tot   = 0
    fstrheat%Q_SUF_tot   = 0
    fstrheat%R_SUF_tot   = 0
    fstrheat%H_SUF_tot   = 0
    fstrheat%WL_tot      = 0
    fstrheat%beta        = -1.0d0
  end subroutine fstr_heat_init
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
  subroutine fstr_setup_heat( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    integer(kind=kint) :: n
    character(len=HECMW_NAME_LEN) :: mName
    integer(kind=kint) :: i
 
    n = fstr_ctrl_get_data_line_n( ctrl )
 
    if( n == 0 ) return
 
    call reallocate_real( p%PARAM%dtime, n)
    call reallocate_real( p%PARAM%etime, n)
    call reallocate_real( p%PARAM%dtmin, n)
    call reallocate_real( p%PARAM%delmax,n)
    call reallocate_integer( p%PARAM%itmax, n)
    call reallocate_real( p%PARAM%eps,   n)
    p%PARAM%analysis_n = n
 
    p%PARAM%dtime = 0
    p%PARAM%etime = 0
    p%PARAM%dtmin = 0
    p%PARAM%delmax = 0
    p%PARAM%itmax = 20
    p%PARAM%eps = 1.0e-6
    p%PARAM%timepoint_id = 0
 
    rcode = fstr_ctrl_get_heat(   ctrl,        &
      p%PARAM%dtime,     &
      p%PARAM%etime,     &
      p%PARAM%dtmin,     &
      p%PARAM%delmax,    &
      p%PARAM%itmax,     &
      p%PARAM%eps,       &
      mname,             &
      p%HEAT%beta)
    if( rcode /= 0 ) then
      call fstr_ctrl_err_stop
    end if
 
    if( associated(p%PARAM%timepoints) ) then
      do i=1,size(p%PARAM%timepoints)
        if( hecmw_streqr( p%PARAM%timepoints(i)%name, mname ) ) then
          p%PARAM%timepoint_id = i; exit
        endif
      enddo
    endif
 
    call reallocate_real( p%HEAT%STEP_DLTIME, n)
    call reallocate_real( p%HEAT%STEP_EETIME, n)
    call reallocate_real( p%HEAT%STEP_DELMIN, n)
    call reallocate_real( p%HEAT%STEP_DELMAX, n)
    p%HEAT%STEPtot = n
 
    p%HEAT%STEP_DLTIME = p%PARAM%dtime
    p%HEAT%STEP_EETIME = p%PARAM%etime
    p%HEAT%STEP_DELMIN = p%PARAM%dtmin
    p%HEAT%STEP_DELMAX = p%PARAM%delmax
    p%HEAT%timepoint_id = p%PARAM%timepoint_id
 
  end subroutine fstr_setup_heat
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
  subroutine fstr_setup_fixtemp( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    character(HECMW_NAME_LEN) :: amp
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    real(kind=kreal),pointer :: value(:)
    integer(kind=kint) :: n
    ! ------------------------------------------------
 
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
 
    allocate( grp_id_name(n))
    allocate( value(n))
 
    amp = ' '
    rcode = fstr_ctrl_get_fixtemp( ctrl, amp, &
      grp_id_name, hecmw_name_len, value )
    if( rcode /= 0 ) call fstr_ctrl_err_stop
 
    call fstr_heat_append_fixtemp( p%MESH, p%PARAM, p%HEAT, '!FIXTEMP', amp, n, grp_id_name, value )
 
    deallocate( grp_id_name )
    deallocate( value )
  end subroutine fstr_setup_fixtemp
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
  subroutine fstr_setup_cflux( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    character(HECMW_NAME_LEN) :: amp
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    real(kind=kreal),pointer :: value(:)
    integer(kind=kint) :: n
    ! ------------------------------------------------
 
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
 
    allocate( grp_id_name(n))
    allocate( value(n))
 
    amp = ' '
    rcode = fstr_ctrl_get_cflux( ctrl, amp, &
      grp_id_name, hecmw_name_len, value )
    if( rcode /= 0 ) call fstr_ctrl_err_stop
 
    call fstr_heat_append_cflux( p%MESH, p%HEAT, '!CFLUX', amp, n, grp_id_name, value )
 
    deallocate( grp_id_name )
    deallocate( value )
  end subroutine fstr_setup_cflux
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
 
  subroutine fstr_setup_dflux( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    character(HECMW_NAME_LEN) :: amp
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    integer(kind=kint),pointer :: load_type(:)
    real(kind=kreal),pointer :: value(:)
    integer(kind=kint) :: n
    ! ------------------------------------------------
 
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
 
    allocate( grp_id_name(n))
    allocate( load_type(n))
    allocate( value(n))
 
    amp = ' '
    rcode = fstr_ctrl_get_dflux( ctrl, amp, &
      grp_id_name, hecmw_name_len, load_type, value )
    if( rcode /= 0 ) call fstr_ctrl_err_stop
 
    call fstr_heat_append_dflux( p%MESH, p%HEAT, '!DFLUX', amp, n, grp_id_name, load_type, value )
 
    deallocate( grp_id_name )
    deallocate( load_type )
    deallocate( value )
  end subroutine fstr_setup_dflux
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
 
  subroutine fstr_setup_sflux( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    character(HECMW_NAME_LEN) :: amp
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    real(kind=kreal),pointer :: value(:)
    integer(kind=kint) :: n
    ! ------------------------------------------------
 
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
 
    allocate( grp_id_name(n))
    allocate( value(n))
 
    amp = ' '
    rcode = fstr_ctrl_get_sflux( ctrl, amp, &
      grp_id_name, hecmw_name_len, value )
    if( rcode /= 0 ) call fstr_ctrl_err_stop
 
    call fstr_heat_append_sflux( p%MESH, p%HEAT, '!SFLUX', amp, n, grp_id_name, value )
 
    deallocate( grp_id_name )
    deallocate( value )
  end subroutine fstr_setup_sflux
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
 
  subroutine fstr_setup_film( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    character(HECMW_NAME_LEN) :: amp1, amp2
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    integer(kind=kint),pointer :: load_type(:)
    real(kind=kreal),pointer :: value(:)
    real(kind=kreal),pointer :: shink(:)
    integer(kind=kint) :: n
    ! ------------------------------------------------
 
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
 
    allocate( grp_id_name(n))
    allocate( load_type(n))
    allocate( value(n))
    allocate( shink(n))
 
    amp1 = ' '
    amp2 = ' '
 
    rcode = fstr_ctrl_get_film( ctrl, amp1, amp2, &
      grp_id_name, hecmw_name_len, load_type, value, shink )
    if( rcode /= 0 ) call fstr_ctrl_err_stop
 
    call fstr_heat_append_film( p%MESH, p%HEAT, '!FILM', amp1, amp2, &
      n, grp_id_name, load_type, value, shink )
 
    deallocate( grp_id_name )
    deallocate( load_type )
    deallocate( value )
    deallocate( shink )
  end subroutine fstr_setup_film
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
 
  subroutine fstr_setup_sfilm( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    character(HECMW_NAME_LEN) :: amp1, amp2
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    real(kind=kreal),pointer :: value(:)
    real(kind=kreal),pointer :: shink(:)
    integer(kind=kint) :: n
    ! ------------------------------------------------
 
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
 
    allocate( grp_id_name(n))
    allocate( value(n))
    allocate( shink(n))
 
    amp1 = ' '
    amp2 = ' '
    rcode = fstr_ctrl_get_sfilm( ctrl, amp1, amp2, &
      grp_id_name, hecmw_name_len, value, shink )
    if( rcode /= 0 ) call fstr_ctrl_err_stop
 
    call fstr_heat_append_sfilm( p%MESH, p%HEAT, '!SFILM', amp1, amp2, &
      n, grp_id_name, value, shink )
 
    deallocate( grp_id_name )
    deallocate( value )
    deallocate( shink )
  end subroutine fstr_setup_sfilm
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
 
  subroutine fstr_setup_radiate( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    character(HECMW_NAME_LEN) :: amp1, amp2
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    integer(kind=kint),pointer :: load_type(:)
    real(kind=kreal),pointer :: value(:)
    real(kind=kreal),pointer :: shink(:)
    integer(kind=kint) :: n
    ! ------------------------------------------------
 
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
 
    allocate( grp_id_name(n))
    allocate( load_type(n))
    allocate( value(n))
    allocate( shink(n))
 
    amp1 = ' '
    amp2 = ' '
    rcode = fstr_ctrl_get_radiate( ctrl, amp1, amp2, &
      grp_id_name, hecmw_name_len, load_type, value, shink )
    if( rcode /= 0 ) call fstr_ctrl_err_stop
 
    call fstr_heat_append_radiate( p%MESH, p%HEAT, '!RADIATE', amp1, amp2, &
      n, grp_id_name, load_type, value, shink )
 
    deallocate( grp_id_name )
    deallocate( load_type )
    deallocate( value )
    deallocate( shink )
  end subroutine fstr_setup_radiate
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
 
 
  subroutine fstr_setup_sradiate( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: rcode
    character(HECMW_NAME_LEN) :: amp1, amp2
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    real(kind=kreal),pointer :: value(:)
    real(kind=kreal),pointer :: shink(:)
    integer(kind=kint) :: n
    ! ------------------------------------------------
 
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
 
    allocate( grp_id_name(n))
    allocate( value(n))
    allocate( shink(n))
 
    amp1 = ' '
    amp2 = ' '
    rcode = fstr_ctrl_get_sradiate( ctrl, amp1, amp2, grp_id_name, hecmw_name_len, value, shink )
    if( rcode /= 0 ) call fstr_ctrl_err_stop
 
    call fstr_heat_append_sradiate( p%MESH, p%HEAT, '!SRADIATE', amp1, amp2, &
      n, grp_id_name, value, shink )
 
    deallocate( grp_id_name )
    deallocate( value )
    deallocate( shink )
  end subroutine fstr_setup_sradiate
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_setup_weld_line( ctrl, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_param_pack) :: P
 
    type(hecmwst_local_mesh), pointer :: hecMESH
    type(fstr_heat), pointer :: fstrHEAT
    type(fstr_card_slot) :: slot
 
    slot = p%STATE%slot
    hecmesh => p%MESH
    fstrheat => p%HEAT
 
    fstrheat%WL_tot = slot%last
    if( fstr_ctrl_get_weldline( ctrl, hecmesh, hecmw_name_len, fstrheat%weldline(fstrheat%WL_tot) )/=0 ) then
      write(*,*) '### Error: Fail in read in Weld Line definition : ' , fstrheat%WL_tot
      write(ilog,*) '### Error: Fail in read in Weld Line definition : ', fstrheat%WL_tot
      stop hecmw_exit_input
    endif
  end subroutine fstr_setup_weld_line
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_heat_append_fixtemp( hecMESH, fstrPARAM, fstrHEAT, header_name, &
      amp_name, n, grp_names, vals )
    implicit none
    type(hecmwst_local_mesh), target          :: hecMESH
    type(fstr_param), target                  :: fstrPARAM
    type(fstr_heat)                           :: fstrHEAT
    character(len=*), intent(in)              :: header_name
    character(len=HECMW_NAME_LEN), intent(in) :: amp_name
    integer(kind=kint), intent(in)            :: n
    character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
    real(kind=kreal), intent(in)              :: vals(:)
 
    integer(kind=kint) :: amp_id
    integer(kind=kint) :: i, j, m, head, id, member_n, old_size, new_size
    integer(kind=kint),pointer :: member(:)
    integer(kind=kint) :: local_id, rtc
 
    if( n == 0 ) return
    call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
 
    m = 0
    do i = 1, n
      !rtc = get_local_member_index( hecMESH, 'node', grp_names(i), local_id )
      rtc = get_sorted_local_member_index( hecmesh, fstrparam, 'node', grp_names(i), local_id )
      if( rtc > 0 ) then
        m = m + 1
      else if( rtc < 0 ) then
        m = m + get_grp_member_n( hecmesh, 'node_grp', grp_names(i) )
      end if
    end do
 
    if (m == 0) return
 
    ! JP-8
    old_size = fstrheat%T_FIX_tot
    new_size = old_size + m
    call hecmw_expand_integer_array( fstrheat%T_FIX_node, old_size, new_size )
    call hecmw_expand_integer_array( fstrheat%T_FIX_ampl, old_size, new_size )
    call hecmw_expand_real_array(    fstrheat%T_FIX_val,  old_size, new_size )
    fstrheat%T_FIX_tot = new_size
 
    head = old_size + 1
    member => fstrheat%T_FIX_node(head:)
    id = head
    do i = 1, n
      !rtc = get_local_member_index( hecMESH, 'node', grp_names(i), local_id )
      rtc = get_sorted_local_member_index( hecmesh, fstrparam, 'node', grp_names(i), local_id )
      if( rtc > 0 ) then
        member(1) = local_id
        member_n = 1
      else if( rtc < 0 ) then
        member_n = get_grp_member( hecmesh, 'node_grp', grp_names(i), member )
      else
        cycle
      end if
      if( i<n ) then
        member => member( member_n+1 : )
      endif
      do j = 1, member_n
        fstrheat%T_FIX_val  (id) = vals(i)
        fstrheat%T_FIX_ampl (id) = amp_id
        id = id + 1
      end do
    end do
 
  end subroutine fstr_heat_append_fixtemp
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_heat_append_cflux( hecMESH, fstrHEAT, header_name, amp_name, n, grp_names, vals )
    implicit none
    type(hecmwst_local_mesh), target          :: hecMESH
    type(fstr_heat)                           :: fstrHEAT
    character(len=*), intent(in)              :: header_name
    character(len=HECMW_NAME_LEN), intent(in) :: amp_name
    integer(kind=kint), intent(in)            :: n
    character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
    real(kind=kreal), intent(in)              :: vals(:)
 
    integer(kind=kint) :: amp_id
    integer(kind=kint) :: i, j, m, head, id, member_n, old_size, new_size
    integer(kind=kint),pointer :: member(:)
    integer(kind=kint) :: local_id, rtc
 
    if( n == 0 ) return
    call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
 
    m = 0
 
    do i = 1, n
      rtc = get_local_member_index( hecmesh, 'node', grp_names(i), local_id )
      if( rtc > 0 ) then
        m = m + 1
      else if( rtc < 0 ) then
        m = m + get_grp_member_n( hecmesh, 'node_grp', grp_names(i) )
      end if
    end do
 
    if (m == 0) return
 
    ! JP-9
    old_size = fstrheat%Q_NOD_tot
    new_size = old_size + m
    call hecmw_expand_integer_array( fstrheat%Q_NOD_node, old_size, new_size )
    call hecmw_expand_integer_array( fstrheat%Q_NOD_ampl, old_size, new_size )
    call hecmw_expand_real_array(    fstrheat%Q_NOD_val,  old_size, new_size )
    fstrheat%Q_NOD_tot = new_size
 
    head = old_size + 1
    member => fstrheat%Q_NOD_node(head:)
    id = head
    do i = 1, n
      rtc = get_local_member_index( hecmesh, 'node', grp_names(i), local_id )
      if( rtc > 0 ) then
        member(1) = local_id
        member_n = 1
      else if( rtc < 0 ) then
        member_n = get_grp_member( hecmesh, 'node_grp', grp_names(i), member )
      else
        cycle
      end if
      if( i<n ) member => member( member_n+1 : )
      do j = 1, member_n
        fstrheat%Q_NOD_val  (id) = vals(i)
        fstrheat%Q_NOD_ampl (id) = amp_id
        id = id + 1
      end do
    end do
 
  end subroutine fstr_heat_append_cflux
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_heat_append_dflux( hecMESH, fstrHEAT, header_name, amp_name, n, grp_names, &
      load_types, vals )
    implicit none
    type(hecmwst_local_mesh), target          :: hecMESH
    type(fstr_heat)                           :: fstrHEAT
    character(len=*), intent(in)              :: header_name
    character(len=HECMW_NAME_LEN), intent(in) :: amp_name
    integer(kind=kint), intent(in)            :: n
    character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
    integer(kind=kint), intent(in)            :: load_types(:)
    real(kind=kreal), intent(in)              :: vals(:)
 
    integer(kind=kint) :: amp_id
    integer(kind=kint) :: i, j, m, head, id, member_n, old_size, new_size
    integer(kind=kint),pointer :: member(:)
    integer(kind=kint) :: local_id, rtc
 
    if( n == 0 ) return
    call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
 
    m = 0
    do i = 1, n
      rtc = get_local_member_index( hecmesh, 'element', grp_names(i), local_id )
      if( rtc > 0 ) then
        m = m + 1
      else if( rtc < 0 ) then
        m = m + get_grp_member_n( hecmesh, 'elem_grp', grp_names(i) )
      end if
    end do
 
    if (m == 0) return
 
    ! JP-10
    old_size = fstrheat%Q_SUF_tot
    new_size = old_size + m
    call hecmw_expand_integer_array( fstrheat%Q_SUF_elem, old_size, new_size )
    call hecmw_expand_integer_array( fstrheat%Q_SUF_ampl, old_size, new_size )
    call hecmw_expand_integer_array( fstrheat%Q_SUF_surf, old_size, new_size )
    call hecmw_expand_real_array(    fstrheat%Q_SUF_val,  old_size, new_size )
    fstrheat%Q_SUF_tot = new_size
 
    head = old_size + 1
    member => fstrheat%Q_SUF_elem(head:)
    id = head
    do i = 1, n
      rtc = get_local_member_index( hecmesh, 'element', grp_names(i), local_id )
      if( rtc > 0 ) then
        member(1) = local_id
        member_n = 1
      else if( rtc < 0 ) then
        member_n = get_grp_member( hecmesh, 'elem_grp', grp_names(i), member )
      else
        cycle
      end if
      if( i<n ) member => member( member_n+1 : )
      do j = 1, member_n
        fstrheat%Q_SUF_surf (id) = load_types(i)
        fstrheat%Q_SUF_val  (id) = vals(i)
        fstrheat%Q_SUF_ampl (id) = amp_id
        id = id + 1
      end do
    end do
 
  end subroutine fstr_heat_append_dflux
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_heat_append_sflux( hecMESH, fstrHEAT, header_name, amp_name, n, grp_names, vals )
    implicit none
    type(hecmwst_local_mesh), target          :: hecMESH
    type(fstr_heat)                           :: fstrHEAT
    character(len=*), intent(in)              :: header_name
    character(len=HECMW_NAME_LEN), intent(in) :: amp_name
    integer(kind=kint), intent(in)            :: n
    character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
    real(kind=kreal), intent(in)              :: vals(:)
 
    integer(kind=kint) :: amp_id
    integer(kind=kint) :: i, j, m, head, id, member_n, old_size, new_size
    integer(kind=kint),pointer :: member1(:), member2(:)
 
    if( n == 0 ) return
    call amp_name_to_id( hecmesh, header_name, amp_name, amp_id )
 
    m = 0
    do i = 1, n
      m = m + get_grp_member_n( hecmesh, 'surf_grp', grp_names(i) )
    end do
 
    if (m == 0) return
 
    ! JP-11
    old_size = fstrheat%Q_SUF_tot
    new_size = old_size + m
    call hecmw_expand_integer_array( fstrheat%Q_SUF_elem, old_size, new_size )
    call hecmw_expand_integer_array( fstrheat%Q_SUF_ampl, old_size, new_size )
    call hecmw_expand_integer_array( fstrheat%Q_SUF_surf, old_size, new_size )
    call hecmw_expand_real_array(    fstrheat%Q_SUF_val,  old_size, new_size )
    fstrheat%Q_SUF_tot = new_size
 
    head = old_size + 1
    member1 => fstrheat%Q_SUF_elem(head:)
    member2 => fstrheat%Q_SUF_surf(head:)
    id = head
    do i = 1, n
      member_n = get_grp_member( hecmesh, 'surf_grp', grp_names(i), member1, member2 )
      if( i<n ) then
        member1 => member1( member_n+1 : )
        member2 => member2( member_n+1 : )
      end if
      do j = 1, member_n
        fstrheat%Q_SUF_val  (id) = vals(i)
        fstrheat%Q_SUF_ampl (id) = amp_id
        id = id + 1
      end do
    end do
 
  end subroutine fstr_heat_append_sflux
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_heat_append_film( hecMESH, fstrHEAT, header_name, amp_name1, amp_name2, &
      n, grp_names, load_types, vals, sinks )
    implicit none
    type(hecmwst_local_mesh), target          :: hecMESH
    type(fstr_heat)                           :: fstrHEAT
    character(len=*), intent(in)              :: header_name
    character(len=HECMW_NAME_LEN), intent(in) :: amp_name1, amp_name2
    integer(kind=kint), intent(in)            :: n
    character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
    integer(kind=kint), intent(in)            :: load_types(:)
    real(kind=kreal), intent(in)              :: vals(:)
    real(kind=kreal), intent(in)              :: sinks(:)
 
    integer(kind=kint) :: amp_id1, amp_id2
    integer(kind=kint) :: i, j, m, head, id, member_n, old_size, new_size
    integer(kind=kint),pointer :: member(:)
    integer(kind=kint) :: local_id, rtc
 
    if( n == 0 ) return
    call amp_name_to_id( hecmesh, header_name, amp_name1, amp_id1 )
    call amp_name_to_id( hecmesh, header_name, amp_name2, amp_id2 )
 
    m = 0
    do i = 1, n
      rtc = get_local_member_index( hecmesh, 'element', grp_names(i), local_id )
      if( rtc > 0 ) then
        m = m + 1
      else if( rtc < 0 ) then
        m = m + get_grp_member_n( hecmesh, 'elem_grp', grp_names(i) )
      end if
    end do
 
    if (m == 0) return
 
    ! JP-12
    old_size = fstrheat%H_SUF_tot
    new_size = old_size + m
    call hecmw_expand_integer_array(  fstrheat%H_SUF_elem,    old_size, new_size )
    call hecmw_expand_integer_array2( fstrheat%H_SUF_ampl, 2, old_size, new_size )
    call hecmw_expand_integer_array(  fstrheat%H_SUF_surf,    old_size, new_size )
    call hecmw_expand_real_array2(    fstrheat%H_SUF_val,  2, old_size, new_size )
    fstrheat%H_SUF_tot = new_size
 
    head = old_size + 1
    member => fstrheat%H_SUF_elem(head:)
    id = head
    do i = 1, n
      rtc = get_local_member_index( hecmesh, 'element', grp_names(i), local_id )
      if( rtc > 0 ) then
        member(1) = local_id
        member_n = 1
      else if( rtc < 0 ) then
        member_n = get_grp_member( hecmesh, 'elem_grp', grp_names(i), member )
      else
        cycle
      end if
      if( i<n ) member => member( member_n+1 : )
      do j = 1, member_n
        fstrheat%H_SUF_surf (id)   = load_types(i)
        fstrheat%H_SUF_val  (id,1) = vals(i)
        fstrheat%H_SUF_val  (id,2) = sinks(i)
        fstrheat%H_SUF_ampl (id,1) = amp_id1
        fstrheat%H_SUF_ampl (id,2) = amp_id2
        id= id + 1
      end do
    end do
 
  end subroutine fstr_heat_append_film
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_heat_append_sfilm( hecMESH, fstrHEAT, header_name, amp_name1, amp_name2, &
      n, grp_names, vals, sinks )
    implicit none
    type(hecmwst_local_mesh), target          :: hecMESH
    type(fstr_heat)                           :: fstrHEAT
    character(len=*), intent(in)              :: header_name
    character(len=HECMW_NAME_LEN), intent(in) :: amp_name1, amp_name2
    integer(kind=kint), intent(in)            :: n
    character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
    real(kind=kreal), intent(in)              :: vals(:)
    real(kind=kreal), intent(in)              :: sinks(:)
 
    integer(kind=kint) :: amp_id1, amp_id2
    integer(kind=kint) :: i, j, m, head, id, member_n, old_size, new_size
    integer(kind=kint),pointer :: member1(:), member2(:)
 
    if( n == 0 ) return
    call amp_name_to_id( hecmesh, header_name, amp_name1, amp_id1 )
    call amp_name_to_id( hecmesh, header_name, amp_name2, amp_id2 )
 
    m = 0
    do i = 1, n
      m = m + get_grp_member_n( hecmesh, 'surf_grp', grp_names(i) )
    end do
 
    if (m == 0) return
 
    ! JP-13
    old_size = fstrheat%H_SUF_tot
    new_size = old_size + m
    call hecmw_expand_integer_array(  fstrheat%H_SUF_elem,    old_size, new_size )
    call hecmw_expand_integer_array2( fstrheat%H_SUF_ampl, 2, old_size, new_size )
    call hecmw_expand_integer_array(  fstrheat%H_SUF_surf,    old_size, new_size )
    call hecmw_expand_real_array2(    fstrheat%H_SUF_val,  2, old_size, new_size )
    fstrheat%H_SUF_tot = new_size
 
    head = old_size + 1
    member1 => fstrheat%H_SUF_elem(head:)
    member2 => fstrheat%H_SUF_surf(head:)
    id = head
    do i = 1, n
      member_n = get_grp_member( hecmesh, 'surf_grp', grp_names(i), member1, member2 )
      if( i<n ) then
        member1 => member1( member_n+1 : )
        member2 => member2( member_n+1 : )
      end if
      do j = 1, member_n
        fstrheat%H_SUF_val  (id,1) = vals(i)
        fstrheat%H_SUF_val  (id,2) = sinks(i)
        fstrheat%H_SUF_ampl (id,1) = amp_id1
        fstrheat%H_SUF_ampl (id,2) = amp_id2
        id = id + 1
      end do
    end do
 
  end subroutine fstr_heat_append_sfilm
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_heat_append_radiate( hecMESH, fstrHEAT, header_name, amp_name1, amp_name2, &
      n, grp_names, load_types, vals, sinks )
    implicit none
    type(hecmwst_local_mesh), target          :: hecMESH
    type(fstr_heat)                           :: fstrHEAT
    character(len=*), intent(in)              :: header_name
    character(len=HECMW_NAME_LEN), intent(in) :: amp_name1, amp_name2
    integer(kind=kint), intent(in)            :: n
    character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
    integer(kind=kint), intent(in)            :: load_types(:)
    real(kind=kreal), intent(in)              :: vals(:)
    real(kind=kreal), intent(in)              :: sinks(:)
 
    integer(kind=kint) :: amp_id1, amp_id2
    integer(kind=kint) :: i, j, m, head, id, member_n, old_size, new_size
    integer(kind=kint),pointer :: member(:)
    integer(kind=kint) :: local_id, rtc
 
    if( n == 0 ) return
    call amp_name_to_id( hecmesh, header_name, amp_name1, amp_id1 )
    call amp_name_to_id( hecmesh, header_name, amp_name2, amp_id2 )
 
    m = 0
    do i = 1, n
      rtc = get_local_member_index( hecmesh, 'element', grp_names(i), local_id )
      if( rtc > 0 ) then
        m = m + 1
      else if( rtc < 0 ) then
        m = m + get_grp_member_n( hecmesh, 'elem_grp', grp_names(i) )
      end if
    end do
 
    if (m == 0) return
 
    ! JP-14
    old_size = fstrheat%R_SUF_tot
    new_size = old_size + m
    call hecmw_expand_integer_array(  fstrheat%R_SUF_elem,    old_size, new_size )
    call hecmw_expand_integer_array2( fstrheat%R_SUF_ampl, 2, old_size, new_size )
    call hecmw_expand_integer_array(  fstrheat%R_SUF_surf,    old_size, new_size )
    call hecmw_expand_real_array2(    fstrheat%R_SUF_val,  2, old_size, new_size )
    fstrheat%R_SUF_tot = new_size
 
    head = old_size + 1
    member => fstrheat%R_SUF_elem(head:)
    id = head
    do i = 1, n
      rtc = get_local_member_index( hecmesh, 'element', grp_names(i), local_id )
      if( rtc > 0 ) then
        member(1) = local_id
        member_n = 1
      else if( rtc < 0 ) then
        member_n = get_grp_member( hecmesh, 'elem_grp', grp_names(i), member )
      else
        cycle
      end if
      if( i<n ) member => member( member_n+1 : )
      do j = 1, member_n
        fstrheat%R_SUF_surf (id)   = load_types(i)
        fstrheat%R_SUF_val  (id,1) = vals(i)
        fstrheat%R_SUF_val  (id,2) = sinks(i)
        fstrheat%R_SUF_ampl (id,1) = amp_id1
        fstrheat%R_SUF_ampl (id,2) = amp_id2
        id = id + 1
      end do
    end do
 
  end subroutine fstr_heat_append_radiate
 
  !-----------------------------------------------------------------------------!
  !-----------------------------------------------------------------------------!
  subroutine fstr_heat_append_sradiate( hecMESH, fstrHEAT, header_name, amp_name1, amp_name2, &
      n, grp_names, vals, sinks )
    implicit none
    type(hecmwst_local_mesh), target          :: hecMESH
    type(fstr_heat)                           :: fstrHEAT
    character(len=*), intent(in)              :: header_name
    character(len=HECMW_NAME_LEN), intent(in) :: amp_name1, amp_name2
    integer(kind=kint), intent(in)            :: n
    character(len=HECMW_NAME_LEN), intent(in) :: grp_names(:)
    real(kind=kreal), intent(in)              :: vals(:)
    real(kind=kreal), intent(in)              :: sinks(:)
 
    integer(kind=kint) :: amp_id1, amp_id2
    integer(kind=kint) :: i, j, m, head, id, member_n, old_size, new_size
    integer(kind=kint),pointer :: member1(:), member2(:)
 
    if( n == 0 ) return
    call amp_name_to_id( hecmesh, header_name, amp_name1, amp_id1 )
    call amp_name_to_id( hecmesh, header_name, amp_name2, amp_id2 )
 
    m = 0
    do i = 1, n
      m = m + get_grp_member_n( hecmesh, 'surf_grp', grp_names(i) )
    end do
 
    if (m == 0) return
 
    ! JP-15
    old_size = fstrheat%R_SUF_tot
    new_size = old_size + m
    call hecmw_expand_integer_array(  fstrheat%R_SUF_elem,    old_size, new_size )
    call hecmw_expand_integer_array2( fstrheat%R_SUF_ampl, 2, old_size, new_size )
    call hecmw_expand_integer_array(  fstrheat%R_SUF_surf,    old_size, new_size )
    call hecmw_expand_real_array2(    fstrheat%R_SUF_val,  2, old_size, new_size )
    fstrheat%R_SUF_tot = new_size
 
    head = old_size + 1
    member1 => fstrheat%R_SUF_elem(head:)
    member2 => fstrheat%R_SUF_surf(head:)
    id = head
    do i = 1, n
      member_n = get_grp_member( hecmesh, 'surf_grp', grp_names(i), member1, member2 )
      if( i<n ) then
        member1 => member1( member_n+1 : )
        member2 => member2( member_n+1 : )
      end if
      do j = 1, member_n
        fstrheat%R_SUF_val  (id,1) = vals(i)
        fstrheat%R_SUF_val  (id,2) = sinks(i)
        fstrheat%R_SUF_ampl (id,1) = amp_id1
        fstrheat%R_SUF_ampl (id,2) = amp_id2
        id = id + 1
      end do
    end do
 
  end subroutine fstr_heat_append_sradiate
 
end module m_fstr_heat_setup