!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
C
C X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X
C
subroutine suvercor 3,2
*
***s/r suvercor - Construct vertical background error correlations.
*
*Author : Luc Fillion *CGD/NCAR - 16 nov 1999
*
*Revision:
* Luc Fillion - ARMA/EC - 28 Aug 2008 - Include TG (nvg2d=2).
* Luc Fillion - ARMA/EC - 2 Sept 2008 - Modify to support 'GU' or 'LU' grd_typ.
* Luc Fillion - ARMA/EC - 14 Jan 2009 - Upgrade lam4d to v_10_1_2. Extra dimension for CORNS.
* -------------------
** Purpose: to be used by evaljb.
*
*Arguments
*
IMPLICIT NONE
*implicits
#include "taglam4d.cdk"
#include "comct0.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comcva.cdk"
#include "comgem.cdk"
#include "comfftla.cdk"
#include "comcorr.cdk"
#include "comgrd_param.cdk"
#include "comgrd.cdk"
C
character*1 clcorg
logical llprint
integer j1,j2,k1,k2,jband,ji,jj,jk,jrow,jcol,ik
integer icheck,jvar,inband
real*8 zdet,zeps,ztol
real*8 zrvpsi, zrvchi, zrvt, zrvq, zps, zpt
real*8 zplev(nflev)
real*8 zcorr(nflev,nflev)
*
**
llprint = .true.
clcorg = 'G'
!
if(llprint) then
write(nulout,fmt=9000)
9000 format(//,1x,"suvercor: Gaussian vertical background error"
S ," correlation matrix")
endif
c
c*1 Initialize to zero the vertical correlation matrix
c --------------------------------------------------
c
call zero(nksdim*nksdim*(ntrunc+1),corns)
c
c*2 Initialize the vertical covariance matrix
c -----------------------------------------
c
zrvpsi = 75.e2 ! PSI backg Vert. correlation length (Pa)
zrvchi = 55.e2 ! CHI backg Vert. correlation length (Pa)
zrvt = 50.e2 ! T back Vert. correlation length (Pa)
zrvq = 40.e2 ! q back Vert. correlation length (Pa)
icheck = 0
if(grd_typ.eq.'GU') then
inband = ntrunc+1
else if(grd_typ.eq.'LU') then
inband = nband
endif
!
if(clcorg.eq.'I') then
icheck = 1
do jband = 1, inband
do jk=1,nksdim
corns(jk,jk,jband-1,1) = 1.0
enddo
enddo
else if(clcorg.eq.'F') then
icheck = 1
CALL ABORT3D(NULOUT,'suvercor: Option not yet supported: PROGRAM STOPS')
else if(clcorg.eq.'G') then
icheck = 1
if(llprint) then
write(nulout,*) 'Gaussian Correlations'
write(nulout,*) 'suvercor: Vert Corr scale PSI = ',zrvpsi
write(nulout,*) 'suvercor: Vert Corr scale CHI = ',zrvchi
write(nulout,*) 'suvercor: Vert Corr scale T = ',zrvt
write(nulout,*) 'suvercor: Vert Corr scale q = ',zrvq
endif
!
zpt = 0.0
zps = 1.0e5
do j1=1,nflev
zplev(j1) = vlev(j1) * (zps - zpt) + zpt
enddo
c
c compute auto-correlations for PSI
c
do jband = 1, inband
do j1=1,nflev
do j2=1,nflev
corns(j1,j2,jband-1,1) = exp(-(zplev(j1)-zplev(j2))
$ **2/(2.*(zrvpsi)**2) )
enddo
enddo
enddo
c
c compute auto-correlations for CHI
c
if (nvgd.gt.1) then
do jband = 1, inband
do j1=1,nflev
do j2=1,nflev
corns(nflev+j1,nflev+j2,jband-1,1) = exp(-(zplev(j1)
$ -zplev(j2))**2/(2.*(zrvchi)**2) )
enddo
enddo
enddo
endif
c
c compute auto-correlations for temperature
c
if (nvgd.gt.2) then
do jband = 1, inband
do j1=1,nflev
do j2=1,nflev
corns(2*nflev+j1,2*nflev+j2,jband-1,1) = exp(-(zplev(j1)
$ -zplev(j2))**2/(2.*(zrvt)**2) )
zcorr(j1,j2)=corns(2*nflev+j1,2*nflev+j2,jband-1,1)
enddo
enddo
enddo
endif
! call outhoriz2d(zcorr,'ttvcorr.od ','TT',1,
! & 1,nflev,1,nflev,nflev,nflev,1)
c
c compute auto-correlations for specific humidity
c
if (nvgd.gt.3) then
do jband = 1, inband
do j1=1,nflev
do j2=1,nflev
corns(3*nflev+j1,3*nflev+j2,jband-1,1) = exp(-(zplev(j1)
$ -zplev(j2))**2/(2.*(zrvq)**2) )
enddo
enddo
enddo
endif
!
if (nvg2d.eq.1) then
do jband = 1, inband
corns(nksdim,nksdim,jband-1,1) = 1.0
enddo
else if (nvg2d.eq.2) then
do jband = 1, inband
corns(nksdim-1,nksdim-1,jband-1,1) = 1.0
corns(nksdim,nksdim,jband-1,1) = 1.0
enddo
endif
endif
!
return
end