Index: LMDZ6/trunk/libf/phylmd/calltherm.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/calltherm.F90 (revision 4677) +++ LMDZ6/trunk/libf/phylmd/calltherm.F90 (revision 4678) @@ -4,5 +4,5 @@ subroutine calltherm(dtime & & ,pplay,paprs,pphi,weak_inversion & - & ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & + & ,u_seri_,v_seri_,t_seri_,q_seri_,zqsat,debut & & ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs & & ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth, & @@ -55,6 +55,9 @@ INTEGER nbptspb - REAL u_seri(klon,klev),v_seri(klon,klev) - REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev) + REAL, DIMENSION(klon,klev), INTENT(IN) :: u_seri_,v_seri_ + REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri_,q_seri_ + REAL, DIMENSION(klon,klev) :: u_seri,v_seri + REAL, DIMENSION(klon,klev) :: t_seri,q_seri + REAL, DIMENSION(klon,klev) :: qmemoire REAL weak_inversion(klon) REAL paprs(klon,klev+1) @@ -165,4 +168,9 @@ first=.false. endif + + u_seri(:,:)=u_seri_(:,:) + v_seri(:,:)=v_seri_(:,:) + t_seri(:,:)=t_seri_(:,:) + q_seri(:,:)=q_seri_(:,:) ! Incrementer le compteur de la physique Index: LMDZ6/trunk/libf/phylmd/lmdz_thermcell_main.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/lmdz_thermcell_main.F90 (revision 4677) +++ LMDZ6/trunk/libf/phylmd/lmdz_thermcell_main.F90 (revision 4678) @@ -2,9 +2,11 @@ ! $Id$ ! +! A REGARDER !!!!!!!!!!!!!!!!! +! ATTENTION : zpspsk est inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023) CONTAINS subroutine thermcell_main(itap,ngrid,nlay,ptimestep & & ,pplay,pplev,pphi,debut & - & ,pu,pv,pt,po & + & ,pu,pv,pt,p_o & & ,pduadj,pdvadj,pdtadj,pdoadj & & ,fm0,entr0,detr0,zqta,zqla,lmax & @@ -104,6 +106,6 @@ real, intent(in) :: ptimestep real, intent(in), dimension(ngrid,nlay) :: pt,pu,pv,pplay,pphi -! ATTENTION : po et zpspsk sont inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023) - real, intent(inout), dimension(ngrid,nlay) :: po +! ATTENTION : zpspsk est inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023) + real, intent(in), dimension(ngrid,nlay) :: p_o real, intent(out), dimension(ngrid,nlay) :: zpspsk real, intent(in), dimension(ngrid,nlay+1) :: pplev @@ -142,5 +144,5 @@ integer,dimension(ngrid) :: lmin,lmix,lmix_bis,nivcon real, dimension(ngrid,nlay) :: ztva_est - real, dimension(ngrid,nlay) :: deltaz,zlay,zh,zdthladj,zu,zv,zo,zl,zva,zua,zoa + real, dimension(ngrid,nlay) :: deltaz,zlay,zh,zdthladj,zu,zv,z_o,zl,zva,zua,z_oa real, dimension(ngrid,nlay) :: zta,zha,q2,wq,wthl,wthv,thetath2,wth2 real, dimension(ngrid,nlay) :: rho,masse @@ -200,6 +202,6 @@ ! -------------------------------------------------------------------- ! - CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay, & - & pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out) + CALL thermcell_env(ngrid,nlay,p_o,pt,pu,pv,pplay, & + & pplev,z_o,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out) if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env' @@ -215,5 +217,5 @@ ! wh,wt,wo ... ! -! + + + + + + + + + + + zh,zu,zv,zo,rho +! + + + + + + + + + + + zh,zu,zv,z_o,rho ! ! @@ -343,5 +345,5 @@ if (iflag_thermals_ed<=9) then ! print*,'THERM NOUVELLE/NOUVELLE Arnaud' - CALL thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& + CALL thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,& & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & @@ -351,5 +353,5 @@ elseif (iflag_thermals_ed<=19) then ! print*,'THERM RIO et al 2010, version d Arnaud' - CALL thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& + CALL thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,& & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & @@ -357,5 +359,5 @@ & ,lev_out,lunout1,igout) else - CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& + CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,& & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & @@ -366,6 +368,6 @@ if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out - call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ') - call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix ') + call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_plum lalim ') + call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_plum lmix ') if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume' @@ -395,8 +397,8 @@ - call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ') - call test_ltherm(ngrid,nlay,pplay,lmin ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin ') - call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix ') - call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax ') + call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lalim ') + call test_ltherm(ngrid,nlay,pplay,lmin ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmin ') + call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmix ') + call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmax ') if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height' @@ -411,6 +413,6 @@ -call test_ltherm(ngrid,nlay,pplay,lmin,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lmin ') -call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lalim ') +call test_ltherm(ngrid,nlay,pplay,lmin,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_dry lmin ') +call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_dry lalim ') if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry' @@ -477,6 +479,6 @@ if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux' - call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ') - call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax ') + call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_flux lalim ') + call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_flux lmax ') !------------------------------------------------------------------ @@ -523,5 +525,5 @@ ! we want to transport potential temperature, total water and momentum CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zthl,zdthladj) - CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,po,pdoadj) + CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,p_o,pdoadj) CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zu,pduadj) CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zv,pdvadj) @@ -531,6 +533,13 @@ call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & & zthl,zdthladj,zta,lev_out) + + do ll=1,nlay + print*,'Z_O ',ll,z_o(1,ll),p_o(1,ll)-z_o(1,ll) + do ig=1,ngrid + z_o(ig,ll)=p_o(ig,ll) + enddo + enddo call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & - & po,pdoadj,zoa,lev_out) + & z_o,pdoadj,z_oa,lev_out) #ifdef ISO @@ -565,5 +574,5 @@ if (iso_HDO.gt.0) then call iso_verif_aberrant_encadre(xtpo(iso_hdo,ig,ll) & - & /po(ig,ll),'thermcell_main 610') + & /p_o(ig,ll),'thermcell_main 610') endif enddo @@ -623,6 +632,6 @@ !nouveau calcul do ig=1,ngrid - CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1)) - pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI + CHI=zh(ig,1)/(1669.0-122.0*z_o(ig,1)/zqsat(ig,1)-zh(ig,1)) + pcon(ig)=pplay(ig,1)*(z_o(ig,1)/zqsat(ig,1))**CHI enddo !IM do k=1,nlay @@ -685,7 +694,7 @@ wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l)) & & *zw2(ig,l)*zw2(ig,l)*zw2(ig,l) - q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2 -!test: on calcul q2/po=ratqsc - ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.)) + q2(ig,l)=zf2*(zqta(ig,l)*1000.-p_o(ig,l)*1000.)**2 +!test: on calcul q2/p_o=ratqsc + ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(p_o(ig,l)*1000.)) enddo enddo @@ -693,5 +702,5 @@ do l=1,nlay do ig=1,ngrid - wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-po(ig,l)*1000.) + wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-p_o(ig,l)*1000.) wthl(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztla(ig,l)-zthl(ig,l)) wthv(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztva(ig,l)-ztv(ig,l)) @@ -728,5 +737,5 @@ do l=1,nlay do ig=1,ngrid - ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.) + ratqsdiff(ig,l)=sqrt(vardiff)/(p_o(ig,l)*1000.) enddo enddo @@ -741,5 +750,5 @@ !///////////////////////////////////////////////////////////////////////////// !============================================================================= - subroutine test_ltherm(ngrid,nlay,pplay,long,ztv,po,ztva, & ! in + subroutine test_ltherm(ngrid,nlay,pplay,long,ztv,p_o,ztva, & ! in & zqla,f_star,zw2,comment) ! in !============================================================================= @@ -748,5 +757,5 @@ integer i, k, ngrid,nlay - real, intent(in), dimension(ngrid,nlay) :: pplay,ztv,po,ztva,zqla + real, intent(in), dimension(ngrid,nlay) :: pplay,ztv,p_o,ztva,zqla real, intent(in), dimension(ngrid,nlay) :: f_star,zw2 integer, intent(in), dimension(ngrid) :: long @@ -768,5 +777,5 @@ print*,' K P(MB) THV(K) Qenv(g/kg)THVA QLA(g/kg) F* W2' do k=1,nlay - write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k) + write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*p_o(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k) enddo endif Index: LMDZ6/trunk/libf/phylmd/lmdz_thermcell_plume_6A.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/lmdz_thermcell_plume_6A.F90 (revision 4677) +++ LMDZ6/trunk/libf/phylmd/lmdz_thermcell_plume_6A.F90 (revision 4678) @@ -734,5 +734,5 @@ REAL ztv(ngrid,nlay) REAL zthl(ngrid,nlay) - REAL po(ngrid,nlay) + REAL, INTENT(IN) :: po(ngrid,nlay) REAL zl(ngrid,nlay) REAL rhobarz(ngrid,nlay) Index: LMDZ6/trunk/libf/phylmd/physiq_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (revision 4677) +++ LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (revision 4678) @@ -1255,4 +1255,5 @@ INTEGER ieru +print*,'COUCOU COUCOU' !======================================================================! ! Bifurcation vers un nouveau moniteur physique pour experimenter !