Context Navigation

calfis_p.F @ 1279

Last change on this file since 1279 was 1279, checked in by Laurent Fairhead, 14 years ago
Merged LMDZ4-dev branch changes r1241:1278 into the trunk Running trunk and LMDZ4-dev in LMDZOR configuration on local machine (sequential) and SX8 (4-proc) yields identical results (restart and restartphy are identical binarily) Log history from r1241 to r1278 is available by switching to source:LMDZ4/branches/LMDZ4-dev-20091210
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 25.6 KB

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

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

Download in other formats:

Original Format