!-------------------------------------- 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 sutg_sdev(KULSSF) 1,2
#if defined (DOC)
*
***s/r sutg_sdev - Read the standard deviations for TG from a RPN standard file.
*
*
*Author : Luc Fillion - 12 Jul 2010 - From sutg.ftn.
! Remains to validate with rotated GFaussian grid.
*
*Revision:
*
* Arguments:
* KULSSF : logical unit to be used to access the SSF file
#endif
IMPLICIT NONE
*implicits
*
* Global variables
*
#include "comlun.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcva.cdk"
#include "comcorr.cdk"
#include "compstat.cdk"
#include "comstate.cdk"
#include "comsp.cdk"
#include "comgd0.cdk"
#include "comspg.cdk"
#include "rpnstd.cdk"
#include "comleg.cdk"
#include "comcst.cdk"
*
* Arguments
*
INTEGER KULSSF
*
* Local variables
*
LOGICAL LLPB
C
INTEGER IKEY, ILEN, JLAT, JLON, JLA, ezgprm, igdgid, ezqkdef
INTEGER JN, JM, JM0, ILA, inlev, itggid, inmxlev,ier, iset
integer ezdefset, vezsint
integer ip1style,ip1kind,jlatbin
C
REAL*8, allocatable, dimension(:,:) :: dltg
REAL*8 ZSPCORR(NTRUNC+1)
*
REAL*8 ZABS, ZPOLE, ZCONST, DLFAC, DLCORR
*
POINTER (PXSPCORR ,ZSPCORR)
integer vfstlir
integer koutmpg
external vfstlir
*---------------------------------------------------------------------
**
write(nulout,fmt='(8x,2A)')'sutg_sdev- initialisation of TG background sdev error',' variances'
clnomvar='TG'
idateo=-1
inmxlev=1
call getfldprm2
(IP1,IP2,IP3,INLEV,CLETIKET,CLTYPVAR,ITGGID,
& clnomvar, idateo, inmxlev, kulssf, nulout,ip1style,ip1kind,
& ntrials,koutmpg)
ier = ezgprm(itggid,CLGRTYP,INI,INJ,IG1,IG2,IG3,IG4)
allocate(dltg(ini,inj))
write(nulout,*)'reading TG variances'
ikey = vfstlir
(dltg,koutmpg,ini,inj,ink,idateo,cletiket,ip1,
& ip2, ip3, cltypvar, clnomvar)
if(clgrtyp == 'G' .and. ni == ini .and. nj == inj .and. ig1 == 0
& .and. ig2 ==0 .and. ig3 == 0 .and.ig4 == 0) then
do jlat = 1, nj
do jlon = 1,ni
tgstdbg(jlon,jlat) = dltg(jlon,nj-jlat+1)
enddo
enddo
elseif(clgrtyp == 'G' .and. ni == ini .and. nj == inj .and. ig1 ==
& 0 .and. ig2 ==1 .and. ig3 == 0 .and.ig4 == 0) then
do jlat = 1, nj
do jlon = 1,ni
tgstdbg(jlon,jlat) = dltg(jlon,jlat)
enddo
enddo
else
* Interpolate to a gaussian grid stored from North to South(IG2=1)
*
igdgid = ezqkdef(ni, nj, 'G', 0, 1, 0, 0 ,0)
iset = ezdefset(igdgid,itggid)
ier = vezsint(tgstdbg,dltg,ni,nj,1,ini,inj,1)
endif
* If specified in namelist Do not accept tg errors
* of more than value specified in namelist
if ( llimtg ) then
where ( tgstdbg > rlimsuptg) tgstdbg = rlimsuptg
endif
*
* Deallocate local arrays
*
deallocate(dltg)
!
WRITE(nulout,*)'DONE in sutg_sdev'
!
!
RETURN
END