source: LMDZ4/trunk/libf/dyn3d/top_bound.F @ 4538

Last change on this file since 4538 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
Line 
1      SUBROUTINE top_bound( vcov,ucov,teta,masse, du,dv,dh )
2      IMPLICIT NONE
3c
4#include "dimensions.h"
5#include "paramet.h"
6#include "comconst.h"
7#include "comvert.h"
8#include "comgeom2.h"
9
10
11c ..  DISSIPATION LINEAIRE A HAUT NIVEAU, RUN MESO,
12C     F. LOTT DEC. 2006
13c                                 (  10/12/06  )
14
15c=======================================================================
16c
17c   Auteur:  F. LOTT 
18c   -------
19c
20c   Objet:
21c   ------
22c
23c   Dissipation linéaire (ex top_bound de la physique)
24c
25c=======================================================================
26c-----------------------------------------------------------------------
27c   Declarations:
28c   -------------
29
30! #include "comgeom.h"
31#include "comdissipn.h"
32
33c   Arguments:
34c   ----------
35
36      REAL ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm),teta(iip1,jjp1,llm)
37      REAL masse(iip1,jjp1,llm)
38      REAL dv(iip1,jjm,llm),du(iip1,jjp1,llm),dh(iip1,jjp1,llm)
39
40c   Local:
41c   ------
42
43      REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm),zm
44      REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
45     
46      INTEGER NDAMP
47      PARAMETER (NDAMP=4)
48      integer i
49      REAL,SAVE :: rdamp(llm)
50!     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
51
52      LOGICAL,SAVE :: first=.true.
53
54      INTEGER j,l
55
56
57C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
58     
59      if (iflag_top_bound.eq.0) return
60
61      if (first) then
62         if (iflag_top_bound.eq.1) then
63! couche eponge dans les 4 dernieres couches du modele
64             rdamp(:)=0.
65             rdamp(llm)=tau_top_bound
66             rdamp(llm-1)=tau_top_bound/2.
67             rdamp(llm-2)=tau_top_bound/4.
68             rdamp(llm-3)=tau_top_bound/8.
69         else if (iflag_top_bound.eq.2) then
70! couce eponge dans toutes les couches de pression plus faible que
71! 100 fois la pression de la derniere couche
72             rdamp(:)=tau_top_bound
73     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
74         endif
75         first=.false.
76         print*,'TOP_BOUND rdamp=',rdamp
77      endif
78
79      CALL massbar(masse,massebx,masseby)
80
81      do l=1,llm
82        do j=1,jjm
83          vzon(j,l)=0.
84          zm=0.
85          do i=1,iim
86! Rm: on peut travailler directement avec la moyenne zonale de vcov
87! plutot qu'avec celle de v car le coefficient cv qui relie les deux
88! ne varie qu'en latitude
89            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
90            zm=zm+masseby(i,j,l)
91          enddo
92          vzon(j,l)=vzon(j,l)/zm
93        enddo
94      enddo
95
96      do l=1,llm
97        do i=1,iip1
98          do j=1,jjm
99            dv(i,j,l)=dv(i,j,l)-rdamp(l)*(vcov(i,j,l)-vzon(j,l))
100          enddo
101        enddo
102      enddo
103
104      do l=1,llm
105        do j=2,jjm
106          uzon(j,l)=0.
107          zm=0.
108          do i=1,iim
109            uzon(j,l)=uzon(j,l)+massebx(i,j,l)*ucov(i,j,l)/cu(i,j)
110            zm=zm+massebx(i,j,l)
111          enddo
112          uzon(j,l)=uzon(j,l)/zm
113        enddo
114      enddo
115
116      do l=1,llm
117        do j=2,jjm
118          zm=0.
119          tzon(j,l)=0.
120          do i=1,iim
121            tzon(j,l)=tzon(j,l)+teta(i,j,l)*masse(i,j,l)
122            zm=zm+masse(i,j,l)
123          enddo
124          tzon(j,l)=tzon(j,l)/zm
125        enddo
126      enddo
127
128C   AMORTISSEMENTS LINEAIRES:
129
130      do l=1,llm
131        do i=1,iip1
132          do j=2,jjm
133            du(i,j,l)=du(i,j,l)
134     s               -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
135            dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
136          enddo
137        enddo
138      enddo
139     
140
141      RETURN
142      END
Note: See TracBrowser for help on using the repository browser.