source: trunk/mars/libf/phymars/updatereffrad.F @ 38

Last change on this file since 38 was 38, checked in by emillour, 14 years ago

Ajout du modè Martien (mon LMDZ.MARS.BETA, du 28/01/2011) dans le rértoire mars, pour pouvoir suivre plus facilement les modifs.
EM

File size: 5.9 KB
Line 
1      SUBROUTINE updatereffrad(ngrid,nlayer,
2     &                rdust,rice,nuice,
3     &                reffrad,nueffrad,
4     &                pq)
5
6       IMPLICIT NONE
7c=======================================================================
8c   subject:
9c   --------
10c   Subroutine designed to update the aerosol size distribution used by
11c     the radiative transfer scheme. This size distribution is assumed
12c     to be a log-normal distribution, with effective radius "reffrad" and
13c     variance "nueffrad".
14c   At firstcall, "rice" and "nuice" are not known, because
15c     the H2O ice microphysical scheme is called after the radiative
16c     transfer in physiq.F. That's why we assess the size of the
17c     water-ice particles at firstcall (see part 1.2 below).
18c
19c   author:   
20c   ------
21c   J.-B. Madeleine (2009-2010)
22c
23c=======================================================================
24c
25c    Declarations :
26c    -------------
27c
28#include "dimensions.h"
29#include "dimphys.h"
30#include "comcstfi.h"
31#include "callkeys.h"
32#include "dimradmars.h"
33#include "tracer.h"
34#include "aerkind.h"
35#include "yomaer.h"
36
37c-----------------------------------------------------------------------
38c     Inputs:
39c     ------
40
41      INTEGER ngrid,nlayer
42c     Ice geometric mean radius (m)
43      REAL :: rice(ngridmx,nlayermx)
44c     Estimated effective variance of the size distribution (n.u.)
45      REAL :: nuice(ngridmx,nlayermx)
46c     Tracer mass mixing ratio (kg/kg)
47      REAL pq(ngrid,nlayer,nqmx)
48      real rdust(ngridmx,nlayermx) ! Dust geometric mean radius (m)
49      real reffdust(ngridmx,nlayermx) ! Dust effective radius (m)
50      real nueffdust(ngridmx,nlayermx) ! Dust effective variance
51
52c     Outputs:
53c     -------
54
55c     Aerosol effective radius used for radiative transfer (meter)
56      REAL :: reffrad(ngridmx,nlayermx,naerkind)
57c     Aerosol effective variance used for radiative transfer (n.u.)
58      REAL :: nueffrad(ngridmx,nlayermx,naerkind)
59
60c     Local variables:
61c     ---------------
62
63      INTEGER :: ig,l          ! 3D grid indices
64      INTEGER :: iaer          ! Aerosol index
65
66c     Number of cloud condensation nuclei near the surface
67c     (only used at firstcall). This value is taken from
68c     Montmessin et al. 2004 JGR 109 E10004 p5 (2E6 part m-3), and
69c     converted to part kg-1 using a typical atmospheric density.
70
71      REAL, PARAMETER :: ccn0 = 1.3E8
72
73      LOGICAL firstcall
74      DATA firstcall/.true./
75      SAVE firstcall
76
77      REAL CBRT
78      EXTERNAL CBRT
79
80c     Local saved variables:
81c     ---------------------
82
83c==================================================================
84c 1. Radius used in the physical subroutines
85c   (but not in the rad. transfer)
86c==================================================================
87
88c     1.1 Dust particles
89c     ------------------
90
91      IF (doubleq.AND.active) THEN
92        DO l=1,nlayer
93          DO ig=1, ngrid
94            reffdust(ig,l) = ref_r0 *
95     &        CBRT(r3n_q*pq(ig,l,igcm_dust_mass)/
96     &        max(pq(ig,l,igcm_dust_number),0.01))
97            reffdust(ig,l)=min(max(reffdust(ig,l),1.e-10),500.e-6)
98            nueffdust(ig,l) = exp(varian**2.)-1.
99          ENDDO
100        ENDDO
101      ELSE
102        DO l=1,nlayer
103          DO ig=1, ngrid
104            reffdust(ig,l) = 1.5E-6
105            nueffdust(ig,l) = 0.3
106          ENDDO
107        ENDDO
108      ENDIF
109
110      DO l=1,nlayer
111        DO ig=1, ngrid
112c         Geometric mean radius = Effective radius / (1+nueff)^5/2
113          rdust(ig,l) = reffdust(ig,l)/(1.+nueffdust(ig,l))**2.5
114        ENDDO
115      ENDDO
116
117c     1.2 Water-ice particles
118c     -----------------------
119
120      IF (firstcall.AND.water.AND.activice) THEN
121        DO l=1,nlayer
122          DO ig=1,ngrid
123            rice(ig,l) = max( CBRT(
124     &        (pq(ig,l,igcm_h2o_ice)/rho_ice +
125     &        ccn0*(4./3.)*pi*rdust(ig,l)**3.) /
126     &        (ccn0*4./3.*pi)),rdust(ig,l) )
127            nuice(ig,l) = nuice_ref
128          ENDDO
129        ENDDO
130        firstcall = .false.
131      ENDIF
132
133c==================================================================
134c 2. Radius used in the radiative transfer code (reffrad)
135c==================================================================
136
137      DO iaer = 1, naerkind ! Loop on aerosol kind
138        aerkind: SELECT CASE (name_iaer(iaer))
139c==================================================================
140        CASE("dust_conrath") aerkind         ! Typical dust profile
141c==================================================================
142          DO l=1,nlayer
143            DO ig=1,ngrid
144              reffrad(ig,l,iaer) = reffdust(ig,l)
145              nueffrad(ig,l,iaer) = nueffdust(ig,l)
146            ENDDO
147          ENDDO
148c==================================================================
149        CASE("dust_doubleq") aerkind! Two-moment scheme for dust
150c==================================================================
151          DO l=1,nlayer
152            DO ig=1,ngrid
153              reffrad(ig,l,iaer) = reffdust(ig,l)
154              nueffrad(ig,l,iaer) = nueffdust(ig,l)
155            ENDDO
156          ENDDO
157c==================================================================
158        CASE("dust_submicron") aerkind   ! Small dust population
159c==================================================================
160          DO l=1,nlayer
161            DO ig=1,ngrid
162              reffrad(ig,l,iaer)=radius(igcm_dust_submicron)
163              nueffrad(ig,l,iaer)=0.03
164            ENDDO
165          ENDDO     
166c==================================================================
167        CASE("h2o_ice") aerkind             ! Water ice crystals
168c==================================================================
169          DO l=1,nlayer
170            DO ig=1,ngrid
171              reffrad(ig,l,iaer)=rice(ig,l)*(1.+nuice_ref)
172              nueffrad(ig,l,iaer)=nuice_ref
173            ENDDO
174          ENDDO
175c==================================================================
176        END SELECT aerkind
177      ENDDO ! iaer (loop on aerosol kind)
178
179      RETURN
180      END
Note: See TracBrowser for help on using the repository browser.