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

Last change on this file was 3342, checked in by alesaux, 6 months ago

GenericPCM: Adapts the Thermal Plume Model for generic tracers.
Adds variables such as vteta in writediagfi section.
ALS
File size: 5.3 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      !ALS24 initialises qa in first layer
105      DO ig=1,ngrid
106         qa(ig,1) = q(ig,1)
107      ENDDO
108
109      DO ig=1,ngrid
110         DO l=2,nlay
111            IF ((fm(ig,l+1)+detr(ig,l))*ptimestep > 1.e-6*masse(ig,l)) THEN
112               qa(ig,l) = (fm(ig,l) * qa(ig,l-1) + entr(ig,l) * q(ig,l))      &
113               &        / (fm(ig,l+1) + detr(ig,l))
114            ELSE
115               qa(ig,l) = q(ig,l)
116            ENDIF
117         ENDDO
118      ENDDO
119     
120!-------------------------------------------------------------------------------
121! Plume vertical flux of tracer
122!-------------------------------------------------------------------------------
123     
124      DO l=2,nlay-1
125         fqa(:,l) = fm(:,l) * qa(:,l-1)
126      ENDDO
127     
128      fqa(:,1) = 0.
129      fqa(:,nlay) = 0.
130     
131!-------------------------------------------------------------------------------
132! Trace species evolution
133!-------------------------------------------------------------------------------
134     
135      IF (dqimpl) THEN
136         DO l=nlay-1,1,-1
137            q(:,l) = ( q(:,l) + ptimestep / masse(:,l)                        &
138            &      * ( fqa(:,l) - fqa(:,l+1) + fm(:,l+1) * q(:,l+1) ) )       &
139            &      / ( 1. + fm(:,l) * ptimestep / masse(:,l) )
140         ENDDO
141      ELSE
142         DO l=1,nlay-1
143            q(:,l) = q(:,l) + (fqa(:,l) - fqa(:,l+1) - fm(:,l) * q(:,l)       &
144            &      + fm(:,l+1) * q(:,l+1)) * ptimestep / masse(:,l)
145         ENDDO
146      ENDIF
147     
148!===============================================================================
149! Tendencies
150!===============================================================================
151     
152      DO l=1,nlay
153         DO ig=1,ngrid
154            dq(ig,l) = (q(ig,l) - qold(ig,l)) / ptimestep
155            q(ig,l) = qold(ig,l)
156         ENDDO
157      ENDDO
158     
159     
160RETURN
161END
Note: See TracBrowser for help on using the repository browser.