Context Navigation

calltherm.F90 @ 985

Last change on this file since 985 was 973, checked in by lmdzadmin, 16 years ago
Initialisations : concvl, cv3_routines, cva_driver, physiq Correction bug i0 + ajout tests : cv3p1_closure Ajout sorties : ale, alp, cin, wape Ajout variables wake : phyetat0, phyredem IM
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 12.2 KB

Rev	Line
[878]	1	!
	2	! $Header$
	3	!
	4	subroutine calltherm(dtime &
	5	& ,pplay,paprs,pphi,weak_inversion &
	6	& ,u_seri,v_seri,t_seri,q_seri,zqsat,debut &
	7	& ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
[973]	8	& ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth, &
[927]	9	& ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, &
	10	& zmax0,f0)
[878]	11
[940]	12	USE dimphy
[878]	13	implicit none
	14	#include "dimensions.h"
[940]	15	!#include "dimphy.h"
[878]	16	#include "thermcell.h"
[938]	17	#include "iniprint.h"
[878]	18
	19	! A inclure eventuellement dans les fichiers de configuration
[973]	20	data r_aspect_thermals,l_mix_thermals/2.,30./
	21	data w2di_thermals/1/
[878]	22
[973]	23	!IM 140508
	24	INTEGER itap
[878]	25	REAL dtime
	26	LOGICAL debut
[973]	27	LOGICAL logexpr0, logexpr2(klon,klev), logexpr1(klon)
	28	REAL fact(klon)
	29	INTEGER nbptspb
	30
[878]	31	REAL u_seri(klon,klev),v_seri(klon,klev)
	32	REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev)
	33	REAL weak_inversion(klon)
	34	REAL paprs(klon,klev+1)
	35	REAL pplay(klon,klev)
	36	REAL pphi(klon,klev)
	37	real zlev(klon,klev+1)
[879]	38	!test: on sort lentr et a* pour alimenter KE
	39	REAL wght_th(klon,klev)
	40	INTEGER lalim_conv(klon)
[878]	41
	42	!FH Update Thermiques
	43	REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
	44	REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
[973]	45	real fm_therm(klon,klev+1)
	46	real entr_therm(klon,klev),detr_therm(klon,klev)
[878]	47
	48	!********************************************************
	49	! declarations
[973]	50	real fmc_therm(klon,klev+1),zqasc(klon,klev)
[878]	51	real zqla(klon,klev)
	52	real wmax_sec(klon)
	53	real zmax_sec(klon)
	54	real f_sec(klon)
[973]	55	real detrc_therm(klon,klev)
	56	! FH WARNING : il semble que ces save ne servent a rien
	57	! save fmc_therm, detrc_therm
[878]	58	real clwcon0(klon,klev)
	59	real zqsat(klon,klev)
	60	real zw_sec(klon,klev+1)
	61	integer lmix_sec(klon)
	62	integer lmax(klon)
	63	real ratqscth(klon,klev)
	64	real ratqsdiff(klon,klev)
	65	real zqsatth(klon,klev)
[879]	66	!nouvelles variables pour la convection
	67	real Ale_bl(klon)
	68	real Alp_bl(klon)
	69	real Ale(klon)
	70	real Alp(klon)
	71	!RC
[927]	72	!on garde le zmax du pas de temps precedent
	73	real zmax0(klon), f0(klon)
[878]	74	!********************************************************
	75
	76
	77	! variables locales
	78	REAL d_t_the(klon,klev), d_q_the(klon,klev)
	79	REAL d_u_the(klon,klev),d_v_the(klon,klev)
	80	!
[973]	81	real zfm_therm(klon,klev+1),zdt
	82	real zentr_therm(klon,klev),zdetr_therm(klon,klev)
	83	! FH A VERIFIER : SAVE INUTILES
[940]	84	! save zentr_therm,zfm_therm
[973]	85
[878]	86	integer i,k
[973]	87	logical, save :: first=.true.
[878]	88	!********************************************************
[973]	89	if (first) then
	90	itap=0
	91	first=.false.
	92	endif
[878]	93
[973]	94	! Incrementer le compteur de la physique
	95	itap = itap + 1
	96
[878]	97	! Modele du thermique
	98	! ===================
	99	! print*,'thermiques: WARNING on passe t au lieu de t_seri'
	100
	101
[973]	102	! On prend comme valeur initiale des thermiques la valeur du pas
	103	! de temps precedent
	104	zfm_therm(:,:)=fm_therm(:,:)
	105	zdetr_therm(:,:)=detr_therm(:,:)
	106	zentr_therm(:,:)=entr_therm(:,:)
	107
	108	! On reinitialise les flux de masse a zero pour le cumul en
	109	! cas de splitting
[878]	110	fm_therm(:,:)=0.
	111	entr_therm(:,:)=0.
[973]	112	detr_therm(:,:)=0.
	113
[879]	114	Ale_bl(:)=0.
	115	Alp_bl(:)=0.
[938]	116	if (prt_level.ge.10) then
	117	print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
	118	endif
[878]	119
	120	! tests sur les valeurs negatives de l'eau
[973]	121	logexpr0=prt_level.ge.10
	122	nbptspb=0
[878]	123	do k=1,klev
	124	do i=1,klon
[973]	125	logexpr2(i,k)=.not.q_seri(i,k).ge.0.
	126	if (logexpr2(i,k)) then
[938]	127	q_seri(i,k)=1.e-15
[973]	128	nbptspb=nbptspb+1
[878]	129	endif
[973]	130	! if (logexpr0) &
	131	! & print*,'WARN eau<0 avant therm i=',i,' k=',k &
	132	! & ,' dq,q',d_q_the(i,k),q_seri(i,k)
[878]	133	enddo
	134	enddo
[973]	135	if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb
[878]	136
	137	zdt=dtime/float(nsplit_thermals)
	138	do isplit=1,nsplit_thermals
	139
	140	if (iflag_thermals.eq.1) then
	141	CALL thermcell_2002(klon,klev,zdt &
	142	& ,pplay,paprs,pphi &
	143	& ,u_seri,v_seri,t_seri,q_seri &
	144	& ,d_u_the,d_v_the,d_t_the,d_q_the &
	145	& ,zfm_therm,zentr_therm &
	146	& ,r_aspect_thermals,30.,w2di_thermals &
[973]	147	& ,tau_thermals,3)
[878]	148	else if (iflag_thermals.eq.2) then
	149	CALL thermcell_sec(klon,klev,zdt &
	150	& ,pplay,paprs,pphi,zlev &
	151	& ,u_seri,v_seri,t_seri,q_seri &
	152	& ,d_u_the,d_v_the,d_t_the,d_q_the &
	153	& ,zfm_therm,zentr_therm &
	154	& ,r_aspect_thermals,30.,w2di_thermals &
[973]	155	& ,tau_thermals,3)
[878]	156	else if (iflag_thermals.eq.3) then
	157	CALL thermcell(klon,klev,zdt &
	158	& ,pplay,paprs,pphi &
	159	& ,u_seri,v_seri,t_seri,q_seri &
	160	& ,d_u_the,d_v_the,d_t_the,d_q_the &
	161	& ,zfm_therm,zentr_therm &
	162	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
[973]	163	& ,tau_thermals,3)
[878]	164	else if (iflag_thermals.eq.10) then
	165	CALL thermcell_eau(klon,klev,zdt &
	166	& ,pplay,paprs,pphi &
	167	& ,u_seri,v_seri,t_seri,q_seri &
	168	& ,d_u_the,d_v_the,d_t_the,d_q_the &
	169	& ,zfm_therm,zentr_therm &
	170	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
[973]	171	& ,tau_thermals,3)
[878]	172	else if (iflag_thermals.eq.11) then
	173	stop'cas non prevu dans calltherm'
	174	! CALL thermcell_pluie(klon,klev,zdt &
	175	! & ,pplay,paprs,pphi,zlev &
	176	! & ,u_seri,v_seri,t_seri,q_seri &
	177	! & ,d_u_the,d_v_the,d_t_the,d_q_the &
	178	! & ,zfm_therm,zentr_therm,zqla &
	179	! & ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
[973]	180	! & ,tau_thermals,3)
[878]	181	else if (iflag_thermals.eq.12) then
	182	CALL calcul_sec(klon,klev,zdt &
	183	& ,pplay,paprs,pphi,zlev &
	184	& ,u_seri,v_seri,t_seri,q_seri &
	185	& ,zmax_sec,wmax_sec,zw_sec,lmix_sec &
	186	& ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
[973]	187	& ,tau_thermals)
[878]	188	! CALL calcul_sec_entr(klon,klev,zdt
	189	! s ,pplay,paprs,pphi,zlev,debut
	190	! s ,u_seri,v_seri,t_seri,q_seri
	191	! s ,zmax_sec,wmax_sec,zw_sec,lmix_sec
	192	! s ,r_aspect_thermals,l_mix_thermals,w2di_thermals
[973]	193	! s ,tau_thermals,3)
[878]	194	! CALL thermcell_pluie_detr(klon,klev,zdt &
	195	! & ,pplay,paprs,pphi,zlev,debut &
	196	! & ,u_seri,v_seri,t_seri,q_seri &
	197	! & ,d_u_the,d_v_the,d_t_the,d_q_the &
	198	! & ,zfm_therm,zentr_therm,zqla,lmax &
	199	! & ,zmax_sec,wmax_sec,zw_sec,lmix_sec &
	200	! & ,ratqscth,ratqsdiff,zqsatth &
	201	! & ,r_aspect_thermals,l_mix_thermals,w2di_thermals &
[973]	202	! & ,tau_thermals)
[878]	203	else if (iflag_thermals.ge.13) then
[973]	204	CALL thermcell_main(itap,klon,klev,zdt &
[878]	205	& ,pplay,paprs,pphi,debut &
	206	& ,u_seri,v_seri,t_seri,q_seri &
	207	& ,d_u_the,d_v_the,d_t_the,d_q_the &
[973]	208	& ,zfm_therm,zentr_therm,zdetr_therm,zqla,lmax &
[878]	209	& ,ratqscth,ratqsdiff,zqsatth &
[973]	210	& ,r_aspect_thermals,l_mix_thermals &
	211	& ,tau_thermals,Ale,Alp,lalim_conv,wght_th &
[927]	212	& ,zmax0,f0)
[878]	213	endif
	214
	215
[973]	216	fact(:)=0.
[878]	217	DO i=1,klon
[973]	218	logexpr1(i)=iflag_thermals.lt.14.or.weak_inversion(i).gt.0.5
	219	IF(logexpr1(i)) fact(i)=1./float(nsplit_thermals)
	220	ENDDO
[878]	221
[973]	222	DO k=1,klev
[878]	223	! transformation de la derivee en tendance
[973]	224	d_t_the(:,k)=d_t_the(:,k)dtimefact(:)
	225	d_u_the(:,k)=d_u_the(:,k)dtimefact(:)
	226	d_v_the(:,k)=d_v_the(:,k)dtimefact(:)
	227	d_q_the(:,k)=d_q_the(:,k)dtimefact(:)
	228	fm_therm(:,k)=fm_therm(:,k) &
	229	& +zfm_therm(:,k)*fact(:)
	230	entr_therm(:,k)=entr_therm(:,k) &
	231	& +zentr_therm(:,k)*fact(:)
	232	ENDDO
	233	fm_therm(:,klev+1)=0.
[878]	234
	235
	236
	237	! accumulation de la tendance
[973]	238	d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_the(:,:)
	239	d_u_ajs(:,:)=d_u_ajs(:,:)+d_u_the(:,:)
	240	d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)
	241	d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:)
[878]	242
	243	! incrementation des variables meteo
[973]	244	t_seri(:,:) = t_seri(:,:) + d_t_the(:,:)
	245	u_seri(:,:) = u_seri(:,:) + d_u_the(:,:)
	246	v_seri(:,:) = v_seri(:,:) + d_v_the(:,:)
	247	qmemoire(:,:)=q_seri(:,:)
	248	q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)
[878]	249
[879]	250	DO i=1,klon
[973]	251	if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i)
[879]	252	fm_therm(i,klev+1)=0.
	253	Ale_bl(i)=Ale_bl(i)+Ale(i)/float(nsplit_thermals)
	254	! write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i)
	255	Alp_bl(i)=Alp_bl(i)+Alp(i)/float(nsplit_thermals)
	256	! write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i)
	257	ENDDO
	258
[973]	259	!IM 060508 marche pas comme cela !!! enddo ! isplit
	260
[878]	261	! tests sur les valeurs negatives de l'eau
[973]	262	nbptspb=0
[878]	263	DO k = 1, klev
	264	DO i = 1, klon
[973]	265	logexpr2(i,k)=.not.q_seri(i,k).ge.0.
	266	if (logexpr2(i,k)) then
	267	q_seri(i,k)=1.e-15
	268	nbptspb=nbptspb+1
	269	! if (prt_level.ge.10) then
	270	! print*,'WARN eau<0 apres therm i=',i,' k=',k &
	271	! & ,' dq,q',d_q_the(i,k),q_seri(i,k), &
	272	! & 'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k)
[938]	273	endif
[878]	274	! stop
	275	ENDDO
	276	ENDDO
[973]	277	IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb
[878]	278	! tests sur les valeurs de la temperature
[973]	279	nbptspb=0
[878]	280	DO k = 1, klev
	281	DO i = 1, klon
[973]	282	logexpr2(i,k)=t_seri(i,k).lt.50..or.t_seri(i,k).gt.370.
	283	if (logexpr2(i,k)) nbptspb=nbptspb+1
	284	! if ((t_seri(i,k).lt.50.) .or. &
	285	! & (t_seri(i,k).gt.370.)) then
	286	! print*,'WARN temp apres therm i=',i,' k=',k &
	287	! & ,' t_seri',t_seri(i,k)
[878]	288	! CALL abort
[973]	289	! endif
[878]	290	ENDDO
	291	ENDDO
[973]	292	IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb
[878]	293	enddo ! isplit
	294
	295	!
	296	!***************************************************************
	297	! calcul du flux ascencant conservatif
	298	! print*,'<<<<calcul flux ascendant conservatif'
	299
	300	fmc_therm=0.
	301	do k=1,klev
	302	do i=1,klon
	303	if (entr_therm(i,k).gt.0.) then
	304	fmc_therm(i,k+1)=fmc_therm(i,k)+entr_therm(i,k)
	305	else
	306	fmc_therm(i,k+1)=fmc_therm(i,k)
	307	endif
	308	detrc_therm(i,k)=(fmc_therm(i,k+1)-fm_therm(i,k+1)) &
	309	& -(fmc_therm(i,k)-fm_therm(i,k))
	310	enddo
	311	enddo
	312
	313
	314	!****************************************************************
	315	! calcul de l'humidite dans l'ascendance
	316	! print*,'<<<<calcul de lhumidite dans thermique'
	317	!CR:on ne le calcule que pour le cas sec
	318	if (iflag_thermals.le.11) then
	319	do i=1,klon
	320	zqasc(i,1)=q_seri(i,1)
	321	do k=2,klev
	322	if (fmc_therm(i,k+1).gt.1.e-6) then
	323	zqasc(i,k)=(fmc_therm(i,k)*zqasc(i,k-1) &
	324	& +entr_therm(i,k)*q_seri(i,k))/fmc_therm(i,k+1)
	325	!CR:test on asseche le thermique
	326	! zqasc(i,k)=zqasc(i,k)/2.
	327	! else
	328	! zqasc(i,k)=q_seri(i,k)
	329	endif
	330	enddo
	331	enddo
	332
	333
	334	! calcul de l'eau condensee dans l'ascendance
	335	! print*,'<<<<calcul de leau condensee dans thermique'
	336	do i=1,klon
	337	do k=1,klev
	338	clwcon0(i,k)=zqasc(i,k)-zqsat(i,k)
	339	if (clwcon0(i,k).lt.0. .or. &
	340	& (fm_therm(i,k+1)+detrc_therm(i,k)).lt.1.e-6) then
	341	clwcon0(i,k)=0.
	342	endif
	343	enddo
	344	enddo
	345	else
	346	do i=1,klon
	347	do k=1,klev
	348	clwcon0(i,k)=zqla(i,k)
	349	if (clwcon0(i,k).lt.0. .or. &
	350	& (fm_therm(i,k+1)+detrc_therm(i,k)).lt.1.e-6) then
	351	clwcon0(i,k)=0.
	352	endif
	353	enddo
	354	enddo
	355	endif
	356	!*******************************************************************
	357
	358
	359	return
	360
	361	end

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

Download in other formats:

Original Format