!-------------------------------------- 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 cse1glb 1,34
#if defined (DOC)
*
***s/r cse1glb - Control of Statistical Estimation at level 1 for Regional option.
*
*Author : L. Fillion - ARMA/EC - 26 May 2009.
* Revisions:
* L. Fillion - ARMA/EC - Sept 2009 - Include option to test reconstruction accuracy of CORNS after vertical localization
* L. Fillion - ARMA/EC - May 2010 - Limit printout to root.
* L. Fillion - ARMA/EC - 5 Jul 2010 - Enforce lcornsmin to FALSE when starting from a precomputed stats file ...
* -------------------
** Purpose: to estimate the forecast error correlation from an
* . ensemble of normalized and unbiased residuals such
* . as differences between 12/24h forecast valid at the
* . same time
*Arguments
* -NONE-
#endif
USE procs_topo
IMPLICIT NONE
*implicits
#include "taglam4d.cdk"
#include "comct0.cdk"
#include "comlun.cdk"
#include "comdim.cdk"
#include "comcse1.cdk"
#include "comgrd_param.cdk"
#include "comgrd.cdk"
#include "comcva.cdk"
#include "comfftla.cdk"
#include "comcorr.cdk"
#include "comgdpar.cdk"
*
character*3 cdcase
logical ldnorm
character*8 cletik
logical llfplane,lltb_psi,llcoriol_one
integer ibal_order,jrow,jcol,jband,jk,jn
integer idum1,idum2,idum3,idum4
INTEGER IULSTAT, IULCORNS, IULSTDEV, iultemp, ierr
INTEGER FNOM, FSTOUV, FSTFRM, FCLOS,VFSTECR
!
real*8 zmin,zmax,dsummed
real*8 zmpp(ni,nflev,nj)
real*8 zmcu(ni,nflev,nj)
real*8 zmtu(ni,nflev,nj)
real*8 zmlq(ni,nflev,nj)
real*8 zmpsu(ni,nj)
real*8 zmtg(ni,nj)
real*8 zeig_vec(nksdim2,nksdim2,nband), zeig_val(nksdim2,nband)
real*8 zcorns(nksdim2,nksdim2,0:nband-1,1)
real*8 zmaxmin(nksdim2,nksdim2)
C
WRITE(NULOUT,FMT=9000)
9000 FORMAT(//,3(" *****************"),/,6X
S ," cse1glb- Computation of Forecast Error Statistics",/
S ,3(" *****************"))
!
!!
CALL READNML('NAMGDPAR',IERR)
!
!*1. Preliminary Initializations
!
!
iulstat = 54 ! file unit for forecast error sample
iulcorns = 55 ! file unit to write spectral correlations
iulstdev = 56 ! file unit to write all st-dev fields
!
call su1cse1glb(iulstat,iulcorns,iulstdev) ! also reads namelist namcse1
!
llfplane = .true. ! active only in lhelm mode
llcoriol_one = .false. ! active only in lhelm mode
lltb_psi = lhelm ! .true. regress Tb with PSI; Regress with VORT otherwise.
!
if(cstats_step.ne.'ALL ') then ! get background error statistics from file
mbal_order = 1 ! to force sustatsgl to read etiket 'CORRNS'
lcornsmin = .false. ! to ensure we dont read preconditioned CORNS...
write(nulout,*) 'cse1glb: lcornsmin enforced to FALSE !!!'
call sustatsgl ! N.B.: Input RSTDDEV from file are now properly normalized w.r.t actual NTRUNC used here...
mbal_order = 0 ! reset
endif
!
if(nanalvar.ne.3.and.(mbal_order.eq.0)) then
write(nulout,*) 'cse1glb: NANALVAR = ',nanalvar
CALL ABORT3D(NULOUT,'cse1glb: mbal_order = 0
& so NANALVAR must be set to 3 ...')
endif
!
IERR = FNOM(iulstdev,cflstdev,'RND',0)
IERR = FSTOUV(iulstdev,'RND')
IERR = FNOM (iulcorns,cflcorns,'RND',0)
IERR = FSTOUV(iulcorns,'RND')
!
! allocate space for accumulators
!
call stddall
!
! Prepare for stats computations
!
if(cstats_step.eq.'ALL ') then ! do all steps to produce background error statistics
!
!*1.1 Compute gridpoint st-dev of U,V,T,HU,GZ,P0 forecast errors
! ----------------------------------------------------------
!
! call stdevla1(iulstat,iulcorns,lhelm,llfplane,lltb_psi)
!
if(lmcstats) then ! prepare error fields from ensemble of forecasts already on LAM4D grid.
call ensfcst_mean(zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg,
& iulstat,iulcorns,lhelm,llfplane,lltb_psi)
endif
!
!*1.2 Balance aspects
! ---------------
!
! call ens_rossby_la
!
if(mbal_order.gt.0) then
if(cptot.eq.'SP') then
call sptotglb(iulstat,iulcorns,llfplane,lltb_psi,llcoriol_one,
& zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg) ! compute ptot matrix
call wrt_sptot(iulcorns)
else if(cptot.eq.'GD') then
! call ptotla_1(iulstat,iulcorns,lhelm,llfplane,lltb_psi,llcoriol_one) ! compute ptot matrix
! call writeptotla(iulcorns) ! uses a local file unit
endif
endif
!
!*1.3 Mean and Standard-deviation of error samples required for correlation computations
! ----------------------------------------------------------------------------------
!
if(.not.lmcstats) then ! prepare error fields from ensemble of forecasts already on LAM4D grid.
call stdev_cv_glb1(iulstat,iulcorns,lhelm,llfplane,lltb_psi,
& llcoriol_one)
else
call stdev_cv_glb2(iulstat,iulcorns,lhelm,llfplane,lltb_psi,
& llcoriol_one,zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg)
endif
!
!*1.4 Compute required background-error correlations to be used by the minimization
! -----------------------------------------------------------------------------
!
! call jm_spcorrla(iulstat,iulcorns,lhelm,llfplane,lltb_psi,llcoriol_one,
! & zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg)
!
if(nanalvar.eq.3) then
if(.not.lmcstats) then ! prepare error fields from ensemble of forecasts already on LAM4D grid.
call spcorrglb1(iulstat,iulcorns,lhelm,llfplane,lltb_psi,
& llcoriol_one)
else
! call spcorrglb2(iulstat,iulcorns,lhelm,llfplane,lltb_psi,
! & llcoriol_one,zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg)
endif
else if(nanalvar.eq.4) then
call spcorrla2(iulstat,iulcorns,lhelm,llfplane,lltb_psi,
& llcoriol_one,zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg)
endif
!
IF(myid == 0) THEN
!
!*1.5 Output RAW correlations on file
! -------------------------------
!
call movecorns(zcorns,corns)
call writecornsglb(zcorns,zeig_vec,zeig_val,iulcorns,cflcorns,
& ndatestat,nensemble,'ORI',.true.,.true.)
!
!*1.6 Output RSTTDEV*CORNS
! --------------------------------------------
!
call scalecorns(zcorns,'M')
call vloc_corns(zcorns)
call writecornsglb(zcorns,zeig_vec,zeig_val,iulcorns,cflcorns,
& ndatestat,nensemble,'LOC',.false.,.false.)
!
!*1.7 Output Preconditioner ready for minimization
! --------------------------------------------
!
if(nanalvar.eq.3) then
call movecorns(corns,zcorns)
call sucorns_3
call movecorns(zcorns,corns)
else
call sucornsla2(zcorns)
endif
call writecornsglb(zcorns,zeig_vec,zeig_val,iulcorns,cflcorns,
& ndatestat,nensemble,'MIN',.false.,.false.)
endif
!
!
!*2.1 Compute gridpoint st-dev of U,V,T,HU,GZ,P0 forecast errors
! ----------------------------------------------------------
!
else if(cstats_step.eq.'MEANGD ') then
call stdev1(iulstat,iulstdev,lhelm,llfplane,lltb_psi)
!
!*2.2 Balance aspects
! ---------------
!
else if(cstats_step.eq.'BALANCE') then
! call ens_rossby_la
if(cptot.eq.'SP') then
! call sptotla(iulstat,iulcorns,llfplane,lltb_psi,
! & zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg) ! compute ptot matrix
call wrt_sptot(iulcorns)
else if(cptot.eq.'GD') then
! call ptotla_1(iulstat,iulstdev,lhelm,llfplane,lltb_psi) ! compute ptot matrix
! call writeptotla(iulcorns) ! uses a local file unit
endif
!
!*2.3 Mean and Standard-deviation of error samples required for correlation computations
! ----------------------------------------------------------------------------------
!
else if(cstats_step.eq.'MEANCV ') then
if(mbal_order.gt.0) then
if(cptot.eq.'SP') then
! call rdsptotlgl ! read precomputed ptot matrix
else
! call rdptotgl ! read precomputed ptot matrix
endif
else
call stdev_cv_glb1(iulstat,iulcorns,lhelm,llfplane,lltb_psi,
& llcoriol_one)
endif
!
!*2.4 Compute required background-error correlations to be used by the minimization
! -----------------------------------------------------------------------------
!
else if(cstats_step.eq.'SPCORR ') then
if(mbal_order.gt.0.and.cptot.eq.'SP') then
! call rdsptotla ! read precomputed ptot matrix
else if(mbal_order.gt.0.and.cptot.eq.'GD') then
! call rdptotla ! read precomputed ptot matrix
endif
! call spcorrla(iulstat,iulcorns,lhelm,llfplane,lltb_psi,
! & zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg)
! call writecornsla(iulcorns,cflcorns,ndatestat,nensemble)
!
!*2.5 Test Vertical Mode Filtering of error samples
! ---------------------------------------------
!
else if(cstats_step.eq.'T_VFILT') then
call test_vfilt(iulstat,iulcorns,llfplane,lltb_psi,llcoriol_one,
& zmpp,zmcu,zmtu,zmlq,zmpsu,zmtg) ! compute ptot matrix
!
!*2.6 Apply Vertical localization to CORNS
! ------------------------------------
!
else if(cstats_step.eq.'LOCCORR') then
!
call movecorns(zcorns,corns)
!
! call tb_corr(iulcorns) ! from PSI correlations directly
!
! call fltcornsla ! ensuure diagonal bocks are positive-definite
!
if(lvloc) then
call vloc_corns(zcorns)
IF(myid == 0) THEN
call writecornsglb(zcorns,zeig_vec,zeig_val,iulcorns,cflcorns,
& ndatestat,nensemble,'LOC',.false.,.true.)
endif
endif
!
if(lsqrt_bgstat) then
if(nanalvar.eq.3) then
call movecorns(corns,zcorns)
call sucorns_3
call movecorns(zcorns,corns)
else
! call sucornsla2(zcorns)
endif
!
IF(myid == 0) THEN
call writecornsglb(zcorns,zeig_vec,zeig_val,iulcorns,cflcorns,
& ndatestat,nensemble,'MIN',.false.,.false.)
endif
endif
!
endif ! cstats_step options
!
! Close files
! -----------
!
IF(myid == 0) THEN
IERR = FSTFRM(iulcorns)
IERR = FSTFRM(iulstdev)
IERR = FCLOS (iulcorns)
IERR = FCLOS (iulstdev)
endif
!
return
end