SUBROUTINE SUNEWSTATS(KULOUT,KULSSF) 1,7
#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)
* . Y. Yang ARQI/MSC Feb 2005
* - Added calls to CH_READCORNS2 and CH_RDSPSTD
* . Y.J. Rochon ARQX/MSC May 2005
* - CH_RDSBALOPER for species background stats
* and balance operators
* . Y.J. Rochon ARQX Nov 2008
* - Moved call to rdspptot after call to rdspstd
* consideration changes in balance operators in rdspptot.
*
**
#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 "comct0.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
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
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)
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 2. Read CORNS and RSTDDEV from a file
c
IF(LCHEM) THEN
C
C TEMPORARY: Eventually only READCORNS2 should be necessary.
C Dynamics and species, call the modified version
C
do jlatbin=1,NLATBIN
write(nulout,*) 'SUNEWSTATS: READING CORNS FOR REGION #',jlatbin
CALL CH_READCORNS2(NDATESTAT,NENSEMBLE,zoper
& ,instatlev,iulbgsto,jlatbin)
end do
ELSE
C
C Dynamics only
C
do jlatbin=1,NLATBIN
write(nulout,*) 'SUNEWSTATS: READING CORNS FOR REGION #',jlatbin
CALL READCORNS2(NDATESTAT,NENSEMBLE,zoper
& ,instatlev,iulbgsto,jlatbin)
end do
ENDIF
C
C 3. Read in the standard deviations for all variables
C
IF(LCHEM) THEN
C
C TEMPORARY: Eventually only READSTD3D and RDSPSTD should be necessary.
C Dynamics and species
C
IF(LUSE3DSTD) THEN
c call ch_readstd3d ! NOT AVAILABLE
call abort3d(NULOUT,'SUNEWSTATS: No module CH_READSTD3D')
ELSE
call ch_rdspstd(zoper,instatlev,iulbgsto)
END IF
ELSE
C
C Dynamics only
C
IF(LUSE3DSTD) THEN
call readstd3d
ELSE
call rdspstd(zoper,instatlev,iulbgsto)
END IF
ENDIF
C
C Read in PtoT - operator need for balance
C
call rdspptot(zoper,instatlev,iulbgsto)
C
IF(LCHEM) THEN
C
C R&D balance operators related to constituents.
C Read species related decoupling matrices (i.e. balance operators)
C
CALL CH_RDSBALOPER(zoper,instatlev)
C
END IF
C
C 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
call hpdeallc(pxzoper,ierr,1)
call hpdeallc(pxzlevstattrg,ierr,1)
c
if(lbgsto) then
ierr = fclos(iulbgsto)
endif
c
RETURN
END