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

Last change on this file since 2467 was 2459, checked in by aslmd, 4 years ago

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