fistr_main.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_main
 
  use hecmw
  use m_fstr
  use m_hecmw2fstr_mesh_conv
  use m_fstr_setup
  use m_fstr_solve_heat
  use m_fstr_solve_nlgeom
  use m_fstr_solve_eigen
  use m_static_echo
  use m_heat_init
  use m_heat_echo
  use m_fstr_precheck
  use m_fstr_rcap_io
  use fstr_solver_dynamic
 
  type(hecmwst_local_mesh), save             :: hecmesh
  type(hecmwst_matrix), save                 :: hecmat
  type(hecmwst_matrix), save                 :: conmat
  type(fstr_solid), save                     :: fstrsolid
  type(hecmwst_matrix_lagrange), save        :: heclagmat
  type(fstr_heat), save                      :: fstrheat
  type(fstr_eigen), save                     :: fstreig
  type(fstr_dynamic), save                   :: fstrdynamic
  type(hecmwst_result_data), save            :: fstrresult
  type(fstr_couple), save                    :: fstrcpl
  type(fstr_freqanalysis), save              :: fstrfreq
  character(len=HECMW_FILENAME_LEN)          :: name_id
 
contains
 
  subroutine fstr_main() bind(C,NAME='fstr_main')
    implicit none
    real(kind=kreal) :: t1, t2, t3
 
    t1=0.0d0; t2=0.0d0; t3=0.0d0
 
    ! =============== INITIALIZE ===================
 
    call hecmw_init
    myrank = hecmw_comm_get_rank()
    nprocs = hecmw_comm_get_size()
 
    t1 = hecmw_wtime()
 
    name_id = 'fstrMSH'
    call hecmw_get_mesh( name_id , hecmesh )
 
    if( hecmesh%contact_pair%n_pair > 0 ) then
      paracontactflag = .true.
      if( myrank == 0 ) then
        print *,'paraContactFlag',paracontactflag
      endif
    endif
 
    call hecmw2fstr_mesh_conv( hecmesh )
 
    call fstr_init
 
    call fstr_rcap_initialize( hecmesh, fstrpr, fstrcpl )
 
    t2 = hecmw_wtime()
 
    ! =============== ANALYSIS =====================
 
    select case( fstrpr%solution_type )
      case( kststatic )
        call fstr_static_analysis
      case( kstdynamic )
        call fstr_dynamic_analysis
      case( ksteigen )
        call fstr_eigen_analysis
      case( kstheat )
        call fstr_heat_analysis
      case( kststaticeigen )
        call fstr_static_eigen_analysis
    end select
 
    t3 = hecmw_wtime()
 
    if(hecmesh%my_rank==0) then
      write(*,*)
      write(*,*)           '===================================='
      write(*,'(a,f10.2)') '    TOTAL TIME (sec) :', t3 - t1
      write(*,'(a,f10.2)') '           pre (sec) :', t2 - t1
      write(*,'(a,f10.2)') '         solve (sec) :', t3 - t2
      write(*,*)           '===================================='
 
      write(imsg,*)           '===================================='
      write(imsg,'(a,f10.2)') '    TOTAL TIME (sec) :', t3 - t1
      write(imsg,'(a,f10.2)') '           pre (sec) :', t2 - t1
      write(imsg,'(a,f10.2)') '         solve (sec) :', t3 - t2
      write(imsg,*)           '===================================='
    endif
 
    ! =============== FINALIZE =====================
 
    call fstr_rcap_finalize( fstrpr, fstrcpl )
    call fstr_finalize()
    call hecmw_dist_free(hecmesh)
    call hecmw_finalize
    if(hecmesh%my_rank==0) write(*,*) 'FrontISTR Completed !!'
 
  end subroutine fstr_main
 
  !=============================================================================!
  !=============================================================================!
 
  subroutine fstr_init
    implicit none
 
    ! set pointer to null
    call hecmw_nullify_matrix     ( hecmat      )
    call hecmw_nullify_matrix     ( conmat      )
    call hecmw_nullify_result_data( fstrresult  )
    call fstr_nullify_fstr_param  ( fstrpr      )
    call fstr_nullify_fstr_solid  ( fstrsolid   )
    call fstr_nullify_fstr_heat   ( fstrheat    )
    call fstr_nullify_fstr_eigen  ( fstreig     )
    call fstr_nullify_fstr_dynamic( fstrdynamic )
    call fstr_nullify_fstr_couple ( fstrcpl     )
    call fstr_init_file
 
    ! ----  default setting of global params ---
    dt    = 1
    etime = 1
    itmax = 20
    eps   = 1.0d-6
 
    ! -------  global pointer setting ----------
    ref_temp => fstrpr%ref_temp
    iecho    => fstrpr%fg_echo
    iresult  => fstrpr%fg_result
    ivisual  => fstrpr%fg_visual
 
    ! for heat ...
    ineutral => fstrpr%fg_neutral
    irres    => fstrpr%fg_irres
    iwres    => fstrpr%fg_iwres
    nrres    => fstrpr%nrres
    nprint   => fstrpr%nprint
 
 
    ! ------- initial value setting -------------
    call fstr_mat_init  ( hecmat   )
    call fstr_param_init( fstrpr, hecmesh )
 
    call fstr_solid_init( hecmesh, fstrsolid )
    call fstr_eigen_init( fstreig )
    call fstr_heat_init ( fstrheat  )
    call fstr_dynamic_init( fstrdynamic  )
 
    ! ------- scan cnt file -------------
    call fstr_init_condition
 
    ! ------- hecMAT setting -------------
    call hecmw_mat_con(hecmesh, hecmat)
    hecmat%NDOF = hecmesh%n_dof
    if( kstheat == fstrpr%solution_type ) then
      call heat_init_material (hecmesh,fstrheat)
      call heat_init_amplitude(hecmesh,fstrheat)
      hecmat%NDOF = 1
    endif
    call hecmat_init( hecmat )
  end subroutine fstr_init
 
  !------------------------------------------------------------------------------
  subroutine fstr_init_file
    implicit none
    character(len=HECMW_FILENAME_LEN) :: s, r
    character(len=HECMW_FILENAME_LEN) :: stafileNAME
    character(len=HECMW_FILENAME_LEN) :: logfileNAME
    character(len=HECMW_FILENAME_LEN) :: msgfileNAME
    character(len=HECMW_FILENAME_LEN) :: dbgfileNAME
    integer :: stat, flag, limit, irank
 
    ! set file name --------------------------------
    call hecmw_ctrl_is_subdir( flag, limit )
    write(s,*) myrank
    if( flag == 0 ) then
      write( logfilename, '(a,a)') trim(adjustl(s)), '.log'
      logfilename = adjustl(logfilename)
      write( dbgfilename, '(a,a)') 'FSTR.dbg.', trim(adjustl(s))
      dbgfilename = adjustl(dbgfilename)
    else
      if( nprocs > limit ) then
        irank = myrank / limit
        write(r,*) irank
        write( logfilename, '(a,a,a,a,a)') 'LOG/TRUNK', trim(adjustl(r)), '/', trim(adjustl(s)), '.log'
        logfilename = adjustl(logfilename)
        call hecmw_ctrl_make_subdir( logfilename, stat )
        if( stat /= 0 ) call fstr_setup_util_err_stop( '### Cannot create directory' )
        write( dbgfilename, '(a,a,a,a,a)') 'DBG/TRUNK', trim(adjustl(r)), '/', 'FSTR.dbg.', trim(adjustl(s))
        dbgfilename = adjustl(dbgfilename)
        call hecmw_ctrl_make_subdir( dbgfilename, stat )
        if( stat /= 0 ) call fstr_setup_util_err_stop( '### Cannot create directory' )
      else
        write( logfilename, '(a,a,a)') 'LOG/', trim(adjustl(s)), '.log'
        logfilename = adjustl(logfilename)
        call hecmw_ctrl_make_subdir( logfilename, stat )
        if( stat /= 0 ) call fstr_setup_util_err_stop( '### Cannot create directory' )
        write( dbgfilename, '(a,a,a)') 'DBG/', 'FSTR.dbg.', trim(adjustl(s))
        dbgfilename = adjustl(dbgfilename)
        call hecmw_ctrl_make_subdir( dbgfilename, stat )
        if( stat /= 0 ) call fstr_setup_util_err_stop( '### Cannot create directory' )
      endif
    endif
    stafilename = 'FSTR.sta'
    msgfilename = 'FSTR.msg'
 
    ! open & opening message out -------------------
    ! MSGFILE
    if( myrank == 0) then
      open(imsg, file=msgfilename, status='replace', iostat=stat)
      if( stat /= 0 ) then
        call fstr_setup_util_err_stop( '### Cannot open message file :'//msgfilename )
      endif
      write(imsg,*) ':========================================:'
      write(imsg,*) ':**   BEGIN FSTR Structural Analysis   **:'
      write(imsg,*) ':========================================:'
      write(imsg,*) '        Total no. of processors: ',nprocs
      write(imsg,*)
      write(imsg,*)
      write(imsg,*)
      write(imsg,*) ' *    STAGE Initialization and input   **'
    endif
 
    ! LOGFILE & STAFILE
    open (ilog, file = logfilename, status = 'replace', iostat=stat )
    if( stat /= 0 ) then
      call fstr_setup_util_err_stop( '### Cannot open log file :'//logfilename )
    endif
 
    if( myrank == 0 ) then
      open (ista,file = stafilename, status = 'replace', iostat=stat )
      write(ista,'(''####'',a80)') stafilename
      if( stat /= 0 ) then
        call fstr_setup_util_err_stop( '### Cannot open status file :'//stafilename )
      endif
    endif
 
    open (idbg,file = dbgfilename, status = 'replace', iostat=stat)
    write(idbg,'(''####'',a80)') dbgfilename
    if( stat /= 0 ) then
      call fstr_setup_util_err_stop( '### Cannot open debug file :'//dbgfilename )
    endif
  end subroutine fstr_init_file
 
  !------------------------------------------------------------------------------
  subroutine fstr_init_condition
    implicit none
    character(len=HECMW_FILENAME_LEN) :: cntfileNAME
 
    name_id='fstrCNT'
    call hecmw_ctrl_get_control_file( name_id, cntfilename )
 
    ! loading boundary conditions etc. from fstr control file or nastran mesh file
    ! and setup parameters ...
    svrarray(:) = hecmat%Rarray(:)
    sviarray(:) = hecmat%Iarray(:)
 
    call fstr_setup( cntfilename, hecmesh, fstrpr, fstrsolid, fstreig, fstrheat, fstrdynamic, fstrcpl, fstrfreq )
 
    hecmat%Rarray(:) = svrarray(:)
    hecmat%Iarray(:) = sviarray(:)
 
    call fstr_input_precheck( hecmesh, hecmat, fstrsolid )
 
    if( myrank == 0) write(*,*) 'fstr_setup: OK'
    write(ilog,*) 'fstr_setup: OK'
    call flush(6)
 
  end subroutine fstr_init_condition
 
  !=============================================================================!
  !=============================================================================!
 
  subroutine fstr_static_analysis
    implicit none
 
    if( iecho.eq.1 ) call fstr_echo(hecmesh)
 
    if(myrank .EQ. 0) then
      write(imsg,*)
      write(imsg,*)
      write(imsg,*)
    endif
 
    if( fstrpr%nlgeom ) then
      if( myrank == 0)  write(imsg,*) ' ***   STAGE Non Linear static analysis   **'
    else
      if( myrank == 0 ) write(imsg,*) ' ***   STAGE Linear static analysis   **'
    endif
 
    call fstr_solve_nlgeom( hecmesh, hecmat, fstrsolid, heclagmat, fstrpr, conmat )
 
    call fstr_solid_finalize( fstrsolid )
 
  end subroutine fstr_static_analysis
 
  !=============================================================================!
  !=============================================================================!
 
  subroutine fstr_eigen_analysis
    use hecmw
    use m_fstr
    implicit none
 
    if( iecho.eq.1 ) call fstr_echo(hecmesh)
    if(myrank .EQ. 0) then
      write(imsg,*)
      write(imsg,*)
      write(imsg,*)
      write(imsg,*) ' ***   STAGE Eigenvalue analysis     **'
    endif
 
    call fstr_solve_eigen( hecmesh, hecmat, fstreig, fstrsolid, fstrresult, fstrpr, heclagmat )
 
  end subroutine fstr_eigen_analysis
 
  !=============================================================================!
  !=============================================================================!
 
  subroutine fstr_heat_analysis
    implicit none
 
    if( iecho.eq.1 ) call heat_echo(fstrpr,hecmesh,fstrheat)
    if(myrank .EQ. 0) then
      write(imsg,*)
      write(imsg,*)
      write(imsg,*)
      write(imsg,*) ' ***   STAGE Heat analysis    **'
    endif
 
    call fstr_solve_heat( hecmesh, hecmat, fstrsolid, fstrresult, fstrpr, fstrheat )
 
  end subroutine fstr_heat_analysis
 
  !=============================================================================!
  !=============================================================================!
 
  subroutine fstr_dynamic_analysis
    implicit none
 
    if( iecho.eq.1 ) call fstr_echo(hecmesh)
 
    if(myrank == 0) then
      write(imsg,*)
      write(imsg,*)
      write(imsg,*)
      if( fstrpr%nlgeom ) then
        write(imsg,*) ' ***   STAGE Nonlinear dynamic analysis   **'
      else
        write(imsg,*) ' ***   STAGE Linear dynamic analysis   **'
      endif
    endif
 
    call fstr_solve_dynamic( hecmesh, hecmat, fstrsolid, fstreig, &
      fstrdynamic, fstrresult, fstrpr, fstrcpl, fstrfreq, heclagmat, &
      conmat )
 
  end subroutine fstr_dynamic_analysis
 
  !=============================================================================!
  !=============================================================================!
 
  subroutine fstr_static_eigen_analysis
    implicit none
 
    if( iecho==1 ) call fstr_echo(hecmesh)
 
    if(myrank == 0) then
      write(imsg,*)
      write(imsg,*)
      write(imsg,*)
      write(imsg,*) ' ***   STAGE Static -> Eigen analysis   **'
      write(*,*) ' ***   STAGE Static -> Eigen analysis   **'
      write(imsg,*)
      write(imsg,*) ' ***   Stage 1: Nonlinear static analysis  **'
      write(*,*) ' ***   Stage 1: Nonlinear static analysis   **'
    endif
 
    call fstr_solve_nlgeom( hecmesh, hecmat, fstrsolid, heclagmat, fstrpr, conmat )
 
    if(myrank == 0) then
      write(imsg,*)
      write(imsg,*) ' ***   Stage 2: Eigenvalue analysis  **'
      write(*,*)
      write(*,*) ' ***   Stage 2: Eigenvalue analysis   **'
    endif
 
    call fstr_solve_eigen( hecmesh, hecmat, fstreig, fstrsolid, fstrresult, fstrpr, heclagmat )
 
    call fstr_solid_finalize( fstrsolid )
 
  end subroutine fstr_static_eigen_analysis
 
  !=============================================================================!
  !=============================================================================!
 
  subroutine fstr_finalize
    implicit none
 
    if( myrank == 0 ) then
      write(imsg,*)
      write(imsg,*)
      write(imsg,*)
      write(imsg,*) ':========================================:'
      write(imsg,*) ':**            END of FSTR             **:'
      write(imsg,*) ':========================================:'
      close(imsg)
      close(ista)
    endif
 
    call fstr_solid_finalize( fstrsolid )
    call hecmat_finalize( hecmat )
 
    close(ilog)
    close(idbg)
  end subroutine fstr_finalize
 
end module m_fstr_main