!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%%
*** S/P CALCDIAG
subroutine calcdiag (d,f,v,dsiz,fsiz,vsiz, 1,1
$ dt,trnch,kount,ni,nk)
*
#include "phy_macros_f.h"
#include "impnone.cdk"
*
integer dsiz,fsiz,vsiz,trnch,kount,ni,nk
real dt
real d(dsiz),f(fsiz), v(vsiz)
*
*
*Author
* B. Bilodeau Feb 2003
*
*Revisions
* 001 A. PLante (Sep 2003) - Test temperature at surface and not at nk-1 for
* freezing rain diag. Also include ipcptype in
* ice pellets logic (fip).
* 002 B. Bilodeau and L. Spacek (Dec 2003) - Set accumulators to zero
* 003 A. Plante (Dec 2003) - PCPN TYPE from volatile pcpn rate
* 004 A. Plante (Feb 2004) - Add shallow convection precipitation rate and accumulation.
* 005 A. Plante (Mar 2004) - Move bourge in this routine from vkuocon
* 006 A. Plante (Apr 2004) - Default PCPN TYPE from PCPN rates tsc tlc tscs tlcs tss tls.
*
*Object
* to calculate averages and accumulators
* of tendencies and diagnostics
*
*Arguments
*
* - Input/Output -
* D dynamic bus
* F permanent bus
*
* - Input -
* V volatile (output) bus
*
* - Input -
* DSIZ dimension of d
* FSIZ dimension of f
* VSIZ dimension of v
* TRNCH slice number
* KOUNT timestep number
* DT length of timestep
* N horizontal running length
* NK vertical dimension
*
*
*IMPLICITES
*
#include "indx_sfc.cdk"
#include "consphy.cdk"
#include "phybus.cdk"
#include "options.cdk"
*
*MODULES
*
**
EXTERNAL BOURGE1
INTEGER I
REAL MOYHRI
REAL TEMPO, SOL_STRA, SOL_CONV, LIQ_STRA, LIQ_CONV
*
*****************************************************************
* PRECIPITATION RATES AND ACCUMULATIONS *
* ------------------------------------- *
*****************************************************************
*
if (moyhr.gt.0) moyhri= 1./float(moyhr)
*
if (kount.gt.0) then
* DIAGNOSTICS ON PRECIPITATION TYPE.
if(ipcptype.eq.1)then
call bourge1(v(fneige),v(fip),d(tplus),d(sigm),ni,nk-1)
endif
*
*VDIR NODEP
do i=0,ni-1
*
* taux des precipitations de la convection profonde
v(ry+i) = f(tsc+i) + f(tlc+i)
*
* taux des precipitations de la convection restreinte
v(rz+i) = f(tscs+i) + f(tlcs+i)
*
* taux des precipitations implicites
v(rc+i) = v(ry+i) + v(rz+i)
**
* taux des precipitations stratiformes
v(rr+i) = f(tss+i) + f(tls+i)
*
* taux total
v(rt+i) = v(rc+i) + v(rr+i)
*
* asc : accumulation des precipitations solides de la convection profonde
f(asc+i) = f(asc+i) + f(tsc+i) * dt
*
* ascs : accumulation des precipitations solides de la convection restreinte
f(ascs+i) = f(ascs+i) + f(tscs+i) * dt
*
* ass : accumulation des precipitations solides stratiformes
f(ass+i) = f(ass+i) + f(tss+i) * dt
*
* alc : accumulation des precipitations liquides de la convection profonde
f(alc+i) = f(alc+i) + f(tlc+i) * dt
*
* alcs : accumulation des precipitations liquides de la convection restreinte
f(alcs+i) = f(alcs+i) + f(tlcs+i) * dt
*
* als : accumulation des precipitations liquides stratiformes
f(als+i) = f(als+i) + f(tls+i) * dt
*
* pc : accumulation des precipitations implicites
v(pc+i) = f(alc+i) + f(asc+i) + f(alcs+i) + f(ascs+i)
*
* py : accumulation des precipitations de la convection profonde
v(py+i) = f(alc+i) + f(asc+i)
**
* pz : accumulation des precipitations de la convection restreinte
v(pz+i) = f(alcs+i) + f(ascs+i)
*
* ae : accumulation des precipitations stratiformes
v(ae+i) = f(als+i) + f(ass+i)
*
* pr : accumulation des precipitations totales
v(pr+i) = v(pc+i) + v(ae+i)
*
* RN : ACCUMULATION DES PRECIPITATIONS de PLUIE
* AZR: ACCUMULATION DES PRECIPITATIONS VERGLACLACANTES
if (istcond.ne.5.and.ipcptype.eq.0) then
sol_stra=f(tss+i)
liq_stra=f(tls+i)
sol_conv=f(tsc+i)+f(tscs+i)
liq_conv=f(tlc+i)+f(tlcs+i)
else
tempo=f(tls+i)+f(tss+i)
sol_stra=max(0.,v(fneige+i)*tempo)
liq_stra=max(0.,tempo-sol_stra)
tempo=(f(tlc+i)+f(tlcs+i))+(f(tsc+i)+f(tscs+i))
sol_conv=max(0.,v(fneige+i)*tempo)
liq_conv=max(0.,tempo-sol_conv)
endif
tempo=liq_stra+liq_conv
if ( d(tplus+(nk-1)*ni+i) .lt. tcdk ) then
f(azr+i) = f(azr+i) +
$ (1.-v(fip+i))*tempo*dt
if(tempo.gt.0.)v(zrflag+i)=1.
else
f(rn+i) = f(rn+i) +
$ (1.-v(fip+i))*tempo*dt
endif
*
* AIP: ACCUMULATION DES PRECIPITATIONS RE-GELEES
*
f(aip+i) = f(aip+i) +
$ v(fip+i)*tempo*dt
*
* SN: ACCUMULATION DES PRECIPITATIONS de neige
*
f(sn+i) = f(sn+i) + (sol_stra+sol_conv)*dt
*
end do
*
endif
*
*
*
*****************************************************************
* AVERAGES *
* -------- *
*****************************************************************
*
* set accumulators to zero every moyhr hours
if (moyhr.gt.0) then
*
if (mod((kount-1),moyhr).eq.0) then
*
do i = 0, ni-1
f(fcmy +i) = 0.0
f(fvmy +i) = 0.0
end do
*
do i = 0, ni*(nk-1)-1
*
* minimum and maximum temperature
f(ttmin +i) = d(tplus +i)
f(ttmax +i) = d(tplus +i)
*
f(kshalm +i) = 0.0
f(ccnm +i) = 0.0
f(tim +i) = 0.0
f(t2m +i) = 0.0
f(ugwdm +i) = 0.0
f(vgwdm +i) = 0.0
f(udifvm +i) = 0.0
f(vdifvm +i) = 0.0
f(tdifvm +i) = 0.0
f(qdifvm +i) = 0.0
f(hushalm+i) = 0.0
f(tshalm +i) = 0.0
f(lwcm +i) = 0.0
f(iwcm +i) = 0.0
*
* see vkuocon6 for the calculation of the
* averages of the following arrays
f(zctem +i) = 0.0
f(zstem +i) = 0.0
f(zcqem +i) = 0.0
f(zsqem +i) = 0.0
f(zsqcem +i) = 0.0
end do
*
* kfc or kfckuo2 convection schemes
if (iconvec.eq.6.or.iconvec.eq.12) then
*
do i=0, ni-1
f(capekfcm +i) = 0.0
f(wumkfcm +i) = 0.0
f(zbaskfcm +i) = 0.0
f(ztopkfcm +i) = 0.0
f(kkfcm +i) = 0.0
end do
*
do i = 0, ni*(nk-1)-1
f(tfcpm +i) = 0.0
f(hufcpm +i) = 0.0
f(qckfcm +i) = 0.0
f(umfkfcm +i) = 0.0
f(dmfkfcm +i) = 0.0
end do
*
endif
*
endif
*
endif
*
if ((moyhr.gt.0).and.(kount.gt.0)) then
*
do i = 0, ni-1
*
f(fcmy +i) = f(fcmy +i) + v(fc + (indx_agrege-1)*ni+i)
f(fvmy +i) = f(fvmy +i) + v(fv + (indx_agrege-1)*ni+i)
f(kshalm +i)= f(kshalm +i)+ v(kshal +i)
*
if (mod((kount),moyhr).eq.0) then
f(fcmy +i) = f(fcmy +i) * moyhri
f(fvmy +i) = f(fvmy +i) * moyhri
f(kshalm +i) = f(kshalm +i) * moyhri
endif
*
end do
*
do i = 0, ni*(nk-1)-1
*
* minimum and maximum temperature
f(ttmin +i) = min( f(ttmin +i), d(tplus + i) )
f(ttmax +i) = max( f(ttmax +i), d(tplus + i) )
*
f(ccnm +i) = f(ccnm +i) + f(ccn +i)
f(tim +i) = f(tim +i) + f(ti +i)
f(t2m +i) = f(t2m +i) + f(t2 +i)
f(ugwdm +i) = f(ugwdm +i) + v( ugwd+i)
f(vgwdm +i) = f(vgwdm +i) + v( vgwd+i)
f(udifvm +i) = f(udifvm +i) + v(udifv+i)
f(vdifvm +i) = f(vdifvm +i) + v(vdifv+i)
f(tdifvm +i) = f(tdifvm +i) + v(tdifv+i)
f(qdifvm +i) = f(qdifvm +i) + v(qdifv+i)
f(hushalm+i) = f(hushalm+i) + v(hushal+i)
f(tshalm +i) = f(tshalm +i) + v(tshal+i)
f(lwcm +i) = f(lwcm +i) + f(lwc+i)
f(iwcm +i) = f(iwcm +i) + f(iwc+i)
*
if (mod((kount),moyhr).eq.0) then
f(ccnm +i) = f(ccnm +i) * moyhri
f(tim +i) = f(tim +i) * moyhri
f(t2m +i) = f(t2m +i) * moyhri
f(ugwdm +i) = f(ugwdm +i) * moyhri
f(vgwdm +i) = f(vgwdm +i) * moyhri
f(udifvm +i) = f(udifvm +i) * moyhri
f(vdifvm +i) = f(vdifvm +i) * moyhri
f(tdifvm +i) = f(tdifvm +i) * moyhri
f(qdifvm +i) = f(qdifvm +i) * moyhri
f(zctem +i) = f(zctem +i) * moyhri
f(zcqem +i) = f(zcqem +i) * moyhri
f(zcqcem +i) = f(zcqcem +i) * moyhri
f(zstem +i) = f(zstem +i) * moyhri
f(zsqem +i) = f(zsqem +i) * moyhri
f(zsqcem +i) = f(zsqcem +i) * moyhri
f(hushalm+i) = f(hushalm+i) * moyhri
f(tshalm +i) = f(tshalm +i) * moyhri
f(lwcm +i) = f(lwcm +i) * moyhri
f(iwcm +i) = f(iwcm +i) * moyhri
*
endif
end do
*
if (iconvec.eq.6.or.iconvec.eq.12) then
do i = 0, ni*(nk-1)-1
f(tfcpm +i) = f(tfcpm +i) + f(tfcp +i)
f(hufcpm +i) = f(hufcpm +i) + f(hufcp+i)
f(qckfcm +i) = f(qckfcm +i) + f(qckfc+i)
f(umfkfcm +i) = f(umfkfcm +i) + f(umfkfc+i)
f(dmfkfcm +i) = f(dmfkfcm +i) + f(dmfkfc+i)
*
if (mod((kount),moyhr).eq.0) then
f(tfcpm +i) = f(tfcpm +i) * moyhri
f(hufcpm +i) = f(hufcpm +i) * moyhri
f(qckfcm +i) = f(qckfcm +i) * moyhri
f(umfkfcm +i) = f(umfkfcm +i) * moyhri
f(dmfkfcm +i) = f(dmfkfcm +i) * moyhri
endif
end do
do i=0, ni-1
f(capekfcm +i) = f(capekfcm+i) + f(capekfc+i)
f(wumkfcm +i) = f(wumkfcm+i) + f(wumaxkfc+i)
f(zbaskfcm +i) = f(zbaskfcm+i) + f(zbasekfc+i)
f(ztopkfcm +i) = f(ztopkfcm+i) + f(ztopkfc+i)
f(kkfcm+i) = f(kkfcm+i) + v(kkfc+i)
*
if (mod((kount),moyhr).eq.0) then
f(capekfcm +i) = f(capekfcm +i) * moyhri
f(wumkfcm+i) = f(wumkfcm+i) * moyhri
f(zbaskfcm+i) = f(zbaskfcm+i) * moyhri
f(ztopkfcm+i) = f(ztopkfcm+i) * moyhri
f(kkfcm+i) = f(kkfcm+i) * moyhri
endif
*
end do
endif
*
endif
*
*
*****************************************************************
* ACCUMULATORS *
* ------------ *
*****************************************************************
*
if (kount.gt.0) then
*
*VDIR NODEP
do i = 0,ni-1
*
* Accumulation of precipitation (in m)
*
f(rainaf+i) = f(rainaf+i) + v(rainrate+i)*dt
f(snowaf+i) = f(snowaf+i) + v(snowrate+i)*dt
*
if (iradia.ge.1) then
f(eiaf +i) = f(eiaf +i) + f(ei +i) * dt
f(evaf +i) = f(evaf +i) + f(ev +i) * dt
f(fiaf +i) = f(fiaf +i) + f(fdsi+i) * dt
f(fsaf +i) = f(fsaf +i) + f(fdss+i) * dt
f(ivaf +i) = f(ivaf +i) + v(iv +i) * dt
f(ntaf +i) = f(ntaf +i) + f(nt +i) * dt
f(flusolaf+i) = f(flusolaf+i) +
1 v(flusolis+i) * dt
endif
*
if (ifluvert.ge.1) then
f(suaf +i) = f(suaf +i) + v(ustress+i) * dt
f(svaf +i) = f(svaf +i) + v(vstress+i) * dt
f(fqaf +i) = f(fqaf +i) + f(fq +i) * dt
f(siaf +i) = f(siaf +i) + v(fnsi+i) * dt
f(flaf +i) = f(flaf +i) + v(fl +i) * dt
f(fcaf +i) = f(fcaf +i) +
+ v(fc + (indx_agrege-1)*ni+i) * dt
f(fvaf +i) = f(fvaf +i) +
+ v(fv + (indx_agrege-1)*ni+i) * dt
endif
*
if (ischmsol.eq.3) then
*
* Accumulation of evaporation (in kg/m2)
*
f(legaf +i) = f(legaf +i) + v(leg +i) * dt / CHLC
f(leraf +i) = f(leraf +i) + v(ler +i) * dt / CHLC
f(letraf +i) = f(letraf +i) + v(letr +i) * dt / CHLC
f(levaf +i) = f(levaf +i) + v(lev +i) * dt / CHLC
f(lesaf +i) = f(lesaf +i) + v(les +i) * dt
1 / (CHLC+CHLF)
*
* Accumulation of drained water
* (soil base water flux, in kg/m2 or mm);
* factor 1000 is for density of water.
*
f(drainaf +i) = f(drainaf +i)
1 - 1000. * f(drain+i) * f(rootdp+i)
*
* Accumulation of surface runoff (in kg/m2 or mm)
*
f(overflaf+i) = f(overflaf+i) + v(overfl+i)
*
endif
*
end do
*
endif
*
*
return
end