Context Navigation

call_calfis_mod.F90 @ 5006

Last change on this file since 5006 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: 12.0 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 :: pks(:)
15	REAL,POINTER,SAVE :: pk(:,:)
16	REAL,POINTER,SAVE :: pkf(:,:)
17	REAL,POINTER,SAVE :: phi(:,:)
18	REAL,POINTER,SAVE :: du(:,:)
19	REAL,POINTER,SAVE :: dv(:,:)
20	REAL,POINTER,SAVE :: dteta(:,:)
21	REAL,POINTER,SAVE :: dq(:,:,:)
22	REAL,POINTER,SAVE :: dufi(:,:)
23	REAL,POINTER,SAVE :: dvfi(:,:)
24	REAL,POINTER,SAVE :: dtetafi(:,:)
25	REAL,POINTER,SAVE :: dqfi(:,:,:)
26	REAL,POINTER,SAVE :: dpfi(:)
27
28
29
30
31
32	CONTAINS
33
34	SUBROUTINE call_calfis_allocate
35	USE bands
36	USE allocate_field_mod
37	USE parallel_lmdz
38	USE dimensions_mod
39	USE infotrac
40	IMPLICIT NONE
41	TYPE(distrib),POINTER :: d
42	d=>distrib_physic
43
44	CALL allocate_u(ucov,llm,d)
45	CALL allocate_v(vcov,llm,d)
46	CALL allocate_u(teta,llm,d)
47	CALL allocate_u(masse,llm,d)
48	CALL allocate_u(ps,d)
49	CALL allocate_u(phis,d)
50	CALL allocate_u(q,llm,nqtot,d)
51	CALL allocate_u(flxw,llm,d)
52	CALL allocate_u(p,llmp1,d)
53	CALL allocate_u(pks,d)
54	pks(:)=0
55	CALL allocate_u(pk,llm,d)
56	pk(:,:)=0
57	CALL allocate_u(pkf,llm,d)
58	CALL allocate_u(phi,llm,d)
59	CALL allocate_u(du,llm,d)
60	CALL allocate_v(dv,llm,d)
61	CALL allocate_u(dteta,llm,d)
62	CALL allocate_u(dq,llm,nqtot,d)
63	CALL allocate_u(dufi,llm,d)
64	CALL allocate_v(dvfi,llm,d)
65	CALL allocate_u(dtetafi,llm,d)
66	CALL allocate_u(dqfi,llm,nqtot,d)
67	CALL allocate_u(dpfi,d)
68
69	END SUBROUTINE call_calfis_allocate
70
71
72	SUBROUTINE call_calfis(itau,lafin,ucov_dyn,vcov_dyn,teta_dyn,masse_dyn,ps_dyn, &
73	phis_dyn,q_dyn,flxw_dyn)
74	USE dimensions_mod
75	use exner_hyb_loc_m, only: exner_hyb_loc
76	use exner_milieu_loc_m, only: exner_milieu_loc
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	USE comconst_mod, ONLY: dtphys
87	USE logic_mod, ONLY: leapf, forward, ok_strato
88	USE comvert_mod, ONLY: ap, bp, pressure_exner
89	USE temps_mod, ONLY: day_ini, day_ref, jd_ref, jh_ref, start_time
90
91	IMPLICIT NONE
92	INCLUDE "iniprint.h"
93
94	INTEGER,INTENT(IN) :: itau ! (time) iteration step number
95	LOGICAL,INTENT(IN) :: lafin ! .true. if final time step
96	REAL,INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u,llm) ! covariant zonal wind
97	REAL,INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v,llm) ! covariant meridional wind
98	REAL,INTENT(INOUT) :: teta_dyn(ijb_u:ije_u,llm) ! potential temperature
99	REAL,INTENT(INOUT) :: masse_dyn(ijb_u:ije_u,llm) ! air mass
100	REAL,INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
101	REAL,INTENT(INOUT) :: phis_dyn(ijb_u:ije_u) ! surface geopotential
102	REAL,INTENT(INOUT) :: q_dyn(ijb_u:ije_u,llm,nqtot) ! advected tracers
103	REAL,INTENT(INOUT) :: flxw_dyn(ijb_u:ije_u,llm) ! vertical mass flux
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	IF (prt_level >= 10) THEN
137	WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
138	ENDIF
139	!$OMP END MASTER
140
141	jD_cur = jD_ref + day_ini - day_ref &
142	& + (itau+1)/day_step
143
144	IF (planet_type .eq."generic") THEN
145	! AS: we make jD_cur to be pday
146	jD_cur = int(day_ini + itau/day_step)
147	ENDIF
148
149	jH_cur = jH_ref + start_time + &
150	& mod(itau+1,day_step)/float(day_step)
151	if (jH_cur > 1.0 ) then
152	jD_cur = jD_cur +1.
153	jH_cur = jH_cur -1.
154	endif
155
156	! Inbterface avec les routines de phylmd (phymars ... )
157	! -----------------------------------------------------
158
159	!+jld
160
161	! Diagnostique de conservation de l'energie : initialisation
162
163	!-jld
164	!$OMP BARRIER
165	!$OMP MASTER
166	CALL VTb(VThallo)
167	!$OMP END MASTER
168
169	#ifdef DEBUG_IO
170	CALL WriteField_u('ucovfi',ucov)
171	CALL WriteField_v('vcovfi',vcov)
172	CALL WriteField_u('tetafi',teta)
173	CALL WriteField_u('pfi',p)
174	CALL WriteField_u('pkfi',pk)
175	#endif
176
177	CALL SetTag(Request_physic,800)
178	CALL Register_SwapField_u(ucov_dyn,ucov,distrib_physic,Request_physic,up=2,down=2)
179	CALL Register_SwapField_v(vcov_dyn,vcov,distrib_physic,Request_physic,up=2,down=2)
180	CALL Register_SwapField_u(teta_dyn,teta,distrib_physic,Request_physic,up=2,down=2)
181	CALL Register_SwapField_u(masse_dyn,masse,distrib_physic,Request_physic,up=1,down=2)
182	CALL Register_SwapField_u(ps_dyn,ps,distrib_physic,Request_physic,up=2,down=2)
183	CALL Register_SwapField_u(phis_dyn,phis,distrib_physic,Request_physic,up=2,down=2)
184	CALL Register_SwapField_u(q_dyn,q,distrib_physic,Request_physic,up=2,down=2)
185	CALL Register_SwapField_u(flxw_dyn,flxw,distrib_physic,Request_physic,up=2,down=2)
186
187	CALL SendRequest(Request_Physic)
188	!$OMP BARRIER
189	CALL WaitRequest(Request_Physic)
190
191	!$OMP BARRIER
192	!$OMP MASTER
193	CALL Set_Distrib(distrib_Physic)
194	CALL VTe(VThallo)
195
196	CALL VTb(VTphysiq)
197	!$OMP END MASTER
198	!$OMP BARRIER
199
200	CALL pression_loc ( ip1jmp1, ap, bp, ps, p )
201
202	!$OMP BARRIER
203	CALL exner_hyb_loc( ip1jmp1, ps, p, pks, pk, pkf )
204	!$OMP BARRIER
205	CALL geopot_loc ( ip1jmp1, teta , pk , pks, phis , phi )
206
207
208	CALL Register_Hallo_u(p,llmp1,2,2,2,2,Request_physic)
209	CALL Register_Hallo_u(pk,llm,2,2,2,2,Request_physic)
210	CALL Register_Hallo_u(phi,llm,2,2,2,2,Request_physic)
211
212	CALL SendRequest(Request_Physic)
213	!$OMP BARRIER
214	CALL WaitRequest(Request_Physic)
215
216	!$OMP BARRIER
217
218
219	#ifdef DEBUG_IO
220	CALL WriteField_u('ucovfi',ucov)
221	CALL WriteField_v('vcovfi',vcov)
222	CALL WriteField_u('tetafi',teta)
223	CALL WriteField_u('pfi',p)
224	CALL WriteField_u('pkfi',pk)
225	DO j=1,nqtot
226	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
227	ENDDO
228	#endif
229
230	!$OMP BARRIER
231
232	#ifdef CPP_PHYS
233	CALL calfis_loc(lafin ,jD_cur, jH_cur, &
234	ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , &
235	du,dv,dteta,dq, &
236	flxw, dufi,dvfi,dtetafi,dqfi,dpfi )
237	#endif
238	ijb=ij_begin
239	ije=ij_end
240	IF ( .not. pole_nord) THEN
241
242	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
243	DO l=1,llm
244	dufi_tmp(1:iip1,l) = dufi(ijb:ijb+iim,l)
245	dvfi_tmp(1:iip1,l) = dvfi(ijb:ijb+iim,l)
246	dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l)
247	dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:)
248	ENDDO
249	!$OMP END DO NOWAIT
250
251	!$OMP MASTER
252	dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim)
253	!$OMP END MASTER
254
255	ENDIF ! of if ( .not. pole_nord)
256
257	!$OMP BARRIER
258	!$OMP MASTER
259	CALL Set_Distrib(distrib_Physic_bis)
260	CALL VTb(VThallo)
261	!$OMP END MASTER
262	!$OMP BARRIER
263
264	CALL Register_Hallo_u(dufi,llm,1,0,0,1,Request_physic)
265	CALL Register_Hallo_v(dvfi,llm,1,0,0,1,Request_physic)
266	CALL Register_Hallo_u(dtetafi,llm,1,0,0,1,Request_physic)
267	CALL Register_Hallo_u(dpfi,1,1,0,0,1,Request_physic)
268
269	DO j=1,nqtot
270	CALL Register_Hallo_u(dqfi(:,:,j),llm,1,0,0,1,Request_physic)
271	ENDDO
272
273	CALL SendRequest(Request_Physic)
274	!$OMP BARRIER
275	CALL WaitRequest(Request_Physic)
276
277	!$OMP BARRIER
278	!$OMP MASTER
279	CALL VTe(VThallo)
280	CALL Set_Distrib(distrib_Physic)
281	!$OMP END MASTER
282	!$OMP BARRIER
283	ijb=ij_begin
284	IF (.not. pole_nord) THEN
285
286	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
287	DO l=1,llm
288	dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
289	dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
290	dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)+dtetafi_tmp(1:iip1,l)
291	dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) + dqfi_tmp(1:iip1,l,:)
292	ENDDO
293	!$OMP END DO NOWAIT
294
295	!$OMP MASTER
296	dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
297	!$OMP END MASTER
298
299	endif ! of if (.not. pole_nord)
300
301
302	#ifdef DEBUG_IO
303	CALL WriteField_u('dufi',dufi)
304	CALL WriteField_v('dvfi',dvfi)
305	CALL WriteField_u('dtetafi',dtetafi)
306	CALL WriteField_u('dpfi',dpfi)
307	DO j=1,nqtot
308	CALL WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j))
309	ENDDO
310	#endif
311
312	!$OMP BARRIER
313
314	! ajout des tendances physiques:
315	! ------------------------------
316	#ifdef DEBUG_IO
317	CALL WriteField_u('ucovfi',ucov)
318	CALL WriteField_v('vcovfi',vcov)
319	CALL WriteField_u('tetafi',teta)
320	CALL WriteField_u('psfi',ps)
321	DO j=1,nqtot
322	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
323	ENDDO
324	#endif
325
326	#ifdef DEBUG_IO
327	CALL WriteField_u('ucovfi',ucov)
328	CALL WriteField_v('vcovfi',vcov)
329	CALL WriteField_u('tetafi',teta)
330	CALL WriteField_u('psfi',ps)
331	DO j=1,nqtot
332	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
333	ENDDO
334	#endif
335
336	CALL addfi_loc( dtphys, leapf, forward , &
337	ucov, vcov, teta , q ,ps , &
338	dufi, dvfi, dtetafi , dqfi ,dpfi )
339	! since addfi updates ps(), also update p(), masse() and pk()
340	CALL pression_loc(ip1jmp1,ap,bp,ps,p)
341	!$OMP BARRIER
342	CALL massdair_loc(p,masse)
343	!$OMP BARRIER
344	if (pressure_exner) then
345	CALL exner_hyb_loc(ijnb_u,ps,p,pks,pk,pkf)
346	else
347	CALL exner_milieu_loc(ijnb_u,ps,p,pks,pk,pkf)
348	endif
349	!$OMP BARRIER
350
351	#ifdef DEBUG_IO
352	CALL WriteField_u('ucovfi',ucov)
353	CALL WriteField_v('vcovfi',vcov)
354	CALL WriteField_u('tetafi',teta)
355	CALL WriteField_u('psfi',ps)
356	DO j=1,nqtot
357	CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
358	ENDDO
359	#endif
360
361	IF (ok_strato) THEN
362	! CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
363	CALL top_bound_loc(vcov,ucov,teta,masse,dtphys)
364	ENDIF
365
366	!$OMP BARRIER
367	!$OMP MASTER
368	CALL VTe(VTphysiq)
369	CALL VTb(VThallo)
370	!$OMP END MASTER
371
372	CALL SetTag(Request_physic,800)
373	CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_physic)
374	CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_physic)
375	CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_physic)
376	CALL Register_SwapField_u(masse,masse_dyn,distrib_caldyn,Request_physic)
377	CALL Register_SwapField_u(ps,ps_dyn,distrib_caldyn,Request_physic)
378	CALL Register_SwapField_u(q,q_dyn,distrib_caldyn,Request_physic)
379	CALL SendRequest(Request_Physic)
380	!$OMP BARRIER
381	CALL WaitRequest(Request_Physic)
382
383	!$OMP BARRIER
384	!$OMP MASTER
385	CALL VTe(VThallo)
386	CALL set_distrib(distrib_caldyn)
387	!$OMP END MASTER
388	!$OMP BARRIER
389
390	!
391	! Diagnostique de conservation de l'energie : difference
392	IF (ip_ebil_dyn.ge.1 ) THEN
393	ztit='bil phys'
394	! CALL diagedyn(ztit,2,1,1,dtphys,ucov, vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
395	write(lunout,*)"call_calfis: diagedyn disabled in dyn3dmem !!"
396	ENDIF
397
398	#ifdef DEBUG_IO
399	CALL WriteField_u('ucovfi',ucov_dyn)
400	CALL WriteField_v('vcovfi',vcov_dyn)
401	CALL WriteField_u('tetafi',teta_dyn)
402	CALL WriteField_u('psfi',ps_dyn)
403	DO j=1,nqtot
404	CALL WriteField_u('qfi'//trim(int2str(j)),q_dyn(:,:,j))
405	ENDDO
406	#endif
407
408
409	!-jld
410	!$OMP MASTER
411	CALL resume_timer(timer_caldyn)
412	!$OMP END MASTER
413
414	END SUBROUTINE call_calfis
415
416	END MODULE call_calfis_mod

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

Download in other formats:

Original Format