fstr_ctrl_freq.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
 
!-----------------------------------------------------------------------------!
!-----------------------------------------------------------------------------!
  subroutine fstr_setup_fload( ctrl, counter, P )
  !---- args
    integer(kind=kint)   :: ctrl
    integer(kind=kint)   :: counter
    type(fstr_param_pack) :: P
  !---- vals
    integer(kind=kint)                  :: rcode
    character(HECMW_NAME_LEN)           :: amp
    integer(kind=kint)                  :: amp_id
    character(HECMW_NAME_LEN), pointer :: grp_id_name(:)
    real(kind=kreal), pointer           :: val_ptr(:)
    integer(kind=kint), pointer        :: id_ptr(:), type_ptr(:)
    integer(kind=kint)                  :: i, n, old_size, new_size
    integer(kind=kint)                  :: gid, loadcase
  !---- body
 
    if( p%SOLID%file_type /= kbcffstr) return
 
    !read grpid
    gid = 1
    rcode = fstr_ctrl_get_param_ex( ctrl, 'GRPID ',  '# ',  0, 'I', gid )
    !read loadcase (real=1:default, img=2)
    loadcase = kfloadcase_re
    rcode = fstr_ctrl_get_param_ex( ctrl, 'LOAD CASE ', '# ', 0, 'I', loadcase)
    !write(*,*) "loadcase=", loadcase
    !pause
 
    !read the num of dataline
    n = fstr_ctrl_get_data_line_n( ctrl )
    if( n == 0 ) return
    old_size = p%FREQ%FLOAD_ngrp_tot
    new_size = old_size + n
 
    !expand data array
    p%FREQ%FLOAD_ngrp_tot = new_size
    call fstr_expand_integer_array( p%FREQ%FLOAD_ngrp_GRPID, old_size, new_size )
    call fstr_expand_integer_array( p%FREQ%FLOAD_ngrp_ID,    old_size, new_size )
    call fstr_expand_integer_array( p%FREQ%FLOAD_ngrp_TYPE,  old_size, new_size )
    call fstr_expand_integer_array( p%FREQ%FLOAD_ngrp_DOF,   old_size, new_size )
    call fstr_expand_real_array   ( p%FREQ%FLOAD_ngrp_valre, old_size, new_size )
    call fstr_expand_real_array   ( p%FREQ%FLOAD_ngrp_valim, old_size, new_size )
 
    !fill bc data
    allocate( grp_id_name(n) )
    if(loadcase == kfloadcase_re) then
      val_ptr  => p%FREQ%FLOAD_ngrp_valre(old_size+1:)
    else if(loadcase == kfloadcase_im) then
      val_ptr  => p%FREQ%FLOAD_ngrp_valim(old_size+1:)
    else
      !error
      write(*,*)    "Error this load set is not defined!"
      write(ilog,*) "Error this load set is not defined!"
      stop
    end if
    id_ptr   => p%FREQ%FLOAD_ngrp_DOF(old_size+1:)
    type_ptr => p%FREQ%FLOAD_ngrp_TYPE(old_size+1:)
    val_ptr = 0.0d0
    rcode = fstr_ctrl_get_fload( ctrl, grp_id_name, hecmw_name_len, id_ptr, val_ptr)
    if( rcode /= 0 ) call fstr_ctrl_err_stop
    p%FREQ%FLOAD_ngrp_GRPID(old_size+1:new_size) = gid
    call nodesurf_grp_name_to_id_ex( p%MESH, '!FLOAD', n, grp_id_name, &
         p%FREQ%FLOAD_ngrp_ID(old_size+1:), p%FREQ%FLOAD_ngrp_TYPE(old_size+1:))
 
    deallocate( grp_id_name )
    return
 
    contains
 
    function fstr_ctrl_get_fload(ctrl, node_id, node_id_len, dof_id, value)
!      include 'fstr_ctrl_util_f.inc'                         !Fortran->C interface for fstr ctrl API
      integer(kind=kint)                    :: ctrl
      character(len=HECMW_NAME_LEN),target :: node_id(:)  !Node group name
      integer(kind=kint), pointer          :: dof_id(:)
      integer(kind=kint)                    :: node_id_len
      real(kind=kreal), pointer             :: value(:)
      integer(kind=kint)                    :: fstr_ctrl_get_fload !return value
      character(len=HECMW_NAME_LEN)        :: data_fmt, ss
      character(len=HECMW_NAME_LEN),pointer :: node_id_p
 
      write(ss,*) node_id_len
      write(data_fmt, '(a,a,a)') 'S', trim(adjustl(ss)), 'IR '
 
      node_id_p => node_id(1)
      fstr_ctrl_get_fload = fstr_ctrl_get_data_array_ex(ctrl, data_fmt, node_id_p, dof_id, value)
    end function
 
  end subroutine
 
!-----------------------------------------------------------------------------!
!-----------------------------------------------------------------------------!
  subroutine fstr_setup_eigenread( ctrl, counter, P )
  !---- args
    integer(kind=kint)    :: ctrl
    integer(kind=kint)    :: counter
    type(fstr_param_pack) :: P
  !---- vals
    integer(kind=kint)                :: filename_len
    character(len=HECMW_NAME_LEN) :: datafmt, ss
  !---- body
 
    filename_len = hecmw_filename_len
    write(ss,*) filename_len
    write(datafmt, '(a,a,a)') 'S', trim(adjustl(ss)), ' '
 
    if( fstr_ctrl_get_data_ex( ctrl, 1, datafmt, p%FREQ%eigenlog_filename ) /= 0) return
    if( fstr_ctrl_get_data_ex( ctrl, 2, 'ii ', p%FREQ%start_mode, p%FREQ%end_mode ) /= 0) return
 
    return
 
  end subroutine