1 | !OPTIONS XOPT(HSFUN) |
---|
2 | SUBROUTINE SWU & |
---|
3 | & ( KIDIA, KFDIA , KLON , KLEV,& |
---|
4 | & PSCT , PCARDI, PCLDSW, PPMB , PPSOL, PRMU0, PTAVE, PWV,& |
---|
5 | & 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 | USE lmdz_clesphys |
---|
67 | |
---|
68 | IMPLICIT NONE |
---|
69 | |
---|
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 | REAL(KIND=JPRB) :: ZC1J(KLON,KLEV+1),ZCLEAR(KLON),ZCLOUD(KLON)& |
---|
103 | & , ZN175(KLON), ZN190(KLON), ZO175(KLON)& |
---|
104 | & , ZO190(KLON), ZSIGN(KLON)& |
---|
105 | & , 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 | REPSEC=1.E-12_JPRB !!!!! A REVOIR (MPL) |
---|
120 | IF (LHOOK) CALL DR_HOOK('SWU',0,ZHOOK_HANDLE) |
---|
121 | IIND(1)=1 |
---|
122 | IIND(2)=2 |
---|
123 | |
---|
124 | !* 1.1 INITIALIZES QUANTITIES |
---|
125 | ! ---------------------- |
---|
126 | |
---|
127 | DO JL = KIDIA,KFDIA |
---|
128 | PUD(JL,1,KLEV+1)=0.0_JPRB |
---|
129 | PUD(JL,2,KLEV+1)=0.0_JPRB |
---|
130 | PUD(JL,3,KLEV+1)=0.0_JPRB |
---|
131 | PUD(JL,4,KLEV+1)=0.0_JPRB |
---|
132 | PUD(JL,5,KLEV+1)=0.0_JPRB |
---|
133 | PFACT(JL)= PRMU0(JL) * PSCT |
---|
134 | !- already accounted for in RADINT |
---|
135 | ! PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35. |
---|
136 | PRMU(JL)=PRMU0(JL) |
---|
137 | PSEC(JL)=1.0_JPRB/PRMU(JL) |
---|
138 | ZC1J(JL,KLEV+1)=0.0_JPRB |
---|
139 | ENDDO |
---|
140 | |
---|
141 | !* 1.3 AMOUNTS OF ABSORBERS |
---|
142 | ! -------------------- |
---|
143 | |
---|
144 | DO JL= KIDIA,KFDIA |
---|
145 | ZUD(JL,1) = 0.0_JPRB |
---|
146 | ZUD(JL,2) = 0.0_JPRB |
---|
147 | ZO175(JL) = PPSOL(JL)** RPDU1 |
---|
148 | ZO190(JL) = PPSOL(JL)** RPDH1 |
---|
149 | ZSIGO(JL) = PPSOL(JL) |
---|
150 | ZCLEAR(JL)=1.0_JPRB |
---|
151 | ZCLOUD(JL)=0.0_JPRB |
---|
152 | ENDDO |
---|
153 | |
---|
154 | DO JK = 1 , KLEV |
---|
155 | JKP1 = JK + 1 |
---|
156 | JKL = KLEV+1 - JK |
---|
157 | JKLP1 = JKL+1 |
---|
158 | ZALPHA1=RA1OVLP(KLEV+1-JK) |
---|
159 | |
---|
160 | DO JL = KIDIA,KFDIA |
---|
161 | ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O |
---|
162 | ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG |
---|
163 | ZWH2O = MAX (PWV(JL,JKL) , REPSCQ ) |
---|
164 | |
---|
165 | ZSIGN(JL) = 100._JPRB * PPMB(JL,JKP1) |
---|
166 | PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL) |
---|
167 | ZN175(JL) = ZSIGN(JL) ** RPDU1 |
---|
168 | ZN190(JL) = ZSIGN(JL) ** RPDH1 |
---|
169 | ZDSCO2 = ZO175(JL) - ZN175(JL) |
---|
170 | ZDSH2O = ZO190(JL) - ZN190(JL) |
---|
171 | PUD(JL,1,JK) = RPNH * ZDSH2O * ZWH2O * ZRTH |
---|
172 | PUD(JL,2,JK) = RPNU * ZDSCO2 * PCARDI * ZRTU |
---|
173 | |
---|
174 | ZFPPW=1.6078_JPRB*ZWH2O/(1.0_JPRB+0.608_JPRB*ZWH2O) |
---|
175 | PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW |
---|
176 | PUD(JL,5,JK)=PUD(JL,1,JK)*(1.0_JPRB-ZFPPW) |
---|
177 | ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK) |
---|
178 | ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK) |
---|
179 | ZSIGO(JL) = ZSIGN(JL) |
---|
180 | ZO175(JL) = ZN175(JL) |
---|
181 | 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 | 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 | & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) |
---|
191 | ZC1J(JL,JKL)= 1.0_JPRB - ZCLEAR(JL) |
---|
192 | 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 | DO JL=KIDIA,KFDIA |
---|
214 | PCLEAR(JL)=1.0_JPRB-ZC1J(JL,1) |
---|
215 | ENDDO |
---|
216 | DO JK=1,KLEV |
---|
217 | DO JL=KIDIA,KFDIA |
---|
218 | IF (PCLEAR(JL) < 1.0_JPRB) THEN |
---|
219 | PCLD(JL,JK)=PCLDSW(JL,JK)/(1.0_JPRB-PCLEAR(JL)) |
---|
220 | ELSE |
---|
221 | PCLD(JL,JK)=0.0_JPRB |
---|
222 | ENDIF |
---|
223 | 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 | DO JA = 1,2 |
---|
231 | DO JL = KIDIA,KFDIA |
---|
232 | ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL) |
---|
233 | ENDDO |
---|
234 | ENDDO |
---|
235 | |
---|
236 | IF (NSW <= 4) THEN |
---|
237 | INUIR=2 |
---|
238 | ELSEIF (NSW == 6) THEN |
---|
239 | INUIR=4 |
---|
240 | ENDIF |
---|
241 | |
---|
242 | DO JNU= INUIR,NSW |
---|
243 | |
---|
244 | CALL SWTT1 ( KIDIA,KFDIA,KLON, JNU, 2, IIND,& |
---|
245 | & ZUD,& |
---|
246 | & ZR ) |
---|
247 | |
---|
248 | DO JA = 1,2 |
---|
249 | DO JL = KIDIA,KFDIA |
---|
250 | PAKI(JL,JA,JNU) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA) |
---|
251 | ENDDO |
---|
252 | ENDDO |
---|
253 | ENDDO |
---|
254 | |
---|
255 | ! ------------------------------------------------------------------ |
---|
256 | |
---|
257 | IF (LHOOK) CALL DR_HOOK('SWU',1,ZHOOK_HANDLE) |
---|
258 | END SUBROUTINE SWU |
---|
259 | |
---|