Context Navigation

call_dissip_mod.F90 @ 3605

Last change on this file since 3605 was 3605, checked in by lguez, 5 years ago
Merge revisions 3427:3600 of trunk into branch `Ocean_skin`
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