!-------------------------------------- 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 readcornsla 2,17
*
#if defined (DOC)
*
*Author : Luc Fillion - 8 Oct 2005.
*Revision:
* Luc Fillion - 26 Aug 2008 - Allow forcing of Gaussian spectral densities.
* Luc Fillion - 5 Sept 2008 - Allow compactification of stats-file horizontal correlations.
* Luc Fillion - 11 Sept 2008 - Read vector mbandsp from stats file first to make sure the
* spectral trunctation on file is the same as the one being actually used by 3dvar.
* An extension of the code to use a different (lower) spectral resolution
* can be done in the future.
* Luc Fillion - 14 Jan 2009 - Upgrade lam4d to v10_1_2 of 3dvar: Extra dimension for CORNS.
*
* -------------------
** Purpose:
*Arguments
#endif
IMPLICIT NONE
*implicits
*
* Global variables
*
#include "taglam4d.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcva.cdk"
#include "comlun.cdk"
#include "comcorr.cdk"
#include "comstate.cdk"
#include "compstat.cdk"
#include "comfftla.cdk"
#include "comgdpar.cdk"
#include "comcse1.cdk"
!
logical llout,llprint
integer istdkey,icornskey,iuleigen,jk
integer ilen,jcol,jrow,jlevo,jlevi
real*8 zmbandsp(nbandmax)
real*8 zwork,zsum
real*8 zstdsrc(nksdim2)
real*8 zcornssrc(nksdim2,nksdim2,1)
real*8 zspdev(nband)
!
integer jband,index,ilev
!
#include "rpnstd.cdk"
!
!!
write(nulout,*) 'readcornsla: lgauscor=',lgauscor
llprint = .false.
llout = .false.
!
!0. Read the vector of spectral bands contained on statistics file
! Ensure nband and spectral trunctation in stats are the same
! (until further extension to allow this case)
! --------------------------------------------------------------
!
idateo = -1
cletiket = 'MBANDSP '
ip1 = -1
ip2 = -1
ip3 = -1
cltypvar = ' '
clnomvar = ' '
istdkey = vfstlir(zmbandsp,nulbgst,INI,INJ,INK,idateo,cletiket,
& ip1,ip2,ip3,cltypvar,clnomvar)
!
if(nband.ne.INI) then
write(nulout,*) 'readcornsla: Warning!!!!! truncation here and on stats file different'
! call abort3d(nulout
! & ,'readcornsla: Problem with specification of 3DVAR value NTRUNCINC')
endif
!
!1. Read the RSTDDEV spectral coefficients
! --------------------------------------
!
! RSTDDEV
do jband = 1, nband
idateo = -1
cletiket = 'RSTDDEV'
ip1 = -1
ip2 = jband-1
ip3 = -1
! cltypvar = 'X' ! old
! clnomvar = 'SS' ! old
! cltypvar = 'S' ! new
! clnomvar = 'ZZ' ! new
istdkey = vfstlir(zstdsrc,nulbgst,INI,INJ,INK,idateo,cletiket,
& ip1,ip2,ip3,cltypvar,clnomvar)
!
if(istdkey .lt.0 ) then
call abort3d(nulout
& ,'readcornsla: Problem reading RSTDDEV ')
endif
if (ini .ne. nksdim2) then
write(nulout,*) 'readcornsla: ini, nksdim2 =',ini,nksdim2
call abort3d(nulout
& ,'readcornsla: BG stat levels inconsitencies')
endif
!
do jk = 1, nksdim2
rstddev(jk,jband-1) = zstdsrc(jk)
enddo
enddo
!
! do jband = 1, nband
! do jk = 1, nksdim2
! write(nulout,*) 'readcornsla: jband,jk,rstddev(jk,jband-1)=',
! & jband,jk,rstddev(jk,jband-1)
! enddo
! enddo
call corrlengthla(999,.false.,.false.)
!
! CORNS
idateo = -1
if(mbal_order.eq.0) then
cletiket = 'CORNSLOC'
else
cletiket = 'CORRNS'
endif
ip1 = -1
ip3 = -1
! cltypvar = 'X' ! old
! cltypvar = 'S' ! new
! clnomvar = 'ZZ'
!
do jband = 1, nband
IP2 = jband-1
icornskey = vfstlir(ZCORNSSRC,nulbgst,INI,INJ,INK
& ,idateo,cletiket,ip1,ip2,ip3,cltypvar,clnomvar)
!
if(icornskey .lt.0 ) then
call abort3d(nulout
& ,'readcornsla: CORRNS etiket probably not set properly here...')
endif
!
if (ini .ne. nksdim2 .or. inj .ne. nksdim2) then
call abort3d(nulout
& ,'readcornsla: BG stat levels inconsitencies')
endif
!
do jcol = 1,nksdim2
do jrow = 1, nksdim2
corns(jrow,jcol,jband-1,1) = zcornssrc(jrow,jcol,1)
if(jcol.eq.jrow) then
if(corns(jrow,jcol,jband-1,1).ne.1.0) then
call abort3d(nulout
& ,'readcornsla: Directly from file: Diagonal CORNS .ne. 1.0')
endif
endif
enddo
enddo
!
! if(llprint) then
! write(nulout,*) 'readcornsla: jband,rstddev for P0 =',
! & jband,rstddev(nksdim2-nfstvar2d+1,jband-1) ! P0
! endif
!
enddo ! jband loop
!
if(llprint) then
!
! Print-out PSI-PSI correlations for wvnb = 1
!
write(nulout,*) '*******************************************'
write(nulout,*) 'Print-out PSI-PSI correlations for wvnb = 1'
write(nulout,*) '*******************************************'
!
do jcol = 1,10
do jrow = 1, nflev
write(nulout,*) 'readcornsla: jrow,jcol,corns(jrow,jcol,1,1) = ',
& jrow,jcol,corns(jrow,jcol,1,1)
enddo
enddo
endif
!
! Ensure normalization to one of correlation function from spectral densities (currently in zrstddev)
! ----------------------------------------------------------------------------------------------------
!
do jk = 1, nksdim2
zsum = 0.
do jband = 1, nband
zsum = zsum + (rstddev(jk,jband-1)**2)*wvnbtot(jband) ! N.B.: rstddev contains sqrt of spectral densities here
enddo
if(abs(zsum-1.0).gt.1.e-2) then
write(nulout,*) 'readcornsla: Problem detected at jk, zsum =',jk,zsum
call abort3d(nulout,'readcornsla: Spectral density norm too far from Unity')
endif
enddo
!
if(lgauscor) then
call corrlengthla(999,.false.,.true.) ! first estimate the correlation lenghts from original spectral densities
call hcorla ! replace rstddev with Gaussian spectral densities
endif
!
if(lcorloc) then
call corlocla ! horizontal localization
endif
!
if(lgausvercor) call suvercor
!
do jband = 1, nband
do jcol = 1,nksdim2
do jrow = 1,nksdim2
corns(jrow,jcol,jband-1,1) = rstddev(jrow,jband-1)
& * corns(jrow,jcol,jband-1,1)*rstddev(jcol,jband-1)
enddo
enddo
enddo
!
if(lsetcross.and.nanalvar.ne.4) then
do jband = 1, nband
call setcrosscorr(jband-1,1) ! Set to zero all cross-variable correlations but T'ln(ps')
enddo
endif
!
if(llout) then
!
! Output spectral densities for barotropic tests
!
! PP
index = 0
ilev = nflev/2
do jband = 1,nband
zspdev(jband) = rstddev(index+ilev,jband-1)
write(nulout,*) 'readcronsla: jband, rstddev(index+ilev,jband-1)=',
& jband, rstddev(index+ilev,jband-1)
enddo
call outhoriz2d(zspdev,'rstddevpp.od','PP',1,
& 1,nband,1,1,nband,1,1)
! LQ
index = 3*nflev
ilev = nflev/2
do jband = 1,nband
zspdev(jband) = rstddev(index+ilev,jband-1)
write(nulout,*) 'readcronsla: jband, rstddev(index+ilev,jband-1)=',
& jband, rstddev(index+ilev,jband-1)
enddo
call outhoriz2d(zspdev,'rstddevlq.od','LQ',1,
& 1,nband,1,1,nband,1,1)
endif
!
write(nulout,*) 'Done in readcornsla'
!
return
end