subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) 1,2 !----------------------------------------------------------------------- ! ! Purpose: ! Hybrid coord version: Compute sea level pressure for a latitude line ! ! Method: ! CCM2 hybrid coord version using ECMWF formulation ! Algorithm: See section 3.1.b in NCAR NT-396 "Vertical ! Interpolation and Truncation of Model-Coordinate Data ! ! Author: Stolen from the Processor by Erik Kluzek ! !----------------------------------------------------------------------- ! ! $Id$ ! $Author$ ! !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 use ppgrid, only: pcols, pver implicit none !-----------------------------Arguments--------------------------------- integer , intent(in) :: ncol ! longitude dimension real(r8), intent(in) :: pmid(pcols,pver) ! Atmospheric pressure (pascals) real(r8), intent(in) :: phis(pcols) ! Surface geopotential (m**2/sec**2) real(r8), intent(in) :: ps(pcols) ! Surface pressure (pascals) real(r8), intent(in) :: T(pcols,pver) ! Vertical slice of temperature (top to bot) real(r8), intent(in) :: gravit ! Gravitational acceleration real(r8), intent(in) :: rair ! gas constant for dry air real(r8), intent(out):: psl(pcols) ! Sea level pressures (pascals) !----------------------------------------------------------------------- !-----------------------------Parameters-------------------------------- real(r8), parameter :: xlapse = 6.5e-3_r8 ! Temperature lapse rate (K/m) !----------------------------------------------------------------------- !-----------------------------Local Variables--------------------------- integer i ! Loop index real(r8) alpha ! Temperature lapse rate in terms of pressure ratio (unitless) real(r8) Tstar ! Computed surface temperature real(r8) TT0 ! Computed temperature at sea-level real(r8) alph ! Power to raise P/Ps to get rate of increase of T with pressure real(r8) beta ! alpha*phis/(R*T) term used in approximation of PSL !----------------------------------------------------------------------- ! alpha = rair*xlapse/gravit do i=1,ncol if ( abs(phis(i)/gravit) < 1.e-4_r8 )then psl(i)=ps(i) else Tstar=T(i,pver)*(1._r8+alpha*(ps(i)/pmid(i,pver)-1._r8)) ! pg 7 eq 5 TT0=Tstar + xlapse*phis(i)/gravit ! pg 8 eq 13 if ( Tstar<=290.5_r8 .and. TT0>290.5_r8 ) then ! pg 8 eq 14.1 alph=rair/phis(i)*(290.5_r8-Tstar) else if (Tstar>290.5_r8 .and. TT0>290.5_r8) then ! pg 8 eq 14.2 alph=0._r8 Tstar= 0.5_r8 * (290.5_r8 + Tstar) else alph=alpha if (Tstar<255._r8) then Tstar= 0.5_r8 * (255._r8 + Tstar) ! pg 8 eq 14.3 endif endif beta = phis(i)/(rair*Tstar) psl(i)=ps(i)*exp( beta*(1._r8-alph*beta/2._r8+((alph*beta)**2)/3._r8)) end if enddo return end subroutine cpslec