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,limz) |
---|
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) :: limz ! 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,limz |
---|
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,limz |
---|
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,limz |
---|
96 | dq_therm(:,k)=(q(:,k)-q_therm(:,k))/ptimestep |
---|
97 | enddo |
---|
98 | |
---|
99 | ! ============== |
---|
100 | |
---|
101 | return |
---|
102 | end |
---|
103 | |
---|