heat_io.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_heat_io
 
contains
 
  subroutine heat_input_restart(fstrHEAT, hecMESH, istep, tstep, tt)
    use m_fstr
    implicit none
    type(hecmwst_local_mesh)  :: hecMESH
    type(fstr_heat)           :: fstrHEAT
    integer(kind=kint) :: restart_istep(1)
    integer(kind=kint) :: restart_step(1)
    real(kind=kreal)   :: restart_time(1)
    integer(kind=kint) :: i, istep, tstep
    real(kind=kreal)   :: tt
 
    if(fstrheat%restart_nout < 0)then
      fstrheat%restart_nout = -fstrheat%restart_nout
      call hecmw_restart_open()
      call hecmw_restart_read_int(restart_istep)
      call hecmw_restart_read_int(restart_step)
      call hecmw_restart_read_real(restart_time)
      call hecmw_restart_read_real(fstrheat%TEMP0)
      call hecmw_restart_close()
      istep = restart_istep(1)
      tstep = restart_step(1) + 1
      tt = restart_time(1)
 
      do i = 1, hecmesh%n_node
        fstrheat%TEMPC(i)= fstrheat%TEMP0(i)
        fstrheat%TEMP (i)= fstrheat%TEMP0(i)
      enddo
      write(ilog,*) ' Restart read of temperatures: OK'
    endif
  end subroutine heat_input_restart
 
  subroutine heat_output_log(hecMESH, fstrPARAM, fstrHEAT, tstep, ctime)
    use m_fstr
    implicit none
    type(hecmwst_local_mesh)  :: hecmesh
    type(fstr_heat)           :: fstrHEAT
    type(fstr_param)          :: fstrPARAM
    integer(kind=kint) :: i, in, inod, tstep, nmax, nmin
    real(kind=kreal)   :: temp, ctime, tmax, tmin
 
    tmax = -1.0d10
    tmin =  1.0d10
    nmax = -1
    nmin = -1
 
    write(ilog,*)
    write(ilog,'(a,i6)')    ' ISTEP =', tstep
    write(ilog,'(a,f10.3)') ' Time  =', ctime
 
    do i = 1, hecmesh%nn_internal
      inod = fstrparam%global_local_id(1,i)
      in = fstrparam%global_local_id(2,i)
      temp = fstrheat%TEMP(in)
      if(tmax < temp)then
        tmax = temp
        nmax = inod
      endif
      if(temp < tmin)then
        tmin = temp
        nmin = inod
      endif
    enddo
 
    write(ilog,'(a,f10.3,i10)') ' Maximum Temperature :', tmax
    write(ilog,'(a,i10)')       ' Maximum Node No.    :', nmax
    write(ilog,'(a,f10.3,i10)') ' Minimum Temperature :', tmin
    write(ilog,'(a,i10)')       ' Minimum Node No.    :', nmin
 
    !global temperature
    call hecmw_allreduce_r1 (hecmesh, tmax, hecmw_max)
    call hecmw_allreduce_r1 (hecmesh, tmin, hecmw_min)
    if( myrank == 0 ) then
      write(ilog,'(a,f10.3,i10)') ' Maximum Temperature(global) :', tmax
      write(ilog,'(a,f10.3,i10)') ' Minimum Temperature(global) :', tmin
    end if
 
 
  end subroutine heat_output_log
 
  subroutine fstr_heat_make_result_step(hecMESH, fstrHEAT, fstrSOLID, fstrRESULT, tstep, ctime)
    use m_fstr
    use m_fstr_elemact
    implicit none
    type(hecmwst_local_mesh)  :: hecmesh
    type(fstr_heat)           :: fstrHEAT
    type(fstr_solid)          :: fstrSOLID
    type(hecmwst_result_data) :: fstrRESULT
    integer(kind=kint) :: tstep
    real(kind=kreal)   :: ctime
 
    real(kind=kreal), pointer  :: work(:)
 
    fstrresult%ng_component = 1
    fstrresult%nn_component = 1
    fstrresult%ne_component = 0
    allocate(fstrresult%ng_dof(1))
    allocate(fstrresult%global_label(1))
    allocate(fstrresult%global_val_item(1))
    fstrresult%ng_dof(1) = 1
    fstrresult%global_label(1) = 'TOTALTIME'
    fstrresult%global_val_item(1) = ctime
    allocate(fstrresult%nn_dof(1))
    allocate(fstrresult%node_label(1))
    allocate(fstrresult%node_val_item(hecmesh%n_node))
    fstrresult%nn_dof(1) = 1
    fstrresult%node_label(1) = 'TEMPERATURE'
    fstrresult%node_val_item = fstrheat%TEMP
 
    !elemact state
    if( fstrheat%elemact%ELEMACT_egrp_tot > 0 ) then
      fstrresult%ne_component = 1
      allocate(fstrresult%ne_dof(1))
      allocate(fstrresult%elem_label(1))
      allocate(fstrresult%elem_val_item(hecmesh%n_elem))
      allocate(work(hecmesh%n_elem))
      call output_elemact_flag( hecmesh, fstrsolid%elements, work )
 
      fstrresult%ne_dof(1) = 1
      fstrresult%elem_label(1) = 'ELEMACT'
      fstrresult%elem_val_item = work
      deallocate(work)
    end if
 
  end subroutine
 
  subroutine heat_output_result(hecMESH, fstrHEAT, fstrSOLID, tstep, ctime, outflag)
    use m_fstr
    use m_fstr_elemact
    implicit none
    type(hecmwst_local_mesh)  :: hecmesh
    type(fstr_heat)           :: fstrHEAT
    type(fstr_solid)          :: fstrSOLID
    integer(kind=kint) :: restart_step(1)
    real(kind=kreal)   :: restart_time(1)
    integer(kind=kint) :: i, tstep
    real(kind=kreal)   :: ctime, work_time(1)
    logical, intent(in)       :: outflag
    character(len=HECMW_HEADER_LEN) :: header
    character(len=HECMW_MSG_LEN)    :: comment
    character(len=HECMW_NAME_LEN)   :: label
    character(len=HECMW_NAME_LEN)   :: nameID
    real(kind=kreal), pointer  :: work(:)
 
    if(iresult == 1 .and. (mod(tstep, irres) == 0 .or. outflag))then
      header = '*fstrresult'
      comment = 'nonsteady_heat_result'
      call hecmw_result_init(hecmesh, tstep, header, comment)
      work_time(1) = ctime
      label = 'TOTALTIME'
      call hecmw_result_add(hecmw_result_dtype_global, 1, label, work_time)
      label = 'TEMPERATURE'
      call hecmw_result_add(hecmw_result_dtype_node, 1, label, fstrheat%TEMP)
 
      !elemact state
      if( fstrheat%elemact%ELEMACT_egrp_tot > 0 ) then
        allocate(work(hecmesh%n_elem))
        call output_elemact_flag( hecmesh, fstrsolid%elements, work )
        label = 'ELEMACT'
        call hecmw_result_add(hecmw_result_dtype_elem, 1, label, work)
        deallocate(work)
      end if
 
      nameid = 'fstrRES'
      call hecmw_result_write_by_name(nameid)
      call hecmw_result_finalize
    endif
  end subroutine heat_output_result
 
  subroutine heat_output_visual(hecMESH, fstrRESULT, fstrHEAT, fstrSOLID, tstep, ctime, outflag)
    use m_fstr
    use m_fstr_elemact
    use m_hecmw2fstr_mesh_conv
    implicit none
    type(hecmwst_local_mesh)  :: hecmesh
    type(fstr_heat)           :: fstrHEAT
    type(hecmwst_result_data) :: fstrRESULT
    type(fstr_solid)          :: fstrSOLID
    integer(kind=kint) :: i, tstep
    real(kind=kreal)   :: ctime
    logical, intent(in)       :: outflag
    real(kind=kreal), pointer  :: work(:)
 
    if(ivisual == 1 .and. (mod(tstep, iwres) == 0 .or. outflag))then
      call hecmw_nullify_result_data(fstrresult)
      call fstr_heat_make_result_step(hecmesh, fstrheat, fstrsolid, fstrresult, tstep, ctime)
      call fstr2hecmw_mesh_conv(hecmesh)
      call hecmw_visualize_init
      call hecmw_visualize( hecmesh, fstrresult, tstep )
      call hecmw_visualize_finalize
      call hecmw2fstr_mesh_conv(hecmesh)
      call hecmw_result_free(fstrresult)
    endif
  end subroutine heat_output_visual
 
  subroutine heat_output_restart(hecMESH, fstrHEAT, istep, tstep, current_time, outflag)
    use m_fstr
    implicit none
    type(hecmwst_local_mesh)  :: hecmesh
    type(fstr_heat)           :: fstrHEAT
    integer(kind=kint) :: restart_istep(1)
    integer(kind=kint) :: restart_step(1)
    real(kind=kreal)   :: restart_time(1)
    integer(kind=kint) :: restrt_data_size
    integer(kind=kint) :: istep, tstep
    logical, intent(in)       :: outflag
    real(kind=kreal)   :: current_time
 
    if( fstrheat%restart_nout <= 0 ) return
 
    if( mod(tstep, fstrheat%restart_nout) == 0 .or. outflag )then
      restart_istep(1) = istep
      restart_step(1) = tstep
      restart_time(1) = current_time
      restrt_data_size = size(restart_istep)
      call hecmw_restart_add_int(restart_istep, restrt_data_size)
      restrt_data_size = size(restart_step)
      call hecmw_restart_add_int(restart_step, restrt_data_size)
      restrt_data_size = size(restart_time)
      call hecmw_restart_add_real(restart_time, restrt_data_size)
      restrt_data_size = size(fstrheat%TEMP)
      call hecmw_restart_add_real(fstrheat%TEMP, restrt_data_size)
      call hecmw_restart_write()
      if( hecmesh%my_rank.eq.0 ) then
        write(imsg,*) '### FSTR output Restart_File.'
        call flush(imsg)
      endif
    endif
  end subroutine heat_output_restart
end module m_heat_io