radiation_tools.F90

 
 
module radiation_tools
  use machine, only: &
       kind_phys                   ! Working type
  implicit none
 
  real(kind_phys) :: &
       rrtmgp_minp, & ! Minimum pressure allowed in RRTMGP
       rrtmgp_mint    ! Minimum temperature allowed in RRTMGP
contains
 
  subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev)
    ! Inputs
    integer, intent(in) :: &
         nCol,nLev
    real(kind_phys),intent(in) :: &
         minP
    real(kind_phys),dimension(nCol),intent(in) :: &
         tsfc
    real(kind_phys),dimension(nCol,nLev),intent(in) :: &
         p_lay,t_lay
    real(kind_phys),dimension(nCol,nLev+1),intent(in) :: &
         p_lev
 
    ! Outputs
    real(kind_phys),dimension(nCol,nLev+1),intent(out) :: &
         t_lev
 
    ! Local
    integer :: iCol,iLay, iSFC, iTOA
    logical :: top_at_1
    real(kind_phys), dimension(nCol,nLev) :: tem2da, tem2db
 
    top_at_1 = (p_lev(1,1) .lt.  p_lev(1, nlev))
    if (top_at_1) then
       isfc = nlev
       itoa = 1
    else
       isfc = 1
       itoa = nlev
    endif
 
    if (itoa .eq. 1) then
       tem2da(1:ncol,2:isfc) = log(p_lay(1:ncol,2:isfc))
       tem2db(1:ncol,2:isfc) = log(p_lev(1:ncol,2:isfc))
       do icol = 1, ncol
           tem2da(icol,1)    = log(p_lay(icol,1) )
           tem2db(icol,1)    = log(max(minp, p_lev(icol,1)) )
           tem2db(icol,isfc) = log(p_lev(icol,isfc) )
       enddo
       t_lev(1:ncol,1)      = t_lay(1:ncol,itoa)
       do ilay = 2, isfc
          do icol = 1, ncol
            t_lev(icol,ilay) = t_lay(icol,ilay) + (t_lay(icol,ilay-1) - t_lay(icol,ilay))&
                     * (tem2db(icol,ilay)   - tem2da(icol,ilay))                   &
                     / (tem2da(icol,ilay-1) - tem2da(icol,ilay))
           enddo
        enddo
       t_lev(1:ncol,isfc+1) = tsfc(1:ncol)
    else
       tem2da(1:ncol,2:itoa) = log(p_lay(1:ncol,2:itoa))
       tem2db(1:ncol,2:itoa) = log(p_lev(1:ncol,2:itoa))
       do icol = 1, ncol
           tem2da(icol,1)    = log(p_lay(icol,1))
           tem2db(icol,1)    = log(p_lev(icol,1))
           tem2db(icol,itoa) = log(max(minp, p_lev(icol,itoa)) )
       enddo
 
       t_lev(1:ncol,1)      = tsfc(1:ncol)
       do ilay = 1, itoa-1
          do icol = 1, ncol
            t_lev(icol,ilay+1) = t_lay(icol,ilay) + (t_lay(icol,ilay+1) - t_lay(icol,ilay))&
                     * (tem2db(icol,ilay+1) - tem2da(icol,ilay))                   &
                     / (tem2da(icol,ilay+1) - tem2da(icol,ilay))
           enddo
        enddo
       t_lev(1:ncol,itoa+1) = t_lay(1:ncol,itoa)
    endif
 
  end subroutine cmp_tlev
 
  subroutine check_error_msg(routine_name, error_msg)
    character(len=*), intent(in) :: &
         error_msg, routine_name
    
    if(error_msg /= "") then
       print*,"ERROR("//trim(routine_name)//"): "
       print*,trim(error_msg)
       return
    end if
  end subroutine check_error_msg  
 
end module radiation_tools