1 |
|
|
!OPTIONS XOPT(HSFUN) |
2 |
|
33696 |
SUBROUTINE SWDE & |
3 |
|
|
& ( KIDIA, KFDIA, KLON,& |
4 |
|
|
& PGG , PREF , PRMUZ, PTO1, PW,& |
5 |
|
|
& PRE1 , PRE2 , PTR1 , PTR2 & |
6 |
|
|
& ) |
7 |
|
|
|
8 |
|
|
!**** *SWDE* - DELTA-EDDINGTON IN A CLOUDY LAYER |
9 |
|
|
|
10 |
|
|
! PURPOSE. |
11 |
|
|
! -------- |
12 |
|
|
! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY |
13 |
|
|
! LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION. |
14 |
|
|
|
15 |
|
|
!** INTERFACE. |
16 |
|
|
! ---------- |
17 |
|
|
! *SWDE* IS CALLED BY *SWR*, *SWNI* |
18 |
|
|
|
19 |
|
|
! EXPLICIT ARGUMENTS : |
20 |
|
|
! -------------------- |
21 |
|
|
! PGG : (KLON) ; ASSYMETRY FACTOR |
22 |
|
|
! PREF : (KLON) ; REFLECTIVITY OF THE UNDERLYING LAYER |
23 |
|
|
! PRMUZ : (KLON) ; COSINE OF SOLAR ZENITH ANGLE |
24 |
|
|
! PTO1 : (KLON) ; OPTICAL THICKNESS |
25 |
|
|
! PW : (KLON) ; SINGLE SCATTERING ALBEDO |
26 |
|
|
! ==== OUTPUTS === |
27 |
|
|
! PRE1 : (KLON) ; LAYER REFLECTIVITY ASSUMING NO |
28 |
|
|
! ; REFLECTION FROM UNDERLYING LAYER |
29 |
|
|
! PTR1 : (KLON) ; LAYER TRANSMISSIVITY ASSUMING NO |
30 |
|
|
! ; REFLECTION FROM UNDERLYING LAYER |
31 |
|
|
! PRE2 : (KLON) ; LAYER REFLECTIVITY ASSUMING |
32 |
|
|
! ; REFLECTION FROM UNDERLYING LAYER |
33 |
|
|
! PTR2 : (KLON) ; LAYER TRANSMISSIVITY ASSUMING |
34 |
|
|
! ; REFLECTION FROM UNDERLYING LAYER |
35 |
|
|
|
36 |
|
|
! IMPLICIT ARGUMENTS : NONE |
37 |
|
|
! -------------------- |
38 |
|
|
|
39 |
|
|
! METHOD. |
40 |
|
|
! ------- |
41 |
|
|
|
42 |
|
|
! STANDARD DELTA-EDDINGTON LAYER CALCULATIONS. |
43 |
|
|
|
44 |
|
|
! EXTERNALS. |
45 |
|
|
! ---------- |
46 |
|
|
|
47 |
|
|
! NONE |
48 |
|
|
|
49 |
|
|
! REFERENCE. |
50 |
|
|
! ---------- |
51 |
|
|
|
52 |
|
|
! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
53 |
|
|
! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
54 |
|
|
|
55 |
|
|
! AUTHOR. |
56 |
|
|
! ------- |
57 |
|
|
! JEAN-JACQUES MORCRETTE *ECMWF* |
58 |
|
|
|
59 |
|
|
! MODIFICATIONS. |
60 |
|
|
! -------------- |
61 |
|
|
! ORIGINAL: 88-12-15 |
62 |
|
|
! 96-05-30 Michel Deque (security in EXP()) |
63 |
|
|
! M.Hamrud 01-Oct-2003 CY28 Cleaning |
64 |
|
|
! Modified: 03-10-10 Deborah Salmond and Marta Janiskova Optimisation |
65 |
|
|
! Modified: 03-12-13 John Hague - MASS Vector Fns |
66 |
|
|
! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests |
67 |
|
|
! ------------------------------------------------------------------ |
68 |
|
|
|
69 |
|
|
! ------------------------------------------------------------------ |
70 |
|
|
|
71 |
|
|
!* 0.1 ARGUMENTS |
72 |
|
|
! --------- |
73 |
|
|
|
74 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
75 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
76 |
|
|
|
77 |
|
|
USE YOERDU , ONLY : REPLOG |
78 |
|
|
USE YOMJFH , ONLY : N_VMASS |
79 |
|
|
!++MODIFCODE |
80 |
|
|
USE YOERAD , ONLY : NOVLP |
81 |
|
|
!--MODIFCODE |
82 |
|
|
IMPLICIT NONE |
83 |
|
|
|
84 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
85 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
86 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
87 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PGG(KLON) |
88 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PREF(KLON) |
89 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PRMUZ(KLON) |
90 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PTO1(KLON) |
91 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PW(KLON) |
92 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PRE1(KLON) |
93 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PRE2(KLON) |
94 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PTR1(KLON) |
95 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PTR2(KLON) |
96 |
|
67392 |
REAL(KIND=JPRB) :: ZTMP (4,KFDIA-KIDIA+1) |
97 |
|
67392 |
REAL(KIND=JPRB) :: ZTMP2 (KFDIA-KIDIA+1+N_VMASS) |
98 |
|
67392 |
REAL(KIND=JPRB) :: ZTMP3 (KFDIA-KIDIA+1+N_VMASS) |
99 |
|
67392 |
REAL(KIND=JPRB) :: ZZARG (KFDIA-KIDIA+1+N_VMASS) |
100 |
|
67392 |
REAL(KIND=JPRB) :: ZZARG2 (KFDIA-KIDIA+1+N_VMASS) |
101 |
|
|
|
102 |
|
|
INTEGER(KIND=JPIM) :: JL, JLL, JLEN |
103 |
|
|
|
104 |
|
|
REAL(KIND=JPRB) :: ZA11, ZA12, ZA13, ZA21, ZA22, ZA23, ZALPHA,& |
105 |
|
|
& ZAM2B, ZAP2B, ZB21, ZB22, ZB23, & |
106 |
|
|
& ZBETA, ZC1A, ZC1B, ZC2A, ZC2B, ZDENA, ZDENB, & |
107 |
|
|
& ZDT, ZEXKM, ZEXKP, ZEXMU0, ZFF, ZGP, ZRI0A, & |
108 |
|
|
& ZRI0B, ZRI0C, ZRI0D, ZRI1A, ZRI1B, ZRI1C, & |
109 |
|
|
& ZRI1D, ZRK, ZRM2, ZRP, ZTOP, ZWCP, ZWM, ZX1, & |
110 |
|
|
& ZX2, ZXM2P, ZXP2P |
111 |
|
|
|
112 |
|
|
|
113 |
|
|
REAL(KIND=JPRB) :: MINJ, MAXJ, X, Y |
114 |
|
|
REAL(KIND=JPRB) :: ZPRMUZ,ZIDENA,ZIDENB,ZRR |
115 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
116 |
|
|
|
117 |
|
|
! STATEMENT DUNCTIONS |
118 |
|
|
MINJ(X,Y) = Y - 0.5_JPRB*(ABS(X-Y)-(X-Y)) |
119 |
|
|
MAXJ(X,Y) = Y + 0.5_JPRB*(ABS(X-Y)+(X-Y)) |
120 |
|
|
|
121 |
|
|
! ------------------------------------------------------------------ |
122 |
|
|
|
123 |
|
|
!* 1. DELTA-EDDINGTON CALCULATIONS |
124 |
|
|
|
125 |
✓✗ |
33696 |
IF (LHOOK) CALL DR_HOOK('SWDE',0,ZHOOK_HANDLE) |
126 |
|
|
|
127 |
|
|
ZDT = 2.0_JPRB/3._JPRB |
128 |
|
|
|
129 |
✓✓ |
33527520 |
DO JL = KIDIA,KFDIA |
130 |
|
33493824 |
JLL=JL-KIDIA+1 |
131 |
|
33493824 |
ZPRMUZ=1.0_JPRB/PRMUZ(JL) |
132 |
|
|
!++MODIFCODE |
133 |
✗✓ |
33493824 |
IF (NOVLP >= 5) THEN !MESONH_VERSION |
134 |
|
|
ZGP = PGG(JL) |
135 |
|
|
ZTOP = PTO1(JL) |
136 |
|
|
ZWCP = PW(JL) |
137 |
|
|
ELSE !ECMWF VERSION |
138 |
|
33493824 |
ZFF = PGG(JL)*PGG(JL) |
139 |
|
33493824 |
ZGP = PGG(JL)/(1.0_JPRB+PGG(JL)) |
140 |
|
33493824 |
ZTOP = (1.0_JPRB- PW(JL) * ZFF) * PTO1(JL) |
141 |
|
33493824 |
ZWCP = (1-ZFF)* PW(JL) /(1.0_JPRB- PW(JL) * ZFF) |
142 |
|
|
ENDIF |
143 |
|
|
!--MODIFCODE |
144 |
|
33493824 |
ZX1 = 1.0_JPRB-ZWCP*ZGP |
145 |
|
33493824 |
ZWM = 1.0_JPRB-ZWCP |
146 |
|
33493824 |
ZRM2 = PRMUZ(JL) * PRMUZ(JL) |
147 |
|
33493824 |
ZRK = SQRT(MAXJ(REPLOG,3._JPRB*ZWM*ZX1)) |
148 |
|
33493824 |
ZX2 = (1.0_JPRB-ZRK*ZRK*ZRM2)*(4._JPRB/3._JPRB) |
149 |
|
33493824 |
ZRR = 1.0_JPRB/ZX2 |
150 |
|
33493824 |
ZRP=ZRK/ZX1 |
151 |
|
33493824 |
ZALPHA = ZWCP*ZRM2*(1.0_JPRB+ZGP*ZWM)*ZRR |
152 |
|
33493824 |
ZBETA = ZWCP* PRMUZ(JL) *(1.0_JPRB+3._JPRB*ZGP*ZRM2*ZWM)*ZRR |
153 |
|
33493824 |
ZZARG(JLL) = -MAXJ( -200._JPRB, MINJ( ZTOP*ZPRMUZ, 200._JPRB) ) |
154 |
|
33493824 |
ZZARG2(JLL) = MINJ( ZRK*ZTOP, 200._JPRB) |
155 |
|
33493824 |
ZTMP(1,JLL) = ZPRMUZ |
156 |
|
33493824 |
ZTMP(2,JLL) = ZALPHA |
157 |
|
33493824 |
ZTMP(3,JLL) = ZBETA |
158 |
|
33527520 |
ZTMP(4,JLL) = ZRP |
159 |
|
|
ENDDO |
160 |
|
|
|
161 |
✗✓ |
33696 |
IF(N_VMASS /= 0 ) THEN !USING VECTOR MASS |
162 |
|
|
JLEN=KFDIA-KIDIA+N_VMASS-MOD(KFDIA-KIDIA,N_VMASS) |
163 |
|
|
IF(KFDIA-KIDIA+1 /= JLEN) THEN |
164 |
|
|
ZZARG (KFDIA-KIDIA+2:JLEN)=1.0_JPRB |
165 |
|
|
ZZARG2 (KFDIA-KIDIA+2:JLEN)=1.0_JPRB |
166 |
|
|
ENDIF |
167 |
|
|
! Commente par MPL le 21.11.08 |
168 |
|
|
! CALL VEXP(ZTMP2,ZZARG, JLEN) |
169 |
|
|
! CALL VEXP(ZTMP3,ZZARG2,JLEN) |
170 |
|
|
ELSE |
171 |
✓✓ |
33527520 |
DO JL = KIDIA,KFDIA |
172 |
|
33493824 |
JLL=JL-KIDIA+1 |
173 |
|
33493824 |
ZTMP2(JLL) = EXP(ZZARG(JLL)) |
174 |
|
33527520 |
ZTMP3(JLL) = EXP(ZZARG2(JLL)) |
175 |
|
|
ENDDO |
176 |
|
|
ENDIF |
177 |
|
|
|
178 |
✓✓ |
33527520 |
DO JL = KIDIA,KFDIA |
179 |
|
33493824 |
JLL=JL-KIDIA+1 |
180 |
|
33493824 |
ZEXMU0 = ZTMP2(JLL) |
181 |
|
33493824 |
ZEXKP = ZTMP3(JLL) |
182 |
|
33493824 |
ZPRMUZ = ZTMP(1,JLL) |
183 |
|
33493824 |
ZALPHA = ZTMP(2,JLL) |
184 |
|
33493824 |
ZBETA = ZTMP(3,JLL) |
185 |
|
33493824 |
ZRP = ZTMP(4,JLL) |
186 |
|
33493824 |
ZEXKM = 1.0_JPRB/ZEXKP |
187 |
|
33493824 |
ZXP2P = 1.0_JPRB+ZDT*ZRP |
188 |
|
33493824 |
ZXM2P = 1.0_JPRB-ZDT*ZRP |
189 |
|
33493824 |
ZAP2B = ZALPHA+ZDT*ZBETA |
190 |
|
33493824 |
ZAM2B = ZALPHA-ZDT*ZBETA |
191 |
|
|
|
192 |
|
|
!* 1.2 WITHOUT REFLECTION FROM THE UNDERLYING LAYER |
193 |
|
|
|
194 |
|
|
ZA11 = ZXP2P |
195 |
|
|
ZA12 = ZXM2P |
196 |
|
|
ZA13 = ZAP2B |
197 |
|
33493824 |
ZA22 = ZXP2P*ZEXKP |
198 |
|
33493824 |
ZA21 = ZXM2P*ZEXKM |
199 |
|
33493824 |
ZA23 = ZAM2B*ZEXMU0 |
200 |
|
33493824 |
ZDENA = ZA11 * ZA22 - ZA21 * ZA12 |
201 |
|
33493824 |
ZIDENA=1.0_JPRB/ZDENA |
202 |
|
33493824 |
ZC1A = (ZA22*ZA13-ZA12*ZA23)*ZIDENA |
203 |
|
33493824 |
ZC2A = (ZA11*ZA23-ZA21*ZA13)*ZIDENA |
204 |
|
33493824 |
ZRI0A = ZC1A+ZC2A-ZALPHA |
205 |
|
33493824 |
ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA |
206 |
|
33493824 |
PRE1(JL) = (ZRI0A-ZDT*ZRI1A)*ZPRMUZ |
207 |
|
33493824 |
ZRI0B = ZC1A*ZEXKM+ZC2A*ZEXKP-ZALPHA*ZEXMU0 |
208 |
|
33493824 |
ZRI1B = ZRP*(ZC1A*ZEXKM-ZC2A*ZEXKP)-ZBETA*ZEXMU0 |
209 |
|
33493824 |
PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)*ZPRMUZ |
210 |
|
|
|
211 |
|
|
!* 1.3 WITH REFLECTION FROM THE UNDERLYING LAYER |
212 |
|
|
|
213 |
|
33493824 |
ZB21 = ZA21- PREF(JL) *ZXP2P*ZEXKM |
214 |
|
33493824 |
ZB22 = ZA22- PREF(JL) *ZXM2P*ZEXKP |
215 |
|
33493824 |
ZB23 = ZA23- PREF(JL) *ZEXMU0*(ZAP2B - PRMUZ(JL) ) |
216 |
|
33493824 |
ZDENB = ZA11 * ZB22 - ZB21 * ZA12 |
217 |
|
33493824 |
ZIDENB= 1.0_JPRB/ZDENB |
218 |
|
33493824 |
ZC1B = (ZB22*ZA13-ZA12*ZB23)*ZIDENB |
219 |
|
33493824 |
ZC2B = (ZA11*ZB23-ZB21*ZA13)*ZIDENB |
220 |
|
33493824 |
ZRI0C = ZC1B+ZC2B-ZALPHA |
221 |
|
33493824 |
ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA |
222 |
|
33493824 |
PRE2(JL) = (ZRI0C-ZDT*ZRI1C) * ZPRMUZ |
223 |
|
33493824 |
ZRI0D = ZC1B*ZEXKM + ZC2B*ZEXKP - ZALPHA*ZEXMU0 |
224 |
|
33493824 |
ZRI1D = ZRP * (ZC1B*ZEXKM - ZC2B*ZEXKP) - ZBETA*ZEXMU0 |
225 |
|
33527520 |
PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) * ZPRMUZ |
226 |
|
|
ENDDO |
227 |
|
|
|
228 |
✓✗ |
33696 |
IF (LHOOK) CALL DR_HOOK('SWDE',1,ZHOOK_HANDLE) |
229 |
|
33696 |
END SUBROUTINE SWDE |
230 |
|
|
|