Context Navigation

calfis_loc.F @ 2049

Last change on this file since 2049 was 1999, checked in by Laurent Fairhead, 11 years ago
Merged trunk changes r1920:1997 into testing branch
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
File size: 31.9 KB

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

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

Download in other formats:

Original Format