!-------------------------------------- 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 prep_target_bgchk 1,21

#if defined (DOC)
*Author  : L. Fillion ARMA/EC - 21 apr 2009. Read global STDDEV fields and output on nulinclr
*                               the interpolated fields onto LAM inner grid, ready to be used by
*                               lam background-check.
*
*Revision:
* L. Fillion ARMA/EC - 2 Jul 2009 - Allo lam or global target.
*     N.B.: Target grid dimensions mni_in & mnj_in are set to ni, nj in sudim in 'GU' mode...
* L. Fillion ARMA/EC - 6 Aug 2010 - Improved naming of etiket 
#endif

      IMPLICIT NONE
#include "comlun.cdk"
#include "comcst.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comgem.cdk"
#include "comgrd_param.cdk"
#include "comgd0.cdk"
#include "compstat.cdk"
#include "comgdpar.cdk"
#include "cvcord.cdk"
#include "rpnstd.cdk"

      character*8 clletiket
      INTEGER JLAT, JLON ,J,ji,jj,jk,jlev
      INTEGER ibrpstamp

      real*8 z2d(ni,nj)
      real*8 z3d(ni,nflev,nj)
      real*8 zfldin(mni_in,mnj_in,nflev)
*
**
      write(nulout,*) 'prep_target_bgchk: active'
!
      ibrpstamp=nbrpstamp
      IPAK = -32
      IDATYP = 5
      cltypvar = 'E'
      if(grd_typ.eq.'GU') then
        clletiket='GDGUSDEV'
      else
        clletiket='GDLUSDEV'
      endif
!
! UU
      call readgd_gusdev(z3d,'UU ',ni,nj,nflev)
!
      do jlev=1,nflev
        do jj=1,mnj_in
          do ji=1,mni_in
            zfldin(ji,jj,jlev) = z3d(ji,jlev,jj)
          enddo
        enddo
      enddo
      if(grd_typ.eq.'GU') then
        call ecr_gu(zfldin,'UU ',niter,clletiket,nulinclr,mni_in,mnj_in,nflev)
      else
        call ecr_la(zfldin,'UU ',niter,clletiket,ipak,ibrpstamp,ideet,inpas,
     &              idatyp,cltypvar,.true.,nulinclr,mni_in,mnj_in,nflev)
      endif
!
! VV
      call readgd_gusdev(z3d,'VV ',ni,nj,nflev)
!
      do jlev=1,nflev
        do jj=1,mnj_in
          do ji=1,mni_in
            zfldin(ji,jj,jlev) = z3d(ji,jlev,jj)
          enddo
        enddo
      enddo
      if(grd_typ.eq.'GU') then
        call ecr_gu(zfldin,'VV ',niter,clletiket,nulinclr,mni_in,mnj_in,nflev)
      else
        call ecr_la(zfldin,'VV ',niter,clletiket,ipak,ibrpstamp,ideet,inpas,
     &              idatyp,cltypvar,.true.,nulinclr,mni_in,mnj_in,nflev)
      endif
!
! GZ
      call readgd_gusdev(z3d,'GZ ',ni,nj,nflev)
!
      do jlev=1,nflev
        do jj=1,mnj_in
          do ji=1,mni_in
            zfldin(ji,jj,jlev) = z3d(ji,jlev,jj)
          enddo
        enddo
      enddo
      if(grd_typ.eq.'GU') then
        call ecr_gu(zfldin,'GZ ',niter,clletiket,nulinclr,mni_in,mnj_in,nflev)
      else
        call ecr_la(zfldin,'GZ ',niter,clletiket,ipak,ibrpstamp,ideet,inpas,
     &              idatyp,cltypvar,.true.,nulinclr,mni_in,mnj_in,nflev)
      endif
!
! TT
      call readgd_gusdev(z3d,'TT ',ni,nj,nflev)
!
      do jlev=1,nflev
        do jj=1,mnj_in
          do ji=1,mni_in
            zfldin(ji,jj,jlev) = z3d(ji,jlev,jj)
          enddo
        enddo
      enddo
      if(grd_typ.eq.'GU') then
        call ecr_gu(zfldin,'TT ',niter,clletiket,nulinclr,mni_in,mnj_in,nflev)
      else
        call ecr_la(zfldin,'TT ',niter,clletiket,ipak,ibrpstamp,ideet,inpas,
     &              idatyp,cltypvar,.true.,nulinclr,mni_in,mnj_in,nflev)
      endif
!
! ES
      call readgd_gusdev(z3d,'ES',ni,nj,nflev)
!
      do jlev=1,nflev
        do jj=1,mnj_in
          do ji=1,mni_in
            zfldin(ji,jj,jlev) = z3d(ji,jlev,jj)
          enddo
        enddo
      enddo
      if(grd_typ.eq.'GU') then
        call ecr_gu(zfldin,'ES ',niter,clletiket,nulinclr,mni_in,mnj_in,nflev)
      else
        call ecr_la(zfldin,'ES ',niter,clletiket,ipak,ibrpstamp,ideet,inpas,
     &              idatyp,cltypvar,.true.,nulinclr,mni_in,mnj_in,nflev)
      endif
!
! LQ
      call readgd_gusdev(z3d,'LQ ',ni,nj,nflev)
!
      do jlev=1,nflev
        do jj=1,mnj_in
          do ji=1,mni_in
            zfldin(ji,jj,jlev) = z3d(ji,jlev,jj)
          enddo
        enddo
      enddo
      if(grd_typ.eq.'GU') then
        call ecr_gu(zfldin,'LQ ',niter,clletiket,nulinclr,mni_in,mnj_in,nflev)
      else
        call ecr_la(zfldin,'LQ ',niter,clletiket,ipak,ibrpstamp,ideet,inpas,
     &              idatyp,cltypvar,.true.,nulinclr,mni_in,mnj_in,nflev)
      endif
!
! P0
      call readgd_gusdev(z2d,'P0 ',ni,nj,1)
      do jj=1,mnj_in
        do ji=1,mni_in
          zfldin(ji,jj,1) = z2d(ji,jj)
        enddo
      enddo
      if(grd_typ.eq.'GU') then
        call ecr_gu(zfldin,'P0 ',niter,clletiket,nulinclr,mni_in,mnj_in,1)
      else
        call ecr_la(zfldin,'P0 ',niter,clletiket,ipak,ibrpstamp,ideet,inpas,
     &              idatyp,cltypvar,.true.,nulinclr,mni_in,mnj_in,1)
      endif
!
      RETURN
      END