!-------------------------------------- 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 rdstatlev(ptrglev,kntrglev,psrclev,knsrclev,knflev 1,5
& ,kulbgsto)
#if defined (DOC)
*
**s/r rdstatlev -Read in pressure levels of background stat file for
* use of vertical interpolation of bg stat.
* .
*Author : S. Pellerin *ARMA/AES February, 2000
*Revision:
* JM Belanger CMDA/SMC Jul 2000
* . 32 bits conversion
* C. Charette - ARMA/SMC - Sept 2004
* - Conversion to hybrid vertical coordinate
*
* Arguments:
* Output:
* ptrglev(kntrglev) : Pressure values of analysis levels
* psrclev(knflev) : Pressure values of statistic levels
* knsrclev : Number of statistic levels
*
* Input :
* kntrglev : Number of analysis levels
* knflev : Max number of statistic levels
* kulbgsto : Logical unit for backgroud stat output
*
#endif
IMPLICIT NONE
*implicits
*
* Global variables
*
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comgem.cdk"
#include "rpnstd.cdk"
*
*
* Local variables
*
integer knsrclev,knflev,ikey,jlev,kntrglev,kulbgsto
real*8 psrclev(knflev),zwork,ptrglev(kntrglev)
**
integer vfstlir,vfstecr
external vfstlir,vfstecr
C ------------------------------------------------------
write(nulout,*) 'Reading in LP from unit:',nulbgst
*
* set up simple spectral transforms
*
ip1 = -1
ip2 = -1
ip3 = -1
idateo = -1
cletiket = 'ETALEVLS'
cltypvar = 'X'
clnomvar = 'LP'
C
c read LP
c
ikey = vfstlir
(psrclev,nulbgst,ini,inj,ink
& ,idateo,cletiket,ip1,ip2,ip3,cltypvar,clnomvar)
c
IF(IKEY .LT.0 ) THEN
CALL ABORT3D
(NULOUT
& ,'RDSTATLEV: Unable to find LP record in stat file')
ENDIF
*
knsrclev = ini
c
call calcpres
(ptrglev,vhybinc,nflev,psrclev(knsrclev),rptopinc
& ,rprefinc,rcoefinc,1)
c
if ( kulbgsto .gt. 0 ) then
ierr = fstprm(ikey,idateo,ideet,inpas,ini,inj,ink, inbits,
& idatyp,ip1,ip2,ip3,cltypvar,clnomvar,cletiket,clgrtyp,ig1
& ,ig2,ig3,ig4,iswa,ilength,idltf,iubc,iextr1,iextr2,iextr3
& )
c
ierr = vfstecr
(ptrglev, zwork, -inbits, kulbgsto, idateo, ideet
& ,inpas, kntrglev, 1, 1, ip1, ip2, ip3, cltypvar, clnomvar
& ,cletiket,clgrtyp,ig1, ig2, ig3, ig4, idatyp, .true.)
c
endif
*
write(nulout,*)'DONE in RDSTATLEV'
call vflush
(nulout)
c
return
end