static_output.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_static_output
  implicit none
contains
 
  !----------------------------------------------------------------------*
  subroutine fstr_static_output( cstep, istep, time, hecMESH, fstrSOLID, fstrPARAM, flag, outflag, dtime )
    !----------------------------------------------------------------------*
    use m_fstr
    use m_fstr_nodalstress
    use m_make_result
    use m_hecmw2fstr_mesh_conv
    use mcontact
    integer, intent(in)                   :: cstep
    integer, intent(in)                   :: istep
    real(kind=kreal), intent(in)          :: time        
    type (hecmwST_local_mesh), intent(in) :: hecMESH
    type (fstr_solid), intent(inout)      :: fstrSOLID
    type (fstr_param       )              :: fstrPARAM
    integer, intent(in)                   :: flag
    logical, intent(in)                   :: outflag
    real(kind=kreal), optional, intent(in) :: dtime       
 
    type ( hecmwST_result_data ) :: fstrRESULT
    integer(kind=kint) :: i, j, ndof, fnum, is, iE, gid
 
    ndof = hecmesh%n_dof
 
    if( fstrsolid%TEMP_ngrp_tot>0 .or. fstrsolid%TEMP_irres>0 ) then
      if( ndof==3 ) then
        if( .not. associated(fstrsolid%tnstrain) ) allocate( fstrsolid%tnstrain(hecmesh%n_node*6) )
        if( .not. associated(fstrsolid%testrain) ) allocate( fstrsolid%testrain(hecmesh%n_elem*6) )
      else if( ndof==2 ) then
        if( .not. associated(fstrsolid%tnstrain) ) allocate( fstrsolid%tnstrain(hecmesh%n_node*3) )
        if( .not. associated(fstrsolid%testrain) ) allocate( fstrsolid%testrain(hecmesh%n_elem*3) )
      endif
    endif
 
    if( ndof==3 ) then
      call fstr_nodalstress3d( hecmesh, fstrsolid )
    else if( ndof==2 ) then
      call fstr_nodalstress2d( hecmesh, fstrsolid )
    else if( ndof==6 ) then
      call fstr_nodalstress6d( hecmesh, fstrsolid )
    endif
 
    if( associated( fstrsolid%contacts ) ) then
      call setup_contact_output_variables( hecmesh, fstrsolid, -1 )
    endif
 
    if( flag==kststaticeigen ) then
      if( iresult==1 .and. &
          (mod(istep,fstrsolid%output_ctrl(3)%frequency)==0 .or. outflag) ) then
        call fstr_write_result( hecmesh, fstrsolid, fstrparam, istep, time, 1 )
      endif
      return
    endif
 
    if( iresult==1 .and. &
        (mod(istep,fstrsolid%output_ctrl(3)%frequency)==0 .or. outflag) ) then
      if( associated( fstrsolid%contacts ) ) then
        if( present(dtime) ) then
          call setup_contact_output_variables( hecmesh, fstrsolid, 3, dtime )
        else
          call setup_contact_output_variables( hecmesh, fstrsolid, 3, fstrsolid%step_ctrl(cstep)%initdt )
        endif
      endif
      call fstr_write_result( hecmesh, fstrsolid, fstrparam, istep, time, 0 )
    endif
 
    if( ivisual==1 .and. &
        (mod(istep,fstrsolid%output_ctrl(4)%frequency)==0 .or. outflag) ) then
 
      if( associated( fstrsolid%contacts ) ) then
        if( present(dtime) ) then
          call setup_contact_output_variables( hecmesh, fstrsolid, 4, dtime )
        else
          call setup_contact_output_variables( hecmesh, fstrsolid, 4, fstrsolid%step_ctrl(cstep)%initdt )
        endif
      endif
      call fstr_make_result( hecmesh, fstrsolid, fstrresult, istep, time )
      call fstr2hecmw_mesh_conv( hecmesh )
      call hecmw_visualize_init
      call hecmw_visualize( hecmesh, fstrresult, istep )
      call hecmw_visualize_finalize
      call hecmw2fstr_mesh_conv( hecmesh )
      call hecmw_result_free( fstrresult )
    endif
 
    if( (mod(istep,fstrsolid%output_ctrl(1)%frequency)==0 .or. outflag) ) then
      fnum = fstrsolid%output_ctrl(1)%filenum
      call fstr_static_post( fnum, hecmesh, fstrsolid, istep )
    endif
 
    if( fstrsolid%output_ctrl(2)%outinfo%grp_id>0 .and. &
        (mod(istep,fstrsolid%output_ctrl(2)%frequency)==0 .or. outflag) ) then
      is = fstrsolid%output_ctrl(2)%outinfo%grp_id
      fnum = fstrsolid%output_ctrl(2)%filenum
      do i = hecmesh%node_group%grp_index(is-1)+1, hecmesh%node_group%grp_index(is)
        ie = hecmesh%node_group%grp_item(i)
        gid = hecmesh%global_node_ID(ie)
        write(fnum,'(2i10,1p6e15.7)') istep,gid,(fstrsolid%unode(ndof*(ie-1)+j),j=1,ndof)
      enddo
    endif
 
  end subroutine fstr_static_output
 
  !----------------------------------------------------------------------*
  subroutine fstr_static_post( fnum, hecMESH, fstrSOLID, istep )
    !----------------------------------------------------------------------*
    use m_fstr
    integer, intent(in)                   :: fnum, istep
    type (hecmwST_local_mesh), intent(in) :: hecMESH
    type (fstr_solid), intent(in)         :: fstrSOLID
 
    real(kind=kreal)   :: umax(6), umin(6), emax(14), emin(14), smax(14), smin(14)
    real(kind=kreal)   :: mmax(1), mmin(1), emmax(1), emmin(1)
    real(kind=kreal)   :: eemax(14), eemin(14), esmax(14), esmin(14)
 
    real(kind=kreal)   :: gumax(6), gumin(6), gemax(14), gemin(14), gsmax(14), gsmin(14)
    real(kind=kreal)   :: gmmax(1), gmmin(1), gemmax(1), gemmin(1)
    real(kind=kreal)   :: geemax(14), geemin(14), gesmax(14), gesmin(14)
 
    integer(kind=kint) :: IUmax(6), IUmin(6), IEmax(14), IEmin(14), ISmax(14), ISmin(14)
    integer(kind=kint) :: IMmax(1), IMmin(1), IEMmax(1), IEMmin(1)
    integer(kind=kint) :: IEEmax(14), IEEmin(14), IESmax(14), IESmin(14)
    integer(kind=kint) :: i, j, k, ndof, mdof, ID_area
    integer(kind=kint) :: label(6)
 
    ndof = hecmesh%n_dof
 
    write( fnum, '(''#### Result step='',I6)') istep
    select case (ndof)
      case (2)
        mdof = 3
        label(1)=11;label(2)=22
        label(3)=12
      case (3,6)
        mdof = 6
        label(1)=11;label(2)=22;label(3)=33;
        label(4)=12;label(5)=23;label(6)=31;
    end select
 
    j = hecmesh%global_node_ID(1)
    do k = 1, ndof
      umax(k) = fstrsolid%unode(k); umin(k) = fstrsolid%unode(k)
      iumax(k)= j; iumin(k)= j
    enddo
    do k = 1, mdof
      emax(k) = fstrsolid%STRAIN(k);   emin(k) = fstrsolid%STRAIN(k)
      smax(k) = fstrsolid%STRESS(k);   smin(k) = fstrsolid%STRESS(k)
      eemax(k) = fstrsolid%ESTRAIN(k); eemin(k) = fstrsolid%ESTRAIN(k)
      esmax(k) = fstrsolid%ESTRESS(k); esmin(k) = fstrsolid%ESTRESS(k)
      iemax(k)= j;  iemin(k)= j;  ismax(k)= j;  ismin(k)= j
      ieemax(k)= j; ieemin(k)= j; iesmax(k)= j; iesmin(k)= j
    enddo
    mmax(1) = fstrsolid%MISES(1); mmin(1) = fstrsolid%MISES(1)
    emmax(1) = fstrsolid%EMISES(1); emmin(1) = fstrsolid%EMISES(1)
    immax(1)= j; immin(1)= j; iemmax(1)= j; iemmin(1)= j
 
    !C*** Show Displacement
    do i = 1, hecmesh%nn_internal
      if(fstrsolid%is_rot(i)==1)cycle
      j = hecmesh%global_node_ID(i)
      do k = 1, ndof
        if     ( fstrsolid%unode(ndof*(i-1)+k) > umax(k) ) then
          umax(k) = fstrsolid%unode(ndof*(i-1)+k)
          iumax(k)= j
        else if( fstrsolid%unode(ndof*(i-1)+k) < umin(k) ) then
          umin(k) = fstrsolid%unode(ndof*(i-1)+k)
          iumin(k)= j
        endif
      enddo
    enddo
    !C*** Nodal Strain / Stress / MISES
    !C @node
    do i = 1, hecmesh%nn_internal
      if(fstrsolid%is_rot(i)==1)cycle
      j = hecmesh%global_node_ID(i)
      do k = 1, mdof
        if     ( fstrsolid%STRAIN(mdof*(i-1)+k) > emax(k) ) then
          emax(k) = fstrsolid%STRAIN(mdof*(i-1)+k)
          iemax(k)= j
        else if( fstrsolid%STRAIN(mdof*(i-1)+k) < emin(k) ) then
          emin(k) = fstrsolid%STRAIN(mdof*(i-1)+k)
          iemin(k)= j
        endif
        if     ( fstrsolid%STRESS(mdof*(i-1)+k) > smax(k) ) then
          smax(k) = fstrsolid%STRESS(mdof*(i-1)+k)
          ismax(k)= j
        else if( fstrsolid%STRESS(mdof*(i-1)+k) < smin(k) ) then
          smin(k) = fstrsolid%STRESS(mdof*(i-1)+k)
          ismin(k)= j
        endif
      enddo
      if     ( fstrsolid%MISES(i) > mmax(1) ) then
        mmax(1) = fstrsolid%MISES(i)
        immax(1)= j
      else if( fstrsolid%MISES(i) < mmin(1) ) then
        mmin(1) = fstrsolid%MISES(i)
        immin(1)= j
      endif
    enddo
    !C*** Elemental Strain / STRESS
    do i = 1, hecmesh%n_elem
      id_area = hecmesh%elem_ID(i*2)
      if( id_area==hecmesh%my_rank ) then
        j = hecmesh%global_elem_ID(i)
        do k = 1, mdof
          if( fstrsolid%ESTRAIN(mdof*(i-1)+k) > eemax(k) ) then
            eemax(k) = fstrsolid%ESTRAIN(mdof*(i-1)+k)
            ieemax(k)= j
          else if( fstrsolid%ESTRAIN(mdof*(i-1)+k) < eemin(k) ) then
            eemin(k) = fstrsolid%ESTRAIN(mdof*(i-1)+k)
            ieemin(k)= j
          endif
          if( fstrsolid%ESTRESS(mdof*(i-1)+k) > esmax(k) ) then
            esmax(k) = fstrsolid%ESTRESS(mdof*(i-1)+k)
            iesmax(k)= j
          else if( fstrsolid%ESTRESS(mdof*(i-1)+k) < esmin(k) ) then
            esmin(k) = fstrsolid%ESTRESS(mdof*(i-1)+k)
            iesmin(k)= j
          endif
        enddo
        if( fstrsolid%EMISES(i) > emmax(1) ) then
          emmax(1) = fstrsolid%EMISES(i)
          iemmax(1)= j
        else if( fstrsolid%EMISES(i) < emmin(1) ) then
          emmin(1) = fstrsolid%EMISES(i)
          iemmin(1)= j
        endif
      endif
    enddo
 
 
    write(ilog,*)    '##### Local Summary @Node    :Max/IdMax/Min/IdMin####'
    do i = 1, ndof; write(ilog,1029) ' //U',i,      '  ',umax(i),iumax(i),umin(i),iumin(i);     end do
    do i = 1, mdof; write(ilog,1029) ' //E',label(i),' ',emax(i),iemax(i),emin(i),iemin(i);     end do
    do i = 1, mdof; write(ilog,1029) ' //S',label(i),' ',smax(i),ismax(i),smin(i),ismin(i);     end do
    write(ilog,1009) '//SMS '           ,mmax(1),immax(1),mmin(1),immin(1)
    write(ilog,*)    '##### Local Summary @Element :Max/IdMax/Min/IdMin####'
    do i = 1, mdof; write(ilog,1029) ' //E',label(i),' ',eemax(i),ieemax(i),eemin(i),ieemin(i); end do
    do i = 1, mdof; write(ilog,1029) ' //S',label(i),' ',esmax(i),iesmax(i),esmin(i),iesmin(i); end do
    write(ilog,1009) '//SMS '           ,emmax(1),iemmax(1),emmin(1),iemmin(1)
 
    !C*** Show Summary
    gumax  = umax; gumin  = umin;
    gemax  = emax; gemin  = emin; geemax = eemax; geemin = eemin;
    gsmax  = smax; gsmin  = smin; gesmax = esmax; gesmin = esmin;
    gmmax  = mmax; gmmin  = mmin; gemmax = emmax; gemmin = emmin;
 
    call hecmw_allreduce_r(hecmesh,gumax,ndof,hecmw_max)
    call hecmw_allreduce_r(hecmesh,gumin,ndof,hecmw_min)
    call hecmw_allreduce_r(hecmesh,gemax,mdof,hecmw_max)
    call hecmw_allreduce_r(hecmesh,gemin,mdof,hecmw_min)
    call hecmw_allreduce_r(hecmesh,gsmax,mdof,hecmw_max)
    call hecmw_allreduce_r(hecmesh,gsmin,mdof,hecmw_min)
    call hecmw_allreduce_r(hecmesh,gmmax,1,hecmw_max)
    call hecmw_allreduce_r(hecmesh,gmmin,1,hecmw_min)
    call hecmw_allreduce_r(hecmesh,geemax,mdof,hecmw_max)
    call hecmw_allreduce_r(hecmesh,geemin,mdof,hecmw_min)
    call hecmw_allreduce_r(hecmesh,gesmax,mdof,hecmw_max)
    call hecmw_allreduce_r(hecmesh,gesmin,mdof,hecmw_min)
    call hecmw_allreduce_r(hecmesh,gemmax,1,hecmw_max)
    call hecmw_allreduce_r(hecmesh,gemmin,1,hecmw_min)
 
    do i=1,ndof
      if(gumax(i) > umax(i)) iumax(i) = 0
      if(gumin(i) < umin(i)) iumin(i) = 0
    enddo
    do i=1,mdof
      if(gemax(i) > emax(i)) iemax(i) = 0
      if(gsmax(i) > smax(i)) ismax(i) = 0
      if(geemax(i) > eemax(i)) ieemax(i) = 0
      if(gesmax(i) > esmax(i)) iesmax(i) = 0
      if(gemin(i) < emin(i)) iemin(i) = 0
      if(gsmin(i) < smin(i)) ismin(i) = 0
      if(geemin(i) < eemin(i)) ieemin(i) = 0
      if(gesmin(i) < esmin(i)) iesmin(i) = 0
    enddo
    do i=1,1
      if(gmmax(i) > mmax(i)) immax(i) = 0
      if(gemmax(i) > emmax(i)) iemmax(i) = 0
      if(gmmin(i) < mmin(i)) immin(i) = 0
      if(gemmin(i) < emmin(i)) iemmin(i) = 0
    enddo
 
    call hecmw_allreduce_i(hecmesh,iumax,ndof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,iumin,ndof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,iemax,mdof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,iemin,mdof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,ismax,mdof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,ismin,mdof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,immax,1,hecmw_max)
    call hecmw_allreduce_i(hecmesh,immin,1,hecmw_max)
    call hecmw_allreduce_i(hecmesh,ieemax,mdof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,ieemin,mdof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,iesmax,mdof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,iesmin,mdof,hecmw_max)
    call hecmw_allreduce_i(hecmesh,iemmax,1,hecmw_max)
    call hecmw_allreduce_i(hecmesh,iemmin,1,hecmw_max)
 
    if( hecmesh%my_rank==0 ) then
      write(ilog,*)    '##### Global Summary @Node    :Max/IdMax/Min/IdMin####'
      do i = 1, ndof; write(ilog,1029) ' //U',i,      '  ',gumax(i),iumax(i),gumin(i),iumin(i);     end do
      do i = 1, mdof; write(ilog,1029) ' //E',label(i),' ',gemax(i),iemax(i),gemin(i),iemin(i);     end do
      do i = 1, mdof; write(ilog,1029) ' //S',label(i),' ',gsmax(i),ismax(i),gsmin(i),ismin(i);     end do
      write(ilog,1009) '//SMS '           ,gmmax(1),immax(1),gmmin(1),immin(1)
      write(ilog,*)    '##### Global Summary @Element :Max/IdMax/Min/IdMin####'
      do i = 1, mdof; write(ilog,1029) ' //E',label(i),' ',geemax(i),ieemax(i),geemin(i),ieemin(i); end do
      do i = 1, mdof; write(ilog,1029) ' //S',label(i),' ',gesmax(i),iesmax(i),gesmin(i),iesmin(i); end do
      write(ilog,1009) '//SMS '           ,gemmax(1),iemmax(1),gemmin(1),iemmin(1)
    endif
 
    1009 format(a7,1pe12.4,i10,1pe12.4,i10)
    1029 format(a,i0,a,1pe12.4,i10,1pe12.4,i10)
  end subroutine fstr_static_post
 
end module m_static_output