do nthini = 1,Lm+1

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

      do nbasei = 1,Lm+1

       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

      do L = 1,Lm

      do L = 1,Lm

      call STRIPIT ( uz,us,im*jm,im*jm,istrip,Lm,n )

      call STRIPIT ( vz,vs,im*jm,im*jm,istrip,Lm,n )

      call STRIPIT ( tv,ts,im*jm,im*jm,istrip,Lm,n )

      call STRIPIT ( pl,plstr,im*jm,im*jm,istrip,Lm,n )

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

      call STRIPIT ( dpres,dpresstr,im*jm,im*jm,istrip,Lm,n )

     .            istrip,Lm,nthinstr,nbasestr,lstar )

      call PASTIT( dragus,dragu,istrip,im*jm,im*jm,Lm,n )

      call PASTIT( dragvs,dragv,istrip,im*jm,im*jm,Lm,n )

      do L = 1,Lm

      do L = 1,Lm

      do L = 1,Lm

      do L = 1,Lm

     .                  grav,rgas,cp,irun,Lm,nthin,nbase,lstar )

      integer irun,Lm

      _RL u(irun,Lm), v(irun,Lm), t(irun,Lm)

      _RL dudt(irun,Lm), dvdt(irun,Lm)

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

      _RL bv(irun,Lm)

      _RL XTENS(irun,Lm+1), YTENS(irun,Lm+1)

      _RL TENSIO(irun,Lm+1)

      _RL RO(irun,Lm), DZ(irun,Lm)

      do l = 1,Lm

       ro(i,L) = pl(i,Lm+1-L)/(rgas*t(i,Lm+1-L))

      do l = 2,Lm

       dz(i,L) = agrav*roiave*( pl(i,Lm+2-L)-pl(i,Lm+1-L) )

       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)))

        vai1 = (t(i,Lm+1-L)-t(i,Lm+2-L))/dz(i,L)+gocp

        vai2    = 2.0*grav/( t(i,Lm+1-L)+t(i,Lm+2-L) )

      integer myid,im,jm,Lm,bi,bj,istrip,npcs,imglobal

       nbar(i) = nbar(i) + bv(i,L)*(pl(i,Lm+2-L)-pl(i,Lm+1-L))

       nbar(i) = nbar(i)/(pl(i,Lm)-pl(i,Lm+1-nbase(i)))

      _RL pl(im,jm,Lm)

      _RL ple(im,jm,Lm+1)

      _RL dpres(im,jm,Lm)

      _RL pkz(im,jm,Lm)

        velco = 0.5*( (u(i,Lm+1-L)*ubar(i) + v(i,Lm+1-L)*vbar(i))

     .            + (u(i,Lm+2-L)*ubar(i) + v(i,Lm+2-L)*vbar(i))  )

      _RL uz(im,jm,Lm)

        deluu = u(i,Lm+1-L)-u(i,Lm+2-L)

        delvv = v(i,Lm+1-L)-v(i,Lm+2-L)

      _RL vz(im,jm,Lm)

      _RL tz(im,jm,Lm)

      _RL qz(im,jm,Lm)

       do l = nbase(i)+1,Lm+1

      _RL dudt(im,jm,Lm)

        if( l.eq.Lm+1 ) then

      _RL dvdt(im,jm,Lm)

        vai1  = (t(i,Lm+1-L)-t(i,Lm+2-L))/dz(i,L)+gocp

        vai2  = 2.0*grav/(t(i,Lm+1-L)+t(i,Lm+2-L))

      _RL dtdt(im,jm,Lm)

        velco = 0.5*( (u(i,Lm+1-L)*ubar(i) + v(i,Lm+1-L)*vbar(i))

     .            + (u(i,Lm+2-L)*ubar(i) + v(i,Lm+2-L)*vbar(i))  )

        deluu = u(i,Lm+1-L)-u(i,Lm+2-L)

        delvv = v(i,Lm+1-L)-v(i,Lm+2-L)

     .         dudt,dvdt,dtdt,im,jm,Lm,bi,bj,istrip,npcs,imglobal)

      _RL tv(im,jm,Lm)

      _RL dragu(im,jm,Lm), dragv(im,jm,Lm)

      do l = nthin(i)+1,Lm

       coef = -grav*ps(i)/dpres(i,Lm+1-L)

       dudt(i,Lm+1-L) = coef*(xtens(i,L+1)-xtens(i,L))

      _RL dragt(im,jm,Lm) 

       dvdt(i,Lm+1-L) = coef*(ytens(i,L+1)-ytens(i,L))

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

       dudt(i,Lm) = coef*(xtens(i,nthin(i)+1)-xtens(i,1))

       dvdt(i,Lm) = coef*(ytens(i,nthin(i)+1)-ytens(i,1))

         dudt(i,Lm+1-L) = dudt(i,Lm)

         dvdt(i,Lm+1-L) = dvdt(i,Lm)

      do l = 1,Lm

      _RL us(istrip,Lm), vs(istrip,Lm), ts(istrip,Lm)

      _RL dragus(istrip,Lm), dragvs(istrip,Lm) 

      _RL plstr(istrip,Lm),plestr(istrip,Lm+1),dpresstr(istrip,Lm)

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