My Project
 All Classes Files Functions Variables Macros
dissip.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4  SUBROUTINE dissip( vcov,ucov,teta,p, dv,du,dh )
5 c
6  IMPLICIT NONE
7 
8 
9 c .. Avec nouveaux operateurs star : gradiv2 , divgrad2, nxgraro2 ...
10 c ( 10/01/98 )
11 
12 c=======================================================================
13 c
14 c Auteur: P. Le Van
15 c -------
16 c
17 c Objet:
18 c ------
19 c
20 c Dissipation horizontale
21 c
22 c=======================================================================
23 c-----------------------------------------------------------------------
24 c Declarations:
25 c -------------
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 
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