!-------------------------------------- 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 X
C
subroutine hcorla_simul0 1,5
*
***s/r hcorla_simul0 - Characterization of the horizontal forecast error correlation
* using Gaussian functions.
* The output is rstddev array = sqrt(spectral density)
*
*Author : Luc Fillon - ARMA-EC - 27 Aug 2008.
*Revision:
* Luc Fillon - ARMA-EC - 20 May 2010 - Simplify for P0 and TG.
* -------------------
*
*Arguments
*
*
implicit none
*implicits
#include "taglam4d.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comgdpar.cdk"
#include "comcst.cdk"
#include "comct0.cdk"
#include "comcva.cdk"
#include "comcorr.cdk"
#include "comsp.cdk"
#include "comgd1.cdk"
#include "comfftla.cdk"
#include "comgrd_param.cdk"
#include "comgrd.cdk"
#include "rpnstd.cdk"
#include "comsim.cdk"
#include "comin.cdk"
*
character*2 clcorspace
character*3 clvar
logical llprint
integer jfi,jfj,jk,ik2,inf2,ji,jj,jla,ila,ilev,iip3
integer in,ix,jband,ik,imin,imax,imid,jm
real*8 zsum,zsumb,zd,zbeta,zlength
real*8 zk,zx,zremainder,zmid,zdx
real*8 zcon,zfacpp,znorm,zfac,ztol
real*8 ztrunc2,zkx,zky,zcorr,zhscal,zlpsi
real*8 zcscl(nksdim)
real*8 zfld(ni,nj)
real*8 z2d(ni,nj)
real*8 zgdxy(ni,nj)
real*8 z3d(ni,nksdim,nj)
real*8 zsp(nla,2,nksdim)
real*8 zrstddev(nksdim,0:ntrunc)
*
**
write(nulout,*) 'hcorla_simul0: ACTIVE'
ztol = 1.e-12
clcorspace = 'GD'
llprint = .true.
!
!
do jk = 1, nflev
zcscl(jk) = 500.e3
enddo
do jk = nflev+1,2*nflev
zcscl(jk) = 500.e3 ! CHI_u
enddo
do jk = 2*nflev+1,3*nflev
zcscl(jk) = 150.e3 ! T_u
enddo
do jk = 3*nflev+1,4*nflev
zcscl(jk) = 100.e3 ! q
enddo
do jk = 4*nflev+1,nksdim
zcscl(jk) = 100.e3
enddo
!
! Homogeneous and isotropic error correlation in Grid-point space
! ---------------------------------------------------------------
!
do jk = 1, nksdim
call cormdl(z2d,zcscl(jk),'G',1,1,1,1)
do jj = 1, nj
do ji = 1, ni
z3d(ji,jk,jj) = z2d(ji,jj)
enddo
enddo
enddo
!
do jk = 1, nksdim
call cormdl(z2d,zcscl(jk),'G',1,ni,1,1)
do jj = 1, nj
do ji = 1, ni
z3d(ji,jk,jj) = z2d(ji,jj) + z3d(ji,jk,jj)
enddo
enddo
enddo
!
do jk = 1, nksdim
call cormdl(z2d,zcscl(jk),'G',1,1,nj,1)
do jj = 1, nj
do ji = 1, ni
z3d(ji,jk,jj) = z2d(ji,jj) + z3d(ji,jk,jj)
enddo
enddo
enddo
!
do jk = 1, nksdim
call cormdl(z2d,zcscl(jk),'G',1,ni,nj,1)
do jj = 1, nj
do ji = 1, ni
z3d(ji,jk,jj) = z2d(ji,jj) + z3d(ji,jk,jj)
enddo
enddo
enddo
!
do jk = 1, nksdim
do jj = 1, nj
do ji = 1, ni
zgdxy(ji,jj) = z3d(ji,jk,jj)
enddo
enddo
call dft2dr(zsp(1,1,jk),zgdxy)
enddo
!
zrstddev(:,:) = 0.0
!
do jk = 1, nksdim ! psi,chiu,Tu etc...
do jband = 1, nband
do jm = 1, mbandsp(jband)
ila=mila(jm,jband)
zrstddev(jk,jband-1)=zrstddev(jk,jband-1)+zsp(ila,1,jk) ! sp(ila,2) never used (cf. transp.ftn)
if(zrstddev(jk,jband-1).lt.ztol) zrstddev(jk,jband-1)=ztol
enddo
enddo
enddo
!
do jband = 1, nband
do jk = 1, nksdim
zrstddev(jk,jband-1)=zrstddev(jk,jband-1)/mbandsp(jband)
enddo
enddo
!
! Ensure normalization to one of correlation function from spectral densities (currently in zrstddev)
!
do jk = 1, nksdim
zsum = 0.
do jband = 1, nband
zsum = zsum + (zrstddev(jk,jband-1))*wvnbtot(jband)
enddo
zcon = 1./zsum
do jband = 1, nband
zrstddev(jk,jband-1) = zcon*zrstddev(jk,jband-1)
enddo
enddo
!
! Build rstddev as sqrt(spectral density)
!
do jk = 1, nksdim
do jband = 1, nband
rstddev(jk,jband-1) = sqrt(zrstddev(jk,jband-1))
enddo
enddo
!
! Estimate the Microscale correlation length
!
do jk = 1, nksdim
zsum = 0.
zsumb = 0.
do jband = 1, nband
zsum = zsum + (rstddev(jk,jband-1)**2)*wvnbtot(jband)
zsumb = zsumb + (rstddev(jk,jband-1)**2)*(wvnbtot(jband)**3)
enddo
!
zdx=dxlam(ni/2,nj/2)
zd=rns*zdx
zbeta=(zd/(2.*rpi))**2
zlength=sqrt(2.*zsum*zbeta/zsumb)
!
if(llprint) then
write(nulout,*) ' '
write(nulout,*) '*********************************************'
write(nulout,*) 'hcorla_simul0: From Spectral form of rstddev:
& jk, zlength (km) = ',jk,zlength/1.e3
write(nulout,*) '*********************************************'
write(nulout,*) ' '
endif
enddo
!
return
end