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) |
71 |
_RL tempor1(im,jm),tempor2(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./ |
97 |
do L =1,lm |
do L =1,lm |
98 |
do j =1,jm |
do j =1,jm |
99 |
do i =1,im |
do i =1,im |
100 |
cldtot(i,j,L)=min(1.0,max(cldlw(i,j,L),fccave(i,j,L)/imstturb)) |
cldtot(i,j,L)=min(1.0 _d 0,max(cldlw(i,j,L),fccave(i,j,L)/ |
101 |
cldmxo(i,j,L) = min( 1.0 , clwmo(i,j,L) ) |
$ imstturb)) |
102 |
|
cldmxo(i,j,L) = min( 1.0 _d 0, clwmo(i,j,L) ) |
103 |
lwlz(i,j,L) = lwlz(i,j,L) + qliqave(i,j,L)/imstturb |
lwlz(i,j,L) = lwlz(i,j,L) + qliqave(i,j,L)/imstturb |
104 |
enddo |
enddo |
105 |
enddo |
enddo |
108 |
do L =1,lm |
do L =1,lm |
109 |
do j =1,jm |
do j =1,jm |
110 |
do i =1,im |
do i =1,im |
111 |
cldtot(i,j,L) = min( 1.0,cldlw(i,j,L) ) |
cldtot(i,j,L) = min( 1.0 _d 0,cldlw(i,j,L) ) |
112 |
cldmxo(i,j,L) = min( 1.0,clwmo(i,j,L) ) |
cldmxo(i,j,L) = min( 1.0 _d 0,clwmo(i,j,L) ) |
113 |
enddo |
enddo |
114 |
enddo |
enddo |
115 |
enddo |
enddo |
152 |
IF(NLWCLD.NE.0)THEN |
IF(NLWCLD.NE.0)THEN |
153 |
DO L = 1,lm |
DO L = 1,lm |
154 |
DO I = 1,ISTRIP |
DO I = 1,ISTRIP |
155 |
CLRO(I,L) = min( 1.0,clro(i,L) ) |
CLRO(I,L) = min( 1.0 _d 0,clro(i,L) ) |
156 |
CLMO(I,L) = min( 1.0,clmo(i,L) ) |
CLMO(I,L) = min( 1.0 _d 0,clmo(i,L) ) |
157 |
ENDDO |
ENDDO |
158 |
ENDDO |
ENDDO |
159 |
ENDIF |
ENDIF |
277 |
C **** BUMP DIAGNOSTICS **** |
C **** BUMP DIAGNOSTICS **** |
278 |
C ********************************************************************** |
C ********************************************************************** |
279 |
|
|
280 |
if(itgrlw.ne.0) then |
#ifdef ALLOW_DIAGNOSTICS |
281 |
do j = 1,jm |
if(diagnostics_is_on('TGRLW ',myid) ) then |
282 |
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 |
|
283 |
endif |
endif |
284 |
|
|
|
if (itlw.ne.0) then |
|
285 |
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 |
|
286 |
|
|
287 |
if (ishrad.ne.0) then |
if(diagnostics_is_on('TLW ',myid) ) then |
288 |
do L = 1,lm |
do j = 1,jm |
289 |
do j = 1,jm |
do i = 1,im |
290 |
do i = 1,im |
tmpdiag(i,j) = tz(i,j,L)*pkz(i,j,L) |
291 |
qdiag(i,j,ishrad+L-1,bi,bj) = qdiag(i,j,ishrad+L-1,bi,bj) + |
enddo |
292 |
. qz(i,j,L)*1000 |
enddo |
293 |
enddo |
call diagnostics_fill(tmpdiag,'TLW ',L,1,3,bi,bj,myid) |
294 |
enddo |
endif |
|
enddo |
|
|
endif |
|
295 |
|
|
296 |
if (iozlw.ne.0) then |
if(diagnostics_is_on('SHRAD ',myid) ) then |
297 |
do L = 1,lm |
do j = 1,jm |
298 |
do j = 1,jm |
do i = 1,im |
299 |
do i = 1,im |
tmpdiag(i,j) = qz(i,j,L)*1000. |
300 |
qdiag(i,j,iozlw+L-1,bi,bj) = qdiag(i,j,iozlw+L-1,bi,bj) + |
enddo |
301 |
. oz(i,j,L) |
enddo |
302 |
enddo |
call diagnostics_fill(tmpdiag,'SHRAD ',L,1,3,bi,bj,myid) |
303 |
enddo |
endif |
304 |
enddo |
|
305 |
endif |
if(diagnostics_is_on('OZLW ',myid) ) then |
306 |
|
do j = 1,jm |
307 |
|
do i = 1,im |
308 |
|
tmpdiag(i,j) = oz(i,j,L) |
309 |
|
enddo |
310 |
|
enddo |
311 |
|
call diagnostics_fill(tmpdiag,'OZLW ',L,1,3,bi,bj,myid) |
312 |
|
endif |
313 |
|
|
|
if (iolr.ne.0) then |
|
|
do j = 1,jm |
|
|
do i = 1,im |
|
|
qdiag(i,j,iolr,bi,bj) = qdiag(i,j,iolr,bi,bj) + tempor1(i,j) |
|
|
enddo |
|
314 |
enddo |
enddo |
315 |
|
|
316 |
|
if(diagnostics_is_on('OLR ',myid) ) then |
317 |
|
call diagnostics_fill(tempor1,'OLR ',0,1,3,bi,bj,myid) |
318 |
endif |
endif |
319 |
|
|
320 |
if (iolrclr.ne.0) then |
if(diagnostics_is_on('OLRCLR ',myid) ) then |
321 |
do j = 1,jm |
call diagnostics_fill(tempor2,'OLRCLR ',0,1,3,bi,bj,myid) |
|
do i = 1,im |
|
|
qdiag(i,j,iolrclr,bi,bj) = qdiag(i,j,iolrclr,bi,bj) + tempor2(i,j) |
|
|
enddo |
|
|
enddo |
|
322 |
endif |
endif |
323 |
|
#endif |
324 |
|
|
325 |
C ********************************************************************** |
C ********************************************************************** |
326 |
C **** Increment Diagnostics Counters and Zero-Out Cloud Info **** |
C **** Increment Diagnostics Counters and Zero-Out Cloud Info **** |
327 |
C ********************************************************************** |
C ********************************************************************** |
328 |
|
|
|
#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 |
|
|
|
|
|
c nudiag4 = nudiag4 + 1 |
|
|
endif |
|
|
#endif |
|
|
|
|
329 |
nlwlz = 0 |
nlwlz = 0 |
330 |
nlwcld = 0 |
nlwcld = 0 |
331 |
imstturb = 0 |
imstturb = 0 |
1028 |
enddo |
enddo |
1029 |
enddo |
enddo |
1030 |
|
|
1031 |
c-----the earth's surface, with an index "np+1", is treated as a layer |
c-----the earth surface, with an index "np+1", is treated as a layer |
1032 |
|
|
1033 |
do j=1,n |
do j=1,n |
1034 |
do i=1,m |
do i=1,m |
1097 |
|
|
1098 |
if (taux.gt.0.02 .and. fcld(i,j,k).gt.0.01) then |
if (taux.gt.0.02 .and. fcld(i,j,k).gt.0.01) then |
1099 |
|
|
1100 |
reff1=min(reff(i,j,k,1),130.) |
reff1=min(reff(i,j,k,1),130. _d 0) |
1101 |
reff2=min(reff(i,j,k,2),20.0) |
reff2=min(reff(i,j,k,2),20.0 _d 0) |
1102 |
|
|
1103 |
w1=taucl(i,j,k,1)*(aiw(1,ib)+(aiw(2,ib)+(aiw(3,ib) |
w1=taucl(i,j,k,1)*(aiw(1,ib)+(aiw(2,ib)+(aiw(3,ib) |
1104 |
* +aiw(4,ib)*reff1)*reff1)*reff1) |
* +aiw(4,ib)*reff1)*reff1)*reff1) |