Sources/phylmd/newmicro.f

module newmicro_m

  IMPLICIT none

contains

  SUBROUTINE newmicro (paprs, play, t, qlwp, clc, cltau, clemi, cldh, cldl, &
       cldm, cldt, ctlwp, flwp, fiwp, flwc, fiwc)

    ! From LMDZ4/libf/phylmd/newmicro.F, version 1.2 2004/06/03 09:22:43

    ! Authors: Z. X. Li (LMD/CNRS), Johannes Quaas
    ! Date: 1993/09/10
    ! Objet: calcul de l'épaisseur optique et de l'émissivité des nuages.

    USE conf_phys_m, ONLY: rad_chau1, rad_chau2
    USE dimphy, ONLY: klev, klon
    USE histwrite_phy_m, ONLY: histwrite_phy
    USE suphec_m, ONLY: rg

    REAL, intent(in):: paprs(:, :) ! (klon, klev+1)
    real, intent(in):: play(:, :) ! (klon, klev)
    REAL, intent(in):: t(:, :) ! (klon, klev) temperature

    REAL, intent(in):: qlwp(:, :) ! (klon, klev)
    ! eau liquide nuageuse dans l'atmosphère (kg/kg)

    REAL, intent(inout):: clc(:, :) ! (klon, klev)
    ! couverture nuageuse pour le rayonnement (0 à 1)

    REAL, intent(out):: cltau(:, :) ! (klon, klev)  épaisseur optique des nuages
    REAL, intent(out):: clemi(:, :) ! (klon, klev) émissivité des nuages (0 à 1)

    REAL, intent(out):: cldh(:), cldl(:), cldm(:), cldt(:) ! (klon)
    REAL, intent(out):: ctlwp(:) ! (klon)
    REAL, intent(out):: flwp(:), fiwp(:) ! (klon)
    REAL, intent(out):: flwc(:, :), fiwc(:, :) ! (klon, klev)

    ! Local:

    REAL re(klon, klev)
    ! cloud droplet effective radius multiplied by fl (micro m)

    REAL fl(klon, klev) 
    ! Denominator to re, introduced to avoid problems in the averaging
    ! of the output. fl is the fraction of liquid water clouds within
    ! a grid cell.

    REAL, PARAMETER:: cetahb = 0.45, cetamb = 0.8
    INTEGER i, k
    REAL zflwp(klon), fice
    REAL rad_chaud
    REAL, PARAMETER:: coef_chau = 0.13
    REAL, PARAMETER:: seuil_neb = 0.001, t_glace = 273. - 15.
    real rel, tc, rei, zfiwp(klon)
    real k_ice
    real, parameter:: k_ice0 = 0.005 ! units=m2/g
    real, parameter:: DF = 1.66 ! diffusivity factor

    !-----------------------------------------------------------------

    ! Calculer l'épaisseur optique et l'émissivité des nuages

    loop_horizontal: DO i = 1, klon
       flwp(i) = 0.
       fiwp(i) = 0.

       loop_vertical: DO k = 1, klev
          clc(i, k) = MAX(clc(i, k), seuil_neb)

          ! liquid/ice cloud water paths:

          fice = 1. - (t(i, k) - t_glace) / (273.13 - t_glace)
          fice = MIN(MAX(fice, 0.), 1.)

          zflwp(i) = 1000. * (1. - fice) * qlwp(i, k) / clc(i, k) &
               * (paprs(i, k) - paprs(i, k + 1)) / RG
          zfiwp(i) = 1000. * fice * qlwp(i, k) / clc(i, k) &
               * (paprs(i, k) - paprs(i, k + 1)) / RG

          flwp(i) = flwp(i) &
               + (1. - fice) * qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG
          fiwp(i) = fiwp(i) &
               + fice * qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG

          ! Total Liquid/Ice water content
          flwc(i, k) = (1.-fice) * qlwp(i, k)
          fiwc(i, k) = fice * qlwp(i, k)
          ! In-Cloud Liquid/Ice water content

          ! effective cloud droplet radius (microns):

          ! for liquid water clouds: 
          rad_chaud = merge(rad_chau2, rad_chau1, k <= 3)
          
          ! For output diagnostics

          ! Cloud droplet effective radius (micro m)

          ! we multiply here with f * xl (fraction of liquid water
          ! clouds in the grid cell) to avoid problems in the
          ! averaging of the output.
          ! In the output of IOIPSL, derive the real cloud droplet 
          ! effective radius as re/fl

          fl(i, k) = clc(i, k) * (1.-fice) 
          re(i, k) = rad_chaud * fl(i, k)

          rel = rad_chaud
          ! for ice clouds: as a function of the ambiant temperature
          ! (formula used by Iacobellis and Somerville (2000), with an 
          ! asymptotical value of 3.5 microns at T<-81.4 C added to be 
          ! consistent with observations of Heymsfield et al. 1986):
          tc = t(i, k)-273.15
          rei = merge(3.5, 0.71 * tc + 61.29, tc <= -81.4)

          ! cloud optical thickness:

          ! (for liquid clouds, traditional formula, 
          ! for ice clouds, Ebert & Curry (1992)) 

          if (zflwp(i) == 0.) rel = 1. 
          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)

          ! cloud infrared emissivity:

          ! (the broadband infrared absorption coefficient is parameterized
          ! as a function of the effective cld droplet radius)

          ! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
          k_ice = k_ice0 + 1. / rei

          clemi(i, k) = 1. - EXP(- coef_chau * zflwp(i) - DF * k_ice * zfiwp(i))

          if (clc(i, k) <= seuil_neb) then
             clc(i, k) = 0.
             cltau(i, k) = 0.
             clemi(i, k) = 0.
          end if
       ENDDO loop_vertical
    ENDDO loop_horizontal

    ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS

    DO i = 1, klon
       cldt(i)=1.
       cldh(i)=1.
       cldm(i) = 1.
       cldl(i) = 1.
       ctlwp(i) = 0.
    ENDDO

    DO k = klev, 1, -1
       DO i = 1, klon
          ctlwp(i) = ctlwp(i) &
               + qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG
          cldt(i) = cldt(i) * (1.-clc(i, k))
          if (play(i, k) <= cetahb * paprs(i, 1)) &
               cldh(i) = cldh(i) * (1. - clc(i, k))
          if (play(i, k) > cetahb * paprs(i, 1) .AND. &
               play(i, k) <= cetamb * paprs(i, 1)) &
               cldm(i) = cldm(i) * (1.-clc(i, k))
          if (play(i, k) > cetamb * paprs(i, 1)) &
               cldl(i) = cldl(i) * (1. - clc(i, k))
       ENDDO
    ENDDO

    DO i = 1, klon
       cldt(i)=1.-cldt(i)
       cldh(i)=1.-cldh(i)
       cldm(i)=1.-cldm(i)
       cldl(i)=1.-cldl(i)
    ENDDO

    CALL histwrite_phy("re", re)
    CALL histwrite_phy("fl", fl)

  END SUBROUTINE newmicro

end module newmicro_m
1	module newmicro_m
2
3	IMPLICIT none
4
5	contains
6
7	SUBROUTINE newmicro (paprs, play, t, qlwp, clc, cltau, clemi, cldh, cldl, &
8	cldm, cldt, ctlwp, flwp, fiwp, flwc, fiwc)
9
10	! 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
13	! Date: 1993/09/10
14	! Objet: calcul de l'épaisseur optique et de l'émissivité des nuages.
15
16	USE conf_phys_m, ONLY: rad_chau1, rad_chau2
17	USE dimphy, ONLY: klev, klon
18	USE histwrite_phy_m, ONLY: histwrite_phy
19	USE suphec_m, ONLY: rg
20
21	REAL, intent(in):: paprs(:, :) ! (klon, klev+1)
22	real, intent(in):: play(:, :) ! (klon, klev)
23	REAL, intent(in):: t(:, :) ! (klon, klev) temperature
24
25	REAL, intent(in):: qlwp(:, :) ! (klon, klev)
26	! eau liquide nuageuse dans l'atmosphère (kg/kg)
27
28	REAL, intent(inout):: clc(:, :) ! (klon, klev)
29	! couverture nuageuse pour le rayonnement (0 à 1)
30
31	REAL, intent(out):: cltau(:, :) ! (klon, klev) épaisseur optique des nuages
32	REAL, intent(out):: clemi(:, :) ! (klon, klev) émissivité des nuages (0 à 1)
33
34	REAL, intent(out):: cldh(:), cldl(:), cldm(:), cldt(:) ! (klon)
35	REAL, intent(out):: ctlwp(:) ! (klon)
36	REAL, intent(out):: flwp(:), fiwp(:) ! (klon)
37	REAL, intent(out):: flwc(:, :), fiwc(:, :) ! (klon, klev)
38
39	! Local:
40
41	REAL re(klon, klev)
42	! cloud droplet effective radius multiplied by fl (micro m)
43
44	REAL fl(klon, klev)
45	! Denominator to re, introduced to avoid problems in the averaging
46	! of the output. fl is the fraction of liquid water clouds within
47	! a grid cell.
48
49	REAL, PARAMETER:: cetahb = 0.45, cetamb = 0.8
50	INTEGER i, k
51	REAL zflwp(klon), fice
52	REAL rad_chaud
53	REAL, PARAMETER:: coef_chau = 0.13
54	REAL, PARAMETER:: seuil_neb = 0.001, t_glace = 273. - 15.
55	real rel, tc, rei, zfiwp(klon)
56	real k_ice
57	real, parameter:: k_ice0 = 0.005 ! units=m2/g
58	real, parameter:: DF = 1.66 ! diffusivity factor
59
60	!-----------------------------------------------------------------
61
62	! Calculer l'épaisseur optique et l'émissivité des nuages
63
64	loop_horizontal: DO i = 1, klon
65	flwp(i) = 0.
66	fiwp(i) = 0.
67
68	loop_vertical: DO k = 1, klev
69	clc(i, k) = MAX(clc(i, k), seuil_neb)
70
71	! liquid/ice cloud water paths:
72
73	fice = 1. - (t(i, k) - t_glace) / (273.13 - t_glace)
74	fice = MIN(MAX(fice, 0.), 1.)
75
76	zflwp(i) = 1000. * (1. - fice) * qlwp(i, k) / clc(i, k) &
77	* (paprs(i, k) - paprs(i, k + 1)) / RG
78	zfiwp(i) = 1000. * fice * qlwp(i, k) / clc(i, k) &
79	* (paprs(i, k) - paprs(i, k + 1)) / RG
80
81	flwp(i) = flwp(i) &
82	+ (1. - fice) * qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG
83	fiwp(i) = fiwp(i) &
84	+ fice * qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG
85
86	! Total Liquid/Ice water content
87	flwc(i, k) = (1.-fice) * qlwp(i, k)
88	fiwc(i, k) = fice * qlwp(i, k)
89	! In-Cloud Liquid/Ice water content
90
91	! effective cloud droplet radius (microns):
92
93	! for liquid water clouds:
94	rad_chaud = merge(rad_chau2, rad_chau1, k <= 3)
95
96	! For output diagnostics
97
98	! Cloud droplet effective radius (micro m)
99
100	! we multiply here with f * xl (fraction of liquid water
101	! clouds in the grid cell) to avoid problems in the
102	! averaging of the output.
103	! In the output of IOIPSL, derive the real cloud droplet
104	! effective radius as re/fl
105
106	fl(i, k) = clc(i, k) * (1.-fice)
107	re(i, k) = rad_chaud * fl(i, k)
108
109	rel = rad_chaud
110	! for ice clouds: as a function of the ambiant temperature
111	! (formula used by Iacobellis and Somerville (2000), with an
112	! asymptotical value of 3.5 microns at T<-81.4 C added to be
113	! consistent with observations of Heymsfield et al. 1986):
114	tc = t(i, k)-273.15
115	rei = merge(3.5, 0.71 * tc + 61.29, tc <= -81.4)
116
117	! cloud optical thickness:
118
119	! (for liquid clouds, traditional formula,
120	! for ice clouds, Ebert & Curry (1992))
121
122	if (zflwp(i) == 0.) rel = 1.
123	if (zfiwp(i) == 0. .or. rei <= 0.) rei = 1.
124	cltau(i, k) = 3./2. * (zflwp(i)/rel) &
125	+ zfiwp(i) * (3.448e-03 + 2.431/rei)
126
127	! cloud infrared emissivity:
128
129	! (the broadband infrared absorption coefficient is parameterized
130	! as a function of the effective cld droplet radius)
131
132	! Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
133	k_ice = k_ice0 + 1. / rei
134
135	clemi(i, k) = 1. - EXP(- coef_chau * zflwp(i) - DF * k_ice * zfiwp(i))
136
137	if (clc(i, k) <= seuil_neb) then
138	clc(i, k) = 0.
139	cltau(i, k) = 0.
140	clemi(i, k) = 0.
141	end if
142	ENDDO loop_vertical
143	ENDDO loop_horizontal
144
145	! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
146
147	DO i = 1, klon
148	cldt(i)=1.
149	cldh(i)=1.
150	cldm(i) = 1.
151	cldl(i) = 1.
152	ctlwp(i) = 0.
153	ENDDO
154
155	DO k = klev, 1, -1
156	DO i = 1, klon
157	ctlwp(i) = ctlwp(i) &
158	+ qlwp(i, k) * (paprs(i, k) - paprs(i, k + 1)) / RG
159	cldt(i) = cldt(i) * (1.-clc(i, k))
160	if (play(i, k) <= cetahb * paprs(i, 1)) &
161	cldh(i) = cldh(i) * (1. - clc(i, k))
162	if (play(i, k) > cetahb * paprs(i, 1) .AND. &
163	play(i, k) <= cetamb * paprs(i, 1)) &
164	cldm(i) = cldm(i) * (1.-clc(i, k))
165	if (play(i, k) > cetamb * paprs(i, 1)) &
166	cldl(i) = cldl(i) * (1. - clc(i, k))
167	ENDDO
168	ENDDO
169
170	DO i = 1, klon
171	cldt(i)=1.-cldt(i)
172	cldh(i)=1.-cldh(i)
173	cldm(i)=1.-cldm(i)
174	cldl(i)=1.-cldl(i)
175	ENDDO
176
177	CALL histwrite_phy("re", re)
178	CALL histwrite_phy("fl", fl)
179
180	END SUBROUTINE newmicro
181
182	end module newmicro_m