subroutine SRCLOUDS (th,q,plk,pl,plke,cloud,cldwat,irun,irise,

      _RL   th(irun,irise)

                  temp = th(i,L)*plk(i,L)

      call CTEI ( th,q,cloud,cldwat,pl,plk,plke,irun,irise )

      subroutine CTEI ( th,q,cldfrc,cldwat,pl,plk,plke,im,lm )

      _RL  th(im,lm),q(im,lm),plke(im,lm+1),cldwat(im,lm)

      k = 1.0 + cpoel*plke(i,L)*( th(i,L)-th(i,L-1) ) / dq

      t = th(i,L)*plk(i,L)

        saveth(i,L) = th (i,L)

       saveth(I,L) =  th(I,L)

      _RL u(istrip,nlay+1), v(istrip,nlay+1), th(istrip,nlay+1)

       call STRIP2TILE(tz,igrd,th,nchp,ijall,istrip,nlay,nn)

       call STRIPIT  (tground,th(1,nlay+1),nchptot,nchp,istrip,1,nn)

      th(i,nlay+1) = th(i,nlay+1) / pke(i,nlay+1)

      thv(i,L) = th(i,L) * thv(i,L)

      call TRBFLX(nn,th,thv,sh,u,v,qq,p,pe,pk,pke,dpstr,stwatr,stz0,

       tmpnlay(i) = th(i,nlay)*pk(i,nlay)

      th(i,nlay+1) = tc(i) / pke(i,nlay+1)

      th(i,L) = th(i,L) + dthdthg(i,L)*(tc(i)-savetc(i))/pke(i,nlay+1)

       sttflux(i,L) = transth(i,L) * (th(i,L+1)-th(i,L))

      tends(i) = ( th(i,l)-tmpstrip(i) )

      _RL del_P ,del_th, th, q

      th     = T + onehalf*del_th

      call SW_ADTG(S,th,P+onehalf*del_P, adtg_val)

      th     = th + (1 - 1/sqrt(two))*(del_th - q)

      call SW_ADTG(S,th,P+onehalf*del_P, adtg_val)

      th     = th + (1 + 1/sqrt(two))*(del_th - q)

      call SW_ADTG(S,th,P+del_P, adtg_val)

      rv     = th + (del_th - two*q)/(two*three)

      _RL del_P ,del_th, th, q

      th     = T + onehalf*del_th

      del_th = del_P*sw_adtg(S,th,P+onehalf*del_P)

      th     = th + (1 - 1/sqrt(two))*(del_th - q)

      del_th = del_P*sw_adtg(S,th,P+onehalf*del_P)

      th     = th + (1 + 1/sqrt(two))*(del_th - q)

      del_th = del_P*sw_adtg(S,th,P+del_P)

      SW_PTMP     = th + (del_th - two*q)/(two*three)