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

Annotation of /trunk/libf/dyn3d/dissip.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 3 months ago) by guez
Original Path: trunk/libf/dyn3d/dissip.f
File size: 3312 byte(s)
Initial import
1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/dissip.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
3     !
4     SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
5     c
6     use dimens_m
7     use paramet_m
8     use comconst
9     use comdissnew
10     use comgeom
11     IMPLICIT NONE
12    
13    
14     c .. Avec nouveaux operateurs star : gradiv2 , divgrad2, nxgraro2 ...
15     c ( 10/01/98 )
16    
17     c=======================================================================
18     c
19     c Auteur: P. Le Van
20     c -------
21     c
22     c Objet:
23     c ------
24     c
25     c Dissipation horizontale
26     c
27     c=======================================================================
28     c-----------------------------------------------------------------------
29     c Declarations:
30     c -------------
31    
32     include "comdissipn.h"
33    
34     c Arguments:
35     c ----------
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    
41     c Local:
42     c ------
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    
53     c-----------------------------------------------------------------------
54     c initialisations:
55     c ----------------
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    
66     c-----------------------------------------------------------------------
67     c Calcul de la dissipation:
68     c -------------------------
69    
70     c Calcul de la partie grad ( div ) :
71     c -------------------------------------
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    
96     c calcul de la partie n X grad ( rot ):
97     c ---------------------------------------
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    
119     c calcul de la partie div ( grad ):
120     c -----------------------------------
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

  ViewVC Help
Powered by ViewVC 1.1.21