1 |
C $Header$ |
C $Header$ |
2 |
C $Name$ |
C $Name$ |
3 |
|
|
4 |
#include "CPP_OPTIONS.h" |
#include "FIZHI_OPTIONS.h" |
5 |
subroutine fizhi_step_diag(myThid,p,uphy,vphy,thphy,sphy,qq,pk,dp, |
subroutine fizhi_step_diag(myThid,p,uphy,vphy,thphy,sphy,qq,pk,dp, |
6 |
. radswt,radswg,swgclr,osr,osrclr,st4,dst4,tgz,tg0,radlwg,lwgclr, |
. radswt,radswg,swgclr,osr,osrclr,st4,dst4,tgz,tg0,radlwg,lwgclr, |
7 |
. turbu,turbv,turbt,turbq,moistu,moistv,moistt,moistq, |
. turbu,turbv,turbt,turbq,moistu,moistv,moistt,moistq, |
8 |
. lwdt,swdt,lwdtclr,swdtclr,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,bi,bj) |
. lwdt,swdt,lwdtclr,swdtclr,dlwdtg, |
9 |
|
. im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer) |
10 |
C*********************************************************************** |
C*********************************************************************** |
11 |
implicit none |
implicit none |
12 |
|
|
13 |
|
#ifdef ALLOW_DIAGNOSTICS |
14 |
|
#include "SIZE.h" |
15 |
|
#include "diagnostics_SIZE.h" |
16 |
#include "diagnostics.h" |
#include "diagnostics.h" |
17 |
|
#endif |
18 |
|
|
19 |
integer myThid,im1,im2,jm1,jm2,Nrphys,Nsx,Nsy,bi,bj |
integer myThid,im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer |
20 |
real p(im2,jm2,Nsx,Nsy) |
_RL p(im2,jm2,Nbi,Nbj) |
21 |
real uphy(im2,jm2,Nrphys,Nsx,Nsy),vphy(im2,jm2,Nrphys,Nsx,Nsy) |
_RL uphy(im2,jm2,Nrphys,Nbi,Nbj) |
22 |
real thphy(im2,jm2,Nrphys,Nsx,Nsy),sphy(im2,jm2,Nrphys,Nsx,Nsy) |
_RL vphy(im2,jm2,Nrphys,Nbi,Nbj) |
23 |
real qq(im2,jm2,Nrphys),pk(im2,jm2,Nrphys,Nsx,Nsy) |
_RL thphy(im2,jm2,Nrphys,Nbi,Nbj) |
24 |
real dp(im2,jm2,Nrphys,Nsx,Nsy) |
_RL sphy(im2,jm2,Nrphys,Nbi,Nbj) |
25 |
real radswt(im2,jm2,Nsx,Nsy),radswg(im2,jm2,Nsx,Nsy) |
_RL qq(im2,jm2,Nrphys),pk(im2,jm2,Nrphys,Nbi,Nbj) |
26 |
real swgclr(im2,jm2,Nsx,Nsy),osr(im2,jm2,Nsx,Nsy) |
_RL dp(im2,jm2,Nrphys,Nbi,Nbj) |
27 |
real osrclr(im2,jm2,Nsx,Nsy),st4(im2,jm2,Nsx,Nsy) |
_RL radswt(im2,jm2,Nbi,Nbj),radswg(im2,jm2,Nbi,Nbj) |
28 |
real dst4(im2,jm2,Nsx,Nsy),tgz(im2,jm2,Nsx,Nsy) |
_RL swgclr(im2,jm2,Nbi,Nbj),osr(im2,jm2,Nbi,Nbj) |
29 |
real tg0(im2,jm2,Nsx,Nsy),radlwg(im2,jm2,Nsx,Nsy) |
_RL osrclr(im2,jm2,Nbi,Nbj),st4(im2,jm2,Nbi,Nbj) |
30 |
real lwgclr(im2,jm2,Nsx,Nsy) |
_RL dst4(im2,jm2,Nbi,Nbj),tgz(im2,jm2,Nbi,Nbj) |
31 |
real turbu(im2,jm2,Nrphys,Nsx,Nsy),turbv(im2,jm2,Nrphys,Nsx,Nsy) |
_RL tg0(im2,jm2,Nbi,Nbj),radlwg(im2,jm2,Nbi,Nbj) |
32 |
real turbt(im2,jm2,Nrphys,Nsx,Nsy),turbq(im2,jm2,Nrphys,Nsx,Nsy) |
_RL lwgclr(im2,jm2,Nbi,Nbj) |
33 |
real moistu(im2,jm2,Nrphys,Nsx,Nsy),moistv(im2,jm2,Nrphys,Nsx,Nsy) |
_RL turbu(im2,jm2,Nrphys,Nbi,Nbj) |
34 |
real moistt(im2,jm2,Nrphys,Nsx,Nsy),moistq(im2,jm2,Nrphys,Nsx,Nsy) |
_RL turbv(im2,jm2,Nrphys,Nbi,Nbj) |
35 |
real lwdt(im2,jm2,Nrphys,Nsx,Nsy),swdt(im2,jm2,Nrphys,Nsx,Nsy) |
_RL turbt(im2,jm2,Nrphys,Nbi,Nbj) |
36 |
real lwdtclr(im2,jm2,Nrphys,Nsx,Nsy) |
_RL turbq(im2,jm2,Nrphys,ntracer,Nbi,Nbj) |
37 |
real swdtclr(im2,jm2,Nrphys,Nsx,Nsy) |
_RL moistu(im2,jm2,Nrphys,Nbi,Nbj) |
38 |
|
_RL moistv(im2,jm2,Nrphys,Nbi,Nbj) |
39 |
|
_RL moistt(im2,jm2,Nrphys,Nbi,Nbj) |
40 |
|
_RL moistq(im2,jm2,Nrphys,ntracer,Nbi,Nbj) |
41 |
|
_RL lwdt(im2,jm2,Nrphys,Nbi,Nbj) |
42 |
|
_RL swdt(im2,jm2,Nrphys,Nbi,Nbj) |
43 |
|
_RL lwdtclr(im2,jm2,Nrphys,Nbi,Nbj) |
44 |
|
_RL swdtclr(im2,jm2,Nrphys,Nbi,Nbj) |
45 |
|
_RL dlwdtg(im2,jm2,Nrphys,Nbi,Nbj) |
46 |
|
|
47 |
integer i,j,L |
integer i,j,L |
48 |
real pinv(im2,jm2), qbar(im2,jm2) |
_RL pinv(im2,jm2), qbar(im2,jm2) |
49 |
|
|
50 |
C ********************************************************************** |
C ********************************************************************** |
51 |
|
|
52 |
|
#ifdef ALLOW_DIAGNOSTICS |
53 |
do j=jm1,jm2 |
do j=jm1,jm2 |
54 |
do i=im1,im2 |
do i=im1,im2 |
55 |
pinv(i,j) = 1.0 / p(i,j,bi,bj) |
pinv(i,j) = 1.0 / p(i,j,bi,bj) |
146 |
enddo |
enddo |
147 |
endif |
endif |
148 |
|
|
149 |
|
if( (bi.eq.1) .and. (bj.eq.1) ) then |
150 |
nradswt = nradswt + 1 |
nradswt = nradswt + 1 |
151 |
nradswg = nradswg + 1 |
nradswg = nradswg + 1 |
152 |
nswgclr = nswgclr + 1 |
nswgclr = nswgclr + 1 |
155 |
nradlwg = nradlwg + 1 |
nradlwg = nradlwg + 1 |
156 |
nlwgclr = nlwgclr + 1 |
nlwgclr = nlwgclr + 1 |
157 |
nlwgup = nlwgup + 1 |
nlwgup = nlwgup + 1 |
158 |
|
endif |
159 |
|
|
160 |
C ********************************************************************** |
C ********************************************************************** |
161 |
do L=1,Nrphys |
do L=1,Nrphys |
221 |
enddo |
enddo |
222 |
enddo |
enddo |
223 |
endif |
endif |
224 |
|
|
225 |
c Longwave Heating Clear-Sky (deg/day) |
c Longwave Heating Clear-Sky (deg/day) |
226 |
c ------------------------------------ |
c ------------------------------------ |
227 |
if (ilwclr.ne.0) then |
if (ilwclr.ne.0) then |
254 |
do i=im1,im2 |
do i=im1,im2 |
255 |
qdiag(i,j,iswclr+l-1,bi,bj) = qdiag(i,j,iswclr+l-1,bi,bj) + |
qdiag(i,j,iswclr+l-1,bi,bj) = qdiag(i,j,iswclr+l-1,bi,bj) + |
256 |
. swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)* |
. swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)* |
257 |
. pk(i,j,l,bi,bj)*pinv(i,j,bi,bj)*86400 |
. pk(i,j,l,bi,bj)*pinv(i,j)*86400 |
258 |
enddo |
enddo |
259 |
enddo |
enddo |
260 |
endif |
endif |
315 |
|
|
316 |
enddo |
enddo |
317 |
|
|
318 |
|
if( (bi.eq.1) .and. (bj.eq.1) ) then |
319 |
|
|
320 |
ndiabu = ndiabu + 1 |
ndiabu = ndiabu + 1 |
321 |
ndiabv = ndiabv + 1 |
ndiabv = ndiabv + 1 |
322 |
ndiabt = ndiabt + 1 |
ndiabt = ndiabt + 1 |
331 |
ntke = ntke + 1 |
ntke = ntke + 1 |
332 |
nsphu = nsphu + 1 |
nsphu = nsphu + 1 |
333 |
|
|
334 |
|
endif |
335 |
|
|
336 |
C ********************************************************************** |
C ********************************************************************** |
337 |
|
|
338 |
c Vertically Averaged Moist-T Increment (K/day) |
c Vertically Averaged Moist-T Increment (K/day) |
354 |
do j=jm1,jm2 |
do j=jm1,jm2 |
355 |
do i=im1,im2 |
do i=im1,im2 |
356 |
qdiag(i,j,ivdtmoist,bi,bj) = qdiag(i,j,ivdtmoist,bi,bj) + |
qdiag(i,j,ivdtmoist,bi,bj) = qdiag(i,j,ivdtmoist,bi,bj) + |
357 |
. qbar(i,j)*pinv(i,j,bi,bj)*pinv(i,j,bi,bj)*86400 |
. qbar(i,j)*pinv(i,j)*pinv(i,j)*86400 |
358 |
enddo |
enddo |
359 |
enddo |
enddo |
360 |
endif |
endif |
378 |
do j=jm1,jm2 |
do j=jm1,jm2 |
379 |
do i=im1,im2 |
do i=im1,im2 |
380 |
qdiag(i,j,ivdtturb,bi,bj) = qdiag(i,j,ivdtturb,bi,bj) + |
qdiag(i,j,ivdtturb,bi,bj) = qdiag(i,j,ivdtturb,bi,bj) + |
381 |
. qbar(i,j)*pinv(i,j,bi,bj)*pinv(i,j,bi,bj)*86400 |
. qbar(i,j)*pinv(i,j)*pinv(i,j)*86400 |
382 |
enddo |
enddo |
383 |
enddo |
enddo |
384 |
endif |
endif |
403 |
do j=jm1,jm2 |
do j=jm1,jm2 |
404 |
do i=im1,im2 |
do i=im1,im2 |
405 |
qdiag(i,j,ivdtradlw,bi,bj) = qdiag(i,j,ivdtradlw,bi,bj) + |
qdiag(i,j,ivdtradlw,bi,bj) = qdiag(i,j,ivdtradlw,bi,bj) + |
406 |
. qbar(i,j)*pinv(i,j,bi,bj)*pinv(i,j,bi,bj)*86400 |
. qbar(i,j)*pinv(i,j)*pinv(i,j)*86400 |
407 |
enddo |
enddo |
408 |
enddo |
enddo |
409 |
endif |
endif |
427 |
do j=jm1,jm2 |
do j=jm1,jm2 |
428 |
do i=im1,im2 |
do i=im1,im2 |
429 |
qdiag(i,j,ivdtradsw,bi,bj) = qdiag(i,j,ivdtradsw,bi,bj) + |
qdiag(i,j,ivdtradsw,bi,bj) = qdiag(i,j,ivdtradsw,bi,bj) + |
430 |
. qbar(i,j)*radswt(i,j,bi,bj)*pinv(i,j,bi,bj)*pinv(i,j,bi,bj)*86400 |
. qbar(i,j)*radswt(i,j,bi,bj)*pinv(i,j)*pinv(i,j)*86400 |
431 |
enddo |
enddo |
432 |
enddo |
enddo |
433 |
endif |
endif |
434 |
|
|
435 |
|
if( (bi.eq.1) .and. (bj.eq.1) ) then |
436 |
nvdtmoist = nvdtmoist + 1 |
nvdtmoist = nvdtmoist + 1 |
437 |
nvdtturb = nvdtturb + 1 |
nvdtturb = nvdtturb + 1 |
438 |
nvdtradlw = nvdtradlw + 1 |
nvdtradlw = nvdtradlw + 1 |
439 |
nvdtradsw = nvdtradsw + 1 |
nvdtradsw = nvdtradsw + 1 |
440 |
|
endif |
441 |
|
|
442 |
|
#endif |
443 |
return |
return |
444 |
end |
end |