8 |
. co2,cfc11,cfc12,cfc22,methane,n2o,emissivity, |
. co2,cfc11,cfc12,cfc22,methane,n2o,emissivity, |
9 |
. tgz,radlwg,st4,dst4, |
. tgz,radlwg,st4,dst4, |
10 |
. dtradlw,dlwdtg,dtradlwc,lwgclr, |
. dtradlw,dlwdtg,dtradlwc,lwgclr, |
11 |
. ptop,nlwcld,cldlw,clwmo,nlwlz,lwlz, |
. nlwcld,cldlw,clwmo,nlwlz,lwlz, |
12 |
. lpnt,imstturb,qliqave,fccave,landtype) |
. lpnt,imstturb,qliqave,fccave,landtype) |
13 |
|
|
14 |
implicit none |
implicit none |
23 |
integer nymd,nhms,istrip,npcs,bi,bj |
integer nymd,nhms,istrip,npcs,bi,bj |
24 |
integer mid_level,low_level |
integer mid_level,low_level |
25 |
integer im,jm,lm |
integer im,jm,lm |
|
_RL ptop |
|
26 |
_RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1) |
_RL pz(im,jm),plz(im,jm,lm),plze(im,jm,lm+1) |
27 |
_RL dpres(im,jm,lm),pkht(im,jm,lm+1),pkz(im,jm,lm) |
_RL dpres(im,jm,lm),pkht(im,jm,lm+1),pkz(im,jm,lm) |
28 |
_RL tz(im,jm,lm),qz(im,jm,lm),oz(im,jm,lm) |
_RL tz(im,jm,lm),qz(im,jm,lm),oz(im,jm,lm) |
70 |
_RL SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP) |
_RL SGMT4(ISTRIP),TSURF(ISTRIP),dsgmt4(ISTRIP) |
71 |
integer lwi(istrip) |
integer lwi(istrip) |
72 |
|
|
73 |
|
_RL tmpstrip(istrip,lm) |
74 |
|
_RL tmpimjm(im,jm,lm) |
75 |
|
_RL tempor(im,jm) |
76 |
|
|
77 |
_RL getcon,secday,convrt |
_RL getcon,secday,convrt |
78 |
|
|
79 |
logical high, trace, cldwater |
logical high, trace, cldwater |
80 |
data high /.true./ |
c data high /.true./ |
81 |
data trace /.true./ |
c data trace /.true./ |
82 |
|
data high /.false./ |
83 |
|
data trace /.false./ |
84 |
data cldwater /.false./ |
data cldwater /.false./ |
85 |
|
|
86 |
C ********************************************************************** |
C ********************************************************************** |
139 |
|
|
140 |
call stripitint (landtype,lwi,im*jm,im*jm,istrip,1,nn) |
call stripitint (landtype,lwi,im*jm,im*jm,istrip,1,nn) |
141 |
|
|
142 |
DO I = 1,ISTRIP*lm |
DO L = 1,lm |
143 |
ADELPL(I,1) = convrt / ( ple(I,2)-ple(I,1) ) |
DO I = 1,ISTRIP |
144 |
|
ADELPL(I,L) = convrt / ( ple(I,L+1)-ple(I,L) ) |
145 |
|
ENDDO |
146 |
ENDDO |
ENDDO |
147 |
|
|
148 |
C Compute Clouds |
C Compute Clouds |
219 |
do L = 1,lm |
do L = 1,lm |
220 |
do i = 1,istrip |
do i = 1,istrip |
221 |
dtrad(i,L) = ( flx(i,L)- flx(i,L+1))*adelpl(i,L) |
dtrad(i,L) = ( flx(i,L)- flx(i,L+1))*adelpl(i,L) |
222 |
|
tmpstrip(i,L) = ( flx(i,L)- flx(i,L+1)) |
223 |
dtdtg(i,L) = ( dfdts(i,L)- dfdts(i,L+1))*adelpl(i,L) |
dtdtg(i,L) = ( dfdts(i,L)- dfdts(i,L+1))*adelpl(i,L) |
224 |
dtradc(i,L) = (flxclr(i,L)-flxclr(i,L+1))*adelpl(i,L) |
dtradc(i,L) = (flxclr(i,L)-flxclr(i,L+1))*adelpl(i,L) |
225 |
enddo |
enddo |
248 |
C **** PASTE AND BUMP SOME DIAGNOSTICS **** |
C **** PASTE AND BUMP SOME DIAGNOSTICS **** |
249 |
C ********************************************************************** |
C ********************************************************************** |
250 |
|
|
251 |
|
CALL PASTE(flx(1,1),tempor,ISTRIP,im*jm,1,NN) |
252 |
|
|
253 |
c IF(IOLR.GT.0)CALL PSTBMP(flx(1,1),QDIAG(1,1,IOLR,bi,bj),ISTRIP, |
c IF(IOLR.GT.0)CALL PSTBMP(flx(1,1),QDIAG(1,1,IOLR,bi,bj),ISTRIP, |
254 |
c . im*jm, 1,NN) |
c . im*jm, 1,NN) |
255 |
c IF(IOLRCLR.GT.0)CALL PSTBMP(flxclr(1,1),QDIAG(1,1,IOLRCLR,bi,bj), |
c IF(IOLRCLR.GT.0)CALL PSTBMP(flxclr(1,1),QDIAG(1,1,IOLRCLR,bi,bj), |
263 |
|
|
264 |
DO L = 1,lm |
DO L = 1,lm |
265 |
DO I = 1,ISTRIP |
DO I = 1,ISTRIP |
266 |
DTRAD (I,L) = ( ple(i,lm+1)-PTOP ) * DTRAD (I,L)/pk(I,L) |
DTRAD (I,L) = ple(i,lm+1) * DTRAD (I,L)/pk(I,L) |
267 |
DTRADC(I,L) = ( ple(i,lm+1)-PTOP ) * DTRADC(I,L)/pk(I,L) |
DTRADC(I,L) = ple(i,lm+1) * DTRADC(I,L)/pk(I,L) |
268 |
dtdtg(I,L) = ( ple(i,lm+1)-PTOP ) * dtdtg (I,L)/pk(I,L) |
dtdtg(I,L) = ple(i,lm+1) * dtdtg (I,L)/pk(I,L) |
269 |
ENDDO |
ENDDO |
270 |
ENDDO |
ENDDO |
271 |
|
CALL PASTE ( tmpstrip ,tmpimjm ,ISTRIP,im*jm,lm,NN ) |
272 |
CALL PASTE ( DTRAD ,DTRADLW ,ISTRIP,im*jm,lm,NN ) |
CALL PASTE ( DTRAD ,DTRADLW ,ISTRIP,im*jm,lm,NN ) |
273 |
CALL PASTE ( DTRADC,DTRADLWC,ISTRIP,im*jm,lm,NN ) |
CALL PASTE ( DTRADC,DTRADLWC,ISTRIP,im*jm,lm,NN ) |
274 |
CALL PASTE ( dtdtg ,dlwdtg ,ISTRIP,im*jm,lm,NN ) |
CALL PASTE ( dtdtg ,dlwdtg ,ISTRIP,im*jm,lm,NN ) |
309 |
enddo |
enddo |
310 |
endif |
endif |
311 |
|
|
312 |
|
if (iudiag1.ne.0) then |
313 |
|
do L = 1,lm |
314 |
|
do j = 1,jm |
315 |
|
do i = 1,im |
316 |
|
qdiag(i,j,iudiag1+L-1,bi,bj) = qdiag(i,j,iudiag1+L-1,bi,bj) + |
317 |
|
. dtradlw(i,j,l) * pkz(i,j,l) * 86400 / pz(i,j) |
318 |
|
enddo |
319 |
|
enddo |
320 |
|
enddo |
321 |
|
endif |
322 |
|
|
323 |
|
if (iudiag4.ne.0) then |
324 |
|
do L = 1,lm |
325 |
|
do j = 1,jm |
326 |
|
do i = 1,im |
327 |
|
qdiag(i,j,iudiag4+L-1,bi,bj) = qdiag(i,j,iudiag4+L-1,bi,bj) + |
328 |
|
. tmpimjm(i,j,L) |
329 |
|
enddo |
330 |
|
enddo |
331 |
|
enddo |
332 |
|
endif |
333 |
|
|
334 |
|
if (iolr.ne.0) then |
335 |
|
do j = 1,jm |
336 |
|
do i = 1,im |
337 |
|
qdiag(i,j,iolr,bi,bj) = qdiag(i,j,iolr,bi,bj) + tempor(i,j) |
338 |
|
enddo |
339 |
|
enddo |
340 |
|
endif |
341 |
|
|
342 |
C ********************************************************************** |
C ********************************************************************** |
343 |
C **** Increment Diagnostics Counters and Zero-Out Cloud Info **** |
C **** Increment Diagnostics Counters and Zero-Out Cloud Info **** |
351 |
ntgrlw = ntgrlw + 1 |
ntgrlw = ntgrlw + 1 |
352 |
nolr = nolr + 1 |
nolr = nolr + 1 |
353 |
nolrclr = nolrclr + 1 |
nolrclr = nolrclr + 1 |
354 |
|
|
355 |
|
nudiag1 = nudiag1 + 1 |
356 |
|
nudiag4 = nudiag4 + 1 |
357 |
endif |
endif |
358 |
#endif |
#endif |
359 |
|
|
822 |
#include "co2-tran3.h" |
#include "co2-tran3.h" |
823 |
#include "o3-tran3.h" |
#include "o3-tran3.h" |
824 |
|
|
825 |
save c1,c2,c3,o1,o2,o3 |
c save c1,c2,c3,o1,o2,o3 |
826 |
save h11,h12,h13,h21,h22,h23,h81,h82,h83 |
c save h11,h12,h13,h21,h22,h23,h81,h82,h83 |
827 |
|
|
828 |
c if (first) then |
c if (first) then |
829 |
|
|