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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.21