! ! AC 2011-01-05 ! SUBROUTINE calltherm_interface (ngrid,nlayer,firstcall, & & long,lati,zzlev,zzlay, & & ptimestep,pu,pv,pt,pq,pdu,pdv,pdt,pdq,q2, & & pplay,pplev,pphi,nq,zpopsk, & & pdu_th,pdv_th,pdt_th,pdq_th,lmax_th,pbl_dtke,hfmax,wmax) USE ioipsl_getincom implicit none #include "callkeys.h" !-------------------------------------------------------- ! Variables d'entree !-------------------------------------------------------- INTEGER, INTENT(IN) :: ngrid,nlayer,nq REAL, INTENT(IN) :: ptimestep REAL, INTENT(IN) :: pplev(ngrid,nlayer+1),pplay(ngrid,nlayer) REAL, INTENT(IN) :: pphi(ngrid,nlayer) REAL, INTENT(IN) :: pu(ngrid,nlayer),pv(ngrid,nlayer) REAL, INTENT(IN) :: pt(ngrid,nlayer),pq(ngrid,nlayer,nq) REAL, INTENT(IN) :: zzlay(ngrid,nlayer) REAL, INTENT(IN) :: zzlev(ngrid,nlayer+1) LOGICAL, INTENT(IN) :: firstcall REAL, INTENT(IN) :: pdu(ngrid,nlayer),pdv(ngrid,nlayer) REAL, INTENT(IN) :: pdq(ngrid,nlayer,nq),pdt(ngrid,nlayer) REAL, INTENT(IN) :: q2(ngrid,nlayer+1) REAL, INTENT(IN) :: long(ngrid),lati(ngrid) REAL, INTENT(IN) :: zpopsk(ngrid,nlayer) !-------------------------------------------------------- ! Variables de sortie (ou entree/sortie) !-------------------------------------------------------- REAL pdu_th(ngrid,nlayer),pdv_th(ngrid,nlayer) REAL pdt_th(ngrid,nlayer),pdq_th(ngrid,nlayer,nq) INTEGER lmax_th(ngrid) REAL pbl_dtke(ngrid,nlayer+1) !-------------------------------------------------------- ! Variables du thermique !-------------------------------------------------------- REAL u_seri(ngrid,nlayer), v_seri(ngrid,nlayer) REAL t_seri(ngrid,nlayer) REAL d_t_ajs(ngrid,nlayer) REAL d_u_ajs(ngrid,nlayer), d_q_ajs(ngrid,nlayer,nq) REAL d_v_ajs(ngrid,nlayer) REAL fm_therm(ngrid,nlayer+1), entr_therm(ngrid,nlayer) REAL detr_therm(ngrid,nlayer) REAL zw2(ngrid,nlayer+1) REAL fraca(ngrid,nlayer+1) REAL ztla(ngrid,nlayer) REAL q_therm(ngrid,nlayer), pq_therm(ngrid,nlayer,nq) REAL dq_therm(ngrid,nlayer), dq_thermdown(ngrid,nlayer) REAL q2_therm(ngrid,nlayer), dq2_therm(ngrid,nlayer) LOGICAL qtransport_thermals,dtke_thermals INTEGER l,ig,iq ! Variable de diagnostique : flux de chaleur vertical REAL heatFlux(ngrid,nlayer) REAL heatFlux_down(ngrid,nlayer) REAL buoyancyOut(ngrid,nlayer) REAL buoyancyEst(ngrid,nlayer) REAL hfmax(ngrid),wmax(ngrid) !--------------------------------------------------------- !--------------------------------------------------------- ! ********************************************************************** ! Thermique ! ********************************************************************** ! Initialisation des sorties lmax_th(:)=1 pdu_th(:,:)=0. pdv_th(:,:)=0. pdt_th(:,:)=0. entr_therm(:,:)=0. detr_therm(:,:)=0. q2_therm(:,:)=0. dq2_therm(:,:)=0. dq_therm(:,:)=0. dq_thermdown(:,:)=0. ztla(:,:)=0. pbl_dtke(:,:)=0. fm_therm(:,:)=0. zw2(:,:)=0. fraca(:,:)=0. if (tracer) then pdq_th(:,:,:)=0. end if ! Dans le model terrestres, les seri sont des q+dq tendances déja cumulées. Il n'y a donc pas de ! cumulage à l'intérieur de la routine comme dans le model martien. On le fait ici : u_seri(:,:)=pu(:,:)+pdu(:,:)*ptimestep v_seri(:,:)=pv(:,:)+pdv(:,:)*ptimestep t_seri(:,:)=pt(:,:)+pdt(:,:)*ptimestep pq_therm(:,:,:)=0. qtransport_thermals=.true. call getin("qtransport_thermals",qtransport_thermals) if(qtransport_thermals) then if(tracer) then pq_therm(:,:,:)=pq(:,:,:)+pdq(:,:,:)*ptimestep endif endif d_t_ajs(:,:)=0. d_u_ajs(:,:)=0. d_v_ajs(:,:)=0. d_q_ajs(:,:,:)=0. heatFlux(:,:)=0. heatFlux_down(:,:)=0. buoyancyOut(:,:)=0. buoyancyEst(:,:)=0. dtke_thermals=.false. call getin("dtke_thermals",dtke_thermals) if(dtke_thermals) then DO l=1,nlayer q2_therm(:,l)=0.5*(q2(:,l)+q2(:,l+1)) ENDDO endif CALL calltherm_mars(ngrid,nlayer,ptimestep,nq,zzlev,zzlay & & ,pplay,pplev,pphi & & ,u_seri,v_seri,t_seri,pq_therm, q2_therm & & ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs, dq2_therm & & ,fm_therm,entr_therm,detr_therm & & ,lmax_th & & ,zw2,fraca & & ,zpopsk,ztla,heatFlux,heatFlux_down & & ,buoyancyOut,buoyancyEst,hfmax,wmax) ! Accumulation des tendances. On n'accumule pas les quantités de traceurs car celle ci n'a pas du changer ! étant donné qu'on ne prends en compte que q_seri de la vap d'eau = 0 ! INCREMENTATION : les d_u_ sont des tendances alors que les pdu sont des dérivees, attention ! pdu_th(:,:)=d_u_ajs(:,:)/ptimestep pdv_th(:,:)=d_v_ajs(:,:)/ptimestep pdt_th(:,:)=d_t_ajs(:,:)/ptimestep if(qtransport_thermals) then if(tracer) then pdq_th(:,:,:)=d_q_ajs(:,:,:)/ptimestep endif endif DO l=2,nlayer pbl_dtke(:,l)=0.5*(dq2_therm(:,l-1)+dq2_therm(:,l))/ptimestep ENDDO pbl_dtke(:,1)=0.5*dq2_therm(:,1)/ptimestep pbl_dtke(:,nlayer+1)=0. !! DIAGNOSTICS if(outptherm) then if (ngrid .eq. 1) then call WRITEDIAGFI(ngrid,'entr_therm','entrainement thermique',& & 'kg/m-2',1,entr_therm) call WRITEDIAGFI(ngrid,'detr_therm','detrainement thermique',& & 'kg/m-2',1,detr_therm) call WRITEDIAGFI(ngrid,'fm_therm','flux masse thermique',& & 'kg/m-2',1,fm_therm) call WRITEDIAGFI(ngrid,'zw2','vitesse verticale thermique',& & 'm/s',1,zw2) call WRITEDIAGFI(ngrid,'heatFlux_up','heatFlux_updraft',& & 'SI',1,heatFlux) call WRITEDIAGFI(ngrid,'heatFlux_down','heatFlux_downdraft',& & 'SI',1,heatFlux_down) call WRITEDIAGFI(ngrid,'fraca','fraction coverage',& & 'percent',1,fraca) call WRITEDIAGFI(ngrid,'buoyancyOut','buoyancyOut',& & 'm.s-2',1,buoyancyOut) call WRITEDIAGFI(ngrid,'buoyancyEst','buoyancyEst',& & 'm.s-2',1,buoyancyEst) call WRITEDIAGFI(ngrid,'d_t_th', & & 'tendance temp TH','K',1,d_t_ajs) else call WRITEDIAGFI(ngrid,'entr_therm','entrainement thermique',& & 'kg/m-2',3,entr_therm) call WRITEDIAGFI(ngrid,'detr_therm','detrainement thermique',& & 'kg/m-2',3,detr_therm) call WRITEDIAGFI(ngrid,'fm_therm','flux masse thermique',& & 'kg/m-2',3,fm_therm) call WRITEDIAGFI(ngrid,'zw2','vitesse verticale thermique',& & 'm/s',3,zw2) call WRITEDIAGFI(ngrid,'heatFlux','heatFlux',& & 'SI',3,heatFlux) call WRITEDIAGFI(ngrid,'buoyancyOut','buoyancyOut',& & 'SI',3,buoyancyOut) call WRITEDIAGFI(ngrid,'d_t_th', & & 'tendance temp TH','K',3,d_t_ajs) endif endif END