source: trunk/LMDZ.GENERIC/libf/phystd/thermcell_dq.F90 @ 2613

Last change on this file since 2613 was 2229, checked in by aboissinot, 5 years ago

A bug in thermcell_dq is fixed. Now zqt is correctly initialized when tracer h2o_vap
is missing (consistency with flag water is assumed).

Useless arguments in thermcell_dq subroutine are removed (lmin, lmax)
File size: 5.2 KB
Line 
1!
2!
3!
4SUBROUTINE thermcell_dq(ngrid,nlay,ptimestep,fm,entr,detr,masse,              &
5                        q,dq,qa)
6     
7     
8!===============================================================================
9!  Purpose: Calcul du transport verticale dans la couche limite en presence de
10!           "thermiques" explicitement representes
11!           Calcul du dq/dt une fois qu'on connait les ascendances
12! 
13!  Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr)
14!  Introduction of an implicit computation of vertical advection in the environ-
15!     ment of thermal plumes in thermcell_dq
16! 
17!  Modif 2019/04 (AB alexandre.boissinot@lmd.jussieu.fr)
18!     dqimpl = true  : implicit scheme
19!     dqimpl = false : explicit scheme
20! 
21!===============================================================================
22     
23      USE print_control_mod, ONLY: prt_level
24      USE thermcell_mod, ONLY: dqimpl
25     
26      IMPLICIT NONE
27     
28     
29!===============================================================================
30! Declaration
31!===============================================================================
32     
33!     Inputs:
34!     -------
35     
36      INTEGER, INTENT(in) :: ngrid
37      INTEGER, INTENT(in) :: nlay
38     
39      REAL, INTENT(in) :: ptimestep
40      REAL, INTENT(in) :: masse(ngrid,nlay)
41      REAL, INTENT(in) :: fm(ngrid,nlay+1)
42      REAL, INTENT(in) :: entr(ngrid,nlay)
43      REAL, INTENT(in) :: detr(ngrid,nlay)
44     
45!     Outputs:
46!     --------
47     
48      REAL, INTENT(inout) :: q(ngrid,nlay)
49      REAL, INTENT(out) :: dq(ngrid,nlay)
50      REAL, INTENT(out) :: qa(ngrid,nlay)
51     
52!     Local:
53!     ------
54     
55      INTEGER ig, l, k
56      INTEGER niter, iter
57     
58      REAL cfl
59      REAL qold(ngrid,nlay)
60      REAL fqa(ngrid,nlay+1)
61      REAL zzm
62     
63!===============================================================================
64! Initialization
65!===============================================================================
66     
67      qold(:,:) = q(:,:)
68     
69!===============================================================================
70! Tracer variation computation
71!===============================================================================
72     
73!-------------------------------------------------------------------------------
74! CFL criterion computation for advection in downdraft
75!-------------------------------------------------------------------------------
76     
77      cfl = 0.
78     
79      DO l=1,nlay
80         DO ig=1,ngrid
81            zzm = masse(ig,l) / ptimestep
82            cfl = max(cfl, fm(ig,l) / zzm)
83           
84            IF (entr(ig,l) > zzm) THEN
85               print *, 'ERROR: entrainment is greater than the layer mass!'
86               print *, 'ig,l,entr', ig, l, entr(ig,l)
87               print *, '-------------------------------'
88               print *, 'entr*dt,mass', entr(ig,l)*ptimestep, masse(ig,l)
89               print *, '-------------------------------'
90               DO k=nlay,1,-1
91                  print *, 'fm ', fm(ig,k+1)
92                  print *, 'entr,detr', entr(ig,k), detr(ig,k)
93               ENDDO
94               print *, 'fm ', fm(ig,1)
95               print *, '-------------------------------'
96               CALL abort
97            ENDIF
98         ENDDO
99      ENDDO
100     
101!-------------------------------------------------------------------------------
102! Computation of tracer concentrations in the ascending plume
103!-------------------------------------------------------------------------------
104     
105      DO ig=1,ngrid
106         DO l=1,nlay
107            IF ((fm(ig,l+1)+detr(ig,l))*ptimestep > 1.e-6*masse(ig,l)) THEN
108               qa(ig,l) = (fm(ig,l) * qa(ig,l-1) + entr(ig,l) * q(ig,l))      &
109               &        / (fm(ig,l+1) + detr(ig,l))
110            ELSE
111               qa(ig,l) = q(ig,l)
112            ENDIF
113         ENDDO
114      ENDDO
115     
116!-------------------------------------------------------------------------------
117! Plume vertical flux of tracer
118!-------------------------------------------------------------------------------
119     
120      DO l=2,nlay-1
121         fqa(:,l) = fm(:,l) * qa(:,l-1)
122      ENDDO
123     
124      fqa(:,1) = 0.
125      fqa(:,nlay) = 0.
126     
127!-------------------------------------------------------------------------------
128! Trace species evolution
129!-------------------------------------------------------------------------------
130     
131      IF (dqimpl) THEN
132         DO l=nlay-1,1,-1
133            q(:,l) = ( q(:,l) + ptimestep / masse(:,l)                        &
134            &      * ( fqa(:,l) - fqa(:,l+1) + fm(:,l+1) * q(:,l+1) ) )       &
135            &      / ( 1. + fm(:,l) * ptimestep / masse(:,l) )
136         ENDDO
137      ELSE
138         DO l=1,nlay-1
139            q(:,l) = q(:,l) + (fqa(:,l) - fqa(:,l+1) - fm(:,l) * q(:,l)       &
140            &      + fm(:,l+1) * q(:,l+1)) * ptimestep / masse(:,l)
141         ENDDO
142      ENDIF
143     
144!===============================================================================
145! Tendencies
146!===============================================================================
147     
148      DO l=1,nlay
149         DO ig=1,ngrid
150            dq(ig,l) = (q(ig,l) - qold(ig,l)) / ptimestep
151            q(ig,l) = qold(ig,l)
152         ENDDO
153      ENDDO
154     
155     
156RETURN
157END
Note: See TracBrowser for help on using the repository browser.