Context Navigation

calfis_p.F @ 5415

Last change on this file since 5415 was 709, checked in by Laurent Fairhead, 18 years ago
Nouvelles versions de la dynamique YM LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 27.1 KB

Line
1	!
2	! $Header$
3	!
4	C
5	C
6	SUBROUTINE calfis_p(nq,
7	$ lafin,
8	$ rdayvrai,
9	$ heure,
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	$ pw,
25	#ifdef INCA
26	$ flxw,
27	#endif
28	$ clesphy0,
29	$ pdufi,
30	$ pdvfi,
31	$ pdhfi,
32	$ pdqfi,
33	$ pdpsfi)
34	c
35	c Auteur : P. Le Van, F. Hourdin
36	c .........
37	USE dimphy
38	USE parallel
39	USE Write_Field
40	Use Write_field_p
41	USE Times
42	USE IOPHY
43	IMPLICIT NONE
44	c=======================================================================
45	c
46	c 1. rearrangement des tableaux et transformation
47	c variables dynamiques > variables physiques
48	c 2. calcul des termes physiques
49	c 3. retransformation des tendances physiques en tendances dynamiques
50	c
51	c remarques:
52	c ----------
53	c
54	c - les vents sont donnes dans la physique par leurs composantes
55	c naturelles.
56	c - la variable thermodynamique de la physique est une variable
57	c intensive : T
58	c pour la dynamique on prend T * ( preff / p(l) ) **kappa
59	c - les deux seules variables dependant de la geometrie necessaires
60	c pour la physique sont la latitude pour le rayonnement et
61	c l'aire de la maille quand on veut integrer une grandeur
62	c horizontalement.
63	c - les points de la physique sont les points scalaires de la
64	c la dynamique; numerotation:
65	c 1 pour le pole nord
66	c (jjm-1)*iim pour l'interieur du domaine
67	c ngridmx pour le pole sud
68	c ---> ngridmx=2+(jjm-1)*iim
69	c
70	c Input :
71	c -------
72	c ecritphy frequence d'ecriture (en jours)de histphy
73	c pucov covariant zonal velocity
74	c pvcov covariant meridional velocity
75	c pteta potential temperature
76	c pps surface pressure
77	c pmasse masse d'air dans chaque maille
78	c pts surface temperature (K)
79	c callrad clef d'appel au rayonnement
80	c
81	c Output :
82	c --------
83	c pdufi tendency for the natural zonal velocity (ms-1)
84	c pdvfi tendency for the natural meridional velocity
85	c pdhfi tendency for the potential temperature
86	c pdtsfi tendency for the surface temperature
87	c
88	c pdtrad radiative tendencies \ both input
89	c pfluxrad radiative fluxes / and output
90	c
91	c=======================================================================
92	c
93	c-----------------------------------------------------------------------
94	c
95	c 0. Declarations :
96	c ------------------
97
98	#include "dimensions.h"
99	#include "paramet.h"
100	#include "temps.h"
101	#include "advtrac.h"
102
103	INTEGER ngridmx,nq
104	PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm )
105
106	#include "comconst.h"
107	#include "comvert.h"
108	#include "comgeom2.h"
109	#include "control.h"
110	include 'mpif.h'
111
112	c Arguments :
113	c -----------
114	LOGICAL lafin
115	REAL heure
116
117	REAL pvcov(iip1,jjm,llm)
118	REAL pucov(iip1,jjp1,llm)
119	REAL pteta(iip1,jjp1,llm)
120	REAL pmasse(iip1,jjp1,llm)
121	REAL pq(iip1,jjp1,llm,nqmx)
122	REAL pphis(iip1,jjp1)
123	REAL pphi(iip1,jjp1,llm)
124	c
125	REAL pdvcov(iip1,jjm,llm)
126	REAL pducov(iip1,jjp1,llm)
127	REAL pdteta(iip1,jjp1,llm)
128	REAL pdq(iip1,jjp1,llm,nqmx)
129	c
130	REAL pw(iip1,jjp1,llm)
131
132	REAL pps(iip1,jjp1)
133	REAL pp(iip1,jjp1,llmp1)
134	REAL ppk(iip1,jjp1,llm)
135	c
136	REAL pdvfi(iip1,jjm,llm)
137	REAL pdufi(iip1,jjp1,llm)
138	REAL pdhfi(iip1,jjp1,llm)
139	REAL pdqfi(iip1,jjp1,llm,nqmx)
140	REAL pdpsfi(iip1,jjp1)
141
142	INTEGER longcles
143	PARAMETER ( longcles = 20 )
144	REAL clesphy0( longcles )
145
146
147	c Local variables :
148	c -----------------
149
150	INTEGER i,j,l,ig0,ig,iq,iiq
151	REAL,ALLOCATABLE,SAVE :: zpsrf(:)
152	REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:)
153	REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:)
154	c
155	REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:)
156	REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:)
157	c
158	REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:)
159	REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
160	c
161	REAL,ALLOCATABLE,SAVE :: pvervel(:,:)
162	c
163	REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
164	REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
165	REAL,ALLOCATABLE,SAVE :: zdpsrf(:)
166	c
167	REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:)
168	REAL,ALLOCATABLE,SAVE :: zplay_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 :: ztfi_omp(:,:)
175	REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:)
176	REAL,ALLOCATABLE,SAVE :: pvervel_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
183	c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
184	c$OMP+ presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
185	c$OMP+ zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp,
186	c$OMP+ zdtfi_omp,zdqfi_omp,zdpsrf_omp)
187
188	LOGICAL,SAVE :: first_omp=.true.
189	c$OMP THREADPRIVATE(first_omp)
190
191	REAL zsin(iim),zcos(iim),z1(iim)
192	REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
193	REAL unskap, pksurcp
194	c
195	cIM diagnostique PVteta, Amip2
196	INTEGER ntetaSTD
197	PARAMETER(ntetaSTD=3)
198	REAL rtetaSTD(ntetaSTD)
199	DATA rtetaSTD/350., 380., 405./
200	REAL PVteta(klon,ntetaSTD)
201
202	#ifdef INCA
203	REAL flxw(iip1,jjp1,llm)
204	REAL flxwfi(klon,llm)
205	#endif
206	c
207
208	REAL SSUM
209
210	LOGICAL firstcal, debut
211	DATA firstcal/.true./
212	SAVE firstcal,debut
213	c$OMP THREADPRIVATE(firstcal,debut)
214	REAL rdayvrai
215
216	REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
217	INTEGER :: ierr
218	INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status
219	INTEGER, dimension(4) :: Req
220	REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
221	integer :: k,kstart,kend
222	INTEGER :: offset
223	c
224	c-----------------------------------------------------------------------
225	c
226	c 1. Initialisations :
227	c --------------------
228	c
229
230	klon=klon_mpi
231
232	PVteta(:,:)=0.
233
234	IF (ngridmx.NE.2+(jjm-1)*iim) THEN
235	PRINT*,'STOP dans calfis'
236	PRINT,'La dimension ngridmx doit etre egale a 2 + (jjm-1)iim'
237	PRINT*,' ngridmx jjm iim '
238	PRINT*,ngridmx,jjm,iim
239	STOP
240	ENDIF
241
242	c-----------------------------------------------------------------------
243	c latitude, longitude et aires des mailles pour la physique:
244	c ----------------------------------------------------------
245
246	c
247	IF ( firstcal ) THEN
248	debut = .TRUE.
249	c$OMP MASTER
250	ALLOCATE(zpsrf(klon))
251	ALLOCATE(zplev(klon,llm+1),zplay(klon,llm))
252	ALLOCATE(zphi(klon,llm),zphis(klon))
253	ALLOCATE(zufi(klon,llm), zvfi(klon,llm))
254	ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqmx))
255	ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
256	ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
257	ALLOCATE(pvervel(klon,llm))
258	ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
259	ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqmx))
260	ALLOCATE(zdpsrf(klon))
261	ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
262	c$OMP END MASTER
263	c$OMP BARRIER
264	ELSE
265	debut = .FALSE.
266	ENDIF
267
268	c
269	c
270	c-----------------------------------------------------------------------
271	c 40. transformation des variables dynamiques en variables physiques:
272	c ---------------------------------------------------------------
273
274	c 41. pressions au sol (en Pascals)
275	c ----------------------------------
276
277	c$OMP MASTER
278	call start_timer(timer_physic)
279	c$OMP END MASTER
280
281	c$OMP MASTER
282	do ig0=1,klon
283	i=Liste_i(ig0)
284	j=Liste_j(ig0)
285	zpsrf(ig0)=pps(i,j)
286	enddo
287	c$OMP END MASTER
288
289
290	c 42. pression intercouches :
291	c
292	c -----------------------------------------------------------------
293	c .... zplev definis aux (llm +1) interfaces des couches ....
294	c .... zplay definis aux ( llm ) milieux des couches ....
295	c -----------------------------------------------------------------
296
297	c ... Exner = cp * ( p(l) / preff ) ** kappa ....
298	c
299	unskap = 1./ kappa
300	c
301	print *,omp_rank,'klon--->',klon
302	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
303	DO l = 1, llmp1
304	do ig0=1,klon
305	i=Liste_i(ig0)
306	j=Liste_j(ig0)
307	zplev( ig0,l ) = pp(i,j,l)
308	enddo
309	ENDDO
310	c$OMP END DO NOWAIT
311	c
312	c
313
314	c 43. temperature naturelle (en K) et pressions milieux couches .
315	c ---------------------------------------------------------------
316	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
317	DO l=1,llm
318
319	do ig0=1,klon
320	i=Liste_i(ig0)
321	j=Liste_j(ig0)
322	pksurcp = ppk(i,j,l) / cpp
323	zplay(ig0,l) = preff * pksurcp ** unskap
324	ztfi(ig0,l) = pteta(i,j,l) * pksurcp
325	c pcvgt(ig0,l) = pdteta(i,j,l) * pksurcp / pmasse(i,j,l)
326	enddo
327
328	ENDDO
329	c$OMP END DO NOWAIT
330
331	c 43.bis traceurs
332	c ---------------
333	c
334
335	DO iq=1,nq
336	iiq=niadv(iq)
337	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
338	DO l=1,llm
339	do ig0=1,klon
340	i=Liste_i(ig0)
341	j=Liste_j(ig0)
342	zqfi(ig0,l,iq) = pq(i,j,l,iiq)
343	enddo
344	ENDDO
345	c$OMP END DO NOWAIT
346	ENDDO
347
348	c convergence dynamique pour les traceurs "EAU"
349
350	DO iq=1,2
351	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
352	DO l=1,llm
353	do ig0=1,klon
354	i=Liste_i(ig0)
355	j=Liste_j(ig0)
356	c pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)
357	enddo
358	ENDDO
359	c$OMP END DO NOWAIT
360	ENDDO
361
362
363
364	c Geopotentiel calcule par rapport a la surface locale:
365	c -----------------------------------------------------
366
367	CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi)
368
369	c$OMP MASTER
370	CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis)
371	c$OMP END MASTER
372	c$OMP BARRIER
373
374	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
375	DO l=1,llm
376	DO ig=1,klon
377	zphi(ig,l)=zphi(ig,l)-zphis(ig)
378	ENDDO
379	ENDDO
380	c$OMP END DO NOWAIT
381	c .... Calcul de la vitesse verticale ( en Pams ou Kg/s ) ....
382	c
383	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
384	DO l=1,llm
385	do ig0=1,klon
386	i=Liste_i(ig0)
387	j=Liste_j(ig0)
388	pvervel(ig0,l) = pw(i,j,l)g unsaire(i,j)
389	enddo
390	if (pole_nord) pvervel(1,l)=pw(1,1,l)*g /apoln
391	if (pole_sud) pvervel(klon,l)=pw(1,jjp1,l)*g/apols
392	ENDDO
393	c$OMP END DO NOWAIT
394
395	c
396	c 45. champ u:
397	c ------------
398
399	kstart=1
400	kend=klon
401
402	if (pole_nord) kstart=2
403	if (pole_sud) kend=klon-1
404
405	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
406	DO l=1,llm
407	do ig0=kstart,kend
408	i=Liste_i(ig0)
409	j=Liste_j(ig0)
410	if (i==1) then
411	zufi(ig0,l)= 0.5 *( pucov(iim,j,l)/cu(iim,j)
412	$ + pucov(1,j,l)/cu(1,j) )
413	c pcvgu(ig0,l)= 0.5*( pducov(iim,j,l)/cu(iim,j)
414	c $ + pducov(1,j,l)/cu(1,j) )
415	else
416	zufi(ig0,l)= 0.5*( pucov(i-1,j,l)/cu(i-1,j)
417	$ + pucov(i,j,l)/cu(i,j) )
418	c pcvgu(ig0,l)= 0.5*( pducov(i-1,j,l)/cu(i-1,j)
419	c $ + pducov(i,j,l)/cu(i,j) )
420	endif
421	enddo
422	ENDDO
423	c$OMP END DO NOWAIT
424	c 46.champ v:
425	c -----------
426	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
427	DO l=1,llm
428	DO ig0=kstart,kend
429	i=Liste_i(ig0)
430	j=Liste_j(ig0)
431	zvfi(ig0,l)= 0.5 *( pvcov(i,j-1,l)/cv(i,j-1)
432	$ + pvcov(i,j,l)/cv(i,j) )
433
434	c pcvgv(ig0+i,l)= 0.5 * ( pdvcov(i,j-1,l)/cv(i,j-1)
435	c $ + pdvcov(i,j,l)/cv(i,j) )
436	ENDDO
437	ENDDO
438	c$OMP END DO NOWAIT
439
440	c 47. champs de vents aux pole nord
441	c ------------------------------
442	c U = 1 / pi * integrale [ v * cos(long) * d long ]
443	c V = 1 / pi * integrale [ v * sin(long) * d long ]
444
445	if (pole_nord) then
446	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
447	DO l=1,llm
448
449	z1(1) =(rlonu(1)-rlonu(iim)+2.pi)pvcov(1,1,l)/cv(1,1)
450	c z1bis(1)=(rlonu(1)-rlonu(iim)+2.pi)pdvcov(1,1,l)/cv(1,1)
451	DO i=2,iim
452	z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
453	c z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
454	ENDDO
455
456	DO i=1,iim
457	zcos(i) = COS(rlonv(i))*z1(i)
458	c zcosbis(i)= COS(rlonv(i))*z1bis(i)
459	zsin(i) = SIN(rlonv(i))*z1(i)
460	c zsinbis(i)= SIN(rlonv(i))*z1bis(i)
461	ENDDO
462
463	zufi(1,l) = SSUM(iim,zcos,1)/pi
464	c pcvgu(1,l) = SSUM(iim,zcosbis,1)/pi
465	zvfi(1,l) = SSUM(iim,zsin,1)/pi
466	c pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi
467
468	ENDDO
469	c$OMP END DO NOWAIT
470	endif
471
472
473	c 48. champs de vents aux pole sud:
474	c ---------------------------------
475	c U = 1 / pi * integrale [ v * cos(long) * d long ]
476	c V = 1 / pi * integrale [ v * sin(long) * d long ]
477
478	if (pole_sud) then
479	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
480	DO l=1,llm
481
482	z1(1) =(rlonu(1)-rlonu(iim)+2.pi)pvcov(1,jjm,l)/cv(1,jjm)
483	c z1bis(1)=(rlonu(1)-rlonu(iim)+2.pi)pdvcov(1,jjm,l)/cv(1,jjm)
484	DO i=2,iim
485	z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
486	c z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
487	ENDDO
488
489	DO i=1,iim
490	zcos(i) = COS(rlonv(i))*z1(i)
491	c zcosbis(i) = COS(rlonv(i))*z1bis(i)
492	zsin(i) = SIN(rlonv(i))*z1(i)
493	c zsinbis(i) = SIN(rlonv(i))*z1bis(i)
494	ENDDO
495
496	zufi(klon,l) = SSUM(iim,zcos,1)/pi
497	c pcvgu(klon,l) = SSUM(iim,zcosbis,1)/pi
498	zvfi(klon,l) = SSUM(iim,zsin,1)/pi
499	c pcvgv(klon,l) = SSUM(iim,zsinbis,1)/pi
500
501	ENDDO
502	c$OMP END DO NOWAIT
503	endif
504
505
506	IF (monocpu) THEN
507	c
508	cIM calcul PV a teta=350, 380, 405K
509	CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
510	$ ztfi,zplay,zplev,
511	$ ntetaSTD,rtetaSTD,PVteta)
512	c
513	ENDIF
514	#ifdef INCA
515	CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi)
516	#endif
517
518
519	c-----------------------------------------------------------------------
520	c Appel de la physique:
521	c ---------------------
522
523	cc$OMP PARALLEL DEFAULT(NONE)
524	cc$OMP+ PRIVATE(i,l,offset,iq)
525	cc$OMP+ SHARED(klon_omp_nb,nq,klon_omp_begin,
526	cc$OMP+ debut,lafin,rdayvrai,heure,dtphys,zplev,zplay,
527	cc$OMP+ zphi,zphis,presnivs,clesphy0,zufi,zvfi,ztfi,
528	cc$OMP+ zqfi,pvervel,zdufi,zdvfi,zdtfi,zdqfi,zdpsrf)
529
530	c PRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
531	c c$OMP+ presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
532	c c$OMP+ zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp,
533	c c$OMP+ zdtfi_omp,zdqfi_omp,zdpsrf_omp)
534
535	c$OMP BARRIER
536	if (first_omp) then
537	klon=klon_omp_nb(omp_rank)
538
539	allocate(zplev_omp(klon,llm+1))
540	allocate(zplay_omp(klon,llm))
541	allocate(zphi_omp(klon,llm))
542	allocate(zphis_omp(klon))
543	allocate(presnivs_omp(llm))
544	allocate(zufi_omp(klon,llm))
545	allocate(zvfi_omp(klon,llm))
546	allocate(ztfi_omp(klon,llm))
547	allocate(zqfi_omp(klon,llm,nq))
548	allocate(pvervel_omp(klon,llm))
549	allocate(zdufi_omp(klon,llm))
550	allocate(zdvfi_omp(klon,llm))
551	allocate(zdtfi_omp(klon,llm))
552	allocate(zdqfi_omp(klon,llm,nq))
553	allocate(zdpsrf_omp(klon))
554	first_omp=.false.
555	endif
556
557
558	klon=klon_omp_nb(omp_rank)
559	offset=klon_omp_begin(omp_rank)-1
560
561	do l=1,llm+1
562	do i=1,klon
563	zplev_omp(i,l)=zplev(offset+i,l)
564	enddo
565	enddo
566
567	do l=1,llm
568	do i=1,klon
569	zplay_omp(i,l)=zplay(offset+i,l)
570	enddo
571	enddo
572
573	do l=1,llm
574	do i=1,klon
575	zphi_omp(i,l)=zphi(offset+i,l)
576	enddo
577	enddo
578
579
580	do i=1,klon
581	zphis_omp(i)=zphis(offset+i)
582	enddo
583
584
585	do l=1,llm
586	presnivs_omp(l)=presnivs(l)
587	enddo
588
589	do l=1,llm
590	do i=1,klon
591	zufi_omp(i,l)=zufi(offset+i,l)
592	enddo
593	enddo
594
595	do l=1,llm
596	do i=1,klon
597	zvfi_omp(i,l)=zvfi(offset+i,l)
598	enddo
599	enddo
600
601	do l=1,llm
602	do i=1,klon
603	ztfi_omp(i,l)=ztfi(offset+i,l)
604	enddo
605	enddo
606
607	do iq=1,nq
608	do l=1,llm
609	do i=1,klon
610	zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq)
611	enddo
612	enddo
613	enddo
614
615	do l=1,llm
616	do i=1,klon
617	pvervel_omp(i,l)=pvervel(offset+i,l)
618	enddo
619	enddo
620
621	do l=1,llm
622	do i=1,klon
623	zdufi_omp(i,l)=zdufi(offset+i,l)
624	enddo
625	enddo
626
627	do l=1,llm
628	do i=1,klon
629	zdvfi_omp(i,l)=zdvfi(offset+i,l)
630	enddo
631	enddo
632
633	do l=1,llm
634	do i=1,klon
635	zdtfi_omp(i,l)=zdtfi(offset+i,l)
636	enddo
637	enddo
638
639	do iq=1,nq
640	do l=1,llm
641	do i=1,klon
642	zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq)
643	enddo
644	enddo
645	enddo
646
647	do i=1,klon
648	zdpsrf_omp(i)=zdpsrf(offset+i)
649	enddo
650
651	c$OMP BARRIER
652	cym call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm)
653
654	CALL physiq (klon,
655	. llm,
656	. nq,
657	. debut,
658	. lafin,
659	. rdayvrai,
660	. heure,
661	. dtphys,
662	. zplev_omp,
663	. zplay_omp,
664	. zphi_omp,
665	. zphis_omp,
666	. presnivs_omp,
667	. clesphy0,
668	. zufi_omp,
669	. zvfi_omp,
670	. ztfi_omp,
671	. zqfi_omp,
672	. pvervel_omp,
673	#ifdef INCA
674	. flxwfi,
675	#endif
676	. zdufi_omp,
677	. zdvfi_omp,
678	. zdtfi_omp,
679	. zdqfi_omp,
680	. zdpsrf_omp,
681	cIM diagnostique PVteta, Amip2
682	. pducov,
683	. PVteta)
684
685	cym call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm)
686
687	c$OMP BARRIER
688
689	do l=1,llm+1
690	do i=1,klon
691	zplev(offset+i,l)=zplev_omp(i,l)
692	enddo
693	enddo
694
695	do l=1,llm
696	do i=1,klon
697	zplay(offset+i,l)=zplay_omp(i,l)
698	enddo
699	enddo
700
701	do l=1,llm
702	do i=1,klon
703	zphi(offset+i,l)=zphi_omp(i,l)
704	enddo
705	enddo
706
707
708	do i=1,klon
709	zphis(offset+i)=zphis_omp(i)
710	enddo
711
712
713	do l=1,llm
714	presnivs(l)=presnivs_omp(l)
715	enddo
716
717	do l=1,llm
718	do i=1,klon
719	zufi(offset+i,l)=zufi_omp(i,l)
720	enddo
721	enddo
722
723	do l=1,llm
724	do i=1,klon
725	zvfi(offset+i,l)=zvfi_omp(i,l)
726	enddo
727	enddo
728
729	do l=1,llm
730	do i=1,klon
731	ztfi(offset+i,l)=ztfi_omp(i,l)
732	enddo
733	enddo
734
735	do iq=1,nq
736	do l=1,llm
737	do i=1,klon
738	zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq)
739	enddo
740	enddo
741	enddo
742
743	do l=1,llm
744	do i=1,klon
745	pvervel(offset+i,l)=pvervel_omp(i,l)
746	enddo
747	enddo
748
749	do l=1,llm
750	do i=1,klon
751	zdufi(offset+i,l)=zdufi_omp(i,l)
752	enddo
753	enddo
754
755	do l=1,llm
756	do i=1,klon
757	zdvfi(offset+i,l)=zdvfi_omp(i,l)
758	enddo
759	enddo
760
761	do l=1,llm
762	do i=1,klon
763	zdtfi(offset+i,l)=zdtfi_omp(i,l)
764	enddo
765	enddo
766
767	do iq=1,nq
768	do l=1,llm
769	do i=1,klon
770	zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq)
771	enddo
772	enddo
773	enddo
774
775	do i=1,klon
776	zdpsrf(offset+i)=zdpsrf_omp(i)
777	enddo
778
779
780	cc$OMP END PARALLEL
781	klon=klon_mpi
782	500 CONTINUE
783	c$OMP BARRIER
784
785	c$OMP MASTER
786	cym call WriteField_phy('zdtfi',zdtfi(:,:),llm)
787	call stop_timer(timer_physic)
788	c$OMP END MASTER
789
790	if (MPI_rank>0) then
791
792	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
793	DO l=1,llm
794	du_send(1:iim,l)=zdufi(1:iim,l)
795	dv_send(1:iim,l)=zdvfi(1:iim,l)
796	ENDDO
797	c$OMP END DO NOWAIT
798
799	c$OMP BARRIER
800	c$OMP MASTER
801	call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401,
802	& COMM_LMDZ,Req(1),ierr)
803	call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402,
804	& COMM_LMDZ,Req(2),ierr)
805	c$OMP END MASTER
806	c$OMP BARRIER
807
808	endif
809
810	if (MPI_rank<MPI_Size-1) then
811	c$OMP BARRIER
812	c$OMP MASTER
813	call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401,
814	& COMM_LMDZ,Req(3),ierr)
815	call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402,
816	& COMM_LMDZ,Req(4),ierr)
817	c$OMP END MASTER
818	c$OMP BARRIER
819	endif
820
821	c$OMP BARRIER
822	c$OMP MASTER
823	if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then
824	call MPI_WAITALL(4,Req(1),Status,ierr)
825	else if (MPI_rank>0) then
826	call MPI_WAITALL(2,Req(1),Status,ierr)
827	else if (MPI_rank <MPI_Size-1) then
828	call MPI_WAITALL(2,Req(3),Status,ierr)
829	endif
830	c$OMP END MASTER
831	c$OMP BARRIER
832
833	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
834	DO l=1,llm
835
836	zdufi2(1:klon,l)=zdufi(1:klon,l)
837	zdufi2(klon+1:klon+iim,l)=du_recv(1:iim,l)
838
839	zdvfi2(1:klon,l)=zdvfi(1:klon,l)
840	zdvfi2(klon+1:klon+iim,l)=dv_recv(1:iim,l)
841
842	pdhfi(:,jjphy_begin,l)=0
843	pdqfi(:,jjphy_begin,l,:)=0
844	pdufi(:,jjphy_begin,l)=0
845	pdvfi(:,jjphy_begin,l)=0
846
847	if (.not. pole_sud) then
848	pdhfi(:,jjphy_end,l)=0
849	pdqfi(:,jjphy_end,l,:)=0
850	pdufi(:,jjphy_end,l)=0
851	pdvfi(:,jjphy_end,l)=0
852	endif
853
854	ENDDO
855	c$OMP END DO NOWAIT
856
857	c$OMP MASTER
858	pdpsfi(:,jjphy_begin)=0
859	if (.not. pole_sud) then
860	pdpsfi(:,jjphy_end)=0
861	endif
862	c$OMP END MASTER
863	c-----------------------------------------------------------------------
864	c transformation des tendances physiques en tendances dynamiques:
865	c ---------------------------------------------------------------
866
867	c tendance sur la pression :
868	c -----------------------------------
869	c$OMP MASTER
870	CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi)
871	c$OMP END MASTER
872	c
873	c 62. enthalpie potentielle
874	c ---------------------
875
876	kstart=1
877	kend=klon
878
879	if (pole_nord) kstart=2
880	if (pole_sud) kend=klon-1
881
882	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
883	DO l=1,llm
884
885	!!cdir NODEP
886	do ig0=kstart,kend
887	i=Liste_i(ig0)
888	j=Liste_j(ig0)
889	pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
890	if (i==1) pdhfi(iip1,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
891	enddo
892
893	if (pole_nord) then
894	DO i=1,iip1
895	pdhfi(i,1,l) = cpp * zdtfi(1,l) / ppk(i, 1 ,l)
896	enddo
897	endif
898
899	if (pole_sud) then
900	DO i=1,iip1
901	pdhfi(i,jjp1,l) = cpp * zdtfi(klon,l)/ ppk(i,jjp1,l)
902	ENDDO
903	endif
904	ENDDO
905	c$OMP END DO NOWAIT
906
907	c 62. humidite specifique
908	c ---------------------
909
910	DO iq=1,nqmx
911	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
912	DO l=1,llm
913	!!cdir NODEP
914	do ig0=kstart,kend
915	i=Liste_i(ig0)
916	j=Liste_j(ig0)
917	pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq)
918	if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq)
919	enddo
920
921	if (pole_nord) then
922	do i=1,iip1
923	pdqfi(i,1,l,iq) = zdqfi(1,l,iq)
924	enddo
925	endif
926
927	if (pole_sud) then
928	do i=1,iip1
929	pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq)
930	enddo
931	endif
932
933	ENDDO
934	c$OMP END DO NOWAIT
935	ENDDO
936
937	c 63. traceurs
938	c ------------
939	C initialisation des tendances
940
941	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
942	DO l=1,llm
943	pdqfi(:,:,l,:)=0.
944	ENDDO
945	c$OMP END DO NOWAIT
946
947	C
948
949	DO iq=1,nq
950	iiq=niadv(iq)
951	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
952	DO l=1,llm
953
954	!!cdir NODEP
955	DO ig0=kstart,kend
956	i=Liste_i(ig0)
957	j=Liste_j(ig0)
958	pdqfi(i,j,l,iiq) = zdqfi(ig0,l,iq)
959	if (i==1) pdqfi(iip1,j,l,iiq) = zdqfi(ig0,l,iq)
960	ENDDO
961
962	IF (pole_nord) then
963	DO i=1,iip1
964	pdqfi(i,1,l,iiq) = zdqfi(1,l,iq)
965	ENDDO
966	ENDIF
967
968	IF (pole_sud) then
969	DO i=1,iip1
970	pdqfi(i,jjp1,l,iiq) = zdqfi(klon,l,iq)
971	ENDDO
972	ENDIF
973
974	ENDDO
975	c$OMP END DO NOWAIT
976	ENDDO
977
978	c 65. champ u:
979	c ------------
980	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
981	DO l=1,llm
982	!!cdir NODEP
983	do ig0=kstart,kend
984	i=Liste_i(ig0)
985	j=Liste_j(ig0)
986
987	if (i/=iim) then
988	pdufi(i,j,l)=0.5(zdufi2(ig0,l)+zdufi2(ig0+1,l))cu(i,j)
989	endif
990
991	if (i==1) then
992	pdufi(iim,j,l)=0.5*( zdufi2(ig0,l)
993	$ + zdufi2(ig0+iim-1,l))*cu(iim,j)
994	pdufi(iip1,j,l)=0.5(zdufi2(ig0,l)+zdufi2(ig0+1,l))cu(i,j)
995	endif
996
997	enddo
998
999	if (Pole_nord) then
1000	DO i=1,iip1
1001	pdufi(i,1,l) = 0.
1002	ENDDO
1003	endif
1004
1005	if (Pole_sud) then
1006	DO i=1,iip1
1007	pdufi(i,jjp1,l) = 0.
1008	ENDDO
1009	endif
1010
1011	ENDDO
1012	c$OMP END DO NOWAIT
1013
1014	c 67. champ v:
1015	c ------------
1016
1017	kstart=1
1018	kend=klon
1019
1020	if (pole_nord) kstart=2
1021	if (pole_sud) kend=klon-1-iim
1022
1023	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1024	DO l=1,llm
1025	!!cdir NODEP
1026	do ig0=kstart,kend
1027	i=Liste_i(ig0)
1028	j=Liste_j(ig0)
1029	pdvfi(i,j,l)=0.5(zdvfi2(ig0,l)+zdvfi2(ig0+iim,l))cv(i,j)
1030	if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+
1031	$ zdvfi2(ig0+iim,l))
1032	$ *cv(i,j)
1033	enddo
1034
1035	ENDDO
1036	c$OMP END DO NOWAIT
1037
1038
1039	c 68. champ v pres des poles:
1040	c ---------------------------
1041	c v = U * cos(long) + V * SIN(long)
1042
1043	if (pole_nord) then
1044
1045	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1046	DO l=1,llm
1047
1048	DO i=1,iim
1049	pdvfi(i,1,l)=
1050	$ zdufi(1,l)COS(rlonv(i))+zdvfi(1,l)SIN(rlonv(i))
1051
1052	pdvfi(i,1,l)=
1053	$ 0.5(pdvfi(i,1,l)+zdvfi(i+1,l))cv(i,1)
1054	ENDDO
1055
1056	pdvfi(iip1,1,l) = pdvfi(1,1,l)
1057
1058	ENDDO
1059	c$OMP END DO NOWAIT
1060
1061	endif
1062
1063	if (pole_sud) then
1064
1065	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1066	DO l=1,llm
1067
1068	DO i=1,iim
1069	pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i))
1070	$ +zdvfi(klon,l)*SIN(rlonv(i))
1071
1072	pdvfi(i,jjm,l)=
1073	$ 0.5(pdvfi(i,jjm,l)+zdvfi(klon-iip1+i,l))cv(i,jjm)
1074	ENDDO
1075
1076	pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
1077
1078	ENDDO
1079	c$OMP END DO NOWAIT
1080
1081	endif
1082	c-----------------------------------------------------------------------
1083
1084	700 CONTINUE
1085
1086	firstcal = .FALSE.
1087
1088	RETURN
1089	END

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

Download in other formats:

Original Format