! ! ! SUBROUTINE thermcell_dq(ngrid,nlay,ptimestep,fm,entr,detr,masse, & q,dq,qa,lmin) !=============================================================================== ! Purpose: Calcul du transport verticale dans la couche limite en presence de ! "thermiques" explicitement representes ! Calcul du dq/dt une fois qu'on connait les ascendances ! ! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr) ! Introduction of an implicit computation of vertical advection in the environ- ! ment of thermal plumes in thermcell_dq ! ! Modif 2019/04 (AB alexandre.boissinot@lmd.jussieu.fr) ! dqimpl = 1 : implicit scheme ! dqimpl = 0 : explicit scheme ! !=============================================================================== USE print_control_mod, ONLY: prt_level USe thermcell_mod, ONLY: dqimpl IMPLICIT NONE !=============================================================================== ! Declaration !=============================================================================== ! Inputs: ! ------- INTEGER ngrid, nlay INTEGER lmin(ngrid) REAL ptimestep REAL masse(ngrid,nlay) REAL fm(ngrid,nlay+1) REAL entr(ngrid,nlay) REAL detr(ngrid,nlay) REAL q(ngrid,nlay) ! Outputs: ! -------- REAL dq(ngrid,nlay) REAL qa(ngrid,nlay) ! Local: ! ------ INTEGER ig, l INTEGER niter, iter REAL cfl REAL qold(ngrid,nlay) REAL fqa(ngrid,nlay+1) REAL wqd(ngrid,nlay+1) REAL zzm !=============================================================================== ! Initialization !=============================================================================== qold(:,:) = q(:,:) !=============================================================================== ! Tracer variation computation !=============================================================================== !------------------------------------------------------------------------------- ! CFL criterion computation for advection in downdraft !------------------------------------------------------------------------------- cfl = 0. DO l=1,nlay DO ig=1,ngrid zzm = masse(ig,l) / ptimestep cfl = max(cfl, fm(ig,l) / zzm) IF (entr(ig,l).gt.zzm) THEN print *, 'ERROR: entrainment is greater than the layer mass!' print *, 'ig,l,entr', ig, l, entr(ig,l) print *, '-------------------------------' print *, 'entr*dt,mass', entr(ig,l)*ptimestep, masse(ig,l) print *, '-------------------------------' print *, 'fm+', fm(ig,l+1) print *, 'entr,detr', entr(ig,l), detr(ig,l) print *, 'fm ', fm(ig,l) print *, 'entr,detr', entr(ig,l-1), detr(ig,l-1) print *, 'fm-', fm(ig,l-1) CALL abort ENDIF ENDDO ENDDO !------------------------------------------------------------------------------- ! Computation of tracer concentrations in the ascending plume !------------------------------------------------------------------------------- DO ig=1,ngrid DO l=1,lmin(ig) qa(ig,l) = q(ig,l) ENDDO ENDDO DO ig=1,ngrid DO l=lmin(ig)+1,nlay IF ((fm(ig,l+1)+detr(ig,l))*ptimestep.gt.1.e-6*masse(ig,l)) THEN qa(ig,l) = (fm(ig,l) * qa(ig,l-1) + entr(ig,l) * q(ig,l)) & & / (fm(ig,l+1) + detr(ig,l)) ELSE qa(ig,l) = q(ig,l) ENDIF ! IF (qa(ig,l).lt.0.) THEN ! print *, 'WARNING: qa is negative!' ! print *, 'qa', qa(ig,l) ! ENDIF ! IF (q(ig,l).lt.0.) THEN ! print *, 'WARNING: q is negative!' ! print *, 'q', q(ig,l) ! ENDIF ENDDO ENDDO !------------------------------------------------------------------------------- ! Plume vertical flux of tracer !------------------------------------------------------------------------------- DO l=2,nlay-1 fqa(:,l) = fm(:,l) * qa(:,l-1) ENDDO fqa(:,1) = 0. fqa(:,nlay) = 0. !------------------------------------------------------------------------------- ! Trace species evolution !------------------------------------------------------------------------------- IF (dqimpl==0) THEN DO l=1,nlay-1 q(:,l) = q(:,l) + (fqa(:,l) - fqa(:,l+1) - fm(:,l) * q(:,l) & & + fm(:,l+1) * q(:,l+1)) * ptimestep / masse(:,l) ENDDO ELSEIF (dqimpl==1) THEN DO l=nlay-1,1,-1 q(:,l) = ( q(:,l) + ptimestep / masse(:,l) & & * ( fqa(:,l) - fqa(:,l+1) + fm(:,l+1) * q(:,l+1) ) ) & & / ( 1. + fm(:,l) * ptimestep / masse(:,l) ) ENDDO ELSE print *, 'ERROR: No corresponding scheme for mixing computations!' print *, ' dqimpl must be equal to 1, 0 or -1 but' print *, 'dqimpl =', dqimpl call abort ENDIF !=============================================================================== ! Tendencies !=============================================================================== DO l=1,nlay DO ig=1,ngrid dq(ig,l) = (q(ig,l) - qold(ig,l)) / ptimestep q(ig,l) = qold(ig,l) ENDDO ENDDO RETURN END