!-------------------------------------- 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 --------------------------------------
!
subroutine hcorglb_simul0 1,2
#if defined (DOC)
*
***s/r hcorglb_simul0: Characterization of the horizontal forecast error correlation
* using Gaussian functions.
* The output is rstddev array = sqrt(spectral density)
*
*
*Author: Luc Fillion *ARMA/EC - 29 Aug 2008.
*
*Revision:
*
*
*Revision:
*
* Purpose:
*
*
#endif
IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comgdpar.cdk"
#include "comct0.cdk"
#include "comleg.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comcva.cdk"
#include "comgd0.cdk"
#include "comsp.cdk"
#include "comspg.cdk"
#include "comgem.cdk"
#include "comstate.cdk"
#include "comcorr.cdk"
C
LOGICAL LLPB, LLSOAR, LLPRINT
INTEGER JVAR, JGL, JLON, jk, JLA, JM, JN, JM0
INTEGER INVAR, IFLEV, INI, ILEN, IERR
REAL*8 ZR, ZPOLE, ZCONST
REAL*8 ZPORVO, ZPORDI, ZPORTT, ZPORQ, ZPORPS, ZABS
REAL*8 DL1SRA4, DLCORR, DLENSC2, DLCSURN,DLALPHA, DLN, DLFAC
real*8 ztol
real*8 z3d(nibeg:niend,nksdim,njbeg:njend)
real*8 zsp(nla,2,nksdim)
real*8 zcscl(nksdim)
*
**
ztol = 1.e-12
DL1SRA4 =1.D0/DBLE(RA)
DL1SRA4 = DL1SRA4**4
ZCONST = 1.E10
LLSOAR = .FALSE.
LLPRINT = .FALSE.
DLALPHA = 0.2D0
DLN = 3.D0
C
z3d(:,:,:) = 0.0
zsp(:,:,:) = 0.0
!
do jk = 1, nflev
zcscl(jk) = 500.e3 ! PSI
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
if(nfstvar2d.gt.1) then
zcscl(nksdim-1) = 200.e3 ! Ps_u
zcscl(nksdim) = 100.e3 ! Ps_u
else if(nfstvar2d.eq.1) then
zcscl(nksdim) = 200.e3 ! Ps_u
endif
C
WRITE(NULOUT,*)" Gaussian correlations are considered"
!
do jk = 1, nksdim
DLENSC2 = 1.D0/DBLE(zcscl(jk))
DLENSC2 = 0.5*DLENSC2*DLENSC2
DO JGL = 1, NJ
ZR = RA * ACOS(RMU(JGL))
INI = NILON(JGL)
DLCORR = DEXP(-(ZR**2)*DLENSC2)
if(abs(DLCORR).lt.ztol) DLCORR=ztol
DO JLON = 1, INI
z3d(JLON,jk,JGL) = DLCORR
END DO
END DO
END DO
C
C* TRANSFORM TO SPECTRAL SPACE
C ---------------------------
C
call reespe(nksdim,zsp,z3d,nla,nibeg,niend,njbeg,njend,nksdim)
C
C* CHECK POSITIVENESS
C ------------------
C
do 141 jk = 1, nksdim
LLPB = .FALSE.
DO 142 JLA = 1, NTRUNC+1
ZABS = ABS(zsp(JLA,1,jk))
LLPB = LLPB.OR.((zsp(JLA,1,jk).LT.0.)
S .AND.(ZABS/zsp(1,1,jk).GT.ztol))
! IF(LLPB) THEN
! write(nulout,*) 'hcorglb_simul0: jla,jk=',jla,jk
! write(nulout,*) 'hcorglb_simul0: zsp(jla,1,jk) = ',zsp(jla,1,jk)
! write(nulout,*) 'hcorglb_simul0: zsp(jla,2,jk) = ',zsp(jla,2,jk)
! CALL ABORT3D(NULOUT,' Negative correlations: hcorglb_simul0 ')
! ENDIF
142 CONTINUE
DO 144 JLA = 1, NTRUNC+1
zsp(JLA,1,jk) = ABS(zsp(JLA,1,jk))
144 CONTINUE
141 CONTINUE
c
c Transform to correlation coefficents (cf. eqn. 11, Boer 1983, JAS, but using 3dvar scalar product)
c
do jk = 1, nksdim
do jla = 1, ntrunc+1
jn = jla-1
zsp(jla,1,jk)=zsp(jla,1,jk)*sqrt(1./(2.0*jn+1.0))
enddo
enddo
C
C* Renormalize Spectral densities (now in zsp) to ensure 1 at the pole
C -------------------------------------------------------------------
C
DO jk = 1, nksdim
ZPOLE = 0.
DO JLA = 1, NTRUNC+1
JN = JLA-1
ZPOLE = ZPOLE + zsp(JLA,1,jk)
END DO
! WRITE(NULOUT,FMT=9162)ZPOLE,JVAR,jk
IF(ZPOLE.LE.0.) THEN
WRITE(UNIT=NULOUT
S ,FMT='("POLE VALUE NEGATIVE IN hcorglb_simul0")')
CALL ABORT3D(NULOUT,'hcorglb_simul0 ')
ENDIF
DO JLA = 1, NTRUNC+1
zsp(JLA,1,jk) = zsp(JLA,1,jk)/ZPOLE
zsp(JLA,2,jk) = 0.0
END DO
END DO
9162 FORMAT(4X,"Central value of correlation function:",4X,G12.6
S ,2X,"JVAR = ",I2,2X,"jk = ",I2)
!
! call speree(nksdim,zsp,z3d,nla,nibeg,niend,njbeg,njend,nksdim)
! write(nulout,*) 'hcorglb_simul0: recovered central value of Gaussian = ',z3d(1,1,1)
!
! Build rstddev as sqrt(spectral density)
! ---------------------------------------
!
do jk = 1, nksdim
DO JN = 0, NTRUNC
rstddev(jk,jn) = sqrt(zsp(JN+1,1,jk))
END DO
END DO
C
RETURN
END