*=*=*=*= dissip.html =*=*=*=*
SUBROUTINE dissip

SUBROUTINE dissip


      SUBROUTINE dissip( vcov,ucov,h,dv,du,dh )
c
      IMPLICIT NONE

c=======================================================================
c
c   Auteur:  P. Le Van
c   -------
c
c   Objet:
c   ------
c
c   Dissipation horizontale
c
c       ...........    Version  du 29/04/97   ............
c
c=======================================================================
c-----------------------------------------------------------------------
c   Declarations:
c   -------------

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comdissnew.h"
#include "comdissipn.h"

c   Arguments:
c   ----------

      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),h(ip1jmp1,llm)
      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dh(ip1jmp1,llm)

c   Local:
c   ------

      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
      REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
      REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
      REAL te1dt(llm),te2dt(llm),te3dt(llm)

      INTEGER l,ij

      EXTERNAL  gradiv,nXgrarot,divgrad,covcont,initial0
      EXTERNAL gradiv2,nXgraro2,divgrad2

c-----------------------------------------------------------------------
c   initialisations:
c   ----------------

      DO l=1,llm
         te1dt(l) = tetaudiv(l) * dtdiss
         te2dt(l) = tetaurot(l) * dtdiss
         te3dt(l) = tetah(l)    * dtdiss
      ENDDO
      CALL initial0( ijp1llm, du )
      CALL initial0( ijmllm , dv )
      CALL initial0( ijp1llm, dh )

c-----------------------------------------------------------------------
c   calcul de la dissipation:
c   -------------------------

c   calcul de la partie   grad  ( div ) :
c   -------------------------------------

      CALL covcont( llm,ucov,vcov,ucont,vcont )

      IF(lstardis) THEN
         CALL gradiv2( llm,ucont,vcont,nitergdiv,gdx,gdy )
      ELSE
         CALL gradiv ( llm,ucont,vcont,nitergdiv,gdx,gdy )
      ENDIF

      DO l=1,llm
         DO ij = iip2,ip1jm
            du(ij,l) = du(ij,l) - te1dt(l) *gdx(ij,l)
         ENDDO
         DO ij = 1,ip1jm
            dv(ij,l) = dv(ij,l) - te1dt(l) *gdy(ij,l)
         ENDDO
      ENDDO

c   calcul de la partie   n X grad ( rot ):
c   ---------------------------------------

      IF(lstardis) THEN
         CALL nxgraro2( llm,ucov, vcov, nitergrot,grx,gry )
      ELSE
         CALL nxgrarot( llm,ucov, vcov, nitergrot,grx,gry )
      ENDIF

      DO l=1,llm
         DO ij = iip2,ip1jm
            du(ij,l) = du(ij,l) - te2dt(l) * grx(ij,l)
         ENDDO
         DO ij =  1, ip1jm
            dv(ij,l) = dv(ij,l) - te2dt(l) * gry(ij,l)
         ENDDO
      ENDDO

c   calcul de la partie   div ( grad ):
c   -----------------------------------

      IF(lstardis) THEN
         CALL divgrad2( llm,h,niterh,gdx )
      ELSE
         CALL divgrad ( llm,h,niterh,gdx )
      ENDIF

      DO l = 1,llm
         DO ij = 1,ip1jmp1
            dh( ij,l ) = dh( ij,l ) - te3dt(l) * gdx( ij,l )
         ENDDO
      ENDDO

      RETURN
      END