SUBROUTINE CH_AVGCORNS(KNULOUT,KTYPE,KNSTATLEV) 1,1
c
IMPLICIT NONE
c
c* Declaration of arguments
c
INTEGER KTYPE,KNULOUT,KNSTATLEV
C
#if defined (DOC)
*----------------------------------------------------------------------
*
***s/r CH_AVGCORNS - 1) If requested, produce physical space vertical
* correlation matrices V from CORRNS (see end
* of ch_readcorns2.ftn).
* Otherwise, read in physical space vertical
* correlation matrices (AVGCORNS)
*
* Results used by module CH_GENOPER (only).
*
*Author : Y.J. Rochon *ARQX/MSC November 2004
*Revision:
* Y.J. Rochon, Dec 2012
* - Reduced to only producing the physical space correlation matrix
*
* -------------------
*
** Purpose: Store block matrices related to physical space vertical
* correlations for use with the generalized innovation
* operator to be applied to integral observations.
*
*Arguments
*
* KTYPE: Flag indicating choice in obtaining vertical correlation
* matrix.
* 0 - Use CORRNS
* 1 - Read in (no transformation required)
* KNULOUT: Output unit index
* KNSTATLEV: Number of level of the original statistics
*
*
*Comments:
*
* - May need to be revised as it duplicates some calc in 'sucorns2'
* - Variable transformations not done here.
*
*-----------------------------------------------------------------------
#endif
c
c* Global variables
c
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcorr.cdk"
#include "comgem.cdk"
#include "comgdpar.cdk"
#include "comchem.cdk"
#include "comstate.cdk"
#include "rpnstd.cdk"
c
#include "comvarstd.cdk"
#include "comcorvert.cdk"
c
c* Declaration of local variables
c
integer jn,jvar,jcol,jrow,jcol2,jrow2,icornskey,jj,ivar,igdyn
c
real*8 zsum,zcorns(nflev,nflev),zwork(nflev,nflev,ncmtmax+6)
c
if (nflev.ne.knstatlev) then
call abort3d(knulout,
& 'CH_AVGCORNS: Interpolation required')
end if
c
c* Set number of model variables
c
igdyn=5 ! see ng* in file sustate.ftn
ngbg=igdyn+ngcmt
c
c* Set/read correlation matrices
c
c Note: ktype.ne.0 is preferred option
c
if (ktype.eq.0) then
c
c Construct physical space matrices from spectral space matrices
c
do jvar=1,nfstvar
do jcol=1,nflev
jcol2=jcol+(jvar-1)*nflev
do jrow=1,nflev
jrow2=jrow+(jvar-1)*nflev
c
zsum=0.0
do jn=0,ntrunc
zsum=zsum+(2*jn+1)*corns(jrow2,jcol2,jn,1)
end do
zwork(jrow,jcol,jvar)=zsum
end do
end do
c
c Set separable correlations
c
do jcol=1,nflev
jcol2=jcol+(jvar-1)*nflev
do jrow=1,nflev
jrow2=jrow+(jvar-1)*nflev
c
zsum=0.0D0
do jn=0,ntrunc
zsum=zsum+(2*jn+1)
1 *rstddev(jrow2,jn)*rstddev(jcol2,jn)
end do
c
do jn=0,ntrunc
corns(jrow2,jcol2,jn,1)=rstddev(jrow2,jn)*
1 zwork(jrow,jcol,jvar)*rstddev(jcol2,jn)/zsum
end do
end do
end do
c
end do
c
c Produce vertical correlation matrices of background/physical
c variables from those of analysis variables
c
c Variable transformation not taken into account below!!!!
c
do jrow=1,nflev
corvertt(jrow,jrow,1:ngbg)=1.0D0
end do
do jvar=1,nfstvar
ivar=0
if (cfstvar(jvar).eq.'UU') then
ivar=nguu
else if (cfstvar(jvar).eq.'VV') then
ivar=ngvv
else if (cfstvar(jvar).eq.'GZ') then
ivar=nggz
else if (cfstvar(jvar).eq.'TT') then
ivar=ngtt
else if (cfstvar(jvar).eq.'HU') then
ivar=ngq
else
do jn=1,NGCMT
if (cfstvar(jvar).eq.CGCMT(jn)) then
ivar=ngtr(jn)
go to 200
end if
end do
end if
200 continue
if (ivar.gt.0) then
corvertt(1:nflev,1:nflev,ivar)=zwork(:,:,jvar)
end if
end do
c
else
c
c Read in physical space correlation matrices for model variables.
c Assume vertical interpolation not required.
c
idateo = -1
cletiket = 'AVGCORR'
ip1 = -1
ip2 = -1
ip3 = -1
cltypvar = 'X'
do jvar=1,ngbg
if (jvar.eq.nguu) then
clnomvar='UU'
else if (jvar.eq.ngvv) then
clnomvar='VV'
else if (jvar.eq.nggz) then
clnomvar='GZ'
else if (jvar.eq.ngtt) then
clnomvar='TT'
else if (jvar.eq.ngq) then
clnomvar='HU'
else if (jvar.gt.igdyn) then
clnomvar=cgcmt(jvar-igdyn)
end if
c
icornskey = vfstlir
(ZCORNS,nulbgst,INI,INJ,INK
& ,idateo,cletiket,ip1,ip2,ip3,cltypvar,clnomvar)
c
if (icornskey .lt.0 ) then
write(knulout,2000) clnomvar
zcorns(:,:)=0.0D0
do jcol=1,nflev
zcorns(jcol,jcol)=1.0D0
end do
endif
c
corvertt(1:nflev,1:nflev,jvar)=zcorns(:,:)
end do
c
end if
c
write(knulout,*) 'Done in AVGCORNS'
c
2000 FORMAT(//,'CH_AVGCORNS: Warning - Missing background stats for '
& ,A2,//)
c
return
end