My Project
 All Classes Files Functions Variables Macros
top_bound_loc.F
Go to the documentation of this file.
1  SUBROUTINE top_bound_loc( vcov,ucov,teta,masse, du,dv,dh )
2  USE parallel
3  IMPLICIT NONE
4 c
5 #include "dimensions.h"
6 #include "paramet.h"
7 #include "comconst.h"
8 #include "comvert.h"
9 #include "comgeom2.h"
10 
11 
12 c .. DISSIPATION LINEAIRE A HAUT NIVEAU, RUN MESO,
13 C F. LOTT DEC. 2006
14 c ( 10/12/06 )
15 
16 c=======================================================================
17 c
18 c Auteur: F. LOTT
19 c -------
20 c
21 c Objet:
22 c ------
23 c
24 c Dissipation linéaire (ex top_bound de la physique)
25 c
26 c=======================================================================
27 c-----------------------------------------------------------------------
28 c Declarations:
29 c -------------
30 
31 #include "comdissipn.h"
32 
33 c Arguments:
34 c ----------
35 
36  REAL ucov(iip1,jjb_u:jje_u,llm),vcov(iip1,jjb_v:jje_v,llm)
37  REAL teta(iip1,jjb_u:jje_u,llm)
38  REAL masse(iip1,jjb_u:jje_u,llm)
39  REAL dv(iip1,jjb_v:jje_v,llm),du(iip1,jjb_u:jje_u,llm)
40  REAL dh(iip1,jjb_u:jje_u,llm)
41 
42 c Local:
43 c ------
44  REAL massebx(iip1,jjb_u:jje_u,llm),masseby(iip1,jjb_v:jje_v,llm)
45  REAL zm
46  REAL uzon(jjb_u:jje_u,llm),vzon(jjb_v:jje_v,llm)
47  REAL tzon(jjb_u:jje_u,llm)
48 
49  INTEGER ndamp
50  parameter(ndamp=4)
51  integer i
52  REAL,SAVE :: rdamp(llm)
53 ! & (/(0., i =1,llm-NDAMP),0.125E-5,.25E-5,.5E-5,1.E-5/)
54  LOGICAL,SAVE :: first=.true.
55  INTEGER j,l,jjb,jje
56 
57 
58  if (iflag_top_bound == 0) return
59  if (first) then
60 c$OMP BARRIER
61 c$OMP MASTER
62  if (iflag_top_bound == 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 == 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 c$OMP END MASTER
78 c$OMP BARRIER
79  endif
80 
81 
82  CALL massbar_loc(masse,massebx,masseby)
83 C CALCUL DES CHAMPS EN MOYENNE ZONALE:
84 
85  jjb=jj_begin
86  jje=jj_end
87  IF (pole_sud) jje=jj_end-1
88 
89 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
90  do l=1,llm
91  do j=jjb,jje
92  zm=0.
93  vzon(j,l)=0
94  do i=1,iim
95 ! Rm: on peut travailler directement avec la moyenne zonale de vcov
96 ! plutot qu'avec celle de v car le coefficient cv qui relie les deux
97 ! ne varie qu'en latitude
98  vzon(j,l)=vzon(j,l)+vcov(i,j,l)*masseby(i,j,l)
99  zm=zm+masseby(i,j,l)
100  enddo
101  vzon(j,l)=vzon(j,l)/zm
102  enddo
103  enddo
104 c$OMP END DO NOWAIT
105 
106 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
107  do l=1,llm
108  do j=jjb,jje
109  do i=1,iip1
110  dv(i,j,l)=dv(i,j,l)-rdamp(l)*(vcov(i,j,l)-vzon(j,l))
111  enddo
112  enddo
113  enddo
114 c$OMP END DO NOWAIT
115 
116  jjb=jj_begin
117  jje=jj_end
118  IF (pole_nord) jjb=jj_begin+1
119  IF (pole_sud) jje=jj_end-1
120 
121 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
122  do l=1,llm
123  do j=jjb,jje
124  uzon(j,l)=0.
125  zm=0.
126  do i=1,iim
127  uzon(j,l)=uzon(j,l)+massebx(i,j,l)*ucov(i,j,l)/cu(i,j)
128  zm=zm+massebx(i,j,l)
129  enddo
130  uzon(j,l)=uzon(j,l)/zm
131  enddo
132  enddo
133 c$OMP END DO NOWAIT
134 
135 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
136  do l=1,llm
137  do j=jjb,jje
138  zm=0.
139  tzon(j,l)=0.
140  do i=1,iim
141  tzon(j,l)=tzon(j,l)+teta(i,j,l)*masse(i,j,l)
142  zm=zm+masse(i,j,l)
143  enddo
144  tzon(j,l)=tzon(j,l)/zm
145  enddo
146  enddo
147 c$OMP END DO NOWAIT
148 
149 C AMORTISSEMENTS LINEAIRES:
150 
151 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
152  do l=1,llm
153  do j=jjb,jje
154  do i=1,iip1
155  du(i,j,l)=du(i,j,l)
156  s -rdamp(l)*(ucov(i,j,l)-cu(i,j)*uzon(j,l))
157  dh(i,j,l)=dh(i,j,l)-rdamp(l)*(teta(i,j,l)-tzon(j,l))
158  enddo
159  enddo
160  enddo
161 c$OMP END DO NOWAIT
162 
163 
164  RETURN
165  END