trunk/phylmd/nuage.f

module nuage_m

  IMPLICIT none

contains

  SUBROUTINE nuage (paprs, pplay, t, pqlwp, pclc, pcltau, pclemi, pch, pcl, &
       pcm, pct, pctlwp)

    ! From LMDZ4/libf/phylmd/nuage.F, version 1.1.1.1, 2004/05/19 12:53:07

    use dimphy, only: klon, klev
    use SUPHEC_M, only: rg

    ! Author: Z. X. Li (LMD/CNRS)
    ! Date: 1993/09/10
    ! Objet: Calculer \'epaisseur optique et \'emissivit\'e des nuages

    ! Arguments:

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

    REAL, intent(in):: pqlwp(klon, klev)
    ! eau liquide nuageuse dans l'atmosphere (kg/kg)

    REAL, intent(inout):: pclc(klon, klev)
    ! couverture nuageuse pour le rayonnement (0 \`a 1)

    REAL, intent(out):: pcltau(klon, klev) ! \'epaisseur optique des nuages
    real pclemi(klon, klev) ! pclemi--output-R-emissivite des nuages (0 a 1)
    REAL pch(klon), pcl(klon), pcm(klon), pct(klon), pctlwp(klon)

    ! Local:

    LOGICAL lo

    REAL cetahb, cetamb
    PARAMETER (cetahb = 0.45, cetamb = 0.80)

    INTEGER i, k
    REAL zflwp, zfice

    REAL radius, rad_froid, rad_chaud, rad_chau1, rad_chau2
    PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
    !cc PARAMETER (rad_chaud=15.0, rad_froid=35.0)
    ! sintex initial PARAMETER (rad_chaud=10.0, rad_froid=30.0)
    REAL coef, coef_froi, coef_chau
    PARAMETER (coef_chau=0.13, coef_froi=0.09)
    REAL seuil_neb, t_glace
    PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0)
    INTEGER nexpo ! exponentiel pour glace/eau
    PARAMETER (nexpo=6)

    !--------------------------------------------------------------------
    
    ! Calculer l'epaisseur optique et l'emmissivite des nuages

    DO k = 1, klev
       DO i = 1, klon
          rad_chaud = rad_chau1
          IF (k <= 3) rad_chaud = rad_chau2

          pclc(i, k) = MAX(pclc(i, k), seuil_neb)
          zflwp = 1000.*pqlwp(i, k)/RG/pclc(i, k) &
               *(paprs(i, k)-paprs(i, k+1))
          zfice = 1.0 - (t(i, k)-t_glace) / (273.13-t_glace)
          zfice = MIN(MAX(zfice, 0.0), 1.0)
          zfice = zfice**nexpo

          radius = rad_chaud * (1.-zfice) + rad_froid * zfice
          coef = coef_chau * (1.-zfice) + coef_froi * zfice
          pcltau(i, k) = 3.0/2.0 * zflwp / radius
          pclemi(i, k) = 1.0 - EXP(- coef * zflwp)
          lo = (pclc(i, k) <= seuil_neb)
          IF (lo) pclc(i, k) = 0.0
          IF (lo) pcltau(i, k) = 0.0
          IF (lo) pclemi(i, k) = 0.0
       END DO
    END DO

    ! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS

    DO i = 1, klon
       pct(i)=1.0
       pch(i)=1.0
       pcm(i) = 1.0
       pcl(i) = 1.0
       pctlwp(i) = 0.0
    END DO

    DO k = klev, 1, -1
       DO i = 1, klon
          pctlwp(i) = pctlwp(i) &
               + pqlwp(i, k)*(paprs(i, k)-paprs(i, k+1))/RG
          pct(i) = pct(i)*(1.0-pclc(i, k))
          if (pplay(i, k) <= cetahb*paprs(i, 1)) &
               pch(i) = pch(i)*(1.0-pclc(i, k))
          if (pplay(i, k) > cetahb*paprs(i, 1) .AND. &
               pplay(i, k) <= cetamb*paprs(i, 1)) &
               pcm(i) = pcm(i)*(1.0-pclc(i, k))
          if (pplay(i, k) > cetamb*paprs(i, 1)) &
               pcl(i) = pcl(i)*(1.0-pclc(i, k))
       END DO
    END DO

    DO i = 1, klon
       pct(i)=1.-pct(i)
       pch(i)=1.-pch(i)
       pcm(i)=1.-pcm(i)
       pcl(i)=1.-pcl(i)
    END DO

  END SUBROUTINE nuage

end module nuage_m
1	guez	175	module nuage_m
2
3	guez	51	IMPLICIT none
4	guez	3
5	guez	175	contains
6	guez	3
7	guez	175	SUBROUTINE nuage (paprs, pplay, t, pqlwp, pclc, pcltau, pclemi, pch, pcl, &
8	guez	217	pcm, pct, pctlwp)
9	guez	213
10			! From LMDZ4/libf/phylmd/nuage.F, version 1.1.1.1, 2004/05/19 12:53:07
11
12			use dimphy, only: klon, klev
13	guez	217	use SUPHEC_M, only: rg
14	guez	213
15			! Author: Z. X. Li (LMD/CNRS)
16			! Date: 1993/09/10
17			! Objet: Calculer \'epaisseur optique et \'emissivit\'e des nuages
18
19	guez	175	! Arguments:
20	guez	213
21			REAL, intent(in):: paprs(klon, klev+1)
22			real, intent(in):: pplay(klon, klev)
23			REAL, intent(in):: t(klon, klev) ! temperature
24
25			REAL, intent(in):: pqlwp(klon, klev)
26			! eau liquide nuageuse dans l'atmosphere (kg/kg)
27
28			REAL, intent(inout):: pclc(klon, klev)
29			! couverture nuageuse pour le rayonnement (0 \`a 1)
30
31	guez	217	REAL, intent(out):: pcltau(klon, klev) ! \'epaisseur optique des nuages
32			real pclemi(klon, klev) ! pclemi--output-R-emissivite des nuages (0 a 1)
33	guez	213	REAL pch(klon), pcl(klon), pcm(klon), pct(klon), pctlwp(klon)
34
35			! Local:
36
37	guez	175	LOGICAL lo
38	guez	213
39	guez	175	REAL cetahb, cetamb
40			PARAMETER (cetahb = 0.45, cetamb = 0.80)
41	guez	213
42	guez	175	INTEGER i, k
43			REAL zflwp, zfice
44	guez	213
45	guez	175	REAL radius, rad_froid, rad_chaud, rad_chau1, rad_chau2
46			PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
47	guez	213	!cc PARAMETER (rad_chaud=15.0, rad_froid=35.0)
48			! sintex initial PARAMETER (rad_chaud=10.0, rad_froid=30.0)
49	guez	175	REAL coef, coef_froi, coef_chau
50			PARAMETER (coef_chau=0.13, coef_froi=0.09)
51			REAL seuil_neb, t_glace
52			PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0)
53			INTEGER nexpo ! exponentiel pour glace/eau
54			PARAMETER (nexpo=6)
55	guez	51
56	guez	213	!--------------------------------------------------------------------
57
58			! Calculer l'epaisseur optique et l'emmissivite des nuages
59	guez	51
60	guez	175	DO k = 1, klev
61			DO i = 1, klon
62			rad_chaud = rad_chau1
63	guez	213	IF (k <= 3) rad_chaud = rad_chau2
64	guez	51
65	guez	213	pclc(i, k) = MAX(pclc(i, k), seuil_neb)
66			zflwp = 1000.*pqlwp(i, k)/RG/pclc(i, k) &
67			*(paprs(i, k)-paprs(i, k+1))
68			zfice = 1.0 - (t(i, k)-t_glace) / (273.13-t_glace)
69			zfice = MIN(MAX(zfice, 0.0), 1.0)
70	guez	175	zfice = zfice**nexpo
71	guez	51
72	guez	175	radius = rad_chaud * (1.-zfice) + rad_froid * zfice
73			coef = coef_chau * (1.-zfice) + coef_froi * zfice
74	guez	213	pcltau(i, k) = 3.0/2.0 * zflwp / radius
75			pclemi(i, k) = 1.0 - EXP(- coef * zflwp)
76			lo = (pclc(i, k) <= seuil_neb)
77			IF (lo) pclc(i, k) = 0.0
78			IF (lo) pcltau(i, k) = 0.0
79			IF (lo) pclemi(i, k) = 0.0
80	guez	175	END DO
81			END DO
82	guez	213
83	guez	175	! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
84	guez	213
85	guez	175	DO i = 1, klon
86			pct(i)=1.0
87			pch(i)=1.0
88			pcm(i) = 1.0
89			pcl(i) = 1.0
90			pctlwp(i) = 0.0
91			END DO
92	guez	213
93	guez	175	DO k = klev, 1, -1
94			DO i = 1, klon
95	guez	213	pctlwp(i) = pctlwp(i) &
96			+ pqlwp(i, k)*(paprs(i, k)-paprs(i, k+1))/RG
97			pct(i) = pct(i)*(1.0-pclc(i, k))
98			if (pplay(i, k) <= cetahb*paprs(i, 1)) &
99			pch(i) = pch(i)*(1.0-pclc(i, k))
100			if (pplay(i, k) > cetahb*paprs(i, 1) .AND. &
101			pplay(i, k) <= cetamb*paprs(i, 1)) &
102			pcm(i) = pcm(i)*(1.0-pclc(i, k))
103			if (pplay(i, k) > cetamb*paprs(i, 1)) &
104			pcl(i) = pcl(i)*(1.0-pclc(i, k))
105	guez	175	END DO
106			END DO
107	guez	213
108	guez	175	DO i = 1, klon
109			pct(i)=1.-pct(i)
110			pch(i)=1.-pch(i)
111			pcm(i)=1.-pcm(i)
112			pcl(i)=1.-pcl(i)
113			END DO
114	guez	213
115	guez	175	END SUBROUTINE nuage
116
117			end module nuage_m