NGMSLP.f

Go to the documentation of this file.

 
!
      SUBROUTINE ngmslp
 
!     
      use vrbls3d,    only: zint, pint, t, q, zmid
      use vrbls2d,    only: slp, fis, z1000
      use masks,      only: lmh
      use params_mod, only: rd, gi, g, h1, d608, gamma, d50, p1000
      use ctlblk_mod, only: jsta, jend, im, jm, spval, ista, iend
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       implicit none
!     
      real,PARAMETER :: ZSL=0.0
      real,PARAMETER :: TAUCR=rd*gi*290.66,const=0.005*g/rd
      real,PARAMETER :: GORD=g/rd,dp=60.e2
!     
!     DECLARE VARIABLES
!
      integer I,J,LLMH
      real ZSFC,PSFC,TVRT,TAU,TVRSFC,TAUSFC,TVRSL,TAUSL,TAUAVG,    &
           alpavg,pavg,rhoavg,rrhog
!     
!**********************************************************************
!     START NGMSLP HERE.
!     
!     LOOP OVER HORIZONTAL GRID.
!
!!$omp  parallel do
!!$omp& private(llmh,pavg,psfc,qavg,rhoavg,rrhog,
!!$omp&         tau,tauavg,tausfc,tausl,tavg,tvrbar,tvrsfc,tvrsl,
!!$omp&         tvrt,tvrtal,zbar,zl,zsfc)
       DO j=jsta,jend
       DO i=ista,iend
         llmh = nint(lmh(i,j))
 
         if( pint(i,j,llmh+1)<spval) then
 
         zsfc = zint(i,j,llmh+1)
         psfc = pint(i,j,llmh+1)
         slp(i,j) = psfc
!
!        COMPUTE LAYER TAU (VIRTUAL TEMP*RD/G).
         tvrt = t(i,j,llmh)*(h1+d608*q(i,j,llmh))
         tau  = tvrt*rd*gi
!     
!        COMPUTE TAU AT THE GROUND (Z=ZSFC) AND SEA LEVEL (Z=0)
!        ASSUMING A CONSTANT LAPSE RATE OF GAMMA=6.5DEG/KM.
!         TVRSFC = TVRT + (ZSFC- ZSL)*GAMMA
         tvrsfc = tvrt + (zmid(i,j,llmh) - zsfc)*gamma ! Chuang
         tausfc = tvrsfc*rd*gi
!         TVRSL  = TVRT + (ZSFC- ZSL)*GAMMA
         tvrsl  = tvrt + (zmid(i,j,llmh) - zsl)*gamma
         tausl  = tvrsl*rd*gi
!     
!        IF NEED BE APPLY SHEULL CORRECTION.
         IF ((tausl>taucr).AND.(tausfc<=taucr)) THEN
            tausl=taucr
         ELSEIF ((tausl>taucr).AND.(tausfc>taucr)) THEN
            tausl = taucr-const*(tausfc-taucr)**2
         ENDIF
!     
!        COMPUTE MEAN TAU.
         tauavg = d50*(tausl+tausfc)
!     
!        COMPUTE SEA LEVEL PRESSURE.
         IF (abs(fis(i,j))>1.0)slp(i,j) = psfc*exp(zsfc/tauavg)
!     
!        COMPUTE 1000MB HEIGHTS.
         alpavg   = d50*(alog(psfc)+alog(slp(i,j)))
         pavg     = exp(alpavg)
         rhoavg   = pavg*gi/tauavg
         rrhog    = h1/(rhoavg*g)
         z1000(i,j) = (slp(i,j)-p1000)*rrhog
 
         else
         slp(i,j) = spval
         z1000(i,j) = spval
         endif
 
!     
!     MOVE TO NEXT HORIZONTAL GRIDPOINT.
      ENDDO
      ENDDO
!     
!     
!     END OF ROUTINE.
!     
 
      RETURN
      END