Context Navigation

calfis_p.F @ 5071

Last change on this file since 5071 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

Rev	Line
[630]	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,
[709]	25	#ifdef INCA
[630]	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
[709]	42	USE IOPHY
[630]	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
[709]	151	REAL,ALLOCATABLE,SAVE :: zpsrf(:)
	152	REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:)
	153	REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:)
[630]	154	c
[709]	155	REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:)
	156	REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:)
[630]	157	c
[709]	158	REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:)
	159	REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
[630]	160	c
[709]	161	REAL,ALLOCATABLE,SAVE :: pvervel(:,:)
[630]	162	c
[709]	163	REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
	164	REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
	165	REAL,ALLOCATABLE,SAVE :: zdpsrf(:)
[630]	166	c
[709]	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
[630]	191	REAL zsin(iim),zcos(iim),z1(iim)
	192	REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
	193	REAL unskap, pksurcp
[709]	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
[630]	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
[709]	213	c$OMP THREADPRIVATE(firstcal,debut)
[630]	214	REAL rdayvrai
	215
[709]	216	REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
[630]	217	INTEGER :: ierr
	218	INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status
	219	INTEGER, dimension(4) :: Req
[709]	220	REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
	221	integer :: k,kstart,kend
	222	INTEGER :: offset
[630]	223	c
	224	c-----------------------------------------------------------------------
	225	c
	226	c 1. Initialisations :
	227	c --------------------
	228	c
	229
[709]	230	klon=klon_mpi
	231
	232	PVteta(:,:)=0.
	233
[630]	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.
[709]	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
[630]	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
[709]	277	c$OMP MASTER
[630]	278	call start_timer(timer_physic)
[709]	279	c$OMP END MASTER
	280
	281	c$OMP MASTER
[630]	282	do ig0=1,klon
	283	i=Liste_i(ig0)
	284	j=Liste_j(ig0)
	285	zpsrf(ig0)=pps(i,j)
	286	enddo
[709]	287	c$OMP END MASTER
[630]	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
[709]	301	print *,omp_rank,'klon--->',klon
	302	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	310	c$OMP END DO NOWAIT
[630]	311	c
	312	c
	313
	314	c 43. temperature naturelle (en K) et pressions milieux couches .
	315	c ---------------------------------------------------------------
[709]	316	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	329	c$OMP END DO NOWAIT
[630]	330
	331	c 43.bis traceurs
	332	c ---------------
	333	c
	334
	335	DO iq=1,nq
	336	iiq=niadv(iq)
[709]	337	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	345	c$OMP END DO NOWAIT
[630]	346	ENDDO
	347
	348	c convergence dynamique pour les traceurs "EAU"
	349
	350	DO iq=1,2
[709]	351	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	359	c$OMP END DO NOWAIT
[630]	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)
[709]	368
	369	c$OMP MASTER
[630]	370	CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis)
[709]	371	c$OMP END MASTER
	372	c$OMP BARRIER
[630]	373
[709]	374	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	375	DO l=1,llm
	376	DO ig=1,klon
	377	zphi(ig,l)=zphi(ig,l)-zphis(ig)
	378	ENDDO
	379	ENDDO
[709]	380	c$OMP END DO NOWAIT
[630]	381	c .... Calcul de la vitesse verticale ( en Pams ou Kg/s ) ....
	382	c
[709]	383	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	393	c$OMP END DO NOWAIT
[630]	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
[709]	405	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	423	c$OMP END DO NOWAIT
[630]	424	c 46.champ v:
	425	c -----------
[709]	426	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	438	c$OMP END DO NOWAIT
[630]	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
[709]	446	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	469	c$OMP END DO NOWAIT
[630]	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
[709]	479	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	502	c$OMP END DO NOWAIT
[630]	503	endif
	504
	505
[709]	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
[630]	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
[709]	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)
[630]	529
[709]	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
[630]	654	CALL physiq (klon,
	655	. llm,
	656	. nq,
	657	. debut,
	658	. lafin,
	659	. rdayvrai,
	660	. heure,
	661	. dtphys,
[709]	662	. zplev_omp,
	663	. zplay_omp,
	664	. zphi_omp,
	665	. zphis_omp,
	666	. presnivs_omp,
[630]	667	. clesphy0,
[709]	668	. zufi_omp,
	669	. zvfi_omp,
	670	. ztfi_omp,
	671	. zqfi_omp,
	672	. pvervel_omp,
	673	#ifdef INCA
[630]	674	. flxwfi,
	675	#endif
[709]	676	. zdufi_omp,
	677	. zdvfi_omp,
	678	. zdtfi_omp,
	679	. zdqfi_omp,
	680	. zdpsrf_omp,
	681	cIM diagnostique PVteta, Amip2
	682	. pducov,
	683	. PVteta)
[630]	684
[709]	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
[630]	782	500 CONTINUE
[709]	783	c$OMP BARRIER
[630]	784
[709]	785	c$OMP MASTER
	786	cym call WriteField_phy('zdtfi',zdtfi(:,:),llm)
[630]	787	call stop_timer(timer_physic)
[709]	788	c$OMP END MASTER
[630]	789
	790	if (MPI_rank>0) then
[709]	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
[630]	801	call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401,
[709]	802	& COMM_LMDZ,Req(1),ierr)
[630]	803	call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402,
[709]	804	& COMM_LMDZ,Req(2),ierr)
	805	c$OMP END MASTER
	806	c$OMP BARRIER
[630]	807
	808	endif
	809
	810	if (MPI_rank<MPI_Size-1) then
[709]	811	c$OMP BARRIER
	812	c$OMP MASTER
[630]	813	call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401,
[709]	814	& COMM_LMDZ,Req(3),ierr)
[630]	815	call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402,
[709]	816	& COMM_LMDZ,Req(4),ierr)
	817	c$OMP END MASTER
	818	c$OMP BARRIER
[630]	819	endif
[709]	820
	821	c$OMP BARRIER
	822	c$OMP MASTER
[630]	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
[709]	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
[630]	853
[709]	854	ENDDO
	855	c$OMP END DO NOWAIT
[630]	856
[709]	857	c$OMP MASTER
	858	pdpsfi(:,jjphy_begin)=0
[630]	859	if (.not. pole_sud) then
	860	pdpsfi(:,jjphy_end)=0
	861	endif
[709]	862	c$OMP END MASTER
[630]	863	c-----------------------------------------------------------------------
	864	c transformation des tendances physiques en tendances dynamiques:
	865	c ---------------------------------------------------------------
	866
	867	c tendance sur la pression :
	868	c -----------------------------------
[709]	869	c$OMP MASTER
[630]	870	CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi)
[709]	871	c$OMP END MASTER
[630]	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
[709]	882	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	883	DO l=1,llm
	884
[709]	885	!!cdir NODEP
[630]	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
[709]	905	c$OMP END DO NOWAIT
[630]	906
	907	c 62. humidite specifique
	908	c ---------------------
	909
	910	DO iq=1,nqmx
[709]	911	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	912	DO l=1,llm
[709]	913	!!cdir NODEP
[630]	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
[709]	934	c$OMP END DO NOWAIT
[630]	935	ENDDO
	936
	937	c 63. traceurs
	938	c ------------
	939	C initialisation des tendances
[709]	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
[630]	947	C
	948
	949	DO iq=1,nq
	950	iiq=niadv(iq)
[709]	951	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	952	DO l=1,llm
	953
[709]	954	!!cdir NODEP
[630]	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
[709]	975	c$OMP END DO NOWAIT
[630]	976	ENDDO
	977
	978	c 65. champ u:
	979	c ------------
[709]	980	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	981	DO l=1,llm
[709]	982	!!cdir NODEP
[630]	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)
[709]	994	pdufi(iip1,j,l)=0.5(zdufi2(ig0,l)+zdufi2(ig0+1,l))cu(i,j)
[630]	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
[709]	1012	c$OMP END DO NOWAIT
[630]	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
[709]	1023	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	1024	DO l=1,llm
[709]	1025	!!cdir NODEP
[630]	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
[709]	1036	c$OMP END DO NOWAIT
[630]	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
[709]	1044
	1045	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[630]	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
[709]	1059	c$OMP END DO NOWAIT
[630]	1060
	1061	endif
	1062
	1063	if (pole_sud) then
[709]	1064
	1065	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
	1066	DO l=1,llm
[630]	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
[709]	1079	c$OMP END DO NOWAIT
[630]	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