!-------------------------------------- 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 getstats_cv(KULFST,pmpp,pmcu,pmtu,pmlq,pmtb,pmpsu,pmpsb,pmtg, 3,8
& pspp,pscu,pstu,pslq,pstb,pspsu,pspsb,pstg,kensemble,
& ldhelm)
#if defined (DOC)
*
*** s/r getstats_cv - Read precomputed mean & stdev values of control variables on file.
*
*
* Author : Luc Fillion - ARMA/EC - 23 Oct 2007.
*
* Revision:
* Luc Fillion - ARMA/EC - 12 Dec 2008 - Introduce mean and st-dev as arguments. Include TG.
* Luc Fillion - ARMA/EC - 30 Apr 2009 - ldhelm as argument to perform UU,VV stats also.
*
* Arguments
* i KULFST : unit to be assigned to this file
*
#endif
C
IMPLICIT NONE
* implicits
#include "taglam4d.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comlun.cdk"
#include "comgem.cdk"
#include "comstdd.cdk"
#include "comgdpar.cdk"
#include "rpnstd.cdk"
*
logical ldhelm
INTEGER KULFST
integer kensemble
real*8 pmpp(ni,nflev,nj)
real*8 pmcu(ni,nflev,nj)
real*8 pmtu(ni,nflev,nj)
real*8 pmlq(ni,nflev,nj)
real*8 pmtb(ni,nflev,nj)
real*8 pmpsu(ni,nj)
real*8 pmpsb(ni,nj)
real*8 pmtg(ni,nj)
!
real*8 pspp(ni,nflev,nj)
real*8 pscu(ni,nflev,nj)
real*8 pstu(ni,nflev,nj)
real*8 pslq(ni,nflev,nj)
real*8 pstb(ni,nflev,nj)
real*8 pspsu(ni,nj)
real*8 pspsb(ni,nj)
real*8 pstg(ni,nj)
!
INTEGER IERR, JLEV, JVAR, INI, INJ, INK,ji,jj,jk1, ip1
INTEGER FNOM, FSTOUV, VFSTLIR, FSTFRM, FCLOS
INTEGER ISTAMP,inbvar
character*2 clvar(5)
character*2 clvar2d(3)
CHARACTER*8 CLETIKET
CHARACTER*1 CLTYPV
!
real*8 zw2d(NI,NJ)
real*8 zfactuv
!
EXTERNAL ABORT3D, FNOM, FSTOUV, VFSTLIR, FSTFRM, FCLOS
!
!!
!
write(nulout,*) 'getstats_cv: '
write(nulout,*) 'getstats_cv: ************************************************'
write(nulout,*) 'getstats_cv: Read on file mean and stdev of control variables'
write(nulout,*) 'getstats_cv: ************************************************'
write(nulout,*) 'getstats_cv: '
!
istamp = -1
cltypv = ' '
!
write(nulout,*) 'getstats_cv: ldhelm = ',ldhelm
clvar(1) = 'PP'
clvar(2) = 'CC'
if(.not.ldhelm) then
clvar(1) = 'QQ'
clvar(2) = 'DD'
endif
clvar(3) = 'TT'
clvar(4) = 'LQ'
clvar(5) = 'TB'
clvar2d(1) = 'PU'
clvar2d(2) = 'TG'
clvar2d(3) = 'PB'
!
! 1st: Mean
!
cletiket = 'CVGDMEAN'
! write(nulout,*) 'getstats_cv: kulfst = ',kulfst
! write(nulout,*) 'getstats_cv: ni,nj = ',ni,nj
! write(nulout,*) 'getstats_cv: istamp=',istamp
! write(nulout,*) 'getstats_cv: cletiket=',cletiket
! write(nulout,*) 'getstats_cv: cltypv=',cltypv
!
! Read 3D-fields from file
! ------------------------
!
do jvar = 1, 5
do jlev = 1,nflev
!
ierr = vfstlir(zw2d(1,1),kulfst,ni,nj,1,istamp,cletiket,
& nip1(jlev),-1,-1,cltypv,clvar(jvar))
!
if(ierr.ge.0) then
if((clvar(jvar).eq.'QQ').or.(clvar(jvar).eq.'PP')) then
do jj=1,nj
do ji=1,ni
pmpp(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
else if((clvar(jvar).eq.'DD').or.(clvar(jvar).eq.'CC')) then
do jj=1,nj
do ji=1,ni
pmcu(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
else if(clvar(jvar).eq.'TT') then
do ji=1,ni
do jj=1,nj
pmtu(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
else if(clvar(jvar).eq.'LQ') then
do ji=1,ni
do jj=1,nj
pmlq(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
else if(clvar(jvar).eq.'TB') then
do ji=1,ni
do jj=1,nj
pmtb(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
endif
else
write(nulout,*)'- getstats_cv: cletiket = ',cletiket
write(nulout,*)'- getstats_cv: VARIABLE = ',clvar(jvar)
write(nulout,*)'- This field has not been found. IERR = ',ierr
CALL ABORT3D(NULOUT,'getstats_cv')
endif
!
enddo ! Levels
enddo ! Variables
!
! Read 2D-fields from file
! ------------------------
!
do jvar = 1, 3
ip1 = 0
ierr = vfstlir(zw2d(1,1),kulfst,ni,nj,1,istamp,cletiket,
& ip1,-1,-1,cltypv,clvar2d(jvar))
if(ierr.ge.0) then
if(clvar2d(jvar).eq.'PU') then
do ji=1,ni
do jj=1,nj
pmpsu(ji,jj) = zw2d(ji,jj)/0.01
enddo
enddo
else if(clvar2d(jvar).eq.'PB') then
do ji=1,ni
do jj=1,nj
pmpsb(ji,jj) = zw2d(ji,jj)/0.01
enddo
enddo
else if(clvar2d(jvar).eq.'TG') then
do ji=1,ni
do jj=1,nj
pmtg(ji,jj) = zw2d(ji,jj)
enddo
enddo
endif
else
write(nulout,*)'- getstats_cv: cletiket = ',cletiket
write(nulout,*)'- getstats_cv: VARIABLE = ',clvar2d(jvar)
write(nulout,*)'- This field has not been found. IERR = ',ierr
CALL ABORT3D(NULOUT,'getstats_cv')
endif
enddo
!
! 2nd: St-dev
!
cletiket = 'CVGDSDEV'
!
! Read 3D-fields from file
! ------------------------
!
do jvar = 1, 5
do jlev = 1,nflev
!
ierr = vfstlir(zw2d(1,1),kulfst,ni,nj,1,istamp,cletiket,
& nip1(jlev),-1,-1,cltypv,clvar(jvar))
!
if(ierr.ge.0) then
if((clvar(jvar).eq.'QQ').or.(clvar(jvar).eq.'PP')) then
do jj=1,nj
do ji=1,ni
pspp(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
else if((clvar(jvar).eq.'DD').or.(clvar(jvar).eq.'CC')) then
do jj=1,nj
do ji=1,ni
pscu(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
else if(clvar(jvar).eq.'TT') then
do ji=1,ni
do jj=1,nj
pstu(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
else if(clvar(jvar).eq.'LQ') then
do ji=1,ni
do jj=1,nj
pslq(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
else if(clvar(jvar).eq.'TB') then
do ji=1,ni
do jj=1,nj
pstb(ji,jlev,jj) = zw2d(ji,jj)
enddo
enddo
endif
else
write(nulout,*)'- getstats_cv: cletiket = ',cletiket
write(nulout,*)'- getstats_cv: VARIABLE = ',clvar(jvar)
write(nulout,*)'- This field has not been found. IERR = ',ierr
CALL ABORT3D(NULOUT,'getstats_cv')
endif
!
enddo ! Levels
enddo ! Variables
!
! Read 2D-fields from file
! ------------------------
!
do jvar = 1, 3
ip1 = 0
ierr = vfstlir(zw2d(1,1),kulfst,ni,nj,1,istamp,cletiket,
& ip1,-1,-1,cltypv,clvar2d(jvar))
if(ierr.ge.0) then
if(clvar2d(jvar).eq.'PU') then
do ji=1,ni
do jj=1,nj
pspsu(ji,jj) = zw2d(ji,jj)/0.01
enddo
enddo
else if(clvar2d(jvar).eq.'PB') then
do ji=1,ni
do jj=1,nj
pspsb(ji,jj) = zw2d(ji,jj)/0.01
enddo
enddo
else if(clvar2d(jvar).eq.'TG') then
do ji=1,ni
do jj=1,nj
pstg(ji,jj) = zw2d(ji,jj)
enddo
enddo
endif
else
write(nulout,*)'- getstats_cv: cletiket = ',cletiket
write(nulout,*)'- getstats_cv: VARIABLE = ',clvar2d(jvar)
write(nulout,*)'- This field has not been found. IERR = ',ierr
CALL ABORT3D(NULOUT,'getstats_cv')
endif
enddo
!
return
end