/[lmdze]/trunk/libf/dyn3d/Dissipation/dissip.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/Dissipation/dissip.f90

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

trunk/libf/dyn3d/dissip.f90 revision 54 by guez, Tue Dec 6 15:07:04 2011 UTC trunk/libf/dyn3d/Dissipation/dissip.f90 revision 55 by guez, Mon Dec 12 13:25:01 2011 UTC
# Line 11  contains Line 11  contains
11      ! Author: P. Le Van      ! Author: P. Le Van
12      ! Objet : dissipation horizontale      ! Objet : dissipation horizontale
13    
14      USE dimens_m, ONLY : iim, jjm, llm      USE dimens_m, ONLY: iim, jjm, llm
15      USE paramet_m, ONLY : iip1, iip2, ip1jmp1, llmp1      USE paramet_m, ONLY: iip1, iip2, ip1jmp1, llmp1
16      USE comdissnew, ONLY : lstardis, nitergdiv, nitergrot, niterh      USE comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh
17      USE inidissip_m, ONLY : dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, &      USE inidissip_m, ONLY: dtdiss, tetah, tetaudiv, tetaurot, cdivu, crot, cdivh
          cdivh  
18      use gradiv2_m, only: gradiv2      use gradiv2_m, only: gradiv2
19    
20      ! Arguments:      REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
21      REAL vcov((iim + 1) * jjm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)      REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
22      REAL, INTENT (IN) :: p(ip1jmp1, llmp1)      REAL, intent(in):: teta((iim + 1) * (jjm + 1), llm)
23      REAL dv((iim + 1) * jjm, llm), du(ip1jmp1, llm), dh(ip1jmp1, llm)      REAL, INTENT(IN):: p((iim + 1) * (jjm + 1), llmp1)
24        REAL, intent(out):: dv(:, :, :) ! (iim + 1, jjm, llm)
25        REAL, intent(out):: du(:, :, :) ! (iim + 1, jjm + 1, llm)
26        REAL, intent(out):: dh(:, :, :) ! (iim + 1, jjm + 1, llm)
27    
28      ! Local:      ! Local:
29      REAL gdx(ip1jmp1, llm), gdy((iim + 1) * jjm, llm)      REAL gdx(iim + 1, jjm + 1, llm), gdy(iim + 1, jjm, llm)
30      REAL grx(ip1jmp1, llm), gry((iim + 1) * jjm, llm)      REAL grx(iim + 1, jjm + 1, llm), gry(iim + 1, jjm, llm)
31      REAL te1dt(llm), te2dt(llm), te3dt(llm)      REAL te1dt(llm), te2dt(llm), te3dt(llm)
32      REAL deltapres(ip1jmp1, llm)      REAL deltapres((iim + 1) * (jjm + 1), llm)
33        INTEGER l
     INTEGER l, ij  
34    
35      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
36    
# Line 51  contains Line 52  contains
52         CALL gradiv(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)         CALL gradiv(llm, ucov, vcov, nitergdiv, gdx, gdy, cdivu)
53      END IF      END IF
54    
55      DO l = 1, llm      gdx(:, 1, :) = 0.
56         DO ij = 1, iip1      gdx(:, jjm + 1, :) = 0.
57            gdx(ij, l) = 0.      forall (l = 1: llm)
58            gdx(ij+(iim + 1) * jjm, l) = 0.         du(:, 2: jjm, l) = du(:, 2: jjm, l) - te1dt(l) * gdx(:, 2: jjm, l)
59         END DO         dv(:, :, l) = dv(:, :, l) - te1dt(l) * gdy(:, :, l)
60        END forall
        DO ij = iip2, (iim + 1) * jjm  
           du(ij, l) = du(ij, l) - te1dt(l) * gdx(ij, l)  
        END DO  
        DO ij = 1, (iim + 1) * jjm  
           dv(ij, l) = dv(ij, l) - te1dt(l) * gdy(ij, l)  
        END DO  
     END DO  
61    
62      ! calcul de la partie n X grad (rot) :      ! calcul de la partie n X grad (rot) :
63    
# Line 74  contains Line 68  contains
68      END IF      END IF
69    
70    
71      DO l = 1, llm      grx(:, 1, :) = 0.
72         DO ij = 1, iip1      forall (l = 1: llm)
73            grx(ij, l) = 0.         du(:, 2: jjm, l) = du(:, 2: jjm, l) - te2dt(l) * grx(:, 2: jjm, l)
74         END DO         dv(:, :, l) = dv(:, :, l) - te2dt(l) * gry(:, :, l)
75        END forall
        DO ij = iip2, (iim + 1) * jjm  
           du(ij, l) = du(ij, l) - te2dt(l) * grx(ij, l)  
        END DO  
        DO ij = 1, (iim + 1) * jjm  
           dv(ij, l) = dv(ij, l) - te2dt(l) * gry(ij, l)  
        END DO  
     END DO  
76    
77      ! calcul de la partie div (grad) :      ! calcul de la partie div (grad) :
78    
79      IF (lstardis) THEN      IF (lstardis) THEN
80         DO l = 1, llm         forall (l = 1: llm) deltapres(:, l) = max(0., p(:, l) - p(:, l + 1))
           DO ij = 1, ip1jmp1  
              deltapres(ij, l) = max(0., p(ij, l) - p(ij, l + 1))  
           END DO  
        END DO  
   
81         CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh)         CALL divgrad2(llm, teta, deltapres, niterh, gdx, cdivh)
82      ELSE      ELSE
83         CALL divgrad(llm, teta, niterh, gdx, cdivh)         CALL divgrad(llm, teta, niterh, gdx, cdivh)
84      END IF      END IF
85    
86      forall (l = 1: llm) dh(:, l) = dh(:, l) - te3dt(l) * gdx(:, l)      forall (l = 1: llm) dh(:, :, l) = dh(:, :, l) - te3dt(l) * gdx(:, :, l)
87    
88    END SUBROUTINE dissip    END SUBROUTINE dissip
89    
Legend:
Removed from v.54  
changed lines
  Added in v.55
  ViewVC Help
Powered by ViewVC 1.1.21