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

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • 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.2 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
5c
6      IMPLICIT NONE
7
8
9c ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
10c                                 (  10/01/98  )
11
12c=======================================================================
13c
14c   Auteur:  P. Le Van
15c   -------
16c
17c   Objet:
18c   ------
19c
20c   Dissipation horizontale
21c
22c=======================================================================
23c-----------------------------------------------------------------------
24c   Declarations:
25c   -------------
26
27#include "dimensions.h"
28#include "paramet.h"
29#include "comconst.h"
30#include "comgeom.h"
31#include "comdissnew.h"
32#include "comdissipn.h"
33
34c   Arguments:
35c   ----------
36
37      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
38      REAL  p( ip1jmp1,llmp1 )
39      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dh(ip1jmp1,llm)
40
41c   Local:
42c   ------
43
44      REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
45      REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
46      REAL te1dt(llm),te2dt(llm),te3dt(llm)
47      REAL deltapres(ip1jmp1,llm)
48
49      INTEGER l,ij
50
51      REAL  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      du=0.
63      dv=0.
64      dh=0.
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.