phylmd/Radlwsw/swde.f

      SUBROUTINE SWDE (PGG,PREF,PRMUZ,PTO1,PW,
     S                 PRE1,PRE2,PTR1,PTR2)
      use dimens_m
      use dimphy
      use raddim
      IMPLICIT none
C
C     ------------------------------------------------------------------
C     PURPOSE.
C     --------
C           COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
C     LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
C
C     METHOD.
C     -------
C
C          STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
C
C     REFERENCE.
C     ----------
C
C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
C
C     AUTHOR.
C     -------
C        JEAN-JACQUES MORCRETTE  *ECMWF*
C
C     MODIFICATIONS.
C     --------------
C        ORIGINAL : 88-12-15
C     ------------------------------------------------------------------
C* ARGUMENTS:
C
      REAL*8 PGG(KDLON)   ! ASSYMETRY FACTOR
      REAL*8 PREF(KDLON)  ! REFLECTIVITY OF THE UNDERLYING LAYER
      REAL*8 PRMUZ(KDLON) ! COSINE OF SOLAR ZENITH ANGLE
      REAL*8 PTO1(KDLON)  ! OPTICAL THICKNESS
      REAL*8 PW(KDLON)    ! SINGLE SCATTERING ALBEDO
      REAL*8 PRE1(KDLON)  ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
      REAL*8 PRE2(KDLON)  ! LAYER REFLECTIVITY
      REAL*8 PTR1(KDLON)  ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
      REAL*8 PTR2(KDLON)  ! LAYER TRANSMISSIVITY
C
C* LOCAL VARIABLES:
C
      INTEGER jl
      REAL*8 ZFF, ZGP, ZTOP, ZWCP, ZDT, ZX1, ZWM
      REAL*8 ZRM2, ZRK, ZX2, ZRP, ZALPHA, ZBETA, ZARG
      REAL*8 ZEXMU0, ZARG2, ZEXKP, ZEXKM, ZXP2P, ZXM2P, ZAP2B, ZAM2B
      REAL*8 ZA11, ZA12, ZA13, ZA21, ZA22, ZA23
      REAL*8 ZDENA, ZC1A, ZC2A, ZRI0A, ZRI1A
      REAL*8 ZRI0B, ZRI1B
      REAL*8 ZB21, ZB22, ZB23, ZDENB, ZC1B, ZC2B
      REAL*8 ZRI0C, ZRI1C, ZRI0D, ZRI1D
C     ------------------------------------------------------------------
C
C*         1.      DELTA-EDDINGTON CALCULATIONS
C
 100  CONTINUE
C
      DO 131 JL   =   1, KDLON
C
C*         1.1     SET UP THE DELTA-MODIFIED PARAMETERS
C
 110  CONTINUE
C
      ZFF = PGG(JL)*PGG(JL)
      ZGP = PGG(JL)/(1.+PGG(JL))
      ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL)
      ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF)
      ZDT = 2./3.
      ZX1 = 1.-ZWCP*ZGP
      ZWM = 1.-ZWCP
      ZRM2 =  PRMUZ(JL) * PRMUZ(JL)
      ZRK = SQRT(3.*ZWM*ZX1)
      ZX2 = 4.*(1.-ZRK*ZRK*ZRM2)
      ZRP=ZRK/ZX1
      ZALPHA = 3.*ZWCP*ZRM2*(1.+ZGP*ZWM)/ZX2
      ZBETA = 3.*ZWCP* PRMUZ(JL) *(1.+3.*ZGP*ZRM2*ZWM)/ZX2
CMAF      ZARG=MIN(ZTOP/PRMUZ(JL),200.)
      ZARG=MIN(ZTOP/PRMUZ(JL),2.0d+2)
      ZEXMU0=EXP(-ZARG)
CMAF      ZARG2=MIN(ZRK*ZTOP,200.)
      ZARG2=MIN(ZRK*ZTOP,2.0d+2)
      ZEXKP=EXP(ZARG2)
      ZEXKM = 1./ZEXKP
      ZXP2P = 1.+ZDT*ZRP
      ZXM2P = 1.-ZDT*ZRP
      ZAP2B = ZALPHA+ZDT*ZBETA
      ZAM2B = ZALPHA-ZDT*ZBETA
C
C*         1.2     WITHOUT REFLECTION FROM THE UNDERLYING LAYER
C
 120  CONTINUE
C
      ZA11 = ZXP2P
      ZA12 = ZXM2P
      ZA13 = ZAP2B
      ZA22 = ZXP2P*ZEXKP
      ZA21 = ZXM2P*ZEXKM
      ZA23 = ZAM2B*ZEXMU0
      ZDENA = ZA11 * ZA22 - ZA21 * ZA12
      ZC1A = (ZA22*ZA13-ZA12*ZA23)/ZDENA
      ZC2A = (ZA11*ZA23-ZA21*ZA13)/ZDENA
      ZRI0A = ZC1A+ZC2A-ZALPHA
      ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA
      PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL)
      ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0
      ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0
      PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL)
C
C*         1.3     WITH REFLECTION FROM THE UNDERLYING LAYER
C
 130  CONTINUE
C
      ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM
      ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP
      ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) )
      ZDENB = ZA11 * ZB22 - ZB21 * ZA12
      ZC1B = (ZB22*ZA13-ZA12*ZB23)/ZDENB
      ZC2B = (ZA11*ZB23-ZB21*ZA13)/ZDENB
      ZRI0C = ZC1B+ZC2B-ZALPHA
      ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA
      PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL)
      ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0
      ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0
      PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL)
C
 131  CONTINUE
      RETURN
      END
1	SUBROUTINE SWDE (PGG,PREF,PRMUZ,PTO1,PW,
2	S PRE1,PRE2,PTR1,PTR2)
3	use dimens_m
4	use dimphy
5	use raddim
6	IMPLICIT none
7	C
8	C ------------------------------------------------------------------
9	C PURPOSE.
10	C --------
11	C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
12	C LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
13	C
14	C METHOD.
15	C -------
16	C
17	C STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
18	C
19	C REFERENCE.
20	C ----------
21	C
22	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
23	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
24	C
25	C AUTHOR.
26	C -------
27	C JEAN-JACQUES MORCRETTE ECMWF
28	C
29	C MODIFICATIONS.
30	C --------------
31	C ORIGINAL : 88-12-15
32	C ------------------------------------------------------------------
33	C* ARGUMENTS:
34	C
35	REAL*8 PGG(KDLON) ! ASSYMETRY FACTOR
36	REAL*8 PREF(KDLON) ! REFLECTIVITY OF THE UNDERLYING LAYER
37	REAL*8 PRMUZ(KDLON) ! COSINE OF SOLAR ZENITH ANGLE
38	REAL*8 PTO1(KDLON) ! OPTICAL THICKNESS
39	REAL*8 PW(KDLON) ! SINGLE SCATTERING ALBEDO
40	REAL*8 PRE1(KDLON) ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
41	REAL*8 PRE2(KDLON) ! LAYER REFLECTIVITY
42	REAL*8 PTR1(KDLON) ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
43	REAL*8 PTR2(KDLON) ! LAYER TRANSMISSIVITY
44	C
45	C* LOCAL VARIABLES:
46	C
47	INTEGER jl
48	REAL*8 ZFF, ZGP, ZTOP, ZWCP, ZDT, ZX1, ZWM
49	REAL*8 ZRM2, ZRK, ZX2, ZRP, ZALPHA, ZBETA, ZARG
50	REAL*8 ZEXMU0, ZARG2, ZEXKP, ZEXKM, ZXP2P, ZXM2P, ZAP2B, ZAM2B
51	REAL*8 ZA11, ZA12, ZA13, ZA21, ZA22, ZA23
52	REAL*8 ZDENA, ZC1A, ZC2A, ZRI0A, ZRI1A
53	REAL*8 ZRI0B, ZRI1B
54	REAL*8 ZB21, ZB22, ZB23, ZDENB, ZC1B, ZC2B
55	REAL*8 ZRI0C, ZRI1C, ZRI0D, ZRI1D
56	C ------------------------------------------------------------------
57	C
58	C* 1. DELTA-EDDINGTON CALCULATIONS
59	C
60	100 CONTINUE
61	C
62	DO 131 JL = 1, KDLON
63	C
64	C* 1.1 SET UP THE DELTA-MODIFIED PARAMETERS
65	C
66	110 CONTINUE
67	C
68	ZFF = PGG(JL)*PGG(JL)
69	ZGP = PGG(JL)/(1.+PGG(JL))
70	ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL)
71	ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF)
72	ZDT = 2./3.
73	ZX1 = 1.-ZWCP*ZGP
74	ZWM = 1.-ZWCP
75	ZRM2 = PRMUZ(JL) * PRMUZ(JL)
76	ZRK = SQRT(3.ZWMZX1)
77	ZX2 = 4.(1.-ZRKZRK*ZRM2)
78	ZRP=ZRK/ZX1
79	ZALPHA = 3.ZWCPZRM2(1.+ZGPZWM)/ZX2
80	ZBETA = 3.ZWCP PRMUZ(JL) (1.+3.ZGPZRM2ZWM)/ZX2
81	CMAF ZARG=MIN(ZTOP/PRMUZ(JL),200.)
82	ZARG=MIN(ZTOP/PRMUZ(JL),2.0d+2)
83	ZEXMU0=EXP(-ZARG)
84	CMAF ZARG2=MIN(ZRK*ZTOP,200.)
85	ZARG2=MIN(ZRK*ZTOP,2.0d+2)
86	ZEXKP=EXP(ZARG2)
87	ZEXKM = 1./ZEXKP
88	ZXP2P = 1.+ZDT*ZRP
89	ZXM2P = 1.-ZDT*ZRP
90	ZAP2B = ZALPHA+ZDT*ZBETA
91	ZAM2B = ZALPHA-ZDT*ZBETA
92	C
93	C* 1.2 WITHOUT REFLECTION FROM THE UNDERLYING LAYER
94	C
95	120 CONTINUE
96	C
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 = (ZA22ZA13-ZA12ZA23)/ZDENA
105	ZC2A = (ZA11ZA23-ZA21ZA13)/ZDENA
106	ZRI0A = ZC1A+ZC2A-ZALPHA
107	ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA
108	PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL)
109	ZRI0B = ZC1AZEXKM+ZC2AZEXKP-ZALPHA*ZEXMU0
110	ZRI1B = ZRP(ZC1AZEXKM-ZC2AZEXKP)-ZBETAZEXMU0
111	PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL)
112	C
113	C* 1.3 WITH REFLECTION FROM THE UNDERLYING LAYER
114	C
115	130 CONTINUE
116	C
117	ZB21 = ZA21- PREF(JL) ZXP2PZEXKM
118	ZB22 = ZA22- PREF(JL) ZXM2PZEXKP
119	ZB23 = ZA23- PREF(JL) ZEXMU0(ZAP2B - PRMUZ(JL) )
120	ZDENB = ZA11 * ZB22 - ZB21 * ZA12
121	ZC1B = (ZB22ZA13-ZA12ZB23)/ZDENB
122	ZC2B = (ZA11ZB23-ZB21ZA13)/ZDENB
123	ZRI0C = ZC1B+ZC2B-ZALPHA
124	ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA
125	PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL)
126	ZRI0D = ZC1BZEXKM + ZC2BZEXKP - ZALPHA*ZEXMU0
127	ZRI1D = ZRP * (ZC1BZEXKM - ZC2BZEXKP) - ZBETA*ZEXMU0
128	PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL)
129	C
130	131 CONTINUE
131	RETURN
132	END