Context Navigation

call_dissip_mod.F90 @ 4203

Last change on this file since 4203 was 3406, checked in by jghattas, 6 years ago
Added all modifications in the model code that were used for the simulations with DYANMICO during the Grand Challeng 2018. Modifications done by Y. Meurdesoif, L. Fairhead and A.K. Traore
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 8.8 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format