2 |
C $Name$ |
C $Name$ |
3 |
|
|
4 |
#include "CPP_OPTIONS.h" |
#include "CPP_OPTIONS.h" |
5 |
subroutine swrio (nymd,nhms,ndswr,myid,istrip,npcs, |
#include "PACKAGES_CONFIG.h" |
6 |
. pz,tz,qz,pkht,oz,co2, |
subroutine swrio (nymd,nhms,bi,bj,ndswr,myid,istrip,npcs, |
7 |
|
. low_level,mid_level, |
8 |
|
. pz,plz,plze,dpres,pkht,pkz,tz,qz,oz,co2, |
9 |
. albvisdr,albvisdf,albnirdr,albnirdf, |
. albvisdr,albvisdf,albnirdr,albnirdf, |
10 |
. dtradsw,dtswclr,radswg,swgclr, |
. dtradsw,dtswclr,radswg,swgclr, |
11 |
. fdifpar,fdirpar,osr,osrclr, |
. fdifpar,fdirpar,osr,osrclr, |
12 |
. im,jm,lm,sige,sig,dsig,ptop, |
. im,jm,lm,ptop, |
13 |
. nswcld,cldsw,cswmo,nswlz,swlz, |
. nswcld,cldsw,cswmo,nswlz,swlz, |
14 |
. lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons) |
. lpnt,imstturb,qliqave,fccave,landtype,xlats,xlons) |
15 |
|
|
16 |
implicit none |
implicit none |
17 |
#ifdef ALLOW_DIAGNOSTICS |
#ifdef ALLOW_DIAGNOSTICS |
18 |
|
#include "SIZE.h" |
19 |
|
#include "diagnostics_SIZE.h" |
20 |
#include "diagnostics.h" |
#include "diagnostics.h" |
21 |
#endif |
#endif |
22 |
|
|
23 |
c Input Variables |
c Input Variables |
24 |
c --------------- |
c --------------- |
25 |
integer nymd,nhms,ndswr,istrip,npcs |
integer nymd,nhms,bi,bj,ndswr,myid,istrip,npcs |
26 |
|
integer mid_level,low_level |
27 |
integer im,jm,lm |
integer im,jm,lm |
28 |
real ptop |
real ptop |
29 |
real sige(lm+1) |
real pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1),dpres(im,jm,lm) |
30 |
real sig(lm) |
real pkht(im,jm,lm+1),pkz(im,jm,lm) |
31 |
real dsig(lm) |
real tz(im,jm,lm),qz(im,jm,lm) |
32 |
|
real oz(im,jm,lm) |
33 |
real pz(im,jm) |
real co2 |
34 |
real tz(im,jm,lm) |
real albvisdr(im,jm),albvisdf(im,jm),albnirdr(im,jm) |
35 |
real pkht(im,jm,lm) |
real albnirdf(im,jm) |
36 |
|
real radswg(im,jm),swgclr(im,jm),fdifpar(im,jm),fdirpar(im,jm) |
37 |
real co2 |
real osr(im,jm),osrclr(im,jm),dtradsw(im,jm,lm),dtswclr(im,jm,lm) |
|
real oz(im,jm,lm) |
|
|
real qz(im,jm,lm) |
|
|
|
|
|
real albvisdr(im,jm) |
|
|
real albvisdf(im,jm) |
|
|
real albnirdr(im,jm) |
|
|
real albnirdf(im,jm) |
|
|
|
|
|
real radswg(im,jm) |
|
|
real swgclr(im,jm) |
|
|
real fdifpar(im,jm) |
|
|
real fdirpar(im,jm) |
|
|
real osr(im,jm) |
|
|
real osrclr(im,jm) |
|
|
real dtradsw(im,jm,lm) |
|
|
real dtswclr(im,jm,lm) |
|
|
|
|
38 |
integer nswcld,nswlz |
integer nswcld,nswlz |
39 |
real cldsw(im,jm,lm) |
real cldsw(im,jm,lm),cswmo(im,jm,lm),swlz(im,jm,lm) |
|
real cswmo(im,jm,lm) |
|
|
real swlz(im,jm,lm) |
|
|
|
|
40 |
logical lpnt |
logical lpnt |
41 |
integer imstturb |
integer imstturb |
42 |
real qliqave(im,jm,lm) |
real qliqave(im,jm,lm),fccave(im,jm,lm) |
|
real fccave(im,jm,lm) |
|
|
|
|
43 |
integer landtype(im,jm) |
integer landtype(im,jm) |
44 |
|
real xlats(im,jm),xlons(im,jm) |
45 |
|
|
46 |
c Local Variables |
c Local Variables |
47 |
c --------------- |
c --------------- |
48 |
integer i,j,L,nn,nsecf,mid_level, low_level |
integer i,j,L,nn,nsecf |
49 |
integer nb2,ntmstp,nymd2,nhms2 |
integer nb2,ntmstp,nymd2,nhms2 |
50 |
real getcon,grav,cp,undef,pcheck |
real getcon,grav,cp,undef,pcheck |
51 |
real ra,alf,reffw,reffi,tminv |
real ra,alf,reffw,reffi,tminv |
53 |
parameter ( reffw = 10.0 ) |
parameter ( reffw = 10.0 ) |
54 |
parameter ( reffi = 65.0 ) |
parameter ( reffi = 65.0 ) |
55 |
|
|
56 |
real alat(im,jm) |
real tdry(im,jm,lm) |
57 |
real alon(im,jm) |
real TEMP1(im,jm) |
58 |
|
real TEMP2(im,jm) |
59 |
|
real zenith (im,jm) |
60 |
|
real cldtot (im,jm,lm) |
61 |
|
real cldmxo (im,jm,lm) |
62 |
|
real totcld (im,jm) |
63 |
|
real cldlow (im,jm) |
64 |
|
real cldmid (im,jm) |
65 |
|
real cldhi (im,jm) |
66 |
|
real taulow (im,jm) |
67 |
|
real taumid (im,jm) |
68 |
|
real tauhi (im,jm) |
69 |
|
real tautype(im,jm,lm,3) |
70 |
|
real tau(im,jm,lm) |
71 |
|
real albedo(im,jm) |
72 |
|
|
73 |
|
real PK(ISTRIP,lm) |
74 |
|
real qzl(ISTRIP,lm),CLRO(ISTRIP,lm) |
75 |
|
real TZL(ISTRIP,lm) |
76 |
|
real OZL(ISTRIP,lm) |
77 |
|
real PLE(ISTRIP,lm+1) |
78 |
|
real OSZ(ISTRIP) |
79 |
|
real dpstrip(ISTRIP,lm) |
80 |
|
|
81 |
|
real albuvdr(ISTRIP),albuvdf(ISTRIP) |
82 |
|
real albirdr(ISTRIP),albirdf(ISTRIP) |
83 |
|
real difpar (ISTRIP),dirpar (ISTRIP) |
84 |
|
|
85 |
|
real fdirir(istrip),fdifir(istrip) |
86 |
|
real fdiruv(istrip),fdifuv(istrip) |
87 |
|
|
88 |
|
real flux(istrip,lm+1) |
89 |
|
real fluxclr(istrip,lm+1) |
90 |
|
real dtsw(istrip,lm) |
91 |
|
real dtswc(istrip,lm) |
92 |
|
|
93 |
|
real taul (istrip,lm) |
94 |
|
real reff (istrip,lm,2) |
95 |
|
real tauc (istrip,lm,2) |
96 |
|
real taua (istrip,lm) |
97 |
|
real tstrip (istrip) |
98 |
|
|
99 |
real PKZ(im,jm,lm) |
logical first |
100 |
real PLZ(im,jm,lm) |
data first /.true./ |
|
real tdry(im,jm,lm) |
|
|
real PLZE(im,jm,lm+1) |
|
|
real TEMP1(im,jm) |
|
|
real TEMP2(im,jm) |
|
|
real zenith (im,jm) |
|
|
real cldtot (im,jm,lm) |
|
|
real cldmxo (im,jm,lm) |
|
|
real totcld (im,jm) |
|
|
real cldlow (im,jm) |
|
|
real cldmid (im,jm) |
|
|
real cldhi (im,jm) |
|
|
real taulow (im,jm) |
|
|
real taumid (im,jm) |
|
|
real tauhi (im,jm) |
|
|
real tautype(im,jm,lm,3) |
|
|
real tau (im,jm,lm) |
|
|
real albedo(im,jm) |
|
|
|
|
|
real PK(ISTRIP,lm) |
|
|
real qzl(ISTRIP,lm), CLRO(ISTRIP,lm) |
|
|
real TZL(ISTRIP,lm) |
|
|
real OZL(ISTRIP,lm) |
|
|
real PLE(ISTRIP,lm+1) |
|
|
real COSZ(ISTRIP) |
|
|
|
|
|
real albuvdr(ISTRIP),albuvdf(ISTRIP) |
|
|
real albirdr(ISTRIP),albirdf(ISTRIP) |
|
|
real difpar (ISTRIP),dirpar (ISTRIP) |
|
|
|
|
|
real fdirir(istrip),fdifir(istrip) |
|
|
real fdiruv(istrip),fdifuv(istrip) |
|
|
|
|
|
real flux (istrip,lm+1) |
|
|
real fluxclr(istrip,lm+1) |
|
|
real dtsw (istrip,lm) |
|
|
real dtswc (istrip,lm) |
|
|
|
|
|
real taul (istrip,lm) |
|
|
real reff (istrip,lm,2) |
|
|
real tauc (istrip,lm,2) |
|
|
real taua (istrip,lm) |
|
|
real tstrip (istrip) |
|
|
|
|
|
logical first |
|
|
data first /.true./ |
|
|
|
|
|
integer koz, kh2o |
|
|
data KOZ /20/ |
|
|
data kh2o /18/ |
|
101 |
|
|
102 |
C ********************************************************************** |
C ********************************************************************** |
103 |
C **** INITIALIZATION **** |
C **** INITIALIZATION **** |
110 |
NTMSTP = nsecf(NDSWR) |
NTMSTP = nsecf(NDSWR) |
111 |
TMINV = 1./float(ntmstp) |
TMINV = 1./float(ntmstp) |
112 |
|
|
|
do j = 1,jm |
|
|
do i = 1,im |
|
|
PLZE(I,j,1) = SIGE(1)*PZ(I,j) + PTOP |
|
|
enddo |
|
|
enddo |
|
|
|
|
|
DO L = 1,lm |
|
|
do j = 1,jm |
|
|
DO I = 1,im |
|
|
PLZ (I,j,L ) = SIG (L) *PZ(I,j) + PTOP |
|
|
PLZE(I,j,L+1) = SIGE(L+1)*PZ(I,j) + PTOP |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
call pkappa ( pz,pkht,pkz,ptop,sige,dsig,im,jm,lm ) |
|
|
|
|
113 |
C Compute Temperature from Theta |
C Compute Temperature from Theta |
114 |
C ------------------------------ |
C ------------------------------ |
115 |
do L=1,lm |
do L=1,lm |
120 |
enddo |
enddo |
121 |
enddo |
enddo |
122 |
|
|
|
c Determine Level Indices for Low-Mid-High Cloud Regions |
|
|
c ------------------------------------------------------ |
|
|
low_level = lm |
|
|
mid_level = lm |
|
|
do L = lm-1,1,-1 |
|
|
pcheck = (1000.-ptop)*sig(l) + ptop |
|
|
if (pcheck.gt.700.0) low_level = L |
|
|
if (pcheck.gt.400.0) mid_level = L |
|
|
enddo |
|
|
|
|
123 |
if (first .and. myid.eq.0 ) then |
if (first .and. myid.eq.0 ) then |
124 |
print * |
print * |
125 |
print *,'Low-Level Clouds are Grouped between levels: ', |
print *,'Low-Level Clouds are Grouped between levels: ', |
134 |
C **** CALCULATE COSINE OF THE ZENITH ANGLE **** |
C **** CALCULATE COSINE OF THE ZENITH ANGLE **** |
135 |
C ********************************************************************** |
C ********************************************************************** |
136 |
|
|
137 |
CALL ASTRO ( NYMD, NHMS, ALAT,ALON, im*jm, TEMP1,RA ) |
CALL ASTRO ( NYMD, NHMS, XLATS,XLONS, im*jm, TEMP1,RA ) |
138 |
NYMD2 = NYMD |
NYMD2 = NYMD |
139 |
NHMS2 = NHMS |
NHMS2 = NHMS |
140 |
CALL TICK ( NYMD2, NHMS2, NTMSTP ) |
CALL TICK ( NYMD2, NHMS2, NTMSTP ) |
141 |
CALL ASTRO ( NYMD2, NHMS2, ALAT,ALON, im*jm, TEMP2,RA ) |
CALL ASTRO ( NYMD2, NHMS2, XLATS,XLONS, im*jm, TEMP2,RA ) |
142 |
|
|
143 |
do j = 1,jm |
do j = 1,jm |
144 |
do i = 1,im |
do i = 1,im |
225 |
if(icldfrc.gt.0) then |
if(icldfrc.gt.0) then |
226 |
do j=1,jm |
do j=1,jm |
227 |
do i=1,im |
do i=1,im |
228 |
qdiag(i,j,icldfrc) = qdiag(i,j,icldfrc) + totcld(i,j) |
qdiag(i,j,icldfrc,bi,bj) = qdiag(i,j,icldfrc,bi,bj) + totcld(i,j) |
229 |
enddo |
enddo |
230 |
enddo |
enddo |
231 |
ncldfrc = ncldfrc + 1 |
ncldfrc = ncldfrc + 1 |
235 |
do L=1,lm |
do L=1,lm |
236 |
do j=1,jm |
do j=1,jm |
237 |
do i=1,im |
do i=1,im |
238 |
qdiag(i,j,icldras+L-1) = qdiag(i,j,icldras+L-1) + cswmo(i,j,L) |
qdiag(i,j,icldras+L-1,bi,bj) = qdiag(i,j,icldras+L-1,bi,bj) + |
239 |
|
. cswmo(i,j,L) |
240 |
enddo |
enddo |
241 |
enddo |
enddo |
242 |
enddo |
enddo |
247 |
do L=1,lm |
do L=1,lm |
248 |
do j=1,jm |
do j=1,jm |
249 |
do i=1,im |
do i=1,im |
250 |
qdiag(i,j,icldtot+L-1) = qdiag(i,j,icldtot+L-1) + cldtot(i,j,L) |
qdiag(i,j,icldtot+L-1,bi,bj) = qdiag(i,j,icldtot+L-1,bi,bj) + |
251 |
|
. cldtot(i,j,L) |
252 |
enddo |
enddo |
253 |
enddo |
enddo |
254 |
enddo |
enddo |
258 |
if( icldlow.gt.0 ) then |
if( icldlow.gt.0 ) then |
259 |
do j=1,jm |
do j=1,jm |
260 |
do i=1,im |
do i=1,im |
261 |
qdiag(i,j,icldlow) = qdiag(i,j,icldlow) + cldlow(i,j) |
qdiag(i,j,icldlow,bi,bj) = qdiag(i,j,icldlow,bi,bj) + cldlow(i,j) |
262 |
enddo |
enddo |
263 |
enddo |
enddo |
264 |
ncldlow = ncldlow + 1 |
ncldlow = ncldlow + 1 |
267 |
if( icldmid.gt.0 ) then |
if( icldmid.gt.0 ) then |
268 |
do j=1,jm |
do j=1,jm |
269 |
do i=1,im |
do i=1,im |
270 |
qdiag(i,j,icldmid) = qdiag(i,j,icldmid) + cldmid(i,j) |
qdiag(i,j,icldmid,bi,bj) = qdiag(i,j,icldmid,bi,bj) + cldmid(i,j) |
271 |
enddo |
enddo |
272 |
enddo |
enddo |
273 |
ncldmid = ncldmid + 1 |
ncldmid = ncldmid + 1 |
276 |
if( icldhi.gt.0 ) then |
if( icldhi.gt.0 ) then |
277 |
do j=1,jm |
do j=1,jm |
278 |
do i=1,im |
do i=1,im |
279 |
qdiag(i,j,icldhi) = qdiag(i,j,icldhi) + cldhi(i,j) |
qdiag(i,j,icldhi,bi,bj) = qdiag(i,j,icldhi,bi,bj) + cldhi(i,j) |
280 |
enddo |
enddo |
281 |
enddo |
enddo |
282 |
ncldhi = ncldhi + 1 |
ncldhi = ncldhi + 1 |
286 |
do L=1,lm |
do L=1,lm |
287 |
do j=1,jm |
do j=1,jm |
288 |
do i=1,im |
do i=1,im |
289 |
qdiag(i,j,ilzrad+L-1) = qdiag(i,j,ilzrad+L-1) + swlz(i,j,L)*1.0e6 |
qdiag(i,j,ilzrad+L-1,bi,bj) = qdiag(i,j,ilzrad+L-1,bi,bj) + |
290 |
|
. swlz(i,j,L)*1.0e6 |
291 |
enddo |
enddo |
292 |
enddo |
enddo |
293 |
enddo |
enddo |
299 |
if( ialbvisdr.gt.0 ) then |
if( ialbvisdr.gt.0 ) then |
300 |
do j=1,jm |
do j=1,jm |
301 |
do i=1,im |
do i=1,im |
302 |
qdiag(i,j,ialbvisdr) = qdiag(i,j,ialbvisdr) + albvisdr(i,j) |
qdiag(i,j,ialbvisdr,bi,bj) = qdiag(i,j,ialbvisdr,bi,bj) + |
303 |
|
. albvisdr(i,j) |
304 |
enddo |
enddo |
305 |
enddo |
enddo |
306 |
nalbvisdr = nalbvisdr + 1 |
nalbvisdr = nalbvisdr + 1 |
309 |
if( ialbvisdf.gt.0 ) then |
if( ialbvisdf.gt.0 ) then |
310 |
do j=1,jm |
do j=1,jm |
311 |
do i=1,im |
do i=1,im |
312 |
qdiag(i,j,ialbvisdf) = qdiag(i,j,ialbvisdf) + albvisdf(i,j) |
qdiag(i,j,ialbvisdf,bi,bj) = qdiag(i,j,ialbvisdf,bi,bj) + |
313 |
|
. albvisdf(i,j) |
314 |
enddo |
enddo |
315 |
enddo |
enddo |
316 |
nalbvisdf = nalbvisdf + 1 |
nalbvisdf = nalbvisdf + 1 |
319 |
if( ialbnirdr.gt.0 ) then |
if( ialbnirdr.gt.0 ) then |
320 |
do j=1,jm |
do j=1,jm |
321 |
do i=1,im |
do i=1,im |
322 |
qdiag(i,j,ialbnirdr) = qdiag(i,j,ialbnirdr) + albnirdr(i,j) |
qdiag(i,j,ialbnirdr,bi,bj) = qdiag(i,j,ialbnirdr,bi,bj) + |
323 |
|
. albnirdr(i,j) |
324 |
enddo |
enddo |
325 |
enddo |
enddo |
326 |
nalbnirdr = nalbnirdr + 1 |
nalbnirdr = nalbnirdr + 1 |
329 |
if( ialbnirdf.gt.0 ) then |
if( ialbnirdf.gt.0 ) then |
330 |
do j=1,jm |
do j=1,jm |
331 |
do i=1,im |
do i=1,im |
332 |
qdiag(i,j,ialbnirdf) = qdiag(i,j,ialbnirdf) + albnirdf(i,j) |
qdiag(i,j,ialbnirdf,bi,bj) = qdiag(i,j,ialbnirdf,bi,bj) + |
333 |
|
. albnirdf(i,j) |
334 |
enddo |
enddo |
335 |
enddo |
enddo |
336 |
nalbnirdf = nalbnirdf + 1 |
nalbnirdf = nalbnirdf + 1 |
353 |
do L=1,lm |
do L=1,lm |
354 |
do j=1,jm |
do j=1,jm |
355 |
do i=1,im |
do i=1,im |
356 |
qdiag(i,j,itauave+L-1) = qdiag(i,j,itauave+L-1) + |
qdiag(i,j,itauave+L-1,bi,bj) = qdiag(i,j,itauave+L-1,bi,bj) + |
357 |
. tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L)) |
. tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L)) |
358 |
enddo |
enddo |
359 |
enddo |
enddo |
366 |
do j=1,jm |
do j=1,jm |
367 |
do i=1,im |
do i=1,im |
368 |
if( cldtot(i,j,L).ne.0.0 ) then |
if( cldtot(i,j,L).ne.0.0 ) then |
369 |
qdiag(i,j,itaucld +L-1) = qdiag(i,j,itaucld +L-1) + |
qdiag(i,j,itaucld +L-1,bi,bj) = qdiag(i,j,itaucld +L-1,bi,bj) + |
370 |
. tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L)) |
. tau(i,j,L)*100/(plze(i,j,L+1)-plze(i,j,L)) |
371 |
qdiag(i,j,itaucldc+L-1) = qdiag(i,j,itaucldc+L-1) + 1.0 |
qdiag(i,j,itaucldc+L-1,bi,bj) = |
372 |
|
. qdiag(i,j,itaucldc+L-1,bi,bj) + 1.0 |
373 |
endif |
endif |
374 |
enddo |
enddo |
375 |
enddo |
enddo |
379 |
c Compute Low, Mid, and High Cloud Optical Depth Diagnostics |
c Compute Low, Mid, and High Cloud Optical Depth Diagnostics |
380 |
c ---------------------------------------------------------- |
c ---------------------------------------------------------- |
381 |
if( itaulow.ne.0 ) then |
if( itaulow.ne.0 ) then |
382 |
do j = 1,jm |
do j = 1,jm |
383 |
do i = 1,im |
do i = 1,im |
384 |
if( cldlow(i,j).ne.0.0 ) then |
if( cldlow(i,j).ne.0.0 ) then |
385 |
taulow(i,j) = 0.0 |
taulow(i,j) = 0.0 |
386 |
do L = low_level,lm |
do L = low_level,lm |
387 |
taulow(i,j) = taulow(i,j) + tau(i,j,L) |
taulow(i,j) = taulow(i,j) + tau(i,j,L) |
388 |
enddo |
enddo |
389 |
qdiag(i,j,itaulow ) = qdiag(i,j,itaulow ) + taulow(i,j) |
qdiag(i,j,itaulow,bi,bj ) = qdiag(i,j,itaulow,bi,bj ) + |
390 |
qdiag(i,j,itaulowc) = qdiag(i,j,itaulowc) + 1.0 |
. taulow(i,j) |
391 |
endif |
qdiag(i,j,itaulowc,bi,bj) = qdiag(i,j,itaulowc,bi,bj) + 1.0 |
392 |
enddo |
endif |
393 |
enddo |
enddo |
394 |
|
enddo |
395 |
endif |
endif |
396 |
|
|
397 |
if( itaumid.ne.0 ) then |
if( itaumid.ne.0 ) then |
398 |
do j = 1,jm |
do j = 1,jm |
399 |
do i = 1,im |
do i = 1,im |
400 |
if( cldmid(i,j).ne.0.0 ) then |
if( cldmid(i,j).ne.0.0 ) then |
401 |
taumid(i,j) = 0.0 |
taumid(i,j) = 0.0 |
402 |
do L = mid_level,low_level+1 |
do L = mid_level,low_level+1 |
403 |
taumid(i,j) = taumid(i,j) + tau(i,j,L) |
taumid(i,j) = taumid(i,j) + tau(i,j,L) |
404 |
enddo |
enddo |
405 |
qdiag(i,j,itaumid ) = qdiag(i,j,itaumid ) + taumid(i,j) |
qdiag(i,j,itaumid,bi,bj ) = qdiag(i,j,itaumid,bi,bj ) + |
406 |
qdiag(i,j,itaumidc) = qdiag(i,j,itaumidc) + 1.0 |
. taumid(i,j) |
407 |
endif |
qdiag(i,j,itaumidc,bi,bj) = qdiag(i,j,itaumidc,bi,bj) + 1.0 |
408 |
enddo |
endif |
409 |
enddo |
enddo |
410 |
|
enddo |
411 |
endif |
endif |
412 |
|
|
413 |
if( itauhi.ne.0 ) then |
if( itauhi.ne.0 ) then |
414 |
do j = 1,jm |
do j = 1,jm |
415 |
do i = 1,im |
do i = 1,im |
416 |
if( cldhi(i,j).ne.0.0 ) then |
if( cldhi(i,j).ne.0.0 ) then |
417 |
tauhi(i,j) = 0.0 |
tauhi(i,j) = 0.0 |
418 |
do L = 1,mid_level+1 |
do L = 1,mid_level+1 |
419 |
tauhi(i,j) = tauhi(i,j) + tau(i,j,L) |
tauhi(i,j) = tauhi(i,j) + tau(i,j,L) |
420 |
enddo |
enddo |
421 |
qdiag(i,j,itauhi ) = qdiag(i,j,itauhi ) + tauhi(i,j) |
qdiag(i,j,itauhi,bi,bj ) = qdiag(i,j,itauhi,bi,bj ) + |
422 |
qdiag(i,j,itauhic) = qdiag(i,j,itauhic) + 1.0 |
. tauhi(i,j) |
423 |
endif |
qdiag(i,j,itauhic,bi,bj) = qdiag(i,j,itauhic,bi,bj) + 1.0 |
424 |
enddo |
endif |
425 |
enddo |
enddo |
426 |
|
enddo |
427 |
endif |
endif |
428 |
|
|
429 |
C*********************************************************************** |
C*********************************************************************** |
438 |
|
|
439 |
CALL STRIP ( zenith,COSZ,im*jm,ISTRIP,1,NN ) |
CALL STRIP ( zenith,COSZ,im*jm,ISTRIP,1,NN ) |
440 |
|
|
441 |
CALL STRIP ( plze, ple ,im*jm,ISTRIP,lm+1,NN) |
CALL STRIP ( plze, ple ,im*jm,ISTRIP,lm+1,NN) |
442 |
CALL STRIP ( pkz , pk ,im*jm,ISTRIP,lm ,NN) |
CALL STRIP ( pkz , pk ,im*jm,ISTRIP,lm ,NN) |
443 |
CALL STRIP ( tdry, tzl ,im*jm,ISTRIP,lm ,NN) |
CALL STRIP ( dpres,dpstrip,im*jm,ISTRIP,lm ,NN) |
444 |
CALL STRIP ( qz , qzl ,im*jm,ISTRIP,lm ,NN) |
CALL STRIP ( tdry, tzl ,im*jm,ISTRIP,lm ,NN) |
445 |
CALL STRIP ( oz , ozl ,im*jm,ISTRIP,lm ,NN) |
CALL STRIP ( qz , qzl ,im*jm,ISTRIP,lm ,NN) |
446 |
CALL STRIP ( tau , taul ,im*jm,ISTRIP,lm ,NN) |
CALL STRIP ( oz , ozl ,im*jm,ISTRIP,lm ,NN) |
447 |
|
CALL STRIP ( tau , taul ,im*jm,ISTRIP,lm ,NN) |
448 |
|
|
449 |
CALL STRIP ( albvisdr,albuvdr,im*jm,ISTRIP,1,NN ) |
CALL STRIP ( albvisdr,albuvdr,im*jm,ISTRIP,1,NN ) |
450 |
CALL STRIP ( albvisdf,albuvdf,im*jm,ISTRIP,1,NN ) |
CALL STRIP ( albvisdf,albuvdf,im*jm,ISTRIP,1,NN ) |
491 |
C ********************************************************************** |
C ********************************************************************** |
492 |
|
|
493 |
do l=1,lm |
do l=1,lm |
|
alf = grav/(cp*dsig(L)*100) |
|
494 |
do i=1,istrip |
do i=1,istrip |
495 |
|
alf = grav*(ple(i,L+1)-ptop)/(cp*dpstrip(i,L)*100) |
496 |
dtsw (i,L) = alf*( flux (i,L)-flux (i,L+1) )/pk(i,L) |
dtsw (i,L) = alf*( flux (i,L)-flux (i,L+1) )/pk(i,L) |
497 |
dtswc(i,L) = alf*( fluxclr(i,L)-fluxclr(i,L+1) )/pk(i,L) |
dtswc(i,L) = alf*( fluxclr(i,L)-fluxclr(i,L+1) )/pk(i,L) |
498 |
enddo |
enddo |
531 |
do j=1,jm |
do j=1,jm |
532 |
do i=1,im |
do i=1,im |
533 |
if( albedo(i,j).ne.undef ) then |
if( albedo(i,j).ne.undef ) then |
534 |
qdiag(i,j,ialbedo ) = qdiag(i,j,ialbedo ) + albedo(i,j) |
qdiag(i,j,ialbedo,bi,bj ) = qdiag(i,j,ialbedo,bi,bj )+albedo(i,j) |
535 |
qdiag(i,j,ialbedoc) = qdiag(i,j,ialbedoc) + 1.0 |
qdiag(i,j,ialbedoc,bi,bj) = qdiag(i,j,ialbedoc,bi,bj) + 1.0 |
536 |
endif |
endif |
537 |
enddo |
enddo |
538 |
enddo |
enddo |