2 |
C $Name$ |
C $Name$ |
3 |
|
|
4 |
#include "FIZHI_OPTIONS.h" |
#include "FIZHI_OPTIONS.h" |
5 |
subroutine lwrio (nymd,nhms,bi,bj,istrip,npcs,low_level,mid_level, |
subroutine lwrio (nymd,nhms,bi,bj,myid,istrip,npcs, |
6 |
|
. low_level,mid_level, |
7 |
. im,jm,lm, |
. im,jm,lm, |
8 |
. pz,plz,plze,dpres,pkht,pkz,tz,qz,oz, |
. pz,plz,plze,dpres,pkht,pkz,tz,qz,oz, |
9 |
. co2,cfc11,cfc12,cfc22,methane,n2o,emissivity, |
. co2,cfc11,cfc12,cfc22,methane,n2o,emissivity, |
13 |
. lpnt,imstturb,qliqave,fccave,landtype) |
. lpnt,imstturb,qliqave,fccave,landtype) |
14 |
|
|
15 |
implicit none |
implicit none |
|
#ifdef ALLOW_DIAGNOSTICS |
|
|
#include "SIZE.h" |
|
|
#include "diagnostics_SIZE.h" |
|
|
#include "diagnostics.h" |
|
|
#endif |
|
16 |
|
|
17 |
c Input Variables |
c Input Variables |
18 |
c --------------- |
c --------------- |
19 |
integer nymd,nhms,istrip,npcs,bi,bj |
integer nymd,nhms,istrip,npcs,bi,bj,myid |
20 |
integer mid_level,low_level |
integer mid_level,low_level |
21 |
integer im,jm,lm |
integer im,jm,lm |
22 |
_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) |
68 |
|
|
69 |
_RL tmpstrip(istrip,lm) |
_RL tmpstrip(istrip,lm) |
70 |
_RL tmpimjm(im,jm,lm) |
_RL tmpimjm(im,jm,lm) |
71 |
_RL tempor(im,jm) |
_RL tempor1(im,jm),tempor2(im,jm) |
72 |
|
|
73 |
_RL getcon,secday,convrt |
_RL getcon,secday,convrt |
74 |
|
#ifdef ALLOW_DIAGNOSTICS |
75 |
|
logical diagnostics_is_on |
76 |
|
external diagnostics_is_on |
77 |
|
_RL tmpdiag(im,jm) |
78 |
|
#endif |
79 |
|
|
80 |
logical high, trace, cldwater |
logical high, trace, cldwater |
81 |
c data high /.true./ |
c data high /.true./ |
222 |
do L = 1,lm |
do L = 1,lm |
223 |
do i = 1,istrip |
do i = 1,istrip |
224 |
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) |
225 |
tmpstrip(i,L) = ( flx(i,L)- flx(i,L+1)) |
tmpstrip(i,L) = flx(i,L) |
226 |
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) |
227 |
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) |
228 |
enddo |
enddo |
251 |
C **** PASTE AND BUMP SOME DIAGNOSTICS **** |
C **** PASTE AND BUMP SOME DIAGNOSTICS **** |
252 |
C ********************************************************************** |
C ********************************************************************** |
253 |
|
|
254 |
CALL PASTE(flx(1,1),tempor,ISTRIP,im*jm,1,NN) |
CALL PASTE(flx(1,1),tempor1,ISTRIP,im*jm,1,NN) |
255 |
|
CALL PASTE(flxclr(1,1),tempor2,ISTRIP,im*jm,1,NN) |
|
c IF(IOLR.GT.0)CALL PSTBMP(flx(1,1),QDIAG(1,1,IOLR,bi,bj),ISTRIP, |
|
|
c . im*jm, 1,NN) |
|
|
c IF(IOLRCLR.GT.0)CALL PSTBMP(flxclr(1,1),QDIAG(1,1,IOLRCLR,bi,bj), |
|
|
c . ISTRIP,im*jm,1,NN) |
|
|
c IF(IOZLW.GT.0)CALL PSTBMP(OZL(1,1),QDIAG(1,1,IOZLW,bi,bj),ISTRIP, |
|
|
c . im*jm,lm,NN) |
|
256 |
|
|
257 |
C ********************************************************************** |
C ********************************************************************** |
258 |
C **** TENDENCY UPDATES **** |
C **** TENDENCY UPDATES **** |
276 |
C **** BUMP DIAGNOSTICS **** |
C **** BUMP DIAGNOSTICS **** |
277 |
C ********************************************************************** |
C ********************************************************************** |
278 |
|
|
279 |
if(itgrlw.ne.0) then |
#ifdef ALLOW_DIAGNOSTICS |
280 |
do j = 1,jm |
if(diagnostics_is_on('TGRLW ',myid) ) then |
281 |
do i = 1,im |
call diagnostics_fill(tgz,'TGRLW ',0,1,3,bi,bj,myid) |
|
qdiag(i,j,itgrlw,bi,bj) = qdiag(i,j,itgrlw,bi,bj) + tgz(i,j) |
|
|
enddo |
|
|
enddo |
|
282 |
endif |
endif |
283 |
|
|
|
if (itlw.ne.0) then |
|
284 |
do L = 1,lm |
do L = 1,lm |
|
do j = 1,jm |
|
|
do i = 1,im |
|
|
qdiag(i,j,itlw+L-1,bi,bj) = qdiag(i,j,itlw+L-1,bi,bj) + |
|
|
. tz(i,j,L)*pkz(i,j,L) |
|
|
enddo |
|
|
enddo |
|
|
enddo |
|
|
endif |
|
285 |
|
|
286 |
if (ishrad.ne.0) then |
if(diagnostics_is_on('TLW ',myid) ) then |
287 |
do L = 1,lm |
do j = 1,jm |
288 |
do j = 1,jm |
do i = 1,im |
289 |
do i = 1,im |
tmpdiag(i,j) = tz(i,j,L)*pkz(i,j,L) |
290 |
qdiag(i,j,ishrad+L-1,bi,bj) = qdiag(i,j,ishrad+L-1,bi,bj) + |
enddo |
291 |
. qz(i,j,L)*1000 |
enddo |
292 |
enddo |
call diagnostics_fill(tmpdiag,'TLW ',L,1,3,bi,bj,myid) |
293 |
enddo |
endif |
294 |
enddo |
|
295 |
endif |
if(diagnostics_is_on('SHRAD ',myid) ) then |
296 |
|
do j = 1,jm |
297 |
|
do i = 1,im |
298 |
|
tmpdiag(i,j) = qz(i,j,L)*1000. |
299 |
|
enddo |
300 |
|
enddo |
301 |
|
call diagnostics_fill(tmpdiag,'SHRAD ',L,1,3,bi,bj,myid) |
302 |
|
endif |
303 |
|
|
304 |
|
if(diagnostics_is_on('OZLW ',myid) ) then |
305 |
|
do j = 1,jm |
306 |
|
do i = 1,im |
307 |
|
tmpdiag(i,j) = oz(i,j,L) |
308 |
|
enddo |
309 |
|
enddo |
310 |
|
call diagnostics_fill(tmpdiag,'OZLW ',L,1,3,bi,bj,myid) |
311 |
|
endif |
312 |
|
|
|
if (iudiag4.ne.0) then |
|
|
do L = 1,lm |
|
|
do j = 1,jm |
|
|
do i = 1,im |
|
|
qdiag(i,j,iudiag4+L-1,bi,bj) = qdiag(i,j,iudiag4+L-1,bi,bj) + |
|
|
. tmpimjm(i,j,L) |
|
|
enddo |
|
|
enddo |
|
313 |
enddo |
enddo |
314 |
|
|
315 |
|
if(diagnostics_is_on('OLR ',myid) ) then |
316 |
|
call diagnostics_fill(tempor1,'OLR ',0,1,3,bi,bj,myid) |
317 |
endif |
endif |
318 |
|
|
319 |
if (iolr.ne.0) then |
if(diagnostics_is_on('OLRCLR ',myid) ) then |
320 |
do j = 1,jm |
call diagnostics_fill(tempor2,'OLRCLR ',0,1,3,bi,bj,myid) |
|
do i = 1,im |
|
|
qdiag(i,j,iolr,bi,bj) = qdiag(i,j,iolr,bi,bj) + tempor(i,j) |
|
|
enddo |
|
|
enddo |
|
321 |
endif |
endif |
322 |
|
#endif |
323 |
|
|
324 |
C ********************************************************************** |
C ********************************************************************** |
325 |
C **** Increment Diagnostics Counters and Zero-Out Cloud Info **** |
C **** Increment Diagnostics Counters and Zero-Out Cloud Info **** |
326 |
C ********************************************************************** |
C ********************************************************************** |
327 |
|
|
|
#ifdef ALLOW_DIAGNOSTICS |
|
|
if ( (bi.eq.1) .and. (bj.eq.1) ) then |
|
|
ntlw = ntlw + 1 |
|
|
nshrad = nshrad + 1 |
|
|
nozlw = nozlw + 1 |
|
|
ntgrlw = ntgrlw + 1 |
|
|
nolr = nolr + 1 |
|
|
nolrclr = nolrclr + 1 |
|
|
|
|
|
nudiag4 = nudiag4 + 1 |
|
|
endif |
|
|
#endif |
|
|
|
|
328 |
nlwlz = 0 |
nlwlz = 0 |
329 |
nlwcld = 0 |
nlwcld = 0 |
330 |
imstturb = 0 |
imstturb = 0 |
793 |
c save c1,c2,c3,o1,o2,o3 |
c save c1,c2,c3,o1,o2,o3 |
794 |
c save h11,h12,h13,h21,h22,h23,h81,h82,h83 |
c save h11,h12,h13,h21,h22,h23,h81,h82,h83 |
795 |
|
|
796 |
c if (first) then |
if (first) then |
797 |
|
|
798 |
c-----tables co2 and h2o are only used with 'high' option |
c-----tables co2 and h2o are only used with 'high' option |
799 |
|
|
861 |
enddo |
enddo |
862 |
enddo |
enddo |
863 |
|
|
864 |
c first=.false. |
first=.false. |
865 |
|
|
866 |
c endif |
endif |
867 |
|
|
868 |
c-----set the pressure at the top of the model atmosphere |
c-----set the pressure at the top of the model atmosphere |
869 |
c to 1.0e-4 if it is zero |
c to 1.0e-4 if it is zero |
1471 |
dpe=0.2 |
dpe=0.2 |
1472 |
call tablup(k1,k2,m,n,np,nx,no,nt,sco3,scopre,scotem, |
call tablup(k1,k2,m,n,np,nx,no,nt,sco3,scopre,scotem, |
1473 |
* w1,p1,dwe,dpe,o1,o2,o3,trant) |
* w1,p1,dwe,dpe,o1,o2,o3,trant) |
1474 |
|
|
1475 |
endif |
endif |
1476 |
|
|
1477 |
c***** for trace gases ***** |
c***** for trace gases ***** |