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