Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

calfis_loc.F90

Last change on this file was 5927, checked in by Sebastien Nguyen, 3 months ago
Changes to compile LMDZ-OR-ISO and wrtie output variables Rsol isotopes soil ratio) xtevap xtcoastal xtrivflu. Changes from CA and ND to write output variables xtprw (precipitatble water) uxt and vxt (meridional and zonal advected humidity) Rlandice and xtsnow.
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.2 KB

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

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

Download in other formats:

Original Format