*=*=*=*= dissip.html =*=*=*=*
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