Context Navigation

calfis_loc.F90 @ 5297

Last change on this file since 5297 was 5285, checked in by abarral, 4 days ago
As discussed internally, remove generic ONLY: ... for new _mod_h modules
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 Property svn:keywords set to `Id`
File size: 29.1 KB

Line
1	!
2	! $Id: calfis_loc.F90 5285 2024-10-28 13:33:29Z abarral $
3	!
4	!
5	!
6	SUBROUTINE calfis_loc(lafin, &
7	jD_cur, jH_cur, &
8	pucov, &
9	pvcov, &
10	pteta, &
11	pq, &
12	pmasse, &
13	pps, &
14	pp, &
15	ppk, &
16	pphis, &
17	pphi, &
18	pducov, &
19	pdvcov, &
20	pdteta, &
21	pdq, &
22	flxw, &
23	pdufi, &
24	pdvfi, &
25	pdhfi, &
26	pdqfi, &
27	pdpsfi)
28
29	! Auteur : P. Le Van, F. Hourdin
30	! .........
31	USE dimphy
32	USE mod_phys_lmdz_mpi_data, mpi_root_xx=>mpi_master
33	USE mod_phys_lmdz_omp_data, ONLY: klon_omp, klon_omp_begin
34	USE mod_const_mpi, ONLY: COMM_LMDZ
35	USE mod_interface_dyn_phys
36	USE IOPHY
37	USE lmdz_mpi
38
39	#ifdef CPP_PARA
40	USE parallel_lmdz,ONLY:omp_chunk,using_mpi,jjb_u,jje_u,jjb_v,jje_v &
41	,jj_begin_dyn=>jj_begin,jj_end_dyn=>jj_end
42	USE Write_Field
43	Use Write_field_p
44	USE Times
45	#endif
46	USE infotrac, ONLY: nqtot, tracers
47	USE control_mod, ONLY: planet_type, nsplit_phys
48	USE callphysiq_mod, ONLY: call_physiq
49	USE comvert_mod, ONLY: preff, presnivs
50	USE comconst_mod, ONLY: cpp, daysec, dtphys, dtvr, kappa, pi
51	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS
52	#ifdef CPP_PARA
53	USE iniprint_mod_h
54	USE comgeom2_mod_h
55	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
56	USE paramet_mod_h
57	IMPLICIT NONE
58	!=======================================================================
59	!
60	! 1. rearrangement des tableaux et transformation
61	! variables dynamiques > variables physiques
62	! 2. calcul des termes physiques
63	! 3. retransformation des tendances physiques en tendances dynamiques
64	!
65	! remarques:
66	! ----------
67	!
68	! - les vents sont donnes dans la physique par leurs composantes
69	! naturelles.
70	! - la variable thermodynamique de la physique est une variable
71	! intensive : T
72	! pour la dynamique on prend T * ( preff / p(l) ) **kappa
73	! - les deux seules variables dependant de la geometrie necessaires
74	! pour la physique sont la latitude pour le rayonnement et
75	! l'aire de la maille quand on veut integrer une grandeur
76	! horizontalement.
77	! - les points de la physique sont les points scalaires de la
78	! la dynamique; numerotation:
79	! 1 pour le pole nord
80	! (jjm-1)*iim pour l'interieur du domaine
81	! ngridmx pour le pole sud
82	! ---> ngridmx=2+(jjm-1)*iim
83	!
84	! Input :
85	! -------
86	! ecritphy frequence d'ecriture (en jours)de histphy
87	! pucov covariant zonal velocity
88	! pvcov covariant meridional velocity
89	! pteta potential temperature
90	! pps surface pressure
91	! pmasse masse d'air dans chaque maille
92	! pts surface temperature (K)
93	! callrad clef d'appel au rayonnement
94	!
95	! Output :
96	! --------
97	! pdufi tendency for the natural zonal velocity (ms-1)
98	! pdvfi tendency for the natural meridional velocity
99	! pdhfi tendency for the potential temperature
100	! pdtsfi tendency for the surface temperature
101	!
102	! pdtrad radiative tendencies \ both input
103	! pfluxrad radiative fluxes / and output
104	!
105	!=======================================================================
106	!
107	!-----------------------------------------------------------------------
108	!
109	! 0. Declarations :
110	! ------------------
111	INTEGER :: ngridmx
112	PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm )
113
114	! Arguments :
115	! -----------
116	LOGICAL,INTENT(IN) :: lafin ! .true. for the very last call to physics
117	REAL,INTENT(IN):: jD_cur, jH_cur
118	REAL,INTENT(IN):: pvcov(iip1,jjb_v:jje_v,llm) ! covariant meridional velocity
119	REAL,INTENT(IN):: pucov(iip1,jjb_u:jje_u,llm) ! covariant zonal velocity
120	REAL,INTENT(IN):: pteta(iip1,jjb_u:jje_u,llm) ! potential temperature
121	REAL,INTENT(IN):: pmasse(iip1,jjb_u:jje_u,llm) ! mass in each cell ! not used
122	REAL,INTENT(IN):: pq(iip1,jjb_u:jje_u,llm,nqtot) ! tracers
123	REAL,INTENT(IN):: pphis(iip1,jjb_u:jje_u) ! surface geopotential
124	REAL,INTENT(IN):: pphi(iip1,jjb_u:jje_u,llm) ! geopotential
125
126	REAL,INTENT(IN) :: pdvcov(iip1,jjb_v:jje_v,llm) ! dynamical tendency on vcov ! not used
127	REAL,INTENT(IN) :: pducov(iip1,jjb_u:jje_u,llm) ! dynamical tendency on ucov
128	REAL,INTENT(IN) :: pdteta(iip1,jjb_u:jje_u,llm) ! dynamical tendency on teta ! not used
129	REAL,INTENT(IN) :: pdq(iip1,jjb_u:jje_u,llm,nqtot) ! dynamical tendency on tracers ! not used
130
131	REAL,INTENT(IN) :: pps(iip1,jjb_u:jje_u) ! surface pressure (Pa)
132	REAL,INTENT(IN) :: pp(iip1,jjb_u:jje_u,llmp1) ! pressure at mesh interfaces (Pa)
133	REAL,INTENT(IN) :: ppk(iip1,jjb_u:jje_u,llm) ! Exner at mid-layer
134	REAL,INTENT(IN) :: flxw(iip1,jjb_u:jje_u,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
135
136	! ! tendencies (in */s) from the physics
137	REAL,INTENT(OUT) :: pdvfi(iip1,jjb_v:jje_v,llm) ! tendency on covariant meridional wind
138	REAL,INTENT(OUT) :: pdufi(iip1,jjb_u:jje_u,llm) ! tendency on covariant zonal wind
139	REAL,INTENT(OUT) :: pdhfi(iip1,jjb_u:jje_u,llm) ! tendency on potential temperature (K/s)
140	REAL,INTENT(OUT) :: pdqfi(iip1,jjb_u:jje_u,llm,nqtot) ! tendency on tracers
141	REAL,INTENT(OUT) :: pdpsfi(iip1,jjb_u:jje_u) ! tendency on surface pressure (Pa/s)
142
143	! Ehouarn: for now calfis_p needs some informations from physics to compile
144	! Local variables :
145	! -----------------
146
147	INTEGER :: i,j,l,ig0,ig,iq,itr
148	REAL,ALLOCATABLE,SAVE :: zpsrf(:)
149	REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:)
150	REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:)
151	!
152	REAL :: zrot(iip1,jjb_v:jje_v,llm) ! AdlC May 2014
153	REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:), zrfi(:,:)
154	REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:)
155	REAL,ALLOCATABLE,SAVE :: zpk(:,:)
156	!
157	REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:)
158	REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
159	!
160	REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
161	REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
162	REAL,ALLOCATABLE,SAVE :: zdpsrf(:)
163	REAL,SAVE,ALLOCATABLE :: flxwfi(:,:) ! Flux de masse verticale sur la grille physiq
164
165	!
166	REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:)
167	REAL,ALLOCATABLE,SAVE :: zplay_omp(:,:)
168	REAL,ALLOCATABLE,SAVE :: zpk_omp(:,:)
169	REAL,ALLOCATABLE,SAVE :: zphi_omp(:,:)
170	REAL,ALLOCATABLE,SAVE :: zphis_omp(:)
171	REAL,ALLOCATABLE,SAVE :: presnivs_omp(:)
172	REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:)
173	REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:)
174	REAL,ALLOCATABLE,SAVE :: zrfi_omp(:,:)
175	REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:)
176	REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:)
177	REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:)
178	REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:)
179	REAL,ALLOCATABLE,SAVE :: zdtfi_omp(:,:)
180	REAL,ALLOCATABLE,SAVE :: zdqfi_omp(:,:,:)
181	REAL,ALLOCATABLE,SAVE :: zdpsrf_omp(:)
182	REAL,SAVE,ALLOCATABLE :: flxwfi_omp(:,:) ! Flux de masse verticale sur la grille physiq
183
184	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
185	! Introduction du splitting (FH)
186	! Question pour Yann :
187	! J'ai �t� surpris au d�but que les tableaux zufi_omp, zdufi_omp n'co soitent
188	! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il
189	! soit allocatable (plutot par exemple que de passer une dimension
190	! d�pendant du process en argument des routines) et que, du coup,
191	! le SAVE �vite d'avoir � refaire l'allocation � chaque appel.
192	! Tu confirmes ?
193	! J'ai suivi le m�me principe pour les zdufic_omp
194	! Mais c'est surement bien que tu controles.
195	!
196
197	REAL,ALLOCATABLE,SAVE :: zdufic_omp(:,:)
198	REAL,ALLOCATABLE,SAVE :: zdvfic_omp(:,:)
199	REAL,ALLOCATABLE,SAVE :: zdtfic_omp(:,:)
200	REAL,ALLOCATABLE,SAVE :: zdqfic_omp(:,:,:)
201	REAL :: jH_cur_split,zdt_split
202	LOGICAL :: debut_split,lafin_split
203	INTEGER :: isplit
204	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
205
206	!$OMP THREADPRIVATE(zplev_omp,zplay_omp,zpk_omp,zphi_omp,zphis_omp, &
207	!$OMP presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp, &
208	!$OMP zrfi_omp,zqfi_omp,zdufi_omp,zdvfi_omp, &
209	!$OMP zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp, &
210	!$OMP zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp)
211
212	LOGICAL,SAVE :: first_omp=.true.
213	!$OMP THREADPRIVATE(first_omp)
214
215	REAL :: zsin(iim),zcos(iim),z1(iim)
216	REAL :: zsinbis(iim),zcosbis(iim),z1bis(iim)
217	REAL :: unskap, pksurcp
218	!
219	REAL :: SSUM
220
221	LOGICAL,SAVE :: firstcal=.true., debut=.true.
222	!$OMP THREADPRIVATE(firstcal,debut)
223
224	REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
225	INTEGER :: ierr
226	INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status
227	INTEGER, dimension(4) :: Req
228	REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
229	integer :: k,kstart,kend
230	INTEGER :: offset
231	INTEGER :: jjb,jje
232
233	IF (CPPKEY_PHYS) THEN
234
235	!
236	!-----------------------------------------------------------------------
237	!
238	! 1. Initialisations :
239	! --------------------
240	!
241
242	klon=klon_mpi
243
244	!
245	IF ( firstcal ) THEN
246	debut = .TRUE.
247	IF (ngridmx.NE.2+(jjm-1)*iim) THEN
248	write(lunout,*) 'STOP dans calfis'
249	write(lunout,*) &
250	'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
251	write(lunout,*) ' ngridmx jjm iim '
252	write(lunout,*) ngridmx,jjm,iim
253	call abort_gcm("calfis_loc", "", 1)
254	ENDIF
255	!$OMP MASTER
256	ALLOCATE(zpsrf(klon))
257	ALLOCATE(zplev(klon,llm+1),zplay(klon,llm))
258	ALLOCATE(zphi(klon,llm),zphis(klon))
259	ALLOCATE(zufi(klon,llm), zvfi(klon,llm),zrfi(klon,llm))
260	ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqtot))
261	ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
262	ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
263	ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
264	ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
265	ALLOCATE(zdpsrf(klon))
266	ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
267	ALLOCATE(flxwfi(klon,llm))
268	ALLOCATE(zpk(klon,llm))
269	!$OMP END MASTER
270	!$OMP BARRIER
271	ELSE
272	debut = .FALSE.
273	ENDIF
274
275	!
276	!
277	!-----------------------------------------------------------------------
278	! 40. transformation des variables dynamiques en variables physiques:
279	! ---------------------------------------------------------------
280
281	! 41. pressions au sol (en Pascals)
282	! ----------------------------------
283
284	!$OMP MASTER
285	call start_timer(timer_physic)
286	!$OMP END MASTER
287
288	!$OMP MASTER
289	!CDIR ON_ADB(index_i)
290	!CDIR ON_ADB(index_j)
291	do ig0=1,klon
292	i=index_i(ig0)
293	j=index_j(ig0)
294	zpsrf(ig0)=pps(i,j)
295	enddo
296	!$OMP END MASTER
297
298
299	! 42. pression intercouches :
300	!
301	! -----------------------------------------------------------------
302	! .... zplev definis aux (llm +1) interfaces des couches ....
303	! .... zplay definis aux ( llm ) milieux des couches ....
304	! -----------------------------------------------------------------
305
306	! ... Exner = cp * ( p(l) / preff ) ** kappa ....
307	!
308	unskap = 1./ kappa
309	!
310	! print *,omp_rank,'klon--->',klon
311	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
312	DO l = 1, llmp1
313	!CDIR ON_ADB(index_i)
314	!CDIR ON_ADB(index_j)
315	do ig0=1,klon
316	i=index_i(ig0)
317	j=index_j(ig0)
318	zplev( ig0,l ) = pp(i,j,l)
319	enddo
320	ENDDO
321	!$OMP END DO NOWAIT
322
323	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
324	DO l=1,llm
325	do ig0=1,klon
326	i=index_i(ig0)
327	j=index_j(ig0)
328	zpk(ig0,l)=ppk(i,j,l)
329	enddo
330	ENDDO
331	!$OMP END DO NOWAIT
332
333	!
334	!
335
336	! 43. temperature naturelle (en K) et pressions milieux couches .
337	! ---------------------------------------------------------------
338	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
339	DO l=1,llm
340	!CDIR ON_ADB(index_i)
341	!CDIR ON_ADB(index_j)
342	do ig0=1,klon
343	i=index_i(ig0)
344	j=index_j(ig0)
345	pksurcp = ppk(i,j,l) / cpp
346	zplay(ig0,l) = preff * pksurcp ** unskap
347	ztfi(ig0,l) = pteta(i,j,l) * pksurcp
348	enddo
349
350	ENDDO
351	!$OMP END DO NOWAIT
352
353	! 43.bis traceurs
354	! ---------------
355	!
356
357	itr = 0
358	DO iq=1,nqtot
359	IF(.NOT.tracers(iq)%isAdvected) CYCLE
360	itr = itr + 1
361	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
362	DO l=1,llm
363	!CDIR ON_ADB(index_i)
364	!CDIR ON_ADB(index_j)
365	do ig0=1,klon
366	i=index_i(ig0)
367	j=index_j(ig0)
368	zqfi(ig0,l,itr) = pq(i,j,l,iq)
369	enddo
370	ENDDO
371	!$OMP END DO NOWAIT
372	ENDDO
373
374
375	! Geopotentiel calcule par rapport a la surface locale:
376	! -----------------------------------------------------
377
378	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
379	DO l=1,llm
380	!CDIR ON_ADB(index_i)
381	!CDIR ON_ADB(index_j)
382	do ig0=1,klon
383	i=index_i(ig0)
384	j=index_j(ig0)
385	zphi(ig0,l) = pphi(i,j,l)
386	enddo
387	ENDDO
388	!$OMP END DO NOWAIT
389
390	! CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi)
391
392	!$OMP MASTER
393	!CDIR ON_ADB(index_i)
394	!CDIR ON_ADB(index_j)
395	do ig0=1,klon
396	i=index_i(ig0)
397	j=index_j(ig0)
398	zphis(ig0) = pphis(i,j)
399	enddo
400	!$OMP END MASTER
401
402
403	! CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis)
404
405	!$OMP BARRIER
406
407	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
408	DO l=1,llm
409	DO ig=1,klon
410	zphi(ig,l)=zphi(ig,l)-zphis(ig)
411	ENDDO
412	ENDDO
413	!$OMP END DO NOWAIT
414
415
416	!
417	! 45. champ u:
418	! ------------
419
420	kstart=1
421	kend=klon
422
423	if (is_north_pole_dyn) kstart=2
424	if (is_south_pole_dyn) kend=klon-1
425
426	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
427	DO l=1,llm
428	!CDIR ON_ADB(index_i)
429	!CDIR ON_ADB(index_j)
430	!CDIR SPARSE
431	do ig0=kstart,kend
432	i=index_i(ig0)
433	j=index_j(ig0)
434	if (i==1) then
435	zufi(ig0,l)= 0.5 *( pucov(iim,j,l)/cu(iim,j) &
436	+ pucov(1,j,l)/cu(1,j) )
437	else
438	zufi(ig0,l)= 0.5*( pucov(i-1,j,l)/cu(i-1,j) &
439	+ pucov(i,j,l)/cu(i,j) )
440	endif
441	enddo
442	ENDDO
443	!$OMP END DO NOWAIT
444
445	!
446	! Alvaro de la Camara (May 2014)
447	! 46.1 Calcul de la vorticite et passage sur la grille physique
448	! --------------------------------------------------------------
449
450	jjb=jj_begin_dyn-1
451	jje=jj_end_dyn+1
452	if (is_north_pole_dyn) jjb=1
453	if (is_south_pole_dyn) jje=jjm
454
455	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
456
457	DO l=1,llm
458	do i=1,iim
459	do j=jjb,jje
460	zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l) &
461	+ pucov(i,j+1,l) - pucov(i,j,l)) &
462	/ (cu(i,j)+cu(i,j+1)) &
463	/ (cv(i+1,j)+cv(i,j)) *4
464	enddo
465	enddo
466	ENDDO
467
468
469	! 46.2champ v:
470	! -----------
471
472	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
473	DO l=1,llm
474	!CDIR ON_ADB(index_i)
475	!CDIR ON_ADB(index_j)
476	DO ig0=kstart,kend
477	i=index_i(ig0)
478	j=index_j(ig0)
479	zvfi(ig0,l)= 0.5 *( pvcov(i,j-1,l)/cv(i,j-1) &
480	+ pvcov(i,j,l)/cv(i,j) )
481	if (j==1 .OR. j==jjp1) then ! AdlC MAY 2014
482	zrfi(ig0,l) = 0 ! AdlC MAY 2014
483	else
484	if(i==1)then
485	zrfi(ig0,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l) &
486	+zrot(1,j-1,l)+zrot(1,j,l)) ! AdlC MAY 2014
487	else
488	zrfi(ig0,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l) &
489	+zrot(i,j-1,l)+zrot(i,j,l)) ! AdlC MAY 2014
490	endif
491	endif
492
493
494	ENDDO
495	ENDDO
496	!$OMP END DO NOWAIT
497
498	! 47. champs de vents aux pole nord
499	! ------------------------------
500	! U = 1 / pi * integrale [ v * cos(long) * d long ]
501	! V = 1 / pi * integrale [ v * sin(long) * d long ]
502
503	if (is_north_pole_dyn) then
504	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
505	DO l=1,llm
506
507	z1(1) =(rlonu(1)-rlonu(iim)+2.pi)pvcov(1,1,l)/cv(1,1)
508	DO i=2,iim
509	z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
510	ENDDO
511
512	DO i=1,iim
513	zcos(i) = COS(rlonv(i))*z1(i)
514	zsin(i) = SIN(rlonv(i))*z1(i)
515	ENDDO
516
517	zufi(1,l) = SSUM(iim,zcos,1)/pi
518	zvfi(1,l) = SSUM(iim,zsin,1)/pi
519	zrfi(1,l) = 0.
520
521	ENDDO
522	!$OMP END DO NOWAIT
523	endif
524
525
526	! 48. champs de vents aux pole sud:
527	! ---------------------------------
528	! U = 1 / pi * integrale [ v * cos(long) * d long ]
529	! V = 1 / pi * integrale [ v * sin(long) * d long ]
530
531	if (is_south_pole_dyn) then
532	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
533	DO l=1,llm
534
535	z1(1) =(rlonu(1)-rlonu(iim)+2.pi)pvcov(1,jjm,l)/cv(1,jjm)
536	DO i=2,iim
537	z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
538	ENDDO
539
540	DO i=1,iim
541	zcos(i) = COS(rlonv(i))*z1(i)
542	zsin(i) = SIN(rlonv(i))*z1(i)
543	ENDDO
544
545	zufi(klon,l) = SSUM(iim,zcos,1)/pi
546	zvfi(klon,l) = SSUM(iim,zsin,1)/pi
547	zrfi(klon,l) = 0.
548	ENDDO
549	!$OMP END DO NOWAIT
550	endif
551
552	! On change de grille, dynamique vers physiq, pour le flux de masse verticale
553	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
554	DO l=1,llm
555	!CDIR ON_ADB(index_i)
556	!CDIR ON_ADB(index_j)
557	do ig0=1,klon
558	i=index_i(ig0)
559	j=index_j(ig0)
560	flxwfi(ig0,l) = flxw(i,j,l)
561	enddo
562	ENDDO
563	!$OMP END DO NOWAIT
564
565	! CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi)
566
567	!-----------------------------------------------------------------------
568	! Appel de la physique:
569	! ---------------------
570
571
572	!$OMP BARRIER
573	if (first_omp) then
574	klon=klon_omp
575
576	allocate(zplev_omp(klon,llm+1))
577	allocate(zplay_omp(klon,llm))
578	allocate(zpk_omp(klon,llm))
579	allocate(zphi_omp(klon,llm))
580	allocate(zphis_omp(klon))
581	allocate(presnivs_omp(llm))
582	allocate(zufi_omp(klon,llm))
583	allocate(zvfi_omp(klon,llm))
584	allocate(zrfi_omp(klon,llm)) ! LG Ari 2014
585	allocate(ztfi_omp(klon,llm))
586	allocate(zqfi_omp(klon,llm,nqtot))
587	allocate(zdufi_omp(klon,llm))
588	allocate(zdvfi_omp(klon,llm))
589	allocate(zdtfi_omp(klon,llm))
590	allocate(zdqfi_omp(klon,llm,nqtot))
591	allocate(zdufic_omp(klon,llm))
592	allocate(zdvfic_omp(klon,llm))
593	allocate(zdtfic_omp(klon,llm))
594	allocate(zdqfic_omp(klon,llm,nqtot))
595	allocate(zdpsrf_omp(klon))
596	allocate(flxwfi_omp(klon,llm))
597	first_omp=.false.
598	endif
599
600
601	klon=klon_omp
602	offset=klon_omp_begin-1
603
604	do l=1,llm+1
605	do i=1,klon
606	zplev_omp(i,l)=zplev(offset+i,l)
607	enddo
608	enddo
609
610	do l=1,llm
611	do i=1,klon
612	zplay_omp(i,l)=zplay(offset+i,l)
613	enddo
614	enddo
615
616	do l=1,llm
617	do i=1,klon
618	zpk_omp(i,l)=zpk(offset+i,l)
619	enddo
620	enddo
621
622	do l=1,llm
623	do i=1,klon
624	zphi_omp(i,l)=zphi(offset+i,l)
625	enddo
626	enddo
627
628	do i=1,klon
629	zphis_omp(i)=zphis(offset+i)
630	enddo
631
632
633	do l=1,llm
634	presnivs_omp(l)=presnivs(l)
635	enddo
636
637	do l=1,llm
638	do i=1,klon
639	zufi_omp(i,l)=zufi(offset+i,l)
640	enddo
641	enddo
642
643	do l=1,llm
644	do i=1,klon
645	zvfi_omp(i,l)=zvfi(offset+i,l)
646	enddo
647	enddo
648
649	do l=1,llm
650	do i=1,klon
651	zrfi_omp(i,l)=zrfi(offset+i,l)
652	enddo
653	enddo
654
655	do l=1,llm
656	do i=1,klon
657	ztfi_omp(i,l)=ztfi(offset+i,l)
658	enddo
659	enddo
660
661	do iq=1,nqtot
662	do l=1,llm
663	do i=1,klon
664	zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq)
665	enddo
666	enddo
667	enddo
668
669	do l=1,llm
670	do i=1,klon
671	zdufi_omp(i,l)=zdufi(offset+i,l)
672	enddo
673	enddo
674
675	do l=1,llm
676	do i=1,klon
677	zdvfi_omp(i,l)=zdvfi(offset+i,l)
678	enddo
679	enddo
680
681	do l=1,llm
682	do i=1,klon
683	zdtfi_omp(i,l)=zdtfi(offset+i,l)
684	enddo
685	enddo
686
687	do iq=1,nqtot
688	do l=1,llm
689	do i=1,klon
690	zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq)
691	enddo
692	enddo
693	enddo
694
695	do i=1,klon
696	zdpsrf_omp(i)=zdpsrf(offset+i)
697	enddo
698
699	do l=1,llm
700	do i=1,klon
701	flxwfi_omp(i,l)=flxwfi(offset+i,l)
702	enddo
703	enddo
704
705	!$OMP BARRIER
706
707
708	!$OMP MASTER
709	! write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
710	!$OMP END MASTER
711	zdt_split=dtphys/nsplit_phys
712	zdufic_omp(:,:)=0.
713	zdvfic_omp(:,:)=0.
714	zdtfic_omp(:,:)=0.
715	zdqfic_omp(:,:,:)=0.
716
717	IF (CPPKEY_PHYS) THEN
718	do isplit=1,nsplit_phys
719
720	jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
721	debut_split=debut.and.isplit==1
722	lafin_split=lafin.and.isplit==nsplit_phys
723
724	CALL call_physiq(klon,llm,nqtot,tracers(:)%name, &
725	debut_split,lafin_split, &
726	jD_cur,jH_cur_split,zdt_split, &
727	zplev_omp,zplay_omp, &
728	zpk_omp,zphi_omp,zphis_omp, &
729	presnivs_omp, &
730	zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp, &
731	flxwfi_omp,pducov, &
732	zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp, &
733	zdpsrf_omp)
734
735
736	zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
737	zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
738	ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split
739	zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split
740
741	zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:)
742	zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:)
743	zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:)
744	zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:)
745
746	enddo
747
748	END IF
749	! of #ifdef CPP_PHYS
750
751
752	zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys
753	zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys
754	zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys
755	zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys
756
757	!$OMP BARRIER
758
759	do l=1,llm+1
760	do i=1,klon
761	zplev(offset+i,l)=zplev_omp(i,l)
762	enddo
763	enddo
764
765	do l=1,llm
766	do i=1,klon
767	zplay(offset+i,l)=zplay_omp(i,l)
768	enddo
769	enddo
770
771	do l=1,llm
772	do i=1,klon
773	zphi(offset+i,l)=zphi_omp(i,l)
774	enddo
775	enddo
776
777
778	do i=1,klon
779	zphis(offset+i)=zphis_omp(i)
780	enddo
781
782
783	do l=1,llm
784	presnivs(l)=presnivs_omp(l)
785	enddo
786
787	do l=1,llm
788	do i=1,klon
789	zufi(offset+i,l)=zufi_omp(i,l)
790	enddo
791	enddo
792
793	do l=1,llm
794	do i=1,klon
795	zvfi(offset+i,l)=zvfi_omp(i,l)
796	enddo
797	enddo
798
799	do l=1,llm
800	do i=1,klon
801	ztfi(offset+i,l)=ztfi_omp(i,l)
802	enddo
803	enddo
804
805	do iq=1,nqtot
806	do l=1,llm
807	do i=1,klon
808	zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq)
809	enddo
810	enddo
811	enddo
812
813	do l=1,llm
814	do i=1,klon
815	zdufi(offset+i,l)=zdufi_omp(i,l)
816	enddo
817	enddo
818
819	do l=1,llm
820	do i=1,klon
821	zdvfi(offset+i,l)=zdvfi_omp(i,l)
822	enddo
823	enddo
824
825	do l=1,llm
826	do i=1,klon
827	zdtfi(offset+i,l)=zdtfi_omp(i,l)
828	enddo
829	enddo
830
831	do iq=1,nqtot
832	do l=1,llm
833	do i=1,klon
834	zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq)
835	enddo
836	enddo
837	enddo
838
839	do i=1,klon
840	zdpsrf(offset+i)=zdpsrf_omp(i)
841	enddo
842
843
844	klon=klon_mpi
845	500 CONTINUE
846	!$OMP BARRIER
847
848	!$OMP MASTER
849	call stop_timer(timer_physic)
850	!$OMP END MASTER
851
852	IF (using_mpi) THEN
853
854	if (MPI_rank>0) then
855
856	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
857	DO l=1,llm
858	du_send(1:iim,l)=zdufi(1:iim,l)
859	dv_send(1:iim,l)=zdvfi(1:iim,l)
860	ENDDO
861	!$OMP END DO NOWAIT
862
863	!$OMP BARRIER
864
865	!$OMP MASTER
866	!$OMP CRITICAL (MPI)
867	call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401, &
868	COMM_LMDZ,Req(1),ierr)
869	call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402, &
870	COMM_LMDZ,Req(2),ierr)
871	!$OMP END CRITICAL (MPI)
872	!$OMP END MASTER
873
874	!$OMP BARRIER
875
876	endif
877
878	if (MPI_rank<MPI_Size-1) then
879	!$OMP BARRIER
880
881	!$OMP MASTER
882	!$OMP CRITICAL (MPI)
883	call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401, &
884	COMM_LMDZ,Req(3),ierr)
885	call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402, &
886	COMM_LMDZ,Req(4),ierr)
887	!$OMP END CRITICAL (MPI)
888	!$OMP END MASTER
889
890	endif
891
892	!$OMP BARRIER
893
894
895	!$OMP MASTER
896	!$OMP CRITICAL (MPI)
897	if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then
898	call MPI_WAITALL(4,Req(1),Status,ierr)
899	else if (MPI_rank>0) then
900	call MPI_WAITALL(2,Req(1),Status,ierr)
901	else if (MPI_rank <MPI_Size-1) then
902	call MPI_WAITALL(2,Req(3),Status,ierr)
903	endif
904	!$OMP END CRITICAL (MPI)
905	!$OMP END MASTER
906
907	!$OMP BARRIER
908
909	ENDIF ! using_mpi
910
911
912	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
913	DO l=1,llm
914
915	zdufi2(1:klon,l)=zdufi(1:klon,l)
916	zdufi2(klon+1:klon+iim,l)=du_recv(1:iim,l)
917
918	zdvfi2(1:klon,l)=zdvfi(1:klon,l)
919	zdvfi2(klon+1:klon+iim,l)=dv_recv(1:iim,l)
920
921	pdhfi(:,jj_begin,l)=0
922	pdqfi(:,jj_begin,l,:)=0
923	pdufi(:,jj_begin,l)=0
924	pdvfi(:,jj_begin,l)=0
925
926	if (.not. is_south_pole_dyn) then
927	pdhfi(:,jj_end:jj_end+1,l)=0
928	pdqfi(:,jj_end:jj_end+1,l,:)=0
929	pdufi(:,jj_end:jj_end+1,l)=0
930	pdvfi(:,jj_end:jj_end+1,l)=0
931	endif
932
933	ENDDO
934	!$OMP END DO NOWAIT
935
936	!$OMP MASTER
937	pdpsfi(:,jj_begin)=0
938
939	if (.not. is_south_pole_dyn) then
940	pdpsfi(:,jj_end:jj_end+1)=0
941	endif
942	!$OMP END MASTER
943	!-----------------------------------------------------------------------
944	! transformation des tendances physiques en tendances dynamiques:
945	! ---------------------------------------------------------------
946
947	! tendance sur la pression :
948	! -----------------------------------
949	! CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi)
950
951	!$OMP MASTER
952	kstart=1
953	kend=klon
954
955	if (is_north_pole_dyn) kstart=2
956	if (is_south_pole_dyn) kend=klon-1
957
958	!CDIR ON_ADB(index_i)
959	!CDIR ON_ADB(index_j)
960	!cdir NODEP
961	do ig0=kstart,kend
962	i=index_i(ig0)
963	j=index_j(ig0)
964	pdpsfi(i,j) = zdpsrf(ig0)
965	if (i==1) pdpsfi(iip1,j) = zdpsrf(ig0)
966	enddo
967
968	if (is_north_pole_dyn) then
969	DO i=1,iip1
970	pdpsfi(i,1) = zdpsrf(1)
971	enddo
972	endif
973
974	if (is_south_pole_dyn) then
975	DO i=1,iip1
976	pdpsfi(i,jjp1) = zdpsrf(klon)
977	ENDDO
978	endif
979	!$OMP END MASTER
980	!c$OMP BARRIER
981
982	!
983	! 62. enthalpie potentielle
984	! ---------------------
985
986	kstart=1
987	kend=klon
988
989	if (is_north_pole_dyn) kstart=2
990	if (is_south_pole_dyn) kend=klon-1
991
992	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
993	DO l=1,llm
994
995	!CDIR ON_ADB(index_i)
996	!CDIR ON_ADB(index_j)
997	!cdir NODEP
998	do ig0=kstart,kend
999	i=index_i(ig0)
1000	j=index_j(ig0)
1001	pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
1002	if (i==1) pdhfi(iip1,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
1003	enddo
1004
1005	if (is_north_pole_dyn) then
1006	DO i=1,iip1
1007	pdhfi(i,1,l) = cpp * zdtfi(1,l) / ppk(i, 1 ,l)
1008	enddo
1009	endif
1010
1011	if (is_south_pole_dyn) then
1012	DO i=1,iip1
1013	pdhfi(i,jjp1,l) = cpp * zdtfi(klon,l)/ ppk(i,jjp1,l)
1014	ENDDO
1015	endif
1016	ENDDO
1017	!$OMP END DO NOWAIT
1018
1019	! 62. humidite specifique
1020	! ---------------------
1021	! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
1022	! DO iq=1,nqtot
1023	!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1024	! DO l=1,llm
1025	!!!cdir NODEP
1026	! do ig0=kstart,kend
1027	! i=index_i(ig0)
1028	! j=index_j(ig0)
1029	! pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq)
1030	! if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq)
1031	! enddo
1032	!
1033	! if (is_north_pole_dyn) then
1034	! do i=1,iip1
1035	! pdqfi(i,1,l,iq) = zdqfi(1,l,iq)
1036	! enddo
1037	! endif
1038	!
1039	! if (is_south_pole_dyn) then
1040	! do i=1,iip1
1041	! pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq)
1042	! enddo
1043	! endif
1044	! ENDDO
1045	!c$OMP END DO NOWAIT
1046	! ENDDO
1047
1048	! 63. traceurs
1049	! ------------
1050	! initialisation des tendances
1051
1052	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1053	DO l=1,llm
1054	pdqfi(:,jj_begin:jj_end,l,:)=0.
1055	ENDDO
1056	!$OMP END DO NOWAIT
1057
1058	!
1059	!cdir NODEP
1060	itr = 0
1061	DO iq=1,nqtot
1062	IF(.NOT.tracers(iq)%isAdvected) CYCLE
1063	itr = itr + 1
1064	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1065	DO l=1,llm
1066	!CDIR ON_ADB(index_i)
1067	!CDIR ON_ADB(index_j)
1068	!cdir NODEP
1069	DO ig0=kstart,kend
1070	i=index_i(ig0)
1071	j=index_j(ig0)
1072	pdqfi(i,j,l,iq) = zdqfi(ig0,l,itr)
1073	if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,itr)
1074	ENDDO
1075
1076	IF (is_north_pole_dyn) then
1077	DO i=1,iip1
1078	pdqfi(i,1,l,iq) = zdqfi(1,l,itr)
1079	ENDDO
1080	ENDIF
1081
1082	IF (is_south_pole_dyn) then
1083	DO i=1,iip1
1084	pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,itr)
1085	ENDDO
1086	ENDIF
1087
1088	ENDDO
1089	!$OMP END DO NOWAIT
1090	ENDDO
1091
1092	! 65. champ u:
1093	! ------------
1094	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1095	DO l=1,llm
1096	!CDIR ON_ADB(index_i)
1097	!CDIR ON_ADB(index_j)
1098	!cdir NODEP
1099	do ig0=kstart,kend
1100	i=index_i(ig0)
1101	j=index_j(ig0)
1102
1103	if (i/=iim) then
1104	pdufi(i,j,l)=0.5(zdufi2(ig0,l)+zdufi2(ig0+1,l))cu(i,j)
1105	endif
1106
1107	if (i==1) then
1108	pdufi(iim,j,l)=0.5*( zdufi2(ig0,l) &
1109	+ zdufi2(ig0+iim-1,l))*cu(iim,j)
1110	pdufi(iip1,j,l)=0.5(zdufi2(ig0,l)+zdufi2(ig0+1,l))cu(i,j)
1111	endif
1112
1113	enddo
1114
1115	if (is_north_pole_dyn) then
1116	DO i=1,iip1
1117	pdufi(i,1,l) = 0.
1118	ENDDO
1119	endif
1120
1121	if (is_south_pole_dyn) then
1122	DO i=1,iip1
1123	pdufi(i,jjp1,l) = 0.
1124	ENDDO
1125	endif
1126
1127	ENDDO
1128	!$OMP END DO NOWAIT
1129
1130	! 67. champ v:
1131	! ------------
1132
1133	kstart=1
1134	kend=klon
1135
1136	if (is_north_pole_dyn) kstart=2
1137	if (is_south_pole_dyn) kend=klon-1-iim
1138
1139	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1140	DO l=1,llm
1141	!CDIR ON_ADB(index_i)
1142	!CDIR ON_ADB(index_j)
1143	!cdir NODEP
1144	do ig0=kstart,kend
1145	i=index_i(ig0)
1146	j=index_j(ig0)
1147	pdvfi(i,j,l)=0.5(zdvfi2(ig0,l)+zdvfi2(ig0+iim,l))cv(i,j)
1148	if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+ &
1149	zdvfi2(ig0+iim,l)) &
1150	*cv(i,j)
1151	enddo
1152
1153	ENDDO
1154	!$OMP END DO NOWAIT
1155
1156
1157	! 68. champ v pres des poles:
1158	! ---------------------------
1159	! v = U * cos(long) + V * SIN(long)
1160
1161	if (is_north_pole_dyn) then
1162
1163	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1164	DO l=1,llm
1165
1166	DO i=1,iim
1167	pdvfi(i,1,l)= &
1168	zdufi(1,l)COS(rlonv(i))+zdvfi(1,l)SIN(rlonv(i))
1169
1170	pdvfi(i,1,l)= &
1171	0.5(pdvfi(i,1,l)+zdvfi(i+1,l))cv(i,1)
1172	ENDDO
1173
1174	pdvfi(iip1,1,l) = pdvfi(1,1,l)
1175
1176	ENDDO
1177	!$OMP END DO NOWAIT
1178
1179	endif
1180
1181	if (is_south_pole_dyn) then
1182
1183	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1184	DO l=1,llm
1185
1186	DO i=1,iim
1187	pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i)) &
1188	+zdvfi(klon,l)*SIN(rlonv(i))
1189
1190	pdvfi(i,jjm,l)= &
1191	0.5(pdvfi(i,jjm,l)+zdvfi(klon-iip1+i,l))cv(i,jjm)
1192	ENDDO
1193
1194	pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
1195
1196	ENDDO
1197	!$OMP END DO NOWAIT
1198
1199	endif
1200	!-----------------------------------------------------------------------
1201
1202	700 CONTINUE
1203
1204	firstcal = .FALSE.
1205
1206	ELSE
1207	call abort_gcm("calfis_loc", &
1208	"calfis_p: for now can only work with parallel physics", 1)
1209	END IF
1210	#endif
1211	! of #ifdef CPP_PARA
1212	END SUBROUTINE calfis_loc

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

Download in other formats:

Original Format