!-------------------------------------- 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 SUNEWSTATS(KULOUT,KULSSF) 1,9
#if defined (DOC)
*
***s/r SUNEWSTATS - Initialize the background error statistics
* . from a non-separable estimate
* . File is the Standard Statistics File (SSF) format
*
* Author: P. Gauthier, ARMA/AES November 1997
*Revision:
* C. Charette *ARMA/AES Nov 1998
* - Changed LDIVBAL to LBALDIV
* C. Charette *ARMA/AES Jan 199
* - Remove setting of the default value for LBALDIV
* Now done in module SU1CSE1
* . P. Koclas *CMC/AES sunewstats.fnomJune 1999:
* . - Y2K conversion
* . J. Halle *CMDA/AES Oct 99.
* - Added ground temperature (TG) to model state.
* C. Charette *ARMA/AES Jan 2000
* - Read stats from unit nulstat
* . S. Pellerin *ARMA/AES March 2000
* - Call to subroutine for vertical interpolation of
* background stat and reading of balance operators
* and standard deviation in spectral space:
* new call to rdstatlev, suvintoper and
* substitutions of readptot -> rdspptot
* readcorns -> readcorns2
* readstd -> rdspstd
* - Cleanup of logical unit
* . J. Halle *CMDA/AES April 2003
* - Added RFACTHUM variable in NAMPSTAT namelist.
* . N. Wagneur CMDA Sept 2006
* - Added LLIMTG and RLIMSUPTG in NAMPSTAT namelist
* to allow and control upper limit forecast error.
* . M. Buehner ARMA May 2008
* - added loop for calls to readcorns2 for multiple
* latitude bands of correlations (NANALVAR=4)
**
#endif
IMPLICIT NONE
*
* implicits
*
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcva.cdk"
#include "comlun.cdk"
#include "comcse1.cdk"
#include "comgdpar.cdk"
#include "compstat.cdk"
#include "comstate.cdk"
#include "comcorr.cdk"
*
* Arguments
*
INTEGER KULOUT, KULSSF
*
* Local variables
*
INTEGER IERR,JLAT,JLON,JLEV,IHR1,IHR2,IYMD,IHM,instatlev,jlatbin
integer iulbgsto,fnom,fstouv,fstfrm,fclos,j,in,ij,ii
real*8 zlevstatsrc(jpnflev),zoper(1),zlevstattrg
pointer (pxzoper,zoper),(pxzlevstattrg,zlevstattrg(nflev))
*------------------------------------------------------------------
WRITE(NULOUT,FMT=9100) LSTAT,NFLEV,NJ
9100 FORMAT(//,6X,'SUNEWSTAT: set-up of the background '
S ,'error statistics',//,12X,'Namelist LSTAT = ',L1,
S ' NFLEV= ',I4,' NJ= ',I4)
C
C 0. Default values
C
NPSICORRTYP=2
NCHICORRTYP=2
NGZCORRTYP=1
NQCORRTYP=1
NPSCORRTYP=1
NOZCORRTYP=0
NTRCORRTYP=0
NTOAR=3
RALPHATOAR=0.2
NTTCORRTYP=0
NTGCORRTYP=1
RCSCLTG=400000.
NAMPLIFACT=1
NU2=1
CETIKETFD='AMPBG012'
REIGMINTT=0.0
REIGMINPSI=0.0
REIGMINCHI=0.0
REIGMINLQ=0.0
LEIGFILT=.false.
LBGSTO=.false.
RFACTHUM=1.0
RLIMSUPTG=3.0
LLIMTG=.false.
C
CALL READNML('NAMPSTAT',IERR)
write(nulout,*) 'sunewstats: leigfilt=',leigfilt
C
C Set amplification factor of prediction error to one (default)
C
DO JLAT = 1,NJ
DO JLEV = 1,NKGDIM
DO JLON = 1,NI
DAMPLIBG(JLON,JLEV,JLAT) = 1.0D0
ENDDO
ENDDO
ENDDO
C
C Set the Nu**2 field to the constant value specified in the NAMELIST
C (currently RNU2 is in COMCVA but will be moved to COMPSTAT shortly)
C
DO JLEV = 1, NFLEV
DO JLAT = 1, NJ
RNU2BG(JLAT,JLEV) = RNU2
END DO
END DO
CALL NEWDATE(NSTAMPA,IYMD,IHM,-3)
IHR1 = IYMD/10
IHR2 = IHR1 - ((IHR1/100)*100)
WRITE(NULOUT,*)' SUNEWSTAT: NSTAMPA,IHR1,IHR2 '
S ,IYMD,IHR1,IHR2
C
C* 1. Read the NAMELIST NAMCSE1 to obtain the name of the SSF
C . file (temporary)
C
WRITE(NULOUT, 9110)
9110 FORMAT(///,5X,"SUNEWSTATS: reading and initializing the"
S ," Background error statistics from the SSF file")
C
NFLSTAT=5
NCSE1=0
LSTATCON = .FALSE.
LSTATREAD = .TRUE.
LBALDIV = .TRUE.
LNORMCOR=.false.
LNODIV=.FALSE.
CFLCORNS = ' '
CFLSTDEV ='RSTDDEV '
CFLPTOT = ' '
do j = 1, 200
CFLNAMES(j) = ' '
enddo
CFLNAMES( 1) = 'INCNORM1'
CFLNAMES( 2) = 'INCNORM2'
CFLNAMES( 3) = 'INCNORM3'
CFLNAMES( 4) = 'INCNORM4'
CFLNAMES( 5) = 'INCNORM5'
CFLNAMES( 6) = 'INCNORM6'
CFLNAMES( 7) = 'INCNORM7'
CFLNAMES( 8) = 'INCNORM8'
CFLNAMES( 9) = 'INCNORM9'
CFLNAMES(10) = 'INCNOR10'
c
CALL READNML('NAMCSE1',IERR)
c
c Reading set of levels
c
call hpalloc(pxzlevstattrg,nflev,ierr,8)
c
iulbgsto = 0
if(lbgsto) then
ierr = fnom(iulbgsto,'newstat','RND',0)
ierr = fstouv(iulbgsto,'RND')
endif
c
call rdstatlev(zlevstattrg,nflev,zlevstatsrc,instatlev,jpnflev
& ,iulbgsto)
c
call hpalloc(pxzoper,nflev*instatlev,ierr,8)
c
call suvintoper(zoper,zlevstattrg,nflev,zlevstatsrc,instatlev,1)
c
c Read in PtoT - operator need for balance
c
call rdspptot(zoper,instatlev,iulbgsto)
c
* 2. Read CORNS and RSTDDEV from a file
*
do jlatbin=1,NLATBIN
write(nulout,*) 'SUNEWSTATS: READING CORNS FOR REGION #',jlatbin
CALL READCORNS2(NDATESTAT,NENSEMBLE,zoper,instatlev,iulbgsto,jlatbin)
enddo
*
* 4. Read in the standard deviations for UU, GZ and ES and NU**2
*
c
IF(nsexist(nstg).eq.1) THEN
CALL SUTG(NULBGST)
ENDIF
c
IF(LUSE3DSTD) THEN
call readstd3d
ELSE
call rdspstd(zoper,instatlev,iulbgsto)
ENDIF
c
call hpdeallc(pxzoper,ierr,1)
call hpdeallc(pxzlevstattrg,ierr,1)
c
if(lbgsto) then
ierr = fstfrm(iulbgsto)
ierr = fclos (iulbgsto)
endif
c
RETURN
END