source: LMDZ.3.3/trunk/libf/dyn3d/dissip.F @ 432

Last change on this file since 432 was 2, checked in by lmdz, 25 years ago

Initial revision

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