trunk/phylmd/newmicro.f90

module newmicro_m

  IMPLICIT none

contains

  SUBROUTINE newmicro (paprs, play, t, cldliq, clc, cldtau, 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'\'epaisseur optique et de l'\'emissivit\'e 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)
    ! pression pour chaque inter-couche, en Pa

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

    REAL, intent(in):: cldliq(:, :) ! (klon, klev)
    ! mass fraction of liquid water in atmosphere

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

    REAL, intent(out):: cldtau(:, :) ! (klon, klev)
    ! \'epaisseur optique des nuages
    
    REAL, intent(out):: clemi(:, :) ! (klon, klev)
    ! \'emissivit\'e 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 ! liquid water path, in micrometers
    real fice ! fraction of ice in cloud
    REAL rad_chaud ! effective radius of liquid cloud droplets, in micrometers
    REAL, PARAMETER:: coef_chau = 0.13
    REAL, PARAMETER:: seuil_neb = 0.001, t_glace = 258.
    real tc, rei, zfiwp
    real k_ice
    real, parameter:: k_ice0 = 0.005 ! units=m2 / g
    real, parameter:: DF = 1.66 ! diffusivity factor

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

    ! Calculer l'\'epaisseur optique et l'\'emissivit\'e 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:

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

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

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

          ! Total Liquid/Ice water content
          flwc(i, k) = (1.-fice) * cldliq(i, k)
          fiwc(i, k) = fice * cldliq(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)

          ! 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 (e. g. Liou 2002 k0795 § 8.4.5.2). For ice clouds,
          ! Ebert and Curry (1992).
          if (zfiwp == 0. .or. rei <= 0.) rei = 1. 
          cldtau(i, k) = 3. / 2. * zflwp / rad_chaud &
               + zfiwp * (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 - DF * k_ice * zfiwp)

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