| 1 | !======================================================================= |
|---|
| 2 | ! THERMCELL_DQUP |
|---|
| 3 | !======================================================================= |
|---|
| 4 | ! |
|---|
| 5 | ! Compute the thermals contribution of explicit thermals |
|---|
| 6 | ! to vertical transport in the PBL. |
|---|
| 7 | ! dq is computed once upward, entrainment and detrainment mass fluxes |
|---|
| 8 | ! are known. |
|---|
| 9 | ! |
|---|
| 10 | ! Version with sub-timestep for Martian thin layers |
|---|
| 11 | ! |
|---|
| 12 | !======================================================================= |
|---|
| 13 | ! Author : A. Colaitis 2011-01-05 (with updates 2011-2013) |
|---|
| 14 | ! Institution : Laboratoire de Meteorologie Dynamique (LMD) Paris, France |
|---|
| 15 | ! ----------------------------------------------------------------------- |
|---|
| 16 | ! Corresponding author : A. Spiga aymeric.spiga_AT_upmc.fr |
|---|
| 17 | ! ----------------------------------------------------------------------- |
|---|
| 18 | ! Reference paper: |
|---|
| 19 | ! A. Colaïtis, A. Spiga, F. Hourdin, C. Rio, F. Forget, and E. Millour. |
|---|
| 20 | ! A thermal plume model for the Martian convective boundary layer. |
|---|
| 21 | ! Journal of Geophysical Research (Planets), 118:1468-1487, July 2013. |
|---|
| 22 | ! http://dx.doi.org/10.1002/jgre.20104 |
|---|
| 23 | ! http://arxiv.org/abs/1306.6215 |
|---|
| 24 | ! ----------------------------------------------------------------------- |
|---|
| 25 | |
|---|
| 26 | subroutine thermcell_dqup(ngrid,nlayer,ptimestep,fm,entr,detr, & |
|---|
| 27 | & masse0,q_therm,dq_therm,ndt,zlmax) |
|---|
| 28 | implicit none |
|---|
| 29 | |
|---|
| 30 | ! ============================ INPUTS ============================ |
|---|
| 31 | |
|---|
| 32 | INTEGER, INTENT(IN) :: ngrid,nlayer ! number of grid points and number of levels |
|---|
| 33 | REAL, INTENT(IN) :: ptimestep ! timestep (s) |
|---|
| 34 | REAL, INTENT(IN) :: fm(ngrid,nlayer+1) ! upward mass flux |
|---|
| 35 | REAL, INTENT(IN) :: entr(ngrid,nlayer) ! entrainment mass flux |
|---|
| 36 | REAL, INTENT(IN) :: detr(ngrid,nlayer) ! detrainment mass flux |
|---|
| 37 | REAL, INTENT(IN) :: q_therm(ngrid,nlayer) ! initial profil of q |
|---|
| 38 | REAL, INTENT(IN) :: masse0(ngrid,nlayer) ! mass of cells |
|---|
| 39 | INTEGER, INTENT(IN) :: ndt ! number of subtimesteps |
|---|
| 40 | INTEGER, INTENT(IN) :: zlmax ! index of maximum layer |
|---|
| 41 | |
|---|
| 42 | ! ============================ OUTPUTS =========================== |
|---|
| 43 | |
|---|
| 44 | REAL, INTENT(OUT) :: dq_therm(ngrid,nlayer) ! dq/dt -> derivative |
|---|
| 45 | |
|---|
| 46 | ! ============================ LOCAL ============================= |
|---|
| 47 | |
|---|
| 48 | REAL q(ngrid,nlayer) |
|---|
| 49 | REAL qa(ngrid,nlayer) |
|---|
| 50 | INTEGER ig,k,i |
|---|
| 51 | REAL invflux0(ngrid,nlayer) |
|---|
| 52 | REAL ztimestep |
|---|
| 53 | |
|---|
| 54 | ! =========== Init ============================================== |
|---|
| 55 | |
|---|
| 56 | qa(:,:)=q_therm(:,:) !q profile in the updraft |
|---|
| 57 | q(:,:)=q_therm(:,:) !mean q profile |
|---|
| 58 | |
|---|
| 59 | ! ====== Computing q ============================================ |
|---|
| 60 | ! Based on equation 14 in appendix 4.2 |
|---|
| 61 | |
|---|
| 62 | dq_therm(:,:)=0. |
|---|
| 63 | ztimestep=ptimestep/real(ndt) |
|---|
| 64 | invflux0(:,:)=ztimestep/masse0(:,:) |
|---|
| 65 | |
|---|
| 66 | do i=1,ndt !subtimestep loop |
|---|
| 67 | |
|---|
| 68 | do ig=1,ngrid |
|---|
| 69 | qa(ig,1)=q(ig,1) |
|---|
| 70 | enddo |
|---|
| 71 | |
|---|
| 72 | do k=2,zlmax |
|---|
| 73 | do ig=1,ngrid |
|---|
| 74 | if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. & |
|---|
| 75 | & 1.e-5*masse0(ig,k)) then |
|---|
| 76 | qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) & |
|---|
| 77 | & /(fm(ig,k+1)+detr(ig,k)) |
|---|
| 78 | else |
|---|
| 79 | qa(ig,k)=q(ig,k) |
|---|
| 80 | endif |
|---|
| 81 | enddo |
|---|
| 82 | enddo |
|---|
| 83 | |
|---|
| 84 | do k=1,zlmax |
|---|
| 85 | q(:,k)=q(:,k)+ & |
|---|
| 86 | & (detr(:,k)*qa(:,k)-entr(:,k)*q(:,k) & |
|---|
| 87 | & -fm(:,k)*q(:,k)+fm(:,k+1)*q(:,k+1)) & |
|---|
| 88 | & *invflux0(:,k) |
|---|
| 89 | enddo |
|---|
| 90 | |
|---|
| 91 | enddo !of do i=1,ndt |
|---|
| 92 | |
|---|
| 93 | ! ====== Derivative ============================================== |
|---|
| 94 | |
|---|
| 95 | do k=1,zlmax |
|---|
| 96 | dq_therm(:,k)=(q(:,k)-q_therm(:,k))/ptimestep |
|---|
| 97 | enddo |
|---|
| 98 | |
|---|
| 99 | ! ============== |
|---|
| 100 | |
|---|
| 101 | return |
|---|
| 102 | end |
|---|
| 103 | |
|---|
