1 |
|
71568 |
SUBROUTINE RRTM_RTRN1A_140GP (KLEV,K_ISTART,K_IEND,K_ICLDLYR,P_CLDFRAC,P_TAUCLD,P_ABSS1,& |
2 |
|
|
& P_OD,P_TAUSF1,P_CLFNET,P_CLHTR,P_FNET,P_HTR,P_TOTDFLUC,P_TOTDFLUX,P_TOTUFLUC,P_TOTUFLUX,& |
3 |
|
|
& P_TAVEL,PZ,P_TZ,P_TBOUND,PFRAC,P_SEMISS,P_SEMISLW,K_IREFLECT) |
4 |
|
|
|
5 |
|
|
! Reformatted for F90 by JJMorcrette, ECMWF, 980714 |
6 |
|
|
! Speed-up by D.Salmond, ECMWF, 9907 |
7 |
|
|
! Bug-fix by M.J. Iacono, AER, Inc., 9911 |
8 |
|
|
! Bug-fix by JJMorcrette, ECMWF, 991209 (RAT1, RAT2 initialization) |
9 |
|
|
! Speed-up by D. Salmond, ECMWF, 9912 |
10 |
|
|
! Bug-fix by JJMorcrette, ECMWF, 0005 (extrapolation T<160K) |
11 |
|
|
! Speed-up by D. Salmond, ECMWF, 000515 |
12 |
|
|
|
13 |
|
|
!-* This program calculates the upward fluxes, downward fluxes, |
14 |
|
|
! and heating rates for an arbitrary atmosphere. The input to |
15 |
|
|
! this program is the atmospheric profile and all Planck function |
16 |
|
|
! information. First-order "numerical" quadrature is used for the |
17 |
|
|
! angle integration, i.e. only one exponential is computed per layer |
18 |
|
|
! per g-value per band. Cloud overlap is treated with a generalized |
19 |
|
|
! maximum/random method in which adjacent cloud layers are treated |
20 |
|
|
! with maximum overlap, and non-adjacent cloud groups are treated |
21 |
|
|
! with random overlap. For adjacent cloud layers, cloud information |
22 |
|
|
! is carried from the previous two layers. |
23 |
|
|
|
24 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
25 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
26 |
|
|
|
27 |
|
|
USE PARRRTM , ONLY : JPBAND ,JPGPT ,JPLAY |
28 |
|
|
USE YOERRTAB , ONLY : BPADE |
29 |
|
|
USE YOERRTWN , ONLY : TOTPLNK ,DELWAVE |
30 |
|
|
USE YOERRTFTR, ONLY : NGB |
31 |
|
|
|
32 |
|
|
IMPLICIT NONE |
33 |
|
|
|
34 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
35 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_ISTART |
36 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_IEND |
37 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: K_ICLDLYR(JPLAY) ! Cloud indicator |
38 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_CLDFRAC(JPLAY) ! Cloud fraction |
39 |
|
|
REAL(KIND=JPRB) :: Z_CLDFRAC(JPLAY) ! Cloud fraction |
40 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness |
41 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_ABSS1(JPGPT*JPLAY) |
42 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_OD(JPGPT,JPLAY) |
43 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUSF1(JPGPT*JPLAY) |
44 |
|
|
REAL(KIND=JPRB) :: P_CLFNET(0:JPLAY) ! Argument NOT used |
45 |
|
|
REAL(KIND=JPRB) :: P_CLHTR(0:JPLAY) ! Argument NOT used |
46 |
|
|
REAL(KIND=JPRB) :: P_FNET(0:JPLAY) ! Argument NOT used |
47 |
|
|
REAL(KIND=JPRB) :: P_HTR(0:JPLAY) ! Argument NOT used |
48 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUC(0:JPLAY) |
49 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUX(0:JPLAY) |
50 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUC(0:JPLAY) |
51 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUX(0:JPLAY) |
52 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(JPLAY) |
53 |
|
|
REAL(KIND=JPRB) :: PZ(0:JPLAY) ! Argument NOT used |
54 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_TZ(0:JPLAY) |
55 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_TBOUND |
56 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: PFRAC(JPGPT,JPLAY) |
57 |
|
|
REAL(KIND=JPRB) ,INTENT(IN) :: P_SEMISS(JPBAND) |
58 |
|
|
REAL(KIND=JPRB) ,INTENT(OUT) :: P_SEMISLW |
59 |
|
|
INTEGER(KIND=JPIM) :: K_IREFLECT ! Argument NOT used |
60 |
|
|
!- from PROFILE |
61 |
|
|
!- from SP |
62 |
|
|
!- from SURFACE |
63 |
|
|
INTEGER(KIND=JPIM) :: INDLAY(JPLAY),INDLEV(0:JPLAY) |
64 |
|
|
|
65 |
|
|
REAL(KIND=JPRB) :: Z_BBU1(JPGPT*JPLAY),Z_BBUTOT1(JPGPT*JPLAY) |
66 |
|
|
REAL(KIND=JPRB) :: Z_TLAYFRAC(JPLAY),Z_TLEVFRAC(0:JPLAY) |
67 |
|
|
REAL(KIND=JPRB) :: Z_BGLEV(JPGPT) |
68 |
|
|
!-- DS_000515 |
69 |
|
|
REAL(KIND=JPRB) :: Z_PLVL(JPBAND+1,0:JPLAY),Z_PLAY(JPBAND+1,0:JPLAY),Z_WTNUM(3) |
70 |
|
|
!-- DS_000515 |
71 |
|
|
REAL(KIND=JPRB) :: Z_ODCLDNW(JPGPT,JPLAY) |
72 |
|
|
REAL(KIND=JPRB) :: Z_SEMIS(JPGPT),Z_RADUEMIT(JPGPT) |
73 |
|
|
|
74 |
|
|
REAL(KIND=JPRB) :: Z_RADCLRU1(JPGPT) ,Z_RADCLRD1(JPGPT) |
75 |
|
|
REAL(KIND=JPRB) :: Z_RADLU1(JPGPT) ,Z_RADLD1(JPGPT) |
76 |
|
|
!-- DS_000515 |
77 |
|
|
REAL(KIND=JPRB) :: Z_TRNCLD(JPLAY,JPBAND+1) |
78 |
|
|
!-- DS_000515 |
79 |
|
|
REAL(KIND=JPRB) :: Z_ABSCLDNW(JPGPT,JPLAY) |
80 |
|
|
REAL(KIND=JPRB) :: Z_ATOT1(JPGPT*JPLAY) |
81 |
|
|
|
82 |
|
|
REAL(KIND=JPRB) :: Z_SURFEMIS(JPBAND),Z_PLNKEMIT(JPBAND) |
83 |
|
|
|
84 |
|
|
! dimension of arrays required for cloud overlap calculations |
85 |
|
|
|
86 |
|
|
REAL(KIND=JPRB) :: Z_CLRRADU(jpgpt),Z_CLDRADU(jpgpt),Z_OLDCLD(jpgpt) |
87 |
|
|
REAL(KIND=JPRB) :: Z_OLDCLR(jpgpt),Z_RAD(jpgpt),Z_FACCLD1(jplay+1),Z_FACCLD2(jplay+1) |
88 |
|
|
REAL(KIND=JPRB) :: Z_FACCLR1(jplay+1),Z_FACCLR2(jplay+1) |
89 |
|
|
REAL(KIND=JPRB) :: Z_FACCMB1(jplay+1),Z_FACCMB2(jplay+1) |
90 |
|
|
REAL(KIND=JPRB) :: Z_FACCLD1D(0:jplay),Z_FACCLD2D(0:jplay),Z_FACCLR1D(0:jplay) |
91 |
|
|
REAL(KIND=JPRB) :: Z_FACCLR2D(0:jplay),Z_FACCMB1D(0:jplay),Z_FACCMB2D(0:jplay) |
92 |
|
|
REAL(KIND=JPRB) :: Z_CLRRADD(jpgpt),Z_CLDRADD(jpgpt) |
93 |
|
|
INTEGER(KIND=JPIM) :: istcld(jplay+1),istcldd(0:jplay) |
94 |
|
|
!****** |
95 |
|
|
|
96 |
|
|
!REAL_B :: ZPLVL(JPGPT+1,JPLAY) ,ZPLAY(JPGPT+1,JPLAY) |
97 |
|
|
!REAL_B :: ZTRNCLD(JPGPT+1,JPLAY),ZTAUCLD(JPGPT+1,JPLAY) |
98 |
|
|
|
99 |
|
|
INTEGER(KIND=JPIM) :: IBAND, ICLDDN, IENT, INDBOUND, INDEX, IPR, I_LAY, I_LEV, I_NBI |
100 |
|
|
|
101 |
|
|
REAL(KIND=JPRB) :: Z_BBD, Z_BBDTOT, Z_BGLAY, Z_CLDSRC, Z_DBDTLAY, Z_DBDTLEV,& |
102 |
|
|
& Z_DELBGDN, Z_DELBGUP, Z_DRAD1, Z_DRADCL1, Z_FACTOT1, & |
103 |
|
|
& Z_FMAX, Z_FMIN, Z_GASSRC, Z_ODSM, Z_PLANKBND, Z_RADCLD, Z_RADD, Z_RADMOD, Z_RAT1, Z_RAT2, Z_SUMPL, & |
104 |
|
|
& Z_SUMPLEM, Z_TBNDFRAC, Z_TRNS, Z_TTOT, Z_URAD1, Z_URADCL1, ZEXTAU |
105 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
106 |
|
|
|
107 |
|
|
|
108 |
|
|
|
109 |
|
|
REAL(KIND=JPRB) :: CLFNET(0:JPLAY) ! Argument NOT used |
110 |
|
|
REAL(KIND=JPRB) :: CLHTR(0:JPLAY) ! Argument NOT used |
111 |
|
|
REAL(KIND=JPRB) :: FNET(0:JPLAY) ! Argument NOT used |
112 |
|
|
REAL(KIND=JPRB) :: HTR(0:JPLAY) ! Argument NOT used |
113 |
|
|
|
114 |
|
|
|
115 |
|
|
|
116 |
|
|
!-------------------------------------------------------------------------- |
117 |
|
|
! Input |
118 |
|
|
! JPLAY ! Maximum number of model layers |
119 |
|
|
! JPGPT ! Total number of g-point subintervals |
120 |
|
|
! JPBAND ! Number of longwave spectral bands |
121 |
|
|
! SECANG ! Diffusivity angle |
122 |
|
|
! WTNUM ! Weight for radiance to flux conversion |
123 |
|
|
! KLEV ! Number of model layers |
124 |
|
|
! PAVEL(JPLAY) ! Mid-layer pressures (hPa) |
125 |
|
|
! PZ(0:JPLAY) ! Interface pressures (hPa) |
126 |
|
|
! TAVEL(JPLAY) ! Mid-layer temperatures (K) |
127 |
|
|
! TZ(0:JPLAY) ! Interface temperatures (K) |
128 |
|
|
! TBOUND ! Surface temperature |
129 |
|
|
! CLDFRAC(JPLAY) ! Layer cloud fraction |
130 |
|
|
! TAUCLD(JPLAY,JPBAND) ! Layer cloud optical thickness |
131 |
|
|
! ITR |
132 |
|
|
! PFRAC(JPGPT,JPLAY) ! Planck function fractions |
133 |
|
|
! ICLDLYR(JPLAY) ! Flag for cloudy layers |
134 |
|
|
! ICLD ! Flag for cloudy column |
135 |
|
|
! IREFLECT ! Flag for specular reflection |
136 |
|
|
! SEMISS(JPBAND) ! Surface spectral emissivity |
137 |
|
|
! BPADE ! Pade constant |
138 |
|
|
! OD ! Clear-sky optical thickness |
139 |
|
|
! TAUSF1 ! |
140 |
|
|
! ABSS1 ! |
141 |
|
|
|
142 |
|
|
! ABSS(JPGPT*JPLAY) ! |
143 |
|
|
! ABSCLD(JPLAY) ! |
144 |
|
|
! ATOT(JPGPT*JPLAY) ! |
145 |
|
|
! ODCLR(JPGPT,JPLAY) ! |
146 |
|
|
! ODCLD(JPBAND,JPLAY) ! |
147 |
|
|
! EFCLFR1(JPBAND,JPLAY) ! Effective cloud fraction |
148 |
|
|
! RADLU(JPGPT) ! Upward radiance |
149 |
|
|
! URAD ! Spectrally summed upward radiance |
150 |
|
|
! RADCLRU(JPGPT) ! Clear-sky upward radiance |
151 |
|
|
! CLRURAD ! Spectrally summed clear-sky upward radiance |
152 |
|
|
! RADLD(JPGPT) ! Downward radiance |
153 |
|
|
! DRAD ! Spectrally summed downward radiance |
154 |
|
|
! RADCLRD(JPGPT) ! Clear-sky downward radiance |
155 |
|
|
! CLRDRAD ! Spectrally summed clear-sky downward radiance |
156 |
|
|
|
157 |
|
|
! Output |
158 |
|
|
! TOTUFLUX(0:JPLAY) ! Upward longwave flux |
159 |
|
|
! TOTDFLUX(0:JPLAY) ! Downward longwave flux |
160 |
|
|
! TOTUFLUC(0:JPLAY) ! Clear-sky upward longwave flux |
161 |
|
|
! TOTDFLUC(0:JPLAY) ! Clear-sky downward longwave flux |
162 |
|
|
|
163 |
|
|
! Maximum/Random cloud overlap variables |
164 |
|
|
! for upward radiaitve transfer |
165 |
|
|
! FACCLR2 fraction of clear radiance from previous layer that needs to |
166 |
|
|
! be switched to cloudy stream |
167 |
|
|
! FACCLR1 fraction of the radiance that had been switched in the previous |
168 |
|
|
! layer from cloudy to clear that needs to be switched back to |
169 |
|
|
! cloudy in the current layer |
170 |
|
|
! FACCLD2 fraction of cloudy radiance from previous layer that needs to |
171 |
|
|
! be switched to clear stream |
172 |
|
|
! be switched to cloudy stream |
173 |
|
|
! FACCLD1 fraction of the radiance that had been switched in the previous |
174 |
|
|
! layer from clear to cloudy that needs to be switched back to |
175 |
|
|
! clear in the current layer |
176 |
|
|
! for downward radiaitve transfer |
177 |
|
|
! FACCLR2D fraction of clear radiance from previous layer that needs to |
178 |
|
|
! be switched to cloudy stream |
179 |
|
|
! FACCLR1D fraction of the radiance that had been switched in the previous |
180 |
|
|
! layer from cloudy to clear that needs to be switched back to |
181 |
|
|
! cloudy in the current layer |
182 |
|
|
! FACCLD2D fraction of cloudy radiance from previous layer that needs to |
183 |
|
|
! be switched to clear stream |
184 |
|
|
! be switched to cloudy stream |
185 |
|
|
! FACCLD1D fraction of the radiance that had been switched in the previous |
186 |
|
|
! layer from clear to cloudy that needs to be switched back to |
187 |
|
|
! clear in the current layer |
188 |
|
|
|
189 |
|
|
!-------------------------------------------------------------------------- |
190 |
|
|
|
191 |
|
|
! CORRECTION PROVISOIRE BUG POTENTIEL MPLFH |
192 |
|
|
! on initialise le niveau klev+1 de p_cldfrac, tableau surdimensionne |
193 |
|
|
! a 100 mais apparemment non initialise en klev+1 |
194 |
✓✓ |
2862720 |
Z_CLDFRAC(1:KLEV)=P_CLDFRAC(1:KLEV) |
195 |
|
71568 |
Z_CLDFRAC(KLEV+1)=0.0_JPRB |
196 |
✓✗ |
71568 |
IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',0,ZHOOK_HANDLE) |
197 |
|
|
Z_WTNUM(1)=0.5_JPRB |
198 |
|
|
Z_WTNUM(2)=0.0_JPRB |
199 |
|
|
Z_WTNUM(3)=0.0_JPRB |
200 |
|
|
|
201 |
|
|
DO I_LAY = 0, KLEV |
202 |
|
|
ENDDO |
203 |
|
|
!-start JJM_000511 |
204 |
✓✗✓✗
|
71568 |
IF (P_TBOUND < 339._JPRB .AND. P_TBOUND >= 160._JPRB ) THEN |
205 |
|
71568 |
INDBOUND = P_TBOUND - 159._JPRB |
206 |
|
71568 |
Z_TBNDFRAC = P_TBOUND - INT(P_TBOUND) |
207 |
|
|
ELSEIF (P_TBOUND >= 339._JPRB ) THEN |
208 |
|
|
INDBOUND = 180 |
209 |
|
|
Z_TBNDFRAC = P_TBOUND - 339._JPRB |
210 |
|
|
ELSEIF (P_TBOUND < 160._JPRB ) THEN |
211 |
|
|
INDBOUND = 1 |
212 |
|
|
Z_TBNDFRAC = P_TBOUND - 160._JPRB |
213 |
|
|
ENDIF |
214 |
|
|
!-end JJM_000511 |
215 |
|
|
|
216 |
✓✓ |
2934288 |
DO I_LAY = 0, KLEV |
217 |
|
2862720 |
P_TOTUFLUC(I_LAY) = 0.0_JPRB |
218 |
|
2862720 |
P_TOTDFLUC(I_LAY) = 0.0_JPRB |
219 |
|
2862720 |
P_TOTUFLUX(I_LAY) = 0.0_JPRB |
220 |
|
2862720 |
P_TOTDFLUX(I_LAY) = 0.0_JPRB |
221 |
|
|
!-start JJM_000511 |
222 |
✓✗✓✗
|
2934288 |
IF (P_TZ(I_LAY) < 339._JPRB .AND. P_TZ(I_LAY) >= 160._JPRB ) THEN |
223 |
|
2862720 |
INDLEV(I_LAY) = P_TZ(I_LAY) - 159._JPRB |
224 |
|
2862720 |
Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - INT(P_TZ(I_LAY)) |
225 |
|
|
ELSEIF (P_TZ(I_LAY) >= 339._JPRB ) THEN |
226 |
|
|
INDLEV(I_LAY) = 180 |
227 |
|
|
Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 339._JPRB |
228 |
|
|
ELSEIF (P_TZ(I_LAY) < 160._JPRB ) THEN |
229 |
|
|
INDLEV(I_LAY) = 1 |
230 |
|
|
Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 160._JPRB |
231 |
|
|
ENDIF |
232 |
|
|
!-end JJM_000511 |
233 |
|
|
ENDDO |
234 |
|
|
|
235 |
|
|
!_start_jjm 991209 |
236 |
✓✓ |
2934288 |
DO I_LEV=0,KLEV |
237 |
|
2862720 |
Z_FACCLD1(I_LEV+1) = 0.0_JPRB |
238 |
|
2862720 |
Z_FACCLD2(I_LEV+1) = 0.0_JPRB |
239 |
|
2862720 |
Z_FACCLR1(I_LEV+1) = 0.0_JPRB |
240 |
|
2862720 |
Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
241 |
|
2862720 |
Z_FACCMB1(I_LEV+1) = 0.0_JPRB |
242 |
|
2862720 |
Z_FACCMB2(I_LEV+1) = 0.0_JPRB |
243 |
|
2862720 |
Z_FACCLD1D(I_LEV) = 0.0_JPRB |
244 |
|
2862720 |
Z_FACCLD2D(I_LEV) = 0.0_JPRB |
245 |
|
2862720 |
Z_FACCLR1D(I_LEV) = 0.0_JPRB |
246 |
|
2862720 |
Z_FACCLR2D(I_LEV) = 0.0_JPRB |
247 |
|
2862720 |
Z_FACCMB1D(I_LEV) = 0.0_JPRB |
248 |
|
2934288 |
Z_FACCMB2D(I_LEV) = 0.0_JPRB |
249 |
|
|
ENDDO |
250 |
|
|
|
251 |
|
|
Z_RAT1 = 0.0_JPRB |
252 |
|
|
Z_RAT2 = 0.0_JPRB |
253 |
|
|
|
254 |
|
|
!_end_jjm 991209 |
255 |
|
|
|
256 |
|
|
Z_SUMPL = 0.0_JPRB |
257 |
|
|
Z_SUMPLEM = 0.0_JPRB |
258 |
|
|
|
259 |
|
71568 |
ISTCLD(1) = 1 |
260 |
|
71568 |
ISTCLDD(KLEV) = 1 |
261 |
|
|
|
262 |
✓✓ |
2862720 |
DO I_LEV = 1, KLEV |
263 |
|
|
!-- DS_000515 |
264 |
|
|
!-start JJM_000511 |
265 |
✓✗✓✗
|
2862720 |
IF (P_TAVEL(I_LEV) < 339._JPRB .AND. P_TAVEL(I_LEV) >= 160._JPRB ) THEN |
266 |
|
2791152 |
INDLAY(I_LEV) = P_TAVEL(I_LEV) - 159._JPRB |
267 |
|
2791152 |
Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - INT(P_TAVEL(I_LEV)) |
268 |
|
|
ELSEIF (P_TAVEL(I_LEV) >= 339._JPRB ) THEN |
269 |
|
|
INDLAY(I_LEV) = 180 |
270 |
|
|
Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 339._JPRB |
271 |
|
|
ELSEIF (P_TAVEL(I_LEV) < 160._JPRB ) THEN |
272 |
|
|
INDLAY(I_LEV) = 1 |
273 |
|
|
Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 160._JPRB |
274 |
|
|
ENDIF |
275 |
|
|
!-end JJM_000511 |
276 |
|
|
ENDDO |
277 |
|
|
!-- DS_000515 |
278 |
|
|
|
279 |
|
|
!-- DS_000515 |
280 |
|
|
!OCL SCALAR |
281 |
|
|
|
282 |
✓✓ |
2862720 |
DO I_LEV = 1, KLEV |
283 |
✓✓ |
2862720 |
IF (K_ICLDLYR(I_LEV) == 1) THEN |
284 |
|
|
|
285 |
|
|
!mji |
286 |
|
620301 |
ISTCLD(I_LEV+1) = 0 |
287 |
✓✓ |
620301 |
IF (I_LEV == KLEV) THEN |
288 |
|
161 |
Z_FACCLD1(I_LEV+1) = 0.0_JPRB |
289 |
|
161 |
Z_FACCLD2(I_LEV+1) = 0.0_JPRB |
290 |
|
161 |
Z_FACCLR1(I_LEV+1) = 0.0_JPRB |
291 |
|
161 |
Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
292 |
|
|
!-- DS_000515 |
293 |
|
|
!SB debug >> |
294 |
|
161 |
Z_FACCMB1(I_LEV+1) =0.0_JPRB |
295 |
|
161 |
Z_FACCMB2(I_LEV+1) =0.0_JPRB |
296 |
|
|
!SB debug << |
297 |
|
|
!mji ISTCLD(LEV+1) = _ZERO_ |
298 |
✓✓ |
620140 |
ELSEIF (Z_CLDFRAC(I_LEV+1) >= Z_CLDFRAC(I_LEV)) THEN |
299 |
|
237491 |
Z_FACCLD1(I_LEV+1) = 0.0_JPRB |
300 |
|
237491 |
Z_FACCLD2(I_LEV+1) = 0.0_JPRB |
301 |
✓✓ |
237491 |
IF (ISTCLD(I_LEV) == 1) THEN |
302 |
|
|
!mji ISTCLD(LEV+1) = 0 |
303 |
|
70222 |
Z_FACCLR1(I_LEV+1) = 0.0_JPRB |
304 |
|
|
!mji |
305 |
|
70222 |
Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
306 |
✓✓ |
70222 |
IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN |
307 |
|
|
Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/& |
308 |
|
70207 |
& (1.0_JPRB-Z_CLDFRAC(I_LEV)) |
309 |
|
|
ENDIF |
310 |
|
|
!SB debug >> |
311 |
|
70222 |
Z_FACCLR2(I_LEV) = 0.0_JPRB |
312 |
|
70222 |
Z_FACCLD2(I_LEV) = 0.0_JPRB |
313 |
|
|
!SB debug << |
314 |
|
|
ELSE |
315 |
|
167269 |
Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1)) |
316 |
|
|
!mji |
317 |
✓✓ |
167269 |
IF (Z_CLDFRAC(I_LEV+1) > Z_FMAX) THEN |
318 |
|
114453 |
Z_FACCLR1(I_LEV+1) = Z_RAT2 |
319 |
|
114453 |
Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_FMAX)/(1.0_JPRB-Z_FMAX) |
320 |
|
|
!mji |
321 |
✓✓ |
52816 |
ELSEIF (Z_CLDFRAC(I_LEV+1) < Z_FMAX) THEN |
322 |
|
|
Z_FACCLR1(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/& |
323 |
|
23750 |
& (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV)) |
324 |
|
23750 |
Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
325 |
|
|
!mji |
326 |
|
|
ELSE |
327 |
|
29066 |
Z_FACCLR1(I_LEV+1) = Z_RAT2 |
328 |
|
29066 |
Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
329 |
|
|
ENDIF |
330 |
|
|
ENDIF |
331 |
✓✓✓✓
|
237491 |
IF (Z_FACCLR1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLR2(I_LEV+1) > 0.0_JPRB) THEN |
332 |
|
|
Z_RAT1 = 1.0_JPRB |
333 |
|
|
Z_RAT2 = 0.0_JPRB |
334 |
|
|
!SB debug >> |
335 |
|
|
! ENDIF |
336 |
|
|
ELSE |
337 |
|
|
Z_RAT1 = 0.0_JPRB |
338 |
|
|
Z_RAT2 = 0.0_JPRB |
339 |
|
|
ENDIF |
340 |
|
|
!SB debug << |
341 |
|
|
ELSE |
342 |
|
382649 |
Z_FACCLR1(I_LEV+1) = 0.0_JPRB |
343 |
|
382649 |
Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
344 |
✓✓ |
382649 |
IF (ISTCLD(I_LEV) == 1) THEN |
345 |
|
|
!mji ISTCLD(LEV+1) = 0 |
346 |
|
54503 |
Z_FACCLD1(I_LEV+1) = 0.0_JPRB |
347 |
|
54503 |
Z_FACCLD2(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/Z_CLDFRAC(I_LEV) |
348 |
|
|
!SB debug >> |
349 |
|
54503 |
Z_FACCLR2(I_LEV) = 0.0_JPRB |
350 |
|
54503 |
Z_FACCLD2(I_LEV) = 0.0_JPRB |
351 |
|
|
!SB debug << |
352 |
|
|
ELSE |
353 |
|
328146 |
Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1)) |
354 |
✓✓ |
328146 |
IF (Z_CLDFRAC(I_LEV+1) <= Z_FMIN) THEN |
355 |
|
287447 |
Z_FACCLD1(I_LEV+1) = Z_RAT1 |
356 |
|
287447 |
Z_FACCLD2(I_LEV+1) = (Z_FMIN-Z_CLDFRAC(I_LEV+1))/Z_FMIN |
357 |
|
|
ELSE |
358 |
|
|
Z_FACCLD1(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/& |
359 |
|
40699 |
& (Z_CLDFRAC(I_LEV)-Z_FMIN) |
360 |
|
40699 |
Z_FACCLD2(I_LEV+1) = 0.0_JPRB |
361 |
|
|
ENDIF |
362 |
|
|
ENDIF |
363 |
✓✓✗✓
|
382649 |
IF (Z_FACCLD1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLD2(I_LEV+1) > 0.0_JPRB) THEN |
364 |
|
|
Z_RAT1 = 0.0_JPRB |
365 |
|
|
Z_RAT2 = 1.0_JPRB |
366 |
|
|
!SB debug >> |
367 |
|
|
! ENDIF |
368 |
|
|
ELSE |
369 |
|
|
Z_RAT1 = 0.0_JPRB |
370 |
|
|
Z_RAT2 = 0.0_JPRB |
371 |
|
|
ENDIF |
372 |
|
|
!SB debug << |
373 |
|
|
ENDIF |
374 |
|
|
!fcc |
375 |
|
|
|
376 |
|
|
!SB debug >> |
377 |
|
|
! IF (I_LEV == 1) THEN |
378 |
|
|
! Z_FACCMB1(I_LEV+1) = 0. |
379 |
|
|
! Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV) |
380 |
|
|
! ELSE |
381 |
|
|
! Z_FACCMB1(I_LEV+1) = Z_FACCLR1(I_LEV+1) * Z_FACCLD2(I_LEV) *Z_CLDFRAC(I_LEV-1) |
382 |
|
|
! Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV) *& |
383 |
|
|
! & (1.0_JPRB - Z_CLDFRAC(I_LEV-1)) |
384 |
|
|
! ENDIF |
385 |
✓✓✓✗
|
620301 |
if(istcld(i_lev).ne.1.and.i_lev.ne.1) then |
386 |
|
|
z_faccmb1(i_lev+1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), & |
387 |
|
495415 |
z_cldfrac(i_lev-1)-z_cldfrac(i_lev))) |
388 |
|
|
z_faccmb2(i_lev+1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), & |
389 |
|
495415 |
z_cldfrac(i_lev)-z_cldfrac(i_lev-1))) |
390 |
|
|
endif |
391 |
|
|
!SB debug << |
392 |
|
|
!end fcc |
393 |
|
|
ELSE |
394 |
|
|
!-- DS_000515 |
395 |
|
2170851 |
ISTCLD(I_LEV+1) = 1 |
396 |
|
|
ENDIF |
397 |
|
|
ENDDO |
398 |
|
|
|
399 |
|
|
!_start_jjm 991209 |
400 |
|
|
Z_RAT1 = 0.0_JPRB |
401 |
|
|
Z_RAT2 = 0.0_JPRB |
402 |
|
|
!_end_jjm 991209 |
403 |
|
|
|
404 |
|
|
!-- DS_000515 |
405 |
|
|
!OCL SCALAR |
406 |
|
|
|
407 |
✓✓ |
2862720 |
DO I_LEV = KLEV, 1, -1 |
408 |
✓✓ |
2862720 |
IF (K_ICLDLYR(I_LEV) == 1) THEN |
409 |
|
|
!mji |
410 |
|
620301 |
ISTCLDD(I_LEV-1) = 0 |
411 |
✓✓ |
620301 |
IF (I_LEV == 1) THEN |
412 |
|
22976 |
Z_FACCLD1D(I_LEV-1) = 0.0_JPRB |
413 |
|
22976 |
Z_FACCLD2D(I_LEV-1) = 0.0_JPRB |
414 |
|
22976 |
Z_FACCLR1D(I_LEV-1) = 0.0_JPRB |
415 |
|
22976 |
Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
416 |
|
22976 |
Z_FACCMB1D(I_LEV-1) = 0.0_JPRB |
417 |
|
22976 |
Z_FACCMB2D(I_LEV-1) = 0.0_JPRB |
418 |
|
|
!mji ISTCLDD(LEV-1) = _ZERO_ |
419 |
✓✓ |
597325 |
ELSEIF (Z_CLDFRAC(I_LEV-1) >= Z_CLDFRAC(I_LEV)) THEN |
420 |
|
290349 |
Z_FACCLD1D(I_LEV-1) = 0.0_JPRB |
421 |
|
290349 |
Z_FACCLD2D(I_LEV-1) = 0.0_JPRB |
422 |
✓✓ |
290349 |
IF (ISTCLDD(I_LEV) == 1) THEN |
423 |
|
|
!mji ISTCLDD(LEV-1) = 0 |
424 |
|
74393 |
Z_FACCLR1D(I_LEV-1) = 0.0_JPRB |
425 |
|
74393 |
Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
426 |
✓✓ |
74393 |
IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN |
427 |
|
|
Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/& |
428 |
|
74277 |
& (1.0_JPRB-Z_CLDFRAC(I_LEV)) |
429 |
|
|
ENDIF |
430 |
|
|
!SB debug >> |
431 |
|
74393 |
z_facclr2d(i_lev)=0.0_JPRB |
432 |
|
74393 |
z_faccld2d(i_lev)=0.0_JPRB |
433 |
|
|
!SB debug << |
434 |
|
|
ELSE |
435 |
|
215956 |
Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1)) |
436 |
|
|
!mji |
437 |
✓✓ |
215956 |
IF (Z_CLDFRAC(I_LEV-1) > Z_FMAX) THEN |
438 |
|
164826 |
Z_FACCLR1D(I_LEV-1) = Z_RAT2 |
439 |
|
164826 |
Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_FMAX)/(1.0_JPRB-Z_FMAX) |
440 |
|
|
!mji |
441 |
✓✓ |
51130 |
ELSEIF (Z_CLDFRAC(I_LEV-1) < Z_FMAX) THEN |
442 |
|
|
Z_FACCLR1D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/& |
443 |
|
21246 |
& (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV)) |
444 |
|
21246 |
Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
445 |
|
|
!mji |
446 |
|
|
ELSE |
447 |
|
29884 |
Z_FACCLR1D(I_LEV-1) = Z_RAT2 |
448 |
|
29884 |
Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
449 |
|
|
ENDIF |
450 |
|
|
ENDIF |
451 |
✓✓✓✓
|
290349 |
IF (Z_FACCLR1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLR2D(I_LEV-1) > 0.0_JPRB)THEN |
452 |
|
|
Z_RAT1 = 1.0_JPRB |
453 |
|
|
Z_RAT2 = 0.0_JPRB |
454 |
|
|
!SB debug >> |
455 |
|
|
! ENDIF |
456 |
|
|
else |
457 |
|
|
Z_RAT1 = 0.0_JPRB |
458 |
|
|
Z_RAT2 = 0.0_JPRB |
459 |
|
|
endif |
460 |
|
|
!SB debug << |
461 |
|
|
ELSE |
462 |
|
306976 |
Z_FACCLR1D(I_LEV-1) = 0.0_JPRB |
463 |
|
306976 |
Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
464 |
✓✓ |
306976 |
IF (ISTCLDD(I_LEV) == 1) THEN |
465 |
|
|
!mji ISTCLDD(LEV-1) = 0 |
466 |
|
43883 |
Z_FACCLD1D(I_LEV-1) = 0.0_JPRB |
467 |
|
43883 |
Z_FACCLD2D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/Z_CLDFRAC(I_LEV) |
468 |
|
|
!SB debug >> |
469 |
|
43883 |
z_facclr2d(i_lev)=0.0_JPRB |
470 |
|
43883 |
z_faccld2d(i_lev)=0.0_JPRB |
471 |
|
|
!SB debug << |
472 |
|
|
ELSE |
473 |
|
263093 |
Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1)) |
474 |
✓✓ |
263093 |
IF (Z_CLDFRAC(I_LEV-1) <= Z_FMIN) THEN |
475 |
|
219108 |
Z_FACCLD1D(I_LEV-1) = Z_RAT1 |
476 |
|
219108 |
Z_FACCLD2D(I_LEV-1) = (Z_FMIN-Z_CLDFRAC(I_LEV-1))/Z_FMIN |
477 |
|
|
ELSE |
478 |
|
|
Z_FACCLD1D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/& |
479 |
|
43985 |
& (Z_CLDFRAC(I_LEV)-Z_FMIN) |
480 |
|
43985 |
Z_FACCLD2D(I_LEV-1) = 0.0_JPRB |
481 |
|
|
ENDIF |
482 |
|
|
ENDIF |
483 |
✓✓✗✓
|
306976 |
IF (Z_FACCLD1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLD2D(I_LEV-1) > 0.0_JPRB)THEN |
484 |
|
|
Z_RAT1 = 0.0_JPRB |
485 |
|
|
Z_RAT2 = 1.0_JPRB |
486 |
|
|
!SB debug >> |
487 |
|
|
! ENDIF |
488 |
|
|
ELSE |
489 |
|
|
Z_RAT1 = 0.0_JPRB |
490 |
|
|
Z_RAT2 = 0.0_JPRB |
491 |
|
|
ENDIF |
492 |
|
|
!SB debug << |
493 |
|
|
ENDIF |
494 |
|
|
!SB debug >> |
495 |
|
|
! Z_FACCMB1D(I_LEV-1) = Z_FACCLR1D(I_LEV-1) * Z_FACCLD2D(I_LEV) *Z_CLDFRAC(I_LEV+1) |
496 |
|
|
! Z_FACCMB2D(I_LEV-1) = Z_FACCLD1D(I_LEV-1) * Z_FACCLR2D(I_LEV) *& |
497 |
|
|
! & (1.0_JPRB - Z_CLDFRAC(I_LEV+1)) |
498 |
✓✓✓✓
|
620301 |
if (istcldd(i_lev).ne.1.and.i_lev.ne.1) then |
499 |
|
|
z_faccmb1d(i_lev-1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), & |
500 |
|
479049 |
z_cldfrac(i_lev-1)-z_cldfrac(i_lev))) |
501 |
|
|
z_faccmb2d(i_lev-1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), & |
502 |
|
479049 |
z_cldfrac(i_lev)-z_cldfrac(i_lev-1))) |
503 |
|
|
endif |
504 |
|
|
!SB debug << |
505 |
|
|
ELSE |
506 |
|
2170851 |
ISTCLDD(I_LEV-1) = 1 |
507 |
|
|
ENDIF |
508 |
|
|
ENDDO |
509 |
|
|
|
510 |
|
|
!- Loop over frequency bands. |
511 |
|
|
|
512 |
✓✓ |
1216656 |
DO IBAND = K_ISTART, K_IEND |
513 |
|
1145088 |
Z_DBDTLEV = TOTPLNK(INDBOUND+1,IBAND)-TOTPLNK(INDBOUND,IBAND) |
514 |
|
1145088 |
Z_PLANKBND = DELWAVE(IBAND) * (TOTPLNK(INDBOUND,IBAND) + Z_TBNDFRAC * Z_DBDTLEV) |
515 |
|
1145088 |
Z_DBDTLEV = TOTPLNK(INDLEV(0)+1,IBAND) -TOTPLNK(INDLEV(0),IBAND) |
516 |
|
|
!-- DS_000515 |
517 |
|
|
Z_PLVL(IBAND,0) = DELWAVE(IBAND)& |
518 |
|
1145088 |
& * (TOTPLNK(INDLEV(0),IBAND) + Z_TLEVFRAC(0)*Z_DBDTLEV) |
519 |
|
|
|
520 |
|
1145088 |
Z_SURFEMIS(IBAND) = P_SEMISS(IBAND) |
521 |
|
1145088 |
Z_PLNKEMIT(IBAND) = Z_SURFEMIS(IBAND) * Z_PLANKBND |
522 |
|
1145088 |
Z_SUMPLEM = Z_SUMPLEM + Z_PLNKEMIT(IBAND) |
523 |
|
1216656 |
Z_SUMPL = Z_SUMPL + Z_PLANKBND |
524 |
|
|
!--DS |
525 |
|
|
ENDDO |
526 |
|
|
!--- |
527 |
|
|
|
528 |
|
|
!-- DS_000515 |
529 |
✓✓ |
2862720 |
DO I_LEV = 1, KLEV |
530 |
✓✓ |
47521152 |
DO IBAND = K_ISTART, K_IEND |
531 |
|
|
! print *,'RTRN1A: I_LEV JPLAY IBAND INDLAY',I_LEV,JPLAY,IBAND,INDLAY(I_LEV) |
532 |
|
|
!---- |
533 |
|
|
!- Calculate the integrated Planck functions for at the |
534 |
|
|
! level and layer temperatures. |
535 |
|
|
! Compute cloud transmittance for cloudy layers. |
536 |
|
44658432 |
Z_DBDTLEV = TOTPLNK(INDLEV(I_LEV)+1,IBAND) - TOTPLNK(INDLEV(I_LEV),IBAND) |
537 |
|
44658432 |
Z_DBDTLAY = TOTPLNK(INDLAY(I_LEV)+1,IBAND) - TOTPLNK(INDLAY(I_LEV),IBAND) |
538 |
|
|
!-- DS_000515 |
539 |
|
|
Z_PLAY(IBAND,I_LEV) = DELWAVE(IBAND)& |
540 |
|
44658432 |
& *(TOTPLNK(INDLAY(I_LEV),IBAND)+Z_TLAYFRAC(I_LEV)*Z_DBDTLAY) |
541 |
|
|
Z_PLVL(IBAND,I_LEV) = DELWAVE(IBAND)& |
542 |
|
44658432 |
& *(TOTPLNK(INDLEV(I_LEV),IBAND)+Z_TLEVFRAC(I_LEV)*Z_DBDTLEV) |
543 |
✓✓ |
47449584 |
IF (K_ICLDLYR(I_LEV) > 0) THEN |
544 |
|
9924816 |
ZEXTAU = MIN( P_TAUCLD(I_LEV,IBAND), 200._JPRB) |
545 |
|
9924816 |
Z_TRNCLD(I_LEV,IBAND) = EXP( -ZEXTAU ) |
546 |
|
|
ENDIF |
547 |
|
|
!-- DS_000515 |
548 |
|
|
ENDDO |
549 |
|
|
|
550 |
|
|
ENDDO |
551 |
|
|
|
552 |
|
71568 |
P_SEMISLW = Z_SUMPLEM / Z_SUMPL |
553 |
|
|
|
554 |
|
|
!--DS |
555 |
|
|
!O IPR = 1, JPGPT |
556 |
|
|
! NBI = NGB(IPR) |
557 |
|
|
! DO LEV = 1 , KLEV |
558 |
|
|
!-- DS_000515 |
559 |
|
|
! ZPLAY(IPR,LEV) = PLAY(LEV,NGB(IPR)) |
560 |
|
|
! ZPLVL(IPR,LEV) = PLVL(LEV-1,NGB(IPR)) |
561 |
|
|
! ZTAUCLD(IPR,LEV) = TAUCLD(LEV,NGB(IPR)) |
562 |
|
|
! ZTRNCLD(IPR,LEV) = TRNCLD(LEV,NGB(IPR)) |
563 |
|
|
!-- DS_000515 |
564 |
|
|
! ENDDO |
565 |
|
|
!NDDO |
566 |
|
|
!---- |
567 |
|
|
|
568 |
|
|
!- For cloudy layers, set cloud parameters for radiative transfer. |
569 |
✓✓ |
2862720 |
DO I_LEV = 1, KLEV |
570 |
✓✓ |
2862720 |
IF (K_ICLDLYR(I_LEV) > 0) THEN |
571 |
✓✓ |
87462441 |
DO IPR = 1, JPGPT |
572 |
|
|
!--DS |
573 |
|
|
! NBI = NGB(IPR) |
574 |
|
86842140 |
Z_ODCLDNW(IPR,I_LEV) = P_TAUCLD(I_LEV,NGB(IPR)) |
575 |
|
87462441 |
Z_ABSCLDNW(IPR,I_LEV) = 1.0_JPRB - Z_TRNCLD(I_LEV,NGB(IPR)) |
576 |
|
|
!---- |
577 |
|
|
! EFCLFRNW(IPR,LEV) = ABSCLDNW(IPR,LEV) * CLDFRAC(LEV) |
578 |
|
|
ENDDO |
579 |
|
|
ENDIF |
580 |
|
|
ENDDO |
581 |
|
|
|
582 |
|
|
!- Initialize for radiative transfer. |
583 |
✓✓ |
10091088 |
DO IPR = 1, JPGPT |
584 |
|
10019520 |
Z_RADCLRD1(IPR) = 0.0_JPRB |
585 |
|
10019520 |
Z_RADLD1(IPR) = 0.0_JPRB |
586 |
|
10019520 |
I_NBI = NGB(IPR) |
587 |
|
10019520 |
Z_SEMIS(IPR) = Z_SURFEMIS(I_NBI) |
588 |
|
10019520 |
Z_RADUEMIT(IPR) = PFRAC(IPR,1) * Z_PLNKEMIT(I_NBI) |
589 |
|
|
!-- DS_000515 |
590 |
|
10091088 |
Z_BGLEV(IPR) = PFRAC(IPR,KLEV) * Z_PLVL(I_NBI,KLEV) |
591 |
|
|
ENDDO |
592 |
|
|
|
593 |
|
|
!- Downward radiative transfer. |
594 |
|
|
! *** DRAD1 holds summed radiance for total sky stream |
595 |
|
|
! *** DRADCL1 holds summed radiance for clear sky stream |
596 |
|
|
|
597 |
|
|
ICLDDN = 0 |
598 |
✓✓ |
2862720 |
DO I_LEV = KLEV, 1, -1 |
599 |
|
|
Z_DRAD1 = 0.0_JPRB |
600 |
|
|
Z_DRADCL1 = 0.0_JPRB |
601 |
|
|
|
602 |
✓✓ |
2791152 |
IF (K_ICLDLYR(I_LEV) == 1) THEN |
603 |
|
|
|
604 |
|
|
! *** Cloudy layer |
605 |
|
|
ICLDDN = 1 |
606 |
|
620301 |
IENT = JPGPT * (I_LEV-1) |
607 |
✓✓ |
87462441 |
DO IPR = 1, JPGPT |
608 |
|
86842140 |
INDEX = IENT + IPR |
609 |
|
|
!--DS |
610 |
|
|
! NBI = NGB(IPR) |
611 |
|
86842140 |
Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV) |
612 |
|
|
!---- |
613 |
|
86842140 |
Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY |
614 |
|
86842140 |
Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP |
615 |
|
|
!--DS |
616 |
|
86842140 |
Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1) |
617 |
|
|
!---- |
618 |
|
86842140 |
Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY |
619 |
|
86842140 |
Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN |
620 |
|
|
!- total-sky downward flux |
621 |
|
86842140 |
Z_ODSM = P_OD(IPR,I_LEV) + Z_ODCLDNW(IPR,I_LEV) |
622 |
|
86842140 |
Z_FACTOT1 = Z_ODSM / (BPADE + Z_ODSM) |
623 |
|
86842140 |
Z_BBUTOT1(INDEX) = Z_BGLAY + Z_FACTOT1 * Z_DELBGUP |
624 |
|
|
Z_ATOT1(INDEX) = P_ABSS1(INDEX) + Z_ABSCLDNW(IPR,I_LEV)& |
625 |
|
86842140 |
& - P_ABSS1(INDEX) * Z_ABSCLDNW(IPR,I_LEV) |
626 |
|
86842140 |
Z_BBDTOT = Z_BGLAY + Z_FACTOT1 * Z_DELBGDN |
627 |
|
86842140 |
Z_GASSRC = Z_BBD * P_ABSS1(INDEX) |
628 |
|
|
!*** |
629 |
✓✓ |
86842140 |
IF (ISTCLDD(I_LEV) == 1) THEN |
630 |
|
17484040 |
Z_CLDRADD(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLD1(IPR) |
631 |
|
17484040 |
Z_CLRRADD(IPR) = Z_RADLD1(IPR) - Z_CLDRADD(IPR) |
632 |
|
|
Z_OLDCLD(IPR) = Z_CLDRADD(IPR) |
633 |
|
|
Z_OLDCLR(IPR) = Z_CLRRADD(IPR) |
634 |
|
17484040 |
Z_RAD(IPR) = 0.0_JPRB |
635 |
|
|
ENDIF |
636 |
|
86842140 |
Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX) |
637 |
|
86842140 |
Z_CLDSRC = Z_BBDTOT * Z_ATOT1(INDEX) |
638 |
|
|
|
639 |
|
|
! Separate RT equations for clear and cloudy streams |
640 |
|
86842140 |
Z_CLDRADD(IPR) = Z_CLDRADD(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC |
641 |
|
|
Z_CLRRADD(IPR) = Z_CLRRADD(IPR) * (1.0_JPRB-P_ABSS1(INDEX)) +& |
642 |
|
86842140 |
& (1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC |
643 |
|
|
|
644 |
|
|
! Total sky downward radiance |
645 |
|
86842140 |
Z_RADLD1(IPR) = Z_CLDRADD(IPR) + Z_CLRRADD(IPR) |
646 |
|
86842140 |
Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR) |
647 |
|
|
|
648 |
|
|
! Clear-sky downward radiance |
649 |
|
86842140 |
Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX) |
650 |
|
86842140 |
Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR) |
651 |
|
|
|
652 |
|
|
!* Code to account for maximum/random overlap: |
653 |
|
|
! Performs RT on the radiance most recently switched between clear and |
654 |
|
|
! cloudy streams |
655 |
|
|
Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1D(I_LEV-1) * (1.0_JPRB-P_ABSS1(INDEX)) +& |
656 |
|
|
& Z_FACCLD1D(I_LEV-1) * Z_TTOT) - & |
657 |
|
|
& Z_FACCMB1D(I_LEV-1) * Z_GASSRC + & |
658 |
|
86842140 |
& Z_FACCMB2D(I_LEV-1) * Z_CLDSRC |
659 |
|
|
|
660 |
|
|
! Computes what the clear and cloudy streams would have been had no |
661 |
|
|
! radiance been switched |
662 |
|
86842140 |
Z_OLDCLD(IPR) = Z_CLDRADD(IPR) - Z_RADMOD |
663 |
|
86842140 |
Z_OLDCLR(IPR) = Z_CLRRADD(IPR) + Z_RADMOD |
664 |
|
|
|
665 |
|
|
! Computes the radiance to be switched between clear and cloudy. |
666 |
|
|
Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2D(I_LEV-1)*Z_OLDCLR(IPR) -& |
667 |
|
86842140 |
& Z_FACCLD2D(I_LEV-1)*Z_OLDCLD(IPR) |
668 |
|
86842140 |
Z_CLDRADD(IPR) = Z_CLDRADD(IPR) + Z_RAD(IPR) |
669 |
|
87462441 |
Z_CLRRADD(IPR) = Z_CLRRADD(IPR) - Z_RAD(IPR) |
670 |
|
|
!*** |
671 |
|
|
|
672 |
|
|
ENDDO |
673 |
|
|
|
674 |
|
|
ELSE |
675 |
|
|
|
676 |
|
|
! *** Clear layer |
677 |
|
|
! *** DRAD1 holds summed radiance for total sky stream |
678 |
|
|
! *** DRADCL1 holds summed radiance for clear sky stream |
679 |
|
|
|
680 |
|
2170851 |
IENT = JPGPT * (I_LEV-1) |
681 |
✓✓ |
2170851 |
IF (ICLDDN == 1) THEN |
682 |
✓✓ |
73241604 |
DO IPR = 1, JPGPT |
683 |
|
72722160 |
INDEX = IENT + IPR |
684 |
|
|
!--DS |
685 |
|
|
! NBI = NGB(IPR) |
686 |
|
72722160 |
Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV) |
687 |
|
|
!---- |
688 |
|
72722160 |
Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY |
689 |
|
72722160 |
Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP |
690 |
|
|
!--DS |
691 |
|
72722160 |
Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1) |
692 |
|
|
!---- |
693 |
|
72722160 |
Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY |
694 |
|
72722160 |
Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN |
695 |
|
|
|
696 |
|
|
!- total-sky downward radiance |
697 |
|
72722160 |
Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX) |
698 |
|
72722160 |
Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR) |
699 |
|
|
|
700 |
|
|
!- clear-sky downward radiance |
701 |
|
|
!- Set clear sky stream to total sky stream as long as layers |
702 |
|
|
!- remain clear. Streams diverge when a cloud is reached. |
703 |
|
72722160 |
Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX) |
704 |
|
73241604 |
Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR) |
705 |
|
|
ENDDO |
706 |
|
|
|
707 |
|
|
ELSE |
708 |
|
|
|
709 |
✓✓ |
232848387 |
DO IPR = 1, JPGPT |
710 |
|
231196980 |
INDEX = IENT + IPR |
711 |
|
|
!--DS |
712 |
|
|
! NBI = NGB(IPR) |
713 |
|
231196980 |
Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV) |
714 |
|
|
!---- |
715 |
|
231196980 |
Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY |
716 |
|
231196980 |
Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP |
717 |
|
|
!--DS |
718 |
|
231196980 |
Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1) |
719 |
|
|
!---- |
720 |
|
231196980 |
Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY |
721 |
|
231196980 |
Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN |
722 |
|
|
!- total-sky downward flux |
723 |
|
231196980 |
Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX) |
724 |
|
231196980 |
Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR) |
725 |
|
|
!- clear-sky downward flux |
726 |
|
|
!- Set clear sky stream to total sky stream as long as layers |
727 |
|
|
!- remain clear. Streams diverge when a cloud is reached. |
728 |
|
232848387 |
Z_RADCLRD1(IPR) = Z_RADLD1(IPR) |
729 |
|
|
ENDDO |
730 |
|
|
Z_DRADCL1 = Z_DRAD1 |
731 |
|
|
ENDIF |
732 |
|
|
|
733 |
|
|
ENDIF |
734 |
|
|
|
735 |
|
2791152 |
P_TOTDFLUC(I_LEV-1) = Z_DRADCL1 * Z_WTNUM(1) |
736 |
|
2862720 |
P_TOTDFLUX(I_LEV-1) = Z_DRAD1 * Z_WTNUM(1) |
737 |
|
|
|
738 |
|
|
ENDDO |
739 |
|
|
|
740 |
|
|
! Spectral reflectivity and reflectance |
741 |
|
|
! Includes the contribution of spectrally varying longwave emissivity |
742 |
|
|
! and reflection from the surface to the upward radiative transfer. |
743 |
|
|
! Note: Spectral and Lambertian reflections are identical for the one |
744 |
|
|
! angle flux integration used here. |
745 |
|
|
|
746 |
|
|
Z_URAD1 = 0.0_JPRB |
747 |
|
|
Z_URADCL1 = 0.0_JPRB |
748 |
|
|
|
749 |
|
|
!start JJM_000511 |
750 |
|
|
!IF (IREFLECT == 0) THEN |
751 |
|
|
!- Lambertian reflection. |
752 |
✓✓ |
10091088 |
DO IPR = 1, JPGPT |
753 |
|
|
! Clear-sky radiance |
754 |
|
|
! RADCLD = _TWO_ * (RADCLRD1(IPR) * WTNUM(1) ) |
755 |
|
10019520 |
Z_RADCLD = Z_RADCLRD1(IPR) |
756 |
|
10019520 |
Z_RADCLRU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADCLD |
757 |
|
10019520 |
Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR) |
758 |
|
|
|
759 |
|
|
! Total sky radiance |
760 |
|
|
! RADD = _TWO_ * (RADLD1(IPR) * WTNUM(1) ) |
761 |
|
10019520 |
Z_RADD = Z_RADLD1(IPR) |
762 |
|
10019520 |
Z_RADLU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADD |
763 |
|
10091088 |
Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR) |
764 |
|
|
ENDDO |
765 |
|
71568 |
P_TOTUFLUC(0) = Z_URADCL1 * 0.5_JPRB |
766 |
|
71568 |
P_TOTUFLUX(0) = Z_URAD1 * 0.5_JPRB |
767 |
|
|
!ELSE |
768 |
|
|
!!- Specular reflection. |
769 |
|
|
! DO IPR = 1, JPGPT |
770 |
|
|
! RADCLU = RADUEMIT(IPR) |
771 |
|
|
! RADCLRU1(IPR) = RADCLU + (_ONE_ - SEMIS(IPR)) * RADCLRD1(IPR) |
772 |
|
|
! URADCL1 = URADCL1 + RADCLRU1(IPR) |
773 |
|
|
|
774 |
|
|
! RADU = RADUEMIT(IPR) |
775 |
|
|
! RADLU1(IPR) = RADU + (_ONE_ - SEMIS(IPR)) * RADLD1(IPR) |
776 |
|
|
! URAD1 = URAD1 + RADLU1(IPR) |
777 |
|
|
! ENDDO |
778 |
|
|
! TOTUFLUC(0) = URADCL1 * WTNUM(1) |
779 |
|
|
! TOTUFLUX(0) = URAD1 * WTNUM(1) |
780 |
|
|
!ENDIF |
781 |
|
|
|
782 |
|
|
!- Upward radiative transfer. |
783 |
|
|
!- *** URAD1 holds the summed radiance for total sky stream |
784 |
|
|
!- *** URADCL1 holds the summed radiance for clear sky stream |
785 |
✓✓ |
2862720 |
DO I_LEV = 1, KLEV |
786 |
|
|
Z_URAD1 = 0.0_JPRB |
787 |
|
|
Z_URADCL1 = 0.0_JPRB |
788 |
|
|
|
789 |
|
|
! Check flag for cloud in current layer |
790 |
✓✓ |
2791152 |
IF (K_ICLDLYR(I_LEV) == 1) THEN |
791 |
|
|
|
792 |
|
|
!- *** Cloudy layer |
793 |
|
620301 |
IENT = JPGPT * (I_LEV-1) |
794 |
✓✓ |
87462441 |
DO IPR = 1, JPGPT |
795 |
|
86842140 |
INDEX = IENT + IPR |
796 |
|
|
!- total-sky upward flux |
797 |
|
86842140 |
Z_GASSRC = Z_BBU1(INDEX) * P_ABSS1(INDEX) |
798 |
|
|
|
799 |
|
|
!- If first cloudy layer in sequence, split up radiance into clear and |
800 |
|
|
! cloudy streams depending on cloud fraction |
801 |
✓✓ |
86842140 |
IF (ISTCLD(I_LEV) == 1) THEN |
802 |
|
17484040 |
Z_CLDRADU(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLU1(IPR) |
803 |
|
17484040 |
Z_CLRRADU(IPR) = Z_RADLU1(IPR) - Z_CLDRADU(IPR) |
804 |
|
|
Z_OLDCLD(IPR) = Z_CLDRADU(IPR) |
805 |
|
|
Z_OLDCLR(IPR) = Z_CLRRADU(IPR) |
806 |
|
17484040 |
Z_RAD(IPR) = 0.0_JPRB |
807 |
|
|
ENDIF |
808 |
|
86842140 |
Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX) |
809 |
|
86842140 |
Z_TRNS = 1.0_JPRB - P_ABSS1(INDEX) |
810 |
|
86842140 |
Z_CLDSRC = Z_BBUTOT1(INDEX) * Z_ATOT1(INDEX) |
811 |
|
|
|
812 |
|
|
!- Separate RT equations for clear and cloudy streams |
813 |
|
86842140 |
Z_CLDRADU(IPR) = Z_CLDRADU(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC |
814 |
|
86842140 |
Z_CLRRADU(IPR) = Z_CLRRADU(IPR) * Z_TRNS +(1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC |
815 |
|
|
!*** |
816 |
|
|
|
817 |
|
|
!- total sky upward flux |
818 |
|
86842140 |
Z_RADLU1(IPR) = Z_CLDRADU(IPR) + Z_CLRRADU(IPR) |
819 |
|
86842140 |
Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR) |
820 |
|
|
|
821 |
|
|
!- clear-sky upward flux |
822 |
|
|
Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR) + (Z_BBU1(INDEX)-Z_RADCLRU1(IPR))& |
823 |
|
86842140 |
& *P_ABSS1(INDEX) |
824 |
|
86842140 |
Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR) |
825 |
|
|
|
826 |
|
|
!* Code to account for maximum/random overlap: |
827 |
|
|
! Performs RT on the radiance most recently switched between clear and |
828 |
|
|
! cloudy streams |
829 |
|
|
Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1(I_LEV+1) * Z_TRNS +& |
830 |
|
|
& Z_FACCLD1(I_LEV+1) * Z_TTOT) - & |
831 |
|
|
& Z_FACCMB1(I_LEV+1) * Z_GASSRC + & |
832 |
|
86842140 |
& Z_FACCMB2(I_LEV+1) * Z_CLDSRC |
833 |
|
|
|
834 |
|
|
! Computes what the clear and cloudy streams would have been had no |
835 |
|
|
! radiance been switched |
836 |
|
86842140 |
Z_OLDCLD(IPR) = Z_CLDRADU(IPR) - Z_RADMOD |
837 |
|
86842140 |
Z_OLDCLR(IPR) = Z_CLRRADU(IPR) + Z_RADMOD |
838 |
|
|
|
839 |
|
|
! Computes the radiance to be switched between clear and cloudy. |
840 |
|
|
Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2(I_LEV+1)*Z_OLDCLR(IPR) -& |
841 |
|
86842140 |
& Z_FACCLD2(I_LEV+1)*Z_OLDCLD(IPR) |
842 |
|
86842140 |
Z_CLDRADU(IPR) = Z_CLDRADU(IPR) + Z_RAD(IPR) |
843 |
|
87462441 |
Z_CLRRADU(IPR) = Z_CLRRADU(IPR) - Z_RAD(IPR) |
844 |
|
|
!*** |
845 |
|
|
ENDDO |
846 |
|
|
|
847 |
|
|
ELSE |
848 |
|
|
|
849 |
|
|
!- *** Clear layer |
850 |
|
2170851 |
IENT = JPGPT * (I_LEV-1) |
851 |
✓✓ |
306089991 |
DO IPR = 1, JPGPT |
852 |
|
303919140 |
INDEX = IENT + IPR |
853 |
|
|
!- total-sky upward flux |
854 |
|
303919140 |
Z_RADLU1(IPR) = Z_RADLU1(IPR)+(Z_BBU1(INDEX)-Z_RADLU1(IPR))*P_ABSS1(INDEX) |
855 |
|
303919140 |
Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR) |
856 |
|
|
!- clear-sky upward flux |
857 |
|
|
! Upward clear and total sky streams must be separate because surface |
858 |
|
|
! reflectance is different for each. |
859 |
|
303919140 |
Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR)+(Z_BBU1(INDEX)-Z_RADCLRU1(IPR))*P_ABSS1(INDEX) |
860 |
|
306089991 |
Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR) |
861 |
|
|
ENDDO |
862 |
|
|
|
863 |
|
|
ENDIF |
864 |
|
|
|
865 |
|
2791152 |
P_TOTUFLUC(I_LEV) = Z_URADCL1 * Z_WTNUM(1) |
866 |
|
2862720 |
P_TOTUFLUX(I_LEV) = Z_URAD1 * Z_WTNUM(1) |
867 |
|
|
|
868 |
|
|
ENDDO |
869 |
|
|
|
870 |
|
|
!* Convert radiances to fluxes and heating rates for total and clear sky. |
871 |
|
|
! ** NB: moved to calling routine |
872 |
|
|
! TOTUFLUC(0) = TOTUFLUC(0) * FLUXFAC |
873 |
|
|
! TOTDFLUC(0) = TOTDFLUC(0) * FLUXFAC |
874 |
|
|
! TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC |
875 |
|
|
! TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC |
876 |
|
|
|
877 |
|
|
! CLFNET(0) = (P_TOTUFLUC(0) - P_TOTDFLUC(0)) |
878 |
|
|
! FNET(0) = (P_TOTUFLUX(0) - P_TOTDFLUX(0)) |
879 |
|
|
! DO LEV = 1, KLEV |
880 |
|
|
! TOTUFLUC(LEV) = TOTUFLUC(LEV) * FLUXFAC |
881 |
|
|
! TOTDFLUC(LEV) = TOTDFLUC(LEV) * FLUXFAC |
882 |
|
|
! CLFNET(LEV) =(P_TOTUFLUC(LEV) - P_TOTDFLUC(LEV)) |
883 |
|
|
|
884 |
|
|
! TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC |
885 |
|
|
! TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC |
886 |
|
|
! FNET(LEV) = (P_TOTUFLUX(LEV) - P_TOTDFLUX(LEV)) |
887 |
|
|
! L = LEV - 1 |
888 |
|
|
|
889 |
|
|
!- Calculate Heating Rates. |
890 |
|
|
! CLHTR(L)=HEATFAC*(CLFNET(L)-CLFNET(LEV))/(PZ(L)-PZ(LEV)) |
891 |
|
|
! HTR(L) =HEATFAC*(FNET(L) -FNET(LEV)) /(PZ(L)-PZ(LEV)) |
892 |
|
|
! END DO |
893 |
|
|
! CLHTR(KLEV) = 0.0 |
894 |
|
|
! HTR(KLEV) = 0.0 |
895 |
|
|
|
896 |
|
|
|
897 |
|
|
|
898 |
✓✗ |
71568 |
IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',1,ZHOOK_HANDLE) |
899 |
|
71568 |
END SUBROUTINE RRTM_RTRN1A_140GP |