My Project
 All Classes Files Functions Variables Macros
top_bound_p.F
Go to the documentation of this file.
1  SUBROUTINE top_bound_p( 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,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 
40 c Local:
41 c ------
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
56 c$OMP BARRIER
57 c$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
73 c$OMP END MASTER
74 c$OMP BARRIER
75  endif
76 
77 
78  CALL massbar_p(masse,massebx,masseby)
79 C CALCUL DES CHAMPS EN MOYENNE ZONALE:
80 
81  jjb=jj_begin
82  jje=jj_end
83  IF (pole_sud) jje=jj_end-1
84 
85 c$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
100 c$OMP END DO NOWAIT
101 
102 c$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
110 c$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 
117 c$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
129 c$OMP END DO NOWAIT
130 
131 c$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
143 c$OMP END DO NOWAIT
144 
145 C AMORTISSEMENTS LINEAIRES:
146 
147 c$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
157 c$OMP END DO NOWAIT
158 
159 
160  RETURN
161  END