heat_get_amplitude.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_get_amplitude
contains
  !C***
  !C*** GET_AMPLITUDE
  !C***
  subroutine heat_get_amplitude ( fstrHEAT,id,TT,QQ,OutOfRange )
 
    use m_fstr
 
    implicit none
    integer(kind=kint) :: id, nn, ii, ikk
    real(kind=kreal)   :: tt, qq
    type(fstr_heat)    :: fstrheat
    logical, optional  :: outofrange
 
    qq = 1.0
    if (present(outofrange)) outofrange = .false.
    if( id>0 ) then
      nn = fstrheat%AMPLtab(id)
      if    ( tt < fstrheat%AMPLtime(id,1) ) then
        ii = 1
        if (present(outofrange)) outofrange = .true.
      elseif( tt >= fstrheat%AMPLtime(id,nn) ) then
        ii = nn + 1
        if (present(outofrange)) outofrange = .true.
      else
        ii = 2
        if (present(outofrange)) outofrange = .false.
        do ikk= 1, nn - 1
          if(       tt .ge. fstrheat%AMPLtime(id,ikk)                        &
              .and.  tt .lt. fstrheat%AMPLtime(id,ikk+1) ) then
            ii = ikk + 1
            exit
          endif
        enddo
      endif
      qq = fstrheat%AMPLfuncA(id,ii) * tt + fstrheat%AMPLfuncB(id,ii)
    endif
 
  end subroutine heat_get_amplitude
end module m_heat_get_amplitude