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

Last change on this file since 3807 was 3726, checked in by emillour, 3 months ago

Mars PCM:
Turn "callkeys.h" into module "callkeys_mod.F90"
EM

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