source: trunk/LMDZ.PLUTO/libf/phypluto/mass_redistribution_mod.F90 @ 3244

Last change on this file since 3244 was 3184, checked in by afalco, 2 years ago

Pluto PCM:
Added LMDZ.PLUTO, a copy of the generic model,
cleaned from some unnecessary modules (water, ...)
AF

File size: 12.7 KB
Line 
1MODULE mass_redistribution_mod
2
3CONTAINS
4
5SUBROUTINE mass_redistribution(ngrid,nlayer,nq,ptimestep,   &
6                       pcapcal,pplay,pplev,pt,ptsrf,pq,pqs,     &
7                       pu,pv,pdt,pdtsrf,pdq,pdu,pdv,pdmassmr,  &
8                       pdtmr,pdtsrfmr,pdpsrfmr,pdumr,pdvmr,pdqmr,pdqsmr)
9                                                   
10       use radcommon_h, only: glat
11       USE planete_mod, only: bp
12       use comcstfi_mod, only: g
13       
14       IMPLICIT NONE
15!=======================================================================
16!   subject:
17!   --------
18!     Mass and momentum fluxes through sigma levels as the surface pressure is modified are also taken into account
19!
20!   author:   Jeremy Leconte 2012 (from F.Forget 1998)
21!   ------
22!
23!   input:
24!   -----
25!    ngrid                 nombre de points de verticales
26!                          (toutes les boucles de la physique sont au
27!                          moins vectorisees sur ngrid)
28!    nlayer                nombre de couches
29!    pplay(ngrid,nlayer)   Pressure levels
30!    pplev(ngrid,nlayer+1) Pressure levels
31!    nq                    Number of tracers
32!
33!    pt(ngrid,nlayer)      temperature (en K)
34!    pq(ngrid,nlayer,nq)   tracer specific concentration (kg/kg of air)
35!    pu,pv (ngrid,nlayer)  wind velocity (m/s)
36!
37!                   
38!    pdX                   physical tendency of X before mass redistribution
39!
40!    pdmassmr                air Mass added to the atmosphere in each layer (kg/m2/s)
41!
42!   output:
43!   -------
44!
45!    pdXmr(ngrid)           physical tendency of X after mass redistribution
46!
47!   
48!
49!=======================================================================
50!
51!    0.  Declarations :
52!    ------------------
53
54!-----------------------------------------------------------------------
55!    Arguments :
56!    ---------
57      INTEGER,INTENT(IN) :: ngrid, nlayer, nq   
58      REAL,INTENT(IN) :: ptimestep
59      REAL,INTENT(IN) :: pcapcal(ngrid)
60      REAL,INTENT(IN) :: pplay(ngrid,nlayer),pplev(ngrid,nlayer+1)
61      REAL,INTENT(IN) :: pt(ngrid,nlayer),pdt(ngrid,nlayer)
62      REAL,INTENT(IN) :: ptsrf(ngrid),pdtsrf(ngrid)
63      REAL,INTENT(OUT) :: pdtmr(ngrid,nlayer)
64      REAL,INTENT(IN) :: pu(ngrid,nlayer) ,  pv(ngrid,nlayer)
65      REAL,INTENT(IN) :: pdu(ngrid,nlayer) , pdv(ngrid,nlayer)
66      REAL,INTENT(IN) :: pdmassmr(ngrid,nlayer)
67      REAL,INTENT(OUT) :: pdumr(ngrid,nlayer) , pdvmr(ngrid,nlayer)
68      REAL,INTENT(IN) :: pq(ngrid,nlayer,nq),pdq(ngrid,nlayer,nq)
69      REAL,INTENT(IN) :: pqs(ngrid,nq)
70      REAL,INTENT(OUT) :: pdqmr(ngrid,nlayer,nq),pdqsmr(ngrid,nq)
71      REAL,INTENT(OUT) :: pdpsrfmr(ngrid),pdtsrfmr(ngrid)
72!
73!    Local variables :
74!    -----------------
75
76!    Boiling/sublimation
77      REAL Tsat(ngrid),zmassboil(ngrid)
78
79!    vertical reorganization of sigma levels
80      REAL zzu(nlayer),zzv(nlayer)
81      REAL zzq(nlayer,nq),zzt(nlayer)
82!    Dummy variables     
83      INTEGER n,l,ig,iq
84      REAL zdtsig(ngrid,nlayer)
85      REAL zmass(ngrid,nlayer),zzmass(nlayer),w(nlayer+1)
86      REAL zdmass_sum(ngrid,nlayer+1)
87      REAL zmflux(nlayer+1)
88      REAL zq1(nlayer)
89      REAL ztsrf(ngrid)
90      REAL ztm(nlayer+1)
91      REAL zum(nlayer+1) , zvm(nlayer+1)
92      REAL zqm(nlayer+1,nq),zqm1(nlayer+1)
93      REAL sigma(nlayer+1)
94
95!   local saved variables
96      LOGICAL, SAVE :: firstcall=.true.
97!$OMP THREADPRIVATE(firstcall)
98
99!----------------------------------------------------------------------
100
101!   Initialisation
102!   --------------
103!
104      IF (firstcall) THEN
105         firstcall=.false.       
106      ENDIF
107!
108!======================================================================
109!    Calcul of h2o condensation 
110!    ============================================================
111
112!    Used variable :
113!       pdmassmr      : air Mass added to the atmosphere in each layer per unit time (kg/m2/s)
114!       zdmass_sum(ngrid,l) : total air mass added to the atm above layer l per unit time (kg/m2/s)
115!
116!
117!     Surface tracer Tendencies set to 0
118!     -------------------------------------
119      pdqsmr(1:ngrid,1:nq)=0.
120
121      ztsrf(1:ngrid) = ptsrf(1:ngrid) + pdtsrf(1:ngrid)*ptimestep
122
123
124      DO ig=1,ngrid
125         zdmass_sum(ig,nlayer+1)=0.
126         DO l = nlayer, 1, -1
127           zmass(ig,l) = (pplev(ig,l)-pplev(ig,l+1))/glat(ig)
128           zdmass_sum(ig,l)= zdmass_sum(ig,l+1)+pdmassmr(ig,l)
129         END DO
130      END DO
131
132!     *************************
133!           UPDATE SURFACE
134!     *************************
135!    Changing pressure at the surface:
136!    """"""""""""""""""""""""""""""""""""
137         
138      pdpsrfmr(1:ngrid) = (zdmass_sum(1:ngrid,1)+zmassboil(1:ngrid))*g
139
140      do ig = 1, ngrid
141        IF(ABS(pdpsrfmr(ig)*ptimestep).GT.pplev(ig,1)) THEN
142         PRINT*,'STOP in condens in mass_redistribution'
143         PRINT*,'condensing more than total mass'
144         PRINT*,'Grid point ',ig
145         PRINT*,'Ps = ',pplev(ig,1)
146         PRINT*,'d Ps = ',pdpsrfmr(ig)*ptimestep
147         STOP
148        ENDIF
149      enddo ! of DO ig=1,ngrid
150
151
152! ***************************************************************
153!  Correction to account for redistribution between sigma or hybrid
154!  layers when changing surface pressure
155!  zzx quantities have dimension (nlayer) to speed up calculation
156! *************************************************************
157
158      DO ig=1,ngrid
159         zzt(1:nlayer)  = pt(ig,1:nlayer) + pdt(ig,1:nlayer) * ptimestep
160         zzu(1:nlayer)  = pu(ig,1:nlayer) + pdu(ig,1:nlayer) * ptimestep
161         zzv(1:nlayer)  = pv(ig,1:nlayer) + pdv(ig,1:nlayer) * ptimestep
162         zzq(1:nlayer,1:nq)=pq(ig,1:nlayer,1:nq)+pdq(ig,1:nlayer,1:nq)*ptimestep ! must add the water that has fallen???
163
164!  Mass fluxes of air through the sigma levels (kg.m-2.s-1)  (>0 when up)
165!  """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
166         zmflux(1) = zmassboil(ig)
167         sigma(1)=1
168         DO l=1,nlayer
169           ! Ehouarn: shouldn't we rather compute sigma levels than use bp()?
170!           sigma(l+1)=pplev(ig,l+1)/pplev(ig,1)
171!           zmflux(l+1) = zmflux(l) + pdmassmr(ig,l) - &
172!                        (sigma(l)-sigma(l+1))*(zdmass_sum(ig,1)+zmflux(1))
173!            if (abs(zmflux(l+1)).lt.1E-13.OR.sigma(l+1).eq.0.) zmflux(l+1)=0.
174           ! Ehouarn: but for now leave things as before
175            zmflux(l+1) = zmflux(l) + pdmassmr(ig,l) - (bp(l)-bp(l+1))*(zdmass_sum(ig,1)+zmflux(1))
176! zmflux set to 0 if very low to avoid: top layer is disappearing in v1ld 
177            if (abs(zmflux(l+1)).lt.1E-13.OR.bp(l+1).eq.0.) zmflux(l+1)=0.
178         END DO
179
180! Mass of each layer
181! ------------------
182         zzmass(1:nlayer)=zmass(ig,1:nlayer)*(1.+pdpsrfmr(ig)*ptimestep/pplev(ig,1))
183
184
185!  Corresponding fluxes for T,U,V,Q
186!  """"""""""""""""""""""""""""""""
187
188!        averaging operator for TRANSPORT 
189!        """"""""""""""""""""""""""""""""
190!        Value transfert at the surface interface when condensation
191!        sublimation:
192         ztm(1) = ztsrf(ig)
193         zum(1) = 0. 
194         zvm(1) = 0. 
195         zqm(1,1:nq)=0. ! most tracer do not condense !
196         !! if (water) zqm(1,igcm_h2o_vap)=1. ! flux is 100% h2o at surface
197         
198!        Van Leer scheme:
199         w(1:nlayer+1)=-zmflux(1:nlayer+1)*ptimestep
200         call vl1d(nlayer,zzt,2.,zzmass,w,ztm)
201         call vl1d(nlayer,zzu,2.,zzmass,w,zum)
202         call vl1d(nlayer,zzv,2.,zzmass,w,zvm)
203         do iq=1,nq
204           zq1(1:nlayer)=zzq(1:nlayer,iq)
205           zqm1(1)=zqm(1,iq)
206!               print*,iq
207!               print*,zq1
208           call vl1d(nlayer,zq1,2.,zzmass,w,zqm1)
209           do l=2,nlayer
210              zzq(l,iq)=zq1(l)
211              zqm(l,iq)=zqm1(l)
212           enddo
213         enddo
214
215!        Surface condensation affects low winds
216         if (zmflux(1).lt.0) then
217            zum(1)= zzu(1) *  (w(1)/zzmass(1))
218            zvm(1)= zzv(1) *  (w(1)/zzmass(1))
219            if (w(1).gt.zzmass(1)) then ! ensure numerical stability
220               zum(1)= (zzu(1)-zum(2))*zzmass(1)/w(1) + zum(2)
221               zvm(1)= (zzv(1)-zvm(2))*zzmass(1)/w(1) + zvm(2)
222            end if
223         end if
224                   
225         ztm(nlayer+1)= zzt(nlayer) ! should not be used, but...
226         zum(nlayer+1)= zzu(nlayer)  ! should not be used, but...
227         zvm(nlayer+1)= zzv(nlayer)  ! should not be used, but...
228         zqm(nlayer+1,1:nq)= zzq(nlayer,1:nq)
229 
230!        Tendencies on T, U, V, Q
231!        """"""""""""""""""""""""
232         DO l=1,nlayer
233 
234!           Tendencies on T
235            pdtmr(ig,l) = (1/zzmass(l)) *   &
236                (zmflux(l)*(ztm(l) - zzt(l))-zmflux(l+1)*(ztm(l+1)-zzt(l)))
237                  !JL12 the last term in Newcondens has been set to zero because we are only dealing with redistribution here
238
239!           Tendencies on U
240            pdumr(ig,l)   = (1/zzmass(l)) *( zmflux(l)*(zum(l) - zzu(l)) - zmflux(l+1)*(zum(l+1) - zzu(l)) )
241
242!           Tendencies on V
243            pdvmr(ig,l)   = (1/zzmass(l)) *( zmflux(l)*(zvm(l) - zzv(l)) - zmflux(l+1)*(zvm(l+1) - zzv(l)) )
244
245         END DO
246
247!        Tendencies on Q
248         do iq=1,nq
249            DO l=1,nlayer
250               pdqmr(ig,l,iq)= (1/zzmass(l)) *   &
251                   (zmflux(l)*(zqm(l,iq)-zzq(l,iq))- zmflux(l+1)*(zqm(l+1,iq)-zzq(l,iq)) - pdmassmr(ig,l)*zzq(l,iq))
252            END DO
253         enddo
254
255      END DO  ! loop on ig
256
257CONTAINS
258
259! *****************************************************************
260      SUBROUTINE vl1d(llm,q,pente_max,zzmass,w,qm)
261!
262!   
263!     Operateur de moyenne inter-couche pour calcul de transport type
264!     Van-Leer " pseudo amont " dans la verticale
265!    q,w sont des arguments d'entree  pour le s-pg ....
266!    masse : masse de la couche Dp/g
267!    w : masse d'atm ``transferee'' a chaque pas de temps (kg.m-2)
268!    pente_max = 2 conseillee
269!
270!
271!   --------------------------------------------------------------------
272     
273      IMPLICIT NONE
274
275!   Arguments:
276!   ----------
277      integer,intent(in) :: llm
278      real zzmass(llm),pente_max
279      REAL q(llm),qm(llm+1)
280      REAL w(llm+1)
281!
282!      Local
283!   ---------
284!
285      INTEGER l
286!
287      real dzq(llm),dzqw(llm),adzqw(llm),dzqmax
288      real sigw, Mtot, MQtot
289      integer m
290!     integer ismax,ismin
291
292
293!    On oriente tout dans le sens de la pression
294!     W > 0 WHEN DOWN !!!!!!!!!!!!!
295
296      do l=2,llm
297            dzqw(l)=q(l-1)-q(l)
298            adzqw(l)=abs(dzqw(l))
299      enddo
300
301      do l=2,llm-1
302            if(dzqw(l)*dzqw(l+1).gt.0.) then
303                dzq(l)=0.5*(dzqw(l)+dzqw(l+1))
304            else
305                dzq(l)=0.
306            endif
307            dzqmax=pente_max*min(adzqw(l),adzqw(l+1))
308            dzq(l)=sign(min(abs(dzq(l)),dzqmax),dzq(l))
309      enddo
310
311         dzq(1)=0.
312         dzq(llm)=0.
313
314       do l = 1,llm-1
315
316!         Regular scheme (transfered mass < layer mass)
317!         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
318          if(w(l+1).gt.0. .and. w(l+1).le.zzmass(l+1)) then
319             sigw=w(l+1)/zzmass(l+1)
320             qm(l+1)=(q(l+1)+0.5*(1.-sigw)*dzq(l+1))
321          else if(w(l+1).le.0. .and. -w(l+1).le.zzmass(l)) then
322             sigw=w(l+1)/zzmass(l)
323             qm(l+1)=(q(l)-0.5*(1.+sigw)*dzq(l))
324
325!         Extended scheme (transfered mass > layer mass)
326!         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
327          else if(w(l+1).gt.0.) then
328             m=l+1
329             Mtot = zzmass(m)
330             MQtot = zzmass(m)*q(m)
331             do while ((m.lt.llm).and.(w(l+1).gt.(Mtot+zzmass(m+1))))
332                m=m+1
333                Mtot = Mtot + zzmass(m)
334                MQtot = MQtot + zzmass(m)*q(m)
335             end do
336             if (m.lt.llm) then
337                sigw=(w(l+1)-Mtot)/zzmass(m+1)
338                qm(l+1)= (1/w(l+1))*(MQtot + (w(l+1)-Mtot)*(q(m+1)+0.5*(1.-sigw)*dzq(m+1)) )
339             else
340!                w(l+1) = Mtot
341!                qm(l+1) = Mqtot / Mtot
342                write(*,*) 'top layer is disappearing !',l,Mtot,w(l+1),qm(l+1)
343                print*,zzmass
344                print*,w
345                print*,q
346                print*,qm
347               stop
348             end if
349          else      ! if(w(l+1).lt.0)
350             m = l-1
351             Mtot = zzmass(m+1)
352             MQtot = zzmass(m+1)*q(m+1)
353             if (m.gt.0) then ! because some compilers will have problems
354                              ! evaluating zzmass(0)
355              do while ((m.gt.0).and.(-w(l+1).gt.(Mtot+zzmass(m))))
356                m=m-1
357                Mtot = Mtot + zzmass(m+1)
358                MQtot = MQtot + zzmass(m+1)*q(m+1)
359                if (m.eq.0) exit
360              end do
361             endif
362             if (m.gt.0) then
363                sigw=(w(l+1)+Mtot)/zzmass(m)
364                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)*(q(m)-0.5*(1.+sigw)*dzq(m))  )
365             else
366                qm(l+1)= (-1/w(l+1))*(MQtot + (-w(l+1)-Mtot)*qm(1))
367             end if   
368          end if
369       enddo
370
371!     boundary conditions (not used in newcondens !!)
372!         qm(llm+1)=0.
373!         if(w(1).gt.0.) then
374!            qm(1)=q(1)
375!         else
376!           qm(1)=0.
377!         end if
378
379       END SUBROUTINE vl1d
380
381END SUBROUTINE mass_redistribution
382
383END MODULE mass_redistribution_mod
Note: See TracBrowser for help on using the repository browser.