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

Last change on this file since 2566 was 2562, checked in by cmathe, 4 years ago

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