source: LMDZ5/trunk/libf/dyn3d/dissip.F @ 4604

Last change on this file since 4604 was 2597, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1!
2! $Id: dissip.F 2597 2016-07-22 06:44:47Z ymeurdesoif $
3!
4      SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
5c
6      USE comconst_mod, ONLY: dtdiss
7     
8      IMPLICIT NONE
9
10
11c ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
12c                                 (  10/01/98  )
13
14c=======================================================================
15c
16c   Auteur:  P. Le Van
17c   -------
18c
19c   Objet:
20c   ------
21c
22c   Dissipation horizontale
23c
24c=======================================================================
25c-----------------------------------------------------------------------
26c   Declarations:
27c   -------------
28
29      include "dimensions.h"
30      include "paramet.h"
31      include "comgeom.h"
32      include "comdissnew.h"
33      include "comdissipn.h"
34
35c   Arguments:
36c   ----------
37
38      REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
39      REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
40      REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature
41      REAL,INTENT(IN) :: p(ip1jmp1,llmp1) ! pressure
42      ! tendencies (.../s) on covariant winds and potential temperature
43      REAL,INTENT(OUT) :: dv(ip1jm,llm)
44      REAL,INTENT(OUT) :: du(ip1jmp1,llm)
45      REAL,INTENT(OUT) :: dh(ip1jmp1,llm)
46
47c   Local:
48c   ------
49
50      REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
51      REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
52      REAL te1dt(llm),te2dt(llm),te3dt(llm)
53      REAL deltapres(ip1jmp1,llm)
54
55      INTEGER l,ij
56
57      REAL  SSUM
58
59c-----------------------------------------------------------------------
60c   initialisations:
61c   ----------------
62
63      DO l=1,llm
64         te1dt(l) = tetaudiv(l) * dtdiss
65         te2dt(l) = tetaurot(l) * dtdiss
66         te3dt(l) = tetah(l)    * dtdiss
67      ENDDO
68      du=0.
69      dv=0.
70      dh=0.
71
72c-----------------------------------------------------------------------
73c   Calcul de la dissipation:
74c   -------------------------
75
76c   Calcul de la partie   grad  ( div ) :
77c   -------------------------------------
78
79
80      IF(lstardis) THEN
81         CALL gradiv2( llm,ucov,vcov,nitergdiv,gdx,gdy )
82      ELSE
83         CALL gradiv ( llm,ucov,vcov,nitergdiv,gdx,gdy )
84      ENDIF
85
86      DO l=1,llm
87
88         DO ij = 1, iip1
89            gdx(     ij ,l) = 0.
90            gdx(ij+ip1jm,l) = 0.
91         ENDDO
92
93         DO ij = iip2,ip1jm
94            du(ij,l) = du(ij,l) - te1dt(l) *gdx(ij,l)
95         ENDDO
96         DO ij = 1,ip1jm
97            dv(ij,l) = dv(ij,l) - te1dt(l) *gdy(ij,l)
98         ENDDO
99
100       ENDDO
101
102c   calcul de la partie   n X grad ( rot ):
103c   ---------------------------------------
104
105      IF(lstardis) THEN
106         CALL nxgraro2( llm,ucov, vcov, nitergrot,grx,gry )
107      ELSE
108         CALL nxgrarot( llm,ucov, vcov, nitergrot,grx,gry )
109      ENDIF
110
111
112      DO l=1,llm
113         DO ij = 1, iip1
114            grx(ij,l) = 0.
115         ENDDO
116
117         DO ij = iip2,ip1jm
118            du(ij,l) = du(ij,l) - te2dt(l) * grx(ij,l)
119         ENDDO
120         DO ij =  1, ip1jm
121            dv(ij,l) = dv(ij,l) - te2dt(l) * gry(ij,l)
122         ENDDO
123      ENDDO
124
125c   calcul de la partie   div ( grad ):
126c   -----------------------------------
127
128       
129      IF(lstardis) THEN
130
131       DO l = 1, llm
132          DO ij = 1, ip1jmp1
133            deltapres(ij,l) = AMAX1( 0.,  p(ij,l) - p(ij,l+1) )
134          ENDDO
135       ENDDO
136
137         CALL divgrad2( llm,teta, deltapres  ,niterh, gdx )
138      ELSE
139         CALL divgrad ( llm,teta, niterh, gdx        )
140      ENDIF
141
142      DO l = 1,llm
143         DO ij = 1,ip1jmp1
144            dh( ij,l ) = dh( ij,l ) - te3dt(l) * gdx( ij,l )
145         ENDDO
146      ENDDO
147
148      RETURN
149      END
Note: See TracBrowser for help on using the repository browser.