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

Last change on this file since 4022 was 3913, checked in by jbclement, 5 months ago

Mars PCM:
Partial reversion of r3847: removal of the incompatibility test requires 'microphys'?. Therefore, in "updatereffrad_mod.F", without microphysics, we use a typical value for 'tau' (0.2) to assess the number of cloud condensation nuclei in the same way than done before r744. Comments and unused variables are cleaned.
JBC
File size: 12.3 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       use callkeys_mod, only: water, activice, microphys
32       use callkeys_mod, only: rdstorm, topflows
33       use callkeys_mod, only: co2clouds, activeco2ice, co2useh2o
34       IMPLICIT NONE
35c=======================================================================
36c   subject:
37c   --------
38c   Subroutine designed to update the aerosol size distribution used by
39c     the radiative transfer scheme. This size distribution is assumed
40c     to be a log-normal distribution, with effective radius "reffrad" and
41c     variance "nueffrad".
42c   At firstcall or without microphysics, "rice" and "nuice" are not known,
43c     because the H2O ice microphysical scheme ("aeropacity.F") is called after
44c     the radiative transfer. That's why we assess the size of the water-ice
45c     particles (see part 1.2 below).
46c
47c   author:   
48c   ------
49c   J.-B. Madeleine (2009-2010)
50c
51c=======================================================================
52c
53c    Declarations :
54c    -------------
55c
56
57c-----------------------------------------------------------------------
58c     Inputs/outputs:
59c     ------
60      INTEGER, INTENT(in) :: ngrid,nlayer
61c     Ice geometric mean radius (m)
62      REAL, INTENT(out) :: rice(ngrid,nlayer)
63c     Estimated effective variance of the size distribution (n.u.)
64      REAL, INTENT(out) :: nuice(ngrid,nlayer)
65c     Tracer mass mixing ratio (kg/kg)
66      REAL, INTENT(in) :: pq(ngrid,nlayer,nqmx)
67      REAL, INTENT(out) :: rdust(ngrid,nlayer) ! Dust geometric mean radius (m)
68      REAL, INTENT(out) :: rstormdust(ngrid,nlayer) ! Dust geometric mean radius (m)   
69      REAL, INTENT(out) :: rtopdust(ngrid,nlayer) ! Dust geometric mean radius (m)
70      REAL, INTENT(in) :: pplay(ngrid,nlayer) ! altitude at the middle of the layers
71      REAL, INTENT(in) :: tau(ngrid,naerkind)
72c     Aerosol effective radius used for radiative transfer (meter)
73      REAL, INTENT(out) :: reffrad(ngrid,nlayer,naerkind)
74c     Aerosol effective variance used for radiative transfer (n.u.)
75      REAL, INTENT(out) :: nueffrad(ngrid,nlayer,naerkind)
76      REAL, INTENT(in) :: tauscaling(ngrid)         ! Convertion factor for qccn and Nccn
77c     CO2 ice mean radius (m)
78      double precision, INTENT(out) :: riceco2(ngrid,nlayer) ! co2 ice radius
79      REAL, INTENT(out) :: nuiceco2(ngrid,nlayer)
80      REAL, INTENT(in) :: pt(ngrid,nlayer) ! temperature
81     
82c     Local variables:
83c     ---------------
84      INTEGER :: ig,l          ! 3D grid indices
85      INTEGER :: iaer          ! Aerosol index
86      REAL, PARAMETER :: threshold = 1e-30 ! limit value
87      REAL :: Nccnco2, Qccnco2, Niceco2, Nccnco2_h2o, Qccnco2_h2o
88c     For microphysics only:
89      REAL :: rhocloud(ngrid,nlayer) ! Cloud density (kg.m-3)
90c     For CO2 microphysics only:
91      REAL :: rhocloudco2(ngrid,nlayer) ! co2 cloud density
92
93c==================================================================
94c 1. Update radius from fields from dynamics or initial state
95c==================================================================
96
97c       1.1 Dust particles
98c       ------------------
99        IF (doubleq.AND.active) THEN
100          DO l=1,nlayer
101            DO ig=1, ngrid
102              call updaterdust(pq(ig,l,igcm_dust_mass),
103     &                         pq(ig,l,igcm_dust_number),rdust(ig,l))
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
113          ENDDO
114        ENDIF
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
126
127        ! updating radius of topdust particles
128        IF (topflows.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
137       
138c       1.2 Water-ice particles
139c       -----------------------
140        IF (water.AND.activice) THEN
141         IF (microphys) THEN
142
143c    At firstcall, the true number and true mass of cloud condensation nuclei are not known.
144c    Indeed it is scaled on the prescribed dust opacity via a 'tauscaling' coefficient
145c    computed after radiative transfer.
146c    Therefore, 'tauscaling' is read in startfi for the first call (=1 if not found).
147          DO l=1,nlayer
148            DO ig=1,ngrid
149              call updaterice_micro(pq(ig,l,igcm_h2o_ice),
150     &                              pq(ig,l,igcm_ccn_mass),
151     &                              pq(ig,l,igcm_ccn_number),
152     &                              tauscaling(ig),rice(ig,l),
153     &                              rhocloud(ig,l))
154              nuice(ig,l) = nuice_ref
155            ENDDO
156          ENDDO
157
158        ELSE ! if not microphys
159
160c    Without microphysics, we use a typical value for 'tau' (0.2) to assess
161c    the number of cloud condensation nuclei near the surface.
162          DO l=1,nlayer
163            DO ig=1,ngrid   
164              call updaterice_typ(pq(ig,l,igcm_h2o_ice),0.2,
165     &                            pplay(ig,l),rice(ig,l))
166              nuice(ig,l) = nuice_ref
167            ENDDO
168          ENDDO
169
170        ENDIF ! of if microphys
171       ENDIF ! of if (water.AND.activice)
172
173c       1.3 CO2-ice particles
174c       ---------------------
175        IF (co2clouds.AND.activeco2ice) THEN
176          DO l=1,nlayer
177            DO ig=1,ngrid
178              Niceco2 = max(pq(ig,l,igcm_co2_ice), threshold)
179              Nccnco2 = max(pq(ig,l,igcm_ccnco2_number),
180     &                              threshold)
181              Qccnco2 = max(pq(ig,l,igcm_ccnco2_mass),
182     &                              threshold)
183              Nccnco2_h2o = 0.
184              Qccnco2_h2o = 0.
185              if (co2useh2o) then
186                Nccnco2_h2o = max(pq(ig,l,igcm_ccnco2_h2o_number),
187     &                              threshold)
188                Qccnco2_h2o = max(pq(ig,l,igcm_ccnco2_h2o_mass_ice)
189     &                        + pq(ig,l,igcm_ccnco2_h2o_mass_ccn),
190     &                              threshold)
191
192                Nccnco2 = Nccnco2 - Nccnco2_h2o
193                Qccnco2 = Qccnco2 - Qccnco2_h2o
194                if (Nccnco2 <= 0) then
195                  Nccnco2 = threshold
196                  Qccnco2 = threshold
197                end if
198              end if
199              call updaterice_microco2(dble(Niceco2),
200     &                              dble(Qccnco2), dble(Nccnco2),
201     &                              dble(Qccnco2_h2o),
202     &                              dble(Nccnco2_h2o),
203     &                              pt(ig,l),
204     &                              tauscaling(ig),riceco2(ig,l),
205     &                              rhocloudco2(ig,l))
206              nuiceco2(ig,l) = nuiceco2_ref
207            END DO
208          ENDDO
209        ENDIF ! of if (co2clouds.AND.activeco2ice)
210
211c==================================================================
212c 2. Radius used in the radiative transfer code (reffrad)
213c==================================================================
214
215      DO iaer = 1, naerkind ! Loop on aerosol kind
216        aerkind: SELECT CASE (name_iaer(iaer))
217c==================================================================
218        CASE("dust_conrath") aerkind         ! Typical dust profile
219c==================================================================
220          DO l=1,nlayer
221            DO ig=1,ngrid
222              reffrad(ig,l,iaer) = rdust(ig,l) *
223     &          (1.e0 + nueffdust(ig,l))**2.5
224              nueffrad(ig,l,iaer) = nueffdust(ig,l)
225            ENDDO
226          ENDDO
227c==================================================================
228        CASE("dust_doubleq") aerkind! Two-moment scheme for dust
229c==================================================================
230          DO l=1,nlayer
231            DO ig=1,ngrid
232              reffrad(ig,l,iaer) = rdust(ig,l) * ref_r0
233              nueffrad(ig,l,iaer) = nueffdust(ig,l)
234            ENDDO
235          ENDDO
236c==================================================================
237        CASE("dust_submicron") aerkind   ! Small dust population
238c==================================================================
239          DO l=1,nlayer
240            DO ig=1,ngrid
241              reffrad(ig,l,iaer)=radius(igcm_dust_submicron)
242              nueffrad(ig,l,iaer)=0.03
243            ENDDO
244          ENDDO     
245c==================================================================
246        CASE("h2o_ice") aerkind             ! Water ice crystals
247c==================================================================
248          DO l=1,nlayer
249            DO ig=1,ngrid
250c             About reffice, do not confuse the mass mean radius
251c             (rayon moyen massique) and the number median radius
252c             (or geometric mean radius, rayon moyen géométrique).
253c             rice is a mass mean radius, whereas rdust
254c             is a geometric mean radius:
255c             number median rad = mass mean rad x exp(-1.5 sigma0^2)
256c             (Montmessin et al. 2004 paragraph 30). Therefore:
257              reffrad(ig,l,iaer)=rice(ig,l)*(1.+nuice_ref)
258              nueffrad(ig,l,iaer)=nuice_ref
259            ENDDO
260          ENDDO
261c==================================================================
262        CASE("co2_ice") aerkind             ! CO2 ice crystals
263c==================================================================
264          DO l=1,nlayer
265            DO ig=1,ngrid
266              reffrad(ig,l,iaer)=real(riceco2(ig,l))*(1.+nuiceco2_ref)
267              nueffrad(ig,l,iaer)=nuiceco2_ref
268            ENDDO
269          ENDDO
270c==================================================================
271        CASE("stormdust_doubleq") aerkind! Two-moment scheme for
272c       stormdust; same distribution than normal dust
273c==================================================================
274          DO l=1,nlayer
275            DO ig=1,ngrid
276              reffrad(ig,l,iaer) = rstormdust(ig,l) * ref_r0
277              nueffrad(ig,l,iaer) = nueffdust(ig,l)
278            ENDDO
279          ENDDO
280c==================================================================
281        CASE("topdust_doubleq") aerkind! MV18: Two-moment scheme for
282c       topdust; same distribution than normal dust
283c==================================================================
284          DO l=1,nlayer
285            DO ig=1,ngrid
286              reffrad(ig,l,iaer) = rtopdust(ig,l) * ref_r0
287              nueffrad(ig,l,iaer) = nueffdust(ig,l)
288            ENDDO
289          ENDDO
290c==================================================================
291        END SELECT aerkind
292      ENDDO ! iaer (loop on aerosol kind)
293
294      END SUBROUTINE updatereffrad
295     
296      END MODULE updatereffrad_mod
Note: See TracBrowser for help on using the repository browser.