source: trunk/LMDZ.GENERIC/libf/dyn3d/dissip.F @ 2236

Last change on this file since 2236 was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).

File size: 3.3 KB
RevLine 
[135]1      SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
2c
[1422]3      USE comconst_mod, ONLY: dtdiss
4
[135]5      IMPLICIT NONE
6
7
8c ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
9c                                 (  10/01/98  )
10
11c=======================================================================
12c
13c   Auteur:  P. Le Van
14c   -------
15c
16c   Objet:
17c   ------
18c
19c   Dissipation horizontale
20c
21c=======================================================================
22c-----------------------------------------------------------------------
23c   Declarations:
24c   -------------
25
26#include "dimensions.h"
27#include "paramet.h"
28#include "comgeom.h"
29#include "comdissnew.h"
30#include "comdissipn.h"
31
32c   Arguments:
33c   ----------
34
35      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
36      REAL  p( ip1jmp1,llmp1 )
37      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dh(ip1jmp1,llm)
38
39c   Local:
40c   ------
41
42      REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
43      REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
44      REAL te1dt(llm),te2dt(llm),te3dt(llm)
45      REAL deltapres(ip1jmp1,llm)
46
47      INTEGER l,ij
48
49      REAL  SSUM
50      EXTERNAL  gradiv ,nXgrarot,divgrad,initial0
51      EXTERNAL  gradiv2,nXgraro2,divgrad2,SSUM
52
53c-----------------------------------------------------------------------
54c   initialisations:
55c   ----------------
56
57      DO l=1,llm
58         te1dt(l) = tetaudiv(l) * dtdiss
59         te2dt(l) = tetaurot(l) * dtdiss
60         te3dt(l) = tetah(l)    * dtdiss
61      ENDDO
62      CALL initial0( ijp1llm, du )
63      CALL initial0( ijmllm , dv )
64      CALL initial0( ijp1llm, dh )
65
66c-----------------------------------------------------------------------
67c   Calcul de la dissipation:
68c   -------------------------
69
70c   Calcul de la partie   grad  ( div ) :
71c   -------------------------------------
72
73
74      IF(lstardis) THEN
75         CALL gradiv2( llm,ucov,vcov,nitergdiv,gdx,gdy )
76      ELSE
77         CALL gradiv ( llm,ucov,vcov,nitergdiv,gdx,gdy )
78      ENDIF
79
80      DO l=1,llm
81
82         DO ij = 1, iip1
83            gdx(     ij ,l) = 0.
84            gdx(ij+ip1jm,l) = 0.
85         ENDDO
86
87         DO ij = iip2,ip1jm
88            du(ij,l) = du(ij,l) - te1dt(l) *gdx(ij,l)
89         ENDDO
90         DO ij = 1,ip1jm
91            dv(ij,l) = dv(ij,l) - te1dt(l) *gdy(ij,l)
92         ENDDO
93
94       ENDDO
95
96c   calcul de la partie   n X grad ( rot ):
97c   ---------------------------------------
98
99      IF(lstardis) THEN
100         CALL nxgraro2( llm,ucov, vcov, nitergrot,grx,gry )
101      ELSE
102         CALL nxgrarot( llm,ucov, vcov, nitergrot,grx,gry )
103      ENDIF
104
105
106      DO l=1,llm
107         DO ij = 1, iip1
108            grx(ij,l) = 0.
109         ENDDO
110
111         DO ij = iip2,ip1jm
112            du(ij,l) = du(ij,l) - te2dt(l) * grx(ij,l)
113         ENDDO
114         DO ij =  1, ip1jm
115            dv(ij,l) = dv(ij,l) - te2dt(l) * gry(ij,l)
116         ENDDO
117      ENDDO
118
119c   calcul de la partie   div ( grad ):
120c   -----------------------------------
121
122       
123      IF(lstardis) THEN
124
125       DO l = 1, llm
126          DO ij = 1, ip1jmp1
127            deltapres(ij,l) = AMAX1( 0.,  p(ij,l) - p(ij,l+1) )
128          ENDDO
129       ENDDO
130
131         CALL divgrad2( llm,teta, deltapres  ,niterh, gdx )
132      ELSE
133         CALL divgrad ( llm,teta, niterh, gdx        )
134      ENDIF
135
136      DO l = 1,llm
137         DO ij = 1,ip1jmp1
138            dh( ij,l ) = dh( ij,l ) - te3dt(l) * gdx( ij,l )
139         ENDDO
140      ENDDO
141
142      RETURN
143      END
Note: See TracBrowser for help on using the repository browser.