_RL ple(sNx,sNy,Nrphys+1,nSx,nSy)

      COMMON /saver/ p,pl,ple,dpres,pkle,pkl

       ple(i,j,Nrphys+1,bi,bj) = pephy(i,j,Nrphys+1,bi,bj)/100.

       ple(i,j,L,bi,bj) = pephy(i,j,L,bi,bj)/100.

       if (ple(i,j,L,bi,bj).gt.0.) then

        pkle(i,j,L,bi,bj) = ple(i,j,L,bi,bj) **kappa

      call PKAPPA (im2,jm2,Nrphys,ple(1,1,1,bi,bj),pkle(1,1,1,bi,bj),

     & p(1,1,bi,bj),u,v,t,q,pl(1,1,1,bi,bj),ple(1,1,1,bi,bj),

     &   p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,

     &   p,pl,ple,dpres,pkht,pkl,t,chemq,chemo3,co2,

     &  ptop,p,u,v,t,q,ntracer,ptracer,pl,ple,dpres,pkht,pkl,

      call GWDRAG (myid,p,pl,ple,dpres,pkl,u,v,t,q,phis_var,

     &    p,pl,ple,dpres,pkht,pkl,u,v,t,q,bi,bj,ntracer,ptracer,qq,

      _RL pl(im,jm,lm),ple(im,jm,lm+1),dpres(im,jm,lm)

     & p,u,v,t,q,pl,ple,dpres,pkht,pkl,surfz,fracland,landtype,radswt,

       if( pz(i,j)-ple(i,j,Lm+2-nthini).gt.25. ) then

       if( ple(i,j,Lm+2-nbasei).lt.(0.667*pz(i,j)) ) then

      if( (0.667*pz(i,j))-ple(i,j,Lm+2-nbase(i,j)) .gt. 

     .           ple(i,j,Lm+3-nbase(i,j))-(0.667*pz(i,j)) ) then

      call STRIPIT ( ple,plestr,im*jm,im*jm,istrip,Lm+1,n )

     .                  std,pl,ple,dpres,

      _RL ple(irun,Lm+1), pl(irun,Lm), dpres(irun,Lm)

       robar(i) = robar(i) + ro(i,L) * (ple(i,Lm+2-L)-ple(i,Lm+1-L))

       ubar(i) = ubar(i) + u(i,Lm+1-L) * (ple(i,Lm+2-L)-ple(i,Lm+1-L))

       vbar(i) = vbar(i) + v(i,Lm+1-L) * (ple(i,Lm+2-L)-ple(i,Lm+1-L))

       robar(i) = robar(i)/(ps(i)-ple(i,Lm+1-(nbase(i)-1))) * 100.0

       ubar(i) = ubar(i)/(ps(i)-ple(i,Lm+1-(nbase(i)-1)))

       vbar(i) = vbar(i)/(ps(i)-ple(i,Lm+1-(nbase(i)-1)))

      _RL ple(im,jm,Lm+1)

      subroutine GWDRAG (myid,pz,pl,ple,dpres,pkz,uz,vz,tz,qz,phis_var,

       coef = grav*ps(i)/(ple(i,Lm+1-nthin(i))-ple(i,Lm+1))

       CALL STRIP (PLZE,ple    ,im*jm,ISTRIP,lm+1 ,NN)

        ADELPL(I,L) = convrt / ( ple(I,L+1)-ple(I,L) )

      call OPTHK ( tzl,pl,ple,cldlz,clro,clmo,lwi,istrip,1,lm,tauc )

      call IRRAD ( istrip,1,1,lm,ple,tzl,shzl,ozl,tsurf,co2,

      DTRAD (I,L) = ple(i,lm+1) * DTRAD (I,L)/pk(I,L)

      DTRADC(I,L) = ple(i,lm+1) * DTRADC(I,L)/pk(I,L)

       dtdtg(I,L) = ple(i,lm+1) * dtdtg (I,L)/pk(I,L)

      _RL ple(istrip,lm+1)

      _RL     ple(istrip,lm+1)

        dum = dp(i,L)/(ple(i,lm+1)-ple(i,nsubcl))

       psubcld    (i) = sp(i)+ptop-ple(i,nsubcl)

      CALL STRIP ( plze,  ple   ,im*jm,ISTRIP,lm+1,NN)

      call SORAD ( istrip,1,1,lm,ple,tzl,qzl,ozl,co2,

      alf = grav*(ple(i,Lm+1)-ptop)/(cp*dpstrip(i,L)*100)

      subroutine OPTHK ( tl,pl,ple,lz,cf,cfm,lwi,im,jm,lm,tau )

      _RL ple(im,jm,lm+1)

         dp   =  ple(i,j,L+1)-ple(i,j,L)

     1    ( (ple(i,lp+2)-ple(i,lp+1))*(qq(i,lp+1)-qqcolmin(i))

     1    ( (ple(i,2)-ple(i,1))*(qq(i,1)-qqcolmin(i))

      subroutine PKAPPA (im,jm,lm,ple,pkle,pkz)

      _RL ple(im,jm,lm+1)

       pkz(i,j,L) = ( ple (i,j,l+1)*pkle(i,j,l+1)

     .             - ple (i,j,l)*pkle(i,j,l) )

     .           /  ( akap1* (ple (i,j,l+1)-ple (i,j,l)) )

      _RL  ple(im*jm,lm+1)

        if ( ple(i,L+1).ge.(ple(i,lm+1)-100.) ) then

         tm(i) = tm(i) + thz(i,L)*(ple(i,L+1)-ple(i,L))

      tm(i) = tm(i)/(ple(i,lm+1)-ple(i,Ltop(i)))

     1                  ple(imt,jmt),kmp(imt,jmt),kmq(imt,jmt)

      _RL ple(sNx,sNy,Nrphys+1,nSx,nSy)