My Project
 All Classes Files Functions Variables Macros
call_dissip_mod.F90
Go to the documentation of this file.
1 MODULE call_dissip_mod
2 
3  REAL,POINTER,SAVE :: ucov(:,:)
4  REAL,POINTER,SAVE :: vcov(:,:)
5  REAL,POINTER,SAVE :: teta(:,:)
6  REAL,POINTER,SAVE :: p(:,: )
7  REAL,POINTER,SAVE :: pk(:,:)
8 
9  REAL,POINTER,SAVE :: ucont(:,:)
10  REAL,POINTER,SAVE :: vcont(:,:)
11  REAL,POINTER,SAVE :: ecin(:,:)
12  REAL,POINTER,SAVE :: ecin0(:,:)
13  REAL,POINTER,SAVE :: dudis(:,:)
14  REAL,POINTER,SAVE :: dvdis(:,:)
15  REAL,POINTER,SAVE :: dtetadis(:,:)
16  REAL,POINTER,SAVE :: dtetaecdt(:,:)
17 
18 
19 
20 CONTAINS
21 
22  SUBROUTINE call_dissip_allocate
23  USE bands
24  USE allocate_field
25  USE parallel
26  USE dimensions
27  USE dissip_mod, ONLY : dissip_allocate
28  IMPLICIT NONE
29  TYPE(distrib),POINTER :: d
30  d=>distrib_dissip
31 
32  CALL allocate_u(ucov,llm,d)
33  CALL allocate_v(vcov,llm,d)
34  CALL allocate_u(teta,llm,d)
35  CALL allocate_u(p,llmp1,d)
36  CALL allocate_u(pk,llm,d)
37  CALL allocate_u(ucont,llm,d)
38  CALL allocate_v(vcont,llm,d)
39  CALL allocate_u(ecin,llm,d)
40  CALL allocate_u(ecin0,llm,d)
41  CALL allocate_u(dudis,llm,d)
42  CALL allocate_v(dvdis,llm,d)
43  CALL allocate_u(dtetadis,llm,d)
44  CALL allocate_u(dtetaecdt,llm,d)
45 
46 
47  CALL dissip_allocate
48 
49  END SUBROUTINE call_dissip_allocate
50 
51  SUBROUTINE call_dissip_switch_dissip(dist)
52  USE allocate_field
53  USE bands
54  USE parallel
55  USE dissip_mod, ONLY : dissip_switch_dissip
56  IMPLICIT NONE
57  TYPE(distrib),INTENT(IN) :: dist
58 
59  CALL switch_u(ucov,distrib_dissip,dist)
60  CALL switch_v(vcov,distrib_dissip,dist)
61  CALL switch_u(teta,distrib_dissip,dist)
62  CALL switch_u(p,distrib_dissip,dist)
63  CALL switch_u(pk,distrib_dissip,dist)
64  CALL switch_u(ucont,distrib_dissip,dist)
65  CALL switch_v(vcont,distrib_dissip,dist)
66  CALL switch_u(ecin,distrib_dissip,dist)
67  CALL switch_u(ecin0,distrib_dissip,dist)
68  CALL switch_u(dudis,distrib_dissip,dist)
69  CALL switch_v(dvdis,distrib_dissip,dist)
70  CALL switch_u(dtetadis,distrib_dissip,dist)
71  CALL switch_u(dtetaecdt,distrib_dissip,dist)
72 
73  CALL dissip_switch_dissip(dist)
74 
75  END SUBROUTINE call_dissip_switch_dissip
76 
77 
78 
79  SUBROUTINE call_dissip(ucov_dyn,vcov_dyn,teta_dyn,p_dyn,pk_dyn,ps_dyn)
80  USE dimensions
81  USE parallel
82  USE times
83  USE mod_hallo
84  USE bands
85  USE vampir
86  USE write_field_loc
87  IMPLICIT NONE
88  include 'comgeom.h'
89  REAL :: ucov_dyn(ijb_u:ije_u,llm)
90  REAL :: vcov_dyn(ijb_v:ije_v,llm)
91  REAL :: teta_dyn(ijb_u:ije_u,llm)
92  REAL :: p_dyn(ijb_u:ije_u,llmp1 )
93  REAL :: pk_dyn(ijb_u:ije_u,llm)
94  REAL :: ps_dyn(ijb_u:ije_u)
95  REAL :: tppn(iim),tpps(iim)
96  REAL :: tpn,tps
97 
98  REAL ssum
99  LOGICAL,PARAMETER :: dissip_conservative=.true.
100  TYPE(request) :: request_dissip
101 
102  INTEGER :: ij,l,ijb,ije
103 
104 
105  !$OMP MASTER
106  CALL suspend_timer(timer_caldyn)
107 
108 ! print*,'Entree dans la dissipation : Iteration No ',true_itau
109 ! calcul de l'energie cinetique avant dissipation
110 ! print *,'Passage dans la dissipation'
111 
112  CALL vtb(vthallo)
113  !$OMP END MASTER
114 
115  !$OMP BARRIER
116 
117  CALL register_swapfield_u(ucov_dyn,ucov,distrib_dissip, request_dissip,up=1,down=1)
118  CALL register_swapfield_v(vcov_dyn,vcov,distrib_dissip, request_dissip,up=1,down=1)
119  CALL register_swapfield_u(teta_dyn,teta,distrib_dissip, request_dissip)
120  CALL register_swapfield_u(p_dyn,p,distrib_dissip,request_dissip)
121  CALL register_swapfield_u(pk_dyn,pk,distrib_dissip,request_dissip)
122 
123  CALL sendrequest(request_dissip)
124  !$OMP BARRIER
125  CALL waitrequest(request_dissip)
126 
127  !$OMP BARRIER
128  !$OMP MASTER
129  CALL set_distrib(distrib_dissip)
130  CALL vte(vthallo)
131  CALL vtb(vtdissipation)
132  CALL start_timer(timer_dissip)
133  !$OMP END MASTER
134  !$OMP BARRIER
135 
136  CALL covcont_loc(llm,ucov,vcov,ucont,vcont)
137  CALL enercin_loc(vcov,ucov,vcont,ucont,ecin0)
138 
139 ! dissipation
140 
141 ! CALL FTRACE_REGION_BEGIN("dissip")
142  CALL dissip_loc(vcov,ucov,teta,p,dvdis,dudis,dtetadis)
143 
144 #ifdef DEBUG_IO
145  CALL writefield_u('dudis',dudis)
146  CALL writefield_v('dvdis',dvdis)
147  CALL writefield_u('dtetadis',dtetadis)
148 #endif
149 
150 ! CALL FTRACE_REGION_END("dissip")
151 
152  ijb=ij_begin
153  ije=ij_end
154  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
155  DO l=1,llm
156  ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l)
157  ENDDO
158  !$OMP END DO NOWAIT
159 
160  IF (pole_sud) ije=ije-iip1
161 
162  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
163  DO l=1,llm
164  vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l)
165  ENDDO
166  !$OMP END DO NOWAIT
167 
168 ! teta=teta+dtetadis
169 
170 
171 !------------------------------------------------------------------------
172  IF (dissip_conservative) THEN
173 ! On rajoute la tendance due a la transform. Ec -> E therm. cree
174 ! lors de la dissipation
175  !$OMP BARRIER
176  !$OMP MASTER
177  CALL suspend_timer(timer_dissip)
178  CALL vtb(vthallo)
179  !$OMP END MASTER
180  CALL register_hallo_u(ucov,llm,1,1,1,1,request_dissip)
181  CALL register_hallo_v(vcov,llm,1,1,1,1,request_dissip)
182  CALL sendrequest(request_dissip)
183  !$OMP BARRIER
184  CALL waitrequest(request_dissip)
185  !$OMP MASTER
186  CALL vte(vthallo)
187  CALL resume_timer(timer_dissip)
188  !$OMP END MASTER
189  !$OMP BARRIER
190  CALL covcont_loc(llm,ucov,vcov,ucont,vcont)
191  CALL enercin_loc(vcov,ucov,vcont,ucont,ecin)
192 
193  ijb=ij_begin
194  ije=ij_end
195  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
196  DO l=1,llm
197  DO ij=ijb,ije
198  dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l)
199  dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l)
200  ENDDO
201  ENDDO
202  !$OMP END DO NOWAIT
203 
204  ENDIF
205 
206  ijb=ij_begin
207  ije=ij_end
208 
209  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
210  DO l=1,llm
211  DO ij=ijb,ije
212  teta(ij,l)=teta(ij,l)+dtetadis(ij,l)
213  ENDDO
214  ENDDO
215  !$OMP END DO NOWAIT
216 
217 !------------------------------------------------------------------------
218 
219 
220 ! ....... P. Le Van ( ajout le 17/04/96 ) ...........
221 ! ... Calcul de la valeur moyenne, unique de h aux poles .....
222 !
223 
224  ijb=ij_begin
225  ije=ij_end
226 
227  IF (pole_nord) THEN
228 
229  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
230  DO l = 1, llm
231  DO ij = 1,iim
232  tppn(ij) = aire( ij ) * teta( ij ,l)
233  ENDDO
234  tpn = ssum(iim,tppn,1)/apoln
235 
236  DO ij = 1, iip1
237  teta( ij ,l) = tpn
238  ENDDO
239  ENDDO
240  !$OMP END DO NOWAIT
241 
242  if (1 == 0) then
243 !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
244 !!! 2) should probably not be here anyway
245 !!! but are kept for those who would want to revert to previous behaviour
246  !$OMP MASTER
247  DO ij = 1,iim
248  tppn(ij) = aire( ij ) * ps_dyn( ij )
249  ENDDO
250  tpn = ssum(iim,tppn,1)/apoln
251 
252  DO ij = 1, iip1
253  ps_dyn( ij ) = tpn
254  ENDDO
255  !$OMP END MASTER
256 
257  ENDIF ! of if (1 == 0)
258  endif ! of of (pole_nord)
259 
260  IF (pole_sud) THEN
261 
262  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
263  DO l = 1, llm
264  DO ij = 1,iim
265  tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
266  ENDDO
267 
268  tps = ssum(iim,tpps,1)/apols
269 
270  DO ij = 1, iip1
271  teta(ij+ip1jm,l) = tps
272  ENDDO
273  ENDDO
274  !$OMP END DO NOWAIT
275 
276  if (1 == 0) then
277 !!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
278 !!! 2) should probably not be here anyway
279 !!! but are kept for those who would want to revert to previous behaviour
280  !$OMP MASTER
281  DO ij = 1,iim
282  tpps(ij) = aire(ij+ip1jm) * ps_dyn(ij+ip1jm)
283  ENDDO
284  tps = ssum(iim,tpps,1)/apols
285 
286  DO ij = 1, iip1
287  ps_dyn(ij+ip1jm) = tps
288  ENDDO
289  !$OMP END MASTER
290  ENDIF ! of if (1 == 0)
291  endif ! of if (pole_sud)
292 
293 
294  !$OMP BARRIER
295  !$OMP MASTER
296  CALL vte(vtdissipation)
297  CALL stop_timer(timer_dissip)
298  CALL vtb(vthallo)
299  !$OMP END MASTER
300 
301  CALL register_swapfield_u(ucov,ucov_dyn,distrib_caldyn,request_dissip)
302  CALL register_swapfield_v(vcov,vcov_dyn,distrib_caldyn,request_dissip)
303  CALL register_swapfield_u(teta,teta_dyn,distrib_caldyn,request_dissip)
304  CALL register_swapfield_u(p,p_dyn,distrib_caldyn,request_dissip)
305  CALL register_swapfield_u(pk,pk_dyn,distrib_caldyn,request_dissip)
306 
307  CALL sendrequest(request_dissip)
308 
309  !$OMP BARRIER
310  CALL waitrequest(request_dissip)
311  !$OMP BARRIER
312  !$OMP MASTER
313  CALL set_distrib(distrib_caldyn)
314  CALL vte(vthallo)
315  CALL resume_timer(timer_caldyn)
316 ! print *,'fin dissipation'
317  !$OMP END MASTER
318  !$OMP BARRIER
319 
320 
321  END SUBROUTINE call_dissip
322 
323 END MODULE call_dissip_mod