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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 341 - (show annotations)
Mon Oct 21 06:11:44 2019 UTC (4 years, 6 months ago) by guez
File size: 4173 byte(s) 
Remove intermediate variables in `pbl_surface`

Remove file `diagcld2.f90`, no longer used since revision 340.

In procedure cdrag, rename zcdn to cdn. In procedure `interfsurf_hq`,
rename `temp_air` to t1lay: this is the corresponding name in
`calcul_fluxs`, is consistent with the other names `[uvq]1lay` and is
more precise.

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