--- trunk/libf/dyn3d/Dissipation/dissip.f90 2012/01/10 19:02:02 56 +++ trunk/dyn3d/Dissipation/dissip.f 2018/07/20 14:30:23 279 @@ -8,15 +8,19 @@ ! From dyn3d/dissip.F, version 1.1.1.1 2004/05/19 12:53:05 ! Author: P. Le Van - ! Objet : calcul de la dissipation horizontale - ! Avec opérateurs star : gradiv2, divgrad2, nxgraro2 + + ! Objet : calcul de la dissipation horizontale. Avec op\'erateurs + ! star : gradiv2, divgrad2, nxgraro2. - USE dimens_m, ONLY: iim, jjm, llm - USE comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh - USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh - use gradiv2_m, only: gradiv2 use nr_util, only: assert + USE comdissnew, ONLY: nitergdiv, nitergrot, niterh + USE dimensions, ONLY: iim, jjm, llm + use divgrad2_m, only: divgrad2 + use gradiv2_m, only: gradiv2 + USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh + use nxgraro2_m, only: nxgraro2 + REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm) REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm) @@ -27,7 +31,6 @@ ! Local: REAL gdx(iim + 1, jjm + 1, llm), gdy(iim + 1, jjm, llm) - REAL grx(iim + 1, jjm + 1, llm), gry(iim + 1, jjm, llm) REAL tedt(llm) REAL deltapres(iim + 1, jjm + 1, llm) INTEGER l @@ -45,44 +48,26 @@ du(:, 1, :) = 0. du(:, jjm + 1, :) = 0. - ! Calcul de la partie grad (div) : - - IF (lstardis) THEN - CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu) - ELSE - CALL gradiv(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu) - END IF - + ! Calcul de la partie grad(div) : + CALL gradiv2(ucov, vcov, nitergdiv, gdx, gdy, cdivu) tedt = tetaudiv * dtdiss forall (l = 1: llm) du(:, 2: jjm, l) = - tedt(l) * gdx(:, 2: jjm, l) dv(:, :, l) = - tedt(l) * gdy(:, :, l) END forall - ! Calcul de la partie n X grad (rot) : - - IF (lstardis) THEN - CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry, crot) - ELSE - CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry, crot) - END IF - + ! Calcul de la partie n \wedge grad(rot) : + CALL nxgraro2(ucov, vcov, nitergrot, gdx, gdy, crot) tedt = tetaurot * dtdiss forall (l = 1: llm) - du(:, 2: jjm, l) = du(:, 2: jjm, l) - tedt(l) * grx(:, 2: jjm, l) - dv(:, :, l) = dv(:, :, l) - tedt(l) * gry(:, :, l) + du(:, 2: jjm, l) = du(:, 2: jjm, l) - tedt(l) * gdx(:, 2: jjm, l) + dv(:, :, l) = dv(:, :, l) - tedt(l) * gdy(:, :, l) END forall - ! calcul de la partie div (grad) : - - IF (lstardis) THEN - forall (l = 1: llm) & - deltapres(:, :, l) = max(0., p(:, :, l) - p(:, :, l + 1)) - CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh) - ELSE - CALL divgrad(llm, teta, niterh, gdx, cdivh) - END IF - + ! calcul de la partie div(grad) : + forall (l = 1: llm) & + deltapres(:, :, l) = max(0., p(:, :, l) - p(:, :, l + 1)) + CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh) forall (l = 1: llm) dh(:, :, l) = - tetah(l) * dtdiss * gdx(:, :, l) END SUBROUTINE dissip