Context Navigation

thermcell_main.F90 @ 1080

Last change on this file since 1080 was 855, checked in by Laurent Fairhead, 17 years ago
Bidouillage interne :-) LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 19.2 KB

Rev	Line
[852]	1	!
	2	! $Header$
	3	!
[814]	4	SUBROUTINE thermcell_main(ngrid,nlay,ptimestep &
	5	& ,pplay,pplev,pphi,debut &
	6	& ,pu,pv,pt,po &
	7	& ,pduadj,pdvadj,pdtadj,pdoadj &
	8	& ,fm0,entr0,zqla,lmax &
	9	& ,ratqscth,ratqsdiff,zqsatth &
	10	& ,r_aspect,l_mix,w2di,tho)
	11
	12	IMPLICIT NONE
	13
	14	!=======================================================================
	15	! Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu
	16	! Version du 09.02.07
	17	! Calcul du transport vertical dans la couche limite en presence
	18	! de "thermiques" explicitement representes avec processus nuageux
	19	!
	20	! Réécriture à partir d'un listing papier à Habas, le 14/02/00
	21	!
	22	! le thermique est supposé homogène et dissipé par mélange avec
	23	! son environnement. la longueur l_mix contrôle l'efficacité du
	24	! mélange
	25	!
	26	! Le calcul du transport des différentes espèces se fait en prenant
	27	! en compte:
	28	! 1. un flux de masse montant
	29	! 2. un flux de masse descendant
	30	! 3. un entrainement
	31	! 4. un detrainement
	32	!
	33	!=======================================================================
	34
	35	!-----------------------------------------------------------------------
	36	! declarations:
	37	! -------------
	38
	39	#include "dimensions.h"
	40	#include "dimphy.h"
	41	#include "YOMCST.h"
	42	#include "YOETHF.h"
	43	#include "FCTTRE.h"
	44
	45	! arguments:
	46	! ----------
	47
	48	INTEGER ngrid,nlay,w2di,tho
	49	real ptimestep,l_mix,r_aspect
	50	REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
	51	REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
	52	REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
	53	REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
	54	REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
	55	real pphi(ngrid,nlay)
	56
	57	! local:
	58	! ------
	59
[852]	60	! integer,save :: igout=4259
	61	integer,save :: igout=2928
[814]	62	integer,save :: lunout=6
[852]	63	integer,save :: lev_out=10
[814]	64
	65	INTEGER ig,k,l,ll
	66	real zsortie1d(klon)
	67	INTEGER lmax(klon),lmin(klon),lalim(klon)
	68	INTEGER lmix(klon)
	69	real linter(klon)
	70	real zmix(klon)
	71	real zmax(klon),zw2(klon,klev+1),ztva(klon,klev)
	72	real zmax_sec(klon)
	73	real w_est(klon,klev+1)
	74	!on garde le zmax du pas de temps precedent
	75	real zmax0(klon)
	76	save zmax0
	77
	78	real zlev(klon,klev+1),zlay(klon,klev)
	79	real deltaz(klon,klev)
	80	REAL zh(klon,klev),zdhadj(klon,klev)
	81	real zthl(klon,klev),zdthladj(klon,klev)
	82	REAL ztv(klon,klev)
	83	real zu(klon,klev),zv(klon,klev),zo(klon,klev)
	84	real zl(klon,klev)
	85	real zsortie(klon,klev)
	86	real zva(klon,klev)
	87	real zua(klon,klev)
	88	real zoa(klon,klev)
	89
	90	real zta(klon,klev)
	91	real zha(klon,klev)
	92	real fraca(klon,klev+1)
	93	real zf,zf2
	94	real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev)
	95	real q2(klon,klev)
	96	common/comtherm/thetath2,wth2
	97
	98	real ratqscth(klon,klev)
	99	real var
	100	real vardiff
	101	real ratqsdiff(klon,klev)
	102	integer isplit,nsplit
	103	parameter (nsplit=10)
	104	data isplit/0/
	105	save isplit
	106
	107	logical sorties
	108	real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
	109	real zpspsk(klon,klev)
	110
	111	real wmax(klon)
	112	real wmax_sec(klon)
	113	real fm0(klon,klev+1),entr0(klon,klev),detr(klon,klev)
	114	real detr0(klon,klev)
	115	real fm(klon,klev+1),entr(klon,klev)
	116
	117	real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev)
	118	!niveau de condensation
	119	real nivcon(klon)
	120	real zcon(klon)
	121	REAL CHI
	122	real zcon2(klon)
	123	real pcon(klon)
	124	real zqsat(klon,klev)
	125	real zqsatth(klon,klev)
	126
	127	real f_star(klon,klev+1),entr_star(klon,klev)
	128	real detr_star(klon,klev)
	129	real alim_star_tot(klon),alim_star2(klon)
	130	real alim_star(klon,klev)
	131	real f(klon), f0(klon)
	132	save f0
	133	real zlevinter(klon)
	134	logical debut
[852]	135	real seuil
[814]	136
	137	!
	138
	139	character*2 str2
	140	character*10 str10
	141
	142	EXTERNAL SCOPY
	143	!
	144
	145	!-----------------------------------------------------------------------
	146	! initialisation:
	147	! ---------------
	148	!
[852]	149
	150	seuil=0.25
	151
[814]	152	if (lev_out.ge.1) print*,'thermcell_main V4'
	153
	154	sorties=.true.
	155	IF(ngrid.NE.klon) THEN
	156	PRINT*
	157	PRINT*,'STOP dans convadj'
	158	PRINT*,'ngrid =',ngrid
	159	PRINT*,'klon =',klon
	160	ENDIF
	161	!
	162	!Initialisation
	163	!
	164	do ig=1,klon
	165	if ((debut).or.((.not.debut).and.(f0(ig).lt.1.e-10))) then
	166	f0(ig)=1.e-5
	167	zmax0(ig)=40.
	168	endif
	169	enddo
	170
	171
	172
	173	!-----------------------------------------------------------------------
	174	! Calcul de T,q,ql a partir de Tl et qT dans l environnement
	175	! --------------------------------------------------------------------
	176	!
	177	CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay, &
	178	& pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
	179
	180	if (lev_out.ge.1) print*,'thermcell_main apres thermcell_env'
	181
	182	!------------------------------------------------------------------------
	183	! --------------------
	184	!
	185	!
	186	! + + + + + + + + + + +
	187	!
	188	!
	189	! wa, fraca, wd, fracd -------------------- zlev(2), rhobarz
	190	! wh,wt,wo ...
	191	!
	192	! + + + + + + + + + + + zh,zu,zv,zo,rho
	193	!
	194	!
	195	! -------------------- zlev(1)
	196	! \\\\\\\\\\\\\\\\\\\\
	197	!
	198	!
	199
	200	!-----------------------------------------------------------------------
	201	! Calcul des altitudes des couches
	202	!-----------------------------------------------------------------------
	203
	204	do l=2,nlay
	205	zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG
	206	enddo
	207	zlev(:,1)=0.
	208	zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG
	209	do l=1,nlay
	210	zlay(:,l)=pphi(:,l)/RG
	211	enddo
	212	!calcul de l epaisseur des couches
	213	do l=1,nlay
	214	deltaz(:,l)=zlev(:,l+1)-zlev(:,l)
	215	enddo
	216
	217	! print*,'2 OK convect8'
	218	!-----------------------------------------------------------------------
	219	! Calcul des densites
	220	!-----------------------------------------------------------------------
	221
	222	do l=1,nlay
	223	rho(:,l)=pplay(:,l)/(zpspsk(:,l)RDztv(:,l))
	224	enddo
	225
	226	do l=2,nlay
	227	rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
	228	enddo
	229
	230	!calcul de la masse
	231	do l=1,nlay
	232	masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG
	233	enddo
	234
	235	if (lev_out.ge.1) print*,'thermcell_main apres initialisation'
	236
	237	!------------------------------------------------------------------
	238	!
[852]	239	! /\|\
	240	! -------- \| F_k+1 -------
	241	! ----> D_k
	242	! /\|\ <---- E_k , A_k
	243	! -------- \| F_k ---------
	244	! ----> D_k-1
	245	! <---- E_k-1 , A_k-1
[814]	246	!
	247	!
	248	!
	249	!
	250	!
[852]	251	! ---------------------------
[814]	252	!
[852]	253	! ----- F_lmax+1=0 ---------- \
	254	! lmax (zmax) \|
	255	! --------------------------- \|
	256	! \|
	257	! --------------------------- \|
	258	! \|
	259	! --------------------------- \|
	260	! \|
	261	! --------------------------- \|
	262	! \|
	263	! --------------------------- \|
	264	! \| E
	265	! --------------------------- \| D
	266	! \|
	267	! --------------------------- \|
	268	! \|
	269	! --------------------------- \ \|
	270	! lalim \| \|
	271	! --------------------------- \| \|
	272	! \| \|
	273	! --------------------------- \| \|
	274	! \| A \|
	275	! --------------------------- \| \|
	276	! \| \|
	277	! --------------------------- \| \|
	278	! lmin (=1 pour le moment) \| \|
	279	! ----- F_lmin=0 ------------ / /
[814]	280	!
[852]	281	! ---------------------------
	282	! //////////////////////////
	283	!
	284	!
	285	!=============================================================================
	286	! Calculs initiaux ne faisant pas intervenir les changements de phase
	287	!=============================================================================
	288
[814]	289	!------------------------------------------------------------------
[852]	290	! 1. alim_star est le profil vertical de l'alimentation à la base du
	291	! panache thermique, calculé à partir de la flotabilité de l'air sec
	292	! 2. lmin et lalim sont les indices inferieurs et superieurs de alim_star
[814]	293	!------------------------------------------------------------------
	294	!
	295	entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0.
	296	CALL thermcell_init(ngrid,nlay,ztv,zlev, &
	297	& lalim,lmin,alim_star,alim_star_tot,lev_out)
	298
[852]	299	call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lmin ')
	300	call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lalim ')
	301
	302
[814]	303	if (lev_out.ge.1) print*,'thermcell_main apres thermcell_init'
	304	if (lev_out.ge.10) then
	305	write(lunout,*) 'Dans thermcell_main 1'
	306	write(lunout,*) 'lmin ',lmin(igout)
	307	write(lunout,*) 'lalim ',lalim(igout)
[852]	308	write(lunout,*) ' ig l alim_star thetav'
	309	write(lunout,'(i6,i4,2e15.5)') (igout,l,alim_star(igout,l) &
	310	& ,ztv(igout,l),l=1,lalim(igout)+4)
[814]	311	endif
	312
[852]	313	!-----------------------------------------------------------------------------
	314	! 3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un
	315	! panache sec conservatif (e=d=0) alimente selon alim_star
	316	! Il s'agit d'un calcul de type CAPE
	317	! zmax_sec est utilisé pour déterminer la géométrie du thermique.
	318	!------------------------------------------------------------------------------
[814]	319	!
	320	CALL thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star, &
	321	& lalim,lmin,zmax_sec,wmax_sec,lev_out)
	322
[852]	323	call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lmin ')
	324	call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lalim ')
	325
[814]	326	if (lev_out.ge.1) print*,'thermcell_main apres thermcell_dry'
[852]	327	if (lev_out.ge.10) then
	328	write(lunout,*) 'Dans thermcell_main 1b'
	329	write(lunout,*) 'lmin ',lmin(igout)
	330	write(lunout,*) 'lalim ',lalim(igout)
	331	write(lunout,*) ' ig l alim_star entr_star detr_star f_star '
	332	write(lunout,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) &
	333	& ,l=1,lalim(igout)+4)
	334	endif
[814]	335
	336
	337
	338	!---------------------------------------------------------------------------------
	339	!calcul du melange et des variables dans le thermique
	340	!--------------------------------------------------------------------------------
	341	!
	342	CALL thermcell_plume(ngrid,nlay,ztv,zthl,po,zl,rhobarz, &
	343	& zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star, &
	344	& lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva, &
	345	& ztla,zqla,zqta,zha,zw2,zqsatth,lmix,linter,lev_out)
[852]	346	call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
	347	call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix ')
[814]	348
	349	if (lev_out.ge.1) print*,'thermcell_main apres thermcell_plume'
	350	if (lev_out.ge.10) then
	351	write(lunout,*) 'Dans thermcell_main 2'
	352	write(lunout,*) 'lmin ',lmin(igout)
	353	write(lunout,*) 'lalim ',lalim(igout)
	354	write(lunout,*) ' ig l alim_star entr_star detr_star f_star '
	355	write(lunout,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) &
[852]	356	& ,f_star(igout,l+1),l=1,nint(linter(igout))+5)
[814]	357	endif
	358
	359	!-------------------------------------------------------------------------------
	360	! Calcul des caracteristiques du thermique:zmax,zmix,wmax
	361	!-------------------------------------------------------------------------------
	362	!
	363	CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2, &
	364	& zlev,lmax,zmax,zmax0,zmix,wmax,lev_out)
	365
[852]	366
	367	call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
	368	call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin ')
	369	call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix ')
	370	call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax ')
	371
[814]	372	if (lev_out.ge.1) print*,'thermcell_main apres thermcell_height'
	373
	374	!-------------------------------------------------------------------------------
	375	! Fermeture,determination de f
	376	!-------------------------------------------------------------------------------
	377
	378	CALL thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho, &
	379	& zlev,lalim,alim_star,zmax_sec,wmax_sec,zmax,wmax,f,f0,lev_out)
	380
	381	if(lev_out.ge.1)print*,'thermcell_closure apres thermcell_closure'
	382
	383	!-------------------------------------------------------------------------------
	384	!deduction des flux
	385	!-------------------------------------------------------------------------------
	386
[855]	387	CALL thermcell_flux(ngrid,nlay,ptimestep,masse, &
[814]	388	& lalim,lmax,alim_star, &
	389	& entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr, &
	390	& detr,zqla,zmax,lev_out,lunout,igout)
	391
	392	if (lev_out.ge.1) print*,'thermcell_main apres thermcell_flux'
[852]	393	call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
	394	call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax ')
[814]	395
	396	!c------------------------------------------------------------------
	397	! calcul du transport vertical
	398	!------------------------------------------------------------------
	399
	400	if (w2di.eq.1) then
	401	fm0=fm0+ptimestep*(fm-fm0)/float(tho)
	402	entr0=entr0+ptimestep*(entr-entr0)/float(tho)
	403	else
	404	fm0=fm
	405	entr0=entr
	406	detr0=detr
	407	endif
	408
	409	call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse, &
	410	& zthl,zdthladj,zta,lev_out)
	411	call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse, &
	412	& po,pdoadj,zoa,lev_out)
	413
	414	if (1.eq.0) then
	415
	416	! Calcul du transport de V tenant compte d'echange par gradient
	417	! de pression horizontal avec l'environnement
	418
	419	call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse &
	420	& ,fraca,zmax &
	421	& ,zu,zv,pduadj,pdvadj,zua,zva,lev_out)
	422	else
	423
	424	! calcul purement conservatif pour le transport de V
	425	call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse &
	426	& ,zu,pduadj,zua,lev_out)
	427	call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse &
	428	& ,zv,pdvadj,zva,lev_out)
	429	endif
	430
	431	! print*,'13 OK convect8'
	432	do l=1,nlay
	433	do ig=1,ngrid
	434	pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l)
	435	enddo
	436	enddo
	437
	438	print*,'14 OK convect8'
	439	!------------------------------------------------------------------
	440	! Calculs de diagnostiques pour les sorties
	441	!------------------------------------------------------------------
	442	!calcul de fraca pour les sorties
	443
	444	if (sorties) then
	445	do ig=1,klon
	446	fraca(ig,1)=0.
	447	enddo
	448	do l=2,nlay
	449	do ig=1,klon
	450	if (zw2(ig,l).gt.1.e-10) then
	451	fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
	452	else
	453	fraca(ig,l)=0.
	454	endif
	455	enddo
	456	enddo
	457
[852]	458	print*,'14a OK convect8'
[814]	459	! calcul du niveau de condensation
	460	! initialisation
	461	do ig=1,ngrid
	462	nivcon(ig)=0.
	463	zcon(ig)=0.
	464	enddo
	465	!nouveau calcul
	466	do ig=1,ngrid
	467	CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1))
	468	pcon(ig)=pplay(ig,1)(zo(ig,1)/zqsat(ig,1))*CHI
	469	enddo
	470	do k=1,nlay
	471	do ig=1,ngrid
	472	if ((pcon(ig).le.pplay(ig,k)) &
	473	& .and.(pcon(ig).gt.pplay(ig,k+1))) then
	474	zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100.
	475	endif
	476	enddo
	477	enddo
[852]	478	print*,'14b OK convect8'
[814]	479	do k=nlay,1,-1
	480	do ig=1,ngrid
	481	if (zqla(ig,k).gt.1e-10) then
	482	nivcon(ig)=k
	483	zcon(ig)=zlev(ig,k)
	484	endif
	485	enddo
	486	enddo
[852]	487	print*,'14c OK convect8'
[814]	488	!calcul des moments
	489	!initialisation
	490	do l=1,nlay
	491	do ig=1,ngrid
	492	q2(ig,l)=0.
	493	wth2(ig,l)=0.
	494	wth3(ig,l)=0.
	495	ratqscth(ig,l)=0.
	496	ratqsdiff(ig,l)=0.
	497	enddo
	498	enddo
[852]	499	print*,'14d OK convect8'
[814]	500	do l=1,nlay
	501	do ig=1,ngrid
	502	zf=fraca(ig,l)
	503	zf2=zf/(1.-zf)
	504	thetath2(ig,l)=zf2(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))*2
	505	wth2(ig,l)=zf2(zw2(ig,l))*2
	506	! print*,'wth2=',wth2(ig,l)
	507	wth3(ig,l)=zf2(1-2.fraca(ig,l))/(1-fraca(ig,l)) &
	508	& zw2(ig,l)zw2(ig,l)*zw2(ig,l)
	509	q2(ig,l)=zf2(zqta(ig,l)1000.-po(ig,l)1000.)*2
	510	!test: on calcul q2/po=ratqsc
[852]	511	ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.))
[814]	512	enddo
	513	enddo
	514	!calcul du ratqscdiff
[852]	515	print*,'14e OK convect8'
[814]	516	var=0.
	517	vardiff=0.
	518	ratqsdiff(:,:)=0.
	519	do ig=1,ngrid
	520	do l=1,lalim(ig)
	521	var=var+alim_star(ig,l)zqta(ig,l)1000.
	522	enddo
	523	enddo
[852]	524	print*,'14f OK convect8'
[814]	525	do ig=1,ngrid
	526	do l=1,lalim(ig)
	527	zf=fraca(ig,l)
	528	zf2=zf/(1.-zf)
	529	vardiff=vardiff+alim_star(ig,l) &
	530	& (zqta(ig,l)1000.-var)**2
	531	! ratqsdiff=ratqsdiff+alim_star(ig,l)*
	532	! s (zqta(ig,l)1000.-po(ig,l)1000.)**2
	533	enddo
	534	enddo
[852]	535	print*,'14g OK convect8'
[814]	536	do l=1,nlay
	537	do ig=1,ngrid
	538	ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)
	539	! write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
	540	enddo
	541	enddo
	542	!--------------------------------------------------------------------
	543	!
	544	!ecriture des fichiers sortie
	545	! print*,'15 OK convect8'
	546
	547	isplit=isplit+1
	548
	549
	550	#ifdef und
	551	if (lev_out.ge.1) print*,'thermcell_main sorties 1D'
	552	#include "thermcell_out1d.h"
	553	#endif
	554
	555
	556	! #define troisD
	557	if (lev_out.ge.1) print*,'thermcell_main sorties 3D'
	558	#ifdef troisD
	559	#include "thermcell_out3d.h"
	560	#endif
	561
	562	endif
	563
	564	if (lev_out.ge.1) print*,'thermcell_main FIN OK'
	565
	566	return
	567	end
	568
	569	!-----------------------------------------------------------------------------
[852]	570
	571	subroutine test_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment)
	572
	573	integer klon,klev
	574	real pplev(klon,klev+1),pplay(klon,klev)
	575	real ztv(klon,klev)
	576	real po(klon,klev)
	577	real ztva(klon,klev)
	578	real zqla(klon,klev)
	579	real f_star(klon,klev)
	580	real zw2(klon,klev)
	581	integer long(klon)
	582	real seuil
	583	character*21 comment
	584
	585	print*,'TEST ',comment
	586	! test sur la hauteur des thermiques ...
	587	do i=1,klon
	588	if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
	589	print*,'WARNING ',comment,' au point ',i,' K= ',long(i)
	590	print,' K P(MB) THV(K) Qenv(g/kg)THVA QLA(g/kg) F W2'
	591	do k=1,klev
	592	write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000po(i,k),ztva(i,k),1000zqla(i,k),f_star(i,k),zw2(i,k)
	593	enddo
	594	! stop
	595	endif
	596	enddo
	597
	598
	599	return
	600	end
	601

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

Download in other formats:

Original Format