1 |
|
|
!OPTIONS XOPT(HSFUN) |
2 |
|
144 |
SUBROUTINE SWU & |
3 |
|
|
& ( KIDIA, KFDIA , KLON , KLEV,& |
4 |
|
72 |
& PSCT , PCARDI, PCLDSW, PPMB , PPSOL, PRMU0, PTAVE, PWV,& |
5 |
|
72 |
& PAKI , PCLD , PCLEAR, PDSIG, PFACT, PRMU , PSEC , PUD & |
6 |
|
|
& ) |
7 |
|
|
|
8 |
|
|
!**** *SWU* - SHORTWAVE RADIATION, ABSORBER AMOUNTS |
9 |
|
|
|
10 |
|
|
! PURPOSE. |
11 |
|
|
! -------- |
12 |
|
|
! COMPUTES THE ABSORBER AMOUNTS USED IN SHORTWAVE RADIATION |
13 |
|
|
! CALCULATIONS |
14 |
|
|
|
15 |
|
|
!** INTERFACE. |
16 |
|
|
! ---------- |
17 |
|
|
! *SWU* IS CALLED BY *SW* |
18 |
|
|
|
19 |
|
|
! IMPLICIT ARGUMENTS : |
20 |
|
|
! -------------------- |
21 |
|
|
|
22 |
|
|
! ==== INPUTS === |
23 |
|
|
! ==== OUTPUTS === |
24 |
|
|
|
25 |
|
|
! METHOD. |
26 |
|
|
! ------- |
27 |
|
|
|
28 |
|
|
! 1. COMPUTES ABSORBER AMOUNTS WITH TEMPERATURE AND PRESSURE |
29 |
|
|
! SCALING. |
30 |
|
|
|
31 |
|
|
! EXTERNALS. |
32 |
|
|
! ---------- |
33 |
|
|
|
34 |
|
|
! *SWTT* |
35 |
|
|
|
36 |
|
|
! REFERENCE. |
37 |
|
|
! ---------- |
38 |
|
|
|
39 |
|
|
! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
40 |
|
|
! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
41 |
|
|
|
42 |
|
|
! AUTHOR. |
43 |
|
|
! ------- |
44 |
|
|
! JEAN-JACQUES MORCRETTE *ECMWF* |
45 |
|
|
|
46 |
|
|
! MODIFICATIONS. |
47 |
|
|
! -------------- |
48 |
|
|
! ORIGINAL : 89-07-14 |
49 |
|
|
! 03-03-18 JJMorcrette security on normalized cloud cover |
50 |
|
|
! M.Hamrud 01-Oct-2003 CY28 Cleaning |
51 |
|
|
! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests |
52 |
|
|
|
53 |
|
|
! ------------------------------------------------------------------ |
54 |
|
|
|
55 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
56 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
57 |
|
|
|
58 |
|
|
USE YOECLD , ONLY : REPSEC |
59 |
|
|
!USE YOERAD , ONLY : NOVLP ,NSW |
60 |
|
|
! NSW mis dans .def MPL 20140211 |
61 |
|
|
USE YOERAD , ONLY : NOVLP |
62 |
|
|
USE YOERDU , ONLY : REPSCQ |
63 |
|
|
USE YOESW , ONLY : RPDH1 ,RPDU1 ,RPNH ,RPNU ,& |
64 |
|
|
& RTDH2O ,RTDUMG ,RTH2O ,RTUMG |
65 |
|
|
USE YOEOVLP , ONLY : RA1OVLP |
66 |
|
|
|
67 |
|
|
IMPLICIT NONE |
68 |
|
|
|
69 |
|
|
include "clesphys.h" |
70 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
71 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
72 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
73 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
74 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PSCT |
75 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCARDI |
76 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PCLDSW(KLON,KLEV) |
77 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1) |
78 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PPSOL(KLON) |
79 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON) |
80 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV) |
81 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) |
82 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PAKI(KLON,2,NSW) |
83 |
|
|
REAL(KIND=JPRB) ,INTENT(INOUT) :: PCLD(KLON,KLEV) |
84 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PCLEAR(KLON) |
85 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PDSIG(KLON,KLEV) |
86 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PFACT(KLON) |
87 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU(KLON) |
88 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PSEC(KLON) |
89 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: PUD(KLON,5,KLEV+1) |
90 |
|
|
! ------------------------------------------------------------------ |
91 |
|
|
|
92 |
|
|
!* 0.1 ARGUMENTS |
93 |
|
|
! --------- |
94 |
|
|
|
95 |
|
|
INTEGER(KIND=JPIM) :: INUIR |
96 |
|
|
|
97 |
|
|
! ------------------------------------------------------------------ |
98 |
|
|
|
99 |
|
|
! ------------ |
100 |
|
|
|
101 |
|
|
INTEGER(KIND=JPIM) :: IIND(2) |
102 |
|
144 |
REAL(KIND=JPRB) :: ZC1J(KLON,KLEV+1),ZCLEAR(KLON),ZCLOUD(KLON)& |
103 |
|
144 |
& , ZN175(KLON), ZN190(KLON), ZO175(KLON)& |
104 |
|
144 |
& , ZO190(KLON), ZSIGN(KLON)& |
105 |
|
144 |
& , ZR(KLON,2) , ZSIGO(KLON), ZUD(KLON,2) |
106 |
|
|
|
107 |
|
|
INTEGER(KIND=JPIM) :: JA, JK, JKL, JKLP1, JKP1, JL, JNU |
108 |
|
|
|
109 |
|
|
REAL(KIND=JPRB) :: ZDSCO2, ZDSH2O, ZFPPW, ZRTH, ZRTU, ZWH2O, ZALPHA1 |
110 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
111 |
|
|
|
112 |
|
|
#include "swtt1.intfb.h" |
113 |
|
|
|
114 |
|
|
! ------------------------------------------------------------------ |
115 |
|
|
|
116 |
|
|
!* 1. COMPUTES AMOUNTS OF ABSORBERS |
117 |
|
|
! ----------------------------- |
118 |
|
|
|
119 |
|
72 |
REPSEC=1.E-12_JPRB !!!!! A REVOIR (MPL) |
120 |
✓✗ |
72 |
IF (LHOOK) CALL DR_HOOK('SWU',0,ZHOOK_HANDLE) |
121 |
|
72 |
IIND(1)=1 |
122 |
|
72 |
IIND(2)=2 |
123 |
|
|
|
124 |
|
|
!* 1.1 INITIALIZES QUANTITIES |
125 |
|
|
! ---------------------- |
126 |
|
|
|
127 |
✓✓ |
71640 |
DO JL = KIDIA,KFDIA |
128 |
|
71568 |
PUD(JL,1,KLEV+1)=0.0_JPRB |
129 |
|
71568 |
PUD(JL,2,KLEV+1)=0.0_JPRB |
130 |
|
71568 |
PUD(JL,3,KLEV+1)=0.0_JPRB |
131 |
|
71568 |
PUD(JL,4,KLEV+1)=0.0_JPRB |
132 |
|
71568 |
PUD(JL,5,KLEV+1)=0.0_JPRB |
133 |
|
71568 |
PFACT(JL)= PRMU0(JL) * PSCT |
134 |
|
|
!- already accounted for in RADINT |
135 |
|
|
! PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35. |
136 |
|
71568 |
PRMU(JL)=PRMU0(JL) |
137 |
|
71568 |
PSEC(JL)=1.0_JPRB/PRMU(JL) |
138 |
|
71640 |
ZC1J(JL,KLEV+1)=0.0_JPRB |
139 |
|
|
ENDDO |
140 |
|
|
|
141 |
|
|
!* 1.3 AMOUNTS OF ABSORBERS |
142 |
|
|
! -------------------- |
143 |
|
|
|
144 |
✓✓ |
71640 |
DO JL= KIDIA,KFDIA |
145 |
|
71568 |
ZUD(JL,1) = 0.0_JPRB |
146 |
|
71568 |
ZUD(JL,2) = 0.0_JPRB |
147 |
|
71568 |
ZO175(JL) = PPSOL(JL)** RPDU1 |
148 |
|
71568 |
ZO190(JL) = PPSOL(JL)** RPDH1 |
149 |
|
71568 |
ZSIGO(JL) = PPSOL(JL) |
150 |
|
71568 |
ZCLEAR(JL)=1.0_JPRB |
151 |
|
71640 |
ZCLOUD(JL)=0.0_JPRB |
152 |
|
|
ENDDO |
153 |
|
|
|
154 |
✓✓ |
2880 |
DO JK = 1 , KLEV |
155 |
|
2808 |
JKP1 = JK + 1 |
156 |
|
2808 |
JKL = KLEV+1 - JK |
157 |
|
|
JKLP1 = JKL+1 |
158 |
|
2808 |
ZALPHA1=RA1OVLP(KLEV+1-JK) |
159 |
|
|
|
160 |
✓✓ |
2794032 |
DO JL = KIDIA,KFDIA |
161 |
|
2791152 |
ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O |
162 |
|
2791152 |
ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG |
163 |
|
2791152 |
ZWH2O = MAX (PWV(JL,JKL) , REPSCQ ) |
164 |
|
|
|
165 |
|
2791152 |
ZSIGN(JL) = 100._JPRB * PPMB(JL,JKP1) |
166 |
|
2791152 |
PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL) |
167 |
|
2791152 |
ZN175(JL) = ZSIGN(JL) ** RPDU1 |
168 |
|
2791152 |
ZN190(JL) = ZSIGN(JL) ** RPDH1 |
169 |
|
2791152 |
ZDSCO2 = ZO175(JL) - ZN175(JL) |
170 |
|
2791152 |
ZDSH2O = ZO190(JL) - ZN190(JL) |
171 |
|
2791152 |
PUD(JL,1,JK) = RPNH * ZDSH2O * ZWH2O * ZRTH |
172 |
|
2791152 |
PUD(JL,2,JK) = RPNU * ZDSCO2 * PCARDI * ZRTU |
173 |
|
|
|
174 |
|
2791152 |
ZFPPW=1.6078_JPRB*ZWH2O/(1.0_JPRB+0.608_JPRB*ZWH2O) |
175 |
|
2791152 |
PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW |
176 |
|
2791152 |
PUD(JL,5,JK)=PUD(JL,1,JK)*(1.0_JPRB-ZFPPW) |
177 |
|
2791152 |
ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK) |
178 |
|
2791152 |
ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK) |
179 |
|
2791152 |
ZSIGO(JL) = ZSIGN(JL) |
180 |
|
2791152 |
ZO175(JL) = ZN175(JL) |
181 |
|
2791152 |
ZO190(JL) = ZN190(JL) |
182 |
|
|
!print *,'SWU: RTH2O RTDH2O RTUMG RTDUMG',RTH2O,RTDH2O,RTUMG,RTDUMG |
183 |
|
|
!print *,'SWU: RPNH ZDSH2O ZWH2O ZRTH',RPNH,ZDSH2O,ZWH2O,ZRTH |
184 |
|
|
!print *,'SWU: RPNU ZDSCO2 PCARDI ZRTU',RPNU,ZDSCO2,PCARDI,ZRTU |
185 |
|
|
|
186 |
|
|
!++MODIFCODE |
187 |
✗✓✗✗
|
2793960 |
IF ((NOVLP == 1).OR.(NOVLP==6).OR.(NOVLP==8)) THEN |
188 |
|
|
ZCLEAR(JL)=ZCLEAR(JL)& |
189 |
|
|
& *(1.0_JPRB-MAX(PCLDSW(JL,JKL),ZCLOUD(JL)))& |
190 |
|
2791152 |
& /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) |
191 |
|
2791152 |
ZC1J(JL,JKL)= 1.0_JPRB - ZCLEAR(JL) |
192 |
|
2791152 |
ZCLOUD(JL) = PCLDSW(JL,JKL) |
193 |
|
|
ELSEIF ((NOVLP == 2).OR.(NOVLP==7)) THEN |
194 |
|
|
ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL)) |
195 |
|
|
ZC1J(JL,JKL) = ZCLOUD(JL) |
196 |
|
|
ELSEIF ((NOVLP == 3).OR.(NOVLP==5)) THEN |
197 |
|
|
ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB-PCLDSW(JL,JKL)) |
198 |
|
|
ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL) |
199 |
|
|
ZC1J(JL,JKL) = ZCLOUD(JL) |
200 |
|
|
ELSEIF (NOVLP == 4) THEN |
201 |
|
|
!** Hogan & Illingworth (2001) |
202 |
|
|
ZCLEAR(JL)=ZCLEAR(JL)*( & |
203 |
|
|
& ZALPHA1*(1.0_JPRB-MAX(PCLDSW(JL,JKL),ZCLOUD(JL))) & |
204 |
|
|
& /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) & |
205 |
|
|
& +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-PCLDSW(JL,JKL)) ) |
206 |
|
|
ZC1J(JL,JKL) = 1.0_JPRB - ZCLEAR(JL) |
207 |
|
|
ZCLOUD(JL) = PCLDSW(JL,JKL) |
208 |
|
|
ENDIF |
209 |
|
|
!--MODIFCODE |
210 |
|
|
ENDDO |
211 |
|
|
ENDDO |
212 |
|
|
|
213 |
✓✓ |
71640 |
DO JL=KIDIA,KFDIA |
214 |
|
71640 |
PCLEAR(JL)=1.0_JPRB-ZC1J(JL,1) |
215 |
|
|
ENDDO |
216 |
✓✓ |
2880 |
DO JK=1,KLEV |
217 |
✓✓ |
2794032 |
DO JL=KIDIA,KFDIA |
218 |
✓✓ |
2791152 |
IF (PCLEAR(JL) < 1.0_JPRB) THEN |
219 |
|
2707263 |
PCLD(JL,JK)=PCLDSW(JL,JK)/(1.0_JPRB-PCLEAR(JL)) |
220 |
|
|
ELSE |
221 |
|
83889 |
PCLD(JL,JK)=0.0_JPRB |
222 |
|
|
ENDIF |
223 |
|
2793960 |
PCLD(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PCLD(JL,JK))) |
224 |
|
|
ENDDO |
225 |
|
|
ENDDO |
226 |
|
|
|
227 |
|
|
!* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS |
228 |
|
|
! ----------------------------------------------- |
229 |
|
|
|
230 |
✓✓ |
216 |
DO JA = 1,2 |
231 |
✓✓ |
143352 |
DO JL = KIDIA,KFDIA |
232 |
|
143280 |
ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL) |
233 |
|
|
ENDDO |
234 |
|
|
ENDDO |
235 |
|
|
|
236 |
✓✗ |
72 |
IF (NSW <= 4) THEN |
237 |
|
|
INUIR=2 |
238 |
✓✗ |
72 |
ELSEIF (NSW == 6) THEN |
239 |
|
|
INUIR=4 |
240 |
|
|
ENDIF |
241 |
|
|
|
242 |
✓✓ |
288 |
DO JNU= INUIR,NSW |
243 |
|
|
|
244 |
|
|
CALL SWTT1 ( KIDIA,KFDIA,KLON, JNU, 2, IIND,& |
245 |
|
|
& ZUD,& |
246 |
|
216 |
& ZR ) |
247 |
|
|
|
248 |
✓✓ |
720 |
DO JA = 1,2 |
249 |
✓✓ |
430056 |
DO JL = KIDIA,KFDIA |
250 |
|
429840 |
PAKI(JL,JA,JNU) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA) |
251 |
|
|
ENDDO |
252 |
|
|
ENDDO |
253 |
|
|
ENDDO |
254 |
|
|
|
255 |
|
|
! ------------------------------------------------------------------ |
256 |
|
|
|
257 |
✓✗ |
72 |
IF (LHOOK) CALL DR_HOOK('SWU',1,ZHOOK_HANDLE) |
258 |
|
72 |
END SUBROUTINE SWU |
259 |
|
|
|