/[lmdze]/trunk/dyn3d/Dissipation/dissip.f

Diff of /trunk/dyn3d/Dissipation/dissip.f

Parent Directory | Revision Log | View Patch Patch

-trunk/libf/dyn3d/dissip.f90
revision 44 by guez,
Wed Apr 13 12:29:18 2011 UTC
+trunk/libf/dyn3d/Dissipation/dissip.f90
revision 55 by guez,
Mon Dec 12 13:25:01 2011 UTC
 Line 1
- SUBROUTINE dissip(vcov, ucov, teta, p, dv, du, dh)
+ module dissip_m
-   ! From dyn3d/dissip.F, version 1.1.1.1 2004/05/19 12:53:05
-   ! Avec nouveaux operateurs star : gradiv2 , divgrad2, nxgraro2
-   ! Author: P. Le Van
-   ! Objet : dissipation horizontale
-   USE dimens_m, ONLY : llm
-   USE paramet_m, ONLY : iip1, iip2, ip1jm, ip1jmp1, llmp1
-   USE comdissnew, ONLY : lstardis, nitergdiv, nitergrot, niterh
-   USE inidissip_m, ONLY : dtdiss, tetah, tetaudiv, tetaurot
    IMPLICIT NONE
-   ! Arguments:
+ contains
-   REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
-   REAL, INTENT (IN) :: p(ip1jmp1, llmp1)
+   SUBROUTINE dissip(vcov, ucov, teta, p, dv, du, dh)
-   REAL dv(ip1jm, llm), du(ip1jmp1, llm), dh(ip1jmp1, llm)
+     ! From dyn3d/dissip.F, version 1.1.1.1 2004/05/19 12:53:05
-   ! Local:
+     ! Avec nouveaux opérateurs star : gradiv2, divgrad2, nxgraro2
-   REAL gdx(ip1jmp1, llm), gdy(ip1jm, llm)
+     ! Author: P. Le Van
-   REAL grx(ip1jmp1, llm), gry(ip1jm, llm)
+     ! Objet : dissipation horizontale
-   REAL te1dt(llm), te2dt(llm), te3dt(llm)
-   REAL deltapres(ip1jmp1, llm)
+     USE dimens_m, ONLY: iim, jjm, llm
+     USE paramet_m, ONLY: iip1, iip2, ip1jmp1, llmp1
-   INTEGER l, ij
+     USE comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh
+     USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh
-   !-----------------------------------------------------------------------
+     use gradiv2_m, only: gradiv2
-   ! initialisations:
+     REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
+     REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
-   DO l = 1, llm
+     REAL, intent(in):: teta((iim + 1) * (jjm + 1), llm)
-      te1dt(l) = tetaudiv(l)*dtdiss
+     REAL, INTENT(IN):: p((iim + 1) * (jjm + 1), llmp1)
-      te2dt(l) = tetaurot(l)*dtdiss
+     REAL, intent(out):: dv(:, :, :) ! (iim + 1, jjm, llm)
-      te3dt(l) = tetah(l)*dtdiss
+     REAL, intent(out):: du(:, :, :) ! (iim + 1, jjm + 1, llm)
-   END DO
+     REAL, intent(out):: dh(:, :, :) ! (iim + 1, jjm + 1, llm)
-   du = 0.
-   dv = 0.
+     ! Local:
-   dh = 0.
+     REAL gdx(iim + 1, jjm + 1, llm), gdy(iim + 1, jjm, llm)
+     REAL grx(iim + 1, jjm + 1, llm), gry(iim + 1, jjm, llm)
-   ! Calcul de la dissipation:
+     REAL te1dt(llm), te2dt(llm), te3dt(llm)
+     REAL deltapres((iim + 1) * (jjm + 1), llm)
-   ! Calcul de la partie grad (div) :
+     INTEGER l
-   IF (lstardis) THEN
+     !-----------------------------------------------------------------------
-      CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy)
-   ELSE
+     ! Initializations:
-      CALL gradiv(llm, ucov, vcov, nitergdiv, gdx, gdy)
+     te1dt = tetaudiv * dtdiss
-   END IF
+     te2dt = tetaurot * dtdiss
+     te3dt = tetah * dtdiss
-   DO l = 1, llm
+     du = 0.
-      DO ij = 1, iip1
+     dv = 0.
-         gdx(ij, l) = 0.
+     dh = 0.
-         gdx(ij+ip1jm, l) = 0.
-      END DO
+     ! Calcul de la dissipation:
-      DO ij = iip2, ip1jm
+     ! Calcul de la partie grad (div) :
-         du(ij, l) = du(ij, l) - te1dt(l)*gdx(ij, l)
-      END DO
+     IF (lstardis) THEN
-      DO ij = 1, ip1jm
+        CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)
-         dv(ij, l) = dv(ij, l) - te1dt(l)*gdy(ij, l)
+     ELSE
-      END DO
+        CALL gradiv(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)
-   END DO
+     END IF
-   ! calcul de la partie n X grad (rot) :
+     gdx(:, 1, :) = 0.
+     gdx(:, jjm + 1, :) = 0.
-   IF (lstardis) THEN
+     forall (l = 1: llm)
-      CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry)
+        du(:, 2: jjm, l) = du(:, 2: jjm, l) - te1dt(l) * gdx(:, 2: jjm, l)
-   ELSE
+        dv(:, :, l) = dv(:, :, l) - te1dt(l) * gdy(:, :, l)
-      CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry)
+     END forall
-   END IF
+     ! calcul de la partie n X grad (rot) :
-   DO l = 1, llm
+     IF (lstardis) THEN
-      DO ij = 1, iip1
+        CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry, crot)
-         grx(ij, l) = 0.
+     ELSE
-      END DO
+        CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry, crot)
+     END IF
-      DO ij = iip2, ip1jm
-         du(ij, l) = du(ij, l) - te2dt(l)*grx(ij, l)
-      END DO
+     grx(:, 1, :) = 0.
-      DO ij = 1, ip1jm
+     forall (l = 1: llm)
-         dv(ij, l) = dv(ij, l) - te2dt(l)*gry(ij, l)
+        du(:, 2: jjm, l) = du(:, 2: jjm, l) - te2dt(l) * grx(:, 2: jjm, l)
-      END DO
+        dv(:, :, l) = dv(:, :, l) - te2dt(l) * gry(:, :, l)
-   END DO
+     END forall
-   ! calcul de la partie div (grad) :
+     ! calcul de la partie div (grad) :
-   IF (lstardis) THEN
+     IF (lstardis) THEN
-      DO l = 1, llm
+        forall (l = 1: llm) deltapres(:, l) = max(0., p(:, l) - p(:, l + 1))
-         DO ij = 1, ip1jmp1
+        CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh)
-            deltapres(ij, l) = amax1(0., p(ij, l)-p(ij, l+1))
+     ELSE
-         END DO
+        CALL divgrad(llm, teta, niterh, gdx, cdivh)
-      END DO
+     END IF
-      CALL divgrad2(llm, teta, deltapres, niterh, gdx)
+     forall (l = 1: llm) dh(:, :, l) = dh(:, :, l) - te3dt(l) * gdx(:, :, l)
-   ELSE
-      CALL divgrad(llm, teta, niterh, gdx)
+   END SUBROUTINE dissip
-   END IF
-   DO l = 1, llm
-      DO ij = 1, ip1jmp1
-         dh(ij, l) = dh(ij, l) - te3dt(l)*gdx(ij, l)
-      END DO
-   END DO
- END SUBROUTINE dissip
+ end module dissip_m

 Legend:



Removed from v.44
 


changed lines


 
Added in v.55
 Legend:



Removed from v.44
 


changed lines


 
Added in v.55
-Removed from v.44
+Added in v.55

	ViewVC Help
Powered by ViewVC 1.1.21