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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/Dissipation/dissip.f90 revision 57 by guez, Mon Jan 30 12:54:02 2012 UTC trunk/dyn3d/Dissipation/dissip.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC
# Line 11  contains Line 11  contains
11      ! Objet : calcul de la dissipation horizontale      ! Objet : calcul de la dissipation horizontale
12      ! Avec opérateurs star : gradiv2, divgrad2, nxgraro2      ! Avec opérateurs star : gradiv2, divgrad2, nxgraro2
13    
14        USE comdissnew, ONLY: nitergdiv, nitergrot, niterh
15      USE dimens_m, ONLY: iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
16      USE comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh      use divgrad2_m, only: divgrad2
     USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh  
17      use gradiv2_m, only: gradiv2      use gradiv2_m, only: gradiv2
18        USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh
19      use nr_util, only: assert      use nr_util, only: assert
20        use nxgraro2_m, only: nxgraro2
21    
22      REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)      REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
23      REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)      REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
# Line 27  contains Line 29  contains
29    
30      ! Local:      ! Local:
31      REAL gdx(iim + 1, jjm + 1, llm), gdy(iim + 1, jjm, llm)      REAL gdx(iim + 1, jjm + 1, llm), gdy(iim + 1, jjm, llm)
     REAL grx(iim + 1, jjm + 1, llm), gry(iim + 1, jjm, llm)  
32      REAL tedt(llm)      REAL tedt(llm)
33      REAL deltapres(iim + 1, jjm + 1, llm)      REAL deltapres(iim + 1, jjm + 1, llm)
34      INTEGER l      INTEGER l
# Line 45  contains Line 46  contains
46      du(:, 1, :) = 0.      du(:, 1, :) = 0.
47      du(:, jjm + 1, :) = 0.      du(:, jjm + 1, :) = 0.
48    
49      ! Calcul de la partie grad (div) :      ! Calcul de la partie grad(div) :
50        CALL gradiv2(ucov, vcov, nitergdiv, gdx, gdy, cdivu)
     IF (lstardis) THEN  
        CALL gradiv2(ucov, vcov, nitergdiv, gdx, gdy, cdivu)  
     ELSE  
        CALL gradiv(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)  
     END IF  
   
51      tedt = tetaudiv * dtdiss      tedt = tetaudiv * dtdiss
52      forall (l = 1: llm)      forall (l = 1: llm)
53         du(:, 2: jjm, l) = - tedt(l) * gdx(:, 2: jjm, l)         du(:, 2: jjm, l) = - tedt(l) * gdx(:, 2: jjm, l)
54         dv(:, :, l) = - tedt(l) * gdy(:, :, l)         dv(:, :, l) = - tedt(l) * gdy(:, :, l)
55      END forall      END forall
56    
57      ! Calcul de la partie n X grad (rot) :      ! Calcul de la partie n X grad(rot) :
58        CALL nxgraro2(ucov, vcov, nitergrot, gdx, gdy, crot)
     IF (lstardis) THEN  
        CALL nxgraro2(llm, ucov, vcov, nitergrot, grx, gry, crot)  
     ELSE  
        CALL nxgrarot(llm, ucov, vcov, nitergrot, grx, gry, crot)  
     END IF  
   
59      tedt = tetaurot * dtdiss      tedt = tetaurot * dtdiss
60      forall (l = 1: llm)      forall (l = 1: llm)
61         du(:, 2: jjm, l) = du(:, 2: jjm, l) - tedt(l) * grx(:, 2: jjm, l)         du(:, 2: jjm, l) = du(:, 2: jjm, l) - tedt(l) * gdx(:, 2: jjm, l)
62         dv(:, :, l) = dv(:, :, l) - tedt(l) * gry(:, :, l)         dv(:, :, l) = dv(:, :, l) - tedt(l) * gdy(:, :, l)
63      END forall      END forall
64    
65      ! calcul de la partie div (grad) :      ! calcul de la partie div(grad) :
66        forall (l = 1: llm) &
67      IF (lstardis) THEN           deltapres(:, :, l) = max(0., p(:, :, l) - p(:, :, l + 1))
68         forall (l = 1: llm) &      CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh)
             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  
   
69      forall (l = 1: llm) dh(:, :, l) = - tetah(l) * dtdiss * gdx(:, :, l)      forall (l = 1: llm) dh(:, :, l) = - tetah(l) * dtdiss * gdx(:, :, l)
70    
71    END SUBROUTINE dissip    END SUBROUTINE dissip
Legend:
Removed from v.57  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.21