source: LMDZ5/branches/testing/libf/dyn3dpar/top_bound_p.F @ 1663

Last change on this file since 1663 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: 4.0 KB
Line 
1      SUBROUTINE top_bound_p( vcov,ucov,teta,masse, du,dv,dh )
2      USE parallel
3      IMPLICIT NONE
4c
5#include "dimensions.h"
6#include "paramet.h"
7#include "comconst.h"
8#include "comvert.h"
9#include "comgeom2.h"
10
11
12c ..  DISSIPATION LINEAIRE A HAUT NIVEAU, RUN MESO,
13C     F. LOTT DEC. 2006
14c                                 (  10/12/06  )
15
16c=======================================================================
17c
18c   Auteur:  F. LOTT 
19c   -------
20c
21c   Objet:
22c   ------
23c
24c   Dissipation linéaire (ex top_bound de la physique)
25c
26c=======================================================================
27c-----------------------------------------------------------------------
28c   Declarations:
29c   -------------
30
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      REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm),zm
43      REAL uzon(jjp1,llm),vzon(jjm,llm),tzon(jjp1,llm)
44     
45      INTEGER NDAMP
46      PARAMETER (NDAMP=4)
47      integer i
48      REAL,SAVE :: rdamp(llm)
49!     &   (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
50      LOGICAL,SAVE :: first=.true.
51      INTEGER j,l,jjb,jje
52
53
54      if (iflag_top_bound == 0) return
55      if (first) then
56c$OMP BARRIER
57c$OMP MASTER
58         if (iflag_top_bound == 1) then
59! couche eponge dans les 4 dernieres couches du modele
60             rdamp(:)=0.
61             rdamp(llm)=tau_top_bound
62             rdamp(llm-1)=tau_top_bound/2.
63             rdamp(llm-2)=tau_top_bound/4.
64             rdamp(llm-3)=tau_top_bound/8.
65         else if (iflag_top_bound == 2) then
66! couce eponge dans toutes les couches de pression plus faible que
67! 100 fois la pression de la derniere couche
68             rdamp(:)=tau_top_bound
69     s       *max(presnivs(llm)/presnivs(:)-0.01,0.)
70         endif
71         first=.false.
72         print*,'TOP_BOUND rdamp=',rdamp
73c$OMP END MASTER
74c$OMP BARRIER
75      endif
76
77
78      CALL massbar_p(masse,massebx,masseby)
79C  CALCUL DES CHAMPS EN MOYENNE ZONALE:
80
81      jjb=jj_begin
82      jje=jj_end
83      IF (pole_sud) jje=jj_end-1
84
85c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
86      do l=1,llm
87        do j=jjb,jje
88          zm=0.
89          vzon(j,l)=0
90          do i=1,iim
91! Rm: on peut travailler directement avec la moyenne zonale de vcov
92! plutot qu'avec celle de v car le coefficient cv qui relie les deux
93! ne varie qu'en latitude
94            vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
95            zm=zm+masseby(i,j,l)
96          enddo
97          vzon(j,l)=vzon(j,l)/zm
98        enddo
99      enddo
100c$OMP END DO NOWAIT   
101
102c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
103      do l=1,llm
104        do j=jjb,jje
105          do i=1,iip1
106            dv(i,j,l)=dv(i,j,l)-rdamp(l)*(vcov(i,j,l)-vzon(j,l))
107          enddo
108        enddo
109      enddo
110c$OMP END DO NOWAIT
111
112      jjb=jj_begin
113      jje=jj_end
114      IF (pole_nord) jjb=jj_begin+1
115      IF (pole_sud)  jje=jj_end-1
116
117c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
118      do l=1,llm
119        do j=jjb,jje
120          uzon(j,l)=0.
121          zm=0.
122          do i=1,iim
123            uzon(j,l)=uzon(j,l)+massebx(i,j,l)*ucov(i,j,l)/cu(i,j)
124            zm=zm+massebx(i,j,l)
125          enddo
126          uzon(j,l)=uzon(j,l)/zm
127        enddo
128      enddo
129c$OMP END DO NOWAIT
130
131c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
132      do l=1,llm
133        do j=jjb,jje
134          zm=0.
135          tzon(j,l)=0.
136          do i=1,iim
137            tzon(j,l)=tzon(j,l)+teta(i,j,l)*masse(i,j,l)
138            zm=zm+masse(i,j,l)
139          enddo
140          tzon(j,l)=tzon(j,l)/zm
141        enddo
142      enddo
143c$OMP END DO NOWAIT
144
145C   AMORTISSEMENTS LINEAIRES:
146
147c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
148      do l=1,llm
149        do j=jjb,jje
150          do i=1,iip1
151            du(i,j,l)=du(i,j,l)
152     s               -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
153            dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
154          enddo
155       enddo
156      enddo
157c$OMP END DO NOWAIT
158     
159
160      RETURN
161      END
Note: See TracBrowser for help on using the repository browser.