| 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 |
guez |
225 |
real, intent(out):: pclemi(klon, klev) ! \'emissivit\'e 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 |
|
|
REAL coef, coef_froi, coef_chau |
| 48 |
|
|
PARAMETER (coef_chau=0.13, coef_froi=0.09) |
| 49 |
|
|
REAL seuil_neb, t_glace |
| 50 |
|
|
PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0) |
| 51 |
|
|
INTEGER nexpo ! exponentiel pour glace/eau |
| 52 |
|
|
PARAMETER (nexpo=6) |
| 53 |
guez |
51 |
|
| 54 |
guez |
213 |
!-------------------------------------------------------------------- |
| 55 |
|
|
|
| 56 |
|
|
! Calculer l'epaisseur optique et l'emmissivite des nuages |
| 57 |
guez |
51 |
|
| 58 |
guez |
175 |
DO k = 1, klev |
| 59 |
|
|
DO i = 1, klon |
| 60 |
|
|
rad_chaud = rad_chau1 |
| 61 |
guez |
213 |
IF (k <= 3) rad_chaud = rad_chau2 |
| 62 |
guez |
51 |
|
| 63 |
guez |
213 |
pclc(i, k) = MAX(pclc(i, k), seuil_neb) |
| 64 |
|
|
zflwp = 1000.*pqlwp(i, k)/RG/pclc(i, k) & |
| 65 |
|
|
*(paprs(i, k)-paprs(i, k+1)) |
| 66 |
|
|
zfice = 1.0 - (t(i, k)-t_glace) / (273.13-t_glace) |
| 67 |
|
|
zfice = MIN(MAX(zfice, 0.0), 1.0) |
| 68 |
guez |
175 |
zfice = zfice**nexpo |
| 69 |
guez |
51 |
|
| 70 |
guez |
175 |
radius = rad_chaud * (1.-zfice) + rad_froid * zfice |
| 71 |
|
|
coef = coef_chau * (1.-zfice) + coef_froi * zfice |
| 72 |
guez |
213 |
pcltau(i, k) = 3.0/2.0 * zflwp / radius |
| 73 |
|
|
pclemi(i, k) = 1.0 - EXP(- coef * zflwp) |
| 74 |
|
|
lo = (pclc(i, k) <= seuil_neb) |
| 75 |
|
|
IF (lo) pclc(i, k) = 0.0 |
| 76 |
|
|
IF (lo) pcltau(i, k) = 0.0 |
| 77 |
|
|
IF (lo) pclemi(i, k) = 0.0 |
| 78 |
guez |
175 |
END DO |
| 79 |
|
|
END DO |
| 80 |
guez |
213 |
|
| 81 |
guez |
175 |
! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS |
| 82 |
guez |
213 |
|
| 83 |
guez |
175 |
DO i = 1, klon |
| 84 |
|
|
pct(i)=1.0 |
| 85 |
|
|
pch(i)=1.0 |
| 86 |
|
|
pcm(i) = 1.0 |
| 87 |
|
|
pcl(i) = 1.0 |
| 88 |
|
|
pctlwp(i) = 0.0 |
| 89 |
|
|
END DO |
| 90 |
guez |
213 |
|
| 91 |
guez |
175 |
DO k = klev, 1, -1 |
| 92 |
|
|
DO i = 1, klon |
| 93 |
guez |
213 |
pctlwp(i) = pctlwp(i) & |
| 94 |
|
|
+ pqlwp(i, k)*(paprs(i, k)-paprs(i, k+1))/RG |
| 95 |
|
|
pct(i) = pct(i)*(1.0-pclc(i, k)) |
| 96 |
|
|
if (pplay(i, k) <= cetahb*paprs(i, 1)) & |
| 97 |
|
|
pch(i) = pch(i)*(1.0-pclc(i, k)) |
| 98 |
|
|
if (pplay(i, k) > cetahb*paprs(i, 1) .AND. & |
| 99 |
|
|
pplay(i, k) <= cetamb*paprs(i, 1)) & |
| 100 |
|
|
pcm(i) = pcm(i)*(1.0-pclc(i, k)) |
| 101 |
|
|
if (pplay(i, k) > cetamb*paprs(i, 1)) & |
| 102 |
|
|
pcl(i) = pcl(i)*(1.0-pclc(i, k)) |
| 103 |
guez |
175 |
END DO |
| 104 |
|
|
END DO |
| 105 |
guez |
213 |
|
| 106 |
guez |
175 |
DO i = 1, klon |
| 107 |
|
|
pct(i)=1.-pct(i) |
| 108 |
|
|
pch(i)=1.-pch(i) |
| 109 |
|
|
pcm(i)=1.-pcm(i) |
| 110 |
|
|
pcl(i)=1.-pcl(i) |
| 111 |
|
|
END DO |
| 112 |
guez |
213 |
|
| 113 |
guez |
175 |
END SUBROUTINE nuage |
| 114 |
|
|
|
| 115 |
|
|
end module nuage_m |
Parent Directory
| 
Revision Log