Context Navigation

interface_icosa_lmdz.f90 @ 3931

Last change on this file since 3931 was 3902, checked in by ymipsl, 9 years ago

Add global index array in order to be able of correctly restart when changing data distribution between 2 jobs (not same number of mpi process or openmp threads)

File size: 23.4 KB

Line
1	MODULE interface_icosa_lmdz_mod
2
3	USE field_mod, ONLY: t_field
4	USE transfert_mod, ONLY: t_message
5
6
7	TYPE(t_message),SAVE :: req_u
8	TYPE(t_message),SAVE :: req_dps0, req_dulon0, req_dulat0, req_dTemp0, req_dq0
9
10	TYPE(t_field),POINTER,SAVE :: f_p(:)
11	TYPE(t_field),POINTER,SAVE :: f_pks(:)
12	TYPE(t_field),POINTER,SAVE :: f_pk(:)
13	TYPE(t_field),POINTER,SAVE :: f_p_layer(:)
14	TYPE(t_field),POINTER,SAVE :: f_theta(:)
15	TYPE(t_field),POINTER,SAVE :: f_phi(:)
16	TYPE(t_field),POINTER,SAVE :: f_Temp(:)
17	TYPE(t_field),POINTER,SAVE :: f_ulon(:)
18	TYPE(t_field),POINTER,SAVE :: f_ulat(:)
19	TYPE(t_field),POINTER,SAVE :: f_dulon(:)
20	TYPE(t_field),POINTER,SAVE :: f_dulat(:)
21	TYPE(t_field),POINTER,SAVE :: f_dTemp(:)
22	TYPE(t_field),POINTER,SAVE :: f_dq(:)
23	TYPE(t_field),POINTER,SAVE :: f_dps(:)
24	TYPE(t_field),POINTER,SAVE :: f_duc(:)
25	TYPE(t_field),POINTER,SAVE :: f_bounds_lon(:)
26	TYPE(t_field),POINTER,SAVE :: f_bounds_lat(:)
27
28	INTEGER :: start_clock
29	INTEGER :: stop_clock
30	INTEGER :: count_clock=0
31
32	REAL :: day_length
33
34
35	INTEGER,SAVE :: nbp_phys
36	INTEGER,SAVE :: nbp_phys_glo
37
38
39	CONTAINS
40
41	SUBROUTINE initialize_physics
42	USE distrib_icosa_lmdz_mod, ONLY : init_distrib_icosa_lmdz, transfer_icosa_to_lmdz
43	! from dynamico
44	USE domain_mod
45	USE dimensions
46	USE mpi_mod
47	USE mpipara
48	USE disvert_mod
49	USE xios_mod
50	USE time_mod , init_time_icosa=> init_time
51	USE transfert_mod
52
53	! from LMDZ
54	USE mod_grid_phy_lmdz, ONLY : unstructured
55	USE mod_phys_lmdz_omp_data, ONLY: klon_omp
56	USE time_phylmdz_mod, ONLY: init_time_lmdz => init_time
57	USE transfert_mod
58	USE physics_distribution_mod, ONLY : init_physics_distribution
59	USE geometry_mod, ONLY : init_geometry
60	USE vertical_layers_mod, ONLY : init_vertical_layers
61	USE infotrac_phy, ONLY : init_infotrac_phy
62	USE inifis_mod, ONLY : inifis
63	USE phyaqua_mod, ONLY : iniaqua
64
65
66	IMPLICIT NONE
67	INTEGER :: ind,i,j,ij,pos
68	REAL(rstd),POINTER :: bounds_lon(:,:)
69	REAL(rstd),POINTER :: bounds_lat(:,:)
70
71	REAL(rstd),ALLOCATABLE :: latfi(:)
72	REAL(rstd),ALLOCATABLE :: lonfi(:)
73	REAL(rstd),ALLOCATABLE :: airefi(:)
74	REAL(rstd),ALLOCATABLE :: bounds_latfi(:,:)
75	REAL(rstd),ALLOCATABLE :: bounds_lonfi(:,:)
76	REAL(rstd) :: pseudoalt(llm)
77
78	INTEGER :: run_length
79	INTEGER :: annee_ref
80	INTEGER :: day_ref
81	INTEGER :: day_ini
82	REAL :: start_time
83	REAL :: physics_timestep
84
85
86	INTEGER :: nqo, nbtr
87	CHARACTER(len=4) :: type_trac
88	CHARACTER(len=20),ALLOCATABLE :: tname(:) ! tracer short name for restart and diagnostics
89	CHARACTER(len=23),ALLOCATABLE :: ttext(:) ! tracer long name for diagnostics
90	INTEGER,ALLOCATABLE :: niadv(:) ! equivalent dyn / physique
91	INTEGER,ALLOCATABLE :: conv_flg(:) ! conv_flg(it)=0 : convection desactivated for tracer number it
92	INTEGER,ALLOCATABLE :: pbl_flg(:) ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it
93	CHARACTER(len=8),ALLOCATABLE :: solsym(:) ! tracer name from inca
94
95	INTEGER :: iflag_phys
96	INTEGER :: nbp_phys, nbp_phys_glo
97
98	!$OMP PARALLEL
99	CALL allocate_field(f_bounds_lon,field_t,type_real,6)
100	CALL allocate_field(f_bounds_lat,field_t,type_real,6)
101	CALL allocate_field(f_p,field_t,type_real,llm+1)
102	CALL allocate_field(f_pks,field_t,type_real)
103	CALL allocate_field(f_pk,field_t,type_real,llm)
104	CALL allocate_field(f_p_layer,field_t,type_real,llm)
105	CALL allocate_field(f_theta,field_t,type_real,llm)
106	CALL allocate_field(f_phi,field_t,type_real,llm)
107	CALL allocate_field(f_Temp,field_t,type_real,llm)
108	CALL allocate_field(f_ulon,field_t,type_real,llm)
109	CALL allocate_field(f_ulat,field_t,type_real,llm)
110	CALL allocate_field(f_dulon,field_t,type_real,llm)
111	CALL allocate_field(f_dulat,field_t,type_real,llm)
112	CALL allocate_field(f_dTemp,field_t,type_real,llm)
113	CALL allocate_field(f_dq,field_t,type_real,llm,nqtot)
114	CALL allocate_field(f_dps,field_t,type_real)
115	CALL allocate_field(f_duc,field_t,type_real,3,llm)
116
117	CALL init_message(f_dps,req_i0,req_dps0)
118	CALL init_message(f_dulon,req_i0,req_dulon0)
119	CALL init_message(f_dulat,req_i0,req_dulat0)
120	CALL init_message(f_dTemp,req_i0,req_dTemp0)
121	CALL init_message(f_dq,req_i0,req_dq0)
122	!$OMP END PARALLEL
123
124	nbp_phys=0
125	DO ind=1,ndomain
126	CALL swap_dimensions(ind)
127	DO j=jj_begin,jj_end
128	DO i=ii_begin,ii_end
129	IF (domain(ind)%own(i,j)) nbp_phys=nbp_phys+1
130	ENDDO
131	ENDDO
132	ENDDO
133
134
135	!initialize LMDZ5 physic mpi decomposition
136	CALL MPI_ALLREDUCE(nbp_phys,nbp_phys_glo,1,MPI_INTEGER,MPI_SUM,comm_icosa,ierr)
137	CALL init_physics_distribution(unstructured, 6, nbp_phys, 1, nbp_phys_glo, llm, comm_icosa)
138
139	DO ind=1,ndomain
140	CALL swap_dimensions(ind)
141	CALL swap_geometry(ind)
142	bounds_lon=f_bounds_lon(ind)
143	bounds_lat=f_bounds_lat(ind)
144	DO j=jj_begin,jj_end
145	DO i=ii_begin,ii_end
146	ij=(j-1)*iim+i
147	CALL xyz2lonlat(xyz_v(ij+z_rup,:), bounds_lon(ij,1), bounds_lat(ij,1))
148	CALL xyz2lonlat(xyz_v(ij+z_up,:), bounds_lon(ij,2), bounds_lat(ij,2))
149	CALL xyz2lonlat(xyz_v(ij+z_lup,:), bounds_lon(ij,3), bounds_lat(ij,3))
150	CALL xyz2lonlat(xyz_v(ij+z_ldown,:), bounds_lon(ij,4), bounds_lat(ij,4))
151	CALL xyz2lonlat(xyz_v(ij+z_down,:), bounds_lon(ij,5), bounds_lat(ij,5))
152	CALL xyz2lonlat(xyz_v(ij+z_rdown,:), bounds_lon(ij,6), bounds_lat(ij,6))
153	ENDDO
154	ENDDO
155	ENDDO
156
157	!$OMP PARALLEL
158	CALL initialize_physics_omp
159	!$OMP END PARALLEL
160
161	CALL xios_set_context
162
163
164
165
166	END SUBROUTINE initialize_physics
167
168
169	SUBROUTINE initialize_physics_omp
170	USE distrib_icosa_lmdz_mod, ONLY : init_distrib_icosa_lmdz, transfer_icosa_to_lmdz
171	! from dynamico
172	USE domain_mod
173	USE dimensions
174	USE mpi_mod
175	USE mpipara
176	USE disvert_mod
177	USE xios_mod
178	USE time_mod , init_time_icosa=> init_time
179	USE omp_para
180
181	! from LMDZ
182	USE mod_grid_phy_lmdz, ONLY : unstructured
183	USE mod_phys_lmdz_omp_data, ONLY: klon_omp
184	USE time_phylmdz_mod, ONLY: init_time_lmdz => init_time
185	USE transfert_mod
186	USE physics_distribution_mod, ONLY : init_physics_distribution
187	USE geometry_mod, ONLY : init_geometry
188	USE vertical_layers_mod, ONLY : init_vertical_layers
189	USE infotrac_phy, ONLY : init_infotrac_phy
190	USE inifis_mod, ONLY : inifis
191	USE phyaqua_mod, ONLY : iniaqua
192
193
194	IMPLICIT NONE
195
196
197
198	INTEGER :: ind,i,j,ij,pos
199	REAL(rstd),POINTER :: bounds_lon(:,:)
200	REAL(rstd),POINTER :: bounds_lat(:,:)
201
202	REAL(rstd),ALLOCATABLE :: latfi(:)
203	REAL(rstd),ALLOCATABLE :: lonfi(:)
204	REAL(rstd),ALLOCATABLE :: airefi(:)
205	REAL(rstd),ALLOCATABLE :: bounds_latfi(:,:)
206	REAL(rstd),ALLOCATABLE :: bounds_lonfi(:,:)
207	REAL(rstd),ALLOCATABLE :: ind_cell_glo(:)
208
209	REAL(rstd) :: pseudoalt(llm)
210
211	INTEGER :: run_length
212	INTEGER :: annee_ref
213	INTEGER :: day_ref
214	INTEGER :: day_ini
215	REAL :: start_time
216	REAL :: physics_timestep
217
218
219	INTEGER :: nqo, nbtr
220	CHARACTER(len=4) :: type_trac
221	CHARACTER(len=20),ALLOCATABLE :: tname(:) ! tracer short name for restart and diagnostics
222	CHARACTER(len=23),ALLOCATABLE :: ttext(:) ! tracer long name for diagnostics
223	INTEGER,ALLOCATABLE :: niadv(:) ! equivalent dyn / physique
224	INTEGER,ALLOCATABLE :: conv_flg(:) ! conv_flg(it)=0 : convection desactivated for tracer number it
225	INTEGER,ALLOCATABLE :: pbl_flg(:) ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it
226	CHARACTER(len=8),ALLOCATABLE :: solsym(:) ! tracer name from inca
227	TYPE(t_field),POINTER,SAVE :: f_ind_cell_glo(:)
228
229	INTEGER :: iflag_phys
230
231	CALL init_distrib_icosa_lmdz
232
233	ALLOCATE(latfi(klon_omp))
234	ALLOCATE(lonfi(klon_omp))
235	ALLOCATE(airefi(klon_omp))
236	ALLOCATE(bounds_latfi(klon_omp,6))
237	ALLOCATE(bounds_lonfi(klon_omp,6))
238	ALLOCATE(ind_cell_glo(klon_omp))
239
240	CALL transfer_icosa_to_lmdz(geom%lat_i,latfi)
241	CALL transfer_icosa_to_lmdz(geom%lon_i,lonfi)
242	CALL transfer_icosa_to_lmdz(f_bounds_lat,bounds_latfi)
243	CALL transfer_icosa_to_lmdz(f_bounds_lon,bounds_lonfi)
244	CALL transfer_icosa_to_lmdz(geom%Ai,airefi)
245
246	CALL allocate_field(f_ind_cell_glo,field_t,type_real)
247
248	DO ind=1,ndomain
249	IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master ) CYCLE
250	CALL swap_dimensions(ind)
251	CALL swap_geometry(ind)
252	DO j=jj_begin,jj_end
253	DO i=ii_begin,ii_end
254	ij=(j-1)*iim+i
255	f_ind_cell_glo(ind)%rval2d(ij)=domain(ind)%assign_cell_glo(i,j)
256	ENDDO
257	ENDDO
258	ENDDO
259
260	!$OMP BARRIER
261
262	CALL transfer_icosa_to_lmdz(f_ind_cell_glo,ind_cell_glo)
263	CALL deallocate_field(f_ind_cell_glo)
264
265
266	CALL init_geometry(lonfi, latfi, bounds_lonfi, bounds_latfi, airefi, INT(ind_cell_glo))
267
268	pseudoalt(:)=0
269	CALL init_vertical_layers(llm,preff,ap,bp,presnivs,pseudoalt)
270
271
272	! Initialize tracer names, numbers, etc. for physics
273
274	!Config Key = type_trac
275	!Config Desc = Choix de couplage avec model de chimie INCA ou REPROBUS
276	!Config Def = lmdz
277	!Config Help =
278	!Config 'lmdz' = pas de couplage, pur LMDZ
279	!Config 'inca' = model de chime INCA
280	!Config 'repr' = model de chime REPROBUS
281	type_trac = 'lmdz'
282	CALL getin('type_trac',type_trac)
283
284	! init model for standard lmdz case
285	nqo=2
286	nbtr=2
287	ALLOCATE(tname(nqtot))
288	ALLOCATE(ttext(nqtot))
289	ALLOCATE(niadv(nqtot))
290	ALLOCATE(conv_flg(nbtr))
291	ALLOCATE(pbl_flg(nbtr))
292	ALLOCATE(solsym(nbtr))
293
294	conv_flg(:) = 1 ! convection activated for all tracers
295	pbl_flg(:) = 1 ! boundary layer activated for all tracers
296	tname(1)='H2Ov'
297	tname(2)='H2Ol'
298	tname(3)='RN'
299	tname(4)='PB'
300	ttext(1)='H2OvVLH'
301	ttext(2)='H2OlVL1'
302	ttext(3)='RNVL1'
303	ttext(4)='PBVL1'
304	solsym(1:2)=tname(3:4)
305	niadv(1)=1
306	niadv(2)=2
307	niadv(3)=3
308	niadv(4)=4
309
310	CALL init_infotrac_phy(nqtot,nqo,nbtr,tname,ttext,type_trac,&
311	niadv,conv_flg,pbl_flg,solsym)
312
313	! Initialize physical constant
314	day_length=86400
315	CALL getin('day_length',day_length)
316	CALL inifis(day_length,radius,g,kappa*cpp,cpp)
317
318
319
320	! init time
321	annee_ref=2015
322	CALL getin("anneeref",annee_ref)
323
324	day_ref=1
325	CALL getin("dayref",day_ref)
326
327	physics_timestep=dt*itau_physics
328	run_length=itaumax*dt
329	ndays=NINT(run_length/day_length)
330
331	day_ini=INT(itau0*dt/day_length)+day_ref
332	start_time= itau0dt/day_length-INT(itau0dt/day_length)
333
334	CALL init_time_lmdz(annee_ref, day_ref, day_ini, start_time, ndays, physics_timestep)
335
336	! Additional initializations for aquaplanets
337	! CALL getin("iflag_phys",iflag_phys)
338	! IF (iflag_phys>=100) THEN
339	! CALL iniaqua(klon_omp, iflag_phys)
340	! END IF
341
342
343	END SUBROUTINE initialize_physics_omp
344
345
346
347
348	SUBROUTINE physics
349	USE ICOSA
350	USE time_mod
351	USE disvert_mod
352	USE transfert_mod
353	USE mpipara
354	USE xios_mod
355	USE wxios
356	USE trace
357	USE distrib_icosa_lmdz_mod, ONLY : transfer_icosa_to_lmdz, transfer_lmdz_to_icosa
358	USE physics_external_mod, ONLY : it, f_phis, f_ps, f_theta_rhodz, f_u, f_wflux, f_q
359	! from LMDZ
360	USE mod_phys_lmdz_omp_data, ONLY: klon_omp
361	IMPLICIT NONE
362
363	REAL(rstd),POINTER :: phis(:)
364	REAL(rstd),POINTER :: ps(:)
365	REAL(rstd),POINTER :: theta_rhodz(:,:)
366	REAL(rstd),POINTER :: u(:,:)
367	REAL(rstd),POINTER :: wflux(:,:)
368	REAL(rstd),POINTER :: q(:,:,:)
369	REAL(rstd),POINTER :: p(:,:)
370	REAL(rstd),POINTER :: pks(:)
371	REAL(rstd),POINTER :: pk(:,:)
372	REAL(rstd),POINTER :: p_layer(:,:)
373	REAL(rstd),POINTER :: theta(:,:)
374	REAL(rstd),POINTER :: phi(:,:)
375	REAL(rstd),POINTER :: Temp(:,:)
376	REAL(rstd),POINTER :: ulon(:,:)
377	REAL(rstd),POINTER :: ulat(:,:)
378	REAL(rstd),POINTER :: dulon(:,:)
379	REAL(rstd),POINTER :: dulat(:,:)
380	REAL(rstd),POINTER :: dTemp(:,:)
381	REAL(rstd),POINTER :: dq(:,:,:)
382	REAL(rstd),POINTER :: dps(:)
383	REAL(rstd),POINTER :: duc(:,:,:)
384
385
386	INTEGER :: ind
387
388	REAL(rstd),ALLOCATABLE,SAVE :: ps_phy(:)
389	!$OMP THREADPRIVATE(ps_phy)
390	REAL(rstd),ALLOCATABLE,SAVE :: p_phy(:,:)
391	!$OMP THREADPRIVATE(p_phy)
392	REAL(rstd),ALLOCATABLE,SAVE :: p_layer_phy(:,:)
393	!$OMP THREADPRIVATE(p_layer_phy)
394	REAL(rstd),ALLOCATABLE,SAVE :: Temp_phy(:,:)
395	!$OMP THREADPRIVATE(Temp_phy)
396	REAL(rstd),ALLOCATABLE,SAVE :: phis_phy(:)
397	!$OMP THREADPRIVATE(phis_phy)
398	REAL(rstd),ALLOCATABLE,SAVE :: phi_phy(:,:)
399	!$OMP THREADPRIVATE(phi_phy)
400	REAL(rstd),ALLOCATABLE,SAVE :: ulon_phy(:,:)
401	!$OMP THREADPRIVATE(ulon_phy)
402	REAL(rstd),ALLOCATABLE,SAVE :: ulat_phy(:,:)
403	!$OMP THREADPRIVATE(ulat_phy)
404	REAL(rstd),ALLOCATABLE,SAVE :: q_phy(:,:,:)
405	!$OMP THREADPRIVATE(q_phy)
406	REAL(rstd),ALLOCATABLE,SAVE :: wflux_phy(:,:)
407	!$OMP THREADPRIVATE(wflux_phy)
408	REAL(rstd),ALLOCATABLE,SAVE :: dulon_phy(:,:)
409	!$OMP THREADPRIVATE(dulon_phy)
410	REAL(rstd),ALLOCATABLE,SAVE :: dulat_phy(:,:)
411	!$OMP THREADPRIVATE(dulat_phy)
412	REAL(rstd),ALLOCATABLE,SAVE :: dTemp_phy(:,:)
413	!$OMP THREADPRIVATE(dTemp_phy)
414	REAL(rstd),ALLOCATABLE,SAVE :: dq_phy(:,:,:)
415	!$OMP THREADPRIVATE(dq_phy)
416	REAL(rstd),ALLOCATABLE,SAVE :: dps_phy(:)
417	!$OMP THREADPRIVATE(dps_phy)
418	REAL(rstd) :: dtphy
419	LOGICAL :: debut
420	LOGICAL :: lafin
421	LOGICAL,SAVE :: first=.TRUE.
422	!$OMP THREADPRIVATE(first)
423
424
425	IF(first) THEN
426	debut=.TRUE.
427	ELSE
428	debut=.FALSE.
429	ENDIF
430
431
432	IF(it-itau0>=itaumax) THEN
433	lafin=.TRUE.
434	ELSE
435	lafin=.FALSE.
436	ENDIF
437
438	IF (first) THEN
439	first=.FALSE.
440	CALL init_message(f_u,req_e1_vect,req_u)
441	ALLOCATE(ps_phy(klon_omp))
442	ALLOCATE(p_phy(klon_omp,llm+1))
443	ALLOCATE(p_layer_phy(klon_omp,llm))
444	ALLOCATE(Temp_phy(klon_omp,llm))
445	ALLOCATE(phis_phy(klon_omp))
446	ALLOCATE(phi_phy(klon_omp,llm))
447	ALLOCATE(ulon_phy(klon_omp,llm))
448	ALLOCATE(ulat_phy(klon_omp,llm))
449	ALLOCATE(q_phy(klon_omp,llm,nqtot))
450	ALLOCATE(wflux_phy(klon_omp,llm))
451	ALLOCATE(dulon_phy(klon_omp,llm))
452	ALLOCATE(dulat_phy(klon_omp,llm))
453	ALLOCATE(dTemp_phy(klon_omp,llm))
454	ALLOCATE(dq_phy(klon_omp,llm,nqtot))
455	ALLOCATE(dps_phy(klon_omp))
456	!$OMP BARRIER
457	ENDIF
458
459
460	!$OMP MASTER
461	! CALL update_calendar(it)
462	!$OMP END MASTER
463	!$OMP BARRIER
464	dtphy=itau_physics*dt
465
466
467
468	CALL transfert_message(f_u,req_u)
469
470	DO ind=1,ndomain
471	CALL swap_dimensions(ind)
472	IF (assigned_domain(ind)) THEN
473	CALL swap_geometry(ind)
474
475	phis=f_phis(ind)
476	ps=f_ps(ind)
477	theta_rhodz=f_theta_rhodz(ind)
478	u=f_u(ind)
479	q=f_q(ind)
480	wflux=f_wflux(ind)
481	p=f_p(ind)
482	pks=f_pks(ind)
483	pk=f_pk(ind)
484	p_layer=f_p_layer(ind)
485	theta=f_theta(ind)
486	phi=f_phi(ind)
487	Temp=f_Temp(ind)
488	ulon=f_ulon(ind)
489	ulat=f_ulat(ind)
490
491	CALL grid_icosa_to_physics
492
493	ENDIF
494	ENDDO
495
496	!$OMP BARRIER
497	!$OMP MASTER
498	CALL SYSTEM_CLOCK(start_clock)
499	!$OMP END MASTER
500	CALL trace_start("physic")
501	! CALL trace_off()
502
503
504
505	CALL transfer_icosa_to_lmdz(f_p , p_phy)
506	CALL transfer_icosa_to_lmdz(f_p_layer, p_layer_phy)
507	CALL transfer_icosa_to_lmdz(f_phi , phi_phy)
508	CALL transfer_icosa_to_lmdz(f_phis , phis_phy )
509	CALL transfer_icosa_to_lmdz(f_ulon , ulon_phy )
510	CALL transfer_icosa_to_lmdz(f_ulat , ulat_phy)
511	CALL transfer_icosa_to_lmdz(f_Temp , Temp_phy)
512	CALL transfer_icosa_to_lmdz(f_q , q_phy)
513	CALL transfer_icosa_to_lmdz(f_wflux , wflux_phy)
514
515	CALL wxios_set_context()
516
517	CALL physiq(klon_omp, llm, debut, lafin, dtphy, &
518	p_phy, p_layer_phy, phi_phy, phis_phy, presnivs, ulon_phy, ulat_phy, Temp_phy, q_phy, wflux_phy, &
519	dulon_phy, dulat_phy, dTemp_phy, dq_phy, dps_phy)
520
521	CALL transfer_lmdz_to_icosa(dulon_phy, f_dulon )
522	CALL transfer_lmdz_to_icosa(dulat_phy, f_dulat )
523	CALL transfer_lmdz_to_icosa(dTemp_phy, f_dTemp )
524	CALL transfer_lmdz_to_icosa(dq_phy , f_dq )
525	CALL transfer_lmdz_to_icosa(dps_phy , f_dps )
526
527	CALL send_message(f_dps,req_dps0)
528	CALL send_message(f_dulon,req_dulon0)
529	CALL send_message(f_dulat,req_dulat0)
530	CALL send_message(f_dTemp,req_dTemp0)
531	CALL send_message(f_dq,req_dq0)
532
533	CALL wait_message(req_dps0)
534	CALL wait_message(req_dulon0)
535	CALL wait_message(req_dulat0)
536	CALL wait_message(req_dTemp0)
537	CALL wait_message(req_dq0)
538
539
540	! CALL trace_on()
541	CALL trace_end("physic")
542	!$OMP MASTER
543	CALL SYSTEM_CLOCK(stop_clock)
544	count_clock=count_clock+stop_clock-start_clock
545	!$OMP END MASTER
546
547	!$OMP BARRIER
548
549	DO ind=1,ndomain
550	CALL swap_dimensions(ind)
551	IF (assigned_domain(ind)) THEN
552	CALL swap_geometry(ind)
553
554	theta_rhodz=f_theta_rhodz(ind)
555	u=f_u(ind)
556	q=f_q(ind)
557	ps=f_ps(ind)
558	dulon=f_dulon(ind)
559	dulat=f_dulat(ind)
560	Temp=f_temp(ind)
561	dTemp=f_dTemp(ind)
562	dq=f_dq(ind)
563	dps=f_dps(ind)
564	duc=f_duc(ind)
565	p=f_p(ind)
566	pks=f_pks(ind)
567	pk=f_pk(ind)
568
569	CALL grid_physics_to_icosa
570	ENDIF
571	ENDDO
572
573	!$OMP BARRIER
574	CALL xios_set_context
575
576
577	CONTAINS
578
579	SUBROUTINE grid_icosa_to_physics
580	USE pression_mod
581	USE exner_mod
582	USE theta2theta_rhodz_mod
583	USE geopotential_mod
584	USE wind_mod
585	USE omp_para
586	IMPLICIT NONE
587
588	REAL(rstd) :: uc(3)
589	INTEGER :: i,j,ij,l
590
591
592	! compute pression
593
594	DO l = ll_begin,ll_endp1
595	DO j=jj_begin,jj_end
596	DO i=ii_begin,ii_end
597	ij=(j-1)*iim+i
598	p(ij,l) = ap(l) + bp(l) * ps(ij)
599	ENDDO
600	ENDDO
601	ENDDO
602
603	!$OMP BARRIER
604
605	! compute exner
606
607	IF (is_omp_first_level) THEN
608	DO j=jj_begin,jj_end
609	DO i=ii_begin,ii_end
610	ij=(j-1)*iim+i
611	pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
612	ENDDO
613	ENDDO
614	ENDIF
615
616	! 3D : pk
617	DO l = ll_begin,ll_end
618	DO j=jj_begin,jj_end
619	DO i=ii_begin,ii_end
620	ij=(j-1)*iim+i
621	pk(ij,l) = cpp * ((.5/preff)(p(ij,l)+p(ij,l+1))) * kappa
622	ENDDO
623	ENDDO
624	ENDDO
625
626	!$OMP BARRIER
627
628	! compute theta, temperature and pression at layer
629	DO l = ll_begin, ll_end
630	DO j=jj_begin,jj_end
631	DO i=ii_begin,ii_end
632	ij=(j-1)*iim+i
633	theta(ij,l) = theta_rhodz(ij,l) / ((p(ij,l)-p(ij,l+1))/g)
634	Temp(ij,l) = theta(ij,l) * pk(ij,l) / cpp
635	p_layer(ij,l)=preff(pk(ij,l)/cpp)*(1./kappa)
636	ENDDO
637	ENDDO
638	ENDDO
639
640
641	!!! Compute geopotential
642
643	! for first layer
644	IF (is_omp_first_level) THEN
645	DO j=jj_begin,jj_end
646	DO i=ii_begin,ii_end
647	ij=(j-1)*iim+i
648	phi( ij,1 ) = phis( ij ) + theta(ij,1) * ( pks(ij) - pk(ij,1) )
649	ENDDO
650	ENDDO
651	ENDIF
652	!!-> implicit flush on phi(:,1)
653
654	! for other layers
655	DO l = ll_beginp1, ll_end
656	DO j=jj_begin,jj_end
657	DO i=ii_begin,ii_end
658	ij=(j-1)*iim+i
659	phi(ij,l) = 0.5 * ( theta(ij,l) + theta(ij,l-1) ) &
660	* ( pk(ij,l-1) - pk(ij,l) )
661	ENDDO
662	ENDDO
663	ENDDO
664
665	!$OMP BARRIER
666
667
668	IF (is_omp_first_level) THEN
669	DO l = 2, llm
670	DO j=jj_begin,jj_end
671	! ---> Bug compilo intel ici en openmp
672	! ---> Couper la boucle
673	IF (j==jj_end+1) PRINT*,"this message must not be printed"
674	DO i=ii_begin,ii_end
675	ij=(j-1)*iim+i
676	phi(ij,l) = phi(ij,l)+ phi(ij,l-1)
677	ENDDO
678	ENDDO
679	ENDDO
680	! --> IMPLICIT FLUSH on phi --> non
681	ENDIF
682
683	! compute wind centered lon lat compound
684	DO l=ll_begin,ll_end
685	DO j=jj_begin,jj_end
686	DO i=ii_begin,ii_end
687	ij=(j-1)*iim+i
688	uc(:)=1/Ai(ij)* &
689	( ne(ij,right)u(ij+u_right,l)le(ij+u_right)*((xyz_v(ij+z_rdown,:)+xyz_v(ij+z_rup,:))/2-centroid(ij,:)) &
690	+ ne(ij,rup)u(ij+u_rup,l)le(ij+u_rup)*((xyz_v(ij+z_rup,:)+xyz_v(ij+z_up,:))/2-centroid(ij,:)) &
691	+ ne(ij,lup)u(ij+u_lup,l)le(ij+u_lup)*((xyz_v(ij+z_up,:)+xyz_v(ij+z_lup,:))/2-centroid(ij,:)) &
692	+ ne(ij,left)u(ij+u_left,l)le(ij+u_left)*((xyz_v(ij+z_lup,:)+xyz_v(ij+z_ldown,:))/2-centroid(ij,:)) &
693	+ ne(ij,ldown)u(ij+u_ldown,l)le(ij+u_ldown)*((xyz_v(ij+z_ldown,:)+xyz_v(ij+z_down,:))/2-centroid(ij,:))&
694	+ ne(ij,rdown)u(ij+u_rdown,l)le(ij+u_rdown)*((xyz_v(ij+z_down,:)+xyz_v(ij+z_rdown,:))/2-centroid(ij,:)))
695	ulon(ij,l)=sum(uc(:)*elon_i(ij,:))
696	ulat(ij,l)=sum(uc(:)*elat_i(ij,:))
697	ENDDO
698	ENDDO
699	ENDDO
700
701	!$OMP BARRIER
702	END SUBROUTINE grid_icosa_to_physics
703
704
705	SUBROUTINE grid_physics_to_icosa
706	USE theta2theta_rhodz_mod
707	USE omp_para
708	IMPLICIT NONE
709	INTEGER :: i,j,ij,l,iq
710
711	DO l=ll_begin,ll_end
712	DO j=jj_begin,jj_end
713	DO i=ii_begin,ii_end
714	ij=(j-1)*iim+i
715	duc(ij,:,l)=dulon(ij,l)elon_i(ij,:)+dulat(ij,l)elat_i(ij,:)
716	ENDDO
717	ENDDO
718	ENDDO
719
720	DO l=ll_begin,ll_end
721	DO j=jj_begin,jj_end
722	DO i=ii_begin,ii_end
723	ij=(j-1)*iim+i
724	u(ij+u_right,l) = u(ij+u_right,l) + dtphy * sum( 0.5(duc(ij,:,l) + duc(ij+t_right,:,l))ep_e(ij+u_right,:) )
725	u(ij+u_lup,l) = u(ij+u_lup,l) + dtphy * sum( 0.5(duc(ij,:,l) + duc(ij+t_lup,:,l))ep_e(ij+u_lup,:) )
726	u(ij+u_ldown,l) = u(ij+u_ldown,l) + dtphysum( 0.5(duc(ij,:,l) + duc(ij+t_ldown,:,l))*ep_e(ij+u_ldown,:) )
727	ENDDO
728	ENDDO
729	ENDDO
730
731	DO l=ll_begin,ll_end
732	DO j=jj_begin,jj_end
733	DO i=ii_begin,ii_end
734	ij=(j-1)*iim+i
735	Temp(ij,l)=Temp(ij,l)+ dtphy * dTemp(ij,l)
736	ENDDO
737	ENDDO
738	ENDDO
739
740	DO iq=1,nqtot
741	DO l=ll_begin,ll_end
742	DO j=jj_begin,jj_end
743	DO i=ii_begin,ii_end
744	ij=(j-1)*iim+i
745	q(ij,l,iq)=q(ij,l,iq)+ dtphy * dq(ij,l,iq)
746	ENDDO
747	ENDDO
748	ENDDO
749	ENDDO
750
751	!$OMP BARRIER
752
753	IF (is_omp_first_level) THEN
754	DO j=jj_begin,jj_end
755	DO i=ii_begin,ii_end
756	ij=(j-1)*iim+i
757	ps(ij)=ps(ij)+ dtphy * dps(ij)
758	ENDDO
759	ENDDO
760	ENDIF
761
762	! CALL compute_temperature2theta_rhodz(ps,Temp,theta_rhodz,0)
763
764	! compute pression
765	!$OMP BARRIER
766	DO l = ll_begin,ll_endp1
767	DO j=jj_begin,jj_end
768	DO i=ii_begin,ii_end
769	ij=(j-1)*iim+i
770	p(ij,l) = ap(l) + bp(l) * ps(ij)
771	ENDDO
772	ENDDO
773	ENDDO
774
775	!$OMP BARRIER
776
777	! compute exner
778
779	IF (is_omp_first_level) THEN
780	DO j=jj_begin,jj_end
781	DO i=ii_begin,ii_end
782	ij=(j-1)*iim+i
783	pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
784	ENDDO
785	ENDDO
786	ENDIF
787
788	! 3D : pk
789	DO l = ll_begin,ll_end
790	DO j=jj_begin,jj_end
791	DO i=ii_begin,ii_end
792	ij=(j-1)*iim+i
793	pk(ij,l) = cpp * ((.5/preff)(p(ij,l)+p(ij,l+1))) * kappa
794	ENDDO
795	ENDDO
796	ENDDO
797
798	!$OMP BARRIER
799
800	! compute theta, temperature and pression at layer
801	DO l = ll_begin, ll_end
802	DO j=jj_begin,jj_end
803	DO i=ii_begin,ii_end
804	ij=(j-1)*iim+i
805	theta_rhodz(ij,l) = temp(ij,l) * ((p(ij,l)-p(ij,l+1))/g) / (pk(ij,l) / cpp )
806	ENDDO
807	ENDDO
808	ENDDO
809
810	END SUBROUTINE grid_physics_to_icosa
811
812
813
814	END SUBROUTINE physics
815
816
817
818
819
820	END MODULE interface_icosa_lmdz_mod

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

Download in other formats:

Original Format