/[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 56 by guez, Tue Jan 10 19:02:02 2012 UTC trunk/dyn3d/Dissipation/dissip.f revision 279 by guez, Fri Jul 20 14:30:23 2018 UTC
# Line 8  contains Line 8  contains
8    
9      ! From dyn3d/dissip.F, version 1.1.1.1 2004/05/19 12:53:05      ! From dyn3d/dissip.F, version 1.1.1.1 2004/05/19 12:53:05
10      ! Author: P. Le Van      ! Author: P. Le Van
11      ! Objet : calcul de la dissipation horizontale      
12      ! Avec opérateurs star : gradiv2, divgrad2, nxgraro2      ! Objet : calcul de la dissipation horizontale. Avec op\'erateurs
13        ! star : gradiv2, divgrad2, nxgraro2.
14    
     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  
15      use nr_util, only: assert      use nr_util, only: assert
16    
17        USE comdissnew, ONLY: nitergdiv, nitergrot, niterh
18        USE dimensions, ONLY: iim, jjm, llm
19        use divgrad2_m, only: divgrad2
20        use gradiv2_m, only: gradiv2
21        USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh
22        use nxgraro2_m, only: nxgraro2
23    
24      REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)      REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
25      REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)      REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
26      REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)      REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
# Line 27  contains Line 31  contains
31    
32      ! Local:      ! Local:
33      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)  
34      REAL tedt(llm)      REAL tedt(llm)
35      REAL deltapres(iim + 1, jjm + 1, llm)      REAL deltapres(iim + 1, jjm + 1, llm)
36      INTEGER l      INTEGER l
# Line 45  contains Line 48  contains
48      du(:, 1, :) = 0.      du(:, 1, :) = 0.
49      du(:, jjm + 1, :) = 0.      du(:, jjm + 1, :) = 0.
50    
51      ! Calcul de la partie grad (div) :      ! Calcul de la partie grad(div) :
52        CALL gradiv2(ucov, vcov, nitergdiv, gdx, gdy, cdivu)
     IF (lstardis) THEN  
        CALL gradiv2(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)  
     ELSE  
        CALL gradiv(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)  
     END IF  
   
53      tedt = tetaudiv * dtdiss      tedt = tetaudiv * dtdiss
54      forall (l = 1: llm)      forall (l = 1: llm)
55         du(:, 2: jjm, l) = - tedt(l) * gdx(:, 2: jjm, l)         du(:, 2: jjm, l) = - tedt(l) * gdx(:, 2: jjm, l)
56         dv(:, :, l) = - tedt(l) * gdy(:, :, l)         dv(:, :, l) = - tedt(l) * gdy(:, :, l)
57      END forall      END forall
58    
59      ! Calcul de la partie n X grad (rot) :      ! Calcul de la partie n \wedge grad(rot) :
60        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  
   
61      tedt = tetaurot * dtdiss      tedt = tetaurot * dtdiss
62      forall (l = 1: llm)      forall (l = 1: llm)
63         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)
64         dv(:, :, l) = dv(:, :, l) - tedt(l) * gry(:, :, l)         dv(:, :, l) = dv(:, :, l) - tedt(l) * gdy(:, :, l)
65      END forall      END forall
66    
67      ! calcul de la partie div (grad) :      ! calcul de la partie div(grad) :
68        forall (l = 1: llm) &
69      IF (lstardis) THEN           deltapres(:, :, l) = max(0., p(:, :, l) - p(:, :, l + 1))
70         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  
   
71      forall (l = 1: llm) dh(:, :, l) = - tetah(l) * dtdiss * gdx(:, :, l)      forall (l = 1: llm) dh(:, :, l) = - tetah(l) * dtdiss * gdx(:, :, l)
72    
73    END SUBROUTINE dissip    END SUBROUTINE dissip
Legend:
Removed from v.56  
changed lines
  Added in v.279
  ViewVC Help
Powered by ViewVC 1.1.21