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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 10 - (hide annotations)
Fri Apr 18 14:45:53 2008 UTC (16 years, 2 months 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 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 guez 10 REAL, intent(in):: p( ip1jmp1,llmp1 )
39 guez 3 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