Context Navigation

calfis.F @ 3547

Last change on this file since 3547 was 2641, checked in by Laurent Fairhead, 8 years ago
Merged trunk changes r2593:2640 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 Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 21.8 KB

Rev	Line
[524]	1	!
[1279]	2	! $Id: calfis.F 2641 2016-09-29 21:26:46Z jbmadeleine $
[524]	3	!
	4	C
	5	C
[1146]	6	SUBROUTINE calfis(lafin,
[1279]	7	$ jD_cur, jH_cur,
[524]	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	$ pdufi,
	24	$ pdvfi,
	25	$ pdhfi,
	26	$ pdqfi,
	27	$ pdpsfi)
	28	c
	29	c Auteur : P. Le Van, F. Hourdin
	30	c .........
[1987]	31	USE infotrac, ONLY: nqtot, niadv, tname
	32	USE control_mod, ONLY: planet_type, nsplit_phys
[2418]	33	#ifdef CPP_PHYS
	34	USE callphysiq_mod, ONLY: call_physiq
	35	#endif
[2641]	36	USE comconst_mod, ONLY: cpp, daysec, dtphys, dtvr, kappa, pi
	37	USE comvert_mod, ONLY: preff, presnivs
	38
[524]	39	IMPLICIT NONE
	40	c=======================================================================
	41	c
	42	c 1. rearrangement des tableaux et transformation
	43	c variables dynamiques > variables physiques
	44	c 2. calcul des termes physiques
	45	c 3. retransformation des tendances physiques en tendances dynamiques
	46	c
	47	c remarques:
	48	c ----------
	49	c
	50	c - les vents sont donnes dans la physique par leurs composantes
	51	c naturelles.
	52	c - la variable thermodynamique de la physique est une variable
	53	c intensive : T
	54	c pour la dynamique on prend T * ( preff / p(l) ) **kappa
	55	c - les deux seules variables dependant de la geometrie necessaires
	56	c pour la physique sont la latitude pour le rayonnement et
	57	c l'aire de la maille quand on veut integrer une grandeur
	58	c horizontalement.
	59	c - les points de la physique sont les points scalaires de la
	60	c la dynamique; numerotation:
	61	c 1 pour le pole nord
	62	c (jjm-1)*iim pour l'interieur du domaine
	63	c ngridmx pour le pole sud
	64	c ---> ngridmx=2+(jjm-1)*iim
	65	c
	66	c Input :
	67	c -------
	68	c pucov covariant zonal velocity
	69	c pvcov covariant meridional velocity
	70	c pteta potential temperature
	71	c pps surface pressure
	72	c pmasse masse d'air dans chaque maille
	73	c pts surface temperature (K)
	74	c callrad clef d'appel au rayonnement
	75	c
	76	c Output :
	77	c --------
	78	c pdufi tendency for the natural zonal velocity (ms-1)
	79	c pdvfi tendency for the natural meridional velocity
	80	c pdhfi tendency for the potential temperature
	81	c pdtsfi tendency for the surface temperature
	82	c
	83	c pdtrad radiative tendencies \ both input
	84	c pfluxrad radiative fluxes / and output
	85	c
	86	c=======================================================================
	87	c
	88	c-----------------------------------------------------------------------
	89	c
	90	c 0. Declarations :
	91	c ------------------
	92
[2641]	93	include "dimensions.h"
	94	include "paramet.h"
[524]	95
[1146]	96	INTEGER ngridmx
[524]	97	PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm )
	98
[2641]	99	include "comgeom2.h"
	100	include "iniprint.h"
[524]	101
	102	c Arguments :
	103	c -----------
[1987]	104	LOGICAL,INTENT(IN) :: lafin ! .true. for the very last call to physics
	105	REAL,INTENT(IN):: jD_cur, jH_cur
	106	REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity
	107	REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity
	108	REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature
	109	REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used
	110	REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers
	111	REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential
	112	REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential
[524]	113
[1987]	114	REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov
	115	REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov
	116	REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta
	117	! NB: pdteta is used only to compute pcvgt which is in fact not used...
	118	REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers
	119	! NB: pdq is only used to compute pcvgq which is in fact not used...
[1279]	120
[1987]	121	REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa)
	122	REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
	123	REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
[2418]	124	REAL,INTENT(IN) :: flxw(iip1,jjp1,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
[524]	125
[1987]	126	! tendencies (in */s) from the physics
	127	REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind
	128	REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind
	129	REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s)
	130	REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
	131	REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
[524]	132
	133
	134	c Local variables :
	135	c -----------------
	136
	137	INTEGER i,j,l,ig0,ig,iq,iiq
	138	REAL zpsrf(ngridmx)
	139	REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
	140	REAL zphi(ngridmx,llm),zphis(ngridmx)
	141	c
[2333]	142	REAL zrot(iip1,jjm,llm) ! AdlC May 2014
[2641]	143	REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
	144	REAL zrfi(ngridmx,llm) ! relative wind vorticity
[1146]	145	REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot)
[2641]	146	REAL zpk(ngridmx,llm)
[524]	147	c
	148	REAL pcvgu(ngridmx,llm), pcvgv(ngridmx,llm)
	149	REAL pcvgt(ngridmx,llm), pcvgq(ngridmx,llm,2)
	150	c
	151	REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
[1146]	152	REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqtot)
[524]	153	REAL zdpsrf(ngridmx)
	154	c
[1403]	155	REAL zdufic(ngridmx,llm),zdvfic(ngridmx,llm)
	156	REAL zdtfic(ngridmx,llm),zdqfic(ngridmx,llm,nqtot)
	157	REAL jH_cur_split,zdt_split
	158	LOGICAL debut_split,lafin_split
	159	INTEGER isplit
	160
[524]	161	REAL zsin(iim),zcos(iim),z1(iim)
	162	REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
	163	REAL unskap, pksurcp
[644]	164	c
[960]	165	REAL flxwfi(ngridmx,llm) ! Flux de masse verticale sur la grille physiq
[524]	166	c
	167
	168	REAL SSUM
	169
[1987]	170	LOGICAL,SAVE :: firstcal=.true., debut=.true.
[1279]	171	! REAL rdayvrai
[1654]	172
[524]	173	c
	174	c-----------------------------------------------------------------------
	175	c
	176	c 1. Initialisations :
	177	c --------------------
	178	c
[1279]	179	c
	180	IF ( firstcal ) THEN
	181	debut = .TRUE.
	182	IF (ngridmx.NE.2+(jjm-1)*iim) THEN
[1403]	183	write(lunout,*) 'STOP dans calfis'
	184	write(lunout,*)
	185	& 'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
	186	write(lunout,*) ' ngridmx jjm iim '
	187	write(lunout,*) ngridmx,jjm,iim
[524]	188	STOP
[1279]	189	ENDIF
[524]	190	ELSE
[1279]	191	debut = .FALSE.
	192	ENDIF ! of IF (firstcal)
[524]	193
	194	c
	195	c
	196	c-----------------------------------------------------------------------
	197	c 40. transformation des variables dynamiques en variables physiques:
	198	c ---------------------------------------------------------------
	199
	200	c 41. pressions au sol (en Pascals)
	201	c ----------------------------------
	202
	203
	204	zpsrf(1) = pps(1,1)
	205
	206	ig0 = 2
	207	DO j = 2,jjm
	208	CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
	209	ig0 = ig0+iim
	210	ENDDO
	211
	212	zpsrf(ngridmx) = pps(1,jjp1)
	213
	214
[2641]	215	c 42. pression intercouches et fonction d'Exner:
[524]	216	c
	217	c -----------------------------------------------------------------
	218	c .... zplev definis aux (llm +1) interfaces des couches ....
	219	c .... zplay definis aux ( llm ) milieux des couches ....
	220	c -----------------------------------------------------------------
	221
	222	c ... Exner = cp * ( p(l) / preff ) ** kappa ....
	223	c
	224	unskap = 1./ kappa
	225	c
[2641]	226	DO l = 1, llm
	227	zpk( 1,l ) = ppk(1,1,l)
[524]	228	zplev( 1,l ) = pp(1,1,l)
	229	ig0 = 2
	230	DO j = 2, jjm
	231	DO i =1, iim
[2641]	232	zpk( ig0,l ) = ppk(i,j,l)
[524]	233	zplev( ig0,l ) = pp(i,j,l)
	234	ig0 = ig0 +1
	235	ENDDO
	236	ENDDO
[2641]	237	zpk( ngridmx,l ) = ppk(1,jjp1,l)
[524]	238	zplev( ngridmx,l ) = pp(1,jjp1,l)
	239	ENDDO
[2641]	240	zplev( 1,llmp1 ) = pp(1,1,llmp1)
	241	ig0 = 2
	242	DO j = 2, jjm
	243	DO i =1, iim
	244	zplev( ig0,llmp1 ) = pp(i,j,llmp1)
	245	ig0 = ig0 +1
	246	ENDDO
	247	ENDDO
	248	zplev( ngridmx,llmp1 ) = pp(1,jjp1,llmp1)
[524]	249	c
	250	c
	251
	252	c 43. temperature naturelle (en K) et pressions milieux couches .
	253	c ---------------------------------------------------------------
	254
	255	DO l=1,llm
	256
	257	pksurcp = ppk(1,1,l) / cpp
	258	zplay(1,l) = preff * pksurcp ** unskap
	259	ztfi(1,l) = pteta(1,1,l) * pksurcp
	260	pcvgt(1,l) = pdteta(1,1,l) * pksurcp / pmasse(1,1,l)
	261	ig0 = 2
	262
	263	DO j = 2, jjm
	264	DO i = 1, iim
	265	pksurcp = ppk(i,j,l) / cpp
	266	zplay(ig0,l) = preff * pksurcp ** unskap
	267	ztfi(ig0,l) = pteta(i,j,l) * pksurcp
	268	pcvgt(ig0,l) = pdteta(i,j,l) * pksurcp / pmasse(i,j,l)
	269	ig0 = ig0 + 1
	270	ENDDO
	271	ENDDO
	272
	273	pksurcp = ppk(1,jjp1,l) / cpp
	274	zplay(ig0,l) = preff * pksurcp ** unskap
	275	ztfi (ig0,l) = pteta(1,jjp1,l) * pksurcp
	276	pcvgt(ig0,l) = pdteta(1,jjp1,l) * pksurcp/ pmasse(1,jjp1,l)
	277
	278	ENDDO
	279
	280	c 43.bis traceurs
	281	c ---------------
	282	c
[1146]	283	DO iq=1,nqtot
[524]	284	iiq=niadv(iq)
	285	DO l=1,llm
	286	zqfi(1,l,iq) = pq(1,1,l,iiq)
	287	ig0 = 2
	288	DO j=2,jjm
	289	DO i = 1, iim
	290	zqfi(ig0,l,iq) = pq(i,j,l,iiq)
	291	ig0 = ig0 + 1
	292	ENDDO
	293	ENDDO
	294	zqfi(ig0,l,iq) = pq(1,jjp1,l,iiq)
	295	ENDDO
	296	ENDDO
	297
	298	c convergence dynamique pour les traceurs "EAU"
[1279]	299	! Earth-specific treatment of first 2 tracers (water)
	300	if (planet_type=="earth") then
	301	DO iq=1,2
[524]	302	DO l=1,llm
	303	pcvgq(1,l,iq)= pdq(1,1,l,iq) / pmasse(1,1,l)
	304	ig0 = 2
	305	DO j=2,jjm
	306	DO i = 1, iim
	307	pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)
	308	ig0 = ig0 + 1
	309	ENDDO
	310	ENDDO
	311	pcvgq(ig0,l,iq)= pdq(1,jjp1,l,iq) / pmasse(1,jjp1,l)
	312	ENDDO
[1279]	313	ENDDO
	314	endif ! of if (planet_type=="earth")
[524]	315
	316
	317	c Geopotentiel calcule par rapport a la surface locale:
	318	c -----------------------------------------------------
	319
	320	CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
	321	CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
	322	DO l=1,llm
[1403]	323	DO ig=1,ngridmx
	324	zphi(ig,l)=zphi(ig,l)-zphis(ig)
	325	ENDDO
[524]	326	ENDDO
	327
	328	c .... Calcul de la vitesse verticale ( en Pams ou Kg/s ) ....
[960]	329	c JG : ancien calcule de omega utilise dans physiq.F. Maintenant le flux
	330	c de masse est calclue dans advtrac.F
	331	c DO l=1,llm
	332	c pvervel(1,l)=pw(1,1,l) * g /apoln
	333	c ig0=2
	334	c DO j=2,jjm
	335	c DO i = 1, iim
	336	c pvervel(ig0,l) = pw(i,j,l) * g * unsaire(i,j)
	337	c ig0 = ig0 + 1
	338	c ENDDO
	339	c ENDDO
	340	c pvervel(ig0,l)=pw(1,jjp1,l) * g /apols
	341	c ENDDO
[524]	342
	343	c
	344	c 45. champ u:
	345	c ------------
	346
	347	DO 50 l=1,llm
	348
	349	DO 25 j=2,jjm
	350	ig0 = 1+(j-2)*iim
	351	zufi(ig0+1,l)= 0.5 *
	352	$ ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
	353	pcvgu(ig0+1,l)= 0.5 *
	354	$ ( pducov(iim,j,l)/cu(iim,j) + pducov(1,j,l)/cu(1,j) )
	355	DO 10 i=2,iim
	356	zufi(ig0+i,l)= 0.5 *
	357	$ ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
	358	pcvgu(ig0+i,l)= 0.5 *
	359	$ ( pducov(i-1,j,l)/cu(i-1,j) + pducov(i,j,l)/cu(i,j) )
	360	10 CONTINUE
	361	25 CONTINUE
	362
	363	50 CONTINUE
	364
	365
[2333]	366	C Alvaro de la Camara (May 2014)
	367	C 46.1 Calcul de la vorticite et passage sur la grille physique
	368	C --------------------------------------------------------------
	369	DO l=1,llm
	370	do i=1,iim
	371	do j=1,jjm
	372	zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l)
	373	$ + pucov(i,j+1,l) - pucov(i,j,l))
	374	$ / (cu(i,j)+cu(i,j+1))
	375	$ / (cv(i+1,j)+cv(i,j)) *4
	376	enddo
	377	enddo
	378	ENDDO
	379
[524]	380	c 46.champ v:
	381	c -----------
	382
	383	DO l=1,llm
	384	DO j=2,jjm
	385	ig0=1+(j-2)*iim
	386	DO i=1,iim
	387	zvfi(ig0+i,l)= 0.5 *
	388	$ ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
	389	pcvgv(ig0+i,l)= 0.5 *
	390	$ ( pdvcov(i,j-1,l)/cv(i,j-1) + pdvcov(i,j,l)/cv(i,j) )
	391	ENDDO
[2333]	392	zrfi(ig0 + 1,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l)
	393	& +zrot(1,j-1,l)+zrot(1,j,l))
	394	DO i=2,iim
	395	zrfi(ig0 + i,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l)
	396	$ +zrot(i,j-1,l)+zrot(i,j,l)) ! AdlC MAY 2014
	397	ENDDO
[524]	398	ENDDO
	399	ENDDO
	400
	401
	402	c 47. champs de vents aux pole nord
	403	c ------------------------------
	404	c U = 1 / pi * integrale [ v * cos(long) * d long ]
	405	c V = 1 / pi * integrale [ v * sin(long) * d long ]
	406
	407	DO l=1,llm
	408
	409	z1(1) =(rlonu(1)-rlonu(iim)+2.pi)pvcov(1,1,l)/cv(1,1)
	410	z1bis(1)=(rlonu(1)-rlonu(iim)+2.pi)pdvcov(1,1,l)/cv(1,1)
	411	DO i=2,iim
	412	z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
	413	z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
	414	ENDDO
	415
	416	DO i=1,iim
	417	zcos(i) = COS(rlonv(i))*z1(i)
	418	zcosbis(i)= COS(rlonv(i))*z1bis(i)
	419	zsin(i) = SIN(rlonv(i))*z1(i)
	420	zsinbis(i)= SIN(rlonv(i))*z1bis(i)
	421	ENDDO
	422
	423	zufi(1,l) = SSUM(iim,zcos,1)/pi
	424	pcvgu(1,l) = SSUM(iim,zcosbis,1)/pi
	425	zvfi(1,l) = SSUM(iim,zsin,1)/pi
	426	pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi
[2333]	427	zrfi(1, l) = 0.
[524]	428	ENDDO
	429
	430
	431	c 48. champs de vents aux pole sud:
	432	c ---------------------------------
	433	c U = 1 / pi * integrale [ v * cos(long) * d long ]
	434	c V = 1 / pi * integrale [ v * sin(long) * d long ]
	435
	436	DO l=1,llm
	437
	438	z1(1) =(rlonu(1)-rlonu(iim)+2.pi)pvcov(1,jjm,l)/cv(1,jjm)
	439	z1bis(1)=(rlonu(1)-rlonu(iim)+2.pi)pdvcov(1,jjm,l)/cv(1,jjm)
	440	DO i=2,iim
	441	z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
	442	z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
[1403]	443	ENDDO
[524]	444
	445	DO i=1,iim
	446	zcos(i) = COS(rlonv(i))*z1(i)
	447	zcosbis(i) = COS(rlonv(i))*z1bis(i)
	448	zsin(i) = SIN(rlonv(i))*z1(i)
	449	zsinbis(i) = SIN(rlonv(i))*z1bis(i)
[1403]	450	ENDDO
[524]	451
	452	zufi(ngridmx,l) = SSUM(iim,zcos,1)/pi
	453	pcvgu(ngridmx,l) = SSUM(iim,zcosbis,1)/pi
	454	zvfi(ngridmx,l) = SSUM(iim,zsin,1)/pi
	455	pcvgv(ngridmx,l) = SSUM(iim,zsinbis,1)/pi
[2333]	456	zrfi(ngridmx, l) = 0.
[524]	457	ENDDO
[644]	458	c
[960]	459	c On change de grille, dynamique vers physiq, pour le flux de masse verticale
[524]	460	CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,flxw,flxwfi)
	461
	462	c-----------------------------------------------------------------------
	463	c Appel de la physique:
	464	c ---------------------
	465
	466
[1403]	467
[1407]	468	! write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
[1403]	469	zdt_split=dtphys/nsplit_phys
	470	zdufic(:,:)=0.
	471	zdvfic(:,:)=0.
	472	zdtfic(:,:)=0.
	473	zdqfic(:,:,:)=0.
	474
[1615]	475	#ifdef CPP_PHYS
[1403]	476
[1615]	477	do isplit=1,nsplit_phys
	478
[1403]	479	jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
	480	debut_split=debut.and.isplit==1
	481	lafin_split=lafin.and.isplit==nsplit_phys
	482
[2418]	483	CALL call_physiq(ngridmx,llm,nqtot,tname,
	484	& debut_split,lafin_split,
	485	& jD_cur,jH_cur_split,zdt_split,
	486	& zplev,zplay,
[2641]	487	& zpk,zphi,zphis,
[2418]	488	& presnivs,
	489	& zufi,zvfi,zrfi,ztfi,zqfi,
	490	& flxwfi,pducov,
	491	& zdufi,zdvfi,zdtfi,zdqfi,zdpsrf)
	492
	493	! if (planet_type=="earth") then
	494	!
	495	! CALL physiq (ngridmx,
	496	! . llm,
	497	! . debut_split,
	498	! . lafin_split,
	499	! . jD_cur,
	500	! . jH_cur_split,
	501	! . zdt_split,
	502	! . zplev,
	503	! . zplay,
	504	! . zphi,
	505	! . zphis,
	506	! . presnivs,
	507	! . zufi,
	508	! . zvfi, zrfi,
	509	! . ztfi,
	510	! . zqfi,
	511	! . flxwfi,
	512	! . zdufi,
	513	! . zdvfi,
	514	! . zdtfi,
	515	! . zdqfi,
	516	! . zdpsrf,
	517	! . pducov)
	518	!
	519	! else if ( planet_type=="generic" ) then
	520	!
	521	! CALL physiq (ngridmx, !! ngrid
	522	! . llm, !! nlayer
	523	! . nqtot, !! nq
	524	! . tname, !! tracer names from dynamical core (given in infotrac)
	525	! . debut_split, !! firstcall
	526	! . lafin_split, !! lastcall
	527	! . jD_cur, !! pday. see leapfrog
	528	! . jH_cur_split, !! ptime "fraction of day"
	529	! . zdt_split, !! ptimestep
	530	! . zplev, !! pplev
	531	! . zplay, !! pplay
	532	! . zphi, !! pphi
	533	! . zufi, !! pu
	534	! . zvfi, !! pv
	535	! . ztfi, !! pt
	536	! . zqfi, !! pq
	537	! . flxwfi, !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
	538	! . zdufi, !! pdu
	539	! . zdvfi, !! pdv
	540	! . zdtfi, !! pdt
	541	! . zdqfi, !! pdq
	542	! . zdpsrf, !! pdpsrf
	543	! . tracerdyn) !! tracerdyn <-- utilite ???
	544	!
	545	! endif ! of if (planet_type=="earth")
[1654]	546
[1403]	547	zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split
	548	zvfi(:,:)=zvfi(:,:)+zdvfi(:,:)*zdt_split
	549	ztfi(:,:)=ztfi(:,:)+zdtfi(:,:)*zdt_split
	550	zqfi(:,:,:)=zqfi(:,:,:)+zdqfi(:,:,:)*zdt_split
	551
	552	zdufic(:,:)=zdufic(:,:)+zdufi(:,:)
	553	zdvfic(:,:)=zdvfic(:,:)+zdvfi(:,:)
	554	zdtfic(:,:)=zdtfic(:,:)+zdtfi(:,:)
	555	zdqfic(:,:,:)=zdqfic(:,:,:)+zdqfi(:,:,:)
	556
[1615]	557	enddo ! of do isplit=1,nsplit_phys
	558
	559	#endif
	560	! of #ifdef CPP_PHYS
	561
[1403]	562	zdufi(:,:)=zdufic(:,:)/nsplit_phys
	563	zdvfi(:,:)=zdvfic(:,:)/nsplit_phys
	564	zdtfi(:,:)=zdtfic(:,:)/nsplit_phys
	565	zdqfi(:,:,:)=zdqfic(:,:,:)/nsplit_phys
	566
[524]	567
	568	500 CONTINUE
	569
	570	c-----------------------------------------------------------------------
	571	c transformation des tendances physiques en tendances dynamiques:
	572	c ---------------------------------------------------------------
	573
	574	c tendance sur la pression :
	575	c -----------------------------------
	576
	577	CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
	578	c
	579	c 62. enthalpie potentielle
	580	c ---------------------
	581
	582	DO l=1,llm
	583
	584	DO i=1,iip1
	585	pdhfi(i,1,l) = cpp * zdtfi(1,l) / ppk(i, 1 ,l)
	586	pdhfi(i,jjp1,l) = cpp * zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
	587	ENDDO
	588
	589	DO j=2,jjm
	590	ig0=1+(j-2)*iim
	591	DO i=1,iim
	592	pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
	593	ENDDO
	594	pdhfi(iip1,j,l) = pdhfi(1,j,l)
	595	ENDDO
	596
	597	ENDDO
	598
	599
	600	c 62. humidite specifique
	601	c ---------------------
[1279]	602	! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
	603	! DO iq=1,nqtot
	604	! DO l=1,llm
	605	! DO i=1,iip1
	606	! pdqfi(i,1,l,iq) = zdqfi(1,l,iq)
	607	! pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
	608	! ENDDO
	609	! DO j=2,jjm
	610	! ig0=1+(j-2)*iim
	611	! DO i=1,iim
	612	! pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
	613	! ENDDO
	614	! pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
	615	! ENDDO
	616	! ENDDO
	617	! ENDDO
[524]	618
	619	c 63. traceurs
	620	c ------------
	621	C initialisation des tendances
[1279]	622	pdqfi(:,:,:,:)=0.
[524]	623	C
[1146]	624	DO iq=1,nqtot
[524]	625	iiq=niadv(iq)
	626	DO l=1,llm
	627	DO i=1,iip1
	628	pdqfi(i,1,l,iiq) = zdqfi(1,l,iq)
	629	pdqfi(i,jjp1,l,iiq) = zdqfi(ngridmx,l,iq)
	630	ENDDO
	631	DO j=2,jjm
	632	ig0=1+(j-2)*iim
	633	DO i=1,iim
	634	pdqfi(i,j,l,iiq) = zdqfi(ig0+i,l,iq)
	635	ENDDO
	636	pdqfi(iip1,j,l,iiq) = pdqfi(1,j,l,iq)
	637	ENDDO
	638	ENDDO
	639	ENDDO
	640
	641	c 65. champ u:
	642	c ------------
	643
	644	DO l=1,llm
	645
	646	DO i=1,iip1
	647	pdufi(i,1,l) = 0.
	648	pdufi(i,jjp1,l) = 0.
	649	ENDDO
	650
	651	DO j=2,jjm
	652	ig0=1+(j-2)*iim
	653	DO i=1,iim-1
	654	pdufi(i,j,l)=
	655	$ 0.5(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))cu(i,j)
	656	ENDDO
	657	pdufi(iim,j,l)=
	658	$ 0.5(zdufi(ig0+1,l)+zdufi(ig0+iim,l))cu(iim,j)
	659	pdufi(iip1,j,l)=pdufi(1,j,l)
	660	ENDDO
	661
	662	ENDDO
	663
	664
	665	c 67. champ v:
	666	c ------------
	667
	668	DO l=1,llm
	669
	670	DO j=2,jjm-1
	671	ig0=1+(j-2)*iim
	672	DO i=1,iim
	673	pdvfi(i,j,l)=
	674	$ 0.5(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))cv(i,j)
	675	ENDDO
	676	pdvfi(iip1,j,l) = pdvfi(1,j,l)
	677	ENDDO
	678	ENDDO
	679
	680
	681	c 68. champ v pres des poles:
	682	c ---------------------------
	683	c v = U * cos(long) + V * SIN(long)
	684
	685	DO l=1,llm
	686
	687	DO i=1,iim
	688	pdvfi(i,1,l)=
	689	$ zdufi(1,l)COS(rlonv(i))+zdvfi(1,l)SIN(rlonv(i))
	690	pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
	691	$ +zdvfi(ngridmx,l)*SIN(rlonv(i))
	692	pdvfi(i,1,l)=
	693	$ 0.5(pdvfi(i,1,l)+zdvfi(i+1,l))cv(i,1)
	694	pdvfi(i,jjm,l)=
	695	$ 0.5(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))cv(i,jjm)
	696	ENDDO
	697
	698	pdvfi(iip1,1,l) = pdvfi(1,1,l)
	699	pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
	700
	701	ENDDO
	702
	703	c-----------------------------------------------------------------------
	704
	705	700 CONTINUE
	706
	707	firstcal = .FALSE.
	708
	709	RETURN
	710	END

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

Download in other formats:

Original Format