fstr_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_setup
  use m_fstr
  use hecmw_setup_util, only &
    : node_grp_name_to_id_ex &
    , elem_grp_name_to_id_ex &
    , surf_grp_name_to_id_ex &
    , hecmw_streqr
  use fstr_setup_util
  use m_fstr_solid_setup
  use m_fstr_heat_setup
  use m_fstr_freq_setup
  use m_fstr_eigen_setup
  use m_fstr_dynamic_setup
  use m_fstr_param_setup
  use m_fstr_setup_finish
  use fstr_ctrl_common
  use fstr_ctrl_static
  use fstr_ctrl_heat
  use fstr_ctrl_eigen
  use fstr_ctrl_dynamic
  use fstr_ctrl_material
  use mcontactparam
  use m_static_get_prop
  use m_out
  use m_step
  use m_utilities
  use fstr_ctrl_util_f
  implicit none
 
contains
 
  !=============================================================================!
  !=============================================================================!
  subroutine fstr_setup( cntl_filename, hecMESH, hecMAT, fstrPARAM,  &
      fstrSOLID, fstrEIG, fstrHEAT, fstrDYNAMIC, fstrCPL, fstrFREQ )
    character(len=HECMW_FILENAME_LEN) :: cntl_filename
    type(hecmwst_local_mesh),target :: hecMESH
    type(hecmwst_matrix),target :: hecMAT
    type(fstr_param),target   :: fstrPARAM
    type(fstr_solid),target   :: fstrSOLID
    type(fstr_eigen),target     :: fstrEIG
    type(fstr_heat),target    :: fstrHEAT
    type(fstr_dynamic),target :: fstrDYNAMIC
    type(fstr_couple),target  :: fstrCPL
    type(fstr_freqanalysis), target :: fstrFREQ
 
    integer(kind=kint) :: ctrl, rcode
    type(fstr_param_pack) :: P
    type(fstr_card_table) :: T
    integer(kind=kint) :: total(FSTR_CARD_MAX)
    type(fstr_setup_counts) :: counts
 
    ! packaging
    p%MESH   => hecmesh
    p%MAT    => hecmat
    p%PARAM  => fstrparam
    p%SOLID  => fstrsolid
    p%EIGEN  => fstreig
    p%HEAT   => fstrheat
    p%DYN    => fstrdynamic
    p%CPL    => fstrcpl
    p%FREQ   => fstrfreq
 
    fstrparam%contact_algo = kcaalagrange
 
    call fstr_setup_cards( t )
 
    ctrl  = fstr_ctrl_open( cntl_filename )
    if( ctrl < 0 ) then
      write(*,*) '### Error: Cannot open FSTR control file : ', cntl_filename
      write(ilog,*) '### Error: Cannot open FSTR control file : ', cntl_filename
      stop hecmw_exit_input
    end if
 
    call fstr_setup_read_cards( ctrl, t, 1, total, p )
 
    ! -----
    counts = fstr_setup_card_counts( t, total )
    call fstr_setup_prepare( p, counts )
 
    ! -----
    rcode = fstr_ctrl_rewind( ctrl )
    call fstr_setup_read_cards( ctrl, t, 2, total, p )
 
    call fstr_setup_finish( p, counts )
    if( p%PARAM%fg_visual == kon ) call fstr_setup_visualize( ctrl, p%MESH )
    rcode = fstr_ctrl_close( ctrl )
 
  end subroutine fstr_setup
 
  subroutine fstr_setup_cards( T )
    implicit none
    type(fstr_card_table) :: T
 
    ! Settings, read in the first reading. fstr_setup_prepare and the second reading use them wherever they are
    ! in the file, and the cards of the first reading use those read before them.
    ! fstr_setup_prepare uses !SOLUTION, !STATIC and !DYNAMIC, !CONTACT uses !CONTACT_ALGO,
    ! and in the first reading, !STEP uses !VERSION and !DLOAD uses NLGEOM of !SOLUTION, !STATIC and !DYNAMIC.
    call fstr_card_add( t, 'VERSION',          first=fstr_setup_version )
    call fstr_card_add( t, 'SOLUTION',         first=fstr_setup_solution )
    call fstr_card_add( t, 'STATIC',           first=fstr_setup_static )
    call fstr_card_add( t, 'DYNAMIC',          first=fstr_setup_dynamic )
    call fstr_card_add( t, 'CONTACT_ALGO',     first=fstr_setup_contactalgo )
    call fstr_card_add( t, 'NONLINEAR_SOLVER', first=fstr_setup_nonlinear_solver )
    call fstr_card_add( t, 'SOLVER',           first=fstr_setup_solver )
    call fstr_card_add( t, 'EIGEN',            first=fstr_setup_eigen )
    call fstr_card_add( t, 'ECHO',             first=fstr_setup_echo )
    call fstr_card_add( t, 'RESTART',          first=fstr_setup_restart )
    call fstr_card_add( t, 'OUTPUT_SSTYPE',    first=fstr_setup_output_sstype )
 
    ! Cards added to arrays as they are read. fstr_setup_prepare converts or checks the rotational dofs of
    ! !BOUNDARY, !CLOAD, !SPRING, !VELOCITY, !ACCELERATION, !FLOAD and !FACCELERATION,
    ! and the cards of the first reading refer to !AMPLITUDE by name.
    call fstr_card_add( t, 'AMPLITUDE',          first=fstr_setup_amplitude )
    call fstr_card_add( t, 'BOUNDARY',           first=fstr_setup_boundary )
    call fstr_card_add( t, 'CLOAD',              first=fstr_setup_cload )
    call fstr_card_add( t, 'SPRING',             first=fstr_setup_spring )
    call fstr_card_add( t, 'VELOCITY',           first=fstr_setup_velocity )
    call fstr_card_add( t, 'ACCELERATION',       first=fstr_setup_acceleration )
    call fstr_card_add( t, 'FLOAD',              first=fstr_setup_fload )
    call fstr_card_add( t, 'FACCELERATION',      first=fstr_setup_facceleration )
    call fstr_card_add( t, 'DLOAD',              first=fstr_setup_dload )
    call fstr_card_add( t, 'TEMPERATURE',        first=fstr_setup_temperature )
    call fstr_card_add( t, 'REFTEMP',            first=fstr_setup_reftemp )
    call fstr_card_add( t, 'ELEMENT_ACTIVATION', first=fstr_setup_element_activation )
    call fstr_card_add( t, 'FIXTEMP',            first=fstr_setup_fixtemp )
    call fstr_card_add( t, 'CFLUX',              first=fstr_setup_cflux )
    call fstr_card_add( t, 'DFLUX',              first=fstr_setup_dflux )
    call fstr_card_add( t, 'SFLUX',              first=fstr_setup_sflux )
    call fstr_card_add( t, 'FILM',               first=fstr_setup_film )
    call fstr_card_add( t, 'SFILM',              first=fstr_setup_sfilm )
    call fstr_card_add( t, 'RADIATE',            first=fstr_setup_radiate )
    call fstr_card_add( t, 'SRADIATE',           first=fstr_setup_sradiate )
    call fstr_card_add( t, 'EIGENREAD',          first=fstr_setup_eigenread )
    call fstr_card_add( t, 'COUPLE',             first=fstr_setup_couple )
    call fstr_card_add( t, 'MPC',                first=fstr_setup_mpc )
 
    ! Counted in the first reading to allocate the arrays they are stored in, and stored in the second reading.
    ! !CONTACT also uses !CONTACT_ALGO, and !CONTACT_INTERFERENCE refers to the pairs of !CONTACT.
    call fstr_card_add( t, 'ORIENTATION',          second=fstr_setup_orientation )
    call fstr_card_add( t, 'CONTACT',              second=fstr_setup_contact, by_line=.true. )
    call fstr_card_add( t, 'EMBED',                second=fstr_setup_embed, by_line=.true. )
    call fstr_card_add( t, 'CONTACT_INTERFERENCE', second=fstr_setup_contact_interference, by_line=.true. )
    call fstr_card_add( t, 'CONTACT_PARAM',        second=fstr_setup_contact_param )
    call fstr_card_add( t, 'AUTOINC_PARAM',        second=fstr_setup_autoinc_param )
    call fstr_card_add( t, 'CONVERG_PARAM',        second=fstr_setup_converg_param )
    call fstr_card_add( t, 'TIME_POINTS',          second=fstr_setup_time_points )
    call fstr_card_add( t, 'INITIAL_CONDITION',    second=fstr_setup_initial_condition )
    call fstr_card_add( t, 'WELD_LINE',            second=fstr_setup_weld_line )
    call fstr_card_add( t, 'MATERIAL',             second=fstr_setup_material )
    ! !ISTEP also refers by name to !AUTOINC_PARAM, !CONVERG_PARAM and !TIME_POINTS read before it.
    ! !STEP of !VERSION 0 is read in the first reading. !STEP of !VERSION 1 or later is a step like !ISTEP,
    ! stored in the same array. !STEP of a negative !VERSION is not read, but is counted as a step in the first reading.
    call fstr_card_add( t, 'ISTEP',                second=fstr_setup_istep, seq='steps' )
    call fstr_card_add( t, 'STEP',                 first=fstr_setup_step, version_min=0, version_max=0 )
    call fstr_card_add( t, 'STEP',                 second=fstr_setup_step_store, seq='steps', version_min=1 )
    call fstr_card_add( t, 'STEP',                 seq='steps', version_max=-1 )
 
    ! Read in the second reading to refer by name to the cards of the second reading read before them:
    ! !SECTION to !ORIENTATION, and !HEAT to !TIME_POINTS
    call fstr_card_add( t, 'SECTION',              second=fstr_setup_section )
    call fstr_card_add( t, 'HEAT',                 second=fstr_setup_heat )
 
    ! Stored in the output controls that fstr_setup_prepare allocates.
    ! !WRITE also sets the output flags in the first reading.
    call fstr_card_add( t, 'WRITE',                first=fstr_setup_write_flags, second=fstr_setup_write_store )
    call fstr_card_add( t, 'OUTPUT_RES',           second=fstr_setup_output_res )
    call fstr_card_add( t, 'OUTPUT_VIS',           second=fstr_setup_output_vis )
 
    ! Stored in the material of the last !MATERIAL
    call fstr_card_add( t, 'ELASTIC',              second=fstr_setup_elastic )
    call fstr_card_add( t, 'PLASTIC',              second=fstr_setup_plastic )
    call fstr_card_add( t, 'HYPERELASTIC',         second=fstr_setup_hyperelastic )
    call fstr_card_add( t, 'VISCOELASTIC',         second=fstr_setup_viscoelastic )
    call fstr_card_add( t, 'TRS',                  second=fstr_setup_trs )
    call fstr_card_add( t, 'CREEP',                second=fstr_setup_creep )
    call fstr_card_add( t, 'DENSITY',              second=fstr_setup_density )
    call fstr_card_add( t, 'EXPANSION_COEF',       second=fstr_setup_expansion_coeff )
    call fstr_card_alias( t, 'EXPANSION_COEFF', 'EXPANSION_COEF' )
    call fstr_card_alias( t, 'EXPANSION',       'EXPANSION_COEF' )
    call fstr_card_add( t, 'DAMPING',              second=fstr_setup_damping )
    call fstr_card_add( t, 'FLUID',                second=fstr_setup_fluid )
    call fstr_card_add( t, 'SPRING_D',             second=fstr_setup_spring_d )
    call fstr_card_add( t, 'SPRING_A',             second=fstr_setup_spring_a )
    call fstr_card_add( t, 'DASHPOT_D',            second=fstr_setup_dashpot_d )
    call fstr_card_add( t, 'DASHPOT_A',            second=fstr_setup_dashpot_a )
    call fstr_card_add( t, 'USER_MATERIAL',        second=fstr_setup_user_material )
 
    ! Read in the second reading
    call fstr_card_add( t, 'ELEMOPT',              second=fstr_setup_elemopt )
    call fstr_card_add( t, 'ULOAD',                second=fstr_setup_uload )
  end subroutine fstr_setup_cards
 
  function fstr_setup_card_counts( T, total ) result( counts )
    implicit none
    type(fstr_card_table), intent(in) :: t
    integer(kind=kint), intent(in) :: total(:)
    type(fstr_setup_counts) :: counts
 
    counts%contact_pairs         = fstr_card_total( t, total, 'CONTACT' )
    counts%embed_pairs           = fstr_card_total( t, total, 'EMBED' )
    counts%contact_interferences = fstr_card_total( t, total, 'CONTACT_INTERFERENCE' )
    counts%contact_params        = fstr_card_total( t, total, 'CONTACT_PARAM' )
    counts%weld_lines            = fstr_card_total( t, total, 'WELD_LINE' )
    counts%initial_conditions    = fstr_card_total( t, total, 'INITIAL_CONDITION' )
    counts%steps                 = fstr_card_total( t, total, 'steps' )
    counts%local_coords          = fstr_card_total( t, total, 'ORIENTATION' )
    counts%autoinc_params        = fstr_card_total( t, total, 'AUTOINC_PARAM' )
    counts%converg_params        = fstr_card_total( t, total, 'CONVERG_PARAM' )
    counts%time_points           = fstr_card_total( t, total, 'TIME_POINTS' )
    counts%materials             = fstr_card_total( t, total, 'MATERIAL' )
  end function fstr_setup_card_counts
 
  subroutine fstr_setup_read_cards( ctrl, T, ipass, total, P )
    implicit none
    integer(kind=kint) :: ctrl
    type(fstr_card_table), intent(in) :: T
    integer(kind=kint), intent(in) :: ipass
    integer(kind=kint), intent(inout) :: total(:)
    type(fstr_param_pack) :: P
 
    integer(kind=kint) :: ctrl_list(20), ictrl, rcode, ierror, k, s
    integer(kind=kint) :: pos(size(total))
    character(len=HECMW_NAME_LEN) :: header_name
    character(len=HECMW_FILENAME_LEN) :: input_filename
 
    pos(:) = 0
    ctrl_list = 0
    ictrl = 1
    do
      rcode = fstr_ctrl_get_c_h_name( ctrl, header_name, hecmw_name_len )
      if( header_name == '!INCLUDE' ) then
        ctrl_list(ictrl) = ctrl
        input_filename   = ""
        ierror = fstr_ctrl_get_param_ex( ctrl, 'INPUT ', '# ', 0, 'F', input_filename )
        ctrl   = fstr_ctrl_open( input_filename )
        if( ctrl < 0 ) then
          write(*,*) '### Error: Cannot open FSTR control file : ', input_filename
          write(ilog,*) '### Error: Cannot open FSTR control file : ', input_filename
          stop hecmw_exit_input
        end if
        ictrl = ictrl + 1
        cycle
      else if( header_name == '!END' ) then
        exit
      end if
 
      k = fstr_card_find( t, header_name(2:), p%STATE%version )
      if( k > 0 ) then
        if( ipass == 1 .or. associated(t%card(k)%second) ) then
          s = t%card(k)%seq
          p%STATE%slot%first = pos(s) + 1
          if( t%card(k)%by_line ) then
            pos(s) = pos(s) + fstr_ctrl_get_data_line_n( ctrl )
          else
            pos(s) = pos(s) + 1
          endif
          p%STATE%slot%last = pos(s)
          if( ipass == 2 .and. pos(s) > total(s) ) call fstr_setup_util_err_stop( '### Error: '// &
            trim(header_name)//' : more than counted in the first reading of the control file' )
          if( ipass == 1 .and. associated(t%card(k)%first) ) call t%card(k)%first( ctrl, p )
          if( ipass == 2 ) call t%card(k)%second( ctrl, p )
        endif
      endif
 
      ! next
      if( fstr_ctrl_seek_next_header(ctrl) == 0 )then
        if( ictrl == 1 )then
          exit
        else
          ierror= fstr_ctrl_close( ctrl )
          ictrl = ictrl - 1
          ctrl  = ctrl_list(ictrl)
          if( fstr_ctrl_seek_next_header(ctrl) == 0 ) exit
        endif
      endif
    end do
    if( ipass == 1 ) total(:) = pos(:)
  end subroutine fstr_setup_read_cards
 
  subroutine fstr_couple_finalize( C )
    implicit none
    type( fstr_couple ) :: C
    if(associated(c%coupled_node)) deallocate(c%coupled_node)
    if(associated(c%trac)) deallocate(c%trac)
    if(associated(c%disp)) deallocate(c%disp)
    if(associated(c%velo)) deallocate(c%velo)
    if(associated(c%accel)) deallocate(c%accel)
    if(associated(c%index)) deallocate(c%index)
  end subroutine fstr_couple_finalize
 
end module m_fstr_setup