/[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 337 by guez, Mon Sep 16 16:54:50 2019 UTC revision 339 by guez, Thu Sep 26 17:08:42 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, cldtau, clemi, cldh, cldl, &    SUBROUTINE newmicro (paprs, play, t, cldliq, clc, cldtau, clemi, cldh, cldl, &
8         cldm, cldt, ctlwp, flwp, fiwp, flwc, fiwc)         cldm, cldt, ctlwp, flwp, fiwp, flwc, fiwc)
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
# Line 19  contains Line 19  contains
19      USE suphec_m, ONLY: rg      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)
# Line 56  contains Line 58  contains
58      REAL rad_chaud      REAL rad_chaud
59      REAL, PARAMETER:: coef_chau = 0.13      REAL, PARAMETER:: coef_chau = 0.13
60      REAL, PARAMETER:: seuil_neb = 0.001, t_glace = 258.      REAL, PARAMETER:: seuil_neb = 0.001, t_glace = 258.
61      real rel, tc, rei, zfiwp      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
# Line 78  contains Line 80  contains
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 = 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 = 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):
# Line 111  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 119  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            ! (for liquid clouds, traditional formula, for ice clouds,            ! formula (e. g. Liou 2002 k0795 § 8.4.5.2). For ice clouds,
125            ! Ebert and Curry (1992))            ! Ebert and Curry (1992).
           if (zflwp == 0.) rel = 1.  
126            if (zfiwp == 0. .or. rei <= 0.) rei = 1.            if (zfiwp == 0. .or. rei <= 0.) rei = 1.
127            cldtau(i, k) = 3. / 2. * (zflwp / rel) &            cldtau(i, k) = 3. / 2. * zflwp / rad_chaud &
128                 + zfiwp * (3.448e-03 + 2.431 / rei)                 + zfiwp * (3.448e-03 + 2.431 / rei)
129    
130            ! cloud infrared emissivity:            ! cloud infrared emissivity:
# Line 158  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))
Legend:
Removed from v.337  
changed lines
  Added in v.339
  ViewVC Help
Powered by ViewVC 1.1.21