source: trunk/LMDZ.PLUTO.old/libf/phypluto/callsedim.F @ 3436

Last change on this file since 3436 was 3175, checked in by emillour, 11 months ago

Pluto PCM:
Add the old Pluto LMDZ for reference (required prior step to making
an LMDZ.PLUTO using the same framework as the other physics packages).
TB+EM

File size: 5.2 KB
Line 
1      SUBROUTINE callsedim(ngrid,nlay, ptimestep,
2     $                pplev,zlev, pt,rice_ch4,rice_co,
3     &                pq, pdqfi, pdqsed,pdqs_sed,nq,pphi)
4
5      use radinc_h, only : naerkind
6      IMPLICIT NONE
7!==================================================================
8!     
9!     Purpose
10!     -------
11!     Calculates sedimentation of aerosols depending on their
12!     density and radius.
13!     
14!     Authors
15!     -------
16!     F. Forget (1999)
17!     Tracer generalisation by E. Millour (2009)
18!     
19!==================================================================
20
21c-----------------------------------------------------------------------
22c   declarations:
23c   -------------
24
25#include "dimensions.h"
26#include "dimphys.h"
27#include "comcstfi.h"
28#include "tracer.h"
29#include "callkeys.h"
30
31c
32c   arguments:
33c   ----------
34
35      INTEGER ngrid              ! number of horizontal grid points
36      INTEGER nlay               ! number of atmospheric layers
37      REAL ptimestep             ! physics time step (s)
38      REAL pplev(ngrid,nlay+1)   ! pressure at inter-layers (Pa)
39      REAL pt(ngrid,nlay)        ! temperature at mid-layer (K)
40      REAL zlev(ngrid,nlay+1)    ! altitude at layer boundaries
41      REAL pphi(ngrid,nlay)    ! geopotential
42
43
44c    Traceurs :
45      integer nq             ! number of tracers
46      real pq(ngrid,nlay,nq)  ! tracers (kg/kg)
47      real pdqfi(ngrid,nlay,nq)  ! tendency before sedimentation (kg/kg.s-1)
48      real pdqsed(ngrid,nlay,nq) ! tendency due to sedimentation (kg/kg.s-1)
49      real pdqs_sed(ngrid,nq)    ! flux at surface (kg.m-2.s-1)
50     
51c   local:
52c   ------
53
54      INTEGER l,ig, iq
55
56      real zqi(ngridmx,nlayermx) ! to locally store tracers
57      real masse (ngridmx,nlayermx) ! Layer mass (kg.m-2)
58      real epaisseur (ngridmx,nlayermx) ! Layer thickness (m)
59      real wq(ngridmx,nlayermx+1) ! displaced tracer mass (kg.m-2)
60      real rfall_ch4(ngridmx,nlayermx)
61      real rfall_co(ngridmx,nlayermx)
62      real rice_ch4(ngridmx,nlayermx)
63      real rice_co(ngridmx,nlayermx)
64
65      LOGICAL firstcall
66      SAVE firstcall
67      DATA firstcall/.true./
68
69c    ** un petit test de coherence
70c       --------------------------
71
72      IF (firstcall) THEN
73         IF(ngrid.NE.ngridmx) THEN
74            PRINT*,'STOP dans callsedim'
75            PRINT*,'probleme de dimensions :'
76            PRINT*,'ngrid  =',ngrid
77            PRINT*,'ngridmx  =',ngridmx
78            STOP
79         ENDIF
80     
81        firstcall=.false.
82      ENDIF ! of IF (firstcall)
83
84!=======================================================================
85!     Preliminary calculation of the layer characteristics
86!     (mass (kg.m-2), thickness (m), etc.
87
88      do  l=1,nlay
89        do ig=1, ngrid
90          masse(ig,l)=(pplev(ig,l) - pplev(ig,l+1)) /g
91          epaisseur(ig,l)= zlev(ig,l+1) - zlev(ig,l)
92        end do
93      end do
94
95      do iq=1,nq
96        if(radius(iq).gt.1.e-12) then   ! no sedimentation for gases (defined by radius=0)
97!     Radius values are defined in initracer
98!     The value of q is updated after the other parameterisations
99
100          do l=1,nlay
101            do ig=1,ngrid
102              ! store locally updated tracers
103              zqi(ig,l)=pq(ig,l,iq)+pdqfi(ig,l,iq)*ptimestep
104
105c                cf sur Mars: 
106c                On affecte un rayon moyen aux poussieres a chaque altitude du type :
107c                r(z)=r0*exp(-z/H) avec r0=0.8 micron et H=18 km.
108c                rfall(ig,l)=max( rice(ig,l)*1.5,rdust(ig,l) )
109c                Pluton : choix de rfall a la place de radius
110              if (iq.eq.igcm_ch4_ice) then
111                 ! TB: rfall_ch4(ig,l)=max( rice_ch4(ig,l)*1.5,2.e-7)
112                 rfall_ch4(ig,l)=max( rice_ch4(ig,l),2.e-7)
113                 rfall_ch4(ig,l)=min(rfall_ch4(ig,l),1.e-4)
114              endif
115              if (iq.eq.igcm_co_ice) then
116                 rfall_co(ig,l)=max( rice_co(ig,l),2.e-7)
117                 rfall_co(ig,l)=min(rfall_co(ig,l),1.e-4)
118              endif
119            enddo
120          enddo ! of do l=1,nlay
121
122!=======================================================================
123!     Calculate the transport due to sedimentation for each tracer
124
125          if (iq.eq.igcm_ch4_ice) then
126          !if (iceparty.and.(iq.eq.igcm_ch4_ice)) then
127            call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
128     &      pplev,masse,epaisseur,pt,rfall_ch4,rho_q(iq),zqi,wq,pphi)
129          else if (iq.eq.igcm_co_ice) then
130            call newsedim(ngrid,nlay,ngrid*nlay,ptimestep,
131     &      pplev,masse,epaisseur,pt,rfall_co,rho_q(iq),zqi,wq,pphi)
132          else if ((radius(iq).gt.0.)) then   ! haze tracers
133            call newsedim(ngrid,nlay,1,ptimestep,
134     &      pplev,masse,epaisseur,pt,radius(iq),rho_q(iq),zqi,wq,pphi)
135          endif
136
137!=======================================================================
138!     Calculate the tendencies
139
140          do ig=1,ngrid
141!     Ehouarn: with new way of tracking tracers by name, this is simply
142            pdqs_sed(ig,iq)=wq(ig,1)/ptimestep
143          end do
144
145          DO l = 1, nlay
146            DO ig=1,ngrid
147              pdqsed(ig,l,iq)=(zqi(ig,l)-
148     $        (pq(ig,l,iq) + pdqfi(ig,l,iq)*ptimestep))/ptimestep
149            ENDDO
150          ENDDO
151
152        endif ! of if(radius(iq).gt.1.e-12)
153      enddo ! of do iq=1,nq
154 
155      RETURN
156      END
157
Note: See TracBrowser for help on using the repository browser.