/[lmdze]/trunk/phylmd/Radlwsw/swde.f90
ViewVC logotype

Annotation of /trunk/phylmd/Radlwsw/swde.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 254 - (hide annotations)
Mon Feb 5 10:39:38 2018 UTC (6 years, 3 months ago) by guez
Original Path: trunk/phylmd/Radlwsw/swde.f
File size: 4270 byte(s)
Move Sources/* to root directory.
1 guez 207 module swde_m
2    
3 guez 81 IMPLICIT NONE
4    
5 guez 207 contains
6 guez 81
7 guez 207 SUBROUTINE swde(pgg, pref, prmuz, pto1, pw, pre1, pre2, ptr1, ptr2)
8     USE dimens_m
9     USE dimphy
10     USE raddim
11     ! ------------------------------------------------------------------
12     ! PURPOSE.
13     ! --------
14     ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
15     ! LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
16 guez 81
17 guez 207 ! METHOD.
18     ! -------
19 guez 81
20 guez 207 ! STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
21 guez 81
22 guez 207 ! REFERENCE.
23     ! ----------
24 guez 81
25 guez 207 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
26     ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
27 guez 81
28 guez 207 ! AUTHOR.
29     ! -------
30     ! JEAN-JACQUES MORCRETTE *ECMWF*
31 guez 81
32 guez 207 ! MODIFICATIONS.
33     ! --------------
34     ! ORIGINAL : 88-12-15
35     ! ------------------------------------------------------------------
36     ! * ARGUMENTS:
37 guez 81
38 guez 207 DOUBLE PRECISION pgg(kdlon) ! ASSYMETRY FACTOR
39     DOUBLE PRECISION pref(kdlon) ! REFLECTIVITY OF THE UNDERLYING LAYER
40     DOUBLE PRECISION prmuz(kdlon) ! COSINE OF SOLAR ZENITH ANGLE
41     DOUBLE PRECISION pto1(kdlon) ! OPTICAL THICKNESS
42     DOUBLE PRECISION pw(kdlon) ! SINGLE SCATTERING ALBEDO
43     DOUBLE PRECISION pre1(kdlon) ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
44     DOUBLE PRECISION pre2(kdlon) ! LAYER REFLECTIVITY
45     DOUBLE PRECISION ptr1(kdlon) ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
46     DOUBLE PRECISION ptr2(kdlon) ! LAYER TRANSMISSIVITY
47 guez 81
48 guez 207 ! * LOCAL VARIABLES:
49 guez 81
50 guez 207 INTEGER jl
51     DOUBLE PRECISION zff, zgp, ztop, zwcp, zdt, zx1, zwm
52     DOUBLE PRECISION zrm2, zrk, zx2, zrp, zalpha, zbeta, zarg
53     DOUBLE PRECISION zexmu0, zarg2, zexkp, zexkm, zxp2p, zxm2p, zap2b
54     DOUBLE PRECISION zam2b
55     DOUBLE PRECISION za11, za12, za13, za21, za22, za23
56     DOUBLE PRECISION zdena, zc1a, zc2a, zri0a, zri1a
57     DOUBLE PRECISION zri0b, zri1b
58     DOUBLE PRECISION zb21, zb22, zb23, zdenb, zc1b, zc2b
59     DOUBLE PRECISION zri0c, zri1c, zri0d, zri1d
60     ! ------------------------------------------------------------------
61 guez 81
62 guez 207 ! * 1. DELTA-EDDINGTON CALCULATIONS
63 guez 81
64    
65 guez 207 DO jl = 1, kdlon
66 guez 81
67 guez 207 ! * 1.1 SET UP THE DELTA-MODIFIED PARAMETERS
68 guez 81
69    
70 guez 207 zff = pgg(jl)*pgg(jl)
71     zgp = pgg(jl)/(1.+pgg(jl))
72     ztop = (1.-pw(jl)*zff)*pto1(jl)
73     zwcp = (1-zff)*pw(jl)/(1.-pw(jl)*zff)
74     zdt = 2./3.
75     zx1 = 1. - zwcp*zgp
76     zwm = 1. - zwcp
77     zrm2 = prmuz(jl)*prmuz(jl)
78     zrk = sqrt(3.*zwm*zx1)
79     zx2 = 4.*(1.-zrk*zrk*zrm2)
80     zrp = zrk/zx1
81     zalpha = 3.*zwcp*zrm2*(1.+zgp*zwm)/zx2
82     zbeta = 3.*zwcp*prmuz(jl)*(1.+3.*zgp*zrm2*zwm)/zx2
83     ! MAF ZARG=MIN(ZTOP/PRMUZ(JL),200.)
84     zarg = min(ztop/prmuz(jl), 2.0D+2)
85     zexmu0 = exp(-zarg)
86     ! MAF ZARG2=MIN(ZRK*ZTOP,200.)
87     zarg2 = min(zrk*ztop, 2.0D+2)
88     zexkp = exp(zarg2)
89     zexkm = 1./zexkp
90     zxp2p = 1. + zdt*zrp
91     zxm2p = 1. - zdt*zrp
92     zap2b = zalpha + zdt*zbeta
93     zam2b = zalpha - zdt*zbeta
94 guez 81
95 guez 207 ! * 1.2 WITHOUT REFLECTION FROM THE UNDERLYING LAYER
96 guez 81
97    
98 guez 207 za11 = zxp2p
99     za12 = zxm2p
100     za13 = zap2b
101     za22 = zxp2p*zexkp
102     za21 = zxm2p*zexkm
103     za23 = zam2b*zexmu0
104     zdena = za11*za22 - za21*za12
105     zc1a = (za22*za13-za12*za23)/zdena
106     zc2a = (za11*za23-za21*za13)/zdena
107     zri0a = zc1a + zc2a - zalpha
108     zri1a = zrp*(zc1a-zc2a) - zbeta
109     pre1(jl) = (zri0a-zdt*zri1a)/prmuz(jl)
110     zri0b = zc1a*zexkm + zc2a*zexkp - zalpha*zexmu0
111     zri1b = zrp*(zc1a*zexkm-zc2a*zexkp) - zbeta*zexmu0
112     ptr1(jl) = zexmu0 + (zri0b+zdt*zri1b)/prmuz(jl)
113 guez 81
114 guez 207 ! * 1.3 WITH REFLECTION FROM THE UNDERLYING LAYER
115 guez 81
116    
117 guez 207 zb21 = za21 - pref(jl)*zxp2p*zexkm
118     zb22 = za22 - pref(jl)*zxm2p*zexkp
119     zb23 = za23 - pref(jl)*zexmu0*(zap2b-prmuz(jl))
120     zdenb = za11*zb22 - zb21*za12
121     zc1b = (zb22*za13-za12*zb23)/zdenb
122     zc2b = (za11*zb23-zb21*za13)/zdenb
123     zri0c = zc1b + zc2b - zalpha
124     zri1c = zrp*(zc1b-zc2b) - zbeta
125     pre2(jl) = (zri0c-zdt*zri1c)/prmuz(jl)
126     zri0d = zc1b*zexkm + zc2b*zexkp - zalpha*zexmu0
127     zri1d = zrp*(zc1b*zexkm-zc2b*zexkp) - zbeta*zexmu0
128     ptr2(jl) = zexmu0 + (zri0d+zdt*zri1d)/prmuz(jl)
129    
130     END DO
131     RETURN
132     END SUBROUTINE swde
133    
134     end module swde_m

  ViewVC Help
Powered by ViewVC 1.1.21