/[lmdze]/trunk/phylmd/newmicro.f90
ViewVC logotype

Diff of /trunk/phylmd/newmicro.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC revision 341 by guez, Mon Oct 21 06:11:44 2019 UTC
# Line 4  module newmicro_m Line 4  module newmicro_m
4    
5  contains  contains
6    
7    SUBROUTINE newmicro (paprs, play, t, qlwp, clc, cltau, clemi, cldh, &    SUBROUTINE newmicro (paprs, play, t, cldliq, clc, cldtau, clemi, cldh, cldl, &
8         cldl, cldm, cldt, ctlwp, flwp, fiwp, flwc, fiwc, ok_aie, sulfate, &         cldm, cldt, ctlwp, flwp, fiwp, flwc, fiwc)
        sulfate_pi, bl95_b0, bl95_b1, cldtaupi, re, fl)  
9    
10      ! From LMDZ4/libf/phylmd/newmicro.F, version 1.2 2004/06/03 09:22:43      ! From LMDZ4/libf/phylmd/newmicro.F, version 1.2 2004/06/03 09:22:43
11    
12      ! Authors: Z. X. Li (LMD/CNRS), Johannes Quaas      ! Authors: Z. X. Li (LMD/CNRS), Johannes Quaas
13      ! Date: 1993/09/10      ! Date: 1993/09/10
14      ! Objet: calcul de l'épaisseur optique et de l'émissivité des nuages.      ! Objet: calcul de l'\'epaisseur optique et de l'\'emissivit\'e des nuages.
15    
16      USE conf_phys_m, ONLY: rad_chau1, rad_chau2      USE conf_phys_m, ONLY: rad_chau1, rad_chau2
17      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
18      USE suphec_m, ONLY: rd, rg      USE histwrite_phy_m, ONLY: histwrite_phy
19      use nr_util, only: pi      USE suphec_m, ONLY: rg
20    
21      REAL, intent(in):: paprs(:, :) ! (klon, klev+1)      REAL, intent(in):: paprs(:, :) ! (klon, klev+1)
22        ! pression pour chaque inter-couche, en Pa
23    
24      real, intent(in):: play(:, :) ! (klon, klev)      real, intent(in):: play(:, :) ! (klon, klev)
25      REAL, intent(in):: t(:, :) ! (klon, klev) temperature      REAL, intent(in):: t(:, :) ! (klon, klev) temperature
26    
27      REAL, intent(in):: qlwp(:, :) ! (klon, klev)      REAL, intent(in):: cldliq(:, :) ! (klon, klev)
28      ! eau liquide nuageuse dans l'atmosphère (kg/kg)      ! mass fraction of liquid water in atmosphere
29    
30      REAL, intent(inout):: clc(:, :) ! (klon, klev)      REAL, intent(inout):: clc(:, :) ! (klon, klev)
31      ! couverture nuageuse pour le rayonnement (0 à 1)      ! couverture nuageuse pour le rayonnement (0 à 1)
32    
33      REAL, intent(out):: cltau(:, :) ! (klon, klev)  épaisseur optique des nuages      REAL, intent(out):: cldtau(:, :) ! (klon, klev)
34      REAL, intent(out):: clemi(:, :) ! (klon, klev) émissivité des nuages (0 à 1)      ! \'epaisseur optique des nuages
35        
36        REAL, intent(out):: clemi(:, :) ! (klon, klev)
37        ! \'emissivit\'e des nuages (0 à 1)
38    
39      REAL, intent(out):: cldh(:), cldl(:), cldm(:), cldt(:) ! (klon)      REAL, intent(out):: cldh(:), cldl(:), cldm(:), cldt(:) ! (klon)
40      REAL, intent(out):: ctlwp(:) ! (klon)      REAL, intent(out):: ctlwp(:) ! (klon)
41      REAL, intent(out):: flwp(:), fiwp(:) ! (klon)      REAL, intent(out):: flwp(:), fiwp(:) ! (klon)
42      REAL, intent(out):: flwc(:, :), fiwc(:, :) ! (klon, klev)      REAL, intent(out):: flwc(:, :), fiwc(:, :) ! (klon, klev)
     LOGICAL, intent(in):: ok_aie ! apply aerosol indirect effect  
   
     REAL, intent(in):: sulfate(:, :) ! (klon, klev)  
     ! sulfate aerosol mass concentration (micro g m-3)  
   
     REAL, intent(in):: sulfate_pi(:, :) ! (klon, klev)  
     ! sulfate aerosol mass concentration (micro g m-3), pre-industrial value  
   
     REAL, intent(in):: bl95_b0, bl95_b1  
     ! Parameters in equation (D) of Boucher and Lohmann (1995, Tellus  
     ! B). They link cloud droplet number concentration to aerosol mass  
     ! concentration.  
43    
44      REAL, intent(out):: cldtaupi(:, :) ! (klon, klev)      ! Local:
     ! pre-industrial value of cloud optical thickness, needed for the  
     ! diagnosis of the aerosol indirect radiative forcing (see  
     ! radlwsw)  
45    
46      REAL, intent(out):: re(:, :) ! (klon, klev)      REAL re(klon, klev)
47      ! cloud droplet effective radius multiplied by fl (micro m)      ! cloud droplet effective radius multiplied by fl (micro m)
48    
49      REAL, intent(out):: fl(:, :) ! (klon, klev)      REAL fl(klon, klev)
50      ! Denominator to re, introduced to avoid problems in the averaging      ! Denominator to re, introduced to avoid problems in the averaging
51      ! of the output. fl is the fraction of liquid water clouds within      ! of the output. fl is the fraction of liquid water clouds within
52      ! a grid cell.      ! a grid cell.
53    
     ! Local:  
   
54      REAL, PARAMETER:: cetahb = 0.45, cetamb = 0.8      REAL, PARAMETER:: cetahb = 0.45, cetamb = 0.8
55      INTEGER i, k      INTEGER i, k
56      REAL zflwp(klon), fice      REAL zflwp ! liquid water path, in micrometers
57      REAL radius, rad_chaud      real fice ! fraction of ice in cloud
58        REAL rad_chaud ! effective radius of liquid cloud droplets, in micrometers
59      REAL, PARAMETER:: coef_chau = 0.13      REAL, PARAMETER:: coef_chau = 0.13
60      REAL, PARAMETER:: seuil_neb = 0.001, t_glace = 273. - 15.      REAL, PARAMETER:: seuil_neb = 0.001, t_glace = 258.
61      real rel, tc, rei, zfiwp(klon)      real tc, rei, zfiwp
62      real k_ice      real k_ice
63      real, parameter:: k_ice0 = 0.005 ! units=m2/g      real, parameter:: k_ice0 = 0.005 ! units=m2 / g
64      real, parameter:: DF = 1.66 ! diffusivity factor      real, parameter:: DF = 1.66 ! diffusivity factor
     REAL cdnc(klon, klev) ! cloud droplet number concentration (m-3)  
   
     REAL cdnc_pi(klon, klev)  
     ! cloud droplet number concentration, pre-industrial value (m-3)  
65    
66      !-----------------------------------------------------------------      !-----------------------------------------------------------------
67    
68      ! Calculer l'épaisseur optique et l'émissivité des nuages      ! Calculer l'\'epaisseur optique et l'\'emissivit\'e des nuages
69    
70      loop_horizontal: DO i = 1, klon      loop_horizontal: DO i = 1, klon
71         flwp(i) = 0.         flwp(i) = 0.
72         fiwp(i) = 0.         fiwp(i) = 0.
73    
74         DO k = 1, klev         loop_vertical: DO k = 1, klev
75            clc(i, k) = MAX(clc(i, k), seuil_neb)            clc(i, k) = MAX(clc(i, k), seuil_neb)
76    
77            ! liquid/ice cloud water paths:            ! liquid/ice cloud water paths:
78    
79              ! Linear transition:
80            fice = 1. - (t(i, k) - t_glace) / (273.13 - t_glace)            fice = 1. - (t(i, k) - t_glace) / (273.13 - t_glace)
81            fice = MIN(MAX(fice, 0.), 1.)            fice = MIN(MAX(fice, 0.), 1.)
82    
83            zflwp(i) = 1000. * (1. - fice) * qlwp(i, k) / clc(i, k) &            zflwp = 1000. * (1. - fice) * cldliq(i, k) / clc(i, k) &
84                 * (paprs(i, k) - paprs(i, k + 1)) / RG                 * (paprs(i, k) - paprs(i, k + 1)) / RG
85            zfiwp(i) = 1000. * fice * qlwp(i, k) / clc(i, k) &            zfiwp = 1000. * fice * cldliq(i, k) / clc(i, k) &
86                 * (paprs(i, k) - paprs(i, k + 1)) / RG                 * (paprs(i, k) - paprs(i, k + 1)) / RG
87    
88            flwp(i) = flwp(i) &            flwp(i) = flwp(i) + (1. - fice) * cldliq(i, k) &
89                 + (1. - fice) * qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG                 * (paprs(i, k) - paprs(i, k + 1)) / RG
90            fiwp(i) = fiwp(i) &            fiwp(i) = fiwp(i) &
91                 + fice * qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG                 + fice * cldliq(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG
92    
93            ! Total Liquid/Ice water content            ! Total Liquid/Ice water content
94            flwc(i, k) = (1.-fice) * qlwp(i, k)            flwc(i, k) = (1.-fice) * cldliq(i, k)
95            fiwc(i, k) = fice * qlwp(i, k)            fiwc(i, k) = fice * cldliq(i, k)
96            ! In-Cloud Liquid/Ice water content            ! In-Cloud Liquid/Ice water content
97    
98            ! effective cloud droplet radius (microns):            ! effective cloud droplet radius (microns):
99    
100            ! for liquid water clouds:            ! for liquid water clouds:
101            IF (ok_aie) THEN            rad_chaud = merge(rad_chau2, rad_chau1, k <= 3)
102               cdnc(i, k) = 10.**(bl95_b0 + bl95_b1 &            
                   * log10(MAX(sulfate(i, k), 1e-4))) * 1.e6  
              cdnc_pi(i, k) = 10.**(bl95_b0 + bl95_b1 &  
                   * log10(MAX(sulfate_pi(i, k), 1e-4))) * 1e6  
   
              ! Restrict to interval [20, 1000] cm^3:  
              cdnc(i, k) = MIN(1000e6, MAX(20e6, cdnc(i, k)))  
              cdnc_pi(i, k) = MIN(1000e6, MAX(20e6, cdnc_pi(i, k)))  
   
              ! air density: play(i, k) / (RD * T(i, k))  
              ! factor 1.1: derive effective radius from volume-mean radius  
              ! factor 1000 is the water density  
              ! "_chaud" means that this is the CDR for liquid water clouds  
   
              rad_chaud = 1.1 * ((qlwp(i, k) * play(i, k) / (RD * T(i, k))) &  
                   / (4./3. * PI * 1000. * cdnc(i, k)))**(1./3.)  
   
              ! Convert to micro m and set a lower limit:  
              rad_chaud = MAX(rad_chaud * 1e6, 5.)  
   
              ! Pre-industrial cloud optical thickness  
   
              ! "radius" is calculated as rad_chaud above (plus the  
              ! ice cloud contribution) but using cdnc_pi instead of  
              ! cdnc.  
              radius = 1.1 * ((qlwp(i, k) * play(i, k) / (RD * T(i, k))) &  
                   / (4./3. * PI * 1000. * cdnc_pi(i, k)))**(1./3.)  
              radius = MAX(radius * 1e6, 5.)  
   
              tc = t(i, k)-273.15  
              rei = merge(3.5, 0.71 * tc + 61.29, tc <= -81.4)  
              if (zflwp(i) == 0.) radius = 1.  
              if (zfiwp(i) == 0. .or. rei <= 0.) rei = 1.  
              cldtaupi(i, k) = 3. / 2. * zflwp(i) / radius &  
                   + zfiwp(i) * (3.448e-03 + 2.431 / rei)  
           else  
              rad_chaud = merge(rad_chau2, rad_chau1, k <= 3)  
           ENDIF  
103            ! For output diagnostics            ! For output diagnostics
104    
105            ! Cloud droplet effective radius (micro m)            ! Cloud droplet effective radius (micro m)
# Line 165  contains Line 113  contains
113            fl(i, k) = clc(i, k) * (1.-fice)            fl(i, k) = clc(i, k) * (1.-fice)
114            re(i, k) = rad_chaud * fl(i, k)            re(i, k) = rad_chaud * fl(i, k)
115    
           rel = rad_chaud  
116            ! for ice clouds: as a function of the ambiant temperature            ! for ice clouds: as a function of the ambiant temperature
117            ! (formula used by Iacobellis and Somerville (2000), with an            ! (formula used by Iacobellis and Somerville (2000), with an
118            ! asymptotical value of 3.5 microns at T<-81.4 C added to be            ! asymptotical value of 3.5 microns at T<-81.4 C added to be
# Line 173  contains Line 120  contains
120            tc = t(i, k)-273.15            tc = t(i, k)-273.15
121            rei = merge(3.5, 0.71 * tc + 61.29, tc <= -81.4)            rei = merge(3.5, 0.71 * tc + 61.29, tc <= -81.4)
122    
123            ! cloud optical thickness:            ! Cloud optical thickness. For liquid clouds, traditional
124              ! formula (e. g. Liou 2002 k0795 § 8.4.5.2). For ice clouds,
125            ! (for liquid clouds, traditional formula,            ! Ebert and Curry (1992).
126            ! for ice clouds, Ebert & Curry (1992))            if (zfiwp == 0. .or. rei <= 0.) rei = 1.
127              cldtau(i, k) = 3. / 2. * zflwp / rad_chaud &
128            if (zflwp(i) == 0.) rel = 1.                 + zfiwp * (3.448e-03 + 2.431 / rei)
           if (zfiwp(i) == 0. .or. rei <= 0.) rei = 1.  
           cltau(i, k) = 3./2. * (zflwp(i)/rel) &  
                + zfiwp(i) * (3.448e-03 + 2.431/rei)  
129    
130            ! cloud infrared emissivity:            ! cloud infrared emissivity:
131    
# Line 191  contains Line 135  contains
135            ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):            ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
136            k_ice = k_ice0 + 1. / rei            k_ice = k_ice0 + 1. / rei
137    
138            clemi(i, k) = 1. - EXP(- coef_chau * zflwp(i) - DF * k_ice * zfiwp(i))            clemi(i, k) = 1. - EXP(- coef_chau * zflwp - DF * k_ice * zfiwp)
139    
140            if (clc(i, k) <= seuil_neb) then            if (clc(i, k) <= seuil_neb) then
141               clc(i, k) = 0.               clc(i, k) = 0.
142               cltau(i, k) = 0.               cldtau(i, k) = 0.
143               clemi(i, k) = 0.               clemi(i, k) = 0.
              cldtaupi(i, k) = 0.  
144            end if            end if
145           ENDDO loop_vertical
           IF (.NOT. ok_aie) cldtaupi(i, k) = cltau(i, k)  
        ENDDO  
146      ENDDO loop_horizontal      ENDDO loop_horizontal
147    
148      ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS      ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
# Line 217  contains Line 158  contains
158      DO k = klev, 1, -1      DO k = klev, 1, -1
159         DO i = 1, klon         DO i = 1, klon
160            ctlwp(i) = ctlwp(i) &            ctlwp(i) = ctlwp(i) &
161                 + qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG                 + cldliq(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG
162            cldt(i) = cldt(i) * (1.-clc(i, k))            cldt(i) = cldt(i) * (1.-clc(i, k))
163            if (play(i, k) <= cetahb * paprs(i, 1)) &            if (play(i, k) <= cetahb * paprs(i, 1)) &
164                 cldh(i) = cldh(i) * (1. - clc(i, k))                 cldh(i) = cldh(i) * (1. - clc(i, k))
# Line 236  contains Line 177  contains
177         cldl(i)=1.-cldl(i)         cldl(i)=1.-cldl(i)
178      ENDDO      ENDDO
179    
180        CALL histwrite_phy("re", re)
181        CALL histwrite_phy("fl", fl)
182    
183    END SUBROUTINE newmicro    END SUBROUTINE newmicro
184    
185  end module newmicro_m  end module newmicro_m
Legend:
Removed from v.76  
changed lines
  Added in v.341
  ViewVC Help
Powered by ViewVC 1.1.21