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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 81 - (show annotations)
Wed Mar 5 14:38:41 2014 UTC (10 years, 2 months ago) by guez
File size: 3964 byte(s) 
 Converted to free source form files which were still in fixed source
form. The conversion was done using the polish mode of the NAG Fortran
Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).
1 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