Context Navigation

call_calfis_mod.F90 @ 5440

Last change on this file since 5440 was 1857, checked in by Ehouarn Millour, 11 years ago
Remove call to diagedyn. Current diagedyn is supposed to work on global arrays, which is not compatible with dyn3dmem settings. Extra work is required if we want to adapt diagedyn to dyn3dmem (but diagedyn currently doesn't work even in seq mode...). EM
File size: 11.3 KB

Line
1	!#define DEBUG_IO
2	MODULE call_calfis_mod
3
4	REAL,POINTER,SAVE :: ucov(:,:)
5	REAL,POINTER,SAVE :: vcov(:,:)
6	REAL,POINTER,SAVE :: teta(:,:)
7	REAL,POINTER,SAVE :: masse(:,:)
8	REAL,POINTER,SAVE :: ps(:)
9	REAL,POINTER,SAVE :: phis(:)
10	REAL,POINTER,SAVE :: q(:,:,:)
11	REAL,POINTER,SAVE :: flxw(:,:)
12
13	REAL,POINTER,SAVE :: p(:,:)
14	REAL,POINTER,SAVE :: alpha(:,:)
15	REAL,POINTER,SAVE :: beta(:,:)
16	REAL,POINTER,SAVE :: pks(:)
17	REAL,POINTER,SAVE :: pk(:,:)
18	REAL,POINTER,SAVE :: pkf(:,:)
19	REAL,POINTER,SAVE :: phi(:,:)
20	REAL,POINTER,SAVE :: du(:,:)
21	REAL,POINTER,SAVE :: dv(:,:)
22	REAL,POINTER,SAVE :: dteta(:,:)
23	REAL,POINTER,SAVE :: dq(:,:,:)
24	REAL,POINTER,SAVE :: dufi(:,:)
25	REAL,POINTER,SAVE :: dvfi(:,:)
26	REAL,POINTER,SAVE :: dtetafi(:,:)
27	REAL,POINTER,SAVE :: dqfi(:,:,:)
28	REAL,POINTER,SAVE :: dpfi(:)
29
30
31
32
33
34	CONTAINS
35
36	SUBROUTINE call_calfis_allocate
37	USE bands
38	USE allocate_field_mod
39	USE parallel_lmdz
40	USE dimensions_mod
41	USE infotrac
42	IMPLICIT NONE
43	TYPE(distrib),POINTER :: d
44	d=>distrib_physic
45
46	CALL allocate_u(ucov,llm,d)
47	CALL allocate_v(vcov,llm,d)
48	CALL allocate_u(teta,llm,d)
49	CALL allocate_u(masse,llm,d)
50	CALL allocate_u(ps,d)
51	CALL allocate_u(phis,d)
52	CALL allocate_u(q,llm,nqtot,d)
53	CALL allocate_u(flxw,llm,d)
54	CALL allocate_u(p,llmp1,d)
55	CALL allocate_u(alpha,llm,d)
56	CALL allocate_u(beta,llm,d)
57	CALL allocate_u(pks,d)
58	CALL allocate_u(pk,llm,d)
59	CALL allocate_u(pkf,llm,d)
60	CALL allocate_u(phi,llm,d)
61	CALL allocate_u(du,llm,d)
62	CALL allocate_v(dv,llm,d)
63	CALL allocate_u(dteta,llm,d)
64	CALL allocate_u(dq,llm,nqtot,d)
65	CALL allocate_u(dufi,llm,d)
66	CALL allocate_v(dvfi,llm,d)
67	CALL allocate_u(dtetafi,llm,d)
68	CALL allocate_u(dqfi,llm,nqtot,d)
69	CALL allocate_u(dpfi,d)
70
71	END SUBROUTINE call_calfis_allocate
72
73
74	SUBROUTINE call_calfis(itau,lafin,clesphy0,ucov_dyn,vcov_dyn,teta_dyn,masse_dyn,ps_dyn, &
75	phis_dyn,q_dyn,flxw_dyn)
76	USE dimensions_mod
77	USE parallel_lmdz
78	USE times
79	USE mod_hallo
80	USE Bands
81	USE vampir
82	USE infotrac
83	USE control_mod
84	USE write_field_loc
85	USE write_field
86	IMPLICIT NONE
87	INCLUDE "comconst.h"
88	INCLUDE "comvert.h"
89	INCLUDE "logic.h"
90	INCLUDE "temps.h"
91	INCLUDE "iniprint.h"
92
93	REAL :: clesphy0( : )
94	INTEGER :: itau
95	LOGICAL :: lafin
96	REAL :: ucov_dyn(ijb_u:ije_u,llm)
97	REAL :: vcov_dyn(ijb_v:ije_v,llm)
98	REAL :: teta_dyn(ijb_u:ije_u,llm)
99	REAL :: masse_dyn(ijb_u:ije_u,llm)
100	REAL :: ps_dyn(ijb_u:ije_u)
101	REAL :: phis_dyn(ijb_u:ije_u)
102	REAL :: q_dyn(ijb_u:ije_u,llm,nqtot)
103	REAL :: flxw_dyn(ijb_u:ije_u,llm)
104
105	REAL :: dufi_tmp(iip1,llm)
106	REAL :: dvfi_tmp(iip1,llm)
107	REAL :: dtetafi_tmp(iip1,llm)
108	REAL :: dpfi_tmp(iip1)
109	REAL :: dqfi_tmp(iip1,llm,nqtot)
110
111	REAL :: jD_cur, jH_cur
112	CHARACTER(LEN=15) :: ztit
113	TYPE(Request),SAVE :: Request_physic
114	!$OMP THREADPRIVATE(Request_physic )
115	INTEGER :: ijb,ije,l,j
116
117
118	#ifdef DEBUG_IO
119	CALL WriteField_u('ucovfi',ucov)
120	CALL WriteField_v('vcovfi',vcov)
121	CALL WriteField_u('tetafi',teta)
122	CALL WriteField_u('pfi',p)
123	CALL WriteField_u('pkfi',pk)
124	DO j=1,nqtot
125	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
126	ENDDO
127	#endif
128
129	!
130	! ....... Ajout P.Le Van ( 17/04/96 ) ...........
131	!
132
133
134	!$OMP MASTER
135	CALL suspend_timer(timer_caldyn)
136	WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
137	!$OMP END MASTER
138
139	jD_cur = jD_ref + day_ini - day_ref &
140	& + itau/day_step
141
142	IF (planet_type .eq."generic") THEN
143	! AS: we make jD_cur to be pday
144	jD_cur = int(day_ini + itau/day_step)
145	ENDIF
146
147	jH_cur = jH_ref + start_time + &
148	& mod(itau,day_step)/float(day_step)
149	if (jH_cur > 1.0 ) then
150	jD_cur = jD_cur +1.
151	jH_cur = jH_cur -1.
152	endif
153
154	! Inbterface avec les routines de phylmd (phymars ... )
155	! -----------------------------------------------------
156
157	!+jld
158
159	! Diagnostique de conservation de l'energie : initialisation
160
161	!-jld
162	!$OMP BARRIER
163	!$OMP MASTER
164	CALL VTb(VThallo)
165	!$OMP END MASTER
166
167	#ifdef DEBUG_IO
168	CALL WriteField_u('ucovfi',ucov)
169	CALL WriteField_v('vcovfi',vcov)
170	CALL WriteField_u('tetafi',teta)
171	CALL WriteField_u('pfi',p)
172	CALL WriteField_u('pkfi',pk)
173	#endif
174
175	CALL SetTag(Request_physic,800)
176	CALL Register_SwapField_u(ucov_dyn,ucov,distrib_physic,Request_physic,up=2,down=2)
177	CALL Register_SwapField_v(vcov_dyn,vcov,distrib_physic,Request_physic,up=2,down=2)
178	CALL Register_SwapField_u(teta_dyn,teta,distrib_physic,Request_physic,up=2,down=2)
179	CALL Register_SwapField_u(masse_dyn,masse,distrib_physic,Request_physic,up=1,down=2)
180	CALL Register_SwapField_u(ps_dyn,ps,distrib_physic,Request_physic,up=2,down=2)
181	CALL Register_SwapField_u(phis_dyn,phis,distrib_physic,Request_physic,up=2,down=2)
182	CALL Register_SwapField_u(q_dyn,q,distrib_physic,Request_physic,up=2,down=2)
183	CALL Register_SwapField_u(flxw_dyn,flxw,distrib_physic,Request_physic,up=2,down=2)
184
185	CALL SendRequest(Request_Physic)
186	!$OMP BARRIER
187	CALL WaitRequest(Request_Physic)
188
189	!$OMP BARRIER
190	!$OMP MASTER
191	CALL Set_Distrib(distrib_Physic)
192	CALL VTe(VThallo)
193
194	CALL VTb(VTphysiq)
195	!$OMP END MASTER
196	!$OMP BARRIER
197
198	CALL pression_loc ( ip1jmp1, ap, bp, ps, p )
199
200	!$OMP BARRIER
201	CALL exner_hyb_loc( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
202	!$OMP BARRIER
203	CALL geopot_loc ( ip1jmp1, teta , pk , pks, phis , phi )
204
205
206	CALL Register_Hallo_u(p,llmp1,2,2,2,2,Request_physic)
207	CALL Register_Hallo_u(pk,llm,2,2,2,2,Request_physic)
208	CALL Register_Hallo_u(phi,llm,2,2,2,2,Request_physic)
209
210	CALL SendRequest(Request_Physic)
211	!$OMP BARRIER
212	CALL WaitRequest(Request_Physic)
213
214	!$OMP BARRIER
215
216
217	#ifdef DEBUG_IO
218	CALL WriteField_u('ucovfi',ucov)
219	CALL WriteField_v('vcovfi',vcov)
220	CALL WriteField_u('tetafi',teta)
221	CALL WriteField_u('pfi',p)
222	CALL WriteField_u('pkfi',pk)
223	DO j=1,nqtot
224	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
225	ENDDO
226	#endif
227
228	!$OMP BARRIER
229
230	CALL calfis_loc(lafin ,jD_cur, jH_cur, &
231	ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , &
232	du,dv,dteta,dq, &
233	flxw, &
234	clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi )
235
236	ijb=ij_begin
237	ije=ij_end
238	IF ( .not. pole_nord) THEN
239
240	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
241	DO l=1,llm
242	dufi_tmp(1:iip1,l) = dufi(ijb:ijb+iim,l)
243	dvfi_tmp(1:iip1,l) = dvfi(ijb:ijb+iim,l)
244	dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l)
245	dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:)
246	ENDDO
247	!$OMP END DO NOWAIT
248
249	!$OMP MASTER
250	dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim)
251	!$OMP END MASTER
252
253	ENDIF ! of if ( .not. pole_nord)
254
255	!$OMP BARRIER
256	!$OMP MASTER
257	CALL Set_Distrib(distrib_Physic_bis)
258	CALL VTb(VThallo)
259	!$OMP END MASTER
260	!$OMP BARRIER
261
262	CALL Register_Hallo_u(dufi,llm,1,0,0,1,Request_physic)
263	CALL Register_Hallo_v(dvfi,llm,1,0,0,1,Request_physic)
264	CALL Register_Hallo_u(dtetafi,llm,1,0,0,1,Request_physic)
265	CALL Register_Hallo_u(dpfi,1,1,0,0,1,Request_physic)
266
267	DO j=1,nqtot
268	CALL Register_Hallo_u(dqfi(:,:,j),llm,1,0,0,1,Request_physic)
269	ENDDO
270
271	CALL SendRequest(Request_Physic)
272	!$OMP BARRIER
273	CALL WaitRequest(Request_Physic)
274
275	!$OMP BARRIER
276	!$OMP MASTER
277	CALL VTe(VThallo)
278	CALL Set_Distrib(distrib_Physic)
279	!$OMP END MASTER
280	!$OMP BARRIER
281	ijb=ij_begin
282	IF (.not. pole_nord) THEN
283
284	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
285	DO l=1,llm
286	dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
287	dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
288	dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)+dtetafi_tmp(1:iip1,l)
289	dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) + dqfi_tmp(1:iip1,l,:)
290	ENDDO
291	!$OMP END DO NOWAIT
292
293	!$OMP MASTER
294	dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
295	!$OMP END MASTER
296
297	endif ! of if (.not. pole_nord)
298
299
300	#ifdef DEBUG_IO
301	CALL WriteField_u('dufi',dufi)
302	CALL WriteField_v('dvfi',dvfi)
303	CALL WriteField_u('dtetafi',dtetafi)
304	CALL WriteField_u('dpfi',dpfi)
305	DO j=1,nqtot
306	CALL WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j))
307	ENDDO
308	#endif
309
310	!$OMP BARRIER
311
312	! ajout des tendances physiques:
313	! ------------------------------
314	#ifdef DEBUG_IO
315	CALL WriteField_u('ucovfi',ucov)
316	CALL WriteField_v('vcovfi',vcov)
317	CALL WriteField_u('tetafi',teta)
318	CALL WriteField_u('psfi',ps)
319	DO j=1,nqtot
320	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
321	ENDDO
322	#endif
323
324	#ifdef DEBUG_IO
325	CALL WriteField_u('ucovfi',ucov)
326	CALL WriteField_v('vcovfi',vcov)
327	CALL WriteField_u('tetafi',teta)
328	CALL WriteField_u('psfi',ps)
329	DO j=1,nqtot
330	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
331	ENDDO
332	#endif
333
334	CALL addfi_loc( dtphys, leapf, forward , &
335	ucov, vcov, teta , q ,ps , &
336	dufi, dvfi, dtetafi , dqfi ,dpfi )
337
338	#ifdef DEBUG_IO
339	CALL WriteField_u('ucovfi',ucov)
340	CALL WriteField_v('vcovfi',vcov)
341	CALL WriteField_u('tetafi',teta)
342	CALL WriteField_u('psfi',ps)
343	DO j=1,nqtot
344	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
345	ENDDO
346	#endif
347
348	IF (ok_strato) THEN
349	! CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
350	CALL top_bound_loc(vcov,ucov,teta,masse,dtphys)
351	ENDIF
352
353	!$OMP BARRIER
354	!$OMP MASTER
355	CALL VTe(VTphysiq)
356	CALL VTb(VThallo)
357	!$OMP END MASTER
358
359	CALL SetTag(Request_physic,800)
360	CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_physic)
361	CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_physic)
362	CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_physic)
363	CALL Register_SwapField_u(masse,masse_dyn,distrib_caldyn,Request_physic)
364	CALL Register_SwapField_u(ps,ps_dyn,distrib_caldyn,Request_physic)
365	CALL Register_SwapField_u(q,q_dyn,distrib_caldyn,Request_physic)
366	CALL SendRequest(Request_Physic)
367	!$OMP BARRIER
368	CALL WaitRequest(Request_Physic)
369
370	!$OMP BARRIER
371	!$OMP MASTER
372	CALL VTe(VThallo)
373	CALL set_distrib(distrib_caldyn)
374	!$OMP END MASTER
375	!$OMP BARRIER
376
377	!
378	! Diagnostique de conservation de l'energie : difference
379	IF (ip_ebil_dyn.ge.1 ) THEN
380	ztit='bil phys'
381	! CALL diagedyn(ztit,2,1,1,dtphys,ucov, vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
382	write(lunout,*)"call_calfis: diagedyn disabled in dyn3dmem !!"
383	ENDIF
384
385	#ifdef DEBUG_IO
386	CALL WriteField_u('ucovfi',ucov_dyn)
387	CALL WriteField_v('vcovfi',vcov_dyn)
388	CALL WriteField_u('tetafi',teta_dyn)
389	CALL WriteField_u('psfi',ps_dyn)
390	DO j=1,nqtot
391	CALL WriteField_u('qfi'//trim(int2str(j)),q_dyn(:,:,j))
392	ENDDO
393	#endif
394
395
396	!-jld
397	!$OMP MASTER
398	CALL resume_timer(timer_caldyn)
399	!$OMP END MASTER
400
401	END SUBROUTINE call_calfis
402
403	END MODULE call_calfis_mod

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

Download in other formats:

Original Format