source: trunk/LMDZ.MARS/libf/phymars/updatereffrad_mod.F @ 2252

Last change on this file since 2252 was 2199, checked in by mvals, 6 years ago

Mars GCM:
Implementation of a new parametrization of the dust entrainment by slope winds above the sub-grid scale topography. The parametrization is activated with the flag slpwind=.true. (set to "false" by
default) in callphys.def. The new parametrization involves the new tracers topdust_mass and topdust_number.
MV

File size: 9.9 KB
RevLine 
[1969]1      MODULE updatereffrad_mod
2     
3      IMPLICIT NONE
4     
5      CONTAINS
6     
[38]7      SUBROUTINE updatereffrad(ngrid,nlayer,
[2199]8     &                rdust,rstormdust,rtopdust,rice,nuice,
[38]9     &                reffrad,nueffrad,
[744]10     &                pq,tauscaling,tau,pplay)
[1969]11       USE updaterad, ONLY: updaterdust, updaterice_micro,
12     &                      updaterice_typ
[1036]13       use tracer_mod, only: nqmx, igcm_dust_mass, igcm_dust_number,
14     &                       igcm_h2o_ice, igcm_ccn_mass, radius,
15     &                       igcm_ccn_number, nuice_ref, varian,
[1974]16     &                       ref_r0, igcm_dust_submicron,
[2199]17     &                       igcm_stormdust_mass,igcm_stormdust_number,
18     &                       igcm_topdust_mass,igcm_topdust_number
[1246]19       USE dimradmars_mod, only: nueffdust,naerkind,
20     &            name_iaer,
21     &            iaer_dust_conrath,iaer_dust_doubleq,
[1974]22     &            iaer_dust_submicron,iaer_h2o_ice,
[2199]23     &            iaer_stormdust_doubleq,iaer_topdust_doubleq
[1969]24
[38]25       IMPLICIT NONE
26c=======================================================================
27c   subject:
28c   --------
29c   Subroutine designed to update the aerosol size distribution used by
30c     the radiative transfer scheme. This size distribution is assumed
31c     to be a log-normal distribution, with effective radius "reffrad" and
32c     variance "nueffrad".
33c   At firstcall, "rice" and "nuice" are not known, because
34c     the H2O ice microphysical scheme is called after the radiative
35c     transfer in physiq.F. That's why we assess the size of the
36c     water-ice particles at firstcall (see part 1.2 below).
37c
38c   author:   
39c   ------
40c   J.-B. Madeleine (2009-2010)
41c
42c=======================================================================
43c
44c    Declarations :
45c    -------------
46c
[1969]47      include "callkeys.h"
[38]48
49c-----------------------------------------------------------------------
[1974]50c     Inputs/outputs:
[38]51c     ------
52
[1974]53      INTEGER, INTENT(in) :: ngrid,nlayer
[38]54c     Ice geometric mean radius (m)
[1974]55      REAL, INTENT(out) :: rice(ngrid,nlayer)
[38]56c     Estimated effective variance of the size distribution (n.u.)
[1974]57      REAL, INTENT(out) :: nuice(ngrid,nlayer)
[38]58c     Tracer mass mixing ratio (kg/kg)
[1974]59      REAL, INTENT(in) :: pq(ngrid,nlayer,nqmx)
60      REAL, INTENT(out) :: rdust(ngrid,nlayer) ! Dust geometric mean radius (m)
[2199]61      REAL, INTENT(out) :: rstormdust(ngrid,nlayer) ! Dust geometric mean radius (m)   
62      REAL, INTENT(out) :: rtopdust(ngrid,nlayer) ! Dust geometric mean radius (m)
[1974]63      REAL, INTENT(in) :: pplay(ngrid,nlayer) ! altitude at the middle of the layers
64      REAL, INTENT(in) :: tau(ngrid,naerkind)
[38]65c     Aerosol effective radius used for radiative transfer (meter)
[1974]66      REAL, INTENT(out) :: reffrad(ngrid,nlayer,naerkind)
[38]67c     Aerosol effective variance used for radiative transfer (n.u.)
[1974]68      REAL, INTENT(out) :: nueffrad(ngrid,nlayer,naerkind)
69      REAL, INTENT(in) :: tauscaling(ngrid)         ! Convertion factor for qccn and Nccn
70     
[38]71c     Local variables:
72c     ---------------
73
74      INTEGER :: ig,l          ! 3D grid indices
75      INTEGER :: iaer          ! Aerosol index
76
77c     Number of cloud condensation nuclei near the surface
78c     (only used at firstcall). This value is taken from
79c     Montmessin et al. 2004 JGR 109 E10004 p5 (2E6 part m-3), and
80c     converted to part kg-1 using a typical atmospheric density.
81
82      REAL, PARAMETER :: ccn0 = 1.3E8
[629]83     
84c     For microphysics only:     
85      REAL Mo,No                       ! Mass and number of ccn
[1047]86      REAL rhocloud(ngrid,nlayer)  ! Cloud density (kg.m-3)
[38]87
[1224]88      LOGICAL,SAVE :: firstcall=.true.
[38]89
90      REAL CBRT
91      EXTERNAL CBRT
92
93c==================================================================
[629]94c 1. Update radius from fields from dynamics or initial state
95c==================================================================
[38]96
[358]97c       1.1 Dust particles
98c       ------------------
99        IF (doubleq.AND.active) THEN
100          DO l=1,nlayer
101            DO ig=1, ngrid
[744]102              call updaterdust(pq(ig,l,igcm_dust_mass),
103     &                         pq(ig,l,igcm_dust_number),rdust(ig,l))
[358]104              nueffdust(ig,l) = exp(varian**2.)-1.
105             ENDDO
106           ENDDO
107        ELSE
108          DO l=1,nlayer
109            DO ig=1, ngrid
110              rdust(ig,l) = 0.8E-6
111              nueffdust(ig,l) = 0.3
112            ENDDO
[38]113          ENDDO
[358]114        ENDIF
[1974]115
116        ! updating radius of stormdust particles
117        IF (rdstorm.AND.active) THEN
118          DO l=1,nlayer
119            DO ig=1, ngrid
120              call updaterdust(pq(ig,l,igcm_stormdust_mass),
121     &                 pq(ig,l,igcm_stormdust_number),rstormdust(ig,l))
122              nueffdust(ig,l) = exp(varian**2.)-1.
123             ENDDO
124           ENDDO
125        ENDIF
[2199]126
127        ! updating radius of topdust particles
128        IF (slpwind.AND.active) THEN
129          DO l=1,nlayer
130            DO ig=1, ngrid
131              call updaterdust(pq(ig,l,igcm_topdust_mass),
132     &                 pq(ig,l,igcm_topdust_number),rtopdust(ig,l))
133              nueffdust(ig,l) = exp(varian**2.)-1.
134             ENDDO
135           ENDDO
136        ENDIF
[629]137       
[358]138c       1.2 Water-ice particles
139c       -----------------------
[744]140
141        IF (water.AND.activice) THEN
142         IF (microphys) THEN
[1208]143       
144c    At firstcall, the true number and true mass of cloud condensation nuclei are not known.
145c    Indeed it is scaled on the prescribed dust opacity via a 'tauscaling' coefficient
146c    computed after radiative transfer. If tauscaling is not in startfi, we make an assumption for its value.
147
[744]148          IF (firstcall) THEN
[1974]149            !IF (minval(tauscaling).lt.0) tauscaling(:) = 1.e-3 ! default value when non-read in startfi is -1
150            !IF (freedust)                tauscaling(:) = 1.    ! if freedust, enforce no rescaling at all
[1208]151            firstcall = .false.
152          ENDIF
153 
154          DO l=1,nlayer
155            DO ig=1,ngrid
156              call updaterice_micro(pq(ig,l,igcm_h2o_ice),
157     &                              pq(ig,l,igcm_ccn_mass),
158     &                              pq(ig,l,igcm_ccn_number),
159     &                              tauscaling(ig),rice(ig,l),
160     &                              rhocloud(ig,l))
161              nuice(ig,l) = nuice_ref
[358]162            ENDDO
[1208]163          ENDDO
[744]164         
165        ELSE ! if not microphys
166         
167          DO l=1,nlayer
168            DO ig=1,ngrid   
169              call updaterice_typ(pq(ig,l,igcm_h2o_ice),
170     &                          tau(ig,1),pplay(ig,l),rice(ig,l))
171              nuice(ig,l) = nuice_ref
[629]172            ENDDO
[744]173          ENDDO
174 
175        ENDIF ! of if microphys
176       ENDIF ! of if (water.AND.activice)
[38]177
178c==================================================================
179c 2. Radius used in the radiative transfer code (reffrad)
180c==================================================================
181
182      DO iaer = 1, naerkind ! Loop on aerosol kind
183        aerkind: SELECT CASE (name_iaer(iaer))
184c==================================================================
185        CASE("dust_conrath") aerkind         ! Typical dust profile
186c==================================================================
187          DO l=1,nlayer
188            DO ig=1,ngrid
[358]189              reffrad(ig,l,iaer) = rdust(ig,l) *
190     &          (1.e0 + nueffdust(ig,l))**2.5
[38]191              nueffrad(ig,l,iaer) = nueffdust(ig,l)
192            ENDDO
193          ENDDO
194c==================================================================
195        CASE("dust_doubleq") aerkind! Two-moment scheme for dust
196c==================================================================
197          DO l=1,nlayer
198            DO ig=1,ngrid
[358]199              reffrad(ig,l,iaer) = rdust(ig,l) * ref_r0
[38]200              nueffrad(ig,l,iaer) = nueffdust(ig,l)
201            ENDDO
202          ENDDO
203c==================================================================
204        CASE("dust_submicron") aerkind   ! Small dust population
205c==================================================================
206          DO l=1,nlayer
207            DO ig=1,ngrid
208              reffrad(ig,l,iaer)=radius(igcm_dust_submicron)
209              nueffrad(ig,l,iaer)=0.03
210            ENDDO
211          ENDDO     
212c==================================================================
213        CASE("h2o_ice") aerkind             ! Water ice crystals
214c==================================================================
215          DO l=1,nlayer
216            DO ig=1,ngrid
[358]217c             About reffice, do not confuse the mass mean radius
218c             (rayon moyen massique) and the number median radius
219c             (or geometric mean radius, rayon moyen géométrique).
220c             rice is a mass mean radius, whereas rdust
221c             is a geometric mean radius:
222c             number median rad = mass mean rad x exp(-1.5 sigma0^2)
223c             (Montmessin et al. 2004 paragraph 30). Therefore:
[38]224              reffrad(ig,l,iaer)=rice(ig,l)*(1.+nuice_ref)
225              nueffrad(ig,l,iaer)=nuice_ref
226            ENDDO
227          ENDDO
228c==================================================================
[1974]229        CASE("stormdust_doubleq") aerkind! Two-moment scheme for
230c       stormdust; same distribution than normal dust
231c==================================================================
232          DO l=1,nlayer
233            DO ig=1,ngrid
234              reffrad(ig,l,iaer) = rstormdust(ig,l) * ref_r0
235              nueffrad(ig,l,iaer) = nueffdust(ig,l)
236            ENDDO
237          ENDDO
238c==================================================================
[2199]239        CASE("topdust_doubleq") aerkind! MV18: Two-moment scheme for
240c       topdust; same distribution than normal dust
241c==================================================================
242          DO l=1,nlayer
243            DO ig=1,ngrid
244              reffrad(ig,l,iaer) = rtopdust(ig,l) * ref_r0
245              nueffrad(ig,l,iaer) = nueffdust(ig,l)
246            ENDDO
247          ENDDO
248c==================================================================
[38]249        END SELECT aerkind
250      ENDDO ! iaer (loop on aerosol kind)
251
[1969]252      END SUBROUTINE updatereffrad
253     
254      END MODULE updatereffrad_mod
Note: See TracBrowser for help on using the repository browser.