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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 341 - (hide annotations)
Mon Oct 21 06:11:44 2019 UTC (4 years, 7 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 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 guez 341
9     USE raddim, only: kdlon
10    
11 guez 207 ! PURPOSE.
12     ! --------
13     ! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
14     ! LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
15 guez 81
16 guez 207 ! METHOD.
17     ! -------
18 guez 81
19 guez 207 ! STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
20 guez 81
21 guez 207 ! REFERENCE.
22     ! ----------
23 guez 81
24 guez 207 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
25     ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
26 guez 81
27 guez 207 ! AUTHOR.
28     ! -------
29     ! JEAN-JACQUES MORCRETTE *ECMWF*
30 guez 81
31 guez 207 ! MODIFICATIONS.
32     ! --------------
33     ! ORIGINAL : 88-12-15
34     ! ------------------------------------------------------------------
35     ! * ARGUMENTS:
36 guez 81
37 guez 207 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 guez 81
47 guez 207 ! * LOCAL VARIABLES:
48 guez 81
49 guez 207 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 guez 81
61 guez 207 ! * 1. DELTA-EDDINGTON CALCULATIONS
62 guez 81
63    
64 guez 207 DO jl = 1, kdlon
65 guez 81
66 guez 207 ! * 1.1 SET UP THE DELTA-MODIFIED PARAMETERS
67 guez 81
68    
69 guez 207 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 guez 81
94 guez 207 ! * 1.2 WITHOUT REFLECTION FROM THE UNDERLYING LAYER
95 guez 81
96    
97 guez 207 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 guez 81
113 guez 207 ! * 1.3 WITH REFLECTION FROM THE UNDERLYING LAYER
114 guez 81
115    
116 guez 207 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 guez 341 END DO
129 guez 207
130     END SUBROUTINE swde
131    
132     end module swde_m
  ViewVC Help
Powered by ViewVC 1.1.21