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

Contents of /trunk/libf/dyn3d/dissip.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 10 - (show annotations)
Fri Apr 18 14:45:53 2008 UTC (16 years ago) by guez
File size: 3325 byte(s) 
Added NetCDF directory "/home/guez/include" in "g95.mk" and
"nag_tools.mk".

Added some "intent" attributes in "PVtheta", "advtrac", "caladvtrac",
"calfis", "diagedyn", "dissip", "vlspltqs", "aeropt", "ajsec",
"calltherm", "clmain", "cltrac", "cltracrn", "concvl", "conema3",
"conflx", "fisrtilp", "newmicro", "nuage", "diagcld1", "diagcld2",
"drag_noro", "lift_noro", "SUGWD", "physiq", "phytrac", "radlwsw", "thermcell".

Removed the case "ierr == 0" in "abort_gcm"; moved call to "histclo"
and messages for end of run from "abort_gcm" to "gcm"; replaced call
to "abort_gcm" in "leapfrog" by exit from outer loop.

In "calfis": removed argument "pp" and variable "unskap"; changed
"pksurcp" from scalar to rank 2; use "pressure_var"; rewrote
computation of "zplev", "zplay", "ztfi", "pcvgt" using "dyn_phy";
added computation of "pls".

Removed unused variable in "dynredem0".

In "exner_hyb": changed "dellta" from scalar to rank 1; replaced call
to "ssum" by call to "sum"; removed variables "xpn" and "xps";
replaced some loops by array expressions.

In "leapfrog": use "pressure_var"; deleted variables "p", "longcles".

Converted common blocks "YOECUMF", "YOEGWD" to modules.

Removed argument "pplay" in "cvltr", "diagetpq", "nflxtr".

Created module "raddimlw" from include file "raddimlw.h".

Corrected call to "new_unit" in "test_disvert".
1 !
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, intent(in):: 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